1. EPMO Open Source Coordination Office Redaction File Detail Report

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

1.1 Files compared

#	Location	File	Last Modified
1	C:\AraxisMergeCompare\Pri_un	PRCA4.5313 TEST v24.KID	Tue Apr 9 12:41:00 2019 UTC
2	C:\AraxisMergeCompare\Pri_re	PRCA4.5313 TEST v24.KID	Thu Apr 11 11:28:50 2019 UTC

1.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	5	21148
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
	2	$KID PRCA* 4.5*313
	3	INSTALL NAME
	4	PRCA4.53 13
	5	"BLD",1073 8,0)
	6	PRCA4.53 13^ACCOUNT S RECEIVAB LE^0^31903 07^y
	7	"BLD",1073 8,1,0)
	8	^^1^1^3190 306^
	9	"BLD",1073 8,1,1,0)
	10	Consolidat ed Patient Statement - PSE
	11	"BLD",1073 8,4,0)
	12	^9.64PA^43 3^7
	13	"BLD",1073 8,4,340,0)
	14	340
	15	"BLD",1073 8,4,340,2, 0)
	16	^9.641^340 ^1
	17	"BLD",1073 8,4,340,2, 340,0)
	18	AR DEBTOR (File-top level)
	19	"BLD",1073 8,4,340,2, 340,1,0)
	20	^9.6411^.0 3^3
	21	"BLD",1073 8,4,340,2, 340,1,.01, 0)
	22	DEBTOR
	23	"BLD",1073 8,4,340,2, 340,1,.03, 0)
	24	STATEMENT DAY
	25	"BLD",1073 8,4,340,2, 340,1,7.06 ,0)
	26	CURRENT CB S DEBT AMO UNT
	27	"BLD",1073 8,4,340,22 2)
	28	y^n^p^^^^n ^^n
	29	"BLD",1073 8,4,340,22 4)
	30
	31	"BLD",1073 8,4,341,0)
	32	341
	33	"BLD",1073 8,4,341,2, 0)
	34	^9.641^341 ^1
	35	"BLD",1073 8,4,341,2, 341,0)
	36	AR EVENT (File-top level)
	37	"BLD",1073 8,4,341,2, 341,1,0)
	38	^9.6411^6. 01^1
	39	"BLD",1073 8,4,341,2, 341,1,6.01 ,0)
	40	CCPC STATE MENT DATE
	41	"BLD",1073 8,4,341,22 2)
	42	y^n^p^^^^n ^^n
	43	"BLD",1073 8,4,341,22 4)
	44
	45	"BLD",1073 8,4,349,0)
	46	349
	47	"BLD",1073 8,4,349,2, 0)
	48	^9.641^349 ^1
	49	"BLD",1073 8,4,349,2, 349,0)
	50	AR TRANSMI SSION RECO RDS (File -top level )
	51	"BLD",1073 8,4,349,2, 349,1,0)
	52	^9.6411^.0 9^1
	53	"BLD",1073 8,4,349,2, 349,1,.09, 0)
	54	STATEMENT DATE
	55	"BLD",1073 8,4,349,22 2)
	56	y^n^p^^^^n ^^n
	57	"BLD",1073 8,4,349,22 4)
	58
	59	"BLD",1073 8,4,349.1, 0)
	60	349.1
	61	"BLD",1073 8,4,349.1, 2,0)
	62	^9.641^349 .11^3
	63	"BLD",1073 8,4,349.1, 2,349.11,0 )
	64	LOCAL ADDR ESSEE (su b-file)
	65	"BLD",1073 8,4,349.1, 2,349.11,1 ,0)
	66	^9.6411^^
	67	"BLD",1073 8,4,349.1, 2,349.141, 0)
	68	MESSAGE AC KNOWLEDGEM ENT (sub- file)
	69	"BLD",1073 8,4,349.1, 2,349.141, 1,0)
	70	^9.6411^^
	71	"BLD",1073 8,4,349.1, 2,349.151, 0)
	72	ACK MESSAG ES (sub-f ile)
	73	"BLD",1073 8,4,349.1, 2,349.151, 1,0)
	74	^9.6411^.0 4^2
	75	"BLD",1073 8,4,349.1, 2,349.151, 1,.01,0)
	76	ACK MESSAG ES
	77	"BLD",1073 8,4,349.1, 2,349.151, 1,.04,0)
	78	PATIENT ST ATEMENT DA TE
	79	"BLD",1073 8,4,349.1, 222)
	80	y^n^p^^^^n ^^n
	81	"BLD",1073 8,4,349.1, 224)
	82
	83	"BLD",1073 8,4,349.2, 0)
	84	349.2
	85	"BLD",1073 8,4,349.2, 2,0)
	86	^9.641^349 .2^1
	87	"BLD",1073 8,4,349.2, 2,349.2,0)
	88	AR CBSS ST ATEMENTS (File-top level)
	89	"BLD",1073 8,4,349.2, 2,349.2,1, 0)
	90	^9.6411^61 ^10
	91	"BLD",1073 8,4,349.2, 2,349.2,1, .01,0)
	92	PATIENT
	93	"BLD",1073 8,4,349.2, 2,349.2,1, .12,0)
	94	INVALID ST ATEMENT ER ROR
	95	"BLD",1073 8,4,349.2, 2,349.2,1, .18,0)
	96	CBSS FILE BUILT
	97	"BLD",1073 8,4,349.2, 2,349.2,1, .19,0)
	98	PATIENT ST ATEMENT DA TE
	99	"BLD",1073 8,4,349.2, 2,349.2,1, 51,0)
	100	ERROR CODE (S)
	101	"BLD",1073 8,4,349.2, 2,349.2,1, 61,0)
	102	CBSS PRINT ED
	103	"BLD",1073 8,4,349.2, 2,349.2,1, 81,0)
	104	INTEGRATIO N CONTROL NUMBER
	105	"BLD",1073 8,4,349.2, 2,349.2,1, 82,0)
	106	ICN CHECKS UM
	107	"BLD",1073 8,4,349.2, 2,349.2,1, 83,0)
	108	AR FLAG
	109	"BLD",1073 8,4,349.2, 2,349.2,1, 84,0)
	110	DATE OF LA TEST BILL
	111	"BLD",1073 8,4,349.2, 222)
	112	y^n^p^^^^n ^^n
	113	"BLD",1073 8,4,349.2, 224)
	114
	115	"BLD",1073 8,4,349.5, 0)
	116	349.5
	117	"BLD",1073 8,4,349.5, 222)
	118	y^n^f^^^^n ^^n
	119	"BLD",1073 8,4,349.5, 224)
	120
	121	"BLD",1073 8,4,433,0)
	122	433
	123	"BLD",1073 8,4,433,2, 0)
	124	^9.641^433 ^1
	125	"BLD",1073 8,4,433,2, 433,0)
	126	AR TRANSAC TION (Fil e-top leve l)
	127	"BLD",1073 8,4,433,2, 433,1,0)
	128	^9.6411^97 ^4
	129	"BLD",1073 8,4,433,2, 433,1,94,0 )
	130	AUTO-CORRE CTION DATE
	131	"BLD",1073 8,4,433,2, 433,1,95,0 )
	132	AUTO-CORRE CTION TRAN S. AMOUNT
	133	"BLD",1073 8,4,433,2, 433,1,96,0 )
	134	AUTO-CORRE CTION TYPE OF ERROR
	135	"BLD",1073 8,4,433,2, 433,1,97,0 )
	136	AUTO-CORRE CTION TICK ET FLAG
	137	"BLD",1073 8,4,433,22 2)
	138	y^n^p^^^^n ^^n
	139	"BLD",1073 8,4,433,22 4)
	140
	141	"BLD",1073 8,4,"APDD" ,340,340)
	142
	143	"BLD",1073 8,4,"APDD" ,340,340,. 01)
	144
	145	"BLD",1073 8,4,"APDD" ,340,340,. 03)
	146
	147	"BLD",1073 8,4,"APDD" ,340,340,7 .06)
	148
	149	"BLD",1073 8,4,"APDD" ,341,341)
	150
	151	"BLD",1073 8,4,"APDD" ,341,341,6 .01)
	152
	153	"BLD",1073 8,4,"APDD" ,349,349)
	154
	155	"BLD",1073 8,4,"APDD" ,349,349,. 09)
	156
	157	"BLD",1073 8,4,"APDD" ,349.1,349 .11)
	158
	159	"BLD",1073 8,4,"APDD" ,349.1,349 .141)
	160
	161	"BLD",1073 8,4,"APDD" ,349.1,349 .151)
	162
	163	"BLD",1073 8,4,"APDD" ,349.1,349 .151,.01)
	164
	165	"BLD",1073 8,4,"APDD" ,349.1,349 .151,.04)
	166
	167	"BLD",1073 8,4,"APDD" ,349.2,349 .2)
	168
	169	"BLD",1073 8,4,"APDD" ,349.2,349 .2,.01)
	170
	171	"BLD",1073 8,4,"APDD" ,349.2,349 .2,.12)
	172
	173	"BLD",1073 8,4,"APDD" ,349.2,349 .2,.18)
	174
	175	"BLD",1073 8,4,"APDD" ,349.2,349 .2,.19)
	176
	177	"BLD",1073 8,4,"APDD" ,349.2,349 .2,51)
	178
	179	"BLD",1073 8,4,"APDD" ,349.2,349 .2,61)
	180
	181	"BLD",1073 8,4,"APDD" ,349.2,349 .2,81)
	182
	183	"BLD",1073 8,4,"APDD" ,349.2,349 .2,82)
	184
	185	"BLD",1073 8,4,"APDD" ,349.2,349 .2,83)
	186
	187	"BLD",1073 8,4,"APDD" ,349.2,349 .2,84)
	188
	189	"BLD",1073 8,4,"APDD" ,433,433)
	190
	191	"BLD",1073 8,4,"APDD" ,433,433,9 4)
	192
	193	"BLD",1073 8,4,"APDD" ,433,433,9 5)
	194
	195	"BLD",1073 8,4,"APDD" ,433,433,9 6)
	196
	197	"BLD",1073 8,4,"APDD" ,433,433,9 7)
	198
	199	"BLD",1073 8,4,"B",34 0,340)
	200
	201	"BLD",1073 8,4,"B",34 1,341)
	202
	203	"BLD",1073 8,4,"B",34 9,349)
	204
	205	"BLD",1073 8,4,"B",34 9.1,349.1)
	206
	207	"BLD",1073 8,4,"B",34 9.2,349.2)
	208
	209	"BLD",1073 8,4,"B",34 9.5,349.5)
	210
	211	"BLD",1073 8,4,"B",43 3,433)
	212
	213	"BLD",1073 8,6)
	214	22^
	215	"BLD",1073 8,6.3)
	216	150
	217	"BLD",1073 8,"ABPKG")
	218	n
	219	"BLD",1073 8,"INI")
	220	PRE^PRCA31 3P
	221	"BLD",1073 8,"INID")
	222	n^n^n
	223	"BLD",1073 8,"INIT")
	224	EN^PRCA313 P
	225	"BLD",1073 8,"KRN",0)
	226	^9.67PA^77 9.2^20
	227	"BLD",1073 8,"KRN",.4 ,0)
	228	.4
	229	"BLD",1073 8,"KRN",.4 ,"NM",0)
	230	^9.68A^^0
	231	"BLD",1073 8,"KRN",.4 01,0)
	232	.401
	233	"BLD",1073 8,"KRN",.4 02,0)
	234	.402
	235	"BLD",1073 8,"KRN",.4 02,"NM",0)
	236	^9.68A^^0
	237	"BLD",1073 8,"KRN",.4 03,0)
	238	.403
	239	"BLD",1073 8,"KRN",.5 ,0)
	240	.5
	241	"BLD",1073 8,"KRN",.8 4,0)
	242	.84
	243	"BLD",1073 8,"KRN",3. 6,0)
	244	3.6
	245	"BLD",1073 8,"KRN",3. 8,0)
	246	3.8
	247	"BLD",1073 8,"KRN",3. 8,"NM",0)
	248	^9.68A^1^1
	249	"BLD",1073 8,"KRN",3. 8,"NM",1,0 )
	250	PRCACPS^^0
	251	"BLD",1073 8,"KRN",3. 8,"NM","B" ,"PRCACPS" ,1)
	252
	253	"BLD",1073 8,"KRN",9. 2,0)
	254	9.2
	255	"BLD",1073 8,"KRN",9. 8,0)
	256	9.8
	257	"BLD",1073 8,"KRN",9. 8,"NM",0)
	258	^9.68A^30^ 22
	259	"BLD",1073 8,"KRN",9. 8,"NM",5,0 )
	260	RCCPCBJ^^0 ^B10271413
	261	"BLD",1073 8,"KRN",9. 8,"NM",7,0 )
	262	RCCPCFN1^^ 0^B7142506
	263	"BLD",1073 8,"KRN",9. 8,"NM",8,0 )
	264	RCCPCML^^0 ^B64731204
	265	"BLD",1073 8,"KRN",9. 8,"NM",9,0 )
	266	RCCPCSV^^0 ^B11825361
	267	"BLD",1073 8,"KRN",9. 8,"NM",10, 0)
	268	RCCPCPS^^0 ^B20768363 6
	269	"BLD",1073 8,"KRN",9. 8,"NM",11, 0)
	270	RCCPCPS1^^ 0^B6555258 2
	271	"BLD",1073 8,"KRN",9. 8,"NM",12, 0)
	272	RCCPCSV1^^ 0^B4364581 7
	273	"BLD",1073 8,"KRN",9. 8,"NM",13, 0)
	274	RCCPCML1^^ 0^B1607977 8
	275	"BLD",1073 8,"KRN",9. 8,"NM",14, 0)
	276	RCCPCSE^^0 ^B16507603
	277	"BLD",1073 8,"KRN",9. 8,"NM",15, 0)
	278	RCCPCT^^0^ B29330001
	279	"BLD",1073 8,"KRN",9. 8,"NM",17, 0)
	280	PRCAG^^0^B 75399507
	281	"BLD",1073 8,"KRN",9. 8,"NM",18, 0)
	282	PRCA313P^^ 0^B3376302 3
	283	"BLD",1073 8,"KRN",9. 8,"NM",19, 0)
	284	PRCAACR^^0 ^B12733608 1
	285	"BLD",1073 8,"KRN",9. 8,"NM",20, 0)
	286	PRCAACR1^^ 0^B1512714 41
	287	"BLD",1073 8,"KRN",9. 8,"NM",21, 0)
	288	RCCPCAP^^0 ^B54508064
	289	"BLD",1073 8,"KRN",9. 8,"NM",22, 0)
	290	RCCPCAT^^0 ^B58409959
	291	"BLD",1073 8,"KRN",9. 8,"NM",23, 0)
	292	RCCPCAR^^0 ^B51376653
	293	"BLD",1073 8,"KRN",9. 8,"NM",26, 0)
	294	RCDPBTLM^^ 0^B5884942 2
	295	"BLD",1073 8,"KRN",9. 8,"NM",27, 0)
	296	PRCACPS^^0 ^B25406671 6
	297	"BLD",1073 8,"KRN",9. 8,"NM",28, 0)
	298	PRCACPS1^^ 0^B2026699 6
	299	"BLD",1073 8,"KRN",9. 8,"NM",29, 0)
	300	PRCACPSA^^ 0^B3327065 3
	301	"BLD",1073 8,"KRN",9. 8,"NM",30, 0)
	302	RCBECHGS^^ 0^B1451695 2
	303	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCA313P ",18)
	304
	305	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCAACR" ,19)
	306
	307	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCAACR1 ",20)
	308
	309	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCACPS" ,27)
	310
	311	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCACPS1 ",28)
	312
	313	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCACPSA ",29)
	314
	315	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"PRCAG",1 7)
	316
	317	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCBECHGS ",30)
	318
	319	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCAP" ,21)
	320
	321	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCAR" ,23)
	322
	323	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCAT" ,22)
	324
	325	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCBJ" ,5)
	326
	327	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCFN1 ",7)
	328
	329	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCML" ,8)
	330
	331	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCML1 ",13)
	332
	333	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCPS" ,10)
	334
	335	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCPS1 ",11)
	336
	337	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCSE" ,14)
	338
	339	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCSV" ,9)
	340
	341	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCSV1 ",12)
	342
	343	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCCPCT", 15)
	344
	345	"BLD",1073 8,"KRN",9. 8,"NM","B" ,"RCDPBTLM ",26)
	346
	347	"BLD",1073 8,"KRN",19 ,0)
	348	19
	349	"BLD",1073 8,"KRN",19 ,"NM",0)
	350	^9.68A^11^ 8
	351	"BLD",1073 8,"KRN",19 ,"NM",4,0)
	352	PRCA CBS N IGHTLY UPD ATE^^0
	353	"BLD",1073 8,"KRN",19 ,"NM",5,0)
	354	PRCAE FOLL OW-UP^^2
	355	"BLD",1073 8,"KRN",19 ,"NM",6,0)
	356	RCCPC APPS BUILD AND TRANS^^0
	357	"BLD",1073 8,"KRN",19 ,"NM",7,0)
	358	RCCPC APPS RETRANS^^ 0
	359	"BLD",1073 8,"KRN",19 ,"NM",8,0)
	360	RCCPC APPS DATA CHEC K^^0
	361	"BLD",1073 8,"KRN",19 ,"NM",9,0)
	362	PRCA ACCOU NT MANAGEM ENT^^2
	363	"BLD",1073 8,"KRN",19 ,"NM",10,0 )
	364	PRCA AUTOC RCT PGM^^0
	365	"BLD",1073 8,"KRN",19 ,"NM",11,0 )
	366	PRCA AUTOC RCT RPT^^0
	367	"BLD",1073 8,"KRN",19 ,"NM","B", "PRCA ACCO UNT MANAGE MENT",9)
	368
	369	"BLD",1073 8,"KRN",19 ,"NM","B", "PRCA AUTO CRCT PGM", 10)
	370
	371	"BLD",1073 8,"KRN",19 ,"NM","B", "PRCA AUTO CRCT RPT", 11)
	372
	373	"BLD",1073 8,"KRN",19 ,"NM","B", "PRCA CBS NIGHTLY UP DATE",4)
	374
	375	"BLD",1073 8,"KRN",19 ,"NM","B", "PRCAE FOL LOW-UP",5)
	376
	377	"BLD",1073 8,"KRN",19 ,"NM","B", "RCCPC APP S BUILD AN D TRANS",6 )
	378
	379	"BLD",1073 8,"KRN",19 ,"NM","B", "RCCPC APP S DATA CHE CK",8)
	380
	381	"BLD",1073 8,"KRN",19 ,"NM","B", "RCCPC APP S RETRANS" ,7)
	382
	383	"BLD",1073 8,"KRN",19 .1,0)
	384	19.1
	385	"BLD",1073 8,"KRN",19 .1,"NM",0)
	386	^9.68A^2^2
	387	"BLD",1073 8,"KRN",19 .1,"NM",1, 0)
	388	RCCPC APPS BUILD AND TRANS^^0
	389	"BLD",1073 8,"KRN",19 .1,"NM",2, 0)
	390	PRCA AUTOC RCT PGM^^0
	391	"BLD",1073 8,"KRN",19 .1,"NM","B ","PRCA AU TOCRCT PGM ",2)
	392
	393	"BLD",1073 8,"KRN",19 .1,"NM","B ","RCCPC A PPS BUILD AND TRANS" ,1)
	394
	395	"BLD",1073 8,"KRN",10 1,0)
	396	101
	397	"BLD",1073 8,"KRN",40 9.61,0)
	398	409.61
	399	"BLD",1073 8,"KRN",77 1,0)
	400	771
	401	"BLD",1073 8,"KRN",77 9.2,0)
	402	779.2
	403	"BLD",1073 8,"KRN",87 0,0)
	404	870
	405	"BLD",1073 8,"KRN",89 89.51,0)
	406	8989.51
	407	"BLD",1073 8,"KRN",89 89.52,0)
	408	8989.52
	409	"BLD",1073 8,"KRN",89 94,0)
	410	8994
	411	"BLD",1073 8,"KRN","B ",.4,.4)
	412
	413	"BLD",1073 8,"KRN","B ",.401,.40 1)
	414
	415	"BLD",1073 8,"KRN","B ",.402,.40 2)
	416
	417	"BLD",1073 8,"KRN","B ",.403,.40 3)
	418
	419	"BLD",1073 8,"KRN","B ",.5,.5)
	420
	421	"BLD",1073 8,"KRN","B ",.84,.84)
	422
	423	"BLD",1073 8,"KRN","B ",3.6,3.6)
	424
	425	"BLD",1073 8,"KRN","B ",3.8,3.8)
	426
	427	"BLD",1073 8,"KRN","B ",9.2,9.2)
	428
	429	"BLD",1073 8,"KRN","B ",9.8,9.8)
	430
	431	"BLD",1073 8,"KRN","B ",19,19)
	432
	433	"BLD",1073 8,"KRN","B ",19.1,19. 1)
	434
	435	"BLD",1073 8,"KRN","B ",101,101)
	436
	437	"BLD",1073 8,"KRN","B ",409.61,4 09.61)
	438
	439	"BLD",1073 8,"KRN","B ",771,771)
	440
	441	"BLD",1073 8,"KRN","B ",779.2,77 9.2)
	442
	443	"BLD",1073 8,"KRN","B ",870,870)
	444
	445	"BLD",1073 8,"KRN","B ",8989.51, 8989.51)
	446
	447	"BLD",1073 8,"KRN","B ",8989.52, 8989.52)
	448
	449	"BLD",1073 8,"KRN","B ",8994,899 4)
	450
	451	"BLD",1073 8,"PRE")
	452	PRCA313E
	453	"BLD",1073 8,"QDEF")
	454	^^^^NO^^^^ YES^^YES
	455	"BLD",1073 8,"QUES",0 )
	456	^9.62^^
	457	"BLD",1073 8,"REQB",0 )
	458	^9.611^6^5
	459	"BLD",1073 8,"REQB",2 ,0)
	460	XMDB1.00 ^2
	461	"BLD",1073 8,"REQB",3 ,0)
	462	PRCA4.52 60^2
	463	"BLD",1073 8,"REQB",4 ,0)
	464	PRCA4.58 7^2
	465	"BLD",1073 8,"REQB",5 ,0)
	466	PRCA4.53 01^2
	467	"BLD",1073 8,"REQB",6 ,0)
	468	PRCA4.53 15^2
	469	"BLD",1073 8,"REQB"," B","PRCA4 .5260",3)
	470
	471	"BLD",1073 8,"REQB"," B","PRCA4 .5301",5)
	472
	473	"BLD",1073 8,"REQB"," B","PRCA4 .5315",6)
	474
	475	"BLD",1073 8,"REQB"," B","PRCA4 .587",4)
	476
	477	"BLD",1073 8,"REQB"," B","XMDB1 .00",2)
	478
	479	"FIA",340)
	480	AR DEBTOR
	481	"FIA",340, 0)
	482	^RCD(340,
	483	"FIA",340, 0,0)
	484	340V
	485	"FIA",340, 0,1)
	486	y^n^p^^^^n ^^n
	487	"FIA",340, 0,10)
	488
	489	"FIA",340, 0,11)
	490
	491	"FIA",340, 0,"RLRO")
	492
	493	"FIA",340, 0,"VR")
	494	4.5^PRCA
	495	"FIA",340, 340)
	496	1
	497	"FIA",340, 340,.01)
	498
	499	"FIA",340, 340,.03)
	500
	501	"FIA",340, 340,7.06)
	502
	503	"FIA",341)
	504	AR EVENT
	505	"FIA",341, 0)
	506	^RC(341,
	507	"FIA",341, 0,0)
	508	341I
	509	"FIA",341, 0,1)
	510	y^n^p^^^^n ^^n
	511	"FIA",341, 0,10)
	512
	513	"FIA",341, 0,11)
	514
	515	"FIA",341, 0,"RLRO")
	516
	517	"FIA",341, 0,"VR")
	518	4.5^PRCA
	519	"FIA",341, 341)
	520	1
	521	"FIA",341, 341,6.01)
	522
	523	"FIA",349)
	524	AR TRANSMI SSION RECO RDS
	525	"FIA",349, 0)
	526	^RCT(349,
	527	"FIA",349, 0,0)
	528	349I
	529	"FIA",349, 0,1)
	530	y^n^p^^^^n ^^n
	531	"FIA",349, 0,10)
	532
	533	"FIA",349, 0,11)
	534
	535	"FIA",349, 0,"RLRO")
	536
	537	"FIA",349, 0,"VR")
	538	4.5^PRCA
	539	"FIA",349, 349)
	540	1
	541	"FIA",349, 349,.09)
	542
	543	"FIA",349. 1)
	544	AR TRANSMI SSION TYPE
	545	"FIA",349. 1,0)
	546	^RCT(349.1 ,
	547	"FIA",349. 1,0,0)
	548	349.1I
	549	"FIA",349. 1,0,1)
	550	y^n^p^^^^n ^^n
	551	"FIA",349. 1,0,10)
	552
	553	"FIA",349. 1,0,11)
	554
	555	"FIA",349. 1,0,"RLRO" )
	556
	557	"FIA",349. 1,0,"VR")
	558	4.5^PRCA
	559	"FIA",349. 1,349.1)
	560	1
	561	"FIA",349. 1,349.1,1)
	562
	563	"FIA",349. 1,349.1,40 )
	564
	565	"FIA",349. 1,349.1,51 )
	566
	567	"FIA",349. 1,349.11)
	568	0
	569	"FIA",349. 1,349.141)
	570	0
	571	"FIA",349. 1,349.151)
	572	1
	573	"FIA",349. 1,349.151, .01)
	574
	575	"FIA",349. 1,349.151, .04)
	576
	577	"FIA",349. 2)
	578	AR CBSS ST ATEMENTS
	579	"FIA",349. 2,0)
	580	^RCPS(349. 2,
	581	"FIA",349. 2,0,0)
	582	349.2I
	583	"FIA",349. 2,0,1)
	584	y^n^p^^^^n ^^n
	585	"FIA",349. 2,0,10)
	586
	587	"FIA",349. 2,0,11)
	588
	589	"FIA",349. 2,0,"RLRO" )
	590
	591	"FIA",349. 2,0,"VR")
	592	4.5^PRCA
	593	"FIA",349. 2,349.2)
	594	1
	595	"FIA",349. 2,349.2,.0 1)
	596
	597	"FIA",349. 2,349.2,.1 2)
	598
	599	"FIA",349. 2,349.2,.1 8)
	600
	601	"FIA",349. 2,349.2,.1 9)
	602
	603	"FIA",349. 2,349.2,51 )
	604
	605	"FIA",349. 2,349.2,61 )
	606
	607	"FIA",349. 2,349.2,81 )
	608
	609	"FIA",349. 2,349.2,82 )
	610
	611	"FIA",349. 2,349.2,83 )
	612
	613	"FIA",349. 2,349.2,84 )
	614
	615	"FIA",349. 5)
	616	AR ANNUAL PAYMENT ST ATEMENT
	617	"FIA",349. 5,0)
	618	^RCAP(349. 5,
	619	"FIA",349. 5,0,0)
	620	349.5
	621	"FIA",349. 5,0,1)
	622	y^n^f^^^^n ^^n
	623	"FIA",349. 5,0,10)
	624
	625	"FIA",349. 5,0,11)
	626
	627	"FIA",349. 5,0,"RLRO" )
	628
	629	"FIA",349. 5,0,"VR")
	630	4.5^PRCA
	631	"FIA",349. 5,349.5)
	632	0
	633	"FIA",349. 5,349.51)
	634	0
	635	"FIA",433)
	636	AR TRANSAC TION
	637	"FIA",433, 0)
	638	^PRCA(433,
	639	"FIA",433, 0,0)
	640	433NI
	641	"FIA",433, 0,1)
	642	y^n^p^^^^n ^^n
	643	"FIA",433, 0,10)
	644
	645	"FIA",433, 0,11)
	646
	647	"FIA",433, 0,"RLRO")
	648
	649	"FIA",433, 0,"VR")
	650	4.5^PRCA
	651	"FIA",433, 433)
	652	1
	653	"FIA",433, 433,94)
	654
	655	"FIA",433, 433,95)
	656
	657	"FIA",433, 433,96)
	658
	659	"FIA",433, 433,97)
	660
	661	"INI")
	662	PRE^PRCA31 3P
	663	"INIT")
	664	EN^PRCA313 P
	665	"IX",349,3 49,"SDT",0 )
	666	349^SDT^Pa tient Stat ement Day of the Mon th^R^^F^IR ^I^349^^^^ ^LS
	667	"IX",349,3 49,"SDT",. 1,0)
	668	^^1^1^3161 007^
	669	"IX",349,3 49,"SDT",. 1,1,0)
	670	This cross -reference is the Pa tient Stat ement Day of the Mon th.
	671	"IX",349,3 49,"SDT",1 )
	672	S ^RCT(349 ,"SDT",$E( X,1,2),DA) =""
	673	"IX",349,3 49,"SDT",2 )
	674	K ^RCT(349 ,"SDT",$E( X,1,2),DA)
	675	"IX",349,3 49,"SDT",2 .5)
	676	K ^RCT(349 ,"SDT")
	677	"IX",349,3 49,"SDT",1 1.1,0)
	678	^.114IA^1^ 1
	679	"IX",349,3 49,"SDT",1 1.1,1,0)
	680	1^F^349^.0 9^2^1^F
	681	"IX",349,3 49,"SDT",1 1.1,1,2)
	682	S X=+$E(X, 6,7)
	683	"IX",349.1 ,349.141," STDT4",0)
	684	349.141^ST DT4^Patien t Statemen t Date and Last Mess age ACK^R^ ^R^IR^I^34 9.141^^^^^ LS
	685	"IX",349.1 ,349.141," STDT4",.1, 0)
	686	^^2^2^3161 007^
	687	"IX",349.1 ,349.141," STDT4",.1, 1,0)
	688	This cross -reference is used t o sort by the Patien t Statemen t Date and the
	689	"IX",349.1 ,349.141," STDT4",.1, 2,0)
	690	Last Messa ge ACK.
	691	"IX",349.1 ,349.141," STDT4",1)
	692	S ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)=" "
	693	"IX",349.1 ,349.141," STDT4",2)
	694	K ^RCT(349 .1,DA(1),4 ,"STDT4",$ E(X(1),1,7 ),$E(X(2), 1,3),DA)
	695	"IX",349.1 ,349.141," STDT4",2.5 )
	696	K ^RCT(349 .1,DA(1),4 ,"STDT4")
	697	"IX",349.1 ,349.141," STDT4",11. 1,0)
	698	^.114IA^2^ 2
	699	"IX",349.1 ,349.141," STDT4",11. 1,1,0)
	700	1^F^349.14 1^.04^7^1^ F
	701	"IX",349.1 ,349.141," STDT4",11. 1,1,3)
	702
	703	"IX",349.1 ,349.141," STDT4",11. 1,2,0)
	704	2^F^349.14 1^.01^3^2^ F
	705	"IX",349.1 ,349.141," STDT4",11. 1,2,3)
	706
	707	"IX",349.1 ,349.151," STDT5",0)
	708	349.151^ST DT5^Patien t Statemen t Date Ind ex^R^^F^IR ^I^349.151 ^^^^^LS
	709	"IX",349.1 ,349.151," STDT5",.1, 0)
	710	^^1^1^3161 006^
	711	"IX",349.1 ,349.151," STDT5",.1, 1,0)
	712	This cross -reference is used t o sort by the Patien t Statemen t Date.
	713	"IX",349.1 ,349.151," STDT5",1)
	714	S ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)=""
	715	"IX",349.1 ,349.151," STDT5",2)
	716	K ^RCT(349 .1,DA(1),5 ,"STDT5",$ E(X,1,7),D A)
	717	"IX",349.1 ,349.151," STDT5",2.5 )
	718	K ^RCT(349 .1,DA(1),5 ,"STDT5")
	719	"IX",349.1 ,349.151," STDT5",11. 1,0)
	720	^.114IA^1^ 1
	721	"IX",349.1 ,349.151," STDT5",11. 1,1,0)
	722	1^F^349.15 1^.04^7^1^ F
	723	"IX",349.2 ,349.2,"ST DT",0)
	724	349.2^STDT ^Patient S tatement D ate^R^^F^I R^I^349.2^ ^^^^LS
	725	"IX",349.2 ,349.2,"ST DT",.1,0)
	726	^^2^2^3161 007^
	727	"IX",349.2 ,349.2,"ST DT",.1,1,0 )
	728	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	729	"IX",349.2 ,349.2,"ST DT",.1,2,0 )
	730	standardly two days after the statement is transmi tted.
	731	"IX",349.2 ,349.2,"ST DT",1)
	732	S ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)=""
	733	"IX",349.2 ,349.2,"ST DT",2)
	734	K ^RCPS(34 9.2,"STDT" ,$E(X,1,7) ,DA)
	735	"IX",349.2 ,349.2,"ST DT",2.5)
	736	K ^RCPS(34 9.2,"STDT" )
	737	"IX",349.2 ,349.2,"ST DT",11.1,0 )
	738	^.114IA^1^ 1
	739	"IX",349.2 ,349.2,"ST DT",11.1,1 ,0)
	740	1^F^349.2^ .19^7^1^F
	741	"IX",433,4 33,"TACD", 0)
	742	433^TACD^T he date th at this tr ansaction was correc ted by the Auto-Corr ection
	743	Program.^R ^^F^IR^I^4 33^^^^^LS
	744	"IX",433,4 33,"TACD", .1,0)
	745	^^2^2^3160 920^
	746	"IX",433,4 33,"TACD", .1,1,0)
	747	The is the date that the Patie nt Stateme nt Auto-Co rrection P rogram
	748	"IX",433,4 33,"TACD", .1,2,0)
	749	corrected the statem ent discre pancy for this trans action.
	750	"IX",433,4 33,"TACD", 1)
	751	S ^PRCA(43 3,"TACD",$ E(X,1,7),D A)=""
	752	"IX",433,4 33,"TACD", 2)
	753	K ^PRCA(43 3,"TACD",$ E(X,1,7),D A)
	754	"IX",433,4 33,"TACD", 2.5)
	755	K ^PRCA(43 3,"TACD")
	756	"IX",433,4 33,"TACD", 11.1,0)
	757	^.114IA^1^ 1
	758	"IX",433,4 33,"TACD", 11.1,1,0)
	759	1^F^433^94 ^7^1^F
	760	"IX",433,4 33,"TACD", "NOREINDEX ")
	761	1
	762	"KRN",3.8, 6303,-1)
	763	0^1
	764	"KRN",3.8, 6303,0)
	765	PRCACPS^PU ^^^^^
	766	"KRN",3.8, 6303,2,0)
	767	^3.801^2^2 ^3160406^^ ^
	768	"KRN",3.8, 6303,2,1,0 )
	769	This mail group will receive a notificat ion when t he Consoli dated
	770	"KRN",3.8, 6303,2,2,0 )
	771	Patient St atement Au to-Correct ion progra m has comp leted.
	772	"KRN",3.8, 6303,3)
	773
	774	"KRN",3.8, 6303,5,0)
	775	^3.811P^1^ 1
	776	"KRN",3.8, 6303,5,1,0 )
	777	PRCA ADJUS TMENT TRAN S
	778	"KRN",19,1 417,-1)
	779	2^5
	780	"KRN",19,1 417,0)
	781	PRCAE FOLL OW-UP^Foll ow-up Lett er Menu^^M ^1159^^^^^ ^^142
	782	"KRN",19,1 417,10,0)
	783	^19.01IP^1 9^19
	784	"KRN",19,1 417,10,17, 0)
	785	14244^^14
	786	"KRN",19,1 417,10,17, "^")
	787	RCCPC APPS BUILD AND TRANS
	788	"KRN",19,1 417,10,18, 0)
	789	14245^^15
	790	"KRN",19,1 417,10,18, "^")
	791	RCCPC APPS RETRANS
	792	"KRN",19,1 417,10,19, 0)
	793	14246^^16
	794	"KRN",19,1 417,10,19, "^")
	795	RCCPC APPS DATA CHEC K
	796	"KRN",19,1 417,"U")
	797	FOLLOW-UP LETTER MEN U
	798	"KRN",19,5 007,-1)
	799	2^9
	800	"KRN",19,5 007,0)
	801	PRCA ACCOU NT MANAGEM ENT^Accoun t Manageme nt^^M^1159 ^^^^^^^142
	802	"KRN",19,5 007,10,0)
	803	^19.01IP^1 8^18
	804	"KRN",19,5 007,10,16, 0)
	805	14247^^2
	806	"KRN",19,5 007,10,16, "^")
	807	PRCA AUTOC RCT PGM
	808	"KRN",19,5 007,10,17, 0)
	809	14248^^1
	810	"KRN",19,5 007,10,17, "^")
	811	PRCA AUTOC RCT RPT
	812	"KRN",19,5 007,10,18, 0)
	813	14243^^3
	814	"KRN",19,5 007,10,18, "^")
	815	PRCA CBS N IGHTLY UPD ATE
	816	"KRN",19,5 007,"U")
	817	ACCOUNT MA NAGEMENT
	818	"KRN",19,1 4243,-1)
	819	0^4
	820	"KRN",19,1 4243,0)
	821	PRCA CBS N IGHTLY UPD ATE^CBS Ni ghtly Acco unt Update Program^^ R^^^^^^^^
	822	"KRN",19,1 4243,1,0)
	823	^^2^2^3160 622^
	824	"KRN",19,1 4243,1,1,0 )
	825	This optio n runs the Consolida ted Billin g System
	826	"KRN",19,1 4243,1,2,0 )
	827	Nightly Ac count Upda te program .
	828	"KRN",19,1 4243,25)
	829	ENTER^PRCA CPS1
	830	"KRN",19,1 4243,"U")
	831	CBS NIGHTL Y ACCOUNT UPDATE PRO
	832	"KRN",19,1 4244,-1)
	833	0^6
	834	"KRN",19,1 4244,0)
	835	RCCPC APPS BUILD AND TRANS^Bui ld and Tra nsmit Annu al Payment File^^A^^ RCCPC APPS BUILD AND
	836	TRANS^^^^^ ^^^1
	837	"KRN",19,1 4244,1,0)
	838	^19.06^3^3 ^3170502^^ ^
	839	"KRN",19,1 4244,1,1,0 )
	840	This optio n will bui ld the Ann ual Paymen t Statemen t file for the previ ous
	841	"KRN",19,1 4244,1,2,0 )
	842	year for e very patie nt who has one or mo re payment s in the p revious ye ar
	843	"KRN",19,1 4244,1,3,0 )
	844	and transm it the fil e to AITC.
	845	"KRN",19,1 4244,20)
	846	D MANBLD^R CCPCAT
	847	"KRN",19,1 4244,"U")
	848	BUILD AND TRANSMIT A NNUAL PAYM
	849	"KRN",19,1 4245,-1)
	850	0^7
	851	"KRN",19,1 4245,0)
	852	RCCPC APPS RETRANS^R etransmit Current An nual Payme nt File^^A ^^RCCPC AP PS BUILD A ND
	853	TRANS^^^^^ ^^^1
	854	"KRN",19,1 4245,1,0)
	855	^19.06^3^3 ^3170502^^ ^^
	856	"KRN",19,1 4245,1,1,0 )
	857	This optio n should o nly to be used when AITC has r equested t he current
	858	"KRN",19,1 4245,1,2,0 )
	859	Annual Pay ment State ment file be retrans mitted. Th is file wi ll include
	860	"KRN",19,1 4245,1,3,0 )
	861	every pati ent who ha s one or m ore paymen ts in the previous y ear.
	862	"KRN",19,1 4245,20)
	863	D RETRANS^ RCCPCAT
	864	"KRN",19,1 4245,"U")
	865	RETRANSMIT CURRENT A NNUAL PAYM
	866	"KRN",19,1 4246,-1)
	867	0^8
	868	"KRN",19,1 4246,0)
	869	RCCPC APPS DATA CHEC K^Annual P ayment Fil e Consiste ncy Check^ ^A^^^^^^^^ ^^1
	870	"KRN",19,1 4246,1,0)
	871	^^5^5^3170 321^
	872	"KRN",19,1 4246,1,1,0 )
	873	AR data is extracted from the VistA site s and is s ent to CBS S who then
	874	"KRN",19,1 4246,1,2,0 )
	875	consolidat es the dat a into the annual pa yment stat ement. The VistA dat a
	876	"KRN",19,1 4246,1,3,0 )
	877	needs to b e validate d prior to its trans mission. T his menu o ption will
	878	"KRN",19,1 4246,1,4,0 )
	879	produce a report det ailing whi ch APPS da ta needs t o be revie wed and
	880	"KRN",19,1 4246,1,5,0 )
	881	updated pr ior to its transmiss ion to CBS S.
	882	"KRN",19,1 4246,20)
	883	D MANBLD^R CCPCAR
	884	"KRN",19,1 4246,"U")
	885	ANNUAL PAY MENT FILE CONSISTENC
	886	"KRN",19,1 4247,-1)
	887	0^10
	888	"KRN",19,1 4247,0)
	889	PRCA AUTOC RCT PGM^Pa tient Stat ement Auto -Correctio n Program^ ^R^^PRCA A UTOCRCT PG M^^^^^^
	890	"KRN",19,1 4247,1,0)
	891	^^2^2^3170 518^
	892	"KRN",19,1 4247,1,1,0 )
	893	This optio n runs the Auto-Corr ection pro gram for P atient Sta tement
	894	"KRN",19,1 4247,1,2,0 )
	895	discrepanc ies.
	896	"KRN",19,1 4247,25)
	897	BEGIN^PRCA CPS
	898	"KRN",19,1 4247,"U")
	899	PATIENT ST ATEMENT AU TO-CORRECT
	900	"KRN",19,1 4248,-1)
	901	0^11
	902	"KRN",19,1 4248,0)
	903	PRCA AUTOC RCT RPT^Au to-Correct Patient D iscrepancy Report^^R ^^^^^^^^
	904	"KRN",19,1 4248,1,0)
	905	^^2^2^3170 518^
	906	"KRN",19,1 4248,1,1,0 )
	907	This optio n runs the Auto-Corr ection Pat ient Discr epancy Rep ort for
	908	"KRN",19,1 4248,1,2,0 )
	909	correction s made by the Patien t Statemen t Auto-Cor rection Pr ogram.
	910	"KRN",19,1 4248,25)
	911	PSACRT^PRC AACR
	912	"KRN",19,1 4248,"U")
	913	AUTO-CORRE CT PATIENT DISCREPAN
	914	"KRN",19.1 ,709,-1)
	915	0^2
	916	"KRN",19.1 ,709,0)
	917	PRCA AUTOC RCT PGM
	918	"KRN",19.1 ,709,1,0)
	919	^19.11^3^3 ^3170515^^ ^^
	920	"KRN",19.1 ,709,1,1,0 )
	921	This is a key for th e AR optio n 'PRCA AU TOCRCT PGM '.
	922	"KRN",19.1 ,709,1,2,0 )
	923	The 'PRCA AUTOCRCT P GM' option runs the Consolidat ed
	924	"KRN",19.1 ,709,1,3,0 )
	925	Patient St atement Au to-Correct ion progra m.
	926	"KRN",19.1 ,710,-1)
	927	0^1
	928	"KRN",19.1 ,710,0)
	929	RCCPC APPS BUILD AND TRANS
	930	"KRN",19.1 ,710,1,0)
	931	^^8^8^3170 502^
	932	"KRN",19.1 ,710,1,1,0 )
	933	This is a key for th e AR menu options 'R CCPC APPS BUILD AND TRANS' and
	934	"KRN",19.1 ,710,1,2,0 )
	935	'RCCPC APP S RETRANS' .
	936	"KRN",19.1 ,710,1,3,0 )
	937
	938	"KRN",19.1 ,710,1,4,0 )
	939	The 'RCCPC APPS BUIL D AND TRAN S' option runs the A nnual Paym ent Statem ent
	940	"KRN",19.1 ,710,1,5,0 )
	941	File Build and Trans mit for th e previous year and sends the data to AI TC.
	942	"KRN",19.1 ,710,1,6,0 )
	943
	944	"KRN",19.1 ,710,1,7,0 )
	945	The 'RCCPC APPS RETR ANS' optio n Re-Trans mits the c urrent Ann ual Paymen t
	946	"KRN",19.1 ,710,1,8,0 )
	947	Statement File data to AITC.
	948	"MBREQ")
	949	0
	950	"ORD",3,19 .1)
	951	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	952	"ORD",3,19 .1,0)
	953	SECURITY K EY
	954	"ORD",11,3 .8)
	955	3.8;11;;;M AILG^XPDTA 1;MAILGF1^ XPDIA1;MAI LGE1^XPDIA 1;MAILGF2^ XPDIA1;;MA ILGDEL^XPD IA1(%)
	956	"ORD",11,3 .8,0)
	957	MAIL GROUP
	958	"ORD",18,1 9)
	959	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	960	"ORD",18,1 9,0)
	961	OPTION
	962	"PKG",142, -1)
	963	1^1
	964	"PKG",142, 0)
	965	ACCOUNTS R ECEIVABLE^ PRCA^BILL COLLECTION S
	966	"PKG",142, 22,0)
	967	^9.49I^1^1
	968	"PKG",142, 22,1,0)
	969	4.5^^29503 20
	970	"PKG",142, 22,1,"PAH" ,1,0)
	971	313^319030 7^1578
	972	"PKG",142, 22,1,"PAH" ,1,1,0)
	973	^^1^1^3190 307
	974	"PKG",142, 22,1,"PAH" ,1,1,1,0)
	975	Consolidat ed Patient Statement - PSE
	976	"PRE")
	977	PRCA313E
	978	"QUES","XP F1",0)
	979	Y
	980	"QUES","XP F1","??")
	981	^D REP^XPD H
	982	"QUES","XP F1","A")
	983	Shall I wr ite over y our \|FLAG\| File
	984	"QUES","XP F1","B")
	985	YES
	986	"QUES","XP F1","M")
	987	D XPF1^XPD IQ
	988	"QUES","XP F2",0)
	989	Y
	990	"QUES","XP F2","??")
	991	^D DTA^XPD H
	992	"QUES","XP F2","A")
	993	Want my da ta \|FLAG\| yours
	994	"QUES","XP F2","B")
	995	YES
	996	"QUES","XP F2","M")
	997	D XPF2^XPD IQ
	998	"QUES","XP I1",0)
	999	YO
	1000	"QUES","XP I1","??")
	1001	^D INHIBIT ^XPDH
	1002	"QUES","XP I1","A")
	1003	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1004	"QUES","XP I1","B")
	1005	NO
	1006	"QUES","XP I1","M")
	1007	D XPI1^XPD IQ
	1008	"QUES","XP M1",0)
	1009	PO^VA(200, :EM
	1010	"QUES","XP M1","??")
	1011	^D MG^XPDH
	1012	"QUES","XP M1","A")
	1013	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1014	"QUES","XP M1","B")
	1015
	1016	"QUES","XP M1","M")
	1017	D XPM1^XPD IQ
	1018	"QUES","XP O1",0)
	1019	Y
	1020	"QUES","XP O1","??")
	1021	^D MENU^XP DH
	1022	"QUES","XP O1","A")
	1023	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1024	"QUES","XP O1","B")
	1025	YES
	1026	"QUES","XP O1","M")
	1027	D XPO1^XPD IQ
	1028	"QUES","XP Z1",0)
	1029	Y
	1030	"QUES","XP Z1","??")
	1031	^D OPT^XPD H
	1032	"QUES","XP Z1","A")
	1033	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1034	"QUES","XP Z1","B")
	1035	YES
	1036	"QUES","XP Z1","M")
	1037	D XPZ1^XPD IQ
	1038	"QUES","XP Z2",0)
	1039	Y
	1040	"QUES","XP Z2","??")
	1041	^D RTN^XPD H
	1042	"QUES","XP Z2","A")
	1043	Want to MO VE routine s to other CPUs
	1044	"QUES","XP Z2","B")
	1045	NO
	1046	"QUES","XP Z2","M")
	1047	D XPZ2^XPD IQ
	1048	"RTN")
	1049	23
	1050	"RTN","PRC A313E")
	1051	0^^B258337 8^n/a
	1052	"RTN","PRC A313E",1,0 )
	1053	PRCA313E ; ALB/WCJ - PATCH PRCA 4.5313 E NVIRONMENT CHECKING ROUTINE ;2 /12/19 9:1 1pm
	1054	"RTN","PRC A313E",2,0 )
	1055	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	1056	"RTN","PRC A313E",3,0 )
	1057	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1058	"RTN","PRC A313E",4,0 )
	1059	;
	1060	"RTN","PRC A313E",5,0 )
	1061	; DBIA#10 141
	1062	"RTN","PRC A313E",6,0 )
	1063	;
	1064	"RTN","PRC A313E",7,0 )
	1065	ENV ; "Env ironment" checking
	1066	"RTN","PRC A313E",8,0 )
	1067	;
	1068	"RTN","PRC A313E",9,0 )
	1069	S XPDNOQU E=1 ; do n't allow anyone to queue this routine
	1070	"RTN","PRC A313E",10, 0)
	1071	;
	1072	"RTN","PRC A313E",11, 0)
	1073	Q:'$$PROD ^XUPROD(1) ; quit if it's no t a produc tion accou nt.
	1074	"RTN","PRC A313E",12, 0)
	1075	;
	1076	"RTN","PRC A313E",13, 0)
	1077	Q:$$INSTA LDT^XPDUTL ("PRCA4.5 313") ;D BIA#10141 ; quit if it's alrea dy been in stalled at least onc e
	1078	"RTN","PRC A313E",14, 0)
	1079	;
	1080	"RTN","PRC A313E",15, 0)
	1081	; due to monthly st atement pr ocessing, only allow ed to inst all this p atch on ce rtain days each mont h.
	1082	"RTN","PRC A313E",16, 0)
	1083	I '$$ALLO WED(DT) D Q
	1084	"RTN","PRC A313E",17, 0)
	1085	. S XPDQU IT=1
	1086	"RTN","PRC A313E",18, 0)
	1087	. W !,"** Installat ion of PRC A4.5313 is not all owed into your produ ction acco unt on tod ay's date **"
	1088	"RTN","PRC A313E",19, 0)
	1089	. W !,"Pl ease reacc ess the in stallation days allo wed for yo ur site.", !
	1090	"RTN","PRC A313E",20, 0)
	1091	;
	1092	"RTN","PRC A313E",21, 0)
	1093	W !,"Inst allation o f PRCA4.5 313 is al lowed.",!
	1094	"RTN","PRC A313E",22, 0)
	1095	Q
	1096	"RTN","PRC A313E",23, 0)
	1097	;
	1098	"RTN","PRC A313E",24, 0)
	1099	ALLOWED(DA TE) ; allo w to insta ll 25th or after but not the l ast 2 days of the mo nth.
	1100	"RTN","PRC A313E",25, 0)
	1101	;
	1102	"RTN","PRC A313E",26, 0)
	1103	; can't i nstall bef ore the 25 th
	1104	"RTN","PRC A313E",27, 0)
	1105	Q:+$E(DAT E,6,7)<25 0
	1106	"RTN","PRC A313E",28, 0)
	1107	;
	1108	"RTN","PRC A313E",29, 0)
	1109	; if you are past t he 25th an d add 2 da ys, you mu st still b e beyond t he 25th un less month changed
	1110	"RTN","PRC A313E",30, 0)
	1111	S DATE=$$ FMADD^XLFD T(DATE,2,0 ,0,0)
	1112	"RTN","PRC A313E",31, 0)
	1113	I $E(DATE ,6,7)<25 Q 0
	1114	"RTN","PRC A313E",32, 0)
	1115	;
	1116	"RTN","PRC A313E",33, 0)
	1117	Q 1
	1118	"RTN","PRC A313E",34, 0)
	1119	;
	1120	"RTN","PRC A313P")
	1121	0^18^B3376 3023^n/a
	1122	"RTN","PRC A313P",1,0 )
	1123	PRCA313P ; ALB/BDB - PATCH PRCA 4.5313 P OST-INSTAL L ROUTINE ;11/2/15 4 :15pm
	1124	"RTN","PRC A313P",2,0 )
	1125	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	1126	"RTN","PRC A313P",3,0 )
	1127	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1128	"RTN","PRC A313P",4,0 )
	1129	; This ro utine queu es the Pat ient State ment Auto- Correction Program
	1130	"RTN","PRC A313P",5,0 )
	1131	;
	1132	"RTN","PRC A313P",6,0 )
	1133	; DBIA#10 141
	1134	"RTN","PRC A313P",7,0 )
	1135	; DBIA#37 79
	1136	"RTN","PRC A313P",8,0 )
	1137	Q
	1138	"RTN","PRC A313P",9,0 )
	1139	;
	1140	"RTN","PRC A313P",10, 0)
	1141	EN ;Entry point for PRCA4.53 13 post-in stall
	1142	"RTN","PRC A313P",11, 0)
	1143	;
	1144	"RTN","PRC A313P",12, 0)
	1145	Q:$$INSTA LDT^XPDUTL ("PRCA4.5 313") ; DBIA#10141 ;below onl y needed o n the init ial instal l
	1146	"RTN","PRC A313P",13, 0)
	1147	;
	1148	"RTN","PRC A313P",14, 0)
	1149	; Queue t he Patient Statement Auto-Corr ection Pro gram
	1150	"RTN","PRC A313P",15, 0)
	1151	D PRCACPS
	1152	"RTN","PRC A313P",16, 0)
	1153	; Delete DD previou s monthly data
	1154	"RTN","PRC A313P",17, 0)
	1155	D CLEANUP
	1156	"RTN","PRC A313P",18, 0)
	1157	; Set Pat ient State ment days
	1158	"RTN","PRC A313P",19, 0)
	1159	D STDT
	1160	"RTN","PRC A313P",20, 0)
	1161	; Set AR Transactio n Types
	1162	"RTN","PRC A313P",21, 0)
	1163	D SET3491
	1164	"RTN","PRC A313P",22, 0)
	1165	; Send fi rst full n ightly acc ount balan ce update
	1166	"RTN","PRC A313P",23, 0)
	1167	D BALUPD2
	1168	"RTN","PRC A313P",24, 0)
	1169	;
	1170	"RTN","PRC A313P",25, 0)
	1171	Q
	1172	"RTN","PRC A313P",26, 0)
	1173	;
	1174	"RTN","PRC A313P",27, 0)
	1175	STDT ; En try point for PRCA4 .5313 set of Patien t Statemen t date dep endent upo n the Pati ent Last
	1176	Name
	1177	"RTN","PRC A313P",28, 0)
	1178	D BMES^XP DUTL("Star ting Patie nt Stateme nt Date Re set.")
	1179	"RTN","PRC A313P",29, 0)
	1180	N DEBT,DI E
	1181	"RTN","PRC A313P",30, 0)
	1182	S DIE="^R CD(340,"
	1183	"RTN","PRC A313P",31, 0)
	1184	S DEBT=""
	1185	"RTN","PRC A313P",32, 0)
	1186	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	1187	"RTN","PRC A313P",33, 0)
	1188	. N NAME, DA,DR
	1189	"RTN","PRC A313P",34, 0)
	1190	. S NAME= $$GET1^DIQ (340,DEBT_ ",",.01)
	1191	"RTN","PRC A313P",35, 0)
	1192	. S DA=DE BT
	1193	"RTN","PRC A313P",36, 0)
	1194	. S DR=". 03////"_+$ $ACSET^RCC PCFN1(NAME )
	1195	"RTN","PRC A313P",37, 0)
	1196	. D ^DIE
	1197	"RTN","PRC A313P",38, 0)
	1198	;
	1199	"RTN","PRC A313P",39, 0)
	1200	; Set cro ss-referen ce in AR E vent (341)
	1201	"RTN","PRC A313P",40, 0)
	1202	N DA,DIK
	1203	"RTN","PRC A313P",41, 0)
	1204	S DIK="^R C(341,"
	1205	"RTN","PRC A313P",42, 0)
	1206	S DIK(1)= "6.01^STDT "
	1207	"RTN","PRC A313P",43, 0)
	1208	D ENALL^D IK
	1209	"RTN","PRC A313P",44, 0)
	1210	;
	1211	"RTN","PRC A313P",45, 0)
	1212	D BMES^XP DUTL("Pati ent Statem ent Date R eset Compl ete.")
	1213	"RTN","PRC A313P",46, 0)
	1214	Q
	1215	"RTN","PRC A313P",47, 0)
	1216	;
	1217	"RTN","PRC A313P",48, 0)
	1218	CLEANUP ; PRCA4.5 313
	1219	"RTN","PRC A313P",49, 0)
	1220	; Remove site state ment date
	1221	"RTN","PRC A313P",50, 0)
	1222	D BMES^XP DUTL("Star ting Patie nt Stateme nt Cleanup .")
	1223	"RTN","PRC A313P",51, 0)
	1224	N DA,DR,D IE,X,RCT
	1225	"RTN","PRC A313P",52, 0)
	1226	S DA=1
	1227	"RTN","PRC A313P",53, 0)
	1228	S DR=".11 ///@"
	1229	"RTN","PRC A313P",54, 0)
	1230	S DIE="^R C(342,"
	1231	"RTN","PRC A313P",55, 0)
	1232	D ^DIE
	1233	"RTN","PRC A313P",56, 0)
	1234	;
	1235	"RTN","PRC A313P",57, 0)
	1236	; Remove all monthl y data
	1237	"RTN","PRC A313P",58, 0)
	1238	S DIK="^R CT(349,"
	1239	"RTN","PRC A313P",59, 0)
	1240	S DA=0 F S DA=$O(^ RCT(349,DA )) Q:DA="" D ^DIK
	1241	"RTN","PRC A313P",60, 0)
	1242	;
	1243	"RTN","PRC A313P",61, 0)
	1244	S DIK="^R CPS(349.2, "
	1245	"RTN","PRC A313P",62, 0)
	1246	S DA=0 F S DA=$O(^ RCPS(349.2 ,DA)) Q:DA ="" D ^DI K
	1247	"RTN","PRC A313P",63, 0)
	1248	;
	1249	"RTN","PRC A313P",64, 0)
	1250	S RCT=0 F S RCT=$O (^RCT(349. 1,RCT)) Q: 'RCT K ^R CT(349.1,+ RCT,4),^RC T(349.1,+R CT,5)
	1251	"RTN","PRC A313P",65, 0)
	1252	;
	1253	"RTN","PRC A313P",66, 0)
	1254	D BMES^XP DUTL("Pati ent Statem ent Cleanu p complete .")
	1255	"RTN","PRC A313P",67, 0)
	1256	Q
	1257	"RTN","PRC A313P",68, 0)
	1258	;
	1259	"RTN","PRC A313P",69, 0)
	1260	SET3491 ; PRCA4.5 313
	1261	"RTN","PRC A313P",70, 0)
	1262	; Set val ues for Pr oduction o r Test AR Transmissi on Type
	1263	"RTN","PRC A313P",71, 0)
	1264	N PROD,CC ,CP,CA,IEN ,TT,TTVAL
	1265	"RTN","PRC A313P",72, 0)
	1266	;
	1267	"RTN","PRC A313P",73, 0)
	1268	D BMES^XP DUTL("Star ting AR Tr ansaction Type Updat e.")
	1269	"RTN","PRC A313P",74, 0)
	1270	;
	1271	"RTN","PRC A313P",75, 0)
	1272	; Set whe ther envir onment is Production or Test a nd define expected/n ew values
	1273	"RTN","PRC A313P",76, 0)
	1274	S PROD=$$ PROD^XUPRO D
	1275	"RTN","PRC A313P",77, 0)
	1276	S (CC(1), CP(1),CA(1 ))="XXX"
	1277	"RTN","PRC A313P",78, 0)
	1278	S CC(3)=" Q-"_$S(PRO D:"CBS",1: "CCT")_" D OM A IN . EXT "
	1279	"RTN","PRC A313P",79, 0)
	1280	S CP(3)=" Q-"_$S(PRO D:"CPP",1: "CPT")_" D OM A IN . EXT "
	1281	"RTN","PRC A313P",80, 0)
	1282	S CA(3)=" Q-"_$S(PRO D:"CAP",1: "CAT")_" D OM A IN . EXT "
	1283	"RTN","PRC A313P",81, 0)
	1284	;
	1285	"RTN","PRC A313P",82, 0)
	1286	; Validat e Domains are availa ble. Writ e error if not
	1287	"RTN","PRC A313P",83, 0)
	1288	I '$D(^DI C(4.2,"B", CC(3)))!(' $D(^DIC(4. 2,"B",CP(3 ))))!('$D( ^DIC(4.2," B",CA(3))) ) D Q ; DBIA#3779
	1289	"RTN","PRC A313P",84, 0)
	1290	. N LINE S $P(LINE, "*",79)=""
	1291	"RTN","PRC A313P",85, 0)
	1292	. D BMES^ XPDUTL(LIN E)
	1293	"RTN","PRC A313P",86, 0)
	1294	. D MES^X PDUTL("Dom ains for P RCA4.531 3 have not been full y set up." )
	1295	"RTN","PRC A313P",87, 0)
	1296	. D MES^X PDUTL("Ple ase establ ish Domain s for: ")
	1297	"RTN","PRC A313P",88, 0)
	1298	. D MES^X PDUTL("CCP C PATIENT STATEMENTS , PATIENT STATEMENT UPDATE, an d ANNUAL P AYMENT
	1299	STATEMENTS .")
	1300	"RTN","PRC A313P",89, 0)
	1301	. D BMES^ XPDUTL(LIN E)
	1302	"RTN","PRC A313P",90, 0)
	1303	;
	1304	"RTN","PRC A313P",91, 0)
	1305	; Validat e 'PS', 'P U', and 'P Y' are set for Patie nt Stateme nt, Nightl y Update, and Annual Payment
	1306	Statement
	1307	"RTN","PRC A313P",92, 0)
	1308	F TT="PS" ,"PU","PY" S IEN=$O( ^RCT(349.1 ,"B",TT,0) ) D
	1309	"RTN","PRC A313P",93, 0)
	1310	. N DOMAI N,I
	1311	"RTN","PRC A313P",94, 0)
	1312	. I TT="P S" M DOMAI N=CC
	1313	"RTN","PRC A313P",95, 0)
	1314	. I TT="P U" M DOMAI N=CP
	1315	"RTN","PRC A313P",96, 0)
	1316	. I TT="P Y" M DOMAI N=CA
	1317	"RTN","PRC A313P",97, 0)
	1318	. ; If no IEN creat e new leve l one and three with cross-ref erences
	1319	"RTN","PRC A313P",98, 0)
	1320	. I IEN=" " D SET1(T T,.DOMAIN) Q
	1321	"RTN","PRC A313P",99, 0)
	1322	. ; If no 3 level o r it is no t set to e xpected va lue reset 3 level
	1323	"RTN","PRC A313P",100 ,0)
	1324	. I IEN'= "" D
	1325	"RTN","PRC A313P",101 ,0)
	1326	. F I=1,3 S TTVAL(I )=$P($G(^R CT(349.1,I EN,3)),U,I )
	1327	"RTN","PRC A313P",102 ,0)
	1328	. I DOMAI N(1)_DOMAI N(3)'=TTVA L(1)_TTVAL (3) D SET3 (IEN,.DOMA IN)
	1329	"RTN","PRC A313P",103 ,0)
	1330	;
	1331	"RTN","PRC A313P",104 ,0)
	1332	D BMES^XP DUTL("AR T ransaction Type Upda te complet e.")
	1333	"RTN","PRC A313P",105 ,0)
	1334	;
	1335	"RTN","PRC A313P",106 ,0)
	1336	Q
	1337	"RTN","PRC A313P",107 ,0)
	1338	;
	1339	"RTN","PRC A313P",108 ,0)
	1340	SET1(TT,DO MAIN) ; P RCA4.531 3
	1341	"RTN","PRC A313P",109 ,0)
	1342	; Set bot h the 1 an d 3 level for 349.1
	1343	"RTN","PRC A313P",110 ,0)
	1344	; New and Set Field values fo r DIC(4.2
	1345	"RTN","PRC A313P",111 ,0)
	1346	N TTNAME, ZZ,DIC,Y
	1347	"RTN","PRC A313P",112 ,0)
	1348	I TT="PS" S TTNAME= "CCPC PATI ENT STATEM ENT"
	1349	"RTN","PRC A313P",113 ,0)
	1350	I TT="PU" S TTNAME= "PATIENT S TATEMENT U PDATE"
	1351	"RTN","PRC A313P",114 ,0)
	1352	I TT="PY" S TTNAME= "ANNUAL PA YMENT STAT EMENTS"
	1353	"RTN","PRC A313P",115 ,0)
	1354	;
	1355	"RTN","PRC A313P",116 ,0)
	1356	; Set 1 l evel value s
	1357	"RTN","PRC A313P",117 ,0)
	1358	S DIC="^R CT(349.1," ,DIC(0)="L "
	1359	"RTN","PRC A313P",118 ,0)
	1360	S X=TT
	1361	"RTN","PRC A313P",119 ,0)
	1362	S DIC("DR ")=".02/// "_TTNAME_" ;.03///"_1 _";"
	1363	"RTN","PRC A313P",120 ,0)
	1364	D FILE^DI CN
	1365	"RTN","PRC A313P",121 ,0)
	1366	S IEN=+Y
	1367	"RTN","PRC A313P",122 ,0)
	1368	;
	1369	"RTN","PRC A313P",123 ,0)
	1370	; Set 3 l evel
	1371	"RTN","PRC A313P",124 ,0)
	1372	D SET3(IE N,.DOMAIN)
	1373	"RTN","PRC A313P",125 ,0)
	1374	;
	1375	"RTN","PRC A313P",126 ,0)
	1376	Q
	1377	"RTN","PRC A313P",127 ,0)
	1378	SET3(IEN,D OMAIN) ; PRCA4.53 13
	1379	"RTN","PRC A313P",128 ,0)
	1380	; Set 3 l evel for 3 49.1
	1381	"RTN","PRC A313P",129 ,0)
	1382	S DOMAIN( "IEN")=$O( ^DIC(4.2," B",DOMAIN( 3),0)) ; DBIA#3779
	1383	"RTN","PRC A313P",130 ,0)
	1384	S ^RCT(34 9.1,IEN,3) =DOMAIN(1) _U_DOMAIN( "IEN")_U_D OMAIN(3)
	1385	"RTN","PRC A313P",131 ,0)
	1386	; PRCA4. 5313 - Se t Cross-Re ferences f or this IE N
	1387	"RTN","PRC A313P",132 ,0)
	1388	S DA=IEN, DIK="^RCT( 349.1," D IX1^DIK
	1389	"RTN","PRC A313P",133 ,0)
	1390	;
	1391	"RTN","PRC A313P",134 ,0)
	1392	Q
	1393	"RTN","PRC A313P",135 ,0)
	1394	;
	1395	"RTN","PRC A313P",136 ,0)
	1396	PRE ; Pre -install a ctions for the Data Dictionary
	1397	"RTN","PRC A313P",137 ,0)
	1398	;
	1399	"RTN","PRC A313P",138 ,0)
	1400	Q:$$INSTA LDT^XPDUTL ("PRCA4.5 313") ; DBIA#10141 ;below onl y needed o n the init ial instal l
	1401	"RTN","PRC A313P",139 ,0)
	1402	;
	1403	"RTN","PRC A313P",140 ,0)
	1404	D BMES^XP DUTL("Star ting Pre-I nstall Cha nges.")
	1405	"RTN","PRC A313P",141 ,0)
	1406	;
	1407	"RTN","PRC A313P",142 ,0)
	1408	N DIK,DA
	1409	"RTN","PRC A313P",143 ,0)
	1410	; Remove DD for 349 .1, elemen ts 41, 42, and 43 - new elemen ts are ent ered durin g regular install
	1411	"RTN","PRC A313P",144 ,0)
	1412	S DIK="^D D(349.1,", DA(1)=349. 1
	1413	"RTN","PRC A313P",145 ,0)
	1414	F DA=41,4 2,43 D ^DI K
	1415	"RTN","PRC A313P",146 ,0)
	1416	;
	1417	"RTN","PRC A313P",147 ,0)
	1418	D BMES^XP DUTL("Pre- Install Ch anges comp lete.")
	1419	"RTN","PRC A313P",148 ,0)
	1420	Q
	1421	"RTN","PRC A313P",149 ,0)
	1422	;
	1423	"RTN","PRC A313P",150 ,0)
	1424	PRCACPS ; Queue the Patient S tatement A uto-Correc tion Progr am
	1425	"RTN","PRC A313P",151 ,0)
	1426	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	1427	"RTN","PRC A313P",152 ,0)
	1428	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	1429	"RTN","PRC A313P",153 ,0)
	1430	S ZTRTN=" START^PRCA CPS",ZTDTH =$H,ZTIO=" "
	1431	"RTN","PRC A313P",154 ,0)
	1432	D ^%ZTLOA D
	1433	"RTN","PRC A313P",155 ,0)
	1434	I $G(ZTSK ) D Q
	1435	"RTN","PRC A313P",156 ,0)
	1436	.D BMES^X PDUTL(">>> POST-INSTA LL CONSOLI DATED PATI ENT STATEM ENT AUTO-C ORRECTION" )
	1437	"RTN","PRC A313P",157 ,0)
	1438	.D MES^XP DUTL(">>>P ROGRAM HAS BEEN QUEU ED IN TASK "_ZTSK)
	1439	"RTN","PRC A313P",158 ,0)
	1440	I '$G(ZTS K) D Q
	1441	"RTN","PRC A313P",159 ,0)
	1442	.D BMES^X PDUTL(">>> ERROR: POS T-INSTALL CONSOLIDAT ED PATIENT STATEMENT AUTO-
	1443	CORRECTION ")
	1444	"RTN","PRC A313P",160 ,0)
	1445	.D MES^XP DUTL(">>>P ROGRAM COU LD NOT BE QUEUED")
	1446	"RTN","PRC A313P",161 ,0)
	1447	Q
	1448	"RTN","PRC A313P",162 ,0)
	1449	;
	1450	"RTN","PRC A313P",163 ,0)
	1451	BALUPD2 ;S end first full night ly account update du ring post install
	1452	"RTN","PRC A313P",164 ,0)
	1453	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	1454	"RTN","PRC A313P",165 ,0)
	1455	S RCFULL= 1 ;run the full debt or list
	1456	"RTN","PRC A313P",166 ,0)
	1457	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	1458	"RTN","PRC A313P",167 ,0)
	1459	S ZTRTN=" DEBTOR^PRC ACPS1",ZTD TH=$H,ZTIO ="",ZTSAVE ("RCFULL") =""
	1460	"RTN","PRC A313P",168 ,0)
	1461	D ^%ZTLOA D
	1462	"RTN","PRC A313P",169 ,0)
	1463	D BMES^XP DUTL("Pati ent Accoun t Balance Update com plete.")
	1464	"RTN","PRC A313P",170 ,0)
	1465	Q
	1466	"RTN","PRC AACR")
	1467	0^19^B1273 36081^n/a
	1468	"RTN","PRC AACR",1,0)
	1469	PRCAACR ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION REPOR T ;09/21/1 5 3:34 PM
	1470	"RTN","PRC AACR",2,0)
	1471	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	1472	"RTN","PRC AACR",3,0)
	1473	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1474	"RTN","PRC AACR",4,0)
	1475	;
	1476	"RTN","PRC AACR",5,0)
	1477	Q
	1478	"RTN","PRC AACR",6,0)
	1479	;
	1480	"RTN","PRC AACR",7,0)
	1481	PSACRT ; r eport, pri nts sorted individua l transact ions that have been auto-corre cted
	1482	"RTN","PRC AACR",8,0)
	1483	N DIC,PAG E,BY,DHD,F ILENUM,FLD S,FR,L,TO, PRCABDT,PR CAEDT,PRCA SORT
	1484	"RTN","PRC AACR",9,0)
	1485	W !
	1486	"RTN","PRC AACR",10,0 )
	1487	PSDATE ;
	1488	"RTN","PRC AACR",11,0 )
	1489	; Determi ne if Auto Correct p rocess is currently running
	1490	"RTN","PRC AACR",12,0 )
	1491	N PRCASTR T,QUIT,X,X 1,X2,Y
	1492	"RTN","PRC AACR",13,0 )
	1493	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= ""
	1494	"RTN","PRC AACR",14,0 )
	1495	; QUIT if Auto Corr ect proces s is curre ntly runni ng
	1496	"RTN","PRC AACR",15,0 )
	1497	I PRCASTR T'="" D Q :QUIT
	1498	"RTN","PRC AACR",16,0 )
	1499	.S Y=$P(P RCASTRT,U, 2)
	1500	"RTN","PRC AACR",17,0 )
	1501	.D DD^%DT
	1502	"RTN","PRC AACR",18,0 )
	1503	.S PRCAST RT=Y
	1504	"RTN","PRC AACR",19,0 )
	1505	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram is cur rently run ning."
	1506	"RTN","PRC AACR",20,0 )
	1507	.W !,"It was starte d at ",PRC ASTRT," an d can take up to 1 h our to com plete."
	1508	"RTN","PRC AACR",21,0 )
	1509	.W !!,"If you choos e to conti nue with t his report , it may n ot reflect all of th e"
	1510	"RTN","PRC AACR",22,0 )
	1511	.W !,"cha nges from this lates t run of t he Patient Statement Auto-Corr ection Pro gram."
	1512	"RTN","PRC AACR",23,0 )
	1513	.W !
	1514	"RTN","PRC AACR",24,0 )
	1515	.S DIR(0) ="Y",DIR(" A")="Do yo u want to continue", DIR("B")=" NO"
	1516	"RTN","PRC AACR",25,0 )
	1517	.D ^DIR
	1518	"RTN","PRC AACR",26,0 )
	1519	.W !
	1520	"RTN","PRC AACR",27,0 )
	1521	.; Quit i f ^, ^^, T imeout or No
	1522	"RTN","PRC AACR",28,0 )
	1523	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	1524	"RTN","PRC AACR",29,0 )
	1525	.; Send M ailMan mes sage to PR CACPS mail group if Yes
	1526	"RTN","PRC AACR",30,0 )
	1527	.I Y=1 D PRCAMAIL^P RCACPSA(PR CASTRT)
	1528	"RTN","PRC AACR",31,0 )
	1529	.K DTOUT, DUOUT,DIRO UT
	1530	"RTN","PRC AACR",32,0 )
	1531	;
	1532	"RTN","PRC AACR",33,0 )
	1533	N DIROUT, DIS,DTOUT, DUOUT
	1534	"RTN","PRC AACR",34,0 )
	1535	S DIR("A" )="Date Ra nge: FROM: ",DIR("B" )="T-7"
	1536	"RTN","PRC AACR",35,0 )
	1537	S DIR("?" )="The def ault date is T-7. F uture date s may not be entered ."
	1538	"RTN","PRC AACR",36,0 )
	1539	S DIR(0)= "DO" D ^DI R
	1540	"RTN","PRC AACR",37,0 )
	1541	S:Y'="" P RCABDT=Y
	1542	"RTN","PRC AACR",38,0 )
	1543	I $D(DIRU T)&'Y K DI RUT Q
	1544	"RTN","PRC AACR",39,0 )
	1545	I PRCABDT >DT G PSDA TE
	1546	"RTN","PRC AACR",40,0 )
	1547	W "(",Y(0 ),")"
	1548	"RTN","PRC AACR",41,0 )
	1549	K DIR,X,Y
	1550	"RTN","PRC AACR",42,0 )
	1551	S DIR(0)= "DO"
	1552	"RTN","PRC AACR",43,0 )
	1553	S DIR("A" )="Date Ra nge: TO: ",DIR("B" )="T"
	1554	"RTN","PRC AACR",44,0 )
	1555	S DIR("?" )="The def ault date is T, but any date m ay be ente red."
	1556	"RTN","PRC AACR",45,0 )
	1557	D ^DIR S: Y="" Y=DT
	1558	"RTN","PRC AACR",46,0 )
	1559	I $D(DIRU T)&'Y K DI RUT Q
	1560	"RTN","PRC AACR",47,0 )
	1561	W "(",Y(0 ),")"
	1562	"RTN","PRC AACR",48,0 )
	1563	S PRCAEDT =Y
	1564	"RTN","PRC AACR",49,0 )
	1565	I PRCABDT >PRCAEDT G PSDATE
	1566	"RTN","PRC AACR",50,0 )
	1567	K DIR
	1568	"RTN","PRC AACR",51,0 )
	1569	S DIR(0)= "S^1:Auto- Correct Re ason;2:Deb tor Name;3 :Bill Numb er;4:Trans action Num ber;5:Auto -
	1570	Correct Da te",DIR("A ")="Sort b y"
	1571	"RTN","PRC AACR",52,0 )
	1572	S DIR("B" )=1
	1573	"RTN","PRC AACR",53,0 )
	1574	D ^DIR K DIR
	1575	"RTN","PRC AACR",54,0 )
	1576	S PRCASOR T=Y
	1577	"RTN","PRC AACR",55,0 )
	1578	Q:$D(DTOU T)!($D(DUO UT))!($D(D IROUT))
	1579	"RTN","PRC AACR",56,0 )
	1580	;
	1581	"RTN","PRC AACR",57,0 )
	1582	; Prompt for device
	1583	"RTN","PRC AACR",58,0 )
	1584	W !
	1585	"RTN","PRC AACR",59,0 )
	1586	N ZTRTN,Z TDESC,ZTSA VE,ZTSK
	1587	"RTN","PRC AACR",60,0 )
	1588	K IOP,%ZI S,POP,IO(" Q")
	1589	"RTN","PRC AACR",61,0 )
	1590	S %ZIS="Q "
	1591	"RTN","PRC AACR",62,0 )
	1592	D ^%ZIS Q :POP
	1593	"RTN","PRC AACR",63,0 )
	1594	; If Queu ed
	1595	"RTN","PRC AACR",64,0 )
	1596	I $D(IO(" Q")) D Q
	1597	"RTN","PRC AACR",65,0 )
	1598	.K IO("Q" )
	1599	"RTN","PRC AACR",66,0 )
	1600	.I $G(IOS T)["P-MES" S ZTRTN=" PRT^PRCAAC R1"
	1601	"RTN","PRC AACR",67,0 )
	1602	.I $G(IOS T)'["P-MES " S ZTRTN= "PRT^PRCAA CR"
	1603	"RTN","PRC AACR",68,0 )
	1604	.S ZTSAVE ("PRCABDT" )="",ZTSAV E("PRCAEDT ")="",ZTSA VE("PRCASO RT")=""
	1605	"RTN","PRC AACR",69,0 )
	1606	.D ^%ZTLO AD
	1607	"RTN","PRC AACR",70,0 )
	1608	.D HOME^% ZIS
	1609	"RTN","PRC AACR",71,0 )
	1610	.I $D(ZTS K)[0 W !!? 5,"Report cancelled! "
	1611	"RTN","PRC AACR",72,0 )
	1612	.E W !!? 5,"Report queued!"
	1613	"RTN","PRC AACR",73,0 )
	1614	.K POP
	1615	"RTN","PRC AACR",74,0 )
	1616	;
	1617	"RTN","PRC AACR",75,0 )
	1618	;Print Re port if no t QUEUED
	1619	"RTN","PRC AACR",76,0 )
	1620	PRT ;
	1621	"RTN","PRC AACR",77,0 )
	1622	; If not queued and output se nt to P-ME S
	1623	"RTN","PRC AACR",78,0 )
	1624	I $G(IOST )["P-MES" D PRT^PRCA ACR1 Q
	1625	"RTN","PRC AACR",79,0 )
	1626	;If not q ueued and output not sent to P -MES
	1627	"RTN","PRC AACR",80,0 )
	1628	U IO
	1629	"RTN","PRC AACR",81,0 )
	1630	K ^TMP("P RCAACR",$J )
	1631	"RTN","PRC AACR",82,0 )
	1632	S PAGE=0
	1633	"RTN","PRC AACR",83,0 )
	1634	S DASH="" ,$P(DASH," -",79)=""
	1635	"RTN","PRC AACR",84,0 )
	1636	S DIS(0)= "I $D(^PRC A(433,""TA CD"",PRCAT SRT,D0))", L=0
	1637	"RTN","PRC AACR",85,0 )
	1638	N PRCATSR T,PRCATN,P RCAACD,PRC AACR,PRCAB N,PRCADATA ,PRCADTR,P RCASSN,PRC AACTF,PRCA TNTF
	1639	"RTN","PRC AACR",86,0 )
	1640	S PRCATSR T=PRCABDT- .00001
	1641	"RTN","PRC AACR",87,0 )
	1642	; Loop th rough the specified date range
	1643	"RTN","PRC AACR",88,0 )
	1644	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT) D
	1645	"RTN","PRC AACR",89,0 )
	1646	.S PRCATN =""
	1647	"RTN","PRC AACR",90,0 )
	1648	.; Loop t hrough the transacti ons for th e current date
	1649	"RTN","PRC AACR",91,0 )
	1650	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	1651	"RTN","PRC AACR",92,0 )
	1652	..; Load associated data fiel ds for rep ort
	1653	"RTN","PRC AACR",93,0 )
	1654	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	1655	"RTN","PRC AACR",94,0 )
	1656	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	1657	"RTN","PRC AACR",95,0 )
	1658	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	1659	"RTN","PRC AACR",96,0 )
	1660	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	1661	"RTN","PRC AACR",97,0 )
	1662	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	1663	"RTN","PRC AACR",98,0 )
	1664	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	1665	"RTN","PRC AACR",99,0 )
	1666	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	1667	"RTN","PRC AACR",100, 0)
	1668	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	1669	"RTN","PRC AACR",101, 0)
	1670	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	1671	"RTN","PRC AACR",102, 0)
	1672	..S PRCAA CR=$E(PRCA ACR,1,14)
	1673	"RTN","PRC AACR",103, 0)
	1674	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	1675	"RTN","PRC AACR",104, 0)
	1676	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	1677	"RTN","PRC AACR",105, 0)
	1678	..I PRCAA CTF="YES" S PRCATNTF =""
	1679	"RTN","PRC AACR",106, 0)
	1680	..;
	1681	"RTN","PRC AACR",107, 0)
	1682	..; If an y of the n odes are n ull Quit
	1683	"RTN","PRC AACR",108, 0)
	1684	..I PRCAA CR=""!(PRC ADTR="")!( PRCABN="") !(PRCATN=" ")!(PRCAAC D="") Q
	1685	"RTN","PRC AACR",109, 0)
	1686	..;
	1687	"RTN","PRC AACR",110, 0)
	1688	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number
	1689	"RTN","PRC AACR",111, 0)
	1690	..I PRCAS ORT=1 D Q
	1691	"RTN","PRC AACR",112, 0)
	1692	...S
	1693	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	1694	_PRCAACD_U _PRCASSN
	1695	"RTN","PRC AACR",113, 0)
	1696	..;
	1697	"RTN","PRC AACR",114, 0)
	1698	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	1699	"RTN","PRC AACR",115, 0)
	1700	..I PRCAS ORT=2 D Q
	1701	"RTN","PRC AACR",116, 0)
	1702	...S
	1703	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	1704	PRCAACD_U_ PRCAACR
	1705	"RTN","PRC AACR",117, 0)
	1706	..;
	1707	"RTN","PRC AACR",118, 0)
	1708	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	1709	"RTN","PRC AACR",119, 0)
	1710	..I PRCAS ORT=3 D Q
	1711	"RTN","PRC AACR",120, 0)
	1712	...S
	1713	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	1714	PRCAACD_U_ PRCAACR
	1715	"RTN","PRC AACR",121, 0)
	1716	..;
	1717	"RTN","PRC AACR",122, 0)
	1718	..; Store in ^TMP s orted by T ransaction , Debtor a nd Bill Nu mber
	1719	"RTN","PRC AACR",123, 0)
	1720	..I PRCAS ORT=4 D Q
	1721	"RTN","PRC AACR",124, 0)
	1722	...S
	1723	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	1724	PRCAACD_U_ PRCAACR
	1725	"RTN","PRC AACR",125, 0)
	1726	..;
	1727	"RTN","PRC AACR",126, 0)
	1728	..; Store in ^TMP s orted by A uto-Correc t Reason, Debtor, #B ill Number and Trans action Num ber
	1729	"RTN","PRC AACR",127, 0)
	1730	..I PRCAS ORT=5 D Q
	1731	"RTN","PRC AACR",128, 0)
	1732	...S
	1733	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	1734	ASSN_U_PRC ATNTF_U_PR CAACR
	1735	"RTN","PRC AACR",129, 0)
	1736	;
	1737	"RTN","PRC AACR",130, 0)
	1738	;
	1739	"RTN","PRC AACR",131, 0)
	1740	N QUIT ; QUIT befor e end of r eport
	1741	"RTN","PRC AACR",132, 0)
	1742	S QUIT=""
	1743	"RTN","PRC AACR",133, 0)
	1744	; Display Auto-Corr ect data s orted by A uto Correc tion Reaso n
	1745	"RTN","PRC AACR",134, 0)
	1746	I PRCASOR T=1 D
	1747	"RTN","PRC AACR",135, 0)
	1748	.; Data L ayout
	1749	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	1750	_PRCAACD_U _PRCASSN
	1751	"RTN","PRC AACR",136, 0)
	1752	.; Displa y Auto Cor rection Re ason heade r
	1753	"RTN","PRC AACR",137, 0)
	1754	.N Y
	1755	"RTN","PRC AACR",138, 0)
	1756	.D PSACRT P1
	1757	"RTN","PRC AACR",139, 0)
	1758	.S PRCAAC R=""
	1759	"RTN","PRC AACR",140, 0)
	1760	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D Q:QUIT
	1761	"RTN","PRC AACR",141, 0)
	1762	..S PRCAD TR=""
	1763	"RTN","PRC AACR",142, 0)
	1764	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1765	"RTN","PRC AACR",143, 0)
	1766	...S PRCA BN=""
	1767	"RTN","PRC AACR",144, 0)
	1768	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:QU IT
	1769	"RTN","PRC AACR",145, 0)
	1770	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	1771	"RTN","PRC AACR",146, 0)
	1772	....S Y=$ P(PRCADATA ,U,5)
	1773	"RTN","PRC AACR",147, 0)
	1774	....D DD^ %DT
	1775	"RTN","PRC AACR",148, 0)
	1776	....S $P( PRCADATA,U ,5)=Y
	1777	"RTN","PRC AACR",149, 0)
	1778	....W
	1779	!,$P(PRCAD ATA,U,1),? 16,$E($P(P RCADATA,U, 2),1,18),? 36,$E($P(P RCADATA,U, 6),6,9),?4 2,$E($P(PR CADA
	1780	TA,U,3),1, 11),?55,$J ($P(PRCADA TA,U,4),9) ,?66,$P(PR CADATA,U,5 )
	1781	"RTN","PRC AACR",150, 0)
	1782	....I $Y> (IOSL-3) D
	1783	"RTN","PRC AACR",151, 0)
	1784	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1785	"RTN","PRC AACR",152, 0)
	1786	......D P RTC
	1787	"RTN","PRC AACR",153, 0)
	1788	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1789	"RTN","PRC AACR",154, 0)
	1790	.....D PS ACRTP1
	1791	"RTN","PRC AACR",155, 0)
	1792	;
	1793	"RTN","PRC AACR",156, 0)
	1794	; Display Auto-Corr ect data s orted by D ebtor
	1795	"RTN","PRC AACR",157, 0)
	1796	I PRCASOR T=2 D
	1797	"RTN","PRC AACR",158, 0)
	1798	.; Data L ayout
	1799	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	1800	PRCAACD_U_ PRCAACR
	1801	"RTN","PRC AACR",159, 0)
	1802	.; Displa y Debtor h eader
	1803	"RTN","PRC AACR",160, 0)
	1804	.D PSACRT P2
	1805	"RTN","PRC AACR",161, 0)
	1806	.S PRCADT R=""
	1807	"RTN","PRC AACR",162, 0)
	1808	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D Q:QUIT
	1809	"RTN","PRC AACR",163, 0)
	1810	..S PRCAB N=""
	1811	"RTN","PRC AACR",164, 0)
	1812	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D Q:Q UIT
	1813	"RTN","PRC AACR",165, 0)
	1814	...S PRCA TN=""
	1815	"RTN","PRC AACR",166, 0)
	1816	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D Q:QUI T
	1817	"RTN","PRC AACR",167, 0)
	1818	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	1819	"RTN","PRC AACR",168, 0)
	1820	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1821	"RTN","PRC AACR",169, 0)
	1822	....W
	1823	!,$E($P(PR CADATA,U,1 ),1,18),?2 0,$P(PRCAD ATA,U,2),? 33,$E($P(P RCADATA,U, 3),6,9),?3 9,$J($P(PR CADA
	1824	TA,U,4),9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1825	"RTN","PRC AACR",170, 0)
	1826	....I $Y> (IOSL-3) D
	1827	"RTN","PRC AACR",171, 0)
	1828	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1829	"RTN","PRC AACR",172, 0)
	1830	......D P RTC
	1831	"RTN","PRC AACR",173, 0)
	1832	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1833	"RTN","PRC AACR",174, 0)
	1834	.....D PS ACRTP2
	1835	"RTN","PRC AACR",175, 0)
	1836	;
	1837	"RTN","PRC AACR",176, 0)
	1838	; Display Auto-Corr ect data s orted by A UTO-C DATE
	1839	"RTN","PRC AACR",177, 0)
	1840	I PRCASOR T=3 D
	1841	"RTN","PRC AACR",178, 0)
	1842	.; Data L ayout
	1843	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	1844	PRCAACD_U_ PRCAACR
	1845	"RTN","PRC AACR",179, 0)
	1846	.; Displa y Bill Num ber header
	1847	"RTN","PRC AACR",180, 0)
	1848	.D PSACRT P3
	1849	"RTN","PRC AACR",181, 0)
	1850	.S PRCABN =""
	1851	"RTN","PRC AACR",182, 0)
	1852	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D Q: QUIT
	1853	"RTN","PRC AACR",183, 0)
	1854	..S PRCAD TR=""
	1855	"RTN","PRC AACR",184, 0)
	1856	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1857	"RTN","PRC AACR",185, 0)
	1858	...S PRCA TN=""
	1859	"RTN","PRC AACR",186, 0)
	1860	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D Q:QUI T
	1861	"RTN","PRC AACR",187, 0)
	1862	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	1863	"RTN","PRC AACR",188, 0)
	1864	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1865	"RTN","PRC AACR",189, 0)
	1866	....W
	1867	!,$P(PRCAD ATA,U,1),? 13,$E($P(P RCADATA,U, 2),1,18),? 33,$E($P(P RCADATA,U, 3),6,9),?3 9,$J($P(PR CADA
	1868	TA,U,4),9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1869	"RTN","PRC AACR",190, 0)
	1870	....I $Y> (IOSL-3) D
	1871	"RTN","PRC AACR",191, 0)
	1872	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1873	"RTN","PRC AACR",192, 0)
	1874	......D P RTC
	1875	"RTN","PRC AACR",193, 0)
	1876	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1877	"RTN","PRC AACR",194, 0)
	1878	.....D PS ACRTP3
	1879	"RTN","PRC AACR",195, 0)
	1880	;
	1881	"RTN","PRC AACR",196, 0)
	1882	; Display Auto-Corr ect data s orted by T ransaction Number
	1883	"RTN","PRC AACR",197, 0)
	1884	I PRCASOR T=4 D
	1885	"RTN","PRC AACR",198, 0)
	1886	.; Data L ayout
	1887	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	1888	PRCAACD_U_ PRCAACR
	1889	"RTN","PRC AACR",199, 0)
	1890	.; Displa y AUTO-C D ATE header
	1891	"RTN","PRC AACR",200, 0)
	1892	.D PSACRT P4
	1893	"RTN","PRC AACR",201, 0)
	1894	.S PRCATN =""
	1895	"RTN","PRC AACR",202, 0)
	1896	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D Q: QUIT
	1897	"RTN","PRC AACR",203, 0)
	1898	..S PRCAD TR=""
	1899	"RTN","PRC AACR",204, 0)
	1900	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D Q:QUIT
	1901	"RTN","PRC AACR",205, 0)
	1902	...S PRCA BN=""
	1903	"RTN","PRC AACR",206, 0)
	1904	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D Q:QUI T
	1905	"RTN","PRC AACR",207, 0)
	1906	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	1907	"RTN","PRC AACR",208, 0)
	1908	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	1909	"RTN","PRC AACR",209, 0)
	1910	....W
	1911	!,$J($P(PR CADATA,U,1 ),9),?11,$ E($P(PRCAD ATA,U,2),1 ,18),?31,$ P(PRCADATA ,U,3),?44, $E($P(PRCA DATA
	1912	,U,4),6,9) ,?50,$P(PR CADATA,U,5 ),?64,$P(P RCADATA,U, 6)
	1913	"RTN","PRC AACR",210, 0)
	1914	....I $Y> (IOSL-3) D
	1915	"RTN","PRC AACR",211, 0)
	1916	.....I $E (IOST,1,2) ="C-" D Q :QUIT
	1917	"RTN","PRC AACR",212, 0)
	1918	......D P RTC
	1919	"RTN","PRC AACR",213, 0)
	1920	......I $ D(DIRUT)!( $D(DTOUT)) S QUIT=1
	1921	"RTN","PRC AACR",214, 0)
	1922	.....D PS ACRTP4
	1923	"RTN","PRC AACR",215, 0)
	1924	;
	1925	"RTN","PRC AACR",216, 0)
	1926	; Display Auto-Corr ect data s orted by A uto-Correc t date
	1927	"RTN","PRC AACR",217, 0)
	1928	I PRCASOR T=5 D
	1929	"RTN","PRC AACR",218, 0)
	1930	.; Data L ayout
	1931	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	1932	ASSN_U_PRC ATNTF_U_PR CAACR
	1933	"RTN","PRC AACR",219, 0)
	1934	.; Displa y AUTO-C D ATE header
	1935	"RTN","PRC AACR",220, 0)
	1936	.D PSACRT P5
	1937	"RTN","PRC AACR",221, 0)
	1938	.S PRCAAC D=""
	1939	"RTN","PRC AACR",222, 0)
	1940	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D Q:QUIT
	1941	"RTN","PRC AACR",223, 0)
	1942	..S PRCAD TR=""
	1943	"RTN","PRC AACR",224, 0)
	1944	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D Q:QUIT
	1945	"RTN","PRC AACR",225, 0)
	1946	...S PRCA BN=""
	1947	"RTN","PRC AACR",226, 0)
	1948	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D Q:QU IT
	1949	"RTN","PRC AACR",227, 0)
	1950	....S PRC ATN=""
	1951	"RTN","PRC AACR",228, 0)
	1952	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN D Q:QUIT
	1953	"RTN","PRC AACR",229, 0)
	1954	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	1955	"RTN","PRC AACR",230, 0)
	1956	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	1957	"RTN","PRC AACR",231, 0)
	1958	.....W
	1959	!,$P(PRCAD ATA,U,1),? 14,$E($P(P RCADATA,U, 2),1,18),? 34,$P(PRCA DATA,U,3), ?47,$E($P( PRCADATA,U ,4),
	1960	6,9),?53,$ J($P(PRCAD ATA,U,5),9 ),?64,$P(P RCADATA,U, 6)
	1961	"RTN","PRC AACR",232, 0)
	1962	.....I $Y >(IOSL-3) D
	1963	"RTN","PRC AACR",233, 0)
	1964	......I $ E(IOST,1,2 )="C-" D Q:QUIT
	1965	"RTN","PRC AACR",234, 0)
	1966	.......D PRTC
	1967	"RTN","PRC AACR",235, 0)
	1968	.......I $D(DIRUT)! ($D(DTOUT) ) S QUIT=1
	1969	"RTN","PRC AACR",236, 0)
	1970	......D P SACRTP5
	1971	"RTN","PRC AACR",237, 0)
	1972	D ^%ZISC
	1973	"RTN","PRC AACR",238, 0)
	1974	I $E(IOST ,1,2)="C-" ,'$D(DUOUT ),('$D(DTO UT)) W ! S DIR(0)="E " D ^DIR
	1975	"RTN","PRC AACR",239, 0)
	1976	K X,Y,DAS H,D0
	1977	"RTN","PRC AACR",240, 0)
	1978	Q
	1979	"RTN","PRC AACR",241, 0)
	1980	;
	1981	"RTN","PRC AACR",242, 0)
	1982	PRTC ; Pre ss Return To Continu e
	1983	"RTN","PRC AACR",243, 0)
	1984	S DIR(0)= "E" D ^DIR
	1985	"RTN","PRC AACR",244, 0)
	1986	Q
	1987	"RTN","PRC AACR",245, 0)
	1988	;
	1989	"RTN","PRC AACR",246, 0)
	1990	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	1991	"RTN","PRC AACR",247, 0)
	1992	W @IOF
	1993	"RTN","PRC AACR",248, 0)
	1994	S PAGE=PA GE+1
	1995	"RTN","PRC AACR",249, 0)
	1996	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION
	1997	REASON)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	1998	"RTN","PRC AACR",250, 0)
	1999	W !,DASH, !
	2000	"RTN","PRC AACR",251, 0)
	2001	W !,"AUTO -C REASON" ,?16,"DEBT OR",?36,"S SN",?42,"B ILL NO.",? 55,"TRANS NUM",?66," AUTO-C DAT E"
	2002	"RTN","PRC AACR",252, 0)
	2003	W !,"---- ---------- ",?16,"--- ---------- -----",?36 ,"----",?4 2,"------- ----",?55, "--------- ",?66,"--- ---------"
	2004	"RTN","PRC AACR",253, 0)
	2005	Q
	2006	"RTN","PRC AACR",254, 0)
	2007	;
	2008	"RTN","PRC AACR",255, 0)
	2009	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2010	"RTN","PRC AACR",256, 0)
	2011	W @IOF
	2012	"RTN","PRC AACR",257, 0)
	2013	S PAGE=PA GE+1
	2014	"RTN","PRC AACR",258, 0)
	2015	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y
	2016	DEBTOR)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	2017	"RTN","PRC AACR",259, 0)
	2018	W !,DASH, !
	2019	"RTN","PRC AACR",260, 0)
	2020	W !,"DEBT OR",?20,"B ILL NO.",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	2021	"RTN","PRC AACR",261, 0)
	2022	W !,"---- ---------- ----",?20, "--------- --",?33,"- ---",?39," ---------" ,?50,"---- --------", ?64,"----- ---------"
	2023	"RTN","PRC AACR",262, 0)
	2024	Q
	2025	"RTN","PRC AACR",263, 0)
	2026	;
	2027	"RTN","PRC AACR",264, 0)
	2028	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2029	"RTN","PRC AACR",265, 0)
	2030	W @IOF
	2031	"RTN","PRC AACR",266, 0)
	2032	S PAGE=PA GE+1
	2033	"RTN","PRC AACR",267, 0)
	2034	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y BILL
	2035	#)",?66,$$ UPPER^VALM 1($$FMTE^X LFDT(DT))
	2036	"RTN","PRC AACR",268, 0)
	2037	W !,DASH, !
	2038	"RTN","PRC AACR",269, 0)
	2039	W !,"BILL NO.",?13, "DEBTOR",? 33,"SSN",? 39,"TRANS NUM",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	2040	"RTN","PRC AACR",270, 0)
	2041	W !,"---- -------",? 13,"------ ---------- --",?33,"- ---",?39," ---------" ,?50,"---- --------", ?64,"----- ---------"
	2042	"RTN","PRC AACR",271, 0)
	2043	Q
	2044	"RTN","PRC AACR",272, 0)
	2045	;
	2046	"RTN","PRC AACR",273, 0)
	2047	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2048	"RTN","PRC AACR",274, 0)
	2049	W @IOF
	2050	"RTN","PRC AACR",275, 0)
	2051	S PAGE=PA GE+1
	2052	"RTN","PRC AACR",276, 0)
	2053	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y TRANSACT ION
	2054	NUMBER)",? 66,$$UPPER ^VALM1($$F MTE^XLFDT( DT))
	2055	"RTN","PRC AACR",277, 0)
	2056	W !,DASH, !
	2057	"RTN","PRC AACR",278, 0)
	2058	W !,"TRAN S NUM",?11 ,"DEBTOR", ?31,"BILL NO.",?44," SSN",?50," AUTO-C DAT E",?64,"AU TO-C REASO N"
	2059	"RTN","PRC AACR",279, 0)
	2060	W !,"---- -----",?11 ,"-------- ---------- ",?31,"--- --------", ?44,"----" ,?50,"---- --------", ?64,"----- ---------"
	2061	"RTN","PRC AACR",280, 0)
	2062	Q
	2063	"RTN","PRC AACR",281, 0)
	2064	;
	2065	"RTN","PRC AACR",282, 0)
	2066	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2067	"RTN","PRC AACR",283, 0)
	2068	W @IOF
	2069	"RTN","PRC AACR",284, 0)
	2070	S PAGE=PA GE+1
	2071	"RTN","PRC AACR",285, 0)
	2072	W "PAGE " _PAGE,?8," AUTO-CORRE CTED BILLS (SORTED B Y AUTO-COR RECTION
	2073	DATE)",?66 ,$$UPPER^V ALM1($$FMT E^XLFDT(DT ))
	2074	"RTN","PRC AACR",286, 0)
	2075	W !,DASH, !
	2076	"RTN","PRC AACR",287, 0)
	2077	W !,"AUTO -C DATE",? 14,"DEBTOR ",?34,"BIL L NO.",?47 ,"SSN",?53 ,"TRANS NU M",?64,"AU TO-C REASO N"
	2078	"RTN","PRC AACR",288, 0)
	2079	W !,"---- --------", ?14,"----- ---------- ---",?34," ---------- -",?47,"-- --",?53,"- --------", ?64,"----- ---------"
	2080	"RTN","PRC AACR",289, 0)
	2081	Q
	2082	"RTN","PRC AACR",290, 0)
	2083	;
	2084	"RTN","PRC AACR",291, 0)
	2085	EXIT ;
	2086	"RTN","PRC AACR",292, 0)
	2087	Q
	2088	"RTN","PRC AACR1")
	2089	0^20^B1512 71441^n/a
	2090	"RTN","PRC AACR1",1,0 )
	2091	PRCAACR1 ; ALBANY/BDB -PATIENT S TATEMENTS AUTO-CORRE CTION REPO RT ;09/21/ 15 3:34 PM
	2092	"RTN","PRC AACR1",2,0 )
	2093	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	2094	"RTN","PRC AACR1",3,0 )
	2095	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2096	"RTN","PRC AACR1",4,0 )
	2097	;
	2098	"RTN","PRC AACR1",5,0 )
	2099	Q
	2100	"RTN","PRC AACR1",6,0 )
	2101	;Print Re port when Queued to P-MES
	2102	"RTN","PRC AACR1",7,0 )
	2103	PRT ;
	2104	"RTN","PRC AACR1",8,0 )
	2105	U IO
	2106	"RTN","PRC AACR1",9,0 )
	2107	; build a rray of tr ansaction auto-corre cted
	2108	"RTN","PRC AACR1",10, 0)
	2109	K ^TMP("P RCAACR1",$ J)
	2110	"RTN","PRC AACR1",11, 0)
	2111	N DASH,PA GE
	2112	"RTN","PRC AACR1",12, 0)
	2113	S PAGE=0
	2114	"RTN","PRC AACR1",13, 0)
	2115	S DASH="" ,$P(DASH," -",79)=""
	2116	"RTN","PRC AACR1",14, 0)
	2117	N
	2118	PRCATSRT,P RCATN,PRCA ACD,PRCAAC R,PRCABN,P RCADATA,PR CADTR,PRCA SSN,PRCAIE N,PRCAACTF ,PRC
	2119	ATNTF,PRCA TEMP
	2120	"RTN","PRC AACR1",15, 0)
	2121	S PRCATSR T=PRCABDT- .00001,PRC AIEN=0
	2122	"RTN","PRC AACR1",16, 0)
	2123	; Loop th rough the specified date range
	2124	"RTN","PRC AACR1",17, 0)
	2125	F S PRCA TSRT=$O(^P RCA(433,"T ACD",PRCAT SRT)) Q:PR CATSRT=""! (PRCATSRT> PRCAEDT) D
	2126	"RTN","PRC AACR1",18, 0)
	2127	.S PRCATN =""
	2128	"RTN","PRC AACR1",19, 0)
	2129	.; Loop t hrough the transacti ons for th e current date
	2130	"RTN","PRC AACR1",20, 0)
	2131	.F S PRC ATN=$O(^PR CA(433,"TA CD",PRCATS RT,PRCATN) ) Q:'PRCAT N D
	2132	"RTN","PRC AACR1",21, 0)
	2133	..; Load associated data fiel ds for rep ort
	2134	"RTN","PRC AACR1",22, 0)
	2135	..S PRCAT NTF=PRCATN ; Transac tion Numbe r Ticket F lag
	2136	"RTN","PRC AACR1",23, 0)
	2137	..S PRCAB N=$P(^PRCA (433,PRCAT N,0),U,2)
	2138	"RTN","PRC AACR1",24, 0)
	2139	..S PRCAD TR=$$GET1^ DIQ(430,PR CABN_",",9 ) ; (#9) D EBTOR
	2140	"RTN","PRC AACR1",25, 0)
	2141	..S PRCAS SN=$G(^PRC A(430,PRCA BN,0)) ; L oad 0 Node
	2142	"RTN","PRC AACR1",26, 0)
	2143	..S PRCAS SN=$P(PRCA SSN,U,9) ; get IEN o f Debtor
	2144	"RTN","PRC AACR1",27, 0)
	2145	..S PRCAB N=$$GET1^D IQ(433,PRC ATN_",",.0 3) ; (#.03 ) BILL NUM BER
	2146	"RTN","PRC AACR1",28, 0)
	2147	..S PRCAS SN=$$GET1^ DIQ(340,PR CASSN_",", 110) ; SSN
	2148	"RTN","PRC AACR1",29, 0)
	2149	..S PRCAS SN=$E(PRCA SSN,6,9)
	2150	"RTN","PRC AACR1",30, 0)
	2151	..S PRCAA CD=$$GET1^ DIQ(433,PR CATN_",",9 4,"I") ;(# 94) AUTO-C ORRECTION DATE
	2152	"RTN","PRC AACR1",31, 0)
	2153	..S PRCAA CR=$$GET1^ DIQ(433,PR CATN_",",9 6) ;(#96) AUTO-CORRE CTION TYPE OF ERROR
	2154	"RTN","PRC AACR1",32, 0)
	2155	..S PRCAA CR=$E(PRCA ACR,1,14)
	2156	"RTN","PRC AACR1",33, 0)
	2157	..S PRCAA CTF=$$GET1 ^DIQ(433,P RCATN_",", 97) ;(#97) AUTO-CORRE CTION TICK ET FLAG
	2158	"RTN","PRC AACR1",34, 0)
	2159	..; If Ti cket Flag is set, re set Transa ction Numb er to null
	2160	"RTN","PRC AACR1",35, 0)
	2161	..I PRCAA CTF="YES" S PRCATNTF =""
	2162	"RTN","PRC AACR1",36, 0)
	2163	..;
	2164	"RTN","PRC AACR1",37, 0)
	2165	..; Stor e in ^TMP sorted by Auto-Corre ct Reason, Debtor an d Bill Num ber #
	2166	"RTN","PRC AACR1",38, 0)
	2167	..I PRCAS ORT=1 D Q
	2168	"RTN","PRC AACR1",39, 0)
	2169	...S
	2170	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	2171	_PRCAACD_U _PRCASSN
	2172	"RTN","PRC AACR1",40, 0)
	2173	..;
	2174	"RTN","PRC AACR1",41, 0)
	2175	..; Store in ^TMP s orted by D ebtor, Bil l Number a nd Transac tion #
	2176	"RTN","PRC AACR1",42, 0)
	2177	..I PRCAS ORT=2 D Q
	2178	"RTN","PRC AACR1",43, 0)
	2179	...S
	2180	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	2181	PRCAACD_U_ PRCAACR
	2182	"RTN","PRC AACR1",44, 0)
	2183	..;
	2184	"RTN","PRC AACR1",45, 0)
	2185	..; Store in ^TMP s orted by B ill Number , Debtor a nd Transac tion #
	2186	"RTN","PRC AACR1",46, 0)
	2187	..I PRCAS ORT=3 D Q
	2188	"RTN","PRC AACR1",47, 0)
	2189	...S
	2190	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	2191	PRCAACD_U_ PRCAACR
	2192	"RTN","PRC AACR1",48, 0)
	2193	..;
	2194	"RTN","PRC AACR1",49, 0)
	2195	..; Store in ^TMP s orted by T ransaction , Debtor a nd #Bill N umber
	2196	"RTN","PRC AACR1",50, 0)
	2197	..I PRCAS ORT=4 D Q
	2198	"RTN","PRC AACR1",51, 0)
	2199	...S
	2200	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	2201	PRCAACD_U_ PRCAACR
	2202	"RTN","PRC AACR1",52, 0)
	2203	..;
	2204	"RTN","PRC AACR1",53, 0)
	2205	..; Store in ^TMP s orted by A uto-Correc t Date, De btor, #Bil l Number a nd Transac tion Numbe r
	2206	"RTN","PRC AACR1",54, 0)
	2207	..I PRCAS ORT=5 D Q
	2208	"RTN","PRC AACR1",55, 0)
	2209	...S
	2210	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	2211	ASSN_U_PRC ATNTF_U_PR CAACR
	2212	"RTN","PRC AACR1",56, 0)
	2213	..Q
	2214	"RTN","PRC AACR1",57, 0)
	2215	;
	2216	"RTN","PRC AACR1",58, 0)
	2217	; Display Auto-Corr ect data s orted by B ill Number
	2218	"RTN","PRC AACR1",59, 0)
	2219	I PRCASOR T=1 D
	2220	"RTN","PRC AACR1",60, 0)
	2221	.; Print Header
	2222	"RTN","PRC AACR1",61, 0)
	2223	.D PSACRT P1
	2224	"RTN","PRC AACR1",62, 0)
	2225	.; Data L ayout
	2226	^TMP("PRCA ACR",$J,PR CAACR,PRCA DTR,PRCABN )=PRCAACR_ U_PRCADTR_ U_PRCABN_U _PRCATNTF_ U
	2227	_PRCAACD_U _PRCASSN
	2228	"RTN","PRC AACR1",63, 0)
	2229	.S PRCAAC R=""
	2230	"RTN","PRC AACR1",64, 0)
	2231	.N Y
	2232	"RTN","PRC AACR1",65, 0)
	2233	.F S PRC AACR=$O(^T MP("PRCAAC R",$J,PRCA ACR)) Q:PR CAACR="" D
	2234	"RTN","PRC AACR1",66, 0)
	2235	..S PRCAD TR=""
	2236	"RTN","PRC AACR1",67, 0)
	2237	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR)) Q:PRC ADTR="" D
	2238	"RTN","PRC AACR1",68, 0)
	2239	...S PRCA BN=""
	2240	"RTN","PRC AACR1",69, 0)
	2241	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACR,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2242	"RTN","PRC AACR1",70, 0)
	2243	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCAAC R,PRCADTR, PRCABN)
	2244	"RTN","PRC AACR1",71, 0)
	2245	....S Y=$ P(PRCADATA ,U,5)
	2246	"RTN","PRC AACR1",72, 0)
	2247	....D DD^ %DT
	2248	"RTN","PRC AACR1",73, 0)
	2249	....S $P( PRCADATA,U ,5)=Y
	2250	"RTN","PRC AACR1",74, 0)
	2251	....S PRC AIEN=PRCAI EN+1
	2252	"RTN","PRC AACR1",75, 0)
	2253	....; Add Auto-Corr ect Reason
	2254	"RTN","PRC AACR1",76, 0)
	2255	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,14 ),$E(PRCAT EMP,16)=" "
	2256	"RTN","PRC AACR1",77, 0)
	2257	....; Add 18 chars of Debtor' s name
	2258	"RTN","PRC AACR1",78, 0)
	2259	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,36)=" "
	2260	"RTN","PRC AACR1",79, 0)
	2261	....; Add SSN
	2262	"RTN","PRC AACR1",80, 0)
	2263	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 ),$E(PRCAT EMP,42)=" "
	2264	"RTN","PRC AACR1",81, 0)
	2265	....; Add Bill Numb er
	2266	"RTN","PRC AACR1",82, 0)
	2267	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,55)=" "
	2268	"RTN","PRC AACR1",83, 0)
	2269	....; Add Transacti on Number
	2270	"RTN","PRC AACR1",84, 0)
	2271	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 66)=" "
	2272	"RTN","PRC AACR1",85, 0)
	2273	....; Add Auto-Corr ect Date
	2274	"RTN","PRC AACR1",86, 0)
	2275	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,74)=" "
	2276	"RTN","PRC AACR1",87, 0)
	2277	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2278	"RTN","PRC AACR1",88, 0)
	2279	....Q
	2280	"RTN","PRC AACR1",89, 0)
	2281	;
	2282	"RTN","PRC AACR1",90, 0)
	2283	; Store i n ^TMP sor ted by Deb tor, Bill Number and Transacti on #
	2284	"RTN","PRC AACR1",91, 0)
	2285	I PRCASOR T=2 D
	2286	"RTN","PRC AACR1",92, 0)
	2287	.; Print Header
	2288	"RTN","PRC AACR1",93, 0)
	2289	.D PSACRT P2
	2290	"RTN","PRC AACR1",94, 0)
	2291	.; Data L ayout
	2292	^TMP("PRCA ACR",$J,PR CADTR,PRCA BN,PRCATN) =PRCADTR_U _PRCABN_U_ PRCASSN_U_ PRCATNTF_U _
	2293	PRCAACD_U_ PRCAACR
	2294	"RTN","PRC AACR1",95, 0)
	2295	.S PRCADT R=""
	2296	"RTN","PRC AACR1",96, 0)
	2297	.F S PRC ADTR=$O(^T MP("PRCAAC R",$J,PRCA DTR)) Q:PR CADTR="" D
	2298	"RTN","PRC AACR1",97, 0)
	2299	..S PRCAB N=""
	2300	"RTN","PRC AACR1",98, 0)
	2301	..F S PR CABN=$O(^T MP("PRCAAC R",$J,PRCA DTR,PRCABN )) Q:'PRCA BN D
	2302	"RTN","PRC AACR1",99, 0)
	2303	...S PRCA TN=""
	2304	"RTN","PRC AACR1",100 ,0)
	2305	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ADTR,PRCAB N,PRCATN)) Q:'PRCATN D
	2306	"RTN","PRC AACR1",101 ,0)
	2307	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCADT R,PRCABN,P RCATN)
	2308	"RTN","PRC AACR1",102 ,0)
	2309	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2310	"RTN","PRC AACR1",103 ,0)
	2311	....S PRC AIEN=PRCAI EN+1
	2312	"RTN","PRC AACR1",104 ,0)
	2313	....; Add 18 chars of Debtor' s name
	2314	"RTN","PRC AACR1",105 ,0)
	2315	....S PRC ATEMP=$E($ P(PRCADATA ,U,1),1,18 ),$E(PRCAT EMP,20)=" "
	2316	"RTN","PRC AACR1",106 ,0)
	2317	....; Add Bill Numb er
	2318	"RTN","PRC AACR1",107 ,0)
	2319	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,2 ),$E(PRCAT EMP,33)=" "
	2320	"RTN","PRC AACR1",108 ,0)
	2321	....; Add SSN
	2322	"RTN","PRC AACR1",109 ,0)
	2323	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2324	"RTN","PRC AACR1",110 ,0)
	2325	....; Add Transacti on Number
	2326	"RTN","PRC AACR1",111 ,0)
	2327	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2328	"RTN","PRC AACR1",112 ,0)
	2329	....; Add Auto-Corr ect Date
	2330	"RTN","PRC AACR1",113 ,0)
	2331	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2332	"RTN","PRC AACR1",114 ,0)
	2333	....; Add Auto-Corr ect Reason
	2334	"RTN","PRC AACR1",115 ,0)
	2335	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2336	"RTN","PRC AACR1",116 ,0)
	2337	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2338	"RTN","PRC AACR1",117 ,0)
	2339	....Q
	2340	"RTN","PRC AACR1",118 ,0)
	2341	;
	2342	"RTN","PRC AACR1",119 ,0)
	2343	; Store i n ^TMP sor ted by Aut o-Correct Date, Debt or, Bill N umber and Transactio n #
	2344	"RTN","PRC AACR1",120 ,0)
	2345	I PRCASOR T=3 D
	2346	"RTN","PRC AACR1",121 ,0)
	2347	.; Print Header
	2348	"RTN","PRC AACR1",122 ,0)
	2349	.D PSACRT P3
	2350	"RTN","PRC AACR1",123 ,0)
	2351	.; Data L ayout
	2352	^TMP("PRCA ACR",$J,PR CABN,PRCAD TR,PRCATN) =PRCABN_U_ PRCADTR_U_ PRCASSN_U_ PRCATNTF_U _
	2353	PRCAACD_U_ PRCAACR
	2354	"RTN","PRC AACR1",124 ,0)
	2355	.S PRCABN =""
	2356	"RTN","PRC AACR1",125 ,0)
	2357	.F S PRC ABN=$O(^TM P("PRCAACR ",$J,PRCAB N)) Q:'PRC ABN D
	2358	"RTN","PRC AACR1",126 ,0)
	2359	..S PRCAD TR=""
	2360	"RTN","PRC AACR1",127 ,0)
	2361	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R)) Q:PRCA DTR="" D
	2362	"RTN","PRC AACR1",128 ,0)
	2363	...S PRCA TN=""
	2364	"RTN","PRC AACR1",129 ,0)
	2365	...F S P RCATN=$O(^ TMP("PRCAA CR",$J,PRC ABN,PRCADT R,PRCATN)) Q:'PRCATN D
	2366	"RTN","PRC AACR1",130 ,0)
	2367	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCABN ,PRCADTR,P RCATN)
	2368	"RTN","PRC AACR1",131 ,0)
	2369	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2370	"RTN","PRC AACR1",132 ,0)
	2371	....S PRC AIEN=PRCAI EN+1
	2372	"RTN","PRC AACR1",133 ,0)
	2373	....; Add Bill Numb er
	2374	"RTN","PRC AACR1",134 ,0)
	2375	....S PRC ATEMP=$P(P RCADATA,U, 1),$E(PRCA TEMP,13)=" "
	2376	"RTN","PRC AACR1",135 ,0)
	2377	....; Add 18 chars of Debtor' s name
	2378	"RTN","PRC AACR1",136 ,0)
	2379	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,33)=" "
	2380	"RTN","PRC AACR1",137 ,0)
	2381	....; Add SSN
	2382	"RTN","PRC AACR1",138 ,0)
	2383	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,39)=" "
	2384	"RTN","PRC AACR1",139 ,0)
	2385	....; Add Transacti on Number
	2386	"RTN","PRC AACR1",140 ,0)
	2387	....S PRC ATEMP=PRCA TEMP_$J($P (PRCADATA, U,4),9),$E (PRCATEMP, 50)=" "
	2388	"RTN","PRC AACR1",141 ,0)
	2389	....; Add Auto-Corr ect Date
	2390	"RTN","PRC AACR1",142 ,0)
	2391	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2392	"RTN","PRC AACR1",143 ,0)
	2393	....; Add Auto-Corr ect Reason
	2394	"RTN","PRC AACR1",144 ,0)
	2395	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2396	"RTN","PRC AACR1",145 ,0)
	2397	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2398	"RTN","PRC AACR1",146 ,0)
	2399	....Q
	2400	"RTN","PRC AACR1",147 ,0)
	2401	;
	2402	"RTN","PRC AACR1",148 ,0)
	2403	; Store i n ^TMP sor ted by Tra nsaction, Debtor and #Bill Num ber
	2404	"RTN","PRC AACR1",149 ,0)
	2405	I PRCASOR T=4 D
	2406	"RTN","PRC AACR1",150 ,0)
	2407	.; Print Header
	2408	"RTN","PRC AACR1",151 ,0)
	2409	.D PSACRT P4
	2410	"RTN","PRC AACR1",152 ,0)
	2411	.; Data L ayout
	2412	^TMP("PRCA ACR",$J,PR CATN,PRCAD TR,PRCABN) =PRCATNTF_ U_PRCADTR_ U_PRCABN_U _PRCASSN_U _
	2413	PRCAACD_U_ PRCAACR
	2414	"RTN","PRC AACR1",153 ,0)
	2415	.S PRCATN =""
	2416	"RTN","PRC AACR1",154 ,0)
	2417	.F S PRC ATN=$O(^TM P("PRCAACR ",$J,PRCAT N)) Q:'PRC ATN D
	2418	"RTN","PRC AACR1",155 ,0)
	2419	..S PRCAD TR=""
	2420	"RTN","PRC AACR1",156 ,0)
	2421	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R)) Q:PRCA DTR="" D
	2422	"RTN","PRC AACR1",157 ,0)
	2423	...S PRCA BN=""
	2424	"RTN","PRC AACR1",158 ,0)
	2425	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC ATN,PRCADT R,PRCABN)) Q:'PRCABN D
	2426	"RTN","PRC AACR1",159 ,0)
	2427	....S PRC ADATA=^TMP ("PRCAACR" ,$J,PRCATN ,PRCADTR,P RCABN)
	2428	"RTN","PRC AACR1",160 ,0)
	2429	....S $P( PRCADATA,U ,5)=$$GET1 ^DIQ(433,P RCATN_",", 94)
	2430	"RTN","PRC AACR1",161 ,0)
	2431	....S PRC AIEN=PRCAI EN+1
	2432	"RTN","PRC AACR1",162 ,0)
	2433	....; Add Transacti on Number
	2434	"RTN","PRC AACR1",163 ,0)
	2435	....S PRC ATEMP=$J($ P(PRCADATA ,U,1),9),$ E(PRCATEMP ,11)=" "
	2436	"RTN","PRC AACR1",164 ,0)
	2437	....; Add 18 chars of Debtor' s name
	2438	"RTN","PRC AACR1",165 ,0)
	2439	....S PRC ATEMP=PRCA TEMP_$E($P (PRCADATA, U,2),1,18) ,$E(PRCATE MP,31)=" "
	2440	"RTN","PRC AACR1",166 ,0)
	2441	....; Add Bill Numb er
	2442	"RTN","PRC AACR1",167 ,0)
	2443	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,3 ),$E(PRCAT EMP,44)=" "
	2444	"RTN","PRC AACR1",168 ,0)
	2445	....; Add SSN
	2446	"RTN","PRC AACR1",169 ,0)
	2447	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,4 ),$E(PRCAT EMP,50)=" "
	2448	"RTN","PRC AACR1",170 ,0)
	2449	....; Add Auto-Corr ect Date
	2450	"RTN","PRC AACR1",171 ,0)
	2451	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,5 ),$E(PRCAT EMP,64)=" "
	2452	"RTN","PRC AACR1",172 ,0)
	2453	....; Add Auto-Corr ect Reason
	2454	"RTN","PRC AACR1",173 ,0)
	2455	....S PRC ATEMP=PRCA TEMP_$P(PR CADATA,U,6 )
	2456	"RTN","PRC AACR1",174 ,0)
	2457	....S ^TM P("PRCAACR 1",$J,PRCA IEN)=PRCAT EMP
	2458	"RTN","PRC AACR1",175 ,0)
	2459	....Q
	2460	"RTN","PRC AACR1",176 ,0)
	2461	;
	2462	"RTN","PRC AACR1",177 ,0)
	2463	; Display Auto-Corr ect data s orted by A uto-Correc t Reason
	2464	"RTN","PRC AACR1",178 ,0)
	2465	I PRCASOR T=5 D
	2466	"RTN","PRC AACR1",179 ,0)
	2467	.; Print Header
	2468	"RTN","PRC AACR1",180 ,0)
	2469	.D PSACRT P5
	2470	"RTN","PRC AACR1",181 ,0)
	2471	.; Data L ayout
	2472	^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)=P RCAACD_U_P RCADTR_U_P RCABN_U_PR C
	2473	ASSN_U_PRC ATNTF_U_PR CAACR
	2474	"RTN","PRC AACR1",182 ,0)
	2475	.S PRCAAC D=""
	2476	"RTN","PRC AACR1",183 ,0)
	2477	.F S PRC AACD=$O(^T MP("PRCAAC R",$J,PRCA ACD)) Q:PR CAACD="" D
	2478	"RTN","PRC AACR1",184 ,0)
	2479	..S PRCAD TR=""
	2480	"RTN","PRC AACR1",185 ,0)
	2481	..F S PR CADTR=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR)) Q:PRC ADTR="" D
	2482	"RTN","PRC AACR1",186 ,0)
	2483	...S PRCA BN=""
	2484	"RTN","PRC AACR1",187 ,0)
	2485	...F S P RCABN=$O(^ TMP("PRCAA CR",$J,PRC AACD,PRCAD TR,PRCABN) ) Q:'PRCAB N D
	2486	"RTN","PRC AACR1",188 ,0)
	2487	....S PRC ATN=""
	2488	"RTN","PRC AACR1",189 ,0)
	2489	....F S PRCATN=$O( ^TMP("PRCA ACR",$J,PR CAACD,PRCA DTR,PRCABN ,PRCATN)) Q:'PRCATN D
	2490	"RTN","PRC AACR1",190 ,0)
	2491	.....S PR CADATA=^TM P("PRCAACR ",$J,PRCAA CD,PRCADTR ,PRCABN,PR CATN)
	2492	"RTN","PRC AACR1",191 ,0)
	2493	.....S $P (PRCADATA, U,1)=$$GET 1^DIQ(433, PRCATN_"," ,94)
	2494	"RTN","PRC AACR1",192 ,0)
	2495	.....S PR CAIEN=PRCA IEN+1
	2496	"RTN","PRC AACR1",193 ,0)
	2497	.....; Ad d Auto-Cor rect Date
	2498	"RTN","PRC AACR1",194 ,0)
	2499	.....S PR CATEMP=$P( PRCADATA,U ,1),$E(PRC ATEMP,14)= " "
	2500	"RTN","PRC AACR1",195 ,0)
	2501	.....; Ad d 18 chars of Debtor 's name
	2502	"RTN","PRC AACR1",196 ,0)
	2503	.....S PR CATEMP=PRC ATEMP_$E($ P(PRCADATA ,U,2),1,18 ),$E(PRCAT EMP,34)=" "
	2504	"RTN","PRC AACR1",197 ,0)
	2505	.....; Ad d Bill Num ber
	2506	"RTN","PRC AACR1",198 ,0)
	2507	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 3),$E(PRCA TEMP,47)=" "
	2508	"RTN","PRC AACR1",199 ,0)
	2509	.....; Ad d SSN
	2510	"RTN","PRC AACR1",200 ,0)
	2511	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 4),$E(PRCA TEMP,53)=" "
	2512	"RTN","PRC AACR1",201 ,0)
	2513	.....; Ad d Transact ion Number
	2514	"RTN","PRC AACR1",202 ,0)
	2515	.....S PR CATEMP=PRC ATEMP_$J($ P(PRCADATA ,U,5),9),$ E(PRCATEMP ,64)=" "
	2516	"RTN","PRC AACR1",203 ,0)
	2517	.....; Ad d Auto-Cor rect Reaso n
	2518	"RTN","PRC AACR1",204 ,0)
	2519	.....S PR CATEMP=PRC ATEMP_$P(P RCADATA,U, 6)
	2520	"RTN","PRC AACR1",205 ,0)
	2521	.....S ^T MP("PRCAAC R1",$J,PRC AIEN)=PRCA TEMP
	2522	"RTN","PRC AACR1",206 ,0)
	2523	.....Q
	2524	"RTN","PRC AACR1",207 ,0)
	2525	;
	2526	"RTN","PRC AACR1",208 ,0)
	2527	; Send Ma ilMan mess age with N o Forward
	2528	"RTN","PRC AACR1",209 ,0)
	2529	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ
	2530	"RTN","PRC AACR1",210 ,0)
	2531	I PRCASOR T=1 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N REASON)"
	2532	"RTN","PRC AACR1",211 ,0)
	2533	I PRCASOR T=2 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY DEBT OR)"
	2534	"RTN","PRC AACR1",212 ,0)
	2535	I PRCASOR T=3 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY BILL #)"
	2536	"RTN","PRC AACR1",213 ,0)
	2537	I PRCASOR T=4 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY TRAN SACTION NU MBER)"
	2538	"RTN","PRC AACR1",214 ,0)
	2539	I PRCASOR T=5 S XMSU BJ="AUTO-C ORRECTED B ILLS (SORT ED BY AUTO -CORRECTIO N DATE)"
	2540	"RTN","PRC AACR1",215 ,0)
	2541	S XMTO(DU Z)=""
	2542	"RTN","PRC AACR1",216 ,0)
	2543	S XMBODY= "^TMP(""PR CAACR1"",$ J)"
	2544	"RTN","PRC AACR1",217 ,0)
	2545	S XMINSTR ("FLAGS")= "X"
	2546	"RTN","PRC AACR1",218 ,0)
	2547	S XMDUZ=D UZ
	2548	"RTN","PRC AACR1",219 ,0)
	2549	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	2550	"RTN","PRC AACR1",220 ,0)
	2551	D HOME^%Z IS
	2552	"RTN","PRC AACR1",221 ,0)
	2553	K IO("Q") ,POP
	2554	"RTN","PRC AACR1",222 ,0)
	2555	K ^TMP("P RCAACR",$J )
	2556	"RTN","PRC AACR1",223 ,0)
	2557	K ^TMP("P RCAACR1",$ J)
	2558	"RTN","PRC AACR1",224 ,0)
	2559	K PRCABDT ,PRCAEDT,P RCASORT
	2560	"RTN","PRC AACR1",225 ,0)
	2561	Q
	2562	"RTN","PRC AACR1",226 ,0)
	2563	;
	2564	"RTN","PRC AACR1",227 ,0)
	2565	PSACRTP1 ; header fo r patient statement auto-corre ction repo rt 1
	2566	"RTN","PRC AACR1",228 ,0)
	2567	S PAGE=PA GE+1
	2568	"RTN","PRC AACR1",229 ,0)
	2569	S PRCAIEN =PRCAIEN+1
	2570	"RTN","PRC AACR1",230 ,0)
	2571	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2572	"RTN","PRC AACR1",231 ,0)
	2573	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2574	"RTN","PRC AACR1",232 ,0)
	2575	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION REASON)"
	2576	"RTN","PRC AACR1",233 ,0)
	2577	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2578	"RTN","PRC AACR1",234 ,0)
	2579	S PRCAIEN =PRCAIEN+1
	2580	"RTN","PRC AACR1",235 ,0)
	2581	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2582	"RTN","PRC AACR1",236 ,0)
	2583	S PRCAIEN =PRCAIEN+1
	2584	"RTN","PRC AACR1",237 ,0)
	2585	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2586	"RTN","PRC AACR1",238 ,0)
	2587	S PRCAIEN =PRCAIEN+1
	2588	"RTN","PRC AACR1",239 ,0)
	2589	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2590	"RTN","PRC AACR1",240 ,0)
	2591	S PRCADAT A="AUTO-C REASON D EBTOR S SN BILL NO. TR ANS NUM A UTO-C DATE "
	2592	"RTN","PRC AACR1",241 ,0)
	2593	S PRCAIEN =PRCAIEN+1
	2594	"RTN","PRC AACR1",242 ,0)
	2595	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2596	"RTN","PRC AACR1",243 ,0)
	2597	S PRCADAT A="------- ------- - ---------- ------- - --- ----- ------ -- ------- - ---------- -"
	2598	"RTN","PRC AACR1",244 ,0)
	2599	S PRCAIEN =PRCAIEN+1
	2600	"RTN","PRC AACR1",245 ,0)
	2601	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2602	"RTN","PRC AACR1",246 ,0)
	2603	Q
	2604	"RTN","PRC AACR1",247 ,0)
	2605	;
	2606	"RTN","PRC AACR1",248 ,0)
	2607	PSACRTP2 ; header fo r patient statement auto-corre ction repo rt 2
	2608	"RTN","PRC AACR1",249 ,0)
	2609	S PAGE=PA GE+1
	2610	"RTN","PRC AACR1",250 ,0)
	2611	S PRCAIEN =PRCAIEN+1
	2612	"RTN","PRC AACR1",251 ,0)
	2613	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2614	"RTN","PRC AACR1",252 ,0)
	2615	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2616	"RTN","PRC AACR1",253 ,0)
	2617	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY DEBTOR )"
	2618	"RTN","PRC AACR1",254 ,0)
	2619	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2620	"RTN","PRC AACR1",255 ,0)
	2621	S PRCAIEN =PRCAIEN+1
	2622	"RTN","PRC AACR1",256 ,0)
	2623	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2624	"RTN","PRC AACR1",257 ,0)
	2625	S PRCAIEN =PRCAIEN+1
	2626	"RTN","PRC AACR1",258 ,0)
	2627	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2628	"RTN","PRC AACR1",259 ,0)
	2629	S PRCAIEN =PRCAIEN+1
	2630	"RTN","PRC AACR1",260 ,0)
	2631	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2632	"RTN","PRC AACR1",261 ,0)
	2633	S PRCADAT A="DEBTOR BILL NO . SSN TRANS NU M AUTO-C DATE AUT O-C REASON "
	2634	"RTN","PRC AACR1",262 ,0)
	2635	S PRCAIEN =PRCAIEN+1
	2636	"RTN","PRC AACR1",263 ,0)
	2637	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2638	"RTN","PRC AACR1",264 ,0)
	2639	S PRCADAT A="------- ---------- - ------- ---- ---- -------- - ------- ----- --- ---------- -"
	2640	"RTN","PRC AACR1",265 ,0)
	2641	S PRCAIEN =PRCAIEN+1
	2642	"RTN","PRC AACR1",266 ,0)
	2643	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2644	"RTN","PRC AACR1",267 ,0)
	2645	Q
	2646	"RTN","PRC AACR1",268 ,0)
	2647	;
	2648	"RTN","PRC AACR1",269 ,0)
	2649	PSACRTP3 ; header fo r patient statement auto-corre ction repo rt 3
	2650	"RTN","PRC AACR1",270 ,0)
	2651	S PAGE=PA GE+1
	2652	"RTN","PRC AACR1",271 ,0)
	2653	S PRCAIEN =PRCAIEN+1
	2654	"RTN","PRC AACR1",272 ,0)
	2655	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2656	"RTN","PRC AACR1",273 ,0)
	2657	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2658	"RTN","PRC AACR1",274 ,0)
	2659	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY BILL # )"
	2660	"RTN","PRC AACR1",275 ,0)
	2661	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2662	"RTN","PRC AACR1",276 ,0)
	2663	S PRCAIEN =PRCAIEN+1
	2664	"RTN","PRC AACR1",277 ,0)
	2665	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2666	"RTN","PRC AACR1",278 ,0)
	2667	S PRCAIEN =PRCAIEN+1
	2668	"RTN","PRC AACR1",279 ,0)
	2669	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2670	"RTN","PRC AACR1",280 ,0)
	2671	S PRCAIEN =PRCAIEN+1
	2672	"RTN","PRC AACR1",281 ,0)
	2673	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2674	"RTN","PRC AACR1",282 ,0)
	2675	S PRCADAT A="BILL NO . DEBT OR SSN TRANS NU M AUTO-C DATE AUT O-C REASON "
	2676	"RTN","PRC AACR1",283 ,0)
	2677	S PRCAIEN =PRCAIEN+1
	2678	"RTN","PRC AACR1",284 ,0)
	2679	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2680	"RTN","PRC AACR1",285 ,0)
	2681	S PRCADAT A="------- ---- ---- ---------- ---- ---- -------- - ------- ----- --- ---------- -"
	2682	"RTN","PRC AACR1",286 ,0)
	2683	S PRCAIEN =PRCAIEN+1
	2684	"RTN","PRC AACR1",287 ,0)
	2685	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2686	"RTN","PRC AACR1",288 ,0)
	2687	Q
	2688	"RTN","PRC AACR1",289 ,0)
	2689	;
	2690	"RTN","PRC AACR1",290 ,0)
	2691	PSACRTP4 ; header fo r patient statement auto-corre ction repo rt 4
	2692	"RTN","PRC AACR1",291 ,0)
	2693	S PAGE=PA GE+1
	2694	"RTN","PRC AACR1",292 ,0)
	2695	S PRCAIEN =PRCAIEN+1
	2696	"RTN","PRC AACR1",293 ,0)
	2697	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2698	"RTN","PRC AACR1",294 ,0)
	2699	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2700	"RTN","PRC AACR1",295 ,0)
	2701	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY TRANSA CTION NUMB ER)"
	2702	"RTN","PRC AACR1",296 ,0)
	2703	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2704	"RTN","PRC AACR1",297 ,0)
	2705	S PRCAIEN =PRCAIEN+1
	2706	"RTN","PRC AACR1",298 ,0)
	2707	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2708	"RTN","PRC AACR1",299 ,0)
	2709	S PRCAIEN =PRCAIEN+1
	2710	"RTN","PRC AACR1",300 ,0)
	2711	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2712	"RTN","PRC AACR1",301 ,0)
	2713	S PRCAIEN =PRCAIEN+1
	2714	"RTN","PRC AACR1",302 ,0)
	2715	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2716	"RTN","PRC AACR1",303 ,0)
	2717	S PRCADAT A="TRANS N UM DEBTOR BILL N O. SSN AUTO-C DATE AUT O-C REASON "
	2718	"RTN","PRC AACR1",304 ,0)
	2719	S PRCAIEN =PRCAIEN+1
	2720	"RTN","PRC AACR1",305 ,0)
	2721	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2722	"RTN","PRC AACR1",306 ,0)
	2723	S PRCADAT A="------- -- ------ ---------- -- ------ ----- --- - ------- ----- --- ---------- -"
	2724	"RTN","PRC AACR1",307 ,0)
	2725	S PRCAIEN =PRCAIEN+1
	2726	"RTN","PRC AACR1",308 ,0)
	2727	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2728	"RTN","PRC AACR1",309 ,0)
	2729	Q
	2730	"RTN","PRC AACR1",310 ,0)
	2731	;
	2732	"RTN","PRC AACR1",311 ,0)
	2733	PSACRTP5 ; header fo r patient statement auto-corre ction repo rt 5
	2734	"RTN","PRC AACR1",312 ,0)
	2735	S PAGE=PA GE+1
	2736	"RTN","PRC AACR1",313 ,0)
	2737	S PRCAIEN =PRCAIEN+1
	2738	"RTN","PRC AACR1",314 ,0)
	2739	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2740	"RTN","PRC AACR1",315 ,0)
	2741	S PRCADAT A="PAGE "_ PAGE,$E(PR CADATA,9)= ""
	2742	"RTN","PRC AACR1",316 ,0)
	2743	S PRCADAT A=PRCADATA _"AUTO-COR RECTED BIL LS (SORTED BY AUTO-C ORRECTION DATE)"
	2744	"RTN","PRC AACR1",317 ,0)
	2745	S $E(PRCA DATA,66)=" ",PRCADATA =PRCADATA_ $$UPPER^VA LM1($$FMTE ^XLFDT(DT) )
	2746	"RTN","PRC AACR1",318 ,0)
	2747	S PRCAIEN =PRCAIEN+1
	2748	"RTN","PRC AACR1",319 ,0)
	2749	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2750	"RTN","PRC AACR1",320 ,0)
	2751	S PRCAIEN =PRCAIEN+1
	2752	"RTN","PRC AACR1",321 ,0)
	2753	S ^TMP("P RCAACR1",$ J,PRCAIEN) =DASH
	2754	"RTN","PRC AACR1",322 ,0)
	2755	S PRCAIEN =PRCAIEN+1
	2756	"RTN","PRC AACR1",323 ,0)
	2757	S ^TMP("P RCAACR1",$ J,PRCAIEN) =""
	2758	"RTN","PRC AACR1",324 ,0)
	2759	S PRCADAT A="AUTO-C DATE DEB TOR BIL L NO. SSN TRAN S NUM AUT O-C REASON "
	2760	"RTN","PRC AACR1",325 ,0)
	2761	S PRCAIEN =PRCAIEN+1
	2762	"RTN","PRC AACR1",326 ,0)
	2763	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2764	"RTN","PRC AACR1",327 ,0)
	2765	S PRCADAT A="------- ----- --- ---------- ----- --- -------- ---- ---- ----- --- ---------- -"
	2766	"RTN","PRC AACR1",328 ,0)
	2767	S PRCAIEN =PRCAIEN+1
	2768	"RTN","PRC AACR1",329 ,0)
	2769	S ^TMP("P RCAACR1",$ J,PRCAIEN) =PRCADATA
	2770	"RTN","PRC AACR1",330 ,0)
	2771	Q
	2772	"RTN","PRC AACR1",331 ,0)
	2773	;
	2774	"RTN","PRC AACR1",332 ,0)
	2775	EXIT ;
	2776	"RTN","PRC AACR1",333 ,0)
	2777	Q
	2778	"RTN","PRC ACPS")
	2779	0^27^B2540 66716^n/a
	2780	"RTN","PRC ACPS",1,0)
	2781	PRCACPS ;A LBANY/BDB- PATIENT ST ATEMENTS A UTO-CORREC TION ;09/2 1/15 3:34 PM
	2782	"RTN","PRC ACPS",2,0)
	2783	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	2784	"RTN","PRC ACPS",3,0)
	2785	;;Per VA Directive 6402, this routine s hould not be modifie d.
	2786	"RTN","PRC ACPS",4,0)
	2787	;
	2788	"RTN","PRC ACPS",5,0)
	2789	Q
	2790	"RTN","PRC ACPS",6,0)
	2791	;
	2792	"RTN","PRC ACPS",7,0)
	2793	BEGIN ; En try point for manual run
	2794	"RTN","PRC ACPS",8,0)
	2795	; Determi ne if Auto Correct p rocess is currently running
	2796	"RTN","PRC ACPS",9,0)
	2797	N DIR,PRC ASTRT,QUIT ,X,X1,X2,Y
	2798	"RTN","PRC ACPS",10,0 )
	2799	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0)),QUIT= 0
	2800	"RTN","PRC ACPS",11,0 )
	2801	; Notify user if Au to Correct process i s currentl y running
	2802	"RTN","PRC ACPS",12,0 )
	2803	I PRCASTR T'="" D Q :QUIT
	2804	"RTN","PRC ACPS",13,0 )
	2805	.S Y=$P(P RCASTRT,U, 2)
	2806	"RTN","PRC ACPS",14,0 )
	2807	.D DD^%DT
	2808	"RTN","PRC ACPS",15,0 )
	2809	.S PRCAST RT=Y
	2810	"RTN","PRC ACPS",16,0 )
	2811	.W !!,"Th e Patient Statement Auto-Corre ction Prog ram was pr eviously s tarted on"
	2812	"RTN","PRC ACPS",17,0 )
	2813	.W !,PRCA STRT," and has not y et success fully comp leted."
	2814	"RTN","PRC ACPS",18,0 )
	2815	.W !!,"Th e job can take up to 1 hour to complete when sched uled to ru n outside"
	2816	"RTN","PRC ACPS",19,0 )
	2817	.W !,"of normal bus iness hour s and long er if run during nor mal busine ss hours"
	2818	"RTN","PRC ACPS",20,0 )
	2819	.W !,"whe n the load on the sy stem is gr eater."
	2820	"RTN","PRC ACPS",21,0 )
	2821	.W !!
	2822	"RTN","PRC ACPS",22,0 )
	2823	.W !,"If it has bee n more tha n an hour since the Patient St atement Au to-Correct ion"
	2824	"RTN","PRC ACPS",23,0 )
	2825	.W !,"Pro gram was s tarted and the confi rmation e- mail with subject: C PS"
	2826	"RTN","PRC ACPS",24,0 )
	2827	.W !,"AUT O-CORRECTI ON COMPLET E has not been sent to the PRC ACPS mail group, you can"
	2828	"RTN","PRC ACPS",25,0 )
	2829	.W !,"run the Patie nt Stateme nt Auto-Co rrection P rogram aga in."
	2830	"RTN","PRC ACPS",26,0 )
	2831	.W !
	2832	"RTN","PRC ACPS",27,0 )
	2833	.S DIR("A ")="Do you want to r un the Pat ient State ment Auto- Correction Program a gain"
	2834	"RTN","PRC ACPS",28,0 )
	2835	.S DIR(0) ="Y",DIR(" B")="NO"
	2836	"RTN","PRC ACPS",29,0 )
	2837	.D ^DIR
	2838	"RTN","PRC ACPS",30,0 )
	2839	.W !
	2840	"RTN","PRC ACPS",31,0 )
	2841	.; Quit i f ^, ^^, T imeout or No
	2842	"RTN","PRC ACPS",32,0 )
	2843	.I $D(DTO UT)!($D(DU OUT))!($D( DIROUT))!( Y=0) S QUI T=1
	2844	"RTN","PRC ACPS",33,0 )
	2845	.K DTOUT, DUOUT,DIRO UT
	2846	"RTN","PRC ACPS",34,0 )
	2847	.Q
	2848	"RTN","PRC ACPS",35,0 )
	2849	;
	2850	"RTN","PRC ACPS",36,0 )
	2851	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K
	2852	"RTN","PRC ACPS",37,0 )
	2853	W !,"Queu e the pati ent statem ent discre pancies au to-correct ion progra m to run:"
	2854	"RTN","PRC ACPS",38,0 )
	2855	S ZTDESC= "Auto-Corr ect Patien t Statemen t Discrepa ncies"
	2856	"RTN","PRC ACPS",39,0 )
	2857	S ZTRTN=" START^PRCA CPS",ZTIO= ""
	2858	"RTN","PRC ACPS",40,0 )
	2859	D ^%ZTLOA D
	2860	"RTN","PRC ACPS",41,0 )
	2861	Q
	2862	"RTN","PRC ACPS",42,0 )
	2863	;
	2864	"RTN","PRC ACPS",43,0 )
	2865	START ; En try point for Schedu led backgr ound job
	2866	"RTN","PRC ACPS",44,0 )
	2867	N DEBTOR, DEBTOR0,DE BTOR1,PRCA STRT,REFRE V,X,Y
	2868	"RTN","PRC ACPS",45,0 )
	2869	S PRCASTR T=$G(^XTMP ("PRCACPS" ,0))
	2870	"RTN","PRC ACPS",46,0 )
	2871	; If a pr evious job still run ning send e-mail war ning to PR CACPS mail group
	2872	"RTN","PRC ACPS",47,0 )
	2873	I PRCASTR T'="" D
	2874	"RTN","PRC ACPS",48,0 )
	2875	.S Y=$P(P RCASTRT,U, 2)
	2876	"RTN","PRC ACPS",49,0 )
	2877	.; Conver t date to external f ormat
	2878	"RTN","PRC ACPS",50,0 )
	2879	.D DD^%DT
	2880	"RTN","PRC ACPS",51,0 )
	2881	.S PRCAST RT=Y
	2882	"RTN","PRC ACPS",52,0 )
	2883	.; Send m ail to PRC ACPS mail group noti ng previou s run didn 't complet e
	2884	"RTN","PRC ACPS",53,0 )
	2885	.D PRCAMA IL^PRCACPS A(PRCASTRT )
	2886	"RTN","PRC ACPS",54,0 )
	2887	.Q
	2888	"RTN","PRC ACPS",55,0 )
	2889	; Get cur rent date/ time
	2890	"RTN","PRC ACPS",56,0 )
	2891	D NOW^%DT C
	2892	"RTN","PRC ACPS",57,0 )
	2893	S (PRCAST RT,X1)=%,X 2=8
	2894	"RTN","PRC ACPS",58,0 )
	2895	D C^%DTC
	2896	"RTN","PRC ACPS",59,0 )
	2897	S ^XTMP(" PRCACPS",0 )=X_U_PRCA STRT_U_"Pa tient Stat ement Auto -Correctio n Program"
	2898	"RTN","PRC ACPS",60,0 )
	2899	; Loop th rough C x- ref in 430 . This fie ld points to the Deb tor File, which in t urn is a
	2900	"RTN","PRC ACPS",61,0 )
	2901	; variabl e pointer to other f iles.
	2902	"RTN","PRC ACPS",62,0 )
	2903	S DEBTOR= 0
	2904	"RTN","PRC ACPS",63,0 )
	2905	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	2906	"RTN","PRC ACPS",64,0 )
	2907	.; Perfor m the same in/out of balance c heck as th e CHECK PA TIENT ACCO UNT BALANC E option
	2908	"RTN","PRC ACPS",65,0 )
	2909	.; Quit t o next deb tor if acc ount is in balance
	2910	"RTN","PRC ACPS",66,0 )
	2911	.I '$$EN^ PRCAMRKC(D EBTOR) Q
	2912	"RTN","PRC ACPS",67,0 )
	2913	.S BALDIF F=0
	2914	"RTN","PRC ACPS",68,0 )
	2915	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) )
	2916	"RTN","PRC ACPS",69,0 )
	2917	.; QUIT i f it doesn 't point t o the PATI ENT (^DPT) file
	2918	"RTN","PRC ACPS",70,0 )
	2919	.Q:$P(DEB TOR0,"^")' ["DPT("
	2920	"RTN","PRC ACPS",71,0 )
	2921	.Q:$P(DEB TOR1,"^",9 )=1 ; qui t if debto r address marked unk nown
	2922	"RTN","PRC ACPS",72,0 )
	2923	.; Skip t his Debtor is they a t least 1 Bill in #4 30 with a status of REFUND REV IEW (#44)
	2924	"RTN","PRC ACPS",73,0 )
	2925	.Q:$$REFR EV(DEBTOR)
	2926	"RTN","PRC ACPS",74,0 )
	2927	.; Get pr evious bal ance and d ate of las t transact ion from t he AR EVEN T file (#3 41)
	2928	"RTN","PRC ACPS",75,0 )
	2929	.D ENTER( DEBTOR)
	2930	"RTN","PRC ACPS",76,0 )
	2931	.; Perfor m checks/u pdates bas ed on File #430
	2932	"RTN","PRC ACPS",77,0 )
	2933	.D START1
	2934	"RTN","PRC ACPS",78,0 )
	2935	.; QUIT i f in balan ce
	2936	"RTN","PRC ACPS",79,0 )
	2937	.; *** Re moved so a ll out of balance ac counts to enter STAR T2
	2938	"RTN","PRC ACPS",80,0 )
	2939	.;I BALDI FF=0 K BAL DIFF,^TMP( "PRCAGTPS" ,$J),^TMP( "PRCABILL" ,$J) Q
	2940	"RTN","PRC ACPS",81,0 )
	2941	.; Review Data in ^ TMP and up date #433 as needed
	2942	"RTN","PRC ACPS",82,0 )
	2943	.D START2
	2944	"RTN","PRC ACPS",83,0 )
	2945	.; If the account i s still ou t of balan ce after f ixing ever ything it can
	2946	"RTN","PRC ACPS",84,0 )
	2947	.; call U PDTLTR to mark the l ast transa ction for the accoun t as NOT F IXABLE
	2948	"RTN","PRC ACPS",85,0 )
	2949	.I $$EN^P RCAMRKC(DE BTOR) D UP DTLTR^PRCA CPSA(0)
	2950	"RTN","PRC ACPS",86,0 )
	2951	.; clean up temp in fo and pro cess next debtor
	2952	"RTN","PRC ACPS",87,0 )
	2953	.K BALDIF F,^TMP("PR CAGTPS",$J ),^TMP("PR CABILL",$J )
	2954	"RTN","PRC ACPS",88,0 )
	2955	; Send ma ilman mess age to the PRCACPS m ail group at end of processing
	2956	"RTN","PRC ACPS",89,0 )
	2957	D USRMSG
	2958	"RTN","PRC ACPS",90,0 )
	2959	Q
	2960	"RTN","PRC ACPS",91,0 )
	2961	;
	2962	"RTN","PRC ACPS",92,0 )
	2963	REFREV(DEB TOR) ;
	2964	"RTN","PRC ACPS",93,0 )
	2965	; Check i f any Bill for this Debtor has a status of REFUND REVIEW (#4 4)
	2966	"RTN","PRC ACPS",94,0 )
	2967	N BN,QUIT
	2968	"RTN","PRC ACPS",95,0 )
	2969	S BN="",Q UIT=0
	2970	"RTN","PRC ACPS",96,0 )
	2971	F S BN=$ O(^PRCA(43 0,"C",DEBT OR,BN)) Q: 'BN D Q: QUIT
	2972	"RTN","PRC ACPS",97,0 )
	2973	.; Check CURRENT ST ATUS (#8) for status of REFUND REVIEW (# 44)
	2974	"RTN","PRC ACPS",98,0 )
	2975	.I $P($G( ^PRCA(430, BN,0)),U,8 )=44 S QUI T=1
	2976	"RTN","PRC ACPS",99,0 )
	2977	Q QUIT
	2978	"RTN","PRC ACPS",100, 0)
	2979	;
	2980	"RTN","PRC ACPS",101, 0)
	2981	ENTER(DEBT OR) ;
	2982	"RTN","PRC ACPS",102, 0)
	2983	S (PBAL,B BAL,TBAL)= 0 K ^TMP(" PRCAGTPS", $J)
	2984	"RTN","PRC ACPS",103, 0)
	2985	; Get las t type of event for debtor by calling $$ LST^RCFN01 . Referenc es files # 340 and #3 41.1
	2986	"RTN","PRC ACPS",104, 0)
	2987	S DAT=$$L ST^RCFN01( DEBTOR,2) I DAT<1 S DAT=0
	2988	"RTN","PRC ACPS",105, 0)
	2989	; PBAL^PR CAGU gets previous b alance and date of l ast transa ction from the AR EV ENT file ( #341)
	2990	"RTN","PRC ACPS",106, 0)
	2991	I DAT S D AT=9999999 .999999-DA T D PBAL^P RCAGU(DEBT OR,.DAT,.P BAL)
	2992	"RTN","PRC ACPS",107, 0)
	2993	D EN(DEBT OR,DAT)
	2994	"RTN","PRC ACPS",108, 0)
	2995	K BBAL,TB AL,DAT
	2996	"RTN","PRC ACPS",109, 0)
	2997	Q
	2998	"RTN","PRC ACPS",110, 0)
	2999	;
	3000	"RTN","PRC ACPS",111, 0)
	3001	EN(DEBTOR, BEG,END,TT Y) ;
	3002	"RTN","PRC ACPS",112, 0)
	3003	NEW Y
	3004	"RTN","PRC ACPS",113, 0)
	3005	; If Begi nning date is not de fined, set it to 0 t o start at beginning
	3006	"RTN","PRC ACPS",114, 0)
	3007	; If End date is no t defined, set it to today's d ate
	3008	"RTN","PRC ACPS",115, 0)
	3009	S:$G(BEG) ="" BEG=0 I $G(END)= "" D NOW^% DTC S END= % K %
	3010	"RTN","PRC ACPS",116, 0)
	3011	S TTY=$G( TTY) I TTY ="" D F430
	3012	"RTN","PRC ACPS",117, 0)
	3013	D F433
	3014	"RTN","PRC ACPS",118, 0)
	3015	Q Q
	3016	"RTN","PRC ACPS",119, 0)
	3017	F430 ; Che cks for AC COUNTS REC EIVABLE fi le (#430) for bills with (#3) ORIGINAL A MOUNT has a value,
	3018	"RTN","PRC ACPS",120, 0)
	3019	; set thi s into the ^TMP glob al with _" ^0"
	3020	"RTN","PRC ACPS",121, 0)
	3021	NEW DAT,B N
	3022	"RTN","PRC ACPS",122, 0)
	3023	S DAT=BEG F S DAT= $O(^PRCA(4 30,"ATD",D EBTOR,DAT) ) Q:('DAT) !(DAT>END) S BN=0 F S
	3024	BN=$O(^PRC A(430,"ATD ",DEBTOR,D AT,BN)) Q: 'BN D
	3025	"RTN","PRC ACPS",123, 0)
	3026	.; Add th e original amount if it is wit hin date r ange based on the da te of the last state ment
	3027	"RTN","PRC ACPS",124, 0)
	3028	.I $P(^PR CA(430,BN, 0),U,3) S ^TMP("PRCA GTPS",$J,D EBTOR,BN,0 )=$P(^PRCA (430,BN,0) ,"^",3)_"^ 0"
	3029	"RTN","PRC ACPS",125, 0)
	3030	Q
	3031	"RTN","PRC ACPS",126, 0)
	3032	F433 ;
	3033	"RTN","PRC ACPS",127, 0)
	3034	NEW DAT,T N
	3035	"RTN","PRC ACPS",128, 0)
	3036	; Loop th rough the Dates and Bills
	3037	"RTN","PRC ACPS",129, 0)
	3038	F DAT=BEG :0 S DAT=$ O(^PRCA(43 3,"ATD",DE BTOR,DAT)) Q:('DAT)! (DAT>END) F TN=0:0 S
	3039	TN=$O(^PRC A(433,"ATD ",DEBTOR,D AT,TN)) Q: 'TN D
	3040	"RTN","PRC ACPS",130, 0)
	3041	.S TCMPLT ="",TMBSNC ="",TRDMRD ="",COMM=0
	3042	"RTN","PRC ACPS",131, 0)
	3043	.S TN0=$G (^PRCA(433 ,TN,0)) Q: TN0=""
	3044	"RTN","PRC ACPS",132, 0)
	3045	.S TN1=$G (^PRCA(433 ,TN,1))
	3046	"RTN","PRC ACPS",133, 0)
	3047	.S TN3=$G (^PRCA(433 ,TN,3))
	3048	"RTN","PRC ACPS",134, 0)
	3049	.I $P(TN1 ,U,2)="" Q ;MISSING TRANS TYP E
	3050	"RTN","PRC ACPS",135, 0)
	3051	.; PRCA4 .5313 - S kip proces sing twin transactio ns for Pre payments
	3052	"RTN","PRC ACPS",136, 0)
	3053	.I $P(TN0 ,U,10),$P( $G(^PRCA(4 33,TN,5)), U,1)'="" N HIT,TWIN D I HIT Q
	3054	"RTN","PRC ACPS",137, 0)
	3055	..S HIT=0
	3056	"RTN","PRC ACPS",138, 0)
	3057	..S TWIN= $P(^PRCA(4 33,TN,5),U ,1)
	3058	"RTN","PRC ACPS",139, 0)
	3059	..I '$D(^ PRCA(433,T WIN,0)) Q
	3060	"RTN","PRC ACPS",140, 0)
	3061	..S HIT=1
	3062	"RTN","PRC ACPS",141, 0)
	3063	..S TWIN( 2)=$P(^PRC A(433,TWIN ,0),U,2)
	3064	"RTN","PRC ACPS",142, 0)
	3065	..K ^TMP( "PRCAGTPS" ,$J,DEBTOR ,TWIN(2),T WIN)
	3066	"RTN","PRC ACPS",143, 0)
	3067	.;
	3068	"RTN","PRC ACPS",144, 0)
	3069	.I $P(TN0 ,U,10)=1 S TCMPLT=1
	3070	"RTN","PRC ACPS",145, 0)
	3071	.I $P(TN1 ,U,2)=45 S COMM=1 G F433A
	3072	"RTN","PRC ACPS",146, 0)
	3073	.I $G(TTY )'="" Q:TT Y'=$P(TN1, U,2)
	3074	"RTN","PRC ACPS",147, 0)
	3075	.; Quit i f Transact ion Type i s blank or one of th e followin g:
	3076	"RTN","PRC ACPS",148, 0)
	3077	.; 3:REFE R TO RC, 4 :REFER TO DOJ, 5:REE STABLISH T O RC/DOJ, 6:RETURNED BY RC/DOJ
	3078	"RTN","PRC ACPS",149, 0)
	3079	.; 7:CASH COLLECTIO N BY RC/DO J, 24:MARS HAL/COURT COST, 25:R EPAYMENT P LAN, 30:DE BIT
	3080	VOUCHER (S F 5515)
	3081	"RTN","PRC ACPS",150, 0)
	3082	.I TTY="" ,",3,4,5,6 ,7,24,25,3 0,"[(","_$ P(TN1,U,2) _",") Q
	3083	"RTN","PRC ACPS",151, 0)
	3084	.; QUIT i f BILL NUM BER (#.03) = blank OR TRANSACTI ON STATUS (#4) '= CO MPLETE
	3085	"RTN","PRC ACPS",152, 0)
	3086	.I ($P(TN 0,U,2)="") !($P(TN0,U ,4)'=2) Q
	3087	"RTN","PRC ACPS",153, 0)
	3088	.; IF PRC AHIST="THI ST" AND TR ANSACTION TYPE (#12) = COMMENT (#45) cal l F433A to Set the d ata into
	3089	^TMP("PRCA GTPS",$J,D EBTOR
	3090	"RTN","PRC ACPS",154, 0)
	3091	.I $G(PRC AHIST)="TH IST",$P(TN 1,U,2)=45 G F433A
	3092	"RTN","PRC ACPS",155, 0)
	3093	.; IF TRA NSACTION T YPE (#12) '= to 46 UNSUSPENDE D AND TRAN SACTION TY PE (#12)'= to 47 CH ARGE
	3094	SUSPENDED
	3095	"RTN","PRC ACPS",156, 0)
	3096	.I $P(TN1 ,"^",2)'=4 6,$P(TN1," ^",2)'=47 D I TN1=" " Q
	3097	"RTN","PRC ACPS",157, 0)
	3098	..N RCTRA NDA,RCSTOP ,TRANTYPE
	3099	"RTN","PRC ACPS",158, 0)
	3100	..S RCSTO P=0
	3101	"RTN","PRC ACPS",159, 0)
	3102	..; Loop BACKWARDS through th e BILL NUM BER "C" x- ref
	3103	"RTN","PRC ACPS",160, 0)
	3104	..S RCTRA NDA=TN
	3105	"RTN","PRC ACPS",161, 0)
	3106	..F S RC TRANDA=$O( ^PRCA(433, "C",+$P(TN 0,"^",2),R CTRANDA),- 1) Q:'RCTR ANDA D I RCSTOP Q
	3107	"RTN","PRC ACPS",162, 0)
	3108	...; QUIT if TRANSA CTION STAT US (#4) '= COMPLETE
	3109	"RTN","PRC ACPS",163, 0)
	3110	...I $P($ G(^PRCA(43 3,RCTRANDA ,0)),"^",4 )'=2 Q
	3111	"RTN","PRC ACPS",164, 0)
	3112	...; Load Transacti on Type
	3113	"RTN","PRC ACPS",165, 0)
	3114	...S TRAN TYPE=$P($G (^PRCA(433 ,RCTRANDA, 1)),"^",2)
	3115	"RTN","PRC ACPS",166, 0)
	3116	...; IF T RANSACTION TYPE (#12 ) = 46 UNS USPENDED s et stop & Quit
	3117	"RTN","PRC ACPS",167, 0)
	3118	...I TRAN TYPE=46 S RCSTOP=1 Q
	3119	"RTN","PRC ACPS",168, 0)
	3120	...; IF T RANSACTION TYPE (#12 ) = 47 CHA RGE SUSPEN DED set st op & Quit
	3121	"RTN","PRC ACPS",169, 0)
	3122	...I TRAN TYPE=47 S RCSTOP=1,T N1="" Q
	3123	"RTN","PRC ACPS",170, 0)
	3124	F433A .
	3125	"RTN","PRC ACPS",171, 0)
	3126	.; The da ta in the ^TMP is as follows:
	3127	"RTN","PRC ACPS",172, 0)
	3128	.; Data =
	3129	"RTN","PRC ACPS",173, 0)
	3130	.; 1. TRA NS. AMOUNT (#15) $ P(TN1,U,5)
	3131	"RTN","PRC ACPS",174, 0)
	3132	.; 2. TRA NSACTION T YPE (#12) $ P(TN1,U,2)
	3133	"RTN","PRC ACPS",175, 0)
	3134	.; 3. PRI N.COLLECTE D (#31) $ P(TN3,U,1)
	3135	"RTN","PRC ACPS",176, 0)
	3136	.; 4. INT EREST COLL ECTED (#32 ) $ P(TN3,U,2)
	3137	"RTN","PRC ACPS",177, 0)
	3138	.; 5. ADM IN.COLLECT ED (#33) $ P(TN3,U,3)
	3139	"RTN","PRC ACPS",178, 0)
	3140	.; 6. MAR SHAL FEE C OLLECTED ( #34) $ P(TN3,U,4)
	3141	"RTN","PRC ACPS",179, 0)
	3142	.; 7. COU RT COST CO LLECTED (# 35) $ P(TN3,U,5)
	3143	"RTN","PRC ACPS",180, 0)
	3144	.; 8. TOT AL OF #3 - #7 $ P(TN3,U,1) +$P(TN3,U, 2)+$P(TN3, U,3)+$P(TN 3,U,4)+$P( TN3,U,5)
	3145	"RTN","PRC ACPS",181, 0)
	3146	.; 9. TCM PLT ( #10) INCOM PLETE TRAN SACTION FL AG
	3147	"RTN","PRC ACPS",182, 0)
	3148	.;10. TRD MRD - Does n't appear to be use d
	3149	"RTN","PRC ACPS",183, 0)
	3150	.;11. TMB SNC - Does n't appear to be use d
	3151	"RTN","PRC ACPS",184, 0)
	3152	.;12. Dup licate fla g for use in START2 1=duplicat e, 0=not a duplicate . Set in B ILLQUIT^PR CACPSA
	3153	"RTN","PRC ACPS",185, 0)
	3154	.;
	3155	"RTN","PRC ACPS",186, 0)
	3156	.N PRCATE MP
	3157	"RTN","PRC ACPS",187, 0)
	3158	.S
	3159	PRCATEMP=$ P(TN1,U,5) _U_$P(TN1, U,2)_U_$P( TN3,U,1)_U _$P(TN3,U, 2)_U_$P(TN 3,U,3)_U_$ P(TN3,U,4
	3160	)_U_$P(TN3 ,U,5)
	3161	"RTN","PRC ACPS",188, 0)
	3162	.S PRCATE MP=PRCATEM P_U_($P(TN 3,U,1)+$P( TN3,U,2)+$ P(TN3,U,3) +$P(TN3,U, 4)+$P(TN3, U,5))
	3163	"RTN","PRC ACPS",189, 0)
	3164	.S PRCATE MP=PRCATEM P_U_TCMPLT
	3165	"RTN","PRC ACPS",190, 0)
	3166	.S PRCATE MP=PRCATEM P_U_TRDMRD
	3167	"RTN","PRC ACPS",191, 0)
	3168	.S PRCATE MP=PRCATEM P_U_TMBSNC
	3169	"RTN","PRC ACPS",192, 0)
	3170	.S ^TMP(" PRCAGTPS", $J,DEBTOR, $P(TN0,U,2 ),TN)=PRCA TEMP
	3171	"RTN","PRC ACPS",193, 0)
	3172	.K TN0,TN 1,TN3,TCMP LT,TRDMRD, TMBSNC,COM M
	3173	"RTN","PRC ACPS",194, 0)
	3174	K PRCAHIS T
	3175	"RTN","PRC ACPS",195, 0)
	3176	Q
	3177	"RTN","PRC ACPS",196, 0)
	3178	;
	3179	"RTN","PRC ACPS",197, 0)
	3180	START1 ;
	3181	"RTN","PRC ACPS",198, 0)
	3182	;
	3183	"RTN","PRC ACPS",199, 0)
	3184	S BILL=""
	3185	"RTN","PRC ACPS",200, 0)
	3186	S CBALTOT =0 ; Will be the tot al of all CURRENT BA LANCE fiel d (#11) fo r the acco unt
	3187	"RTN","PRC ACPS",201, 0)
	3188	; ACCOUNT S RECEIVAB LE (#430) The C cros s-referenc e allows u ser look-u p of bills belonging to a
	3189	specific d ebtor.
	3190	"RTN","PRC ACPS",202, 0)
	3191	; Loop th rough bill s
	3192	"RTN","PRC ACPS",203, 0)
	3193	; ^TMP("P RCABILL",$ J,DEBTOR,B ILL)= Sum of CURRENT BALANCE f ield (#11) for the B ill
	3194	"RTN","PRC ACPS",204, 0)
	3195	; ^Sum of TRANS. AMOUNT (#1 5) for all transacti ons for th e Bill
	3196	"RTN","PRC ACPS",205, 0)
	3197	; ^Stop Flag if t he Bill ha s more tha n one erro r
	3198	"RTN","PRC ACPS",206, 0)
	3199	K ^TMP("P RCABILL",$ J)
	3200	"RTN","PRC ACPS",207, 0)
	3201	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3202	"RTN","PRC ACPS",208, 0)
	3203	.; BILLTO T is the C URRENT BAL ANCE field (#11) for each Bill for the D ebtor
	3204	"RTN","PRC ACPS",209, 0)
	3205	.N BILLTO T
	3206	"RTN","PRC ACPS",210, 0)
	3207	.S BN0=$G (^PRCA(430 ,BILL,0))
	3208	"RTN","PRC ACPS",211, 0)
	3209	.; QUIT: CURRENT ST ATUS (#8) '= ACTIVE
	3210	"RTN","PRC ACPS",212, 0)
	3211	.; I $P(B N0,U,8)'=1 6 Q based on call o n 11/28/16 process a ll bill wi th a statu s other th an Refund Review
	3212	"RTN","PRC ACPS",213, 0)
	3213	.; Skip a ll Debtors with 1 or more Bill s with a s tatus of R EFEUND REV IEW (#44). This che ck is done in
	3214	"RTN","PRC ACPS",214, 0)
	3215	.; REFREV above.
	3216	"RTN","PRC ACPS",215, 0)
	3217	.; Sum up CURRENT B ALANCE (#1 1) for eac h ACTIVE B ill
	3218	"RTN","PRC ACPS",216, 0)
	3219	.; Set in CBALTOT f or BALDIFF and in PR CABILL for BILLDIFF in Start2
	3220	"RTN","PRC ACPS",217, 0)
	3221	.; S CBAL TOT=CBALTO T+$$GET1^D IQ(430,BIL L,11)
	3222	"RTN","PRC ACPS",218, 0)
	3223	.S BILLTO T=$$GET1^D IQ(430,BIL L,11) ; Ge t CURRENT BALANCE (# 11) which is compute d:
	3224	#71+#72+#7 3+#74+#75
	3225	"RTN","PRC ACPS",219, 0)
	3226	.S ^TMP(" PRCABILL", $J,DEBTOR, BILL)=+BIL LTOT
	3227	"RTN","PRC ACPS",220, 0)
	3228	.S CBALTO T=CBALTOT+ BILLTOT
	3229	"RTN","PRC ACPS",221, 0)
	3230	N BILL,I, TN,TRANSTO T,TNVAL,TT YPE,TNTOT
	3231	"RTN","PRC ACPS",222, 0)
	3232	S TN="",( BILL,TRANS TOT,TTYPE, TNVAL)=0
	3233	"RTN","PRC ACPS",223, 0)
	3234	; Loop th rough Bill s
	3235	"RTN","PRC ACPS",224, 0)
	3236	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3237	"RTN","PRC ACPS",225, 0)
	3238	.; Call B ILLQUIT to determine if this b ill has mu ltiple iss ues
	3239	"RTN","PRC ACPS",226, 0)
	3240	.I $$BILL QUIT^PRCAC PSA(DEBTOR ,BILL) Q
	3241	"RTN","PRC ACPS",227, 0)
	3242	.; Initia lize TNTOT for Trans action Tot al for thi s bill
	3243	"RTN","PRC ACPS",228, 0)
	3244	.I $G(TNT OT(BILL))= "" S TNTOT (BILL)=0
	3245	"RTN","PRC ACPS",229, 0)
	3246	.; Loop t hrough Tra nsactions
	3247	"RTN","PRC ACPS",230, 0)
	3248	.S TN=0 F S TN=$O( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN)) Q:TN ="" D
	3249	"RTN","PRC ACPS",231, 0)
	3250	..; IF Tr ansaction # = 0 Add TRANS. AMO UNT (#15) to the Tra nsaction T otal
	3251	"RTN","PRC ACPS",232, 0)
	3252	..; I TN= 0 S TRANST OT=TRANSTO T+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN) Q
	3253	"RTN","PRC ACPS",233, 0)
	3254	..; S TNV AL = (#15) TRANS. AM OUNT from #433
	3255	"RTN","PRC ACPS",234, 0)
	3256	..S TNVAL =+^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)
	3257	"RTN","PRC ACPS",235, 0)
	3258	..; S TTY PE = (#12) TRANSACTI ON TYPE fr om #433
	3259	"RTN","PRC ACPS",236, 0)
	3260	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3261	"RTN","PRC ACPS",237, 0)
	3262	..; IF IN COMPLETE T RANSACTION FLAG is s et, set Tr ansaction amount = 0
	3263	"RTN","PRC ACPS",238, 0)
	3264	..S TCMPL T=+$P(^TMP ("PRCAGTPS ",$J,DEBTO R,BILL,TN) ,U,9)
	3265	"RTN","PRC ACPS",239, 0)
	3266	..I TCMPL T S TNVAL= 0
	3267	"RTN","PRC ACPS",240, 0)
	3268	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3269	"RTN","PRC ACPS",241, 0)
	3270	..I TMBSN C S TNVAL= 0
	3271	"RTN","PRC ACPS",242, 0)
	3272	..; Set T NVAL =0 if one of th e followin g Transact ion Types:
	3273	"RTN","PRC ACPS",243, 0)
	3274	..; 3:REF ER TO RC, 4:REFER TO DOJ, 5:RE ESTABLISH TO RC/DOJ, 6:RETURNE D BY RC/DO J
	3275	"RTN","PRC ACPS",244, 0)
	3276	..; 25:RE PAYMENT PL AN, 32:RET URNED FOR AMENDMENT, 33:AMENDE D BILL
	3277	"RTN","PRC ACPS",245, 0)
	3278	..I (TTYP E=3)!(TTYP E=4)!(TTYP E=5)!(TTYP E=6)!(TTYP E=32)!(TTY PE=25)!(TT YPE=33) S TNVAL=0
	3279	"RTN","PRC ACPS",246, 0)
	3280	..; Set T NVAL to ne gative val ue if one of the Tra nsaction T ypes:
	3281	"RTN","PRC ACPS",247, 0)
	3282	..; 2:PAY MENT (IN P ART), 8:TE RM.BY FIS. OFFICER, 9 :TERM.BY C OMPROMISE, 10:WAIVED IN FULL
	3283	"RTN","PRC ACPS",248, 0)
	3284	..; 11:WA IVED IN PA RT, 14:EXE MPT INT/AD M. COST, 2 9:TERM.BY RC/DOJ, 34 :PAYMENT ( IN FULL)
	3285	"RTN","PRC ACPS",249, 0)
	3286	..; 35:DE CREASE ADJ USTMENT, 4 1:REFUNDED , 47:CHARG E SUSPENDE D
	3287	"RTN","PRC ACPS",250, 0)
	3288	..I
	3289	TTYPE=2!(T TYPE=8)!(T TYPE=9)!(T TYPE=10)!( TTYPE=11)! (TTYPE=14) !(TTYPE=29 )!(TTYPE=3 4)!(TTYPE= 35)!(
	3290	TTYPE=41)! (TTYPE=47) S TNVAL=- TNVAL
	3291	"RTN","PRC ACPS",251, 0)
	3292	..; Updat e Transact ion Total
	3293	"RTN","PRC ACPS",252, 0)
	3294	..S TRANS TOT=TRANST OT+TNVAL
	3295	"RTN","PRC ACPS",253, 0)
	3296	..; Updat e Transact ion Total for this B ill
	3297	"RTN","PRC ACPS",254, 0)
	3298	..S TNTOT (BILL)=TNT OT(BILL)+T NVAL
	3299	"RTN","PRC ACPS",255, 0)
	3300	.; Update PRCABILL with Trans action Tot al for thi s Bill
	3301	"RTN","PRC ACPS",256, 0)
	3302	.S $P(^TM P("PRCABIL L",$J,DEBT OR,BILL),U ,2)=TNTOT( BILL)
	3303	"RTN","PRC ACPS",257, 0)
	3304	; Set Bal ance Diffe rence = Su m up CURRE NT BALANCE (#8) for each ACTIV E Bill - T ransaction Total for all
	3305	bills - PB AL from AR EVENT fil e (#341)
	3306	"RTN","PRC ACPS",258, 0)
	3307	S BALDIFF =CBALTOT-T RANSTOT-PB AL
	3308	"RTN","PRC ACPS",259, 0)
	3309	K CBALTOT ,TRANSTOT, PBAL,TCMPL T,BILL,BN0
	3310	"RTN","PRC ACPS",260, 0)
	3311	Q
	3312	"RTN","PRC ACPS",261, 0)
	3313	;
	3314	"RTN","PRC ACPS",262, 0)
	3315	START2 ;
	3316	"RTN","PRC ACPS",263, 0)
	3317	N
	3318	I,ATNLAST, BILL,BILLC NT,BILLCNT R,BILLNUM, FLAGGED,TN ,TN9,TRANS TOT,TNVAL, TTYPE,TCPL T,STOP,TRA
	3319	NCRNT,TRAN PREV,TNLAS T
	3320	"RTN","PRC ACPS",264, 0)
	3321	S (BILL,B ILLCNTR,FL AGGED)=0,A TNLAST=""
	3322	"RTN","PRC ACPS",265, 0)
	3323	; ATNLAST = The las t number f or the acc ount
	3324	"RTN","PRC ACPS",266, 0)
	3325	; FLAGGED = Account level fla g noting i f audit da ta was mar ked for th is account
	3326	"RTN","PRC ACPS",267, 0)
	3327	; PRCAFIX (X) = Hold s the tota l of the n umber of t ransaction s for a bi ll that ma tch to che ck criteri a X
	3328	"RTN","PRC ACPS",268, 0)
	3329	; Determi ne the num ber of bil l for this account
	3330	"RTN","PRC ACPS",269, 0)
	3331	S (BILLCN T,BILLCNTR )=0,BILLNU M=""
	3332	"RTN","PRC ACPS",270, 0)
	3333	; Determi ne the num ber of bil ls for thi s account
	3334	"RTN","PRC ACPS",271, 0)
	3335	F S BILL NUM=$O(^TM P("PRCAGTP S",$J,DEBT OR,BILLNUM )) Q:'BILL NUM S BIL LCNT=BILLC NT+1
	3336	"RTN","PRC ACPS",272, 0)
	3337	; Loop th rough Bill s
	3338	"RTN","PRC ACPS",273, 0)
	3339	F S BILL =$O(^TMP(" PRCAGTPS", $J,DEBTOR, BILL)) Q:B ILL="" D
	3340	"RTN","PRC ACPS",274, 0)
	3341	.S BILLCN TR=BILLCNT R+1
	3342	"RTN","PRC ACPS",275, 0)
	3343	.; QUIT i f STOP fla g is set f or this Bi ll
	3344	"RTN","PRC ACPS",276, 0)
	3345	.I $P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,3)=1 S FLAGGED= FLAGGED+1 Q
	3346	"RTN","PRC ACPS",277, 0)
	3347	.; New an d set Bill Balance D ifference
	3348	"RTN","PRC ACPS",278, 0)
	3349	.N BILLDI FF
	3350	"RTN","PRC ACPS",279, 0)
	3351	.; ***** The follow ing 2 form ulas will need to be re-evalua ted once t he VA supp lies us th e necessar y
	3352	details *
	3353	"RTN","PRC ACPS",280, 0)
	3354	.; If the Original Bill Amoun t is not n ull use th is formula
	3355	"RTN","PRC ACPS",281, 0)
	3356	.I +$G(^T MP("PRCAGT PS",$J,DEB TOR,BILL,0 )) D
	3357	"RTN","PRC ACPS",282, 0)
	3358	..S BILLD IFF=$P($G( ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,0)),U,1)-
	3359	$P($G(^TMP ("PRCABILL ",$J,DEBTO R,BILL)),U ,1)+$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,2)
	3360	"RTN","PRC ACPS",283, 0)
	3361	.; If the Original Amount is null use t his formul a
	3362	"RTN","PRC ACPS",284, 0)
	3363	.I '+$G(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, 0)) D
	3364	"RTN","PRC ACPS",285, 0)
	3365	..S BILLD IFF=$P($G( ^TMP("PRCA BILL",$J,D EBTOR,BILL )),U,1)-
	3366	$P($G(^TMP ("PRCABILL ",$J,DEBTO R,BILL)),U ,2)
	3367	"RTN","PRC ACPS",286, 0)
	3368	.; Quit i f Bill Bal ance Diffe rence is z ero
	3369	"RTN","PRC ACPS",287, 0)
	3370	.I 'BILLD IFF Q
	3371	"RTN","PRC ACPS",288, 0)
	3372	.; PRCAFI X(X) = Hol ds the tot al of the number of transactio ns for a b ill that m atch to ch eck criter ia X
	3373	"RTN","PRC ACPS",289, 0)
	3374	.; PRCATT TF = Total Transacti on Types t o Fix
	3375	"RTN","PRC ACPS",290, 0)
	3376	.N PRCATT TF,PRCAFIX
	3377	"RTN","PRC ACPS",291, 0)
	3378	.S (PRCAT TTF,TRANST OT,TTYPE,T NVAL)=0
	3379	"RTN","PRC ACPS",292, 0)
	3380	.S (TN,TN LAST)=""
	3381	"RTN","PRC ACPS",293, 0)
	3382	.; Initia lize type of fix cou nts
	3383	"RTN","PRC ACPS",294, 0)
	3384	.F I=1:1: 4 S PRCAFI X(I)=""
	3385	"RTN","PRC ACPS",295, 0)
	3386	.;
	3387	"RTN","PRC ACPS",296, 0)
	3388	.F S TN= $O(^TMP("P RCAGTPS",$ J,DEBTOR,B ILL,TN)) Q :TN="" D
	3389	"RTN","PRC ACPS",297, 0)
	3390	..; Save first tran saction nu mber
	3391	"RTN","PRC ACPS",298, 0)
	3392	..S (ATNL AST,TNLAST )=TN
	3393	"RTN","PRC ACPS",299, 0)
	3394	..; IF Tr ansaction number = 0 update Tr ansaction Total with (#15) TRA NS. AMOUNT from #433
	3395	"RTN","PRC ACPS",300, 0)
	3396	..I TN=0 S TRANSTOT =TRANSTOT+ ^TMP("PRCA GTPS",$J,D EBTOR,BILL ,TN) Q
	3397	"RTN","PRC ACPS",301, 0)
	3398	..; Set T NVAL = (#1 5) TRANS. AMOUNT fro m #433
	3399	"RTN","PRC ACPS",302, 0)
	3400	..S TNVAL =$P(^TMP(" PRCAGTPS", $J,DEBTOR, BILL,TN),U ,1)
	3401	"RTN","PRC ACPS",303, 0)
	3402	..; Set T TYPE = (#1 2) TRANSAC TION TYPE from #433
	3403	"RTN","PRC ACPS",304, 0)
	3404	..S TTYPE =+$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,2)
	3405	"RTN","PRC ACPS",305, 0)
	3406	..; Set T CPLT = (#1 0) INCOMPL ETE TRANSA CTION FLAG
	3407	"RTN","PRC ACPS",306, 0)
	3408	..S TCPLT =+$P($G(^P RCA(433,TN ,0)),U,10)
	3409	"RTN","PRC ACPS",307, 0)
	3410	..; I thi nk this wi ll always be blank
	3411	"RTN","PRC ACPS",308, 0)
	3412	..S TRDMR D=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,10)
	3413	"RTN","PRC ACPS",309, 0)
	3414	..; I thi nk this wi ll always be blank
	3415	"RTN","PRC ACPS",310, 0)
	3416	..S TMBSN C=$P(^TMP( "PRCAGTPS" ,$J,DEBTOR ,BILL,TN), U,11)
	3417	"RTN","PRC ACPS",311, 0)
	3418	..; Quit it this tr ansaction was previo usly used to correct an out of balance s cenario
	3419	"RTN","PRC ACPS",312, 0)
	3420	..S TN9=$ G(^PRCA(43 3,TN,9))
	3421	"RTN","PRC ACPS",313, 0)
	3422	..Q:$P(TN 9,U,4)'=""
	3423	"RTN","PRC ACPS",314, 0)
	3424	..;
	3425	"RTN","PRC ACPS",315, 0)
	3426	..; Check #1 - Tran saction wi th missing $ amount & Transact ion Type ' = Comment (#45)
	3427	"RTN","PRC ACPS",316, 0)
	3428	..;I TNVA L="",(TTYP E'=45) D Q
	3429	"RTN","PRC ACPS",317, 0)
	3430	..;.S PRC AFIX(1)=$G (PRCAFIX(1 ))+1,IENCR RT=TN
	3431	"RTN","PRC ACPS",318, 0)
	3432	..;.S PRC AFIX(1,TN) =""
	3433	"RTN","PRC ACPS",319, 0)
	3434	..;
	3435	"RTN","PRC ACPS",320, 0)
	3436	..; Check #2 - Tran saction ma rked as In complete w ith +$ amo unt matchi ng off by amount
	3437	"RTN","PRC ACPS",321, 0)
	3438	..I TNVAL =BILLDIFF I TCPLT D Q
	3439	"RTN","PRC ACPS",322, 0)
	3440	...Q:(TTY PE=45)
	3441	"RTN","PRC ACPS",323, 0)
	3442	...I TRDM RD Q
	3443	"RTN","PRC ACPS",324, 0)
	3444	...S PRCA FIX(2)=$G( PRCAFIX(2) )+1,IENCRR T=TN
	3445	"RTN","PRC ACPS",325, 0)
	3446	...S PRCA FIX(2,TN)= ""
	3447	"RTN","PRC ACPS",326, 0)
	3448	..;
	3449	"RTN","PRC ACPS",327, 0)
	3450	..; Check #3 - Tran saction ma rked as In complete w ith -$ amo unt matchi ng off by amount
	3451	"RTN","PRC ACPS",328, 0)
	3452	..I -TNVA L=BILLDIFF I TCPLT D Q
	3453	"RTN","PRC ACPS",329, 0)
	3454	...Q:(TTY PE=45)
	3455	"RTN","PRC ACPS",330, 0)
	3456	...S PRCA FIX(3)=$G( PRCAFIX(3) )+1,IENCRR T=TN
	3457	"RTN","PRC ACPS",331, 0)
	3458	...S PRCA FIX(3,TN)= ""
	3459	"RTN","PRC ACPS",332, 0)
	3460	..;
	3461	"RTN","PRC ACPS",333, 0)
	3462	..; Check #4 - Dupl icate Tran saction
	3463	"RTN","PRC ACPS",334, 0)
	3464	..I TTYPE '=45,($P(^ TMP("PRCAG TPS",$J,DE BTOR,BILL, TN),U,12)= 1) D
	3465	"RTN","PRC ACPS",335, 0)
	3466	...S PRCA FIX(4)=$G( PRCAFIX(4) )+1,IENCRR T=TN
	3467	"RTN","PRC ACPS",336, 0)
	3468	...S PRCA FIX(4,TN)= ""
	3469	"RTN","PRC ACPS",337, 0)
	3470	.;
	3471	"RTN","PRC ACPS",338, 0)
	3472	.; Quit i f there we re no tran sactions f or this bi ll
	3473	"RTN","PRC ACPS",339, 0)
	3474	.I $G(IEN CRRT)=""!( $G(TNLAST) ="") Q
	3475	"RTN","PRC ACPS",340, 0)
	3476	.; If we are on the last Bill and there were no t ransaction s for the entire acc ount Quit
	3477	"RTN","PRC ACPS",341, 0)
	3478	.I BILLCN TR=BILLCNT ,ATNLAST=" " Q
	3479	"RTN","PRC ACPS",342, 0)
	3480	.;
	3481	"RTN","PRC ACPS",343, 0)
	3482	.F I=1:1: 4 D
	3483	"RTN","PRC ACPS",344, 0)
	3484	..S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3485	"RTN","PRC ACPS",345, 0)
	3486	.; if you get to he re the bil l was out of balance and if it shows not hing to fi x, set las t transact ion
	3487	"RTN","PRC ACPS",346, 0)
	3488	.; for th is Bill to NOT FIXAB LE
	3489	"RTN","PRC ACPS",347, 0)
	3490	.I PRCATT TF=0 D UPD TLTR^PRCAC PSA($G(TNL AST)) S FL AGGED=1 Q
	3491	"RTN","PRC ACPS",348, 0)
	3492	.; Update this bill
	3493	"RTN","PRC ACPS",349, 0)
	3494	.D FIXBIL L(.FLAGGED )
	3495	"RTN","PRC ACPS",350, 0)
	3496	Q:FLAGGED
	3497	"RTN","PRC ACPS",351, 0)
	3498	; The acc ount was o ut of bala nce but no thing was found on a ny bill th at could b e fixed.
	3499	"RTN","PRC ACPS",352, 0)
	3500	; Mark th e last tra nsaction f or the las t bill for this acco unt as not fixable.
	3501	"RTN","PRC ACPS",353, 0)
	3502	I 'FLAGGE D D UPDTLT R^PRCACPSA ($G(ATNLAS T))
	3503	"RTN","PRC ACPS",354, 0)
	3504	Q
	3505	"RTN","PRC ACPS",355, 0)
	3506	;
	3507	"RTN","PRC ACPS",356, 0)
	3508	FIXBILL(FL AGGED) ;Up date a sin gle bill u sing PRCAF IX array
	3509	"RTN","PRC ACPS",357, 0)
	3510	; Make up date deter mination b ased on ch ecks 1 - 4 .
	3511	"RTN","PRC ACPS",358, 0)
	3512	; Sum up check tota ls
	3513	"RTN","PRC ACPS",359, 0)
	3514	;F I=1:1: 4 D
	3515	"RTN","PRC ACPS",360, 0)
	3516	;.S PRCAT TTF=PRCATT TF+PRCAFIX (I)
	3517	"RTN","PRC ACPS",361, 0)
	3518	; Get cur rent date/ time
	3519	"RTN","PRC ACPS",362, 0)
	3520	N PRCADAT E
	3521	"RTN","PRC ACPS",363, 0)
	3522	D NOW^%DT C
	3523	"RTN","PRC ACPS",364, 0)
	3524	S PRCADAT E=X
	3525	"RTN","PRC ACPS",365, 0)
	3526	; Otherwi se there i s only 1 b ad transac tion so up date as ne eded
	3527	"RTN","PRC ACPS",366, 0)
	3528	; Lock Re cord
	3529	"RTN","PRC ACPS",367, 0)
	3530	L +^PRCA( 433,IENCRR T,9):DILOC KTM
	3531	"RTN","PRC ACPS",368, 0)
	3532	; If lock not obtai ned, updat e number o f transact ions that couldn't b e fixed
	3533	"RTN","PRC ACPS",369, 0)
	3534	Q:'$T
	3535	"RTN","PRC ACPS",370, 0)
	3536	; Set FDA array for the neces sary field s based on the type of fix ide ntified
	3537	"RTN","PRC ACPS",371, 0)
	3538	N PRCAFDA
	3539	"RTN","PRC ACPS",372, 0)
	3540	;I PRCAFI X(1) D
	3541	"RTN","PRC ACPS",373, 0)
	3542	;.S PRCAF DA(433,IEN CRRT_",",1 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3543	"RTN","PRC ACPS",374, 0)
	3544	;.S PRCAF DA(433,IEN CRRT_",",9 4)=PRCADAT E
	3545	"RTN","PRC ACPS",375, 0)
	3546	;.S PRCAF DA(433,IEN CRRT_",",9 5)=$S(BILL DIFF>0:BIL LDIFF,1:-B ILLDIFF)
	3547	"RTN","PRC ACPS",376, 0)
	3548	;.S PRCAF DA(433,IEN CRRT_",",9 6)="N" ; N ULL TRANSA CTION AMOU NT
	3549	"RTN","PRC ACPS",377, 0)
	3550	; Check # 2 - Transa ction mark ed as Inco mplete wit h +$ amoun t matching off by am ount
	3551	"RTN","PRC ACPS",378, 0)
	3552	; Check # 3 - Transa ction mark ed as Inco mplete wit h -$ amoun t matching off by am ount
	3553	"RTN","PRC ACPS",379, 0)
	3554	I PRCAFIX (2)!(PRCAF IX(3)) D
	3555	"RTN","PRC ACPS",380, 0)
	3556	.S PRCAFD A(433,IENC RRT_",",10 )=""
	3557	"RTN","PRC ACPS",381, 0)
	3558	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3559	"RTN","PRC ACPS",382, 0)
	3560	.S PRCAFD A(433,IENC RRT_",",96 )="I" ; IN COMPLETE F LAG ERROR
	3561	"RTN","PRC ACPS",383, 0)
	3562	; Check # 4 - Duplic ate Transa ction
	3563	"RTN","PRC ACPS",384, 0)
	3564	I PRCAFIX (4) D
	3565	"RTN","PRC ACPS",385, 0)
	3566	.; Null o ut audit f ields on o riginal tr ansaction
	3567	"RTN","PRC ACPS",386, 0)
	3568	.S PRCAFD A(433,IENC RRT-1_",", 94)=""
	3569	"RTN","PRC ACPS",387, 0)
	3570	.S PRCAFD A(433,IENC RRT-1_",", 95)=""
	3571	"RTN","PRC ACPS",388, 0)
	3572	.S PRCAFD A(433,IENC RRT-1_",", 96)=""
	3573	"RTN","PRC ACPS",389, 0)
	3574	.L +^PRCA (433,IENCR RT-1,9):DI LOCKTM
	3575	"RTN","PRC ACPS",390, 0)
	3576	.Q:'$T
	3577	"RTN","PRC ACPS",391, 0)
	3578	.D FILE^D IE(,"PRCAF DA")
	3579	"RTN","PRC ACPS",392, 0)
	3580	.L -^PRCA (433,IENCR RT-1,9)
	3581	"RTN","PRC ACPS",393, 0)
	3582	.; Set th e fields f or the dup licate tra nsaction
	3583	"RTN","PRC ACPS",394, 0)
	3584	.S PRCAFD A(433,IENC RRT_",",10 )=1 ; INCO MPLETE TRA NSACTION
	3585	"RTN","PRC ACPS",395, 0)
	3586	.S PRCAFD A(433,IENC RRT_",",94 )=PRCADATE
	3587	"RTN","PRC ACPS",396, 0)
	3588	.S PRCAFD A(433,IENC RRT_",",95 )=$S(BILLD IFF>0:BILL DIFF,1:-BI LLDIFF)
	3589	"RTN","PRC ACPS",397, 0)
	3590	.S PRCAFD A(433,IENC RRT_",",96 )="D" ; DU PLICATE TR ANSACTION
	3591	"RTN","PRC ACPS",398, 0)
	3592	; Update Transactio n
	3593	"RTN","PRC ACPS",399, 0)
	3594	D FILE^DI E(,"PRCAFD A")
	3595	"RTN","PRC ACPS",400, 0)
	3596	S FLAGGED =1
	3597	"RTN","PRC ACPS",401, 0)
	3598	; Unlock file
	3599	"RTN","PRC ACPS",402, 0)
	3600	L -^PRCA( 433,IENCRR T,9)
	3601	"RTN","PRC ACPS",403, 0)
	3602	K TMBSNC, IENCRRT
	3603	"RTN","PRC ACPS",404, 0)
	3604	Q
	3605	"RTN","PRC ACPS",405, 0)
	3606	;
	3607	"RTN","PRC ACPS",406, 0)
	3608	DIQOUTCS(D IQOUT) ;Re turn check sum for a processed DIQOUT arr ay.
	3609	"RTN","PRC ACPS",407, 0)
	3610	N CS,DATA ,FIELD,FNU M,IENS,IND ,SFN,STRIN G,TARGET,T EXT,WP
	3611	"RTN","PRC ACPS",408, 0)
	3612	S FNUM=$O (DIQOUT("" ))
	3613	"RTN","PRC ACPS",409, 0)
	3614	S (CS,FNU M)=0
	3615	"RTN","PRC ACPS",410, 0)
	3616	F S FNUM =$O(DIQOUT (FNUM)) Q: FNUM="" D
	3617	"RTN","PRC ACPS",411, 0)
	3618	.S IENS=" "
	3619	"RTN","PRC ACPS",412, 0)
	3620	.F S IEN S=$O(DIQOU T(FNUM,IEN S)) Q:IENS ="" D
	3621	"RTN","PRC ACPS",413, 0)
	3622	..S FIELD =0
	3623	"RTN","PRC ACPS",414, 0)
	3624	..F S FI ELD=$O(DIQ OUT(FNUM,I ENS,FIELD) ) Q:FIELD= "" D
	3625	"RTN","PRC ACPS",415, 0)
	3626	...S DATA =DIQOUT(FN UM,IENS,FI ELD)
	3627	"RTN","PRC ACPS",416, 0)
	3628	...S TEXT =FNUM_$L(I ENS,",")_F IELD_DATA
	3629	"RTN","PRC ACPS",417, 0)
	3630	...S CS=$ $CRC32^XLF CRC(TEXT,C S)
	3631	"RTN","PRC ACPS",418, 0)
	3632	Q CS
	3633	"RTN","PRC ACPS",419, 0)
	3634	;
	3635	"RTN","PRC ACPS",420, 0)
	3636	USRMSG ;se nds mailma n message to the PRC ACPS mail group
	3637	"RTN","PRC ACPS",421, 0)
	3638	N XMY,XMD UZ,XMSUB,X MTEXT,X
	3639	"RTN","PRC ACPS",422, 0)
	3640	S XMDUZ=" AR PACKAGE "
	3641	"RTN","PRC ACPS",423, 0)
	3642	S XMY("G. PRCACPS")= ""
	3643	"RTN","PRC ACPS",424, 0)
	3644	S XMSUB=" CPS AUTO-C ORRECTION COMPLETE " _$E(DT,4,5 )_"/"_$E(D T,6,7)_"/" _$E(DT,2,3 )
	3645	"RTN","PRC ACPS",425, 0)
	3646	S X(1)="C onsolidate d Patient Statement Auto-Corre ction"
	3647	"RTN","PRC ACPS",426, 0)
	3648	S X(2)="P rogram com pleted on "_$$FMTE^X LFDT($$NOW ^XLFDT()," 5P")
	3649	"RTN","PRC ACPS",427, 0)
	3650	S XMTEXT= "X("
	3651	"RTN","PRC ACPS",428, 0)
	3652	D ^XMD
	3653	"RTN","PRC ACPS",429, 0)
	3654	; Remove ^XTMP node
	3655	"RTN","PRC ACPS",430, 0)
	3656	K ^XTMP(" PRCACPS",0 )
	3657	"RTN","PRC ACPS",431, 0)
	3658	Q
	3659	"RTN","PRC ACPS1")
	3660	0^28^B2026 6996^n/a
	3661	"RTN","PRC ACPS1",1,0 )
	3662	PRCACPS1 ; ALBANY/BDB -PATIENT S TATEMENTS UPDATE ;03 /25/16 3:3 4 PM
	3663	"RTN","PRC ACPS1",2,0 )
	3664	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	3665	"RTN","PRC ACPS1",3,0 )
	3666	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3667	"RTN","PRC ACPS1",4,0 )
	3668	;
	3669	"RTN","PRC ACPS1",5,0 )
	3670	Q
	3671	"RTN","PRC ACPS1",6,0 )
	3672	;
	3673	"RTN","PRC ACPS1",7,0 )
	3674	ENTER ;cal led by the cbs night ly account update pr ogram opti on
	3675	"RTN","PRC ACPS1",8,0 )
	3676	N ZTDTH,Z TIO,ZTDESC ,ZTRTN,ZTS K,ZTSAVE,R CFULL
	3677	"RTN","PRC ACPS1",9,0 )
	3678	S RCFULL= 1 ;run the full debt or list
	3679	"RTN","PRC ACPS1",10, 0)
	3680	W !,"Queu e the pati ent statem ent update program t o run:"
	3681	"RTN","PRC ACPS1",11, 0)
	3682	S ZTDESC= "Consolida ted Billin g Statemen t Update"
	3683	"RTN","PRC ACPS1",12, 0)
	3684	S ZTRTN=" DEBTOR^PRC ACPS1",ZTI O="",ZTSAV E("RCFULL" )=""
	3685	"RTN","PRC ACPS1",13, 0)
	3686	D ^%ZTLOA D
	3687	"RTN","PRC ACPS1",14, 0)
	3688	Q
	3689	"RTN","PRC ACPS1",15, 0)
	3690	;
	3691	"RTN","PRC ACPS1",16, 0)
	3692	DEBTOR ;ca lled by rc cpcbj
	3693	"RTN","PRC ACPS1",17, 0)
	3694	N DEBTOR, X,DEBTOR0, DEBTOR1,DE BTOR7,CBSS TOT,BALDT
	3695	"RTN","PRC ACPS1",18, 0)
	3696	K ^XTMP(" RCCBSS",$J )
	3697	"RTN","PRC ACPS1",19, 0)
	3698	S ^XTMP(" RCCBSS",$J ,0)=$$FMAD D^XLFDT(DT ,3)_"^"_DT
	3699	"RTN","PRC ACPS1",20, 0)
	3700	S DEBTOR= 0
	3701	"RTN","PRC ACPS1",21, 0)
	3702	F S DEBT OR=$O(^PRC A(430,"C", DEBTOR)) Q :DEBTOR'?1 N.N D
	3703	"RTN","PRC ACPS1",22, 0)
	3704	.S DEBTOR 0=$G(^RCD( 340,DEBTOR ,0)),DEBTO R1=$G(^(1) ),DEBTOR7= $G(^(7)),B ALDT=""
	3705	"RTN","PRC ACPS1",23, 0)
	3706	.Q:$P(DEB TOR0,"^")' ["DPT("
	3707	"RTN","PRC ACPS1",24, 0)
	3708	.I +$$GET ICN^MPIF00 1(+DEBTOR0 )<0 Q ;qu it if no i cn
	3709	"RTN","PRC ACPS1",25, 0)
	3710	.S BALDT= $$BILLS(DE BTOR) Q:$P (BALDT,U,2 )=9999999
	3711	"RTN","PRC ACPS1",26, 0)
	3712	.D RECPD
	3713	"RTN","PRC ACPS1",27, 0)
	3714	D COMPILE
	3715	"RTN","PRC ACPS1",28, 0)
	3716	K ^XTMP(" RCCBSS",$J )
	3717	"RTN","PRC ACPS1",29, 0)
	3718	Q
	3719	"RTN","PRC ACPS1",30, 0)
	3720	;
	3721	"RTN","PRC ACPS1",31, 0)
	3722	RECPD(BILL ) ;add a n ew account update
	3723	"RTN","PRC ACPS1",32, 0)
	3724	N REC,RCD FN
	3725	"RTN","PRC ACPS1",33, 0)
	3726	S RCDFN=+ DEBTOR0
	3727	"RTN","PRC ACPS1",34, 0)
	3728	S REC="PD ^"_$$GETIC N^MPIF001( RCDFN)_"^"
	3729	"RTN","PRC ACPS1",35, 0)
	3730	S
	3731	REC=REC_$$ SITE^RCMSI TE_$$UP^XL FSTR($S(($ $SSN^RCFN0 1(DEBTOR)] "")&($$NAM ^RCFN01(DE BTOR)]
	3732	""):$TR($E ($$SSN^RCF N01(DEBTOR ),1,9)_$E( $P($$NAM^R CFN01(DEBT OR),","),1 ,5)," ","" ),1:""))_" ^"
	3733	"RTN","PRC ACPS1",36, 0)
	3734	S REC=REC _RCDFN_"^"
	3735	"RTN","PRC ACPS1",37, 0)
	3736	S BALDT=$ $BILLS(DEB TOR)
	3737	"RTN","PRC ACPS1",38, 0)
	3738	S CBSSTOT =+$P(DEBTO R7,U,6)
	3739	"RTN","PRC ACPS1",39, 0)
	3740	I '$G(RCF ULL) Q:CBS STOT=+BALD T
	3741	"RTN","PRC ACPS1",40, 0)
	3742	S $P(^RCD (340,DEBTO R,7),U,6)= +BALDT
	3743	"RTN","PRC ACPS1",41, 0)
	3744	;;[BEGIN EDIT,ASF,1 2/10/18, P RCA4.531 3]
	3745	"RTN","PRC ACPS1",42, 0)
	3746	;S REC=RE C_$$HEX(+B ALDT)_"^"_ $P(BALDT,U ,2)_"^\|"
	3747	"RTN","PRC ACPS1",43, 0)
	3748	S
	3749	REC=$S(+BA LDT'=0:REC _$$HEX(+BA LDT)_"^"_$ P(BALDT,U, 2)_"^\|",1: REC_$$HEX( +BALDT)_"^ "_$$DTMD
	3750	Y(DT)_"^\|" )
	3751	"RTN","PRC ACPS1",44, 0)
	3752	;;[END ED IT,ASF,12/ 10/18, PRC A4.5313]
	3753	"RTN","PRC ACPS1",45, 0)
	3754	S ^XTMP(" RCCBSS",$J ,DEBTOR)=R EC
	3755	"RTN","PRC ACPS1",46, 0)
	3756	Q
	3757	"RTN","PRC ACPS1",47, 0)
	3758	;
	3759	"RTN","PRC ACPS1",48, 0)
	3760	BILLS(DEBT OR) ;get o ldest bill date
	3761	"RTN","PRC ACPS1",49, 0)
	3762	N BALTOT, BILL,BN0,P RPDT,OLDDT
	3763	"RTN","PRC ACPS1",50, 0)
	3764	S BILL=""
	3765	"RTN","PRC ACPS1",51, 0)
	3766	S BALTOT= 0,OLDDT=99 99999
	3767	"RTN","PRC ACPS1",52, 0)
	3768	F S BILL =$O(^PRCA( 430,"C",DE BTOR,BILL) ) Q:BILL'? 1N.N D
	3769	"RTN","PRC ACPS1",53, 0)
	3770	.Q:$D(^PR CA(430,"TC SP",BILL)) ;cs chec k
	3771	"RTN","PRC ACPS1",54, 0)
	3772	.S BN0=$G (^PRCA(430 ,BILL,0))
	3773	"RTN","PRC ACPS1",55, 0)
	3774	.I $P(BN0 ,U,8)'=16 Q ;not ac tive
	3775	"RTN","PRC ACPS1",56, 0)
	3776	.S BALTOT =BALTOT+$$ GET1^DIQ(4 30,BILL,11 )
	3777	"RTN","PRC ACPS1",57, 0)
	3778	.S PRPDT= $P(^PRCA(4 30,BILL,0) ,U,10) I + PRPDT,OLDD T>PRPDT S OLDDT=PRPD T
	3779	"RTN","PRC ACPS1",58, 0)
	3780	Q BALTOT_ U_$S(OLDDT '=9999999: $$DTMDY(OL DDT),1:"")
	3781	"RTN","PRC ACPS1",59, 0)
	3782	;
	3783	"RTN","PRC ACPS1",60, 0)
	3784	COMPILE ;
	3785	"RTN","PRC ACPS1",61, 0)
	3786	N RCMSG,D CNTR,REC,R ECC,AMOUNT ,RCNTR,ACT ION,SEQ,SE QTOT
	3787	"RTN","PRC ACPS1",62, 0)
	3788	S DCNTR=0 ,REC=1,REC C=0,AMOUNT =0,SEQ=1,S EQTOT=0
	3789	"RTN","PRC ACPS1",63, 0)
	3790	F S DCNT R=$O(^XTMP ("RCCBSS", $J,DCNTR)) S:+DCNTR' >0 SEQTOT= SEQ Q:+DCN TR'>0 D
	3791	"RTN","PRC ACPS1",64, 0)
	3792	.I REC>45 0 D
	3793	"RTN","PRC ACPS1",65, 0)
	3794	..S ^XTMP ("RCCBSS", $J,"BUILD" ,SEQ,REC)= ^XTMP("RCC BSS",$J,"B UILD",SEQ, REC)_"~"
	3795	"RTN","PRC ACPS1",66, 0)
	3796	..D HEADE R
	3797	"RTN","PRC ACPS1",67, 0)
	3798	..D AITCM SG
	3799	"RTN","PRC ACPS1",68, 0)
	3800	..S REC=0 ,SEQ=SEQ+1
	3801	"RTN","PRC ACPS1",69, 0)
	3802	..Q
	3803	"RTN","PRC ACPS1",70, 0)
	3804	.S REC=RE C+1
	3805	"RTN","PRC ACPS1",71, 0)
	3806	.S ^XTMP( "RCCBSS",$ J,"BUILD", SEQ,REC)=^ XTMP("RCCB SS",$J,DCN TR)
	3807	"RTN","PRC ACPS1",72, 0)
	3808	.Q
	3809	"RTN","PRC ACPS1",73, 0)
	3810	Q:'$D(^XT MP("RCCBSS ",$J,"BUIL D",SEQ))
	3811	"RTN","PRC ACPS1",74, 0)
	3812	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,REC)=^X TMP("RCCBS S",$J,"BUI LD",SEQ,RE C)_"~"
	3813	"RTN","PRC ACPS1",75, 0)
	3814	D HEADER
	3815	"RTN","PRC ACPS1",76, 0)
	3816	D AITCMSG
	3817	"RTN","PRC ACPS1",77, 0)
	3818	Q
	3819	"RTN","PRC ACPS1",78, 0)
	3820	;
	3821	"RTN","PRC ACPS1",79, 0)
	3822	AITCMSG ;
	3823	"RTN","PRC ACPS1",80, 0)
	3824	N XMY,XMD UZ,XMSUB,X MTEXT
	3825	"RTN","PRC ACPS1",81, 0)
	3826	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3827	"RTN","PRC ACPS1",82, 0)
	3828	S XMDUZ=" AR PACKAGE "
	3829	"RTN","PRC ACPS1",83, 0)
	3830	;S XMY("X XX@Q-CPT D OM A IN . EXT ")=""
	3831	"RTN","PRC ACPS1",84, 0)
	3832	S X=$O(^R CT(349.1," B","PU",0) )
	3833	"RTN","PRC ACPS1",85, 0)
	3834	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S
	3835	X=$P($G(^R CT(349.1,+ X,3)),"^") _"@"_$P($G (^RCT(349. 1,+X,3))," ^",3) S:$P (X,"@",2)] "" XMY(X)= ""
	3836	"RTN","PRC ACPS1",86, 0)
	3837	S XMY("G. PRCACPS")= ""
	3838	"RTN","PRC ACPS1",87, 0)
	3839	S XMSUB=S ITE_"/CBSS TRANSMISS ION/BATCH# : "_SEQ
	3840	"RTN","PRC ACPS1",88, 0)
	3841	S XMTEXT= "^XTMP(""R CCBSS"","_ $J_",""BUI LD"","_SEQ _","
	3842	"RTN","PRC ACPS1",89, 0)
	3843	D ^XMD
	3844	"RTN","PRC ACPS1",90, 0)
	3845	K ^XTMP(" RCCBSS",$J ,"BUILD",S EQ)
	3846	"RTN","PRC ACPS1",91, 0)
	3847	Q
	3848	"RTN","PRC ACPS1",92, 0)
	3849	;
	3850	"RTN","PRC ACPS1",93, 0)
	3851	HEADER ;
	3852	"RTN","PRC ACPS1",94, 0)
	3853	;incremen t batch se quence num ber, build new heade r
	3854	"RTN","PRC ACPS1",95, 0)
	3855	N RCMSG,S ITE
	3856	"RTN","PRC ACPS1",96, 0)
	3857	S SITE=$E ($$SITE^RC MSITE(),1, 3)
	3858	"RTN","PRC ACPS1",97, 0)
	3859	S RCMSG=" PU"_"^"_SE Q_"^"_SEQT OT_"^"_(RE C-1)_"^"_S ITE_"^"_$$ DTMDY(DT)_ "^\|"
	3860	"RTN","PRC ACPS1",98, 0)
	3861	S ^XTMP(" RCCBSS",$J ,"BUILD",S EQ,1)=RCMS G
	3862	"RTN","PRC ACPS1",99, 0)
	3863	Q
	3864	"RTN","PRC ACPS1",100 ,0)
	3865	;
	3866	"RTN","PRC ACPS1",101 ,0)
	3867	HEX(AMT) ; sets up am ount forma tted as 99 9999999V99 S w/no lea ding blank s and trai ling sign
	3868	"RTN","PRC ACPS1",102 ,0)
	3869	I $G(AMT) '?.1"-".N. 1".".N S A MT="" G Q
	3870	"RTN","PRC ACPS1",103 ,0)
	3871	S AMT=$TR ($J(AMT,9, 2)," ","")
	3872	"RTN","PRC ACPS1",104 ,0)
	3873	I $E(AMT) ="-" S AMT =$E(AMT,2, 99)_$E(AMT ,1)
	3874	"RTN","PRC ACPS1",105 ,0)
	3875	E S AMT= AMT_"+"
	3876	"RTN","PRC ACPS1",106 ,0)
	3877	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	3878	"RTN","PRC ACPS1",107 ,0)
	3879	Q Q AMT
	3880	"RTN","PRC ACPS1",108 ,0)
	3881	;
	3882	"RTN","PRC ACPS1",109 ,0)
	3883	DTMDY(DAT) ;Changes date from fm to mmdd yyyy forma t
	3884	"RTN","PRC ACPS1",110 ,0)
	3885	N YR
	3886	"RTN","PRC ACPS1",111 ,0)
	3887	I '$G(DAT ) G QDAT
	3888	"RTN","PRC ACPS1",112 ,0)
	3889	S YR=$E(( $E(DAT,1,3 )+1700),1, 2)
	3890	"RTN","PRC ACPS1",113 ,0)
	3891	Q $E(DAT, 4,5)_$E(DA T,6,7)_$G( YR)_$E(DAT ,2,3)
	3892	"RTN","PRC ACPS1",114 ,0)
	3893	QDAT Q ""
	3894	"RTN","PRC ACPS1",115 ,0)
	3895	;
	3896	"RTN","PRC ACPS1",116 ,0)
	3897	BLANK(X) ; returns 'x ' blank sp aces
	3898	"RTN","PRC ACPS1",117 ,0)
	3899	N BLANK
	3900	"RTN","PRC ACPS1",118 ,0)
	3901	S BLANK=" ",$P(BLANK ," ",X+1)= ""
	3902	"RTN","PRC ACPS1",119 ,0)
	3903	Q BLANK
	3904	"RTN","PRC ACPS1",120 ,0)
	3905	;
	3906	"RTN","PRC ACPS1",121 ,0)
	3907	RJZF(X,Y) ;right jus tify zero fill width Y
	3908	"RTN","PRC ACPS1",122 ,0)
	3909	S X=$E("0 0000000000 0",1,Y-$L( X))_X
	3910	"RTN","PRC ACPS1",123 ,0)
	3911	Q X
	3912	"RTN","PRC ACPS1",124 ,0)
	3913	;
	3914	"RTN","PRC ACPS1",125 ,0)
	3915	LJSF(X,Y) ;left just ified spac e filled
	3916	"RTN","PRC ACPS1",126 ,0)
	3917	S X=$E(X, 1,Y)
	3918	"RTN","PRC ACPS1",127 ,0)
	3919	S X=X_$$B LANK(Y-$L( X))
	3920	"RTN","PRC ACPS1",128 ,0)
	3921	Q X
	3922	"RTN","PRC ACPS1",129 ,0)
	3923	;
	3924	"RTN","PRC ACPS1",130 ,0)
	3925	JD() ; ret urns today 's Julian date YDOY
	3926	"RTN","PRC ACPS1",131 ,0)
	3927	N XMDDD,X MNOW,XMDT
	3928	"RTN","PRC ACPS1",132 ,0)
	3929	S XMNOW=$ $NOW^XLFDT
	3930	"RTN","PRC ACPS1",133 ,0)
	3931	S XMDT=$E (XMNOW,1,7 )
	3932	"RTN","PRC ACPS1",134 ,0)
	3933	S XMDDD=$ $RJ^XLFSTR ($$FMDIFF^ XLFDT(XMDT ,$E(XMDT,1 ,3)_"0101" ,1)+1,3,"0 ")
	3934	"RTN","PRC ACPS1",135 ,0)
	3935	Q $E(DT,3 )_XMDDD
	3936	"RTN","PRC ACPS1",136 ,0)
	3937	;
	3938	"RTN","PRC ACPS1",137 ,0)
	3939	AMOUNT(X) ;changes a mount to z ero filled , right ju stified
	3940	"RTN","PRC ACPS1",138 ,0)
	3941	S:X<0 X=- X
	3942	"RTN","PRC ACPS1",139 ,0)
	3943	S X=$TR($ J(X,0,2)," .")
	3944	"RTN","PRC ACPS1",140 ,0)
	3945	S X=$E("0 0000000000 0",1,14-$L (X))_X
	3946	"RTN","PRC ACPS1",141 ,0)
	3947	Q X
	3948	"RTN","PRC ACPS1",142 ,0)
	3949	;
	3950	"RTN","PRC ACPSA")
	3951	0^29^B3327 0653^n/a
	3952	"RTN","PRC ACPSA",1,0 )
	3953	PRCACPSA ; ALBANY/MGD -PATIENT S TATEMENTS AUTO-CORRE CTION ;09/ 21/15 3:34 PM
	3954	"RTN","PRC ACPSA",2,0 )
	3955	;;4.5;Acc ounts Rece ivable;3 13;Mar 2 0, 1995;Bu ild 150
	3956	"RTN","PRC ACPSA",3,0 )
	3957	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3958	"RTN","PRC ACPSA",4,0 )
	3959	;
	3960	"RTN","PRC ACPSA",5,0 )
	3961	Q
	3962	"RTN","PRC ACPSA",6,0 )
	3963	;
	3964	"RTN","PRC ACPSA",7,0 )
	3965	BILLQUIT(D EBTOR,BILL ) ;
	3966	"RTN","PRC ACPSA",8,0 )
	3967	; check n ews and in itializati ons
	3968	"RTN","PRC ACPSA",9,0 )
	3969	N
	3970	FILENUM,IE NCRRT,IENP REV,PRCABF IX,PRCABST ,PRCAFDA,P RCACUR,PRC ACUR1,PRCA PRV,PRCAPR V1,TN,
	3971	TNLAST,TRN SCRRT,TRNS PREV,X
	3972	"RTN","PRC ACPSA",10, 0)
	3973	S TNLAST= ""
	3974	"RTN","PRC ACPSA",11, 0)
	3975	S PRCABFI X=0
	3976	"RTN","PRC ACPSA",12, 0)
	3977	S TN=0
	3978	"RTN","PRC ACPSA",13, 0)
	3979	F S TN=$ O(^TMP("PR CAGTPS",$J ,DEBTOR,BI LL,TN)) Q: 'TN D
	3980	"RTN","PRC ACPSA",14, 0)
	3981	.; Load 0 and 1 nod es
	3982	"RTN","PRC ACPSA",15, 0)
	3983	.S PRCACU R=$G(^PRCA (433,TN,0) )
	3984	"RTN","PRC ACPSA",16, 0)
	3985	.S PRCACU R1=$G(^PRC A(433,TN,1 ))
	3986	"RTN","PRC ACPSA",17, 0)
	3987	.; Quit i f this Tra nsaction i s a COMMEN T
	3988	"RTN","PRC ACPSA",18, 0)
	3989	.I $P(PRC ACUR1,U,2) =45 Q
	3990	"RTN","PRC ACPSA",19, 0)
	3991	.; Quit i f this tra nsaction w as updated earlier a s part of an previou s fix
	3992	"RTN","PRC ACPSA",20, 0)
	3993	.I $P($G( ^PRCA(433, TN,9)),U,4 ) Q
	3994	"RTN","PRC ACPSA",21, 0)
	3995	.S TNLAST =TN
	3996	"RTN","PRC ACPSA",22, 0)
	3997	.; Check if Transac tion is ma rked as IN COMPLETE
	3998	"RTN","PRC ACPSA",23, 0)
	3999	.I $P(PRC ACUR,U,10) =1 S PRCAB FIX=PRCABF IX+1,PRCAB FIX("I")=$ G(PRCABFIX ("I"))+1
	4000	"RTN","PRC ACPSA",24, 0)
	4001	.; Check if zero do llar amoun t
	4002	"RTN","PRC ACPSA",25, 0)
	4003	.;I $P(PR CACUR1,U,5 )="" S PRC ABFIX=PRCA BFIX+1,PRC ABFIX("N") =$G(PRCABF IX("N"))+1
	4004	"RTN","PRC ACPSA",26, 0)
	4005	.S PRCAPR V=$G(^PRCA (433,TN-1, 0))
	4006	"RTN","PRC ACPSA",27, 0)
	4007	.S PRCAPR V1=$G(^PRC A(433,TN-1 ,1))
	4008	"RTN","PRC ACPSA",28, 0)
	4009	.; Perfor m quick hi gh level d uplicate c heck
	4010	"RTN","PRC ACPSA",29, 0)
	4011	.I $P(PRC ACUR,U,2)' =$P(PRCAPR V,U,2) Q ; QUIT if (#.03) BIL L NUMBER d on't match
	4012	"RTN","PRC ACPSA",30, 0)
	4013	.I $P(PRC ACUR,U,9)' =$P(PRCAPR V,U,9) Q ; QUIT if (#42) PROC ESSED BY d on't match
	4014	"RTN","PRC ACPSA",31, 0)
	4015	.I $P(PRC ACUR1,U,1) '=$P(PRCAP RV1,U,1) Q ; QUIT i f (#11) TR ANSACTION DATE don't match
	4016	"RTN","PRC ACPSA",32, 0)
	4017	.I $P(PRC ACUR1,U,5) '=$P(PRCAP RV1,U,5) Q ; QUIT i f (#15) TR ANS. AMOUN T don't ma tch
	4018	"RTN","PRC ACPSA",33, 0)
	4019	.; Perfor m detailed duplicate check
	4020	"RTN","PRC ACPSA",34, 0)
	4021	.S IENPRE V=TN-1,IEN CRRT=TN,FI LENUM=433
	4022	"RTN","PRC ACPSA",35, 0)
	4023	.K TRNSPR EV S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENP REV,"**"," N","TRNSPR EV","MSG")
	4024	"RTN","PRC ACPSA",36, 0)
	4025	.K TRNSCR RT S FILEN UM=433 D G ETS^DIQ(FI LENUM,IENC RRT,"**"," N","TRNSCR RT","MSG")
	4026	"RTN","PRC ACPSA",37, 0)
	4027	.S TRNSCR RT(433,TN_ ",",.01)=T RNSPREV(43 3,(TN-1)_" ,",.01)
	4028	"RTN","PRC ACPSA",38, 0)
	4029	.I $D(TRN SPREV(433, (TN-1)_"," ,41)) S TR NSCRRT(433 ,TN_",",41 )=$G(TRNSP REV(433,(T N-1)_",",4 1))
	4030	"RTN","PRC ACPSA",39, 0)
	4031	.I $$DIQO UTCS^PRCAC PS(.TRNSPR EV)'=$$DIQ OUTCS^PRCA CPS(.TRNSC RRT) Q
	4032	"RTN","PRC ACPSA",40, 0)
	4033	.; Set du plicate fl ag which w ill be use d in START 2
	4034	"RTN","PRC ACPSA",41, 0)
	4035	.S $P(^TM P("PRCAGTP S",$J,DEBT OR,BILL,TN ),U,12)=1
	4036	"RTN","PRC ACPSA",42, 0)
	4037	.; we hav e a duplic ate so upd ate counte r
	4038	"RTN","PRC ACPSA",43, 0)
	4039	.S PRCABF IX=PRCABFI X+1,PRCABF IX("D")=$G (PRCABFIX( "D"))+1
	4040	"RTN","PRC ACPSA",44, 0)
	4041	; Get Bil l Status f or checks
	4042	"RTN","PRC ACPSA",45, 0)
	4043	S PRCABST =$P($G(^PR CA(430,BIL L,0)),U,8)
	4044	"RTN","PRC ACPSA",46, 0)
	4045	;
	4046	"RTN","PRC ACPSA",47, 0)
	4047	; 3rd pie ce of ^TMP ("PRCABILL ",$J,DEBTO R,BILL) is stop/go f lag for th is bill.
	4048	"RTN","PRC ACPSA",48, 0)
	4049	; Set bel ow and uti lized in S TART2^PRCA CPS
	4050	"RTN","PRC ACPSA",49, 0)
	4051	;
	4052	"RTN","PRC ACPSA",50, 0)
	4053	; Check f or Duplica te needs t o include Bill Statu s of ACTIV E (#16), O PEN (#42) or CANCELL ATION (#39 )
	4054	"RTN","PRC ACPSA",51, 0)
	4055	; If ther e was only 1 problem and that problem wa s a Duplic ate and th e Bill Sta tus is ACT IVE or OPE N
	4056	"RTN","PRC ACPSA",52, 0)
	4057	; or CANC ELLATION Q uit and le t it get s et in CHEC K2
	4058	"RTN","PRC ACPSA",53, 0)
	4059	I PRCABFI X=1,$G(PRC ABFIX("D") )=1,(PRCAB ST=16!(PRC ABST=42)!( PRCABST=39 )) S
	4060	$P(^TMP("P RCABILL",$ J,DEBTOR,B ILL),U,3)= 0 Q 0
	4061	"RTN","PRC ACPSA",54, 0)
	4062	; If a si ngle probl em on a Bi ll in a st atus other than Acti ve or Open mark last transacti on as NOT FIXABLE
	4063	"RTN","PRC ACPSA",55, 0)
	4064	I PRCABFI X=1,PRCABS T'=16&(PRC ABST'=42) D UPDTLTR( $G(TNLAST) )
	4065	"RTN","PRC ACPSA",56, 0)
	4066	; If a si ngle probl em on a Bi ll in a st atus of Ac tive or Op en will be further c hecked in START2
	4067	"RTN","PRC ACPSA",57, 0)
	4068	I PRCABFI X=1,(PRCAB ST=16!(PRC ABST=42)) S PRCABFIX =0
	4069	"RTN","PRC ACPSA",58, 0)
	4070	; If mult iple probl ems set au dit fields for last transactio n for the Bill
	4071	"RTN","PRC ACPSA",59, 0)
	4072	I PRCABFI X>1 D UPDT LTR($G(TNL AST)) S PR CABFIX=1
	4073	"RTN","PRC ACPSA",60, 0)
	4074	; Update Bill level stop flag
	4075	"RTN","PRC ACPSA",61, 0)
	4076	S $P(^TMP ("PRCABILL ",$J,DEBTO R,BILL),U, 3)=PRCABFI X
	4077	"RTN","PRC ACPSA",62, 0)
	4078	Q PRCABFI X
	4079	"RTN","PRC ACPSA",63, 0)
	4080	;
	4081	"RTN","PRC ACPSA",64, 0)
	4082	UPDTLTR(TN LAST) ;
	4083	"RTN","PRC ACPSA",65, 0)
	4084	; Initial ize variab les
	4085	"RTN","PRC ACPSA",66, 0)
	4086	N PRCABIL L,PRCABILX ,PRCADTR,P RCATN,PRCA UPDT
	4087	"RTN","PRC ACPSA",67, 0)
	4088	; Initial ize PRCAUP DT to 0 (i .e. No). This flag is set to 1 when an transactio n was upda ted with t he audit
	4089	data
	4090	"RTN","PRC ACPSA",68, 0)
	4091	S PRCAUPD T=0
	4092	"RTN","PRC ACPSA",69, 0)
	4093	; If TNLA ST was und efined or null or so mething ot her than a positive number, se t TNLAST=0
	4094	"RTN","PRC ACPSA",70, 0)
	4095	; If TNLA ST was a p ositive nu mber, leav e it as is
	4096	"RTN","PRC ACPSA",71, 0)
	4097	S TNLAST= +$G(TNLAST ,0)
	4098	"RTN","PRC ACPSA",72, 0)
	4099	; If the IEN was a decimal nu mber, stri p off the decimal am ount
	4100	"RTN","PRC ACPSA",73, 0)
	4101	S TNLAST= $P(TNLAST, ".",1)
	4102	"RTN","PRC ACPSA",74, 0)
	4103	; Init ch ecks for a positive IEN and no correspon ding trans action
	4104	"RTN","PRC ACPSA",75, 0)
	4105	I +TNLAST >0,'$D(^PR CA(433,TNL AST,0)) S TNLAST=0
	4106	"RTN","PRC ACPSA",76, 0)
	4107	; Init ch ecks for a positive IEN and th is Transac tion exist s
	4108	"RTN","PRC ACPSA",77, 0)
	4109	I +TNLAST >0,$D(^PRC A(433,TNLA ST,0)) D Q:PRCAUPDT
	4110	"RTN","PRC ACPSA",78, 0)
	4111	.; If thi s transact ion hasn't been prev iously use d to flag an account , use it
	4112	"RTN","PRC ACPSA",79, 0)
	4113	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="" S PRCAUPDT= 1 D UPDTSE T(TNLAST) Q
	4114	"RTN","PRC ACPSA",80, 0)
	4115	.; If thi s transact ion was pr eviously u sed to ide ntify a NO T FIXABLE issue
	4116	"RTN","PRC ACPSA",81, 0)
	4117	.; update it again to have to day's date
	4118	"RTN","PRC ACPSA",82, 0)
	4119	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)="X" S PRCAUPDT =1 D UPDTS ET(TNLAST) Q
	4120	"RTN","PRC ACPSA",83, 0)
	4121	.; If thi s Transact ion was pr eviously u sed to fix an issue other than NOT FIXAB LE,
	4122	"RTN","PRC ACPSA",84, 0)
	4123	.; reset to 0 to ma ke it find another t ransaction
	4124	"RTN","PRC ACPSA",85, 0)
	4125	.I $P($G( ^PRCA(433, TNLAST,9)) ,U,6)'="", ($P($G(^PR CA(433,TNL AST,9)),U, 6)'="X") S TNLAST=0
	4126	"RTN","PRC ACPSA",86, 0)
	4127	.Q
	4128	"RTN","PRC ACPSA",87, 0)
	4129	; If you get to her e, TNLAST was either sent in w ith a posi tive value that coul dn't be us ed
	4130	"RTN","PRC ACPSA",88, 0)
	4131	; OR TNLA ST was sen t in as a null or 0. Either wa y, try to find anoth er accepta ble transa ction to m ark
	4132	"RTN","PRC ACPSA",89, 0)
	4133	; There i s a possib ility that no transa ction can be found t o mark, in which cas e, just qu it
	4134	"RTN","PRC ACPSA",90, 0)
	4135	I +TNLAST <1 D Q:+T NLAST<1
	4136	"RTN","PRC ACPSA",91, 0)
	4137	.S PRCABI LX=""
	4138	"RTN","PRC ACPSA",92, 0)
	4139	.F S PRC ABILX=$O(^ TMP("PRCAG TPS",$J,DE BTOR,PRCAB ILX),-1) Q :'PRCABILX D Q:TNL AST
	4140	"RTN","PRC ACPSA",93, 0)
	4141	..S PRCAT N=""
	4142	"RTN","PRC ACPSA",94, 0)
	4143	..F S PR CATN=$O(^T MP("PRCAGT PS",$J,DEB TOR,PRCABI LX,PRCATN) ,-1) Q:'PR CATN D Q :TNLAST
	4144	"RTN","PRC ACPSA",95, 0)
	4145	...; Quit if this t ransaction from ^TMP doesn't e xist in ^P RCA(433
	4146	"RTN","PRC ACPSA",96, 0)
	4147	...I '$D( ^PRCA(433, PRCATN,0)) Q
	4148	"RTN","PRC ACPSA",97, 0)
	4149	...; If t his transa ction hasn 't been ma rked for a nything, u se it
	4150	"RTN","PRC ACPSA",98, 0)
	4151	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)="" S TNLAST= PRCATN Q
	4152	"RTN","PRC ACPSA",99, 0)
	4153	...; Chec k if this transactio n was prev iously fla gged as so me fix oth er than NO T FIXABLE
	4154	"RTN","PRC ACPSA",100 ,0)
	4155	...I $P($ G(^PRCA(43 3,PRCATN,9 )),U,6)'=" X" Q
	4156	"RTN","PRC ACPSA",101 ,0)
	4157	...; If t his transc tion was p reviously marked as NOT FIXABL E, mark it again wit h today's date
	4158	"RTN","PRC ACPSA",102 ,0)
	4159	...S TNLA ST=PRCATN
	4160	"RTN","PRC ACPSA",103 ,0)
	4161	; QUIT If no accept able trans action cou ld be foun d
	4162	"RTN","PRC ACPSA",104 ,0)
	4163	Q:+TNLAST <1
	4164	"RTN","PRC ACPSA",105 ,0)
	4165	; QUIT if this tran saction do esn't exis t for some reason
	4166	"RTN","PRC ACPSA",106 ,0)
	4167	Q:'$D(^PR CA(433,TNL AST,0))
	4168	"RTN","PRC ACPSA",107 ,0)
	4169	; Call UP DTSET to u pdate the transactio n that was identifie d
	4170	"RTN","PRC ACPSA",108 ,0)
	4171	D UPDTSET (TNLAST)
	4172	"RTN","PRC ACPSA",109 ,0)
	4173	Q
	4174	"RTN","PRC ACPSA",110 ,0)
	4175	;
	4176	"RTN","PRC ACPSA",111 ,0)
	4177	UPDTSET(TN LAST) ; On ce transac tion has b een identi fied, set the necess ary audit fields
	4178	"RTN","PRC ACPSA",112 ,0)
	4179	; Identif y Bill for this Tran saction
	4180	"RTN","PRC ACPSA",113 ,0)
	4181	S PRCABIL L=$P($G(^P RCA(433,TN LAST,0)),U ,2)
	4182	"RTN","PRC ACPSA",114 ,0)
	4183	; Quit if bill can' t be ident ified
	4184	"RTN","PRC ACPSA",115 ,0)
	4185	Q:PRCABIL L=""
	4186	"RTN","PRC ACPSA",116 ,0)
	4187	; Use Bil l to ident ify Debtor
	4188	"RTN","PRC ACPSA",117 ,0)
	4189	S PRCADTR =$P($G(^PR CA(430,PRC ABILL,0)), U,9)
	4190	"RTN","PRC ACPSA",118 ,0)
	4191	; Quit if Debtor ca n't be def ined
	4192	"RTN","PRC ACPSA",119 ,0)
	4193	Q:PRCADTR =""
	4194	"RTN","PRC ACPSA",120 ,0)
	4195	; Quit if the stop flag for t his bill w as previou sly set in $$BILLQUI T^PRCACPSA
	4196	"RTN","PRC ACPSA",121 ,0)
	4197	I $P($G(^ TMP("PRCAB ILL",$J,PR CADTR,PRCA BILL)),U,3 ) Q
	4198	"RTN","PRC ACPSA",122 ,0)
	4199	; Get cur rent date
	4200	"RTN","PRC ACPSA",123 ,0)
	4201	D NOW^%DT C
	4202	"RTN","PRC ACPSA",124 ,0)
	4203	N PRCADAT E
	4204	"RTN","PRC ACPSA",125 ,0)
	4205	S PRCADAT E=X
	4206	"RTN","PRC ACPSA",126 ,0)
	4207	; Set up Audit Fiel d Array
	4208	"RTN","PRC ACPSA",127 ,0)
	4209	S PRCAFDA (433,TNLAS T_",",94)= PRCADATE
	4210	"RTN","PRC ACPSA",128 ,0)
	4211	S PRCAFDA (433,TNLAS T_",",96)= "X" ; NOT FIXABLE
	4212	"RTN","PRC ACPSA",129 ,0)
	4213	S PRCAFDA (433,TNLAS T_",",97)= 1
	4214	"RTN","PRC ACPSA",130 ,0)
	4215	L +^PRCA( 433,TNLAST ,9):DILOCK TM
	4216	"RTN","PRC ACPSA",131 ,0)
	4217	; QUIT if lock not obtainable
	4218	"RTN","PRC ACPSA",132 ,0)
	4219	Q:'$T
	4220	"RTN","PRC ACPSA",133 ,0)
	4221	; Update record
	4222	"RTN","PRC ACPSA",134 ,0)
	4223	D FILE^DI E(,"PRCAFD A")
	4224	"RTN","PRC ACPSA",135 ,0)
	4225	; Unlock file
	4226	"RTN","PRC ACPSA",136 ,0)
	4227	L -^PRCA( 433,TNLAST ,9)
	4228	"RTN","PRC ACPSA",137 ,0)
	4229	Q
	4230	"RTN","PRC ACPSA",138 ,0)
	4231	;
	4232	"RTN","PRC ACPSA",139 ,0)
	4233	PRCAMAIL(P RCASTRT) ;
	4234	"RTN","PRC ACPSA",140 ,0)
	4235	; Send e- mail notif ication to the PRCAC PS mail gr oup if the Auto-Corr ect was ma nually run
	4236	"RTN","PRC ACPSA",141 ,0)
	4237	; when it showed to be curren tly runnin g or possi ble errore d out on a previous attempt.
	4238	"RTN","PRC ACPSA",142 ,0)
	4239	;
	4240	"RTN","PRC ACPSA",143 ,0)
	4241	; PRCASTA RT = Exter nal format of date/t ime (i.e. OCT 12, 20 16@09:39:5 8) that th e
	4242	"RTN","PRC ACPSA",144 ,0)
	4243	; Auto-Co rrect prog ram was la st started .
	4244	"RTN","PRC ACPSA",145 ,0)
	4245	N XMY,XMD UZ,XMSUB,X MTEXT,X
	4246	"RTN","PRC ACPSA",146 ,0)
	4247	S XMDUZ=" AR PACKAGE "
	4248	"RTN","PRC ACPSA",147 ,0)
	4249	S XMY("G. PRCACPS")= ""
	4250	"RTN","PRC ACPSA",148 ,0)
	4251	S XMSUB=" CPS AUTO-C ORRECTION FAILURE "_ $E(DT,4,5) _"/"_$E(DT ,6,7)_"/"_ $E(DT,2,3)
	4252	"RTN","PRC ACPSA",149 ,0)
	4253	S X(1)="T he Patient Statement Auto-Corr ection Pro gram was s tarted on: "
	4254	"RTN","PRC ACPSA",150 ,0)
	4255	S X(2)=PR CASTRT_" a nd may not have comp leted norm ally."
	4256	"RTN","PRC ACPSA",151 ,0)
	4257	S X(3)=""
	4258	"RTN","PRC ACPSA",152 ,0)
	4259	S X(4)="P lease have OI&T chec k the erro r trap for any error s related to routine "
	4260	"RTN","PRC ACPSA",153 ,0)
	4261	S X(5)="P RCACPS on this date. "
	4262	"RTN","PRC ACPSA",154 ,0)
	4263	S XMTEXT= "X("
	4264	"RTN","PRC ACPSA",155 ,0)
	4265	D ^XMD
	4266	"RTN","PRC ACPSA",156 ,0)
	4267	Q
	4268	"RTN","PRC AG")
	4269	0^17^B7539 9507^B2201 6512
	4270	"RTN","PRC AG",1,0)
	4271	PRCAG ;WAS H-ISC@ALTO ONA,PA/CMS -Reprint S tatement/L etter Opti on Entries ;8/23/93 2:42 PM
	4272	"RTN","PRC AG",2,0)
	4273	V ;;4.5;Ac counts Rec eivable; 149,165,19 8,313;Ma r 20, 1995 ;Build 150
	4274	"RTN","PRC AG",3,0)
	4275	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4276	"RTN","PRC AG",4,0)
	4277	REP ;ENTRY FROM REPR INT PAT ST ATEMENT
	4278	"RTN","PRC AG",5,0)
	4279	NEW BEG,E ND,DAT,DAT E,DEB,DIC, HDAT,IOP,S ITE,TYP,X, Y,ZTDESC,Z TRTN,ZTSAV E,SDT,%ZIS ,POP,ZTIO
	4280	"RTN","PRC AG",6,0)
	4281	W !!
	4282	"RTN","PRC AG",7,0)
	4283	ADT ; PRC A4.5313 - Build an d print a list of av ailable da tes for Pa tient Stat ements wit hin the la st
	4284	month
	4285	"RTN","PRC AG",8,0)
	4286	W !,"Thes e dates in the previ ous month contain Pa tient Stat ements: "
	4287	"RTN","PRC AG",9,0)
	4288	S DAT="" F S DAT=$ O(^RCPS(34 9.2,"STDT" ,DAT)) Q:D AT="" I $ D(^RC(341, "STDT",DAT )) W
	4289	!,$$DATE^R CCPCPS1(DA T)
	4290	"RTN","PRC AG",10,0)
	4291	W !!
	4292	"RTN","PRC AG",11,0)
	4293	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4294	"RTN","PRC AG",12,0)
	4295	S DIR(0)= "DAO^^K:'$ D(^RC(341, ""STDT"",Y )) X"
	4296	"RTN","PRC AG",13,0)
	4297	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	4298	"RTN","PRC AG",14,0)
	4299	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	4300	"RTN","PRC AG",15,0)
	4301	D ^DIR
	4302	"RTN","PRC AG",16,0)
	4303	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4304	"RTN","PRC AG",17,0)
	4305	S SDT=Y
	4306	"RTN","PRC AG",18,0)
	4307	W !!,"NOT E: The ran ge is in p rint order not alpha betic!",!
	4308	"RTN","PRC AG",19,0)
	4309	S X=""
	4310	"RTN","PRC AG",20,0)
	4311	S BEG=$O( ^RC(341,"S TDT",SDT," "))
	4312	"RTN","PRC AG",21,0)
	4313	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4314	"RTN","PRC AG",22,0)
	4315	S DIR(0)= "YAO"
	4316	"RTN","PRC AG",23,0)
	4317	S DIR("B" )="N"
	4318	"RTN","PRC AG",24,0)
	4319	S DIR("A" )="Do you want to St art with a Specific Patient? "
	4320	"RTN","PRC AG",25,0)
	4321	D ^DIR
	4322	"RTN","PRC AG",26,0)
	4323	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4324	"RTN","PRC AG",27,0)
	4325	I Y=0 S X =""
	4326	"RTN","PRC AG",28,0)
	4327	I Y=1 S X =$$SELNAME (SDT)
	4328	"RTN","PRC AG",29,0)
	4329	I X=-1 Q
	4330	"RTN","PRC AG",30,0)
	4331	I X'="" S BEG=X
	4332	"RTN","PRC AG",31,0)
	4333	; PRCA4. 5313 - Us e statemen t date cro ss-referen ce to prov ide a pati ent list
	4334	"RTN","PRC AG",32,0)
	4335	S X=""
	4336	"RTN","PRC AG",33,0)
	4337	S END=$O( ^RC(341,"S TDT",SDT," "),-1)
	4338	"RTN","PRC AG",34,0)
	4339	W !,"Endi ng Patient Bill must be printe d after th e Starting Patient B ill.",!
	4340	"RTN","PRC AG",35,0)
	4341	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4342	"RTN","PRC AG",36,0)
	4343	S DIR(0)= "YAO"
	4344	"RTN","PRC AG",37,0)
	4345	S DIR("B" )="N"
	4346	"RTN","PRC AG",38,0)
	4347	S DIR("A" )="Do you want to En d with a S pecific Pa tient? "
	4348	"RTN","PRC AG",39,0)
	4349	D ^DIR
	4350	"RTN","PRC AG",40,0)
	4351	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	4352	"RTN","PRC AG",41,0)
	4353	I Y=0 S X =""
	4354	"RTN","PRC AG",42,0)
	4355	I Y=1 S X =$$SELNAME (SDT)
	4356	"RTN","PRC AG",43,0)
	4357	I X=-1 Q
	4358	"RTN","PRC AG",44,0)
	4359	I X'="" S END=X
	4360	"RTN","PRC AG",45,0)
	4361	I END>0,E ND<BEG W * 7,!,"Endin g bill is before sta rting bill !" D
	4362	Q:$D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) G ADT
	4363	"RTN","PRC AG",46,0)
	4364	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4365	"RTN","PRC AG",47,0)
	4366	. S DIR(0 )="E"
	4367	"RTN","PRC AG",48,0)
	4368	. D ^DIR
	4369	"RTN","PRC AG",49,0)
	4370	S HDAT=99 99999-SDT
	4371	"RTN","PRC AG",50,0)
	4372	REPD W !! S %ZIS="QN ",IOP="Q", %ZIS("B")= $P($G(^RC( 342,1,0)), U,8) D ^%Z IS G:POP R EPQ
	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
	4377	Statements ",ZTSAVE(" BEG")="",Z 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,DT OUT
	4394	"RTN","PRC AG",61,0)
	4395	D SITE^PR CAGU
	4396	"RTN","PRC AG",62,0)
	4397	S:'$D(ETY ) ETY="FL"
	4398	"RTN","PRC AG",63,0)
	4399	REBDT S %D T="AEXP",% DT(0)="-NO W",%DT("A" )="Enter a Date to R eprint: " D ^%DT G:Y <1 REBQ
	4400	"RTN","PRC AG",64,0)
	4401	S Y=$P(Y, ".")
	4402	"RTN","PRC AG",65,0)
	4403	I $P($O(^ RC(341,"C" ,Y)),".")' =Y W !!,*7 ,"No notif ications s ent on tha t date",! G REBDT
	4404	"RTN","PRC AG",66,0)
	4405	S DAT=999 9999-Y
	4406	"RTN","PRC AG",67,0)
	4407	W !!,"Pre ss return at the 'Bi ll:' promp ts to repr int all ", ETY," Lett ers",!,"fo r the date selected or select a
	4408	start and/ or end poi nt."
	4409	"RTN","PRC AG",68,0)
	4410	W !,"Do n ot select bills that print on the Patien t Statemen t."
	4411	"RTN","PRC AG",69,0)
	4412	W !,"NOTE : The rang e is in pr int order not alphab etic!",!
	4413	"RTN","PRC AG",70,0)
	4414	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	4415	"RTN","PRC AG",71,0)
	4416	S DIC="^P RCA(430,", DIC(0)="AE MNQ",DIC(" A")="Start from Bill : ",DIC("S ")="I
	4417	"",18,25,5 ,24,1,2,3, 4,23,22,"" '[("",""_$ P(^(0),U,2 )_"","")" D ^DIC I ( $D(DTOUT)) !(X["^") G REBQ
	4418	"RTN","PRC AG",72,0)
	4419	S BEG=0,Y =+Y
	4420	"RTN","PRC AG",73,0)
	4421	I Y>0 S B EG=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="U B":9,1:10) ,0)) F
	4422	DATE=DAT-. 0001:0 S D ATE=$O(^RC (341,"AD", DEB,TYP,DA TE)) Q:$P( DATE,".")' =DAT D
	4423	"RTN","PRC AG",74,0)
	4424	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y S BEG=DA,D EB=0
	4425	Q
	4426	"RTN","PRC AG",75,0)
	4427	.Q
	4428	"RTN","PRC AG",76,0)
	4429	I BEG=0 S BEG=$O(^R C(341,"C", +$O(^RC(34 1,"C",9999 999-DAT)), 0)) S:'BEG BEG=-1
	4430	"RTN","PRC AG",77,0)
	4431	I BEG<0 W *7,!," So rry, not f ound!" G R EBDT
	4432	"RTN","PRC AG",78,0)
	4433	S DIC("A" )="End aft er Bill: " D ^DIC I ($D(DTOUT) )!(X["^") G REBQ
	4434	"RTN","PRC AG",79,0)
	4435	S END="*" ,Y=+Y
	4436	"RTN","PRC AG",80,0)
	4437	I Y>0 S E ND=-1,DEB= +$P($G(^PR CA(430,Y,0 )),U,9),TY P=+$O(^RC( 341.1,"AC" ,$S(ETY="U B":9,1:10) ,0)) F
	4438	DATE=DAT-. 0001:0 S D ATE=$O(^RC (341,"AD", DEB,TYP,DA TE)) Q:$P( DATE,".")' =DAT D
	4439	"RTN","PRC AG",81,0)
	4440	.F DA=0:0 S DA=$O(^ RC(341,"AD ",DEB,TYP, DATE,DA)) Q:'DA I + $G(^RC(341 ,DA,5))=Y S END=DA,D EB=0
	4441	Q
	4442	"RTN","PRC AG",82,0)
	4443	.Q
	4444	"RTN","PRC AG",83,0)
	4445	I END<0 W *7,!," So rry, not f ound!" G R EBDT
	4446	"RTN","PRC AG",84,0)
	4447	I END'="* ",END<BEG W *7,!,"En ding bill is before starting b ill!" G RE BDT
	4448	"RTN","PRC AG",85,0)
	4449	W !!
	4450	"RTN","PRC AG",86,0)
	4451	REBD I ETY ="UB" S ZT IO="" G RE BD1
	4452	"RTN","PRC AG",87,0)
	4453	S %ZIS("B ")=$P($G(^ RC(342,1,0 )),U,8),%Z IS="QN",IO P="Q" D ^% ZIS G:POP REBQ
	4454	"RTN","PRC AG",88,0)
	4455	I '$D(IO( "Q")) W !! ,*7,"YOU M UST QUEUE THIS OUTPU T",! G REB D
	4456	"RTN","PRC AG",89,0)
	4457	REBD1 S
	4458	ZTRTN="BIL L^PRCAGS", ZTSAVE("BE G")="",ZTS AVE("END") ="",ZTSAVE ("DAT")="" ,ZTSAVE("S ITE")="",Z TSA
	4459	VE("ETY")= ""
	4460	"RTN","PRC AG",90,0)
	4461	S ZTDESC= $S(ETY="UB ":"AR Repr int UB Let ters",1:"R eprint AR Follow-up Letters") D ^%ZTLOAD
	4462	"RTN","PRC AG",91,0)
	4463	REBQ K ETY D ^%ZISC Q
	4464	"RTN","PRC AG",92,0)
	4465	PRDT ;ENTR Y FROM PRI NT STATEME NT/LETTER BY DATE OP TION
	4466	"RTN","PRC AG",93,0)
	4467	D PRDT^PR CAGP
	4468	"RTN","PRC AG",94,0)
	4469	Q
	4470	"RTN","PRC AG",95,0)
	4471	SELNAME(SD T) ; PRCA ^4.5^313 - Create a list and t hen select a patient name
	4472	"RTN","PRC AG",96,0)
	4473	; There a re three v alues to R eturn from this tag
	4474	"RTN","PRC AG",97,0)
	4475	; IEN -- Number from list of Selecte d Patient
	4476	"RTN","PRC AG",98,0)
	4477	; Null -- No Pati ent Select ed from li st - used to begin o r end Sele ction list
	4478	"RTN","PRC AG",99,0)
	4479	; -1 -- Quit pr ocessing f rom called tag
	4480	"RTN","PRC AG",100,0)
	4481	N IEN,CNT ,NAME
	4482	"RTN","PRC AG",101,0)
	4483	W !,"Plea se wait wh ile we bui ld the pat ient list. ",!
	4484	"RTN","PRC AG",102,0)
	4485	K ^TMP($J ,"LISTNAME ")
	4486	"RTN","PRC AG",103,0)
	4487	S (IEN,CN T)=0
	4488	"RTN","PRC AG",104,0)
	4489	F S IEN= $O(^RC(341 ,"STDT",SD T,IEN)) Q: IEN="" D
	4490	"RTN","PRC AG",105,0)
	4491	. N PAT,N AME
	4492	"RTN","PRC AG",106,0)
	4493	.; S PAT= $P(^RCD(34 0,$P(^RC(3 41,IEN,0), "^",5),0), ";")
	4494	"RTN","PRC AG",107,0)
	4495	.; S NAME =$P(^DPT(P AT,0),U)
	4496	"RTN","PRC AG",108,0)
	4497	. S NAME= $$GET1^DIQ (341,IEN_" ,",.05) ; WCJ repl aced above 2 lines w ith this o ne
	4498	"RTN","PRC AG",109,0)
	4499	. S ^TMP( $J,"LISTNA ME",NAME)= IEN
	4500	"RTN","PRC AG",110,0)
	4501	; Quit th e listing if no name s to displ ay
	4502	"RTN","PRC AG",111,0)
	4503	I '$D(^TM P($J,"LIST NAME")) D Q -1
	4504	"RTN","PRC AG",112,0)
	4505	. W !,"Th ere are no names to display fo r this dat e."
	4506	"RTN","PRC AG",113,0)
	4507	. S DIR(0 )="E" D ^D IR
	4508	"RTN","PRC AG",114,0)
	4509	S NAME=$$ ENTNAM
	4510	"RTN","PRC AG",115,0)
	4511	I NAME="^ " Q -1
	4512	"RTN","PRC AG",116,0)
	4513	I NAME="" Q NAME
	4514	"RTN","PRC AG",117,0)
	4515	I $G(NAME )'="",$D(^ TMP($J,"LI STNAME",NA ME)) S IEN =^(NAME) Q IEN
	4516	"RTN","PRC AG",118,0)
	4517	W !!,"Pat ient Name is not an exact matc h."
	4518	"RTN","PRC AG",119,0)
	4519	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4520	"RTN","PRC AG",120,0)
	4521	S DIR(0)= "YAO"
	4522	"RTN","PRC AG",121,0)
	4523	S DIR("B" )="N"
	4524	"RTN","PRC AG",122,0)
	4525	S DIR("A" )="Would y ou like to search Pa tient Name s for "_$$ DATE^RCCPC PS1(SDT)_" ? "
	4526	"RTN","PRC AG",123,0)
	4527	D ^DIR
	4528	"RTN","PRC AG",124,0)
	4529	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4530	"RTN","PRC AG",125,0)
	4531	I Y=0 N Q UIT D I Q UIT'=0 Q Q UIT
	4532	"RTN","PRC AG",126,0)
	4533	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4534	"RTN","PRC AG",127,0)
	4535	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4536	"RTN","PRC AG",128,0)
	4537	. S DIR(0 )="YAO"
	4538	"RTN","PRC AG",129,0)
	4539	. S DIR(" B")="Y"
	4540	"RTN","PRC AG",130,0)
	4541	. S DIR(" A")="Is th is correct ? "
	4542	"RTN","PRC AG",131,0)
	4543	. D ^DIR
	4544	"RTN","PRC AG",132,0)
	4545	. S QUIT= Y
	4546	"RTN","PRC AG",133,0)
	4547	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4548	"RTN","PRC AG",134,0)
	4549	. I QUIT= 1 S QUIT=" "
	4550	"RTN","PRC AG",135,0)
	4551	; Select Name - If Zero (0) i s returned keep tryi ng
	4552	"RTN","PRC AG",136,0)
	4553	F S IEN= $$SELNM1(N AME) I IEN '=0 Q
	4554	"RTN","PRC AG",137,0)
	4555	Q IEN
	4556	"RTN","PRC AG",138,0)
	4557	SELNM1(NM) ; Select name
	4558	"RTN","PRC AG",139,0)
	4559	N DIRUT,X CNT,DIR,CN T
	4560	"RTN","PRC AG",140,0)
	4561	K ^TMP($J ,"LISTCNT" )
	4562	"RTN","PRC AG",141,0)
	4563	S CNT=0,N AME=""
	4564	"RTN","PRC AG",142,0)
	4565	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I $D(D IRUT) Q
	4566	"RTN","PRC AG",143,0)
	4567	. ; Add n ame to lis t only if first part of name m atches ent ered name
	4568	"RTN","PRC AG",144,0)
	4569	. I $E(NA ME,1,$L(NM ))'=NM Q
	4570	"RTN","PRC AG",145,0)
	4571	. I CNT=0 W @IOF,"N umber",?10 ,"Patient Name"
	4572	"RTN","PRC AG",146,0)
	4573	. S CNT=C NT+1
	4574	"RTN","PRC AG",147,0)
	4575	. S ^TMP( $J,"LISTCN T",CNT,NAM E)=^TMP($J ,"LISTNAME ",NAME)
	4576	"RTN","PRC AG",148,0)
	4577	. W !,CNT ,?10,NAME
	4578	"RTN","PRC AG",149,0)
	4579	. I ($Y+3 )>IOSL D Q:$D(DIRUT )
	4580	"RTN","PRC AG",150,0)
	4581	. . S DIR (0)="E" D ^DIR
	4582	"RTN","PRC AG",151,0)
	4583	. . I X=" ^" Q
	4584	"RTN","PRC AG",152,0)
	4585	. . W @IO F,"Number" ,?10,"Pati ent Name"
	4586	"RTN","PRC AG",153,0)
	4587	; If no n ames match ed entered name Quit to menu
	4588	"RTN","PRC AG",154,0)
	4589	I CNT=0 D Q QUIT
	4590	"RTN","PRC AG",155,0)
	4591	. W @IOF, "No Matche s to Patie nt Name en tered were found.",!
	4592	"RTN","PRC AG",156,0)
	4593	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4594	"RTN","PRC AG",157,0)
	4595	. S DIR(0 )="E"
	4596	"RTN","PRC AG",158,0)
	4597	. D ^DIR
	4598	"RTN","PRC AG",159,0)
	4599	. S QUIT= 0
	4600	"RTN","PRC AG",160,0)
	4601	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4602	"RTN","PRC AG",161,0)
	4603	W !,"Plea se enter n umber of s elected Pa tient Name : " R XCNT :DTIME
	4604	"RTN","PRC AG",162,0)
	4605	I XCNT="^ " Q -1
	4606	"RTN","PRC AG",163,0)
	4607	; If a va lue entere d is not i n LISTCNT, write err or and all ow retry i f requeste d
	4608	"RTN","PRC AG",164,0)
	4609	I XCNT'=" ",'$D(^TMP ($J,"LISTC NT",XCNT)) N QUIT D Q QUIT
	4610	"RTN","PRC AG",165,0)
	4611	. W !,"Va lue entere d not a li sted numbe r.",!
	4612	"RTN","PRC AG",166,0)
	4613	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4614	"RTN","PRC AG",167,0)
	4615	. S DIR(0 )="E"
	4616	"RTN","PRC AG",168,0)
	4617	. D ^DIR
	4618	"RTN","PRC AG",169,0)
	4619	. S QUIT= 0
	4620	"RTN","PRC AG",170,0)
	4621	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4622	"RTN","PRC AG",171,0)
	4623	I XCNT="" N QUIT D Q QUIT
	4624	"RTN","PRC AG",172,0)
	4625	. W !,"Al l of the P atient Sta tements fo r this dat e will now print."
	4626	"RTN","PRC AG",173,0)
	4627	. N DIR,D TOUT,DUOUT ,DIRUT,DIR OUT
	4628	"RTN","PRC AG",174,0)
	4629	. S DIR(0 )="YAO"
	4630	"RTN","PRC AG",175,0)
	4631	. S DIR(" B")="Y"
	4632	"RTN","PRC AG",176,0)
	4633	. S DIR(" A")="No Pa tient Sele cted. "
	4634	"RTN","PRC AG",177,0)
	4635	. S DIR(" A",1)="Is this corre ct? "
	4636	"RTN","PRC AG",178,0)
	4637	. D ^DIR
	4638	"RTN","PRC AG",179,0)
	4639	. S QUIT= Y
	4640	"RTN","PRC AG",180,0)
	4641	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S QU IT=-1
	4642	"RTN","PRC AG",181,0)
	4643	. I QUIT= 1 S QUIT=" "
	4644	"RTN","PRC AG",182,0)
	4645	S CNT=XCN T
	4646	"RTN","PRC AG",183,0)
	4647	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	4648	"RTN","PRC AG",184,0)
	4649	S DIR(0)= "YAO"
	4650	"RTN","PRC AG",185,0)
	4651	S DIR("B" )="Y"
	4652	"RTN","PRC AG",186,0)
	4653	S DIR("A" )="...OK? "
	4654	"RTN","PRC AG",187,0)
	4655	S DIR("A" ,1)=""
	4656	"RTN","PRC AG",188,0)
	4657	S DIR("A" ,2)=$O(^TM P($J,"LIST CNT",CNT,0 ))
	4658	"RTN","PRC AG",189,0)
	4659	D ^DIR
	4660	"RTN","PRC AG",190,0)
	4661	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q -1
	4662	"RTN","PRC AG",191,0)
	4663	; If user answered No, then t ry again
	4664	"RTN","PRC AG",192,0)
	4665	I Y=0 Q Y
	4666	"RTN","PRC AG",193,0)
	4667	S NAME=$O (^TMP($J," LISTCNT",C NT,0))
	4668	"RTN","PRC AG",194,0)
	4669	Q ^TMP($J ,"LISTCNT" ,CNT,NAME)
	4670	"RTN","PRC AG",195,0)
	4671	;
	4672	"RTN","PRC AG",196,0)
	4673	ENTNAM() ; Enter na me and pri nt list of names if requested
	4674	"RTN","PRC AG",197,0)
	4675	;
	4676	"RTN","PRC AG",198,0)
	4677	N HIT,X
	4678	"RTN","PRC AG",199,0)
	4679	S HIT=0
	4680	"RTN","PRC AG",200,0)
	4681	F D I H IT Q
	4682	"RTN","PRC AG",201,0)
	4683	. W !,"Pl ease enter all or pa rt of Pati ent Name: " R NAME:D TIME
	4684	"RTN","PRC AG",202,0)
	4685	. I NAME' ["?" S HIT =1 Q
	4686	"RTN","PRC AG",203,0)
	4687	. I NAME= "?" D LIST NAME(1)
	4688	"RTN","PRC AG",204,0)
	4689	. I NAME= "??" D LIS TNAME(2)
	4690	"RTN","PRC AG",205,0)
	4691	. ; If th e user ent ers a care t in LISTN AME quit a nd return a caret in NAME to Q uit applic ation
	4692	"RTN","PRC AG",206,0)
	4693	. I X="^" S NAME=X, HIT=1
	4694	"RTN","PRC AG",207,0)
	4695	Q NAME
	4696	"RTN","PRC AG",208,0)
	4697	;
	4698	"RTN","PRC AG",209,0)
	4699	LISTNAME(H EADER) ; Display li st of name
	4700	"RTN","PRC AG",210,0)
	4701	;
	4702	"RTN","PRC AG",211,0)
	4703	N NAME,CN T,DIR,DTOU T,DUOUT,DI RUT,DIROUT
	4704	"RTN","PRC AG",212,0)
	4705	S NAME="" ,CNT=0
	4706	"RTN","PRC AG",213,0)
	4707	F S NAME =$O(^TMP($ J,"LISTNAM E",NAME)) Q:NAME="" D I
	4708	$D(DTOUT)! $D(DUOUT)! $D(DIRUT)! $D(DIROUT) Q
	4709	"RTN","PRC AG",214,0)
	4710	. I CNT=0 ,HEADER=1 W @IOF,"Pa tient Name "
	4711	"RTN","PRC AG",215,0)
	4712	. I CNT=0 ,HEADER=2 D I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	4713	"RTN","PRC AG",216,0)
	4714	. . W @IO F,"The use r can ente r all or p art of a n ame or '?' for the"
	4715	"RTN","PRC AG",217,0)
	4716	. . W !," list of na mes availa ble for th e selected date."
	4717	"RTN","PRC AG",218,0)
	4718	. . S DIR (0)="E" D ^DIR
	4719	"RTN","PRC AG",219,0)
	4720	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) Q
	4721	"RTN","PRC AG",220,0)
	4722	. . W !!, "Patient N ame"
	4723	"RTN","PRC AG",221,0)
	4724	. S CNT=C NT+1
	4725	"RTN","PRC AG",222,0)
	4726	. W !,NAM E
	4727	"RTN","PRC AG",223,0)
	4728	. I ($Y+3 )>IOSL D I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	4729	"RTN","PRC AG",224,0)
	4730	. . S DIR (0)="E" D ^DIR
	4731	"RTN","PRC AG",225,0)
	4732	. . I $D( DTOUT)!$D( DUOUT)!$D( DIRUT)!$D( DIROUT) S X="" Q
	4733	"RTN","PRC AG",226,0)
	4734	. . W @IO F,"Patient Name"
	4735	"RTN","PRC AG",227,0)
	4736	Q
	4737	"RTN","RCB ECHGS")
	4738	0^30^B1451 6952^B1408 0962
	4739	"RTN","RCB ECHGS",1,0 )
	4740	RCBECHGS ; WISC/RFJ-a dd charges to an acc ount or bi ll (top ro utine) ;1 Jun 00
	4741	"RTN","RCB ECHGS",2,0 )
	4742	;;4.5;Acc ounts Rece ivable;1 53,237,301 ,313;Mar 20, 1995; Build 150
	4743	"RTN","RCB ECHGS",3,0 )
	4744	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4745	"RTN","RCB ECHGS",4,0 )
	4746	;DBIA#100 61
	4747	"RTN","RCB ECHGS",5,0 )
	4748	Q
	4749	"RTN","RCB ECHGS",6,0 )
	4750	;
	4751	"RTN","RCB ECHGS",7,0 )
	4752	;
	4753	"RTN","RCB ECHGS",8,0 )
	4754	FIRSTPTY ; add int/ admin char ges to all benefit d ebts
	4755	"RTN","RCB ECHGS",9,0 )
	4756	; this e ntry point is called from CCPC on the
	4757	"RTN","RCB ECHGS",10, 0)
	4758	; statem ent day
	4759	"RTN","RCB ECHGS",11, 0)
	4760	; variab le rclasda t passed e qual to st atement da te
	4761	"RTN","RCB ECHGS",12, 0)
	4762	;
	4763	"RTN","RCB ECHGS",13, 0)
	4764	N RCDEBTD A
	4765	"RTN","RCB ECHGS",14, 0)
	4766	K ^TMP("R CBECHGS RE PORT",$J) ;used to generate m ailman rep ort
	4767	"RTN","RCB ECHGS",15, 0)
	4768	;
	4769	"RTN","RCB ECHGS",16, 0)
	4770	; lock t he int/adm in update to prevent two jobs from apply ing
	4771	"RTN","RCB ECHGS",17, 0)
	4772	; the ch arges at t he same ti me
	4773	"RTN","RCB ECHGS",18, 0)
	4774	L +^RCD(3 40,"RCBECH GS")
	4775	"RTN","RCB ECHGS",19, 0)
	4776	;
	4777	"RTN","RCB ECHGS",20, 0)
	4778	; PRCA4. 5313/DM - Changed c ross-refer ence to pa tient stat ement day
	4779	"RTN","RCB ECHGS",21, 0)
	4780	S RCDEBTD A=0 F S R CDEBTDA=$O (^RCD(340, "AC",+$E(R CLASDAT,6, 7),RCDEBTD A)) Q:RCDE BTDA="" I
	4781	$D(^RCD(34 0,"AB","DP T(",RCDEBT DA)) D CHG ACCT(RCDEB TDA,RCLASD AT)
	4782	"RTN","RCB ECHGS",22, 0)
	4783	;S RCDEBT DA=0 F S RCDEBTDA=$ O(^RCD(340 ,"AB","DPT (",RCDEBTD A)) Q:'RCD EBTDA D
	4784	CHGACCT(RC DEBTDA,RCL ASDAT)
	4785	"RTN","RCB ECHGS",23, 0)
	4786	;
	4787	"RTN","RCB ECHGS",24, 0)
	4788	; clear the lock
	4789	"RTN","RCB ECHGS",25, 0)
	4790	L -^RCD(3 40,"RCBECH GS")
	4791	"RTN","RCB ECHGS",26, 0)
	4792	;
	4793	"RTN","RCB ECHGS",27, 0)
	4794	; genera te mailman report sh owing all charges ad ded
	4795	"RTN","RCB ECHGS",28, 0)
	4796	D REPORT^ RCBECHGU
	4797	"RTN","RCB ECHGS",29, 0)
	4798	;
	4799	"RTN","RCB ECHGS",30, 0)
	4800	K ^TMP("R CBECHGS RE PORT",$J)
	4801	"RTN","RCB ECHGS",31, 0)
	4802	Q
	4803	"RTN","RCB ECHGS",32, 0)
	4804	;
	4805	"RTN","RCB ECHGS",33, 0)
	4806	;
	4807	"RTN","RCB ECHGS",34, 0)
	4808	NONBENE ; add int/a dm/penalty charges t o all non- benefit de bts
	4809	"RTN","RCB ECHGS",35, 0)
	4810	; this i ncludes ve ndor, empl oyee, ex-e mployee.
	4811	"RTN","RCB ECHGS",36, 0)
	4812	; this i s called b y prcabj. it does n ot update first part y
	4813	"RTN","RCB ECHGS",37, 0)
	4814	; debts since they work off a set stat ement day where as
	4815	"RTN","RCB ECHGS",38, 0)
	4816	; non-be nefit debt s could be any state ment day.
	4817	"RTN","RCB ECHGS",39, 0)
	4818	;
	4819	"RTN","RCB ECHGS",40, 0)
	4820	N RCDEBTD A,RCLASDAT
	4821	"RTN","RCB ECHGS",41, 0)
	4822	K ^TMP("R CBECHGS RE PORT",$J) ;used to generate m ailman rep ort
	4823	"RTN","RCB ECHGS",42, 0)
	4824	;
	4825	"RTN","RCB ECHGS",43, 0)
	4826	; lock t he int/adm in update to prevent two jobs from apply ing
	4827	"RTN","RCB ECHGS",44, 0)
	4828	; the ch arges at t he same ti me
	4829	"RTN","RCB ECHGS",45, 0)
	4830	L +^RCD(3 40,"RCBECH GS")
	4831	"RTN","RCB ECHGS",46, 0)
	4832	;
	4833	"RTN","RCB ECHGS",47, 0)
	4834	; get th e last dat e the syst em was las t updated
	4835	"RTN","RCB ECHGS",48, 0)
	4836	S RCLASDA T=$P($P(^R C(342,1,0) ,"^",10)," .")
	4837	"RTN","RCB ECHGS",49, 0)
	4838	; loop a ll days fr om the las t update d ate up to today
	4839	"RTN","RCB ECHGS",50, 0)
	4840	; this w ill make s ure all ac counts are updated f or missed days
	4841	"RTN","RCB ECHGS",51, 0)
	4842	F S RCLA SDAT=$$FMA DD^XLFDT(R CLASDAT,1) Q:RCLASDA T>DT D
	4843	"RTN","RCB ECHGS",52, 0)
	4844	. S RCD EBTDA=0
	4845	"RTN","RCB ECHGS",53, 0)
	4846	. F S RCDEBTDA=$ O(^RCD(340 ,"AC",+$E( RCLASDAT,6 ,7),RCDEBT DA)) Q:'RC DEBTDA D
	4847	"RTN","RCB ECHGS",54, 0)
	4848	. . ; do not l ook at fir st party d ebts here
	4849	"RTN","RCB ECHGS",55, 0)
	4850	. . I $P($G(^RC D(340,RCDE BTDA,0))," ^")["DPT(" Q
	4851	"RTN","RCB ECHGS",56, 0)
	4852	. . ; add int/ admin to n on-benefit debts
	4853	"RTN","RCB ECHGS",57, 0)
	4854	. . D CHGACCT(R CDEBTDA,RC LASDAT)
	4855	"RTN","RCB ECHGS",58, 0)
	4856	;
	4857	"RTN","RCB ECHGS",59, 0)
	4858	; clear the lock
	4859	"RTN","RCB ECHGS",60, 0)
	4860	L -^RCD(3 40,"RCBECH GS")
	4861	"RTN","RCB ECHGS",61, 0)
	4862	;
	4863	"RTN","RCB ECHGS",62, 0)
	4864	; genera te mailman report sh owing all charges ad ded
	4865	"RTN","RCB ECHGS",63, 0)
	4866	D REPORT^ RCBECHGU
	4867	"RTN","RCB ECHGS",64, 0)
	4868	;
	4869	"RTN","RCB ECHGS",65, 0)
	4870	K ^TMP("R CBECHGS RE PORT",$J)
	4871	"RTN","RCB ECHGS",66, 0)
	4872	Q
	4873	"RTN","RCB ECHGS",67, 0)
	4874	;
	4875	"RTN","RCB ECHGS",68, 0)
	4876	;
	4877	"RTN","RCB ECHGS",69, 0)
	4878	CHGACCT(RC DEBTDA,RCU PDATE) ; get bills for debtor and add c harges
	4879	"RTN","RCB ECHGS",70, 0)
	4880	; for a given date in rcupda te
	4881	"RTN","RCB ECHGS",71, 0)
	4882	N
	4883	DAYSINT,DF N,FROMDATE ,RCBILLDA, RCDATA0,RC DATA6,RCDA TE,RCLASTD T,RCSTATUS ,VA,VADM,V AERR
	4884	,X
	4885	"RTN","RCB ECHGS",72, 0)
	4886	S RCDATA0 =$G(^RCD(3 40,RCDEBTD A,0))
	4887	"RTN","RCB ECHGS",73, 0)
	4888	; do not add charg es for ins urance com panies
	4889	"RTN","RCB ECHGS",74, 0)
	4890	I $P(RCDA TA0,"^")[" DIC(36" Q
	4891	"RTN","RCB ECHGS",75, 0)
	4892	; if fir st party a nd patient is dead, do not add charges
	4893	"RTN","RCB ECHGS",76, 0)
	4894	I $P(RCDA TA0,"^")[" DPT(" S DF N=+$P(RCDA TA0,"^") D DEM^VADPT I +VADM(6 ) Q ; DBI A#10061
	4895	"RTN","RCB ECHGS",77, 0)
	4896	;If Emerg ency Respo nse Indica tor flag i s set quit out, do n ot add cha rges.
	4897	"RTN","RCB ECHGS",78, 0)
	4898	I $P(RCDA TA0,"^")[" DPT(",$$EM ERES^PRCAU TL(+$P(RCD ATA0,"^")) ]"" Q
	4899	"RTN","RCB ECHGS",79, 0)
	4900	; lock t he debtor to show ch arges bein g applied
	4901	"RTN","RCB ECHGS",80, 0)
	4902	L +^RCD(3 40,RCDEBTD A)
	4903	"RTN","RCB ECHGS",81, 0)
	4904	;
	4905	"RTN","RCB ECHGS",82, 0)
	4906	; loop t hru all bi lls in act ive (16) a nd suspend ed (40) st atus
	4907	"RTN","RCB ECHGS",83, 0)
	4908	; build a list of bills sort ed by the date bill prepared
	4909	"RTN","RCB ECHGS",84, 0)
	4910	K ^TMP("R CBECHGS",$ J)
	4911	"RTN","RCB ECHGS",85, 0)
	4912	F RCSTATU S=16,40 D
	4913	"RTN","RCB ECHGS",86, 0)
	4914	. S RCB ILLDA=0 F S RCBILLD A=$O(^PRCA (430,"AS", RCDEBTDA,R CSTATUS,RC BILLDA)) Q :'RCBILLDA D
	4915	"RTN","RCB ECHGS",87, 0)
	4916	. . ; hold let ter date ( field 21) is set for bill
	4917	"RTN","RCB ECHGS",88, 0)
	4918	. . I $G(^PRCA( 430,RCBILL DA,1)) Q
	4919	"RTN","RCB ECHGS",89, 0)
	4920	. . ; no lette r1 sent
	4921	"RTN","RCB ECHGS",90, 0)
	4922	. . I '$G(^PRCA (430,RCBIL LDA,6)) Q
	4923	"RTN","RCB ECHGS",91, 0)
	4924	. . ; no princ ipal balan ce
	4925	"RTN","RCB ECHGS",92, 0)
	4926	. . I '$P($G(^P RCA(430,RC BILLDA,7)) ,"^") Q
	4927	"RTN","RCB ECHGS",93, 0)
	4928	. . ; no date bill prepa red
	4929	"RTN","RCB ECHGS",94, 0)
	4930	. . I '$P(^PRCA (430,RCBIL LDA,0),"^" ,10) Q
	4931	"RTN","RCB ECHGS",95, 0)
	4932	. . ; bill sen t to cross -servicing prca4. 5301
	4933	"RTN","RCB ECHGS",96, 0)
	4934	. . I $D(^PRCA( 430,"TCSP" ,RCBILLDA) ) Q
	4935	"RTN","RCB ECHGS",97, 0)
	4936	. . ; bill aut omatically recalled from cross -servicing prca4. 5301
	4937	"RTN","RCB ECHGS",98, 0)
	4938	. . I $P($G(^PR CA(430,RCB ILLDA,19)) ,"^",11) Q
	4939	"RTN","RCB ECHGS",99, 0)
	4940	. . ; store th e bills in date prep ared order
	4941	"RTN","RCB ECHGS",100 ,0)
	4942	. . S ^TMP("RCB ECHGS",$J, "LIST",$P( ^PRCA(430, RCBILLDA,0 ),"^",10), RCBILLDA)= ""
	4943	"RTN","RCB ECHGS",101 ,0)
	4944	;
	4945	"RTN","RCB ECHGS",102 ,0)
	4946	; * ca lculate in terest *
	4947	"RTN","RCB ECHGS",103 ,0)
	4948	D INTERES T^RCBECHGI
	4949	"RTN","RCB ECHGS",104 ,0)
	4950	;
	4951	"RTN","RCB ECHGS",105 ,0)
	4952	; * ca lculate ad min *
	4953	"RTN","RCB ECHGS",106 ,0)
	4954	D ADMIN^R CBECHGA
	4955	"RTN","RCB ECHGS",107 ,0)
	4956	;
	4957	"RTN","RCB ECHGS",108 ,0)
	4958	; * ca lculate pe nalty *
	4959	"RTN","RCB ECHGS",109 ,0)
	4960	; penalt y charges are not as sessed on a first pa rty accoun t
	4961	"RTN","RCB ECHGS",110 ,0)
	4962	I $P(RCDA TA0,"^")'[ "DPT(" D P ENALTY^RCB ECHGP
	4963	"RTN","RCB ECHGS",111 ,0)
	4964	;
	4965	"RTN","RCB ECHGS",112 ,0)
	4966	; * ad d charges to bills f or this ac count *
	4967	"RTN","RCB ECHGS",113 ,0)
	4968	D ADDCHAR G^RCBECHGU
	4969	"RTN","RCB ECHGS",114 ,0)
	4970	;
	4971	"RTN","RCB ECHGS",115 ,0)
	4972	; clear the lock o n the debt or
	4973	"RTN","RCB ECHGS",116 ,0)
	4974	L -^RCD(3 40,RCDEBTD A)
	4975	"RTN","RCB ECHGS",117 ,0)
	4976	;
	4977	"RTN","RCB ECHGS",118 ,0)
	4978	K ^TMP("R CBECHGS",$ J)
	4979	"RTN","RCB ECHGS",119 ,0)
	4980	Q
	4981	"RTN","RCC PCAP")
	4982	0^21^B5450 8064^n/a
	4983	"RTN","RCC PCAP",1,0)
	4984	RCCPCAP ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT B UILD ;2/3/ 2016 11:30 am
	4985	"RTN","RCC PCAP",2,0)
	4986	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 150
	4987	"RTN","RCC PCAP",3,0)
	4988	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4989	"RTN","RCC PCAP",4,0)
	4990	;DBIA#100 61
	4991	"RTN","RCC PCAP",5,0)
	4992	EN(YEAR,SO URCE,DTTIM E) ; Bui ld the pay ment state ments for Year enter ed
	4993	"RTN","RCC PCAP",6,0)
	4994	; Year is the first three num bers of th e Internal Date form at and mus t be earli er than cu rrent Year
	4995	"RTN","RCC PCAP",7,0)
	4996	; Source will be us ed to dete rmine whet her to sch edule or i mmediately start Tra nsmit afte r Build
	4997	"RTN","RCC PCAP",8,0)
	4998	; DTTIME is the Tra nsmit date and time in Interna l time fro m Build an d Transmit menu opti on
	4999	"RTN","RCC PCAP",9,0)
	5000	;
	5001	"RTN","RCC PCAP",10,0 )
	5002	; Initial ize Incomi ng Variabl es - YEAR will be to Year befo re Current
	5003	"RTN","RCC PCAP",11,0 )
	5004	; Source will be to "B"ackgro und, and D TTIME to i ts current value, in cluding NU LL
	5005	"RTN","RCC PCAP",12,0 )
	5006	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1
	5007	"RTN","RCC PCAP",13,0 )
	5008	I $G(SOUR CE)="" S S OURCE="B"
	5009	"RTN","RCC PCAP",14,0 )
	5010	S DTTIME= $G(DTTIME)
	5011	"RTN","RCC PCAP",15,0 )
	5012	;
	5013	"RTN","RCC PCAP",16,0 )
	5014	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5015	"RTN","RCC PCAP",17,0 )
	5016	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5017	"RTN","RCC PCAP",18,0 )
	5018	. S YEAR= 20_$E(YEAR ,2,3)
	5019	"RTN","RCC PCAP",19,0 )
	5020	. S ^TMP( $J,"MSG",1 ,0)="The B uild and T ransmit of the Annua l Payment File for " _YEAR_" ha s not
	5021	completed. "
	5022	"RTN","RCC PCAP",20,0 )
	5023	. D ERRMA IL^RCCPCAT
	5024	"RTN","RCC PCAP",21,0 )
	5025	;
	5026	"RTN","RCC PCAP",22,0 )
	5027	N %,%I,%H ,STARTDT,E NDDT,LINE, PSSEG,PSCN TR,EXIT,DE BTOR,END,N EXT,SIZE
	5028	"RTN","RCC PCAP",23,0 )
	5029	N WK,ARAD DR,ARFLAG, COUNTRY,ST ,DBN0,VAPA ; PRCA4. 5313/DM m ove addres s creation higher to
	5030	facilitate skipping a bad addr ess
	5031	"RTN","RCC PCAP",24,0 )
	5032	N DFN ; P RCA4.531 3/JG - Nee d DFN in t his sectio n of code for call t o VADPT.
	5033	"RTN","RCC PCAP",25,0 )
	5034	;
	5035	"RTN","RCC PCAP",26,0 )
	5036	; Remove previous e ntries fro m file pri or to buil ding new f ile
	5037	"RTN","RCC PCAP",27,0 )
	5038	K ^RCAP(3 49.5)
	5039	"RTN","RCC PCAP",28,0 )
	5040	S ^RCAP(3 49.5,0)="A R ANNUAL P AYMENT STA TEMENT^349 .5^^"
	5041	"RTN","RCC PCAP",29,0 )
	5042	;
	5043	"RTN","RCC PCAP",30,0 )
	5044	; Set Sta rt and End Dates
	5045	"RTN","RCC PCAP",31,0 )
	5046	S STARTDT =YEAR_"010 0"
	5047	"RTN","RCC PCAP",32,0 )
	5048	S ENDDT=Y EAR_1232
	5049	"RTN","RCC PCAP",33,0 )
	5050	S (DEBTOR ,END)=""
	5051	"RTN","RCC PCAP",34,0 )
	5052	F PSCNTR= 1:1 D Q:E ND ;
	5053	"RTN","RCC PCAP",35,0 )
	5054	. S (NEXT ,SIZE,LINE )=0
	5055	"RTN","RCC PCAP",36,0 )
	5056	. D SETPS (PSCNTR,YE AR)
	5057	"RTN","RCC PCAP",37,0 )
	5058	. N LASTP D
	5059	"RTN","RCC PCAP",38,0 )
	5060	. F S DE BTOR=$O(^P RCA(433,"A TD",DEBTOR )) Q:DEBTO R="" D I NEXT Q ; ASF,12/31/ 18,PRCA4. 5313
	5061	"RTN","RCC PCAP",39,0 )
	5062	.. N SSN
	5063	"RTN","RCC PCAP",40,0 )
	5064	.. ; Quit if the de btor is no t a patien t
	5065	"RTN","RCC PCAP",41,0 )
	5066	.. I '$D( ^RCD(340," AB","DPT(" ,DEBTOR)) Q
	5067	"RTN","RCC PCAP",42,0 )
	5068	.. ; Quit if a test patient S SN contain s a "P" or is Null
	5069	"RTN","RCC PCAP",43,0 )
	5070	.. S SSN= $$SSN^RCFN 01(DEBTOR)
	5071	"RTN","RCC PCAP",44,0 )
	5072	.. I SSN[ "P"!(SSN=- 1) Q
	5073	"RTN","RCC PCAP",45,0 )
	5074	.. ; Get Address an d ARFLAG P RCA4.531 3/DM
	5075	"RTN","RCC PCAP",46,0 )
	5076	.. S ARFL AG="N",DBN 0=$P($G(^R CD(340,DEB TOR,0)),"^ ",1)
	5077	"RTN","RCC PCAP",47,0 )
	5078	.. I $P($ G(^RCD(340 ,DEBTOR,1) ),U,9) Q ; address is marked as ADDRESS UNKNOWN
	5079	"RTN","RCC PCAP",48,0 )
	5080	.. S DFN= +$P($G(^RC D(340,DEBT OR,0)),U) ; PRCA4.5 313/JG - Get DFN fo r call to VADPT
	5081	"RTN","RCC PCAP",49,0 )
	5082	.. S ARAD DR=$$PAT^R CAMADD(+DB N0,1) ; confiden tial
	5083	"RTN","RCC PCAP",50,0 )
	5084	.. I ARAD DR="" D
	5085	"RTN","RCC PCAP",51,0 )
	5086	... S ARA DDR=$P($G( ^RCD(340,D EBTOR,1)), U,1,8)
	5087	"RTN","RCC PCAP",52,0 )
	5088	... I $$C HKDEB^RCCP CML1(ARADD R) S ARFLA G="Y"
	5089	"RTN","RCC PCAP",53,0 )
	5090	... S ARA DDR=$$DADD ^RCAMADD(D EBTOR,0)
	5091	"RTN","RCC PCAP",54,0 )
	5092	.. ;
	5093	"RTN","RCC PCAP",55,0 )
	5094	.. S ARAD DR=$$TRIMD EB^RCCPCML 1(ARADDR)
	5095	"RTN","RCC PCAP",56,0 )
	5096	.. F WK=1 :1:4 S $P( ARADDR,U,W K)=$E($P(A RADDR,U,WK ),1,40)
	5097	"RTN","RCC PCAP",57,0 )
	5098	.. ; figu re out COU NTRY first
	5099	"RTN","RCC PCAP",58,0 )
	5100	.. S COUN TRY="",ST= $P(ARADDR, U,5)
	5101	"RTN","RCC PCAP",59,0 )
	5102	.. I ARFL AG="Y",ST' ="" D
	5103	"RTN","RCC PCAP",60,0 )
	5104	... S WK= $O(^DIC(5, "C",ST,0))
	5105	"RTN","RCC PCAP",61,0 )
	5106	... I (WK >90),'$P($ G(^DIC(5,W K,0)),U,6) S ST="FX" ,COUNTRY=$ P($G(^DIC( 5,WK,0)),U ,1)
	5107	"RTN","RCC PCAP",62,0 )
	5108	.. I ARFL AG="N" D
	5109	"RTN","RCC PCAP",63,0 )
	5110	... K VAP A D ADD^VA DPT ; DBIA #10061
	5111	"RTN","RCC PCAP",64,0 )
	5112	... I +VA PA(25)>2 S ST="FX",C OUNTRY=$P( VAPA(25),U ,2)
	5113	"RTN","RCC PCAP",65,0 )
	5114	.. ;
	5115	"RTN","RCC PCAP",66,0 )
	5116	.. S $P(A RADDR,U,5) =$E(ST,1,2 )
	5117	"RTN","RCC PCAP",67,0 )
	5118	.. S $P(A RADDR,U,6) =$S(COUNTR Y="":$E($P (ARADDR,U, 6),1,9),1: "")
	5119	"RTN","RCC PCAP",68,0 )
	5120	.. ; for APPS, we w ant to dro p telephon e number
	5121	"RTN","RCC PCAP",69,0 )
	5122	.. S ARAD DR=$P(ARAD DR,U,1,6)
	5123	"RTN","RCC PCAP",70,0 )
	5124	.. S $P(A RADDR,U,7) =COUNTRY
	5125	"RTN","RCC PCAP",71,0 )
	5126	.. ; skip an invali d address
	5127	"RTN","RCC PCAP",72,0 )
	5128	.. I ($P( ARADDR,U,1 )="")!($P( ARADDR,U,4 )="")!(ST= "")!(($P(A RADDR,U,6) ="")&(ST'= "FX")) Q
	5129	"RTN","RCC PCAP",73,0 )
	5130	.. ;
	5131	"RTN","RCC PCAP",74,0 )
	5132	.. N PHSE T,PHCNTR,P HSEG,DATE, LTBDT
	5133	"RTN","RCC PCAP",75,0 )
	5134	.. S (PHS ET,PHCNTR, LTBDT)=0
	5135	"RTN","RCC PCAP",76,0 )
	5136	.. S DATE =STARTDT
	5137	"RTN","RCC PCAP",77,0 )
	5138	.. F S D ATE=$O(^PR CA(433,"AT D",DEBTOR, DATE)) Q:D ATE="" Q: DATE>ENDDT D
	5139	"RTN","RCC PCAP",78,0 )
	5140	... ; Rec heck and Q uit if the date is n ot within the Year
	5141	"RTN","RCC PCAP",79,0 )
	5142	... I DAT E<STARTDT! (DATE>ENDD T) Q
	5143	"RTN","RCC PCAP",80,0 )
	5144	... ; Set Final Dat e for this Debtor to determine final tra nsaction
	5145	"RTN","RCC PCAP",81,0 )
	5146	... N TRA NS
	5147	"RTN","RCC PCAP",82,0 )
	5148	... S TRA NS=""
	5149	"RTN","RCC PCAP",83,0 )
	5150	... F S TRANS=$O(^ PRCA(433," ATD",DEBTO R,DATE,TRA NS)) Q:TRA NS="" D
	5151	"RTN","RCC PCAP",84,0 )
	5152	.... ; Qu it if the Transactio n Type is not Paymen t in Part( 2) or Paym ent in Ful l(34)
	5153	"RTN","RCC PCAP",85,0 )
	5154	.... I $P (^PRCA(433 ,TRANS,1), U,2)'=2&($ P(^PRCA(43 3,TRANS,1) ,U,2)'=34) Q
	5155	"RTN","RCC PCAP",86,0 )
	5156	.... ; Se t PH Recor d if first time for this Debto r
	5157	"RTN","RCC PCAP",87,0 )
	5158	.... ; PR CA4.5313 - DFN alr eady calcu lated. Se nding to S ETPH.
	5159	"RTN","RCC PCAP",88,0 )
	5160	.... I 'P HSET D SET PH(DEBTOR, DFN,SSN,PS CNTR,ARADD R,ARFLAG) S PHSET=1
	5161	"RTN","RCC PCAP",89,0 )
	5162	.... ; Se t PD Recor d for each Payment T ransaction
	5163	"RTN","RCC PCAP",90,0 )
	5164	.... D SE TPD(DEBTOR ,DATE,TRAN S,PSCNTR)
	5165	"RTN","RCC PCAP",91,0 )
	5166	.. ;
	5167	"RTN","RCC PCAP",92,0 )
	5168	.. ; Afte r completi ng each De btor, if t he Size is over 25K, set Next to create a new PS R ecord,
	5169	"RTN","RCC PCAP",93,0 )
	5170	.. ; set Message De limiter at the end o f the PD r ecord, and set End D ate and Ti me
	5171	"RTN","RCC PCAP",94,0 )
	5172	.. I SIZE >25000 D
	5173	"RTN","RCC PCAP",95,0 )
	5174	... S ^RC AP(349.5,P SCNTR,1,LA STPD,0)=^R CAP(349.5, PSCNTR,1,L ASTPD,0)_" ~"
	5175	"RTN","RCC PCAP",96,0 )
	5176	... S NEX T=1
	5177	"RTN","RCC PCAP",97,0 )
	5178	... D NOW ^%DTC
	5179	"RTN","RCC PCAP",98,0 )
	5180	... S $P( ^RCAP(349. 5,PSCNTR,0 ),U,4)=%
	5181	"RTN","RCC PCAP",99,0 )
	5182	.. ;
	5183	"RTN","RCC PCAP",100, 0)
	5184	.. ; If t he last De btor in AT D has proc essed set End to sto p processi ng, if Til de not fin al
	5185	"RTN","RCC PCAP",101, 0)
	5186	.. ; char acter, set Tilde to Last PD re cord, and set End Da te and tim e
	5187	"RTN","RCC PCAP",102, 0)
	5188	. I DEBTO R="" D
	5189	"RTN","RCC PCAP",103, 0)
	5190	.. S END= 1
	5191	"RTN","RCC PCAP",104, 0)
	5192	.. I $G(L ASTPD)="" Q
	5193	"RTN","RCC PCAP",105, 0)
	5194	.. I $E(^ RCAP(349.5 ,PSCNTR,1, LASTPD,0), $L(^RCAP(3 49.5,PSCNT R,1,LASTPD ,0)))'="~" S
	5195	^RCAP(349. 5,PSCNTR,1 ,LASTPD,0) =^RCAP(349 .5,PSCNTR, 1,LASTPD,0 )_"~"
	5196	"RTN","RCC PCAP",106, 0)
	5197	.. D NOW^ %DTC
	5198	"RTN","RCC PCAP",107, 0)
	5199	.. S $P(^ RCAP(349.5 ,PSCNTR,0) ,U,4)=%
	5200	"RTN","RCC PCAP",108, 0)
	5201	;
	5202	"RTN","RCC PCAP",109, 0)
	5203	; PRCA4. 5313 - Un lock prior to transm ission
	5204	"RTN","RCC PCAP",110, 0)
	5205	L -^RCAP( 349.5):DIL OCKTM
	5206	"RTN","RCC PCAP",111, 0)
	5207	;
	5208	"RTN","RCC PCAP",112, 0)
	5209	; If the Source is Background (B) deter mine the d ate and ti me from th e schedule based upo n site cod e
	5210	"RTN","RCC PCAP",113, 0)
	5211	I SOURCE= "B" S DTTI ME=$$SCHED ^RCCPCAT($ $SITE^RCMS ITE)
	5212	"RTN","RCC PCAP",114, 0)
	5213	D EN^RCCP CAT(DTTIME )
	5214	"RTN","RCC PCAP",115, 0)
	5215	;
	5216	"RTN","RCC PCAP",116, 0)
	5217	Q
	5218	"RTN","RCC PCAP",117, 0)
	5219	;
	5220	"RTN","RCC PCAP",118, 0)
	5221	SETPS(PSCN TR,YEAR) ; Get and Set Data f or PS Reco rd into 34 9.5
	5222	"RTN","RCC PCAP",119, 0)
	5223	; Set Yea r and Buil d Start Da te and Tim e
	5224	"RTN","RCC PCAP",120, 0)
	5225	N PS,DR,D A,DIE,DIC, X,PRCAFDA
	5226	"RTN","RCC PCAP",121, 0)
	5227	S DIC="^R CAP(349.5, ",X=PSCNTR ,DA=.01,DI C(0)="" D FILE^DICN
	5228	"RTN","RCC PCAP",122, 0)
	5229	D NOW^%DT C
	5230	"RTN","RCC PCAP",123, 0)
	5231	S $P(^RCA P(349.5,PS CNTR,0),U, 2,3)=YEAR_ U_%
	5232	"RTN","RCC PCAP",124, 0)
	5233	; Increme nt Line nu mber
	5234	"RTN","RCC PCAP",125, 0)
	5235	S LINE=LI NE+1
	5236	"RTN","RCC PCAP",126, 0)
	5237	; Set PSS EG for thi s Segment to PS Coun ter
	5238	"RTN","RCC PCAP",127, 0)
	5239	S PSSEG(P SCNTR)=PSC NTR
	5240	"RTN","RCC PCAP",128, 0)
	5241	; Pieces 3 and 6 wi ll be upda ted during the creat ion of oth er PS and PH segment s
	5242	"RTN","RCC PCAP",129, 0)
	5243	S
	5244	PS="PS"_U_ PSCNTR_U_P SCNTR_U_$$ SITE^RCMSI TE_U_$$FP^ RCCPCFN_U_ 0_U_20_$E( YEAR,2,3)_ U_$$
	5245	DAT^RCCPCF N(DT)_U_"} "
	5246	"RTN","RCC PCAP",130, 0)
	5247	; Update File
	5248	"RTN","RCC PCAP",131, 0)
	5249	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P S
	5250	"RTN","RCC PCAP",132, 0)
	5251	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5252	"RTN","RCC PCAP",133, 0)
	5253	; Add len gth to SIZ E
	5254	"RTN","RCC PCAP",134, 0)
	5255	S SIZE=SI ZE+$L(PS)
	5256	"RTN","RCC PCAP",135, 0)
	5257	; Update all previo us PS Segm ents piece 3 with cu rrent coun ter
	5258	"RTN","RCC PCAP",136, 0)
	5259	N I
	5260	"RTN","RCC PCAP",137, 0)
	5261	S I=0
	5262	"RTN","RCC PCAP",138, 0)
	5263	F S I=$O (PSSEG(I)) Q:I=PSCNT R S $P(^R CAP(349.5, I,1,1,0),U ,3)=PSCNTR
	5264	"RTN","RCC PCAP",139, 0)
	5265	;
	5266	"RTN","RCC PCAP",140, 0)
	5267	Q
	5268	"RTN","RCC PCAP",141, 0)
	5269	;
	5270	"RTN","RCC PCAP",142, 0)
	5271	; PRCA4. 5313 - Se nding DFN into SETPH . Already set above .
	5272	"RTN","RCC PCAP",143, 0)
	5273	SETPH(DEBT OR,DFN,SSN ,PSCNTR,AR ADDR,ARFLA G) ; Get and Set Da ta for PH Record int o 349.5
	5274	"RTN","RCC PCAP",144, 0)
	5275	N PH,SITE ,PATNAME,I CN,DR,DA,D IE,PRCAFDA ; PRCA4. 5313 - El iminating newing of DFN. Sent in.
	5276	"RTN","RCC PCAP",145, 0)
	5277	; Increme nt Line nu mber
	5278	"RTN","RCC PCAP",146, 0)
	5279	S LINE=LI NE+1
	5280	"RTN","RCC PCAP",147, 0)
	5281	; Increme nt PH Coun ter
	5282	"RTN","RCC PCAP",148, 0)
	5283	S PHCNTR= PHCNTR+1
	5284	"RTN","RCC PCAP",149, 0)
	5285	; Set PHS EG for thi s Segment to Line
	5286	"RTN","RCC PCAP",150, 0)
	5287	S PHSEG(P HCNTR)=LIN E
	5288	"RTN","RCC PCAP",151, 0)
	5289	; PRCA4. 5313/JG - DFN is fo r Debtor a nd get ICN for Patie nt
	5290	"RTN","RCC PCAP",152, 0)
	5291	; - If the IC N returns a -1 in th e first pi ece
	5292	"RTN","RCC PCAP",153, 0)
	5293	; send a Null value as the IC N
	5294	"RTN","RCC PCAP",154, 0)
	5295	; PRCA4. 5313/JG - Eliminati ng set of DFN. Sent in from a bove.
	5296	"RTN","RCC PCAP",155, 0)
	5297	S ICN=$$G ETICN^MPIF 001(DFN)
	5298	"RTN","RCC PCAP",156, 0)
	5299	S ICN=$S( +ICN'=-1:I CN,1:"")
	5300	"RTN","RCC PCAP",157, 0)
	5301	; Get Acc ount Numbe r -- Sit e code and SSN
	5302	"RTN","RCC PCAP",158, 0)
	5303	S SITE=$$ SITE^RCMSI TE
	5304	"RTN","RCC PCAP",159, 0)
	5305	S PH="PH" _U_SITE_SS N
	5306	"RTN","RCC PCAP",160, 0)
	5307	; Get Pat ient Name
	5308	"RTN","RCC PCAP",161, 0)
	5309	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5310	"RTN","RCC PCAP",162, 0)
	5311	S PH=PH_$ E($P(PATNA ME,","),1, 5)_U_$E($P (PATNAME," ,"),1,20)_ U_$E($P($P (PATNAME," ,",2),"
	5312	"),1,10)_U _$E($P(PAT NAME," ",2 ),1,10)
	5313	"RTN","RCC PCAP",163, 0)
	5314	;
	5315	"RTN","RCC PCAP",164, 0)
	5316	S PH=PH_U _ARADDR
	5317	"RTN","RCC PCAP",165, 0)
	5318	; Set DFN and ICN f or Debtor and Patien t with Nul l space fo r Total Am ount Recei ved
	5319	"RTN","RCC PCAP",166, 0)
	5320	S PH=PH_U _U_SITE_$$ RJ^XLFSTR( $TR(DFN,". ",""),13,0 )_U_ICN
	5321	"RTN","RCC PCAP",167, 0)
	5322	S PH=PH_U _ARFLAG
	5323	"RTN","RCC PCAP",168, 0)
	5324	; Set Nul l spaces f or Last Bi ll Prepare d Date for Debtor an d Number o f PD Segme nts
	5325	"RTN","RCC PCAP",169, 0)
	5326	; and the n Record D elimiter
	5327	"RTN","RCC PCAP",170, 0)
	5328	S PH=PH_U _U_U_"}"
	5329	"RTN","RCC PCAP",171, 0)
	5330	; Update file
	5331	"RTN","RCC PCAP",172, 0)
	5332	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P H
	5333	"RTN","RCC PCAP",173, 0)
	5334	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5335	"RTN","RCC PCAP",174, 0)
	5336	; Add len gth to SIZ E
	5337	"RTN","RCC PCAP",175, 0)
	5338	S SIZE=SI ZE+$L(PH)
	5339	"RTN","RCC PCAP",176, 0)
	5340	; Increme nt PS segm ent piece 6 with ano ther PH re cord
	5341	"RTN","RCC PCAP",177, 0)
	5342	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,1,0),U ,6)=$P(^RC AP(349.5,P SSEG(PSCNT R),1,1,0), U,6)+1
	5343	"RTN","RCC PCAP",178, 0)
	5344	Q
	5345	"RTN","RCC PCAP",179, 0)
	5346	;
	5347	"RTN","RCC PCAP",180, 0)
	5348	SETPD(DEBT OR,DATE,TR ANS,PSCNTR ) ; Get a nd Set Dat a for PD R ecord into 349.5
	5349	"RTN","RCC PCAP",181, 0)
	5350	N DR,DA,D IE,PD,AMT, PHTOT,BILL ,CURBDT,PR CAFDA
	5351	"RTN","RCC PCAP",182, 0)
	5352	; Get Tra nsaction A mount - Qu it if Amou nt is zero or null
	5353	"RTN","RCC PCAP",183, 0)
	5354	S AMT=$P( $G(^PRCA(4 33,TRANS,1 )),U,5)
	5355	"RTN","RCC PCAP",184, 0)
	5356	I 'AMT Q
	5357	"RTN","RCC PCAP",185, 0)
	5358	; Format Amount
	5359	"RTN","RCC PCAP",186, 0)
	5360	S AMT=$TR ($J(AMT,9, 2)," ","")
	5361	"RTN","RCC PCAP",187, 0)
	5362	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5363	"RTN","RCC PCAP",188, 0)
	5364	;
	5365	"RTN","RCC PCAP",189, 0)
	5366	S LINE=LI NE+1
	5367	"RTN","RCC PCAP",190, 0)
	5368	S LASTPD= LINE
	5369	"RTN","RCC PCAP",191, 0)
	5370	; Format and Set Da te Entered , Amount, and Delimi ter
	5371	"RTN","RCC PCAP",192, 0)
	5372	S PD="PD" _U_$$DAT^R CCPCFN(DAT E)_U_AMT_U _"}"
	5373	"RTN","RCC PCAP",193, 0)
	5374	;
	5375	"RTN","RCC PCAP",194, 0)
	5376	; Add len gth to SIZ E
	5377	"RTN","RCC PCAP",195, 0)
	5378	S SIZE=SI ZE+$L(PD)
	5379	"RTN","RCC PCAP",196, 0)
	5380	;
	5381	"RTN","RCC PCAP",197, 0)
	5382	; Update file
	5383	"RTN","RCC PCAP",198, 0)
	5384	S PRCAFDA (349.51,"+ "_(LINE)_" ,"_PSCNTR_ ",",.01)=P D
	5385	"RTN","RCC PCAP",199, 0)
	5386	D UPDATE^ DIE("","PR CAFDA","LI NE")
	5387	"RTN","RCC PCAP",200, 0)
	5388	;
	5389	"RTN","RCC PCAP",201, 0)
	5390	; Get cur rent PH To tal, add A mount, the n reset to PH Segmen t
	5391	"RTN","RCC PCAP",202, 0)
	5392	S PHTOT=$ P(^RCAP(34 9.5,PSSEG( PSCNTR),1, PHSEG(PHCN TR),0),U,1 3)
	5393	"RTN","RCC PCAP",203, 0)
	5394	S PHTOT=P HTOT+AMT
	5395	"RTN","RCC PCAP",204, 0)
	5396	S $P(^RCA P(349.5,PS SEG(PSCNTR ),1,PHSEG( PHCNTR),0) ,U,13)=PHT OT
	5397	"RTN","RCC PCAP",205, 0)
	5398	;
	5399	"RTN","RCC PCAP",206, 0)
	5400	; Determi ne the Cur rent Bill Date and i f greater than LTBDT , Latest B ill Date,
	5401	"RTN","RCC PCAP",207, 0)
	5402	; set to PH Segment and LTBDT
	5403	"RTN","RCC PCAP",208, 0)
	5404	S BILL=$P ($G(^PRCA( 433,TRANS, 0)),U,2)
	5405	"RTN","RCC PCAP",209, 0)
	5406	S CURBDT= $P($G(^PRC A(430,BILL ,0)),U,10)
	5407	"RTN","RCC PCAP",210, 0)
	5408	I CURBDT> LTBDT S
	5409	$P(^RCAP(3 49.5,PSSEG (PSCNTR),1 ,PHSEG(PHC NTR),0),U, 17)=$$DAT^ RCCPCFN(CU RBDT),LTBD T=CURBDT
	5410	"RTN","RCC PCAP",211, 0)
	5411	;
	5412	"RTN","RCC PCAP",212, 0)
	5413	; Increme nt PH segm ent piece 18 with an other PD r ecord
	5414	"RTN","RCC PCAP",213, 0)
	5415	S
	5416	$P(^RCAP(3 49.5,PSSEG (PSCNTR),1 ,PHSEG(PHC NTR),0),U, 18)=$P(^RC AP(349.5,P SSEG(PSCNT R),1,PHSEG (
	5417	PHCNTR),0) ,U,18)+1
	5418	"RTN","RCC PCAP",214, 0)
	5419	Q
	5420	"RTN","RCC PCAR")
	5421	0^23^B5137 6653^n/a
	5422	"RTN","RCC PCAR",1,0)
	5423	RCCPCAR ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT R EPORT ;2/3 /2016 11:3 0 am
	5424	"RTN","RCC PCAR",2,0)
	5425	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 150
	5426	"RTN","RCC PCAR",3,0)
	5427	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5428	"RTN","RCC PCAR",4,0)
	5429	;DBIA#101 13
	5430	"RTN","RCC PCAR",5,0)
	5431	;DBIA#101 11
	5432	"RTN","RCC PCAR",6,0)
	5433	;DBIA#100 61
	5434	"RTN","RCC PCAR",7,0)
	5435	EN(YEAR) ; Report errors for the payme nt stateme nts for Ye ar entered
	5436	"RTN","RCC PCAR",8,0)
	5437	; Year is the first three num bers of th e Internal Date form at
	5438	"RTN","RCC PCAR",9,0)
	5439	;
	5440	"RTN","RCC PCAR",10,0 )
	5441	K ^XTMP(" RCCPCAR",$ J)
	5442	"RTN","RCC PCAR",11,0 )
	5443	S ^XTMP(" RCCPCAR",0 )=DT_U_DT
	5444	"RTN","RCC PCAR",12,0 )
	5445	S ^XTMP(" RCCPCAR IS RUNNING", 0)=DT_U_DT
	5446	"RTN","RCC PCAR",13,0 )
	5447	S ^XTMP(" RCCPCAR IS RUNNING", $J)=1
	5448	"RTN","RCC PCAR",14,0 )
	5449	N STARTDT ,ENDDT,LIN E,DEBTOR,P ATSSN
	5450	"RTN","RCC PCAR",15,0 )
	5451	;
	5452	"RTN","RCC PCAR",16,0 )
	5453	; Initial ize YEAR t o current year if Nu ll
	5454	"RTN","RCC PCAR",17,0 )
	5455	I $G(YEAR )="" S YEA R=$E(DT,1, 3)
	5456	"RTN","RCC PCAR",18,0 )
	5457	;
	5458	"RTN","RCC PCAR",19,0 )
	5459	; Set Sta rt and End Dates
	5460	"RTN","RCC PCAR",20,0 )
	5461	S STARTDT =YEAR_"010 0"
	5462	"RTN","RCC PCAR",21,0 )
	5463	S ENDDT=Y EAR_1232
	5464	"RTN","RCC PCAR",22,0 )
	5465	S LINE=0
	5466	"RTN","RCC PCAR",23,0 )
	5467	S DEBTOR= ""
	5468	"RTN","RCC PCAR",24,0 )
	5469	F S DEBT OR=$O(^PRC A(433,"ATD ",DEBTOR)) Q:DEBTOR= "" D
	5470	"RTN","RCC PCAR",25,0 )
	5471	. ; Quit if the deb tor is not a patient
	5472	"RTN","RCC PCAR",26,0 )
	5473	. I '$D(^ RCD(340,"A B","DPT(", DEBTOR)) Q
	5474	"RTN","RCC PCAR",27,0 )
	5475	. N DATE, PATERROR,P HSET
	5476	"RTN","RCC PCAR",28,0 )
	5477	. S (PHSE T,PATERROR )=0
	5478	"RTN","RCC PCAR",29,0 )
	5479	. S DATE= STARTDT
	5480	"RTN","RCC PCAR",30,0 )
	5481	. F S DA TE=$O(^PRC A(433,"ATD ",DEBTOR,D ATE)) Q:DA TE="" Q:D ATE>ENDDT D
	5482	"RTN","RCC PCAR",31,0 )
	5483	.. ; Rech eck and Qu it if the date is no t within t he Year
	5484	"RTN","RCC PCAR",32,0 )
	5485	.. I DATE <STARTDT!( DATE>ENDDT ) Q
	5486	"RTN","RCC PCAR",33,0 )
	5487	.. ; Set Final Date for this Debtor to determine final tran saction
	5488	"RTN","RCC PCAR",34,0 )
	5489	.. N TRAN S
	5490	"RTN","RCC PCAR",35,0 )
	5491	.. S TRAN S=""
	5492	"RTN","RCC PCAR",36,0 )
	5493	.. F S T RANS=$O(^P RCA(433,"A TD",DEBTOR ,DATE,TRAN S)) Q:TRAN S="" D
	5494	"RTN","RCC PCAR",37,0 )
	5495	... ; Qui t if the T ransaction Type is n ot Payment in Part(2 ) or Payme nt in Full (34)
	5496	"RTN","RCC PCAR",38,0 )
	5497	... I $P( ^PRCA(433, TRANS,1),U ,2)'=2&($P (^PRCA(433 ,TRANS,1), U,2)'=34) Q
	5498	"RTN","RCC PCAR",39,0 )
	5499	... ; Che ck PH Reco rd if firs t time for this Debt or
	5500	"RTN","RCC PCAR",40,0 )
	5501	... I 'PH SET D CHEC KPH(DEBTOR ) S PHSET= 1
	5502	"RTN","RCC PCAR",41,0 )
	5503	... ; Che ck PD Reco rd for eac h Payment Transactio n
	5504	"RTN","RCC PCAR",42,0 )
	5505	... D CHE CKPD(DEBTO R,DATE,TRA NS)
	5506	"RTN","RCC PCAR",43,0 )
	5507	;
	5508	"RTN","RCC PCAR",44,0 )
	5509	; If ther e are any errors Sen d MailMan Message wi th Errors in ^XTMP(" RCCPCAR",$ J,"MSG")
	5510	"RTN","RCC PCAR",45,0 )
	5511	I $D(^XTM P("RCCPCAR ",$J,"MSG" )) D TRANS MIT ;ASF,1 2/19/18,PR CA4.5313
	5512	"RTN","RCC PCAR",46,0 )
	5513	I '$D(^XT MP("RCCPCA R",$J,"MSG ")) D
	5514	"RTN","RCC PCAR",47,0 )
	5515	. S ^XTMP ("RCCPCAR" ,$J,"MSG", 1,0)="No a nnual pati ent paymen t data inc onsistenci es found."
	5516	"RTN","RCC PCAR",48,0 )
	5517	. D TRANS MIT
	5518	"RTN","RCC PCAR",49,0 )
	5519	;
	5520	"RTN","RCC PCAR",50,0 )
	5521	; reset x tmp
	5522	"RTN","RCC PCAR",51,0 )
	5523	K ^XTMP(" RCCPCAR",$ J)
	5524	"RTN","RCC PCAR",52,0 )
	5525	K ^XTMP(" RCCPCAR IS RUNNING", $J)
	5526	"RTN","RCC PCAR",53,0 )
	5527	Q
	5528	"RTN","RCC PCAR",54,0 )
	5529	;
	5530	"RTN","RCC PCAR",55,0 )
	5531	CHECKPH(DE BTOR) ; C heck Data for PH Rec ord
	5532	"RTN","RCC PCAR",56,0 )
	5533	N SSN,PAT NAME,I,ARA DDR,ADDRER ,DFN,ICN,C OUNTRY,ST, ARFLAG,DBN 0,VAPA
	5534	"RTN","RCC PCAR",57,0 )
	5535	;
	5536	"RTN","RCC PCAR",58,0 )
	5537	; Get and Check DFN for Debto r. If DFN is Null o r does not start wit h a number
	5538	"RTN","RCC PCAR",59,0 )
	5539	; write E rror with Debtor Num ber and th en Quit, a s other da ta is depe ndent upon DFN
	5540	"RTN","RCC PCAR",60,0 )
	5541	S DFN=+$P (^RCD(340, DEBTOR,0), U)
	5542	"RTN","RCC PCAR",61,0 )
	5543	I 'DFN D SETERROR(" Debtor Num ber: "_DEB TOR,"Missi ng DFN") Q
	5544	"RTN","RCC PCAR",62,0 )
	5545	;
	5546	"RTN","RCC PCAR",63,0 )
	5547	; Get Pat ient Name and SSN
	5548	"RTN","RCC PCAR",64,0 )
	5549	S PATNAME =$$NAM^RCF N01(DEBTOR )
	5550	"RTN","RCC PCAR",65,0 )
	5551	S SSN=$$S SN^RCFN01( DEBTOR)
	5552	"RTN","RCC PCAR",66,0 )
	5553	S PATSSN= PATNAME_" LAST-4: " _$E(SSN,6, 9)
	5554	"RTN","RCC PCAR",67,0 )
	5555	;
	5556	"RTN","RCC PCAR",68,0 )
	5557	; Get and Check DFN and ICN f or Debtor and Patien t
	5558	"RTN","RCC PCAR",69,0 )
	5559	I $L(DFN) >16 D SETE RROR(PATSS N,"Warning : DFN("_DF N_") is lo nger than 16 positio ns")
	5560	;ASF,12/19 /18,PRCA4 .5313
	5561	"RTN","RCC PCAR",70,0 )
	5562	S ICN=$$G ETICN^MPIF 001(DFN)
	5563	"RTN","RCC PCAR",71,0 )
	5564	I +ICN=-1 !($L(ICN)> 17) D SETE RROR(PATSS N,"Missing or Invali d ICN")
	5565	"RTN","RCC PCAR",72,0 )
	5566	;
	5567	"RTN","RCC PCAR",73,0 )
	5568	; Check P atient Nam e and SSN
	5569	"RTN","RCC PCAR",74,0 )
	5570	I SSN=""! (SSN'?9N) D SETERROR (PATSSN,"M issing or Invalid SS N")
	5571	"RTN","RCC PCAR",75,0 )
	5572	I $P(PATN AME,",")=" " D SETERR OR(PATSSN, "Missing o r Invalid Last Name" )
	5573	"RTN","RCC PCAR",76,0 )
	5574	I $P($P(P ATNAME,"," ,2)," ")=" " D SETERR OR(PATSSN, "Missing o r Invalid First Name ")
	5575	"RTN","RCC PCAR",77,0 )
	5576	;
	5577	"RTN","RCC PCAR",78,0 )
	5578	; Get and Check Add ress ;PRCA 4.5313/D M
	5579	"RTN","RCC PCAR",79,0 )
	5580	S ARADDR= "",ARFLAG= "N",DBN0=$ P($G(^RCD( 340,DEBTOR ,0)),"^",1 )
	5581	"RTN","RCC PCAR",80,0 )
	5582	I DBN0["D PT(" S ARA DDR=$$PAT^ RCAMADD(+D BN0,1) ; c onfidentia l
	5583	"RTN","RCC PCAR",81,0 )
	5584	I ARADDR= "" D
	5585	"RTN","RCC PCAR",82,0 )
	5586	. S ARADD R=$P($G(^R CD(340,DEB TOR,1)),U, 1,8)
	5587	"RTN","RCC PCAR",83,0 )
	5588	. I $$CHK DEB^RCCPCM L1(ARADDR) S ARFLAG= "Y"
	5589	"RTN","RCC PCAR",84,0 )
	5590	. S ARADD R=$$DADD^R CAMADD(DEB TOR,0)
	5591	"RTN","RCC PCAR",85,0 )
	5592	;
	5593	"RTN","RCC PCAR",86,0 )
	5594	I $P($G(^ RCD(340,DE BTOR,1)),U ,9) D SETE RROR(PATSS N,"Address is marked as ADDRES S UNKNOWN" )
	5595	"RTN","RCC PCAR",87,0 )
	5596	;
	5597	"RTN","RCC PCAR",88,0 )
	5598	S ARADDR= $$TRIMDEB^ RCCPCML1(A RADDR)
	5599	"RTN","RCC PCAR",89,0 )
	5600	F I=1,4 I $P(ARADDR ,U,I)=""!( $L($P(ARAD DR,U,I))>4 0!('$L($TR ($P(ARADDR ,U,I)," ", "")))) D
	5601	"RTN","RCC PCAR",90,0 )
	5602	. S ADDRE R(I)=$S(I= 1:"Address Line 1",I =4:"City")
	5603	"RTN","RCC PCAR",91,0 )
	5604	. D SETER ROR(PATSSN ,"Missing or Invalid "_ADDRER( I))
	5605	"RTN","RCC PCAR",92,0 )
	5606	N ADDRER
	5607	"RTN","RCC PCAR",93,0 )
	5608	F I=2,3 I $L($P(ARA DDR,U,I))> 40 D
	5609	"RTN","RCC PCAR",94,0 )
	5610	. S ADDRE R(I)=$S(I= 2:"Address Line 2",I =3:"Addres s Line 3")
	5611	"RTN","RCC PCAR",95,0 )
	5612	. D SETER ROR(PATSSN ,"Invalid "_ADDRER(I ))
	5613	"RTN","RCC PCAR",96,0 )
	5614	;
	5615	"RTN","RCC PCAR",97,0 )
	5616	; figure out COUNTR Y first
	5617	"RTN","RCC PCAR",98,0 )
	5618	S COUNTRY ="",ST=$P( ARADDR,U,5 )
	5619	"RTN","RCC PCAR",99,0 )
	5620	I ARFLAG= "Y",ST'="" D
	5621	"RTN","RCC PCAR",100, 0)
	5622	. S I=$O( ^DIC(5,"C" ,ST,0))
	5623	"RTN","RCC PCAR",101, 0)
	5624	. I (I>90 ),'$P($G(^ DIC(5,I,0) ),U,6) S S T="FX",COU NTRY=$P($G (^DIC(5,I, 0)),U,1)
	5625	"RTN","RCC PCAR",102, 0)
	5626	I ARFLAG= "N" D
	5627	"RTN","RCC PCAR",103, 0)
	5628	. I DBN0' ["DPT(" Q
	5629	"RTN","RCC PCAR",104, 0)
	5630	. K VAPA D ADD^VADP T ; DBIA#1 0061
	5631	"RTN","RCC PCAR",105, 0)
	5632	. I +VAPA (25)>2 S S T="FX",COU NTRY=$P(VA PA(25),U,2 )
	5633	"RTN","RCC PCAR",106, 0)
	5634	;
	5635	"RTN","RCC PCAR",107, 0)
	5636	I ST="" D SETERROR( PATSSN,"Mi ssing Stat e")
	5637	"RTN","RCC PCAR",108, 0)
	5638	I ST'="", ST'="FX",' $O(^DIC(5, "C",ST,0)) D SETERRO R(PATSSN," Invalid St ate")
	5639	"RTN","RCC PCAR",109, 0)
	5640	I COUNTRY ="",$P(ARA DDR,U,6)=" " D SETERR OR(PATSSN, "Missing Z ip Code")
	5641	"RTN","RCC PCAR",110, 0)
	5642	I COUNTRY ="",($P(AR ADDR,U,6)' =""),($P(A RADDR,U,6) '?5.9N) D SETERROR(P ATSSN,"Inv alid Zip C ode")
	5643	"RTN","RCC PCAR",111, 0)
	5644	Q
	5645	"RTN","RCC PCAR",112, 0)
	5646	;
	5647	"RTN","RCC PCAR",113, 0)
	5648	CHECKPD(DE BTOR,DATE, TRANS) ; Get and Se t Data for PD Record into 349. 5
	5649	"RTN","RCC PCAR",114, 0)
	5650	N AMT
	5651	"RTN","RCC PCAR",115, 0)
	5652	; Get and Check Tra nsaction A mount
	5653	"RTN","RCC PCAR",116, 0)
	5654	S AMT=$P( ^PRCA(433, TRANS,1),U ,5)
	5655	"RTN","RCC PCAR",117, 0)
	5656	; Format Amount
	5657	"RTN","RCC PCAR",118, 0)
	5658	S AMT=$TR ($J(AMT,9, 2)," ","")
	5659	"RTN","RCC PCAR",119, 0)
	5660	S AMT=$P( AMT,".")_$ P(AMT,".", 2)
	5661	"RTN","RCC PCAR",120, 0)
	5662	I 'AMT!($ L(AMT)>10) D SETERRO R(PATSSN," Amount in Transactio n "_TRANS_ " Invalid" )
	5663	"RTN","RCC PCAR",121, 0)
	5664	;
	5665	"RTN","RCC PCAR",122, 0)
	5666	; Get and Check Tra nsaction D ate
	5667	"RTN","RCC PCAR",123, 0)
	5668	I $P(DATE ,".")'?7N. N D SETERR OR(PATSSN, "Date for Transactio n "_TRANS_ " Invalid" )
	5669	"RTN","RCC PCAR",124, 0)
	5670	Q
	5671	"RTN","RCC PCAR",125, 0)
	5672	;
	5673	"RTN","RCC PCAR",126, 0)
	5674	SETERROR(P ATSSN,ERRO R) ; Set the error into ^XTMP ($J,"MSG", LINE,0) fo r transmis sion
	5675	"RTN","RCC PCAR",127, 0)
	5676	; If the first time thru for this patie nt set the Name and SSN in mes sage
	5677	"RTN","RCC PCAR",128, 0)
	5678	; with a blank line above the Patient D ata for sp acing
	5679	"RTN","RCC PCAR",129, 0)
	5680	I 'PATERR OR D
	5681	"RTN","RCC PCAR",130, 0)
	5682	. S LINE= LINE+1,^XT MP("RCCPCA R",$J,"MSG ",LINE,0)= ""
	5683	"RTN","RCC PCAR",131, 0)
	5684	. S LINE= LINE+1,^XT MP("RCCPCA R",$J,"MSG ",LINE,0)= PATSSN
	5685	"RTN","RCC PCAR",132, 0)
	5686	. S PATER ROR=1
	5687	"RTN","RCC PCAR",133, 0)
	5688	; Write E rror to ne xt line wi th a doubl e space in front
	5689	"RTN","RCC PCAR",134, 0)
	5690	S LINE=LI NE+1 S ^XT MP("RCCPCA R",$J,"MSG ",LINE,0)= " "_ERROR
	5691	"RTN","RCC PCAR",135, 0)
	5692	Q
	5693	"RTN","RCC PCAR",136, 0)
	5694	;
	5695	"RTN","RCC PCAR",137, 0)
	5696	TRANSMIT ; set up and send mail message - copied fr om RCCPCML
	5697	"RTN","RCC PCAR",138, 0)
	5698	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY
	5699	"RTN","RCC PCAR",139, 0)
	5700	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT ERROR R EPORT "_20 _$E(YEAR,2 ,3)_" TO C URRENT
	5701	DATE"
	5702	"RTN","RCC PCAR",140, 0)
	5703	S XMDUZ=" AR PACKAGE "
	5704	"RTN","RCC PCAR",141, 0)
	5705	;I $O(^XM B(3.8,"B", "RCCPC STA TEMENTS"," ")),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC
	5706	STATEMENTS ")=""
	5707	"RTN","RCC PCAR",142, 0)
	5708	N TAR,ERR
	5709	"RTN","RCC PCAR",143, 0)
	5710	D FIND^DI C(3.8,,.01 ,"X","RCCP C STATEMEN TS",1,"B", ,,"TAR","E RR") ;DBIA #10111
	5711	"RTN","RCC PCAR",144, 0)
	5712	I +$G(TAR ("DILIST", 0)),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC STATE MENTS")=""
	5713	"RTN","RCC PCAR",145, 0)
	5714	S XMDUZ=" AR PACKAGE "
	5715	"RTN","RCC PCAR",146, 0)
	5716	D XMZ^XMA 2
	5717	"RTN","RCC PCAR",147, 0)
	5718	I XMZ<1 S RTY=RTY+1 G TRANSMI T:RTY<4 S ERROR=5,NM =0 D ERROR Q
	5719	"RTN","RCC PCAR",148, 0)
	5720	S (L,L(1) )=0 F S L (1)=$O(^XT MP("RCCPCA R",$J,"MSG ",L(1))) Q :'L(1) I
	5721	$D(^XTMP(" RCCPCAR",$ J,"MSG",L( 1),0)) S
	5722	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^XT MP("RCCPCA R",$J,"MSG ",L(1),0) ;DBIA#1011 3
	5723	"RTN","RCC PCAR",149, 0)
	5724	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T ;DBIA#10 113
	5725	"RTN","RCC PCAR",150, 0)
	5726	D ENT1^XM D
	5727	"RTN","RCC PCAR",151, 0)
	5728	D NOW^%DT C
	5729	"RTN","RCC PCAR",152, 0)
	5730	Q
	5731	"RTN","RCC PCAR",153, 0)
	5732	;
	5733	"RTN","RCC PCAR",154, 0)
	5734	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	5735	"RTN","RCC PCAR",155, 0)
	5736	I NM=0 S ^XTMP("RCC PCAR",$J," ERROR",ERR OR,NM)="" Q
	5737	"RTN","RCC PCAR",156, 0)
	5738	Q
	5739	"RTN","RCC PCAR",157, 0)
	5740	;
	5741	"RTN","RCC PCAR",158, 0)
	5742	MANBLD ; Build and Transmit t he Annual Payment St atement Co nsistency Checker
	5743	"RTN","RCC PCAR",159, 0)
	5744	N YEAR,DA TE,DIR,X,Y ,ZTIO,ZTRT N,ZTDESC,Z TDTH,ZTSK, QDT,%,%H
	5745	"RTN","RCC PCAR",160, 0)
	5746	; PRCA4. 5313 - Ch eck for RU NNING IF r unning qui t with war ning.
	5747	"RTN","RCC PCAR",161, 0)
	5748	S X=$O(^X TMP("RCCPC AR IS RUNN ING",0)) I X D Q ; --> out
	5749	"RTN","RCC PCAR",162, 0)
	5750	. W !!,"# ########## ########## ########## #########"
	5751	"RTN","RCC PCAR",163, 0)
	5752	. W 7,7 ,!,"Annual Payment E rror Repor t is alrea dy being r un or tran smitted."
	5753	"RTN","RCC PCAR",164, 0)
	5754	. W !,"Tr y again la ter."
	5755	"RTN","RCC PCAR",165, 0)
	5756	. W !,"## ########## ########## ########## ########"
	5757	"RTN","RCC PCAR",166, 0)
	5758	;
	5759	"RTN","RCC PCAR",167, 0)
	5760	S YEAR=20 _$E(DT,2,3 )
	5761	"RTN","RCC PCAR",168, 0)
	5762	S DIR(0)= "YAO"
	5763	"RTN","RCC PCAR",169, 0)
	5764	S DIR("B" )="N"
	5765	"RTN","RCC PCAR",170, 0)
	5766	S DIR("A" )="Do you want to Ru n and Tran smit the C onsistency Checker f or "_YEAR_ " to the c urrent
	5767	date? "
	5768	"RTN","RCC PCAR",171, 0)
	5769	S DIR("?? ")="^D MAN HLP^RCCPCA R"
	5770	"RTN","RCC PCAR",172, 0)
	5771	D ^DIR
	5772	"RTN","RCC PCAR",173, 0)
	5773	I $D(DTOU T)!($D(DUO UT))!($D(D IROUT))!(Y =0) K DTOU T,DUOUT,DI ROUT Q
	5774	;ASF,12/18 /18,PRCA4 .5313
	5775	"RTN","RCC PCAR",174, 0)
	5776	S ZTIO="" ,ZTRTN="EN ^RCCPCAR(" _$E(DT,1,3 )_")"
	5777	"RTN","RCC PCAR",175, 0)
	5778	S ZTDESC= "Annual Pa yment Stat ement File Consisten cy Checker "
	5779	"RTN","RCC PCAR",176, 0)
	5780	S ZTDTH=" " D ^%ZTLO AD Q:$G(ZT SK)=""
	5781	"RTN","RCC PCAR",177, 0)
	5782	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	5783	"RTN","RCC PCAR",178, 0)
	5784	Q
	5785	"RTN","RCC PCAR",179, 0)
	5786	;
	5787	"RTN","RCC PCAR",180, 0)
	5788	MANHLP ; "??" Help for MANBLD
	5789	"RTN","RCC PCAR",181, 0)
	5790	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Run and Transmit t he Consist ency Check er."
	5791	"RTN","RCC PCAR",182, 0)
	5792	Q
	5793	"RTN","RCC PCAT")
	5794	0^22^B5840 9959^n/a
	5795	"RTN","RCC PCAT",1,0)
	5796	RCCPCAT ;A LB/TGH - P ATCH PRCA* 4.5*ANNUAL PAYMENT T RANSMIT ;2 /3/2016 11 :30 am
	5797	"RTN","RCC PCAT",2,0)
	5798	;;4.5;Acc ounts Rece ivable;3 13;Feb 2 0, 2017;Bu ild 150
	5799	"RTN","RCC PCAT",3,0)
	5800	;;Per VA Directive 6402, this routine s hould not be modifie d.
	5801	"RTN","RCC PCAT",4,0)
	5802	;DBIA#101 13
	5803	"RTN","RCC PCAT",5,0)
	5804	;DBIA#101 11
	5805	"RTN","RCC PCAT",6,0)
	5806	EN(DTTIME) ;Schedul e the Tran smit
	5807	"RTN","RCC PCAT",7,0)
	5808	N ZTDESC, ZTASK,ZTDT H,ZTIO,ZTR TN
	5809	"RTN","RCC PCAT",8,0)
	5810	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	5811	"RTN","RCC PCAT",9,0)
	5812	S ZTDESC= "ANNUAL PA YMENT STAT EMENT TRAN SMISSION"
	5813	"RTN","RCC PCAT",10,0 )
	5814	; Initial ize Transm it date an d time
	5815	"RTN","RCC PCAT",11,0 )
	5816	I DTTIME= "" S DTTIM E=%H
	5817	"RTN","RCC PCAT",12,0 )
	5818	S ZTDTH=D TTIME
	5819	"RTN","RCC PCAT",13,0 )
	5820	D ^%ZTLOA D Q:$G(ZTS K)=""
	5821	"RTN","RCC PCAT",14,0 )
	5822	Q
	5823	"RTN","RCC PCAT",15,0 )
	5824	;
	5825	"RTN","RCC PCAT",16,0 )
	5826	TRANSMIT ; Send Ann ual Paymen t Statemen t Files to AITC from RCAP(349. 5
	5827	"RTN","RCC PCAT",17,0 )
	5828	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5829	"RTN","RCC PCAT",18,0 )
	5830	L +^RCAP( 349.5):DIL OCKTM I '$ T D Q
	5831	"RTN","RCC PCAT",19,0 )
	5832	. N YEAR
	5833	"RTN","RCC PCAT",20,0 )
	5834	. S YEAR= 20_$E($P(^ RCAP(349.5 ,1,0),U,2) ,2,3)
	5835	"RTN","RCC PCAT",21,0 )
	5836	. S ^TMP( $J,"MSG",1 ,0)="The T ransmit of the Annua l Payment File for " _YEAR_" ha s not comp leted."
	5837	"RTN","RCC PCAT",22,0 )
	5838	. D ERRMA IL^RCCPCAT
	5839	"RTN","RCC PCAT",23,0 )
	5840	;
	5841	"RTN","RCC PCAT",24,0 )
	5842	K ^TMP($J ,"MSG")
	5843	"RTN","RCC PCAT",25,0 )
	5844	N PSCNTR, %,%I,%H,YE AR
	5845	"RTN","RCC PCAT",26,0 )
	5846	S YEAR=20 _$E($P(^RC AP(349.5,1 ,0),U,2),2 ,3)
	5847	"RTN","RCC PCAT",27,0 )
	5848	S PSCNTR= 0
	5849	"RTN","RCC PCAT",28,0 )
	5850	F S PSCN TR=$O(^RCA P(349.5,PS CNTR)) Q:' PSCNTR D
	5851	"RTN","RCC PCAT",29,0 )
	5852	. ; Set T ransmit St art Date a nd Time
	5853	"RTN","RCC PCAT",30,0 )
	5854	. D NOW^% DTC
	5855	"RTN","RCC PCAT",31,0 )
	5856	. S $P(^R CAP(349.5, PSCNTR,0), U,5)=%
	5857	"RTN","RCC PCAT",32,0 )
	5858	. ; Merge all PS el ements int o TMP MSG file
	5859	"RTN","RCC PCAT",33,0 )
	5860	. M ^TMP( $J,"MSG")= ^RCAP(349. 5,PSCNTR,1 )
	5861	"RTN","RCC PCAT",34,0 )
	5862	. D MAIL
	5863	"RTN","RCC PCAT",35,0 )
	5864	. ; Set T ransmit En d Date and Time
	5865	"RTN","RCC PCAT",36,0 )
	5866	. D NOW^% DTC
	5867	"RTN","RCC PCAT",37,0 )
	5868	. S $P(^R CAP(349.5, PSCNTR,0), U,6)=%
	5869	"RTN","RCC PCAT",38,0 )
	5870	;
	5871	"RTN","RCC PCAT",39,0 )
	5872	; PRCA4. 5313 - Un lock prior to quit
	5873	"RTN","RCC PCAT",40,0 )
	5874	L -^RCAP( 349.5):DIL OCKTM
	5875	"RTN","RCC PCAT",41,0 )
	5876	Q
	5877	"RTN","RCC PCAT",42,0 )
	5878	;
	5879	"RTN","RCC PCAT",43,0 )
	5880	MAIL ;set up and sen d mail mes sage - cop ied from R CCPCML
	5881	"RTN","RCC PCAT",44,0 )
	5882	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	5883	"RTN","RCC PCAT",45,0 )
	5884	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT TRANSMI SSION "_YE AR
	5885	"RTN","RCC PCAT",46,0 )
	5886	S XMDUZ=" AR PACKAGE "
	5887	"RTN","RCC PCAT",47,0 )
	5888	;I $O(^XM B(3.8,"B", "RCCPC STA TEMENTS"," ")),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC
	5889	STATEMENTS ")=""
	5890	"RTN","RCC PCAT",48,0 )
	5891	N TAR,ERR
	5892	"RTN","RCC PCAT",49,0 )
	5893	D FIND^DI C(3.8,,.01 ,"X","RCCP C STATEMEN TS",1,"B", ,,"TAR","E RR") ;DBIA #10111
	5894	"RTN","RCC PCAT",50,0 )
	5895	I +$G(TAR ("DILIST", 0)),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC STATE MENTS")=""
	5896	"RTN","RCC PCAT",51,0 )
	5897	S X=$O(^R CT(349.1," B","PY",0) )
	5898	"RTN","RCC PCAT",52,0 )
	5899	I X,$P($G (^RCT(349. 1,+X,0)),U ,3) S X=$P ($G(^RCT(3 49.1,+X,3) ),U)_"@"_$ P($G(^RCT( 349.1,+X,3 )),U,3)
	5900	S:$P(X,"@" ,2)]"" XMY (X)=""
	5901	"RTN","RCC PCAT",53,0 )
	5902	I $P(X,"@ ",2)']"" D Q
	5903	"RTN","RCC PCAT",54,0 )
	5904	.S ERROR= 6,NM=0 D E RROR
	5905	"RTN","RCC PCAT",55,0 )
	5906	S XMDUZ=" AR PACKAGE "
	5907	"RTN","RCC PCAT",56,0 )
	5908	D XMZ^XMA 2
	5909	"RTN","RCC PCAT",57,0 )
	5910	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	5911	"RTN","RCC PCAT",58,0 )
	5912	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1) ,0)) S
	5913	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1),0)
	5914	"RTN","RCC PCAT",59,0 )
	5915	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T
	5916	"RTN","RCC PCAT",60,0 )
	5917	D ENT1^XM D
	5918	"RTN","RCC PCAT",61,0 )
	5919	D NOW^%DT C
	5920	"RTN","RCC PCAT",62,0 )
	5921	K ^TMP($J ,"MSG")
	5922	"RTN","RCC PCAT",63,0 )
	5923	Q
	5924	"RTN","RCC PCAT",64,0 )
	5925	;
	5926	"RTN","RCC PCAT",65,0 )
	5927	ERRMAIL ;s et up and send mail message fo r Locking issues
	5928	"RTN","RCC PCAT",66,0 )
	5929	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z,ERR OR,NM,PSN, RTY,X
	5930	"RTN","RCC PCAT",67,0 )
	5931	S XMSUB=$ $SITE^RCMS ITE()_" AN NUAL PAYME NT NOT COM PLETED "_Y EAR
	5932	"RTN","RCC PCAT",68,0 )
	5933	S XMDUZ=" AR PACKAGE "
	5934	"RTN","RCC PCAT",69,0 )
	5935	;I $O(^XM B(3.8,"B", "RCCPC STA TEMENTS"," ")),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC
	5936	STATEMENTS ")=""
	5937	"RTN","RCC PCAT",70,0 )
	5938	N TAR,ERR
	5939	"RTN","RCC PCAT",71,0 )
	5940	D FIND^DI C(3.8,,.01 ,"X","RCCP C STATEMEN TS",1,"B", ,,"TAR","E RR") ;DBIA #10111
	5941	"RTN","RCC PCAT",72,0 )
	5942	I +$G(TAR ("DILIST", 0)),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC STATE MENTS")=""
	5943	"RTN","RCC PCAT",73,0 )
	5944	S XMDUZ=" AR PACKAGE "
	5945	"RTN","RCC PCAT",74,0 )
	5946	D XMZ^XMA 2
	5947	"RTN","RCC PCAT",75,0 )
	5948	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	5949	"RTN","RCC PCAT",76,0 )
	5950	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) I $ D(^TMP($J, "MSG",L(1) ,0)) S
	5951	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1),0) ; DBIA#10113
	5952	"RTN","RCC PCAT",77,0 )
	5953	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T ;DBIA#10 113
	5954	"RTN","RCC PCAT",78,0 )
	5955	D ENT1^XM D
	5956	"RTN","RCC PCAT",79,0 )
	5957	D NOW^%DT C
	5958	"RTN","RCC PCAT",80,0 )
	5959	K ^TMP($J ,"MSG")
	5960	"RTN","RCC PCAT",81,0 )
	5961	Q
	5962	"RTN","RCC PCAT",82,0 )
	5963	;
	5964	"RTN","RCC PCAT",83,0 )
	5965	SCHED(SITE ) ; Deter mine the d ate and ti me for Tra nsmit base d upon Sit e Code and table AIT C provided
	5966	"RTN","RCC PCAT",84,0 )
	5967	; Time wi ll always be 2:00 AM
	5968	"RTN","RCC PCAT",85,0 )
	5969	I SITE>40 1&(SITE<52 0) S DTTIM E=$E(DT,1, 5)_"03.020 000" Q DTT IME
	5970	"RTN","RCC PCAT",86,0 )
	5971	I SITE>51 9&(SITE<54 1) S DTTIM E=$E(DT,1, 5)_"04.020 000" Q DTT IME
	5972	"RTN","RCC PCAT",87,0 )
	5973	I SITE>54 0&(SITE<55 9) S DTTIM E=$E(DT,1, 5)_"05.020 000" Q DTT IME
	5974	"RTN","RCC PCAT",88,0 )
	5975	I SITE>56 0&(SITE<58 1) S DTTIM E=$E(DT,1, 5)_"06.020 000" Q DTT IME
	5976	"RTN","RCC PCAT",89,0 )
	5977	I SITE>58 0&(SITE<59 9) S DTTIM E=$E(DT,1, 5)_"07.020 000" Q DTT IME
	5978	"RTN","RCC PCAT",90,0 )
	5979	I SITE>59 9&(SITE<62 0) S DTTIM E=$E(DT,1, 5)_"08.020 000" Q DTT IME
	5980	"RTN","RCC PCAT",91,0 )
	5981	I SITE>61 9&(SITE<64 1) S DTTIM E=$E(DT,1, 5)_"09.020 000" Q DTT IME
	5982	"RTN","RCC PCAT",92,0 )
	5983	I SITE>64 1&(SITE<65 8) S DTTIM E=$E(DT,1, 5)_"10.020 000" Q DTT IME
	5984	"RTN","RCC PCAT",93,0 )
	5985	I SITE>65 7&(SITE<67 5) S DTTIM E=$E(DT,1, 5)_"11.020 000" Q DTT IME
	5986	"RTN","RCC PCAT",94,0 )
	5987	I SITE>67 4&(SITE<75 8) S DTTIM E=$E(DT,1, 5)_"12.020 000" Q DTT IME
	5988	"RTN","RCC PCAT",95,0 )
	5989	S DTTIME= ""
	5990	"RTN","RCC PCAT",96,0 )
	5991	Q DTTIME
	5992	"RTN","RCC PCAT",97,0 )
	5993	;
	5994	"RTN","RCC PCAT",98,0 )
	5995	MANBLD ; Build and Transmit t he Annual Payment St atement af ter initia l yearly t ransmissio n
	5996	"RTN","RCC PCAT",99,0 )
	5997	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	5998	"RTN","RCC PCAT",100, 0)
	5999	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6000	"RTN","RCC PCAT",101, 0)
	6001	;
	6002	"RTN","RCC PCAT",102, 0)
	6003	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6004	"RTN","RCC PCAT",103, 0)
	6005	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6006	"RTN","RCC PCAT",104, 0)
	6007	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6008	"RTN","RCC PCAT",105, 0)
	6009	I YEAR="" S YEAR=$E (DT,1,3)-1
	6010	"RTN","RCC PCAT",106, 0)
	6011	S YEAR("E XT")=20_$E (YEAR,2,3)
	6012	"RTN","RCC PCAT",107, 0)
	6013	S DATE=+$ P($G(^RCAP (349.5,1,0 )),U,6)
	6014	"RTN","RCC PCAT",108, 0)
	6015	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6016	"RTN","RCC PCAT",109, 0)
	6017	I 'DATE D L -^RCAP (349.5):DI LOCKTM Q
	6018	"RTN","RCC PCAT",110, 0)
	6019	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been trans mitted."
	6020	"RTN","RCC PCAT",111, 0)
	6021	. W !,"Bu ild and Re transmit m ay not be manually r un until s cheduled j ob has com pleted.",!
	6022	"RTN","RCC PCAT",112, 0)
	6023	. N DIR
	6024	"RTN","RCC PCAT",113, 0)
	6025	. S DIR(0 )="E"
	6026	"RTN","RCC PCAT",114, 0)
	6027	. S DIR(" A")="Type <Enter> to return to the Menu. "
	6028	"RTN","RCC PCAT",115, 0)
	6029	. D ^DIR
	6030	"RTN","RCC PCAT",116, 0)
	6031	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6032	"RTN","RCC PCAT",117, 0)
	6033	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_"."
	6034	"RTN","RCC PCAT",118, 0)
	6035	S DIR(0)= "YAO"
	6036	"RTN","RCC PCAT",119, 0)
	6037	S DIR("B" )="N"
	6038	"RTN","RCC PCAT",120, 0)
	6039	S DIR("A" )="Do you want to Bu ild and Tr ansmit the file for "_YEAR("EX T")_"? "
	6040	"RTN","RCC PCAT",121, 0)
	6041	S DIR("?? ")="^D MAN HLP^RCCPCA T"
	6042	"RTN","RCC PCAT",122, 0)
	6043	D ^DIR
	6044	"RTN","RCC PCAT",123, 0)
	6045	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6046	"RTN","RCC PCAT",124, 0)
	6047	I $D(DTOU T)!($D(DUO UT))!($D(D IROUT))!(Y =0) K DTOU T,DUOUT,DI ROUT Q ;A SF,12/17/1 8,PRCA*4.5
	6048	313
	6049	"RTN","RCC PCAT",125, 0)
	6050	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6051	"RTN","RCC PCAT",126, 0)
	6052	S ZTIO="" ,ZTRTN="EN ^RCCPCAP(" _YEAR_","_ """F"""_", "_""""""_" )"
	6053	"RTN","RCC PCAT",127, 0)
	6054	S ZTDESC= "Build Ann ual Paymen t Statemen t File"
	6055	"RTN","RCC PCAT",128, 0)
	6056	S ZTDTH=" "
	6057	"RTN","RCC PCAT",129, 0)
	6058	;
	6059	"RTN","RCC PCAT",130, 0)
	6060	; PRCA4. 5313 - Un lock prior to transm itting
	6061	"RTN","RCC PCAT",131, 0)
	6062	L -^RCAP( 349.5):DIL OCKTM
	6063	"RTN","RCC PCAT",132, 0)
	6064	;
	6065	"RTN","RCC PCAT",133, 0)
	6066	D ^%ZTLOA D Q:$G(ZTS K)=""
	6067	"RTN","RCC PCAT",134, 0)
	6068	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6069	"RTN","RCC PCAT",135, 0)
	6070	Q
	6071	"RTN","RCC PCAT",136, 0)
	6072	;
	6073	"RTN","RCC PCAT",137, 0)
	6074	RETRANS ; Retransmi t the exis ting file and allow user to se lect date and time
	6075	"RTN","RCC PCAT",138, 0)
	6076	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	6077	"RTN","RCC PCAT",139, 0)
	6078	L +^RCAP( 349.5):DIL OCKTM I '$ T D MENUER R Q
	6079	"RTN","RCC PCAT",140, 0)
	6080	;
	6081	"RTN","RCC PCAT",141, 0)
	6082	N YEAR,DA TE,DIR,X,Z TIO,ZTRTN, ZTDESC,ZTD TH,ZTSK,QD T
	6083	"RTN","RCC PCAT",142, 0)
	6084	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6085	"RTN","RCC PCAT",143, 0)
	6086	S YEAR=$P ($G(^RCAP( 349.5,1,0) ),U,2)
	6087	"RTN","RCC PCAT",144, 0)
	6088	I $G(YEAR )="" S YEA R=$E(DT,1, 3)-1 ; ASF ,12/15/18, PRCA*4.5 3 13
	6089	"RTN","RCC PCAT",145, 0)
	6090	S YEAR("E XT")=20_$E (YEAR,2,3)
	6091	"RTN","RCC PCAT",146, 0)
	6092	S DATE=$P ($G(^RCAP( 349.5,1,0) ),U,6)
	6093	"RTN","RCC PCAT",147, 0)
	6094	S DATE=$S (DATE'="": $$SLH^RCFN 01(DATE),1 :"")
	6095	"RTN","RCC PCAT",148, 0)
	6096	I '$P($G( ^RCAP(349. 5,1,0)),U, 4) D L -^ RCAP(349.5 ):DILOCKTM Q
	6097	"RTN","RCC PCAT",149, 0)
	6098	. W !,"Th e Annual P ayment Fil e for "_YE AR("EXT")_ " has not been Built and canno t be trans mitted."
	6099	"RTN","RCC PCAT",150, 0)
	6100	. N DIR
	6101	"RTN","RCC PCAT",151, 0)
	6102	. S DIR(0 )="E"
	6103	"RTN","RCC PCAT",152, 0)
	6104	. S DIR(" A")="Type <Enter> to return to the menu. "
	6105	"RTN","RCC PCAT",153, 0)
	6106	. D ^DIR
	6107	"RTN","RCC PCAT",154, 0)
	6108	. I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	6109	"RTN","RCC PCAT",155, 0)
	6110	W !!,"The Annual Pa yment File for "_YEA R("EXT")_" was trans mitted on "_DATE_"."
	6111	"RTN","RCC PCAT",156, 0)
	6112	S DIR(0)= "YAO"
	6113	"RTN","RCC PCAT",157, 0)
	6114	S DIR("B" )="N"
	6115	"RTN","RCC PCAT",158, 0)
	6116	S DIR("A" )="Do you want to Re transmit t he existin g file for "_YEAR("E XT")_" aga in? "
	6117	"RTN","RCC PCAT",159, 0)
	6118	S DIR("?? ")="^D RET HLP^RCCPCA T"
	6119	"RTN","RCC PCAT",160, 0)
	6120	D ^DIR
	6121	"RTN","RCC PCAT",161, 0)
	6122	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC AP(349.5): DILOCKTM Q
	6123	"RTN","RCC PCAT",162, 0)
	6124	I $D(DTOU T)!($D(DUO UT))!($D(D IROUT))!(Y =0) K DTOU T,DUOUT,DI ROUT Q ;A SF,12/17/1 8,PRCA*4.5
	6125	313
	6126	"RTN","RCC PCAT",163, 0)
	6127	W !!,">> PLEASE CON TACT CUSTO MER SUPPOR T BEFORE P ROCEEDING <<",!!
	6128	"RTN","RCC PCAT",164, 0)
	6129	S ZTIO="" ,ZTRTN="TR ANSMIT^RCC PCAT"
	6130	"RTN","RCC PCAT",165, 0)
	6131	S ZTDESC= "Retransmi t Annual P ayment Sta tement Fil e"
	6132	"RTN","RCC PCAT",166, 0)
	6133	S ZTDTH=" "
	6134	"RTN","RCC PCAT",167, 0)
	6135	;
	6136	"RTN","RCC PCAT",168, 0)
	6137	; PRCA4. 5313 - Un lock prior to retran smitting
	6138	"RTN","RCC PCAT",169, 0)
	6139	L -^RCAP( 349.5):DIL OCKTM
	6140	"RTN","RCC PCAT",170, 0)
	6141	;
	6142	"RTN","RCC PCAT",171, 0)
	6143	D ^%ZTLOA D Q:$G(ZTS K)=""
	6144	"RTN","RCC PCAT",172, 0)
	6145	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	6146	"RTN","RCC PCAT",173, 0)
	6147	Q
	6148	"RTN","RCC PCAT",174, 0)
	6149	;
	6150	"RTN","RCC PCAT",175, 0)
	6151	ERROR ;ER ROR FILE - Copied fr om RCCPCML
	6152	"RTN","RCC PCAT",176, 0)
	6153	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6154	"RTN","RCC PCAT",177, 0)
	6155	Q
	6156	"RTN","RCC PCAT",178, 0)
	6157	;
	6158	"RTN","RCC PCAT",179, 0)
	6159	MENUERR ; Print err or to scre en if Annu al Payment File has not comple ted for th is year
	6160	"RTN","RCC PCAT",180, 0)
	6161	N YEAR
	6162	"RTN","RCC PCAT",181, 0)
	6163	S YEAR=20 _$E(DT,2,3 )-1
	6164	"RTN","RCC PCAT",182, 0)
	6165	W !!,"The Build and Transmit of the Ann ual Paymen t File for "_YEAR_" has not co mpleted."
	6166	"RTN","RCC PCAT",183, 0)
	6167	W !,"You may not us e this opt ion until it complet es.",!
	6168	"RTN","RCC PCAT",184, 0)
	6169	D PAUSE^V ALM1
	6170	"RTN","RCC PCAT",185, 0)
	6171	Q
	6172	"RTN","RCC PCAT",186, 0)
	6173	;
	6174	"RTN","RCC PCAT",187, 0)
	6175	MANHLP ; "??" Help for MANBLD and RETRA NS
	6176	"RTN","RCC PCAT",188, 0)
	6177	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Build an d Retransm it file."
	6178	"RTN","RCC PCAT",189, 0)
	6179	Q
	6180	"RTN","RCC PCAT",190, 0)
	6181	;
	6182	"RTN","RCC PCAT",191, 0)
	6183	RETHLP ; "??" Help for MANBLD and RETRA NS
	6184	"RTN","RCC PCAT",192, 0)
	6185	W !,"Ente r 'N' or R eturn to Q uit. 'Y' t o Retransm it file."
	6186	"RTN","RCC PCAT",193, 0)
	6187	Q
	6188	"RTN","RCC PCBJ")
	6189	0^5^B10271 413^B62884 91
	6190	"RTN","RCC PCBJ",1,0)
	6191	RCCPCBJ ;W ASH-ISC@AL TOONA,PA/N YB-Backgro und Driver for CCPC ;1/7/97 9 :42 AM
	6192	"RTN","RCC PCBJ",2,0)
	6193	;;4.5;Acc ounts Rece ivable;3 4,76,130,1 53,166,195 ,217,237,3 13;Mar 2 0, 1995;Bu ild 150
	6194	"RTN","RCC PCBJ",3,0)
	6195	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6196	"RTN","RCC PCBJ",4,0)
	6197	EN ;Starts the backg round job for CCPC 5 days befo re stateme nt day
	6198	"RTN","RCC PCBJ",5,0)
	6199	N X,X1,X2 ,X3,ZTRTN, ZTIO,ZTDTH ,ZTSK,ZTDE SC,SDT,RCF ULL
	6200	"RTN","RCC PCBJ",6,0)
	6201	;D ACK P RCA4.531 3 - Moved into OPEN
	6202	"RTN","RCC PCBJ",7,0)
	6203	D ;run t he cbs nig htly accou nt update program ev eryday
	6204	"RTN","RCC PCBJ",8,0)
	6205	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6206	"RTN","RCC PCBJ",9,0)
	6207	.S RCFULL =0 ;do not send the full debto r list
	6208	"RTN","RCC PCBJ",10,0 )
	6209	.S ZTIO=" ",ZTRTN="D EBTOR^PRCA CPS1"
	6210	"RTN","RCC PCBJ",11,0 )
	6211	.S ZTDESC ="CBS NIGH TLY ACCOUN T UPDATE P ROGRAM",ZT DTH=$H
	6212	"RTN","RCC PCBJ",12,0 )
	6213	.D ^%ZTLO AD
	6214	"RTN","RCC PCBJ",13,0 )
	6215	;
	6216	"RTN","RCC PCBJ",14,0 )
	6217	I $$DOW^X LFDT(DT,1) =3 D ;run the cbs a uto-correc tion progr am on Wedn esdays
	6218	"RTN","RCC PCBJ",15,0 )
	6219	.N ZTDESC ,ZTASK,ZTD TH,ZTIO,ZT RTN
	6220	"RTN","RCC PCBJ",16,0 )
	6221	.S ZTIO=" ",ZTRTN="S TART^PRCAC PS",ZTSAVE ("RCFULL") =""
	6222	"RTN","RCC PCBJ",17,0 )
	6223	.S ZTDESC ="PATIENT STATEMENTS AUTO-CORR ECTION PRO GRAM",ZTDT H=$H
	6224	"RTN","RCC PCBJ",18,0 )
	6225	.D ^%ZTLO AD
	6226	"RTN","RCC PCBJ",19,0 )
	6227	;
	6228	"RTN","RCC PCBJ",20,0 )
	6229	; PRCA4. 5313 - Ru n the Annu al Payment Statement Build and Transmit
	6230	"RTN","RCC PCBJ",21,0 )
	6231	; on Janu ary 2nd of each year for the p revious ye ar
	6232	"RTN","RCC PCBJ",22,0 )
	6233	I $E(DT,4 ,7)="0102" D
	6234	"RTN","RCC PCBJ",23,0 )
	6235	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6236	"RTN","RCC PCBJ",24,0 )
	6237	. S ZTIO= "",ZTRTN=" EN^RCCPCAP ",ZTDTH=$H
	6238	"RTN","RCC PCBJ",25,0 )
	6239	. S ZTDES C="ANNUAL PAYMENT ST ATEMENT BU ILD AND TR ANSMIT"
	6240	"RTN","RCC PCBJ",26,0 )
	6241	. D ^%ZTL OAD
	6242	"RTN","RCC PCBJ",27,0 )
	6243	;
	6244	"RTN","RCC PCBJ",28,0 )
	6245	; PRCA4. 5313 - Ru n the Annu al Payment Error Rep ort on Mar ch, June, September and
	6246	"RTN","RCC PCBJ",29,0 )
	6247	; Decembe r 15th
	6248	"RTN","RCC PCBJ",30,0 )
	6249	I $E(DT,4 ,5)="03"!( $E(DT,4,5) ="06")!($E (DT,4,5)=" 09")!($E(D T,4,5)=12) D
	6250	"RTN","RCC PCBJ",31,0 )
	6251	. I $E(DT ,6,7)'=15 Q
	6252	"RTN","RCC PCBJ",32,0 )
	6253	. N ZTIO, ZTRTN,ZTDE SC,ZTDTH
	6254	"RTN","RCC PCBJ",33,0 )
	6255	. S ZTIO= "",ZTRTN=" EN^RCCPCAR ",ZTDTH=$H
	6256	"RTN","RCC PCBJ",34,0 )
	6257	. S ZTDES C="ANNUAL PAYMENT ER ROR REPORT "
	6258	"RTN","RCC PCBJ",35,0 )
	6259	. D ^%ZTL OAD
	6260	"RTN","RCC PCBJ",36,0 )
	6261	;
	6262	"RTN","RCC PCBJ",37,0 )
	6263	I DT'<$P( $G(^RC(342 ,1,30)),"^ ",1)&(DT'> $P($G(^RC( 342,1,30)) ,"^",2)) D ^RCEXINAD
	6264	"RTN","RCC PCBJ",38,0 )
	6265	;
	6266	"RTN","RCC PCBJ",39,0 )
	6267	; PRCA4. 5313 - Se t Statemen t Date to two days i n future a nd save fo r Job
	6268	"RTN","RCC PCBJ",40,0 )
	6269	S X1=DT,X 2=2 D C^%D TC S SDT=X
	6270	"RTN","RCC PCBJ",41,0 )
	6271	S ZTSAVE( "SDT")=SDT
	6272	"RTN","RCC PCBJ",42,0 )
	6273	S ZTIO="" ,ZTRTN="OP EN^RCCPCBJ ",ZTDESC=" CBSS PATIE NT STATEME NT"
	6274	"RTN","RCC PCBJ",43,0 )
	6275	S ZTDTH=$ H D ^%ZTLO AD
	6276	"RTN","RCC PCBJ",44,0 )
	6277	Q
	6278	"RTN","RCC PCBJ",45,0 )
	6279	OPEN ;Upda te Open st atus bills to Active or Cancel lation sta tus
	6280	"RTN","RCC PCBJ",46,0 )
	6281	N DAY,BN, DEBTOR,DA, DIE,DR,P,A MT,DATE
	6282	"RTN","RCC PCBJ",47,0 )
	6283	N ZTSAVE, ZTRTN,ZTDE SC,ZTASK,% ZIS,ZTDTH
	6284	"RTN","RCC PCBJ",48,0 )
	6285	;PRCA4.5 313(/DM) verify Pat ient State ment date dependent upon the P atient Las t Name
	6286	"RTN","RCC PCBJ",49,0 )
	6287	D STDT^RC CPCPS
	6288	"RTN","RCC PCBJ",50,0 )
	6289	; PRCA4. 5313 - Ch eck the ac knowledgem ent for pr evious mon th
	6290	"RTN","RCC PCBJ",51,0 )
	6291	D TRANCHK ^RCCPCSV1
	6292	"RTN","RCC PCBJ",52,0 )
	6293	; PRCA4. 5313 - Se t DATE and day of mo nth from S DT and pro cess that date's deb tors
	6294	"RTN","RCC PCBJ",53,0 )
	6295	S DATE=SD T,DAY=+$E( SDT,6,7),D EBTOR=""
	6296	"RTN","RCC PCBJ",54,0 )
	6297	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6298	"RTN","RCC PCBJ",55,0 )
	6299	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'BN D
	6300	"RTN","RCC PCBJ",56,0 )
	6301	..S AMT=0 F P=1:1:5 S AMT=$P( $G(^PRCA(4 30,+BN,7)) ,"^",P)+AM T
	6302	"RTN","RCC PCBJ",57,0 )
	6303	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )),AMT Q
	6304	"RTN","RCC PCBJ",58,0 )
	6305	..S DIE=" ^PRCA(430, ",DA=+BN,D R="8////^S
	6306	X="_$S(AMT :$O(^PRCA( 430.3,"AC" ,102,0)),1 :$O(^PRCA( 430.3,"AC" ,111,0))) D ^DIE K D A,DIE,DR
	6307	"RTN","RCC PCBJ",59,0 )
	6308	..Q
	6309	"RTN","RCC PCBJ",60,0 )
	6310	.Q
	6311	"RTN","RCC PCBJ",61,0 )
	6312	;
	6313	"RTN","RCC PCBJ",62,0 )
	6314	; update patient a ccounts wi th interes t and admi n
	6315	"RTN","RCC PCBJ",63,0 )
	6316	N RCLASDA T
	6317	"RTN","RCC PCBJ",64,0 )
	6318	S RCLASDA T=DATE
	6319	"RTN","RCC PCBJ",65,0 )
	6320	I DT>3010 101 D FIRS TPTY^RCBEC HGS
	6321	"RTN","RCC PCBJ",66,0 )
	6322	; PRCA4. 5313 - Ad ded SDT to process a nd send
	6323	"RTN","RCC PCBJ",67,0 )
	6324	D EN^RCCP CPS(SDT)
	6325	"RTN","RCC PCBJ",68,0 )
	6326	D REFUND
	6327	"RTN","RCC PCBJ",69,0 )
	6328	;;[BEGIN EDIT,ASF,1 2/7/18, PR CA4.5313 ]
	6329	"RTN","RCC PCBJ",70,0 )
	6330	; D EN^RC CPCML(SDT)
	6331	"RTN","RCC PCBJ",71,0 )
	6332	I $$STMTD AYS^RCCPCM L1()[(","_ DAY_",") D EN^RCCPCM L(SDT)
	6333	"RTN","RCC PCBJ",72,0 )
	6334	;;[END ED IT,ASF,12/ 7/18, PRCA 4.5313]
	6335	"RTN","RCC PCBJ",73,0 )
	6336	Q
	6337	"RTN","RCC PCBJ",74,0 )
	6338	;
	6339	"RTN","RCC PCBJ",75,0 )
	6340	REFUND ;Up date Open status PRE PAYMENT bi lls to REF UND REVIEW
	6341	"RTN","RCC PCBJ",76,0 )
	6342	S DEBTOR= 0
	6343	"RTN","RCC PCBJ",77,0 )
	6344	F S DEBT OR=$O(^RCD (340,"AC", DAY,DEBTOR )) Q:'DEBT OR D
	6345	"RTN","RCC PCBJ",78,0 )
	6346	.S BN=0 F S BN=$O( ^PRCA(430, "AS",DEBTO R,$O(^PRCA (430.3,"AC ",112,0)), BN)) Q:'BN D
	6347	"RTN","RCC PCBJ",79,0 )
	6348	..I $P($G (^PRCA(430 ,+BN,0))," ^",2)=$O(^ PRCA(430.2 ,"AC",33,0 )) S X=$$E N^PRCARFU( +BN)
	6349	"RTN","RCC PCBJ",80,0 )
	6350	..Q
	6351	"RTN","RCC PCBJ",81,0 )
	6352	.Q
	6353	"RTN","RCC PCBJ",82,0 )
	6354	Q
	6355	"RTN","RCC PCBJ",83,0 )
	6356	;
	6357	"RTN","RCC PCBJ",84,0 )
	6358	ACK ;CHECK FOR ACKNO WLEDGEMENT S PRCA4. 5313 - No longer us ed
	6359	"RTN","RCC PCBJ",85,0 )
	6360	N DEB,MSG ,NO,RCX,X, X1,X2
	6361	"RTN","RCC PCBJ",86,0 )
	6362	S X1=$$ST D^RCCPCFN, X2=DT D ^% DTC I X>3 D
	6363	"RTN","RCC PCBJ",87,0 )
	6364	. D TRANC HK^RCCPCSV 1
	6365	"RTN","RCC PCBJ",88,0 )
	6366	Q
	6367	"RTN","RCC PCFN1")
	6368	0^7^B71425 06^n/a
	6369	"RTN","RCC PCFN1",1,0 )
	6370	RCCPCFN1 ; ALB/TGH-Ad ditional F unction ca lls for CB SS ;12/31/ 96 9:27 A M
	6371	"RTN","RCC PCFN1",2,0 )
	6372	;;4.5;Acc ounts Rece ivable;3 13;Mar 3 1, 2016;Bu ild 150
	6373	"RTN","RCC PCFN1",3,0 )
	6374	;;Per VA Directive 6402, this routine s hould not be modifie d.
	6375	"RTN","RCC PCFN1",4,0 )
	6376	ACSET(NAME ) ; Deter mine the d ay of the month for each new d ebtor to h ave their patient st atement
	6377	sent
	6378	"RTN","RCC PCFN1",5,0 )
	6379	; by the site to CB SS for con solidation .
	6380	"RTN","RCC PCFN1",6,0 )
	6381	; Input: NAME = Pa tient's Na me
	6382	"RTN","RCC PCFN1",7,0 )
	6383	; Output: DAY/GROUP = day of month for patient st atement tr ansmission and group number
	6384	"RTN","RCC PCFN1",8,0 )
	6385	; 0 = if i nvalid fir st charact er of last name
	6386	"RTN","RCC PCFN1",9,0 )
	6387	;
	6388	"RTN","RCC PCFN1",10, 0)
	6389	N LTR,GRO UP,DAY,I
	6390	"RTN","RCC PCFN1",11, 0)
	6391	;
	6392	"RTN","RCC PCFN1",12, 0)
	6393	; Quit if the patie nt name is not cross -reference d in the P atient Fil e (#2) - r eturn 0
	6394	"RTN","RCC PCFN1",13, 0)
	6395	I $G(NAME )="" Q 0
	6396	"RTN","RCC PCFN1",14, 0)
	6397	;I '$D(^D PT("B",NAM E)) Q 0 ; WCJ no IC R and not really nee ded. The calling ro utine got the name f rom
	6398	the patien t file.
	6399	"RTN","RCC PCFN1",15, 0)
	6400	;
	6401	"RTN","RCC PCFN1",16, 0)
	6402	F I=1,2 S LTR(I)=$E (NAME,I)
	6403	"RTN","RCC PCFN1",17, 0)
	6404	I "AB"[LT R(1) S GRO UP=1,DAY=$ $GRP1(.LTR ) Q DAY_" /"_GROUP
	6405	"RTN","RCC PCFN1",18, 0)
	6406	I "CD"[LT R(1) S GRO UP=2,DAY=$ $GRP2(.LTR ) Q DAY_" /"_GROUP
	6407	"RTN","RCC PCFN1",19, 0)
	6408	I "EFIQ"[ LTR(1) S G ROUP=3,DAY =$$GRP3(.L TR) Q DAY _"/"_GROUP
	6409	"RTN","RCC PCFN1",20, 0)
	6410	I "GH"[LT R(1) S GRO UP=4,DAY=$ $GRP4(.LTR ) Q DAY_" /"_GROUP
	6411	"RTN","RCC PCFN1",21, 0)
	6412	I "JK"[LT R(1) S GRO UP=5,DAY=$ $GRP5(.LTR ) Q DAY_" /"_GROUP
	6413	"RTN","RCC PCFN1",22, 0)
	6414	I "LO"[LT R(1) S GRO UP=6,DAY=$ $GRP6(.LTR ) Q DAY_" /"_GROUP
	6415	"RTN","RCC PCFN1",23, 0)
	6416	I "MN"[LT R(1) S GRO UP=7,DAY=$ $GRP7(.LTR ) Q DAY_" /"_GROUP
	6417	"RTN","RCC PCFN1",24, 0)
	6418	I "T"[LTR (1) S GROU P=8,DAY=$$ GRP8(.LTR) Q DAY_"/ "_GROUP
	6419	"RTN","RCC PCFN1",25, 0)
	6420	I "R"[LTR (1) S GROU P=9,DAY=$$ GRP9(.LTR) Q DAY_"/ "_GROUP
	6421	"RTN","RCC PCFN1",26, 0)
	6422	I "SV"[LT R(1) S GRO UP=10,DAY= $$GRP10(.L TR) Q DAY _"/"_GROUP
	6423	"RTN","RCC PCFN1",27, 0)
	6424	I "PUXYZ" [LTR(1) S GROUP=11,D AY=$$GRP11 (.LTR) Q DAY_"/"_GR OUP
	6425	"RTN","RCC PCFN1",28, 0)
	6426	I "W"[LTR (1) S GROU P=12,DAY=$ $GRP12(.LT R) Q DAY_ "/"_GROUP
	6427	"RTN","RCC PCFN1",29, 0)
	6428	;
	6429	"RTN","RCC PCFN1",30, 0)
	6430	Q 0
	6431	"RTN","RCC PCFN1",31, 0)
	6432	;
	6433	"RTN","RCC PCFN1",32, 0)
	6434	GRP1(LTR) ;AB
	6435	"RTN","RCC PCFN1",33, 0)
	6436	;
	6437	"RTN","RCC PCFN1",34, 0)
	6438	I LTR(1)= "A" S DAY= 1
	6439	"RTN","RCC PCFN1",35, 0)
	6440	I LTR(1)= "B" D
	6441	"RTN","RCC PCFN1",36, 0)
	6442	. I "AU"[ LTR(2) S D AY=1
	6443	"RTN","RCC PCFN1",37, 0)
	6444	. I "AU"' [LTR(2) S DAY=2
	6445	"RTN","RCC PCFN1",38, 0)
	6446	;
	6447	"RTN","RCC PCFN1",39, 0)
	6448	Q DAY
	6449	"RTN","RCC PCFN1",40, 0)
	6450	;
	6451	"RTN","RCC PCFN1",41, 0)
	6452	GRP2(LTR) ;CD
	6453	"RTN","RCC PCFN1",42, 0)
	6454	;
	6455	"RTN","RCC PCFN1",43, 0)
	6456	I LTR(1)= "D" S DAY= 4
	6457	"RTN","RCC PCFN1",44, 0)
	6458	I LTR(1)= "C" D
	6459	"RTN","RCC PCFN1",45, 0)
	6460	. I "IRU" [LTR(2) S DAY=4
	6461	"RTN","RCC PCFN1",46, 0)
	6462	. I "IRU" '[LTR(2) S DAY=6
	6463	"RTN","RCC PCFN1",47, 0)
	6464	;
	6465	"RTN","RCC PCFN1",48, 0)
	6466	Q DAY
	6467	"RTN","RCC PCFN1",49, 0)
	6468	;
	6469	"RTN","RCC PCFN1",50, 0)
	6470	GRP3(LTR) ;EFIQ
	6471	"RTN","RCC PCFN1",51, 0)
	6472	;
	6473	"RTN","RCC PCFN1",52, 0)
	6474	S DAY=7
	6475	"RTN","RCC PCFN1",53, 0)
	6476	;
	6477	"RTN","RCC PCFN1",54, 0)
	6478	Q DAY
	6479	"RTN","RCC PCFN1",55, 0)
	6480	;
	6481	"RTN","RCC PCFN1",56, 0)
	6482	GRP4(LTR) ;GH
	6483	"RTN","RCC PCFN1",57, 0)
	6484	;
	6485	"RTN","RCC PCFN1",58, 0)
	6486	I LTR(1)= "G" S DAY= 8
	6487	"RTN","RCC PCFN1",59, 0)
	6488	I LTR(1)= "H" D
	6489	"RTN","RCC PCFN1",60, 0)
	6490	. I "E"[L TR(2) S DA Y=8
	6491	"RTN","RCC PCFN1",61, 0)
	6492	. I "E"'[ LTR(2) S D AY=10
	6493	"RTN","RCC PCFN1",62, 0)
	6494	;
	6495	"RTN","RCC PCFN1",63, 0)
	6496	Q DAY
	6497	"RTN","RCC PCFN1",64, 0)
	6498	;
	6499	"RTN","RCC PCFN1",65, 0)
	6500	GRP5(LTR) ;JK
	6501	"RTN","RCC PCFN1",66, 0)
	6502	;
	6503	"RTN","RCC PCFN1",67, 0)
	6504	S DAY=12
	6505	"RTN","RCC PCFN1",68, 0)
	6506	;
	6507	"RTN","RCC PCFN1",69, 0)
	6508	Q DAY
	6509	"RTN","RCC PCFN1",70, 0)
	6510	;
	6511	"RTN","RCC PCFN1",71, 0)
	6512	GRP6(LTR) ;LO
	6513	"RTN","RCC PCFN1",72, 0)
	6514	;
	6515	"RTN","RCC PCFN1",73, 0)
	6516	S DAY=14
	6517	"RTN","RCC PCFN1",74, 0)
	6518	;
	6519	"RTN","RCC PCFN1",75, 0)
	6520	Q DAY
	6521	"RTN","RCC PCFN1",76, 0)
	6522	;
	6523	"RTN","RCC PCFN1",77, 0)
	6524	GRP7(LTR) ;MN
	6525	"RTN","RCC PCFN1",78, 0)
	6526	;
	6527	"RTN","RCC PCFN1",79, 0)
	6528	I LTR(1)= "N" S DAY= 17
	6529	"RTN","RCC PCFN1",80, 0)
	6530	I LTR(1)= "M" D
	6531	"RTN","RCC PCFN1",81, 0)
	6532	. I "CI"[ LTR(2) S D AY=17
	6533	"RTN","RCC PCFN1",82, 0)
	6534	. I "CI"' [LTR(2) S DAY=15
	6535	"RTN","RCC PCFN1",83, 0)
	6536	;
	6537	"RTN","RCC PCFN1",84, 0)
	6538	Q DAY
	6539	"RTN","RCC PCFN1",85, 0)
	6540	;
	6541	"RTN","RCC PCFN1",86, 0)
	6542	GRP8(LTR) ;T
	6543	"RTN","RCC PCFN1",87, 0)
	6544	;
	6545	"RTN","RCC PCFN1",88, 0)
	6546	I "ABCDE" [LTR(2) S DAY=19
	6547	"RTN","RCC PCFN1",89, 0)
	6548	I "FGH"[L TR(2) S DA Y=22
	6549	"RTN","RCC PCFN1",90, 0)
	6550	I "ABCDEF GH"'[LTR(2 ) S DAY=17
	6551	"RTN","RCC PCFN1",91, 0)
	6552	;
	6553	"RTN","RCC PCFN1",92, 0)
	6554	Q DAY
	6555	"RTN","RCC PCFN1",93, 0)
	6556	;
	6557	"RTN","RCC PCFN1",94, 0)
	6558	GRP9(LTR) ;R
	6559	"RTN","RCC PCFN1",95, 0)
	6560	;
	6561	"RTN","RCC PCFN1",96, 0)
	6562	S DAY=19
	6563	"RTN","RCC PCFN1",97, 0)
	6564	;
	6565	"RTN","RCC PCFN1",98, 0)
	6566	Q DAY
	6567	"RTN","RCC PCFN1",99, 0)
	6568	;
	6569	"RTN","RCC PCFN1",100 ,0)
	6570	GRP10(LTR) ;SV
	6571	"RTN","RCC PCFN1",101 ,0)
	6572	;
	6573	"RTN","RCC PCFN1",102 ,0)
	6574	I LTR(1)= "V" S DAY= 22
	6575	"RTN","RCC PCFN1",103 ,0)
	6576	I LTR(1)= "S" D
	6577	"RTN","RCC PCFN1",104 ,0)
	6578	. I "CHIM "[LTR(2) S DAY=22
	6579	"RTN","RCC PCFN1",105 ,0)
	6580	. I "CHIM "'[LTR(2) S DAY=21
	6581	"RTN","RCC PCFN1",106 ,0)
	6582	;
	6583	"RTN","RCC PCFN1",107 ,0)
	6584	Q DAY
	6585	"RTN","RCC PCFN1",108 ,0)
	6586	;
	6587	"RTN","RCC PCFN1",109 ,0)
	6588	GRP11(LTR) ;PUXYZ
	6589	"RTN","RCC PCFN1",110 ,0)
	6590	;
	6591	"RTN","RCC PCFN1",111 ,0)
	6592	S DAY=24
	6593	"RTN","RCC PCFN1",112 ,0)
	6594	;
	6595	"RTN","RCC PCFN1",113 ,0)
	6596	Q DAY
	6597	"RTN","RCC PCFN1",114 ,0)
	6598	;
	6599	"RTN","RCC PCFN1",115 ,0)
	6600	GRP12(LTR) ;W
	6601	"RTN","RCC PCFN1",116 ,0)
	6602	;
	6603	"RTN","RCC PCFN1",117 ,0)
	6604	S DAY=26
	6605	"RTN","RCC PCFN1",118 ,0)
	6606	;
	6607	"RTN","RCC PCFN1",119 ,0)
	6608	Q DAY
	6609	"RTN","RCC PCML")
	6610	0^8^B64731 204^B47881 024
	6611	"RTN","RCC PCML",1,0)
	6612	RCCPCML ;W ASH-ISC@AL TOONA,PA/L DB-Send CC PC transmi ssion ;12/ 19/96 4:16 PM
	6613	"RTN","RCC PCML",2,0)
	6614	V ;;4.5;Ac counts Rec eivable; 34,80,93,1 18,133,140 ,160,165,1 87,195,206 ,223,260,3 13;Mar 2 0,
	6615	1995;Build 150
	6616	"RTN","RCC PCML",3,0)
	6617	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	6618	"RTN","RCC PCML",4,0)
	6619	TRAN ;call from RCCP C TRANSMIT option to interacti vely allow transmiss ion of CCP C mesages
	6620	"RTN","RCC PCML",5,0)
	6621	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	6622	"RTN","RCC PCML",6,0)
	6623	N SDT,X,Y ,ZTRTN,ZTS AVE,ZTDESC ,ZTIO,IEN
	6624	"RTN","RCC PCML",7,0)
	6625	I '$D(^XU SEC("RCCPC TRANSMIT" ,DUZ)) W * 7,*7,!,"Yo u do not h ave access to do thi s." Q
	6626	"RTN","RCC PCML",8,0)
	6627	; PRCA4. 5313 - Ch eck for lo ck. If loc ked quit w ith warnin g.
	6628	"RTN","RCC PCML",9,0)
	6629	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmit ted. Try a gain later ." Q
	6630	"RTN","RCC PCML",10,0 )
	6631	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	6632	"RTN","RCC PCML",11,0 )
	6633	S DIR(0)= "DAO^^K:'$ D(^RCPS(34 9.2,""STDT "",Y)) X"
	6634	"RTN","RCC PCML",12,0 )
	6635	S DIR("A" )="Enter s tatement d ate as it will appea r on these statement s: "
	6636	"RTN","RCC PCML",13,0 )
	6637	S DIR("?" )="Enter s tatement d ate as it will appea r on these statement s or ^ to exit."
	6638	"RTN","RCC PCML",14,0 )
	6639	D ^DIR
	6640	"RTN","RCC PCML",15,0 )
	6641	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	6642	"RTN","RCC PCML",16,0 )
	6643	; PRCA4. 5313 - Ch anged to a llow for s eparate da tes for st atements b ased upon last name
	6644	"RTN","RCC PCML",17,0 )
	6645	S SDT=Y
	6646	"RTN","RCC PCML",18,0 )
	6647	; PRCA4. 5313 - Un lock prior to quitti ng
	6648	"RTN","RCC PCML",19,0 )
	6649	S IEN=$O( ^RCPS(349. 2,"STDT",S DT,0)) I ' $P($P($G(^ RCPS(349.2 ,IEN,0))," ^",10),"." ) D Q
	6650	"RTN","RCC PCML",20,0 )
	6651	. W !,"Yo ur CBSS st atement fi le (349.2) is corrup ted. Pleas e rebuild it."
	6652	"RTN","RCC PCML",21,0 )
	6653	. L -^RCP S(349.2):D ILOCKTM
	6654	"RTN","RCC PCML",22,0 )
	6655	; PRCA4. 5313 - Un lock prior to jobbin g off
	6656	"RTN","RCC PCML",23,0 )
	6657	L -^RCPS( 349.2):DIL OCKTM
	6658	"RTN","RCC PCML",24,0 )
	6659	; PRCA4. 5313 - Al lows for m ultiple st atement da tes
	6660	"RTN","RCC PCML",25,0 )
	6661	S ZTSAVE( "SDT")=SDT ,ZTRTN="RE TRAN^RCCPC ML",ZTIO=" ",ZTDESC=" Re-transmi t CBSS pat ient
	6662	statements -user act ivated"
	6663	"RTN","RCC PCML",26,0 )
	6664	D ^%ZTLOA D
	6665	"RTN","RCC PCML",27,0 )
	6666	Q
	6667	"RTN","RCC PCML",28,0 )
	6668	;
	6669	"RTN","RCC PCML",29,0 )
	6670	EN(SDT) ;c alled from backgroun d job - PR CA4.5313 Added SDT for backg round job call
	6671	"RTN","RCC PCML",30,0 )
	6672	N DA,DIK, LPRINT
	6673	"RTN","RCC PCML",31,0 )
	6674	D NOW^%DT C
	6675	"RTN","RCC PCML",32,0 )
	6676	RETRAN N I I,JJ,PTIX, DA,DIK,ERR OR,RCT,X,X 1,DEB
	6677	"RTN","RCC PCML",33,0 )
	6678	; PRCA4. 5313 - Pr ovides err or for inc omplete bu ild of 349 .2
	6679	"RTN","RCC PCML",34,0 )
	6680	S (ERROR, X)=0 F S X=$O(^RCPS (349.2,"ST DT",SDT,X) ) Q:'X I $G(^RCPS(3 49.2,X,6)) S ERROR=1 ,NM=0 D
	6681	ERROR Q
	6682	"RTN","RCC PCML",35,0 )
	6683	; PRCA4. 5313 - Ch eck for lo ck. If loc ked quit w ith Error.
	6684	"RTN","RCC PCML",36,0 )
	6685	L +^RCPS( 349.2):DIL OCKTM I '$ T S ERROR= 11,NM=0 D ERROR
	6686	"RTN","RCC PCML",37,0 )
	6687	I $G(ERRO R) D EXIT Q
	6688	"RTN","RCC PCML",38,0 )
	6689	K ^TMP($J )
	6690	"RTN","RCC PCML",39,0 )
	6691	; PRCA4. 5313 - Re moves exis ting 349 f or this da te
	6692	"RTN","RCC PCML",40,0 )
	6693	S X1=0 F S X1=$O(^ RCT(349,"S DT",+$E(SD T,6,7),X1) ) Q:X1="" I $P($G(^ RCT(349,X1 ,0)),U,2)= "PS" S
	6694	DA=X1,DIK= "^RCT(349, " D ^DIK
	6695	"RTN","RCC PCML",41,0 )
	6696	F X="PA", "IS","IT" S RCT=$O(^ RCT(349.1, "B",X,0)) I RCT K ^R CT(349.1,+ RCT,4,+$E( SDT,6,7))
	6697	"RTN","RCC PCML",42,0 )
	6698	N
	6699	%,ADD,AMT, ERROR,L,LN ,M,MSG,MCT ,MTOT,NM,P ,PD,PD0,PS N,PT,PT0,P HCT,RCM,RT Y,TAMT,TMS G,SZ,T
	6700	RDESC ; PR CA4.5313 - MPT1 no t needed
	6701	"RTN","RCC PCML",43,0 )
	6702	D DT^DICR W
	6703	"RTN","RCC PCML",44,0 )
	6704	S (ERROR, RTY)=0
	6705	"RTN","RCC PCML",45,0 )
	6706	S X=$O(^R CT(349.1," B","PS",0) )
	6707	"RTN","RCC PCML",46,0 )
	6708	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S X= $P($G(^RCT (349.1,+X, 3)),"^",3)
	6709	"RTN","RCC PCML",47,0 )
	6710	I X']"" S ERROR=6,N M=0 D ERRO R,EXIT Q
	6711	"RTN","RCC PCML",48,0 )
	6712	D PHCT I 'PHCT S ER ROR=1,NM=0 D ERROR,E XIT Q
	6713	"RTN","RCC PCML",49,0 )
	6714	S MTOT=$O (^TMP($J," MCT",""),- 1)
	6715	"RTN","RCC PCML",50,0 )
	6716	; PRCA4. 5313 - Re set MTOT a nd MCT(1) for multip le dates o n one day
	6717	"RTN","RCC PCML",51,0 )
	6718	S MCT(1)= $O(^TMP($J ,"MCT","") )
	6719	"RTN","RCC PCML",52,0 )
	6720	S MTOT=MT OT-(MCT(1) -1)
	6721	"RTN","RCC PCML",53,0 )
	6722	S MCT(1)= 0
	6723	"RTN","RCC PCML",54,0 )
	6724	S MCT=0 F S MCT=$O (^TMP($J," MCT",MCT)) Q:'MCT D PS
	6725	"RTN","RCC PCML",55,0 )
	6726	EXIT D ERR ML^RCCPCML 1
	6727	"RTN","RCC PCML",56,0 )
	6728	K SDT,^TM P($J)
	6729	"RTN","RCC PCML",57,0 )
	6730	; PRCA4. 5313 - Un lock prior to exitin g
	6731	"RTN","RCC PCML",58,0 )
	6732	L -^RCPS( 349.2):DIL OCKTM
	6733	"RTN","RCC PCML",59,0 )
	6734	Q
	6735	"RTN","RCC PCML",60,0 )
	6736	;
	6737	"RTN","RCC PCML",61,0 )
	6738	F349 ;Get PS segment entry
	6739	"RTN","RCC PCML",62,0 )
	6740	N DA,D0,D IC,DLAYGO, X
	6741	"RTN","RCC PCML",63,0 )
	6742	S ERROR=0 K DD,DO S
	6743	DIC="^RCT( 349,",DIC( 0)="L",DLA YGO=349,X= "PS."_$TR( $$FMTE^XLF DT(DT,"2D" ),"/",".") _"."_RCM D
	6744	FILE^DICN
	6745	"RTN","RCC PCML",64,0 )
	6746	I Y<0 S R TY=RTY+1 G F349:RTY< 4 S ERROR= 2,NM=0 D E RROR Q
	6747	"RTN","RCC PCML",65,0 )
	6748	S PSN=+Y
	6749	"RTN","RCC PCML",66,0 )
	6750	Q
	6751	"RTN","RCC PCML",67,0 )
	6752	;
	6753	"RTN","RCC PCML",68,0 )
	6754	PS ;Build PS,PH,PD s egments an d messages
	6755	"RTN","RCC PCML",69,0 )
	6756	S PSN=$O( ^TMP($J,"M CT",MCT,0) )
	6757	"RTN","RCC PCML",70,0 )
	6758	; PRCA4. 5313 - In crement Co unter for internal s torage
	6759	"RTN","RCC PCML",71,0 )
	6760	S MCT(1)= MCT(1)+1
	6761	"RTN","RCC PCML",72,0 )
	6762	; PRCA4. 5313 - Up date to ne w formatti ng
	6763	"RTN","RCC PCML",73,0 )
	6764	S
	6765	$P(^RCT(34 9,+PSN,0), "^",3,10)= MCT(1)_"^" _MTOT_"^"_ $$SITE^RCM SITE()_"^" _$$FP^RCCP CFN_"^"_+^
	6766	TMP($J,"MC T",MCT)_"^ "_$P(^TMP( $J,"MCT",M CT),"^",2) _"^"_$$DAT ^RCCPCFN(S DT)_"^"_$$ DAT^RCCP
	6767	CFN(DT)
	6768	"RTN","RCC PCML",74,0 )
	6769	S LN=+PSN ,^TMP($J," MSG",LN)=$ P($G(^RCT( 349,+PSN,0 )),"^",2,1 0)_"^\|"
	6770	"RTN","RCC PCML",75,0 )
	6771	; Reforma t Statemen t Date to Internal F ormat
	6772	"RTN","RCC PCML",76,0 )
	6773	S $P(^RCT (349,+PSN, 0),"^",9)= SDT
	6774	"RTN","RCC PCML",77,0 )
	6775	; PRCA4. 5313/JG - Not neede d (Getting PT from ^ TMP($J,"PS ",MCT,I)
	6776	"RTN","RCC PCML",78,0 )
	6777	S PTIX=0
	6778	"RTN","RCC PCML",79,0 )
	6779	F S PTIX =$O(^TMP($ J,"PS",MCT ,PTIX)) Q: PTIX="" S PT=^(PTIX ) D ; PRC A4.5313/ JG - Retri eved PT's
	6780	from ^TMP( $J,"PS"... ), not ^RC PS
	6781	"RTN","RCC PCML",80,0 )
	6782	.S PT0=^R CPS(349.2, +PT,0)
	6783	"RTN","RCC PCML",81,0 )
	6784	. ; PRCA* 4.5*313 - Set DEB fr om PTO
	6785	"RTN","RCC PCML",82,0 )
	6786	. S DEB=$ P(PT0,"^")
	6787	"RTN","RCC PCML",83,0 )
	6788	.S LN=LN+ 1 S
	6789	^TMP($J,"M SG",LN)="P H^"_$$SITE ^RCMSITE_$ $KEY^RCCPC FN(+PT)_"^ "_$$NM^RCC PCFN(+PT)_ "^"
	6790	"RTN","RCC PCML",84,0 )
	6791	.S ADD=$G (^RCPS(349 .2,+PT,1))
	6792	"RTN","RCC PCML",85,0 )
	6793	.;
	6794	"RTN","RCC PCML",86,0 )
	6795	.;Remove special ch aracters c ausing pro blems (WIM -0402-2072 8)
	6796	"RTN","RCC PCML",87,0 )
	6797	.I ADD["~ " S ADD=$T R(ADD,"~", "") ;Remov e tilde
	6798	"RTN","RCC PCML",88,0 )
	6799	.I ADD["\| " S ADD=$T R(ADD,"\|", "") ;Remov e the pipe symbol
	6800	"RTN","RCC PCML",89,0 )
	6801	.;
	6802	"RTN","RCC PCML",90,0 )
	6803	.;Debtor needs larg e print (f ont) IF LP RINT=1
	6804	"RTN","RCC PCML",91,0 )
	6805	.S LPRINT =$G(^RCPS( 349.2,+PT, 7)) S:LPRI NT="" LPRI NT=0
	6806	"RTN","RCC PCML",92,0 )
	6807	.;
	6808	"RTN","RCC PCML",93,0 )
	6809	.; PRCA4 .5313/JG - Simplifi ed logic
	6810	"RTN","RCC PCML",94,0 )
	6811	.F P=1:1: 7 S $P(^TM P($J,"MSG" ,LN),"^",P +5)=$P(ADD ,"^",P)
	6812	"RTN","RCC PCML",95,0 )
	6813	.S ^TMP($ J,"MSG",LN )=^TMP($J, "MSG",LN)_ "^"
	6814	"RTN","RCC PCML",96,0 )
	6815	.S LN=LN+ 1
	6816	"RTN","RCC PCML",97,0 )
	6817	.F X=4:1: 8 S $P(AMT ,"^",X-3)= $$HEX^RCCP CFN($P(PT0 ,"^",X))
	6818	"RTN","RCC PCML",98,0 )
	6819	.S
	6820	^TMP($J,"M SG",LN)=AM T_"^"_$G(^ RCPS(349.2 ,+PT,3))_" ^"_$G(^RCP S(349.2,+P T,4))_"^"_ $O(^RCPS(3 4
	6821	9.2,+PT,2, ""),-1)
	6822	"RTN","RCC PCML",99,0 )
	6823	.S LN=LN+ 1 I $P($G( ^RCD(340,+ DEB,0)),"; ") S
	6824	^TMP($J,"M SG",LN)="^ "_$$SITE^R CMSITE_$$R J^XLFSTR($ TR($P(^RCD (340,+DEB, 0),";"),". ",""),13,0 )
	6825	"RTN","RCC PCML",100, 0)
	6826	.; PRCA5 .4313 - S et ICN wit h Checksum , AR Flag, and Date of Latest Bill ino P H data
	6827	"RTN","RCC PCML",101, 0)
	6828	.N PT8 S PT8=$G(^RC PS(349.2,+ PT,8))
	6829	"RTN","RCC PCML",102, 0)
	6830	.S
	6831	^TMP($J,"M SG",LN)=$G (^TMP($J," MSG",LN))_ "^"_LPRINT _"^"_$P(PT 8,"^")_"V" _$P(PT8,"^ ",2,3)_"^" _$$
	6832	DAT^RCCPCF N($P(PT8," ^",4))_"^\| "
	6833	"RTN","RCC PCML",103, 0)
	6834	.S $P(^RC PS(349.2,+ PT,0),"^", 11)=+PSN
	6835	"RTN","RCC PCML",104, 0)
	6836	.S PD=0 F S PD=$O( ^RCPS(349. 2,+PT,2,PD )) Q:'PD I $D(^(PD, 0)) S PD0= ^(0) D
	6837	"RTN","RCC PCML",105, 0)
	6838	..S AMT(0 )=$$HEX^RC CPCFN($P(P D0,"^",3))
	6839	"RTN","RCC PCML",106, 0)
	6840	..;Replac e special characters causing p roblem (PR CA*260)
	6841	"RTN","RCC PCML",107, 0)
	6842	..S TRDES C=$P(PD0," ^",2)
	6843	"RTN","RCC PCML",108, 0)
	6844	..; PRCA* 4.5*313/JG - Simplif y code to replace ti lde and pi pe symbols
	6845	"RTN","RCC PCML",109, 0)
	6846	..F II="~ ","\|" I TR DESC[II S TRDESC=$TR (TRDESC,II ," ")
	6847	"RTN","RCC PCML",110, 0)
	6848	..S
	6849	LN=LN+1,^T MP($J,"MSG ",LN)="PD^ "_$$DAT^RC CPCFN(+PD0 )_"^"_TRDE SC_"^"_AMT (0)_"^"_$P (PD0,"^
	6850	",4)_"^\|"
	6851	"RTN","RCC PCML",111, 0)
	6852	S LN=LN+1 ,^TMP($J," MSG",LN)=" ~"
	6853	"RTN","RCC PCML",112, 0)
	6854	; PRCA4. 5313 - Se t all cros s-referenc es for Fil e
	6855	"RTN","RCC PCML",113, 0)
	6856	S DA=+PSN ,DIK="^RCT (349," D I X1^DIK
	6857	"RTN","RCC PCML",114, 0)
	6858	;
	6859	"RTN","RCC PCML",115, 0)
	6860	MAIL ;set up mail me ssage
	6861	"RTN","RCC PCML",116, 0)
	6862	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	6863	"RTN","RCC PCML",117, 0)
	6864	S XMSUB=$ $SITE^RCMS ITE()_" CB SS TRANSMI SSION "_SD T
	6865	"RTN","RCC PCML",118, 0)
	6866	S XMDUZ=" AR PACKAGE "
	6867	"RTN","RCC PCML",119, 0)
	6868	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS","" )),$P($G(^ RC(342,1,0 )),"^",12) S XMY("G. RCCPC
	6869	STATEMENTS ")=""
	6870	"RTN","RCC PCML",120, 0)
	6871	S X=$O(^R CT(349.1," B","PS",0) )
	6872	"RTN","RCC PCML",121, 0)
	6873	I X,$P($G (^RCT(349. 1,+X,0))," ^",3) S
	6874	X=$P($G(^R CT(349.1,+ X,3)),"^") _"@"_$P($G (^RCT(349. 1,+X,3))," ^",3) S:$P (X,"@",2)] "" XMY(X)= ""
	6875	"RTN","RCC PCML",122, 0)
	6876	I $P(X,"@ ",2)']"" D Q
	6877	"RTN","RCC PCML",123, 0)
	6878	.S ERROR= 6,NM=0 D E RROR
	6879	"RTN","RCC PCML",124, 0)
	6880	S XMDUZ=" AR PACKAGE "
	6881	"RTN","RCC PCML",125, 0)
	6882	D XMZ^XMA 2
	6883	"RTN","RCC PCML",126, 0)
	6884	I XMZ<1 S RTY=RTY+1 G MAIL:RT Y<4 S ERRO R=5,NM=0 D ERROR Q
	6885	"RTN","RCC PCML",127, 0)
	6886	S $P(^RCT (349,+PSN, 0),"^",11, 12)=DT_"^" _XMZ
	6887	"RTN","RCC PCML",128, 0)
	6888	S (L,L(1) )=0 F S L (1)=$O(^TM P($J,"MSG" ,L(1))) Q: 'L(1) S
	6889	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P($J,"MSG" ,L(1)) ; P RCA4.531 3
	6890	"RTN","RCC PCML",129, 0)
	6891	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_"^"_L_" ^"_DT
	6892	"RTN","RCC PCML",130, 0)
	6893	D ENT1^XM D
	6894	"RTN","RCC PCML",131, 0)
	6895	D NOW^%DT C
	6896	"RTN","RCC PCML",132, 0)
	6897	S $P(^RCT (349,+PSN, 0),"^",11, 12)=%_"^"_ XMZ
	6898	"RTN","RCC PCML",133, 0)
	6899	K ^TMP($J ,"MSG")
	6900	"RTN","RCC PCML",134, 0)
	6901	Q
	6902	"RTN","RCC PCML",135, 0)
	6903	;
	6904	"RTN","RCC PCML",136, 0)
	6905	PHCT ;PH c ount
	6906	"RTN","RCC PCML",137, 0)
	6907	S (ERROR, PT,PHCT,TA MT,SZ)=0,R CM=1 ; PRC A4.5313/ JG - Delet ed ERRCTR( )
	6908	"RTN","RCC PCML",138, 0)
	6909	; PRCA4. 5313 - If last reco rd is for this date reset RCM to next va lue
	6910	"RTN","RCC PCML",139, 0)
	6911	S II=$O(^ RCT(349,"@ "),-1)
	6912	"RTN","RCC PCML",140, 0)
	6913	I II,$P($ P(^RCT(349 ,II,0),"^" ),".",2,4) =$TR($$FMT E^XLFDT(DT ,"2D"),"/" ,".") S
	6914	RCM=$P($P( ^RCT(349,I I,0),"^"), ".",5)+1
	6915	"RTN","RCC PCML",141, 0)
	6916	F S PT=$ O(^RCPS(34 9.2,"STDT" ,SDT,PT)) Q:'PT S E RROR=0 D I ERROR,(E RROR<3) Q
	6917	"RTN","RCC PCML",142, 0)
	6918	.; PRCA4 .5313 - S et DEB to Debtor num ber
	6919	"RTN","RCC PCML",143, 0)
	6920	.S DEB=$P ($G(^RCPS( 349.2,PT,0 )),"^")
	6921	"RTN","RCC PCML",144, 0)
	6922	.S SZ(1)= 0 D ERRCHK Q:ERROR ; PRCA4.5 313/JG - Deleted ER RCTR()
	6923	"RTN","RCC PCML",145, 0)
	6924	.S PT0=^R CPS(349.2, +PT,0)
	6925	"RTN","RCC PCML",146, 0)
	6926	.S PHCT=P HCT+1
	6927	"RTN","RCC PCML",147, 0)
	6928	.S SZ=550 +SZ,SZ(1)= 550
	6929	"RTN","RCC PCML",148, 0)
	6930	.; PRCA4 .5313/JG - Shortene d code
	6931	"RTN","RCC PCML",149, 0)
	6932	.F II=1,3 ,4 I $G(^R CPS(349.2, +PT,II))]" " D
	6933	"RTN","RCC PCML",150, 0)
	6934	..S JJ=$S (II=1:0,1: 1) ; PRCA* 4.5*313/JG - Simplif y code: I f II=1, re turn 0; ot herwise, r eturn 1
	6935	"RTN","RCC PCML",151, 0)
	6936	..S SZ=SZ +$L(^(II)) +JJ,SZ(1)= SZ(1)+$L(^ (II))+JJ
	6937	"RTN","RCC PCML",152, 0)
	6938	.S X=0 F S X=$O(^R CPS(349.2, +PT,2,X)) Q:'X I $D (^(X,0)) S SZ=$L(^(0 ))+SZ,SZ(1 )=SZ(1)+$L (^(0))
	6939	"RTN","RCC PCML",153, 0)
	6940	.S TAMT=T AMT+$P(^RC PS(349.2,+ PT,0),"^", 8)
	6941	"RTN","RCC PCML",154, 0)
	6942	.I SZ>270 00 D
	6943	"RTN","RCC PCML",155, 0)
	6944	..S RTY=0 D F349 Q: ERROR
	6945	"RTN","RCC PCML",156, 0)
	6946	..S TAMT= TAMT-$P(PT 0,"^",8)
	6947	"RTN","RCC PCML",157, 0)
	6948	..S TAMT= $$HEX^RCCP CFN(TAMT)
	6949	"RTN","RCC PCML",158, 0)
	6950	..; PRCA* 4.5*313/JG - Deleted ERRCTR()
	6951	"RTN","RCC PCML",159, 0)
	6952	..S ^TMP( $J,"MCT",R CM)=(PHCT- 1)_"^"_TAM T_"^"_$O(^ RCPS(349.2 ,"STDT",SD T,PT),-1)_ "^"_(SZ-SZ (1)) ;
	6953	prca
	6954	"RTN","RCC PCML",160, 0)
	6955	..;
	6956	"RTN","RCC PCML",161, 0)
	6957	..S ^TMP( $J,"MCT",R CM,+PSN)=" "
	6958	"RTN","RCC PCML",162, 0)
	6959	..S RCM=R CM+1,PHCT= 1
	6960	"RTN","RCC PCML",163, 0)
	6961	..; PRCA* 4.5*313/JG - Deleted ERRCTR() [Commented out line]
	6962	"RTN","RCC PCML",164, 0)
	6963	..S SZ=SZ (1)
	6964	"RTN","RCC PCML",165, 0)
	6965	..S TAMT= $P(PT0,"^" ,8)
	6966	"RTN","RCC PCML",166, 0)
	6967	..;
	6968	"RTN","RCC PCML",167, 0)
	6969	.; PRCA4 .5313/DM - Store PT in ^TMP($ J,"PS",RCM ,PHCT)=PT instead of ^RCPS(349 .2,"STDT", SDT,PT)
	6970	"RTN","RCC PCML",168, 0)
	6971	.S ^TMP($ J,"PS",RCM ,PHCT)=PT
	6972	"RTN","RCC PCML",169, 0)
	6973	I 'PT,$O( ^RCPS(349. 2,"STDT",S DT,0)) D
	6974	"RTN","RCC PCML",170, 0)
	6975	.S RTY=0 D F349 Q:E RROR S
	6976	^TMP($J,"M CT",RCM)=P HCT_"^"_$$ HEX^RCCPCF N(TAMT)_"^ "_$O(^RCPS (349.2,"ST DT",SDT,PT ),-1)
	6977	"RTN","RCC PCML",171, 0)
	6978	.S ^TMP($ J,"MCT",RC M,+PSN)=""
	6979	"RTN","RCC PCML",172, 0)
	6980	Q
	6981	"RTN","RCC PCML",173, 0)
	6982	;
	6983	"RTN","RCC PCML",174, 0)
	6984	ERROR ;ERR OR FILE
	6985	"RTN","RCC PCML",175, 0)
	6986	I NM=0 S ^TMP($J,"E RROR",ERRO R,NM)="" Q
	6987	"RTN","RCC PCML",176, 0)
	6988	N SSN
	6989	"RTN","RCC PCML",177, 0)
	6990	S SSN=$$S SN^RCFN01( +DEB)
	6991	"RTN","RCC PCML",178, 0)
	6992	I SSN'=-1 S ^TMP($J ,"ERROR",E RROR,NM,SS N)=""
	6993	"RTN","RCC PCML",179, 0)
	6994	Q
	6995	"RTN","RCC PCML",180, 0)
	6996	;
	6997	"RTN","RCC PCML",181, 0)
	6998	ERRCHK ;Er ror check
	6999	"RTN","RCC PCML",182, 0)
	7000	I '$D(^RC PS(349.2,+ PT,0)) S E RROR=1,NM= 0 D ERROR Q
	7001	"RTN","RCC PCML",183, 0)
	7002	S PT(1)=P T,PT=$O(^R CPS(349.2, "STDT",SDT ,0)) I '$P (^RCPS(349 .2,PT,0)," ^",18) S E RROR=1,NM= 0 D
	7003	ERROR S PT =PT(1) Q
	7004	"RTN","RCC PCML",184, 0)
	7005	S PT=PT(1 )
	7006	"RTN","RCC PCML",185, 0)
	7007	I $$KEY^R CCPCFN(+PT )']"" S ER ROR=4,NM=$ $NAM^RCFN0 1(+DEB) D ERROR S
	7008	^TMP($J,"E RRPT",+PT) ="" Q
	7009	"RTN","RCC PCML",186, 0)
	7010	I '$D(^RC PS(349.2," AKEY",$$KE Y^RCCPCFN( +PT))) S E RROR=4,NM= $$NAM^RCFN 01(+DEB) D ERROR S
	7011	^TMP($J,"E RRPT",+PT) ="" Q
	7012	"RTN","RCC PCML",187, 0)
	7013	S ADD=$G( ^RCPS(349. 2,+PT,1))
	7014	"RTN","RCC PCML",188, 0)
	7015	F P=1:1:7 S ADD(P)= $P(ADD,"^" ,P)
	7016	"RTN","RCC PCML",189, 0)
	7017	;I (ADD(1 )="")!(ADD (4)="")!(A DD(5)="")! ((ADD(6)=" ")&(ADD(7) ="")) S
	7018	ERROR=8,NM =$$NAM^RCF N01(+DEB) D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	7019	"RTN","RCC PCML",190, 0)
	7020	;I ADD(1) ="",ADD(2) ="",ADD(3) ="",ADD(4) ="",ADD(5) ="",ADD(6) ="" S
	7021	ERROR=8,NM =$$NAM^RCF N01(+DEB) D ERROR S ^TMP($J,"E RRPT",+PT) ="" Q
	7022	"RTN","RCC PCML",191, 0)
	7023	;I ADD(1) ="",(ADD(2 )=""),(ADD (3)=""),(A DD(6)="") S ERROR=8, NM=$$NAM^R CFN01(+DEB ) D ERROR S
	7024	^TMP($J,"E RRPT",+PT) ="" Q
	7025	"RTN","RCC PCML",192, 0)
	7026	;I ADD(4) =""!(ADD(5 )="")!(ADD (6)="") S ERROR=8,NM =$$NAM^RCF N01(+DEB) D ERROR S
	7027	^TMP($J,"E RRPT",+PT) =""
	7028	"RTN","RCC PCML",193, 0)
	7029	F ADD=1:1 :6 I ADD(A DD)'?.ANP S ERROR=10 ,NM=$$NAM^ RCFN01(+DE B),^TMP($J ,"ERRPT",+ PT)="" D
	7030	ERROR Q
	7031	"RTN","RCC PCML",194, 0)
	7032	;I $P($G( ^RCD(340,+ DEB,1)),"^ ",9) S ^TM P($J,"ERRP T",+PT)="" ,ERROR=9,N M=$$NAM^RC FN01(+DEB) D
	7033	ERROR
	7034	"RTN","RCC PCML",195, 0)
	7035	Q
	7036	"RTN","RCC PCML1")
	7037	0^13^B1607 9778^B6682 335
	7038	"RTN","RCC PCML1",1,0 )
	7039	RCCPCML1 ; ALB@ALTOON A,PA/LDB - Send CCPC transmiss ion (cont. ) ;8/25/00 4:16 PM
	7040	"RTN","RCC PCML1",2,0 )
	7041	V ;;4.5;Ac counts Rec eivable; 160,313; Mar 20, 19 95;Build 1 50
	7042	"RTN","RCC PCML1",3,0 )
	7043	;;Per VA Directive 6402, this routine s hould not be modifie d.
	7044	"RTN","RCC PCML1",4,0 )
	7045	ERRML ;ERR OR MESSAGE S
	7046	"RTN","RCC PCML1",5,0 )
	7047	N CT,ERRO R,LN,PT,SP ,XMDUZ,XMT EXT,XMSUB, XMY
	7048	"RTN","RCC PCML1",6,0 )
	7049	K ^TMP($J ,"ERRMSG")
	7050	"RTN","RCC PCML1",7,0 )
	7051	S (ERROR, LN)=0 F S ERROR=$O( ^TMP($J,"E RROR",ERRO R)) Q:'ERR OR D
	7052	"RTN","RCC PCML1",8,0 )
	7053	. ; PRCA* 4.5*313 - Add header identifyi ng the Sta tement Dat e
	7054	"RTN","RCC PCML1",9,0 )
	7055	. I LN=0 S LN=LN+1 D
	7056	"RTN","RCC PCML1",10, 0)
	7057	. . N Y
	7058	"RTN","RCC PCML1",11, 0)
	7059	. . S Y=S DT X ^DD(" DD")
	7060	"RTN","RCC PCML1",12, 0)
	7061	. . S ^TM P($J,"ERRM SG",LN)="E RRORS FOR PATIENT ST ATEMENT DA TE: "_Y
	7062	"RTN","RCC PCML1",13, 0)
	7063	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7064	"RTN","RCC PCML1",14, 0)
	7065	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=$$RTN MSG(ERROR)
	7066	"RTN","RCC PCML1",15, 0)
	7067	.S LN=LN+ 1 S ^TMP($ J,"ERRMSG" ,LN)=" "
	7068	"RTN","RCC PCML1",16, 0)
	7069	.S CT=0,P T="" F S PT=$O(^TMP ($J,"ERROR ",ERROR,PT )) Q:PT="" D
	7070	"RTN","RCC PCML1",17, 0)
	7071	..S CT=CT +1,LN=LN+1
	7072	"RTN","RCC PCML1",18, 0)
	7073	..I PT=0 S ^TMP($J, "ERRMSG",L N)=" " Q
	7074	"RTN","RCC PCML1",19, 0)
	7075	..N Y I P T'=0 D
	7076	"RTN","RCC PCML1",20, 0)
	7077	...S PT(1 )="" F S PT(1)=$O(^ TMP($J,"ER ROR",ERROR ,PT,PT(1)) ) Q:PT(1)= "" D
	7078	"RTN","RCC PCML1",21, 0)
	7079	....S ^TM P($J,"ERRM SG",LN)=$S ($L(CT)<2: " "_CT,1:C T)_". "
	7080	"RTN","RCC PCML1",22, 0)
	7081	....S SP= " ",Y=PT,Y= PT_$E(SP,$ L(PT),30)
	7082	"RTN","RCC PCML1",23, 0)
	7083	....S ^TM P($J,"ERRM SG",LN)=^T MP($J,"ERR MSG",LN)_Y _PT(1)
	7084	"RTN","RCC PCML1",24, 0)
	7085	S XMDUZ=" AR PACKAGE "
	7086	"RTN","RCC PCML1",25, 0)
	7087	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= ""
	7088	"RTN","RCC PCML1",26, 0)
	7089	E S XMY( $G(DUZ))=" "
	7090	"RTN","RCC PCML1",27, 0)
	7091	; PRCA4. 5313 - Ch ange CCPC to CBSS an d add Stat ement Date
	7092	"RTN","RCC PCML1",28, 0)
	7093	N Y S Y=S DT D DD^%D T S SDT=Y
	7094	"RTN","RCC PCML1",29, 0)
	7095	S XMSUB=" CBSS ERROR S FOUND DU RING TRANS MISSION"
	7096	"RTN","RCC PCML1",30, 0)
	7097	S XMTEXT= "^TMP($J," "ERRMSG"", "
	7098	"RTN","RCC PCML1",31, 0)
	7099	D ^XMD
	7100	"RTN","RCC PCML1",32, 0)
	7101	K ^TMP($J ,"ERRMSG")
	7102	"RTN","RCC PCML1",33, 0)
	7103	Q
	7104	"RTN","RCC PCML1",34, 0)
	7105	;
	7106	"RTN","RCC PCML1",35, 0)
	7107	LT(X) ;lef t trim; ex pecting va riable by reference
	7108	"RTN","RCC PCML1",36, 0)
	7109	Q:'$D(X)
	7110	"RTN","RCC PCML1",37, 0)
	7111	F Q:$E(X ,1)'=" "!( X="") S X =$E(X,2,$L (X))
	7112	"RTN","RCC PCML1",38, 0)
	7113	Q
	7114	"RTN","RCC PCML1",39, 0)
	7115	;
	7116	"RTN","RCC PCML1",40, 0)
	7117	TRIMDEB(DE BADD) ;lef t trim add ress compo nents retu rned from $$DADD^RCA MADD ;
	7118	A1^A2^a3^c ity^state^ zip^phone^ fcc
	7119	"RTN","RCC PCML1",41, 0)
	7120	N A1,A2,A 3,CITY,STA TE,ZIP,PHO NE,FCC
	7121	"RTN","RCC PCML1",42, 0)
	7122	I '$D(DEB ADD) Q ""
	7123	"RTN","RCC PCML1",43, 0)
	7124	S
	7125	A1=$P(DEBA DD,U,1),A2 =$P(DEBADD ,U,2),A3=$ P(DEBADD,U ,3),CITY=$ P(DEBADD,U ,4),STATE= $P(DEBAD
	7126	D,U,5)
	7127	"RTN","RCC PCML1",44, 0)
	7128	S ZIP=$P( DEBADD,U,6 ),PHONE=$P (DEBADD,U, 7),FCC=$P( DEBADD,U,8 )
	7129	"RTN","RCC PCML1",45, 0)
	7130	D LT(.A1) D LT(.A2) D LT(.A3) D LT(.CIT Y) D LT(.S TATE) D LT (.ZIP) D L T(.PHONE) D LT(.FCC)
	7131	"RTN","RCC PCML1",46, 0)
	7132	Q A1_U_A2 _U_A3_U_CI TY_U_STATE _U_ZIP_U_P HONE_U_FCC
	7133	"RTN","RCC PCML1",47, 0)
	7134	;
	7135	"RTN","RCC PCML1",48, 0)
	7136	CHKDEB(DEB ADD) ; che ck for a p opulated d ebtor addr ess ; A1^A 2^a3^city^ state^zip^ phone^fcc
	7137	"RTN","RCC PCML1",49, 0)
	7138	N A1,CITY ,STATE,ZIP ,FCC
	7139	"RTN","RCC PCML1",50, 0)
	7140	I '$D(DEB ADD) Q 0
	7141	"RTN","RCC PCML1",51, 0)
	7142	S
	7143	A1=$P(DEBA DD,U,1),CI TY=$P(DEBA DD,U,4),ST ATE=$P(DEB ADD,U,5),Z IP=$P(DEBA DD,U,6),FC C=$P(DEBA
	7144	DD,U,8)
	7145	"RTN","RCC PCML1",52, 0)
	7146	D LT(.A1) D LT(.CIT Y) D LT(.S TATE) D LT (.ZIP) D L T(.FCC)
	7147	"RTN","RCC PCML1",53, 0)
	7148	I (A1'="" ),(CITY'=" "),(STATE' =""),((ZIP '="")!(FCC '="")) Q 1 ;populat ed
	7149	"RTN","RCC PCML1",54, 0)
	7150	Q 0
	7151	"RTN","RCC PCML1",55, 0)
	7152	;
	7153	"RTN","RCC PCML1",56, 0)
	7154	RTNMSG(NUM ) ; PRCA4 .5313/JG - Given me ssage numb er, return with mess age
	7155	"RTN","RCC PCML1",57, 0)
	7156	Q $P($T(E RRMSG+NUM) ,";;",2)
	7157	"RTN","RCC PCML1",58, 0)
	7158	;
	7159	"RTN","RCC PCML1",59, 0)
	7160	ERRMSG ;E rror messa ges PRCA 4.5313 - Change CC PC to CBSS / PRCA4. 5313/JG - Added err or #12
	7161	"RTN","RCC PCML1",60, 0)
	7162	1 ;;CBSS t ransmissio n process found no r ecords or an incompl ete file. Contact IR M.
	7163	"RTN","RCC PCML1",61, 0)
	7164	2 ;;No CBS S transmis sion recor ds transmi tted. Chec k file 349 . Contact IRM.
	7165	"RTN","RCC PCML1",62, 0)
	7166	3 ;;Corrup ted PH seg ment has b een encoun tered for the follow ing patien t(s):
	7167	"RTN","RCC PCML1",63, 0)
	7168	4 ;;No key field in CBSS file for the fo llowing pa tient(s):
	7169	"RTN","RCC PCML1",64, 0)
	7170	5 ;;Mailma n message creation a borted. Pl ease conta ct IRM.
	7171	"RTN","RCC PCML1",65, 0)
	7172	6 ;;No tra nsmission sent. Defi ne REMOTE DOMAIN in AR TRANSMI SSION TYPE file (349 .1).
	7173	"RTN","RCC PCML1",66, 0)
	7174	7 ;;Print Acknowledg ements exi st. Transm ission can not be res ent.
	7175	"RTN","RCC PCML1",67, 0)
	7176	8 ;;Addres s informat ion is mis sing for t he followi ng patient (s):
	7177	"RTN","RCC PCML1",68, 0)
	7178	9 ;;Addres s is marke d as ADDRE SS UNKNOWN for the f ollowing p atient(s):
	7179	"RTN","RCC PCML1",69, 0)
	7180	10 ;;Corru pted Addre ss. Re-ent er address informati on for the following patient(s ):
	7181	"RTN","RCC PCML1",70, 0)
	7182	11 ;;File did not bu ild or tra nsmit due to another build or transmissi on running .
	7183	"RTN","RCC PCML1",71, 0)
	7184	12 ;;Date chosen was prior to installati on of PRCA 4.5313 a nd structu re has cha nged.
	7185	"RTN","RCC PCML1",72, 0)
	7186	Q ;ASF
	7187	"RTN","RCC PCML1",73, 0)
	7188	;;[BEGIN EDIT,ASF,1 2/31/18, P RCA4.531 3]
	7189	"RTN","RCC PCML1",74, 0)
	7190	STMTDAYS() ; List of statement run days
	7191	"RTN","RCC PCML1",75, 0)
	7192	Q ",1,2,4 ,6,7,8,10, 12,14,15,1 7,19,21,22 ,24,26,"
	7193	"RTN","RCC PCML1",76, 0)
	7194	;
	7195	"RTN","RCC PCML1",77, 0)
	7196	; 1 A,BA, BU
	7197	"RTN","RCC PCML1",78, 0)
	7198	; 2 B EXC LUDE (BA,B U)
	7199	"RTN","RCC PCML1",79, 0)
	7200	; 4 CI,CR ,CU,D
	7201	"RTN","RCC PCML1",80, 0)
	7202	; 6 C EXC LUDE (CI,C R,CU)
	7203	"RTN","RCC PCML1",81, 0)
	7204	; 7 E,F,I ,Q
	7205	"RTN","RCC PCML1",82, 0)
	7206	; 8 G,HE
	7207	"RTN","RCC PCML1",83, 0)
	7208	;10 H EXC LUDE HE
	7209	"RTN","RCC PCML1",84, 0)
	7210	;12 J,K
	7211	"RTN","RCC PCML1",85, 0)
	7212	;14 L,O
	7213	"RTN","RCC PCML1",86, 0)
	7214	;15 M EXC LUDE (MC,M I)
	7215	"RTN","RCC PCML1",87, 0)
	7216	;17 MC,MI ,N,TI-TZ
	7217	"RTN","RCC PCML1",88, 0)
	7218	;19 R,TA- TE
	7219	"RTN","RCC PCML1",89, 0)
	7220	;21 S EXC LUDE (SC,S H,SI,SM)
	7221	"RTN","RCC PCML1",90, 0)
	7222	;22 SC,SH ,SI,SM,TF- TH,V
	7223	"RTN","RCC PCML1",91, 0)
	7224	;24 P,U,X ,Y,Z
	7225	"RTN","RCC PCML1",92, 0)
	7226	;26 W
	7227	"RTN","RCC PCPS")
	7228	0^10^B2076 83636^B808 98915
	7229	"RTN","RCC PCPS",1,0)
	7230	RCCPCPS ;W ASH-ISC@AL TOONA,PA/N YB-Build P atient Sta tement Fil e ;12/19/9 6 4:14 PM
	7231	"RTN","RCC PCPS",2,0)
	7232	;;4.5;Acc ounts Rece ivable;3 4,70,80,48 ,104,116,1 49,170,181 ,190,223,2 37,219,265 ,301,313 ;Mar
	7233	20,1995;Bu ild 150
	7234	"RTN","RCC PCPS",3,0)
	7235	;;Per VHA Directive 6402, thi s routine should not be modifi ed.
	7236	"RTN","RCC PCPS",4,0)
	7237	;DBIA#101 41
	7238	"RTN","RCC PCPS",5,0)
	7239	;DBIA#101 13
	7240	"RTN","RCC PCPS",6,0)
	7241	;DBIA#101 11
	7242	"RTN","RCC PCPS",7,0)
	7243	;DBIA#100 61
	7244	"RTN","RCC PCPS",8,0)
	7245	EN(SDT) ; PRCA4.5 313 - For use when c alled by B ackground Job
	7246	"RTN","RCC PCPS",9,0)
	7247	;
	7248	"RTN","RCC PCPS",10,0 )
	7249	EN1 ;FOR U SE WHEN BU ILDING PS FILE (SDT MUST BE AV AILABLE AS A LOCAL V ARIABLE)
	7250	"RTN","RCC PCPS",11,0 )
	7251	; D STDT PRCA4.53 13/DM move d to OPEN^ RCCPCBJ in v20
	7252	"RTN","RCC PCPS",12,0 )
	7253	N
	7254	CCPC,CNT,D EB,DIK,END ,INADFL,LD T1,LDT3,PC C,PRN,RCDA TE,RCT,SVA DM,SVAMT,S VINT,SVOTH ,SITE,TXT
	7255	,VAR,X,%,E RROR,NM
	7256	"RTN","RCC PCPS",13,0 )
	7257	N OLDID,E RRLN,PATNA ME,PATSSN, PNMSSN,RCI NFULL,RCIN PART
	7258	"RTN","RCC PCPS",14,0 )
	7259	; PRCA4. 5313/JG D o not proc eed with d ate prior to 1st ins tallation of PRCA4. 5313
	7260	"RTN","RCC PCPS",15,0 )
	7261	Q:$$CHK31 3(0,SDT) ; PRCA4.5 313/JG - Check stat ement date against v irgin inst all date o f
	7262	PRCA4.53 13
	7263	"RTN","RCC PCPS",16,0 )
	7264	S (COMM,E RRLN)=0,OL DID=""
	7265	"RTN","RCC PCPS",17,0 )
	7266	K ^TMP("M SG",$J)
	7267	"RTN","RCC PCPS",18,0 )
	7268	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7269	"RTN","RCC PCPS",19,0 )
	7270	L +^RCPS( 349.2):DIL OCKTM I '$ T D Q
	7271	"RTN","RCC PCPS",20,0 )
	7272	. D NOW^% DTC S Y=% D DD^%DT
	7273	"RTN","RCC PCPS",21,0 )
	7274	. W Y W ! !,"Another date is b eing run o r transmit ted. Try again late r."
	7275	"RTN","RCC PCPS",22,0 )
	7276	. S ERROR =11,NM=0 D ERROR^RCC PCML,ERRML ^RCCPCML1
	7277	"RTN","RCC PCPS",23,0 )
	7278	; PRCA4. 5313 - Cl ear data f or date be ing create d
	7279	"RTN","RCC PCPS",24,0 )
	7280	D KILL^RC CPCPS1(SDT )
	7281	"RTN","RCC PCPS",25,0 )
	7282	; PRCA4. 5313 - Se t date to a month ag o and kill data for that date
	7283	"RTN","RCC PCPS",26,0 )
	7284	N OLDDT
	7285	"RTN","RCC PCPS",27,0 )
	7286	S OLDDT=$ $MONTHAGO^ RCCPCPS1(S DT)
	7287	"RTN","RCC PCPS",28,0 )
	7288	; PRCA4. 5313 - Mo ved to KIL L^RCCPCPS1
	7289	"RTN","RCC PCPS",29,0 )
	7290	D KILL^RC CPCPS1(OLD DT)
	7291	"RTN","RCC PCPS",30,0 )
	7292	;
	7293	"RTN","RCC PCPS",31,0 )
	7294	D DT^DICR W,SITE^PRC AGU
	7295	"RTN","RCC PCPS",32,0 )
	7296	I '$D(SIT E) W !!,"A R SITE PAR AMETER ENT RIES NOT D EFINED!",? 50 D Q
	7297	"RTN","RCC PCPS",33,0 )
	7298	. D NOW^% DTC S Y=% D DD^%DT W Y
	7299	"RTN","RCC PCPS",34,0 )
	7300	. W !!,"C OULD NOT P ROCESS AR PATIENT ST ATEMENTS"
	7301	"RTN","RCC PCPS",35,0 )
	7302	. ; PRCA* 4.5*313 - Unlock pri or to exit ing
	7303	"RTN","RCC PCPS",36,0 )
	7304	. L -^RCP S(349.2):D ILOCKTM
	7305	"RTN","RCC PCPS",37,0 )
	7306	;
	7307	"RTN","RCC PCPS",38,0 )
	7308	; PRCA4. 5313 - Cl ear ICN Er ror tempor ary storag e
	7309	"RTN","RCC PCPS",39,0 )
	7310	K ^TMP("I CNERROR",$ J)
	7311	"RTN","RCC PCPS",40,0 )
	7312	D NOW^%DT C S END=%
	7313	"RTN","RCC PCPS",41,0 )
	7314	S LDT1=$$ FPS^RCAMFN 01(DT,-1), RCDATE=DT
	7315	"RTN","RCC PCPS",42,0 )
	7316	S (CNT,DE B)=0,PRN=1
	7317	"RTN","RCC PCPS",43,0 )
	7318	F S DEB= $O(^RCD(34 0,"AC",+$E (SDT,6,7), DEB)) Q:DE B="" I $D (^RCD(340, "AB","DPT( ",DEB)) D
	7319	"RTN","RCC PCPS",44,0 )
	7320	. N AMT ,BBAL,BEG, BN,CAT,DES C,ETY,FC,N D,PAT,PBAL ,PC,PSIEN, DFN,DBN0,V APA
	7321	"RTN","RCC PCPS",45,0 )
	7322	. N PDA T,PEND,ST, SVINT,SVAD M,SVOTH,AD DR,ARFLAG, DIC,FLBPD1 ,ICN
	7323	"RTN","RCC PCPS",46,0 )
	7324	. S PAT NAME=$$NAM ^RCFN01(DE B)
	7325	"RTN","RCC PCPS",47,0 )
	7326	. S PAT SSN=$$SSN^ RCFN01(DEB )
	7327	"RTN","RCC PCPS",48,0 )
	7328	. I $L( +PATSSN)<5 Q
	7329	"RTN","RCC PCPS",49,0 )
	7330	. S PNM SSN=PATNAM E_" LAST- 4: "_$E(PA TSSN,6,9)
	7331	"RTN","RCC PCPS",50,0 )
	7332	. ;Chec k for Emer gency Resp onse Indic ator (ERI) Flag.
	7333	"RTN","RCC PCPS",51,0 )
	7334	. N RCD FN S RCDFN =+($P($G(^ RCD(340,DE B,0)),U,1) ) I $$EMER ES^PRCAUTL (RCDFN)]"" Q
	7335	"RTN","RCC PCPS",52,0 )
	7336	. ; ini tialize va riables fo r CS - PRC A4.5301
	7337	"RTN","RCC PCPS",53,0 )
	7338	. N CSB B,CSTCH,CS TPC,CSPREV S (CSBB,C STCH,CSTPC )=0
	7339	"RTN","RCC PCPS",54,0 )
	7340	. ; PRC A^4.5*313 - If ICN i s null set to send e rror email
	7341	"RTN","RCC PCPS",55,0 )
	7342	. S ICN =$$GETICN^ MPIF001(RC DFN)
	7343	"RTN","RCC PCPS",56,0 )
	7344	. I $P( ICN,U)=-1 S ^TMP("IC NERROR",$J ,RCDFN)="" Q
	7345	"RTN","RCC PCPS",57,0 )
	7346	. S FLB PD1=$$FLBP D1
	7347	"RTN","RCC PCPS",58,0 )
	7348	. I FLB PD1="" Q
	7349	"RTN","RCC PCPS",59,0 )
	7350	. I $P( ^PRCA(430, FLBPD1,0), U,10)="" Q
	7351	"RTN","RCC PCPS",60,0 )
	7352	. S INA DFL=0
	7353	"RTN","RCC PCPS",61,0 )
	7354	. S (SV ADM,SVAMT, SVINT,SVOT H)=0
	7355	"RTN","RCC PCPS",62,0 )
	7356	. N REF ,SBAL,TBAL ,TN,TTY,X, Y
	7357	"RTN","RCC PCPS",63,0 )
	7358	. K ^TM P("PRCAGT" ,$J)
	7359	"RTN","RCC PCPS",64,0 )
	7360	. S BEG =+$$LST^RC FN01(DEB,2 )
	7361	"RTN","RCC PCPS",65,0 )
	7362	. S LDT 3=$S(BEG>0 :$$FPS^RCA MFN01($P(B EG,"."),-3 ),1:0)
	7363	"RTN","RCC PCPS",66,0 )
	7364	. I $P( BEG,".")'< $P(RCDATE, ".") Q
	7365	"RTN","RCC PCPS",67,0 )
	7366	. D NOW ^%DTC S EN D=%
	7367	"RTN","RCC PCPS",68,0 )
	7368	. I BEG <1 S PDAT= "",BEG=0,P BAL=0
	7369	"RTN","RCC PCPS",69,0 )
	7370	. I BEG S PDAT=BE G,BEG=9999 999.999999 -BEG,PBAL= 0 D PBAL^P RCAGU(DEB, .BEG,.PBAL ) ;get pre v bal
	7371	"RTN","RCC PCPS",70,0 )
	7372	. D EN^ PRCAGT(DEB ,BEG,.END)
	7373	"RTN","RCC PCPS",71,0 )
	7374	. S TBA L=0 D TBAL ^PRCAGT(DE B,.TBAL) ; get trans bal
	7375	"RTN","RCC PCPS",72,0 )
	7376	. S BBA L=0 D BBAL ^PRCAGU(DE B,.BBAL) ; get bill b al
	7377	"RTN","RCC PCPS",73,0 )
	7378	. ; ent ire accoun t has been referred to CS - PR CA4.5301
	7379	"RTN","RCC PCPS",74,0 )
	7380	. I CSB B,CSBB'<BB AL Q
	7381	"RTN","RCC PCPS",75,0 )
	7382	. S X=$ $PRE^PRCAG U(DEB) S P END=$P(X,U ,2),X=+X I X,BBAL D REF^PRCAGD (DEB,X,$G( REP)) Q
	7383	"RTN","RCC PCPS",76,0 )
	7384	. I BBA L=0,PEND,- PEND=PBAL+ TBAL Q
	7385	"RTN","RCC PCPS",77,0 )
	7386	. I BBA L'=(PBAL+T BAL) D EN^ PRCAGD(DEB ,BBAL,TBAL ,PBAL,BEG, $G(REP)) Q
	7387	"RTN","RCC PCPS",78,0 )
	7388	. I BBA L'>0,'$D(^ TMP("PRCAG T",$J,DEB) ) Q
	7389	"RTN","RCC PCPS",79,0 )
	7390	. I BBA L=0,$G(SIT E("ZERO")) Q
	7391	"RTN","RCC PCPS",80,0 )
	7392	. I BBA L<0,BBAL>- .99 Q
	7393	"RTN","RCC PCPS",81,0 )
	7394	. I BBA L'<0,'$D(^ XTMP("PRCA GU",$J,DEB )),'COMM Q ;third l etter prin ted,not co mment
	7395	"RTN","RCC PCPS",82,0 )
	7396	. S TBA L=TBAL+PBA L
	7397	"RTN","RCC PCPS",83,0 )
	7398	. ;adju st amounts to be fil ed in 349. 2 for CS b ills - PRC A4.5301
	7399	"RTN","RCC PCPS",84,0 )
	7400	. S TBA L=TBAL-CSB B ; reduce the total bill bala nce by CS balance
	7401	"RTN","RCC PCPS",85,0 )
	7402	. S CSP REV=CSBB-( CSTCH+CSTP C) ; compu te the CS previous b alance as the differ ence betwe en the bil l
	7403	balance an d the tran saction ba lance
	7404	"RTN","RCC PCPS",86,0 )
	7405	. S PBA L=PBAL-CSP REV ; redu ce the pre vious bala nce by the CS previo us balance
	7406	"RTN","RCC PCPS",87,0 )
	7407	. S TBA L("CH")=TB AL("CH")-C STCH ; red uce total charges by CS charge s
	7408	"RTN","RCC PCPS",88,0 )
	7409	. S TBA L("PC")=TB AL("PC")-C STPC ; red uce total credits by CS credit s
	7410	"RTN","RCC PCPS",89,0 )
	7411	. ;
	7412	"RTN","RCC PCPS",90,0 )
	7413	. I '$D (^RCPS(349 .2,0)) S ^ (0)="AR CB SS STATEME NTS^349.2I ^^"
	7414	"RTN","RCC PCPS",91,0 )
	7415	. S DIC ="^RCPS(34 9.2,",X=DE B,DA=.01,D IC(0)="" D FILE^DICN
	7416	"RTN","RCC PCPS",92,0 )
	7417	. S PSI EN=+Y
	7418	"RTN","RCC PCPS",93,0 )
	7419	. S ^RC PS(349.2,P SIEN,0)=DE B_U_PATSSN _U
	7420	"RTN","RCC PCPS",94,0 )
	7421	. ; PRC A4.5313/ DM valid a ddress, ha ndle forei gn address , handle c onfidentia l
	7422	"RTN","RCC PCPS",95,0 )
	7423	. S ADD R="",ARFLA G="N",DBN0 =$P($G(^RC D(340,DEB, 0)),"^",1)
	7424	"RTN","RCC PCPS",96,0 )
	7425	. I $P( $G(^RCD(34 0,DEB,1)), U,9) D PUT ERR(PNMSSN ,"Address is marked as ADDRESS UNKNOWN") Q
	7426	"RTN","RCC PCPS",97,0 )
	7427	. I DBN 0["DPT(" S ADDR=$$PA T^RCAMADD( +DBN0,1) ; confident ial
	7428	"RTN","RCC PCPS",98,0 )
	7429	. I ADD R="" D
	7430	"RTN","RCC PCPS",99,0 )
	7431	. . S A DDR=$P($G( ^RCD(340,D EB,1)),U,1 ,8)
	7432	"RTN","RCC PCPS",100, 0)
	7433	. . I $ $CHKDEB^RC CPCML1(ADD R) S ARFLA G="Y"
	7434	"RTN","RCC PCPS",101, 0)
	7435	. . S A DDR=$$DADD ^RCAMADD(D EB,0)
	7436	"RTN","RCC PCPS",102, 0)
	7437	. ;
	7438	"RTN","RCC PCPS",103, 0)
	7439	. S ADD R=$$TRIMDE B^RCCPCML1 (ADDR)
	7440	"RTN","RCC PCPS",104, 0)
	7441	. ; fig ure out Fo reign Coun try (FC) f irst
	7442	"RTN","RCC PCPS",105, 0)
	7443	. S FC= "",ST=$P(A DDR,U,5)
	7444	"RTN","RCC PCPS",106, 0)
	7445	. I ARF LAG="Y",ST '="" D
	7446	"RTN","RCC PCPS",107, 0)
	7447	. . S X =$O(^DIC(5 ,"C",ST,0) )
	7448	"RTN","RCC PCPS",108, 0)
	7449	. . I ( X>90),'$P( $G(^DIC(5, X,0)),U,6) S ST="FX" ,FC=$P($G( ^DIC(5,X,0 )),U,1)
	7450	"RTN","RCC PCPS",109, 0)
	7451	. I ARF LAG="N" D
	7452	"RTN","RCC PCPS",110, 0)
	7453	. . I D BN0'["DPT( " Q
	7454	"RTN","RCC PCPS",111, 0)
	7455	. . K V APA S DFN= +DBN0 D AD D^VADPT ; DBIA#10061
	7456	"RTN","RCC PCPS",112, 0)
	7457	. . I + VAPA(25)>2 S ST="FX" ,FC=$P(VAP A(25),U,2)
	7458	"RTN","RCC PCPS",113, 0)
	7459	. ; /DM check/ski p invalid address
	7460	"RTN","RCC PCPS",114, 0)
	7461	. I ($P (ADDR,U,1) ="")!($P(A DDR,U,4)=" ")!(ST="") !(($P(ADDR ,U,6)="")& (ST'="FX") ) D
	7462	PUTERR(PNM SSN,"Inval id address ") Q
	7463	"RTN","RCC PCPS",115, 0)
	7464	. I $L( +DBN0)>16 D PUTERR(P NMSSN,"War ning: DFN( "_+DBN0_") is longer than 16 p ositions")
	7465	"RTN","RCC PCPS",116, 0)
	7466	. S ^RC PS(349.2,P SIEN,1)=$P (ADDR,U,1, 6)
	7467	"RTN","RCC PCPS",117, 0)
	7468	. S:ST= "FX" $P(^R CPS(349.2, PSIEN,1),U ,5)=ST
	7469	"RTN","RCC PCPS",118, 0)
	7470	. S:ST= "FX" $P(^R CPS(349.2, PSIEN,1),U ,6)=$P(ADD R,U,8) ; / DM: FOREIG N COUNTRY CODE
	7471	"RTN","RCC PCPS",119, 0)
	7472	. S $P( ^RCPS(349. 2,PSIEN,1) ,U,7)=FC
	7473	"RTN","RCC PCPS",120, 0)
	7474	. S ^RC PS(349.2,P SIEN,7)=$P (^RCD(340, DEB,0),U,7 ) ;large p rint
	7475	"RTN","RCC PCPS",121, 0)
	7476	. ; PRC A4.5313 - Add four new eleme nts for CB SS
	7477	"RTN","RCC PCPS",122, 0)
	7478	. S $P( ^RCPS(349. 2,PSIEN,8) ,U)=$P(ICN ,"V")
	7479	"RTN","RCC PCPS",123, 0)
	7480	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,2)=$P(I CN,"V",2)
	7481	"RTN","RCC PCPS",124, 0)
	7482	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,3)=ARFL AG
	7483	"RTN","RCC PCPS",125, 0)
	7484	. S $P( ^RCPS(349. 2,PSIEN,8) ,U,4)=""
	7485	"RTN","RCC PCPS",126, 0)
	7486	. I FLB PD1 S $P(^ RCPS(349.2 ,PSIEN,8), U,4)=$P(^P RCA(430,FL BPD1,0),U, 10)
	7487	"RTN","RCC PCPS",127, 0)
	7488	. D NOW ^%DTC S $P (^RCPS(349 .2,PSIEN,0 ),U,10)=%
	7489	"RTN","RCC PCPS",128, 0)
	7490	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,3)=PATN AME
	7491	"RTN","RCC PCPS",129, 0)
	7492	. S
	7493	$P(^RCPS(3 49.2,PSIEN ,0),U,4,7) =$S(TBAL'> 0:0,1:TBAL )_U_PBAL_U _TBAL("CH" )_U_TBAL(" PC"),$P(^( 0),U,
	7494	8)=PBAL+TB AL("CH")+T BAL("PC")+ TBAL("RF")
	7495	"RTN","RCC PCPS",130, 0)
	7496	. S
	7497	$P(^RCPS(3 49.2,PSIEN ,0),U,13,1 7)=BBAL("P B")_U_BBAL ("INT")_U_ BBAL("ADM" )_U_BBAL(" MF")_U_BBA
	7498	L("CT")
	7499	"RTN","RCC PCPS",131, 0)
	7500	. ;
	7501	"RTN","RCC PCPS",132, 0)
	7502	. N
	7503	RCBILLDA,R CDATA1,RCD EBTDA,RCDE SC,RCPSDA, RCTOTAL,RC TRANDA,RCT RDATE,VALU E,RCCOM1,R CCO
	7504	M2,RCCOM3
	7505	"RTN","RCC PCPS",133, 0)
	7506	. S RCD EBTDA=DEB
	7507	"RTN","RCC PCPS",134, 0)
	7508	. I '$D (^RCPS(349 .2,PSIEN,2 ,0)) S ^(0 )="^^^"
	7509	"RTN","RCC PCPS",135, 0)
	7510	. ;
	7511	"RTN","RCC PCPS",136, 0)
	7512	. S RCC OM1=$E($TR ($G(SITE(" COM1")),"~ \|^",""),1, 80),(RCCOM 2,RCCOM3)= ""
	7513	"RTN","RCC PCPS",137, 0)
	7514	. ; Add second co mment line for the G MT-reduced status
	7515	"RTN","RCC PCPS",138, 0)
	7516	. I $$G MT^PRCAGST (RCDEBTDA) S RCCOM2= "REDUCTION OF INPATI ENT COPAYM ENT DUE TO
	7517	GEOGRAPHIC MEANS TES T STATUS"
	7518	"RTN","RCC PCPS",139, 0)
	7519	. I TBA L'>0 S RCC OM3=" THI S IS NOT A BILL"
	7520	"RTN","RCC PCPS",140, 0)
	7521	. I RCC OM1'="",RC COM2'="" S $E(RCCOM1 ,80)=" " ; Make sure GMT messag e will be printed on
	7522	separate l ine.
	7523	"RTN","RCC PCPS",141, 0)
	7524	. S ^RC PS(349.2,P SIEN,3)=RC COM1_RCCOM 2_RCCOM3
	7525	"RTN","RCC PCPS",142, 0)
	7526	. ;
	7527	"RTN","RCC PCPS",143, 0)
	7528	. S RCP SDA=0 ; th is variabl e used to set the de scription on the PS segment
	7529	"RTN","RCC PCPS",144, 0)
	7530	. S RCT RDATE=0 F S RCTRDAT E=$O(^TMP( "PRCAGT",$ J,RCDEBTDA ,RCTRDATE) ) Q:'RCTRD ATE S
	7531	RCBILLDA=0 F S RCBI LLDA=$O(^T MP("PRCAGT ",$J,RCDEB TDA,RCTRDA TE,RCBILLD A)) Q:'RCB ILLDA D
	7532	"RTN","RCC PCPS",145, 0)
	7533	. . ; skip CS b ills/trans actions - PRCA4.53 01
	7534	"RTN","RCC PCPS",146, 0)
	7535	. . Q :$D(^PRCA( 430,"TCSP" ,RCBILLDA) )
	7536	"RTN","RCC PCPS",147, 0)
	7537	. . I $P($G(^RC PS(349.2,P SIEN,0)),U ,8)<0 S PC (75)=75
	7538	"RTN","RCC PCPS",148, 0)
	7539	. . I $P($G(^PR CA(430,RCB ILLDA,6)), U,2)]"",($ P($G(^PRCA (430,RCBIL LDA,7)),U) >0) S PC(1 )="01"
	7540	"RTN","RCC PCPS",149, 0)
	7541	. . S CAT=$P($G (^PRCA(430 ,RCBILLDA, 0)),U,2)
	7542	"RTN","RCC PCPS",150, 0)
	7543	. . S PC=$P($G( ^PRCA(430. 2,CAT,0)), U,14)
	7544	"RTN","RCC PCPS",151, 0)
	7545	. . F X=1:1:100 I $P(PC," ,",X)'="" S PCC=$P(P C,",",X),P C(+PCC)=PC C Q:PCC=""
	7546	"RTN","RCC PCPS",152, 0)
	7547	. . S PC="",X=0 F S X=$O (PC(X)) Q: X="" I $G (PC(X))'=" " S PC=PC_ PC(X)
	7548	"RTN","RCC PCPS",153, 0)
	7549	. . S $P(^RCPS( 349.2,PSIE N,4),U)=PC
	7550	"RTN","RCC PCPS",154, 0)
	7551	. . ;
	7552	"RTN","RCC PCPS",155, 0)
	7553	. . I $D(^TMP(" PRCAGT",$J ,RCDEBTDA, RCTRDATE,R CBILLDA,0) ) S AMT=+^ (0) I AMT D
	7554	"RTN","RCC PCPS",156, 0)
	7555	. . . ; get the descri ption for the bill
	7556	"RTN","RCC PCPS",157, 0)
	7557	. . . K RCDES C D BILLDE SC^RCCPCPS 1(RCBILLDA )
	7558	"RTN","RCC PCPS",158, 0)
	7559	. . . ;
	7560	"RTN","RCC PCPS",159, 0)
	7561	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7562	"RTN","RCC PCPS",160, 0)
	7563	. . . S RCPSD A=RCPSDA+1
	7564	"RTN","RCC PCPS",161, 0)
	7565	. . . S
	7566	$P(^RCPS(3 49.2,PSIEN ,2,RCPSDA, 0),U,1,4)= $P(RCTRDAT E,".")_U_$ G(RCDESC(1 ))_U_$G(AM T)_U_$P($G (
	7567	^PRCA(430, RCBILLDA,0 )),U)
	7568	"RTN","RCC PCPS",162, 0)
	7569	. . . F X=2:1 Q:$G(RCDE SC(X))="" S
	7570	RCPSDA=RCP SDA+1,^RCP S(349.2,PS IEN,2,RCPS DA,0)=U_RC DESC(X)_"^ ^"
	7571	"RTN","RCC PCPS",163, 0)
	7572	. . ;
	7573	"RTN","RCC PCPS",164, 0)
	7574	. . S RCTRANDA= 0 F S
	7575	RCTRANDA=$ O(^TMP("PR CAGT",$J,R CDEBTDA,RC TRDATE,RCB ILLDA,RCTR ANDA)) D:' RCTRANDA N O
	7576	Q:'RCTRAND A D
	7577	"RTN","RCC PCPS",165, 0)
	7578	. . . ; get the descri ption for the transa ction
	7579	"RTN","RCC PCPS",166, 0)
	7580	. . . K RCDES C D TRANDE SC^RCCPCPS 1(RCTRANDA ),RCDESC
	7581	"RTN","RCC PCPS",167, 0)
	7582	. . . ; if i t is an in terest/adm in charge, summarize it below
	7583	"RTN","RCC PCPS",168, 0)
	7584	. . . I $G(RC DESC(1))[" INTEREST" Q
	7585	"RTN","RCC PCPS",169, 0)
	7586	. . . ; get the value of the tra nsaction f or the sta tement
	7587	"RTN","RCC PCPS",170, 0)
	7588	. . . S VALUE =$$TRANVAL U^RCDPBTLM (RCTRANDA)
	7589	"RTN","RCC PCPS",171, 0)
	7590	. . . S VALUE =$P(VALUE, U,2)+$P(VA LUE,U,3)+$ P(VALUE,U, 4)+$P(VALU E,U,5)+$P( VALUE,U,6)
	7591	"RTN","RCC PCPS",172, 0)
	7592	. . . ; if i t is a sus pended (47 ) or unsus pended (46 ) transact ion, show value
	7593	"RTN","RCC PCPS",173, 0)
	7594	. . . ; make suspended charges a ppear as n egative
	7595	"RTN","RCC PCPS",174, 0)
	7596	. . . S RCDAT A1=$G(^PRC A(433,RCTR ANDA,1))
	7597	"RTN","RCC PCPS",175, 0)
	7598	. . . I $P(RC DATA1,U,2) =47!($P(RC DATA1,U,2) =46) S VAL UE=$P(RCDA TA1,U,5) I $P(RCDATA 1,U,2)=47
	7599	S VALUE=-V ALUE
	7600	"RTN","RCC PCPS",176, 0)
	7601	. . . ; if i t is an am ended bill , show val ue
	7602	"RTN","RCC PCPS",177, 0)
	7603	. . . I $P(RC DATA1,U,2) =33 S VALU E=$P(RCDAT A1,U,5)
	7604	"RTN","RCC PCPS",178, 0)
	7605	. . . ; stor e the desc ription in file 349. 2, PS segm ent
	7606	"RTN","RCC PCPS",179, 0)
	7607	. . . S RCPSD A=RCPSDA+1
	7608	"RTN","RCC PCPS",180, 0)
	7609	. . . S
	7610	$P(^RCPS(3 49.2,PSIEN ,2,RCPSDA, 0),U,1,5)= $P(RCTRDAT E,".")_U_$ G(RCDESC(1 ))_U_VALUE _U_$P($G(^ P
	7611	RCA(430,RC BILLDA,0)) ,U)
	7612	"RTN","RCC PCPS",181, 0)
	7613	. . . F X=2:1 Q:$G(RCDE SC(X))="" S
	7614	RCPSDA=RCP SDA+1,^RCP S(349.2,PS IEN,2,RCPS DA,0)=U_RC DESC(X)_"^ ^"
	7615	"RTN","RCC PCPS",182, 0)
	7616	. . . ;
	7617	"RTN","RCC PCPS",183, 0)
	7618	. . . ; for comment tr ansaction ... not su re what th is is for ?
	7619	"RTN","RCC PCPS",184, 0)
	7620	. . . I $P(RC DATA1,U,2) =45,$P($G( ^PRCA(433, RCTRANDA,5 )),U,2)["y our waiver rights" S
	7621	^RCPS(349. 2,PSIEN,4) ="0150"
	7622	"RTN","RCC PCPS",185, 0)
	7623	. ;
	7624	"RTN","RCC PCPS",186, 0)
	7625	. ; if interest, admin, or other, ad d them her e
	7626	"RTN","RCC PCPS",187, 0)
	7627	. S X=$ G(RCTOTAL( "INT"))+$G (RCTOTAL(" ADM"))+$G( RCTOTAL("O TH"))
	7628	"RTN","RCC PCPS",188, 0)
	7629	. I X>0 D
	7630	"RTN","RCC PCPS",189, 0)
	7631	. . S RCDESC="I NTEREST/AD M. CHARGE (Int:"_$J( $G(RCTOTAL ("INT")),1 ,2)_"
	7632	Adm:"_$J($ G(RCTOTAL( "ADM")),1, 2)_" Other :"_$J($G(R CTOTAL("OT H")),1,2)_ ")"
	7633	"RTN","RCC PCPS",190, 0)
	7634	. . S RCPSDA=RC PSDA+1
	7635	"RTN","RCC PCPS",191, 0)
	7636	. . S ^RCPS(349 .2,PSIEN,2 ,RCPSDA,0) =U_RCDESC_ U_$J(X,1,2 )
	7637	"RTN","RCC PCPS",192, 0)
	7638	. . S ^RCPS(349 .2,PSIEN,2 ,0)="^^"_R CPSDA_U_RC PSDA
	7639	"RTN","RCC PCPS",193, 0)
	7640	. ;
	7641	"RTN","RCC PCPS",194, 0)
	7642	. ; PRC A4.5313 - Set stat ement date into cros s-referenc e
	7643	"RTN","RCC PCPS",195, 0)
	7644	. S $P( ^RCPS(349. 2,PSIEN,0) ,U,19)=SDT
	7645	"RTN","RCC PCPS",196, 0)
	7646	. ;
	7647	"RTN","RCC PCPS",197, 0)
	7648	. ; se t 0th node
	7649	"RTN","RCC PCPS",198, 0)
	7650	. I RCP SDA S ^RCP S(349.2,PS IEN,2,0)=" ^^"_RCPSDA _U_RCPSDA
	7651	"RTN","RCC PCPS",199, 0)
	7652	. ;
	7653	"RTN","RCC PCPS",200, 0)
	7654	. ; PRC A4.5313 - Set Cros s-Referenc es for thi s Debtor
	7655	"RTN","RCC PCPS",201, 0)
	7656	. S DA= PSIEN,DIK= "^RCPS(349 .2," D IX1 ^DIK
	7657	"RTN","RCC PCPS",202, 0)
	7658	. ;
	7659	"RTN","RCC PCPS",203, 0)
	7660	. ; PRC A4.5313 - Remove d ata for ea ch debtor
	7661	"RTN","RCC PCPS",204, 0)
	7662	. K ^XT MP("PRCAGU ",$J,DEB)
	7663	"RTN","RCC PCPS",205, 0)
	7664	. ;
	7665	"RTN","RCC PCPS",206, 0)
	7666	. I RCP SDA'<287 S ^XTMP("RC CPC",0)=DT ,(^XTMP("R CCPC",RCDE BTDA),^XTM P("RCCPC1" ,PSIEN))=" " Q
	7667	"RTN","RCC PCPS",207, 0)
	7668	. D NO
	7669	"RTN","RCC PCPS",208, 0)
	7670	;
	7671	"RTN","RCC PCPS",209, 0)
	7672	S PSIEN=0 S PSIEN=$ O(^RCPS(34 9.2,"STDT" ,SDT,PSIEN )) Q:PSIEN ="" S $P( ^RCPS(349. 2,PSIEN,0) ,U,18)=1
	7673	"RTN","RCC PCPS",210, 0)
	7674	;
	7675	"RTN","RCC PCPS",211, 0)
	7676	; PRCA4. 5313 - Se nd ICN Err or email i f necessar y
	7677	"RTN","RCC PCPS",212, 0)
	7678	I $D(^TMP ("ICNERROR ",$J)) D I CNERR^RCCP CPS1 K ^TM P("ICNERRO R",$J)
	7679	"RTN","RCC PCPS",213, 0)
	7680	I $D(^TMP ("MSG",$J) ) D TRFMAI L K ^TMP(" MSG",$J)
	7681	"RTN","RCC PCPS",214, 0)
	7682	;
	7683	"RTN","RCC PCPS",215, 0)
	7684	K COMM,TR ,TRNIEN
	7685	"RTN","RCC PCPS",216, 0)
	7686	;
	7687	"RTN","RCC PCPS",217, 0)
	7688	OSTM ;Proc ess old st atements
	7689	"RTN","RCC PCPS",218, 0)
	7690	S DIK="^R CPS(349.2, ",DA=0 F S DA=$O(^X TMP("RCCPC 1",DA)) Q: 'DA D ^DI K
	7691	"RTN","RCC PCPS",219, 0)
	7692	K DA,^XTM P("RCCPC1" )
	7693	"RTN","RCC PCPS",220, 0)
	7694	;
	7695	"RTN","RCC PCPS",221, 0)
	7696	STATMNT ;P rint patie nt stateme nts
	7697	"RTN","RCC PCPS",222, 0)
	7698	N IOP,ZTI O,ZTSAVE,Z TRTN,ZTDES C,ZTASK,%Z IS,ZTDTH,P RCADEV,POP
	7699	"RTN","RCC PCPS",223, 0)
	7700	S (IOP,PR CADEV)=$P( $G(^RC(342 ,1,0)),U,8 )
	7701	"RTN","RCC PCPS",224, 0)
	7702	I IOP]"" D
	7703	"RTN","RCC PCPS",225, 0)
	7704	.S ZTRTN= "STM^RCCPC STM",ZTDTH =$H,ZTDESC ="Print ol d AR State ments"
	7705	"RTN","RCC PCPS",226, 0)
	7706	.S %ZIS=" N0" D ^%ZI S Q:POP
	7707	"RTN","RCC PCPS",227, 0)
	7708	.S ZTSAVE ("PRCADEV" )="" D ^%Z TLOAD,^%ZI SC
	7709	"RTN","RCC PCPS",228, 0)
	7710	; PRCA4. 5313 - Un lock prior to exitin g
	7711	"RTN","RCC PCPS",229, 0)
	7712	L -^RCPS( 349.2):DIL OCKTM
	7713	"RTN","RCC PCPS",230, 0)
	7714	Q
	7715	"RTN","RCC PCPS",231, 0)
	7716	;
	7717	"RTN","RCC PCPS",232, 0)
	7718	NO ;If the re is no a ctivity
	7719	"RTN","RCC PCPS",233, 0)
	7720	I $G(^RCP S(349.2,PS IEN,4))["0 150" D
	7721	"RTN","RCC PCPS",234, 0)
	7722	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^NOTICE: Y ou now hav e delinque nt charges . Please^^ "
	7723	"RTN","RCC PCPS",235, 0)
	7724	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^review En forcement of Involun tary Colle ctions^^"
	7725	"RTN","RCC PCPS",236, 0)
	7726	.S ^RCPS( 349.2,PSIE N,2,3,0)=" ^on revers e.^^"
	7727	"RTN","RCC PCPS",237, 0)
	7728	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 3^3"
	7729	"RTN","RCC PCPS",238, 0)
	7730	I $G(^RCP S(349.2,PS IEN,2,1,0) )="" D
	7731	"RTN","RCC PCPS",239, 0)
	7732	.S ^RCPS( 349.2,PSIE N,2,1,0)=" ^No Activi ty in the Last 30 Da ys!^^"
	7733	"RTN","RCC PCPS",240, 0)
	7734	.S ^RCPS( 349.2,PSIE N,2,2,0)=" ^Please re fer to pre vious stat ement of r ights.^^"
	7735	"RTN","RCC PCPS",241, 0)
	7736	.S ^RCPS( 349.2,PSIE N,2,0)="^^ 2^2"
	7737	"RTN","RCC PCPS",242, 0)
	7738	.I $G(^RC PS(349.2,P SIEN,4))=" " S ^(4)=" 90"
	7739	"RTN","RCC PCPS",243, 0)
	7740	Q
	7741	"RTN","RCC PCPS",244, 0)
	7742	BUILD ;Thi s is the e ntry point from the BUILD CCPC file opti on
	7743	"RTN","RCC PCPS",245, 0)
	7744	N TDT,QDT ,ZTDESC,ZT ASK,ZTSK,Z DTDTH,ZTIO ,ZTRTN,CNC L,%H,%DT,D IR,DTOUT
	7745	"RTN","RCC PCPS",246, 0)
	7746	; PRCA4. 5313 - Ch eck for lo ck. If lo cked quit with warni ng.
	7747	"RTN","RCC PCPS",247, 0)
	7748	L +^RCPS( 349.2):DIL OCKTM I '$ T W 7,7, !,"Another date is b eing run o r transmit ted. Try again late r."
	7749	Q
	7750	"RTN","RCC PCPS",248, 0)
	7751	; PRCA4. 5313 - Re written to use Patie nt Stateme nt Date en try
	7752	"RTN","RCC PCPS",249, 0)
	7753	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	7754	"RTN","RCC PCPS",250, 0)
	7755	;;[BEGIN EDIT,ASF,1 2/11/18, P RCA4.531 3]
	7756	"RTN","RCC PCPS",251, 0)
	7757	;S DIR(0) ="DAO^^D:" ",1,2,4,6, 7,8,10,12, 14,15,17,1 9,21,22,24 ,26,""'[(" ",""_+$E(Y ,6,7)_""," ")
	7758	BLDERR^RCC PCPS"
	7759	"RTN","RCC PCPS",252, 0)
	7760	S DIR(0)= "DAO^^D:"" "_$$STMTDA YS^RCCPCML 1()_"""'[( "",""_+$E( Y,6,7)_"", "") BLDERR ^RCCPCPS"
	7761	"RTN","RCC PCPS",253, 0)
	7762	;;[END ED IT,ASF,12/ 11/18, PRC A4.5313]
	7763	"RTN","RCC PCPS",254, 0)
	7764	S DIR("A" )="Enter a Patient S tatement d ate for th is build: "
	7765	"RTN","RCC PCPS",255, 0)
	7766	S DIR("?" )="Enter a Patient S tatement d ate for th is build o r ^ to exi t."
	7767	"RTN","RCC PCPS",256, 0)
	7768	D ^DIR
	7769	"RTN","RCC PCPS",257, 0)
	7770	; PRCA4. 5313 - Un lock prior to quitti ng
	7771	"RTN","RCC PCPS",258, 0)
	7772	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) L -^RC PS(349.2): DILOCKTM Q
	7773	"RTN","RCC PCPS",259, 0)
	7774	S SDT=Y
	7775	"RTN","RCC PCPS",260, 0)
	7776	; PRCA4. 5313/JG D o not proc eed with d ate prior to 1st ins tallation of PRCA4. 5313
	7777	"RTN","RCC PCPS",261, 0)
	7778	I $$CHK31 3(1,SDT) L -^RCPS(34 9.2):DILOC KTM Q
	7779	"RTN","RCC PCPS",262, 0)
	7780	S TDT=$O( ^RCPS(349. 2,"STDT",S DT,0)) I T DT D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$D (DIROUT) Q
	7781	"RTN","RCC PCPS",263, 0)
	7782	.S TDT=$T R($$SLH^RC FN01(SDT), "/","")
	7783	"RTN","RCC PCPS",264, 0)
	7784	.W *7,!!, "The Patie nt Stateme nts for ", $E(TDT,1,2 )_"/"_$E(T DT,3,4)_"/ "_$E(TDT,5 ,8)
	7785	"RTN","RCC PCPS",265, 0)
	7786	.I $D(^RC T(349,"SDT ",+$E(SDT, 6,7))) D
	7787	"RTN","RCC PCPS",266, 0)
	7788	..S TDT=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",+ $E(SDT,6,7 ),0)),0),U ,10)
	7789	"RTN","RCC PCPS",267, 0)
	7790	..S TDT=$ TR($$SLH^R CFN01(TDT) ,"/","")
	7791	"RTN","RCC PCPS",268, 0)
	7792	..W " wer e transmit ted on ",$ E(TDT,1,2) _"/"_$E(TD T,3,4)_"/" _$E(TDT,5, 8)_"."
	7793	"RTN","RCC PCPS",269, 0)
	7794	.E W " d o not have a transmi ssion date !"
	7795	"RTN","RCC PCPS",270, 0)
	7796	.W !!,">> PLEASE CO NTACT CUST OMER SUPPO RT BEFORE PROCEEDING <<",!!
	7797	"RTN","RCC PCPS",271, 0)
	7798	.N DIR,DT OUT,DUOUT, DIRUT,DIRO UT
	7799	"RTN","RCC PCPS",272, 0)
	7800	.S DIR(0) ="E",DIR(" A")=" Pres s ENTER to Continue with Build or ^ to E xit" D ^DI R
	7801	"RTN","RCC PCPS",273, 0)
	7802	.I $D(DTO UT)!$D(DUO UT)!$D(DIR UT)!$D(DIR OUT) L -^R CPS(349.2) :DILOCKTM Q
	7803	"RTN","RCC PCPS",274, 0)
	7804	; PRCA4. 5313 - Un lock prior to jobbin g off
	7805	"RTN","RCC PCPS",275, 0)
	7806	L -^RCPS( 349.2):DIL OCKTM
	7807	"RTN","RCC PCPS",276, 0)
	7808	I $D(DIRU T) K SDT Q
	7809	"RTN","RCC PCPS",277, 0)
	7810	TIME S ZTI O="",ZTRTN ="EN1^RCCP CPS",ZTDES C="Build C BSS Statem ent File"
	7811	"RTN","RCC PCPS",278, 0)
	7812	S ZTDTH=" ",ZTSAVE(" SDT")=SDT D ^%ZTLOAD Q:$G(ZTSK )=""
	7813	"RTN","RCC PCPS",279, 0)
	7814	S %H=ZTSK ("D") D YM D^%DTC S Q DT=X_%
	7815	"RTN","RCC PCPS",280, 0)
	7816	; PRCA5. 4313 - Al low run an y time
	7817	"RTN","RCC PCPS",281, 0)
	7818	;I (QDT>D T_"."_0800 )&(QDT<(DT _"."_1801) ) D G TIM E
	7819	"RTN","RCC PCPS",282, 0)
	7820	;.W !!,*7 ,"You Can Not Queue this Job B etween 8:0 0am and 6: 00pm.",!
	7821	"RTN","RCC PCPS",283, 0)
	7822	;.D KILL^ %ZTLOAD
	7823	"RTN","RCC PCPS",284, 0)
	7824	W !,"Queu ed for Bui lding."
	7825	"RTN","RCC PCPS",285, 0)
	7826	; PRCA4. 5313 - Un lock prior to quitti ng
	7827	"RTN","RCC PCPS",286, 0)
	7828	L -^RCPS( 349.2):DIL OCKTM
	7829	"RTN","RCC PCPS",287, 0)
	7830	Q
	7831	"RTN","RCC PCPS",288, 0)
	7832	;
	7833	"RTN","RCC PCPS",289, 0)
	7834	RCDESC ;Re move "IN P ART" & "IN FULL" fro m the the bill descr iption
	7835	"RTN","RCC PCPS",290, 0)
	7836	QUIT:$G(R CDESC(1))= ""
	7837	"RTN","RCC PCPS",291, 0)
	7838	S RCINFUL L=" (IN FU LL)"
	7839	"RTN","RCC PCPS",292, 0)
	7840	S RCINPAR T=" (IN PA RT)"
	7841	"RTN","RCC PCPS",293, 0)
	7842	I RCDESC( 1)[RCINFUL L S RCDESC (1)=$P(RCD ESC(1),RCI NFULL)_$P( RCDESC(1), RCINFULL,2 )
	7843	"RTN","RCC PCPS",294, 0)
	7844	I RCDESC( 1)[RCINPAR T S RCDESC (1)=$P(RCD ESC(1),RCI NPART)_$P( RCDESC(1), RCINPART,2 )
	7845	"RTN","RCC PCPS",295, 0)
	7846	Q
	7847	"RTN","RCC PCPS",296, 0)
	7848	FLBPD1() ; PRCA4.5 313 - Retu rn last bi ll prep da te
	7849	"RTN","RCC PCPS",297, 0)
	7850	N X1,X2 S X1="" I ' $D(^PRCA(4 30,"ATD",D EB)) Q X1
	7851	"RTN","RCC PCPS",298, 0)
	7852	S X2=$O(^ PRCA(430," ATD",DEB,X 1),-1)
	7853	"RTN","RCC PCPS",299, 0)
	7854	S X1=$O(^ PRCA(430," ATD",DEB,X 2,X1),-1)
	7855	"RTN","RCC PCPS",300, 0)
	7856	Q X1
	7857	"RTN","RCC PCPS",301, 0)
	7858	BLDERR ; PRCA4.53 13 - Print Error and Kill X
	7859	"RTN","RCC PCPS",302, 0)
	7860	W !!,"INV ALID STATE MENT DATE"
	7861	"RTN","RCC PCPS",303, 0)
	7862	K X
	7863	"RTN","RCC PCPS",304, 0)
	7864	Q
	7865	"RTN","RCC PCPS",305, 0)
	7866	STDT ; En try point for PRCA4 .5313 ver ify Patien t Statemen t date dep endent upo n the Pati ent Last
	7867	Name
	7868	"RTN","RCC PCPS",306, 0)
	7869	N DEBT,DI E
	7870	"RTN","RCC PCPS",307, 0)
	7871	S DIE="^R CD(340,"
	7872	"RTN","RCC PCPS",308, 0)
	7873	S DEBT=""
	7874	"RTN","RCC PCPS",309, 0)
	7875	F S DEBT =$O(^RCD(3 40,"AB","D PT(",DEBT) ) Q:DEBT=" " D
	7876	"RTN","RCC PCPS",310, 0)
	7877	.N NAME,D A,DR,DAYOF MON ; PRCA 4.5313/J G - Add DA YOFMON and remove PA T and DPT
	7878	"RTN","RCC PCPS",311, 0)
	7879	.S NAME=$ $GET1^DIQ( 340,DEBT_" ,",.01) ; WCJ repl aced direc t global r eference w ith filema n call
	7880	"RTN","RCC PCPS",312, 0)
	7881	.S DA=DEB T
	7882	"RTN","RCC PCPS",313, 0)
	7883	.S DAYOFM ON=+$$ACSE T^RCCPCFN1 (NAME) ; P RCA4.531 3/JG - Eva luate func tion only once
	7884	"RTN","RCC PCPS",314, 0)
	7885	.S DR=".0 3////"_DAY OFMON ; PR CA4.5313 /JG - Use evaluated function
	7886	"RTN","RCC PCPS",315, 0)
	7887	.I DAYOFM ON'=$P($G( ^RCD(340,D EBT,0)),3) D ^DIE
	7888	"RTN","RCC PCPS",316, 0)
	7889	; Set cro ss-referen ce in AR E vent (341) if Patien t Statemen t date exi sts
	7890	"RTN","RCC PCPS",317, 0)
	7891	N DA,DIK
	7892	"RTN","RCC PCPS",318, 0)
	7893	S DIK="^R C(341,"
	7894	"RTN","RCC PCPS",319, 0)
	7895	S DA="" F S DA=$O( ^RC(341,DA )) Q:DA="" I $G(^RC (341,DA,6) )'="" D IX 1^DIK
	7896	"RTN","RCC PCPS",320, 0)
	7897	Q
	7898	"RTN","RCC PCPS",321, 0)
	7899	;
	7900	"RTN","RCC PCPS",322, 0)
	7901	PUTERR(IDT XT,ERRTXT) ; add er ror to ^TM P("MSG",$J ,ERRLN,0) for transm ission lat er
	7902	"RTN","RCC PCPS",323, 0)
	7903	I OLDID'= IDTXT D ; header ch anged
	7904	"RTN","RCC PCPS",324, 0)
	7905	. S OLDID =IDTXT
	7906	"RTN","RCC PCPS",325, 0)
	7907	. S ERRLN =ERRLN+1,^ TMP("MSG", $J,ERRLN,0 )=""
	7908	"RTN","RCC PCPS",326, 0)
	7909	. S ERRLN =ERRLN+1,^ TMP("MSG", $J,ERRLN,0 )=IDTXT
	7910	"RTN","RCC PCPS",327, 0)
	7911	;
	7912	"RTN","RCC PCPS",328, 0)
	7913	S ERRLN=E RRLN+1,^TM P("MSG",$J ,ERRLN,0)= " "_ERRTX T
	7914	"RTN","RCC PCPS",329, 0)
	7915	Q
	7916	"RTN","RCC PCPS",330, 0)
	7917	;
	7918	"RTN","RCC PCPS",331, 0)
	7919	TRFMAIL ;s et up and send mail message - copied fro m RCCPCAR
	7920	"RTN","RCC PCPS",332, 0)
	7921	N L,XMDUZ ,XMSUB,XMY ,XMZ,Z
	7922	"RTN","RCC PCPS",333, 0)
	7923	S XMSUB=$ $SITE^RCMS ITE()_" PA TIENT STMN T BUILD IS SUES "_SDT
	7924	"RTN","RCC PCPS",334, 0)
	7925	D PUTERR( "**END==== ========== ========== ======="," ")
	7926	"RTN","RCC PCPS",335, 0)
	7927	S XMDUZ=" AR PACKAGE "
	7928	"RTN","RCC PCPS",336, 0)
	7929	;PRCA4.5 313/JG - Use Filema n call to set up XMY ("G.RCCPC STATEMENTS ")
	7930	"RTN","RCC PCPS",337, 0)
	7931	N TAR,ERR
	7932	"RTN","RCC PCPS",338, 0)
	7933	D FIND^DI C(3.8,,.01 ,"X","RCCP C STATEMEN TS",1,"B", ,,"TAR","E RR") ;DBIA #10111
	7934	"RTN","RCC PCPS",339, 0)
	7935	I +$G(TAR ("DILIST", 0)),$P($G( ^RC(342,1, 0)),U,12) S XMY("G.R CCPC STATE MENTS")=""
	7936	"RTN","RCC PCPS",340, 0)
	7937	S XMDUZ=" AR PACKAGE "
	7938	"RTN","RCC PCPS",341, 0)
	7939	D XMZ^XMA 2
	7940	"RTN","RCC PCPS",342, 0)
	7941	Q:XMZ<1 ; no mailm an message number re turned, no t much tha t can be d one, just exit
	7942	"RTN","RCC PCPS",343, 0)
	7943	S (L,L(1) )=0 F S L (1)=$O(^TM P("MSG",$J ,L(1))) Q: 'L(1) I $ D(^TMP("MS G",$J,L(1) ,0)) S
	7944	L=L+1,^XMB (3.9,+XMZ, 2,L,0)=^TM P("MSG",$J ,L(1),0) ; DBIA#10113
	7945	"RTN","RCC PCPS",344, 0)
	7946	S ^XMB(3. 9,XMZ,2,0) ="^3.92A^" _L_U_L_U_D T ;DBIA#10 113
	7947	"RTN","RCC PCPS",345, 0)
	7948	D ENT1^XM D
	7949	"RTN","RCC PCPS",346, 0)
	7950	D NOW^%DT C
	7951	"RTN","RCC PCPS",347, 0)
	7952	Q
	7953	"RTN","RCC PCPS",348, 0)
	7954	;
	7955	"RTN","RCC PCPS",349, 0)
	7956	CHK313(OPT ,SDT) ; Ch eck agains t 1st inst allation d ate of PRC A4.5313
	7957	"RTN","RCC PCPS",350, 0)
	7958	; OPT - 1 for pri nting mess age, 0 for using Mai lman
	7959	"RTN","RCC PCPS",351, 0)
	7960	; SDT - Statement date
	7961	"RTN","RCC PCPS",352, 0)
	7962	; ERROR - Equals 12 if there is a probl em with da te prior t o 1st inst allation o f patch
	7963	"RTN","RCC PCPS",353, 0)
	7964	; Otherwise , 0 for no such prob lem
	7965	"RTN","RCC PCPS",354, 0)
	7966	; Returns ( ERROR=12) --> 1 or 0 (Problem or no prob lem)
	7967	"RTN","RCC PCPS",355, 0)
	7968	;
	7969	"RTN","RCC PCPS",356, 0)
	7970	N DAT,DTS ,ERROR,NM, Y
	7971	"RTN","RCC PCPS",357, 0)
	7972	; PRCA4. 5313/JG D o not proc eed with d ate prior to 1st ins tallation of PRCA4. 5313
	7973	"RTN","RCC PCPS",358, 0)
	7974	I $$INSTA LDT^XPDUTL ("PRCA4.5 313",.DTS ) D ;DBIA #10141 ; C hecking fo r installa tion of
	7975	PRCA4.53 13
	7976	"RTN","RCC PCPS",359, 0)
	7977	. S DAT=$ O(DTS("")) \1
	7978	"RTN","RCC PCPS",360, 0)
	7979	. I SDT<D AT D
	7980	"RTN","RCC PCPS",361, 0)
	7981	. . S ERR OR=12
	7982	"RTN","RCC PCPS",362, 0)
	7983	. . D NOW ^%DTC S Y= % D DD^%DT
	7984	"RTN","RCC PCPS",363, 0)
	7985	. . I OPT D
	7986	"RTN","RCC PCPS",364, 0)
	7987	. . . W Y ,!!,$$RTNM SG^RCCPCML 1(12)
	7988	"RTN","RCC PCPS",365, 0)
	7989	. . E D
	7990	"RTN","RCC PCPS",366, 0)
	7991	. . . S N M=0 D ERRO R^RCCPCML, ERRML^RCCP CML1
	7992	"RTN","RCC PCPS",367, 0)
	7993	. E S ER ROR=0
	7994	"RTN","RCC PCPS",368, 0)
	7995	E S ERRO R=0
	7996	"RTN","RCC PCPS",369, 0)
	7997	Q (ERROR= 12)
	7998	"RTN","RCC PCPS",370, 0)
	7999	;
	8000	"RTN","RCC PCPS1")
	8001	0^11^B6555 2582^B3737 0113
	8002	"RTN","RCC PCPS1",1,0 )
	8003	RCCPCPS1 ; WISC/RFJ-b uild descr iption for patient s tatement ; 08 Aug 200 1
	8004	"RTN","RCC PCPS1",2,0 )
	8005	;;4.5;Acc ounts Rece ivable;3 4,48,104,1 70,176,192 ,265,313 ;Mar 20, 1 995;Build 150
	8006	"RTN","RCC PCPS1",3,0 )
	8007	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8008	"RTN","RCC PCPS1",4,0 )
	8009	;DBIA#100 61
	8010	"RTN","RCC PCPS1",5,0 )
	8011	Q
	8012	"RTN","RCC PCPS1",6,0 )
	8013	;
	8014	"RTN","RCC PCPS1",7,0 )
	8015	;
	8016	"RTN","RCC PCPS1",8,0 )
	8017	TRANDESC(R CTRANDA,RC WIDTH) ; build the descriptio n array fo r a transa ction
	8018	"RTN","RCC PCPS1",9,0 )
	8019	;
	8020	"RTN","RCC PCPS1",10, 0)
	8021	; initia lize
	8022	"RTN","RCC PCPS1",11, 0)
	8023	N DESCRIP T,RCBILLDA ,RCCATEG,R CCATTXT,RC DATA0,RCDA TA1,RCDATA 3,RCLINE,T RANTYPE,X
	8024	"RTN","RCC PCPS1",12, 0)
	8025	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8026	"RTN","RCC PCPS1",13, 0)
	8027	K RCDESC
	8028	"RTN","RCC PCPS1",14, 0)
	8029	S RCLINE= 1,RCDESC(1 )=""
	8030	"RTN","RCC PCPS1",15, 0)
	8031	;
	8032	"RTN","RCC PCPS1",16, 0)
	8033	S RCBILLD A=+$P($G(^ PRCA(433,R CTRANDA,0) ),"^",2) I 'RCBILLDA Q
	8034	"RTN","RCC PCPS1",17, 0)
	8035	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8036	"RTN","RCC PCPS1",18, 0)
	8037	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8038	"RTN","RCC PCPS1",19, 0)
	8039	S RCDATA1 =^PRCA(433 ,RCTRANDA, 1)
	8040	"RTN","RCC PCPS1",20, 0)
	8041	S TRANTYP E=$P(RCDAT A1,"^",2)
	8042	"RTN","RCC PCPS1",21, 0)
	8043	;
	8044	"RTN","RCC PCPS1",22, 0)
	8045	; build the first line descr iption
	8046	"RTN","RCC PCPS1",23, 0)
	8047	; if tra nsaction t ype is an increase o r decrease , set desc ription
	8048	"RTN","RCC PCPS1",24, 0)
	8049	I TRANTYP E=1!(TRANT YPE=35) D
	8050	"RTN","RCC PCPS1",25, 0)
	8051	. ; if c means t est, set d escription to catego ry for c m eans test
	8052	"RTN","RCC PCPS1",26, 0)
	8053	. I RCC ATEG=18 S
	8054	DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^" ,16),0),"^ "),1:RCCAT TXT) Q
	8055	"RTN","RCC PCPS1",27, 0)
	8056	. ; ot herwise, s et to cate gory name
	8057	"RTN","RCC PCPS1",28, 0)
	8058	. S DES CRIPT=RCCA TTXT
	8059	"RTN","RCC PCPS1",29, 0)
	8060	;
	8061	"RTN","RCC PCPS1",30, 0)
	8062	; if the bill cate gory is a rx-copay a nd it is a n increase adjustmen t
	8063	"RTN","RCC PCPS1",31, 0)
	8064	; then s et the des cription t o copay
	8065	"RTN","RCC PCPS1",32, 0)
	8066	I RCCATEG =22!(RCCAT EG=23),TRA NTYPE=1 S DESCRIPT=" COPAY"
	8067	"RTN","RCC PCPS1",33, 0)
	8068	;
	8069	"RTN","RCC PCPS1",34, 0)
	8070	; if the bill cate gory is ad ult day he alth care, remove he alth
	8071	"RTN","RCC PCPS1",35, 0)
	8072	I RCCATEG =33 S DESC RIPT="ADUL T DAY CARE "
	8073	"RTN","RCC PCPS1",36, 0)
	8074	;
	8075	"RTN","RCC PCPS1",37, 0)
	8076	; if the bill cate gory is re spite or g eriatric e val,
	8077	"RTN","RCC PCPS1",38, 0)
	8078	; take t he 2nd pie ce removin g institut ional
	8079	"RTN","RCC PCPS1",39, 0)
	8080	I RCCATEG =35!(RCCAT EG=36)!(RC CATEG=37)! (RCCATEG=3 8) S DESCR IPT=$P(RCC ATTXT,"-
	8081	")_$S(RCCA TEG=35!(RC CATEG=37): " IN",1:" OUT")_"PAT IENT"
	8082	"RTN","RCC PCPS1",40, 0)
	8083	;
	8084	"RTN","RCC PCPS1",41, 0)
	8085	; if it is a comme nt transac tion
	8086	"RTN","RCC PCPS1",42, 0)
	8087	I TRANTYP E=45 S DES CRIPT="COM MENT: "_$P ($G(^PRCA( 433,RCTRAN DA,5)),"^" ,2)
	8088	"RTN","RCC PCPS1",43, 0)
	8089	;
	8090	"RTN","RCC PCPS1",44, 0)
	8091	; prepay ment bill (1=increas e, 35=decr ease, othe rwise refu nd)
	8092	"RTN","RCC PCPS1",45, 0)
	8093	I RCCATEG =26 S DESC RIPT=$S(TR ANTYPE=1:" OVERPAYMEN T CREDIT", TRANTYPE=3 5:"OVERPAY MENT
	8094	CREDIT DEC REASE",1:" OVERPAYMEN T REFUND")
	8095	"RTN","RCC PCPS1",46, 0)
	8096	;
	8097	"RTN","RCC PCPS1",47, 0)
	8098	; if the first lin e descript ion not se t (like pa yments), s et it
	8099	"RTN","RCC PCPS1",48, 0)
	8100	; to the type of t ransaction
	8101	"RTN","RCC PCPS1",49, 0)
	8102	I $G(DESC RIPT)="" S DESCRIPT= $P($G(^PRC A(430.3,+$ P(RCDATA1, "^",2),0)) ,"^")
	8103	"RTN","RCC PCPS1",50, 0)
	8104	;
	8105	"RTN","RCC PCPS1",51, 0)
	8106	; if the transacti on date is different from the process da te,
	8107	"RTN","RCC PCPS1",52, 0)
	8108	; show i t with the descripti on
	8109	"RTN","RCC PCPS1",53, 0)
	8110	I $P(RCDA TA1,"^"),$ P($P(RCDAT A1,"^"),". ")'=$P($P( RCDATA1,"^ ",9),".") S DESCRIPT =DESCRIPT_ "
	8111	("_$$DATE( $P($P(RCDA TA1,"^")," ."))_")"
	8112	"RTN","RCC PCPS1",54, 0)
	8113	;
	8114	"RTN","RCC PCPS1",55, 0)
	8115	; set th e first de scription line
	8116	"RTN","RCC PCPS1",56, 0)
	8117	D SETDESC (DESCRIPT)
	8118	"RTN","RCC PCPS1",57, 0)
	8119	;
	8120	"RTN","RCC PCPS1",58, 0)
	8121	; if it is a payme nt transac tion, show amount pa id interes t, admin, other
	8122	"RTN","RCC PCPS1",59, 0)
	8123	I TRANTYP E=2!(TRANT YPE=34) D
	8124	"RTN","RCC PCPS1",60, 0)
	8125	. S RCD ATA3=$G(^P RCA(433,RC TRANDA,3))
	8126	"RTN","RCC PCPS1",61, 0)
	8127	. ; if not inter est, admin , or other , quit
	8128	"RTN","RCC PCPS1",62, 0)
	8129	. I '$P (RCDATA3," ^",2),'$P( RCDATA3,"^ ",3),'$P(R CDATA3,"^" ,4),'$P(RC DATA3,"^", 5) Q
	8130	"RTN","RCC PCPS1",63, 0)
	8131	. ;
	8132	"RTN","RCC PCPS1",64, 0)
	8133	. S DES CRIPT=" ( Int:"_$J(+ $P(RCDATA3 ,"^",2),1, 2)_" Adm: "_$J(+$P(R CDATA3,"^" ,3),1,2)
	8134	"RTN","RCC PCPS1",65, 0)
	8135	. ; ca lculate ot her
	8136	"RTN","RCC PCPS1",66, 0)
	8137	. S X=$ P(RCDATA1, "^",5)-$P( RCDATA3,"^ ")-$P(RCDA TA3,"^",2) -$P(RCDATA 3,"^",3)
	8138	"RTN","RCC PCPS1",67, 0)
	8139	. S DES CRIPT=DESC RIPT_$S(X: " Other:"_ $J(X,1,2)_ ")",1:")")
	8140	"RTN","RCC PCPS1",68, 0)
	8141	. D SET DESC(DESCR IPT)
	8142	"RTN","RCC PCPS1",69, 0)
	8143	;
	8144	"RTN","RCC PCPS1",70, 0)
	8145	; if it is a admin cost or i nterest ch arge, tota l the amou nts
	8146	"RTN","RCC PCPS1",71, 0)
	8147	I TRANTYP E=13!(TRAN TYPE=12) D Q
	8148	"RTN","RCC PCPS1",72, 0)
	8149	. S X=$ G(^PRCA(43 3,RCTRANDA ,2)) I X=" " Q
	8150	"RTN","RCC PCPS1",73, 0)
	8151	. S RCT OTAL("INT" )=$G(RCTOT AL("INT")) +$P(X,"^", 7)
	8152	"RTN","RCC PCPS1",74, 0)
	8153	. S RCT OTAL("ADM" )=$G(RCTOT AL("ADM")) +$P(X,"^", 8)
	8154	"RTN","RCC PCPS1",75, 0)
	8155	. S RCT OTAL("OTH" )=$G(RCTOT AL("OTH")) +($P(RCDAT A1,"^",5)- $P(X,"^",7 )-$P(X,"^" ,8))
	8156	"RTN","RCC PCPS1",76, 0)
	8157	;
	8158	"RTN","RCC PCPS1",77, 0)
	8159	; if not an increa se adjustm ent, quit
	8160	"RTN","RCC PCPS1",78, 0)
	8161	I TRANTYP E'=1 Q
	8162	"RTN","RCC PCPS1",79, 0)
	8163	;
	8164	"RTN","RCC PCPS1",80, 0)
	8165	; increa se to c me ans test, ltc or rx- copay, get data from ib
	8166	"RTN","RCC PCPS1",81, 0)
	8167	I RCCATEG =18!(RCCAT EG=22)!(RC CATEG=23)! ((RCCATEG> 32)&(RCCAT EG<40)) D
	8168	"RTN","RCC PCPS1",82, 0)
	8169	. S X=" IBRFN1" X ^%ZOSF("TE ST") I '$T Q
	8170	"RTN","RCC PCPS1",83, 0)
	8171	. K ^TM P("IBRFN1" ,$J)
	8172	"RTN","RCC PCPS1",84, 0)
	8173	. D STM T^IBRFN1(R CTRANDA)
	8174	"RTN","RCC PCPS1",85, 0)
	8175	. D IBD ATA
	8176	"RTN","RCC PCPS1",86, 0)
	8177	Q
	8178	"RTN","RCC PCPS1",87, 0)
	8179	;
	8180	"RTN","RCC PCPS1",88, 0)
	8181	;
	8182	"RTN","RCC PCPS1",89, 0)
	8183	; Return s RCDESC(1 ..n) array of Bill D escription
	8184	"RTN","RCC PCPS1",90, 0)
	8185	BILLDESC(R CBILLDA,RC WIDTH) ;
	8186	"RTN","RCC PCPS1",91, 0)
	8187	; initia lize
	8188	"RTN","RCC PCPS1",92, 0)
	8189	N DESCRIP T,RCCATEG, RCCATTXT,R CDATA0,RCL INE,X
	8190	"RTN","RCC PCPS1",93, 0)
	8191	I '$G(RCW IDTH) S RC WIDTH=50 ; Default m ax. width is 50 char acters
	8192	"RTN","RCC PCPS1",94, 0)
	8193	K RCDESC
	8194	"RTN","RCC PCPS1",95, 0)
	8195	S RCLINE= 1,RCDESC(1 )=""
	8196	"RTN","RCC PCPS1",96, 0)
	8197	;
	8198	"RTN","RCC PCPS1",97, 0)
	8199	S RCDATA0 =^PRCA(430 ,RCBILLDA, 0)
	8200	"RTN","RCC PCPS1",98, 0)
	8201	S RCCATEG =+$P(RCDAT A0,"^",2), RCCATTXT=$ P($G(^PRCA (430.2,RCC ATEG,0))," ^")
	8202	"RTN","RCC PCPS1",99, 0)
	8203	;
	8204	"RTN","RCC PCPS1",100 ,0)
	8205	; if cat egory=c me ans test, set the de scription and quit
	8206	"RTN","RCC PCPS1",101 ,0)
	8207	I RCCATEG =18 S
	8208	DESCRIPT=$ S($P(RCDAT A0,"^",16) :$P(^PRCA( 430.2,$P(R CDATA0,"^" ,16),0),"^ "),1:RCCAT TXT) D
	8209	SETDESC(DE SCRIPT) Q
	8210	"RTN","RCC PCPS1",102 ,0)
	8211	;
	8212	"RTN","RCC PCPS1",103 ,0)
	8213	; set th e category descripti on
	8214	"RTN","RCC PCPS1",104 ,0)
	8215	D SETDESC (RCCATTXT)
	8216	"RTN","RCC PCPS1",105 ,0)
	8217	;
	8218	"RTN","RCC PCPS1",106 ,0)
	8219	; if cat egory not champva su bsitence a nd not tri care patie nt, quit
	8220	"RTN","RCC PCPS1",107 ,0)
	8221	I RCCATEG '=27,RCCAT EG'=31 Q
	8222	"RTN","RCC PCPS1",108 ,0)
	8223	;
	8224	"RTN","RCC PCPS1",109 ,0)
	8225	; build descriptio n for cham pva subsis tence and tricare pa tient bill s
	8226	"RTN","RCC PCPS1",110 ,0)
	8227	; get da ta from ib
	8228	"RTN","RCC PCPS1",111 ,0)
	8229	S X="IBRF N1" X ^%ZO SF("TEST") I '$T Q
	8230	"RTN","RCC PCPS1",112 ,0)
	8231	K ^TMP("I BRFN1",$J)
	8232	"RTN","RCC PCPS1",113 ,0)
	8233	D STMTB^I BRFN1($P(R CDATA0,"^" ))
	8234	"RTN","RCC PCPS1",114 ,0)
	8235	D IBDATA
	8236	"RTN","RCC PCPS1",115 ,0)
	8237	Q
	8238	"RTN","RCC PCPS1",116 ,0)
	8239	;
	8240	"RTN","RCC PCPS1",117 ,0)
	8241	;
	8242	"RTN","RCC PCPS1",118 ,0)
	8243	IBDATA ; get data f rom IB for descripti on
	8244	"RTN","RCC PCPS1",119 ,0)
	8245	N IBDATA, IBJ
	8246	"RTN","RCC PCPS1",120 ,0)
	8247	;
	8248	"RTN","RCC PCPS1",121 ,0)
	8249	; show I B data
	8250	"RTN","RCC PCPS1",122 ,0)
	8251	S IBJ=0 F S IBJ=$O (^TMP("IBR FN1",$J,IB J)) Q:'IBJ S IBDATA =^TMP("IBR FN1",$J,IB J) D
	8252	"RTN","RCC PCPS1",123 ,0)
	8253	. ;
	8254	"RTN","RCC PCPS1",124 ,0)
	8255	. ; if no drug o r bill dat e returned from IB, then it is outpatien t
	8256	"RTN","RCC PCPS1",125 ,0)
	8257	. I $P( IBDATA,"^" ,3)="" D:$ P(IBDATA," ^",2) SETD ESC("VISIT DATE: "_$ $DATE($P(I BDATA,"^", 2))) Q
	8258	"RTN","RCC PCPS1",126 ,0)
	8259	. ;
	8260	"RTN","RCC PCPS1",127 ,0)
	8261	. ; if no drug q uantity re turned fro m ib, then it is inp atient
	8262	"RTN","RCC PCPS1",128 ,0)
	8263	. I '$P (IBDATA,"^ ",6) D Q
	8264	"RTN","RCC PCPS1",129 ,0)
	8265	. . I $P(IBDATA ,"^",2) D SETDESC(" ADMISSION DATE: "_$ $DATE($P(I BDATA,"^", 2)))
	8266	"RTN","RCC PCPS1",130 ,0)
	8267	. . I $P(IBDATA ,"^",3) D SETDESC(" BEGINNING DATE OF B ILLING CYC LE: "_$$DA TE($P(IBDA TA,"^",3)) )
	8268	"RTN","RCC PCPS1",131 ,0)
	8269	. . I $P(IBDATA ,"^",4) D SETDESC(" ENDING DA TE OF BILL ING CYCLE: "_$$DATE( $P(IBDATA, "^",4)))
	8270	"RTN","RCC PCPS1",132 ,0)
	8271	. . I $P(IBDATA ,"^",5) D SETDESC(" DISCHARGE DATE: "_$ $DATE($P(I BDATA,"^", 5)))
	8272	"RTN","RCC PCPS1",133 ,0)
	8273	. ;
	8274	"RTN","RCC PCPS1",134 ,0)
	8275	. ; ph armacy
	8276	"RTN","RCC PCPS1",135 ,0)
	8277	. D:$P( IBDATA,"^" ,2) SETDES C("RX:"_$P (IBDATA,"^ ",2))
	8278	"RTN","RCC PCPS1",136 ,0)
	8279	. D:$P( IBDATA,"^" ,7) SETDES C("FD:"_$$ DATE($P(IB DATA,"^",7 )))
	8280	"RTN","RCC PCPS1",137 ,0)
	8281	. ;
	8282	"RTN","RCC PCPS1",138 ,0)
	8283	. ; if not patie nt stateme nt detail, quit
	8284	"RTN","RCC PCPS1",139 ,0)
	8285	. I $$D ET^RCFN01( $P(RCDATA0 ,"^",9))'= 2 Q
	8286	"RTN","RCC PCPS1",140 ,0)
	8287	. ;
	8288	"RTN","RCC PCPS1",141 ,0)
	8289	. ; re turn pharm acy detail
	8290	"RTN","RCC PCPS1",142 ,0)
	8291	. I $P( IBDATA,"^" ,3)'="" D SETDESC(" DRUG:"_$TR ($P(IBDATA ,"^",3),"\| ~"))
	8292	"RTN","RCC PCPS1",143 ,0)
	8293	. I $P( IBDATA,"^" ,4) D SETD ESC(" DAYS :"_$P(IBDA TA,"^",4))
	8294	"RTN","RCC PCPS1",144 ,0)
	8295	. I $P( IBDATA,"^" ,6) D SETD ESC(" QTY: "_$P(IBDAT A,"^",6))
	8296	"RTN","RCC PCPS1",145 ,0)
	8297	. I $P( IBDATA,"^" ,5)'="" D SETDESC(" PHY:"_$P(I BDATA,"^", 5))
	8298	"RTN","RCC PCPS1",146 ,0)
	8299	. I $P( IBDATA,"^" ,8) D SETD ESC(" CHG: $"_$J($P(I BDATA,"^", 8),0,2))
	8300	"RTN","RCC PCPS1",147 ,0)
	8301	;
	8302	"RTN","RCC PCPS1",148 ,0)
	8303	K ^TMP("I BRFN1",$J)
	8304	"RTN","RCC PCPS1",149 ,0)
	8305	Q
	8306	"RTN","RCC PCPS1",150 ,0)
	8307	;
	8308	"RTN","RCC PCPS1",151 ,0)
	8309	;
	8310	"RTN","RCC PCPS1",152 ,0)
	8311	; Add lin e to the d escription , not long er than RC WIDTH
	8312	"RTN","RCC PCPS1",153 ,0)
	8313	; Input: RCLINE,RCW IDTH
	8314	"RTN","RCC PCPS1",154 ,0)
	8315	; Output: RCDESC
	8316	"RTN","RCC PCPS1",155 ,0)
	8317	SETDESC(DE SCRIPT) N LENGTH
	8318	"RTN","RCC PCPS1",156 ,0)
	8319	; calcul ate the le ngth of th e descript ion
	8320	"RTN","RCC PCPS1",157 ,0)
	8321	S LENGTH= $L(RCDESC( RCLINE))+$ L(DESCRIPT )
	8322	"RTN","RCC PCPS1",158 ,0)
	8323	I RCDESC( RCLINE)'=" " S LENGTH =LENGTH+1
	8324	"RTN","RCC PCPS1",159 ,0)
	8325	;
	8326	"RTN","RCC PCPS1",160 ,0)
	8327	; the de scription line canno t go over RCWIDTH ch aracters
	8328	"RTN","RCC PCPS1",161 ,0)
	8329	I LENGTH< RCWIDTH S RCDESC(RCL INE)=RCDES C(RCLINE)_ $S(RCDESC( RCLINE)="" :"",1:" ") _DESCRIPT Q
	8330	"RTN","RCC PCPS1",162 ,0)
	8331	;
	8332	"RTN","RCC PCPS1",163 ,0)
	8333	; Descrip tion line to add is over RCWID TH
	8334	"RTN","RCC PCPS1",164 ,0)
	8335	; The giv en string will be sp litted _on ly_ if the limit is more than 44 charact ers.
	8336	"RTN","RCC PCPS1",165 ,0)
	8337	I $L(DESC RIPT)>RCWI DTH D Q
	8338	"RTN","RCC PCPS1",166 ,0)
	8339	. I RCD ESC(RCLINE )'="" S RC LINE=RCLIN E+1
	8340	"RTN","RCC PCPS1",167 ,0)
	8341	. S RCD ESC(RCLINE )=$E(DESCR IPT,1,RCWI DTH)
	8342	"RTN","RCC PCPS1",168 ,0)
	8343	. S RCL INE=RCLINE +1
	8344	"RTN","RCC PCPS1",169 ,0)
	8345	. S RCD ESC(RCLINE )=$E(DESCR IPT,RCWIDT H+1,2*RCWI DTH)
	8346	"RTN","RCC PCPS1",170 ,0)
	8347	;
	8348	"RTN","RCC PCPS1",171 ,0)
	8349	; over R CWIDTH cha racters, s tart new l ine
	8350	"RTN","RCC PCPS1",172 ,0)
	8351	I RCDESC( RCLINE)'=" " S RCLINE =RCLINE+1
	8352	"RTN","RCC PCPS1",173 ,0)
	8353	S RCDESC( RCLINE)=DE SCRIPT
	8354	"RTN","RCC PCPS1",174 ,0)
	8355	Q
	8356	"RTN","RCC PCPS1",175 ,0)
	8357	;
	8358	"RTN","RCC PCPS1",176 ,0)
	8359	DATE(FMDT) ; format date mm/d d/yyyy
	8360	"RTN","RCC PCPS1",177 ,0)
	8361	I 'FMDT Q ""
	8362	"RTN","RCC PCPS1",178 ,0)
	8363	N X,Y,%DT S %DT="TX ",X=FMDT D ^%DT Q:Y< 0 ""
	8364	"RTN","RCC PCPS1",179 ,0)
	8365	Q $E(FMDT ,4,5)_"/"_ $E(FMDT,6, 7)_"/"_(17 00+$E(FMDT ,1,3))
	8366	"RTN","RCC PCPS1",180 ,0)
	8367	;
	8368	"RTN","RCC PCPS1",181 ,0)
	8369	KILL(SDT) ; PRCA4 .5313 - k ill data p rior to re creating f or this da y of month
	8370	"RTN","RCC PCPS1",182 ,0)
	8371	;
	8372	"RTN","RCC PCPS1",183 ,0)
	8373	; Set dat e back one month
	8374	"RTN","RCC PCPS1",184 ,0)
	8375	N IEN,X,R CT,DA,DIK, ACK
	8376	"RTN","RCC PCPS1",185 ,0)
	8377	;
	8378	"RTN","RCC PCPS1",186 ,0)
	8379	S IEN=""
	8380	"RTN","RCC PCPS1",187 ,0)
	8381	F S IEN= $O(^RCPS(3 49.2,"STDT ",SDT,IEN) ) Q:IEN="" S DA=IEN ,DIK="^RCP S(349.2," D ^DIK
	8382	"RTN","RCC PCPS1",188 ,0)
	8383	;
	8384	"RTN","RCC PCPS1",189 ,0)
	8385	F X="PA", "IS" S RCT =$O(^RCT(3 49.1,"B",X ,0)) Q:'RC T D
	8386	"RTN","RCC PCPS1",190 ,0)
	8387	. S ACK=" " F S ACK =$O(^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK)) Q :ACK="" D
	8388	"RTN","RCC PCPS1",191 ,0)
	8389	. . S IEN =0 F S IE N=$O(^RCT( 349.1,RCT, 4,"STDT4", SDT,ACK,IE N)) Q:IEN= "" S
	8390	DA=IEN,DIK ="^RCT(349 .1,"_RCT_" ,4," D ^DI K K ^RCT(3 49.1,RCT,4 ,"STDT4",S DT,ACK,IEN )
	8391	"RTN","RCC PCPS1",192 ,0)
	8392	. S IEN=0 F S IEN= $O(^RCT(34 9.1,RCT,5, "STDT5",SD T,IEN)) Q: IEN="" S
	8393	DA=IEN,DIK ="^RCT(349 .1,"_RCT_" ,5," D ^DI K K ^RCT(3 49.1,RCT,5 ,"STDT5",S DT,IEN)
	8394	"RTN","RCC PCPS1",193 ,0)
	8395	;
	8396	"RTN","RCC PCPS1",194 ,0)
	8397	K ^XTMP(" RCCPC")
	8398	"RTN","RCC PCPS1",195 ,0)
	8399	;
	8400	"RTN","RCC PCPS1",196 ,0)
	8401	Q
	8402	"RTN","RCC PCPS1",197 ,0)
	8403	;
	8404	"RTN","RCC PCPS1",198 ,0)
	8405	MONTHAGO(S DT) ; PRC A4.5313 - Return d ate one mo nth prior to entered date - SD T is state ment
	8406	date
	8407	"RTN","RCC PCPS1",199 ,0)
	8408	; and Sta tement dat e cannot e xceed 26th day of th e month.
	8409	"RTN","RCC PCPS1",200 ,0)
	8410	; New OLD DT in call ing routin e
	8411	"RTN","RCC PCPS1",201 ,0)
	8412	S OLDDT=S DT-100
	8413	"RTN","RCC PCPS1",202 ,0)
	8414	I $E(SDT, 4,5)="01" S OLDDT=($ E(SDT,1,3) -1)_12_$E( SDT,6,7)
	8415	"RTN","RCC PCPS1",203 ,0)
	8416	Q OLDDT
	8417	"RTN","RCC PCPS1",204 ,0)
	8418	;
	8419	"RTN","RCC PCPS1",205 ,0)
	8420	ICNERR ; PRCA4.5 313 - Send email to RCCPC STAT EMENTS Mai l Group wi th all mis sing ICNs
	8421	"RTN","RCC PCPS1",206 ,0)
	8422	N XMTO,XM SUBJ,XMBOD Y,XMINSTR, XMDUZ,XMY, DFN,CNT,I
	8423	"RTN","RCC PCPS1",207 ,0)
	8424	;
	8425	"RTN","RCC PCPS1",208 ,0)
	8426	; Create Message at MSG level of tempor ary storag e
	8427	"RTN","RCC PCPS1",209 ,0)
	8428	S CNT=1,^ TMP("ICNER ROR",$J,"M SG",CNT)=" The Patien t Statemen ts for the se patient s were not sent
	8429	to CBSS du e to a"
	8430	"RTN","RCC PCPS1",210 ,0)
	8431	S CNT=2,^ TMP("ICNER ROR",$J,"M SG",CNT)=" missing IC N."
	8432	"RTN","RCC PCPS1",211 ,0)
	8433	S CNT=3,^ TMP("ICNER ROR",$J,"M SG",CNT)=" NAME SSN"
	8434	"RTN","RCC PCPS1",212 ,0)
	8435	S CNT=4,^ TMP("ICNER ROR",$J,"M SG",CNT)=" ========== ========== ========== ========== ======"
	8436	"RTN","RCC PCPS1",213 ,0)
	8437	S DFN="" F S DFN=$ O(^TMP("IC NERROR",$J ,DFN)) Q:D FN="" Q:D FN="MSG" D
	8438	"RTN","RCC PCPS1",214 ,0)
	8439	. N NAME, SSN
	8440	"RTN","RCC PCPS1",215 ,0)
	8441	. D DEM^V ADPT ; DBI A#10061
	8442	"RTN","RCC PCPS1",216 ,0)
	8443	. S NAME= VADM(1)
	8444	"RTN","RCC PCPS1",217 ,0)
	8445	. S SSN=$ P(VADM(2), U)
	8446	"RTN","RCC PCPS1",218 ,0)
	8447	. I $L(NA ME)<35 S $ E(NAME,35) =" "
	8448	"RTN","RCC PCPS1",219 ,0)
	8449	. S CNT=C NT+1
	8450	"RTN","RCC PCPS1",220 ,0)
	8451	. S ^TMP( "ICNERROR" ,$J,"MSG", CNT)=NAME_ SSN
	8452	"RTN","RCC PCPS1",221 ,0)
	8453	;
	8454	"RTN","RCC PCPS1",222 ,0)
	8455	S XMDUZ=D UZ
	8456	"RTN","RCC PCPS1",223 ,0)
	8457	S XMTO(DU Z)=""
	8458	"RTN","RCC PCPS1",224 ,0)
	8459	S XMTO("G .RCCPC STA TEMENTS")= ""
	8460	"RTN","RCC PCPS1",225 ,0)
	8461	S XMSUBJ= "PATIENTS WITH MISSI NG ICNS"
	8462	"RTN","RCC PCPS1",226 ,0)
	8463	S XMBODY= "^TMP(""IC NERROR"",$ J,""MSG"") "
	8464	"RTN","RCC PCPS1",227 ,0)
	8465	S XMINSTR ("FLAGS")= "X"
	8466	"RTN","RCC PCPS1",228 ,0)
	8467	D SENDMSG ^XMXAPI(XM DUZ,XMSUBJ ,XMBODY,.X MTO,.XMINS TR)
	8468	"RTN","RCC PCPS1",229 ,0)
	8469	Q
	8470	"RTN","RCC PCSE")
	8471	0^14^B1650 7603^B5810 439
	8472	"RTN","RCC PCSE",1,0)
	8473	RCCPCSE ;W ASH-ISC@AL TOONA,PA/L DB - CCPC Statements Errors ;5 /30/96 10 :20 AM ;10 /16/96 8: 42
	8474	AM
	8475	"RTN","RCC PCSE",2,0)
	8476	V ;;4.5;Ac counts Rec eivable; 34,313;M ar 20, 199 5;Build 15 0
	8477	"RTN","RCC PCSE",3,0)
	8478	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8479	"RTN","RCC PCSE",4,0)
	8480	;
	8481	"RTN","RCC PCSE",5,0)
	8482	K ^TMP($J )
	8483	"RTN","RCC PCSE",6,0)
	8484	N ADD,DIR ,DIRUT,ERR ,ERROR,HDR ,LINE,LN,P G,POP,PT,X ,X1,Y,%ZIS ,Z,ZTRTN,Z TDESC,%,%Y ,ZTSAVE
	8485	"RTN","RCC PCSE",7,0)
	8486	I '$O(^RC PS(349.2," AD","E",0) ) W !,"THE RE ARE NO CBSS PATIE NT STATEME NT ERRORS" Q
	8487	"RTN","RCC PCSE",8,0)
	8488	E W !,"C BSS PATIEN T STATEMEN T ERROR RE PORT"
	8489	"RTN","RCC PCSE",9,0)
	8490	N IEN,%D, DTOUT,SDT, SDAT,TMPQ, ALL,DTPT
	8491	"RTN","RCC PCSE",10,0 )
	8492	S (TMPQ,A LL)=0
	8493	"RTN","RCC PCSE",11,0 )
	8494	S IEN="" F S IEN=$ O(^RCPS(34 9.2,"AD"," E",IEN)) Q :IEN="" I $G(^RCPS( 349.2,IEN, 5))'="" D
	8495	"RTN","RCC PCSE",12,0 )
	8496	. S SDT=$ P(^RCPS(34 9.2,IEN,0) ,U,19)
	8497	"RTN","RCC PCSE",13,0 )
	8498	. S DTPT( SDT,IEN)=" "
	8499	"RTN","RCC PCSE",14,0 )
	8500	. S DTPT( SDT)=$G(DT PT(SDT))+1
	8501	"RTN","RCC PCSE",15,0 )
	8502	; PRCA4. 5313 - As k about al l dates or specific
	8503	"RTN","RCC PCSE",16,0 )
	8504	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8505	"RTN","RCC PCSE",17,0 )
	8506	S DIR(0)= "YAO"
	8507	"RTN","RCC PCSE",18,0 )
	8508	S DIR("B" )="Y"
	8509	"RTN","RCC PCSE",19,0 )
	8510	S DIR("A" )="Do you want to pr int errors for all d ates avail able? "
	8511	"RTN","RCC PCSE",20,0 )
	8512	D ^DIR
	8513	"RTN","RCC PCSE",21,0 )
	8514	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8515	"RTN","RCC PCSE",22,0 )
	8516	I Y=1 S A LL=1 D PRI NT Q
	8517	"RTN","RCC PCSE",23,0 )
	8518	; PRCA4. 5313 - Ad d date pro mpts
	8519	"RTN","RCC PCSE",24,0 )
	8520	W !,"The following dates have errors to print:"
	8521	"RTN","RCC PCSE",25,0 )
	8522	S SDT="" F S SDT=$ O(DTPT(SDT )) Q:SDT= "" W !,$$ DATE^RCCPC PS1(SDT)
	8523	"RTN","RCC PCSE",26,0 )
	8524	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8525	"RTN","RCC PCSE",27,0 )
	8526	S DIR(0)= "DAO^^K:'$ D(DTPT(Y)) X"
	8527	"RTN","RCC PCSE",28,0 )
	8528	S DIR("A" )="Enter a Patient S tatement d ate from l ist above: "
	8529	"RTN","RCC PCSE",29,0 )
	8530	S DIR("?" )="Enter a Patient S tatement d ate from l ist above or ^ to ex it."
	8531	"RTN","RCC PCSE",30,0 )
	8532	D ^DIR
	8533	"RTN","RCC PCSE",31,0 )
	8534	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8535	"RTN","RCC PCSE",32,0 )
	8536	S SDT=Y
	8537	"RTN","RCC PCSE",33,0 )
	8538	D PRINT
	8539	"RTN","RCC PCSE",34,0 )
	8540	Q
	8541	"RTN","RCC PCSE",35,0 )
	8542	PRINT ; P RCA4.531 3 Determin e print de vice then enter Sort
	8543	"RTN","RCC PCSE",36,0 )
	8544	D HOME^%Z IS S %ZIS= "QN" D ^%Z IS Q:POP
	8545	"RTN","RCC PCSE",37,0 )
	8546	I $D(IO(" Q")) D Q
	8547	"RTN","RCC PCSE",38,0 )
	8548	.S ZTRTN= "SORT^RCCP CSE",ZTDES C="CBSS PA TIENT STAT EMENT ERRO R REPORT"
	8549	"RTN","RCC PCSE",39,0 )
	8550	. S TMPQ= 1,(ZTSAVE( "DTPT("),Z TSAVE("SDT "),ZTSAVE( "ALL"),ZTS AVE("TMPQ" ))=""
	8551	"RTN","RCC PCSE",40,0 )
	8552	.D ^%ZTLO AD
	8553	"RTN","RCC PCSE",41,0 )
	8554	SORT ; PR CA4.5313 - Rewritt en to prin t by date
	8555	"RTN","RCC PCSE",42,0 )
	8556	S HDR="CB SS PATIENT STATEMENT ERROR REP ORT",LINE= "",$P(LINE ,"=",79)=" ",PG=1
	8557	"RTN","RCC PCSE",43,0 )
	8558	I 'ALL D SORT1,PRNT Q
	8559	"RTN","RCC PCSE",44,0 )
	8560	I ALL S S DT=""
	8561	"RTN","RCC PCSE",45,0 )
	8562	F S SDT= $O(DTPT(SD T)) Q:SDT= "" D SORT 1
	8563	"RTN","RCC PCSE",46,0 )
	8564	D PRNT
	8565	"RTN","RCC PCSE",47,0 )
	8566	; PRCA4. 5313 - Re move TMP s torage
	8567	"RTN","RCC PCSE",48,0 )
	8568	K ^TMP($J )
	8569	"RTN","RCC PCSE",49,0 )
	8570	Q
	8571	"RTN","RCC PCSE",50,0 )
	8572	SORT1 ;PR CA4.5313 Print a d ay of erro rs
	8573	"RTN","RCC PCSE",51,0 )
	8574	N IEN
	8575	"RTN","RCC PCSE",52,0 )
	8576	S IEN="" F S IEN=$ O(DTPT(SDT ,IEN)) Q:I EN="" D
	8577	"RTN","RCC PCSE",53,0 )
	8578	.S ERR=$G (^RCPS(349 .2,IEN,5))
	8579	"RTN","RCC PCSE",54,0 )
	8580	.S ^TMP($ J,"ERR",SD T,IEN)=$P( $G(^RCPS(3 49.2,IEN,0 )),"^",3)_ "^"_$P(^(0 ),"^",2)
	8581	"RTN","RCC PCSE",55,0 )
	8582	.S ADD=$G (^RCPS(349 .2,IEN,1))
	8583	"RTN","RCC PCSE",56,0 )
	8584	.F X=1:1: 6 S ADD(X) =$P(ADD,"^ ",X),^TMP( $J,"ERR",S DT,IEN,1+X )=ADD(X)
	8585	"RTN","RCC PCSE",57,0 )
	8586	.F X=1:5 S X1=X+4,E RROR=$E(ER R,X,X1) Q: ERROR="" D
	8587	"RTN","RCC PCSE",58,0 )
	8588	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=ERROR
	8589	"RTN","RCC PCSE",59,0 )
	8590	..S ERROR =$O(^RCPSE (349.7,"B" ,$E(ERROR, 1,5),""))
	8591	"RTN","RCC PCSE",60,0 )
	8592	..S ERROR =$P($G(^RC PSE(349.7, +ERROR,0)) ,"^",4)
	8593	"RTN","RCC PCSE",61,0 )
	8594	..S ^TMP( $J,"ERR",S DT,IEN,X+1 0)=^TMP($J ,"ERR",SDT ,IEN,X+10) _"^"_ERROR
	8595	"RTN","RCC PCSE",62,0 )
	8596	;
	8597	"RTN","RCC PCSE",63,0 )
	8598	K ADD
	8599	"RTN","RCC PCSE",64,0 )
	8600	Q
	8601	"RTN","RCC PCSE",65,0 )
	8602	PRNT ; PR CA4.5313 - Print b ased upon statement date
	8603	"RTN","RCC PCSE",66,0 )
	8604	K DIRUT
	8605	"RTN","RCC PCSE",67,0 )
	8606	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	8607	"RTN","RCC PCSE",68,0 )
	8608	S (SDT,IE N)=""
	8609	"RTN","RCC PCSE",69,0 )
	8610	F S SDT= $O(^TMP($J ,"ERR",SDT )) Q:SDT=" " D I $D (DTOUT)!$D (DUOUT)!$D (DIRUT)!$D (DIROUT) Q
	8611	"RTN","RCC PCSE",70,0 )
	8612	. W @IOF, ?25,HDR,?7 5,PG,!,LIN E S PG=PG+ 1
	8613	"RTN","RCC PCSE",71,0 )
	8614	. W !,?20 ,"Patient Statement Date: "_$$ DATE^RCCPC PS1(SDT),! ,LINE
	8615	"RTN","RCC PCSE",72,0 )
	8616	. F S IE N=$O(^TMP( $J,"ERR",S DT,IEN)) Q :IEN="" D PRNT1 I
	8617	$D(DTOUT)! $D(DUOUT)! $D(DIRUT)! $D(DIROUT) Q
	8618	"RTN","RCC PCSE",73,0 )
	8619	. I 'TMPQ S DIR(0)= "E" D ^DIR I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8620	"RTN","RCC PCSE",74,0 )
	8621	Q
	8622	"RTN","RCC PCSE",75,0 )
	8623	PRNT1 ; P RCA4.531 3 - Print based upon statement date
	8624	"RTN","RCC PCSE",76,0 )
	8625	I ($Y+12) >IOSL D
	8626	"RTN","RCC PCSE",77,0 )
	8627	.I 'TMPQ S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	8628	"RTN","RCC PCSE",78,0 )
	8629	.W @IOF,? 25,HDR,?75 ,PG S PG=P G+1
	8630	"RTN","RCC PCSE",79,0 )
	8631	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	8632	"RTN","RCC PCSE",80,0 )
	8633	W !!,$E($ P(^TMP($J, "ERR",SDT, IEN),"^"), 1,25),?37, "ERROR COD ES",!,$P(^ (IEN),"^", 2),?30,$E( LINE,1,48)
	8634	"RTN","RCC PCSE",81,0 )
	8635	F X=2:1:4 S:$G(^TMP ($J,"ERR", SDT,IEN,X) )]"" ADD(X )=^(X)
	8636	"RTN","RCC PCSE",82,0 )
	8637	S ADD(5)= $G(^TMP($J ,"ERR",SDT ,IEN,5))_" , "_$G(^(6 ))_" "_$G( ^(7))
	8638	"RTN","RCC PCSE",83,0 )
	8639	S X=7 F S X=$O(^TM P($J,"ERR" ,SDT,IEN,X )) Q:'X S ERR(X-1)= ^(X)
	8640	"RTN","RCC PCSE",84,0 )
	8641	S (Z,Y)=0 F D Q:Y =""&(Z="")
	8642	"RTN","RCC PCSE",85,0 )
	8643	.W !
	8644	"RTN","RCC PCSE",86,0 )
	8645	.I Z'="" S Z=$O(ADD (Z)) I Z'= "",(ADD(Z) ]"") W ADD (Z)
	8646	"RTN","RCC PCSE",87,0 )
	8647	.I Y'="" S Y=$O(ERR (Y)) I Y'= "" W ?30,$ P(ERR(Y)," ^"),?40,$P (ERR(Y),"^ ",2)
	8648	"RTN","RCC PCSE",88,0 )
	8649	W !,LINE
	8650	"RTN","RCC PCSE",89,0 )
	8651	Q
	8652	"RTN","RCC PCSV")
	8653	0^9^B11825 361^B51994 90
	8654	"RTN","RCC PCSV",1,0)
	8655	RCCPCSV ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 11: 36 AM
	8656	"RTN","RCC PCSV",2,0)
	8657	V ;;4.5;Ac counts Rec eivable; 34,70,87,3 13;Mar 2 0, 1995;Bu ild 150
	8658	"RTN","RCC PCSV",3,0)
	8659	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8660	"RTN","RCC PCSV",4,0)
	8661	;
	8662	"RTN","RCC PCSV",5,0)
	8663	EN ;INPUT FROM MESSA GE
	8664	"RTN","RCC PCSV",6,0)
	8665	RREC ;READ INCOMING MESSAGE
	8666	"RTN","RCC PCSV",7,0)
	8667	N
	8668	DAT,DEB,EN D,ERR,ERRO R,EVN,KEY, LABEL,LN,M SG,P,RCMSG ,RCTR,RCX, RCX1,RE,SB AL,STOT,TR ,TR0,TR1,T
	8669	XT
	8670	"RTN","RCC PCSV",8,0)
	8671	N SDT,NOE RR,X,Y,DA
	8672	"RTN","RCC PCSV",9,0)
	8673	K ^TMP($J )
	8674	"RTN","RCC PCSV",10,0 )
	8675	S (LN,MSG ,RCX,RE)=0
	8676	"RTN","RCC PCSV",11,0 )
	8677	S TXT=0 F X XMREC Q:XMER<0!( XMRG="") S TXT=TXT+ 1,^TMP($J, "MSG",TXT) =XMRG
	8678	"RTN","RCC PCSV",12,0 )
	8679	S (DA(1), NOERR)=""
	8680	"RTN","RCC PCSV",13,0 )
	8681	S TXT=1 F S TXT=$O (^TMP($J," MSG",TXT)) Q:'TXT D
	8682	"RTN","RCC PCSV",14,0 )
	8683	. S:^TMP( $J,"MSG",T XT)?1"PA^" .E DA(1)=4 S:^TMP($J ,"MSG",TXT )?1"IS".E DA(1)=3
	8684	"RTN","RCC PCSV",15,0 )
	8685	. ; PRCA* 4.5*313 - Set Statem ent date f rom PA or IS records
	8686	"RTN","RCC PCSV",16,0 )
	8687	. I "PAIS "[$E(^TMP( $J,"MSG",T XT),1,2) S X=$P(^TMP ($J,"MSG", TXT),"^",7 ) D ^%DT S SDT=Y
	8688	"RTN","RCC PCSV",17,0 )
	8689	. ; PRCA* 4.5*313 - If the dat e and sequ ence numbe r have alr eady been processed quit after setting a n
	8690	error
	8691	"RTN","RCC PCSV",18,0 )
	8692	. I "PAIS "[$P(^TMP( $J,"MSG",T XT),U) I
	8693	($D(^RCT(3 49.1,DA(1) ,4,"STDT4" ,SDT,$P(^T MP($J,"MSG ",TXT),U,2 )))) D Q
	8694	"RTN","RCC PCSV",19,0 )
	8695	. . S ERR ="Duplicat e file was received for Patien t Statemen t Date: "_ $P(^TMP($J ,"MSG",TXT ),U,7) D
	8696	ERRMSG
	8697	"RTN","RCC PCSV",20,0 )
	8698	. . S ERR ="Last Mes sage Ackno wledgement Number: " _$P(^TMP($ J,"MSG",TX T),U,2) D ERRMSG
	8699	"RTN","RCC PCSV",21,0 )
	8700	. . S SDT =$P(^TMP($ J,"MSG",TX T),U,7)
	8701	"RTN","RCC PCSV",22,0 )
	8702	. ; PRCA* 4.5*313 - If IT is r eceived it always pr ocesses
	8703	"RTN","RCC PCSV",23,0 )
	8704	. I $P(^T MP($J,"MSG ",TXT),U)= "IT" S SDT =$P(^TMP($ J,"MSG",TX T),"^",6), NOERR=1 Q
	8705	"RTN","RCC PCSV",24,0 )
	8706	. I $G(XM Z)=""!('DA (1))!($D(E RR)) Q
	8707	"RTN","RCC PCSV",25,0 )
	8708	. S RCX=R CX+1
	8709	"RTN","RCC PCSV",26,0 )
	8710	. I "PAIS ADID"[$E(^ TMP($J,"MS G",TXT),1, 2) D
	8711	"RTN","RCC PCSV",27,0 )
	8712	. . ; PRC A4.5313 - Add Stat ement Date to 349.1, five leve l for PA, IS, AD, an d ID recor ds
	8713	"RTN","RCC PCSV",28,0 )
	8714	. . N DIN UM,DIC,X
	8715	"RTN","RCC PCSV",29,0 )
	8716	. . S DIN UM=+$G(XMZ )_RCX
	8717	"RTN","RCC PCSV",30,0 )
	8718	. . S DIC ="^RCT(349 .1,DA(1),5 ,"
	8719	"RTN","RCC PCSV",31,0 )
	8720	. . S X=$ P(^TMP($J, "MSG",TXT) ,"^",2)
	8721	"RTN","RCC PCSV",32,0 )
	8722	. . S DIC (0)="L"
	8723	"RTN","RCC PCSV",33,0 )
	8724	. . S DIC ("DR")=".0 2////"_$P( ^TMP($J,"M SG",TXT)," ^",3)_";.0 3////"_$G( XMZ)_";.04 ////"_SDT
	8725	"RTN","RCC PCSV",34,0 )
	8726	. . D FIL E^DICN
	8727	"RTN","RCC PCSV",35,0 )
	8728	. ; PRCA* 4.5*313 - If process ing has oc curred
	8729	"RTN","RCC PCSV",36,0 )
	8730	. S NOERR =1
	8731	"RTN","RCC PCSV",37,0 )
	8732	;
	8733	"RTN","RCC PCSV",38,0 )
	8734	K DA(1)
	8735	"RTN","RCC PCSV",39,0 )
	8736	I NOERR D SEG,KILL^ XM
	8737	"RTN","RCC PCSV",40,0 )
	8738	I $O(^TMP ($J,"ERR", 0)) D
	8739	"RTN","RCC PCSV",41,0 )
	8740	. ; PRCA* 4.5*313 - Change CCP C to CBSS and add da te
	8741	"RTN","RCC PCSV",42,0 )
	8742	. S XMSUB ="CBSS ERR OR MESSAGE TO STATIO N FOR "_SD T
	8743	"RTN","RCC PCSV",43,0 )
	8744	. S XMDUZ ="AR PACKA GE"
	8745	"RTN","RCC PCSV",44,0 )
	8746	. S XMTEX T="^TMP($J ,"_"""ERR" ","
	8747	"RTN","RCC PCSV",45,0 )
	8748	. I $O(^X MB(3.8,"B" ,"RCCPC ST ATEMENTS", 0)) S XMY( "G.RCCPC S TATEMENTS" )=""
	8749	"RTN","RCC PCSV",46,0 )
	8750	. D ^XMD
	8751	"RTN","RCC PCSV",47,0 )
	8752	. K ^TMP( $J)
	8753	"RTN","RCC PCSV",48,0 )
	8754	. ; PRCA* 4.5*313 - Change to send SDT f or resend
	8755	"RTN","RCC PCSV",49,0 )
	8756	. D:$G(RE )="R"&($G( SDT)'="") EN^RCCPCML (SDT)
	8757	"RTN","RCC PCSV",50,0 )
	8758	E S XMZ= XQMSG,XMSE R="S."_XQS OP D REMSB MSG^XMA1C
	8759	"RTN","RCC PCSV",51,0 )
	8760	Q
	8761	"RTN","RCC PCSV",52,0 )
	8762	;
	8763	"RTN","RCC PCSV",53,0 )
	8764	SEG S RCMS G=1 S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) D
	8765	"RTN","RCC PCSV",54,0 )
	8766	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8767	"RTN","RCC PCSV",55,0 )
	8768	.S LABEL= $S(($P(RCT R,"^")]"") &($T(@($P( RCTR,"^")) )]""):$P(R CTR,"^"),1 :"ERROR")
	8769	"RTN","RCC PCSV",56,0 )
	8770	.D @(LABE L)
	8771	"RTN","RCC PCSV",57,0 )
	8772	Q
	8773	"RTN","RCC PCSV",58,0 )
	8774	;
	8775	"RTN","RCC PCSV",59,0 )
	8776	ERROR ;SEN D ERROR ME SSAGE TO M AIL GROUP
	8777	"RTN","RCC PCSV",60,0 )
	8778	;
	8779	"RTN","RCC PCSV",61,0 )
	8780	; PRCA4. 5313 - Ch ange CCPC to CBSS
	8781	"RTN","RCC PCSV",62,0 )
	8782	S ERR="CB SS ERROR - CANNOT RE AD MESSAGE FROM CBSS " D ERRMSG
	8783	"RTN","RCC PCSV",63,0 )
	8784	S ERR="An error has occurred in reading a message from the CBSS."
	8785	"RTN","RCC PCSV",64,0 )
	8786	D ERRMSG
	8787	"RTN","RCC PCSV",65,0 )
	8788	S ERR="Pl ease conta ct your IR M for assi stance."
	8789	"RTN","RCC PCSV",66,0 )
	8790	D ERRMSG
	8791	"RTN","RCC PCSV",67,0 )
	8792	S ERR="Th e MESSAGE WAS AS FOL LOWS:"
	8793	"RTN","RCC PCSV",68,0 )
	8794	D ERRMSG
	8795	"RTN","RCC PCSV",69,0 )
	8796	S ERR=^TM P($J,"MSG" ,RCMSG)
	8797	"RTN","RCC PCSV",70,0 )
	8798	D ERRMSG
	8799	"RTN","RCC PCSV",71,0 )
	8800	Q
	8801	"RTN","RCC PCSV",72,0 )
	8802	;
	8803	"RTN","RCC PCSV",73,0 )
	8804	IS ;INVALI D STATEMEN T
	8805	"RTN","RCC PCSV",74,0 )
	8806	D IS^RCCP CSV1
	8807	"RTN","RCC PCSV",75,0 )
	8808	Q
	8809	"RTN","RCC PCSV",76,0 )
	8810	;
	8811	"RTN","RCC PCSV",77,0 )
	8812	PA ;STATEM ENT ACKNOW LEDGEMENT
	8813	"RTN","RCC PCSV",78,0 )
	8814	D PA^RCCP CSV1
	8815	"RTN","RCC PCSV",79,0 )
	8816	Q
	8817	"RTN","RCC PCSV",80,0 )
	8818	;
	8819	"RTN","RCC PCSV",81,0 )
	8820	IT ;INVALI D TRANSMIS SION
	8821	"RTN","RCC PCSV",82,0 )
	8822	D IT^RCCP CSV1
	8823	"RTN","RCC PCSV",83,0 )
	8824	Q
	8825	"RTN","RCC PCSV",84,0 )
	8826	;
	8827	"RTN","RCC PCSV",85,0 )
	8828	ERRMSG ;ER ROR MESSAG E
	8829	"RTN","RCC PCSV",86,0 )
	8830	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	8831	"RTN","RCC PCSV",87,0 )
	8832	Q
	8833	"RTN","RCC PCSV1")
	8834	0^12^B4364 5817^B3201 7096
	8835	"RTN","RCC PCSV1",1,0 )
	8836	RCCPCSV1 ; WASH-ISC@A LTOONA,PA/ LDB-Receiv e and Proc ess CCPC m essages ;1 /6/97 2:5 4 PM
	8837	"RTN","RCC PCSV1",2,0 )
	8838	;;4.5;Acc ounts Rece ivable;*3 4,70,76,13 0,153,313 *;Mar 20, 1995;Build 150
	8839	"RTN","RCC PCSV1",3,0 )
	8840	;;Per VA Directive 6402, this routine s hould not be modifie d.
	8841	"RTN","RCC PCSV1",4,0 )
	8842	;
	8843	"RTN","RCC PCSV1",5,0 )
	8844	IS ;INVALI D STATEMEN T
	8845	"RTN","RCC PCSV1",6,0 )
	8846	; PRCA4. 5313 - Ad d SDT for Patient St atement Da te
	8847	"RTN","RCC PCSV1",7,0 )
	8848	N SDAT,SD T,X,Y,ERR
	8849	"RTN","RCC PCSV1",8,0 )
	8850	S SDAT=$P (RCTR,"^", 7) S (X,SD T)=SDAT D ^%DT S SDA T=Y
	8851	"RTN","RCC PCSV1",9,0 )
	8852	D CHKTRAN (LABEL)
	8853	"RTN","RCC PCSV1",10, 0)
	8854	S ERR="Th e followin g statemen ts did not print due to errors :" D ERRMS G
	8855	"RTN","RCC PCSV1",11, 0)
	8856	S ERR=" " D ERRMSG
	8857	"RTN","RCC PCSV1",12, 0)
	8858	S ERR=" KEY ER ROR" D ERR MSG S ERR= " " D ERRM SG
	8859	"RTN","RCC PCSV1",13, 0)
	8860	D ID
	8861	"RTN","RCC PCSV1",14, 0)
	8862	S ERR="If these err ors are co rrected, t hese state ments will not print until" D ERRMSG S E RR="the ne xt
	8863	billing cy cle." D ER RMSG
	8864	"RTN","RCC PCSV1",15, 0)
	8865	Q
	8866	"RTN","RCC PCSV1",16, 0)
	8867	;
	8868	"RTN","RCC PCSV1",17, 0)
	8869	ID ;INVALI D STATEMEN T DETAIL E RROR
	8870	"RTN","RCC PCSV1",18, 0)
	8871	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8872	"RTN","RCC PCSV1",19, 0)
	8873	.; PRCA4 .5313 - C lean up va riables
	8874	"RTN","RCC PCSV1",20, 0)
	8875	.N KEY,DE B,ERROR,RC X,RCX1,ERR ; PRCA4 .5313/DM remove LN, assume it 's set in RCCPCSV
	8876	"RTN","RCC PCSV1",21, 0)
	8877	.I $P(^TM P($J,"MSG" ,RCMSG),"^ ")'="ID" S ERR="ERRO R IN READI NG CBSS ER ROR RECORD " D ERRMSG
	8878	Q
	8879	"RTN","RCC PCSV1",22, 0)
	8880	.S KEY=$P (^TMP($J," MSG",RCMSG ),"^",2),K EY=$TR(KEY ,"
	8881	",""),KEY= $E(KEY,$F( KEY,$$SITE ^RCMSITE), 999)
	8882	"RTN","RCC PCSV1",23, 0)
	8883	.I KEY']" " D KEYERR Q
	8884	"RTN","RCC PCSV1",24, 0)
	8885	.S DEB=$O (^RCPS(349 .2,"AKEY", KEY,0)) I 'DEB D KEY ERR Q
	8886	"RTN","RCC PCSV1",25, 0)
	8887	.S ERROR= $P(^TMP($J ,"MSG",RCM SG),"^",3) ,^RCPS(349 .2,+DEB,5) =ERROR
	8888	"RTN","RCC PCSV1",26, 0)
	8889	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERR(0)=$E( ERROR,RCX, RCX1) Q:ER R(0)="" D
	8890	"RTN","RCC PCSV1",27, 0)
	8891	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERR(0)," "))
	8892	"RTN","RCC PCSV1",28, 0)
	8893	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RR(0)
	8894	"RTN","RCC PCSV1",29, 0)
	8895	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 )
	8896	"RTN","RCC PCSV1",30, 0)
	8897	..S ERR=K EY_" "_ERR (0)_" "_ER R
	8898	"RTN","RCC PCSV1",31, 0)
	8899	..D ERRMS G
	8900	"RTN","RCC PCSV1",32, 0)
	8901	..S ERR=" " D ERRMS G
	8902	"RTN","RCC PCSV1",33, 0)
	8903	.S ^RCPS( 349.2,+DEB ,5)=$P(^TM P($J,"MSG" ,RCMSG),"^ ",3)
	8904	"RTN","RCC PCSV1",34, 0)
	8905	.S ^RCPS( 349.2,"AD" ,"E",+DEB) =""
	8906	"RTN","RCC PCSV1",35, 0)
	8907	Q
	8908	"RTN","RCC PCSV1",36, 0)
	8909	;
	8910	"RTN","RCC PCSV1",37, 0)
	8911	;
	8912	"RTN","RCC PCSV1",38, 0)
	8913	KEYERR ;SE ND MESSAGE TO MAIL G ROUP INDIC ATING NO K EY
	8914	"RTN","RCC PCSV1",39, 0)
	8915	S ERR="CB SS ERROR M ESSAGE - N O AR KEY I D FOR CBSS KEY: "_KE Y D ERRMSG
	8916	"RTN","RCC PCSV1",40, 0)
	8917	S ERR="Th is patient record is corrupted . Please c ontact IRM ." D ERRMS G
	8918	"RTN","RCC PCSV1",41, 0)
	8919	S ERR=" " D ERRMSG
	8920	"RTN","RCC PCSV1",42, 0)
	8921	Q
	8922	"RTN","RCC PCSV1",43, 0)
	8923	;
	8924	"RTN","RCC PCSV1",44, 0)
	8925	PA ;STATEM ENT ACKNOW LEDGEMENT
	8926	"RTN","RCC PCSV1",45, 0)
	8927	N STDT,SS TDT,SDAT,S DT,IEN,DEB ,X,Y,STOT, SEQ,KEY,EN D,SBAL,EVN ,DA,DIK
	8928	"RTN","RCC PCSV1",46, 0)
	8929	Q:$P(RCTR ,"^")'="PA "
	8930	"RTN","RCC PCSV1",47, 0)
	8931	; D CHKTR AN(LABEL)
	8932	"RTN","RCC PCSV1",48, 0)
	8933	S (X,SDT) =$P(RCTR," ^",7) D ^% DT S SDAT= Y
	8934	"RTN","RCC PCSV1",49, 0)
	8935	D CHKTRAN (LABEL)
	8936	"RTN","RCC PCSV1",50, 0)
	8937	S STOT=+$ P(RCTR,"^" ,6)
	8938	"RTN","RCC PCSV1",51, 0)
	8939	S SEQ=+$P (RCTR,"^", 3)
	8940	"RTN","RCC PCSV1",52, 0)
	8941	F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	8942	"RTN","RCC PCSV1",53, 0)
	8943	.N P
	8944	"RTN","RCC PCSV1",54, 0)
	8945	.S RCTR=^ TMP($J,"MS G",RCMSG)
	8946	"RTN","RCC PCSV1",55, 0)
	8947	.Q:$P(RCT R,"^")'="A D"
	8948	"RTN","RCC PCSV1",56, 0)
	8949	.S KEY=$P (RCTR,"^", 2),KEY=$TR (KEY," "," "),KEY=$E( KEY,$F(KEY ,$$SITE^RC MSITE),999 )
	8950	"RTN","RCC PCSV1",57, 0)
	8951	.I KEY']" " D KEYERR Q
	8952	"RTN","RCC PCSV1",58, 0)
	8953	.;PRCA4. 5313 - Fi nd Debtor using IEN from 349.2
	8954	"RTN","RCC PCSV1",59, 0)
	8955	.S IEN=$O (^RCPS(349 .2,"AKEY", KEY,0))
	8956	"RTN","RCC PCSV1",60, 0)
	8957	.I '$G(IE N) D KEYER R Q
	8958	"RTN","RCC PCSV1",61, 0)
	8959	.S DEB=$P ($G(^RCPS( 349.2,IEN, 0)),U)
	8960	"RTN","RCC PCSV1",62, 0)
	8961	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	8962	"RTN","RCC PCSV1",63, 0)
	8963	.I IEN S END=$P(^RC PS(349.2,+ IEN,0),"^" ,10)
	8964	"RTN","RCC PCSV1",64, 0)
	8965	.S:'$G(EN D) END=$O( ^RCPS(349. 2,"STDT",S DAT,0)),EN D=$P($G(^( +END,0))," ^",10)
	8966	"RTN","RCC PCSV1",65, 0)
	8967	.F P=13:1 :17 S SBAL (P)=$P(^RC PS(349.2,+ IEN,0),"^" ,P)
	8968	"RTN","RCC PCSV1",66, 0)
	8969	.;update patient st atement da te in 341 to end pro cess time
	8970	"RTN","RCC PCSV1",67, 0)
	8971	.D
	8972	OPEN^RCEVD RV1(2,$P(^ RCD(340,DE B,0),U),EN D,DUZ,$$SI TE^RCMSITE ,.ERR,.EVN ,SBAL(13)_ U_SBAL(14)
	8973	_U_SBAL(15 )_U_SBAL(1 6)_U_SBAL( 17))
	8974	"RTN","RCC PCSV1",68, 0)
	8975	.I EVN S DR=".07/// /"_END_";. 11////"_1, DA=+EVN,DI E="^RC(341 ," D ^DIE K DIE,DR,D A
	8976	"RTN","RCC PCSV1",69, 0)
	8977	.; PRCA4 .5313 - A dd cross-r eference f or File
	8978	"RTN","RCC PCSV1",70, 0)
	8979	.I EVN S $P(^RC(341 ,+EVN,6)," ^")=$G(SDA T) D
	8980	"RTN","RCC PCSV1",71, 0)
	8981	. .S DA=+ EVN,DIK="^ RC(341," D IX1^DIK
	8982	"RTN","RCC PCSV1",72, 0)
	8983	.;update bill file 430 letter fields
	8984	"RTN","RCC PCSV1",73, 0)
	8985	.NEW BN,D A,DIC,DIE, DR,II,LET, NOT,X,Y
	8986	"RTN","RCC PCSV1",74, 0)
	8987	.S DIE="^ PRCA(430," ,NOT=0,BN= 0
	8988	"RTN","RCC PCSV1",75, 0)
	8989	.F S BN= $O(^PRCA(4 30,"AS",DE B,16,BN)) Q:'BN S D A=BN D
	8990	"RTN","RCC PCSV1",76, 0)
	8991	..S LET=$ G(^PRCA(43 0,BN,6))
	8992	"RTN","RCC PCSV1",77, 0)
	8993	..I $P(LE T,"^",21)> END Q
	8994	"RTN","RCC PCSV1",78, 0)
	8995	..S END=$ G(SDAT)
	8996	"RTN","RCC PCSV1",79, 0)
	8997	..F II=1: 1:4 Q:$P(L ET,U,II)=E ND I $P(L ET,U,II)=" " S DR=$S( II=1:61,II =2:62,II=3 :63,1:68)_ "////^S
	8998	X="_END_"; 68.1////^S X="_END D ^DIE Q
	8999	"RTN","RCC PCSV1",80, 0)
	9000	.;PRCA4. 5313 - Ch ange DEB t o IEN for all date f rom 349.2
	9001	"RTN","RCC PCSV1",81, 0)
	9002	.S ^RCPS( 349.2,+IEN ,6)=1
	9003	"RTN","RCC PCSV1",82, 0)
	9004	PAMAIL ;
	9005	"RTN","RCC PCSV1",83, 0)
	9006	N XMSUB,X MY,XMDUZ,X MTEXT,MSG
	9007	"RTN","RCC PCSV1",84, 0)
	9008	; PRCA4. 5313 - Ch ange to CB SS
	9009	"RTN","RCC PCSV1",85, 0)
	9010	S XMSUB=" Patient Ac knowledgem ents recei ved from C BSS."
	9011	"RTN","RCC PCSV1",86, 0)
	9012	S XMY("G. RCCPC STAT EMENTS")=" ",XMDUZ="A R PACKAGE" ,XMTEXT="M SG("
	9013	"RTN","RCC PCSV1",87, 0)
	9014	; PRCA4. 5313 - Ad d Patient Statement Date and r enumber ot her lines
	9015	"RTN","RCC PCSV1",88, 0)
	9016	S MSG(1)= "For Patie nt Stateme nt Date of "_SDT_"."
	9017	"RTN","RCC PCSV1",89, 0)
	9018	S MSG(2)= "Patient a cknowledge ment messa ge "_$G(XM Z)_" recei ved."
	9019	"RTN","RCC PCSV1",90, 0)
	9020	S MSG(3)= "This mean s that CBS S has prin ted patien t statemen ts for thi s statemen t period."
	9021	"RTN","RCC PCSV1",91, 0)
	9022	D ^XMD
	9023	"RTN","RCC PCSV1",92, 0)
	9024	Q
	9025	"RTN","RCC PCSV1",93, 0)
	9026	;
	9027	"RTN","RCC PCSV1",94, 0)
	9028	CHKTRAN(LA BEL) ;Chec k for inco mplete mes sage from CCPC
	9029	"RTN","RCC PCSV1",95, 0)
	9030	; PRCA4. 5313 - Ad d multiple entries b ased upon date to fo ur level
	9031	"RTN","RCC PCSV1",96, 0)
	9032	Q:$G(LABE L)']""
	9033	"RTN","RCC PCSV1",97, 0)
	9034	N PSIEN,D A,DIK,DO,D IC,X
	9035	"RTN","RCC PCSV1",98, 0)
	9036	S LABEL(1 )=+$O(^RCT (349.1,"B" ,LABEL,0))
	9037	"RTN","RCC PCSV1",99, 0)
	9038	; PRCA4. 5313 - Ad d Patient Statement Date to fo ur level
	9039	"RTN","RCC PCSV1",100 ,0)
	9040	I LABEL(1 ),$P(^TMP( $J,"MSG",R CMSG),"^", 2)=$P(^TMP ($J,"MSG", RCMSG),"^" ,3) D
	9041	"RTN","RCC PCSV1",101 ,0)
	9042	. S DIC=" ^RCT(349.1 ,LABEL(1), 4,"
	9043	"RTN","RCC PCSV1",102 ,0)
	9044	. S X=$P( ^TMP($J,"M SG",RCMSG) ,"^",2)
	9045	"RTN","RCC PCSV1",103 ,0)
	9046	. S DA(1) =LABEL(1), DIC(0)="L"
	9047	"RTN","RCC PCSV1",104 ,0)
	9048	. S DIC(" DR")=".02/ ///"_$P(^T MP($J,"MSG ",RCMSG)," ^",3)_";.0 3////"_$G( XMZ)_";.04 ////"_SDAT
	9049	"RTN","RCC PCSV1",105 ,0)
	9050	. D FILE^ DICN
	9051	"RTN","RCC PCSV1",106 ,0)
	9052	Q
	9053	"RTN","RCC PCSV1",107 ,0)
	9054	;
	9055	"RTN","RCC PCSV1",108 ,0)
	9056	TRANCHK ;C heck for c omplete AC K transmis sion
	9057	"RTN","RCC PCSV1",109 ,0)
	9058	; PRCA4. 5313 - Ch eck for st atement da tes five t o seven da ys in past since bui ld and tra nsmit.
	9059	"RTN","RCC PCSV1",110 ,0)
	9060	N X,Y,DAT E,SDT,I,X1 ,X2
	9061	"RTN","RCC PCSV1",111 ,0)
	9062	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
	9063	"RTN","RCC PCSV1",112 ,0)
	9064	Q
	9065	"RTN","RCC PCSV1",113 ,0)
	9066	;
	9067	"RTN","RCC PCSV1",114 ,0)
	9068	TRANCHK1 ; PRCA4.5 313 - Vali date trans mission co mpleteness for date provided.
	9069	"RTN","RCC PCSV1",115 ,0)
	9070	N MSG,RCT ,SEG,SEQ,C NT,IEN,XMD UZ,XMSUB,X MTEXT,XMY
	9071	"RTN","RCC PCSV1",116 ,0)
	9072	F RCT=3,4 S CNT=$O( ^RCT(349.1 ,RCT,4,"ST DT4",SDT,0 )) I CNT'= "" D
	9073	"RTN","RCC PCSV1",117 ,0)
	9074	.S IEN=$O (^RCT(349. 1,RCT,4,"S TDT4",SDT, CNT,0)) D
	9075	"RTN","RCC PCSV1",118 ,0)
	9076	..I IEN'= "",$P($G(^ RCT(349.1, +RCT,4,IEN ,0)),"^")' =$P($G(^RC T(349.1,+R CT,4,IEN,0 )),"^",2) D TRANSEND
	9077	"RTN","RCC PCSV1",119 ,0)
	9078	Q
	9079	"RTN","RCC PCSV1",120 ,0)
	9080	;
	9081	"RTN","RCC PCSV1",121 ,0)
	9082	TRANSEND ; PRCA4.5 313 Send Transmissi on
	9083	"RTN","RCC PCSV1",122 ,0)
	9084	S XMDUZ=" AR PACKAGE "
	9085	"RTN","RCC PCSV1",123 ,0)
	9086	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9087	"RTN","RCC PCSV1",124 ,0)
	9088	S XMSUB=" CBSS ACKNO WLEDGEMENT TRANSMISS ION(S) INC OMPLETE"
	9089	"RTN","RCC PCSV1",125 ,0)
	9090	I $O(^XMB (3.8,"B"," RCCPC STAT EMENTS",0) ) S XMY("G .RCCPC STA TEMENTS")= "" E S XM Y(.5)=""
	9091	"RTN","RCC PCSV1",126 ,0)
	9092	S XMTEXT= "MSG("
	9093	"RTN","RCC PCSV1",127 ,0)
	9094	S SEG=$S( RCT=3:"IS" ,1:"PA")
	9095	"RTN","RCC PCSV1",128 ,0)
	9096	S SEG(1)= $P(^RCT(34 9.1,+RCT,4 ,IEN,0),"^ ",2)
	9097	"RTN","RCC PCSV1",129 ,0)
	9098	; PRCA4. 5313 - Ad d line ide ntifying P atient Sta tement Dat e that err ored
	9099	"RTN","RCC PCSV1",130 ,0)
	9100	S MSG(2)= "For Patie nt Stateme nt Date of "_DATE_". "
	9101	"RTN","RCC PCSV1",131 ,0)
	9102	; PRCA4. 5313 - Ch ange CCPC to CBSS
	9103	"RTN","RCC PCSV1",132 ,0)
	9104	S MSG(3)= "The last "_SEG_" se gment mess age receiv ed from CB SS was num bered "_SE G(1)_"."
	9105	"RTN","RCC PCSV1",133 ,0)
	9106	S MSG(4)= "This was not labele d the fina l message in that se gment type transmiss ion."
	9107	"RTN","RCC PCSV1",134 ,0)
	9108	S MSG(5)= "This may cause pati ent statem ent inform ation to b e missing. "
	9109	"RTN","RCC PCSV1",135 ,0)
	9110	S MSG(6)= "The last message nu mber recei ved was "_ $P($G(^RCT (349.1,RCT ,4,IEN,0)) ,"^",3)_". "
	9111	"RTN","RCC PCSV1",136 ,0)
	9112	; PRCA4 .5313 - C hange CCPC to CBSS
	9113	"RTN","RCC PCSV1",137 ,0)
	9114	S MSG(7)= "Please co ntact the CBSS in Au stin."
	9115	"RTN","RCC PCSV1",138 ,0)
	9116	D ^XMD
	9117	"RTN","RCC PCSV1",139 ,0)
	9118	Q
	9119	"RTN","RCC PCSV1",140 ,0)
	9120	;
	9121	"RTN","RCC PCSV1",141 ,0)
	9122	;
	9123	"RTN","RCC PCSV1",142 ,0)
	9124	IT ;INVALI D TRANSMIS SION
	9125	"RTN","RCC PCSV1",143 ,0)
	9126	; PRCA4. 5313 - Ch ange messa ge from CC PC to CBSS
	9127	"RTN","RCC PCSV1",144 ,0)
	9128	N SDT,ERR ,MSG,RCX,R CX1,ERROR, RE
	9129	"RTN","RCC PCSV1",145 ,0)
	9130	S ERR="Th e CBSS pat ient state ment messa ges were n ot accepte d by CBSS" D ERRMSG
	9131	"RTN","RCC PCSV1",146 ,0)
	9132	; PRCA4. 5313 - Ad d statemen t date to error mess age
	9133	"RTN","RCC PCSV1",147 ,0)
	9134	S SDT=$P( ^TMP($J,"M SG",RCMSG) ,"^",6)
	9135	"RTN","RCC PCSV1",148 ,0)
	9136	S ERR="fo r "_SDT_" due to the following error(s): " D ERRMSG
	9137	"RTN","RCC PCSV1",149 ,0)
	9138	S ERR=" " D ERRMSG
	9139	"RTN","RCC PCSV1",150 ,0)
	9140	S RCMSG=1 F S RCMS G=$O(^TMP( $J,"MSG",R CMSG)) Q:' RCMSG D
	9141	"RTN","RCC PCSV1",151 ,0)
	9142	.S MSG=^T MP($J,"MSG ",RCMSG)
	9143	"RTN","RCC PCSV1",152 ,0)
	9144	.S MSG=$P (MSG,"^",8 )
	9145	"RTN","RCC PCSV1",153 ,0)
	9146	.F RCX=1: 5:21 S RCX 1=RCX+4 S ERROR=$E(M SG,RCX,RCX 1) Q:ERROR ="" D
	9147	"RTN","RCC PCSV1",154 ,0)
	9148	..S ERR(1 )=$O(^RCPS E(349.7,"B ",ERROR,"" ))
	9149	"RTN","RCC PCSV1",155 ,0)
	9150	..I 'ERR( 1) S ERR=" NO ERROR D ESCRIPTION FOR ERROR CODE: "_E RROR
	9151	"RTN","RCC PCSV1",156 ,0)
	9152	..I ERR(1 ) S ERR=$P (^RCPSE(34 9.7,+ERR(1 ),0),"^",4 ),ERR=ERRO R_" "_ERR
	9153	"RTN","RCC PCSV1",157 ,0)
	9154	..I ERR(1 ) S:$P(^RC PSE(349.7, +ERR(1),0) ,"^",3)="R " RE=1
	9155	"RTN","RCC PCSV1",158 ,0)
	9156	..D ERRMS G
	9157	"RTN","RCC PCSV1",159 ,0)
	9158	S ERR=" " D ERRMSG
	9159	"RTN","RCC PCSV1",160 ,0)
	9160	S ERR="Pl ease conta ct IRM."
	9161	"RTN","RCC PCSV1",161 ,0)
	9162	D ERRMSG
	9163	"RTN","RCC PCSV1",162 ,0)
	9164	Q
	9165	"RTN","RCC PCSV1",163 ,0)
	9166	;
	9167	"RTN","RCC PCSV1",164 ,0)
	9168	ERRMSG ;ER ROR MESSAG E
	9169	"RTN","RCC PCSV1",165 ,0)
	9170	S LN=LN+1 ,^TMP($J," ERR",LN)=E RR
	9171	"RTN","RCC PCSV1",166 ,0)
	9172	Q
	9173	"RTN","RCC PCT")
	9174	0^15^B2933 0001^B2489 697
	9175	"RTN","RCC PCT",1,0)
	9176	RCCPCT ;WA SH-ISC@ALT OONA,PA/LD B - CCPC P atient Sta tement mes sage total s ;11/7/96 10:53 AM
	9177	"RTN","RCC PCT",2,0)
	9178	;;4.5;Acc ounts Rece ivable;3 4,313;Ma r 20, 1995 ;Build 150
	9179	"RTN","RCC PCT",3,0)
	9180	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9181	"RTN","RCC PCT",4,0)
	9182	EN ;
	9183	"RTN","RCC PCT",5,0)
	9184	D GO
	9185	"RTN","RCC PCT",6,0)
	9186	K TDT,TDT 1,TDT2,TDT 3,DATE,PTO T,TTOT,L,X ,Y,Y1,Y2,D ,IEN,POP,Q ,%,%DT,%ZI S,%Y,FIRST ,LAST
	9187	"RTN","RCC PCT",7,0)
	9188	Q
	9189	"RTN","RCC PCT",8,0)
	9190	GO ;
	9191	"RTN","RCC PCT",9,0)
	9192	W @IOF W !,"This re port will print the total Pati ent Statem ents sent to CBSS an d the"
	9193	"RTN","RCC PCT",10,0)
	9194	W !,"tota l acknowle dged as ha ving been printed wi th three d ifferent r eport"
	9195	"RTN","RCC PCT",11,0)
	9196	W !,"form ats availa ble."
	9197	"RTN","RCC PCT",12,0)
	9198	W !!,"The first for mat is jus t a single summary t otal repor t of all S tatement"
	9199	"RTN","RCC PCT",13,0)
	9200	W !,"Date s."
	9201	"RTN","RCC PCT",14,0)
	9202	W !!,"The second fo rmat is al l Statemen t Dates pr inted indi vidually w ith totals "
	9203	"RTN","RCC PCT",15,0)
	9204	W !,"and a summary total at t he end."
	9205	"RTN","RCC PCT",16,0)
	9206	W !!,"The third for mat is pri nting the totals for a single Statement Date selec ted.",!
	9207	"RTN","RCC PCT",17,0)
	9208	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9209	"RTN","RCC PCT",18,0)
	9210	S DIR(0)= "E" D ^DIR
	9211	"RTN","RCC PCT",19,0)
	9212	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9213	"RTN","RCC PCT",20,0)
	9214	S IEN="" F S IEN=$ O(^RCT(349 ,"SDT",IEN )) Q:IEN=" " S TDT(I EN)=""
	9215	"RTN","RCC PCT",21,0)
	9216	W @IOF W !!,"The fo llowing Pa tient Stat ement Date s are avai lable for the Totals Report:", !
	9217	"RTN","RCC PCT",22,0)
	9218	S (TDT1,F IRST,LAST) ="" F S T DT1=$O(TDT (TDT1)) Q: TDT1="" D
	9219	"RTN","RCC PCT",23,0)
	9220	.S TDT3=$ P(^RCT(349 ,$O(^RCT(3 49,"SDT",T DT1,0)),0) ,"^",9) W !,$$DATE^R CCPCPS1(TD T3)
	9221	"RTN","RCC PCT",24,0)
	9222	.I TDT3<F IRST S FIR ST=TDT3
	9223	"RTN","RCC PCT",25,0)
	9224	.I TDT3>L AST S LAST =TDT3
	9225	"RTN","RCC PCT",26,0)
	9226	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9227	"RTN","RCC PCT",27,0)
	9228	S DIR(0)= "YAO"
	9229	"RTN","RCC PCT",28,0)
	9230	S DIR("B" )="Y"
	9231	"RTN","RCC PCT",29,0)
	9232	S DIR("A" )="Do you want to pr int a sing le total f or ALL the available dates? "
	9233	"RTN","RCC PCT",30,0)
	9234	D ^DIR
	9235	"RTN","RCC PCT",31,0)
	9236	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9237	"RTN","RCC PCT",32,0)
	9238	I Y=1 D Q
	9239	"RTN","RCC PCT",33,0)
	9240	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9241	"RTN","RCC PCT",34,0)
	9242	.I $D(IO( "Q")) D Q
	9243	"RTN","RCC PCT",35,0)
	9244	..S Q=1
	9245	"RTN","RCC PCT",36,0)
	9246	..S ZTRTN ="STARTS^R CCPCT",ZTD ESC="CBSS ALL PATIEN T STATEMEN TS TOTAL R EPORT"
	9247	"RTN","RCC PCT",37,0)
	9248	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9249	"RTN","RCC PCT",38,0)
	9250	..D ^%ZTL OAD
	9251	"RTN","RCC PCT",39,0)
	9252	..K ZTRTN ,ZTDESC,ZT SAVE
	9253	"RTN","RCC PCT",40,0)
	9254	.E D STA RTS Q
	9255	"RTN","RCC PCT",41,0)
	9256	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9257	"RTN","RCC PCT",42,0)
	9258	S DIR(0)= "YAO"
	9259	"RTN","RCC PCT",43,0)
	9260	S DIR("B" )="Y"
	9261	"RTN","RCC PCT",44,0)
	9262	S DIR("A" )="Do you want to pr int separa te totals for ALL th e availabl e dates? "
	9263	"RTN","RCC PCT",45,0)
	9264	D ^DIR
	9265	"RTN","RCC PCT",46,0)
	9266	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9267	"RTN","RCC PCT",47,0)
	9268	I Y=1 D Q
	9269	"RTN","RCC PCT",48,0)
	9270	.D HOME^% ZIS S %ZIS ="AEQ" D ^ %ZIS Q:POP
	9271	"RTN","RCC PCT",49,0)
	9272	.I $D(IO( "Q")) D Q
	9273	"RTN","RCC PCT",50,0)
	9274	..S Q=1
	9275	"RTN","RCC PCT",51,0)
	9276	..S ZTRTN ="START^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9277	"RTN","RCC PCT",52,0)
	9278	..S ZTSAV E("Q")="", ZTSAVE("TD T(")=""
	9279	"RTN","RCC PCT",53,0)
	9280	..D ^%ZTL OAD
	9281	"RTN","RCC PCT",54,0)
	9282	..K ZTRTN ,ZTDESC,ZT SAVE
	9283	"RTN","RCC PCT",55,0)
	9284	.E D STA RT Q
	9285	"RTN","RCC PCT",56,0)
	9286	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9287	"RTN","RCC PCT",57,0)
	9288	S DIR(0)= "DAO^"_FIR ST_":"_LAS T_":EX^K:' $D(TDT(+$E (Y,6,7))) X"
	9289	"RTN","RCC PCT",58,0)
	9290	S DIR("A" )="Enter a single Pa tient Stat ement date from list above: "
	9291	"RTN","RCC PCT",59,0)
	9292	S DIR("?" )="Enter a single Pa tient Stat ement date from list above or ^ to exit. "
	9293	"RTN","RCC PCT",60,0)
	9294	D ^DIR
	9295	"RTN","RCC PCT",61,0)
	9296	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q
	9297	"RTN","RCC PCT",62,0)
	9298	S Y1=+$E( Y,6,7),Y2= Y
	9299	"RTN","RCC PCT",63,0)
	9300	;I '$D(TD T(Y1)) W ! ,"There ar e no recor ds for tha t date." Q
	9301	"RTN","RCC PCT",64,0)
	9302	D HOME^%Z IS S %ZIS= "AEQ" D ^% ZIS Q:POP
	9303	"RTN","RCC PCT",65,0)
	9304	I $D(IO(" Q")) D Q
	9305	"RTN","RCC PCT",66,0)
	9306	.S Q=1
	9307	"RTN","RCC PCT",67,0)
	9308	.S ZTRTN= "START1^RC CPCT",ZTDE SC="CBSS A LL PATIENT STATEMENT S TOTAL RE PORT"
	9309	"RTN","RCC PCT",68,0)
	9310	.S ZTSAVE ("Q")="",Z TSAVE("Y1" )="",ZTSAV E("Y2")=""
	9311	"RTN","RCC PCT",69,0)
	9312	.D ^%ZTLO AD
	9313	"RTN","RCC PCT",70,0)
	9314	.K ZTRTN, ZTDESC,ZTS AVE
	9315	"RTN","RCC PCT",71,0)
	9316	START1 ;Th is will pr int a summ ary total for a sing le date
	9317	"RTN","RCC PCT",72,0)
	9318	N PTOT,TT OT,X,D
	9319	"RTN","RCC PCT",73,0)
	9320	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9321	"RTN","RCC PCT",74,0)
	9322	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
	9323	TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9324	"RTN","RCC PCT",75,0)
	9325	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,"STD T",Y2,X)) Q:'X I $G (^RCPS(349 .2,X,6)) S PTOT=PTOT +1
	9326	"RTN","RCC PCT",76,0)
	9327	I IOST?1" C".E W @IO F
	9328	"RTN","RCC PCT",77,0)
	9329	W !,?10," CBSS Messa ge Totals for ",$$DA TE^RCCPCPS 1(Y2),!!
	9330	"RTN","RCC PCT",78,0)
	9331	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9332	"RTN","RCC PCT",79,0)
	9333	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9334	"RTN","RCC PCT",80,0)
	9335	W !,"==== ========== ========== ======="
	9336	"RTN","RCC PCT",81,0)
	9337	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9338	"RTN","RCC PCT",82,0)
	9339	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9340	"RTN","RCC PCT",83,0)
	9341	Q
	9342	"RTN","RCC PCT",84,0)
	9343	START ;Thi s will pri nt separat e totals f or all ava ilable sta tement dat es
	9344	"RTN","RCC PCT",85,0)
	9345	N PTOT,TT OT,X,X1,DA TE
	9346	"RTN","RCC PCT",86,0)
	9347	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9348	"RTN","RCC PCT",87,0)
	9349	S (TTOT,P TOT,X,X1)= 0 S DATE=" "
	9350	"RTN","RCC PCT",88,0)
	9351	U IO S (T DT1,TDT2)= ""
	9352	"RTN","RCC PCT",89,0)
	9353	I IOST?1" C".E W @IO F
	9354	"RTN","RCC PCT",90,0)
	9355	F S TDT1 =$O(TDT(TD T1)) Q:TDT 1="" D I $D(DTOUT) !$D(DUOUT) !$D(DIRUT) !$D(DIROUT ) Q
	9356	"RTN","RCC PCT",91,0)
	9357	.I X="^" Q
	9358	"RTN","RCC PCT",92,0)
	9359	.S TTOT=0
	9360	"RTN","RCC PCT",93,0)
	9361	.F S TDT 2=$O(^RCT( 349,"SDT", TDT1,TDT2) ) Q:TDT2=" " D
	9362	"RTN","RCC PCT",94,0)
	9363	..S Y=$P( ^RCT(349,T DT2,0),"^" ,9)
	9364	"RTN","RCC PCT",95,0)
	9365	..S Y1=+$ E(Y,3,4),D ATE=$$DATE ^RCCPCPS1( Y)
	9366	"RTN","RCC PCT",96,0)
	9367	..S X=Y D ^%DT
	9368	"RTN","RCC PCT",97,0)
	9369	..I $D(^R CT(349,TDT 2,0)) S TT OT=$P(^RCT (349,TDT2, 0),"^",7)+ TTOT
	9370	"RTN","RCC PCT",98,0)
	9371	..S PTOT= 0,X1="" I $D(^RCPS(3 49.2,"STDT ",Y)) F S X1=$O(^RC PS(349.2," STDT",Y,X1 )) Q:'X1 I
	9372	$G(^RCPS(3 49.2,X1,6) ) S PTOT=P TOT+1
	9373	"RTN","RCC PCT",99,0)
	9374	.W !,?10, "CBSS Mess age Totals for ",DAT E,!!
	9375	"RTN","RCC PCT",100,0 )
	9376	.W "Trans mission St atement To tal : ",$ J(TTOT,9)
	9377	"RTN","RCC PCT",101,0 )
	9378	.W !,"CBS S Statemen ts Printed Total : " ,$J(PTOT,9 )
	9379	"RTN","RCC PCT",102,0 )
	9380	.W !,"=== ========== ========== ========"
	9381	"RTN","RCC PCT",103,0 )
	9382	.W !,"Tot al Not Pri nted : " ,$J(TTOT-P TOT,9),!
	9383	"RTN","RCC PCT",104,0 )
	9384	.I '$D(Q) I $Y+4>IO SL D
	9385	"RTN","RCC PCT",105,0 )
	9386	..S DIR(0 )="E" D ^D IR I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) Q
	9387	"RTN","RCC PCT",106,0 )
	9388	..W @IOF
	9389	"RTN","RCC PCT",107,0 )
	9390	I X="^" Q
	9391	"RTN","RCC PCT",108,0 )
	9392	W !!!," ****** ****** ****** ****** ******** *"
	9393	"RTN","RCC PCT",109,0 )
	9394	STARTS ; T his will p rint the s ummary tot al for ALL available statement s
	9395	"RTN","RCC PCT",110,0 )
	9396	N DATE,PT OT,TTOT,X, D
	9397	"RTN","RCC PCT",111,0 )
	9398	N DIR,DTO UT,DUOUT,D IRUT,DIROU T
	9399	"RTN","RCC PCT",112,0 )
	9400	U IO S (T TOT,D)=0 F S D=$O(T DT(D)) Q:D ="" S X=0 F S X=$O (^RCT(349, "SDT",D,X) ) Q:X="" I
	9401	$D(^RCT(34 9,X,0)) S TTOT=$P(^R CT(349,X,0 ),"^",7)+T TOT
	9402	"RTN","RCC PCT",113,0 )
	9403	S (PTOT,X )=0 F S X =$O(^RCPS( 349.2,X)) Q:'X I $G (^(X,6)) S PTOT=PTOT +1
	9404	"RTN","RCC PCT",114,0 )
	9405	W !!,?10, "CBSS Mess age Totals for ALL a vailable d ates ",!!
	9406	"RTN","RCC PCT",115,0 )
	9407	W "Transm ission Sta tement Tot al : ",$J (TTOT,9)
	9408	"RTN","RCC PCT",116,0 )
	9409	W !,"CBSS Statement s Printed Total : ", $J(PTOT,9)
	9410	"RTN","RCC PCT",117,0 )
	9411	W !,"==== ========== ========== ======="
	9412	"RTN","RCC PCT",118,0 )
	9413	W !,"Tota l Not Prin ted : ", $J(TTOT-PT OT,9),!
	9414	"RTN","RCC PCT",119,0 )
	9415	I '$D(Q) S DIR(0)=" E" D ^DIR I $D(DTOUT )!$D(DUOUT )!$D(DIRUT )!$D(DIROU T) Q
	9416	"RTN","RCD PBTLM")
	9417	0^26^B5884 9422^B5228 0967
	9418	"RTN","RCD PBTLM",1,0 )
	9419	RCDPBTLM ; WISC/RFJ - bill tran sactions L ist Manage r top rout ine ;1 Jun 99
	9420	"RTN","RCD PBTLM",2,0 )
	9421	;;4.5;Acc ounts Rece ivable;1 14,148,153 ,168,169,1 98,247,271 ,276,315,3 13;Mar 2 0, 1995;Bu ild 150
	9422	"RTN","RCD PBTLM",3,0 )
	9423	;;Per VA Directive 6402, this routine s hould not be modifie d.
	9424	"RTN","RCD PBTLM",4,0 )
	9425	;
	9426	"RTN","RCD PBTLM",5,0 )
	9427	; Referen ce to $$RE C^IBRFN su pported by DBIA 2031
	9428	"RTN","RCD PBTLM",6,0 )
	9429	;
	9430	"RTN","RCD PBTLM",7,0 )
	9431	; called from menu option (1 9)
	9432	"RTN","RCD PBTLM",8,0 )
	9433	;
	9434	"RTN","RCD PBTLM",9,0 )
	9435	N RCBILLD A,RCDPFXIT
	9436	"RTN","RCD PBTLM",10, 0)
	9437	;
	9438	"RTN","RCD PBTLM",11, 0)
	9439	F D Q:' RCBILLDA
	9440	"RTN","RCD PBTLM",12, 0)
	9441	. W !! S RCBILLDA =$$SELBILL
	9442	"RTN","RCD PBTLM",13, 0)
	9443	. I RCB ILLDA<1 S RCBILLDA=0 Q
	9444	"RTN","RCD PBTLM",14, 0)
	9445	. D EN^ VALM("RCDP TRANSACTI ONS LIST")
	9446	"RTN","RCD PBTLM",15, 0)
	9447	. ; fa st exit
	9448	"RTN","RCD PBTLM",16, 0)
	9449	. I $G( RCDPFXIT) S RCBILLDA =0
	9450	"RTN","RCD PBTLM",17, 0)
	9451	Q
	9452	"RTN","RCD PBTLM",18, 0)
	9453	;
	9454	"RTN","RCD PBTLM",19, 0)
	9455	;
	9456	"RTN","RCD PBTLM",20, 0)
	9457	INIT ; in itializati on for lis t manager list
	9458	"RTN","RCD PBTLM",21, 0)
	9459	; requir es rcbilld a
	9460	"RTN","RCD PBTLM",22, 0)
	9461	; PRCA3 .5315 - R eplaced "^ " with VA Standard V ariable U throughout
	9462	"RTN","RCD PBTLM",23, 0)
	9463	N ADMIN,D ATE,RCLINE ,RCLIST,RC TOTAL,RCTR AN,RCTRAND A
	9464	"RTN","RCD PBTLM",24, 0)
	9465	K ^TMP("R CDPBTLM",$ J),^TMP("V ALM VIDEO" ,$J)
	9466	"RTN","RCD PBTLM",25, 0)
	9467	;
	9468	"RTN","RCD PBTLM",26, 0)
	9469	; fast e xit
	9470	"RTN","RCD PBTLM",27, 0)
	9471	I $G(RCDP FXIT) S VA LMQUIT=1 Q
	9472	"RTN","RCD PBTLM",28, 0)
	9473	;
	9474	"RTN","RCD PBTLM",29, 0)
	9475	; set th e List Man ager line number
	9476	"RTN","RCD PBTLM",30, 0)
	9477	S RCLINE= 0
	9478	"RTN","RCD PBTLM",31, 0)
	9479	; set th e List Man ager trans action num ber
	9480	"RTN","RCD PBTLM",32, 0)
	9481	S RCTRAN= 0
	9482	"RTN","RCD PBTLM",33, 0)
	9483	;
	9484	"RTN","RCD PBTLM",34, 0)
	9485	; get tr ansactions and balan ce for bil l
	9486	"RTN","RCD PBTLM",35, 0)
	9487	S RCTOTAL =$$GETTRAN S(RCBILLDA )
	9488	"RTN","RCD PBTLM",36, 0)
	9489	;
	9490	"RTN","RCD PBTLM",37, 0)
	9491	S DATE="" F S DATE =$O(RCLIST (DATE)) Q: 'DATE D
	9492	"RTN","RCD PBTLM",38, 0)
	9493	. S RCT RANDA="" F S RCTRAN DA=$O(RCLI ST(DATE,RC TRANDA)) Q :RCTRANDA= "" D
	9494	"RTN","RCD PBTLM",39, 0)
	9495	. . S RCLINE=RC LINE+1
	9496	"RTN","RCD PBTLM",40, 0)
	9497	. . ;
	9498	"RTN","RCD PBTLM",41, 0)
	9499	. . ; create a n index ar ray for tr ansaction lookup in list
	9500	"RTN","RCD PBTLM",42, 0)
	9501	. . I RCTRANDA D
	9502	"RTN","RCD PBTLM",43, 0)
	9503	. . . S RCTRA N=RCTRAN+1
	9504	"RTN","RCD PBTLM",44, 0)
	9505	. . . S ^TMP( "RCDPBTLM" ,$J,"IDX", RCTRAN,RCT RAN)=RCTRA NDA
	9506	"RTN","RCD PBTLM",45, 0)
	9507	. . . D SET^R CDPAPLI(RC TRAN,RCLIN E,1,80,0,I ORVON,IORV OFF)
	9508	"RTN","RCD PBTLM",46, 0)
	9509	. . ;
	9510	"RTN","RCD PBTLM",47, 0)
	9511	. . D SET^RCDPA PLI($S(RCT RANDA:RCTR ANDA,1:" " ),RCLINE,6 ,80) ; PRC A4.5315 Incr left margin
	9512	"RTN","RCD PBTLM",48, 0)
	9513	. . D SET^RCDPA PLI($E(DAT E,4,5)_"/" _$E(DATE,6 ,7)_"/"_$E (DATE,2,3) ,RCLINE,13 ,21)
	9514	"RTN","RCD PBTLM",49, 0)
	9515	. . D
	9516	SET^RCDPAP LI($TR($P( RCLIST(DAT E,RCTRANDA ),U),"ABCD EFGHIJKLMN OPQRSTUVWX YZ","abcde fghijkl
	9517	mnopqrstuv wxyz"),RCL INE,25,50)
	9518	"RTN","RCD PBTLM",50, 0)
	9519	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),U,2),9,2 ),RCLINE,5 3,62)
	9520	"RTN","RCD PBTLM",51, 0)
	9521	. . D SET^RCDPA PLI($J($P( RCLIST(DAT E,RCTRANDA ),U,3),9,2 ),RCLINE,6 2,71)
	9522	"RTN","RCD PBTLM",52, 0)
	9523	. . ; add mars hal fee an d court co st to crea te admin d ollars
	9524	"RTN","RCD PBTLM",53, 0)
	9525	. . S
	9526	ADMIN=$P(R CLIST(DATE ,RCTRANDA) ,U,4)+$P(R CLIST(DATE ,RCTRANDA) ,U,5)+$P(R CLIST(DATE ,RCTRAND
	9527	A),U,6)
	9528	"RTN","RCD PBTLM",54, 0)
	9529	. . D SET^RCDPA PLI($J(ADM IN,9,2),RC LINE,71,80 )
	9530	"RTN","RCD PBTLM",55, 0)
	9531	;
	9532	"RTN","RCD PBTLM",56, 0)
	9533	; show t otals
	9534	"RTN","RCD PBTLM",57, 0)
	9535	S RCLINE= RCLINE+1
	9536	"RTN","RCD PBTLM",58, 0)
	9537	D SET^RCD PAPLI(" - -------- - ------- -- ------",RC LINE,1,80)
	9538	"RTN","RCD PBTLM",59, 0)
	9539	S RCLINE= RCLINE+1
	9540	"RTN","RCD PBTLM",60, 0)
	9541	D SET^RCD PAPLI(" TOTAL BALA NCE FOR BI LL",RCLINE ,1,80)
	9542	"RTN","RCD PBTLM",61, 0)
	9543	D SET^RCD PAPLI($J($ P(RCTOTAL, U,1),9,2), RCLINE,53, 62)
	9544	"RTN","RCD PBTLM",62, 0)
	9545	D SET^RCD PAPLI($J($ P(RCTOTAL, U,2),9,2), RCLINE,62, 71)
	9546	"RTN","RCD PBTLM",63, 0)
	9547	D SET^RCD PAPLI($J($ P(RCTOTAL, U,3)+$P(RC TOTAL,U,4) +$P(RCTOTA L,U,5),9,2 ),RCLINE,7 1,80)
	9548	"RTN","RCD PBTLM",64, 0)
	9549	;
	9550	"RTN","RCD PBTLM",65, 0)
	9551	; compar e totals t o what is stored in the file
	9552	"RTN","RCD PBTLM",66, 0)
	9553	N RCDATA7 ,RCFOUT
	9554	"RTN","RCD PBTLM",67, 0)
	9555	S RCDATA7 =$G(^PRCA( 430,RCBILL DA,7))
	9556	"RTN","RCD PBTLM",68, 0)
	9557	; for a write-off bill, the balance sh ould equal all zeros , for
	9558	"RTN","RCD PBTLM",69, 0)
	9559	; these bills, nod e 7 is the write-off amount, s o for the out of
	9560	"RTN","RCD PBTLM",70, 0)
	9561	; balanc e check to work, nod e 7 needs to be adju sted to al l zeros
	9562	"RTN","RCD PBTLM",71, 0)
	9563	I $P(^PRC A(430,RCBI LLDA,0),U, 8)=23 S RC DATA7="0^0 ^0^0^0"
	9564	"RTN","RCD PBTLM",72, 0)
	9565	I +$P(RCD ATA7,U,1)' =+$P(RCTOT AL,U,1) S RCFOUT=1
	9566	"RTN","RCD PBTLM",73, 0)
	9567	I +$P(RCD ATA7,U,2)' =+$P(RCTOT AL,U,2) S RCFOUT=1
	9568	"RTN","RCD PBTLM",74, 0)
	9569	I ($P(RCD ATA7,U,3)+ $P(RCDATA7 ,U,4)+$P(R CDATA7,U,5 ))'=+$P(RC TOTAL,U,3) S RCFOUT= 1
	9570	"RTN","RCD PBTLM",75, 0)
	9571	I $G(RCFO UT) D
	9572	"RTN","RCD PBTLM",76, 0)
	9573	. S RCL INE=RCLINE +1
	9574	"RTN","RCD PBTLM",77, 0)
	9575	. D SET ^RCDPAPLI( " ",RCLINE ,1,80)
	9576	"RTN","RCD PBTLM",78, 0)
	9577	. S RCL INE=RCLINE +1
	9578	"RTN","RCD PBTLM",79, 0)
	9579	. D SET ^RCDPAPLI( " STORED BALANCE FO R BILL ( INCORRECT )",RCLI NE,1,80)
	9580	"RTN","RCD PBTLM",80, 0)
	9581	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,1),9 ,2),RCLINE ,53,62)
	9582	"RTN","RCD PBTLM",81, 0)
	9583	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,2),9 ,2),RCLINE ,62,71)
	9584	"RTN","RCD PBTLM",82, 0)
	9585	. D SET ^RCDPAPLI( $J($P(RCDA TA7,U,3)+$ P(RCDATA7, U,4)+$P(RC DATA7,U,5) ,9,2),RCLI NE,71,80)
	9586	"RTN","RCD PBTLM",83, 0)
	9587	;
	9588	"RTN","RCD PBTLM",84, 0)
	9589	; set va lmcnt to n umber of l ines in th e list
	9590	"RTN","RCD PBTLM",85, 0)
	9591	S VALMCNT =RCLINE
	9592	"RTN","RCD PBTLM",86, 0)
	9593	D HDR
	9594	"RTN","RCD PBTLM",87, 0)
	9595	Q
	9596	"RTN","RCD PBTLM",88, 0)
	9597	;
	9598	"RTN","RCD PBTLM",89, 0)
	9599	;
	9600	"RTN","RCD PBTLM",90, 0)
	9601	HDR ; hea der code f or list ma nager disp lay
	9602	"RTN","RCD PBTLM",91, 0)
	9603	; requir es rcbilld a
	9604	"RTN","RCD PBTLM",92, 0)
	9605	N %,DATA, RCDEBTDA,R CDPDATA
	9606	"RTN","RCD PBTLM",93, 0)
	9607	;
	9608	"RTN","RCD PBTLM",94, 0)
	9609	D DIQ430^ RCDPBPLM(R CBILLDA,". 01;8;")
	9610	"RTN","RCD PBTLM",95, 0)
	9611	;
	9612	"RTN","RCD PBTLM",96, 0)
	9613	S RCDEBTD A=$P(^PRCA (430,RCBIL LDA,0),U,9 )
	9614	"RTN","RCD PBTLM",97, 0)
	9615	S DATA=$$ ACCNTHDR^R CDPAPLM(RC DEBTDA)
	9616	"RTN","RCD PBTLM",98, 0)
	9617	;
	9618	"RTN","RCD PBTLM",99, 0)
	9619	S %="",$P (%," ",80) =""
	9620	"RTN","RCD PBTLM",100 ,0)
	9621	; PRCA4. 5276 - ge t EEOB ind icator for 1st/3rd p arty payme nt and att ach to bil l when app licable
	9622	"RTN","RCD PBTLM",101 ,0)
	9623	S PRCOUT= $$COMP3^PR CAAPR(RCBI LLDA)
	9624	"RTN","RCD PBTLM",102 ,0)
	9625	I PRCOUT' ="%" S PRC OUT=$$IBEE OBCK^PRCAA PR1(RCBILL DA)
	9626	"RTN","RCD PBTLM",103 ,0)
	9627	S VALMHDR (1)=$E("Bi ll #: "_$G (PRCOUT)_$ G(RCDPDATA (430,RCBIL LDA,.01,"E "))_%,1,25 )_"Account :
	9628	"_$P(DATA, U)_$P(DATA ,U,2)
	9629	"RTN","RCD PBTLM",104 ,0)
	9630	S VALMHDR (2)=$E("St atus: "_$G (RCDPDATA( 430,RCBILL DA,8,"E")) _%,1,25)_$ E(" Addr :
	9631	"_$P(DATA, U,4)_", "_ $P(DATA,U, 7)_", "_$P (DATA,U,8) _" "_$P(D ATA,U,9)_% ,1,55)
	9632	"RTN","RCD PBTLM",105 ,0)
	9633	; PRCA4. 5276 - sh ow caption for user
	9634	"RTN","RCD PBTLM",106 ,0)
	9635	S VALMSG= "\|% EEOB \| Enter ?? for more a ctions \|" ; PRCA4.5 276
	9636	"RTN","RCD PBTLM",107 ,0)
	9637	Q
	9638	"RTN","RCD PBTLM",108 ,0)
	9639	S VALMHDR (3)=" "_I ORVON_$E(" Bill Balan ce:
	9640	"_$J($P(RC TOTAL,U)+$ P(RCTOTAL, U,2)+$P(RC TOTAL,U,3) +$P(RCTOTA L,U,4)+$P( RCTOTAL,U, 5),0,2)_%, 1,
	9641	23)_IORVOF F_" Phone : "_$P(DAT A,U,10)
	9642	"RTN","RCD PBTLM",109 ,0)
	9643	Q
	9644	"RTN","RCD PBTLM",110 ,0)
	9645	;
	9646	"RTN","RCD PBTLM",111 ,0)
	9647	;
	9648	"RTN","RCD PBTLM",112 ,0)
	9649	EXIT ; ex it list ma nager opti on and cle an up
	9650	"RTN","RCD PBTLM",113 ,0)
	9651	K ^TMP("R CDPBTLM",$ J),^TMP("R CDPBTLMX", $J)
	9652	"RTN","RCD PBTLM",114 ,0)
	9653	Q
	9654	"RTN","RCD PBTLM",115 ,0)
	9655	;
	9656	"RTN","RCD PBTLM",116 ,0)
	9657	;
	9658	"RTN","RCD PBTLM",117 ,0)
	9659	SELBILL() ; select a bill
	9660	"RTN","RCD PBTLM",118 ,0)
	9661	; return s -1 for t imeout or ^, 0 for n o selectio n, or ien of bill
	9662	"RTN","RCD PBTLM",119 ,0)
	9663	N %,%Y,C, DIC,DTOUT, DUOUT,RCBE FLUP,X,Y
	9664	"RTN","RCD PBTLM",120 ,0)
	9665	N DPTNOFZ Y,DPTNOFZK S (DPTNOF ZY,DPTNOFZ K)=1
	9666	"RTN","RCD PBTLM",121 ,0)
	9667	N RCY,DIR ,DIRUT
	9668	"RTN","RCD PBTLM",122 ,0)
	9669	; allow u ser to get the recor d using bi ll# or ECM E#
	9670	"RTN","RCD PBTLM",123 ,0)
	9671	S DIR("A" )="Select (B)ILL or (E)CME#: "
	9672	"RTN","RCD PBTLM",124 ,0)
	9673	S DIR(0)= "SA^B:BILL NUMBER;E: ECME#"
	9674	"RTN","RCD PBTLM",125 ,0)
	9675	S DIR("B" )="B"
	9676	"RTN","RCD PBTLM",126 ,0)
	9677	D ^DIR K DIR I $D(D IRUT) Q 0
	9678	"RTN","RCD PBTLM",127 ,0)
	9679	S RCY=Y
	9680	"RTN","RCD PBTLM",128 ,0)
	9681	I RCY="E" Q $$SELEC ME
	9682	"RTN","RCD PBTLM",129 ,0)
	9683	S DIC="^P RCA(430,", DIC(0)="QE AM",DIC("A ")="Select BILL: "
	9684	"RTN","RCD PBTLM",130 ,0)
	9685	S DIC("W" )="D DICW^ RCBEUBI1"
	9686	"RTN","RCD PBTLM",131 ,0)
	9687	; specia l lookup o n input
	9688	"RTN","RCD PBTLM",132 ,0)
	9689	S RCBEFLU P=1
	9690	"RTN","RCD PBTLM",133 ,0)
	9691	D ^DIC
	9692	"RTN","RCD PBTLM",134 ,0)
	9693	I Y<0,'$G (DUOUT),'$ G(DTOUT) S Y=0
	9694	"RTN","RCD PBTLM",135 ,0)
	9695	Q +Y
	9696	"RTN","RCD PBTLM",136 ,0)
	9697	;
	9698	"RTN","RCD PBTLM",137 ,0)
	9699	;
	9700	"RTN","RCD PBTLM",138 ,0)
	9701	GETTRANS(B ILLDA) ; original a mount goes first for bill
	9702	"RTN","RCD PBTLM",139 ,0)
	9703	; return s list of transactio ns in
	9704	"RTN","RCD PBTLM",140 ,0)
	9705	; rclist (date,tran da)=tranty pe ^ princ iple ^ int erest ^ ad min
	9706	"RTN","RCD PBTLM",141 ,0)
	9707	; return s principl e balance ^ interest balance ^ admin bal ance
	9708	"RTN","RCD PBTLM",142 ,0)
	9709	; ^ marshall fee balan ce ^ court cost bala nce
	9710	"RTN","RCD PBTLM",143 ,0)
	9711	N
	9712	%,ADMBAL,A MTDISP,CCB AL,DATA0,D ATA1,DATA9 ,DATE,INTB AL,MFBAL,P RINBAL,RCD PDATA,RCUS ER,TR
	9713	ANDA,VALUE
	9714	"RTN","RCD PBTLM",144 ,0)
	9715	;
	9716	"RTN","RCD PBTLM",145 ,0)
	9717	D DIQ430^ RCDPBPLM(B ILLDA,"3;6 0;")
	9718	"RTN","RCD PBTLM",146 ,0)
	9719	;
	9720	"RTN","RCD PBTLM",147 ,0)
	9721	K RCLIST
	9722	"RTN","RCD PBTLM",148 ,0)
	9723	S (ADMBAL ,CCBAL,INT BAL,MFBAL, PRINBAL)=0
	9724	"RTN","RCD PBTLM",149 ,0)
	9725	S PRINBAL =RCDPDATA( 430,BILLDA ,3,"I")
	9726	"RTN","RCD PBTLM",150 ,0)
	9727	; loop t ransaction and add t o list
	9728	"RTN","RCD PBTLM",151 ,0)
	9729	S TRANDA= 0 F S TRA NDA=$O(^PR CA(433,"C" ,BILLDA,TR ANDA)) Q:' TRANDA D
	9730	"RTN","RCD PBTLM",152 ,0)
	9731	. S DAT A0=$G(^PRC A(433,TRAN DA,0)) ;P RCA4.531 5 Needed f or User ID
	9732	"RTN","RCD PBTLM",153 ,0)
	9733	. S RCU SER=$P(DAT A0,U,9) ; PRCA4.53 15
	9734	"RTN","RCD PBTLM",154 ,0)
	9735	. S RCU SER=$$GET1 ^DIQ(200,R CUSER_",", 1) ;PRCA* 4.5*315
	9736	"RTN","RCD PBTLM",155 ,0)
	9737	. S DAT A1=$G(^PRC A(433,TRAN DA,1))
	9738	"RTN","RCD PBTLM",156 ,0)
	9739	. S DAT E=$P(DATA1 ,U,9) I 'D ATE Q
	9740	"RTN","RCD PBTLM",157 ,0)
	9741	. ;
	9742	"RTN","RCD PBTLM",158 ,0)
	9743	. ; Don 't include transacti ons that h ave the IN COMPLETE T RANSACTION FLAG (#10 ) set to Y ES and
	9744	"RTN","RCD PBTLM",159 ,0)
	9745	. ; thi s transact ion was pr eviously u sed by the auto-corr ect progra m to corre ct an earl ier issue.
	9746	PRCA4.53 13
	9747	"RTN","RCD PBTLM",160 ,0)
	9748	. S DAT A9=$G(^PRC A(433,TRAN DA,9))
	9749	"RTN","RCD PBTLM",161 ,0)
	9750	. ; Che ck for Inc omplete an d previous ly fixed b y auto-cor rect
	9751	"RTN","RCD PBTLM",162 ,0)
	9752	. I $P( DATA0,U,10 ),($P(DATA 9,U,4)) S VALUE="" Q
	9753	"RTN","RCD PBTLM",163 ,0)
	9754	. ;
	9755	"RTN","RCD PBTLM",164 ,0)
	9756	. S VAL UE=$$TRANV ALU(TRANDA ) ;PRCA4 .5315 (wa s I VALUE= "" Q)
	9757	"RTN","RCD PBTLM",165 ,0)
	9758	. S RCL IST($P(DAT E,"."),TRA NDA)=$P($G (^PRCA(430 .3,+$P(DAT A1,U,2),0) ),U)_VALUE
	9759	"RTN","RCD PBTLM",166 ,0)
	9760	. S $P( RCLIST($P( DATE,"."), TRANDA),U, 7)=RCUSER ;PRCA4.5 315
	9761	"RTN","RCD PBTLM",167 ,0)
	9762	. ;
	9763	"RTN","RCD PBTLM",168 ,0)
	9764	. ; ca lculate bi ll's balan ce
	9765	"RTN","RCD PBTLM",169 ,0)
	9766	. S PRI NBAL=PRINB AL+$P(VALU E,U,2)
	9767	"RTN","RCD PBTLM",170 ,0)
	9768	. S INT BAL=INTBAL +$P(VALUE, U,3)
	9769	"RTN","RCD PBTLM",171 ,0)
	9770	. S ADM BAL=ADMBAL +$P(VALUE, U,4)
	9771	"RTN","RCD PBTLM",172 ,0)
	9772	. S MFB AL=MFBAL+$ P(VALUE,U, 5)
	9773	"RTN","RCD PBTLM",173 ,0)
	9774	. S CCB AL=CCBAL+$ P(VALUE,U, 6)
	9775	"RTN","RCD PBTLM",174 ,0)
	9776	;
	9777	"RTN","RCD PBTLM",175 ,0)
	9778	S DATE=$G (RCDPDATA( 430,BILLDA ,60,"I"))
	9779	"RTN","RCD PBTLM",176 ,0)
	9780	; check to make su re activat ion date i s not grea ter than f irst trans action
	9781	"RTN","RCD PBTLM",177 ,0)
	9782	S %=$O(RC LIST(0)) I DATE>% S DATE=%
	9783	"RTN","RCD PBTLM",178 ,0)
	9784	S RCLIST( +$P(DATE," ."),0)="or iginal amo unt^"_RCDP DATA(430,B ILLDA,3,"I ")
	9785	"RTN","RCD PBTLM",179 ,0)
	9786	;
	9787	"RTN","RCD PBTLM",180 ,0)
	9788	Q PRINBAL _U_INTBAL_ U_ADMBAL_U _MFBAL_U_C CBAL
	9789	"RTN","RCD PBTLM",181 ,0)
	9790	;
	9791	"RTN","RCD PBTLM",182 ,0)
	9792	;
	9793	"RTN","RCD PBTLM",183 ,0)
	9794	TRANVALU(T RANDA) ; return the transacti on value a s displaye d (with + or - sign)
	9795	"RTN","RCD PBTLM",184 ,0)
	9796	N TYPE,VA LUE
	9797	"RTN","RCD PBTLM",185 ,0)
	9798	S VALUE=$ $TRANBAL^R CRJRCOT(TR ANDA)
	9799	"RTN","RCD PBTLM",186 ,0)
	9800	; no dol lars on tr ansaction
	9801	"RTN","RCD PBTLM",187 ,0)
	9802	I '$P(VAL UE,U),'$P( VALUE,U,2) ,'$P(VALUE ,U,3),'$P( VALUE,U,4) ,'$P(VALUE ,U,5) Q ""
	9803	"RTN","RCD PBTLM",188 ,0)
	9804	; check type for p ayments, e tc, make v alues (-) to subtrac t
	9805	"RTN","RCD PBTLM",189 ,0)
	9806	S TYPE=$P ($G(^PRCA( 433,TRANDA ,1)),U,2)
	9807	"RTN","RCD PBTLM",190 ,0)
	9808	I TYPE=2! (TYPE=8)!( TYPE=9)!(T YPE=10)!(T YPE=11)!(T YPE=14)!(T YPE=29)!(T YPE=34)!(T YPE=35)!(T YPE=41)
	9809	D
	9810	"RTN","RCD PBTLM",191 ,0)
	9811	. S $P( VALUE,U,1) =-$P(VALUE ,U,1)
	9812	"RTN","RCD PBTLM",192 ,0)
	9813	. S $P( VALUE,U,2) =-$P(VALUE ,U,2)
	9814	"RTN","RCD PBTLM",193 ,0)
	9815	. S $P( VALUE,U,3) =-$P(VALUE ,U,3)
	9816	"RTN","RCD PBTLM",194 ,0)
	9817	. S $P( VALUE,U,4) =-$P(VALUE ,U,4)
	9818	"RTN","RCD PBTLM",195 ,0)
	9819	. S $P( VALUE,U,5) =-$P(VALUE ,U,5)
	9820	"RTN","RCD PBTLM",196 ,0)
	9821	;
	9822	"RTN","RCD PBTLM",197 ,0)
	9823	; the fo llowing tr ansaction types shou ld not cha nge the bi lls balanc e
	9824	"RTN","RCD PBTLM",198 ,0)
	9825	; return the amoun t displaye d in the d escription and 0 for value
	9826	"RTN","RCD PBTLM",199 ,0)
	9827	; refe r to RC 3, refer to DOJ 4, ree stablish 5 , returned 6 and 32
	9828	"RTN","RCD PBTLM",200 ,0)
	9829	; repa yment plan 25, amend ed 33, sus pended 47, unsuspend ed 46
	9830	"RTN","RCD PBTLM",201 ,0)
	9831	K AMTDISP
	9832	"RTN","RCD PBTLM",202 ,0)
	9833	I TYPE=3! (TYPE=4)!( TYPE=5)!(T YPE=6)!(TY PE=25)!(TY PE=32)!(TY PE=33)!(TY PE=46)!(TY PE=47) D
	9834	"RTN","RCD PBTLM",203 ,0)
	9835	. S AMT DISP="
	9836	($"_$J($P( VALUE,U)+$ P(VALUE,U, 2)+$P(VALU E,U,3)+$P( VALUE,U,4) +$P(VALUE, U,5),0,2)_ ")"
	9837	"RTN","RCD PBTLM",204 ,0)
	9838	. S VAL UE=""
	9839	"RTN","RCD PBTLM",205 ,0)
	9840	Q $G(AMTD ISP)_U_VAL UE
	9841	"RTN","RCD PBTLM",206 ,0)
	9842	;
	9843	"RTN","RCD PBTLM",207 ,0)
	9844	SELECME() ;
	9845	"RTN","RCD PBTLM",208 ,0)
	9846	; functio n takes th e user inp ut of the ECME # to return a v alid ien o f file 430
	9847	"RTN","RCD PBTLM",209 ,0)
	9848	; if an i nvalid ECM E is evalu ated then the proces s keeps as king the u ser for EC ME #
	9849	"RTN","RCD PBTLM",210 ,0)
	9850	; until a valid ECM E# is ente red or unt il the use r enters a U or null value
	9851	"RTN","RCD PBTLM",211 ,0)
	9852	; output - returns the IEN of the recor d entry in the ACCOU NT RECEIVA BLE file ( #430) or " ??"
	9853	"RTN","RCD PBTLM",212 ,0)
	9854	N RCECME, RCBILL,DIR ,DIRUT,Y
	9855	"RTN","RCD PBTLM",213 ,0)
	9856	S DIR(0)= "FO^1:12^I X'?1.12N W !!,""Can not contai n alpha ch aracters"" K X"
	9857	"RTN","RCD PBTLM",214 ,0)
	9858	S DIR("A" )="Select ECME#"
	9859	"RTN","RCD PBTLM",215 ,0)
	9860	RET D ^DIR I $D(DIRU T) Q 0
	9861	"RTN","RCD PBTLM",216 ,0)
	9862	S RCECME= $S(+Y>0:Y, 1:0)
	9863	"RTN","RCD PBTLM",217 ,0)
	9864	S RCBILL= $$REC^IBRF N(RCECME) ; IA 20 31
	9865	"RTN","RCD PBTLM",218 ,0)
	9866	I RCBILL< 0 W !!,"?? " G RET
	9867	"RTN","RCD PBTLM",219 ,0)
	9868	E W !!,$ P($G(^PRCA (430,+RCBI LL,0)),U), " "
	9869	"RTN","RCD PBTLM",220 ,0)
	9870	Q RCBILL
	9871	"RTN","RCD PBTLM",221 ,0)
	9872	;RCDPBTLM
	9873	"UP",349.1 ,349.11,-1 )
	9874	349.1^1
	9875	"UP",349.1 ,349.11,0)
	9876	349.11
	9877	"UP",349.1 ,349.141,- 1)
	9878	349.1^4
	9879	"UP",349.1 ,349.141,0 )
	9880	349.141
	9881	"UP",349.1 ,349.151,- 1)
	9882	349.1^5
	9883	"UP",349.1 ,349.151,0 )
	9884	349.151
	9885	"VER")
	9886	8.0^22.2
	9887	"^DD",340, 340,.01,0)
	9888	DEBTOR^RV^ ^0;1^
	9889	"^DD",340, 340,.01,1, 0)
	9890	^.1
	9891	"^DD",340, 340,.01,1, 1,0)
	9892	340^B
	9893	"^DD",340, 340,.01,1, 1,1)
	9894	S ^RCD(340 ,"B",$E(X, 1,30),DA)= ""
	9895	"^DD",340, 340,.01,1, 1,2)
	9896	K ^RCD(340 ,"B",$E(X, 1,30),DA)
	9897	"^DD",340, 340,.01,1, 1,3)
	9898	Needed for look-up o f informat ion by Deb tor
	9899	"^DD",340, 340,.01,1, 1,"%D",0)
	9900	^^2^2^2931 014^^^^
	9901	"^DD",340, 340,.01,1, 1,"%D",1,0 )
	9902	This is th e regular FileMan 'B ' cross-re ference an d is used throughout the
	9903	"^DD",340, 340,.01,1, 1,"%D",2,0 )
	9904	AR package for users to look u p informat ion by deb tor.
	9905	"^DD",340, 340,.01,1, 2,0)
	9906	^^TRIGGER^ 340^.03
	9907	"^DD",340, 340,.01,1, 2,1)
	9908	X ^DD(340, .01,1,2,1. 3) I X S X =DIV S Y(1 )=$S($D(^R CD(340,D0, 0)):^(0),1 :"") S X=$ P(Y(1),U,3 ),X=X S DI U=X
	9909	K Y X ^DD( 340,.01,1, 2,1.1) X ^ DD(340,.01 ,1,2,1.4)
	9910	"^DD",340, 340,.01,1, 2,1.1)
	9911	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),";"),0), U)) S:X X= +X
	9912	"^DD",340, 340,.01,1, 2,1.3)
	9913	K DIV S DI V=X,D0=DA, DIV(0)=D0 S Y(0)=X S Y(1)=$S($ D(^RCD(340 ,D0,0)):^( 0),1:"") S
	9914	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
	9915	"^DD",340, 340,.01,1, 2,1.4)
	9916	S DIH=$S($ D(^RCD(340 ,DIV(0),0) ):^(0),1:" "),DIV=X S $P(^(0),U ,3)=DIV,DI H=340,DIG= .03 D
	9917	^DICR:$O(^ DD(DIH,DIG ,1,0))>0
	9918	"^DD",340, 340,.01,1, 2,2)
	9919	Q
	9920	"^DD",340, 340,.01,1, 2,3)
	9921	Needed for assigning statement days for patients
	9922	"^DD",340, 340,.01,1, 2,"%D",0)
	9923	^.101^2^2^ 3160502^^^
	9924	"^DD",340, 340,.01,1, 2,"%D",1,0 )
	9925	This cross -reference sets the statement day for ne w patients as determ ined
	9926	"^DD",340, 340,.01,1, 2,"%D",2,0 )
	9927	by the fir st two let ters of th e patient' s last nam e.
	9928	"^DD",340, 340,.01,1, 2,"CREATE CONDITION" )
	9929	STATEMENT DAY=""&(IN TERNAL(DEB TOR)[";DPT (")
	9930	"^DD",340, 340,.01,1, 2,"CREATE VALUE")
	9931	S X=$$ACSE T^RCCPCFN1 ($P(^DPT($ P($P(^RCD( 340,D0,0) ,U),";"),0 ),U) S:X X =+X
	9932	"^DD",340, 340,.01,1, 2,"DELETE VALUE")
	9933	NO EFFECT
	9934	"^DD",340, 340,.01,1, 2,"DT")
	9935	2961010
	9936	"^DD",340, 340,.01,1, 2,"FIELD")
	9937	STATEMENT DAY
	9938	"^DD",340, 340,.01,1, 3,0)
	9939	340^AB^MUM PS
	9940	"^DD",340, 340,.01,1, 3,1)
	9941	S ^RCD(340 ,"AB",$P(X ,";",2),DA )=""
	9942	"^DD",340, 340,.01,1, 3,2)
	9943	K ^RCD(340 ,"AB",$P(X ,";",2),DA )
	9944	"^DD",340, 340,.01,1, 3,3)
	9945	Needed to cross-refe rence debt or file by 'type' of debtor
	9946	"^DD",340, 340,.01,1, 3,"%D",0)
	9947	^^5^5^2931 014^^^^
	9948	"^DD",340, 340,.01,1, 3,"%D",1,0 )
	9949	This cross -reference allows ra pid look-u p of debto rs in the debtor fil e
	9950	"^DD",340, 340,.01,1, 3,"%D",2,0 )
	9951	by the 'ty pe' of deb tor. Ther e are five types of debtors (P atient,
	9952	"^DD",340, 340,.01,1, 3,"%D",3,0 )
	9953	Insurance Company, I nstitution , Vendor, and Person ). This a llows
	9954	"^DD",340, 340,.01,1, 3,"%D",4,0 )
	9955	the AR sof tware to s can the fi le for onl y a specif ic type of debtor
	9956	"^DD",340, 340,.01,1, 3,"%D",5,0 )
	9957	rather tha n having t o look at each entry .
	9958	"^DD",340, 340,.01,1, 3,"DT")
	9959	2930526
	9960	"^DD",340, 340,.01,1. 1)
	9961	S X=DIV S X=+$$ACSET ^RCCPCFN1( $P(^DPT($P ($P(^RCD(3 40,D0,0),U ),"";""),0 ),U) S:X X =+X
	9962	"^DD",340, 340,.01,3)
	9963	Enter Debt or Informa tion
	9964	"^DD",340, 340,.01,7. 5)
	9965	S:$D(PRCAB T) DIC("V" )="I +Y(0) ="_$P("440 !(+Y(0)=4) ^440!(+Y(0 )=4)^440!( +Y(0)=200) ",U,PRCABT )
	9966	S:$D(PRCAT ) DIC("V") ="I
	9967	+Y(0)="_$S ("CP"[PRCA T:2,"FV"[P RCAT:440," T"[PRCAT:3 6,"N"[PRCA T:4,"O"[PR CAT:200,1: "200!(+Y(0 )=44
	9968	0)")
	9969	"^DD",340, 340,.01,21 ,0)
	9970	^^5^5^2970 219^^^^
	9971	"^DD",340, 340,.01,21 ,1,0)
	9972	This field contains the debtor to which this accou nt belongs to. An
	9973	"^DD",340, 340,.01,21 ,2,0)
	9974	account ca n belong t o an insur ance compa ny, vendor , institut ion, perso n,
	9975	"^DD",340, 340,.01,21 ,3,0)
	9976	or patient . Account s can be s et up for Medical Ca re Cost Re covery cha rges
	9977	"^DD",340, 340,.01,21 ,4,0)
	9978	and also f or non-ben efit debts , such as: Employee bills, Ex- employee b ills,
	9979	"^DD",340, 340,.01,21 ,5,0)
	9980	and Vendor bills.
	9981	"^DD",340, 340,.01,"D T")
	9982	3160428
	9983	"^DD",340, 340,.01,"V ",0)
	9984	^.12P^5^5
	9985	"^DD",340, 340,.01,"V ",1,0)
	9986	2^PATIENT^ 1^P^n^n
	9987	"^DD",340, 340,.01,"V ",1,1)
	9988
	9989	"^DD",340, 340,.01,"V ",1,2)
	9990
	9991	"^DD",340, 340,.01,"V ",2,0)
	9992	200^OTHER (PERSON)^2 ^O^n^y
	9993	"^DD",340, 340,.01,"V ",3,0)
	9994	36^3RD PAR TY^4^I^n^n
	9995	"^DD",340, 340,.01,"V ",4,0)
	9996	4^INSTITUT ION^5^N^n^ n
	9997	"^DD",340, 340,.01,"V ",5,0)
	9998	440^VENDOR ^3^V^n^n
	9999	"^DD",340, 340,.03,0)
	10000	STATEMENT DAY^NJ2,0^ ^0;3^K:+X' =X!(X>28)! (X<1)!(X?. E1"."1N.N) X
	10001	"^DD",340, 340,.03,1, 0)
	10002	^.1
	10003	"^DD",340, 340,.03,1, 1,0)
	10004	340^AC
	10005	"^DD",340, 340,.03,1, 1,1)
	10006	S ^RCD(340 ,"AC",$E(X ,1,30),DA) =""
	10007	"^DD",340, 340,.03,1, 1,2)
	10008	K ^RCD(340 ,"AC",$E(X ,1,30),DA)
	10009	"^DD",340, 340,.03,1, 1,3)
	10010	Needed for printing of patient statement s and foll ow-up lett ers
	10011	"^DD",340, 340,.03,1, 1,"%D",0)
	10012	^^4^4^2931 014^^^^
	10013	"^DD",340, 340,.03,1, 1,"%D",1,0 )
	10014	This cross -reference is used t o print pa tient stat ements and Vendor, P erson,
	10015	"^DD",340, 340,.03,1, 1,"%D",2,0 )
	10016	and Instit ution foll ow-up lett ers. Sinc e these ty pe of debt ors get no tified
	10017	"^DD",340, 340,.03,1, 1,"%D",3,0 )
	10018	based on t heir state ment day, this cross -reference allows ra pid look-u p
	10019	"^DD",340, 340,.03,1, 1,"%D",4,0 )
	10020	of which d ebtor is d ue a notif ication on a particu lar day.
	10021	"^DD",340, 340,.03,1, 1,"DT")
	10022	2930309
	10023	"^DD",340, 340,.03,3)
	10024	Type a Num ber betwee n 1 and 28 , 0 Decima l Digits
	10025	"^DD",340, 340,.03,5, 1,0)
	10026	340^.01^2
	10027	"^DD",340, 340,.03,21 ,0)
	10028	^^19^19^31 90201^
	10029	"^DD",340, 340,.03,21 ,1,0)
	10030	A statemen t day is a ssigned to all types of debtor s, except insurance
	10031	"^DD",340, 340,.03,21 ,2,0)
	10032	companies. A statem ent day is the day t hat a stat ement is g enerated o r a
	10033	"^DD",340, 340,.03,21 ,3,0)
	10034	follow-up letter is generated for non-be nefit debt s - except for
	10035	"^DD",340, 340,.03,21 ,4,0)
	10036	Patient St atements w hich are g enerated t wo days pr ior to thi s day.
	10037	"^DD",340, 340,.03,21 ,5,0)
	10038	The AR pac kage will hold 'noti fications' from bein g sent unt il the
	10039	"^DD",340, 340,.03,21 ,6,0)
	10040	debtor's ' statement day' arriv es. This allows all activity since the
	10041	"^DD",340, 340,.03,21 ,7,0)
	10042	previous s tatement t o print an d update t he debtor on the acc ount
	10043	"^DD",340, 340,.03,21 ,8,0)
	10044	activity.
	10045	"^DD",340, 340,.03,21 ,9,0)
	10046
	10047	"^DD",340, 340,.03,21 ,10,0)
	10048	Patient st atement da ys never c hange, but Instituti on, Person , and Vend or
	10049	"^DD",340, 340,.03,21 ,11,0)
	10050	statement days are c hanged by the AR sof tware. Wh en these t ype debtor s
	10051	"^DD",340, 340,.03,21 ,12,0)
	10052	have a new active bi ll, the da te the new active bi ll is crea ted become s
	10053	"^DD",340, 340,.03,21 ,13,0)
	10054	their 'sta tement day '. This s tatement d ay remains in effect until no
	10055	"^DD",340, 340,.03,21 ,14,0)
	10056	active bil ls exist f or the deb tor, at wh ich time t he stateme nt day
	10057	"^DD",340, 340,.03,21 ,15,0)
	10058	is 'delete d'.
	10059	"^DD",340, 340,.03,21 ,16,0)
	10060
	10061	"^DD",340, 340,.03,21 ,17,0)
	10062	Insurance companies are notifi ed based o n a bill-s pecific da te.
	10063	"^DD",340, 340,.03,21 ,18,0)
	10064	Since insu rance comp anies have much more activity, they are notified
	10065	"^DD",340, 340,.03,21 ,19,0)
	10066	on a const ant basis depending on each in dividual b ill 'due-d ate'.
	10067	"^DD",340, 340,.03,"D T")
	10068	3190201
	10069	"^DD",340, 340,7.06,0 )
	10070	CURRENT CB S DEBT AMO UNT^NJ9,2^ ^7;6^S:X[" $" X=$P(X, "$",2) K:X '?."-".N.1 ".".2N!(X> 999999)!(X <-
	10071	999999) X
	10072	"^DD",340, 340,7.06,3 )
	10073	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10074	"^DD",340, 340,7.06,2 1,0)
	10075	^^7^7^3160 401^
	10076	"^DD",340, 340,7.06,2 1,1,0)
	10077	This field stores th e debt amo unt curren tly
	10078	"^DD",340, 340,7.06,2 1,2,0)
	10079	updated to the Conso lidated Bi lling Stat ement Syst em
	10080	"^DD",340, 340,7.06,2 1,3,0)
	10081	CBSS. Thi s field is used to c ompare the current
	10082	"^DD",340, 340,7.06,2 1,4,0)
	10083	amount at the CBSS w ith the am ount curre ntly
	10084	"^DD",340, 340,7.06,2 1,5,0)
	10085	available for receiv ing paymen t. For in creases
	10086	"^DD",340, 340,7.06,2 1,6,0)
	10087	or decreas es, the de bt amount is forward ed to
	10088	"^DD",340, 340,7.06,2 1,7,0)
	10089	CBSS.
	10090	"^DD",340, 340,7.06," DT")
	10091	3160401
	10092	"^DD",341, 341,6.01,0 )
	10093	CCPC STATE MENT DATE^ D^^6;1^S % DT="EX" D ^%DT S X=Y K:X<1 X
	10094	"^DD",341, 341,6.01,1 ,0)
	10095	^.1
	10096	"^DD",341, 341,6.01,1 ,1,0)
	10097	341^STDT
	10098	"^DD",341, 341,6.01,1 ,1,1)
	10099	S ^RC(341, "STDT",$E( X,1,30),DA )=""
	10100	"^DD",341, 341,6.01,1 ,1,2)
	10101	K ^RC(341, "STDT",$E( X,1,30),DA )
	10102	"^DD",341, 341,6.01,1 ,1,"%D",0)
	10103	^.101^2^2^ 3160809^^
	10104	"^DD",341, 341,6.01,1 ,1,"%D",1, 0)
	10105	This cross reference is used t o sort and print eve nts by the ir Patient
	10106	"^DD",341, 341,6.01,1 ,1,"%D",2, 0)
	10107	Statement date.
	10108	"^DD",341, 341,6.01,1 ,1,"DT")
	10109	3160803
	10110	"^DD",341, 341,6.01,3 )
	10111	Enter date of Patien t Statemen t.
	10112	"^DD",341, 341,6.01,2 1,0)
	10113	^^1^1^3160 921^
	10114	"^DD",341, 341,6.01,2 1,1,0)
	10115	This is th e date of the Patien t Statemen t from CBS S.
	10116	"^DD",341, 341,6.01," DT")
	10117	3160921
	10118	"^DD",349, 349,.09,0)
	10119	STATEMENT DATE^D^^0; 9^S %DT="E X" D ^%DT S X=Y K:X< 1 X
	10120	"^DD",349, 349,.09,3)
	10121	Enter the statement date.
	10122	"^DD",349, 349,.09,21 ,0)
	10123	^^1^1^3161 019^
	10124	"^DD",349, 349,.09,21 ,1,0)
	10125	This is th e patient statement date.
	10126	"^DD",349, 349,.09,"D T")
	10127	3161103
	10128	"^DD",349. 1,349.1,1, 0)
	10129	LOCAL ADDR ESSEE^349. 11P^^1;0
	10130	"^DD",349. 1,349.1,1, 21,0)
	10131	^^2^2^3190 211^
	10132	"^DD",349. 1,349.1,1, 21,1,0)
	10133	This multi ple contai ns a list of local u sers that want to re ceive
	10134	"^DD",349. 1,349.1,1, 21,2,0)
	10135	Acknowledg ement mess ages.
	10136	"^DD",349. 1,349.1,40 ,0)
	10137	MESSAGE AC KNOWLEDGEM ENT^349.14 1A^^4;0
	10138	"^DD",349. 1,349.1,40 ,21,0)
	10139	^^5^5^3160 429^
	10140	"^DD",349. 1,349.1,40 ,21,1,0)
	10141	Message Ac knowledgem ents conta in the top level of data for m essages
	10142	"^DD",349. 1,349.1,40 ,21,2,0)
	10143	received f rom Austin .
	10144	"^DD",349. 1,349.1,40 ,21,3,0)
	10145
	10146	"^DD",349. 1,349.1,40 ,21,4,0)
	10147	The IEN fo r the mult iple Messa ge Acknowl edgements is set in the code t o
	10148	"^DD",349. 1,349.1,40 ,21,5,0)
	10149	the day of the month for the P atient Sta tement.
	10150	"^DD",349. 1,349.1,51 ,0)
	10151	ACK MESSAG ES^349.151 A^^5;0
	10152	"^DD",349. 1,349.1,51 ,21,0)
	10153	^^2^2^3190 211^
	10154	"^DD",349. 1,349.1,51 ,21,1,0)
	10155	This multi ple contai ns a list of Acknowl edgment me ssages rec eived from
	10156	"^DD",349. 1,349.1,51 ,21,2,0)
	10157	Austin.
	10158	"^DD",349. 1,349.11,0 )
	10159	LOCAL ADDR ESSEE SUB- FIELD^^.01 ^1
	10160	"^DD",349. 1,349.11,0 ,"DT")
	10161	3190211
	10162	"^DD",349. 1,349.11,0 ,"IX","B", 349.11,.01 )
	10163
	10164	"^DD",349. 1,349.11,0 ,"NM","LOC AL ADDRESS EE")
	10165
	10166	"^DD",349. 1,349.11,0 ,"UP")
	10167	349.1
	10168	"^DD",349. 1,349.11,. 01,0)
	10169	LOCAL ADDR ESSEE^MP20 0'^VA(200, ^0;1^Q
	10170	"^DD",349. 1,349.11,. 01,1,0)
	10171	^.1
	10172	"^DD",349. 1,349.11,. 01,1,1,0)
	10173	349.11^B
	10174	"^DD",349. 1,349.11,. 01,1,1,1)
	10175	S ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)= ""
	10176	"^DD",349. 1,349.11,. 01,1,1,2)
	10177	K ^RCT(349 .1,DA(1),1 ,"B",$E(X, 1,30),DA)
	10178	"^DD",349. 1,349.11,. 01,3)
	10179	Enter the local user s that sho uld receiv e Acknowle dgement me ssages.
	10180	"^DD",349. 1,349.11,. 01,21,0)
	10181	^^2^2^3190 211^
	10182	"^DD",349. 1,349.11,. 01,21,1,0)
	10183	The local users who wish to be recipient s of the t ransmissio n messages
	10184	"^DD",349. 1,349.11,. 01,21,2,0)
	10185	will be na med in thi s field.
	10186	"^DD",349. 1,349.11,. 01,"DT")
	10187	3190211
	10188	"^DD",349. 1,349.141, 0)
	10189	MESSAGE AC KNOWLEDGEM ENT SUB-FI ELD^^.04^4
	10190	"^DD",349. 1,349.141, 0,"DT")
	10191	3160425
	10192	"^DD",349. 1,349.141, 0,"NM","ME SSAGE ACKN OWLEDGEMEN T")
	10193
	10194	"^DD",349. 1,349.141, 0,"UP")
	10195	349.1
	10196	"^DD",349. 1,349.141, .01,0)
	10197	LAST MESSA GE ACK^NJ3 ,0X^^0;1^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10198	"^DD",349. 1,349.141, .01,1,0)
	10199	^.1^^0
	10200	"^DD",349. 1,349.141, .01,3)
	10201	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10202	"^DD",349. 1,349.141, .01,21,0)
	10203	^^1^1^3160 425^
	10204	"^DD",349. 1,349.141, .01,21,1,0 )
	10205	Number of last messa ge type se nt from CB SS.
	10206	"^DD",349. 1,349.141, .01,"DT")
	10207	3161007
	10208	"^DD",349. 1,349.141, .02,0)
	10209	FINAL MESS AGE ACK^NJ 3,0^^0;2^K :+X'=X!(X> 999)!(X<1) !(X?.E1"." 1.N) X
	10210	"^DD",349. 1,349.141, .02,3)
	10211	Type a num ber betwee n 1 and 99 9, 0 decim al digits.
	10212	"^DD",349. 1,349.141, .02,21,0)
	10213	^^1^1^3160 425^
	10214	"^DD",349. 1,349.141, .02,21,1,0 )
	10215	Final mess age number of this t ype from C BSS.
	10216	"^DD",349. 1,349.141, .02,"DT")
	10217	3160425
	10218	"^DD",349. 1,349.141, .03,0)
	10219	LAST MESSA GE NUMBER^ NJ8,0^^0;3 ^K:+X'=X!( X>99999999 )!(X<1)!(X ?.E1"."1.N ) X
	10220	"^DD",349. 1,349.141, .03,3)
	10221	Type a num ber betwee n 1 and 99 999999, 0 decimal di gits.
	10222	"^DD",349. 1,349.141, .03,21,0)
	10223	^^2^2^3160 425^
	10224	"^DD",349. 1,349.141, .03,21,1,0 )
	10225	This is th e last mes sage numbe r of this type for t he last tr ansmission
	10226	"^DD",349. 1,349.141, .03,21,2,0 )
	10227	from CBSS.
	10228	"^DD",349. 1,349.141, .03,"DT")
	10229	3160425
	10230	"^DD",349. 1,349.141, .04,0)
	10231	PATIENT ST ATEMENT DA TE^DX^^0;4 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10232	"^DD",349. 1,349.141, .04,1,0)
	10233	^.1^^0
	10234	"^DD",349. 1,349.141, .04,3)
	10235	Enter date of Patien t Statemen t.
	10236	"^DD",349. 1,349.141, .04,21,0)
	10237	^^1^1^3161 025^
	10238	"^DD",349. 1,349.141, .04,21,1,0 )
	10239	This is th e Patient Statement Date.
	10240	"^DD",349. 1,349.141, .04,"DT")
	10241	3161025
	10242	"^DD",349. 1,349.151, 0)
	10243	ACK MESSAG ES SUB-FIE LD^^.04^4
	10244	"^DD",349. 1,349.151, 0,"NM","AC K MESSAGES ")
	10245
	10246	"^DD",349. 1,349.151, .01,0)
	10247	ACK MESSAG ES^F^^0;1^ K:$L(X)>80 !($L(X)<3) X
	10248	"^DD",349. 1,349.151, .01,1,0)
	10249	^.1^^0
	10250	"^DD",349. 1,349.151, .01,3)
	10251	Answer mus t be 3-80 characters in length .
	10252	"^DD",349. 1,349.151, .01,21,0)
	10253	^^1^1^3190 211^
	10254	"^DD",349. 1,349.151, .01,21,1,0 )
	10255	This is th e Acknowle dgement Me ssage rece ived from an externa l source.
	10256	"^DD",349. 1,349.151, .01,"DT")
	10257	3190211
	10258	"^DD",349. 1,349.151, .04,0)
	10259	PATIENT ST ATEMENT DA TE^D^^0;4^ S %DT="EX" D ^%DT S X=Y K:X<1 X
	10260	"^DD",349. 1,349.151, .04,3)
	10261	Enter date of Patien t Statemen t.
	10262	"^DD",349. 1,349.151, .04,21,0)
	10263	^^1^1^3161 006^
	10264	"^DD",349. 1,349.151, .04,21,1,0 )
	10265	The Patien t Statemen t date for Acknowled gement Mes sages.
	10266	"^DD",349. 1,349.151, .04,"DT")
	10267	3161103
	10268	"^DD",349. 2,349.2,.0 1,0)
	10269	PATIENT^RP 340'X^RCD( 340,^0;1^Q
	10270	"^DD",349. 2,349.2,.0 1,1,0)
	10271	^.1^^0
	10272	"^DD",349. 2,349.2,.0 1,3)
	10273	Enter the Debtor Num ber for th e Patient Statement.
	10274	"^DD",349. 2,349.2,.0 1,21,0)
	10275	^^2^2^3161 011^^
	10276	"^DD",349. 2,349.2,.0 1,21,1,0)
	10277	This is th e Debtor n umber to r eceive the Patient S tatement a ssociated
	10278	"^DD",349. 2,349.2,.0 1,21,2,0)
	10279	with the s pecific Pa tient.
	10280	"^DD",349. 2,349.2,.0 1,"DT")
	10281	3161011
	10282	"^DD",349. 2,349.2,.1 2,0)
	10283	INVALID ST ATEMENT ER ROR^P349.7 '^RCPSE(34 9.7,^0;12^ Q
	10284	"^DD",349. 2,349.2,.1 2,3)
	10285	Enter the error code for the r ecord that was not a ccepted by CBSS.
	10286	"^DD",349. 2,349.2,.1 2,21,0)
	10287	^^1^1^3160 427^
	10288	"^DD",349. 2,349.2,.1 2,21,1,0)
	10289	This is th e error co de for the record th at was not accepted by CBSS.
	10290	"^DD",349. 2,349.2,.1 2,"DT")
	10291	3160909
	10292	"^DD",349. 2,349.2,.1 8,0)
	10293	CBSS FILE BUILT^S^0: NOT BUILT; 1:BUILT;^0 ;18^Q
	10294	"^DD",349. 2,349.2,.1 8,3)
	10295	Enter a '1 ' when the CBSS PATI ENT STATEM ENTS file is complet e.
	10296	"^DD",349. 2,349.2,.1 8,21,0)
	10297	^^2^2^3160 909^^
	10298	"^DD",349. 2,349.2,.1 8,21,1,0)
	10299	This field will stor e a marker that the CBSS PATIE NT STATEME NTS file
	10300	"^DD",349. 2,349.2,.1 8,21,2,0)
	10301	(349.2) is a complet e file for that stat ement day.
	10302	"^DD",349. 2,349.2,.1 8,"DT")
	10303	3160921
	10304	"^DD",349. 2,349.2,.1 9,0)
	10305	PATIENT ST ATEMENT DA TE^D^^0;19 ^S %DT="EX " D ^%DT S X=Y K:X<1 X
	10306	"^DD",349. 2,349.2,.1 9,3)
	10307	Enter the date of th e Patient Statement.
	10308	"^DD",349. 2,349.2,.1 9,21,0)
	10309	^^2^2^3161 019^
	10310	"^DD",349. 2,349.2,.1 9,21,1,0)
	10311	Date Patie nt Stateme nt will di splay on p rinted ver sion. Thi s date is
	10312	"^DD",349. 2,349.2,.1 9,21,2,0)
	10313	standardly two days after the statement is transmi tted
	10314	"^DD",349. 2,349.2,.1 9,"DT")
	10315	3161103
	10316	"^DD",349. 2,349.2,51 ,0)
	10317	ERROR CODE (S)^F^^5;1 ^K:$L(X)>3 0!($L(X)<5 ) X
	10318	"^DD",349. 2,349.2,51 ,1,0)
	10319	^.1^^0
	10320	"^DD",349. 2,349.2,51 ,1,1,0)
	10321	349.2^AD^M UMPS
	10322	"^DD",349. 2,349.2,51 ,1,1,1)
	10323	S ^RCPS(34 9.2,"AD"," E",DA)=""
	10324	"^DD",349. 2,349.2,51 ,1,1,2)
	10325	K ^RCPS(34 9.2,"AD"," E",DA)
	10326	"^DD",349. 2,349.2,51 ,1,1,"%D", 0)
	10327	^^2^2^3190 201^
	10328	"^DD",349. 2,349.2,51 ,1,1,"%D", 1,0)
	10329	This is th e cross-re ference to find pati ent statem ent errors that are
	10330	"^DD",349. 2,349.2,51 ,1,1,"%D", 2,0)
	10331	returned f rom CBSS.
	10332	"^DD",349. 2,349.2,51 ,1,1,"DT")
	10333	2960523
	10334	"^DD",349. 2,349.2,51 ,3)
	10335	Answer mus t be 5-30 characters in length .
	10336	"^DD",349. 2,349.2,51 ,21,0)
	10337	^^2^2^3161 007^
	10338	"^DD",349. 2,349.2,51 ,21,1,0)
	10339	These are the error codes sent back by C BSS when a statement cannot be
	10340	"^DD",349. 2,349.2,51 ,21,2,0)
	10341	printed.
	10342	"^DD",349. 2,349.2,51 ,"DT")
	10343	3190306
	10344	"^DD",349. 2,349.2,61 ,0)
	10345	CBSS PRINT ED^S^1:Y;0 :N;^6;1^Q
	10346	"^DD",349. 2,349.2,61 ,3)
	10347	Enter whet her the pa tient stat ement for this patie nt printed at the CB SS.
	10348	"^DD",349. 2,349.2,61 ,21,0)
	10349	^^2^2^3160 909^^
	10350	"^DD",349. 2,349.2,61 ,21,1,0)
	10351	This field indicates whether t he patient statement for this patient pr inted
	10352	"^DD",349. 2,349.2,61 ,21,2,0)
	10353	at the CCP C or not.
	10354	"^DD",349. 2,349.2,61 ,"DT")
	10355	3160921
	10356	"^DD",349. 2,349.2,81 ,0)
	10357	INTEGRATIO N CONTROL NUMBER^NJ1 2,0^^8;1^K :+X'=X!(X> 9999999999 99)!(X<0)! (X?.E1"."1 .N) X
	10358	"^DD",349. 2,349.2,81 ,3)
	10359	Enter the ICN, a num ber betwee n 0 and 99 9999999999 with no d ecimal dig its.
	10360	"^DD",349. 2,349.2,81 ,21,0)
	10361	^^2^2^3160 909^
	10362	"^DD",349. 2,349.2,81 ,21,1,0)
	10363	Machine to machine i dentifier for a pati ent. This field can only be
	10364	"^DD",349. 2,349.2,81 ,21,2,0)
	10365	edited by CIRN.
	10366	"^DD",349. 2,349.2,81 ,"DT")
	10367	3160921
	10368	"^DD",349. 2,349.2,82 ,0)
	10369	ICN CHECKS UM^F^^8;2^ K:$L(X)>6! ($L(X)<6) X
	10370	"^DD",349. 2,349.2,82 ,3)
	10371	Answer mus t be 6 cha racters in length.
	10372	"^DD",349. 2,349.2,82 ,21,0)
	10373	^^2^2^3160 428^
	10374	"^DD",349. 2,349.2,82 ,21,1,0)
	10375	This check sum is the calculate d checksum for the I ntegration Control
	10376	"^DD",349. 2,349.2,82 ,21,2,0)
	10377	Number. I t verifies the integ rity of th e ICN.
	10378	"^DD",349. 2,349.2,82 ,"DT")
	10379	3160428
	10380	"^DD",349. 2,349.2,83 ,0)
	10381	AR FLAG^S^ T:TRUE;F:F ALSE;^8;3^ Q
	10382	"^DD",349. 2,349.2,83 ,3)
	10383	Enter T fo r 'TRUE' o r F for 'F alse', for whether t he patient address w as obtaine d from AR storage.
	10384	"^DD",349. 2,349.2,83 ,21,0)
	10385	^^2^2^3160 428^
	10386	"^DD",349. 2,349.2,83 ,21,1,0)
	10387	This is a set of cod e, indicat ing whethe r or not t he address was taken
	10388	"^DD",349. 2,349.2,83 ,21,2,0)
	10389	from the A R DEBTOR ( #340).
	10390	"^DD",349. 2,349.2,83 ,"DT")
	10391	3160921
	10392	"^DD",349. 2,349.2,84 ,0)
	10393	DATE OF LA TEST BILL^ DX^^8;4^S %DT="EX" D ^%DT S X= Y K:X<1 X
	10394	"^DD",349. 2,349.2,84 ,3)
	10395	Enter the date on wh ich the la test bill was establ ished.
	10396	"^DD",349. 2,349.2,84 ,21,0)
	10397	^^1^1^3160 428^^
	10398	"^DD",349. 2,349.2,84 ,21,1,0)
	10399	The date t he latest bill was p repared. Time is no t allowed.
	10400	"^DD",349. 2,349.2,84 ,"DT")
	10401	3160921
	10402	"^DD",349. 5,349.5,0)
	10403	FIELD^^1^7
	10404	"^DD",349. 5,349.5,0, "DT")
	10405	3190115
	10406	"^DD",349. 5,349.5,0, "IX","B",3 49.5,.01)
	10407
	10408	"^DD",349. 5,349.5,0, "NM","AR A NNUAL PAYM ENT STATEM ENT")
	10409
	10410	"^DD",349. 5,349.5,0, "VRPK")
	10411	PRCA
	10412	"^DD",349. 5,349.5,.0 1,0)
	10413	PS SEGMENT NUMBER^RN J4,0^^0;1^ K:+X'=X!(X >9999)!(X< 1)!(X?.E1" ."1.N) X
	10414	"^DD",349. 5,349.5,.0 1,1,0)
	10415	^.1
	10416	"^DD",349. 5,349.5,.0 1,1,1,0)
	10417	349.5^B
	10418	"^DD",349. 5,349.5,.0 1,1,1,1)
	10419	S ^RCAP(34 9.5,"B",$E (X,1,30),D A)=""
	10420	"^DD",349. 5,349.5,.0 1,1,1,2)
	10421	K ^RCAP(34 9.5,"B",$E (X,1,30),D A)
	10422	"^DD",349. 5,349.5,.0 1,3)
	10423	Enter the PS Segment Number (a number be tween 1 an d 9999).
	10424	"^DD",349. 5,349.5,.0 1,21,0)
	10425	^^1^1^3170 223^
	10426	"^DD",349. 5,349.5,.0 1,21,1,0)
	10427	This is th e Segment Number for the "PS" Record Ide ntifier.
	10428	"^DD",349. 5,349.5,.0 1,"DT")
	10429	3170224
	10430	"^DD",349. 5,349.5,.0 2,0)
	10431	YEAR^NJ3,0 ^^0;2^K:+X '=X!(X>400 )!(X<300)! (X?.E1"."1 .N) X
	10432	"^DD",349. 5,349.5,.0 2,3)
	10433	Enter the Year for t his segmen t in Inter nal FileMa n Format ( a number b etween 300 and 400).
	10434	"^DD",349. 5,349.5,.0 2,21,0)
	10435	^^1^1^3170 223^
	10436	"^DD",349. 5,349.5,.0 2,21,1,0)
	10437	This is th e Annual P ayment Fil e Year to be process ed.
	10438	"^DD",349. 5,349.5,.0 2,"DT")
	10439	3170224
	10440	"^DD",349. 5,349.5,.0 3,0)
	10441	DATE/TIME BUILD STAR TED^D^^0;3 ^S %DT="ES TXR" D ^%D T S X=Y K: 3170101>X X
	10442	"^DD",349. 5,349.5,.0 3,3)
	10443	Enter the Date and T ime Build Started.
	10444	"^DD",349. 5,349.5,.0 3,21,0)
	10445	^^1^1^3170 223^
	10446	"^DD",349. 5,349.5,.0 3,21,1,0)
	10447	This is th e Date and Time that the Build for this file start ed.
	10448	"^DD",349. 5,349.5,.0 3,"DT")
	10449	3170224
	10450	"^DD",349. 5,349.5,.0 4,0)
	10451	DATE/TIME BUILD ENDE D^D^^0;4^S %DT="ESTX R" D ^%DT S X=Y K:31 70101>X X
	10452	"^DD",349. 5,349.5,.0 4,3)
	10453	Enter the Date and T ime Build Ended.
	10454	"^DD",349. 5,349.5,.0 4,21,0)
	10455	^^1^1^3170 223^
	10456	"^DD",349. 5,349.5,.0 4,21,1,0)
	10457	This is th e Date and Time that the Build for this file ended .
	10458	"^DD",349. 5,349.5,.0 4,"DT")
	10459	3170224
	10460	"^DD",349. 5,349.5,.0 5,0)
	10461	DATE/TIME TRANSMIT S TARTED^D^^ 0;5^S %DT= "ESTXR" D ^%DT S X=Y K:3170101 >X X
	10462	"^DD",349. 5,349.5,.0 5,3)
	10463	Enter the Date and T ime Transm it Started .
	10464	"^DD",349. 5,349.5,.0 5,21,0)
	10465	^^1^1^3170 223^
	10466	"^DD",349. 5,349.5,.0 5,21,1,0)
	10467	This is th e Date and Time that the Trans mit for th is file st arted.
	10468	"^DD",349. 5,349.5,.0 5,"DT")
	10469	3170224
	10470	"^DD",349. 5,349.5,.0 6,0)
	10471	DATE/TIME TRANSMIT E NDED^D^^0; 6^S %DT="E STXR" D ^% DT S X=Y K :3170101>X X
	10472	"^DD",349. 5,349.5,.0 6,3)
	10473	Enter Date /Time Tran smit Ended .
	10474	"^DD",349. 5,349.5,.0 6,21,0)
	10475	^^1^1^3170 223^
	10476	"^DD",349. 5,349.5,.0 6,21,1,0)
	10477	This is th e Date and Time that the Trans mit for th is file en ded.
	10478	"^DD",349. 5,349.5,.0 6,"DT")
	10479	3170224
	10480	"^DD",349. 5,349.5,1, 0)
	10481	STATEMENT FILE LINES ^349.51^^1 ;0
	10482	"^DD",349. 5,349.5,1, 21,0)
	10483	^^1^1^3170 224^^
	10484	"^DD",349. 5,349.5,1, 21,1,0)
	10485	This is th e multiple for the A nnual Paym ent Statem ent file l ines.
	10486	"^DD",349. 5,349.51,0 )
	10487	STATEMENT FILE LINES SUB-FIELD ^^.01^1
	10488	"^DD",349. 5,349.51,0 ,"DT")
	10489	3170224
	10490	"^DD",349. 5,349.51,0 ,"NM","STA TEMENT FIL E LINES")
	10491
	10492	"^DD",349. 5,349.51,0 ,"UP")
	10493	349.5
	10494	"^DD",349. 5,349.51,. 01,0)
	10495	STATEMENT FILE LINES ^MFJ342^^0 ;1^K:$L(X) >342!($L(X )<1) X
	10496	"^DD",349. 5,349.51,. 01,1,0)
	10497	^.1^^0
	10498	"^DD",349. 5,349.51,. 01,3)
	10499	Enter File Lines for Annual Pa yment Stat ement (1 t o 342 char acters).
	10500	"^DD",349. 5,349.51,. 01,21,0)
	10501	^^1^1^3170 224^
	10502	"^DD",349. 5,349.51,. 01,21,1,0)
	10503	These are the File L ines for A nnual Paym ent Statem ent.
	10504	"^DD",349. 5,349.51,. 01,"DT")
	10505	3170224
	10506	"^DD",433, 433,94,0)
	10507	AUTO-CORRE CTION DATE ^D^^9;4^S %DT="EX" D ^%DT S X= Y K:Y<1 X
	10508	"^DD",433, 433,94,3)
	10509	Type the d ate that t he stateme nt discrep ancy was c orrected.
	10510	"^DD",433, 433,94,21, 0)
	10511	^^2^2^3160 428^
	10512	"^DD",433, 433,94,21, 1,0)
	10513	The is the date that the auto- correction program c orrected t he
	10514	"^DD",433, 433,94,21, 2,0)
	10515	statement discrepanc y for this transacti on.
	10516	"^DD",433, 433,94,"DT ")
	10517	3160920
	10518	"^DD",433, 433,95,0)
	10519	AUTO-CORRE CTION TRAN S. AMOUNT^ NJ9,2^^9;5 ^S:X["$" X =$P(X,"$", 2) K:X'?." -
	10520	".N.1".".2 N!(X>99999 9)!(X<-999 999) X
	10521	"^DD",433, 433,95,3)
	10522	Type a dol lar amount between - 999999 and 999999, 2 decimal d igits.
	10523	"^DD",433, 433,95,21, 0)
	10524	^.001^1^1^ 3160428^^
	10525	"^DD",433, 433,95,21, 1,0)
	10526	This is th e transact ion amount associate d with the statement discrepan cy.
	10527	"^DD",433, 433,95,"DT ")
	10528	3160428
	10529	"^DD",433, 433,96,0)
	10530	AUTO-CORRE CTION TYPE OF ERROR^ S^I:INCOMP LETE FLAG ERROR;D:DU PLICATE TR ANSACTION; N:NULL
	10531	TRANSACTIO N AMOUNT;X :NOT FIXAB LE;^9;6^Q
	10532	"^DD",433, 433,96,3)
	10533	Type the k ind of sta tement dis crepancy e rror that was correc ted.
	10534	"^DD",433, 433,96,21, 0)
	10535	^^5^5^3161 004^
	10536	"^DD",433, 433,96,21, 1,0)
	10537	This field stores th e type of error that was corre cted
	10538	"^DD",433, 433,96,21, 2,0)
	10539	for the st atement di screpancy. The erro rs are thr ee
	10540	"^DD",433, 433,96,21, 3,0)
	10541	types: inc omplete fl ag error, a duplicat e transact ion,
	10542	"^DD",433, 433,96,21, 4,0)
	10543	a null tra nsaction a mount, or not fixabl e for all other
	10544	"^DD",433, 433,96,21, 5,0)
	10545	errors.
	10546	"^DD",433, 433,96,"DT ")
	10547	3161004
	10548	"^DD",433, 433,97,0)
	10549	AUTO-CORRE CTION TICK ET FLAG^S^ 1:YES;0:NO ;^9;7^Q
	10550	"^DD",433, 433,97,3)
	10551	Enter Yes if this tr ansaction will need to be manu ally revie wed and co rrected.
	10552	"^DD",433, 433,97,21, 0)
	10553	^^2^2^3161 027^
	10554	"^DD",433, 433,97,21, 1,0)
	10555	Flag notin g that thi s transact ion will n eed to be manually r eviewed an d
	10556	"^DD",433, 433,97,21, 2,0)
	10557	corrected.
	10558	"^DD",433, 433,97,"DT ")
	10559	3161027
	10560	"^DIC",349 .5,349.5,0 )
	10561	AR ANNUAL PAYMENT ST ATEMENT^34 9.5
	10562	"^DIC",349 .5,349.5,0 ,"GL")
	10563	^RCAP(349. 5,
	10564	"^DIC",349 .5,349.5," %",0)
	10565	^1.005^^0
	10566	"^DIC",349 .5,349.5," %D",0)
	10567	^^3^3^3170 223^
	10568	"^DIC",349 .5,349.5," %D",1,0)
	10569	This file will hold all of the previous year's pat ient payme nt data fo r
	10570	"^DIC",349 .5,349.5," %D",2,0)
	10571	that calen dar year a nd persist for only one year t o then be deleted an d
	10572	"^DIC",349 .5,349.5," %D",3,0)
	10573	replaced a t the begi nning of t he next ca lendar yea r.
	10574	"^DIC",349 .5,"B","AR ANNUAL PA YMENT STAT EMENT",349 .5)
	10575
	10576	"BLD",1073 8,6)
	10577	24^
	10578	$END KID P RCA4.531 3