9. EPMO Open Source Coordination Office Redaction File Detail Report

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

9.1 Files compared

#	Location	File	Last Modified
1	OSCIF_MCCF EDI TAS_ PRCA_4.5_318_July_2017.zip	PRCA_4_5_318_TEST_V1.kid	Mon Jul 31 12:32:10 2017 UTC
2	OSCIF_MCCF EDI TAS_ PRCA_4.5_318_July_2017.zip	PRCA_4_5_318_TEST_V1.kid	Mon Jul 31 20:47:56 2017 UTC

9.2 Comparison summary

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

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

9.4 Active regular expressions

No regular expressions were active.

9.5 Comparison detail

	1	PRCA4.53 18 TEST v1 4
	2	Extracted from mail message
	3	KIDS:P RCA4.531 8^
	4
	5	INSTALL NAME
	6	PRCA4.53 18
	7	"BLD",1046 1,0)
	8	PRCA4.53 18^ACCOUNT S RECEIVAB LE^0^31704 20^y
	9	"BLD",1046 1,4,0)
	10	^9.64PA^34 4.31^2
	11	"BLD",1046 1,4,344.31 ,0)
	12	344.31
	13	"BLD",1046 1,4,344.31 ,2,0)
	14	^9.641^344 .31^1
	15	"BLD",1046 1,4,344.31 ,2,344.31, 0)
	16	EDI THIRD PARTY EFT DETAIL (F ile-top le vel)
	17	"BLD",1046 1,4,344.31 ,2,344.31, 1,0)
	18	^9.6411^.0 2^1
	19	"BLD",1046 1,4,344.31 ,2,344.31, 1,.02,0)
	20	PAYER NAME
	21	"BLD",1046 1,4,344.31 ,222)
	22	y^y^p^^^^n ^^n
	23	"BLD",1046 1,4,344.31 ,224)
	24
	25	"BLD",1046 1,4,344.4, 0)
	26	344.4
	27	"BLD",1046 1,4,344.4, 2,0)
	28	^9.641^344 .4^1
	29	"BLD",1046 1,4,344.4, 2,344.4,0)
	30	ELECTRONIC REMITTANC E ADVICE (File-top level)
	31	"BLD",1046 1,4,344.4, 2,344.4,1, 0)
	32	^9.6411^.0 6^1
	33	"BLD",1046 1,4,344.4, 2,344.4,1, .06,0)
	34	PAYMENT FR OM
	35	"BLD",1046 1,4,344.4, 222)
	36	y^y^p^^^^n ^^n
	37	"BLD",1046 1,4,344.4, 224)
	38
	39	"BLD",1046 1,4,"APDD" ,344.31,34 4.31)
	40
	41	"BLD",1046 1,4,"APDD" ,344.31,34 4.31,.02)
	42
	43	"BLD",1046 1,4,"APDD" ,344.4,344 .4)
	44
	45	"BLD",1046 1,4,"APDD" ,344.4,344 .4,.06)
	46
	47	"BLD",1046 1,4,"B",34 4.31,344.3 1)
	48
	49	"BLD",1046 1,4,"B",34 4.4,344.4)
	50
	51	"BLD",1046 1,6.3)
	52	25
	53	"BLD",1046 1,"INI")
	54	PRE^PRCAP3 18
	55	"BLD",1046 1,"INIT")
	56	POST^PRCAP 318
	57	"BLD",1046 1,"KRN",0)
	58	^9.67PA^77 9.2^20
	59	"BLD",1046 1,"KRN",.4 ,0)
	60	.4
	61	"BLD",1046 1,"KRN",.4 01,0)
	62	.401
	63	"BLD",1046 1,"KRN",.4 02,0)
	64	.402
	65	"BLD",1046 1,"KRN",.4 03,0)
	66	.403
	67	"BLD",1046 1,"KRN",.5 ,0)
	68	.5
	69	"BLD",1046 1,"KRN",.8 4,0)
	70	.84
	71	"BLD",1046 1,"KRN",3. 6,0)
	72	3.6
	73	"BLD",1046 1,"KRN",3. 8,0)
	74	3.8
	75	"BLD",1046 1,"KRN",9. 2,0)
	76	9.2
	77	"BLD",1046 1,"KRN",9. 8,0)
	78	9.8
	79	"BLD",1046 1,"KRN",9. 8,"NM",0)
	80	^9.68A^30^ 28
	81	"BLD",1046 1,"KRN",9. 8,"NM",1,0 )
	82	RCDPESP^^0 ^B15238590 2
	83	"BLD",1046 1,"KRN",9. 8,"NM",2,0 )
	84	RCDPEAP^^0 ^B22545950 3
	85	"BLD",1046 1,"KRN",9. 8,"NM",4,0 )
	86	RCDPESP1^^ 0^B1020778 24
	87	"BLD",1046 1,"KRN",9. 8,"NM",6,0 )
	88	RCDPEDAR^^ 0^B7269236 8
	89	"BLD",1046 1,"KRN",9. 8,"NM",7,0 )
	90	RCDPEDA2^^ 0^B9723351 3
	91	"BLD",1046 1,"KRN",9. 8,"NM",8,0 )
	92	RCDPEDA3^^ 0^B1356562 32
	93	"BLD",1046 1,"KRN",9. 8,"NM",9,0 )
	94	RCDPEAP1^^ 0^B1001618 17
	95	"BLD",1046 1,"KRN",9. 8,"NM",10, 0)
	96	RCDPEAR2^^ 0^B1115291 13
	97	"BLD",1046 1,"KRN",9. 8,"NM",11, 0)
	98	RCDPEM^^0^ B62343432
	99	"BLD",1046 1,"KRN",9. 8,"NM",12, 0)
	100	RCDPEM1^^0 ^B51446445
	101	"BLD",1046 1,"KRN",9. 8,"NM",13, 0)
	102	RCDPEMA^^0 ^B22956552
	103	"BLD",1046 1,"KRN",9. 8,"NM",14, 0)
	104	RCDPEWL^^0 ^B75628654
	105	"BLD",1046 1,"KRN",9. 8,"NM",15, 0)
	106	RCDPEWL7^^ 0^B1006120 79
	107	"BLD",1046 1,"KRN",9. 8,"NM",16, 0)
	108	PRCAP318^^ 0^B1842298
	109	"BLD",1046 1,"KRN",9. 8,"NM",17, 0)
	110	RCDPE8NZ^^ 0^B1192116 99
	111	"BLD",1046 1,"KRN",9. 8,"NM",18, 0)
	112	PRCAEXM^^0 ^B14988614
	113	"BLD",1046 1,"KRN",9. 8,"NM",19, 0)
	114	RCDPEWL8^^ 0^B1019934 84
	115	"BLD",1046 1,"KRN",9. 8,"NM",20, 0)
	116	RCDPEWL6^^ 0^B8555130 9
	117	"BLD",1046 1,"KRN",9. 8,"NM",21, 0)
	118	RCDPEWL2^^ 0^B1132682 75
	119	"BLD",1046 1,"KRN",9. 8,"NM",22, 0)
	120	RCDPEWL4^^ 0^B6291674 2
	121	"BLD",1046 1,"KRN",9. 8,"NM",23, 0)
	122	RCDPEAA2^^ 0^B1183866 16
	123	"BLD",1046 1,"KRN",9. 8,"NM",24, 0)
	124	RCDPEAA3^^ 0^B1033510 99
	125	"BLD",1046 1,"KRN",9. 8,"NM",25, 0)
	126	RCDPEAD^^0 ^B86618636
	127	"BLD",1046 1,"KRN",9. 8,"NM",26, 0)
	128	RCDPEAD1^^ 0^B6786981 6
	129	"BLD",1046 1,"KRN",9. 8,"NM",27, 0)
	130	RCDPEADP^^ 0^B1564760 63
	131	"BLD",1046 1,"KRN",9. 8,"NM",28, 0)
	132	RCDPEM9^^0 ^B45658707
	133	"BLD",1046 1,"KRN",9. 8,"NM",29, 0)
	134	RCDPELAR^^ 0^B1257825 41
	135	"BLD",1046 1,"KRN",9. 8,"NM",30, 0)
	136	RCDPELA1^^ 0^B1183911 23
	137	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"PRCAEXM" ,18)
	138
	139	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"PRCAP318 ",16)
	140
	141	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPE8NZ ",17)
	142
	143	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAA2 ",23)
	144
	145	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAA3 ",24)
	146
	147	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAD" ,25)
	148
	149	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAD1 ",26)
	150
	151	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEADP ",27)
	152
	153	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAP" ,2)
	154
	155	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAP1 ",9)
	156
	157	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEAR2 ",10)
	158
	159	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEDA2 ",7)
	160
	161	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEDA3 ",8)
	162
	163	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEDAR ",6)
	164
	165	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPELA1 ",30)
	166
	167	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPELAR ",29)
	168
	169	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEM", 11)
	170
	171	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEM1" ,12)
	172
	173	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEM9" ,28)
	174
	175	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEMA" ,13)
	176
	177	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPESP" ,1)
	178
	179	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPESP1 ",4)
	180
	181	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL" ,14)
	182
	183	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL2 ",21)
	184
	185	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL4 ",22)
	186
	187	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL6 ",20)
	188
	189	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL7 ",15)
	190
	191	"BLD",1046 1,"KRN",9. 8,"NM","B" ,"RCDPEWL8 ",19)
	192
	193	"BLD",1046 1,"KRN",19 ,0)
	194	19
	195	"BLD",1046 1,"KRN",19 ,"NM",0)
	196	^9.68A^26^ 25
	197	"BLD",1046 1,"KRN",19 ,"NM",2,0)
	198	RCDPE NR M ANUAL STAR T^^0
	199	"BLD",1046 1,"KRN",19 ,"NM",3,0)
	200	RCDPE NR M ANUAL TRAN SMIT^^0
	201	"BLD",1046 1,"KRN",19 ,"NM",4,0)
	202	RCDPE NR D ISABLE/ENA BLE^^0
	203	"BLD",1046 1,"KRN",19 ,"NM",5,0)
	204	RCDPE AUTO -POST RECE IPT REPORT ^^0
	205	"BLD",1046 1,"KRN",19 ,"NM",6,0)
	206	RCDPE EDI LOCKBOX RE PORTS MENU ^^0
	207	"BLD",1046 1,"KRN",19 ,"NM",7,0)
	208	RCDPE ACTI VE WITH EE OB REPORT^ ^4^
	209	"BLD",1046 1,"KRN",19 ,"NM",8,0)
	210	RCDPE AUTO -POST REPO RT^^4^
	211	"BLD",1046 1,"KRN",19 ,"NM",9,0)
	212	RCDPE AUTO -DECREASE REPORT^^4^
	213	"BLD",1046 1,"KRN",19 ,"NM",10,0 )
	214	RCDPE VIEW /PRINT ERA ^^4^
	215	"BLD",1046 1,"KRN",19 ,"NM",11,0 )
	216	RCDPE REMO VED ERA AU DIT^^4^
	217	"BLD",1046 1,"KRN",19 ,"NM",12,0 )
	218	RCDPE ERA W/PAPER EO B REPORT^^ 4^
	219	"BLD",1046 1,"KRN",19 ,"NM",13,0 )
	220	RCDPE EFT AUDIT REPO RT^^4^
	221	"BLD",1046 1,"KRN",19 ,"NM",14,0 )
	222	RCDPE EEOB MOVE/COPY /RMOVE RPT ^^4^
	223	"BLD",1046 1,"KRN",19 ,"NM",15,0 )
	224	RCDPE PAYE R EXCLUSIO N NAME TIN ^^4^
	225	"BLD",1046 1,"KRN",19 ,"NM",16,0 )
	226	RCDPE CARC /RARC TABL E REPORT^^ 4^
	227	"BLD",1046 1,"KRN",19 ,"NM",17,0 )
	228	RCDPE EDI LOCKBOX AC T REPORT^^ 4^
	229	"BLD",1046 1,"KRN",19 ,"NM",18,0 )
	230	RCDPE EFT AGING REPO RT^^4^
	231	"BLD",1046 1,"KRN",19 ,"NM",19,0 )
	232	RCDPE ERA AGING REPO RT^^4^
	233	"BLD",1046 1,"KRN",19 ,"NM",20,0 )
	234	RCDPE CARC /RARC QUIC K SEARCH^^ 4^
	235	"BLD",1046 1,"KRN",19 ,"NM",21,0 )
	236	RCDPE PROV IDER LVL A DJ REPORT^ ^4^
	237	"BLD",1046 1,"KRN",19 ,"NM",22,0 )
	238	RCDPE EFT TRANSACTIO N AUD REP^ ^4^
	239	"BLD",1046 1,"KRN",19 ,"NM",23,0 )
	240	RCDPE CARC CODE PAYE R REPORT^^ 4^
	241	"BLD",1046 1,"KRN",19 ,"NM",24,0 )
	242	RCDPE ERA STATUS CHN G AUD REP^ ^4^
	243	"BLD",1046 1,"KRN",19 ,"NM",25,0 )
	244	RCDPE UNAP PLIED EFT DEP REPORT ^^4^
	245	"BLD",1046 1,"KRN",19 ,"NM",26,0 )
	246	RCDP AGENT CASHIER M ENU^^2
	247	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDP AGEN T CASHIER MENU",26)
	248
	249	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE ACT IVE WITH E EOB REPORT ",7)
	250
	251	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE AUT O-DECREASE REPORT",9 )
	252
	253	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE AUT O-POST REC EIPT REPOR T",5)
	254
	255	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE AUT O-POST REP ORT",8)
	256
	257	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE CAR C CODE PAY ER REPORT" ,23)
	258
	259	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE CAR C/RARC QUI CK SEARCH" ,20)
	260
	261	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE CAR C/RARC TAB LE REPORT" ,16)
	262
	263	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EDI LOCKBOX A CT REPORT" ,17)
	264
	265	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EDI LOCKBOX R EPORTS MEN U",6)
	266
	267	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EEO B MOVE/COP Y/RMOVE RP T",14)
	268
	269	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EFT AGING REP ORT",18)
	270
	271	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EFT AUDIT REP ORT",13)
	272
	273	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE EFT TRANSACTI ON AUD REP ",22)
	274
	275	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE ERA AGING REP ORT",19)
	276
	277	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE ERA STATUS CH NG AUD REP ",24)
	278
	279	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE ERA W/PAPER E OB REPORT" ,12)
	280
	281	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE NR DISABLE/EN ABLE",4)
	282
	283	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE NR MANUAL STA RT",2)
	284
	285	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE NR MANUAL TRA NSMIT",3)
	286
	287	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE PAY ER EXCLUSI ON NAME TI N",15)
	288
	289	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE PRO VIDER LVL ADJ REPORT ",21)
	290
	291	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE REM OVED ERA A UDIT",11)
	292
	293	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE UNA PPLIED EFT DEP REPOR T",25)
	294
	295	"BLD",1046 1,"KRN",19 ,"NM","B", "RCDPE VIE W/PRINT ER A",10)
	296
	297	"BLD",1046 1,"KRN",19 .1,0)
	298	19.1
	299	"BLD",1046 1,"KRN",19 .1,"NM",0)
	300	^9.68A^2^2
	301	"BLD",1046 1,"KRN",19 .1,"NM",1, 0)
	302	RCDPEAR^^0
	303	"BLD",1046 1,"KRN",19 .1,"NM",2, 0)
	304	RCDPEPP^^0
	305	"BLD",1046 1,"KRN",19 .1,"NM","B ","RCDPEAR ",1)
	306
	307	"BLD",1046 1,"KRN",19 .1,"NM","B ","RCDPEPP ",2)
	308
	309	"BLD",1046 1,"KRN",10 1,0)
	310	101
	311	"BLD",1046 1,"KRN",10 1,"NM",0)
	312	^9.68A^24^ 24
	313	"BLD",1046 1,"KRN",10 1,"NM",1,0 )
	314	RCDPE EOB WORKLIST M ENU^^0
	315	"BLD",1046 1,"KRN",10 1,"NM",2,0 )
	316	RCDPE EOB WORKLIST S PLIT LINE^ ^0
	317	"BLD",1046 1,"KRN",10 1,"NM",3,0 )
	318	RCDPE EOB WORKLIST R ESEARCH^^0
	319	"BLD",1046 1,"KRN",10 1,"NM",4,0 )
	320	RCDPE EOB WL REVIEW^ ^0
	321	"BLD",1046 1,"KRN",10 1,"NM",5,0 )
	322	RCDPE EOB WORKLIST C HANGE VIEW ^^0
	323	"BLD",1046 1,"KRN",10 1,"NM",6,0 )
	324	RCDPE EOB WORKLIST D IST ADJ^^0
	325	"BLD",1046 1,"KRN",10 1,"NM",7,0 )
	326	RCDPE VIEW /PRINT WOR KLIST ERA^ ^0
	327	"BLD",1046 1,"KRN",10 1,"NM",8,0 )
	328	VALM QUIT^ ^0
	329	"BLD",1046 1,"KRN",10 1,"NM",9,0 )
	330	RCDPE EOB WORKLIST R ECEIPT PRO CESSING^^0
	331	"BLD",1046 1,"KRN",10 1,"NM",10, 0)
	332	RCDPE EOB WL RECEIPT VIEW^^0
	333	"BLD",1046 1,"KRN",10 1,"NM",11, 0)
	334	RCDPE EOB WORKLIST M ARK FOR AU TO POST^^0
	335	"BLD",1046 1,"KRN",10 1,"NM",12, 0)
	336	RCDPE EOB WORKLIST V ERIFY^^0
	337	"BLD",1046 1,"KRN",10 1,"NM",13, 0)
	338	RCDPE EOB WORKLIST R ESEARCH ME NU^^0
	339	"BLD",1046 1,"KRN",10 1,"NM",14, 0)
	340	RCDPE EOB WORKLIST F ULL ACCT P ROF^^0
	341	"BLD",1046 1,"KRN",10 1,"NM",15, 0)
	342	RCDPE EOB WORKLIST T PJI^^0
	343	"BLD",1046 1,"KRN",10 1,"NM",16, 0)
	344	RCDPE EOB WORKLIST B ILL COMMEN T^^0
	345	"BLD",1046 1,"KRN",10 1,"NM",17, 0)
	346	RCDPE EOB WL RESEARC H EXIT^^0
	347	"BLD",1046 1,"KRN",10 1,"NM",18, 0)
	348	RCDPE EOB WORKLIST R EESTABLISH ^^0
	349	"BLD",1046 1,"KRN",10 1,"NM",19, 0)
	350	RCDPE EOB WORKLIST A DMIN COST ADJ^^0
	351	"BLD",1046 1,"KRN",10 1,"NM",20, 0)
	352	RCDPE APAR EEOB RESE ARCH MENU^ ^0
	353	"BLD",1046 1,"KRN",10 1,"NM",21, 0)
	354	RCDPE APAR VIEW/PRIN T EOB^^0
	355	"BLD",1046 1,"KRN",10 1,"NM",22, 0)
	356	RCDPE APAR EEOB REVI EW^^0
	357	"BLD",1046 1,"KRN",10 1,"NM",23, 0)
	358	RCDPE VIEW /PRINT WOR KLIST EOB^ ^0
	359	"BLD",1046 1,"KRN",10 1,"NM",24, 0)
	360	RCDPE EOB WORKLIST R EFRESH^^0
	361	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR EEOB RE SEARCH MEN U",20)
	362
	363	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR EEOB RE VIEW",22)
	364
	365	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR VIEW/PR INT EOB",2 1)
	366
	367	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WL RECEI PT VIEW",1 0)
	368
	369	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WL RESEA RCH EXIT", 17)
	370
	371	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WL REVIE W",4)
	372
	373	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST ADMIN COS T ADJ",19)
	374
	375	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST BILL COMM ENT",16)
	376
	377	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST CHANGE VI EW",5)
	378
	379	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST DIST ADJ" ,6)
	380
	381	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST FULL ACCT PROF",14)
	382
	383	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST MARK FOR AUTO POST" ,11)
	384
	385	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST MENU",1)
	386
	387	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST RECEIPT P ROCESSING" ,9)
	388
	389	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST REESTABLI SH",18)
	390
	391	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST REFRESH", 24)
	392
	393	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST RESEARCH" ,3)
	394
	395	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST RESEARCH MENU",13)
	396
	397	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST SPLIT LIN E",2)
	398
	399	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST TPJI",15)
	400
	401	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST VERIFY",1 2)
	402
	403	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE VI EW/PRINT W ORKLIST EO B",23)
	404
	405	"BLD",1046 1,"KRN",10 1,"NM","B" ,"RCDPE VI EW/PRINT W ORKLIST ER A",7)
	406
	407	"BLD",1046 1,"KRN",10 1,"NM","B" ,"VALM QUI T",8)
	408
	409	"BLD",1046 1,"KRN",40 9.61,0)
	410	409.61
	411	"BLD",1046 1,"KRN",40 9.61,"NM", 0)
	412	^9.68A^^
	413	"BLD",1046 1,"KRN",77 1,0)
	414	771
	415	"BLD",1046 1,"KRN",77 9.2,0)
	416	779.2
	417	"BLD",1046 1,"KRN",87 0,0)
	418	870
	419	"BLD",1046 1,"KRN",89 89.51,0)
	420	8989.51
	421	"BLD",1046 1,"KRN",89 89.52,0)
	422	8989.52
	423	"BLD",1046 1,"KRN",89 94,0)
	424	8994
	425	"BLD",1046 1,"KRN","B ",.4,.4)
	426
	427	"BLD",1046 1,"KRN","B ",.401,.40 1)
	428
	429	"BLD",1046 1,"KRN","B ",.402,.40 2)
	430
	431	"BLD",1046 1,"KRN","B ",.403,.40 3)
	432
	433	"BLD",1046 1,"KRN","B ",.5,.5)
	434
	435	"BLD",1046 1,"KRN","B ",.84,.84)
	436
	437	"BLD",1046 1,"KRN","B ",3.6,3.6)
	438
	439	"BLD",1046 1,"KRN","B ",3.8,3.8)
	440
	441	"BLD",1046 1,"KRN","B ",9.2,9.2)
	442
	443	"BLD",1046 1,"KRN","B ",9.8,9.8)
	444
	445	"BLD",1046 1,"KRN","B ",19,19)
	446
	447	"BLD",1046 1,"KRN","B ",19.1,19. 1)
	448
	449	"BLD",1046 1,"KRN","B ",101,101)
	450
	451	"BLD",1046 1,"KRN","B ",409.61,4 09.61)
	452
	453	"BLD",1046 1,"KRN","B ",771,771)
	454
	455	"BLD",1046 1,"KRN","B ",779.2,77 9.2)
	456
	457	"BLD",1046 1,"KRN","B ",870,870)
	458
	459	"BLD",1046 1,"KRN","B ",8989.51, 8989.51)
	460
	461	"BLD",1046 1,"KRN","B ",8989.52, 8989.52)
	462
	463	"BLD",1046 1,"KRN","B ",8994,899 4)
	464
	465	"BLD",1046 1,"QDEF")
	466	^^^^^^^^YE S^^YES
	467	"BLD",1046 1,"QUES",0 )
	468	^9.62^^
	469	"BLD",1046 1,"REQB",0 )
	470	^9.611^4^4
	471	"BLD",1046 1,"REQB",1 ,0)
	472	PRCA4.53 04^1
	473	"BLD",1046 1,"REQB",2 ,0)
	474	PRCA4.53 17^1
	475	"BLD",1046 1,"REQB",3 ,0)
	476	PRCA4.53 01^1
	477	"BLD",1046 1,"REQB",4 ,0)
	478	PRCA4.53 03^1
	479	"BLD",1046 1,"REQB"," B","PRCA4 .5301",3)
	480
	481	"BLD",1046 1,"REQB"," B","PRCA4 .5303",4)
	482
	483	"BLD",1046 1,"REQB"," B","PRCA4 .5304",1)
	484
	485	"BLD",1046 1,"REQB"," B","PRCA4 .5317",2)
	486
	487	"FIA",344. 31)
	488	EDI THIRD PARTY EFT DETAIL
	489	"FIA",344. 31,0)
	490	^RCY(344.3 1,
	491	"FIA",344. 31,0,0)
	492	344.31PI
	493	"FIA",344. 31,0,1)
	494	y^y^p^^^^n ^^n
	495	"FIA",344. 31,0,10)
	496
	497	"FIA",344. 31,0,11)
	498
	499	"FIA",344. 31,0,"RLRO ")
	500
	501	"FIA",344. 31,0,"VR")
	502	4.5^PRCA
	503	"FIA",344. 31,344.31)
	504	1
	505	"FIA",344. 31,344.31, .02)
	506
	507	"FIA",344. 4)
	508	ELECTRONIC REMITTANC E ADVICE
	509	"FIA",344. 4,0)
	510	^RCY(344.4 ,
	511	"FIA",344. 4,0,0)
	512	344.4I
	513	"FIA",344. 4,0,1)
	514	y^y^p^^^^n ^^n
	515	"FIA",344. 4,0,10)
	516
	517	"FIA",344. 4,0,11)
	518
	519	"FIA",344. 4,0,"RLRO" )
	520
	521	"FIA",344. 4,0,"VR")
	522	4.5^PRCA
	523	"FIA",344. 4,344.4)
	524	1
	525	"FIA",344. 4,344.4,.0 6)
	526
	527	"INI")
	528	PRE^PRCAP3 18
	529	"INIT")
	530	POST^PRCAP 318
	531	"IX",344.3 1,344.31," C",0)
	532	344.31^C^U sed to loo k up entri es by the full payer name.^R^^ F^IR^I^344 .31^^^^^LS
	533	"IX",344.3 1,344.31," C",.1,0)
	534	^^1^1^3170 316^
	535	"IX",344.3 1,344.31," C",.1,1,0)
	536	This cross -reference is used f or payer n ames of up to 60 cha racters.
	537	"IX",344.3 1,344.31," C",1)
	538	S ^RCY(344 .31,"C",$E (X,1,60),D A)=""
	539	"IX",344.3 1,344.31," C",2)
	540	K ^RCY(344 .31,"C",$E (X,1,60),D A)
	541	"IX",344.3 1,344.31," C",2.5)
	542	K ^RCY(344 .31,"C")
	543	"IX",344.3 1,344.31," C",11.1,0)
	544	^.114IA^1^ 1
	545	"IX",344.3 1,344.31," C",11.1,1, 0)
	546	1^F^344.31 ^.02^60^1^ F
	547	"IX",344.4 ,344.4,"C" ,0)
	548	344.4^C^Us ed to look up entrie s by the f ull payer name.^MU^^ F^IR^I^344 .4^^^^^LS
	549	"IX",344.4 ,344.4,"C" ,.1,0)
	550	^^3^3^3170 310^
	551	"IX",344.4 ,344.4,"C" ,.1,1,0)
	552	This cross -reference is used f or payer n ames of up to 60 cha racters.
	553	"IX",344.4 ,344.4,"C" ,.1,2,0)
	554
	555	"IX",344.4 ,344.4,"C" ,.1,3,0)
	556	Do not del ete this c ross-refer ence.
	557	"IX",344.4 ,344.4,"C" ,1)
	558	S ^RCY(344 .4,"C",$$U P^XLFSTR($ E(X,1,60)) ,DA)=""
	559	"IX",344.4 ,344.4,"C" ,2)
	560	K ^RCY(344 .4,"C",$$U P^XLFSTR($ E(X,1,60)) ,DA)
	561	"IX",344.4 ,344.4,"C" ,2.5)
	562	K ^RCY(344 .4,"C")
	563	"IX",344.4 ,344.4,"C" ,11.1,0)
	564	^.114IA^1^ 1
	565	"IX",344.4 ,344.4,"C" ,11.1,1,0)
	566	1^F^344.4^ .06^60^1^F
	567	"KRN",19,2 918308,-1)
	568	2^26
	569	"KRN",19,2 918308,0)
	570	RCDP AGENT CASHIER M ENU^Agent Cashier Me nu^^M^568^ ^^^^^^561
	571	"KRN",19,2 918308,10, 0)
	572	^19.01IP^1 9^19
	573	"KRN",19,2 918308,10, 19,0)
	574	2922446^AP R^9.5
	575	"KRN",19,2 918308,10, 19,"^")
	576	RCDPE AUTO -POST RECE IPT REPORT
	577	"KRN",19,2 918308,"U" )
	578	AGENT CASH IER MENU
	579	"KRN",19,2 919462,-1)
	580	4^18
	581	"KRN",19,2 919462,0)
	582	RCDPE EFT AGING REPO RT
	583	"KRN",19,2 919463,-1)
	584	4^19
	585	"KRN",19,2 919463,0)
	586	RCDPE ERA AGING REPO RT
	587	"KRN",19,2 919468,-1)
	588	4^17
	589	"KRN",19,2 919468,0)
	590	RCDPE EDI LOCKBOX AC T REPORT
	591	"KRN",19,2 919470,-1)
	592	0^6
	593	"KRN",19,2 919470,0)
	594	RCDPE EDI LOCKBOX RE PORTS MENU ^EDI Lockb ox (ePayme nts) Repor ts Menu^^M ^^^^^^^^AC COUNTS REC EIVABLE
	595	"KRN",19,2 919470,1,0 )
	596	2^19.06^2^ 2^3140224^ ^^^
	597	"KRN",19,2 919470,1,1 ,0)
	598	This menu allows acc ess to all the repor ts that ca n be produ ced for ED I
	599	"KRN",19,2 919470,1,2 ,0)
	600	Lockbox.
	601	"KRN",19,2 919470,10, 0)
	602	^19.01IP^2 3^23
	603	"KRN",19,2 919470,10, 1,0)
	604	2919468^DA ^10
	605	"KRN",19,2 919470,10, 1,"^")
	606	RCDPE EDI LOCKBOX AC T REPORT
	607	"KRN",19,2 919470,10, 3,0)
	608	2919462^EF T^30
	609	"KRN",19,2 919470,10, 3,"^")
	610	RCDPE EFT AGING REPO RT
	611	"KRN",19,2 919470,10, 4,0)
	612	2919463^ER A^40
	613	"KRN",19,2 919470,10, 4,"^")
	614	RCDPE ERA AGING REPO RT
	615	"KRN",19,2 919470,10, 6,0)
	616	2919477^VP
	617	"KRN",19,2 919470,10, 6,"^")
	618	RCDPE VIEW /PRINT ERA
	619	"KRN",19,2 919470,10, 7,0)
	620	2919712^AB ^60
	621	"KRN",19,2 919470,10, 7,"^")
	622	RCDPE ACTI VE WITH EE OB REPORT
	623	"KRN",19,2 919470,10, 9,0)
	624	2921658^RE MR^
	625	"KRN",19,2 919470,10, 9,"^")
	626	RCDPE REMO VED ERA AU DIT
	627	"KRN",19,2 919470,10, 10,0)
	628	2921610^PO SR^
	629	"KRN",19,2 919470,10, 10,"^")
	630	RCDPE ERA W/PAPER EO B REPORT
	631	"KRN",19,2 919470,10, 11,0)
	632	2921611^DU PR
	633	"KRN",19,2 919470,10, 11,"^")
	634	RCDPE EFT AUDIT REPO RT
	635	"KRN",19,2 919470,10, 12,0)
	636	2922179^MC R
	637	"KRN",19,2 919470,10, 12,"^")
	638	RCDPE EEOB MOVE/COPY /RMOVE RPT
	639	"KRN",19,2 919470,10, 13,0)
	640	2922181^AP ^80
	641	"KRN",19,2 919470,10, 13,"^")
	642	RCDPE AUTO -POST REPO RT
	643	"KRN",19,2 919470,10, 14,0)
	644	2922182^AD ^70
	645	"KRN",19,2 919470,10, 14,"^")
	646	RCDPE AUTO -DECREASE REPORT
	647	"KRN",19,2 919470,10, 15,0)
	648	2922186^PX
	649	"KRN",19,2 919470,10, 15,"^")
	650	RCDPE PAYE R EXCLUSIO N NAME TIN
	651	"KRN",19,2 919470,10, 16,0)
	652	2922296^TB
	653	"KRN",19,2 919470,10, 16,"^")
	654	RCDPE CARC /RARC TABL E REPORT
	655	"KRN",19,2 919470,10, 17,0)
	656	2922299^QS
	657	"KRN",19,2 919470,10, 17,"^")
	658	RCDPE CARC /RARC QUIC K SEARCH
	659	"KRN",19,2 919470,10, 18,0)
	660	2922297^PL B
	661	"KRN",19,2 919470,10, 18,"^")
	662	RCDPE PROV IDER LVL A DJ REPORT
	663	"KRN",19,2 919470,10, 19,0)
	664	2922298^ET A
	665	"KRN",19,2 919470,10, 19,"^")
	666	RCDPE EFT TRANSACTIO N AUD REP
	667	"KRN",19,2 919470,10, 20,0)
	668	2922295^CR
	669	"KRN",19,2 919470,10, 20,"^")
	670	RCDPE CARC CODE PAYE R REPORT
	671	"KRN",19,2 919470,10, 21,0)
	672	2922310^ES C
	673	"KRN",19,2 919470,10, 21,"^")
	674	RCDPE ERA STATUS CHN G AUD REP
	675	"KRN",19,2 919470,10, 22,0)
	676	2922424^UN ^50
	677	"KRN",19,2 919470,10, 22,"^")
	678	RCDPE UNAP PLIED EFT DEP REPORT
	679	"KRN",19,2 919470,10, 23,0)
	680	2922446^AP R^90
	681	"KRN",19,2 919470,10, 23,"^")
	682	RCDPE AUTO -POST RECE IPT REPORT
	683	"KRN",19,2 919470,99)
	684	64371,4682 2
	685	"KRN",19,2 919470,99. 1)
	686	59232,4962 9
	687	"KRN",19,2 919470,"U" )
	688	EDI LOCKBO X (EPAYMEN TS) REPORT
	689	"KRN",19,2 919477,-1)
	690	4^10
	691	"KRN",19,2 919477,0)
	692	RCDPE VIEW /PRINT ERA
	693	"KRN",19,2 919712,-1)
	694	4^7
	695	"KRN",19,2 919712,0)
	696	RCDPE ACTI VE WITH EE OB REPORT
	697	"KRN",19,2 921610,-1)
	698	4^12
	699	"KRN",19,2 921610,0)
	700	RCDPE ERA W/PAPER EO B REPORT
	701	"KRN",19,2 921611,-1)
	702	4^13
	703	"KRN",19,2 921611,0)
	704	RCDPE EFT AUDIT REPO RT
	705	"KRN",19,2 921658,-1)
	706	4^11
	707	"KRN",19,2 921658,0)
	708	RCDPE REMO VED ERA AU DIT
	709	"KRN",19,2 922179,-1)
	710	4^14
	711	"KRN",19,2 922179,0)
	712	RCDPE EEOB MOVE/COPY /RMOVE RPT
	713	"KRN",19,2 922181,-1)
	714	4^8
	715	"KRN",19,2 922181,0)
	716	RCDPE AUTO -POST REPO RT
	717	"KRN",19,2 922182,-1)
	718	4^9
	719	"KRN",19,2 922182,0)
	720	RCDPE AUTO -DECREASE REPORT
	721	"KRN",19,2 922186,-1)
	722	4^15
	723	"KRN",19,2 922186,0)
	724	RCDPE PAYE R EXCLUSIO N NAME TIN
	725	"KRN",19,2 922295,-1)
	726	4^23
	727	"KRN",19,2 922295,0)
	728	RCDPE CARC CODE PAYE R REPORT
	729	"KRN",19,2 922296,-1)
	730	4^16
	731	"KRN",19,2 922296,0)
	732	RCDPE CARC /RARC TABL E REPORT
	733	"KRN",19,2 922297,-1)
	734	4^21
	735	"KRN",19,2 922297,0)
	736	RCDPE PROV IDER LVL A DJ REPORT
	737	"KRN",19,2 922298,-1)
	738	4^22
	739	"KRN",19,2 922298,0)
	740	RCDPE EFT TRANSACTIO N AUD REP
	741	"KRN",19,2 922299,-1)
	742	4^20
	743	"KRN",19,2 922299,0)
	744	RCDPE CARC /RARC QUIC K SEARCH
	745	"KRN",19,2 922303,-1)
	746	0^4
	747	"KRN",19,2 922303,0)
	748	RCDPE NR D ISABLE/ENA BLE^Disabl e-Enable D M Backgrou nd Job/Rep orts^^R^^P RCFA SUPER VISOR^^^^^ ^ACCOUNTS RECEIVABLE
	749	"KRN",19,2 922303,1,0 )
	750	^^3^3^3150 603^
	751	"KRN",19,2 922303,1,1 ,0)
	752	This optio n allows a user to d isable or re-enable the AR Nat ional Repo rts
	753	"KRN",19,2 922303,1,2 ,0)
	754	background job. Onc e a report is disabl ed, it won 't re-queu e to run v ia
	755	"KRN",19,2 922303,1,3 ,0)
	756	the AR Nat ional Repo rts proces s.
	757	"KRN",19,2 922303,25)
	758	DER^RCDPEN RU
	759	"KRN",19,2 922303,"U" )
	760	DISABLE-EN ABLE DM BA CKGROUND J
	761	"KRN",19,2 922305,-1)
	762	0^2
	763	"KRN",19,2 922305,0)
	764	RCDPE NR M ANUAL STAR T^Manually Start DM Extract^^R ^^PRCFA SU PERVISOR^^ ^^^^ACCOUN TS RECEIVA BLE
	765	"KRN",19,2 922305,1,0 )
	766	^19.06^2^2 ^3150603^^
	767	"KRN",19,2 922305,1,1 ,0)
	768	This optio n allows a user to r estart the AR Nation al Reports Extractio n
	769	"KRN",19,2 922305,1,2 ,0)
	770	background job if th e report i s not runn ing.
	771	"KRN",19,2 922305,25)
	772	MAN1^RCDPE NRU
	773	"KRN",19,2 922305,33)
	774
	775	"KRN",19,2 922305,"U" )
	776	MANUALLY S TART DM EX TRACT
	777	"KRN",19,2 922306,-1)
	778	0^3
	779	"KRN",19,2 922306,0)
	780	RCDPE NR M ANUAL TRAN SMIT^Manua lly Transm it DM Extr act^^R^^PR CFA SUPERV ISOR^^^^^^ ACCOUNTS R ECEIVABLE
	781	"KRN",19,2 922306,1,0 )
	782	^19.06^3^3 ^3150603^^
	783	"KRN",19,2 922306,1,1 ,0)
	784	This optio n allows a user to r etransmit a AR Natio nal Report file to
	785	"KRN",19,2 922306,1,2 ,0)
	786	FORUM for a particul ar month i f that mon th's repor t data did not
	787	"KRN",19,2 922306,1,3 ,0)
	788	successful ly transmi t the firs t time.
	789	"KRN",19,2 922306,25)
	790	MAN2^RCDPE NRU
	791	"KRN",19,2 922306,"U" )
	792	MANUALLY T RANSMIT DM EXTRACT
	793	"KRN",19,2 922310,-1)
	794	4^24
	795	"KRN",19,2 922310,0)
	796	RCDPE ERA STATUS CHN G AUD REP
	797	"KRN",19,2 922424,-1)
	798	4^25
	799	"KRN",19,2 922424,0)
	800	RCDPE UNAP PLIED EFT DEP REPORT
	801	"KRN",19,2 922446,-1)
	802	0^5
	803	"KRN",19,2 922446,0)
	804	RCDPE AUTO -POST RECE IPT REPORT ^Auto-Post ed Receipt Report^^R ^^^^^^^^AC COUNTS REC EIVABLE
	805	"KRN",19,2 922446,1,0 )
	806	^^2^2^3170 329^
	807	"KRN",19,2 922446,1,1 ,0)
	808	The Auto-P osted Rece ipt Report (APR) opt ion displa ys receipt details
	809	"KRN",19,2 922446,1,2 ,0)
	810	associated with auto -posted ER A/EFT, inc luding tot als.
	811	"KRN",19,2 922446,25)
	812	EN^RCDPELA R
	813	"KRN",19,2 922446,668 000,0)
	814	^19.0668^1 ^1
	815	"KRN",19,2 922446,668 000,1,0)
	816	APR
	817	"KRN",19,2 922446,"U" )
	818	AUTO-POSTE D RECEIPT REPORT
	819	"KRN",19.1 ,976,-1)
	820	0^2
	821	"KRN",19.1 ,976,0)
	822	RCDPEPP^Pa yment Post ing
	823	"KRN",19.1 ,977,-1)
	824	0^1
	825	"KRN",19.1 ,977,0)
	826	RCDPEAR^Ac counts Rec eivable
	827	"KRN",101, 1697,-1)
	828	0^8
	829	"KRN",101, 1697,0)
	830	VALM QUIT^ Quit^^A^^^ ^^^^^
	831	"KRN",101, 1697,.1)
	832
	833	"KRN",101, 1697,1,0)
	834	^^1^1^2911 105^
	835	"KRN",101, 1697,1,1,0 )
	836	This proto col can be used as a generic ' quit' acti on.
	837	"KRN",101, 1697,2,0)
	838	^101.02A^2 ^2
	839	"KRN",101, 1697,2,1,0 )
	840	EXIT
	841	"KRN",101, 1697,2,2,0 )
	842	QUIT
	843	"KRN",101, 1697,2,"B" ,"EXIT",1)
	844
	845	"KRN",101, 1697,2,"B" ,"QUIT",2)
	846
	847	"KRN",101, 1697,15)
	848
	849	"KRN",101, 1697,20)
	850	Q
	851	"KRN",101, 1697,99)
	852	63700,2855 7
	853	"KRN",101, 6663,-1)
	854	0^1
	855	"KRN",101, 6663,0)
	856	RCDPE EOB WORKLIST M ENU^EOB WO RKLIST MEN U^^M^^^^^^ ^^ACCOUNTS RECEIVABL E
	857	"KRN",101, 6663,1,0)
	858	^101.06^2^ 2^3170328^ ^^^
	859	"KRN",101, 6663,1,1,0 )
	860	This is th e main men u that con tains the actions th at can be performed
	861	"KRN",101, 6663,1,2,0 )
	862	manually o n ERAs rec eived.
	863	"KRN",101, 6663,4)
	864	26^4
	865	"KRN",101, 6663,10,0)
	866	^101.01PA^ 32^21
	867	"KRN",101, 6663,10,6, 0)
	868	6672^^100^
	869	"KRN",101, 6663,10,6, "^")
	870	RCDPE EOB WORKLIST S PLIT LINE
	871	"KRN",101, 6663,10,7, 0)
	872	6673^^110^
	873	"KRN",101, 6663,10,7, "^")
	874	RCDPE EOB WORKLIST D IST ADJ
	875	"KRN",101, 6663,10,17 ,0)
	876	6761^^230^
	877	"KRN",101, 6663,10,17 ,"^")
	878	RCDPE EOB WORKLIST V ERIFY
	879	"KRN",101, 6663,10,23 ,0)
	880	1697^^999^ ^^EXIT
	881	"KRN",101, 6663,10,23 ,"^")
	882	VALM QUIT
	883	"KRN",101, 6663,10,24 ,0)
	884	6675^ERA^3 10^
	885	"KRN",101, 6663,10,24 ,"^")
	886	RCDPE VIEW /PRINT WOR KLIST ERA
	887	"KRN",101, 6663,10,25 ,0)
	888	6691^^210^
	889	"KRN",101, 6663,10,25 ,"^")
	890	RCDPE EOB WL REVIEW
	891	"KRN",101, 6663,10,27 ,0)
	892	7960^^240^
	893	"KRN",101, 6663,10,27 ,"^")
	894	RCDPE EOB WORKLIST C HANGE VIEW
	895	"KRN",101, 6663,10,28 ,0)
	896	6682^^200^
	897	"KRN",101, 6663,10,28 ,"^")
	898	RCDPE EOB WL RECEIPT VIEW
	899	"KRN",101, 6663,10,29 ,0)
	900	8019^^300^
	901	"KRN",101, 6663,10,29 ,"^")
	902	RCDPE EOB WORKLIST M ARK FOR AU TO POST
	903	"KRN",101, 6663,10,30 ,0)
	904	6674^^120^
	905	"KRN",101, 6663,10,30 ,"^")
	906	RCDPE EOB WORKLIST R EFRESH
	907	"KRN",101, 6663,10,31 ,0)
	908	8009^RP^32 0^
	909	"KRN",101, 6663,10,31 ,"^")
	910	RCDPE EOB WORKLIST R ECEIPT PRO CESSING
	911	"KRN",101, 6663,10,32 ,0)
	912	6678^^130^
	913	"KRN",101, 6663,10,32 ,"^")
	914	RCDPE EOB WORKLIST R ESEARCH
	915	"KRN",101, 6663,15)
	916	I $G(RCFAS TXT) S VAL MBCK="Q"
	917	"KRN",101, 6663,26)
	918	D SHOW^VAL M
	919	"KRN",101, 6663,28)
	920	Select Act ion:
	921	"KRN",101, 6663,99)
	922	64370,3717 7
	923	"KRN",101, 6664,-1)
	924	0^13
	925	"KRN",101, 6664,0)
	926	RCDPE EOB WORKLIST R ESEARCH ME NU^Researc h Menu^^M^ ^^^^^^^ACC OUNTS RECE IVABLE
	927	"KRN",101, 6664,1,0)
	928	^101.06^2^ 2^3170327^ ^^^
	929	"KRN",101, 6664,1,1,0 )
	930	This is th e main men u that con tains the actions th at can be performed to
	931	"KRN",101, 6664,1,2,0 )
	932	research a payment/d enial for a claim wh en reviewi ng an EOB.
	933	"KRN",101, 6664,2,0)
	934	^101.02A^^ 0
	935	"KRN",101, 6664,4)
	936	26^4
	937	"KRN",101, 6664,10,0)
	938	^101.01PA^ 13^9
	939	"KRN",101, 6664,10,4, 0)
	940	6691^^300^
	941	"KRN",101, 6664,10,4, "^")
	942	RCDPE EOB WL REVIEW
	943	"KRN",101, 6664,10,5, 0)
	944	6688^^200^
	945	"KRN",101, 6664,10,5, "^")
	946	RCDPE EOB WORKLIST B ILL COMMEN T
	947	"KRN",101, 6664,10,7, 0)
	948	6669^^100^
	949	"KRN",101, 6664,10,7, "^")
	950	RCDPE EOB WORKLIST F ULL ACCT P ROF
	951	"KRN",101, 6664,10,8, 0)
	952	6677^^310^
	953	"KRN",101, 6664,10,8, "^")
	954	RCDPE EOB WL RESEARC H EXIT
	955	"KRN",101, 6664,10,9, 0)
	956	6666^^130^
	957	"KRN",101, 6664,10,9, "^")
	958	RCDPE EOB WORKLIST T PJI
	959	"KRN",101, 6664,10,11 ,0)
	960	6665^^220^
	961	"KRN",101, 6664,10,11 ,"^")
	962	RCDPE VIEW /PRINT WOR KLIST EOB
	963	"KRN",101, 6664,10,12 ,0)
	964	6687^^210^
	965	"KRN",101, 6664,10,12 ,"^")
	966	RCDPE EOB WORKLIST R EESTABLISH
	967	"KRN",101, 6664,10,13 ,0)
	968	7602^^110^
	969	"KRN",101, 6664,10,13 ,"^")
	970	RCDPE EOB WORKLIST A DMIN COST ADJ
	971	"KRN",101, 6664,15)
	972	I $G(RCFAS TXT) S VAL MBCK="Q"
	973	"KRN",101, 6664,26)
	974	D SHOW^VAL M
	975	"KRN",101, 6664,28)
	976	Select Act ion:
	977	"KRN",101, 6664,99)
	978	64369,2837 4
	979	"KRN",101, 6665,-1)
	980	0^23
	981	"KRN",101, 6665,0)
	982	RCDPE VIEW /PRINT WOR KLIST EOB^ View/Print EEOB^^A^^ ^^^^^^ACCO UNTS RECEI VABLE
	983	"KRN",101, 6665,1,0)
	984	^101.06^2^ 2^3030220^ ^^^
	985	"KRN",101, 6665,1,1,0 )
	986	This optio n allows t he user to view the detail of a selected EOB from the
	987	"KRN",101, 6665,1,2,0 )
	988	list of EO B's presen ted in the Worklist Scratch pa d function for an ER A.
	989	"KRN",101, 6665,4)
	990	^^^
	991	"KRN",101, 6665,20)
	992	D PREOB^RC DPEWL2
	993	"KRN",101, 6665,99)
	994	63700,2855 7
	995	"KRN",101, 6666,-1)
	996	0^15
	997	"KRN",101, 6666,0)
	998	RCDPE EOB WORKLIST T PJI^TPJI^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	999	"KRN",101, 6666,1,0)
	1000	^101.06^2^ 2^3021127^ ^^^
	1001	"KRN",101, 6666,1,1,0 )
	1002	This optio n allows t he user ac cess the t hird party joint inq uiry (TPJI )
	1003	"KRN",101, 6666,1,2,0 )
	1004	functions for an ele ctronic EO B's claim.
	1005	"KRN",101, 6666,4)
	1006	^^^VP
	1007	"KRN",101, 6666,20)
	1008	D TPJI^RCD PEWL2
	1009	"KRN",101, 6666,99)
	1010	63700,2855 7
	1011	"KRN",101, 6669,-1)
	1012	0^14
	1013	"KRN",101, 6669,0)
	1014	RCDPE EOB WORKLIST F ULL ACCT P ROF^Full A cct Prof^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	1015	"KRN",101, 6669,1,0)
	1016	^101.06^1^ 1^3030701^ ^^^
	1017	"KRN",101, 6669,1,1,0 )
	1018	This optio n allows t he user ac cess to th e AR funct ion FULL A CCOUNT PRO FILE.
	1019	"KRN",101, 6669,4)
	1020	^^^DA
	1021	"KRN",101, 6669,20)
	1022	D FAP^RCDP EWL2
	1023	"KRN",101, 6669,99)
	1024	63700,2855 7
	1025	"KRN",101, 6672,-1)
	1026	0^2
	1027	"KRN",101, 6672,0)
	1028	RCDPE EOB WORKLIST S PLIT LINE^ Split/Edit A Line^^A ^^^^^^^^AC COUNTS REC EIVABLE
	1029	"KRN",101, 6672,1,0)
	1030	^101.06^3^ 3^3030218^ ^^^
	1031	"KRN",101, 6672,1,1,0 )
	1032	This optio n allows t he user to split the payment a nd adjustm ent amount s of
	1033	"KRN",101, 6672,1,2,0 )
	1034	a selected line in t he ERA to redistribu te the fun ds to more accuratel y
	1035	"KRN",101, 6672,1,3,0 )
	1036	reflect th e disposit ion of the payment/a djustment.
	1037	"KRN",101, 6672,4)
	1038	^^^TB
	1039	"KRN",101, 6672,20)
	1040	D SPLIT^RC DPEWL0
	1041	"KRN",101, 6672,99)
	1042	63700,2855 7
	1043	"KRN",101, 6673,-1)
	1044	0^6
	1045	"KRN",101, 6673,0)
	1046	RCDPE EOB WORKLIST D IST ADJ^Di stribute A dj Amts^^A ^^^^^^^^AC COUNTS REC EIVABLE
	1047	"KRN",101, 6673,1,0)
	1048	^101.06^4^ 4^3170328^ ^^^
	1049	"KRN",101, 6673,1,1,0 )
	1050	This optio n allows t he user to select an adjustmen t line tha t has a
	1051	"KRN",101, 6673,1,2,0 )
	1052	negative n et payment to allow this amoun t to be di stributed to other
	1053	"KRN",101, 6673,1,3,0 )
	1054	lines so t he total a mount of p ayments re ceived to post equal s the tota l
	1055	"KRN",101, 6673,1,4,0 )
	1056	amount of the deposi t.
	1057	"KRN",101, 6673,4)
	1058	^^^TB
	1059	"KRN",101, 6673,20)
	1060	D DISTADJ^ RCDPEWL6
	1061	"KRN",101, 6673,99)
	1062	63700,2855 7
	1063	"KRN",101, 6674,-1)
	1064	0^24
	1065	"KRN",101, 6674,0)
	1066	RCDPE EOB WORKLIST R EFRESH^Ref resh Scrat ch Pad^^A^ ^^^^^^^ACC OUNTS RECE IVABLE
	1067	"KRN",101, 6674,1,0)
	1068	^101.06^3^ 3^3170328^ ^^^
	1069	"KRN",101, 6674,1,1,0 )
	1070	This optio n allows t he user to 'refresh' the workl ist scratc h pad entr y
	1071	"KRN",101, 6674,1,2,0 )
	1072	to remove all previo usly enter ed edits/s plits/adju stments an d restore it
	1073	"KRN",101, 6674,1,3,0 )
	1074	to the sta te it was in before any manual changes w ere made.
	1075	"KRN",101, 6674,4)
	1076	^^^TB
	1077	"KRN",101, 6674,20)
	1078	D REFRESH^ RCDPEWL6
	1079	"KRN",101, 6674,99)
	1080	63700,2855 7
	1081	"KRN",101, 6675,-1)
	1082	0^7
	1083	"KRN",101, 6675,0)
	1084	RCDPE VIEW /PRINT WOR KLIST ERA^ View/Print ERA^^A^^^ ^^^^^ACCOU NTS RECEIV ABLE
	1085	"KRN",101, 6675,1,0)
	1086	^101.06^2^ 2^3030219^ ^^^
	1087	"KRN",101, 6675,1,1,0 )
	1088	This optio n allows t he user to view the summary or summary a nd detail
	1089	"KRN",101, 6675,1,2,0 )
	1090	informatio n for an e lectronic remittance advice (E RA).
	1091	"KRN",101, 6675,20)
	1092	D PRERA^RC DPEWL0
	1093	"KRN",101, 6675,99)
	1094	63700,2855 7
	1095	"KRN",101, 6677,-1)
	1096	0^17
	1097	"KRN",101, 6677,0)
	1098	RCDPE EOB WL RESEARC H EXIT^Scr atch Pad M enu/Exit^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	1099	"KRN",101, 6677,1,0)
	1100	^^1^1^3030 219^
	1101	"KRN",101, 6677,1,1,0 )
	1102	This optio n allows t he user ac cess to ex it back to the ERA d isplay men u
	1103	"KRN",101, 6677,4)
	1104	^^^
	1105	"KRN",101, 6677,20)
	1106	D EXIT^RCD PEWL2
	1107	"KRN",101, 6677,99)
	1108	63700,2855 7
	1109	"KRN",101, 6678,-1)
	1110	0^3
	1111	"KRN",101, 6678,0)
	1112	RCDPE EOB WORKLIST R ESEARCH^Re search Men u^^A^^^^^^ ^^ACCOUNTS RECEIVABL E
	1113	"KRN",101, 6678,1,0)
	1114	^101.06^2^ 2^3030219^ ^^^
	1115	"KRN",101, 6678,1,1,0 )
	1116	This optio n allows t he user ac cess to th e IB optio ns for can cel, edit, add
	1117	"KRN",101, 6678,1,2,0 )
	1118	patient ch arges from within th e EDI Lock box workli st functio n.
	1119	"KRN",101, 6678,4)
	1120	^^^
	1121	"KRN",101, 6678,20)
	1122	D RESEARCH ^RCDPEWL2
	1123	"KRN",101, 6678,99)
	1124	64351,2650 3
	1125	"KRN",101, 6682,-1)
	1126	0^10
	1127	"KRN",101, 6682,0)
	1128	RCDPE EOB WL RECEIPT VIEW^Look At Receip t^^A^^^^^^ ^^ACCOUNTS RECEIVABL E
	1129	"KRN",101, 6682,20)
	1130	D VRECPT^R CDPEWL4
	1131	"KRN",101, 6682,99)
	1132	63700,2855 7
	1133	"KRN",101, 6687,-1)
	1134	0^18
	1135	"KRN",101, 6687,0)
	1136	RCDPE EOB WORKLIST R EESTABLISH ^Re-establ ish Bill^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	1137	"KRN",101, 6687,20)
	1138	D REEST^RC DPEWL2
	1139	"KRN",101, 6687,99)
	1140	63700,2855 7
	1141	"KRN",101, 6688,-1)
	1142	0^16
	1143	"KRN",101, 6688,0)
	1144	RCDPE EOB WORKLIST B ILL COMMEN T^Bill Com ment Log^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	1145	"KRN",101, 6688,20)
	1146	D BILLCOM^ RCDPEWL2
	1147	"KRN",101, 6688,99)
	1148	63700,2855 7
	1149	"KRN",101, 6691,-1)
	1150	0^4
	1151	"KRN",101, 6691,0)
	1152	RCDPE EOB WL REVIEW^ Review Lin e^^A^^^^^^ ^^ACCOUNTS RECEIVABL E
	1153	"KRN",101, 6691,20)
	1154	D REVIEW^R CDPEWL5
	1155	"KRN",101, 6691,99)
	1156	63700,2855 7
	1157	"KRN",101, 6761,-1)
	1158	0^12
	1159	"KRN",101, 6761,0)
	1160	RCDPE EOB WORKLIST V ERIFY^Veri fy^^A^^^^^ ^^^ACCOUNT S RECEIVAB LE
	1161	"KRN",101, 6761,1,0)
	1162	^101.06^3^ 3^3170328^ ^^^
	1163	"KRN",101, 6761,1,1,0 )
	1164	This optio n allows t he user to access th e options for verify ing the
	1165	"KRN",101, 6761,1,2,0 )
	1166	EEOBs agai nst the da ta on the VistA syst em to insu re the pay ments are
	1167	"KRN",101, 6761,1,3,0 )
	1168	being made for the c orrect cla im.
	1169	"KRN",101, 6761,20)
	1170	D VERIF^RC DPEWL8
	1171	"KRN",101, 6761,99)
	1172	63700,2855 7
	1173	"KRN",101, 7602,-1)
	1174	0^19
	1175	"KRN",101, 7602,0)
	1176	RCDPE EOB WORKLIST A DMIN COST ADJ^Admin Cost Adj^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
	1177	"KRN",101, 7602,1,0)
	1178	^101.06^1^ 1^3170327^ ^^
	1179	"KRN",101, 7602,1,1,0 )
	1180	Used to ad just the a dministrat ive costs, IRS cost, DMV cost, etc
	1181	"KRN",101, 7602,15)
	1182	S VALMBCK= "R" K PRCA SUP
	1183	"KRN",101, 7602,20)
	1184	S PRCASUP= 1 D FULL^V ALM1 D ^PR CAEXM K DT OUT
	1185	"KRN",101, 7602,99)
	1186	63700,2855 7
	1187	"KRN",101, 7960,-1)
	1188	0^5
	1189	"KRN",101, 7960,0)
	1190	RCDPE EOB WORKLIST C HANGE VIEW ^Change Vi ew^^A^^^^^ ^^^ACCOUNT S RECEIVAB LE
	1191	"KRN",101, 7960,20)
	1192	D CV^RCDPE WL
	1193	"KRN",101, 7960,99)
	1194	63700,2855 7
	1195	"KRN",101, 7970,-1)
	1196	0^22
	1197	"KRN",101, 7970,0)
	1198	RCDPE APAR EEOB REVI EW^Review Line^^A^^^ ^^^^^ACCOU NTS RECEIV ABLE
	1199	"KRN",101, 7970,1,0)
	1200	^^4^4^3140 515^
	1201	"KRN",101, 7970,1,1,0 )
	1202	Allows add ition of c omments or used as a bookmark on a speci fic EEOB l ine
	1203	"KRN",101, 7970,1,2,0 )
	1204	in case pr ocessing w as interru pted, ther eby allowi ng the use r to more
	1205	"KRN",101, 7970,1,3,0 )
	1206	easily res ume where they left off. This option mus t be turne d 'on' eac h
	1207	"KRN",101, 7970,1,4,0 )
	1208	time the u ser enters the EEOB to enter o r view com ments.
	1209	"KRN",101, 7970,20)
	1210	D REVIEW^R CDPEAA3(RC IENS)
	1211	"KRN",101, 7970,99)
	1212	63700,2855 7
	1213	"KRN",101, 7971,-1)
	1214	0^21
	1215	"KRN",101, 7971,0)
	1216	RCDPE APAR VIEW/PRIN T EOB^View /Print EEO B^^A^^^^^^ ^^ACCOUNTS RECEIVABL E
	1217	"KRN",101, 7971,1,0)
	1218	^^2^2^3140 516^
	1219	"KRN",101, 7971,1,1,0 )
	1220	This optio n allows t he user to view the detail of a selected
	1221	"KRN",101, 7971,1,2,0 )
	1222	EOB presen ted in the APAR Scra tch pad sc reen.
	1223	"KRN",101, 7971,20)
	1224	D PREOB^RC DPEAA3($G( RCIENS))
	1225	"KRN",101, 7971,99)
	1226	63700,2855 7
	1227	"KRN",101, 7972,-1)
	1228	0^20
	1229	"KRN",101, 7972,0)
	1230	RCDPE APAR EEOB RESE ARCH MENU^ APAR Resea rch Menu^^ M^^^^^^^^A CCOUNTS RE CEIVABLE
	1231	"KRN",101, 7972,1,0)
	1232	^101.06^2^ 2^3170327^ ^^
	1233	"KRN",101, 7972,1,1,0 )
	1234	This is th e main men u that con tains the actions th at can be performed to
	1235	"KRN",101, 7972,1,2,0 )
	1236	research a payment/d enial for a claim wh en reviewi ng an EOB.
	1237	"KRN",101, 7972,4)
	1238	26^4
	1239	"KRN",101, 7972,10,0)
	1240	^101.01PA^ 9^8
	1241	"KRN",101, 7972,10,1, 0)
	1242	6666^^120^
	1243	"KRN",101, 7972,10,1, "^")
	1244	RCDPE EOB WORKLIST T PJI
	1245	"KRN",101, 7972,10,2, 0)
	1246	7971^^220^
	1247	"KRN",101, 7972,10,2, "^")
	1248	RCDPE APAR VIEW/PRIN T EOB
	1249	"KRN",101, 7972,10,3, 0)
	1250	7970^^300^
	1251	"KRN",101, 7972,10,3, "^")
	1252	RCDPE APAR EEOB REVI EW
	1253	"KRN",101, 7972,10,4, 0)
	1254	6688^^200^
	1255	"KRN",101, 7972,10,4, "^")
	1256	RCDPE EOB WORKLIST B ILL COMMEN T
	1257	"KRN",101, 7972,10,6, 0)
	1258	6669^^100^
	1259	"KRN",101, 7972,10,6, "^")
	1260	RCDPE EOB WORKLIST F ULL ACCT P ROF
	1261	"KRN",101, 7972,10,7, 0)
	1262	6677^^310^
	1263	"KRN",101, 7972,10,7, "^")
	1264	RCDPE EOB WL RESEARC H EXIT
	1265	"KRN",101, 7972,10,8, 0)
	1266	7602^^110^
	1267	"KRN",101, 7972,10,8, "^")
	1268	RCDPE EOB WORKLIST A DMIN COST ADJ
	1269	"KRN",101, 7972,10,9, 0)
	1270	6687^^210^
	1271	"KRN",101, 7972,10,9, "^")
	1272	RCDPE EOB WORKLIST R EESTABLISH
	1273	"KRN",101, 7972,15)
	1274	I $G(RCFAS TXT) S VAL MBCK="Q"
	1275	"KRN",101, 7972,26)
	1276	D SHOW^VAL M
	1277	"KRN",101, 7972,28)
	1278	Select Act ion:
	1279	"KRN",101, 7972,99)
	1280	64369,3181 6
	1281	"KRN",101, 8009,-1)
	1282	0^9
	1283	"KRN",101, 8009,0)
	1284	RCDPE EOB WORKLIST R ECEIPT PRO CESSING^Re ceipt Proc essing^^A^ ^^^^^^^ACC OUNTS RECE IVABLE
	1285	"KRN",101, 8009,1,0)
	1286	^101.06^1^ 1^3170328^ ^^
	1287	"KRN",101, 8009,1,1,0 )
	1288	This optio n will jum p to the r eceipt pro file listm anager
	1289	"KRN",101, 8009,20)
	1290	D RECPROC^ RCDPEWL4
	1291	"KRN",101, 8009,99)
	1292	64175,4058 7
	1293	"KRN",101, 8019,-1)
	1294	0^11
	1295	"KRN",101, 8019,0)
	1296	RCDPE EOB WORKLIST M ARK FOR AU TO POST^Ma rk for Aut o Post^^A^ ^^^^^^^ACC OUNTS RECE IVABLE
	1297	"KRN",101, 8019,1,0)
	1298	^101.06^3^ 3^3170328^ ^^^
	1299	"KRN",101, 8019,1,1,0 )
	1300	This optio n allows t he user to mark an E RA for aut o-posting. If the E RA
	1301	"KRN",101, 8019,1,2,0 )
	1302	passes val idation, t he ERA wil l be marke d as an au to-post ca ndidate to get
	1303	"KRN",101, 8019,1,3,0 )
	1304	posted by the Nightl y Backgrou nd Job.
	1305	"KRN",101, 8019,20)
	1306	D AUTOPOST ^RCDPEWL8( 2)
	1307	"KRN",101, 8019,99)
	1308	64175,4272 0
	1309	"MBREQ")
	1310	0
	1311	"ORD",3,19 .1)
	1312	19.1;3;;;K EY^XPDTA1; KEYF1^XPDI A1;KEYE1^X PDIA1;KEYF 2^XPDIA1;; KEYDEL^XPD IA1
	1313	"ORD",3,19 .1,0)
	1314	SECURITY K EY
	1315	"ORD",15,1 01)
	1316	101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
	1317	"ORD",15,1 01,0)
	1318	PROTOCOL
	1319	"ORD",18,1 9)
	1320	19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
	1321	"ORD",18,1 9,0)
	1322	OPTION
	1323	"PKG",561, -1)
	1324	1^1
	1325	"PKG",561, 0)
	1326	ACCOUNTS R ECEIVABLE^ PRCA^FMS
	1327	"PKG",561, 20,0)
	1328	^9.402P^1^ 1
	1329	"PKG",561, 20,1,0)
	1330	2^^PRCAMRG
	1331	"PKG",561, 20,1,1)
	1332
	1333	"PKG",561, 20,"B",2,1 )
	1334
	1335	"PKG",561, 22,0)
	1336	^9.49I^1^1
	1337	"PKG",561, 22,1,0)
	1338	4.5^295032 0^2950331
	1339	"PKG",561, 22,1,"PAH" ,1,0)
	1340	318^317042 0
	1341	"QUES","XP F1",0)
	1342	Y
	1343	"QUES","XP F1","??")
	1344	^D REP^XPD H
	1345	"QUES","XP F1","A")
	1346	Shall I wr ite over y our \|FLAG\| File
	1347	"QUES","XP F1","B")
	1348	YES
	1349	"QUES","XP F1","M")
	1350	D XPF1^XPD IQ
	1351	"QUES","XP F2",0)
	1352	Y
	1353	"QUES","XP F2","??")
	1354	^D DTA^XPD H
	1355	"QUES","XP F2","A")
	1356	Want my da ta \|FLAG\| yours
	1357	"QUES","XP F2","B")
	1358	YES
	1359	"QUES","XP F2","M")
	1360	D XPF2^XPD IQ
	1361	"QUES","XP I1",0)
	1362	YO
	1363	"QUES","XP I1","??")
	1364	^D INHIBIT ^XPDH
	1365	"QUES","XP I1","A")
	1366	Want KIDS to INHIBIT LOGONs du ring the i nstall
	1367	"QUES","XP I1","B")
	1368	NO
	1369	"QUES","XP I1","M")
	1370	D XPI1^XPD IQ
	1371	"QUES","XP M1",0)
	1372	PO^VA(200, :EM
	1373	"QUES","XP M1","??")
	1374	^D MG^XPDH
	1375	"QUES","XP M1","A")
	1376	Enter the Coordinato r for Mail Group '\|F LAG\|'
	1377	"QUES","XP M1","B")
	1378
	1379	"QUES","XP M1","M")
	1380	D XPM1^XPD IQ
	1381	"QUES","XP O1",0)
	1382	Y
	1383	"QUES","XP O1","??")
	1384	^D MENU^XP DH
	1385	"QUES","XP O1","A")
	1386	Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install
	1387	"QUES","XP O1","B")
	1388	YES
	1389	"QUES","XP O1","M")
	1390	D XPO1^XPD IQ
	1391	"QUES","XP Z1",0)
	1392	Y
	1393	"QUES","XP Z1","??")
	1394	^D OPT^XPD H
	1395	"QUES","XP Z1","A")
	1396	Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls
	1397	"QUES","XP Z1","B")
	1398	YES
	1399	"QUES","XP Z1","M")
	1400	D XPZ1^XPD IQ
	1401	"QUES","XP Z2",0)
	1402	Y
	1403	"QUES","XP Z2","??")
	1404	^D RTN^XPD H
	1405	"QUES","XP Z2","A")
	1406	Want to MO VE routine s to other CPUs
	1407	"QUES","XP Z2","B")
	1408	NO
	1409	"QUES","XP Z2","M")
	1410	D XPZ2^XPD IQ
	1411	"RTN")
	1412	28
	1413	"RTN","PRC AEXM")
	1414	0^18^B1498 8614^B1361 7982
	1415	"RTN","PRC AEXM",1,0)
	1416	PRCAEXM ;S F-ISC/YJK- ADMIN.COST CHARGE TR ANSACTION ;3/30/94 11:19 AM
	1417	"RTN","PRC AEXM",2,0)
	1418	;;4.5;Acc ounts Rece ivable;6 7,103,196, 301,318; Mar 20, 19 95;Build 2 5
	1419	"RTN","PRC AEXM",3,0)
	1420	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1421	"RTN","PRC AEXM",4,0)
	1422	; Update Int/adm.ba lanceand A dministrat ive cost c harge tran saction, i s called b y
	1423	"RTN","PRC AEXM",5,0)
	1424	; ^PRCAWO .
	1425	"RTN","PRC AEXM",6,0)
	1426	;
	1427	"RTN","PRC AEXM",7,0)
	1428	EN1 ; Adju stment Int erest/admi n.cost fro m an AR - this makes the int/a dm. balanc e
	1429	"RTN","PRC AEXM",8,0)
	1430	; marshal fee and c ourt cost zero,0.
	1431	"RTN","PRC AEXM",9,0)
	1432	N PRCAIND ,ADMINTOT, PRCAERR,PR CABN0
	1433	"RTN","PRC AEXM",10,0 )
	1434	I '$D(^XU SEC("RCDPE AR",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	1435	"RTN","PRC AEXM",11,0 )
	1436	. W !!,"T his action can only be taken b y users th at have th e RCDPEAR security k ey.",!
	1437	"RTN","PRC AEXM",12,0 )
	1438	. S VALMB CK="R"
	1439	"RTN","PRC AEXM",13,0 )
	1440	. D PAUSE ^VALM1
	1441	"RTN","PRC AEXM",14,0 )
	1442	D BEGIN^P RCAWO G:(' $D(PRCABN) )!('$D(PRC AEN)) END G:'$D(^PRC A(430,PRCA BN,7)) END
	1443	"RTN","PRC AEXM",15,0 )
	1444	L +^PRCA( 430,PRCABN ):1 I '$T W !!,*7,"A NOTHER USE R IS EDITI NG THIS BI LL" G EN1
	1445	"RTN","PRC AEXM",16,0 )
	1446	S PRCABN0 =PRCABN
	1447	"RTN","PRC AEXM",17,0 )
	1448	S PRCAIND =$G(^PRCA( 430,PRCABN ,7))
	1449	"RTN","PRC AEXM",18,0 )
	1450	S PRCAMT= $P(PRCAIND ,U,2)+$P(P RCAIND,U,3 )+$P(PRCAI ND,U,4)+$P (PRCAIND,U ,5)
	1451	"RTN","PRC AEXM",19,0 )
	1452	S %=$P(^P RCA(430,PR CABN,0),U, 2) I "PC"' [$P(^PRCA( 430.2,%,0) ,U,6) W *7 ,!,"This A R may not be appropr iate to ch arge Inter est/Admini strative c ost.",!,"P lease chec k the cate gory of th is AR.",! H 3
	1453	"RTN","PRC AEXM",20,0 )
	1454	K % W !!, "You may e xempt the account fr om all the interest and admini strative c ost balanc es - makin g those ba lances zer o (0),",!, "or adjust them."
	1455	"RTN","PRC AEXM",21,0 )
	1456	EN011 S %= 2 W !!,"Do you want to exempt the accoun t from all the Int/A dm. costs" D YN^DICN I %<0 S P RCACOMM="U ser Cancel ed" D DELE TE^PRCAWO1 K PRCACOM M G EN1
	1457	"RTN","PRC AEXM",22,0 )
	1458	I %=1 D E N11,END G EN1
	1459	"RTN","PRC AEXM",23,0 )
	1460	I %=0 W ! ,"ANSWER ' YES' OR 'N O' " G EN0 11
	1461	"RTN","PRC AEXM",24,0 )
	1462	W !,"Adju sting the administra tive/Inter est charge ...",!
	1463	"RTN","PRC AEXM",25,0 )
	1464	I $D(^PRC A(430,"TCS P",PRCABN) ) W !,"BIL L HAS BEEN REFERRED TO CROSS-S ERVICING." ,!,"NO MAN UAL COST A DJUSTMENTS ARE ALLOW ED." G EN1 ;prca4. 5301
	1465	"RTN","PRC AEXM",26,0 )
	1466	D DIEEN^P RCAWO1,END G EN1
	1467	"RTN","PRC AEXM",27,0 )
	1468	;
	1469	"RTN","PRC AEXM",28,0 )
	1470	; exempt interest and admin charges
	1471	"RTN","PRC AEXM",29,0 )
	1472	EN11 S PRC ATYPE=14,D IE="^PRCA( 433,",DA=P RCAEN
	1473	"RTN","PRC AEXM",30,0 )
	1474	S DR=".03 ////^S X=" _PRCABN_"; 11////^S X ="_DT_";12 ////^S X=" _PRCATYPE_ ";15////^S X="_PRCAM T_";"
	1475	"RTN","PRC AEXM",31,0 )
	1476	S DR=DR_" 27////^S X ="_+$P(PRC AIND,U,2)_ ";" ;inte rest
	1477	"RTN","PRC AEXM",32,0 )
	1478	S DR=DR_" 28////^S X ="_+$P(PRC AIND,U,3)_ ";" ;admi n charge
	1479	"RTN","PRC AEXM",33,0 )
	1480	S DR=DR_" 25////^S X ="_+$P(PRC AIND,U,4)_ ";" ;mars hal fee
	1481	"RTN","PRC AEXM",34,0 )
	1482	S DR=DR_" 26////^S X ="_+$P(PRC AIND,U,5)_ ";" ;cour t cost
	1483	"RTN","PRC AEXM",35,0 )
	1484	S DIC=DIE ,PRCA("LOC K")=0 D LO CKF^PRCAWO 1 Q:PRCA(" LOCK")=1 D ^DIE
	1485	"RTN","PRC AEXM",36,0 )
	1486	I PRCAEN, $D(^PRCA(4 30,"TCSP", PRCABN)) D DECADJ^RC TCSPU(PRCA BN,PRCAEN) ;prca4.5 301 add c s 5B flag
	1487	"RTN","PRC AEXM",37,0 )
	1488	S $P(^PRC A(430,PRCA BN,7),U,2, 5)="0^0^0^ 0" D TRANS T^PRCAWO1 Q
	1489	"RTN","PRC AEXM",38,0 )
	1490	;
	1491	"RTN","PRC AEXM",39,0 )
	1492	;
	1493	"RTN","PRC AEXM",40,0 )
	1494	EN2 Q:'$D( PRCAEN) Q :($P(^PRCA (433,PRCAE N,2),U,8)= "")&($P(^P RCA(433,PR CAEN,2),U, 7)="")
	1495	"RTN","PRC AEXM",41,0 )
	1496	W !,"MONT HLY ADMIN. CHARGE: " ,?25,+$P(^ PRCA(433,P RCAEN,2),U ,8),?40,"I NTEREST CH ARGE: ",+$ P(^PRCA(43 3,PRCAEN,2 ),U,7) Q
	1497	"RTN","PRC AEXM",42,0 )
	1498	;
	1499	"RTN","PRC AEXM",43,0 )
	1500	END L -^PR CA(433,+$G (PRCAEN)), -^PRCA(430 ,+$G(PRCAB N))
	1501	"RTN","PRC AEXM",44,0 )
	1502	S X(1)=0, X=$G(^PRCA (430,+$G(P RCABN0),7) ),X(1)=+X, X(1)=$P(X, "^",2)+X(1 ),X(1)=$P( X,"^",3)+X (1),X(1)=$ P(X,"^",4) +X(1),X(1) =$P(X,"^", 5)+X(1)
	1503	"RTN","PRC AEXM",45,0 )
	1504	K PRCA("S TATUS")
	1505	"RTN","PRC AEXM",46,0 )
	1506	I X(1)=0, $G(PRCABN0 ) D
	1507	"RTN","PRC AEXM",47,0 )
	1508	.;Check f or payment transacti ons
	1509	"RTN","PRC AEXM",48,0 )
	1510	.F X=0:0 S X=$O(^PR CA(433,"C" ,PRCABN0,X )) Q:'X I ",2,7,20, "[(","_$P( $G(^PRCA(4 30.3,+$P($ G(^PRCA(43 3,X,1)),"^ ",2),0))," ^",3)_",") S PRCA("S TATUS")=$O (^PRCA(430 .3,"AC",10 8,0))
	1511	"RTN","PRC AEXM",49,0 )
	1512	.S:'$D(PR CA("STATUS ")) PRCA(" STATUS")=$ O(^PRCA(43 0.3,"AC",1 11,0))
	1513	"RTN","PRC AEXM",50,0 )
	1514	.S DA=PRC ABN0,DIE=" ^PRCA(430, ",DR="8/// /"_PRCA("S TATUS") D ^DIE
	1515	"RTN","PRC AEXM",51,0 )
	1516	K PRCATY, PRCA,PRCA2 ,PRCAD,PRC ABN,PRCAEN ,PRCATYPE, DA,DIE,DIC ,PRCAMT,DR ,X,% Q
	1517	"RTN","PRC AP318")
	1518	0^16^B1842 298^n/a
	1519	"RTN","PRC AP318",1,0 )
	1520	PRCAP318 ; BIRM/EWL A LB/PJH - e Payment Lo ckbox Post -Installat ion Proces sing ;Dec 20, 2014@1 4:08:45
	1521	"RTN","PRC AP318",2,0 )
	1522	;;4.5;Acc ounts Rece ivable;3 18;Jan 2 1, 2014;Bu ild 25
	1523	"RTN","PRC AP318",3,0 )
	1524	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1525	"RTN","PRC AP318",4,0 )
	1526	;
	1527	"RTN","PRC AP318",5,0 )
	1528	Q
	1529	"RTN","PRC AP318",6,0 )
	1530	;
	1531	"RTN","PRC AP318",7,0 )
	1532	PRE ; pre- installati on process ing
	1533	"RTN","PRC AP318",8,0 )
	1534	N DIK
	1535	"RTN","PRC AP318",9,0 )
	1536	D MES^XPD UTL("Delet ing PAYER NAME index on EDI TH IRD PARTY EFT DETAIL file (#34 4.31)")
	1537	"RTN","PRC AP318",10, 0)
	1538	S DIK="^R CY(344.31, ",DIK(1)=" .02^C" D E NALL2^DIK
	1539	"RTN","PRC AP318",11, 0)
	1540	;
	1541	"RTN","PRC AP318",12, 0)
	1542	; IA #674 7 allows u s to use f ileman to touch the field LOCK (#19,3)
	1543	"RTN","PRC AP318",13, 0)
	1544	D MES^XPD UTL("Remov ing lock f rom menu o ption EDI Diagnostic Measures Reports [R CDPE EDI N ATIONAL RE PORTS]")
	1545	"RTN","PRC AP318",14, 0)
	1546	N DA,PRCA DA
	1547	"RTN","PRC AP318",15, 0)
	1548	S DA=$$FI ND1^DIC(19 ,,,"RCDPE EDI NATION AL REPORTS ")
	1549	"RTN","PRC AP318",16, 0)
	1550	I 'DA G P REEXIT
	1551	"RTN","PRC AP318",17, 0)
	1552	S PRCADA( 19,DA_",", 3)="@"
	1553	"RTN","PRC AP318",18, 0)
	1554	D FILE^DI E("","PRCA DA")
	1555	"RTN","PRC AP318",19, 0)
	1556	PREEXIT ;
	1557	"RTN","PRC AP318",20, 0)
	1558	Q
	1559	"RTN","PRC AP318",21, 0)
	1560	;
	1561	"RTN","PRC AP318",22, 0)
	1562	POST ; PRC A4.5318 post-insta llation pr ocessing
	1563	"RTN","PRC AP318",23, 0)
	1564	N DIK
	1565	"RTN","PRC AP318",24, 0)
	1566	D MES^XPD UTL("Re-in dexing PAY ER NAME on EDI THIRD PARTY EFT DETAIL fi le (#344.3 1)")
	1567	"RTN","PRC AP318",25, 0)
	1568	S DIK="^R CY(344.31, ",DIK(1)=" .02^C" D E NALL^DIK
	1569	"RTN","PRC AP318",26, 0)
	1570	Q
	1571	"RTN","RCD PE8NZ")
	1572	0^17^B1192 11699^B111 235321
	1573	"RTN","RCD PE8NZ",1,0 )
	1574	RCDPE8NZ ; ALB/TMK/KM L/hrubovca k - Unappl ied EFT De posits rep ort ;Jun 0 6, 2014@19 :11:19
	1575	"RTN","RCD PE8NZ",2,0 )
	1576	;;4.5;Acc ounts Rece ivable;1 73,212,208 ,269,276,2 83,293,298 ,317,318 ;Mar 20, 1 995;Build 25
	1577	"RTN","RCD PE8NZ",3,0 )
	1578	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1579	"RTN","RCD PE8NZ",4,0 )
	1580	;
	1581	"RTN","RCD PE8NZ",5,0 )
	1582	EN ; entry point for Unapplied EFT Depos its Report [RCDPE UN APPLIED EF T DEP REPO RT]
	1583	"RTN","RCD PE8NZ",6,0 )
	1584	; ^RCY(34 4.3,0) = E DI LOCKBOX DEPOSIT^3 44.3I^
	1585	"RTN","RCD PE8NZ",7,0 )
	1586	;
	1587	"RTN","RCD PE8NZ",8,0 )
	1588	N %ZIS,DI R,RCDISPTY ,RCDTRNG,R CENDT,RCHD R,RCLNCNT, RCLSTMGR,R CPGNUM,RCR PLST,RCSTD T,RCTMPND, X,Y
	1589	"RTN","RCD PE8NZ",9,0 )
	1590	; RCDISPT Y - displa y type for Excel
	1591	"RTN","RCD PE8NZ",10, 0)
	1592	; RCDTRNG - range o f dates
	1593	"RTN","RCD PE8NZ",11, 0)
	1594	; RCHDR - report he ader
	1595	"RTN","RCD PE8NZ",12, 0)
	1596	; RCLNCNT - line co unter for ^TMP stora ge
	1597	"RTN","RCD PE8NZ",13, 0)
	1598	; RCLSTMG R - ListMa n flag
	1599	"RTN","RCD PE8NZ",14, 0)
	1600	; RCPGNUM - page nu mber
	1601	"RTN","RCD PE8NZ",15, 0)
	1602	; RCRPLST - node fo r report l ist in ^TM P
	1603	"RTN","RCD PE8NZ",16, 0)
	1604	; RCTMPND - storage node (or null) for SL^RCPEARL
	1605	"RTN","RCD PE8NZ",17, 0)
	1606	;
	1607	"RTN","RCD PE8NZ",18, 0)
	1608	S RCRPLST =$T(+0)_"_ EFT" ; st orage for list of en tries
	1609	"RTN","RCD PE8NZ",19, 0)
	1610	S RCLNCNT =0,RCLSTMG R="",RCTMP ND="" ; i nitial val ues for Li stMan
	1611	"RTN","RCD PE8NZ",20, 0)
	1612	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) RPTQ
	1613	"RTN","RCD PE8NZ",21, 0)
	1614	S RCSTDT= $P(RCDTRNG ,U,2),RCEN DT=$P(RCDT RNG,U,3)
	1615	"RTN","RCD PE8NZ",22, 0)
	1616	; ask if export to excel
	1617	"RTN","RCD PE8NZ",23, 0)
	1618	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 RPTQ
	1619	"RTN","RCD PE8NZ",24, 0)
	1620	; for Exc el, set Li stMan flag to preven t question
	1621	"RTN","RCD PE8NZ",25, 0)
	1622	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	1623	"RTN","RCD PE8NZ",26, 0)
	1624	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 RPTQ
	1625	"RTN","RCD PE8NZ",27, 0)
	1626	I RCLSTMG R D G RPT Q ; send output to ListMan
	1627	"RTN","RCD PE8NZ",28, 0)
	1628	.S RCTMPN D=$T(+0)_" ^UNAPPLIED EFT" K ^T MP($J,RCTM PND) ; cl ean any re sidue
	1629	"RTN","RCD PE8NZ",29, 0)
	1630	.D MKRPRT
	1631	"RTN","RCD PE8NZ",30, 0)
	1632	.N H,L,HD R S L=0
	1633	"RTN","RCD PE8NZ",31, 0)
	1634	.S HDR("T ITLE")=$$H DRNM
	1635	"RTN","RCD PE8NZ",32, 0)
	1636	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take fir st 3 lines of report header
	1637	"RTN","RCD PE8NZ",33, 0)
	1638	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	1639	"RTN","RCD PE8NZ",34, 0)
	1640	..N N S N =0,H=L F S H=$O(RCH DR(H)) Q:' H S N=N+. 001,^TMP($ J,RCTMPND, N)=RCHDR(H )
	1641	"RTN","RCD PE8NZ",35, 0)
	1642	.; invoke ListMan
	1643	"RTN","RCD PE8NZ",36, 0)
	1644	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	1645	"RTN","RCD PE8NZ",37, 0)
	1646	;
	1647	"RTN","RCD PE8NZ",38, 0)
	1648	; Ask dev ice
	1649	"RTN","RCD PE8NZ",39, 0)
	1650	S %ZIS="Q M" D ^%ZIS Q:POP
	1651	"RTN","RCD PE8NZ",40, 0)
	1652	I $D(IO(" Q")) D Q
	1653	"RTN","RCD PE8NZ",41, 0)
	1654	.N ZTRTN, ZTSAVE,ZTD ESC,POP,ZT SK
	1655	"RTN","RCD PE8NZ",42, 0)
	1656	.S ZTRTN= "MKRPRT^RC DPE8NZ",ZT DESC="AR - List of u nlinked EF T deposit payments"
	1657	"RTN","RCD PE8NZ",43, 0)
	1658	.S ZTSAVE ("RC*")=""
	1659	"RTN","RCD PE8NZ",44, 0)
	1660	.D ^%ZTLO AD
	1661	"RTN","RCD PE8NZ",45, 0)
	1662	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" was queue d.",1:"Una ble to que ue this ta sk.")
	1663	"RTN","RCD PE8NZ",46, 0)
	1664	.K ZTSK,I O("Q") D H OME^%ZIS
	1665	"RTN","RCD PE8NZ",47, 0)
	1666	;
	1667	"RTN","RCD PE8NZ",48, 0)
	1668	U IO
	1669	"RTN","RCD PE8NZ",49, 0)
	1670	D MKRPRT
	1671	"RTN","RCD PE8NZ",50, 0)
	1672	Q
	1673	"RTN","RCD PE8NZ",51, 0)
	1674	;
	1675	"RTN","RCD PE8NZ",52, 0)
	1676	MKRPRT ; E ntry point for queue d job
	1677	"RTN","RCD PE8NZ",53, 0)
	1678	N RCTSKCN T,RCARDEP, RCCR,RCDA, RCDATA,RCD T,RCEFT,RC EFTIEN,RCR EC,RCSTAT, RCSTOP,RCS UM,RCTOT,R CTR,RCUNAP ,RECEXT,Y, Z,ZTSTOP
	1679	"RTN","RCD PE8NZ",54, 0)
	1680	;
	1681	"RTN","RCD PE8NZ",55, 0)
	1682	; get li st of unli nked EFT d eposit dat a
	1683	"RTN","RCD PE8NZ",56, 0)
	1684	K ^TMP(RC RPLST,$J) ; subscrip ts: dep da te,EFT ien ,EFT det i en
	1685	"RTN","RCD PE8NZ",57, 0)
	1686	; Data i s FMS doc indicator^ FMS doc #^ FMS Doc St atus
	1687	"RTN","RCD PE8NZ",58, 0)
	1688	; FMS doc indica tor = -1:n o receipt -2:no FMS doc 1:FM S doc exis ts
	1689	"RTN","RCD PE8NZ",59, 0)
	1690	;
	1691	"RTN","RCD PE8NZ",60, 0)
	1692	S (RCTSKC NT,RCSTOP, RCSUM,RCUN AP)=0
	1693	"RTN","RCD PE8NZ",61, 0)
	1694	S RCARDEP ="" F S R CARDEP=$O( ^RCY(344.3 ,"ARDEP",R CARDEP)) Q :RCARDEP=" "!RCSTOP S RCDA=0 F S RCDA=$ O(^RCY(344 .3,"ARDEP" ,RCARDEP,R CDA)) Q:'R CDA D Q: RCSTOP
	1695	"RTN","RCD PE8NZ",62, 0)
	1696	. S RCDAT A=$G(^RCY( 344.3,RCDA ,0)),RCDT= $P(RCDATA, U,7),RCTOT =0
	1697	"RTN","RCD PE8NZ",63, 0)
	1698	. Q:RCDT< RCSTDT ; Before sta rt date
	1699	"RTN","RCD PE8NZ",64, 0)
	1700	. Q:RCDT> (RCENDT+.9 99999) ; After the end date
	1701	"RTN","RCD PE8NZ",65, 0)
	1702	. Q:'$P(R CDATA,"^", 8) ; no p ayment amt
	1703	"RTN","RCD PE8NZ",66, 0)
	1704	. S RCEFT =0 F S RC EFT=$O(^RC Y(344.31," B",RCDA,RC EFT)) Q:'R CEFT!RCSTO P S RCDAT A(0)=$G(^R CY(344.31, RCEFT,0)) D Q:RCSTO P
	1705	"RTN","RCD PE8NZ",67, 0)
	1706	. . S RCT SKCNT=RCTS KCNT+1
	1707	"RTN","RCD PE8NZ",68, 0)
	1708	. . I '(R CTSKCNT#10 0),$D(ZTQU EUED),$$S^ %ZTLOAD S (RCSTOP,ZT STOP)=1 K ZTREQ Q
	1709	"RTN","RCD PE8NZ",69, 0)
	1710	. . Q:$P( $G(^RCY(34 4.31,RCEFT ,3)),U) ; EFT has been removed PRCA4.52 93
	1711	"RTN","RCD PE8NZ",70, 0)
	1712	. . S RCR EC=$$GETRE C(RCEFT,RC DATA(0),.R ECEXT)
	1713	"RTN","RCD PE8NZ",71, 0)
	1714	. . Q:RCR EC="PURGED " ; need to prevent processed EFTs that had recei pts purged from bein g generate d on the r eport
	1715	"RTN","RCD PE8NZ",72, 0)
	1716	. . ;; PR CA276 - ne ed to add EFT entrie s without a receipt to the tot al number of unappli ed deposit s
	1717	"RTN","RCD PE8NZ",73, 0)
	1718	. . I 'RC REC S RCUN AP=RCUNAP+ 1,^TMP(RCR PLST,$J,RC DT,RCDA,RC EFT)=-1,RC TOT=RCTOT+ $P(RCDATA( 0),U,7) Q ; No rece ipt theref ore no FMS document
	1719	"RTN","RCD PE8NZ",74, 0)
	1720	. . S RCS TAT=$$FMSS TAT^RCDPUR EC(RCREC)
	1721	"RTN","RCD PE8NZ",75, 0)
	1722	. . I $E( $P(RCSTAT, U),1,2)="T R",$P(RCST AT,U,2)["A CCEPTED" Q
	1723	"RTN","RCD PE8NZ",76, 0)
	1724	. . S RCU NAP=RCUNAP +1,RCTOT=R CTOT+$P(RC DATA(0),U, 7) ; tota l unapplie d deposits and total dollar am ount of un applied de posits
	1725	"RTN","RCD PE8NZ",77, 0)
	1726	. . I $P( RCSTAT,U,2 )="NOT ENT ERED" S ^T MP(RCRPLST ,$J,RCDT,R CDA,RCEFT) ="-2^^"_$P (RCSTAT,U) Q ; No F MS doc
	1727	"RTN","RCD PE8NZ",78, 0)
	1728	. . S ^TM P(RCRPLST, $J,RCDT,RC DA,RCEFT)= "1^"_$P(RC STAT,U,1,2 )_"^"_RECE XT
	1729	"RTN","RCD PE8NZ",79, 0)
	1730	. S:RCTOT ^TMP(RCRP LST,$J,RCD T,RCDA)=RC TOT,RCSUM= RCSUM+RCTO T
	1731	"RTN","RCD PE8NZ",80, 0)
	1732	;
	1733	"RTN","RCD PE8NZ",81, 0)
	1734	D:'RCLSTM GR HDRBLD
	1735	"RTN","RCD PE8NZ",82, 0)
	1736	D:RCLSTMG R HDRLM
	1737	"RTN","RCD PE8NZ",83, 0)
	1738	;
	1739	"RTN","RCD PE8NZ",84, 0)
	1740	I RCDISPT Y D EXCEL Q
	1741	"RTN","RCD PE8NZ",85, 0)
	1742	;
	1743	"RTN","RCD PE8NZ",86, 0)
	1744	D RPT
	1745	"RTN","RCD PE8NZ",87, 0)
	1746	Q
	1747	"RTN","RCD PE8NZ",88, 0)
	1748	;
	1749	"RTN","RCD PE8NZ",89, 0)
	1750	RPT ; dis play/print the repor t using da ta populat ed in temp orary glob al array
	1751	"RTN","RCD PE8NZ",90, 0)
	1752	N RCPAYID ,RCPAYER,X X,YY,ZZ ;PRCA4.5 318
	1753	"RTN","RCD PE8NZ",91, 0)
	1754	;
	1755	"RTN","RCD PE8NZ",92, 0)
	1756	D:'RCLSTM GR HDRLST^ RCDPEARL(. RCSTOP,.RC HDR) ; in itial repo rt header
	1757	"RTN","RCD PE8NZ",93, 0)
	1758	;
	1759	"RTN","RCD PE8NZ",94, 0)
	1760	S RCDT=0
	1761	"RTN","RCD PE8NZ",95, 0)
	1762	F S RCDT =$O(^TMP(R CRPLST,$J, RCDT)) Q:' RCDT D Q :RCSTOP
	1763	"RTN","RCD PE8NZ",96, 0)
	1764	.I 'RCLST MGR,$Y>(IO SL-RCHDR(0 )) D HDRLS T^RCDPEARL (.RCSTOP,. RCHDR) Q:R CSTOP
	1765	"RTN","RCD PE8NZ",97, 0)
	1766	.D SL^RCD PEARL(" ", .RCLNCNT,R CTMPND) ; skip a li ne
	1767	"RTN","RCD PE8NZ",98, 0)
	1768	.S Y="DEP OSIT DATE: "_$$FMTE^ XLFDT(RCDT ,1),Y=$J(" ",80-$L(Y) \2)_Y D SL ^RCDPEARL( Y,.RCLNCNT ,RCTMPND)
	1769	"RTN","RCD PE8NZ",99, 0)
	1770	.S RCARDE P=0 F S R CARDEP=$O( ^TMP(RCRPL ST,$J,RCDT ,RCARDEP)) Q:'RCARDE P D
	1771	"RTN","RCD PE8NZ",100 ,0)
	1772	..D SL^RC DPEARL(" " ,.RCLNCNT, RCTMPND) ; skip a l ine
	1773	"RTN","RCD PE8NZ",101 ,0)
	1774	..S RCTSK CNT=RCTSKC NT+1 I 'RC LSTMGR,(RC TSKCNT#100 ),$D(ZTQUE UED),$$S^% ZTLOAD D Q ; stop task
	1775	"RTN","RCD PE8NZ",102 ,0)
	1776	...S (RCS TOP,ZTSTOP )=1 D SL^R CDPEARL("T ASK STOPPE D BY USER! !",.RCLNCN T,RCTMPND) K ZTREQ
	1777	"RTN","RCD PE8NZ",103 ,0)
	1778	..;
	1779	"RTN","RCD PE8NZ",104 ,0)
	1780	..S RCDAT A(0)=$G(^R CY(344.3,R CARDEP,0))
	1781	"RTN","RCD PE8NZ",105 ,0)
	1782	..I 'RCLS TMGR,$Y>(I OSL-RCHDR( 0)) D HDRL ST^RCDPEAR L(.RCSTOP, .RCHDR) Q: RCSTOP
	1783	"RTN","RCD PE8NZ",106 ,0)
	1784	..; PRCA* 4.5*283 - Change the spaces fo r DEP # fr om 10 to 1 3 to allow 9 digit D EP #
	1785	"RTN","RCD PE8NZ",107 ,0)
	1786	..; PRCA* 4.5*317 Sh ift line 2 chars to the right
	1787	"RTN","RCD PE8NZ",108 ,0)
	1788	..S Y=" "_$E($P(RC DATA(0),U, 6)_$S('$$H ACEFT^RCDP EU(RCARDEP ):"",1:"-H AC")_$J("" ,13),1,13) ;deposit #
	1789	"RTN","RCD PE8NZ",109 ,0)
	1790	..S Y=Y_" "_$E($$F MTE^XLFDT( $P(RCDATA( 0),U,7),2) _$J("",16) ,1,16) ; deposit date
	1791	"RTN","RCD PE8NZ",110 ,0)
	1792	..S Y=Y_" "_$E($J( +$P(RCDATA (0),U,8)," ",2)_$J("" ,20),1,20) ; total a mt deposit
	1793	"RTN","RCD PE8NZ",111 ,0)
	1794	..S Y=Y_" "_$J(+$G (^TMP(RCRP LST,$J,RCD T,RCARDEP) ),"",2) ; total a mt unposte d
	1795	"RTN","RCD PE8NZ",112 ,0)
	1796	..D SL^RC DPEARL(Y,. RCLNCNT,RC TMPND)
	1797	"RTN","RCD PE8NZ",113 ,0)
	1798	..S RCEFT IEN=0 F S RCEFTIEN= $O(^TMP(RC RPLST,$J,R CDT,RCARDE P,RCEFTIEN )) Q:'RCEF TIEN S RC DATA=$G(^( RCEFTIEN)) ,RCEFT("DE P")=$G(^RC Y(344.31,R CEFTIEN,0) ) D
	1799	"RTN","RCD PE8NZ",114 ,0)
	1800	...I 'RCL STMGR,$Y>( IOSL-RCHDR (0)) D HDR LST^RCDPEA RL(.RCSTOP ,.RCHDR) Q :RCSTOP
	1801	"RTN","RCD PE8NZ",115 ,0)
	1802	...N RCPA Y S RCPAY= $P(RCEFT(" DEP"),U,2) S:RCPAY=" " RCPAY="N O PAYER NA ME RECEIVE D" ; PRCA* 4.5*298
	1803	"RTN","RCD PE8NZ",116 ,0)
	1804	...;
	1805	"RTN","RCD PE8NZ",117 ,0)
	1806	...; PRCA 4.5317 S hift line 2 chars to the right
	1807	"RTN","RCD PE8NZ",118 ,0)
	1808	...;S Y=" "_RCPAY _"/"_$P(RC EFT("DEP") ,U,3) D S L^RCDPEARL (Y,.RCLNCN T,RCTMPND) ; payer /ID
	1809	"RTN","RCD PE8NZ",119 ,0)
	1810	...; PRCA 4.5318 A ccount for payer nam es of 60 c haracters and payer ID of 20 c haracters
	1811	"RTN","RCD PE8NZ",120 ,0)
	1812	...S RCPA YID=$P(RCE FT("DEP"), U,3)
	1813	"RTN","RCD PE8NZ",121 ,0)
	1814	...S RCPA YER=RCPAY_ "/"_RCPAYI D ; p ayer/ID
	1815	"RTN","RCD PE8NZ",122 ,0)
	1816	...I $L(R CPAYER)>77 D
	1817	"RTN","RCD PE8NZ",123 ,0)
	1818	... . S Z Z=$L(RCPAY ER,"/"),XX =$P(RCPAYE R,"/",1,ZZ -1),YY=$P( RCPAYER,"/ ",ZZ)
	1819	"RTN","RCD PE8NZ",124 ,0)
	1820	... . S X X=$E(XX,1, $L(XX)-($L (RCPAYER)- 77)),RCPAY ER=XX_"/"_ YY
	1821	"RTN","RCD PE8NZ",125 ,0)
	1822	...S Y=" "_RCPAYE R
	1823	"RTN","RCD PE8NZ",126 ,0)
	1824	...; end of PRCA4. 5318
	1825	"RTN","RCD PE8NZ",127 ,0)
	1826	...D SL^R CDPEARL(Y, .RCLNCNT,R CTMPND) ; payer/ID
	1827	"RTN","RCD PE8NZ",128 ,0)
	1828	...; PRCA 4.5317 S hift line 2 chars to the right
	1829	"RTN","RCD PE8NZ",129 ,0)
	1830	...S Y=" "_$E($P (RCEFT("DE P"),U,4)_$ J("",50),1 ,50) ; trace #
	1831	"RTN","RCD PE8NZ",130 ,0)
	1832	...S Y=Y_ " "_$E($J( +$P(RCEFT( "DEP"),U,7 ),"",2)_$J ("",12),1, 12) ; payment amt
	1833	"RTN","RCD PE8NZ",131 ,0)
	1834	...;
	1835	"RTN","RCD PE8NZ",132 ,0)
	1836	...; PRCA 4.5317 S hift lines 2 to thr right to a llow 12 di git receip t #
	1837	"RTN","RCD PE8NZ",133 ,0)
	1838	...S Y=Y_ " "_$S($P( RCDATA,U,4 )'="":$P(R CDATA,U,4) ,1:"NO REC EIPT") ; receipt #
	1839	"RTN","RCD PE8NZ",134 ,0)
	1840	... D SL^ RCDPEARL(Y ,.RCLNCNT, RCTMPND)
	1841	"RTN","RCD PE8NZ",135 ,0)
	1842	...; PRCA 4.5317 S hift line 2 chars to the right
	1843	"RTN","RCD PE8NZ",136 ,0)
	1844	...S Z=$P (RCEFT("DE P"),U,8)
	1845	"RTN","RCD PE8NZ",137 ,0)
	1846	...S Y=" "_$E( $S('Z:"UNM ATCHED",Z= 2:"PAPER E OB",1:"MAT CHED TO ER A #: "_$P( RCEFT("DEP "),U,10)_$ S(Z=-1:" ( TOTALS MIS MATCH)",1: ""))_$J("" ,40),1,40) _" "
	1847	"RTN","RCD PE8NZ",138 ,0)
	1848	...S Y=Y_ $S($P(RCDA TA,U)=-1:" NO RECEIPT ",$P(RCDAT A,U)=-2:"N O FMS DOCU MENT",1:$E ($P(RCDATA ,U,2)_" - "_$P(RCDAT A,U,3),1,3 0))
	1849	"RTN","RCD PE8NZ",139 ,0)
	1850	...D SL^R CDPEARL(Y, .RCLNCNT,R CTMPND)
	1851	"RTN","RCD PE8NZ",140 ,0)
	1852	;
	1853	"RTN","RCD PE8NZ",141 ,0)
	1854	I '$D(^TM P(RCRPLST, $J)) D SL^ RCDPEARL(" * NO REC ORDS TO PR INT *",. RCLNCNT,RC TMPND)
	1855	"RTN","RCD PE8NZ",142 ,0)
	1856	;
	1857	"RTN","RCD PE8NZ",143 ,0)
	1858	I 'RCSTOP D SL^RCDP EARL(" ",. RCLNCNT,RC TMPND),SL^ RCDPEARL($ $ENDORPRT^ RCDPEARL,. RCLNCNT,RC TMPND)
	1859	"RTN","RCD PE8NZ",144 ,0)
	1860	I $D(ZTQU EUED) S ZT REQ="@"
	1861	"RTN","RCD PE8NZ",145 ,0)
	1862	D:'$D(ZTQ UEUED) ^%Z ISC
	1863	"RTN","RCD PE8NZ",146 ,0)
	1864	G:RCSTOP RPTQ
	1865	"RTN","RCD PE8NZ",147 ,0)
	1866	;
	1867	"RTN","RCD PE8NZ",148 ,0)
	1868	I 'RCLSTM GR,'RCSTOP ,$E(IOST,1 ,2)="C-" D ASK^RCDPE ARL(.RCSTO P)
	1869	"RTN","RCD PE8NZ",149 ,0)
	1870	;
	1871	"RTN","RCD PE8NZ",150 ,0)
	1872	RPTQ ;
	1873	"RTN","RCD PE8NZ",151 ,0)
	1874	K ^TMP(RC RPLST,$J)
	1875	"RTN","RCD PE8NZ",152 ,0)
	1876	Q
	1877	"RTN","RCD PE8NZ",153 ,0)
	1878	;
	1879	"RTN","RCD PE8NZ",154 ,0)
	1880	GETREC(EFT DA,EFTDET, RECEXT) ; function, prca276
	1881	"RTN","RCD PE8NZ",155 ,0)
	1882	; input - EFTDA - I EN OF 344. 31
	1883	"RTN","RCD PE8NZ",156 ,0)
	1884	; input - EFTDET - data store d at the 0 subscript of the TH IRD PARTY EFT DETAIL file (344 .31)
	1885	"RTN","RCD PE8NZ",157 ,0)
	1886	; input - RECEXT pa ssed by re ference
	1887	"RTN","RCD PE8NZ",158 ,0)
	1888	; output - RECEXT p opulated w ith the ex ternal rec eipt value that gets generated on the re port
	1889	"RTN","RCD PE8NZ",159 ,0)
	1890	; output - RECEIPT - returns internal v alue of th e receipt that eithe r comes fr om the EFT file (344 .31) or th e ERA file (344.4)
	1891	"RTN","RCD PE8NZ",160 ,0)
	1892	N RECEIPT
	1893	"RTN","RCD PE8NZ",161 ,0)
	1894	S RECEXT= 0
	1895	"RTN","RCD PE8NZ",162 ,0)
	1896	S RECEIPT =+$P($G(^R CY(344.4,+ $P(EFTDET, U,10),0)), U,8) ; ge t receipt off the ER A record
	1897	"RTN","RCD PE8NZ",163 ,0)
	1898	I 'RECEIP T,$P(EFTDE T,U,8)=2 S RECEIPT=+ $O(^RCY(34 4,"AEFT",E FTDA,0)) ; EFT proc essed agai nst paper EOB
	1899	"RTN","RCD PE8NZ",164 ,0)
	1900	I 'RECEIP T S RECEIP T=$P(EFTDE T,U,9) ; r eceipt not posted in payment f ile so get from EFT detail (un processed EFT)
	1901	"RTN","RCD PE8NZ",165 ,0)
	1902	I +RECEIP T,'$D(^RCY (344,RECEI PT)) Q "PU RGED" ; h andle purg ed receipt s but brok en pointer exists in 344.31; n eed to han dle as a p rocessed E FT
	1903	"RTN","RCD PE8NZ",166 ,0)
	1904	I +RECEIP T S RECEXT =$P(^RCY(3 44,RECEIPT ,0),U)
	1905	"RTN","RCD PE8NZ",167 ,0)
	1906	Q +RECEIP T
	1907	"RTN","RCD PE8NZ",168 ,0)
	1908	;
	1909	"RTN","RCD PE8NZ",169 ,0)
	1910	;
	1911	"RTN","RCD PE8NZ",170 ,0)
	1912	HDRBLD ; c reate the report hea der
	1913	"RTN","RCD PE8NZ",171 ,0)
	1914	; returns RCHDR, RC PGNUM, RCS TOP
	1915	"RTN","RCD PE8NZ",172 ,0)
	1916	; RCHDR (0) = head er text li ne count
	1917	"RTN","RCD PE8NZ",173 ,0)
	1918	; RCHDR ("XECUTE") = M code for page n umber
	1919	"RTN","RCD PE8NZ",174 ,0)
	1920	; RCHDR ("RUNDATE" ) = date/t ime report generated , external format
	1921	"RTN","RCD PE8NZ",175 ,0)
	1922	; RCPGN UM - page counter
	1923	"RTN","RCD PE8NZ",176 ,0)
	1924	; RCSTO P - flag t o exit
	1925	"RTN","RCD PE8NZ",177 ,0)
	1926	; INPUT:
	1927	"RTN","RCD PE8NZ",178 ,0)
	1928	; RCDIS PTY - Disp lay/print/ Excel flag
	1929	"RTN","RCD PE8NZ",179 ,0)
	1930	; RCRTY P - Report Type (EOB or ERA)
	1931	"RTN","RCD PE8NZ",180 ,0)
	1932	; VAUTD
	1933	"RTN","RCD PE8NZ",181 ,0)
	1934	K RCHDR S RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
	1935	"RTN","RCD PE8NZ",182 ,0)
	1936	;
	1937	"RTN","RCD PE8NZ",183 ,0)
	1938	;
	1939	"RTN","RCD PE8NZ",184 ,0)
	1940	I RCDISPT Y D Q ; Excel form at, xecute code is Q UIT, null page numbe r
	1941	"RTN","RCD PE8NZ",185 ,0)
	1942	.S RCHDR( 0)=1,RCHDR ("XECUTE") ="Q",RCPGN UM=""
	1943	"RTN","RCD PE8NZ",186 ,0)
	1944	.S RCHDR( 1)="DEPOSI T #^DEPOSI T DATE^TOT AMT DEPOS IT^TOT AMT UNPOSTED^ PAYER ID^T RACE #^PAY MENT AMT^R ECEIPT #^E RA MATCHED ^FMS DOC # /STATUS"
	1945	"RTN","RCD PE8NZ",187 ,0)
	1946	;
	1947	"RTN","RCD PE8NZ",188 ,0)
	1948	N DIV,HCN T,Y
	1949	"RTN","RCD PE8NZ",189 ,0)
	1950	S HCNT=0 ; header counter
	1951	"RTN","RCD PE8NZ",190 ,0)
	1952	;
	1953	"RTN","RCD PE8NZ",191 ,0)
	1954	S Y=$$HDR NM,HCNT=1, RCHDR(HCNT )=$J("",80 -$L(Y)\2)_ Y ; line 1 will be replaced b y XECUTE c ode below
	1955	"RTN","RCD PE8NZ",192 ,0)
	1956	S RCHDR(" XECUTE")=" N Y S RCPG NUM=RCPGNU M+1,Y=$$HD RNM^"_$T(+ 0)_"_$S(RC LSTMGR:""" ",1:$J(""P age: ""_RC PGNUM,12)) ,RCHDR(1)= $J("" "",8 0-$L(Y)\2) _Y"
	1957	"RTN","RCD PE8NZ",193 ,0)
	1958	S Y="Run Date: "_RC HDR("RUNDA TE"),HCNT= HCNT+1,RCH DR(HCNT)=$ J("",80-$L (Y)\2)_Y ; line 1 w ill be rep laced by X ECUTE code below
	1959	"RTN","RCD PE8NZ",194 ,0)
	1960	;
	1961	"RTN","RCD PE8NZ",195 ,0)
	1962	S Y="Date Range: "_ $$FMTE^XLF DT(RCSTDT, 2)_" - "_$ $FMTE^XLFD T(RCENDT,2 )_" (Depos it Date)", Y=$J("",80 -$L(Y)\2)_ Y
	1963	"RTN","RCD PE8NZ",196 ,0)
	1964	S HCNT=HC NT+1,RCHDR (HCNT)=Y
	1965	"RTN","RCD PE8NZ",197 ,0)
	1966	S Y="TOTA L NUMBER O F UNAPPLIE D DEPOSITS : "_RCUNAP ,HCNT=HCNT +1,RCHDR(H CNT)=$J("" ,80-$L(Y)\ 2)_Y
	1967	"RTN","RCD PE8NZ",198 ,0)
	1968	S Y="TOTA L AMOUNT O F UNAPPLIE D DEPOSITS : $"_$FN(R CSUM,",",2 ),HCNT=HCN T+1,RCHDR( HCNT)=$J(" ",80-$L(Y) \2)_Y
	1969	"RTN","RCD PE8NZ",199 ,0)
	1970	S HCNT=HC NT+1,RCHDR (HCNT)=""
	1971	"RTN","RCD PE8NZ",200 ,0)
	1972	;
	1973	"RTN","RCD PE8NZ",201 ,0)
	1974	; PRCA4. 5317 Shif t each lin e 2 chars to the rig ht
	1975	"RTN","RCD PE8NZ",202 ,0)
	1976	S HCNT=HC NT+1,RCHDR (HCNT)=" DEPOSIT # DEPOS IT DATE TOT AMT OF DEPOSI T TOT A MT UNPOSTE D"
	1977	"RTN","RCD PE8NZ",203 ,0)
	1978	S HCNT=HC NT+1,RCHDR (HCNT)=" PAYER/ID"
	1979	"RTN","RCD PE8NZ",204 ,0)
	1980	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",4)_"TRA CE #"_$J(" ",44)_"PAY MENT AMT RECEIPT #"
	1981	"RTN","RCD PE8NZ",205 ,0)
	1982	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",6)_$E(" ERA MATCHE D"_$J("",4 0),1,40)_" FMS DOC #/STATUS"
	1983	"RTN","RCD PE8NZ",206 ,0)
	1984	; PRCA4. 5317 End
	1985	"RTN","RCD PE8NZ",207 ,0)
	1986	S Y="",$P (Y,"=",81) ="",HCNT=H CNT+1,RCHD R(HCNT)=Y ; row of equal sign s at botto m
	1987	"RTN","RCD PE8NZ",208 ,0)
	1988	;
	1989	"RTN","RCD PE8NZ",209 ,0)
	1990	S RCHDR(0 )=HCNT ; header lin e count
	1991	"RTN","RCD PE8NZ",210 ,0)
	1992	Q
	1993	"RTN","RCD PE8NZ",211 ,0)
	1994	;
	1995	"RTN","RCD PE8NZ",212 ,0)
	1996	HDRLM ; cr eate the r eport head er
	1997	"RTN","RCD PE8NZ",213 ,0)
	1998	; returns RCHDR
	1999	"RTN","RCD PE8NZ",214 ,0)
	2000	; RCHDR (0) = head er text li ne count
	2001	"RTN","RCD PE8NZ",215 ,0)
	2002	; INPUT:
	2003	"RTN","RCD PE8NZ",216 ,0)
	2004	; RCSTD T - Date R ange
	2005	"RTN","RCD PE8NZ",217 ,0)
	2006	K RCHDR
	2007	"RTN","RCD PE8NZ",218 ,0)
	2008	;
	2009	"RTN","RCD PE8NZ",219 ,0)
	2010	N DIV,HCN T,Y
	2011	"RTN","RCD PE8NZ",220 ,0)
	2012	S HCNT=0 ; header counter
	2013	"RTN","RCD PE8NZ",221 ,0)
	2014	S Y="Date Range: "_ $$FMTE^XLF DT(RCSTDT, 2)_" - "_$ $FMTE^XLFD T(RCENDT,2 )_" (Depos it Date)", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	2015	"RTN","RCD PE8NZ",222 ,0)
	2016	S Y="TOTA L NUMBER O F UNAPPLIE D DEPOSITS : "_RCUNAP ,HCNT=HCNT +1,RCHDR(H CNT)=Y
	2017	"RTN","RCD PE8NZ",223 ,0)
	2018	S Y="TOTA L AMOUNT O F UNAPPLIE D DEPOSITS : $"_$FN(R CSUM,",",2 ),HCNT=HCN T+1,RCHDR( HCNT)=Y
	2019	"RTN","RCD PE8NZ",224 ,0)
	2020	;
	2021	"RTN","RCD PE8NZ",225 ,0)
	2022	; PRCA4. 5317 Shif t each lin e 2 chars to the rig ht
	2023	"RTN","RCD PE8NZ",226 ,0)
	2024	S HCNT=HC NT+1,RCHDR (HCNT)=" DEPOSIT # DEPOS IT DATE TOT AMT OF DEPOSI T TOT A MT UNPOSTE D"
	2025	"RTN","RCD PE8NZ",227 ,0)
	2026	S HCNT=HC NT+1,RCHDR (HCNT)=" PAYER/ID"
	2027	"RTN","RCD PE8NZ",228 ,0)
	2028	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",4)_"TRA CE #"_$J(" ",44)_"PAY MENT AMT RECEIPT #"
	2029	"RTN","RCD PE8NZ",229 ,0)
	2030	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",6)_$E(" ERA MATCHE D"_$J("",4 0),1,40)_" FMS DOC #/STATUS"
	2031	"RTN","RCD PE8NZ",230 ,0)
	2032	; PRCA4. 5317 End
	2033	"RTN","RCD PE8NZ",231 ,0)
	2034	;
	2035	"RTN","RCD PE8NZ",232 ,0)
	2036	S RCHDR(0 )=HCNT ; header lin e count
	2037	"RTN","RCD PE8NZ",233 ,0)
	2038	Q
	2039	"RTN","RCD PE8NZ",234 ,0)
	2040	;
	2041	"RTN","RCD PE8NZ",235 ,0)
	2042	; extrins ic variabl e, name fo r header P RCA4.529 8
	2043	"RTN","RCD PE8NZ",236 ,0)
	2044	HDRNM() Q "Unapplied EFT Depos its Report "
	2045	"RTN","RCD PE8NZ",237 ,0)
	2046	;
	2047	"RTN","RCD PE8NZ",238 ,0)
	2048	EXCEL ; Pr int report formatted for expor t to Excel
	2049	"RTN","RCD PE8NZ",239 ,0)
	2050	N STR1
	2051	"RTN","RCD PE8NZ",240 ,0)
	2052	W !,$G(RC HDR(1)),!
	2053	"RTN","RCD PE8NZ",241 ,0)
	2054	S RCDT=0 F S RCDT= $O(^TMP(RC RPLST,$J,R CDT)) Q:'R CDT D Q: RCSTOP
	2055	"RTN","RCD PE8NZ",242 ,0)
	2056	.S RCARDE P=0 F S R CARDEP=$O( ^TMP(RCRPL ST,$J,RCDT ,RCARDEP)) Q:'RCARDE P D
	2057	"RTN","RCD PE8NZ",243 ,0)
	2058	..S RCDAT A(0)=$G(^R CY(344.3,R CARDEP,0))
	2059	"RTN","RCD PE8NZ",244 ,0)
	2060	..S STR1= $P(RCDATA( 0),U,6)_$S ('$$HACEFT ^RCDPEU(RC ARDEP):"", 1:"-HAC")_ U_$$FMTE^X LFDT($P(RC DATA(0),U, 7))_U_$P(R CDATA(0),U ,8)_U
	2061	"RTN","RCD PE8NZ",245 ,0)
	2062	..S STR1= STR1_+$G(^ TMP(RCRPLS T,$J,RCDT, RCARDEP))_ U
	2063	"RTN","RCD PE8NZ",246 ,0)
	2064	..S RCEFT IEN=0 F S RCEFTIEN= $O(^TMP(RC RPLST,$J,R CDT,RCARDE P,RCEFTIEN )) Q:'RCEF TIEN S RC DATA=$G(^( RCEFTIEN)) ,RCEFT("DE P")=$G(^RC Y(344.31,R CEFTIEN,0) ) D
	2065	"RTN","RCD PE8NZ",247 ,0)
	2066	...W STR1 S:$P(RCEF T("DEP"),U ,2)="" $P( RCEFT("DEP "),U,2)="N O PAYER NA ME RECEIVE D" ;PRCA4 .5298
	2067	"RTN","RCD PE8NZ",248 ,0)
	2068	...W $P(R CEFT("DEP" ),U,2)_"/" _$P(RCEFT( "DEP"),U,3 )_U_$P(RCE FT("DEP"), U,4)_U
	2069	"RTN","RCD PE8NZ",249 ,0)
	2070	...W +$P( RCEFT("DEP "),U,7)_U_ $S($P(RCDA TA,U,4)'=" ":$P(RCDAT A,U,4),1:" NO RECEIPT ")_U
	2071	"RTN","RCD PE8NZ",250 ,0)
	2072	...W $P(R CEFT("DEP" ),U,10)_U
	2073	"RTN","RCD PE8NZ",251 ,0)
	2074	...W $S($ P(RCDATA,U )=-1:"NO R ECEIPT",$P (RCDATA,U) =-2:"NO FM S DOCUMENT ",1:$P(RCD ATA,U,2)_" - "_$P(RC DATA,U,3))
	2075	"RTN","RCD PE8NZ",252 ,0)
	2076	...W !
	2077	"RTN","RCD PE8NZ",253 ,0)
	2078	Q
	2079	"RTN","RCD PE8NZ",254 ,0)
	2080	;
	2081	"RTN","RCD PEAA2")
	2082	0^23^B1183 86616^B113 400441
	2083	"RTN","RCD PEAA2",1,0 )
	2084	RCDPEAA2 ; ALB/KML - APAR Scree n - SELECT ED EOB ;Ju n 06, 2014 @19:11:19
	2085	"RTN","RCD PEAA2",2,0 )
	2086	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	2087	"RTN","RCD PEAA2",3,0 )
	2088	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2089	"RTN","RCD PEAA2",4,0 )
	2090	Q
	2091	"RTN","RCD PEAA2",5,0 )
	2092	;
	2093	"RTN","RCD PEAA2",6,0 )
	2094	INIT(RCIEN S) ; Entry point for List temp late to bu ild the di splay of t he EEOB on APAR
	2095	"RTN","RCD PEAA2",7,0 )
	2096	;
	2097	"RTN","RCD PEAA2",8,0 )
	2098	; Inpu t - RCIENS = ien of entry in f ile 344.49 ^ien of 34 4.491^sele ctable lin e item fro m listman screen
	2099	"RTN","RCD PEAA2",9,0 )
	2100	;
	2101	"RTN","RCD PEAA2",10, 0)
	2102	N FDTTM
	2103	"RTN","RCD PEAA2",11, 0)
	2104	D CLEAN^V ALM10
	2105	"RTN","RCD PEAA2",12, 0)
	2106	K ^TMP("R CDPE-EOB_W L",$J),^TM P("RCDPE-E OB_WLDX",$ J),^TMP("R CS",$J)
	2107	"RTN","RCD PEAA2",13, 0)
	2108	S VALMCNT =0,VALMBG= 1
	2109	"RTN","RCD PEAA2",14, 0)
	2110	D BLD(RCI ENS)
	2111	"RTN","RCD PEAA2",15, 0)
	2112	Q
	2113	"RTN","RCD PEAA2",16, 0)
	2114	;
	2115	"RTN","RCD PEAA2",17, 0)
	2116	;
	2117	"RTN","RCD PEAA2",18, 0)
	2118	BLD(RCIENS ) ; Displa y selected EEOB on APAR scree n
	2119	"RTN","RCD PEAA2",19, 0)
	2120	N RCZ0,RC ECME,REASO N,V1,RCLI1 ,TLINE,RCS CR,Z,ZZ,Z0 ,ZZ1,RC0,R CTL,RCTS,R CCL,RCCL1
	2121	"RTN","RCD PEAA2",20, 0)
	2122	S RCSCR=$ P(RCIENS,U ),Z=$P(^RC Y(344.49,R CSCR,1,$P( RCIENS,U,2 ),0),U),RC PROG="RCDP EAA2"
	2123	"RTN","RCD PEAA2",21, 0)
	2124	I Z#1=0 S ZZ=+$O(^R CY(344.49, RCSCR,1,"B ",Z,0)) I ZZ D
	2125	"RTN","RCD PEAA2",22, 0)
	2126	. S Z0=Z F S Z0=$O (^RCY(344. 49,RCSCR,1 ,"B",Z0)) Q:((Z0\1)' =(Z\1)) S Z=Z0,ZZ1= +$O(^RCY(3 44.49,RCSC R,1,"B",Z0 ,0)) I ZZ1 D
	2127	"RTN","RCD PEAA2",23, 0)
	2128	.. S ^TMP ("RCS",$J, ZZ,ZZ1)=""
	2129	"RTN","RCD PEAA2",24, 0)
	2130	. S ^TMP( "RCS",$J,Z Z)=""
	2131	"RTN","RCD PEAA2",25, 0)
	2132	S (RCTS,Z Z)=0
	2133	"RTN","RCD PEAA2",26, 0)
	2134	F S ZZ=$ O(^TMP("RC S",$J,ZZ)) Q:'ZZ D
	2135	"RTN","RCD PEAA2",27, 0)
	2136	. S RCZ0= $G(^RCY(34 4.49,RCSCR ,1,ZZ,0))
	2137	"RTN","RCD PEAA2",28, 0)
	2138	. S RCECM E=$P($G(^R CY(344.4,R CSCR,1,+$P (RCZ0,U,9) ,4)),U,2) ; ECME # (344.41,.2 4)
	2139	"RTN","RCD PEAA2",29, 0)
	2140	. S REASO N=$$GET1^D IQ(344.41, $P(RCZ0,U, 9)_","_RCS CR_",",5) ; AUTOPOS T REJECTIO N REASON ( 344.41,5)
	2141	"RTN","RCD PEAA2",30, 0)
	2142	. S TLINE =$$TOPLINE (RCZ0)
	2143	"RTN","RCD PEAA2",31, 0)
	2144	. D SET(T LINE,$P(RC Z0,U),$P(R CZ0,U),ZZ)
	2145	"RTN","RCD PEAA2",32, 0)
	2146	. ; PRCA* 4.5*304 - Add claim comment to screen if it exists for this ERA EEOB d etail line
	2147	"RTN","RCD PEAA2",33, 0)
	2148	. S:$P(RC Z0,U,9)'=" " RCCL=$$G ET1^DIQ(34 4.41,$P(RC Z0,U,9)_", "_RCSCR_", ",4)
	2149	"RTN","RCD PEAA2",34, 0)
	2150	. D:$G(RC CL)'="" ; If we hav e a ERA De tail line comment, d isplay it
	2151	"RTN","RCD PEAA2",35, 0)
	2152	. . D SLI NE(RCCL,"R CCL1",58,7 6)
	2153	"RTN","RCD PEAA2",36, 0)
	2154	. . S TLI NE=$J("",4 )_"Claim C omment: "_ RCCL1(1)
	2155	"RTN","RCD PEAA2",37, 0)
	2156	. . D SET (TLINE,$P( RCZ0,U),$P (RCZ0,U),Z Z)
	2157	"RTN","RCD PEAA2",38, 0)
	2158	. . ; If we have a second lin e for the comment th en put it on the scr een
	2159	"RTN","RCD PEAA2",39, 0)
	2160	. . I RCC L1>1 D SET ($J("",4)_ RCCL1(2),$ P(RCZ0,U), $P(RCZ0,U) ,ZZ) I RCC L1=3 D SET ($J("",4)_ RCCL1(3),$ P(RCZ0,U), $P(RCZ0,U) ,ZZ)
	2161	"RTN","RCD PEAA2",40, 0)
	2162	. ; *End of 304 m odificatio ns**
	2163	"RTN","RCD PEAA2",41, 0)
	2164	. ; sub-l ine info ( e.g., "n.0 01")
	2165	"RTN","RCD PEAA2",42, 0)
	2166	. S ZZ1=0 F S ZZ1= $O(^TMP("R CS",$J,ZZ, ZZ1)) Q:'Z Z1 D
	2167	"RTN","RCD PEAA2",43, 0)
	2168	. . S RCZ Z0=$G(^RCY (344.49,RC SCR,1,ZZ1, 0))
	2169	"RTN","RCD PEAA2",44, 0)
	2170	. . S RCT =$P(RCZZ0, U),RCTL=$L (RCT)
	2171	"RTN","RCD PEAA2",45, 0)
	2172	. . S V1= $S($P(RCZZ 0,U,2)'["* ADJ":"",$ P($P(RCZZ0 ,U,2),"ADJ ",2):"A DJUSTMENT AT ERA LEV EL",1:"* ADJUSTMEN T LINE FOR TOTALS MI SMATCH")
	2173	"RTN","RCD PEAA2",46, 0)
	2174	. . S RCL I1=$S(V1=" ":" Claim #: "_$P(RC ZZ0,U,2)_" Patient/L ast 4: "_$ S($P(RCZZ0 ,U,7):$$PN M4("","",$ P(RCZZ0,U, 7)),'$P($G (^RCY(344. 49,RCSCR,1 ,ZZ1,2)),U ,3):$$PNM4 (+$G(^RCY( 344.49,RCS CR,0)),ZZ1 ),1:"??"), 1:V1)
	2175	"RTN","RCD PEAA2",47, 0)
	2176	. . D SET ($J("",4)_ $P(" ^(V )",U,$P(RC ZZ0,U,13)+ 1)_RCT_RCL I1,RCT,RCT ,ZZ1)
	2177	"RTN","RCD PEAA2",48, 0)
	2178	. . I $P( RCZZ0,U,7) D CLINES( RCZZ0,RCT, ZZ1)
	2179	"RTN","RCD PEAA2",49, 0)
	2180	. . ;
	2181	"RTN","RCD PEAA2",50, 0)
	2182	. . D SET ($J("",4+R CTL)_"Paym ent Amt: " _$J(+$P(RC ZZ0,U,5)," ",2)_" T otal Adjus tments: "_ $J(+$P(RCZ Z0,U,8),"" ,2)_" Net : "_$J($P( RCZZ0,U,5) +$P(RCZZ0, U,8),"",2) ,RCT,RCT,Z Z1)
	2183	"RTN","RCD PEAA2",51, 0)
	2184	. . ; dis plaY pharm acy EEOB d ata
	2185	"RTN","RCD PEAA2",52, 0)
	2186	. . I RCE CME]"" D R XLINES(RCZ Z0,RCECME, RCT,ZZ1)
	2187	"RTN","RCD PEAA2",53, 0)
	2188	. . I $P( RCZZ0,U,10 )'="" D SE T($J("",9) _"Receipt Comment: " _$P(RCZZ0, U,10),$P(R CZZ0,U),RC T,ZZ1)
	2189	"RTN","RCD PEAA2",54, 0)
	2190	. . I $O( ^RCY(344.4 9,RCSCR,1, ZZ1,1,0)) D ADJLINES (RCZZ0,RCT ,ZZ1)
	2191	"RTN","RCD PEAA2",55, 0)
	2192	. . I $G( ^TMP($J,"R C_REVIEW") ) D REVLIN ES(RCSCR,R CZZ0,RCT,Z Z1)
	2193	"RTN","RCD PEAA2",56, 0)
	2194	. . D SET ($J("",7)_ "APAR Reas on: "_REAS ON,RCT,RCT ,ZZ1)
	2195	"RTN","RCD PEAA2",57, 0)
	2196	. . S A=" ",$P(A,"." ,79)="" D SET(A,RCT, RCT,ZZ1)
	2197	"RTN","RCD PEAA2",58, 0)
	2198	I VALMCNT =0 D SET(" THERE ARE NO EEOBs M ATCHING YO UR SELECTI ON CRITERI A")
	2199	"RTN","RCD PEAA2",59, 0)
	2200	K ^TMP($J ,"RCS")
	2201	"RTN","RCD PEAA2",60, 0)
	2202	Q
	2203	"RTN","RCD PEAA2",61, 0)
	2204	;
	2205	"RTN","RCD PEAA2",62, 0)
	2206	SET(X,RCSE Q,RCSEQ1,R CZ9) ; -- set ListMa nager arra ys
	2207	"RTN","RCD PEAA2",63, 0)
	2208	; X = the data to s et into th e global
	2209	"RTN","RCD PEAA2",64, 0)
	2210	; RCSEQ = the selec table line #
	2211	"RTN","RCD PEAA2",65, 0)
	2212	; RCSEQ1 = = the su b line #
	2213	"RTN","RCD PEAA2",66, 0)
	2214	; RCZ9 = reference to the lin e(s) in fi le 344.41 or to the subline in
	2215	"RTN","RCD PEAA2",67, 0)
	2216	; file 344.4 9 for RCSE Q having a decimal
	2217	"RTN","RCD PEAA2",68, 0)
	2218	S VALMCNT =VALMCNT+1 ,^TMP("RCD PE-EOB_WL" ,$J,VALMCN T,0)=X
	2219	"RTN","RCD PEAA2",69, 0)
	2220	I $G(RCSE Q) S ^TMP( "RCDPE-EOB _WL",$J,"I DX",VALMCN T,RCSEQ)=" "
	2221	"RTN","RCD PEAA2",70, 0)
	2222	I $G(RCSE Q1),'$D(^T MP("RCDPE- EOB_WLDX", $J,RCSEQ1) ) S ^TMP(" RCDPE-EOB_ WLDX",$J,R CSEQ1)=VAL MCNT_U_$G( RCZ9)
	2223	"RTN","RCD PEAA2",71, 0)
	2224	Q
	2225	"RTN","RCD PEAA2",72, 0)
	2226	;
	2227	"RTN","RCD PEAA2",73, 0)
	2228	TOPLINE(RC Z0) ; Func tion retur ns the top line of t he EEOB di splay
	2229	"RTN","RCD PEAA2",74, 0)
	2230	; RCZ0 = the 0-node of the wh ole number entry lin e for the EEOB
	2231	"RTN","RCD PEAA2",75, 0)
	2232	N A
	2233	"RTN","RCD PEAA2",76, 0)
	2234	S A=" "_$ S($P(RCZ0, U,13):"(V) ",1:" ") _"EEOB: ER A Seq #"_$ S($P(RCZ0, U,9)[",":" 's",1:"")_ " "_$S($P( RCZ0,U,9)' ="":$P(RCZ 0,U,9),1:" None")_" Net Payme nt Amt: "_ $J(+$P(RCZ 0,U,6),"", 2)
	2235	"RTN","RCD PEAA2",77, 0)
	2236	I $G(^TMP ($J,"RC_RE VIEW")) S A=A_" Rev iewed?: "_ $S($P(RCZ0 ,U,11)="": "NO",1:$$E XTERNAL^DI LFD(344.49 1,.11,,$P( RCZ0,U,11) ))
	2237	"RTN","RCD PEAA2",78, 0)
	2238	Q A
	2239	"RTN","RCD PEAA2",79, 0)
	2240	;
	2241	"RTN","RCD PEAA2",80, 0)
	2242	;PRCA4.5 304 - Spl it long li ne into pr intable le nghts
	2243	"RTN","RCD PEAA2",81, 0)
	2244	SLINE(ZIN, ZARR,FLN,S LN) ;
	2245	"RTN","RCD PEAA2",82, 0)
	2246	; ZIN - I nput strin g; ZARR - Array outp ut of line s ; FLN - First line length ; SLN - Subs equent lin e lengths
	2247	"RTN","RCD PEAA2",83, 0)
	2248	; Assumes ZIN max l ength is 1 32 charact ers and FL N and SLN variables will make ZIN fit in 3 lines.
	2249	"RTN","RCD PEAA2",84, 0)
	2250	N ZL,ZI,Z M
	2251	"RTN","RCD PEAA2",85, 0)
	2252	I $L(ZIN) <(FLN+1) S @ZARR@(1) =ZIN,@ZARR =1 Q
	2253	"RTN","RCD PEAA2",86, 0)
	2254	; Otherwi se we are spanning m ore than 1 line
	2255	"RTN","RCD PEAA2",87, 0)
	2256	S ZL="" F ZI=1:1 Q: ($L(ZL)+$L ($P(ZIN," ",ZI)))>FL N S ZL=ZL _$S($L(ZL) >0:" ",1:" ")_$P(ZIN, " ",ZI)
	2257	"RTN","RCD PEAA2",88, 0)
	2258	S @ZARR@( 1)=ZL,ZL=$ P(ZIN," ", ZI,9999)
	2259	"RTN","RCD PEAA2",89, 0)
	2260	I $L(ZL)< (SLN+1) S @ZARR@(2)= ZL,@ZARR=2 Q
	2261	"RTN","RCD PEAA2",90, 0)
	2262	; Spillin g onto a t hird line.
	2263	"RTN","RCD PEAA2",91, 0)
	2264	S ZM="" F ZI=1:1 Q: ($L(ZM)+$L ($P(ZL," " ,ZI)))>SLN S ZM=ZM_ $S($L(ZM)> 0:" ",1:"" )_$P(ZL," ",ZI)
	2265	"RTN","RCD PEAA2",92, 0)
	2266	S @ZARR@( 2)=ZM,ZM=$ P(ZL," ",Z I,9999)
	2267	"RTN","RCD PEAA2",93, 0)
	2268	S @ZARR@( 3)=ZM,@ZAR R=3
	2269	"RTN","RCD PEAA2",94, 0)
	2270	Q
	2271	"RTN","RCD PEAA2",95, 0)
	2272	; *END o f 304 cha nges**
	2273	"RTN","RCD PEAA2",96, 0)
	2274	;
	2275	"RTN","RCD PEAA2",97, 0)
	2276	CLINES(RCZ Z0,RCT,ZZ1 ) ; calle d from BLD ; set up the claim informatio n lines
	2277	"RTN","RCD PEAA2",98, 0)
	2278	;
	2279	"RTN","RCD PEAA2",99, 0)
	2280	; Input - RCZZ0 = zero nod e data at 344.491
	2281	"RTN","RCD PEAA2",100 ,0)
	2282	; RCT = sub line #
	2283	"RTN","RCD PEAA2",101 ,0)
	2284	; ZZ1 = referenc e to the t o the subl ine in
	2285	"RTN","RCD PEAA2",102 ,0)
	2286	; file 344 .49 for RC SEQ having a decimal
	2287	"RTN","RCD PEAA2",103 ,0)
	2288	N A,RCX,Q ,QQ
	2289	"RTN","RCD PEAA2",104 ,0)
	2290	S A("OA") =$$ORI^PRC AFN(+$P(RC ZZ0,U,7)), A("SDT")=$ P($G(^DGCR (399,+$P(R CZZ0,U,7), "U")),U),A ("DFN")=+$ P($G(^(0)) ,U,2),A("E NRPR")=""
	2291	"RTN","RCD PEAA2",105 ,0)
	2292	; Find Rx copay sta tus
	2293	"RTN","RCD PEAA2",106 ,0)
	2294	S A("RXCP ")=$S('A(" SDT"):"",1 :$$RXST^IB ARXEU(A("D FN"),A("SD T"))),A("R XCP")=$S($ P(A("RXCP" ),U)'="":$ P(A("RXCP" ),U,2),1:" UNKNOWN") ;IA #10147
	2295	"RTN","RCD PEAA2",107 ,0)
	2296	; Find M/ T status
	2297	"RTN","RCD PEAA2",108 ,0)
	2298	S RCX=$$L ST^DGMTU(A ("DFN"),A( "SDT")),A( "M/T")=$P( RCX,U,4)
	2299	"RTN","RCD PEAA2",109 ,0)
	2300	S A("M/T" )=$S('RCX: "??",A("M/ T")="P":"P EN",A("M/T ")="C":"YE S",A("M/T" )="G":"GMT ",A("M/T") ="R":"REQ" ,1:"NO")
	2301	"RTN","RCD PEAA2",110 ,0)
	2302	S QQ=" Billed Amt : "_$J(A(" OA"),"",2) _" Amt T o Post: "_ $J(+$P(RCZ Z0,U,3),"" ,2)
	2303	"RTN","RCD PEAA2",111 ,0)
	2304	D SET($J( "",4+RCTL) _"Claim Ba l: "_$J(+$ P($$BILL^R CJIBFN2(+$ P(RCZZ0,U, 7)),U,3)," ",2)_QQ,$P (RCZZ0,U), RCT,ZZ1)
	2305	"RTN","RCD PEAA2",112 ,0)
	2306	S ^TMP("R C_BILL",$J ,$P(RCZZ0, U,7),RCT)= QQ
	2307	"RTN","RCD PEAA2",113 ,0)
	2308	S Z3=$J(" ",4+RCTL)_ "Svc Dt: " _$S(A("SDT ")'="":$$F MTE^XLFDT( A("SDT"),2 ),1:"UNKNO WN")
	2309	"RTN","RCD PEAA2",114 ,0)
	2310	S Z3=Z3_" COB: "_$ S($D(^DGCR (399,+$P(R CZZ0,U,7), "I"_($$COB N(+$P(RCZZ 0,U,7))+1) )):"YES",1 :"NO ")
	2311	"RTN","RCD PEAA2",115 ,0)
	2312	D SET(Z3_ " Rx Copa y: "_$E(A( "RXCP"),1, 17)_" Mea ns Tst: "_ A("M/T"),$ P(RCZZ0,U) ,RCT,ZZ1)
	2313	"RTN","RCD PEAA2",116 ,0)
	2314	Q
	2315	"RTN","RCD PEAA2",117 ,0)
	2316	;
	2317	"RTN","RCD PEAA2",118 ,0)
	2318	REVLINES(R CSCR,RCZZ0 ,RCT,ZZ1) ;called fr om BLD; se t up the r eviewed li nes
	2319	"RTN","RCD PEAA2",119 ,0)
	2320	;
	2321	"RTN","RCD PEAA2",120 ,0)
	2322	; Inpu t - RCSCR = ien of 3 44.49 (and 344.4)
	2323	"RTN","RCD PEAA2",121 ,0)
	2324	; RCZZ0 = zero nod e data at 344.491
	2325	"RTN","RCD PEAA2",122 ,0)
	2326	; RCT = sub line #
	2327	"RTN","RCD PEAA2",123 ,0)
	2328	; ZZ1 = referenc e to the t o the subl ine in
	2329	"RTN","RCD PEAA2",124 ,0)
	2330	; file 344 .49 for RC SEQ having a decimal
	2331	"RTN","RCD PEAA2",125 ,0)
	2332	N A,A0,B, B0
	2333	"RTN","RCD PEAA2",126 ,0)
	2334	S A=$J("" ,10)_"REVI EW STATUS: ("_$S($P( RCZZ0,U,11 )="I":"REV IEW IN PRO CESS",$P(R CZZ0,U,11) =1:"REVIEW ED",1:"NOT REVIEWED" )
	2335	"RTN","RCD PEAA2",127 ,0)
	2336	I $P(RCZZ 0,U,12) S A=A_" SE T BY: "_$E ($P($G(^VA (200,$P(RC ZZ0,U,12), 0)),U),1,2 0)
	2337	"RTN","RCD PEAA2",128 ,0)
	2338	D SET(A_" )",+$P(RCZ Z0,U),RCT, ZZ1)
	2339	"RTN","RCD PEAA2",129 ,0)
	2340	S A=0 F S A=$O(^RC Y(344.49,R CSCR,1,ZZ1 ,4,A)) Q:' A S A0=$G (^(A,0)) D
	2341	"RTN","RCD PEAA2",130 ,0)
	2342	. D SET($ J("",12)_$ $FMTE^XLFD T($P(A0,U) ,2)_" "_$ P($G(^VA(2 00,+$P(A0, U,2),0)),U )_$S($P(A0 ,U,4):" L AST EDIT: "_$$FMTE^X LFDT($P(A0 ,U,4),2),1 :""),$P(RC ZZ0,U),RCT ,ZZ1)
	2343	"RTN","RCD PEAA2",131 ,0)
	2344	. S B=0 F S B=$O(^ RCY(344.49 ,RCSCR,1,Z Z1,4,A,1,B )) Q:'B S B0=$G(^(B ,0)) D
	2345	"RTN","RCD PEAA2",132 ,0)
	2346	. . I $L( B0)>64 D S ET($J("",1 5)_$E(B0,1 ,64),$P(RC ZZ0,U),RCT ,ZZ1) S B0 =" "_$E(B 0,65,$L(B0 )) ; Split line if > 64 charac ters in co mment line
	2347	"RTN","RCD PEAA2",133 ,0)
	2348	. . D SET ($J("",15) _B0,$P(RCZ Z0,U),RCT, ZZ1)
	2349	"RTN","RCD PEAA2",134 ,0)
	2350	Q
	2351	"RTN","RCD PEAA2",135 ,0)
	2352	;
	2353	"RTN","RCD PEAA2",136 ,0)
	2354	ADJLINES(R CZZ0,RCT,Z Z1) ; call ed from BL D; set up the adjus tment line s
	2355	"RTN","RCD PEAA2",137 ,0)
	2356	;
	2357	"RTN","RCD PEAA2",138 ,0)
	2358	; Input - RCZZ0 = zero nod e data at 344.491
	2359	"RTN","RCD PEAA2",139 ,0)
	2360	; RCT = sub line #
	2361	"RTN","RCD PEAA2",140 ,0)
	2362	; ZZ1 = referenc e to the t o the subl ine in
	2363	"RTN","RCD PEAA2",141 ,0)
	2364	; file 344 .49 for RC SEQ having a decimal
	2365	"RTN","RCD PEAA2",142 ,0)
	2366	N RCAZ,RC AZ0,Z3
	2367	"RTN","RCD PEAA2",143 ,0)
	2368	S Z3=""
	2369	"RTN","RCD PEAA2",144 ,0)
	2370	D SET($J( "",4+RCTL) _"ADJUSTME NTS:",$P(R CZZ0,U),RC T,ZZ1)
	2371	"RTN","RCD PEAA2",145 ,0)
	2372	S RCAZ=0 F S RCAZ= $O(^RCY(34 4.49,RCSCR ,1,ZZ1,1,R CAZ)) Q:'R CAZ S RCA Z0=$G(^(RC AZ,0)) D
	2373	"RTN","RCD PEAA2",146 ,0)
	2374	. S Z3=$J ("",6+RCTL )_+RCAZ0_" . ",Q=$L( Z3)
	2375	"RTN","RCD PEAA2",147 ,0)
	2376	. I $P(RC AZ0,U,2)=0 S Z3=Z3_" Distribute d adj dec for retrac tion "_$P( RCAZ0,U,4) _": "_$P(R CAZ0,U,3)
	2377	"RTN","RCD PEAA2",148 ,0)
	2378	. I $P(RC AZ0,U,2)=1 S Z3=Z3_" Adjustment distribut ion to bal ance recei pt: "_$P(R CAZ0,U,3)
	2379	"RTN","RCD PEAA2",149 ,0)
	2380	. I $P(RC AZ0,U,2)=2 !($P(RCAZ0 ,U,2)=4) D
	2381	"RTN","RCD PEAA2",150 ,0)
	2382	. . S Z3= Z3_"ERA pa yment adju sted from "_$J($P(RC ZZ0,U,5)-$ P(RCZZ0,U, 6),"",2)_" to "_$J(+ $P(RCZZ0,U ,5),"",2)_ " NET: "_ $J($P(RCZZ 0,U,5)+$P( RCAZ0,U,3) ,"",2)
	2383	"RTN","RCD PEAA2",151 ,0)
	2384	. I $P(RC AZ0,U,2)=5 S Z3=Z3_" Non-specif ic payment (ref# "_$ P(RCAZ0,U, 4)_"): "_$ P(RCAZ0,U, 3)
	2385	"RTN","RCD PEAA2",152 ,0)
	2386	. I $P(RC AZ0,U,2)=3 S Z3=Z3_" Non-specif ic retract ion (ref# "_$P(RCAZ0 ,U,4)_"): "_$P(RCAZ0 ,U,3)
	2387	"RTN","RCD PEAA2",153 ,0)
	2388	. D SET(Z 3,$P(RCZZ0 ,U),RCT,ZZ 1)
	2389	"RTN","RCD PEAA2",154 ,0)
	2390	. I $P(RC AZ0,U,9)'= "" D SET($ J("",Q)_$P (RCAZ0,U,9 ),$P(RCZZ0 ,U),RCT,ZZ 1)
	2391	"RTN","RCD PEAA2",155 ,0)
	2392	Q
	2393	"RTN","RCD PEAA2",156 ,0)
	2394	;
	2395	"RTN","RCD PEAA2",157 ,0)
	2396	;
	2397	"RTN","RCD PEAA2",158 ,0)
	2398	RXLINES(RC ZZ0,RCECME ,RCT,ZZ1) ; called f rom BLD ; set up the Pharmacy lines
	2399	"RTN","RCD PEAA2",159 ,0)
	2400	;
	2401	"RTN","RCD PEAA2",160 ,0)
	2402	; Input - RCZZ0 = zero n ode data a t 344.491
	2403	"RTN","RCD PEAA2",161 ,0)
	2404	; RCECME = ECME # for Pharm acy claims
	2405	"RTN","RCD PEAA2",162 ,0)
	2406	; RCT = sub li ne #
	2407	"RTN","RCD PEAA2",163 ,0)
	2408	; ZZ1 = refere nce to the to the su bline in
	2409	"RTN","RCD PEAA2",164 ,0)
	2410	; file 3 44.49 for RCSEQ havi ng a decim al
	2411	"RTN","RCD PEAA2",165 ,0)
	2412	N RXARRAY
	2413	"RTN","RCD PEAA2",166 ,0)
	2414	D GETPHAR M^RCDPEWLP ($P(RCZZ0, U,7),.RXAR RAY)
	2415	"RTN","RCD PEAA2",167 ,0)
	2416	D SET($J( "",9)_"ECM E #: "_RCE CME,$P(RCZ Z0,U),RCT, ZZ1)
	2417	"RTN","RCD PEAA2",168 ,0)
	2418	I '$D(RXA RRAY) D SE T($J("",9) _" Pharmac y data doe s not exis t for this claim",$P (RCZZ0,U), RCT,ZZ1) Q
	2419	"RTN","RCD PEAA2",169 ,0)
	2420	D SET($J( "",9)_"Rx/ Fill/Relea se Status: "_RXARRAY ("RX")_"/" _RXARRAY(" FILL")_"/" _RXARRAY(" RELEASED S TATUS"),$P (RCZZ0,U), RCT,ZZ1)
	2421	"RTN","RCD PEAA2",170 ,0)
	2422	D SET($J( "",9)_"DOS : "_RXARRA Y("DOS"),$ P(RCZZ0,U) ,RCT,ZZ1)
	2423	"RTN","RCD PEAA2",171 ,0)
	2424	Q
	2425	"RTN","RCD PEAA2",172 ,0)
	2426	;
	2427	"RTN","RCD PEAA2",173 ,0)
	2428	HDR ; Crea tes header lines for the selec ted EEOB d isplay
	2429	"RTN","RCD PEAA2",174 ,0)
	2430	N RC0,RC4 ,RC5,Z,RCD A,RCSEQ
	2431	"RTN","RCD PEAA2",175 ,0)
	2432	I '$G(RCI ENS) S VAL MQUIT=1 Q
	2433	"RTN","RCD PEAA2",176 ,0)
	2434	S RCDA=$P (RCIENS,U) ,RCSEQ=$P( RCIENS,U,3 )
	2435	"RTN","RCD PEAA2",177 ,0)
	2436	S RC0=$G( ^RCY(344.4 ,RCDA,0)), RC4=$G(^RC Y(344.4,RC DA,4)),RC5 =$G(^RCY(3 44.4,RCDA, 5))
	2437	"RTN","RCD PEAA2",178 ,0)
	2438	S VALMHDR (1)=$E("ER A Entry #: "_$P(RC0, U)_$J("",3 1),1,31)_" Total Amt Pd: "_$J(+ $P(RC0,U,5 ),"",2)
	2439	"RTN","RCD PEAA2",179 ,0)
	2440	I +RCSEQ S VALMHDR( 2)=$E("Pos ted Amt: " _$J($P(^TM P("RCDPE-A PAR_EEOB_W LDX",$J,RC SEQ),U,5), "",2)_$J(" ",31),1,31 )
	2441	"RTN","RCD PEAA2",180 ,0)
	2442	S VALMHDR (2)=$G(VAL MHDR(2))_" Un-posted balance: " _$J($P(^TM P("RCDPE-A PAR_EEOB_W LDX",$J,RC SEQ),U,4), "",2)
	2443	"RTN","RCD PEAA2",181 ,0)
	2444	S VALMHDR (3)="Payer Name/ID: "_$P(RC0,U ,6)_"/"_$P (RC0,U,3)
	2445	"RTN","RCD PEAA2",182 ,0)
	2446	S Z=+$O(^ RCY(344.31 ,"AERA",RC DA,0))
	2447	"RTN","RCD PEAA2",183 ,0)
	2448	I Z S VAL MHDR(4)="E FT #/TRACE #: "_$P($ G(^RCY(344 .3,+$G(^RC Y(344.31,Z ,0)),0)),U )_"/"_$P(R C0,U,2)
	2449	"RTN","RCD PEAA2",184 ,0)
	2450	I 'Z,$P(R C5,U,2)'=" " S VALMHD R(4)="PAPE R CHECK #: "_$P(RC5, U,2)
	2451	"RTN","RCD PEAA2",185 ,0)
	2452	S VALMHDR (5)="Poste d Receipt #(s): "_$$ RCPTS(RCDA ,RC0)
	2453	"RTN","RCD PEAA2",186 ,0)
	2454	Q
	2455	"RTN","RCD PEAA2",187 ,0)
	2456	;
	2457	"RTN","RCD PEAA2",188 ,0)
	2458	RCPTS(RCDA ,RC0) ; pu ll list of 'other re ceipt #s
	2459	"RTN","RCD PEAA2",189 ,0)
	2460	; input - RCDA = ien of en try in 344 .4
	2461	"RTN","RCD PEAA2",190 ,0)
	2462	; RC0 = data stri ng at zero node of e ntry in 34 4.4
	2463	"RTN","RCD PEAA2",191 ,0)
	2464	; output - RCPTS = returns l ist of rec eipts stor ed at 344. 4,.08 and 344.48 mul tiple
	2465	"RTN","RCD PEAA2",192 ,0)
	2466	N X,RIEN, RCPTS
	2467	"RTN","RCD PEAA2",193 ,0)
	2468	S X=0
	2469	"RTN","RCD PEAA2",194 ,0)
	2470	S RCPTS=$ P($G(^RCY( 344,+$P(RC 0,U,8),0)) ,U)
	2471	"RTN","RCD PEAA2",195 ,0)
	2472	I RCPTS=" " G RCPTSQ ; receip t not post ed to any of EEOB it ems
	2473	"RTN","RCD PEAA2",196 ,0)
	2474	S RCPTS=R CPTS_","
	2475	"RTN","RCD PEAA2",197 ,0)
	2476	F S X=$O (^RCY(344. 4,RCDA,8,X )) Q:'X S RIEN=+^(X ,0) S RCPT S=RCPTS_$P ($G(^RCY(3 44,RIEN,0) ),U)_","
	2477	"RTN","RCD PEAA2",198 ,0)
	2478	S RCPTS=$ $TRIM^XLFS TR(RCPTS," R",",") ; remove or phan comma from last receipt n umber
	2479	"RTN","RCD PEAA2",199 ,0)
	2480	RCPTSQ ;
	2481	"RTN","RCD PEAA2",200 ,0)
	2482	Q RCPTS
	2483	"RTN","RCD PEAA2",201 ,0)
	2484	;
	2485	"RTN","RCD PEAA2",202 ,0)
	2486	EXIT ; -- Clean up l ist
	2487	"RTN","RCD PEAA2",203 ,0)
	2488	K RCFASTX T
	2489	"RTN","RCD PEAA2",204 ,0)
	2490	Q
	2491	"RTN","RCD PEAA2",205 ,0)
	2492	;
	2493	"RTN","RCD PEAA2",206 ,0)
	2494	PNM4(RCIFN ,RCDA,RC) ; Returns either the patient n ame or pat ient name/ last 4
	2495	"RTN","RCD PEAA2",207 ,0)
	2496	; RCIFN = ien of fi le 344.4
	2497	"RTN","RCD PEAA2",208 ,0)
	2498	; RCDA = ien of fil e 344.41
	2499	"RTN","RCD PEAA2",209 ,0)
	2500	; RC = th e ien of f ile 430
	2501	"RTN","RCD PEAA2",210 ,0)
	2502	N Z,Z0,Q
	2503	"RTN","RCD PEAA2",211 ,0)
	2504	S Z=""
	2505	"RTN","RCD PEAA2",212 ,0)
	2506	I $G(RCIF N)'="" D
	2507	"RTN","RCD PEAA2",213 ,0)
	2508	. S Z0=$G (^RCY(344. 4,RCIFN,1, RCDA,0)),Z =""
	2509	"RTN","RCD PEAA2",214 ,0)
	2510	. I $P(Z0 ,U,2) S Q= +$P($G(^DG CR(399,+$G (^IBM(361. 1,+$P(Z0,U ,2),0)),0) ),U,2),Z=$ P($G(^DPT( Q,0)),U)_" /"_$E($P($ G(^(0)),U, 9),6,9) ; IA 4051
	2511	"RTN","RCD PEAA2",215 ,0)
	2512	. I $TR(Z ,"/")="" S Z=$P(Z0,U ,15)
	2513	"RTN","RCD PEAA2",216 ,0)
	2514	I $G(RC)' ="" D
	2515	"RTN","RCD PEAA2",217 ,0)
	2516	. S Q=+$P ($G(^PRCA( 430,RC,0)) ,U,7)
	2517	"RTN","RCD PEAA2",218 ,0)
	2518	. I Q S Z =$P($G(^DP T(Q,0)),U) _"/"_$E($P ($G(^(0)), U,9),6,9)
	2519	"RTN","RCD PEAA2",219 ,0)
	2520	Q Z
	2521	"RTN","RCD PEAA2",220 ,0)
	2522	;
	2523	"RTN","RCD PEAA2",221 ,0)
	2524	COBN(RC,A) ; Return seq # of s elected pa yer
	2525	"RTN","RCD PEAA2",222 ,0)
	2526	; A = 'PS T' or null to get cu rrent bill payer seq #
	2527	"RTN","RCD PEAA2",223 ,0)
	2528	I $G(A)=" " S A=$P($ G(^DGCR(39 9,RC,0)),U ,21) S:A=" " A="P" S: "PST"'[A A ="P"
	2529	"RTN","RCD PEAA2",224 ,0)
	2530	I 'A S A= $F("PST",A )-1 S:A<1 A=1
	2531	"RTN","RCD PEAA2",225 ,0)
	2532	Q A
	2533	"RTN","RCD PEAA2",226 ,0)
	2534	;
	2535	"RTN","RCD PEAA2",227 ,0)
	2536	COPAY(RCIF N) ; Returns 1 if any no t cancelle d 1st part y bills ex ist for
	2537	"RTN","RCD PEAA2",228 ,0)
	2538	; a 3rd p arty bill or any bil ls related to this 3 rd party b ill
	2539	"RTN","RCD PEAA2",229 ,0)
	2540	; RCIFN = the 3rd p arty bill #
	2541	"RTN","RCD PEAA2",230 ,0)
	2542	N FIRST,R CTP0,RCTP1 ,RCTP2
	2543	"RTN","RCD PEAA2",231 ,0)
	2544	K ^TMP("I BRBF",$J), ^TMP($J,"I BRBF")
	2545	"RTN","RCD PEAA2",232 ,0)
	2546	D RELBILL ^IBRFN(RCI FN) ; DBIA 3124
	2547	"RTN","RCD PEAA2",233 ,0)
	2548	S RCTP0=0 F S RCTP 0=$O(^TMP( "IBRBF",$J ,RCIFN,RCT P0)) Q:RCT P0="" S R CTP1=$G(^( RCTP0)) D
	2549	"RTN","RCD PEAA2",234 ,0)
	2550	. I $P(RC TP1,U,3) K ^TMP("IBR BF",$J,RCI FN,RCTP0) Q ; IB ca ncelled
	2551	"RTN","RCD PEAA2",235 ,0)
	2552	. S RCTP2 =$O(^PRCA( 430,"B",+$ P(RCTP1,U, 4),0)) I $ P($G(^PRCA (430,+RCTP 2,0)),U,8) =39 K ^TMP ("IBRBF",$ J,RCIFN,RC TP0) ; AR cancelled
	2553	"RTN","RCD PEAA2",236 ,0)
	2554	S FIRST=$ S($O(^TMP( "IBRBF",$J ,RCIFN,0)) :1,1:0)
	2555	"RTN","RCD PEAA2",237 ,0)
	2556	K ^TMP("I BRBF",$J), ^TMP($J,"I BRBF")
	2557	"RTN","RCD PEAA2",238 ,0)
	2558	Q FIRST
	2559	"RTN","RCD PEAA2",239 ,0)
	2560	;
	2561	"RTN","RCD PEAA2",240 ,0)
	2562	MARK(RCIEN S) ;EP - P rotocol ac tion - RCD PE MARK FO R AUTO POS T
	2563	"RTN","RCD PEAA2",241 ,0)
	2564	; Mark fo r Auto-Pos t - EEOB o n APAR get s marked f or auto-po st if it p asses
	2565	"RTN","RCD PEAA2",242 ,0)
	2566	; autopos ting valid ation
	2567	"RTN","RCD PEAA2",243 ,0)
	2568	; Input: RCIENS - Internal IEN of en try in fil e 344.49^i en of
	2569	"RTN","RCD PEAA2",244 ,0)
	2570	; 344.491^ selectable line item from list man screen
	2571	"RTN","RCD PEAA2",245 ,0)
	2572	;
	2573	"RTN","RCD PEAA2",246 ,0)
	2574	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	2575	"RTN","RCD PEAA2",247 ,0)
	2576	. D FULL^ VALM1
	2577	"RTN","RCD PEAA2",248 ,0)
	2578	. S VALMB CK="R"
	2579	"RTN","RCD PEAA2",249 ,0)
	2580	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	2581	"RTN","RCD PEAA2",250 ,0)
	2582	. D PAUSE ^VALM1
	2583	"RTN","RCD PEAA2",251 ,0)
	2584	;
	2585	"RTN","RCD PEAA2",252 ,0)
	2586	N RESULT, REASON,LIN E,DIR,X,Y, RCERROR,XX ,ERADA1,RC DFDA
	2587	"RTN","RCD PEAA2",253 ,0)
	2588	S:$G(RCIE NS)="" RCI ENS=+$$SEL ^RCDPEAA1( )
	2589	"RTN","RCD PEAA2",254 ,0)
	2590	Q:'RCIENS
	2591	"RTN","RCD PEAA2",255 ,0)
	2592	I '$$VALI D^RCDPEAP( $P(RCIENS, U),$P(RCIE NS,U,2),.R ESULT) D G MARKQ
	2593	"RTN","RCD PEAA2",256 ,0)
	2594	. S LINE= $O(RESULT( ""))
	2595	"RTN","RCD PEAA2",257 ,0)
	2596	. S REASO N=$TR(RESU LT(LINE),U ,"-")
	2597	"RTN","RCD PEAA2",258 ,0)
	2598	. S DIR(0 )="EA",DIR ("A",1)="E EOB cannot be marked for Auto- Post for t he followi ng reason: "
	2599	"RTN","RCD PEAA2",259 ,0)
	2600	. S DIR(" A",2)=REAS ON
	2601	"RTN","RCD PEAA2",260 ,0)
	2602	. S DIR(" A")="PRESS RETURN TO CONTINUE "
	2603	"RTN","RCD PEAA2",261 ,0)
	2604	. W ! D ^ DIR K DIR W !
	2605	"RTN","RCD PEAA2",262 ,0)
	2606	; EEOB pa ssed valid ation; rea dy for Aut opost
	2607	"RTN","RCD PEAA2",263 ,0)
	2608	L +^RCY(3 44.4,$P(RC IENS,U),0) :5 I '$T D NOLOCK G MARKQ
	2609	"RTN","RCD PEAA2",264 ,0)
	2610	S ERADA1= $P($G(^RCY (344.49,$P (RCIENS,U) ,1,$P(RCIE NS,U,2),0) ),U,9) ; get 344.41 ien (344. 491,.09)
	2611	"RTN","RCD PEAA2",265 ,0)
	2612	S RCDFDA( 344.41,ERA DA1_","_$P (RCIENS,U) _",",6)=1
	2613	"RTN","RCD PEAA2",266 ,0)
	2614	D FILE^DI E("","RCDF DA")
	2615	"RTN","RCD PEAA2",267 ,0)
	2616	S DIR(0)= "EA",DIR(" A",1)=$P(R CIENS,U)_" ."_ERADA1_ " has been marked fo r auto-pos t and has been remov ed from th e APAR Lis t."
	2617	"RTN","RCD PEAA2",268 ,0)
	2618	S DIR("A" )="PRESS R ETURN TO C ONTINUE "
	2619	"RTN","RCD PEAA2",269 ,0)
	2620	W ! D ^DI R K DIR W !
	2621	"RTN","RCD PEAA2",270 ,0)
	2622	L -^RCY(3 44.4,$P(RC IENS,U),0)
	2623	"RTN","RCD PEAA2",271 ,0)
	2624	MARKQ ;
	2625	"RTN","RCD PEAA2",272 ,0)
	2626	Q
	2627	"RTN","RCD PEAA2",273 ,0)
	2628	;
	2629	"RTN","RCD PEAA2",274 ,0)
	2630	NOLOCK ; e ntry canno t be locke d
	2631	"RTN","RCD PEAA2",275 ,0)
	2632	N DIR
	2633	"RTN","RCD PEAA2",276 ,0)
	2634	S DIR(0)= "EA"
	2635	"RTN","RCD PEAA2",277 ,0)
	2636	S DIR("A" ,1)="Sorry , another user is ed iting this ERA entry ."
	2637	"RTN","RCD PEAA2",278 ,0)
	2638	S DIR("A" ,2)="Try a gain later ."
	2639	"RTN","RCD PEAA2",279 ,0)
	2640	S DIR("A" ,3)=""
	2641	"RTN","RCD PEAA2",280 ,0)
	2642	S DIR("A" )="PRESS E NTER TO CO NTINUE "
	2643	"RTN","RCD PEAA2",281 ,0)
	2644	D ^DIR
	2645	"RTN","RCD PEAA2",282 ,0)
	2646	Q
	2647	"RTN","RCD PEAA2",283 ,0)
	2648	;
	2649	"RTN","RCD PEAA2",284 ,0)
	2650	VIEWERA(RC IENS) ; Vi ew/Print E RA - proto col entry from APAR EEOB List screen and APAR - EE OB ITEM - SCRATCHPAD screen
	2651	"RTN","RCD PEAA2",285 ,0)
	2652	N RCSCR
	2653	"RTN","RCD PEAA2",286 ,0)
	2654	I RCPROG= "RCDPEAA2" S RCSCR=$ P(RCIENS,U )
	2655	"RTN","RCD PEAA2",287 ,0)
	2656	I RCPROG= "RCDPEAA1" S RCSCR=+ $$SEL^RCDP EAA1()
	2657	"RTN","RCD PEAA2",288 ,0)
	2658	I RCSCR>0 D PRERA^R CDPEWL0
	2659	"RTN","RCD PEAA2",289 ,0)
	2660	Q
	2661	"RTN","RCD PEAA3")
	2662	0^24^B1033 51099^B917 78928
	2663	"RTN","RCD PEAA3",1,0 )
	2664	RCDPEAA3 ; ALB/KML - APAR Scree n - callab le entry p oints ;Nov 24, 2014@ 23:32:24
	2665	"RTN","RCD PEAA3",2,0 )
	2666	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	2667	"RTN","RCD PEAA3",3,0 )
	2668	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2669	"RTN","RCD PEAA3",4,0 )
	2670	Q
	2671	"RTN","RCD PEAA3",5,0 )
	2672	;
	2673	"RTN","RCD PEAA3",6,0 )
	2674	SPLIT(RCIE NS) ;EP - Protocol a ction - RC DPE APAR S PLINE LINE
	2675	"RTN","RCD PEAA3",7,0 )
	2676	; Split E EOB in APA R
	2677	"RTN","RCD PEAA3",8,0 )
	2678	; Input: RCIENS - Internal IEN of en try in fil e 344.49^i en of
	2679	"RTN","RCD PEAA3",9,0 )
	2680	; 344.491^ selectable line item from list man screen
	2681	"RTN","RCD PEAA3",10, 0)
	2682	N DIR,L,R CQUIT,X
	2683	"RTN","RCD PEAA3",11, 0)
	2684	S RCQUIT= 0
	2685	"RTN","RCD PEAA3",12, 0)
	2686	D FULL^VA LM1
	2687	"RTN","RCD PEAA3",13, 0)
	2688	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	2689	"RTN","RCD PEAA3",14, 0)
	2690	. S VALMB CK="R"
	2691	"RTN","RCD PEAA3",15, 0)
	2692	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	2693	"RTN","RCD PEAA3",16, 0)
	2694	. D PAUSE ^VALM1
	2695	"RTN","RCD PEAA3",17, 0)
	2696	S L=0 F S L=$O(^RC Y(344.49,$ P(RCIENS,U ),1,$P(RCI ENS,U,2),1 ,L)) Q:'L D
	2697	"RTN","RCD PEAA3",18, 0)
	2698	. I "01"[ $P($G(^(L, 0)),U,2) S DIR(0)="E A",DIR("A" ,1)="THIS EEOB IS NO T AVAILABL E TO EDIT/ SPLIT",DIR ("A")="PRE SS RETURN TO CONTINU E " W ! D ^DIR K DIR G SPLITQ
	2699	"RTN","RCD PEAA3",19, 0)
	2700	I $P($G(^ RCY(344.49 ,$P(RCIENS ,U),1,$P(R CIENS,U,2) ,0)),U,13) D G:RCQU IT SPLITQ
	2701	"RTN","RCD PEAA3",20, 0)
	2702	. S DIR(" A",1)="WAR NING! THI S LINE HAS ALREADY B EEN VERIFI ED",DIR("A ")="ARE YO U SURE YOU WANT TO C ONTINUE?: ",DIR(0)=" YA",DIR("B ")="NO" W ! D ^DIR K DIR
	2703	"RTN","RCD PEAA3",21, 0)
	2704	. I Y'=1 S RCQUIT=1
	2705	"RTN","RCD PEAA3",22, 0)
	2706	K ^TMP("R CDPE_SPLIT _REBLD",$J )
	2707	"RTN","RCD PEAA3",23, 0)
	2708	S X=+$O(^ TMP("RCDPE -EOB_WLDX" ,$J,""),-1 )
	2709	"RTN","RCD PEAA3",24, 0)
	2710	D SPLIT^R CDPEWL3($P (RCIENS,U) ,X)
	2711	"RTN","RCD PEAA3",25, 0)
	2712	I $G(^TMP ("RCDPE_SP LIT_REBLD" ,$J)) K ^T MP("RCDPE_ SPLIT_REBL D",$J) D I NIT^RCDPEA A2(RCIENS)
	2713	"RTN","RCD PEAA3",26, 0)
	2714	;
	2715	"RTN","RCD PEAA3",27, 0)
	2716	SPLITQ S V ALMBCK="R"
	2717	"RTN","RCD PEAA3",28, 0)
	2718	Q
	2719	"RTN","RCD PEAA3",29, 0)
	2720	;
	2721	"RTN","RCD PEAA3",30, 0)
	2722	REFRESH(RC IENS) ;EP - Protocol action - RCDPE APAR EEOB REFR ESH
	2723	"RTN","RCD PEAA3",31, 0)
	2724	; Refresh the entry in file 3 44.49 to r emove all user adjus tments
	2725	"RTN","RCD PEAA3",32, 0)
	2726	; Input: RCIENS - Internal IEN of en try in fil e 344.49^i en of
	2727	"RTN","RCD PEAA3",33, 0)
	2728	; 344.491^ selectable line item from list man screen
	2729	"RTN","RCD PEAA3",34, 0)
	2730	N DA,DIK, DIR,X,Y,Z, Z0
	2731	"RTN","RCD PEAA3",35, 0)
	2732	D FULL^VA LM1
	2733	"RTN","RCD PEAA3",36, 0)
	2734	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	2735	"RTN","RCD PEAA3",37, 0)
	2736	. S VALMB CK="R"
	2737	"RTN","RCD PEAA3",38, 0)
	2738	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	2739	"RTN","RCD PEAA3",39, 0)
	2740	. D PAUSE ^VALM1
	2741	"RTN","RCD PEAA3",40, 0)
	2742	;
	2743	"RTN","RCD PEAA3",41, 0)
	2744	S DIR(0)= "YA"
	2745	"RTN","RCD PEAA3",42, 0)
	2746	S DIR("A" ,1)="THIS ACTION WIL L DELETE A ND REBUILD THIS EEOB WORKLIST SCRATCH PA D ENTRY",D IR("A",2)= "ALL EDITS /SPLITS/DI STRIBUTE A DJUSTMENTS ENTERED F OR THIS ER A WILL BE ERASED"
	2747	"RTN","RCD PEAA3",43, 0)
	2748	S DIR("A" ,3)="AND A LL ENTRIES MARKED AS MANUALLY VERIFIED W ILL BE UNM ARKED",DIR ("A",4)=" "
	2749	"RTN","RCD PEAA3",44, 0)
	2750	S DIR("A" )="ARE YOU SURE YOU WANT TO DO THIS?: "
	2751	"RTN","RCD PEAA3",45, 0)
	2752	W ! D ^DI R K DIR
	2753	"RTN","RCD PEAA3",46, 0)
	2754	I Y'=1 G REFQ
	2755	"RTN","RCD PEAA3",47, 0)
	2756	D ADDLINE S^RCDPEWLA ($P(RCIENS ,U))
	2757	"RTN","RCD PEAA3",48, 0)
	2758	D INIT^RC DPEAA2(RCI ENS)
	2759	"RTN","RCD PEAA3",49, 0)
	2760	REFQ S VAL MBG=1,VALM BCK="R"
	2761	"RTN","RCD PEAA3",50, 0)
	2762	Q
	2763	"RTN","RCD PEAA3",51, 0)
	2764	;
	2765	"RTN","RCD PEAA3",52, 0)
	2766	RESEARCH ; Invoke th e research menu off APAR
	2767	"RTN","RCD PEAA3",53, 0)
	2768	;
	2769	"RTN","RCD PEAA3",54, 0)
	2770	K ^TMP($J ,"RC_VALMB G")
	2771	"RTN","RCD PEAA3",55, 0)
	2772	S ^TMP($J ,"RC_VALMB G")=$G(VAL MBG)
	2773	"RTN","RCD PEAA3",56, 0)
	2774	D FULL^VA LM1
	2775	"RTN","RCD PEAA3",57, 0)
	2776	D EN^VALM ("RCDPE AP AR EEOB RE SEARCH")
	2777	"RTN","RCD PEAA3",58, 0)
	2778	RQ K ^TMP( $J,"RC_VAL MBG")
	2779	"RTN","RCD PEAA3",59, 0)
	2780	Q
	2781	"RTN","RCD PEAA3",60, 0)
	2782	;
	2783	"RTN","RCD PEAA3",61, 0)
	2784	VRECPT(RCI ENS) ;
	2785	"RTN","RCD PEAA3",62, 0)
	2786	;
	2787	"RTN","RCD PEAA3",63, 0)
	2788	; Inpu t - RCIENS = ien of entry in f ile 344.49 ^ien of 34 4.491^sele ctable lin e item fro m listman screen
	2789	"RTN","RCD PEAA3",64, 0)
	2790	;
	2791	"RTN","RCD PEAA3",65, 0)
	2792	D VR^RCDP EWLP($P(RC IENS,U))
	2793	"RTN","RCD PEAA3",66, 0)
	2794	Q
	2795	"RTN","RCD PEAA3",67, 0)
	2796	REVIEW(RCI ENS) ; Ent er review informatio n on workl ist and tu rn review display on /off
	2797	"RTN","RCD PEAA3",68, 0)
	2798	;
	2799	"RTN","RCD PEAA3",69, 0)
	2800	; Inpu t - RCIENS = ien of entry in f ile 344.49 ^ien of 34 4.491^sele ctable lin e item fro m listman screen
	2801	"RTN","RCD PEAA3",70, 0)
	2802	;
	2803	"RTN","RCD PEAA3",71, 0)
	2804	;
	2805	"RTN","RCD PEAA3",72, 0)
	2806	N Z,RC,RC DA,RCZ,DIC ,DA,DIE,DR ,X,Y,DIR,R EVCHG,RCUS PREF,RCLST REV,RCREV
	2807	"RTN","RCD PEAA3",73, 0)
	2808	D FULL^VA LM1
	2809	"RTN","RCD PEAA3",74, 0)
	2810	;
	2811	"RTN","RCD PEAA3",75, 0)
	2812	S REVCHG= ""
	2813	"RTN","RCD PEAA3",76, 0)
	2814	S DIR(0)= "YA",RC=+$ G(^TMP($J, "RC_REVIEW "))
	2815	"RTN","RCD PEAA3",77, 0)
	2816	S DIR("A" ,1)="REVIE W DATA DIS PLAY IS CU RRENTLY TU RNED "_$P( "OFF^ON",U ,RC+1),DIR ("A")="DO YOU WANT T O TURN IT "_$P("ON^O FF",U,RC+1 )_"?: ",DI R("B")=$S( 'RC:"YES", 1:"NO") W ! D ^DIR K DIR
	2817	"RTN","RCD PEAA3",78, 0)
	2818	I Y=1 S ^ TMP($J,"RC _REVIEW")= ((RC+1)#2) ,REVCHG=1
	2819	"RTN","RCD PEAA3",79, 0)
	2820	S RCUSPRE F=+$O(^RCY (344.49,$P (RCIENS,U) ,2,"B",DUZ ,0))
	2821	"RTN","RCD PEAA3",80, 0)
	2822	;
	2823	"RTN","RCD PEAA3",81, 0)
	2824	I 'RCUSPR EF D ; Ad d the user pref reco rd
	2825	"RTN","RCD PEAA3",82, 0)
	2826	. S RCUSP REF=+$$ADD USER($P(RC IENS,U),DU Z)
	2827	"RTN","RCD PEAA3",83, 0)
	2828	S RCLSTRE V=+$P($G(^ RCY(344.49 ,$P(RCIENS ,U),2,RCUS PREF,0)),U ,2)
	2829	"RTN","RCD PEAA3",84, 0)
	2830	S DA(1)=$ P(RCIENS,U ),DA=RCUSP REF
	2831	"RTN","RCD PEAA3",85, 0)
	2832	I DA,RCLS TREV'=$G(^ TMP($J,"RC _REVIEW")) D ; Upda te user pr ef
	2833	"RTN","RCD PEAA3",86, 0)
	2834	. S DIE=" ^RCY(344.4 9,"_DA(1)_ ",2,",DR=" .02////"_+ $G(^TMP($J ,"RC_REVIE W")) D ^DI E
	2835	"RTN","RCD PEAA3",87, 0)
	2836	W !
	2837	"RTN","RCD PEAA3",88, 0)
	2838	I '$G(^TM P($J,"RC_R EVIEW")) G REVIEWQ
	2839	"RTN","RCD PEAA3",89, 0)
	2840	;
	2841	"RTN","RCD PEAA3",90, 0)
	2842	D SEL^RCD PEWL(.RCDA )
	2843	"RTN","RCD PEAA3",91, 0)
	2844	S RCZ=+$O (RCDA(0)), RCZ=+$G(RC DA(RCZ)) G :'RCZ REVI EWQ
	2845	"RTN","RCD PEAA3",92, 0)
	2846	;
	2847	"RTN","RCD PEAA3",93, 0)
	2848	S RCREV=0
	2849	"RTN","RCD PEAA3",94, 0)
	2850	I '$O(^RC Y(344.49,$ P(RCIENS,U ),1,"AC",D UZ,RCZ,0)) D
	2851	"RTN","RCD PEAA3",95, 0)
	2852	. S RCREV =$$NEWREV( $P(RCIENS, U),RCZ,DUZ )
	2853	"RTN","RCD PEAA3",96, 0)
	2854	E D
	2855	"RTN","RCD PEAA3",97, 0)
	2856	. N DIR,X ,Y
	2857	"RTN","RCD PEAA3",98, 0)
	2858	. S DIR(" A")="(A)DD or (E)DIT A REVIEW COMMENT?: ",DIR("B") ="ADD",DIR (0)="SA^A: ADD;E:EDIT " W ! D ^D IR K DIR
	2859	"RTN","RCD PEAA3",99, 0)
	2860	. I $D(DU OUT)!$D(DT OUT) Q
	2861	"RTN","RCD PEAA3",100 ,0)
	2862	. ;
	2863	"RTN","RCD PEAA3",101 ,0)
	2864	. I Y="E" D Q ; E dit a revi ew entry e ntered by same user
	2865	"RTN","RCD PEAA3",102 ,0)
	2866	.. N DA,D R,DIE,X,Y
	2867	"RTN","RCD PEAA3",103 ,0)
	2868	.. S DA(1 )=$P(RCIEN S,U),DA=RC Z,DIC="^RC Y(344.49," _DA(1)_",1 ,"_DA_",4, ",DIC(0)=" AEMQ",DIC( "S")="I $P (^(0),U,2) =DUZ" D ^D IC
	2869	"RTN","RCD PEAA3",104 ,0)
	2870	.. S RCRE V=$S(Y>0:+ Y,1:0)
	2871	"RTN","RCD PEAA3",105 ,0)
	2872	.. I RCRE V S DA(2)= $P(RCIENS, U),DA(1)=R CZ,DA=RCRE V,DIE="^RC Y(344.49," _DA(2)_",1 ,"_DA(1)_" ,4,",DR=". 03;.04//// ^S X=$$NOW ^XLFDT()" D ^DIE
	2873	"RTN","RCD PEAA3",106 ,0)
	2874	. ;
	2875	"RTN","RCD PEAA3",107 ,0)
	2876	. S RCREV =$$NEWREV( $P(RCIENS, U),RCZ,DUZ )
	2877	"RTN","RCD PEAA3",108 ,0)
	2878	;
	2879	"RTN","RCD PEAA3",109 ,0)
	2880	I RCREV S DIE("NO^" )="",DA(1) =$P(RCIENS ,U),DA=RCZ ,DIE="^RCY (344.49,"_ DA(1)_",1, ",DR=".11R ;I X=0 S Y =""@10"";. 12////^S X =DUZ;S Y=" "@20"";@10 ;.12///@;@ 20" D ^DIE K DIE
	2881	"RTN","RCD PEAA3",110 ,0)
	2882	D INIT^RC DPEAA2(RCI ENS)
	2883	"RTN","RCD PEAA3",111 ,0)
	2884	S REVCHG= ""
	2885	"RTN","RCD PEAA3",112 ,0)
	2886	;
	2887	"RTN","RCD PEAA3",113 ,0)
	2888	REVIEWQ I $G(REVCHG) D INIT^RC DPEAA2(RCI ENS)
	2889	"RTN","RCD PEAA3",114 ,0)
	2890	S VALMBCK ="R"
	2891	"RTN","RCD PEAA3",115 ,0)
	2892	Q
	2893	"RTN","RCD PEAA3",116 ,0)
	2894	;
	2895	"RTN","RCD PEAA3",117 ,0)
	2896	NEWREV(RCS CR,RCZ,RCD UZ) ; Ente r a new re view comme nt
	2897	"RTN","RCD PEAA3",118 ,0)
	2898	; RCSCR = ien of en try in fil e 344.49
	2899	"RTN","RCD PEAA3",119 ,0)
	2900	; RCZ = i en of the EEOB (seq #)
	2901	"RTN","RCD PEAA3",120 ,0)
	2902	; RCDUZ = DUZ of use r entering the comme nt
	2903	"RTN","RCD PEAA3",121 ,0)
	2904	; Functio n returns 0 if no ne w comment, ien of co mment if a dded
	2905	"RTN","RCD PEAA3",122 ,0)
	2906	N DA,X,Y, DIC,DIK,DL AYGO,DO,DD ,RCREV,RCN OW
	2907	"RTN","RCD PEAA3",123 ,0)
	2908	S RCNOW=$ $NOW^XLFDT () W !!,"R EVIEW DATE /TIME: "_$ $FMTE^XLFD T(RCNOW,"2 ")
	2909	"RTN","RCD PEAA3",124 ,0)
	2910	S DA(2)=R CSCR,DA(1) =RCZ,X=RCN OW,DIC("DR ")=".02/// /"_RCDUZ_" ;.03",DLAY GO=344.492 ,DIC(0)="L "
	2911	"RTN","RCD PEAA3",125 ,0)
	2912	S DIC="^R CY(344.49, "_DA(2)_", 1,"_DA(1)_ ",4,"
	2913	"RTN","RCD PEAA3",126 ,0)
	2914	K DO,DD
	2915	"RTN","RCD PEAA3",127 ,0)
	2916	D FILE^DI CN K DO,DD ,DIC,DLAYG O
	2917	"RTN","RCD PEAA3",128 ,0)
	2918	S RCREV=+ Y
	2919	"RTN","RCD PEAA3",129 ,0)
	2920	I RCREV'> 0 S RCREV= 0 G NEWREV Q
	2921	"RTN","RCD PEAA3",130 ,0)
	2922	I '$O(^RC Y(344.49,D A(2),1,DA( 1),4,RCREV ,0)) S DIK ="^RCY(344 .49,"_DA(2 )_",1,"_DA (1)_",4,", DA=RCREV D ^DIK S RC REV=0 ; No comment - delete en try
	2923	"RTN","RCD PEAA3",131 ,0)
	2924	;
	2925	"RTN","RCD PEAA3",132 ,0)
	2926	NEWREVQ Q RCREV
	2927	"RTN","RCD PEAA3",133 ,0)
	2928	;
	2929	"RTN","RCD PEAA3",134 ,0)
	2930	ADDUSER(RC SCR,RCDUZ) ; Add use r record t o user pre ferences m ultiple in file 344. 49 and ini tialize al l preferen ces
	2931	"RTN","RCD PEAA3",135 ,0)
	2932	; RCSCR = ien of en try in fil e 344.49
	2933	"RTN","RCD PEAA3",136 ,0)
	2934	; RCDUZ = the ien of the use r
	2935	"RTN","RCD PEAA3",137 ,0)
	2936	N DIC,DA, X,Y,DLAYGO ,DO,DD
	2937	"RTN","RCD PEAA3",138 ,0)
	2938	S Y=+$O(^ RCY(344.49 ,RCSCR,2," B",RCDUZ,0 ))
	2939	"RTN","RCD PEAA3",139 ,0)
	2940	I Y G ADD UQ
	2941	"RTN","RCD PEAA3",140 ,0)
	2942	S DLAYGO= 344.492,DA (1)=RCSCR, DIC(0)="L" ,X=RCDUZ,D IC="^RCY(3 44.49,"_DA (1)_",2,", DIC("DR")= ".02////0; .03////N"
	2943	"RTN","RCD PEAA3",141 ,0)
	2944	D FILE^DI CN K DIC,D LAYGO
	2945	"RTN","RCD PEAA3",142 ,0)
	2946	ADDUQ Q $S (Y>0:Y,1:0 )
	2947	"RTN","RCD PEAA3",143 ,0)
	2948	;
	2949	"RTN","RCD PEAA3",144 ,0)
	2950	PREOB(RCIE NS) ; Prin t/View EOB detail
	2951	"RTN","RCD PEAA3",145 ,0)
	2952	N RCDA,RC DAZ,Z,Z0
	2953	"RTN","RCD PEAA3",146 ,0)
	2954	D FULL^VA LM1
	2955	"RTN","RCD PEAA3",147 ,0)
	2956	S RCDA=$P ($G(^RCY(3 44.49,$P(R CIENS,U),1 ,$P(RCIENS ,U,2),0)), U,9)
	2957	"RTN","RCD PEAA3",148 ,0)
	2958	F RCDAZ=1 :1:$L(RCDA ,",") S RC DAZ(RCDAZ) =$P(RCDA," ,",RCDAZ)
	2959	"RTN","RCD PEAA3",149 ,0)
	2960	S Z=0 F S Z=$O(RCD AZ(Z)) Q:' Z D
	2961	"RTN","RCD PEAA3",150 ,0)
	2962	. ;
	2963	"RTN","RCD PEAA3",151 ,0)
	2964	. S Z0=RC DAZ(Z)
	2965	"RTN","RCD PEAA3",152 ,0)
	2966	. I $E(Z0 ,1,3)="ADJ " D Q
	2967	"RTN","RCD PEAA3",153 ,0)
	2968	.. I $G(^ RCY(344.4, RCSCR,2,+$ P(Z0,"ADJ" ,2),0))'=" " S RCDAZ( Z)="ADJ^"_ +$P(Z0,"AD J",2)
	2969	"RTN","RCD PEAA3",154 ,0)
	2970	. ;
	2971	"RTN","RCD PEAA3",155 ,0)
	2972	. S Z0=$G (^RCY(344. 4,$P(RCIEN S,U),1,+Z0 ,0))
	2973	"RTN","RCD PEAA3",156 ,0)
	2974	. S RCDAZ (Z)=+Z0_U_ $S($P(Z0,U ,2):$P(Z0, U,2),1:-1) Q
	2975	"RTN","RCD PEAA3",157 ,0)
	2976	;
	2977	"RTN","RCD PEAA3",158 ,0)
	2978	D VP^RCDP EWL2($P(RC IENS,U),.R CDAZ)
	2979	"RTN","RCD PEAA3",159 ,0)
	2980	;
	2981	"RTN","RCD PEAA3",160 ,0)
	2982	S VALMBCK ="R"
	2983	"RTN","RCD PEAA3",161 ,0)
	2984	Q
	2985	"RTN","RCD PEAA3",162 ,0)
	2986	;
	2987	"RTN","RCD PEAA3",163 ,0)
	2988	VERIF(RCIE NS) ;EP - Protocol a ction RCDP E APAR VER IFY
	2989	"RTN","RCD PEAA3",164 ,0)
	2990	; Entry p oint to ve rification options o n APAR wor klist
	2991	"RTN","RCD PEAA3",165 ,0)
	2992	; Input: RCIENS - Internal IEN of en try in fil e 344.49^i en of
	2993	"RTN","RCD PEAA3",166 ,0)
	2994	; 344.491^ selectable line item from list man screen
	2995	"RTN","RCD PEAA3",167 ,0)
	2996	N DIR,DIR UT,DTOUT,D UOUT,RCQUI T,X,Y
	2997	"RTN","RCD PEAA3",168 ,0)
	2998	D FULL^VA LM1
	2999	"RTN","RCD PEAA3",169 ,0)
	3000	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	3001	"RTN","RCD PEAA3",170 ,0)
	3002	. S VALMB CK="R"
	3003	"RTN","RCD PEAA3",171 ,0)
	3004	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	3005	"RTN","RCD PEAA3",172 ,0)
	3006	. D PAUSE ^VALM1
	3007	"RTN","RCD PEAA3",173 ,0)
	3008	;
	3009	"RTN","RCD PEAA3",174 ,0)
	3010	W !!!!
	3011	"RTN","RCD PEAA3",175 ,0)
	3012	S RCQUIT= 0
	3013	"RTN","RCD PEAA3",176 ,0)
	3014	F D Q:R CQUIT
	3015	"RTN","RCD PEAA3",177 ,0)
	3016	. S DIR(0 )="SAO^1:M ANUAL VERI FICATION;2 :REPORT UN VERIFIED D ISCREPANCI ES;3:QUIT"
	3017	"RTN","RCD PEAA3",178 ,0)
	3018	. S DIR(" A",1)="VER IFY EEOBs: "
	3019	"RTN","RCD PEAA3",179 ,0)
	3020	. S DIR(" A",2)=" 1 MANUALLY MARK AS V ERIFIED"
	3021	"RTN","RCD PEAA3",180 ,0)
	3022	. S DIR(" A",3)=" 2 REPORT O F UNVERIFI ED WITH DI SCREPANCIE S"
	3023	"RTN","RCD PEAA3",181 ,0)
	3024	. S DIR(" A",4)=" 3 QUIT AND RETURN TO WORKLIST"
	3025	"RTN","RCD PEAA3",182 ,0)
	3026	. S DIR(" A")="Selec t Action: ",DIR("B") ="QUIT" W ! D ^DIR K DIR
	3027	"RTN","RCD PEAA3",183 ,0)
	3028	. I Y=3!( Y="")!$D(D UOUT)!$D(D TOUT) S RC QUIT=1 Q
	3029	"RTN","RCD PEAA3",184 ,0)
	3030	. ;
	3031	"RTN","RCD PEAA3",185 ,0)
	3032	. I Y=1 D MVER($P(R CIENS,U)) W !! Q
	3033	"RTN","RCD PEAA3",186 ,0)
	3034	. ;
	3035	"RTN","RCD PEAA3",187 ,0)
	3036	. I Y=2 D RPT^RCDPE V0($P(RCIE NS,U)) W ! ! Q
	3037	"RTN","RCD PEAA3",188 ,0)
	3038	;
	3039	"RTN","RCD PEAA3",189 ,0)
	3040	S VALMBCK ="R"
	3041	"RTN","RCD PEAA3",190 ,0)
	3042	Q
	3043	"RTN","RCD PEAA3",191 ,0)
	3044	;
	3045	"RTN","RCD PEAA3",192 ,0)
	3046	MVER(RCERA ) ; Manual ly mark an EEOB as v erified wi thin APAR
	3047	"RTN","RCD PEAA3",193 ,0)
	3048	; subrout ine cloned from the process th at VERIFIE S EEOBs of f the stan dard workl ist (MVER^ RCDPEV)
	3049	"RTN","RCD PEAA3",194 ,0)
	3050	; but wit h specific changes t o support APAR
	3051	"RTN","RCD PEAA3",195 ,0)
	3052	; this su broutine o nly needs to VERIFY one EEOB r ather than a list of EEOBs
	3053	"RTN","RCD PEAA3",196 ,0)
	3054	N A,CT,DA ,DIE,DR,DT OUT,DUOUT, Z,Z0,Z1,RC T,RCY,RCY0 ,RCZ0,RCLI NE,RCYNUM, DIR,X,Y,RE SULT,SPLIT ,Q,Q0,DT1, DT2
	3055	"RTN","RCD PEAA3",197 ,0)
	3056	N VERIFIE D
	3057	"RTN","RCD PEAA3",198 ,0)
	3058	S (VERIFI ED,RCT)=0, CT=1,Z0=""
	3059	"RTN","RCD PEAA3",199 ,0)
	3060	; get the EEOB entr y ien to d etermine i f already it's alrea dy been ve rified
	3061	"RTN","RCD PEAA3",200 ,0)
	3062	S Z1=$O(^ TMP("RCDPE -EOB_WLDX" ,$J,"")) I Z1 S Z=^T MP("RCDPE- EOB_WLDX", $J,Z1)
	3063	"RTN","RCD PEAA3",201 ,0)
	3064	; grab th e data bel onging to the EEOB
	3065	"RTN","RCD PEAA3",202 ,0)
	3066	I Z]"" S Z0=$G(^RCY (344.49,RC ERA,1,+$P( Z,U,2),0))
	3067	"RTN","RCD PEAA3",203 ,0)
	3068	; get VER IFY data
	3069	"RTN","RCD PEAA3",204 ,0)
	3070	I Z0'="", $P(Z0,U,13 ) S VERIFI ED=1
	3071	"RTN","RCD PEAA3",205 ,0)
	3072	I VERIFIE D D Q
	3073	"RTN","RCD PEAA3",206 ,0)
	3074	. S DIR(0 )="EA",DIR ("A",1)="T HIS EEOB I S ALREADY VERIFIED", DIR("A")=" PRESS RETU RN TO CONT INUE: " W ! D ^DIR K DIR
	3075	"RTN","RCD PEAA3",207 ,0)
	3076	S RCY=+$P ($G(^TMP(" RCDPE-EOB_ WLDX",$J,Z 1)),U,2),R CLINE=+^(Z 1),RCYNUM= Z1
	3077	"RTN","RCD PEAA3",208 ,0)
	3078	S RCY0=$G (^RCY(344. 49,RCERA,1 ,RCY,0))
	3079	"RTN","RCD PEAA3",209 ,0)
	3080	S RCZ0=$G (^RCY(344. 4,RCERA,1, +$P(RCY0,U ,9),0))
	3081	"RTN","RCD PEAA3",210 ,0)
	3082	I '$P(RCZ 0,U,2) D
	3083	"RTN","RCD PEAA3",211 ,0)
	3084	. W !!,"T HIS LINE D OES NOT RE FERENCE A VALID BILL "
	3085	"RTN","RCD PEAA3",212 ,0)
	3086	E D
	3087	"RTN","RCD PEAA3",213 ,0)
	3088	. S RESUL T=$$VER^RC DPEV(RCERA ,+$G(^IBM( 361.1,+$P( RCZ0,U,2), 0)),+$P(RC Y0,U,9),1)
	3089	"RTN","RCD PEAA3",214 ,0)
	3090	. F Z=2:1 :9 I $E($P (RESULT,U, Z))="*" S Q=$P(RESUL T,U,Z),$E( Q,1)="",$P (RESULT,U, Z)=Q
	3091	"RTN","RCD PEAA3",215 ,0)
	3092	. S SPLIT =$O(^RCY(3 44.49,RCER A,1,"B",+R CY0_".9999 "),-1)'=(+ RCY0_".000 1")
	3093	"RTN","RCD PEAA3",216 ,0)
	3094	. S Z=$S( SPLIT:"CLA IM #'s: ", 1:" CLAIM #: ")
	3095	"RTN","RCD PEAA3",217 ,0)
	3096	. S Z=Z_$ P(RCY0,U,2 )_$S('SPLI T:"",1:" ( ORIGINAL E RA DATA)")
	3097	"RTN","RCD PEAA3",218 ,0)
	3098	. I SPLIT D
	3099	"RTN","RCD PEAA3",219 ,0)
	3100	.. S Q=+R CY0 F S Q =$O(^RCY(3 44.49,RCER A,1,"B",Q) ) Q:(Q\1)' =+RCY0 S Q0=+$O(^RC Y(344.49,R CERA,1,"B" ,Q,0)),Q0= $G(^RCY(34 4.49,RCERA ,1,Q0,0)) I $P(Q0,U, 2)'="" S Z =Z_" "_$P( Q0,U,2)
	3101	"RTN","RCD PEAA3",220 ,0)
	3102	. W !!!,Z
	3103	"RTN","RCD PEAA3",221 ,0)
	3104	. W !,?13 ,"PATIENT NAME"_$J(" ",18)_" S UBMITTED A MT SVC DATE(S)"
	3105	"RTN","RCD PEAA3",222 ,0)
	3106	. W !,?13 ,"-------- ---------- ---------- -- ------ --------- --------- --------"
	3107	"RTN","RCD PEAA3",223 ,0)
	3108	. S DT1=$ E($S($P(RE SULT,U,7): $$FMTE^XLF DT($P(RESU LT,U,7),"2 D"),1:"NOT FOUND")_$J ("",8),1,8 )
	3109	"RTN","RCD PEAA3",224 ,0)
	3110	. S DT2=$ E($S($P(RE SULT,U,9): "-"_$$FMTE ^XLFDT($P( RESULT,U,9 ),"2D"),1: "-NOTFOUND ")_$J("",9 ),1,9)
	3111	"RTN","RCD PEAA3",225 ,0)
	3112	. W !," ERA DATA: ",$E($P(R ESULT,U,3) _$J("",30) ,1,30)," ",$E($J($P (RESULT,U, 5),"",2)_$ J("",15),1 ,15)_" "_ DT1_DT2
	3113	"RTN","RCD PEAA3",226 ,0)
	3114	. W !,?15 ,$P($G(^RC Y(344,RCER A,0)),U,6)
	3115	"RTN","RCD PEAA3",227 ,0)
	3116	. S DT1=$ E($S($P(RE SULT,U,6): $$FMTE^XLF DT($P(RESU LT,U,6),"2 D"),1:"NOT FOUND")_$J ("",8),1,8 )
	3117	"RTN","RCD PEAA3",228 ,0)
	3118	. S DT2=$ E($S($P(RE SULT,U,8): "-"_$$FMTE ^XLFDT($P( RESULT,U,8 ),"2D"),1: "-NOTFOUND ")_$J("",9 ),1,9)
	3119	"RTN","RCD PEAA3",229 ,0)
	3120	. W !," BILL DATA: "_$E($P(R ESULT,U,2) _$J("",30) ,1,30)_" "_$E($J($P (RESULT,U, 4),"",2)_$ J("",15),1 ,15)_" "_ DT1_DT2
	3121	"RTN","RCD PEAA3",230 ,0)
	3122	. W !,?15 ,$P($G(^DI C(36,+$P(R CZ0,U,4),0 )),U),!
	3123	"RTN","RCD PEAA3",231 ,0)
	3124	S DIR(0)= "YA",DIR(" A")="DO YO U WANT TO MARK THIS LINE VERIF IED? ",DIR ("B")="NO" W ! D ^DI R K DIR
	3125	"RTN","RCD PEAA3",232 ,0)
	3126	;
	3127	"RTN","RCD PEAA3",233 ,0)
	3128	I Y'=1 Q
	3129	"RTN","RCD PEAA3",234 ,0)
	3130	S DA(1)=R CERA,DA=+R CY,DIE="^R CY(344.49, "_DA(1)_", 1,",DR=".1 3////1" D ^DIE
	3131	"RTN","RCD PEAA3",235 ,0)
	3132	S A=$$TOP LINE^RCDPE WL1($G(^RC Y(344.49,R CERA,1,+RC Y,0)),RCYN UM)
	3133	"RTN","RCD PEAA3",236 ,0)
	3134	S ^TMP("R CDPE-EOB_W L",$J,RCLI NE,0)=A
	3135	"RTN","RCD PEAA3",237 ,0)
	3136	Q
	3137	"RTN","RCD PEAA3",238 ,0)
	3138	;
	3139	"RTN","RCD PEAA3",239 ,0)
	3140	;PRCA4.5 304 - add a claim c omment to the ERA de tail line from APAR
	3141	"RTN","RCD PEAA3",240 ,0)
	3142	COMNT ;
	3143	"RTN","RCD PEAA3",241 ,0)
	3144	N IEN,SEQ ,DA,DIR,DT OUT,DUOUT, X,Y,DIRUT, DIROUT,ZDA ,ZBILL,RCO MMENT,TCOM M
	3145	"RTN","RCD PEAA3",242 ,0)
	3146	S RCOMMEN T=0
	3147	"RTN","RCD PEAA3",243 ,0)
	3148	S IEN=+$P (RCIENS,U, 1)
	3149	"RTN","RCD PEAA3",244 ,0)
	3150	; Validat e the sele ction
	3151	"RTN","RCD PEAA3",245 ,0)
	3152	I IEN=0 D G COMQ
	3153	"RTN","RCD PEAA3",246 ,0)
	3154	. W !,"Ca nnot comme nt, no rec ord in fil e ELECTRON IC REMITTA NCE ADVICE file sele cted." D W AIT^VALM1
	3155	"RTN","RCD PEAA3",247 ,0)
	3156	S SEQ=$P( ^RCY(344.4 9,IEN,1,+$ P(RCIENS,U ,2),0),U,9 ) ; Just g rab the fi rst sequen ce number for the co mment.
	3157	"RTN","RCD PEAA3",248 ,0)
	3158	I $G(SEQ) ="" D G C OMQ
	3159	"RTN","RCD PEAA3",249 ,0)
	3160	. W !,"Ca nnot comme nt, no ERA detail re cord selec ted." D WA IT^VALM1
	3161	"RTN","RCD PEAA3",250 ,0)
	3162	I $G(^RCY (344.4,IEN ,1,SEQ,0)) ']"" D G COMQ
	3163	"RTN","RCD PEAA3",251 ,0)
	3164	. W !,"Ca nnot comme nt, ERA de tail recor d selected not found ." D WAIT^ VALM1
	3165	"RTN","RCD PEAA3",252 ,0)
	3166	;
	3167	"RTN","RCD PEAA3",253 ,0)
	3168	; Allow u ser to put comment o n this ERA Detail re cord
	3169	"RTN","RCD PEAA3",254 ,0)
	3170	S ZDA=SEQ ,ZDA(1)=IE N,ZBILL=$P ($$GETBILL ^RCDPESR0( .ZDA),"-", 2)
	3171	"RTN","RCD PEAA3",255 ,0)
	3172	W !,"Ente r a commen t on ERA # "_IEN_" E RA Detail Seq #",SEQ ," Bill # ",ZBILL,!
	3173	"RTN","RCD PEAA3",256 ,0)
	3174	S DIE="^R CY(344.4," _IEN_",1," ,DA=SEQ,DA (1)=IEN,DR ="4Comment " D ^DIE G :$D(DTOUT) !$D(Y) COM Q
	3175	"RTN","RCD PEAA3",257 ,0)
	3176	; Now fil e user (DU Z) and DAT E
	3177	"RTN","RCD PEAA3",258 ,0)
	3178	K DR
	3179	"RTN","RCD PEAA3",259 ,0)
	3180	; If DA i s not defi ned then t he user de leted the comment wi th an @,
	3181	"RTN","RCD PEAA3",260 ,0)
	3182	; Delete the user a nd date to o.
	3183	"RTN","RCD PEAA3",261 ,0)
	3184	S TCOMM=$ $GET1^DIQ( 344.41,SEQ _","_IEN_" ,",4,"E")
	3185	"RTN","RCD PEAA3",262 ,0)
	3186	I TCOMM=" " S DA=SEQ ,DA(1)=IEN ,DR="4.01/ ///@;4.02/ ///@;"
	3187	"RTN","RCD PEAA3",263 ,0)
	3188	E S DR=" 4.01////"_ $$DT^XLFDT _";4.02/// /"_$G(DUZ) _";"
	3189	"RTN","RCD PEAA3",264 ,0)
	3190	D ^DIE
	3191	"RTN","RCD PEAA3",265 ,0)
	3192	S RCOMMEN T=1
	3193	"RTN","RCD PEAA3",266 ,0)
	3194	D WAIT^VA LM1
	3195	"RTN","RCD PEAA3",267 ,0)
	3196	;
	3197	"RTN","RCD PEAA3",268 ,0)
	3198	COMQ I RCO MMENT D IN IT^RCDPEAA 2(RCIENS) ;
	3199	"RTN","RCD PEAA3",269 ,0)
	3200	S VALMBCK ="R"
	3201	"RTN","RCD PEAA3",270 ,0)
	3202	Q
	3203	"RTN","RCD PEAD")
	3204	0^25^B8661 8636^B5125 3087
	3205	"RTN","RCD PEAD",1,0)
	3206	RCDPEAD ;A LB/PJH - A UTO DECREA SE ;Jun 06 , 2014@19: 11:19
	3207	"RTN","RCD PEAD",2,0)
	3208	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	3209	"RTN","RCD PEAD",3,0)
	3210	;Per VA D irective 6 402, this routine sh ould not b e modified .
	3211	"RTN","RCD PEAD",4,0)
	3212	;Read ^IB M(361.1) v ia Private IA 4051
	3213	"RTN","RCD PEAD",5,0)
	3214	;
	3215	"RTN","RCD PEAD",6,0)
	3216	EN ;Auto D ecrease - applies to auto-post ed claims only
	3217	"RTN","RCD PEAD",7,0)
	3218	N RCAMT,R CDATE,RCDA Y,RCSTART, RCITEM
	3219	"RTN","RCD PEAD",8,0)
	3220	N RC34461 0,RCMDAP,R CMDAD,RCJ, RCK,RCIARR ,J
	3221	"RTN","RCD PEAD",9,0)
	3222	;
	3223	"RTN","RCD PEAD",10,0 )
	3224	; Quit if medical a uto postin g is OFF o r medical auto decre ase is OFF
	3225	"RTN","RCD PEAD",11,0 )
	3226	Q:'$P($G( ^RCY(344.6 1,1,0)),U, 2) Q:'$P( $G(^RCY(34 4.61,1,0)) ,U,3)
	3227	"RTN","RCD PEAD",12,0 )
	3228	;
	3229	"RTN","RCD PEAD",13,0 )
	3230	; Get the RCDPE PAR AMETER fil e #344.61 field.04 A UTO DECREA SE MED DAY S DEFAULT value and
	3231	"RTN","RCD PEAD",14,0 )
	3232	; calcula te process date by s ubtracting this valu e from tod ay's date
	3233	"RTN","RCD PEAD",15,0 )
	3234	S RCDAY=$ $FMADD^XLF DT(DT\1,-$ P($G(^RCY( 344.61,1,0 )),U,4))
	3235	"RTN","RCD PEAD",16,0 )
	3236	;
	3237	"RTN","RCD PEAD",17,0 )
	3238	; PRCA4. 5304 - re moved gene ric auto-d ecrease am ount. Now auto-decre ase is by CARC
	3239	"RTN","RCD PEAD",18,0 )
	3240	; Allow f or a range of dates in future - currentl y only che cks for RC DAY
	3241	"RTN","RCD PEAD",19,0 )
	3242	;
	3243	"RTN","RCD PEAD",20,0 )
	3244	; Scan F index for ERA within date rang e
	3245	"RTN","RCD PEAD",21,0 )
	3246	S RCDATE= $$FMADD^XL FDT(RCDAY, -1)
	3247	"RTN","RCD PEAD",22,0 )
	3248	F S RCDA TE=$O(^RCY (344.4,"F" ,RCDATE)) Q:'RCDATE Q:(RCDATE \1)>RCDAY D
	3249	"RTN","RCD PEAD",23,0 )
	3250	. ;
	3251	"RTN","RCD PEAD",24,0 )
	3252	. ; Scan "F" index of ERA fil e for ERA entries wi th AUTOPOS T DATE fie ld #4.03 m atching RC DAY
	3253	"RTN","RCD PEAD",25,0 )
	3254	. D EN2(R CDATE,RCDA Y)
	3255	"RTN","RCD PEAD",26,0 )
	3256	Q
	3257	"RTN","RCD PEAD",27,0 )
	3258	;
	3259	"RTN","RCD PEAD",28,0 )
	3260	EN2(RCDATE ,RCDAY) ; Scans the 'F' index of the ERA file for ERA entrie s with an
	3261	"RTN","RCD PEAD",29,0 )
	3262	; AUTOPOS T DATE fie ld (#4.03) matching RCDAY
	3263	"RTN","RCD PEAD",30,0 )
	3264	; Input: RCDATE - Curr ent date b eing searc h
	3265	"RTN","RCD PEAD",31,0 )
	3266	; RCDAY - AUTO DECREATES MED DAYS DEFAULT (F ile 344.61 , field .0 4)
	3267	"RTN","RCD PEAD",32,0 )
	3268	N PAYID,P AYNAM,RCER A,RCRTYPE
	3269	"RTN","RCD PEAD",33,0 )
	3270	S RCERA=0
	3271	"RTN","RCD PEAD",34,0 )
	3272	F S RCER A=$O(^RCY( 344.4,"F", RCDATE,RCE RA)) Q:'RC ERA D
	3273	"RTN","RCD PEAD",35,0 )
	3274	. N RC344 6,RCPARM
	3275	"RTN","RCD PEAD",36,0 )
	3276	. ;
	3277	"RTN","RCD PEAD",37,0 )
	3278	. ; Quit if ERA is for Pharma cy
	3279	"RTN","RCD PEAD",38,0 )
	3280	. S RCRTY PE=$$PHARM ^RCDPEAP1( RCERA)
	3281	"RTN","RCD PEAD",39,0 )
	3282	. Q:RCRTY PE
	3283	"RTN","RCD PEAD",40,0 )
	3284	. ;
	3285	"RTN","RCD PEAD",41,0 )
	3286	. ; Check payer exc lusion fil e for this ERA's pay er
	3287	"RTN","RCD PEAD",42,0 )
	3288	. S PAYID =$P($G(^RC Y(344.4,RC ERA,0)),U, 3)
	3289	"RTN","RCD PEAD",43,0 )
	3290	. S PAYNA M=$P($G(^R CY(344.4,R CERA,0)),U ,6)
	3291	"RTN","RCD PEAD",44,0 )
	3292	. I PAYID '="",PAYNA M'="" D
	3293	"RTN","RCD PEAD",45,0 )
	3294	. . S RCP ARM=$O(^RC Y(344.6,"C PID",PAYNA M,PAYID,"" ))
	3295	"RTN","RCD PEAD",46,0 )
	3296	. . S:RCP ARM'="" RC 3446=$G(^R CY(344.6,R CPARM,0))
	3297	"RTN","RCD PEAD",47,0 )
	3298	. ;
	3299	"RTN","RCD PEAD",48,0 )
	3300	. ; Ignor e ERA if E XCLUDE MED CLAIMS PO STING (#. 06) or
	3301	"RTN","RCD PEAD",49,0 )
	3302	. ; EXCLU DE MED CLA IMS DECREA SE (#.07) fields set to 'yes'
	3303	"RTN","RCD PEAD",50,0 )
	3304	. I $G(RC 3446)'="" Q:$P(RC344 6,U,6)=1 Q:$P(RC344 6,U,7)=1
	3305	"RTN","RCD PEAD",51,0 )
	3306	. ;
	3307	"RTN","RCD PEAD",52,0 )
	3308	. ; Build index to scratchpad for this ERA
	3309	"RTN","RCD PEAD",53,0 )
	3310	. N RCARR AY
	3311	"RTN","RCD PEAD",54,0 )
	3312	. D BUILD ^RCDPEAP(R CERA,.RCAR RAY)
	3313	"RTN","RCD PEAD",55,0 )
	3314	. ;
	3315	"RTN","RCD PEAD",56,0 )
	3316	. ; Scan ERA DETAIL entries i n #344.41 for auto-p osted medi cal claims
	3317	"RTN","RCD PEAD",57,0 )
	3318	. D EN3(R CDATE,RCER A)
	3319	"RTN","RCD PEAD",58,0 )
	3320	Q
	3321	"RTN","RCD PEAD",59,0 )
	3322	;
	3323	"RTN","RCD PEAD",60,0 )
	3324	EN3(RCDATE ,RCERA) ; Scan ERA D ETAIL entr ies in #34 4.41 for a uto-posted medical c laims
	3325	"RTN","RCD PEAD",61,0 )
	3326	; Input: RCDATE - Curr ent date b eing searc h
	3327	"RTN","RCD PEAD",62,0 )
	3328	; RCERA - ERA number
	3329	"RTN","RCD PEAD",63,0 )
	3330	N RCADJ,R CDREC,RCLI NE
	3331	"RTN","RCD PEAD",64,0 )
	3332	S RCLINE= 0
	3333	"RTN","RCD PEAD",65,0 )
	3334	F S RCLI NE=$O(^RCY (344.4,"F" ,RCDATE,RC ERA,RCLINE )) Q:'RCLI NE D
	3335	"RTN","RCD PEAD",66,0 )
	3336	. ;
	3337	"RTN","RCD PEAD",67,0 )
	3338	. ; Ignor e claim li ne if alre ady auto d ecreased
	3339	"RTN","RCD PEAD",68,0 )
	3340	. Q:$P($G (^RCY(344. 4,RCERA,1, RCLINE,5)) ,U,3)
	3341	"RTN","RCD PEAD",69,0 )
	3342	. ;
	3343	"RTN","RCD PEAD",70,0 )
	3344	. ; Get r ecord deta il
	3345	"RTN","RCD PEAD",71,0 )
	3346	. S RCDRE C=$G(^RCY( 344.4,RCER A,1,RCLINE ,0))
	3347	"RTN","RCD PEAD",72,0 )
	3348	. ;
	3349	"RTN","RCD PEAD",73,0 )
	3350	. ; Get c laim numbe r RCBILL f or the ERA line usin g EOB #361 .1 pointer
	3351	"RTN","RCD PEAD",74,0 )
	3352	. N COMME NT,EOBIEN, RCBAL,RCBI LL,RCTRAND A
	3353	"RTN","RCD PEAD",75,0 )
	3354	. ;
	3355	"RTN","RCD PEAD",76,0 )
	3356	. ; Get p ointer to EOB file # 361.1 from ERA DETAI L
	3357	"RTN","RCD PEAD",77,0 )
	3358	. S EOBIE N=$P($G(^R CY(344.4,R CERA,1,RCL INE,0)),U, 2),RCBILL= 0
	3359	"RTN","RCD PEAD",78,0 )
	3360	. ;
	3361	"RTN","RCD PEAD",79,0 )
	3362	. ; Get ^ DGCR(399 p ointer (DI NUM for #4 30 file)
	3363	"RTN","RCD PEAD",80,0 )
	3364	. S:EOBIE N RCBILL=$ P($G(^IBM( 361.1,EOBI EN,0)),U) Q:'RCBILL
	3365	"RTN","RCD PEAD",81,0 )
	3366	. ;
	3367	"RTN","RCD PEAD",82,0 )
	3368	. ; If cl aim has be en split/e dit and cl aim change d in APAR do not aut o decrease
	3369	"RTN","RCD PEAD",83,0 )
	3370	. Q:$$SPL IT(RCERA,R CLINE,RCBI LL,.RCARRA Y)
	3371	"RTN","RCD PEAD",84,0 )
	3372	. ;
	3373	"RTN","RCD PEAD",85,0 )
	3374	. ; Do no t auto dec rease if c laim is re ferred to General Co uncil
	3375	"RTN","RCD PEAD",86,0 )
	3376	. Q:$P($G (^PRCA(430 ,RCBILL,6) ),U,4)]""
	3377	"RTN","RCD PEAD",87,0 )
	3378	. ;
	3379	"RTN","RCD PEAD",88,0 )
	3380	. ; Claim must be O PEN or ACT IVE
	3381	"RTN","RCD PEAD",89,0 )
	3382	. N STATU S
	3383	"RTN","RCD PEAD",90,0 )
	3384	. S STATU S=$P($G(^P RCA(430,RC BILL,0))," ^",8)
	3385	"RTN","RCD PEAD",91,0 )
	3386	. I STATU S'=42,STAT US'=16 Q
	3387	"RTN","RCD PEAD",92,0 )
	3388	. ;
	3389	"RTN","RCD PEAD",93,0 )
	3390	. ; PRCA* 4.5*304 - A CARC mus t be inclu ded and ha ve an auto -decrease limit befo re auto-de creasing c an occur.
	3391	"RTN","RCD PEAD",94,0 )
	3392	. S RCAMT =$$CARCLMT (EOBIEN)
	3393	"RTN","RCD PEAD",95,0 )
	3394	. Q:$L(RC AMT)=0 ; No CARCs on E OB were el igible for auto-decr ease
	3395	"RTN","RCD PEAD",96,0 )
	3396	. ;
	3397	"RTN","RCD PEAD",97,0 )
	3398	. ; Order CARCs for Auto-Decr ease in la rgest to s mallest am ount order
	3399	"RTN","RCD PEAD",98,0 )
	3400	. K RCIAR R
	3401	"RTN","RCD PEAD",99,0 )
	3402	. F J=1:1 S RCITEM= $P(RCAMT,U ,J) Q:RCIT EM="" S R CIARR(-($P (RCITEM,"; ",1)),J)=R CITEM
	3403	"RTN","RCD PEAD",100, 0)
	3404	. Q:$D(RC IARR)<10 ; Quit if CARC adjus tment arra y doesn't have any e lements to process
	3405	"RTN","RCD PEAD",101, 0)
	3406	. ;
	3407	"RTN","RCD PEAD",102, 0)
	3408	. ; Walk the RCIARR and apply CARC base d adjustme nts to the bill.
	3409	"RTN","RCD PEAD",103, 0)
	3410	. S RCJ=" ",RCADJ=0
	3411	"RTN","RCD PEAD",104, 0)
	3412	. F S RC J=$O(RCIAR R(RCJ)) Q: RCJ="" S RCK="" F S RCK=$O(R CIARR(RCJ, RCK)) Q:RC K="" D
	3413	"RTN","RCD PEAD",105, 0)
	3414	. . ; Get current b alance on Bill
	3415	"RTN","RCD PEAD",106, 0)
	3416	. . S RCB AL=$P($G(^ PRCA(430,R CBILL,7)), U)
	3417	"RTN","RCD PEAD",107, 0)
	3418	. . ;
	3419	"RTN","RCD PEAD",108, 0)
	3420	. . ; Che ck pending payment a mount and bill balan ce
	3421	"RTN","RCD PEAD",109, 0)
	3422	. . N PEN DING
	3423	"RTN","RCD PEAD",110, 0)
	3424	. . S PEN DING=$$PEN DPAY^RCDPU RET(RCBILL )
	3425	"RTN","RCD PEAD",111, 0)
	3426	. . K ^TM P($J,"RCDP UREC","PP" )
	3427	"RTN","RCD PEAD",112, 0)
	3428	. . Q:(RC BAL-PENDIN G)<(+$P(RC IARR(RCJ,R CK),";",1) )
	3429	"RTN","RCD PEAD",113, 0)
	3430	. . ;
	3431	"RTN","RCD PEAD",114, 0)
	3432	. . ; Add comment
	3433	"RTN","RCD PEAD",115, 0)
	3434	. . S COM MENT(1)="M EDICAL AUT O-DECREASE FOR CARC: "_$P(RCIA RR(RCJ,RCK ),";",2)_" AMOUNT: " _+$P(RCIAR R(RCJ,RCK) ,";",1)_" (MAX DEC: "_+$P($$AC TCARC($P(R CIARR(RCJ, RCK),";",2 )),U,2)_") "
	3435	"RTN","RCD PEAD",116, 0)
	3436	. . ; If this CARC is expired then add that infor mation to the commen t
	3437	"RTN","RCD PEAD",117, 0)
	3438	. . I $P( RCIARR(RCJ ,RCK),";", 3)'="" S C OMMENT(1)= COMMENT(1) _" CARC ex pired on " _$$FMTE^XL FDT($P(RCI ARR(RCJ,RC K),";",3), "6D")
	3439	"RTN","RCD PEAD",118, 0)
	3440	. . ; App ly contrac t adjustme nt for CAR C adjustme nt amount from claim informati on
	3441	"RTN","RCD PEAD",119, 0)
	3442	. . S RCT RANDA=$$IN CDEC^RCBEU TR1(RCBILL ,-$P(RCIAR R(RCJ,RCK) ,";",1),.C OMMENT,"", "",1) Q:'R CTRANDA
	3443	"RTN","RCD PEAD",120, 0)
	3444	. . ; Upd ate total adjustment s for line
	3445	"RTN","RCD PEAD",121, 0)
	3446	. . S RCA DJ=RCADJ+$ P(RCIARR(R CJ,RCK),"; ",1)
	3447	"RTN","RCD PEAD",122, 0)
	3448	. ; Updat e auto-dec rease indi cator, aut o decrease amount an d auto dec rease date
	3449	"RTN","RCD PEAD",123, 0)
	3450	. N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R="7///1;8 ///"_RCADJ _";10///"_ DT D ^DIE
	3451	"RTN","RCD PEAD",124, 0)
	3452	. ; PRCA* 4.5*304 - End of upd ates
	3453	"RTN","RCD PEAD",125, 0)
	3454	. ; Updat e last aut o decrease date on E RA
	3455	"RTN","RCD PEAD",126, 0)
	3456	. N DA,DI E,DR S DA= RCERA,DIE= "^RCY(344. 4,",DR="4. 03///"_DT D ^DIE
	3457	"RTN","RCD PEAD",127, 0)
	3458	Q
	3459	"RTN","RCD PEAD",128, 0)
	3460	;
	3461	"RTN","RCD PEAD",129, 0)
	3462	SPLIT(RCSC R,RCLINE,R CBILL,RCAR RAY) ;Chec k for SPLI T/EDIT in scratchpad
	3463	"RTN","RCD PEAD",130, 0)
	3464	;Input RC SCR - IEN of #344.49
	3465	"RTN","RCD PEAD",131, 0)
	3466	; RC LINE - ERA detail li ne sequenc e number
	3467	"RTN","RCD PEAD",132, 0)
	3468	; RC BILL - IEN of #430
	3469	"RTN","RCD PEAD",133, 0)
	3470	; AR RAY - refe rence to p assed arra y (from BU ILD^RCDPEA P)
	3471	"RTN","RCD PEAD",134, 0)
	3472	;Output r eturn valu e 1/0 = Sp lit/Not Sp lit
	3473	"RTN","RCD PEAD",135, 0)
	3474	N SUB,SUB 1
	3475	"RTN","RCD PEAD",136, 0)
	3476	;Find ERA line in s cratchpad
	3477	"RTN","RCD PEAD",137, 0)
	3478	S SUB=$G( RCARRAY(RC LINE)) Q:' SUB 0
	3479	"RTN","RCD PEAD",138, 0)
	3480	;Get n.00 1 line
	3481	"RTN","RCD PEAD",139, 0)
	3482	S SUB1=$O (^RCY(344. 49,RCSCR,1 ,SUB)) Q:' SUB1 0
	3483	"RTN","RCD PEAD",140, 0)
	3484	;Check se quence num ber is the same
	3485	"RTN","RCD PEAD",141, 0)
	3486	Q:$P($G(^ RCY(344.49 ,RCSCR,1,S UB1,0)),". ")'=$P($G( ^RCY(344.4 9,RCSCR,1, SUB,0)),U) 0
	3487	"RTN","RCD PEAD",142, 0)
	3488	;Check th at claim n umber is u nchanged f rom origin al ERA
	3489	"RTN","RCD PEAD",143, 0)
	3490	Q:$P($G(^ RCY(344.49 ,RCSCR,1,S UB1,0)),U, 7)=RCBILL 0
	3491	"RTN","RCD PEAD",144, 0)
	3492	;Otherwis e claim wa s edited ( and should not be de creased)
	3493	"RTN","RCD PEAD",145, 0)
	3494	Q 1
	3495	"RTN","RCD PEAD",146, 0)
	3496	;
	3497	"RTN","RCD PEAD",147, 0)
	3498	CARCLMT(RC EOB,FROMAD P,ADATE) ; EP from CO MPILE^RCDP EADP
	3499	"RTN","RCD PEAD",148, 0)
	3500	; PRCA4. 5304 - Ch eck to see if CARC a re include d and are eligible
	3501	"RTN","RCD PEAD",149, 0)
	3502	; for aut o-decrease . Return 0 if not, M ax Amount ^ CARC if it is.
	3503	"RTN","RCD PEAD",150, 0)
	3504	; Input: RCEOB - Internal IEN for t he explana tion of be nefits fie ld (361.1)
	3505	"RTN","RCD PEAD",151, 0)
	3506	; FROMADP - 1 if bei ng called from COMPI LE^RCDPEAD P, 0 other wise
	3507	"RTN","RCD PEAD",152, 0)
	3508	; Optional , default to 0
	3509	"RTN","RCD PEAD",153, 0)
	3510	; ADATE - Internal Auto-Post Date (onl y passed i f FROMADP= 1)
	3511	"RTN","RCD PEAD",154, 0)
	3512	; Returns : A1;A2;A3 ;A4^B1;B2; B3;B4^...^ N1;N2;N3;N 4 Where:
	3513	"RTN","RCD PEAD",155, 0)
	3514	; A1 - Au to-Decreas e amount o f the 1st CARC code in the EOB
	3515	"RTN","RCD PEAD",156, 0)
	3516	; A2 - 1s t CARC cod e in the E OB
	3517	"RTN","RCD PEAD",157, 0)
	3518	; A3 - De activation Date of t he 1st CAR C code in the EOB if
	3519	"RTN","RCD PEAD",158, 0)
	3520	; it has one a nd is less than toda y AND FROM ADP=0
	3521	"RTN","RCD PEAD",159, 0)
	3522	; Ot herwise Qu antity of the first CARC code in the EOB if
	3523	"RTN","RCD PEAD",160, 0)
	3524	; FR OMADP=1
	3525	"RTN","RCD PEAD",161, 0)
	3526	; A4 - Re ason of th e 1st CARC code in t he EOB
	3527	"RTN","RCD PEAD",162, 0)
	3528	; on ly passed if FROMADP =1
	3529	"RTN","RCD PEAD",163, 0)
	3530	N I,RCAMT ,RCCAMT,RC CODE,RCCOD ES,RCDATA, RCITEM,RCT AMT,XDT,XI EN
	3531	"RTN","RCD PEAD",164, 0)
	3532	S:'$D(FRO MADP) FROM ADP=0
	3533	"RTN","RCD PEAD",165, 0)
	3534	S RCAMT=" ",RCCODES= ""
	3535	"RTN","RCD PEAD",166, 0)
	3536	;
	3537	"RTN","RCD PEAD",167, 0)
	3538	; Extract the CARC codes from the EOB.
	3539	"RTN","RCD PEAD",168, 0)
	3540	; Returne d are ^A1; A2;A3;A4^A 1;A2;A3;A4 ^... Where
	3541	"RTN","RCD PEAD",169, 0)
	3542	; A 1 - CARC c ode
	3543	"RTN","RCD PEAD",170, 0)
	3544	; A 2 - Auto D ecrease Am ount
	3545	"RTN","RCD PEAD",171, 0)
	3546	; A 3 - Quanti ty ( only retur ned if FRO MADP=1)
	3547	"RTN","RCD PEAD",172, 0)
	3548	; A 4 - REASON ( only retur ned if FRO MADP=1)
	3549	"RTN","RCD PEAD",173, 0)
	3550	D GETCARC S(RCEOB,.R CCODES,FRO MADP)
	3551	"RTN","RCD PEAD",174, 0)
	3552	;
	3553	"RTN","RCD PEAD",175, 0)
	3554	; Loop th rough all of the CAR C codes fo und. If n one, it wi ll exit.
	3555	"RTN","RCD PEAD",176, 0)
	3556	F I=2:1:$ L(RCCODES, "^") D
	3557	"RTN","RCD PEAD",177, 0)
	3558	. S RCITE M=$P(RCCOD ES,"^",I)
	3559	"RTN","RCD PEAD",178, 0)
	3560	. Q:RCITE M=""
	3561	"RTN","RCD PEAD",179, 0)
	3562	. S RCCOD E=$P(RCITE M,";",1),R CCAMT=$P(R CITEM,";", 2)
	3563	"RTN","RCD PEAD",180, 0)
	3564	. ;
	3565	"RTN","RCD PEAD",181, 0)
	3566	. ; Quit If the Adj ustment am ount is a negative a mount
	3567	"RTN","RCD PEAD",182, 0)
	3568	. Q:+RCCA MT<0
	3569	"RTN","RCD PEAD",183, 0)
	3570	. ;
	3571	"RTN","RCD PEAD",184, 0)
	3572	. ; Look up code in CARC tabl e and get max adjust ment
	3573	"RTN","RCD PEAD",185, 0)
	3574	. S RCDAT A=$$ACTCAR C(RCCODE)
	3575	"RTN","RCD PEAD",186, 0)
	3576	. ;
	3577	"RTN","RCD PEAD",187, 0)
	3578	. ; Quit If auto de crease is not active on this c ode
	3579	"RTN","RCD PEAD",188, 0)
	3580	. Q:+RCDA TA=0
	3581	"RTN","RCD PEAD",189, 0)
	3582	. ;
	3583	"RTN","RCD PEAD",190, 0)
	3584	. ; Get c ode inacti ve date if it exists
	3585	"RTN","RCD PEAD",191, 0)
	3586	. S XIEN= $$FIND1^DI C(345,,"O" ,RCCODE)
	3587	"RTN","RCD PEAD",192, 0)
	3588	. S:$G(XI EN)'="" XD T=$$GET1^D IQ(345,XIE N_",",2,"I ")
	3589	"RTN","RCD PEAD",193, 0)
	3590	. I $G(XD T)'="" S:X DT'<DT XDT =""
	3591	"RTN","RCD PEAD",194, 0)
	3592	. S RCTAM T=$P(RCDAT A,U,2) ; Get limit
	3593	"RTN","RCD PEAD",195, 0)
	3594	. ;
	3595	"RTN","RCD PEAD",196, 0)
	3596	. ; 11/11 /2015: Com pare the m ax adjustm ent in par ameters to the adjus tment on E EOB
	3597	"RTN","RCD PEAD",197, 0)
	3598	. ; Quit if over
	3599	"RTN","RCD PEAD",198, 0)
	3600	. ;
	3601	"RTN","RCD PEAD",199, 0)
	3602	. ; If th e CARC pay er adjustm ent <= CAR C max adju stment amo unt, Then add to lis t
	3603	"RTN","RCD PEAD",200, 0)
	3604	. ; for p ossible ad justments.
	3605	"RTN","RCD PEAD",201, 0)
	3606	. I RCCAM T<(RCTAMT+ .01) D
	3607	"RTN","RCD PEAD",202, 0)
	3608	. . ;
	3609	"RTN","RCD PEAD",203, 0)
	3610	. . ; If we're bein g called f rom the au to-decreas e report, return all CARC info rmation
	3611	"RTN","RCD PEAD",204, 0)
	3612	. . I FRO MADP D Q
	3613	"RTN","RCD PEAD",205, 0)
	3614	. . . S X X=RCCAMT_" ;"_RCCODE_ ";"_$P(RCI TEM,";",3, 4)
	3615	"RTN","RCD PEAD",206, 0)
	3616	. . . S R CAMT=$S(RC AMT'[";":X X,1:RCAMT_ "^"_XX)
	3617	"RTN","RCD PEAD",207, 0)
	3618	. . S RCA MT=$S($L(R CAMT)=0:RC CAMT_";"_R CCODE_";"_ XDT,1:RCAM T_U_RCCAMT _";"_RCCOD E_";"_XDT)
	3619	"RTN","RCD PEAD",208, 0)
	3620	Q RCAMT
	3621	"RTN","RCD PEAD",209, 0)
	3622	;
	3623	"RTN","RCD PEAD",210, 0)
	3624	GETCARCS(R CEOB,RCCOD ES,FROMADP ) ; Extrac t the CARC s from an EOB at cla im and lin e levels
	3625	"RTN","RCD PEAD",211, 0)
	3626	; Input: RCEOB - Internal IEN for t he explana tion of be nefits fie ld (361.1)
	3627	"RTN","RCD PEAD",212, 0)
	3628	; FROMADP - 1 if bei ng called from COMPI LE^RCDPEAD 1, 0 other wise
	3629	"RTN","RCD PEAD",213, 0)
	3630	; Optional , default to 0
	3631	"RTN","RCD PEAD",214, 0)
	3632	; Output: RCCODES - ^ delimi tted strin g of CARC code infor mation fro m the
	3633	"RTN","RCD PEAD",215, 0)
	3634	; claim and claim ine levels for the s pecified E OB
	3635	"RTN","RCD PEAD",216, 0)
	3636	; ^A1;A2 ;A3;A4^A1; A2;A3;A4^. .. Where
	3637	"RTN","RCD PEAD",217, 0)
	3638	; A1 - CARC code
	3639	"RTN","RCD PEAD",218, 0)
	3640	; A2 - Auto Decr ease Amoun t
	3641	"RTN","RCD PEAD",219, 0)
	3642	; A3 - Quantity (onl y returned if FROMAD P=1)
	3643	"RTN","RCD PEAD",220, 0)
	3644	; A4 - REASON (onl y returned if FROMAD P=1)
	3645	"RTN","RCD PEAD",221, 0)
	3646	N IENS,RC AMT,QUANT, REASON,RCC ODE,RCI,RC J,RCL
	3647	"RTN","RCD PEAD",222, 0)
	3648	S:'$D(FRO MADP) FROM ADP=0
	3649	"RTN","RCD PEAD",223, 0)
	3650	S RCI=0,R CCODES=""
	3651	"RTN","RCD PEAD",224, 0)
	3652	;
	3653	"RTN","RCD PEAD",225, 0)
	3654	; Get to the Codes at the cla im level
	3655	"RTN","RCD PEAD",226, 0)
	3656	F D Q:' RCI
	3657	"RTN","RCD PEAD",227, 0)
	3658	. S RCI=$ O(^IBM(361 .1,RCEOB,1 0,RCI))
	3659	"RTN","RCD PEAD",228, 0)
	3660	. Q:'RCI
	3661	"RTN","RCD PEAD",229, 0)
	3662	. S RCJ=0
	3663	"RTN","RCD PEAD",230, 0)
	3664	. F D Q :'RCJ
	3665	"RTN","RCD PEAD",231, 0)
	3666	. . S RCJ =$O(^IBM(3 61.1,RCEOB ,10,RCI,1, RCJ))
	3667	"RTN","RCD PEAD",232, 0)
	3668	. . Q:'RC J
	3669	"RTN","RCD PEAD",233, 0)
	3670	. . S IEN S=RCJ_","_ RCI_","_RC EOB_","
	3671	"RTN","RCD PEAD",234, 0)
	3672	. . S RCC ODE=$$GET1 ^DIQ(361.1 11,IENS,.0 1,"I") ; C ARC Code
	3673	"RTN","RCD PEAD",235, 0)
	3674	. . Q:RCC ODE=""
	3675	"RTN","RCD PEAD",236, 0)
	3676	. . S RCA MT=$$GET1^ DIQ(361.11 1,IENS,.02 ,"I") ; C ARC Amount
	3677	"RTN","RCD PEAD",237, 0)
	3678	. . I 'FR OMADP S RC CODES=RCCO DES_"^"_RC CODE_";"_R CAMT Q
	3679	"RTN","RCD PEAD",238, 0)
	3680	. . S QUA NT=$$GET1^ DIQ(361.11 1,IENS,.03 ,"I") ; C ARC Quanti ty
	3681	"RTN","RCD PEAD",239, 0)
	3682	. . S REA SON=$$GET1 ^DIQ(361.1 11,IENS,.0 4,"I") ; C ARC Reason
	3683	"RTN","RCD PEAD",240, 0)
	3684	. . S:$L( REASON)>30 REASON=$E (REASON,1, 27)_"..."
	3685	"RTN","RCD PEAD",241, 0)
	3686	. . S RCC ODES=RCCOD ES_"^"_RCC ODE_";"_RC AMT_";"_QU ANT_";"_RE ASON
	3687	"RTN","RCD PEAD",242, 0)
	3688	;
	3689	"RTN","RCD PEAD",243, 0)
	3690	; Get Cla im Line le vel CARCs
	3691	"RTN","RCD PEAD",244, 0)
	3692	S RCL=0
	3693	"RTN","RCD PEAD",245, 0)
	3694	F D Q:+ RCL=0
	3695	"RTN","RCD PEAD",246, 0)
	3696	. S RCL=$ O(^IBM(361 .1,RCEOB,1 5,RCL))
	3697	"RTN","RCD PEAD",247, 0)
	3698	. Q:+RCL= 0
	3699	"RTN","RCD PEAD",248, 0)
	3700	. S RCI=0
	3701	"RTN","RCD PEAD",249, 0)
	3702	. F D Q :+RCI=0
	3703	"RTN","RCD PEAD",250, 0)
	3704	. . S RCI =$O(^IBM(3 61.1,RCEOB ,15,RCL,1, RCI))
	3705	"RTN","RCD PEAD",251, 0)
	3706	. . Q:+RC I=0
	3707	"RTN","RCD PEAD",252, 0)
	3708	. . S RCJ =0
	3709	"RTN","RCD PEAD",253, 0)
	3710	. . F D Q:+RCJ=0
	3711	"RTN","RCD PEAD",254, 0)
	3712	. . . S R CJ=$O(^IBM (361.1,RCE OB,15,RCL, 1,RCI,1,RC J))
	3713	"RTN","RCD PEAD",255, 0)
	3714	. . . Q:+ RCJ=0
	3715	"RTN","RCD PEAD",256, 0)
	3716	. . . S I ENS=RCJ_", "_RCI_","_ RCL_","_RC EOB_","
	3717	"RTN","RCD PEAD",257, 0)
	3718	. . . S R CCODE=$$GE T1^DIQ(361 .11511,IEN S,.01,"I") ; CARC Co de
	3719	"RTN","RCD PEAD",258, 0)
	3720	. . . Q:R CCODE=""
	3721	"RTN","RCD PEAD",259, 0)
	3722	. . . S R CAMT=$$GET 1^DIQ(361. 11511,IENS ,.02,"I") ; CARC Am ount
	3723	"RTN","RCD PEAD",260, 0)
	3724	. . . I ' FROMADP S RCCODES=RC CODES_"^"_ RCCODE_";" _RCAMT Q
	3725	"RTN","RCD PEAD",261, 0)
	3726	. . . S Q UANT=$$GET 1^DIQ(361. 11511,IENS ,.03,"I") ; CARC Qu antity
	3727	"RTN","RCD PEAD",262, 0)
	3728	. . . S R EASON=$$GE T1^DIQ(361 .11511,IEN S,.04,"I") ; CARC Re ason
	3729	"RTN","RCD PEAD",263, 0)
	3730	. . . S:$ L(REASON)> 30 REASON= $E(REASON, 1,27)_"... "
	3731	"RTN","RCD PEAD",264, 0)
	3732	. . . S R CCODES=RCC ODES_"^"_R CCODE_";"_ RCAMT_";"_ QUANT_";"_ REASON
	3733	"RTN","RCD PEAD",265, 0)
	3734	Q
	3735	"RTN","RCD PEAD",266, 0)
	3736	;
	3737	"RTN","RCD PEAD",267, 0)
	3738	; PRCA4. 5304 - Ad ded functi on
	3739	"RTN","RCD PEAD",268, 0)
	3740	ACTCARC(CO DE) ; Is t his CARC a n active c ode for au to-decreas e
	3741	"RTN","RCD PEAD",269, 0)
	3742	; Input: CODE - CARC cod e being ch ecked
	3743	"RTN","RCD PEAD",270, 0)
	3744	; Returns : '0^NOT A CTIVE' if not active
	3745	"RTN","RCD PEAD",271, 0)
	3746	; '1^{amou nt}' if ac tive and t he second peice is t he decreas e amount
	3747	"RTN","RCD PEAD",272, 0)
	3748	N AIEN,XX
	3749	"RTN","RCD PEAD",273, 0)
	3750	I $G(CODE )="" Q "0^ NOT ACTIVE "
	3751	"RTN","RCD PEAD",274, 0)
	3752	S AIEN=$O (^RCY(344. 62,"B",COD E,""))
	3753	"RTN","RCD PEAD",275, 0)
	3754	I AIEN="" Q "0^NOT ACTIVE"
	3755	"RTN","RCD PEAD",276, 0)
	3756	S XX=$$GE T1^DIQ(344 .62,AIEN,. 02,"I") ; Quit if auto-d ecrease is off
	3757	"RTN","RCD PEAD",277, 0)
	3758	I XX=1 Q "1^"_$$GET 1^DIQ(344. 62,AIEN,.0 6) ; Acti ve code re turns maxi mum allowe d decrease amount
	3759	"RTN","RCD PEAD",278, 0)
	3760	Q "0^NOT ACTIVE"
	3761	"RTN","RCD PEAD",279, 0)
	3762	;
	3763	"RTN","RCD PEAD1")
	3764	0^26^B6786 9816^n/a
	3765	"RTN","RCD PEAD1",1,0 )
	3766	RCDPEAD1 ; OI D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	3767	"RTN","RCD PEAD1",2,0 )
	3768	;;4.5;Acc ounts Rece ivable;2 98,317,318 ;Mar 20, 1995;Buil d 25
	3769	"RTN","RCD PEAD1",3,0 )
	3770	;;Per VA Directive 6402, this routine s hould not be modifie d.
	3771	"RTN","RCD PEAD1",4,0 )
	3772	;
	3773	"RTN","RCD PEAD1",5,0 )
	3774	CARCS(A1,A 2,A3,CARCS ) ; Get CA RC Auto-De crease dat a
	3775	"RTN","RCD PEAD1",6,0 )
	3776	; Input: A1 - "EXCEL" if exporting to excel
	3777	"RTN","RCD PEAD1",7,0 )
	3778	; Internal f ileman dat e if not e xporting t o excel
	3779	"RTN","RCD PEAD1",8,0 )
	3780	; A2 - Excel Line Counter i f exportin g to excel
	3781	"RTN","RCD PEAD1",9,0 )
	3782	; External C laim numbe r is sorti ng by clai m
	3783	"RTN","RCD PEAD1",10, 0)
	3784	; External P ayer Name if sorting by Payer
	3785	"RTN","RCD PEAD1",11, 0)
	3786	; External P atient Nam e if sorti ng by Pati ent Name
	3787	"RTN","RCD PEAD1",12, 0)
	3788	; A3 - Record Cou nter
	3789	"RTN","RCD PEAD1",13, 0)
	3790	; CARCS - ^ delimite d string o f CARC inf ormation
	3791	"RTN","RCD PEAD1",14, 0)
	3792	; See SAVE f or a compl ete descri ption
	3793	"RTN","RCD PEAD1",15, 0)
	3794	; Output: ^TMP("RC DPEADP",$J ,A1,A2,A3, A4) - C1^C 2^C3^C4 Wh ere:
	3795	"RTN","RCD PEAD1",16, 0)
	3796	; - A1 - "EXCE L" if expo rting to e xcel
	3797	"RTN","RCD PEAD1",17, 0)
	3798	; Inte rnal filem an date if not expor ting to ex cel
	3799	"RTN","RCD PEAD1",18, 0)
	3800	; A2 - Excel Line Coun ter if exp orting to excel
	3801	"RTN","RCD PEAD1",19, 0)
	3802	; Exter nal Claim number is sorting by claim
	3803	"RTN","RCD PEAD1",20, 0)
	3804	; Exter nal Payer Name if so rting by P ayer
	3805	"RTN","RCD PEAD1",21, 0)
	3806	; Exter nal Patien t Name if sorting by Patient N ame
	3807	"RTN","RCD PEAD1",22, 0)
	3808	; A3 - Recor d Counter
	3809	"RTN","RCD PEAD1",23, 0)
	3810	; A4 - CARC Counter
	3811	"RTN","RCD PEAD1",24, 0)
	3812	; C1 - CARC Code (file 361.111, field .01)
	3813	"RTN","RCD PEAD1",25, 0)
	3814	; C2 - Decre ase Amount (file 361 .111, fiel d .02)
	3815	"RTN","RCD PEAD1",26, 0)
	3816	; C3 - Quant ity (file 361.111, f ield .03)
	3817	"RTN","RCD PEAD1",27, 0)
	3818	; C4 - Reaso n (file 36 1.111, fie ld .04)
	3819	"RTN","RCD PEAD1",28, 0)
	3820	N AMT,CAR C,CCTR,OCA RC,QUANT,R EASON,XX
	3821	"RTN","RCD PEAD1",29, 0)
	3822	;
	3823	"RTN","RCD PEAD1",30, 0)
	3824	; Loop th rough all of the val id CARCs f ound in th e EOB reco rd
	3825	"RTN","RCD PEAD1",31, 0)
	3826	F CCTR=1: 1:$L(CARCS ,"^") D
	3827	"RTN","RCD PEAD1",32, 0)
	3828	. S OCARC =$P(CARCS, "^",CCTR)
	3829	"RTN","RCD PEAD1",33, 0)
	3830	. S CARC= $P(OCARC," ;",2) ; CARC Code
	3831	"RTN","RCD PEAD1",34, 0)
	3832	. S AMT=$ P(OCARC,"; ",1) ; Amou nt
	3833	"RTN","RCD PEAD1",35, 0)
	3834	. S QUANT =$P(OCARC, ";",3) ; Quan tity
	3835	"RTN","RCD PEAD1",36, 0)
	3836	. S REASO N=$P(OCARC ,";",4) ; Reas on Text
	3837	"RTN","RCD PEAD1",37, 0)
	3838	. S XX=CA RC_"^"_AMT _"^"_QUANT _"^"_REASO N
	3839	"RTN","RCD PEAD1",38, 0)
	3840	. S ^TMP( "RCDPEADP" ,$J,A1,A2, A3,CCTR)=X X
	3841	"RTN","RCD PEAD1",39, 0)
	3842	Q
	3843	"RTN","RCD PEAD1",40, 0)
	3844	;
	3845	"RTN","RCD PEAD1",41, 0)
	3846	COMPILE(IN PUTS,RCVAU TD,DTOTAL, GTOTAL) ; EP Generat e the Auto -Decrease report ^TM P array
	3847	"RTN","RCD PEAD1",42, 0)
	3848	; Input: INPUTS - A1^A2^A3 ^...^An Wh ere:
	3849	"RTN","RCD PEAD1",43, 0)
	3850	; A1 - 1 - All divisions selected
	3851	"RTN","RCD PEAD1",44, 0)
	3852	; 2 - Sele cted divis ions
	3853	"RTN","RCD PEAD1",45, 0)
	3854	; A2 - C - Sort by Claim
	3855	"RTN","RCD PEAD1",46, 0)
	3856	; P - Sort by Payer
	3857	"RTN","RCD PEAD1",47, 0)
	3858	; N - Sort by Patien t Name
	3859	"RTN","RCD PEAD1",48, 0)
	3860	; A3 - F - Firs t to Last Sort Order
	3861	"RTN","RCD PEAD1",49, 0)
	3862	; L - Last to First Sort Order
	3863	"RTN","RCD PEAD1",50, 0)
	3864	; A4 - B1\|B2
	3865	"RTN","RCD PEAD1",51, 0)
	3866	; B1 - Auto -Post Star t Date
	3867	"RTN","RCD PEAD1",52, 0)
	3868	; B2 - Auto -Post End Date
	3869	"RTN","RCD PEAD1",53, 0)
	3870	; A5 - 1 - Outpu t to Excel
	3871	"RTN","RCD PEAD1",54, 0)
	3872	; 2 - Other wise
	3873	"RTN","RCD PEAD1",55, 0)
	3874	; RCVAUTD - Arra y of selec ted Divisi ons
	3875	"RTN","RCD PEAD1",56, 0)
	3876	; Only passed if A1=2
	3877	"RTN","RCD PEAD1",57, 0)
	3878	; Output: DTOTAL() - Array of totals by Auto-Po st Date
	3879	"RTN","RCD PEAD1",58, 0)
	3880	; GTOTAL - Grand totals
	3881	"RTN","RCD PEAD1",59, 0)
	3882	; ^TMP("RC DPEADP",$J ) - Array of report data
	3883	"RTN","RCD PEAD1",60, 0)
	3884	; See SA VE for a f ull descri ption
	3885	"RTN","RCD PEAD1",61, 0)
	3886	N ADDATE, CARCS,END, ERAIEN,EOB IEN,EXCEL, RCTR,RCRZ, RCSORT,STA ,STNAM,STN UM,XX
	3887	"RTN","RCD PEAD1",62, 0)
	3888	;
	3889	"RTN","RCD PEAD1",63, 0)
	3890	S XX=$P(I NPUTS,"^", 4) ; Auto -Post Date range
	3891	"RTN","RCD PEAD1",64, 0)
	3892	S ADDATE= $$FMADD^XL FDT($P(XX, "\|",1),-1)
	3893	"RTN","RCD PEAD1",65, 0)
	3894	S END=$P( XX,"\|",2) ; Auto -Post End Date
	3895	"RTN","RCD PEAD1",66, 0)
	3896	S RCTR=0 ; Reco rd counter
	3897	"RTN","RCD PEAD1",67, 0)
	3898	S EXCEL=$ P(INPUTS," ^",5) ; 1 ou tput to Ex cel, 0 oth erwise
	3899	"RTN","RCD PEAD1",68, 0)
	3900	S RCSORT= $P(INPUTS, "^",2) ; Sort Type
	3901	"RTN","RCD PEAD1",69, 0)
	3902	;
	3903	"RTN","RCD PEAD1",70, 0)
	3904	; ^RCY(34 4.4,0) = " ELECTRONIC REMITTANC E ADVICE^3 44.4I^"
	3905	"RTN","RCD PEAD1",71, 0)
	3906	; G cross-ref . REGULA R WHOLE FILE (#34 4.4)
	3907	"RTN","RCD PEAD1",72, 0)
	3908	; F ield: AUT O-POST DAT E (344.41 ,9)
	3909	"RTN","RCD PEAD1",73, 0)
	3910	; Scan G index for ERA within date rang e
	3911	"RTN","RCD PEAD1",74, 0)
	3912	F S ADDA TE=$O(^RCY (344.4,"G" ,ADDATE)) Q:'ADDATE Q:(ADDATE \1)>END D
	3913	"RTN","RCD PEAD1",75, 0)
	3914	. S ERAIE N=""
	3915	"RTN","RCD PEAD1",76, 0)
	3916	. F D Q :'ERAIEN
	3917	"RTN","RCD PEAD1",77, 0)
	3918	. . S ERA IEN=$O(^RC Y(344.4,"G ",ADDATE,E RAIEN))
	3919	"RTN","RCD PEAD1",78, 0)
	3920	. . Q:'ER AIEN
	3921	"RTN","RCD PEAD1",79, 0)
	3922	. . D ERA STA(ERAIEN ,.STA,.STN UM,.STNAM) ; Check for valid Divi sion
	3923	"RTN","RCD PEAD1",80, 0)
	3924	. . I $P( INPUTS,"^" ,1)=2,'$D( RCVAUTD(ST A)) Q ; Not a vali d Division
	3925	"RTN","RCD PEAD1",81, 0)
	3926	. . ;
	3927	"RTN","RCD PEAD1",82, 0)
	3928	. . ; Sca n index fo r auto-dec reased cla im lines w ithin the ERA
	3929	"RTN","RCD PEAD1",83, 0)
	3930	. . ; and Save clai m line det ail to ^TM P global
	3931	"RTN","RCD PEAD1",84, 0)
	3932	. . S RCR Z=""
	3933	"RTN","RCD PEAD1",85, 0)
	3934	. . F D Q:'RCRZ
	3935	"RTN","RCD PEAD1",86, 0)
	3936	. . . S R CRZ=$O(^RC Y(344.4,"G ",ADDATE,E RAIEN,RCRZ ))
	3937	"RTN","RCD PEAD1",87, 0)
	3938	. . . Q:' RCRZ
	3939	"RTN","RCD PEAD1",88, 0)
	3940	. . . S E OBIEN=$$GE T1^DIQ(344 .41,RCRZ_" ,"_ERAIEN_ ",",.02,"I ")
	3941	"RTN","RCD PEAD1",89, 0)
	3942	. . . ;
	3943	"RTN","RCD PEAD1",90, 0)
	3944	. . . ; F ind all Cl aim level and Claim line level CARCs
	3945	"RTN","RCD PEAD1",91, 0)
	3946	. . . S C ARCS=$$CAR CLMT^RCDPE AD(EOBIEN, 1,ADDATE)
	3947	"RTN","RCD PEAD1",92, 0)
	3948	. . . Q:+ CARCS=0 ; No CARCs f ound
	3949	"RTN","RCD PEAD1",93, 0)
	3950	. . . D S AVE^RCDPEA DP(ADDATE, ERAIEN,RCR Z,EXCEL,RC SORT,CARCS ,.RCTR,STN AM,STNUM)
	3951	"RTN","RCD PEAD1",94, 0)
	3952	Q
	3953	"RTN","RCD PEAD1",95, 0)
	3954	;
	3955	"RTN","RCD PEAD1",96, 0)
	3956	ERASTA(ERA IEN,STA,ST NUM,STNAM) ; Get the station f or this ER A
	3957	"RTN","RCD PEAD1",97, 0)
	3958	; Input: ERAIEN - Internal IEN for f ile 344.4
	3959	"RTN","RCD PEAD1",98, 0)
	3960	; Output: STA - Internal Station I EN
	3961	"RTN","RCD PEAD1",99, 0)
	3962	; STNUM - Station Number
	3963	"RTN","RCD PEAD1",100 ,0)
	3964	; STNAM - Station Name
	3965	"RTN","RCD PEAD1",101 ,0)
	3966	N ERAEOB, ERABILL,ST AIEN
	3967	"RTN","RCD PEAD1",102 ,0)
	3968	S (ERAEOB ,ERABILL)= ""
	3969	"RTN","RCD PEAD1",103 ,0)
	3970	S (STA,ST NUM,STNAM) ="UNKNOWN"
	3971	"RTN","RCD PEAD1",104 ,0)
	3972	S ERAEOB= $$GET1^DIQ (344.41,"1 ,"_ERAIEN_ ",",.02,"I ")
	3973	"RTN","RCD PEAD1",105 ,0)
	3974	Q:'ERAEOB
	3975	"RTN","RCD PEAD1",106 ,0)
	3976	S ERABILL =$$GET1^DI Q(361.1,ER AEOB,.01," I")
	3977	"RTN","RCD PEAD1",107 ,0)
	3978	Q:'ERABIL L
	3979	"RTN","RCD PEAD1",108 ,0)
	3980	S STAIEN= $$GET1^DIQ (399,ERABI LL,.22,"I" )
	3981	"RTN","RCD PEAD1",109 ,0)
	3982	Q:'STAIEN
	3983	"RTN","RCD PEAD1",110 ,0)
	3984	S STA=STA IEN
	3985	"RTN","RCD PEAD1",111 ,0)
	3986	S STNAM=$ $EXTERNAL^ DILFD(399, .22,,STA)
	3987	"RTN","RCD PEAD1",112 ,0)
	3988	S STNUM=$ $GET1^DIQ( 40.8,STAIE N,1,"I")
	3989	"RTN","RCD PEAD1",113 ,0)
	3990	Q
	3991	"RTN","RCD PEAD1",114 ,0)
	3992	;
	3993	"RTN","RCD PEAD1",115 ,0)
	3994	HDR(EXCEL, HDRINFO,PA GE,NOLINE) ; Print t he report header
	3995	"RTN","RCD PEAD1",116 ,0)
	3996	; Input: EXCEL - 1 if output to Excel, 0 otherwise
	3997	"RTN","RCD PEAD1",117 ,0)
	3998	; HDRINFO( ) - Arra y of Heade r informat ion
	3999	"RTN","RCD PEAD1",118 ,0)
	4000	; PAGE - Curr ent Page N umber
	4001	"RTN","RCD PEAD1",119 ,0)
	4002	; NOLINE - 1 to not displ ay Claim l ine header
	4003	"RTN","RCD PEAD1",120 ,0)
	4004	; Opti onal, defa ults to 0
	4005	"RTN","RCD PEAD1",121 ,0)
	4006	; Output: PAGE - Upda ted Page N umber (if EXCEL=0)
	4007	"RTN","RCD PEAD1",122 ,0)
	4008	N DIV,MSG ,SUB,XX,Y, Z0,Z1
	4009	"RTN","RCD PEAD1",123 ,0)
	4010	S:'$D(NOL INE) NOLIN E=0
	4011	"RTN","RCD PEAD1",124 ,0)
	4012	I EXCEL D Q
	4013	"RTN","RCD PEAD1",125 ,0)
	4014	. W !,"ST ATION^STAT ION NUMBER ^CLAIM #^P ATIENT NAM E^PAYER^DE CREASE AMO UNT^DATE^C ARC"
	4015	"RTN","RCD PEAD1",126 ,0)
	4016	. W "^DEC REASE AMT^ #^REASON"
	4017	"RTN","RCD PEAD1",127 ,0)
	4018	;
	4019	"RTN","RCD PEAD1",128 ,0)
	4020	S PAGE=PA GE+1
	4021	"RTN","RCD PEAD1",129 ,0)
	4022	W @IOF
	4023	"RTN","RCD PEAD1",130 ,0)
	4024	S MSG(1)= " EDI Lock box Auto-D ecrease Ad justment R eport "
	4025	"RTN","RCD PEAD1",131 ,0)
	4026	S MSG(1)= MSG(1)_" Page: "_PAGE
	4027	"RTN","RCD PEAD1",132 ,0)
	4028	S MSG(2)= " Run D ate: "_HDR INFO("RUND ATE")
	4029	"RTN","RCD PEAD1",133 ,0)
	4030	S Z0="Div isions: "_ HDRINFO("D IVISIONS")
	4031	"RTN","RCD PEAD1",134 ,0)
	4032	S MSG(3)= $S($L(Z0)< 75:$J("",7 5-$L(Z0)\2 ),1:"")_Z0
	4033	"RTN","RCD PEAD1",135 ,0)
	4034	S XX=" (D ate Decrea se Applied )"
	4035	"RTN","RCD PEAD1",136 ,0)
	4036	S MSG(4)= " Date Range: "_ HDRINFO("S TART")_" - "_HDRINFO ("END")_XX
	4037	"RTN","RCD PEAD1",137 ,0)
	4038	S MSG(5)= " "_H DRINFO("SO RT")
	4039	"RTN","RCD PEAD1",138 ,0)
	4040	S MSG(6)= ""
	4041	"RTN","RCD PEAD1",139 ,0)
	4042	I 'NOLINE D
	4043	"RTN","RCD PEAD1",140 ,0)
	4044	. S MSG(7 )="Claim # Pat ient Name P ayer Dec rease Amt Date "
	4045	"RTN","RCD PEAD1",141 ,0)
	4046	. S MSG(8 )="======= ========== ========== ========== ========== ========== ========== ========="
	4047	"RTN","RCD PEAD1",142 ,0)
	4048	D EN^DDIO L(.MSG)
	4049	"RTN","RCD PEAD1",143 ,0)
	4050	Q
	4051	"RTN","RCD PEAD1",144 ,0)
	4052	;
	4053	"RTN","RCD PEAD1",145 ,0)
	4054	HINFO(INPU TS,HDRINFO ) ;Get hea der inform ation
	4055	"RTN","RCD PEAD1",146 ,0)
	4056	; Input: INPUTS - See REPORT^RC DPEADP for a complet e descript ion
	4057	"RTN","RCD PEAD1",147 ,0)
	4058	; HDRINFO - Ret urn array - passed b y referenc e
	4059	"RTN","RCD PEAD1",148 ,0)
	4060	; Output: HDRINFO - For matted hea der array for ListMa n
	4061	"RTN","RCD PEAD1",149 ,0)
	4062	N XX
	4063	"RTN","RCD PEAD1",150 ,0)
	4064	S XX=$P(I NPUTS,"^", 4) ; Auto -Post Date range
	4065	"RTN","RCD PEAD1",151 ,0)
	4066	S HDRINFO ("START")= $$FMTE^XLF DT($P(XX," \|",1),"2SZ ")
	4067	"RTN","RCD PEAD1",152 ,0)
	4068	S HDRINFO ("END")=$$ FMTE^XLFDT ($P(XX,"\|" ,2),"2SZ")
	4069	"RTN","RCD PEAD1",153 ,0)
	4070	S HDRINFO ("RUNDATE" )=$$FMTE^X LFDT($$NOW ^XLFDT,"2S Z")
	4071	"RTN","RCD PEAD1",154 ,0)
	4072	s XX=$P(I NPUTS,"^", 2) ; Sort Type
	4073	"RTN","RCD PEAD1",155 ,0)
	4074	S HDRINFO ("SORT")=" SORTED BY: "_$S(XX=" C":"CLAIM" ,XX="P":"P AYER",1:"P ATIENT NAM E")
	4075	"RTN","RCD PEAD1",156 ,0)
	4076	S XX=$S($ P(INPUTS," ^",3)="L": "LAST TO F IRST",1:"F IRST TO LA ST")
	4077	"RTN","RCD PEAD1",157 ,0)
	4078	S HDRINFO ("SORT")=H DRINFO("SO RT")_" - " _XX
	4079	"RTN","RCD PEAD1",158 ,0)
	4080	; Format Division f ilter
	4081	"RTN","RCD PEAD1",159 ,0)
	4082	S XX=$P(I NPUTS,"^", 1) ; XX=1 - All Div isions, 2- selected
	4083	"RTN","RCD PEAD1",160 ,0)
	4084	S HDRINFO ("DIVISION S")=$S(XX= 2:$$LINE^R CDPEADP(.R CVAUTD),1: "ALL")
	4085	"RTN","RCD PEAD1",161 ,0)
	4086	Q
	4087	"RTN","RCD PEAD1",162 ,0)
	4088	;
	4089	"RTN","RCD PEAD1",163 ,0)
	4090	LMAN(DATA, A1,A2,A3,X X) ; Forma t and save List Mana ger line
	4091	"RTN","RCD PEAD1",164 ,0)
	4092	; Input: DATA - E RA line ad justment t otal
	4093	"RTN","RCD PEAD1",165 ,0)
	4094	; A1,A2,A3 - ^TMP("R CDPEAP") s ubscripts
	4095	"RTN","RCD PEAD1",166 ,0)
	4096	; XX - Lis t Counter for ^TMP(" RCDPE_ADP" ,$J)
	4097	"RTN","RCD PEAD1",167 ,0)
	4098	N CARCAMT ,CCTR,DATA 1,Y
	4099	"RTN","RCD PEAD1",168 ,0)
	4100	S Y=$E($P (DATA,U,3) ,1,12) ; C laim #
	4101	"RTN","RCD PEAD1",169 ,0)
	4102	S $E(Y,15 )=$E($P(DA TA,U,4),1, 20) ; P atient Nam e
	4103	"RTN","RCD PEAD1",170 ,0)
	4104	S $E(Y,37 )=$E($P(DA TA,U,5),1, 19) ; P ayer Name
	4105	"RTN","RCD PEAD1",171 ,0)
	4106	S $E(Y,55 )=$J($P(DA TA,U,6),12 ,2) ; A uto-Decrea se Amount
	4107	"RTN","RCD PEAD1",172 ,0)
	4108	S $E(Y,69 )=$P(DATA, U,7) ; A uto-Decrea se Date
	4109	"RTN","RCD PEAD1",173 ,0)
	4110	S ^TMP("R CDPE_ADP", $J,XX)=Y,X X=XX+1
	4111	"RTN","RCD PEAD1",174 ,0)
	4112	S ^TMP("R CDPE_ADP", $J,XX)=" " ,XX=XX+1
	4113	"RTN","RCD PEAD1",175 ,0)
	4114	S ^TMP("R CDPE_ADP", $J,XX)=" CARC Decrea se Amt # Reaso n",XX=XX+1
	4115	"RTN","RCD PEAD1",176 ,0)
	4116	S ^TMP("R CDPE_ADP", $J,XX)=" -------- ---------- -- ------ ------- - --- ----- ---------- ---------- ----",XX=X X+1
	4117	"RTN","RCD PEAD1",177 ,0)
	4118	S CCTR=0
	4119	"RTN","RCD PEAD1",178 ,0)
	4120	F S CCTR =$O(^TMP(" RCDPEADP", $J,A1,A2,A 3,CCTR)) Q :'CCTR D
	4121	"RTN","RCD PEAD1",179 ,0)
	4122	. ;Displa y a line f or each CA RC adjustm ent on the line
	4123	"RTN","RCD PEAD1",180 ,0)
	4124	. S DATA1 =$G(^TMP(" RCDPEADP", $J,A1,A2,A 3,CCTR)),C ARCAMT=$P( DATA1,U,2)
	4125	"RTN","RCD PEAD1",181 ,0)
	4126	. S Y=" "_$E($P( DATA1,U,1) ,1,20) ; CARC
	4127	"RTN","RCD PEAD1",182 ,0)
	4128	. S $E(Y, 27)=$J($P( DATA1,U,2) ,12,2) ; Decr ease Amoun t
	4129	"RTN","RCD PEAD1",183 ,0)
	4130	. S $E(Y, 42)=$J($P( DATA1,U,3) ,4) ; Quan tity
	4131	"RTN","RCD PEAD1",184 ,0)
	4132	. S $E(Y, 48)=$E($P( DATA1,U,4) ,1,32) ; Reas on
	4133	"RTN","RCD PEAD1",185 ,0)
	4134	. S ^TMP( "RCDPE_ADP ",$J,XX)=Y ,XX=XX+1
	4135	"RTN","RCD PEAD1",186 ,0)
	4136	S ^TMP("R CDPE_ADP", $J,XX)=" " ,XX=XX+1
	4137	"RTN","RCD PEAD1",187 ,0)
	4138	Q
	4139	"RTN","RCD PEAD1",188 ,0)
	4140	;
	4141	"RTN","RCD PEAD1",189 ,0)
	4142	LMOUT(INPU T,RCVAUTD, IO) ; EP O utput repo rt to List man
	4143	"RTN","RCD PEAD1",190 ,0)
	4144	; Input: INPUT - See REPORT for a complet e descript ion
	4145	"RTN","RCD PEAD1",191 ,0)
	4146	; RCVAUTD - Arr ay of sele cted Divis ions
	4147	"RTN","RCD PEAD1",192 ,0)
	4148	; Onl y passed i f A1=2
	4149	"RTN","RCD PEAD1",193 ,0)
	4150	; IO - Out put device array
	4151	"RTN","RCD PEAD1",194 ,0)
	4152	; Output: ^TMP("RC DPE_LAR",$ J,CTR)=Lin e - Array of display lines (no headers)
	4153	"RTN","RCD PEAD1",195 ,0)
	4154	; for o utput to L istman
	4155	"RTN","RCD PEAD1",196 ,0)
	4156	; Only set when A 7-1
	4157	"RTN","RCD PEAD1",197 ,0)
	4158	N HDR,HDR INFO,XX,Z0
	4159	"RTN","RCD PEAD1",198 ,0)
	4160	D REPORT^ RCDPEADP(I NPUT,.RCVA UTD,.IO) ; Get the li nes to be displayed
	4161	"RTN","RCD PEAD1",199 ,0)
	4162	D HINFO(I NPUT,.HDRI NFO)
	4163	"RTN","RCD PEAD1",200 ,0)
	4164	S HDR("TI TLE")="AUT O-DECREASE REPORT"
	4165	"RTN","RCD PEAD1",201 ,0)
	4166	S HDR(1)= " RUN D ATE: "_HDR INFO("RUND ATE")
	4167	"RTN","RCD PEAD1",202 ,0)
	4168	S Z0="DIV ISIONS: "_ HDRINFO("D IVISIONS")
	4169	"RTN","RCD PEAD1",203 ,0)
	4170	S HDR(2)= $S($L(Z0)< 75:$J("",7 5-$L(Z0)\2 ),1:"")_Z0
	4171	"RTN","RCD PEAD1",204 ,0)
	4172	S XX=" (D ATE DECREA SE APPLIED )"
	4173	"RTN","RCD PEAD1",205 ,0)
	4174	S HDR(3)= " DATE RANGE: "_ HDRINFO("S TART")_" - "_HDRINFO ("END")_XX
	4175	"RTN","RCD PEAD1",206 ,0)
	4176	S HDR(4)= " "_H DRINFO("SO RT")
	4177	"RTN","RCD PEAD1",207 ,0)
	4178	S HDR(5)= ""
	4179	"RTN","RCD PEAD1",208 ,0)
	4180	S HDR(6)= ""
	4181	"RTN","RCD PEAD1",209 ,0)
	4182	S HDR(7)= "CLAIM # PATIE NT NAME PAY ER DECRE ASE AMT D ATE "
	4183	"RTN","RCD PEAD1",210 ,0)
	4184	D LMRPT^R CDPEARL(.H DR,$NA(^TM P("RCDPE_A DP",$J))) ; Generate ListMan d isplay
	4185	"RTN","RCD PEAD1",211 ,0)
	4186	;
	4187	"RTN","RCD PEAD1",212 ,0)
	4188	K ^TMP("R CDPEADP",$ J),^TMP($J ,"RCDPEADP "),^TMP("R CDPE_ADP", $J)
	4189	"RTN","RCD PEAD1",213 ,0)
	4190	Q
	4191	"RTN","RCD PEAD1",214 ,0)
	4192	;
	4193	"RTN","RCD PEAD1",215 ,0)
	4194	TOTALD(EXC EL,HDRINFO ,PAGE,STOP ,DAY,DTOTA L) ; Total s for a si ngle day
	4195	"RTN","RCD PEAD1",216 ,0)
	4196	; Input: EXCEL - 1 if output to Excel, 0 otherwise
	4197	"RTN","RCD PEAD1",217 ,0)
	4198	; HDRINFO( ) - Arra y of heade r informat ion
	4199	"RTN","RCD PEAD1",218 ,0)
	4200	; PAGE - Curr ent Page N umber
	4201	"RTN","RCD PEAD1",219 ,0)
	4202	; DAY - Inte rnal Filem an date to display t otals for
	4203	"RTN","RCD PEAD1",220 ,0)
	4204	; DTOTAL() - Arra y of total s by day
	4205	"RTN","RCD PEAD1",221 ,0)
	4206	; IOSL - Page length
	4207	"RTN","RCD PEAD1",222 ,0)
	4208	; Output: PAGE - Upda ted Page N umber (if a new head er is disp layed)
	4209	"RTN","RCD PEAD1",223 ,0)
	4210	; STOP - 1 if displayin g to scree n and user asked to stop
	4211	"RTN","RCD PEAD1",224 ,0)
	4212	N DAMT,DC NT,Y
	4213	"RTN","RCD PEAD1",225 ,0)
	4214	I 'EXCEL, $Y>(IOSL-4 ) D
	4215	"RTN","RCD PEAD1",226 ,0)
	4216	. D ASK^R CDPEADP(.S TOP,0)
	4217	"RTN","RCD PEAD1",227 ,0)
	4218	. Q:STOP
	4219	"RTN","RCD PEAD1",228 ,0)
	4220	. D HDR(E XCEL,.HDRI NFO,.PAGE)
	4221	"RTN","RCD PEAD1",229 ,0)
	4222	Q:STOP
	4223	"RTN","RCD PEAD1",230 ,0)
	4224	S DCNT=$P (DTOTAL(DA Y),U),DAMT =$P(DTOTAL (DAY),U,2)
	4225	"RTN","RCD PEAD1",231 ,0)
	4226	S Y="**To tals for D ate: "_$$F MTE^XLFDT( DAY,"2Z")
	4227	"RTN","RCD PEAD1",232 ,0)
	4228	S $E(Y,35 )=" # o f Decrease Adjustmen ts: "_DCNT
	4229	"RTN","RCD PEAD1",233 ,0)
	4230	W !!,Y
	4231	"RTN","RCD PEAD1",234 ,0)
	4232	S Y="",$E (Y,28)="To tal Amount of Decrea se Adjustm ents: $"_$ J(DAMT,3,2 )
	4233	"RTN","RCD PEAD1",235 ,0)
	4234	W !,Y
	4235	"RTN","RCD PEAD1",236 ,0)
	4236	Q
	4237	"RTN","RCD PEAD1",237 ,0)
	4238	;
	4239	"RTN","RCD PEAD1",238 ,0)
	4240	;TOTALS ; Print tot als for EX CEL
	4241	"RTN","RCD PEAD1",239 ,0)
	4242	;N DAY,DA MT,DCNT
	4243	"RTN","RCD PEAD1",240 ,0)
	4244	;S DAY=""
	4245	"RTN","RCD PEAD1",241 ,0)
	4246	;F S DAY =$O(DTOTAL (DAY)) Q:' DAY D Q: STOP
	4247	"RTN","RCD PEAD1",242 ,0)
	4248	;.;Day to tals
	4249	"RTN","RCD PEAD1",243 ,0)
	4250	;.D TOTAL D(DAY)
	4251	"RTN","RCD PEAD1",244 ,0)
	4252	;;Grand t otals
	4253	"RTN","RCD PEAD1",245 ,0)
	4254	;D TOTALG
	4255	"RTN","RCD PEAD1",246 ,0)
	4256	;Q
	4257	"RTN","RCD PEAD1",247 ,0)
	4258	;
	4259	"RTN","RCD PEAD1",248 ,0)
	4260	TOTALG(EXC EL,HDRINFO ,PAGE,GTOT AL,STOP) ; Overall r eport tota l
	4261	"RTN","RCD PEAD1",249 ,0)
	4262	; Input: EXCEL - 1 if output to Excel, 0 otherwise
	4263	"RTN","RCD PEAD1",250 ,0)
	4264	; HDRINFO( ) - Arra y of heade r informat ion
	4265	"RTN","RCD PEAD1",251 ,0)
	4266	; PAGE - Curr ent Page N umber
	4267	"RTN","RCD PEAD1",252 ,0)
	4268	; GTOTAL() - Gran d Totals f or report
	4269	"RTN","RCD PEAD1",253 ,0)
	4270	; IOSL - Page length
	4271	"RTN","RCD PEAD1",254 ,0)
	4272	; Output: PAGE - Upda ted Page N umber (if a new head er is disp layed)
	4273	"RTN","RCD PEAD1",255 ,0)
	4274	N Y
	4275	"RTN","RCD PEAD1",256 ,0)
	4276	I 'EXCEL, $Y>(IOSL-6 ) D
	4277	"RTN","RCD PEAD1",257 ,0)
	4278	. D ASK^R CDPEADP(.S TOP,0)
	4279	"RTN","RCD PEAD1",258 ,0)
	4280	. Q:STOP
	4281	"RTN","RCD PEAD1",259 ,0)
	4282	. D HDR(E XCEL,.HDRI NFO,.PAGE)
	4283	"RTN","RCD PEAD1",260 ,0)
	4284	Q:STOP
	4285	"RTN","RCD PEAD1",261 ,0)
	4286	W !!,"*** * Totals f or Date Ra nge: # of Decrease A djustments : "_+$P(GT OTAL,U,1)
	4287	"RTN","RCD PEAD1",262 ,0)
	4288	S Y="",$E (Y,28)="To tal Amount of Decrea se Adjustm ents: $"_$ J((+$P(GTO TAL,U,2)), 3,2)
	4289	"RTN","RCD PEAD1",263 ,0)
	4290	W !,Y,!
	4291	"RTN","RCD PEAD1",264 ,0)
	4292	Q
	4293	"RTN","RCD PEAD1",265 ,0)
	4294	;
	4295	"RTN","RCD PEADP")
	4296	0^27^B1564 76063^B828 56652
	4297	"RTN","RCD PEADP",1,0 )
	4298	RCDPEADP ; OI D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	4299	"RTN","RCD PEADP",2,0 )
	4300	;;4.5;Acc ounts Rece ivable;2 98,317,318 ;Mar 20, 1995;Buil d 25
	4301	"RTN","RCD PEADP",3,0 )
	4302	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4303	"RTN","RCD PEADP",4,0 )
	4304	; Read ^D GCR(399) via Pr ivate IA 3 820
	4305	"RTN","RCD PEADP",5,0 )
	4306	; Read ^D G(40.8) via Co ntrolled I A 417
	4307	"RTN","RCD PEADP",6,0 )
	4308	; Read ^I BM(361.1) via Pr ivate IA 4 051
	4309	"RTN","RCD PEADP",7,0 )
	4310	; Use DIV ISION^VAUT OMA via Co ntrolled I A 664
	4311	"RTN","RCD PEADP",8,0 )
	4312	;
	4313	"RTN","RCD PEADP",9,0 )
	4314	RPT ; entr y point fo r Auto-Dec rease Adju stment rep ort [RCDPE AUTO-DECR EASE REPOR T]
	4315	"RTN","RCD PEADP",10, 0)
	4316	N INPUT,R CVAUTD
	4317	"RTN","RCD PEADP",11, 0)
	4318	S INPUT=$ $STADIV(.R CVAUTD) ; Di vision fil ter
	4319	"RTN","RCD PEADP",12, 0)
	4320	Q:'INPUT ; '^ ' or timeo ut
	4321	"RTN","RCD PEADP",13, 0)
	4322	S $P(INPU T,"^",2)=$ $ASKSORT() ; Se lect Sort Criteria
	4323	"RTN","RCD PEADP",14, 0)
	4324	Q:$P(INPU T,"^",2)=" 0" ; '^ ' or timeo ut
	4325	"RTN","RCD PEADP",15, 0)
	4326	S $P(INPU T,"^",3)=$ $SORTORD($ P(INPUT,"^ ",2)) ; Se lect Sort Order
	4327	"RTN","RCD PEADP",16, 0)
	4328	Q:$P(INPU T,"^",3)=" 0" ; '^ ' or timeo ut
	4329	"RTN","RCD PEADP",17, 0)
	4330	S $P(INPU T,"^",4)=$ $DTRNG() ; Se lect Date Range for Report
	4331	"RTN","RCD PEADP",18, 0)
	4332	Q:'$P(INP UT,"^",4) ; '^ ' or timeo ut
	4333	"RTN","RCD PEADP",19, 0)
	4334	S $P(INPU T,"^",4)=$ P($P(INPUT ,"^",4),"\| ",2,3)
	4335	"RTN","RCD PEADP",20, 0)
	4336	S $P(INPU T,"^",6)=$ $ASKLM^RCD PEARL ; Ask to Dis play in Li stman Temp late
	4337	"RTN","RCD PEADP",21, 0)
	4338	Q:$P(INPU T,"^",6)<0 ; '^' or tim eout
	4339	"RTN","RCD PEADP",22, 0)
	4340	I $P(INPU T,"^",6)=1 D Q ; Compile da ta and cal l listman to display
	4341	"RTN","RCD PEADP",23, 0)
	4342	. D LMOUT ^RCDPEAD1( INPUT,.RCV AUTD,.IO)
	4343	"RTN","RCD PEADP",24, 0)
	4344	S $P(INPU T,"^",5)=$ $DISPTY() ; Se lect Displ ay Type
	4345	"RTN","RCD PEADP",25, 0)
	4346	Q:$P(INPU T,"^",5)=- 1 ; '^ ' or timeo ut
	4347	"RTN","RCD PEADP",26, 0)
	4348	D:$P(INPU T,"^",5)=1 INFO^RCDP EM6 ; Di splay capt ure inform ation for Excel
	4349	"RTN","RCD PEADP",27, 0)
	4350	Q:'$$DEVI CE($P(INPU T,"^",5),. IO) ; As k output d evice
	4351	"RTN","RCD PEADP",28, 0)
	4352	;
	4353	"RTN","RCD PEADP",29, 0)
	4354	; Compile and Displ ay Report data (queu ed) - not allowed fo r EXCEL
	4355	"RTN","RCD PEADP",30, 0)
	4356	I $P(INPU T,"^",5)'= 1,$D(IO("Q ")) D Q
	4357	"RTN","RCD PEADP",31, 0)
	4358	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK
	4359	"RTN","RCD PEADP",32, 0)
	4360	.S ZTRTN= "REPORT^RC DPEADP(INP UT,.RCVAUT D,.IO)"
	4361	"RTN","RCD PEADP",33, 0)
	4362	.S ZTDESC ="EDI LOCK BOX AUTO-D ECREASE RE PORT"
	4363	"RTN","RCD PEADP",34, 0)
	4364	.S ZTSAVE ("RC")="" ,ZTSAVE("I NPUT")="", ZTSAVE("IO ")=""
	4365	"RTN","RCD PEADP",35, 0)
	4366	.D ^%ZTLO AD
	4367	"RTN","RCD PEADP",36, 0)
	4368	.I $D(ZTS K) W !!,"T ask number "_ZTSK_" has been q ueued."
	4369	"RTN","RCD PEADP",37, 0)
	4370	.E W !!, "Unable to queue thi s job."
	4371	"RTN","RCD PEADP",38, 0)
	4372	.K ZTSK,I O("Q")
	4373	"RTN","RCD PEADP",39, 0)
	4374	.D HOME^% ZIS
	4375	"RTN","RCD PEADP",40, 0)
	4376	; Compile and Displ ay Report data (non- queued)
	4377	"RTN","RCD PEADP",41, 0)
	4378	D REPORT( INPUT,.RCV AUTD,.IO) ; Compile and Displa y Report d ata
	4379	"RTN","RCD PEADP",42, 0)
	4380	Q
	4381	"RTN","RCD PEADP",43, 0)
	4382	;
	4383	"RTN","RCD PEADP",44, 0)
	4384	STADIV(RCV AUTD) ; Di vision/Sta tion Filte r
	4385	"RTN","RCD PEADP",45, 0)
	4386	; Input: None
	4387	"RTN","RCD PEADP",46, 0)
	4388	; Output: RCVAUTD( ) - Arra y of selec ted Divisi ons/Statio ns if 2 is returned
	4389	"RTN","RCD PEADP",47, 0)
	4390	; Returns : 1 - All Divisions/ Stations s elected
	4391	"RTN","RCD PEADP",48, 0)
	4392	; 2 - Spec ified Divi sions/Stat ions selec ted
	4393	"RTN","RCD PEADP",49, 0)
	4394	; 0 - "^" or timeout
	4395	"RTN","RCD PEADP",50, 0)
	4396	N DIR,DIR OUT,DTOUT, DUOUT,VAUT D,Y
	4397	"RTN","RCD PEADP",51, 0)
	4398	;
	4399	"RTN","RCD PEADP",52, 0)
	4400	; Divisio n selectio n - IA 664
	4401	"RTN","RCD PEADP",53, 0)
	4402	; RETURNS Y=-1 (qui t), VAUTD= 1 (for all ),VAUTD=0 (selected divisions in VAUTD)
	4403	"RTN","RCD PEADP",54, 0)
	4404	D DIVISIO N^VAUTOMA
	4405	"RTN","RCD PEADP",55, 0)
	4406	Q:Y<0 0
	4407	"RTN","RCD PEADP",56, 0)
	4408	Q:VAUTD=1 1 ; All Divisions selected
	4409	"RTN","RCD PEADP",57, 0)
	4410	M RCVAUTD =VAUTD ; Save selected divisions
	4411	"RTN","RCD PEADP",58, 0)
	4412	Q 2
	4413	"RTN","RCD PEADP",59, 0)
	4414	;
	4415	"RTN","RCD PEADP",60, 0)
	4416	ASKSORT() ; Select t he sort cr iteria
	4417	"RTN","RCD PEADP",61, 0)
	4418	; Input: None
	4419	"RTN","RCD PEADP",62, 0)
	4420	; Returns : C - Sort by Claim
	4421	"RTN","RCD PEADP",63, 0)
	4422	; P - Sort by Payer
	4423	"RTN","RCD PEADP",64, 0)
	4424	; N - Sort by Patient Na me
	4425	"RTN","RCD PEADP",65, 0)
	4426	; 0 - User ent ered '^' o r timed ou t
	4427	"RTN","RCD PEADP",66, 0)
	4428	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,XX
	4429	"RTN","RCD PEADP",67, 0)
	4430	S DIR(0)= "SA^C:CLAI M;P:PAYER; N:PATIENT NAME;"
	4431	"RTN","RCD PEADP",68, 0)
	4432	S DIR("A" )="Sort by (C)LAIM # , (P)AYER or PATIENT (N)AME?: "
	4433	"RTN","RCD PEADP",69, 0)
	4434	S DIR("?" ,1)="Enter 'C' to so rt by Clai m Number, 'P' to sor t by Payer or 'N' to sort"
	4435	"RTN","RCD PEADP",70, 0)
	4436	S DIR("?" )="by Pati ent Name."
	4437	"RTN","RCD PEADP",71, 0)
	4438	S DIR("B" )="CLAIM"
	4439	"RTN","RCD PEADP",72, 0)
	4440	D ^DIR
	4441	"RTN","RCD PEADP",73, 0)
	4442	Q:$D(DTOU T)!$D(DUOU T) 0
	4443	"RTN","RCD PEADP",74, 0)
	4444	Q Y
	4445	"RTN","RCD PEADP",75, 0)
	4446	;
	4447	"RTN","RCD PEADP",76, 0)
	4448	SORTORD(SO RT) ; Sele ct the sor t order
	4449	"RTN","RCD PEADP",77, 0)
	4450	; Input: SORT - 'C' - So rt by Clai m Number
	4451	"RTN","RCD PEADP",78, 0)
	4452	; 'P' - So rt by Paye r
	4453	"RTN","RCD PEADP",79, 0)
	4454	; 'N' - So rt by Pati ent Name
	4455	"RTN","RCD PEADP",80, 0)
	4456	; Returns : F - First to Last
	4457	"RTN","RCD PEADP",81, 0)
	4458	; L - Last to First
	4459	"RTN","RCD PEADP",82, 0)
	4460	; 0 - User ent ered '^' o r timed ou t
	4461	"RTN","RCD PEADP",83, 0)
	4462	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,XX,YY
	4463	"RTN","RCD PEADP",84, 0)
	4464	S XX=" (F )IRST TO L AST or (L) AST TO FIR ST?: "
	4465	"RTN","RCD PEADP",85, 0)
	4466	S YY=$S(S ORT="C":"C LAIM",SORT ="P":"PAYE R",1:"PATI ENT NAME")
	4467	"RTN","RCD PEADP",86, 0)
	4468	S DIR("A" )="Sort "_ YY_XX
	4469	"RTN","RCD PEADP",87, 0)
	4470	S DIR(0)= "SA^F:FIRS T TO LAST; L:LAST TO FIRST"
	4471	"RTN","RCD PEADP",88, 0)
	4472	S DIR("B" )="FIRST T O LAST"
	4473	"RTN","RCD PEADP",89, 0)
	4474	D ^DIR
	4475	"RTN","RCD PEADP",90, 0)
	4476	Q:$D(DTOU T)!$D(DUOU T) 0
	4477	"RTN","RCD PEADP",91, 0)
	4478	Q Y
	4479	"RTN","RCD PEADP",92, 0)
	4480	;
	4481	"RTN","RCD PEADP",93, 0)
	4482	DTRNG() ; Get the da te range f or the rep ort
	4483	"RTN","RCD PEADP",94, 0)
	4484	; Input: None
	4485	"RTN","RCD PEADP",95, 0)
	4486	; Returns : A1\|A2\|A3 - Wher e:
	4487	"RTN","RCD PEADP",96, 0)
	4488	; A1 - 0 - Use r up-arrow ed or time d out, 1 o therwise
	4489	"RTN","RCD PEADP",97, 0)
	4490	; A2 - Auto-Po st Start D ate
	4491	"RTN","RCD PEADP",98, 0)
	4492	; A3 - Auto-Po st End Dat e
	4493	"RTN","RCD PEADP",99, 0)
	4494	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RCEND,RC START,RNGF LG,X,Y
	4495	"RTN","RCD PEADP",100 ,0)
	4496	D DATES(. RCSTART,.R CEND)
	4497	"RTN","RCD PEADP",101 ,0)
	4498	Q:RCSTART =-1 0
	4499	"RTN","RCD PEADP",102 ,0)
	4500	Q:RCSTART "1\|"_RCST ART_"\|"_RC END
	4501	"RTN","RCD PEADP",103 ,0)
	4502	Q:'RCSTAR T "0\|\|"
	4503	"RTN","RCD PEADP",104 ,0)
	4504	Q 0
	4505	"RTN","RCD PEADP",105 ,0)
	4506	;
	4507	"RTN","RCD PEADP",106 ,0)
	4508	DATES(BDAT E,EDATE) ; Get a dat e range.
	4509	"RTN","RCD PEADP",107 ,0)
	4510	; Input: None
	4511	"RTN","RCD PEADP",108 ,0)
	4512	; Output: BDATE - Internal Auto-Post Start Dat e
	4513	"RTN","RCD PEADP",109 ,0)
	4514	; EDATE - Internal Auto-Post End Date
	4515	"RTN","RCD PEADP",110 ,0)
	4516	D1 ; loopi ng tag
	4517	"RTN","RCD PEADP",111 ,0)
	4518	S (BDATE, EDATE)=0
	4519	"RTN","RCD PEADP",112 ,0)
	4520	S DIR("?" )="Enter t he earlies t Auto-Pos ting date to include on the re port."
	4521	"RTN","RCD PEADP",113 ,0)
	4522	S DIR(0)= "DAO^:"_DT _":APE"
	4523	"RTN","RCD PEADP",114 ,0)
	4524	S DIR("A" )="Start D ate: "
	4525	"RTN","RCD PEADP",115 ,0)
	4526	D ^DIR
	4527	"RTN","RCD PEADP",116 ,0)
	4528	K DIR
	4529	"RTN","RCD PEADP",117 ,0)
	4530	I $D(DTOU T)!$D(DUOU T)!(Y="") S BDATE=-1 Q
	4531	"RTN","RCD PEADP",118 ,0)
	4532	S BDATE=Y
	4533	"RTN","RCD PEADP",119 ,0)
	4534	S DIR("?" )="Enter t he latest Auto-Posti ng date to include o n the repo rt."
	4535	"RTN","RCD PEADP",120 ,0)
	4536	S DIR("B" )=Y(0)
	4537	"RTN","RCD PEADP",121 ,0)
	4538	S DIR(0)= "DAO^"_BDA TE_":"_DT_ ":APE"
	4539	"RTN","RCD PEADP",122 ,0)
	4540	S DIR("A" )="End Dat e: "
	4541	"RTN","RCD PEADP",123 ,0)
	4542	D ^DIR
	4543	"RTN","RCD PEADP",124 ,0)
	4544	K DIR
	4545	"RTN","RCD PEADP",125 ,0)
	4546	I $D(DTOU T)!$D(DUOU T)!(Y="") S BDATE=-1 Q
	4547	"RTN","RCD PEADP",126 ,0)
	4548	S EDATE=Y
	4549	"RTN","RCD PEADP",127 ,0)
	4550	Q
	4551	"RTN","RCD PEADP",128 ,0)
	4552	;
	4553	"RTN","RCD PEADP",129 ,0)
	4554	DISPTY() ; Get displ ay/output type
	4555	"RTN","RCD PEADP",130 ,0)
	4556	; Input: None
	4557	"RTN","RCD PEADP",131 ,0)
	4558	; Returns : 1 - Output t o Excel
	4559	"RTN","RCD PEADP",132 ,0)
	4560	; 0 - Output t o paper
	4561	"RTN","RCD PEADP",133 ,0)
	4562	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,Y
	4563	"RTN","RCD PEADP",134 ,0)
	4564	S DIR(0)= "Y"
	4565	"RTN","RCD PEADP",135 ,0)
	4566	S DIR("A" )="Export the report to Micros oft Excel"
	4567	"RTN","RCD PEADP",136 ,0)
	4568	S DIR("B" )="NO"
	4569	"RTN","RCD PEADP",137 ,0)
	4570	D ^DIR
	4571	"RTN","RCD PEADP",138 ,0)
	4572	I $G(DUOU T) Q -1
	4573	"RTN","RCD PEADP",139 ,0)
	4574	Q Y
	4575	"RTN","RCD PEADP",140 ,0)
	4576	;
	4577	"RTN","RCD PEADP",141 ,0)
	4578	DEVICE(EXC EL,IO) ; S elect the output dev ice
	4579	"RTN","RCD PEADP",142 ,0)
	4580	; Input: EXCEL - 1 - Outp ut to Exce l, 0 other wise
	4581	"RTN","RCD PEADP",143 ,0)
	4582	; Output:
	4583	"RTN","RCD PEADP",144 ,0)
	4584	; IO - Array of selected output inf o
	4585	"RTN","RCD PEADP",145 ,0)
	4586	; Returns : 0 - No devic e selected , 1 Otherw ise
	4587	"RTN","RCD PEADP",146 ,0)
	4588	N POP,%ZI S
	4589	"RTN","RCD PEADP",147 ,0)
	4590	S %ZIS="Q M"
	4591	"RTN","RCD PEADP",148 ,0)
	4592	D ^%ZIS
	4593	"RTN","RCD PEADP",149 ,0)
	4594	Q:POP 0
	4595	"RTN","RCD PEADP",150 ,0)
	4596	Q 1
	4597	"RTN","RCD PEADP",151 ,0)
	4598	;
	4599	"RTN","RCD PEADP",152 ,0)
	4600	REPORT(INP UTS,RCVAUT D,IO) ; EP Compile a nd print r eport
	4601	"RTN","RCD PEADP",153 ,0)
	4602	; Input: INPUTS - A1^A2^A3 ^...^An Wh ere:
	4603	"RTN","RCD PEADP",154 ,0)
	4604	; A1 - 1 - All divisions selected
	4605	"RTN","RCD PEADP",155 ,0)
	4606	; 2 - Sele cted divis ions
	4607	"RTN","RCD PEADP",156 ,0)
	4608	; A2 - C - Sort by Claim
	4609	"RTN","RCD PEADP",157 ,0)
	4610	; P - Sort by Payer
	4611	"RTN","RCD PEADP",158 ,0)
	4612	; N - Sort by Patien t Name
	4613	"RTN","RCD PEADP",159 ,0)
	4614	; A3 - F - Firs t to Last Sort Order
	4615	"RTN","RCD PEADP",160 ,0)
	4616	; L - Last to First Sort Order
	4617	"RTN","RCD PEADP",161 ,0)
	4618	; A4 - B1\|B2
	4619	"RTN","RCD PEADP",162 ,0)
	4620	; B1 - Auto -Post Star t Date
	4621	"RTN","RCD PEADP",163 ,0)
	4622	; B2 - Auto -Post End Date
	4623	"RTN","RCD PEADP",164 ,0)
	4624	; A5 - 1 - Outpu t to Excel
	4625	"RTN","RCD PEADP",165 ,0)
	4626	; 0 - Other wise
	4627	"RTN","RCD PEADP",166 ,0)
	4628	; A6 - 1 - Outpu t to List Manager
	4629	"RTN","RCD PEADP",167 ,0)
	4630	; 0 - Other wise
	4631	"RTN","RCD PEADP",168 ,0)
	4632	; RCVAUTD - Array of selected D ivisions
	4633	"RTN","RCD PEADP",169 ,0)
	4634	; Only pass ed if A1=2
	4635	"RTN","RCD PEADP",170 ,0)
	4636	; IO - Output D evice
	4637	"RTN","RCD PEADP",171 ,0)
	4638	; Output:
	4639	"RTN","RCD PEADP",172 ,0)
	4640	N DTOTAL, GTOTAL,XX, ZTREQ
	4641	"RTN","RCD PEADP",173 ,0)
	4642	U IO
	4643	"RTN","RCD PEADP",174 ,0)
	4644	K ^TMP("R CDPEADP",$ J),^TMP("R CDPE_ADP", $J)
	4645	"RTN","RCD PEADP",175 ,0)
	4646	D COMPILE ^RCDPEAD1( INPUTS,.RC VAUTD,.DTO TAL,.GTOTA L) ; Scan ERA file f or entries in date r ange
	4647	"RTN","RCD PEADP",176 ,0)
	4648	D DISP(IN PUTS,.DTOT AL,.GTOTAL ) ; Dis play Repor t
	4649	"RTN","RCD PEADP",177 ,0)
	4650	K ^TMP("R CDPEADP",$ J),^TMP("R CSELPAY",$ J) ; Clea r TMP glob al
	4651	"RTN","RCD PEADP",178 ,0)
	4652	D ^%ZISC ; Clos e device
	4653	"RTN","RCD PEADP",179 ,0)
	4654	Q
	4655	"RTN","RCD PEADP",180 ,0)
	4656	;
	4657	"RTN","RCD PEADP",181 ,0)
	4658	SAVE(ADDAT E,ERAIEN,R CRZ,EXCEL, RCSORT,CAR CS,RCTR,ST NAM,STNUM) ; Put the data into the ^TMP global
	4659	"RTN","RCD PEADP",182 ,0)
	4660	; Input: ADDATE - Curren t Internal Date bein g processe d
	4661	"RTN","RCD PEADP",183 ,0)
	4662	; ERAIEN - Intern al IEN of the ERA re cord
	4663	"RTN","RCD PEADP",184 ,0)
	4664	; RCRZ - ERA li ne number
	4665	"RTN","RCD PEADP",185 ,0)
	4666	; EXCEL - 1 outp ut to Exce l, 0 other wise
	4667	"RTN","RCD PEADP",186 ,0)
	4668	; RCSORT - C - S ort by Cla im
	4669	"RTN","RCD PEADP",187 ,0)
	4670	; P - S ort by Pay er
	4671	"RTN","RCD PEADP",188 ,0)
	4672	; N - S ort by Pat ient Name
	4673	"RTN","RCD PEADP",189 ,0)
	4674	; CARCS - ^ deli mited stri ng of CARC informati on found
	4675	"RTN","RCD PEADP",190 ,0)
	4676	; on the EOB recor d pointed to by the ERA detail record
	4677	"RTN","RCD PEADP",191 ,0)
	4678	; A1;A2; A3;A4^B1;B 2;B3;B4^.. .^N1;N2;N3 ;N4 Where:
	4679	"RTN","RCD PEADP",192 ,0)
	4680	; A1 - Auto-Decr ease amoun t of the 1 st CARC co de
	4681	"RTN","RCD PEADP",193 ,0)
	4682	; A2 - 1st CARC code
	4683	"RTN","RCD PEADP",194 ,0)
	4684	; A3 - Quantity of the fir st CARC co de
	4685	"RTN","RCD PEADP",195 ,0)
	4686	; A4 - Truncated Reason te xt of the 1st CARC
	4687	"RTN","RCD PEADP",196 ,0)
	4688	; DTOTAL() - Curren t Array of totals by Auto-Post Date
	4689	"RTN","RCD PEADP",197 ,0)
	4690	; GTOTAL - Curren t Grand to tals
	4691	"RTN","RCD PEADP",198 ,0)
	4692	; RCTR - Curren t Record C ounter
	4693	"RTN","RCD PEADP",199 ,0)
	4694	; STNAM - Statio n name
	4695	"RTN","RCD PEADP",200 ,0)
	4696	; STNUM - Statio n number
	4697	"RTN","RCD PEADP",201 ,0)
	4698	; ^TMP("RC DPEADP",$J ) - Curren t report d ata
	4699	"RTN","RCD PEADP",202 ,0)
	4700	; See DI SP for a f ull descri ption
	4701	"RTN","RCD PEADP",203 ,0)
	4702	; Output: DTOTAL() - Update d Array of totals by Auto-Post Date
	4703	"RTN","RCD PEADP",204 ,0)
	4704	; GTOTAL - Update d Grand to tals
	4705	"RTN","RCD PEADP",205 ,0)
	4706	; RCTR - Update d Record C ounter
	4707	"RTN","RCD PEADP",206 ,0)
	4708	; ^TMP("RC DPEADP",$J ,A1,A2,A3) - B1^B2^B 3^...^Bn W here:
	4709	"RTN","RCD PEADP",207 ,0)
	4710	; - A1 - "EXCE L" if expo rting to e xcel
	4711	"RTN","RCD PEADP",208 ,0)
	4712	; Inte rnal filem an date if not expor ting to ex cel
	4713	"RTN","RCD PEADP",209 ,0)
	4714	; A2 - Excel Line Coun ter if exp orting to excel
	4715	"RTN","RCD PEADP",210 ,0)
	4716	; Exter nal Claim number is sorting by claim
	4717	"RTN","RCD PEADP",211 ,0)
	4718	; Exter nal Payer Name if so rting by P ayer
	4719	"RTN","RCD PEADP",212 ,0)
	4720	; Exter nal Patien t Name if sorting by Patient N ame
	4721	"RTN","RCD PEADP",213 ,0)
	4722	; A3 - Recor d Counter
	4723	"RTN","RCD PEADP",214 ,0)
	4724	; B1 - Exter nal Statio n Name
	4725	"RTN","RCD PEADP",215 ,0)
	4726	; B2 - Exter nal Statio n Number
	4727	"RTN","RCD PEADP",216 ,0)
	4728	; B3 - Exter nal Claim Number
	4729	"RTN","RCD PEADP",217 ,0)
	4730	; B4 - Exter nal Patien t Name
	4731	"RTN","RCD PEADP",218 ,0)
	4732	; B5 - Exter nal Payer Name
	4733	"RTN","RCD PEADP",219 ,0)
	4734	; B6 - Auto- Decrease A mount
	4735	"RTN","RCD PEADP",220 ,0)
	4736	; B7 - Auto- Decrease D ate
	4737	"RTN","RCD PEADP",221 ,0)
	4738	; ^TMP("RC DPEADP",$J ,A1,A2,A3, A4) - C1^C 2^C3^C4 Wh ere:
	4739	"RTN","RCD PEADP",222 ,0)
	4740	; - A1 - "EXCE L" if expo rting to e xcel
	4741	"RTN","RCD PEADP",223 ,0)
	4742	; Inte rnal filem an date if not expor ting to ex cel
	4743	"RTN","RCD PEADP",224 ,0)
	4744	; A2 - Excel Line Coun ter if exp orting to excel
	4745	"RTN","RCD PEADP",225 ,0)
	4746	; Exter nal Claim number is sorting by claim
	4747	"RTN","RCD PEADP",226 ,0)
	4748	; Exter nal Payer Name if so rting by P ayer
	4749	"RTN","RCD PEADP",227 ,0)
	4750	; Exter nal Patien t Name if sorting by Patient N ame
	4751	"RTN","RCD PEADP",228 ,0)
	4752	; A3 - Recor d Counter
	4753	"RTN","RCD PEADP",229 ,0)
	4754	; A4 - CARC Counter
	4755	"RTN","RCD PEADP",230 ,0)
	4756	; C1 - CARC Code (file 361.111, field .01)
	4757	"RTN","RCD PEADP",231 ,0)
	4758	; C2 - Decre ase Amount (file 361 .111, fiel d .02)
	4759	"RTN","RCD PEADP",232 ,0)
	4760	; C3 - Quant ity (file 361.111, f ield .03)
	4761	"RTN","RCD PEADP",233 ,0)
	4762	; C4 - Reaso n (file 36 1.111, fie ld .04)
	4763	"RTN","RCD PEADP",234 ,0)
	4764	N A1,A2,A MOUNT,CARC ,CLAIM,DAT E,EOBIEN,P AYNAM,PTNA M,XX,Y
	4765	"RTN","RCD PEADP",235 ,0)
	4766	S PAYNAM= $$GET1^DIQ (344.4,ERA IEN,.06,"E ") ; Pa yer name f rom ERA re cord
	4767	"RTN","RCD PEADP",236 ,0)
	4768	S DATE=$$ FMTE^XLFDT (ADDATE,"2 SZ") ; Fo rmat Auto- Decrease d ate
	4769	"RTN","RCD PEADP",237 ,0)
	4770	S AMOUNT= $$GET1^DIQ (344.41,RC RZ_","_ERA IEN_",",8, "I") ; Au to-Decreas e Amount
	4771	"RTN","RCD PEADP",238 ,0)
	4772	Q:+AMOUNT =0
	4773	"RTN","RCD PEADP",239 ,0)
	4774	S EOBIEN= $$GET1^DIQ (344.41,RC RZ_","_ERA IEN_",",.0 2,"I") ; I EN to file 361.1 - E RA Detail
	4775	"RTN","RCD PEADP",240 ,0)
	4776	S CLAIM=$ $CLAIM(EOB IEN) ; Cl aim #
	4777	"RTN","RCD PEADP",241 ,0)
	4778	S PTNAM=$ $PNM4^RCDP EWL1(ERAIE N,RCRZ) ; Pa tient Name from Clai m file #39 9
	4779	"RTN","RCD PEADP",242 ,0)
	4780	S:PTNAM=" " PTNAM="( unknown)"
	4781	"RTN","RCD PEADP",243 ,0)
	4782	S RCTR=RC TR+1
	4783	"RTN","RCD PEADP",244 ,0)
	4784	;
	4785	"RTN","RCD PEADP",245 ,0)
	4786	; If EXCE L sorting is done in EXCEL
	4787	"RTN","RCD PEADP",246 ,0)
	4788	I EXCEL=1 D
	4789	"RTN","RCD PEADP",247 ,0)
	4790	. S A1="E XCEL",A2=$ G(^TMP("RC DPEADP",$J ,A1))+1
	4791	"RTN","RCD PEADP",248 ,0)
	4792	. S ^TMP( "RCDPEADP" ,$J,A1)=A2
	4793	"RTN","RCD PEADP",249 ,0)
	4794	;
	4795	"RTN","RCD PEADP",250 ,0)
	4796	; Otherwi se sort by DATE and selected c riteria
	4797	"RTN","RCD PEADP",251 ,0)
	4798	I 'EXCEL D
	4799	"RTN","RCD PEADP",252 ,0)
	4800	. S A1=AD DATE
	4801	"RTN","RCD PEADP",253 ,0)
	4802	. S A2=$S ($E(RCSORT )="C":CLAI M,$E(RCSOR T)="P":PAY NAM,1:PTNA M)
	4803	"RTN","RCD PEADP",254 ,0)
	4804	;
	4805	"RTN","RCD PEADP",255 ,0)
	4806	; Update ^TMP globa l if claim level adj ustments are found for this c laim
	4807	"RTN","RCD PEADP",256 ,0)
	4808	Q:'+$O(^I BM(361.1,E OBIEN,10,0 )) ; No claim lev el adjustm ents
	4809	"RTN","RCD PEADP",257 ,0)
	4810	S XX=STNA M_U_STNUM_ U_CLAIM_U_ PTNAM_U_PA YNAM_U_AMO UNT_U_DATE
	4811	"RTN","RCD PEADP",258 ,0)
	4812	S ^TMP("R CDPEADP",$ J,A1,A2,RC TR)=XX ; Cl aim Inform ation
	4813	"RTN","RCD PEADP",259 ,0)
	4814	D CARCS^R CDPEAD1(A1 ,A2,RCTR,C ARCS) ; CAR C informat ion
	4815	"RTN","RCD PEADP",260 ,0)
	4816	;
	4817	"RTN","RCD PEADP",261 ,0)
	4818	; Update totals for individua l date
	4819	"RTN","RCD PEADP",262 ,0)
	4820	S $P(DTOT AL(ADDATE) ,U)=$P($G( DTOTAL(ADD ATE)),U)+1
	4821	"RTN","RCD PEADP",263 ,0)
	4822	S $P(DTOT AL(ADDATE) ,U,2)=$P($ G(DTOTAL(A DDATE)),U, 2)+AMOUNT
	4823	"RTN","RCD PEADP",264 ,0)
	4824	;
	4825	"RTN","RCD PEADP",265 ,0)
	4826	; Update totals for date rang e
	4827	"RTN","RCD PEADP",266 ,0)
	4828	S $P(GTOT AL,U)=$P($ G(GTOTAL), U)+1,$P(GT OTAL,U,2)= $P($G(GTOT AL),U,2)+A MOUNT
	4829	"RTN","RCD PEADP",267 ,0)
	4830	Q
	4831	"RTN","RCD PEADP",268 ,0)
	4832	;
	4833	"RTN","RCD PEADP",269 ,0)
	4834	DISP(INPUT S,DTOTAL,G TOTAL) ; F ormat the display fo r screen/p rinter or MS Excel
	4835	"RTN","RCD PEADP",270 ,0)
	4836	; Input: INPUTS - A1^A2^A3 ^...^An Wh ere:
	4837	"RTN","RCD PEADP",271 ,0)
	4838	; A1 - 1 - All divisions selected
	4839	"RTN","RCD PEADP",272 ,0)
	4840	; 2 - Sele cted divis ions
	4841	"RTN","RCD PEADP",273 ,0)
	4842	; A2 - C - Sort by Claim
	4843	"RTN","RCD PEADP",274 ,0)
	4844	; P - Sort by Payer
	4845	"RTN","RCD PEADP",275 ,0)
	4846	; N - Sort by Patien t Name
	4847	"RTN","RCD PEADP",276 ,0)
	4848	; A3 - F - Firs t to Last Sort Order
	4849	"RTN","RCD PEADP",277 ,0)
	4850	; L - Last to First Sort Order
	4851	"RTN","RCD PEADP",278 ,0)
	4852	; A4 - B1\|B2
	4853	"RTN","RCD PEADP",279 ,0)
	4854	; B1 - Auto -Post Star t Date
	4855	"RTN","RCD PEADP",280 ,0)
	4856	; B2 - Auto -Post End Date
	4857	"RTN","RCD PEADP",281 ,0)
	4858	; A5 - 1 - Outpu t to Excel
	4859	"RTN","RCD PEADP",282 ,0)
	4860	; 0 - Other wise
	4861	"RTN","RCD PEADP",283 ,0)
	4862	; IO - Output D evice
	4863	"RTN","RCD PEADP",284 ,0)
	4864	; DTOTAL() - Array of totals by Internal Auto-Post date
	4865	"RTN","RCD PEADP",285 ,0)
	4866	; GTOTAL - Grand To tals for t he selecte d date per iod
	4867	"RTN","RCD PEADP",286 ,0)
	4868	; ^TMP("RC DPEADP",$J ) - See SA VE for a c omplete de scription
	4869	"RTN","RCD PEADP",287 ,0)
	4870	N A1,A2,A 3,DATA,EXC EL,HDRINFO ,LMAN,LCNT ,MODE,PAGE ,RCRDNUM,S TOP,Y
	4871	"RTN","RCD PEADP",288 ,0)
	4872	U IO ; Use the select ed device
	4873	"RTN","RCD PEADP",289 ,0)
	4874	S EXCEL=$ P(INPUTS," ^",5),LMAN =$P(INPUTS ,U,6)
	4875	"RTN","RCD PEADP",290 ,0)
	4876	;
	4877	"RTN","RCD PEADP",291 ,0)
	4878	; Header informatio n
	4879	"RTN","RCD PEADP",292 ,0)
	4880	S XX=$P(I NPUTS,"^", 4) ; Auto -Post Date range
	4881	"RTN","RCD PEADP",293 ,0)
	4882	S HDRINFO ("START")= $$FMTE^XLF DT($P(XX," \|",1),"2SZ ")
	4883	"RTN","RCD PEADP",294 ,0)
	4884	S HDRINFO ("END")=$$ FMTE^XLFDT ($P(XX,"\|" ,2),"2SZ")
	4885	"RTN","RCD PEADP",295 ,0)
	4886	S HDRINFO ("RUNDATE" )=$$FMTE^X LFDT($$NOW ^XLFDT,"2S Z")
	4887	"RTN","RCD PEADP",296 ,0)
	4888	s XX=$P(I NPUTS,"^", 2) ; Sort Type
	4889	"RTN","RCD PEADP",297 ,0)
	4890	S HDRINFO ("SORT")=" Sorted By: "_$S(XX=" C":"Claim" ,XX="P":"P ayer",1:"P atient Nam e")
	4891	"RTN","RCD PEADP",298 ,0)
	4892	S XX=$S($ P(INPUTS," ^",3)="L": "Last to F irst",1:"F irst to La st")
	4893	"RTN","RCD PEADP",299 ,0)
	4894	S HDRINFO ("SORT")=H DRINFO("SO RT")_" - " _XX
	4895	"RTN","RCD PEADP",300 ,0)
	4896	;
	4897	"RTN","RCD PEADP",301 ,0)
	4898	; Format Division f ilter
	4899	"RTN","RCD PEADP",302 ,0)
	4900	S XX=$P(I NPUTS,"^", 1) ; XX=1 - All Div isions, 2- selected
	4901	"RTN","RCD PEADP",303 ,0)
	4902	S HDRINFO ("DIVISION S")=$S(XX= 2:$$LINE(. RCVAUTD),1 :"ALL")
	4903	"RTN","RCD PEADP",304 ,0)
	4904	;
	4905	"RTN","RCD PEADP",305 ,0)
	4906	S A1="",P AGE=0,STOP =0,LCNT=1
	4907	"RTN","RCD PEADP",306 ,0)
	4908	S MODE=$S ($P(INPUTS ,"^",3)="L ":-1,1:1) ; Mode for $ORDE R directio n
	4909	"RTN","RCD PEADP",307 ,0)
	4910	F D Q:( A1="")!STO P
	4911	"RTN","RCD PEADP",308 ,0)
	4912	. S A1=$O (^TMP("RCD PEADP",$J, A1))
	4913	"RTN","RCD PEADP",309 ,0)
	4914	. Q:A1=""
	4915	"RTN","RCD PEADP",310 ,0)
	4916	. I PAGE D ASK(.STO P,0) Q:STO P ; Outp ut to scre en, quit i f user wan ts to
	4917	"RTN","RCD PEADP",311 ,0)
	4918	. D:'LMAN HDR^RCDPE AD1(EXCEL, .HDRINFO,. PAGE) ; Display H eader
	4919	"RTN","RCD PEADP",312 ,0)
	4920	. ;
	4921	"RTN","RCD PEADP",313 ,0)
	4922	. S A2=""
	4923	"RTN","RCD PEADP",314 ,0)
	4924	. F D Q :(A2="")!S TOP
	4925	"RTN","RCD PEADP",315 ,0)
	4926	. . S A2= $O(^TMP("R CDPEADP",$ J,A1,A2),M ODE)
	4927	"RTN","RCD PEADP",316 ,0)
	4928	. . I 'EX CEL,A2="", 'LMAN D TO TALD^RCDPE AD1(EXCEL, .HDRINFO,. PAGE,.STOP ,A1,.DTOTA L)
	4929	"RTN","RCD PEADP",317 ,0)
	4930	. . Q:A2= ""
	4931	"RTN","RCD PEADP",318 ,0)
	4932	. . S A3= 0
	4933	"RTN","RCD PEADP",319 ,0)
	4934	. . F D Q:'A3!STO P
	4935	"RTN","RCD PEADP",320 ,0)
	4936	. . . S A 3=$O(^TMP( "RCDPEADP" ,$J,A1,A2, A3))
	4937	"RTN","RCD PEADP",321 ,0)
	4938	. . . Q:' A3
	4939	"RTN","RCD PEADP",322 ,0)
	4940	. . . S D ATA=^TMP(" RCDPEADP", $J,A1,A2,A 3) ; Auto- Decreased Claim
	4941	"RTN","RCD PEADP",323 ,0)
	4942	. . . I E XCEL D EXC EL(DATA,A1 ,A2,A3) Q ; Outpu t to Excel
	4943	"RTN","RCD PEADP",324 ,0)
	4944	. . . I L MAN D LMAN ^RCDPEAD1( DATA,A1,A2 ,A3,.LCNT) Q
	4945	"RTN","RCD PEADP",325 ,0)
	4946	. . . I $ Y>(IOSL-4) D Q:STOP ; End o f page
	4947	"RTN","RCD PEADP",326 ,0)
	4948	. . . . D ASK(.STOP ,0)
	4949	"RTN","RCD PEADP",327 ,0)
	4950	. . . . Q :STOP
	4951	"RTN","RCD PEADP",328 ,0)
	4952	. . . . D HDR^RCDPE AD1(EXCEL, .HDRINFO,. PAGE)
	4953	"RTN","RCD PEADP",329 ,0)
	4954	. . . S Y =$E($P(DAT A,U,3),1,1 2) ; Claim #
	4955	"RTN","RCD PEADP",330 ,0)
	4956	. . . S $ E(Y,15)=$E ($P(DATA,U ,4),1,20) ; Patie nt Name
	4957	"RTN","RCD PEADP",331 ,0)
	4958	. . . S $ E(Y,37)=$E ($P(DATA,U ,5),1,19) ; Payer Name
	4959	"RTN","RCD PEADP",332 ,0)
	4960	. . . S $ E(Y,55)=$J ($P(DATA,U ,6),12,2) ; Auto- Decrease Amount
	4961	"RTN","RCD PEADP",333 ,0)
	4962	. . . S $ E(Y,69)=$P (DATA,U,7) ; Auto- Decrease D ate
	4963	"RTN","RCD PEADP",334 ,0)
	4964	. . . W ! ,Y
	4965	"RTN","RCD PEADP",335 ,0)
	4966	. . . D D CARCS(A1,A 2,A3,EXCEL ,.HDRINFO, .PAGE,.STO P) ; Displ ay CARCs
	4967	"RTN","RCD PEADP",336 ,0)
	4968	. . . W:' EXCEL !
	4969	"RTN","RCD PEADP",337 ,0)
	4970	;
	4971	"RTN","RCD PEADP",338 ,0)
	4972	; Grand t otals
	4973	"RTN","RCD PEADP",339 ,0)
	4974	I $D(GTOT AL),'LMAN D
	4975	"RTN","RCD PEADP",340 ,0)
	4976	. I 'STOP ,'EXCEL D ; Print grand tota l if not E xcel
	4977	"RTN","RCD PEADP",341 ,0)
	4978	. . D TOT ALG^RCDPEA D1(EXCEL,. HDRINFO,.P AGE,GTOTAL ,.STOP)
	4979	"RTN","RCD PEADP",342 ,0)
	4980	. I 'STOP D ; Report finished
	4981	"RTN","RCD PEADP",343 ,0)
	4982	. . W !,$ $ENDORPRT^ RCDPEARL,!
	4983	"RTN","RCD PEADP",344 ,0)
	4984	. . D ASK (.STOP,1)
	4985	"RTN","RCD PEADP",345 ,0)
	4986	;
	4987	"RTN","RCD PEADP",346 ,0)
	4988	; Null Re port
	4989	"RTN","RCD PEADP",347 ,0)
	4990	I '$D(GTO TAL),'LMAN D
	4991	"RTN","RCD PEADP",348 ,0)
	4992	. D HDR^R CDPEAD1(EX CEL,.HDRIN FO,.PAGE)
	4993	"RTN","RCD PEADP",349 ,0)
	4994	. W !!,?2 6,"* No Records to Print * ",!
	4995	"RTN","RCD PEADP",350 ,0)
	4996	. W !,$$E NDORPRT^RC DPEARL
	4997	"RTN","RCD PEADP",351 ,0)
	4998	. S:'$D(Z TQUEUED) X =$$ASKSTOP ^RCDPELAR( )
	4999	"RTN","RCD PEADP",352 ,0)
	5000	;
	5001	"RTN","RCD PEADP",353 ,0)
	5002	; List ma nager
	5003	"RTN","RCD PEADP",354 ,0)
	5004	I LMAN D
	5005	"RTN","RCD PEADP",355 ,0)
	5006	.S:LCNT=1 ^TMP("RCD PE_ADP",$J ,LCNT)=$J( "",26)_"** * No Recor ds to Prin t ***",LCN T=LCNT+1
	5007	"RTN","RCD PEADP",356 ,0)
	5008	.S ^TMP(" RCDPE_ADP" ,$J,LCNT)= " ",LCNT=L CNT+1
	5009	"RTN","RCD PEADP",357 ,0)
	5010	.S ^TMP(" RCDPE_ADP" ,$J,LCNT)= $$ENDORPRT ^RCDPEARL
	5011	"RTN","RCD PEADP",358 ,0)
	5012	; Close d evice
	5013	"RTN","RCD PEADP",359 ,0)
	5014	I '$D(ZTQ UEUED) D ^ %ZISC
	5015	"RTN","RCD PEADP",360 ,0)
	5016	I $D(ZTQU EUED) S ZT REQ="@"
	5017	"RTN","RCD PEADP",361 ,0)
	5018	Q
	5019	"RTN","RCD PEADP",362 ,0)
	5020	;
	5021	"RTN","RCD PEADP",363 ,0)
	5022	DCARCS(A1, A2,A3,EXCE L,HDRINFO, PAGE,STOP) ; Display detailes CARC infor mation - a dded as pa rt of PRCA 4.5318 r e-write
	5023	"RTN","RCD PEADP",364 ,0)
	5024	; Input: A1 - "EXCEL " if expor ting to ex cel
	5025	"RTN","RCD PEADP",365 ,0)
	5026	; Intern al fileman date if n ot exporti ng to exce l
	5027	"RTN","RCD PEADP",366 ,0)
	5028	; A2 - Excel Line Count er if expo rting to e xcel
	5029	"RTN","RCD PEADP",367 ,0)
	5030	; Extern al Claim n umber is s orting by claim
	5031	"RTN","RCD PEADP",368 ,0)
	5032	; Extern al Payer N ame if sor ting by Pa yer
	5033	"RTN","RCD PEADP",369 ,0)
	5034	; Extern al Patient Name if s orting by Patient Na me
	5035	"RTN","RCD PEADP",370 ,0)
	5036	; A3 - Record Counter
	5037	"RTN","RCD PEADP",371 ,0)
	5038	; EXCEL - 1 if e xporting t o Excel, 0 otherwise
	5039	"RTN","RCD PEADP",372 ,0)
	5040	; HDRINFO( ) - Array of header informatio n
	5041	"RTN","RCD PEADP",373 ,0)
	5042	; PAGE - Curren t Page num ber
	5043	"RTN","RCD PEADP",374 ,0)
	5044	; ^TMP("RC DPEADP",$J ) - Array of report data. See SAVE for d etails
	5045	"RTN","RCD PEADP",375 ,0)
	5046	; Output: PAGE - Update d Page num ber
	5047	"RTN","RCD PEADP",376 ,0)
	5048	; STOP - 1 if u ser aborts display, 0 otherwis e
	5049	"RTN","RCD PEADP",377 ,0)
	5050	N A4,DATA ,FIRST,XX
	5051	"RTN","RCD PEADP",378 ,0)
	5052	S A4="",F IRST=1
	5053	"RTN","RCD PEADP",379 ,0)
	5054	F D Q:( A4="")!STO P
	5055	"RTN","RCD PEADP",380 ,0)
	5056	. S A4=$O (^TMP("RCD PEADP",$J, A1,A2,A3,A 4))
	5057	"RTN","RCD PEADP",381 ,0)
	5058	. Q:A4=""
	5059	"RTN","RCD PEADP",382 ,0)
	5060	. S DATA= ^TMP("RCDP EADP",$J,A 1,A2,A3,A4 )
	5061	"RTN","RCD PEADP",383 ,0)
	5062	. I 'EXCE L,$Y>(IOSL -4) D Q:S TOP ; End of page
	5063	"RTN","RCD PEADP",384 ,0)
	5064	. . D ASK (.STOP,0)
	5065	"RTN","RCD PEADP",385 ,0)
	5066	. . Q:STO P
	5067	"RTN","RCD PEADP",386 ,0)
	5068	. . S FIR ST=1
	5069	"RTN","RCD PEADP",387 ,0)
	5070	. . D HDR ^RCDPEAD1( EXCEL,.HDR INFO,.PAGE ,1)
	5071	"RTN","RCD PEADP",388 ,0)
	5072	. I FIRST D ; CARC header
	5073	"RTN","RCD PEADP",389 ,0)
	5074	. . S FIR ST=0
	5075	"RTN","RCD PEADP",390 ,0)
	5076	. . I EXC EL D Q
	5077	"RTN","RCD PEADP",391 ,0)
	5078	. . . W ! !,"CARC^De crease Amt ^Quantity^ Reason"
	5079	"RTN","RCD PEADP",392 ,0)
	5080	. . W !!, " CARC Dec rease Amt # Re ason"
	5081	"RTN","RCD PEADP",393 ,0)
	5082	. . W !," ------ ---------- ---- ---- --------- ---- --- ---------- ---------- ------"
	5083	"RTN","RCD PEADP",394 ,0)
	5084	. S XX=" "_$E($P (DATA,U,1) ,1,20) ; CARC
	5085	"RTN","RCD PEADP",395 ,0)
	5086	. S $E(XX ,27)=$J($P (DATA,U,2) ,12,2) ; Decr ease Amoun t
	5087	"RTN","RCD PEADP",396 ,0)
	5088	. S $E(XX ,42)=$J($P (DATA,U,3) ,4) ; Quan tity
	5089	"RTN","RCD PEADP",397 ,0)
	5090	. S $E(XX ,48)=$E($P (DATA,U,4) ,1,32) ; Reas on
	5091	"RTN","RCD PEADP",398 ,0)
	5092	. W !,XX
	5093	"RTN","RCD PEADP",399 ,0)
	5094	Q
	5095	"RTN","RCD PEADP",400 ,0)
	5096	;
	5097	"RTN","RCD PEADP",401 ,0)
	5098	EXCEL(DATA ,A1,A2,A3) ; Format EXCEL line
	5099	"RTN","RCD PEADP",402 ,0)
	5100	; Input: DATA - E RA line ad justment t otal
	5101	"RTN","RCD PEADP",403 ,0)
	5102	; A1,A2,A3 - ^TMP("R CDPEAP") s ubscripts
	5103	"RTN","RCD PEADP",404 ,0)
	5104	N CARCAMT ,CCTR,DATA 1
	5105	"RTN","RCD PEADP",405 ,0)
	5106	S CCTR=0
	5107	"RTN","RCD PEADP",406 ,0)
	5108	F S CCTR =$O(^TMP(" RCDPEADP", $J,A1,A2,A 3,CCTR)) Q :'CCTR D
	5109	"RTN","RCD PEADP",407 ,0)
	5110	. ;Displa y an EXCEL line for each CARC adjustment on the li ne
	5111	"RTN","RCD PEADP",408 ,0)
	5112	. S DATA1 =$G(^TMP(" RCDPEADP", $J,A1,A2,A 3,CCTR)),C ARCAMT=$P( DATA1,U,2)
	5113	"RTN","RCD PEADP",409 ,0)
	5114	. W !,$P( DATA,U,1,5 )_U_CARCAM T_U_$P(DAT A,U,7)_U_D ATA1
	5115	"RTN","RCD PEADP",410 ,0)
	5116	Q
	5117	"RTN","RCD PEADP",411 ,0)
	5118	;
	5119	"RTN","RCD PEADP",412 ,0)
	5120	LINE(DIV) ; List sel ected stat ions
	5121	"RTN","RCD PEADP",413 ,0)
	5122	; Input: DIV() - Arra y of selec ted divisi ons
	5123	"RTN","RCD PEADP",414 ,0)
	5124	; Returns : Comma de limited li st of sele cted divis ions
	5125	"RTN","RCD PEADP",415 ,0)
	5126	N LINE,P, SUB
	5127	"RTN","RCD PEADP",416 ,0)
	5128	S LINE="" ,SUB="",P= 0
	5129	"RTN","RCD PEADP",417 ,0)
	5130	F D Q:' SUB
	5131	"RTN","RCD PEADP",418 ,0)
	5132	. S SUB=$ O(DIV(SUB) )
	5133	"RTN","RCD PEADP",419 ,0)
	5134	. Q:'SUB
	5135	"RTN","RCD PEADP",420 ,0)
	5136	. S P=P+1 ,$P(LINE," , ",P)=$G( DIV(SUB))
	5137	"RTN","RCD PEADP",421 ,0)
	5138	Q LINE
	5139	"RTN","RCD PEADP",422 ,0)
	5140	;
	5141	"RTN","RCD PEADP",423 ,0)
	5142	ASK(STOP,T YP) ; Ask to continu e, if TYP= 1 then pro mpt to fin ish
	5143	"RTN","RCD PEADP",424 ,0)
	5144	; Input: TYP - 1 - Prom pt to fini sh, 0 Othe rwise
	5145	"RTN","RCD PEADP",425 ,0)
	5146	; IOST - Device T ype
	5147	"RTN","RCD PEADP",426 ,0)
	5148	; Output: STOP - 1 to abo rt print, 0 otherwis e
	5149	"RTN","RCD PEADP",427 ,0)
	5150	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
	5151	"RTN","RCD PEADP",428 ,0)
	5152	Q:$E(IOST ,1,2)'["C- " ; Not a terminal
	5153	"RTN","RCD PEADP",429 ,0)
	5154	S:$G(TYP) =1 DIR("A" )="Enter R ETURN to f inish"
	5155	"RTN","RCD PEADP",430 ,0)
	5156	S DIR(0)= "E"
	5157	"RTN","RCD PEADP",431 ,0)
	5158	W !
	5159	"RTN","RCD PEADP",432 ,0)
	5160	D ^DIR
	5161	"RTN","RCD PEADP",433 ,0)
	5162	I ($D(DIR UT))!($D(D UOUT)) S S TOP=1
	5163	"RTN","RCD PEADP",434 ,0)
	5164	Q
	5165	"RTN","RCD PEADP",435 ,0)
	5166	;
	5167	"RTN","RCD PEADP",436 ,0)
	5168	CLAIM(EOBI EN) ; Gets the claim number fr om AR
	5169	"RTN","RCD PEADP",437 ,0)
	5170	; Input: EOBIEN - Inte rnal IEN f or file 36 1.1
	5171	"RTN","RCD PEADP",438 ,0)
	5172	; Returns : External Claim Num ber
	5173	"RTN","RCD PEADP",439 ,0)
	5174	N CLAIM,C LAIMIEN
	5175	"RTN","RCD PEADP",440 ,0)
	5176	Q:'$G(EOB IEN)>0 "(n o EOB IEN) "
	5177	"RTN","RCD PEADP",441 ,0)
	5178	S CLAIMIE N=$$GET1^D IQ(361.1,E OBIEN,.01, "I") ; IEN for fi le 399
	5179	"RTN","RCD PEADP",442 ,0)
	5180	Q:'CLAIMI EN "(no Cl aim IEN)"
	5181	"RTN","RCD PEADP",443 ,0)
	5182	S CLAIM=$ $GET1^DIQ( 430,CLAIMI EN,.01,"I" )
	5183	"RTN","RCD PEADP",444 ,0)
	5184	Q:CLAIM=" " "(Claim not found) "
	5185	"RTN","RCD PEADP",445 ,0)
	5186	Q CLAIM ; Return cla im (nnn-Kn nnnnn)
	5187	"RTN","RCD PEADP",446 ,0)
	5188	;
	5189	"RTN","RCD PEAP")
	5190	0^2^B22545 9503^B2185 88559
	5191	"RTN","RCD PEAP",1,0)
	5192	RCDPEAP ;A LB/PJH - A UTO POST M ATCHING EF T ERA PAIR ;Oct 15, 2014@12:36 :51
	5193	"RTN","RCD PEAP",2,0)
	5194	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	5195	"RTN","RCD PEAP",3,0)
	5196	;Per VA D irective 6 402, this routine sh ould not b e modified .
	5197	"RTN","RCD PEAP",4,0)
	5198	;Read ^IB M(361.1) v ia Private IA 4051
	5199	"RTN","RCD PEAP",5,0)
	5200	;
	5201	"RTN","RCD PEAP",6,0)
	5202	EN ;Auto-p ost ERA Re ceipts
	5203	"RTN","RCD PEAP",7,0)
	5204	;Process newly matc hed and ma tched but unprocesse d ERAs
	5205	"RTN","RCD PEAP",8,0)
	5206	D EN1
	5207	"RTN","RCD PEAP",9,0)
	5208	;Process previously processed ERA's
	5209	"RTN","RCD PEAP",10,0 )
	5210	D EN2
	5211	"RTN","RCD PEAP",11,0 )
	5212	Q
	5213	"RTN","RCD PEAP",12,0 )
	5214	;
	5215	"RTN","RCD PEAP",13,0 )
	5216	EN1 ;Auto- post newly matched a nd matched but unpro cessed ERA
	5217	"RTN","RCD PEAP",14,0 )
	5218	N RCRZ,RC EFTDA
	5219	"RTN","RCD PEAP",15,0 )
	5220	S RCRZ=0
	5221	"RTN","RCD PEAP",16,0 )
	5222	;Scan ERA file for auto-post candidates with AUTO -POST STAT US = UNPOS TED
	5223	"RTN","RCD PEAP",17,0 )
	5224	F S RCRZ =$O(^RCY(3 44.4,"E",0 ,RCRZ)) Q: 'RCRZ D
	5225	"RTN","RCD PEAP",18,0 )
	5226	.;Get EFT reference
	5227	"RTN","RCD PEAP",19,0 )
	5228	.S RCEFTD A=$O(^RCY( 344.31,"AE RA",RCRZ," ")) Q:'RCE FTDA
	5229	"RTN","RCD PEAP",20,0 )
	5230	.;Check t hat EFT fu nds were p osted to F MS and Acc epted by F MS. If no t, quit an d go to ne xt unposte d ERA
	5231	"RTN","RCD PEAP",21,0 )
	5232	.N RCOK,R CDEPTDA,RC RECTDA
	5233	"RTN","RCD PEAP",22,0 )
	5234	.S RCOK=1
	5235	"RTN","RCD PEAP",23,0 )
	5236	.I $P($G( ^RCY(344.3 ,+$G(^RCY( 344.31,+RC EFTDA,0)), 0)),U,8),$ P($G(^RCY( 344.31,+RC EFTDA,0)), U,7) D Q: 'RCOK
	5237	"RTN","RCD PEAP",24,0 )
	5238	..S RCDEP TDA=+$P($G (^RCY(344. 3,+$G(^RCY (344.31,+R CEFTDA,0)) ,0)),U,3), RCRECTDA=+ $O(^RCY(34 4,"AD",+RC DEPTDA,0)) ; Get dep osit ticke t and EFT receipt (C R - 8NZZ)
	5239	"RTN","RCD PEAP",25,0 )
	5240	..I RCREC TDA N Z S Z=$P($$FMS STAT^RCDPU REC(RCRECT DA),U,2) I $E(Z)="A" Q ; EFT Accepted b y FMS
	5241	"RTN","RCD PEAP",26,0 )
	5242	..S RCOK= 0
	5243	"RTN","RCD PEAP",27,0 )
	5244	.;
	5245	"RTN","RCD PEAP",28,0 )
	5246	.;Auto-Po st
	5247	"RTN","RCD PEAP",29,0 )
	5248	.D AUTOPO ST(RCEFTDA ,RCRZ)
	5249	"RTN","RCD PEAP",30,0 )
	5250	Q
	5251	"RTN","RCD PEAP",31,0 )
	5252	;
	5253	"RTN","RCD PEAP",32,0 )
	5254	; Process ERA
	5255	"RTN","RCD PEAP",33,0 )
	5256	AUTOPOST(R CEFTDA,RCE RA) ;
	5257	"RTN","RCD PEAP",34,0 )
	5258	; RCEFTDA = ien of file #344. 31
	5259	"RTN","RCD PEAP",35,0 )
	5260	; RCERA = ien of fi le #344.4
	5261	"RTN","RCD PEAP",36,0 )
	5262	;
	5263	"RTN","RCD PEAP",37,0 )
	5264	;Lock ERA
	5265	"RTN","RCD PEAP",38,0 )
	5266	L +^RCY(3 44.4,RCERA ):5 Q:'$T
	5267	"RTN","RCD PEAP",39,0 )
	5268	;
	5269	"RTN","RCD PEAP",40,0 )
	5270	;Build Sc ratchpad a nd Verify Lines
	5271	"RTN","RCD PEAP",41,0 )
	5272	N ALLOK,R CERR,RCLIN ES,RCRCPTD A,RCSCR,RC TRDA,ZEROB AL ; PRCA* 4.5*318 Va riables pl aced in al pha order
	5273	"RTN","RCD PEAP",42,0 )
	5274	K ^TMP($J ,"RCDPEWLA ")
	5275	"RTN","RCD PEAP",43,0 )
	5276	S RCSCR=$ $SCRPAD(RC ERA)
	5277	"RTN","RCD PEAP",44,0 )
	5278	; Re-set AUTO-POST STATUS if unable to create sc ratchpad
	5279	"RTN","RCD PEAP",45,0 )
	5280	I 'RCSCR D SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create scr atchpad") G AUTOQ
	5281	"RTN","RCD PEAP",46,0 )
	5282	;
	5283	"RTN","RCD PEAP",47,0 )
	5284	; ERA can not be aut oposted; r emove any pre-existi ng value t o the AUTO -POST STAT US so ERA can be pro cessed man ually in t he Worklis t
	5285	"RTN","RCD PEAP",48,0 )
	5286	I $D(^TMP ($J,"RCDPE WLA","ERA LEVEL ADJU STMENT EXI STS")) D S ETSTA(RCER A,"@","Aut o Posting: Removed f rom Auto P osting-ERA level Adj ustment(s) ") G AUTOQ
	5287	"RTN","RCD PEAP",49,0 )
	5288	;
	5289	"RTN","RCD PEAP",50,0 )
	5290	; If ERA is unbalan ced, do no t auto-pos t
	5291	"RTN","RCD PEAP",51,0 )
	5292	I $$UNBAL ^RCDPEAP1( RCERA) D U NLOCKE Q ; PRCA4.5 318 Added line
	5293	"RTN","RCD PEAP",52,0 )
	5294	;
	5295	"RTN","RCD PEAP",53,0 )
	5296	;Check if all lines can be po sted
	5297	"RTN","RCD PEAP",54,0 )
	5298	S ALLOK=$ $ALLOK(RCE RA,RCSCR,. ZEROBAL,.R CLINES)
	5299	"RTN","RCD PEAP",55,0 )
	5300	;
	5301	"RTN","RCD PEAP",56,0 )
	5302	;If $$ALL OK post en tire ERA a nd reset A UTO-POST S TATUS = CO MPLETE
	5303	"RTN","RCD PEAP",57,0 )
	5304	I ALLOK D POSTALL(R CERA)
	5305	"RTN","RCD PEAP",58,0 )
	5306	;
	5307	"RTN","RCD PEAP",59,0 )
	5308	; If 'ALL OK and 'ZE ROBAL(matc hing posit ive/negati ve pairs t o not bala nce out to zero), th en ERA nee ds to go t o the stan dard workl ist for ma nual recei pt process ing
	5309	"RTN","RCD PEAP",60,0 )
	5310	I 'ALLOK, 'ZEROBAL D SETSTA(RC ERA,"@","A uto Postin g: Removed from Auto Posting-+ /- pairs d o not bala nce") G AU TOQ
	5311	"RTN","RCD PEAP",61,0 )
	5312	;
	5313	"RTN","RCD PEAP",62,0 )
	5314	;If 'ALLO K and some of the li nes passed validatio n then pos t receipt to summary ERA and s et AUTO-PO ST STATUS = PARTIAL
	5315	"RTN","RCD PEAP",63,0 )
	5316	;Un-poste d lines fa ll to APAR list for processing .
	5317	"RTN","RCD PEAP",64,0 )
	5318	I 'ALLOK D POSTERA( RCERA,.RCL INES)
	5319	"RTN","RCD PEAP",65,0 )
	5320	;Unlock E RA
	5321	"RTN","RCD PEAP",66,0 )
	5322	AUTOQ D UN LOCKE
	5323	"RTN","RCD PEAP",67,0 )
	5324	Q
	5325	"RTN","RCD PEAP",68,0 )
	5326	;
	5327	"RTN","RCD PEAP",69,0 )
	5328	EN2 ;Auto- Post Previ ously Proc essed ERA
	5329	"RTN","RCD PEAP",70,0 )
	5330	N AUTORCP T,CLAIM,CO MPLETE,EOB IEN,RCERA, RCIFN,RCRC PTDA,RCLIN ES
	5331	"RTN","RCD PEAP",71,0 )
	5332	S RCERA=0 ,AUTORCPT= 1 ;Variabl e AUTORCPT suppresse s #344 tri gger updat e to ERA r eceipt fie ld
	5333	"RTN","RCD PEAP",72,0 )
	5334	;Scan ERA file for auto-post candidates with AUTO -POST STAT US = PARTI AL
	5335	"RTN","RCD PEAP",73,0 )
	5336	F S RCER A=$O(^RCY( 344.4,"E", 1,RCERA)) Q:'RCERA D
	5337	"RTN","RCD PEAP",74,0 )
	5338	. ;Ignore if it was just part ially post ed in POST LNS so we do not pro cess again
	5339	"RTN","RCD PEAP",75,0 )
	5340	. Q:$D(^T MP("RCDPEA P",$J,RCER A))
	5341	"RTN","RCD PEAP",76,0 )
	5342	. ;Set re ceipt vari able to nu ll for eac h ERA so t hat the re ceipt numb er from th e previous ERA is no t hanging around
	5343	"RTN","RCD PEAP",77,0 )
	5344	. S RCRCP TDA=""
	5345	"RTN","RCD PEAP",78,0 )
	5346	. ;Check if there a re lines t hat are se t for auto -posting a nd if they can be po sted or ha ve errors.
	5347	"RTN","RCD PEAP",79,0 )
	5348	. K RCLIN ES
	5349	"RTN","RCD PEAP",80,0 )
	5350	. S RCLIN ES=0
	5351	"RTN","RCD PEAP",81,0 )
	5352	. D VALID ^RCDPEAP1( RCERA,.RCL INES)
	5353	"RTN","RCD PEAP",82,0 )
	5354	. ;If val id lines f ound creat e receipt for those lines (Var iable RCLI NES is onl y incremen ted for va lid lines)
	5355	"RTN","RCD PEAP",83,0 )
	5356	. I RCLIN ES D
	5357	"RTN","RCD PEAP",84,0 )
	5358	. . N RCE FTDA,RCDEP TDA,RCRECT DA
	5359	"RTN","RCD PEAP",85,0 )
	5360	. . ;Get EFT refere nce
	5361	"RTN","RCD PEAP",86,0 )
	5362	. . S RCE FTDA=$O(^R CY(344.31, "AERA",RCE RA,"")) Q: 'RCEFTDA
	5363	"RTN","RCD PEAP",87,0 )
	5364	. . ;Get deposit ti cket and E FT receipt
	5365	"RTN","RCD PEAP",88,0 )
	5366	. . S RCD EPTDA=+$P( $G(^RCY(34 4.3,+$G(^R CY(344.31, +RCEFTDA,0 )),0)),U,3 ),RCRECTDA =+$O(^RCY( 344,"AD",+ RCDEPTDA,0 ))
	5367	"RTN","RCD PEAP",89,0 )
	5368	. . ;ERA Receipt is created f rom scratc hpad entry - type 14 is EDI Lo ckbox paym ent
	5369	"RTN","RCD PEAP",90,0 )
	5370	. . S RCR CPTDA=$$BL DRCPT^RCDP EMA(RCERA) ; Creates basic rec eipt for E RA of paym ent type E DI LOCKBOX ; 2nd para meter mean s an alpha suffix on receipt n umber
	5371	"RTN","RCD PEAP",91,0 )
	5372	. . I 'RC RCPTDA Q ;PRCA4.5 318 - Prob lem buildi ng receipt header
	5373	"RTN","RCD PEAP",92,0 )
	5374	. . K RCE RR
	5375	"RTN","RCD PEAP",93,0 )
	5376	. . D RCP TDET^RCDPE MA(RCERA,R CRCPTDA,.R CLINES,.RC ERR) ; Add s detail t o a receip t based on file 344. 49 and RCL INES array
	5377	"RTN","RCD PEAP",94,0 )
	5378	. . ;;Una ble to cre ate receip t - clear scratchpad , reset AU TO-POST ST ATUS = NUL L - PRCA4 .5318 - r eplaced fo llowing li ne
	5379	"RTN","RCD PEAP",95,0 )
	5380	. . ;;I $ O(RCERR("" )) D CLEAR (RCSCR),SE TSTA(RCERA ,"@","Auto Posting: Removed fr om Auto Po sting-Unab le to crea te receipt ") Q
	5381	"RTN","RCD PEAP",96,0 )
	5382	. . I $O( RCERR("")) Q ; PRCA 4.5318 - Do not at tempt to p rocess par tially fil ed receipt
	5383	"RTN","RCD PEAP",97,0 )
	5384	. . ;Lock ERA recei pt and dep osit ticke t
	5385	"RTN","RCD PEAP",98,0 )
	5386	. . I '$$ LOCKREC^RC DPRPLU(RCR CPTDA) Q
	5387	"RTN","RCD PEAP",99,0 )
	5388	. . I '$$ LOCKDEP^RC DPDPLU(RCD EPTDA) D U NLOCKR Q
	5389	"RTN","RCD PEAP",100, 0)
	5390	. . ;Proc ess Receip t to FMS
	5391	"RTN","RCD PEAP",101, 0)
	5392	. . D PRO CESS^RCDPU RE1(RCRCPT DA,2) I $D (^TMP("RCD PE-RECEIPT -ERROR",$J )) D UNLOC KR Q
	5393	"RTN","RCD PEAP",102, 0)
	5394	. . ; upd ate 344, . 18 ERA REF ERENCE fie ld
	5395	"RTN","RCD PEAP",103, 0)
	5396	. . D ERA REF(RCERA, RCRCPTDA)
	5397	"RTN","RCD PEAP",104, 0)
	5398	. . ;Unlo ck deposit ticket an d receipt
	5399	"RTN","RCD PEAP",105, 0)
	5400	. . D UNL OCKR
	5401	"RTN","RCD PEAP",106, 0)
	5402	. ;Update ERA and E RA detail lines with receipt # or auto-p ost reject ion reason
	5403	"RTN","RCD PEAP",107, 0)
	5404	. D ERADE T^RCDPEAP1 (RCERA,RCR CPTDA,.RCL INES)
	5405	"RTN","RCD PEAP",108, 0)
	5406	. ;Determ ine if pos ting compl ete for th is ERA
	5407	"RTN","RCD PEAP",109, 0)
	5408	. S COMPL ETE=$$COMP LETE(RCERA )
	5409	"RTN","RCD PEAP",110, 0)
	5410	. ;If com plete upda te ERA det ail post s tatus to P OSTED
	5411	"RTN","RCD PEAP",111, 0)
	5412	. I COMPL ETE S DIE= "^RCY(344. 4,",DR=".1 4////1",DA =RCERA D ^ DIE
	5413	"RTN","RCD PEAP",112, 0)
	5414	. ;Update the audit log
	5415	"RTN","RCD PEAP",113, 0)
	5416	. D AUDIT LOG(RCERA, $S(COMPLET E:2,1:1)," Auto Posti ng: Previo usly proce ssed ERA p osting att empt")
	5417	"RTN","RCD PEAP",114, 0)
	5418	. ;Set ER A auto-pos t status a nd update latest aut o-post dat e
	5419	"RTN","RCD PEAP",115, 0)
	5420	. S DIE=" ^RCY(344.4 ,",DR="4.0 1////"_DT_ ";4.02//// "_$S(COMPL ETE:2,1:1) ,DA=RCERA D ^DIE
	5421	"RTN","RCD PEAP",116, 0)
	5422	;Unlock E RA
	5423	"RTN","RCD PEAP",117, 0)
	5424	D UNLOCKE
	5425	"RTN","RCD PEAP",118, 0)
	5426	Q
	5427	"RTN","RCD PEAP",119, 0)
	5428	;
	5429	"RTN","RCD PEAP",120, 0)
	5430	;Function s/Sub-rout ines in al pha order
	5431	"RTN","RCD PEAP",121, 0)
	5432	;
	5433	"RTN","RCD PEAP",122, 0)
	5434	ACTIVE(EOB IEN) ;Veri fy claim i s active
	5435	"RTN","RCD PEAP",123, 0)
	5436	; EOBIEN - IEN of f ile 361.1
	5437	"RTN","RCD PEAP",124, 0)
	5438	N RCIFN,R CBILL,RCST ATUS
	5439	"RTN","RCD PEAP",125, 0)
	5440	;Get EOB number (im plies this is 3rd Pa rty claim)
	5441	"RTN","RCD PEAP",126, 0)
	5442	I 'EOBIEN Q 0
	5443	"RTN","RCD PEAP",127, 0)
	5444	;Get #399 claim num ber from E OB
	5445	"RTN","RCD PEAP",128, 0)
	5446	S RCIFN=$ P($G(^IBM( 361.1,EOBI EN,0)),U) Q:'RCIFN 0
	5447	"RTN","RCD PEAP",129, 0)
	5448	S RCBILL= $P($G(^DGC R(399,RCIF N,0)),U) Q :RCBILL="" 0 ; IA 4 051
	5449	"RTN","RCD PEAP",130, 0)
	5450	;Check if bill is c ancelled o r closed
	5451	"RTN","RCD PEAP",131, 0)
	5452	S RCSTATU S=$P($G(^D GCR(399,RC IFN,0)),U, 13)
	5453	"RTN","RCD PEAP",132, 0)
	5454	Q $S(RCST ATUS=0:0,R CSTATUS=7: 0,1:1)
	5455	"RTN","RCD PEAP",133, 0)
	5456	;
	5457	"RTN","RCD PEAP",134, 0)
	5458	ALLOK(RCER A,RCSCR,ZE ROBAL,RCLI NES) ;Veri fy which s cratchpad lines are able to au to-post
	5459	"RTN","RCD PEAP",135, 0)
	5460	; RCERA - 344.4 ien
	5461	"RTN","RCD PEAP",136, 0)
	5462	; RCSCR - 344.49 ie n
	5463	"RTN","RCD PEAP",137, 0)
	5464	; ZEROBAL - flag th at represe nts if ERA has zero payment ba lance afte r processi ng matched positive/ negative p airs, pass ed by refe rence
	5465	"RTN","RCD PEAP",138, 0)
	5466	; RCLINES - array o f ERA line reference s (passed in by refe rence)
	5467	"RTN","RCD PEAP",139, 0)
	5468	; NOTE: ORIGINAL E RA SEQUENC ES (344.49 1, .09) ca n have mul tiple ERA line refer ences sepa rated by c ommas (e.g ., 3,4)
	5469	"RTN","RCD PEAP",140, 0)
	5470	; returns 0 or 1 (A LLOK)
	5471	"RTN","RCD PEAP",141, 0)
	5472	N ALLOK,A MT,ERALINE ,STATUS,SU B,SUB1,CLA IM,WLINE,V ERIFY
	5473	"RTN","RCD PEAP",142, 0)
	5474	K CLARRAY
	5475	"RTN","RCD PEAP",143, 0)
	5476	S (ZEROBA L,ALLOK)=1
	5477	"RTN","RCD PEAP",144, 0)
	5478	S (SUB,RC LINES)=0
	5479	"RTN","RCD PEAP",145, 0)
	5480	F S SUB= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB )) Q:SUB=" " D
	5481	"RTN","RCD PEAP",146, 0)
	5482	. ;Get sc ratchpad l ine and da ta
	5483	"RTN","RCD PEAP",147, 0)
	5484	. S SUB1= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB ,"")) Q:'S UB1 S WLI NE=$G(^RCY (344.49,RC SCR,1,SUB1 ,0)),AMT=$ P(WLINE,U, 3)
	5485	"RTN","RCD PEAP",148, 0)
	5486	. ;If int eger seque nce, get E RA line re ference an d verify f lag and th en quit fo r this seq uence and go on to t he non-int eger seque nce to fin ish valida tion
	5487	"RTN","RCD PEAP",149, 0)
	5488	. I $P(WL INE,U)?1N. N S VERIFY =1 S ERALI NE=$P(WLIN E,U,9) S:' $P(WLINE,U ,13) ALLOK =0,RCLINES (ERALINE)= "0^^1",VER IFY=0 Q
	5489	"RTN","RCD PEAP",150, 0)
	5490	. ; ignor e zero val ued lines
	5491	"RTN","RCD PEAP",151, 0)
	5492	. Q:AMT=0 Q:AMT="0 .00"
	5493	"RTN","RCD PEAP",152, 0)
	5494	. ;Get cl aim number from N.00 1 line - i f not foun d treat as inactive
	5495	"RTN","RCD PEAP",153, 0)
	5496	. S CLAIM =$P(WLINE, U,7) I 'CL AIM S ALLO K=0,$P(RCL INES(ERALI NE),U,3)=2 Q
	5497	"RTN","RCD PEAP",154, 0)
	5498	. ;Save c laim numbe r
	5499	"RTN","RCD PEAP",155, 0)
	5500	. S $P(RC LINES(ERAL INE),U,2)= $P($G(^PRC A(430,CLAI M,0)),U) Q :'VERIFY
	5501	"RTN","RCD PEAP",156, 0)
	5502	. ;Claim must be OP EN or ACTI VE
	5503	"RTN","RCD PEAP",157, 0)
	5504	. S STATU S=$P($G(^P RCA(430,CL AIM,0)),"^ ",8) I STA TUS'=42,ST ATUS'=16 S ALLOK=0,$ P(RCLINES( ERALINE),U ,3)=2 Q
	5505	"RTN","RCD PEAP",158, 0)
	5506	. ;Check that payme nt does no t exceed b alance and no pendin g payments (at the t ime of aut o posting)
	5507	"RTN","RCD PEAP",159, 0)
	5508	. S CLARR AY(CLAIM)= +$G(CLARRA Y(CLAIM))+ $P(WLINE,U ,3) I '$$C HECKPAY(.C LARRAY,CLA IM) S ALLO K=0,$P(RCL INES(ERALI NE),U,3)=3 Q
	5509	"RTN","RCD PEAP",160, 0)
	5510	. ;Check if referre d to gener al council
	5511	"RTN","RCD PEAP",161, 0)
	5512	. I $P($G (^PRCA(430 ,CLAIM,6)) ,U,4)]"" S ALLOK=0,$ P(RCLINES( ERALINE),U ,3)=4 Q
	5513	"RTN","RCD PEAP",162, 0)
	5514	. ;Line i s potentia lly postab le
	5515	"RTN","RCD PEAP",163, 0)
	5516	. S $P(RC LINES(ERAL INE),U)=1, $P(RCLINES (ERALINE), U,3)=$P(WL INE,U,6),R CLINES=$G( RCLINES)+1
	5517	"RTN","RCD PEAP",164, 0)
	5518	Q ALLOK
	5519	"RTN","RCD PEAP",165, 0)
	5520	;
	5521	"RTN","RCD PEAP",166, 0)
	5522	AUDITLOG(D A,RCNEWST, RCREASON) ;
	5523	"RTN","RCD PEAP",167, 0)
	5524	; Update the Auto-p ost Audit Log
	5525	"RTN","RCD PEAP",168, 0)
	5526	;
	5527	"RTN","RCD PEAP",169, 0)
	5528	I '$G(DA) Q
	5529	"RTN","RCD PEAP",170, 0)
	5530	I $G(RCRE ASON)="" Q
	5531	"RTN","RCD PEAP",171, 0)
	5532	;
	5533	"RTN","RCD PEAP",172, 0)
	5534	N RCAUDIT ,RCOLDST,D IE,DR,X,Y, DTOUT,DUOU T,DROUT,DI RUT
	5535	"RTN","RCD PEAP",173, 0)
	5536	; Get the current s tatus
	5537	"RTN","RCD PEAP",174, 0)
	5538	S RCOLDST =$$GET1^DI Q(344.4,DA _",",4.02, "I")
	5539	"RTN","RCD PEAP",175, 0)
	5540	; If the new status is null, set to old status (n o change)
	5541	"RTN","RCD PEAP",176, 0)
	5542	I $G(RCNE WST)="" S RCNEWST=RC OLDST
	5543	"RTN","RCD PEAP",177, 0)
	5544	; File
	5545	"RTN","RCD PEAP",178, 0)
	5546	S RCAUDIT (344.72,"+ 1,",.01)=$ $NOW^XLFDT ;Date/Tim e Stamp
	5547	"RTN","RCD PEAP",179, 0)
	5548	S RCAUDIT (344.72,"+ 1,",.02)=D UZ ;User
	5549	"RTN","RCD PEAP",180, 0)
	5550	S RCAUDIT (344.72,"+ 1,",.03)=D A ;ERA #
	5551	"RTN","RCD PEAP",181, 0)
	5552	S RCAUDIT (344.72,"+ 1,",.04)=R COLDST ;Old Stat us
	5553	"RTN","RCD PEAP",182, 0)
	5554	I RCNEWST '="@" S RC AUDIT(344. 72,"+1,",. 05)=RCNEWS T ;New sta tus
	5555	"RTN","RCD PEAP",183, 0)
	5556	S RCAUDIT (344.72,"+ 1,",.06)=$ E(RCREASON ,1,80) ;Re ason text
	5557	"RTN","RCD PEAP",184, 0)
	5558	D UPDATE^ DIE(,"RCAU DIT")
	5559	"RTN","RCD PEAP",185, 0)
	5560	Q
	5561	"RTN","RCD PEAP",186, 0)
	5562	;
	5563	"RTN","RCD PEAP",187, 0)
	5564	BUILD(RCSC R,ARRAY) ; Build list of ERA li nes
	5565	"RTN","RCD PEAP",188, 0)
	5566	;
	5567	"RTN","RCD PEAP",189, 0)
	5568	; RCSCR = ien of fi le 344.49
	5569	"RTN","RCD PEAP",190, 0)
	5570	; ARRAY = the array that will hold the list of ER A lines, p assed by r eference
	5571	"RTN","RCD PEAP",191, 0)
	5572	;
	5573	"RTN","RCD PEAP",192, 0)
	5574	N FOUND,S CRLINE,SUB ,SUB1
	5575	"RTN","RCD PEAP",193, 0)
	5576	K ARRAY
	5577	"RTN","RCD PEAP",194, 0)
	5578	S SUB=0,A RRAY=0
	5579	"RTN","RCD PEAP",195, 0)
	5580	F S SUB= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB )) Q:SUB=" " D:SUB'[ "."
	5581	"RTN","RCD PEAP",196, 0)
	5582	. ;Get ac tual scrat chpad ^RCY (344.49,RC SCR,1) nod e
	5583	"RTN","RCD PEAP",197, 0)
	5584	. S SUB1= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB ,"")) Q:'S UB1
	5585	"RTN","RCD PEAP",198, 0)
	5586	. ;Ignore zero line s
	5587	"RTN","RCD PEAP",199, 0)
	5588	. Q:'$P($ G(^RCY(344 .49,RCSCR, 1,SUB1,0)) ,U,3)
	5589	"RTN","RCD PEAP",200, 0)
	5590	. ;Index scratchpad line by E RA sequenc e
	5591	"RTN","RCD PEAP",201, 0)
	5592	. S ARRAY ($P($G(^RC Y(344.49,R CSCR,1,SUB 1,0)),U,9) )=SUB1,ARR AY=$G(ARRA Y)+1
	5593	"RTN","RCD PEAP",202, 0)
	5594	Q
	5595	"RTN","RCD PEAP",203, 0)
	5596	;
	5597	"RTN","RCD PEAP",204, 0)
	5598	CHECKPAY(A RRAY,CLAIM ) ;Check b alance ver sus paymen ts
	5599	"RTN","RCD PEAP",205, 0)
	5600	; ARRAY = array of claim numb ers and re spective p ayment amo unts
	5601	"RTN","RCD PEAP",206, 0)
	5602	; e.g. ARRA Y(430 ien) = 123.04
	5603	"RTN","RCD PEAP",207, 0)
	5604	; CLAIM = AR BILL ( 344.491, . 07) - IEN of file 43 0
	5605	"RTN","RCD PEAP",208, 0)
	5606	Q:'CLAIM 0
	5607	"RTN","RCD PEAP",209, 0)
	5608	; get the payment a mount to b e posted t o the clai m
	5609	"RTN","RCD PEAP",210, 0)
	5610	S AMT=ARR AY(CLAIM)
	5611	"RTN","RCD PEAP",211, 0)
	5612	;Payment exceeds pr inciple ba lance
	5613	"RTN","RCD PEAP",212, 0)
	5614	Q:AMT>$P( $G(^PRCA(4 30,CLAIM,7 )),U) 0
	5615	"RTN","RCD PEAP",213, 0)
	5616	;Check pe nding paym ents for c laim
	5617	"RTN","RCD PEAP",214, 0)
	5618	N PENDING S PENDING =$$PENDPAY ^RCDPURET( CLAIM) K ^ TMP($J,"RC DPUREC","P P")
	5619	"RTN","RCD PEAP",215, 0)
	5620	;Pending payments i s > billed
	5621	"RTN","RCD PEAP",216, 0)
	5622	I PENDING >AMT Q 0
	5623	"RTN","RCD PEAP",217, 0)
	5624	;otherwis e OK to po st payment
	5625	"RTN","RCD PEAP",218, 0)
	5626	Q 1
	5627	"RTN","RCD PEAP",219, 0)
	5628	;
	5629	"RTN","RCD PEAP",220, 0)
	5630	CLEAR(DA) ;Clear scr atchpad
	5631	"RTN","RCD PEAP",221, 0)
	5632	N DIK S D IK="^RCY(3 44.49," D ^DIK
	5633	"RTN","RCD PEAP",222, 0)
	5634	Q
	5635	"RTN","RCD PEAP",223, 0)
	5636	;
	5637	"RTN","RCD PEAP",224, 0)
	5638	COMPLETE(R CSCR) ;Che ck for non -zero line s without a receipt
	5639	"RTN","RCD PEAP",225, 0)
	5640	;
	5641	"RTN","RCD PEAP",226, 0)
	5642	; RCSCR = ien of fi le 344.49
	5643	"RTN","RCD PEAP",227, 0)
	5644	; Returns status of check (1 or 0)
	5645	"RTN","RCD PEAP",228, 0)
	5646	N RCSUB,S CRSUB,COMP LETE,SCRLI NE,RCERA
	5647	"RTN","RCD PEAP",229, 0)
	5648	;Default to complet e
	5649	"RTN","RCD PEAP",230, 0)
	5650	S SCRSUB= 0,COMPLETE =1,RCERA=R CSCR
	5651	"RTN","RCD PEAP",231, 0)
	5652	;Scan scr atchpad
	5653	"RTN","RCD PEAP",232, 0)
	5654	F S SCRS UB=$O(^RCY (344.49,RC SCR,1,SCRS UB)) Q:'SC RSUB D Q :'COMPLETE
	5655	"RTN","RCD PEAP",233, 0)
	5656	. ;Ignore zero and split line s (splitti ng line sh ould not c hange bala nce)
	5657	"RTN","RCD PEAP",234, 0)
	5658	. S SCRLI NE=$G(^RCY (344.49,RC SCR,1,SCRS UB,0)) Q:$ P(SCRLINE, U)'?1N.N Q:$P(SCRLI NE,U,3)=0 Q:$P(SCRL INE,U,3)=" 0.00"
	5659	"RTN","RCD PEAP",235, 0)
	5660	. ;Check if non-zer o line has receipt o n ERA, DET AIL line
	5661	"RTN","RCD PEAP",236, 0)
	5662	. S RCSUB =$P(SCRLIN E,U,9) I R CSUB,$P($G (^RCY(344. 4,RCERA,1, RCSUB,4)), U,3)]"" Q
	5663	"RTN","RCD PEAP",237, 0)
	5664	. ;Otherw ise more A UTO-postin g to do
	5665	"RTN","RCD PEAP",238, 0)
	5666	. S COMPL ETE=0
	5667	"RTN","RCD PEAP",239, 0)
	5668	Q COMPLET E
	5669	"RTN","RCD PEAP",240, 0)
	5670	;
	5671	"RTN","RCD PEAP",241, 0)
	5672	ERAREF(RCS CR,RCRCPTD A) ; updat e ERA refe rence and EFT record IEN in fi le 344
	5673	"RTN","RCD PEAP",242, 0)
	5674	; RCSCR - IEN of re cord in fi le 344.49
	5675	"RTN","RCD PEAP",243, 0)
	5676	; RCRCPTD A - ien of record in file 344 (receipt i en)
	5677	"RTN","RCD PEAP",244, 0)
	5678	N Z,DR,DI E,DA
	5679	"RTN","RCD PEAP",245, 0)
	5680	S Z=+$O(^ RCY(344.31 ,"AERA",RC SCR,0))
	5681	"RTN","RCD PEAP",246, 0)
	5682	S DIE="^R CY(344,",D A=RCRCPTDA ,DR=".18// //"_RCSCR_ $S(Z:";.17 ////"_Z,1: "") D ^DIE
	5683	"RTN","RCD PEAP",247, 0)
	5684	Q
	5685	"RTN","RCD PEAP",248, 0)
	5686	;
	5687	"RTN","RCD PEAP",249, 0)
	5688	NOTOK(RCSC R) ;Verify all scrat chpad line s passed a uto verify (V)
	5689	"RTN","RCD PEAP",250, 0)
	5690	;
	5691	"RTN","RCD PEAP",251, 0)
	5692	; RCSCR = ien of fi le 344.49
	5693	"RTN","RCD PEAP",252, 0)
	5694	; Returns status of check (1 or 0)
	5695	"RTN","RCD PEAP",253, 0)
	5696	N NOTOK,S UB
	5697	"RTN","RCD PEAP",254, 0)
	5698	S SUB=0,N OTOK=0
	5699	"RTN","RCD PEAP",255, 0)
	5700	F S SUB= $O(^RCY(34 4.49,RCSCR ,1,SUB)) Q :'SUB D Q:NOTOK
	5701	"RTN","RCD PEAP",256, 0)
	5702	. ;Set NO TOK if any single li ne is unve rified
	5703	"RTN","RCD PEAP",257, 0)
	5704	. S:$P($G (^RCY(344. 49,RCSCR,1 ,SUB,0)),U ,13)'=1 NO TOK=1
	5705	"RTN","RCD PEAP",258, 0)
	5706	Q NOTOK
	5707	"RTN","RCD PEAP",259, 0)
	5708	;
	5709	"RTN","RCD PEAP",260, 0)
	5710	POSTALL(RC ERA) ; all lines in ERA get po sted on fi rst attemp t of auto- post
	5711	"RTN","RCD PEAP",261, 0)
	5712	;
	5713	"RTN","RCD PEAP",262, 0)
	5714	; RCERA = ien of 34 4.4
	5715	"RTN","RCD PEAP",263, 0)
	5716	;
	5717	"RTN","RCD PEAP",264, 0)
	5718	;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment
	5719	"RTN","RCD PEAP",265, 0)
	5720	S RCRCPTD A=$$BLDRCP T^RCDPUREC (DT,"",+$O (^RC(341.1 ,"AC",14,0 ))) ; Cre ates basic receipt f or ERA of payment ty pe EDI LOC KBOX; 2nd parameter means no a lpha suffi x on recei pt number
	5721	"RTN","RCD PEAP",266, 0)
	5722	D RCPTDET ^RCDPEM(RC SCR,RCRCPT DA,.RCERR) ; Adds de tail to a receipt ba sed on fil e 344.49
	5723	"RTN","RCD PEAP",267, 0)
	5724	;
	5725	"RTN","RCD PEAP",268, 0)
	5726	;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL
	5727	"RTN","RCD PEAP",269, 0)
	5728	I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q
	5729	"RTN","RCD PEAP",270, 0)
	5730	;
	5731	"RTN","RCD PEAP",271, 0)
	5732	;Lock ERA receipt a nd deposit ticket
	5733	"RTN","RCD PEAP",272, 0)
	5734	I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q
	5735	"RTN","RCD PEAP",273, 0)
	5736	I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q
	5737	"RTN","RCD PEAP",274, 0)
	5738	;
	5739	"RTN","RCD PEAP",275, 0)
	5740	;Process Receipt to FMS
	5741	"RTN","RCD PEAP",276, 0)
	5742	D PROCESS ^RCDPURE1( RCRCPTDA,2 )
	5743	"RTN","RCD PEAP",277, 0)
	5744	I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q
	5745	"RTN","RCD PEAP",278, 0)
	5746	;
	5747	"RTN","RCD PEAP",279, 0)
	5748	; update 344, .18 E RA REFEREN CE field
	5749	"RTN","RCD PEAP",280, 0)
	5750	D ERAREF( RCSCR,RCRC PTDA)
	5751	"RTN","RCD PEAP",281, 0)
	5752	;
	5753	"RTN","RCD PEAP",282, 0)
	5754	;Unlock d eposit tic ket and re ceipt
	5755	"RTN","RCD PEAP",283, 0)
	5756	D UNLOCKR
	5757	"RTN","RCD PEAP",284, 0)
	5758	;
	5759	"RTN","RCD PEAP",285, 0)
	5760	;Update t he audit l og
	5761	"RTN","RCD PEAP",286, 0)
	5762	D AUDITLO G(RCERA,2, "Auto Post ing: ERA p osted succ essfully")
	5763	"RTN","RCD PEAP",287, 0)
	5764	;Update E RA receipt and detai l post sta tus
	5765	"RTN","RCD PEAP",288, 0)
	5766	S DIE="^R CY(344.4," ,DR=".14// //1;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE
	5767	"RTN","RCD PEAP",289, 0)
	5768	;Set ERA auto-post status to 'complete' and updat e latest a uto-post d ate
	5769	"RTN","RCD PEAP",290, 0)
	5770	S DIE="^R CY(344.4," ,DR="4.01/ ///"_DT_"; 4.02////2" ,DA=RCERA D ^DIE
	5771	"RTN","RCD PEAP",291, 0)
	5772	;Update a uto-post d ate for ea ch claim l ine
	5773	"RTN","RCD PEAP",292, 0)
	5774	N RCLINE, RCSCSUB,RC SCD0
	5775	"RTN","RCD PEAP",293, 0)
	5776	S RCSCSUB =0
	5777	"RTN","RCD PEAP",294, 0)
	5778	F S RCSC SUB=$O(^RC Y(344.49,R CERA,1,RCS CSUB)) Q:' RCSCSUB D
	5779	"RTN","RCD PEAP",295, 0)
	5780	. S RCSCD 0=$G(^RCY( 344.49,RCE RA,1,RCSCS UB,0))
	5781	"RTN","RCD PEAP",296, 0)
	5782	. ;Ignore if zero v alue (line not on re ceipt) oth erwise get original ERA line s equence
	5783	"RTN","RCD PEAP",297, 0)
	5784	. Q:'+$P( RCSCD0,U,3 ) S RCLIN E=$P(RCSCD 0,U,9) Q:' RCLINE
	5785	"RTN","RCD PEAP",298, 0)
	5786	. ;Update ERA line with recei pt number and auto-p ost date
	5787	"RTN","RCD PEAP",299, 0)
	5788	. N DA,DI E,DR S DA( 1)=RCERA,D A=RCLINE,D IE="^RCY(3 44.4,"_DA( 1)_",1,",D R=".25//// "_RCRCPTDA _";9////"_ DT D ^DIE
	5789	"RTN","RCD PEAP",300, 0)
	5790	Q
	5791	"RTN","RCD PEAP",301, 0)
	5792	;
	5793	"RTN","RCD PEAP",302, 0)
	5794	POSTERA(RC ERA,RCLINE S) ; only some of th e EEOB lin es passed validation on first attempt (D AY 1) of a uto-post
	5795	"RTN","RCD PEAP",303, 0)
	5796	; therefo re assign the receip t number a nd 'partia l' post st atus to ER A summary
	5797	"RTN","RCD PEAP",304, 0)
	5798	;
	5799	"RTN","RCD PEAP",305, 0)
	5800	; RCERA = ien of 34 4.4
	5801	"RTN","RCD PEAP",306, 0)
	5802	; RCLINES = array o f ERA line reference s
	5803	"RTN","RCD PEAP",307, 0)
	5804	;
	5805	"RTN","RCD PEAP",308, 0)
	5806	; no line s passed v alidation; at lease 1 EEOB li ne needs t o pass val idation be fore assig ning a rec eipt to th e ERA
	5807	"RTN","RCD PEAP",309, 0)
	5808	I RCLINES =0 S RCRCP TDA="" G P OSTERAQ
	5809	"RTN","RCD PEAP",310, 0)
	5810	;ERA Rece ipt is cre ated from scratchpad entry - t ype 14 is EDI Lockbo x payment
	5811	"RTN","RCD PEAP",311, 0)
	5812	S RCRCPTD A=$$BLDRCP T^RCDPEMA( RCERA) ; C reates bas ic receipt for ERA o f payment type EDI L OCKBOXA
	5813	"RTN","RCD PEAP",312, 0)
	5814	D RCPTDET ^RCDPEMA(R CSCR,RCRCP TDA,.RCLIN ES,.RCERR) ; Adds de tail to a receipt ba sed on fil e 344.49 a nd RCLINES array
	5815	"RTN","RCD PEAP",313, 0)
	5816	;
	5817	"RTN","RCD PEAP",314, 0)
	5818	;Unable t o create r eceipt - c lear scrat chpad, res et AUTO-PO ST STATUS = NULL
	5819	"RTN","RCD PEAP",315, 0)
	5820	I $O(RCER R("")) D C LEAR(RCSCR ),SETSTA(R CERA,"@"," Auto Posti ng: Remove d from Aut o Posting- Unable to create rec eipt") Q
	5821	"RTN","RCD PEAP",316, 0)
	5822	;
	5823	"RTN","RCD PEAP",317, 0)
	5824	;Lock ERA receipt a nd deposit ticket
	5825	"RTN","RCD PEAP",318, 0)
	5826	I '$$LOCK REC^RCDPRP LU(RCRCPTD A) Q
	5827	"RTN","RCD PEAP",319, 0)
	5828	I '$$LOCK DEP^RCDPDP LU(RCDEPTD A) D UNLOC KR Q
	5829	"RTN","RCD PEAP",320, 0)
	5830	;
	5831	"RTN","RCD PEAP",321, 0)
	5832	;Process Receipt to FMS
	5833	"RTN","RCD PEAP",322, 0)
	5834	D PROCESS ^RCDPURE1( RCRCPTDA,2 )
	5835	"RTN","RCD PEAP",323, 0)
	5836	I $D(^TMP ("RCDPE-RE CEIPT-ERRO R",$J)) D CLEAR(RCSC R),SETSTA( RCERA,"@", "Auto Post ing: Remov ed from Au to Posting -Error in receipt pr ocessing") ,UNLOCKR Q
	5837	"RTN","RCD PEAP",324, 0)
	5838	;
	5839	"RTN","RCD PEAP",325, 0)
	5840	; update 344, .18 E RA REFEREN CE field
	5841	"RTN","RCD PEAP",326, 0)
	5842	D ERAREF( RCSCR,RCRC PTDA)
	5843	"RTN","RCD PEAP",327, 0)
	5844	;
	5845	"RTN","RCD PEAP",328, 0)
	5846	;Unlock d eposit tic ket and re ceipt
	5847	"RTN","RCD PEAP",329, 0)
	5848	D UNLOCKR
	5849	"RTN","RCD PEAP",330, 0)
	5850	;Update E RA receipt and detai l post sta tus
	5851	"RTN","RCD PEAP",331, 0)
	5852	S DIE="^R CY(344.4," ,DR=".14// //5;.08/// /"_RCRCPTD A,DA=RCERA D ^DIE
	5853	"RTN","RCD PEAP",332, 0)
	5854	POSTERAQ ;
	5855	"RTN","RCD PEAP",333, 0)
	5856	D POSTLNS (RCERA,RCR CPTDA,.RCL INES)
	5857	"RTN","RCD PEAP",334, 0)
	5858	Q
	5859	"RTN","RCD PEAP",335, 0)
	5860	;
	5861	"RTN","RCD PEAP",336, 0)
	5862	POSTLNS(RC ERA,RCRCPT DA,RCLINES ) ; this s ubroutine should onl y be calle d when som e of the E EOB lines
	5863	"RTN","RCD PEAP",337, 0)
	5864	; passed validatio n on FIRST attempt ( DAY 1) of auto-post
	5865	"RTN","RCD PEAP",338, 0)
	5866	;
	5867	"RTN","RCD PEAP",339, 0)
	5868	; RCERA = ien of ER A entry in 344.4
	5869	"RTN","RCD PEAP",340, 0)
	5870	; RCRCPTD A = ien of receipt e ntry in 34 4 or undef ined if re ceipt not created si nce none o f the line s passed v alidation
	5871	"RTN","RCD PEAP",341, 0)
	5872	; RCLINES = array o f ERA line reference s
	5873	"RTN","RCD PEAP",342, 0)
	5874	;
	5875	"RTN","RCD PEAP",343, 0)
	5876	;Mark ERA as proces sed to pre vent repro cessing in EN2^RCDPE AP which r uns next
	5877	"RTN","RCD PEAP",344, 0)
	5878	S ^TMP("R CDPEAP",$J ,RCERA)=""
	5879	"RTN","RCD PEAP",345, 0)
	5880	S RCRCPTD A=$G(RCRCP TDA)
	5881	"RTN","RCD PEAP",346, 0)
	5882	;Update i ndividual claim line s on ERA
	5883	"RTN","RCD PEAP",347, 0)
	5884	N RCLIN,D A,DIE,DR,L NUM,RCI,RE JECT
	5885	"RTN","RCD PEAP",348, 0)
	5886	S RCLIN=0 F S RCLI N=$O(RCLIN ES(RCLIN)) Q:'RCLIN D
	5887	"RTN","RCD PEAP",349, 0)
	5888	. ; flag the line i f it was r ejected du ring valid ation
	5889	"RTN","RCD PEAP",350, 0)
	5890	. S REJEC T=0 I '$P( RCLINES(RC LIN),U) S REJECT=1
	5891	"RTN","RCD PEAP",351, 0)
	5892	. ;get al l ERA line reference s (e.g. RC LINES(RCLI N) could h ave multip le line # references )
	5893	"RTN","RCD PEAP",352, 0)
	5894	. ;Need t o parse ou t each lin e referenc e so that the necess ary fields can be up dated for the specif ic line
	5895	"RTN","RCD PEAP",353, 0)
	5896	. F RCI=1 :1 S LNUM= $P(RCLIN," ,",RCI) Q: LNUM="" D
	5897	"RTN","RCD PEAP",354, 0)
	5898	. . S DA( 1)=RCERA,D A=LNUM,DIE ="^RCY(344 .4,"_DA(1) _",1,"
	5899	"RTN","RCD PEAP",355, 0)
	5900	. . ;If n ot posted then the A UTO-POST R EJECTION R EASON (344 .41,5) nee ds to be u pdated ;ot herwise up date line with recei pt number and auto-p ost date
	5901	"RTN","RCD PEAP",356, 0)
	5902	. . I REJ ECT S DR=" 5////"_$P( RCLINES(RC LIN),U,3)
	5903	"RTN","RCD PEAP",357, 0)
	5904	. . E S DR=".25/// /"_RCRCPTD A_";9////" _DT
	5905	"RTN","RCD PEAP",358, 0)
	5906	. . D ^DI E
	5907	"RTN","RCD PEAP",359, 0)
	5908	;Update t he Audit L og
	5909	"RTN","RCD PEAP",360, 0)
	5910	D AUDITLO G(RCERA,1, "Auto Post ing: Some of the ERA lines wen t to APAR" )
	5911	"RTN","RCD PEAP",361, 0)
	5912	;Set ERA AUTO-POST STATUS = P ARTIAL and update au to-post da te
	5913	"RTN","RCD PEAP",362, 0)
	5914	S DIE="^R CY(344.4," ,DR="4.01/ ///"_DT_"; 4.02////1" ,DA=RCERA D ^DIE
	5915	"RTN","RCD PEAP",363, 0)
	5916	Q
	5917	"RTN","RCD PEAP",364, 0)
	5918	;
	5919	"RTN","RCD PEAP",365, 0)
	5920	SCRPAD(RCE RA) ;Build Scratchpa d entry in #344.49 f or the ERA
	5921	"RTN","RCD PEAP",366, 0)
	5922	N RC0,RC5 ,RCSCR,RCD AT,X
	5923	"RTN","RCD PEAP",367, 0)
	5924	S RC0=$G( ^RCY(344.4 ,RCERA,0)) ,RC5=$G(^R CY(344.4,R CERA,5))
	5925	"RTN","RCD PEAP",368, 0)
	5926	;Ignore i s this ERA already h as a recei pt
	5927	"RTN","RCD PEAP",369, 0)
	5928	I +$P(RC0 ,U,8) Q 0
	5929	"RTN","RCD PEAP",370, 0)
	5930	;Ignore i f this is zero ERA
	5931	"RTN","RCD PEAP",371, 0)
	5932	I +$P(RC0 ,U,5)=0 Q 0
	5933	"RTN","RCD PEAP",372, 0)
	5934	;Ignore i f this is not an ERA for an EF T
	5935	"RTN","RCD PEAP",373, 0)
	5936	I "^ACH^" '[(U_$P(RC 0,U,15)_U) Q 0
	5937	"RTN","RCD PEAP",374, 0)
	5938	; Scratch pad alread y exists
	5939	"RTN","RCD PEAP",375, 0)
	5940	S RCSCR=+ $O(^RCY(34 4.49,"B",R CERA,0)) I RCSCR G S CRPADX
	5941	"RTN","RCD PEAP",376, 0)
	5942	;Create n ew Scratch pad
	5943	"RTN","RCD PEAP",377, 0)
	5944	S RCSCR=+ $$ADDREC^R CDPEWL(RCE RA,.RCDAT) I 'RCSCR Q 0
	5945	"RTN","RCD PEAP",378, 0)
	5946	;Add all the ERA li nes to the Scratchpa d entry
	5947	"RTN","RCD PEAP",379, 0)
	5948	D ADDLINE S^RCDPEWLA (RCSCR)
	5949	"RTN","RCD PEAP",380, 0)
	5950	SCRPADX ;R eturn Scra tchpad IEN
	5951	"RTN","RCD PEAP",381, 0)
	5952	Q RCSCR
	5953	"RTN","RCD PEAP",382, 0)
	5954	;
	5955	"RTN","RCD PEAP",383, 0)
	5956	SETSTA(DA, STATUS,RCR EASON) ;Se t ERA auto -post stat us
	5957	"RTN","RCD PEAP",384, 0)
	5958	; Log sta tus change
	5959	"RTN","RCD PEAP",385, 0)
	5960	I '$G(DA) Q
	5961	"RTN","RCD PEAP",386, 0)
	5962	I $G(STAT US)="" Q
	5963	"RTN","RCD PEAP",387, 0)
	5964	;
	5965	"RTN","RCD PEAP",388, 0)
	5966	D AUDITLO G(DA,STATU S,$G(RCREA SON))
	5967	"RTN","RCD PEAP",389, 0)
	5968	; Update status
	5969	"RTN","RCD PEAP",390, 0)
	5970	N DIE,DR
	5971	"RTN","RCD PEAP",391, 0)
	5972	S DIE="^R CY(344.4," ,DR="4.02/ ///"_STATU S D ^DIE
	5973	"RTN","RCD PEAP",392, 0)
	5974	Q
	5975	"RTN","RCD PEAP",393, 0)
	5976	;
	5977	"RTN","RCD PEAP",394, 0)
	5978	;
	5979	"RTN","RCD PEAP",395, 0)
	5980	UNLOCKR ;U nlock ERA receipt an d deposit ticket
	5981	"RTN","RCD PEAP",396, 0)
	5982	L -^RCY(3 44,RCRCPTD A)
	5983	"RTN","RCD PEAP",397, 0)
	5984	L -^RCY(3 44.1,RCDEP TDA)
	5985	"RTN","RCD PEAP",398, 0)
	5986	Q
	5987	"RTN","RCD PEAP",399, 0)
	5988	;
	5989	"RTN","RCD PEAP",400, 0)
	5990	UNLOCKE ;U nlock ERA
	5991	"RTN","RCD PEAP",401, 0)
	5992	L -^RCY(3 44.4,RCERA )
	5993	"RTN","RCD PEAP",402, 0)
	5994	Q
	5995	"RTN","RCD PEAP",403, 0)
	5996	;
	5997	"RTN","RCD PEAP",404, 0)
	5998	VALID(RCSC R,SCRLINE, RCARRAY) ; Validates Scratchpad line - Us ed by APAR /Mark for Auto-post
	5999	"RTN","RCD PEAP",405, 0)
	6000	;Input
	6001	"RTN","RCD PEAP",406, 0)
	6002	; RCSCR - #344.4 /#344.49 f ile IEN
	6003	"RTN","RCD PEAP",407, 0)
	6004	; SCRLIN E - Subscr ipt of fir st scratch pad entry for the ER A line
	6005	"RTN","RCD PEAP",408, 0)
	6006	; RCARRA Y - Passed reference to result array
	6007	"RTN","RCD PEAP",409, 0)
	6008	;Output
	6009	"RTN","RCD PEAP",410, 0)
	6010	; OK - Boolea n 1 or 0
	6011	"RTN","RCD PEAP",411, 0)
	6012	; RCARRA Y - Array of claim(s ) which fa il validat ion
	6013	"RTN","RCD PEAP",412, 0)
	6014	;
	6015	"RTN","RCD PEAP",413, 0)
	6016	; e.g l ine number 2
	6017	"RTN","RCD PEAP",414, 0)
	6018	; R CARRAY(2.0 01)="K8000 01^NOT AN ACTIVE CLA IM"
	6019	"RTN","RCD PEAP",415, 0)
	6020	;
	6021	"RTN","RCD PEAP",416, 0)
	6022	; e.g. s plit line number 2
	6023	"RTN","RCD PEAP",417, 0)
	6024	; R CARRAY(2.0 01)="K8000 02^CLAIM R EFERRED TO GENERAL C OUNCIL"
	6025	"RTN","RCD PEAP",418, 0)
	6026	; R CARRAY(2.0 06)="K8000 03^PAYMENT EXCEEDS C LAIM BALAN CE"
	6027	"RTN","RCD PEAP",419, 0)
	6028	;
	6029	"RTN","RCD PEAP",420, 0)
	6030	N CLAIM,D ONE,SEQ,SE Q1,SUB,STA TUS,WLINE
	6031	"RTN","RCD PEAP",421, 0)
	6032	K RCARRAY ,CLARRAY
	6033	"RTN","RCD PEAP",422, 0)
	6034	S SUB=SCR LINE,SEQ=$ P($G(^RCY( 344.49,RCS CR,1,SUB,0 )),U),DONE =0
	6035	"RTN","RCD PEAP",423, 0)
	6036	F S SUB= $O(^RCY(34 4.49,RCSCR ,1,SUB)) Q :SUB="" D Q:DONE
	6037	"RTN","RCD PEAP",424, 0)
	6038	. ;Get sc ratchpad N .001 line and data
	6039	"RTN","RCD PEAP",425, 0)
	6040	. S WLINE =$G(^RCY(3 44.49,RCSC R,1,SUB,0) ),SEQ1=$P( WLINE,".") I SEQ1'=S EQ S DONE= 1 Q
	6041	"RTN","RCD PEAP",426, 0)
	6042	. ;Get cl aim number from N.00 N line - i gnore susp ense lines
	6043	"RTN","RCD PEAP",427, 0)
	6044	. S CLAIM =$P(WLINE, U,7) I 'CL AIM Q
	6045	"RTN","RCD PEAP",428, 0)
	6046	. ;Claim must be OP EN or ACTI VE
	6047	"RTN","RCD PEAP",429, 0)
	6048	. S STATU S=$P($G(^P RCA(430,CL AIM,0)),"^ ",8) I STA TUS'=42,ST ATUS'=16 S RCARRAY(S EQ1)=$P(WL INE,U,2)_" ^NOT AN AC TIVE CLAIM " Q
	6049	"RTN","RCD PEAP",430, 0)
	6050	. ;Check that payme nt does no t exceed b alance and no pendin g payments (at the t ime of aut o posting)
	6051	"RTN","RCD PEAP",431, 0)
	6052	. S CLARR AY(CLAIM)= +$G(CLARRA Y(CLAIM))+ $P(WLINE,U ,3) I '$$C HECKPAY(.C LARRAY,CLA IM) S RCAR RAY(SEQ1)= $P(WLINE,U ,2)_"^PAYM ENT EXCEED S CLAIM BA LANCE" Q
	6053	"RTN","RCD PEAP",432, 0)
	6054	. ;Check if referre d to gener al council
	6055	"RTN","RCD PEAP",433, 0)
	6056	. I $P($G (^PRCA(430 ,CLAIM,6)) ,U,4)]"" S RCARRAY(S EQ1)=$P(WL INE,U,2)_" ^CLAIM REF ERRED TO G ENERAL COU NCIL" Q
	6057	"RTN","RCD PEAP",434, 0)
	6058	. ;Check that payme nt is not negative
	6059	"RTN","RCD PEAP",435, 0)
	6060	. I $P(WL INE,U,6)<0 S RCARRAY (SEQ1)=$P( WLINE,U,2) _"^PAYMENT AMOUNT IS NEGATIVE" Q
	6061	"RTN","RCD PEAP",436, 0)
	6062	;Returns 1 if line is OK
	6063	"RTN","RCD PEAP",437, 0)
	6064	Q $S($O(R CARRAY("") )]"":0,1:1 )
	6065	"RTN","RCD PEAP1")
	6066	0^9^B10016 1817^B9406 7228
	6067	"RTN","RCD PEAP1",1,0 )
	6068	RCDPEAP1 ; ALB/KML - AUTO POST MATCHING E FT ERA PAI R - CONT. ;Jun 06, 2 014@19:11: 19
	6069	"RTN","RCD PEAP1",2,0 )
	6070	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	6071	"RTN","RCD PEAP1",3,0 )
	6072	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6073	"RTN","RCD PEAP1",4,0 )
	6074	;Read ^IB M(361.1) v ia Private IA 4051
	6075	"RTN","RCD PEAP1",5,0 )
	6076	;
	6077	"RTN","RCD PEAP1",6,0 )
	6078	;-------- ---------- ---------- ---
	6079	"RTN","RCD PEAP1",7,0 )
	6080	;RCDPEM0 and RCDPEA P SUBROUTI NES
	6081	"RTN","RCD PEAP1",8,0 )
	6082	;-------- ---------- ---------- ---
	6083	"RTN","RCD PEAP1",9,0 )
	6084	AUTOCHK(RC ERA) ;Veri fy if ERA can be aut o-posted - PRE-CHECK USED IN R CDPEM0
	6085	"RTN","RCD PEAP1",10, 0)
	6086	; Many ch ecks done by this ar e also don e AUTOCHK2 below so if these a re changed , may also need to b e changed
	6087	"RTN","RCD PEAP1",11, 0)
	6088	N NOTOK,R CDSUB,RCD0 ,RCSCR
	6089	"RTN","RCD PEAP1",12, 0)
	6090	K ^TMP($J ,"RCDPEWLA ")
	6091	"RTN","RCD PEAP1",13, 0)
	6092	;Check fo r exceptio ns
	6093	"RTN","RCD PEAP1",14, 0)
	6094	S RCDSUB= 0,NOTOK=0
	6095	"RTN","RCD PEAP1",15, 0)
	6096	F S RCDS UB=$O(^RCY (344.4,RCE RA,1,RCDSU B)) Q:'RCD SUB D Q: NOTOK
	6097	"RTN","RCD PEAP1",16, 0)
	6098	. ;Except ion exists if INVALI D BILL NUM BER field is populat ed in #344 .41
	6099	"RTN","RCD PEAP1",17, 0)
	6100	. S RCD0= $G(^RCY(34 4.4,RCERA, 1,RCDSUB,0 )) S:($P(R CD0,U,5)]" ") NOTOK=1
	6101	"RTN","RCD PEAP1",18, 0)
	6102	;Cannot a uto-post i f exceptio ns exist
	6103	"RTN","RCD PEAP1",19, 0)
	6104	Q:NOTOK 0
	6105	"RTN","RCD PEAP1",20, 0)
	6106	; Ignore ERA if ERA level Adj ustments e xist
	6107	"RTN","RCD PEAP1",21, 0)
	6108	I $O(^RCY (344.4,RCE RA,2,0)) Q 0
	6109	"RTN","RCD PEAP1",22, 0)
	6110	;Create s cratchpad
	6111	"RTN","RCD PEAP1",23, 0)
	6112	S RCSCR=$ $SCRPAD^RC DPEAP(RCER A) Q:'RCSC R 0
	6113	"RTN","RCD PEAP1",24, 0)
	6114	;Ignore E RA if clai m level ad justments without pa yment exis t
	6115	"RTN","RCD PEAP1",25, 0)
	6116	;This wil l only get set if th e scratchp ad is crea ted, not i f it alrea dy exists. Looking at the cod e, it
	6117	"RTN","RCD PEAP1",26, 0)
	6118	;will mai nly set if there are ERA level adjustmen ts and may get set f or unbalan ced pairs, which is found
	6119	"RTN","RCD PEAP1",27, 0)
	6120	;by the Z EROBAL fun ction. So , I think this does not have a real purp ose but wa s not 100% sure.
	6121	"RTN","RCD PEAP1",28, 0)
	6122	I $D(^TMP ($J,"RCDPE WLA","ERA LEVEL ADJU STMENT EXI STS")) D C LEAR^RCDPE AP(RCSCR) Q 0
	6123	"RTN","RCD PEAP1",29, 0)
	6124	; ERA nee ds to drop to standa rd worklis t if adjus tment betw een matchi ng
	6125	"RTN","RCD PEAP1",30, 0)
	6126	;positive /negative does not c reate a ze ro balance
	6127	"RTN","RCD PEAP1",31, 0)
	6128	I '$$ZERO BAL(RCSCR) D CLEAR^R CDPEAP(RCS CR) Q 0
	6129	"RTN","RCD PEAP1",32, 0)
	6130	;Clear sc ratchpad
	6131	"RTN","RCD PEAP1",33, 0)
	6132	D CLEAR^R CDPEAP(RCS CR)
	6133	"RTN","RCD PEAP1",34, 0)
	6134	;This is valid auto -post - re turn to MA TCH^RCPDEM 0
	6135	"RTN","RCD PEAP1",35, 0)
	6136	Q 1
	6137	"RTN","RCD PEAP1",36, 0)
	6138	;
	6139	"RTN","RCD PEAP1",37, 0)
	6140	AUTOCHK2(R CERA) ;
	6141	"RTN","RCD PEAP1",38, 0)
	6142	;Check if this entr y is an au to-post ca ndidate
	6143	"RTN","RCD PEAP1",39, 0)
	6144	;This has the same/ similar ch ecks as MA TCH^RCDPEM 0 and AUTO CHK above. If those procedure s are
	6145	"RTN","RCD PEAP1",40, 0)
	6146	; change d, this ma y need to updated as well.
	6147	"RTN","RCD PEAP1",41, 0)
	6148	;
	6149	"RTN","RCD PEAP1",42, 0)
	6150	;Input
	6151	"RTN","RCD PEAP1",43, 0)
	6152	; RCERA: IEN from Electronic Remittanc e Advice f ile (#344. 4)
	6153	"RTN","RCD PEAP1",44, 0)
	6154	;Output
	6155	"RTN","RCD PEAP1",45, 0)
	6156	; 1: Aut o-Post can didate
	6157	"RTN","RCD PEAP1",46, 0)
	6158	; 0^Reas on: Not a auto-post candidate and reason
	6159	"RTN","RCD PEAP1",47, 0)
	6160	;
	6161	"RTN","RCD PEAP1",48, 0)
	6162	; Validat e Paramete r
	6163	"RTN","RCD PEAP1",49, 0)
	6164	I '$G(RCE RA) Q "0^I nvalid Par ameter"
	6165	"RTN","RCD PEAP1",50, 0)
	6166	;
	6167	"RTN","RCD PEAP1",51, 0)
	6168	N STATUS, RC0,RCERAT YP,RCXCLDE ,RCDSUB,NO TOK,RCCREA TE,RCSCR
	6169	"RTN","RCD PEAP1",52, 0)
	6170	K ^TMP($J ,"RCDPEWLA ")
	6171	"RTN","RCD PEAP1",53, 0)
	6172	;
	6173	"RTN","RCD PEAP1",54, 0)
	6174	; Check i f record e xists
	6175	"RTN","RCD PEAP1",55, 0)
	6176	I '$D(^RC Y(344.4,RC ERA,0)) Q "0^Invalid ERA recor d"
	6177	"RTN","RCD PEAP1",56, 0)
	6178	;
	6179	"RTN","RCD PEAP1",57, 0)
	6180	; Check c urrent sta tus
	6181	"RTN","RCD PEAP1",58, 0)
	6182	S STATUS= $$GET1^DIQ (344.4,RCE RA_",",4.0 2,"I")
	6183	"RTN","RCD PEAP1",59, 0)
	6184	I STATUS= 0 Q "0^Alr eady marke d for Auto -Posting"
	6185	"RTN","RCD PEAP1",60, 0)
	6186	I STATUS= 1 Q "0^Alr eady parti ally Auto- Posted"
	6187	"RTN","RCD PEAP1",61, 0)
	6188	I STATUS= 2 Q "0^Alr eady compl etely Auto -Posted"
	6189	"RTN","RCD PEAP1",62, 0)
	6190	;
	6191	"RTN","RCD PEAP1",63, 0)
	6192	; Check f or matchin g
	6193	"RTN","RCD PEAP1",64, 0)
	6194	I '$$GET1 ^DIQ(344.4 ,RCERA_"," ,.09,"I") Q "0^ERA n ot matched "
	6195	"RTN","RCD PEAP1",65, 0)
	6196	;
	6197	"RTN","RCD PEAP1",66, 0)
	6198	; Check f or zero va lue ERA
	6199	"RTN","RCD PEAP1",67, 0)
	6200	S RC0=$G( ^RCY(344.4 ,RCERA,0))
	6201	"RTN","RCD PEAP1",68, 0)
	6202	I +$P(RC0 ,U,5)=0 Q "0^Zero va lue ERA"
	6203	"RTN","RCD PEAP1",69, 0)
	6204	;
	6205	"RTN","RCD PEAP1",70, 0)
	6206	; Determi ne if ERA should be excluded u sing the s ite parame ters
	6207	"RTN","RCD PEAP1",71, 0)
	6208	S RCERATY P=$$PHARM( RCERA)
	6209	"RTN","RCD PEAP1",72, 0)
	6210	;
	6211	"RTN","RCD PEAP1",73, 0)
	6212	; Check i f medical claim and auto-posti ng is turn ed off
	6213	"RTN","RCD PEAP1",74, 0)
	6214	I 'RCERAT YP,'$P($G( ^RCY(344.6 1,1,0)),U, 2) Q "0^Me dical auto -posting o ff"
	6215	"RTN","RCD PEAP1",75, 0)
	6216	;
	6217	"RTN","RCD PEAP1",76, 0)
	6218	; Check i f pharmacy claim and auto-post ing is tur ned off
	6219	"RTN","RCD PEAP1",77, 0)
	6220	I RCERATY P,'$P($G(^ RCY(344.61 ,1,1)),U,1 ) Q "0^Pha rmacy auto -posting o ff"
	6221	"RTN","RCD PEAP1",78, 0)
	6222	;
	6223	"RTN","RCD PEAP1",79, 0)
	6224	; Check i f ERA paye r is exclu ded from a utopost
	6225	"RTN","RCD PEAP1",80, 0)
	6226	S RCXCLDE =0
	6227	"RTN","RCD PEAP1",81, 0)
	6228	S:'RCERAT YP RCXCLDE =$$EXCLUDE (RCERA)
	6229	"RTN","RCD PEAP1",82, 0)
	6230	S:RCERATY P RCXCLDE= $$EXCLDRX( RCERA)
	6231	"RTN","RCD PEAP1",83, 0)
	6232	I RCXCLDE Q "0^"_$S (RCERATYP: "Pharmacy" ,1:"Medica l")_" paye r excluded "
	6233	"RTN","RCD PEAP1",84, 0)
	6234	;
	6235	"RTN","RCD PEAP1",85, 0)
	6236	; Check f or invalid bill numb er excepti on
	6237	"RTN","RCD PEAP1",86, 0)
	6238	S RCDSUB= 0,NOTOK=0
	6239	"RTN","RCD PEAP1",87, 0)
	6240	F S RCDS UB=$O(^RCY (344.4,RCE RA,1,RCDSU B)) Q:'RCD SUB D Q: NOTOK
	6241	"RTN","RCD PEAP1",88, 0)
	6242	. S RCD0= $G(^RCY(34 4.4,RCERA, 1,RCDSUB,0 ))
	6243	"RTN","RCD PEAP1",89, 0)
	6244	. I $P(RC D0,U,5)]"" S NOTOK=1
	6245	"RTN","RCD PEAP1",90, 0)
	6246	I NOTOK Q "0^Invali d Bill Num ber Except ion(s)"
	6247	"RTN","RCD PEAP1",91, 0)
	6248	;
	6249	"RTN","RCD PEAP1",92, 0)
	6250	; Check f or ERA lev el Adjustm ents
	6251	"RTN","RCD PEAP1",93, 0)
	6252	I $O(^RCY (344.4,RCE RA,2,0)) Q "0^ERA le vel Adjust ment(s)"
	6253	"RTN","RCD PEAP1",94, 0)
	6254	;
	6255	"RTN","RCD PEAP1",95, 0)
	6256	; Check i f receipt already cr eated
	6257	"RTN","RCD PEAP1",96, 0)
	6258	I +$P(RC0 ,U,8) Q "0 ^ERA has a receipt"
	6259	"RTN","RCD PEAP1",97, 0)
	6260	;
	6261	"RTN","RCD PEAP1",98, 0)
	6262	; Check i f they is a ACH paym ent type
	6263	"RTN","RCD PEAP1",99, 0)
	6264	I "^ACH^" '[(U_$P(RC 0,U,15)_U) Q "0^Paym ent Type i s not ACH"
	6265	"RTN","RCD PEAP1",100 ,0)
	6266	;
	6267	"RTN","RCD PEAP1",101 ,0)
	6268	; Create scratchpad if needed
	6269	"RTN","RCD PEAP1",102 ,0)
	6270	S RCCREAT E=0
	6271	"RTN","RCD PEAP1",103 ,0)
	6272	S RCSCR=+ $O(^RCY(34 4.49,"B",R CERA,0))
	6273	"RTN","RCD PEAP1",104 ,0)
	6274	I 'RCSCR S RCSCR=$$ SCRPAD^RCD PEAP(RCERA ) S RCCREA TE=1
	6275	"RTN","RCD PEAP1",105 ,0)
	6276	I 'RCSCR Q "0^Unabl e to creat e scratchp ad"
	6277	"RTN","RCD PEAP1",106 ,0)
	6278	;
	6279	"RTN","RCD PEAP1",107 ,0)
	6280	; Check i f claim le vel adjust ments with out paymen t exist
	6281	"RTN","RCD PEAP1",108 ,0)
	6282	; Note th at PRCA*29 8 sets thi s temp glo bal only i f the scra tchpad is created by the call above ($$S CRPAD^RCDP EAP). If t he
	6283	"RTN","RCD PEAP1",109 ,0)
	6284	; scrat chpad alre ady exists , the TMP global wil l never ge t set. L ooking at the code, it will ma inly set i f there
	6285	"RTN","RCD PEAP1",110 ,0)
	6286	; are E RA level a djustments and may g et set for unbalance d pairs, w hich is fo und by the ZEROBAL f unction. So, I thin k
	6287	"RTN","RCD PEAP1",111 ,0)
	6288	; this does not h ave a real purpose b ut was not 100% sure and wante d to mimic what AUTO CHK does.
	6289	"RTN","RCD PEAP1",112 ,0)
	6290	I $D(^TMP ($J,"RCDPE WLA","ERA LEVEL ADJU STMENT EXI STS")) D:R CCREATE CL EAR^RCDPEA P(RCSCR) Q "0^Claim Level Adju stments w/ o payment"
	6291	"RTN","RCD PEAP1",113 ,0)
	6292	;
	6293	"RTN","RCD PEAP1",114 ,0)
	6294	; Check i f adjustme nt between matching positive/n egative do es not cre ate a zero balance
	6295	"RTN","RCD PEAP1",115 ,0)
	6296	I '$$ZERO BAL(RCSCR) D:RCCREAT E CLEAR^RC DPEAP(RCSC R) Q "0^+/ - pairs do not balan ce"
	6297	"RTN","RCD PEAP1",116 ,0)
	6298	;
	6299	"RTN","RCD PEAP1",117 ,0)
	6300	; Clear s cratchpad if it was created by this func tion
	6301	"RTN","RCD PEAP1",118 ,0)
	6302	D:RCCREAT E CLEAR^RC DPEAP(RCSC R)
	6303	"RTN","RCD PEAP1",119 ,0)
	6304	;
	6305	"RTN","RCD PEAP1",120 ,0)
	6306	;If we go t this far , this is an autopos t candidat e so quit with 1
	6307	"RTN","RCD PEAP1",121 ,0)
	6308	Q 1
	6309	"RTN","RCD PEAP1",122 ,0)
	6310	;
	6311	"RTN","RCD PEAP1",123 ,0)
	6312	EXCLUDE(RC ERA) ;Veri fy if auto -posting i s allowed for this P ayer - PRE CHECK USED IN RCDPEM 0
	6313	"RTN","RCD PEAP1",124 ,0)
	6314	;Not allo wed if med ical auto- posting is switched off
	6315	"RTN","RCD PEAP1",125 ,0)
	6316	Q:'$P($G( ^RCY(344.6 1,1,0)),U, 2) 1
	6317	"RTN","RCD PEAP1",126 ,0)
	6318	;Check if Payer Nam e and Paye r ID from ERA are in auto-post ing payer table
	6319	"RTN","RCD PEAP1",127 ,0)
	6320	N RCPNM,R CPID,RCPXD A
	6321	"RTN","RCD PEAP1",128 ,0)
	6322	S RCPNM=$ P($G(^RCY( 344.4,RCER A,0)),U,6) Q:RCPNM=" " 1
	6323	"RTN","RCD PEAP1",129 ,0)
	6324	S RCPID=$ P($G(^RCY( 344.4,RCER A,0)),U,3) Q:RCPID=" " 1
	6325	"RTN","RCD PEAP1",130 ,0)
	6326	;Auto-pos t is allow ed if this is a new payer (not in table)
	6327	"RTN","RCD PEAP1",131 ,0)
	6328	S RCPXDA= $O(^RCY(34 4.6,"CPID" ,RCPNM,RCP ID,"")) Q: RCPXDA="" 0
	6329	"RTN","RCD PEAP1",132 ,0)
	6330	;If payer table ent ry found c heck if pa yer is exc luded from medical a uto-post
	6331	"RTN","RCD PEAP1",133 ,0)
	6332	Q:$P($G(^ RCY(344.6, RCPXDA,0)) ,U,6)=1 1
	6333	"RTN","RCD PEAP1",134 ,0)
	6334	;Otherwis e it is OK to auto-p ost
	6335	"RTN","RCD PEAP1",135 ,0)
	6336	Q 0
	6337	"RTN","RCD PEAP1",136 ,0)
	6338	;
	6339	"RTN","RCD PEAP1",137 ,0)
	6340	PHARM(RCER A) ;Check if ERA is for Pharma cy only (E CME number on first line) - CA LLED FROM RCDPEM0
	6341	"RTN","RCD PEAP1",138 ,0)
	6342	N SUB S S UB=$O(^RCY (344.4,RCE RA,1,0)) Q :'SUB 0
	6343	"RTN","RCD PEAP1",139 ,0)
	6344	Q:$P($G(^ RCY(344.4, RCERA,1,SU B,4)),U,2) ]"" 1
	6345	"RTN","RCD PEAP1",140 ,0)
	6346	Q 0
	6347	"RTN","RCD PEAP1",141 ,0)
	6348	;
	6349	"RTN","RCD PEAP1",142 ,0)
	6350	ERADET(RCE RA,RCRCPTD A,RCLINES) ; called on subsequ ent attemp ts of auto -post for a given ER A (DAY 2, DAY 3, ex. )
	6351	"RTN","RCD PEAP1",143 ,0)
	6352	; update ERA with receipt or if not po sted then update the AUTO-POST REJECTION REASON (# 5)
	6353	"RTN","RCD PEAP1",144 ,0)
	6354	;
	6355	"RTN","RCD PEAP1",145 ,0)
	6356	; RCERA = ien of en try in fil e 344.4
	6357	"RTN","RCD PEAP1",146 ,0)
	6358	; RCRCPTD A = ien of receipt n umber (344 , .01) - o ptional
	6359	"RTN","RCD PEAP1",147 ,0)
	6360	; RCLINES = array o f ERA line reference s
	6361	"RTN","RCD PEAP1",148 ,0)
	6362	;
	6363	"RTN","RCD PEAP1",149 ,0)
	6364	I '$G(RCE RA) Q
	6365	"RTN","RCD PEAP1",150 ,0)
	6366	S RCRCPTD A=$G(RCRCP TDA)
	6367	"RTN","RCD PEAP1",151 ,0)
	6368	;
	6369	"RTN","RCD PEAP1",152 ,0)
	6370	N DA,DIC, DIE,DLAYGO ,DO,DR,X
	6371	"RTN","RCD PEAP1",153 ,0)
	6372	; Update receipt. If this is the first receipt, put it in the RECEIP T (#08) fi eld. If n ot, put in OTHER REC EIPTS mult iple (#344 .48)
	6373	"RTN","RCD PEAP1",154 ,0)
	6374	I RCRCPTD A D
	6375	"RTN","RCD PEAP1",155 ,0)
	6376	. I $P($G (^RCY(344. 4,RCERA,0) ),U,8)]"" S DA(1)=RC ERA,DIC="^ RCY(344.4, "_DA(1)_", 8,",DIC(0) ="L",X=RCR CPTDA D FI LE^DICN I 1
	6377	"RTN","RCD PEAP1",156 ,0)
	6378	. E S DI E="^RCY(34 4.4,",DR=" .14////1;. 08////"_RC RCPTDA,DA= RCERA D ^D IE
	6379	"RTN","RCD PEAP1",157 ,0)
	6380	;
	6381	"RTN","RCD PEAP1",158 ,0)
	6382	; Update ERA detail line with Receipt o r reject r eason as a ppropriate
	6383	"RTN","RCD PEAP1",159 ,0)
	6384	; PRCA4. 5318 begi ns
	6385	"RTN","RCD PEAP1",160 ,0)
	6386	N RCLIN,R EJECT
	6387	"RTN","RCD PEAP1",161 ,0)
	6388	S RCLIN=0
	6389	"RTN","RCD PEAP1",162 ,0)
	6390	F S RCLI N=$O(RCLIN ES(RCLIN)) Q:'RCLIN D
	6391	"RTN","RCD PEAP1",163 ,0)
	6392	. ; Set R EJECT to t rue if the line was rejected d uring vali dation
	6393	"RTN","RCD PEAP1",164 ,0)
	6394	. S REJEC T=0 I '$P( RCLINES(RC LIN),U) S REJECT=1
	6395	"RTN","RCD PEAP1",165 ,0)
	6396	. ;If not posted th en update the AUTO-P OST REJECT ION REASON (#5)
	6397	"RTN","RCD PEAP1",166 ,0)
	6398	. ;Otherw ise update line with receipt n umber and autopost d ate
	6399	"RTN","RCD PEAP1",167 ,0)
	6400	. S DA(1) =RCERA,DA= RCLIN,DIE= "^RCY(344. 4,"_DA(1)_ ",1,"
	6401	"RTN","RCD PEAP1",168 ,0)
	6402	. I 'REJE CT,'RCRCPT DA Q
	6403	"RTN","RCD PEAP1",169 ,0)
	6404	. I REJEC T S DR="5/ //"_$P(RCL INES(RCLIN ),U,3)
	6405	"RTN","RCD PEAP1",170 ,0)
	6406	. E S DR =".25///"_ RCRCPTDA_" ;9///"_DT
	6407	"RTN","RCD PEAP1",171 ,0)
	6408	. D ^DIE
	6409	"RTN","RCD PEAP1",172 ,0)
	6410	; PRCA4. 5318 ends
	6411	"RTN","RCD PEAP1",173 ,0)
	6412	Q
	6413	"RTN","RCD PEAP1",174 ,0)
	6414	;
	6415	"RTN","RCD PEAP1",175 ,0)
	6416	ZEROBAL(RC SCR) ;
	6417	"RTN","RCD PEAP1",176 ,0)
	6418	; per req uirements, only posi tive/negat ive paymen t pairs wh ere paymen t
	6419	"RTN","RCD PEAP1",177 ,0)
	6420	; calcula tes to zer o are allo wed for au to-post
	6421	"RTN","RCD PEAP1",178 ,0)
	6422	; if paym ent ends u p less tha n zero or greater th an zero th en ERA can not
	6423	"RTN","RCD PEAP1",179 ,0)
	6424	;be autop osted.
	6425	"RTN","RCD PEAP1",180 ,0)
	6426	; ERA get s sent to the standa rd worklis t for manu al receipt processin g
	6427	"RTN","RCD PEAP1",181 ,0)
	6428	; note: a payment pair repre sents 2 EE OB sequenc es with th e same cla im
	6429	"RTN","RCD PEAP1",182 ,0)
	6430	; RCSCR - 3 44.49 ien
	6431	"RTN","RCD PEAP1",183 ,0)
	6432	; X - retur ns 1 or 0
	6433	"RTN","RCD PEAP1",184 ,0)
	6434	;
	6435	"RTN","RCD PEAP1",185 ,0)
	6436	N SUB,SUB 1,WLINE,X, ERALINE
	6437	"RTN","RCD PEAP1",186 ,0)
	6438	S SUB=0,X =1,ERALINE =""
	6439	"RTN","RCD PEAP1",187 ,0)
	6440	F S SUB= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB )) Q:SUB=" " D
	6441	"RTN","RCD PEAP1",188 ,0)
	6442	. ;Get sc ratchpad l ine and da ta
	6443	"RTN","RCD PEAP1",189 ,0)
	6444	. S SUB1= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB ,"")) Q:'S UB1 S WLI NE=$G(^RCY (344.49,RC SCR,1,SUB1 ,0))
	6445	"RTN","RCD PEAP1",190 ,0)
	6446	. ;If int eger seque nce, get E RA line re ference th en quit fo r this seq uence and go on to t he non-int eger seque nce to fin ish valida tion
	6447	"RTN","RCD PEAP1",191 ,0)
	6448	. I $P(WL INE,U)?1N. N S ERALIN E=$P(WLINE ,U,9) Q
	6449	"RTN","RCD PEAP1",192 ,0)
	6450	. ; there are multi ple EEOB s equences f or the spe cific bill number so an adjust ment took place;
	6451	"RTN","RCD PEAP1",193 ,0)
	6452	. ; if pa yment adju stment doe sn't gener ate a zero payment b alance at 344.491,.0 6 then thi s ERA need s to drop to standar d worklist
	6453	"RTN","RCD PEAP1",194 ,0)
	6454	. I ERALI NE[",",+$P (WLINE,U,6 )'=0 S X=0 Q
	6455	"RTN","RCD PEAP1",195 ,0)
	6456	. ;do not autopost ERA if one of paymen ts is nega tive amoun t
	6457	"RTN","RCD PEAP1",196 ,0)
	6458	. I $P(WL INE,U,6)<0 S X=0
	6459	"RTN","RCD PEAP1",197 ,0)
	6460	Q X
	6461	"RTN","RCD PEAP1",198 ,0)
	6462	;
	6463	"RTN","RCD PEAP1",199 ,0)
	6464	; Verify if auto-po sting is a llowed for Pharmacy claims and for the P ayer - PRE CHECK USED IN RCDPEM 0
	6465	"RTN","RCD PEAP1",200 ,0)
	6466	EXCLDRX(RC ERA) ;
	6467	"RTN","RCD PEAP1",201 ,0)
	6468	;Not allo wed if pha rmacy auto -posting i s switched off
	6469	"RTN","RCD PEAP1",202 ,0)
	6470	Q:'$P($G( ^RCY(344.6 1,1,1)),U, 1) 1
	6471	"RTN","RCD PEAP1",203 ,0)
	6472	;Check if Payer Nam e and Paye r ID from ERA are in auto-post ing payer table
	6473	"RTN","RCD PEAP1",204 ,0)
	6474	N RCPNM,R CPID,RCPXD A
	6475	"RTN","RCD PEAP1",205 ,0)
	6476	S RCPNM=$ P($G(^RCY( 344.4,RCER A,0)),U,6) Q:RCPNM=" " 1
	6477	"RTN","RCD PEAP1",206 ,0)
	6478	S RCPID=$ P($G(^RCY( 344.4,RCER A,0)),U,3) Q:RCPID=" " 1
	6479	"RTN","RCD PEAP1",207 ,0)
	6480	;Auto-pos t is allow ed if this is a new payer (not in table)
	6481	"RTN","RCD PEAP1",208 ,0)
	6482	S RCPXDA= $O(^RCY(34 4.6,"CPID" ,RCPNM,RCP ID,"")) Q: RCPXDA="" 0
	6483	"RTN","RCD PEAP1",209 ,0)
	6484	;If payer table ent ry found c heck if pa yer is exc luded from pharmacy auto-post
	6485	"RTN","RCD PEAP1",210 ,0)
	6486	Q:$P($G(^ RCY(344.6, RCPXDA,0)) ,U,8)=1 1
	6487	"RTN","RCD PEAP1",211 ,0)
	6488	;Otherwis e it is OK to auto-p ost
	6489	"RTN","RCD PEAP1",212 ,0)
	6490	Q 0
	6491	"RTN","RCD PEAP1",213 ,0)
	6492	;
	6493	"RTN","RCD PEAP1",214 ,0)
	6494	VALID(RCER A,RCLINES) ;
	6495	"RTN","RCD PEAP1",215 ,0)
	6496	;Verify w hich scrat chpad line s are able to auto-p ost - call ed by EN2^ RCDPEAP
	6497	"RTN","RCD PEAP1",216 ,0)
	6498	;
	6499	"RTN","RCD PEAP1",217 ,0)
	6500	; RCERA - Electroni c Remittan ce Advice (#344.4) I EN
	6501	"RTN","RCD PEAP1",218 ,0)
	6502	; RCLINES - Array o f ERA line reference s (passed in by refe rence)
	6503	"RTN","RCD PEAP1",219 ,0)
	6504	; RCLINES (ERALINE)= 1 - ERA l ine(s) are postable. Also RCL INES count er is incr emented.
	6505	"RTN","RCD PEAP1",220 ,0)
	6506	; RCLINES (ERALINE)= 0^^Reject Reason Cod e - ERA li ne(s) are not postab le
	6507	"RTN","RCD PEAP1",221 ,0)
	6508	; NOTE: O RIGINAL ER A SEQUENCE S (#.09) c an have mu ltiple ERA line refe rences sep arated by commas (e. g.,"3,4")
	6509	"RTN","RCD PEAP1",222 ,0)
	6510	;
	6511	"RTN","RCD PEAP1",223 ,0)
	6512	;Check fo r ScratchP ad entry. If missin g (should not happen ), quit
	6513	"RTN","RCD PEAP1",224 ,0)
	6514	N RCSCR
	6515	"RTN","RCD PEAP1",225 ,0)
	6516	S RCSCR=$ O(^RCY(344 .49,"B",+$ G(RCERA)," "))
	6517	"RTN","RCD PEAP1",226 ,0)
	6518	I RCSCR=" " S RCLINE S=0 Q
	6519	"RTN","RCD PEAP1",227 ,0)
	6520	;Loop thr ough scrat chpad for this ERA
	6521	"RTN","RCD PEAP1",228 ,0)
	6522	N SUB,SUB 1,WLINE,ER ALINE,PIEC E,SEQ,CLAI M,STATUS,C LARRAY,AUT OPOST
	6523	"RTN","RCD PEAP1",229 ,0)
	6524	S SUB=0 F S SUB=$O (^RCY(344. 49,RCSCR,1 ,"B",SUB)) Q:SUB="" D
	6525	"RTN","RCD PEAP1",230 ,0)
	6526	. ;Get sc ratchpad l ine and da ta
	6527	"RTN","RCD PEAP1",231 ,0)
	6528	. S SUB1= $O(^RCY(34 4.49,RCSCR ,1,"B",SUB ,""))
	6529	"RTN","RCD PEAP1",232 ,0)
	6530	. I 'SUB1 Q
	6531	"RTN","RCD PEAP1",233 ,0)
	6532	. S WLINE =$G(^RCY(3 44.49,RCSC R,1,SUB1,0 ))
	6533	"RTN","RCD PEAP1",234 ,0)
	6534	. ;If int eger seque nce, get E RA line re ference an d check fo r auto-pos t flag
	6535	"RTN","RCD PEAP1",235 ,0)
	6536	. I $P(WL INE,U)?1N. N D Q
	6537	"RTN","RCD PEAP1",236 ,0)
	6538	.. S ERAL INE=$P(WLI NE,U,9)
	6539	"RTN","RCD PEAP1",237 ,0)
	6540	.. ; If E RA referen ce is miss ing (shoul d not happ en), skip ahead to n ext intege r sequence
	6541	"RTN","RCD PEAP1",238 ,0)
	6542	.. I ERAL INE="" S S UB=SUB\1_" .999" Q
	6543	"RTN","RCD PEAP1",239 ,0)
	6544	.. ; Chec k for rece ipt - PRCA 4.5318
	6545	"RTN","RCD PEAP1",240 ,0)
	6546	.. I $$GE T1^DIQ(344 .41,ERALIN E_","_RCER A_",",.25) ]"" S SUB= SUB\1_".99 9" Q ; PR CA4.5318
	6547	"RTN","RCD PEAP1",241 ,0)
	6548	.. S AUTO POST=1
	6549	"RTN","RCD PEAP1",242 ,0)
	6550	.. F PIEC E=1:1 S SE Q=$P(ERALI NE,",",PIE CE) Q:'SEQ I '$P($G (^RCY(344. 4,RCERA,1, SEQ,5)),U, 2) S AUTOP OST=0 Q
	6551	"RTN","RCD PEAP1",243 ,0)
	6552	.. ; Unle ss all of the associ ated ERA d etail line s are set for auto-p ost, skip ahead to n ext intege r sequence
	6553	"RTN","RCD PEAP1",244 ,0)
	6554	.. I 'AUT OPOST S SU B=SUB\1_". 999" Q
	6555	"RTN","RCD PEAP1",245 ,0)
	6556	. ;If no claim numb er (suspen se), set t o autopost but check the rest of the lin es for the ERA refer ence
	6557	"RTN","RCD PEAP1",246 ,0)
	6558	. S CLAIM =$P(WLINE, U,7)
	6559	"RTN","RCD PEAP1",247 ,0)
	6560	. I 'CLAI M S RCLINE S(ERALINE) =1 Q
	6561	"RTN","RCD PEAP1",248 ,0)
	6562	. ;Quit w ith error if claim i s not OPEN or ACTIVE
	6563	"RTN","RCD PEAP1",249 ,0)
	6564	. S STATU S=$P($G(^P RCA(430,CL AIM,0)),"^ ",8)
	6565	"RTN","RCD PEAP1",250 ,0)
	6566	. I STATU S'=42,STAT US'=16 S R CLINES(ERA LINE)="0^^ 5",SUB=SUB \1_".999" Q
	6567	"RTN","RCD PEAP1",251 ,0)
	6568	. ;Quit w ith error if referre d to gener al council
	6569	"RTN","RCD PEAP1",252 ,0)
	6570	. I $P($G (^PRCA(430 ,CLAIM,6)) ,U,4)]"" S RCLINES(E RALINE)="0 ^^7",SUB=S UB\1_".999 " Q
	6571	"RTN","RCD PEAP1",253 ,0)
	6572	. ;Check for negati ve payment amount
	6573	"RTN","RCD PEAP1",254 ,0)
	6574	. I $P(WL INE,U,6)<0 S RCLINES (ERALINE)= "0^^6",SUB =SUB\1_".9 99" Q
	6575	"RTN","RCD PEAP1",255 ,0)
	6576	. ;Increm ent claim balance. If payment exceeds c laim balan ce and no pending pa yments (at the time of auto po sting), qu it
	6577	"RTN","RCD PEAP1",256 ,0)
	6578	. ; with error. A lso deduct the amoun t from the balance s o subseque nt, smalle r amounts may get po sted
	6579	"RTN","RCD PEAP1",257 ,0)
	6580	. S CLARR AY(CLAIM)= +$G(CLARRA Y(CLAIM))+ $P(WLINE,U ,3)
	6581	"RTN","RCD PEAP1",258 ,0)
	6582	. I '$$CH ECKPAY^RCD PEAP(.CLAR RAY,CLAIM) S RCLINES (ERALINE)= "0^^3",SUB =SUB\1_".9 99",CLARRA Y(CLAIM)=+ $G(CLARRAY (CLAIM))-$ P(WLINE,U, 3) Q
	6583	"RTN","RCD PEAP1",259 ,0)
	6584	. ;Line i s potentia lly postab le - updat e flag
	6585	"RTN","RCD PEAP1",260 ,0)
	6586	. S RCLIN ES(ERALINE )=1
	6587	"RTN","RCD PEAP1",261 ,0)
	6588	;
	6589	"RTN","RCD PEAP1",262 ,0)
	6590	;Reset th e MARK FOR AUTOPOST flag on ER A lines an d return c ount of au to-postabl e lines - PRCA4.53 18
	6591	"RTN","RCD PEAP1",263 ,0)
	6592	N DA,DIE, DR,RCLIN,R CI
	6593	"RTN","RCD PEAP1",264 ,0)
	6594	S RCLIN=0 ,RCLINES=0 F S RCLI N=$O(RCLIN ES(RCLIN)) Q:'RCLIN D
	6595	"RTN","RCD PEAP1",265 ,0)
	6596	. I +RCLI NES(RCLIN) S RCLINES =RCLINES+1
	6597	"RTN","RCD PEAP1",266 ,0)
	6598	. ;Set MA RK FOR AUT O-POST (#6 ) to NO fo r every li ne
	6599	"RTN","RCD PEAP1",267 ,0)
	6600	. S DA(1) =RCERA,DA= RCLIN,DIE= "^RCY(344. 4,"_DA(1)_ ",1,"
	6601	"RTN","RCD PEAP1",268 ,0)
	6602	. S DR="6 ///0"
	6603	"RTN","RCD PEAP1",269 ,0)
	6604	. D ^DIE
	6605	"RTN","RCD PEAP1",270 ,0)
	6606	Q
	6607	"RTN","RCD PEAP1",271 ,0)
	6608	;
	6609	"RTN","RCD PEAP1",272 ,0)
	6610	UNBAL(RCER A) ; PRCA* 4.5*318 ad ded method
	6611	"RTN","RCD PEAP1",273 ,0)
	6612	; Determi ne if the ERA total matches th e EFT tota l for the selected E RA
	6613	"RTN","RCD PEAP1",274 ,0)
	6614	; Input: RCERA - Interna l IEN of t he selecte d ERA
	6615	"RTN","RCD PEAP1",275 ,0)
	6616	; Returns : 1 - ERA is unbalan ced, 0 oth erwise
	6617	"RTN","RCD PEAP1",276 ,0)
	6618	N RCLTOT, RCSUB,RCTO T
	6619	"RTN","RCD PEAP1",277 ,0)
	6620	;ERA tota l balance - on match ed ERAs th e ERA tota l balance is the sam e as the E FT total
	6621	"RTN","RCD PEAP1",278 ,0)
	6622	S RCTOT=+ $$GET1^DIQ (344.4,RCE RA_",",.05 )
	6623	"RTN","RCD PEAP1",279 ,0)
	6624	;Sum of E RA claim l ine paymen ts
	6625	"RTN","RCD PEAP1",280 ,0)
	6626	S RCSUB=0 ,RCLTOT=0
	6627	"RTN","RCD PEAP1",281 ,0)
	6628	F S RCSU B=$O(^RCY( 344.4,RCER A,1,RCSUB) ) Q:'RCSUB D
	6629	"RTN","RCD PEAP1",282 ,0)
	6630	. S RCLTO T=RCLTOT+$ $GET1^DIQ( 344.41,RCS UB_","_RCE RA_",",.03 )
	6631	"RTN","RCD PEAP1",283 ,0)
	6632	;Plus sum of ERA ad justment l ines
	6633	"RTN","RCD PEAP1",284 ,0)
	6634	S RCSUB=0
	6635	"RTN","RCD PEAP1",285 ,0)
	6636	F S RCSU B=$O(^RCY( 344.4,RCER A,2,RCSUB) ) Q:'RCSUB D
	6637	"RTN","RCD PEAP1",286 ,0)
	6638	. S RCLTO T=RCLTOT+$ $GET1^DIQ( 344.42,RCS UB_","_RCE RA_",",.03 )
	6639	"RTN","RCD PEAP1",287 ,0)
	6640	;Return 1 if total of ERA lin es does no t match EF T
	6641	"RTN","RCD PEAP1",288 ,0)
	6642	Q $S(RCTO T=RCLTOT:0 ,1:1)
	6643	"RTN","RCD PEAR2")
	6644	0^10^B1115 29113^B996 64049
	6645	"RTN","RCD PEAR2",1,0 )
	6646	RCDPEAR2 ; ALB/TMK/PJ H - EFT Un matched Ag ing Report - FILE 34 4.3 ;Nov 2 4, 2014@18 :31:57
	6647	"RTN","RCD PEAR2",2,0 )
	6648	;;4.5;Acc ounts Rece ivable;1 73,269,276 ,284,283,2 93,298,318 ;Mar 20, 1995;Buil d 25
	6649	"RTN","RCD PEAR2",3,0 )
	6650	;Per VA D irective 6 402, this routine sh ould not b e modified .
	6651	"RTN","RCD PEAR2",4,0 )
	6652	Q
	6653	"RTN","RCD PEAR2",5,0 )
	6654	;
	6655	"RTN","RCD PEAR2",6,0 )
	6656	; PRCA4. 5298 note s at botto m
	6657	"RTN","RCD PEAR2",7,0 )
	6658	EN1 ; opti on: EFT Un matched Ag ing Report [RCDPE EF T AGING RE PORT]
	6659	"RTN","RCD PEAR2",8,0 )
	6660	N %ZIS,DI C,DIR,DTOU T,DUOUT,PO P,RCDISPTY ,RCDTRNG,R CEND,RCHDR ,RCJOB
	6661	"RTN","RCD PEAR2",9,0 )
	6662	N RCJOB1, RCLSTMGR,R CNP,RCPYRL ST,RCPGNUM ,RCSTART,R CTMPND,X,Y
	6663	"RTN","RCD PEAR2",10, 0)
	6664	; RCDISPT Y = displa y type
	6665	"RTN","RCD PEAR2",11, 0)
	6666	; RCEND = end date
	6667	"RTN","RCD PEAR2",12, 0)
	6668	; RCLSTMG R = list m anager fla g
	6669	"RTN","RCD PEAR2",13, 0)
	6670	; RCNP = payer info : "1^first payer^las t payer" o r "2^^" (f or all)
	6671	"RTN","RCD PEAR2",14, 0)
	6672	; RCPYRLS T - payer list for s elected pa yers
	6673	"RTN","RCD PEAR2",15, 0)
	6674	; RCDTRNG = "1^start date^end date"
	6675	"RTN","RCD PEAR2",16, 0)
	6676	; RCSTART = start d ate
	6677	"RTN","RCD PEAR2",17, 0)
	6678	; RCTMPND = name of the subsc ript for ^ TMP to use
	6679	"RTN","RCD PEAR2",18, 0)
	6680	;
	6681	"RTN","RCD PEAR2",19, 0)
	6682	S RCLSTMG R="" ; in itial valu e
	6683	"RTN","RCD PEAR2",20, 0)
	6684	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) EN1Q
	6685	"RTN","RCD PEAR2",21, 0)
	6686	S RCSTART =$P(RCDTRN G,U,2)-1,R CEND=$P(RC DTRNG,U,3)
	6687	"RTN","RCD PEAR2",22, 0)
	6688	;Get insu rance comp any to be used as fi lter
	6689	"RTN","RCD PEAR2",23, 0)
	6690	; PRCA4. 5284 - RC NP (Type o f Response (1=Range,2 =All,3=Spe cific)^Fro m name^To name)
	6691	"RTN","RCD PEAR2",24, 0)
	6692	S RCNP=$$ GETPAY^RCD PEM9(344.3 1) G:RCNP< 0 EN1Q
	6693	"RTN","RCD PEAR2",25, 0)
	6694	;Get disp lay type
	6695	"RTN","RCD PEAR2",26, 0)
	6696	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 EN1Q
	6697	"RTN","RCD PEAR2",27, 0)
	6698	; display device in fo about E xcel forma t, set Lis tMan flag to prevent question
	6699	"RTN","RCD PEAR2",28, 0)
	6700	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	6701	"RTN","RCD PEAR2",29, 0)
	6702	I $D(DUOU T)!$D(DTOU T) G EN1Q
	6703	"RTN","RCD PEAR2",30, 0)
	6704	S RCJOB=$ J ; neede d in RPTOU T
	6705	"RTN","RCD PEAR2",31, 0)
	6706	;
	6707	"RTN","RCD PEAR2",32, 0)
	6708	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	6709	"RTN","RCD PEAR2",33, 0)
	6710	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL I RCLST MGR<0 G EN 1Q
	6711	"RTN","RCD PEAR2",34, 0)
	6712	; display in ListMa n format a nd exit on return
	6713	"RTN","RCD PEAR2",35, 0)
	6714	I RCLSTMG R D G EN1 Q
	6715	"RTN","RCD PEAR2",36, 0)
	6716	.S RCTMPN D=$T(+0)_" ^EFT UNMAT CHED AGING " K ^TMP( $J,RCTMPND ) ; clean any resid ue
	6717	"RTN","RCD PEAR2",37, 0)
	6718	.D RPTOUT
	6719	"RTN","RCD PEAR2",38, 0)
	6720	.N H,L,HD R S L=0
	6721	"RTN","RCD PEAR2",39, 0)
	6722	.S HDR("T ITLE")=$$H DRNM
	6723	"RTN","RCD PEAR2",40, 0)
	6724	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take fir st 3 lines of report header
	6725	"RTN","RCD PEAR2",41, 0)
	6726	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	6727	"RTN","RCD PEAR2",42, 0)
	6728	..N N S N =0,H=L F S H=$O(RCH DR(H)) Q:' H S N=N+. 001,^TMP($ J,RCTMPND, N)=RCHDR(H )
	6729	"RTN","RCD PEAR2",43, 0)
	6730	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	6731	"RTN","RCD PEAR2",44, 0)
	6732	;
	6733	"RTN","RCD PEAR2",45, 0)
	6734	S RCJOB=$ J,RCTMPND= ""
	6735	"RTN","RCD PEAR2",46, 0)
	6736	; Ask dev ice
	6737	"RTN","RCD PEAR2",47, 0)
	6738	S %ZIS="Q M" D ^%ZIS G:POP EN1 Q
	6739	"RTN","RCD PEAR2",48, 0)
	6740	I $D(IO(" Q")) D G EN1Q
	6741	"RTN","RCD PEAR2",49, 0)
	6742	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSTOP
	6743	"RTN","RCD PEAR2",50, 0)
	6744	.S ZTRTN= "RPTOUT^RC DPEAR2",ZT DESC="EFT AGING REPO RT"
	6745	"RTN","RCD PEAR2",51, 0)
	6746	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	6747	"RTN","RCD PEAR2",52, 0)
	6748	.; PRCA4 .5284 - B ecause TMP global ma y be on an other serv er, save o ff specifi c payers i n local
	6749	"RTN","RCD PEAR2",53, 0)
	6750	.I +RCNP= 3 M RCPYRL ST=^TMP("R CSELPAY",$ J)
	6751	"RTN","RCD PEAR2",54, 0)
	6752	.D ^%ZTLO AD
	6753	"RTN","RCD PEAR2",55, 0)
	6754	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	6755	"RTN","RCD PEAR2",56, 0)
	6756	.K ZTSK,I O("Q") D H OME^%ZIS
	6757	"RTN","RCD PEAR2",57, 0)
	6758	;
	6759	"RTN","RCD PEAR2",58, 0)
	6760	U IO D RP TOUT
	6761	"RTN","RCD PEAR2",59, 0)
	6762	;
	6763	"RTN","RCD PEAR2",60, 0)
	6764	EN1Q ; exi t and clea n up
	6765	"RTN","RCD PEAR2",61, 0)
	6766	I 'RCLSTM GR D ^%ZIS C
	6767	"RTN","RCD PEAR2",62, 0)
	6768	K ^TMP("R CSELPAY",$ J),^TMP("R CPAYER",$J )
	6769	"RTN","RCD PEAR2",63, 0)
	6770	Q
	6771	"RTN","RCD PEAR2",64, 0)
	6772	;
	6773	"RTN","RCD PEAR2",65, 0)
	6774	RPTOUT ; E ntry point for queue d job, nig htly job
	6775	"RTN","RCD PEAR2",66, 0)
	6776	; RCTMPND = name of the subsc ript for ^ TMP to use to return all lines
	6777	"RTN","RCD PEAR2",67, 0)
	6778	; If undefi ned or nul l, output is printed
	6779	"RTN","RCD PEAR2",68, 0)
	6780	; Return global if RCTMPND no t null: ^T MP($J,RCTM PND,line#) =line text
	6781	"RTN","RCD PEAR2",69, 0)
	6782	N DIC,DUO UT,RC0,RC1 3,RC3443,R CCT,RCIEN, RCNT,RCOUT ,RCPAY,RCP AYER,RCPAY ID
	6783	"RTN","RCD PEAR2",70, 0)
	6784	N RCSTOP, RCTOT,RCZ, X,XX,YY,Z, Z0,ZZ
	6785	"RTN","RCD PEAR2",71, 0)
	6786	S RCTMPND =$G(RCTMPN D)
	6787	"RTN","RCD PEAR2",72, 0)
	6788	S (RCCT,R CSTOP,RCNT ,RCTOT)=0
	6789	"RTN","RCD PEAR2",73, 0)
	6790	K ^TMP($J ,"RCERA_AG ED"),^TMP( $J,"RCERA_ ADJ")
	6791	"RTN","RCD PEAR2",74, 0)
	6792	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	6793	"RTN","RCD PEAR2",75, 0)
	6794	I $G(RCJO B)'="",RCJ OB'=$J D
	6795	"RTN","RCD PEAR2",76, 0)
	6796	.K ^TMP(" RCSELPAY", $J)
	6797	"RTN","RCD PEAR2",77, 0)
	6798	.D RLOAD^ RCDPEAR1(3 44.31)
	6799	"RTN","RCD PEAR2",78, 0)
	6800	.S RCJOB= $J
	6801	"RTN","RCD PEAR2",79, 0)
	6802	; build l ocal payer array her e
	6803	"RTN","RCD PEAR2",80, 0)
	6804	S RCNP=+R CNP
	6805	"RTN","RCD PEAR2",81, 0)
	6806	D SELPAY^ RCDPEAR1(R CNP,RCJOB, .RCPAY)
	6807	"RTN","RCD PEAR2",82, 0)
	6808	I RCTMPND '="" K ^TM P($J,RCTMP ND)
	6809	"RTN","RCD PEAR2",83, 0)
	6810	; cross-r ef on file #344.31 f ield #.08 - MATCH ST ATUS
	6811	"RTN","RCD PEAR2",84, 0)
	6812	S RCIEN=0 F S RCIE N=$O(^RCY( 344.31,"AM ATCH",0,RC IEN)) Q:'R CIEN D ;unmatched entries o nly
	6813	"RTN","RCD PEAR2",85, 0)
	6814	.Q:$P($G( ^RCY(344.3 1,RCIEN,3) ),U) ; EF T has been removed
	6815	"RTN","RCD PEAR2",86, 0)
	6816	.Q:$P($G( ^RCY(344.3 1,RCIEN,0) ),U,7)=0 ; payment of zero
	6817	"RTN","RCD PEAR2",87, 0)
	6818	.;
	6819	"RTN","RCD PEAR2",88, 0)
	6820	.S RC13=$ P($G(^RCY( 344.31,RCI EN,0)),U,1 3) ; date received
	6821	"RTN","RCD PEAR2",89, 0)
	6822	.; Check for payer match
	6823	"RTN","RCD PEAR2",90, 0)
	6824	.I '$$CHK PYR^RCDPED AR(RCIEN,0 ,RCJOB,RCN P) Q ;PR CA4.5318 passed ex isting var iable RCNP
	6825	"RTN","RCD PEAR2",91, 0)
	6826	.; Check date range
	6827	"RTN","RCD PEAR2",92, 0)
	6828	.Q:(RCSTA RT>RC13)!( RC13>RCEND )
	6829	"RTN","RCD PEAR2",93, 0)
	6830	.; Passed all the f ilters - i nclude on report
	6831	"RTN","RCD PEAR2",94, 0)
	6832	.S ^TMP($ J,"RCEFT_A GED",$$FMD IFF^XLFDT( RC13,DT),R CIEN)=0,RC NT=RCNT+1
	6833	"RTN","RCD PEAR2",95, 0)
	6834	;
	6835	"RTN","RCD PEAR2",96, 0)
	6836	D:'RCLSTM GR HDRBLD ; create header
	6837	"RTN","RCD PEAR2",97, 0)
	6838	D:RCLSTMG R HDRLM ; create Li stman head er
	6839	"RTN","RCD PEAR2",98, 0)
	6840	;
	6841	"RTN","RCD PEAR2",99, 0)
	6842	I RCDISPT Y D EXCEL Q
	6843	"RTN","RCD PEAR2",100 ,0)
	6844	;
	6845	"RTN","RCD PEAR2",101 ,0)
	6846	; Find to tal amount of EFTs
	6847	"RTN","RCD PEAR2",102 ,0)
	6848	S RCZ="" F S RCZ=$ O(^TMP($J, "RCEFT_AGE D",RCZ)) Q :RCZ="" S RCIEN=0 F S RCIEN= $O(^TMP($J ,"RCEFT_AG ED",RCZ,RC IEN)) Q:'R CIEN D G :RCSTOP PR TQ
	6849	"RTN","RCD PEAR2",103 ,0)
	6850	.I $D(ZTQ UEUED),$$S ^%ZTLOAD S (RCSTOP,Z TSTOP)=1 K ZTREQ I + $G(RCPGNUM ) W:RCTMPN D="" !!,"* TASK STO PPED BY US ER*" Q
	6851	"RTN","RCD PEAR2",104 ,0)
	6852	.S RC0=$G (^RCY(344. 31,RCIEN,0 )),RC3443= $G(^RCY(34 4.3,+RC0,0 ))
	6853	"RTN","RCD PEAR2",105 ,0)
	6854	.S RCTOT= RCTOT+$P(R C0,U,7)
	6855	"RTN","RCD PEAR2",106 ,0)
	6856	;
	6857	"RTN","RCD PEAR2",107 ,0)
	6858	D:'RCLSTM GR HDRLST^ RCDPEARL(. RCSTOP,.RC HDR) ; in itial repo rt header
	6859	"RTN","RCD PEAR2",108 ,0)
	6860	;
	6861	"RTN","RCD PEAR2",109 ,0)
	6862	S Z=$$SET STR^VALM1( "Totals:", "",1,79)
	6863	"RTN","RCD PEAR2",110 ,0)
	6864	D SL^RCDP EARL(Z,.RC CT,RCTMPND )
	6865	"RTN","RCD PEAR2",111 ,0)
	6866	S Z=$$SET STR^VALM1( " Number A ged Electr onic EFT M essages Fo und: "_RCN T,"",1,79)
	6867	"RTN","RCD PEAR2",112 ,0)
	6868	D SL^RCDP EARL(Z,.RC CT,RCTMPND )
	6869	"RTN","RCD PEAR2",113 ,0)
	6870	S Z=$$SET STR^VALM1( " Amount A ged Electr onic EFT M essages Fo und: $"_$F N(+RCTOT," ,",2),"",1 ,79)
	6871	"RTN","RCD PEAR2",114 ,0)
	6872	D SL^RCDP EARL(Z,.RC CT,RCTMPND )
	6873	"RTN","RCD PEAR2",115 ,0)
	6874	D SL^RCDP EARL($TR($ J("",IOM), " ","="),. RCCT,RCTMP ND)
	6875	"RTN","RCD PEAR2",116 ,0)
	6876	;
	6877	"RTN","RCD PEAR2",117 ,0)
	6878	S RCZ="" F S RCZ=$ O(^TMP($J, "RCEFT_AGE D",RCZ)) Q :RCZ="" S RCIEN=0 F S RCIEN= $O(^TMP($J ,"RCEFT_AG ED",RCZ,RC IEN)) Q:'R CIEN D G :RCSTOP PR TQ
	6879	"RTN","RCD PEAR2",118 ,0)
	6880	.I $D(ZTQ UEUED),$$S ^%ZTLOAD S (RCSTOP,Z TSTOP)=1 K ZTREQ I + $G(RCPGNUM ) W:RCTMPN D="" !!,"* TASK STO PPED BY US ER*" Q
	6881	"RTN","RCD PEAR2",119 ,0)
	6882	.I RCPGNU M D SL^RCD PEARL(" ", .RCCT,.RCT MPND) ; On detail li st, skip l ine
	6883	"RTN","RCD PEAR2",120 ,0)
	6884	.I 'RCLST MGR,$Y>(IO SL-RCHDR(0 )) D HDRLS T^RCDPEARL (.RCSTOP,. RCHDR) Q:R CSTOP
	6885	"RTN","RCD PEAR2",121 ,0)
	6886	.S RC0=$G (^RCY(344. 31,RCIEN,0 )),RC3443= $G(^RCY(34 4.3,+RC0,0 ))
	6887	"RTN","RCD PEAR2",122 ,0)
	6888	.S RCTOT= RCTOT+$P(R C0,U,7)
	6889	"RTN","RCD PEAR2",123 ,0)
	6890	.S Z=$$SE TSTR^VALM1 ($J(-RCZ,4 ),"",1,4)
	6891	"RTN","RCD PEAR2",124 ,0)
	6892	.; PRCA4 .5318 mov ed deposit date up a row to gi ve more ro om for pay er/payer I D
	6893	"RTN","RCD PEAR2",125 ,0)
	6894	.S Z=$$SE TSTR^VALM1 (" "_$P(R C0,U,4),Z, 5,52) ;tr ace#
	6895	"RTN","RCD PEAR2",126 ,0)
	6896	.S Z=$$SE TSTR^VALM1 ($$FMTE^XL FDT($P(RC0 ,U,12),2), Z,73,8) ; deposit d ate
	6897	"RTN","RCD PEAR2",127 ,0)
	6898	.D SL^RCD PEARL(Z,.R CCT,RCTMPN D)
	6899	"RTN","RCD PEAR2",128 ,0)
	6900	.N RCPAY S RCPAY=$P (RC0,U,2) S:RCPAY="" RCPAY="NO PAYER NAM E RECEIVED " ; PRCA4 .5298
	6901	"RTN","RCD PEAR2",129 ,0)
	6902	.S RCPAYI D=$P(RC0,U ,3) ; Payer ID ;PRCA4 .5298
	6903	"RTN","RCD PEAR2",130 ,0)
	6904	.;PRCA4. 5318 dyna mically di splay paye r name/ID based on l ength
	6905	"RTN","RCD PEAR2",131 ,0)
	6906	.S RCPAYE R=RCPAY_"/ "_RCPAYID
	6907	"RTN","RCD PEAR2",132 ,0)
	6908	.I $L(RCP AYER)>76 D
	6909	"RTN","RCD PEAR2",133 ,0)
	6910	. . S ZZ= $L(RCPAYER ,"/"),XX=$ P(RCPAYER, "/",1,ZZ-1 ),YY=$P(RC PAYER,"/", ZZ)
	6911	"RTN","RCD PEAR2",134 ,0)
	6912	. . S XX= $E(RCPAYER ,1,$L(XX)- ($L(RCPAYE R)-76)),RC PAYER=XX_" /"_YY
	6913	"RTN","RCD PEAR2",135 ,0)
	6914	.S Z=$$SE TSTR^VALM1 (RCPAYER," ",5,76) ; PRCA4.52 98 (payer /payer ID)
	6915	"RTN","RCD PEAR2",136 ,0)
	6916	.;S Z=$$S ETSTR^VALM 1(" "_$$F MTE^XLFDT( $P(RC0,U,1 2),2),Z,70 ,10) ; de posit date
	6917	"RTN","RCD PEAR2",137 ,0)
	6918	.;end of PRCA4.53 18 display change
	6919	"RTN","RCD PEAR2",138 ,0)
	6920	.D SL^RCD PEARL(Z,.R CCT,RCTMPN D)
	6921	"RTN","RCD PEAR2",139 ,0)
	6922	.S Z=$$SE TSTR^VALM1 ($J("",6)_ $S($P(RC0, U,13):$$FM TE^XLFDT($ P(RC0,U,13 ),2),1:"") ,"",1,17)
	6923	"RTN","RCD PEAR2",140 ,0)
	6924	.S Z=$$SE TSTR^VALM1 (" "_$J($ P(RC0,U,7) ,15,2),Z,1 8,17)
	6925	"RTN","RCD PEAR2",141 ,0)
	6926	.; PRCA4 .5283 - c hange leng th from 8 to 11 to a llow for 9 digit DEP #'s
	6927	"RTN","RCD PEAR2",142 ,0)
	6928	.S Z=$$SE TSTR^VALM1 (" "_$P(R C3443,U,6) ,Z,35,11)
	6929	"RTN","RCD PEAR2",143 ,0)
	6930	.S Z=$$SE TSTR^VALM1 (" "_$S($ P(RC3443,U ,12):"",1: "NOT ")_"P osted to 8 NZZ"_$S($P (RC3443,U, 12):" "_$$ FMTE^XLFDT ($P(RC3443 ,U,11),2), 1:""),Z,47 ,36)
	6931	"RTN","RCD PEAR2",144 ,0)
	6932	.D SL^RCD PEARL(Z,.R CCT,RCTMPN D)
	6933	"RTN","RCD PEAR2",145 ,0)
	6934	.K RCOUT
	6935	"RTN","RCD PEAR2",146 ,0)
	6936	.D GETS^D IQ(344.31, RCIEN_",", 2,"E","RCO UT")
	6937	"RTN","RCD PEAR2",147 ,0)
	6938	.Q:'$O(RC OUT(344.31 ,RCIEN_"," ,2,0))
	6939	"RTN","RCD PEAR2",148 ,0)
	6940	.D SL^RCD PEARL($J(" ",8)_"--EX CEPTION NO TES--",.RC CT,RCTMPND )
	6941	"RTN","RCD PEAR2",149 ,0)
	6942	.S Z=0 F S Z=$O(RC OUT(344.31 ,RCIEN_"," ,2,Z)) Q:' Z D Q:RC STOP
	6943	"RTN","RCD PEAR2",150 ,0)
	6944	..I 'RCLS TMGR,$Y>(I OSL-RCHDR( 0)) D HDRL ST^RCDPEAR L(.RCSTOP, .RCHDR) Q: RCSTOP
	6945	"RTN","RCD PEAR2",151 ,0)
	6946	..D SL^RC DPEARL($J( "",8)_" "_ RCOUT(344. 31,RCIEN_" ,",2,Z),.R CCT,RCTMPN D)
	6947	"RTN","RCD PEAR2",152 ,0)
	6948	;
	6949	"RTN","RCD PEAR2",153 ,0)
	6950	;
	6951	"RTN","RCD PEAR2",154 ,0)
	6952	; PRCA4. 5298, put end-of-re port into SL^RCDPEAR L
	6953	"RTN","RCD PEAR2",155 ,0)
	6954	D SL^RCDP EARL(" ",. RCCT,RCTMP ND) ; ski p a line
	6955	"RTN","RCD PEAR2",156 ,0)
	6956	D SL^RCDP EARL($$END ORPRT^RCDP EARL,.RCCT ,RCTMPND)
	6957	"RTN","RCD PEAR2",157 ,0)
	6958	;
	6959	"RTN","RCD PEAR2",158 ,0)
	6960	PRTQ ;
	6961	"RTN","RCD PEAR2",159 ,0)
	6962	; PRCA4. 5298, add ed ListMan check
	6963	"RTN","RCD PEAR2",160 ,0)
	6964	I '$D(ZTQ UEUED),'RC LSTMGR,'RC STOP D ASK ^RCDPEARL( .RCSTOP)
	6965	"RTN","RCD PEAR2",161 ,0)
	6966	I $D(ZTQU EUED) S ZT REQ="@"
	6967	"RTN","RCD PEAR2",162 ,0)
	6968	I '$D(ZTQ UEUED) D ^ %ZISC
	6969	"RTN","RCD PEAR2",163 ,0)
	6970	K ^TMP($J ,"RCEFT_AG ED"),ZTQUE UED
	6971	"RTN","RCD PEAR2",164 ,0)
	6972	Q
	6973	"RTN","RCD PEAR2",165 ,0)
	6974	;
	6975	"RTN","RCD PEAR2",166 ,0)
	6976	; extrins ic variabl e, text fo r header P RCA4.529 8
	6977	"RTN","RCD PEAR2",167 ,0)
	6978	HDRNM() Q "EFT UNMAT CHED AGING REPORT"
	6979	"RTN","RCD PEAR2",168 ,0)
	6980	;
	6981	"RTN","RCD PEAR2",169 ,0)
	6982	HDRBLD ; c reate the report hea der
	6983	"RTN","RCD PEAR2",170 ,0)
	6984	; returns RCHDR, RC PGNUM, RCS TOP
	6985	"RTN","RCD PEAR2",171 ,0)
	6986	; RCHDR (0) = head er text li ne count
	6987	"RTN","RCD PEAR2",172 ,0)
	6988	; RCHDR ("XECUTE") = M code for page n umber
	6989	"RTN","RCD PEAR2",173 ,0)
	6990	; RCHDR ("RUNDATE" ) = date/t ime report generated , external format
	6991	"RTN","RCD PEAR2",174 ,0)
	6992	; RCPGN UM - page counter
	6993	"RTN","RCD PEAR2",175 ,0)
	6994	; RCSTO P - flag t o exit
	6995	"RTN","RCD PEAR2",176 ,0)
	6996	;INPUT:
	6997	"RTN","RCD PEAR2",177 ,0)
	6998	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	6999	"RTN","RCD PEAR2",178 ,0)
	7000	; RCPAY - Payer fil ter value( s)
	7001	"RTN","RCD PEAR2",179 ,0)
	7002	; RCLSTMG R
	7003	"RTN","RCD PEAR2",180 ,0)
	7004	;
	7005	"RTN","RCD PEAR2",181 ,0)
	7006	K RCHDR S RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
	7007	"RTN","RCD PEAR2",182 ,0)
	7008	;
	7009	"RTN","RCD PEAR2",183 ,0)
	7010	I RCDISPT Y D Q ; Excel form at, xecute code is Q UIT, null page numbe r
	7011	"RTN","RCD PEAR2",184 ,0)
	7012	.S RCHDR( 0)=1,RCHDR ("XECUTE") ="Q",RCPGN UM=""
	7013	"RTN","RCD PEAR2",185 ,0)
	7014	.S RCHDR( 1)="Aged D ays^Trace #^Deposit From/ID^Fi le Date^De posit Amou nt^Deposit #^Deposit Post Stat us^Deposit Date"
	7015	"RTN","RCD PEAR2",186 ,0)
	7016	;
	7017	"RTN","RCD PEAR2",187 ,0)
	7018	N START,E ND,MSG,DAT E,Y,DIV,HC NT
	7019	"RTN","RCD PEAR2",188 ,0)
	7020	S START=$ $FMTE^XLFD T($P(RCDTR NG,U,2),2) ,END=$$FMT E^XLFDT($P (RCDTRNG,U ,3),2)
	7021	"RTN","RCD PEAR2",189 ,0)
	7022	;
	7023	"RTN","RCD PEAR2",190 ,0)
	7024	S Y=$$HDR NM,HCNT=1, RCHDR(HCNT )=$J("",80 -$L(Y)\2)_ Y ; line 1 will be replaced b y XECUTE c ode below
	7025	"RTN","RCD PEAR2",191 ,0)
	7026	S RCHDR(" XECUTE")=" N Y S RCPG NUM=RCPGNU M+1,Y=$$HD RNM^"_$T(+ 0)_"_$S(RC LSTMGR:""" ",1:$J(""P age: ""_RC PGNUM,12)) ,RCHDR(1)= $J("" "",8 0-$L(Y)\2) _Y"
	7027	"RTN","RCD PEAR2",192 ,0)
	7028	S Y="RUN DATE: "_RC HDR("RUNDA TE"),HCNT= HCNT+1,RCH DR(HCNT)=$ J("",80-$L (Y)\2)_Y ; line 1 w ill be rep laced by X ECUTE code below
	7029	"RTN","RCD PEAR2",193 ,0)
	7030	;
	7031	"RTN","RCD PEAR2",194 ,0)
	7032	; Payer(s )
	7033	"RTN","RCD PEAR2",195 ,0)
	7034	S Y="PAYE RS: " D
	7035	"RTN","RCD PEAR2",196 ,0)
	7036	.I $D(RCP AY)=1 S Y= Y_RCPAY,HC NT=HCNT+1, RCHDR(HCNT )=$J("",80 -$L(Y)\2)_ Y Q
	7037	"RTN","RCD PEAR2",197 ,0)
	7038	.N S,X S S=0 F S S =$O(RCPAY( S)) Q:'S D
	7039	"RTN","RCD PEAR2",198 ,0)
	7040	..S X=RCP AY(S)_$S($ O(RCPAY(S) ):", ",1:" ")
	7041	"RTN","RCD PEAR2",199 ,0)
	7042	..I $L(X) +$L(Y)>80 S HCNT=HCN T+1,RCHDR( HCNT)=Y,Y= $J(" ",8)
	7043	"RTN","RCD PEAR2",200 ,0)
	7044	..S Y=Y_X
	7045	"RTN","RCD PEAR2",201 ,0)
	7046	.;
	7047	"RTN","RCD PEAR2",202 ,0)
	7048	.S:$TR(Y, " ")]"" HC NT=HCNT+1, RCHDR(HCNT )=Y ; any residual data
	7049	"RTN","RCD PEAR2",203 ,0)
	7050	S Y="DATE RANGE: "_ $P($$FMTE^ XLFDT(STAR T,2),"@")_ " - "_$P($ $FMTE^XLFD T(END,2)," @")_" (DAT E EFT FILE D)"
	7051	"RTN","RCD PEAR2",204 ,0)
	7052	S Y=$J("" ,80-$L(Y)\ 2)_Y,HCNT= HCNT+1,RCH DR(HCNT)=Y
	7053	"RTN","RCD PEAR2",205 ,0)
	7054	;
	7055	"RTN","RCD PEAR2",206 ,0)
	7056	S Y="AGED ",HCNT=HCN T+1,RCHDR( HCNT)=Y
	7057	"RTN","RCD PEAR2",207 ,0)
	7058	; PRCA4. 5318 move d deposit date up a row
	7059	"RTN","RCD PEAR2",208 ,0)
	7060	S Y="DAYS TRACE # DE P DATE",HC NT=HCNT+1, RCHDR(HCNT )=Y
	7061	"RTN","RCD PEAR2",209 ,0)
	7062	S Y=" DEPOSIT FR OM/ID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	7063	"RTN","RCD PEAR2",210 ,0)
	7064	S Y=" FILE DAT E DEPO SIT AMOUNT DEP # DEPOSI T POST STA TUS",HCNT= HCNT+1,RCH DR(HCNT)=Y
	7065	"RTN","RCD PEAR2",211 ,0)
	7066	S Y="",$P (Y,"=",81) ="",HCNT=H CNT+1,RCHD R(HCNT)=Y ; row of equal sign s at botto m
	7067	"RTN","RCD PEAR2",212 ,0)
	7068	;
	7069	"RTN","RCD PEAR2",213 ,0)
	7070	S RCHDR(0 )=HCNT
	7071	"RTN","RCD PEAR2",214 ,0)
	7072	;
	7073	"RTN","RCD PEAR2",215 ,0)
	7074	Q
	7075	"RTN","RCD PEAR2",216 ,0)
	7076	;
	7077	"RTN","RCD PEAR2",217 ,0)
	7078	HDRLM ; cr eate the L istman hea der sectio n
	7079	"RTN","RCD PEAR2",218 ,0)
	7080	; returns RCHDR
	7081	"RTN","RCD PEAR2",219 ,0)
	7082	; RCHDR (0) = head er text li ne count
	7083	"RTN","RCD PEAR2",220 ,0)
	7084	;INPUT:
	7085	"RTN","RCD PEAR2",221 ,0)
	7086	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	7087	"RTN","RCD PEAR2",222 ,0)
	7088	; RCPAY - Payer fil ter value( s)
	7089	"RTN","RCD PEAR2",223 ,0)
	7090	;
	7091	"RTN","RCD PEAR2",224 ,0)
	7092	K RCHDR S RCPGNUM=0 ,RCSTOP=0
	7093	"RTN","RCD PEAR2",225 ,0)
	7094	;
	7095	"RTN","RCD PEAR2",226 ,0)
	7096	N START,E ND,MSG,DAT E,Y,DIV,HC NT
	7097	"RTN","RCD PEAR2",227 ,0)
	7098	S START=$ $FMTE^XLFD T($P(RCDTR NG,U,2),2) ,END=$$FMT E^XLFDT($P (RCDTRNG,U ,3),2)
	7099	"RTN","RCD PEAR2",228 ,0)
	7100	S Y="DATE RANGE: "_ $P($$FMTE^ XLFDT(STAR T,2),"@")_ " - "_$P($ $FMTE^XLFD T(END,2)," @")_" (DAT E EFT FILE D)"
	7101	"RTN","RCD PEAR2",229 ,0)
	7102	S HCNT=1, RCHDR(HCNT )=Y
	7103	"RTN","RCD PEAR2",230 ,0)
	7104	; Payer(s )
	7105	"RTN","RCD PEAR2",231 ,0)
	7106	S Y="PAYE RS: " D
	7107	"RTN","RCD PEAR2",232 ,0)
	7108	.I $D(RCP AY)=1 S Y= Y_RCPAY,HC NT=HCNT+1, RCHDR(HCNT )=Y Q
	7109	"RTN","RCD PEAR2",233 ,0)
	7110	.N S,X S S=0 F S S =$O(RCPAY( S)) Q:'S D
	7111	"RTN","RCD PEAR2",234 ,0)
	7112	..S X=RCP AY(S)_$S($ O(RCPAY(S) ):", ",1:" ")
	7113	"RTN","RCD PEAR2",235 ,0)
	7114	..I $L(X) +$L(Y)>80 S HCNT=HCN T+1,RCHDR( HCNT)=Y,Y= $J(" ",8)
	7115	"RTN","RCD PEAR2",236 ,0)
	7116	..S Y=Y_X
	7117	"RTN","RCD PEAR2",237 ,0)
	7118	.;
	7119	"RTN","RCD PEAR2",238 ,0)
	7120	.S:$TR(Y, " ")]"" HC NT=HCNT+1, RCHDR(HCNT )=Y ; any residual data
	7121	"RTN","RCD PEAR2",239 ,0)
	7122	;
	7123	"RTN","RCD PEAR2",240 ,0)
	7124	S HCNT=HC NT+1,RCHDR (HCNT)=""
	7125	"RTN","RCD PEAR2",241 ,0)
	7126	S Y="AGED ",HCNT=HCN T+1,RCHDR( HCNT)=Y
	7127	"RTN","RCD PEAR2",242 ,0)
	7128	; PRCA4. 5318 move d deposit date up a row
	7129	"RTN","RCD PEAR2",243 ,0)
	7130	S Y="DAYS TRACE # DEP DATE",HCN T=HCNT+1,R CHDR(HCNT) =Y
	7131	"RTN","RCD PEAR2",244 ,0)
	7132	S Y=" DEPOSIT FR OM/ID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	7133	"RTN","RCD PEAR2",245 ,0)
	7134	S Y=" FILE DATE DEPOS IT AMOUNT DEP # DEPOSIT POST STAT US",HCNT=H CNT+1,RCHD R(HCNT)=Y
	7135	"RTN","RCD PEAR2",246 ,0)
	7136	;
	7137	"RTN","RCD PEAR2",247 ,0)
	7138	S RCHDR(0 )=HCNT
	7139	"RTN","RCD PEAR2",248 ,0)
	7140	;
	7141	"RTN","RCD PEAR2",249 ,0)
	7142	Q
	7143	"RTN","RCD PEAR2",250 ,0)
	7144	;
	7145	"RTN","RCD PEAR2",251 ,0)
	7146	EXCEL ; Pr int report to screen , one reco rd per lin e for expo rt to MS E xcel.
	7147	"RTN","RCD PEAR2",252 ,0)
	7148	; RCTMPND = name of the subsc ript for ^ TMP to use
	7149	"RTN","RCD PEAR2",253 ,0)
	7150	W !!,"Age d Days^Tra ce #^Depos it From/ID ^File Date ^Deposit A mount^Depo sit #^Depo sit Post S tatus^Depo sit Date"
	7151	"RTN","RCD PEAR2",254 ,0)
	7152	S RCZ="" F S RCZ=$ O(^TMP($J, "RCEFT_AGE D",RCZ)) Q :RCZ="" S RCIEN=0 F S RCIEN= $O(^TMP($J ,"RCEFT_AG ED",RCZ,RC IEN)) Q:'R CIEN D G :RCSTOP PR TQ2
	7153	"RTN","RCD PEAR2",255 ,0)
	7154	.I $D(ZTQ UEUED),$$S ^%ZTLOAD S (RCSTOP,Z TSTOP)=1 K ZTREQ I + $G(RCPG) W :RCTMPND=" " !!,"**T ASK STOPPE D BY USER **" Q
	7155	"RTN","RCD PEAR2",256 ,0)
	7156	.S RC0=$G (^RCY(344. 31,RCIEN,0 )),RC3443= $G(^RCY(34 4.3,+RC0,0 ))
	7157	"RTN","RCD PEAR2",257 ,0)
	7158	.N RCPAY S RCPAY=$P (RC0,U,2) S:RCPAY="" RCPAY="NO PAYER NAM E RECEIVED " ; PRCA4 .5298
	7159	"RTN","RCD PEAR2",258 ,0)
	7160	.S Z=$J(- RCZ,4)_"^" _$P(RC0,U, 4)_"^"_RCP AY_"/"_$P( RC0,U,3)_" ^"_$S($P(R C0,U,13):$ $FMTE^XLFD T($P(RC0,U ,13),2),1: "")_"^" ; PRCA4.52 98
	7161	"RTN","RCD PEAR2",259 ,0)
	7162	.S Z=Z_$P (RC0,U,7)_ "^"_$P(RC3 443,U,6)_" ^"_$S($P(R C3443,U,12 ):"",1:"NO T ")_"Post ed to 8NZZ "_$S($P(RC 3443,U,12) :"^"_$$FMT E^XLFDT($P (RC0,U,12) ,2),1:"")
	7163	"RTN","RCD PEAR2",260 ,0)
	7164	.W !,Z
	7165	"RTN","RCD PEAR2",261 ,0)
	7166	W !!,"* END OF RE PORT *", !
	7167	"RTN","RCD PEAR2",262 ,0)
	7168	;
	7169	"RTN","RCD PEAR2",263 ,0)
	7170	PRTQ2 ;
	7171	"RTN","RCD PEAR2",264 ,0)
	7172	I $D(ZTQU EUED) S ZT REQ="@"
	7173	"RTN","RCD PEAR2",265 ,0)
	7174	I '$D(ZTQ UEUED) D ^ %ZISC
	7175	"RTN","RCD PEAR2",266 ,0)
	7176	K ^TMP($J ,"RCEFT_AG ED"),^TMP( "RCSELPAY" ,$J),^TMP( "RCPAYER", $J),^TMP($ J,"RCERA_A DJ")
	7177	"RTN","RCD PEAR2",267 ,0)
	7178	Q
	7179	"RTN","RCD PEAR2",268 ,0)
	7180	;
	7181	"RTN","RCD PEAR2",269 ,0)
	7182	;PRCA4.5 298
	7183	"RTN","RCD PEAR2",270 ,0)
	7184	; removed RCIND loc al variabl e
	7185	"RTN","RCD PEAR2",271 ,0)
	7186	; changed RC00 to R C3443
	7187	"RTN","RCD PEAR2",272 ,0)
	7188	; replace d SETLINE with SL^RC DPEARL
	7189	"RTN","RCD PEAR2",273 ,0)
	7190	; added $ $HDRNM
	7191	"RTN","RCD PEAR2",274 ,0)
	7192	; added R CLSTMGR in checks fo r header
	7193	"RTN","RCD PEAR2",275 ,0)
	7194	; changed upper cas e text to mixed case throughou t
	7195	"RTN","RCD PEAR2",276 ,0)
	7196	;
	7197	"RTN","RCD PEDA2")
	7198	0^7^B97233 513^n/a
	7199	"RTN","RCD PEDA2",1,0 )
	7200	RCDPEDA2 ; EDE/DW - A CTIVITY RE PORT ;Feb 17, 2017@1 0:37:00
	7201	"RTN","RCD PEDA2",2,0 )
	7202	;;4.5;Acc ounts Rece ivable;3 18;Mar 2 0, 1995;Bu ild 25
	7203	"RTN","RCD PEDA2",3,0 )
	7204	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7205	"RTN","RCD PEDA2",4,0 )
	7206	Q
	7207	"RTN","RCD PEDA2",5,0 )
	7208	;
	7209	"RTN","RCD PEDA2",6,0 )
	7210	RPT2(INPUT ) ; Entry point from RCDPEDAR
	7211	"RTN","RCD PEDA2",7,0 )
	7212	; Loop th rough EDI LOCKBOX DE POSIT entr ies
	7213	"RTN","RCD PEDA2",8,0 )
	7214	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7215	"RTN","RCD PEDA2",9,0 )
	7216	; A1 - 1 - Call ed by nigh tly job, 0 otherwise
	7217	"RTN","RCD PEDA2",10, 0)
	7218	; A2 - 1 - Disp lay to lis t manager, 0 otherwi se
	7219	"RTN","RCD PEDA2",11, 0)
	7220	; A3 - 1 - Deta il report, 0 - Summa ry report
	7221	"RTN","RCD PEDA2",12, 0)
	7222	; A4 - Current Page Numbe r
	7223	"RTN","RCD PEDA2",13, 0)
	7224	; A5 - Stop Fla g
	7225	"RTN","RCD PEDA2",14, 0)
	7226	; A6 - Start of Date Rang e
	7227	"RTN","RCD PEDA2",15, 0)
	7228	; A7 - End of D ate Range
	7229	"RTN","RCD PEDA2",16, 0)
	7230	; A8 - Current Line Numbe r
	7231	"RTN","RCD PEDA2",17, 0)
	7232	; A9 - Internal Date bein g processe d
	7233	"RTN","RCD PEDA2",18, 0)
	7234	; ^TMP(B1, $J,B2,B3) = ""
	7235	"RTN","RCD PEDA2",19, 0)
	7236	; ^TMP(B1, $J,B2,B3," EFT",B4) = "" W here:
	7237	"RTN","RCD PEDA2",20, 0)
	7238	; B1 - "RCDAILYA CT"
	7239	"RTN","RCD PEDA2",21, 0)
	7240	; B2 - Internal Date from DATE/TIME ADDED
	7241	"RTN","RCD PEDA2",22, 0)
	7242	; (344.3, . 13)
	7243	"RTN","RCD PEDA2",23, 0)
	7244	; B3 - Internal IEN for 34 4.3
	7245	"RTN","RCD PEDA2",24, 0)
	7246	; B4 - Internal IEN for fi le 344.31
	7247	"RTN","RCD PEDA2",25, 0)
	7248	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces
	7249	"RTN","RCD PEDA2",26, 0)
	7250	; may be updated
	7251	"RTN","RCD PEDA2",27, 0)
	7252	; A4 - Updated Page Numbe r
	7253	"RTN","RCD PEDA2",28, 0)
	7254	; A5 - Stop Fla g
	7255	"RTN","RCD PEDA2",29, 0)
	7256	; A6 - Updated Line numbe r
	7257	"RTN","RCD PEDA2",30, 0)
	7258	; ^TMP($J, "TOTALS"," DEP",C1) - Tota l # of dep osits by I nternal da te (C1)
	7259	"RTN","RCD PEDA2",31, 0)
	7260	; ^TMP($J, "TOTALS"," DEPA",C1) - Tota l Deposit Amount by Internal d ate (C1)
	7261	"RTN","RCD PEDA2",32, 0)
	7262	; ^TMP($J, "TOTALS"," EFT","D") - Tota l Deposit Amount by EFTs for d ate
	7263	"RTN","RCD PEDA2",33, 0)
	7264	; ^TMP($J, "TOTALS"," FMS") - FMS Document S tatus or " NO FMS DOC "
	7265	"RTN","RCD PEDA2",34, 0)
	7266	; ^TMP($J, "TOTALS"," FMS","D",- 1) - Tota l Deposit Amount by FMS Docume nt
	7267	"RTN","RCD PEDA2",35, 0)
	7268	; ^TMP($J, "TOTALS"," FMS","D",0 ) - Tota l Amount f or Error/R ejected do cuments
	7269	"RTN","RCD PEDA2",36, 0)
	7270	; ^TMP($J, "TOTALS"," FMS","D",1 ") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
	7271	"RTN","RCD PEDA2",37, 0)
	7272	; ^TMP($J, "TOTALS"," FMS","D",2 ") - Tota l Amount f or queued docs
	7273	"RTN","RCD PEDA2",38, 0)
	7274	; ^TMP($J, "TOTALS"," FMSTOT") - Upda ted Total Deposit Am ount for d ate range
	7275	"RTN","RCD PEDA2",39, 0)
	7276	; ^TMP($J, "TOTALS"," MATCH","D" ) - Curr ent Total matched EF Ts for dat e
	7277	"RTN","RCD PEDA2",40, 0)
	7278	N CRDOC,D ETL,DTADD, IEN344,IEN 3443,IEN34 431,TOTDEP ,Q,X,XX,YY
	7279	"RTN","RCD PEDA2",41, 0)
	7280	S DETL=$P (INPUT,"^" ,3),DTADD= $P(INPUT," ^",9)
	7281	"RTN","RCD PEDA2",42, 0)
	7282	;
	7283	"RTN","RCD PEDA2",43, 0)
	7284	; Clear t he followi ng daily t otals
	7285	"RTN","RCD PEDA2",44, 0)
	7286	K ^TMP($J ,"TOTALS", "EFT","D")
	7287	"RTN","RCD PEDA2",45, 0)
	7288	K ^TMP($J ,"TOTALS", "FMS","D")
	7289	"RTN","RCD PEDA2",46, 0)
	7290	K ^TMP($J ,"TOTALS", "MATCH","D ")
	7291	"RTN","RCD PEDA2",47, 0)
	7292	S IEN3443 =""
	7293	"RTN","RCD PEDA2",48, 0)
	7294	F D Q:I EN3443="" Q:$P(INPU T,"^",5)=1
	7295	"RTN","RCD PEDA2",49, 0)
	7296	. S IEN34 43=$O(^TMP ("RCDAILYA CT",$J,DTA DD,IEN3443 ))
	7297	"RTN","RCD PEDA2",50, 0)
	7298	. Q:IEN34 43=""
	7299	"RTN","RCD PEDA2",51, 0)
	7300	. S XX=$$ GET1^DIQ(3 44.3,IEN34 43,.03,"I" ) ; IEN for 34 4.1
	7301	"RTN","RCD PEDA2",52, 0)
	7302	. S IEN34 4=+$O(^RCY (344,"AD", +XX,0)) ; IEN for 34 4
	7303	"RTN","RCD PEDA2",53, 0)
	7304	. S XX=$G (^TMP($J," TOTALS","D EP",DTADD) )
	7305	"RTN","RCD PEDA2",54, 0)
	7306	. S ^TMP( $J,"TOTALS ","DEP",DT ADD)=XX+1 ; # of depos its for da y
	7307	"RTN","RCD PEDA2",55, 0)
	7308	. S TOTDE P=$$GET1^D IQ(344.3,I EN3443,.08 ,"I") ; Total Depo sit Amount
	7309	"RTN","RCD PEDA2",56, 0)
	7310	. S XX=$G (^TMP($J," TOTALS","D EPA",DTADD ))
	7311	"RTN","RCD PEDA2",57, 0)
	7312	. S ^TMP( $J,"TOTALS ","DEPA",D TADD)=XX+T OTDEP ; Total Depo sit Amount for day
	7313	"RTN","RCD PEDA2",58, 0)
	7314	. S CRDOC =$$GET1^DI Q(344,IEN3 44,200,"I" ) ; FMS Docume nt Number
	7315	"RTN","RCD PEDA2",59, 0)
	7316	. S ^TMP( $J,"TOTALS ","CRDOC", IEN3443)=C RDOC
	7317	"RTN","RCD PEDA2",60, 0)
	7318	. I CRDOC ="" D ; No FMS Doc ument Numb er
	7319	"RTN","RCD PEDA2",61, 0)
	7320	. . S YY= $G(^TMP($J ,"TOTALS", "FMS","D", -1))
	7321	"RTN","RCD PEDA2",62, 0)
	7322	. . S ^TM P($J,"TOTA LS","FMS", "D",-1)=YY +TOTDEP
	7323	"RTN","RCD PEDA2",63, 0)
	7324	. . S ^TM P($J,"TOTA LS","FMS") ="NO FMS D OC"
	7325	"RTN","RCD PEDA2",64, 0)
	7326	. I CRDOC '="" D ; FMS Docume nt Number found
	7327	"RTN","RCD PEDA2",65, 0)
	7328	. . S YY= $$STATUS^G ECSSGET(CR DOC) ; Get the st atus of th e doc
	7329	"RTN","RCD PEDA2",66, 0)
	7330	. . I YY= -1 D Q ; Document w asn't foun d
	7331	"RTN","RCD PEDA2",67, 0)
	7332	. . . S X X=$G(^TMP( $J,"TOTALS ","FMS","D ",-1))
	7333	"RTN","RCD PEDA2",68, 0)
	7334	. . . S ^ TMP($J,"TO TALS","FMS ","D",-1)= XX+TOTDEP
	7335	"RTN","RCD PEDA2",69, 0)
	7336	. . . S ^ TMP($J,"TO TALS","FMS ")="STATUS MISSING"
	7337	"RTN","RCD PEDA2",70, 0)
	7338	. . S XX= $E($P(YY," "),1,10) ; First Word of the st atus
	7339	"RTN","RCD PEDA2",71, 0)
	7340	. . S ^TM P($J,"TOTA LS","FMS") =XX ; First Word of the st atus
	7341	"RTN","RCD PEDA2",72, 0)
	7342	. . S Q=$ E(YY,1) ; First Char acter of t he status
	7343	"RTN","RCD PEDA2",73, 0)
	7344	. . S Q=$ S(Q="E"!(Q ="R"):0,Q= "Q":2,1:1) ; Q=0 - Reje ct or Erro r, 2 - Que ued, 1 - g ood
	7345	"RTN","RCD PEDA2",74, 0)
	7346	. . S XX= $G(^TMP($J ,"TOTALS", "FMS","D", Q))
	7347	"RTN","RCD PEDA2",75, 0)
	7348	. . S ^TM P($J,"TOTA LS","FMS", "D",Q)=XX+ TOTDEP ; Rej/Err, Q ueued OR g ood Amount for day
	7349	"RTN","RCD PEDA2",76, 0)
	7350	. ;
	7351	"RTN","RCD PEDA2",77, 0)
	7352	. I DETL D Q:$P(I NPUT,"^",5 )=1 ; Display De tail Line
	7353	"RTN","RCD PEDA2",78, 0)
	7354	. . D DET LN(.INPUT, IEN3443,TO TDEP)
	7355	"RTN","RCD PEDA2",79, 0)
	7356	. S ^TMP( $J,"TOTALS ","FMSTOT" )=0 ; Initialize FMS total for range
	7357	"RTN","RCD PEDA2",80, 0)
	7358	. D ERRMS GS(.INPUT, IEN3443) ; Display an y error me ssages
	7359	"RTN","RCD PEDA2",81, 0)
	7360	. Q:$P(IN PUT,"^",5) =1
	7361	"RTN","RCD PEDA2",82, 0)
	7362	. D PROCE FT(.INPUT, IEN3443) ; Process EF T records
	7363	"RTN","RCD PEDA2",83, 0)
	7364	Q
	7365	"RTN","RCD PEDA2",84, 0)
	7366	;
	7367	"RTN","RCD PEDA2",85, 0)
	7368	DETLN(INPU T,IEN3443, TOTDEP) ; Display de tail line
	7369	"RTN","RCD PEDA2",86, 0)
	7370	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7371	"RTN","RCD PEDA2",87, 0)
	7372	; A1 - 1 if ca lled from Nightly Pr ocess
	7373	"RTN","RCD PEDA2",88, 0)
	7374	; 0 other wise
	7375	"RTN","RCD PEDA2",89, 0)
	7376	; A2 - 1 if di splaying t o Listman
	7377	"RTN","RCD PEDA2",90, 0)
	7378	; 0 other wise
	7379	"RTN","RCD PEDA2",91, 0)
	7380	; A3 - 1 if De tail repor t
	7381	"RTN","RCD PEDA2",92, 0)
	7382	; 0 if su mmary repo rt
	7383	"RTN","RCD PEDA2",93, 0)
	7384	; A4 - Current Page Numb er
	7385	"RTN","RCD PEDA2",94, 0)
	7386	; A5 - Stop Fl ag
	7387	"RTN","RCD PEDA2",95, 0)
	7388	; A6 - Start o f Date Ran ge
	7389	"RTN","RCD PEDA2",96, 0)
	7390	; A7 - End of Date Range
	7391	"RTN","RCD PEDA2",97, 0)
	7392	; A8 - Current Line Coun ter
	7393	"RTN","RCD PEDA2",98, 0)
	7394	; A9 - Interna l Date bei ng process ed
	7395	"RTN","RCD PEDA2",99, 0)
	7396	; IEN3443 - Inte rnal IEN f or file 34 4.3
	7397	"RTN","RCD PEDA2",100 ,0)
	7398	; TOTDEP - Tota l Deposit Amount (34 4.3, .08)
	7399	"RTN","RCD PEDA2",101 ,0)
	7400	; ^TMP($J, "TOTALS"," FMS") - FMS Document # or "NO FM S DOC"
	7401	"RTN","RCD PEDA2",102 ,0)
	7402	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces
	7403	"RTN","RCD PEDA2",103 ,0)
	7404	; may be updated
	7405	"RTN","RCD PEDA2",104 ,0)
	7406	; A5 - Updated Page Numb er
	7407	"RTN","RCD PEDA2",105 ,0)
	7408	; A6 - Stop Fl ag
	7409	"RTN","RCD PEDA2",106 ,0)
	7410	; A8 - Updated Line Coun ter
	7411	"RTN","RCD PEDA2",107 ,0)
	7412	;
	7413	"RTN","RCD PEDA2",108 ,0)
	7414	N DTADD,D ETL,LSTMAN ,NJ,X,XX,Y Y
	7415	"RTN","RCD PEDA2",109 ,0)
	7416	S LSTMAN= $P(INPUT," ^",2),NJ=$ P(INPUT,"^ ",1)
	7417	"RTN","RCD PEDA2",110 ,0)
	7418	S DETL=$P (INPUT,"^" ,3)
	7419	"RTN","RCD PEDA2",111 ,0)
	7420	S XX=$$GE T1^DIQ(344 .3,IEN3443 ,.06,"I") ; Deposit Nu mber
	7421	"RTN","RCD PEDA2",112 ,0)
	7422	;
	7423	"RTN","RCD PEDA2",113 ,0)
	7424	; PRCA4. 5283 - ch ange lengt h of DEP # from 6 to 9 to allo w for 9 di git DEP #' s
	7425	"RTN","RCD PEDA2",114 ,0)
	7426	S X=$$SET STR^VALM1( XX,"",1,9)
	7427	"RTN","RCD PEDA2",115 ,0)
	7428	;
	7429	"RTN","RCD PEDA2",116 ,0)
	7430	; Change DEPOSIT DT 's startin g position from 9 to 12
	7431	"RTN","RCD PEDA2",117 ,0)
	7432	S YY=$$GE T1^DIQ(344 .3,IEN3443 ,.07,"I") ; Deposit Da te
	7433	"RTN","RCD PEDA2",118 ,0)
	7434	S X=$$SET STR^VALM1( $$FMTE^XLF DT(YY\1,"2 Z"),X,12,1 0)
	7435	"RTN","RCD PEDA2",119 ,0)
	7436	;
	7437	"RTN","RCD PEDA2",120 ,0)
	7438	; Change starting p osition fr om 21 to 2 3 & reduce length of spaces fr om 10 to 8 .
	7439	"RTN","RCD PEDA2",121 ,0)
	7440	S X=$$SET STR^VALM1( "",X,23,8)
	7441	"RTN","RCD PEDA2",122 ,0)
	7442	S X=$$SET STR^VALM1( "",X,32,10 )
	7443	"RTN","RCD PEDA2",123 ,0)
	7444	S XX=^TMP ($J,"TOTAL S","FMS")
	7445	"RTN","RCD PEDA2",124 ,0)
	7446	S X=$$SET STR^VALM1( $E($J(TOTD EP,"",2)_$ J("",20),1 ,20)_XX,X, 43,37)
	7447	"RTN","RCD PEDA2",125 ,0)
	7448	D SL^RCDP EDA3(.INPU T,X)
	7449	"RTN","RCD PEDA2",126 ,0)
	7450	Q
	7451	"RTN","RCD PEDA2",127 ,0)
	7452	;
	7453	"RTN","RCD PEDA2",128 ,0)
	7454	PROCEFT(IN PUT,IEN344 3) ; Entry Point fro m RCDPEDAR
	7455	"RTN","RCD PEDA2",129 ,0)
	7456	; Proce ss EFT rec ords
	7457	"RTN","RCD PEDA2",130 ,0)
	7458	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7459	"RTN","RCD PEDA2",131 ,0)
	7460	; A1 - 1 if ca lled from Nightly Pr ocess
	7461	"RTN","RCD PEDA2",132 ,0)
	7462	; 0 other wise
	7463	"RTN","RCD PEDA2",133 ,0)
	7464	; A2 - 1 if di splaying t o Listman
	7465	"RTN","RCD PEDA2",134 ,0)
	7466	; 0 other wise
	7467	"RTN","RCD PEDA2",135 ,0)
	7468	; A3 - 1 if De tail repor t
	7469	"RTN","RCD PEDA2",136 ,0)
	7470	; 0 if su mmary repo rt
	7471	"RTN","RCD PEDA2",137 ,0)
	7472	; A4 - Current Page Numb er
	7473	"RTN","RCD PEDA2",138 ,0)
	7474	; A5 - Stop Fl ag
	7475	"RTN","RCD PEDA2",139 ,0)
	7476	; A6 - Start o f Date Ran ge
	7477	"RTN","RCD PEDA2",140 ,0)
	7478	; A7 - End of Date Range
	7479	"RTN","RCD PEDA2",141 ,0)
	7480	; A8 - Current Line Coun ter
	7481	"RTN","RCD PEDA2",142 ,0)
	7482	; A9 - Interna l Date bei ng process ed
	7483	"RTN","RCD PEDA2",143 ,0)
	7484	; IEN3443 - Inte rnal IEN f or file 34 4.3
	7485	"RTN","RCD PEDA2",144 ,0)
	7486	; ^TMP($J, "TOTALS"," EFT","D") - Curr ent Total Deposit Am ount by EF Ts for dat e
	7487	"RTN","RCD PEDA2",145 ,0)
	7488	; ^TMP($J, "TOTALS"," MATCH","D" ) - Curr ent Total matched EF Ts for dat e
	7489	"RTN","RCD PEDA2",146 ,0)
	7490	; ^TMP($J, "TOTALS"," FMSTOT") - Curr ent Total Deposit Am ount for d ate range
	7491	"RTN","RCD PEDA2",147 ,0)
	7492	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces
	7493	"RTN","RCD PEDA2",148 ,0)
	7494	; may be updated
	7495	"RTN","RCD PEDA2",149 ,0)
	7496	; A5 - Updated Page Numb er
	7497	"RTN","RCD PEDA2",150 ,0)
	7498	; A6 - Stop Fl ag
	7499	"RTN","RCD PEDA2",151 ,0)
	7500	; A8 - Updated Line Coun ter
	7501	"RTN","RCD PEDA2",152 ,0)
	7502	; ^TMP($J, "TOTALS"," FMSTOT") - Upda ted Total Deposit Am ount for d ate range
	7503	"RTN","RCD PEDA2",153 ,0)
	7504	; ^TMP($J, "TOTALS"," EFT","D") - Upda ted Total Deposit Am ount by EF Ts for dat e
	7505	"RTN","RCD PEDA2",154 ,0)
	7506	; ^TMP($J, "TOTALS"," MATCH","D" ) - Upda ted Total matched EF Ts for dat e
	7507	"RTN","RCD PEDA2",155 ,0)
	7508	N DETL,DT ADD,IEN344 31,RCFMS1, TRDOC,X,XX ,YY
	7509	"RTN","RCD PEDA2",156 ,0)
	7510	S ^TMP($J ,"TOTALS", "FMSTOT")= 0
	7511	"RTN","RCD PEDA2",157 ,0)
	7512	S DTADD=$ P(INPUT,"^ ",9)
	7513	"RTN","RCD PEDA2",158 ,0)
	7514	S RCFMS1= "NO FMS DO C"
	7515	"RTN","RCD PEDA2",159 ,0)
	7516	S DETL=$P (INPUT,"^" ,3)
	7517	"RTN","RCD PEDA2",160 ,0)
	7518	S IEN3443 1=""
	7519	"RTN","RCD PEDA2",161 ,0)
	7520	F D Q:I EN34431="" Q:$P(INP UT,"^",5)= 1
	7521	"RTN","RCD PEDA2",162 ,0)
	7522	. S IEN34 431=$O(^TM P("RCDAILY ACT",$J,DT ADD,IEN344 3,"EFT",IE N34431))
	7523	"RTN","RCD PEDA2",163 ,0)
	7524	. Q:IEN34 431=""
	7525	"RTN","RCD PEDA2",164 ,0)
	7526	. S XX=$G (^TMP($J," TOTALS","E FT","D"))+ 1
	7527	"RTN","RCD PEDA2",165 ,0)
	7528	. S ^TMP( $J,"TOTALS ","EFT","D ")=XX ; Total # EFTs for date
	7529	"RTN","RCD PEDA2",166 ,0)
	7530	. S XX=+$ $GET1^DIQ( 344.31,IEN 34431,.09, "I") ; Receipt # from 34 4.31
	7531	"RTN","RCD PEDA2",167 ,0)
	7532	. S TRDOC =$$GET1^DI Q(344,XX,2 00,"I") ; FMS Doc ument #
	7533	"RTN","RCD PEDA2",168 ,0)
	7534	. S X=$S( TRDOC'="": $$STATUS^G ECSSGET(TR DOC),1:"")
	7535	"RTN","RCD PEDA2",169 ,0)
	7536	. I X'="" ,X'=-1,$E( X,1)'="R", $E(X,1)'=" E" D
	7537	"RTN","RCD PEDA2",170 ,0)
	7538	. . S XX= $G(^TMP($J ,"TOTALS", "FMSTOT"))
	7539	"RTN","RCD PEDA2",171 ,0)
	7540	. . S YY= $$GET1^DIQ (344.31,IE N34431,.07 ,"I") ; Amount of Payment
	7541	"RTN","RCD PEDA2",172 ,0)
	7542	. . S ^TM P($J,"TOTA LS","FMSTO T")=XX+YY
	7543	"RTN","RCD PEDA2",173 ,0)
	7544	. . S RCF MS1=$S($E( X,1)="Q":" QUEUED TO POST",1:"P OSTED")
	7545	"RTN","RCD PEDA2",174 ,0)
	7546	. S XX=$S (X="":"",X =-1:"NO FM S DOC",1:$ E($P(X," " ,1),1,10))
	7547	"RTN","RCD PEDA2",175 ,0)
	7548	. S RCFMS 1(IEN34431 )=XX ; FMS Doc ument Stat us for EFT
	7549	"RTN","RCD PEDA2",176 ,0)
	7550	. S XX=$$ GET1^DIQ(3 44.31,IEN3 4431,.08," I") ; Match S tatus
	7551	"RTN","RCD PEDA2",177 ,0)
	7552	. I XX D
	7553	"RTN","RCD PEDA2",178 ,0)
	7554	. . S XX= $G(^TMP($J ,"TOTALS", "MATCH","D "))
	7555	"RTN","RCD PEDA2",179 ,0)
	7556	. . S ^TM P($J,"TOTA LS","MATCH ","D")=XX+ 1 ; Total M atched EFT S by date
	7557	"RTN","RCD PEDA2",180 ,0)
	7558	. D:DETL EFTDTL(.IN PUT,IEN344 3,IEN34431 ,.RCFMS1)
	7559	"RTN","RCD PEDA2",181 ,0)
	7560	. Q:$P(IN PUT,"^",5) =1
	7561	"RTN","RCD PEDA2",182 ,0)
	7562	. D:DETL SL^RCDPEDA 3(.INPUT," ")
	7563	"RTN","RCD PEDA2",183 ,0)
	7564	Q
	7565	"RTN","RCD PEDA2",184 ,0)
	7566	;
	7567	"RTN","RCD PEDA2",185 ,0)
	7568	EFTDTL(INP UT,IEN3443 ,IEN34431, RCFMS1) ; Display EF T Detail
	7569	"RTN","RCD PEDA2",186 ,0)
	7570	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7571	"RTN","RCD PEDA2",187 ,0)
	7572	; A1 - 1 if ca lled from Nightly Pr ocess
	7573	"RTN","RCD PEDA2",188 ,0)
	7574	; 0 other wise
	7575	"RTN","RCD PEDA2",189 ,0)
	7576	; A2 - 1 if di splaying t o Listman
	7577	"RTN","RCD PEDA2",190 ,0)
	7578	; 0 other wise
	7579	"RTN","RCD PEDA2",191 ,0)
	7580	; A3 - 1 if De tail repor t
	7581	"RTN","RCD PEDA2",192 ,0)
	7582	; 0 if su mmary repo rt
	7583	"RTN","RCD PEDA2",193 ,0)
	7584	; A4 - Current Page Numb er
	7585	"RTN","RCD PEDA2",194 ,0)
	7586	; A5 - Stop Fl ag
	7587	"RTN","RCD PEDA2",195 ,0)
	7588	; A6 - Start o f Date Ran ge
	7589	"RTN","RCD PEDA2",196 ,0)
	7590	; A7 - End of Date Range
	7591	"RTN","RCD PEDA2",197 ,0)
	7592	; A8 - Current Line Coun ter
	7593	"RTN","RCD PEDA2",198 ,0)
	7594	; A9 - Interna l Date bei ng process ed
	7595	"RTN","RCD PEDA2",199 ,0)
	7596	; IEN3443 - Inte rnal IEN f or file 34 4.3
	7597	"RTN","RCD PEDA2",200 ,0)
	7598	; IEN34431 - Inte rnal IEN f or file 34 4.31
	7599	"RTN","RCD PEDA2",201 ,0)
	7600	; RCFMS1(I EN34431) - FMS Document S tatus for EFT IEN
	7601	"RTN","RCD PEDA2",202 ,0)
	7602	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces
	7603	"RTN","RCD PEDA2",203 ,0)
	7604	; may be updated
	7605	"RTN","RCD PEDA2",204 ,0)
	7606	; A5 - Updated Page Numb er
	7607	"RTN","RCD PEDA2",205 ,0)
	7608	; A6 - Stop Fl ag
	7609	"RTN","RCD PEDA2",206 ,0)
	7610	; A8 - Updated Line Coun ter
	7611	"RTN","RCD PEDA2",207 ,0)
	7612	N PAY,PAY ER,PAYID,X ,XX,YY,ZZ
	7613	"RTN","RCD PEDA2",208 ,0)
	7614	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.01,"I" ) ; EFT Transa ction IEN
	7615	"RTN","RCD PEDA2",209 ,0)
	7616	S X=$$SET STR^VALM1( XX,"",3,6)
	7617	"RTN","RCD PEDA2",210 ,0)
	7618	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.12,"I" ) ; Date Claim s Paid
	7619	"RTN","RCD PEDA2",211 ,0)
	7620	S X=$$SET STR^VALM1( $$FMTE^XLF DT(XX\1,"2 Z"),X,31,8 )
	7621	"RTN","RCD PEDA2",212 ,0)
	7622	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.07,"I" ) ; Amount of Payment
	7623	"RTN","RCD PEDA2",213 ,0)
	7624	S X=$$SET STR^VALM1( $J(XX,"",2 ),X,41,18)
	7625	"RTN","RCD PEDA2",214 ,0)
	7626	;
	7627	"RTN","RCD PEDA2",215 ,0)
	7628	; PRCA4. 5284, Mov e to left 3 space (6 1 to 58) t o allow fo r 10 digit ERA #'s
	7629	"RTN","RCD PEDA2",216 ,0)
	7630	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.08,"I" ) ; Match Stat us
	7631	"RTN","RCD PEDA2",217 ,0)
	7632	S YY=$$GE T1^DIQ(344 .31,IEN344 31,.1,"I") ; ERA IEN
	7633	"RTN","RCD PEDA2",218 ,0)
	7634	S X=$$SET STR^VALM1( $$EXTERNAL ^DILFD(344 .31,.08,"" ,+XX)_$S(X X=1:"/ERA #"_YY,1:"" ),X,57,20)
	7635	"RTN","RCD PEDA2",219 ,0)
	7636	Q:$P(INPU T,"^",5)=1
	7637	"RTN","RCD PEDA2",220 ,0)
	7638	D SL^RCDP EDA3(.INPU T,X)
	7639	"RTN","RCD PEDA2",221 ,0)
	7640	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.04,"I" ) ; Trace Numb er
	7641	"RTN","RCD PEDA2",222 ,0)
	7642	S X=$$SET STR^VALM1( XX,"",5,$L (XX))
	7643	"RTN","RCD PEDA2",223 ,0)
	7644	S XX=$G(^ TMP($J,"TO TALS","CRD OC",IEN344 3))
	7645	"RTN","RCD PEDA2",224 ,0)
	7646	; PRCA4. 5318 add CR # to de tail rpt
	7647	"RTN","RCD PEDA2",225 ,0)
	7648	S X=$$SET STR^VALM1( XX,X,54,$L (XX)) ; CR Documen t Number
	7649	"RTN","RCD PEDA2",226 ,0)
	7650	D SL^RCDP EDA3(.INPU T,X)
	7651	"RTN","RCD PEDA2",227 ,0)
	7652	S PAYER=$ $GET1^DIQ( 344.31,IEN 34431,.02, "I") ; Payer Name
	7653	"RTN","RCD PEDA2",228 ,0)
	7654	S:PAYER=" " PAYER="N O PAYER NA ME RECEIVE D" ; PRCA4.52 98
	7655	"RTN","RCD PEDA2",229 ,0)
	7656	S PAYID=$ $GET1^DIQ( 344.31,IEN 34431,.03, "I") ; Payer ID
	7657	"RTN","RCD PEDA2",230 ,0)
	7658	S PAY=PAY ER_"/"_PAY ID
	7659	"RTN","RCD PEDA2",231 ,0)
	7660	I $L(PAY) >74 D ; PRCA4.53 18 added i f statemen t
	7661	"RTN","RCD PEDA2",232 ,0)
	7662	. S ZZ=$L (PAY,"/"), XX=$P(PAY, "/",1,ZZ-1 ),YY=$P(PA Y,"/",ZZ)
	7663	"RTN","RCD PEDA2",233 ,0)
	7664	. S XX=$E (XX,1,$L(X X)-($L(PAY )-74)),PAY =XX_"/"_YY
	7665	"RTN","RCD PEDA2",234 ,0)
	7666	S XX=$$SE TSTR^VALM1 (PAY,"",7, 74)
	7667	"RTN","RCD PEDA2",235 ,0)
	7668	D SL^RCDP EDA3(.INPU T,XX)
	7669	"RTN","RCD PEDA2",236 ,0)
	7670	; PRCA4. 5318 add TR #s to d etail rpt
	7671	"RTN","RCD PEDA2",237 ,0)
	7672	D GETTR(I EN34431,.I NPUT) ; Gather & display al l TR Doc # s for EFT detail rec ord
	7673	"RTN","RCD PEDA2",238 ,0)
	7674	S X=""
	7675	"RTN","RCD PEDA2",239 ,0)
	7676	;
	7677	"RTN","RCD PEDA2",240 ,0)
	7678	; PRCA4. 5304 - le ngthen rec eipt numbe r display to 12
	7679	"RTN","RCD PEDA2",241 ,0)
	7680	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.09,"I" ) ; Receipt IE N
	7681	"RTN","RCD PEDA2",242 ,0)
	7682	I XX'="" D
	7683	"RTN","RCD PEDA2",243 ,0)
	7684	. S YY=$$ GET1^DIQ(3 44,XX,.01, "I") ; Receipt Nu mber
	7685	"RTN","RCD PEDA2",244 ,0)
	7686	. S X=$$S ETSTR^VALM 1(YY,X,46, 12)
	7687	"RTN","RCD PEDA2",245 ,0)
	7688	S X=$$SET STR^VALM1( $G(RCFMS1( IEN34431)) ,X,61,19)
	7689	"RTN","RCD PEDA2",246 ,0)
	7690	D SL^RCDP EDA3(.INPU T,X)
	7691	"RTN","RCD PEDA2",247 ,0)
	7692	Q:$P(INPU T,"^",5)=1
	7693	"RTN","RCD PEDA2",248 ,0)
	7694	D EFTERRS ^RCDPEDA3( .INPUT,IEN 34431) ; Display an y EFT Erro rs
	7695	"RTN","RCD PEDA2",249 ,0)
	7696	D DUP(.IN PUT,IEN344 31) ; Check if t his was a duplicate EFT
	7697	"RTN","RCD PEDA2",250 ,0)
	7698	Q
	7699	"RTN","RCD PEDA2",251 ,0)
	7700	;
	7701	"RTN","RCD PEDA2",252 ,0)
	7702	GETTR(IEN3 4431,INPUT ) ;Gathers and Displ ays all TR Doc #s fo r a specif ied EFT
	7703	"RTN","RCD PEDA2",253 ,0)
	7704	; detail record
	7705	"RTN","RCD PEDA2",254 ,0)
	7706	; PRCA4. 5318 add TR #s to d etail rpt
	7707	"RTN","RCD PEDA2",255 ,0)
	7708	; Input: IEN34431 - Internal IEN for fi le #344.31
	7709	"RTN","RCD PEDA2",256 ,0)
	7710	; INPUT - A1^A2^ A3^...^An Where:
	7711	"RTN","RCD PEDA2",257 ,0)
	7712	; A1 - 1 if ca lled from Nightly Pr ocess
	7713	"RTN","RCD PEDA2",258 ,0)
	7714	; 0 other wise
	7715	"RTN","RCD PEDA2",259 ,0)
	7716	; A2 - 1 if di splaying t o Listman
	7717	"RTN","RCD PEDA2",260 ,0)
	7718	; 0 other wise
	7719	"RTN","RCD PEDA2",261 ,0)
	7720	; A3 - 1 if De tail repor t
	7721	"RTN","RCD PEDA2",262 ,0)
	7722	; 0 if su mmary repo rt
	7723	"RTN","RCD PEDA2",263 ,0)
	7724	; A4 - Current Page Numb er
	7725	"RTN","RCD PEDA2",264 ,0)
	7726	; A5 - Stop Fl ag
	7727	"RTN","RCD PEDA2",265 ,0)
	7728	; A6 - Start o f Date Ran ge
	7729	"RTN","RCD PEDA2",266 ,0)
	7730	; A7 - End of Date Range
	7731	"RTN","RCD PEDA2",267 ,0)
	7732	; A8 - Current Line Coun ter
	7733	"RTN","RCD PEDA2",268 ,0)
	7734	; A9 - Interna l Date bei ng process ed;
	7735	"RTN","RCD PEDA2",269 ,0)
	7736	;
	7737	"RTN","RCD PEDA2",270 ,0)
	7738	N CTR,IEN 3444,IENS, RECEIPT,TR DOC,TRDOCS ,XX
	7739	"RTN","RCD PEDA2",271 ,0)
	7740	; First g ather up a ll the TR Document n umbers int o as many lines as n eeded
	7741	"RTN","RCD PEDA2",272 ,0)
	7742	S CTR=1
	7743	"RTN","RCD PEDA2",273 ,0)
	7744	S IEN3444 =$$GET1^DI Q(344.31,I EN34431,.1 ,"I") ; In ternal IEN for for 3 44.4
	7745	"RTN","RCD PEDA2",274 ,0)
	7746	S RECEIPT =$$GET1^DI Q(344.4,IE N3444,.08, "I") ; Re ceipt # fr om 344.4
	7747	"RTN","RCD PEDA2",275 ,0)
	7748	I RECEIPT '="" D
	7749	"RTN","RCD PEDA2",276 ,0)
	7750	. S TRDOC =$TR($$GET 1^DIQ(344, RECEIPT,20 0,"I")," " ) ; FMS Document #
	7751	"RTN","RCD PEDA2",277 ,0)
	7752	. I TRDOC ="" Q
	7753	"RTN","RCD PEDA2",278 ,0)
	7754	. S TRDOC S(CTR)=TRD OC
	7755	"RTN","RCD PEDA2",279 ,0)
	7756	. S XX=""
	7757	"RTN","RCD PEDA2",280 ,0)
	7758	. F D Q :XX=""
	7759	"RTN","RCD PEDA2",281 ,0)
	7760	.. S XX=$ O(^RCY(344 .4,IEN3444 ,8,XX))
	7761	"RTN","RCD PEDA2",282 ,0)
	7762	.. Q:XX=" "
	7763	"RTN","RCD PEDA2",283 ,0)
	7764	.. S IENS =XX_","_IE N3444_","
	7765	"RTN","RCD PEDA2",284 ,0)
	7766	.. S RECE IPT=$$GET1 ^DIQ(344.4 8,IENS,.01 ,"I") ; O ther recei pt numbers
	7767	"RTN","RCD PEDA2",285 ,0)
	7768	.. I RECE IPT="" Q
	7769	"RTN","RCD PEDA2",286 ,0)
	7770	.. S TRDO C=$TR($$GE T1^DIQ(344 ,RECEIPT,2 00,"I")," ") ; FMS Document #
	7771	"RTN","RCD PEDA2",287 ,0)
	7772	.. Q:TRDO C=""
	7773	"RTN","RCD PEDA2",288 ,0)
	7774	.. I $L(T RDOC)+$L($ G(TRDOCS(C TR)))+1>73 D Q
	7775	"RTN","RCD PEDA2",289 ,0)
	7776	.. . S CT R=CTR+1,TR DOCS(CTR)= TRDOC
	7777	"RTN","RCD PEDA2",290 ,0)
	7778	.. S TRDO CS(CTR)=TR DOCS(CTR)_ ", "_TRDOC
	7779	"RTN","RCD PEDA2",291 ,0)
	7780	;
	7781	"RTN","RCD PEDA2",292 ,0)
	7782	; Now dis play the T R Document numbers
	7783	"RTN","RCD PEDA2",293 ,0)
	7784	I '$D(TRD OCS) D SL^ RCDPEDA3(. INPUT," ") Q ; bl ank line f or TR#s
	7785	"RTN","RCD PEDA2",294 ,0)
	7786	S XX=""
	7787	"RTN","RCD PEDA2",295 ,0)
	7788	F D Q:X X=""
	7789	"RTN","RCD PEDA2",296 ,0)
	7790	. S XX=$O (TRDOCS(XX ))
	7791	"RTN","RCD PEDA2",297 ,0)
	7792	. Q:XX=""
	7793	"RTN","RCD PEDA2",298 ,0)
	7794	. D SL^RC DPEDA3(.IN PUT,$J("", 3)_TRDOCS( XX))
	7795	"RTN","RCD PEDA2",299 ,0)
	7796	Q
	7797	"RTN","RCD PEDA2",300 ,0)
	7798	;
	7799	"RTN","RCD PEDA2",301 ,0)
	7800	DUP(INPUT, IEN34431) ; Check to see if th e EFT was a duplicat e
	7801	"RTN","RCD PEDA2",302 ,0)
	7802	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7803	"RTN","RCD PEDA2",303 ,0)
	7804	; A1 - 1 if ca lled from Nightly Pr ocess, 0 o therwise
	7805	"RTN","RCD PEDA2",304 ,0)
	7806	; A2 - 1 if di splaying t o Listman, 0 otherwi se
	7807	"RTN","RCD PEDA2",305 ,0)
	7808	; A3 - Current Page Numb er
	7809	"RTN","RCD PEDA2",306 ,0)
	7810	; A1 - 1 if De tail repor t, 0 if su mmary repo rt
	7811	"RTN","RCD PEDA2",307 ,0)
	7812	; A5 - Stop Fl ag
	7813	"RTN","RCD PEDA2",308 ,0)
	7814	; A6 - Start o f Date Ran ge
	7815	"RTN","RCD PEDA2",309 ,0)
	7816	; A7 - End of Date Range
	7817	"RTN","RCD PEDA2",310 ,0)
	7818	; A8 - Current Line Coun ter
	7819	"RTN","RCD PEDA2",311 ,0)
	7820	; A9 - Interna l Date bei ng process ed
	7821	"RTN","RCD PEDA2",312 ,0)
	7822	; IEN34431 - Inte rnal IEN f or file 34 4.31
	7823	"RTN","RCD PEDA2",313 ,0)
	7824	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	7825	"RTN","RCD PEDA2",314 ,0)
	7826	; A5 - Updated Page Numb er
	7827	"RTN","RCD PEDA2",315 ,0)
	7828	; A6 - Stop Fl ag
	7829	"RTN","RCD PEDA2",316 ,0)
	7830	; A8 - Updated Line Coun ter
	7831	"RTN","RCD PEDA2",317 ,0)
	7832	N XX,YY
	7833	"RTN","RCD PEDA2",318 ,0)
	7834	Q:'$D(^RC Y(344.31,I EN34431,3) ) ; Not a dupl icate
	7835	"RTN","RCD PEDA2",319 ,0)
	7836	S XX=$$GE T1^DIQ(344 .31,IEN344 31,.18,"I" ) ; Date/Time Removed
	7837	"RTN","RCD PEDA2",320 ,0)
	7838	S YY=$$GE T1^DIQ(344 .31,IEN344 31,.17,"I" ) ; User who r emoved it
	7839	"RTN","RCD PEDA2",321 ,0)
	7840	S X=" M ARKED AS D UPLICATE: "_$$FMTE^X LFDT(XX)_" "_$$EXTER NAL^DILFD( 344.31,.17 ,,YY)
	7841	"RTN","RCD PEDA2",322 ,0)
	7842	D SL^RCDP EDA3(.INPU T,X)
	7843	"RTN","RCD PEDA2",323 ,0)
	7844	D SL^RCDP EDA3(.INPU T," ")
	7845	"RTN","RCD PEDA2",324 ,0)
	7846	Q
	7847	"RTN","RCD PEDA2",325 ,0)
	7848	;
	7849	"RTN","RCD PEDA2",326 ,0)
	7850	ERRMSGS(IN PUT,IEN344 3) ; Displ ay any EFT error mes sages
	7851	"RTN","RCD PEDA2",327 ,0)
	7852	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7853	"RTN","RCD PEDA2",328 ,0)
	7854	; A1 - 1 if cal led from N ightly Pro cess, 0 ot herwise
	7855	"RTN","RCD PEDA2",329 ,0)
	7856	; A2 - 1 if dis playing to Listman, 0 otherwis e
	7857	"RTN","RCD PEDA2",330 ,0)
	7858	; A3 - 1 if Det ail report , 0 if sum mary repor t
	7859	"RTN","RCD PEDA2",331 ,0)
	7860	; A4 - Current Page Numbe r
	7861	"RTN","RCD PEDA2",332 ,0)
	7862	; A5 - Stop Fla g
	7863	"RTN","RCD PEDA2",333 ,0)
	7864	; A6 - Start of Date Rang e
	7865	"RTN","RCD PEDA2",334 ,0)
	7866	; A7 - End of D ate Range
	7867	"RTN","RCD PEDA2",335 ,0)
	7868	; A8 - Current Line Count er
	7869	"RTN","RCD PEDA2",336 ,0)
	7870	; A9 - Internal Date bein g processe d
	7871	"RTN","RCD PEDA2",337 ,0)
	7872	; IEN3443 - Inte rnal IEN f or file 34 4.3
	7873	"RTN","RCD PEDA2",338 ,0)
	7874	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	7875	"RTN","RCD PEDA2",339 ,0)
	7876	; A5 - Updated Page Numbe r
	7877	"RTN","RCD PEDA2",340 ,0)
	7878	; A6 - Stop Fla g
	7879	"RTN","RCD PEDA2",341 ,0)
	7880	; A8 - Updated Line Count er
	7881	"RTN","RCD PEDA2",342 ,0)
	7882	;
	7883	"RTN","RCD PEDA2",343 ,0)
	7884	N DETL,ER RS,XX
	7885	"RTN","RCD PEDA2",344 ,0)
	7886	S DETL=$P (INPUT,"^" ,3)
	7887	"RTN","RCD PEDA2",345 ,0)
	7888	S XX=$$GE T1^DIQ(344 .3,IEN3443 ,2,"I","ER RS") ; Error Mess age WP fie ld
	7889	"RTN","RCD PEDA2",346 ,0)
	7890	Q:'$D(ERR S) ; No errors
	7891	"RTN","RCD PEDA2",347 ,0)
	7892	Q:$P(INPU T,"^",5)=1
	7893	"RTN","RCD PEDA2",348 ,0)
	7894	D SL^RCDP EDA3(.INPU T,$J("",10 )_"ERROR M ESSAGES FO R EFT:")
	7895	"RTN","RCD PEDA2",349 ,0)
	7896	S XX=""
	7897	"RTN","RCD PEDA2",350 ,0)
	7898	F D Q:X X="" Q:$P (INPUT,"^" ,5)=1
	7899	"RTN","RCD PEDA2",351 ,0)
	7900	. S XX=$O (ERRS(XX))
	7901	"RTN","RCD PEDA2",352 ,0)
	7902	. Q:XX=""
	7903	"RTN","RCD PEDA2",353 ,0)
	7904	. Q:$P(IN PUT,"^",5) =1
	7905	"RTN","RCD PEDA2",354 ,0)
	7906	. D SL^RC DPEDA3(.IN PUT,$J("", 12)_ERRS(X X))
	7907	"RTN","RCD PEDA2",355 ,0)
	7908	Q
	7909	"RTN","RCD PEDA2",356 ,0)
	7910	;
	7911	"RTN","RCD PEDA3")
	7912	0^8^B13565 6232^n/a
	7913	"RTN","RCD PEDA3",1,0 )
	7914	RCDPEDA3 ; EDE/DW - A CTIVITY RE PORT ;Feb 17, 2017@1 0:37:00
	7915	"RTN","RCD PEDA3",2,0 )
	7916	;;4.5;Acc ounts Rece ivable;3 18;Mar 2 0, 1995;Bu ild 25
	7917	"RTN","RCD PEDA3",3,0 )
	7918	;Per VA D irective 6 402, this routine sh ould not b e modified .
	7919	"RTN","RCD PEDA3",4,0 )
	7920	Q
	7921	"RTN","RCD PEDA3",5,0 )
	7922	;
	7923	"RTN","RCD PEDA3",6,0 )
	7924	EFTERRS(IN PUT,IEN344 31) ; Entr y Point fr om RCDPEDA 2
	7925	"RTN","RCD PEDA3",7,0 )
	7926	; Outp ut any EFT Detail er rors
	7927	"RTN","RCD PEDA3",8,0 )
	7928	;
	7929	"RTN","RCD PEDA3",9,0 )
	7930	; Input: INPUT - A1^A 2^A3^...^A n Where:
	7931	"RTN","RCD PEDA3",10, 0)
	7932	; A1 - 1 if ca lled from Nightly Pr ocess, 0 o therwise
	7933	"RTN","RCD PEDA3",11, 0)
	7934	; A2 - 1 if di splaying t o Listman, 0 otherwi se
	7935	"RTN","RCD PEDA3",12, 0)
	7936	; A3 - 1 if De tail repor t, 0 if su mmary repo rt
	7937	"RTN","RCD PEDA3",13, 0)
	7938	; A4 - Current Page Numb er
	7939	"RTN","RCD PEDA3",14, 0)
	7940	; A5 - Stop Fl ag
	7941	"RTN","RCD PEDA3",15, 0)
	7942	; A6 - Start o f Date Ran ge
	7943	"RTN","RCD PEDA3",16, 0)
	7944	; A7 - End of Date Range
	7945	"RTN","RCD PEDA3",17, 0)
	7946	; A8 - Current Line Coun ter
	7947	"RTN","RCD PEDA3",18, 0)
	7948	; A9 - Interna l Date bei ng process ed
	7949	"RTN","RCD PEDA3",19, 0)
	7950	; IEN34431 - Inte rnal IEN f or file 34 4.31
	7951	"RTN","RCD PEDA3",20, 0)
	7952	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	7953	"RTN","RCD PEDA3",21, 0)
	7954	; A5 - Updated Page Numb er
	7955	"RTN","RCD PEDA3",22, 0)
	7956	; A6 - Stop Fl ag
	7957	"RTN","RCD PEDA3",23, 0)
	7958	; A8 - Updated Line Coun ter
	7959	"RTN","RCD PEDA3",24, 0)
	7960	Q:'$O(^RC Y(344.31,I EN34431,2, 0)) ; No e rror messa ge
	7961	"RTN","RCD PEDA3",25, 0)
	7962	N ERRS,V, XX,YY
	7963	"RTN","RCD PEDA3",26, 0)
	7964	Q:$P(INPU T,"^",5)=1
	7965	"RTN","RCD PEDA3",27, 0)
	7966	D SL(.INP UT,$J("",1 0)_"ERROR MESSAGES F OR EFT DET AIL:")
	7967	"RTN","RCD PEDA3",28, 0)
	7968	S XX=$$GE T1^DIQ(344 .31,IEN344 31,2,"I"," ERRS")
	7969	"RTN","RCD PEDA3",29, 0)
	7970	S V=""
	7971	"RTN","RCD PEDA3",30, 0)
	7972	F D Q:V ="" Q:$P( INPUT,"^", 5)=1
	7973	"RTN","RCD PEDA3",31, 0)
	7974	. S V=$O( ERRS(V))
	7975	"RTN","RCD PEDA3",32, 0)
	7976	. Q:V=""
	7977	"RTN","RCD PEDA3",33, 0)
	7978	. Q:$P(IN PUT,"^",5) =1
	7979	"RTN","RCD PEDA3",34, 0)
	7980	. D SL(.I NPUT,$J("" ,12)_ERRS( V))
	7981	"RTN","RCD PEDA3",35, 0)
	7982	Q
	7983	"RTN","RCD PEDA3",36, 0)
	7984	;
	7985	"RTN","RCD PEDA3",37, 0)
	7986	LMHDR(RCST OP,RCDET,R CNJ,RCDT1, RCDT2,RCHD R) ; Entry Point fro m RCDPEDAR
	7987	"RTN","RCD PEDA3",38, 0)
	7988	; Lis tMan repor t heading
	7989	"RTN","RCD PEDA3",39, 0)
	7990	;
	7991	"RTN","RCD PEDA3",40, 0)
	7992	; Input: RCDET - 1 to display d etail, 0 o therwise
	7993	"RTN","RCD PEDA3",41, 0)
	7994	; RCNJ - Set 1, indicat es report was called from the nightly
	7995	"RTN","RCD PEDA3",42, 0)
	7996	; proc ess OR dis playing to listman. Used to s et lines
	7997	"RTN","RCD PEDA3",43, 0)
	7998	; into a ^TMP ar ray instea d of displ aying them .
	7999	"RTN","RCD PEDA3",44, 0)
	8000	; RCDT1 - Inte rnal Start Date of d ate range
	8001	"RTN","RCD PEDA3",45, 0)
	8002	; RCDT2 - Inte rnal End D ate of dat e range
	8003	"RTN","RCD PEDA3",46, 0)
	8004	; RCNP - Paye r Selectio n flag A1^ A2^A3 Wher e:
	8005	"RTN","RCD PEDA3",47, 0)
	8006	; A1 - 1 - Rang e,2 - All, 3 -Specifi c
	8007	"RTN","RCD PEDA3",48, 0)
	8008	; A2 - From Pay er text (o nly set if A1=1)
	8009	"RTN","RCD PEDA3",49, 0)
	8010	; A3 - Through text (only set if A1 =1)
	8011	"RTN","RCD PEDA3",50, 0)
	8012	; ^TMP("RC SELPAY",$J ,B1) - Sel ected paye rs to be d isplayed
	8013	"RTN","RCD PEDA3",51, 0)
	8014	; Output: RCHDR - Arra y of listm an header lines
	8015	"RTN","RCD PEDA3",52, 0)
	8016	; RCSTOP - 1 if user stop ped
	8017	"RTN","RCD PEDA3",53, 0)
	8018	;
	8019	"RTN","RCD PEDA3",54, 0)
	8020	N RCCT,X, XX,Y,Z,Z0, Z1
	8021	"RTN","RCD PEDA3",55, 0)
	8022	S RCCT=0
	8023	"RTN","RCD PEDA3",56, 0)
	8024	S XX=$S(R CDET:"DETA IL",1:"SUM MARY")_" R EPORT"
	8025	"RTN","RCD PEDA3",57, 0)
	8026	S RCHDR(" TITLE")="E DI LOCKBOX EFT DAILY ACTIVITY "_XX
	8027	"RTN","RCD PEDA3",58, 0)
	8028	S Z1=""
	8029	"RTN","RCD PEDA3",59, 0)
	8030	I 'VAUTD S Z0=0 F S Z0=$O(VA UTD(Z0)) Q :'Z0 S Z1 =Z1_VAUTD( Z0)_", "
	8031	"RTN","RCD PEDA3",60, 0)
	8032	S Z="DIVI SIONS: "_$ S(VAUTD:"A LL",1:$E(Z 1,1,$L(Z1) -2))
	8033	"RTN","RCD PEDA3",61, 0)
	8034	I 'RCDET D
	8035	"RTN","RCD PEDA3",62, 0)
	8036	. S RCCT= RCCT+1,RCH DR(RCCT)=" "
	8037	"RTN","RCD PEDA3",63, 0)
	8038	S RCCT=RC CT+1,RCHDR (RCCT)=Z
	8039	"RTN","RCD PEDA3",64, 0)
	8040	;
	8041	"RTN","RCD PEDA3",65, 0)
	8042	I 'RCDET D
	8043	"RTN","RCD PEDA3",66, 0)
	8044	. S RCCT= RCCT+1,RCH DR(RCCT)=" "
	8045	"RTN","RCD PEDA3",67, 0)
	8046	S Z="DATE RANGE: "_ $$FMTE^XLF DT(RCDT1," 2Z")_" - "
	8047	"RTN","RCD PEDA3",68, 0)
	8048	S Z=Z_$$F MTE^XLFDT( RCDT2,"2Z" )_" (Date Deposit Ad ded)"
	8049	"RTN","RCD PEDA3",69, 0)
	8050	I 'RCDET D
	8051	"RTN","RCD PEDA3",70, 0)
	8052	. S RCCT= RCCT+1,RCH DR(RCCT)=" "
	8053	"RTN","RCD PEDA3",71, 0)
	8054	S RCCT=RC CT+1,RCHDR (RCCT)=Z
	8055	"RTN","RCD PEDA3",72, 0)
	8056	I RCDET D
	8057	"RTN","RCD PEDA3",73, 0)
	8058	. S XX="D EP # DEPOSIT DT "_$J("", 19)
	8059	"RTN","RCD PEDA3",74, 0)
	8060	. S XX=XX _"DEP AMOU NT FMS DEPO SIT STAT"
	8061	"RTN","RCD PEDA3",75, 0)
	8062	. S Z=$$S ETSTR^VALM 1(XX,"",1, 80)
	8063	"RTN","RCD PEDA3",76, 0)
	8064	. S RCCT= RCCT+1,RCH DR(RCCT)=Z
	8065	"RTN","RCD PEDA3",77, 0)
	8066	. ; PRCA* 4.5*318, M ove entire EFT # row to left 1 space to adjust for other row s needing space
	8067	"RTN","RCD PEDA3",78, 0)
	8068	. S XX=$J ("",2)_"EF T #"_$J("" ,22)_"DATE PD PAYM ENT AMOUNT ERA MATC H STATUS"
	8069	"RTN","RCD PEDA3",79, 0)
	8070	. S Z=$$S ETSTR^VALM 1(XX,"",1, 80)
	8071	"RTN","RCD PEDA3",80, 0)
	8072	. S RCCT= RCCT+1,RCH DR(RCCT)=Z
	8073	"RTN","RCD PEDA3",81, 0)
	8074	. ; PRCA* 4.5*318, M ove entire EFT Payer Trace # r ow to left 6 spaces to adjust for other rows needi ng space
	8075	"RTN","RCD PEDA3",82, 0)
	8076	. S Z=$$S ETSTR^VALM 1($J("",4) _"EFT PAYE R TRACE #" ,"",1,30)
	8077	"RTN","RCD PEDA3",83, 0)
	8078	. ;PRCA4 .5318 add CR #
	8079	"RTN","RCD PEDA3",84, 0)
	8080	. S Z=$$S ETSTR^VALM 1("CR #",Z ,54,80)
	8081	"RTN","RCD PEDA3",85, 0)
	8082	. S RCCT= RCCT+1,RCH DR(RCCT)=Z
	8083	"RTN","RCD PEDA3",86, 0)
	8084	. ; PRCA* 4.5*318, M ove entire Payment F rom row to left 8 sp aces to ad just
	8085	"RTN","RCD PEDA3",87, 0)
	8086	. ; a pos sible 60 c haracter P ayer Name and 20 cha racter Pay er ID
	8087	"RTN","RCD PEDA3",88, 0)
	8088	. S Z=$$S ETSTR^VALM 1($J("",6) _"PAYMENT FROM","",1 ,30)
	8089	"RTN","RCD PEDA3",89, 0)
	8090	. S Z=$$S ETSTR^VALM 1($J("",15 )_"DEP REC EIPT #",Z, 31,30)
	8091	"RTN","RCD PEDA3",90, 0)
	8092	. S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
	8093	"RTN","RCD PEDA3",91, 0)
	8094	. S RCCT= RCCT+1,RCH DR(RCCT)=Z
	8095	"RTN","RCD PEDA3",92, 0)
	8096	. ;PRCA4 .5318 add TR #s
	8097	"RTN","RCD PEDA3",93, 0)
	8098	. S Z=$$S ETSTR^VALM 1("TR #"," ",1,30)
	8099	"RTN","RCD PEDA3",94, 0)
	8100	. S RCCT= RCCT+1,RCH DR(RCCT)=Z
	8101	"RTN","RCD PEDA3",95, 0)
	8102	Q
	8103	"RTN","RCD PEDA3",96, 0)
	8104	;
	8105	"RTN","RCD PEDA3",97, 0)
	8106	HDR(INPUT) ; Display s report h eader
	8107	"RTN","RCD PEDA3",98, 0)
	8108	; Input: INPUT - A1^A 2^A3^...^A n Where:
	8109	"RTN","RCD PEDA3",99, 0)
	8110	; A1 - 1 if cal led from N ightly Pro cess, 0 ot herwise
	8111	"RTN","RCD PEDA3",100 ,0)
	8112	; A2 - 1 if dis playing to Listman, 0 otherwis e
	8113	"RTN","RCD PEDA3",101 ,0)
	8114	; A3 - 1 if Det ail report , 0 if sum mary repor t
	8115	"RTN","RCD PEDA3",102 ,0)
	8116	; A4 - Current Page Numbe r
	8117	"RTN","RCD PEDA3",103 ,0)
	8118	; A5 - Stop Fla g
	8119	"RTN","RCD PEDA3",104 ,0)
	8120	; A6 - Start of Date Rang e
	8121	"RTN","RCD PEDA3",105 ,0)
	8122	; A7 - End of D ate Range
	8123	"RTN","RCD PEDA3",106 ,0)
	8124	; A9 - Current line count
	8125	"RTN","RCD PEDA3",107 ,0)
	8126	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	8127	"RTN","RCD PEDA3",108 ,0)
	8128	; A4 - Current Page Numbe r
	8129	"RTN","RCD PEDA3",109 ,0)
	8130	; A5 - Stop Fla g
	8131	"RTN","RCD PEDA3",110 ,0)
	8132	; A8 - Updated line count
	8133	"RTN","RCD PEDA3",111 ,0)
	8134	N CURPG,D ETL,DTST,D TEND,NJ,ST OP,X,XX,Y, Z,Z0,Z1
	8135	"RTN","RCD PEDA3",112 ,0)
	8136	S DETL=$P (INPUT,"^" ,3)
	8137	"RTN","RCD PEDA3",113 ,0)
	8138	S STOP=$P (INPUT,"^" ,5)
	8139	"RTN","RCD PEDA3",114 ,0)
	8140	S DTST=$P (INPUT,"^" ,6) ; Date Range Sta rt
	8141	"RTN","RCD PEDA3",115 ,0)
	8142	S DTEND=$ P(INPUT,"^ ",7) ; Date Range End S STOP=0
	8143	"RTN","RCD PEDA3",116 ,0)
	8144	S NJ=$P(I NPUT,"^",1 ),CURPG=$P (INPUT,"^" ,4)
	8145	"RTN","RCD PEDA3",117 ,0)
	8146	Q:NJ&(CUR PG)
	8147	"RTN","RCD PEDA3",118 ,0)
	8148	I CURPG!( $E(IOST,1, 2)="C-") D
	8149	"RTN","RCD PEDA3",119 ,0)
	8150	. Q:NJ
	8151	"RTN","RCD PEDA3",120 ,0)
	8152	. I CURPG ,($E(IOST, 1,2)="C-") D ASK(.ST OP) Q:STOP
	8153	"RTN","RCD PEDA3",121 ,0)
	8154	. W @IOF ; Write fo rm feed
	8155	"RTN","RCD PEDA3",122 ,0)
	8156	I STOP S $P(INPUT," ^",5)=1 Q
	8157	"RTN","RCD PEDA3",123 ,0)
	8158	S CURPG=C URPG+1,$P( INPUT,"^", 4)=CURPG
	8159	"RTN","RCD PEDA3",124 ,0)
	8160	;
	8161	"RTN","RCD PEDA3",125 ,0)
	8162	; PRCA276 if coming from nigh tly job ne ed to defi ne payer s election v ariable
	8163	"RTN","RCD PEDA3",126 ,0)
	8164	I NJ N RC NP S RCNP= 2
	8165	"RTN","RCD PEDA3",127 ,0)
	8166	;
	8167	"RTN","RCD PEDA3",128 ,0)
	8168	; PRCA276 if coming from nigh tly job ne ed to defi ne divisio n selectio n variable
	8169	"RTN","RCD PEDA3",129 ,0)
	8170	I NJ N VA UTD S VAUT D=1
	8171	"RTN","RCD PEDA3",130 ,0)
	8172	S Z0="EDI LOCKBOX E FT DAILY A CTIVITY "_ $S(DETL:"D ETAIL",1:" SUMMARY")_ " REPORT"
	8173	"RTN","RCD PEDA3",131 ,0)
	8174	S Z=$$SET STR^VALM1( $J("",80-$ L(Z0)\2)_Z 0,"",1,79)
	8175	"RTN","RCD PEDA3",132 ,0)
	8176	S Z=$$SET STR^VALM1( "Page: "_C URPG,Z,70, 10)
	8177	"RTN","RCD PEDA3",133 ,0)
	8178	D SL(.INP UT,Z)
	8179	"RTN","RCD PEDA3",134 ,0)
	8180	S Z="RUN DATE: "_$$ FMTE^XLFDT ($$NOW^XLF DT(),"2Z") ,Z=$J("",8 0-$L(Z)\2) _Z
	8181	"RTN","RCD PEDA3",135 ,0)
	8182	D SL(.INP UT,Z)
	8183	"RTN","RCD PEDA3",136 ,0)
	8184	;
	8185	"RTN","RCD PEDA3",137 ,0)
	8186	; PRCA276 add divis ions to he ader
	8187	"RTN","RCD PEDA3",138 ,0)
	8188	S Z1="" I 'VAUTD S Z0=0 F S Z0=$O(VAUT D(Z0)) Q:' Z0 S Z1=Z 1_VAUTD(Z0 )_", "
	8189	"RTN","RCD PEDA3",139 ,0)
	8190	S Z="DIVI SIONS: "_$ S(VAUTD:"A LL",1:$E(Z 1,1,$L(Z1) -2)),Z=$J( "",80-$L(Z )\2)_Z
	8191	"RTN","RCD PEDA3",140 ,0)
	8192	D SL(.INP UT,Z)
	8193	"RTN","RCD PEDA3",141 ,0)
	8194	;
	8195	"RTN","RCD PEDA3",142 ,0)
	8196	; PRCA276 add payer selection list to h eader
	8197	"RTN","RCD PEDA3",143 ,0)
	8198	I RCNP'=2 D
	8199	"RTN","RCD PEDA3",144 ,0)
	8200	. S Z0=0, Z1=""
	8201	"RTN","RCD PEDA3",145 ,0)
	8202	. F D Q :'Z0
	8203	"RTN","RCD PEDA3",146 ,0)
	8204	. . S Z0= $O(^TMP("R CSELPAY",$ J,Z0))
	8205	"RTN","RCD PEDA3",147 ,0)
	8206	. . Q:'Z0
	8207	"RTN","RCD PEDA3",148 ,0)
	8208	. . S Z1= Z1_^TMP("R CSELPAY",$ J,Z0)_", "
	8209	"RTN","RCD PEDA3",149 ,0)
	8210	S Z="PAYE RS: "_$S(R CNP=2:"ALL ",1:$E(Z1, 1,$L(Z1)-2 )),Z=$J("" ,80-$L(Z)\ 2)_Z
	8211	"RTN","RCD PEDA3",150 ,0)
	8212	D SL(.INP UT,Z)
	8213	"RTN","RCD PEDA3",151 ,0)
	8214	;
	8215	"RTN","RCD PEDA3",152 ,0)
	8216	; PRCA276 add date filter to header
	8217	"RTN","RCD PEDA3",153 ,0)
	8218	S Z="DATE RANGE: "_ $$FMTE^XLF DT(DTST,"2 Z")_" - "_ $$FMTE^XLF DT(DTEND," 2Z")
	8219	"RTN","RCD PEDA3",154 ,0)
	8220	S Z=Z_" ( Date Depos it Added)" ,Z=$J("",8 0-$L(Z)\2) _Z
	8221	"RTN","RCD PEDA3",155 ,0)
	8222	D SL(.INP UT,Z)
	8223	"RTN","RCD PEDA3",156 ,0)
	8224	I DETL D
	8225	"RTN","RCD PEDA3",157 ,0)
	8226	. ;
	8227	"RTN","RCD PEDA3",158 ,0)
	8228	. ; PRCA* 4.5*283 - Add 3 more spaces be tween DEP # and DEPO SIT DT
	8229	"RTN","RCD PEDA3",159 ,0)
	8230	. ; and r emove 3 sp aces betwe en DEPOSIT DT and DE P AMOUNT t o allow fo r 9 digit DEP #'s
	8231	"RTN","RCD PEDA3",160 ,0)
	8232	. D SL(.I NPUT,"")
	8233	"RTN","RCD PEDA3",161 ,0)
	8234	. S XX="D EP # DEPOSIT DT "_$J("", 19)_"DEP A MOUNT FMS D EPOSIT STA T"
	8235	"RTN","RCD PEDA3",162 ,0)
	8236	. S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
	8237	"RTN","RCD PEDA3",163 ,0)
	8238	. D SL(.I NPUT,Z)
	8239	"RTN","RCD PEDA3",164 ,0)
	8240	. ;
	8241	"RTN","RCD PEDA3",165 ,0)
	8242	. ; PRCA* 4.5*318, M ove entire EFT # row to left 1 space to adjust for other row s needing space
	8243	"RTN","RCD PEDA3",166 ,0)
	8244	. ; PRCA* 4.5*284, M ove Match Status to left 3 spa ce to allo w for 10 d igit ERA # 's
	8245	"RTN","RCD PEDA3",167 ,0)
	8246	. S XX=$J ("",2)_"EF T #"_$J("" ,22)_"DATE PD PAYM ENT AMOUNT ERA MATC H STATUS"
	8247	"RTN","RCD PEDA3",168 ,0)
	8248	. S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
	8249	"RTN","RCD PEDA3",169 ,0)
	8250	. D SL(.I NPUT,Z)
	8251	"RTN","RCD PEDA3",170 ,0)
	8252	. ; PRCA* 4.5*318, M ove entire EFT Payer Trace # r ow to left 6 spaces to adjust for other rows needi ng space
	8253	"RTN","RCD PEDA3",171 ,0)
	8254	. S Z=$$S ETSTR^VALM 1($J("",4) _"EFT PAYE R TRACE #" ,"",1,52)
	8255	"RTN","RCD PEDA3",172 ,0)
	8256	. S Z=$$S ETSTR^VALM 1("CR #",Z ,54,4) ;PRCA4.5 318 add C R #
	8257	"RTN","RCD PEDA3",173 ,0)
	8258	. D SL(.I NPUT,Z)
	8259	"RTN","RCD PEDA3",174 ,0)
	8260	. ; PRCA* 4.5*318, M ove entire Payment F rom row to left 8 sp aces to ad just
	8261	"RTN","RCD PEDA3",175 ,0)
	8262	. ; a pos sible 60 c haracter P ayer Name and 20 cha racter Pay er ID
	8263	"RTN","RCD PEDA3",176 ,0)
	8264	. S XX=$J ("",6)_"PA YMENT FROM "
	8265	"RTN","RCD PEDA3",177 ,0)
	8266	. S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
	8267	"RTN","RCD PEDA3",178 ,0)
	8268	. D SL(.I NPUT,Z)
	8269	"RTN","RCD PEDA3",179 ,0)
	8270	. S XX=$J ("",3)_"TR #" ;PRCA4.5 318 add T R #
	8271	"RTN","RCD PEDA3",180 ,0)
	8272	. S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
	8273	"RTN","RCD PEDA3",181 ,0)
	8274	. D SL(.I NPUT,Z) ; TR DOC header
	8275	"RTN","RCD PEDA3",182 ,0)
	8276	. S XX=$J ("",45)_"D EP RECEIPT #"
	8277	"RTN","RCD PEDA3",183 ,0)
	8278	. S Z=$$S ETSTR^VALM 1(XX,"",1, $L(XX))
	8279	"RTN","RCD PEDA3",184 ,0)
	8280	. S Z=$$S ETSTR^VALM 1("DEP REC EIPT STATU S",Z,61,19 )
	8281	"RTN","RCD PEDA3",185 ,0)
	8282	. D SL(.I NPUT,Z)
	8283	"RTN","RCD PEDA3",186 ,0)
	8284	D SL(.INP UT,$TR($J( "",IOM-1), " ","="))
	8285	"RTN","RCD PEDA3",187 ,0)
	8286	Q
	8287	"RTN","RCD PEDA3",188 ,0)
	8288	;
	8289	"RTN","RCD PEDA3",189 ,0)
	8290	TOTSDAY(IN PUT) ; Ent ry Point f rom RCDPED AR
	8291	"RTN","RCD PEDA3",190 ,0)
	8292	; Dis play the t otals for the specif ied date
	8293	"RTN","RCD PEDA3",191 ,0)
	8294	;
	8295	"RTN","RCD PEDA3",192 ,0)
	8296	; Input: INPUT - A1^A 2^A3^...^A n Where:
	8297	"RTN","RCD PEDA3",193 ,0)
	8298	; A1 - 1 if cal led from N ightly Pro cess, 0 ot herwise
	8299	"RTN","RCD PEDA3",194 ,0)
	8300	; A2 - 1 if dis playing to Listman, 0 otherwis e
	8301	"RTN","RCD PEDA3",195 ,0)
	8302	; A3 - 1 if Det ail report , 0 if sum mary repor t
	8303	"RTN","RCD PEDA3",196 ,0)
	8304	; A4 - Current Page Numbe r
	8305	"RTN","RCD PEDA3",197 ,0)
	8306	; A5 - Stop Fla g
	8307	"RTN","RCD PEDA3",198 ,0)
	8308	; A6 - Start of Date Rang e
	8309	"RTN","RCD PEDA3",199 ,0)
	8310	; A7 - End of D ate Range
	8311	"RTN","RCD PEDA3",200 ,0)
	8312	; A8 - Current Line Count er
	8313	"RTN","RCD PEDA3",201 ,0)
	8314	; A9 - Internal Date bein g processe d
	8315	"RTN","RCD PEDA3",202 ,0)
	8316	; ^TMP($J, "TOTALS"," DEP") - Curr ent Total # of depos its for da te range
	8317	"RTN","RCD PEDA3",203 ,0)
	8318	; ^TMP($J, "TOTALS"," DEP",C1) - Tota l # of dep osits for Internal d ate (C1)
	8319	"RTN","RCD PEDA3",204 ,0)
	8320	; ^TMP($J, "TOTALS"," DEPA") - Curr ent Total Deposit Am ount for d ate range
	8321	"RTN","RCD PEDA3",205 ,0)
	8322	; ^TMP($J, "TOTALS"," DEPA",C1) - Tota l Deposit Amount for Internal date (C1)
	8323	"RTN","RCD PEDA3",206 ,0)
	8324	; ^TMP($J, "TOTALS"," EFT","D") - Tota l Deposit Amount by EFTs for d ate
	8325	"RTN","RCD PEDA3",207 ,0)
	8326	; ^TMP($J, "TOTALS"," EFT","T") - Curr ent Total Deposit Am ount by EF Ts for ran ge
	8327	"RTN","RCD PEDA3",208 ,0)
	8328	; ^TMP($J, "TOTALS"," FMS") - FMS Document S tatus or " NO FMS DOC "
	8329	"RTN","RCD PEDA3",209 ,0)
	8330	; ^TMP($J, "TOTALS"," FMS","D",- 1) - Tota l Deposit Amount by FMS Docume nt
	8331	"RTN","RCD PEDA3",210 ,0)
	8332	; ^TMP($J, "TOTALS"," FMS","D",0 ) - Tota l Amount f or Error/R ejected do cuments
	8333	"RTN","RCD PEDA3",211 ,0)
	8334	; ^TMP($J, "TOTALS"," FMS","D",1 ") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs
	8335	"RTN","RCD PEDA3",212 ,0)
	8336	; ^TMP($J, "TOTALS"," FMS","D",2 ") - Tota l Amount f or queued docs
	8337	"RTN","RCD PEDA3",213 ,0)
	8338	; ^TMP($J, "TOTALS"," FMS","T",- 1) - Tota l Deposit Amount by FMS Docume nt for ran ge
	8339	"RTN","RCD PEDA3",214 ,0)
	8340	; ^TMP($J, "TOTALS"," FMS","T",0 ) - Tota l Amount f or Error/R ejected do cs for ran ge
	8341	"RTN","RCD PEDA3",215 ,0)
	8342	; ^TMP($J, "TOTALS"," FMS","T",1 ") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs ran ge
	8343	"RTN","RCD PEDA3",216 ,0)
	8344	; ^TMP($J, "TOTALS"," FMS","T",2 ") - Tota l Amount f or queued docs for r ange
	8345	"RTN","RCD PEDA3",217 ,0)
	8346	; ^TMP($J, "TOTALS"," FMSTOT") - Upda ted Total Deposit Am ount for d ate range
	8347	"RTN","RCD PEDA3",218 ,0)
	8348	; ^TMP($J, "TOTALS"," MATCH","D" ) - Curr ent Total matched EF Ts for dat e
	8349	"RTN","RCD PEDA3",219 ,0)
	8350	; ^TMP($J, "TOTALS"," MATCH","T" ) - Curr ent Total matched EF Ts for dat e range
	8351	"RTN","RCD PEDA3",220 ,0)
	8352	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	8353	"RTN","RCD PEDA3",221 ,0)
	8354	; A4 - Updated Page Numbe r
	8355	"RTN","RCD PEDA3",222 ,0)
	8356	; A5 - Stop Fla g
	8357	"RTN","RCD PEDA3",223 ,0)
	8358	; A8 - Updated Line Count er
	8359	"RTN","RCD PEDA3",224 ,0)
	8360	; ^TMP($J, "TOTALS"," DEP") - Upda ted Total # of depos its for da te range
	8361	"RTN","RCD PEDA3",225 ,0)
	8362	; ^TMP($J, "TOTALS"," DEPA") - Upda ted Total Deposit Am ount for d ate range
	8363	"RTN","RCD PEDA3",226 ,0)
	8364	; ^TMP($J, "TOTALS"," EFT","T") - Upda ted Total Deposit Am ount by EF Ts for ran ge
	8365	"RTN","RCD PEDA3",227 ,0)
	8366	; ^TMP($J, "TOTALS"," FMS","T",- 1) - Upda ted Deposi t Amount b y FMS Docu ment for r ange
	8367	"RTN","RCD PEDA3",228 ,0)
	8368	; ^TMP($J, "TOTALS"," FMS","T",0 ) - Upda ted Amount for Error /Rejected docs for r ange
	8369	"RTN","RCD PEDA3",229 ,0)
	8370	; ^TMP($J, "TOTALS"," FMS","T",1 ") - Upda ted Amount for 'A',' M',"F' or 'T' docs r ange
	8371	"RTN","RCD PEDA3",230 ,0)
	8372	; ^TMP($J, "TOTALS"," FMS","T",2 ") - Upda ted Amount for queue d docs for range
	8373	"RTN","RCD PEDA3",231 ,0)
	8374	; ^TMP($J, "TOTALS"," MATCH","T" ) - Upda ted Total Matched EF Ts for dat e range
	8375	"RTN","RCD PEDA3",232 ,0)
	8376	N CURPG,D TADD,LSTMA N,NL,Q,XX, YY
	8377	"RTN","RCD PEDA3",233 ,0)
	8378	S LSTMAN= $P(INPUT," ^",2) ; Disp lay to Lis tman flag
	8379	"RTN","RCD PEDA3",234 ,0)
	8380	S NJ=$P(I NPUT,"^",1 ) ; Call ed from Ni ghtly Proc ess flag
	8381	"RTN","RCD PEDA3",235 ,0)
	8382	S CURPG=$ P(INPUT,"^ ",4) ; Curr ent Page C ounter
	8383	"RTN","RCD PEDA3",236 ,0)
	8384	S DTADD=$ P(INPUT,"^ ",9) ; Date to displa y totals f or
	8385	"RTN","RCD PEDA3",237 ,0)
	8386	S XX=$G(^ TMP($J,"TO TALS","DEP A")) ; Curr ent Total Deposit Am ount for d ate range
	8387	"RTN","RCD PEDA3",238 ,0)
	8388	S YY=$G(^ TMP($J,"TO TALS","DEP A",DTADD)) ; Tota l Deposit Amount for date
	8389	"RTN","RCD PEDA3",239 ,0)
	8390	S ^TMP($J ,"TOTALS", "DEPA")=XX +YY ; Upda ted Total for range
	8391	"RTN","RCD PEDA3",240 ,0)
	8392	S XX=$G(^ TMP($J,"TO TALS","DEP ")) ; Curr ent Total # of Depos its for da te range
	8393	"RTN","RCD PEDA3",241 ,0)
	8394	S YY=$G(^ TMP($J,"TO TALS","DEP ",DTADD)) ; Tota l # of Dep osits for date
	8395	"RTN","RCD PEDA3",242 ,0)
	8396	S ^TMP($J ,"TOTALS", "DEP")=XX+ YY ; Upda ted Total # for rang e
	8397	"RTN","RCD PEDA3",243 ,0)
	8398	;
	8399	"RTN","RCD PEDA3",244 ,0)
	8400	S XX=$G(^ TMP($J,"TO TALS","EFT ","T")) ; Curr ent Total Amount by EFTs for d ate range
	8401	"RTN","RCD PEDA3",245 ,0)
	8402	S YY=$G(^ TMP($J,"TO TALS","EFT ","D")) ; Tota l Amount b y EFTs for date
	8403	"RTN","RCD PEDA3",246 ,0)
	8404	S ^TMP($J ,"TOTALS", "EFT","T") =XX+YY ; Upda ted Total Amount for range
	8405	"RTN","RCD PEDA3",247 ,0)
	8406	;
	8407	"RTN","RCD PEDA3",248 ,0)
	8408	S XX=$G(^ TMP($J,"TO TALS","MAT CH","T")) ; Curr ent Total # Matched EFTs for d ate range
	8409	"RTN","RCD PEDA3",249 ,0)
	8410	S YY=$G(^ TMP($J,"TO TALS","MAT CH","D")) ; # Ma tched EFTs for date
	8411	"RTN","RCD PEDA3",250 ,0)
	8412	S ^TMP($J ,"TOTALS", "MATCH","T ")=XX+YY ; Upda ted Total # Matched EFTs for d ate range
	8413	"RTN","RCD PEDA3",251 ,0)
	8414	;
	8415	"RTN","RCD PEDA3",252 ,0)
	8416	; Update document s tatus tota ls for ran ge
	8417	"RTN","RCD PEDA3",253 ,0)
	8418	F Q=-1,0, 1,2 D
	8419	"RTN","RCD PEDA3",254 ,0)
	8420	. S XX=$G (^TMP($J," TOTALS","F MS","T",Q) ) ; Curr ent Total # of Q sta tus for da te range
	8421	"RTN","RCD PEDA3",255 ,0)
	8422	. S YY=$G (^TMP($J," TOTALS","F MS","D",Q) ) ; # of Q status for date
	8423	"RTN","RCD PEDA3",256 ,0)
	8424	. S ^TMP( $J,"TOTALS ","FMS","T ",Q)=XX+YY ; Upda ted Total # of Q sta tus for da te range
	8425	"RTN","RCD PEDA3",257 ,0)
	8426	;
	8427	"RTN","RCD PEDA3",258 ,0)
	8428	; Display the daily totals
	8429	"RTN","RCD PEDA3",259 ,0)
	8430	D SL(.INP UT," ")
	8431	"RTN","RCD PEDA3",260 ,0)
	8432	I $S('NJ: ($Y+5)>IOS L,1:0)!'CU RPG D Q:$ P(INPUT,"^ ",5)=1
	8433	"RTN","RCD PEDA3",261 ,0)
	8434	. D:'LSTM AN HDR(.IN PUT)
	8435	"RTN","RCD PEDA3",262 ,0)
	8436	S XX=$E(" **TOTALS F OR DATE: " _$$FMTE^XL FDT(DTADD\ 1,"2Z")_$J ("",30),1, 30)
	8437	"RTN","RCD PEDA3",263 ,0)
	8438	S YY=$G(^ TMP($J,"TO TALS","DEP ",DTADD))
	8439	"RTN","RCD PEDA3",264 ,0)
	8440	S XX=XX_" # OF DE POSIT TICK ETS RECEIV ED: "_+YY_ $J("",5)
	8441	"RTN","RCD PEDA3",265 ,0)
	8442	D SL(.INP UT,XX)
	8443	"RTN","RCD PEDA3",266 ,0)
	8444	S YY=$G(^ TMP($J,"TO TALS","DEP A",DTADD))
	8445	"RTN","RCD PEDA3",267 ,0)
	8446	S XX=$J(" ",29)_"TOT AL AMOUNT OF DEPOSIT S RECEIVED : $"_$J(YY ,"",2)
	8447	"RTN","RCD PEDA3",268 ,0)
	8448	D SL(.INP UT,XX)
	8449	"RTN","RCD PEDA3",269 ,0)
	8450	Q:$P(INPU T,"^",5)=1
	8451	"RTN","RCD PEDA3",270 ,0)
	8452	D SL(.INP UT," ")
	8453	"RTN","RCD PEDA3",271 ,0)
	8454	D SL(.INP UT,$J("",2 0)_"DEPOSI T AMOUNTS SENT TO FM S:")
	8455	"RTN","RCD PEDA3",272 ,0)
	8456	Q:$P(INPU T,"^",5)=1
	8457	"RTN","RCD PEDA3",273 ,0)
	8458	S YY=+$G( ^TMP($J,"T OTALS","FM S","D",1))
	8459	"RTN","RCD PEDA3",274 ,0)
	8460	S XX=$J(" ",39)_"ACC EPTED: $"_ $J(YY,"",2 )
	8461	"RTN","RCD PEDA3",275 ,0)
	8462	D SL(.INP UT,XX)
	8463	"RTN","RCD PEDA3",276 ,0)
	8464	Q:$P(INPU T,"^",5)=1
	8465	"RTN","RCD PEDA3",277 ,0)
	8466	S YY=+$G( ^TMP($J,"T OTALS","FM S","D",2))
	8467	"RTN","RCD PEDA3",278 ,0)
	8468	S XX=$J(" ",41)_"QUE UED: $"_$J (YY,"",2)
	8469	"RTN","RCD PEDA3",279 ,0)
	8470	D SL(.INP UT,XX)
	8471	"RTN","RCD PEDA3",280 ,0)
	8472	Q:$P(INPU T,"^",5)=1
	8473	"RTN","RCD PEDA3",281 ,0)
	8474	S YY=+$G( ^TMP($J,"T OTALS","FM S","D",0))
	8475	"RTN","RCD PEDA3",282 ,0)
	8476	S XX=$J(" ",35)_"ERR OR/REJECT: $"_$J(YY, "",2)
	8477	"RTN","RCD PEDA3",283 ,0)
	8478	D SL(.INP UT,XX)
	8479	"RTN","RCD PEDA3",284 ,0)
	8480	Q:$P(INPU T,"^",5)=1
	8481	"RTN","RCD PEDA3",285 ,0)
	8482	S YY=+$G( ^TMP($J,"T OTALS","FM S","D",-1) )
	8483	"RTN","RCD PEDA3",286 ,0)
	8484	S XX=$J(" ",37)_"NOT IN FMS: $ "_$J(YY,"" ,2)
	8485	"RTN","RCD PEDA3",287 ,0)
	8486	D SL(.INP UT,XX)
	8487	"RTN","RCD PEDA3",288 ,0)
	8488	D SL(.INP UT," ")
	8489	"RTN","RCD PEDA3",289 ,0)
	8490	Q:$P(INPU T,"^",5)=1
	8491	"RTN","RCD PEDA3",290 ,0)
	8492	S YY=+$G( ^TMP($J,"T OTALS","EF T","D"))
	8493	"RTN","RCD PEDA3",291 ,0)
	8494	S XX=$J(" ",26)_"# E FT PAYMENT RECORDS: "_YY
	8495	"RTN","RCD PEDA3",292 ,0)
	8496	D SL(.INP UT,XX)
	8497	"RTN","RCD PEDA3",293 ,0)
	8498	Q:$P(INPU T,"^",5)=1
	8499	"RTN","RCD PEDA3",294 ,0)
	8500	S YY=+$G( ^TMP($J,"T OTALS","MA TCH","D"))
	8501	"RTN","RCD PEDA3",295 ,0)
	8502	S XX=$J(" ",25)_"# E FT PAYMENT S MATCHED: "_YY
	8503	"RTN","RCD PEDA3",296 ,0)
	8504	D SL(.INP UT,XX)
	8505	"RTN","RCD PEDA3",297 ,0)
	8506	Q:$P(INPU T,"^",5)=1
	8507	"RTN","RCD PEDA3",298 ,0)
	8508	S YY=+$G( ^TMP($J,"T OTALS","DE PAP",DTADD ))
	8509	"RTN","RCD PEDA3",299 ,0)
	8510	S XX=$J(" ",18)_"MAT CHED PAYME NT AMOUNT POSTED: $" _$J(YY,"", 2)
	8511	"RTN","RCD PEDA3",300 ,0)
	8512	D SL(.INP UT,XX)
	8513	"RTN","RCD PEDA3",301 ,0)
	8514	D SL(.INP UT," ")
	8515	"RTN","RCD PEDA3",302 ,0)
	8516	Q
	8517	"RTN","RCD PEDA3",303 ,0)
	8518	;
	8519	"RTN","RCD PEDA3",304 ,0)
	8520	TOTSF(INPU T) ; Entry Point fro m RCDPEDAR
	8521	"RTN","RCD PEDA3",305 ,0)
	8522	; Displ ay Final T otals
	8523	"RTN","RCD PEDA3",306 ,0)
	8524	;
	8525	"RTN","RCD PEDA3",307 ,0)
	8526	; Input: INPUT - A1^A 2^A3^...^A n Where:
	8527	"RTN","RCD PEDA3",308 ,0)
	8528	; A1 - 1 if cal led from N ightly Pro cess, 0 ot herwise
	8529	"RTN","RCD PEDA3",309 ,0)
	8530	; A2 - 1 if dis playing to Listman, 0 otherwis e
	8531	"RTN","RCD PEDA3",310 ,0)
	8532	; A3 - 1 if Det ail report , 0 if sum mary repor t
	8533	"RTN","RCD PEDA3",311 ,0)
	8534	; A4 - Current Page Numbe r
	8535	"RTN","RCD PEDA3",312 ,0)
	8536	; A5 - Stop Fla g
	8537	"RTN","RCD PEDA3",313 ,0)
	8538	; A6 - Start of Date Rang e
	8539	"RTN","RCD PEDA3",314 ,0)
	8540	; A7 - End of D ate Range
	8541	"RTN","RCD PEDA3",315 ,0)
	8542	; A8 - Current Line Count er
	8543	"RTN","RCD PEDA3",316 ,0)
	8544	; A9 - Internal Date bein g processe d
	8545	"RTN","RCD PEDA3",317 ,0)
	8546	; ^TMP($J, "TOTALS"," DEP") - Tota l # of dep osits for date range
	8547	"RTN","RCD PEDA3",318 ,0)
	8548	; ^TMP($J, "TOTALS"," DEPA") - Tota l Deposit Amount for date rang e
	8549	"RTN","RCD PEDA3",319 ,0)
	8550	; ^TMP($J, "TOTALS"," EFT","T") - Tota l Deposit Amount by EFTs for r ange
	8551	"RTN","RCD PEDA3",320 ,0)
	8552	; ^TMP($J, "TOTALS"," FMS","T",- 1) - Tota l Deposit Amount by FMS Docume nt for ran ge
	8553	"RTN","RCD PEDA3",321 ,0)
	8554	; ^TMP($J, "TOTALS"," FMS","T",0 ) - Tota l Amount f or Error/R ejected do cs for ran ge
	8555	"RTN","RCD PEDA3",322 ,0)
	8556	; ^TMP($J, "TOTALS"," FMS","T",1 ") - Tota l Amount f or 'A','M' ,"F' or 'T ' docs ran ge
	8557	"RTN","RCD PEDA3",323 ,0)
	8558	; ^TMP($J, "TOTALS"," FMS","T",2 ") - Tota l Amount f or queued docs for r ange
	8559	"RTN","RCD PEDA3",324 ,0)
	8560	; ^TMP($J, "TOTALS"," MATCH","T" ) - Tota l Matched EFTs for d ate range
	8561	"RTN","RCD PEDA3",325 ,0)
	8562	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	8563	"RTN","RCD PEDA3",326 ,0)
	8564	; A5 - Updated Page Numbe r
	8565	"RTN","RCD PEDA3",327 ,0)
	8566	; A6 - Stop Fla g
	8567	"RTN","RCD PEDA3",328 ,0)
	8568	; A8 - Updated Line Count er
	8569	"RTN","RCD PEDA3",329 ,0)
	8570	N LSTMAN, NJ,XX,YY
	8571	"RTN","RCD PEDA3",330 ,0)
	8572	S LSTMAN= $P(INPUT," ^",2),NJ=$ P(INPUT,"^ ",1)
	8573	"RTN","RCD PEDA3",331 ,0)
	8574	;
	8575	"RTN","RCD PEDA3",332 ,0)
	8576	; Display header if no output was displ ayed and n ot being d isplayed i n listman
	8577	"RTN","RCD PEDA3",333 ,0)
	8578	I '$O(^TM P("RCDAILY ACT",$J,0) ),'LSTMAN D HDR(.INP UT)
	8579	"RTN","RCD PEDA3",334 ,0)
	8580	;
	8581	"RTN","RCD PEDA3",335 ,0)
	8582	; If user quit or ( Nightly pr ocess flag AND not d isplay to listman) - end here
	8583	"RTN","RCD PEDA3",336 ,0)
	8584	I $P(INPU T,"^",5)=1 !(NJ&'LSTM AN) Q
	8585	"RTN","RCD PEDA3",337 ,0)
	8586	D SL(.INP UT," ")
	8587	"RTN","RCD PEDA3",338 ,0)
	8588	S XX=$E(" **** TOTAL S FOR DATE RANGE:"_$ J("",30),1 ,30)
	8589	"RTN","RCD PEDA3",339 ,0)
	8590	S YY=+$G( ^TMP($J,"T OTALS","DE P"))
	8591	"RTN","RCD PEDA3",340 ,0)
	8592	S XX=XX_" # OF DE POSIT TICK ETS RECEIV ED: "_YY_$ J("",5)
	8593	"RTN","RCD PEDA3",341 ,0)
	8594	D SL(.INP UT,XX)
	8595	"RTN","RCD PEDA3",342 ,0)
	8596	S YY=+$G( ^TMP($J,"T OTALS","DE PA"))
	8597	"RTN","RCD PEDA3",343 ,0)
	8598	S XX=$J(" ",29)_"TOT AL AMOUNT OF DEPOSIT S RECEIVED : $"_$J(YY ,"",2)
	8599	"RTN","RCD PEDA3",344 ,0)
	8600	D SL(.INP UT,XX)
	8601	"RTN","RCD PEDA3",345 ,0)
	8602	D SL(.INP UT," ")
	8603	"RTN","RCD PEDA3",346 ,0)
	8604	D SL(.INP UT,$J("",2 0)_"DEPOSI T AMOUNTS SENT TO FM S:")
	8605	"RTN","RCD PEDA3",347 ,0)
	8606	S YY=+$G( ^TMP($J,"T OTALS","FM S","T",1))
	8607	"RTN","RCD PEDA3",348 ,0)
	8608	S XX=$J(" ",39)_"ACC EPTED: $"_ $J(YY,"",2 )
	8609	"RTN","RCD PEDA3",349 ,0)
	8610	D SL(.INP UT,XX)
	8611	"RTN","RCD PEDA3",350 ,0)
	8612	S YY=+$G( ^TMP($J,"T OTALS","FM S","T",2))
	8613	"RTN","RCD PEDA3",351 ,0)
	8614	S XX=$J(" ",41)_"QUE UED: $"_$J (YY,"",2)
	8615	"RTN","RCD PEDA3",352 ,0)
	8616	D SL(.INP UT,XX)
	8617	"RTN","RCD PEDA3",353 ,0)
	8618	S YY=+$G( ^TMP($J,"T OTALS","FM S","T",0))
	8619	"RTN","RCD PEDA3",354 ,0)
	8620	S XX=$J(" ",35)_"ERR OR/REJECT: $"_$J(YY, "",2)
	8621	"RTN","RCD PEDA3",355 ,0)
	8622	D SL(.INP UT,XX)
	8623	"RTN","RCD PEDA3",356 ,0)
	8624	S YY=+$G( ^TMP($J,"T OTALS","FM S","T",-1) )
	8625	"RTN","RCD PEDA3",357 ,0)
	8626	S XX=$J(" ",37)_"NOT IN FMS: $ "_$J(YY,"" ,2)
	8627	"RTN","RCD PEDA3",358 ,0)
	8628	D SL(.INP UT,XX)
	8629	"RTN","RCD PEDA3",359 ,0)
	8630	D SL(.INP UT," ")
	8631	"RTN","RCD PEDA3",360 ,0)
	8632	;
	8633	"RTN","RCD PEDA3",361 ,0)
	8634	S YY=+$G( ^TMP($J,"T OTALS","EF T","T"))
	8635	"RTN","RCD PEDA3",362 ,0)
	8636	S XX=$J(" ",26)_"# E FT PAYMENT RECORDS: "_YY
	8637	"RTN","RCD PEDA3",363 ,0)
	8638	D SL(.INP UT,XX)
	8639	"RTN","RCD PEDA3",364 ,0)
	8640	S YY=+$G( ^TMP($J,"T OTALS","MA TCH","T"))
	8641	"RTN","RCD PEDA3",365 ,0)
	8642	S XX=$J(" ",25)_"# E FT PAYMENT S MATCHED: "_YY
	8643	"RTN","RCD PEDA3",366 ,0)
	8644	D SL(.INP UT,XX)
	8645	"RTN","RCD PEDA3",367 ,0)
	8646	S YY=+$G( ^TMP($J,"T OTALS","DE PAP"))
	8647	"RTN","RCD PEDA3",368 ,0)
	8648	S XX=$J(" ",18)_"MAT CHED PAYME NT AMOUNT POSTED: $" _$J(YY,"", 2)
	8649	"RTN","RCD PEDA3",369 ,0)
	8650	D SL(.INP UT,XX)
	8651	"RTN","RCD PEDA3",370 ,0)
	8652	D SL(.INP UT," ")
	8653	"RTN","RCD PEDA3",371 ,0)
	8654	D SL(.INP UT," ")
	8655	"RTN","RCD PEDA3",372 ,0)
	8656	Q
	8657	"RTN","RCD PEDA3",373 ,0)
	8658	;
	8659	"RTN","RCD PEDA3",374 ,0)
	8660	ASK(RCSTOP ) ; Ask to continue
	8661	"RTN","RCD PEDA3",375 ,0)
	8662	; If pass ed by refe rence ,RCS TOP is ret urned as 1 if print is aborted
	8663	"RTN","RCD PEDA3",376 ,0)
	8664	I $E(IOST ,1,2)'["C- " Q
	8665	"RTN","RCD PEDA3",377 ,0)
	8666	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
	8667	"RTN","RCD PEDA3",378 ,0)
	8668	S DIR(0)= "E" W ! D ^DIR
	8669	"RTN","RCD PEDA3",379 ,0)
	8670	I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q
	8671	"RTN","RCD PEDA3",380 ,0)
	8672	Q
	8673	"RTN","RCD PEDA3",381 ,0)
	8674	;
	8675	"RTN","RCD PEDA3",382 ,0)
	8676	SL(INPUT,Z ) ; Entry Point from RCDPEDAR & RCDEPA2
	8677	"RTN","RCD PEDA3",383 ,0)
	8678	; Writes or stores line
	8679	"RTN","RCD PEDA3",384 ,0)
	8680	;
	8681	"RTN","RCD PEDA3",385 ,0)
	8682	; Input: INPUT - A1 ^A2^A3^... ^An Where:
	8683	"RTN","RCD PEDA3",386 ,0)
	8684	; A1 - 1 if called fro m Nightly Process, 0 otherwise
	8685	"RTN","RCD PEDA3",387 ,0)
	8686	; A2 - 1 if displaying to Listma n, 0 other wise
	8687	"RTN","RCD PEDA3",388 ,0)
	8688	; A3 - 1 if Detail rep ort, 0 if summary re port
	8689	"RTN","RCD PEDA3",389 ,0)
	8690	; A4 - Curre nt Page Nu mber
	8691	"RTN","RCD PEDA3",390 ,0)
	8692	; A5 - Stop Flag
	8693	"RTN","RCD PEDA3",391 ,0)
	8694	; A6 - Start of Date R ange
	8695	"RTN","RCD PEDA3",392 ,0)
	8696	; A7 - End o f Date Ran ge
	8697	"RTN","RCD PEDA3",393 ,0)
	8698	; A8 - Curre nt Line Nu mber
	8699	"RTN","RCD PEDA3",394 ,0)
	8700	; Z - Da ta line to write or store
	8701	"RTN","RCD PEDA3",395 ,0)
	8702	; RCCT - Cu rrent line counter
	8703	"RTN","RCD PEDA3",396 ,0)
	8704	; RCNJ - 1 to set arr ay, 0 to w rite line
	8705	"RTN","RCD PEDA3",397 ,0)
	8706	; ^TMP($J, "RCDPE_DAR ") - Cu rrent arra y of store d lines (i f RCNJ=1)
	8707	"RTN","RCD PEDA3",398 ,0)
	8708	; Output: INPUT - A1 ^A2^A3^... ^An - The following pieces may be update d
	8709	"RTN","RCD PEDA3",399 ,0)
	8710	; A11 - Upda ted Line N umber
	8711	"RTN","RCD PEDA3",400 ,0)
	8712	; Output:
	8713	"RTN","RCD PEDA3",401 ,0)
	8714	; ^TMP($J, "RCDPE_DAR ") - Up dated arra y of store d lines (i f RCNJ=1)
	8715	"RTN","RCD PEDA3",402 ,0)
	8716	N XX
	8717	"RTN","RCD PEDA3",403 ,0)
	8718	S XX=$P(I NPUT,"^",8 )+1
	8719	"RTN","RCD PEDA3",404 ,0)
	8720	S $P(INPU T,"^",8)=X X
	8721	"RTN","RCD PEDA3",405 ,0)
	8722	;
	8723	"RTN","RCD PEDA3",406 ,0)
	8724	; Called from night ly process
	8725	"RTN","RCD PEDA3",407 ,0)
	8726	I $P(INPU T,"^",1) S ^TMP($J," RCDPE_DAR" ,XX)=Z Q
	8727	"RTN","RCD PEDA3",408 ,0)
	8728	W !,Z
	8729	"RTN","RCD PEDA3",409 ,0)
	8730	Q
	8731	"RTN","RCD PEDAR")
	8732	0^6^B72692 368^B19642 7903
	8733	"RTN","RCD PEDAR",1,0 )
	8734	RCDPEDAR ; ALB/TMK - ACTIVITY R EPORT ;Jun 06, 2014@ 19:11:19
	8735	"RTN","RCD PEDAR",2,0 )
	8736	;;4.5;Acc ounts Rece ivable;1 73,276,284 ,283,298,3 04,318;M ar 20, 199 5;Build 25
	8737	"RTN","RCD PEDAR",3,0 )
	8738	;Per VA D irective 6 402, this routine sh ould not b e modified .
	8739	"RTN","RCD PEDAR",4,0 )
	8740	Q
	8741	"RTN","RCD PEDAR",5,0 )
	8742	;
	8743	"RTN","RCD PEDAR",6,0 )
	8744	RPT ; Dail y Activity Rpt On De mand
	8745	"RTN","RCD PEDAR",7,0 )
	8746	N POP,RCD ET,RCDIV,R CDT1,RCDT2 ,RCHDR,RCI NC,RCLSTMG R,RCNP,RCN J
	8747	"RTN","RCD PEDAR",8,0 )
	8748	N RCPYRSE L,RCRANGE, RCSTOP,RCT MPND,VAUTD ,X,XX,Y,%Z IS
	8749	"RTN","RCD PEDAR",9,0 )
	8750	S RCNJ=0 ; Not the nightl y job, use r interact ions
	8751	"RTN","RCD PEDAR",10, 0)
	8752	D DIVISIO N^VAUTOMA ; IA 6 64 Select Division/S tation - s ets VAUTD
	8753	"RTN","RCD PEDAR",11, 0)
	8754	I 'VAUTD, ($D(VAUTD) '=11) Q
	8755	"RTN","RCD PEDAR",12, 0)
	8756	S RCDET=$ $RTYPE() ; Sele ct Report Type (Summ ary/Detail )
	8757	"RTN","RCD PEDAR",13, 0)
	8758	Q:RCDET=- 1
	8759	"RTN","RCD PEDAR",14, 0)
	8760	S XX=$$DT RANGE(.RCD T1,.RCDT2) ; Sele ct Date Ra nge to be used
	8761	"RTN","RCD PEDAR",15, 0)
	8762	Q:'XX
	8763	"RTN","RCD PEDAR",16, 0)
	8764	;
	8765	"RTN","RCD PEDAR",17, 0)
	8766	; Get ins urance com pany to be used as f ilter
	8767	"RTN","RCD PEDAR",18, 0)
	8768	; PRCA4. 5284 - RC NP is Type of Respon se (1=Rang e,2=All,3= Specific) ^ From Ran ge^ Thru R ange
	8769	"RTN","RCD PEDAR",19, 0)
	8770	S RCNP=$$ GETPAY^RCD PEM9(344.3 1)
	8771	"RTN","RCD PEDAR",20, 0)
	8772	Q:+RCNP=- 1 ; No I nsurance C ompany sel ected
	8773	"RTN","RCD PEDAR",21, 0)
	8774	S RCLSTMG R=$$ASKLM^ RCDPEARL ; Ask to Display in Listma n Template
	8775	"RTN","RCD PEDAR",22, 0)
	8776	Q:RCLSTMG R<0 ; '^' or timeout
	8777	"RTN","RCD PEDAR",23, 0)
	8778	;
	8779	"RTN","RCD PEDAR",24, 0)
	8780	I RCLSTMG R=1 D Q ; List Man Templa te format, put in ar ray
	8781	"RTN","RCD PEDAR",25, 0)
	8782	. S RCTMP ND="RCDPE_ DAR"
	8783	"RTN","RCD PEDAR",26, 0)
	8784	. K ^TMP( $J,RCTMPND )
	8785	"RTN","RCD PEDAR",27, 0)
	8786	. D EN(RC DET,RCDT1, RCDT2,RCLS TMGR)
	8787	"RTN","RCD PEDAR",28, 0)
	8788	. D LMHDR ^RCDPEDA3( .RCSTOP,RC DET,1,RCDT 1,RCDT2,.R CHDR)
	8789	"RTN","RCD PEDAR",29, 0)
	8790	. D LMRPT ^RCDPEARL( .RCHDR,$NA (^TMP($J,R CTMPND))) ; Generate ListMan d isplay
	8791	"RTN","RCD PEDAR",30, 0)
	8792	. K ^TMP( $J,RCTMPND )
	8793	"RTN","RCD PEDAR",31, 0)
	8794	;
	8795	"RTN","RCD PEDAR",32, 0)
	8796	; Ask dev ice
	8797	"RTN","RCD PEDAR",33, 0)
	8798	S %ZIS="Q M"
	8799	"RTN","RCD PEDAR",34, 0)
	8800	D ^%ZIS
	8801	"RTN","RCD PEDAR",35, 0)
	8802	Q:POP
	8803	"RTN","RCD PEDAR",36, 0)
	8804	;
	8805	"RTN","RCD PEDAR",37, 0)
	8806	I $D(IO(" Q")) D Q ; Queu ed Report
	8807	"RTN","RCD PEDAR",38, 0)
	8808	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	8809	"RTN","RCD PEDAR",39, 0)
	8810	. S ZTRTN ="EN^RCDPE DAR("_RCDE T_","_RCDT 1_","_RCDT 2_")"
	8811	"RTN","RCD PEDAR",40, 0)
	8812	. S ZTDES C="AR - ED I LOCKBOX EFT DAILY ACTIVITY R EPORT"
	8813	"RTN","RCD PEDAR",41, 0)
	8814	. S ZTSAV E("RC*")=" ",ZTSAVE(" VAUTD")=""
	8815	"RTN","RCD PEDAR",42, 0)
	8816	. ;
	8817	"RTN","RCD PEDAR",43, 0)
	8818	. ; PRCA* 4.5*284 - Because TM P global m ay be on a nother ser ver, save off specif ic payers in local
	8819	"RTN","RCD PEDAR",44, 0)
	8820	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	8821	"RTN","RCD PEDAR",45, 0)
	8822	. D ^%ZTL OAD
	8823	"RTN","RCD PEDAR",46, 0)
	8824	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	8825	"RTN","RCD PEDAR",47, 0)
	8826	. K ZTSK, IO("Q")
	8827	"RTN","RCD PEDAR",48, 0)
	8828	. D HOME^ %ZIS
	8829	"RTN","RCD PEDAR",49, 0)
	8830	;
	8831	"RTN","RCD PEDAR",50, 0)
	8832	U IO
	8833	"RTN","RCD PEDAR",51, 0)
	8834	D EN(RCDE T,RCDT1,RC DT2,RCLSTM GR)
	8835	"RTN","RCD PEDAR",52, 0)
	8836	Q
	8837	"RTN","RCD PEDAR",53, 0)
	8838	;
	8839	"RTN","RCD PEDAR",54, 0)
	8840	RTYPE() ; Allows the user to s elect the report typ e (Summary /Detail)
	8841	"RTN","RCD PEDAR",55, 0)
	8842	; Input: None
	8843	"RTN","RCD PEDAR",56, 0)
	8844	; Returns : 0 - Summary Display
	8845	"RTN","RCD PEDAR",57, 0)
	8846	; 1 - Detail D isplay
	8847	"RTN","RCD PEDAR",58, 0)
	8848	; -1 - User up- arrowed or timed out
	8849	"RTN","RCD PEDAR",59, 0)
	8850	N DIR,DTO UT,DUOUT
	8851	"RTN","RCD PEDAR",60, 0)
	8852	S DIR("A" )="(S)UMMA RY OR (D)E TAIL?: "
	8853	"RTN","RCD PEDAR",61, 0)
	8854	S DIR(0)= "SA^S:SUMM ARY TOTALS ONLY;D:DE TAIL AND T OTALS"
	8855	"RTN","RCD PEDAR",62, 0)
	8856	S DIR("B" )="D"
	8857	"RTN","RCD PEDAR",63, 0)
	8858	D ^DIR
	8859	"RTN","RCD PEDAR",64, 0)
	8860	I $D(DTOU T)!$D(DUOU T)!(Y="") Q -1
	8861	"RTN","RCD PEDAR",65, 0)
	8862	Q Y="D"
	8863	"RTN","RCD PEDAR",66, 0)
	8864	;
	8865	"RTN","RCD PEDAR",67, 0)
	8866	DTRANGE(ST DATE,ENDDA TE) ; Allo ws the use r to selec t the date range to by used
	8867	"RTN","RCD PEDAR",68, 0)
	8868	; Input: None
	8869	"RTN","RCD PEDAR",69, 0)
	8870	; Output: STDATE = Internal Fileman D ate to sta rt at
	8871	"RTN","RCD PEDAR",70, 0)
	8872	; ENDDATE - Internal Fileman D ate to end at
	8873	"RTN","RCD PEDAR",71, 0)
	8874	; Returns : 0 - User up-arrowe d or timed out, 1 ot herwise
	8875	"RTN","RCD PEDAR",72, 0)
	8876	N DIR,DTO UT,DUOUT
	8877	"RTN","RCD PEDAR",73, 0)
	8878	S DIR("?" )="Enter t he earlies t date of receipt of deposit t o include on the rep ort."
	8879	"RTN","RCD PEDAR",74, 0)
	8880	S DIR(0)= "DAO^:"_DT _":APE"
	8881	"RTN","RCD PEDAR",75, 0)
	8882	S DIR("A" )="START D ATE: "
	8883	"RTN","RCD PEDAR",76, 0)
	8884	D ^DIR
	8885	"RTN","RCD PEDAR",77, 0)
	8886	Q:$D(DTOU T)!$D(DUOU T)!(Y="") 0
	8887	"RTN","RCD PEDAR",78, 0)
	8888	S STDATE= Y
	8889	"RTN","RCD PEDAR",79, 0)
	8890	K DIR
	8891	"RTN","RCD PEDAR",80, 0)
	8892	S DIR("?" )="Enter t he latest date of re ceipt of d eposit to include on the repor t."
	8893	"RTN","RCD PEDAR",81, 0)
	8894	S DIR("B" )=Y(0)
	8895	"RTN","RCD PEDAR",82, 0)
	8896	S DIR(0)= "DAO^"_RCD T1_":"_DT_ ":APE",DIR ("A")="END DATE: "
	8897	"RTN","RCD PEDAR",83, 0)
	8898	D ^DIR
	8899	"RTN","RCD PEDAR",84, 0)
	8900	Q:$D(DTOU T)!$D(DUOU T)!(Y="") 0
	8901	"RTN","RCD PEDAR",85, 0)
	8902	S ENDDATE =Y
	8903	"RTN","RCD PEDAR",86, 0)
	8904	Q 1
	8905	"RTN","RCD PEDAR",87, 0)
	8906	;
	8907	"RTN","RCD PEDAR",88, 0)
	8908	EN(RCDET,R CDT1,RCDT2 ,RCLSTMGR) ; Entry p oint for r eport, mig ht be queu ed
	8909	"RTN","RCD PEDAR",89, 0)
	8910	; Input: RCDET - 1 - Detail Rep ort, 0 - S ummary
	8911	"RTN","RCD PEDAR",90, 0)
	8912	; RCDT1 - Inte rnal Filem an Start d ate
	8913	"RTN","RCD PEDAR",91, 0)
	8914	; RCDT2 - Inte rnal Filem an End dat e
	8915	"RTN","RCD PEDAR",92, 0)
	8916	; RCLSTMGR - 1 di splay in l ist manage r, 0 other wise
	8917	"RTN","RCD PEDAR",93, 0)
	8918	; Opti onal, defa ults to 0
	8919	"RTN","RCD PEDAR",94, 0)
	8920	; RCNP - A1^A 2^A3 Where :
	8921	"RTN","RCD PEDAR",95, 0)
	8922	; A 1 - 1 - Ra nge of Pay ers
	8923	"RTN","RCD PEDAR",96, 0)
	8924	; 2 - Al l Payers s elected
	8925	"RTN","RCD PEDAR",97, 0)
	8926	; 3 - Sp ecific pay ers
	8927	"RTN","RCD PEDAR",98, 0)
	8928	; A 2 - From R ange (When a from/th ru range i s selected by user)
	8929	"RTN","RCD PEDAR",99, 0)
	8930	; A 3 - Thru R ange (When a from/th ru range i s selected by user)
	8931	"RTN","RCD PEDAR",100 ,0)
	8932	; RCPYRSEL - Arra y of selec ted payers (Only pre sent if A1 =3 above
	8933	"RTN","RCD PEDAR",101 ,0)
	8934	; VAUTD - 1 - All select ed divisio ns OR an a rray of se lected div isions
	8935	"RTN","RCD PEDAR",102 ,0)
	8936	N DTADD,I EN3443,IEN 34431,INPU T,RCFLG,RC JOB,RCT,XX ,Z
	8937	"RTN","RCD PEDAR",103 ,0)
	8938	N:$G(ZTSK ) ZTSTOP ; Job was tasked , ZTSTOP = flag to s top
	8939	"RTN","RCD PEDAR",104 ,0)
	8940	S:'$D(RCL STMGR) RCL STMGR=0
	8941	"RTN","RCD PEDAR",105 ,0)
	8942	;
	8943	"RTN","RCD PEDAR",106 ,0)
	8944	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	8945	"RTN","RCD PEDAR",107 ,0)
	8946	I $D(RCPY RSEL) D
	8947	"RTN","RCD PEDAR",108 ,0)
	8948	. K ^TMP( "RCSELPAY" ,$J)
	8949	"RTN","RCD PEDAR",109 ,0)
	8950	. M ^TMP( "RCSELPAY" ,$J)=RCPYR SEL
	8951	"RTN","RCD PEDAR",110 ,0)
	8952	;
	8953	"RTN","RCD PEDAR",111 ,0)
	8954	S XX=$S(R CLSTMGR:1, 1:0)
	8955	"RTN","RCD PEDAR",112 ,0)
	8956	S INPUT=X X_"^"_RCLS TMGR_"^"_+ RCDET
	8957	"RTN","RCD PEDAR",113 ,0)
	8958	S RCNP=+R CNP,RCJOB= $J
	8959	"RTN","RCD PEDAR",114 ,0)
	8960	K ^TMP("R CDAILYACT" ,$J)
	8961	"RTN","RCD PEDAR",115 ,0)
	8962	K ^TMP($J ,"TOTALS") ; Init ialize Tot als temp w orkspace
	8963	"RTN","RCD PEDAR",116 ,0)
	8964	;
	8965	"RTN","RCD PEDAR",117 ,0)
	8966	; Loop th rough all of the EDI LOCKBOX D EPOSIT rec ords in th e selected date
	8967	"RTN","RCD PEDAR",118 ,0)
	8968	; range a nd add any that pass the payer and divis ion filter s into ^TM P
	8969	"RTN","RCD PEDAR",119 ,0)
	8970	; by the internal d ate added
	8971	"RTN","RCD PEDAR",120 ,0)
	8972	S DTADD=R CDT1-.0001 ,RCT=0
	8973	"RTN","RCD PEDAR",121 ,0)
	8974	S $P(INPU T,"^",4)=0 ; Curr ent Page N umber
	8975	"RTN","RCD PEDAR",122 ,0)
	8976	S $P(INPU T,"^",5)=0 ; Stop Flag
	8977	"RTN","RCD PEDAR",123 ,0)
	8978	F D Q:' DTADD Q:D TADD>(RCDT 2_".9999") Q:$P(INP UT,"^",5)= 1
	8979	"RTN","RCD PEDAR",124 ,0)
	8980	. S DTADD =$O(^RCY(3 44.3,"AREC DT",DTADD) )
	8981	"RTN","RCD PEDAR",125 ,0)
	8982	. Q:'DTAD D
	8983	"RTN","RCD PEDAR",126 ,0)
	8984	. Q:DTADD >(RCDT2_". 9999")
	8985	"RTN","RCD PEDAR",127 ,0)
	8986	. S IEN34 43=0
	8987	"RTN","RCD PEDAR",128 ,0)
	8988	. F D Q :'IEN3443 Q:$P(INPU T,"^",5)=1
	8989	"RTN","RCD PEDAR",129 ,0)
	8990	. . S IEN 3443=$O(^R CY(344.3," ARECDT",DT ADD,IEN344 3))
	8991	"RTN","RCD PEDAR",130 ,0)
	8992	. . Q:'IE N3443
	8993	"RTN","RCD PEDAR",131 ,0)
	8994	. . S IEN 34431="",R CFLG=0
	8995	"RTN","RCD PEDAR",132 ,0)
	8996	. . F D Q:IEN3443 1=""
	8997	"RTN","RCD PEDAR",133 ,0)
	8998	. . . S I EN34431=$O (^RCY(344. 31,"B",IEN 3443,IEN34 431))
	8999	"RTN","RCD PEDAR",134 ,0)
	9000	. . . Q:I EN34431=""
	9001	"RTN","RCD PEDAR",135 ,0)
	9002	. . . Q:' $$CHKPYR(I EN34431,0, RCJOB,RCNP ) ; Not a selected payer PRC A*4.5(318 added ,RCN P
	9003	"RTN","RCD PEDAR",136 ,0)
	9004	. . . Q:' $$CHKDIV(I EN34431,0, .VAUTD) ; Not a selected station/d ivision
	9005	"RTN","RCD PEDAR",137 ,0)
	9006	. . . S R CFLG=1
	9007	"RTN","RCD PEDAR",138 ,0)
	9008	. . . S ^ TMP("RCDAI LYACT",$J, DTADD\1,IE N3443,"EFT ",IEN34431 )=""
	9009	"RTN","RCD PEDAR",139 ,0)
	9010	. . ;
	9011	"RTN","RCD PEDAR",140 ,0)
	9012	. . S:RCF LG ^TMP("R CDAILYACT" ,$J,DTADD\ 1,IEN3443) =""
	9013	"RTN","RCD PEDAR",141 ,0)
	9014	. . S RCT =RCT+1 ; Curr ent Record Count
	9015	"RTN","RCD PEDAR",142 ,0)
	9016	. . ;
	9017	"RTN","RCD PEDAR",143 ,0)
	9018	. . ; Che ck for use r stopped every 100 records
	9019	"RTN","RCD PEDAR",144 ,0)
	9020	. . I '(R CT#100),$D (ZTQUEUED) ,$$S^%ZTLO AD D Q
	9021	"RTN","RCD PEDAR",145 ,0)
	9022	. . . S Z TSTOP=1
	9023	"RTN","RCD PEDAR",146 ,0)
	9024	. . . S $ P(INPUT,"^ ",5)=1 ; Stop now
	9025	"RTN","RCD PEDAR",147 ,0)
	9026	. . . K Z TREQ
	9027	"RTN","RCD PEDAR",148 ,0)
	9028	;
	9029	"RTN","RCD PEDAR",149 ,0)
	9030	I '$P(INP UT,"^",5) D
	9031	"RTN","RCD PEDAR",150 ,0)
	9032	. S $P(IN PUT,"^",6) =RCDT1 ; Star t of Date Range
	9033	"RTN","RCD PEDAR",151 ,0)
	9034	. S $P(IN PUT,"^",7) =RCDT2 ; End of Date Ra nge
	9035	"RTN","RCD PEDAR",152 ,0)
	9036	. D RPT1( .INPUT)
	9037	"RTN","RCD PEDAR",153 ,0)
	9038	D ENQ(INP UT)
	9039	"RTN","RCD PEDAR",154 ,0)
	9040	Q
	9041	"RTN","RCD PEDAR",155 ,0)
	9042	;
	9043	"RTN","RCD PEDAR",156 ,0)
	9044	ENQ(INPUT) ; Clean u p
	9045	"RTN","RCD PEDAR",157 ,0)
	9046	; Input: INPUT - A1^A 2^A3^...^A 8 Where:
	9047	"RTN","RCD PEDAR",158 ,0)
	9048	; A1 - 1 if Det ail report , 0 if sum mary repor t
	9049	"RTN","RCD PEDAR",159 ,0)
	9050	; A2 - 1 if dis playing to Listman, 0 otherwis e
	9051	"RTN","RCD PEDAR",160 ,0)
	9052	; A3 - 0 if NOT called fr om Nightly Process, 1 otherwis e
	9053	"RTN","RCD PEDAR",161 ,0)
	9054	; A4 - Current Page Numbe r
	9055	"RTN","RCD PEDAR",162 ,0)
	9056	; A5 - Stop Fla g
	9057	"RTN","RCD PEDAR",163 ,0)
	9058	; A6 - Start of Date Rang e
	9059	"RTN","RCD PEDAR",164 ,0)
	9060	; A7 - End of D ate Range
	9061	"RTN","RCD PEDAR",165 ,0)
	9062	; ZTQUEUED - Defi ned if Joh was queue d
	9063	"RTN","RCD PEDAR",166 ,0)
	9064	; Output: ZTREQ - "@" Only retur ned if ZTQ UEUED is d efined
	9065	"RTN","RCD PEDAR",167 ,0)
	9066	N XX,YY,Z Z
	9067	"RTN","RCD PEDAR",168 ,0)
	9068	K ^TMP("R CDAILYACT" ,$J),^TMP( "RCSELPAY" ,$J)
	9069	"RTN","RCD PEDAR",169 ,0)
	9070	K ^TMP($J ,"TOTALS")
	9071	"RTN","RCD PEDAR",170 ,0)
	9072	I '$D(ZTQ UEUED) D
	9073	"RTN","RCD PEDAR",171 ,0)
	9074	. D ^%ZIS C
	9075	"RTN","RCD PEDAR",172 ,0)
	9076	. S XX=$P (INPUT,"^" ,1) ; Nigh tly Proces s Flag
	9077	"RTN","RCD PEDAR",173 ,0)
	9078	. S YY=$P (INPUT,"^" ,5) ; Stop Flag
	9079	"RTN","RCD PEDAR",174 ,0)
	9080	. S ZZ=$P (INPUT,"^" ,4) ; Curr ent Page N umber
	9081	"RTN","RCD PEDAR",175 ,0)
	9082	. I 'XX,' YY,ZZ D
	9083	"RTN","RCD PEDAR",176 ,0)
	9084	. . S XX= ""
	9085	"RTN","RCD PEDAR",177 ,0)
	9086	. . D ASK ^RCDPEARL( .XX)
	9087	"RTN","RCD PEDAR",178 ,0)
	9088	I $D(ZTQU EUED) S ZT REQ="@"
	9089	"RTN","RCD PEDAR",179 ,0)
	9090	Q
	9091	"RTN","RCD PEDAR",180 ,0)
	9092	;
	9093	"RTN","RCD PEDAR",181 ,0)
	9094	RPT1(INPUT ) ;EP from RCDPEM1 ( Nightly Pr ocess)
	9095	"RTN","RCD PEDAR",182 ,0)
	9096	; Output the report
	9097	"RTN","RCD PEDAR",183 ,0)
	9098	; Input: INPUT - A1^A 2^A3^...^A n Where:
	9099	"RTN","RCD PEDAR",184 ,0)
	9100	; A1 - 1 if cal led from N ightly Pro cess, 0 ot herwise
	9101	"RTN","RCD PEDAR",185 ,0)
	9102	; A2 - 1 if dis playing to Listman, 0 otherwis e
	9103	"RTN","RCD PEDAR",186 ,0)
	9104	; A4 - Current Page Numbe r
	9105	"RTN","RCD PEDAR",187 ,0)
	9106	; A5 - Stop Fla g
	9107	"RTN","RCD PEDAR",188 ,0)
	9108	; A6 - Start of Date Rang e
	9109	"RTN","RCD PEDAR",189 ,0)
	9110	; A7 - End of D ate Range
	9111	"RTN","RCD PEDAR",190 ,0)
	9112	; ^TMP(B1, $J,B2,B3) = "" - Arra y of recor d IENs in 344.3 in d ate range
	9113	"RTN","RCD PEDAR",191 ,0)
	9114	; and for select ed payer(s ) and divi sion(s)
	9115	"RTN","RCD PEDAR",192 ,0)
	9116	; ^TMP(B1, $J,B2,B3," EFT",B4) = "" - Arra y of recor d IENS in 344.31 for above Whe re:
	9117	"RTN","RCD PEDAR",193 ,0)
	9118	; B1 - "RCDAILYA CT"
	9119	"RTN","RCD PEDAR",194 ,0)
	9120	; B2 - Internal Date from DATE/TIME ADDED (344 .3, .13)
	9121	"RTN","RCD PEDAR",195 ,0)
	9122	; B3 - Internal IEN for 34 4.3
	9123	"RTN","RCD PEDAR",196 ,0)
	9124	; B4 - Internal IEN for fi le 344.31
	9125	"RTN","RCD PEDAR",197 ,0)
	9126	; Output: INPUT - A1^A 2^A3^...^A n - The fo llowing pi eces may b e updated
	9127	"RTN","RCD PEDAR",198 ,0)
	9128	; A4 - Current Page Numbe r
	9129	"RTN","RCD PEDAR",199 ,0)
	9130	; A5 - Stop Fla g
	9131	"RTN","RCD PEDAR",200 ,0)
	9132	;
	9133	"RTN","RCD PEDAR",201 ,0)
	9134	N CURPG,D ETL,DTADD, DTEND,DTST ,HDR1,LSTM AN,NJ
	9135	"RTN","RCD PEDAR",202 ,0)
	9136	S DETL=$P (INPUT,"^" ,3) ; Deta il Report flag
	9137	"RTN","RCD PEDAR",203 ,0)
	9138	S LSTMAN= $P(INPUT," ^",2) ; List man flag
	9139	"RTN","RCD PEDAR",204 ,0)
	9140	S NJ=$P(I NPUT,"^",1 ) ; Nigh tly Proces s flag
	9141	"RTN","RCD PEDAR",205 ,0)
	9142	S CURPG=$ P(INPUT,"^ ",4) ; Curr ent Page N umber
	9143	"RTN","RCD PEDAR",206 ,0)
	9144	S DTST=$P (INPUT,"^" ,6) ; Date Range Sta rt
	9145	"RTN","RCD PEDAR",207 ,0)
	9146	S DTEND=$ P(INPUT,"^ ",7) ; Date Range End
	9147	"RTN","RCD PEDAR",208 ,0)
	9148	S $P(INPU T,"^",8)=0 ; Curr ent line c ounter
	9149	"RTN","RCD PEDAR",209 ,0)
	9150	S DTADD=" "
	9151	"RTN","RCD PEDAR",210 ,0)
	9152	F D Q:D TADD="" Q :$P(INPUT, "^",5)=1
	9153	"RTN","RCD PEDAR",211 ,0)
	9154	. S DTADD =$O(^TMP(" RCDAILYACT ",$J,DTADD ))
	9155	"RTN","RCD PEDAR",212 ,0)
	9156	. Q:DTADD =""
	9157	"RTN","RCD PEDAR",213 ,0)
	9158	. ;
	9159	"RTN","RCD PEDAR",214 ,0)
	9160	. ; If no t being di splayed in the list manager an d either t his is the initial
	9161	"RTN","RCD PEDAR",215 ,0)
	9162	. ; page header (RC PG=0) OR t his wasn't called by the night ly job and we have
	9163	"RTN","RCD PEDAR",216 ,0)
	9164	. ; reach ed the end of the pa ge, then p rint a pag e header
	9165	"RTN","RCD PEDAR",217 ,0)
	9166	. I 'LSTM AN,'CURPG! $S('NJ:($Y +5)>IOSL,1 :0) D Q:$ P(INPUT,"^ ",5)=1
	9167	"RTN","RCD PEDAR",218 ,0)
	9168	. . D HDR ^RCDPEDA3( .INPUT)
	9169	"RTN","RCD PEDAR",219 ,0)
	9170	. S HDR1= "DATE EFT DEPOSIT RE CEIVED: "_ $$FMTE^XLF DT(DTADD," 2Z")
	9171	"RTN","RCD PEDAR",220 ,0)
	9172	. S HDR1= $J("",80-$ L(HDR1)\2) _HDR1 ; Cent er it
	9173	"RTN","RCD PEDAR",221 ,0)
	9174	. Q:$P(IN PUT,"^",5) =1 ; User quit
	9175	"RTN","RCD PEDAR",222 ,0)
	9176	. I DETL D ; Deta il Report
	9177	"RTN","RCD PEDAR",223 ,0)
	9178	. . D SL^ RCDPEDA3(. INPUT,HDR1 )
	9179	"RTN","RCD PEDAR",224 ,0)
	9180	. . D SL^ RCDPEDA3(. INPUT," ")
	9181	"RTN","RCD PEDAR",225 ,0)
	9182	. S $P(IN PUT,"^",9) =DTADD
	9183	"RTN","RCD PEDAR",226 ,0)
	9184	. D RPT2^ RCDPEDA2(. INPUT) ; Proc ess all 34 4.3 record s found
	9185	"RTN","RCD PEDAR",227 ,0)
	9186	. Q:$P(IN PUT,"^",5) =1 ; User quit
	9187	"RTN","RCD PEDAR",228 ,0)
	9188	. D TOTSD AY^RCDPEDA 3(.INPUT) ; Displ ay Totals for Date
	9189	"RTN","RCD PEDAR",229 ,0)
	9190	;
	9191	"RTN","RCD PEDAR",230 ,0)
	9192	Q:$P(INPU T,"^",5)=1 ; User quit
	9193	"RTN","RCD PEDAR",231 ,0)
	9194	D TOTSF^R CDPEDA3(.I NPUT) ; Displ ay Final T otals
	9195	"RTN","RCD PEDAR",232 ,0)
	9196	D SL^RCDP EDA3(.INPU T,$$ENDORP RT^RCDPEAR L) ; Displ ay End of Report
	9197	"RTN","RCD PEDAR",233 ,0)
	9198	Q
	9199	"RTN","RCD PEDAR",234 ,0)
	9200	;
	9201	"RTN","RCD PEDAR",235 ,0)
	9202	CHKPYR(IEN ,FLG,RCJOB ,RCNP) ;EP from RCDP EAR2 PRCA* 4.5*318 ad ded RCNP p arameter
	9203	"RTN","RCD PEDAR",236 ,0)
	9204	; Checks to be sure the speci fied payer has been selected
	9205	"RTN","RCD PEDAR",237 ,0)
	9206	; Input: IEN - Internal IEN into file 344.3 1 (EDI THI RD PARTY E FT DETAI) OR
	9207	"RTN","RCD PEDAR",238 ,0)
	9208	; file 344.4 (ELECTRO NIC REMITT ANCE ADVIC E)
	9209	"RTN","RCD PEDAR",239 ,0)
	9210	; Used to retrieve t he payer
	9211	"RTN","RCD PEDAR",240 ,0)
	9212	; FLG - 0 if IEN contains ien in fil e 344.31
	9213	"RTN","RCD PEDAR",241 ,0)
	9214	; 1 if IEN contains ien in fil e 344.4
	9215	"RTN","RCD PEDAR",242 ,0)
	9216	; RCJOB - $J
	9217	"RTN","RCD PEDAR",243 ,0)
	9218	; RCNP - 0 - Not passed
	9219	"RTN","RCD PEDAR",244 ,0)
	9220	; 1 - Rang e of Payer s
	9221	"RTN","RCD PEDAR",245 ,0)
	9222	; 2 - All Payers sel ected
	9223	"RTN","RCD PEDAR",246 ,0)
	9224	; 3 - Spec ific payer s
	9225	"RTN","RCD PEDAR",247 ,0)
	9226	; Optional , defaults to 0
	9227	"RTN","RCD PEDAR",248 ,0)
	9228	; ^TMP("RC SELPAY",$J ,CNT)=A1 W here:
	9229	"RTN","RCD PEDAR",249 ,0)
	9230	; CNT - Counter of the nu mber of pa yers 1-n
	9231	"RTN","RCD PEDAR",250 ,0)
	9232	; A1 - Payer N ame
	9233	"RTN","RCD PEDAR",251 ,0)
	9234	; Returns : 1 if pay er in 344. 31/.02 or 344.4/.06 is in the list of se lected pay ers
	9235	"RTN","RCD PEDAR",252 ,0)
	9236	; ^TMP(" RCSELPAY", $J)
	9237	"RTN","RCD PEDAR",253 ,0)
	9238	; 0 otherw ise
	9239	"RTN","RCD PEDAR",254 ,0)
	9240	N RCPAY,R ES,Z
	9241	"RTN","RCD PEDAR",255 ,0)
	9242	S:'$D(RCN P) RCNP=0 ; PRCA4 .5318 add ed line
	9243	"RTN","RCD PEDAR",256 ,0)
	9244	S RCPAY=" "
	9245	"RTN","RCD PEDAR",257 ,0)
	9246	I IEN D
	9247	"RTN","RCD PEDAR",258 ,0)
	9248	. I FLG S RCPAY=$$G ET1^DIQ(34 4.4,IEN,.0 6,"I") Q ; PAYMEN T FROM fie ld
	9249	"RTN","RCD PEDAR",259 ,0)
	9250	. S RCPAY =$$GET1^DI Q(344.31,I EN,.02,"I" ) ; PAYER NAME field
	9251	"RTN","RCD PEDAR",260 ,0)
	9252	;
	9253	"RTN","RCD PEDAR",261 ,0)
	9254	; Include EFT with null Payer Names in reports fo r ALL paye rs - PRCA* 4.5*298
	9255	"RTN","RCD PEDAR",262 ,0)
	9256	I FLG=0,R CNP=2,RCPA Y="" Q 1
	9257	"RTN","RCD PEDAR",263 ,0)
	9258	Q:RCPAY=" " 0 ; No Pay er to comp are, inval id
	9259	"RTN","RCD PEDAR",264 ,0)
	9260	S Z=0,RES =0
	9261	"RTN","RCD PEDAR",265 ,0)
	9262	F D Q:Z ="" Q:RES
	9263	"RTN","RCD PEDAR",266 ,0)
	9264	. S Z=$O( ^TMP("RCSE LPAY",RCJO B,Z))
	9265	"RTN","RCD PEDAR",267 ,0)
	9266	. Q:Z=""
	9267	"RTN","RCD PEDAR",268 ,0)
	9268	. S:RCPAY =$G(^TMP(" RCSELPAY", RCJOB,Z)) RES=1
	9269	"RTN","RCD PEDAR",269 ,0)
	9270	Q RES
	9271	"RTN","RCD PEDAR",270 ,0)
	9272	;
	9273	"RTN","RCD PEDAR",271 ,0)
	9274	CHKDIV(IEN ,FLG,VAUTD ) ;
	9275	"RTN","RCD PEDAR",272 ,0)
	9276	; IEN - i en in file 344.31 or 344.4
	9277	"RTN","RCD PEDAR",273 ,0)
	9278	; FLG - 0 if IEN co ntains ien in file 3 44.31, 1 i f IEN cont ains ien i n file 344 .4
	9279	"RTN","RCD PEDAR",274 ,0)
	9280	; VAUTD - array of selected d ivisions f rom DIVISI ON^VAUTOMA API call
	9281	"RTN","RCD PEDAR",275 ,0)
	9282	; returns 1 if divi sion assoc iated with an entry in 344.31 is on the list in VA UTD
	9283	"RTN","RCD PEDAR",276 ,0)
	9284	; returns 0 otherwi se
	9285	"RTN","RCD PEDAR",277 ,0)
	9286	N ERA,I,N AME,RCSTA, RES
	9287	"RTN","RCD PEDAR",278 ,0)
	9288	S RES=0
	9289	"RTN","RCD PEDAR",279 ,0)
	9290	I VAUTD=1 S RES=1 G CHKDIVX
	9291	"RTN","RCD PEDAR",280 ,0)
	9292	I 'IEN G CHKDIVX
	9293	"RTN","RCD PEDAR",281 ,0)
	9294	S ERA=$S( FLG:IEN,1: $P($G(^RCY (344.31,IE N,0)),U,10 ))
	9295	"RTN","RCD PEDAR",282 ,0)
	9296	S RCSTA=$ $ERASTA^RC DPEM3(ERA) ,NAME=$P(R CSTA,U)
	9297	"RTN","RCD PEDAR",283 ,0)
	9298	I NAME="U NKNOWN" G CHKDIVX
	9299	"RTN","RCD PEDAR",284 ,0)
	9300	S I=0 I ' VAUTD F S I=$O(VAUT D(I)) Q:'I !RES I NA ME=VAUTD(I ) S RES=1
	9301	"RTN","RCD PEDAR",285 ,0)
	9302	CHKDIVX ;
	9303	"RTN","RCD PEDAR",286 ,0)
	9304	Q RES
	9305	"RTN","RCD PELA1")
	9306	0^30^B1183 91123^n/a
	9307	"RTN","RCD PELA1",1,0 )
	9308	RCDPELA1 ; EDE/FA - L IST ALL AU TO-POSTED RECEIPTS R EPORT ;Nov 17, 2016
	9309	"RTN","RCD PELA1",2,0 )
	9310	;;4.5;Acc ounts Rece ivable;3 18;Mar 2 0, 1995;Bu ild 25
	9311	"RTN","RCD PELA1",3,0 )
	9312	;Per VA D irective 6 402, this routine sh ould not b e modified .
	9313	"RTN","RCD PELA1",4,0 )
	9314	;
	9315	"RTN","RCD PELA1",5,0 )
	9316	Q ; no direct ent ry
	9317	"RTN","RCD PELA1",6,0 )
	9318	;
	9319	"RTN","RCD PELA1",7,0 )
	9320	RPTOUT(INP UT) ; Outp ut the rep ort to pap er/screen, listman o r excel
	9321	"RTN","RCD PELA1",8,0 )
	9322	; Input: INPUT - See REPO RT for a c omplete de scription
	9323	"RTN","RCD PELA1",9,0 )
	9324	; ^TMP($J, A1,"SEL",A 2,A3,A4,A5 )="" - if record pas sed filter s Where:
	9325	"RTN","RCD PELA1",10, 0)
	9326	; A1 - "RCDPE_LAR "
	9327	"RTN","RCD PELA1",11, 0)
	9328	; A2 - Uppercased Payer Nam e (primary sort)
	9329	"RTN","RCD PELA1",12, 0)
	9330	; A3 - Secondary Sort Value
	9331	"RTN","RCD PELA1",13, 0)
	9332	; A4 - Internal I EN for fil e 344.4
	9333	"RTN","RCD PELA1",14, 0)
	9334	; A5 - Internal I EN for fil e 344.41
	9335	"RTN","RCD PELA1",15, 0)
	9336	; Output: ^TMP("RC DPE_LAR",$ J,CTR)=Lin e - Array of display lines (no headers)
	9337	"RTN","RCD PELA1",16, 0)
	9338	; for ou tput to Li stman
	9339	"RTN","RCD PELA1",17, 0)
	9340	; Only s et when A7 -1
	9341	"RTN","RCD PELA1",18, 0)
	9342	;
	9343	"RTN","RCD PELA1",19, 0)
	9344	; ^TMP($J,A 1,"ZERO",A 3,A4)="" - List of E EOBs with zero balan ce Where:
	9345	"RTN","RCD PELA1",20, 0)
	9346	; A1 - "RCDPE_LAR "
	9347	"RTN","RCD PELA1",21, 0)
	9348	; A3 - IEN of #34 4.4 (ERA # )
	9349	"RTN","RCD PELA1",22, 0)
	9350	; A4 - IEN of #34 4.41 (orig inal seque nce #)
	9351	"RTN","RCD PELA1",23, 0)
	9352	;
	9353	"RTN","RCD PELA1",24, 0)
	9354	N A1,DATA ,EXCEL,FIR ST,IEN3444 ,LNCNT,LST MAN
	9355	"RTN","RCD PELA1",25, 0)
	9356	N ONEERA, OUTTYP,PAG E,PAYER,ST OP,SVAL
	9357	"RTN","RCD PELA1",26, 0)
	9358	S (LNCNT, PAGE)=0 ; Init ialize Lin e/Page cou nters
	9359	"RTN","RCD PELA1",27, 0)
	9360	S $P(INPU T,"^",9)=0 ; Line Counter f or Listman output
	9361	"RTN","RCD PELA1",28, 0)
	9362	S EXCEL=$ P(INPUT,"^ ",8)
	9363	"RTN","RCD PELA1",29, 0)
	9364	S LSTMAN= $P(INPUT," ^",7)
	9365	"RTN","RCD PELA1",30, 0)
	9366	S DATA=0
	9367	"RTN","RCD PELA1",31, 0)
	9368	S OUTYPE= $S(EXCEL:2 ,LSTMAN:1, 1:0)
	9369	"RTN","RCD PELA1",32, 0)
	9370	I OUTYPE= 2 D ; Exce l Ouput
	9371	"RTN","RCD PELA1",33, 0)
	9372	. S XX="P ayer^ERA^D ate Receiv ed^Date Po sted^Recei pt^Trace # "
	9373	"RTN","RCD PELA1",34, 0)
	9374	. S XX=XX _"^Receipt Total^ERA Total^Mis sing Recei pts^User^A mount^FMS Doc #"
	9375	"RTN","RCD PELA1",35, 0)
	9376	. W !,XX
	9377	"RTN","RCD PELA1",36, 0)
	9378	. ;
	9379	"RTN","RCD PELA1",37, 0)
	9380	S A1="RCD PE_LAR",PA YER="",STO P=0
	9381	"RTN","RCD PELA1",38, 0)
	9382	S FIRST=$ O(^TMP($J, A1,"SEL"," ")) ; Firs t payer on the repor t
	9383	"RTN","RCD PELA1",39, 0)
	9384	F D Q:P AYER="" Q :STOP
	9385	"RTN","RCD PELA1",40, 0)
	9386	. S PAYER =$O(^TMP($ J,A1,"SEL" ,PAYER))
	9387	"RTN","RCD PELA1",41, 0)
	9388	. Q:PAYER =""
	9389	"RTN","RCD PELA1",42, 0)
	9390	. S DATA= 1 ; foun d data
	9391	"RTN","RCD PELA1",43, 0)
	9392	. ;
	9393	"RTN","RCD PELA1",44, 0)
	9394	. I OUTYP E=1 D ; List man Output
	9395	"RTN","RCD PELA1",45, 0)
	9396	. . S XX= $P(INPUT," ^",9)+1
	9397	"RTN","RCD PELA1",46, 0)
	9398	. . S $P( INPUT,"^", 9)=XX
	9399	"RTN","RCD PELA1",47, 0)
	9400	. . S ^TM P(A1,$J,XX )=PAYER
	9401	"RTN","RCD PELA1",48, 0)
	9402	. ;
	9403	"RTN","RCD PELA1",49, 0)
	9404	. I OUTYP E=0 D Q:S TOP ; Pape r/Screen o utput
	9405	"RTN","RCD PELA1",50, 0)
	9406	. . S:PAG E>1!(PAYER '=FIRST) S TOP=$$ASKS TOP^RCDPEL AR()
	9407	"RTN","RCD PELA1",51, 0)
	9408	. . Q:STO P
	9409	"RTN","RCD PELA1",52, 0)
	9410	. . S LNC NT=0
	9411	"RTN","RCD PELA1",53, 0)
	9412	. . D HEA DER(INPUT, .LNCNT,.PA GE)
	9413	"RTN","RCD PELA1",54, 0)
	9414	. . D:'EX CEL ERAHDR (PAYER,.LN CNT,PAGE)
	9415	"RTN","RCD PELA1",55, 0)
	9416	. S SVAL= ""
	9417	"RTN","RCD PELA1",56, 0)
	9418	. F D Q :SVAL="" Q:STOP
	9419	"RTN","RCD PELA1",57, 0)
	9420	. . S SVA L=$O(^TMP( $J,A1,"SEL ",PAYER,SV AL))
	9421	"RTN","RCD PELA1",58, 0)
	9422	. . Q:SVA L=""
	9423	"RTN","RCD PELA1",59, 0)
	9424	. . S IEN 3444=""
	9425	"RTN","RCD PELA1",60, 0)
	9426	. . F D Q:IEN3444 ="" Q:STO P
	9427	"RTN","RCD PELA1",61, 0)
	9428	. . . S I EN3444=$O( ^TMP($J,A1 ,"SEL",PAY ER,SVAL,IE N3444))
	9429	"RTN","RCD PELA1",62, 0)
	9430	. . . Q:I EN3444=""
	9431	"RTN","RCD PELA1",63, 0)
	9432	. . . D Z EROBAL(IEN 3444) ; d etermine w hich IEN34 441 lines are zero b alance
	9433	"RTN","RCD PELA1",64, 0)
	9434	. . . K O NEERA
	9435	"RTN","RCD PELA1",65, 0)
	9436	. . . S X X=$$GET1^D IQ(344.4,I EN3444,.05 ,"I") ; To tal Amount Paid
	9437	"RTN","RCD PELA1",66, 0)
	9438	. . . S X X=$J(XX,12 ,2)
	9439	"RTN","RCD PELA1",67, 0)
	9440	. . . S O NEERA="0^" _XX_"^0^0" ; In itial ERA values
	9441	"RTN","RCD PELA1",68, 0)
	9442	. . . S I EN34441=""
	9443	"RTN","RCD PELA1",69, 0)
	9444	. . . F D Q:IEN34 441="" Q: STOP
	9445	"RTN","RCD PELA1",70, 0)
	9446	. . . . S IEN34441= $O(^TMP($J ,A1,"SEL", PAYER,SVAL ,IEN3444,I EN34441))
	9447	"RTN","RCD PELA1",71, 0)
	9448	. . . . Q :IEN34441= ""
	9449	"RTN","RCD PELA1",72, 0)
	9450	. . . . ;
	9451	"RTN","RCD PELA1",73, 0)
	9452	. . . . Q :$D(^TMP($ J,A1,"ZERO ",IEN3444, IEN34441)) ; elimin ates rever sals
	9453	"RTN","RCD PELA1",74, 0)
	9454	. . . . ;
	9455	"RTN","RCD PELA1",75, 0)
	9456	. . . . ; Get all t he detail lines need ed to outp ut one ERA record
	9457	"RTN","RCD PELA1",76, 0)
	9458	. . . . D ONEDLN(OU TYPE,IEN34 44,IEN3444 1,.ONEERA)
	9459	"RTN","RCD PELA1",77, 0)
	9460	. . . D A DDERAH(OUT YPE,.ONEER A,IEN3444) ; Ad d the ERA Header lin es
	9461	"RTN","RCD PELA1",78, 0)
	9462	. . . ;
	9463	"RTN","RCD PELA1",79, 0)
	9464	. . . ; O utput all the lines for one ER A
	9465	"RTN","RCD PELA1",80, 0)
	9466	. . . S S TOP=$$OUTE RA(.INPUT, OUTYPE,PAY ER,.ONEERA ,.LNCNT,.P AGE)
	9467	"RTN","RCD PELA1",81, 0)
	9468	I 'DATA,' EXCEL,'LST MAN D
	9469	"RTN","RCD PELA1",82, 0)
	9470	. D HEADE R(INPUT,.L NCNT,.PAGE )
	9471	"RTN","RCD PELA1",83, 0)
	9472	. D ERAHD R(PAYER,.L NCNT,PAGE)
	9473	"RTN","RCD PELA1",84, 0)
	9474	I 'EXCEL D
	9475	"RTN","RCD PELA1",85, 0)
	9476	. S XX=$$ ENDORPRT^R CDPEARL
	9477	"RTN","RCD PELA1",86, 0)
	9478	. I OUTYP E=1 D Q
	9479	"RTN","RCD PELA1",87, 0)
	9480	. . S YY= $P(INPUT," ^",9)+1
	9481	"RTN","RCD PELA1",88, 0)
	9482	. . S $P( INPUT,"^", 9)=YY
	9483	"RTN","RCD PELA1",89, 0)
	9484	. . S ^TM P(A1,$J,YY )=XX
	9485	"RTN","RCD PELA1",90, 0)
	9486	. W !,XX
	9487	"RTN","RCD PELA1",91, 0)
	9488	. I 'STOP S STOP=$$ ASKSTOP^RC DPELAR()
	9489	"RTN","RCD PELA1",92, 0)
	9490	. Q:STOP
	9491	"RTN","RCD PELA1",93, 0)
	9492	Q
	9493	"RTN","RCD PELA1",94, 0)
	9494	;
	9495	"RTN","RCD PELA1",95, 0)
	9496	ZEROBAL(IE N3444) ; Is it a zero value EEOB
	9497	"RTN","RCD PELA1",96, 0)
	9498	; Those E EOB with r eversals w ill have a zero valu e. This b uilds
	9499	"RTN","RCD PELA1",97, 0)
	9500	; an arra y of them.
	9501	"RTN","RCD PELA1",98, 0)
	9502	; Input: IEN3444 - Inte rnal IEN f or file 34 4.4
	9503	"RTN","RCD PELA1",99, 0)
	9504	; Output:
	9505	"RTN","RCD PELA1",100 ,0)
	9506	; ^TMP($J,A 1,"ZERO",A 3,A4)="" - List of E EOBs with zero balan ce Where:
	9507	"RTN","RCD PELA1",101 ,0)
	9508	; A1 - "RCDPE_LAR "
	9509	"RTN","RCD PELA1",102 ,0)
	9510	; A3 - IEN of #34 4.4 (ERA # )
	9511	"RTN","RCD PELA1",103 ,0)
	9512	; A4 - IEN of #34 4.41 (orig inal seque nce #)
	9513	"RTN","RCD PELA1",104 ,0)
	9514	;
	9515	"RTN","RCD PELA1",105 ,0)
	9516	N A1,A2,A MTPOST,IEN S,ORIGSEQ, RCSEQ,RCDA 1,XX
	9517	"RTN","RCD PELA1",106 ,0)
	9518	K ^TMP($J ,"RCDPE_LA R","ZERO", IEN3444)
	9519	"RTN","RCD PELA1",107 ,0)
	9520	;
	9521	"RTN","RCD PELA1",108 ,0)
	9522	S A1="RCD PE_LAR",A2 ="ZERO"
	9523	"RTN","RCD PELA1",109 ,0)
	9524	S RCSEQ=0
	9525	"RTN","RCD PELA1",110 ,0)
	9526	F S RCSE Q=$O(^RCY( 344.49,IEN 3444,1,"B" ,RCSEQ)) Q :'RCSEQ D
	9527	"RTN","RCD PELA1",111 ,0)
	9528	. Q:RCSEQ #1'=0
	9529	"RTN","RCD PELA1",112 ,0)
	9530	. S RCDA1 =+$O(^RCY( 344.49,IEN 3444,1,"B" ,RCSEQ,0))
	9531	"RTN","RCD PELA1",113 ,0)
	9532	. Q:'RCDA 1
	9533	"RTN","RCD PELA1",114 ,0)
	9534	. S IENS= RCDA1_","_ IEN3444_", "
	9535	"RTN","RCD PELA1",115 ,0)
	9536	. S AMTPO ST=$$GET1^ DIQ(344.49 1,IENS,.03 ,"I") ; A mount to p ost on rec eipt
	9537	"RTN","RCD PELA1",116 ,0)
	9538	. I AMTPO ST>0 Q ; N ot zero va lue line
	9539	"RTN","RCD PELA1",117 ,0)
	9540	. S ORIGS EQ=$$GET1^ DIQ(344.49 1,IENS,.09 ,"I") ; l ist of ori ginal seq #s with ze ro balance
	9541	"RTN","RCD PELA1",118 ,0)
	9542	. S XX=0
	9543	"RTN","RCD PELA1",119 ,0)
	9544	. F XX=1: 1 Q:$P(ORI GSEQ,",",X X)="" S ^ TMP($J,A1, A2,IEN3444 ,($P(ORIGS EQ,",",XX) ))=""
	9545	"RTN","RCD PELA1",120 ,0)
	9546	Q
	9547	"RTN","RCD PELA1",121 ,0)
	9548	;
	9549	"RTN","RCD PELA1",122 ,0)
	9550	ONEDLN(OUT YPE,IEN344 4,IEN34441 ,ONEERA) ; Gather al l of the E RA Detail lines to d isplay
	9551	"RTN","RCD PELA1",123 ,0)
	9552	; one ERA record
	9553	"RTN","RCD PELA1",124 ,0)
	9554	; Input: OUTYPE - O - Output to Screen or paper
	9555	"RTN","RCD PELA1",125 ,0)
	9556	; 1 - Output to Listman
	9557	"RTN","RCD PELA1",126 ,0)
	9558	; 2 - Output to Excel
	9559	"RTN","RCD PELA1",127 ,0)
	9560	; IEN3444 - Inte rnal IEN f or file 34 4.4
	9561	"RTN","RCD PELA1",128 ,0)
	9562	; IEN34441 - Inte rnal IEN f or sub fil e 344.41 o f the ERA detail
	9563	"RTN","RCD PELA1",129 ,0)
	9564	; line being pro cessed
	9565	"RTN","RCD PELA1",130 ,0)
	9566	; ONEERA - A1^A 2^A3^A4 Wh ere:
	9567	"RTN","RCD PELA1",131 ,0)
	9568	; A1 - Current Number of lines in t he ERA dis play
	9569	"RTN","RCD PELA1",132 ,0)
	9570	; A2 - ERA Tota l for the ERA (forma tted)
	9571	"RTN","RCD PELA1",133 ,0)
	9572	; A3 - Current Receipt To tal for th e ERA (for matted)
	9573	"RTN","RCD PELA1",134 ,0)
	9574	; A4 - 1 if ERA contains at least o ne detail record
	9575	"RTN","RCD PELA1",135 ,0)
	9576	; with a missing r eceipt.
	9577	"RTN","RCD PELA1",136 ,0)
	9578	; 0 otherw ise
	9579	"RTN","RCD PELA1",137 ,0)
	9580	; ONEERA(L N)=A4- Whe re
	9581	"RTN","RCD PELA1",138 ,0)
	9582	; LN - Line num ber for ER A Display
	9583	"RTN","RCD PELA1",139 ,0)
	9584	; A4 - Actual d isplay lin e
	9585	"RTN","RCD PELA1",140 ,0)
	9586	; Ouput: ONEERA - A1^A2 ^A3^A4 Whe re:
	9587	"RTN","RCD PELA1",141 ,0)
	9588	; A1 - Updated Number of lines in t he ERA dis play
	9589	"RTN","RCD PELA1",142 ,0)
	9590	; A2 - ERA Tota l for the ERA (forma tted)
	9591	"RTN","RCD PELA1",143 ,0)
	9592	; A3 - Updated Receipt To tal for th e ERA (for matted)
	9593	"RTN","RCD PELA1",144 ,0)
	9594	; A4 - 1 if ERA contains at least o ne detail record
	9595	"RTN","RCD PELA1",145 ,0)
	9596	; with a missing r eceipt.
	9597	"RTN","RCD PELA1",146 ,0)
	9598	; 0 otherw ise
	9599	"RTN","RCD PELA1",147 ,0)
	9600	; ONEERA(L N)=A4- Whe re
	9601	"RTN","RCD PELA1",148 ,0)
	9602	; LN - Line num ber for ER A Display
	9603	"RTN","RCD PELA1",149 ,0)
	9604	; A4 - Actual d isplay lin e
	9605	"RTN","RCD PELA1",150 ,0)
	9606	N AMT,DTP OST,DTREC, LCNT,IENS, LN,PAYER,R ECEIPT,TRD OC,USER,XX ,YY
	9607	"RTN","RCD PELA1",151 ,0)
	9608	S IENS=IE N34441_"," _IEN3444_" ,"
	9609	"RTN","RCD PELA1",152 ,0)
	9610	S LCNT=$P (ONEERA,"^ ",1)+1
	9611	"RTN","RCD PELA1",153 ,0)
	9612	S $P(ONEE RA,"^",1)= LCNT ; ERA Line count er
	9613	"RTN","RCD PELA1",154 ,0)
	9614	;
	9615	"RTN","RCD PELA1",155 ,0)
	9616	; Build d etail line for ERA D etail reco rd being p rocess
	9617	"RTN","RCD PELA1",156 ,0)
	9618	S XX=$$GE T1^DIQ(344 .4,IEN3444 ,.07,"I") ; ERA Date Recei ved
	9619	"RTN","RCD PELA1",157 ,0)
	9620	S DTREC=$ $FMTE^XLFD T(XX,"2DZ" )
	9621	"RTN","RCD PELA1",158 ,0)
	9622	S XX=$$GE T1^DIQ(344 .41,IENS,9 ,"I") ; Auto -Post Date
	9623	"RTN","RCD PELA1",159 ,0)
	9624	S DTPOST= $$FMTE^XLF DT(XX,"2DZ ")
	9625	"RTN","RCD PELA1",160 ,0)
	9626	S XX=$$GE T1^DIQ(344 .41,IENS,. 25,"I") ; Rece ipt Pointe r
	9627	"RTN","RCD PELA1",161 ,0)
	9628	S RECEIPT =$$GET1^DI Q(344,XX,. 01,"I") ; Rece ipt Number
	9629	"RTN","RCD PELA1",162 ,0)
	9630	S TRDOC=$ $GET1^DIQ( 344,XX,200 ,"I") ; FMS Document #
	9631	"RTN","RCD PELA1",163 ,0)
	9632	I RECEIPT ="" D
	9633	"RTN","RCD PELA1",164 ,0)
	9634	. S $P(ON EERA,"^",4 )=1
	9635	"RTN","RCD PELA1",165 ,0)
	9636	. S RECEI PT="* Miss ing *"
	9637	"RTN","RCD PELA1",166 ,0)
	9638	S XX=$O(^ RCY(344.72 ,"E",IEN34 44,"")) ; IEN of the Aut o-Post Aud it File en try
	9639	"RTN","RCD PELA1",167 ,0)
	9640	S USER=$$ GET1^DIQ(3 44.72,XX,. 02,"I") ; User IEN who m arked for Auto-Post
	9641	"RTN","RCD PELA1",168 ,0)
	9642	S USER=$$ GET1^DIQ(2 00,USER,1, "I") ; Init ials of Us er who mar ked for Au to-Post
	9643	"RTN","RCD PELA1",169 ,0)
	9644	S AMT=$$G ET1^DIQ(34 4.41,IENS, .03,"I") ; Amou nt Paid
	9645	"RTN","RCD PELA1",170 ,0)
	9646	I RECEIPT '="* Missi ng *" D
	9647	"RTN","RCD PELA1",171 ,0)
	9648	. S YY=$P (ONEERA,"^ ",3) ; Curr ent Receip t Total
	9649	"RTN","RCD PELA1",172 ,0)
	9650	. S $P(ON EERA,"^",3 )=AMT+YY ; Upda ted Receip t Total
	9651	"RTN","RCD PELA1",173 ,0)
	9652	S AMT=$J( AMT,12,2) ; Form atted Paid
	9653	"RTN","RCD PELA1",174 ,0)
	9654	I OUTYPE= 2 D Q ; Outp ut to Exce l
	9655	"RTN","RCD PELA1",175 ,0)
	9656	. S LN=$$ GET1^DIQ(3 44.4,IEN34 44,.06,"I" ) ; Paym ent From
	9657	"RTN","RCD PELA1",176 ,0)
	9658	. S LN=LN _"^"_IEN34 44_"^"_DTR EC_"^"_DTP OST_"^"_RE CEIPT
	9659	"RTN","RCD PELA1",177 ,0)
	9660	. S $P(LN ,"^",10)=U SER
	9661	"RTN","RCD PELA1",178 ,0)
	9662	. S $P(LN ,"^",11)=A MT
	9663	"RTN","RCD PELA1",179 ,0)
	9664	. S $P(LN ,"^",12)=T RDOC
	9665	"RTN","RCD PELA1",180 ,0)
	9666	. S ONEER A(LCNT)=LN
	9667	"RTN","RCD PELA1",181 ,0)
	9668	;
	9669	"RTN","RCD PELA1",182 ,0)
	9670	S LN=" "
	9671	"RTN","RCD PELA1",183 ,0)
	9672	S LN=$$SE TSTR^VALM1 (DTREC,LN, 9,10)
	9673	"RTN","RCD PELA1",184 ,0)
	9674	S LN=$$SE TSTR^VALM1 (DTPOST,LN ,19,10)
	9675	"RTN","RCD PELA1",185 ,0)
	9676	S LN=$$SE TSTR^VALM1 (RECEIPT,L N,30,$L(RE CEIPT))
	9677	"RTN","RCD PELA1",186 ,0)
	9678	S LN=$$SE TSTR^VALM1 (USER,LN,4 3,$L(USER) )
	9679	"RTN","RCD PELA1",187 ,0)
	9680	S LN=$$SE TSTR^VALM1 (AMT,LN,50 ,$L(AMT))
	9681	"RTN","RCD PELA1",188 ,0)
	9682	S LN=$$SE TSTR^VALM1 (TRDOC,LN, 65,$L(TRDO C))
	9683	"RTN","RCD PELA1",189 ,0)
	9684	S ONEERA( LCNT)=LN
	9685	"RTN","RCD PELA1",190 ,0)
	9686	Q
	9687	"RTN","RCD PELA1",191 ,0)
	9688	;
	9689	"RTN","RCD PELA1",192 ,0)
	9690	ADDERAH(OU TYPE,ONEER A,IEN3444) ; Add the header li nes to ERA output ar ray
	9691	"RTN","RCD PELA1",193 ,0)
	9692	; Input: OUTYPE - O - Output to Screen or paper
	9693	"RTN","RCD PELA1",194 ,0)
	9694	; 1 - Output to Listman
	9695	"RTN","RCD PELA1",195 ,0)
	9696	; 2 - Output to Excel
	9697	"RTN","RCD PELA1",196 ,0)
	9698	; ONEERA - A1^A 2^A3^A4 Wh ere:
	9699	"RTN","RCD PELA1",197 ,0)
	9700	; A1 - Number of lines in the ERA di splay
	9701	"RTN","RCD PELA1",198 ,0)
	9702	; A2 - Total Rec eipt amoun t for the ERA (forma tted)
	9703	"RTN","RCD PELA1",199 ,0)
	9704	; A3 - Total Amo unt paid f or the ERA (formatte d)
	9705	"RTN","RCD PELA1",200 ,0)
	9706	; A4 - 1 if ERA contains a t least on e detail r ecord
	9707	"RTN","RCD PELA1",201 ,0)
	9708	; with a missing re ceipt.
	9709	"RTN","RCD PELA1",202 ,0)
	9710	; 0 otherwi se
	9711	"RTN","RCD PELA1",203 ,0)
	9712	; ONEERA(L N)=A4- Whe re
	9713	"RTN","RCD PELA1",204 ,0)
	9714	; LN - Line numb er for ERA Display
	9715	"RTN","RCD PELA1",205 ,0)
	9716	; A4 - Actual di splay line
	9717	"RTN","RCD PELA1",206 ,0)
	9718	; IEN3444 - Inte rnal IEN f or file 34 4.4
	9719	"RTN","RCD PELA1",207 ,0)
	9720	; Ouput: ONEERA - Rece ipt Total Formatted, ERA Lines 1-4 added
	9721	"RTN","RCD PELA1",208 ,0)
	9722	N LN,MISS INGR,TOTER A,TOTREC,T RACE,XX
	9723	"RTN","RCD PELA1",209 ,0)
	9724	S XX=$P(O NEERA,"^", 3) ; Fina l Receipt Total
	9725	"RTN","RCD PELA1",210 ,0)
	9726	S TOTREC= $J(XX,12,2 ) ; Form atted tota l
	9727	"RTN","RCD PELA1",211 ,0)
	9728	S TOTERA= $P(ONEERA, "^",2) ; Form atted ERA Total
	9729	"RTN","RCD PELA1",212 ,0)
	9730	S XX=$$CO MPLETE^RCD PELAR(IEN3 444)
	9731	"RTN","RCD PELA1",213 ,0)
	9732	S MISSING R=$S(XX=0: "* Missing Receipts *",1:"")
	9733	"RTN","RCD PELA1",214 ,0)
	9734	S TRACE=$ $GET1^DIQ( 344.4,IEN3 444,.02,"I ") ; Trac e Number
	9735	"RTN","RCD PELA1",215 ,0)
	9736	I OUTYPE= 2 D Q ; Exce l output
	9737	"RTN","RCD PELA1",216 ,0)
	9738	. S XX=""
	9739	"RTN","RCD PELA1",217 ,0)
	9740	. F D Q :XX=""
	9741	"RTN","RCD PELA1",218 ,0)
	9742	. . S XX= $O(ONEERA( XX))
	9743	"RTN","RCD PELA1",219 ,0)
	9744	. . Q:XX= ""
	9745	"RTN","RCD PELA1",220 ,0)
	9746	. . S $P( ONEERA(XX) ,"^",6)=TR ACE ; For matted Rec eipt Total
	9747	"RTN","RCD PELA1",221 ,0)
	9748	. . S $P( ONEERA(XX) ,"^",7)=TO TREC ; For matted Rec eipt Total
	9749	"RTN","RCD PELA1",222 ,0)
	9750	. . S $P( ONEERA(XX) ,"^",8)=$P (ONEERA,"^ ",2) ; For matted ERA Total
	9751	"RTN","RCD PELA1",223 ,0)
	9752	. . S $P( ONEERA(XX) ,"^",9)=MI SSINGR
	9753	"RTN","RCD PELA1",224 ,0)
	9754	;
	9755	"RTN","RCD PELA1",225 ,0)
	9756	; 1st Mai n ERA disp lay line
	9757	"RTN","RCD PELA1",226 ,0)
	9758	S LN="ERA : "
	9759	"RTN","RCD PELA1",227 ,0)
	9760	S LN=$$SE TSTR^VALM1 (IEN3444,L N,6,$L(IEN 3444))
	9761	"RTN","RCD PELA1",228 ,0)
	9762	S LN=$$SE TSTR^VALM1 ("ERA Tota l: ",LN,20 ,11)
	9763	"RTN","RCD PELA1",229 ,0)
	9764	S LN=$$SE TSTR^VALM1 (TOTERA,LN ,32,$L(TOT ERA))
	9765	"RTN","RCD PELA1",230 ,0)
	9766	S LN=$$SE TSTR^VALM1 (MISSINGR, LN,53,$L(M ISSINGR))
	9767	"RTN","RCD PELA1",231 ,0)
	9768	S XX=$P(O NEERA,"^", 1)+1
	9769	"RTN","RCD PELA1",232 ,0)
	9770	S $P(ONEE RA,"^",1)= XX ; Upd ate Line c ounter
	9771	"RTN","RCD PELA1",233 ,0)
	9772	S ONEERA( .1)=LN
	9773	"RTN","RCD PELA1",234 ,0)
	9774	;
	9775	"RTN","RCD PELA1",235 ,0)
	9776	; 2nd Mai n ERA disp lay line
	9777	"RTN","RCD PELA1",236 ,0)
	9778	S LN=" Receipt Total:"
	9779	"RTN","RCD PELA1",237 ,0)
	9780	S LN=$$SE TSTR^VALM1 (TOTREC,LN ,32,$L(TOT REC))
	9781	"RTN","RCD PELA1",238 ,0)
	9782	S XX=$P(O NEERA,"^", 1)+1
	9783	"RTN","RCD PELA1",239 ,0)
	9784	S $P(ONEE RA,"^",1)= XX ; Upd ate Line c ounter
	9785	"RTN","RCD PELA1",240 ,0)
	9786	S ONEERA( .2)=LN
	9787	"RTN","RCD PELA1",241 ,0)
	9788	;
	9789	"RTN","RCD PELA1",242 ,0)
	9790	; 3rd Mai n ERA disp lay line
	9791	"RTN","RCD PELA1",243 ,0)
	9792	S LN=" T race #:"
	9793	"RTN","RCD PELA1",244 ,0)
	9794	S XX=$$GE T1^DIQ(344 .4,IEN3444 ,.02,"I") ; Trac e Number
	9795	"RTN","RCD PELA1",245 ,0)
	9796	S LN=$$SE TSTR^VALM1 (XX,LN,32, $L(XX))
	9797	"RTN","RCD PELA1",246 ,0)
	9798	S XX=$P(O NEERA,"^", 1)+1
	9799	"RTN","RCD PELA1",247 ,0)
	9800	S $P(ONEE RA,"^",1)= XX ; Upda te Line co unter
	9801	"RTN","RCD PELA1",248 ,0)
	9802	S ONEERA( .3)=LN
	9803	"RTN","RCD PELA1",249 ,0)
	9804	Q
	9805	"RTN","RCD PELA1",250 ,0)
	9806	;
	9807	"RTN","RCD PELA1",251 ,0)
	9808	OUTERA(INP UT,OUTYPE, PAYER,ONEE RA,LNCNT,P AGE) ; Out put the di splay line s for one ERA
	9809	"RTN","RCD PELA1",252 ,0)
	9810	; Input: INPUT - See REPO RT for a c omplete de scription
	9811	"RTN","RCD PELA1",253 ,0)
	9812	; OUTYPE - O - Output to Screen or paper
	9813	"RTN","RCD PELA1",254 ,0)
	9814	; 1 - Output to Listman
	9815	"RTN","RCD PELA1",255 ,0)
	9816	; 2 - Output to Excel
	9817	"RTN","RCD PELA1",256 ,0)
	9818	; PAYER - Paye r Name
	9819	"RTN","RCD PELA1",257 ,0)
	9820	; ONEERA - Arra y of lines to displa y for one ERA
	9821	"RTN","RCD PELA1",258 ,0)
	9822	; LNCNT - Curr ent Line C ount
	9823	"RTN","RCD PELA1",259 ,0)
	9824	; PAGE - Curr ent Page C ount
	9825	"RTN","RCD PELA1",260 ,0)
	9826	; Output: LNCNT - Upda ted Line C ount
	9827	"RTN","RCD PELA1",261 ,0)
	9828	; PAGE - Upda ted Page C ount
	9829	"RTN","RCD PELA1",262 ,0)
	9830	; A9 - Part of Input above
	9831	"RTN","RCD PELA1",263 ,0)
	9832	; Upda ted Line c ounter for Listman O utput
	9833	"RTN","RCD PELA1",264 ,0)
	9834	; ^TMP("RC DPE_LAR",$ J,CTR)=Lin e - Array of display lines (no headers)
	9835	"RTN","RCD PELA1",265 ,0)
	9836	; for ou tput to Li stman
	9837	"RTN","RCD PELA1",266 ,0)
	9838	; Only s et when A7 -1
	9839	"RTN","RCD PELA1",267 ,0)
	9840	; Returns : 1 if use r quit, 0 otherwise
	9841	"RTN","RCD PELA1",268 ,0)
	9842	N LN,STOP ,XX
	9843	"RTN","RCD PELA1",269 ,0)
	9844	S STOP=0
	9845	"RTN","RCD PELA1",270 ,0)
	9846	S XX=LNCN T-4+$P(ONE ERA,"^",1) ; LN CNT + # of lines to display
	9847	"RTN","RCD PELA1",271 ,0)
	9848	I 'OUTYPE ,(XX>(IOSL -3)) D Q: STOP 1
	9849	"RTN","RCD PELA1",272 ,0)
	9850	. S STOP= $$ASKSTOP^ RCDPELAR()
	9851	"RTN","RCD PELA1",273 ,0)
	9852	. Q:STOP
	9853	"RTN","RCD PELA1",274 ,0)
	9854	. S LNCNT =0
	9855	"RTN","RCD PELA1",275 ,0)
	9856	. D HEADE R(INPUT,.L NCNT,.PAGE )
	9857	"RTN","RCD PELA1",276 ,0)
	9858	. D ERAHD R(PAYER,.L NCNT,.PAGE )
	9859	"RTN","RCD PELA1",277 ,0)
	9860	S LN=""
	9861	"RTN","RCD PELA1",278 ,0)
	9862	F D Q:L N="" Q:ST OP
	9863	"RTN","RCD PELA1",279 ,0)
	9864	. S LN=$O (ONEERA(LN ))
	9865	"RTN","RCD PELA1",280 ,0)
	9866	. Q:LN=""
	9867	"RTN","RCD PELA1",281 ,0)
	9868	. S LNCNT =LNCNT+1
	9869	"RTN","RCD PELA1",282 ,0)
	9870	. I OUTYP E=1 D Q
	9871	"RTN","RCD PELA1",283 ,0)
	9872	. . S XX= $P(INPUT," ^",9)+1
	9873	"RTN","RCD PELA1",284 ,0)
	9874	. . S $P( INPUT,"^", 9)=XX
	9875	"RTN","RCD PELA1",285 ,0)
	9876	. . S ^TM P("RCDPE_L AR",$J,XX) =ONEERA(LN )
	9877	"RTN","RCD PELA1",286 ,0)
	9878	. W !,ONE ERA(LN)
	9879	"RTN","RCD PELA1",287 ,0)
	9880	S LNCNT=L NCNT+1
	9881	"RTN","RCD PELA1",288 ,0)
	9882	W:OUTYPE= 0 !
	9883	"RTN","RCD PELA1",289 ,0)
	9884	I OUTYPE= 1 D
	9885	"RTN","RCD PELA1",290 ,0)
	9886	. S XX=$P (INPUT,"^" ,9)+1
	9887	"RTN","RCD PELA1",291 ,0)
	9888	. S $P(IN PUT,"^",9) =XX
	9889	"RTN","RCD PELA1",292 ,0)
	9890	. S ^TMP( "RCDPE_LAR ",$J,XX)=" "
	9891	"RTN","RCD PELA1",293 ,0)
	9892	Q STOP
	9893	"RTN","RCD PELA1",294 ,0)
	9894	;
	9895	"RTN","RCD PELA1",295 ,0)
	9896	HEADER(INP UT,LNCNT,P AGE) ; Dis play a Pag e Header
	9897	"RTN","RCD PELA1",296 ,0)
	9898	; Input: INPUT - See REPO RT for a c omplete de scription
	9899	"RTN","RCD PELA1",297 ,0)
	9900	; LNCNT - Current Line Count
	9901	"RTN","RCD PELA1",298 ,0)
	9902	; PAGE - Current Page Count
	9903	"RTN","RCD PELA1",299 ,0)
	9904	; Output: LNCNT - Updated Line Count
	9905	"RTN","RCD PELA1",300 ,0)
	9906	; PAGE - Updated Page Count
	9907	"RTN","RCD PELA1",301 ,0)
	9908	N XX,YY,Z Z
	9909	"RTN","RCD PELA1",302 ,0)
	9910	S YY="AUT O-POSTED R ECEIPT REP ORT",PAGE= PAGE+1
	9911	"RTN","RCD PELA1",303 ,0)
	9912	S XX=$$NO W^XLFDT(), XX=$$FMTE^ XLFDT(XX)
	9913	"RTN","RCD PELA1",304 ,0)
	9914	S XX=$$SE TSTR^VALM1 (XX,YY,40, 21)
	9915	"RTN","RCD PELA1",305 ,0)
	9916	S YY="Pag e: "_$J(PA GE,3)
	9917	"RTN","RCD PELA1",306 ,0)
	9918	S XX=$$SE TSTR^VALM1 (YY,XX,72, $L(YY))
	9919	"RTN","RCD PELA1",307 ,0)
	9920	S LNCNT=L NCNT+1
	9921	"RTN","RCD PELA1",308 ,0)
	9922	W @IOF,XX
	9923	"RTN","RCD PELA1",309 ,0)
	9924	;
	9925	"RTN","RCD PELA1",310 ,0)
	9926	S LNCNT=L NCNT+1
	9927	"RTN","RCD PELA1",311 ,0)
	9928	S XX=$$HD RLN2(INPUT )
	9929	"RTN","RCD PELA1",312 ,0)
	9930	W !,XX
	9931	"RTN","RCD PELA1",313 ,0)
	9932	;
	9933	"RTN","RCD PELA1",314 ,0)
	9934	S LNCNT=L NCNT+1
	9935	"RTN","RCD PELA1",315 ,0)
	9936	S XX=$$HD RLN3(INPUT )
	9937	"RTN","RCD PELA1",316 ,0)
	9938	W !,XX
	9939	"RTN","RCD PELA1",317 ,0)
	9940	;
	9941	"RTN","RCD PELA1",318 ,0)
	9942	S LNCNT=L NCNT+1
	9943	"RTN","RCD PELA1",319 ,0)
	9944	W ! ; Blan k line
	9945	"RTN","RCD PELA1",320 ,0)
	9946	Q
	9947	"RTN","RCD PELA1",321 ,0)
	9948	;
	9949	"RTN","RCD PELA1",322 ,0)
	9950	HDRLN2(INP UT) ; Buil d the 2nd header lin e
	9951	"RTN","RCD PELA1",323 ,0)
	9952	; Input: INPUT - See REPO RT for a c omplete de scription
	9953	"RTN","RCD PELA1",324 ,0)
	9954	; Returns : Text for 2nd heade r line
	9955	"RTN","RCD PELA1",325 ,0)
	9956	N XX,YY,Z Z
	9957	"RTN","RCD PELA1",326 ,0)
	9958	S XX=" FI LTERS: "_$ S($P(INPUT ,"^",1)=1: "All",1:"S elected")_ " Divs;"
	9959	"RTN","RCD PELA1",327 ,0)
	9960	S XX=XX_$ S($P(INPUT ,"^",5)=1: " All",1:" Selected" )_" Payers ;"
	9961	"RTN","RCD PELA1",328 ,0)
	9962	S XX=XX_$ S($P(INPUT ,"^",2)=1: " Auto-Pos t Date",1: " ERA Dt R eceived")
	9963	"RTN","RCD PELA1",329 ,0)
	9964	S YY=$P($ P(INPUT,"^ ",3),"\|",1 ),YY=$$FMT E^XLFDT(YY ,"2Z")
	9965	"RTN","RCD PELA1",330 ,0)
	9966	S ZZ=$P($ P(INPUT,"^ ",3),"\|",2 ),ZZ=$$FMT E^XLFDT(ZZ ,"2Z")
	9967	"RTN","RCD PELA1",331 ,0)
	9968	S XX=XX_" "_YY_" to "_ZZ
	9969	"RTN","RCD PELA1",332 ,0)
	9970	Q XX
	9971	"RTN","RCD PELA1",333 ,0)
	9972	;
	9973	"RTN","RCD PELA1",334 ,0)
	9974	HDRLN3(INP UT) ; Buil d the 2nd header lin e
	9975	"RTN","RCD PELA1",335 ,0)
	9976	; Input: INPUT - A1^A2^A3 ^...^An Wh ere:
	9977	"RTN","RCD PELA1",336 ,0)
	9978	; A1 - 1 - All di visions se lected
	9979	"RTN","RCD PELA1",337 ,0)
	9980	; 2 - Select ed divisio ns
	9981	"RTN","RCD PELA1",338 ,0)
	9982	; A2 - 1 - Filter by Auto-P ost date r ange
	9983	"RTN","RCD PELA1",339 ,0)
	9984	; 2 - Filter by ERA Da te Receive d date ran ge
	9985	"RTN","RCD PELA1",340 ,0)
	9986	; A3 - B1\|B2 - Where:
	9987	"RTN","RCD PELA1",341 ,0)
	9988	; B1 - ERA Date Recei ved Start Date if A2 =2
	9989	"RTN","RCD PELA1",342 ,0)
	9990	; Auto -Post Star t Date of A2=1
	9991	"RTN","RCD PELA1",343 ,0)
	9992	; B2 - ERA Date Recei ved End Da te if A2=2
	9993	"RTN","RCD PELA1",344 ,0)
	9994	; Auto -Post End Date of A2 =1
	9995	"RTN","RCD PELA1",345 ,0)
	9996	; A4 - 1 - Posted /Completed Receipts
	9997	"RTN","RCD PELA1",346 ,0)
	9998	; 2 - Only E RAs with M issing Rec eipts
	9999	"RTN","RCD PELA1",347 ,0)
	10000	; 3 - Both P osted/Comp leted and Missing Re ceipts
	10001	"RTN","RCD PELA1",348 ,0)
	10002	; A5 - 1 - All in surance co mpanies se lected
	10003	"RTN","RCD PELA1",349 ,0)
	10004	; 2 - Select ed insuran ce compani es chosen
	10005	"RTN","RCD PELA1",350 ,0)
	10006	; A6 - 1 - Auto-P ost Date/E RA Date Re ceived Sor t
	10007	"RTN","RCD PELA1",351 ,0)
	10008	; 2 - Payer sort
	10009	"RTN","RCD PELA1",352 ,0)
	10010	; 3 - Missin g Receipts
	10011	"RTN","RCD PELA1",353 ,0)
	10012	; A7 - 0 - Do not display i n a listma n template
	10013	"RTN","RCD PELA1",354 ,0)
	10014	; 1 - Displa y in a lis tman templ ate
	10015	"RTN","RCD PELA1",355 ,0)
	10016	; A8 - 0 - Output to paper
	10017	"RTN","RCD PELA1",356 ,0)
	10018	; 1 - Output to Excel
	10019	"RTN","RCD PELA1",357 ,0)
	10020	; A9 - Line count er for Lis tman outpu t
	10021	"RTN","RCD PELA1",358 ,0)
	10022	; Returns : Text for 2nd heade r line
	10023	"RTN","RCD PELA1",359 ,0)
	10024	N XX,YY,Z Z
	10025	"RTN","RCD PELA1",360 ,0)
	10026	S YY=$P(I NPUT,"^",4 )
	10027	"RTN","RCD PELA1",361 ,0)
	10028	S:YY=1 ZZ ="Posted/C ompleted R eceipts" ; Rece ipt filter
	10029	"RTN","RCD PELA1",362 ,0)
	10030	S:YY=2 ZZ ="Missing Receipts O nly"
	10031	"RTN","RCD PELA1",363 ,0)
	10032	S:YY=3 ZZ ="All Rece ipts"
	10033	"RTN","RCD PELA1",364 ,0)
	10034	S XX=" ER A: "_ZZ
	10035	"RTN","RCD PELA1",365 ,0)
	10036	S XX=$$SE TSTR^VALM1 ("SORT: ", XX,40,6)
	10037	"RTN","RCD PELA1",366 ,0)
	10038	S YY=$P(I NPUT,"^",6 ) ; Sele cted Sort
	10039	"RTN","RCD PELA1",367 ,0)
	10040	I YY=1,$P (INPUT,"^" ,2)=1 S ZZ ="Auto-Pos t Date"
	10041	"RTN","RCD PELA1",368 ,0)
	10042	I YY=1,$P (INPUT,"^" ,2)=2 S ZZ ="ERA Date Received"
	10043	"RTN","RCD PELA1",369 ,0)
	10044	I YY=2 S ZZ="Payer"
	10045	"RTN","RCD PELA1",370 ,0)
	10046	I YY=3 S ZZ="Missin g Receipts "
	10047	"RTN","RCD PELA1",371 ,0)
	10048	S XX=$$SE TSTR^VALM1 (ZZ,XX,46, $L(ZZ))
	10049	"RTN","RCD PELA1",372 ,0)
	10050	Q XX
	10051	"RTN","RCD PELA1",373 ,0)
	10052	;
	10053	"RTN","RCD PELA1",374 ,0)
	10054	ERAHDR(PAY ER,LNCNT,P AGE) ; Dis play ERA H eader Line s
	10055	"RTN","RCD PELA1",375 ,0)
	10056	; Input: PAYER - Payer Na me
	10057	"RTN","RCD PELA1",376 ,0)
	10058	; LNCNT - Current Line Count
	10059	"RTN","RCD PELA1",377 ,0)
	10060	; PAGE - Current Page Count
	10061	"RTN","RCD PELA1",378 ,0)
	10062	; Output: LNCNT - Updated Line Count
	10063	"RTN","RCD PELA1",379 ,0)
	10064	; PAGE - Updated Page Count
	10065	"RTN","RCD PELA1",380 ,0)
	10066	N XX,YY,Z Z
	10067	"RTN","RCD PELA1",381 ,0)
	10068	S LNCNT=L NCNT+1
	10069	"RTN","RCD PELA1",382 ,0)
	10070	S XX=" DATE DATE"
	10071	"RTN","RCD PELA1",383 ,0)
	10072	W !,XX
	10073	"RTN","RCD PELA1",384 ,0)
	10074	;
	10075	"RTN","RCD PELA1",385 ,0)
	10076	S LNCNT=L NCNT+1
	10077	"RTN","RCD PELA1",386 ,0)
	10078	S XX=$$ER AHDR2()
	10079	"RTN","RCD PELA1",387 ,0)
	10080	W !,XX
	10081	"RTN","RCD PELA1",388 ,0)
	10082	;
	10083	"RTN","RCD PELA1",389 ,0)
	10084	S LNCNT=L NCNT+1
	10085	"RTN","RCD PELA1",390 ,0)
	10086	S XX=$J(" ",80),XX=$ TR(XX," ", "-")
	10087	"RTN","RCD PELA1",391 ,0)
	10088	W !,XX
	10089	"RTN","RCD PELA1",392 ,0)
	10090	;
	10091	"RTN","RCD PELA1",393 ,0)
	10092	S LNCNT=L NCNT+1
	10093	"RTN","RCD PELA1",394 ,0)
	10094	W !,"Paye r: ",PAYER
	10095	"RTN","RCD PELA1",395 ,0)
	10096	Q
	10097	"RTN","RCD PELA1",396 ,0)
	10098	;
	10099	"RTN","RCD PELA1",397 ,0)
	10100	ERAHDR2() ; Build th e 2nd ERA header lin e
	10101	"RTN","RCD PELA1",398 ,0)
	10102	; Input: None
	10103	"RTN","RCD PELA1",399 ,0)
	10104	; Returns : Text for 2nd ERA h eader line
	10105	"RTN","RCD PELA1",400 ,0)
	10106	N XX
	10107	"RTN","RCD PELA1",401 ,0)
	10108	S XX=" " ;RE CEIVED PO STED R ECEIPT"
	10109	"RTN","RCD PELA1",402 ,0)
	10110	S XX=$$SE TSTR^VALM1 ("RECEIVED ",XX,9,8)
	10111	"RTN","RCD PELA1",403 ,0)
	10112	S XX=$$SE TSTR^VALM1 ("POSTED", XX,19,6)
	10113	"RTN","RCD PELA1",404 ,0)
	10114	S XX=$$SE TSTR^VALM1 ("RECEIPT" ,XX,30,7)
	10115	"RTN","RCD PELA1",405 ,0)
	10116	S XX=$$SE TSTR^VALM1 ("USER",XX ,43,4)
	10117	"RTN","RCD PELA1",406 ,0)
	10118	S XX=$$SE TSTR^VALM1 (" AM OUNT",XX,5 0,12)
	10119	"RTN","RCD PELA1",407 ,0)
	10120	S XX=$$SE TSTR^VALM1 ("FMS DOC" ,XX,65,7)
	10121	"RTN","RCD PELA1",408 ,0)
	10122	Q XX
	10123	"RTN","RCD PELA1",409 ,0)
	10124	;
	10125	"RTN","RCD PELAR")
	10126	0^29^B1257 82541^n/a
	10127	"RTN","RCD PELAR",1,0 )
	10128	RCDPELAR ; EDE/FA - L IST ALL AU TO-POSTED RECEIPTS R EPORT ;Nov 17, 2016
	10129	"RTN","RCD PELAR",2,0 )
	10130	;;4.5;Acc ounts Rece ivable;3 18;Mar 2 0, 1995;Bu ild 25
	10131	"RTN","RCD PELAR",3,0 )
	10132	;Per VA D irective 6 402, this routine sh ould not b e modified .
	10133	"RTN","RCD PELAR",4,0 )
	10134	;
	10135	"RTN","RCD PELAR",5,0 )
	10136	EN ; Main entry poin t
	10137	"RTN","RCD PELAR",6,0 )
	10138	N INPUT,R CVAUTD,XX, YY
	10139	"RTN","RCD PELAR",7,0 )
	10140	K ^TMP($J ,"RCDPE_LA R"),^TMP(" RCDPE_LAR" ,$J)
	10141	"RTN","RCD PELAR",8,0 )
	10142	K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER ")
	10143	"RTN","RCD PELAR",9,0 )
	10144	;
	10145	"RTN","RCD PELAR",10, 0)
	10146	S INPUT=$ $STADIV(.R CVAUTD) ; Division f ilter
	10147	"RTN","RCD PELAR",11, 0)
	10148	Q:'INPUT ; '^' or tim eout
	10149	"RTN","RCD PELAR",12, 0)
	10150	S $P(INPU T,"^",2)=$ $APORERA() ; Filter by Auto-Post Date or ER A Date Rec eived
	10151	"RTN","RCD PELAR",13, 0)
	10152	Q:'$P(INP UT,"^",2) ; '^' or tim eout
	10153	"RTN","RCD PELAR",14, 0)
	10154	S $P(INPU T,"^",3)=$ $DTRNG(0) ; Start Date \|End date
	10155	"RTN","RCD PELAR",15, 0)
	10156	Q:'$P(INP UT,"^",3) ; '^' or tim eout
	10157	"RTN","RCD PELAR",16, 0)
	10158	S $P(INPU T,"^",4)=$ $SELERA() ; Select typ e of ERAS to be disp layed
	10159	"RTN","RCD PELAR",17, 0)
	10160	Q:'$P(INP UT,"^",4) ; '^' or tim eout
	10161	"RTN","RCD PELAR",18, 0)
	10162	S XX=+$$G ETPAY^RCDP EM9(344.4, 1,0) ; Insurance Company fi lter
	10163	"RTN","RCD PELAR",19, 0)
	10164	S XX=$S(X X=-1:-1,XX =2:1,1:2)
	10165	"RTN","RCD PELAR",20, 0)
	10166	S $P(INPU T,"^",5)=X X ; Insurance Company fi lter
	10167	"RTN","RCD PELAR",21, 0)
	10168	Q:$P(INPU T,"^",5)<0 ; '^' or tim eout
	10169	"RTN","RCD PELAR",22, 0)
	10170	S XX=$P(I NPUT,"^",2 ),YY=$P(IN PUT,"^",4)
	10171	"RTN","RCD PELAR",23, 0)
	10172	S $P(INPU T,"^",6)=$ $RPTSORT(X X,YY) ; Select Sec ondary sor t
	10173	"RTN","RCD PELAR",24, 0)
	10174	Q:'$P(INP UT,"^",6) ; '^' or tim eout
	10175	"RTN","RCD PELAR",25, 0)
	10176	S $P(INPU T,"^",7)=$ $ASKLM^RCD PEARL ; Ask to Dis play in Li stman Temp late
	10177	"RTN","RCD PELAR",26, 0)
	10178	Q:$P(INPU T,"^",7)<0 ; '^' or tim eout
	10179	"RTN","RCD PELAR",27, 0)
	10180	I $P(INPU T,"^",7)=1 D Q ; Compile da ta and cal l listman to display
	10181	"RTN","RCD PELAR",28, 0)
	10182	. D LMOUT (INPUT,.RC VAUTD,.IO)
	10183	"RTN","RCD PELAR",29, 0)
	10184	S $P(INPU T,"^",8)=$ $EXCEL() ; Ask to out put to Exc el
	10185	"RTN","RCD PELAR",30, 0)
	10186	Q:$P(INPU T,"^",8)=- 1 ; '^' or tim eout
	10187	"RTN","RCD PELAR",31, 0)
	10188	D:$P(INPU T,"^",8)=1 INFO^RCDP EM6 ; Display ca pture info rmation fo r Excel
	10189	"RTN","RCD PELAR",32, 0)
	10190	S $P(INPU T,"^",9)=$ $DEVICE($P (INPUT,"^" ,8),.IO) ; Ask ou tput devic e
	10191	"RTN","RCD PELAR",33, 0)
	10192	Q:'$P(INP UT,"^",9)
	10193	"RTN","RCD PELAR",34, 0)
	10194	;
	10195	"RTN","RCD PELAR",35, 0)
	10196	; Option to queue
	10197	"RTN","RCD PELAR",36, 0)
	10198	I $D(IO(" Q")) D Q
	10199	"RTN","RCD PELAR",37, 0)
	10200	. N JOB S JOB=$J
	10201	"RTN","RCD PELAR",38, 0)
	10202	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	10203	"RTN","RCD PELAR",39, 0)
	10204	. S ZTRTN ="REPORT^R CDPELAR(IN PUT,.RCVAU TD,.IO,JOB )"
	10205	"RTN","RCD PELAR",40, 0)
	10206	. S ZTDES C="LIST AL L AUTO-POS TED RECEIP TS REPORT"
	10207	"RTN","RCD PELAR",41, 0)
	10208	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	10209	"RTN","RCD PELAR",42, 0)
	10210	. S ZTSAV E("RC")=" ",ZTSAVE(" VAUTD")="" ,ZTSAVE("I O")=""
	10211	"RTN","RCD PELAR",43, 0)
	10212	. S ZTSAV E("INPUT") ="",ZTSAVE ("JOB")=""
	10213	"RTN","RCD PELAR",44, 0)
	10214	. D ^%ZTL OAD
	10215	"RTN","RCD PELAR",45, 0)
	10216	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	10217	"RTN","RCD PELAR",46, 0)
	10218	. K ZTSK, IO("Q")
	10219	"RTN","RCD PELAR",47, 0)
	10220	. D HOME^ %ZIS
	10221	"RTN","RCD PELAR",48, 0)
	10222	;
	10223	"RTN","RCD PELAR",49, 0)
	10224	D REPORT( INPUT,.RCV AUTD,.IO) ; Compile and Displa y Report d ata
	10225	"RTN","RCD PELAR",50, 0)
	10226	Q
	10227	"RTN","RCD PELAR",51, 0)
	10228	;
	10229	"RTN","RCD PELAR",52, 0)
	10230	LMOUT(INPU T,RCVAUTD, IO) ; Outp ut report to Listman
	10231	"RTN","RCD PELAR",53, 0)
	10232	; Input: INPUT - See REPORT for a complet e descript ion
	10233	"RTN","RCD PELAR",54, 0)
	10234	; RCVAUTD - Arr ay of sele cted Divis ions
	10235	"RTN","RCD PELAR",55, 0)
	10236	; Onl y passed i f A1=2
	10237	"RTN","RCD PELAR",56, 0)
	10238	; Output: ^TMP("RC DPE_LAR",$ J,CTR)=Lin e - Array of display lines (no headers)
	10239	"RTN","RCD PELAR",57, 0)
	10240	; for o utput to L istman
	10241	"RTN","RCD PELAR",58, 0)
	10242	; Only set when A 7-1
	10243	"RTN","RCD PELAR",59, 0)
	10244	N HDR
	10245	"RTN","RCD PELAR",60, 0)
	10246	S $P(INPU T,"^",9)=0 ; Initial l istman lin e counter
	10247	"RTN","RCD PELAR",61, 0)
	10248	D REPORT( INPUT,.RCV AUTD,.IO) ; Get the l ines to be displayed
	10249	"RTN","RCD PELAR",62, 0)
	10250	S HDR("TI TLE")="AUT O-POSTED R ECEIPT REP ORT"
	10251	"RTN","RCD PELAR",63, 0)
	10252	S HDR(1)= $$HDRLN2^R CDPELA1(IN PUT)
	10253	"RTN","RCD PELAR",64, 0)
	10254	S HDR(2)= $$HDRLN3^R CDPELA1(IN PUT)
	10255	"RTN","RCD PELAR",65, 0)
	10256	S HDR(3)= ""
	10257	"RTN","RCD PELAR",66, 0)
	10258	S HDR(4)= ""
	10259	"RTN","RCD PELAR",67, 0)
	10260	S HDR(5)= "PAYER"
	10261	"RTN","RCD PELAR",68, 0)
	10262	S HDR(6)= " D ATE D ATE"
	10263	"RTN","RCD PELAR",69, 0)
	10264	S HDR(7)= $$ERAHDR2^ RCDPELA1()
	10265	"RTN","RCD PELAR",70, 0)
	10266	D LMRPT^R CDPEARL(.H DR,$NA(^TM P("RCDPE_L AR",$J))) ; Generate ListMan d isplay
	10267	"RTN","RCD PELAR",71, 0)
	10268	;
	10269	"RTN","RCD PELAR",72, 0)
	10270	D ^%ZISC ; Close the device
	10271	"RTN","RCD PELAR",73, 0)
	10272	K ^TMP("R CDPE_LAR", $J),^TMP($ J,"RCDPE_L AR")
	10273	"RTN","RCD PELAR",74, 0)
	10274	K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER ")
	10275	"RTN","RCD PELAR",75, 0)
	10276	Q
	10277	"RTN","RCD PELAR",76, 0)
	10278	;
	10279	"RTN","RCD PELAR",77, 0)
	10280	STADIV(RCV AUTD) ; Di vision/Sta tion Filte r
	10281	"RTN","RCD PELAR",78, 0)
	10282	; Input: None
	10283	"RTN","RCD PELAR",79, 0)
	10284	; Output: RCVAUTD - Arra y of selec ted divisi ons, if 1 is returne d
	10285	"RTN","RCD PELAR",80, 0)
	10286	; Returns : 0 - User up-arrowe d or timed out
	10287	"RTN","RCD PELAR",81, 0)
	10288	; 1 - All divisions selected
	10289	"RTN","RCD PELAR",82, 0)
	10290	; 2 - Sele cted Divis ions
	10291	"RTN","RCD PELAR",83, 0)
	10292	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,VAUTD,X, Y
	10293	"RTN","RCD PELAR",84, 0)
	10294	D DIVISIO N^VAUTOMA ; IA # 664 allows this
	10295	"RTN","RCD PELAR",85, 0)
	10296	Q:Y<0 0 ; User up-arrowe d or timed out
	10297	"RTN","RCD PELAR",86, 0)
	10298	Q:VAUTD=1 1 ; All divisions selected
	10299	"RTN","RCD PELAR",87, 0)
	10300	M RCVAUTD =VAUTD ; Save selected divisions (if any)
	10301	"RTN","RCD PELAR",88, 0)
	10302	Q 2
	10303	"RTN","RCD PELAR",89, 0)
	10304	;
	10305	"RTN","RCD PELAR",90, 0)
	10306	APORERA() ; Ask the user if th ey want to filter by Auto-Post Date or E RA Date
	10307	"RTN","RCD PELAR",91, 0)
	10308	; receive d
	10309	"RTN","RCD PELAR",92, 0)
	10310	; Input: None
	10311	"RTN","RCD PELAR",93, 0)
	10312	; Returns : 0 - User up- arrowed or timed out
	10313	"RTN","RCD PELAR",94, 0)
	10314	; 1 - Filter b y Auto-Pos t date ran ge
	10315	"RTN","RCD PELAR",95, 0)
	10316	; 2 - Filter b y ERA Date Received
	10317	"RTN","RCD PELAR",96, 0)
	10318	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
	10319	"RTN","RCD PELAR",97, 0)
	10320	S DIR("A" )="(A)uto- Post Date or (E)RA D ate Receiv ed? (A/E): "
	10321	"RTN","RCD PELAR",98, 0)
	10322	S DIR(0)= "SA^A:Auto -Post Date ;E:ERA Dat e Received "
	10323	"RTN","RCD PELAR",99, 0)
	10324	S DIR("?" ,1)="Enter 'A' to fi lter by an Auto-Post Date Rang e."
	10325	"RTN","RCD PELAR",100 ,0)
	10326	S DIR("?" )="Enter ' E' to filt er by an E RA Date Re ceived Dat e Range."
	10327	"RTN","RCD PELAR",101 ,0)
	10328	S DIR("B" )="A"
	10329	"RTN","RCD PELAR",102 ,0)
	10330	D ^DIR
	10331	"RTN","RCD PELAR",103 ,0)
	10332	I $D(DTOU T)!$D(DUOU T)!(Y="") Q 0
	10333	"RTN","RCD PELAR",104 ,0)
	10334	Q:Y="A" 1
	10335	"RTN","RCD PELAR",105 ,0)
	10336	Q 2
	10337	"RTN","RCD PELAR",106 ,0)
	10338	;
	10339	"RTN","RCD PELAR",107 ,0)
	10340	DTRNG(WHIC H) ; Allow s the user to select the Auto- Post OR ER A Received
	10341	"RTN","RCD PELAR",108 ,0)
	10342	; date ra nge to be used
	10343	"RTN","RCD PELAR",109 ,0)
	10344	; Input: WHICH - 0 - Auto -Post Date Range
	10345	"RTN","RCD PELAR",110 ,0)
	10346	; 1 - ERA Date Recei ved Date R ange
	10347	"RTN","RCD PELAR",111 ,0)
	10348	; Returns : 0 - User up- arrowed or timed out , 1 otherw ise
	10349	"RTN","RCD PELAR",112 ,0)
	10350	; A1^A2 - Where:
	10351	"RTN","RCD PELAR",113 ,0)
	10352	; A1 - Aut -Post Star t Date
	10353	"RTN","RCD PELAR",114 ,0)
	10354	; A2 - Aut o-Post End Date
	10355	"RTN","RCD PELAR",115 ,0)
	10356	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RANGE,ST ART,X,XX,Y
	10357	"RTN","RCD PELAR",116 ,0)
	10358	S DIR(0)= "DAO^:"_DT _":APE"
	10359	"RTN","RCD PELAR",117 ,0)
	10360	S DIR("A" )="Start D ate: "
	10361	"RTN","RCD PELAR",118 ,0)
	10362	S XX="Ent er the ear liest "_$S (WHICH=0:" Auto-Post date",1:"E RA Date Re ceived")
	10363	"RTN","RCD PELAR",119 ,0)
	10364	S XX=XX_" for recei pts to inc lude on th e report"
	10365	"RTN","RCD PELAR",120 ,0)
	10366	S DIR("?" )=XX
	10367	"RTN","RCD PELAR",121 ,0)
	10368	D ^DIR
	10369	"RTN","RCD PELAR",122 ,0)
	10370	Q:$D(DTOU T)!$D(DUOU T)!(Y="") 0
	10371	"RTN","RCD PELAR",123 ,0)
	10372	S START=Y
	10373	"RTN","RCD PELAR",124 ,0)
	10374	ENDDT ; Pr ompt for e nd date
	10375	"RTN","RCD PELAR",125 ,0)
	10376	K DIR
	10377	"RTN","RCD PELAR",126 ,0)
	10378	S DIR("B" )=Y(0)
	10379	"RTN","RCD PELAR",127 ,0)
	10380	S DIR(0)= "DAO^"_STA RT_":"_DT_ ":APE"
	10381	"RTN","RCD PELAR",128 ,0)
	10382	S DIR("A" )="End Dat e: "
	10383	"RTN","RCD PELAR",129 ,0)
	10384	S XX="Ent er the lat est "_$S(W HICH=0:"Au to-Post da te",1:"ERA Date Rece ived")
	10385	"RTN","RCD PELAR",130 ,0)
	10386	S XX=XX_" for recei pts to inc lude on th e report"
	10387	"RTN","RCD PELAR",131 ,0)
	10388	S DIR("?" )=XX
	10389	"RTN","RCD PELAR",132 ,0)
	10390	D ^DIR
	10391	"RTN","RCD PELAR",133 ,0)
	10392	Q:$D(DTOU T)!$D(DUOU T)!(Y="") 0
	10393	"RTN","RCD PELAR",134 ,0)
	10394	I Y<START D G ENDD T
	10395	"RTN","RCD PELAR",135 ,0)
	10396	. S XX=$$ FMTE^XLFDT (START,"2Z D") ;****
	10397	"RTN","RCD PELAR",136 ,0)
	10398	. W !,*7, "Enter an End date t hat is not less than "_XX
	10399	"RTN","RCD PELAR",137 ,0)
	10400	S RANGE=S TART_"\|"_Y
	10401	"RTN","RCD PELAR",138 ,0)
	10402	Q RANGE
	10403	"RTN","RCD PELAR",139 ,0)
	10404	;
	10405	"RTN","RCD PELAR",140 ,0)
	10406	SELERA() ; Ask the u ser which types of E RA the wan t to see o n the repo rt
	10407	"RTN","RCD PELAR",141 ,0)
	10408	; Input: None
	10409	"RTN","RCD PELAR",142 ,0)
	10410	; Returns : 0 - User up- arrowed or timed out
	10411	"RTN","RCD PELAR",143 ,0)
	10412	; 1 - Posted/C ompleted R eceipts
	10413	"RTN","RCD PELAR",144 ,0)
	10414	; 2 - Only ERA s with Mis sing Recei pts
	10415	"RTN","RCD PELAR",145 ,0)
	10416	; 3 - Both Pos ted/Comple ted and Mi ssing Rece ipts
	10417	"RTN","RCD PELAR",146 ,0)
	10418	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
	10419	"RTN","RCD PELAR",147 ,0)
	10420	S DIR("A" )="Select ERAs to be Displayed : "
	10421	"RTN","RCD PELAR",148 ,0)
	10422	S DIR(0)= "SA^1:Post ed/Complet ed Receipt s;2:Missin g Receipts ;3:Both"
	10423	"RTN","RCD PELAR",149 ,0)
	10424	S DIR("B" )="Both"
	10425	"RTN","RCD PELAR",150 ,0)
	10426	S DIR("?" ,1)="Enter 1 to only display P osted Rece ipts."
	10427	"RTN","RCD PELAR",151 ,0)
	10428	S DIR("?" ,2)="Enter 2 to only display E RAs with m issing rec eipts."
	10429	"RTN","RCD PELAR",152 ,0)
	10430	S DIR("?" )="Enter 3 to displa y all rece ipts."
	10431	"RTN","RCD PELAR",153 ,0)
	10432	D ^DIR
	10433	"RTN","RCD PELAR",154 ,0)
	10434	I $D(DTOU T)!$D(DUOU T)!(Y="") Q 0
	10435	"RTN","RCD PELAR",155 ,0)
	10436	Q Y
	10437	"RTN","RCD PELAR",156 ,0)
	10438	;
	10439	"RTN","RCD PELAR",157 ,0)
	10440	RPTSORT(WH ICH,ERASEL ) ; Ask th e user how they want to sort t he data
	10441	"RTN","RCD PELAR",158 ,0)
	10442	; Input: WHICH - 1- Filte ring by Au to-Post Da te
	10443	"RTN","RCD PELAR",159 ,0)
	10444	; 2 - Filt ering by E RA Date Re ceived
	10445	"RTN","RCD PELAR",160 ,0)
	10446	; ERASEL - ERA Filt er
	10447	"RTN","RCD PELAR",161 ,0)
	10448	; 1 - Post ed/Complet ed Receipt s
	10449	"RTN","RCD PELAR",162 ,0)
	10450	; 2 - Only ERAs with Missing R eceipts
	10451	"RTN","RCD PELAR",163 ,0)
	10452	; 3 - Both Posted/Co mpleted an d Missing Receipts
	10453	"RTN","RCD PELAR",164 ,0)
	10454	; Returns : 0 - User up- arrowed or timed out
	10455	"RTN","RCD PELAR",165 ,0)
	10456	; 1 - Auto-Pos t Date sor t
	10457	"RTN","RCD PELAR",166 ,0)
	10458	; 2 - Missing Receipts
	10459	"RTN","RCD PELAR",167 ,0)
	10460	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,XX,Y
	10461	"RTN","RCD PELAR",168 ,0)
	10462	;
	10463	"RTN","RCD PELAR",169 ,0)
	10464	; If the user is on ly showing Posted/Co mpleted Re ceipts OR
	10465	"RTN","RCD PELAR",170 ,0)
	10466	; Missing Receipts then the o nly possib le sort va lue is by date
	10467	"RTN","RCD PELAR",171 ,0)
	10468	I ERASEL' =3 Q 1
	10469	"RTN","RCD PELAR",172 ,0)
	10470	S DIR("A" )="Sort by (D)ate or (M)issing Receipts: "
	10471	"RTN","RCD PELAR",173 ,0)
	10472	S DIR(0)= "SA^D:Date ;M:Missing Receipts"
	10473	"RTN","RCD PELAR",174 ,0)
	10474	S DIR("B" )="D"
	10475	"RTN","RCD PELAR",175 ,0)
	10476	S XX=$S(W HICH=1:"Au to-Post da te.",1:"ER A Date Rec eived.")
	10477	"RTN","RCD PELAR",176 ,0)
	10478	S DIR("?" ,1)="Enter 'D' to so rt by "_XX
	10479	"RTN","RCD PELAR",177 ,0)
	10480	S DIR("?" )="Enter ' M' to disp lay Missin g Receipts first."
	10481	"RTN","RCD PELAR",178 ,0)
	10482	D ^DIR
	10483	"RTN","RCD PELAR",179 ,0)
	10484	I $D(DTOU T)!$D(DUOU T)!(Y="") Q 0
	10485	"RTN","RCD PELAR",180 ,0)
	10486	S XX=$S(Y ="D":1,Y=" P":2,1:3)
	10487	"RTN","RCD PELAR",181 ,0)
	10488	Q XX
	10489	"RTN","RCD PELAR",182 ,0)
	10490	;
	10491	"RTN","RCD PELAR",183 ,0)
	10492	EXCEL() ; Ask the us er if they want to e xport to E xcel
	10493	"RTN","RCD PELAR",184 ,0)
	10494	; Input: None
	10495	"RTN","RCD PELAR",185 ,0)
	10496	; Returns : -1 - User up- arrowed or timed out
	10497	"RTN","RCD PELAR",186 ,0)
	10498	; 0 - Output t o paper
	10499	"RTN","RCD PELAR",187 ,0)
	10500	; 1 - Output t o Excel
	10501	"RTN","RCD PELAR",188 ,0)
	10502	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
	10503	"RTN","RCD PELAR",189 ,0)
	10504	S DIR(0)= "Y"
	10505	"RTN","RCD PELAR",190 ,0)
	10506	S DIR("A" )="Export the report to Micros oft Excel"
	10507	"RTN","RCD PELAR",191 ,0)
	10508	S DIR("B" )="NO"
	10509	"RTN","RCD PELAR",192 ,0)
	10510	S DIR("?" )="Enter ' YES' to ou tput to Ex cel. Other wise enter 'NO'"
	10511	"RTN","RCD PELAR",193 ,0)
	10512	D ^DIR
	10513	"RTN","RCD PELAR",194 ,0)
	10514	I $G(DUOU T) Q -1
	10515	"RTN","RCD PELAR",195 ,0)
	10516	Q Y
	10517	"RTN","RCD PELAR",196 ,0)
	10518	;
	10519	"RTN","RCD PELAR",197 ,0)
	10520	DEVICE(EXC EL,IO) ; S elect the output dev ice
	10521	"RTN","RCD PELAR",198 ,0)
	10522	; Input: EXCEL - 1 - Oupu t to Excel , 0 otherw ise
	10523	"RTN","RCD PELAR",199 ,0)
	10524	; Output: %ZIS - Selected device
	10525	"RTN","RCD PELAR",200 ,0)
	10526	; IO - Array of selected output inf o
	10527	"RTN","RCD PELAR",201 ,0)
	10528	; Returns : 0 - No devic e selected , 1 otherw ise
	10529	"RTN","RCD PELAR",202 ,0)
	10530	N POP,RCP YRSEL,%ZIS
	10531	"RTN","RCD PELAR",203 ,0)
	10532	S %ZIS="Q M"
	10533	"RTN","RCD PELAR",204 ,0)
	10534	D ^%ZIS
	10535	"RTN","RCD PELAR",205 ,0)
	10536	Q:POP 0
	10537	"RTN","RCD PELAR",206 ,0)
	10538	Q:EXCEL 1 ; Output to Excel, no queueing
	10539	"RTN","RCD PELAR",207 ,0)
	10540	;
	10541	"RTN","RCD PELAR",208 ,0)
	10542	Q 1
	10543	"RTN","RCD PELAR",209 ,0)
	10544	;
	10545	"RTN","RCD PELAR",210 ,0)
	10546	REPORT(INP UT,RCVAUTD ,IO,JOB) ; Compile a nd run the report
	10547	"RTN","RCD PELAR",211 ,0)
	10548	; Expects ZTQUEUED to be defi ned alread y if queue d
	10549	"RTN","RCD PELAR",212 ,0)
	10550	; Input: INPUT - A1^A2^A3 ^...^An Wh ere:
	10551	"RTN","RCD PELAR",213 ,0)
	10552	; A1 - 1 - All di visions se lected
	10553	"RTN","RCD PELAR",214 ,0)
	10554	; 2 - Select ed divisio ns
	10555	"RTN","RCD PELAR",215 ,0)
	10556	; A2 - 1 - Filter by Auto-P ost date r ange
	10557	"RTN","RCD PELAR",216 ,0)
	10558	; 2 - Filter by ERA Da te Receive d date ran ge
	10559	"RTN","RCD PELAR",217 ,0)
	10560	; A3 - B1\|B2 - Where:
	10561	"RTN","RCD PELAR",218 ,0)
	10562	; B1 - ERA Date Recei ved Start Date if A2 =2
	10563	"RTN","RCD PELAR",219 ,0)
	10564	; Auto -Post Star t Date of A2=1
	10565	"RTN","RCD PELAR",220 ,0)
	10566	; B2 - ERA Date Recei ved End Da te if A2=2
	10567	"RTN","RCD PELAR",221 ,0)
	10568	; Auto -Post End Date of A2 =1
	10569	"RTN","RCD PELAR",222 ,0)
	10570	; A4 - 1 - Posted /Completed Receipts
	10571	"RTN","RCD PELAR",223 ,0)
	10572	; 2 - Only E RAs with M issing Rec eipts
	10573	"RTN","RCD PELAR",224 ,0)
	10574	; 3 - Both P osted/Comp leted and Missing Re ceipts
	10575	"RTN","RCD PELAR",225 ,0)
	10576	; A5 - 1 - All in surance co mpanies se lected
	10577	"RTN","RCD PELAR",226 ,0)
	10578	; 2 - Select ed insuran ce compani es chosen
	10579	"RTN","RCD PELAR",227 ,0)
	10580	; A6 - 1 - Auto-P ost Date/E RA Date Re ceived Sor t
	10581	"RTN","RCD PELAR",228 ,0)
	10582	; 2 - Payer sort
	10583	"RTN","RCD PELAR",229 ,0)
	10584	; 3 - Missin g Receipts
	10585	"RTN","RCD PELAR",230 ,0)
	10586	; A7 - 0 - Do not display i n a listma n template
	10587	"RTN","RCD PELAR",231 ,0)
	10588	; 1 - Displa y in a lis tman templ ate
	10589	"RTN","RCD PELAR",232 ,0)
	10590	; A8 - 0 - Output to paper
	10591	"RTN","RCD PELAR",233 ,0)
	10592	; 1 - Output to Excel
	10593	"RTN","RCD PELAR",234 ,0)
	10594	; A9 - Line count er for Lis tman outpu t
	10595	"RTN","RCD PELAR",235 ,0)
	10596	; RCVAUTD - Array of selecte d Division s
	10597	"RTN","RCD PELAR",236 ,0)
	10598	; Only p assed if A 1=2
	10599	"RTN","RCD PELAR",237 ,0)
	10600	; IO - Interfa ce device
	10601	"RTN","RCD PELAR",238 ,0)
	10602	; JOB - $J (opt ional, onl y passed i n when rep ort is que ued)
	10603	"RTN","RCD PELAR",239 ,0)
	10604	; ^TMP("R CSELPAY",$ J)- Global Array of selected i nsurance c ompanies
	10605	"RTN","RCD PELAR",240 ,0)
	10606	; Output: ^TMP("R CDPE_LAR", $J,CTR)=Li ne - Array of displa y lines (n o headers)
	10607	"RTN","RCD PELAR",241 ,0)
	10608	; for o utput to L istman
	10609	"RTN","RCD PELAR",242 ,0)
	10610	; Only set when A 7-1
	10611	"RTN","RCD PELAR",243 ,0)
	10612	N CURDT,D IVFLT,DTEN D,DTSTART, ERAFILT,WH ICH,XX,SOR T,STOP
	10613	"RTN","RCD PELAR",244 ,0)
	10614	K ^TMP("R CDPE_LAR", $J),^TMP($ J,"RCDPE_L AR")
	10615	"RTN","RCD PELAR",245 ,0)
	10616	I '$G(JOB ) S JOB=""
	10617	"RTN","RCD PELAR",246 ,0)
	10618	U IO
	10619	"RTN","RCD PELAR",247 ,0)
	10620	D PAYERS( JOB) ; Rear range paye r global f or easier use
	10621	"RTN","RCD PELAR",248 ,0)
	10622	S DIVFLT= $P(INPUT," ^",1) ; Divi sion filte r
	10623	"RTN","RCD PELAR",249 ,0)
	10624	S WHICH=$ P(INPUT,"^ ",2) ; 1 - Auto-Post date, 2 - ERA Date R eceived
	10625	"RTN","RCD PELAR",250 ,0)
	10626	S SORT=$P (INPUT,"^" ,6) ; Type of second ary sort
	10627	"RTN","RCD PELAR",251 ,0)
	10628	S DTEND=$ P($P(INPUT ,"^",3),"\| ",2)_".999 9" ; End of Date Ra nge
	10629	"RTN","RCD PELAR",252 ,0)
	10630	S DTSTART =$P($P(INP UT,"^",3), "\|",1) ; End of Date Ra nge
	10631	"RTN","RCD PELAR",253 ,0)
	10632	S ERAFILT =$P(INPUT, "^",4) ; ERA Filter
	10633	"RTN","RCD PELAR",254 ,0)
	10634	;
	10635	"RTN","RCD PELAR",255 ,0)
	10636	; First f ilter and sort the r eport
	10637	"RTN","RCD PELAR",256 ,0)
	10638	S CURDT=D TSTART-1
	10639	"RTN","RCD PELAR",257 ,0)
	10640	F D Q:' CURDT Q:C URDT>(DTEN D)
	10641	"RTN","RCD PELAR",258 ,0)
	10642	. S:WHICH =1 CURDT=$ O(^RCY(344 .4,"F",CUR DT))
	10643	"RTN","RCD PELAR",259 ,0)
	10644	. S:WHICH =2 CURDT=$ O(^RCY(344 .4,"AFD",C URDT))
	10645	"RTN","RCD PELAR",260 ,0)
	10646	. Q:'CURD T
	10647	"RTN","RCD PELAR",261 ,0)
	10648	. Q:CURDT >(DTEND)
	10649	"RTN","RCD PELAR",262 ,0)
	10650	. I WHICH =2 D RPTE( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD) Q
	10651	"RTN","RCD PELAR",263 ,0)
	10652	. D RPTA( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD)
	10653	"RTN","RCD PELAR",264 ,0)
	10654	;
	10655	"RTN","RCD PELAR",265 ,0)
	10656	D RPTOUT^ RCDPELA1(I NPUT) ; Output the report
	10657	"RTN","RCD PELAR",266 ,0)
	10658	;
	10659	"RTN","RCD PELAR",267 ,0)
	10660	; Quit if Listman - clean up of ^TMP & device is handled in LMOUT^RCD PELAR
	10661	"RTN","RCD PELAR",268 ,0)
	10662	I $P(INPU T,"^",7)=1 Q
	10663	"RTN","RCD PELAR",269 ,0)
	10664	;
	10665	"RTN","RCD PELAR",270 ,0)
	10666	; Close d evice
	10667	"RTN","RCD PELAR",271 ,0)
	10668	I '$D(ZTQ UEUED) D ^ %ZISC
	10669	"RTN","RCD PELAR",272 ,0)
	10670	I $D(ZTQU EUED) S ZT REQ="@"
	10671	"RTN","RCD PELAR",273 ,0)
	10672	K ^TMP("R CDPE_LAR", $J),^TMP($ J,"RCDPE_L AR")
	10673	"RTN","RCD PELAR",274 ,0)
	10674	K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER ")
	10675	"RTN","RCD PELAR",275 ,0)
	10676	K ZTQUEUE D
	10677	"RTN","RCD PELAR",276 ,0)
	10678	Q
	10679	"RTN","RCD PELAR",277 ,0)
	10680	;
	10681	"RTN","RCD PELAR",278 ,0)
	10682	PAYERS(JOB ) ; Rearra nge payer global for easier us e
	10683	"RTN","RCD PELAR",279 ,0)
	10684	; Input: ^TMP("RC SELPAY",$J ,nn)=Payer Name - Gl obal Array of select ed
	10685	"RTN","RCD PELAR",280 ,0)
	10686	; in surance co mpanies
	10687	"RTN","RCD PELAR",281 ,0)
	10688	; Output ^TMP($J, "SELPAYER" ,Payer Nam e)="" - Gl obal Array of select ed
	10689	"RTN","RCD PELAR",282 ,0)
	10690	; in surance re arranged f or easier checks
	10691	"RTN","RCD PELAR",283 ,0)
	10692	I JOB="" S JOB=$J
	10693	"RTN","RCD PELAR",284 ,0)
	10694	N PAYER,X X
	10695	"RTN","RCD PELAR",285 ,0)
	10696	K ^TMP($J ,"SELPAYER ")
	10697	"RTN","RCD PELAR",286 ,0)
	10698	S XX=""
	10699	"RTN","RCD PELAR",287 ,0)
	10700	F D Q:X X=""
	10701	"RTN","RCD PELAR",288 ,0)
	10702	. S XX=$O (^TMP("RCS ELPAY",JOB ,XX))
	10703	"RTN","RCD PELAR",289 ,0)
	10704	. Q:XX=""
	10705	"RTN","RCD PELAR",290 ,0)
	10706	. S PAYER =$$UP^XLFS TR(^TMP("R CSELPAY",J OB,XX))
	10707	"RTN","RCD PELAR",291 ,0)
	10708	. S ^TMP( $J,"SELPAY ER",PAYER) =""
	10709	"RTN","RCD PELAR",292 ,0)
	10710	K ^TMP("R CSELPAY",J OB)
	10711	"RTN","RCD PELAR",293 ,0)
	10712	Q
	10713	"RTN","RCD PELAR",294 ,0)
	10714	;
	10715	"RTN","RCD PELAR",295 ,0)
	10716	RPTE(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD) ; Use the ER A Date Rec eived inde x and filt er out
	10717	"RTN","RCD PELAR",296 ,0)
	10718	; divisio ns, payers that were n't select ed
	10719	"RTN","RCD PELAR",297 ,0)
	10720	; Input: DIVFLT - 1 - Al l Division s selected , 2 otherw ise
	10721	"RTN","RCD PELAR",298 ,0)
	10722	; CURDT - Date b eing proce ssed
	10723	"RTN","RCD PELAR",299 ,0)
	10724	; SORT - 1 - Au to-Post Da te Sort
	10725	"RTN","RCD PELAR",300 ,0)
	10726	; 2 - Mi ssing Rece ipts
	10727	"RTN","RCD PELAR",301 ,0)
	10728	; ERAFILT - 1 - Po sted/Compl eted Recei pts
	10729	"RTN","RCD PELAR",302 ,0)
	10730	; 2 - On ly ERAs wi th Missing Receipts
	10731	"RTN","RCD PELAR",303 ,0)
	10732	; 3 - Bo th Posted/ Completed and Missin g Receipts
	10733	"RTN","RCD PELAR",304 ,0)
	10734	; VAUTD - Array of selecte d division s
	10735	"RTN","RCD PELAR",305 ,0)
	10736	; ^TMP("RCS ELPAY",$J) - Global Array of selected i nsurance c ompanies
	10737	"RTN","RCD PELAR",306 ,0)
	10738	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	10739	"RTN","RCD PELAR",307 ,0)
	10740	; A1 - "RCDPE_LAR "
	10741	"RTN","RCD PELAR",308 ,0)
	10742	; A2 - Uppercased Payer Nam e (primary sort)
	10743	"RTN","RCD PELAR",309 ,0)
	10744	; A3 - Secondary Sort Value
	10745	"RTN","RCD PELAR",310 ,0)
	10746	; A4 - Internal I EN for fil e 344.4
	10747	"RTN","RCD PELAR",311 ,0)
	10748	; A5 - Internal I EN for sub file 344. 41
	10749	"RTN","RCD PELAR",312 ,0)
	10750	N COMPLET E,IEN3444, IEN34441,I ENS,PAYER, RECEIPT,SV AL,XX
	10751	"RTN","RCD PELAR",313 ,0)
	10752	S IEN3444 =0
	10753	"RTN","RCD PELAR",314 ,0)
	10754	F D Q:' IEN3444
	10755	"RTN","RCD PELAR",315 ,0)
	10756	. S IEN34 44=$O(^RCY (344.4,"AF D",CURDT,I EN3444))
	10757	"RTN","RCD PELAR",316 ,0)
	10758	. Q:'IEN3 444
	10759	"RTN","RCD PELAR",317 ,0)
	10760	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pa yment From field
	10761	"RTN","RCD PELAR",318 ,0)
	10762	. S PAYER =$$UP^XLFS TR(PAYER)
	10763	"RTN","RCD PELAR",319 ,0)
	10764	. Q:'$D(^ TMP($J,"SE LPAYER",PA YER)) ; No t a select ed payer
	10765	"RTN","RCD PELAR",320 ,0)
	10766	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; No t a select ed Divisio n
	10767	"RTN","RCD PELAR",321 ,0)
	10768	. S XX=$$ GET1^DIQ(3 44.4,IEN34 44,4.01,"I ") ; Au to-Post da te on ERA
	10769	"RTN","RCD PELAR",322 ,0)
	10770	. Q:'XX ; sk ip if not auto-poste d ERA
	10771	"RTN","RCD PELAR",323 ,0)
	10772	. S COMPL ETE=$$COMP LETE(IEN34 44) ; Ch eck for mi ssing rece ipts
	10773	"RTN","RCD PELAR",324 ,0)
	10774	. I ERAFI LT=1,'COMP LETE Q ; Mi ssing Rece ipt
	10775	"RTN","RCD PELAR",325 ,0)
	10776	. I ERAFI LT=2,COMPL ETE Q ; No t a Missin g Receipt
	10777	"RTN","RCD PELAR",326 ,0)
	10778	. ;
	10779	"RTN","RCD PELAR",327 ,0)
	10780	. ; Just showing mi ssing rece ipts and t his ERA do esn't have any
	10781	"RTN","RCD PELAR",328 ,0)
	10782	. I ERAFI LT=2,COMPL ETE Q
	10783	"RTN","RCD PELAR",329 ,0)
	10784	. S IEN34 441=0
	10785	"RTN","RCD PELAR",330 ,0)
	10786	. F D Q :'IEN34441
	10787	"RTN","RCD PELAR",331 ,0)
	10788	. . S IEN 34441=$O(^ RCY(344.4, IEN3444,1, IEN34441))
	10789	"RTN","RCD PELAR",332 ,0)
	10790	. . Q:'IE N34441
	10791	"RTN","RCD PELAR",333 ,0)
	10792	. . S IEN S=IEN34441 _","_IEN34 44_","
	10793	"RTN","RCD PELAR",334 ,0)
	10794	. . S SVA L=$S(SORT= 1:CURDT,1: COMPLETE) ; Ge t the sort value
	10795	"RTN","RCD PELAR",335 ,0)
	10796	. . S ^TM P($J,"RCDP E_LAR","SE L",PAYER,S VAL,IEN344 4,IEN34441 )=""
	10797	"RTN","RCD PELAR",336 ,0)
	10798	Q
	10799	"RTN","RCD PELAR",337 ,0)
	10800	;
	10801	"RTN","RCD PELAR",338 ,0)
	10802	RPTA(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD) ; Use the Au to-Post Da te index a nd filter out
	10803	"RTN","RCD PELAR",339 ,0)
	10804	; divisio ns, payers that were n't select ed
	10805	"RTN","RCD PELAR",340 ,0)
	10806	; Input: DIVFLT - 1 - Al l Division s selected , 2 otherw ise
	10807	"RTN","RCD PELAR",341 ,0)
	10808	; CURDT - Date b eing proce ssed
	10809	"RTN","RCD PELAR",342 ,0)
	10810	; SORT - 1 - Au to-Post Da te Sort
	10811	"RTN","RCD PELAR",343 ,0)
	10812	; 2 - Mi ssing Rece ipts
	10813	"RTN","RCD PELAR",344 ,0)
	10814	; ERAFILT - 1 - Po sted/Compl eted Recei pts
	10815	"RTN","RCD PELAR",345 ,0)
	10816	; 2 - On ly ERAs wi th Missing Receipts
	10817	"RTN","RCD PELAR",346 ,0)
	10818	; 3 - Bo th Posted/ Completed and Missin g Receipts
	10819	"RTN","RCD PELAR",347 ,0)
	10820	; VAUTD - Array of selecte d division s
	10821	"RTN","RCD PELAR",348 ,0)
	10822	; ^TMP("RCS ELPAY",$J) - Global Array of selected i nsurance c ompanies
	10823	"RTN","RCD PELAR",349 ,0)
	10824	; ^TMP($J," RCDPE_LAR" ,"ERA") - see output for defin ition
	10825	"RTN","RCD PELAR",350 ,0)
	10826	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	10827	"RTN","RCD PELAR",351 ,0)
	10828	; A1 - "RCDPE_LAR "
	10829	"RTN","RCD PELAR",352 ,0)
	10830	; A2 - Uppercased Payer Nam e (primary sort)
	10831	"RTN","RCD PELAR",353 ,0)
	10832	; A3 - Secondary Sort Value
	10833	"RTN","RCD PELAR",354 ,0)
	10834	; A4 - Internal I EN for fil e 344.4
	10835	"RTN","RCD PELAR",355 ,0)
	10836	; A5 - Internal I EN for sub file 344. 41
	10837	"RTN","RCD PELAR",356 ,0)
	10838	; ^TMP($J,A1 ,"ERA",A2) ="" - List of ERAs t hat were a lready pul led Where:
	10839	"RTN","RCD PELAR",357 ,0)
	10840	; A1 - "RCDPE_LAR "
	10841	"RTN","RCD PELAR",358 ,0)
	10842	; A2 - IEN of #34 4.4 (ERA # )
	10843	"RTN","RCD PELAR",359 ,0)
	10844	;
	10845	"RTN","RCD PELAR",360 ,0)
	10846	N COMPLET E,IEN3444, IEN3441,PA YER,SVAL
	10847	"RTN","RCD PELAR",361 ,0)
	10848	S IEN3444 =0
	10849	"RTN","RCD PELAR",362 ,0)
	10850	F D Q:' IEN3444
	10851	"RTN","RCD PELAR",363 ,0)
	10852	. S IEN34 44=$O(^RCY (344.4,"F" ,CURDT,IEN 3444))
	10853	"RTN","RCD PELAR",364 ,0)
	10854	. Q:'IEN3 444
	10855	"RTN","RCD PELAR",365 ,0)
	10856	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; Not a selecte d Division
	10857	"RTN","RCD PELAR",366 ,0)
	10858	. S COMPL ETE=$$COMP LETE(IEN34 44)
	10859	"RTN","RCD PELAR",367 ,0)
	10860	. I ERAFI LT=1,'COMP LETE Q ; Mis sing Recei pt
	10861	"RTN","RCD PELAR",368 ,0)
	10862	. I ERAFI LT=2,COMPL ETE Q ; Not a Missing Receipt
	10863	"RTN","RCD PELAR",369 ,0)
	10864	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pay ment From field
	10865	"RTN","RCD PELAR",370 ,0)
	10866	. S PAYER =$$UP^XLFS TR(PAYER)
	10867	"RTN","RCD PELAR",371 ,0)
	10868	. Q:'$D(^ TMP($J,"SE LPAYER",PA YER)) ; Not a selecte d payer
	10869	"RTN","RCD PELAR",372 ,0)
	10870	. Q:$D(^T MP($J,"RCD PE_LAR","E RA",IEN344 4)) ; Alr eady pulle d this ERA
	10871	"RTN","RCD PELAR",373 ,0)
	10872	. ;
	10873	"RTN","RCD PELAR",374 ,0)
	10874	. S ^TMP( $J,"RCDPE_ LAR","ERA" ,IEN3444)= ""
	10875	"RTN","RCD PELAR",375 ,0)
	10876	. S IEN34 441=0
	10877	"RTN","RCD PELAR",376 ,0)
	10878	. F D Q :'IEN34441
	10879	"RTN","RCD PELAR",377 ,0)
	10880	. . S IEN 34441=$O(^ RCY(344.4, IEN3444,1, IEN34441))
	10881	"RTN","RCD PELAR",378 ,0)
	10882	. . Q:'IE N34441
	10883	"RTN","RCD PELAR",379 ,0)
	10884	. . S SVA L=$S(SORT= 1:CURDT,1: COMPLETE) ; Get the sort value
	10885	"RTN","RCD PELAR",380 ,0)
	10886	. . S ^TM P($J,"RCDP E_LAR","SE L",PAYER,S VAL,IEN344 4,IEN34441 )=""
	10887	"RTN","RCD PELAR",381 ,0)
	10888	Q
	10889	"RTN","RCD PELAR",382 ,0)
	10890	;
	10891	"RTN","RCD PELAR",383 ,0)
	10892	COMPLETE(I EN3444) ; Checks an ERA for mi ssing rece ipts
	10893	"RTN","RCD PELAR",384 ,0)
	10894	; Input: IEN3444 - ERA to be checke d
	10895	"RTN","RCD PELAR",385 ,0)
	10896	; Returns : 0 if at least one detail lin e of the E RA has a m issing rec eipt
	10897	"RTN","RCD PELAR",386 ,0)
	10898	; 1 otherw ise
	10899	"RTN","RCD PELAR",387 ,0)
	10900	N XX
	10901	"RTN","RCD PELAR",388 ,0)
	10902	S XX=$$GE T1^DIQ(344 .4,IEN3444 ,4.02,"I") ; Auto -Post Stat us field
	10903	"RTN","RCD PELAR",389 ,0)
	10904	I XX=2 Q 1 ; Comp lete ERA
	10905	"RTN","RCD PELAR",390 ,0)
	10906	Q 0
	10907	"RTN","RCD PELAR",391 ,0)
	10908	;
	10909	"RTN","RCD PELAR",392 ,0)
	10910	ASKSTOP() ; Ask to c ontinue
	10911	"RTN","RCD PELAR",393 ,0)
	10912	; Input: IOST - Device T ype
	10913	"RTN","RCD PELAR",394 ,0)
	10914	; Returns : 1 - User wants to quit, 0 ot herwise
	10915	"RTN","RCD PELAR",395 ,0)
	10916	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
	10917	"RTN","RCD PELAR",396 ,0)
	10918	Q:$E(IOST ,1,2)'["C- " 0 ; Not a terminal
	10919	"RTN","RCD PELAR",397 ,0)
	10920	S DIR(0)= "E"
	10921	"RTN","RCD PELAR",398 ,0)
	10922	W ! D ^DI R
	10923	"RTN","RCD PELAR",399 ,0)
	10924	I ($D(DIR UT))!($D(D UOUT)) Q 1
	10925	"RTN","RCD PELAR",400 ,0)
	10926	Q 0
	10927	"RTN","RCD PELAR",401 ,0)
	10928	;
	10929	"RTN","RCD PEM")
	10930	0^11^B6234 3432^B6147 3456
	10931	"RTN","RCD PEM",1,0)
	10932	RCDPEM ;AL B/TMK/PJH - POST EFT , ERA MATC HING TO EF T ;Jun 06, 2014@19:1 1:19
	10933	"RTN","RCD PEM",2,0)
	10934	;;4.5;Acc ounts Rece ivable;1 73,255,269 ,276,283,2 98,304,318 ;Mar 20, 1995;Buil d 25
	10935	"RTN","RCD PEM",3,0)
	10936	;Per VA D irective 6 402, this routine sh ould not b e modified .
	10937	"RTN","RCD PEM",4,0)
	10938	; IA 4050 covers ca ll to SPL1 ^IBCEOBAR
	10939	"RTN","RCD PEM",5,0)
	10940	; Note - keep proce ssing in l ine with R CDPXPAP
	10941	"RTN","RCD PEM",6,0)
	10942	EN ; Post EFT deposi ts, auto-m atch EFT's and ERA's
	10943	"RTN","RCD PEM",7,0)
	10944	;
	10945	"RTN","RCD PEM",8,0)
	10946	K ^TMP($J ,"RCDPETOT "),^TMP("R CDPEAP",$J )
	10947	"RTN","RCD PEM",9,0)
	10948	; ^TMP($J ,"RCDPETOT ",344.3 or 344.31,fi le ien)=
	10949	"RTN","RCD PEM",10,0)
	10950	; (1) ma tch (0/1/- 1) (2) t otal $ ( 3) posted (0/1) (4) error ref
	10951	"RTN","RCD PEM",11,0)
	10952	; (5) EF T deposit ien 344.1 if added f or EFT
	10953	"RTN","RCD PEM",12,0)
	10954	;
	10955	"RTN","RCD PEM",13,0)
	10956	N RCZ,RCS UM,RCDEP,R ECTDA,RC0, RCER,RCDUZ ,Z,Z0,Z1,D A,X,Y,DIE, DR
	10957	"RTN","RCD PEM",14,0)
	10958	M RCDUZ=D UZ
	10959	"RTN","RCD PEM",15,0)
	10960	N DUZ S D UZ=+$O(^VA (200,"B"," EDILOCKBOX ,AUTOMATIC ",0)),DUZ( 0)="" S:'D UZ DUZ=.5
	10961	"RTN","RCD PEM",16,0)
	10962	K ^TMP($J ,"RCXM"),^ TMP($J,"RC TOT")
	10963	"RTN","RCD PEM",17,0)
	10964	S ZTREQ=" @"
	10965	"RTN","RCD PEM",18,0)
	10966	L +^RCY(3 44.3,"ALOC K"):5 I '$ T D G ENQ ; Lock re cord
	10967	"RTN","RCD PEM",19,0)
	10968	. ; Send bulletin t hat job co uld not be run
	10969	"RTN","RCD PEM",20,0)
	10970	. S ^TMP( $J,"RCXM", 1)="The ni ghtly job to post EF T deposits and match EFTs to E RAs could not be run ",^TMP($J, "RCXM",2)= "Another m atch proce ss was alr eady runni ng (lock o n ^RCY(344 .3,""ALOCK "") )"
	10971	"RTN","RCD PEM",21,0)
	10972	. D SENDB ULL^RCDPEM 1
	10973	"RTN","RCD PEM",22,0)
	10974	;
	10975	"RTN","RCD PEM",23,0)
	10976	; Post de posits for any unpos ted EFTs i n file 344 .3
	10977	"RTN","RCD PEM",24,0)
	10978	; 'Unpost ed' EFTs h ave a 0 in AMOUNT PO STED field
	10979	"RTN","RCD PEM",25,0)
	10980	S ^TMP($J ,"RCTOT"," EFT_DEP")= 0
	10981	"RTN","RCD PEM",26,0)
	10982	S RCZ=0 F S RCZ=$O (^RCY(344. 3,"APOST", 0,RCZ)) Q: 'RCZ S RC 0=$G(^RCY( 344.3,RCZ, 0)) I RC0 '="",$P(RC 0,U,8) D
	10983	"RTN","RCD PEM",27,0)
	10984	. S ^TMP( $J,"RCTOT" ,"EFT_DEP" )=^TMP($J, "RCTOT","E FT_DEP")+1
	10985	"RTN","RCD PEM",28,0)
	10986	. ; Verif y check su ms
	10987	"RTN","RCD PEM",29,0)
	10988	. S RCSUM =$$CHKSUM^ RCDPESR3(R CZ)
	10989	"RTN","RCD PEM",30,0)
	10990	. I RCSUM '=$P(RC0,U ,9) D Q
	10991	"RTN","RCD PEM",31,0)
	10992	.. ; Bull etin that check sums do not ma tch
	10993	"RTN","RCD PEM",32,0)
	10994	.. ; Upda te record error list and check sum error field
	10995	"RTN","RCD PEM",33,0)
	10996	.. S RCER (1)=$$SETE RR^RCDPEM0 (2)
	10997	"RTN","RCD PEM",34,0)
	10998	.. S RCER (2)=" Che cksum is i nvalid and the EFT d eposit rec ord is cor rupted.",R CER(3)=" Stored Che cksum = "_ $P(RC0,U,9 )_" Calcul ated Check sum: "_RCS UM,RCER(4) =" This E FT deposit cannot be sent to F MS. You m ust ask fo r it to be "
	10999	"RTN","RCD PEM",35,0)
	11000	.. S RCER (5)=" re transmitte d to your site."
	11001	"RTN","RCD PEM",36,0)
	11002	.. D BULL ^RCDPEM1(3 44.3,RC0,. RCER)
	11003	"RTN","RCD PEM",37,0)
	11004	.. S $P(^ TMP($J,"RC DPETOT",34 4.3,RCZ),U ,4)=+$G(^T MP($J,"RCX M",0))
	11005	"RTN","RCD PEM",38,0)
	11006	.. D STOR ERR^RCDPEM 0(RCZ,.RCE R)
	11007	"RTN","RCD PEM",39,0)
	11008	.. S DIE= "^RCY(344. 3,",DA=RCZ ,DR=".1/// /1" D ^DIE
	11009	"RTN","RCD PEM",40,0)
	11010	.. S ^TMP ($J,"RCTOT ","CSUM")= $G(^TMP($J ,"RCTOT"," CSUM"))+1
	11011	"RTN","RCD PEM",41,0)
	11012	. ;
	11013	"RTN","RCD PEM",42,0)
	11014	. S RCDEP =+$P(RC0,U ,3),RECTDA =+$O(^RCY( 344,"AD",R CDEP,0))
	11015	"RTN","RCD PEM",43,0)
	11016	. I RCDEP D LOCKDEP (RCDEP,1)
	11017	"RTN","RCD PEM",44,0)
	11018	. I 'RCDE P!'RECTDA D ; Add deposit an d/or recei pt to file s 344.1, 3 44
	11019	"RTN","RCD PEM",45,0)
	11020	.. I 'RCD EP D ; Ad d dep reco rd RCDEP, update fie ld .03 wit h the poin ter
	11021	"RTN","RCD PEM",46,0)
	11022	... S RCD EP=+$$ADDD EP^RCDPEM0 ($P(RC0,U, 6),$P(RC0, U,7),RCZ)
	11023	"RTN","RCD PEM",47,0)
	11024	... S ^TM P($J,"RCTO T","DEPOSI T")=$G(^TM P($J,"RCTO T","DEPOSI T"))+1
	11025	"RTN","RCD PEM",48,0)
	11026	.. ;
	11027	"RTN","RCD PEM",49,0)
	11028	.. I 'REC TDA,RCDEP D ; Add r eceipt rec ord, post to rev sou rce cd 8NZ Z
	11029	"RTN","RCD PEM",50,0)
	11030	... S REC TDA=+$$ADD REC^RCDPEM 0(RCDEP,RC Z)
	11031	"RTN","RCD PEM",51,0)
	11032	.. ;
	11033	"RTN","RCD PEM",52,0)
	11034	. I RCDEP D LOCKDEP (RCDEP,0)
	11035	"RTN","RCD PEM",53,0)
	11036	. ;
	11037	"RTN","RCD PEM",54,0)
	11038	. I 'RCDE P!'RECTDA D Q ; Co uld not ad d entry to file 344. 1 or 344
	11039	"RTN","RCD PEM",55,0)
	11040	.. ; Send a bulleti n, update error text
	11041	"RTN","RCD PEM",56,0)
	11042	.. S RCER (1)=$$SETE RR^RCDPEM0 (2),RCER(2 )=" "_$S( 'RCDEP:"Ne ither a de posit nor a receipt were able" ,1:"A rece ipt was no t able")_" to be add ed - no ma tch attemp ted"
	11043	"RTN","RCD PEM",57,0)
	11044	.. I RCDE P,'RECTDA S RCER(3)= " Deposit Ticket # created: " _$P($G(^RC Y(344.1,+$ P(RC0,U,3) ,0)),U)
	11045	"RTN","RCD PEM",58,0)
	11046	.. S RCER ($O(RCER(" "),-1)+1)= "This EFT deposit ca n't be sen t to FMS. You must ask Austin to retran smit"
	11047	"RTN","RCD PEM",59,0)
	11048	.. D BULL ^RCDPEM1(3 44.3,RC0,. RCER)
	11049	"RTN","RCD PEM",60,0)
	11050	.. S $P(^ TMP($J,"RC DPETOT",34 4.3,RCZ),U ,4)=+$G(^T MP($J,"RCX M",0))
	11051	"RTN","RCD PEM",61,0)
	11052	.. D STOR ERR^RCDPEM 0(RCZ,.RCE R)
	11053	"RTN","RCD PEM",62,0)
	11054	.. S ^TMP ($J,"RCTOT ","ERR")=$ G(^TMP($J, "RCTOT","E RR"))+1
	11055	"RTN","RCD PEM",63,0)
	11056	. ;
	11057	"RTN","RCD PEM",64,0)
	11058	. S DIE=" ^RCY(344.3 1," S Z=0 F S Z=$O( ^RCY(344.3 1,"B",RCZ, Z)) Q:'Z S DA=Z,DR= ".11////1" D ^DIE
	11059	"RTN","RCD PEM",65,0)
	11060	;
	11061	"RTN","RCD PEM",66,0)
	11062	;Update p ayer table for new p ayers - PR CA4.5298
	11063	"RTN","RCD PEM",67,0)
	11064	D NEWPYR^ RCDPESP
	11065	"RTN","RCD PEM",68,0)
	11066	;Scan Non -Released Rx Excepti ons for re leased Rx - PRCA4.5 298
	11067	"RTN","RCD PEM",69,0)
	11068	D EN^RCDP EX4
	11069	"RTN","RCD PEM",70,0)
	11070	;
	11071	"RTN","RCD PEM",71,0)
	11072	D MATCH(0 ,1)
	11073	"RTN","RCD PEM",72,0)
	11074	;
	11075	"RTN","RCD PEM",73,0)
	11076	;Auto Pos t - PRCA4 .5298
	11077	"RTN","RCD PEM",74,0)
	11078	D EN^RCDP EAP
	11079	"RTN","RCD PEM",75,0)
	11080	;Auto Dec rease - PR CA4.5298
	11081	"RTN","RCD PEM",76,0)
	11082	D EN^RCDP EAD
	11083	"RTN","RCD PEM",77,0)
	11084	;
	11085	"RTN","RCD PEM",78,0)
	11086	L -^RCY(3 44.3,"ALOC K")
	11087	"RTN","RCD PEM",79,0)
	11088	ENQ K ^TMP ($J,"RCDPE TOT"),^TMP ("RCDPEAP" ,$J)
	11089	"RTN","RCD PEM",80,0)
	11090	;
	11091	"RTN","RCD PEM",81,0)
	11092	;ePayment s 5010 par t II enhan cements
	11093	"RTN","RCD PEM",82,0)
	11094	;Create B ulletins o f EEOB Mov ed or Copi ed today
	11095	"RTN","RCD PEM",83,0)
	11096	D EN^RCDP EM8
	11097	"RTN","RCD PEM",84,0)
	11098	Q
	11099	"RTN","RCD PEM",85,0)
	11100	;
	11101	"RTN","RCD PEM",86,0)
	11102	MATCH(RCMA N,RCPROC) ; match un matched EF Ts with ER As
	11103	"RTN","RCD PEM",87,0)
	11104	; RCMAN = 1 if job run manual ly, outsid e of night ly process ing
	11105	"RTN","RCD PEM",88,0)
	11106	; RCPROC = 1 if cal led from E FT-EOB aut omatch, 0 if from ma nual match
	11107	"RTN","RCD PEM",89,0)
	11108	;
	11109	"RTN","RCD PEM",90,0)
	11110	N RC0,RCE R,RCZ,RCHA C
	11111	"RTN","RCD PEM",91,0)
	11112	I '$O(^RC Y(344.31," AMATCH",0, 0)) D G M ATCHQ
	11113	"RTN","RCD PEM",92,0)
	11114	. ; Send bulletin - no unmatc hed EFTs f ound
	11115	"RTN","RCD PEM",93,0)
	11116	. N RCT
	11117	"RTN","RCD PEM",94,0)
	11118	. S RCT=+ $O(^TMP($J ,"RCXM"," "),-1)+1
	11119	"RTN","RCD PEM",95,0)
	11120	. S ^TMP( $J,"RCXM", RCT)=$S('$ G(RCMAN):" The nightl y job",1:" The manual option")_ " to match EFTs has found no E FTs are cu rrently un matched on your syst em"
	11121	"RTN","RCD PEM",96,0)
	11122	. I $G(RC MAN) S ^TM P($J,"RCXM ",RCT+1)=" The action was initi ated by "_ $P($G(^VA( 200,DUZ,0) ),U)
	11123	"RTN","RCD PEM",97,0)
	11124	. D SENDB ULL^RCDPEM 1
	11125	"RTN","RCD PEM",98,0)
	11126	;
	11127	"RTN","RCD PEM",99,0)
	11128	S RCZ=0 F S RCZ=$O (^RCY(344. 31,"AMATCH ",0,RCZ)) Q:'RCZ D
	11129	"RTN","RCD PEM",100,0 )
	11130	. K RCER
	11131	"RTN","RCD PEM",101,0 )
	11132	. S RC0=$ G(^RCY(344 .31,RCZ,0) ),RCHAC=($ E($P($G(^R CY(344.3,+ RC0,0)),U, 6),1,3)="H AC")
	11133	"RTN","RCD PEM",102,0 )
	11134	. Q:RC0=" " ; Bad x ref
	11135	"RTN","RCD PEM",103,0 )
	11136	. Q:$S('R CHAC:'$P(R C0,U,11),1 :0) ; EFT deposit m ust have b een record ed
	11137	"RTN","RCD PEM",104,0 )
	11138	. S ^TMP( $J,"RCTOT" ,"EFT")=$G (^TMP($J," RCTOT","EF T"))+1
	11139	"RTN","RCD PEM",105,0 )
	11140	. I RCHAC S ^TMP($J ,"RCTOT"," EFT_HAC")= $G(^TMP($J ,"RCTOT"," EFT_HAC")) +1
	11141	"RTN","RCD PEM",106,0 )
	11142	. S ^TMP( $J,"RCDPET OT",344.31 ,RCZ)=""
	11143	"RTN","RCD PEM",107,0 )
	11144	. ;
	11145	"RTN","RCD PEM",108,0 )
	11146	. D MATCH ^RCDPEM0(R CZ,RCPROC)
	11147	"RTN","RCD PEM",109,0 )
	11148	;
	11149	"RTN","RCD PEM",110,0 )
	11150	I '$O(^TM P($J,"RCXM ",0)) K RC ER S RCER( 1)="",RCER (2)="NO EX CEPTIONS W HILE MATCH ING EFTs-E RAs OR IN RECORDING THE DEPOSI TS TO FMS" D BULL^RC DPEM1(""," ",.RCER) K RCER
	11151	"RTN","RCD PEM",111,0 )
	11152	D EN2^RCD PEM1,BULL^ RCDPEM1("" ,"",.RCER)
	11153	"RTN","RCD PEM",112,0 )
	11154	D SENDBUL L^RCDPEM1
	11155	"RTN","RCD PEM",113,0 )
	11156	;
	11157	"RTN","RCD PEM",114,0 )
	11158	MATCHQ K ^ TMP($J,"RC DPETOT"),^ TMP($J,"RC TOT")
	11159	"RTN","RCD PEM",115,0 )
	11160	Q
	11161	"RTN","RCD PEM",116,0 )
	11162	;
	11163	"RTN","RCD PEM",117,0 )
	11164	LOCKDEP(RC DEP,LOCK) ; Lock/con firm depos it ien RCD EP file 34 1.1
	11165	"RTN","RCD PEM",118,0 )
	11166	; If LOCK = 1 lock deposit
	11167	"RTN","RCD PEM",119,0 )
	11168	; If LOCK = 0 unloc k deposit
	11169	"RTN","RCD PEM",120,0 )
	11170	I $G(LOCK ) D
	11171	"RTN","RCD PEM",121,0 )
	11172	. L +^RCY (344.1,RCD EP,0):DILO CKTM
	11173	"RTN","RCD PEM",122,0 )
	11174	. D CONFI RM^RCDPUDE P(RCDEP) ; confirm t o prevent changes
	11175	"RTN","RCD PEM",123,0 )
	11176	I '$G(LOC K) L -^RCY (344.1,RCD EP,0)
	11177	"RTN","RCD PEM",124,0 )
	11178	Q
	11179	"RTN","RCD PEM",125,0 )
	11180	;
	11181	"RTN","RCD PEM",126,0 )
	11182	RCPTDET(RC RZ,RECTDA1 ,RCER) ; A dds detail to a rece ipt based on file 34 4.49
	11183	"RTN","RCD PEM",127,0 )
	11184	; RCRZ = ien of ERA entry in file 344.4 9
	11185	"RTN","RCD PEM",128,0 )
	11186	; RECTDA1 = ien of receipt en try in fil e 344
	11187	"RTN","RCD PEM",129,0 )
	11188	; RCER = error arra y returned if passed by refere nce
	11189	"RTN","RCD PEM",130,0 )
	11190	;
	11191	"RTN","RCD PEM",131,0 )
	11192	N DA,DIE, DR,Q,RCR,R CSPL,RCZ0, RCTRANDA,R CQ,X,Y,Z0, Z1,Z ; PRC A4.5318
	11193	"RTN","RCD PEM",132,0 )
	11194	;
	11195	"RTN","RCD PEM",133,0 )
	11196	S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D
	11197	"RTN","RCD PEM",134,0 )
	11198	. S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0))
	11199	"RTN","RCD PEM",135,0 )
	11200	. I $P(RC Z0,U)'["." S RCSPL(+ RCZ0)=$P(R CZ0,U,9) Q
	11201	"RTN","RCD PEM",136,0 )
	11202	. I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q
	11203	"RTN","RCD PEM",137,0 )
	11204	. S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 )
	11205	"RTN","RCD PEM",138,0 )
	11206	. ;
	11207	"RTN","RCD PEM",139,0 )
	11208	. I RCTRA NDA'>0 D Q ; Error adding re ceipt deta il - PRCA* 4.5*318
	11209	"RTN","RCD PEM",140,0 )
	11210	.. S RCER (1)=$$SETE RR^RCDPEM0 (1) ; PRCA 4.5318 - pass RCPR OC value t o $$SETERR
	11211	"RTN","RCD PEM",141,0 )
	11212	.. S RCER ($O(RCER(" "),-1)+1)= " NO DETA IL LINE AD DED TO REC EIPT "_$P( $G(^RCY(34 4,RECTDA1, 0)),U)_" F OR LINE #" _$P(RCZ0,U )_" IN EEO B WORKLIST SCRATCH P AD"
	11213	"RTN","RCD PEM",142,0 )
	11214	. ;
	11215	"RTN","RCD PEM",143,0 )
	11216	. ;Store receipt li ne detail
	11217	"RTN","RCD PEM",144,0 )
	11218	. D DET(R CRZ,RCR,RE CTDA1,RCTR ANDA)
	11219	"RTN","RCD PEM",145,0 )
	11220	. S RCSPL (RCZ0\1,+R CZ0)=RCZ0
	11221	"RTN","RCD PEM",146,0 )
	11222	S Z=0 F S Z=$O(RCS PL(Z)) Q:' Z S RCQ=+ $G(RCSPL(Z )) I RCQ D
	11223	"RTN","RCD PEM",147,0 )
	11224	.;;Move E EOB if one claim ent ered-chang ed 10/19/1 1-see +25^ RCDPEWL8
	11225	"RTN","RCD PEM",148,0 )
	11226	. S Z1=$O (RCSPL(Z," ")) Q:Z1=" "
	11227	"RTN","RCD PEM",149,0 )
	11228	. I $O(RC SPL(Z,""), -1)=Z1,'$$ SPLIT(Z,Z1 ,RCERA) Q ; No spli t occurred
	11229	"RTN","RCD PEM",150,0 )
	11230	. S Z1=0 F S Z1=$O (RCSPL(Z,Z 1)) Q:'Z1 S Z0=$G(R CSPL(Z,Z1) ) D
	11231	"RTN","RCD PEM",151,0 )
	11232	.. S Q=+$ P($G(^RCY( 344.4,RCRZ ,1,RCQ,0)) ,U,2) ; EO B detail r ec
	11233	"RTN","RCD PEM",152,0 )
	11234	.. Q:'Q
	11235	"RTN","RCD PEM",153,0 )
	11236	.. I '$P( Z0,U,7)!($ P(Z0,U,2)= "") D ; S uspensed
	11237	"RTN","RCD PEM",154,0 )
	11238	... D SPL 1^IBCEOBAR (Q,$S($P(Z 0,U,2)="": "NO BILL", 1:$P(Z0,U, 2)),"",$P( Z0,U,6)) ; IA 4050
	11239	"RTN","RCD PEM",155,0 )
	11240	.. E D
	11241	"RTN","RCD PEM",156,0 )
	11242	... D SPL 1^IBCEOBAR (Q,$P(Z0,U ,2),$P(Z0, U,7),$P(Z0 ,U,6)) ; A dd the spl it bill # ; IA 4050
	11243	"RTN","RCD PEM",157,0 )
	11244	;
	11245	"RTN","RCD PEM",158,0 )
	11246	Q
	11247	"RTN","RCD PEM",159,0 )
	11248	SPLIT(Z,Z1 ,RCERA) ;C heck if wo rklist was split but to to sin gle claim
	11249	"RTN","RCD PEM",160,0 )
	11250	N SUB,NBI LL,OBILL
	11251	"RTN","RCD PEM",161,0 )
	11252	;Find spl it line in scratchpa d
	11253	"RTN","RCD PEM",162,0 )
	11254	S SUB=$O( ^RCY(344.4 9,RCERA,1, "B",Z1,"") ) Q:'SUB 0
	11255	"RTN","RCD PEM",163,0 )
	11256	;Get orig inal claim number fr om scratch pad
	11257	"RTN","RCD PEM",164,0 )
	11258	S OBILL=$ P($G(^RCY( 344.49,RCE RA,1,SUB-1 ,0)),U,2)
	11259	"RTN","RCD PEM",165,0 )
	11260	;New clai m number
	11261	"RTN","RCD PEM",166,0 )
	11262	S NBILL=$ P(RCSPL(Z, Z1),U,2)
	11263	"RTN","RCD PEM",167,0 )
	11264	;If new a nd old cla im are not the same this is a move via s plit
	11265	"RTN","RCD PEM",168,0 )
	11266	I OBILL'= "",OBILL'= NBILL Q 1
	11267	"RTN","RCD PEM",169,0 )
	11268	;Otherwis e this is not a spli t
	11269	"RTN","RCD PEM",170,0 )
	11270	Q 0
	11271	"RTN","RCD PEM",171,0 )
	11272	;
	11273	"RTN","RCD PEM",172,0 )
	11274	DET(RCZ,RC R,RECTDA1, RCTRANDA) ; Store re ceipt deta il
	11275	"RTN","RCD PEM",173,0 )
	11276	; RCZ = i en of entr y file 344 .49
	11277	"RTN","RCD PEM",174,0 )
	11278	; RCR = i en of entr y in file 344.491
	11279	"RTN","RCD PEM",175,0 )
	11280	; RCPROC = Function calling t his subrou tine
	11281	"RTN","RCD PEM",176,0 )
	11282	; = 1 EFT ma tch to ERA = 0 man ual add re ceipt
	11283	"RTN","RCD PEM",177,0 )
	11284	; RECTDA1 = ien of entry in f ile 344
	11285	"RTN","RCD PEM",178,0 )
	11286	; RCTRAND A = ien of entry in subfile 34 4.01
	11287	"RTN","RCD PEM",179,0 )
	11288	;
	11289	"RTN","RCD PEM",180,0 )
	11290	N DIE,DA, DR,X,Y,Z,R CUP,RCCOM, RCZ0,RC0
	11291	"RTN","RCD PEM",181,0 )
	11292	S RC0=$G( ^RCY(344.4 9,RCZ,0))
	11293	"RTN","RCD PEM",182,0 )
	11294	S RCZ0=$G (^RCY(344. 49,RCZ,1,R CR,0))
	11295	"RTN","RCD PEM",183,0 )
	11296	S DR="",R CUP=+$O(^R CY(344.49, RCZ,1,"B", +RCZ0/1,0) ),RCUP=$G( ^RCY(344.4 9,RCZ,1,RC UP,0))
	11297	"RTN","RCD PEM",184,0 )
	11298	I $P(RCZ0 ,U,7) S DR =".09////^ S X="_+$P( RCZ0,U,7)_ "_$C(59)_" "PRCA(430, "";"
	11299	"RTN","RCD PEM",185,0 )
	11300	S DR=DR_" .04////"_( +$P(RCZ0,U ,3))_";.27 ////"_RCR_ ";"
	11301	"RTN","RCD PEM",186,0 )
	11302	I $P(RC0, U,5)'="" S DR=DR_".1 ////"_$P(R C0,U,5)_"; "
	11303	"RTN","RCD PEM",187,0 )
	11304	I $P(RC0, U,6)'="" S DR=DR_".0 8////"_$P( RC0,U,6)_" ;"
	11305	"RTN","RCD PEM",188,0 )
	11306	S Z=0 F S Z=$O(^RC Y(344.49,R CZ,1,RCR,1 ,Z)) Q:'Z I $P($G(^ (Z,0)),U,5 )=1 S DR=D R_".28//// 1;" Q ; U pdate rece ipt line w ith dec ad j flag
	11307	"RTN","RCD PEM",189,0 )
	11308	S RCCOM=$ P(RCZ0,U,1 0)
	11309	"RTN","RCD PEM",190,0 )
	11310	I $P(RCUP ,U,2)["**A DJ" S RCCO M=RCCOM_$S (RCCOM'="" :"/",1:"") _$S($P($P( RCUP,U,2), "ADJ",2):" ERA adjust ment - no bill refer enced",1:" Total of E FT mismatc hed to ERA ")
	11311	"RTN","RCD PEM",191,0 )
	11312	I RCCOM]" " S DR=DR_ "1.02////" _$E(RCCOM, 1,60)_";"
	11313	"RTN","RCD PEM",192,0 )
	11314	I $P($G(^ RCY(344.49 ,RCZ,0)),U ,4)'="" S DR=DR_".07 ////"_$P($ G(^RCY(344 .49,RCZ,0) ),U,4)_";"
	11315	"RTN","RCD PEM",193,0 )
	11316	S DA(1)=R ECTDA1,DA= RCTRANDA,D IE="^RCY(3 44,"_DA(1) _",1,"
	11317	"RTN","RCD PEM",194,0 )
	11318	D ^DIE
	11319	"RTN","RCD PEM",195,0 )
	11320	Q
	11321	"RTN","RCD PEM",196,0 )
	11322	;
	11323	"RTN","RCD PEM1")
	11324	0^12^B5144 6445^B5072 0523
	11325	"RTN","RCD PEM1",1,0)
	11326	RCDPEM1 ;A LB/TMK,DWA ,PJH - ERA MATCH TO EFT (cont) ; 5/5/11 1:25pm
	11327	"RTN","RCD PEM1",2,0)
	11328	;;4.5;Acc ounts Rece ivable;1 73,269,318 ;Mar 20, 1995;Buil d 25
	11329	"RTN","RCD PEM1",3,0)
	11330	;;Per VA Directive 6402, this routine s hould not be modifie d.
	11331	"RTN","RCD PEM1",4,0)
	11332	Q
	11333	"RTN","RCD PEM1",5,0)
	11334	;
	11335	"RTN","RCD PEM1",6,0)
	11336	BULL(RCFIL E,RC0,RCER ) ; Add th e error to the bulle tin text a rray
	11337	"RTN","RCD PEM1",7,0)
	11338	; RCFILE = null, 34 4.3 or 344 .31, depen ding on th e file bei ng worked
	11339	"RTN","RCD PEM1",8,0)
	11340	; RC0 = t he 0-node of the RCF ILE entry
	11341	"RTN","RCD PEM1",9,0)
	11342	; RCER = the error text to be placed in the bulle tin (passe d by ref)
	11343	"RTN","RCD PEM1",10,0 )
	11344	;
	11345	"RTN","RCD PEM1",11,0 )
	11346	N RCHCT,C T,Z
	11347	"RTN","RCD PEM1",12,0 )
	11348	I '$O(^TM P($J,"RCXM ",0)) S ^T MP($J,"RCX M",1)="The following exception s were enc ountered a ttempting" ,^TMP($J," RCXM",2)=" to post EF T deposits OR to mat ch EFT's w ith ERA's: ",^TMP($J, "RCXM",3)= " "
	11349	"RTN","RCD PEM1",13,0 )
	11350	S (RCHCT, CT)=+$O(^T MP($J,"RCX M",""),-1)
	11351	"RTN","RCD PEM1",14,0 )
	11352	S ^TMP($J ,"RCXM",0) =$G(^TMP($ J,"RCXM",0 ))+1
	11353	"RTN","RCD PEM1",15,0 )
	11354	I RC0'="" D
	11355	"RTN","RCD PEM1",16,0 )
	11356	. D BLD(" ^TMP($J,"" RCXM"")",. CT,RCFILE, RC0)
	11357	"RTN","RCD PEM1",17,0 )
	11358	. S RCER= $G(RCER)+1 ,RCHCT=RCH CT+1
	11359	"RTN","RCD PEM1",18,0 )
	11360	. S ^TMP( $J,"RCXM", RCHCT)=$E( ^TMP($J,"R CXM",0)_$J ("",4),1,4 )_$G(^TMP( $J,"RCXM", RCHCT))
	11361	"RTN","RCD PEM1",19,0 )
	11362	S Z=1 F S Z=$O(RCE R(Z)) Q:'Z S CT=CT+ 1,^TMP($J, "RCXM",CT) =" "_RCER (Z)
	11363	"RTN","RCD PEM1",20,0 )
	11364	S CT=CT+1 ,^TMP($J," RCXM",CT)= " "
	11365	"RTN","RCD PEM1",21,0 )
	11366	Q
	11367	"RTN","RCD PEM1",22,0 )
	11368	;
	11369	"RTN","RCD PEM1",23,0 )
	11370	SENDBULL ; Sends the bulletin when all p rocessing is complet e
	11371	"RTN","RCD PEM1",24,0 )
	11372	N XMBODY, XMB,XMINST R,XMTYPE,X MFULL,XMTO ,XMZ,XMERR ,XMSUBJ
	11373	"RTN","RCD PEM1",25,0 )
	11374	S XMTO("I :G.RCDPE P AYMENTS")= ""
	11375	"RTN","RCD PEM1",26,0 )
	11376	S XMBODY= "^TMP($J," "RCXM"")"
	11377	"RTN","RCD PEM1",27,0 )
	11378	S XMSUBJ= "EDI LBOX "_$$FMTE^X LFDT(DT,2) _" EXCEPTI ONS EFT DE P/MATCH EF Ts TO ERAs "
	11379	"RTN","RCD PEM1",28,0 )
	11380	D ;
	11381	"RTN","RCD PEM1",29,0 )
	11382	. N DUZ
	11383	"RTN","RCD PEM1",30,0 )
	11384	. S DUZ=. 5,DUZ(0)=" @"
	11385	"RTN","RCD PEM1",31,0 )
	11386	. D SENDM SG^XMXAPI( .5,XMSUBJ, XMBODY,.XM TO,,.XMZ)
	11387	"RTN","RCD PEM1",32,0 )
	11388	K ^TMP($J ,"RCXM")
	11389	"RTN","RCD PEM1",33,0 )
	11390	Q
	11391	"RTN","RCD PEM1",34,0 )
	11392	;
	11393	"RTN","RCD PEM1",35,0 )
	11394	BLD(RCARRA Y,RCT,RCFI LE,RC0) ; Build the array for entry 344. 31 detail
	11395	"RTN","RCD PEM1",36,0 )
	11396	; RCARRAY = the nam e of the a rray to be set
	11397	"RTN","RCD PEM1",37,0 )
	11398	; RCT = t he # of li nes alread y output i nto this a rray
	11399	"RTN","RCD PEM1",38,0 )
	11400	; RCFILE = 344.3 or 344.31
	11401	"RTN","RCD PEM1",39,0 )
	11402	; RC0 = t he 0-node of the ent ry in RCFI LE
	11403	"RTN","RCD PEM1",40,0 )
	11404	;
	11405	"RTN","RCD PEM1",41,0 )
	11406	N Z,RC00
	11407	"RTN","RCD PEM1",42,0 )
	11408	I RCFILE= 344.31 D
	11409	"RTN","RCD PEM1",43,0 )
	11410	. S RC00= $G(^RCY(34 4.3,+RC0,0 ))
	11411	"RTN","RCD PEM1",44,0 )
	11412	. S Z=$$S ETSTR^VALM 1(" TRACE #: "_$P(R C0,U,4),"" ,1,61) ; E xpand Trac e # to 50 characters
	11413	"RTN","RCD PEM1",45,0 )
	11414	. S RCT=R CT+1,@RCAR RAY@(RCT)= Z ; for In s. Co. bel ow
	11415	"RTN","RCD PEM1",46,0 )
	11416	. S Z=$$S ETSTR^VALM 1(" INS C O: "_$E($P (RC0,U,2), 1,22)_"/"_ $P(RC0,U,3 ),"",1,76)
	11417	"RTN","RCD PEM1",47,0 )
	11418	. S RCT=R CT+1,@RCAR RAY@(RCT)= Z
	11419	"RTN","RCD PEM1",48,0 )
	11420	. S Z=$$S ETSTR^VALM 1(" DEPOS IT DATE: " _$$FMTE^XL FDT($P(RC0 0,U,7),2), "",1,24)
	11421	"RTN","RCD PEM1",49,0 )
	11422	. S Z=$$S ETSTR^VALM 1(" DATE REC'D: "_$ S($P(RC00, U,13):$$FM TE^XLFDT($ P(RC00,U,1 3)\1,2),1: ""),Z,25,2 2)
	11423	"RTN","RCD PEM1",50,0 )
	11424	. S Z=$$S ETSTR^VALM 1(" PAYME NT AMT: "_ $TR($J($P( RC0,U,7),1 5,2)," "), Z,47,30)
	11425	"RTN","RCD PEM1",51,0 )
	11426	. S RCT=R CT+1,@RCAR RAY@(RCT)= Z
	11427	"RTN","RCD PEM1",52,0 )
	11428	;
	11429	"RTN","RCD PEM1",53,0 )
	11430	I RCFILE= 344.3 D
	11431	"RTN","RCD PEM1",54,0 )
	11432	. S Z=$$S ETSTR^VALM 1(" DEPOS IT #: "_$P (RC0,U,6), "",1,13)
	11433	"RTN","RCD PEM1",55,0 )
	11434	. S Z=$$S ETSTR^VALM 1(" DEPOS IT DATE: " _$$FMTE^XL FDT($P(RC0 ,U,7),2),Z ,16,24)
	11435	"RTN","RCD PEM1",56,0 )
	11436	. S RCT=R CT+1,@RCAR RAY@(RCT)= Z
	11437	"RTN","RCD PEM1",57,0 )
	11438	. S Z=$$S ETSTR^VALM 1(" DATE REC'D: "_$ S($P(RC0,U ,13):$$FMT E^XLFDT($P (RC0,U,13) \1,2),1:"" ),"",25,22 )
	11439	"RTN","RCD PEM1",58,0 )
	11440	. S Z=$$S ETSTR^VALM 1(" DEPOS IT AMT: "_ $TR($J($P( RC0,U,8),1 5,2)," "), Z,47,30)
	11441	"RTN","RCD PEM1",59,0 )
	11442	. S RCT=R CT+1,@RCAR RAY@(RCT)= Z
	11443	"RTN","RCD PEM1",60,0 )
	11444	;
	11445	"RTN","RCD PEM1",61,0 )
	11446	Q
	11447	"RTN","RCD PEM1",62,0 )
	11448	;
	11449	"RTN","RCD PEM1",63,0 )
	11450	EN1 ; Queu e match jo b for run on demand
	11451	"RTN","RCD PEM1",64,0 )
	11452	N DIR,X,Y ,ZTIO,ZTRT N,ZTSK,ZTD ESC,ZTDTH
	11453	"RTN","RCD PEM1",65,0 )
	11454	S DIR(0)= "YA",DIR(" A",1)="THI S OPTION Q UEUES THE JOB TO MAT CH EFTs TO ELECTRONI C ERAs"
	11455	"RTN","RCD PEM1",66,0 )
	11456	S DIR("A" )="ARE YOU SURE YOU WANT TO RU N THIS JOB ?: ",DIR(" B")="NO"
	11457	"RTN","RCD PEM1",67,0 )
	11458	W ! D ^DI R K DIR
	11459	"RTN","RCD PEM1",68,0 )
	11460	I Y'=1 G EN1Q
	11461	"RTN","RCD PEM1",69,0 )
	11462	L +^RCY(3 44.3,"ALOC K"):5 I '$ T D G EN1 Q
	11463	"RTN","RCD PEM1",70,0 )
	11464	. S DIR(0 )="EA",DIR ("A",1)="T his job is currently running . .. try aga in later", DIR("A")=" Press ENTE R to conti nue: " D ^ DIR K DIR
	11465	"RTN","RCD PEM1",71,0 )
	11466	S ZTIO="" ,ZTDTH=$$N OW^XLFDT()
	11467	"RTN","RCD PEM1",72,0 )
	11468	S ZTRTN=" MATCH^RCDP EM(1,1)",Z TDESC="AR - MANUAL E FT-ERA MAT CH EDI LOC KBOX"
	11469	"RTN","RCD PEM1",73,0 )
	11470	D ^%ZTLOA D
	11471	"RTN","RCD PEM1",74,0 )
	11472	W !!,$S($ D(ZTSK):"Y our job ha s been que ued - task number "_ ZTSK,1:"Un able to qu eue this j ob.")
	11473	"RTN","RCD PEM1",75,0 )
	11474	U IO
	11475	"RTN","RCD PEM1",76,0 )
	11476	EN1Q L -^R CY(344.3," ALOCK")
	11477	"RTN","RCD PEM1",77,0 )
	11478	Q
	11479	"RTN","RCD PEM1",78,0 )
	11480	;
	11481	"RTN","RCD PEM1",79,0 )
	11482	EN2 ; Entr ypoint fro m nightly job to put Nightly a nd Daily A ctivity Re port
	11483	"RTN","RCD PEM1",80,0 )
	11484	; data in to the nig htly job's status bu lletin
	11485	"RTN","RCD PEM1",81,0 )
	11486	N CT,DATA ,Z,Z0,RCHD ,T,T0
	11487	"RTN","RCD PEM1",82,0 )
	11488	S CT=+$O( ^TMP($J,"R CXM",""),- 1)
	11489	"RTN","RCD PEM1",83,0 )
	11490	S CT=CT+1 ,^TMP($J," RCXM",CT)= ""
	11491	"RTN","RCD PEM1",84,0 )
	11492	I $D(^TMP ($J,"RCTOT ","EFT_DEP ")) D
	11493	"RTN","RCD PEM1",85,0 )
	11494	. S CT=CT +1,^TMP($J ,"RCXM",CT )=$J("",12 )_"***** * TOTALS ********* *"
	11495	"RTN","RCD PEM1",86,0 )
	11496	. S CT=CT +1,^TMP($J ,"RCXM",CT )="DEPOSIT S"
	11497	"RTN","RCD PEM1",87,0 )
	11498	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL # UNPOSTE D EFT DEPO SITS FOUND : "_+$G(^T MP($J,"RCT OT","EFT_D EP"))
	11499	"RTN","RCD PEM1",88,0 )
	11500	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL # NEW EFT DEPOSITS CREATED: " _+$G(^TMP( $J,"RCTOT" ,"DEPOSIT" ))
	11501	"RTN","RCD PEM1",89,0 )
	11502	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL # NEW EFT DEPOSIT R ECEIPTS CR EATED: "_+ $G(^TMP($J ,"RCTOT"," EFT_RECPT" ))
	11503	"RTN","RCD PEM1",90,0 )
	11504	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL # EFT DEP OSITS WITH CHECK SUM ERRORS: " _+$G(^TMP( $J,"RCTOT" ,"CSUM"))
	11505	"RTN","RCD PEM1",91,0 )
	11506	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL # EFT DEP OSITS WITH OTHER ERR ORS: "_+$G (^TMP($J," RCTOT","ER R"))
	11507	"RTN","RCD PEM1",92,0 )
	11508	. S CT=CT +1,^TMP($J ,"RCXM",CT )=" TOTAL EFT DEPOS IT AMOUNT POSTED TO REV SRC CD 8NZZ: "_$ J(+$G(^TMP ($J,"RCTOT ","SUSPAMT ")),"",2)
	11509	"RTN","RCD PEM1",93,0 )
	11510	. S CT=CT +1,^TMP($J ,"RCXM",CT )=""
	11511	"RTN","RCD PEM1",94,0 )
	11512	S CT=CT+1 ,^TMP($J," RCXM",CT)= "EFT-ERA M ATCHES"
	11513	"RTN","RCD PEM1",95,0 )
	11514	S CT=CT+1 ,^TMP($J," RCXM",CT)= " TOTAL # UNMATCHED ERAs CHEC KED: "_+$G (^TMP($J," RCTOT","EF T"))
	11515	"RTN","RCD PEM1",96,0 )
	11516	S CT=CT+1 ,^TMP($J," RCXM",CT)= " TOTAL # ERAs MATC HED TO EFT s: "_+$G(^ TMP($J,"RC TOT","MATC H"))_$S($G (^TMP($J," RCTOT","MA TCH"))&$G( ^TMP($J,"R CTOT","TOT MIS")):" I NCLUDING " _+$G(^TMP( $J,"RCTOT" ,"TOTMIS") )_" WITH M ISMATCHED TOTALS",1: "")
	11517	"RTN","RCD PEM1",97,0 )
	11518	S CT=CT+1 ,^TMP($J," RCXM",CT)= " TOTAL # ERAs STIL L UNMATCHE D: "_+$G(^ TMP($J,"RC TOT","NO_M ATCH"))
	11519	"RTN","RCD PEM1",98,0 )
	11520	S CT=CT+1 ,^TMP($J," RCXM",CT)= ""
	11521	"RTN","RCD PEM1",99,0 )
	11522	K ^TMP("R CDAILYACT" ,$J),^TMP( $J,"RC1")
	11523	"RTN","RCD PEM1",100, 0)
	11524	;
	11525	"RTN","RCD PEM1",101, 0)
	11526	S Z=0 F S Z=$O(^TM P($J,"RCDP ETOT",344. 31,Z)) Q:' Z S Z0=$G (^RCY(344. 31,Z,0)) I Z0 S ^TMP ($J,"RC1", +Z0,Z)=Z0
	11527	"RTN","RCD PEM1",102, 0)
	11528	;
	11529	"RTN","RCD PEM1",103, 0)
	11530	S (RCHD,Z )=0 F S Z =$O(^TMP($ J,"RCDPETO T",344.3,Z )) Q:'Z S DATA=$G(^ (Z)) D
	11531	"RTN","RCD PEM1",104, 0)
	11532	. I 'RCHD D HDR(.CT ,.RCHD) ; Add header s
	11533	"RTN","RCD PEM1",105, 0)
	11534	. S Z0=$G (^RCY(344. 3,Z,0))
	11535	"RTN","RCD PEM1",106, 0)
	11536	. S CT=CT +1
	11537	"RTN","RCD PEM1",107, 0)
	11538	. S ^TMP( $J,"RCXM", CT)=""
	11539	"RTN","RCD PEM1",108, 0)
	11540	. I '$G(D ATA) D
	11541	"RTN","RCD PEM1",109, 0)
	11542	.. S CT=C T+1
	11543	"RTN","RCD PEM1",110, 0)
	11544	.. S ^TMP ($J,"RCXM" ,CT)=^TMP( $J,"RCXM", CT)_" "_$ E($P($G(^R CY(344.1,+ $P(Z0,U,3) ,0)),U)_$J ("",15),1, 15)_" "_$ E($P($G(^R CY(344,+$O (^RCY(344, "AD",+$P(Z 0,U,3),0)) ,0)),U)_$J ("",15),1, 15)_" "
	11545	"RTN","RCD PEM1",111, 0)
	11546	.. S ^TMP ($J,"RCXM" ,CT)=^TMP( $J,"RCXM", CT)_$J(+$P (Z0,U,12), "",2)
	11547	"RTN","RCD PEM1",112, 0)
	11548	. I $G(DA TA) D
	11549	"RTN","RCD PEM1",113, 0)
	11550	.. S ^TMP ($J,"RCXM" ,CT)=^TMP( $J,"RCXM", CT)_" "_$ E($P($G(^R CY(344.1,+ $P(DATA,U, 5),0)),U)_ $J("",15), 1,15)_" " _$E($S($P( DATA,U,5): $P($G(^RCY (344,+DATA ,0)),U),1: "")_$J("", 15),1,15)_ " "
	11551	"RTN","RCD PEM1",114, 0)
	11552	.. S ^TMP ($J,"RCXM" ,CT)=^TMP( $J,"RCXM", CT)_$J($S( $P(DATA,U, 3):+$P(DAT A,U,2),1:0 ),"",2)
	11553	"RTN","RCD PEM1",115, 0)
	11554	. I $P(DA TA,U,4) S CT=CT+1,^T MP($J,"RCX M",CT)=" ERROR # REFERENCED ABOVE : " _$P(DATA,U ,4)
	11555	"RTN","RCD PEM1",116, 0)
	11556	. S T=0 F S T=$O(^ TMP($J,"RC 1",Z,T)) Q :'T S T0= $G(^(T)) D
	11557	"RTN","RCD PEM1",117, 0)
	11558	.. S CT=C T+1
	11559	"RTN","RCD PEM1",118, 0)
	11560	.. S ^TMP ($J,"RCXM" ,CT)=$J("" ,5)_$P(T0, U,4)
	11561	"RTN","RCD PEM1",119, 0)
	11562	.. S CT=C T+1 ; sepa rate TRACE # above f rom PAYER NAME/ID be low
	11563	"RTN","RCD PEM1",120, 0)
	11564	.. S ^TMP ($J,"RCXM" ,CT)=$J("" ,5)_$P(T0, U,2)_"/"_$ P(T0,U,3)
	11565	"RTN","RCD PEM1",121, 0)
	11566	.. S CT=C T+1,^TMP($ J,"RCXM",C T)=$J("",1 0)_"PAYMEN T AMOUNT: "_$J(+$P(T 0,U,7),"", 2)_" MATC H STATUS: "_$$EXTERN AL^DILFD(3 44.31,.08, ,$P(T0,U,8 ))
	11567	"RTN","RCD PEM1",122, 0)
	11568	.. S:$O(^ TMP($J,"RC DPETOT",34 4.3,Z)) CT =CT+1,^TMP ($J,"RCXM" ,CT)=" "
	11569	"RTN","RCD PEM1",123, 0)
	11570	. I $P(DA TA,U,3) S ^TMP("RCDA ILYACT",$J ,DT,Z)=Z0
	11571	"RTN","RCD PEM1",124, 0)
	11572	;
	11573	"RTN","RCD PEM1",125, 0)
	11574	K ^TMP($J ,"RC1")
	11575	"RTN","RCD PEM1",126, 0)
	11576	I $O(^TMP ("RCDAILYA CT",$J,0)) D ; Dail y activity rep autom atic bulle tin
	11577	"RTN","RCD PEM1",127, 0)
	11578	. N XMBOD Y,XMB,XMIN STR,XMTYPE ,XMFULL,XM TO,XMZ,XME RR,XMSUBJ
	11579	"RTN","RCD PEM1",128, 0)
	11580	. K ^TMP( $J,"RCDPE_ DAR")
	11581	"RTN","RCD PEM1",129, 0)
	11582	. D RPT1^ RCDPEDAR(" 1^0^0^0^0^ "_DT_"^"_D T) ;PRCA* 4.5*318, c hanged the parameter s
	11583	"RTN","RCD PEM1",130, 0)
	11584	. K ^TMP( "RCDAILYAC T",$J)
	11585	"RTN","RCD PEM1",131, 0)
	11586	. Q:'$O(^ TMP($J,"RC DPE_DAR",0 ))
	11587	"RTN","RCD PEM1",132, 0)
	11588	. S XMTO( "I:G.RCDPE PAYMENTS" )=""
	11589	"RTN","RCD PEM1",133, 0)
	11590	. S XMBOD Y="^TMP($J ,""RCDPE_D AR"")"
	11591	"RTN","RCD PEM1",134, 0)
	11592	. S XMSUB J="EDI LBO X - AUTO D AILY ACTIV ITY SUMMAR Y - "_$$FM TE^XLFDT(D T,2)
	11593	"RTN","RCD PEM1",135, 0)
	11594	. D ;
	11595	"RTN","RCD PEM1",136, 0)
	11596	.. N DUZ
	11597	"RTN","RCD PEM1",137, 0)
	11598	.. S DUZ= .5,DUZ(0)= "@"
	11599	"RTN","RCD PEM1",138, 0)
	11600	.. D SEND MSG^XMXAPI (.5,XMSUBJ ,XMBODY,.X MTO,,.XMZ)
	11601	"RTN","RCD PEM1",139, 0)
	11602	. K ^TMP( $J,"RCDPE_ DAR")
	11603	"RTN","RCD PEM1",140, 0)
	11604	Q
	11605	"RTN","RCD PEM1",141, 0)
	11606	;
	11607	"RTN","RCD PEM1",142, 0)
	11608	HDR(CT,HD) ; Header array set
	11609	"RTN","RCD PEM1",143, 0)
	11610	; CT = li ne count, passed by reference
	11611	"RTN","RCD PEM1",144, 0)
	11612	; HD = fl ag returne d as 1 so the header is only o utput once
	11613	"RTN","RCD PEM1",145, 0)
	11614	N Q
	11615	"RTN","RCD PEM1",146, 0)
	11616	S CT=CT+1 ,^TMP($J," RCXM",CT)= " "
	11617	"RTN","RCD PEM1",147, 0)
	11618	S CT=CT+1 ,^TMP($J," RCXM",CT)= $J("",20)_ "********* * EFT DEPO SIT RECORD S ****** "
	11619	"RTN","RCD PEM1",148, 0)
	11620	S CT=CT+1 ,^TMP($J," RCXM",CT)= " EFT DEP OSIT EFT RECEIP T POS TED AMOUNT "
	11621	"RTN","RCD PEM1",149, 0)
	11622	S CT=CT+1 ,^TMP($J," RCXM",CT)= " "
	11623	"RTN","RCD PEM1",150, 0)
	11624	S CT=CT+1 ,^TMP($J," RCXM",CT)= " TRAC E #"
	11625	"RTN","RCD PEM1",151, 0)
	11626	S CT=CT+1 ,^TMP($J," RCXM",CT)= " PAYE R NAME/ID"
	11627	"RTN","RCD PEM1",152, 0)
	11628	S CT=CT+1 ,Q="",$P(Q ,"=",79)=" ",^TMP($J, "RCXM",CT) =Q
	11629	"RTN","RCD PEM1",153, 0)
	11630	S HD=1
	11631	"RTN","RCD PEM1",154, 0)
	11632	Q
	11633	"RTN","RCD PEM1",155, 0)
	11634	;
	11635	"RTN","RCD PEM9")
	11636	0^28^B4565 8707^B2705 6813
	11637	"RTN","RCD PEM9",1,0)
	11638	RCDPEM9 ;O I D N S /PJH - PAY ER SELECTI ON ;10/18/ 11 6:17pm
	11639	"RTN","RCD PEM9",2,0)
	11640	;;4.5;Acc ounts Rece ivable;2 76,284,318 ;Mar 20, 1995;Buil d 25
	11641	"RTN","RCD PEM9",3,0)
	11642	;;Per VHA Directive 2004-038, this rout ine should not be mo dified.
	11643	"RTN","RCD PEM9",4,0)
	11644	;
	11645	"RTN","RCD PEM9",5,0)
	11646	; PRCA4. 5318 - Ad ded parame ters MIXED and BLANK LN
	11647	"RTN","RCD PEM9",6,0)
	11648	GETPAY(FIL E,MIXED,BL ANKLN) ; L et user se lect payer for filte r
	11649	"RTN","RCD PEM9",7,0)
	11650	; Input: FILE - File to re trieve Pay ers from e ither #344 .4 OR ##34 4.31
	11651	"RTN","RCD PEM9",8,0)
	11652	; MIXED - 1 to displ ay prompts in mixed case
	11653	"RTN","RCD PEM9",9,0)
	11654	; Optional, defaults t o 0
	11655	"RTN","RCD PEM9",10,0 )
	11656	; BLANKLN - 0 skip ini tial blank line
	11657	"RTN","RCD PEM9",11,0 )
	11658	; Optional, defaults t o 1
	11659	"RTN","RCD PEM9",12,0 )
	11660	;
	11661	"RTN","RCD PEM9",13,0 )
	11662	; Returne d RTNFLG v alue
	11663	"RTN","RCD PEM9",14,0 )
	11664	;
	11665	"RTN","RCD PEM9",15,0 )
	11666	; PRCA4. 5284 - Ad ded pieces 2 & 3 to provide ba ckground j obs inform ation to r e-calculat e payer li st.
	11667	"RTN","RCD PEM9",16,0 )
	11668	;
	11669	"RTN","RCD PEM9",17,0 )
	11670	; Piece 1 : -1 = non e selected
	11671	"RTN","RCD PEM9",18,0 )
	11672	; 1 = ran ge of paye rs
	11673	"RTN","RCD PEM9",19,0 )
	11674	; 2 = all payers se lected
	11675	"RTN","RCD PEM9",20,0 )
	11676	; 3 = spe cific paye rs
	11677	"RTN","RCD PEM9",21,0 )
	11678	; Piece 2 : From Ran ge (When a from/thru range is selected b y user)
	11679	"RTN","RCD PEM9",22,0 )
	11680	; Piece 3 : Thru Ran ge (When a from/thru range is selected b y user)
	11681	"RTN","RCD PEM9",23,0 )
	11682	;
	11683	"RTN","RCD PEM9",24,0 )
	11684	; Payers selected a re returne d in ^TMP( "RCSELPAY" ,$J
	11685	"RTN","RCD PEM9",25,0 )
	11686	;
	11687	"RTN","RCD PEM9",26,0 )
	11688	N RCPAY,R CINC,CNT,R TNFLG,I,RC ANS,INDX,X ,RCANS2,DI R,Y,DTOUT, DUOUT,RCIN SF
	11689	"RTN","RCD PEM9",27,0 )
	11690	N RCINST, RNG1,RNG2
	11691	"RTN","RCD PEM9",28,0 )
	11692	S:'$D(MIX ED) MIXED= 0 ; PRCA 4.5318 - Added log ic for MIX ED and BLA NKLN
	11693	"RTN","RCD PEM9",29,0 )
	11694	S:'$D(BLA NKLN) BLAN KLN=1
	11695	"RTN","RCD PEM9",30,0 )
	11696	;
	11697	"RTN","RCD PEM9",31,0 )
	11698	S RTNFLG= 0,INDX=1,R NG1="",RNG 2=""
	11699	"RTN","RCD PEM9",32,0 )
	11700	;
	11701	"RTN","RCD PEM9",33,0 )
	11702	;Clear li st of sele cted payer s
	11703	"RTN","RCD PEM9",34,0 )
	11704	K ^TMP("R CSELPAY",$ J)
	11705	"RTN","RCD PEM9",35,0 )
	11706	;
	11707	"RTN","RCD PEM9",36,0 )
	11708	;Select o ption requ ired (All, Selected or Range)
	11709	"RTN","RCD PEM9",37,0 )
	11710	S DIR(0)= "SA^A:ALL; S:SPECIFIC ;R:RANGE"
	11711	"RTN","RCD PEM9",38,0 )
	11712	S DIR("A" )="RUN REP ORT FOR (A )LL, (S)PE CIFIC, OR (R)ANGE OF INSURANCE COMPANIES ?: "
	11713	"RTN","RCD PEM9",39,0 )
	11714	S DIR("B" )="ALL"
	11715	"RTN","RCD PEM9",40,0 )
	11716	S DIR("?" ,1)="Enter 'ALL' to select all Insurance Companies ."
	11717	"RTN","RCD PEM9",41,0 )
	11718	S DIR("?" ,2)="Enter 'RANGE' t o select a n Insuranc e Company range."
	11719	"RTN","RCD PEM9",42,0 )
	11720	S DIR("?" )="Enter ' SPECIFIC' to select specific I nsurance C ompanies."
	11721	"RTN","RCD PEM9",43,0 )
	11722	I MIXED D ; PRCA4. 5318 - Ad ded logic for MIXED and BLANKL N
	11723	"RTN","RCD PEM9",44,0 )
	11724	. N XX
	11725	"RTN","RCD PEM9",45,0 )
	11726	. S XX="R un Report for (A)LL, (S)PECIFI C, or (R)A NGE of Ins urance Com panies?: "
	11727	"RTN","RCD PEM9",46,0 )
	11728	. S DIR(0 )="SA^A:AL L;S:SPECIF IC;R:RANGE "
	11729	"RTN","RCD PEM9",47,0 )
	11730	. S DIR(" A")=XX,DIR ("B")="ALL "
	11731	"RTN","RCD PEM9",48,0 )
	11732	W:BLANKLN ! ; PRCA4. 5318 - Ad ded condit ion for BL ANKLN
	11733	"RTN","RCD PEM9",49,0 )
	11734	D ^DIR K DIR
	11735	"RTN","RCD PEM9",50,0 )
	11736	;
	11737	"RTN","RCD PEM9",51,0 )
	11738	;Abort on ^ exit or timeout
	11739	"RTN","RCD PEM9",52,0 )
	11740	I $D(DTOU T)!$D(DUOU T) S RTNFL G=-1 Q RTN FLG
	11741	"RTN","RCD PEM9",53,0 )
	11742	;
	11743	"RTN","RCD PEM9",54,0 )
	11744	;ALL paye rs
	11745	"RTN","RCD PEM9",55,0 )
	11746	I Y="A" D
	11747	"RTN","RCD PEM9",56,0 )
	11748	.; Build list of AL L stations
	11749	"RTN","RCD PEM9",57,0 )
	11750	.S CNT=0, RCPAY="",R TNFLG=2
	11751	"RTN","RCD PEM9",58,0 )
	11752	.F S RCP AY=$O(^RCY (FILE,"C", RCPAY)) Q: RCPAY="" D
	11753	"RTN","RCD PEM9",59,0 )
	11754	..S CNT=C NT+1,^TMP( "RCSELPAY" ,$J,CNT)=R CPAY
	11755	"RTN","RCD PEM9",60,0 )
	11756	;
	11757	"RTN","RCD PEM9",61,0 )
	11758	;Selected Payers
	11759	"RTN","RCD PEM9",62,0 )
	11760	I Y="S" D
	11761	"RTN","RCD PEM9",63,0 )
	11762	.D GLIST( FILE),GETP AYS(CNT,MI XED) ; PR CA4.5318 - Added p arameter M IXED
	11763	"RTN","RCD PEM9",64,0 )
	11764	;
	11765	"RTN","RCD PEM9",65,0 )
	11766	;Range of Payers
	11767	"RTN","RCD PEM9",66,0 )
	11768	I Y="R" D
	11769	"RTN","RCD PEM9",67,0 )
	11770	.D GLIST( FILE),GETP AYR(MIXED, BLANKLN) ; PRCA4.5 318 - Add ed paramet ers MIXED and BLANKL N
	11771	"RTN","RCD PEM9",68,0 )
	11772	;
	11773	"RTN","RCD PEM9",69,0 )
	11774	;Clear li st of all payers
	11775	"RTN","RCD PEM9",70,0 )
	11776	K:RTNFLG' =2 ^TMP("R CPAYER",$J )
	11777	"RTN","RCD PEM9",71,0 )
	11778	;If abort ing also c lear any s elected pa yers
	11779	"RTN","RCD PEM9",72,0 )
	11780	K:RTNFLG= -1 ^TMP("R CSELPAY",$ J)
	11781	"RTN","RCD PEM9",73,0 )
	11782	;
	11783	"RTN","RCD PEM9",74,0 )
	11784	;Return v alue
	11785	"RTN","RCD PEM9",75,0 )
	11786	; PRCA4. 5284 - Up date retur n value to include f rom/thru r ange. See above for documentat ion
	11787	"RTN","RCD PEM9",76,0 )
	11788	Q RTNFLG_ "^"_RNG1_" ^"_RNG2
	11789	"RTN","RCD PEM9",77,0 )
	11790	;
	11791	"RTN","RCD PEM9",78,0 )
	11792	GLIST(FILE ) ;Build l ist for th is file
	11793	"RTN","RCD PEM9",79,0 )
	11794	;
	11795	"RTN","RCD PEM9",80,0 )
	11796	;Clear wo rkfile
	11797	"RTN","RCD PEM9",81,0 )
	11798	K ^TMP("R CPAYER",$J )
	11799	"RTN","RCD PEM9",82,0 )
	11800	;
	11801	"RTN","RCD PEM9",83,0 )
	11802	; Build l ist of ava ilable sta tions
	11803	"RTN","RCD PEM9",84,0 )
	11804	S CNT=0,R CPAY=""
	11805	"RTN","RCD PEM9",85,0 )
	11806	F S RCPA Y=$O(^RCY( FILE,"C",R CPAY)) Q:R CPAY="" D
	11807	"RTN","RCD PEM9",86,0 )
	11808	.S CNT=CN T+1
	11809	"RTN","RCD PEM9",87,0 )
	11810	.S ^TMP(" RCPAYER",$ J,CNT)=RCP AY
	11811	"RTN","RCD PEM9",88,0 )
	11812	.S ^TMP(" RCPAYER",$ J,"B",RCPA Y,CNT)=""
	11813	"RTN","RCD PEM9",89,0 )
	11814	;
	11815	"RTN","RCD PEM9",90,0 )
	11816	Q
	11817	"RTN","RCD PEM9",91,0 )
	11818	;
	11819	"RTN","RCD PEM9",92,0 )
	11820	; PRCA4. 5318 - Ad ded parame ter & logi c for MIXE D
	11821	"RTN","RCD PEM9",93,0 )
	11822	GETPAYS(CN T,MIXED) ; select pay er for fil ter, speci fic
	11823	"RTN","RCD PEM9",94,0 )
	11824	; Input: CNT - Nu mber of Pa yers
	11825	"RTN","RCD PEM9",95,0 )
	11826	; MIXED - 1 to display prompts i n mixed ca se
	11827	"RTN","RCD PEM9",96,0 )
	11828	; Op tional, de faults to 0
	11829	"RTN","RCD PEM9",97,0 )
	11830	;
	11831	"RTN","RCD PEM9",98,0 )
	11832	S:'$D(MIX ED) MIXED= 0
	11833	"RTN","RCD PEM9",99,0 )
	11834	;
	11835	"RTN","RCD PEM9",100, 0)
	11836	N PNAME
	11837	"RTN","RCD PEM9",101, 0)
	11838	;
	11839	"RTN","RCD PEM9",102, 0)
	11840	K ^TMP("R CDPEM9",$J )
	11841	"RTN","RCD PEM9",103, 0)
	11842	;
	11843	"RTN","RCD PEM9",104, 0)
	11844	F Q:RTNF LG'=0 D
	11845	"RTN","RCD PEM9",105, 0)
	11846	.N DIR,X, Y,DTOUT,DU OUT,DIRUT, DIROUT
	11847	"RTN","RCD PEM9",106, 0)
	11848	.S DIR("A ")="SELECT INSURANCE COMPANY"
	11849	"RTN","RCD PEM9",107, 0)
	11850	.S:MIXED DIR("A")=" Select Ins urance Com pany" ; PRCA4.53 18
	11851	"RTN","RCD PEM9",108, 0)
	11852	.S DIR(0) ="FO^1:30"
	11853	"RTN","RCD PEM9",109, 0)
	11854	.S DIR("? ")="ENTER THE NAME O F THE PAYE R OR '??' TO LIST PA YERS"
	11855	"RTN","RCD PEM9",110, 0)
	11856	.; PRCA4 .5318 - A dded MIXED
	11857	"RTN","RCD PEM9",111, 0)
	11858	.S:MIXED DIR("?")=" Enter the name of th e payer or '??' to l ist payers "
	11859	"RTN","RCD PEM9",112, 0)
	11860	.S DIR("? ?")="^D LI ST^RCDPEM9 (CNT)"
	11861	"RTN","RCD PEM9",113, 0)
	11862	.D ^DIR K DIR
	11863	"RTN","RCD PEM9",114, 0)
	11864	.;User pr essed ENTE R
	11865	"RTN","RCD PEM9",115, 0)
	11866	.I Y="",' $D(DTOUT) S RTNFLG=$ S($D(^TMP( "RCSELPAY" )):3,1:-1) Q
	11867	"RTN","RCD PEM9",116, 0)
	11868	.;First c heck for e xits
	11869	"RTN","RCD PEM9",117, 0)
	11870	.I $D(DUO UT)!$D(DTO UT)!$D(DIR UT)!$D(DIR OUT) S RTN FLG=-1 Q
	11871	"RTN","RCD PEM9",118, 0)
	11872	.;Check f or help
	11873	"RTN","RCD PEM9",119, 0)
	11874	.S (RCANS ,RCANS2)=" "
	11875	"RTN","RCD PEM9",120, 0)
	11876	.S RCANS= Y
	11877	"RTN","RCD PEM9",121, 0)
	11878	.; Now ch eck for ex otic user input
	11879	"RTN","RCD PEM9",122, 0)
	11880	.I '(RCAN S?.N) S RC ANS2=$O(^T MP("RCPAYE R",$J,"B", RCANS,RCAN S2)) D:'RC ANS2 PART Q:'$G(RCAN S2)
	11881	"RTN","RCD PEM9",123, 0)
	11882	.S:$G(RCA NS2) RCANS =RCANS2 I RCANS="" W " ??" Q
	11883	"RTN","RCD PEM9",124, 0)
	11884	.I RCANS? .N&((+RCAN S<1)!(+RCA NS>CNT)) W " ??" Q
	11885	"RTN","RCD PEM9",125, 0)
	11886	.I RCANS' ?.N W " ? ?" Q
	11887	"RTN","RCD PEM9",126, 0)
	11888	.I $D(^TM P("RCDPEM9 ",$J,RCANS )) W " ?? PAYER ALR EADY SELEC TED" Q
	11889	"RTN","RCD PEM9",127, 0)
	11890	.S ^TMP(" RCDPEM9",$ J,RCANS)=" "
	11891	"RTN","RCD PEM9",128, 0)
	11892	.S PNAME= $G(^TMP("R CPAYER",$J ,RCANS))
	11893	"RTN","RCD PEM9",129, 0)
	11894	.W " "_P NAME
	11895	"RTN","RCD PEM9",130, 0)
	11896	.S ^TMP(" RCSELPAY", $J,INDX)=$ G(^TMP("RC PAYER",$J, RCANS))
	11897	"RTN","RCD PEM9",131, 0)
	11898	.S INDX=I NDX+1
	11899	"RTN","RCD PEM9",132, 0)
	11900	;
	11901	"RTN","RCD PEM9",133, 0)
	11902	K ^TMP("R CDPEM9",$J )
	11903	"RTN","RCD PEM9",134, 0)
	11904	Q
	11905	"RTN","RCD PEM9",135, 0)
	11906	;
	11907	"RTN","RCD PEM9",136, 0)
	11908	LIST(CNT) ;
	11909	"RTN","RCD PEM9",137, 0)
	11910	; Prompt users for stations t o be used for filter ing
	11911	"RTN","RCD PEM9",138, 0)
	11912	N I
	11913	"RTN","RCD PEM9",139, 0)
	11914	F I=1:1:C NT D
	11915	"RTN","RCD PEM9",140, 0)
	11916	.W !,I,". ",?5,$G(^T MP("RCPAYE R",$J,I))
	11917	"RTN","RCD PEM9",141, 0)
	11918	Q
	11919	"RTN","RCD PEM9",142, 0)
	11920	;
	11921	"RTN","RCD PEM9",143, 0)
	11922	PART ;
	11923	"RTN","RCD PEM9",144, 0)
	11924	N RCPAR,C NT,IEN
	11925	"RTN","RCD PEM9",145, 0)
	11926	S RCPAR=0 ,CNT=0
	11927	"RTN","RCD PEM9",146, 0)
	11928	F S RCPA R=$O(^TMP( "RCPAYER", $J,"B",RCP AR)) Q:RCP AR="" D
	11929	"RTN","RCD PEM9",147, 0)
	11930	.S IEN=$O (^TMP("RCP AYER",$J," B",RCPAR," "))
	11931	"RTN","RCD PEM9",148, 0)
	11932	.I $E(RCP AR,1,$L(RC ANS))[RCAN S W !,?10, IEN,".",^T MP("RCPAYE R",$J,IEN) S CNT=1
	11933	"RTN","RCD PEM9",149, 0)
	11934	I 'CNT W " ??"
	11935	"RTN","RCD PEM9",150, 0)
	11936	Q
	11937	"RTN","RCD PEM9",151, 0)
	11938	;
	11939	"RTN","RCD PEM9",152, 0)
	11940	; PRCA4. 5318 - Ad ded parame ters & log ic for MIX ED & BLANK LN
	11941	"RTN","RCD PEM9",153, 0)
	11942	GETPAYR(MI XED,BLANKL N) ;select payer for filter, r ange
	11943	"RTN","RCD PEM9",154, 0)
	11944	; called from ^RCDP EAR1
	11945	"RTN","RCD PEM9",155, 0)
	11946	; Input: MIXED - 1 to displ ay prompts in mixed case
	11947	"RTN","RCD PEM9",156, 0)
	11948	; Optional, defaults t o 0
	11949	"RTN","RCD PEM9",157, 0)
	11950	; BLANKLN - 0 skip ini tial blank line
	11951	"RTN","RCD PEM9",158, 0)
	11952	; Optional, defaults t o 1
	11953	"RTN","RCD PEM9",159, 0)
	11954	;
	11955	"RTN","RCD PEM9",160, 0)
	11956	S:'$D(MIX ED) MIXED= 0 ; PRCA4 .5318
	11957	"RTN","RCD PEM9",161, 0)
	11958	S:'$D(BLA NKLN) BLAN KLN=1
	11959	"RTN","RCD PEM9",162, 0)
	11960	;
	11961	"RTN","RCD PEM9",163, 0)
	11962	N DIR,DTO UT,DUOUT,D IRUT,DIROU T,INDX,X,Y ,RCINSF,RC INST,NUM
	11963	"RTN","RCD PEM9",164, 0)
	11964	S DIR("?" )="ENTER T HE NAME OF THE PAYER OR '??' T O LIST PAY ERS"
	11965	"RTN","RCD PEM9",165, 0)
	11966	S DIR("?? ")="^D LIS T^RCDPEM9( CNT)"
	11967	"RTN","RCD PEM9",166, 0)
	11968	S DIR(0)= "FA^1:30^K :X'?1.U.E X"
	11969	"RTN","RCD PEM9",167, 0)
	11970	S DIR("A" )="START W ITH INSURA NCE COMPAN Y NAME: "
	11971	"RTN","RCD PEM9",168, 0)
	11972	S DIR("B" )=$E($O(^T MP("RCPAYE R",$J,"B", "")),1,30)
	11973	"RTN","RCD PEM9",169, 0)
	11974	I MIXED D ; PRCA4.53 18
	11975	"RTN","RCD PEM9",170, 0)
	11976	. S DIR(" ?")="Enter the name of the pay er or '??' to list p ayers"
	11977	"RTN","RCD PEM9",171, 0)
	11978	. S DIR(" A")="Start with Insu rance Comp any name: "
	11979	"RTN","RCD PEM9",172, 0)
	11980	D ^DIR K DIR
	11981	"RTN","RCD PEM9",173, 0)
	11982	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT)!(Y="") S RTNFLG= -1 Q
	11983	"RTN","RCD PEM9",174, 0)
	11984	S RCINSF= Y
	11985	"RTN","RCD PEM9",175, 0)
	11986	S DIR("?" )="ENTER T HE NAME OF THE PAYER OR '??' T O LIST PAY ERS"
	11987	"RTN","RCD PEM9",176, 0)
	11988	S DIR("?? ")="^D LIS T^RCDPEM9( CNT)"
	11989	"RTN","RCD PEM9",177, 0)
	11990	S DIR(0)= "FA^1:30^K :X'?1.U.E X"
	11991	"RTN","RCD PEM9",178, 0)
	11992	S DIR("A" )="GO TO I NSURANCE C OMPANY NAM E: "
	11993	"RTN","RCD PEM9",179, 0)
	11994	I MIXED D ; PRCA4.53 18
	11995	"RTN","RCD PEM9",180, 0)
	11996	. S DIR(" ?")="Enter the name of the pay er or '??' to list p ayers"
	11997	"RTN","RCD PEM9",181, 0)
	11998	. S DIR(" A")="Go to Insurance Company n ame: "
	11999	"RTN","RCD PEM9",182, 0)
	12000	S DIR("B" )=$E($O(^T MP("RCPAYE R",$J,"B", ""),-1),1, 30)
	12001	"RTN","RCD PEM9",183, 0)
	12002	; PRCA4. 5318 - ad ded condit ional for MIXED & BL ANKLN
	12003	"RTN","RCD PEM9",184, 0)
	12004	F W:BLAN KLN ! D ^D IR Q:$S($D (DTOUT)!$D (DUOUT):1, 1:RCINSF'] Y) D
	12005	"RTN","RCD PEM9",185, 0)
	12006	. W:'MIXE D !,"'GO T O' NAME MU ST COME AF TER 'START WITH' NAM E"
	12007	"RTN","RCD PEM9",186, 0)
	12008	. W:MIXED !,"'GO TO ' name mus t come aft er 'START WITH' name "
	12009	"RTN","RCD PEM9",187, 0)
	12010	K DIR
	12011	"RTN","RCD PEM9",188, 0)
	12012	I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT)!(Y="") S RTNFLG= -1 Q
	12013	"RTN","RCD PEM9",189, 0)
	12014	S RCINST= Y_"Z" ;en try of "AB C" will pi ck up "ABC INSURANCE " if "Z" i s appended
	12015	"RTN","RCD PEM9",190, 0)
	12016	;If the f irst name is an exac t match, b ack up to the previo us entry
	12017	"RTN","RCD PEM9",191, 0)
	12018	I $D(^TMP ("RCPAYER" ,$J,"B",RC INSF)) S R CINSF=$O(^ TMP("RCPAY ER",$J,"B" ,RCINSF),- 1)
	12019	"RTN","RCD PEM9",192, 0)
	12020	; PRCA4. 5284 - Sa ve from/th ru user re sponses in RNG1 & RN G2 to rebu ild after report is queued. Wi ll be retu rned to th e calling program.
	12021	"RTN","RCD PEM9",193, 0)
	12022	S RNG1=RC INSF,RNG2= RCINST
	12023	"RTN","RCD PEM9",194, 0)
	12024	S INDX=1 F S RCINS F=$O(^TMP( "RCPAYER", $J,"B",RCI NSF)) Q:RC INSF="" Q :RCINSF]RC INST D
	12025	"RTN","RCD PEM9",195, 0)
	12026	. S NUM=$ O(^TMP("RC PAYER",$J, "B",RCINSF ,""))
	12027	"RTN","RCD PEM9",196, 0)
	12028	. S ^TMP( "RCSELPAY" ,$J,INDX)= $G(^TMP("R CPAYER",$J ,NUM))
	12029	"RTN","RCD PEM9",197, 0)
	12030	. S INDX= INDX+1
	12031	"RTN","RCD PEM9",198, 0)
	12032	;Set retu rn value
	12033	"RTN","RCD PEM9",199, 0)
	12034	I INDX=1 S RTNFLG=- 1 Q ; no entries in selected range
	12035	"RTN","RCD PEM9",200, 0)
	12036	S RTNFLG= 1
	12037	"RTN","RCD PEM9",201, 0)
	12038	Q
	12039	"RTN","RCD PEMA")
	12040	0^13^B2295 6552^B2268 0742
	12041	"RTN","RCD PEMA",1,0)
	12042	RCDPEMA ;A LB/PJH - A UTO-POSTIN G RECEIPT CREATION ; Oct 15, 20 14@12:37:5 2
	12043	"RTN","RCD PEMA",2,0)
	12044	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	12045	"RTN","RCD PEMA",3,0)
	12046	;Per VA D irective 6 402, this routine sh ould not b e modified .
	12047	"RTN","RCD PEMA",4,0)
	12048	;
	12049	"RTN","RCD PEMA",5,0)
	12050	RCPTDET(RC RZ,RECTDA1 ,RCLINES,R CER) ; Add s detail t o a receip t based on file 344. 49 and exc eptions in array RCL INES
	12051	"RTN","RCD PEMA",6,0)
	12052	; RCRZ = ien of ERA entry in file 344.4 9
	12053	"RTN","RCD PEMA",7,0)
	12054	; RECTDA1 = ien of receipt en try in fil e 344
	12055	"RTN","RCD PEMA",8,0)
	12056	; RCER = error arra y returned if passed by refere nce
	12057	"RTN","RCD PEMA",9,0)
	12058	; RCLINES = array t o indicate which scr atchpad li nes can be posted (a ssigned a receipt)
	12059	"RTN","RCD PEMA",10,0 )
	12060	;
	12061	"RTN","RCD PEMA",11,0 )
	12062	N DA,DIE, DR,Q,RCLIN E,RCQ,RCR, RCSPL,RCTR ANDA,RCZ0, SEQLINES,R CSEQ,X,Y,Z ,Z0,Z1
	12063	"RTN","RCD PEMA",12,0 )
	12064	;
	12065	"RTN","RCD PEMA",13,0 )
	12066	S RCR=0 F S RCR=$O (^RCY(344. 49,RCRZ,1, RCR)) Q:'R CR D
	12067	"RTN","RCD PEMA",14,0 )
	12068	. S RCZ0= $G(^RCY(34 4.49,RCRZ, 1,RCR,0)), RCSEQ=$P(R CZ0,U)
	12069	"RTN","RCD PEMA",15,0 )
	12070	. ;Check first line for prefi x to see i f ERA line is valid for auto-p ost
	12071	"RTN","RCD PEMA",16,0 )
	12072	. I RCSEQ ?1N.N,$P(R CZ0,U,9),$ P($G(RCLIN ES($P(RCZ0 ,U,9))),U) S SEQLINE S(RCSEQ)=" "
	12073	"RTN","RCD PEMA",17,0 )
	12074	. ;Skip W ORKLIST li nes that d o not need associate d receipt detail
	12075	"RTN","RCD PEMA",18,0 )
	12076	. Q:'$D(S EQLINES(RC SEQ\1))
	12077	"RTN","RCD PEMA",19,0 )
	12078	. I RCSEQ '["." S RC SPL(+RCZ0) =$P(RCZ0,U ,9) Q
	12079	"RTN","RCD PEMA",20,0 )
	12080	. I $S(+$ P(RCZ0,U,3 )=0:$P($G( ^RCY(344.4 9,RCRZ,0)) ,U,3),1:$P (RCZ0,U,3) <0) S RCSP L(RCZ0\1,+ RCZ0)=RCZ0 Q
	12081	"RTN","RCD PEMA",21,0 )
	12082	. S RCTRA NDA=$$ADDT RAN^RCDPUR ET(RECTDA1 )
	12083	"RTN","RCD PEMA",22,0 )
	12084	. ;
	12085	"RTN","RCD PEMA",23,0 )
	12086	. I RCTRA NDA'>0 D Q ; Error adding re ceipt deta il - PRCA* 4.5*318
	12087	"RTN","RCD PEMA",24,0 )
	12088	.. S RCER (1)=$$SETE RR^RCDPEM0 (1) ; PRCA 4.5318 - pass RCPR OC value t o $$SETERR
	12089	"RTN","RCD PEMA",25,0 )
	12090	.. S RCER ($O(RCER(" "),-1)+1)= " NO DETA IL LINE AD DED TO REC EIPT "_$P( $G(^RCY(34 4,RECTDA1, 0)),U)_" F OR LINE #" _$P(RCZ0,U )_" IN EEO B WORKLIST SCRATCH P AD"
	12091	"RTN","RCD PEMA",26,0 )
	12092	. ;
	12093	"RTN","RCD PEMA",27,0 )
	12094	. ;Store receipt li ne detail
	12095	"RTN","RCD PEMA",28,0 )
	12096	. D DET(R CRZ,RCR,RE CTDA1,RCTR ANDA)
	12097	"RTN","RCD PEMA",29,0 )
	12098	. S RCSPL (RCZ0\1,+R CZ0)=RCZ0
	12099	"RTN","RCD PEMA",30,0 )
	12100	S Z=0 F S Z=$O(RCS PL(Z)) Q:' Z S RCQ=+ $G(RCSPL(Z )) I RCQ D
	12101	"RTN","RCD PEMA",31,0 )
	12102	.; Move E EOB if one claim ent ered-chang ed 10/19/1 1-see +25^ RCDPEWL8
	12103	"RTN","RCD PEMA",32,0 )
	12104	. S Z1=$O (RCSPL(Z," ")) Q:Z1=" "
	12105	"RTN","RCD PEMA",33,0 )
	12106	. I $O(RC SPL(Z,""), -1)=Z1,'$$ SPLIT(Z,Z1 ,RCERA) Q ; No spli t occurred
	12107	"RTN","RCD PEMA",34,0 )
	12108	. S Z1=0 F S Z1=$O (RCSPL(Z,Z 1)) Q:'Z1 S Z0=$G(R CSPL(Z,Z1) ) D
	12109	"RTN","RCD PEMA",35,0 )
	12110	.. S Q=+$ P($G(^RCY( 344.4,RCRZ ,1,RCQ,0)) ,U,2) ; EO B detail r ec
	12111	"RTN","RCD PEMA",36,0 )
	12112	.. Q:'Q
	12113	"RTN","RCD PEMA",37,0 )
	12114	.. I '$P( Z0,U,7)!($ P(Z0,U,2)= "") D ; S uspense
	12115	"RTN","RCD PEMA",38,0 )
	12116	... D SPL 1^IBCEOBAR (Q,$S($P(Z 0,U,2)="": "NO BILL", 1:$P(Z0,U, 2)),"",$P( Z0,U,6)) ; IA 4050
	12117	"RTN","RCD PEMA",39,0 )
	12118	.. E D
	12119	"RTN","RCD PEMA",40,0 )
	12120	... D SPL 1^IBCEOBAR (Q,$P(Z0,U ,2),$P(Z0, U,7),$P(Z0 ,U,6)) ; A dd the spl it bill # ; IA 4050
	12121	"RTN","RCD PEMA",41,0 )
	12122	;
	12123	"RTN","RCD PEMA",42,0 )
	12124	Q
	12125	"RTN","RCD PEMA",43,0 )
	12126	;
	12127	"RTN","RCD PEMA",44,0 )
	12128	SPLIT(Z,Z1 ,RCERA) ;C heck if wo rklist was split to single cla im
	12129	"RTN","RCD PEMA",45,0 )
	12130	N SUB,NBI LL,OBILL
	12131	"RTN","RCD PEMA",46,0 )
	12132	;Find spl it line in scratchpa d
	12133	"RTN","RCD PEMA",47,0 )
	12134	S SUB=$O( ^RCY(344.4 9,RCERA,1, "B",Z1,"") ) Q:'SUB 0
	12135	"RTN","RCD PEMA",48,0 )
	12136	;Get orig inal claim number fr om scratch pad
	12137	"RTN","RCD PEMA",49,0 )
	12138	S OBILL=$ P($G(^RCY( 344.49,RCE RA,1,SUB-1 ,0)),U,2)
	12139	"RTN","RCD PEMA",50,0 )
	12140	;New clai m number
	12141	"RTN","RCD PEMA",51,0 )
	12142	S NBILL=$ P(RCSPL(Z, Z1),U,2)
	12143	"RTN","RCD PEMA",52,0 )
	12144	;If new a nd old cla im are not the same this is a move via s plit
	12145	"RTN","RCD PEMA",53,0 )
	12146	I OBILL'= "",OBILL'= NBILL Q 1
	12147	"RTN","RCD PEMA",54,0 )
	12148	;Otherwis e this is not a spli t
	12149	"RTN","RCD PEMA",55,0 )
	12150	Q 0
	12151	"RTN","RCD PEMA",56,0 )
	12152	;
	12153	"RTN","RCD PEMA",57,0 )
	12154	DET(RCZ,RC R,RECTDA1, RCTRANDA) ; Store re ceipt deta il
	12155	"RTN","RCD PEMA",58,0 )
	12156	; RCZ = i en of entr y file 344 .49
	12157	"RTN","RCD PEMA",59,0 )
	12158	; RCR = i en of entr y in file 344.491
	12159	"RTN","RCD PEMA",60,0 )
	12160	; RECTDA1 = ien of entry in f ile 344
	12161	"RTN","RCD PEMA",61,0 )
	12162	; RCTRAND A = ien of entry in subfile 34 4.01
	12163	"RTN","RCD PEMA",62,0 )
	12164	;
	12165	"RTN","RCD PEMA",63,0 )
	12166	N DIE,DA, DR,X,Y,Z,R CUP,RCCOM, RCZ0,RC0
	12167	"RTN","RCD PEMA",64,0 )
	12168	S RC0=$G( ^RCY(344.4 9,RCZ,0))
	12169	"RTN","RCD PEMA",65,0 )
	12170	S RCZ0=$G (^RCY(344. 49,RCZ,1,R CR,0))
	12171	"RTN","RCD PEMA",66,0 )
	12172	S DR="",R CUP=+$O(^R CY(344.49, RCZ,1,"B", +RCZ0/1,0) ),RCUP=$G( ^RCY(344.4 9,RCZ,1,RC UP,0))
	12173	"RTN","RCD PEMA",67,0 )
	12174	I $P(RCZ0 ,U,7) S DR =".09////^ S X="_+$P( RCZ0,U,7)_ "_$C(59)_" "PRCA(430, "";"
	12175	"RTN","RCD PEMA",68,0 )
	12176	S DR=DR_" .04////"_( +$P(RCZ0,U ,3))_";.27 ////"_RCR_ ";"
	12177	"RTN","RCD PEMA",69,0 )
	12178	I $P(RC0, U,5)'="" S DR=DR_".1 ////"_$P(R C0,U,5)_"; "
	12179	"RTN","RCD PEMA",70,0 )
	12180	I $P(RC0, U,6)'="" S DR=DR_".0 8////"_$P( RC0,U,6)_" ;"
	12181	"RTN","RCD PEMA",71,0 )
	12182	S Z=0 F S Z=$O(^RC Y(344.49,R CZ,1,RCR,1 ,Z)) Q:'Z I $P($G(^ (Z,0)),U,5 )=1 S DR=D R_".28//// 1;" Q ; U pdate rece ipt line w ith dec ad j flag
	12183	"RTN","RCD PEMA",72,0 )
	12184	S RCCOM=$ P(RCZ0,U,1 0)
	12185	"RTN","RCD PEMA",73,0 )
	12186	I $P(RCUP ,U,2)["**A DJ" S RCCO M=RCCOM_$S (RCCOM'="" :"/",1:"") _$S($P($P( RCUP,U,2), "ADJ",2):" ERA adjust ment - no bill refer enced",1:" Total of E FT mismatc hed to ERA ")
	12187	"RTN","RCD PEMA",74,0 )
	12188	I RCCOM]" " S DR=DR_ "1.02////" _$E(RCCOM, 1,60)_";"
	12189	"RTN","RCD PEMA",75,0 )
	12190	I $P($G(^ RCY(344.49 ,RCZ,0)),U ,4)'="" S DR=DR_".07 ////"_$P($ G(^RCY(344 .49,RCZ,0) ),U,4)_";"
	12191	"RTN","RCD PEMA",76,0 )
	12192	S DA(1)=R ECTDA1,DA= RCTRANDA,D IE="^RCY(3 44,"_DA(1) _",1,"
	12193	"RTN","RCD PEMA",77,0 )
	12194	D ^DIE
	12195	"RTN","RCD PEMA",78,0 )
	12196	Q
	12197	"RTN","RCD PEMA",79,0 )
	12198	;
	12199	"RTN","RCD PEMA",80,0 )
	12200	BLDRCPT(RC ERA) ; Cre ate a rece ipt for Au to Posting ERA with multiple R eceipts - alpha char at the 10 th charact er
	12201	"RTN","RCD PEMA",81,0 )
	12202	; LAYGO n ew entry t o AR BATCH PAYMENT f ile (#344)
	12203	"RTN","RCD PEMA",82,0 )
	12204	; input - RCERA = P ointer to 344.4
	12205	"RTN","RCD PEMA",83,0 )
	12206	; returns new IEN o n success, else zero
	12207	"RTN","RCD PEMA",84,0 )
	12208	; called by auto-po st process (RCDPEAP)
	12209	"RTN","RCD PEMA",85,0 )
	12210	;
	12211	"RTN","RCD PEMA",86,0 )
	12212	N RECEIPT ,TYPE,LAST REC
	12213	"RTN","RCD PEMA",87,0 )
	12214	S TYPE=$E ($G(^RC(34 1.1,+$O(^R C(341.1,"A C",14,0)), 0))) ; ^R C(341.1,0) = AR EVEN T TYPE
	12215	"RTN","RCD PEMA",88,0 )
	12216	; retriev e the last receipt r ecorded on the ERA ( if it exis ts)
	12217	"RTN","RCD PEMA",89,0 )
	12218	S LASTREC =$$GETREC( RCERA)
	12219	"RTN","RCD PEMA",90,0 )
	12220	; Make su re last re ceipt for the ERA is 10-chars long and t he last ch ar is betw een A - Y (can't be Z),
	12221	"RTN","RCD PEMA",91,0 )
	12222	; Otherwi se grab a new number and appen d "A"
	12223	"RTN","RCD PEMA",92,0 )
	12224	I LASTREC '="",$L(LA STREC)=10, $A($E(LAST REC,10))>6 4,$A($E(LA STREC,10)) <90 D
	12225	"RTN","RCD PEMA",93,0 )
	12226	. S RECEI PT=$E(LAST REC,1,9)_$ C($A($E(LA STREC,10)) +1)
	12227	"RTN","RCD PEMA",94,0 )
	12228	E D
	12229	"RTN","RCD PEMA",95,0 )
	12230	. S RECEI PT=$$NEXT^ RCDPUREC(T YPE_$E(DT, 2,7))_"A"
	12231	"RTN","RCD PEMA",96,0 )
	12232	;
	12233	"RTN","RCD PEMA",97,0 )
	12234	; Prevent s duplicat e Receipt # entries from being filed
	12235	"RTN","RCD PEMA",98,0 )
	12236	F Q:'$D( ^RCY(344," B",RECEIPT )) D
	12237	"RTN","RCD PEMA",99,0 )
	12238	. S RECEI PT=$E(RECE IPT,1)_$E( 1000001+$E (RECEIPT,2 ,7),2,7)_$ E(RECEIPT, 8,9)_"A"
	12239	"RTN","RCD PEMA",100, 0)
	12240	;
	12241	"RTN","RCD PEMA",101, 0)
	12242	L +^RCY(3 44,"B",REC EIPT):DILO CKTM E Q 0 ; if LO CK timeout return ze ro
	12243	"RTN","RCD PEMA",102, 0)
	12244	;
	12245	"RTN","RCD PEMA",103, 0)
	12246	; add ent ry to AR B ATCH PAYME NT file (# 344)
	12247	"RTN","RCD PEMA",104, 0)
	12248	N %,%DT,D 0,DA,DD,DI ,DIC,DIE,D LAYGO,DO,D Q,DR,X,Y
	12249	"RTN","RCD PEMA",105, 0)
	12250	S DIC="^R CY(344,",D IC(0)="L", DLAYGO=344
	12251	"RTN","RCD PEMA",106, 0)
	12252	; .02 = opened by .03 = date op ened = tra nsmission dt
	12253	"RTN","RCD PEMA",107, 0)
	12254	; .04 = type of pa yment
	12255	"RTN","RCD PEMA",108, 0)
	12256	; .14 = status (se t to 1:ope n)
	12257	"RTN","RCD PEMA",109, 0)
	12258	S DIC("DR ")=".02/// /"_DUZ_";. 03///"_DT_ ";.04////1 4;.14////1 ;"
	12259	"RTN","RCD PEMA",110, 0)
	12260	S X=RECEI PT
	12261	"RTN","RCD PEMA",111, 0)
	12262	D FILE^DI CN
	12263	"RTN","RCD PEMA",112, 0)
	12264	L -^RCY(3 44,"B",REC EIPT)
	12265	"RTN","RCD PEMA",113, 0)
	12266	I Y>0 Q + Y ; Y set by DICN, return new IEN
	12267	"RTN","RCD PEMA",114, 0)
	12268	Q 0 ; en try not cr eated
	12269	"RTN","RCD PEMA",115, 0)
	12270	;
	12271	"RTN","RCD PEMA",116, 0)
	12272	GETREC(RCE RA) ; retu rns the re ceipt numb er
	12273	"RTN","RCD PEMA",117, 0)
	12274	; input - RCERA = i en of entr y in 344.4
	12275	"RTN","RCD PEMA",118, 0)
	12276	; output - returns the receip t number i n external form
	12277	"RTN","RCD PEMA",119, 0)
	12278	N X,RECEI PT
	12279	"RTN","RCD PEMA",120, 0)
	12280	S RECEIPT =""
	12281	"RTN","RCD PEMA",121, 0)
	12282	S X=$O(^R CY(344.4,R CERA,1,"RE CEIPT","") ,-1) ; ge t last REC EIPT ien f rom 344.41 subfile
	12283	"RTN","RCD PEMA",122, 0)
	12284	S:X RECEI PT=$P($G(^ RCY(344,X, 0)),U) ; get extern al form of receipt
	12285	"RTN","RCD PEMA",123, 0)
	12286	Q RECEIPT
	12287	"RTN","RCD PESP")
	12288	0^1^B15238 5902^B1523 85563
	12289	"RTN","RCD PESP",1,0)
	12290	RCDPESP ;B IRM/EWL - ePayment L ockbox Sit e Paramete rs Definit ion - File s 344.61 & 344.6 ;No v 19, 2014 @15:26:16
	12291	"RTN","RCD PESP",2,0)
	12292	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	12293	"RTN","RCD PESP",3,0)
	12294	;;Per VA Directive 6402, this routine s hould not be modifie d.
	12295	"RTN","RCD PESP",4,0)
	12296	;
	12297	"RTN","RCD PESP",5,0)
	12298	EN ; entry point for EDI Lockb ox Paramet ers [RCDPE EDI LOCKB OX PARAMET ERS]
	12299	"RTN","RCD PESP",6,0)
	12300	N DA,DIC, DIE,DIR,DI RUT,DLAYGO ,DR,DTOUT, DUOUT,X,Y ; FileMan variables
	12301	"RTN","RCD PESP",7,0)
	12302	;
	12303	"RTN","RCD PESP",8,0)
	12304	W !," Upd ate AR Sit e Paramete rs",!
	12305	"RTN","RCD PESP",9,0)
	12306	;
	12307	"RTN","RCD PESP",10,0 )
	12308	S X="RCDP E AUTO DEC " I '$D(^X USEC(X,DUZ )) W !!,"Y ou do not hold the " _X_" secur ity key." Q
	12309	"RTN","RCD PESP",11,0 )
	12310	; Lock th e paramete r file
	12311	"RTN","RCD PESP",12,0 )
	12312	L +^RCY(3 44.61,1):D ILOCKTM E D Q
	12313	"RTN","RCD PESP",13,0 )
	12314	.W !!," A nother use r is curre ntly using the AR Si te Paramet ers option ."
	12315	"RTN","RCD PESP",14,0 )
	12316	.W !," Pl ease try a gain later ."
	12317	"RTN","RCD PESP",15,0 )
	12318	;
	12319	"RTN","RCD PESP",16,0 )
	12320	; Check p arameter f ile
	12321	"RTN","RCD PESP",17,0 )
	12322	N FDAEDI, FDAPAYER,I EN,IENS,RC QUIT
	12323	"RTN","RCD PESP",18,0 )
	12324	; FDAPAYE R - FDA ar ray for RC DPE AUTO-P AY EXCLUSI ON file (# 344.6)
	12325	"RTN","RCD PESP",19,0 )
	12326	; FDAEDI - FDA arra y for RCDP E PARAMETE R file (#3 44.61)
	12327	"RTN","RCD PESP",20,0 )
	12328	; RCAUDVA L - audit data for R CDPE PARAM ETER AUDIT file (#34 4.7)
	12329	"RTN","RCD PESP",21,0 )
	12330	; IEN - e ntry #
	12331	"RTN","RCD PESP",22,0 )
	12332	; IENS - IEN_comma
	12333	"RTN","RCD PESP",23,0 )
	12334	; RCQUIT - exit fla g
	12335	"RTN","RCD PESP",24,0 )
	12336	;
	12337	"RTN","RCD PESP",25,0 )
	12338	; functio n returns 1 on succe ss
	12339	"RTN","RCD PESP",26,0 )
	12340	S Y=$$EDI LOCK^RCMSI TE ; Upda te EDI Loc kbox site parameters
	12341	"RTN","RCD PESP",27,0 )
	12342	I 'Y G AB ORT ; use r entered '^'
	12343	"RTN","RCD PESP",28,0 )
	12344	;
	12345	"RTN","RCD PESP",29,0 )
	12346	;-------- ---------- ---------- ---------- --------
	12347	"RTN","RCD PESP",30,0 )
	12348	; prca4. 5304
	12349	"RTN","RCD PESP",31,0 )
	12350	; Enable/ disable au to-auditin g of paper bills
	12351	"RTN","RCD PESP",32,0 )
	12352	;-------- ---------- ---------- ---------- --------
	12353	"RTN","RCD PESP",33,0 )
	12354	;
	12355	"RTN","RCD PESP",34,0 )
	12356	S RCQUIT= 0 W !
	12357	"RTN","RCD PESP",35,0 )
	12358	S RCQUIT= $$AUDIT^RC DPESP5
	12359	"RTN","RCD PESP",36,0 )
	12360	Q:RCQUIT
	12361	"RTN","RCD PESP",37,0 )
	12362	;
	12363	"RTN","RCD PESP",38,0 )
	12364	W !
	12365	"RTN","RCD PESP",39,0 )
	12366	I '$D(^RC Y(344.61,1 ,0)) W !," There is a problem w ith the RC DPE PARAME TER file ( #344.61)." G EXIT
	12367	"RTN","RCD PESP",40,0 )
	12368	;
	12369	"RTN","RCD PESP",41,0 )
	12370	;-------- ---------- ---------- ---------- --------
	12371	"RTN","RCD PESP",42,0 )
	12372	; Enable/ disable au to-posting of medica l claims
	12373	"RTN","RCD PESP",43,0 )
	12374	;-------- ---------- ---------- ---------- --------
	12375	"RTN","RCD PESP",44,0 )
	12376	N APMC,AP MCT
	12377	"RTN","RCD PESP",45,0 )
	12378	;PRCA4.5 304 Move from Medic al Auto de crease sec tion below
	12379	"RTN","RCD PESP",46,0 )
	12380	N ADMC ; ^DD(344.6 1,.03,0)=" AUTO-DECRE ASE MED EN ABLED^S^0: No;1:Yes;^ 0;3^Q"
	12381	"RTN","RCD PESP",47,0 )
	12382	S ADMC="" ; Init i n case Med ical Auto Posting is turned of f.
	12383	"RTN","RCD PESP",48,0 )
	12384	;end PRCA 4.5304
	12385	"RTN","RCD PESP",49,0 )
	12386	; APMC=AU TO POSTING OF MEDICA L CLAIMS E NABLED
	12387	"RTN","RCD PESP",50,0 )
	12388	; APMCT=T EMP APMC
	12389	"RTN","RCD PESP",51,0 )
	12390	S APMCT=$ $GET1^DIQ( 344.61,"1, ",.02,"I") ,APMC=$S(A PMCT=1:"Ye s",APMCT=0 :"No",1:"" )
	12391	"RTN","RCD PESP",52,0 )
	12392	K DIR S D IR(0)="YA" ,DIR("B")= $S(APMC="" :"Y",1:APM C)
	12393	"RTN","RCD PESP",53,0 )
	12394	S DIR("A" )=$$GET1^D ID(344.61, .02,,"TITL E")
	12395	"RTN","RCD PESP",54,0 )
	12396	S DIR("?" )=$$GET1^D ID(344.61, .02,,"HELP -PROMPT")
	12397	"RTN","RCD PESP",55,0 )
	12398	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12399	"RTN","RCD PESP",56,0 )
	12400	I APMCT'= Y D ; use r updated value
	12401	"RTN","RCD PESP",57,0 )
	12402	.S FDAEDI (344.61,"1 ,",.02)=Y D FILE^DIE (,"FDAEDI" ) K FDAEDI
	12403	"RTN","RCD PESP",58,0 )
	12404	.D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"mis sing"))
	12405	"RTN","RCD PESP",59,0 )
	12406	.S RCAUDV AL(1)="344 .61^.02^1^ "_Y_U_('Y) D AUDIT(. RCAUDVAL) K RCAUDVAL
	12407	"RTN","RCD PESP",60,0 )
	12408	;
	12409	"RTN","RCD PESP",61,0 )
	12410	I Y=0 G R XPARMS
	12411	"RTN","RCD PESP",62,0 )
	12412	;
	12413	"RTN","RCD PESP",63,0 )
	12414	; Set/Res et payer e xclusions for medica l claim po sting
	12415	"RTN","RCD PESP",64,0 )
	12416	D EXCLLIS T(1) ; Dis play the e xclusion l ist
	12417	"RTN","RCD PESP",65,0 )
	12418	D SETEXCL (1) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions
	12419	"RTN","RCD PESP",66,0 )
	12420	D EXCLLIS T(1) ; Dis play the e xclusion l ist
	12421	"RTN","RCD PESP",67,0 )
	12422	W !
	12423	"RTN","RCD PESP",68,0 )
	12424	;
	12425	"RTN","RCD PESP",69,0 )
	12426	; Enable/ disable au to-decreas e of medic al claims
	12427	"RTN","RCD PESP",70,0 )
	12428	K FDAEDI ; used fo r FILE^DIE call
	12429	"RTN","RCD PESP",71,0 )
	12430	S ADMC=$$ GET1^DIQ(3 44.61,"1," ,.03,"I") ; get curr ent value
	12431	"RTN","RCD PESP",72,0 )
	12432	K DIR S D IR(0)="YA" ,DIR("B")= $S(ADMC="" !(ADMC=1): "Yes",1:"N o")
	12433	"RTN","RCD PESP",73,0 )
	12434	S DIR("A" )=$$GET1^D ID(344.61, .03,,"TITL E")
	12435	"RTN","RCD PESP",74,0 )
	12436	S DIR("?" )=$$GET1^D ID(344.61, .03,,"HELP -PROMPT")
	12437	"RTN","RCD PESP",75,0 )
	12438	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12439	"RTN","RCD PESP",76,0 )
	12440	; if user changed v alue, upda te and aud it
	12441	"RTN","RCD PESP",77,0 )
	12442	S:ADMC'=Y FDAEDI(34 4.61,"1,", .03)=Y,RCA UDVAL(1)=" 344.61^.03 ^1^"_Y_U_A DMC
	12443	"RTN","RCD PESP",78,0 )
	12444	I Y=0 D G RXPARMS ; value s et to No, update (if needed), go to Phar macy param s.
	12445	"RTN","RCD PESP",79,0 )
	12446	. D:$D(FD AEDI) FILE ^DIE(,"FDA EDI"),AUDI T(.RCAUDVA L) K RCAUD VAL
	12447	"RTN","RCD PESP",80,0 )
	12448	;
	12449	"RTN","RCD PESP",81,0 )
	12450	; If auto -decrease (medical f or now) on , ask abou t CARC/RAR C auto-dec rease setu p
	12451	"RTN","RCD PESP",82,0 )
	12452	W !
	12453	"RTN","RCD PESP",83,0 )
	12454	S RCQUIT= 0
	12455	"RTN","RCD PESP",84,0 )
	12456	D CARC^RC DPESP5
	12457	"RTN","RCD PESP",85,0 )
	12458	W !
	12459	"RTN","RCD PESP",86,0 )
	12460	; If no a ctive CARC s Turn med ical auto- decrease o ff, Then g o to Phara cy params
	12461	"RTN","RCD PESP",87,0 )
	12462	I ($$COUN T(1)=0)&($ $GET1^DIQ( 344.61,"1, ",.03,"I") =1) D G R XPARMS
	12463	"RTN","RCD PESP",88,0 )
	12464	. K FDAED I,RCAUDVAL
	12465	"RTN","RCD PESP",89,0 )
	12466	. S ADMC= $$GET1^DIQ (344.61,"1 ,",.03,"I" )
	12467	"RTN","RCD PESP",90,0 )
	12468	. S FDAED I(344.61," 1,",.03)=0 ,RCAUDVAL( 1)="344.61 ^.03^1^"_0 _U_ADMC_U_ "SYSTEM di sabled Med ical Auto- decrease, there are NO active CARCs"
	12469	"RTN","RCD PESP",91,0 )
	12470	. D FILE^ DIE(,"FDAE DI"),AUDIT (.RCAUDVAL ) K RCAUDV AL
	12471	"RTN","RCD PESP",92,0 )
	12472	. W !,"** * System h as DISABLE D Medical Auto-decre ase, there are NO ac tive CARCs .",!
	12473	"RTN","RCD PESP",93,0 )
	12474	. D PAUSE
	12475	"RTN","RCD PESP",94,0 )
	12476	Q:RCQUIT
	12477	"RTN","RCD PESP",95,0 )
	12478	;
	12479	"RTN","RCD PESP",96,0 )
	12480	; Set num ber of day s to wait before aut o-decrease amount
	12481	"RTN","RCD PESP",97,0 )
	12482	N ADMT ; ^DD(344.61 ,.04,0) = AUTO-DECRE ASE MED DA YS DEFAULT
	12483	"RTN","RCD PESP",98,0 )
	12484	S ADMT=$$ GET1^DIQ(3 44.61,"1," ,.04)
	12485	"RTN","RCD PESP",99,0 )
	12486	K DIR S:A DMT]"" DIR ("B")=ADMT
	12487	"RTN","RCD PESP",100, 0)
	12488	S (DIR("? "),DIR("?? "))=$$GET1 ^DID(344.6 1,.04,,"HE LP-PROMPT" )
	12489	"RTN","RCD PESP",101, 0)
	12490	S DIR(0)= "NA^0:7:0" ,DIR("A")= $$GET1^DID (344.61,.0 4,,"TITLE" )
	12491	"RTN","RCD PESP",102, 0)
	12492	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12493	"RTN","RCD PESP",103, 0)
	12494	S:ADMT'=Y FDAEDI(34 4.61,"1,", .04)=Y,RCA UDVAL(2)=" 344.61^.04 ^1^"_Y_U_A DMT
	12495	"RTN","RCD PESP",104, 0)
	12496	;
	12497	"RTN","RCD PESP",105, 0)
	12498	; PRCA4. 5304 - re moved gene ral auto-d ecrease am ount in fa vor of aut o-decrease by CARC
	12499	"RTN","RCD PESP",106, 0)
	12500	;
	12501	"RTN","RCD PESP",107, 0)
	12502	; file ch anges to m edical aut o-post and auto-decr ease param eters
	12503	"RTN","RCD PESP",108, 0)
	12504	D FILE^DI E(,"FDAEDI ")
	12505	"RTN","RCD PESP",109, 0)
	12506	D:$D(RCAU DVAL) AUDI T(.RCAUDVA L)
	12507	"RTN","RCD PESP",110, 0)
	12508	K RCAUDVA L
	12509	"RTN","RCD PESP",111, 0)
	12510	;
	12511	"RTN","RCD PESP",112, 0)
	12512	; Set/Res et payer e xclusions for medica l claim de crease
	12513	"RTN","RCD PESP",113, 0)
	12514	D EXCLLIS T(2) ; Dis play the e xclusion l ist
	12515	"RTN","RCD PESP",114, 0)
	12516	D SETEXCL (2) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions
	12517	"RTN","RCD PESP",115, 0)
	12518	D EXCLLIS T(2) ; Dis play the e xclusion l ist
	12519	"RTN","RCD PESP",116, 0)
	12520	W !
	12521	"RTN","RCD PESP",117, 0)
	12522	;
	12523	"RTN","RCD PESP",118, 0)
	12524	; code fa lls throug h
	12525	"RTN","RCD PESP",119, 0)
	12526	;
	12527	"RTN","RCD PESP",120, 0)
	12528	RXPARMS ; branch her e from abo ve
	12529	"RTN","RCD PESP",121, 0)
	12530	;-------- ---------- ---------- ---------- --------
	12531	"RTN","RCD PESP",122, 0)
	12532	; Enable/ disable au to-posting of pharma cy claims
	12533	"RTN","RCD PESP",123, 0)
	12534	;-------- ---------- ---------- ---------- --------
	12535	"RTN","RCD PESP",124, 0)
	12536	N APPC,AP PCT
	12537	"RTN","RCD PESP",125, 0)
	12538	; APPC=AU TO POSTING OF PHARMA CY CLAIMS ENABLED
	12539	"RTN","RCD PESP",126, 0)
	12540	; APPCT=T EMP APMC
	12541	"RTN","RCD PESP",127, 0)
	12542	S APPCT=$ $GET1^DIQ( 344.61,"1, ",1.01,"I" ),APPC=$S( APPCT=1:"Y es",APPCT= 0:"No",1:" ")
	12543	"RTN","RCD PESP",128, 0)
	12544	K DIR S D IR(0)="YA" ,DIR("B")= $S(APPC="" :"Yes",1:A PPC)
	12545	"RTN","RCD PESP",129, 0)
	12546	S DIR("A" )=$$GET1^D ID(344.61, 1.01,,"TIT LE")
	12547	"RTN","RCD PESP",130, 0)
	12548	S DIR("?" )=$$GET1^D ID(344.61, 1.01,,"HEL P-PROMPT")
	12549	"RTN","RCD PESP",131, 0)
	12550	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12551	"RTN","RCD PESP",132, 0)
	12552	I APPCT'= Y D ; use r updated value
	12553	"RTN","RCD PESP",133, 0)
	12554	.S FDAEDI (344.61,"1 ,",1.01)=Y D FILE^DI E(,"FDAEDI ") K FDAED I
	12555	"RTN","RCD PESP",134, 0)
	12556	.D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"mis sing"),1)
	12557	"RTN","RCD PESP",135, 0)
	12558	.S RCAUDV AL(1)="344 .61^1.01^1 ^"_Y_U_('Y ) D AUDIT( .RCAUDVAL) K RCAUDVA L
	12559	"RTN","RCD PESP",136, 0)
	12560	;
	12561	"RTN","RCD PESP",137, 0)
	12562	; If yes, set/Reset payer exc lusions fo r pharmacy claims po sting
	12563	"RTN","RCD PESP",138, 0)
	12564	I Y=1 D G:$G(RCQUI T)=1 ABORT
	12565	"RTN","RCD PESP",139, 0)
	12566	. D EXCLL IST(3) ; D isplay the exclusion list
	12567	"RTN","RCD PESP",140, 0)
	12568	. D SETEX CL(3) Q:$G (RCQUIT) ; SET/RESE T exclusio ns
	12569	"RTN","RCD PESP",141, 0)
	12570	. D EXCLL IST(3) ; D isplay the exclusion list
	12571	"RTN","RCD PESP",142, 0)
	12572	. W !
	12573	"RTN","RCD PESP",143, 0)
	12574	. ;
	12575	"RTN","RCD PESP",144, 0)
	12576	;
	12577	"RTN","RCD PESP",145, 0)
	12578	; Show Ph armacy pro mpt but do n't allow change
	12579	"RTN","RCD PESP",146, 0)
	12580	D:$$GET1^ DIQ(344.61 ,"1,",1.01 ,"I")=1 G :$G(RCQUIT )=1 ABORT
	12581	"RTN","RCD PESP",147, 0)
	12582	. W !,"EN ABLE AUTO- DECREASE O F PHARMACY CLAIMS (Y /N): NO//"
	12583	"RTN","RCD PESP",148, 0)
	12584	. W !," Determine s if auto- decrease o f pharmacy claims ar e enabled for this s ite."
	12585	"RTN","RCD PESP",149, 0)
	12586	. W !," NOTE: No t editable and set t o Disabled until fur ther notic e.",!
	12587	"RTN","RCD PESP",150, 0)
	12588	. K DIR S DIR(0)="E A"
	12589	"RTN","RCD PESP",151, 0)
	12590	. S DIR(" A")="Press Enter to continue: "
	12591	"RTN","RCD PESP",152, 0)
	12592	. D ^DIR I $D(DTOUT )!$D(DUOUT ) S RCQUIT =1
	12593	"RTN","RCD PESP",153, 0)
	12594	. W !
	12595	"RTN","RCD PESP",154, 0)
	12596	;
	12597	"RTN","RCD PESP",155, 0)
	12598	; set MED ICAL EFT O VERRIDE ^D D(344.61,. 06,0) = ME DICAL EFT POST PREVE NT DAYS
	12599	"RTN","RCD PESP",156, 0)
	12600	N MEO S M EO=$$GET1^ DIQ(344.61 ,"1,",.06)
	12601	"RTN","RCD PESP",157, 0)
	12602	K DIR S:M EO]"" DIR( "B")=MEO
	12603	"RTN","RCD PESP",158, 0)
	12604	S DIR("?" )=$$GET1^D ID(344.61, .06,,"HELP -PROMPT")
	12605	"RTN","RCD PESP",159, 0)
	12606	S DIR(0)= "NA^14:99: 0",DIR("A" )=$$GET1^D ID(344.61, .06,,"TITL E")
	12607	"RTN","RCD PESP",160, 0)
	12608	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12609	"RTN","RCD PESP",161, 0)
	12610	I MEO'=Y D ; updat e and audi t
	12611	"RTN","RCD PESP",162, 0)
	12612	.S RCAUDV AL(1)="344 .61^.06^1^ "_Y_U_MEO
	12613	"RTN","RCD PESP",163, 0)
	12614	.S FDAEDI (344.61,"1 ,",.06)=Y D FILE^DIE (,"FDAEDI" )
	12615	"RTN","RCD PESP",164, 0)
	12616	.D AUDIT( .RCAUDVAL) K RCAUDVA L
	12617	"RTN","RCD PESP",165, 0)
	12618	;
	12619	"RTN","RCD PESP",166, 0)
	12620	;-------- ---------- ---------- ---------- --------
	12621	"RTN","RCD PESP",167, 0)
	12622	; Set PHA RMACY EFT OVERRIDE
	12623	"RTN","RCD PESP",168, 0)
	12624	;-------- ---------- ---------- ---------- --------
	12625	"RTN","RCD PESP",169, 0)
	12626	N PEO S P EO=$$GET1^ DIQ(344.61 ,"1,",.07)
	12627	"RTN","RCD PESP",170, 0)
	12628	K DIR S:P EO]"" DIR( "B")=PEO
	12629	"RTN","RCD PESP",171, 0)
	12630	S DIR("?" )=$$GET1^D ID(344.61, .07,,"HELP -PROMPT")
	12631	"RTN","RCD PESP",172, 0)
	12632	S DIR(0)= "NA^21:999 :0",DIR("A ")=$$GET1^ DID(344.61 ,.07,,"TIT LE")
	12633	"RTN","RCD PESP",173, 0)
	12634	D ^DIR I $D(DTOUT)! $D(DUOUT) G ABORT
	12635	"RTN","RCD PESP",174, 0)
	12636	I PEO'=Y D ; updat e and audi t
	12637	"RTN","RCD PESP",175, 0)
	12638	.S RCAUDV AL(1)="344 .61^.07^1^ "_Y_U_PEO
	12639	"RTN","RCD PESP",176, 0)
	12640	.S FDAEDI (344.61,"1 ,",.07)=Y D FILE^DIE (,"FDAEDI" )
	12641	"RTN","RCD PESP",177, 0)
	12642	.D AUDIT( .RCAUDVAL) K RCAUDVA L
	12643	"RTN","RCD PESP",178, 0)
	12644	;
	12645	"RTN","RCD PESP",179, 0)
	12646	G EXIT
	12647	"RTN","RCD PESP",180, 0)
	12648	;
	12649	"RTN","RCD PESP",181, 0)
	12650	ABORT ; Ca lled when user enter s a '^' or times out
	12651	"RTN","RCD PESP",182, 0)
	12652	; fall th rough to E XIT
	12653	"RTN","RCD PESP",183, 0)
	12654	;
	12655	"RTN","RCD PESP",184, 0)
	12656	EXIT ; unL OCK, ask u ser to pre ss return, exit
	12657	"RTN","RCD PESP",185, 0)
	12658	L -^RCY(3 44.61,1)
	12659	"RTN","RCD PESP",186, 0)
	12660	D PAUSE
	12661	"RTN","RCD PESP",187, 0)
	12662	Q
	12663	"RTN","RCD PESP",188, 0)
	12664	;
	12665	"RTN","RCD PESP",189, 0)
	12666	PAUSE ; pr ompt user to press r eturn
	12667	"RTN","RCD PESP",190, 0)
	12668	W ! N DIR
	12669	"RTN","RCD PESP",191, 0)
	12670	S DIR("T" )=3,DIR(0) ="E",DIR(" A")="Press RETURN to continue" D ^DIR
	12671	"RTN","RCD PESP",192, 0)
	12672	Q
	12673	"RTN","RCD PESP",193, 0)
	12674	;
	12675	"RTN","RCD PESP",194, 0)
	12676	COUNT(TYPE ) ; Count active CAR Cs in file 344.62 (R CDPE CARC- RARC AUTO DEC)
	12677	"RTN","RCD PESP",195, 0)
	12678	N NUM,I
	12679	"RTN","RCD PESP",196, 0)
	12680	I (TYPE'= 1)&(TYPE'= 0) Q 0 ; If TYPE is not activ e (1) or i n-active ( 0) quit wi th count = 0
	12681	"RTN","RCD PESP",197, 0)
	12682	S NUM=0
	12683	"RTN","RCD PESP",198, 0)
	12684	S I="" F S I=$O(^R CY(344.62, "ACTV",TYP E,I)) Q:I= "" S NUM= NUM+1
	12685	"RTN","RCD PESP",199, 0)
	12686	Q NUM
	12687	"RTN","RCD PESP",200, 0)
	12688	;
	12689	"RTN","RCD PESP",201, 0)
	12690	EXCLLIST(T YP) ; CHOI CE determi nes which exclusions to list
	12691	"RTN","RCD PESP",202, 0)
	12692	; TYP - T YPE OF EXL USION - RE QUIRED
	12693	"RTN","RCD PESP",203, 0)
	12694	; IX - wh ich index to use
	12695	"RTN","RCD PESP",204, 0)
	12696	; IEN - p oints to a n excluded payer for the selec ted choice
	12697	"RTN","RCD PESP",205, 0)
	12698	Q:'("^1^2 ^3^"[(U_$G (TYP)_U)) ; one or two only
	12699	"RTN","RCD PESP",206, 0)
	12700	N IX,IEN, CT,LIST S (IEN,CT)=0 W !
	12701	"RTN","RCD PESP",207, 0)
	12702	S IX=$S(T YP=1:"EXMD POST",TYP= 2:"EXMDDEC R",TYP=3:" EXRXPOST", 1:"") ;,TY P=4:"EXRXD ECR",1:"")
	12703	"RTN","RCD PESP",208, 0)
	12704	S LIST=$S (TYP=1:"", TYP=3:"",1 :"** Addit ional ")_" Payers exc luded from "_$S(TYP= 1:"Medical Auto-Post ing:",TYP= 3:"Pharmac y Auto-Pos ting",1:"M edical Aut o-Decrease :")
	12705	"RTN","RCD PESP",209, 0)
	12706	F S IEN= $O(^RCY(34 4.6,IX,1,I EN)) Q:'IE N D
	12707	"RTN","RCD PESP",210, 0)
	12708	. S CT=CT +1
	12709	"RTN","RCD PESP",211, 0)
	12710	. W:CT=1 !,LIST
	12711	"RTN","RCD PESP",212, 0)
	12712	. W !," "_$P(^RCY( 344.6,IEN, 0),U,1)_" "_$P(^RCY( 344.6,IEN, 0),U,2)
	12713	"RTN","RCD PESP",213, 0)
	12714	;
	12715	"RTN","RCD PESP",214, 0)
	12716	I TYP=2 W !,"All pa yers exclu ded from A uto-Postin g are also excluded from Auto- Decrease."
	12717	"RTN","RCD PESP",215, 0)
	12718	W:CT=0 !, " No "_$ S(TYP=2:"a dditional ",1:"")_"p ayers excl uded from "_$S(TYP=1 :"Medical Auto-Posti ng:",TYP=3 :"Pharmacy Auto-Post ing",1:"Me dical Auto -Decrease: ")
	12719	"RTN","RCD PESP",216, 0)
	12720	; if list is for au to-decreas e and ther e are excl usions wri te a messa ge
	12721	"RTN","RCD PESP",217, 0)
	12722	Q
	12723	"RTN","RCD PESP",218, 0)
	12724	;
	12725	"RTN","RCD PESP",219, 0)
	12726	SETEXCL(TY P) ; LOOP FOR SETTIN G PAYER EX CLUSIONS
	12727	"RTN","RCD PESP",220, 0)
	12728	; TYP - T YPE OF EXL USION - RE QUIRED
	12729	"RTN","RCD PESP",221, 0)
	12730	N FDAPAYE R,IEN,DONE ,CT,X,Y,FL D,RTYP,DIC ,DIR,RCAUD VAL,PREC,C MT
	12731	"RTN","RCD PESP",222, 0)
	12732	; FDAPAYE R - FDA FO R FILE 344 .6
	12733	"RTN","RCD PESP",223, 0)
	12734	; FLD - F IELD BEING MODIFIED
	12735	"RTN","RCD PESP",224, 0)
	12736	; RTYP - STRING REP RESENTING FIELD
	12737	"RTN","RCD PESP",225, 0)
	12738	; DONE - INDICATOR TO LEAVE L OOP
	12739	"RTN","RCD PESP",226, 0)
	12740	; RCAUDVA L - ARRAY FOR AUDITI NG
	12741	"RTN","RCD PESP",227, 0)
	12742	; PREC - HOLDER FOR Y(0) AFTE R ^DIC CAL L
	12743	"RTN","RCD PESP",228, 0)
	12744	; FILE NUMB ER^FIELD N UMBER^IEN^ NEW VALUE^ OLD VALUE, COMMENT
	12745	"RTN","RCD PESP",229, 0)
	12746	I $G(TYP) =1 S FLD=. 06,CMT=1,R TYP="MEDIC AL CLAIMS POSTING"
	12747	"RTN","RCD PESP",230, 0)
	12748	I $G(TYP) =2 S FLD=. 07,CMT=2,R TYP="MEDIC AL CLAIMS DECREASE"
	12749	"RTN","RCD PESP",231, 0)
	12750	I $G(TYP) =3 S FLD=. 08,CMT=3,R TYP="PHARM ACY CLAIMS POSTING"
	12751	"RTN","RCD PESP",232, 0)
	12752	I '$D(FLD ) Q
	12753	"RTN","RCD PESP",233, 0)
	12754	;
	12755	"RTN","RCD PESP",234, 0)
	12756	W !!,"Sel ect a Paye r to add o r remove f rom the ex clusion li st.",!
	12757	"RTN","RCD PESP",235, 0)
	12758	S (RCQUIT ,CT,DONE)= 0 F Q:DON E!RCQUIT D
	12759	"RTN","RCD PESP",236, 0)
	12760	. S DIC=" ^RCY(344.6 ,",DIC(0)= "AEMQZ",DI C("A")="Pa yer: " D ^ DIC I X="^ " S RCQUIT =1 Q
	12761	"RTN","RCD PESP",237, 0)
	12762	. I +$G(Y )<1 S DONE =1 Q
	12763	"RTN","RCD PESP",238, 0)
	12764	. S CT=CT +1,IEN=+Y, IENS=IEN_" ,",PREC=Y( 0)
	12765	"RTN","RCD PESP",239, 0)
	12766	. K FDAPA YER
	12767	"RTN","RCD PESP",240, 0)
	12768	. N COMME NT,STAT
	12769	"RTN","RCD PESP",241, 0)
	12770	. S COMME NT=""
	12771	"RTN","RCD PESP",242, 0)
	12772	. S STAT= '$$GET1^DI Q(344.6,IE NS,FLD,"I" )
	12773	"RTN","RCD PESP",243, 0)
	12774	. S FDAPA YER(344.6, IENS,FLD)= STAT
	12775	"RTN","RCD PESP",244, 0)
	12776	. ; GET C OMMENT HER E
	12777	"RTN","RCD PESP",245, 0)
	12778	. K Y S D IR("A")="C OMMENT: ", DIR(0)="FA ^3:72"
	12779	"RTN","RCD PESP",246, 0)
	12780	. S DIR(" PRE")="S X =$$TRIM^XL FSTR(X,""L R"")" ; co mment requ ired and s hould be s ignificant
	12781	"RTN","RCD PESP",247, 0)
	12782	. S DIR(" ?")="Enter an explan ation for "_$S(STAT: "adding th e payer to ",1:"remov ing the pa yer from") _" the lis t of Exclu ded Payers ."
	12783	"RTN","RCD PESP",248, 0)
	12784	. D ^DIR I $D(DTOUT )!$D(DUOUT )!(Y="") S RCQUIT=1 Q
	12785	"RTN","RCD PESP",249, 0)
	12786	. S COMME NT=Y
	12787	"RTN","RCD PESP",250, 0)
	12788	. I COMME NT]"" D
	12789	"RTN","RCD PESP",251, 0)
	12790	. . I STA T S FDAPAY ER(344.6,I ENS,CMT)=C OMMENT
	12791	"RTN","RCD PESP",252, 0)
	12792	. . E S FDAPAYER(3 44.6,IENS, CMT)=""
	12793	"RTN","RCD PESP",253, 0)
	12794	. . W !,$ P(PREC,U,1 )_" "_$P(P REC,U,2)_" has been "
	12795	"RTN","RCD PESP",254, 0)
	12796	. . W $S( STAT:"adde d to",1:"r emoved fro m")_" the list of Ex cluded Pay ers"
	12797	"RTN","RCD PESP",255, 0)
	12798	. . I TYP =1 D
	12799	"RTN","RCD PESP",256, 0)
	12800	. . . W ! ,"If medic al auto-de crease is turned on, "
	12801	"RTN","RCD PESP",257, 0)
	12802	. . . I S TAT W "thi s payer wi ll be excl uded from medical au to-decreas e too."
	12803	"RTN","RCD PESP",258, 0)
	12804	. . . I ' STAT,'$$GE T1^DIQ(344 .6,IEN_"," ,.07,"I") W "this pa yer will n o longer b e excluded from Medi cal Auto-D ecrease."
	12805	"RTN","RCD PESP",259, 0)
	12806	. . . I ' STAT,$$GET 1^DIQ(344. 6,IEN_",", .07,"I") W "Medical Auto-Decre ase is set to be exc luded for this payer ."
	12807	"RTN","RCD PESP",260, 0)
	12808	. . K RCA UDVAL
	12809	"RTN","RCD PESP",261, 0)
	12810	. . D FIL E^DIE(,"FD APAYER")
	12811	"RTN","RCD PESP",262, 0)
	12812	. . S RCA UDVAL(1)=" 344.6"_U_F LD_U_IEN_U _STAT_U_(' STAT)_U_CO MMENT
	12813	"RTN","RCD PESP",263, 0)
	12814	. . D AUD IT(.RCAUDV AL) K RCAU DVAL
	12815	"RTN","RCD PESP",264, 0)
	12816	Q
	12817	"RTN","RCD PESP",265, 0)
	12818	;
	12819	"RTN","RCD PESP",266, 0)
	12820	NOTIFY(VAL ,TYPE) ; N otify CBO team of ch ange to Si te Paramet ers
	12821	"RTN","RCD PESP",267, 0)
	12822	N GLB,GLO ,MSG,SITE, SUBJ,XMINS TR,XMTO
	12823	"RTN","RCD PESP",268, 0)
	12824	S SITE=$$ SITE^VASIT E
	12825	"RTN","RCD PESP",269, 0)
	12826	S TYPE=+$ G(TYPE) ; init optio nal parame ter
	12827	"RTN","RCD PESP",270, 0)
	12828	; limit s ubject to 65 chars.
	12829	"RTN","RCD PESP",271, 0)
	12830	S SUBJ=$E ("Site Par ameter edi t, Station #"_$P(SIT E,U,3)_" - "_$P(SITE ,U,2),1,65 )
	12831	"RTN","RCD PESP",272, 0)
	12832	S MSG(1)= " "
	12833	"RTN","RCD PESP",273, 0)
	12834	S MSG(2)= " S ite: "_$P( SITE,U,2)
	12835	"RTN","RCD PESP",274, 0)
	12836	S MSG(3)= " Statio n #: "_$P( SITE,U,3)
	12837	"RTN","RCD PESP",275, 0)
	12838	S MSG(4)= " Dom ain: "_$G( ^XMB("NETN AME"))
	12839	"RTN","RCD PESP",276, 0)
	12840	S MSG(5)= " Date/T ime: "_$$F MTE^XLFDT( $$NOW^XLFD T,"5ZPM")
	12841	"RTN","RCD PESP",277, 0)
	12842	S MSG(6)= " Changed by: "_$P( $G(^VA(200 ,DUZ,0)),U )
	12843	"RTN","RCD PESP",278, 0)
	12844	S MSG(7)= " "
	12845	"RTN","RCD PESP",279, 0)
	12846	S MSG(8)= " ENABLE AUTO-POSTI NG OF "_$S (TYPE=1:"P HARMACY",1 :"MEDICAL" )_" CLAIMS = "_VAL
	12847	"RTN","RCD PESP",280, 0)
	12848	S MSG(9)= " "
	12849	"RTN","RCD PESP",281, 0)
	12850	;Copy mes sage to eP ayments CB O team
	12851	"RTN","RCD PESP",282, 0)
	12852	S XMTO(DU Z)=""
	12853	"RTN","RCD PESP",283, 0)
	12854	S:$$PROD^ XUPROD XMT O(" P II ")=""
	12855	"RTN","RCD PESP",284, 0)
	12856	;
	12857	"RTN","RCD PESP",285, 0)
	12858	K ^TMP("X MERR",$J)
	12859	"RTN","RCD PESP",286, 0)
	12860	D SENDMSG ^XMXAPI(DU Z,SUBJ,"MS G",.XMTO,. XMINSTR)
	12861	"RTN","RCD PESP",287, 0)
	12862	;
	12863	"RTN","RCD PESP",288, 0)
	12864	I $D(^TMP ("XMERR",$ J)) D
	12865	"RTN","RCD PESP",289, 0)
	12866	.D MES^XP DUTL("Mail Man report ed a probl em trying to send th e notifica tion messa ge.")
	12867	"RTN","RCD PESP",290, 0)
	12868	.D MES^XP DUTL(" ")
	12869	"RTN","RCD PESP",291, 0)
	12870	.S (GLO,G LB)="^TMP( ""XMERR"", "_$J
	12871	"RTN","RCD PESP",292, 0)
	12872	.S GLO=GL O_")"
	12873	"RTN","RCD PESP",293, 0)
	12874	.F S GLO =$Q(@GLO) Q:GLO'[GLB D MES^XP DUTL(" " _GLO_" = " _$G(@GLO))
	12875	"RTN","RCD PESP",294, 0)
	12876	.D MES^XP DUTL(" ")
	12877	"RTN","RCD PESP",295, 0)
	12878	Q
	12879	"RTN","RCD PESP",296, 0)
	12880	;
	12881	"RTN","RCD PESP",297, 0)
	12882	AUDIT(INP) ; WRITE A UDIT RECOR D(S)
	12883	"RTN","RCD PESP",298, 0)
	12884	; INP = a udit value in this f ormat:
	12885	"RTN","RCD PESP",299, 0)
	12886	; F ILE NUMBER ^FIELD NUM BER^IEN^NE W VALUE^OL D VALUE^CO MMENT
	12887	"RTN","RCD PESP",300, 0)
	12888	Q:'$O(INP (0)) ; n othing to audit
	12889	"RTN","RCD PESP",301, 0)
	12890	N FDAUDT ; FileMan FDA array for audit s
	12891	"RTN","RCD PESP",302, 0)
	12892	N IDX S I DX=0
	12893	"RTN","RCD PESP",303, 0)
	12894	F S IDX= $O(INP(IDX )) Q:'IDX D
	12895	"RTN","RCD PESP",304, 0)
	12896	. K FDAUD T
	12897	"RTN","RCD PESP",305, 0)
	12898	. S FDAUD T(344.7,"+ 1,",.01)=$ $NOW^XLFDT
	12899	"RTN","RCD PESP",306, 0)
	12900	. S FDAUD T(344.7,"+ 1,",.02)=$ P(INP(IDX) ,U,3) ; IE N
	12901	"RTN","RCD PESP",307, 0)
	12902	. S FDAUD T(344.7,"+ 1,",.03)=D UZ ; user
	12903	"RTN","RCD PESP",308, 0)
	12904	. S FDAUD T(344.7,"+ 1,",.04)=$ P(INP(IDX) ,U,2) ; FI ELD NUMBER
	12905	"RTN","RCD PESP",309, 0)
	12906	. S FDAUD T(344.7,"+ 1,",.05)=$ P(INP(IDX) ,U,1) ; FI LE NUMBER
	12907	"RTN","RCD PESP",310, 0)
	12908	. S FDAUD T(344.7,"+ 1,",.06)=$ P(INP(IDX) ,U,4) ; NE W VALUE
	12909	"RTN","RCD PESP",311, 0)
	12910	. S FDAUD T(344.7,"+ 1,",.07)=$ P(INP(IDX) ,U,5) ; OL D VALUE
	12911	"RTN","RCD PESP",312, 0)
	12912	. S FDAUD T(344.7,"+ 1,",.08)=$ P(INP(IDX) ,U,6) ; CO MMENT
	12913	"RTN","RCD PESP",313, 0)
	12914	. D UPDAT E^DIE(,"FD AUDT")
	12915	"RTN","RCD PESP",314, 0)
	12916	Q
	12917	"RTN","RCD PESP",315, 0)
	12918	;
	12919	"RTN","RCD PESP",316, 0)
	12920	; ***** ****** ****** ****** ****** ****** **
	12921	"RTN","RCD PESP",317, 0)
	12922	; CALLS R ELATED TO CREATING E PAYMENT PA YER EXCLUS ION PARAME TERS
	12923	"RTN","RCD PESP",318, 0)
	12924	; ***** ****** ****** ****** ****** ****** **
	12925	"RTN","RCD PESP",319, 0)
	12926	;
	12927	"RTN","RCD PESP",320, 0)
	12928	NEWPYR ;Ad d new paye rs to paye r table - called fro m AR Night ly Job (EN ^RCDPEM)
	12929	"RTN","RCD PESP",321, 0)
	12930	N RCDATE, RCERA,RCUP D
	12931	"RTN","RCD PESP",322, 0)
	12932	;Get date /time of l ast run ot herwise st art at pre vious day
	12933	"RTN","RCD PESP",323, 0)
	12934	S RCDATE= $P($G(^RCY (344.61,1, 0)),U,8) S :RCDATE="" RCDATE=$$ FMADD^XLFD T($$NOW^XL FDT\1,-1)
	12935	"RTN","RCD PESP",324, 0)
	12936	F S RCDA TE=$O(^RCY (344.4,"AF D",RCDATE) ) Q:'RCDAT E D
	12937	"RTN","RCD PESP",325, 0)
	12938	.S RCERA= "" F S RC ERA=$O(^RC Y(344.4,"A FD",RCDATE ,RCERA)) Q :'RCERA S RCUPD=$$P AYRINIT(RC ERA)
	12939	"RTN","RCD PESP",326, 0)
	12940	;Update l ast run da te
	12941	"RTN","RCD PESP",327, 0)
	12942	S $P(^RCY (344.61,1, 0),U,8)=$$ NOW^XLFDT
	12943	"RTN","RCD PESP",328, 0)
	12944	Q
	12945	"RTN","RCD PESP",329, 0)
	12946	;
	12947	"RTN","RCD PESP",330, 0)
	12948	PAYERPRM(I EN,EXMDPOS T,EXMDDECR ) ; USED T O UPDATE A NEW PAYER
	12949	"RTN","RCD PESP",331, 0)
	12950	; CHECK I EN FOR VAL ID INPUT
	12951	"RTN","RCD PESP",332, 0)
	12952	Q:'$G(IEN )!('$D(^RC Y(344.4,+$ G(IEN),0)) ) 0
	12953	"RTN","RCD PESP",333, 0)
	12954	N PFDA,PA YER,ID,CPA YERID,PIEN S
	12955	"RTN","RCD PESP",334, 0)
	12956	S PAYER=$ E($$GET1^D IQ(344.4,I EN_",",.06 ),1,35)
	12957	"RTN","RCD PESP",335, 0)
	12958	Q:PAYER=" " 0
	12959	"RTN","RCD PESP",336, 0)
	12960	S ID=$E($ $GET1^DIQ( 344.4,IEN_ ",",.03),1 ,30)
	12961	"RTN","RCD PESP",337, 0)
	12962	I '$D(^RC Y(344.6,"C PID",PAYER ,ID)) Q 0
	12963	"RTN","RCD PESP",338, 0)
	12964	; FILE CU RRENT SETT INGS
	12965	"RTN","RCD PESP",339, 0)
	12966	S PIENS=$ O(^RCY(344 .6,"CPID", PAYER,ID,0 ))_","
	12967	"RTN","RCD PESP",340, 0)
	12968	S PFDA(34 4.6,PIENS, .04)=DUZ
	12969	"RTN","RCD PESP",341, 0)
	12970	S PFDA(34 4.6,PIENS, .05)=$$NOW ^XLFDT
	12971	"RTN","RCD PESP",342, 0)
	12972	S PFDA(34 4.6,PIENS, .06)=+$G(E XMDPOST)
	12973	"RTN","RCD PESP",343, 0)
	12974	S PFDA(34 4.6,PIENS, .07)=+$G(E XMDDECR)
	12975	"RTN","RCD PESP",344, 0)
	12976	D FILE^DI E(,"PFDA")
	12977	"RTN","RCD PESP",345, 0)
	12978	Q 1
	12979	"RTN","RCD PESP",346, 0)
	12980	;
	12981	"RTN","RCD PESP",347, 0)
	12982	PAYRINIT(I EN) ; Add Payer Name and Payer ID to Pay er table # 344.6
	12983	"RTN","RCD PESP",348, 0)
	12984	;
	12985	"RTN","RCD PESP",349, 0)
	12986	N PFDA,PA YER,ID,PIE NS,ERADATE
	12987	"RTN","RCD PESP",350, 0)
	12988	;
	12989	"RTN","RCD PESP",351, 0)
	12990	Q:'$G(IEN )!('$D(^RC Y(344.4,+$ G(IEN)))) 0
	12991	"RTN","RCD PESP",352, 0)
	12992	S PAYER=$ P($G(^RCY( 344.4,IEN, 0)),U,6) Q :PAYER="" 0
	12993	"RTN","RCD PESP",353, 0)
	12994	S ID=$P($ G(^RCY(344 .4,IEN,0)) ,U,3) Q:ID ="" 0
	12995	"RTN","RCD PESP",354, 0)
	12996	I $D(^RCY (344.6,"CP ID",PAYER, ID)) Q 1
	12997	"RTN","RCD PESP",355, 0)
	12998	S ERADATE =$P($G(^RC Y(344.4,IE N,0)),U,7)
	12999	"RTN","RCD PESP",356, 0)
	13000	; UPDATE PAYER PARA METERS
	13001	"RTN","RCD PESP",357, 0)
	13002	S PIENS=" +1,"
	13003	"RTN","RCD PESP",358, 0)
	13004	S PFDA(34 4.6,PIENS, .01)=PAYER
	13005	"RTN","RCD PESP",359, 0)
	13006	S PFDA(34 4.6,PIENS, .02)=ID
	13007	"RTN","RCD PESP",360, 0)
	13008	S PFDA(34 4.6,PIENS, .03)=ERADA TE
	13009	"RTN","RCD PESP",361, 0)
	13010	S PFDA(34 4.6,PIENS, .04)=.5
	13011	"RTN","RCD PESP",362, 0)
	13012	S PFDA(34 4.6,PIENS, .05)=$$NOW ^XLFDT
	13013	"RTN","RCD PESP",363, 0)
	13014	S PFDA(34 4.6,PIENS, .06)=0
	13015	"RTN","RCD PESP",364, 0)
	13016	S PFDA(34 4.6,PIENS, .07)=0
	13017	"RTN","RCD PESP",365, 0)
	13018	D UPDATE^ DIE(,"PFDA ")
	13019	"RTN","RCD PESP",366, 0)
	13020	Q 1
	13021	"RTN","RCD PESP1")
	13022	0^4^B10207 7824^B1020 77824
	13023	"RTN","RCD PESP1",1,0 )
	13024	RCDPESP1 ; BIRM/SAB,h rubovcak - ePayment Lockbox Si te Paramet er Reports ;7/1/15
	13025	"RTN","RCD PESP1",2,0 )
	13026	;;4.5;Acc ounts Rece ivable;2 98,304,318 ;Mar 20, 1995;Buil d 25
	13027	"RTN","RCD PESP1",3,0 )
	13028	;Per VA D irective 6 402, this routine sh ould not b e modified .
	13029	"RTN","RCD PESP1",4,0 )
	13030	;
	13031	"RTN","RCD PESP1",5,0 )
	13032	Q
	13033	"RTN","RCD PESP1",6,0 )
	13034	;
	13035	"RTN","RCD PESP1",7,0 )
	13036	RPT ; EDI Lockbox Pa rameters R eport [RCD PE SITE PA RAMETER RE PORT]
	13037	"RTN","RCD PESP1",8,0 )
	13038	; report data from:
	13039	"RTN","RCD PESP1",9,0 )
	13040	; AR S ITE PARAME TER file ( #342)
	13041	"RTN","RCD PESP1",10, 0)
	13042	; RCDP E PARAMETE R file (#3 44.61)
	13043	"RTN","RCD PESP1",11, 0)
	13044	; RCDP E AUTO-PAY EXCLUSION file (#34 4.6)
	13045	"RTN","RCD PESP1",12, 0)
	13046	;
	13047	"RTN","RCD PESP1",13, 0)
	13048	; LOCAL V ARIABLES:
	13049	"RTN","RCD PESP1",14, 0)
	13050	; RTYP E - Type o f Report t o run (Med ical, Phar macy, or B oth)
	13051	"RTN","RCD PESP1",15, 0)
	13052	;
	13053	"RTN","RCD PESP1",16, 0)
	13054	N RCTYPE
	13055	"RTN","RCD PESP1",17, 0)
	13056	W !,$$HDR LN,!
	13057	"RTN","RCD PESP1",18, 0)
	13058	;
	13059	"RTN","RCD PESP1",19, 0)
	13060	S RCTYPE= $$RTYPE^RC DPESP2() G :RCTYPE=-1 RPTQ
	13061	"RTN","RCD PESP1",20, 0)
	13062	W !! ;S pacing bef ore the ne xt prompt
	13063	"RTN","RCD PESP1",21, 0)
	13064	;
	13065	"RTN","RCD PESP1",22, 0)
	13066	N %ZIS,PO P S %ZIS=" QM" D ^%ZI S Q:POP
	13067	"RTN","RCD PESP1",23, 0)
	13068	I $D(IO(" Q")) D Q
	13069	"RTN","RCD PESP1",24, 0)
	13070	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK
	13071	"RTN","RCD PESP1",25, 0)
	13072	.S ZTRTN= "SPRPT^RCD PESP1",ZTD ESC=$$HDRL N,ZTSAVE(" RC*")=""
	13073	"RTN","RCD PESP1",26, 0)
	13074	.D ^%ZTLO AD
	13075	"RTN","RCD PESP1",27, 0)
	13076	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	13077	"RTN","RCD PESP1",28, 0)
	13078	.K IO("Q" ) D HOME^% ZIS
	13079	"RTN","RCD PESP1",29, 0)
	13080	;
	13081	"RTN","RCD PESP1",30, 0)
	13082	D SPRPT
	13083	"RTN","RCD PESP1",31, 0)
	13084	RPTQ Q
	13085	"RTN","RCD PESP1",32, 0)
	13086	;
	13087	"RTN","RCD PESP1",33, 0)
	13088	SPRPT ; si te paramet er report entry poin t
	13089	"RTN","RCD PESP1",34, 0)
	13090	; RCNTR - counter
	13091	"RTN","RCD PESP1",35, 0)
	13092	; RCFLD - DD field number
	13093	"RTN","RCD PESP1",36, 0)
	13094	; RCHDR - header in formation
	13095	"RTN","RCD PESP1",37, 0)
	13096	; RCPARM - paramete rs
	13097	"RTN","RCD PESP1",38, 0)
	13098	; RCSTOP - exit fla g
	13099	"RTN","RCD PESP1",39, 0)
	13100	N J,RCNTR ,RCFLD,RCG LB,RCHDR,R CPARM,RCST OP,V,X,Y,R CSTRING
	13101	"RTN","RCD PESP1",40, 0)
	13102	N RCDATA, RCCODE,RCD ESC,RCSTAT ,RCI,RCCAR CD,RCCIEN, RCITEM,RCA CTV
	13103	"RTN","RCD PESP1",41, 0)
	13104	;
	13105	"RTN","RCD PESP1",42, 0)
	13106	S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP( $J,X) ; cl ear out ol d data
	13107	"RTN","RCD PESP1",43, 0)
	13108	;
	13109	"RTN","RCD PESP1",44, 0)
	13110	; RCGLB - ^TMP glob al storage locations
	13111	"RTN","RCD PESP1",45, 0)
	13112	; ^TM P($J,"RC34 2") - AR S ITE PARAME TER file ( #342)
	13113	"RTN","RCD PESP1",46, 0)
	13114	; ^TMP( $J,"RC344. 6") - RCDP E AUTO-PAY EXCLUSION file (#34 4.6)
	13115	"RTN","RCD PESP1",47, 0)
	13116	; ^TMP($ J,"RC344.6 1") - RCDP E PARAMETE R file (#3 44.61)
	13117	"RTN","RCD PESP1",48, 0)
	13118	F J=342,3 44.6,344.6 1 S RCGLB( J)=$NA(^TM P($J,"RC"_ J)) K @RCG LB(J)
	13119	"RTN","RCD PESP1",49, 0)
	13120	;
	13121	"RTN","RCD PESP1",50, 0)
	13122	S RCHDR(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"10S" )
	13123	"RTN","RCD PESP1",51, 0)
	13124	S RCHDR(" PGNMBR")=0 ; page n umber
	13125	"RTN","RCD PESP1",52, 0)
	13126	;
	13127	"RTN","RCD PESP1",53, 0)
	13128	; AR SITE PARAMETER file (#34 2)
	13129	"RTN","RCD PESP1",54, 0)
	13130	D GETS^DI Q(342,"1," ,".01;7.02 ;7.03;7.04 ;7.05;7.06 ","E",RCGL B(342))
	13131	"RTN","RCD PESP1",55, 0)
	13132	; add sit e to heade r data
	13133	"RTN","RCD PESP1",56, 0)
	13134	S RCHDR(" SITE")="Si te: "_@RCG LB(342)@(3 42,"1,",.0 1,"E")
	13135	"RTN","RCD PESP1",57, 0)
	13136	;
	13137	"RTN","RCD PESP1",58, 0)
	13138	F RCFLD=7 .02,7.03,7 .04,7.05,7 .06 S RCIT EM=$S(RCFL D=7.05:"TI TLE",RCFLD =7.06:"TIT LE",1:"LAB EL") D ; EFT and ER A days unm atched
	13139	"RTN","RCD PESP1",59, 0)
	13140	. Q:(RCFL D=7.05)&(R CTYPE="P") ; Dont d isplay if only showi ng Pharmac y paramete rs
	13141	"RTN","RCD PESP1",60, 0)
	13142	. Q:(RCFL D=7.06)&(R CTYPE="M") ; Dont d isplay if only showi ng medical parameter s
	13143	"RTN","RCD PESP1",61, 0)
	13144	. S Y=$$G ET1^DID(34 2,RCFLD,,R CITEM)_": "_@RCGLB(3 42)@(342," 1,",RCFLD, "E")
	13145	"RTN","RCD PESP1",62, 0)
	13146	. I RCFLD =7.05 D AD 2RPT(" ")
	13147	"RTN","RCD PESP1",63, 0)
	13148	. I (RCFL D=7.06)&(R CTYPE="P") D AD2RPT( " ")
	13149	"RTN","RCD PESP1",64, 0)
	13150	. D AD2RP T(Y)
	13151	"RTN","RCD PESP1",65, 0)
	13152	;
	13153	"RTN","RCD PESP1",66, 0)
	13154	D AD2RPT( " ")
	13155	"RTN","RCD PESP1",67, 0)
	13156	;
	13157	"RTN","RCD PESP1",68, 0)
	13158	; Display Medical P arameters
	13159	"RTN","RCD PESP1",69, 0)
	13160	; RCDPE P ARAMETER f ile (#344. 61)
	13161	"RTN","RCD PESP1",70, 0)
	13162	D GETS^DI Q(344.61," 1,",".02;. 03;.04;.05 ;.06;.07;1 .01;1.02", "E",RCGLB( 344.61))
	13163	"RTN","RCD PESP1",71, 0)
	13164	; get aut o-post and auto-decr ease setti ngs, save zero node
	13165	"RTN","RCD PESP1",72, 0)
	13166	S X=$G(^R CY(344.61, 1,0)),RCPA RM("AUTO-P OST")=$P(X ,U,2),RCPA RM("AUTO-D ECREASE")= $P(X,U,3), RCPARM(344 .61,0)=X
	13167	"RTN","RCD PESP1",73, 0)
	13168	S RCPARM( "RX AUTO-P OST")=$P($ G(^RCY(344 .61,1,1)), U)
	13169	"RTN","RCD PESP1",74, 0)
	13170	;
	13171	"RTN","RCD PESP1",75, 0)
	13172	; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 )
	13173	"RTN","RCD PESP1",76, 0)
	13174	; scree ning logic : ^DD(344. 6,.06,0)=" EXCLUDE ME D CLAIMS P OSTING^S^0 :No;1:Yes; ^0;6^Q"
	13175	"RTN","RCD PESP1",77, 0)
	13176	D LIST^DI C(344.6,," @;.01;.02; .06;1","P" ,,,,,"I $P (^(0),U,6) =1",,RCGLB (344.6))
	13177	"RTN","RCD PESP1",78, 0)
	13178	;
	13179	"RTN","RCD PESP1",79, 0)
	13180	; PRCA4. 5304 - Pr int Medica l Claim Pa rameters
	13181	"RTN","RCD PESP1",80, 0)
	13182	I RCTYPE' ="P" D
	13183	"RTN","RCD PESP1",81, 0)
	13184	.; RCDPE PARAMETER file (#344 .61), auto -posting o f medical claims
	13185	"RTN","RCD PESP1",82, 0)
	13186	.S X=$$GE T1^DID(344 .61,.02,," TITLE"),V= " (Y/N)" S :X[V X=$P( X,V)_$P(X, V,2) ; re move yes/n o prompt
	13187	"RTN","RCD PESP1",83, 0)
	13188	.S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", .02,"E")
	13189	"RTN","RCD PESP1",84, 0)
	13190	.D AD2RPT (Y)
	13191	"RTN","RCD PESP1",85, 0)
	13192	.;
	13193	"RTN","RCD PESP1",86, 0)
	13194	.I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list auto-post excluded p ayers
	13195	"RTN","RCD PESP1",87, 0)
	13196	..I '$D(@ RCGLB(344. 6)@("DILIS T",1,0)) D Q
	13197	"RTN","RCD PESP1",88, 0)
	13198	...S X=" No pay ers exclud ed from me dical auto -posting." D AD2RPT( $J(" ",80- $L(X)\2)_X )
	13199	"RTN","RCD PESP1",89, 0)
	13200	..;
	13201	"RTN","RCD PESP1",90, 0)
	13202	..D AD2RP T(" Excl uded Payer Comment" )
	13203	"RTN","RCD PESP1",91, 0)
	13204	..S RCNTR =0
	13205	"RTN","RCD PESP1",92, 0)
	13206	..F S RC NTR=$O(@RC GLB(344.6) @("DILIST" ,RCNTR)) Q :'RCNTR D
	13207	"RTN","RCD PESP1",93, 0)
	13208	...S V=@R CGLB(344.6 )@("DILIST ",RCNTR,0) ,X=$E($P(V ,U,2),1,35 )
	13209	"RTN","RCD PESP1",94, 0)
	13210	...S Y=" "_X_$J(" ",36-$L(X ))_$P(V,U, 5)
	13211	"RTN","RCD PESP1",95, 0)
	13212	...D AD2R PT($E(Y,1, IOM))
	13213	"RTN","RCD PESP1",96, 0)
	13214	.;
	13215	"RTN","RCD PESP1",97, 0)
	13216	.I RCPARM ("AUTO-POS T") D AD2R PT(" ") ; blank lin e
	13217	"RTN","RCD PESP1",98, 0)
	13218	.;
	13219	"RTN","RCD PESP1",99, 0)
	13220	.K @RCGLB (344.6) ; delete ol d data
	13221	"RTN","RCD PESP1",100 ,0)
	13222	.; RCDPE AUTO-PAY E XCLUSION f ile (#344. 6)
	13223	"RTN","RCD PESP1",101 ,0)
	13224	.; scre ening logi c: ^DD(344 .6,.07,0)= "EXCLUDE M ED CLAIMS DECREASE^S ^0:No;1:Ye s;^0;7^Q"
	13225	"RTN","RCD PESP1",102 ,0)
	13226	.D LIST^D IC(344.6,, "@;.01;.02 ;.07;2","P ",,,,,"I $ P(^(0),U,7 )=1",,RCGL B(344.6))
	13227	"RTN","RCD PESP1",103 ,0)
	13228	.;
	13229	"RTN","RCD PESP1",104 ,0)
	13230	.; RCDPE PARAMETER file (#344 .61), auto -decrease of medical claims
	13231	"RTN","RCD PESP1",105 ,0)
	13232	.S X=$$GE T1^DID(344 .61,.03,," TITLE"),V= " (Y/N): " ,V=" (Y/N) " S:X[V X= $P(X,V)_$P (X,V,2) ; remove ye s/no promp t
	13233	"RTN","RCD PESP1",106 ,0)
	13234	.S Y=$J(X ,45)_@RCGL B(344.61)@ (344.61,"1 ,",.03,"E" )
	13235	"RTN","RCD PESP1",107 ,0)
	13236	.D AD2RPT (Y) ; ,AD2 RPT(" ")
	13237	"RTN","RCD PESP1",108 ,0)
	13238	.; PRCA4 .5304 - R emoved bec ause auto- decrease a mounts are based on CARCs
	13239	"RTN","RCD PESP1",109 ,0)
	13240	.;I RCPAR M("AUTO-DE CREASE") D ; list t hese 2 fie lds only i f auto-dec rease enab led
	13241	"RTN","RCD PESP1",110 ,0)
	13242	.;.D AD2R PT("NUMBER OF DAYS T O WAIT BEF ORE AUTO-D ECREASE: " _(+$P(RCPA RM(344.61, 0),U,4)))
	13243	"RTN","RCD PESP1",111 ,0)
	13244	.;.D AD2R PT(" M AXIMUM DOL LAR AMOUNT TO AUTO-D ECREASE: " _"$"_(+$P( RCPARM(344 .61,0),U,5 )))
	13245	"RTN","RCD PESP1",112 ,0)
	13246	.;
	13247	"RTN","RCD PESP1",113 ,0)
	13248	.; PRCA4 .5304 - P rint the C ARC Auto-d ecrease pa rameters
	13249	"RTN","RCD PESP1",114 ,0)
	13250	. I $$CAR CCHK(RCTYP E,"M") D
	13251	"RTN","RCD PESP1",115 ,0)
	13252	.. D AD2R PT(" "),AD 2RPT(" AUTO-DECR EASE MEDIC AL CLAIMS FOR THE FO LLOWING CA RC/AMOUNTS ONLY:"),A D2RPT(" ")
	13253	"RTN","RCD PESP1",116 ,0)
	13254	.. S RCST RING=$TR($ J("",70)," ","-"),RC I=0
	13255	"RTN","RCD PESP1",117 ,0)
	13256	.. D AD2R PT(" C ARC Descr iption Max. Amt" )
	13257	"RTN","RCD PESP1",118 ,0)
	13258	.. D AD2R PT(" " _RCSTRING)
	13259	"RTN","RCD PESP1",119 ,0)
	13260	.. ;
	13261	"RTN","RCD PESP1",120 ,0)
	13262	.. ; Loop and print entries
	13263	"RTN","RCD PESP1",121 ,0)
	13264	.. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D
	13265	"RTN","RCD PESP1",122 ,0)
	13266	.. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= ""
	13267	"RTN","RCD PESP1",123 ,0)
	13268	.. . Q:RC DATA=""
	13269	"RTN","RCD PESP1",124 ,0)
	13270	.. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") )
	13271	"RTN","RCD PESP1",125 ,0)
	13272	.. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0))
	13273	"RTN","RCD PESP1",126 ,0)
	13274	.. . S RC STAT=$P(RC DATA,U,2)
	13275	"RTN","RCD PESP1",127 ,0)
	13276	.. . Q:RC STAT'=1
	13277	"RTN","RCD PESP1",128 ,0)
	13278	.. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .."
	13279	"RTN","RCD PESP1",129 ,0)
	13280	.. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70")
	13281	"RTN","RCD PESP1",130 ,0)
	13282	.. . S Y= " "_$J (RCCODE,4) _" "
	13283	"RTN","RCD PESP1",131 ,0)
	13284	.. . S Y= Y_$E(RCDES C,1,53) S: $L(RCDESC) <53 Y=Y_$J ("",(53-$L (RCDESC))) S Y=Y_$J( $P(RCDATA, U,6),10,0)
	13285	"RTN","RCD PESP1",132 ,0)
	13286	.. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i)
	13287	"RTN","RCD PESP1",133 ,0)
	13288	.. . D AD 2RPT(Y)
	13289	"RTN","RCD PESP1",134 ,0)
	13290	.. ;
	13291	"RTN","RCD PESP1",135 ,0)
	13292	..D AD2RP T(" ") ; blank line
	13293	"RTN","RCD PESP1",136 ,0)
	13294	.I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE")) D ; list excluded a uto-decrea se payers
	13295	"RTN","RCD PESP1",137 ,0)
	13296	.. S X=$P ($$GET1^DI D(344.61,. 04,,"TITLE ")," (",1) _": "
	13297	"RTN","RCD PESP1",138 ,0)
	13298	.. S Y=$J (X,50)_@RC GLB(344.61 )@(344.61, "1,",.04," E")
	13299	"RTN","RCD PESP1",139 ,0)
	13300	.. D AD2R PT(Y),AD2R PT(" ")
	13301	"RTN","RCD PESP1",140 ,0)
	13302	.. D AD2R PT(" A ll payers excluded f rom Auto-P osting are excluded from Auto- Decrease." )
	13303	"RTN","RCD PESP1",141 ,0)
	13304	.. Q:'RCP ARM("AUTO- DECREASE")
	13305	"RTN","RCD PESP1",142 ,0)
	13306	.. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q
	13307	"RTN","RCD PESP1",143 ,0)
	13308	... S X=" No additional payers ex cluded fro m Medical Auto-Decre ase." D AD 2RPT($J(" ",80-$L(X) \2)_X)
	13309	"RTN","RCD PESP1",144 ,0)
	13310	..;
	13311	"RTN","RCD PESP1",145 ,0)
	13312	.. D AD2R PT(" A dditional Excluded P ayer Comme nt")
	13313	"RTN","RCD PESP1",146 ,0)
	13314	.. S RCNT R=0
	13315	"RTN","RCD PESP1",147 ,0)
	13316	.. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D
	13317	"RTN","RCD PESP1",148 ,0)
	13318	... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5)
	13319	"RTN","RCD PESP1",149 ,0)
	13320	... S Y=" "_X_$ J(" ",36-$ L(X))_$P(V ,U,5)
	13321	"RTN","RCD PESP1",150 ,0)
	13322	... D AD2 RPT($E(Y,1 ,IOM))
	13323	"RTN","RCD PESP1",151 ,0)
	13324	.;
	13325	"RTN","RCD PESP1",152 ,0)
	13326	.D AD2RPT (" ") ; b lank line
	13327	"RTN","RCD PESP1",153 ,0)
	13328	;
	13329	"RTN","RCD PESP1",154 ,0)
	13330	K @RCGLB( 344.6) ; delete old data
	13331	"RTN","RCD PESP1",155 ,0)
	13332	; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 )
	13333	"RTN","RCD PESP1",156 ,0)
	13334	; scree ning logic : ^DD(344. 6,.06,0)=" EXCLUDE ME D CLAIMS P OSTING^S^0 :No;1:Yes; ^0;6^Q"
	13335	"RTN","RCD PESP1",157 ,0)
	13336	D LIST^DI C(344.6,," @;.01;.02; .08;3","P" ,,,,,"I $P (^(0),U,8) =1",,RCGLB (344.6))
	13337	"RTN","RCD PESP1",158 ,0)
	13338	;
	13339	"RTN","RCD PESP1",159 ,0)
	13340	; PRCA4. 5304 - Pr int Pharma cy Claim P arameters
	13341	"RTN","RCD PESP1",160 ,0)
	13342	I RCTYPE' ="M" D
	13343	"RTN","RCD PESP1",161 ,0)
	13344	.; RCDPE PARAMETER file (#344 .61), auto -posting o f pharmacy claims
	13345	"RTN","RCD PESP1",162 ,0)
	13346	.S X=$$GE T1^DID(344 .61,1.01,, "TITLE"),V =" (Y/N)" S:X[V X=$P (X,V)_$P(X ,V,2) ; r emove yes/ no prompt
	13347	"RTN","RCD PESP1",163 ,0)
	13348	.S Y=X_" "_@RCGLB(3 44.61)@(34 4.61,"1,", 1.01,"E")
	13349	"RTN","RCD PESP1",164 ,0)
	13350	.D AD2RPT (Y)
	13351	"RTN","RCD PESP1",165 ,0)
	13352	.;
	13353	"RTN","RCD PESP1",166 ,0)
	13354	. I RCPAR M("RX AUTO -POST") D ; list au to-post ex cluded pay ers
	13355	"RTN","RCD PESP1",167 ,0)
	13356	.. I '$D( @RCGLB(344 .6)@("DILI ST",1,0)) D Q
	13357	"RTN","RCD PESP1",168 ,0)
	13358	... S X=" No pa yers exclu ded from p harmacy au to-posting ." D AD2RP T($J(" ",8 0-$L(X)\2) _X)
	13359	"RTN","RCD PESP1",169 ,0)
	13360	..;
	13361	"RTN","RCD PESP1",170 ,0)
	13362	.. D AD2R PT(" Exc luded Paye r Comment ")
	13363	"RTN","RCD PESP1",171 ,0)
	13364	.. S RCNT R=0
	13365	"RTN","RCD PESP1",172 ,0)
	13366	.. F S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR)) Q:'RCNTR D
	13367	"RTN","RCD PESP1",173 ,0)
	13368	... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5)
	13369	"RTN","RCD PESP1",174 ,0)
	13370	... S Y=" "_X_$J( " ",36-$L( X))_$P(V,U ,5)
	13371	"RTN","RCD PESP1",175 ,0)
	13372	... D AD2 RPT($E(Y,1 ,IOM))
	13373	"RTN","RCD PESP1",176 ,0)
	13374	.. S X=$P ($$GET1^DI D(344.61,1 .02,,"TITL E")," (",1 )_": " ; remove yes /no prompt
	13375	"RTN","RCD PESP1",177 ,0)
	13376	.. S Y=" "_X_" "_$S(@RCGL B(344.61)@ (344.61,"1 ,",1.02,"E ")="":"No" ,1:@RCGLB( 344.61)@(3 44.61,"1," ,1.02,"E") )
	13377	"RTN","RCD PESP1",178 ,0)
	13378	.. D AD2R PT(" "),AD 2RPT(Y)
	13379	"RTN","RCD PESP1",179 ,0)
	13380	.;
	13381	"RTN","RCD PESP1",180 ,0)
	13382	.I RCPARM ("RX AUTO- POST") D A D2RPT(" ") ; blank line
	13383	"RTN","RCD PESP1",181 ,0)
	13384	.;
	13385	"RTN","RCD PESP1",182 ,0)
	13386	.K @RCGLB (344.6) ; delete ol d data
	13387	"RTN","RCD PESP1",183 ,0)
	13388	.;
	13389	"RTN","RCD PESP1",184 ,0)
	13390	.; PRCA4 .5304 - P rint the C ARC Auto-d ecrease pa rameters
	13391	"RTN","RCD PESP1",185 ,0)
	13392	. I $$CAR CCHK(RCTYP E,"P") D
	13393	"RTN","RCD PESP1",186 ,0)
	13394	.. S RCST RING=$TR($ J("",73)," ","-"),RC I=0
	13395	"RTN","RCD PESP1",187 ,0)
	13396	.. D AD2R PT(" CARC Descript ion Ma x. Amt")
	13397	"RTN","RCD PESP1",188 ,0)
	13398	.. D AD2R PT(RCSTRIN G)
	13399	"RTN","RCD PESP1",189 ,0)
	13400	.. ;
	13401	"RTN","RCD PESP1",190 ,0)
	13402	.. ; Loop and print entries
	13403	"RTN","RCD PESP1",191 ,0)
	13404	.. F S R CI=$O(^RCY (344.62,RC I)) Q:'RCI D
	13405	"RTN","RCD PESP1",192 ,0)
	13406	.. . S RC DATA=$G(^R CY(344.62, RCI,0)),Y= ""
	13407	"RTN","RCD PESP1",193 ,0)
	13408	.. . Q:RC DATA=""
	13409	"RTN","RCD PESP1",194 ,0)
	13410	.. . S RC CODE=$P(RC DATA,U),RC CIEN=$O(^R C(345,"B", RCCODE,"") )
	13411	"RTN","RCD PESP1",195 ,0)
	13412	.. . S RC DESC=$G(^R C(345,RCCI EN,1,1,0))
	13413	"RTN","RCD PESP1",196 ,0)
	13414	.. . S RC STAT=$P(RC DATA,U,2)
	13415	"RTN","RCD PESP1",197 ,0)
	13416	.. . Q:RC STAT'=1
	13417	"RTN","RCD PESP1",198 ,0)
	13418	.. . I $L (RCDESC)>5 0 S RCDESC =$E(RCDESC ,1,50)_" . .."
	13419	"RTN","RCD PESP1",199 ,0)
	13420	.. . D GE TCODES^RCD PCRR(RCCOD E,"","A",$ $DT^XLFDT, "RCCARCD", "1^70")
	13421	"RTN","RCD PESP1",200 ,0)
	13422	.. . S Y= " "_$E(RC CODE,1,4)_ " "
	13423	"RTN","RCD PESP1",201 ,0)
	13424	.. . S Y= Y_$E(RCDES C,1,55)_$J ($P(RCDATA ,U,6),10,0 )
	13425	"RTN","RCD PESP1",202 ,0)
	13426	.. . I '$ $ACT^RCDPR U(345,RCCO DE,) S Y=Y _" (I)" ; if inacti ve, displa y (i)
	13427	"RTN","RCD PESP1",203 ,0)
	13428	.. . D AD 2RPT(Y)
	13429	"RTN","RCD PESP1",204 ,0)
	13430	;
	13431	"RTN","RCD PESP1",205 ,0)
	13432	; RCDPE P ARAMETER f ile (#344. 61)
	13433	"RTN","RCD PESP1",206 ,0)
	13434	F RCFLD=. 06,.07 D
	13435	"RTN","RCD PESP1",207 ,0)
	13436	. Q:(RCFL D=.06)&(RC TYPE="P") ; Dont di splay if o nly showin g Pharmacy parameter s
	13437	"RTN","RCD PESP1",208 ,0)
	13438	. Q:(RCFL D=.07)&(RC TYPE="M") ; Dont di splay if o nly showin g medical parameters
	13439	"RTN","RCD PESP1",209 ,0)
	13440	. S Y=$$G ET1^DID(34 4.61,RCFLD ,,"TITLE") _" "_@RCGL B(344.61)@ (344.61,"1 ,",RCFLD," E")
	13441	"RTN","RCD PESP1",210 ,0)
	13442	. D AD2RP T(Y)
	13443	"RTN","RCD PESP1",211 ,0)
	13444	;
	13445	"RTN","RCD PESP1",212 ,0)
	13446	D AD2RPT( " "),AD2RP T($$ENDORP RT^RCDPEAR L)
	13447	"RTN","RCD PESP1",213 ,0)
	13448	;
	13449	"RTN","RCD PESP1",214 ,0)
	13450	S RCSTOP= 0 U IO D S PHDR(.RCHD R)
	13451	"RTN","RCD PESP1",215 ,0)
	13452	S J=0 F S J=$O(^TM P($J,"RC S P REPORT", J)) Q:'J!R CSTOP S Y =^TMP($J," RC SP REPO RT",J,0) D
	13453	"RTN","RCD PESP1",216 ,0)
	13454	.W !,Y Q: '$O(^TMP($ J,"RC SP R EPORT",J)) ; quit i f last lin e
	13455	"RTN","RCD PESP1",217 ,0)
	13456	.I '$G(ZT SK),$E(IOS T,1,2)="C- ",$Y+3>IOS L D ASK^RC DPEARL(.RC STOP) I 'R CSTOP D SP HDR(.RCHDR ) Q
	13457	"RTN","RCD PESP1",218 ,0)
	13458	.Q:RCSTOP Q:$Y+2<I OSL
	13459	"RTN","RCD PESP1",219 ,0)
	13460	.D SPHDR( .RCHDR)
	13461	"RTN","RCD PESP1",220 ,0)
	13462	;
	13463	"RTN","RCD PESP1",221 ,0)
	13464	I '$G(ZTS K),$E(IOST ,1,2)="C-" ,'RCSTOP D ASK^RCDPE ARL(.RCSTO P)
	13465	"RTN","RCD PESP1",222 ,0)
	13466	;
	13467	"RTN","RCD PESP1",223 ,0)
	13468	; close d evice
	13469	"RTN","RCD PESP1",224 ,0)
	13470	U IO(0) D ^%ZISC
	13471	"RTN","RCD PESP1",225 ,0)
	13472	;
	13473	"RTN","RCD PESP1",226 ,0)
	13474	S X="RC" F S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" ) K ^TMP( $J,X) ; cl ean up
	13475	"RTN","RCD PESP1",227 ,0)
	13476	;
	13477	"RTN","RCD PESP1",228 ,0)
	13478	Q
	13479	"RTN","RCD PESP1",229 ,0)
	13480	;
	13481	"RTN","RCD PESP1",230 ,0)
	13482	SPHDR(HDR) ; HDR pas sed by ref .
	13483	"RTN","RCD PESP1",231 ,0)
	13484	; HDR("RU NDATE") - run date, external f ormat
	13485	"RTN","RCD PESP1",232 ,0)
	13486	; HDR("P GNMBR") - page numbe r
	13487	"RTN","RCD PESP1",233 ,0)
	13488	; HDR( "SITE") - site name
	13489	"RTN","RCD PESP1",234 ,0)
	13490	N P,X,Y
	13491	"RTN","RCD PESP1",235 ,0)
	13492	S P=$G(HD R("PGNMBR" ))+1,HDR(" PGNMBR")=P ; increm ent page c ount
	13493	"RTN","RCD PESP1",236 ,0)
	13494	;
	13495	"RTN","RCD PESP1",237 ,0)
	13496	S X=$$HDR LN
	13497	"RTN","RCD PESP1",238 ,0)
	13498	S P=IOM-( $L(X)+10)\ 2,Y=$J(" " ,P)_X_$J(" ",P)_" Pa ge: "_HDR( "PGNMBR")
	13499	"RTN","RCD PESP1",239 ,0)
	13500	W @IOF,Y
	13501	"RTN","RCD PESP1",240 ,0)
	13502	S X=" R un Date: " _HDR("RUND ATE"),Y=X_ $J(HDR("SI TE"),IOM-( $L(X)+1))
	13503	"RTN","RCD PESP1",241 ,0)
	13504	W !,Y
	13505	"RTN","RCD PESP1",242 ,0)
	13506	S Y=" "_$ TR($J("",I OM-2)," ", "-") ; sp ace_row of hyphens
	13507	"RTN","RCD PESP1",243 ,0)
	13508	W !,Y
	13509	"RTN","RCD PESP1",244 ,0)
	13510	Q
	13511	"RTN","RCD PESP1",245 ,0)
	13512	;
	13513	"RTN","RCD PESP1",246 ,0)
	13514	AD2RPT(A) ; add line to report
	13515	"RTN","RCD PESP1",247 ,0)
	13516	Q:$G(A)=" "
	13517	"RTN","RCD PESP1",248 ,0)
	13518	N C S C=$ G(^TMP($J, "RC SP REP ORT",0))+1 ,^TMP($J," RC SP REPO RT",0)=C
	13519	"RTN","RCD PESP1",249 ,0)
	13520	S ^TMP($J ,"RC SP RE PORT",C,0) =A Q
	13521	"RTN","RCD PESP1",250 ,0)
	13522	;
	13523	"RTN","RCD PESP1",251 ,0)
	13524	HDRLN() Q "EDI Lockb ox Paramet ers Report "_$S($G(RC TYPE)="B": " - ALL",$ G(RCTYPE)= "M":" - ME DICAL",$G( RCTYPE)="P ":" - PHAR MACY",1:"" ) ; extri nsic varia ble
	13525	"RTN","RCD PESP1",252 ,0)
	13526	;
	13527	"RTN","RCD PESP1",253 ,0)
	13528	;Function to check to see if the CARC p arameters are to app ear on the report
	13529	"RTN","RCD PESP1",254 ,0)
	13530	CARCCHK(RC TYPE,TYPE) ;
	13531	"RTN","RCD PESP1",255 ,0)
	13532	;
	13533	"RTN","RCD PESP1",256 ,0)
	13534	N RCMEN,R CREN
	13535	"RTN","RCD PESP1",257 ,0)
	13536	;
	13537	"RTN","RCD PESP1",258 ,0)
	13538	; Return 1 if valid to print, 0 otherwi se
	13539	"RTN","RCD PESP1",259 ,0)
	13540	;
	13541	"RTN","RCD PESP1",260 ,0)
	13542	Q:RCTYPE= "B"&($G(TY PE)="M") + $P($G(^RCY (344.61,1, 0)),U,3) ;User want s all para meters and we are ch ecking for medical a uto decrea se
	13543	"RTN","RCD PESP1",261 ,0)
	13544	;
	13545	"RTN","RCD PESP1",262 ,0)
	13546	Q:RCTYPE= "B"&($G(TY PE)="P") + $P($G(^RCY (344.61,1, 1)),U,2) ;User want s all para meters and we are ch ecking for Pharmacy auto decre ase
	13547	"RTN","RCD PESP1",263 ,0)
	13548	;
	13549	"RTN","RCD PESP1",264 ,0)
	13550	S (RCMEN, RCREN)=""
	13551	"RTN","RCD PESP1",265 ,0)
	13552	;
	13553	"RTN","RCD PESP1",266 ,0)
	13554	;Print if Report ty pe is medi cal and au to-decreas e for medi cal is on
	13555	"RTN","RCD PESP1",267 ,0)
	13556	I RCTYPE= "M" S RCME N=+$P($G(^ RCY(344.61 ,1,0)),U,3 ) Q RCMEN
	13557	"RTN","RCD PESP1",268 ,0)
	13558	;
	13559	"RTN","RCD PESP1",269 ,0)
	13560	;Print if Report ty pe is phar macy and a uto-decrea se for pha rmacy is o n
	13561	"RTN","RCD PESP1",270 ,0)
	13562	I RCTYPE= "P" S RCRE N=+$P($G(^ RCY(344.61 ,1,1)),U,2 ) Q RCREN
	13563	"RTN","RCD PESP1",271 ,0)
	13564	;
	13565	"RTN","RCD PESP1",272 ,0)
	13566	Q 0 ;Don 't print t he CARCs
	13567	"RTN","RCD PESP1",273 ,0)
	13568	;
	13569	"RTN","RCD PEWL")
	13570	0^14^B7562 8654^B7541 1625
	13571	"RTN","RCD PEWL",1,0)
	13572	RCDPEWL ;A LB/TMK/KML - ELECTRO NIC EOB ME SSAGE WORK LIST ;Jun 06, 2014@1 9:11:19
	13573	"RTN","RCD PEWL",2,0)
	13574	;;4.5;Acc ounts Rece ivable;1 73,208,269 ,298,317,3 18;Mar 2 0, 1995;Bu ild 25
	13575	"RTN","RCD PEWL",3,0)
	13576	;Per VA D irective 6 402, this routine sh ould not b e modified .
	13577	"RTN","RCD PEWL",4,0)
	13578	; IA for read acces s to ^IBM( 361.1 = 40 51
	13579	"RTN","RCD PEWL",5,0)
	13580	;
	13581	"RTN","RCD PEWL",6,0)
	13582	EN ; Main entry poin t
	13583	"RTN","RCD PEWL",7,0)
	13584	N RCFASTX T,DA,DIC,X ,Y,RCERA,R CNOED,RCQU IT ;PRCA* 4.5*317 Ad ded RCQUIT
	13585	"RTN","RCD PEWL",8,0)
	13586	D FULL^VA LM1
	13587	"RTN","RCD PEWL",9,0)
	13588	;
	13589	"RTN","RCD PEWL",10,0 )
	13590	S DIR(0)= "SA^L:LIST ;S:SPECIFI C"
	13591	"RTN","RCD PEWL",11,0 )
	13592	S DIR("A" )="Do you want a (L) IST of ERA s or a (S) PECIFIC on e?: "
	13593	"RTN","RCD PEWL",12,0 )
	13594	S DIR("?" ,1)="Enter LIST to s ee a list of ERAs."
	13595	"RTN","RCD PEWL",13,0 )
	13596	S DIR("?" )="Enter S PECIFIC to see a sel ected ERA. "
	13597	"RTN","RCD PEWL",14,0 )
	13598	S DIR("B" )="LIST"
	13599	"RTN","RCD PEWL",15,0 )
	13600	W !
	13601	"RTN","RCD PEWL",16,0 )
	13602	D ^DIR
	13603	"RTN","RCD PEWL",17,0 )
	13604	K DIR
	13605	"RTN","RCD PEWL",18,0 )
	13606	Q:$D(DTOU T)!$D(DUOU T)
	13607	"RTN","RCD PEWL",19,0 )
	13608	I Y="S" D Q
	13609	"RTN","RCD PEWL",20,0 )
	13610	. S DIC=" ^RCY(344.4 ,",DIC(0)= "AEMQ"
	13611	"RTN","RCD PEWL",21,0 )
	13612	. D ^DIC
	13613	"RTN","RCD PEWL",22,0 )
	13614	. I Y>0 D WL^RCDPEW L7(+Y)
	13615	"RTN","RCD PEWL",23,0 )
	13616	;
	13617	"RTN","RCD PEWL",24,0 )
	13618	; Calling Preferred View API in Menu Op tion Mode
	13619	"RTN","RCD PEWL",25,0 )
	13620	D PARAMS^ RCDPEWL0(" MO")
	13621	"RTN","RCD PEWL",26,0 )
	13622	Q:$G(RCQU IT)
	13623	"RTN","RCD PEWL",27,0 )
	13624	D EN^VALM ("RCDPE WO RKLIST ERA LIST")
	13625	"RTN","RCD PEWL",28,0 )
	13626	Q
	13627	"RTN","RCD PEWL",29,0 )
	13628	;
	13629	"RTN","RCD PEWL",30,0 )
	13630	DISP(RCERA ,RCNOED) ; Entry to worklist f rom receip t processi ng
	13631	"RTN","RCD PEWL",31,0 )
	13632	; RCERA = ien of e ntry in fi le 344.49
	13633	"RTN","RCD PEWL",32,0 )
	13634	; RCNOED = 1 if rec eipt exist s/no editi ng allowed
	13635	"RTN","RCD PEWL",33,0 )
	13636	; = 2 if no edit and c alled from receipt p rocessing
	13637	"RTN","RCD PEWL",34,0 )
	13638	; ; prca 4.5298 - added AUT OPOST inpu t argument
	13639	"RTN","RCD PEWL",35,0 )
	13640	; AUTOPOS T = "" if ERA is non -autopost
	13641	"RTN","RCD PEWL",36,0 )
	13642	; = 0 if auto-poste d ERA is i n UNPOSTED status
	13643	"RTN","RCD PEWL",37,0 )
	13644	; = 1 if a uto-posted ERA is in PARTIAL p osted stat us
	13645	"RTN","RCD PEWL",38,0 )
	13646	; = 2 if a uto-posted ERA is in COMPLETE status
	13647	"RTN","RCD PEWL",39,0 )
	13648	;
	13649	"RTN","RCD PEWL",40,0 )
	13650	N DUOUT,D TOUT,DIC,D IK,X,Y,DIR ,RCQUIT,DA ,DIE,DR,RC SCR,RC0,RC 5,RCDAT,RC UNM
	13651	"RTN","RCD PEWL",41,0 )
	13652	;
	13653	"RTN","RCD PEWL",42,0 )
	13654	S RCSCR(" NOEDIT")=+ $G(RCNOED)
	13655	"RTN","RCD PEWL",43,0 )
	13656	S RCQUIT= 0,RC0=$G(^ RCY(344.4, RCERA,0)), RC5=$G(^RC Y(344.4,RC ERA,5))
	13657	"RTN","RCD PEWL",44,0 )
	13658	I 'RCSCR( "NOEDIT"), '$O(^RCY(3 44.49,"B", RCERA,0)) D G:RCQUI T DISPQ
	13659	"RTN","RCD PEWL",45,0 )
	13660	. ;allow additional selection s
	13661	"RTN","RCD PEWL",46,0 )
	13662	. S DIR(" A",1)="No worklist s cratchpad entry exis ts for thi s ERA."
	13663	"RTN","RCD PEWL",47,0 )
	13664	. S DIR(" A")="(C)re ate scratc hpad, (V)i ew ERA det ails or (E )xit:"
	13665	"RTN","RCD PEWL",48,0 )
	13666	. S DIR(0 )="SAO^C:C REATE SCRA TCHPAD;V:V IEW ERA DE TAILS;E:EX IT"
	13667	"RTN","RCD PEWL",49,0 )
	13668	. W ! D ^ DIR K DIR
	13669	"RTN","RCD PEWL",50,0 )
	13670	. I (Y'=" V")&(Y'="C ")&(Y'="E" ) S RCERA= -1,RCQUIT= 1 Q
	13671	"RTN","RCD PEWL",51,0 )
	13672	. I Y="V" S RCSCR=R CERA D PRE RA1^RCDPEW L0 S RCERA =-1,RCQUIT =1 Q
	13673	"RTN","RCD PEWL",52,0 )
	13674	. I Y="E" S RCERA=- 1,RCQUIT=1 Q
	13675	"RTN","RCD PEWL",53,0 )
	13676	. ; prca* 4.5*298 Y is = "C" therefore perform th e pre-exis ting scrat chpad crea tion/editi ng algorit hm
	13677	"RTN","RCD PEWL",54,0 )
	13678	. I $P(RC 0,U,15)'=" " W !!,"PA YMENT METH OD CODE RE PORTED: "_ $P(RC0,U,1 5),!
	13679	"RTN","RCD PEWL",55,0 )
	13680	. I $P(RC 0,U,15)="" W !!,"NO PAYMENT ME THOD CODE REPORTED", !
	13681	"RTN","RCD PEWL",56,0 )
	13682	. I $P(RC 0,U,9)=0,$ P(RC5,U,2) ="" D Q:R CQUIT
	13683	"RTN","RCD PEWL",57,0 )
	13684	.. S RCQU IT=0,RCUNM =0
	13685	"RTN","RCD PEWL",58,0 )
	13686	.. I +$P( RC0,U,5)=0 ,"ACH"'[(U _$P(RC0,U, 15)_U) D Q:RCQUIT!R CUNM
	13687	"RTN","RCD PEWL",59,0 )
	13688	... S DIR ("A",1)="T his ERA ha s no payme nt associa ted with i t and can be marked as",DIR("A ",2)="'MAT CH-0 PAYME NT' to rem ove it fro m the ERA AGING REPO RT if no p aper check or",DIR(" A",3)="EFT is expect ed to be r eceived fo r this ERA "
	13689	"RTN","RCD PEWL",60,0 )
	13690	... S DIR ("?")="Do NOT respon d YES here unless yo u are sure there wil l be no EF T or paper ",DIR("?", 1)=" check to be rec eived for this 0-PAY MENT ERA"
	13691	"RTN","RCD PEWL",61,0 )
	13692	... S DIR ("A")="Do you want t o do this? : "
	13693	"RTN","RCD PEWL",62,0 )
	13694	... S DIR (0)="YA"
	13695	"RTN","RCD PEWL",63,0 )
	13696	... D ^DI R K DIR
	13697	"RTN","RCD PEWL",64,0 )
	13698	... I $D( DTOUT)!$D( DUOUT) S R CQUIT=1 Q
	13699	"RTN","RCD PEWL",65,0 )
	13700	... I Y'= 1 Q
	13701	"RTN","RCD PEWL",66,0 )
	13702	... S DIE ="^RCY(344 .4,",DR=". 09////3;.1 4////3",DA =RCERA D ^ DIE S RCUN M=1
	13703	"RTN","RCD PEWL",67,0 )
	13704	.. I 'RCU NM D
	13705	"RTN","RCD PEWL",68,0 )
	13706	... S DIR ("A",1)="T his ERA do es NOT hav e a matchi ng EFT",DI R("A")="En ter the nu mber of th e paper ch eck you re ceived for this ERA: ",DIR(0)= "344.01,.0 7A"
	13707	"RTN","RCD PEWL",69,0 )
	13708	... I $P( RC5,U,2)'= "" S DIR(" B")=$P(RC5 ,U,2)
	13709	"RTN","RCD PEWL",70,0 )
	13710	... I $G( DIR("B"))= "",$P(RC0, U,2)'="" S DIR("B")= $P(RC0,U,2 )
	13711	"RTN","RCD PEWL",71,0 )
	13712	... W ! D ^DIR K DI R
	13713	"RTN","RCD PEWL",72,0 )
	13714	... I $D( DTOUT)!$D( DUOUT)!(Y= "") D S R CQUIT=1 Q
	13715	"RTN","RCD PEWL",73,0 )
	13716	.... S DI R(0)="EA", DIR("A",1) ="There mu st be eith er a paper check or an EFT for this ERA" ,DIR("A")= "PRESS RET URN TO CON TINUE " W !! D ^DIR K DIR
	13717	"RTN","RCD PEWL",74,0 )
	13718	... S RCD AT("CHECK# ")=Y
	13719	"RTN","RCD PEWL",75,0 )
	13720	... S DIR (0)="344.0 1,.1O",DIR ("B")=$$FM TE^XLFDT($ P(RC0,U,4) ,2)
	13721	"RTN","RCD PEWL",76,0 )
	13722	... W ! D ^DIR K DI R
	13723	"RTN","RCD PEWL",77,0 )
	13724	... I $D( DTOUT)!$D( DUOUT) S R CQUIT=1 Q
	13725	"RTN","RCD PEWL",78,0 )
	13726	... S RCD AT("CHECKD T")=Y
	13727	"RTN","RCD PEWL",79,0 )
	13728	... S DIR (0)="344.0 1,.08O"
	13729	"RTN","RCD PEWL",80,0 )
	13730	... W ! D ^DIR K DI R
	13731	"RTN","RCD PEWL",81,0 )
	13732	... I $D( DTOUT)!$D( DUOUT) S R CQUIT=1 Q
	13733	"RTN","RCD PEWL",82,0 )
	13734	... S RCD AT("BANK") =Y
	13735	"RTN","RCD PEWL",83,0 )
	13736	... S DIR ("A",1)="E RA #"_RCER A_" (TRACE #:"_$P(RC 0,U,2)_") matched to paper che ck "_RCDAT ("CHECK#") ,DIR("A")= "Is this c orrect?: " ,DIR(0)="Y A",DIR("B" )="YES" W ! D ^DIR K DIR
	13737	"RTN","RCD PEWL",84,0 )
	13738	... I Y'= 1 S RCQUIT =1 Q
	13739	"RTN","RCD PEWL",85,0 )
	13740	... S DIE ="^RCY(344 .4,",DA=RC ERA,DR=".1 3////"_RCD AT("CHECK# ")_";.09// //2" D ^DI E
	13741	"RTN","RCD PEWL",86,0 )
	13742	;
	13743	"RTN","RCD PEWL",87,0 )
	13744	S RCSCR=+ $O(^RCY(34 4.49,"B",R CERA,0))
	13745	"RTN","RCD PEWL",88,0 )
	13746	I 'RCSCR D ; Build the entry in file 3 44.49
	13747	"RTN","RCD PEWL",89,0 )
	13748	. I RCSCR ("NOEDIT") D Q
	13749	"RTN","RCD PEWL",90,0 )
	13750	.. S DIR( "A")="NO w orklist en try exists for this ERA - PRES S RETURN T O CONTINUE ",DIR(0)= "EA" W ! D ^DIR K DI R
	13751	"RTN","RCD PEWL",91,0 )
	13752	. ;
	13753	"RTN","RCD PEWL",92,0 )
	13754	. S RCSCR =+$$ADDREC (RCERA,.RC DAT)
	13755	"RTN","RCD PEWL",93,0 )
	13756	. I RCSCR D Q:'RCS CR
	13757	"RTN","RCD PEWL",94,0 )
	13758	.. F X=1: 1:6 L +^RC Y(344.4,RC SCR):5 Q:$ T I X=6 D Q
	13759	"RTN","RCD PEWL",95,0 )
	13760	... S DA= RCSCR,DIK= "^RCY(344. 49," D ^DI K S RCSCR= 0
	13761	"RTN","RCD PEWL",96,0 )
	13762	... S DIR (0)="EA",D IR("A",1)= "Another u ser has lo cked this entry - NE W RECORD N OT CREATED ",DIR("A") ="PRESS RE TURN TO CO NTINUE " W ! D ^DIR K DIR
	13763	"RTN","RCD PEWL",97,0 )
	13764	.. Q:'RCS CR
	13765	"RTN","RCD PEWL",98,0 )
	13766	.. ; prca 4.5298 per patch requiremen ts, keep c ode relate d to
	13767	"RTN","RCD PEWL",99,0 )
	13768	.. ; crea ting/maint aining bat ches but j ust remove from exec ution.
	13769	"RTN","RCD PEWL",100, 0)
	13770	.. ;D SET BATCH^RCDP EWLB(RCSCR ) ; prca4 .5298
	13771	"RTN","RCD PEWL",101, 0)
	13772	.. D ADDL INES^RCDPE WLA(RCSCR)
	13773	"RTN","RCD PEWL",102, 0)
	13774	.. K ^TMP ($J,"BATCH ES")
	13775	"RTN","RCD PEWL",103, 0)
	13776	;
	13777	"RTN","RCD PEWL",104, 0)
	13778	I RCSCR D G:'RCSCR DISPQ
	13779	"RTN","RCD PEWL",105, 0)
	13780	. ; prca* 4.5*298 p er patch r equirement s, keep co de related to
	13781	"RTN","RCD PEWL",106, 0)
	13782	. ; creat ing/mainta ining batc hes but ju st remove from execu tion.
	13783	"RTN","RCD PEWL",107, 0)
	13784	. ;Q:'$$B AT^RCDPEWL 7(RCSCR)
	13785	"RTN","RCD PEWL",108, 0)
	13786	. ;I 'RCS CR("NOEDIT "),'$G(^TM P("RCBATCH _SELECTED" ,$J)) L +^ RCY(344.4, RCSCR):5 I '$T W !!, "Another u ser is cur rently edi ting this entry",! S DIR(0)="E " D ^DIR K DIR S RCS CR=0 Q
	13787	"RTN","RCD PEWL",109, 0)
	13788	. I 'RCSC R("NOEDIT" ) L +^RCY( 344.4,RCSC R):5 I '$T W !!,"Ano ther user is current ly editing this entr y",! S DIR (0)="E" D ^DIR K DIR S RCSCR=0 Q
	13789	"RTN","RCD PEWL",110, 0)
	13790	. D EN^VA LM("RCDPE EOB WORKLI ST")
	13791	"RTN","RCD PEWL",111, 0)
	13792	;
	13793	"RTN","RCD PEWL",112, 0)
	13794	DISPQ L -^ RCY(344.4, +$G(RCERA) )
	13795	"RTN","RCD PEWL",113, 0)
	13796	Q
	13797	"RTN","RCD PEWL",114, 0)
	13798	;
	13799	"RTN","RCD PEWL",115, 0)
	13800	INIT ; -- set up ini tial varia bles
	13801	"RTN","RCD PEWL",116, 0)
	13802	N RCQUIT, RCREV
	13803	"RTN","RCD PEWL",117, 0)
	13804	S VALMCNT =0,VALMBG= 1
	13805	"RTN","RCD PEWL",118, 0)
	13806	S RCQUIT= 0
	13807	"RTN","RCD PEWL",119, 0)
	13808	; PRCA4. 5298: Rem oved funct ionality f or retriev ing/storin g user pre ferences i n file #34 4.49
	13809	"RTN","RCD PEWL",120, 0)
	13810	; and rep laced with the use o f paramete rs handled by PARAMS ^RCDPEWLA.
	13811	"RTN","RCD PEWL",121, 0)
	13812	D PARAMS^ RCDPEWLA(" MO") I $G( RCQUIT) S VALMQUIT=1 Q
	13813	"RTN","RCD PEWL",122, 0)
	13814	D BLD^RCD PEWL1($G(^ TMP($J,"RC _SORTPARM" )))
	13815	"RTN","RCD PEWL",123, 0)
	13816	Q
	13817	"RTN","RCD PEWL",124, 0)
	13818	;
	13819	"RTN","RCD PEWL",125, 0)
	13820	CV ; Chang e View Act ion for EE OB Worklis t
	13821	"RTN","RCD PEWL",126, 0)
	13822	D FULL^VA LM1
	13823	"RTN","RCD PEWL",127, 0)
	13824	D PARAMS^ RCDPEWLA(" CV")
	13825	"RTN","RCD PEWL",128, 0)
	13826	D BLD^RCD PEWL1($G(^ TMP($J,"RC _SORTPARM" ))),HDR
	13827	"RTN","RCD PEWL",129, 0)
	13828	S VALMBCK ="R",VALMB G=1
	13829	"RTN","RCD PEWL",130, 0)
	13830	Q
	13831	"RTN","RCD PEWL",131, 0)
	13832	;
	13833	"RTN","RCD PEWL",132, 0)
	13834	ADDREC(RCE RA,RCDAT) ; Add a re cord to fi le 344.49
	13835	"RTN","RCD PEWL",133, 0)
	13836	; RCERA = ien of fi le 344.4
	13837	"RTN","RCD PEWL",134, 0)
	13838	; RCDAT = array con taining ad ditional d ata to add to new en try
	13839	"RTN","RCD PEWL",135, 0)
	13840	;
	13841	"RTN","RCD PEWL",136, 0)
	13842	N DIC,DLA YGO,X,Y,DO ,DD,RCY,DI NUM
	13843	"RTN","RCD PEWL",137, 0)
	13844	S RCY=0,D IC("DR")=" "
	13845	"RTN","RCD PEWL",138, 0)
	13846	S DIC(0)= "L",DLAYGO =344.49,(D INUM,X)=RC ERA,DIC="^ RCY(344.49 ,"
	13847	"RTN","RCD PEWL",139, 0)
	13848	I $G(RCDA T("CHECK#" ))'="" S D IC("DR")=" .04////"_R CDAT("CHEC K#")_";"
	13849	"RTN","RCD PEWL",140, 0)
	13850	I $G(RCDA T("CHECKDT "))'="" S DIC("DR")= DIC("DR")_ ".05////"_ RCDAT("CHE CKDT")_";"
	13851	"RTN","RCD PEWL",141, 0)
	13852	I $G(RCDA T("BANK")) '="" S DIC ("DR")=DIC ("DR")_".0 6////"_RCD AT("BANK") _";"
	13853	"RTN","RCD PEWL",142, 0)
	13854	K DD,DO D FILE^DICN K DIC
	13855	"RTN","RCD PEWL",143, 0)
	13856	I Y>0 S R CY=+Y
	13857	"RTN","RCD PEWL",144, 0)
	13858	Q RCY
	13859	"RTN","RCD PEWL",145, 0)
	13860	;
	13861	"RTN","RCD PEWL",146, 0)
	13862	HDR ; Crea tes header lines for the selec ted ERA di splay
	13863	"RTN","RCD PEWL",147, 0)
	13864	N X,Z,I,R C,RC5,RC4, RCSORTBY,R CEEOBPU
	13865	"RTN","RCD PEWL",148, 0)
	13866	F I=1:1:5 S VALMHDR (I)=""
	13867	"RTN","RCD PEWL",149, 0)
	13868	I '$G(RCS CR) S VALM QUIT=1 Q
	13869	"RTN","RCD PEWL",150, 0)
	13870	S RC=$G(^ RCY(344.4, +RCSCR,0)) ,RC5=$G(^R CY(344.4,+ RCSCR,5))
	13871	"RTN","RCD PEWL",151, 0)
	13872	S RC4=$G( ^RCY(344.4 ,+RCSCR,4) ) ;prca4 .5298
	13873	"RTN","RCD PEWL",152, 0)
	13874	S VALMHDR (1)=$E("ER A Entry #: "_$P(RC,U )_$J("",31 ),1,31)_"T otal Amt P d: "_$J(+$ P(RC,U,5), "",2)
	13875	"RTN","RCD PEWL",153, 0)
	13876	S VALMHDR (2)="Payer Name/ID: "_$P(RC,U, 6)_"/"_$P( RC,U,3)
	13877	"RTN","RCD PEWL",154, 0)
	13878	S Z=+$O(^ RCY(344.31 ,"AERA",+R CSCR,0))
	13879	"RTN","RCD PEWL",155, 0)
	13880	I Z S VAL MHDR(3)="E FT #/TRACE #: "_$P($ G(^RCY(344 .3,+$G(^RC Y(344.31,Z ,0)),0)),U )_"/"_$P(R C,U,2)
	13881	"RTN","RCD PEWL",156, 0)
	13882	I 'Z,$P(R C5,U,2)'=" " S VALMHD R(3)="PAPE R CHECK #: "_$P(RC5, U,2)
	13883	"RTN","RCD PEWL",157, 0)
	13884	; prca4. 5298 per patch req uirements, keep code related t o creating /maintaini ng
	13885	"RTN","RCD PEWL",158, 0)
	13886	; batches but just remove fro m executio n.
	13887	"RTN","RCD PEWL",159, 0)
	13888	;I $G(^TM P("RCBATCH _SELECTED" ,$J)) D
	13889	"RTN","RCD PEWL",160, 0)
	13890	;. N Z,Z0
	13891	"RTN","RCD PEWL",161, 0)
	13892	;. S Z=+$ G(^TMP("RC BATCH_SELE CTED",$J)) ,Z0=$G(^RC Y(344.49,R CSCR,3,Z,0 ))
	13893	"RTN","RCD PEWL",162, 0)
	13894	;. S RCT= RCT+1,VALM HDR(RCT)=" BATCH: "_Z _" "_$P(Z 0,U,2)_" "_$$EXTERN AL^DILFD(3 44.493,.03 ,"",$P(Z0, U,3))
	13895	"RTN","RCD PEWL",163, 0)
	13896	I $G(RCSC R("NOEDIT" )) D
	13897	"RTN","RCD PEWL",164, 0)
	13898	. S VALMH DR(4)="* RECEIPT(S ) ALREADY CREATED * ("_$$REC EIPTS(RCSC R)_")"
	13899	"RTN","RCD PEWL",165, 0)
	13900	I $P(RC4, U,2)]"" D ;AUTO-POS T STATUS ( 344.4, 4.0 2); if no t null, th en the sel ected ERA is designa ted for au to-post
	13901	"RTN","RCD PEWL",166, 0)
	13902	. ; Setti ng the Aut o-Post inf o in the h eader
	13903	"RTN","RCD PEWL",167, 0)
	13904	. N AUTOP STS
	13905	"RTN","RCD PEWL",168, 0)
	13906	. S AUTOP STS="Auto- Post Statu s: "_$S($P (RC4,U,2)= 0:"Unposte d",$P(RC4, U,2)=1:"Pa rtial",1:" Complete")
	13907	"RTN","RCD PEWL",169, 0)
	13908	. S AUTOP STS=AUTOPS TS_" Au to-Post Da te: "_$S($ P(RC4,U,2) >0:$$FMTE^ XLFDT($P(R C4,U)),1:" ") ; PRCA* 4.5*318
	13909	"RTN","RCD PEWL",170, 0)
	13910	. S VALMH DR(5)=AUTO PSTS
	13911	"RTN","RCD PEWL",171, 0)
	13912	; Display ing Curren t View (PR CA4.5298 )
	13913	"RTN","RCD PEWL",172, 0)
	13914	S $E(VALM HDR(1),60) ="Current View:"
	13915	"RTN","RCD PEWL",173, 0)
	13916	S RCSORTB Y=$G(^TMP( $J,"RC_SOR TPARM"))
	13917	"RTN","RCD PEWL",174, 0)
	13918	S $E(VALM HDR(2),60) =$S(RCSORT BY="F":"ZE RO-PAYMENT S FIRST",R CSORTBY="L ":"ZERO-PA YMENTS LAS T",1:"NO S ORT ORDER" )
	13919	"RTN","RCD PEWL",175, 0)
	13920	S RCEEOBP U=$G(^TMP( $J,"RC_EEO BPOST"))
	13921	"RTN","RCD PEWL",176, 0)
	13922	S $E(VALM HDR(3),60) =$S(RCEEOB PU="P":"PO STED EEOBs ONLY",RCE EOBPU="U": "UNPOSTED EEOBs ONLY ",1:"ALL E EOBS")
	13923	"RTN","RCD PEWL",177, 0)
	13924	Q
	13925	"RTN","RCD PEWL",178, 0)
	13926	;
	13927	"RTN","RCD PEWL",179, 0)
	13928	FNL ; -- C lean up li st
	13929	"RTN","RCD PEWL",180, 0)
	13930	K ^TMP("R CDPE-EOB_W LDX",$J),^ TMP("RCDPE -EOB_WL",$ J),^TMP($J ,"RC_SORTP ARM"),^TMP ($J,"RC_BI LL")
	13931	"RTN","RCD PEWL",181, 0)
	13932	D CLEAN^V ALM10,CLEA R^VALM1
	13933	"RTN","RCD PEWL",182, 0)
	13934	K RCFASTX T
	13935	"RTN","RCD PEWL",183, 0)
	13936	Q
	13937	"RTN","RCD PEWL",184, 0)
	13938	;
	13939	"RTN","RCD PEWL",185, 0)
	13940	SEL(RCDA) ; Select e ntry from worklist s cratch pad screen
	13941	"RTN","RCD PEWL",186, 0)
	13942	; RCDA = array retu rned if se lections m ade
	13943	"RTN","RCD PEWL",187, 0)
	13944	; RCDA (n)=ien of entry(s) in file 34 4.41
	13945	"RTN","RCD PEWL",188, 0)
	13946	; where n = the li ne # selec ted
	13947	"RTN","RCD PEWL",189, 0)
	13948	K RCDA
	13949	"RTN","RCD PEWL",190, 0)
	13950	N VALMY
	13951	"RTN","RCD PEWL",191, 0)
	13952	D EN^VALM 2($G(XQORN OD(0)),"S" )
	13953	"RTN","RCD PEWL",192, 0)
	13954	S RCDA=0 F S RCDA= $O(VALMY(R CDA)) Q:'R CDA S RCD A(RCDA)=$P ($G(^TMP(" RCDPE-EOB_ WLDX",$J,R CDA)),U,2, 5)
	13955	"RTN","RCD PEWL",193, 0)
	13956	Q
	13957	"RTN","RCD PEWL",194, 0)
	13958	;
	13959	"RTN","RCD PEWL",195, 0)
	13960	NOEDIT ; D isplay no edit allow ed if rece ipt exists
	13961	"RTN","RCD PEWL",196, 0)
	13962	N DIR,X,Y
	13963	"RTN","RCD PEWL",197, 0)
	13964	S DIR(0)= "EA",DIR(" A",1)="Thi s action i s NOT avai lable sinc e the ERA already ha s a receip t."
	13965	"RTN","RCD PEWL",198, 0)
	13966	S DIR("A" )="PRESS R ETURN TO C ONTINUE "
	13967	"RTN","RCD PEWL",199, 0)
	13968	W ! D ^DI R K DIR W !
	13969	"RTN","RCD PEWL",200, 0)
	13970	Q
	13971	"RTN","RCD PEWL",201, 0)
	13972	;
	13973	"RTN","RCD PEWL",202, 0)
	13974	NOBATCH ; Display ac tion not a llowed if working at batch lev el not the ERA level
	13975	"RTN","RCD PEWL",203, 0)
	13976	N DIR,X,Y
	13977	"RTN","RCD PEWL",204, 0)
	13978	S DIR(0)= "EA",DIR(" A",1)="Thi s action i s NOT vali d when in a batch wi thin the E RA."
	13979	"RTN","RCD PEWL",205, 0)
	13980	S DIR("A" )="PRESS R ETURN TO C ONTINUE "
	13981	"RTN","RCD PEWL",206, 0)
	13982	W ! D ^DI R K DIR W !
	13983	"RTN","RCD PEWL",207, 0)
	13984	Q
	13985	"RTN","RCD PEWL",208, 0)
	13986	;
	13987	"RTN","RCD PEWL",209, 0)
	13988	RECEIPTS(R CSCR) ; ge t list of receipts f or the ERA
	13989	"RTN","RCD PEWL",210, 0)
	13990	; Input: RCSCR: ERA File (#34 4.4) IEN
	13991	"RTN","RCD PEWL",211, 0)
	13992	; Output: "" - No R eceipt / R EC# - One Receipt / REC#A-REC# Z - Range of Receipt s
	13993	"RTN","RCD PEWL",212, 0)
	13994	N X,RECEI PT,CTR,RC0
	13995	"RTN","RCD PEWL",213, 0)
	13996	K ARRAY,S TR
	13997	"RTN","RCD PEWL",214, 0)
	13998	S X=0,CTR =1,(STR,RE CEIPT)=""
	13999	"RTN","RCD PEWL",215, 0)
	14000	F S X=$O (^RCY(344. 4,RCSCR,1, "RECEIPT", X)) Q:'X D
	14001	"RTN","RCD PEWL",216, 0)
	14002	. S:X REC EIPT=$P($G (^RCY(344, X,0)),U) ; get exte rnal form of receipt
	14003	"RTN","RCD PEWL",217, 0)
	14004	. I RECEI PT]"" S AR RAY(RECEIP T)=""
	14005	"RTN","RCD PEWL",218, 0)
	14006	; array o f receipts does not exist so t his could be a non a uto-posted ERA; so o nly 1 rece ipt will b e assigned ; retrieve at 344.4, .08
	14007	"RTN","RCD PEWL",219, 0)
	14008	I '$D(ARR AY),$$GET1 ^DIQ(344.4 ,RCSCR,.08 )'="" S AR RAY($$GET1 ^DIQ(344.4 ,RCSCR,.08 ))=""
	14009	"RTN","RCD PEWL",220, 0)
	14010	;
	14011	"RTN","RCD PEWL",221, 0)
	14012	I $O(ARRA Y($O(ARRAY (""))))'=" " D
	14013	"RTN","RCD PEWL",222, 0)
	14014	. S STR=$ O(ARRAY("" ))_"-"_$O( ARRAY(""), -1)
	14015	"RTN","RCD PEWL",223, 0)
	14016	E D
	14017	"RTN","RCD PEWL",224, 0)
	14018	. S STR=$ O(ARRAY("" ))
	14019	"RTN","RCD PEWL",225, 0)
	14020	Q STR
	14021	"RTN","RCD PEWL2")
	14022	0^21^B1132 68275^B108 949020
	14023	"RTN","RCD PEWL2",1,0 )
	14024	RCDPEWL2 ; ALB/TMK/KM L - ELECTR ONIC EOB W ORKLIST AC TIONS ;7/7 /10 6:43pm
	14025	"RTN","RCD PEWL2",2,0 )
	14026	;;4.5;Acc ounts Rece ivable;1 73,208,269 ,298,303,3 18;Mar 2 0, 1995;Bu ild 25
	14027	"RTN","RCD PEWL2",3,0 )
	14028	;;Per VA Directive 6402, this routine s hould not be modifie d.
	14029	"RTN","RCD PEWL2",4,0 )
	14030	; IA for call to OP TION^IBJTL A = 4121
	14031	"RTN","RCD PEWL2",5,0 )
	14032	; IA for call to AS K^IBRREL = 306
	14033	"RTN","RCD PEWL2",6,0 )
	14034	; IA call for EN1AR ^IBECEA = 4047
	14035	"RTN","RCD PEWL2",7,0 )
	14036	; IA call for MAIN^ IBOHPT1 = 4048
	14037	"RTN","RCD PEWL2",8,0 )
	14038	; IA for read acces s to ^IBM( 361.1 = 40 51
	14039	"RTN","RCD PEWL2",9,0 )
	14040	Q
	14041	"RTN","RCD PEWL2",10, 0)
	14042	;
	14043	"RTN","RCD PEWL2",11, 0)
	14044	VP(RCSCR,R CDAZ) ; Vi ew/Print E OB Detail data from file 361.1
	14045	"RTN","RCD PEWL2",12, 0)
	14046	; RCSCR = ien of en try in fil e 344.4
	14047	"RTN","RCD PEWL2",13, 0)
	14048	; RCDAZ = array sub scripted b y a sequen tial # and
	14049	"RTN","RCD PEWL2",14, 0)
	14050	; RCDAZ (n) = one of 3 forma ts
	14051	"RTN","RCD PEWL2",15, 0)
	14052	; ERA level adj ustments
	14053	"RTN","RCD PEWL2",16, 0)
	14054	; ADJ^the ien of the adj in 34 4.42
	14055	"RTN","RCD PEWL2",17, 0)
	14056	; EOB exists in file 361. 1:
	14057	"RTN","RCD PEWL2",18, 0)
	14058	; ien of l ine in 344 .41^ien of 361.1
	14059	"RTN","RCD PEWL2",19, 0)
	14060	; EOB doesn't e xist in 36 1.1:
	14061	"RTN","RCD PEWL2",20, 0)
	14062	; ien of l ine in 344 .41^-1
	14063	"RTN","RCD PEWL2",21, 0)
	14064	;
	14065	"RTN","RCD PEWL2",22, 0)
	14066	N RCDA,%Z IS,ZTRTN,Z TSAVE,ZTDE SC,POP
	14067	"RTN","RCD PEWL2",23, 0)
	14068	; Ask dev ice
	14069	"RTN","RCD PEWL2",24, 0)
	14070	S %ZIS="Q M" D ^%ZIS G:POP VPQ
	14071	"RTN","RCD PEWL2",25, 0)
	14072	I $D(IO(" Q")) D G VPQ
	14073	"RTN","RCD PEWL2",26, 0)
	14074	. S ZTRTN ="VPOUT^RC DPEWL2",ZT DESC="AR - Print EEO B Detail f rom Workli st"
	14075	"RTN","RCD PEWL2",27, 0)
	14076	. S ZTSAV E("RC*")=" "
	14077	"RTN","RCD PEWL2",28, 0)
	14078	. D ^%ZTL OAD
	14079	"RTN","RCD PEWL2",29, 0)
	14080	. W !!,$S ($D(ZTSK): "Your task number "_ ZTSK_" has been queu ed.",1:"Un able to qu eue this j ob.")
	14081	"RTN","RCD PEWL2",30, 0)
	14082	. K ZTSK, IO("Q") D HOME^%ZIS
	14083	"RTN","RCD PEWL2",31, 0)
	14084	U IO
	14085	"RTN","RCD PEWL2",32, 0)
	14086	;
	14087	"RTN","RCD PEWL2",33, 0)
	14088	VPOUT ; En trypoint f or queued job
	14089	"RTN","RCD PEWL2",34, 0)
	14090	N Z,Z0,RC STOP,RCPG, RCREF,RC36 11,RCDASH, RCDT,RC1,R C3444,RCZ, RCZ0
	14091	"RTN","RCD PEWL2",35, 0)
	14092	;
	14093	"RTN","RCD PEWL2",36, 0)
	14094	K ^TMP("P RCA_EOB",$ J),^TMP("P RCA_EOB1", $J)
	14095	"RTN","RCD PEWL2",37, 0)
	14096	S RCDT=DT ,(RCSTOP,R CPG)=0,RC3 444=RCSCR, RCDASH="", $P(RCDASH, "-",71)=""
	14097	"RTN","RCD PEWL2",38, 0)
	14098	I '$O(RCD AZ(0)) G V PQ
	14099	"RTN","RCD PEWL2",39, 0)
	14100	S RCZ=0 F S RCZ=$O (RCDAZ(RCZ )) Q:'RCZ D
	14101	"RTN","RCD PEWL2",40, 0)
	14102	. S RCREF =$P(RCDAZ( RCZ),U),RC 3611=+$P(R CDAZ(RCZ), U,2)
	14103	"RTN","RCD PEWL2",41, 0)
	14104	. K ^TMP( "PRCA_EOB1 ",$J,RC361 1)
	14105	"RTN","RCD PEWL2",42, 0)
	14106	. ;
	14107	"RTN","RCD PEWL2",43, 0)
	14108	. I $E(RC REF,1,3)[" ADJ" D Q
	14109	"RTN","RCD PEWL2",44, 0)
	14110	.. ;Displ ay ERA lev el adj
	14111	"RTN","RCD PEWL2",45, 0)
	14112	.. S RCZ0 =$G(^RCY(3 44.4,RCSCR ,2,RC3611, 0))
	14113	"RTN","RCD PEWL2",46, 0)
	14114	.. S ^TMP ("PRCA_EOB ",$J,"ADJ" ,1)="ERA L EVEL ADJUS TMENT #"_R C3611
	14115	"RTN","RCD PEWL2",47, 0)
	14116	.. S ^TMP ("PRCA_EOB ",$J,"ADJ" ,2)=" AD JUSTMENT R EFERENCE # : "_$P(RCZ 0,U)
	14117	"RTN","RCD PEWL2",48, 0)
	14118	.. S ^TMP ("PRCA_EOB ",$J,"ADJ" ,3)=" AD JUSTMENT R EASON CODE : "_$P(RCZ 0,U,2)
	14119	"RTN","RCD PEWL2",49, 0)
	14120	.. S ^TMP ("PRCA_EOB ",$J,"ADJ" ,4)=" ADJUSTM ENT AMOUNT : "_$J(+$P (RCZ0,U,3) ,"",2)
	14121	"RTN","RCD PEWL2",50, 0)
	14122	.. S ^TMP ("PRCA_EOB ",$J,"ADJ" ,5)=RCDASH
	14123	"RTN","RCD PEWL2",51, 0)
	14124	. ;
	14125	"RTN","RCD PEWL2",52, 0)
	14126	. I $P(RC DAZ(RCZ),U ,2)'>0 D Q
	14127	"RTN","RCD PEWL2",53, 0)
	14128	.. ;Displ ay formatt ed raw dat a - no EOB data in 3 61.1
	14129	"RTN","RCD PEWL2",54, 0)
	14130	.. K ^TMP ($J,"RC_SU MRAW")
	14131	"RTN","RCD PEWL2",55, 0)
	14132	.. D DISP ^RCDPESR0( "^RCY(344. 4,"_RCSCR_ ",1,"_+RCD AZ(RCZ)_", 1)","^TMP( $J,""RC_SU MRAW"")",1 ,"^TMP(""P RCA_EOB"", $J,0)")
	14133	"RTN","RCD PEWL2",56, 0)
	14134	.. S ^TMP ("PRCA_EOB 1",$J,RC36 11,1)="CLA IM #: "_$$ BILLREF^RC DPESR0(RCS CR,+RCDAZ( RCZ))_"* NOT IDENT IFIED IN A /R **"_$ S($P($G(^R CY(344.4,R CSCR,1,+RC DAZ(RCZ),0 )),U,14):" (REVERSAL )",1:"")
	14135	"RTN","RCD PEWL2",57, 0)
	14136	.. K ^TMP ($J,"RC_SU MRAW")
	14137	"RTN","RCD PEWL2",58, 0)
	14138	.. S ^TMP ("PRCA_EOB ",$J,+$O(^ TMP("PRCA_ EOB",$J,"" ),-1)+1)=R CDASH
	14139	"RTN","RCD PEWL2",59, 0)
	14140	. ;
	14141	"RTN","RCD PEWL2",60, 0)
	14142	. K ^TMP( "PRCA_EOB1 ",$J,RC361 1)
	14143	"RTN","RCD PEWL2",61, 0)
	14144	. S ^TMP( "PRCA_EOB1 ",$J,RC361 1,1)="CLAI M #: "_$$B ILLREF^RCD PESR0(RCSC R,+RCDAZ(R CZ))_$S($P ($G(^RCY(3 44.4,RCSCR ,1,+RCDAZ( RCZ),0)),U ,14):" (RE VERSAL)",1 :"")
	14145	"RTN","RCD PEWL2",62, 0)
	14146	. D GETEO B^IBCECSA6 (RC3611,2)
	14147	"RTN","RCD PEWL2",63, 0)
	14148	. I $O(^I BM(361.1,R C3611,"ERR ",0)) D GE TERR^RCDPE DS(RC3611, +$O(^TMP(" PRCA_EOB", $J,RC3611, " "),-1)) ; get fili ng errors
	14149	"RTN","RCD PEWL2",64, 0)
	14150	. S ^TMP( "PRCA_EOB" ,$J,+$O(^T MP("PRCA_E OB",$J,"") ,-1)+1)=RC DASH
	14151	"RTN","RCD PEWL2",65, 0)
	14152	. ;
	14153	"RTN","RCD PEWL2",66, 0)
	14154	S RC3611= "" F S RC 3611=$O(^T MP("PRCA_E OB",$J,RC3 611)) Q:RC 3611=""!RC STOP D
	14155	"RTN","RCD PEWL2",67, 0)
	14156	. S RC1=1
	14157	"RTN","RCD PEWL2",68, 0)
	14158	. S Z0=0 F S Z0=$O (^TMP("PRC A_EOB",$J, RC3611,Z0) ) Q:'Z0 D Q:RCSTOP
	14159	"RTN","RCD PEWL2",69, 0)
	14160	.. I $D(Z TQUEUED),$ $S^%ZTLOAD S (RCSTOP ,ZTSTOP)=1 K ZTREQ I +$G(RCPG) W !,"**T ASK STOPPE D BY USER **" Q
	14161	"RTN","RCD PEWL2",70, 0)
	14162	.. I 'RCP G!(($Y+5)> IOSL) D I RCSTOP Q
	14163	"RTN","RCD PEWL2",71, 0)
	14164	... D:RCP G ASK(.RCS TOP) I RCS TOP Q
	14165	"RTN","RCD PEWL2",72, 0)
	14166	... D RHD R(RCSCR,RC DT,.RCPG)
	14167	"RTN","RCD PEWL2",73, 0)
	14168	.. I RC1 W !!,$G(^T MP("PRCA_E OB1",$J,RC 3611,1)) S RC1=0
	14169	"RTN","RCD PEWL2",74, 0)
	14170	.. W !,$G (^TMP("PRC A_EOB",$J, RC3611,Z0) )
	14171	"RTN","RCD PEWL2",75, 0)
	14172	I 'RCSTOP ,RCPG D AS K(.RCSTOP)
	14173	"RTN","RCD PEWL2",76, 0)
	14174	;
	14175	"RTN","RCD PEWL2",77, 0)
	14176	I $D(ZTQU EUED) S ZT REQ="@"
	14177	"RTN","RCD PEWL2",78, 0)
	14178	I '$D(ZTQ UEUED) D ^ %ZISC
	14179	"RTN","RCD PEWL2",79, 0)
	14180	;
	14181	"RTN","RCD PEWL2",80, 0)
	14182	VPQ K ^TMP ("PRCA_EOB ",$J),^TMP ("PRCA_EOB 1",$J)
	14183	"RTN","RCD PEWL2",81, 0)
	14184	S VALMBCK ="R"
	14185	"RTN","RCD PEWL2",82, 0)
	14186	Q
	14187	"RTN","RCD PEWL2",83, 0)
	14188	;
	14189	"RTN","RCD PEWL2",84, 0)
	14190	TPJI ; Jum p to Third Party Joi nt Inquiry for the c laim
	14191	"RTN","RCD PEWL2",85, 0)
	14192	D FULL^VA LM1
	14193	"RTN","RCD PEWL2",86, 0)
	14194	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G TPJIQ
	14195	"RTN","RCD PEWL2",87, 0)
	14196	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14197	"RTN","RCD PEWL2",88, 0)
	14198	D OPTION^ IBJTLA ; I A 4121
	14199	"RTN","RCD PEWL2",89, 0)
	14200	D RESTMP^ RCDPEWL6
	14201	"RTN","RCD PEWL2",90, 0)
	14202	;
	14203	"RTN","RCD PEWL2",91, 0)
	14204	TPJIQ S VA LMBCK="R"
	14205	"RTN","RCD PEWL2",92, 0)
	14206	Q
	14207	"RTN","RCD PEWL2",93, 0)
	14208	;
	14209	"RTN","RCD PEWL2",94, 0)
	14210	FAP ; Jump to Full A ccount Pro file
	14211	"RTN","RCD PEWL2",95, 0)
	14212	D FULL^VA LM1
	14213	"RTN","RCD PEWL2",96, 0)
	14214	;
	14215	"RTN","RCD PEWL2",97, 0)
	14216	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G FAPQ
	14217	"RTN","RCD PEWL2",98, 0)
	14218	;
	14219	"RTN","RCD PEWL2",99, 0)
	14220	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14221	"RTN","RCD PEWL2",100 ,0)
	14222	D EN^PRCA APR("ALL") ,RET K DTO UT
	14223	"RTN","RCD PEWL2",101 ,0)
	14224	D RESTMP^ RCDPEWL6
	14225	"RTN","RCD PEWL2",102 ,0)
	14226	;
	14227	"RTN","RCD PEWL2",103 ,0)
	14228	FAPQ S VAL MBCK="R"
	14229	"RTN","RCD PEWL2",104 ,0)
	14230	Q
	14231	"RTN","RCD PEWL2",105 ,0)
	14232	;
	14233	"RTN","RCD PEWL2",106 ,0)
	14234	RELHOLD ; Jump to Re lease Hold function
	14235	"RTN","RCD PEWL2",107 ,0)
	14236	N DIR,X,Y ,RCDA,RCSC R
	14237	"RTN","RCD PEWL2",108 ,0)
	14238	D FULL^VA LM1
	14239	"RTN","RCD PEWL2",109 ,0)
	14240	;
	14241	"RTN","RCD PEWL2",110 ,0)
	14242	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G RELHQ
	14243	"RTN","RCD PEWL2",111 ,0)
	14244	;
	14245	"RTN","RCD PEWL2",112 ,0)
	14246	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14247	"RTN","RCD PEWL2",113 ,0)
	14248	D ^IBRREL ,RET ; IA = 306
	14249	"RTN","RCD PEWL2",114 ,0)
	14250	D RESTMP^ RCDPEWL6
	14251	"RTN","RCD PEWL2",115 ,0)
	14252	;
	14253	"RTN","RCD PEWL2",116 ,0)
	14254	RELHQ S VA LMBCK="R"
	14255	"RTN","RCD PEWL2",117 ,0)
	14256	Q
	14257	"RTN","RCD PEWL2",118 ,0)
	14258	;
	14259	"RTN","RCD PEWL2",119 ,0)
	14260	CMRPT ; Ju mp to clai ms matchin g report
	14261	"RTN","RCD PEWL2",120 ,0)
	14262	N DIR,X,Y ,RCIBY
	14263	"RTN","RCD PEWL2",121 ,0)
	14264	D FULL^VA LM1
	14265	"RTN","RCD PEWL2",122 ,0)
	14266	;
	14267	"RTN","RCD PEWL2",123 ,0)
	14268	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G CMQ
	14269	"RTN","RCD PEWL2",124 ,0)
	14270	;
	14271	"RTN","RCD PEWL2",125 ,0)
	14272	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14273	"RTN","RCD PEWL2",126 ,0)
	14274	D ^RCDPRT P,RET
	14275	"RTN","RCD PEWL2",127 ,0)
	14276	D RESTMP^ RCDPEWL6
	14277	"RTN","RCD PEWL2",128 ,0)
	14278	;
	14279	"RTN","RCD PEWL2",129 ,0)
	14280	CMQ S VALM BCK="R"
	14281	"RTN","RCD PEWL2",130 ,0)
	14282	Q
	14283	"RTN","RCD PEWL2",131 ,0)
	14284	;
	14285	"RTN","RCD PEWL2",132 ,0)
	14286	CHGMNT ; J ump to cha rge mainte nance
	14287	"RTN","RCD PEWL2",133 ,0)
	14288	N DIR,X,Y ,RCSCR
	14289	"RTN","RCD PEWL2",134 ,0)
	14290	D FULL^VA LM1
	14291	"RTN","RCD PEWL2",135 ,0)
	14292	;
	14293	"RTN","RCD PEWL2",136 ,0)
	14294	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G CHMQ
	14295	"RTN","RCD PEWL2",137 ,0)
	14296	;
	14297	"RTN","RCD PEWL2",138 ,0)
	14298	I $D(^XUS EC("PRCA E DI LOCKBOX CHARGES", DUZ)) D
	14299	"RTN","RCD PEWL2",139 ,0)
	14300	. M ^TMP( "RC_SAVE_T MP",$J)=^T MP($J)
	14301	"RTN","RCD PEWL2",140 ,0)
	14302	. D EN1AR ^IBECEA ; IA 4047
	14303	"RTN","RCD PEWL2",141 ,0)
	14304	. D RESTM P^RCDPEWL6
	14305	"RTN","RCD PEWL2",142 ,0)
	14306	E D
	14307	"RTN","RCD PEWL2",143 ,0)
	14308	. S DIR(0 )="EA",DIR ("A",1)="Y OU DO NOT HAVE THE K EY NEEDED TO ACCESS THIS OPTIO N.",DIR("A ")="PRESS RETURN TO CONTINUE " W ! D ^DI R K DIR
	14309	"RTN","RCD PEWL2",144 ,0)
	14310	;
	14311	"RTN","RCD PEWL2",145 ,0)
	14312	S VALMBCK ="R"
	14313	"RTN","RCD PEWL2",146 ,0)
	14314	CHMQ Q
	14315	"RTN","RCD PEWL2",147 ,0)
	14316	;
	14317	"RTN","RCD PEWL2",148 ,0)
	14318	LSTHLD ; J ump to lis t current/ on hold ch arges
	14319	"RTN","RCD PEWL2",149 ,0)
	14320	N DIR,X,Y ,RCIBY
	14321	"RTN","RCD PEWL2",150 ,0)
	14322	D FULL^VA LM1
	14323	"RTN","RCD PEWL2",151 ,0)
	14324	;
	14325	"RTN","RCD PEWL2",152 ,0)
	14326	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G LHQ
	14327	"RTN","RCD PEWL2",153 ,0)
	14328	;
	14329	"RTN","RCD PEWL2",154 ,0)
	14330	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14331	"RTN","RCD PEWL2",155 ,0)
	14332	D MAIN^IB OHPT1,RET ; IA 4048
	14333	"RTN","RCD PEWL2",156 ,0)
	14334	D RESTMP^ RCDPEWL6
	14335	"RTN","RCD PEWL2",157 ,0)
	14336	;
	14337	"RTN","RCD PEWL2",158 ,0)
	14338	S VALMBCK ="R"
	14339	"RTN","RCD PEWL2",159 ,0)
	14340	LHQ Q
	14341	"RTN","RCD PEWL2",160 ,0)
	14342	;
	14343	"RTN","RCD PEWL2",161 ,0)
	14344	REEST ;EP - Protocol action - RCDPE EOB WORKLIST R EESTABLISH
	14345	"RTN","RCD PEWL2",162 ,0)
	14346	; Jump to re-establ ish bill
	14347	"RTN","RCD PEWL2",163 ,0)
	14348	N PRC
	14349	"RTN","RCD PEWL2",164 ,0)
	14350	D FULL^VA LM1
	14351	"RTN","RCD PEWL2",165 ,0)
	14352	I '$D(^XU SEC("RCDPE AR",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	14353	"RTN","RCD PEWL2",166 ,0)
	14354	. W !!,"T his action can only be taken b y users th at have th e RCDPEAR security k ey.",!
	14355	"RTN","RCD PEWL2",167 ,0)
	14356	. D PAUSE ^VALM1
	14357	"RTN","RCD PEWL2",168 ,0)
	14358	. S VALMB CK="R"
	14359	"RTN","RCD PEWL2",169 ,0)
	14360	;
	14361	"RTN","RCD PEWL2",170 ,0)
	14362	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G REEST Q
	14363	"RTN","RCD PEWL2",171 ,0)
	14364	;
	14365	"RTN","RCD PEWL2",172 ,0)
	14366	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14367	"RTN","RCD PEWL2",173 ,0)
	14368	D ^PRCAWR EA K DTOUT
	14369	"RTN","RCD PEWL2",174 ,0)
	14370	D RESTMP^ RCDPEWL6
	14371	"RTN","RCD PEWL2",175 ,0)
	14372	D RET
	14373	"RTN","RCD PEWL2",176 ,0)
	14374	;
	14375	"RTN","RCD PEWL2",177 ,0)
	14376	REESTQ S V ALMBCK="R"
	14377	"RTN","RCD PEWL2",178 ,0)
	14378	Q
	14379	"RTN","RCD PEWL2",179 ,0)
	14380	;
	14381	"RTN","RCD PEWL2",180 ,0)
	14382	BILLCOM ; Jump to bi ll comment log
	14383	"RTN","RCD PEWL2",181 ,0)
	14384	D FULL^VA LM1
	14385	"RTN","RCD PEWL2",182 ,0)
	14386	;
	14387	"RTN","RCD PEWL2",183 ,0)
	14388	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G BILLC OMQ
	14389	"RTN","RCD PEWL2",184 ,0)
	14390	;
	14391	"RTN","RCD PEWL2",185 ,0)
	14392	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	14393	"RTN","RCD PEWL2",186 ,0)
	14394	D ^PRCACM K DTOUT
	14395	"RTN","RCD PEWL2",187 ,0)
	14396	D RET
	14397	"RTN","RCD PEWL2",188 ,0)
	14398	D RESTMP^ RCDPEWL6
	14399	"RTN","RCD PEWL2",189 ,0)
	14400	;
	14401	"RTN","RCD PEWL2",190 ,0)
	14402	BILLCOMQ S VALMBCK=" R"
	14403	"RTN","RCD PEWL2",191 ,0)
	14404	Q
	14405	"RTN","RCD PEWL2",192 ,0)
	14406	;
	14407	"RTN","RCD PEWL2",193 ,0)
	14408	ASK(RCSTOP ) ;
	14409	"RTN","RCD PEWL2",194 ,0)
	14410	I $E(IOST ,1,2)'["C- " Q
	14411	"RTN","RCD PEWL2",195 ,0)
	14412	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
	14413	"RTN","RCD PEWL2",196 ,0)
	14414	S DIR(0)= "E" W ! D ^DIR
	14415	"RTN","RCD PEWL2",197 ,0)
	14416	I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q
	14417	"RTN","RCD PEWL2",198 ,0)
	14418	Q
	14419	"RTN","RCD PEWL2",199 ,0)
	14420	;
	14421	"RTN","RCD PEWL2",200 ,0)
	14422	RHDR(RCSCR ,RCDT,RCPG ) ;Prints EOB detail report he ading
	14423	"RTN","RCD PEWL2",201 ,0)
	14424	N Z
	14425	"RTN","RCD PEWL2",202 ,0)
	14426	S Z=$G(^R CY(344.4,R CSCR,0))
	14427	"RTN","RCD PEWL2",203 ,0)
	14428	I RCPG!($ E(IOST,1,2 )="C-") W @IOF,*13
	14429	"RTN","RCD PEWL2",204 ,0)
	14430	S RCPG=RC PG+1
	14431	"RTN","RCD PEWL2",205 ,0)
	14432	W !,?15," EDI LOCKBO X EEOB DET AIL FROM W ORKLIST",? 55,$$FMTE^ XLFDT(RCDT ,2),?70,"P age: ",RCP G
	14433	"RTN","RCD PEWL2",206 ,0)
	14434	; HIPAA 5 010 - TRAC E # increa sed in len gth from 3 0 to 50 ch aracters t herefore i t needs to be displa yed on its own line
	14435	"RTN","RCD PEWL2",207 ,0)
	14436	W !!,$E(" ERA NUMBE R: "_RCSCR _$J("",25) ,1,25)_"ER A DATE: "_ $$FMTE^XLF DT($P(Z,U, 4)),!,"INS COMPANY: "_$P(Z,U,6 )_"/"_$P(Z ,U,3)
	14437	"RTN","RCD PEWL2",208 ,0)
	14438	W !,"ERA TRACE #: " _$P(Z,U,2)
	14439	"RTN","RCD PEWL2",209 ,0)
	14440	W !,$TR($ J("",IOM), " ","=")
	14441	"RTN","RCD PEWL2",210 ,0)
	14442	Q
	14443	"RTN","RCD PEWL2",211 ,0)
	14444	;
	14445	"RTN","RCD PEWL2",212 ,0)
	14446	RET ; Paus e before r eturning t o list
	14447	"RTN","RCD PEWL2",213 ,0)
	14448	N DIR,X,Y
	14449	"RTN","RCD PEWL2",214 ,0)
	14450	S DIR(0)= "EA",DIR(" A")="RETUR N TO CONTI NUE" W ! D ^DIR K DI R
	14451	"RTN","RCD PEWL2",215 ,0)
	14452	Q
	14453	"RTN","RCD PEWL2",216 ,0)
	14454	;
	14455	"RTN","RCD PEWL2",217 ,0)
	14456	NOWAY ; Ms g for unid entified b ill
	14457	"RTN","RCD PEWL2",218 ,0)
	14458	N DIR,X,Y
	14459	"RTN","RCD PEWL2",219 ,0)
	14460	S DIR(0)= "EA",DIR(" A",1)="THI S BILL IS NOT IDENTI FIED IN YO UR A/R",DI R("A")="TH IS FUNCTIO N IS NOT A VAILABLE . .. RETURN TO CONTINU E " W ! D ^DIR K DIR
	14461	"RTN","RCD PEWL2",220 ,0)
	14462	Q
	14463	"RTN","RCD PEWL2",221 ,0)
	14464	;
	14465	"RTN","RCD PEWL2",222 ,0)
	14466	NOWAY1 ; M sg for ERA level Adj ustment
	14467	"RTN","RCD PEWL2",223 ,0)
	14468	N DIR,X,Y
	14469	"RTN","RCD PEWL2",224 ,0)
	14470	S DIR(0)= "EA",DIR(" A",1)="THI S IS AN ER A LEVEL AD JUSTMENT - NO DATA E XISTS FOR IT IN YOUR AR",DIR(" A")="PRESS ENTER TO CONTINUE" W ! D ^DIR K DIR
	14471	"RTN","RCD PEWL2",225 ,0)
	14472	Q
	14473	"RTN","RCD PEWL2",226 ,0)
	14474	;
	14475	"RTN","RCD PEWL2",227 ,0)
	14476	SET1(RCIBY ,RCDA,RCDA 1,RC3444,R CREF) ; Se t up varia bles for r eceipt/ERA
	14477	"RTN","RCD PEWL2",228 ,0)
	14478	S RCDA1=+ RCIBY("IBE OB"),RCDA= +$P(RCIBY( "IBEOB"),U ,2),RC3444 =+$P(RCIBY ("IBEOB"), U,3),RCREF =+$P(RCIBY ("IBEOB"), U,4)
	14479	"RTN","RCD PEWL2",229 ,0)
	14480	Q
	14481	"RTN","RCD PEWL2",230 ,0)
	14482	;
	14483	"RTN","RCD PEWL2",231 ,0)
	14484	CHKFILE ; If the use r leaves t he split l ine screen without f iling - do uble check
	14485	"RTN","RCD PEWL2",232 ,0)
	14486	; that th ey didn't want to fi le it.
	14487	"RTN","RCD PEWL2",233 ,0)
	14488	N DIR,X,Y
	14489	"RTN","RCD PEWL2",234 ,0)
	14490	D FULL^VA LM1 W !!
	14491	"RTN","RCD PEWL2",235 ,0)
	14492	I $G(^TMP ("RCDPE_EO B_SPLIT_OK ",$J)),$O( RCSPLIT(0) ) D
	14493	"RTN","RCD PEWL2",236 ,0)
	14494	. S DIR(0 )="YA",DIR ("B")="NO" ,DIR("A",1 )="YOU HAV E NOT FILE D THESE CH ANGES",DIR ("A")="DO YOU WANT T O FILE THE M BEFORE Y OU EXIT?: " D ^DIR K DIR
	14495	"RTN","RCD PEWL2",237 ,0)
	14496	. I Y=1 D FILESP^RC DPEWL8
	14497	"RTN","RCD PEWL2",238 ,0)
	14498	K ^TMP($J ,"RCDPE_SP LIT_FILE")
	14499	"RTN","RCD PEWL2",239 ,0)
	14500	Q
	14501	"RTN","RCD PEWL2",240 ,0)
	14502	;
	14503	"RTN","RCD PEWL2",241 ,0)
	14504	EDITSP ; A ction that edits the split lin es
	14505	"RTN","RCD PEWL2",242 ,0)
	14506	; RCLINE, RCSCR must already e xist
	14507	"RTN","RCD PEWL2",243 ,0)
	14508	N DA,RCED IT,RCDONE, RCDEF,RCSA VE,RCSAVE1
	14509	"RTN","RCD PEWL2",244 ,0)
	14510	D FULL^VA LM1
	14511	"RTN","RCD PEWL2",245 ,0)
	14512	;
	14513	"RTN","RCD PEWL2",246 ,0)
	14514	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G EDITQ
	14515	"RTN","RCD PEWL2",247 ,0)
	14516	;
	14517	"RTN","RCD PEWL2",248 ,0)
	14518	D SEL(.RC EDIT)
	14519	"RTN","RCD PEWL2",249 ,0)
	14520	G:'RCEDIT EDITQ
	14521	"RTN","RCD PEWL2",250 ,0)
	14522	S RCDONE= 0
	14523	"RTN","RCD PEWL2",251 ,0)
	14524	M RCSAVE= RCSPLIT,RC SAVE1=RCDI R S RCDEF= $G(RCSPLIT (RCEDIT)), RCSPLIT=RC EDIT
	14525	"RTN","RCD PEWL2",252 ,0)
	14526	D EDIT^RC DPEWL3(RCS CR,RCLINE, .RCDIR,.RC SPLIT,RCDE F,.RCDONE)
	14527	"RTN","RCD PEWL2",253 ,0)
	14528	I '$D(RCS PLIT(RCSAV E)) K RCSP LIT M RCSP LIT=RCSAVE K RCDIR M RCDIR=RCS AVE1
	14529	"RTN","RCD PEWL2",254 ,0)
	14530	D INIT^RC DPEWL3
	14531	"RTN","RCD PEWL2",255 ,0)
	14532	EDITQ S VA LMBCK="R"
	14533	"RTN","RCD PEWL2",256 ,0)
	14534	Q
	14535	"RTN","RCD PEWL2",257 ,0)
	14536	;
	14537	"RTN","RCD PEWL2",258 ,0)
	14538	PREOB ; Pr int/View E OB detail
	14539	"RTN","RCD PEWL2",259 ,0)
	14540	N RCDA,RC DAZ,Z,Z0
	14541	"RTN","RCD PEWL2",260 ,0)
	14542	D FULL^VA LM1
	14543	"RTN","RCD PEWL2",261 ,0)
	14544	D SEL^RCD PEWL(.RCDA )
	14545	"RTN","RCD PEWL2",262 ,0)
	14546	S RCDA=+$ O(RCDA(0)) ,RCDA=$G(R CDA(RCDA))
	14547	"RTN","RCD PEWL2",263 ,0)
	14548	I RCDA="" G PREOBQ
	14549	"RTN","RCD PEWL2",264 ,0)
	14550	S RCDA=$P ($G(^RCY(3 44.49,RCSC R,1,+RCDA, 0)),U,9)
	14551	"RTN","RCD PEWL2",265 ,0)
	14552	F RCDAZ=1 :1:$L(RCDA ,",") S RC DAZ(RCDAZ) =$P(RCDA," ,",RCDAZ)
	14553	"RTN","RCD PEWL2",266 ,0)
	14554	S Z=0 F S Z=$O(RCD AZ(Z)) Q:' Z D
	14555	"RTN","RCD PEWL2",267 ,0)
	14556	. ;
	14557	"RTN","RCD PEWL2",268 ,0)
	14558	. S Z0=RC DAZ(Z)
	14559	"RTN","RCD PEWL2",269 ,0)
	14560	. I $E(Z0 ,1,3)="ADJ " D Q
	14561	"RTN","RCD PEWL2",270 ,0)
	14562	.. I $G(^ RCY(344.4, RCSCR,2,+$ P(Z0,"ADJ" ,2),0))'=" " S RCDAZ( Z)="ADJ^"_ +$P(Z0,"AD J",2)
	14563	"RTN","RCD PEWL2",271 ,0)
	14564	. ;
	14565	"RTN","RCD PEWL2",272 ,0)
	14566	. S Z0=$G (^RCY(344. 4,RCSCR,1, +Z0,0))
	14567	"RTN","RCD PEWL2",273 ,0)
	14568	. S RCDAZ (Z)=+Z0_U_ $S($P(Z0,U ,2):$P(Z0, U,2),1:-1) Q
	14569	"RTN","RCD PEWL2",274 ,0)
	14570	;
	14571	"RTN","RCD PEWL2",275 ,0)
	14572	D VP(RCSC R,.RCDAZ)
	14573	"RTN","RCD PEWL2",276 ,0)
	14574	;
	14575	"RTN","RCD PEWL2",277 ,0)
	14576	PREOBQ S V ALMBCK="R"
	14577	"RTN","RCD PEWL2",278 ,0)
	14578	Q
	14579	"RTN","RCD PEWL2",279 ,0)
	14580	;
	14581	"RTN","RCD PEWL2",280 ,0)
	14582	RESEARCH ; Invoke th e research menu
	14583	"RTN","RCD PEWL2",281 ,0)
	14584	;
	14585	"RTN","RCD PEWL2",282 ,0)
	14586	K ^TMP($J ,"RC_VALMB G")
	14587	"RTN","RCD PEWL2",283 ,0)
	14588	S ^TMP($J ,"RC_VALMB G")=$G(VAL MBG)
	14589	"RTN","RCD PEWL2",284 ,0)
	14590	D FULL^VA LM1
	14591	"RTN","RCD PEWL2",285 ,0)
	14592	I $G(RCSC R("NOEDIT" ))=2 D NOT AV G RQ
	14593	"RTN","RCD PEWL2",286 ,0)
	14594	;
	14595	"RTN","RCD PEWL2",287 ,0)
	14596	D EN^VALM ("RCDPE EO B RESEARCH ")
	14597	"RTN","RCD PEWL2",288 ,0)
	14598	;
	14599	"RTN","RCD PEWL2",289 ,0)
	14600	RQ K ^TMP( $J,"RC_VAL MBG")
	14601	"RTN","RCD PEWL2",290 ,0)
	14602	Q
	14603	"RTN","RCD PEWL2",291 ,0)
	14604	;
	14605	"RTN","RCD PEWL2",292 ,0)
	14606	SEL(RCEDIT ) ;
	14607	"RTN","RCD PEWL2",293 ,0)
	14608	N VALMY
	14609	"RTN","RCD PEWL2",294 ,0)
	14610	D EN^VALM 2($G(XQORN OD(0)),"S" )
	14611	"RTN","RCD PEWL2",295 ,0)
	14612	S RCEDIT= +$O(VALMY( 0))
	14613	"RTN","RCD PEWL2",296 ,0)
	14614	Q
	14615	"RTN","RCD PEWL2",297 ,0)
	14616	;
	14617	"RTN","RCD PEWL2",298 ,0)
	14618	EXIT ; Exi ts back to ERA menu actions fr om researc h
	14619	"RTN","RCD PEWL2",299 ,0)
	14620	S VALMBCK ="Q"
	14621	"RTN","RCD PEWL2",300 ,0)
	14622	Q
	14623	"RTN","RCD PEWL2",301 ,0)
	14624	;
	14625	"RTN","RCD PEWL2",302 ,0)
	14626	WL(RCRCPT) ; Entrypo int to the ERA Workl ist from R eceipt Pro cessing
	14627	"RTN","RCD PEWL2",303 ,0)
	14628	;RCRCPT = ien of en try in fil e 344
	14629	"RTN","RCD PEWL2",304 ,0)
	14630	N DIR,X,Y ,Z
	14631	"RTN","RCD PEWL2",305 ,0)
	14632	D FULL^VA LM1
	14633	"RTN","RCD PEWL2",306 ,0)
	14634	; if not at ERA sum mary level (344.4,.0 8), get a receipt ma tch using the cross- reference at the ERA detail (R ECEIPT (34 4.41, .25)
	14635	"RTN","RCD PEWL2",307 ,0)
	14636	S Z=$S($O (^RCY(344. 4,"AREC",R CRCPT,0)): +$O(^RCY(3 44.4,"AREC ",RCRCPT,0 )),1:+$O(^ RCY(344.4, "H",RCRCPT ,0)))
	14637	"RTN","RCD PEWL2",308 ,0)
	14638	I 'Z D G WLQ
	14639	"RTN","RCD PEWL2",309 ,0)
	14640	. S DIR(" A")="THIS RECEIPT IS NOT ASSOC IATED WITH AN ERA RE CORD - PRE SS RETURN TO CONTINU E ",DIR(0) ="EA" W ! D ^DIR K D IR
	14641	"RTN","RCD PEWL2",310 ,0)
	14642	;
	14643	"RTN","RCD PEWL2",311 ,0)
	14644	I '$D(^RC Y(344.49,Z ,0)) D G WLQ
	14645	"RTN","RCD PEWL2",312 ,0)
	14646	. S DIR(" A")="NO ER A WORKLIST SCRATCHPA D EXISTS F OR THIS ER A - PRESS RETURN TO CONTINUE " ,DIR(0)="E A" W ! D ^ DIR K DIR
	14647	"RTN","RCD PEWL2",313 ,0)
	14648	;
	14649	"RTN","RCD PEWL2",314 ,0)
	14650	D DISP^RC DPEWL(Z,2)
	14651	"RTN","RCD PEWL2",315 ,0)
	14652	;
	14653	"RTN","RCD PEWL2",316 ,0)
	14654	WLQ S VALM BCK="R"
	14655	"RTN","RCD PEWL2",317 ,0)
	14656	Q
	14657	"RTN","RCD PEWL2",318 ,0)
	14658	;
	14659	"RTN","RCD PEWL2",319 ,0)
	14660	NOTAV ; Di splay not available msg
	14661	"RTN","RCD PEWL2",320 ,0)
	14662	N DIR,X,Y
	14663	"RTN","RCD PEWL2",321 ,0)
	14664	;
	14665	"RTN","RCD PEWL2",322 ,0)
	14666	S DIR(0)= "EA",DIR(" A")="THIS ACTION NOT CURRENTLY AVAILABLE - PRESS R ETURN TO C ONTINUE " W ! D ^DIR K DIR
	14667	"RTN","RCD PEWL2",323 ,0)
	14668	S VALMBCK ="R"
	14669	"RTN","RCD PEWL2",324 ,0)
	14670	Q
	14671	"RTN","RCD PEWL2",325 ,0)
	14672	;
	14673	"RTN","RCD PEWL2",326 ,0)
	14674	;PRCA4.5 303 - Add jump to E CME Inform ation from the ERA W orklist Re search
	14675	"RTN","RCD PEWL2",327 ,0)
	14676	; IA 1992 - BILL/CL AIMS file (#399)
	14677	"RTN","RCD PEWL2",328 ,0)
	14678	; RCIENS exists bef ore this c ode is cal led if com ing from A PAR
	14679	"RTN","RCD PEWL2",329 ,0)
	14680	; RCERA, RCSCR are assumed to exist bef ore this c ode is cal led
	14681	"RTN","RCD PEWL2",330 ,0)
	14682	GOECME ; S elect an E EOB and th en jump to the [IBJT ECME RESP INFO SCRE EN]
	14683	"RTN","RCD PEWL2",331 ,0)
	14684	N RCDA,RC DAZ,RCDG,Z ,Z0,IBIFN, DFN,RCAPAR
	14685	"RTN","RCD PEWL2",332 ,0)
	14686	S RCAPAR= 0
	14687	"RTN","RCD PEWL2",333 ,0)
	14688	I '$D(RCS CR) S RCAP AR=1,(RCER A,RCSCR)=$ P($G(RCIEN S),U,1) ; From APAR RCSCR & RC ERA not de fined
	14689	"RTN","RCD PEWL2",334 ,0)
	14690	G:($G(RCE RA)="")!($ G(RCSCR)=" ") GOEBQ
	14691	"RTN","RCD PEWL2",335 ,0)
	14692	D FULL^VA LM1
	14693	"RTN","RCD PEWL2",336 ,0)
	14694	D SEL^RCD PEWL(.RCDA )
	14695	"RTN","RCD PEWL2",337 ,0)
	14696	S RCDA=+$ O(RCDA(0)) ,RCDA=$G(R CDA(RCDA))
	14697	"RTN","RCD PEWL2",338 ,0)
	14698	I RCDA="" G GOEBQ
	14699	"RTN","RCD PEWL2",339 ,0)
	14700	S RCDA=$P ($G(^RCY(3 44.49,RCSC R,1,+RCDA, 0)),U,9)
	14701	"RTN","RCD PEWL2",340 ,0)
	14702	S IBIFN=$ P($G(^RCY( 344.4,RCER A,1,RCDA,0 )),U,2) S: +IBIFN'=0 RCDG=$P($G (^IBM(361. 1,IBIFN,0) ),U,1)
	14703	"RTN","RCD PEWL2",341 ,0)
	14704	I $G(RCDG )="" W !!, "Problem w ith Bill I EN: "_IBIF N_", ERA: "_RCERA_" Please rep ort this i ssue." D P AUSE^VALM1 G GOEBQ
	14705	"RTN","RCD PEWL2",342 ,0)
	14706	S DFN=$P( $G(^DGCR(3 99,RCDG,0) ),U,2)
	14707	"RTN","RCD PEWL2",343 ,0)
	14708	I RCAPAR S IBIFN=RC DG
	14709	"RTN","RCD PEWL2",344 ,0)
	14710	I '$$ISRX ^IBCEF1(IB IFN) W !!, "Not avail able. This is not a Pharmacy C laim." D P AUSE^VALM1 G GOEBQ
	14711	"RTN","RCD PEWL2",345 ,0)
	14712	I $$ECME^ IBTRE(IBIF N)="" W !! ,"Not avai lable. Thi s is a Pha rmacy Clai m, but not an ECME C laim." D P AUSE^VALM1 G GOEBQ
	14713	"RTN","RCD PEWL2",346 ,0)
	14714	D EN^VALM ("IBJT ECM E RESP INF O")
	14715	"RTN","RCD PEWL2",347 ,0)
	14716	;
	14717	"RTN","RCD PEWL2",348 ,0)
	14718	GOEBQ S VA LMBCK="R"
	14719	"RTN","RCD PEWL2",349 ,0)
	14720	I RCAPAR K RCSCR,RC ERA ; Clea n up if we are in AP AR
	14721	"RTN","RCD PEWL2",350 ,0)
	14722	Q
	14723	"RTN","RCD PEWL4")
	14724	0^22^B6291 6742^B5774 0502
	14725	"RTN","RCD PEWL4",1,0 )
	14726	RCDPEWL4 ; ALB/TMK/PJ H - ELECTR ONIC EOB W ORKLIST AC TIONS ;Jun 06, 2014@ 19:11:19
	14727	"RTN","RCD PEWL4",2,0 )
	14728	;;4.5;Acc ounts Rece ivable;1 73,208,269 ,298,303,3 18;Mar 2 0, 1995;Bu ild 25
	14729	"RTN","RCD PEWL4",3,0 )
	14730	;;Per VA Directive 6402, this routine s hould not be modifie d.
	14731	"RTN","RCD PEWL4",4,0 )
	14732	; RCSCR v ariable mu st be defi ned for th is routine
	14733	"RTN","RCD PEWL4",5,0 )
	14734	Q
	14735	"RTN","RCD PEWL4",6,0 )
	14736	;
	14737	"RTN","RCD PEWL4",7,0 )
	14738	DISTADJ(RC FR,RCTO,RC AMT,RCCOM) ; Action that distr ibutes an adjustment amount
	14739	"RTN","RCD PEWL4",8,0 )
	14740	; against another l ine item's payment
	14741	"RTN","RCD PEWL4",9,0 )
	14742	; Assumes RCSCR = i en of the entry in f ile 344.49
	14743	"RTN","RCD PEWL4",10, 0)
	14744	; RCFR = ien of ent ry in 344. 491 that h as a negat ive net
	14745	"RTN","RCD PEWL4",11, 0)
	14746	; RCTO = ien of ent ry in 344. 491 that w ill be dec remented
	14747	"RTN","RCD PEWL4",12, 0)
	14748	; RCAMT = the amoun t being ad justed (po sitive #)
	14749	"RTN","RCD PEWL4",13, 0)
	14750	; RCCOM = the comme nt to plac e on the d ecrease ad justment
	14751	"RTN","RCD PEWL4",14, 0)
	14752	;
	14753	"RTN","RCD PEWL4",15, 0)
	14754	N RCFRX,R CREF,RCFR0 ,RCFR1,RCF R10,RCTO0, RCTO1,RCTO 10,RCY,DIK ,DA,DR,DIC ,X,Y,DLAYG O,DD,DO,DI E,DIR
	14755	"RTN","RCD PEWL4",16, 0)
	14756	I $G(^TMP ("RCBATCH_ SELECTED", $J)) D NOB ATCH^RCDPE WL Q
	14757	"RTN","RCD PEWL4",17, 0)
	14758	S RCFR0=$ G(^RCY(344 .49,RCSCR, 1,RCFR,0)) ,RCTO0=$G( ^RCY(344.4 9,RCSCR,1, RCTO,0)),R CFRX=+$O(^ RCY(344.49 ,RCSCR,1," B",RCFR0\1 ,0)),RCFRX =$G(^RCY(3 44.49,RCSC R,1,RCFRX, 0))
	14759	"RTN","RCD PEWL4",18, 0)
	14760	S RCREF=$ P($P(RCFRX ,U,2),"**A DJ",2),RCR EF=$S(RCRE F="":"",RC REF=0:$P(R CFRX,U,9), 1:$P($G(^R CY(344.4,R CSCR,2,+RC REF,0)),U) )
	14761	"RTN","RCD PEWL4",19, 0)
	14762	S RCFR1=+ $O(^RCY(34 4.49,RCSCR ,1,"B",RCF R0\1,0)),R CTO1=+$O(^ RCY(344.49 ,RCSCR,1," B",RCTO0\1 ,0))
	14763	"RTN","RCD PEWL4",20, 0)
	14764	S RCFR10= $G(^RCY(34 4.49,RCSCR ,1,RCFR1,0 )),RCTO10= $G(^RCY(34 4.49,RCSCR ,1,RCTO1,0 ))
	14765	"RTN","RCD PEWL4",21, 0)
	14766	S RCFR0=$ G(^RCY(344 .49,RCSCR, 1,RCFR,0)) ,RCTO0=$G( ^RCY(344.4 9,RCSCR,1, RCTO,0))
	14767	"RTN","RCD PEWL4",22, 0)
	14768	S DA(2)=R CSCR,DA(1) =RCFR
	14769	"RTN","RCD PEWL4",23, 0)
	14770	S DIC("DR ")=".02/// /1;.03//// "_RCAMT_"; .04////"_$ S($P(RCTO0 ,U,2)'="": $P(RCTO0,U ,2),RCREF' ="":RCREF, 1:"UNKNOWN ")
	14771	"RTN","RCD PEWL4",24, 0)
	14772	S DIC("DR ")=DIC("DR ")_";.05// //0;.06/// /0;.09//// RETRACTED FUNDS DEDU CTED FROM OTHER PAYM ENT ON THI S ERA",DIC ="^RCY(344 .49,"_DA(2 )_",1,"_DA (1)_",1,"
	14773	"RTN","RCD PEWL4",25, 0)
	14774	S DLAYGO= 344.4911,D IC(0)="L", X=+$O(^RCY (344.49,RC SCR,1,RCFR ,1,"B","") ,-1)+1
	14775	"RTN","RCD PEWL4",26, 0)
	14776	D FILE^DI CN K DIC,D D,DO,DLAYG O
	14777	"RTN","RCD PEWL4",27, 0)
	14778	S RCY=+Y
	14779	"RTN","RCD PEWL4",28, 0)
	14780	I RCY'>0 D Q
	14781	"RTN","RCD PEWL4",29, 0)
	14782	. S DIR(0 )="EA",DIR ("A",1)="P ROBLEM ADD ING ADJUST MENT - NO DISTRIBUTI ON PERFORM ED",DIR("A ")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
	14783	"RTN","RCD PEWL4",30, 0)
	14784	;
	14785	"RTN","RCD PEWL4",31, 0)
	14786	S DA(2)=R CSCR,DA(1) =RCTO
	14787	"RTN","RCD PEWL4",32, 0)
	14788	S DIC("DR ")=".02/// /0;.03//// "_$J(-RCAM T,"",2)
	14789	"RTN","RCD PEWL4",33, 0)
	14790	S DIC("DR ")=DIC("DR ")_";.04// //"_$S($P( RCFR0,U,2) '="":$P(RC FR0,U,2),R CREF'="":R CREF,1:"UN KNOWN")_"; .05////"_$ S($P($G(^R CY(344.49, RCSCR,1,RC TO1,0)),U, 2)'["**ADJ ":"1;.08// //0",1:0)_ ";.06////0 "_$S(RCCOM '="":";.09 ////"_RCCO M,1:"")
	14791	"RTN","RCD PEWL4",34, 0)
	14792	S DIC="^R CY(344.49, "_DA(2)_", 1,"_DA(1)_ ",1,"
	14793	"RTN","RCD PEWL4",35, 0)
	14794	S DLAYGO= 344.4911,D IC(0)="L", X=+$O(^RCY (344.49,RC SCR,1,RCTO ,1,"B","") ,-1)+1
	14795	"RTN","RCD PEWL4",36, 0)
	14796	D FILE^DI CN K DIC,D D,DO,DLAYG O
	14797	"RTN","RCD PEWL4",37, 0)
	14798	S RCY=+Y
	14799	"RTN","RCD PEWL4",38, 0)
	14800	;
	14801	"RTN","RCD PEWL4",39, 0)
	14802	I RCY'>0 D Q
	14803	"RTN","RCD PEWL4",40, 0)
	14804	. N DA
	14805	"RTN","RCD PEWL4",41, 0)
	14806	. S DA(2) =RCSCR,DA( 1)=RCFR,DA =RCY,DIK=" ^RCY(344.4 9,"_DA(2)_ ",1,"_DA(1 )_",1," D ^DIK
	14807	"RTN","RCD PEWL4",42, 0)
	14808	. S DIR(0 )="EA",DIR ("A",1)="P ROBLEM ADD ING ADJUST MENT - NO DISTRIBUTI ON PERFORM ED",DIR("A ")="PRESS RETURN TO CONTINUE " D ^DIR K DIR
	14809	"RTN","RCD PEWL4",43, 0)
	14810	;
	14811	"RTN","RCD PEWL4",44, 0)
	14812	S DA(1)=R CSCR,DA=RC FR,DIE="^R CY(344.49, "_DA(1)_", 1,",DR=".0 6////"_$J( $P(RCFR0,U ,6)+RCAMT, "",2)_";.0 8////"_$J( $P(RCFR0,U ,8)+RCAMT, "",2) D ^D IE
	14813	"RTN","RCD PEWL4",45, 0)
	14814	S DA=RCFR 1,DIE="^RC Y(344.49," _DA(1)_",1 ,",DR=".06 ////"_$J($ P(RCFR10,U ,6)+RCAMT, "",2) D ^D IE
	14815	"RTN","RCD PEWL4",46, 0)
	14816	S DA(1)=R CSCR,DA=RC TO,DIE="^R CY(344.49, "_DA(1)_", 1,",DR=".0 6////"_$J( $P(RCTO0,U ,6)-RCAMT, "",2)_";.0 3////"_$J( $P(RCTO0,U ,3)-RCAMT, "",2)_";.0 8////"_$J( $P(RCTO0,U ,8)-RCAMT, "",2) D ^D IE
	14817	"RTN","RCD PEWL4",47, 0)
	14818	S DA(1)=R CSCR,DA=RC TO1,DIE="^ RCY(344.49 ,"_DA(1)_" ,1,",DR=". 06////"_$J ($P(RCTO10 ,U,6)-RCAM T,"",2)_"; .03////"_$ J($P(RCTO1 0,U,3)-RCA MT,"",2)_" ;.08////"_ $J($P(RCTO 10,U,8)-RC AMT,"",2) D ^DIE
	14819	"RTN","RCD PEWL4",48, 0)
	14820	D BLD^RCD PEWL1($G(^ TMP($J,"RC _SORTPARM" )))
	14821	"RTN","RCD PEWL4",49, 0)
	14822	Q
	14823	"RTN","RCD PEWL4",50, 0)
	14824	;
	14825	"RTN","RCD PEWL4",51, 0)
	14826	NEWREC ; C reate a ne w receipt from scrat ch pad ent ry
	14827	"RTN","RCD PEWL4",52, 0)
	14828	N Z,Z0,RC OK,RCRECTD A,RCSTOP,D IR,X,Y,REC TDA,CT,DIE ,DA,DR,RCE R,RCPAYTY, RCHAC,RCDE P,DIC
	14829	"RTN","RCD PEWL4",53, 0)
	14830	D FULL^VA LM1
	14831	"RTN","RCD PEWL4",54, 0)
	14832	I $G(RCSC R("NOEDIT" ))=2 D NOT AV^RCDPEWL 2 G NEWREC Q
	14833	"RTN","RCD PEWL4",55, 0)
	14834	S (RCSTOP ,RCOK)=0,V ALMBCK="R"
	14835	"RTN","RCD PEWL4",56, 0)
	14836	S RECTDA= $P($G(^RCY (344.49,RC SCR,0)),U, 2)
	14837	"RTN","RCD PEWL4",57, 0)
	14838	I 'RECTDA S RECTDA= $P($G(^RCY (344.4,RCS CR,0)),U,8 )
	14839	"RTN","RCD PEWL4",58, 0)
	14840	; PRCA4. 5303 - Co rrected re ceipt numb er display to use RE CTDA in th e DIR("A", 1) variabl e
	14841	"RTN","RCD PEWL4",59, 0)
	14842	I RECTDA D G NEWRE CQ
	14843	"RTN","RCD PEWL4",60, 0)
	14844	. S DIR(0 )="EA",DIR ("A",1)="T HIS ERA AL READY HAS A RECEIPT - "_$P($G( ^RCY(344,R ECTDA,0)), U)_" - NO RECEIPT CR EATED",DIR ("A")="PRE SS RETURN TO CONTINU E" W ! D ^ DIR K DIR
	14845	"RTN","RCD PEWL4",61, 0)
	14846	S DIR("A" ,1)="THIS ACTION WIL L CREATE T HE RECEIPT FOR THIS ERA. ONCE THE RECEI PT IS",DIR ("A",2)=" CREATED HE RE, NO MOR E AUTOMATI C ADJUSTME NTS MAY BE MADE FOR THIS ERA." ,DIR("A",3 )=" "
	14847	"RTN","RCD PEWL4",62, 0)
	14848	S DIR("A" )="ARE YOU SURE YOU ARE READY TO CREATE THIS RECEI PT?: ",DIR ("B")="NO" ,DIR(0)="Y A"
	14849	"RTN","RCD PEWL4",63, 0)
	14850	W ! D ^DI R K DIR W !
	14851	"RTN","RCD PEWL4",64, 0)
	14852	I Y'=1 S DIR(0)="EA ",DIR("A") ="NO RECEI PT CREATED - PRESS R ETURN TO C ONTINUE" W ! D ^DIR K DIR G NE WRECQ
	14853	"RTN","RCD PEWL4",65, 0)
	14854	I $$HASAD J^RCDPEWL8 (RCSCR,.RC OK) D G N EWRECQ
	14855	"RTN","RCD PEWL4",66, 0)
	14856	. S DIR(0 )="EA",DIR ("A",1)="A T LEAST ON E LINE ITE M WAS FOUN D WITH A N EGATIVE PA YMENT AMOU NT",DIR("A ")="NO REC EIPT CAN B E CREATED - PRESS RE TURN TO CO NTINUE " D ^DIR K DI R S RCSTOP =1
	14857	"RTN","RCD PEWL4",67, 0)
	14858	I 'RCOK S DIR(0)="E A",DIR("A" )="NO RECE IPT CAN BE CREATED - NO POSTAB LE LINE IT EMS WERE F OUND" W ! D ^DIR K D IR G NEWRE CQ
	14859	"RTN","RCD PEWL4",68, 0)
	14860	;
	14861	"RTN","RCD PEWL4",69, 0)
	14862	S RCHAC=$ $HACERA^RC DPEU(RCSCR )
	14863	"RTN","RCD PEWL4",70, 0)
	14864	S RCPAYTY =$S(RCHAC: 8,$P($G(^R CY(344.4,+ RCSCR,5)), U,2)="":14 ,1:4)
	14865	"RTN","RCD PEWL4",71, 0)
	14866	S RCDEP=" "
	14867	"RTN","RCD PEWL4",72, 0)
	14868	I RCPAYTY =4 D
	14869	"RTN","RCD PEWL4",73, 0)
	14870	. N RCOK1
	14871	"RTN","RCD PEWL4",74, 0)
	14872	. F D Q :RCOK1
	14873	"RTN","RCD PEWL4",75, 0)
	14874	.. S RCOK 1=1
	14875	"RTN","RCD PEWL4",76, 0)
	14876	.. S DIC= "^RCY(344. 1,",DIC("S ")="I $P(^ (0),U,12)= 1",DIC(0)= "AEMQ" D ^ DIC
	14877	"RTN","RCD PEWL4",77, 0)
	14878	.. Q:Y'>0
	14879	"RTN","RCD PEWL4",78, 0)
	14880	.. S RCDE P=+Y
	14881	"RTN","RCD PEWL4",79, 0)
	14882	.. I RCDE P,$$TOOOLD ^RCDPEWLA( RCDEP) S R COK1=0,RCD EP=""
	14883	"RTN","RCD PEWL4",80, 0)
	14884	S RECTDA= $$BLDRCPT^ RCDPUREC(D T,+RCDEP_$ S(RCPAYTY= 4:"ERACHK" ,1:""),+$O (^RC(341.1 ,"AC",+RCP AYTY,0))) ; Note:ERA with pape r check is type 4, b ut receipt needs to start with an 'E'
	14885	"RTN","RCD PEWL4",81, 0)
	14886	I 'RECTDA W ! S DIR (0)="EA",D IR("A",1)= "A PROBLEM WAS ENCOU NTERED ADD ING THE RE CEIPT - NO RECEIPT A DDED",DIR( "A")="PRES S RETURN T O CONTINUE " W ! D ^D IR K DIR G NEWRECQ
	14887	"RTN","RCD PEWL4",82, 0)
	14888	;
	14889	"RTN","RCD PEWL4",83, 0)
	14890	D RCPTDET ^RCDPEM(RC SCR,RECTDA ,.RCER)
	14891	"RTN","RCD PEWL4",84, 0)
	14892	;
	14893	"RTN","RCD PEWL4",85, 0)
	14894	S DIE="^R CY(344.49, ",DA=RCSCR ,DR=".02// //"_RECTDA D ^DIE
	14895	"RTN","RCD PEWL4",86, 0)
	14896	S DIE="^R CY(344.4," ,DA=RCSCR, DR=".08/// /"_RECTDA D ^DIE
	14897	"RTN","RCD PEWL4",87, 0)
	14898	S Z=+$O(^ RCY(344.31 ,"AERA",RC SCR,0))
	14899	"RTN","RCD PEWL4",88, 0)
	14900	S DIE="^R CY(344,",D A=RECTDA,D R=".18//// "_RCSCR_$S (Z:";.17// //"_Z,1:"" )_$S(RCPAY TY=4:";.06 ////"_RCDE P,1:"")_$S ($P($G(^RC Y(344.31,Z ,0)),U,15) '="":";.16 ////"_$P(^ RCY(344.31 ,Z,0),U,15 ),1:"") D ^DIE
	14901	"RTN","RCD PEWL4",89, 0)
	14902	;
	14903	"RTN","RCD PEWL4",90, 0)
	14904	I $O(RCER (0)) D
	14905	"RTN","RCD PEWL4",91, 0)
	14906	. S CT=1, DIR(0)="EA ",DIR("A", 1)="THE FO LLOWING PR OBLEMS OCC URRED WHIL E ADDING T HE RECEIPT : "
	14907	"RTN","RCD PEWL4",92, 0)
	14908	. S Z=0 F S Z=$O(R CER(Z)) Q: 'Z S CT=C T+1,DIR("A ",CT)=RCER (Z)
	14909	"RTN","RCD PEWL4",93, 0)
	14910	. S DIR(" A")="PRESS RETURN TO CONTINUE "
	14911	"RTN","RCD PEWL4",94, 0)
	14912	. W ! D ^ DIR K DIR
	14913	"RTN","RCD PEWL4",95, 0)
	14914	;
	14915	"RTN","RCD PEWL4",96, 0)
	14916	S DIR(0)= "YA",DIR(" A")="DO YO U WANT TO GO TO RECE IPT PROCES SING NOW? ",DIR("A", 1)=" ",DIR ("A",2)="R ECEIPT "_$ P($G(^RCY( 344,+RECTD A,0)),U)_" HAS BEEN CREATED FO R THIS ERA ",DIR("B") ="YES" W ! D ^DIR K DIR
	14917	"RTN","RCD PEWL4",97, 0)
	14918	I Y=1 S R CRECTDA=RE CTDA D EN^ VALM("RCDP RECEIPT P ROFILE")
	14919	"RTN","RCD PEWL4",98, 0)
	14920	S RCSCR=0
	14921	"RTN","RCD PEWL4",99, 0)
	14922	S VALMBCK ="Q"
	14923	"RTN","RCD PEWL4",100 ,0)
	14924	;
	14925	"RTN","RCD PEWL4",101 ,0)
	14926	NEWRECQ Q
	14927	"RTN","RCD PEWL4",102 ,0)
	14928	;
	14929	"RTN","RCD PEWL4",103 ,0)
	14930	VRECPT ;EP - Protoco l action - RCDPE EOB WL RECEIP T VIEW
	14931	"RTN","RCD PEWL4",104 ,0)
	14932	; Preview receipt l ines
	14933	"RTN","RCD PEWL4",105 ,0)
	14934	; Assume RCSCR = ie n from fil e 344.49 ( and 344.4)
	14935	"RTN","RCD PEWL4",106 ,0)
	14936	N DIR,RCO K,RCZ,X,Y, Z,Z0
	14937	"RTN","RCD PEWL4",107 ,0)
	14938	D FULL^VA LM1
	14939	"RTN","RCD PEWL4",108 ,0)
	14940	S VALMBCK ="R"
	14941	"RTN","RCD PEWL4",109 ,0)
	14942	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	14943	"RTN","RCD PEWL4",110 ,0)
	14944	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	14945	"RTN","RCD PEWL4",111 ,0)
	14946	. D PAUSE ^VALM1
	14947	"RTN","RCD PEWL4",112 ,0)
	14948	I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D VR^RCDPEWL P(RCSCR) G VRECPTQ ; prca4. 5298 aut o-posted E RAs are ha ndled diff erently
	14949	"RTN","RCD PEWL4",113 ,0)
	14950	;
	14951	"RTN","RCD PEWL4",114 ,0)
	14952	;
	14953	"RTN","RCD PEWL4",115 ,0)
	14954	; prca4. 5298 per patch req uirements, keep code related t o creating /maintaini ng
	14955	"RTN","RCD PEWL4",116 ,0)
	14956	; batches but just remove fro m executio n.
	14957	"RTN","RCD PEWL4",117 ,0)
	14958	; I $G(^T MP("RCBATC H_SELECTED ",$J)) D N OBATCH^RCD PEWL Q
	14959	"RTN","RCD PEWL4",118 ,0)
	14960	;I $O(^RC Y(344.49,R CSCR,3,0)) D Q:'RCO K
	14961	"RTN","RCD PEWL4",119 ,0)
	14962	;. S RCOK =1
	14963	"RTN","RCD PEWL4",120 ,0)
	14964	;. S Z=0 F S Z=$O( ^RCY(344.4 9,RCSCR,3, Z)) Q:'Z I '$P($G(^ (Z,0)),U,3 ) S RCOK=0 Q
	14965	"RTN","RCD PEWL4",121 ,0)
	14966	;. I 'RCO K S DIR(0) ="EA",DIR( "A",1)="A RECEIPT CA NNOT BE PR EVIEWED UN TIL ALL BA TCHES FOR THIS ERA A RE MARKED AS",DIR("A ",2)="'REA DY TO POST '",DIR("A" )="PRESS R ETURN TO C ONTINUE " W ! D ^DIR K DIR
	14967	"RTN","RCD PEWL4",122 ,0)
	14968	; end of prca4.52 98
	14969	"RTN","RCD PEWL4",123 ,0)
	14970	S Z=0 F S Z=$O(^RC Y(344.49,R CSCR,1,Z)) Q:'Z I $ P(Z,".",2) S Z0=$G(^ (Z,0)) I $ P(Z0,U,6)< 0 S RCZ($P (Z0,U))=$P (Z0,U,2)_U _$P(Z0,U,6 )
	14971	"RTN","RCD PEWL4",124 ,0)
	14972	I $O(RCZ( ""))'="" D
	14973	"RTN","RCD PEWL4",125 ,0)
	14974	. W !,"TH E FOLLOWIN G LINES HA VE A NET P AYMENT LES S THAN 0. THESE LIN ES MUST HA VE",!,"THI S NEGATIVE AMOUNT DI STRIBUTED TO OTHER L INE(S) IN THE ERA BE FORE A",!, "RECEIPT C AN BE CREA TED."
	14975	"RTN","RCD PEWL4",126 ,0)
	14976	. S Z="" F S Z=$O( RCZ(Z)) Q: Z="" W !, $J("",5)_$ J(Z,10)_" "_$E($P(R CZ(Z),U)_$ J("",15),1 ,15)_" "_ $J(+$P(RCZ (Z),U,2)," ",2)
	14977	"RTN","RCD PEWL4",127 ,0)
	14978	. W !
	14979	"RTN","RCD PEWL4",128 ,0)
	14980	. S DIR(0 )="E" D ^D IR K DIR
	14981	"RTN","RCD PEWL4",129 ,0)
	14982	;
	14983	"RTN","RCD PEWL4",130 ,0)
	14984	D EN^VALM ("RCDPE EO B RECEIPT PREVIEW")
	14985	"RTN","RCD PEWL4",131 ,0)
	14986	VRECPTQ ;
	14987	"RTN","RCD PEWL4",132 ,0)
	14988	S VALMBCK =$S('$G(RC SCR):"Q",1 :"R")
	14989	"RTN","RCD PEWL4",133 ,0)
	14990	Q
	14991	"RTN","RCD PEWL4",134 ,0)
	14992	;
	14993	"RTN","RCD PEWL4",135 ,0)
	14994	; PRCA4. 5303 - Re ceipt Proc essing
	14995	"RTN","RCD PEWL4",136 ,0)
	14996	RECPROC ;E P - Protoc ol action - RCDPE E ON WORKLIS T RECEIPT PROCESSING
	14997	"RTN","RCD PEWL4",137 ,0)
	14998	; Receipt Processin g
	14999	"RTN","RCD PEWL4",138 ,0)
	15000	; Called by RCDPE E OB WORKLIS T RECEIPT PROCESSING protocol
	15001	"RTN","RCD PEWL4",139 ,0)
	15002	; Assume RCSCR is t he IEN fro m file 344 .49 (and 3 44.4)
	15003	"RTN","RCD PEWL4",140 ,0)
	15004	; Variabl e RCRECTDA is needed by RECEIP T PROFILE so is not newed
	15005	"RTN","RCD PEWL4",141 ,0)
	15006	; Variabl e RCDPFXIT is used b y RCDPLPLM for immed iate exit so newed i t here so that does not happen
	15007	"RTN","RCD PEWL4",142 ,0)
	15008	;
	15009	"RTN","RCD PEWL4",143 ,0)
	15010	N ARRAY,R ECIEN,RECE IPT,CNT,DI R,X,Y,DTOU T,DUOUT,DR OUT,DIRUT, I,LIST,RCD PFXIT
	15011	"RTN","RCD PEWL4",144 ,0)
	15012	D FULL^VA LM1
	15013	"RTN","RCD PEWL4",145 ,0)
	15014	S VALMBCK ="R"
	15015	"RTN","RCD PEWL4",146 ,0)
	15016	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	15017	"RTN","RCD PEWL4",147 ,0)
	15018	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	15019	"RTN","RCD PEWL4",148 ,0)
	15020	. D PAUSE ^VALM1
	15021	"RTN","RCD PEWL4",149 ,0)
	15022	;
	15023	"RTN","RCD PEWL4",150 ,0)
	15024	; Get lis t of recei pts from t he ERA det ail multip le
	15025	"RTN","RCD PEWL4",151 ,0)
	15026	S RECIEN= 0,CNT=0
	15027	"RTN","RCD PEWL4",152 ,0)
	15028	F S RECI EN=$O(^RCY (344.4,RCS CR,1,"RECE IPT",RECIE N)) Q:'REC IEN D
	15029	"RTN","RCD PEWL4",153 ,0)
	15030	. S RECEI PT=$P($G(^ RCY(344,RE CIEN,0)),U )
	15031	"RTN","RCD PEWL4",154 ,0)
	15032	. I RECEI PT]"" S CN T=CNT+1,AR RAY(CNT)=R ECEIPT_"^" _RECIEN
	15033	"RTN","RCD PEWL4",155 ,0)
	15034	;
	15035	"RTN","RCD PEWL4",156 ,0)
	15036	; The arr ay of rece ipts does not exist, this coul d be a non auto-post ed ERA; so only 1 re ceipt will be assign ed; retrie ve at 344. 4, .08
	15037	"RTN","RCD PEWL4",157 ,0)
	15038	I '$D(ARR AY),$$GET1 ^DIQ(344.4 ,RCSCR_"," ,.08)'="" S CNT=1,AR RAY(1)=$$G ET1^DIQ(34 4.4,RCSCR_ ",",.08,"E ")_"^"_$$G ET1^DIQ(34 4.4,RCSCR_ ",",.08,"I ")
	15039	"RTN","RCD PEWL4",158 ,0)
	15040	;
	15041	"RTN","RCD PEWL4",159 ,0)
	15042	; No rece ipt - disp lay mesage and quit
	15043	"RTN","RCD PEWL4",160 ,0)
	15044	I CNT=0 K DIR S DIR ("A",1)="N o receipts exist for this ERA. " G RECPRO CQ
	15045	"RTN","RCD PEWL4",161 ,0)
	15046	;
	15047	"RTN","RCD PEWL4",162 ,0)
	15048	; One rec eipt - Use it
	15049	"RTN","RCD PEWL4",163 ,0)
	15050	I CNT=1 S RCRECTDA= $P(ARRAY(1 ),U,2) G R ECPROC1
	15051	"RTN","RCD PEWL4",164 ,0)
	15052	;
	15053	"RTN","RCD PEWL4",165 ,0)
	15054	; Multipl e receipts - User ne eds to sel ect
	15055	"RTN","RCD PEWL4",166 ,0)
	15056	W !
	15057	"RTN","RCD PEWL4",167 ,0)
	15058	S LIST=""
	15059	"RTN","RCD PEWL4",168 ,0)
	15060	F I=1:1:C NT S LIST= LIST_$S(LI ST]"":";", 1:"")_I_": "_$P(ARRAY (I),U,1)
	15061	"RTN","RCD PEWL4",169 ,0)
	15062	S DIR(0)= "SO^"_LIST ,DIR("A")= "Select Re ceipt"
	15063	"RTN","RCD PEWL4",170 ,0)
	15064	D ^DIR
	15065	"RTN","RCD PEWL4",171 ,0)
	15066	I Y<1!(Y> CNT) K DIR S DIR("A" ,1)="No se lection ma de" G RECP ROCQ
	15067	"RTN","RCD PEWL4",172 ,0)
	15068	S RCRECTD A=$P(ARRAY (Y),U,2)
	15069	"RTN","RCD PEWL4",173 ,0)
	15070	RECPROC1 ;
	15071	"RTN","RCD PEWL4",174 ,0)
	15072	D EN^VALM ("RCDP REC EIPT PROFI LE")
	15073	"RTN","RCD PEWL4",175 ,0)
	15074	; If RCDP FXIT is se t, exit op tion entir ely was se lected so quit back to the men u
	15075	"RTN","RCD PEWL4",176 ,0)
	15076	I $G(RCDP FXIT) S VA LMBCK="Q"
	15077	"RTN","RCD PEWL4",177 ,0)
	15078	Q
	15079	"RTN","RCD PEWL4",178 ,0)
	15080	;
	15081	"RTN","RCD PEWL4",179 ,0)
	15082	RECPROCQ ;
	15083	"RTN","RCD PEWL4",180 ,0)
	15084	; Display the messa ge in DIR( "A",1) and then pres s enter
	15085	"RTN","RCD PEWL4",181 ,0)
	15086	S DIR(0)= "EA",DIR(" A")="Press ENTER to continue: "
	15087	"RTN","RCD PEWL4",182 ,0)
	15088	W ! D ^DI R K DIR
	15089	"RTN","RCD PEWL4",183 ,0)
	15090	Q
	15091	"RTN","RCD PEWL6")
	15092	0^20^B8555 1309^B8181 5547
	15093	"RTN","RCD PEWL6",1,0 )
	15094	RCDPEWL6 ; ALB/TMK/KM L - ELECTR ONIC EOB W ORKLIST AC TIONS ;Jun 06, 2014@ 19:11:19
	15095	"RTN","RCD PEWL6",2,0 )
	15096	;;4.5;Acc ounts Rece ivable;1 73,208,222 ,276,298,3 03,318;M ar 20, 199 5;Build 25
	15097	"RTN","RCD PEWL6",3,0 )
	15098	;;Per VA Directive 6402, this routine s hould not be modifie d.
	15099	"RTN","RCD PEWL6",4,0 )
	15100	Q
	15101	"RTN","RCD PEWL6",5,0 )
	15102	;
	15103	"RTN","RCD PEWL6",6,0 )
	15104	DISTADJ ;E P - Protoc ol action - RCDPE EO B WORKLIST DIST ADJ
	15105	"RTN","RCD PEWL6",7,0 )
	15106	; Distrib ute an adj ustment th at retract s a paymen t to other bill(s)
	15107	"RTN","RCD PEWL6",8,0 )
	15108	; NOTE: R CSCR is as sumed to b e the IEN of the ERA entry in file 344.4 9
	15109	"RTN","RCD PEWL6",9,0 )
	15110	N RCDA,RC DA1,RCAMT, RCADJ,RCQU IT,Z,Z0,Z1 ,DIR,X,Y,C T,RCZ,RCZ1 ,RCZ2,RCAD JOK,TOT,DT OUT,DUOUT
	15111	"RTN","RCD PEWL6",10, 0)
	15112	N RCNONSP ,RCACTIVE, RCZZ1,RCZZ 2,RCADJSTR ; prca27 6 - variab les used t o establis h non-spec ific payme nt adjustm ents and A R BILL cla im status (fix to ne gative cla im balance issue)
	15113	"RTN","RCD PEWL6",11, 0)
	15114	D FULL^VA LM1
	15115	"RTN","RCD PEWL6",12, 0)
	15116	I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D NOEDIT^RCD PEWLP G DI STQ ;prc a4.5298 auto-post ed ERAs ca nnot enter dISTRIBUT E ADJ AMTS action
	15117	"RTN","RCD PEWL6",13, 0)
	15118	I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL G DISTQ
	15119	"RTN","RCD PEWL6",14, 0)
	15120	I $G(^TMP ("RCBATCH_ SELECTED", $J)) D NOB ATCH^RCDPE WL G DISTQ
	15121	"RTN","RCD PEWL6",15, 0)
	15122	;
	15123	"RTN","RCD PEWL6",16, 0)
	15124	S Z=0,RCA DJOK="" F S Z=$O(^T MP("RCDPE- EOB_WLDX", $J,Z)) Q:' Z S Z1=+$ P($G(^(Z)) ,U,2),Z0=$ G(^RCY(344 .49,RCSCR, 1,Z1,0)) D
	15125	"RTN","RCD PEWL6",17, 0)
	15126	. I $P(Z0 ,U)'["." S RCADJOK=( $P(Z0,U,2) ["**ADJ") Q
	15127	"RTN","RCD PEWL6",18, 0)
	15128	. I '$P(Z 0,U,7),'RC ADJOK Q ; Suspense item canno t be used to adjust
	15129	"RTN","RCD PEWL6",19, 0)
	15130	. I $P(Z0 ,U,6)<0 S RCZ(Z)=$P( Z0,U,6)_U_ Z1 Q
	15131	"RTN","RCD PEWL6",20, 0)
	15132	. I $P(Z0 ,U,6)>0 D Q
	15133	"RTN","RCD PEWL6",21, 0)
	15134	.. N Q,ON HLD,IBA
	15135	"RTN","RCD PEWL6",22, 0)
	15136	.. S ONHL D=0
	15137	"RTN","RCD PEWL6",23, 0)
	15138	.. I $P(Z 0,U,7) I $ $IB^IBRUTL (+$P(Z0,U, 7),1) S Q= 0 F S Q=$ O(IBA(Q)) Q:'Q I $P ($G(^IB(+I BA(Q),0)), U,5)=8 S O NHLD=1 Q
	15139	"RTN","RCD PEWL6",24, 0)
	15140	.. S RCZ1 (+$P(Z0,U, 6),Z)=Z1_U _ONHLD,RCZ 2(Z)=Z1_U_ $P(Z0,U,6) _U_ONHLD Q
	15141	"RTN","RCD PEWL6",25, 0)
	15142	;
	15143	"RTN","RCD PEWL6",26, 0)
	15144	I $O(RCZ( 0))="" D G DISTQ
	15145	"RTN","RCD PEWL6",27, 0)
	15146	. S DIR(0 )="EA",DIR ("A",1)="N O LINES EX IST NEEDIN G ADJUSTME NT DISTRIB UTION",DIR ("A")="PRE SS RETURN TO CONTINU E" W ! D ^ DIR K DIR
	15147	"RTN","RCD PEWL6",28, 0)
	15148	;
	15149	"RTN","RCD PEWL6",29, 0)
	15150	I $O(RCZ1 (0))="" D G DISTQ
	15151	"RTN","RCD PEWL6",30, 0)
	15152	. S DIR(0 )="EA",DIR ("A",1)="N O VALID LI NES EXIST ON THIS ER A WHERE A DISTRIBUTI ON CAN BE MADE",DIR( "A",2)=$$W HAT(RCSCR) ,DIR("A")= "PRESS RET URN TO CON TINUE" W ! D ^DIR K DIR
	15153	"RTN","RCD PEWL6",31, 0)
	15154	;
	15155	"RTN","RCD PEWL6",32, 0)
	15156	S RCQUIT= 0
	15157	"RTN","RCD PEWL6",33, 0)
	15158	F S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE THAT NEED S AN ADJUS TMENT AMOU NT DISTRIB UTED: " D Q:RCQUIT
	15159	"RTN","RCD PEWL6",34, 0)
	15160	. S DIR(" ?",1)="THE FOLLOWING LINE(S) H AVE AN ADJ USTMENT TH AT CAUSED A NEGATIVE NET PAYME NT.",DIR(" ?",2)="IN ORDER TO B ALANCE THE RECEIPT A ND THE DEP OSIT, THES E AMOUNTS WILL NEED TO",DIR("? ",3)=" BE DISTRIBUT ED TO OTHE R LINE(S)" ,CT=3
	15161	"RTN","RCD PEWL6",35, 0)
	15162	. S Z=0
	15163	"RTN","RCD PEWL6",36, 0)
	15164	. F S Z= $O(RCZ(Z)) Q:'Z S C T=CT+1,DIR ("?",CT)=" "_$J(Z,8 )_" "_$J( $P(RCZ(Z), U),15,2)
	15165	"RTN","RCD PEWL6",37, 0)
	15166	. S DIR(" ?")=" "
	15167	"RTN","RCD PEWL6",38, 0)
	15168	. I $O(RC Z(0))=$O(R CZ(""),-1) S DIR("B" )=$O(RCZ(0 ))
	15169	"RTN","RCD PEWL6",39, 0)
	15170	. W ! D ^ DIR K DIR
	15171	"RTN","RCD PEWL6",40, 0)
	15172	. I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA="" Q
	15173	"RTN","RCD PEWL6",41, 0)
	15174	. I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
	15175	"RTN","RCD PEWL6",42, 0)
	15176	. I '$D(R CZ(Y)) D Q:Y=""
	15177	"RTN","RCD PEWL6",43, 0)
	15178	.. I Y'[" .",$D(RCZ( Y_".001")) ,$O(RCZ(Y+ 1),-1)=(Y_ ".001") S Y=Y_".001" Q
	15179	"RTN","RCD PEWL6",44, 0)
	15180	.. W !,$S (Y["."!($O (RCZ(Y))\1 '=(Y\1)):" THIS LINE DOESN'T NE ED AN ADJU STMENT DIS TRIBUTION" ,1:"PLEASE ENTER THE ENTIRE LI NE # (Such as: 1.001 )") W !
	15181	"RTN","RCD PEWL6",45, 0)
	15182	.. S Y=""
	15183	"RTN","RCD PEWL6",46, 0)
	15184	. W !," LINE #: "_ +Y_" AMOU NT NEEDED TO DISTRIB UTE: "_$J( +RCZ(Y),"" ,2),!
	15185	"RTN","RCD PEWL6",47, 0)
	15186	. ; RCDA = the ien of the lin e in file 344.491
	15187	"RTN","RCD PEWL6",48, 0)
	15188	. ; RCDA( 1) = the l ine # RCDA(2) = the amo unt to be adjusted ( +)
	15189	"RTN","RCD PEWL6",49, 0)
	15190	. S RCDA= $P(RCZ(Y), U,2),RCDA( 1)=Y,RCQUI T=1,RCDA(2 )=-$P(RCZ( Y),U)
	15191	"RTN","RCD PEWL6",50, 0)
	15192	;
	15193	"RTN","RCD PEWL6",51, 0)
	15194	G:$G(RCDA )="" DISTQ
	15195	"RTN","RCD PEWL6",52, 0)
	15196	;
	15197	"RTN","RCD PEWL6",53, 0)
	15198	S RCQUIT= 0
	15199	"RTN","RCD PEWL6",54, 0)
	15200	;
	15201	"RTN","RCD PEWL6",55, 0)
	15202	; PRCA4. 5303 - Ma y miss if multiple a mounts are equal, ch anged calc ulation to use RCZ2 instead of RCZ1
	15203	"RTN","RCD PEWL6",56, 0)
	15204	; Old cod e: S (TOT, Z)=0 F S Z=$O(RCZ1( Z)) Q:'Z S TOT=TOT+ Z
	15205	"RTN","RCD PEWL6",57, 0)
	15206	S (TOT,Z) =0 F S Z= $O(RCZ2(Z) ) Q:'Z S TOT=TOT+$P (RCZ2(Z),U ,2)
	15207	"RTN","RCD PEWL6",58, 0)
	15208	I TOT<RCD A(2) D G DISTQ
	15209	"RTN","RCD PEWL6",59, 0)
	15210	. S DIR(0 )="EA",DIR ("A",1)="T HE ERA DOE S NOT HAVE ENOUGH VA LID PAYMEN TS TO OFFS ET THIS DI STRIBUTION ",DIR("A", 2)=$$WHAT( RCSCR),DIR ("A")="PRE SS RETURN TO CONTINU E" W ! D ^ DIR K DIR
	15211	"RTN","RCD PEWL6",60, 0)
	15212	F S DIR( 0)="NA^1:9 999:3",DIR ("A")="SEL ECT A LINE TO DISTRI BUTE THE A DJUSTMENT AMOUNT TO: " D Q:RC QUIT
	15213	"RTN","RCD PEWL6",61, 0)
	15214	. S DIR(" ?",1)="THE FOLLOWING LINE(S) H AVE A NET PAYMENT TH AT CAN BE USED TO OF FSET THE", DIR("?",2) =" NEGATI VE NET PAY MENT FOR L INE "_RCDA (1)_" ("_$ J(+$P(RCZ( RCDA(1)),U ),"",2)_") :",CT=2
	15215	"RTN","RCD PEWL6",62, 0)
	15216	. S Z="" F S Z=$O( RCZ1(Z),-1 ) Q:'Z S Z0=0 F S Z0=$O(RCZ1 (Z,Z0)) Q: 'Z0 S CT= CT+1,DIR(" ?",CT)=" "_$J(Z0,8) _" "_$J(+ Z,15,2)_$S ($P(RCZ1(Z ,Z0),U,2): " On hold exists",1: "")
	15217	"RTN","RCD PEWL6",63, 0)
	15218	. S DIR(" ?")=" "
	15219	"RTN","RCD PEWL6",64, 0)
	15220	. I $O(RC Z2(0))=$O( RCZ2(""),- 1) S DIR(" B")=$O(RCZ 2(0))
	15221	"RTN","RCD PEWL6",65, 0)
	15222	. W ! D ^ DIR K DIR
	15223	"RTN","RCD PEWL6",66, 0)
	15224	. I $D(DU OUT)!$D(DT OUT)!(Y="" ) S RCQUIT =1,RCDA1=" " Q
	15225	"RTN","RCD PEWL6",67, 0)
	15226	. I '$D(^ TMP("RCDPE -EOB_WLDX" ,$J,Y)) W !,"THIS LI NE DOES NO T EXIST FO R THIS ERA " W ! Q
	15227	"RTN","RCD PEWL6",68, 0)
	15228	. I '$D(R CZ2(Y)) D Q:Y=""
	15229	"RTN","RCD PEWL6",69, 0)
	15230	.. I Y'[" .",$D(RCZ2 (Y_".001") ),$O(RCZ2( Y+1),-1)=( Y_".001") S Y=Y_".00 1" Q
	15231	"RTN","RCD PEWL6",70, 0)
	15232	.. I Y'[" .",$O(RCZ2 (Y))\1'=Y S Y=Y_"."
	15233	"RTN","RCD PEWL6",71, 0)
	15234	.. W !,$S (Y[".":"TH IS LINE CA NNOT BE US ED FOR AN ADJUSTMENT DISTRIBUT ION",1:"PL EASE ENTER THE ENTIR E LINE # ( Such as: 1 .001)") W !
	15235	"RTN","RCD PEWL6",72, 0)
	15236	.. S Y=""
	15237	"RTN","RCD PEWL6",73, 0)
	15238	. ; prca2 76 - next few lines represent the a fix to prevent distribut ions again s collecte d/closed c laims (cla im balance = zero do llars)
	15239	"RTN","RCD PEWL6",74, 0)
	15240	. ;distri butions sh ould only occur on l ine items that have specific p ayments ag ainst acti ve claims
	15241	"RTN","RCD PEWL6",75, 0)
	15242	. S RCZZ1 =$P(^TMP(" RCDPE-EOB_ WLDX",$J,Y ),U,2) ; g et line it em sequenc e # off th e VIEW ord er before accessing the scratc hpad
	15243	"RTN","RCD PEWL6",76, 0)
	15244	. S (RCZZ 2,RCNONSP) =0 F S RC ZZ2=$O(^RC Y(344.49,R CSCR,1,RCZ Z1,1,RCZZ2 )) Q:'RCZZ 2 Q:RCNON SP S RCAD JSTR=$G(^( RCZZ2,0)) S RCNONSP= $S($P(RCAD JSTR,U,2)= 3:1,$P(RCA DJSTR,U,2) =5:1,1:0) ;identi fy if non- specific p ayment adj ustments e xist
	15245	"RTN","RCD PEWL6",77, 0)
	15246	. ; do no t evaluate claim sta tus for no n-specific payment a djustments
	15247	"RTN","RCD PEWL6",78, 0)
	15248	. I 'RCNO NSP D Q:' RCACTIVE
	15249	"RTN","RCD PEWL6",79, 0)
	15250	. . S RCA CTIVE=$$GE T1^DIQ(430 ,$P(^RCY(3 44.49,RCSC R,1,RCZZ1, 0),U,7),8)
	15251	"RTN","RCD PEWL6",80, 0)
	15252	. . I (RC ACTIVE'="A CTIVE")&(R CACTIVE'=" OPEN") S R CACTIVE=0 W !,"THIS IS NOT AN ACTIVE BIL L !",!,"CA NNOT PERFO RM DISTRIB UTION TO T HIS CLAIM" ,! Q
	15253	"RTN","RCD PEWL6",81, 0)
	15254	. . S RCA CTIVE=1
	15255	"RTN","RCD PEWL6",82, 0)
	15256	. I $P(RC Z2(Y),U,3) W !,"Warn ing - on-h old exists for this claim",!
	15257	"RTN","RCD PEWL6",83, 0)
	15258	. W !," LINE #: "_ +Y_" LINE BALANCE: "_$J(+$P(R CZ2(Y),U,2 ),"",2),!
	15259	"RTN","RCD PEWL6",84, 0)
	15260	. ; RCDA1 = the ien of the li ne in file 344.491
	15261	"RTN","RCD PEWL6",85, 0)
	15262	. ; RCDA1 (1) = the line # in the displa y
	15263	"RTN","RCD PEWL6",86, 0)
	15264	. S RCDA1 (1)=Y,RCDA 1=+$G(RCZ2 (Y)),RCQUI T=1
	15265	"RTN","RCD PEWL6",87, 0)
	15266	. S Z=$O( ^RCY(344.4 9,RCSCR,1, "B",RCDA1( 1)\1,0))
	15267	"RTN","RCD PEWL6",88, 0)
	15268	. S RCADJ =0
	15269	"RTN","RCD PEWL6",89, 0)
	15270	. I $P($G (^RCY(344. 49,RCSCR,1 ,Z,0)),U,2 )["**ADJ" S RCADJ=1 W !,"THE L INE SELECT ED IS AN A DDITIONAL PAYMENT LI NE, NOT SP ECIFIC TO A CLAIM",! ,"THE AMT WILL BE DI STRIBUTED, BUT A DEC REASE ADJU STMENT WIL L NOT BE P ERFORMED", !
	15271	"RTN","RCD PEWL6",90, 0)
	15272	;
	15273	"RTN","RCD PEWL6",91, 0)
	15274	G:'$G(RCD A1) DISTQ
	15275	"RTN","RCD PEWL6",92, 0)
	15276	;
	15277	"RTN","RCD PEWL6",93, 0)
	15278	S DIR("B" )=$S(RCDA( 2)<$P(RCZ2 (RCDA1(1)) ,U,2):$J(R CDA(2),"", 2),1:$J($P (RCZ2(+RCD A1(1)),U,2 ),"",2))
	15279	"RTN","RCD PEWL6",94, 0)
	15280	S DIR(0)= "NA^.01:"_ DIR("B")_" :2",DIR("A ")="ADJUST MENT AMOUN T TO DISTR IBUTE: "
	15281	"RTN","RCD PEWL6",95, 0)
	15282	S DIR("?" ,1)="THIS IS THE AMO UNT OF THE ADJUSTMEN T THAT SHO ULD BE APP LIED TO TH IS",DIR("? ")="PAYMEN T LINE. T HE AMT ENT ERED MUST BE BETWEEN .01 AND " _$J(DIR("B "),"",2)
	15283	"RTN","RCD PEWL6",96, 0)
	15284	D ^DIR K DIR
	15285	"RTN","RCD PEWL6",97, 0)
	15286	;
	15287	"RTN","RCD PEWL6",98, 0)
	15288	I $D(DUOU T)!$D(DTOU T)!'Y D G DISTQ
	15289	"RTN","RCD PEWL6",99, 0)
	15290	. S DIR(0 )="EA",DIR ("A",1)="N O AMOUNT W AS ENTERED - TRY AGA IN LATER", DIR("A")=" PRESS RETU RN TO CONT INUE " D ^ DIR K DIR
	15291	"RTN","RCD PEWL6",100 ,0)
	15292	S RCAMT=$ J(Y,"",2)
	15293	"RTN","RCD PEWL6",101 ,0)
	15294	;
	15295	"RTN","RCD PEWL6",102 ,0)
	15296	D ^DIR K DIR
	15297	"RTN","RCD PEWL6",103 ,0)
	15298	I $D(DUOU T)!$D(DTOU T) D G DI STQ
	15299	"RTN","RCD PEWL6",104 ,0)
	15300	. S DIR(0 )="EA",DIR ("A")="USE R ABORT - PRESS RETU RN TO CONT INUE " D ^ DIR K DIR
	15301	"RTN","RCD PEWL6",105 ,0)
	15302	;
	15303	"RTN","RCD PEWL6",106 ,0)
	15304	S Y=""
	15305	"RTN","RCD PEWL6",107 ,0)
	15306	I 'RCADJ D G:'$D(R CDA) DISTQ
	15307	"RTN","RCD PEWL6",108 ,0)
	15308	. N Z,RCA
	15309	"RTN","RCD PEWL6",109 ,0)
	15310	. S RCA=0 ,Z1=+$P($G (^TMP("RCD PE-EOB_WLD X",$J,RCDA (1)\1)),U, 2),Z=$G(^R CY(344.49, RCSCR,1,Z1 ,0)),RCA(" #")=+$P($P (Z,U,2),"* *ADJ",2)
	15311	"RTN","RCD PEWL6",110 ,0)
	15312	. I $P(Z, U,2)["**AD J" D
	15313	"RTN","RCD PEWL6",111 ,0)
	15314	.. S RCA= 1
	15315	"RTN","RCD PEWL6",112 ,0)
	15316	.. S RCA( "REF")=$S( RCA("#"):$ P($G(^RCY( 344.4,RCSC R,2,RCA("# "),0)),U), 1:$P(Z,U,9 ))
	15317	"RTN","RCD PEWL6",113 ,0)
	15318	. S Z=$S( RCA:RCA("# "),1:$G(^R CY(344.49, RCSCR,1,RC DA,0)))
	15319	"RTN","RCD PEWL6",114 ,0)
	15320	. S DIR(0 )="FAO^1:6 0",DIR("A" )=" > ",D IR("A",1)= "DECREASE ADJ COMMEN T (1-60 CH ARACTERS): "
	15321	"RTN","RCD PEWL6",115 ,0)
	15322	. S DIR(" B")="RETRA CTED FOR "
	15323	"RTN","RCD PEWL6",116 ,0)
	15324	. S DIR(" B")=DIR("B ")_$S(RCA: "ERA ADJ # "_Z_" Ref: "_RCA("RE F"),1:"CLA IM "_$S($P (Z,U,2)'=" ":$P(Z,U,2 ),1:"UNKNO WN"))
	15325	"RTN","RCD PEWL6",117 ,0)
	15326	. I $L(DI R("B"))>60 S DIR("B" )=$E(DIR(" B"),1,60)
	15327	"RTN","RCD PEWL6",118 ,0)
	15328	. D ^DIR K DIR
	15329	"RTN","RCD PEWL6",119 ,0)
	15330	. ;
	15331	"RTN","RCD PEWL6",120 ,0)
	15332	. I $D(DU OUT)!$D(DT OUT) D Q
	15333	"RTN","RCD PEWL6",121 ,0)
	15334	.. K RCDA
	15335	"RTN","RCD PEWL6",122 ,0)
	15336	.. S DIR( 0)="EA",DI R("A")="US ER ABORT - PRESS RET URN TO CON TINUE " D ^DIR K DIR
	15337	"RTN","RCD PEWL6",123 ,0)
	15338	;
	15339	"RTN","RCD PEWL6",124 ,0)
	15340	D DISTADJ ^RCDPEWL4( RCDA,RCDA1 ,RCAMT,Y)
	15341	"RTN","RCD PEWL6",125 ,0)
	15342	;
	15343	"RTN","RCD PEWL6",126 ,0)
	15344	DISTQ S VA LMBCK="R"
	15345	"RTN","RCD PEWL6",127 ,0)
	15346	Q
	15347	"RTN","RCD PEWL6",128 ,0)
	15348	;
	15349	"RTN","RCD PEWL6",129 ,0)
	15350	REFRESH ;E P - Protoc ol action - RCDPE EO B WORKLIST REFRESH
	15351	"RTN","RCD PEWL6",130 ,0)
	15352	; Refresh the entry in file 3 44.49 to r emove all user adjus tments
	15353	"RTN","RCD PEWL6",131 ,0)
	15354	N DA,DIK, DIR,RCQUIT ,RCREDEF,X ,Y,Z,Z0
	15355	"RTN","RCD PEWL6",132 ,0)
	15356	D FULL^VA LM1
	15357	"RTN","RCD PEWL6",133 ,0)
	15358	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	15359	"RTN","RCD PEWL6",134 ,0)
	15360	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	15361	"RTN","RCD PEWL6",135 ,0)
	15362	. D PAUSE ^VALM1
	15363	"RTN","RCD PEWL6",136 ,0)
	15364	. S VALMB CK="R"
	15365	"RTN","RCD PEWL6",137 ,0)
	15366	I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D NOEDIT^RCD PEWLP G RE FQ ;prca 4.5298 auto-poste d ERAs can not enter REFRESH SC RATCHPAD a ction
	15367	"RTN","RCD PEWL6",138 ,0)
	15368	I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL G REFQ
	15369	"RTN","RCD PEWL6",139 ,0)
	15370	; prca4. 5298 per patch req uirements, keep code related t o creating /maintaini ng
	15371	"RTN","RCD PEWL6",140 ,0)
	15372	; batches but just remove fro m executio n
	15373	"RTN","RCD PEWL6",141 ,0)
	15374	;I $G(^TM P("RCBATCH _SELECTED" ,$J)) D NO BATCH^RCDP EWL G REFQ ;prca4. 5298
	15375	"RTN","RCD PEWL6",142 ,0)
	15376	S DIR(0)= "YA"
	15377	"RTN","RCD PEWL6",143 ,0)
	15378	S DIR("A" ,1)="THIS ACTION WIL L DELETE A ND REBUILD THIS EEOB WORKLIST SCRATCH PA D ENTRY",D IR("A",2)= "ALL EDITS /SPLITS/DI STRIBUTE A DJUSTMENTS ENTERED F OR THIS ER A WILL BE ERASED"
	15379	"RTN","RCD PEWL6",144 ,0)
	15380	S DIR("A" ,3)="AND A LL ENTRIES MARKED AS MANUALLY VERIFIED W ILL BE UNM ARKED",DIR ("A",4)=" "
	15381	"RTN","RCD PEWL6",145 ,0)
	15382	S DIR("A" )="ARE YOU SURE YOU WANT TO DO THIS?: "
	15383	"RTN","RCD PEWL6",146 ,0)
	15384	W ! D ^DI R K DIR
	15385	"RTN","RCD PEWL6",147 ,0)
	15386	I Y'=1 G REFQ
	15387	"RTN","RCD PEWL6",148 ,0)
	15388	; prca4. 5298 per patch req uirements, keep code related t o creating /maintaini ng
	15389	"RTN","RCD PEWL6",149 ,0)
	15390	; batches but just remove fro m executio n
	15391	"RTN","RCD PEWL6",150 ,0)
	15392	;I $O(^RC Y(344.49,R CSCR,3,0)) S RCQUIT= 0 D I RCQ UIT G REFQ
	15393	"RTN","RCD PEWL6",151 ,0)
	15394	;. S DIR( 0)="YA",DI R("A")="DO YOU WANT TO REDEFIN E YOUR BAT CHES TOO?: ",DIR("B" )="NO" W ! D ^DIR K DIR
	15395	"RTN","RCD PEWL6",152 ,0)
	15396	;. I $D(D TOUT)!$D(D UOUT) S RC QUIT=1 Q
	15397	"RTN","RCD PEWL6",153 ,0)
	15398	;. S RCRE DEF=+Y
	15399	"RTN","RCD PEWL6",154 ,0)
	15400	;. K ^TMP ($J,"BATCH ES")
	15401	"RTN","RCD PEWL6",155 ,0)
	15402	;. S Z=0 F S Z=$O( ^RCY(344.4 9,RCSCR,3, Z)) Q:'Z S Z0=$G(^( Z,0)) D
	15403	"RTN","RCD PEWL6",156 ,0)
	15404	;.. I RCR EDEF S DA= Z,DA(1)=RC SCR,DIK="^ RCY(344.49 ,"_DA(1)_" ,3," D ^DI K Q
	15405	"RTN","RCD PEWL6",157 ,0)
	15406	;.. S ^TM P($J,"BATC HES",+$P(Z 0,U,6),$P( Z0,U,7))=+ Z0_U_$P(Z0 ,U,8)
	15407	"RTN","RCD PEWL6",158 ,0)
	15408	;. I 'RCR EDEF S ^TM P($J,"BATC HES")=+$O( ^TMP($J,"B ATCHES",0) )
	15409	"RTN","RCD PEWL6",159 ,0)
	15410	;. I RCRE DEF D SETB ATCH^RCDPE WLB(RCSCR)
	15411	"RTN","RCD PEWL6",160 ,0)
	15412	D ADDLINE S^RCDPEWLA (RCSCR)
	15413	"RTN","RCD PEWL6",161 ,0)
	15414	D BLD^RCD PEWL1($G(^ TMP($J,"RC _SORTPARM" )))
	15415	"RTN","RCD PEWL6",162 ,0)
	15416	K ^TMP($J ,"BATCHES" )
	15417	"RTN","RCD PEWL6",163 ,0)
	15418	REFQ S VAL MBG=1,VALM BCK="R"
	15419	"RTN","RCD PEWL6",164 ,0)
	15420	Q
	15421	"RTN","RCD PEWL6",165 ,0)
	15422	;
	15423	"RTN","RCD PEWL6",166 ,0)
	15424	WHAT(RCSCR ) ; Text f or what to do if not enough fu nds found for dist a dj
	15425	"RTN","RCD PEWL6",167 ,0)
	15426	Q $S($O(^ RCY(344.31 ,"AERA",+R CSCR,0)):" THIS ERA M UST BE MOV ED TO SUSP ENSE",1:"T HIS ERA'S RECEIPT MU ST BE ENTE RED MANUAL LY")
	15427	"RTN","RCD PEWL6",168 ,0)
	15428	;
	15429	"RTN","RCD PEWL6",169 ,0)
	15430	ADJUST ; A llow entry into incr ease/decre ase adjust ment funct ions
	15431	"RTN","RCD PEWL6",170 ,0)
	15432	N DIR,X,Y ,RCTYP,RCY ,DIC
	15433	"RTN","RCD PEWL6",171 ,0)
	15434	D FULL^VA LM1
	15435	"RTN","RCD PEWL6",172 ,0)
	15436	;
	15437	"RTN","RCD PEWL6",173 ,0)
	15438	I $G(RCSC R("NOEDIT" ))=2 D NOT AV^RCDPEWL 2 G ADJUST Q
	15439	"RTN","RCD PEWL6",174 ,0)
	15440	; PRCA4. 5276 - ch eck for au thorized u ser
	15441	"RTN","RCD PEWL6",175 ,0)
	15442	I '$D(^XU SEC("PRCAD J",DUZ)) D Q
	15443	"RTN","RCD PEWL6",176 ,0)
	15444	.S DIR(0) ="EA",DIR( "A",1)="Th e Adjust ( Inc/Dec) A ction is l ocked."
	15445	"RTN","RCD PEWL6",177 ,0)
	15446	.S DIR("A ",2)="Plea se speak t o your Sup ervisor to request t he key."
	15447	"RTN","RCD PEWL6",178 ,0)
	15448	.S DIR("A ")="PRESS RETURN TO CONTINUE" W ! D ^DIR K DIR
	15449	"RTN","RCD PEWL6",179 ,0)
	15450	; PRCA4. 5276 - en d of chang es
	15451	"RTN","RCD PEWL6",180 ,0)
	15452	;
	15453	"RTN","RCD PEWL6",181 ,0)
	15454	S DIR(0)= "SA^D:DECR EASE ADJUS TMENT;I:IN CREASE ADJ USTMENT",D IR("B")="D ECREASE AD JUSTMENT", DIR("A")=" TYPE OF AD JUSTMENT: "
	15455	"RTN","RCD PEWL6",182 ,0)
	15456	W ! D ^DI R K DIR
	15457	"RTN","RCD PEWL6",183 ,0)
	15458	M ^TMP("R C_SAVE_TMP ",$J)=^TMP ($J)
	15459	"RTN","RCD PEWL6",184 ,0)
	15460	I $D(DUOU T)!$D(DTOU T)!(Y="") G ADJUSTQ
	15461	"RTN","RCD PEWL6",185 ,0)
	15462	;
	15463	"RTN","RCD PEWL6",186 ,0)
	15464	S RCTYP=$ S(Y="D":"D ECREASE",1 :"INCREASE ")
	15465	"RTN","RCD PEWL6",187 ,0)
	15466	F S RCY= $$GETABILL ^RCBEUBIL Q:RCY<0!(R CY'<1)
	15467	"RTN","RCD PEWL6",188 ,0)
	15468	G:RCY<1 A DJUSTQ
	15469	"RTN","RCD PEWL6",189 ,0)
	15470	D ADJUST^ RCBEADJ(RC TYP,RCY_"; "_RCSCR)
	15471	"RTN","RCD PEWL6",190 ,0)
	15472	I $D(^TMP ("RC_BILL" ,$J,RCY)) D
	15473	"RTN","RCD PEWL6",191 ,0)
	15474	. D UPDBA L(RCY)
	15475	"RTN","RCD PEWL6",192 ,0)
	15476	. W !,"Cl aim balanc e is now: ",$J(+$P($ $BILL^RCJI BFN2(RCY), U,3),"",2)
	15477	"RTN","RCD PEWL6",193 ,0)
	15478	;
	15479	"RTN","RCD PEWL6",194 ,0)
	15480	ADJUSTQ D RESTMP
	15481	"RTN","RCD PEWL6",195 ,0)
	15482	D RET^RCD PEWL2
	15483	"RTN","RCD PEWL6",196 ,0)
	15484	S VALMBCK ="R"
	15485	"RTN","RCD PEWL6",197 ,0)
	15486	Q
	15487	"RTN","RCD PEWL6",198 ,0)
	15488	;
	15489	"RTN","RCD PEWL6",199 ,0)
	15490	RESTMP ;
	15491	"RTN","RCD PEWL6",200 ,0)
	15492	I $D(^TMP ("RC_SAVE_ TMP",$J)) M ^TMP($J) =^TMP("RC_ SAVE_TMP", $J) K ^TMP ("RC_SAVE_ TMP")
	15493	"RTN","RCD PEWL6",201 ,0)
	15494	Q
	15495	"RTN","RCD PEWL6",202 ,0)
	15496	;
	15497	"RTN","RCD PEWL6",203 ,0)
	15498	UPDBAL(RCY ) ; Update s the clai m balance if bill ex ists in li st
	15499	"RTN","RCD PEWL6",204 ,0)
	15500	; RCY = i en of bill in file 4 30
	15501	"RTN","RCD PEWL6",205 ,0)
	15502	;
	15503	"RTN","RCD PEWL6",206 ,0)
	15504	N X,Y,Z,Z 0,Z1
	15505	"RTN","RCD PEWL6",207 ,0)
	15506	S Z0=$J(+ $P($$BILL^ RCJIBFN2(R CY),U,3)," ",2)
	15507	"RTN","RCD PEWL6",208 ,0)
	15508	S Z=0 F S Z=$O(^TM P("RC_BILL ",$J,RCY,Z )) Q:'Z D
	15509	"RTN","RCD PEWL6",209 ,0)
	15510	. S X=+$G (^TMP("RCD PE-EOB_WLD X",$J,Z))
	15511	"RTN","RCD PEWL6",210 ,0)
	15512	. Q:'X
	15513	"RTN","RCD PEWL6",211 ,0)
	15514	. S Y=$G( ^TMP("RCDP E-EOB_WL", $J,X+1,0))
	15515	"RTN","RCD PEWL6",212 ,0)
	15516	. I Y["Cl aim Bal: " S Z1=$P(Y ,"Claim Ba l: ")_"Cla im Bal: "_ Z0_$G(^TMP ("RC_BILL" ,$J,RCY,Z) ),^TMP("RC DPE-EOB_WL ",$J,X+1,0 )=Z1
	15517	"RTN","RCD PEWL6",213 ,0)
	15518	Q
	15519	"RTN","RCD PEWL6",214 ,0)
	15520	;
	15521	"RTN","RCD PEWL7")
	15522	0^15^B1006 12079^B988 45066
	15523	"RTN","RCD PEWL7",1,0 )
	15524	RCDPEWL7 ; ALB/TMK/KM L - EDI LO CKBOX WORK LIST ERA D ISPLAY SCR EEN ;Jun 0 6, 2014@19 :11:19
	15525	"RTN","RCD PEWL7",2,0 )
	15526	;;4.5;Acc ounts Rece ivable;2 08,222,269 ,276,298,3 04,318;M ar 20, 199 5;Build 25
	15527	"RTN","RCD PEWL7",3,0 )
	15528	;Per VA D irective 6 402, this routine sh ould not b e modified .
	15529	"RTN","RCD PEWL7",4,0 )
	15530	Q
	15531	"RTN","RCD PEWL7",5,0 )
	15532	;
	15533	"RTN","RCD PEWL7",6,0 )
	15534	BLD(RCSORT ) ; Build list with sort crite ria
	15535	"RTN","RCD PEWL7",7,0 )
	15536	; RCSORT = the sort levels to use to di splay the data in ^ pieces
	15537	"RTN","RCD PEWL7",8,0 )
	15538	; piece 1 = the co des for th e first le vel sort ( sort code; null or -)
	15539	"RTN","RCD PEWL7",9,0 )
	15540	; piece 2 = the co des for th e second l evel sort
	15541	"RTN","RCD PEWL7",10, 0)
	15542	; sor t code is the type o f data to sort by;- indicates reverse or der
	15543	"RTN","RCD PEWL7",11, 0)
	15544	N Z,Z1,RC T,RCZ
	15545	"RTN","RCD PEWL7",12, 0)
	15546	S (RCT,VA LMCNT)=0
	15547	"RTN","RCD PEWL7",13, 0)
	15548	I '$D(^TM P($J,"RCER A_LIST")) D
	15549	"RTN","RCD PEWL7",14, 0)
	15550	. S Z=0 F S Z=$O(^ TMP("RCDPE -ERA_WLDX" ,$J,Z)) Q: 'Z S RCZ= $P($G(^(Z) ),U,2) D
	15551	"RTN","RCD PEWL7",15, 0)
	15552	.. I $$FI LTER^RCDPE WL0(RCZ) S ^TMP($J," RCERA_LIST ",$$SL(RCZ ,$P(RCSORT ,U)),$$SL( RCZ,$P(RCS ORT,U,2)), RCZ)=""
	15553	"RTN","RCD PEWL7",16, 0)
	15554	. K ^TMP( "RCDPE-ERA _WLDX",$J) ,^TMP("RCD PE-ERA_WL" ,$J)
	15555	"RTN","RCD PEWL7",17, 0)
	15556	;
	15557	"RTN","RCD PEWL7",18, 0)
	15558	S Z=""
	15559	"RTN","RCD PEWL7",19, 0)
	15560	I RCSORT' ["PN;-" D
	15561	"RTN","RCD PEWL7",20, 0)
	15562	. F S Z= $O(^TMP($J ,"RCERA_LI ST",Z)) Q: Z="" S Z1 ="" F S Z 1=$O(^TMP( $J,"RCERA_ LIST",Z,Z1 )) Q:Z1="" D EXTRAC T(Z,Z1,.RC T)
	15563	"RTN","RCD PEWL7",21, 0)
	15564	;
	15565	"RTN","RCD PEWL7",22, 0)
	15566	I $P(RCSO RT,U)["PN; -" D
	15567	"RTN","RCD PEWL7",23, 0)
	15568	. F S Z= $O(^TMP($J ,"RCERA_LI ST",Z),-1) Q:Z="" S Z1="" F S Z1=$O(^T MP($J,"RCE RA_LIST",Z ,Z1)) Q:Z1 ="" D EXT RACT(Z,Z1, .RCT)
	15569	"RTN","RCD PEWL7",24, 0)
	15570	;
	15571	"RTN","RCD PEWL7",25, 0)
	15572	I $P(RCSO RT,U,2)["P N;-" D
	15573	"RTN","RCD PEWL7",26, 0)
	15574	. F S Z= $O(^TMP($J ,"RCERA_LI ST",Z)) Q: Z="" S Z1 ="" F S Z 1=$O(^TMP( $J,"RCERA_ LIST",Z,Z1 ),-1) Q:Z1 ="" D EXT RACT(Z,Z1, .RCT)
	15575	"RTN","RCD PEWL7",27, 0)
	15576	;
	15577	"RTN","RCD PEWL7",28, 0)
	15578	I '$O(^TM P($J,"RCER A_LIST",0) ) D SET("N o ERAs lef t for your selection criteria" )
	15579	"RTN","RCD PEWL7",29, 0)
	15580	K ^TMP($J ,"RCERA_LI ST")
	15581	"RTN","RCD PEWL7",30, 0)
	15582	S ^TMP("R CERA_PARAM S",$J,"SOR T")=RCSORT
	15583	"RTN","RCD PEWL7",31, 0)
	15584	Q
	15585	"RTN","RCD PEWL7",32, 0)
	15586	;
	15587	"RTN","RCD PEWL7",33, 0)
	15588	EXTRACT(RC SRT1,RCSRT 2,RCT) ; E xtract the data
	15589	"RTN","RCD PEWL7",34, 0)
	15590	; RCSRT1 = data val ue at 1st sort level
	15591	"RTN","RCD PEWL7",35, 0)
	15592	; RCSRT2 = data val ue at 2nd sort level
	15593	"RTN","RCD PEWL7",36, 0)
	15594	; RCT = r unning ent ry counter - returne d if passe d by ref
	15595	"RTN","RCD PEWL7",37, 0)
	15596	N AUTOCOM P,FIRST,RC 0,RCEFT,RC EXCEP,RCPO ST,RCSTAT, RCZ,X,XX,Z ,Z0 ;PRCA* 4.5*318 Va riable XX added
	15597	"RTN","RCD PEWL7",38, 0)
	15598	S RCZ=0 F S RCZ=$O (^TMP($J," RCERA_LIST ",RCSRT1,R CSRT2,RCZ) ) Q:'RCZ D
	15599	"RTN","RCD PEWL7",39, 0)
	15600	. S RCT=R CT+1,RC0=$ G(^RCY(344 .4,RCZ,0))
	15601	"RTN","RCD PEWL7",40, 0)
	15602	. S RCEFT =+$O(^RCY( 344.31,"AE RA",RCZ,0) )
	15603	"RTN","RCD PEWL7",41, 0)
	15604	. S RCEXC EP=$$XCEPT ^RCDPEWLP( RCZ) ; pr ca4.5298 assignme nt of ERA exception flag
	15605	"RTN","RCD PEWL7",42, 0)
	15606	. S AUTOC OMP=$S($P( $G(^RCY(34 4.4,RCZ,4) ),U,2)=2:" A",1:"") ;prca4.5 298 AUTO -POSTED CO MPLETE ind icator ("A ")
	15607	"RTN","RCD PEWL7",43, 0)
	15608	. S RCSTA T=$S('RCEF T:U_$S($P( RC0,U,15)= "CHK":"(CH ECK PAYMEN T EXPECTED )",$P(RC0, U,15)="NON ":"(NO PAY MENT EXPEC TED)",$P(R C0,U,9)=2: "(CHECK PA YMENT CHOS EN)",1:"N/ A"),1:$$FM SSTAT^RCDP UREC(+$P($ G(^RCY(344 .31,RCEFT, 0)),U,9)))
	15609	"RTN","RCD PEWL7",44, 0)
	15610	. S RCPOS T=$S(RCEFT :"EFT RECE IPT STATUS : ",1:"")_ $P(RCSTAT, U,2)
	15611	"RTN","RCD PEWL7",45, 0)
	15612	. ;prca4 .5298 inc lude Auto- Post Compl ete indica tor and ER A exceptio n flag in $SELECT st atement
	15613	"RTN","RCD PEWL7",46, 0)
	15614	. S X=$E( RCT_$J("", 5),1,5)_" "_$S(RCEX CEP]"":RCE XCEP,AUTOC OMP]"":AUT OCOMP,$D(^ RCY(344.49 ,RCZ)):" " ,1:"-")_$E ($P(RC0,U) _$J("",10) ,1,10)_" "_$E($P(RC 0,U,2)_$J( "",50),1,5 0)
	15615	"RTN","RCD PEWL7",47, 0)
	15616	. D SET(X ,RCT,RCZ)
	15617	"RTN","RCD PEWL7",48, 0)
	15618	. S X=$J( "",40)_$J( $$FMTE^XLF DT($P(RC0, U,7),"2D") ,8)_$J("", 5)_$J(+$P( RC0,U,5),1 2,2)
	15619	"RTN","RCD PEWL7",49, 0)
	15620	. S $E(X, 73,80)=$$F MTE^XLFDT( $P(RC0,U,7 ),"2D")
	15621	"RTN","RCD PEWL7",50, 0)
	15622	. D SET(X ,RCT,RCZ)
	15623	"RTN","RCD PEWL7",51, 0)
	15624	. S X=$J( "",12)_$E( $P(RC0,U,6 )_$J("",30 ),1,30)_" APPROX # EEOBs: "_+ $$CTEEOB^R CDPEWLB(RC Z)
	15625	"RTN","RCD PEWL7",52, 0)
	15626	. D SET(X ,RCT,RCZ)
	15627	"RTN","RCD PEWL7",53, 0)
	15628	. S XX=$$ EXTERNAL^D ILFD(344.4 ,.09,"",$P (RC0,U,9))
	15629	"RTN","RCD PEWL7",54, 0)
	15630	. S:$$UNB AL^RCDPEAP 1(RCZ) XX= XX_" - UNB ALANCED" ; PRCA4.53 18 added l ine
	15631	"RTN","RCD PEWL7",55, 0)
	15632	. S X=$J( "",12)_$E( XX_$J("",3 0),1,30)_" "_RCPOST ;PRCA4.5 318 modif ied line
	15633	"RTN","RCD PEWL7",56, 0)
	15634	. D SET(X ,RCT)
	15635	"RTN","RCD PEWL7",57, 0)
	15636	. D SET(" ",RCT)
	15637	"RTN","RCD PEWL7",58, 0)
	15638	;.; prca* 4.5*298 p er patch r equirement s, keep co de related to
	15639	"RTN","RCD PEWL7",59, 0)
	15640	;. ; crea ting/maint aining bat ches but j ust remove from exec ution.
	15641	"RTN","RCD PEWL7",60, 0)
	15642	;. ;I $G( ^TMP("RCER A_PARAMS", $J,"BATCHO N")) D
	15643	"RTN","RCD PEWL7",61, 0)
	15644	;.. ;S Z= 0 F S Z=$ O(^RCY(344 .49,RCZ,3, Z)) Q:'Z S Z0=$G(^( Z,0)) I Z0 '="" D
	15645	"RTN","RCD PEWL7",62, 0)
	15646	;...; S X =$J("",12) _$E("- BAT CH #"_$P(Z 0,U)_$J("" ,4),1,13)_ " "_$E($P( Z0,U,2)_$J ("",30),1, 30)_" "_$ S('$P(Z0,U ,3):"NOT " ,1:"")_"RE ADY TO POS T"
	15647	"RTN","RCD PEWL7",63, 0)
	15648	;... ;D S ET(X,RCT)
	15649	"RTN","RCD PEWL7",64, 0)
	15650	;
	15651	"RTN","RCD PEWL7",65, 0)
	15652	S VALMSG= "\|'-' No s cratchpad\| 'x' EXC \|' A' autopos t complete "
	15653	"RTN","RCD PEWL7",66, 0)
	15654	;
	15655	"RTN","RCD PEWL7",67, 0)
	15656	Q
	15657	"RTN","RCD PEWL7",68, 0)
	15658	;
	15659	"RTN","RCD PEWL7",69, 0)
	15660	SL(Y,SORT) ; Returns data for sort level from entr y Y in fil e 344.4
	15661	"RTN","RCD PEWL7",70, 0)
	15662	; SORT = the sort d ata in ';' delimited pieces
	15663	"RTN","RCD PEWL7",71, 0)
	15664	; pc 1 = code fo r sort dat a
	15665	"RTN","RCD PEWL7",72, 0)
	15666	; pc 2 = the ord er request ed (- or n ull)
	15667	"RTN","RCD PEWL7",73, 0)
	15668	;
	15669	"RTN","RCD PEWL7",74, 0)
	15670	N RC0,DAT ,SORT1,SOR T2
	15671	"RTN","RCD PEWL7",75, 0)
	15672	S SORT1=$ P(SORT,";" ),SORT2=$P (SORT,";", 2)
	15673	"RTN","RCD PEWL7",76, 0)
	15674	S RC0=$G( ^RCY(344.4 ,Y,0)),DAT =" "
	15675	"RTN","RCD PEWL7",77, 0)
	15676	; No sort
	15677	"RTN","RCD PEWL7",78, 0)
	15678	I SORT="" G SLQ
	15679	"RTN","RCD PEWL7",79, 0)
	15680	; Amt pai d
	15681	"RTN","RCD PEWL7",80, 0)
	15682	I SORT1=" AP" D G S LQ
	15683	"RTN","RCD PEWL7",81, 0)
	15684	. S DAT=S ORT2_+$P(R C0,U,5)
	15685	"RTN","RCD PEWL7",82, 0)
	15686	; ERA dat e pd
	15687	"RTN","RCD PEWL7",83, 0)
	15688	I SORT1=" DP" D G S LQ
	15689	"RTN","RCD PEWL7",84, 0)
	15690	. S DAT=S ORT2_($P(R C0,U,4)\1)
	15691	"RTN","RCD PEWL7",85, 0)
	15692	; Payer n ame
	15693	"RTN","RCD PEWL7",86, 0)
	15694	I SORT1=" PN" D G S LQ
	15695	"RTN","RCD PEWL7",87, 0)
	15696	. S DAT=$ $UP^RCDPEA RL($P(RC0, U,6))
	15697	"RTN","RCD PEWL7",88, 0)
	15698	; ERA dat e received
	15699	"RTN","RCD PEWL7",89, 0)
	15700	I SORT1=" DR" D G S LQ
	15701	"RTN","RCD PEWL7",90, 0)
	15702	. S DAT=S ORT2_($P(R C0,U,7)\1)
	15703	"RTN","RCD PEWL7",91, 0)
	15704	;
	15705	"RTN","RCD PEWL7",92, 0)
	15706	SLQ Q $S(D AT'="":DAT ,1:" ")
	15707	"RTN","RCD PEWL7",93, 0)
	15708	;
	15709	"RTN","RCD PEWL7",94, 0)
	15710	INIT ; Ent ry point f or List te mplate to build the display of ERAs
	15711	"RTN","RCD PEWL7",95, 0)
	15712	;
	15713	"RTN","RCD PEWL7",96, 0)
	15714	; Paramet ers for se lecting ER As to be i ncluded in the list are
	15715	"RTN","RCD PEWL7",97, 0)
	15716	; contain ed in the global ^TM P("RCERA_P ARAMS",$J, parameter name)
	15717	"RTN","RCD PEWL7",98, 0)
	15718	;
	15719	"RTN","RCD PEWL7",99, 0)
	15720	N RCZ,RC0 ,RCT,RCTT, RCQUIT,RCD TFR,RCDTTO ,DTOUT,DUO UT,DIR,X,Y ,Z,Z1,RCPO ST,RCEFT,R CINDX,QFLG
	15721	"RTN","RCD PEWL7",100 ,0)
	15722	D CLEAN^V ALM10
	15723	"RTN","RCD PEWL7",101 ,0)
	15724	K ^TMP("R CDPE-ERA_W L",$J),^TM P("RCDPE-E RA_WLDX",$ J),^TMP($J ,"RCERA_LI ST")
	15725	"RTN","RCD PEWL7",102 ,0)
	15726	;
	15727	"RTN","RCD PEWL7",103 ,0)
	15728	S (RCT,RC TT,RCQUIT) =0
	15729	"RTN","RCD PEWL7",104 ,0)
	15730	;
	15731	"RTN","RCD PEWL7",105 ,0)
	15732	S RCDTFR= +$P($G(^TM P("RCERA_P ARAMS",$J, "RCDT")),U ),RCDTTO=$ S($P($G(^T MP("RCERA_ PARAMS",$J ,"RCDT")), U,2):$P(^( "RCDT"),U, 2),1:DT)
	15733	"RTN","RCD PEWL7",106 ,0)
	15734	;
	15735	"RTN","RCD PEWL7",107 ,0)
	15736	S RCINDX= $S(RCDTFR: RCDTFR-.00 000001,1:0 )
	15737	"RTN","RCD PEWL7",108 ,0)
	15738	W !!,"SEA RCHING, PL EASE STAND BY (PRESS '^' TO QUI T SEARCH)" ,!!
	15739	"RTN","RCD PEWL7",109 ,0)
	15740	F S RCIN DX=$O(^RCY (344.4,"AF D",RCINDX) ) Q:'RCIND X!(RCINDX\ 1>RCDTTO)! RCQUIT S RCZ=0 F S RCZ=$O(^R CY(344.4," AFD",RCIND X,RCZ)) Q: 'RCZ D Q :RCQUIT
	15741	"RTN","RCD PEWL7",110 ,0)
	15742	. S RCTT= RCTT+1
	15743	"RTN","RCD PEWL7",111 ,0)
	15744	. I (RCTT #10000=0) D Q:RCQUI T=1
	15745	"RTN","RCD PEWL7",112 ,0)
	15746	. . S RCT T=0
	15747	"RTN","RCD PEWL7",113 ,0)
	15748	. . D WAI T^DICD
	15749	"RTN","RCD PEWL7",114 ,0)
	15750	. . D INI TKB^XGF ; supported by DBIA 31 73
	15751	"RTN","RCD PEWL7",115 ,0)
	15752	. . S QFL G=$$READ^X GF(1,1)
	15753	"RTN","RCD PEWL7",116 ,0)
	15754	. . Q:$G( DTOUT)
	15755	"RTN","RCD PEWL7",117 ,0)
	15756	. . S:QFL G="^" RCQU IT=1 Q
	15757	"RTN","RCD PEWL7",118 ,0)
	15758	. . I $D( DUOUT)!(Y= 0) S RCQUI T=1 Q
	15759	"RTN","RCD PEWL7",119 ,0)
	15760	. . D RES ETKB^XGF
	15761	"RTN","RCD PEWL7",120 ,0)
	15762	. ;
	15763	"RTN","RCD PEWL7",121 ,0)
	15764	. S RC0=$ G(^RCY(344 .4,RCZ,0))
	15765	"RTN","RCD PEWL7",122 ,0)
	15766	. I $$FIL TER^RCDPEW L0(RCZ) S ^TMP($J,"R CERA_LIST" ,$$SL(RCZ, "DR"),$$SL (RCZ,""),R CZ)=""
	15767	"RTN","RCD PEWL7",123 ,0)
	15768	;
	15769	"RTN","RCD PEWL7",124 ,0)
	15770	; Output the list
	15771	"RTN","RCD PEWL7",125 ,0)
	15772	I 'RCQUIT D
	15773	"RTN","RCD PEWL7",126 ,0)
	15774	. D:$D(^T MP($J,"RCE RA_LIST")) BLD("DR^N ")
	15775	"RTN","RCD PEWL7",127 ,0)
	15776	. ; If no ERAs foun d display the messag e below in the list area
	15777	"RTN","RCD PEWL7",128 ,0)
	15778	. I '$O(^ TMP("RCDPE -ERA_WL",$ J,0)) D
	15779	"RTN","RCD PEWL7",129 ,0)
	15780	. . S ^TM P("RCDPE-E RA_WL",$J, 1,0)="THER E ARE NO E RAs MATCHI NG YOUR SE LECTION CR ITERIA" S VALMCNT=2
	15781	"RTN","RCD PEWL7",130 ,0)
	15782	I RCQUIT K ^TMP("RC DPE-ERA_WL ",$J),^TMP ("RCDPE-ER A_WLDX",$J ),^TMP($J, "RCERA_LIS T") S VALM QUIT=""
	15783	"RTN","RCD PEWL7",131 ,0)
	15784	Q
	15785	"RTN","RCD PEWL7",132 ,0)
	15786	;
	15787	"RTN","RCD PEWL7",133 ,0)
	15788	HDR ; Head er for ERA Worklist (List user Current S creen View selection s)
	15789	"RTN","RCD PEWL7",134 ,0)
	15790	N X
	15791	"RTN","RCD PEWL7",135 ,0)
	15792	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCMATCH" ))
	15793	"RTN","RCD PEWL7",136 ,0)
	15794	S VALMHDR (1)="SELEC TED MATCH STATUS: "_ $S(X="N":" NOT MATCHE D",X="M":" MATCHED",1 :"BOTH")
	15795	"RTN","RCD PEWL7",137 ,0)
	15796	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCPOST") )
	15797	"RTN","RCD PEWL7",138 ,0)
	15798	S $E(VALM HDR(1),42) ="POST STA TUS : "_$S(X="U" :"UNPOSTED ",X="P":"P OSTED",1:" BOTH")
	15799	"RTN","RCD PEWL7",139 ,0)
	15800	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCDT"))
	15801	"RTN","RCD PEWL7",140 ,0)
	15802	S VALMHDR (2)=$J("", 11)_"DATE RANGE: "_$ S($P(X,U): $$FMTE^XLF DT($P(X,U) ,2)_$S($P( X,U,2):"-" _$$FMTE^XL FDT($P(X,U ,2),2),1:" "),1:"NONE SELECTED" )
	15803	"RTN","RCD PEWL7",141 ,0)
	15804	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCAUTOP" ))
	15805	"RTN","RCD PEWL7",142 ,0)
	15806	S $E(VALM HDR(2),42) ="AUTO-POS TING : "_$S(X="A" :"AUTO-POS TING ONLY" ,X="N":"NO N AUTO-POS TING ONLY" ,1:"BOTH")
	15807	"RTN","RCD PEWL7",143 ,0)
	15808	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCPAYR") )
	15809	"RTN","RCD PEWL7",144 ,0)
	15810	S VALMHDR (3)=$J("", 10)_$S($P( X,U)="A"!( X=""):"ALL PAYERS",1 :"PAYERS: "_$P(X,U,2 )_"-"_$P(X ,U,3))
	15811	"RTN","RCD PEWL7",145 ,0)
	15812	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCTYPE") )
	15813	"RTN","RCD PEWL7",146 ,0)
	15814	S $E(VALM HDR(3),42) ="PHARMACY /MEDICAL: "_$S(X="M" :"MEDICAL ONLY",X="P ":"PHARMAC Y ONLY",1: "BOTH")
	15815	"RTN","RCD PEWL7",147 ,0)
	15816	S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCERA_TR ACE#"))
	15817	"RTN","RCD PEWL7",148 ,0)
	15818	S VALMHDR (4)="# ERA # Trace#"
	15819	"RTN","RCD PEWL7",149 ,0)
	15820	Q
	15821	"RTN","RCD PEWL7",150 ,0)
	15822	;
	15823	"RTN","RCD PEWL7",151 ,0)
	15824	FNL ; -- C lean up li st
	15825	"RTN","RCD PEWL7",152 ,0)
	15826	K ^TMP("R CDPE-ERA_W L",$J),^TM P("RCDPE-E RA_WLDX",$ J),^TMP("R CERA_PARAM S",$J),^TM P($J,"RCER A_LIST")
	15827	"RTN","RCD PEWL7",153 ,0)
	15828	Q
	15829	"RTN","RCD PEWL7",154 ,0)
	15830	;
	15831	"RTN","RCD PEWL7",155 ,0)
	15832	SET(X,RCSE Q,RCSEQ1) ; -- set a rrays
	15833	"RTN","RCD PEWL7",156 ,0)
	15834	; X = the data to s et into th e global
	15835	"RTN","RCD PEWL7",157 ,0)
	15836	; RCSEQ = the selec table line #
	15837	"RTN","RCD PEWL7",158 ,0)
	15838	; RCSEQ1 = the ien of the ent ry in file 344.4
	15839	"RTN","RCD PEWL7",159 ,0)
	15840	S VALMCNT =VALMCNT+1 ,^TMP("RCD PE-ERA_WL" ,$J,VALMCN T,0)=X
	15841	"RTN","RCD PEWL7",160 ,0)
	15842	I $G(RCSE Q) S ^TMP( "RCDPE-ERA _WL",$J,"I DX",VALMCN T,RCSEQ)=$ G(RCSEQ1)
	15843	"RTN","RCD PEWL7",161 ,0)
	15844	I $G(RCSE Q1) S ^TMP ("RCDPE-ER A_WLDX",$J ,RCSEQ)=VA LMCNT_U_RC SEQ1
	15845	"RTN","RCD PEWL7",162 ,0)
	15846	Q
	15847	"RTN","RCD PEWL7",163 ,0)
	15848	;
	15849	"RTN","RCD PEWL7",164 ,0)
	15850	ENTERWL ; Enter the worklist w ith an ERA
	15851	"RTN","RCD PEWL7",165 ,0)
	15852	D WL($$SE L())
	15853	"RTN","RCD PEWL7",166 ,0)
	15854	D BLD($G( ^TMP("RCER A_PARAMS", $J,"SORT") ))
	15855	"RTN","RCD PEWL7",167 ,0)
	15856	S VALMBCK ="R"
	15857	"RTN","RCD PEWL7",168 ,0)
	15858	Q
	15859	"RTN","RCD PEWL7",169 ,0)
	15860	;
	15861	"RTN","RCD PEWL7",170 ,0)
	15862	SEL() ; Se lect an ER A from the ERA list
	15863	"RTN","RCD PEWL7",171 ,0)
	15864	N RCDA,VA LMY
	15865	"RTN","RCD PEWL7",172 ,0)
	15866	D FULL^VA LM1
	15867	"RTN","RCD PEWL7",173 ,0)
	15868	D EN^VALM 2($G(XQORN OD(0)),"S" )
	15869	"RTN","RCD PEWL7",174 ,0)
	15870	S RCERA=0
	15871	"RTN","RCD PEWL7",175 ,0)
	15872	S RCDA=0 F S RCDA= $O(VALMY(R CDA)) Q:'R CDA S RCE RA=+$P($G( ^TMP("RCDP E-ERA_WLDX ",$J,RCDA) ),U,2)
	15873	"RTN","RCD PEWL7",176 ,0)
	15874	;
	15875	"RTN","RCD PEWL7",177 ,0)
	15876	Q RCERA
	15877	"RTN","RCD PEWL7",178 ,0)
	15878	;
	15879	"RTN","RCD PEWL7",179 ,0)
	15880	WL(RCERA) ; Enter wo rklist
	15881	"RTN","RCD PEWL7",180 ,0)
	15882	;
	15883	"RTN","RCD PEWL7",181 ,0)
	15884	; input - RCERA = ien of th e ERA entr y in file 344.4
	15885	"RTN","RCD PEWL7",182 ,0)
	15886	;
	15887	"RTN","RCD PEWL7",183 ,0)
	15888	N DA,DIE, DIR,DR,DTO UT,DUOUT,I ,PREVENT,R C0,RCNOED, RCQUIT,RCS ORT,RCEXC, RETCODES,S TATE,TYPE, X,Y
	15889	"RTN","RCD PEWL7",184 ,0)
	15890	Q:RCERA'> 0
	15891	"RTN","RCD PEWL7",185 ,0)
	15892	; PRCA4. 5304 - Re entry if w e cleared exceptions
	15893	"RTN","RCD PEWL7",186 ,0)
	15894	WL1 ; rete st to make sure this ERA does not have a n exceptio n
	15895	"RTN","RCD PEWL7",187 ,0)
	15896	S TYPE=$S ($$PHARM^R CDPEWLP(RC ERA):"P",1 :"M"),RCEX C=0
	15897	"RTN","RCD PEWL7",188 ,0)
	15898	; PRCA4. 5304 - se e if we ha ve the ERA and go to WL1 to re test.
	15899	"RTN","RCD PEWL7",189 ,0)
	15900	I ($$XCEP T^RCDPEWLP (RCERA)]"" )&(TYPE="M ") D EXCDE NY^RCDPEWL P Q ;cann ot process MEDICAL E RA if exce ption exis ts then fa ll back to Worklist.
	15901	"RTN","RCD PEWL7",190 ,0)
	15902	; PRCA4. 5304 - Re moved the G:($G(RCER A)'="")&&( $G(RCEXC)= 1) WL1 fro m above so it falls back to th e worklist instead o f going fo rward to t he "Select ERA"
	15903	"RTN","RCD PEWL7",191 ,0)
	15904	; I ($$XC EPT^RCDPEW LP(RCERA)] "")&(TYPE= "M") D EXC DENY^RCDPE WLP G:($G( RCERA)'="" )&&($G(RCE XC)=1) WL1 Q
	15905	"RTN","RCD PEWL7",192 ,0)
	15906	S (RCQUIT ,RCNOED,PR EVENT)=0,R C0=$G(^RCY (344.4,RCE RA,0)),RCS ORT=""
	15907	"RTN","RCD PEWL7",193 ,0)
	15908	I $P(RC0, U,8) D
	15909	"RTN","RCD PEWL7",194 ,0)
	15910	. I '$D(^ RCY(344.49 ,RCERA,0)) D Q
	15911	"RTN","RCD PEWL7",195 ,0)
	15912	.. S RCQU IT=1
	15913	"RTN","RCD PEWL7",196 ,0)
	15914	.. W ! S DIR(0)="EA ",DIR("A", 1)="A SCRA TCH PAD WA S NOT CREA TED FOR TH IS ERA BEF ORE POSTIN G",DIR("A" ,2)="USE T HE VIEW/PR INT ERA OP TION TO SE E ITS DETA IL",DIR("A ")="Press ENTER to c ontinue: " D ^DIR K DIR Q
	15915	"RTN","RCD PEWL7",197 ,0)
	15916	. ;
	15917	"RTN","RCD PEWL7",198 ,0)
	15918	. S RCNOE D=+$P(RC0, U,8)
	15919	"RTN","RCD PEWL7",199 ,0)
	15920	. S DIR(0 )="EA",DIR ("A",1)="T HIS ERA AL READY HAS A RECEIPT - YOU MAY ONLY VIEW ITS SCRATC H PAD",DIR ("A")="Pre ss ENTER t o continue : "
	15921	"RTN","RCD PEWL7",200 ,0)
	15922	. W ! D ^ DIR K DIR W !
	15923	"RTN","RCD PEWL7",201 ,0)
	15924	G:RCQUIT WLQ
	15925	"RTN","RCD PEWL7",202 ,0)
	15926	G:RCNOED WLD ; al ready has a receipt so no need to check for older unposted E FTs
	15927	"RTN","RCD PEWL7",203 ,0)
	15928	; functio n $$AGEDEF TS - searc h for any UNPOSTED E FTs older than 14 da ys (medica l) or 30 d ays (pharm acy)
	15929	"RTN","RCD PEWL7",204 ,0)
	15930	; return value of 0 , 2, or 3 represent that entry into scra tchpad can occur
	15931	"RTN","RCD PEWL7",205 ,0)
	15932	S RETCODE S=$$AGEDEF TS^RCDPEWL P(RCERA,TY PE)
	15933	"RTN","RCD PEWL7",206 ,0)
	15934	F I=1:1 S STATE=$P( RETCODES,U ,I) Q:STAT E="" S PR EVENT=$S($ E(STATE,1) =1:1,1:0)
	15935	"RTN","RCD PEWL7",207 ,0)
	15936	Q:PREVENT ; preve nt user fr om enterin g scratchp ad; there are older EFTs on th e system t hat need t o be worke d.
	15937	"RTN","RCD PEWL7",208 ,0)
	15938	WLD ;
	15939	"RTN","RCD PEWL7",209 ,0)
	15940	D DISP^RC DPEWL(RCER A,RCNOED)
	15941	"RTN","RCD PEWL7",210 ,0)
	15942	;
	15943	"RTN","RCD PEWL7",211 ,0)
	15944	; prca4. 5298 per patch req uirements, keep code related t o
	15945	"RTN","RCD PEWL7",212 ,0)
	15946	; creatin g/maintain ing batche s but just remove fr om executi on.
	15947	"RTN","RCD PEWL7",213 ,0)
	15948	;I 'RCQUI T,$G(^TMP( "RCBATCH_S ELECTED",$ J)) D
	15949	"RTN","RCD PEWL7",214 ,0)
	15950	;. S DA(1 )=RCERA,DA =+$G(^TMP( "RCBATCH_S ELECTED",$ J)),DR=".0 5////0",DI E="^RCY(34 4.49,"_DA( 1)_",3," D ^DIE
	15951	"RTN","RCD PEWL7",215 ,0)
	15952	;. L -^RC Y(344.49,D A(1),3,DA, 0)
	15953	"RTN","RCD PEWL7",216 ,0)
	15954	;. K ^TMP ("RCBATCH_ SELECTED", $J)
	15955	"RTN","RCD PEWL7",217 ,0)
	15956	;E D
	15957	"RTN","RCD PEWL7",218 ,0)
	15958	;L -^RCY( 344.4,RCER A,0)
	15959	"RTN","RCD PEWL7",219 ,0)
	15960	WLQ ;
	15961	"RTN","RCD PEWL7",220 ,0)
	15962	L -^RCY(3 44.4,RCERA ,0)
	15963	"RTN","RCD PEWL7",221 ,0)
	15964	Q
	15965	"RTN","RCD PEWL7",222 ,0)
	15966	;
	15967	"RTN","RCD PEWL7",223 ,0)
	15968	PRERA ; Vi ew/Print E RA from ER A list men u
	15969	"RTN","RCD PEWL7",224 ,0)
	15970	N RCSCR
	15971	"RTN","RCD PEWL7",225 ,0)
	15972	S RCSCR=$ $SEL()
	15973	"RTN","RCD PEWL7",226 ,0)
	15974	I RCSCR>0 D PRERA^R CDPEWL0
	15975	"RTN","RCD PEWL7",227 ,0)
	15976	S VALMBCK ="R"
	15977	"RTN","RCD PEWL7",228 ,0)
	15978	Q
	15979	"RTN","RCD PEWL7",229 ,0)
	15980	;
	15981	"RTN","RCD PEWL7",230 ,0)
	15982	BAT(RCERA) ; Select batch, if needed
	15983	"RTN","RCD PEWL7",231 ,0)
	15984	; Returns 1 if batc h selected OK or no batch need ed
	15985	"RTN","RCD PEWL7",232 ,0)
	15986	; RCERA = ien of en try in fil e 344.49
	15987	"RTN","RCD PEWL7",233 ,0)
	15988	N RCINUSE ,RCQUIT,RC ADJ,RC0,RC OK,DIR,DTO UT,DUOUT,X ,Y,Z
	15989	"RTN","RCD PEWL7",234 ,0)
	15990	K ^TMP("R CBATCH_SEL ECTED",$J)
	15991	"RTN","RCD PEWL7",235 ,0)
	15992	S RCOK=1
	15993	"RTN","RCD PEWL7",236 ,0)
	15994	I '$O(^RC Y(344.49,R CERA,3,0)) G BATQ
	15995	"RTN","RCD PEWL7",237 ,0)
	15996	S RC0=$G( ^RCY(344.4 ,RCERA,0))
	15997	"RTN","RCD PEWL7",238 ,0)
	15998	S (RCQUIT ,RCADJ)=0
	15999	"RTN","RCD PEWL7",239 ,0)
	16000	I $$HASAD J^RCDPEWL8 (RCERA) D
	16001	"RTN","RCD PEWL7",240 ,0)
	16002	. S RCADJ =1
	16003	"RTN","RCD PEWL7",241 ,0)
	16004	. S DIR(" A",1)="THI S ERA HAS NEGATIVE A DJUSTMENTS THAT NEED TO BE DIS TRIBUTED T O OTHER",D IR("A",2)= "PAYMENTS ON THE ERA . YOU CAN NOT SELECT ANY INDIV IDUAL BATC HES UNTIL" ,DIR("A",3 )="THE DIS TRIBUTIONS ARE COMPL ETE."
	16005	"RTN","RCD PEWL7",242 ,0)
	16006	. S DIR(" A")="Press ENTER to continue: ",DIR(0)=" EA" W ! D ^DIR K DIR
	16007	"RTN","RCD PEWL7",243 ,0)
	16008	S RCINUSE =+$O(^RCY( 344.49,"AI NUSE",1,RC ERA,0))
	16009	"RTN","RCD PEWL7",244 ,0)
	16010	I RCINUSE D
	16011	"RTN","RCD PEWL7",245 ,0)
	16012	. N OK,Z
	16013	"RTN","RCD PEWL7",246 ,0)
	16014	. Q:RCADJ !$P(RC0,U, 8)
	16015	"RTN","RCD PEWL7",247 ,0)
	16016	. S OK=0 S Z=0 F S Z=$O(^RCY (344.49,RC ERA,3,Z)) Q:'Z I '$ P($G(^RCY( 344.49,RCE RA,3,Z,0)) ,U,5) S OK =1 Q
	16017	"RTN","RCD PEWL7",248 ,0)
	16018	. I 'OK D Q
	16019	"RTN","RCD PEWL7",249 ,0)
	16020	.. S DIR( "A",1)="AL L BATCHES WITHIN THI S ERA ARE CURRENTLY IN USE - T RY AGAIN L ATER",DIR( "A")="Pres s ENTER to continue: ",DIR(0)= "EA" W ! D ^DIR K DI R S RCQUIT =1,RCOK=0 Q
	16021	"RTN","RCD PEWL7",250 ,0)
	16022	. W !!,"A T LEAST 1 BATCH WITH IN THIS ER A IS CURRE NTLY IN US E",!,"AT T HIS TIME, YOU CAN ON LY ACCESS INDIVIDUAL BATCHES", !
	16023	"RTN","RCD PEWL7",251 ,0)
	16024	. D SELBA T^RCDPEWL8 (RCERA,.RC QUIT)
	16025	"RTN","RCD PEWL7",252 ,0)
	16026	. I RCQUI T S RCOK=0
	16027	"RTN","RCD PEWL7",253 ,0)
	16028	E D
	16029	"RTN","RCD PEWL7",254 ,0)
	16030	. Q:$P(RC 0,U,8)!RCA DJ ; Alwa ys require the entir e ERA be u sed
	16031	"RTN","RCD PEWL7",255 ,0)
	16032	. S DIR(0 )="SA^E:(E )NTIRE ERA ;B:(B)ATCH ",DIR("A") ="DO YOU W ANT THE (E )NTIRE ERA OR JUST A (B)ATCH?: " W ! D ^ DIR K DIR
	16033	"RTN","RCD PEWL7",256 ,0)
	16034	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1,RCOK =0 Q
	16035	"RTN","RCD PEWL7",257 ,0)
	16036	. I Y="E" D Q
	16037	"RTN","RCD PEWL7",258 ,0)
	16038	.. S RCQU IT=1 F Z=1 :1:2 L +^R CY(344.4,R CERA,0):5 I $T S RCQ UIT=0 Q
	16039	"RTN","RCD PEWL7",259 ,0)
	16040	.. I RCQU IT S RCOK= 0,DIR(0)=" EA",DIR("A ",1)="ANOT HER USER I S CURRENTL Y USING TH IS ERA, TR Y AGAIN LA TER",DIR(" A")="Press ENTER to continue: " W ! D ^D IR K DIR Q
	16041	"RTN","RCD PEWL7",260 ,0)
	16042	. D SELBA T^RCDPEWL8 (RCERA,.RC QUIT)
	16043	"RTN","RCD PEWL7",261 ,0)
	16044	. I RCQUI T S RCOK=0
	16045	"RTN","RCD PEWL7",262 ,0)
	16046	;
	16047	"RTN","RCD PEWL7",263 ,0)
	16048	BATQ Q RCO K
	16049	"RTN","RCD PEWL7",264 ,0)
	16050	;
	16051	"RTN","RCD PEWL7",265 ,0)
	16052	HELP ; -- help code
	16053	"RTN","RCD PEWL7",266 ,0)
	16054	S X="?" D DISP^XQOR M1 W !!
	16055	"RTN","RCD PEWL7",267 ,0)
	16056	Q
	16057	"RTN","RCD PEWL7",268 ,0)
	16058	;
	16059	"RTN","RCD PEWL8")
	16060	0^19^B1019 93484^B938 21264
	16061	"RTN","RCD PEWL8",1,0 )
	16062	RCDPEWL8 ; ALB/TMK/PJ H - EDI LO CKBOX WORK LIST ERA L EVEL ;Jun 06, 2014@1 9:11:19
	16063	"RTN","RCD PEWL8",2,0 )
	16064	;;4.5;Acc ounts Rece ivable;2 08,269,276 ,298,304,3 18;Mar 2 0, 1995;Bu ild 25
	16065	"RTN","RCD PEWL8",3,0 )
	16066	;;Per VA Directive 6402, this routine s hould not be modifie d.
	16067	"RTN","RCD PEWL8",4,0 )
	16068	Q
	16069	"RTN","RCD PEWL8",5,0 )
	16070	;
	16071	"RTN","RCD PEWL8",6,0 )
	16072	FILESP ; A ction that files the split lin es
	16073	"RTN","RCD PEWL8",7,0 )
	16074	; Assumes RCDIR,RCL INE,RCSCR, RCSPLIT ar ray define d
	16075	"RTN","RCD PEWL8",8,0 )
	16076	N RCTOT,Z ,RCZ0,RCZ1 ,DTOUT,DUO UT,DIR,X,Y ,DIE,DA,DR ,DIC,DD,DO ,DLAYGO,RC Z,RCZZ,RCZ T,VALBCK
	16077	"RTN","RCD PEWL8",9,0 )
	16078	D FULL^VA LM1
	16079	"RTN","RCD PEWL8",10, 0)
	16080	I '$G(^TM P("RCDPE_E OB_SPLIT_O K",$J)) D Q
	16081	"RTN","RCD PEWL8",11, 0)
	16082	. S VALMB CK="R"
	16083	"RTN","RCD PEWL8",12, 0)
	16084	. F Z=2,3 S RCTOT(Z )=$$TOT^RC DPEWL3(Z,. RCSPLIT)
	16085	"RTN","RCD PEWL8",13, 0)
	16086	. S DIR(0 )="EA"
	16087	"RTN","RCD PEWL8",14, 0)
	16088	. S DIR(" A",1)="TOT AL "_$S(+R CTOT(2)'=+ $P(RCDIR,U ,2):"PAYME NTS",1:"AD JUSTMENTS" )_$S(+RCTO T(3)=+$P(R CDIR,U,3): "",+RCTOT( 2)'=+$P(RC DIR,U,2):" AND ADJUS TMENTS",1: "")_" DO N OT MATCH T HE ORIGINA L AMOUNT(s ):"
	16089	"RTN","RCD PEWL8",15, 0)
	16090	. S DIR(" A",2)=$E(" ORIG PAY AMT: "_$J (+$P(RCDIR ,U,2),"",2 )_$J("",35 ),1,35)_" ORIG ADJ A MT: "_$J(+ $P(RCDIR,U ,3),"",2)
	16091	"RTN","RCD PEWL8",16, 0)
	16092	. S DIR(" A",3)=$E(" AMT ENT ERED: "_$J (+RCTOT(2) ,"",2)_$J( "",35),1,3 5)_" AMT ENTERED: " _$J(+RCTOT (3),"",2)
	16093	"RTN","RCD PEWL8",17, 0)
	16094	. S DIR(" A")="PRESS RETURN TO CONTINUE " W ! D ^D IR K DIR
	16095	"RTN","RCD PEWL8",18, 0)
	16096	S DA(1)=R CSCR
	16097	"RTN","RCD PEWL8",19, 0)
	16098	S RCZ0=+$ P(RCLINE,U ,2),RCZZ=+ $G(^RCY(34 4.49,DA(1) ,1,RCZ0,0) ),RCZZ(1)= ""
	16099	"RTN","RCD PEWL8",20, 0)
	16100	S RCZ=+$O (RCSPLIT(0 ))
	16101	"RTN","RCD PEWL8",21, 0)
	16102	;
	16103	"RTN","RCD PEWL8",22, 0)
	16104	;Option t o move/cop y EOB
	16105	"RTN","RCD PEWL8",23, 0)
	16106	I RCZ D Q:$G(VALMB CK)="Q"
	16107	"RTN","RCD PEWL8",24, 0)
	16108	.;;Move/C opy remove d 10/19/11 -now in re ceipt crea tion +136^ RCDPEM
	16109	"RTN","RCD PEWL8",25, 0)
	16110	.;;Q:$$UP DWL^RCDPEM 5($P(RCDIR ,U),.RCSPL IT,RCERA)
	16111	"RTN","RCD PEWL8",26, 0)
	16112	.;;User a bort
	16113	"RTN","RCD PEWL8",27, 0)
	16114	.;;K ^TMP ($J,"RCDPE _SPLIT_FIL E") S VALM BCK="Q"
	16115	"RTN","RCD PEWL8",28, 0)
	16116	;
	16117	"RTN","RCD PEWL8",29, 0)
	16118	I RCZ D
	16119	"RTN","RCD PEWL8",30, 0)
	16120	. S DIE=" ^RCY(344.4 9,"_DA(1)_ ",1,",DA=R CZ0,RCZT=$ P(RCSPLIT( RCZ),U,2)+ $P(RCSPLIT (RCZ),U,3)
	16121	"RTN","RCD PEWL8",31, 0)
	16122	. S DR=". 02////"_$P (RCSPLIT(R CZ),U)_";. 05////"_$J (+$P(RCSPL IT(RCZ),U, 2),"",2)_" ;.06////"_ $J(+RCZT," ",2)_";.08 ////"_$J($ P(RCSPLIT( RCZ),U,3), "",2)
	16123	"RTN","RCD PEWL8",32, 0)
	16124	. S DR=DR _";.07///" _$S($P(RCS PLIT(RCZ), U,5):"/"_$ P(RCSPLIT( RCZ),U,5), 1:"@")_";. 03////"_$S (RCZT'<0:$ J(+RCZT,"" ,2),1:"0.0 0")_$S($P( RCSPLIT(RC Z),U,6)'=" ":";.1///" _$S($P(RCS PLIT(RCZ), U,6)'="@": "/^S X=$P( RCSPLIT(RC Z),U,6)",1 :"@"),1:"" )
	16125	"RTN","RCD PEWL8",33, 0)
	16126	. D ^DIE, UPD^RCDPEW L3(DA(1),D A)
	16127	"RTN","RCD PEWL8",34, 0)
	16128	. I $P(RC DIR,U,3) D
	16129	"RTN","RCD PEWL8",35, 0)
	16130	.. N DA
	16131	"RTN","RCD PEWL8",36, 0)
	16132	.. S DA(2 )=RCSCR,DA (1)=RCZ0,D A=1,DIE="^ RCY(344.49 ,"_DA(2)_" ,1,"_DA(1) _",1,"
	16133	"RTN","RCD PEWL8",37, 0)
	16134	.. S RCZZ (1)=$G(^RC Y(344.49,D A(2),1,DA( 1),1,1,0))
	16135	"RTN","RCD PEWL8",38, 0)
	16136	.. S DR=" .03////"_$ J(+$P(RCSP LIT(RCZ),U ,3),"",2)_ $S($P(RCSP LIT(RCZ),U ,4)'="":". 09////"_$P (RCSPLIT(R CZ),U,4),1 :"")
	16137	"RTN","RCD PEWL8",39, 0)
	16138	.. D ^DIE
	16139	"RTN","RCD PEWL8",40, 0)
	16140	F S RCZ= $O(RCSPLIT (RCZ)) Q:' RCZ D
	16141	"RTN","RCD PEWL8",41, 0)
	16142	. S DIC(0 )="L",DLAY GO=344.491 ,DIC="^RCY (344.49,"_ DA(1)_",1, ",X=+$O(^R CY(344.49, RCSCR,1,"B ",RCZZ\1+. 999),-1)+. 001
	16143	"RTN","RCD PEWL8",42, 0)
	16144	. S DIC(" DR")=".02/ ///"_$P(RC SPLIT(RCZ) ,U)_";.05/ ///"_$J(+$ P(RCSPLIT( RCZ),U,2), "",2)_";.0 8////"_$J( +$P(RCSPLI T(RCZ),U,3 ),"",2)_"; .06////"_$ J($P(RCSPL IT(RCZ),U, 2)+$P(RCSP LIT(RCZ),U ,3),"",2)
	16145	"RTN","RCD PEWL8",43, 0)
	16146	. I $P(RC SPLIT(RCZ) ,U,6)'="" S DIC("DR" )=DIC("DR" )_";.1///" _$S($P(RCS PLIT(RCZ), U,6)'="@": "/^S X=$P( RCSPLIT(RC Z),U,6)",1 :"@")
	16147	"RTN","RCD PEWL8",44, 0)
	16148	. I $P(RC SPLIT(RCZ) ,U,5) S DI C("DR")=DI C("DR")_"; .07////"_$ P(RCSPLIT( RCZ),U,5)
	16149	"RTN","RCD PEWL8",45, 0)
	16150	. K DD,DO D FILE^DI CN K DIC,D LAYGO,DD,D O
	16151	"RTN","RCD PEWL8",46, 0)
	16152	. S RCZ1= +Y
	16153	"RTN","RCD PEWL8",47, 0)
	16154	. I Y D U PD^RCDPEWL 3(RCSCR,RC Z1)
	16155	"RTN","RCD PEWL8",48, 0)
	16156	. I Y,$P( RCDIR,U,3) D
	16157	"RTN","RCD PEWL8",49, 0)
	16158	.. N DA
	16159	"RTN","RCD PEWL8",50, 0)
	16160	.. S DA(2 )=RCSCR,DA (1)=RCZ1,X =1,DIC(0)= "L",DIC="^ RCY(344.49 ,"_DA(2)_" ,1,"_DA(1) _",1,"
	16161	"RTN","RCD PEWL8",51, 0)
	16162	.. S DIC( "DR")=".02 ////"_$P(R CZZ(1),U,2 )_";.03/// /"_$J(+$P( RCSPLIT(RC Z),U,3),"" ,2)_$S($P( RCSPLIT(RC Z),U,4)'=" ":";.09/// /"_$P(RCSP LIT(RCZ),U ,4),$P(RCZ Z(1),U,9)' ="":";.09/ ///"_$P(RC ZZ(1),U,9) ,1:"")
	16163	"RTN","RCD PEWL8",52, 0)
	16164	.. F Z=4: 1:8 I $P(R CZZ(1),U,Z )'="" S DI C("DR")=DI C("DR")_"; "_(Z/100)_ "////"_$P( RCZZ(1),U, Z)
	16165	"RTN","RCD PEWL8",53, 0)
	16166	.. D FILE ^DICN K DI C,DLAYGO,D D,DO
	16167	"RTN","RCD PEWL8",54, 0)
	16168	K ^TMP($J ,"RCDPE_SP LIT_FILE")
	16169	"RTN","RCD PEWL8",55, 0)
	16170	S VALMBCK ="Q"
	16171	"RTN","RCD PEWL8",56, 0)
	16172	Q
	16173	"RTN","RCD PEWL8",57, 0)
	16174	;
	16175	"RTN","RCD PEWL8",58, 0)
	16176	SELBAT(RCE RA,RCQUIT) ; Select a batch
	16177	"RTN","RCD PEWL8",59, 0)
	16178	; If batc h is selec ted, globa l ^TMP("RC BATCH_SELE CTED",$J) is set =
	16179	"RTN","RCD PEWL8",60, 0)
	16180	; batch ien selec ted
	16181	"RTN","RCD PEWL8",61, 0)
	16182	; RCQUIT = 1 if sel ection not made
	16183	"RTN","RCD PEWL8",62, 0)
	16184	; prca4. 5298 per requiremen ts, keep c ode for cr eating/mai ntaining b atches but remove fr om executi on
	16185	"RTN","RCD PEWL8",63, 0)
	16186	Q ;prca* 4.5*298
	16187	"RTN","RCD PEWL8",64, 0)
	16188	N DA,DIC, DIE,DIR,DR ,DTOUT,DUO UT,RCBAT,X ,Y
	16189	"RTN","RCD PEWL8",65, 0)
	16190	S RCQUIT= 0
	16191	"RTN","RCD PEWL8",66, 0)
	16192	S DA(1)=R CERA,DIC(0 )="AEMQ",D IC="^RCY(3 44.49,"_DA (1)_",3,", DIC("S")=" I '$P(^(0) ,U,5)" D ^ DIC
	16193	"RTN","RCD PEWL8",67, 0)
	16194	I Y'>0 S RCQUIT=1 Q
	16195	"RTN","RCD PEWL8",68, 0)
	16196	S RCBAT=+ Y
	16197	"RTN","RCD PEWL8",69, 0)
	16198	L +^RCY(3 44.4,RCERA ,0):5 I '$ T S DIR("A ",1)="ANOT HER USER H AS JUST AC CESSED THE ENTIRE ER A - TRY AG AIN LATER" ,DIR("A")= "PRESS RET URN TO CON TINUE ",DI R(0)="EA" W ! D ^DIR K DIR S R CQUIT=1 Q
	16199	"RTN","RCD PEWL8",70, 0)
	16200	L +^RCY(3 44.49,RCER A,3,RCBAT, 0):5 I '$T !$P($G(^(0 )),U,5) S DIR("A",1) ="ANOTHER USER HAS J UST OPENED THIS BATC H - TRY AG AIN LATER" ,DIR("A")= "PRESS RET URN TO CON TINUE ",DI R(0)=-"EA" W ! D ^DI R K DIR S RCQUIT=1 Q
	16201	"RTN","RCD PEWL8",71, 0)
	16202	S DA=RCBA T,DA(1)=RC ERA,DIE="^ RCY(344.49 ,"_DA(1)_" ,3,",DR=". 05////1" D ^DIE L -^ RCY(344.49 ,RCERA,3,R CBAT,0)
	16203	"RTN","RCD PEWL8",72, 0)
	16204	I $P($G(^ RCY(344.49 ,RCERA,3,R CBAT,0)),U ,3) D
	16205	"RTN","RCD PEWL8",73, 0)
	16206	. S DIR(0 )="EA",DIR ("A",1)="* * WARNING - THIS BAT CH HAS BEE N FLAGGED AS READY T O POST",DI R("A")="PR ESS RETURN TO CONTIN UE " W ! D ^DIR K DI R
	16207	"RTN","RCD PEWL8",74, 0)
	16208	S ^TMP("R CBATCH_SEL ECTED",$J) =RCBAT
	16209	"RTN","RCD PEWL8",75, 0)
	16210	L -^RCY(3 44.4,RCERA ,0)
	16211	"RTN","RCD PEWL8",76, 0)
	16212	Q
	16213	"RTN","RCD PEWL8",77, 0)
	16214	;
	16215	"RTN","RCD PEWL8",78, 0)
	16216	SORT ; Sel ect a new sort for t he list of ERAs
	16217	"RTN","RCD PEWL8",79, 0)
	16218	D FULL^VA LM1
	16219	"RTN","RCD PEWL8",80, 0)
	16220	N RCSORT, DUOUT,DTOU T,DIR,X,Y, RCS1,RCS2, RCORD
	16221	"RTN","RCD PEWL8",81, 0)
	16222	S VALMBCK ="R"
	16223	"RTN","RCD PEWL8",82, 0)
	16224	S DIR("L" ,1)=" SEL ECT A FIRS T LEVEL SO RT",DIR("L ",2)=" "
	16225	"RTN","RCD PEWL8",83, 0)
	16226	S DIR("L" ,3)=" A AMOUNT P AID E ERA PAID DATE"
	16227	"RTN","RCD PEWL8",84, 0)
	16228	S DIR("L" )=" P PAYER NAME D DATE ERA R ECEIVED"
	16229	"RTN","RCD PEWL8",85, 0)
	16230	S DIR(0)= "S^A:AMOUN T PAID;E:E RA PAID DA TE;P:PAYER NAME;D:DA TE ERA REC EIVED",DIR ("B")=$P($ P(DIR(0)," D:",2),";" )
	16231	"RTN","RCD PEWL8",86, 0)
	16232	W ! D ^DI R K DIR
	16233	"RTN","RCD PEWL8",87, 0)
	16234	I $D(DTOU T)!$D(DUOU T) Q
	16235	"RTN","RCD PEWL8",88, 0)
	16236	S RCS1=$S (Y="A":"AP ",Y="E":"D P",Y="P":" PN",1:"DR" )
	16237	"RTN","RCD PEWL8",89, 0)
	16238	S RCORD=$ $ORD(.RCS1 )
	16239	"RTN","RCD PEWL8",90, 0)
	16240	Q:'$D(RCS 1)
	16241	"RTN","RCD PEWL8",91, 0)
	16242	S $P(RCSO RT,U)=(RCS 1_";"_RCOR D)
	16243	"RTN","RCD PEWL8",92, 0)
	16244	K X
	16245	"RTN","RCD PEWL8",93, 0)
	16246	S X(1)=$S (RCS1'="AP ":"A:AMOUN T PAID",1: "E:ERA PAI D DATE")
	16247	"RTN","RCD PEWL8",94, 0)
	16248	S X(2)=$S (RCS1'="AP "&(RCS1'=" DP"):"E:ER A PAID DAT E",1:"P:PA YER NAME")
	16249	"RTN","RCD PEWL8",95, 0)
	16250	S X(3)=$S (RCS1="DR" :"P:PAYER NAME",1:"D :DATE ERA RECEIVED")
	16251	"RTN","RCD PEWL8",96, 0)
	16252	S DIR(0)= "S^N:NONE; "_X(1)_";" _X(2)_";"_ X(3)
	16253	"RTN","RCD PEWL8",97, 0)
	16254	S DIR("B" )="NONE"
	16255	"RTN","RCD PEWL8",98, 0)
	16256	S DIR("L" ,1)=" SEL ECT A SECO ND LEVEL S ORT",DIR(" L",2)=" "
	16257	"RTN","RCD PEWL8",99, 0)
	16258	S DIR("L" ,3)=" N NONE"_$J ("",13)_$P (X(1),":") _" "_$P(X (1),":",2)
	16259	"RTN","RCD PEWL8",100 ,0)
	16260	S DIR("L" )=" "_$ E($P(X(2), ":")_" "_ $P(X(2),": ",2)_$J("" ,20),1,20) _$P(X(3)," :")_" "_$ P(X(3),":" ,2)
	16261	"RTN","RCD PEWL8",101 ,0)
	16262	K X W ! D ^DIR K DI R
	16263	"RTN","RCD PEWL8",102 ,0)
	16264	I $D(DTOU T)!$D(DUOU T) Q
	16265	"RTN","RCD PEWL8",103 ,0)
	16266	S RCS2=$S (Y="N":"N" ,Y="A":"AP ",Y="E":"D P",Y="P":" PN",1:"DR" )
	16267	"RTN","RCD PEWL8",104 ,0)
	16268	S RCORD=$ $ORD(.RCS2 )
	16269	"RTN","RCD PEWL8",105 ,0)
	16270	Q:'$D(RCS 2)
	16271	"RTN","RCD PEWL8",106 ,0)
	16272	S $P(RCSO RT,U,2)=(R CS2_";"_RC ORD)
	16273	"RTN","RCD PEWL8",107 ,0)
	16274	K ^TMP($J ,"RCERA_LI ST") D BLD ^RCDPEWL7( RCSORT)
	16275	"RTN","RCD PEWL8",108 ,0)
	16276	Q
	16277	"RTN","RCD PEWL8",109 ,0)
	16278	;
	16279	"RTN","RCD PEWL8",110 ,0)
	16280	ORD(RCS) ; Select an order for the sorte d field co de in RCS
	16281	"RTN","RCD PEWL8",111 ,0)
	16282	; Kill RC S if nothi ng selecte d, passed by referen ce
	16283	"RTN","RCD PEWL8",112 ,0)
	16284	; Returns '-' if re verse orde r selected
	16285	"RTN","RCD PEWL8",113 ,0)
	16286	N DIR,X,Y ,ORD,RCQUI T
	16287	"RTN","RCD PEWL8",114 ,0)
	16288	S RCQUIT= 0,ORD=""
	16289	"RTN","RCD PEWL8",115 ,0)
	16290	I RCS="N" G ORDQ
	16291	"RTN","RCD PEWL8",116 ,0)
	16292	I RCS="PN " D G ORD Q
	16293	"RTN","RCD PEWL8",117 ,0)
	16294	. S DIR(0 )="SA^F:FI RST TO LAS T;L:LAST T O FIRST"
	16295	"RTN","RCD PEWL8",118 ,0)
	16296	. S DIR(" B")=$P($P( DIR(0),"F: ",2),";")
	16297	"RTN","RCD PEWL8",119 ,0)
	16298	. S DIR(" A")=" SOR T (F)IRST TO LAST OR (L)AST TO FIRST?: "
	16299	"RTN","RCD PEWL8",120 ,0)
	16300	. D ^DIR K DIR
	16301	"RTN","RCD PEWL8",121 ,0)
	16302	. I $D(DU OUT)!$D(DT OUT) S RCQ UIT=1 Q
	16303	"RTN","RCD PEWL8",122 ,0)
	16304	. S ORD=$ S(Y="F":"" ,1:"-")
	16305	"RTN","RCD PEWL8",123 ,0)
	16306	;
	16307	"RTN","RCD PEWL8",124 ,0)
	16308	I RCS="AP " D G ORD Q
	16309	"RTN","RCD PEWL8",125 ,0)
	16310	. S DIR(" A")=" SOR T (L)OWEST TO HIGHES T OR (H)IG HEST TO LO WEST?: "
	16311	"RTN","RCD PEWL8",126 ,0)
	16312	. S DIR(0 )="SA^L:LO WEST TO HI GHEST;H:HI GHEST TO L OWEST"
	16313	"RTN","RCD PEWL8",127 ,0)
	16314	. S DIR(" B")=$P($P( DIR(0),"L: ",2),";")
	16315	"RTN","RCD PEWL8",128 ,0)
	16316	. D ^DIR K DIR
	16317	"RTN","RCD PEWL8",129 ,0)
	16318	. I $D(DU OUT)!$D(DT OUT) S RCQ UIT=1 Q
	16319	"RTN","RCD PEWL8",130 ,0)
	16320	. S ORD=$ S(Y="L":"" ,1:"-")
	16321	"RTN","RCD PEWL8",131 ,0)
	16322	;
	16323	"RTN","RCD PEWL8",132 ,0)
	16324	I RCS="DP "!(RCS="DR ") D G OR DQ
	16325	"RTN","RCD PEWL8",133 ,0)
	16326	. S DIR(" A")=" SOR T (E)ARLIE ST TO LATE ST OR (L)A TEST TO EA RLIEST?: "
	16327	"RTN","RCD PEWL8",134 ,0)
	16328	. S DIR(0 )="SA^E:EA RLIEST TO LATEST;L:L ATEST TO E ARLIEST"
	16329	"RTN","RCD PEWL8",135 ,0)
	16330	. S DIR(" B")=$P($P( DIR(0),"E: ",2),";")
	16331	"RTN","RCD PEWL8",136 ,0)
	16332	. D ^DIR K DIR
	16333	"RTN","RCD PEWL8",137 ,0)
	16334	. I $D(DU OUT)!$D(DT OUT) S RCQ UIT=1 Q
	16335	"RTN","RCD PEWL8",138 ,0)
	16336	. S ORD=$ S(Y="E":"" ,1:"-")
	16337	"RTN","RCD PEWL8",139 ,0)
	16338	;
	16339	"RTN","RCD PEWL8",140 ,0)
	16340	; Invalid sort code
	16341	"RTN","RCD PEWL8",141 ,0)
	16342	S RCQUIT= 1
	16343	"RTN","RCD PEWL8",142 ,0)
	16344	;
	16345	"RTN","RCD PEWL8",143 ,0)
	16346	ORDQ I RCQ UIT K RCS
	16347	"RTN","RCD PEWL8",144 ,0)
	16348	Q ORD
	16349	"RTN","RCD PEWL8",145 ,0)
	16350	;
	16351	"RTN","RCD PEWL8",146 ,0)
	16352	BATDSP ; A sk Display /Hide batc h info on ERA list s creen
	16353	"RTN","RCD PEWL8",147 ,0)
	16354	; prca4. 5298 per requiremen ts, keep c ode for cr eating/mai ntaining b atches but remove fr om executi on
	16355	"RTN","RCD PEWL8",148 ,0)
	16356	Q ;prca* 4.5*298
	16357	"RTN","RCD PEWL8",149 ,0)
	16358	N DIR,DTO UT,DUOUT,R CZ,X,Y
	16359	"RTN","RCD PEWL8",150 ,0)
	16360	D FULL^VA LM1
	16361	"RTN","RCD PEWL8",151 ,0)
	16362	S RCZ=+$G (^TMP("RCE RA_PARAMS" ,$J,"BATCH ON"))
	16363	"RTN","RCD PEWL8",152 ,0)
	16364	S DIR("A" ,1)="BATCH INFO DISP LAY IS CUR RENTLY TUR NED "_$S(' RCZ:"OFF", 1:"ON"),DI R("A")="DO YOU WANT TO TURN IT "_$S('RCZ :"ON",1:"O FF")_" NOW ?: "
	16365	"RTN","RCD PEWL8",153 ,0)
	16366	S DIR(0)= "YA",DIR(" B")="YES" W ! D ^DIR K DIR
	16367	"RTN","RCD PEWL8",154 ,0)
	16368	S VALMBCK ="R"
	16369	"RTN","RCD PEWL8",155 ,0)
	16370	Q:$D(DUOU T)!$D(DTOU T)!'Y
	16371	"RTN","RCD PEWL8",156 ,0)
	16372	S ^TMP("R CERA_PARAM S",$J,"BAT CHON")=$S( RCZ:0,1:1)
	16373	"RTN","RCD PEWL8",157 ,0)
	16374	D BLD^RCD PEWL7($G(^ TMP("RCERA _PARAMS",$ J,"SORT")) )
	16375	"RTN","RCD PEWL8",158 ,0)
	16376	Q
	16377	"RTN","RCD PEWL8",159 ,0)
	16378	;
	16379	"RTN","RCD PEWL8",160 ,0)
	16380	HASADJ(RCS CR,RCOK) ; Function= 1 if WL en try has an y adj not yet distri buted
	16381	"RTN","RCD PEWL8",161 ,0)
	16382	; RCSCR = ien of en try in fil e 344.49
	16383	"RTN","RCD PEWL8",162 ,0)
	16384	; RCOK = if passed by referen ce, return s 1 if ANY postable lines exis t
	16385	"RTN","RCD PEWL8",163 ,0)
	16386	N Z,Z0,RC STOP
	16387	"RTN","RCD PEWL8",164 ,0)
	16388	S RCSTOP= 0,RCOK=0
	16389	"RTN","RCD PEWL8",165 ,0)
	16390	S Z=0 F S Z=$O(^RC Y(344.49,R CSCR,1,Z)) Q:'Z S Z 0=$G(^(Z,0 )) D Q:RC STOP
	16391	"RTN","RCD PEWL8",166 ,0)
	16392	. ;HIPAA 5010 - neg ative valu e now take s preceden ce over ad justment
	16393	"RTN","RCD PEWL8",167 ,0)
	16394	. I $P(Z0 ,U,6)>0!$O (^RCY(344. 49,RCSCR,1 ,Z,1,0)) S RCOK=1
	16395	"RTN","RCD PEWL8",168 ,0)
	16396	. I $P(Z0 ,U,6)<0 S RCSTOP=1
	16397	"RTN","RCD PEWL8",169 ,0)
	16398	Q RCSTOP
	16399	"RTN","RCD PEWL8",170 ,0)
	16400	;
	16401	"RTN","RCD PEWL8",171 ,0)
	16402	VERIF ;EP - Protocol action - RCDPE EOB WORKLIST V ERIFY
	16403	"RTN","RCD PEWL8",172 ,0)
	16404	; Entrypo int to ver ification options
	16405	"RTN","RCD PEWL8",173 ,0)
	16406	N DIR,X,Y ,RCQUIT,DT OUT,DUOUT
	16407	"RTN","RCD PEWL8",174 ,0)
	16408	D FULL^VA LM1
	16409	"RTN","RCD PEWL8",175 ,0)
	16410	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	16411	"RTN","RCD PEWL8",176 ,0)
	16412	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	16413	"RTN","RCD PEWL8",177 ,0)
	16414	. D PAUSE ^VALM1
	16415	"RTN","RCD PEWL8",178 ,0)
	16416	. S VALMB CK="R"
	16417	"RTN","RCD PEWL8",179 ,0)
	16418	I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D NOEDIT^RCD PEWLP G VE RIFQ ;pr ca4.5298 auto-pos ted ERAs c annot ente r VERIFY a ction
	16419	"RTN","RCD PEWL8",180 ,0)
	16420	;
	16421	"RTN","RCD PEWL8",181 ,0)
	16422	W !!!!
	16423	"RTN","RCD PEWL8",182 ,0)
	16424	S RCQUIT= 0
	16425	"RTN","RCD PEWL8",183 ,0)
	16426	F D Q:R CQUIT
	16427	"RTN","RCD PEWL8",184 ,0)
	16428	. W !,"VE RIFY EEOBs :",!,?10," 1",$J("",5 ),"MANUALL Y MARK AS VERIFIED", !,?10,"2", $J("",5)," REPORT OF UNVERIFIED WITH DISC REPANCIES" ,!,?10,"3" ,$J("",5), "QUIT AND RETURN TO WORKLIST"
	16429	"RTN","RCD PEWL8",185 ,0)
	16430	. S DIR(0 )="SAO^1:M ANUAL VERI FICATION;2 :REPORT UN VERIFIED D ISCREPANCI ES;3:QUIT"
	16431	"RTN","RCD PEWL8",186 ,0)
	16432	. S DIR(" A")="Selec t Action: ",DIR("B") ="QUIT" W ! D ^DIR K DIR
	16433	"RTN","RCD PEWL8",187 ,0)
	16434	. I Y=3!( Y="")!$D(D UOUT)!$D(D TOUT) S RC QUIT=1 Q
	16435	"RTN","RCD PEWL8",188 ,0)
	16436	. ;
	16437	"RTN","RCD PEWL8",189 ,0)
	16438	. I Y=1 D MVER^RCDP EV(RCERA) W !! Q
	16439	"RTN","RCD PEWL8",190 ,0)
	16440	. ;
	16441	"RTN","RCD PEWL8",191 ,0)
	16442	. I Y=2 D RPT^RCDPE V0(RCERA) W !! Q
	16443	"RTN","RCD PEWL8",192 ,0)
	16444	;
	16445	"RTN","RCD PEWL8",193 ,0)
	16446	VERIFQ S V ALMBCK="R"
	16447	"RTN","RCD PEWL8",194 ,0)
	16448	Q
	16449	"RTN","RCD PEWL8",195 ,0)
	16450	;
	16451	"RTN","RCD PEWL8",196 ,0)
	16452	BATED ; En try point to batch e dit option s
	16453	"RTN","RCD PEWL8",197 ,0)
	16454	; prca4. 5298 per requireme nts, keep code for c reating/ma intaining batches bu t remove f rom execut ion
	16455	"RTN","RCD PEWL8",198 ,0)
	16456	Q ; prca 4.5298
	16457	"RTN","RCD PEWL8",199 ,0)
	16458	N DA,DIC, DIR,DTOUT, DUOUT,RCQU IT,X,Y
	16459	"RTN","RCD PEWL8",200 ,0)
	16460	D FULL^VA LM1
	16461	"RTN","RCD PEWL8",201 ,0)
	16462	;
	16463	"RTN","RCD PEWL8",202 ,0)
	16464	W !!!!
	16465	"RTN","RCD PEWL8",203 ,0)
	16466	S RCQUIT= 0
	16467	"RTN","RCD PEWL8",204 ,0)
	16468	I '$O(^RC Y(344.49,R CERA,3,0)) W !,"**** * THERE AR E CURRENTL Y NO BATCH ES DEFINED FOR THIS ERA *****" ,!
	16469	"RTN","RCD PEWL8",205 ,0)
	16470	; No menu if enteri ng from a batch leve l
	16471	"RTN","RCD PEWL8",206 ,0)
	16472	I $G(^TMP ("RCBATCH_ SELECTED", $J)) W !," EDITING BA TCH #"_+^T MP("RCBATC H_SELECTED ",$J) D ED IT^RCDPEWL B(RCERA,+^ TMP("RCBAT CH_SELECTE D",$J)) G BATEDQ
	16473	"RTN","RCD PEWL8",207 ,0)
	16474	F D Q:R CQUIT
	16475	"RTN","RCD PEWL8",208 ,0)
	16476	. I '$D(^ XUSEC("PRC A ERA BATC H MAINT",D UZ)) D Q
	16477	"RTN","RCD PEWL8",209 ,0)
	16478	.. S RCQU IT=1
	16479	"RTN","RCD PEWL8",210 ,0)
	16480	.. S DIR( 0)="EA",DI R("A")="YO U DO NOT H AVE SECURI TY ACCESS TO THIS AC TION - Pre ss ENTER t o continue : " W ! D ^DIR K DIR
	16481	"RTN","RCD PEWL8",211 ,0)
	16482	.;
	16483	"RTN","RCD PEWL8",212 ,0)
	16484	. W !,"BA TCH MAINTE NANCE:",!, ?10,"1",$J ("",5),"ED IT BATCH", !,?10,"2", $J("",5)," NEW BATCH ASSIGNMENT ",!,?10,"3 ",$J("",5) ,"MARK ALL READY TO POST",!,?1 0,"4",$J(" ",5),"BATC H SUMMARY REPORT",!, ?10,"5",$J ("",5),"QU IT AND RET URN TO WOR KLIST"
	16485	"RTN","RCD PEWL8",213 ,0)
	16486	. S DIR(0 )="SAO^1:E DIT BATCH; 2:NEW BATC HES;3:MARK ALL;4:BAT CH SUMMARY ;5:QUIT"
	16487	"RTN","RCD PEWL8",214 ,0)
	16488	. S DIR(" A")="Selec t Action: ",DIR("B") ="Quit" W ! D ^DIR K DIR
	16489	"RTN","RCD PEWL8",215 ,0)
	16490	. I Y="5" !(Y="")!$D (DUOUT)!$D (DTOUT) S RCQUIT=1 Q
	16491	"RTN","RCD PEWL8",216 ,0)
	16492	. ;
	16493	"RTN","RCD PEWL8",217 ,0)
	16494	. I Y=1 D W !! Q
	16495	"RTN","RCD PEWL8",218 ,0)
	16496	.. I '$O( ^RCY(344.4 9,RCERA,3, 0)) D NOTS ET^RCDPEWL C Q
	16497	"RTN","RCD PEWL8",219 ,0)
	16498	.. S DIR( "B")="ONE" ,DIR(0)="S A^A:ALL;O: ONE",DIR(" A")="EDIT( A)LL or (O )NE BATCH? : " W ! D ^DIR K DIR
	16499	"RTN","RCD PEWL8",220 ,0)
	16500	.. I $D(D TOUT)!$D(D UOUT) Q
	16501	"RTN","RCD PEWL8",221 ,0)
	16502	.. I Y="A " D EDITAL L^RCDPEWLB (RCERA) Q
	16503	"RTN","RCD PEWL8",222 ,0)
	16504	.. S DA(1 )=RCERA,DI C="^RCY(34 4.49,"_DA( 1)_",3,",D IC(0)="AEM Q" D ^DIC
	16505	"RTN","RCD PEWL8",223 ,0)
	16506	.. Q:Y'>0
	16507	"RTN","RCD PEWL8",224 ,0)
	16508	.. D EDIT ^RCDPEWLB( RCERA,+Y)
	16509	"RTN","RCD PEWL8",225 ,0)
	16510	. ;
	16511	"RTN","RCD PEWL8",226 ,0)
	16512	. I Y=2 D REBATCH^R CDPEWLB(RC ERA) W !! Q
	16513	"RTN","RCD PEWL8",227 ,0)
	16514	. ;
	16515	"RTN","RCD PEWL8",228 ,0)
	16516	. I Y=3 D MARKALL^R CDPEWLB(RC ERA) W !! Q
	16517	"RTN","RCD PEWL8",229 ,0)
	16518	. ;
	16519	"RTN","RCD PEWL8",230 ,0)
	16520	. I Y=4 D SUMRPT^RC DPEWLC(RCE RA) W !! Q
	16521	"RTN","RCD PEWL8",231 ,0)
	16522	;
	16523	"RTN","RCD PEWL8",232 ,0)
	16524	BATEDQ S V ALMBCK="R"
	16525	"RTN","RCD PEWL8",233 ,0)
	16526	Q
	16527	"RTN","RCD PEWL8",234 ,0)
	16528	;
	16529	"RTN","RCD PEWL8",235 ,0)
	16530	AUTOPOST(S OURCE) ;EP Protocol action - R CDPE EOB W ORKLIST MA RK FOR AUT O POST
	16531	"RTN","RCD PEWL8",236 ,0)
	16532	; Input:
	16533	"RTN","RCD PEWL8",237 ,0)
	16534	; SOURC E
	16535	"RTN","RCD PEWL8",238 ,0)
	16536	; 1: Called by Worklist ( RCDPE WORK LIST ERA M ARK FOR AU TO POST)
	16537	"RTN","RCD PEWL8",239 ,0)
	16538	; 2: Called by Scratchpad (RCDPE WO RKLIST EOB MARK FOR AUTO POST)
	16539	"RTN","RCD PEWL8",240 ,0)
	16540	; If SO URCE=2, RC SCR will b e set to t he IEN of 344.4
	16541	"RTN","RCD PEWL8",241 ,0)
	16542	;
	16543	"RTN","RCD PEWL8",242 ,0)
	16544	D FULL^VA LM1
	16545	"RTN","RCD PEWL8",243 ,0)
	16546	I '$D(^XU SEC("RCDPE PP",DUZ)) D Q ; PR CA4.5318 Added sec urity key check
	16547	"RTN","RCD PEWL8",244 ,0)
	16548	. W !!,"T his action can only be taken b y users th at have th e RCDPEPP security k ey.",!
	16549	"RTN","RCD PEWL8",245 ,0)
	16550	. D PAUSE ^VALM1
	16551	"RTN","RCD PEWL8",246 ,0)
	16552	. S VALMB CK="R"
	16553	"RTN","RCD PEWL8",247 ,0)
	16554	;
	16555	"RTN","RCD PEWL8",248 ,0)
	16556	; If call ed by Work list (SOUR CE=1), the n ask whic h ERA
	16557	"RTN","RCD PEWL8",249 ,0)
	16558	; If call ed by Scra tchpad (SO URCE=2), E RA is alre ady in var iable RCSC R
	16559	"RTN","RCD PEWL8",250 ,0)
	16560	N RCERA
	16561	"RTN","RCD PEWL8",251 ,0)
	16562	I SOURCE= 1 S RCERA= $$SEL^RCDP EWL7()
	16563	"RTN","RCD PEWL8",252 ,0)
	16564	I SOURCE= 2 S RCERA= $G(RCSCR)
	16565	"RTN","RCD PEWL8",253 ,0)
	16566	I 'RCERA S VALMBCK= "R" Q
	16567	"RTN","RCD PEWL8",254 ,0)
	16568	;
	16569	"RTN","RCD PEWL8",255 ,0)
	16570	N AUTOPOS T
	16571	"RTN","RCD PEWL8",256 ,0)
	16572	S AUTOPOS T=$$AUTOCH K2^RCDPEAP 1(RCERA)
	16573	"RTN","RCD PEWL8",257 ,0)
	16574	I AUTOPOS T D
	16575	"RTN","RCD PEWL8",258 ,0)
	16576	. D SETST A^RCDPEAP( RCERA,0,"W orklist: M arked as A uto-Post C andidate")
	16577	"RTN","RCD PEWL8",259 ,0)
	16578	. W !,"ER A has been successfu lly Marked as an Aut o-Post CAN DIDATE"
	16579	"RTN","RCD PEWL8",260 ,0)
	16580	I 'AUTOPO ST D
	16581	"RTN","RCD PEWL8",261 ,0)
	16582	. D AUDIT LOG^RCDPEA P(RCERA,"" ,"Worklist : Not Mark ed as Auto -Post Cand idate-"_$P (AUTOPOST, U,2))
	16583	"RTN","RCD PEWL8",262 ,0)
	16584	. W !,"ER A was NOT Marked as an Auto-Po st CANDIDA TE - ",$P( AUTOPOST,U ,2)
	16585	"RTN","RCD PEWL8",263 ,0)
	16586	;
	16587	"RTN","RCD PEWL8",264 ,0)
	16588	AUTOPSTQ ;
	16589	"RTN","RCD PEWL8",265 ,0)
	16590	K DIR
	16591	"RTN","RCD PEWL8",266 ,0)
	16592	S DIR(0)= "E" D ^DIR
	16593	"RTN","RCD PEWL8",267 ,0)
	16594	S VALMBCK ="R"
	16595	"RTN","RCD PEWL8",268 ,0)
	16596	Q
	16597	"VER")
	16598	8.0^22.2
	16599	"^DD",344. 31,344.31, .02,0)
	16600	PAYER NAME ^FJ60^^0;2 ^K:$L(X)>6 0!($L(X)<1 ) X
	16601	"^DD",344. 31,344.31, .02,1,0)
	16602	^.1^^0
	16603	"^DD",344. 31,344.31, .02,3)
	16604	Answer mus t be 1-60 characters in length .
	16605	"^DD",344. 31,344.31, .02,21,0)
	16606	^.001^1^1^ 3100621^^^
	16607	"^DD",344. 31,344.31, .02,21,1,0 )
	16608	This is th e insuranc e co name as reporte d for the payment on the EFT.
	16609	"^DD",344. 31,344.31, .02,"DT")
	16610	3170310
	16611	"^DD",344. 4,344.4,.0 6,0)
	16612	PAYMENT FR OM^FJ60^^0 ;6^K:$L(X) >60!($L(X) <1) X
	16613	"^DD",344. 4,344.4,.0 6,1,0)
	16614	^.1^^0
	16615	"^DD",344. 4,344.4,.0 6,3)
	16616	Answer mus t be 1-60 characters in length .
	16617	"^DD",344. 4,344.4,.0 6,21,0)
	16618	^.001^1^1^ 3141217^^
	16619	"^DD",344. 4,344.4,.0 6,21,1,0)
	16620	This is th e name of the insura nce co as returned o n the ERA.
	16621	"^DD",344. 4,344.4,.0 6,"DT")
	16622	3170310
	16623	"BLD",1046 1,6)
	16624	14^
	16625	END
	16626	END
	16627
	16628