1. EPMO Open Source Coordination Office Redaction File Detail Report

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

1.1 Files compared

#	Location	File	Last Modified
1	PRCA_4.5_313_v14_Dec_2017.zip	PRCA_4.5_313_v14_Dec_2017.KID	Mon Feb 5 21:43:47 2018 UTC
2	PRCA_4.5_313_v14_Dec_2017.zip	PRCA_4.5_313_v14_Dec_2017.KID	Mon Feb 5 22:29:18 2018 UTC

1.2 Comparison summary

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

1.3 Comparison options

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

1.4 Active regular expressions

No regular expressions were active.

1.5 Comparison detail

	1	$END TXT
	2	$KID PRCA* 4.5*313
	3	INSTALL NAME
	4	PRCA4.53 13
	5	"BLD",1011 1,0)
	6	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31712 14^y
	7	"BLD",1011 1,1,0)
	8	^^1^1^3160 811^^^^
	9	"BLD",1011 1,1,1,0)
	10	Consolidat ed Patient Statement
	11	"BLD",1011 1,4,0)
	12	^9.64PA^43 3^7
	13	"BLD",1011 1,4,340,0)
	14	340
	15	"BLD",1011 1,4,340,2, 0)
	16	^9.641^340 ^1
	17	"BLD",1011 1,4,340,2, 340,0)
	18	AR DEBTOR (File-top level)
	19	"BLD",1011 1,4,340,2, 340,1,0)
	20	^9.6411^.0 3^3
	21	"BLD",1011 1,4,340,2, 340,1,.01, 0)
	22	DEBTOR
	23	"BLD",1011 1,4,340,2, 340,1,.03, 0)
	24	STATEMENT DAY
	25	"BLD",1011 1,4,340,2, 340,1,7.06 ,0)
	26	CURRENT CB S DEBT AMO UNT
	27	"BLD",1011 1,4,340,22 2)
	28	y^n^p^^^^n ^^n
	29	"BLD",1011 1,4,340,22 4)
	30
	31	"BLD",1011 1,4,341,0)
	32	341
	33	"BLD",1011 1,4,341,2, 0)
	34	^9.641^341 ^1
	35	"BLD",1011 1,4,341,2, 341,0)
	36	AR EVENT (File-top level)
	37	"BLD",1011 1,4,341,2, 341,1,0)
	38	^9.6411^6. 01^1
	39	"BLD",1011 1,4,341,2, 341,1,6.01 ,0)
	40	CCPC STATE MENT DATE
	41	"BLD",1011 1,4,341,22 2)
	42	y^n^p^^^^n ^^n
	43	"BLD",1011 1,4,341,22 4)
	44
	45	"BLD",1011 1,4,349,0)
	46	349
	47	"BLD",1011 1,4,349,2, 0)
	48	^9.641^349 ^1
	49	"BLD",1011 1,4,349,2, 349,0)
	50	AR TRANSMI SSION RECO RDS (File -top level )
	51	"BLD",1011 1,4,349,2, 349,1,0)
	52	^9.6411^.0 9^1
	53	"BLD",1011 1,4,349,2, 349,1,.09, 0)
	54	STATEMENT DATE
	55	"BLD",1011 1,4,349,22 2)
	56	y^n^p^^^^n ^^n
	57	"BLD",1011 1,4,349,22 4)
	58
	59	"BLD",1011 1,4,349.1, 0)
	60	349.1
	61	"BLD",1011 1,4,349.1, 222)
	62	y^n^f^^^^n ^^n
	63	"BLD",1011 1,4,349.1, 224)
	64
	65	"BLD",1011 1,4,349.2, 0)
	66	349.2
	67	"BLD",1011 1,4,349.2, 2,0)
	68	^9.641^349 .2^1
	69	"BLD",1011 1,4,349.2, 2,349.2,0)
	70	AR CBSS ST ATEMENTS (File-top level)
	71	"BLD",1011 1,4,349.2, 2,349.2,1, 0)
	72	^9.6411^61 ^12
	73	"BLD",1011 1,4,349.2, 2,349.2,1, .01,0)
	74	PATIENT
	75	"BLD",1011 1,4,349.2, 2,349.2,1, .02,0)
	76	SSN
	77	"BLD",1011 1,4,349.2, 2,349.2,1, .03,0)
	78	PATIENT NA ME
	79	"BLD",1011 1,4,349.2, 2,349.2,1, .12,0)
	80	INVALID ST ATEMENT ER ROR
	81	"BLD",1011 1,4,349.2, 2,349.2,1, .18,0)
	82	CBSS FILE BUILT
	83	"BLD",1011 1,4,349.2, 2,349.2,1, .19,0)
	84	PATIENT ST ATEMENT DA TE
	85	"BLD",1011 1,4,349.2, 2,349.2,1, 51,0)
	86	ERROR CODE (S)
	87	"BLD",1011 1,4,349.2, 2,349.2,1, 61,0)
	88	CBSS PRINT ED
	89	"BLD",1011 1,4,349.2, 2,349.2,1, 81,0)
	90	INTEGRATIO N CONTROL NUMBER
	91	"BLD",1011 1,4,349.2, 2,349.2,1, 82,0)
	92	ICN CHECKS UM
	93	"BLD",1011 1,4,349.2, 2,349.2,1, 83,0)
	94	AR FLAG
	95	"BLD",1011 1,4,349.2, 2,349.2,1, 84,0)
	96	DATE OF LA TEST BILL
	97	"BLD",1011 1,4,349.2, 222)
	98	y^n^p^^^^n ^^n
	99	"BLD",1011 1,4,349.2, 224)
	100
	101	"BLD",1011 1,4,349.5, 0)
	102	349.5
	103	"BLD",1011 1,4,349.5, 222)
	104	y^n^f^^^^n ^^n
	105	"BLD",1011 1,4,349.5, 224)
	106
	107	"BLD",1011 1,4,433,0)
	108	433
	109	"BLD",1011 1,4,433,2, 0)
	110	^9.641^433 ^1
	111	"BLD",1011 1,4,433,2, 433,0)
	112	AR TRANSAC TION (Fil e-top leve l)
	113	"BLD",1011 1,4,433,2, 433,1,0)
	114	^9.6411^97 ^4
	115	"BLD",1011 1,4,433,2, 433,1,94,0 )
	116	AUTO-CORRE CTION DATE
	117	"BLD",1011 1,4,433,2, 433,1,95,0 )
	118	AUTO-CORRE CTION TRAN S. AMOUNT
	119	"BLD",1011 1,4,433,2, 433,1,96,0 )
	120	AUTO-CORRE CTION TYPE OF ERROR
	121	"BLD",1011 1,4,433,2, 433,1,97,0 )
	122	AUTO-CORRE CTION TICK ET FLAG
	123	"BLD",1011 1,4,433,22 2)
	124	y^n^p^^^^n ^^n
	125	"BLD",1011 1,4,433,22 4)
	126
	127	"BLD",1011 1,4,"APDD" ,340,340)
	128
	129	"BLD",1011 1,4,"APDD" ,340,340,. 01)
	130
	131	"BLD",1011 1,4,"APDD" ,340,340,. 03)
	132
	133	"BLD",1011 1,4,"APDD" ,340,340,7 .06)
	134
	135	"BLD",1011 1,4,"APDD" ,341,341)
	136
	137	"BLD",1011 1,4,"APDD" ,341,341,6 .01)
	138
	139	"BLD",1011 1,4,"APDD" ,349,349)
	140
	141	"BLD",1011 1,4,"APDD" ,349,349,. 09)
	142
	143	"BLD",1011 1,4,"APDD" ,349.2,349 .2)
	144
	145	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.01)
	146
	147	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.02)
	148
	149	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.03)
	150
	151	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.12)
	152
	153	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.18)
	154
	155	"BLD",1011 1,4,"APDD" ,349.2,349 .2,.19)
	156
	157	"BLD",1011 1,4,"APDD" ,349.2,349 .2,51)
	158
	159	"BLD",1011 1,4,"APDD" ,349.2,349 .2,61)
	160
	161	"BLD",1011 1,4,"APDD" ,349.2,349 .2,81)
	162
	163	"BLD",1011 1,4,"APDD" ,349.2,349 .2,82)
	164
	165	"BLD",1011 1,4,"APDD" ,349.2,349 .2,83)
	166
	167	"BLD",1011 1,4,"APDD" ,349.2,349 .2,84)
	168
	169	"BLD",1011 1,4,"APDD" ,433,433)
	170
	171	"BLD",1011 1,4,"APDD" ,433,433,9 4)
	172
	173	"BLD",1011 1,4,"APDD" ,433,433,9 5)
	174
	175	"BLD",1011 1,4,"APDD" ,433,433,9 6)
	176
	177	"BLD",1011 1,4,"APDD" ,433,433,9 7)
	178
	179	"BLD",1011 1,4,"B",34 0,340)
	180
	181	"BLD",1011 1,4,"B",34 1,341)
	182
	183	"BLD",1011 1,4,"B",34 9,349)
	184
	185	"BLD",1011 1,4,"B",34 9.1,349.1)
	186
	187	"BLD",1011 1,4,"B",34 9.2,349.2)
	188
	189	"BLD",1011 1,4,"B",34 9.5,349.5)
	190
	191	"BLD",1011 1,4,"B",43 3,433)
	192
	193	"BLD",1011 1,6)
	194	2^
	195	"BLD",1011 1,6.3)
	196	130
	197	"BLD",1011 1,"ABPKG")
	198	n
	199	"BLD",1011 1,"INI")
	200	PRE^PRCA31 3P
	201	"BLD",1011 1,"INID")
	202	^y^y
	203	"BLD",1011 1,"INIT")
	204	EN^PRCA313 P
	205	"BLD",1011 1,"KRN",0)
	206	^9.67PA^77 9.2^20
	207	"BLD",1011 1,"KRN",.4 ,0)
	208	.4
	209	"BLD",1011 1,"KRN",.4 ,"NM",0)
	210	^9.68A^^0
	211	"BLD",1011 1,"KRN",.4 01,0)
	212	.401
	213	"BLD",1011 1,"KRN",.4 02,0)
	214	.402
	215	"BLD",1011 1,"KRN",.4 02,"NM",0)
	216	^9.68A^^0
	217	"BLD",1011 1,"KRN",.4 03,0)
	218	.403
	219	"BLD",1011 1,"KRN",.5 ,0)
	220	.5
	221	"BLD",1011 1,"KRN",.8 4,0)
	222	.84
	223	"BLD",1011 1,"KRN",3. 6,0)
	224	3.6
	225	"BLD",1011 1,"KRN",3. 8,0)
	226	3.8
	227	"BLD",1011 1,"KRN",3. 8,"NM",0)
	228	^9.68A^1^1
	229	"BLD",1011 1,"KRN",3. 8,"NM",1,0 )
	230	PRCACPS^^0
	231	"BLD",1011 1,"KRN",3. 8,"NM","B" ,"PRCACPS" ,1)
	232
	233	"BLD",1011 1,"KRN",9. 2,0)
	234	9.2
	235	"BLD",1011 1,"KRN",9. 8,0)
	236	9.8
	237	"BLD",1011 1,"KRN",9. 8,"NM",0)
	238	^9.68A^29^ 22
	239	"BLD",1011 1,"KRN",9. 8,"NM",5,0 )
	240	RCCPCBJ^^0 ^B9440906
	241	"BLD",1011 1,"KRN",9. 8,"NM",7,0 )
	242	RCCPCFN1^^ 0^B7181774
	243	"BLD",1011 1,"KRN",9. 8,"NM",8,0 )
	244	RCCPCML^^0 ^B67061934
	245	"BLD",1011 1,"KRN",9. 8,"NM",9,0 )
	246	RCCPCSV^^0 ^B11825361
	247	"BLD",1011 1,"KRN",9. 8,"NM",10, 0)
	248	RCCPCPS^^0 ^B14320836 9
	249	"BLD",1011 1,"KRN",9. 8,"NM",11, 0)
	250	RCCPCPS1^^ 0^B6544337 8
	251	"BLD",1011 1,"KRN",9. 8,"NM",12, 0)
	252	RCCPCSV1^^ 0^B4331384 1
	253	"BLD",1011 1,"KRN",9. 8,"NM",13, 0)
	254	RCCPCML1^^ 0^B8980051
	255	"BLD",1011 1,"KRN",9. 8,"NM",14, 0)
	256	RCCPCSE^^0 ^B16507603
	257	"BLD",1011 1,"KRN",9. 8,"NM",15, 0)
	258	RCCPCT^^0^ B29330001
	259	"BLD",1011 1,"KRN",9. 8,"NM",17, 0)
	260	PRCAG^^0^B 74256403
	261	"BLD",1011 1,"KRN",9. 8,"NM",18, 0)
	262	PRCA313P^^ 0^B2768173 4
	263	"BLD",1011 1,"KRN",9. 8,"NM",19, 0)
	264	PRCAACR^^0 ^B12733608 1
	265	"BLD",1011 1,"KRN",9. 8,"NM",20, 0)
	266	PRCAACR1^^ 0^B1512714 41
	267	"BLD",1011 1,"KRN",9. 8,"NM",21, 0)
	268	RCCPCAP^^0 ^B43506016
	269	"BLD",1011 1,"KRN",9. 8,"NM",22, 0)
	270	RCCPCAT^^0 ^B52270242
	271	"BLD",1011 1,"KRN",9. 8,"NM",23, 0)
	272	RCCPCAR^^0 ^B47894432
	273	"BLD",1011 1,"KRN",9. 8,"NM",24, 0)
	274	RCBEADJ^^0 ^B77106309
	275	"BLD",1011 1,"KRN",9. 8,"NM",26, 0)
	276	RCDPBTLM^^ 0^B5588593 9
	277	"BLD",1011 1,"KRN",9. 8,"NM",27, 0)
	278	PRCACPS^^0 ^B25406671 6
	279	"BLD",1011 1,"KRN",9. 8,"NM",28, 0)
	280	PRCACPS1^^ 0^B1912815 8
	281	"BLD",1011 1,"KRN",9. 8,"NM",29, 0)
	282	PRCACPSA^^ 0^B3327065 3
	283	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	284
	285	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	286
	287	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	288
	289	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS" ,27)
	290
	291	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",28)
	292
	293	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCACPSA ",29)
	294
	295	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	296
	297	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCBEADJ" ,24)
	298
	299	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	300
	301	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	302
	303	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	304
	305	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	306
	307	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	308
	309	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	310
	311	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	312
	313	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	314
	315	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	316
	317	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	318
	319	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	320
	321	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	322
	323	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	324
	325	"BLD",1011 1,"KRN",9. 8,"NM","B" ,"RCDPBTLM ",26)
	326
	327	"BLD",1011 1,"KRN",19 ,0)
	328	19
	329	"BLD",1011 1,"KRN",19 ,"NM",0)
	330	^9.68A^11^ 8
	331	"BLD",1011 1,"KRN",19 ,"NM",4,0)
	332	PRCA CBS N IGHTLY UPD ATE^^0
	333	"BLD",1011 1,"KRN",19 ,"NM",5,0)
	334	PRCAE FOLL OW-UP^^2
	335	"BLD",1011 1,"KRN",19 ,"NM",6,0)
	336	RCCPC APPS BUILD AND TRANS^^0
	337	"BLD",1011 1,"KRN",19 ,"NM",7,0)
	338	RCCPC APPS RETRANS^^ 0
	339	"BLD",1011 1,"KRN",19 ,"NM",8,0)
	340	RCCPC APPS DATA CHEC K^^0
	341	"BLD",1011 1,"KRN",19 ,"NM",9,0)
	342	PRCA ACCOU NT MANAGEM ENT^^2
	343	"BLD",1011 1,"KRN",19 ,"NM",10,0 )
	344	PRCA AUTOC RCT PGM^^0
	345	"BLD",1011 1,"KRN",19 ,"NM",11,0 )
	346	PRCA AUTOC RCT RPT^^0
	347	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA ACCO UNT MANAGE MENT",9)
	348
	349	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM", 10)
	350
	351	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA AUTO CRCT RPT", 11)
	352
	353	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	354
	355	"BLD",1011 1,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	356
	357	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	358
	359	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	360
	361	"BLD",1011 1,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	362
	363	"BLD",1011 1,"KRN",19 .1,0)
	364	19.1
	365	"BLD",1011 1,"KRN",19 .1,"NM",0)
	366	^9.68A^2^2
	367	"BLD",1011 1,"KRN",19 .1,"NM",1, 0)
	368	RCCPC APPS BUILD AND TRANS^^0
	369	"BLD",1011 1,"KRN",19 .1,"NM",2, 0)
	370	PRCA AUTOC RCT PGM^^0
	371	"BLD",1011 1,"KRN",19 .1,"NM","B ","PRCA AU TOCRCT PGM ",2)
	372
	373	"BLD",1011 1,"KRN",19 .1,"NM","B ","RCCPC A PPS BUILD AND TRANS" ,1)
	374
	375	"BLD",1011 1,"KRN",10 1,0)
	376	101
	377	"BLD",1011 1,"KRN",40 9.61,0)
	378	409.61
	379	"BLD",1011 1,"KRN",77 1,0)
	380	771
	381	"BLD",1011 1,"KRN",77 9.2,0)
	382	779.2
	383	"BLD",1011 1,"KRN",87 0,0)
	384	870
	385	"BLD",1011 1,"KRN",89 89.51,0)
	386	8989.51
	387	"BLD",1011 1,"KRN",89 89.52,0)
	388	8989.52
	389	"BLD",1011 1,"KRN",89 94,0)
	390	8994
	391	"BLD",1011 1,"KRN","B ",.4,.4)
	392
	393	"BLD",1011 1,"KRN","B ",.401,.40 1)
	394
	395	"BLD",1011 1,"KRN","B ",.402,.40 2)
	396
	397	"BLD",1011 1,"KRN","B ",.403,.40 3)
	398
	399	"BLD",1011 1,"KRN","B ",.5,.5)
	400
	401	"BLD",1011 1,"KRN","B ",.84,.84)
	402
	403	"BLD",1011 1,"KRN","B ",3.6,3.6)
	404
	405	"BLD",1011 1,"KRN","B ",3.8,3.8)
	406
	407	"BLD",1011 1,"KRN","B ",9.2,9.2)
	408
	409	"BLD",1011 1,"KRN","B ",9.8,9.8)
	410
	411	"BLD",1011 1,"KRN","B ",19,19)
	412
	413	"BLD",1011 1,"KRN","B ",19.1,19. 1)
	414
	415	"BLD",1011 1,"KRN","B ",101,101)
	416
	417	"BLD",1011 1,"KRN","B ",409.61,4 09.61)
	418
	419	"BLD",1011 1,"KRN","B ",771,771)
	420
	421	"BLD",1011 1,"KRN","B ",779.2,77 9.2)
	422
	423	"BLD",1011 1,"KRN","B ",870,870)
	424
	425	"BLD",1011 1,"KRN","B ",8989.51, 8989.51)
	426
	427	"BLD",1011 1,"KRN","B ",8989.52, 8989.52)
	428
	429	"BLD",1011 1,"KRN","B ",8994,899 4)
	430
	431	"BLD",1011 1,"QDEF")
	432	^^^^^^^^YE S^^YES
	433	"BLD",1011 1,"QUES",0 )
	434	^9.62^^
	435	"BLD",1011 1,"REQB",0 )
	436	^9.611^7^7
	437	"BLD",1011 1,"REQB",1 ,0)
	438	PRCA4.53 07^2
	439	"BLD",1011 1,"REQB",2 ,0)
	440	XMDB1.00 ^2
	441	"BLD",1011 1,"REQB",3 ,0)
	442	PRCA4.52 37^2
	443	"BLD",1011 1,"REQB",4 ,0)
	444	PRCA4.52 33^2
	445	"BLD",1011 1,"REQB",5 ,0)
	446	PRCA4.53 09^2
	447	"BLD",1011 1,"REQB",6 ,0)
	448	PRCA4.52 76^2
	449	"BLD",1011 1,"REQB",7 ,0)
	450	PRCA4.53 01^2
	451	"BLD",1011 1,"REQB"," B","PRCA4 .5233",4)
	452
	453	"BLD",1011 1,"REQB"," B","PRCA4 .5237",3)
	454
	455	"BLD",1011 1,"REQB"," B","PRCA4 .5276",6)
	456
	457	"BLD",1011 1,"REQB"," B","PRCA4 .5301",7)
	458
	459	"BLD",1011 1,"REQB"," B","PRCA4 .5307",1)
	460
	461	"BLD",1011 1,"REQB"," B","PRCA4 .5309",5)
	462
	463	"BLD",1011 1,"REQB"," B","XMDB1 .00",2)
	464
	465	"FIA",340)
	466	AR DEBTOR
	467	"FIA",340, 0)
	468	^RCD(340,
	469	"FIA",340, 0,0)
	470	340V
	471	"FIA",340, 0,1)
	472	y^n^p^^^^n ^^n
	473	"FIA",340, 0,10)
	474
	475	"FIA",340, 0,11)
	476
	477	"FIA",340, 0,"RLRO")
	478
	479	"FIA",340, 0,"VR")
	480	4.5^PRCA
	481	"FIA",340, 340)
	482	1
	483	"FIA",340, 340,.01)
	484
	485	"FIA",340, 340,.03)
	486
	487	"FIA",340, 340,7.06)
	488
	489	"FIA",341)
	490	AR EVENT
	491	"FIA",341, 0)
	492	^RC(341,
	493	"FIA",341, 0,0)
	494	341I
	495	"FIA",341, 0,1)
	496	y^n^p^^^^n ^^n
	497	"FIA",341, 0,10)
	498
	499	"FIA",341, 0,11)
	500
	501	"FIA",341, 0,"RLRO")
	502
	503	"FIA",341, 0,"VR")
	504	4.5^PRCA
	505	"FIA",341, 341)
	506	1
	507	"FIA",341, 341,6.01)
	508
	509	"FIA",349)
	510	AR TRANSMI SSION RECO RDS
	511	"FIA",349, 0)
	512	^RCT(349,
	513	"FIA",349, 0,0)
	514	349I
	515	"FIA",349, 0,1)
	516	y^n^p^^^^n ^^n
	517	"FIA",349, 0,10)
	518
	519	"FIA",349, 0,11)
	520
	521	"FIA",349, 0,"RLRO")
	522
	523	"FIA",349, 0,"VR")
	524	4.5^PRCA
	525	"FIA",349, 349)
	526	1
	527	"FIA",349, 349,.09)
	528
	529	"FIA",349. 1)
	530	AR TRANSMI SSION TYPE
	531	"FIA",349. 1,0)
	532	^RCT(349.1 ,
	533	"FIA",349. 1,0,0)
	534	349.1I
	535	"FIA",349. 1,0,1)
	536	y^n^f^^^^n ^^n
	537	"FIA",349. 1,0,10)
	538
	539	"FIA",349. 1,0,11)
	540
	541	"FIA",349. 1,0,"RLRO" )
	542
	543	"FIA",349. 1,0,"VR")
	544	4.5^PRCA
	545	"FIA",349. 1,349.1)
	546	0
	547	"FIA",349. 1,349.11)
	548	0
	549	"FIA",349. 1,349.12)
	550	0
	551	"FIA",349. 1,349.141)
	552	0
	553	"FIA",349. 1,349.151)
	554	0
	555	"FIA",349. 1,349.161)
	556	0
	557	"FIA",349. 2)
	558	AR CBSS ST ATEMENTS
	559	"FIA",349. 2,0)
	560	^RCPS(349. 2,
	561	"FIA",349. 2,0,0)
	562	349.2I
	563	"FIA",349. 2,0,1)
	564	y^n^p^^^^n ^^n
	565	"FIA",349. 2,0,10)
	566
	567	"FIA",349. 2,0,11)
	568
	569	"FIA",349. 2,0,"RLRO" )
	570
	571	"FIA",349. 2,0,"VR")
	572	4.5^PRCA
	573	"FIA",349. 2,349.2)
	574	1
	575	"FIA",349. 2,349.2,.0 1)
	576
	577	"FIA",349. 2,349.2,.0 2)
	578
	579	"FIA",349. 2,349.2,.0 3)
	580
	581	"FIA",349. 2,349.2,.1 2)
	582
	583	"FIA",349. 2,349.2,.1 8)
	584
	585	"FIA",349. 2,349.2,.1 9)
	586
	587	"FIA",349. 2,349.2,51 )
	588
	589	"FIA",349. 2,349.2,61 )
	590
	591	"FIA",349. 2,349.2,81 )
	592
	593	"FIA",349. 2,349.2,82 )
	594
	595	"FIA",349. 2,349.2,83 )
	596
	597	"FIA",349. 2,349.2,84 )
	598
	599	"FIA",349. 5)
	600	AR ANNUAL PAYMENT ST ATEMENT
	601	"FIA",349. 5,0)
	602	^RCAP(349. 5,
	603	"FIA",349. 5,0,0)
	604	349.5
	605	"FIA",349. 5,0,1)
	606	y^n^f^^^^n ^^n
	607	"FIA",349. 5,0,10)
	608
	609	"FIA",349. 5,0,11)
	610
	611	"FIA",349. 5,0,"RLRO" )
	612
	613	"FIA",349. 5,0,"VR")
	614	4.5^PRCA
	615	"FIA",349. 5,349.5)
	616	0
	617	"FIA",349. 5,349.51)
	618	0
	619	"FIA",433)
	620	AR TRANSAC TION
	621	"FIA",433, 0)
	622	^PRCA(433,
	623	"FIA",433, 0,0)
	624	433NI
	625	"FIA",433, 0,1)
	626	y^n^p^^^^n ^^n
	627	"FIA",433, 0,10)
	628
	629	"FIA",433, 0,11)
	630
	631	"FIA",433, 0,"RLRO")
	632
	633	"FIA",433, 0,"VR")
	634	4.5^PRCA
	635	"FIA",433, 433)
	636	1
	637	"FIA",433, 433,94)
	638
	639	"FIA",433, 433,95)
	640
	641	"FIA",433, 433,96)
	642
	643	"FIA",433, 433,97)
	644
	645	"INI")
	646	PRE^PRCA31 3P
	647	"INIT")
	648	EN^PRCA313 P
	649	"IX",349,3 49,"SDT",0 )
	650	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	651	"IX",349,3 49,"SDT",. 1,0)
	652	^^1^1^3161 007^
	653	"IX",349,3 49,"SDT",. 1,1,0)
	654	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	655	"IX",349,3 49,"SDT",1 )
	656	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	657	"IX",349,3 49,"SDT",2 )
	658	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	659	"IX",349,3 49,"SDT",2 .5)
	660	K ^RCT(349 ,"SDT")
	661	"IX",349,3 49,"SDT",1 1.1,0)
	662	^.114IA^1^ 1
	663	"IX",349,3 49,"SDT",1 1.1,1,0)
	664	1^F^349^.0 9^2^1^F
	665	"IX",349,3 49,"SDT",1 1.1,1,2)
	666	S X=+$E(X, 6,7)
	667	"IX",349.1 ,349.141," STDT4",0)
	668	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^
	669	^LS
	670	"IX",349.1 ,349.141," STDT4",.1, 0)
	671	^^2^2^3161 007^
	672	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	673	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	674	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	675	Last Messa ge ACK.
	676	"IX",349.1 ,349.141," STDT4",1)
	677	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	678	"IX",349.1 ,349.141," STDT4",2)
	679	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	680	"IX",349.1 ,349.141," STDT4",2.5 )
	681	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	682	"IX",349.1 ,349.141," STDT4",11. 1,0)
	683	^.114IA^2^ 2
	684	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	685	1^F^349.14 1^.04^7^1^ F
	686	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	687
	688	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	689	2^F^349.14 1^.01^3^2^ F
	690	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	691
	692	"IX",349.1 ,349.151," STDT5",0)
	693	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	694	"IX",349.1 ,349.151," STDT5",.1, 0)
	695	^^1^1^3161 006^
	696	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	697	This cross -reference is used t o sort by the Patien t Statemen t Date.
	698	"IX",349.1 ,349.151," STDT5",1)
	699	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	700	"IX",349.1 ,349.151," STDT5",2)
	701	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	702	"IX",349.1 ,349.151," STDT5",2.5 )
	703	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	704	"IX",349.1 ,349.151," STDT5",11. 1,0)
	705	^.114IA^1^ 1
	706	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	707	1^F^349.15 1^.04^7^1^ F
	708	"IX",349.2 ,349.2,"AD ",0)
	709	349.2^AD^P atient Sta tement Err ors^R^^F^I R^I^349.2^ ^^^^S
	710	"IX",349.2 ,349.2,"AD ",.1,0)
	711	^^2^2^3161 007^
	712	"IX",349.2 ,349.2,"AD ",.1,1,0)
	713	This is th e cross-re ference to find pati ent statem ent errors that are
	714	"IX",349.2 ,349.2,"AD ",.1,2,0)
	715	returned f rom CBSS.
	716	"IX",349.2 ,349.2,"AD ",1)
	717	S ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)=""
	718	"IX",349.2 ,349.2,"AD ",2)
	719	K ^RCPS(34 9.2,"AD",$ E(X,1,1),D A)
	720	"IX",349.2 ,349.2,"AD ",2.5)
	721	K ^RCPS(34 9.2,"AD")
	722	"IX",349.2 ,349.2,"AD ",11.1,0)
	723	^.114IA^1^ 1
	724	"IX",349.2 ,349.2,"AD ",11.1,1,0 )
	725	1^F^349.2^ 51^1^1^F
	726	"IX",349.2 ,349.2,"AD ",11.1,1,1 )
	727
	728	"IX",349.2 ,349.2,"AD ",11.1,1,2 )
	729	S X="E"
	730	"IX",349.2 ,349.2,"ST DT",0)
	731	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	732	"IX",349.2 ,349.2,"ST DT",.1,0)
	733	^^2^2^3161 007^
	734	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	735	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	736	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	737	standardly two days after the statement is transmi tted.
	738	"IX",349.2 ,349.2,"ST DT",1)
	739	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	740	"IX",349.2 ,349.2,"ST DT",2)
	741	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	742	"IX",349.2 ,349.2,"ST DT",2.5)
	743	K ^RCPS(34 9.2,"STDT" )
	744	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	745	^.114IA^1^ 1
	746	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	747	1^F^349.2^ .19^7^1^F
	748	"IX",433,4 33,"TACD", 0)
	749	433^TACD^T he date th at this tr ansaction was correc ted by the Auto-Corr ection Pr
	750	ogram.^R^^ F^IR^I^433 ^^^^^LS
	751	"IX",433,4 33,"TACD", .1,0)
	752	^^2^2^3160 920^
	753	"IX",433,4 33,"TACD", .1,1,0)
	754	The is the date that the Patie nt Stateme nt Auto-Co rrection P rogram
	755	"IX",433,4 33,"TACD", .1,2,0)
	756	corrected the statem ent discre pancy for this trans action.
	757	"IX",433,4 33,"TACD", 1)
	758	S ^PRCA(43 3,"TACD",$ E(X,1,7),D A)=""
	759	"IX",433,4 33,"TACD", 2)
	760	K ^PRCA(43 3,"TACD",$ E(X,1,7),D A)
	761	"IX",433,4 33,"TACD", 2.5)
	762	K ^PRCA(43 3,"TACD")
	763	"IX",433,4 33,"TACD", 11.1,0)
	764	^.114IA^1^ 1
	765	"IX",433,4 33,"TACD", 11.1,1,0)
	766	1^F^433^94 ^7^1^F
	767	"IX",433,4 33,"TACD", "NOREINDEX ")
	768	1
	769	"KRN",3.8, 322,-1)
	770	0^1
	771	"KRN",3.8, 322,0)
	772	PRCACPS^PU ^^^^^
	773	"KRN",3.8, 322,2,0)
	774	^3.801^2^2 ^3160406^^ ^
	775	"KRN",3.8, 322,2,1,0)
	776	This mail group will receive a notificat ion when t he Consoli dated
	777	"KRN",3.8, 322,2,2,0)
	778	Patient St atement Au to-Correct ion progra m has comp leted.
	779	"KRN",3.8, 322,3)
	780
	781	"KRN",19,3 026,-1)
	782	2^5
	783	"KRN",19,3 026,0)
	784	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1^^^^^^^5 3
	785	"KRN",19,3 026,10,0)
	786	^19.01IP^1 9^19
	787	"KRN",19,3 026,10,17, 0)
	788	11666^^14
	789	"KRN",19,3 026,10,17, "^")
	790	RCCPC APPS BUILD AND TRANS
	791	"KRN",19,3 026,10,18, 0)
	792	11667^^15
	793	"KRN",19,3 026,10,18, "^")
	794	RCCPC APPS RETRANS
	795	"KRN",19,3 026,10,19, 0)
	796	11668^^16
	797	"KRN",19,3 026,10,19, "^")
	798	RCCPC APPS DATA CHEC K
	799	"KRN",19,3 026,"U")
	800	FOLLOW-UP LETTER MEN U
	801	"KRN",19,3 126,-1)
	802	2^9
	803	"KRN",19,3 126,0)
	804	PRCA ACCOU NT MANAGEM ENT^Accoun t Manageme nt^^M^1^^^ ^^^^53
	805	"KRN",19,3 126,10,0)
	806	^19.01IP^2 1^20
	807	"KRN",19,3 126,10,18, 0)
	808	11669^^2
	809	"KRN",19,3 126,10,18, "^")
	810	PRCA AUTOC RCT PGM
	811	"KRN",19,3 126,10,19, 0)
	812	11670^^1
	813	"KRN",19,3 126,10,19, "^")
	814	PRCA AUTOC RCT RPT
	815	"KRN",19,3 126,10,21, 0)
	816	11657^^3
	817	"KRN",19,3 126,10,21, "^")
	818	PRCA CBS N IGHTLY UPD ATE
	819	"KRN",19,3 126,"U")
	820	ACCOUNT MA NAGEMENT
	821	"KRN",19,1 1657,-1)
	822	0^4
	823	"KRN",19,1 1657,0)
	824	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	825	"KRN",19,1 1657,1,0)
	826	^^2^2^3160 622^
	827	"KRN",19,1 1657,1,1,0 )
	828	This optio n runs the Consolida ted Billin g System
	829	"KRN",19,1 1657,1,2,0 )
	830	Nightly Ac count Upda te program .
	831	"KRN",19,1 1657,25)
	832	ENTER^PRCA CPS1
	833	"KRN",19,1 1657,"U")
	834	CBS NIGHTL Y ACCOUNT UPDATE PRO
	835	"KRN",19,1 1666,-1)
	836	0^6
	837	"KRN",19,1 1666,0)
	838	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ RCCPC APP
	839	S BUILD AN D TRANS^^^ ^^^^^1
	840	"KRN",19,1 1666,1,0)
	841	^19.06^3^3 ^3170502^^ ^
	842	"KRN",19,1 1666,1,1,0 )
	843	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	844	"KRN",19,1 1666,1,2,0 )
	845	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	846	"KRN",19,1 1666,1,3,0 )
	847	and transm it the fil e to AITC.
	848	"KRN",19,1 1666,20)
	849	D MANBLD^R CCPCAT
	850	"KRN",19,1 1666,"U")
	851	BUILD AND TRANSMIT A NNUAL PAYM
	852	"KRN",19,1 1667,-1)
	853	0^7
	854	"KRN",19,1 1667,0)
	855	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^RCCPC AP PS BUILD
	856	AND TRANS^ ^^^^^^^1
	857	"KRN",19,1 1667,1,0)
	858	^19.06^3^3 ^3170502^^ ^^
	859	"KRN",19,1 1667,1,1,0 )
	860	This optio n should o nly to be used when AITC has r equested t he current
	861	"KRN",19,1 1667,1,2,0 )
	862	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	863	"KRN",19,1 1667,1,3,0 )
	864	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	865	"KRN",19,1 1667,20)
	866	D RETRANS^ RCCPCAT
	867	"KRN",19,1 1667,"U")
	868	RETRANSMIT CURRENT A NNUAL PAYM
	869	"KRN",19,1 1668,-1)
	870	0^8
	871	"KRN",19,1 1668,0)
	872	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	873	"KRN",19,1 1668,1,0)
	874	^^5^5^3170 321^
	875	"KRN",19,1 1668,1,1,0 )
	876	AR data is extracted from the VistA site s and is s ent to CBS S who then
	877	"KRN",19,1 1668,1,2,0 )
	878	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	879	"KRN",19,1 1668,1,3,0 )
	880	needs to b e validate d prior to its trans mission. T his menu o ption will
	881	"KRN",19,1 1668,1,4,0 )
	882	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	883	"KRN",19,1 1668,1,5,0 )
	884	updated pr ior to its transmiss ion to CBS S.
	885	"KRN",19,1 1668,20)
	886	D MANBLD^R CCPCAR
	887	"KRN",19,1 1668,"U")
	888	ANNUAL PAY MENT FILE CONSISTENC
	889	"KRN",19,1 1669,-1)
	890	0^10
	891	"KRN",19,1 1669,0)
	892	PRCA AUTOC RCT PGM^Pa tient Stat ement Auto -Correctio n Program^ ^R^^PRCA A UTOCRCT P
	893	GM^^^^^^
	894	"KRN",19,1 1669,1,0)
	895	^^2^2^3170 518^
	896	"KRN",19,1 1669,1,1,0 )
	897	This optio n runs the Auto-Corr ection pro gram for P atient Sta tement
	898	"KRN",19,1 1669,1,2,0 )
	899	discrepanc ies.
	900	"KRN",19,1 1669,25)
	901	BEGIN^PRCA CPS
	902	"KRN",19,1 1669,"U")
	903	PATIENT ST ATEMENT AU TO-CORRECT
	904	"KRN",19,1 1670,-1)
	905	0^11
	906	"KRN",19,1 1670,0)
	907	PRCA AUTOC RCT RPT^Au to-Correct Patient D iscrepancy Report^^R ^^^^^^^^
	908	"KRN",19,1 1670,1,0)
	909	^^2^2^3170 518^
	910	"KRN",19,1 1670,1,1,0 )
	911	This optio n runs the Auto-Corr ection Pat ient Discr epancy Rep ort for
	912	"KRN",19,1 1670,1,2,0 )
	913	correction s made by the Patien t Statemen t Auto-Cor rection Pr ogram.
	914	"KRN",19,1 1670,25)
	915	PSACRT^PRC AACR
	916	"KRN",19,1 1670,"U")
	917	AUTO-CORRE CT PATIENT DISCREPAN
	918	"KRN",19.1 ,598,-1)
	919	0^2
	920	"KRN",19.1 ,598,0)
	921	PRCA AUTOC RCT PGM
	922	"KRN",19.1 ,598,1,0)
	923	^19.11^3^3 ^3170515^^ ^^
	924	"KRN",19.1 ,598,1,1,0 )
	925	This is a key for th e AR optio n 'PRCA AU TOCRCT PGM '.
	926	"KRN",19.1 ,598,1,2,0 )
	927	The 'PRCA AUTOCRCT P GM' option runs the Consolidat ed
	928	"KRN",19.1 ,598,1,3,0 )
	929	Patient St atement Au to-Correct ion progra m.
	930	"KRN",19.1 ,600,-1)
	931	0^1
	932	"KRN",19.1 ,600,0)
	933	RCCPC APPS BUILD AND TRANS
	934	"KRN",19.1 ,600,1,0)
	935	^^8^8^3170 502^
	936	"KRN",19.1 ,600,1,1,0 )
	937	This is a key for th e AR menu options 'R CCPC APPS BUILD AND TRANS' and
	938	"KRN",19.1 ,600,1,2,0 )
	939	'RCCPC APP S RETRANS' .
	940	"KRN",19.1 ,600,1,3,0 )
	941
	942	"KRN",19.1 ,600,1,4,0 )
	943	The 'RCCPC APPS BUIL D AND TRAN S' option runs the A nnual Paym ent Statem ent
	944	"KRN",19.1 ,600,1,5,0 )
	945	File Build and Trans mit for th e previous year and sends the data to AI TC.
	946	"KRN",19.1 ,600,1,6,0 )
	947
	948	"KRN",19.1 ,600,1,7,0 )
	949	The 'RCCPC APPS RETR ANS' optio n Re-Trans mits the c urrent Ann ual Paymen t
	950	"KRN",19.1 ,600,1,8,0 )
	951	Statement File data to AITC.
	952	"MBREQ")
	953	0
	954	"ORD",3,19 .1)
	955	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	956	"ORD",3,19 .1,0)
	957	SECURITY K EY
	958	"ORD",11,3 .8)
	959	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XP
	960	DIA1(%)
	961	"ORD",11,3 .8,0)
	962	MAIL GROUP
	963	"ORD",18,1 9)
	964	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	965	"ORD",18,1 9,0)
	966	OPTION
	967	"PKG",53,- 1)
	968	1^1
	969	"PKG",53,0 )
	970	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	971	"PKG",53,2 0,0)
	972	^9.402P^1^ 1
	973	"PKG",53,2 0,1,0)
	974	2^^PRCAMRG
	975	"PKG",53,2 0,1,1)
	976
	977	"PKG",53,2 0,"B",2,1)
	978
	979	"PKG",53,2 2,0)
	980	^9.49I^1^1
	981	"PKG",53,2 2,1,0)
	982	4.5^305111 9^2960627
	983	"PKG",53,2 2,1,"PAH", 1,0)
	984	313^317121 4^81
	985	"PKG",53,2 2,1,"PAH", 1,1,0)
	986	^^1^1^3171 214
	987	"PKG",53,2 2,1,"PAH", 1,1,1,0)
	988	Consolidat ed Patient Statement
	989	"QUES","XP F1",0)
	990	Y
	991	"QUES","XP F1","??")
	992	^D REP^XPD H
	993	"QUES","XP F1","A")
	994	Shall I wr ite over y our \|FLAG\| File
	995	"QUES","XP F1","B")
	996	YES
	997	"QUES","XP F1","M")
	998	D XPF1^XPD IQ
	999	"QUES","XP F2",0)
	1000	Y
	1001	"QUES","XP F2","??")
	1002	^D DTA^XPD H
	1003	"QUES","XP F2","A")
	1004	Want my da ta \|FLAG\| yours
	1005	"QUES","XP F2","B")
	1006	YES
	1007	"QUES","XP F2","M")
	1008	D XPF2^XPD IQ
	1009	"QUES","XP I1",0)
	1010	YO
	1011	"QUES","XP I1","??")
	1012	^D INHIBIT ^XPDH
	1013	"QUES","XP I1","A")
	1014	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1015	"QUES","XP I1","B")
	1016	NO
	1017	"QUES","XP I1","M")
	1018	D XPI1^XPD IQ
	1019	"QUES","XP M1",0)
	1020	PO^VA(200, :EM
	1021	"QUES","XP M1","??")
	1022	^D MG^XPDH
	1023	"QUES","XP M1","A")
	1024	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1025	"QUES","XP M1","B")
	1026
	1027	"QUES","XP M1","M")
	1028	D XPM1^XPD IQ
	1029	"QUES","XP O1",0)
	1030	Y
	1031	"QUES","XP O1","??")
	1032	^D MENU^XP DH
	1033	"QUES","XP O1","A")
	1034	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1035	"QUES","XP O1","B")
	1036	YES
	1037	"QUES","XP O1","M")
	1038	D XPO1^XPD IQ
	1039	"QUES","XP Z1",0)
	1040	Y
	1041	"QUES","XP Z1","??")
	1042	^D OPT^XPD H
	1043	"QUES","XP Z1","A")
	1044	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1045	"QUES","XP Z1","B")
	1046	YES
	1047	"QUES","XP Z1","M")
	1048	D XPZ1^XPD IQ
	1049	"QUES","XP Z2",0)
	1050	Y
	1051	"QUES","XP Z2","??")
	1052	^D RTN^XPD H
	1053	"QUES","XP Z2","A")
	1054	Want to MO VE routine s to other CPUs
	1055	"QUES","XP Z2","B")
	1056	NO
	1057	"QUES","XP Z2","M")
	1058	D XPZ2^XPD IQ
	1059	"RTN")
	1060	22
	1061	"RTN","PRC A313P")
	1062	0^18^B2768 1734^n/a
	1063	"RTN","PRC A313P",1,0 )
	1064	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ; 11/2/15 4:15pm
	1065	"RTN","PRC A313P",2,0 )
	1066	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	1067	"RTN","PRC A313P",3,0 )
	1068	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1069	"RTN","PRC A313P",4,0 )
	1070	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1071	"RTN","PRC A313P",5,0 )
	1072	;
	1073	"RTN","PRC A313P",6,0 )
	1074	Q
	1075	"RTN","PRC A313P",7,0 )
	1076	EN ;Entry point for PRCA4.53 13 post-in stall
	1077	"RTN","PRC A313P",8,0 )
	1078	;
	1079	"RTN","PRC A313P",9,0 )
	1080	; Queue t he Patient Statement Auto-Corr ection Pro gram
	1081	"RTN","PRC A313P",10, 0)
	1082	D PRCACPS
	1083	"RTN","PRC A313P",11, 0)
	1084	; Delete DD previou s monthly data
	1085	"RTN","PRC A313P",12, 0)
	1086	D CLEANUP
	1087	"RTN","PRC A313P",13, 0)
	1088	; Set Pat ient State ment days
	1089	"RTN","PRC A313P",14, 0)
	1090	D STDT
	1091	"RTN","PRC A313P",15, 0)
	1092	; Set AR Transactio n Types
	1093	"RTN","PRC A313P",16, 0)
	1094	D SET3491
	1095	"RTN","PRC A313P",17, 0)
	1096	;
	1097	"RTN","PRC A313P",18, 0)
	1098	Q
	1099	"RTN","PRC A313P",19, 0)
	1100	;
	1101	"RTN","PRC A313P",20, 0)
	1102	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent up
	1103	on the Pat ient Last Name
	1104	"RTN","PRC A313P",21, 0)
	1105	D BMES^XP DUTL("Star ting Patie nt Stateme nt Date Re set.")
	1106	"RTN","PRC A313P",22, 0)
	1107	N DEBT,DI E
	1108	"RTN","PRC A313P",23, 0)
	1109	S DIE="^R CD(340,"
	1110	"RTN","PRC A313P",24, 0)
	1111	S DEBT=""
	1112	"RTN","PRC A313P",25, 0)
	1113	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	1114	"RTN","PRC A313P",26, 0)
	1115	. N PAT,D PT,NAME,DA ,DR
	1116	"RTN","PRC A313P",27, 0)
	1117	. S PAT=$ P($G(^RCD( 340,DEBT,0 )),U)
	1118	"RTN","PRC A313P",28, 0)
	1119	. S DPT=$ P(PAT,";", 1)
	1120	"RTN","PRC A313P",29, 0)
	1121	. S NAME= $P($G(^DPT (DPT,0)),U )
	1122	"RTN","PRC A313P",30, 0)
	1123	. S DA=DE BT
	1124	"RTN","PRC A313P",31, 0)
	1125	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1126	"RTN","PRC A313P",32, 0)
	1127	. D ^DIE
	1128	"RTN","PRC A313P",33, 0)
	1129	;
	1130	"RTN","PRC A313P",34, 0)
	1131	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	1132	"RTN","PRC A313P",35, 0)
	1133	N DA,DIK
	1134	"RTN","PRC A313P",36, 0)
	1135	S DIK="^R C(341,"
	1136	"RTN","PRC A313P",37, 0)
	1137	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	1138	"RTN","PRC A313P",38, 0)
	1139	;
	1140	"RTN","PRC A313P",39, 0)
	1141	D BMES^XP DUTL("Pati ent Statem ent Date R eset Compl ete.")
	1142	"RTN","PRC A313P",40, 0)
	1143	Q
	1144	"RTN","PRC A313P",41, 0)
	1145	;
	1146	"RTN","PRC A313P",42, 0)
	1147	CLEANUP ; PRCA4.5 313
	1148	"RTN","PRC A313P",43, 0)
	1149	; Remove site state ment date
	1150	"RTN","PRC A313P",44, 0)
	1151	D BMES^XP DUTL("Star ting Patie nt Stateme nt Cleanup .")
	1152	"RTN","PRC A313P",45, 0)
	1153	N DA,DR,D IE,X,RCT
	1154	"RTN","PRC A313P",46, 0)
	1155	S DA=1
	1156	"RTN","PRC A313P",47, 0)
	1157	S DR=".11 ///@"
	1158	"RTN","PRC A313P",48, 0)
	1159	S DIE="^R C(342,"
	1160	"RTN","PRC A313P",49, 0)
	1161	D ^DIE
	1162	"RTN","PRC A313P",50, 0)
	1163	;
	1164	"RTN","PRC A313P",51, 0)
	1165	; Remove all monthl y data
	1166	"RTN","PRC A313P",52, 0)
	1167	S DIK="^R CT(349,"
	1168	"RTN","PRC A313P",53, 0)
	1169	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1170	"RTN","PRC A313P",54, 0)
	1171	S ^RCT(34 9,0)="AR T RANSMISSIO N RECORDS^ 349I^^"
	1172	"RTN","PRC A313P",55, 0)
	1173	S DIK="^R CPS(349.2, "
	1174	"RTN","PRC A313P",56, 0)
	1175	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1176	"RTN","PRC A313P",57, 0)
	1177	S ^RCPS(3 49.2,0)="A R CBSS STA TEMENTS^34 9.2I^^"
	1178	"RTN","PRC A313P",58, 0)
	1179	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T K ^RCT( 349.1,+RCT ,4),^RCT(
	1180	349.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))
	1219	)) D Q
	1220	"RTN","PRC A313P",78, 0)
	1221	. N LINE S $P(LINE, "*",79)=""
	1222	"RTN","PRC A313P",79, 0)
	1223	. D BMES^ XPDUTL(LIN E)
	1224	"RTN","PRC A313P",80, 0)
	1225	. D MES^X PDUTL("Dom ains for P RCA4.531 3 have not been full y set up." )
	1226	"RTN","PRC A313P",81, 0)
	1227	. D MES^X PDUTL("Ple ase establ ish Domain s for: ")
	1228	"RTN","PRC A313P",82, 0)
	1229	. D MES^X PDUTL("CCP C PATIENT STATEMENTS , PATIENT STATEMENT UPDATE, an d ANNUAL
	1230	PAYMENT ST ATEMENTS." )
	1231	"RTN","PRC A313P",83, 0)
	1232	. D BMES^ XPDUTL(LIN E)
	1233	"RTN","PRC A313P",84, 0)
	1234	;
	1235	"RTN","PRC A313P",85, 0)
	1236	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update,
	1237	and Annua l Payment Statement
	1238	"RTN","PRC A313P",86, 0)
	1239	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1240	"RTN","PRC A313P",87, 0)
	1241	. N DOMAI N,I
	1242	"RTN","PRC A313P",88, 0)
	1243	. I TT="P S" M DOMAI N=CC
	1244	"RTN","PRC A313P",89, 0)
	1245	. I TT="P U" M DOMAI N=CP
	1246	"RTN","PRC A313P",90, 0)
	1247	. I TT="P Y" M DOMAI N=CA
	1248	"RTN","PRC A313P",91, 0)
	1249	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1250	"RTN","PRC A313P",92, 0)
	1251	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1252	"RTN","PRC A313P",93, 0)
	1253	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1254	"RTN","PRC A313P",94, 0)
	1255	. I IEN'= "" D
	1256	"RTN","PRC A313P",95, 0)
	1257	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1258	"RTN","PRC A313P",96, 0)
	1259	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1260	"RTN","PRC A313P",97, 0)
	1261	;
	1262	"RTN","PRC A313P",98, 0)
	1263	D BMES^XP DUTL("AR T ransaction Type Upda te complet e.")
	1264	"RTN","PRC A313P",99, 0)
	1265	;
	1266	"RTN","PRC A313P",100 ,0)
	1267	Q
	1268	"RTN","PRC A313P",101 ,0)
	1269	;
	1270	"RTN","PRC A313P",102 ,0)
	1271	SET1(TT,DO MAIN) ; P RCA4.531 3
	1272	"RTN","PRC A313P",103 ,0)
	1273	; Set bot h the 1 an d 3 level for 349.1
	1274	"RTN","PRC A313P",104 ,0)
	1275	; New and Set Field values fo r DIC(4.2
	1276	"RTN","PRC A313P",105 ,0)
	1277	N TTNAME, ZZ,DIC,Y
	1278	"RTN","PRC A313P",106 ,0)
	1279	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1280	"RTN","PRC A313P",107 ,0)
	1281	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1282	"RTN","PRC A313P",108 ,0)
	1283	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1284	"RTN","PRC A313P",109 ,0)
	1285	;
	1286	"RTN","PRC A313P",110 ,0)
	1287	; Set 1 l evel value s
	1288	"RTN","PRC A313P",111 ,0)
	1289	S DIC="^R CT(349.1," ,DIC(0)="L "
	1290	"RTN","PRC A313P",112 ,0)
	1291	S X=TT
	1292	"RTN","PRC A313P",113 ,0)
	1293	S DIC("DR ")=".02/// "_TTNAME_" ;.03///"_1 _";"
	1294	"RTN","PRC A313P",114 ,0)
	1295	D FILE^DI CN
	1296	"RTN","PRC A313P",115 ,0)
	1297	S IEN=+Y
	1298	"RTN","PRC A313P",116 ,0)
	1299	;
	1300	"RTN","PRC A313P",117 ,0)
	1301	; Set 3 l evel
	1302	"RTN","PRC A313P",118 ,0)
	1303	D SET3(IE N,.DOMAIN)
	1304	"RTN","PRC A313P",119 ,0)
	1305	;
	1306	"RTN","PRC A313P",120 ,0)
	1307	Q
	1308	"RTN","PRC A313P",121 ,0)
	1309	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1310	"RTN","PRC A313P",122 ,0)
	1311	; Set 3 l evel for 3 49.1
	1312	"RTN","PRC A313P",123 ,0)
	1313	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0))
	1314	"RTN","PRC A313P",124 ,0)
	1315	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1316	"RTN","PRC A313P",125 ,0)
	1317	; PRCA4. 5313 - Se t Cross-Re ferences f or this IE N
	1318	"RTN","PRC A313P",126 ,0)
	1319	S DA=IEN, DIK="^RCT( 349.1," D IX1^DIK
	1320	"RTN","PRC A313P",127 ,0)
	1321	;
	1322	"RTN","PRC A313P",128 ,0)
	1323	Q
	1324	"RTN","PRC A313P",129 ,0)
	1325	;
	1326	"RTN","PRC A313P",130 ,0)
	1327	PRE ; Pre -install a ctions for the Data Dictionary
	1328	"RTN","PRC A313P",131 ,0)
	1329	;
	1330	"RTN","PRC A313P",132 ,0)
	1331	D BMES^XP DUTL("Star ting Pre-I nstall Cha nges.")
	1332	"RTN","PRC A313P",133 ,0)
	1333	;
	1334	"RTN","PRC A313P",134 ,0)
	1335	N DIK,DA
	1336	"RTN","PRC A313P",135 ,0)
	1337	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered duri
	1338	ng regular install
	1339	"RTN","PRC A313P",136 ,0)
	1340	S DIK="^D D(349.1,", DA(1)=349. 1
	1341	"RTN","PRC A313P",137 ,0)
	1342	F DA=41,4 2,43 D ^DI K
	1343	"RTN","PRC A313P",138 ,0)
	1344	;
	1345	"RTN","PRC A313P",139 ,0)
	1346	; Remove DD for 349 , element .09 to cha nge from o ld to new Style Cros s Referen
	1347	ce.
	1348	"RTN","PRC A313P",140 ,0)
	1349	S DIK="^D D(349,",DA (1)=349
	1350	"RTN","PRC A313P",141 ,0)
	1351	S DA=.09 D ^DIK
	1352	"RTN","PRC A313P",142 ,0)
	1353	;
	1354	"RTN","PRC A313P",143 ,0)
	1355	D BMES^XP DUTL("Pre- Install Ch anges comp lete.")
	1356	"RTN","PRC A313P",144 ,0)
	1357	Q
	1358	"RTN","PRC A313P",145 ,0)
	1359	;
	1360	"RTN","PRC A313P",146 ,0)
	1361	PRCACPS ; Queue the Patient S tatement A uto-Correc tion Progr am
	1362	"RTN","PRC A313P",147 ,0)
	1363	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	1364	"RTN","PRC A313P",148 ,0)
	1365	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	1366	"RTN","PRC A313P",149 ,0)
	1367	S ZTRTN=" START^PRCA CPS",ZTDTH =$H,ZTIO=" "
	1368	"RTN","PRC A313P",150 ,0)
	1369	D ^%ZTLOA D
	1370	"RTN","PRC A313P",151 ,0)
	1371	I $G(ZTSK ) D Q
	1372	"RTN","PRC A313P",152 ,0)
	1373	.D BMES^X PDUTL(">>> POST-INSTA LL CONSOLI DATED PATI ENT STATEM ENT AUTO-C ORRECTION
	1374	")
	1375	"RTN","PRC A313P",153 ,0)
	1376	.D MES^XP DUTL(">>>P ROGRAM HAS BEEN QUEU ED IN TASK "_ZTSK)
	1377	"RTN","PRC A313P",154 ,0)
	1378	I '$G(ZTS K) D Q
	1379	"RTN","PRC A313P",155 ,0)
	1380	.D BMES^X PDUTL(">>> ERROR: POS T-INSTALL CONSOLIDAT ED PATIENT STATEMENT AUTO-COR
	1381	RECTION")
	1382	"RTN","PRC A313P",156 ,0)
	1383	.D MES^XP DUTL(">>>P ROGRAM COU LD NOT BE QUEUED")
	1384	"RTN","PRC A313P",157 ,0)
	1385	Q
	1386	"RTN","PRC AACR")
	1387	0^19^B1273 36081^n/a
	1388	"RTN","PRC AACR",1,0)
	1389	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1390	"RTN","PRC AACR",2,0)
	1391	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	1392	"RTN","PRC AACR",3,0)
	1393	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1394	"RTN","PRC AACR",4,0)
	1395	;
	1396	"RTN","PRC AACR",5,0)
	1397	Q
	1398	"RTN","PRC AACR",6,0)
	1399	;
	1400	"RTN","PRC AACR",7,0)
	1401	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corr
	1402	ected
	1403	"RTN","PRC AACR",8,0)
	1404	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1405	"RTN","PRC AACR",9,0)
	1406	W !
	1407	"RTN","PRC AACR",10,0 )
	1408	PSDATE ;
	1409	"RTN","PRC AACR",11,0 )
	1410	; Determi ne if Auto Correct p rocess is currently running
	1411	"RTN","PRC AACR",12,0 )
	1412	N PRCASTR T,QUIT,X,X 1,X2,Y
	1413	"RTN","PRC AACR",13,0 )
	1414	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1415	"RTN","PRC AACR",14,0 )
	1416	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1417	"RTN","PRC AACR",15,0 )
	1418	I PRCASTR T'="" D Q :QUIT
	1419	"RTN","PRC AACR",16,0 )
	1420	.S Y=$P(P RCASTRT,U, 2)
	1421	"RTN","PRC AACR",17,0 )
	1422	.D DD^%DT
	1423	"RTN","PRC AACR",18,0 )
	1424	.S PRCAST RT=Y
	1425	"RTN","PRC AACR",19,0 )
	1426	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1427	"RTN","PRC AACR",20,0 )
	1428	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1429	"RTN","PRC AACR",21,0 )
	1430	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of t
	1431	he"
	1432	"RTN","PRC AACR",22,0 )
	1433	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pr
	1434	ogram."
	1435	"RTN","PRC AACR",23,0 )
	1436	.W !
	1437	"RTN","PRC AACR",24,0 )
	1438	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1439	"RTN","PRC AACR",25,0 )
	1440	.D ^DIR
	1441	"RTN","PRC AACR",26,0 )
	1442	.W !
	1443	"RTN","PRC AACR",27,0 )
	1444	.; Quit i f ^, ^^, T imeout or No
	1445	"RTN","PRC AACR",28,0 )
	1446	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1447	"RTN","PRC AACR",29,0 )
	1448	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1449	"RTN","PRC AACR",30,0 )
	1450	.I Y=1 D PRCAMAIL^P RCACPSA(PR CASTRT)
	1451	"RTN","PRC AACR",31,0 )
	1452	.K DTOUT, DUOUT,DIRO UT
	1453	"RTN","PRC AACR",32,0 )
	1454	;
	1455	"RTN","PRC AACR",33,0 )
	1456	N DIROUT, DIS,DTOUT, DUOUT
	1457	"RTN","PRC AACR",34,0 )
	1458	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1459	"RTN","PRC AACR",35,0 )
	1460	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1461	"RTN","PRC AACR",36,0 )
	1462	S DIR(0)= "DO" D ^DI R
	1463	"RTN","PRC AACR",37,0 )
	1464	S:Y'="" P RCABDT=Y
	1465	"RTN","PRC AACR",38,0 )
	1466	I $D(DIRU T)&'Y K DI RUT Q
	1467	"RTN","PRC AACR",39,0 )
	1468	I PRCABDT >DT G PSDA TE
	1469	"RTN","PRC AACR",40,0 )
	1470	W "(",Y(0 ),")"
	1471	"RTN","PRC AACR",41,0 )
	1472	K DIR,X,Y
	1473	"RTN","PRC AACR",42,0 )
	1474	S DIR(0)= "DO"
	1475	"RTN","PRC AACR",43,0 )
	1476	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1477	"RTN","PRC AACR",44,0 )
	1478	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1479	"RTN","PRC AACR",45,0 )
	1480	D ^DIR S: Y="" Y=DT
	1481	"RTN","PRC AACR",46,0 )
	1482	I $D(DIRU T)&'Y K DI RUT Q
	1483	"RTN","PRC AACR",47,0 )
	1484	W "(",Y(0 ),")"
	1485	"RTN","PRC AACR",48,0 )
	1486	S PRCAEDT =Y
	1487	"RTN","PRC AACR",49,0 )
	1488	I PRCABDT >PRCAEDT G PSDATE
	1489	"RTN","PRC AACR",50,0 )
	1490	K DIR
	1491	"RTN","PRC AACR",51,0 )
	1492	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Nu
	1493	mber;5:Aut o-Correct Date",DIR( "A")="Sort by"
	1494	"RTN","PRC AACR",52,0 )
	1495	S DIR("B" )=1
	1496	"RTN","PRC AACR",53,0 )
	1497	D ^DIR K DIR
	1498	"RTN","PRC AACR",54,0 )
	1499	S PRCASOR T=Y
	1500	"RTN","PRC AACR",55,0 )
	1501	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1502	"RTN","PRC AACR",56,0 )
	1503	;
	1504	"RTN","PRC AACR",57,0 )
	1505	; Prompt for device
	1506	"RTN","PRC AACR",58,0 )
	1507	W !
	1508	"RTN","PRC AACR",59,0 )
	1509	N ZTRTN,Z TDESC,ZTSA VE,ZTSK
	1510	"RTN","PRC AACR",60,0 )
	1511	K IOP,%ZI S,POP,IO(" Q")
	1512	"RTN","PRC AACR",61,0 )
	1513	S %ZIS="Q "
	1514	"RTN","PRC AACR",62,0 )
	1515	D ^%ZIS Q :POP
	1516	"RTN","PRC AACR",63,0 )
	1517	; If Queu ed
	1518	"RTN","PRC AACR",64,0 )
	1519	I $D(IO(" Q")) D Q
	1520	"RTN","PRC AACR",65,0 )
	1521	.K IO("Q" )
	1522	"RTN","PRC AACR",66,0 )
	1523	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1524	"RTN","PRC AACR",67,0 )
	1525	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1526	"RTN","PRC AACR",68,0 )
	1527	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1528	"RTN","PRC AACR",69,0 )
	1529	.D ^%ZTLO AD
	1530	"RTN","PRC AACR",70,0 )
	1531	.D HOME^% ZIS
	1532	"RTN","PRC AACR",71,0 )
	1533	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	1534	"RTN","PRC AACR",72,0 )
	1535	.E W !!? 5,"Report queued!"
	1536	"RTN","PRC AACR",73,0 )
	1537	.K POP
	1538	"RTN","PRC AACR",74,0 )
	1539	;
	1540	"RTN","PRC AACR",75,0 )
	1541	;Print Re port if no t QUEUED
	1542	"RTN","PRC AACR",76,0 )
	1543	PRT ;
	1544	"RTN","PRC AACR",77,0 )
	1545	; If not queued and output se nt to P-ME S
	1546	"RTN","PRC AACR",78,0 )
	1547	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1548	"RTN","PRC AACR",79,0 )
	1549	;If not q ueued and output not sent to P -MES
	1550	"RTN","PRC AACR",80,0 )
	1551	U IO
	1552	"RTN","PRC AACR",81,0 )
	1553	K ^TMP("P RCAACR",$J )
	1554	"RTN","PRC AACR",82,0 )
	1555	S PAGE=0
	1556	"RTN","PRC AACR",83,0 )
	1557	S DASH="" ,$P(DASH," -",79)=""
	1558	"RTN","PRC AACR",84,0 )
	1559	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1560	"RTN","PRC AACR",85,0 )
	1561	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRC
	1562	ATNTF
	1563	"RTN","PRC AACR",86,0 )
	1564	S PRCATSR T=PRCABDT- .00001
	1565	"RTN","PRC AACR",87,0 )
	1566	; Loop th rough the specified date range
	1567	"RTN","PRC AACR",88,0 )
	1568	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	1569	D
	1570	"RTN","PRC AACR",89,0 )
	1571	.S PRCATN =""
	1572	"RTN","PRC AACR",90,0 )
	1573	.; Loop t hrough the transacti ons for th e current date
	1574	"RTN","PRC AACR",91,0 )
	1575	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1576	"RTN","PRC AACR",92,0 )
	1577	..; Load associated data fiel ds for rep ort
	1578	"RTN","PRC AACR",93,0 )
	1579	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1580	"RTN","PRC AACR",94,0 )
	1581	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1582	"RTN","PRC AACR",95,0 )
	1583	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1584	"RTN","PRC AACR",96,0 )
	1585	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1586	"RTN","PRC AACR",97,0 )
	1587	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1588	"RTN","PRC AACR",98,0 )
	1589	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1590	"RTN","PRC AACR",99,0 )
	1591	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1592	"RTN","PRC AACR",100, 0)
	1593	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1594	"RTN","PRC AACR",101, 0)
	1595	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1596	"RTN","PRC AACR",102, 0)
	1597	..S PRCAA CR=$E(PRCA ACR,1,14)
	1598	"RTN","PRC AACR",103, 0)
	1599	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1600	"RTN","PRC AACR",104, 0)
	1601	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1602	"RTN","PRC AACR",105, 0)
	1603	..I PRCAA CTF="YES" S PRCATNTF =""
	1604	"RTN","PRC AACR",106, 0)
	1605	..;
	1606	"RTN","PRC AACR",107, 0)
	1607	..; If an y of the n odes are n ull Quit
	1608	"RTN","PRC AACR",108, 0)
	1609	..I PRCAA CR=""!(PRC ADTR="")!( PRCABN="") !(PRCATN=" ")!(PRCAAC D="") Q
	1610	"RTN","PRC AACR",109, 0)
	1611	..;
	1612	"RTN","PRC AACR",110, 0)
	1613	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	1614	"RTN","PRC AACR",111, 0)
	1615	..I PRCAS ORT=1 D Q
	1616	"RTN","PRC AACR",112, 0)
	1617	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	1618	CATNTF_U_P RCAACD_U_P RCASSN
	1619	"RTN","PRC AACR",113, 0)
	1620	..;
	1621	"RTN","PRC AACR",114, 0)
	1622	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1623	"RTN","PRC AACR",115, 0)
	1624	..I PRCAS ORT=2 D Q
	1625	"RTN","PRC AACR",116, 0)
	1626	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	1627	ATNTF_U_PR CAACD_U_PR CAACR
	1628	"RTN","PRC AACR",117, 0)
	1629	..;
	1630	"RTN","PRC AACR",118, 0)
	1631	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1632	"RTN","PRC AACR",119, 0)
	1633	..I PRCAS ORT=3 D Q
	1634	"RTN","PRC AACR",120, 0)
	1635	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	1636	ATNTF_U_PR CAACD_U_PR CAACR
	1637	"RTN","PRC AACR",121, 0)
	1638	..;
	1639	"RTN","PRC AACR",122, 0)
	1640	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	1641	"RTN","PRC AACR",123, 0)
	1642	..I PRCAS ORT=4 D Q
	1643	"RTN","PRC AACR",124, 0)
	1644	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	1645	CASSN_U_PR CAACD_U_PR CAACR
	1646	"RTN","PRC AACR",125, 0)
	1647	..;
	1648	"RTN","PRC AACR",126, 0)
	1649	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Tran
	1650	saction Nu mber
	1651	"RTN","PRC AACR",127, 0)
	1652	..I PRCAS ORT=5 D Q
	1653	"RTN","PRC AACR",128, 0)
	1654	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	1655	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1656	"RTN","PRC AACR",129, 0)
	1657	;
	1658	"RTN","PRC AACR",130, 0)
	1659	;
	1660	"RTN","PRC AACR",131, 0)
	1661	N QUIT ; QUIT befor e end of r eport
	1662	"RTN","PRC AACR",132, 0)
	1663	S QUIT=""
	1664	"RTN","PRC AACR",133, 0)
	1665	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	1666	"RTN","PRC AACR",134, 0)
	1667	I PRCASOR T=1 D
	1668	"RTN","PRC AACR",135, 0)
	1669	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	1670	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	1671	"RTN","PRC AACR",136, 0)
	1672	.; Displa y Auto Cor rection Re ason heade r
	1673	"RTN","PRC AACR",137, 0)
	1674	.N Y
	1675	"RTN","PRC AACR",138, 0)
	1676	.D PSACRT P1
	1677	"RTN","PRC AACR",139, 0)
	1678	.S PRCAAC R=""
	1679	"RTN","PRC AACR",140, 0)
	1680	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	1681	"RTN","PRC AACR",141, 0)
	1682	..S PRCAD TR=""
	1683	"RTN","PRC AACR",142, 0)
	1684	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1685	"RTN","PRC AACR",143, 0)
	1686	...S PRCA BN=""
	1687	"RTN","PRC AACR",144, 0)
	1688	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	1689	UIT
	1690	"RTN","PRC AACR",145, 0)
	1691	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	1692	"RTN","PRC AACR",146, 0)
	1693	....S Y=$ P(PRCADATA ,U,5)
	1694	"RTN","PRC AACR",147, 0)
	1695	....D DD^ %DT
	1696	"RTN","PRC AACR",148, 0)
	1697	....S $P( PRCADATA,U ,5)=Y
	1698	"RTN","PRC AACR",149, 0)
	1699	....W !,$ P(PRCADATA ,U,1),?16, $E($P(PRCA DATA,U,2), 1,18),?36, $E($P(PRCA DATA,U,6)
	1700	,6,9),?42, $E($P(PRCA DATA,U,3), 1,11),?55, $J($P(PRCA DATA,U,4), 9),?66,$P( PRCADATA,
	1701	U,5)
	1702	"RTN","PRC AACR",150, 0)
	1703	....I $Y> (IOSL-3) D
	1704	"RTN","PRC AACR",151, 0)
	1705	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1706	"RTN","PRC AACR",152, 0)
	1707	......D P RTC
	1708	"RTN","PRC AACR",153, 0)
	1709	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1710	"RTN","PRC AACR",154, 0)
	1711	.....D PS ACRTP1
	1712	"RTN","PRC AACR",155, 0)
	1713	;
	1714	"RTN","PRC AACR",156, 0)
	1715	; Display Auto-Corr ect data s orted by D ebtor
	1716	"RTN","PRC AACR",157, 0)
	1717	I PRCASOR T=2 D
	1718	"RTN","PRC AACR",158, 0)
	1719	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	1720	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1721	"RTN","PRC AACR",159, 0)
	1722	.; Displa y Debtor h eader
	1723	"RTN","PRC AACR",160, 0)
	1724	.D PSACRT P2
	1725	"RTN","PRC AACR",161, 0)
	1726	.S PRCADT R=""
	1727	"RTN","PRC AACR",162, 0)
	1728	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1729	"RTN","PRC AACR",163, 0)
	1730	..S PRCAB N=""
	1731	"RTN","PRC AACR",164, 0)
	1732	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1733	"RTN","PRC AACR",165, 0)
	1734	...S PRCA TN=""
	1735	"RTN","PRC AACR",166, 0)
	1736	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QU
	1737	IT
	1738	"RTN","PRC AACR",167, 0)
	1739	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1740	"RTN","PRC AACR",168, 0)
	1741	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1742	"RTN","PRC AACR",169, 0)
	1743	....W !,$ E($P(PRCAD ATA,U,1),1 ,18),?20,$ P(PRCADATA ,U,2),?33, $E($P(PRCA DATA,U,3)
	1744	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1745	"RTN","PRC AACR",170, 0)
	1746	....I $Y> (IOSL-3) D
	1747	"RTN","PRC AACR",171, 0)
	1748	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1749	"RTN","PRC AACR",172, 0)
	1750	......D P RTC
	1751	"RTN","PRC AACR",173, 0)
	1752	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1753	"RTN","PRC AACR",174, 0)
	1754	.....D PS ACRTP2
	1755	"RTN","PRC AACR",175, 0)
	1756	;
	1757	"RTN","PRC AACR",176, 0)
	1758	; Display Auto-Corr ect data s orted by A UTO-C DATE
	1759	"RTN","PRC AACR",177, 0)
	1760	I PRCASOR T=3 D
	1761	"RTN","PRC AACR",178, 0)
	1762	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	1763	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	1764	"RTN","PRC AACR",179, 0)
	1765	.; Displa y Bill Num ber header
	1766	"RTN","PRC AACR",180, 0)
	1767	.D PSACRT P3
	1768	"RTN","PRC AACR",181, 0)
	1769	.S PRCABN =""
	1770	"RTN","PRC AACR",182, 0)
	1771	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1772	"RTN","PRC AACR",183, 0)
	1773	..S PRCAD TR=""
	1774	"RTN","PRC AACR",184, 0)
	1775	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1776	"RTN","PRC AACR",185, 0)
	1777	...S PRCA TN=""
	1778	"RTN","PRC AACR",186, 0)
	1779	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QU
	1780	IT
	1781	"RTN","PRC AACR",187, 0)
	1782	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1783	"RTN","PRC AACR",188, 0)
	1784	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1785	"RTN","PRC AACR",189, 0)
	1786	....W !,$ P(PRCADATA ,U,1),?13, $E($P(PRCA DATA,U,2), 1,18),?33, $E($P(PRCA DATA,U,3)
	1787	,6,9),?39, $J($P(PRCA DATA,U,4), 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1788	"RTN","PRC AACR",190, 0)
	1789	....I $Y> (IOSL-3) D
	1790	"RTN","PRC AACR",191, 0)
	1791	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1792	"RTN","PRC AACR",192, 0)
	1793	......D P RTC
	1794	"RTN","PRC AACR",193, 0)
	1795	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1796	"RTN","PRC AACR",194, 0)
	1797	.....D PS ACRTP3
	1798	"RTN","PRC AACR",195, 0)
	1799	;
	1800	"RTN","PRC AACR",196, 0)
	1801	; Display Auto-Corr ect data s orted by T ransaction Number
	1802	"RTN","PRC AACR",197, 0)
	1803	I PRCASOR T=4 D
	1804	"RTN","PRC AACR",198, 0)
	1805	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	1806	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	1807	"RTN","PRC AACR",199, 0)
	1808	.; Displa y AUTO-C D ATE header
	1809	"RTN","PRC AACR",200, 0)
	1810	.D PSACRT P4
	1811	"RTN","PRC AACR",201, 0)
	1812	.S PRCATN =""
	1813	"RTN","PRC AACR",202, 0)
	1814	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	1815	"RTN","PRC AACR",203, 0)
	1816	..S PRCAD TR=""
	1817	"RTN","PRC AACR",204, 0)
	1818	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1819	"RTN","PRC AACR",205, 0)
	1820	...S PRCA BN=""
	1821	"RTN","PRC AACR",206, 0)
	1822	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QU
	1823	IT
	1824	"RTN","PRC AACR",207, 0)
	1825	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	1826	"RTN","PRC AACR",208, 0)
	1827	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1828	"RTN","PRC AACR",209, 0)
	1829	....W !,$ J($P(PRCAD ATA,U,1),9 ),?11,$E($ P(PRCADATA ,U,2),1,18 ),?31,$P(P RCADATA,U
	1830	,3),?44,$E ($P(PRCADA TA,U,4),6, 9),?50,$P( PRCADATA,U ,5),?64,$P (PRCADATA, U,6)
	1831	"RTN","PRC AACR",210, 0)
	1832	....I $Y> (IOSL-3) D
	1833	"RTN","PRC AACR",211, 0)
	1834	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1835	"RTN","PRC AACR",212, 0)
	1836	......D P RTC
	1837	"RTN","PRC AACR",213, 0)
	1838	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1839	"RTN","PRC AACR",214, 0)
	1840	.....D PS ACRTP4
	1841	"RTN","PRC AACR",215, 0)
	1842	;
	1843	"RTN","PRC AACR",216, 0)
	1844	; Display Auto-Corr ect data s orted by A uto-Correc t date
	1845	"RTN","PRC AACR",217, 0)
	1846	I PRCASOR T=5 D
	1847	"RTN","PRC AACR",218, 0)
	1848	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	1849	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	1850	"RTN","PRC AACR",219, 0)
	1851	.; Displa y AUTO-C D ATE header
	1852	"RTN","PRC AACR",220, 0)
	1853	.D PSACRT P5
	1854	"RTN","PRC AACR",221, 0)
	1855	.S PRCAAC D=""
	1856	"RTN","PRC AACR",222, 0)
	1857	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	1858	"RTN","PRC AACR",223, 0)
	1859	..S PRCAD TR=""
	1860	"RTN","PRC AACR",224, 0)
	1861	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1862	"RTN","PRC AACR",225, 0)
	1863	...S PRCA BN=""
	1864	"RTN","PRC AACR",226, 0)
	1865	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:Q
	1866	UIT
	1867	"RTN","PRC AACR",227, 0)
	1868	....S PRC ATN=""
	1869	"RTN","PRC AACR",228, 0)
	1870	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	1871	D Q:QUI T
	1872	"RTN","PRC AACR",229, 0)
	1873	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	1874	"RTN","PRC AACR",230, 0)
	1875	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	1876	"RTN","PRC AACR",231, 0)
	1877	.....W !, $P(PRCADAT A,U,1),?14 ,$E($P(PRC ADATA,U,2) ,1,18),?34 ,$P(PRCADA TA,U,3),?
	1878	47,$E($P(P RCADATA,U, 4),6,9),?5 3,$J($P(PR CADATA,U,5 ),9),?64,$ P(PRCADATA ,U,6)
	1879	"RTN","PRC AACR",232, 0)
	1880	.....I $Y >(IOSL-3) D
	1881	"RTN","PRC AACR",233, 0)
	1882	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	1883	"RTN","PRC AACR",234, 0)
	1884	.......D PRTC
	1885	"RTN","PRC AACR",235, 0)
	1886	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	1887	"RTN","PRC AACR",236, 0)
	1888	......D P SACRTP5
	1889	"RTN","PRC AACR",237, 0)
	1890	D ^%ZISC
	1891	"RTN","PRC AACR",238, 0)
	1892	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	1893	"RTN","PRC AACR",239, 0)
	1894	K X,Y,DAS H,D0
	1895	"RTN","PRC AACR",240, 0)
	1896	Q
	1897	"RTN","PRC AACR",241, 0)
	1898	;
	1899	"RTN","PRC AACR",242, 0)
	1900	PRTC ; Pre ss Return To Continu e
	1901	"RTN","PRC AACR",243, 0)
	1902	S DIR(0)= "E" D ^DIR
	1903	"RTN","PRC AACR",244, 0)
	1904	Q
	1905	"RTN","PRC AACR",245, 0)
	1906	;
	1907	"RTN","PRC AACR",246, 0)
	1908	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	1909	"RTN","PRC AACR",247, 0)
	1910	W @IOF
	1911	"RTN","PRC AACR",248, 0)
	1912	S PAGE=PA GE+1
	1913	"RTN","PRC AACR",249, 0)
	1914	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION RE ASON)",?6
	1915	6,$$UPPER^ VALM1($$FM TE^XLFDT(D T))
	1916	"RTN","PRC AACR",250, 0)
	1917	W !,DASH, !
	1918	"RTN","PRC AACR",251, 0)
	1919	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66,
	1920	"AUTO-C DA TE"
	1921	"RTN","PRC AACR",252, 0)
	1922	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55
	1923	,"-------- -",?66,"-- ---------- "
	1924	"RTN","PRC AACR",253, 0)
	1925	Q
	1926	"RTN","PRC AACR",254, 0)
	1927	;
	1928	"RTN","PRC AACR",255, 0)
	1929	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	1930	"RTN","PRC AACR",256, 0)
	1931	W @IOF
	1932	"RTN","PRC AACR",257, 0)
	1933	S PAGE=PA GE+1
	1934	"RTN","PRC AACR",258, 0)
	1935	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y DEBTOR)" ,?66,$$UPP ER^VALM1(
	1936	$$FMTE^XLF DT(DT))
	1937	"RTN","PRC AACR",259, 0)
	1938	W !,DASH, !
	1939	"RTN","PRC AACR",260, 0)
	1940	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	1941	UTO-C REAS ON"
	1942	"RTN","PRC AACR",261, 0)
	1943	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---
	1944	---------" ,?64,"---- ---------- "
	1945	"RTN","PRC AACR",262, 0)
	1946	Q
	1947	"RTN","PRC AACR",263, 0)
	1948	;
	1949	"RTN","PRC AACR",264, 0)
	1950	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	1951	"RTN","PRC AACR",265, 0)
	1952	W @IOF
	1953	"RTN","PRC AACR",266, 0)
	1954	S PAGE=PA GE+1
	1955	"RTN","PRC AACR",267, 0)
	1956	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL #)" ,?66,$$UPP ER^VALM1(
	1957	$$FMTE^XLF DT(DT))
	1958	"RTN","PRC AACR",268, 0)
	1959	W !,DASH, !
	1960	"RTN","PRC AACR",269, 0)
	1961	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"A
	1962	UTO-C REAS ON"
	1963	"RTN","PRC AACR",270, 0)
	1964	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---
	1965	---------" ,?64,"---- ---------- "
	1966	"RTN","PRC AACR",271, 0)
	1967	Q
	1968	"RTN","PRC AACR",272, 0)
	1969	;
	1970	"RTN","PRC AACR",273, 0)
	1971	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	1972	"RTN","PRC AACR",274, 0)
	1973	W @IOF
	1974	"RTN","PRC AACR",275, 0)
	1975	S PAGE=PA GE+1
	1976	"RTN","PRC AACR",276, 0)
	1977	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION NUMBER )",?66,$$
	1978	UPPER^VALM 1($$FMTE^X LFDT(DT))
	1979	"RTN","PRC AACR",277, 0)
	1980	W !,DASH, !
	1981	"RTN","PRC AACR",278, 0)
	1982	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"A
	1983	UTO-C REAS ON"
	1984	"RTN","PRC AACR",279, 0)
	1985	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---
	1986	---------" ,?64,"---- ---------- "
	1987	"RTN","PRC AACR",280, 0)
	1988	Q
	1989	"RTN","PRC AACR",281, 0)
	1990	;
	1991	"RTN","PRC AACR",282, 0)
	1992	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	1993	"RTN","PRC AACR",283, 0)
	1994	W @IOF
	1995	"RTN","PRC AACR",284, 0)
	1996	S PAGE=PA GE+1
	1997	"RTN","PRC AACR",285, 0)
	1998	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION DA TE)",?66,
	1999	$$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2000	"RTN","PRC AACR",286, 0)
	2001	W !,DASH, !
	2002	"RTN","PRC AACR",287, 0)
	2003	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"A
	2004	UTO-C REAS ON"
	2005	"RTN","PRC AACR",288, 0)
	2006	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"
	2007	---------" ,?64,"---- ---------- "
	2008	"RTN","PRC AACR",289, 0)
	2009	Q
	2010	"RTN","PRC AACR",290, 0)
	2011	;
	2012	"RTN","PRC AACR",291, 0)
	2013	EXIT ;
	2014	"RTN","PRC AACR",292, 0)
	2015	Q
	2016	"RTN","PRC AACR1")
	2017	0^20^B1512 71441^n/a
	2018	"RTN","PRC AACR1",1,0 )
	2019	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 P
	2020	M
	2021	"RTN","PRC AACR1",2,0 )
	2022	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	2023	"RTN","PRC AACR1",3,0 )
	2024	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2025	"RTN","PRC AACR1",4,0 )
	2026	;
	2027	"RTN","PRC AACR1",5,0 )
	2028	Q
	2029	"RTN","PRC AACR1",6,0 )
	2030	;Print Re port when Queued to P-MES
	2031	"RTN","PRC AACR1",7,0 )
	2032	PRT ;
	2033	"RTN","PRC AACR1",8,0 )
	2034	U IO
	2035	"RTN","PRC AACR1",9,0 )
	2036	; build a rray of tr ansaction auto-corre cted
	2037	"RTN","PRC AACR1",10, 0)
	2038	K ^TMP("P RCAACR1",$ J)
	2039	"RTN","PRC AACR1",11, 0)
	2040	N DASH,PA GE
	2041	"RTN","PRC AACR1",12, 0)
	2042	S PAGE=0
	2043	"RTN","PRC AACR1",13, 0)
	2044	S DASH="" ,$P(DASH," -",79)=""
	2045	"RTN","PRC AACR1",14, 0)
	2046	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AIEN,PRCA
	2047	ACTF,PRCAT NTF,PRCATE MP
	2048	"RTN","PRC AACR1",15, 0)
	2049	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2050	"RTN","PRC AACR1",16, 0)
	2051	; Loop th rough the specified date range
	2052	"RTN","PRC AACR1",17, 0)
	2053	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT)
	2054	D
	2055	"RTN","PRC AACR1",18, 0)
	2056	.S PRCATN =""
	2057	"RTN","PRC AACR1",19, 0)
	2058	.; Loop t hrough the transacti ons for th e current date
	2059	"RTN","PRC AACR1",20, 0)
	2060	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2061	"RTN","PRC AACR1",21, 0)
	2062	..; Load associated data fiel ds for rep ort
	2063	"RTN","PRC AACR1",22, 0)
	2064	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2065	"RTN","PRC AACR1",23, 0)
	2066	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2067	"RTN","PRC AACR1",24, 0)
	2068	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2069	"RTN","PRC AACR1",25, 0)
	2070	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2071	"RTN","PRC AACR1",26, 0)
	2072	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2073	"RTN","PRC AACR1",27, 0)
	2074	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2075	"RTN","PRC AACR1",28, 0)
	2076	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2077	"RTN","PRC AACR1",29, 0)
	2078	..S PRCAS SN=$E(PRCA SSN,6,9)
	2079	"RTN","PRC AACR1",30, 0)
	2080	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2081	"RTN","PRC AACR1",31, 0)
	2082	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2083	"RTN","PRC AACR1",32, 0)
	2084	..S PRCAA CR=$E(PRCA ACR,1,14)
	2085	"RTN","PRC AACR1",33, 0)
	2086	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2087	"RTN","PRC AACR1",34, 0)
	2088	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2089	"RTN","PRC AACR1",35, 0)
	2090	..I PRCAA CTF="YES" S PRCATNTF =""
	2091	"RTN","PRC AACR1",36, 0)
	2092	..;
	2093	"RTN","PRC AACR1",37, 0)
	2094	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2095	"RTN","PRC AACR1",38, 0)
	2096	..I PRCAS ORT=1 D Q
	2097	"RTN","PRC AACR1",39, 0)
	2098	...S ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_PR CABN_U_PR
	2099	CATNTF_U_P RCAACD_U_P RCASSN
	2100	"RTN","PRC AACR1",40, 0)
	2101	..;
	2102	"RTN","PRC AACR1",41, 0)
	2103	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2104	"RTN","PRC AACR1",42, 0)
	2105	..I PRCAS ORT=2 D Q
	2106	"RTN","PRC AACR1",43, 0)
	2107	...S ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRCA SSN_U_PRC
	2108	ATNTF_U_PR CAACD_U_PR CAACR
	2109	"RTN","PRC AACR1",44, 0)
	2110	..;
	2111	"RTN","PRC AACR1",45, 0)
	2112	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2113	"RTN","PRC AACR1",46, 0)
	2114	..I PRCAS ORT=3 D Q
	2115	"RTN","PRC AACR1",47, 0)
	2116	...S ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRCA SSN_U_PRC
	2117	ATNTF_U_PR CAACD_U_PR CAACR
	2118	"RTN","PRC AACR1",48, 0)
	2119	..;
	2120	"RTN","PRC AACR1",49, 0)
	2121	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2122	"RTN","PRC AACR1",50, 0)
	2123	..I PRCAS ORT=4 D Q
	2124	"RTN","PRC AACR1",51, 0)
	2125	...S ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_PR CABN_U_PR
	2126	CASSN_U_PR CAACD_U_PR CAACR
	2127	"RTN","PRC AACR1",52, 0)
	2128	..;
	2129	"RTN","PRC AACR1",53, 0)
	2130	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transa
	2131	ction Numb er
	2132	"RTN","PRC AACR1",54, 0)
	2133	..I PRCAS ORT=5 D Q
	2134	"RTN","PRC AACR1",55, 0)
	2135	...S ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCAD TR_U_PRCA
	2136	BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2137	"RTN","PRC AACR1",56, 0)
	2138	..Q
	2139	"RTN","PRC AACR1",57, 0)
	2140	;
	2141	"RTN","PRC AACR1",58, 0)
	2142	; Display Auto-Corr ect data s orted by B ill Number
	2143	"RTN","PRC AACR1",59, 0)
	2144	I PRCASOR T=1 D
	2145	"RTN","PRC AACR1",60, 0)
	2146	.; Print Header
	2147	"RTN","PRC AACR1",61, 0)
	2148	.D PSACRT P1
	2149	"RTN","PRC AACR1",62, 0)
	2150	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)=PR CAACR_U_PR CADTR_U_P
	2151	RCABN_U_PR CATNTF_U_P RCAACD_U_P RCASSN
	2152	"RTN","PRC AACR1",63, 0)
	2153	.S PRCAAC R=""
	2154	"RTN","PRC AACR1",64, 0)
	2155	.N Y
	2156	"RTN","PRC AACR1",65, 0)
	2157	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2158	"RTN","PRC AACR1",66, 0)
	2159	..S PRCAD TR=""
	2160	"RTN","PRC AACR1",67, 0)
	2161	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2162	"RTN","PRC AACR1",68, 0)
	2163	...S PRCA BN=""
	2164	"RTN","PRC AACR1",69, 0)
	2165	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2166	"RTN","PRC AACR1",70, 0)
	2167	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2168	"RTN","PRC AACR1",71, 0)
	2169	....S Y=$ P(PRCADATA ,U,5)
	2170	"RTN","PRC AACR1",72, 0)
	2171	....D DD^ %DT
	2172	"RTN","PRC AACR1",73, 0)
	2173	....S $P( PRCADATA,U ,5)=Y
	2174	"RTN","PRC AACR1",74, 0)
	2175	....S PRC AIEN=PRCAI EN+1
	2176	"RTN","PRC AACR1",75, 0)
	2177	....; Add Auto-Corr ect Reason
	2178	"RTN","PRC AACR1",76, 0)
	2179	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2180	"RTN","PRC AACR1",77, 0)
	2181	....; Add 18 chars of Debtor' s name
	2182	"RTN","PRC AACR1",78, 0)
	2183	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2184	"RTN","PRC AACR1",79, 0)
	2185	....; Add SSN
	2186	"RTN","PRC AACR1",80, 0)
	2187	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2188	"RTN","PRC AACR1",81, 0)
	2189	....; Add Bill Numb er
	2190	"RTN","PRC AACR1",82, 0)
	2191	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2192	"RTN","PRC AACR1",83, 0)
	2193	....; Add Transacti on Number
	2194	"RTN","PRC AACR1",84, 0)
	2195	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2196	"RTN","PRC AACR1",85, 0)
	2197	....; Add Auto-Corr ect Date
	2198	"RTN","PRC AACR1",86, 0)
	2199	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2200	"RTN","PRC AACR1",87, 0)
	2201	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2202	"RTN","PRC AACR1",88, 0)
	2203	....Q
	2204	"RTN","PRC AACR1",89, 0)
	2205	;
	2206	"RTN","PRC AACR1",90, 0)
	2207	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2208	"RTN","PRC AACR1",91, 0)
	2209	I PRCASOR T=2 D
	2210	"RTN","PRC AACR1",92, 0)
	2211	.; Print Header
	2212	"RTN","PRC AACR1",93, 0)
	2213	.D PSACRT P2
	2214	"RTN","PRC AACR1",94, 0)
	2215	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)=PRC ADTR_U_PRC ABN_U_PRC
	2216	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2217	"RTN","PRC AACR1",95, 0)
	2218	.S PRCADT R=""
	2219	"RTN","PRC AACR1",96, 0)
	2220	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2221	"RTN","PRC AACR1",97, 0)
	2222	..S PRCAB N=""
	2223	"RTN","PRC AACR1",98, 0)
	2224	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2225	"RTN","PRC AACR1",99, 0)
	2226	...S PRCA TN=""
	2227	"RTN","PRC AACR1",100 ,0)
	2228	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2229	"RTN","PRC AACR1",101 ,0)
	2230	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2231	"RTN","PRC AACR1",102 ,0)
	2232	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2233	"RTN","PRC AACR1",103 ,0)
	2234	....S PRC AIEN=PRCAI EN+1
	2235	"RTN","PRC AACR1",104 ,0)
	2236	....; Add 18 chars of Debtor' s name
	2237	"RTN","PRC AACR1",105 ,0)
	2238	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2239	"RTN","PRC AACR1",106 ,0)
	2240	....; Add Bill Numb er
	2241	"RTN","PRC AACR1",107 ,0)
	2242	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2243	"RTN","PRC AACR1",108 ,0)
	2244	....; Add SSN
	2245	"RTN","PRC AACR1",109 ,0)
	2246	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2247	"RTN","PRC AACR1",110 ,0)
	2248	....; Add Transacti on Number
	2249	"RTN","PRC AACR1",111 ,0)
	2250	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2251	"RTN","PRC AACR1",112 ,0)
	2252	....; Add Auto-Corr ect Date
	2253	"RTN","PRC AACR1",113 ,0)
	2254	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2255	"RTN","PRC AACR1",114 ,0)
	2256	....; Add Auto-Corr ect Reason
	2257	"RTN","PRC AACR1",115 ,0)
	2258	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2259	"RTN","PRC AACR1",116 ,0)
	2260	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2261	"RTN","PRC AACR1",117 ,0)
	2262	....Q
	2263	"RTN","PRC AACR1",118 ,0)
	2264	;
	2265	"RTN","PRC AACR1",119 ,0)
	2266	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transacti
	2267	on #
	2268	"RTN","PRC AACR1",120 ,0)
	2269	I PRCASOR T=3 D
	2270	"RTN","PRC AACR1",121 ,0)
	2271	.; Print Header
	2272	"RTN","PRC AACR1",122 ,0)
	2273	.D PSACRT P3
	2274	"RTN","PRC AACR1",123 ,0)
	2275	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)=PRC ABN_U_PRCA DTR_U_PRC
	2276	ASSN_U_PRC ATNTF_U_PR CAACD_U_PR CAACR
	2277	"RTN","PRC AACR1",124 ,0)
	2278	.S PRCABN =""
	2279	"RTN","PRC AACR1",125 ,0)
	2280	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2281	"RTN","PRC AACR1",126 ,0)
	2282	..S PRCAD TR=""
	2283	"RTN","PRC AACR1",127 ,0)
	2284	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2285	"RTN","PRC AACR1",128 ,0)
	2286	...S PRCA TN=""
	2287	"RTN","PRC AACR1",129 ,0)
	2288	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2289	"RTN","PRC AACR1",130 ,0)
	2290	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2291	"RTN","PRC AACR1",131 ,0)
	2292	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2293	"RTN","PRC AACR1",132 ,0)
	2294	....S PRC AIEN=PRCAI EN+1
	2295	"RTN","PRC AACR1",133 ,0)
	2296	....; Add Bill Numb er
	2297	"RTN","PRC AACR1",134 ,0)
	2298	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2299	"RTN","PRC AACR1",135 ,0)
	2300	....; Add 18 chars of Debtor' s name
	2301	"RTN","PRC AACR1",136 ,0)
	2302	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2303	"RTN","PRC AACR1",137 ,0)
	2304	....; Add SSN
	2305	"RTN","PRC AACR1",138 ,0)
	2306	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2307	"RTN","PRC AACR1",139 ,0)
	2308	....; Add Transacti on Number
	2309	"RTN","PRC AACR1",140 ,0)
	2310	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2311	"RTN","PRC AACR1",141 ,0)
	2312	....; Add Auto-Corr ect Date
	2313	"RTN","PRC AACR1",142 ,0)
	2314	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2315	"RTN","PRC AACR1",143 ,0)
	2316	....; Add Auto-Corr ect Reason
	2317	"RTN","PRC AACR1",144 ,0)
	2318	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2319	"RTN","PRC AACR1",145 ,0)
	2320	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2321	"RTN","PRC AACR1",146 ,0)
	2322	....Q
	2323	"RTN","PRC AACR1",147 ,0)
	2324	;
	2325	"RTN","PRC AACR1",148 ,0)
	2326	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2327	"RTN","PRC AACR1",149 ,0)
	2328	I PRCASOR T=4 D
	2329	"RTN","PRC AACR1",150 ,0)
	2330	.; Print Header
	2331	"RTN","PRC AACR1",151 ,0)
	2332	.D PSACRT P4
	2333	"RTN","PRC AACR1",152 ,0)
	2334	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)=PRC ATNTF_U_PR CADTR_U_P
	2335	RCABN_U_PR CASSN_U_PR CAACD_U_PR CAACR
	2336	"RTN","PRC AACR1",153 ,0)
	2337	.S PRCATN =""
	2338	"RTN","PRC AACR1",154 ,0)
	2339	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2340	"RTN","PRC AACR1",155 ,0)
	2341	..S PRCAD TR=""
	2342	"RTN","PRC AACR1",156 ,0)
	2343	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2344	"RTN","PRC AACR1",157 ,0)
	2345	...S PRCA BN=""
	2346	"RTN","PRC AACR1",158 ,0)
	2347	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2348	"RTN","PRC AACR1",159 ,0)
	2349	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2350	"RTN","PRC AACR1",160 ,0)
	2351	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2352	"RTN","PRC AACR1",161 ,0)
	2353	....S PRC AIEN=PRCAI EN+1
	2354	"RTN","PRC AACR1",162 ,0)
	2355	....; Add Transacti on Number
	2356	"RTN","PRC AACR1",163 ,0)
	2357	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2358	"RTN","PRC AACR1",164 ,0)
	2359	....; Add 18 chars of Debtor' s name
	2360	"RTN","PRC AACR1",165 ,0)
	2361	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2362	"RTN","PRC AACR1",166 ,0)
	2363	....; Add Bill Numb er
	2364	"RTN","PRC AACR1",167 ,0)
	2365	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2366	"RTN","PRC AACR1",168 ,0)
	2367	....; Add SSN
	2368	"RTN","PRC AACR1",169 ,0)
	2369	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2370	"RTN","PRC AACR1",170 ,0)
	2371	....; Add Auto-Corr ect Date
	2372	"RTN","PRC AACR1",171 ,0)
	2373	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2374	"RTN","PRC AACR1",172 ,0)
	2375	....; Add Auto-Corr ect Reason
	2376	"RTN","PRC AACR1",173 ,0)
	2377	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2378	"RTN","PRC AACR1",174 ,0)
	2379	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2380	"RTN","PRC AACR1",175 ,0)
	2381	....Q
	2382	"RTN","PRC AACR1",176 ,0)
	2383	;
	2384	"RTN","PRC AACR1",177 ,0)
	2385	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2386	"RTN","PRC AACR1",178 ,0)
	2387	I PRCASOR T=5 D
	2388	"RTN","PRC AACR1",179 ,0)
	2389	.; Print Header
	2390	"RTN","PRC AACR1",180 ,0)
	2391	.D PSACRT P5
	2392	"RTN","PRC AACR1",181 ,0)
	2393	.; Data L ayout ^TMP ("PRCAACR" ,$J,PRCAAC D,PRCADTR, PRCABN,PRC ATN)=PRCAA CD_U_PRCA
	2394	DTR_U_PRCA BN_U_PRCAS SN_U_PRCAT NTF_U_PRCA ACR
	2395	"RTN","PRC AACR1",182 ,0)
	2396	.S PRCAAC D=""
	2397	"RTN","PRC AACR1",183 ,0)
	2398	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2399	"RTN","PRC AACR1",184 ,0)
	2400	..S PRCAD TR=""
	2401	"RTN","PRC AACR1",185 ,0)
	2402	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2403	"RTN","PRC AACR1",186 ,0)
	2404	...S PRCA BN=""
	2405	"RTN","PRC AACR1",187 ,0)
	2406	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2407	"RTN","PRC AACR1",188 ,0)
	2408	....S PRC ATN=""
	2409	"RTN","PRC AACR1",189 ,0)
	2410	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN
	2411	D
	2412	"RTN","PRC AACR1",190 ,0)
	2413	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2414	"RTN","PRC AACR1",191 ,0)
	2415	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2416	"RTN","PRC AACR1",192 ,0)
	2417	.....S PR CAIEN=PRCA IEN+1
	2418	"RTN","PRC AACR1",193 ,0)
	2419	.....; Ad d Auto-Cor rect Date
	2420	"RTN","PRC AACR1",194 ,0)
	2421	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2422	"RTN","PRC AACR1",195 ,0)
	2423	.....; Ad d 18 chars of Debtor 's name
	2424	"RTN","PRC AACR1",196 ,0)
	2425	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2426	"RTN","PRC AACR1",197 ,0)
	2427	.....; Ad d Bill Num ber
	2428	"RTN","PRC AACR1",198 ,0)
	2429	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2430	"RTN","PRC AACR1",199 ,0)
	2431	.....; Ad d SSN
	2432	"RTN","PRC AACR1",200 ,0)
	2433	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2434	"RTN","PRC AACR1",201 ,0)
	2435	.....; Ad d Transact ion Number
	2436	"RTN","PRC AACR1",202 ,0)
	2437	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	2438	"RTN","PRC AACR1",203 ,0)
	2439	.....; Ad d Auto-Cor rect Reaso n
	2440	"RTN","PRC AACR1",204 ,0)
	2441	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	2442	"RTN","PRC AACR1",205 ,0)
	2443	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	2444	"RTN","PRC AACR1",206 ,0)
	2445	.....Q
	2446	"RTN","PRC AACR1",207 ,0)
	2447	;
	2448	"RTN","PRC AACR1",208 ,0)
	2449	; Send Ma ilMan mess age with N o Forward
	2450	"RTN","PRC AACR1",209 ,0)
	2451	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	2452	"RTN","PRC AACR1",210 ,0)
	2453	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)
	2454	"
	2455	"RTN","PRC AACR1",211 ,0)
	2456	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	2457	"RTN","PRC AACR1",212 ,0)
	2458	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	2459	"RTN","PRC AACR1",213 ,0)
	2460	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	2461	"RTN","PRC AACR1",214 ,0)
	2462	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	2463	"RTN","PRC AACR1",215 ,0)
	2464	S XMTO(DU Z)=""
	2465	"RTN","PRC AACR1",216 ,0)
	2466	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	2467	"RTN","PRC AACR1",217 ,0)
	2468	S XMINSTR ("FLAGS")= "X"
	2469	"RTN","PRC AACR1",218 ,0)
	2470	S XMDUZ=D UZ
	2471	"RTN","PRC AACR1",219 ,0)
	2472	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	2473	"RTN","PRC AACR1",220 ,0)
	2474	D HOME^%Z IS
	2475	"RTN","PRC AACR1",221 ,0)
	2476	K IO("Q") ,POP
	2477	"RTN","PRC AACR1",222 ,0)
	2478	K ^TMP("P RCAACR",$J )
	2479	"RTN","PRC AACR1",223 ,0)
	2480	K ^TMP("P RCAACR1",$ J)
	2481	"RTN","PRC AACR1",224 ,0)
	2482	K PRCABDT ,PRCAEDT,P RCASORT
	2483	"RTN","PRC AACR1",225 ,0)
	2484	Q
	2485	"RTN","PRC AACR1",226 ,0)
	2486	;
	2487	"RTN","PRC AACR1",227 ,0)
	2488	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2489	"RTN","PRC AACR1",228 ,0)
	2490	S PAGE=PA GE+1
	2491	"RTN","PRC AACR1",229 ,0)
	2492	S PRCAIEN =PRCAIEN+1
	2493	"RTN","PRC AACR1",230 ,0)
	2494	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2495	"RTN","PRC AACR1",231 ,0)
	2496	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2497	"RTN","PRC AACR1",232 ,0)
	2498	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	2499	"RTN","PRC AACR1",233 ,0)
	2500	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2501	"RTN","PRC AACR1",234 ,0)
	2502	S PRCAIEN =PRCAIEN+1
	2503	"RTN","PRC AACR1",235 ,0)
	2504	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2505	"RTN","PRC AACR1",236 ,0)
	2506	S PRCAIEN =PRCAIEN+1
	2507	"RTN","PRC AACR1",237 ,0)
	2508	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2509	"RTN","PRC AACR1",238 ,0)
	2510	S PRCAIEN =PRCAIEN+1
	2511	"RTN","PRC AACR1",239 ,0)
	2512	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2513	"RTN","PRC AACR1",240 ,0)
	2514	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM
	2515	AUTO-C DAT E"
	2516	"RTN","PRC AACR1",241 ,0)
	2517	S PRCAIEN =PRCAIEN+1
	2518	"RTN","PRC AACR1",242 ,0)
	2519	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2520	"RTN","PRC AACR1",243 ,0)
	2521	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- -------
	2522	---------- --"
	2523	"RTN","PRC AACR1",244 ,0)
	2524	S PRCAIEN =PRCAIEN+1
	2525	"RTN","PRC AACR1",245 ,0)
	2526	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2527	"RTN","PRC AACR1",246 ,0)
	2528	Q
	2529	"RTN","PRC AACR1",247 ,0)
	2530	;
	2531	"RTN","PRC AACR1",248 ,0)
	2532	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2533	"RTN","PRC AACR1",249 ,0)
	2534	S PAGE=PA GE+1
	2535	"RTN","PRC AACR1",250 ,0)
	2536	S PRCAIEN =PRCAIEN+1
	2537	"RTN","PRC AACR1",251 ,0)
	2538	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2539	"RTN","PRC AACR1",252 ,0)
	2540	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2541	"RTN","PRC AACR1",253 ,0)
	2542	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	2543	"RTN","PRC AACR1",254 ,0)
	2544	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2545	"RTN","PRC AACR1",255 ,0)
	2546	S PRCAIEN =PRCAIEN+1
	2547	"RTN","PRC AACR1",256 ,0)
	2548	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2549	"RTN","PRC AACR1",257 ,0)
	2550	S PRCAIEN =PRCAIEN+1
	2551	"RTN","PRC AACR1",258 ,0)
	2552	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2553	"RTN","PRC AACR1",259 ,0)
	2554	S PRCAIEN =PRCAIEN+1
	2555	"RTN","PRC AACR1",260 ,0)
	2556	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2557	"RTN","PRC AACR1",261 ,0)
	2558	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AU
	2559	TO-C REASO N"
	2560	"RTN","PRC AACR1",262 ,0)
	2561	S PRCAIEN =PRCAIEN+1
	2562	"RTN","PRC AACR1",263 ,0)
	2563	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2564	"RTN","PRC AACR1",264 ,0)
	2565	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --
	2566	---------- --"
	2567	"RTN","PRC AACR1",265 ,0)
	2568	S PRCAIEN =PRCAIEN+1
	2569	"RTN","PRC AACR1",266 ,0)
	2570	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2571	"RTN","PRC AACR1",267 ,0)
	2572	Q
	2573	"RTN","PRC AACR1",268 ,0)
	2574	;
	2575	"RTN","PRC AACR1",269 ,0)
	2576	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2577	"RTN","PRC AACR1",270 ,0)
	2578	S PAGE=PA GE+1
	2579	"RTN","PRC AACR1",271 ,0)
	2580	S PRCAIEN =PRCAIEN+1
	2581	"RTN","PRC AACR1",272 ,0)
	2582	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2583	"RTN","PRC AACR1",273 ,0)
	2584	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2585	"RTN","PRC AACR1",274 ,0)
	2586	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	2587	"RTN","PRC AACR1",275 ,0)
	2588	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2589	"RTN","PRC AACR1",276 ,0)
	2590	S PRCAIEN =PRCAIEN+1
	2591	"RTN","PRC AACR1",277 ,0)
	2592	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2593	"RTN","PRC AACR1",278 ,0)
	2594	S PRCAIEN =PRCAIEN+1
	2595	"RTN","PRC AACR1",279 ,0)
	2596	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2597	"RTN","PRC AACR1",280 ,0)
	2598	S PRCAIEN =PRCAIEN+1
	2599	"RTN","PRC AACR1",281 ,0)
	2600	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2601	"RTN","PRC AACR1",282 ,0)
	2602	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AU
	2603	TO-C REASO N"
	2604	"RTN","PRC AACR1",283 ,0)
	2605	S PRCAIEN =PRCAIEN+1
	2606	"RTN","PRC AACR1",284 ,0)
	2607	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2608	"RTN","PRC AACR1",285 ,0)
	2609	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --
	2610	---------- --"
	2611	"RTN","PRC AACR1",286 ,0)
	2612	S PRCAIEN =PRCAIEN+1
	2613	"RTN","PRC AACR1",287 ,0)
	2614	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2615	"RTN","PRC AACR1",288 ,0)
	2616	Q
	2617	"RTN","PRC AACR1",289 ,0)
	2618	;
	2619	"RTN","PRC AACR1",290 ,0)
	2620	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2621	"RTN","PRC AACR1",291 ,0)
	2622	S PAGE=PA GE+1
	2623	"RTN","PRC AACR1",292 ,0)
	2624	S PRCAIEN =PRCAIEN+1
	2625	"RTN","PRC AACR1",293 ,0)
	2626	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2627	"RTN","PRC AACR1",294 ,0)
	2628	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2629	"RTN","PRC AACR1",295 ,0)
	2630	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	2631	"RTN","PRC AACR1",296 ,0)
	2632	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2633	"RTN","PRC AACR1",297 ,0)
	2634	S PRCAIEN =PRCAIEN+1
	2635	"RTN","PRC AACR1",298 ,0)
	2636	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2637	"RTN","PRC AACR1",299 ,0)
	2638	S PRCAIEN =PRCAIEN+1
	2639	"RTN","PRC AACR1",300 ,0)
	2640	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2641	"RTN","PRC AACR1",301 ,0)
	2642	S PRCAIEN =PRCAIEN+1
	2643	"RTN","PRC AACR1",302 ,0)
	2644	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2645	"RTN","PRC AACR1",303 ,0)
	2646	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AU
	2647	TO-C REASO N"
	2648	"RTN","PRC AACR1",304 ,0)
	2649	S PRCAIEN =PRCAIEN+1
	2650	"RTN","PRC AACR1",305 ,0)
	2651	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2652	"RTN","PRC AACR1",306 ,0)
	2653	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --
	2654	---------- --"
	2655	"RTN","PRC AACR1",307 ,0)
	2656	S PRCAIEN =PRCAIEN+1
	2657	"RTN","PRC AACR1",308 ,0)
	2658	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2659	"RTN","PRC AACR1",309 ,0)
	2660	Q
	2661	"RTN","PRC AACR1",310 ,0)
	2662	;
	2663	"RTN","PRC AACR1",311 ,0)
	2664	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2665	"RTN","PRC AACR1",312 ,0)
	2666	S PAGE=PA GE+1
	2667	"RTN","PRC AACR1",313 ,0)
	2668	S PRCAIEN =PRCAIEN+1
	2669	"RTN","PRC AACR1",314 ,0)
	2670	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2671	"RTN","PRC AACR1",315 ,0)
	2672	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2673	"RTN","PRC AACR1",316 ,0)
	2674	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	2675	"RTN","PRC AACR1",317 ,0)
	2676	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2677	"RTN","PRC AACR1",318 ,0)
	2678	S PRCAIEN =PRCAIEN+1
	2679	"RTN","PRC AACR1",319 ,0)
	2680	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2681	"RTN","PRC AACR1",320 ,0)
	2682	S PRCAIEN =PRCAIEN+1
	2683	"RTN","PRC AACR1",321 ,0)
	2684	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2685	"RTN","PRC AACR1",322 ,0)
	2686	S PRCAIEN =PRCAIEN+1
	2687	"RTN","PRC AACR1",323 ,0)
	2688	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2689	"RTN","PRC AACR1",324 ,0)
	2690	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AU
	2691	TO-C REASO N"
	2692	"RTN","PRC AACR1",325 ,0)
	2693	S PRCAIEN =PRCAIEN+1
	2694	"RTN","PRC AACR1",326 ,0)
	2695	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2696	"RTN","PRC AACR1",327 ,0)
	2697	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --
	2698	---------- --"
	2699	"RTN","PRC AACR1",328 ,0)
	2700	S PRCAIEN =PRCAIEN+1
	2701	"RTN","PRC AACR1",329 ,0)
	2702	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2703	"RTN","PRC AACR1",330 ,0)
	2704	Q
	2705	"RTN","PRC AACR1",331 ,0)
	2706	;
	2707	"RTN","PRC AACR1",332 ,0)
	2708	EXIT ;
	2709	"RTN","PRC AACR1",333 ,0)
	2710	Q
	2711	"RTN","PRC ACPS")
	2712	0^27^B2540 66716^n/a
	2713	"RTN","PRC ACPS",1,0)
	2714	PRCACPS ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION ;09/2 1/15 3:34 PM
	2715	"RTN","PRC ACPS",2,0)
	2716	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	2717	"RTN","PRC ACPS",3,0)
	2718	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2719	"RTN","PRC ACPS",4,0)
	2720	;
	2721	"RTN","PRC ACPS",5,0)
	2722	Q
	2723	"RTN","PRC ACPS",6,0)
	2724	;
	2725	"RTN","PRC ACPS",7,0)
	2726	BEGIN ; En try point for manual run
	2727	"RTN","PRC ACPS",8,0)
	2728	; Determi ne if Auto Correct p rocess is currently running
	2729	"RTN","PRC ACPS",9,0)
	2730	N DIR,PRC ASTRT,QUIT ,X,X1,X2,Y
	2731	"RTN","PRC ACPS",10,0 )
	2732	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= 0
	2733	"RTN","PRC ACPS",11,0 )
	2734	; Notify user if Au to Correct process i s currentl y running
	2735	"RTN","PRC ACPS",12,0 )
	2736	I PRCASTR T'="" D Q :QUIT
	2737	"RTN","PRC ACPS",13,0 )
	2738	.S Y=$P(P RCASTRT,U, 2)
	2739	"RTN","PRC ACPS",14,0 )
	2740	.D DD^%DT
	2741	"RTN","PRC ACPS",15,0 )
	2742	.S PRCAST RT=Y
	2743	"RTN","PRC ACPS",16,0 )
	2744	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram was pr eviously s tarted on
	2745	"
	2746	"RTN","PRC ACPS",17,0 )
	2747	.W !,PRCA STRT," and has not y et success fully comp leted."
	2748	"RTN","PRC ACPS",18,0 )
	2749	.W !!,"Th e job can take up to 1 hour to complete when sched uled to ru n outside
	2750	"
	2751	"RTN","PRC ACPS",19,0 )
	2752	.W !,"of normal bus iness hour s and long er if run during nor mal busine ss hours"
	2753	"RTN","PRC ACPS",20,0 )
	2754	.W !,"whe n the load on the sy stem is gr eater."
	2755	"RTN","PRC ACPS",21,0 )
	2756	.W !!
	2757	"RTN","PRC ACPS",22,0 )
	2758	.W !,"If it has bee n more tha n an hour since the Patient St atement Au to-Correc
	2759	tion"
	2760	"RTN","PRC ACPS",23,0 )
	2761	.W !,"Pro gram was s tarted and the confi rmation e- mail with subject: C PS"
	2762	"RTN","PRC ACPS",24,0 )
	2763	.W !,"AUT O-CORRECTI ON COMPLET E has not been sent to the PRC ACPS mail group, yo
	2764	u can"
	2765	"RTN","PRC ACPS",25,0 )
	2766	.W !,"run the Patie nt Stateme nt Auto-Co rrection P rogram aga in."
	2767	"RTN","PRC ACPS",26,0 )
	2768	.W !
	2769	"RTN","PRC ACPS",27,0 )
	2770	.S DIR("A ")="Do you want to r un the Pat ient State ment Auto- Correction Program
	2771	again"
	2772	"RTN","PRC ACPS",28,0 )
	2773	.S DIR(0) ="Y",DIR(" B")="NO"
	2774	"RTN","PRC ACPS",29,0 )
	2775	.D ^DIR
	2776	"RTN","PRC ACPS",30,0 )
	2777	.W !
	2778	"RTN","PRC ACPS",31,0 )
	2779	.; Quit i f ^, ^^, T imeout or No
	2780	"RTN","PRC ACPS",32,0 )
	2781	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	2782	"RTN","PRC ACPS",33,0 )
	2783	.K DTOUT, DUOUT,DIRO UT
	2784	"RTN","PRC ACPS",34,0 )
	2785	.Q
	2786	"RTN","PRC ACPS",35,0 )
	2787	;
	2788	"RTN","PRC ACPS",36,0 )
	2789	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	2790	"RTN","PRC ACPS",37,0 )
	2791	W !,"Queu e the pati ent statem ent discre pancies au to-correct ion progra m to run:
	2792	"
	2793	"RTN","PRC ACPS",38,0 )
	2794	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	2795	"RTN","PRC ACPS",39,0 )
	2796	S ZTRTN=" START^PRCA CPS",ZTIO= ""
	2797	"RTN","PRC ACPS",40,0 )
	2798	D ^%ZTLOA D
	2799	"RTN","PRC ACPS",41,0 )
	2800	Q
	2801	"RTN","PRC ACPS",42,0 )
	2802	;
	2803	"RTN","PRC ACPS",43,0 )
	2804	START ; En try point for Schedu led backgr ound job
	2805	"RTN","PRC ACPS",44,0 )
	2806	N DEBTOR, DEBTOR0,DE BTOR1,PRCA STRT,REFRE V,X,Y
	2807	"RTN","PRC ACPS",45,0 )
	2808	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0))
	2809	"RTN","PRC ACPS",46,0 )
	2810	; If a pr evious job still run ning send e-mail war ning to PR CACPS mail group
	2811	"RTN","PRC ACPS",47,0 )
	2812	I PRCASTR T'="" D
	2813	"RTN","PRC ACPS",48,0 )
	2814	.S Y=$P(P RCASTRT,U, 2)
	2815	"RTN","PRC ACPS",49,0 )
	2816	.; Conver t date to external f ormat
	2817	"RTN","PRC ACPS",50,0 )
	2818	.D DD^%DT
	2819	"RTN","PRC ACPS",51,0 )
	2820	.S PRCAST RT=Y
	2821	"RTN","PRC ACPS",52,0 )
	2822	.; Send m ail to PRC ACPS mail group noti ng previou s run didn 't complet e
	2823	"RTN","PRC ACPS",53,0 )
	2824	.D PRCAMA IL^PRCACPS A(PRCASTRT )
	2825	"RTN","PRC ACPS",54,0 )
	2826	.Q
	2827	"RTN","PRC ACPS",55,0 )
	2828	; Get cur rent date/ time
	2829	"RTN","PRC ACPS",56,0 )
	2830	D NOW^%DT C
	2831	"RTN","PRC ACPS",57,0 )
	2832	S (PRCAST RT,X1)=%,X 2=8
	2833	"RTN","PRC ACPS",58,0 )
	2834	D C^%DTC
	2835	"RTN","PRC ACPS",59,0 )
	2836	S ^XTMP(" PRCACPS",0 )=X_U_PRCA STRT_U_"Pa tient Stat ement Auto -Correctio n Program
	2837	"
	2838	"RTN","PRC ACPS",60,0 )
	2839	; Loop th rough C x- ref in 430 . This fie ld points to the Deb tor File, which in
	2840	turn is a
	2841	"RTN","PRC ACPS",61,0 )
	2842	; variabl e pointer to other f iles.
	2843	"RTN","PRC ACPS",62,0 )
	2844	S DEBTOR= 0
	2845	"RTN","PRC ACPS",63,0 )
	2846	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2847	"RTN","PRC ACPS",64,0 )
	2848	.; Perfor m the same in/out of balance c heck as th e CHECK PA TIENT ACCO UNT BALAN
	2849	CE option
	2850	"RTN","PRC ACPS",65,0 )
	2851	.; Quit t o next deb tor if acc ount is in balance
	2852	"RTN","PRC ACPS",66,0 )
	2853	.I '$$EN^ PRCAMRKC(D EBTOR) Q
	2854	"RTN","PRC ACPS",67,0 )
	2855	.S BALDIF F=0
	2856	"RTN","PRC ACPS",68,0 )
	2857	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) )
	2858	"RTN","PRC ACPS",69,0 )
	2859	.; QUIT i f it doesn 't point t o the PATI ENT (^DPT) file
	2860	"RTN","PRC ACPS",70,0 )
	2861	.Q:$P(DEB TOR0,"^")' ["DPT("
	2862	"RTN","PRC ACPS",71,0 )
	2863	.Q:$P(DEB TOR1,"^",9 )=1 ; qui t if debto r address marked unk nown
	2864	"RTN","PRC ACPS",72,0 )
	2865	.; Skip t his Debtor is they a t least 1 Bill in #4 30 with a status of REFUND RE
	2866	VIEW (#44)
	2867	"RTN","PRC ACPS",73,0 )
	2868	.Q:$$REFR EV(DEBTOR)
	2869	"RTN","PRC ACPS",74,0 )
	2870	.; Get pr evious bal ance and d ate of las t transact ion from t he AR EVEN T file (#
	2871	341)
	2872	"RTN","PRC ACPS",75,0 )
	2873	.D ENTER( DEBTOR)
	2874	"RTN","PRC ACPS",76,0 )
	2875	.; Perfor m checks/u pdates bas ed on File #430
	2876	"RTN","PRC ACPS",77,0 )
	2877	.D START1
	2878	"RTN","PRC ACPS",78,0 )
	2879	.; QUIT i f in balan ce
	2880	"RTN","PRC ACPS",79,0 )
	2881	.; *** Re moved so a ll out of balance ac counts to enter STAR T2
	2882	"RTN","PRC ACPS",80,0 )
	2883	.;I BALDI FF=0 K BAL DIFF,^TMP( "PRCAGTPS" ,$J),^TMP( "PRCABILL" ,$J) Q
	2884	"RTN","PRC ACPS",81,0 )
	2885	.; Review Data in ^ TMP and up date #433 as needed
	2886	"RTN","PRC ACPS",82,0 )
	2887	.D START2
	2888	"RTN","PRC ACPS",83,0 )
	2889	.; If the account i s still ou t of balan ce after f ixing ever ything it can
	2890	"RTN","PRC ACPS",84,0 )
	2891	.; call U PDTLTR to mark the l ast transa ction for the accoun t as NOT F IXABLE
	2892	"RTN","PRC ACPS",85,0 )
	2893	.I $$EN^P RCAMRKC(DE BTOR) D UP DTLTR^PRCA CPSA(0)
	2894	"RTN","PRC ACPS",86,0 )
	2895	.; clean up temp in fo and pro cess next debtor
	2896	"RTN","PRC ACPS",87,0 )
	2897	.K BALDIF F,^TMP("PR CAGTPS",$J ),^TMP("PR CABILL",$J )
	2898	"RTN","PRC ACPS",88,0 )
	2899	; Send ma ilman mess age to the PRCACPS m ail group at end of processing
	2900	"RTN","PRC ACPS",89,0 )
	2901	D USRMSG
	2902	"RTN","PRC ACPS",90,0 )
	2903	Q
	2904	"RTN","PRC ACPS",91,0 )
	2905	;
	2906	"RTN","PRC ACPS",92,0 )
	2907	REFREV(DEB TOR) ;
	2908	"RTN","PRC ACPS",93,0 )
	2909	; Check i f any Bill for this Debtor has a status of REFUND REVIEW (#4 4)
	2910	"RTN","PRC ACPS",94,0 )
	2911	N BN,QUIT
	2912	"RTN","PRC ACPS",95,0 )
	2913	S BN="",Q UIT=0
	2914	"RTN","PRC ACPS",96,0 )
	2915	F S BN=$ O(^PRCA(43 0,"C",DEBT OR,BN)) Q: 'BN D Q: QUIT
	2916	"RTN","PRC ACPS",97,0 )
	2917	.; Check CURRENT ST ATUS (#8) for status of REFUND REVIEW (# 44)
	2918	"RTN","PRC ACPS",98,0 )
	2919	.I $P($G( ^PRCA(430, BN,0)),U,8 )=44 S QUI T=1
	2920	"RTN","PRC ACPS",99,0 )
	2921	Q QUIT
	2922	"RTN","PRC ACPS",100, 0)
	2923	;
	2924	"RTN","PRC ACPS",101, 0)
	2925	ENTER(DEBT OR) ;
	2926	"RTN","PRC ACPS",102, 0)
	2927	S (PBAL,B BAL,TBAL)= 0 K ^TMP(" PRCAGTPS", $J)
	2928	"RTN","PRC ACPS",103, 0)
	2929	; Get las t type of event for debtor by calling $$ LST^RCFN01 . Referenc es files
	2930	#340 and # 341.1
	2931	"RTN","PRC ACPS",104, 0)
	2932	S DAT=$$L ST^RCFN01( DEBTOR,2) I DAT<1 S DAT=0
	2933	"RTN","PRC ACPS",105, 0)
	2934	; PBAL^PR CAGU gets previous b alance and date of l ast transa ction from the AR E
	2935	VENT file (#341)
	2936	"RTN","PRC ACPS",106, 0)
	2937	I DAT S D AT=9999999 .999999-DA T D PBAL^P RCAGU(DEBT OR,.DAT,.P BAL)
	2938	"RTN","PRC ACPS",107, 0)
	2939	D EN(DEBT OR,DAT)
	2940	"RTN","PRC ACPS",108, 0)
	2941	K BBAL,TB AL,DAT
	2942	"RTN","PRC ACPS",109, 0)
	2943	Q
	2944	"RTN","PRC ACPS",110, 0)
	2945	;
	2946	"RTN","PRC ACPS",111, 0)
	2947	EN(DEBTOR, BEG,END,TT Y) ;
	2948	"RTN","PRC ACPS",112, 0)
	2949	NEW Y
	2950	"RTN","PRC ACPS",113, 0)
	2951	; If Begi nning date is not de fined, set it to 0 t o start at beginning
	2952	"RTN","PRC ACPS",114, 0)
	2953	; If End date is no t defined, set it to today's d ate
	2954	"RTN","PRC ACPS",115, 0)
	2955	S:$G(BEG) ="" BEG=0 I $G(END)= "" D NOW^% DTC S END= % K %
	2956	"RTN","PRC ACPS",116, 0)
	2957	S TTY=$G( TTY) I TTY ="" D F430
	2958	"RTN","PRC ACPS",117, 0)
	2959	D F433
	2960	"RTN","PRC ACPS",118, 0)
	2961	Q Q
	2962	"RTN","PRC ACPS",119, 0)
	2963	F430 ; Che cks for AC COUNTS REC EIVABLE fi le (#430) for bills with (#3) ORIGINAL
	2964	AMOUNT has a value,
	2965	"RTN","PRC ACPS",120, 0)
	2966	; set thi s into the ^TMP glob al with _" ^0"
	2967	"RTN","PRC ACPS",121, 0)
	2968	NEW DAT,B N
	2969	"RTN","PRC ACPS",122, 0)
	2970	S DAT=BEG F S DAT= $O(^PRCA(4 30,"ATD",D EBTOR,DAT) ) Q:('DAT) !(DAT>END) S BN=0
	2971	F S BN=$O (^PRCA(430 ,"ATD",DEB TOR,DAT,BN )) Q:'BN D
	2972	"RTN","PRC ACPS",123, 0)
	2973	.; Add th e original amount if it is wit hin date r ange based on the da te of the
	2974	last stat ement
	2975	"RTN","PRC ACPS",124, 0)
	2976	.I $P(^PR CA(430,BN, 0),U,3) S ^TMP("PRCA GTPS",$J,D EBTOR,BN,0 )=$P(^PRCA (430,BN,0
	2977	),"^",3)_" ^0"
	2978	"RTN","PRC ACPS",125, 0)
	2979	Q
	2980	"RTN","PRC ACPS",126, 0)
	2981	F433 ;
	2982	"RTN","PRC ACPS",127, 0)
	2983	NEW DAT,T N
	2984	"RTN","PRC ACPS",128, 0)
	2985	; Loop th rough the Dates and Bills
	2986	"RTN","PRC ACPS",129, 0)
	2987	F DAT=BEG :0 S DAT=$ O(^PRCA(43 3,"ATD",DE BTOR,DAT)) Q:('DAT)! (DAT>END) F TN=0:0
	2988	S TN=$O(^ PRCA(433," ATD",DEBTO R,DAT,TN)) Q:'TN D
	2989	"RTN","PRC ACPS",130, 0)
	2990	.S TCMPLT ="",TMBSNC ="",TRDMRD ="",COMM=0
	2991	"RTN","PRC ACPS",131, 0)
	2992	.S TN0=$G (^PRCA(433 ,TN,0)) Q: TN0=""
	2993	"RTN","PRC ACPS",132, 0)
	2994	.S TN1=$G (^PRCA(433 ,TN,1))
	2995	"RTN","PRC ACPS",133, 0)
	2996	.S TN3=$G (^PRCA(433 ,TN,3))
	2997	"RTN","PRC ACPS",134, 0)
	2998	.I $P(TN1 ,U,2)="" Q ;MISSING TRANS TYP E
	2999	"RTN","PRC ACPS",135, 0)
	3000	.; PRCA4 .5313 - S kip proces sing twin transactio ns for Pre payments
	3001	"RTN","PRC ACPS",136, 0)
	3002	.I $P(TN0 ,U,10),$P( $G(^PRCA(4 33,TN,5)), U,1)'="" N HIT,TWIN D I HIT Q
	3003	"RTN","PRC ACPS",137, 0)
	3004	..S HIT=0
	3005	"RTN","PRC ACPS",138, 0)
	3006	..S TWIN= $P(^PRCA(4 33,TN,5),U ,1)
	3007	"RTN","PRC ACPS",139, 0)
	3008	..I '$D(^ PRCA(433,T WIN,0)) Q
	3009	"RTN","PRC ACPS",140, 0)
	3010	..S HIT=1
	3011	"RTN","PRC ACPS",141, 0)
	3012	..S TWIN( 2)=$P(^PRC A(433,TWIN ,0),U,2)
	3013	"RTN","PRC ACPS",142, 0)
	3014	..K ^TMP( "PRCAGTPS" ,$J,DEBTOR ,TWIN(2),T WIN)
	3015	"RTN","PRC ACPS",143, 0)
	3016	.;
	3017	"RTN","PRC ACPS",144, 0)
	3018	.I $P(TN0 ,U,10)=1 S TCMPLT=1
	3019	"RTN","PRC ACPS",145, 0)
	3020	.I $P(TN1 ,U,2)=45 S COMM=1 G F433A
	3021	"RTN","PRC ACPS",146, 0)
	3022	.I $G(TTY )'="" Q:TT Y'=$P(TN1, U,2)
	3023	"RTN","PRC ACPS",147, 0)
	3024	.; Quit i f Transact ion Type i s blank or one of th e followin g:
	3025	"RTN","PRC ACPS",148, 0)
	3026	.; 3:REFE R TO RC, 4 :REFER TO DOJ, 5:REE STABLISH T O RC/DOJ, 6:RETURNED BY RC/DO
	3027	J
	3028	"RTN","PRC ACPS",149, 0)
	3029	.; 7:CASH COLLECTIO N BY RC/DO J, 24:MARS HAL/COURT COST, 25:R EPAYMENT P LAN, 30:D
	3030	EBIT VOUCH ER (SF 551 5)
	3031	"RTN","PRC ACPS",150, 0)
	3032	.I TTY="" ,",3,4,5,6 ,7,24,25,3 0,"[(","_$ P(TN1,U,2) _",") Q
	3033	"RTN","PRC ACPS",151, 0)
	3034	.; QUIT i f BILL NUM BER (#.03) = blank OR TRANSACTI ON STATUS (#4) '= CO MPLETE
	3035	"RTN","PRC ACPS",152, 0)
	3036	.I ($P(TN 0,U,2)="") !($P(TN0,U ,4)'=2) Q
	3037	"RTN","PRC ACPS",153, 0)
	3038	.; IF PRC AHIST="THI ST" AND TR ANSACTION TYPE (#12) = COMMENT (#45) cal l F433A t
	3039	o Set the data into ^TMP("PRCA GTPS",$J,D EBTOR
	3040	"RTN","PRC ACPS",154, 0)
	3041	.I $G(PRC AHIST)="TH IST",$P(TN 1,U,2)=45 G F433A
	3042	"RTN","PRC ACPS",155, 0)
	3043	.; IF TRA NSACTION T YPE (#12) '= to 46 UNSUSPENDE D AND TRAN SACTION TY PE (#12)'
	3044	= to 47 C HARGE SUSP ENDED
	3045	"RTN","PRC ACPS",156, 0)
	3046	.I $P(TN1 ,"^",2)'=4 6,$P(TN1," ^",2)'=47 D I TN1=" " Q
	3047	"RTN","PRC ACPS",157, 0)
	3048	..N RCTRA NDA,RCSTOP ,TRANTYPE
	3049	"RTN","PRC ACPS",158, 0)
	3050	..S RCSTO P=0
	3051	"RTN","PRC ACPS",159, 0)
	3052	..; Loop BACKWARDS through th e BILL NUM BER "C" x- ref
	3053	"RTN","PRC ACPS",160, 0)
	3054	..S RCTRA NDA=TN
	3055	"RTN","PRC ACPS",161, 0)
	3056	..F S RC TRANDA=$O( ^PRCA(433, "C",+$P(TN 0,"^",2),R CTRANDA),- 1) Q:'RCTR ANDA D
	3057	I RCSTOP Q
	3058	"RTN","PRC ACPS",162, 0)
	3059	...; QUIT if TRANSA CTION STAT US (#4) '= COMPLETE
	3060	"RTN","PRC ACPS",163, 0)
	3061	...I $P($ G(^PRCA(43 3,RCTRANDA ,0)),"^",4 )'=2 Q
	3062	"RTN","PRC ACPS",164, 0)
	3063	...; Load Transacti on Type
	3064	"RTN","PRC ACPS",165, 0)
	3065	...S TRAN TYPE=$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",2)
	3066	"RTN","PRC ACPS",166, 0)
	3067	...; IF T RANSACTION TYPE (#12 ) = 46 UNS USPENDED s et stop & Quit
	3068	"RTN","PRC ACPS",167, 0)
	3069	...I TRAN TYPE=46 S RCSTOP=1 Q
	3070	"RTN","PRC ACPS",168, 0)
	3071	...; IF T RANSACTION TYPE (#12 ) = 47 CHA RGE SUSPEN DED set st op & Quit
	3072	"RTN","PRC ACPS",169, 0)
	3073	...I TRAN TYPE=47 S RCSTOP=1,T N1="" Q
	3074	"RTN","PRC ACPS",170, 0)
	3075	F433A .
	3076	"RTN","PRC ACPS",171, 0)
	3077	.; The da ta in the ^TMP is as follows:
	3078	"RTN","PRC ACPS",172, 0)
	3079	.; Data =
	3080	"RTN","PRC ACPS",173, 0)
	3081	.; 1. TRA NS. AMOUNT (#15) $ P(TN1,U,5)
	3082	"RTN","PRC ACPS",174, 0)
	3083	.; 2. TRA NSACTION T YPE (#12) $ P(TN1,U,2)
	3084	"RTN","PRC ACPS",175, 0)
	3085	.; 3. PRI N.COLLECTE D (#31) $ P(TN3,U,1)
	3086	"RTN","PRC ACPS",176, 0)
	3087	.; 4. INT EREST COLL ECTED (#32 ) $ P(TN3,U,2)
	3088	"RTN","PRC ACPS",177, 0)
	3089	.; 5. ADM IN.COLLECT ED (#33) $ P(TN3,U,3)
	3090	"RTN","PRC ACPS",178, 0)
	3091	.; 6. MAR SHAL FEE C OLLECTED ( #34) $ P(TN3,U,4)
	3092	"RTN","PRC ACPS",179, 0)
	3093	.; 7. COU RT COST CO LLECTED (# 35) $ P(TN3,U,5)
	3094	"RTN","PRC ACPS",180, 0)
	3095	.; 8. TOT AL OF #3 - #7 $ P(TN3,U,1) +$P(TN3,U, 2)+$P(TN3, U,3)+$P(T
	3096	N3,U,4)+$P (TN3,U,5)
	3097	"RTN","PRC ACPS",181, 0)
	3098	.; 9. TCM PLT ( #10) INCOM PLETE TRAN SACTION FL AG
	3099	"RTN","PRC ACPS",182, 0)
	3100	.;10. TRD MRD - Does n't appear to be use d
	3101	"RTN","PRC ACPS",183, 0)
	3102	.;11. TMB SNC - Does n't appear to be use d
	3103	"RTN","PRC ACPS",184, 0)
	3104	.;12. Dup licate fla g for use in START2 1=duplicat e, 0=not a duplicate . Set in
	3105	BILLQUIT^P RCACPSA
	3106	"RTN","PRC ACPS",185, 0)
	3107	.;
	3108	"RTN","PRC ACPS",186, 0)
	3109	.N PRCATE MP
	3110	"RTN","PRC ACPS",187, 0)
	3111	.S PRCATE MP=$P(TN1, U,5)_U_$P( TN1,U,2)_U _$P(TN3,U, 1)_U_$P(TN 3,U,2)_U_$ P(TN3,U,3
	3112	)_U_$P(TN3 ,U,4)_U_$P (TN3,U,5)
	3113	"RTN","PRC ACPS",188, 0)
	3114	.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
	3115	,U,5))
	3116	"RTN","PRC ACPS",189, 0)
	3117	.S PRCATE MP=PRCATEM P_U_TCMPLT
	3118	"RTN","PRC ACPS",190, 0)
	3119	.S PRCATE MP=PRCATEM P_U_TRDMRD
	3120	"RTN","PRC ACPS",191, 0)
	3121	.S PRCATE MP=PRCATEM P_U_TMBSNC
	3122	"RTN","PRC ACPS",192, 0)
	3123	.S ^TMP(" PRCAGTPS", $J,DEBTOR, $P(TN0,U,2 ),TN)=PRCA TEMP
	3124	"RTN","PRC ACPS",193, 0)
	3125	.K TN0,TN 1,TN3,TCMP LT,TRDMRD, TMBSNC,COM M
	3126	"RTN","PRC ACPS",194, 0)
	3127	K PRCAHIS T
	3128	"RTN","PRC ACPS",195, 0)
	3129	Q
	3130	"RTN","PRC ACPS",196, 0)
	3131	;
	3132	"RTN","PRC ACPS",197, 0)
	3133	START1 ;
	3134	"RTN","PRC ACPS",198, 0)
	3135	;
	3136	"RTN","PRC ACPS",199, 0)
	3137	S BILL=""
	3138	"RTN","PRC ACPS",200, 0)
	3139	S CBALTOT =0 ; Will be the tot al of all CURRENT BA LANCE fiel d (#11) fo r the acc
	3140	ount
	3141	"RTN","PRC ACPS",201, 0)
	3142	; ACCOUNT S RECEIVAB LE (#430) The C cros s-referenc e allows u ser look-u p of bill
	3143	s belongin g to a spe cific debt or.
	3144	"RTN","PRC ACPS",202, 0)
	3145	; Loop th rough bill s
	3146	"RTN","PRC ACPS",203, 0)
	3147	; ^TMP("P RCABILL",$ J,DEBTOR,B ILL)= Sum of CURRENT BALANCE f ield (#11) for the
	3148	Bill
	3149	"RTN","PRC ACPS",204, 0)
	3150	; ^Sum of TRANS. AMOUNT (#1 5) for all transact
	3151	ions for t he Bill
	3152	"RTN","PRC ACPS",205, 0)
	3153	; ^Stop Flag if t he Bill ha s more tha n one err
	3154	or
	3155	"RTN","PRC ACPS",206, 0)
	3156	K ^TMP("P RCABILL",$ J)
	3157	"RTN","PRC ACPS",207, 0)
	3158	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3159	"RTN","PRC ACPS",208, 0)
	3160	.; BILLTO T is the C URRENT BAL ANCE field (#11) for each Bill for the D ebtor
	3161	"RTN","PRC ACPS",209, 0)
	3162	.N BILLTO T
	3163	"RTN","PRC ACPS",210, 0)
	3164	.S BN0=$G (^PRCA(430 ,BILL,0))
	3165	"RTN","PRC ACPS",211, 0)
	3166	.; QUIT: CURRENT ST ATUS (#8) '= ACTIVE
	3167	"RTN","PRC ACPS",212, 0)
	3168	.; I $P(B N0,U,8)'=1 6 Q based on call o n 11/28/16 process a ll bill wi th a stat
	3169	us other t han Refund Review
	3170	"RTN","PRC ACPS",213, 0)
	3171	.; Skip a ll Debtors with 1 or more Bill s with a s tatus of R EFEUND REV IEW (#44)
	3172	. This ch eck is don e in
	3173	"RTN","PRC ACPS",214, 0)
	3174	.; REFREV above.
	3175	"RTN","PRC ACPS",215, 0)
	3176	.; Sum up CURRENT B ALANCE (#1 1) for eac h ACTIVE B ill
	3177	"RTN","PRC ACPS",216, 0)
	3178	.; Set in CBALTOT f or BALDIFF and in PR CABILL for BILLDIFF in Start2
	3179	"RTN","PRC ACPS",217, 0)
	3180	.; S CBAL TOT=CBALTO T+$$GET1^D IQ(430,BIL L,11)
	3181	"RTN","PRC ACPS",218, 0)
	3182	.S BILLTO T=$$GET1^D IQ(430,BIL L,11) ; Ge t CURRENT BALANCE (# 11) which is comput
	3183	ed: #71+#7 2+#73+#74+ #75
	3184	"RTN","PRC ACPS",219, 0)
	3185	.S ^TMP(" PRCABILL", $J,DEBTOR, BILL)=+BIL LTOT
	3186	"RTN","PRC ACPS",220, 0)
	3187	.S CBALTO T=CBALTOT+ BILLTOT
	3188	"RTN","PRC ACPS",221, 0)
	3189	N BILL,I, TN,TRANSTO T,TNVAL,TT YPE,TNTOT
	3190	"RTN","PRC ACPS",222, 0)
	3191	S TN="",( BILL,TRANS TOT,TTYPE, TNVAL)=0
	3192	"RTN","PRC ACPS",223, 0)
	3193	; Loop th rough Bill s
	3194	"RTN","PRC ACPS",224, 0)
	3195	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3196	"RTN","PRC ACPS",225, 0)
	3197	.; Call B ILLQUIT to determine if this b ill has mu ltiple iss ues
	3198	"RTN","PRC ACPS",226, 0)
	3199	.I $$BILL QUIT^PRCAC PSA(DEBTOR ,BILL) Q
	3200	"RTN","PRC ACPS",227, 0)
	3201	.; Initia lize TNTOT for Trans action Tot al for thi s bill
	3202	"RTN","PRC ACPS",228, 0)
	3203	.I $G(TNT OT(BILL))= "" S TNTOT (BILL)=0
	3204	"RTN","PRC ACPS",229, 0)
	3205	.; Loop t hrough Tra nsactions
	3206	"RTN","PRC ACPS",230, 0)
	3207	.S TN=0 F S TN=$O( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN)) Q:TN ="" D
	3208	"RTN","PRC ACPS",231, 0)
	3209	..; IF Tr ansaction # = 0 Add TRANS. AMO UNT (#15) to the Tra nsaction T otal
	3210	"RTN","PRC ACPS",232, 0)
	3211	..; I TN= 0 S TRANST OT=TRANSTO T+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN) Q
	3212	"RTN","PRC ACPS",233, 0)
	3213	..; S TNV AL = (#15) TRANS. AM OUNT from #433
	3214	"RTN","PRC ACPS",234, 0)
	3215	..S TNVAL =+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)
	3216	"RTN","PRC ACPS",235, 0)
	3217	..; S TTY PE = (#12) TRANSACTI ON TYPE fr om #433
	3218	"RTN","PRC ACPS",236, 0)
	3219	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3220	"RTN","PRC ACPS",237, 0)
	3221	..; IF IN COMPLETE T RANSACTION FLAG is s et, set Tr ansaction amount = 0
	3222	"RTN","PRC ACPS",238, 0)
	3223	..S TCMPL T=+$P(^TMP ("PRCAGTPS ",$J,DEBTO R,BILL,TN) ,U,9)
	3224	"RTN","PRC ACPS",239, 0)
	3225	..I TCMPL T S TNVAL= 0
	3226	"RTN","PRC ACPS",240, 0)
	3227	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3228	"RTN","PRC ACPS",241, 0)
	3229	..I TMBSN C S TNVAL= 0
	3230	"RTN","PRC ACPS",242, 0)
	3231	..; Set T NVAL =0 if one of th e followin g Transact ion Types:
	3232	"RTN","PRC ACPS",243, 0)
	3233	..; 3:REF ER TO RC, 4:REFER TO DOJ, 5:RE ESTABLISH TO RC/DOJ, 6:RETURNE D BY RC/D
	3234	OJ
	3235	"RTN","PRC ACPS",244, 0)
	3236	..; 25:RE PAYMENT PL AN, 32:RET URNED FOR AMENDMENT, 33:AMENDE D BILL
	3237	"RTN","PRC ACPS",245, 0)
	3238	..I (TTYP E=3)!(TTYP E=4)!(TTYP E=5)!(TTYP E=6)!(TTYP E=32)!(TTY PE=25)!(TT YPE=33) S
	3239	TNVAL=0
	3240	"RTN","PRC ACPS",246, 0)
	3241	..; Set T NVAL to ne gative val ue if one of the Tra nsaction T ypes:
	3242	"RTN","PRC ACPS",247, 0)
	3243	..; 2:PAY MENT (IN P ART), 8:TE RM.BY FIS. OFFICER, 9 :TERM.BY C OMPROMISE, 10:WAIVE
	3244	D IN FULL
	3245	"RTN","PRC ACPS",248, 0)
	3246	..; 11:WA IVED IN PA RT, 14:EXE MPT INT/AD M. COST, 2 9:TERM.BY RC/DOJ, 34 :PAYMENT
	3247	(IN FULL)
	3248	"RTN","PRC ACPS",249, 0)
	3249	..; 35:DE CREASE ADJ USTMENT, 4 1:REFUNDED , 47:CHARG E SUSPENDE D
	3250	"RTN","PRC ACPS",250, 0)
	3251	..I TTYPE =2!(TTYPE= 8)!(TTYPE= 9)!(TTYPE= 10)!(TTYPE =11)!(TTYP E=14)!(TTY PE=29)!(T
	3252	TYPE=34)!( TTYPE=35)! (TTYPE=41) !(TTYPE=47 ) S TNVAL= -TNVAL
	3253	"RTN","PRC ACPS",251, 0)
	3254	..; Updat e Transact ion Total
	3255	"RTN","PRC ACPS",252, 0)
	3256	..S TRANS TOT=TRANST OT+TNVAL
	3257	"RTN","PRC ACPS",253, 0)
	3258	..; Updat e Transact ion Total for this B ill
	3259	"RTN","PRC ACPS",254, 0)
	3260	..S TNTOT (BILL)=TNT OT(BILL)+T NVAL
	3261	"RTN","PRC ACPS",255, 0)
	3262	.; Update PRCABILL with Trans action Tot al for thi s Bill
	3263	"RTN","PRC ACPS",256, 0)
	3264	.S $P(^TM P("PRCABIL L",$J,DEBT OR,BILL),U ,2)=TNTOT( BILL)
	3265	"RTN","PRC ACPS",257, 0)
	3266	; Set Bal ance Diffe rence = Su m up CURRE NT BALANCE (#8) for each ACTIV E Bill -
	3267	Transactio n Total fo r all bill s - PBAL f rom AR EVE NT file (# 341)
	3268	"RTN","PRC ACPS",258, 0)
	3269	S BALDIFF =CBALTOT-T RANSTOT-PB AL
	3270	"RTN","PRC ACPS",259, 0)
	3271	K CBALTOT ,TRANSTOT, PBAL,TCMPL T,BILL,BN0
	3272	"RTN","PRC ACPS",260, 0)
	3273	Q
	3274	"RTN","PRC ACPS",261, 0)
	3275	;
	3276	"RTN","PRC ACPS",262, 0)
	3277	START2 ;
	3278	"RTN","PRC ACPS",263, 0)
	3279	N I,ATNLA ST,BILL,BI LLCNT,BILL CNTR,BILLN UM,FLAGGED ,TN,TN9,TR ANSTOT,TNV AL,TTYPE,
	3280	TCPLT,STOP ,TRANCRNT, TRANPREV,T NLAST
	3281	"RTN","PRC ACPS",264, 0)
	3282	S (BILL,B ILLCNTR,FL AGGED)=0,A TNLAST=""
	3283	"RTN","PRC ACPS",265, 0)
	3284	; ATNLAST = The las t number f or the acc ount
	3285	"RTN","PRC ACPS",266, 0)
	3286	; FLAGGED = Account level fla g noting i f audit da ta was mar ked for th is accoun
	3287	t
	3288	"RTN","PRC ACPS",267, 0)
	3289	; PRCAFIX (X) = Hold s the tota l of the n umber of t ransaction s for a bi ll that m
	3290	atch to ch eck criter ia X
	3291	"RTN","PRC ACPS",268, 0)
	3292	; Determi ne the num ber of bil l for this account
	3293	"RTN","PRC ACPS",269, 0)
	3294	S (BILLCN T,BILLCNTR )=0,BILLNU M=""
	3295	"RTN","PRC ACPS",270, 0)
	3296	; Determi ne the num ber of bil ls for thi s account
	3297	"RTN","PRC ACPS",271, 0)
	3298	F S BILL NUM=$O(^TM P("PRCAGTP S",$J,DEBT OR,BILLNUM )) Q:'BILL NUM S BIL LCNT=BILL
	3299	CNT+1
	3300	"RTN","PRC ACPS",272, 0)
	3301	; Loop th rough Bill s
	3302	"RTN","PRC ACPS",273, 0)
	3303	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3304	"RTN","PRC ACPS",274, 0)
	3305	.S BILLCN TR=BILLCNT R+1
	3306	"RTN","PRC ACPS",275, 0)
	3307	.; QUIT i f STOP fla g is set f or this Bi ll
	3308	"RTN","PRC ACPS",276, 0)
	3309	.I $P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,3)=1 S FLAGGED= FLAGGED+1 Q
	3310	"RTN","PRC ACPS",277, 0)
	3311	.; New an d set Bill Balance D ifference
	3312	"RTN","PRC ACPS",278, 0)
	3313	.N BILLDI FF
	3314	"RTN","PRC ACPS",279, 0)
	3315	.; ***** The follow ing 2 form ulas will need to be re-evalua ted once t he VA sup
	3316	plies us t he necessa ry details *****
	3317	"RTN","PRC ACPS",280, 0)
	3318	.; If the Original Bill Amoun t is not n ull use th is formula
	3319	"RTN","PRC ACPS",281, 0)
	3320	.I +$G(^T MP("PRCAGT PS",$J,DEB TOR,BILL,0 )) D
	3321	"RTN","PRC ACPS",282, 0)
	3322	..S BILLD IFF=$P($G( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,0)),U,1)- $P($G(^TMP ("PRCABIL
	3323	L",$J,DEBT OR,BILL)), U,1)+$P($G (^TMP("PRC ABILL",$J, DEBTOR,BIL L)),U,2)
	3324	"RTN","PRC ACPS",283, 0)
	3325	.; If the Original Amount is null use t his formul a
	3326	"RTN","PRC ACPS",284, 0)
	3327	.I '+$G(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, 0)) D
	3328	"RTN","PRC ACPS",285, 0)
	3329	..S BILLD IFF=$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,1)-$P ($G(^TMP(" PRCABILL"
	3330	,$J,DEBTOR ,BILL)),U, 2)
	3331	"RTN","PRC ACPS",286, 0)
	3332	.; Quit i f Bill Bal ance Diffe rence is z ero
	3333	"RTN","PRC ACPS",287, 0)
	3334	.I 'BILLD IFF Q
	3335	"RTN","PRC ACPS",288, 0)
	3336	.; PRCAFI X(X) = Hol ds the tot al of the number of transactio ns for a b ill that
	3337	match to c heck crite ria X
	3338	"RTN","PRC ACPS",289, 0)
	3339	.; PRCATT TF = Total Transacti on Types t o Fix
	3340	"RTN","PRC ACPS",290, 0)
	3341	.N PRCATT TF,PRCAFIX
	3342	"RTN","PRC ACPS",291, 0)
	3343	.S (PRCAT TTF,TRANST OT,TTYPE,T NVAL)=0
	3344	"RTN","PRC ACPS",292, 0)
	3345	.S (TN,TN LAST)=""
	3346	"RTN","PRC ACPS",293, 0)
	3347	.; Initia lize type of fix cou nts
	3348	"RTN","PRC ACPS",294, 0)
	3349	.F I=1:1: 4 S PRCAFI X(I)=""
	3350	"RTN","PRC ACPS",295, 0)
	3351	.;
	3352	"RTN","PRC ACPS",296, 0)
	3353	.F S TN= $O(^TMP("P RCAGTPS",$ J,DEBTOR,B ILL,TN)) Q :TN="" D
	3354	"RTN","PRC ACPS",297, 0)
	3355	..; Save first tran saction nu mber
	3356	"RTN","PRC ACPS",298, 0)
	3357	..S (ATNL AST,TNLAST )=TN
	3358	"RTN","PRC ACPS",299, 0)
	3359	..; IF Tr ansaction number = 0 update Tr ansaction Total with (#15) TRA NS. AMOUN
	3360	T from #43 3
	3361	"RTN","PRC ACPS",300, 0)
	3362	..I TN=0 S TRANSTOT =TRANSTOT+ ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN) Q
	3363	"RTN","PRC ACPS",301, 0)
	3364	..; Set T NVAL = (#1 5) TRANS. AMOUNT fro m #433
	3365	"RTN","PRC ACPS",302, 0)
	3366	..S TNVAL =$P(^TMP(" PRCAGTPS", $J,DEBTOR, BILL,TN),U ,1)
	3367	"RTN","PRC ACPS",303, 0)
	3368	..; Set T TYPE = (#1 2) TRANSAC TION TYPE from #433
	3369	"RTN","PRC ACPS",304, 0)
	3370	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3371	"RTN","PRC ACPS",305, 0)
	3372	..; Set T CPLT = (#1 0) INCOMPL ETE TRANSA CTION FLAG
	3373	"RTN","PRC ACPS",306, 0)
	3374	..S TCPLT =+$P($G(^P RCA(433,TN ,0)),U,10)
	3375	"RTN","PRC ACPS",307, 0)
	3376	..; I thi nk this wi ll always be blank
	3377	"RTN","PRC ACPS",308, 0)
	3378	..S TRDMR D=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,10)
	3379	"RTN","PRC ACPS",309, 0)
	3380	..; I thi nk this wi ll always be blank
	3381	"RTN","PRC ACPS",310, 0)
	3382	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3383	"RTN","PRC ACPS",311, 0)
	3384	..; Quit it this tr ansaction was previo usly used to correct an out of balance
	3385	scenario
	3386	"RTN","PRC ACPS",312, 0)
	3387	..S TN9=$ G(^PRCA(43 3,TN,9))
	3388	"RTN","PRC ACPS",313, 0)
	3389	..Q:$P(TN 9,U,4)'=""
	3390	"RTN","PRC ACPS",314, 0)
	3391	..;
	3392	"RTN","PRC ACPS",315, 0)
	3393	..; Check #1 - Tran saction wi th missing $ amount & Transact ion Type ' = Comment
	3394	(#45)
	3395	"RTN","PRC ACPS",316, 0)
	3396	..;I TNVA L="",(TTYP E'=45) D Q
	3397	"RTN","PRC ACPS",317, 0)
	3398	..;.S PRC AFIX(1)=$G (PRCAFIX(1 ))+1,IENCR RT=TN
	3399	"RTN","PRC ACPS",318, 0)
	3400	..;.S PRC AFIX(1,TN) =""
	3401	"RTN","PRC ACPS",319, 0)
	3402	..;
	3403	"RTN","PRC ACPS",320, 0)
	3404	..; Check #2 - Tran saction ma rked as In complete w ith +$ amo unt matchi ng off by
	3405	amount
	3406	"RTN","PRC ACPS",321, 0)
	3407	..I TNVAL =BILLDIFF I TCPLT D Q
	3408	"RTN","PRC ACPS",322, 0)
	3409	...Q:(TTY PE=45)
	3410	"RTN","PRC ACPS",323, 0)
	3411	...I TRDM RD Q
	3412	"RTN","PRC ACPS",324, 0)
	3413	...S PRCA FIX(2)=$G( PRCAFIX(2) )+1,IENCRR T=TN
	3414	"RTN","PRC ACPS",325, 0)
	3415	...S PRCA FIX(2,TN)= ""
	3416	"RTN","PRC ACPS",326, 0)
	3417	..;
	3418	"RTN","PRC ACPS",327, 0)
	3419	..; Check #3 - Tran saction ma rked as In complete w ith -$ amo unt matchi ng off by
	3420	amount
	3421	"RTN","PRC ACPS",328, 0)
	3422	..I -TNVA L=BILLDIFF I TCPLT D Q
	3423	"RTN","PRC ACPS",329, 0)
	3424	...Q:(TTY PE=45)
	3425	"RTN","PRC ACPS",330, 0)
	3426	...S PRCA FIX(3)=$G( PRCAFIX(3) )+1,IENCRR T=TN
	3427	"RTN","PRC ACPS",331, 0)
	3428	...S PRCA FIX(3,TN)= ""
	3429	"RTN","PRC ACPS",332, 0)
	3430	..;
	3431	"RTN","PRC ACPS",333, 0)
	3432	..; Check #4 - Dupl icate Tran saction
	3433	"RTN","PRC ACPS",334, 0)
	3434	..I TTYPE '=45,($P(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, TN),U,12)= 1) D
	3435	"RTN","PRC ACPS",335, 0)
	3436	...S PRCA FIX(4)=$G( PRCAFIX(4) )+1,IENCRR T=TN
	3437	"RTN","PRC ACPS",336, 0)
	3438	...S PRCA FIX(4,TN)= ""
	3439	"RTN","PRC ACPS",337, 0)
	3440	.;
	3441	"RTN","PRC ACPS",338, 0)
	3442	.; Quit i f there we re no tran sactions f or this bi ll
	3443	"RTN","PRC ACPS",339, 0)
	3444	.I $G(IEN CRRT)=""!( $G(TNLAST) ="") Q
	3445	"RTN","PRC ACPS",340, 0)
	3446	.; If we are on the last Bill and there were no t ransaction s for the entire ac
	3447	count Quit
	3448	"RTN","PRC ACPS",341, 0)
	3449	.I BILLCN TR=BILLCNT ,ATNLAST=" " Q
	3450	"RTN","PRC ACPS",342, 0)
	3451	.;
	3452	"RTN","PRC ACPS",343, 0)
	3453	.F I=1:1: 4 D
	3454	"RTN","PRC ACPS",344, 0)
	3455	..S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3456	"RTN","PRC ACPS",345, 0)
	3457	.; if you get to he re the bil l was out of balance and if it shows not hing to f
	3458	ix, set la st transac tion
	3459	"RTN","PRC ACPS",346, 0)
	3460	.; for th is Bill to NOT FIXAB LE
	3461	"RTN","PRC ACPS",347, 0)
	3462	.I PRCATT TF=0 D UPD TLTR^PRCAC PSA($G(TNL AST)) S FL AGGED=1 Q
	3463	"RTN","PRC ACPS",348, 0)
	3464	.; Update this bill
	3465	"RTN","PRC ACPS",349, 0)
	3466	.D FIXBIL L(.FLAGGED )
	3467	"RTN","PRC ACPS",350, 0)
	3468	Q:FLAGGED
	3469	"RTN","PRC ACPS",351, 0)
	3470	; The acc ount was o ut of bala nce but no thing was found on a ny bill th at could
	3471	be fixed.
	3472	"RTN","PRC ACPS",352, 0)
	3473	; Mark th e last tra nsaction f or the las t bill for this acco unt as not fixable.
	3474	"RTN","PRC ACPS",353, 0)
	3475	I 'FLAGGE D D UPDTLT R^PRCACPSA ($G(ATNLAS T))
	3476	"RTN","PRC ACPS",354, 0)
	3477	Q
	3478	"RTN","PRC ACPS",355, 0)
	3479	;
	3480	"RTN","PRC ACPS",356, 0)
	3481	FIXBILL(FL AGGED) ;Up date a sin gle bill u sing PRCAF IX array
	3482	"RTN","PRC ACPS",357, 0)
	3483	; Make up date deter mination b ased on ch ecks 1 - 4 .
	3484	"RTN","PRC ACPS",358, 0)
	3485	; Sum up check tota ls
	3486	"RTN","PRC ACPS",359, 0)
	3487	;F I=1:1: 4 D
	3488	"RTN","PRC ACPS",360, 0)
	3489	;.S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3490	"RTN","PRC ACPS",361, 0)
	3491	; Get cur rent date/ time
	3492	"RTN","PRC ACPS",362, 0)
	3493	N PRCADAT E
	3494	"RTN","PRC ACPS",363, 0)
	3495	D NOW^%DT C
	3496	"RTN","PRC ACPS",364, 0)
	3497	S PRCADAT E=X
	3498	"RTN","PRC ACPS",365, 0)
	3499	; Otherwi se there i s only 1 b ad transac tion so up date as ne eded
	3500	"RTN","PRC ACPS",366, 0)
	3501	; Lock Re cord
	3502	"RTN","PRC ACPS",367, 0)
	3503	L +^PRCA( 433,IENCRR T,9):DILOC KTM
	3504	"RTN","PRC ACPS",368, 0)
	3505	; If lock not obtai ned, updat e number o f transact ions that couldn't b e fixed
	3506	"RTN","PRC ACPS",369, 0)
	3507	Q:'$T
	3508	"RTN","PRC ACPS",370, 0)
	3509	; Set FDA array for the neces sary field s based on the type of fix ide ntified
	3510	"RTN","PRC ACPS",371, 0)
	3511	N PRCAFDA
	3512	"RTN","PRC ACPS",372, 0)
	3513	;I PRCAFI X(1) D
	3514	"RTN","PRC ACPS",373, 0)
	3515	;.S PRCAF DA(433,IEN CRRT_",",1 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3516	"RTN","PRC ACPS",374, 0)
	3517	;.S PRCAF DA(433,IEN CRRT_",",9 4)=PRCADAT E
	3518	"RTN","PRC ACPS",375, 0)
	3519	;.S PRCAF DA(433,IEN CRRT_",",9 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3520	"RTN","PRC ACPS",376, 0)
	3521	;.S PRCAF DA(433,IEN CRRT_",",9 6)="N" ; N ULL TRANSA CTION AMOU NT
	3522	"RTN","PRC ACPS",377, 0)
	3523	; Check # 2 - Transa ction mark ed as Inco mplete wit h +$ amoun t matching off by a
	3524	mount
	3525	"RTN","PRC ACPS",378, 0)
	3526	; Check # 3 - Transa ction mark ed as Inco mplete wit h -$ amoun t matching off by a
	3527	mount
	3528	"RTN","PRC ACPS",379, 0)
	3529	I PRCAFIX (2)!(PRCAF IX(3)) D
	3530	"RTN","PRC ACPS",380, 0)
	3531	.S PRCAFD A(433,IENC RRT_",",10 )=""
	3532	"RTN","PRC ACPS",381, 0)
	3533	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3534	"RTN","PRC ACPS",382, 0)
	3535	.S PRCAFD A(433,IENC RRT_",",96 )="I" ; IN COMPLETE F LAG ERROR
	3536	"RTN","PRC ACPS",383, 0)
	3537	; Check # 4 - Duplic ate Transa ction
	3538	"RTN","PRC ACPS",384, 0)
	3539	I PRCAFIX (4) D
	3540	"RTN","PRC ACPS",385, 0)
	3541	.; Null o ut audit f ields on o riginal tr ansaction
	3542	"RTN","PRC ACPS",386, 0)
	3543	.S PRCAFD A(433,IENC RRT-1_",", 94)=""
	3544	"RTN","PRC ACPS",387, 0)
	3545	.S PRCAFD A(433,IENC RRT-1_",", 95)=""
	3546	"RTN","PRC ACPS",388, 0)
	3547	.S PRCAFD A(433,IENC RRT-1_",", 96)=""
	3548	"RTN","PRC ACPS",389, 0)
	3549	.L +^PRCA (433,IENCR RT-1,9):DI LOCKTM
	3550	"RTN","PRC ACPS",390, 0)
	3551	.Q:'$T
	3552	"RTN","PRC ACPS",391, 0)
	3553	.D FILE^D IE(,"PRCAF DA")
	3554	"RTN","PRC ACPS",392, 0)
	3555	.L -^PRCA (433,IENCR RT-1,9)
	3556	"RTN","PRC ACPS",393, 0)
	3557	.; Set th e fields f or the dup licate tra nsaction
	3558	"RTN","PRC ACPS",394, 0)
	3559	.S PRCAFD A(433,IENC RRT_",",10 )=1 ; INCO MPLETE TRA NSACTION
	3560	"RTN","PRC ACPS",395, 0)
	3561	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3562	"RTN","PRC ACPS",396, 0)
	3563	.S PRCAFD A(433,IENC RRT_",",95 )=$S(BILLD IFF>0:BILL DIFF,1:-BI LLDIFF)
	3564	"RTN","PRC ACPS",397, 0)
	3565	.S PRCAFD A(433,IENC RRT_",",96 )="D" ; DU PLICATE TR ANSACTION
	3566	"RTN","PRC ACPS",398, 0)
	3567	; Update Transactio n
	3568	"RTN","PRC ACPS",399, 0)
	3569	D FILE^DI E(,"PRCAFD A")
	3570	"RTN","PRC ACPS",400, 0)
	3571	S FLAGGED =1
	3572	"RTN","PRC ACPS",401, 0)
	3573	; Unlock file
	3574	"RTN","PRC ACPS",402, 0)
	3575	L -^PRCA( 433,IENCRR T,9)
	3576	"RTN","PRC ACPS",403, 0)
	3577	K TMBSNC, IENCRRT
	3578	"RTN","PRC ACPS",404, 0)
	3579	Q
	3580	"RTN","PRC ACPS",405, 0)
	3581	;
	3582	"RTN","PRC ACPS",406, 0)
	3583	DIQOUTCS(D IQOUT) ;Re turn check sum for a processed DIQOUT arr ay.
	3584	"RTN","PRC ACPS",407, 0)
	3585	N CS,DATA ,FIELD,FNU M,IENS,IND ,SFN,STRIN G,TARGET,T EXT,WP
	3586	"RTN","PRC ACPS",408, 0)
	3587	S FNUM=$O (DIQOUT("" ))
	3588	"RTN","PRC ACPS",409, 0)
	3589	S (CS,FNU M)=0
	3590	"RTN","PRC ACPS",410, 0)
	3591	F S FNUM =$O(DIQOUT (FNUM)) Q: FNUM="" D
	3592	"RTN","PRC ACPS",411, 0)
	3593	.S IENS=" "
	3594	"RTN","PRC ACPS",412, 0)
	3595	.F S IEN S=$O(DIQOU T(FNUM,IEN S)) Q:IENS ="" D
	3596	"RTN","PRC ACPS",413, 0)
	3597	..S FIELD =0
	3598	"RTN","PRC ACPS",414, 0)
	3599	..F S FI ELD=$O(DIQ OUT(FNUM,I ENS,FIELD) ) Q:FIELD= "" D
	3600	"RTN","PRC ACPS",415, 0)
	3601	...S DATA =DIQOUT(FN UM,IENS,FI ELD)
	3602	"RTN","PRC ACPS",416, 0)
	3603	...S TEXT =FNUM_$L(I ENS,",")_F IELD_DATA
	3604	"RTN","PRC ACPS",417, 0)
	3605	...S CS=$ $CRC32^XLF CRC(TEXT,C S)
	3606	"RTN","PRC ACPS",418, 0)
	3607	Q CS
	3608	"RTN","PRC ACPS",419, 0)
	3609	;
	3610	"RTN","PRC ACPS",420, 0)
	3611	USRMSG ;se nds mailma n message to the PRC ACPS mail group
	3612	"RTN","PRC ACPS",421, 0)
	3613	N XMY,XMD UZ,XMSUB,X MTEXT,X
	3614	"RTN","PRC ACPS",422, 0)
	3615	S XMDUZ=" AR PACKAGE "
	3616	"RTN","PRC ACPS",423, 0)
	3617	S XMY("G. PRCACPS")= ""
	3618	"RTN","PRC ACPS",424, 0)
	3619	S XMSUB=" CPS AUTO-C ORRECTION COMPLETE " _$E(DT,4,5 )_"/"_$E(D T,6,7)_"/" _$E(DT,2,
	3620	3)
	3621	"RTN","PRC ACPS",425, 0)
	3622	S X(1)="C onsolidate d Patient Statement Auto-Corre ction"
	3623	"RTN","PRC ACPS",426, 0)
	3624	S X(2)="P rogram com pleted on "_$$FMTE^X LFDT($$NOW ^XLFDT()," 5P")
	3625	"RTN","PRC ACPS",427, 0)
	3626	S XMTEXT= "X("
	3627	"RTN","PRC ACPS",428, 0)
	3628	D ^XMD
	3629	"RTN","PRC ACPS",429, 0)
	3630	; Remove ^XTMP node
	3631	"RTN","PRC ACPS",430, 0)
	3632	K ^XTMP(" PRCACPS",0 )
	3633	"RTN","PRC ACPS",431, 0)
	3634	Q
	3635	"RTN","PRC ACPS1")
	3636	0^28^B1912 8158^n/a
	3637	"RTN","PRC ACPS1",1,0 )
	3638	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	3639	"RTN","PRC ACPS1",2,0 )
	3640	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	3641	"RTN","PRC ACPS1",3,0 )
	3642	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3643	"RTN","PRC ACPS1",4,0 )
	3644	;
	3645	"RTN","PRC ACPS1",5,0 )
	3646	Q
	3647	"RTN","PRC ACPS1",6,0 )
	3648	;
	3649	"RTN","PRC ACPS1",7,0 )
	3650	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	3651	"RTN","PRC ACPS1",8,0 )
	3652	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	3653	"RTN","PRC ACPS1",9,0 )
	3654	S RCFULL= 1 ;run the full debt or list
	3655	"RTN","PRC ACPS1",10, 0)
	3656	W !,"Queu e the pati ent statem ent update program t o run:"
	3657	"RTN","PRC ACPS1",11, 0)
	3658	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	3659	"RTN","PRC ACPS1",12, 0)
	3660	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	3661	"RTN","PRC ACPS1",13, 0)
	3662	D ^%ZTLOA D
	3663	"RTN","PRC ACPS1",14, 0)
	3664	Q
	3665	"RTN","PRC ACPS1",15, 0)
	3666	;
	3667	"RTN","PRC ACPS1",16, 0)
	3668	DEBTOR ;ca lled by rc cpcbj
	3669	"RTN","PRC ACPS1",17, 0)
	3670	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	3671	"RTN","PRC ACPS1",18, 0)
	3672	K ^XTMP(" RCCBSS",$J )
	3673	"RTN","PRC ACPS1",19, 0)
	3674	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	3675	"RTN","PRC ACPS1",20, 0)
	3676	S DEBTOR= 0
	3677	"RTN","PRC ACPS1",21, 0)
	3678	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	3679	"RTN","PRC ACPS1",22, 0)
	3680	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	3681	"RTN","PRC ACPS1",23, 0)
	3682	.Q:$P(DEB TOR0,"^")' ["DPT("
	3683	"RTN","PRC ACPS1",24, 0)
	3684	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	3685	"RTN","PRC ACPS1",25, 0)
	3686	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	3687	"RTN","PRC ACPS1",26, 0)
	3688	.D RECPD
	3689	"RTN","PRC ACPS1",27, 0)
	3690	D COMPILE
	3691	"RTN","PRC ACPS1",28, 0)
	3692	K ^XTMP(" RCCBSS",$J )
	3693	"RTN","PRC ACPS1",29, 0)
	3694	Q
	3695	"RTN","PRC ACPS1",30, 0)
	3696	;
	3697	"RTN","PRC ACPS1",31, 0)
	3698	RECPD(BILL ) ;add a n ew account update
	3699	"RTN","PRC ACPS1",32, 0)
	3700	N REC,RCD FN
	3701	"RTN","PRC ACPS1",33, 0)
	3702	S RCDFN=+ DEBTOR0
	3703	"RTN","PRC ACPS1",34, 0)
	3704	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	3705	"RTN","PRC ACPS1",35, 0)
	3706	S REC=REC _$$SITE^RC MSITE_$$UP ^XLFSTR($S (($$SSN^RC FN01(DEBTO R)]"")&($$ NAM^RCFN0
	3707	1(DEBTOR)] ""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),
	3708	1,5)," "," "),1:""))_ "^"
	3709	"RTN","PRC ACPS1",36, 0)
	3710	S REC=REC _RCDFN_"^"
	3711	"RTN","PRC ACPS1",37, 0)
	3712	S BALDT=$ $BILLS(DEB TOR)
	3713	"RTN","PRC ACPS1",38, 0)
	3714	S CBSSTOT =+$P(DEBTO R7,U,6)
	3715	"RTN","PRC ACPS1",39, 0)
	3716	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	3717	"RTN","PRC ACPS1",40, 0)
	3718	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	3719	"RTN","PRC ACPS1",41, 0)
	3720	S REC=REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|"
	3721	"RTN","PRC ACPS1",42, 0)
	3722	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	3723	"RTN","PRC ACPS1",43, 0)
	3724	Q
	3725	"RTN","PRC ACPS1",44, 0)
	3726	;
	3727	"RTN","PRC ACPS1",45, 0)
	3728	BILLS(DEBT OR) ;get o ldest bill date
	3729	"RTN","PRC ACPS1",46, 0)
	3730	N BALTOT, BILL,BN0,P RPDT,OLDDT
	3731	"RTN","PRC ACPS1",47, 0)
	3732	S BILL=""
	3733	"RTN","PRC ACPS1",48, 0)
	3734	S BALTOT= 0,OLDDT=99 99999
	3735	"RTN","PRC ACPS1",49, 0)
	3736	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3737	"RTN","PRC ACPS1",50, 0)
	3738	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	3739	"RTN","PRC ACPS1",51, 0)
	3740	.S BN0=$G (^PRCA(430 ,BILL,0))
	3741	"RTN","PRC ACPS1",52, 0)
	3742	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	3743	"RTN","PRC ACPS1",53, 0)
	3744	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	3745	"RTN","PRC ACPS1",54, 0)
	3746	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	3747	"RTN","PRC ACPS1",55, 0)
	3748	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	3749	"RTN","PRC ACPS1",56, 0)
	3750	;
	3751	"RTN","PRC ACPS1",57, 0)
	3752	COMPILE ;
	3753	"RTN","PRC ACPS1",58, 0)
	3754	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	3755	"RTN","PRC ACPS1",59, 0)
	3756	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	3757	"RTN","PRC ACPS1",60, 0)
	3758	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	3759	"RTN","PRC ACPS1",61, 0)
	3760	.I REC>45 0 D
	3761	"RTN","PRC ACPS1",62, 0)
	3762	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	3763	"RTN","PRC ACPS1",63, 0)
	3764	..D HEADE R
	3765	"RTN","PRC ACPS1",64, 0)
	3766	..D AITCM SG
	3767	"RTN","PRC ACPS1",65, 0)
	3768	..S REC=0 ,SEQ=SEQ+1
	3769	"RTN","PRC ACPS1",66, 0)
	3770	..Q
	3771	"RTN","PRC ACPS1",67, 0)
	3772	.S REC=RE C+1
	3773	"RTN","PRC ACPS1",68, 0)
	3774	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	3775	"RTN","PRC ACPS1",69, 0)
	3776	.Q
	3777	"RTN","PRC ACPS1",70, 0)
	3778	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	3779	"RTN","PRC ACPS1",71, 0)
	3780	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	3781	"RTN","PRC ACPS1",72, 0)
	3782	D HEADER
	3783	"RTN","PRC ACPS1",73, 0)
	3784	D AITCMSG
	3785	"RTN","PRC ACPS1",74, 0)
	3786	Q
	3787	"RTN","PRC ACPS1",75, 0)
	3788	;
	3789	"RTN","PRC ACPS1",76, 0)
	3790	AITCMSG ;
	3791	"RTN","PRC ACPS1",77, 0)
	3792	N XMY,XMD UZ,XMSUB,X MTEXT
	3793	"RTN","PRC ACPS1",78, 0)
	3794	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3795	"RTN","PRC ACPS1",79, 0)
	3796	S XMDUZ=" AR PACKAGE "
	3797	"RTN","PRC ACPS1",80, 0)
	3798	;S XMY("X XX@Q- URL ")=""
	3799	"RTN","PRC ACPS1",81, 0)
	3800	S X=$O(^R CT(349.1," B","PU",0) )
	3801	"RTN","PRC ACPS1",82, 0)
	3802	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	3803	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	3804	"RTN","PRC ACPS1",83, 0)
	3805	S XMY("G. PRCACPS")= ""
	3806	"RTN","PRC ACPS1",84, 0)
	3807	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	3808	"RTN","PRC ACPS1",85, 0)
	3809	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	3810	"RTN","PRC ACPS1",86, 0)
	3811	D ^XMD
	3812	"RTN","PRC ACPS1",87, 0)
	3813	K ^XTMP(" RCCBSS",$J ,"BUILD",S EQ)
	3814	"RTN","PRC ACPS1",88, 0)
	3815	Q
	3816	"RTN","PRC ACPS1",89, 0)
	3817	;
	3818	"RTN","PRC ACPS1",90, 0)
	3819	HEADER ;
	3820	"RTN","PRC ACPS1",91, 0)
	3821	;incremen t batch se quence num ber, build new heade r
	3822	"RTN","PRC ACPS1",92, 0)
	3823	N RCMSG,S ITE
	3824	"RTN","PRC ACPS1",93, 0)
	3825	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3826	"RTN","PRC ACPS1",94, 0)
	3827	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	3828	"RTN","PRC ACPS1",95, 0)
	3829	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	3830	"RTN","PRC ACPS1",96, 0)
	3831	Q
	3832	"RTN","PRC ACPS1",97, 0)
	3833	;
	3834	"RTN","PRC ACPS1",98, 0)
	3835	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and tra
	3836	iling sign
	3837	"RTN","PRC ACPS1",99, 0)
	3838	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	3839	"RTN","PRC ACPS1",100 ,0)
	3840	S AMT=$TR ($J(AMT,9, 2)," ","")
	3841	"RTN","PRC ACPS1",101 ,0)
	3842	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	3843	"RTN","PRC ACPS1",102 ,0)
	3844	E S AMT= AMT_"+"
	3845	"RTN","PRC ACPS1",103 ,0)
	3846	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3847	"RTN","PRC ACPS1",104 ,0)
	3848	Q Q AMT
	3849	"RTN","PRC ACPS1",105 ,0)
	3850	;
	3851	"RTN","PRC ACPS1",106 ,0)
	3852	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	3853	"RTN","PRC ACPS1",107 ,0)
	3854	N YR
	3855	"RTN","PRC ACPS1",108 ,0)
	3856	I '$G(DAT ) G QDAT
	3857	"RTN","PRC ACPS1",109 ,0)
	3858	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	3859	"RTN","PRC ACPS1",110 ,0)
	3860	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	3861	"RTN","PRC ACPS1",111 ,0)
	3862	QDAT Q ""
	3863	"RTN","PRC ACPS1",112 ,0)
	3864	;
	3865	"RTN","PRC ACPS1",113 ,0)
	3866	BLANK(X) ; returns 'x ' blank sp aces
	3867	"RTN","PRC ACPS1",114 ,0)
	3868	N BLANK
	3869	"RTN","PRC ACPS1",115 ,0)
	3870	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3871	"RTN","PRC ACPS1",116 ,0)
	3872	Q BLANK
	3873	"RTN","PRC ACPS1",117 ,0)
	3874	;
	3875	"RTN","PRC ACPS1",118 ,0)
	3876	RJZF(X,Y) ;right jus tify zero fill width Y
	3877	"RTN","PRC ACPS1",119 ,0)
	3878	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3879	"RTN","PRC ACPS1",120 ,0)
	3880	Q X
	3881	"RTN","PRC ACPS1",121 ,0)
	3882	;
	3883	"RTN","PRC ACPS1",122 ,0)
	3884	LJSF(X,Y) ;left just ified spac e filled
	3885	"RTN","PRC ACPS1",123 ,0)
	3886	S X=$E(X, 1,Y)
	3887	"RTN","PRC ACPS1",124 ,0)
	3888	S X=X_$$B LANK(Y-$L( X))
	3889	"RTN","PRC ACPS1",125 ,0)
	3890	Q X
	3891	"RTN","PRC ACPS1",126 ,0)
	3892	;
	3893	"RTN","PRC ACPS1",127 ,0)
	3894	JD() ; ret urns today 's Julian date YDOY
	3895	"RTN","PRC ACPS1",128 ,0)
	3896	N XMDDD,X MNOW,XMDT
	3897	"RTN","PRC ACPS1",129 ,0)
	3898	S XMNOW=$ $NOW^XLFDT
	3899	"RTN","PRC ACPS1",130 ,0)
	3900	S XMDT=$E (XMNOW,1,7 )
	3901	"RTN","PRC ACPS1",131 ,0)
	3902	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	3903	"RTN","PRC ACPS1",132 ,0)
	3904	Q $E(DT,3 )_XMDDD
	3905	"RTN","PRC ACPS1",133 ,0)
	3906	;
	3907	"RTN","PRC ACPS1",134 ,0)
	3908	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3909	"RTN","PRC ACPS1",135 ,0)
	3910	S:X<0 X=- X
	3911	"RTN","PRC ACPS1",136 ,0)
	3912	S X=$TR($ J(X,0,2)," .")
	3913	"RTN","PRC ACPS1",137 ,0)
	3914	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3915	"RTN","PRC ACPS1",138 ,0)
	3916	Q X
	3917	"RTN","PRC ACPS1",139 ,0)
	3918	;
	3919	"RTN","PRC ACPSA")
	3920	0^29^B3327 0653^n/a
	3921	"RTN","PRC ACPSA",1,0 )
	3922	PRCACPSA ; ALBANY/MGD -PATIENT S TATEMENTS AUTO-CORRE CTION ;09/ 21/15 3:34 PM
	3923	"RTN","PRC ACPSA",2,0 )
	3924	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 130
	3925	"RTN","PRC ACPSA",3,0 )
	3926	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3927	"RTN","PRC ACPSA",4,0 )
	3928	;
	3929	"RTN","PRC ACPSA",5,0 )
	3930	Q
	3931	"RTN","PRC ACPSA",6,0 )
	3932	;
	3933	"RTN","PRC ACPSA",7,0 )
	3934	BILLQUIT(D EBTOR,BILL ) ;
	3935	"RTN","PRC ACPSA",8,0 )
	3936	; check n ews and in itializati ons
	3937	"RTN","PRC ACPSA",9,0 )
	3938	N FILENUM ,IENCRRT,I ENPREV,PRC ABFIX,PRCA BST,PRCAFD A,PRCACUR, PRCACUR1,P RCAPRV,PR
	3939	CAPRV1,TN, TNLAST,TRN SCRRT,TRNS PREV,X
	3940	"RTN","PRC ACPSA",10, 0)
	3941	S TNLAST= ""
	3942	"RTN","PRC ACPSA",11, 0)
	3943	S PRCABFI X=0
	3944	"RTN","PRC ACPSA",12, 0)
	3945	S TN=0
	3946	"RTN","PRC ACPSA",13, 0)
	3947	F S TN=$ O(^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)) Q: 'TN D
	3948	"RTN","PRC ACPSA",14, 0)
	3949	.; Load 0 and 1 nod es
	3950	"RTN","PRC ACPSA",15, 0)
	3951	.S PRCACU R=$G(^PRCA (433,TN,0) )
	3952	"RTN","PRC ACPSA",16, 0)
	3953	.S PRCACU R1=$G(^PRC A(433,TN,1 ))
	3954	"RTN","PRC ACPSA",17, 0)
	3955	.; Quit i f this Tra nsaction i s a COMMEN T
	3956	"RTN","PRC ACPSA",18, 0)
	3957	.I $P(PRC ACUR1,U,2) =45 Q
	3958	"RTN","PRC ACPSA",19, 0)
	3959	.; Quit i f this tra nsaction w as updated earlier a s part of an previou s fix
	3960	"RTN","PRC ACPSA",20, 0)
	3961	.I $P($G( ^PRCA(433, TN,9)),U,4 ) Q
	3962	"RTN","PRC ACPSA",21, 0)
	3963	.S TNLAST =TN
	3964	"RTN","PRC ACPSA",22, 0)
	3965	.; Check if Transac tion is ma rked as IN COMPLETE
	3966	"RTN","PRC ACPSA",23, 0)
	3967	.I $P(PRC ACUR,U,10) =1 S PRCAB FIX=PRCABF IX+1,PRCAB FIX("I")=$ G(PRCABFIX ("I"))+1
	3968	"RTN","PRC ACPSA",24, 0)
	3969	.; Check if zero do llar amoun t
	3970	"RTN","PRC ACPSA",25, 0)
	3971	.;I $P(PR CACUR1,U,5 )="" S PRC ABFIX=PRCA BFIX+1,PRC ABFIX("N") =$G(PRCABF IX("N"))+
	3972	1
	3973	"RTN","PRC ACPSA",26, 0)
	3974	.S PRCAPR V=$G(^PRCA (433,TN-1, 0))
	3975	"RTN","PRC ACPSA",27, 0)
	3976	.S PRCAPR V1=$G(^PRC A(433,TN-1 ,1))
	3977	"RTN","PRC ACPSA",28, 0)
	3978	.; Perfor m quick hi gh level d uplicate c heck
	3979	"RTN","PRC ACPSA",29, 0)
	3980	.I $P(PRC ACUR,U,2)' =$P(PRCAPR V,U,2) Q ; QUIT if (#.03) BIL L NUMBER d on't matc
	3981	h
	3982	"RTN","PRC ACPSA",30, 0)
	3983	.I $P(PRC ACUR,U,9)' =$P(PRCAPR V,U,9) Q ; QUIT if (#42) PROC ESSED BY d on't matc
	3984	h
	3985	"RTN","PRC ACPSA",31, 0)
	3986	.I $P(PRC ACUR1,U,1) '=$P(PRCAP RV1,U,1) Q ; QUIT i f (#11) TR ANSACTION DATE don'
	3987	t match
	3988	"RTN","PRC ACPSA",32, 0)
	3989	.I $P(PRC ACUR1,U,5) '=$P(PRCAP RV1,U,5) Q ; QUIT i f (#15) TR ANS. AMOUN T don't m
	3990	atch
	3991	"RTN","PRC ACPSA",33, 0)
	3992	.; Perfor m detailed duplicate check
	3993	"RTN","PRC ACPSA",34, 0)
	3994	.S IENPRE V=TN-1,IEN CRRT=TN,FI LENUM=433
	3995	"RTN","PRC ACPSA",35, 0)
	3996	.K TRNSPR EV S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENP REV,"**"," N","TRNSPR EV","MSG"
	3997	)
	3998	"RTN","PRC ACPSA",36, 0)
	3999	.K TRNSCR RT S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENC RRT,"**"," N","TRNSCR RT","MSG"
	4000	)
	4001	"RTN","PRC ACPSA",37, 0)
	4002	.S TRNSCR RT(433,TN_ ",",.01)=T RNSPREV(43 3,(TN-1)_" ,",.01)
	4003	"RTN","PRC ACPSA",38, 0)
	4004	.I $D(TRN SPREV(433, (TN-1)_"," ,41)) S TR NSCRRT(433 ,TN_",",41 )=$G(TRNSP REV(433,(
	4005	TN-1)_",", 41))
	4006	"RTN","PRC ACPSA",39, 0)
	4007	.I $$DIQO UTCS^PRCAC PS(.TRNSPR EV)'=$$DIQ OUTCS^PRCA CPS(.TRNSC RRT) Q
	4008	"RTN","PRC ACPSA",40, 0)
	4009	.; Set du plicate fl ag which w ill be use d in START 2
	4010	"RTN","PRC ACPSA",41, 0)
	4011	.S $P(^TM P("PRCAGTP S",$J,DEBT OR,BILL,TN ),U,12)=1
	4012	"RTN","PRC ACPSA",42, 0)
	4013	.; we hav e a duplic ate so upd ate counte r
	4014	"RTN","PRC ACPSA",43, 0)
	4015	.S PRCABF IX=PRCABFI X+1,PRCABF IX("D")=$G (PRCABFIX( "D"))+1
	4016	"RTN","PRC ACPSA",44, 0)
	4017	; Get Bil l Status f or checks
	4018	"RTN","PRC ACPSA",45, 0)
	4019	S PRCABST =$P($G(^PR CA(430,BIL L,0)),U,8)
	4020	"RTN","PRC ACPSA",46, 0)
	4021	;
	4022	"RTN","PRC ACPSA",47, 0)
	4023	; 3rd pie ce of ^TMP ("PRCABILL ",$J,DEBTO R,BILL) is stop/go f lag for th is bill.
	4024	"RTN","PRC ACPSA",48, 0)
	4025	; Set bel ow and uti lized in S TART2^PRCA CPS
	4026	"RTN","PRC ACPSA",49, 0)
	4027	;
	4028	"RTN","PRC ACPSA",50, 0)
	4029	; Check f or Duplica te needs t o include Bill Statu s of ACTIV E (#16), O PEN (#42)
	4030	or CANCEL LATION (#3 9)
	4031	"RTN","PRC ACPSA",51, 0)
	4032	; If ther e was only 1 problem and that problem wa s a Duplic ate and th e Bill St
	4033	atus is AC TIVE or OP EN
	4034	"RTN","PRC ACPSA",52, 0)
	4035	; or CANC ELLATION Q uit and le t it get s et in CHEC K2
	4036	"RTN","PRC ACPSA",53, 0)
	4037	I PRCABFI X=1,$G(PRC ABFIX("D") )=1,(PRCAB ST=16!(PRC ABST=42)!( PRCABST=39 )) S $P(^
	4038	TMP("PRCAB ILL",$J,DE BTOR,BILL) ,U,3)=0 Q 0
	4039	"RTN","PRC ACPSA",54, 0)
	4040	; If a si ngle probl em on a Bi ll in a st atus other than Acti ve or Open mark las
	4041	t transact ion as NOT FIXABLE
	4042	"RTN","PRC ACPSA",55, 0)
	4043	I PRCABFI X=1,PRCABS T'=16&(PRC ABST'=42) D UPDTLTR( $G(TNLAST) )
	4044	"RTN","PRC ACPSA",56, 0)
	4045	; If a si ngle probl em on a Bi ll in a st atus of Ac tive or Op en will be further
	4046	checked in START2
	4047	"RTN","PRC ACPSA",57, 0)
	4048	I PRCABFI X=1,(PRCAB ST=16!(PRC ABST=42)) S PRCABFIX =0
	4049	"RTN","PRC ACPSA",58, 0)
	4050	; If mult iple probl ems set au dit fields for last transactio n for the Bill
	4051	"RTN","PRC ACPSA",59, 0)
	4052	I PRCABFI X>1 D UPDT LTR($G(TNL AST)) S PR CABFIX=1
	4053	"RTN","PRC ACPSA",60, 0)
	4054	; Update Bill level stop flag
	4055	"RTN","PRC ACPSA",61, 0)
	4056	S $P(^TMP ("PRCABILL ",$J,DEBTO R,BILL),U, 3)=PRCABFI X
	4057	"RTN","PRC ACPSA",62, 0)
	4058	Q PRCABFI X
	4059	"RTN","PRC ACPSA",63, 0)
	4060	;
	4061	"RTN","PRC ACPSA",64, 0)
	4062	UPDTLTR(TN LAST) ;
	4063	"RTN","PRC ACPSA",65, 0)
	4064	; Initial ize variab les
	4065	"RTN","PRC ACPSA",66, 0)
	4066	N PRCABIL L,PRCABILX ,PRCADTR,P RCATN,PRCA UPDT
	4067	"RTN","PRC ACPSA",67, 0)
	4068	; Initial ize PRCAUP DT to 0 (i .e. No). This flag is set to 1 when an transacti
	4069	on was upd ated with the audit data
	4070	"RTN","PRC ACPSA",68, 0)
	4071	S PRCAUPD T=0
	4072	"RTN","PRC ACPSA",69, 0)
	4073	; If TNLA ST was und efined or null or so mething ot her than a positive number, s
	4074	et TNLAST= 0
	4075	"RTN","PRC ACPSA",70, 0)
	4076	; If TNLA ST was a p ositive nu mber, leav e it as is
	4077	"RTN","PRC ACPSA",71, 0)
	4078	S TNLAST= +$G(TNLAST ,0)
	4079	"RTN","PRC ACPSA",72, 0)
	4080	; If the IEN was a decimal nu mber, stri p off the decimal am ount
	4081	"RTN","PRC ACPSA",73, 0)
	4082	S TNLAST= $P(TNLAST, ".",1)
	4083	"RTN","PRC ACPSA",74, 0)
	4084	; Init ch ecks for a positive IEN and no correspon ding trans action
	4085	"RTN","PRC ACPSA",75, 0)
	4086	I +TNLAST >0,'$D(^PR CA(433,TNL AST,0)) S TNLAST=0
	4087	"RTN","PRC ACPSA",76, 0)
	4088	; Init ch ecks for a positive IEN and th is Transac tion exist s
	4089	"RTN","PRC ACPSA",77, 0)
	4090	I +TNLAST >0,$D(^PRC A(433,TNLA ST,0)) D Q:PRCAUPDT
	4091	"RTN","PRC ACPSA",78, 0)
	4092	.; If thi s transact ion hasn't been prev iously use d to flag an account , use it
	4093	"RTN","PRC ACPSA",79, 0)
	4094	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="" S PRCAUPDT= 1 D UPDTSE T(TNLAST) Q
	4095	"RTN","PRC ACPSA",80, 0)
	4096	.; If thi s transact ion was pr eviously u sed to ide ntify a NO T FIXABLE issue
	4097	"RTN","PRC ACPSA",81, 0)
	4098	.; update it again to have to day's date
	4099	"RTN","PRC ACPSA",82, 0)
	4100	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="X" S PRCAUPDT =1 D UPDTS ET(TNLAST) Q
	4101	"RTN","PRC ACPSA",83, 0)
	4102	.; If thi s Transact ion was pr eviously u sed to fix an issue other than NOT FIXA
	4103	BLE,
	4104	"RTN","PRC ACPSA",84, 0)
	4105	.; reset to 0 to ma ke it find another t ransaction
	4106	"RTN","PRC ACPSA",85, 0)
	4107	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)'="", ($P($G(^PR CA(433,TNL AST,9)),U, 6)'="X")
	4108	S TNLAST=0
	4109	"RTN","PRC ACPSA",86, 0)
	4110	.Q
	4111	"RTN","PRC ACPSA",87, 0)
	4112	; If you get to her e, TNLAST was either sent in w ith a posi tive value that cou
	4113	ldn't be u sed
	4114	"RTN","PRC ACPSA",88, 0)
	4115	; OR TNLA ST was sen t in as a null or 0. Either wa y, try to find anoth er accept
	4116	able trans action to mark
	4117	"RTN","PRC ACPSA",89, 0)
	4118	; There i s a possib ility that no transa ction can be found t o mark, in which ca
	4119	se, just q uit
	4120	"RTN","PRC ACPSA",90, 0)
	4121	I +TNLAST <1 D Q:+T NLAST<1
	4122	"RTN","PRC ACPSA",91, 0)
	4123	.S PRCABI LX=""
	4124	"RTN","PRC ACPSA",92, 0)
	4125	.F S PRC ABILX=$O(^ TMP("PRCAG TPS",$J,DE BTOR,PRCAB ILX),-1) Q :'PRCABILX D Q:TN
	4126	LAST
	4127	"RTN","PRC ACPSA",93, 0)
	4128	..S PRCAT N=""
	4129	"RTN","PRC ACPSA",94, 0)
	4130	..F S PR CATN=$O(^T MP("PRCAGT PS",$J,DEB TOR,PRCABI LX,PRCATN) ,-1) Q:'PR CATN D
	4131	Q:TNLAST
	4132	"RTN","PRC ACPSA",95, 0)
	4133	...; Quit if this t ransaction from ^TMP doesn't e xist in ^P RCA(433
	4134	"RTN","PRC ACPSA",96, 0)
	4135	...I '$D( ^PRCA(433, PRCATN,0)) Q
	4136	"RTN","PRC ACPSA",97, 0)
	4137	...; If t his transa ction hasn 't been ma rked for a nything, u se it
	4138	"RTN","PRC ACPSA",98, 0)
	4139	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)="" S TNLAST= PRCATN Q
	4140	"RTN","PRC ACPSA",99, 0)
	4141	...; Chec k if this transactio n was prev iously fla gged as so me fix oth er than N
	4142	OT FIXABLE
	4143	"RTN","PRC ACPSA",100 ,0)
	4144	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)'=" X" Q
	4145	"RTN","PRC ACPSA",101 ,0)
	4146	...; If t his transc tion was p reviously marked as NOT FIXABL E, mark it again wi
	4147	th today's date
	4148	"RTN","PRC ACPSA",102 ,0)
	4149	...S TNLA ST=PRCATN
	4150	"RTN","PRC ACPSA",103 ,0)
	4151	; QUIT If no accept able trans action cou ld be foun d
	4152	"RTN","PRC ACPSA",104 ,0)
	4153	Q:+TNLAST <1
	4154	"RTN","PRC ACPSA",105 ,0)
	4155	; QUIT if this tran saction do esn't exis t for some reason
	4156	"RTN","PRC ACPSA",106 ,0)
	4157	Q:'$D(^PR CA(433,TNL AST,0))
	4158	"RTN","PRC ACPSA",107 ,0)
	4159	; Call UP DTSET to u pdate the transactio n that was identifie d
	4160	"RTN","PRC ACPSA",108 ,0)
	4161	D UPDTSET (TNLAST)
	4162	"RTN","PRC ACPSA",109 ,0)
	4163	Q
	4164	"RTN","PRC ACPSA",110 ,0)
	4165	;
	4166	"RTN","PRC ACPSA",111 ,0)
	4167	UPDTSET(TN LAST) ; On ce transac tion has b een identi fied, set the necess ary audit
	4168	fields
	4169	"RTN","PRC ACPSA",112 ,0)
	4170	; Identif y Bill for this Tran saction
	4171	"RTN","PRC ACPSA",113 ,0)
	4172	S PRCABIL L=$P($G(^P RCA(433,TN LAST,0)),U ,2)
	4173	"RTN","PRC ACPSA",114 ,0)
	4174	; Quit if bill can' t be ident ified
	4175	"RTN","PRC ACPSA",115 ,0)
	4176	Q:PRCABIL L=""
	4177	"RTN","PRC ACPSA",116 ,0)
	4178	; Use Bil l to ident ify Debtor
	4179	"RTN","PRC ACPSA",117 ,0)
	4180	S PRCADTR =$P($G(^PR CA(430,PRC ABILL,0)), U,9)
	4181	"RTN","PRC ACPSA",118 ,0)
	4182	; Quit if Debtor ca n't be def ined
	4183	"RTN","PRC ACPSA",119 ,0)
	4184	Q:PRCADTR =""
	4185	"RTN","PRC ACPSA",120 ,0)
	4186	; Quit if the stop flag for t his bill w as previou sly set in $$BILLQUI T^PRCACPS
	4187	A
	4188	"RTN","PRC ACPSA",121 ,0)
	4189	I $P($G(^ TMP("PRCAB ILL",$J,PR CADTR,PRCA BILL)),U,3 ) Q
	4190	"RTN","PRC ACPSA",122 ,0)
	4191	; Get cur rent date
	4192	"RTN","PRC ACPSA",123 ,0)
	4193	D NOW^%DT C
	4194	"RTN","PRC ACPSA",124 ,0)
	4195	N PRCADAT E
	4196	"RTN","PRC ACPSA",125 ,0)
	4197	S PRCADAT E=X
	4198	"RTN","PRC ACPSA",126 ,0)
	4199	; Set up Audit Fiel d Array
	4200	"RTN","PRC ACPSA",127 ,0)
	4201	S PRCAFDA (433,TNLAS T_",",94)= PRCADATE
	4202	"RTN","PRC ACPSA",128 ,0)
	4203	S PRCAFDA (433,TNLAS T_",",96)= "X" ; NOT FIXABLE
	4204	"RTN","PRC ACPSA",129 ,0)
	4205	S PRCAFDA (433,TNLAS T_",",97)= 1
	4206	"RTN","PRC ACPSA",130 ,0)
	4207	L +^PRCA( 433,TNLAST ,9):DILOCK TM
	4208	"RTN","PRC ACPSA",131 ,0)
	4209	; QUIT if lock not obtainable
	4210	"RTN","PRC ACPSA",132 ,0)
	4211	Q:'$T
	4212	"RTN","PRC ACPSA",133 ,0)
	4213	; Update record
	4214	"RTN","PRC ACPSA",134 ,0)
	4215	D FILE^DI E(,"PRCAFD A")
	4216	"RTN","PRC ACPSA",135 ,0)
	4217	; Unlock file
	4218	"RTN","PRC ACPSA",136 ,0)
	4219	L -^PRCA( 433,TNLAST ,9)
	4220	"RTN","PRC ACPSA",137 ,0)
	4221	Q
	4222	"RTN","PRC ACPSA",138 ,0)
	4223	;
	4224	"RTN","PRC ACPSA",139 ,0)
	4225	PRCAMAIL(P RCASTRT) ;
	4226	"RTN","PRC ACPSA",140 ,0)
	4227	; Send e- mail notif ication to the PRCAC PS mail gr oup if the Auto-Corr ect was m
	4228	anually ru n
	4229	"RTN","PRC ACPSA",141 ,0)
	4230	; when it showed to be curren tly runnin g or possi ble errore d out on a previous
	4231	attempt.
	4232	"RTN","PRC ACPSA",142 ,0)
	4233	;
	4234	"RTN","PRC ACPSA",143 ,0)
	4235	; PRCASTA RT = Exter nal format of date/t ime (i.e. OCT 12, 20 16@09:39:5 8) that t
	4236	he
	4237	"RTN","PRC ACPSA",144 ,0)
	4238	; Auto-Co rrect prog ram was la st started .
	4239	"RTN","PRC ACPSA",145 ,0)
	4240	N XMY,XMD UZ,XMSUB,X MTEXT,X
	4241	"RTN","PRC ACPSA",146 ,0)
	4242	S XMDUZ=" AR PACKAGE "
	4243	"RTN","PRC ACPSA",147 ,0)
	4244	S XMY("G. PRCACPS")= ""
	4245	"RTN","PRC ACPSA",148 ,0)
	4246	S XMSUB=" CPS AUTO-C ORRECTION FAILURE "_ $E(DT,4,5) _"/"_$E(DT ,6,7)_"/"_ $E(DT,2,3
	4247	)
	4248	"RTN","PRC ACPSA",149 ,0)
	4249	S X(1)="T he Patient Statement Auto-Corr ection Pro gram was s tarted on: "
	4250	"RTN","PRC ACPSA",150 ,0)
	4251	S X(2)=PR CASTRT_" a nd may not have comp leted norm ally."
	4252	"RTN","PRC ACPSA",151 ,0)
	4253	S X(3)=""
	4254	"RTN","PRC ACPSA",152 ,0)
	4255	S X(4)="P lease have OI&T chec k the erro r trap for any error s related to routin
	4256	e"
	4257	"RTN","PRC ACPSA",153 ,0)
	4258	S X(5)="P RCACPS on this date. "
	4259	"RTN","PRC ACPSA",154 ,0)
	4260	S XMTEXT= "X("
	4261	"RTN","PRC ACPSA",155 ,0)
	4262	D ^XMD
	4263	"RTN","PRC ACPSA",156 ,0)
	4264	Q
	4265	"RTN","PRC AG")
	4266	0^17^B7425 6403^B2201 6512
	4267	"RTN","PRC AG",1,0)
	4268	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93
	4269	2:42 PM
	4270	"RTN","PRC AG",2,0)
	4271	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 130
	4272	"RTN","PRC AG",3,0)
	4273	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4274	"RTN","PRC AG",4,0)
	4275	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	4276	"RTN","PRC AG",5,0)
	4277	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,SDT,%ZI
	4278	S,POP,ZTIO
	4279	"RTN","PRC AG",6,0)
	4280	W !!
	4281	"RTN","PRC AG",7,0)
	4282	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Sta
	4283	tements wi thin the l ast month
	4284	"RTN","PRC AG",8,0)
	4285	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	4286	"RTN","PRC AG",9,0)
	4287	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DA
	4288	T)) W !,$$ DATE^RCCPC PS1(DAT)
	4289	"RTN","PRC AG",10,0)
	4290	W !!
	4291	"RTN","PRC AG",11,0)
	4292	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4293	"RTN","PRC AG",12,0)
	4294	S DIR(0)= "DAO^^K:'$ D(^RC(341, ""STDT"",Y )) X"
	4295	"RTN","PRC AG",13,0)
	4296	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	4297	"RTN","PRC AG",14,0)
	4298	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	4299	"RTN","PRC AG",15,0)
	4300	D ^DIR
	4301	"RTN","PRC AG",16,0)
	4302	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4303	"RTN","PRC AG",17,0)
	4304	S SDT=Y
	4305	"RTN","PRC AG",18,0)
	4306	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	4307	"RTN","PRC AG",19,0)
	4308	S X=""
	4309	"RTN","PRC AG",20,0)
	4310	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	4311	"RTN","PRC AG",21,0)
	4312	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4313	"RTN","PRC AG",22,0)
	4314	S DIR(0)= "YAO"
	4315	"RTN","PRC AG",23,0)
	4316	S DIR("B" )="N"
	4317	"RTN","PRC AG",24,0)
	4318	S DIR("A" )="Do you want to St art with a Specific Patient? "
	4319	"RTN","PRC AG",25,0)
	4320	D ^DIR
	4321	"RTN","PRC AG",26,0)
	4322	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4323	"RTN","PRC AG",27,0)
	4324	I Y=0 S X =""
	4325	"RTN","PRC AG",28,0)
	4326	I Y=1 S X =$$SELNAME (SDT)
	4327	"RTN","PRC AG",29,0)
	4328	I X=-1 Q
	4329	"RTN","PRC AG",30,0)
	4330	I X'="" S BEG=X
	4331	"RTN","PRC AG",31,0)
	4332	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	4333	"RTN","PRC AG",32,0)
	4334	S X=""
	4335	"RTN","PRC AG",33,0)
	4336	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	4337	"RTN","PRC AG",34,0)
	4338	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	4339	"RTN","PRC AG",35,0)
	4340	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4341	"RTN","PRC AG",36,0)
	4342	S DIR(0)= "YAO"
	4343	"RTN","PRC AG",37,0)
	4344	S DIR("B" )="N"
	4345	"RTN","PRC AG",38,0)
	4346	S DIR("A" )="Do you want to En d with a S pecific Pa tient? "
	4347	"RTN","PRC AG",39,0)
	4348	D ^DIR
	4349	"RTN","PRC AG",40,0)
	4350	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4351	"RTN","PRC AG",41,0)
	4352	I Y=0 S X =""
	4353	"RTN","PRC AG",42,0)
	4354	I Y=1 S X =$$SELNAME (SDT)
	4355	"RTN","PRC AG",43,0)
	4356	I X=-1 Q
	4357	"RTN","PRC AG",44,0)
	4358	I X'="" S END=X
	4359	"RTN","PRC AG",45,0)
	4360	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" D Q:$D (DTOUT)!$
	4361	D(DUOUT)!$ D(DIRUT)!$ D(DIROUT) G ADT
	4362	"RTN","PRC AG",46,0)
	4363	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4364	"RTN","PRC AG",47,0)
	4365	. S DIR(0 )="E"
	4366	"RTN","PRC AG",48,0)
	4367	. D ^DIR
	4368	"RTN","PRC AG",49,0)
	4369	S HDAT=99 99999-SDT
	4370	"RTN","PRC AG",50,0)
	4371	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP
	4372	REPQ
	4373	"RTN","PRC AG",51,0)
	4374	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REP D
	4375	"RTN","PRC AG",52,0)
	4376	S ZTRTN=" REP^PRCAGS ",ZTDESC=" Reprint AR Patient S tatements" ,ZTSAVE("B EG")="",Z
	4377	TSAVE("END ")="",ZTSA VE("HDAT") ="" D ^%ZT LOAD
	4378	"RTN","PRC AG",53,0)
	4379	REPQ ; PRC A4.5313 - Kill TMP ($J Lists prior to q uit
	4380	"RTN","PRC AG",54,0)
	4381	D ^%ZISC
	4382	"RTN","PRC AG",55,0)
	4383	K ^TMP($J ,"LISTNAME "),^TMP($J ,"LISTCNT" )
	4384	"RTN","PRC AG",56,0)
	4385	Q
	4386	"RTN","PRC AG",57,0)
	4387	UB ;ENTRY FROM REPRI NT UB BILL S
	4388	"RTN","PRC AG",58,0)
	4389	S ETY="UB " ;set eve nt type to UB and us e REB sub- routine
	4390	"RTN","PRC AG",59,0)
	4391	REB ;ENTRY FROM REPR INT FOLLOW -UP LETTER S
	4392	"RTN","PRC AG",60,0)
	4393	NEW BEG,E ND,DAT,DAT E,DEB,DIC, IOP,SITE,T YP,X,Y,ZTD ESC,ZTRTN, ZTSAVE,%DT ,DA,DIR,D
	4394	TOUT
	4395	"RTN","PRC AG",61,0)
	4396	D SITE^PR CAGU
	4397	"RTN","PRC AG",62,0)
	4398	S:'$D(ETY ) ETY="FL"
	4399	"RTN","PRC AG",63,0)
	4400	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:
	4401	Y<1 REBQ
	4402	"RTN","PRC AG",64,0)
	4403	S Y=$P(Y, ".")
	4404	"RTN","PRC AG",65,0)
	4405	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",!
	4406	G REBDT
	4407	"RTN","PRC AG",66,0)
	4408	S DAT=999 9999-Y
	4409	"RTN","PRC AG",67,0)
	4410	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"f
	4411	or the dat e selected or select a start a nd/or end point."
	4412	"RTN","PRC AG",68,0)
	4413	W !,"Do n ot select bills that print on the Patien t Statemen t."
	4414	"RTN","PRC AG",69,0)
	4415	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	4416	"RTN","PRC AG",70,0)
	4417	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	4418	"RTN","PRC AG",71,0)
	4419	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I "",
	4420	18,25,5,24 ,1,2,3,4,2 3,22,""'[( "",""_$P(^ (0),U,2)_" ","")" D ^ DIC I ($D( DTOUT))!(
	4421	X["^") G R EBQ
	4422	"RTN","PRC AG",72,0)
	4423	S BEG=0,Y =+Y
	4424	"RTN","PRC AG",73,0)
	4425	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="
	4426	UB":9,1:10 ),0)) F DA TE=DAT-.00 01:0 S DAT E=$O(^RC(3 41,"AD",DE B,TYP,DATE )) Q:$P(D
	4427	ATE,".")'= DAT D
	4428	"RTN","PRC AG",74,0)
	4429	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	4430	S BEG=DA, DEB=0 Q
	4431	"RTN","PRC AG",75,0)
	4432	.Q
	4433	"RTN","PRC AG",76,0)
	4434	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	4435	"RTN","PRC AG",77,0)
	4436	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	4437	"RTN","PRC AG",78,0)
	4438	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	4439	"RTN","PRC AG",79,0)
	4440	S END="*" ,Y=+Y
	4441	"RTN","PRC AG",80,0)
	4442	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="
	4443	UB":9,1:10 ),0)) F DA TE=DAT-.00 01:0 S DAT E=$O(^RC(3 41,"AD",DE B,TYP,DATE )) Q:$P(D
	4444	ATE,".")'= DAT D
	4445	"RTN","PRC AG",81,0)
	4446	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y
	4447	S END=DA, DEB=0 Q
	4448	"RTN","PRC AG",82,0)
	4449	.Q
	4450	"RTN","PRC AG",83,0)
	4451	I END<0 W *7,!," So rry, not f ound!" G R EBDT
	4452	"RTN","PRC AG",84,0)
	4453	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	4454	"RTN","PRC AG",85,0)
	4455	W !!
	4456	"RTN","PRC AG",86,0)
	4457	REBD I ETY ="UB" S ZT IO="" G RE BD1
	4458	"RTN","PRC AG",87,0)
	4459	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	4460	"RTN","PRC AG",88,0)
	4461	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	4462	"RTN","PRC AG",89,0)
	4463	REBD1 S ZT RTN="BILL^ PRCAGS",ZT SAVE("BEG" )="",ZTSAV E("END")=" ",ZTSAVE(" DAT")="",
	4464	ZTSAVE("SI TE")="",ZT SAVE("ETY" )=""
	4465	"RTN","PRC AG",90,0)
	4466	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters")
	4467	D ^%ZTLOA D
	4468	"RTN","PRC AG",91,0)
	4469	REBQ K ETY D ^%ZISC Q
	4470	"RTN","PRC AG",92,0)
	4471	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	4472	"RTN","PRC AG",93,0)
	4473	D PRDT^PR CAGP
	4474	"RTN","PRC AG",94,0)
	4475	Q
	4476	"RTN","PRC AG",95,0)
	4477	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	4478	"RTN","PRC AG",96,0)
	4479	; There a re three v alues to R eturn from this tag
	4480	"RTN","PRC AG",97,0)
	4481	; IEN -- Number from list of Selecte d Patient
	4482	"RTN","PRC AG",98,0)
	4483	; Null -- No Pati ent Select ed from li st - used to begin o r end Sele ction lis
	4484	t
	4485	"RTN","PRC AG",99,0)
	4486	; -1 -- Quit pr ocessing f rom called tag
	4487	"RTN","PRC AG",100,0)
	4488	N IEN,CNT ,NAME
	4489	"RTN","PRC AG",101,0)
	4490	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	4491	"RTN","PRC AG",102,0)
	4492	K ^TMP($J ,"LISTNAME ")
	4493	"RTN","PRC AG",103,0)
	4494	S (IEN,CN T)=0
	4495	"RTN","PRC AG",104,0)
	4496	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	4497	"RTN","PRC AG",105,0)
	4498	. N PAT,N AME
	4499	"RTN","PRC AG",106,0)
	4500	. S PAT=$ P(^RCD(340 ,$P(^RC(34 1,IEN,0)," ^",5),0)," ;")
	4501	"RTN","PRC AG",107,0)
	4502	. S NAME= $P(^DPT(PA T,0),U)
	4503	"RTN","PRC AG",108,0)
	4504	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	4505	"RTN","PRC AG",109,0)
	4506	; Quit th e listing if no name s to displ ay
	4507	"RTN","PRC AG",110,0)
	4508	I '$D(^TM P($J,"LIST NAME")) D Q -1
	4509	"RTN","PRC AG",111,0)
	4510	. W !,"Th ere are no names to display fo r this dat e."
	4511	"RTN","PRC AG",112,0)
	4512	. S DIR(0 )="E" D ^D IR
	4513	"RTN","PRC AG",113,0)
	4514	S NAME=$$ ENTNAM
	4515	"RTN","PRC AG",114,0)
	4516	I NAME="^ " Q -1
	4517	"RTN","PRC AG",115,0)
	4518	I NAME="" Q NAME
	4519	"RTN","PRC AG",116,0)
	4520	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	4521	"RTN","PRC AG",117,0)
	4522	W !!,"Pat ient Name is not an exact matc h."
	4523	"RTN","PRC AG",118,0)
	4524	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4525	"RTN","PRC AG",119,0)
	4526	S DIR(0)= "YAO"
	4527	"RTN","PRC AG",120,0)
	4528	S DIR("B" )="N"
	4529	"RTN","PRC AG",121,0)
	4530	S DIR("A" )="Would y ou like to search Pa tient Name s for "_$$ DATE^RCCPC PS1(SDT)_
	4531	"? "
	4532	"RTN","PRC AG",122,0)
	4533	D ^DIR
	4534	"RTN","PRC AG",123,0)
	4535	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4536	"RTN","PRC AG",124,0)
	4537	I Y=0 N Q UIT D I Q UIT'=0 Q Q UIT
	4538	"RTN","PRC AG",125,0)
	4539	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4540	"RTN","PRC AG",126,0)
	4541	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4542	"RTN","PRC AG",127,0)
	4543	. S DIR(0 )="YAO"
	4544	"RTN","PRC AG",128,0)
	4545	. S DIR(" B")="Y"
	4546	"RTN","PRC AG",129,0)
	4547	. S DIR(" A")="Is th is correct ? "
	4548	"RTN","PRC AG",130,0)
	4549	. D ^DIR
	4550	"RTN","PRC AG",131,0)
	4551	. S QUIT= Y
	4552	"RTN","PRC AG",132,0)
	4553	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4554	"RTN","PRC AG",133,0)
	4555	. I QUIT= 1 S QUIT=" "
	4556	"RTN","PRC AG",134,0)
	4557	; Select Name - If Zero (0) i s returned keep tryi ng
	4558	"RTN","PRC AG",135,0)
	4559	F S IEN= $$SELNM1(N AME) I IEN '=0 Q
	4560	"RTN","PRC AG",136,0)
	4561	Q IEN
	4562	"RTN","PRC AG",137,0)
	4563	SELNM1(NM) ; Select name
	4564	"RTN","PRC AG",138,0)
	4565	N DIRUT,X CNT,DIR,CN T
	4566	"RTN","PRC AG",139,0)
	4567	K ^TMP($J ,"LISTCNT" )
	4568	"RTN","PRC AG",140,0)
	4569	S CNT=0,N AME=""
	4570	"RTN","PRC AG",141,0)
	4571	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	4572	"RTN","PRC AG",142,0)
	4573	. ; Add n ame to lis t only if first part of name m atches ent ered name
	4574	"RTN","PRC AG",143,0)
	4575	. I $E(NA ME,1,$L(NM ))'=NM Q
	4576	"RTN","PRC AG",144,0)
	4577	. I CNT=0 W @IOF,"N umber",?10 ,"Patient Name"
	4578	"RTN","PRC AG",145,0)
	4579	. S CNT=C NT+1
	4580	"RTN","PRC AG",146,0)
	4581	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	4582	"RTN","PRC AG",147,0)
	4583	. W !,CNT ,?10,NAME
	4584	"RTN","PRC AG",148,0)
	4585	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	4586	"RTN","PRC AG",149,0)
	4587	. . S DIR (0)="E" D ^DIR
	4588	"RTN","PRC AG",150,0)
	4589	. . I X=" ^" Q
	4590	"RTN","PRC AG",151,0)
	4591	. . W @IO F,"Number" ,?10,"Pati ent Name"
	4592	"RTN","PRC AG",152,0)
	4593	; If no n ames match ed entered name Quit to menu
	4594	"RTN","PRC AG",153,0)
	4595	I CNT=0 D Q QUIT
	4596	"RTN","PRC AG",154,0)
	4597	. W @IOF, "No Matche s to Patie nt Name en tered were found.",!
	4598	"RTN","PRC AG",155,0)
	4599	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4600	"RTN","PRC AG",156,0)
	4601	. S DIR(0 )="E"
	4602	"RTN","PRC AG",157,0)
	4603	. D ^DIR
	4604	"RTN","PRC AG",158,0)
	4605	. S QUIT= 0
	4606	"RTN","PRC AG",159,0)
	4607	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4608	"RTN","PRC AG",160,0)
	4609	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	4610	"RTN","PRC AG",161,0)
	4611	I XCNT="^ " Q -1
	4612	"RTN","PRC AG",162,0)
	4613	; If a va lue entere d is not i n LISTCNT, write err or and all ow retry i f request
	4614	ed
	4615	"RTN","PRC AG",163,0)
	4616	I XCNT'=" ",'$D(^TMP ($J,"LISTC NT",XCNT)) N QUIT D Q QUIT
	4617	"RTN","PRC AG",164,0)
	4618	. W !,"Va lue entere d not a li sted numbe r.",!
	4619	"RTN","PRC AG",165,0)
	4620	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4621	"RTN","PRC AG",166,0)
	4622	. S DIR(0 )="E"
	4623	"RTN","PRC AG",167,0)
	4624	. D ^DIR
	4625	"RTN","PRC AG",168,0)
	4626	. S QUIT= 0
	4627	"RTN","PRC AG",169,0)
	4628	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4629	"RTN","PRC AG",170,0)
	4630	I XCNT="" N QUIT D Q QUIT
	4631	"RTN","PRC AG",171,0)
	4632	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4633	"RTN","PRC AG",172,0)
	4634	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4635	"RTN","PRC AG",173,0)
	4636	. S DIR(0 )="YAO"
	4637	"RTN","PRC AG",174,0)
	4638	. S DIR(" B")="Y"
	4639	"RTN","PRC AG",175,0)
	4640	. S DIR(" A")="No Pa tient Sele cted. "
	4641	"RTN","PRC AG",176,0)
	4642	. S DIR(" A",1)="Is this corre ct? "
	4643	"RTN","PRC AG",177,0)
	4644	. D ^DIR
	4645	"RTN","PRC AG",178,0)
	4646	. S QUIT= Y
	4647	"RTN","PRC AG",179,0)
	4648	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4649	"RTN","PRC AG",180,0)
	4650	. I QUIT= 1 S QUIT=" "
	4651	"RTN","PRC AG",181,0)
	4652	S CNT=XCN T
	4653	"RTN","PRC AG",182,0)
	4654	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4655	"RTN","PRC AG",183,0)
	4656	S DIR(0)= "YAO"
	4657	"RTN","PRC AG",184,0)
	4658	S DIR("B" )="Y"
	4659	"RTN","PRC AG",185,0)
	4660	S DIR("A" )="...OK? "
	4661	"RTN","PRC AG",186,0)
	4662	S DIR("A" ,1)=""
	4663	"RTN","PRC AG",187,0)
	4664	S DIR("A" ,2)=$O(^TM P($J,"LIST CNT",CNT,0 ))
	4665	"RTN","PRC AG",188,0)
	4666	D ^DIR
	4667	"RTN","PRC AG",189,0)
	4668	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4669	"RTN","PRC AG",190,0)
	4670	; If user answered No, then t ry again
	4671	"RTN","PRC AG",191,0)
	4672	I Y=0 Q Y
	4673	"RTN","PRC AG",192,0)
	4674	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	4675	"RTN","PRC AG",193,0)
	4676	Q ^TMP($J ,"LISTCNT" ,CNT,NAME)
	4677	"RTN","PRC AG",194,0)
	4678	;
	4679	"RTN","PRC AG",195,0)
	4680	ENTNAM() ; Enter na me and pri nt list of names if requested
	4681	"RTN","PRC AG",196,0)
	4682	;
	4683	"RTN","PRC AG",197,0)
	4684	N HIT,X
	4685	"RTN","PRC AG",198,0)
	4686	S HIT=0
	4687	"RTN","PRC AG",199,0)
	4688	F D I H IT Q
	4689	"RTN","PRC AG",200,0)
	4690	. W !,"Pl ease enter all or pa rt of Pati ent Name: " R NAME:D TIME
	4691	"RTN","PRC AG",201,0)
	4692	. I NAME' ["?" S HIT =1 Q
	4693	"RTN","PRC AG",202,0)
	4694	. I NAME= "?" D LIST NAME(1)
	4695	"RTN","PRC AG",203,0)
	4696	. I NAME= "??" D LIS TNAME(2)
	4697	"RTN","PRC AG",204,0)
	4698	. ; If th e user ent ers a care t in LISTN AME quit a nd return a caret in NAME to
	4699	Quit appli cation
	4700	"RTN","PRC AG",205,0)
	4701	. I X="^" S NAME=X, HIT=1
	4702	"RTN","PRC AG",206,0)
	4703	Q NAME
	4704	"RTN","PRC AG",207,0)
	4705	;
	4706	"RTN","PRC AG",208,0)
	4707	LISTNAME(H EADER) ; Display li st of name
	4708	"RTN","PRC AG",209,0)
	4709	;
	4710	"RTN","PRC AG",210,0)
	4711	N NAME,CN T,DIR,DTOU T,DUOUT,DI RUT,DIROUT
	4712	"RTN","PRC AG",211,0)
	4713	S NAME="" ,CNT=0
	4714	"RTN","PRC AG",212,0)
	4715	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D TOUT)!$D(D UOUT)!$D(
	4716	DIRUT)!$D( DIROUT) Q
	4717	"RTN","PRC AG",213,0)
	4718	. I CNT=0 ,HEADER=1 W @IOF,"Pa tient Name "
	4719	"RTN","PRC AG",214,0)
	4720	. I CNT=0 ,HEADER=2 D I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	4721	"RTN","PRC AG",215,0)
	4722	. . W @IO F,"The use r can ente r all or p art of a n ame or '?' for the"
	4723	"RTN","PRC AG",216,0)
	4724	. . W !," list of na mes availa ble for th e selected date."
	4725	"RTN","PRC AG",217,0)
	4726	. . S DIR (0)="E" D ^DIR
	4727	"RTN","PRC AG",218,0)
	4728	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) Q
	4729	"RTN","PRC AG",219,0)
	4730	. . W !!, "Patient N ame"
	4731	"RTN","PRC AG",220,0)
	4732	. S CNT=C NT+1
	4733	"RTN","PRC AG",221,0)
	4734	. W !,NAM E
	4735	"RTN","PRC AG",222,0)
	4736	. I ($Y+3 )>IOSL D I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	4737	"RTN","PRC AG",223,0)
	4738	. . S DIR (0)="E" D ^DIR
	4739	"RTN","PRC AG",224,0)
	4740	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) S X="" Q
	4741	"RTN","PRC AG",225,0)
	4742	. . W @IO F,"Patient Name"
	4743	"RTN","PRC AG",226,0)
	4744	Q
	4745	"RTN","RCB EADJ")
	4746	0^24^B7710 6309^B7712 5147
	4747	"RTN","RCB EADJ",1,0)
	4748	RCBEADJ ;W ISC/RFJ-ad justment ; Jun 06, 20 14@19:11:1 9
	4749	"RTN","RCB EADJ",2,0)
	4750	;;4.5;Acc ounts Rece ivable;1 69,172,204 ,173,208,2 33,298,301 ,313;Mar 20, 1995
	4751	;Build 130
	4752	"RTN","RCB EADJ",3,0)
	4753	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4754	"RTN","RCB EADJ",4,0)
	4755	Q
	4756	"RTN","RCB EADJ",5,0)
	4757	;
	4758	"RTN","RCB EADJ",6,0)
	4759	;
	4760	"RTN","RCB EADJ",7,0)
	4761	DECREASE ; menu opt ion: creat e a decrea se adjustm ent
	4762	"RTN","RCB EADJ",8,0)
	4763	D ADJUST( "DECREASE" )
	4764	"RTN","RCB EADJ",9,0)
	4765	Q
	4766	"RTN","RCB EADJ",10,0 )
	4767	;
	4768	"RTN","RCB EADJ",11,0 )
	4769	;
	4770	"RTN","RCB EADJ",12,0 )
	4771	INCREASE ; menu opt ion: creat e an incre ase adjust ment
	4772	"RTN","RCB EADJ",13,0 )
	4773	D ADJUST( "INCREASE" )
	4774	"RTN","RCB EADJ",14,0 )
	4775	Q
	4776	"RTN","RCB EADJ",15,0 )
	4777	;
	4778	"RTN","RCB EADJ",16,0 )
	4779	ADJUST(RCB ETYPE,RCED I) ; crea te an adju stment
	4780	"RTN","RCB EADJ",17,0 )
	4781	; rcbety pe = INCRE ASE for in crease or DECREASE f or decreas e
	4782	"RTN","RCB EADJ",18,0 )
	4783	; rcedi = the ien of the bil l selected via the E DI Worklis t;ien of
	4784	"RTN","RCB EADJ",19,0 )
	4785	; XX the ER A entry or null/unde fined if b ill should be select ed
	4786	"RTN","RCB EADJ",20,0 )
	4787	N RCBILLD A
	4788	"RTN","RCB EADJ",21,0 )
	4789	F D Q:R CBILLDA<0! $G(RCEDI)
	4790	"RTN","RCB EADJ",22,0 )
	4791	. K RCT RANDA,RCLI ST
	4792	"RTN","RCB EADJ",23,0 )
	4793	. ;
	4794	"RTN","RCB EADJ",24,0 )
	4795	. ; se lect a bil l
	4796	"RTN","RCB EADJ",25,0 )
	4797	. S RCB ILLDA=$S(' $G(RCEDI): $$GETABILL ^RCBEUBIL, 1:+RCEDI)
	4798	"RTN","RCB EADJ",26,0 )
	4799	. I RCB ILLDA<1 Q
	4800	"RTN","RCB EADJ",27,0 )
	4801	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="I NCREASE") W !,"BILL HAS BEEN
	4802	REFERRED T O CROSS-SE RVICING.", !,"NO MANU AL INCREAS E ADJUSTME NTS ARE AL LOWED." Q
	4803	;prca4. 5301
	4804	"RTN","RCB EADJ",28,0 )
	4805	. I $D( ^PRCA(430, "TCSP",RCB ILLDA)),(R CBETYPE="D ECREASE") S %=2 W !! ,"IS THIS
	4806	ACTION BE ING PERFOR MED DUE TO THE CLAIM S MATCHING PROCESS? " D YN^DIC N Q:(%<0)
	4807	!(%=2) ;p rca4.530 1
	4808	"RTN","RCB EADJ",29,0 )
	4809	. ;
	4810	"RTN","RCB EADJ",30,0 )
	4811	. ; ad just the b ill
	4812	"RTN","RCB EADJ",31,0 )
	4813	. D ADJ BILL(RCBET YPE,RCBILL DA,$P($G(R CEDI),";", 2))
	4814	"RTN","RCB EADJ",32,0 )
	4815	Q
	4816	"RTN","RCB EADJ",33,0 )
	4817	;
	4818	"RTN","RCB EADJ",34,0 )
	4819	ADJBILL(RC BETYPE,RCB ILLDA,RCED IWL) ; ad just a bil l
	4820	"RTN","RCB EADJ",35,0 )
	4821	; RCEDIWL = ien of ERA entry if called from workl ist
	4822	"RTN","RCB EADJ",36,0 )
	4823	N RCAMOUN T,RCBALANC ,RCDATA7,R CLIST,RCON TADJ,RCTRA NDA,TOTALC AL,TOTALST O,I,X,Y
	4824	"RTN","RCB EADJ",37,0 )
	4825	; lock t he bill
	4826	"RTN","RCB EADJ",38,0 )
	4827	L +^PRCA( 430,RCBILL DA):5 E W !,"ANOTHE R USER IS CURRENTLY WORKING WI TH THIS B
	4828	ILL." Q
	4829	"RTN","RCB EADJ",39,0 )
	4830	;
	4831	"RTN","RCB EADJ",40,0 )
	4832	; show d ata for th e bill
	4833	"RTN","RCB EADJ",41,0 )
	4834	D SHOWBIL L^RCWROFF1 (RCBILLDA)
	4835	"RTN","RCB EADJ",42,0 )
	4836	;
	4837	"RTN","RCB EADJ",43,0 )
	4838	; check the balanc e of the b ill
	4839	"RTN","RCB EADJ",44,0 )
	4840	W !!,"Che cking the bill's bal ance ..."
	4841	"RTN","RCB EADJ",45,0 )
	4842	S RCBALAN C=$$OUTOFB AL^RCBDBBA L(RCBILLDA )
	4843	"RTN","RCB EADJ",46,0 )
	4844	I RCBALAN C="" W " I N Balance! "
	4845	"RTN","RCB EADJ",47,0 )
	4846	;
	4847	"RTN","RCB EADJ",48,0 )
	4848	; out of balance, ask to fix it
	4849	"RTN","RCB EADJ",49,0 )
	4850	I RCBALAN C'="" D I RCBILLDA< 1 D UNLOCK Q
	4851	"RTN","RCB EADJ",50,0 )
	4852	. S TOT ALCAL=$P(R CBALANC,"^ ")+$P(RCBA LANC,"^",2 )+$P(RCBAL ANC,"^",3) +$P(RCBAL
	4853	ANC,"^",4) +$P(RCBALA NC,"^",5)
	4854	"RTN","RCB EADJ",51,0 )
	4855	. S RCD ATA7=$G(^P RCA(430,RC BILLDA,7))
	4856	"RTN","RCB EADJ",52,0 )
	4857	. S TOT ALSTO=$P(R CDATA7,"^" )+$P(RCDAT A7,"^",2)+ $P(RCDATA7 ,"^",3)+$P (RCDATA7,
	4858	"^",4)+$P( RCDATA7,"^ ",5)
	4859	"RTN","RCB EADJ",53,0 )
	4860	. W " O UT of Bala nce!"
	4861	"RTN","RCB EADJ",54,0 )
	4862	. W !!, " B ALANCE:",$ J("Calcula ted",12),$ J("Stored" ,12)
	4863	"RTN","RCB EADJ",55,0 )
	4864	. W !," -- ----- ",$J ("-------- ----",12), $J("------ ------",1
	4865	2)
	4866	"RTN","RCB EADJ",56,0 )
	4867	. W !," Pr incipal Ba lance:",$J ($P(RCBALA NC,"^",1), 12,2),$J($ P(RCDATA7
	4868	,"^",1),12 ,2)
	4869	"RTN","RCB EADJ",57,0 )
	4870	. I +$P (RCBALANC, "^",1)'=+$ P(RCDATA7, "^",1) W " <<-- OUT OF BALANC E"
	4871	"RTN","RCB EADJ",58,0 )
	4872	. W !," I nterest Ba lance:",$J ($P(RCBALA NC,"^",2), 12,2),$J($ P(RCDATA7
	4873	,"^",2),12 ,2)
	4874	"RTN","RCB EADJ",59,0 )
	4875	. I +$P (RCBALANC, "^",2)'=+$ P(RCDATA7, "^",2) W " <<-- OUT OF BALANC E"
	4876	"RTN","RCB EADJ",60,0 )
	4877	. W !," Admin Ba lance:",$J ($P(RCBALA NC,"^",3), 12,2),$J($ P(RCDATA7
	4878	,"^",3),12 ,2)
	4879	"RTN","RCB EADJ",61,0 )
	4880	. I +$P (RCBALANC, "^",3)'=+$ P(RCDATA7, "^",3) W " <<-- OUT OF BALANC E"
	4881	"RTN","RCB EADJ",62,0 )
	4882	. W !," MF Ba lance:",$J ($P(RCBALA NC,"^",4), 12,2),$J($ P(RCDATA7
	4883	,"^",4),12 ,2)
	4884	"RTN","RCB EADJ",63,0 )
	4885	. I +$P (RCBALANC, "^",4)'=+$ P(RCDATA7, "^",4) W " <<-- OUT OF BALANC E"
	4886	"RTN","RCB EADJ",64,0 )
	4887	. W !," CC Ba lance:",$J ($P(RCBALA NC,"^",5), 12,2),$J($ P(RCDATA7
	4888	,"^",5),12 ,2)
	4889	"RTN","RCB EADJ",65,0 )
	4890	. I +$P (RCBALANC, "^",5)'=+$ P(RCDATA7, "^",5) W " <<-- OUT OF BALANC E"
	4891	"RTN","RCB EADJ",66,0 )
	4892	. W !," -- ----- ",$J ("-------- -----",12) ,$J("----- --------"
	4893	,12)
	4894	"RTN","RCB EADJ",67,0 )
	4895	. W !," TOTAL:",$J (TOTALCAL, 12,2),$J(T OTALSTO,12 ,2)
	4896	"RTN","RCB EADJ",68,0 )
	4897	. I +TO TALCAL'=+T OTALSTO W " <<-- OU T OF BALAN CE"
	4898	"RTN","RCB EADJ",69,0 )
	4899	. ;
	4900	"RTN","RCB EADJ",70,0 )
	4901	. ; as k to fix t he balance s
	4902	"RTN","RCB EADJ",71,0 )
	4903	. S Y=$ $ASKFIX I Y'=1 W !," NOTE: Yo u must fix the Balan ce Discrep ancy befo
	4904	re process ing an adj ustment!" S RCBILLDA =0 Q
	4905	"RTN","RCB EADJ",72,0 )
	4906	. ;
	4907	"RTN","RCB EADJ",73,0 )
	4908	. ; fi x it
	4909	"RTN","RCB EADJ",74,0 )
	4910	. S $P( RCDATA7,"^ ",1)=+$P(R CBALANC,"^ ",1) ; pri ncipal
	4911	"RTN","RCB EADJ",75,0 )
	4912	. S $P( RCDATA7,"^ ",2)=+$P(R CBALANC,"^ ",2) ; int erest
	4913	"RTN","RCB EADJ",76,0 )
	4914	. S $P( RCDATA7,"^ ",3)=+$P(R CBALANC,"^ ",3) ; adm in
	4915	"RTN","RCB EADJ",77,0 )
	4916	. S $P( RCDATA7,"^ ",4)=+$P(R CBALANC,"^ ",4) ; mar shal fee
	4917	"RTN","RCB EADJ",78,0 )
	4918	. S $P( RCDATA7,"^ ",5)=+$P(R CBALANC,"^ ",5) ; cou rt cost
	4919	"RTN","RCB EADJ",79,0 )
	4920	. S $P( ^PRCA(430, RCBILLDA,7 ),"^",1,5) =$P(RCDATA 7,"^",1,5)
	4921	"RTN","RCB EADJ",80,0 )
	4922	. ;
	4923	"RTN","RCB EADJ",81,0 )
	4924	. W !," Balance Discrepanc y FIXED!"
	4925	"RTN","RCB EADJ",82,0 )
	4926	;
	4927	"RTN","RCB EADJ",83,0 )
	4928	; if the principal balance i s zero, do not allow it to be adjusted
	4929	"RTN","RCB EADJ",84,0 )
	4930	; ask to close/can cel it
	4931	"RTN","RCB EADJ",85,0 )
	4932	I RCBETYP E="DECREAS E",'$G(^PR CA(430,RCB ILLDA,7)) W !!,"Note : This bil l has NO
	4933	PRINCIPAL BALANCE to decrease !" D INTAD MIN(RCBILL DA),UNLOCK Q
	4934	"RTN","RCB EADJ",86,0 )
	4935	;
	4936	"RTN","RCB EADJ",87,0 )
	4937	; If entr y is from EDI Lockbo x worklist , display total adju stments in ERA
	4938	"RTN","RCB EADJ",88,0 )
	4939	N AP D
	4940	"RTN","RCB EADJ",89,0 )
	4941	.N BILL,E OB,ERA,SEQ S ERA="", AP=0
	4942	"RTN","RCB EADJ",90,0 )
	4943	.F S ERA =$O(^RCY(3 44.4,"AP", 1,ERA)) Q: 'ERA D Q :AP
	4944	"RTN","RCB EADJ",91,0 )
	4945	..S SEQ=0
	4946	"RTN","RCB EADJ",92,0 )
	4947	..F S SE Q=$O(^RCY( 344.4,"AP" ,1,ERA,SEQ )) Q:'SEQ D Q:AP
	4948	"RTN","RCB EADJ",93,0 )
	4949	...S EOB= $P($G(^RCY (344.4,ERA ,1,SEQ,0)) ,U,2) Q:'E OB
	4950	"RTN","RCB EADJ",94,0 )
	4951	...S:$P($ G(^IBM(361 .1,EOB,0)) ,U)=RCBILL DA AP=1 ;I A #4051
	4952	"RTN","RCB EADJ",95,0 )
	4953	;
	4954	"RTN","RCB EADJ",96,0 )
	4955	; Ask to enter tra nsaction e ven though it is mar ked for au topost PRC A4.5298
	4956	"RTN","RCB EADJ",97,0 )
	4957	I RCBETYP E="DECREAS E",AP S Y= $$ASKAUPO( ) I Y'=1 W !,"Exitin g bill adj ustment."
	4958	D UNLOCK Q
	4959	"RTN","RCB EADJ",98,0 )
	4960	;
	4961	"RTN","RCB EADJ",99,0 )
	4962	; ask to enter adj ustment am ount
	4963	"RTN","RCB EADJ",100, 0)
	4964	S RCAMOUN T=$$AMOUNT (RCBILLDA, RCBETYPE)
	4965	"RTN","RCB EADJ",101, 0)
	4966	I RCAMOUN T<0 D UNLO CK Q
	4967	"RTN","RCB EADJ",102, 0)
	4968	;
	4969	"RTN","RCB EADJ",103, 0)
	4970	; if dec rease, mak e negative
	4971	"RTN","RCB EADJ",104, 0)
	4972	I RCBETYP E="DECREAS E" S RCAMO UNT=-RCAMO UNT
	4973	"RTN","RCB EADJ",105, 0)
	4974	;
	4975	"RTN","RCB EADJ",106, 0)
	4976	; ask if it is a c ontract ad justment
	4977	"RTN","RCB EADJ",107, 0)
	4978	I RCBETYP E="DECREAS E","^9^28^ 29^30^32^" [("^"_$P($ G(^PRCA(43 0,RCBILLDA ,0)),"^",
	4979	2)_"^") S RCONTADJ=$ $ASKCONT I RCONTADJ< 0 D UNLOCK Q
	4980	"RTN","RCB EADJ",108, 0)
	4981	;
	4982	"RTN","RCB EADJ",109, 0)
	4983	; show w hat the ne w transact ion will l ook like
	4984	"RTN","RCB EADJ",110, 0)
	4985	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	4986	"RTN","RCB EADJ",111, 0)
	4987	W !!,"If you proces s the tran saction, t he bill wi ll look li ke:"
	4988	"RTN","RCB EADJ",112, 0)
	4989	W !,"Curr ent Princi pal Balanc e: ",$J($P (RCDATA7," ^"),11,2)
	4990	"RTN","RCB EADJ",113, 0)
	4991	W !," NE W ",RCBETY PE," Adjus tment: ",$ J(RCAMOUNT ,11,2)
	4992	"RTN","RCB EADJ",114, 0)
	4993	W !," ------- ----"
	4994	"RTN","RCB EADJ",115, 0)
	4995	W !," NEW Princi pal Balanc e: ",$J($P (RCDATA7," ^")+RCAMOU NT,11,2)
	4996	"RTN","RCB EADJ",116, 0)
	4997	;
	4998	"RTN","RCB EADJ",117, 0)
	4999	; ask to enter tra nsaction
	5000	"RTN","RCB EADJ",118, 0)
	5001	S Y=$$ASK OK(RCBETYP E) I Y'=1 D UNLOCK Q
	5002	"RTN","RCB EADJ",119, 0)
	5003	;
	5004	"RTN","RCB EADJ",120, 0)
	5005	ADDADJ ; add adjust ment
	5006	"RTN","RCB EADJ",121, 0)
	5007	S RCTRAND A=$$INCDEC ^RCBEUTR1( RCBILLDA,R CAMOUNT,"" ,"","",$G( RCONTADJ))
	5008	"RTN","RCB EADJ",122, 0)
	5009	I 'RCTRAN DA W !," * W A R N I N G: A djustment NOT Proces sed! *" D UNLOCK
	5010	Q
	5011	"RTN","RCB EADJ",123, 0)
	5012	I RCTRAND A W !," A djustment Transactio n: ",RCTRA NDA," has been added ."
	5013	"RTN","RCB EADJ",124, 0)
	5014	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	5015	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs decr ease adjus tment
	5016	"RTN","RCB EADJ",125, 0)
	5017	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	5018	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	5019	"RTN","RCB EADJ",126, 0)
	5020	;
	5021	"RTN","RCB EADJ",127, 0)
	5022	; ask to enter a c omment
	5023	"RTN","RCB EADJ",128, 0)
	5024	W !!,"Ent er a comme nt for the ",RCBETYP E," Adjust ment:"
	5025	"RTN","RCB EADJ",129, 0)
	5026	S Y=$$EDI T433^RCBEU TRA(RCTRAN DA,"41;")
	5027	"RTN","RCB EADJ",130, 0)
	5028	;
	5029	"RTN","RCB EADJ",131, 0)
	5030	; ask to exempt in terest and admin cha rges
	5031	"RTN","RCB EADJ",132, 0)
	5032	I RCBETYP E="DECREAS E" D INTAD MIN(RCBILL DA)
	5033	"RTN","RCB EADJ",133, 0)
	5034	;
	5035	"RTN","RCB EADJ",134, 0)
	5036	; notifi cation of subsequent payer bul letin
	5037	"RTN","RCB EADJ",135, 0)
	5038	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7)),X=0
	5039	"RTN","RCB EADJ",136, 0)
	5040	F I=1:1:5 S X=X+$P( RCDATA7,"^ ",I)
	5041	"RTN","RCB EADJ",137, 0)
	5042	I RCDATA7 '="",'X D
	5043	"RTN","RCB EADJ",138, 0)
	5044	. N PRC ABN,PRCAEN ,PRCAMT
	5045	"RTN","RCB EADJ",139, 0)
	5046	. S PRC ABN=RCBILL DA,PRCAEN= RCTRANDA,P RCAMT=+$P( $G(^PRCA(4 33,RCTRAND A,1)),"^"
	5047	,5)
	5048	"RTN","RCB EADJ",140, 0)
	5049	. D EOB ^PRCADJ
	5050	"RTN","RCB EADJ",141, 0)
	5051	;
	5052	"RTN","RCB EADJ",142, 0)
	5053	; unlock and ask t he next bi ll to adju st
	5054	"RTN","RCB EADJ",143, 0)
	5055	D UNLOCK
	5056	"RTN","RCB EADJ",144, 0)
	5057	Q
	5058	"RTN","RCB EADJ",145, 0)
	5059	;
	5060	"RTN","RCB EADJ",146, 0)
	5061	;
	5062	"RTN","RCB EADJ",147, 0)
	5063	UNLOCK ; unlock bil l and tran saction
	5064	"RTN","RCB EADJ",148, 0)
	5065	L -^PRCA( 430,RCBILL DA)
	5066	"RTN","RCB EADJ",149, 0)
	5067	I $G(RCTR ANDA) L -^ PRCA(433,R CTRANDA)
	5068	"RTN","RCB EADJ",150, 0)
	5069	Q
	5070	"RTN","RCB EADJ",151, 0)
	5071	;
	5072	"RTN","RCB EADJ",152, 0)
	5073	;
	5074	"RTN","RCB EADJ",153, 0)
	5075	INTADMIN(R CBILLDA) ; ask and adjust the interest and admin
	5076	"RTN","RCB EADJ",154, 0)
	5077	N RCAMOUN T,RCTRANDA ,Y
	5078	"RTN","RCB EADJ",155, 0)
	5079	;
	5080	"RTN","RCB EADJ",156, 0)
	5081	; check to see if there is i nterest an d admin ch arges
	5082	"RTN","RCB EADJ",157, 0)
	5083	S RCAMOUN T=$G(^PRCA (430,RCBIL LDA,7))
	5084	"RTN","RCB EADJ",158, 0)
	5085	I '$P(RCA MOUNT,"^", 2),'$P(RCA MOUNT,"^", 3),'$P(RCA MOUNT,"^", 4),'$P(RCA MOUNT,"^"
	5086	,5) Q
	5087	"RTN","RCB EADJ",159, 0)
	5088	;
	5089	"RTN","RCB EADJ",160, 0)
	5090	; only a sk if ther e is no pr incipal
	5091	"RTN","RCB EADJ",161, 0)
	5092	I RCAMOUN T Q
	5093	"RTN","RCB EADJ",162, 0)
	5094	;
	5095	"RTN","RCB EADJ",163, 0)
	5096	W !!,"You have the option to automatica lly EXEMPT the inter est"
	5097	"RTN","RCB EADJ",164, 0)
	5098	W !,"and administra tive charg es. This will close the bill. "
	5099	"RTN","RCB EADJ",165, 0)
	5100	S Y=$$ASK EXEMP I Y' =1 Q
	5101	"RTN","RCB EADJ",166, 0)
	5102	;
	5103	"RTN","RCB EADJ",167, 0)
	5104	W !!,"Cre ating an E XEMPT tran saction .. ."
	5105	"RTN","RCB EADJ",168, 0)
	5106	S RCTRAND A=$$EXEMPT ^RCBEUTR2( RCBILLDA,$ P(RCAMOUNT ,"^",2)_"^ "_$P(RCAMO UNT,"^",3
	5107	)_"^^"_$P( RCAMOUNT," ^",4)_"^"_ $P(RCAMOUN T,"^",5))
	5108	"RTN","RCB EADJ",169, 0)
	5109	I 'RCTRAN DA W !," * W A R N I N G: E XEMPTION N OT Process ed! *" Q
	5110	"RTN","RCB EADJ",170, 0)
	5111	I RCTRAND A W !," Exempt Tra nsaction: ",RCTRANDA ," has bee n added."
	5112	"RTN","RCB EADJ",171, 0)
	5113	INTC35B ;C heck if CS 5B entry n eeded for exempt tra nsaction
	5114	"RTN","RCB EADJ",172, 0)
	5115	I RCTRAND A,'$G(RCED IWL),(RCBE TYPE="DECR EASE"),$D( ^PRCA(430, "TCSP",RCB ILLDA)) D
	5116	DECADJ^RC TCSPU(RCBI LLDA,RCTRA NDA) ;prca 4.5301 a dd cs exem pt
	5117	"RTN","RCB EADJ",173, 0)
	5118	I '$G(REF MS)&(DT>$$ LDATE^RCRJ R(DT)) S Y =$E($$FPS^ RCAMFN01(D T,1),1,5)_ "01" D DD
	5119	^%DT W !!, " * * * * Transmis sion will be held un til "_Y_" * * * *"
	5120	"RTN","RCB EADJ",174, 0)
	5121	;
	5122	"RTN","RCB EADJ",175, 0)
	5123	W !," Cu rrent Bill Status: " ,$P($G(^PR CA(430.3,+ $P($G(^PRC A(430,RCBI LLDA,0)),
	5124	"^",8),0)) ,"^")
	5125	"RTN","RCB EADJ",176, 0)
	5126	Q
	5127	"RTN","RCB EADJ",177, 0)
	5128	;
	5129	"RTN","RCB EADJ",178, 0)
	5130	ASKOK(RCBE TYPE) ; a sk record decrease o r increase transacti on
	5131	"RTN","RCB EADJ",179, 0)
	5132	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5133	"RTN","RCB EADJ",180, 0)
	5134	S DIR(0)= "YO",DIR(" B")="YES"
	5135	"RTN","RCB EADJ",181, 0)
	5136	S DIR("A" )="Are you sure you want to en ter this " _RCBETYPE_ " adjustme nt "
	5137	"RTN","RCB EADJ",182, 0)
	5138	W ! D ^DI R
	5139	"RTN","RCB EADJ",183, 0)
	5140	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5141	"RTN","RCB EADJ",184, 0)
	5142	Q Y
	5143	"RTN","RCB EADJ",185, 0)
	5144	;
	5145	"RTN","RCB EADJ",186, 0)
	5146	ASKAUPO() ; ask rec ord even t hough mark ed for aut o post PRC A4.5298
	5147	"RTN","RCB EADJ",187, 0)
	5148	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5149	"RTN","RCB EADJ",188, 0)
	5150	S DIR(0)= "YOA",DIR( "B")="NO"
	5151	"RTN","RCB EADJ",189, 0)
	5152	S DIR("A" )="Marked for Auto-P ost. Are y ou sure? ( Y/N) "
	5153	"RTN","RCB EADJ",190, 0)
	5154	W ! D ^DI R
	5155	"RTN","RCB EADJ",191, 0)
	5156	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5157	"RTN","RCB EADJ",192, 0)
	5158	Q Y
	5159	"RTN","RCB EADJ",193, 0)
	5160	;
	5161	"RTN","RCB EADJ",194, 0)
	5162	ASKFIX() ; ask to f ix bill's balance
	5163	"RTN","RCB EADJ",195, 0)
	5164	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5165	"RTN","RCB EADJ",196, 0)
	5166	S DIR(0)= "YO",DIR(" B")="NO"
	5167	"RTN","RCB EADJ",197, 0)
	5168	S DIR("A" )=" Do yo u want to FIX the ba lance disc repancy "
	5169	"RTN","RCB EADJ",198, 0)
	5170	W ! D ^DI R
	5171	"RTN","RCB EADJ",199, 0)
	5172	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5173	"RTN","RCB EADJ",200, 0)
	5174	Q Y
	5175	"RTN","RCB EADJ",201, 0)
	5176	;
	5177	"RTN","RCB EADJ",202, 0)
	5178	;
	5179	"RTN","RCB EADJ",203, 0)
	5180	ASKEXEMP() ; ask to record an exempt tr ansaction
	5181	"RTN","RCB EADJ",204, 0)
	5182	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5183	"RTN","RCB EADJ",205, 0)
	5184	S DIR(0)= "YO",DIR(" B")="NO"
	5185	"RTN","RCB EADJ",206, 0)
	5186	S DIR("A" )=" Would you like to EXEMPT the intere st and adm in charges "
	5187	"RTN","RCB EADJ",207, 0)
	5188	D ^DIR
	5189	"RTN","RCB EADJ",208, 0)
	5190	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5191	"RTN","RCB EADJ",209, 0)
	5192	Q Y
	5193	"RTN","RCB EADJ",210, 0)
	5194	;
	5195	"RTN","RCB EADJ",211, 0)
	5196	;
	5197	"RTN","RCB EADJ",212, 0)
	5198	ASKCONT() ; ask if contract a djustment
	5199	"RTN","RCB EADJ",213, 0)
	5200	N DIR,DIQ 2,DIRUT,DT OUT,DUOUT, X,Y
	5201	"RTN","RCB EADJ",214, 0)
	5202	S DIR(0)= "YO",DIR(" B")="YES"
	5203	"RTN","RCB EADJ",215, 0)
	5204	S DIR("A" )=" Is th is a CONTR ACT adjust ment "
	5205	"RTN","RCB EADJ",216, 0)
	5206	W ! D ^DI R
	5207	"RTN","RCB EADJ",217, 0)
	5208	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5209	"RTN","RCB EADJ",218, 0)
	5210	Q Y
	5211	"RTN","RCB EADJ",219, 0)
	5212	;
	5213	"RTN","RCB EADJ",220, 0)
	5214	ADJNUM(RCB ILLDA) ; get next a djustment number for a bill
	5215	"RTN","RCB EADJ",221, 0)
	5216	N %,ADJUS T,DATA1,RC TRANDA
	5217	"RTN","RCB EADJ",222, 0)
	5218	S RCTRAND A=0
	5219	"RTN","RCB EADJ",223, 0)
	5220	F S RCTR ANDA=$O(^P RCA(433,"C ",RCBILLDA ,RCTRANDA) ) Q:'RCTRA NDA S DAT A1=$G(^PR
	5221	CA(433,RCT RANDA,1)) I $P(DATA1 ,"^",4),$P (DATA1,"^" ,2)=1!($P( DATA1,"^", 2)=35) S
	5222	ADJUST=$P( DATA1,"^", 4)+1
	5223	"RTN","RCB EADJ",224, 0)
	5224	Q ADJUST
	5225	"RTN","RCB EADJ",225, 0)
	5226	;
	5227	"RTN","RCB EADJ",226, 0)
	5228	;
	5229	"RTN","RCB EADJ",227, 0)
	5230	AMOUNT(RCB ILLDA,RCBE TYPE) ; e nter the a djustment amount for a bill
	5231	"RTN","RCB EADJ",228, 0)
	5232	N DIR,DIR UT,DTOUT,D UOUT,PRINB AL,X,Y
	5233	"RTN","RCB EADJ",229, 0)
	5234	S PRINBAL =+$P($G(^P RCA(430,RC BILLDA,7)) ,"^")
	5235	"RTN","RCB EADJ",230, 0)
	5236	I RCBETYP E="INCREAS E" S PRINB AL=9999999 .99
	5237	"RTN","RCB EADJ",231, 0)
	5238	W !!,"Ent er the ",R CBETYPE," Adjustment AMOUNT, f rom .01 to ",$J(PRIN BAL,0,2),
	5239	"."
	5240	"RTN","RCB EADJ",232, 0)
	5241	S DIR(0)= "NAO^.01:" _PRINBAL_" :2"
	5242	"RTN","RCB EADJ",233, 0)
	5243	S DIR("A" )=" "_RCB ETYPE_" PR INCIPAL BA LANCE BY: "
	5244	"RTN","RCB EADJ",234, 0)
	5245	D ^DIR
	5246	"RTN","RCB EADJ",235, 0)
	5247	I $G(DTOU T)!($G(DUO UT)) S Y=- 1
	5248	"RTN","RCB EADJ",236, 0)
	5249	Q $S(Y'=" ":Y,1:-1)
	5250	"RTN","RCB EADJ",237, 0)
	5251	;
	5252	"RTN","RCC PCAP")
	5253	0^21^B4350 6016^n/a
	5254	"RTN","RCC PCAP",1,0)
	5255	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ; 2/3 /2016 11:3 0 am
	5256	"RTN","RCC PCAP",2,0)
	5257	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 130
	5258	"RTN","RCC PCAP",3,0)
	5259	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5260	"RTN","RCC PCAP",4,0)
	5261	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	5262	"RTN","RCC PCAP",5,0)
	5263	; Year is the first three num bers of th e Internal Date form at and mus t be earl
	5264	ier than c urrent Yea r
	5265	"RTN","RCC PCAP",6,0)
	5266	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tr
	5267	ansmit aft er Build
	5268	"RTN","RCC PCAP",7,0)
	5269	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmi
	5270	t menu opt ion
	5271	"RTN","RCC PCAP",8,0)
	5272	;
	5273	"RTN","RCC PCAP",9,0)
	5274	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	5275	"RTN","RCC PCAP",10,0 )
	5276	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding N
	5277	ULL
	5278	"RTN","RCC PCAP",11,0 )
	5279	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	5280	"RTN","RCC PCAP",12,0 )
	5281	I $G(SOUR CE)="" S S OURCE="B"
	5282	"RTN","RCC PCAP",13,0 )
	5283	S DTTIME= $G(DTTIME)
	5284	"RTN","RCC PCAP",14,0 )
	5285	;
	5286	"RTN","RCC PCAP",15,0 )
	5287	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5288	"RTN","RCC PCAP",16,0 )
	5289	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5290	"RTN","RCC PCAP",17,0 )
	5291	. S YEAR= 20_$E(YEAR ,2,3)
	5292	"RTN","RCC PCAP",18,0 )
	5293	. S ^TMP( $J,"MSG",1 ,0)="The B uild and T ransmit of the Annua l Payment File for
	5294	"_YEAR_" h as not com pleted."
	5295	"RTN","RCC PCAP",19,0 )
	5296	. D ERRMA IL^RCCPCAT
	5297	"RTN","RCC PCAP",20,0 )
	5298	;
	5299	"RTN","RCC PCAP",21,0 )
	5300	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	5301	"RTN","RCC PCAP",22,0 )
	5302	;
	5303	"RTN","RCC PCAP",23,0 )
	5304	; Remove previous e ntries fro m file pri or to buil ding new f ile
	5305	"RTN","RCC PCAP",24,0 )
	5306	K ^RCAP(3 49.5)
	5307	"RTN","RCC PCAP",25,0 )
	5308	S ^RCAP(3 49.5,0)="A R ANNUAL P AYMENT STA TEMENT^349 .5^^"
	5309	"RTN","RCC PCAP",26,0 )
	5310	;
	5311	"RTN","RCC PCAP",27,0 )
	5312	; Set Sta rt and End Dates
	5313	"RTN","RCC PCAP",28,0 )
	5314	S STARTDT =YEAR_"010 0"
	5315	"RTN","RCC PCAP",29,0 )
	5316	S ENDDT=Y EAR_1232
	5317	"RTN","RCC PCAP",30,0 )
	5318	S (DEBTOR ,END)=""
	5319	"RTN","RCC PCAP",31,0 )
	5320	F PSCNTR= 1:1 Q:END D
	5321	"RTN","RCC PCAP",32,0 )
	5322	. S (NEXT ,SIZE,LINE )=0
	5323	"RTN","RCC PCAP",33,0 )
	5324	. D SETPS (PSCNTR,YE AR)
	5325	"RTN","RCC PCAP",34,0 )
	5326	. N LASTP D
	5327	"RTN","RCC PCAP",35,0 )
	5328	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q
	5329	"RTN","RCC PCAP",36,0 )
	5330	.. N SSN
	5331	"RTN","RCC PCAP",37,0 )
	5332	.. ; Quit if the de btor is no t a patien t
	5333	"RTN","RCC PCAP",38,0 )
	5334	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	5335	"RTN","RCC PCAP",39,0 )
	5336	.. ; Quit if a test patient S SN contain s a "P" or is Null
	5337	"RTN","RCC PCAP",40,0 )
	5338	.. S SSN= $$SSN^RCFN 01(DEBTOR)
	5339	"RTN","RCC PCAP",41,0 )
	5340	.. I SSN[ "P"!(SSN=- 1) Q
	5341	"RTN","RCC PCAP",42,0 )
	5342	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	5343	"RTN","RCC PCAP",43,0 )
	5344	.. S (PHS ET,PHCNTR, LTBDT)=0
	5345	"RTN","RCC PCAP",44,0 )
	5346	.. S DATE =STARTDT
	5347	"RTN","RCC PCAP",45,0 )
	5348	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	5349	"RTN","RCC PCAP",46,0 )
	5350	... ; Rec heck and Q uit if the date is n ot within the Year
	5351	"RTN","RCC PCAP",47,0 )
	5352	... I DAT E<STARTDT! (DATE>ENDD T) Q
	5353	"RTN","RCC PCAP",48,0 )
	5354	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	5355	"RTN","RCC PCAP",49,0 )
	5356	... N TRA NS
	5357	"RTN","RCC PCAP",50,0 )
	5358	... S TRA NS=""
	5359	"RTN","RCC PCAP",51,0 )
	5360	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	5361	"RTN","RCC PCAP",52,0 )
	5362	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Fu
	5363	ll(34)
	5364	"RTN","RCC PCAP",53,0 )
	5365	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	5366	"RTN","RCC PCAP",54,0 )
	5367	.... ; Se t PH Recor d if first time for this Debto r
	5368	"RTN","RCC PCAP",55,0 )
	5369	.... I 'P HSET D SET PH(DEBTOR, SSN,PSCNTR ) S PHSET= 1
	5370	"RTN","RCC PCAP",56,0 )
	5371	.... ; Se t PD Recor d for each Payment T ransaction
	5372	"RTN","RCC PCAP",57,0 )
	5373	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	5374	"RTN","RCC PCAP",58,0 )
	5375	.. ;
	5376	"RTN","RCC PCAP",59,0 )
	5377	.. ; Afte r completi ng each De btor, if t he Size is over 25K, set Next to create
	5378	a new PS Record,
	5379	"RTN","RCC PCAP",60,0 )
	5380	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and T
	5381	ime
	5382	"RTN","RCC PCAP",61,0 )
	5383	.. I SIZE >25000 D
	5384	"RTN","RCC PCAP",62,0 )
	5385	... S ^RC AP(349.5,P SCNTR,1,LA STPD,0)=^R CAP(349.5, PSCNTR,1,L ASTPD,0)_" ~"
	5386	"RTN","RCC PCAP",63,0 )
	5387	... S NEX T=1
	5388	"RTN","RCC PCAP",64,0 )
	5389	... D NOW ^%DTC
	5390	"RTN","RCC PCAP",65,0 )
	5391	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	5392	"RTN","RCC PCAP",66,0 )
	5393	.. ;
	5394	"RTN","RCC PCAP",67,0 )
	5395	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Ti
	5396	lde not fi nal
	5397	"RTN","RCC PCAP",68,0 )
	5398	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	5399	"RTN","RCC PCAP",69,0 )
	5400	. I DEBTO R="" D
	5401	"RTN","RCC PCAP",70,0 )
	5402	.. S END= 1
	5403	"RTN","RCC PCAP",71,0 )
	5404	.. I $G(L ASTPD)="" Q
	5405	"RTN","RCC PCAP",72,0 )
	5406	.. I $E(^ RCAP(349.5 ,PSCNTR,1, LASTPD,0), $L(^RCAP(3 49.5,PSCNT R,1,LASTPD ,0)))'="~
	5407	" S ^RCAP( 349.5,PSCN TR,1,LASTP D,0)=^RCAP (349.5,PSC NTR,1,LAST PD,0)_"~"
	5408	"RTN","RCC PCAP",73,0 )
	5409	.. D NOW^ %DTC
	5410	"RTN","RCC PCAP",74,0 )
	5411	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	5412	"RTN","RCC PCAP",75,0 )
	5413	;
	5414	"RTN","RCC PCAP",76,0 )
	5415	; PRCA4. 5313 - Un lock prior to transm ission
	5416	"RTN","RCC PCAP",77,0 )
	5417	L -^RCAP( 349.5):DIL OCKTM
	5418	"RTN","RCC PCAP",78,0 )
	5419	;
	5420	"RTN","RCC PCAP",79,0 )
	5421	; If the Source is Background (B) deter mine the d ate and ti me from th e schedul
	5422	e based up on site co de
	5423	"RTN","RCC PCAP",80,0 )
	5424	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	5425	"RTN","RCC PCAP",81,0 )
	5426	D EN^RCCP CAT(DTTIME )
	5427	"RTN","RCC PCAP",82,0 )
	5428	;
	5429	"RTN","RCC PCAP",83,0 )
	5430	Q
	5431	"RTN","RCC PCAP",84,0 )
	5432	;
	5433	"RTN","RCC PCAP",85,0 )
	5434	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	5435	"RTN","RCC PCAP",86,0 )
	5436	; Set Yea r and Buil d Start Da te and Tim e
	5437	"RTN","RCC PCAP",87,0 )
	5438	N PS,DR,D A,DIE,DIC, X,PRCAFDA
	5439	"RTN","RCC PCAP",88,0 )
	5440	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	5441	"RTN","RCC PCAP",89,0 )
	5442	D NOW^%DT C
	5443	"RTN","RCC PCAP",90,0 )
	5444	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	5445	"RTN","RCC PCAP",91,0 )
	5446	; Increme nt Line nu mber
	5447	"RTN","RCC PCAP",92,0 )
	5448	S LINE=LI NE+1
	5449	"RTN","RCC PCAP",93,0 )
	5450	; Set PSS EG for thi s Segment to PS Coun ter
	5451	"RTN","RCC PCAP",94,0 )
	5452	S PSSEG(P SCNTR)=PSC NTR
	5453	"RTN","RCC PCAP",95,0 )
	5454	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segmen
	5455	ts
	5456	"RTN","RCC PCAP",96,0 )
	5457	S PS="PS" _U_PSCNTR_ U_PSCNTR_U _$$SITE^RC MSITE_U_$$ FP^RCCPCFN _U_0_U_20_ $E(YEAR,2
	5458	,3)_U_$$DA T^RCCPCFN( DT)_U_"}"
	5459	"RTN","RCC PCAP",97,0 )
	5460	; Update File
	5461	"RTN","RCC PCAP",98,0 )
	5462	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P S
	5463	"RTN","RCC PCAP",99,0 )
	5464	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5465	"RTN","RCC PCAP",100, 0)
	5466	; Add len gth to SIZ E
	5467	"RTN","RCC PCAP",101, 0)
	5468	S SIZE=SI ZE+$L(PS)
	5469	"RTN","RCC PCAP",102, 0)
	5470	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	5471	"RTN","RCC PCAP",103, 0)
	5472	N I
	5473	"RTN","RCC PCAP",104, 0)
	5474	S I=0
	5475	"RTN","RCC PCAP",105, 0)
	5476	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,1,0),U ,3)=PSCNTR
	5477	"RTN","RCC PCAP",106, 0)
	5478	;
	5479	"RTN","RCC PCAP",107, 0)
	5480	Q
	5481	"RTN","RCC PCAP",108, 0)
	5482	;
	5483	"RTN","RCC PCAP",109, 0)
	5484	SETPH(DEBT OR,SSN,PSC NTR) ; Ge t and Set Data for P H Record i nto 349.5
	5485	"RTN","RCC PCAP",110, 0)
	5486	N PH,SITE ,PATNAME,A DDRESS,I,A RFLAG,ARAD DR,COUNTRY ,DFN,ICN,D R,DA,DIE,P OSTCODE,P
	5487	RCAFDA
	5488	"RTN","RCC PCAP",111, 0)
	5489	; Increme nt Line nu mber
	5490	"RTN","RCC PCAP",112, 0)
	5491	S LINE=LI NE+1
	5492	"RTN","RCC PCAP",113, 0)
	5493	; Increme nt PH Coun ter
	5494	"RTN","RCC PCAP",114, 0)
	5495	S PHCNTR= PHCNTR+1
	5496	"RTN","RCC PCAP",115, 0)
	5497	; Set PHS EG for thi s Segment to Line
	5498	"RTN","RCC PCAP",116, 0)
	5499	S PHSEG(P HCNTR)=LIN E
	5500	"RTN","RCC PCAP",117, 0)
	5501	; Get DFN and ICN f or Debtor and Patien t - If the ICN retur ns a -1 in the firs
	5502	t piece
	5503	"RTN","RCC PCAP",118, 0)
	5504	; send a Null value as the IC N
	5505	"RTN","RCC PCAP",119, 0)
	5506	S DFN=+$P ($G(^RCD(3 40,DEBTOR, 0)),U)
	5507	"RTN","RCC PCAP",120, 0)
	5508	S ICN=$$G ETICN^MPIF 001(DFN)
	5509	"RTN","RCC PCAP",121, 0)
	5510	S ICN=$S( +ICN'=-1:I CN,1:"")
	5511	"RTN","RCC PCAP",122, 0)
	5512	; Get Acc ount Numbe r -- Sit e code and SSN
	5513	"RTN","RCC PCAP",123, 0)
	5514	S SITE=$$ SITE^RCMSI TE
	5515	"RTN","RCC PCAP",124, 0)
	5516	S PH="PH" _U_SITE_SS N
	5517	"RTN","RCC PCAP",125, 0)
	5518	; Get Pat ient Name
	5519	"RTN","RCC PCAP",126, 0)
	5520	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5521	"RTN","RCC PCAP",127, 0)
	5522	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME,
	5523	",",2)," " ),1,10)_U_ $E($P(PATN AME," ",2) ,1,10)
	5524	"RTN","RCC PCAP",128, 0)
	5525	; If Coun try is not '1' get C ountry Nam e and Post al Code
	5526	"RTN","RCC PCAP",129, 0)
	5527	S COUNTRY =$P($G(^DP T(+$P(^RCD (340,DEBTO R,0),U),.1 1)),U,10)
	5528	"RTN","RCC PCAP",130, 0)
	5529	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	5530	"RTN","RCC PCAP",131, 0)
	5531	; Get Add ress and A RFLAG
	5532	"RTN","RCC PCAP",132, 0)
	5533	S ADDRESS =$P($$DADD ^RCAMADD(D EBTOR,1),U ,1,6)
	5534	"RTN","RCC PCAP",133, 0)
	5535	F I=1:1:4 S $P(ADDR ESS,U,I)=$ E($P(ADDRE SS,U,I),1, 40)
	5536	"RTN","RCC PCAP",134, 0)
	5537	; If the Country is Null the State and Zip Code w ill be use d
	5538	"RTN","RCC PCAP",135, 0)
	5539	; If the Country is Not Null, the State will be F X and the
	5540	"RTN","RCC PCAP",136, 0)
	5541	; Zip Cod e will be Null
	5542	"RTN","RCC PCAP",137, 0)
	5543	S $P(ADDR ESS,U,5)=$ S(COUNTRY= "":$E($P(A DDRESS,U,5 ),1,2),1:" FX")
	5544	"RTN","RCC PCAP",138, 0)
	5545	S $P(ADDR ESS,U,6)=$ S(COUNTRY= "":$E($P(A DDRESS,U,6 ),1,9),1:" ")
	5546	"RTN","RCC PCAP",139, 0)
	5547	S PH=PH_U _ADDRESS
	5548	"RTN","RCC PCAP",140, 0)
	5549	S ARFLAG= "N"
	5550	"RTN","RCC PCAP",141, 0)
	5551	S ARADDR= $P($G(^RCD (340,DEBTO R,1)),U,1, 6)
	5552	"RTN","RCC PCAP",142, 0)
	5553	I ($P(ARA DDR,U)'="" ),($P(ARAD DR,U,4)'=" "),($P(ARA DDR,U,5)'= ""),(($P(A RADDR,U,6
	5554	)'="")) S ARFLAG="Y"
	5555	"RTN","RCC PCAP",143, 0)
	5556	S PH=PH_U _$E(COUNTR Y,1,11)
	5557	"RTN","RCC PCAP",144, 0)
	5558	; Set DFN and ICN f or Debtor and Patien t with Nul l space fo r Total Am ount Rece
	5559	ived
	5560	"RTN","RCC PCAP",145, 0)
	5561	S PH=PH_U _U_SITE_$$ RJ^XLFSTR( $TR(DFN,". ",""),13,0 )_U_ICN
	5562	"RTN","RCC PCAP",146, 0)
	5563	; Set ARF LAG from a bove
	5564	"RTN","RCC PCAP",147, 0)
	5565	S PH=PH_U _ARFLAG
	5566	"RTN","RCC PCAP",148, 0)
	5567	; Set Nul l spaces f or Last Bi ll Prepare d Date for Debtor an d Number o f PD Segm
	5568	ents
	5569	"RTN","RCC PCAP",149, 0)
	5570	; and the n Record D elimiter
	5571	"RTN","RCC PCAP",150, 0)
	5572	S PH=PH_U _U_U_"}"
	5573	"RTN","RCC PCAP",151, 0)
	5574	; Update file
	5575	"RTN","RCC PCAP",152, 0)
	5576	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P H
	5577	"RTN","RCC PCAP",153, 0)
	5578	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5579	"RTN","RCC PCAP",154, 0)
	5580	; Add len gth to SIZ E
	5581	"RTN","RCC PCAP",155, 0)
	5582	S SIZE=SI ZE+$L(PH)
	5583	"RTN","RCC PCAP",156, 0)
	5584	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	5585	"RTN","RCC PCAP",157, 0)
	5586	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)
	5587	,U,6)+1
	5588	"RTN","RCC PCAP",158, 0)
	5589	Q
	5590	"RTN","RCC PCAP",159, 0)
	5591	;
	5592	"RTN","RCC PCAP",160, 0)
	5593	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	5594	"RTN","RCC PCAP",161, 0)
	5595	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT,PR CAFDA
	5596	"RTN","RCC PCAP",162, 0)
	5597	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	5598	"RTN","RCC PCAP",163, 0)
	5599	S AMT=$P( $G(^PRCA(4 33,TRANS,1 )),U,5)
	5600	"RTN","RCC PCAP",164, 0)
	5601	I 'AMT Q
	5602	"RTN","RCC PCAP",165, 0)
	5603	; Format Amount
	5604	"RTN","RCC PCAP",166, 0)
	5605	S AMT=$TR ($J(AMT,9, 2)," ","")
	5606	"RTN","RCC PCAP",167, 0)
	5607	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5608	"RTN","RCC PCAP",168, 0)
	5609	;
	5610	"RTN","RCC PCAP",169, 0)
	5611	S LINE=LI NE+1
	5612	"RTN","RCC PCAP",170, 0)
	5613	S LASTPD= LINE
	5614	"RTN","RCC PCAP",171, 0)
	5615	; Format and Set Da te Entered , Amount, and Delimi ter
	5616	"RTN","RCC PCAP",172, 0)
	5617	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	5618	"RTN","RCC PCAP",173, 0)
	5619	;
	5620	"RTN","RCC PCAP",174, 0)
	5621	; Add len gth to SIZ E
	5622	"RTN","RCC PCAP",175, 0)
	5623	S SIZE=SI ZE+$L(PD)
	5624	"RTN","RCC PCAP",176, 0)
	5625	;
	5626	"RTN","RCC PCAP",177, 0)
	5627	; Update file
	5628	"RTN","RCC PCAP",178, 0)
	5629	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P D
	5630	"RTN","RCC PCAP",179, 0)
	5631	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5632	"RTN","RCC PCAP",180, 0)
	5633	;
	5634	"RTN","RCC PCAP",181, 0)
	5635	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	5636	"RTN","RCC PCAP",182, 0)
	5637	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),1, PHSEG(PHCN TR),0),U,1 3)
	5638	"RTN","RCC PCAP",183, 0)
	5639	S PHTOT=P HTOT+AMT
	5640	"RTN","RCC PCAP",184, 0)
	5641	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,13)=PHT OT
	5642	"RTN","RCC PCAP",185, 0)
	5643	;
	5644	"RTN","RCC PCAP",186, 0)
	5645	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	5646
	5647	"RTN","RCC PCAP",187, 0)
	5648	; set to PH Segment and LTBDT
	5649	"RTN","RCC PCAP",188, 0)
	5650	S BILL=$P ($G(^PRCA( 433,TRANS, 0)),U,2)
	5651	"RTN","RCC PCAP",189, 0)
	5652	S CURBDT= $P($G(^PRC A(430,BILL ,0)),U,10)
	5653	"RTN","RCC PCAP",190, 0)
	5654	I CURBDT> LTBDT S $P (^RCAP(349 .5,PSSEG(P SCNTR),1,P HSEG(PHCNT R),0),U,17 )=$$DAT^R
	5655	CCPCFN(CUR BDT),LTBDT =CURBDT
	5656	"RTN","RCC PCAP",191, 0)
	5657	;
	5658	"RTN","RCC PCAP",192, 0)
	5659	; Increme nt PH segm ent piece 18 with an other PD r ecord
	5660	"RTN","RCC PCAP",193, 0)
	5661	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,18)=$P( ^RCAP(349. 5,PSSEG(P
	5662	SCNTR),1,P HSEG(PHCNT R),0),U,18 )+1
	5663	"RTN","RCC PCAP",194, 0)
	5664	Q
	5665	"RTN","RCC PCAP",195, 0)
	5666	;
	5667	"RTN","RCC PCAR")
	5668	0^23^B4789 4432^n/a
	5669	"RTN","RCC PCAR",1,0)
	5670	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ; 2/ 3/2016 11: 30 am
	5671	"RTN","RCC PCAR",2,0)
	5672	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 130
	5673	"RTN","RCC PCAR",3,0)
	5674	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5675	"RTN","RCC PCAR",4,0)
	5676	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	5677	"RTN","RCC PCAR",5,0)
	5678	; Year is the first three num bers of th e Internal Date form at
	5679	"RTN","RCC PCAR",6,0)
	5680	;
	5681	"RTN","RCC PCAR",7,0)
	5682	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5683	"RTN","RCC PCAR",8,0)
	5684	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	5685	"RTN","RCC PCAR",9,0)
	5686	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	5687	"RTN","RCC PCAR",10,0 )
	5688	. W !,"Tr y again la ter."
	5689	"RTN","RCC PCAR",11,0 )
	5690	;
	5691	"RTN","RCC PCAR",12,0 )
	5692	K ^TMP($J ,"MSG")
	5693	"RTN","RCC PCAR",13,0 )
	5694	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	5695	"RTN","RCC PCAR",14,0 )
	5696	;
	5697	"RTN","RCC PCAR",15,0 )
	5698	; Initial ize YEAR t o current year if Nu ll
	5699	"RTN","RCC PCAR",16,0 )
	5700	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	5701	"RTN","RCC PCAR",17,0 )
	5702	;
	5703	"RTN","RCC PCAR",18,0 )
	5704	; Set Sta rt and End Dates
	5705	"RTN","RCC PCAR",19,0 )
	5706	S STARTDT =YEAR_"010 0"
	5707	"RTN","RCC PCAR",20,0 )
	5708	S ENDDT=Y EAR_1232
	5709	"RTN","RCC PCAR",21,0 )
	5710	S LINE=0
	5711	"RTN","RCC PCAR",22,0 )
	5712	S DEBTOR= ""
	5713	"RTN","RCC PCAR",23,0 )
	5714	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	5715	"RTN","RCC PCAR",24,0 )
	5716	. ; Quit if the deb tor is not a patient
	5717	"RTN","RCC PCAR",25,0 )
	5718	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	5719	"RTN","RCC PCAR",26,0 )
	5720	. N DATE, PATERROR,P HSET
	5721	"RTN","RCC PCAR",27,0 )
	5722	. S (PHSE T,PATERROR )=0
	5723	"RTN","RCC PCAR",28,0 )
	5724	. S DATE= STARTDT
	5725	"RTN","RCC PCAR",29,0 )
	5726	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	5727	"RTN","RCC PCAR",30,0 )
	5728	.. ; Rech eck and Qu it if the date is no t within t he Year
	5729	"RTN","RCC PCAR",31,0 )
	5730	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	5731	"RTN","RCC PCAR",32,0 )
	5732	.. ; Set Final Date for this Debtor to determine final tran saction
	5733	"RTN","RCC PCAR",33,0 )
	5734	.. N TRAN S
	5735	"RTN","RCC PCAR",34,0 )
	5736	.. S TRAN S=""
	5737	"RTN","RCC PCAR",35,0 )
	5738	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	5739	"RTN","RCC PCAR",36,0 )
	5740	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Ful
	5741	l(34)
	5742	"RTN","RCC PCAR",37,0 )
	5743	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	5744	"RTN","RCC PCAR",38,0 )
	5745	... ; Che ck PH Reco rd if firs t time for this Debt or
	5746	"RTN","RCC PCAR",39,0 )
	5747	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	5748	"RTN","RCC PCAR",40,0 )
	5749	... ; Che ck PD Reco rd for eac h Payment Transactio n
	5750	"RTN","RCC PCAR",41,0 )
	5751	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	5752	"RTN","RCC PCAR",42,0 )
	5753	;
	5754	"RTN","RCC PCAR",43,0 )
	5755	; If ther e are any errors Sen d MailMan Message wi th Errors in ^TMP($J ,"MSG")
	5756	"RTN","RCC PCAR",44,0 )
	5757	I $D(^TMP ($J,"MSG") ) D TRANSM IT
	5758	"RTN","RCC PCAR",45,0 )
	5759	; If ther e are no e rrors Send MailMan M essage wit h No Error s Line
	5760	"RTN","RCC PCAR",46,0 )
	5761	I '$D(^TM P($J,"MSG" )) D
	5762	"RTN","RCC PCAR",47,0 )
	5763	. S ^TMP( $J,"MSG",1 ,0)="No an nual patie nt payment data inco nsistencie s found."
	5764	"RTN","RCC PCAR",48,0 )
	5765	. D TRANS MIT
	5766	"RTN","RCC PCAR",49,0 )
	5767	;
	5768	"RTN","RCC PCAR",50,0 )
	5769	K ^TMP($J ,"MSG")
	5770	"RTN","RCC PCAR",51,0 )
	5771	; PRCA4. 5313 - Un lock follo wing trans mission
	5772	"RTN","RCC PCAR",52,0 )
	5773	L -^TMP($ J,"MSG"):D ILOCKTM
	5774	"RTN","RCC PCAR",53,0 )
	5775	Q
	5776	"RTN","RCC PCAR",54,0 )
	5777	;
	5778	"RTN","RCC PCAR",55,0 )
	5779	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	5780	"RTN","RCC PCAR",56,0 )
	5781	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,B ILLDATE,CO UNTRY,ST
	5782	"RTN","RCC PCAR",57,0 )
	5783	;
	5784	"RTN","RCC PCAR",58,0 )
	5785	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a numbe
	5786	r
	5787	"RTN","RCC PCAR",59,0 )
	5788	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upo
	5789	n DFN
	5790	"RTN","RCC PCAR",60,0 )
	5791	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	5792	"RTN","RCC PCAR",61,0 )
	5793	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	5794	"RTN","RCC PCAR",62,0 )
	5795	;
	5796	"RTN","RCC PCAR",63,0 )
	5797	; Get Pat ient Name and SSN
	5798	"RTN","RCC PCAR",64,0 )
	5799	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5800	"RTN","RCC PCAR",65,0 )
	5801	S SSN=$$S SN^RCFN01( DEBTOR)
	5802	"RTN","RCC PCAR",66,0 )
	5803	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	5804	"RTN","RCC PCAR",67,0 )
	5805	;
	5806	"RTN","RCC PCAR",68,0 )
	5807	; Get and Check DFN and ICN f or Debtor and Patien t
	5808	"RTN","RCC PCAR",69,0 )
	5809	I $L(DFN) >8 D SETER ROR(PATSSN ,"Invalid DFN")
	5810	"RTN","RCC PCAR",70,0 )
	5811	S ICN=$$G ETICN^MPIF 001(DFN)
	5812	"RTN","RCC PCAR",71,0 )
	5813	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	5814	"RTN","RCC PCAR",72,0 )
	5815	;
	5816	"RTN","RCC PCAR",73,0 )
	5817	; Check P atient Nam e and SSN
	5818	"RTN","RCC PCAR",74,0 )
	5819	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	5820	"RTN","RCC PCAR",75,0 )
	5821	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	5822	"RTN","RCC PCAR",76,0 )
	5823	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Nam
	5824	e")
	5825	"RTN","RCC PCAR",77,0 )
	5826	;
	5827	"RTN","RCC PCAR",78,0 )
	5828	; Get and Check Add ress
	5829	"RTN","RCC PCAR",79,0 )
	5830	S ARADDR= $P($$DADD^ RCAMADD(DE BTOR,1),U, 1,6)
	5831	"RTN","RCC PCAR",80,0 )
	5832	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0!('$L($TR ($P(ARADDR ,U,I)," "
	5833	,"")))) D
	5834	"RTN","RCC PCAR",81,0 )
	5835	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	5836	"RTN","RCC PCAR",82,0 )
	5837	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	5838	"RTN","RCC PCAR",83,0 )
	5839	N ADDRER
	5840	"RTN","RCC PCAR",84,0 )
	5841	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	5842	"RTN","RCC PCAR",85,0 )
	5843	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	5844	"RTN","RCC PCAR",86,0 )
	5845	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	5846	"RTN","RCC PCAR",87,0 )
	5847	;
	5848	"RTN","RCC PCAR",88,0 )
	5849	; If the Zip Code i s Null fro m DADD^RCM ADD set Pi ece 6 of A RADDR to P iece 6 of
	5850	.11
	5851	"RTN","RCC PCAR",89,0 )
	5852	I $P(ARAD DR,U,6)="" S $P(ARAD DR,U,6)=$P ($G(^DPT(D FN,.11)),U ,6)
	5853	"RTN","RCC PCAR",90,0 )
	5854	;
	5855	"RTN","RCC PCAR",91,0 )
	5856	; If Coun try is not '1' get C ountry Nam e for use in validat ing the St ate and Z
	5857	ip Code
	5858	"RTN","RCC PCAR",92,0 )
	5859	S COUNTRY =$P($G(^DP T(DFN,.11) ),U,10)
	5860	"RTN","RCC PCAR",93,0 )
	5861	S COUNTRY =$S(COUNTR Y=1:"",1:$ $GET1^DIQ( 779.004,CO UNTRY,"POS TAL NAME") )
	5862	"RTN","RCC PCAR",94,0 )
	5863	; State h as three E rror condi tions
	5864	"RTN","RCC PCAR",95,0 )
	5865	; If the State is N ot Null an d is not 2 character s
	5866	"RTN","RCC PCAR",96,0 )
	5867	; If the State is N ot Null an d is not a Valid US State
	5868	"RTN","RCC PCAR",97,0 )
	5869	; If the State is N ot Null an d the Coun try is Not Null
	5870	"RTN","RCC PCAR",98,0 )
	5871	; If the State is N ull and th e Country is Null
	5872	"RTN","RCC PCAR",99,0 )
	5873	I $P(ARAD DR,U,5)'=" ",$L($P(AR ADDR,U,5)) '=2 D SETE RROR(PATSS N,"Missing or Inval
	5874	id State")
	5875	"RTN","RCC PCAR",100, 0)
	5876	S ST=""
	5877	"RTN","RCC PCAR",101, 0)
	5878	I $P(ARAD DR,U,5)'=" " S ST=$O( ^DIC(5,"C" ,$P(ARADDR ,U,5),""))
	5879	"RTN","RCC PCAR",102, 0)
	5880	I $P(ARAD DR,U,5)'=" ",ST="" D SETERROR(P ATSSN,"Mis sing or In valid Stat e")
	5881	"RTN","RCC PCAR",103, 0)
	5882	I $P(ARAD DR,U,5)'=" ",ST'="",$ P(^DIC(5,S T,0),U,6)' =1 D SETER ROR(PATSSN ,"Missing
	5883	or Invali d State")
	5884	"RTN","RCC PCAR",104, 0)
	5885	I $P(ARAD DR,U,5)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid State
	5886	")
	5887	"RTN","RCC PCAR",105, 0)
	5888	I $P(ARAD DR,U,5)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d State")
	5889	"RTN","RCC PCAR",106, 0)
	5890	; Zip Cod e has thre e Error co nditions
	5891	"RTN","RCC PCAR",107, 0)
	5892	; If the Zip Code i s Not Null and is no t 5 to 9 N umerics
	5893	"RTN","RCC PCAR",108, 0)
	5894	; If the Zip Code i s Not Null and the C ountry is Not Null
	5895	"RTN","RCC PCAR",109, 0)
	5896	; If the Zip Code i s Null and the Count ry is Null
	5897	"RTN","RCC PCAR",110, 0)
	5898	I $P(ARAD DR,U,6)'=" "&($P(ARAD DR,U,6)'?5 .9N) D SET ERROR(PATS SN,"Missin g or Inva
	5899	lid Zip Co de")
	5900	"RTN","RCC PCAR",111, 0)
	5901	I $P(ARAD DR,U,6)'=" "&(COUNTRY '="") D SE TERROR(PAT SSN,"Missi ng or Inva lid Zip C
	5902	ode")
	5903	"RTN","RCC PCAR",112, 0)
	5904	I $P(ARAD DR,U,6)="" &(COUNTRY= "") D SETE RROR(PATSS N,"Missing or Invali d Zip Cod
	5905	e")
	5906	"RTN","RCC PCAR",113, 0)
	5907	Q
	5908	"RTN","RCC PCAR",114, 0)
	5909	;
	5910	"RTN","RCC PCAR",115, 0)
	5911	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	5912	"RTN","RCC PCAR",116, 0)
	5913	N AMT
	5914	"RTN","RCC PCAR",117, 0)
	5915	; Get and Check Tra nsaction A mount
	5916	"RTN","RCC PCAR",118, 0)
	5917	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	5918	"RTN","RCC PCAR",119, 0)
	5919	; Format Amount
	5920	"RTN","RCC PCAR",120, 0)
	5921	S AMT=$TR ($J(AMT,9, 2)," ","")
	5922	"RTN","RCC PCAR",121, 0)
	5923	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5924	"RTN","RCC PCAR",122, 0)
	5925	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid
	5926	")
	5927	"RTN","RCC PCAR",123, 0)
	5928	;
	5929	"RTN","RCC PCAR",124, 0)
	5930	; Get and Check Tra nsaction D ate
	5931	"RTN","RCC PCAR",125, 0)
	5932	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid
	5933	")
	5934	"RTN","RCC PCAR",126, 0)
	5935	Q
	5936	"RTN","RCC PCAR",127, 0)
	5937	;
	5938	"RTN","RCC PCAR",128, 0)
	5939	SETERROR(P ATSSN,ERRO R) ; Set the error into TMP($ J,"MSG",LI NE,0) for transmiss
	5940	ion
	5941	"RTN","RCC PCAR",129, 0)
	5942	; If the first time thru for this patie nt set the Name and SSN in mes sage
	5943	"RTN","RCC PCAR",130, 0)
	5944	; with a blank line above the Patient D ata for sp acing
	5945	"RTN","RCC PCAR",131, 0)
	5946	I 'PATERR OR D
	5947	"RTN","RCC PCAR",132, 0)
	5948	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=" "
	5949	"RTN","RCC PCAR",133, 0)
	5950	. S LINE= LINE+1,^TM P($J,"MSG" ,LINE,0)=P ATSSN
	5951	"RTN","RCC PCAR",134, 0)
	5952	. S PATER ROR=1
	5953	"RTN","RCC PCAR",135, 0)
	5954	; Write E rror to ne xt line wi th a doubl e space in front
	5955	"RTN","RCC PCAR",136, 0)
	5956	S LINE=LI NE+1 S ^TM P($J,"MSG" ,LINE,0)=" "_ERROR
	5957	"RTN","RCC PCAR",137, 0)
	5958	Q
	5959	"RTN","RCC PCAR",138, 0)
	5960	;
	5961	"RTN","RCC PCAR",139, 0)
	5962	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	5963	"RTN","RCC PCAR",140, 0)
	5964	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	5965	"RTN","RCC PCAR",141, 0)
	5966	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO
	5967	CURRENT DA TE"
	5968	"RTN","RCC PCAR",142, 0)
	5969	S XMDUZ=" AR PACKAGE "
	5970	"RTN","RCC PCAR",143, 0)
	5971	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	5972	CCPC STATE MENTS")=""
	5973	"RTN","RCC PCAR",144, 0)
	5974	S XMDUZ=" AR PACKAGE "
	5975	"RTN","RCC PCAR",145, 0)
	5976	D XMZ^XMA 2
	5977	"RTN","RCC PCAR",146, 0)
	5978	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	5979	"RTN","RCC PCAR",147, 0)
	5980	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
	5981	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	5982	"RTN","RCC PCAR",148, 0)
	5983	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	5984	"RTN","RCC PCAR",149, 0)
	5985	D ENT1^XM D
	5986	"RTN","RCC PCAR",150, 0)
	5987	D NOW^%DT C
	5988	"RTN","RCC PCAR",151, 0)
	5989	Q
	5990	"RTN","RCC PCAR",152, 0)
	5991	;
	5992	"RTN","RCC PCAR",153, 0)
	5993	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	5994	"RTN","RCC PCAR",154, 0)
	5995	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	5996	"RTN","RCC PCAR",155, 0)
	5997	Q
	5998	"RTN","RCC PCAR",156, 0)
	5999	;
	6000	"RTN","RCC PCAR",157, 0)
	6001	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	6002	"RTN","RCC PCAR",158, 0)
	6003	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6004	"RTN","RCC PCAR",159, 0)
	6005	L +^TMP($ J,"MSG"):D ILOCKTM I '$T D Q
	6006	"RTN","RCC PCAR",160, 0)
	6007	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	6008	"RTN","RCC PCAR",161, 0)
	6009	. W !,"Tr y again la ter."
	6010	"RTN","RCC PCAR",162, 0)
	6011	; PRCA4. 5313 - Un lock prior to prepar ing and tr ansmitting
	6012	"RTN","RCC PCAR",163, 0)
	6013	L -^TMP($ J,"MSG"):D ILOCKTM
	6014	"RTN","RCC PCAR",164, 0)
	6015	;
	6016	"RTN","RCC PCAR",165, 0)
	6017	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T,%,%H
	6018	"RTN","RCC PCAR",166, 0)
	6019	S YEAR=20 _$E(DT,2,3 )
	6020	"RTN","RCC PCAR",167, 0)
	6021	S DIR(0)= "YAO"
	6022	"RTN","RCC PCAR",168, 0)
	6023	S DIR("B" )="N"
	6024	"RTN","RCC PCAR",169, 0)
	6025	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR
	6026	_" to the current da te? "
	6027	"RTN","RCC PCAR",170, 0)
	6028	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	6029	"RTN","RCC PCAR",171, 0)
	6030	D ^DIR
	6031	"RTN","RCC PCAR",172, 0)
	6032	I $E(X)'= "Y" Q
	6033	"RTN","RCC PCAR",173, 0)
	6034	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	6035	"RTN","RCC PCAR",174, 0)
	6036	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	6037	"RTN","RCC PCAR",175, 0)
	6038	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	6039	"RTN","RCC PCAR",176, 0)
	6040	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6041	"RTN","RCC PCAR",177, 0)
	6042	Q
	6043	"RTN","RCC PCAR",178, 0)
	6044	;
	6045	"RTN","RCC PCAR",179, 0)
	6046	MANHLP ; "??" Help for MANBLD
	6047	"RTN","RCC PCAR",180, 0)
	6048	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Chec
	6049	ker."
	6050	"RTN","RCC PCAR",181, 0)
	6051	Q
	6052	"RTN","RCC PCAT")
	6053	0^22^B5227 0242^n/a
	6054	"RTN","RCC PCAT",1,0)
	6055	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ; 2/3/2016 1 1:30 am
	6056	"RTN","RCC PCAT",2,0)
	6057	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 130
	6058	"RTN","RCC PCAT",3,0)
	6059	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6060	"RTN","RCC PCAT",4,0)
	6061	EN(DTTIME) ;Schedul e the Tran smit
	6062	"RTN","RCC PCAT",5,0)
	6063	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	6064	"RTN","RCC PCAT",6,0)
	6065	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6066	"RTN","RCC PCAT",7,0)
	6067	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	6068	"RTN","RCC PCAT",8,0)
	6069	; Initial ize Transm it date an d time
	6070	"RTN","RCC PCAT",9,0)
	6071	I DTTIME= "" S DTTIM E=%H
	6072	"RTN","RCC PCAT",10,0 )
	6073	S ZTDTH=D TTIME
	6074	"RTN","RCC PCAT",11,0 )
	6075	D ^%ZTLOA D Q:$G(ZTS K)=""
	6076	"RTN","RCC PCAT",12,0 )
	6077	Q
	6078	"RTN","RCC PCAT",13,0 )
	6079	;
	6080	"RTN","RCC PCAT",14,0 )
	6081	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	6082	"RTN","RCC PCAT",15,0 )
	6083	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6084	"RTN","RCC PCAT",16,0 )
	6085	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	6086	"RTN","RCC PCAT",17,0 )
	6087	. N YEAR
	6088	"RTN","RCC PCAT",18,0 )
	6089	. S YEAR= 20_$E($P(^ RCAP(349.5 ,1,0),U,2) ,2,3)
	6090	"RTN","RCC PCAT",19,0 )
	6091	. S ^TMP( $J,"MSG",1 ,0)="The T ransmit of the Annua l Payment File for " _YEAR_" h
	6092	as not com pleted."
	6093	"RTN","RCC PCAT",20,0 )
	6094	. D ERRMA IL^RCCPCAT
	6095	"RTN","RCC PCAT",21,0 )
	6096	;
	6097	"RTN","RCC PCAT",22,0 )
	6098	K ^TMP($J ,"MSG")
	6099	"RTN","RCC PCAT",23,0 )
	6100	N PSCNTR, %,%I,%H,YE AR
	6101	"RTN","RCC PCAT",24,0 )
	6102	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	6103	"RTN","RCC PCAT",25,0 )
	6104	S PSCNTR= 0
	6105	"RTN","RCC PCAT",26,0 )
	6106	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:' PSCNTR D
	6107	"RTN","RCC PCAT",27,0 )
	6108	. ; Set T ransmit St art Date a nd Time
	6109	"RTN","RCC PCAT",28,0 )
	6110	. D NOW^% DTC
	6111	"RTN","RCC PCAT",29,0 )
	6112	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	6113	"RTN","RCC PCAT",30,0 )
	6114	. ; Merge all PS el ements int o TMP MSG file
	6115	"RTN","RCC PCAT",31,0 )
	6116	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR,1 )
	6117	"RTN","RCC PCAT",32,0 )
	6118	. D MAIL
	6119	"RTN","RCC PCAT",33,0 )
	6120	. ; Set T ransmit En d Date and Time
	6121	"RTN","RCC PCAT",34,0 )
	6122	. D NOW^% DTC
	6123	"RTN","RCC PCAT",35,0 )
	6124	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	6125	"RTN","RCC PCAT",36,0 )
	6126	;
	6127	"RTN","RCC PCAT",37,0 )
	6128	; PRCA4. 5313 - Un lock prior to quit
	6129	"RTN","RCC PCAT",38,0 )
	6130	L -^RCAP( 349.5):DIL OCKTM
	6131	"RTN","RCC PCAT",39,0 )
	6132	Q
	6133	"RTN","RCC PCAT",40,0 )
	6134	;
	6135	"RTN","RCC PCAT",41,0 )
	6136	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	6137	"RTN","RCC PCAT",42,0 )
	6138	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6139	"RTN","RCC PCAT",43,0 )
	6140	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	6141	"RTN","RCC PCAT",44,0 )
	6142	S XMDUZ=" AR PACKAGE "
	6143	"RTN","RCC PCAT",45,0 )
	6144	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	6145	CCPC STATE MENTS")=""
	6146	"RTN","RCC PCAT",46,0 )
	6147	S X=$O(^R CT(349.1," B","PY",0) )
	6148	"RTN","RCC PCAT",47,0 )
	6149	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
	6150	(349.1,+X, 3)),U,3) S :$P(X,"@", 2)]"" XMY( X)=""
	6151	"RTN","RCC PCAT",48,0 )
	6152	I $P(X,"@ ",2)']"" D Q
	6153	"RTN","RCC PCAT",49,0 )
	6154	.S ERROR= 6,NM=0 D E RROR
	6155	"RTN","RCC PCAT",50,0 )
	6156	S XMDUZ=" AR PACKAGE "
	6157	"RTN","RCC PCAT",51,0 )
	6158	D XMZ^XMA 2
	6159	"RTN","RCC PCAT",52,0 )
	6160	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6161	"RTN","RCC PCAT",53,0 )
	6162	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
	6163	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	6164	"RTN","RCC PCAT",54,0 )
	6165	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6166	"RTN","RCC PCAT",55,0 )
	6167	D ENT1^XM D
	6168	"RTN","RCC PCAT",56,0 )
	6169	D NOW^%DT C
	6170	"RTN","RCC PCAT",57,0 )
	6171	K ^TMP($J ,"MSG")
	6172	"RTN","RCC PCAT",58,0 )
	6173	Q
	6174	"RTN","RCC PCAT",59,0 )
	6175	;
	6176	"RTN","RCC PCAT",60,0 )
	6177	ERRMAIL ;s et up and send mail message fo r Locking issues
	6178	"RTN","RCC PCAT",61,0 )
	6179	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	6180	"RTN","RCC PCAT",62,0 )
	6181	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT NOT COM PLETED "_Y EAR
	6182	"RTN","RCC PCAT",63,0 )
	6183	S XMDUZ=" AR PACKAGE "
	6184	"RTN","RCC PCAT",64,0 )
	6185	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),U,12) S XMY("G.R
	6186	CCPC STATE MENTS")=""
	6187	"RTN","RCC PCAT",65,0 )
	6188	S XMDUZ=" AR PACKAGE "
	6189	"RTN","RCC PCAT",66,0 )
	6190	D XMZ^XMA 2
	6191	"RTN","RCC PCAT",67,0 )
	6192	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6193	"RTN","RCC PCAT",68,0 )
	6194	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
	6195	),0)) S L= L+1,^XMB(3 .9,+XMZ,2, L,0)=^TMP( $J,"MSG",L (1),0)
	6196	"RTN","RCC PCAT",69,0 )
	6197	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	6198	"RTN","RCC PCAT",70,0 )
	6199	D ENT1^XM D
	6200	"RTN","RCC PCAT",71,0 )
	6201	D NOW^%DT C
	6202	"RTN","RCC PCAT",72,0 )
	6203	K ^TMP($J ,"MSG")
	6204	"RTN","RCC PCAT",73,0 )
	6205	Q
	6206	"RTN","RCC PCAT",74,0 )
	6207	;
	6208	"RTN","RCC PCAT",75,0 )
	6209	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code an
	6210	d table AI TC provide d
	6211	"RTN","RCC PCAT",76,0 )
	6212	; Time wi ll always be 2:00 AM
	6213	"RTN","RCC PCAT",77,0 )
	6214	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	6215	"RTN","RCC PCAT",78,0 )
	6216	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	6217	"RTN","RCC PCAT",79,0 )
	6218	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	6219	"RTN","RCC PCAT",80,0 )
	6220	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	6221	"RTN","RCC PCAT",81,0 )
	6222	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	6223	"RTN","RCC PCAT",82,0 )
	6224	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	6225	"RTN","RCC PCAT",83,0 )
	6226	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	6227	"RTN","RCC PCAT",84,0 )
	6228	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	6229	"RTN","RCC PCAT",85,0 )
	6230	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	6231	"RTN","RCC PCAT",86,0 )
	6232	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	6233	"RTN","RCC PCAT",87,0 )
	6234	S DTTIME= ""
	6235	"RTN","RCC PCAT",88,0 )
	6236	Q DTTIME
	6237	"RTN","RCC PCAT",89,0 )
	6238	;
	6239	"RTN","RCC PCAT",90,0 )
	6240	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly
	6241	transmissi on
	6242	"RTN","RCC PCAT",91,0 )
	6243	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6244	"RTN","RCC PCAT",92,0 )
	6245	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6246	"RTN","RCC PCAT",93,0 )
	6247	;
	6248	"RTN","RCC PCAT",94,0 )
	6249	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6250	"RTN","RCC PCAT",95,0 )
	6251	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6252	"RTN","RCC PCAT",96,0 )
	6253	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6254	"RTN","RCC PCAT",97,0 )
	6255	I YEAR="" S YEAR=$E (DT,1,3)-1
	6256	"RTN","RCC PCAT",98,0 )
	6257	S YEAR("E XT")=20_$E (YEAR,2,3)
	6258	"RTN","RCC PCAT",99,0 )
	6259	S DATE=+$ P($G(^RCAP (349.5,1,0 )),U,6)
	6260	"RTN","RCC PCAT",100, 0)
	6261	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6262	"RTN","RCC PCAT",101, 0)
	6263	I 'DATE D L -^RCAP (349.5):DI LOCKTM Q
	6264	"RTN","RCC PCAT",102, 0)
	6265	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been trans mitted."
	6266	"RTN","RCC PCAT",103, 0)
	6267	. W !,"Bu ild and Re transmit m ay not be manually r un until s cheduled j ob has co
	6268	mpleted.", !
	6269	"RTN","RCC PCAT",104, 0)
	6270	. N DIR
	6271	"RTN","RCC PCAT",105, 0)
	6272	. S DIR(0 )="E"
	6273	"RTN","RCC PCAT",106, 0)
	6274	. S DIR(" A")="Type <Enter> to return to the Menu. "
	6275	"RTN","RCC PCAT",107, 0)
	6276	. D ^DIR
	6277	"RTN","RCC PCAT",108, 0)
	6278	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6279	"RTN","RCC PCAT",109, 0)
	6280	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	6281	"
	6282	"RTN","RCC PCAT",110, 0)
	6283	S DIR(0)= "YAO"
	6284	"RTN","RCC PCAT",111, 0)
	6285	S DIR("B" )="N"
	6286	"RTN","RCC PCAT",112, 0)
	6287	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_"? "
	6288	"RTN","RCC PCAT",113, 0)
	6289	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	6290	"RTN","RCC PCAT",114, 0)
	6291	D ^DIR
	6292	"RTN","RCC PCAT",115, 0)
	6293	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6294	"RTN","RCC PCAT",116, 0)
	6295	I $E(X)'= "Y" Q
	6296	"RTN","RCC PCAT",117, 0)
	6297	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6298	"RTN","RCC PCAT",118, 0)
	6299	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	6300	"RTN","RCC PCAT",119, 0)
	6301	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	6302	"RTN","RCC PCAT",120, 0)
	6303	S ZTDTH=" "
	6304	"RTN","RCC PCAT",121, 0)
	6305	;
	6306	"RTN","RCC PCAT",122, 0)
	6307	; PRCA4. 5313 - Un lock prior to transm itting
	6308	"RTN","RCC PCAT",123, 0)
	6309	L -^RCAP( 349.5):DIL OCKTM
	6310	"RTN","RCC PCAT",124, 0)
	6311	;
	6312	"RTN","RCC PCAT",125, 0)
	6313	D ^%ZTLOA D Q:$G(ZTS K)=""
	6314	"RTN","RCC PCAT",126, 0)
	6315	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6316	"RTN","RCC PCAT",127, 0)
	6317	Q
	6318	"RTN","RCC PCAT",128, 0)
	6319	;
	6320	"RTN","RCC PCAT",129, 0)
	6321	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	6322	"RTN","RCC PCAT",130, 0)
	6323	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6324	"RTN","RCC PCAT",131, 0)
	6325	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6326	"RTN","RCC PCAT",132, 0)
	6327	;
	6328	"RTN","RCC PCAT",133, 0)
	6329	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6330	"RTN","RCC PCAT",134, 0)
	6331	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6332	"RTN","RCC PCAT",135, 0)
	6333	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6334	"RTN","RCC PCAT",136, 0)
	6335	S YEAR("E XT")=20_$E (YEAR,2,3)
	6336	"RTN","RCC PCAT",137, 0)
	6337	S DATE=$P ($G(^RCAP( 349.5,1,0) ),U,6)
	6338	"RTN","RCC PCAT",138, 0)
	6339	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6340	"RTN","RCC PCAT",139, 0)
	6341	I '$P($G( ^RCAP(349. 5,1,0)),U, 4) D L -^ RCAP(349.5 ):DILOCKTM Q
	6342	"RTN","RCC PCAT",140, 0)
	6343	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been Built and cann
	6344	ot be tran smitted."
	6345	"RTN","RCC PCAT",141, 0)
	6346	. N DIR
	6347	"RTN","RCC PCAT",142, 0)
	6348	. S DIR(0 )="E"
	6349	"RTN","RCC PCAT",143, 0)
	6350	. S DIR(" A")="Type <Enter> to return to the menu. "
	6351	"RTN","RCC PCAT",144, 0)
	6352	. D ^DIR
	6353	"RTN","RCC PCAT",145, 0)
	6354	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6355	"RTN","RCC PCAT",146, 0)
	6356	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_".
	6357	"
	6358	"RTN","RCC PCAT",147, 0)
	6359	S DIR(0)= "YAO"
	6360	"RTN","RCC PCAT",148, 0)
	6361	S DIR("B" )="N"
	6362	"RTN","RCC PCAT",149, 0)
	6363	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" ag
	6364	ain? "
	6365	"RTN","RCC PCAT",150, 0)
	6366	S DIR("?? ")="^D RET HLP^RCCPCA T"
	6367	"RTN","RCC PCAT",151, 0)
	6368	D ^DIR
	6369	"RTN","RCC PCAT",152, 0)
	6370	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6371	"RTN","RCC PCAT",153, 0)
	6372	I $E(X)'= "Y" Q
	6373	"RTN","RCC PCAT",154, 0)
	6374	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6375	"RTN","RCC PCAT",155, 0)
	6376	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6377	"RTN","RCC PCAT",156, 0)
	6378	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	6379	"RTN","RCC PCAT",157, 0)
	6380	S ZTDTH=" "
	6381	"RTN","RCC PCAT",158, 0)
	6382	;
	6383	"RTN","RCC PCAT",159, 0)
	6384	; PRCA4. 5313 - Un lock prior to retran smitting
	6385	"RTN","RCC PCAT",160, 0)
	6386	L -^RCAP( 349.5):DIL OCKTM
	6387	"RTN","RCC PCAT",161, 0)
	6388	;
	6389	"RTN","RCC PCAT",162, 0)
	6390	D ^%ZTLOA D Q:$G(ZTS K)=""
	6391	"RTN","RCC PCAT",163, 0)
	6392	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6393	"RTN","RCC PCAT",164, 0)
	6394	Q
	6395	"RTN","RCC PCAT",165, 0)
	6396	;
	6397	"RTN","RCC PCAT",166, 0)
	6398	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	6399	"RTN","RCC PCAT",167, 0)
	6400	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6401	"RTN","RCC PCAT",168, 0)
	6402	Q
	6403	"RTN","RCC PCAT",169, 0)
	6404	;
	6405	"RTN","RCC PCAT",170, 0)
	6406	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for t
	6407	his year
	6408	"RTN","RCC PCAT",171, 0)
	6409	N YEAR
	6410	"RTN","RCC PCAT",172, 0)
	6411	S YEAR=20 _$E(DT,2,3 )-1
	6412	"RTN","RCC PCAT",173, 0)
	6413	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not c
	6414	ompleted."
	6415	"RTN","RCC PCAT",174, 0)
	6416	W !,"You may not us e this opt ion until it complet es.",!
	6417	"RTN","RCC PCAT",175, 0)
	6418	D PAUSE^V ALM1
	6419	"RTN","RCC PCAT",176, 0)
	6420	Q
	6421	"RTN","RCC PCAT",177, 0)
	6422	;
	6423	"RTN","RCC PCAT",178, 0)
	6424	MANHLP ; "??" Help for MANBLD and RETRA NS
	6425	"RTN","RCC PCAT",179, 0)
	6426	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	6427	"RTN","RCC PCAT",180, 0)
	6428	Q
	6429	"RTN","RCC PCAT",181, 0)
	6430	;
	6431	"RTN","RCC PCAT",182, 0)
	6432	RETHLP ; "??" Help for MANBLD and RETRA NS
	6433	"RTN","RCC PCAT",183, 0)
	6434	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	6435	"RTN","RCC PCAT",184, 0)
	6436	Q
	6437	"RTN","RCC PCBJ")
	6438	0^5^B94409 06^B628849 1
	6439	"RTN","RCC PCBJ",1,0)
	6440	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	6441	"RTN","RCC PCBJ",2,0)
	6442	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 13;Mar 2 0, 1995;B
	6443	uild 130
	6444	"RTN","RCC PCBJ",3,0)
	6445	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6446	"RTN","RCC PCBJ",4,0)
	6447	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	6448	"RTN","RCC PCBJ",5,0)
	6449	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	6450	"RTN","RCC PCBJ",6,0)
	6451	;D ACK P RCA4.531 3 - Moved into OPEN
	6452	"RTN","RCC PCBJ",7,0)
	6453	D ;run t he cbs nig htly accou nt update program ev eryday
	6454	"RTN","RCC PCBJ",8,0)
	6455	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6456	"RTN","RCC PCBJ",9,0)
	6457	.S RCFULL =0 ;do not send the full debto r list
	6458	"RTN","RCC PCBJ",10,0 )
	6459	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	6460	"RTN","RCC PCBJ",11,0 )
	6461	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	6462	"RTN","RCC PCBJ",12,0 )
	6463	.D ^%ZTLO AD
	6464	"RTN","RCC PCBJ",13,0 )
	6465	;
	6466	"RTN","RCC PCBJ",14,0 )
	6467	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	6468	"RTN","RCC PCBJ",15,0 )
	6469	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6470	"RTN","RCC PCBJ",16,0 )
	6471	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	6472	"RTN","RCC PCBJ",17,0 )
	6473	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	6474	"RTN","RCC PCBJ",18,0 )
	6475	.D ^%ZTLO AD
	6476	"RTN","RCC PCBJ",19,0 )
	6477	;
	6478	"RTN","RCC PCBJ",20,0 )
	6479	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	6480	"RTN","RCC PCBJ",21,0 )
	6481	; on Janu ary 2nd of each year for the p revious ye ar
	6482	"RTN","RCC PCBJ",22,0 )
	6483	I $E(DT,4 ,7)="0102" D
	6484	"RTN","RCC PCBJ",23,0 )
	6485	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6486	"RTN","RCC PCBJ",24,0 )
	6487	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	6488	"RTN","RCC PCBJ",25,0 )
	6489	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	6490	"RTN","RCC PCBJ",26,0 )
	6491	. D ^%ZTL OAD
	6492	"RTN","RCC PCBJ",27,0 )
	6493	;
	6494	"RTN","RCC PCBJ",28,0 )
	6495	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September
	6496	and
	6497	"RTN","RCC PCBJ",29,0 )
	6498	; Decembe r 15th
	6499	"RTN","RCC PCBJ",30,0 )
	6500	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	6501	"RTN","RCC PCBJ",31,0 )
	6502	. I $E(DT ,6,7)'=15 Q
	6503	"RTN","RCC PCBJ",32,0 )
	6504	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6505	"RTN","RCC PCBJ",33,0 )
	6506	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	6507	"RTN","RCC PCBJ",34,0 )
	6508	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	6509	"RTN","RCC PCBJ",35,0 )
	6510	. D ^%ZTL OAD
	6511	"RTN","RCC PCBJ",36,0 )
	6512	;
	6513	"RTN","RCC PCBJ",37,0 )
	6514	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINA
	6515	D
	6516	"RTN","RCC PCBJ",38,0 )
	6517	;
	6518	"RTN","RCC PCBJ",39,0 )
	6519	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	6520	"RTN","RCC PCBJ",40,0 )
	6521	S X1=DT,X 2=2 D C^%D TC S SDT=X
	6522	"RTN","RCC PCBJ",41,0 )
	6523	S ZTSAVE( "SDT")=SDT
	6524	"RTN","RCC PCBJ",42,0 )
	6525	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	6526	"RTN","RCC PCBJ",43,0 )
	6527	S ZTDTH=$ H D ^%ZTLO AD
	6528	"RTN","RCC PCBJ",44,0 )
	6529	Q
	6530	"RTN","RCC PCBJ",45,0 )
	6531	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	6532	"RTN","RCC PCBJ",46,0 )
	6533	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	6534	"RTN","RCC PCBJ",47,0 )
	6535	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	6536	"RTN","RCC PCBJ",48,0 )
	6537	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	6538	"RTN","RCC PCBJ",49,0 )
	6539	D TRANCHK ^RCCPCSV1
	6540	"RTN","RCC PCBJ",50,0 )
	6541	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's de
	6542	btors
	6543	"RTN","RCC PCBJ",51,0 )
	6544	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	6545	"RTN","RCC PCBJ",52,0 )
	6546	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6547	"RTN","RCC PCBJ",53,0 )
	6548	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	6549	N D
	6550	"RTN","RCC PCBJ",54,0 )
	6551	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	6552	"RTN","RCC PCBJ",55,0 )
	6553	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	6554	"RTN","RCC PCBJ",56,0 )
	6555	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S X="_$S(AM T:$O(^PRCA (430.3,"AC ",102,0))
	6556	,1:$O(^PRC A(430.3,"A C",111,0)) ) D ^DIE K DA,DIE,DR
	6557	"RTN","RCC PCBJ",57,0 )
	6558	..Q
	6559	"RTN","RCC PCBJ",58,0 )
	6560	.Q
	6561	"RTN","RCC PCBJ",59,0 )
	6562	;
	6563	"RTN","RCC PCBJ",60,0 )
	6564	; update patient a ccounts wi th interes t and admi n
	6565	"RTN","RCC PCBJ",61,0 )
	6566	N RCLASDA T
	6567	"RTN","RCC PCBJ",62,0 )
	6568	S RCLASDA T=DATE
	6569	"RTN","RCC PCBJ",63,0 )
	6570	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	6571	"RTN","RCC PCBJ",64,0 )
	6572	; PRCA4. 5313 - Ad ded SDT to process a nd send
	6573	"RTN","RCC PCBJ",65,0 )
	6574	D EN^RCCP CPS(SDT)
	6575	"RTN","RCC PCBJ",66,0 )
	6576	D REFUND
	6577	"RTN","RCC PCBJ",67,0 )
	6578	D EN^RCCP CML(SDT)
	6579	"RTN","RCC PCBJ",68,0 )
	6580	Q
	6581	"RTN","RCC PCBJ",69,0 )
	6582	;
	6583	"RTN","RCC PCBJ",70,0 )
	6584	;
	6585	"RTN","RCC PCBJ",71,0 )
	6586	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	6587	"RTN","RCC PCBJ",72,0 )
	6588	; PRCA4. 5313 - Ch anged DAY to stateme nt date
	6589	"RTN","RCC PCBJ",73,0 )
	6590	S DEBTOR= 0,DAY=SDT
	6591	"RTN","RCC PCBJ",74,0 )
	6592	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6593	"RTN","RCC PCBJ",75,0 )
	6594	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'B
	6595	N D
	6596	"RTN","RCC PCBJ",76,0 )
	6597	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU
	6598	(+BN)
	6599	"RTN","RCC PCBJ",77,0 )
	6600	..Q
	6601	"RTN","RCC PCBJ",78,0 )
	6602	.Q
	6603	"RTN","RCC PCBJ",79,0 )
	6604	Q
	6605	"RTN","RCC PCBJ",80,0 )
	6606	;
	6607	"RTN","RCC PCBJ",81,0 )
	6608	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	6609	"RTN","RCC PCBJ",82,0 )
	6610	N DEB,MSG ,NO,RCX,X, X1,X2
	6611	"RTN","RCC PCBJ",83,0 )
	6612	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	6613	"RTN","RCC PCBJ",84,0 )
	6614	. D TRANC HK^RCCPCSV 1
	6615	"RTN","RCC PCBJ",85,0 )
	6616	Q
	6617	"RTN","RCC PCFN1")
	6618	0^7^B71817 74^n/a
	6619	"RTN","RCC PCFN1",1,0 )
	6620	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	6621	"RTN","RCC PCFN1",2,0 )
	6622	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 130
	6623	"RTN","RCC PCFN1",3,0 )
	6624	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6625	"RTN","RCC PCFN1",4,0 )
	6626	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their
	6627	patient s tatement s ent
	6628	"RTN","RCC PCFN1",5,0 )
	6629	; by the site to CB SS for con solidation .
	6630	"RTN","RCC PCFN1",6,0 )
	6631	; Input: NAME = Pa tient's Na me
	6632	"RTN","RCC PCFN1",7,0 )
	6633	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and grou
	6634	p number
	6635	"RTN","RCC PCFN1",8,0 )
	6636	; 0 = if i nvalid fir st charact er of last name
	6637	"RTN","RCC PCFN1",9,0 )
	6638	;
	6639	"RTN","RCC PCFN1",10, 0)
	6640	N LTR,GRO UP,DAY,I
	6641	"RTN","RCC PCFN1",11, 0)
	6642	;
	6643	"RTN","RCC PCFN1",12, 0)
	6644	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) -
	6645	return 0
	6646	"RTN","RCC PCFN1",13, 0)
	6647	I $G(NAME )="" Q 0
	6648	"RTN","RCC PCFN1",14, 0)
	6649	I '$D(^DP T("B",NAME )) Q 0
	6650	"RTN","RCC PCFN1",15, 0)
	6651	;
	6652	"RTN","RCC PCFN1",16, 0)
	6653	F I=1,2 S LTR(I)=$E (NAME,I)
	6654	"RTN","RCC PCFN1",17, 0)
	6655	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	6656	"RTN","RCC PCFN1",18, 0)
	6657	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	6658	"RTN","RCC PCFN1",19, 0)
	6659	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	6660	"RTN","RCC PCFN1",20, 0)
	6661	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	6662	"RTN","RCC PCFN1",21, 0)
	6663	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	6664	"RTN","RCC PCFN1",22, 0)
	6665	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	6666	"RTN","RCC PCFN1",23, 0)
	6667	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	6668	"RTN","RCC PCFN1",24, 0)
	6669	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	6670	"RTN","RCC PCFN1",25, 0)
	6671	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	6672	"RTN","RCC PCFN1",26, 0)
	6673	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	6674	"RTN","RCC PCFN1",27, 0)
	6675	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	6676	"RTN","RCC PCFN1",28, 0)
	6677	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	6678	"RTN","RCC PCFN1",29, 0)
	6679	;
	6680	"RTN","RCC PCFN1",30, 0)
	6681	Q 0
	6682	"RTN","RCC PCFN1",31, 0)
	6683	;
	6684	"RTN","RCC PCFN1",32, 0)
	6685	GRP1(LTR) ;AB
	6686	"RTN","RCC PCFN1",33, 0)
	6687	;
	6688	"RTN","RCC PCFN1",34, 0)
	6689	I LTR(1)= "A" S DAY= 1
	6690	"RTN","RCC PCFN1",35, 0)
	6691	I LTR(1)= "B" D
	6692	"RTN","RCC PCFN1",36, 0)
	6693	. I "AU"[ LTR(2) S D AY=1
	6694	"RTN","RCC PCFN1",37, 0)
	6695	. I "AU"' [LTR(2) S DAY=2
	6696	"RTN","RCC PCFN1",38, 0)
	6697	;
	6698	"RTN","RCC PCFN1",39, 0)
	6699	Q DAY
	6700	"RTN","RCC PCFN1",40, 0)
	6701	;
	6702	"RTN","RCC PCFN1",41, 0)
	6703	GRP2(LTR) ;CD
	6704	"RTN","RCC PCFN1",42, 0)
	6705	;
	6706	"RTN","RCC PCFN1",43, 0)
	6707	I LTR(1)= "D" S DAY= 4
	6708	"RTN","RCC PCFN1",44, 0)
	6709	I LTR(1)= "C" D
	6710	"RTN","RCC PCFN1",45, 0)
	6711	. I "IRU" [LTR(2) S DAY=4
	6712	"RTN","RCC PCFN1",46, 0)
	6713	. I "IRU" '[LTR(2) S DAY=6
	6714	"RTN","RCC PCFN1",47, 0)
	6715	;
	6716	"RTN","RCC PCFN1",48, 0)
	6717	Q DAY
	6718	"RTN","RCC PCFN1",49, 0)
	6719	;
	6720	"RTN","RCC PCFN1",50, 0)
	6721	GRP3(LTR) ;EFIQ
	6722	"RTN","RCC PCFN1",51, 0)
	6723	;
	6724	"RTN","RCC PCFN1",52, 0)
	6725	S DAY=7
	6726	"RTN","RCC PCFN1",53, 0)
	6727	;
	6728	"RTN","RCC PCFN1",54, 0)
	6729	Q DAY
	6730	"RTN","RCC PCFN1",55, 0)
	6731	;
	6732	"RTN","RCC PCFN1",56, 0)
	6733	GRP4(LTR) ;GH
	6734	"RTN","RCC PCFN1",57, 0)
	6735	;
	6736	"RTN","RCC PCFN1",58, 0)
	6737	I LTR(1)= "G" S DAY= 8
	6738	"RTN","RCC PCFN1",59, 0)
	6739	I LTR(1)= "H" D
	6740	"RTN","RCC PCFN1",60, 0)
	6741	. I "E"[L TR(2) S DA Y=8
	6742	"RTN","RCC PCFN1",61, 0)
	6743	. I "E"'[ LTR(2) S D AY=10
	6744	"RTN","RCC PCFN1",62, 0)
	6745	;
	6746	"RTN","RCC PCFN1",63, 0)
	6747	Q DAY
	6748	"RTN","RCC PCFN1",64, 0)
	6749	;
	6750	"RTN","RCC PCFN1",65, 0)
	6751	GRP5(LTR) ;JK
	6752	"RTN","RCC PCFN1",66, 0)
	6753	;
	6754	"RTN","RCC PCFN1",67, 0)
	6755	S DAY=12
	6756	"RTN","RCC PCFN1",68, 0)
	6757	;
	6758	"RTN","RCC PCFN1",69, 0)
	6759	Q DAY
	6760	"RTN","RCC PCFN1",70, 0)
	6761	;
	6762	"RTN","RCC PCFN1",71, 0)
	6763	GRP6(LTR) ;LO
	6764	"RTN","RCC PCFN1",72, 0)
	6765	;
	6766	"RTN","RCC PCFN1",73, 0)
	6767	S DAY=14
	6768	"RTN","RCC PCFN1",74, 0)
	6769	;
	6770	"RTN","RCC PCFN1",75, 0)
	6771	Q DAY
	6772	"RTN","RCC PCFN1",76, 0)
	6773	;
	6774	"RTN","RCC PCFN1",77, 0)
	6775	GRP7(LTR) ;MN
	6776	"RTN","RCC PCFN1",78, 0)
	6777	;
	6778	"RTN","RCC PCFN1",79, 0)
	6779	I LTR(1)= "N" S DAY= 17
	6780	"RTN","RCC PCFN1",80, 0)
	6781	I LTR(1)= "M" D
	6782	"RTN","RCC PCFN1",81, 0)
	6783	. I "CI"[ LTR(2) S D AY=17
	6784	"RTN","RCC PCFN1",82, 0)
	6785	. I "CI"' [LTR(2) S DAY=15
	6786	"RTN","RCC PCFN1",83, 0)
	6787	;
	6788	"RTN","RCC PCFN1",84, 0)
	6789	Q DAY
	6790	"RTN","RCC PCFN1",85, 0)
	6791	;
	6792	"RTN","RCC PCFN1",86, 0)
	6793	GRP8(LTR) ;T
	6794	"RTN","RCC PCFN1",87, 0)
	6795	;
	6796	"RTN","RCC PCFN1",88, 0)
	6797	I "ABCDE" [LTR(2) S DAY=19
	6798	"RTN","RCC PCFN1",89, 0)
	6799	I "FGH"[L TR(2) S DA Y=22
	6800	"RTN","RCC PCFN1",90, 0)
	6801	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	6802	"RTN","RCC PCFN1",91, 0)
	6803	;
	6804	"RTN","RCC PCFN1",92, 0)
	6805	Q DAY
	6806	"RTN","RCC PCFN1",93, 0)
	6807	;
	6808	"RTN","RCC PCFN1",94, 0)
	6809	GRP9(LTR) ;R
	6810	"RTN","RCC PCFN1",95, 0)
	6811	;
	6812	"RTN","RCC PCFN1",96, 0)
	6813	S DAY=19
	6814	"RTN","RCC PCFN1",97, 0)
	6815	;
	6816	"RTN","RCC PCFN1",98, 0)
	6817	Q DAY
	6818	"RTN","RCC PCFN1",99, 0)
	6819	;
	6820	"RTN","RCC PCFN1",100 ,0)
	6821	GRP10(LTR) ;SV
	6822	"RTN","RCC PCFN1",101 ,0)
	6823	;
	6824	"RTN","RCC PCFN1",102 ,0)
	6825	I LTR(1)= "V" S DAY= 22
	6826	"RTN","RCC PCFN1",103 ,0)
	6827	I LTR(1)= "S" D
	6828	"RTN","RCC PCFN1",104 ,0)
	6829	. I "CHIM "[LTR(2) S DAY=22
	6830	"RTN","RCC PCFN1",105 ,0)
	6831	. I "CHIM "'[LTR(2) S DAY=21
	6832	"RTN","RCC PCFN1",106 ,0)
	6833	;
	6834	"RTN","RCC PCFN1",107 ,0)
	6835	Q DAY
	6836	"RTN","RCC PCFN1",108 ,0)
	6837	;
	6838	"RTN","RCC PCFN1",109 ,0)
	6839	GRP11(LTR) ;PUXYZ
	6840	"RTN","RCC PCFN1",110 ,0)
	6841	;
	6842	"RTN","RCC PCFN1",111 ,0)
	6843	S DAY=24
	6844	"RTN","RCC PCFN1",112 ,0)
	6845	;
	6846	"RTN","RCC PCFN1",113 ,0)
	6847	Q DAY
	6848	"RTN","RCC PCFN1",114 ,0)
	6849	;
	6850	"RTN","RCC PCFN1",115 ,0)
	6851	GRP12(LTR) ;W
	6852	"RTN","RCC PCFN1",116 ,0)
	6853	;
	6854	"RTN","RCC PCFN1",117 ,0)
	6855	S DAY=26
	6856	"RTN","RCC PCFN1",118 ,0)
	6857	;
	6858	"RTN","RCC PCFN1",119 ,0)
	6859	Q DAY
	6860	"RTN","RCC PCML")
	6861	0^8^B67061 934^B47881 024
	6862	"RTN","RCC PCML",1,0)
	6863	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:1 6 PM
	6864	"RTN","RCC PCML",2,0)
	6865	V ;;4.5;Ac counts Rec eivable;** 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,
	6866	313**;Mar 20, 1995;B uild 130
	6867	"RTN","RCC PCML",3,0)
	6868	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6869	"RTN","RCC PCML",4,0)
	6870	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CC
	6871	PC mesages
	6872	"RTN","RCC PCML",5,0)
	6873	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	6874	"RTN","RCC PCML",6,0)
	6875	N SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	6876	"RTN","RCC PCML",7,0)
	6877	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do th
	6878	is." Q
	6879	"RTN","RCC PCML",8,0)
	6880	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6881	"RTN","RCC PCML",9,0)
	6882	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	6883	tted. Try again lat er." Q
	6884	"RTN","RCC PCML",10,0 )
	6885	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6886	"RTN","RCC PCML",11,0 )
	6887	S DIR(0)= "DAO^^K:'$ D(^RCPS(34 9.2,""STDT "",Y)) X"
	6888	"RTN","RCC PCML",12,0 )
	6889	S DIR("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	6890	"RTN","RCC PCML",13,0 )
	6891	S DIR("?" )="Enter s tatement d ate as it will appea r on these statement s or ^ to
	6892	exit."
	6893	"RTN","RCC PCML",14,0 )
	6894	D ^DIR
	6895	"RTN","RCC PCML",15,0 )
	6896	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	6897	"RTN","RCC PCML",16,0 )
	6898	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon
	6899	last name
	6900	"RTN","RCC PCML",17,0 )
	6901	S SDT=Y
	6902	"RTN","RCC PCML",18,0 )
	6903	; PRCA4. 5313 - Un lock prior to quitti ng
	6904	"RTN","RCC PCML",19,0 )
	6905	;I '$D(^R CPS(349.2, "STDT",SDT )) W !,"Th ere is not a CCPC fi le for thi s date."
	6906	L -^RCPS(3 49.2):DILO CKTM Q
	6907	"RTN","RCC PCML",20,0 )
	6908	; PRCA4. 5313 - Un lock prior to quitti ng
	6909	"RTN","RCC PCML",21,0 )
	6910	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),".
	6911	") D Q
	6912	"RTN","RCC PCML",22,0 )
	6913	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	6914	"RTN","RCC PCML",23,0 )
	6915	. L -^RCP S(349.2):D ILOCKTM
	6916	"RTN","RCC PCML",24,0 )
	6917	; PRCA4. 5313 - Un lock prior to jobbin g off
	6918	"RTN","RCC PCML",25,0 )
	6919	L -^RCPS( 349.2):DIL OCKTM
	6920	"RTN","RCC PCML",26,0 )
	6921	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	6922	"RTN","RCC PCML",27,0 )
	6923	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pa
	6924	tient stat ements -us er activat ed"
	6925	"RTN","RCC PCML",28,0 )
	6926	D ^%ZTLOA D
	6927	"RTN","RCC PCML",29,0 )
	6928	Q
	6929	"RTN","RCC PCML",30,0 )
	6930	;
	6931	"RTN","RCC PCML",31,0 )
	6932	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job
	6933	call
	6934	"RTN","RCC PCML",32,0 )
	6935	N DA,DIK, LPRINT
	6936	"RTN","RCC PCML",33,0 )
	6937	D NOW^%DT C
	6938	"RTN","RCC PCML",34,0 )
	6939	RETRAN N D A,DIK,ERRO R,RCT,X,X1 ,DEB
	6940	"RTN","RCC PCML",35,0 )
	6941	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	6942	"RTN","RCC PCML",36,0 )
	6943	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)
	6944	) S ERROR= 1,NM=0 D E RROR Q
	6945	"RTN","RCC PCML",37,0 )
	6946	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with Error .
	6947	"RTN","RCC PCML",38,0 )
	6948	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	6949	"RTN","RCC PCML",39,0 )
	6950	I $G(ERRO R) D EXIT Q
	6951	"RTN","RCC PCML",40,0 )
	6952	K ^TMP($J )
	6953	"RTN","RCC PCML",41,0 )
	6954	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	6955	"RTN","RCC PCML",42,0 )
	6956	S X1=0 F S X1=$O(^ RCT(349,"S DT",+$E(SD T,6,7),X1) ) Q:X1="" I $P($G(^ RCT(349,X
	6957	1,0)),U,2) ="PS" S DA =X1,DIK="^ RCT(349," D ^DIK
	6958	"RTN","RCC PCML",43,0 )
	6959	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E
	6960	(SDT,6,7))
	6961	"RTN","RCC PCML",44,0 )
	6962	N %,ADD,A MT,ERROR,L ,LN,M,MSG, MCT,MPT1,M TOT,NM,P,P D,PD0,PSN, PT,PT0,PHC T,RCM,RTY
	6963	,TAMT,TMSG ,SZ,TRDESC
	6964	"RTN","RCC PCML",45,0 )
	6965	D DT^DICR W
	6966	"RTN","RCC PCML",46,0 )
	6967	S (ERROR, RTY)=0
	6968	"RTN","RCC PCML",47,0 )
	6969	S X=$O(^R CT(349.1," B","PS",0) )
	6970	"RTN","RCC PCML",48,0 )
	6971	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	6972	"RTN","RCC PCML",49,0 )
	6973	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	6974	"RTN","RCC PCML",50,0 )
	6975	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	6976	"RTN","RCC PCML",51,0 )
	6977	S MTOT=$O (^TMP($J," MCT",""),- 1)
	6978	"RTN","RCC PCML",52,0 )
	6979	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	6980	"RTN","RCC PCML",53,0 )
	6981	S MCT(1)= $O(^TMP($J ,"MCT","") )
	6982	"RTN","RCC PCML",54,0 )
	6983	S MTOT=MT OT-(MCT(1) -1)
	6984	"RTN","RCC PCML",55,0 )
	6985	S MCT(1)= 0
	6986	"RTN","RCC PCML",56,0 )
	6987	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	6988	"RTN","RCC PCML",57,0 )
	6989	EXIT D ERR ML^RCCPCML 1
	6990	"RTN","RCC PCML",58,0 )
	6991	K SDT,^TM P($J)
	6992	"RTN","RCC PCML",59,0 )
	6993	; PRCA4. 5313 - Un lock prior to exitin g
	6994	"RTN","RCC PCML",60,0 )
	6995	L -^RCPS( 349.2):DIL OCKTM
	6996	"RTN","RCC PCML",61,0 )
	6997	Q
	6998	"RTN","RCC PCML",62,0 )
	6999	;
	7000	"RTN","RCC PCML",63,0 )
	7001	F349 ;Get PS segment entry
	7002	"RTN","RCC PCML",64,0 )
	7003	N DA,D0,D IC,DLAYGO, X
	7004	"RTN","RCC PCML",65,0 )
	7005	S ERROR=0 K DD,DO S DIC="^RCT (349,",DIC (0)="L",DL AYGO=349,X ="PS."_$TR ($$FMTE^X
	7006	LFDT(DT,"2 D"),"/",". ")_"."_RCM D FILE^DI CN
	7007	"RTN","RCC PCML",66,0 )
	7008	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	7009	"RTN","RCC PCML",67,0 )
	7010	S PSN=+Y
	7011	"RTN","RCC PCML",68,0 )
	7012	Q
	7013	"RTN","RCC PCML",69,0 )
	7014	;
	7015	"RTN","RCC PCML",70,0 )
	7016	PS ;Build PS,PH,PD s egments an d messages
	7017	"RTN","RCC PCML",71,0 )
	7018	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	7019	"RTN","RCC PCML",72,0 )
	7020	; PRCA4. 5313 - In crement Co unter for internal s torage
	7021	"RTN","RCC PCML",73,0 )
	7022	S MCT(1)= MCT(1)+1
	7023	"RTN","RCC PCML",74,0 )
	7024	; PRCA4. 5313 - Up date to ne w formatti ng
	7025	"RTN","RCC PCML",75,0 )
	7026	S $P(^RCT (349,+PSN, 0),"^",3,1 0)=MCT(1)_ "^"_MTOT_" ^"_$$SITE^ RCMSITE()_ "^"_$$FP^
	7027	RCCPCFN_"^ "_+^TMP($J ,"MCT",MCT )_"^"_$P(^ TMP($J,"MC T",MCT),"^ ",2)_"^"_$ $DAT^RCCP
	7028	CFN(SDT)_" ^"_$$DAT^R CCPCFN(DT)
	7029	"RTN","RCC PCML",76,0 )
	7030	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	7031	"RTN","RCC PCML",77,0 )
	7032	; Reforma t Statemen t Date to Internal F ormat
	7033	"RTN","RCC PCML",78,0 )
	7034	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	7035	"RTN","RCC PCML",79,0 )
	7036	S MPT1=$P (^TMP($J," MCT",MCT), "^",3)
	7037	"RTN","RCC PCML",80,0 )
	7038	; PRCA4. 5313 - Su btract num ber of rec ords from last recor d to find number be
	7039	fore file starting p oint
	7040	"RTN","RCC PCML",81,0 )
	7041	S PT=MPT1 -$P(^TMP($ J,"MCT",MC T),"^",1)
	7042	"RTN","RCC PCML",82,0 )
	7043	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:PT="" Q :PT=$O(^RC PS(349.2,+ ($P(^TMP(
	7044	$J,"MCT",M CT),"^",3) ))) D
	7045	"RTN","RCC PCML",83,0 )
	7046	.Q:$D(^TM P($J,"ERRP T",+PT))
	7047	"RTN","RCC PCML",84,0 )
	7048	.S PT0=^R CPS(349.2, +PT,0)
	7049	"RTN","RCC PCML",85,0 )
	7050	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	7051	"RTN","RCC PCML",86,0 )
	7052	. S DEB=$ P(PT0,"^")
	7053	"RTN","RCC PCML",87,0 )
	7054	.S LN=LN+ 1 S ^TMP($ J,"MSG",LN )="PH^"_$$ SITE^RCMSI TE_$$KEY^R CCPCFN(+PT )_"^"_$$N
	7055	M^RCCPCFN( +PT)_"^"
	7056	"RTN","RCC PCML",88,0 )
	7057	.S ADD=$G (^RCPS(349 .2,+PT,1))
	7058	"RTN","RCC PCML",89,0 )
	7059	.;
	7060	"RTN","RCC PCML",90,0 )
	7061	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	7062	"RTN","RCC PCML",91,0 )
	7063	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	7064	"RTN","RCC PCML",92,0 )
	7065	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	7066	"RTN","RCC PCML",93,0 )
	7067	.;
	7068	"RTN","RCC PCML",94,0 )
	7069	.;Debtor needs larg e print (f ont) IF LP RINT=1
	7070	"RTN","RCC PCML",95,0 )
	7071	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	7072	"RTN","RCC PCML",96,0 )
	7073	.;
	7074	"RTN","RCC PCML",97,0 )
	7075	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$S($P( ADD,"^",P) ]"":$P(ADD ,"^",P),1
	7076	:"")
	7077	"RTN","RCC PCML",98,0 )
	7078	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	7079	"RTN","RCC PCML",99,0 )
	7080	.S LN=LN+ 1
	7081	"RTN","RCC PCML",100, 0)
	7082	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	7083	"RTN","RCC PCML",101, 0)
	7084	.S ^TMP($ J,"MSG",LN )=AMT_"^"_ $G(^RCPS(3 49.2,+PT,3 ))_"^"_$G( ^RCPS(349. 2,+PT,4))
	7085	_"^"_$O(^R CPS(349.2, +PT,2,""), -1)
	7086	"RTN","RCC PCML",102, 0)
	7087	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S ^TMP( $J,"MSG",L N)="^"_$$S ITE^RCMSI
	7088	TE_$$RJ^XL FSTR($TR($ P(^RCD(340 ,+DEB,0)," ;"),".","" ),13,0)
	7089	"RTN","RCC PCML",103, 0)
	7090	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino
	7091	PH data
	7092	"RTN","RCC PCML",104, 0)
	7093	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	7094	"RTN","RCC PCML",105, 0)
	7095	.S ^TMP($ J,"MSG",LN )=$G(^TMP( $J,"MSG",L N))_"^"_LP RINT_"^"_$ P(PT8,"^") _"V"_$P(P
	7096	T8,"^",2,3 )_"^"_$$DA T^RCCPCFN( $P(PT8,"^" ,4))_"^\|"
	7097	"RTN","RCC PCML",106, 0)
	7098	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	7099	"RTN","RCC PCML",107, 0)
	7100	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	7101	"RTN","RCC PCML",108, 0)
	7102	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	7103	"RTN","RCC PCML",109, 0)
	7104	..;Replac e special characters causing p roblem (PR CA*260)
	7105	"RTN","RCC PCML",110, 0)
	7106	..S TRDES C=$P(PD0," ^",2)
	7107	"RTN","RCC PCML",111, 0)
	7108	..I TRDES C["~" S TR DESC=$TR(T RDESC,"~", " ") ;Rep lace tilde
	7109	"RTN","RCC PCML",112, 0)
	7110	..I TRDES C["\|" S TR DESC=$TR(T RDESC,"\|", " ") ;Rep lace the p ipe symbol
	7111	"RTN","RCC PCML",113, 0)
	7112	..S LN=LN +1,^TMP($J ,"MSG",LN) ="PD^"_$$D AT^RCCPCFN (+PD0)_"^" _TRDESC_"^ "_AMT(0)_
	7113	"^"_$P(PD0 ,"^",4)_"^ \|"
	7114	"RTN","RCC PCML",114, 0)
	7115	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	7116	"RTN","RCC PCML",115, 0)
	7117	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	7118	"RTN","RCC PCML",116, 0)
	7119	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	7120	"RTN","RCC PCML",117, 0)
	7121	;
	7122	"RTN","RCC PCML",118, 0)
	7123	MAIL ;set up mail me ssage
	7124	"RTN","RCC PCML",119, 0)
	7125	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	7126	"RTN","RCC PCML",120, 0)
	7127	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	7128	"RTN","RCC PCML",121, 0)
	7129	S XMDUZ=" AR PACKAGE "
	7130	"RTN","RCC PCML",122, 0)
	7131	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G
	7132	.RCCPC STA TEMENTS")= ""
	7133	"RTN","RCC PCML",123, 0)
	7134	S X=$O(^R CT(349.1," B","PS",0) )
	7135	"RTN","RCC PCML",124, 0)
	7136	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^")_" @"_$P($G(
	7137	^RCT(349.1 ,+X,3)),"^ ",3) S:$P( X,"@",2)]" " XMY(X)=" "
	7138	"RTN","RCC PCML",125, 0)
	7139	I $P(X,"@ ",2)']"" D Q
	7140	"RTN","RCC PCML",126, 0)
	7141	.S ERROR= 6,NM=0 D E RROR
	7142	"RTN","RCC PCML",127, 0)
	7143	S XMDUZ=" AR PACKAGE "
	7144	"RTN","RCC PCML",128, 0)
	7145	D XMZ^XMA 2
	7146	"RTN","RCC PCML",129, 0)
	7147	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	7148	"RTN","RCC PCML",130, 0)
	7149	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	7150	"RTN","RCC PCML",131, 0)
	7151	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) S L =L+1,^XMB( 3.9,+XMZ,
	7152	2,L,0)=^TM P($J,"MSG" ,L(1))
	7153	"RTN","RCC PCML",132, 0)
	7154	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	7155	"RTN","RCC PCML",133, 0)
	7156	D ENT1^XM D
	7157	"RTN","RCC PCML",134, 0)
	7158	D NOW^%DT C
	7159	"RTN","RCC PCML",135, 0)
	7160	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	7161	"RTN","RCC PCML",136, 0)
	7162	K ^TMP($J ,"MSG")
	7163	"RTN","RCC PCML",137, 0)
	7164	Q
	7165	"RTN","RCC PCML",138, 0)
	7166	;
	7167	"RTN","RCC PCML",139, 0)
	7168	PHCT ;PH c ount
	7169	"RTN","RCC PCML",140, 0)
	7170	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1
	7171	"RTN","RCC PCML",141, 0)
	7172	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	7173	"RTN","RCC PCML",142, 0)
	7174	N FINAL
	7175	"RTN","RCC PCML",143, 0)
	7176	S FINAL=$ O(^RCT(349 ,"@"),-1)
	7177	"RTN","RCC PCML",144, 0)
	7178	I FINAL,$ P($P(^RCT( 349,FINAL, 0),"^"),". ",2,4)=$TR ($$FMTE^XL FDT(DT,"2D "),"/",".
	7179	") S RCM=$ P($P(^RCT( 349,FINAL, 0),"^"),". ",5)+1
	7180	"RTN","RCC PCML",145, 0)
	7181	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	7182	"RTN","RCC PCML",146, 0)
	7183	.; PRCA4 .5313 - S et DEB to Debtor num ber
	7184	"RTN","RCC PCML",147, 0)
	7185	.S DEB=$P ($G(^RCPS( 349.2,PT,0 )),"^")
	7186	"RTN","RCC PCML",148, 0)
	7187	.S SZ(1)= 0 D ERRCHK Q:ERROR
	7188	"RTN","RCC PCML",149, 0)
	7189	.S PT0=^R CPS(349.2, +PT,0)
	7190	"RTN","RCC PCML",150, 0)
	7191	.S PHCT=P HCT+1
	7192	"RTN","RCC PCML",151, 0)
	7193	.S SZ=550 +SZ,SZ(1)= 550
	7194	"RTN","RCC PCML",152, 0)
	7195	.S:$G(^RC PS(349.2,+ PT,1))]"" SZ=SZ+$L(^ (1)),SZ(1) =SZ(1)+$L( ^(1))
	7196	"RTN","RCC PCML",153, 0)
	7197	.S:$G(^RC PS(349.2,+ PT,3))]"" SZ=SZ+$L(^ (3))+1,SZ( 1)=SZ(1)+$ L(^(3))+1
	7198	"RTN","RCC PCML",154, 0)
	7199	.S:$G(^RC PS(349.2,+ PT,4))]"" SZ=SZ+$L(^ (4))+1,SZ( 1)=SZ(1)+$ L(^(4))+1
	7200	"RTN","RCC PCML",155, 0)
	7201	.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(
	7202	1)=SZ(1)+$ L(^(0))
	7203	"RTN","RCC PCML",156, 0)
	7204	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	7205	"RTN","RCC PCML",157, 0)
	7206	.I SZ>270 00 D
	7207	"RTN","RCC PCML",158, 0)
	7208	..S RTY=0 D F349 Q: ERROR
	7209	"RTN","RCC PCML",159, 0)
	7210	..S TAMT= TAMT-$P(PT 0,"^",8)
	7211	"RTN","RCC PCML",160, 0)
	7212	..S TAMT= $$HEX^RCCP CFN(TAMT)
	7213	"RTN","RCC PCML",161, 0)
	7214	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)
	7215	_"^"_(SZ-S Z(1))
	7216	"RTN","RCC PCML",162, 0)
	7217	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	7218	"RTN","RCC PCML",163, 0)
	7219	..S RCM=R CM+1,PHCT= 1
	7220	"RTN","RCC PCML",164, 0)
	7221	..S SZ=SZ (1)
	7222	"RTN","RCC PCML",165, 0)
	7223	..S TAMT= $P(PT0,"^" ,8)
	7224	"RTN","RCC PCML",166, 0)
	7225	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	7226	"RTN","RCC PCML",167, 0)
	7227	.S RTY=0 D F349 Q:E RROR S ^T MP($J,"MCT ",RCM)=PHC T_"^"_$$HE X^RCCPCFN( TAMT)_"^"
	7228	_$O(^RCPS( 349.2,"STD T",SDT,PT) ,-1)
	7229	"RTN","RCC PCML",168, 0)
	7230	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	7231	"RTN","RCC PCML",169, 0)
	7232	Q
	7233	"RTN","RCC PCML",170, 0)
	7234	;
	7235	"RTN","RCC PCML",171, 0)
	7236	ERROR ;ERR OR FILE
	7237	"RTN","RCC PCML",172, 0)
	7238	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	7239	"RTN","RCC PCML",173, 0)
	7240	N SSN
	7241	"RTN","RCC PCML",174, 0)
	7242	S SSN=$$S SN^RCFN01( +DEB)
	7243	"RTN","RCC PCML",175, 0)
	7244	I SSN'=-1 S ^TMP($J ,"ERROR",E RROR,NM,SS N)=""
	7245	"RTN","RCC PCML",176, 0)
	7246	Q
	7247	"RTN","RCC PCML",177, 0)
	7248	;
	7249	"RTN","RCC PCML",178, 0)
	7250	ERRCHK ;Er ror check
	7251	"RTN","RCC PCML",179, 0)
	7252	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	7253	"RTN","RCC PCML",180, 0)
	7254	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S
	7255	ERROR=1,NM =0 D ERROR S PT=PT(1 ) Q
	7256	"RTN","RCC PCML",181, 0)
	7257	S PT=PT(1 )
	7258	"RTN","RCC PCML",182, 0)
	7259	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S ^T MP($J,"ER
	7260	RPT",+PT)= "" Q
	7261	"RTN","RCC PCML",183, 0)
	7262	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB)
	7263	D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	7264	"RTN","RCC PCML",184, 0)
	7265	S ADD=$G( ^RCPS(349. 2,+PT,1))
	7266	"RTN","RCC PCML",185, 0)
	7267	F P=1:1:7 S ADD(P)= $S($P(ADD, "^",P)]"": $P(ADD,"^" ,P),1:"")
	7268	"RTN","RCC PCML",186, 0)
	7269	I ADD(1)= "",ADD(2)= "",ADD(3)= "",ADD(4)= "",ADD(5)= "",ADD(6)= "" S ERROR =8,NM=$$N
	7270	AM^RCFN01( +DEB) D ER ROR S ^TMP ($J,"ERRPT ",+PT)="" Q
	7271	"RTN","RCC PCML",187, 0)
	7272	I ADD(1)= "",(ADD(2) =""),(ADD( 3)=""),(AD D(6)="") S ERROR=8,N M=$$NAM^RC FN01(+DEB
	7273	) D ERROR S ^TMP($J, "ERRPT",+P T)="" Q
	7274	"RTN","RCC PCML",188, 0)
	7275	I ADD(4)= ""!(ADD(5) ="")!(ADD( 6)="") S E RROR=8,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	7276	^TMP($J,"E RRPT",+PT) =""
	7277	"RTN","RCC PCML",189, 0)
	7278	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",
	7279	+PT)="" D ERROR Q
	7280	"RTN","RCC PCML",190, 0)
	7281	I $P($G(^ RCD(340,+D EB,1)),"^" ,9) S ^TMP ($J,"ERRPT ",+PT)="", ERROR=9,NM =$$NAM^RC
	7282	FN01(+DEB) D ERROR
	7283	"RTN","RCC PCML",191, 0)
	7284	Q
	7285	"RTN","RCC PCML1")
	7286	0^13^B8980 051^B66823 35
	7287	"RTN","RCC PCML1",1,0 )
	7288	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. );8/25/00 4:16 PM
	7289	"RTN","RCC PCML1",2,0 )
	7290	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 30
	7291	"RTN","RCC PCML1",3,0 )
	7292	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7293	"RTN","RCC PCML1",4,0 )
	7294	ERRML ;ERR OR MESSAGE S
	7295	"RTN","RCC PCML1",5,0 )
	7296	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	7297	"RTN","RCC PCML1",6,0 )
	7298	K ^TMP($J ,"ERRMSG")
	7299	"RTN","RCC PCML1",7,0 )
	7300	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	7301	"RTN","RCC PCML1",8,0 )
	7302	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	7303	"RTN","RCC PCML1",9,0 )
	7304	. I LN=0 S LN=LN+1 D
	7305	"RTN","RCC PCML1",10, 0)
	7306	. . N Y
	7307	"RTN","RCC PCML1",11, 0)
	7308	. . S Y=S DT X ^DD(" DD")
	7309	"RTN","RCC PCML1",12, 0)
	7310	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	7311	"RTN","RCC PCML1",13, 0)
	7312	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7313	"RTN","RCC PCML1",14, 0)
	7314	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$P($T (ERRMSG+ER ROR),";;", 2)
	7315	"RTN","RCC PCML1",15, 0)
	7316	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7317	"RTN","RCC PCML1",16, 0)
	7318	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	7319	"RTN","RCC PCML1",17, 0)
	7320	..S CT=CT +1,LN=LN+1
	7321	"RTN","RCC PCML1",18, 0)
	7322	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	7323	"RTN","RCC PCML1",19, 0)
	7324	..N Y I P T'=0 D
	7325	"RTN","RCC PCML1",20, 0)
	7326	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	7327	"RTN","RCC PCML1",21, 0)
	7328	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	7329	"RTN","RCC PCML1",22, 0)
	7330	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	7331	"RTN","RCC PCML1",23, 0)
	7332	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	7333	"RTN","RCC PCML1",24, 0)
	7334	S XMDUZ=" AR PACKAGE "
	7335	"RTN","RCC PCML1",25, 0)
	7336	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	7337	"RTN","RCC PCML1",26, 0)
	7338	E S XMY( $G(DUZ))=" "
	7339	"RTN","RCC PCML1",27, 0)
	7340	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	7341	"RTN","RCC PCML1",28, 0)
	7342	N Y S Y=S DT D DD^%D T S SDT=Y
	7343	"RTN","RCC PCML1",29, 0)
	7344	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	7345	"RTN","RCC PCML1",30, 0)
	7346	S XMTEXT= "^TMP($J," "ERRMSG"", "
	7347	"RTN","RCC PCML1",31, 0)
	7348	D ^XMD
	7349	"RTN","RCC PCML1",32, 0)
	7350	K ^TMP($J ,"ERRMSG")
	7351	"RTN","RCC PCML1",33, 0)
	7352	Q
	7353	"RTN","RCC PCML1",34, 0)
	7354	;
	7355	"RTN","RCC PCML1",35, 0)
	7356	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS
	7357	"RTN","RCC PCML1",36, 0)
	7358	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact I
	7359	RM.
	7360	"RTN","RCC PCML1",37, 0)
	7361	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	7362	"RTN","RCC PCML1",38, 0)
	7363	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	7364	"RTN","RCC PCML1",39, 0)
	7365	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	7366	"RTN","RCC PCML1",40, 0)
	7367	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	7368	"RTN","RCC PCML1",41, 0)
	7369	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (34
	7370	9.1).
	7371	"RTN","RCC PCML1",42, 0)
	7372	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	7373	"RTN","RCC PCML1",43, 0)
	7374	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	7375	"RTN","RCC PCML1",44, 0)
	7376	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	7377	"RTN","RCC PCML1",45, 0)
	7378	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(
	7379	s):
	7380	"RTN","RCC PCML1",46, 0)
	7381	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on runnin
	7382	g.
	7383	"RTN","RCC PCPS")
	7384	0^10^B1432 08369^B808 98915
	7385	"RTN","RCC PCPS",1,0)
	7386	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 P
	7387	M
	7388	"RTN","RCC PCPS",2,0)
	7389	;;4.5;Acc ounts Rece ivable;**3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,26
	7390	5,301,313* *;Mar 20,1 995;Build 130
	7391	"RTN","RCC PCPS",3,0)
	7392	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7393	"RTN","RCC PCPS",4,0)
	7394	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	7395	"RTN","RCC PCPS",5,0)
	7396	;
	7397	"RTN","RCC PCPS",6,0)
	7398	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	7399	"RTN","RCC PCPS",7,0)
	7400	; PRCA4. 5313 - Ve rify Patie nt Stateme nt days
	7401	"RTN","RCC PCPS",8,0)
	7402	D STDT
	7403	"RTN","RCC PCPS",9,0)
	7404	N CCPC,CN T,DAT,DEB, DIK,END,IN ADFL,LDT1, LDT3,PCC,P RN,RCDATE, RCT,SVADM, SVAMT,SVI
	7405	NT,SVOTH,S ITE,TXT,VA R,X,%,REP, ERROR,NM
	7406	"RTN","RCC PCPS",10,0 )
	7407	N RCINFUL L,RCINPART S COMM=0
	7408	"RTN","RCC PCPS",11,0 )
	7409	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7410	"RTN","RCC PCPS",12,0 )
	7411	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	7412	"RTN","RCC PCPS",13,0 )
	7413	. D NOW^% DTC S Y=% D DD^%DT
	7414	"RTN","RCC PCPS",14,0 )
	7415	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	7416	"RTN","RCC PCPS",15,0 )
	7417	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	7418	"RTN","RCC PCPS",16,0 )
	7419	; PRCA4. 5313 - Cl ear data f or date be ing create d
	7420	"RTN","RCC PCPS",17,0 )
	7421	D KILL^RC CPCPS1(SDT )
	7422	"RTN","RCC PCPS",18,0 )
	7423	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	7424	"RTN","RCC PCPS",19,0 )
	7425	N OLDDT
	7426	"RTN","RCC PCPS",20,0 )
	7427	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	7428	"RTN","RCC PCPS",21,0 )
	7429	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	7430	"RTN","RCC PCPS",22,0 )
	7431	D KILL^RC CPCPS1(OLD DT)
	7432	"RTN","RCC PCPS",23,0 )
	7433	;
	7434	"RTN","RCC PCPS",24,0 )
	7435	D DT^DICR W,SITE^PRC AGU
	7436	"RTN","RCC PCPS",25,0 )
	7437	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	7438	"RTN","RCC PCPS",26,0 )
	7439	. D NOW^% DTC S Y=% D DD^%DT W Y
	7440	"RTN","RCC PCPS",27,0 )
	7441	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	7442	"RTN","RCC PCPS",28,0 )
	7443	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	7444	"RTN","RCC PCPS",29,0 )
	7445	. L -^RCP S(349.2):D ILOCKTM
	7446	"RTN","RCC PCPS",30,0 )
	7447	;
	7448	"RTN","RCC PCPS",31,0 )
	7449	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	7450	"RTN","RCC PCPS",32,0 )
	7451	K ^TMP("I CNERROR",$ J)
	7452	"RTN","RCC PCPS",33,0 )
	7453	D NOW^%DT C S END=%
	7454	"RTN","RCC PCPS",34,0 )
	7455	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	7456	"RTN","RCC PCPS",35,0 )
	7457	S (CNT,DE B)=0,PRN=1
	7458	"RTN","RCC PCPS",36,0 )
	7459	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT
	7460	(",DEB)) D
	7461	"RTN","RCC PCPS",37,0 )
	7462	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN
	7463	"RTN","RCC PCPS",38,0 )
	7464	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC,FLBPD1 ,ICN
	7465	"RTN","RCC PCPS",39,0 )
	7466	. I $L( +$$SSN^RCF N01(DEB))< 5 Q
	7467	"RTN","RCC PCPS",40,0 )
	7468	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	7469	"RTN","RCC PCPS",41,0 )
	7470	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),"^", 1)) I $$EM ERES^PRCAU TL(RCDFN)
	7471	]"" Q
	7472	"RTN","RCC PCPS",42,0 )
	7473	. ; ini tialize va riables fo r CS - PRC A4.5301
	7474	"RTN","RCC PCPS",43,0 )
	7475	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	7476	"RTN","RCC PCPS",44,0 )
	7477	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	7478	"RTN","RCC PCPS",45,0 )
	7479	. S ICN =$$GETICN^ MPIF001(RC DFN)
	7480	"RTN","RCC PCPS",46,0 )
	7481	. I $P( ICN,U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	7482	"RTN","RCC PCPS",47,0 )
	7483	. S FLB PD1=$$FLBP D1
	7484	"RTN","RCC PCPS",48,0 )
	7485	. I FLB PD1="" Q
	7486	"RTN","RCC PCPS",49,0 )
	7487	. I $P( ^PRCA(430, FLBPD1,0), U,10)="" Q
	7488	"RTN","RCC PCPS",50,0 )
	7489	. S INA DFL=0
	7490	"RTN","RCC PCPS",51,0 )
	7491	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	7492	"RTN","RCC PCPS",52,0 )
	7493	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	7494	"RTN","RCC PCPS",53,0 )
	7495	. K ^TM P("PRCAGT" ,$J)
	7496	"RTN","RCC PCPS",54,0 )
	7497	. S BEG =+$$LST^RC FN01(DEB,2 )
	7498	"RTN","RCC PCPS",55,0 )
	7499	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	7500	"RTN","RCC PCPS",56,0 )
	7501	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	7502	"RTN","RCC PCPS",57,0 )
	7503	. D NOW ^%DTC S EN D=%
	7504	"RTN","RCC PCPS",58,0 )
	7505	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	7506	"RTN","RCC PCPS",59,0 )
	7507	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBA
	7508	L) ;get pr ev bal
	7509	"RTN","RCC PCPS",60,0 )
	7510	. D EN^ PRCAGT(DEB ,BEG,.END)
	7511	"RTN","RCC PCPS",61,0 )
	7512	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	7513	"RTN","RCC PCPS",62,0 )
	7514	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	7515	"RTN","RCC PCPS",63,0 )
	7516	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	7517	"RTN","RCC PCPS",64,0 )
	7518	. I CSB B,CSBB'<BB AL Q
	7519	"RTN","RCC PCPS",65,0 )
	7520	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G
	7521	(REP)) Q
	7522	"RTN","RCC PCPS",66,0 )
	7523	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	7524	"RTN","RCC PCPS",67,0 )
	7525	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	7526	"RTN","RCC PCPS",68,0 )
	7527	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	7528	"RTN","RCC PCPS",69,0 )
	7529	. I BBA L=0,$G(SIT E("ZERO")) Q
	7530	"RTN","RCC PCPS",70,0 )
	7531	. I BBA L<0,BBAL>- .99 Q
	7532	"RTN","RCC PCPS",71,0 )
	7533	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not c
	7534	omment
	7535	"RTN","RCC PCPS",72,0 )
	7536	. S TBA L=TBAL+PBA L
	7537	"RTN","RCC PCPS",73,0 )
	7538	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	7539	"RTN","RCC PCPS",74,0 )
	7540	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	7541	"RTN","RCC PCPS",75,0 )
	7542	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the diffe
	7543	rence betw een the bi ll balance and the t ransaction balance
	7544	"RTN","RCC PCPS",76,0 )
	7545	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balanc
	7546	e
	7547	"RTN","RCC PCPS",77,0 )
	7548	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	7549	"RTN","RCC PCPS",78,0 )
	7550	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	7551	"RTN","RCC PCPS",79,0 )
	7552	. ;
	7553	"RTN","RCC PCPS",80,0 )
	7554	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^^"
	7555	"RTN","RCC PCPS",81,0 )
	7556	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	7557	"RTN","RCC PCPS",82,0 )
	7558	. S PSI EN=+Y
	7559	"RTN","RCC PCPS",83,0 )
	7560	. S ^RC PS(349.2,P SIEN,0)=DE B_"^"_$$SS N^RCFN01(D EB)_"^"
	7561	"RTN","RCC PCPS",84,0 )
	7562	. S ADD R=$$DADD^R CAMADD(DEB ,1) ;get p atient's a ddress, co nfidential if appli
	7563	cable
	7564	"RTN","RCC PCPS",85,0 )
	7565	. S ARF LAG="N" N X
	7566	"RTN","RCC PCPS",86,0 )
	7567	. S X=$ P($G(^RCD( 340,DEB,1) ),U,1,6) I ($P(X,U)' =""),($P(X ,U,4)'="") ,($P(X,U,
	7568	5)'=""),(( $P(X,U,6)' ="")) S AR FLAG="Y"
	7569	"RTN","RCC PCPS",87,0 )
	7570	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,"^", 1,6)
	7571	"RTN","RCC PCPS",88,0 )
	7572	. S ST= $P(ADDR,"^ ",5)
	7573	"RTN","RCC PCPS",89,0 )
	7574	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	7575	"RTN","RCC PCPS",90,0 )
	7576	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	7577	"RTN","RCC PCPS",91,0 )
	7578	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P(ICN ,"V")
	7579	"RTN","RCC PCPS",92,0 )
	7580	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P(I CN,"V",2)
	7581	"RTN","RCC PCPS",93,0 )
	7582	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	7583	"RTN","RCC PCPS",94,0 )
	7584	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	7585	"RTN","RCC PCPS",95,0 )
	7586	. I FLB PD1 S $P(^ RCPS(349.2 ,PSIEN,8), U,4)=$P(^P RCA(430,FL BPD1,0),U, 10)
	7587	"RTN","RCC PCPS",96,0 )
	7588	. I $G( ST)'="" S ST=$O(^DIC (5,"C",ST, 0))
	7589	"RTN","RCC PCPS",97,0 )
	7590	. I $G( ST)>90,'$P ($G(^DIC(5 ,ST,0)),"^ ",6) S FC= $P($G(^DIC (5,ST,0)), "^")
	7591	"RTN","RCC PCPS",98,0 )
	7592	. S $P( ^RCPS(349. 2,PSIEN,1) ,"^",7)=$G (FC) S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1
	7593	),"^",5)=" FX"
	7594	"RTN","RCC PCPS",99,0 )
	7595	. S:$G( FC)]"" $P( ^RCPS(349. 2,PSIEN,1) ,"^",6)=$P (ADDR,"^", 8)
	7596	"RTN","RCC PCPS",100, 0)
	7597	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),"^",10)= %
	7598	"RTN","RCC PCPS",101, 0)
	7599	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",3)=$$ NAM^RCFN01 (DEB)
	7600	"RTN","RCC PCPS",102, 0)
	7601	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",4,7)= $S(TBAL'>0 :0,1:TBAL) _"^"_PBAL_ "^"_TBAL(
	7602	"CH")_"^"_ TBAL("PC") ,$P(^(0)," ^",8)=PBAL +TBAL("CH" )+TBAL("PC ")+TBAL("R F")
	7603	"RTN","RCC PCPS",103, 0)
	7604	. S $P( ^RCPS(349. 2,PSIEN,0) ,"^",13,17 )=BBAL("PB ")_"^"_BBA L("INT")_" ^"_BBAL("
	7605	ADM")_"^"_ BBAL("MF") _"^"_BBAL( "CT")
	7606	"RTN","RCC PCPS",104, 0)
	7607	. ;
	7608	"RTN","RCC PCPS",105, 0)
	7609	. N RCB ILLDA,RCDA TA1,RCDEBT DA,RCDESC, RCPSDA,RCT OTAL,RCTRA NDA,RCTRDA TE,VALUE,
	7610	RCCOM1,RCC OM2,RCCOM3
	7611	"RTN","RCC PCPS",106, 0)
	7612	. S RCD EBTDA=DEB
	7613	"RTN","RCC PCPS",107, 0)
	7614	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^^^"
	7615	"RTN","RCC PCPS",108, 0)
	7616	. ;
	7617	"RTN","RCC PCPS",109, 0)
	7618	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	7619	"RTN","RCC PCPS",110, 0)
	7620	. ; Add second co mment line for the G MT-reduced status
	7621	"RTN","RCC PCPS",111, 0)
	7622	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE T
	7623	O GEOGRAPH IC MEANS T EST STATUS "
	7624	"RTN","RCC PCPS",112, 0)
	7625	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	7626	"RTN","RCC PCPS",113, 0)
	7627	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be
	7628	printed o n separate line.
	7629	"RTN","RCC PCPS",114, 0)
	7630	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	7631	"RTN","RCC PCPS",115, 0)
	7632	. ;
	7633	"RTN","RCC PCPS",116, 0)
	7634	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	7635	"RTN","RCC PCPS",117, 0)
	7636	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTR
	7637	DATE S RC BILLDA=0 F S RCBILL DA=$O(^TMP ("PRCAGT", $J,RCDEBTD A,RCTRDATE ,RCBILLDA
	7638	)) Q:'RCBI LLDA D
	7639	"RTN","RCC PCPS",118, 0)
	7640	. . ; skip CS b ills/trans actions - PRCA4.53 01
	7641	"RTN","RCC PCPS",119, 0)
	7642	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	7643	"RTN","RCC PCPS",120, 0)
	7644	. . I $P($G(^RC PS(349.2,P SIEN,0))," ^",8)<0 S PC(75)=75
	7645	"RTN","RCC PCPS",121, 0)
	7646	. . I $P($G(^PR CA(430,RCB ILLDA,6)), "^",2)]"", ($P($G(^PR CA(430,RCB ILLDA,7))
	7647	,"^")>0) S PC(1)="01 "
	7648	"RTN","RCC PCPS",122, 0)
	7649	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),"^",2)
	7650	"RTN","RCC PCPS",123, 0)
	7651	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), "^",14)
	7652	"RTN","RCC PCPS",124, 0)
	7653	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC="
	7654	"
	7655	"RTN","RCC PCPS",125, 0)
	7656	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	7657	"RTN","RCC PCPS",126, 0)
	7658	. . S $P(^RCPS( 349.2,PSIE N,4),"^")= PC
	7659	"RTN","RCC PCPS",127, 0)
	7660	. . ;
	7661	"RTN","RCC PCPS",128, 0)
	7662	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT
	7663	D
	7664	"RTN","RCC PCPS",129, 0)
	7665	. . . ; get the descri ption for the bill
	7666	"RTN","RCC PCPS",130, 0)
	7667	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	7668	"RTN","RCC PCPS",131, 0)
	7669	. . . ;
	7670	"RTN","RCC PCPS",132, 0)
	7671	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7672	"RTN","RCC PCPS",133, 0)
	7673	. . . S RCPSD A=RCPSDA+1
	7674	"RTN","RCC PCPS",134, 0)
	7675	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,4)=$P( RCTRDATE," .")_"^"_$
	7676	G(RCDESC(1 ))_"^"_$G( AMT)_"^"_$ P($G(^PRCA (430,RCBIL LDA,0)),"^ ")
	7677	"RTN","RCC PCPS",135, 0)
	7678	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	7679	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	7680	"RTN","RCC PCPS",136, 0)
	7681	. . ;
	7682	"RTN","RCC PCPS",137, 0)
	7683	. . S RCTRANDA= 0 F S RCT RANDA=$O(^ TMP("PRCAG T",$J,RCDE BTDA,RCTRD ATE,RCBIL
	7684	LDA,RCTRAN DA)) D:'RC TRANDA NO Q:'RCTRAND A D
	7685	"RTN","RCC PCPS",138, 0)
	7686	. . . ; get the descri ption for the transa ction
	7687	"RTN","RCC PCPS",139, 0)
	7688	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	7689	"RTN","RCC PCPS",140, 0)
	7690	. . . ; if i t is an in terest/adm in charge, summarize it below
	7691	"RTN","RCC PCPS",141, 0)
	7692	. . . I $G(RC DESC(1))[" INTEREST" Q
	7693	"RTN","RCC PCPS",142, 0)
	7694	. . . ; get the value of the tra nsaction f or the sta tement
	7695	"RTN","RCC PCPS",143, 0)
	7696	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	7697	"RTN","RCC PCPS",144, 0)
	7698	. . . S VALUE =$P(VALUE, "^",2)+$P( VALUE,"^", 3)+$P(VALU E,"^",4)+$ P(VALUE,"
	7699	^",5)+$P(V ALUE,"^",6 )
	7700	"RTN","RCC PCPS",145, 0)
	7701	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show
	7702	value
	7703	"RTN","RCC PCPS",146, 0)
	7704	. . . ; make suspended charges a ppear as n egative
	7705	"RTN","RCC PCPS",147, 0)
	7706	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	7707	"RTN","RCC PCPS",148, 0)
	7708	. . . I $P(RC DATA1,"^", 2)=47!($P( RCDATA1,"^ ",2)=46) S VALUE=$P( RCDATA1,"
	7709	^",5) I $P (RCDATA1," ^",2)=47 S VALUE=-VA LUE
	7710	"RTN","RCC PCPS",149, 0)
	7711	. . . ; if i t is an am ended bill , show val ue
	7712	"RTN","RCC PCPS",150, 0)
	7713	. . . I $P(RC DATA1,"^", 2)=33 S VA LUE=$P(RCD ATA1,"^",5 )
	7714	"RTN","RCC PCPS",151, 0)
	7715	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7716	"RTN","RCC PCPS",152, 0)
	7717	. . . S RCPSD A=RCPSDA+1
	7718	"RTN","RCC PCPS",153, 0)
	7719	. . . S $P(^R CPS(349.2, PSIEN,2,RC PSDA,0),"^ ",1,5)=$P( RCTRDATE," .")_"^"_$
	7720	G(RCDESC(1 ))_"^"_VAL UE_"^"_$P( $G(^PRCA(4 30,RCBILLD A,0)),"^")
	7721	"RTN","RCC PCPS",154, 0)
	7722	. . . F X=2:1 Q:$G(RCDE SC(X))="" S RCPSDA= RCPSDA+1,^ RCPS(349.2 ,PSIEN,2,
	7723	RCPSDA,0)= "^"_RCDESC (X)_"^^"
	7724	"RTN","RCC PCPS",155, 0)
	7725	. . . ;
	7726	"RTN","RCC PCPS",156, 0)
	7727	. . . ; for comment tr ansaction ... not su re what th is is for ?
	7728	"RTN","RCC PCPS",157, 0)
	7729	. . . I $P(RC DATA1,"^", 2)=45,$P($ G(^PRCA(43 3,RCTRANDA ,5)),"^",2 )["your w
	7730	aiver righ ts" S ^RCP S(349.2,PS IEN,4)="01 50"
	7731	"RTN","RCC PCPS",158, 0)
	7732	. ;
	7733	"RTN","RCC PCPS",159, 0)
	7734	. ; if interest, admin, or other, ad d them her e
	7735	"RTN","RCC PCPS",160, 0)
	7736	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	7737	"RTN","RCC PCPS",161, 0)
	7738	. I X>0 D
	7739	"RTN","RCC PCPS",162, 0)
	7740	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_" Adm
	7741	:"_$J($G(R CTOTAL("AD M")),1,2)_ " Other:"_ $J($G(RCTO TAL("OTH") ),1,2)_")"
	7742	"RTN","RCC PCPS",163, 0)
	7743	. . S RCPSDA=RC PSDA+1
	7744	"RTN","RCC PCPS",164, 0)
	7745	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) ="^"_RCDES C_"^"_$J(X ,1,2)
	7746	"RTN","RCC PCPS",165, 0)
	7747	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^^"_R CPSDA_"^"_ RCPSDA
	7748	"RTN","RCC PCPS",166, 0)
	7749	. ;
	7750	"RTN","RCC PCPS",167, 0)
	7751	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	7752	"RTN","RCC PCPS",168, 0)
	7753	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	7754	"RTN","RCC PCPS",169, 0)
	7755	. ;
	7756	"RTN","RCC PCPS",170, 0)
	7757	. ; se t 0th node
	7758	"RTN","RCC PCPS",171, 0)
	7759	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^^"_RCPSDA _"^"_RCPSD A
	7760	"RTN","RCC PCPS",172, 0)
	7761	. ;
	7762	"RTN","RCC PCPS",173, 0)
	7763	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	7764	"RTN","RCC PCPS",174, 0)
	7765	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	7766	"RTN","RCC PCPS",175, 0)
	7767	. ;
	7768	"RTN","RCC PCPS",176, 0)
	7769	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	7770	"RTN","RCC PCPS",177, 0)
	7771	. K ^XT MP("PRCAGU ",$J,DEB)
	7772	"RTN","RCC PCPS",178, 0)
	7773	. ;
	7774	"RTN","RCC PCPS",179, 0)
	7775	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1
	7776	",PSIEN))= "" Q
	7777	"RTN","RCC PCPS",180, 0)
	7778	. D NO
	7779	"RTN","RCC PCPS",181, 0)
	7780	;
	7781	"RTN","RCC PCPS",182, 0)
	7782	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S $P( ^RCPS(349
	7783	.2,PSIEN,0 ),"^",18)= 1
	7784	"RTN","RCC PCPS",183, 0)
	7785	;
	7786	"RTN","RCC PCPS",184, 0)
	7787	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	7788	"RTN","RCC PCPS",185, 0)
	7789	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	7790	"RTN","RCC PCPS",186, 0)
	7791	;
	7792	"RTN","RCC PCPS",187, 0)
	7793	K COMM,TR ,TRNIEN
	7794	"RTN","RCC PCPS",188, 0)
	7795	;
	7796	"RTN","RCC PCPS",189, 0)
	7797	OSTM ;Proc ess old st atements
	7798	"RTN","RCC PCPS",190, 0)
	7799	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	7800	"RTN","RCC PCPS",191, 0)
	7801	K DA,^XTM P("RCCPC1" )
	7802	"RTN","RCC PCPS",192, 0)
	7803	;
	7804	"RTN","RCC PCPS",193, 0)
	7805	STATMNT ;P rint patie nt stateme nts
	7806	"RTN","RCC PCPS",194, 0)
	7807	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	7808	"RTN","RCC PCPS",195, 0)
	7809	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),"^" ,8)
	7810	"RTN","RCC PCPS",196, 0)
	7811	I IOP]"" D
	7812	"RTN","RCC PCPS",197, 0)
	7813	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	7814	"RTN","RCC PCPS",198, 0)
	7815	.S %ZIS=" N0" D ^%ZI S Q:POP
	7816	"RTN","RCC PCPS",199, 0)
	7817	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	7818	"RTN","RCC PCPS",200, 0)
	7819	; PRCA4. 5313 - Un lock prior to exitin g
	7820	"RTN","RCC PCPS",201, 0)
	7821	L -^RCPS( 349.2):DIL OCKTM
	7822	"RTN","RCC PCPS",202, 0)
	7823	Q
	7824	"RTN","RCC PCPS",203, 0)
	7825	;
	7826	"RTN","RCC PCPS",204, 0)
	7827	NO ;If the re is no a ctivity
	7828	"RTN","RCC PCPS",205, 0)
	7829	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	7830	"RTN","RCC PCPS",206, 0)
	7831	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^
	7832	^"
	7833	"RTN","RCC PCPS",207, 0)
	7834	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	7835	"RTN","RCC PCPS",208, 0)
	7836	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	7837	"RTN","RCC PCPS",209, 0)
	7838	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	7839	"RTN","RCC PCPS",210, 0)
	7840	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	7841	"RTN","RCC PCPS",211, 0)
	7842	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	7843	"RTN","RCC PCPS",212, 0)
	7844	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	7845	"RTN","RCC PCPS",213, 0)
	7846	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	7847	"RTN","RCC PCPS",214, 0)
	7848	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	7849	"RTN","RCC PCPS",215, 0)
	7850	Q
	7851	"RTN","RCC PCPS",216, 0)
	7852	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	7853	"RTN","RCC PCPS",217, 0)
	7854	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	7855	"RTN","RCC PCPS",218, 0)
	7856	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7857	"RTN","RCC PCPS",219, 0)
	7858	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmi
	7859	tted. Try again lat er." Q
	7860	"RTN","RCC PCPS",220, 0)
	7861	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	7862	"RTN","RCC PCPS",221, 0)
	7863	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7864	"RTN","RCC PCPS",222, 0)
	7865	S DIR(0)= "DAO^^D:"" ,1,2,4,6,7 ,8,10,12,1 4,15,17,19 ,21,22,24, 26,""'[("" ,""_+$E(Y
	7866	,6,7)_""," ") BLDERR^ RCCPCPS"
	7867	"RTN","RCC PCPS",223, 0)
	7868	S DIR("A" )="Enter a Patient S tatement d ate for th is build: "
	7869	"RTN","RCC PCPS",224, 0)
	7870	S DIR("?" )="Enter a Patient S tatement d ate for th is build o r ^ to exi t."
	7871	"RTN","RCC PCPS",225, 0)
	7872	D ^DIR
	7873	"RTN","RCC PCPS",226, 0)
	7874	; PRCA4. 5313 - Un lock prior to quitti ng
	7875	"RTN","RCC PCPS",227, 0)
	7876	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	7877	"RTN","RCC PCPS",228, 0)
	7878	S SDT=Y
	7879	"RTN","RCC PCPS",229, 0)
	7880	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	7881	D(DIROUT) Q
	7882	"RTN","RCC PCPS",230, 0)
	7883	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	7884	"RTN","RCC PCPS",231, 0)
	7885	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,
	7886	5,8)
	7887	"RTN","RCC PCPS",232, 0)
	7888	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	7889	"RTN","RCC PCPS",233, 0)
	7890	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0)," ^",10)
	7891	"RTN","RCC PCPS",234, 0)
	7892	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	7893	"RTN","RCC PCPS",235, 0)
	7894	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	7895	"RTN","RCC PCPS",236, 0)
	7896	.E W " d o not have a transmi ssion date !"
	7897	"RTN","RCC PCPS",237, 0)
	7898	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	7899	"RTN","RCC PCPS",238, 0)
	7900	.N DIR,DT OUT,DUOUT, DIRUT,DIRO UT
	7901	"RTN","RCC PCPS",239, 0)
	7902	.S DIR(0) ="E",DIR(" A")=" Pres s ENTER to Continue with Build or ^ to E xit" D ^D
	7903	IR
	7904	"RTN","RCC PCPS",240, 0)
	7905	.I $D(DTO UT)!$D(DUO UT)!$D(DIR UT)!$D(DIR OUT) L -^R CPS(349.2) :DILOCKTM Q
	7906	"RTN","RCC PCPS",241, 0)
	7907	; PRCA4. 5313 - Un lock prior to jobbin g off
	7908	"RTN","RCC PCPS",242, 0)
	7909	L -^RCPS( 349.2):DIL OCKTM
	7910	"RTN","RCC PCPS",243, 0)
	7911	I $D(DIRU T) K SDT Q
	7912	"RTN","RCC PCPS",244, 0)
	7913	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	7914	"RTN","RCC PCPS",245, 0)
	7915	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	7916	"RTN","RCC PCPS",246, 0)
	7917	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	7918	"RTN","RCC PCPS",247, 0)
	7919	; PRCA5. 4313 - Al low run an y time
	7920	"RTN","RCC PCPS",248, 0)
	7921	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	7922	"RTN","RCC PCPS",249, 0)
	7923	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	7924	"RTN","RCC PCPS",250, 0)
	7925	;.D KILL^ %ZTLOAD
	7926	"RTN","RCC PCPS",251, 0)
	7927	W !,"Queu ed for Bui lding."
	7928	"RTN","RCC PCPS",252, 0)
	7929	; PRCA4. 5313 - Un lock prior to quitti ng
	7930	"RTN","RCC PCPS",253, 0)
	7931	L -^RCPS( 349.2):DIL OCKTM
	7932	"RTN","RCC PCPS",254, 0)
	7933	Q
	7934	"RTN","RCC PCPS",255, 0)
	7935	;
	7936	"RTN","RCC PCPS",256, 0)
	7937	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	7938	"RTN","RCC PCPS",257, 0)
	7939	QUIT:$G(R CDESC(1))= ""
	7940	"RTN","RCC PCPS",258, 0)
	7941	S RCINFUL L=" (IN FU LL)"
	7942	"RTN","RCC PCPS",259, 0)
	7943	S RCINPAR T=" (IN PA RT)"
	7944	"RTN","RCC PCPS",260, 0)
	7945	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,
	7946	2)
	7947	"RTN","RCC PCPS",261, 0)
	7948	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,
	7949	2)
	7950	"RTN","RCC PCPS",262, 0)
	7951	Q
	7952	"RTN","RCC PCPS",263, 0)
	7953	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	7954	"RTN","RCC PCPS",264, 0)
	7955	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",R CDFN)) Q X 1
	7956	"RTN","RCC PCPS",265, 0)
	7957	S X2=$O(^ PRCA(430," ATD",RCDFN ,X1),-1)
	7958	"RTN","RCC PCPS",266, 0)
	7959	S X1=$O(^ PRCA(430," ATD",RCDFN ,X2,X1),-1 )
	7960	"RTN","RCC PCPS",267, 0)
	7961	Q X1
	7962	"RTN","RCC PCPS",268, 0)
	7963	BLDERR ; PRCA4.53 13 - Print Error and Kill X
	7964	"RTN","RCC PCPS",269, 0)
	7965	W !!,"INV ALID STATE MENT DATE"
	7966	"RTN","RCC PCPS",270, 0)
	7967	K X
	7968	"RTN","RCC PCPS",271, 0)
	7969	Q
	7970	"RTN","RCC PCPS",272, 0)
	7971	STDT ; En try point for PRCA4 .5313 ver ify Patien t Statemen t date dep endent up
	7972	on the Pat ient Last Name
	7973	"RTN","RCC PCPS",273, 0)
	7974	N DEBT,DI E
	7975	"RTN","RCC PCPS",274, 0)
	7976	S DIE="^R CD(340,"
	7977	"RTN","RCC PCPS",275, 0)
	7978	S DEBT=""
	7979	"RTN","RCC PCPS",276, 0)
	7980	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	7981	"RTN","RCC PCPS",277, 0)
	7982	.N PAT,DP T,NAME,DA, DR
	7983	"RTN","RCC PCPS",278, 0)
	7984	.S PAT=$P ($G(^RCD(3 40,DEBT,0) ),U)
	7985	"RTN","RCC PCPS",279, 0)
	7986	.S DPT=$P (PAT,";",1 )
	7987	"RTN","RCC PCPS",280, 0)
	7988	.S NAME=$ P($G(^DPT( DPT,0)),U)
	7989	"RTN","RCC PCPS",281, 0)
	7990	.S DA=DEB T
	7991	"RTN","RCC PCPS",282, 0)
	7992	.S DR=".0 3////"_+$$ ACSET^RCCP CFN1(NAME)
	7993	"RTN","RCC PCPS",283, 0)
	7994	.I +$$ACS ET^RCCPCFN 1(NAME)'=$ P($G(^RCD( 340,DEBT,0 )),3) D ^D IE
	7995	"RTN","RCC PCPS",284, 0)
	7996	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	7997	"RTN","RCC PCPS",285, 0)
	7998	N DA,DIK
	7999	"RTN","RCC PCPS",286, 0)
	8000	S DIK="^R C(341,"
	8001	"RTN","RCC PCPS",287, 0)
	8002	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	8003	"RTN","RCC PCPS",288, 0)
	8004	Q
	8005	"RTN","RCC PCPS1")
	8006	0^11^B6544 3378^B3737 0113
	8007	"RTN","RCC PCPS1",1,0 )
	8008	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	8009	"RTN","RCC PCPS1",2,0 )
	8010	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build
	8011	130
	8012	"RTN","RCC PCPS1",3,0 )
	8013	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8014	"RTN","RCC PCPS1",4,0 )
	8015	Q
	8016	"RTN","RCC PCPS1",5,0 )
	8017	;
	8018	"RTN","RCC PCPS1",6,0 )
	8019	;
	8020	"RTN","RCC PCPS1",7,0 )
	8021	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	8022	"RTN","RCC PCPS1",8,0 )
	8023	;
	8024	"RTN","RCC PCPS1",9,0 )
	8025	; initia lize
	8026	"RTN","RCC PCPS1",10, 0)
	8027	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	8028	"RTN","RCC PCPS1",11, 0)
	8029	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8030	"RTN","RCC PCPS1",12, 0)
	8031	K RCDESC
	8032	"RTN","RCC PCPS1",13, 0)
	8033	S RCLINE= 1,RCDESC(1 )=""
	8034	"RTN","RCC PCPS1",14, 0)
	8035	;
	8036	"RTN","RCC PCPS1",15, 0)
	8037	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	8038	"RTN","RCC PCPS1",16, 0)
	8039	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8040	"RTN","RCC PCPS1",17, 0)
	8041	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8042	"RTN","RCC PCPS1",18, 0)
	8043	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	8044	"RTN","RCC PCPS1",19, 0)
	8045	S TRANTYP E=$P(RCDAT A1,"^",2)
	8046	"RTN","RCC PCPS1",20, 0)
	8047	;
	8048	"RTN","RCC PCPS1",21, 0)
	8049	; build the first line descr iption
	8050	"RTN","RCC PCPS1",22, 0)
	8051	; if tra nsaction t ype is an increase o r decrease , set desc ription
	8052	"RTN","RCC PCPS1",23, 0)
	8053	I TRANTYP E=1!(TRANT YPE=35) D
	8054	"RTN","RCC PCPS1",24, 0)
	8055	. ; if c means t est, set d escription to catego ry for c m eans test
	8056	"RTN","RCC PCPS1",25, 0)
	8057	. I RCC ATEG=18 S DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^
	8058	",16),0)," ^"),1:RCCA TTXT) Q
	8059	"RTN","RCC PCPS1",26, 0)
	8060	. ; ot herwise, s et to cate gory name
	8061	"RTN","RCC PCPS1",27, 0)
	8062	. S DES CRIPT=RCCA TTXT
	8063	"RTN","RCC PCPS1",28, 0)
	8064	;
	8065	"RTN","RCC PCPS1",29, 0)
	8066	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	8067	"RTN","RCC PCPS1",30, 0)
	8068	; then s et the des cription t o copay
	8069	"RTN","RCC PCPS1",31, 0)
	8070	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	8071	"RTN","RCC PCPS1",32, 0)
	8072	;
	8073	"RTN","RCC PCPS1",33, 0)
	8074	; if the bill cate gory is ad ult day he alth care, remove he alth
	8075	"RTN","RCC PCPS1",34, 0)
	8076	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	8077	"RTN","RCC PCPS1",35, 0)
	8078	;
	8079	"RTN","RCC PCPS1",36, 0)
	8080	; if the bill cate gory is re spite or g eriatric e val,
	8081	"RTN","RCC PCPS1",37, 0)
	8082	; take t he 2nd pie ce removin g institut ional
	8083	"RTN","RCC PCPS1",38, 0)
	8084	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-"
	8085	)_$S(RCCAT EG=35!(RCC ATEG=37):" IN",1:" O UT")_"PATI ENT"
	8086	"RTN","RCC PCPS1",39, 0)
	8087	;
	8088	"RTN","RCC PCPS1",40, 0)
	8089	; if it is a comme nt transac tion
	8090	"RTN","RCC PCPS1",41, 0)
	8091	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	8092	"RTN","RCC PCPS1",42, 0)
	8093	;
	8094	"RTN","RCC PCPS1",43, 0)
	8095	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	8096	"RTN","RCC PCPS1",44, 0)
	8097	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPA
	8098	YMENT CRED IT DECREAS E",1:"OVER PAYMENT RE FUND")
	8099	"RTN","RCC PCPS1",45, 0)
	8100	;
	8101	"RTN","RCC PCPS1",46, 0)
	8102	; if the first lin e descript ion not se t (like pa yments), s et it
	8103	"RTN","RCC PCPS1",47, 0)
	8104	; to the type of t ransaction
	8105	"RTN","RCC PCPS1",48, 0)
	8106	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	8107	"RTN","RCC PCPS1",49, 0)
	8108	;
	8109	"RTN","RCC PCPS1",50, 0)
	8110	; if the transacti on date is different from the process da te,
	8111	"RTN","RCC PCPS1",51, 0)
	8112	; show i t with the descripti on
	8113	"RTN","RCC PCPS1",52, 0)
	8114	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIP
	8115	T=DESCRIPT _" ("_$$D ATE($P($P( RCDATA1,"^ "),"."))_" )"
	8116	"RTN","RCC PCPS1",53, 0)
	8117	;
	8118	"RTN","RCC PCPS1",54, 0)
	8119	; set th e first de scription line
	8120	"RTN","RCC PCPS1",55, 0)
	8121	D SETDESC (DESCRIPT)
	8122	"RTN","RCC PCPS1",56, 0)
	8123	;
	8124	"RTN","RCC PCPS1",57, 0)
	8125	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	8126	"RTN","RCC PCPS1",58, 0)
	8127	I TRANTYP E=2!(TRANT YPE=34) D
	8128	"RTN","RCC PCPS1",59, 0)
	8129	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	8130	"RTN","RCC PCPS1",60, 0)
	8131	. ; if not inter est, admin , or other , quit
	8132	"RTN","RCC PCPS1",61, 0)
	8133	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^"
	8134	,5) Q
	8135	"RTN","RCC PCPS1",62, 0)
	8136	. ;
	8137	"RTN","RCC PCPS1",63, 0)
	8138	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^
	8139	",3),1,2)
	8140	"RTN","RCC PCPS1",64, 0)
	8141	. ; ca lculate ot her
	8142	"RTN","RCC PCPS1",65, 0)
	8143	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	8144	"RTN","RCC PCPS1",66, 0)
	8145	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	8146	"RTN","RCC PCPS1",67, 0)
	8147	. D SET DESC(DESCR IPT)
	8148	"RTN","RCC PCPS1",68, 0)
	8149	;
	8150	"RTN","RCC PCPS1",69, 0)
	8151	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	8152	"RTN","RCC PCPS1",70, 0)
	8153	I TRANTYP E=13!(TRAN TYPE=12) D Q
	8154	"RTN","RCC PCPS1",71, 0)
	8155	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	8156	"RTN","RCC PCPS1",72, 0)
	8157	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	8158	"RTN","RCC PCPS1",73, 0)
	8159	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	8160	"RTN","RCC PCPS1",74, 0)
	8161	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^
	8162	",8))
	8163	"RTN","RCC PCPS1",75, 0)
	8164	;
	8165	"RTN","RCC PCPS1",76, 0)
	8166	; if not an increa se adjustm ent, quit
	8167	"RTN","RCC PCPS1",77, 0)
	8168	I TRANTYP E'=1 Q
	8169	"RTN","RCC PCPS1",78, 0)
	8170	;
	8171	"RTN","RCC PCPS1",79, 0)
	8172	; increa se to c me ans test, ltc or rx- copay, get data from ib
	8173	"RTN","RCC PCPS1",80, 0)
	8174	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	8175	"RTN","RCC PCPS1",81, 0)
	8176	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	8177	"RTN","RCC PCPS1",82, 0)
	8178	. K ^TM P("IBRFN1" ,$J)
	8179	"RTN","RCC PCPS1",83, 0)
	8180	. D STM T^IBRFN1(R CTRANDA)
	8181	"RTN","RCC PCPS1",84, 0)
	8182	. D IBD ATA
	8183	"RTN","RCC PCPS1",85, 0)
	8184	Q
	8185	"RTN","RCC PCPS1",86, 0)
	8186	;
	8187	"RTN","RCC PCPS1",87, 0)
	8188	;
	8189	"RTN","RCC PCPS1",88, 0)
	8190	; Return s RCDESC(1 ..n) array of Bill D escription
	8191	"RTN","RCC PCPS1",89, 0)
	8192	BILLDESC(R CBILLDA,RC WIDTH) ;
	8193	"RTN","RCC PCPS1",90, 0)
	8194	; initia lize
	8195	"RTN","RCC PCPS1",91, 0)
	8196	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	8197	"RTN","RCC PCPS1",92, 0)
	8198	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8199	"RTN","RCC PCPS1",93, 0)
	8200	K RCDESC
	8201	"RTN","RCC PCPS1",94, 0)
	8202	S RCLINE= 1,RCDESC(1 )=""
	8203	"RTN","RCC PCPS1",95, 0)
	8204	;
	8205	"RTN","RCC PCPS1",96, 0)
	8206	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8207	"RTN","RCC PCPS1",97, 0)
	8208	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8209	"RTN","RCC PCPS1",98, 0)
	8210	;
	8211	"RTN","RCC PCPS1",99, 0)
	8212	; if cat egory=c me ans test, set the de scription and quit
	8213	"RTN","RCC PCPS1",100 ,0)
	8214	I RCCATEG =18 S DESC RIPT=$S($P (RCDATA0," ^",16):$P( ^PRCA(430. 2,$P(RCDAT A0,"^",16
	8215	),0),"^"), 1:RCCATTXT ) D SETDES C(DESCRIPT ) Q
	8216	"RTN","RCC PCPS1",101 ,0)
	8217	;
	8218	"RTN","RCC PCPS1",102 ,0)
	8219	; set th e category descripti on
	8220	"RTN","RCC PCPS1",103 ,0)
	8221	D SETDESC (RCCATTXT)
	8222	"RTN","RCC PCPS1",104 ,0)
	8223	;
	8224	"RTN","RCC PCPS1",105 ,0)
	8225	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	8226	"RTN","RCC PCPS1",106 ,0)
	8227	I RCCATEG '=27,RCCAT EG'=31 Q
	8228	"RTN","RCC PCPS1",107 ,0)
	8229	;
	8230	"RTN","RCC PCPS1",108 ,0)
	8231	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	8232	"RTN","RCC PCPS1",109 ,0)
	8233	; get da ta from ib
	8234	"RTN","RCC PCPS1",110 ,0)
	8235	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	8236	"RTN","RCC PCPS1",111 ,0)
	8237	K ^TMP("I BRFN1",$J)
	8238	"RTN","RCC PCPS1",112 ,0)
	8239	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	8240	"RTN","RCC PCPS1",113 ,0)
	8241	D IBDATA
	8242	"RTN","RCC PCPS1",114 ,0)
	8243	Q
	8244	"RTN","RCC PCPS1",115 ,0)
	8245	;
	8246	"RTN","RCC PCPS1",116 ,0)
	8247	;
	8248	"RTN","RCC PCPS1",117 ,0)
	8249	IBDATA ; get data f rom IB for descripti on
	8250	"RTN","RCC PCPS1",118 ,0)
	8251	N IBDATA, IBJ
	8252	"RTN","RCC PCPS1",119 ,0)
	8253	;
	8254	"RTN","RCC PCPS1",120 ,0)
	8255	; show I B data
	8256	"RTN","RCC PCPS1",121 ,0)
	8257	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,I
	8258	BJ) D
	8259	"RTN","RCC PCPS1",122 ,0)
	8260	. ;
	8261	"RTN","RCC PCPS1",123 ,0)
	8262	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	8263	"RTN","RCC PCPS1",124 ,0)
	8264	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(
	8265	IBDATA,"^" ,2))) Q
	8266	"RTN","RCC PCPS1",125 ,0)
	8267	. ;
	8268	"RTN","RCC PCPS1",126 ,0)
	8269	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	8270	"RTN","RCC PCPS1",127 ,0)
	8271	. I '$P (IBDATA,"^ ",6) D Q
	8272	"RTN","RCC PCPS1",128 ,0)
	8273	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^"
	8274	,2)))
	8275	"RTN","RCC PCPS1",129 ,0)
	8276	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$D
	8277	ATE($P(IBD ATA,"^",3) ))
	8278	"RTN","RCC PCPS1",130 ,0)
	8279	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE
	8280	($P(IBDATA ,"^",4)))
	8281	"RTN","RCC PCPS1",131 ,0)
	8282	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^"
	8283	,5)))
	8284	"RTN","RCC PCPS1",132 ,0)
	8285	. ;
	8286	"RTN","RCC PCPS1",133 ,0)
	8287	. ; ph armacy
	8288	"RTN","RCC PCPS1",134 ,0)
	8289	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	8290	"RTN","RCC PCPS1",135 ,0)
	8291	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	8292	"RTN","RCC PCPS1",136 ,0)
	8293	. ;
	8294	"RTN","RCC PCPS1",137 ,0)
	8295	. ; if not patie nt stateme nt detail, quit
	8296	"RTN","RCC PCPS1",138 ,0)
	8297	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	8298	"RTN","RCC PCPS1",139 ,0)
	8299	. ;
	8300	"RTN","RCC PCPS1",140 ,0)
	8301	. ; re turn pharm acy detail
	8302	"RTN","RCC PCPS1",141 ,0)
	8303	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	8304	"RTN","RCC PCPS1",142 ,0)
	8305	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	8306	"RTN","RCC PCPS1",143 ,0)
	8307	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	8308	"RTN","RCC PCPS1",144 ,0)
	8309	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	8310	"RTN","RCC PCPS1",145 ,0)
	8311	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	8312	"RTN","RCC PCPS1",146 ,0)
	8313	;
	8314	"RTN","RCC PCPS1",147 ,0)
	8315	K ^TMP("I BRFN1",$J)
	8316	"RTN","RCC PCPS1",148 ,0)
	8317	Q
	8318	"RTN","RCC PCPS1",149 ,0)
	8319	;
	8320	"RTN","RCC PCPS1",150 ,0)
	8321	;
	8322	"RTN","RCC PCPS1",151 ,0)
	8323	; Add lin e to the d escription , not long er than RC WIDTH
	8324	"RTN","RCC PCPS1",152 ,0)
	8325	; Input: RCLINE,RCW IDTH
	8326	"RTN","RCC PCPS1",153 ,0)
	8327	; Output: RCDESC
	8328	"RTN","RCC PCPS1",154 ,0)
	8329	SETDESC(DE SCRIPT) N LENGTH
	8330	"RTN","RCC PCPS1",155 ,0)
	8331	; calcul ate the le ngth of th e descript ion
	8332	"RTN","RCC PCPS1",156 ,0)
	8333	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	8334	"RTN","RCC PCPS1",157 ,0)
	8335	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	8336	"RTN","RCC PCPS1",158 ,0)
	8337	;
	8338	"RTN","RCC PCPS1",159 ,0)
	8339	; the de scription line canno t go over RCWIDTH ch aracters
	8340	"RTN","RCC PCPS1",160 ,0)
	8341	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" "
	8342	)_DESCRIPT Q
	8343	"RTN","RCC PCPS1",161 ,0)
	8344	;
	8345	"RTN","RCC PCPS1",162 ,0)
	8346	; Descrip tion line to add is over RCWID TH
	8347	"RTN","RCC PCPS1",163 ,0)
	8348	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charac
	8349	ters.
	8350	"RTN","RCC PCPS1",164 ,0)
	8351	I $L(DESC RIPT)>RCWI DTH D Q
	8352	"RTN","RCC PCPS1",165 ,0)
	8353	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	8354	"RTN","RCC PCPS1",166 ,0)
	8355	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	8356	"RTN","RCC PCPS1",167 ,0)
	8357	. S RCL INE=RCLINE +1
	8358	"RTN","RCC PCPS1",168 ,0)
	8359	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	8360	"RTN","RCC PCPS1",169 ,0)
	8361	;
	8362	"RTN","RCC PCPS1",170 ,0)
	8363	; over R CWIDTH cha racters, s tart new l ine
	8364	"RTN","RCC PCPS1",171 ,0)
	8365	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	8366	"RTN","RCC PCPS1",172 ,0)
	8367	S RCDESC( RCLINE)=DE SCRIPT
	8368	"RTN","RCC PCPS1",173 ,0)
	8369	Q
	8370	"RTN","RCC PCPS1",174 ,0)
	8371	;
	8372	"RTN","RCC PCPS1",175 ,0)
	8373	DATE(FMDT) ; format date mm/d d/yyyy
	8374	"RTN","RCC PCPS1",176 ,0)
	8375	I 'FMDT Q ""
	8376	"RTN","RCC PCPS1",177 ,0)
	8377	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	8378	"RTN","RCC PCPS1",178 ,0)
	8379	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	8380	"RTN","RCC PCPS1",179 ,0)
	8381	;
	8382	"RTN","RCC PCPS1",180 ,0)
	8383	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of mont
	8384	h
	8385	"RTN","RCC PCPS1",181 ,0)
	8386	;
	8387	"RTN","RCC PCPS1",182 ,0)
	8388	; Set dat e back one month
	8389	"RTN","RCC PCPS1",183 ,0)
	8390	N IEN,X,R CT,DA,DIK, ACK
	8391	"RTN","RCC PCPS1",184 ,0)
	8392	;
	8393	"RTN","RCC PCPS1",185 ,0)
	8394	S IEN=""
	8395	"RTN","RCC PCPS1",186 ,0)
	8396	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2,"
	8397	D ^DIK
	8398	"RTN","RCC PCPS1",187 ,0)
	8399	;
	8400	"RTN","RCC PCPS1",188 ,0)
	8401	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	8402	"RTN","RCC PCPS1",189 ,0)
	8403	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	8404	"RTN","RCC PCPS1",190 ,0)
	8405	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S DA=
	8406	IEN,DIK="^ RCT(349.1, "_RCT_",4, " D ^DIK K ^RCT(349. 1,RCT,4,"S TDT4",SDT, ACK,IEN)
	8407	"RTN","RCC PCPS1",191 ,0)
	8408	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S DA=IEN,DI
	8409	K="^RCT(34 9.1,"_RCT_ ",5," D ^D IK K ^RCT( 349.1,RCT, 5,"STDT5", SDT,IEN)
	8410	"RTN","RCC PCPS1",192 ,0)
	8411	;
	8412	"RTN","RCC PCPS1",193 ,0)
	8413	K ^XTMP(" RCCPC")
	8414	"RTN","RCC PCPS1",194 ,0)
	8415	;
	8416	"RTN","RCC PCPS1",195 ,0)
	8417	Q
	8418	"RTN","RCC PCPS1",196 ,0)
	8419	;
	8420	"RTN","RCC PCPS1",197 ,0)
	8421	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date - S
	8422	DT is stat ement date
	8423	"RTN","RCC PCPS1",198 ,0)
	8424	; and Sta tement dat e cannot e xceed 26th day of th e month.
	8425	"RTN","RCC PCPS1",199 ,0)
	8426	; New OLD DT in call ing routin e
	8427	"RTN","RCC PCPS1",200 ,0)
	8428	S OLDDT=S DT-100
	8429	"RTN","RCC PCPS1",201 ,0)
	8430	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	8431	"RTN","RCC PCPS1",202 ,0)
	8432	Q OLDDT
	8433	"RTN","RCC PCPS1",203 ,0)
	8434	;
	8435	"RTN","RCC PCPS1",204 ,0)
	8436	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mi
	8437	ssing ICNs
	8438	"RTN","RCC PCPS1",205 ,0)
	8439	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	8440	"RTN","RCC PCPS1",206 ,0)
	8441	;
	8442	"RTN","RCC PCPS1",207 ,0)
	8443	; Create Message at MSG level of tempor ary storag e
	8444	"RTN","RCC PCPS1",208 ,0)
	8445	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patien
	8446	ts were no t sent to CBSS due t o a"
	8447	"RTN","RCC PCPS1",209 ,0)
	8448	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	8449	"RTN","RCC PCPS1",210 ,0)
	8450	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN
	8451	"
	8452	"RTN","RCC PCPS1",211 ,0)
	8453	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== =========
	8454	======="
	8455	"RTN","RCC PCPS1",212 ,0)
	8456	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	8457	"RTN","RCC PCPS1",213 ,0)
	8458	. N DPTDA TA,NAME
	8459	"RTN","RCC PCPS1",214 ,0)
	8460	. S DPTDA TA=$G(^DPT (DFN,0))
	8461	"RTN","RCC PCPS1",215 ,0)
	8462	. I DPTDA TA="" Q
	8463	"RTN","RCC PCPS1",216 ,0)
	8464	. S NAME= $P(DPTDATA ,U)
	8465	"RTN","RCC PCPS1",217 ,0)
	8466	. I $L(NA ME)<35 S $ E(NAME,35) =" "
	8467	"RTN","RCC PCPS1",218 ,0)
	8468	. S CNT=C NT+1
	8469	"RTN","RCC PCPS1",219 ,0)
	8470	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ $P(DPTDATA ,U,9)
	8471	"RTN","RCC PCPS1",220 ,0)
	8472	;
	8473	"RTN","RCC PCPS1",221 ,0)
	8474	S XMDUZ=D UZ
	8475	"RTN","RCC PCPS1",222 ,0)
	8476	S XMTO(DU Z)=""
	8477	"RTN","RCC PCPS1",223 ,0)
	8478	S XMTO("G .RCCPC STA TEMENTS")= ""
	8479	"RTN","RCC PCPS1",224 ,0)
	8480	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	8481	"RTN","RCC PCPS1",225 ,0)
	8482	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	8483	"RTN","RCC PCPS1",226 ,0)
	8484	S XMINSTR ("FLAGS")= "X"
	8485	"RTN","RCC PCPS1",227 ,0)
	8486	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	8487	"RTN","RCC PCPS1",228 ,0)
	8488	Q
	8489	"RTN","RCC PCSE")
	8490	0^14^B1650 7603^B5810 439
	8491	"RTN","RCC PCSE",1,0)
	8492	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors;5/ 30/96 10: 20 AM ;10
	8493	/16/96 8: 42 AM
	8494	"RTN","RCC PCSE",2,0)
	8495	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 13 0
	8496	"RTN","RCC PCSE",3,0)
	8497	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8498	"RTN","RCC PCSE",4,0)
	8499	;
	8500	"RTN","RCC PCSE",5,0)
	8501	K ^TMP($J )
	8502	"RTN","RCC PCSE",6,0)
	8503	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%
	8504	Y,ZTSAVE
	8505	"RTN","RCC PCSE",7,0)
	8506	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS
	8507	" Q
	8508	"RTN","RCC PCSE",8,0)
	8509	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	8510	"RTN","RCC PCSE",9,0)
	8511	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	8512	"RTN","RCC PCSE",10,0 )
	8513	S (TMPQ,A LL)=0
	8514	"RTN","RCC PCSE",11,0 )
	8515	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN
	8516	,5))'="" D
	8517	"RTN","RCC PCSE",12,0 )
	8518	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	8519	"RTN","RCC PCSE",13,0 )
	8520	. S DTPT( SDT,IEN)=" "
	8521	"RTN","RCC PCSE",14,0 )
	8522	. S DTPT( SDT)=$G(DT PT(SDT))+1
	8523	"RTN","RCC PCSE",15,0 )
	8524	; PRCA4. 5313 - As k about al l dates or specific
	8525	"RTN","RCC PCSE",16,0 )
	8526	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8527	"RTN","RCC PCSE",17,0 )
	8528	S DIR(0)= "YAO"
	8529	"RTN","RCC PCSE",18,0 )
	8530	S DIR("B" )="Y"
	8531	"RTN","RCC PCSE",19,0 )
	8532	S DIR("A" )="Do you want to pr int errors for all d ates avail able? "
	8533	"RTN","RCC PCSE",20,0 )
	8534	D ^DIR
	8535	"RTN","RCC PCSE",21,0 )
	8536	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8537	"RTN","RCC PCSE",22,0 )
	8538	I Y=1 S A LL=1 D PRI NT Q
	8539	"RTN","RCC PCSE",23,0 )
	8540	; PRCA4. 5313 - Ad d date pro mpts
	8541	"RTN","RCC PCSE",24,0 )
	8542	W !,"The following dates have errors to print:"
	8543	"RTN","RCC PCSE",25,0 )
	8544	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	8545	"RTN","RCC PCSE",26,0 )
	8546	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8547	"RTN","RCC PCSE",27,0 )
	8548	S DIR(0)= "DAO^^K:'$ D(DTPT(Y)) X"
	8549	"RTN","RCC PCSE",28,0 )
	8550	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	8551	"RTN","RCC PCSE",29,0 )
	8552	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	8553	"RTN","RCC PCSE",30,0 )
	8554	D ^DIR
	8555	"RTN","RCC PCSE",31,0 )
	8556	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8557	"RTN","RCC PCSE",32,0 )
	8558	S SDT=Y
	8559	"RTN","RCC PCSE",33,0 )
	8560	D PRINT
	8561	"RTN","RCC PCSE",34,0 )
	8562	Q
	8563	"RTN","RCC PCSE",35,0 )
	8564	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	8565	"RTN","RCC PCSE",36,0 )
	8566	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	8567	"RTN","RCC PCSE",37,0 )
	8568	I $D(IO(" Q")) D Q
	8569	"RTN","RCC PCSE",38,0 )
	8570	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	8571	"RTN","RCC PCSE",39,0 )
	8572	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	8573	"RTN","RCC PCSE",40,0 )
	8574	.D ^%ZTLO AD
	8575	"RTN","RCC PCSE",41,0 )
	8576	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	8577	"RTN","RCC PCSE",42,0 )
	8578	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	8579	"RTN","RCC PCSE",43,0 )
	8580	I 'ALL D SORT1,PRNT Q
	8581	"RTN","RCC PCSE",44,0 )
	8582	I ALL S S DT=""
	8583	"RTN","RCC PCSE",45,0 )
	8584	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	8585	"RTN","RCC PCSE",46,0 )
	8586	D PRNT
	8587	"RTN","RCC PCSE",47,0 )
	8588	; PRCA4. 5313 - Re move TMP s torage
	8589	"RTN","RCC PCSE",48,0 )
	8590	K ^TMP($J )
	8591	"RTN","RCC PCSE",49,0 )
	8592	Q
	8593	"RTN","RCC PCSE",50,0 )
	8594	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	8595	"RTN","RCC PCSE",51,0 )
	8596	N IEN
	8597	"RTN","RCC PCSE",52,0 )
	8598	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	8599	"RTN","RCC PCSE",53,0 )
	8600	.S ERR=$G (^RCPS(349 .2,IEN,5))
	8601	"RTN","RCC PCSE",54,0 )
	8602	.S ^TMP($ J,"ERR",SD T,IEN)=$P( $G(^RCPS(3 49.2,IEN,0 )),"^",3)_ "^"_$P(^(0 ),"^",2)
	8603	"RTN","RCC PCSE",55,0 )
	8604	.S ADD=$G (^RCPS(349 .2,IEN,1))
	8605	"RTN","RCC PCSE",56,0 )
	8606	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	8607	"RTN","RCC PCSE",57,0 )
	8608	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	8609	"RTN","RCC PCSE",58,0 )
	8610	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	8611	"RTN","RCC PCSE",59,0 )
	8612	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	8613	"RTN","RCC PCSE",60,0 )
	8614	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	8615	"RTN","RCC PCSE",61,0 )
	8616	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	8617	"RTN","RCC PCSE",62,0 )
	8618	;
	8619	"RTN","RCC PCSE",63,0 )
	8620	K ADD
	8621	"RTN","RCC PCSE",64,0 )
	8622	Q
	8623	"RTN","RCC PCSE",65,0 )
	8624	PRNT ; PR CA4.5313 - Print b ased upon statement date
	8625	"RTN","RCC PCSE",66,0 )
	8626	K DIRUT
	8627	"RTN","RCC PCSE",67,0 )
	8628	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8629	"RTN","RCC PCSE",68,0 )
	8630	S (SDT,IE N)=""
	8631	"RTN","RCC PCSE",69,0 )
	8632	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$
	8633	D(DIROUT) Q
	8634	"RTN","RCC PCSE",70,0 )
	8635	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	8636	"RTN","RCC PCSE",71,0 )
	8637	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	8638	"RTN","RCC PCSE",72,0 )
	8639	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 I $ D(DTOUT)!$ D(DUOUT)!
	8640	$D(DIRUT)! $D(DIROUT) Q
	8641	"RTN","RCC PCSE",73,0 )
	8642	. I 'TMPQ S DIR(0)= "E" D ^DIR I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8643	"RTN","RCC PCSE",74,0 )
	8644	Q
	8645	"RTN","RCC PCSE",75,0 )
	8646	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	8647	"RTN","RCC PCSE",76,0 )
	8648	I ($Y+12) >IOSL D
	8649	"RTN","RCC PCSE",77,0 )
	8650	.I 'TMPQ S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	8651	"RTN","RCC PCSE",78,0 )
	8652	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	8653	"RTN","RCC PCSE",79,0 )
	8654	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8655	"RTN","RCC PCSE",80,0 )
	8656	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^"
	8657	,2),?30,$E (LINE,1,48 )
	8658	"RTN","RCC PCSE",81,0 )
	8659	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	8660	"RTN","RCC PCSE",82,0 )
	8661	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	8662	"RTN","RCC PCSE",83,0 )
	8663	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	8664	"RTN","RCC PCSE",84,0 )
	8665	S (Z,Y)=0 F D Q:Y =""&(Z="")
	8666	"RTN","RCC PCSE",85,0 )
	8667	.W !
	8668	"RTN","RCC PCSE",86,0 )
	8669	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	8670	"RTN","RCC PCSE",87,0 )
	8671	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	8672	"RTN","RCC PCSE",88,0 )
	8673	W !,LINE
	8674	"RTN","RCC PCSE",89,0 )
	8675	Q
	8676	"RTN","RCC PCSV")
	8677	0^9^B11825 361^B51994 90
	8678	"RTN","RCC PCSV",1,0)
	8679	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11
	8680	:36 AM
	8681	"RTN","RCC PCSV",2,0)
	8682	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 130
	8683	"RTN","RCC PCSV",3,0)
	8684	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8685	"RTN","RCC PCSV",4,0)
	8686	;
	8687	"RTN","RCC PCSV",5,0)
	8688	EN ;INPUT FROM MESSA GE
	8689	"RTN","RCC PCSV",6,0)
	8690	RREC ;READ INCOMING MESSAGE
	8691	"RTN","RCC PCSV",7,0)
	8692	N DAT,DEB ,END,ERR,E RROR,EVN,K EY,LABEL,L N,MSG,P,RC MSG,RCTR,R CX,RCX1,RE ,SBAL,STO
	8693	T,TR,TR0,T R1,TXT
	8694	"RTN","RCC PCSV",8,0)
	8695	N SDT,NOE RR,X,Y,DA
	8696	"RTN","RCC PCSV",9,0)
	8697	K ^TMP($J )
	8698	"RTN","RCC PCSV",10,0 )
	8699	S (LN,MSG ,RCX,RE)=0
	8700	"RTN","RCC PCSV",11,0 )
	8701	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	8702	"RTN","RCC PCSV",12,0 )
	8703	S (DA(1), NOERR)=""
	8704	"RTN","RCC PCSV",13,0 )
	8705	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	8706	"RTN","RCC PCSV",14,0 )
	8707	. S:^TMP( $J,"MSG",T XT)?1"PA^" .E DA(1)=4 S:^TMP($J ,"MSG",TXT )?1"IS".E DA(1)=3
	8708	"RTN","RCC PCSV",15,0 )
	8709	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	8710	"RTN","RCC PCSV",16,0 )
	8711	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT
	8712	S SDT=Y
	8713	"RTN","RCC PCSV",17,0 )
	8714	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed
	8715	quit afte r setting an error
	8716	"RTN","RCC PCSV",18,0 )
	8717	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I ( $D(^RCT(34 9.1,DA(1), 4,"STDT4", SDT,$P(^T
	8718	MP($J,"MSG ",TXT),U,2 )))) D Q
	8719	"RTN","RCC PCSV",19,0 )
	8720	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($
	8721	J,"MSG",TX T),U,7) D ERRMSG
	8722	"RTN","RCC PCSV",20,0 )
	8723	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D
	8724	ERRMSG
	8725	"RTN","RCC PCSV",21,0 )
	8726	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	8727	"RTN","RCC PCSV",22,0 )
	8728	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	8729	"RTN","RCC PCSV",23,0 )
	8730	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	8731	"RTN","RCC PCSV",24,0 )
	8732	. I $G(XM Z)=""!('DA (1))!($D(E RR)) Q
	8733	"RTN","RCC PCSV",25,0 )
	8734	. S RCX=R CX+1
	8735	"RTN","RCC PCSV",26,0 )
	8736	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	8737	"RTN","RCC PCSV",27,0 )
	8738	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, a
	8739	nd ID reco rds
	8740	"RTN","RCC PCSV",28,0 )
	8741	. . N DIN UM,DIC,X
	8742	"RTN","RCC PCSV",29,0 )
	8743	. . S DIN UM=+$G(XMZ )_RCX
	8744	"RTN","RCC PCSV",30,0 )
	8745	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	8746	"RTN","RCC PCSV",31,0 )
	8747	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	8748	"RTN","RCC PCSV",32,0 )
	8749	. . S DIC (0)="L"
	8750	"RTN","RCC PCSV",33,0 )
	8751	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	8752	4////"_SDT
	8753	"RTN","RCC PCSV",34,0 )
	8754	. . D FIL E^DICN
	8755	"RTN","RCC PCSV",35,0 )
	8756	. ; PRCA* 4.5*313 - If process ing has oc curred
	8757	"RTN","RCC PCSV",36,0 )
	8758	. S NOERR =1
	8759	"RTN","RCC PCSV",37,0 )
	8760	;
	8761	"RTN","RCC PCSV",38,0 )
	8762	K DA(1)
	8763	"RTN","RCC PCSV",39,0 )
	8764	I NOERR D SEG,KILL^ XM
	8765	"RTN","RCC PCSV",40,0 )
	8766	I $O(^TMP ($J,"ERR", 0)) D
	8767	"RTN","RCC PCSV",41,0 )
	8768	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	8769	"RTN","RCC PCSV",42,0 )
	8770	. S XMSUB ="CBSS ERR OR MESSAGE TO STATIO N FOR "_SD T
	8771	"RTN","RCC PCSV",43,0 )
	8772	. S XMDUZ ="AR PACKA GE"
	8773	"RTN","RCC PCSV",44,0 )
	8774	. S XMTEX T="^TMP($J ,"_"""ERR" ","
	8775	"RTN","RCC PCSV",45,0 )
	8776	. I $O(^X MB(3.8,"B" ,"RCCPC ST ATEMENTS", 0)) S XMY( "G.RCCPC S TATEMENTS" )=""
	8777	"RTN","RCC PCSV",46,0 )
	8778	. D ^XMD
	8779	"RTN","RCC PCSV",47,0 )
	8780	. K ^TMP( $J)
	8781	"RTN","RCC PCSV",48,0 )
	8782	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	8783	"RTN","RCC PCSV",49,0 )
	8784	. D:$G(RE )="R"&($G( SDT)'="") EN^RCCPCML (SDT)
	8785	"RTN","RCC PCSV",50,0 )
	8786	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	8787	"RTN","RCC PCSV",51,0 )
	8788	Q
	8789	"RTN","RCC PCSV",52,0 )
	8790	;
	8791	"RTN","RCC PCSV",53,0 )
	8792	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	8793	"RTN","RCC PCSV",54,0 )
	8794	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8795	"RTN","RCC PCSV",55,0 )
	8796	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	8797	"RTN","RCC PCSV",56,0 )
	8798	.D @(LABE L)
	8799	"RTN","RCC PCSV",57,0 )
	8800	Q
	8801	"RTN","RCC PCSV",58,0 )
	8802	;
	8803	"RTN","RCC PCSV",59,0 )
	8804	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	8805	"RTN","RCC PCSV",60,0 )
	8806	;
	8807	"RTN","RCC PCSV",61,0 )
	8808	; PRCA4. 5313 - Ch ange CCPC to CBSS
	8809	"RTN","RCC PCSV",62,0 )
	8810	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	8811	"RTN","RCC PCSV",63,0 )
	8812	S ERR="An error has occurred in reading a message from the CBSS."
	8813	"RTN","RCC PCSV",64,0 )
	8814	D ERRMSG
	8815	"RTN","RCC PCSV",65,0 )
	8816	S ERR="Pl ease conta ct your IR M for assi stance."
	8817	"RTN","RCC PCSV",66,0 )
	8818	D ERRMSG
	8819	"RTN","RCC PCSV",67,0 )
	8820	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	8821	"RTN","RCC PCSV",68,0 )
	8822	D ERRMSG
	8823	"RTN","RCC PCSV",69,0 )
	8824	S ERR=^TM P($J,"MSG" ,RCMSG)
	8825	"RTN","RCC PCSV",70,0 )
	8826	D ERRMSG
	8827	"RTN","RCC PCSV",71,0 )
	8828	Q
	8829	"RTN","RCC PCSV",72,0 )
	8830	;
	8831	"RTN","RCC PCSV",73,0 )
	8832	IS ;INVALI D STATEMEN T
	8833	"RTN","RCC PCSV",74,0 )
	8834	D IS^RCCP CSV1
	8835	"RTN","RCC PCSV",75,0 )
	8836	Q
	8837	"RTN","RCC PCSV",76,0 )
	8838	;
	8839	"RTN","RCC PCSV",77,0 )
	8840	PA ;STATEM ENT ACKNOW LEDGEMENT
	8841	"RTN","RCC PCSV",78,0 )
	8842	D PA^RCCP CSV1
	8843	"RTN","RCC PCSV",79,0 )
	8844	Q
	8845	"RTN","RCC PCSV",80,0 )
	8846	;
	8847	"RTN","RCC PCSV",81,0 )
	8848	IT ;INVALI D TRANSMIS SION
	8849	"RTN","RCC PCSV",82,0 )
	8850	D IT^RCCP CSV1
	8851	"RTN","RCC PCSV",83,0 )
	8852	Q
	8853	"RTN","RCC PCSV",84,0 )
	8854	;
	8855	"RTN","RCC PCSV",85,0 )
	8856	ERRMSG ;ER ROR MESSAG E
	8857	"RTN","RCC PCSV",86,0 )
	8858	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	8859	"RTN","RCC PCSV",87,0 )
	8860	Q
	8861	"RTN","RCC PCSV1")
	8862	0^12^B4331 3841^B3201 7096
	8863	"RTN","RCC PCSV1",1,0 )
	8864	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:
	8865	54 PM
	8866	"RTN","RCC PCSV1",2,0 )
	8867	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 130
	8868	"RTN","RCC PCSV1",3,0 )
	8869	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8870	"RTN","RCC PCSV1",4,0 )
	8871	;
	8872	"RTN","RCC PCSV1",5,0 )
	8873	IS ;INVALI D STATEMEN T
	8874	"RTN","RCC PCSV1",6,0 )
	8875	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	8876	"RTN","RCC PCSV1",7,0 )
	8877	N SDAT,SD T,X,Y,ERR
	8878	"RTN","RCC PCSV1",8,0 )
	8879	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	8880	"RTN","RCC PCSV1",9,0 )
	8881	D CHKTRAN (LABEL)
	8882	"RTN","RCC PCSV1",10, 0)
	8883	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	8884	"RTN","RCC PCSV1",11, 0)
	8885	S ERR=" " D ERRMSG
	8886	"RTN","RCC PCSV1",12, 0)
	8887	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	8888	"RTN","RCC PCSV1",13, 0)
	8889	D ID
	8890	"RTN","RCC PCSV1",14, 0)
	8891	S ERR="If these err ors are co rrected, t hese state ments will not print until" D
	8892	ERRMSG S ERR="the n ext billin g cycle." D ERRMSG
	8893	"RTN","RCC PCSV1",15, 0)
	8894	Q
	8895	"RTN","RCC PCSV1",16, 0)
	8896	;
	8897	"RTN","RCC PCSV1",17, 0)
	8898	ID ;INVALI D STATEMEN T DETAIL E RROR
	8899	"RTN","RCC PCSV1",18, 0)
	8900	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8901	"RTN","RCC PCSV1",19, 0)
	8902	.; PRCA4 .5313 - C lean up va riables
	8903	"RTN","RCC PCSV1",20, 0)
	8904	.N KEY,DE B,ERROR,RC X,RCX1,ERR ,LN
	8905	"RTN","RCC PCSV1",21, 0)
	8906	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECOR
	8907	D" D ERRMS G Q
	8908	"RTN","RCC PCSV1",22, 0)
	8909	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ," ",""),K EY=$E(KEY, $F(KEY,$$
	8910	SITE^RCMSI TE),999)
	8911	"RTN","RCC PCSV1",23, 0)
	8912	.I KEY']" " D KEYERR Q
	8913	"RTN","RCC PCSV1",24, 0)
	8914	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	8915	"RTN","RCC PCSV1",25, 0)
	8916	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	8917	"RTN","RCC PCSV1",26, 0)
	8918	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	8919	"RTN","RCC PCSV1",27, 0)
	8920	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	8921	"RTN","RCC PCSV1",28, 0)
	8922	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	8923	"RTN","RCC PCSV1",29, 0)
	8924	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	8925	"RTN","RCC PCSV1",30, 0)
	8926	..S ERR=K EY_" "_ERR (0)_" "_ER R
	8927	"RTN","RCC PCSV1",31, 0)
	8928	..D ERRMS G
	8929	"RTN","RCC PCSV1",32, 0)
	8930	..S ERR=" " D ERRMS G
	8931	"RTN","RCC PCSV1",33, 0)
	8932	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	8933	"RTN","RCC PCSV1",34, 0)
	8934	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	8935	"RTN","RCC PCSV1",35, 0)
	8936	Q
	8937	"RTN","RCC PCSV1",36, 0)
	8938	;
	8939	"RTN","RCC PCSV1",37, 0)
	8940	;
	8941	"RTN","RCC PCSV1",38, 0)
	8942	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	8943	"RTN","RCC PCSV1",39, 0)
	8944	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	8945	"RTN","RCC PCSV1",40, 0)
	8946	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	8947	"RTN","RCC PCSV1",41, 0)
	8948	S ERR=" " D ERRMSG
	8949	"RTN","RCC PCSV1",42, 0)
	8950	Q
	8951	"RTN","RCC PCSV1",43, 0)
	8952	;
	8953	"RTN","RCC PCSV1",44, 0)
	8954	PA ;STATEM ENT ACKNOW LEDGEMENT
	8955	"RTN","RCC PCSV1",45, 0)
	8956	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	8957	"RTN","RCC PCSV1",46, 0)
	8958	Q:$P(RCTR ,"^")'="PA "
	8959	"RTN","RCC PCSV1",47, 0)
	8960	; D CHKTR AN(LABEL)
	8961	"RTN","RCC PCSV1",48, 0)
	8962	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	8963	"RTN","RCC PCSV1",49, 0)
	8964	D CHKTRAN (LABEL)
	8965	"RTN","RCC PCSV1",50, 0)
	8966	S STOT=+$ P(RCTR,"^" ,6)
	8967	"RTN","RCC PCSV1",51, 0)
	8968	S SEQ=+$P (RCTR,"^", 3)
	8969	"RTN","RCC PCSV1",52, 0)
	8970	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8971	"RTN","RCC PCSV1",53, 0)
	8972	.N P
	8973	"RTN","RCC PCSV1",54, 0)
	8974	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8975	"RTN","RCC PCSV1",55, 0)
	8976	.Q:$P(RCT R,"^")'="A D"
	8977	"RTN","RCC PCSV1",56, 0)
	8978	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),99
	8979	9)
	8980	"RTN","RCC PCSV1",57, 0)
	8981	.I KEY']" " D KEYERR Q
	8982	"RTN","RCC PCSV1",58, 0)
	8983	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	8984	"RTN","RCC PCSV1",59, 0)
	8985	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	8986	"RTN","RCC PCSV1",60, 0)
	8987	.I '$G(IE N) D KEYER R Q
	8988	"RTN","RCC PCSV1",61, 0)
	8989	.S DEB=$P ($G(^RCPS( 349.2,IEN, 0)),U)
	8990	"RTN","RCC PCSV1",62, 0)
	8991	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	8992	"RTN","RCC PCSV1",63, 0)
	8993	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	8994	"RTN","RCC PCSV1",64, 0)
	8995	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	8996	"RTN","RCC PCSV1",65, 0)
	8997	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	8998	"RTN","RCC PCSV1",66, 0)
	8999	.;update patient st atement da te in 341 to end pro cess time
	9000	"RTN","RCC PCSV1",67, 0)
	9001	.D OPEN^R CEVDRV1(2, $P(^RCD(34 0,DEB,0),U ),END,DUZ, $$SITE^RCM SITE,.ERR, .EVN,SBAL
	9002	(13)_U_SBA L(14)_U_SB AL(15)_U_S BAL(16)_U_ SBAL(17))
	9003	"RTN","RCC PCSV1",68, 0)
	9004	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,
	9005	DA
	9006	"RTN","RCC PCSV1",69, 0)
	9007	.; PRCA4 .5313 - A dd cross-r eference f or File
	9008	"RTN","RCC PCSV1",70, 0)
	9009	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	9010	"RTN","RCC PCSV1",71, 0)
	9011	. .S DA=+ EVN,DIK="^ RC(341," D IX1^DIK
	9012	"RTN","RCC PCSV1",72, 0)
	9013	.;update bill file 430 letter fields
	9014	"RTN","RCC PCSV1",73, 0)
	9015	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	9016	"RTN","RCC PCSV1",74, 0)
	9017	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	9018	"RTN","RCC PCSV1",75, 0)
	9019	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	9020	"RTN","RCC PCSV1",76, 0)
	9021	..S LET=$ G(^PRCA(43 0,BN,6))
	9022	"RTN","RCC PCSV1",77, 0)
	9023	..I $P(LE T,"^",21)> END Q
	9024	"RTN","RCC PCSV1",78, 0)
	9025	..S END=$ G(SDAT)
	9026	"RTN","RCC PCSV1",79, 0)
	9027	..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=
	9028	3:63,1:68) _"////^S X ="_END_";6 8.1////^S X="_END D ^DIE Q
	9029	"RTN","RCC PCSV1",80, 0)
	9030	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	9031	"RTN","RCC PCSV1",81, 0)
	9032	.S ^RCPS( 349.2,+IEN ,6)=1
	9033	"RTN","RCC PCSV1",82, 0)
	9034	PAMAIL ;
	9035	"RTN","RCC PCSV1",83, 0)
	9036	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	9037	"RTN","RCC PCSV1",84, 0)
	9038	; PRCA4. 5313 - Ch ange to CB SS
	9039	"RTN","RCC PCSV1",85, 0)
	9040	S XMSUB=" Patient Ac knowledgem ents recei ved from C BSS."
	9041	"RTN","RCC PCSV1",86, 0)
	9042	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	9043	"RTN","RCC PCSV1",87, 0)
	9044	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	9045	"RTN","RCC PCSV1",88, 0)
	9046	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	9047	"RTN","RCC PCSV1",89, 0)
	9048	S MSG(2)= "Patient a cknowledge ment messa ge "_$G(XM Z)_" recei ved."
	9049	"RTN","RCC PCSV1",90, 0)
	9050	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s stateme
	9051	nt period. "
	9052	"RTN","RCC PCSV1",91, 0)
	9053	D ^XMD
	9054	"RTN","RCC PCSV1",92, 0)
	9055	Q
	9056	"RTN","RCC PCSV1",93, 0)
	9057	;
	9058	"RTN","RCC PCSV1",94, 0)
	9059	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	9060	"RTN","RCC PCSV1",95, 0)
	9061	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	9062	"RTN","RCC PCSV1",96, 0)
	9063	Q:$G(LABE L)']""
	9064	"RTN","RCC PCSV1",97, 0)
	9065	N PSIEN,D A,DIK,DO,D IC,X
	9066	"RTN","RCC PCSV1",98, 0)
	9067	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	9068	"RTN","RCC PCSV1",99, 0)
	9069	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	9070	"RTN","RCC PCSV1",100 ,0)
	9071	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	9072	"RTN","RCC PCSV1",101 ,0)
	9073	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	9074	"RTN","RCC PCSV1",102 ,0)
	9075	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	9076	"RTN","RCC PCSV1",103 ,0)
	9077	. S DA(1) =LABEL(1), DIC(0)="L"
	9078	"RTN","RCC PCSV1",104 ,0)
	9079	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.0
	9080	4////"_SDA T
	9081	"RTN","RCC PCSV1",105 ,0)
	9082	. D FILE^ DICN
	9083	"RTN","RCC PCSV1",106 ,0)
	9084	Q
	9085	"RTN","RCC PCSV1",107 ,0)
	9086	;
	9087	"RTN","RCC PCSV1",108 ,0)
	9088	TRANCHK ;C heck for c omplete AC K transmis sion
	9089	"RTN","RCC PCSV1",109 ,0)
	9090	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bu
	9091	ild and tr ansmit.
	9092	"RTN","RCC PCSV1",110 ,0)
	9093	N X,Y,DAT E,SDT,I,X1 ,X2
	9094	"RTN","RCC PCSV1",111 ,0)
	9095	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
	9096	"RTN","RCC PCSV1",112 ,0)
	9097	Q
	9098	"RTN","RCC PCSV1",113 ,0)
	9099	;
	9100	"RTN","RCC PCSV1",114 ,0)
	9101	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	9102	"RTN","RCC PCSV1",115 ,0)
	9103	N MSG,RCT ,SEG,SEQ,C NT,IEN,XMD UZ,XMSUB,X MTEXT,XMY
	9104	"RTN","RCC PCSV1",116 ,0)
	9105	F RCT=3,4 S CNT=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I CNT'= "" D
	9106	"RTN","RCC PCSV1",117 ,0)
	9107	.S IEN=$O (^RCT(349. 1,RCT,4,"S TDT4",SDT, CNT,0)) D
	9108	"RTN","RCC PCSV1",118 ,0)
	9109	..I IEN'= "",$P($G(^ RCT(349.1, +RCT,4,IEN ,0)),"^")' =$P($G(^RC T(349.1,+R CT,4,IEN,
	9110	0)),"^",2) D TRANSEN D
	9111	"RTN","RCC PCSV1",119 ,0)
	9112	Q
	9113	"RTN","RCC PCSV1",120 ,0)
	9114	;
	9115	"RTN","RCC PCSV1",121 ,0)
	9116	TRANSEND ; PRCA4.5 313 Send Transmissi on
	9117	"RTN","RCC PCSV1",122 ,0)
	9118	S XMDUZ=" AR PACKAGE "
	9119	"RTN","RCC PCSV1",123 ,0)
	9120	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9121	"RTN","RCC PCSV1",124 ,0)
	9122	S XMSUB=" CBSS ACKNO WLEDGEMENT TRANSMISS ION(S) INC OMPLETE"
	9123	"RTN","RCC PCSV1",125 ,0)
	9124	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= "" E S X
	9125	MY(.5)=""
	9126	"RTN","RCC PCSV1",126 ,0)
	9127	S XMTEXT= "MSG("
	9128	"RTN","RCC PCSV1",127 ,0)
	9129	S SEG=$S( RCT=3:"IS" ,1:"PA")
	9130	"RTN","RCC PCSV1",128 ,0)
	9131	S SEG(1)= $P(^RCT(34 9.1,+RCT,4 ,IEN,0),"^ ",2)
	9132	"RTN","RCC PCSV1",129 ,0)
	9133	; PRCA4. 5313 - Ad d line ide ntifying P atient Sta tement Dat e that err ored
	9134	"RTN","RCC PCSV1",130 ,0)
	9135	S MSG(2)= "For Patie nt Stateme nt Date of "_DATE_". "
	9136	"RTN","RCC PCSV1",131 ,0)
	9137	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9138	"RTN","RCC PCSV1",132 ,0)
	9139	S MSG(3)= "The last "_SEG_" se gment mess age receiv ed from CB SS was num bered "_S
	9140	EG(1)_"."
	9141	"RTN","RCC PCSV1",133 ,0)
	9142	S MSG(4)= "This was not labele d the fina l message in that se gment type transmis
	9143	sion."
	9144	"RTN","RCC PCSV1",134 ,0)
	9145	S MSG(5)= "This may cause pati ent statem ent inform ation to b e missing. "
	9146	"RTN","RCC PCSV1",135 ,0)
	9147	S MSG(6)= "The last message nu mber recei ved was "_ $P($G(^RCT (349.1,RCT ,4,IEN,0)
	9148	),"^",3)_" ."
	9149	"RTN","RCC PCSV1",136 ,0)
	9150	; PRCA4 .5313 - C hange CCPC to CBSS
	9151	"RTN","RCC PCSV1",137 ,0)
	9152	S MSG(7)= "Please co ntact the CBSS in Au stin."
	9153	"RTN","RCC PCSV1",138 ,0)
	9154	D ^XMD
	9155	"RTN","RCC PCSV1",139 ,0)
	9156	Q
	9157	"RTN","RCC PCSV1",140 ,0)
	9158	;
	9159	"RTN","RCC PCSV1",141 ,0)
	9160	;
	9161	"RTN","RCC PCSV1",142 ,0)
	9162	IT ;INVALI D TRANSMIS SION
	9163	"RTN","RCC PCSV1",143 ,0)
	9164	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	9165	"RTN","RCC PCSV1",144 ,0)
	9166	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	9167	"RTN","RCC PCSV1",145 ,0)
	9168	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	9169	"RTN","RCC PCSV1",146 ,0)
	9170	; PRCA4. 5313 - Ad d statemen t date to error mess age
	9171	"RTN","RCC PCSV1",147 ,0)
	9172	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	9173	"RTN","RCC PCSV1",148 ,0)
	9174	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	9175	"RTN","RCC PCSV1",149 ,0)
	9176	S ERR=" " D ERRMSG
	9177	"RTN","RCC PCSV1",150 ,0)
	9178	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9179	"RTN","RCC PCSV1",151 ,0)
	9180	.S MSG=^T MP($J,"MSG ",RCMSG)
	9181	"RTN","RCC PCSV1",152 ,0)
	9182	.S MSG=$P (MSG,"^",8 )
	9183	"RTN","RCC PCSV1",153 ,0)
	9184	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	9185	"RTN","RCC PCSV1",154 ,0)
	9186	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	9187	"RTN","RCC PCSV1",155 ,0)
	9188	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	9189	"RTN","RCC PCSV1",156 ,0)
	9190	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	9191	"RTN","RCC PCSV1",157 ,0)
	9192	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	9193	"RTN","RCC PCSV1",158 ,0)
	9194	..D ERRMS G
	9195	"RTN","RCC PCSV1",159 ,0)
	9196	S ERR=" " D ERRMSG
	9197	"RTN","RCC PCSV1",160 ,0)
	9198	S ERR="Pl ease conta ct IRM."
	9199	"RTN","RCC PCSV1",161 ,0)
	9200	D ERRMSG
	9201	"RTN","RCC PCSV1",162 ,0)
	9202	Q
	9203	"RTN","RCC PCSV1",163 ,0)
	9204	;
	9205	"RTN","RCC PCSV1",164 ,0)
	9206	ERRMSG ;ER ROR MESSAG E
	9207	"RTN","RCC PCSV1",165 ,0)
	9208	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	9209	"RTN","RCC PCSV1",166 ,0)
	9210	Q
	9211	"RTN","RCC PCT")
	9212	0^15^B2933 0001^B2489 697
	9213	"RTN","RCC PCT",1,0)
	9214	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/9
	9215	6 10:53 A M
	9216	"RTN","RCC PCT",2,0)
	9217	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 130
	9218	"RTN","RCC PCT",3,0)
	9219	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9220	"RTN","RCC PCT",4,0)
	9221	EN ;
	9222	"RTN","RCC PCT",5,0)
	9223	D GO
	9224	"RTN","RCC PCT",6,0)
	9225	K TDT,TDT 1,TDT2,TDT 3,DATE,PTO T,TTOT,L,X ,Y,Y1,Y2,D ,IEN,POP,Q ,%,%DT,%ZI S,%Y,FIRS
	9226	T,LAST
	9227	"RTN","RCC PCT",7,0)
	9228	Q
	9229	"RTN","RCC PCT",8,0)
	9230	GO ;
	9231	"RTN","RCC PCT",9,0)
	9232	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS a
	9233	nd the"
	9234	"RTN","RCC PCT",10,0)
	9235	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	9236	"RTN","RCC PCT",11,0)
	9237	W !,"form ats availa ble."
	9238	"RTN","RCC PCT",12,0)
	9239	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	9240	"RTN","RCC PCT",13,0)
	9241	W !,"Date s."
	9242	"RTN","RCC PCT",14,0)
	9243	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith total
	9244	s"
	9245	"RTN","RCC PCT",15,0)
	9246	W !,"and a summary total at t he end."
	9247	"RTN","RCC PCT",16,0)
	9248	W !!,"The third for mat is pri nting the totals for a single Statement Date sele
	9249	cted.",!
	9250	"RTN","RCC PCT",17,0)
	9251	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9252	"RTN","RCC PCT",18,0)
	9253	S DIR(0)= "E" D ^DIR
	9254	"RTN","RCC PCT",19,0)
	9255	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9256	"RTN","RCC PCT",20,0)
	9257	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	9258	"RTN","RCC PCT",21,0)
	9259	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Total
	9260	s Report:" ,!
	9261	"RTN","RCC PCT",22,0)
	9262	S (TDT1,F IRST,LAST) ="" F S T DT1=$O(TDT (TDT1)) Q: TDT1="" D
	9263	"RTN","RCC PCT",23,0)
	9264	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(T
	9265	DT3)
	9266	"RTN","RCC PCT",24,0)
	9267	.I TDT3<F IRST S FIR ST=TDT3
	9268	"RTN","RCC PCT",25,0)
	9269	.I TDT3>L AST S LAST =TDT3
	9270	"RTN","RCC PCT",26,0)
	9271	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9272	"RTN","RCC PCT",27,0)
	9273	S DIR(0)= "YAO"
	9274	"RTN","RCC PCT",28,0)
	9275	S DIR("B" )="Y"
	9276	"RTN","RCC PCT",29,0)
	9277	S DIR("A" )="Do you want to pr int a sing le total f or ALL the available dates? "
	9278	"RTN","RCC PCT",30,0)
	9279	D ^DIR
	9280	"RTN","RCC PCT",31,0)
	9281	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9282	"RTN","RCC PCT",32,0)
	9283	I Y=1 D Q
	9284	"RTN","RCC PCT",33,0)
	9285	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9286	"RTN","RCC PCT",34,0)
	9287	.I $D(IO( "Q")) D Q
	9288	"RTN","RCC PCT",35,0)
	9289	..S Q=1
	9290	"RTN","RCC PCT",36,0)
	9291	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	9292	"RTN","RCC PCT",37,0)
	9293	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9294	"RTN","RCC PCT",38,0)
	9295	..D ^%ZTL OAD
	9296	"RTN","RCC PCT",39,0)
	9297	..K ZTRTN ,ZTDESC,ZT SAVE
	9298	"RTN","RCC PCT",40,0)
	9299	.E D STA RTS Q
	9300	"RTN","RCC PCT",41,0)
	9301	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9302	"RTN","RCC PCT",42,0)
	9303	S DIR(0)= "YAO"
	9304	"RTN","RCC PCT",43,0)
	9305	S DIR("B" )="Y"
	9306	"RTN","RCC PCT",44,0)
	9307	S DIR("A" )="Do you want to pr int separa te totals for ALL th e availabl e dates?
	9308	"
	9309	"RTN","RCC PCT",45,0)
	9310	D ^DIR
	9311	"RTN","RCC PCT",46,0)
	9312	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9313	"RTN","RCC PCT",47,0)
	9314	I Y=1 D Q
	9315	"RTN","RCC PCT",48,0)
	9316	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9317	"RTN","RCC PCT",49,0)
	9318	.I $D(IO( "Q")) D Q
	9319	"RTN","RCC PCT",50,0)
	9320	..S Q=1
	9321	"RTN","RCC PCT",51,0)
	9322	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9323	"RTN","RCC PCT",52,0)
	9324	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9325	"RTN","RCC PCT",53,0)
	9326	..D ^%ZTL OAD
	9327	"RTN","RCC PCT",54,0)
	9328	..K ZTRTN ,ZTDESC,ZT SAVE
	9329	"RTN","RCC PCT",55,0)
	9330	.E D STA RT Q
	9331	"RTN","RCC PCT",56,0)
	9332	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9333	"RTN","RCC PCT",57,0)
	9334	S DIR(0)= "DAO^"_FIR ST_":"_LAS T_":EX^K:' $D(TDT(+$E (Y,6,7))) X"
	9335	"RTN","RCC PCT",58,0)
	9336	S DIR("A" )="Enter a single Pa tient Stat ement date from list above: "
	9337	"RTN","RCC PCT",59,0)
	9338	S DIR("?" )="Enter a single Pa tient Stat ement date from list above or ^ to exit
	9339	."
	9340	"RTN","RCC PCT",60,0)
	9341	D ^DIR
	9342	"RTN","RCC PCT",61,0)
	9343	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9344	"RTN","RCC PCT",62,0)
	9345	S Y1=+$E( Y,6,7),Y2= Y
	9346	"RTN","RCC PCT",63,0)
	9347	;I '$D(TD T(Y1)) W ! ,"There ar e no recor ds for tha t date." Q
	9348	"RTN","RCC PCT",64,0)
	9349	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	9350	"RTN","RCC PCT",65,0)
	9351	I $D(IO(" Q")) D Q
	9352	"RTN","RCC PCT",66,0)
	9353	.S Q=1
	9354	"RTN","RCC PCT",67,0)
	9355	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9356	"RTN","RCC PCT",68,0)
	9357	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	9358	"RTN","RCC PCT",69,0)
	9359	.D ^%ZTLO AD
	9360	"RTN","RCC PCT",70,0)
	9361	.K ZTRTN, ZTDESC,ZTS AVE
	9362	"RTN","RCC PCT",71,0)
	9363	START1 ;Th is will pr int a summ ary total for a sing le date
	9364	"RTN","RCC PCT",72,0)
	9365	N PTOT,TT OT,X,D
	9366	"RTN","RCC PCT",73,0)
	9367	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9368	"RTN","RCC PCT",74,0)
	9369	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
	9370	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9371	"RTN","RCC PCT",75,0)
	9372	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6))
	9373	S PTOT=PTO T+1
	9374	"RTN","RCC PCT",76,0)
	9375	I IOST?1" C".E W @IO F
	9376	"RTN","RCC PCT",77,0)
	9377	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	9378	"RTN","RCC PCT",78,0)
	9379	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9380	"RTN","RCC PCT",79,0)
	9381	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9382	"RTN","RCC PCT",80,0)
	9383	W !,"==== ========== ========== ======="
	9384	"RTN","RCC PCT",81,0)
	9385	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9386	"RTN","RCC PCT",82,0)
	9387	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9388	"RTN","RCC PCT",83,0)
	9389	Q
	9390	"RTN","RCC PCT",84,0)
	9391	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	9392	"RTN","RCC PCT",85,0)
	9393	N PTOT,TT OT,X,X1,DA TE
	9394	"RTN","RCC PCT",86,0)
	9395	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9396	"RTN","RCC PCT",87,0)
	9397	S (TTOT,P TOT,X,X1)= 0 S DATE=" "
	9398	"RTN","RCC PCT",88,0)
	9399	U IO S (T DT1,TDT2)= ""
	9400	"RTN","RCC PCT",89,0)
	9401	I IOST?1" C".E W @IO F
	9402	"RTN","RCC PCT",90,0)
	9403	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D I $D(DTOUT) !$D(DUOUT) !$D(DIRUT) !$D(DIROU
	9404	T) Q
	9405	"RTN","RCC PCT",91,0)
	9406	.I X="^" Q
	9407	"RTN","RCC PCT",92,0)
	9408	.S TTOT=0
	9409	"RTN","RCC PCT",93,0)
	9410	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	9411	"RTN","RCC PCT",94,0)
	9412	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	9413	"RTN","RCC PCT",95,0)
	9414	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	9415	"RTN","RCC PCT",96,0)
	9416	..S X=Y D ^%DT
	9417	"RTN","RCC PCT",97,0)
	9418	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	9419	"RTN","RCC PCT",98,0)
	9420	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X
	9421	1)) Q:'X1 I $G(^RCP S(349.2,X1 ,6)) S PTO T=PTOT+1
	9422	"RTN","RCC PCT",99,0)
	9423	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	9424	"RTN","RCC PCT",100,0 )
	9425	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	9426	"RTN","RCC PCT",101,0 )
	9427	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	9428	"RTN","RCC PCT",102,0 )
	9429	.W !,"=== ========== ========== ========"
	9430	"RTN","RCC PCT",103,0 )
	9431	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	9432	"RTN","RCC PCT",104,0 )
	9433	.I '$D(Q) I $Y+4>IO SL D
	9434	"RTN","RCC PCT",105,0 )
	9435	..S DIR(0 )="E" D ^D IR I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	9436	Subj: PRCA 4.5313 T EST v14 [ #86963784] Page 2
	9437	---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
	9438	"RTN","RCC PCT",106,0 )
	9439	..W @IOF
	9440	"RTN","RCC PCT",107,0 )
	9441	I X="^" Q
	9442	"RTN","RCC PCT",108,0 )
	9443	W !!!," ****** ****** ****** ****** ******** *"
	9444	"RTN","RCC PCT",109,0 )
	9445	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	9446	"RTN","RCC PCT",110,0 )
	9447	N DATE,PT OT,TTOT,X, D
	9448	"RTN","RCC PCT",111,0 )
	9449	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9450	"RTN","RCC PCT",112,0 )
	9451	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
	9452	)) Q:X="" I $D(^RCT (349,X,0)) S TTOT=$P (^RCT(349, X,0),"^",7 )+TTOT
	9453	"RTN","RCC PCT",113,0 )
	9454	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	9455	"RTN","RCC PCT",114,0 )
	9456	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	9457	"RTN","RCC PCT",115,0 )
	9458	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9459	"RTN","RCC PCT",116,0 )
	9460	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9461	"RTN","RCC PCT",117,0 )
	9462	W !,"==== ========== ========== ======="
	9463	"RTN","RCC PCT",118,0 )
	9464	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9465	"RTN","RCC PCT",119,0 )
	9466	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9467	"RTN","RCD PBTLM")
	9468	0^26^B5588 5939^B4947 6140
	9469	"RTN","RCD PBTLM",1,0 )
	9470	RCDPBTLM ; WISC/RFJ - bill tran sactions L ist Manage r top rout ine ;1 Jun 99
	9471	"RTN","RCD PBTLM",2,0 )
	9472	;;4.5;Acc ounts Rece ivable;1 14,148,153 ,168,169,1 98,247,271 ,276,313 ;Mar 20,
	9473	1995;Build 130
	9474	"RTN","RCD PBTLM",3,0 )
	9475	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	9476	"RTN","RCD PBTLM",4,0 )
	9477	;
	9478	"RTN","RCD PBTLM",5,0 )
	9479	; Referen ce to $$RE C^IBRFN su pported by DBIA 2031
	9480	"RTN","RCD PBTLM",6,0 )
	9481	;
	9482	"RTN","RCD PBTLM",7,0 )
	9483	; called from menu option (1 9)
	9484	"RTN","RCD PBTLM",8,0 )
	9485	;
	9486	"RTN","RCD PBTLM",9,0 )
	9487	N RCBILLD A,RCDPFXIT
	9488	"RTN","RCD PBTLM",10, 0)
	9489	;
	9490	"RTN","RCD PBTLM",11, 0)
	9491	F D Q:' RCBILLDA
	9492	"RTN","RCD PBTLM",12, 0)
	9493	. W !! S RCBILLDA =$$SELBILL
	9494	"RTN","RCD PBTLM",13, 0)
	9495	. I RCB ILLDA<1 S RCBILLDA=0 Q
	9496	"RTN","RCD PBTLM",14, 0)
	9497	. D EN^ VALM("RCDP TRANSACTI ONS LIST")
	9498	"RTN","RCD PBTLM",15, 0)
	9499	. ; fa st exit
	9500	"RTN","RCD PBTLM",16, 0)
	9501	. I $G( RCDPFXIT) S RCBILLDA =0
	9502	"RTN","RCD PBTLM",17, 0)
	9503	Q
	9504	"RTN","RCD PBTLM",18, 0)
	9505	;
	9506	"RTN","RCD PBTLM",19, 0)
	9507	;
	9508	"RTN","RCD PBTLM",20, 0)
	9509	INIT ; in itializati on for lis t manager list
	9510	"RTN","RCD PBTLM",21, 0)
	9511	; requir es rcbilld a
	9512	"RTN","RCD PBTLM",22, 0)
	9513	N ADMIN,D ATE,RCLINE ,RCLIST,RC TOTAL,RCTR AN,RCTRAND A
	9514	"RTN","RCD PBTLM",23, 0)
	9515	K ^TMP("R CDPBTLM",$ J),^TMP("V ALM VIDEO" ,$J)
	9516	"RTN","RCD PBTLM",24, 0)
	9517	;
	9518	"RTN","RCD PBTLM",25, 0)
	9519	; fast e xit
	9520	"RTN","RCD PBTLM",26, 0)
	9521	I $G(RCDP FXIT) S VA LMQUIT=1 Q
	9522	"RTN","RCD PBTLM",27, 0)
	9523	;
	9524	"RTN","RCD PBTLM",28, 0)
	9525	; set th e List Man ager line number
	9526	"RTN","RCD PBTLM",29, 0)
	9527	S RCLINE= 0
	9528	"RTN","RCD PBTLM",30, 0)
	9529	; set th e List Man ager trans action num ber
	9530	"RTN","RCD PBTLM",31, 0)
	9531	S RCTRAN= 0
	9532	"RTN","RCD PBTLM",32, 0)
	9533	;
	9534	"RTN","RCD PBTLM",33, 0)
	9535	; get tr ansactions and balan ce for bil l
	9536	"RTN","RCD PBTLM",34, 0)
	9537	S RCTOTAL =$$GETTRAN S(RCBILLDA )
	9538	"RTN","RCD PBTLM",35, 0)
	9539	;
	9540	"RTN","RCD PBTLM",36, 0)
	9541	S DATE="" F S DATE =$O(RCLIST (DATE)) Q: 'DATE D
	9542	"RTN","RCD PBTLM",37, 0)
	9543	. S RCT RANDA="" F S RCTRAN DA=$O(RCLI ST(DATE,RC TRANDA)) Q :RCTRANDA= "" D
	9544	"RTN","RCD PBTLM",38, 0)
	9545	. . S RCLINE=RC LINE+1
	9546	"RTN","RCD PBTLM",39, 0)
	9547	. . ;
	9548	"RTN","RCD PBTLM",40, 0)
	9549	. . ; create a n index ar ray for tr ansaction lookup in list
	9550	"RTN","RCD PBTLM",41, 0)
	9551	. . I RCTRANDA D
	9552	"RTN","RCD PBTLM",42, 0)
	9553	. . . S RCTRA N=RCTRAN+1
	9554	"RTN","RCD PBTLM",43, 0)
	9555	. . . S ^TMP( "RCDPBTLM" ,$J,"IDX", RCTRAN,RCT RAN)=RCTRA NDA
	9556	"RTN","RCD PBTLM",44, 0)
	9557	. . . D SET^R CDPAPLI(RC TRAN,RCLIN E,1,80,0,I ORVON,IORV OFF)
	9558	"RTN","RCD PBTLM",45, 0)
	9559	. . ;
	9560	"RTN","RCD PBTLM",46, 0)
	9561	. . D SET^RCDPA PLI($S(RCT RANDA:RCTR ANDA,1:" " ),RCLINE,4 ,80)
	9562	"RTN","RCD PBTLM",47, 0)
	9563	. . D SET^RCDPA PLI($E(DAT E,4,5)_"/" _$E(DATE,6 ,7)_"/"_$E (DATE,2,3) ,RCLINE,1
	9564	3,21)
	9565	"RTN","RCD PBTLM",48, 0)
	9566	. . D SET^RCDPA PLI($TR($P (RCLIST(DA TE,RCTRAND A),"^"),"A BCDEFGHIJK LMNOPQRST
	9567	UVWXYZ","a bcdefghijk lmnopqrstu vwxyz"),RC LINE,25,50 )
	9568	"RTN","RCD PBTLM",49, 0)
	9569	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",2),9 ,2),RCLINE ,53,62)
	9570	"RTN","RCD PBTLM",50, 0)
	9571	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),"^",3),9 ,2),RCLINE ,62,71)
	9572	"RTN","RCD PBTLM",51, 0)
	9573	. . ; add mars hal fee an d court co st to crea te admin d ollars
	9574	"RTN","RCD PBTLM",52, 0)
	9575	. . S ADMIN=$P( RCLIST(DAT E,RCTRANDA ),"^",4)+$ P(RCLIST(D ATE,RCTRAN DA),"^",5
	9576	)+$P(RCLIS T(DATE,RCT RANDA),"^" ,6)
	9577	"RTN","RCD PBTLM",53, 0)
	9578	. . D SET^RCDPA PLI($J(ADM IN,9,2),RC LINE,71,80 )
	9579	"RTN","RCD PBTLM",54, 0)
	9580	;
	9581	"RTN","RCD PBTLM",55, 0)
	9582	; show t otals
	9583	"RTN","RCD PBTLM",56, 0)
	9584	S RCLINE= RCLINE+1
	9585	"RTN","RCD PBTLM",57, 0)
	9586	D SET^RCD PAPLI(" - --------
	9587	-------- - -------",R CLINE,1,80 )
	9588	"RTN","RCD PBTLM",58, 0)
	9589	S RCLINE= RCLINE+1
	9590	"RTN","RCD PBTLM",59, 0)
	9591	D SET^RCD PAPLI(" TOTAL BALA NCE FOR BI LL",RCLINE ,1,80)
	9592	"RTN","RCD PBTLM",60, 0)
	9593	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",1),9,2 ),RCLINE,5 3,62)
	9594	"RTN","RCD PBTLM",61, 0)
	9595	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",2),9,2 ),RCLINE,6 2,71)
	9596	"RTN","RCD PBTLM",62, 0)
	9597	D SET^RCD PAPLI($J($ P(RCTOTAL, "^",3)+$P( RCTOTAL,"^ ",4)+$P(RC TOTAL,"^", 5),9,2),R
	9598	CLINE,71,8 0)
	9599	"RTN","RCD PBTLM",63, 0)
	9600	;
	9601	"RTN","RCD PBTLM",64, 0)
	9602	; compar e totals t o what is stored in the file
	9603	"RTN","RCD PBTLM",65, 0)
	9604	N RCDATA7 ,RCFOUT
	9605	"RTN","RCD PBTLM",66, 0)
	9606	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	9607	"RTN","RCD PBTLM",67, 0)
	9608	; for a write-off bill, the balance sh ould equal all zeros , for
	9609	"RTN","RCD PBTLM",68, 0)
	9610	; these bills, nod e 7 is the write-off amount, s o for the out of
	9611	"RTN","RCD PBTLM",69, 0)
	9612	; balanc e check to work, nod e 7 needs to be adju sted to al l zeros
	9613	"RTN","RCD PBTLM",70, 0)
	9614	I $P(^PRC A(430,RCBI LLDA,0),"^ ",8)=23 S RCDATA7="0 ^0^0^0^0"
	9615	"RTN","RCD PBTLM",71, 0)
	9616	I +$P(RCD ATA7,"^",1 )'=+$P(RCT OTAL,"^",1 ) S RCFOUT =1
	9617	"RTN","RCD PBTLM",72, 0)
	9618	I +$P(RCD ATA7,"^",2 )'=+$P(RCT OTAL,"^",2 ) S RCFOUT =1
	9619	"RTN","RCD PBTLM",73, 0)
	9620	I ($P(RCD ATA7,"^",3 )+$P(RCDAT A7,"^",4)+ $P(RCDATA7 ,"^",5))'= +$P(RCTOTA L,"^",3)
	9621	S RCFOUT=1
	9622	"RTN","RCD PBTLM",74, 0)
	9623	I $G(RCFO UT) D
	9624	"RTN","RCD PBTLM",75, 0)
	9625	. S RCL INE=RCLINE +1
	9626	"RTN","RCD PBTLM",76, 0)
	9627	. D SET ^RCDPAPLI( " ",RCLINE ,1,80)
	9628	"RTN","RCD PBTLM",77, 0)
	9629	. S RCL INE=RCLINE +1
	9630	"RTN","RCD PBTLM",78, 0)
	9631	. D SET ^RCDPAPLI( " STORED BALANCE FO R BILL ( INCORRECT )",RCLI NE,1,80)
	9632	"RTN","RCD PBTLM",79, 0)
	9633	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",1) ,9,2),RCLI NE,53,62)
	9634	"RTN","RCD PBTLM",80, 0)
	9635	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",2) ,9,2),RCLI NE,62,71)
	9636	"RTN","RCD PBTLM",81, 0)
	9637	. D SET ^RCDPAPLI( $J($P(RCDA TA7,"^",3) +$P(RCDATA 7,"^",4)+$ P(RCDATA7, "^",5),9,
	9638	2),RCLINE, 71,80)
	9639	"RTN","RCD PBTLM",82, 0)
	9640	;
	9641	"RTN","RCD PBTLM",83, 0)
	9642	; set va lmcnt to n umber of l ines in th e list
	9643	"RTN","RCD PBTLM",84, 0)
	9644	S VALMCNT =RCLINE
	9645	"RTN","RCD PBTLM",85, 0)
	9646	D HDR
	9647	"RTN","RCD PBTLM",86, 0)
	9648	Q
	9649	"RTN","RCD PBTLM",87, 0)
	9650	;
	9651	"RTN","RCD PBTLM",88, 0)
	9652	;
	9653	"RTN","RCD PBTLM",89, 0)
	9654	HDR ; hea der code f or list ma nager disp lay
	9655	"RTN","RCD PBTLM",90, 0)
	9656	; requir es rcbilld a
	9657	"RTN","RCD PBTLM",91, 0)
	9658	N %,DATA, RCDEBTDA,R CDPDATA
	9659	"RTN","RCD PBTLM",92, 0)
	9660	;
	9661	"RTN","RCD PBTLM",93, 0)
	9662	D DIQ430^ RCDPBPLM(R CBILLDA,". 01;8;")
	9663	"RTN","RCD PBTLM",94, 0)
	9664	;
	9665	"RTN","RCD PBTLM",95, 0)
	9666	S RCDEBTD A=$P(^PRCA (430,RCBIL LDA,0),"^" ,9)
	9667	"RTN","RCD PBTLM",96, 0)
	9668	S DATA=$$ ACCNTHDR^R CDPAPLM(RC DEBTDA)
	9669	"RTN","RCD PBTLM",97, 0)
	9670	;
	9671	"RTN","RCD PBTLM",98, 0)
	9672	S %="",$P (%," ",80) =""
	9673	"RTN","RCD PBTLM",99, 0)
	9674	; PRCA4. 5276 - ge t EEOB ind icator for 1st/3rd p arty payme nt and att ach to bi
	9675	ll when ap plicable
	9676	"RTN","RCD PBTLM",100 ,0)
	9677	S PRCOUT= $$COMP3^PR CAAPR(RCBI LLDA)
	9678	"RTN","RCD PBTLM",101 ,0)
	9679	I PRCOUT' ="%" S PRC OUT=$$IBEE OBCK^PRCAA PR1(RCBILL DA)
	9680	"RTN","RCD PBTLM",102 ,0)
	9681	S VALMHDR (1)=$E("Bi ll #: "_$G (PRCOUT)_$ G(RCDPDATA (430,RCBIL LDA,.01,"E "))_%,1,2
	9682	5)_"Accoun t: "_$P(DA TA,"^")_$P (DATA,"^", 2)
	9683	"RTN","RCD PBTLM",103 ,0)
	9684	S VALMHDR (2)=$E("St atus: "_$G (RCDPDATA( 430,RCBILL DA,8,"E")) _%,1,25)_$ E(" Add
	9685	r: "_$P(DA TA,"^",4)_ ", "_$P(DA TA,"^",7)_ ", "_$P(DA TA,"^",8)_ " "_$P(DA TA,"^",9)
	9686	_%,1,55)
	9687	"RTN","RCD PBTLM",104 ,0)
	9688	; PRCA4. 5276 - sh ow caption for user
	9689	"RTN","RCD PBTLM",105 ,0)
	9690	S VALMSG= "\|% EEOB \| Enter ?? for more a ctions \|" ; PRCA4.5 276
	9691	"RTN","RCD PBTLM",106 ,0)
	9692	Q
	9693	"RTN","RCD PBTLM",107 ,0)
	9694	S VALMHDR (3)=" "_I ORVON_$E(" Bill Balan ce: "_$J($ P(RCTOTAL, "^")+$P(RC TOTAL,"^"
	9695	,2)+$P(RCT OTAL,"^",3 )+$P(RCTOT AL,"^",4)+ $P(RCTOTAL ,"^",5),0, 2)_%,1,23) _IORVOFF_
	9696	" Phone: "_$P(DATA, "^",10)
	9697	"RTN","RCD PBTLM",108 ,0)
	9698	Q
	9699	"RTN","RCD PBTLM",109 ,0)
	9700	;
	9701	"RTN","RCD PBTLM",110 ,0)
	9702	;
	9703	"RTN","RCD PBTLM",111 ,0)
	9704	EXIT ; ex it list ma nager opti on and cle an up
	9705	"RTN","RCD PBTLM",112 ,0)
	9706	K ^TMP("R CDPBTLM",$ J),^TMP("R CDPBTLMX", $J)
	9707	"RTN","RCD PBTLM",113 ,0)
	9708	Q
	9709	"RTN","RCD PBTLM",114 ,0)
	9710	;
	9711	"RTN","RCD PBTLM",115 ,0)
	9712	;
	9713	"RTN","RCD PBTLM",116 ,0)
	9714	SELBILL() ; select a bill
	9715	"RTN","RCD PBTLM",117 ,0)
	9716	; return s -1 for t imeout or ^, 0 for n o selectio n, or ien of bill
	9717	"RTN","RCD PBTLM",118 ,0)
	9718	N %,%Y,C, DIC,DTOUT, DUOUT,RCBE FLUP,X,Y
	9719	"RTN","RCD PBTLM",119 ,0)
	9720	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	9721	"RTN","RCD PBTLM",120 ,0)
	9722	N RCY,DIR ,DIRUT
	9723	"RTN","RCD PBTLM",121 ,0)
	9724	; allow u ser to get the recor d using bi ll# or ECM E#
	9725	"RTN","RCD PBTLM",122 ,0)
	9726	S DIR("A" )="Select (B)ILL or (E)CME#: "
	9727	"RTN","RCD PBTLM",123 ,0)
	9728	S DIR(0)= "SA^B:BILL NUMBER;E: ECME#"
	9729	"RTN","RCD PBTLM",124 ,0)
	9730	S DIR("B" )="B"
	9731	"RTN","RCD PBTLM",125 ,0)
	9732	D ^DIR K DIR I $D(D IRUT) Q 0
	9733	"RTN","RCD PBTLM",126 ,0)
	9734	S RCY=Y
	9735	"RTN","RCD PBTLM",127 ,0)
	9736	I RCY="E" Q $$SELEC ME
	9737	"RTN","RCD PBTLM",128 ,0)
	9738	S DIC="^P RCA(430,", DIC(0)="QE AM",DIC("A ")="Select BILL: "
	9739	"RTN","RCD PBTLM",129 ,0)
	9740	S DIC("W" )="D DICW^ RCBEUBI1"
	9741	"RTN","RCD PBTLM",130 ,0)
	9742	; specia l lookup o n input
	9743	"RTN","RCD PBTLM",131 ,0)
	9744	S RCBEFLU P=1
	9745	"RTN","RCD PBTLM",132 ,0)
	9746	D ^DIC
	9747	"RTN","RCD PBTLM",133 ,0)
	9748	I Y<0,'$G (DUOUT),'$ G(DTOUT) S Y=0
	9749	"RTN","RCD PBTLM",134 ,0)
	9750	Q +Y
	9751	"RTN","RCD PBTLM",135 ,0)
	9752	;
	9753	"RTN","RCD PBTLM",136 ,0)
	9754	;
	9755	"RTN","RCD PBTLM",137 ,0)
	9756	GETTRANS(B ILLDA) ; original a mount goes first for bill
	9757	"RTN","RCD PBTLM",138 ,0)
	9758	; return s list of transactio ns in
	9759	"RTN","RCD PBTLM",139 ,0)
	9760	; rclist (date,tran da)=tranty pe ^ princ iple ^ int erest ^ ad min
	9761	"RTN","RCD PBTLM",140 ,0)
	9762	; return s principl e balance ^ interest balance ^ admin bal ance
	9763	"RTN","RCD PBTLM",141 ,0)
	9764	; ^ marshall fee balan ce ^ court cost bala nce
	9765	"RTN","RCD PBTLM",142 ,0)
	9766	N %,ADMBA L,AMTDISP, CCBAL,DATA 0,DATA1,DA TA9,DATE,I NTBAL,MFBA L,PRINBAL, RCDPDATA,
	9767	TRANDA,VAL UE
	9768	"RTN","RCD PBTLM",143 ,0)
	9769	;
	9770	"RTN","RCD PBTLM",144 ,0)
	9771	D DIQ430^ RCDPBPLM(B ILLDA,"3;6 0;")
	9772	"RTN","RCD PBTLM",145 ,0)
	9773	;
	9774	"RTN","RCD PBTLM",146 ,0)
	9775	K RCLIST
	9776	"RTN","RCD PBTLM",147 ,0)
	9777	S (ADMBAL ,CCBAL,INT BAL,MFBAL, PRINBAL)=0
	9778	"RTN","RCD PBTLM",148 ,0)
	9779	S PRINBAL =RCDPDATA( 430,BILLDA ,3,"I")
	9780	"RTN","RCD PBTLM",149 ,0)
	9781	; loop t ransaction and add t o list
	9782	"RTN","RCD PBTLM",150 ,0)
	9783	S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"C" ,BILLDA,TR ANDA)) Q:' TRANDA D
	9784	"RTN","RCD PBTLM",151 ,0)
	9785	. S DATA1 =$G(^PRCA( 433,TRANDA ,1))
	9786	"RTN","RCD PBTLM",152 ,0)
	9787	. S DATE= $P(DATA1," ^",9) I 'D ATE Q
	9788	"RTN","RCD PBTLM",153 ,0)
	9789	. ; Don't include t ransaction s that hav e the INCO MPLETE TRA NSACTION F LAG (#10)
	9790	set to YE S and
	9791	"RTN","RCD PBTLM",154 ,0)
	9792	. ; this transactio n was prev iously use d by the a uto-correc t program to correc
	9793	t an earli er issue. PRCA4.53 13
	9794	"RTN","RCD PBTLM",155 ,0)
	9795	. S DATA0 =$G(^PRCA( 433,TRANDA ,0))
	9796	"RTN","RCD PBTLM",156 ,0)
	9797	. S DATA9 =$G(^PRCA( 433,TRANDA ,9))
	9798	"RTN","RCD PBTLM",157 ,0)
	9799	. ; Check for Incom plete and previously fixed by auto-corre ct
	9800	"RTN","RCD PBTLM",158 ,0)
	9801	. I $P(DA TA0,U,10), ($P(DATA9, U,4)) S VA LUE="" Q
	9802	"RTN","RCD PBTLM",159 ,0)
	9803	. S VALUE =$$TRANVAL U(TRANDA) I VALUE="" Q
	9804	"RTN","RCD PBTLM",160 ,0)
	9805	. S RCLIS T($P(DATE, "."),TRAND A)=$P($G(^ PRCA(430.3 ,+$P(DATA1 ,"^",2),0) ),"^")_VA
	9806	LUE
	9807	"RTN","RCD PBTLM",161 ,0)
	9808	. ;
	9809	"RTN","RCD PBTLM",162 ,0)
	9810	. ; calc ulate bill 's balance
	9811	"RTN","RCD PBTLM",163 ,0)
	9812	. S PRINB AL=PRINBAL +$P(VALUE, "^",2)
	9813	"RTN","RCD PBTLM",164 ,0)
	9814	. S INTBA L=INTBAL+$ P(VALUE,"^ ",3)
	9815	"RTN","RCD PBTLM",165 ,0)
	9816	. S ADMBA L=ADMBAL+$ P(VALUE,"^ ",4)
	9817	"RTN","RCD PBTLM",166 ,0)
	9818	. S MFBAL =MFBAL+$P( VALUE,"^", 5)
	9819	"RTN","RCD PBTLM",167 ,0)
	9820	. S CCBAL =CCBAL+$P( VALUE,"^", 6)
	9821	"RTN","RCD PBTLM",168 ,0)
	9822	;
	9823	"RTN","RCD PBTLM",169 ,0)
	9824	S DATE=$G (RCDPDATA( 430,BILLDA ,60,"I"))
	9825	"RTN","RCD PBTLM",170 ,0)
	9826	; check to make su re activat ion date i s not grea ter than f irst trans action
	9827	"RTN","RCD PBTLM",171 ,0)
	9828	S %=$O(RC LIST(0)) I DATE>% S DATE=%
	9829	"RTN","RCD PBTLM",172 ,0)
	9830	S RCLIST( +$P(DATE," ."),0)="or iginal amo unt^"_RCDP DATA(430,B ILLDA,3,"I ")
	9831	"RTN","RCD PBTLM",173 ,0)
	9832	;
	9833	"RTN","RCD PBTLM",174 ,0)
	9834	Q PRINBAL _"^"_INTBA L_"^"_ADMB AL_"^"_MFB AL_"^"_CCB AL
	9835	"RTN","RCD PBTLM",175 ,0)
	9836	;
	9837	"RTN","RCD PBTLM",176 ,0)
	9838	;
	9839	"RTN","RCD PBTLM",177 ,0)
	9840	TRANVALU(T RANDA) ; return the transacti on value a s displaye d (with + or - sign
	9841	)
	9842	"RTN","RCD PBTLM",178 ,0)
	9843	N TYPE,VA LUE
	9844	"RTN","RCD PBTLM",179 ,0)
	9845	S VALUE=$ $TRANBAL^R CRJRCOT(TR ANDA)
	9846	"RTN","RCD PBTLM",180 ,0)
	9847	; no dol lars on tr ansaction
	9848	"RTN","RCD PBTLM",181 ,0)
	9849	I '$P(VAL UE,"^"),'$ P(VALUE,"^ ",2),'$P(V ALUE,"^",3 ),'$P(VALU E,"^",4),' $P(VALUE,
	9850	"^",5) Q " "
	9851	"RTN","RCD PBTLM",182 ,0)
	9852	; check type for p ayments, e tc, make v alues (-) to subtrac t
	9853	"RTN","RCD PBTLM",183 ,0)
	9854	S TYPE=$P ($G(^PRCA( 433,TRANDA ,1)),"^",2 )
	9855	"RTN","RCD PBTLM",184 ,0)
	9856	I TYPE=2! (TYPE=8)!( TYPE=9)!(T YPE=10)!(T YPE=11)!(T YPE=14)!(T YPE=29)!(T YPE=34)!(
	9857	TYPE=35)!( TYPE=41) D
	9858	"RTN","RCD PBTLM",185 ,0)
	9859	. S $P( VALUE,"^", 1)=-$P(VAL UE,"^",1)
	9860	"RTN","RCD PBTLM",186 ,0)
	9861	. S $P( VALUE,"^", 2)=-$P(VAL UE,"^",2)
	9862	"RTN","RCD PBTLM",187 ,0)
	9863	. S $P( VALUE,"^", 3)=-$P(VAL UE,"^",3)
	9864	"RTN","RCD PBTLM",188 ,0)
	9865	. S $P( VALUE,"^", 4)=-$P(VAL UE,"^",4)
	9866	"RTN","RCD PBTLM",189 ,0)
	9867	. S $P( VALUE,"^", 5)=-$P(VAL UE,"^",5)
	9868	"RTN","RCD PBTLM",190 ,0)
	9869	;
	9870	"RTN","RCD PBTLM",191 ,0)
	9871	; the fo llowing tr ansaction types shou ld not cha nge the bi lls balanc e
	9872	"RTN","RCD PBTLM",192 ,0)
	9873	; return the amoun t displaye d in the d escription and 0 for value
	9874	"RTN","RCD PBTLM",193 ,0)
	9875	; refe r to RC 3, refer to DOJ 4, ree stablish 5 , returned 6 and 32
	9876	"RTN","RCD PBTLM",194 ,0)
	9877	; repa yment plan 25, amend ed 33, sus pended 47, unsuspend ed 46
	9878	"RTN","RCD PBTLM",195 ,0)
	9879	K AMTDISP
	9880	"RTN","RCD PBTLM",196 ,0)
	9881	I TYPE=3! (TYPE=4)!( TYPE=5)!(T YPE=6)!(TY PE=25)!(TY PE=32)!(TY PE=33)!(TY PE=46)!(T
	9882	YPE=47) D
	9883	"RTN","RCD PBTLM",197 ,0)
	9884	. S AMT DISP=" ($" _$J($P(VAL UE,"^")+$P (VALUE,"^" ,2)+$P(VAL UE,"^",3)+ $P(VALUE,
	9885	"^",4)+$P( VALUE,"^", 5),0,2)_") "
	9886	"RTN","RCD PBTLM",198 ,0)
	9887	. S VAL UE=""
	9888	"RTN","RCD PBTLM",199 ,0)
	9889	Q $G(AMTD ISP)_"^"_V ALUE
	9890	"RTN","RCD PBTLM",200 ,0)
	9891	;
	9892	"RTN","RCD PBTLM",201 ,0)
	9893	SELECME() ;
	9894	"RTN","RCD PBTLM",202 ,0)
	9895	; functio n takes th e user inp ut of the ECME # to return a v alid ien o f file 43
	9896	0
	9897	"RTN","RCD PBTLM",203 ,0)
	9898	; if an i nvalid ECM E is evalu ated then the proces s keeps as king the u ser for E
	9899	CME #
	9900	"RTN","RCD PBTLM",204 ,0)
	9901	; until a valid ECM E# is ente red or unt il the use r enters a "^" or nu ll value
	9902	"RTN","RCD PBTLM",205 ,0)
	9903	; output - returns the IEN of the recor d entry in the ACCOU NT RECEIVA BLE file
	9904	(#430) or "??"
	9905	"RTN","RCD PBTLM",206 ,0)
	9906	N RCECME, RCBILL,DIR ,DIRUT,Y
	9907	"RTN","RCD PBTLM",207 ,0)
	9908	S DIR(0)= "FO^1:12^I X'?1.12N W !!,""Can not contai n alpha ch aracters"" K X"
	9909	"RTN","RCD PBTLM",208 ,0)
	9910	S DIR("A" )="Select ECME#"
	9911	"RTN","RCD PBTLM",209 ,0)
	9912	RET D ^DIR I $D(DIRU T) Q 0
	9913	"RTN","RCD PBTLM",210 ,0)
	9914	S RCECME= $S(+Y>0:Y, 1:0)
	9915	"RTN","RCD PBTLM",211 ,0)
	9916	S RCBILL= $$REC^IBRF N(RCECME) ; IA 20 31
	9917	"RTN","RCD PBTLM",212 ,0)
	9918	I RCBILL< 0 W !!,"?? " G RET
	9919	"RTN","RCD PBTLM",213 ,0)
	9920	E W !!,$ P($G(^PRCA (430,+RCBI LL,0)),"^" )," "
	9921	"RTN","RCD PBTLM",214 ,0)
	9922	Q RCBILL
	9923	"RTN","RCD PBTLM",215 ,0)
	9924	;RCDPBTLM
	9925	"VER")
	9926	8.0^22.2
	9927	"^DD",340, 340,.01,0)
	9928	DEBTOR^RV^ ^0;1^
	9929	"^DD",340, 340,.01,1, 0)
	9930	^.1
	9931	"^DD",340, 340,.01,1, 1,0)
	9932	340^B
	9933	"^DD",340, 340,.01,1, 1,1)
	9934	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	9935	"^DD",340, 340,.01,1, 1,2)
	9936	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	9937	"^DD",340, 340,.01,1, 1,3)
	9938	Needed for look-up o f informat ion by Deb tor
	9939	"^DD",340, 340,.01,1, 1,"%D",0)
	9940	^^2^2^2931 014^^^^
	9941	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	9942	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	9943	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	9944	AR package for users to look u p informat ion by deb tor.
	9945	"^DD",340, 340,.01,1, 2,0)
	9946	^^TRIGGER^ 340^.03
	9947	"^DD",340, 340,.01,1, 2,1)
	9948	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=
	9949	$P(Y(1),U, 3),X=X S D IU=X K Y X ^DD(340,. 01,1,2,1.1 ) X ^DD(34 0,.01,1,2, 1.4)
	9950	"^DD",340, 340,.01,1, 2,1.1)
	9951	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X
	9952	=+X
	9953	"^DD",340, 340,.01,1, 2,1.3)
	9954	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:"")
	9955	S X=$P(Y(1 ),U,3)="", Y(2)=X,Y(3 )=X S X=Y( 0),X=X S X =X[";DPT(" ,Y=X,X=Y(2 ),X=X&Y
	9956	"^DD",340, 340,.01,1, 2,1.4)
	9957	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG
	9958	=.03 D ^DI CR:$O(^DD( DIH,DIG,1, 0))>0
	9959	"^DD",340, 340,.01,1, 2,2)
	9960	Q
	9961	"^DD",340, 340,.01,1, 2,3)
	9962	Needed for assigning statement days for patients
	9963	"^DD",340, 340,.01,1, 2,"%D",0)
	9964	^.101^2^2^ 3160502^^^
	9965	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	9966	This cross -reference sets the statement day for ne w patients as determ ined
	9967	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	9968	by the fir st two let ters of th e patient' s last nam e.
	9969	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	9970	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	9971	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	9972	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	9973	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	9974	NO EFFECT
	9975	"^DD",340, 340,.01,1, 2,"DT")
	9976	2961010
	9977	"^DD",340, 340,.01,1, 2,"FIELD")
	9978	STATEMENT DAY
	9979	"^DD",340, 340,.01,1, 3,0)
	9980	340^AB^MUM PS
	9981	"^DD",340, 340,.01,1, 3,1)
	9982	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	9983	"^DD",340, 340,.01,1, 3,2)
	9984	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	9985	"^DD",340, 340,.01,1, 3,3)
	9986	Needed to cross-refe rence debt or file by 'type' of debtor
	9987	"^DD",340, 340,.01,1, 3,"%D",0)
	9988	^^5^5^2931 014^^^^
	9989	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	9990	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	9991	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	9992	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	9993	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	9994	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	9995	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	9996	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	9997	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	9998	rather tha n having t o look at each entry .
	9999	"^DD",340, 340,.01,1, 3,"DT")
	10000	2930526
	10001	"^DD",340, 340,.01,1. 1)
	10002	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X
	10003	X=+X
	10004	"^DD",340, 340,.01,3)
	10005	Enter Debt or Informa tion
	10006	"^DD",340, 340,.01,7. 5)
	10007	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200
	10008	)",U,PRCAB T) S:$D(PR CAT) DIC(" V")="I +Y( 0)="_$S("C P"[PRCAT:2 ,"FV"[PRCA T:440,"T"
	10009	[PRCAT:36, "N"[PRCAT: 4,"O"[PRCA T:200,1:"2 00!(+Y(0)= 440)")
	10010	"^DD",340, 340,.01,21 ,0)
	10011	^^5^5^2970 219^^^^
	10012	"^DD",340, 340,.01,21 ,1,0)
	10013	This field contains the debtor to which this accou nt belongs to. An
	10014	"^DD",340, 340,.01,21 ,2,0)
	10015	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	10016	"^DD",340, 340,.01,21 ,3,0)
	10017	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	10018	"^DD",340, 340,.01,21 ,4,0)
	10019	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	10020	"^DD",340, 340,.01,21 ,5,0)
	10021	and Vendor bills.
	10022	"^DD",340, 340,.01,"D T")
	10023	3160428
	10024	"^DD",340, 340,.01,"V ",0)
	10025	^.12P^5^5
	10026	"^DD",340, 340,.01,"V ",1,0)
	10027	2^PATIENT^ 1^P^n^n
	10028	"^DD",340, 340,.01,"V ",1,1)
	10029
	10030	"^DD",340, 340,.01,"V ",1,2)
	10031
	10032	"^DD",340, 340,.01,"V ",2,0)
	10033	200^OTHER (PERSON)^2 ^O^n^y
	10034	"^DD",340, 340,.01,"V ",3,0)
	10035	36^3RD PAR TY^4^I^n^n
	10036	"^DD",340, 340,.01,"V ",4,0)
	10037	4^INSTITUT ION^5^N^n^ n
	10038	"^DD",340, 340,.01,"V ",5,0)
	10039	440^VENDOR ^3^V^n^n
	10040	"^DD",340, 340,.03,0)
	10041	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	10042	"^DD",340, 340,.03,1, 0)
	10043	^.1
	10044	"^DD",340, 340,.03,1, 1,0)
	10045	340^AC
	10046	"^DD",340, 340,.03,1, 1,1)
	10047	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	10048	"^DD",340, 340,.03,1, 1,2)
	10049	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	10050	"^DD",340, 340,.03,1, 1,3)
	10051	Needed for printing of patient statement s and foll ow-up lett ers
	10052	"^DD",340, 340,.03,1, 1,"%D",0)
	10053	^^4^4^2931 014^^^^
	10054	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	10055	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	10056	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	10057	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	10058	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	10059	based on t heir state ment day, this cross -reference allows ra pid look-u p
	10060	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	10061	of which d ebtor is d ue a notif ication on a particu lar day.
	10062	"^DD",340, 340,.03,1, 1,"DT")
	10063	2930309
	10064	"^DD",340, 340,.03,3)
	10065	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	10066	"^DD",340, 340,.03,5, 1,0)
	10067	340^.01^2
	10068	"^DD",340, 340,.03,21 ,0)
	10069	^^19^19^31 60428^
	10070	"^DD",340, 340,.03,21 ,1,0)
	10071	A statemen t day is a ssigned to all types of debtor s, except insurance
	10072	"^DD",340, 340,.03,21 ,2,0)
	10073	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	10074	"^DD",340, 340,.03,21 ,3,0)
	10075	follow-up letter is generated for non-be nefit debt s. Except for
	10076	"^DD",340, 340,.03,21 ,4,0)
	10077	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	10078	"^DD",340, 340,.03,21 ,5,0)
	10079	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	10080	"^DD",340, 340,.03,21 ,6,0)
	10081	debtor's ' statement day' arriv es. This allows all activity since the
	10082	"^DD",340, 340,.03,21 ,7,0)
	10083	previous s tatement t o print an d update t he debtor on the acc ount
	10084	"^DD",340, 340,.03,21 ,8,0)
	10085	activity.
	10086	"^DD",340, 340,.03,21 ,9,0)
	10087
	10088	"^DD",340, 340,.03,21 ,10,0)
	10089	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	10090	"^DD",340, 340,.03,21 ,11,0)
	10091	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	10092	"^DD",340, 340,.03,21 ,12,0)
	10093	have a new active bi ll, the da te the new active bi ll is crea ted become s
	10094	"^DD",340, 340,.03,21 ,13,0)
	10095	their 'sta tement day '. This s tatement d ay remains in effect until no
	10096	"^DD",340, 340,.03,21 ,14,0)
	10097	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	10098	"^DD",340, 340,.03,21 ,15,0)
	10099	is 'delete d'.
	10100	"^DD",340, 340,.03,21 ,16,0)
	10101
	10102	"^DD",340, 340,.03,21 ,17,0)
	10103	Insurance companies are notifi ed based o n a bill-s pecific da te.
	10104	"^DD",340, 340,.03,21 ,18,0)
	10105	Since insu rance comp anies have much more activity, they are notified
	10106	"^DD",340, 340,.03,21 ,19,0)
	10107	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	10108	"^DD",340, 340,.03,"D T")
	10109	3160428
	10110	"^DD",340, 340,7.06,0 )
	10111	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X
	10112	>999999)!( X<-999999) X
	10113	"^DD",340, 340,7.06,3 )
	10114	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10115	"^DD",340, 340,7.06,2 1,0)
	10116	^^7^7^3160 401^
	10117	"^DD",340, 340,7.06,2 1,1,0)
	10118	This field stores th e debt amo unt curren tly
	10119	"^DD",340, 340,7.06,2 1,2,0)
	10120	updated to the Conso lidated Bi lling Stat ement Syst em
	10121	"^DD",340, 340,7.06,2 1,3,0)
	10122	CBSS. Thi s field is used to c ompare the current
	10123	"^DD",340, 340,7.06,2 1,4,0)
	10124	amount at the CBSS w ith the am ount curre ntly
	10125	"^DD",340, 340,7.06,2 1,5,0)
	10126	available for receiv ing paymen t. For in creases
	10127	"^DD",340, 340,7.06,2 1,6,0)
	10128	or decreas es, the de bt amount is forward ed to
	10129	"^DD",340, 340,7.06,2 1,7,0)
	10130	CBSS.
	10131	"^DD",340, 340,7.06," DT")
	10132	3160401
	10133	"^DD",341, 341,6.01,0 )
	10134	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	10135	"^DD",341, 341,6.01,1 ,0)
	10136	^.1
	10137	"^DD",341, 341,6.01,1 ,1,0)
	10138	341^STDT
	10139	"^DD",341, 341,6.01,1 ,1,1)
	10140	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	10141	"^DD",341, 341,6.01,1 ,1,2)
	10142	K ^RC(341, "STDT",$E( X,1,30),DA )
	10143	"^DD",341, 341,6.01,1 ,1,"%D",0)
	10144	^.101^2^2^ 3160809^^
	10145	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	10146	This cross reference is used t o sort and print eve nts by the ir Patient
	10147	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	10148	Statement date.
	10149	"^DD",341, 341,6.01,1 ,1,"DT")
	10150	3160803
	10151	"^DD",341, 341,6.01,3 )
	10152	Enter date of Patien t Statemen t.
	10153	"^DD",341, 341,6.01,2 1,0)
	10154	^^1^1^3160 921^
	10155	"^DD",341, 341,6.01,2 1,1,0)
	10156	This is th e date of the Patien t Statemen t from CBS S.
	10157	"^DD",341, 341,6.01," DT")
	10158	3160921
	10159	"^DD",349, 349,.09,0)
	10160	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	10161	"^DD",349, 349,.09,3)
	10162	Enter the statement date.
	10163	"^DD",349, 349,.09,21 ,0)
	10164	^^1^1^3161 019^
	10165	"^DD",349, 349,.09,21 ,1,0)
	10166	This is th e patient statement date.
	10167	"^DD",349, 349,.09,"D T")
	10168	3161103
	10169	"^DD",349. 1,349.1,0)
	10170	FIELD^^40^ 14
	10171	"^DD",349. 1,349.1,0, "DDA")
	10172	N
	10173	"^DD",349. 1,349.1,0, "DT")
	10174	3170919
	10175	"^DD",349. 1,349.1,0, "IX","B",3 49.1,.01)
	10176
	10177	"^DD",349. 1,349.1,0, "NM","AR T RANSMISSIO N TYPE")
	10178
	10179	"^DD",349. 1,349.1,0, "PT",349.9 ,.01)
	10180
	10181	"^DD",349. 1,349.1,0, "VRPK")
	10182	PRCA
	10183	"^DD",349. 1,349.1,.0 1,0)
	10184	CODE^RF^^0 ;1^K:$L(X) >10!($L(X) <2)!'(X'?1 P.E) X
	10185	"^DD",349. 1,349.1,.0 1,1,0)
	10186	^.1
	10187	"^DD",349. 1,349.1,.0 1,1,1,0)
	10188	349.1^B
	10189	"^DD",349. 1,349.1,.0 1,1,1,1)
	10190	S ^RCT(349 .1,"B",$E( X,1,30),DA )=""
	10191	"^DD",349. 1,349.1,.0 1,1,1,2)
	10192	K ^RCT(349 .1,"B",$E( X,1,30),DA )
	10193	"^DD",349. 1,349.1,.0 1,3)
	10194	Answer mus t be 2-10 characters in length .
	10195	"^DD",349. 1,349.1,.0 1,21,0)
	10196	^.001^1^1^ 3040601^^^
	10197	"^DD",349. 1,349.1,.0 1,21,1,0)
	10198	This field will hold the uniqu e codes fo r the tran smission t ypes.
	10199	"^DD",349. 1,349.1,.0 1,23,0)
	10200	^^1^1^3040 601^
	10201	"^DD",349. 1,349.1,.0 1,23,1,0)
	10202
	10203	"^DD",349. 1,349.1,.0 1,"DT")
	10204	2960216
	10205	"^DD",349. 1,349.1,.0 2,0)
	10206	EXPANDED N AME^F^^0;2 ^K:$L(X)>3 0!($L(X)<3 ) X
	10207	"^DD",349. 1,349.1,.0 2,3)
	10208	Answer mus t be 3-30 characters in length .
	10209	"^DD",349. 1,349.1,.0 2,21,0)
	10210	^^1^1^2960 216^^
	10211	"^DD",349. 1,349.1,.0 2,21,1,0)
	10212	This is th e expanded name of t he transmi ssion type .
	10213	"^DD",349. 1,349.1,.0 2,"DT")
	10214	2960216
	10215	"^DD",349. 1,349.1,.0 3,0)
	10216	ACTIVE^S^0 :NO;1:YES; ^0;3^Q
	10217	"^DD",349. 1,349.1,.0 3,21,0)
	10218	^^1^1^2960 216^
	10219	"^DD",349. 1,349.1,.0 3,21,1,0)
	10220	This field will indi cate if th e transmis sion type is being u sed.
	10221	"^DD",349. 1,349.1,.0 3,"DT")
	10222	2960216
	10223	"^DD",349. 1,349.1,.0 4,0)
	10224	PURGE FREQ UENCY^NJ4, 0^^0;4^K:+ X'=X!(X>36 50)!(X<30) !(X?.E1"." 1N.N) X
	10225	"^DD",349. 1,349.1,.0 4,3)
	10226	Type a Num ber betwee n 30 and 3 650, 0 Dec imal Digit s
	10227	"^DD",349. 1,349.1,.0 4,21,0)
	10228	^^2^2^2960 216^^
	10229	"^DD",349. 1,349.1,.0 4,21,1,0)
	10230	This field indicates if and wh en a purge of the en tries will take
	10231	"^DD",349. 1,349.1,.0 4,21,2,0)
	10232	place.
	10233	"^DD",349. 1,349.1,.0 4,23,0)
	10234	^^2^2^2960 216^
	10235	"^DD",349. 1,349.1,.0 4,23,1,0)
	10236	Number of days that transmissi on records are on-li ne before
	10237	"^DD",349. 1,349.1,.0 4,23,2,0)
	10238	purging oc curs.
	10239	"^DD",349. 1,349.1,.0 4,"DT")
	10240	2960216
	10241	"^DD",349. 1,349.1,1, 0)
	10242	LOCAL ADDR ESSEE^349. 11P^^1;0
	10243	"^DD",349. 1,349.1,2, 0)
	10244	LOCAL MAIL GROUP^349. 12P^^2;0
	10245	"^DD",349. 1,349.1,31 ,0)
	10246	REMOTE ADD RESSEE^F^^ 3;1^K:$L(X )>30!($L(X )<1)!'(X?. A) X
	10247	"^DD",349. 1,349.1,31 ,3)
	10248	Answer mus t be 1-30 characters in length .
	10249	"^DD",349. 1,349.1,31 ,21,0)
	10250	^^1^1^2960 430^^^
	10251	"^DD",349. 1,349.1,31 ,21,1,0)
	10252	This is th e addresse e name at the remote domain.
	10253	"^DD",349. 1,349.1,31 ,"DT")
	10254	2960430
	10255	"^DD",349. 1,349.1,32 ,0)
	10256	REMOTE DOM AIN^P4.2'^ DIC(4.2,^3 ;2^Q
	10257	"^DD",349. 1,349.1,32 ,1,0)
	10258	^.1
	10259	"^DD",349. 1,349.1,32 ,1,1,0)
	10260	^^TRIGGER^ 349.1^33
	10261	"^DD",349. 1,349.1,32 ,1,1,1)
	10262	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(
	10263	Y(1),U,3), X=X S DIU= X K Y X ^D D(349.1,32 ,1,1,1.1) X ^DD(349. 1,32,1,1,1 .4)
	10264	"^DD",349. 1,349.1,32 ,1,1,1.1)
	10265	S X=DIV S I(0,0)=$S( $D(D0):D0, 1:""),D0=D IV S:'$D(^ DIC(4.2,+D 0,0)) D0=- 1 S Y(101
	10266	)=$S($D(^D IC(4.2,D0, 0)):^(0),1 :"") S X=$ P(Y(101),U ,1) S D0=I (0,0)
	10267	"^DD",349. 1,349.1,32 ,1,1,1.4)
	10268	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	10269	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10270	"^DD",349. 1,349.1,32 ,1,1,2)
	10271	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(
	10272	Y(1),U,3), X=X S DIU= X K Y S X= "" X ^DD(3 49.1,32,1, 1,2.4)
	10273	"^DD",349. 1,349.1,32 ,1,1,2.4)
	10274	S DIH=$S($ D(^RCT(349 .1,DIV(0), 3)):^(3),1 :""),DIV=X S $P(^(3) ,U,3)=DIV, DIH=349.1
	10275	,DIG=33 D ^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	10276	"^DD",349. 1,349.1,32 ,1,1,"CREA TE VALUE")
	10277	REMOTE DOM AIN:.01
	10278	"^DD",349. 1,349.1,32 ,1,1,"DELE TE VALUE")
	10279	@
	10280	"^DD",349. 1,349.1,32 ,1,1,"FIEL D")
	10281	DOMAIN NAM E
	10282	"^DD",349. 1,349.1,32 ,21,0)
	10283	^.001^2^2^ 3000524^^^
	10284	"^DD",349. 1,349.1,32 ,21,1,0)
	10285	This is th e remote d omain wher e the tran smission r ecord is b eing
	10286	"^DD",349. 1,349.1,32 ,21,2,0)
	10287	sent.
	10288	"^DD",349. 1,349.1,32 ,"DT")
	10289	2960902
	10290	"^DD",349. 1,349.1,33 ,0)
	10291	DOMAIN NAM E^F^^3;3^K :$L(X)>30! ($L(X)<3) X
	10292	"^DD",349. 1,349.1,33 ,3)
	10293	Answer mus t be 3-30 characters in length .
	10294	"^DD",349. 1,349.1,33 ,5,1,0)
	10295	349.1^32^1
	10296	"^DD",349. 1,349.1,33 ,9)
	10297	^
	10298	"^DD",349. 1,349.1,33 ,21,0)
	10299	^^1^1^2960 902^
	10300	"^DD",349. 1,349.1,33 ,21,1,0)
	10301	This is th e name of the DOMAIN from file 4.2 DOMAI N.
	10302	"^DD",349. 1,349.1,33 ,"DT")
	10303	2960902
	10304	"^DD",349. 1,349.1,34 ,0)
	10305	RC MAIL AD DRESS^RFX^ ^3;4^K:$L( X)>30!($L( X)<3) X
	10306	"^DD",349. 1,349.1,34 ,3)
	10307	Answer mus t be 3-30 characters in length .
	10308	"^DD",349. 1,349.1,34 ,4)
	10309	D MAILADD^ RCRCXMS
	10310	"^DD",349. 1,349.1,34 ,21,0)
	10311	^.001^2^2^ 3040429^^^ ^
	10312	"^DD",349. 1,349.1,34 ,21,1,0)
	10313	This field will cont ain the Re gional Cou nsel mail address fo r the
	10314	"^DD",349. 1,349.1,34 ,21,2,0)
	10315	primary si te. It wi ll be the default ma il address .
	10316	"^DD",349. 1,349.1,34 ,23,0)
	10317	^.001^1^1^ 3040429^^^ ^
	10318	"^DD",349. 1,349.1,34 ,23,1,0)
	10319
	10320	"^DD",349. 1,349.1,34 ,"DT")
	10321	3040407
	10322	"^DD",349. 1,349.1,35 ,0)
	10323	RC DEATH N OTIFICATIO N ADDRESS^ RF^^3;5^K: $L(X)>40!( $L(X)<2) X
	10324	"^DD",349. 1,349.1,35 ,3)
	10325	Answer mus t be 2-40 characters in length .
	10326	"^DD",349. 1,349.1,35 ,4)
	10327	D DEATHADD ^RCRCXMS
	10328	"^DD",349. 1,349.1,35 ,21,0)
	10329	^.001^3^3^ 3040429^^^ ^
	10330	"^DD",349. 1,349.1,35 ,21,1,0)
	10331	This field contains the Region al Counsel mail addr ess for de ath
	10332	"^DD",349. 1,349.1,35 ,21,2,0)
	10333	notificati ons for th e primary site. Thi s will be the defaul t for deat h
	10334	"^DD",349. 1,349.1,35 ,21,3,0)
	10335	notificati ons.
	10336	"^DD",349. 1,349.1,35 ,23,0)
	10337	^.001^1^1^ 3040429^^^ ^
	10338	"^DD",349. 1,349.1,35 ,23,1,0)
	10339
	10340	"^DD",349. 1,349.1,35 ,"DT")
	10341	3040428
	10342	"^DD",349. 1,349.1,40 ,0)
	10343	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	10344	"^DD",349. 1,349.1,40 ,21,0)
	10345	^^5^5^3160 429^
	10346	"^DD",349. 1,349.1,40 ,21,1,0)
	10347	Message Ac knowledgem ents conta in the top level of data for m essages
	10348	"^DD",349. 1,349.1,40 ,21,2,0)
	10349	received f rom Austin .
	10350	"^DD",349. 1,349.1,40 ,21,3,0)
	10351
	10352	"^DD",349. 1,349.1,40 ,21,4,0)
	10353	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	10354	"^DD",349. 1,349.1,40 ,21,5,0)
	10355	the day of the month for the P atient Sta tement.
	10356	"^DD",349. 1,349.1,51 ,0)
	10357	ACK MESSAG ES^349.151 A^^5;0
	10358	"^DD",349. 1,349.1,51 ,21,0)
	10359	^^1^1^3161 006^
	10360	"^DD",349. 1,349.1,51 ,21,1,0)
	10361	Acknowledg ement Mess ages recei ved from e xternal so urces.
	10362	"^DD",349. 1,349.1,61 ,0)
	10363	DIVISION O F CARE^349 .161PA^^6; 0
	10364	"^DD",349. 1,349.1,61 ,21,0)
	10365	^.001^4^4^ 3040517^^^ ^
	10366	"^DD",349. 1,349.1,61 ,21,1,0)
	10367	This field is a mult iple that allows div isions to be entered if their
	10368	"^DD",349. 1,349.1,61 ,21,2,0)
	10369	Regional C ounsel mai l addresse s and deat h notifica tion addre sses are
	10370	"^DD",349. 1,349.1,61 ,21,3,0)
	10371	different from the p rimary add resses.
	10372	"^DD",349. 1,349.1,61 ,21,4,0)
	10373
	10374	"^DD",349. 1,349.1,61 ,23,0)
	10375	^.001^1^1^ 3040517^^^ ^
	10376	"^DD",349. 1,349.1,61 ,23,1,0)
	10377
	10378	"^DD",349. 1,349.1,61 ,"DT")
	10379	3040514
	10380	"^DD",349. 1,349.11,0 )
	10381	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	10382	"^DD",349. 1,349.11,0 ,"DT")
	10383	2960216
	10384	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	10385
	10386	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	10387
	10388	"^DD",349. 1,349.11,0 ,"UP")
	10389	349.1
	10390	"^DD",349. 1,349.11,. 01,0)
	10391	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	10392	"^DD",349. 1,349.11,. 01,1,0)
	10393	^.1
	10394	"^DD",349. 1,349.11,. 01,1,1,0)
	10395	349.11^B
	10396	"^DD",349. 1,349.11,. 01,1,1,1)
	10397	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	10398	"^DD",349. 1,349.11,. 01,1,1,2)
	10399	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	10400	"^DD",349. 1,349.11,. 01,21,0)
	10401	^^2^2^3171 005^
	10402	"^DD",349. 1,349.11,. 01,21,1,0)
	10403	The local users who wish to be recipient s of the t ransmissio n messages
	10404	"^DD",349. 1,349.11,. 01,21,2,0)
	10405	will named in this f ield.
	10406	"^DD",349. 1,349.11,. 01,"DT")
	10407	3171005
	10408	"^DD",349. 1,349.12,0 )
	10409	LOCAL MAIL GROUP SUB- FIELD^^.01 ^1
	10410	"^DD",349. 1,349.12,0 ,"DT")
	10411	2960216
	10412	"^DD",349. 1,349.12,0 ,"IX","B", 349.12,.01 )
	10413
	10414	"^DD",349. 1,349.12,0 ,"NM","LOC AL MAILGRO UP")
	10415
	10416	"^DD",349. 1,349.12,0 ,"UP")
	10417	349.1
	10418	"^DD",349. 1,349.12,. 01,0)
	10419	LOCAL MAIL GROUP^MP3. 8'^XMB(3.8 ,^0;1^Q
	10420	"^DD",349. 1,349.12,. 01,1,0)
	10421	^.1
	10422	"^DD",349. 1,349.12,. 01,1,1,0)
	10423	349.12^B
	10424	"^DD",349. 1,349.12,. 01,1,1,1)
	10425	S ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)= ""
	10426	"^DD",349. 1,349.12,. 01,1,1,2)
	10427	K ^RCT(349 .1,DA(1),2 ,"B",$E(X, 1,30),DA)
	10428	"^DD",349. 1,349.12,. 01,21,0)
	10429	^^2^2^2960 216^
	10430	"^DD",349. 1,349.12,. 01,21,1,0)
	10431	This field is used t o define a ny mailgro ups which should rec eive the
	10432	"^DD",349. 1,349.12,. 01,21,2,0)
	10433	transmissi on message s.
	10434	"^DD",349. 1,349.12,. 01,"DT")
	10435	2960216
	10436	"^DD",349. 1,349.141, 0)
	10437	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	10438	"^DD",349. 1,349.141, 0,"DT")
	10439	3160425
	10440	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	10441
	10442	"^DD",349. 1,349.141, 0,"UP")
	10443	349.1
	10444	"^DD",349. 1,349.141, .01,0)
	10445	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10446	"^DD",349. 1,349.141, .01,1,0)
	10447	^.1^^0
	10448	"^DD",349. 1,349.141, .01,3)
	10449	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10450	"^DD",349. 1,349.141, .01,21,0)
	10451	^^1^1^3160 425^
	10452	"^DD",349. 1,349.141, .01,21,1,0 )
	10453	Number of last messa ge type se nt from CB SS.
	10454	"^DD",349. 1,349.141, .01,"DT")
	10455	3161007
	10456	"^DD",349. 1,349.141, .02,0)
	10457	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10458	"^DD",349. 1,349.141, .02,3)
	10459	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10460	"^DD",349. 1,349.141, .02,21,0)
	10461	^^1^1^3160 425^
	10462	"^DD",349. 1,349.141, .02,21,1,0 )
	10463	Final mess age number of this t ype from C BSS.
	10464	"^DD",349. 1,349.141, .02,"DT")
	10465	3160425
	10466	"^DD",349. 1,349.141, .03,0)
	10467	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	10468	"^DD",349. 1,349.141, .03,3)
	10469	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	10470	"^DD",349. 1,349.141, .03,21,0)
	10471	^^2^2^3160 425^
	10472	"^DD",349. 1,349.141, .03,21,1,0 )
	10473	This is th e last mes sage numbe r of this type for t he last tr ansmission
	10474	"^DD",349. 1,349.141, .03,21,2,0 )
	10475	from CBSS.
	10476	"^DD",349. 1,349.141, .03,"DT")
	10477	3160425
	10478	"^DD",349. 1,349.141, .04,0)
	10479	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10480	"^DD",349. 1,349.141, .04,1,0)
	10481	^.1^^0
	10482	"^DD",349. 1,349.141, .04,3)
	10483	Enter date of Patien t Statemen t.
	10484	"^DD",349. 1,349.141, .04,21,0)
	10485	^^1^1^3161 025^
	10486	"^DD",349. 1,349.141, .04,21,1,0 )
	10487	This is th e Patient Statement Date.
	10488	"^DD",349. 1,349.141, .04,"DT")
	10489	3161025
	10490	"^DD",349. 1,349.151, 0)
	10491	ACK MESSAG ES SUB-FIE LD^^.04^4
	10492	"^DD",349. 1,349.151, 0,"DT")
	10493	3161103
	10494	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	10495
	10496	"^DD",349. 1,349.151, 0,"UP")
	10497	349.1
	10498	"^DD",349. 1,349.151, .01,0)
	10499	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	10500	"^DD",349. 1,349.151, .01,1,0)
	10501	^.1^^0
	10502	"^DD",349. 1,349.151, .01,3)
	10503	Answer mus t be 3-80 characters in length .
	10504	"^DD",349. 1,349.151, .01,21,0)
	10505	^^1^1^3171 005^
	10506	"^DD",349. 1,349.151, .01,21,1,0 )
	10507	This multi ple will s tore the A cknowledgm ent messag es from Au stin.
	10508	"^DD",349. 1,349.151, .01,"DT")
	10509	3171005
	10510	"^DD",349. 1,349.151, .02,0)
	10511	ACCOUNT/SE G ID^F^^0; 2^K:$L(X)> 25!($L(X)< 3) X
	10512	"^DD",349. 1,349.151, .02,3)
	10513	Answer mus t be 3-25 characters in length .
	10514	"^DD",349. 1,349.151, .02,21,0)
	10515	^^1^1^2961 114^
	10516	"^DD",349. 1,349.151, .02,21,1,0 )
	10517	This field stores th e account id for the record.
	10518	"^DD",349. 1,349.151, .02,"DT")
	10519	2961205
	10520	"^DD",349. 1,349.151, .03,0)
	10521	ACCOUNT/SE G INFO^F^^ 0;3^K:$L(X )>40!($L(X )<3) X
	10522	"^DD",349. 1,349.151, .03,3)
	10523	Answer mus t be 3-40 characters in length .
	10524	"^DD",349. 1,349.151, .03,21,0)
	10525	^^1^1^2961 114^
	10526	"^DD",349. 1,349.151, .03,21,1,0 )
	10527	This field will stor e the deta iled infor mation abo ut the rec ord if any .
	10528	"^DD",349. 1,349.151, .03,"DT")
	10529	2961205
	10530	"^DD",349. 1,349.151, .04,0)
	10531	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	10532	"^DD",349. 1,349.151, .04,3)
	10533	Enter date of Patien t Statemen t.
	10534	"^DD",349. 1,349.151, .04,21,0)
	10535	^^1^1^3161 006^
	10536	"^DD",349. 1,349.151, .04,21,1,0 )
	10537	The Patien t Statemen t date for Acknowled gement Mes sages.
	10538	"^DD",349. 1,349.151, .04,"DT")
	10539	3161103
	10540	"^DD",349. 1,349.161, 0)
	10541	DIVISION O F CARE SUB -FIELD^^.0 4^4
	10542	"^DD",349. 1,349.161, 0,"DT")
	10543	3040429
	10544	"^DD",349. 1,349.161, 0,"IX","B" ,349.161,. 01)
	10545
	10546	"^DD",349. 1,349.161, 0,"NM","DI VISION OF CARE")
	10547
	10548	"^DD",349. 1,349.161, 0,"UP")
	10549	349.1
	10550	"^DD",349. 1,349.161, .01,0)
	10551	DIVISION O F CARE^P40 .8'^DG(40. 8,^0;1^Q
	10552	"^DD",349. 1,349.161, .01,1,0)
	10553	^.1
	10554	"^DD",349. 1,349.161, .01,1,1,0)
	10555	349.161^B
	10556	"^DD",349. 1,349.161, .01,1,1,1)
	10557	S ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)= ""
	10558	"^DD",349. 1,349.161, .01,1,1,2)
	10559	K ^RCT(349 .1,DA(1),6 ,"B",$E(X, 1,30),DA)
	10560	"^DD",349. 1,349.161, .01,21,0)
	10561	^.001^1^1^ 3040517^^^ ^
	10562	"^DD",349. 1,349.161, .01,21,1,0 )
	10563	Enter divi sions of c are where bill charg es origina te for thi s site.
	10564	"^DD",349. 1,349.161, .01,"DT")
	10565	3000524
	10566	"^DD",349. 1,349.161, .02,0)
	10567	REMOTE DOM AIN^P4.2'^ DIC(4.2,^0 ;2^Q
	10568	"^DD",349. 1,349.161, .02,3)
	10569
	10570	"^DD",349. 1,349.161, .02,21,0)
	10571	^.001^1^1^ 3000524^^
	10572	"^DD",349. 1,349.161, .02,21,1,0 )
	10573	This is th e Remote D omain addr ess where transmissi ons will b e sent for this div
	10574	ision.
	10575	"^DD",349. 1,349.161, .02,"DT")
	10576	3000524
	10577	"^DD",349. 1,349.161, .03,0)
	10578	RC MAIL AD DRESS^F^^0 ;3^K:$L(X) >30!($L(X) <3) X
	10579	"^DD",349. 1,349.161, .03,3)
	10580	Answer mus t be 3-30 characters in length .
	10581	"^DD",349. 1,349.161, .03,4)
	10582	D MAILADD^ RCRCXMS
	10583	"^DD",349. 1,349.161, .03,21,0)
	10584	^.001^4^4^ 3040429^^
	10585	"^DD",349. 1,349.161, .03,21,1,0 )
	10586	This field will cont ain the na me of the Regional C ounsel mai l address
	10587	"^DD",349. 1,349.161, .03,21,2,0 )
	10588	that trans actions fr om the ass ociated Di vision of Care will be sent.
	10589	"^DD",349. 1,349.161, .03,21,3,0 )
	10590	This field s address will be di fferent fr om the pri mary divis ion's
	10591	"^DD",349. 1,349.161, .03,21,4,0 )
	10592	RC mail ad dress.
	10593	"^DD",349. 1,349.161, .03,23,0)
	10594	^^1^1^3040 429^
	10595	"^DD",349. 1,349.161, .03,23,1,0 )
	10596
	10597	"^DD",349. 1,349.161, .03,"DT")
	10598	3040325
	10599	"^DD",349. 1,349.161, .04,0)
	10600	RC DEATH N OTIFICATIO N ADDRESS^ F^^0;4^K:$ L(X)>40!($ L(X)<3) X
	10601	"^DD",349. 1,349.161, .04,3)
	10602	Answer mus t be 3-40 characters in length .
	10603	"^DD",349. 1,349.161, .04,4)
	10604	D DEATHADD ^RCRCXMS
	10605	"^DD",349. 1,349.161, .04,21,0)
	10606	^.001^4^4^ 3040429^^^
	10607	"^DD",349. 1,349.161, .04,21,1,0 )
	10608	This field will cont ain the na me of the RC death n otificatio ns address
	10609	"^DD",349. 1,349.161, .04,21,2,0 )
	10610	that death notices f rom the as sociated D ivision of Care will be sent.
	10611	"^DD",349. 1,349.161, .04,21,3,0 )
	10612	This field s address will be di fferent fr om the pri mary divis ion's
	10613	"^DD",349. 1,349.161, .04,21,4,0 )
	10614	RC death n otificatio n address.
	10615	"^DD",349. 1,349.161, .04,23,0)
	10616	^.001^1^1^ 3040429^^
	10617	"^DD",349. 1,349.161, .04,23,1,0 )
	10618
	10619	"^DD",349. 1,349.161, .04,"DT")
	10620	3040429
	10621	"^DD",349. 2,349.2,.0 1,0)
	10622	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	10623	"^DD",349. 2,349.2,.0 1,1,0)
	10624	^.1^^0
	10625	"^DD",349. 2,349.2,.0 1,3)
	10626	Enter the Debtor Num ber for th e Patient Statement.
	10627	"^DD",349. 2,349.2,.0 1,21,0)
	10628	^^2^2^3161 011^^
	10629	"^DD",349. 2,349.2,.0 1,21,1,0)
	10630	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	10631	"^DD",349. 2,349.2,.0 1,21,2,0)
	10632	with the s pecific Pa tient.
	10633	"^DD",349. 2,349.2,.0 1,"DT")
	10634	3161011
	10635	"^DD",349. 2,349.2,.0 2,0)
	10636	SSN^RFXO^^ 0;2^K:$L(X )>10!($L(X )<9) X S X =$$SSN^RCF N01(+DA)
	10637	"^DD",349. 2,349.2,.0 2,1,0)
	10638	^.1
	10639	"^DD",349. 2,349.2,.0 2,1,1,0)
	10640	349.2^AKEY 1^MUMPS
	10641	"^DD",349. 2,349.2,.0 2,1,1,1)
	10642	I $P(^RCPS (349.2,+DA ,0),"^",3) ]"" S ^RCP S(349.2,"A KEY",$E(X, 1,9)_$TR($ E($P($P(^
	10643	RCPS(349.2 ,+DA,0),"^ ",3),","), 1,5)," "," "),DA)=""
	10644	"^DD",349. 2,349.2,.0 2,1,1,2)
	10645	K ^RCPS(34 9.2,"AKEY" ,$E(X,1,9) _$TR($E($P ($P(^RCPS( 349.2,+DA, 0),"^",3), ","),1,5)
	10646	," ",""))
	10647	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,0)
	10648	^.101^1^1^ 3160427^^
	10649	"^DD",349. 2,349.2,.0 2,1,1,"%D" ,1,0)
	10650	This cross -reference is used t o key the statements for CBSS.
	10651	"^DD",349. 2,349.2,.0 2,1,1,"DT" )
	10652	2960924
	10653	"^DD",349. 2,349.2,.0 2,2)
	10654	S Y(0)=Y S Y=Y
	10655	"^DD",349. 2,349.2,.0 2,2.1)
	10656	S Y=Y
	10657	"^DD",349. 2,349.2,.0 2,3)
	10658	Answer mus t be 9-10 characters in length .
	10659	"^DD",349. 2,349.2,.0 2,21,0)
	10660	^^1^1^2960 418^^
	10661	"^DD",349. 2,349.2,.0 2,21,1,0)
	10662	This is th e SSN for the patien t.
	10663	"^DD",349. 2,349.2,.0 2,"DT")
	10664	2960924
	10665	"^DD",349. 2,349.2,.0 3,0)
	10666	PATIENT NA ME^RFX^^0; 3^K:$L(X)> 44!($L(X)< 3) X S X=$ $NAM^RCFN0 1(+DA)
	10667	"^DD",349. 2,349.2,.0 3,1,0)
	10668	^.1
	10669	"^DD",349. 2,349.2,.0 3,1,1,0)
	10670	349.2^AKEY 2^MUMPS
	10671	"^DD",349. 2,349.2,.0 3,1,1,1)
	10672	I $$KEY^RC CPCFN(+DA) ]"" S ^RCP S(349.2,"A KEY",$$KEY ^RCCPCFN(+ DA),DA)=""
	10673	"^DD",349. 2,349.2,.0 3,1,1,2)
	10674	I $P(^RCPS (349.2,+DA ,0),"^",2) >1 K ^RCPS (349.2,"AK EY",$E($P( ^RCPS(349. 2,+DA,0),
	10675	"^",2),1,9 )_$TR($E($ P(X,","),1 ,5)," ","" ))
	10676	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,0)
	10677	^^1^1^3160 427^
	10678	"^DD",349. 2,349.2,.0 3,1,1,"%D" ,1,0)
	10679	This cross -reference is used t o key the statements for CBSS.
	10680	"^DD",349. 2,349.2,.0 3,1,1,"DT" )
	10681	2960924
	10682	"^DD",349. 2,349.2,.0 3,3)
	10683	Answer mus t be 3-44 characters in length .
	10684	"^DD",349. 2,349.2,.0 3,21,0)
	10685	^^1^1^2960 418^^^^
	10686	"^DD",349. 2,349.2,.0 3,21,1,0)
	10687	This is th e patient name as it appears o n the stat ement.
	10688	"^DD",349. 2,349.2,.0 3,"DT")
	10689	2960924
	10690	"^DD",349. 2,349.2,.1 2,0)
	10691	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	10692	"^DD",349. 2,349.2,.1 2,3)
	10693	Enter the error code for the r ecord that was not a ccepted by CBSS.
	10694	"^DD",349. 2,349.2,.1 2,21,0)
	10695	^^1^1^3160 427^
	10696	"^DD",349. 2,349.2,.1 2,21,1,0)
	10697	This is th e error co de for the record th at was not accepted by CBSS.
	10698	"^DD",349. 2,349.2,.1 2,"DT")
	10699	3160909
	10700	"^DD",349. 2,349.2,.1 8,0)
	10701	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	10702	"^DD",349. 2,349.2,.1 8,3)
	10703	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	10704	"^DD",349. 2,349.2,.1 8,21,0)
	10705	^^2^2^3160 909^^
	10706	"^DD",349. 2,349.2,.1 8,21,1,0)
	10707	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	10708	"^DD",349. 2,349.2,.1 8,21,2,0)
	10709	(349.2) is a complet e file for that stat ement day.
	10710	"^DD",349. 2,349.2,.1 8,"DT")
	10711	3160921
	10712	"^DD",349. 2,349.2,.1 9,0)
	10713	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10714	"^DD",349. 2,349.2,.1 9,3)
	10715	Enter the date of th e Patient Statement.
	10716	"^DD",349. 2,349.2,.1 9,21,0)
	10717	^^2^2^3161 019^
	10718	"^DD",349. 2,349.2,.1 9,21,1,0)
	10719	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	10720	"^DD",349. 2,349.2,.1 9,21,2,0)
	10721	standardly two days after the statement is transmi tted
	10722	"^DD",349. 2,349.2,.1 9,"DT")
	10723	3161103
	10724	"^DD",349. 2,349.2,51 ,0)
	10725	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	10726	"^DD",349. 2,349.2,51 ,1,0)
	10727	^.1^^0
	10728	"^DD",349. 2,349.2,51 ,3)
	10729	Answer mus t be 5-30 characters in length .
	10730	"^DD",349. 2,349.2,51 ,21,0)
	10731	^^2^2^3161 007^
	10732	"^DD",349. 2,349.2,51 ,21,1,0)
	10733	These are the error codes sent back by C BSS when a statement cannot be
	10734	"^DD",349. 2,349.2,51 ,21,2,0)
	10735	printed.
	10736	"^DD",349. 2,349.2,51 ,"DT")
	10737	3161007
	10738	"^DD",349. 2,349.2,61 ,0)
	10739	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	10740	"^DD",349. 2,349.2,61 ,3)
	10741	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	10742	"^DD",349. 2,349.2,61 ,21,0)
	10743	^^2^2^3160 909^^
	10744	"^DD",349. 2,349.2,61 ,21,1,0)
	10745	This field indicates whether t he patient statement for this patient pr inted
	10746	"^DD",349. 2,349.2,61 ,21,2,0)
	10747	at the CCP C or not.
	10748	"^DD",349. 2,349.2,61 ,"DT")
	10749	3160921
	10750	"^DD",349. 2,349.2,81 ,0)
	10751	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."
	10752	1.N) X
	10753	"^DD",349. 2,349.2,81 ,3)
	10754	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	10755	"^DD",349. 2,349.2,81 ,21,0)
	10756	^^2^2^3160 909^
	10757	"^DD",349. 2,349.2,81 ,21,1,0)
	10758	Machine to machine i dentifier for a pati ent. This field can only be
	10759	"^DD",349. 2,349.2,81 ,21,2,0)
	10760	edited by CIRN.
	10761	"^DD",349. 2,349.2,81 ,"DT")
	10762	3160921
	10763	"^DD",349. 2,349.2,82 ,0)
	10764	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	10765	"^DD",349. 2,349.2,82 ,3)
	10766	Answer mus t be 6 cha racters in length.
	10767	"^DD",349. 2,349.2,82 ,21,0)
	10768	^^2^2^3160 428^
	10769	"^DD",349. 2,349.2,82 ,21,1,0)
	10770	This check sum is the calculate d checksum for the I ntegration Control
	10771	"^DD",349. 2,349.2,82 ,21,2,0)
	10772	Number. I t verifies the integ rity of th e ICN.
	10773	"^DD",349. 2,349.2,82 ,"DT")
	10774	3160428
	10775	"^DD",349. 2,349.2,83 ,0)
	10776	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	10777	"^DD",349. 2,349.2,83 ,3)
	10778	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtain
	10779	ed from AR storage.
	10780	"^DD",349. 2,349.2,83 ,21,0)
	10781	^^2^2^3160 428^
	10782	"^DD",349. 2,349.2,83 ,21,1,0)
	10783	This is a set of cod e, indicat ing whethe r or not t he address was taken
	10784	"^DD",349. 2,349.2,83 ,21,2,0)
	10785	from the A R DEBTOR ( #340).
	10786	"^DD",349. 2,349.2,83 ,"DT")
	10787	3160921
	10788	"^DD",349. 2,349.2,84 ,0)
	10789	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	10790	"^DD",349. 2,349.2,84 ,3)
	10791	Enter the date on wh ich the la test bill was establ ished.
	10792	"^DD",349. 2,349.2,84 ,21,0)
	10793	^^1^1^3160 428^^
	10794	"^DD",349. 2,349.2,84 ,21,1,0)
	10795	The date t he latest bill was p repared. Time is no t allowed.
	10796	"^DD",349. 2,349.2,84 ,"DT")
	10797	3160921
	10798	"^DD",349. 5,349.5,0)
	10799	FIELD^^1^7
	10800	"^DD",349. 5,349.5,0, "DT")
	10801	3170919
	10802	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	10803
	10804	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	10805
	10806	"^DD",349. 5,349.5,0, "VRPK")
	10807	PRCA
	10808	"^DD",349. 5,349.5,.0 1,0)
	10809	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	10810	"^DD",349. 5,349.5,.0 1,1,0)
	10811	^.1
	10812	"^DD",349. 5,349.5,.0 1,1,1,0)
	10813	349.5^B
	10814	"^DD",349. 5,349.5,.0 1,1,1,1)
	10815	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	10816	"^DD",349. 5,349.5,.0 1,1,1,2)
	10817	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	10818	"^DD",349. 5,349.5,.0 1,3)
	10819	Enter the PS Segment Number (a number be tween 1 an d 9999).
	10820	"^DD",349. 5,349.5,.0 1,21,0)
	10821	^^1^1^3170 223^
	10822	"^DD",349. 5,349.5,.0 1,21,1,0)
	10823	This is th e Segment Number for the "PS" Record Ide ntifier.
	10824	"^DD",349. 5,349.5,.0 1,"DT")
	10825	3170224
	10826	"^DD",349. 5,349.5,.0 2,0)
	10827	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	10828	"^DD",349. 5,349.5,.0 2,3)
	10829	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 30
	10830	0 and 400) .
	10831	"^DD",349. 5,349.5,.0 2,21,0)
	10832	^^1^1^3170 223^
	10833	"^DD",349. 5,349.5,.0 2,21,1,0)
	10834	This is th e Annual P ayment Fil e Year to be process ed.
	10835	"^DD",349. 5,349.5,.0 2,"DT")
	10836	3170224
	10837	"^DD",349. 5,349.5,.0 3,0)
	10838	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 3170101>X X
	10839	"^DD",349. 5,349.5,.0 3,3)
	10840	Enter the Date and T ime Build Started.
	10841	"^DD",349. 5,349.5,.0 3,21,0)
	10842	^^1^1^3170 223^
	10843	"^DD",349. 5,349.5,.0 3,21,1,0)
	10844	This is th e Date and Time that the Build for this file start ed.
	10845	"^DD",349. 5,349.5,.0 3,"DT")
	10846	3170224
	10847	"^DD",349. 5,349.5,.0 4,0)
	10848	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 70101>X X
	10849	"^DD",349. 5,349.5,.0 4,3)
	10850	Enter the Date and T ime Build Ended.
	10851	"^DD",349. 5,349.5,.0 4,21,0)
	10852	^^1^1^3170 223^
	10853	"^DD",349. 5,349.5,.0 4,21,1,0)
	10854	This is th e Date and Time that the Build for this file ended .
	10855	"^DD",349. 5,349.5,.0 4,"DT")
	10856	3170224
	10857	"^DD",349. 5,349.5,.0 5,0)
	10858	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:3170101 >X X
	10859	"^DD",349. 5,349.5,.0 5,3)
	10860	Enter the Date and T ime Transm it Started .
	10861	"^DD",349. 5,349.5,.0 5,21,0)
	10862	^^1^1^3170 223^
	10863	"^DD",349. 5,349.5,.0 5,21,1,0)
	10864	This is th e Date and Time that the Trans mit for th is file st arted.
	10865	"^DD",349. 5,349.5,.0 5,"DT")
	10866	3170224
	10867	"^DD",349. 5,349.5,.0 6,0)
	10868	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :3170101>X X
	10869	"^DD",349. 5,349.5,.0 6,3)
	10870	Enter Date /Time Tran smit Ended .
	10871	"^DD",349. 5,349.5,.0 6,21,0)
	10872	^^1^1^3170 223^
	10873	"^DD",349. 5,349.5,.0 6,21,1,0)
	10874	This is th e Date and Time that the Trans mit for th is file en ded.
	10875	"^DD",349. 5,349.5,.0 6,"DT")
	10876	3170224
	10877	"^DD",349. 5,349.5,1, 0)
	10878	STATEMENT FILE LINES ^349.51^^1 ;0
	10879	"^DD",349. 5,349.5,1, 21,0)
	10880	^^1^1^3170 224^^
	10881	"^DD",349. 5,349.5,1, 21,1,0)
	10882	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	10883	"^DD",349. 5,349.51,0 )
	10884	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	10885	"^DD",349. 5,349.51,0 ,"DT")
	10886	3170224
	10887	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	10888
	10889	"^DD",349. 5,349.51,0 ,"UP")
	10890	349.5
	10891	"^DD",349. 5,349.51,. 01,0)
	10892	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	10893	"^DD",349. 5,349.51,. 01,1,0)
	10894	^.1^^0
	10895	"^DD",349. 5,349.51,. 01,3)
	10896	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	10897	"^DD",349. 5,349.51,. 01,21,0)
	10898	^^1^1^3170 224^
	10899	"^DD",349. 5,349.51,. 01,21,1,0)
	10900	These are the File L ines for A nnual Paym ent Statem ent.
	10901	"^DD",349. 5,349.51,. 01,"DT")
	10902	3170224
	10903	"^DD",433, 433,94,0)
	10904	AUTO-CORRE CTION DATE ^D^^9;4^S %DT="EX" D ^%DT S X= Y K:Y<1 X
	10905	"^DD",433, 433,94,3)
	10906	Type the d ate that t he stateme nt discrep ancy was c orrected.
	10907	"^DD",433, 433,94,21, 0)
	10908	^^2^2^3160 428^
	10909	"^DD",433, 433,94,21, 1,0)
	10910	The is the date that the auto- correction program c orrected t he
	10911	"^DD",433, 433,94,21, 2,0)
	10912	statement discrepanc y for this transacti on.
	10913	"^DD",433, 433,94,"DT ")
	10914	3160920
	10915	"^DD",433, 433,95,0)
	10916	AUTO-CORRE CTION TRAN S. AMOUNT^ NJ9,2^^9;5 ^S:X["$" X =$P(X,"$", 2) K:X'?." -".N.1"."
	10917	.2N!(X>999 999)!(X<-9 99999) X
	10918	"^DD",433, 433,95,3)
	10919	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10920	"^DD",433, 433,95,21, 0)
	10921	^.001^1^1^ 3160428^^
	10922	"^DD",433, 433,95,21, 1,0)
	10923	This is th e transact ion amount associate d with the statement discrepan cy.
	10924	"^DD",433, 433,95,"DT ")
	10925	3160428
	10926	"^DD",433, 433,96,0)
	10927	AUTO-CORRE CTION TYPE OF ERROR^ S^I:INCOMP LETE FLAG ERROR;D:DU PLICATE TR ANSACTION
	10928	;N:NULL TR ANSACTION AMOUNT;X:N OT FIXABLE ;^9;6^Q
	10929	"^DD",433, 433,96,3)
	10930	Type the k ind of sta tement dis crepancy e rror that was correc ted.
	10931	"^DD",433, 433,96,21, 0)
	10932	^^5^5^3161 004^
	10933	"^DD",433, 433,96,21, 1,0)
	10934	This field stores th e type of error that was corre cted
	10935	"^DD",433, 433,96,21, 2,0)
	10936	for the st atement di screpancy. The erro rs are thr ee
	10937	"^DD",433, 433,96,21, 3,0)
	10938	types: inc omplete fl ag error, a duplicat e transact ion,
	10939	"^DD",433, 433,96,21, 4,0)
	10940	a null tra nsaction a mount, or not fixabl e for all other
	10941	"^DD",433, 433,96,21, 5,0)
	10942	errors.
	10943	"^DD",433, 433,96,"DT ")
	10944	3161004
	10945	"^DD",433, 433,97,0)
	10946	AUTO-CORRE CTION TICK ET FLAG^S^ 1:YES;0:NO ;^9;7^Q
	10947	"^DD",433, 433,97,3)
	10948	Enter Yes if this tr ansaction will need to be manu ally revie wed and co rrected.
	10949	"^DD",433, 433,97,21, 0)
	10950	^^2^2^3161 027^
	10951	"^DD",433, 433,97,21, 1,0)
	10952	Flag notin g that thi s transact ion will n eed to be manually r eviewed an d
	10953	"^DD",433, 433,97,21, 2,0)
	10954	corrected.
	10955	"^DD",433, 433,97,"DT ")
	10956	3161027
	10957	"^DIC",349 .1,349.1,0 )
	10958	AR TRANSMI SSION TYPE ^349.1
	10959	"^DIC",349 .1,349.1,0 ,"GL")
	10960	^RCT(349.1 ,
	10961	"^DIC",349 .1,349.1," %D",0)
	10962	^1.001^2^2 ^3160422^^ ^^
	10963	"^DIC",349 .1,349.1," %D",1,0)
	10964	This file stores the transmiss ion types used in fi le 349
	10965	"^DIC",349 .1,349.1," %D",2,0)
	10966	AR TRANSMI SSION RECO RDS.
	10967	"^DIC",349 .1,"B","AR TRANSMISS ION TYPE", 349.1)
	10968
	10969	"^DIC",349 .5,349.5,0 )
	10970	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	10971	"^DIC",349 .5,349.5,0 ,"GL")
	10972	^RCAP(349. 5,
	10973	"^DIC",349 .5,349.5," %",0)
	10974	^1.005^^0
	10975	"^DIC",349 .5,349.5," %D",0)
	10976	^^3^3^3170 223^
	10977	"^DIC",349 .5,349.5," %D",1,0)
	10978	This file will hold all of the previous year's pat ient payme nt data fo r
	10979	"^DIC",349 .5,349.5," %D",2,0)
	10980	that calen dar year a nd persist for only one year t o then be deleted an d
	10981	"^DIC",349 .5,349.5," %D",3,0)
	10982	replaced a t the begi nning of t he next ca lendar yea r.
	10983	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	10984
	10985	"BLD",1011 1,6)
	10986	14^
	10987	$END KID P RCA4.531 3