28. EPMO Open Source Coordination Office Redaction File Detail Report

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

28.1 Files compared

#	Location	File	Last Modified
1	docs	TAS ePay US786 SDD - Copy.doc	Mon Oct 22 16:27:48 2018 UTC
2	docs	TAS ePay US786 SDD - Copy.doc	Mon Oct 22 16:33:02 2018 UTC

28.2 Comparison summary

Description	Between Files 1 and 2
Description	Text Blocks	Lines
Unchanged	21	10130
Changed	20	62
Inserted	0	0
Removed	0	0

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

28.4 Active regular expressions

No regular expressions were active.

28.5 Comparison detail

	1	MCCF EDI T AS US786
	2	System Des ign Docume nt
	3	PRCA4.53 26
	4
	5	Department of Vetera ns Affairs
	6	January 20 18
	7	Version 1
	8	User Story Number: U S786
	9	User Story Name: Ne ed the cap ability to sort all 3rd Party EDI lockbo x reports and option s for Tric are/ChampV A
	10	Sizing: 1 3
	11	Epic Taxon omy eBiz C ompliance Port Updat e Incre ase No Tou ch TAS Ap psStory
	12	As a...I w ant to...S o that...e Pay UserNe ed the cap ability to sort all 3rd Party EDI lockbo x reports and option s by Medic al, Pharma cy, and Tr icare repo rting has a standard ized Medic al, Pharma cy, and Tr icare sort functionC onversatio n (if desi red by dev elopers)
	13	Standardiz e filterin g based on the ERA w orklist fu nctionalit y:
	14	(M)EDICAL, (P)HARMAC Y, (T)RICA RE or (A)L L: A// - the M/P/T filter
	15	If a repor t is filte red by thi s option, then the a bility to select by Payer name and/or TI N will be restricted to within that opti on selecte d.
	16	Summary
	17	The M/P/T filter wil l be added to EDI LO CKBOX repo rts. If t he report already ha d an exist ing filter that was similar (e .g. Medica l or Pharm acy filter ) it will be replace d by the n ew M/P/T f ilter. In addition, if the re port has a Payer Nam e/TIN filt er the M/P /T filter will be as ked prior to the Pay er Name/TI N filter a nd the Pay er Name/TI N filter w ill not di splay any Payer Name s/TINs tha t don’t ma tch the M/ PT/ filter .
	18	Additional ly, any ex isting fil ters for ‘ CHAMPVA’ .
	19	Reports an d Worklist s to be Mo dified
	20	All report s on the E DI LOCKBOX REPORTS M ENU except the EFT T ransaction Audit Rep ort (which operates on a singl e selected EFT).
	21	The EDI Lo ckbox 3rd Party Exce ptions and Auto-Post Awaiting Resolution worklists .
	22	OptionInte rnal Optio n NameRout inesActive Bills Wit h EEOB Rep ortRCDPE A CTIVE WITH EEOB REPO RTRCDPEACA uto-Post A waiting Re solutionRC DPE APARRC DPEAA1Auto -Decrease Adjustment reportRCD PE AUTO-DE CREASE REP ORTRCDPEAD P RCDPEAD1 Auto-Poste d Receipt ReportRCDP E AUTO-POS T RECEIPT REPORTRCDP ELARAuto-P ost Report RCDPE AUTO -POST REPO RTRCDPEAPP
	23	RCDPEAPQ83 5 CARC Dat a ReportRC DPE CARC C ODE PAYER REPORTRCDP ARCEFT Dai ly Activit y ReportRC DPE EDI LO CKBOX ACT REPORTRCDP EDAREEOB M ove/Copy/R emove Audi t ReportRC DPE EEOB M OVE/COPY/R MOVE RPTRC DPEM4EFT U nmatched A ging Repor tRCDPE EFT AGING REP ORTRCDPEAR 2Duplicate EFT Depos its Audit ReportRCDP E EFT AUDI T REPORTRC DPEM6EFT/E RA TRENDIN G ReportRC DPE EFT-ER A TRENDING REPORTRCD PENR2
	24	RCDPENR3
	25	RCDPENR4ER A Unmatche d Aging Re portRCDPE ERA AGING REPORTRCDP EAR1ERA St atus Chang e Audit Re portRCDPE ERA STATUS CHNG AUD REPRCDPEAP SERAs Post ed with Pa per EOB Au dit Report RCDPE ERA W/PAPER EO B REPORTRC DPEM4EDI L ockbox 3rd Party Exc eptionsRCD PE EXCEPTI ON PROCESS INGRCDPEX1
	26	RCDPEX2Pay er Impleme ntation Re portRCDPE PAYER EXCL USION NAME TINRCDPES P3Provider Level Adj ustments ( PLB) Repor tRCDPE PRO VIDER LVL ADJ REPORT RCDPPLBRem ove ERA fr om Active Worklist A udit Repor tRCDPE REM OVED ERA A UDITRCDPEM 3Unapplied EFT Depos its Report RCDPE UNAP PLIED EFT DEP REPORT RCDPE8NZOt her Change s
	27	Parameter RCDPE APAR . Add TRI CARE to fi lter and c onvert “BO TH” to “AL L” in the patch post install.
	28	Routines t o Modify
	29	* Note cop ies of all routines with draft coding ch anges have been save d with a p refix of Z ZCJE.
	30	RCDPEU1 - New
	31	Add new ut ility func tions for payer filt ers, selec tion and c hecks.
	32	RCDPEAC - Modified
	33	Change exi sting BOTH , MEDICAL, PHARMACY selection to MEDICAL , PHARMACY , TRICARE, ALL. Chan ge INCLUDE subroutin e to use n ew check b ased on fl ags in pay er exclusi on file [# 344.6]. C hange Head er to remo ve old CHA MPVA and T RICARE fil ter refere nces and a dd Tricare to MEDICA L/PHARMACY /BOTH in h eader.
	34	(**Note th e report u ses insura nce compan y selectio n from fil e 36 and t here is no way to cr oss check selections between f ile 36 and file 344. 6).
	35	RCDPEAA1 - Modified
	36	Modify pro mpt for Me dical/Phar macy filte r to inclu de Tricare and use t he new fil ter based on flags i n file 344 .6. Move t ype filter before pa yer range in case we need to u se type in the payer selection filter. C urrently p ayer range selection is by alp habetic ra nge which is stored in a syste m paramete r for the preferred view. This remains u nchanged a t the time of writin g.
	37	RCDPEADP a nd RCDPEAD 1 - Modifi ed
	38	Prompt for payer typ e and chec k if payer from ERA matches th e selected type.
	39	RCDPELAR - Modified
	40	Add filter by payer type, re-w ork payer selection to filter by selecte d type. F ilter repo rt based o n new crit eria. Add payer sele ction ^TMP global to ZTSAVE.
	41	RCDPEAPP a nd RCDPEAP Q – Modifi ed
	42	Add payer type filte r. Standa rdise paye r selectio n via new utilities. Pass pay er selecti on ^TMP gl obal into background job via Z TSAVE. Use new filte r logic in report co mpilation.
	43	RCDPARC – Modified
	44	Add new pa yer type f ilter. Re work payer selection , which wa s by NAME and TIN to use same payer sele ction as R CDPEAPP, i .e. ask se lected pay ers by NAM E or TIN f irst. Pas s payer se lections i n ^TMP to background task usin g ZTSAVE. User new f ilters in report com pilation.
	45	RCDPEDAR - Modified
	46	Add new fi lter by pa yer type. Standardi se payer s election u sing new u tilities. Pass new payer sele ctions in ^TMP to ba ckground t ask using ZTSAVE. Us e new filt ers in rep ort compil ation.
	47	RCDPEM4 – Modified
	48	Add payer type filte r and use it in repo rt compila tion.
	49	RCDPEAR2 – Modified
	50	Add new pa yer type f ilter. St andardize payer sele ction usin g new util ities. Pa ss payer s elections in ^TMP to backgroun d task usi ng ZTSAVE. Use new filters in report co mpilation.
	51	RCDPEM6 - Modified
	52	Add filter by payer type and u se it in r eport comp ilation.
	53	RCDPENR2, RCDPENR3, RCDPENR4 – Modified
	54	Add filter by payer type. Sta ndardize p ayer selec tion using new utili ties. Pass payer sel ections in ^TMP into backgroun d job usin g ZTSAVE. Use new f ilters in report com pilation.
	55	RCDPEAR1 - Modified
	56	Add filter by payer type. Sta ndardize p ayer selec tion using new utili ties. Pass payer sel ections in ^TMP into backgroun d job usin g ZTSAVE. Use new f ilters in report com pilation.
	57	RCDPEAPS - Modified
	58	Add filter by payer type and u se it in r eport comp ilation.
	59	RCDPEX1 an d RCDPEX2 - Modified
	60	Add filter by payer type. Sta ndardize p ayer selec tion using new utili ties. Use new filte rs in work list compi lation.
	61	RCDPESP3 - Modified
	62	Add filter by payer type and u se it in r eport comp ilation.
	63	RCDPPLB - Modified
	64	Add new pa yer type f ilter. Re work payer selection , which wa s by NAME and TIN to use same payer sele ction as R CDPEAPP, i .e. ask se lected pay ers by NAM E or TIN f irst. Pass payer sel ections in ^TMP to b ackground task using ZTSAVE. U ser new fi lters in r eport comp ilation.
	65	RCDPEM3 - Modified
	66	Add filter by payer type and u se it in r eport comp ilation. R emove old Tricare an d ChampVA filters.
	67	RCDPE8NZ - Modified
	68	Add filter by payer type and u se it in r eport comp ilation.
	69	Resolution – Added C hanged Obj ects
	70	RoutinesAc tivitiesRo utine Name RCDPARCEnh ancement C ategory Ne w Modify D elete No C hangeRTMRe lated Opti onsRCDPE C ARC CODE P AYER REPOR TRelated R outinesRou tines “Cal led By”Rou tines “Cal led” RCD PPLB (When tasked)GC ARC^RCDPCR R
	71	$$CHECKDT^ RCDPRU
	72	$$DATE^RCD PRU
	73	$$GETPAY^R CDPRU
	74	$$GETTIN^R CDPRU
	75	$$NOW^RCDP RU
	76	$$VAL^RCDP RU
	77	ASK^RCDPRU
	78	RNG^RCDPRU
	79	$$CHK^RCDP RU2
	80	$$GPAYR^RC DPRU2
	81	$$PAYTIN^R CDPRU2
	82	PAYLIST^RC DPRU2
	83	PAYTINS^RC DPRU2
	84	SUM^RCDPRU 2 Current Lo gic - RCDP ARCRCDPARC ;ALB/TJB - CARC REP ORT ON PAY ER OR CARC CODE ;9/1 5/14 3:00p m
	85	;;4.5;Acc ounts Rece ivable;3 03,321;M ar 20, 199 5;Build 84
	86	;;Per VA Directive 6402, this routine s hould not be modifie d.
	87	Q
	88	; PRCA4. 5303 - CA RC and Pay er report
	89	; DESCRIP TION :
	90	; The fol lowing gen erates a r eport that displays selected o r all
	91	; CARC Co des and Pa yers and t otals the amounts fo r each CAR C code.
	92	; several filters m ay be used to limit the CARC c odes or Pa yer inform ation
	93	; to be d isplayed:
	94	EN ; Entry point for Report
	95	N DUOUT,D TOUT,DIR,X ,Y,RCDT1,R CDT2,RCDET ,ZTRTN,ZTS K,ZTDESC,Z TSAVE,ZTST OP,%ZIS,PO P,DTOK,DIV HDR,CRHDR
	96	N RCDIV,R CINC,VAUTD ,RCRANGE,R CNP,RCJOB, RCNP1,RCPG ,RCNOW,RCH R,RCODE,RC RARC,RCSTO P,EX
	97	S RCRARC= 0,RCSTOP=0
	98	; ICR 107 7 - Get di vision/sta tion
	99	D DIVISIO N^VAUTOMA
	100	I 'VAUTD& ($D(VAUTD) '=11) G AR CQ
	101	;
	102	S DIR("A" )="(S)umma ry or(D)et ail Report format?: ",DIR(0)=" SA^S:Summa ry Informa tion only; D:Detail a nd Totals"
	103	S DIR("B" )="SUMMARY " D ^DIR K DIR
	104	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	105	S RCDET=( $E(Y,1)="D ")
	106	; Get CAR C Codes fo r report
	107	D GCARC^R CDPCRR(.RC ODE) G:RCS TOP ARCQ
	108	;
	109	;I RCDET D G:$D(DTO UT)!$D(DUO UT)!(Y="") ARCQ ; Se e if User wants RARC s displaye d on Detai led report
	110	;. S DIR( 0)="YA",DI R("A")="Di splay avai lable RARC s on Detai led Report ? (Y/N): " ,DIR("B")= "No"
	111	;. D ^DIR K DIR
	112	;. I $D(D TOUT)!$D(D UOUT)!(Y=" ") Q
	113	;. S RCRA RC=(Y=1)
	114	S RCRARC= 0 ; Set RA RCs not to display o n report, but keep a round just in case S usan chang es her min d.
	115	;
	116	; Get Pay er informa tion
	117	S EX=$$GE TPAY^RCDPR U(.RCPAY)
	118	G:EX=0 AR CQ
	119	;
	120	; Get Pay er TIN inf ormation
	121	S EX=$$GE TTIN^RCDPR U(.RCTIN)
	122	G:EX=0 AR CQ
	123	;
	124	S DIR("A" )="Sort Re port by (C )ARC or (P )ayer?: ", DIR(0)="SA ^P:Payer N ame;CARC: CARC Codes ;C:CARC Co des"
	125	S DIR("B" )="CARC" D ^DIR K DI R
	126	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	127	S RCSORT= $E(Y,1)
	128	;
	129	S DIR("?" )="Enter t he Beginni ng date fo r the repo rt"
	130	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date: ",DIR("B") ="T" D ^DI R K DIR
	131	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	132	S RCDT1=Y
	133	S DIR("?" )="Enter t he end dat e for the report"
	134	S DIR("B" )=$$DATE^R CDPRU($P($ $NOW^XLFDT ,"."),"2Z" )
	135	S DIR(0)= "DAO^"_RCD T1_":"_DT_ ":APE",DIR ("A")="End Date: ",D IR("B")="T " D ^DIR K DIR
	136	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	137	S RCDT2=Y
	138	S DTOK=$$ CHECKDT^RC DPRU(RCDT1 ,RCDT2,361 .1)
	139	I 'DTOK W !!,"* N ote: Date Range "_$$ DATE^RCDPR U(RCDT1)_" - "_$$DAT E^RCDPRU(R CDT2)," ",! W "* * No Recor ds found * **",! D AS K^RCDPRU(. RCSTOP) G ARCQ
	140	; Get inp ut to expo rt to exce l. Removed per Susan (03/24/20 15)
	141	S RCEXCEL =0
	142	;S RCEXCE L=$$DISPTY ^RCDPRU()
	143	;D:RCEXCE L INFO^RCD PRU
	144	;
	145	S %ZIS="Q M" D ^%ZIS Q:POP
	146	I $D(IO(" Q")) D Q
	147	. S ZTRTN ="ENQ^RCDP ARC",ZTDES C="AR - 83 5 CARC & P AYER DATA REPORT",ZT SAVE("*")= ""
	148	. D ^%ZTL OAD
	149	. W !!,$S ($D(ZTSK): "Your task number"_Z TSK_" has been queue d.",1:"Una ble to que ue this jo b.")
	150	. K ZTSK, IO("Q") D HOME^%ZIS
	151	U IO
	152	;
	153	.
	154	.
	155	.
	156	GETDATA(GC ARC,GPAYER ,GTIN,GSOR T,GRARC,GS TART,GSTOP ,GARRAY,GD IV) ;
	157	; Input: GCCARC - R ange of CA RC codes t o include
	158	; GPAYER - Range of payers to include
	159	; GTIN - Range of T INs to inc lude
	160	; GSORT - Sort orde r
	161	; GRARC - Flag to d isplay RAR C codes on the repor t (0 = No)
	162	; GSTART - Start da te
	163	; GSTOP - End date
	164	; GARRAY - Root of the array in which t o store th e output d ata
	165	; GDIV - Range of D ivisions t o include
	166	; Output: @GARRAY(" BILLS",IEN ,0)=A1^A2^ A3^A4^A5^A 6^A7
	167	; A1=Poin ter to BIL L/CLAIM fi le (#399)
	168	; A2=Bill Number
	169	; A3=Poin ter to pat ient file (#2)
	170	; A4=Paye r Name fro m EOB, poi nter to In surance fi le (#36)
	171	; A5=TIN from EOB
	172	; A6=Tota l Charges
	173	; A7=Paid amount
	174	;
	175	N SDT,IEN ,CNT,ZX,RM ,ZND,CARR, PNARR,PTAR R,RCSET,GL INE,DZN,PT R,ZPAY,RCE RR,RCDEN
	176	S SDT=$O( ^IBM(361.1 ,"E",GSTAR T),-1)
	177	; Set up the arrays for filte ring on CA RC, PAYER name and P ayer TINs
	178	D RNG^RCD PRU("CARC" ,GCARC,.CA RR)
	179	D RNG^RCD PRU("PAYER ",GPAYER(" DATA"),.PN ARR)
	180	I $G(PNAR R("PAYER") )'="ALL" D ;
	181	. N XARR, ZARR
	182	. MERGE X ARR=PNARR( "PAYER")
	183	. D PAYLI ST^RCDPRU2 (.XARR,"E" ,.ZARR) ; PRCA4.53 21 - Expan d payer li st to incl ude all wi th same TI N
	184	. MERGE P NARR("PAYE R")=ZARR
	185	D RNG^RCD PRU("TIN", GTIN("DATA "),.PTARR)
	186	;Get poss ible bills to work o n from ^IB M(361.1,"E ") index
	187	F S SDT= $O(^IBM(36 1.1,"E",SD T)) Q:SDT= ""!(SDT>GS TOP) D
	188	. S IEN=" " F S IEN =$O(^IBM(3 61.1,"E",S DT,IEN)) Q :IEN="" D
	189	.. S RM=$ $GET1^DIQ( 361.1,IEN_ ",",102,"I ") Q:$G(RM )=1 ; Quit looking i f this EOB is remove d
	190	.. ; If n ot all div isions the n check to see if th is EOB sho uld be inc luded
	191	.. I GDIV =0 S RCDIV ="",RCDEN= $$GET1^DIQ (361.1,IEN _",",.01," I") S:RCDE N'="" RCDI V=$$GET1^D IQ(399,RCD EN_",",.22 ,"I") Q:RC DIV="" Q: $G(GDIV(RC DIV))=""
	192	.. ; Get the data f or this cl aim and 83 5 Payer
	193	.. S ZND= ^IBM(361.1 ,IEN,0),PT R=$P(ZND,U ,1),ZPAY=$ $GPAYR^RCD PRU2($P(ZN D,U,3))
	194	.. S RCSE T=1
	195	.. ; Are there CARC codes for this reco rd
	196	.. S:($G( ^IBM(361.1 ,IEN,10,0) )']"")&($G (^IBM(361. 1,IEN,15,0 ))']"") RC SET=0
	197	.. ; Is t he PAYER i ncluded in the list
	198	.. S:'$$C HK^RCDPRU2 ("PAYER",Z PAY,.PNARR ) RCSET=0
	199	.. ; Is t he payer T IN include d in the l ist
	200	.. S:'$$C HK^RCDPRU2 ("TIN",$P( ZND,U,3)_" ",.PTARR) RCSET=0
	201	.. Q:RCSE T=0 ; No n eed to che ck further get next IEN
	202	.. ; Poin ter to the bill (^DG CR(399,))^ KBill #^Pa tient poin ter^Payer Pointer [^ DIC(36)]^P ayer ID/TI N^Total Ch arges^Paid Amount
	203	.. S DZN= $G(^DGCR(3 99,PTR,0))
	204	.
	205	.
	206	.Modified Logic (Cha nges are i n bold) - RCDPARCRCD PARC ;ALB/ TJB - CARC REPORT ON PAYER OR CARC CODE ;9/15/14 3 :00pm
	207	;;4.5;Acc ounts Rece ivable;3 03,321;M ar 20, 199 5;Build 84
	208	;;Per VA Directive 6402, this routine s hould not be modifie d.
	209	Q
	210	; PRCA4. 5303 - CA RC and Pay er report
	211	; DESCRIP TION :
	212	; The fol lowing gen erates a r eport that displays selected o r all
	213	; CARC Co des and Pa yers and t otals the amounts fo r each CAR C code.
	214	; several filters m ay be used to limit the CARC c odes or Pa yer inform ation
	215	; to be d isplayed:
	216	EN ; Entry point for Report
	217	N DUOUT,D TOUT,DIR,X ,Y,RCDT1,R CDT2,RCDET ,ZTRTN,ZTS K,ZTDESC,Z TSAVE,ZTST OP,%ZIS,PO P,DTOK,DIV HDR,CRHDR
	218	N RCDIV,R CINC,VAUTD ,RCRANGE,R CNP,RCJOB, RCNP1,RCPG ,RCNOW,RCH R,RCODE,RC PAR,RCPAY, RCRARC,RCS TOP,RCWHIC H,EX
	219	S RCRARC= 0,RCSTOP=0
	220	; ICR 107 7 - Get di vision/sta tion
	221	D DIVISIO N^VAUTOMA
	222	I 'VAUTD& ($D(VAUTD) '=11) G AR CQ
	223	;
	224	S DIR("A" )="(S)umma ry or(D)et ail Report format?: ",DIR(0)=" SA^S:Summa ry Informa tion only; D:Detail a nd Totals"
	225	S DIR("B" )="SUMMARY " D ^DIR K DIR
	226	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	227	S RCDET=( $E(Y,1)="D ")
	228	; Get CAR C Codes fo r report
	229	D GCARC^R CDPCRR(.RC ODE) G:RCS TOP ARCQ
	230	;
	231	;I RCDET D G:$D(DTO UT)!$D(DUO UT)!(Y="") ARCQ ; Se e if User wants RARC s displaye d on Detai led report
	232	;. S DIR( 0)="YA",DI R("A")="Di splay avai lable RARC s on Detai led Report ? (Y/N): " ,DIR("B")= "No"
	233	;. D ^DIR K DIR
	234	;. I $D(D TOUT)!$D(D UOUT)!(Y=" ") Q
	235	;. S RCRA RC=(Y=1)
	236	S RCRARC= 0 ; Set RA RCs not to display o n report, but keep a round just in case S usan chang es her min d.
	237	;
	238	S RCLAIM= $$RTYPE^RC DPEU1("A") G:RCLAIM= -1 ARCQ ; Payer Type
	239	; Get Pay er informa tion
	240	S RCWHICH =$$NMORTIN ^RCDPEAPP( ) G:RCWHIC H=-1 ARCQ ; Filter b y Payer Na me or TIN
	241	;
	242	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1(1,1,RC WHICH) ; U S786 - Sel ected or R ange of Pa yers
	243	G:RCPAR(" SELC")=-1 ARCQ ; US7 86 '^' or timeout
	244	S RCPAY=R CPAR("SELC ")
	245	;
	246	I RCPAR(" SELC")'="A " D G:XX= -1 ARCQ ; US786 - Si nce we don 't want al l payers
	247	. S RCPAR ("TYPE")=R CLAIM
	248	. S RCPAR ("SRCH")=$ S(RCWHICH= 2:"T",1:"N ") ; promp t for paye rs we do w ant
	249	. S RCPAR ("FILE")=3 44.4
	250	. S RCPAR ("DICA")=" Select Ins urance Com pany"_$S(R CWHICH=1:" NAME: ",1 :" TIN: ")
	251	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	252	; S EX=$$ GETPAY^RCD PRU(.RCPAY )
	253	; G:EX=0 ARCQ
	254	;
	255	; Get Pay er TIN inf ormation
	256	; S EX=$$ GETTIN^RCD PRU(.RCTIN )
	257	; G:EX=0 ARCQ
	258	;
	259	S DIR("A" )="Sort Re port by (C )ARC or (P )ayer?: ", DIR(0)="SA ^P:Payer N ame;CARC: CARC Codes ;C:CARC Co des"
	260	S DIR("B" )="CARC" D ^DIR K DI R
	261	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	262	S RCSORT= $E(Y,1)
	263	;
	264	S DIR("?" )="Enter t he Beginni ng date fo r the repo rt"
	265	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date: ",DIR("B") ="T" D ^DI R K DIR
	266	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	267	S RCDT1=Y
	268	S DIR("?" )="Enter t he end dat e for the report"
	269	S DIR("B" )=$$DATE^R CDPRU($P($ $NOW^XLFDT ,"."),"2Z" )
	270	S DIR(0)= "DAO^"_RCD T1_":"_DT_ ":APE",DIR ("A")="End Date: ",D IR("B")="T " D ^DIR K DIR
	271	I $D(DTOU T)!$D(DUOU T)!(Y="") G ARCQ
	272	S RCDT2=Y
	273	S DTOK=$$ CHECKDT^RC DPRU(RCDT1 ,RCDT2,361 .1)
	274	I 'DTOK W !!,"* N ote: Date Range "_$$ DATE^RCDPR U(RCDT1)_" - "_$$DAT E^RCDPRU(R CDT2)," ",! W "* * No Recor ds found * **",! D AS K^RCDPRU(. RCSTOP) G ARCQ
	275	; Get inp ut to expo rt to exce l. Removed per Susan (03/24/20 15)
	276	S RCEXCEL =0
	277	;S RCEXCE L=$$DISPTY ^RCDPRU()
	278	;D:RCEXCE L INFO^RCD PRU
	279	;
	280	S %ZIS="Q M" D ^%ZIS Q:POP
	281	I $D(IO(" Q")) D Q
	282	. S ZTRTN ="ENQ^RCDP ARC",ZTDES C="AR - 83 5 CARC & P AYER DATA REPORT"
	283	. S ZTSAV E("*")=""
	284	. S ZTSAV E("^TMP("" RCDPEU1"", $J,")=""
	285	. D ^%ZTL OAD
	286	. W !!,$S ($D(ZTSK): "Your task number"_Z TSK_" has been queue d.",1:"Una ble to que ue this jo b.")
	287	. K ZTSK, IO("Q") D HOME^%ZIS
	288	U IO
	289	;
	290	.
	291	.
	292	.
	293	GETDATA(GC ARC,GPAYER ,GTIN,GSOR T,GRARC,GS TART,GSTOP ,GARRAY,GD IV) ;
	294	; Input: GCCARC - R ange of CA RC codes t o include
	295	; GPAYER - Range of payers to include
	296	; GTIN - Range of T INs to inc lude
	297	; GSORT - Sort orde r
	298	; GRARC - Flag to d isplay RAR C codes on the repor t (0 = No)
	299	; GSTART - Start da te
	300	; GSTOP - End date
	301	; GARRAY - Root of the array in which t o store th e output d ata
	302	; GDIV - Range of D ivisions t o include
	303	; Output: @GARRAY(" BILLS",IEN ,0)=A1^A2^ A3^A4^A5^A 6^A7
	304	; A1=Poin ter to BIL L/CLAIM fi le (#399)
	305	; A2=Bill Number
	306	; A3=Poin ter to pat ient file (#2)
	307	; A4=Paye r Name fro m EOB, poi nter to In surance fi le (#36)
	308	; A5=TIN from EOB
	309	; A6=Tota l Charges
	310	; A7=Paid amount
	311	;
	312	N SDT,IEN ,CNT,ZX,RM ,ZND,CARR, PNARR,PTAR R,RCSET,GL INE,DZN,PT R,ZPAY,RCE RR,RCDEN
	313	S SDT=$O( ^IBM(361.1 ,"E",GSTAR T),-1)
	314	; Set up the arrays for filte ring on CA RC, PAYER name and P ayer TINs
	315	D RNG^RCD PRU("CARC" ,GCARC,.CA RR)
	316	D RNG^RCD PRU("PAYER ",GPAYER(" DATA"),.PN ARR)
	317	I $G(PNAR R("PAYER") )'="ALL" D ;
	318	. N XARR, ZARR
	319	. MERGE X ARR=PNARR( "PAYER")
	320	. D PAYLI ST^RCDPRU2 (.XARR,"E" ,.ZARR) ; PRCA4.53 21 - Expan d payer li st to incl ude all wi th same TI N
	321	. MERGE P NARR("PAYE R")=ZARR
	322	D RNG^RCD PRU("TIN", GTIN("DATA "),.PTARR)
	323	;Get poss ible bills to work o n from ^IB M(361.1,"E ") index
	324	F S SDT= $O(^IBM(36 1.1,"E",SD T)) Q:SDT= ""!(SDT>GS TOP) D
	325	. S IEN=" " F S IEN =$O(^IBM(3 61.1,"E",S DT,IEN)) Q :IEN="" D
	326	.. S RM=$ $GET1^DIQ( 361.1,IEN_ ",",102,"I ") Q:$G(RM )=1 ; Quit looking i f this EOB is remove d
	327	.. ; If n ot all div isions the n check to see if th is EOB sho uld be inc luded
	328	.. I GDIV =0 S RCDIV ="",RCDEN= $$GET1^DIQ (361.1,IEN _",",.01," I") S:RCDE N'="" RCDI V=$$GET1^D IQ(399,RCD EN_",",.22 ,"I") Q:RC DIV="" Q: $G(GDIV(RC DIV))=""
	329	.. ; Get the data f or this cl aim and 83 5 Payer
	330	.. S ZND= ^IBM(361.1 ,IEN,0),PT R=$P(ZND,U ,1),ZPAY=$ $GPAYR^RCD PRU2($P(ZN D,U,3))
	331	.. S RCSE T=1
	332	.. ; Are there CARC codes for this reco rd
	333	.. S:($G( ^IBM(361.1 ,IEN,10,0) )']"")&($G (^IBM(361. 1,IEN,15,0 ))']"") RC SET=0
	334	.. ; Is t he PAYER i ncluded in the list
	335	.. S:'$$C HK^RCDPRU2 ("PAYER",Z PAY,.PNARR ) RCSET=0
	336	.. ; Is t he payer T IN include d in the l ist
	337	.. S:'$$C HK^RCDPRU2 ("TIN",$P( ZND,U,3)_" ",.PTARR) RCSET=0
	338	.. ;
	339	.. I RCPA Y="A",RCLA IM'="A" D Q:'RCSET ; If both not speci fied check for inclu sion
	340	... S RCS ET=$$ISTYP E^CJERCDPE U1(361.1,I EN,RCLAIM)
	341	.. ;
	342	.. ; Chec k Payer Na me
	343	.. I RCPA Y'="A" D
	344	... S RCS ET=$$ISSEL ^CJERCDPEU 1(361.1,IE N)
	345	.. ;
	346	.. Q:RCSE T=0 ; No n eed to che ck further get next IEN
	347	.. ; Poin ter to the bill (^DG CR(399,))^ KBill #^Pa tient poin ter^Payer Pointer [^ DIC(36)]^P ayer ID/TI N^Total Ch arges^Paid Amount
	348	.. S DZN= $G(^DGCR(3 99,PTR,0)) RoutinesAc tivitiesRo utine Name RCDPE8NZEn hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRelate d Routines Routines “ Called By” Routines “ Called” None $$A SKLM^RCDPE ARL
	349	$$ENDOR PRT^RCDPEA RL
	350	$$NOW^R CDPEARL
	351	ASK^RCD PEARL
	352	HDRLST^ RCDPEARL
	353	LMRPT^R CDPEARL
	354	SL^RCDP EARL
	355	$$DISPT Y^RCDPEM3
	356	$$DTRNG ^RCDPEM4
	357	INFO^RC DPEM6
	358	$$HACEF T^RCDPEU
	359	$$FMSST AT^RCDPURE CCurrent L ogic – RCD PE8NZRCDPE 8NZ ;ALB/T MK/KML/hru bovcak - U napplied E FT Deposit s report ; Jun 06, 20 14@19:11:1 9
	360	;;4.5;Acc ounts Rece ivable;1 73,212,208 ,269,276,2 83,293,298 ,317,318 ;Mar 20, 1 995;Build 8
	361	;Per VA D irective 6 402, this routine sh ould not b e modified .
	362	;
	363	EN ; entry point for Unapplied EFT Depos its Report [RCDPE UN APPLIED EF T DEP REPO RT]
	364	; ^RCY(34 4.3,0) = E DI LOCKBOX DEPOSIT^3 44.3I^
	365	;
	366	N %ZIS,DI R,RCDISPTY ,RCDTRNG,R CENDT,RCHD R,RCLNCNT, RCLSTMGR,R CPGNUM,RCR PLST,RCSTD T,RCTMPND, X,Y
	367	; RCDISPT Y - displa y type for Excel
	368	; RCDTRNG - range o f dates
	369	; RCHDR - report he ader
	370	; RCLNCNT - line co unter for ^TMP stora ge
	371	; RCLSTMG R - ListMa n flag
	372	; RCPGNUM - page nu mber
	373	; RCRPLST - node fo r report l ist in ^TM P
	374	; RCTMPND - storage node (or null) for SL^RCPEARL
	375	;
	376	S RCRPLST =$T(+0)_"_ EFT" ; st orage for list of en tries
	377	S RCLNCNT =0,RCLSTMG R="",RCTMP ND="" ; i nitial val ues for Li stMan
	378	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) RPTQ
	379	S RCSTDT= $P(RCDTRNG ,U,2),RCEN DT=$P(RCDT RNG,U,3)
	380	; ask if export to excel
	381	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 RPTQ
	382	; for Exc el, set Li stMan flag to preven t question
	383	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	384	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 RPTQ
	385	I RCLSTMG R D G RPT Q ; send output to ListMan
	386	.S RCTMPN D=$T(+0)_" ^UNAPPLIED EFT" K ^T MP($J,RCTM PND) ; cle an any res idue
	387	.D MKRPRT
	388	.N H,L,HD R S L=0
	389	.S HDR("T ITLE")=$$H DRNM
	390	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 3 lines of report header
	391	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	392	..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 )
	393	.; invoke ListMan
	394	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	395	;
	396	; Ask dev ice
	397	S %ZIS="Q M" D ^%ZIS Q:POP
	398	I $D(IO(" Q")) D Q
	399	.N ZTRTN, ZTSAVE,ZTD ESC,POP,ZT SK
	400	.S ZTRTN= "MKRPRT^RC DPE8NZ",ZT DESC="AR - List of u nlinked EF T deposit payments"
	401	.S ZTSAVE ("RC*")=""
	402	.D ^%ZTLO AD
	403	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" was queue d.",1:"Una ble to que ue this ta sk.")
	404	.K ZTSK,I O("Q") D H OME^%ZIS
	405	;
	406	U IO
	407	D MKRPRT
	408	Q
	409	;
	410	MKRPRT ; E ntry point for queue d job
	411	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
	412	;
	413	; get lis t of unlin ked EFT de posit data
	414	K ^TMP(RC RPLST,$J) ; subscrip ts: dep da te,EFT ien ,EFT det i en
	415	; Data is FMS doc i ndicator^F MS doc #^F MS Doc Sta tus
	416	; FMS doc indicator = -1:no r eceipt -2: no FMS doc 1:FMS doc exists
	417	;
	418	S (RCTSKC NT,RCSTOP, RCSUM,RCUN AP)=0
	419	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
	420	. S RCDAT A=$G(^RCY( 344.3,RCDA ,0)),RCDT= $P(RCDATA, U,7),RCTOT =0
	421	. Q:RCDT< RCSTDT ; Before sta rt date
	422	. Q:RCDT> (RCENDT+.9 99999) ; A fter the e nd date
	423	. Q:'$P(R CDATA,"^", 8) ; no pa yment amt
	424	. 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
	425	. . S RCT SKCNT=RCTS KCNT+1
	426	. . I '(R CTSKCNT#10 0),$D(ZTQU EUED),$$S^ %ZTLOAD S (RCSTOP,ZT STOP)=1 K ZTREQ Q
	427	. . Q:$P( $G(^RCY(34 4.31,RCEFT ,3)),U) ; EFT has be en removed PRCA4.5 293
	428	. . S RCR EC=$$GETRE C(RCEFT,RC DATA(0),.R ECEXT)
	429	. . Q:RCR EC="PURGED " ; need to prevent processed EFTs that had recei pts purged from bein g generate d on the r eport
	430	. . ;; PR CA276 - ne ed to add EFT entrie s without a receipt to the tot al number of unappli ed deposit s
	431	. . 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
	432	. . S RCS TAT=$$FMSS TAT^RCDPUR EC(RCREC)
	433	. . I $E( $P(RCSTAT, U),1,2)="T R",$P(RCST AT,U,2)["A CCEPTED" Q
	434	. . S RCU NAP=RCUNAP +1,RCTOT=R CTOT+$P(RC DATA(0),U, 7) ; total unapplied deposits and total dollar amo unt of una pplied dep osits
	435	. . 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
	436	. . S ^TM P(RCRPLST, $J,RCDT,RC DA,RCEFT)= "1^"_$P(RC STAT,U,1,2 )_"^"_RECE XT
	437	. S:RCTOT ^TMP(RCRP LST,$J,RCD T,RCDA)=RC TOT,RCSUM= RCSUM+RCTO T
	438	;
	439	D:'RCLSTM GR HDRBLD
	440	D:RCLSTMG R HDRLM
	441	;
	442	I RCDISPT Y D EXCEL Q
	443	;
	444	D RPT
	445	Q
	446	.
	447	.
	448	.Modified Logic (Cha nges are i n bold) – RCDPE8NZRC DPE8NZ ;AL B/TMK/KML/ hrubovcak - Unapplie d EFT Depo sits repor t ;Jun 06, 2014@19:1 1:19
	449	;;4.5;Acc ounts Rece ivable;1 73,212,208 ,269,276,2 83,293,298 ,317,318 ;Mar 20, 1 995;Build 8
	450	;Per VA D irective 6 402, this routine sh ould not b e modified .
	451	;
	452	EN ; entry point for Unapplied EFT Depos its Report [RCDPE UN APPLIED EF T DEP REPO RT]
	453	; ^RCY(34 4.3,0) = E DI LOCKBOX DEPOSIT^3 44.3I^
	454	;
	455	N %ZIS,DI R,RCDISPTY ,RCDTRNG,R CENDT,RCHD R,RCLNCNT, RCLSTMGR,R CPGNUM,RCR PLST,RCSTD T,RCTMPND, RCTYPE,X,Y
	456	; RCDISPT Y - displa y type for Excel
	457	; RCDTRNG - range o f dates
	458	; RCHDR - report he ader
	459	; RCLNCNT - line co unter for ^TMP stora ge
	460	; RCLSTMG R - ListMa n flag
	461	; RCPGNUM - page nu mber
	462	; RCRPLST - node fo r report l ist in ^TM P
	463	; RCTMPND - storage node (or null) for SL^RCPEARL
	464	; RCTYPE – Payer ty pe filter M – MEDICA L, P-PHARM ACY, T-TRI CARE, A-AL L
	465	;
	466	S RCRPLST =$T(+0)_"_ EFT" ; st orage for list of en tries
	467	S RCLNCNT =0,RCLSTMG R="",RCTMP ND="" ; i nitial val ues for Li stMan
	468	S RCTYPE= $$RTYPE^RC DPEU1("A")
	469	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) RPTQ
	470	S RCSTDT= $P(RCDTRNG ,U,2),RCEN DT=$P(RCDT RNG,U,3)
	471	; ask if export to excel
	472	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 RPTQ
	473	; for Exc el, set Li stMan flag to preven t question
	474	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	475	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 RPTQ
	476	I RCLSTMG R D G RPT Q ; send output to ListMan
	477	.S RCTMPN D=$T(+0)_" ^UNAPPLIED EFT" K ^T MP($J,RCTM PND) ; cle an any res idue
	478	.D MKRPRT
	479	.N H,L,HD R S L=0
	480	.S HDR("T ITLE")=$$H DRNM
	481	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 3 lines of report header
	482	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	483	..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 )
	484	.; invoke ListMan
	485	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	486	;
	487	; Ask dev ice
	488	S %ZIS="Q M" D ^%ZIS Q:POP
	489	I $D(IO(" Q")) D Q
	490	.N ZTRTN, ZTSAVE,ZTD ESC,POP,ZT SK
	491	.S ZTRTN= "MKRPRT^RC DPE8NZ",ZT DESC="AR - List of u nlinked EF T deposit payments"
	492	.S ZTSAVE ("RC*")=""
	493	.D ^%ZTLO AD
	494	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" was queue d.",1:"Una ble to que ue this ta sk.")
	495	.K ZTSK,I O("Q") D H OME^%ZIS
	496	;
	497	U IO
	498	D MKRPRT
	499	Q
	500	;
	501	MKRPRT ; E ntry point for queue d job
	502	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
	503	;
	504	; get lis t of unlin ked EFT de posit data
	505	K ^TMP(RC RPLST,$J) ; subscrip ts: dep da te,EFT ien ,EFT det i en
	506	; Data is FMS doc i ndicator^F MS doc #^F MS Doc Sta tus
	507	; FMS doc indicator = -1:no r eceipt -2: no FMS doc 1:FMS doc exists
	508	;
	509	S (RCTSKC NT,RCSTOP, RCSUM,RCUN AP)=0
	510	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
	511	. S RCDAT A=$G(^RCY( 344.3,RCDA ,0)),RCDT= $P(RCDATA, U,7),RCTOT =0
	512	. Q:RCDT< RCSTDT ; Before sta rt date
	513	. Q:RCDT> (RCENDT+.9 99999) ; A fter the e nd date
	514	. Q:'$P(R CDATA,"^", 8) ; no pa yment amt
	515	. 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
	516	. . I '$$ ISTYPE^RCD PEU1(344.3 1,RCEFT,RC TYPE) Q
	517	. . S RCT SKCNT=RCTS KCNT+1
	518	. . I '(R CTSKCNT#10 0),$D(ZTQU EUED),$$S^ %ZTLOAD S (RCSTOP,ZT STOP)=1 K ZTREQ Q
	519	. . Q:$P( $G(^RCY(34 4.31,RCEFT ,3)),U) ; EFT has be en removed PRCA4.5 293
	520	. . S RCR EC=$$GETRE C(RCEFT,RC DATA(0),.R ECEXT)
	521	. . Q:RCR EC="PURGED " ; need to prevent processed EFTs that had recei pts purged from bein g generate d on the r eport
	522	. . ;; PR CA276 - ne ed to add EFT entrie s without a receipt to the tot al number of unappli ed deposit s
	523	. . 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
	524	. . S RCS TAT=$$FMSS TAT^RCDPUR EC(RCREC)
	525	. . I $E( $P(RCSTAT, U),1,2)="T R",$P(RCST AT,U,2)["A CCEPTED" Q
	526	. . S RCU NAP=RCUNAP +1,RCTOT=R CTOT+$P(RC DATA(0),U, 7) ; total unapplied deposits and total dollar amo unt of una pplied dep osits
	527	. . 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
	528	. . S ^TM P(RCRPLST, $J,RCDT,RC DA,RCEFT)= "1^"_$P(RC STAT,U,1,2 )_"^"_RECE XT
	529	. S:RCTOT ^TMP(RCRP LST,$J,RCD T,RCDA)=RC TOT,RCSUM= RCSUM+RCTO T
	530	;
	531	D:'RCLSTM GR HDRBLD
	532	D:RCLSTMG R HDRLM
	533	;
	534	I RCDISPT Y D EXCEL Q
	535	;
	536	D RPT
	537	Q
	538	.
	539	.
	540	.RoutinesA ctivitiesR outine Nam eRCDPEAA1E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE APARRelat ed Routine sRoutines “Called By ”Routines “Called” RCDPEAA2 BLD^RCDP EAA4
	541	$$RTYPE ^RCDPESP2
	542	$$ASKUV W^RCDPEWL0 Current Logic – RC DPEAA1RCDP EAA1 ;ALB/ KML - AUTO POST AWAI TING RESOL UTION (APA R) - LIST OF UNPOSTE D EEOBS ;J un 06, 201 4@19:11:19
	543	;;4.5;Acc ounts Rece ivable;2 98,304,317 ,321;Mar 20, 1995; Build 8
	544	;Per VA D irective 6 402, this routine sh ould not b e modified .
	545	Q
	546	;
	547	.
	548	.
	549	; PRCA4. 5321 - St art modifi ed code bl ock
	550	Q:USEPVW 0
	551	Q:RCQUIT 1
	552	S RCQUIT= $$PAYR() ; Select Pa yer(s)
	553	Q:RCQUIT 1
	554	S RCQUIT= $$MORP() ; Select Me dical or P harmacy
	555	Q:RCQUIT 1
	556	S RCQUIT= $$SORT() ; Select So rt
	557	Q:RCQUIT 1
	558	S RCQUIT= $$SAVEPVW( ) ; Save P referred V iew
	559	Q:RCQUIT 1
	560	Q 0
	561	.
	562	.
	563	.
	564	PAYR() ; P ayer Selec tion
	565	; Input: ^TMP("RCDP E_APAR_EEO B_PARAMS", $J,"RCPAYR ") - Curre nt payer s election s etting
	566	; Output: ^TMP("RCD PE_APAR_EE OB_PARAMS" ,$J,"RCPAY R") - Upda ted payer selection setting
	567	; RCQUIT= 1 if user ^ or timed out
	568	; Returns : 1 if use r ^ arrowe d or time out
	569	N DIR,DIR UT,DIROUT, DUOUT,DTOU T,RCPAYR,R CPAYRDF,RC XPAR,RCDRL IM,RCERROR ,RCAUTOPDF
	570	N RCTYPED F,RCQ,X,XX ,Y
	571	S RCPAYRD F=$G(^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CPAYR"))
	572	S RCQUIT= 0
	573	K DIR
	574	S DIR(0)= "SA^A:ALL; R:RANGE"
	575	S DIR("A" )="(A)LL p ayers, (R) ANGE of pa yer names: "
	576	S DIR("B" )="ALL"
	577	S DIR("?" ,1)="Enter ing ALL wi ll select all payers ."
	578	S DIR("?" )="If RANG E is enter ed, you wi ll be prom pted for a payer ran ge."
	579	S:$P(RCPA YRDF,"^")' ="" DIR("B ")=$P(RCPA YRDF,"^") ;Stored pr eferred vi ew, use as default
	580	W !
	581	D ^DIR
	582	I $D(DTOU T)!$D(DUOU T) S RCQUI T=1 Q 1
	583	S RCPAYR= Y
	584	I RCPAYR= "A" S ^TMP ("RCDPE_AP AR_EEOB_PA RAMS",$J," RCPAYR")=Y Q 0
	585	I RCPAYR= "R" D Q:R CQUIT RCQU IT
	586	. W !,"Na mes you se lect here will be th e payer na mes from t he ERA, NO T the INS File"
	587	. K DIR
	588	. S DIR(" ?")="Enter a name be tween 1 an d 30 chara cters in U PPERCASE"
	589	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Start wi th payer n ame: "
	590	. S:$P(RC PAYRDF,"^" ,2)'="" DI R("B")=$P( RCPAYRDF," ^",2) ;Sto red prefer red view, use as def ault
	591	. W !
	592	. D ^DIR
	593	. I $D(DT OUT)!$D(DU OUT) D Q
	594	. . S RCQ UIT=1 Q
	595	. . K ^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")
	596	. S RCPAY R("FROM")= Y
	597	. K DIR
	598	. S DIR(" ?")="Enter a name be tween 1 an d 30 chara cters in U PPERCASE"
	599	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Go to pa yer name: "
	600	. S DIR(" B")=$E(RCP AYR("FROM" ),1,27)_"Z ZZ"
	601	. W ! D ^ DIR K DIR
	602	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	603	. S ^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CPAYR")=RC PAYR_"^"_R CPAYR("FRO M")_"^"_Y
	604	Q 0
	605	;
	606	MORP() ; A sk for Med ical or Ph armacy (Or Both)
	607	; Input: None
	608	; Returns : 1 if use r ^ arrowe d or timed out, 0 ot herwise
	609	N DEF
	610	S DEF=$G( ^TMP("RCDP E_APAR_EEO B_PARAMS", $J,"RCMEDR X"))
	611	S DEF=$S( DEF="P":"P HARMACY",D EF="M":"ME DICAL",1:" BOTH")
	612	S RCQ=$$R TYPE^RCDPE U(DEF)
	613	I RCQ=-1 Q 1
	614	S ^TMP("R CDPE_APAR_ EEOB_PARAM S",$J,"RCM EDRX")=RCQ
	615	Q 0
	616	;
	617	.
	618	.
	619	.
	620	FILTER(RCD A) ; Retur ns 1 if re cord in en try 344.4 passes
	621	; the edi ts for the APAR work list selec tion of EE OBs
	622	; Paramet ers found in ^TMP("R CDPE_APAR_ EEOB_PARAM S",$J)
	623	;
	624	; Input: RCDA - Int ernal IEN OF 344.4
	625	; Returns : 1 if the ERA Recor d passes f ilters, 0 otherwise
	626	; PRCA4. 5321 - St art modifi ed code bl ock
	627	N OK,RCEC ME,RCERATY P,RCIEN,RC PAYR,RCPAY FR,RCPAYTO ,XX
	628	S OK=1
	629	;
	630	S RCPAYR= $P($G(^TMP ("RCDPE_AP AR_EEOB_PA RAMS",$J," RCPAYR")), U,1)
	631	S RCPAYFR =$P($G(^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")) ,U,2)
	632	S RCPAYTO =$P($G(^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")) ,U,3)
	633	S RCERATY P=$G(^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CMEDRX"))
	634	; Payer n ame filter
	635	I RCPAYR' ="A" D Q: 'OK OK
	636	. S XX=$$ GET1^DIQ(3 44.4,RCDA, .06,"I") ; Payer Nam e
	637	. S XX=$$ UP^XLFSTR( XX)
	638	. ;
	639	. ; Make sure the P ayer is in the selec ted Payer range
	640	. I $S(XX =RCPAYFR:1 ,XX=RCPAYT O:1,XX]RCP AYFR:RCPAY TO]XX,1:0) Q
	641	. S OK=0
	642	;
	643	; ERA Typ e (Medical /Pharmacy) filter
	644	I RCERATY P'="A" D ; US786
	645	. ;
	646	. ; Check the first EOB in th e ERA to s ee if it i s a Pharma cy or Medi cal ERA
	647	. S RCIEN =$O(^RCY(3 44.4,RCDA, 1,0))
	648	. I RCIEN ="" S OK=0 Q
	649	. S RCECM E=$$GET1^D IQ(344.41, RCIEN_","_ RCDA_",",. 24,"I") ; ECME #
	650	. ;
	651	. ; If re quested fi lter is Ph armacy and there is an ECME #, display
	652	. I RCECM E="",RCERA TYP="M" Q
	653	. ;
	654	. ; If re quested fi lter is Me dical and there is n o ECME #, display
	655	. I RCECM E'="",RCER ATYP="P" Q
	656	. ;
	657	. ; Other wise, not valid on t he filter, don't dis play
	658	. S OK=0
	659	Q OKModif ied Logic (Changes a re in bold ) – RCDPEA A1RCDPEAA1 ;ALB/KML - AUTO POS T AWAITING RESOLUTIO N (APAR) - LIST OF U NPOSTED EE OBS ;Jun 0 6, 2014@19 :11:19
	660	;;4.5;Acc ounts Rece ivable;2 98,304,317 ,321;Mar 20, 1995; Build 8
	661	;Per VA D irective 6 402, this routine sh ould not b e modified .
	662	Q
	663	;
	664	.
	665	.
	666	; PRCA4.5 321 - Sta rt modifie d code blo ck
	667	Q:USEPVW 0
	668	Q:RCQUIT 1
	669	; US786 pr ompt for t ype filter first in case we ne ed to use it in paye r selectio n
	670	S RCQUIT= $$MORP() ; Select Me dical or P harmacy, o r Tricare
	671	Q:RCQUIT 1
	672	S RCQUIT= $$PAYR() ; Select Pa yer(s)
	673	Q:RCQUIT 1
	674	S RCQUIT= $$SORT() ; Select So rt
	675	Q:RCQUIT 1
	676	S RCQUIT= $$SAVEPVW( ) ; Save P referred V iew
	677	Q:RCQUIT 1
	678	Q 0
	679	.
	680	.
	681	.
	682	PAYR() ; P ayer Selec tion
	683	; Input: ^TMP("RCDP E_APAR_EEO B_PARAMS", $J,"RCPAYR ") - Curre nt payer s election s etting
	684	; Output: ^TMP("RCD PE_APAR_EE OB_PARAMS" ,$J,"RCPAY R") - Upda ted payer selection setting
	685	; RCQUIT= 1 if user ^ or timed out
	686	; Returns : 1 if use r ^ arrowe d or time out
	687	N DIR,DIR UT,DIROUT, DUOUT,DTOU T,RCPAYR,R CPAYRDF,RC XPAR,RCDRL IM,RCERROR ,RCAUTOPDF
	688	N RCTYPED F,RCQ,X,XX ,Y
	689	S RCPAYRD F=$G(^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CPAYR"))
	690	S RCQUIT= 0
	691	K DIR
	692	S DIR(0)= "SA^A:ALL; R:RANGE"
	693	S DIR("A" )="(A)LL p ayers, (R) ANGE of pa yer names: "
	694	S DIR("B" )="ALL"
	695	S DIR("?" ,1)="Enter ing ALL wi ll select all payers ."
	696	S DIR("?" )="If RANG E is enter ed, you wi ll be prom pted for a payer ran ge."
	697	S:$P(RCPA YRDF,"^")' ="" DIR("B ")=$P(RCPA YRDF,"^") ;Stored pr eferred vi ew, use as default
	698	W !
	699	D ^DIR
	700	I $D(DTOU T)!$D(DUOU T) S RCQUI T=1 Q 1
	701	S RCPAYR= Y
	702	I RCPAYR= "A" S ^TMP ("RCDPE_AP AR_EEOB_PA RAMS",$J," RCPAYR")=Y Q 0
	703	I RCPAYR= "R" D Q:R CQUIT RCQU IT
	704	. W !,"Na mes you se lect here will be th e payer na mes from t he ERA, NO T the INS File"
	705	. K DIR
	706	. S DIR(" ?")="Enter a name be tween 1 an d 30 chara cters in U PPERCASE"
	707	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Start wi th payer n ame: "
	708	. S:$P(RC PAYRDF,"^" ,2)'="" DI R("B")=$P( RCPAYRDF," ^",2) ;Sto red prefer red view, use as def ault
	709	. W !
	710	. D ^DIR
	711	. I $D(DT OUT)!$D(DU OUT) D Q
	712	. . S RCQ UIT=1 Q
	713	. . K ^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")
	714	. S RCPAY R("FROM")= Y
	715	. K DIR
	716	. S DIR(" ?")="Enter a name be tween 1 an d 30 chara cters in U PPERCASE"
	717	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="Go to pa yer name: "
	718	. S DIR(" B")=$E(RCP AYR("FROM" ),1,27)_"Z ZZ"
	719	. W ! D ^ DIR K DIR
	720	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	721	. S ^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CPAYR")=RC PAYR_"^"_R CPAYR("FRO M")_"^"_Y
	722	Q 0
	723	;
	724	MORP() ; A sk for Med ical or Ph armacy, Tr icare (Or All)
	725	; Input: None
	726	; Returns : 1 if use r ^ arrowe d or timed out, 0 ot herwise
	727	N DEF
	728	S DEF=$G( ^TMP("RCDP E_APAR_EEO B_PARAMS", $J,"RCMEDR X"))
	729	S DEF=$S( DEF="P":"P HARMACY",D EF="M":"ME DICAL",DEF ="T":"TRIC ARE",1:"AL L")
	730	S RCQ=$$R TYPE^RCDPE U(DEF)
	731	I RCQ=-1 Q 1
	732	S ^TMP("R CDPE_APAR_ EEOB_PARAM S",$J,"RCM EDRX")=RCQ
	733	Q 0
	734	;
	735	.
	736	.
	737	.
	738	FILTER(RCD A) ; Retur ns 1 if re cord in en try 344.4 passes
	739	; the edi ts for the APAR work list selec tion of EE OBs
	740	; Paramet ers found in ^TMP("R CDPE_APAR_ EEOB_PARAM S",$J)
	741	;
	742	; Input: RCDA - Int ernal IEN OF 344.4
	743	; Returns : 1 if the ERA Recor d passes f ilters, 0 otherwise
	744	; PRCA4. 5321 - St art modifi ed code bl ock
	745	N OK,RCEC ME,RCERATY P,RCIEN,RC PAYR,RCPAY FR,RCPAYTO ,XX
	746	S OK=1
	747	;
	748	S RCPAYR= $P($G(^TMP ("RCDPE_AP AR_EEOB_PA RAMS",$J," RCPAYR")), U,1)
	749	S RCPAYFR =$P($G(^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")) ,U,2)
	750	S RCPAYTO =$P($G(^TM P("RCDPE_A PAR_EEOB_P ARAMS",$J, "RCPAYR")) ,U,3)
	751	S RCERATY P=$G(^TMP( "RCDPE_APA R_EEOB_PAR AMS",$J,"R CMEDRX"))
	752	; Payer n ame filter
	753	I RCPAYR' ="A" D Q: 'OK OK
	754	. S XX=$$ GET1^DIQ(3 44.4,RCDA, .06,"I") ; Payer Nam e
	755	. S XX=$$ UP^XLFSTR( XX)
	756	. ;
	757	. ; Make sure the P ayer is in the selec ted Payer range
	758	. I $S(XX =RCPAYFR:1 ,XX=RCPAYT O:1,XX]RCP AYFR:RCPAY TO]XX,1:0) Q
	759	. S OK=0
	760	;
	761	; ERA Typ e (Medical /Pharmacy) filter
	762	I RCERATY P'="A" D ; US786
	763	. ;
	764	. I '$$IS TYPE^RCDPE U1(344,RCD A,RCERATYP ) S OK=0
	765	. ; Check the first EOB in th e ERA to s ee if it i s a Pharma cy or Medi cal ERA
	766	. S RCIEN =$O(^RCY(3 44.4,RCDA, 1,0))
	767	. I RCIEN ="" S OK=0 Q
	768	. S RCECM E=$$GET1^D IQ(344.41, RCIEN_","_ RCDA_",",. 24,"I") ; ECME #
	769	. ;
	770	. ; If re quested fi lter is Ph armacy and there is an ECME #, display
	771	. I RCECM E="",RCERA TYP="M" Q
	772	. ;
	773	. ; If re quested fi lter is Me dical and there is n o ECME #, display
	774	. I RCECM E'="",RCER ATYP="P" Q
	775	. ;
	776	. ; Other wise, not valid on t he filter, don't dis play
	777	. S OK=0
	778	Q OKRouti nesActivit iesRoutine NameRCDPE ACEnhancem ent Catego ry New Mod ify Delete No Change RTMRelated OptionsRC DPE ACTIVE WITH EEOB REPORTRel ated Routi nesRoutine s “Called By”Routine s “Called” None $$ASKLM^RC DPEARL
	779	$$ENDOR PRT^RCDPEA RL
	780	$$INCHM PVA^RCDPEA RL
	781	$$INTRI CAR^RCDPEA RL
	782	$$NOW^R CDPEARL
	783	ASK^RCD PEARL
	784	HDRLST^ RCDPEARL
	785	LMRPT^R CDPEARL
	786	SL^RCDP EARL
	787	$$DISPT Y^RCDPEM3
	788	INFO^RC DPEM6 Current Logic - R CDPEACRCDP EAC ;ALB/T MK/PJH - A CTIVE BILL S WITH EEO B ON FILE ;Jun 06, 2 014@19:11: 19
	789	;;4.5;Acc ounts Rece ivable;2 08,269,276 ,298,303 ;Mar 20, 1 995;Build 84
	790	;;Per VA Directive 6402, this routine s hould not be modifie d.
	791	;
	792	EN ; Entr y point fo r Active B ills With EEOB Repor t [RCDPE A CTIVE WITH EEOB REPO RT]
	793	N %ZIS,DT OUT,DUOUT, CHAM,HDR,P OP,RCCT,RC DISPTY,RCH DR,RCINS,R CLSTMGR,RC PGNUM,RCSO RT,RCSTOP, RCTMPND,TR IC,VAUTD,X ,Y
	794	N START,E ND,RCZRO,R CMDRX
	795	; PRCA4. 5276 - IA 1077 - Qu ery Divisi on
	796	D DIVISIO N^VAUTOMA
	797	I 'VAUTD& ($D(VAUTD) '=11) Q
	798	; PRCA4. 5276 - se lect repor t format
	799	Q:'$$SELE CT(.RCINS, .RCSORT,.R CZRO,.RCMD RX)
	800	;
	801	S RCTMPND ="",RCPGNU M=0,RCSTOP =0
	802	I RCLSTMG R D G ENO UT
	803	. S RCTMP ND=$T(+0)_ "^AR - ACT IVE BILLS WITH EEOB REPORT" K ^TMP($J,R CTMPND) ; clean any residue
	804	. D ENQ
	805	. M HDR=R CHDR
	806	. D LMRPT ^RCDPEARL( .HDR,$NA(^ TMP($J,RCT MPND))) ; generate L istMan dis play
	807	. I $D(RC TMPND) K ^ TMP($J,RCT MPND)
	808	;
	809	W !
	810	S %ZIS="Q M" D ^%ZIS Q:POP
	811	I $D(IO(" Q")) D Q
	812	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
	813	.S ZTRTN= "ENQ^RCDPE AC",ZTDESC ="AR - ACT IVE BILLS WITH EEOB REPORT",ZT SAVE("*")= ""
	814	.D ^%ZTLO AD
	815	.W !!,$S( $D(ZTSK):" Your task number"_ZT SK_" has b een queued .",1:"Unab le to queu e this job .")
	816	.K IO("Q" ) D HOME^% ZIS
	817	U IO
	818	;
	819	.
	820	.
	821	.
	822	I 'RCLSTM GR D HDRLS T^RCDPEARL (0,.RCHDR) ; initial report he ader
	823	S RCBILL= 0,RCDT=STA RT-.0001
	824	; PRCA4. 5303 - Ch anged loop to use th e "AD" ind ex on 361. 1 so that the number of record s checked is limited by
	825	; the STA RT and END dates of when the E EOB was re cieved in VistA
	826	F S RCDT =$O(^IBM(3 61.1,"AD", RCDT)) Q:( RCDT>END)! (RCDT="") D
	827	. S RCEIE N="" F S RCEIEN=$O( ^IBM(361.1 ,"AD",RCDT ,RCEIEN)) Q:RCEIEN=" " S RCBIL L=$P(^IBM( 361.1,RCEI EN,0),U,1) I ($P(^PR CA(430,RCB ILL,0),U,8 )=RCACT),$ $INCLUDE(. RCINS,RCBI LL,TRIC,CH AM),$$EEOB (RCBILL,.R CEOB,RCZRO ) D
	828	. . S (RC TOT,RCEOB, SN)=0 F S RCEOB=$O( RCEOB(RCEO B)) Q:'RCE OB F S S N=$O(RCEOB (RCEOB,SN) ) Q:'SN D
	829	. . . S R CTOT=RCTOT +$G(^IBM(3 61.1,RCEOB ,1)),^TMP( $J,"RCSORT ",$$INSNM( RCBILL),$$ SL1(RCSORT ,RCBILL),R CBILL,+RCE OB(RCEOB,S N)_"_"_RCE OB_"_"_SN, RCEOB)=$P( RCEOB(RCEO B,SN),U,2) ; PRCA*4. 5.303 add ERA PD AMO UNT
	830	. . . I $ O(RCEOB(0) ) S ^TMP($ J,"RCSORT" ,$$INSNM(R CBILL),$$S L1(RCSORT, RCBILL),RC BILL)=RCTO T ;This is from th e eob and will be th e same for each line
	831	.
	832	.
	833	.
	834	OUTPUT(RCZ ,RCZ0,RCSO RT,RCSTOP, RCINS,RCNE W) ; Outpu t the data
	835	; RCZ, RC Z0 are the first 2 s ort levels for the a rray
	836	; RCINS = insurance co info a rray
	837	; RCSTOP passed by ref - retu rned if us er chooses to stop
	838	; RCNEW = 1 if the header sho uld be for ced to pri nt
	839	N ZZ,RCEP D
	840	S RCBILL= 0 F S RCB ILL=$O(^TM P($J,"RCSO RT",RCZ,RC Z0,RCBILL) ) Q:'RCBIL L!RCSTOP S RCZ1="" F S RCZ1= $O(^TMP($J ,"RCSORT", RCZ,RCZ0,R CBILL,RCZ1 )) Q:RCZ1= ""!RCSTOP D
	841	. I $D(ZT QUEUED),$$ S^%ZTLOAD S (RCSTOP, ZTSTOP)=1 K ZTREQ I +$G(RCSTOP ) W !!,"** TASK STOP PED BY USE R**" Q
	842	. ; IA 19 92 - BILL/ CLAIMS fil e (#399)
	843	. S RC399 =$G(^DGCR( 399,RCBILL ,0)),RC399 M1=$G(^DGC R(399,RCBI LL,"M1")), RCPT=+$P(R C399,U,2), RC430=$G(^ PRCA(430,R CBILL,0)) ;RC430 is from the t op level
	844	. ; PRCA* 4.5*276 - Check for Division
	845	. I VAUTD =0 Q:$P(RC 399,U,22)= "" Q:$G(V AUTD($P(RC 399,U,22)) )=""
	846	. ; PRCA* $.5*303 Ch eck for me dical or p harmacy cl aims, don' t check fu rther if w e are repo rting both
	847	. I RCMDR X'="B" S Z Z=$S((RCMD RX="P")&($ P(RC399M1, U,8)'=""): 1,(RCMDRX= "M")&($P(R C399M1,U,8 )=""):1,1: 0) Q:ZZ=0
	848	. S RCSTO P=$$NEWPG( .RCINS,RCN EW) S RCNE W=0 Q:RCST OP
	849	. S RCSTO P=$$NEWPG( .RCINS,RCN EW) Q:RCST OP
	850	.
	851	.
	852	.
	853	INCLUDE(RC INS,RCZ,TR I,CVA) ; F unction re turns 1 if record sh ould be in cluded bas ed
	854	; on ins co
	855	; RCINS = array con taining in surance co informati on
	856	; RCZ = i en of the entry in f ile 430
	857	N OK,RCI, RCINM,RCAI NP
	858	S OK=0
	859	S RCI=+$$ INS(RCZ)
	860	;
	861	I 'RCI G INCQ ; Not a third p arty bill
	862	;
	863	I RCINS=" A" S OK=1
	864	;
	865	I RCINS=" S"!(RCINS= "R") D
	866	. I RCINS ="S" S:$D( RCINS("S", RCI)) OK=1 Q
	867	. S RCINM =$$INSNM(R CZ) ; INS CO NAME
	868	. I $S(RC INM=RCINS( "FR")!(RCI NM]RCINS(" FR")):RCIN M']RCINS(" TO"),1:0) S OK=1
	869	;
	870	I OK=0 G INCQ ;CHA MPVA and T RICARE do not matter - do not include
	871	I OK=1,TR I,CVA G IN CQ ;Add c heck for C HAMPVA and TRICARE
	872	S RCAINP= $P($G(^PRC A(430,RCZ, 0)),U,2)
	873	I 'TRI,", 30,31,32," [(","_RCAI NP_",") S OK=0 ;Only exclude T RICARE
	874	I 'CVA,", 27,28,29," [(","_RCAI NP_",") S OK=0 ;Only exclude C HAMPVA
	875	;
	876	INCQ Q OK
	877	;
	878	.
	879	.
	880	.
	881	SELECT(RCI NS,RCSORT, RCZRO,RCMD RX) ; Sele ct insuran ce co, sor t criteria , Zero Pay ment, Bill type (Med /RX) and i f output f or EXCEL f ormat is s elected
	882	; Functio n returns values sel ected for RCSORT and RCINS - p assed by r ef
	883	N RCQUIT, DONE,DIR,X ,Y,%DT
	884	S (RCQUIT ,DONE,RCLS TMGR)=0
	885	S DIR(0)= "SA^A:ALL; S:SPECIFIC ;R:RANGE", DIR("A")=" RUN REPORT FOR (A)LL , (S)PECIF IC, OR (R) ANGE OF IN SURANCE CO MPANIES?: ",DIR("B") ="ALL" W ! D ^DIR K DIR
	886	I $D(DTOU T)!$D(DUOU T) G SELQ
	887	;
	888	S RCINS=Y
	889	I RCINS=" S" D G:RC QUIT SELQ
	890	. W !
	891	. F D LI ST(.DIR,.R CINS) S DI R("A")="SE LECT "_$S( $O(RCINS(" S",0)):"AN OTHER ",1: "")_"INSUR ANCE COMPA NY"_$S($O( RCINS("S", 0)):" (PRE SS RETURN WHEN DONE) ",1:"")_": ",DIR(0)= "PAO^DIC(3 6,:AEMQ" D ^DIR K DI R D Q:Y'> 0
	892	.. I $D(D TOUT)!$D(D UOUT) S RC QUIT=1 Q
	893	.. I Y>0 S RCINS("S ",+Y)=""
	894	. I '$O(R CINS("S",0 )) S RCQUI T=1 W !!," NO INSURAN CE COMPANI ES SELECTE D - NO REP ORT GENERA TED" S DIR (0)="E" D ^DIR K DIR
	895	;
	896	I RCINS=" R" D I RC QUIT W !!, "NO INSURA NCE COMPAN Y NAME RAN GE SELECTE D - NO REP ORT GENERA TED" S DIR (0)="E" D ^DIR K DIR G SELQ
	897	. W !
	898	. S DIR(" ?")="ENTER 1-30 UPPE RCASE CHAR ACTERS OF THE FIRST NAME TO IN CLUDE"
	899	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="START WI TH INSURAN CE COMPANY NAME: " D ^DIR K DI R
	900	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	901	. S RCINS ("FR")=Y
	902	. S DIR(" ?")="ENTER 1-30 UPPE RCASE CHAR ACTERS OF THE LAST N AME TO INC LUDE"
	903	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="GO TO IN SURANCE CO MPANY NAME : ",DIR("B ")=$E(RCIN S("FR"),1, 27)_"ZZZ"
	904	. F W ! D ^DIR Q:$ S($D(DTOUT )!$D(DUOUT ):1,1:RCIN S("FR")']Y ) W !,"'GO TO' NAME MUST COME AFTER 'STA RT WITH' N AME"
	905	. K DIR
	906	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	907	. S RCINS ("TO")=Y
	908	; PRCA4. 5303 - Ad d Zero $ P rompt and Medical/Ph armacy EEO Bs Prompt
	909	S DIR(0)= "SA^A:ALL; Z:ZERO PAY MENT EEOBs ",DIR("A") ="RUN REPO RT FOR (A) LL EEOBs o r (Z)ERO P AYMENT EEO Bs only: " ,DIR("B")= "ALL" W ! D ^DIR K D IR
	910	I $D(DTOU T)!$D(DUOU T) G SELQ
	911	;
	912	S RCZRO=$ E(Y,1)
	913	S DIR(0) ="SA^B:BOT H;M:MEDICA L;P:PHARMA CY",DIR("A ")="RUN RE PORT FOR ( M)EDICAL, (P)HARMACY OR (B)OTH : ",DIR("B ")="BOTH" W ! D ^DIR K DIR
	914	I $D(DTOU T)!$D(DUOU T) G SELQ
	915	;
	916	S RCMDRX= $E(Y,1)
	917	;
	918	S DIR(0)= "SA^P:PATI ENT NAME;L :LAST 4 OF PATIENT S SN",DIR("A ")="WITHIN INS CO, S ORT BY (P) ATIENT NAM E OR (L)AS T 4 OF SSN ?: ",DIR(" B")="PATIE NT NAME" W ! D ^DIR K DIR
	919	I $D(DTOU T)!$D(DUOU T) G SELQ
	920	S RCSORT= $S(Y="P":" PN",1:"L4" )
	921	S DIR(0)= "SA^F:FIRS T TO LAST; L:LAST TO FIRST",DIR ("A")="SOR T "_$S(RCS ORT="PN":" PATIENT NA ME",1:"LAS T 4")_" (F )IRST TO L AST OR (L) AST TO FIR ST?: ",DIR ("B")="FIR ST TO LAST " D ^DIR K DIR
	922	I $D(DTOU T)!$D(DUOU T) G SELQ
	923	I Y="L" S RCSORT=RC SORT_";-"
	924	;
	925	; PRCA4. 5298 - Ad d Date Ran ge Prompts
	926	K DIR
	927	S DIR("?" )="ENTER T HE EARLIES T RECEIVED DATE TO I NCLUDE ON THE REPORT "
	928	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="ST ART DATE ( RECEIVED): ",DIR("B" )="T" D ^D IR K DIR
	929	I $D(DTOU T)!$D(DUOU T)!(Y="") G SELQ
	930	S START=Y
	931	K DIR
	932	S DIR("?" )="ENTER T HE LATEST RECEIVED D ATE TO INC LUDE ON TH E REPORT"
	933	S DIR("B" )="T"
	934	S DIR(0)= "DAO^"_STA RT_":"_DT_ ":APE",DIR ("A")="END DATE (REC EIVED): " D ^DIR K D IR
	935	I $D(DTOU T)!$D(DUOU T)!(Y="") G SELQ
	936	S END=Y
	937	;
	938	; PRCA4. 5298 - Ad d TRICARE Prompt
	939	S TRIC=$$ INTRICAR^R CDPEARL G: TRIC<0 SEL Q
	940	;
	941	; PRCA4. 5298 - Ad d CHAMPVA Prompt
	942	S CHAM=$$ INCHMPVA^R CDPEARL G: CHAM<0 SEL Q
	943	;
	944	; PRCA4. 5276 - De termine wh ether to g ather data for Excel report.
	945	S RCDISPT Y=$$DISPTY ^RCDPEM3 G SELQ:RCDI SPTY<0
	946	I RCDISPT Y D INFO^R CDPEM6 S D ONE=1 G SE LQ
	947	;
	948	; PRCA4. 5298 - Ad d ListMana ger Prompt s
	949	S RCLSTMG R=$$ASKLM^ RCDPEARL G :RCLSTMGR< 0 SELQ
	950	;
	951	S DONE=1
	952	;
	953	SELQ ;
	954	Q DONE
	955	.
	956	.
	957	.
	958	HDRBLD ; c reate the report hea der
	959	; returns RCHDR,RCP GNUM,RCSTO P
	960	; RCHDR(0 ) = header text line count
	961	; RCHDR(" PGNUM") = page numbe r
	962	; RCHDR(" XECUTE") = M code fo r page num ber
	963	; RCHDR(" RUNDATE") = date/tim e report g enerated
	964	; RCPGNUM - page co unter
	965	; RCSTOP - flag to stop listi ng
	966	;INPUT:
	967	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	968	; RCPAY - Payer fil ter value( s)
	969	; RCLSTMG R
	970	;
	971	N Z0
	972	S Z0=""
	973	K RCHDR S RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
	974	;
	975	I RCDISPT Y D Q ; Excel form at, xecute code is Q UIT, null page numbe r
	976	. S RCHDR (0)=1,RCHD R("XECUTE" )="Q",RCPG NUM=""
	977	. S RCHDR (1)="PATIE NT NAME^SS N^BILL#^IN S CO NAME^ BALANCE^AM T BILLE^AM T PAID^TRA CE#^DT REC 'D^DT POST ^ERA PD AM T"
	978	;
	979	N MSG,DAT E,Y,DIV,HC NT
	980	S RCHDR(1 )=$$HDRNM, HCNT=1 ; l ine 1 will be replac ed by XECU TE code be low
	981	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"
	982	;
	983	S Y="RUN DATE: "_RC HDR("RUNDA TE"),HCNT= HCNT+1,RCH DR(HCNT)=$ J("",80-$L (Y)\2)_Y
	984	I VAUTD=1 S Y="DIVI SIONS: ALL "
	985	I VAUTD=0 D
	986	. S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0="" S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
	987	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Y )\2)_Y
	988	I RCINS=" S" S Z=0,Z 0="" F S Z=$O(RCINS ("S",Z)) Q :'Z S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
	989	S Z0="PAY ERS: "_$S( RCINS="A": "ALL ",RCI NS="R":"RA NGE FROM " _RCINS("FR ")_"-"_RCI NS("TO"),1 :"")_Z0
	990	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0,Z 0=""
	991	S Z0=Z0_" DATE RANGE : "_$$FMTE ^XLFDT(STA RT,"2Z")_" -"_$$FMTE^ XLFDT(END, "2Z")_" TR ICARE: "_$ S(TRIC=1:" YES",1:"NO ")_" CHAMP VA: "_$S(C HAM=1:"YES ",1:"NO")_ " EEOBs: " _$S(RCMDRX ="M":"MEDI CAL",RCMDR X="P":"PHA RMACY",1:" BOTH")
	992	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0
	993	;
	994	S HCNT=HC NT+1,RCHDR (HCNT)=""
	995	S Y="PATI ENT NAME S SN BILL#", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	996	S Y="INS CO NAME BA LANCE AMT BILLED AMT PAID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	997	S Y=" TRA CE# ERA PD AMT REC'D DT POST", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	998	S Y=$TR($ J("",IOM), " ","="),H CNT=HCNT+1 ,RCHDR(HCN T)=Y
	999	S RCHDR(0 )=HCNT
	1000	Q
	1001	;
	1002	HDRLM ; cr eate the l ist manage r version of the rep ort header
	1003	; returns RCHDR,RCP GNUM,RCSTO P
	1004	; RCHDR(0 ) = header text line count
	1005	; RCHDR(" PGNUM") = page numbe r
	1006	; RCHDR(" XECUTE") = M code fo r page num ber
	1007	; RCHDR(" RUNDATE") = date/tim e report g enerated
	1008	; RCPGNUM - page co unter
	1009	; RCSTOP - flag to stop listi ng
	1010	;INPUT:
	1011	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	1012	; RCPAY - Payer fil ter value( s)
	1013	; RCLSTMG R
	1014	;
	1015	N Z0 S Z0 =""
	1016	K RCHDR S RCPGNUM=0 ,RCSTOP=0
	1017	N MSG,DAT E,Y,DIV,HC NT
	1018	S RCHDR(" TITLE")=$$ HDRNM,RCHD R("XECUTE" )="Q"
	1019	S RCHDR(1 )="DATE RA NGE: "_$$F MTE^XLFDT( START,"2Z" )_"-"_$$FM TE^XLFDT(E ND,"2Z")_" TRICARE: "_$S(TRIC= 1:"YES",1: "NO")_" CH AMPVA: "_$ S(CHAM=1:" YES",1:"NO ")_" EEOBs : "_$S(RCM DRX="M":"M EDICAL",RC MDRX="P":" PHARMACY", 1:"BOTH"), HCNT=1
	1020	I VAUTD=1 S Y="DIVI SIONS: ALL "
	1021	I VAUTD=0 D
	1022	. S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0="" S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
	1023	S HCNT=HC NT+1,RCHDR (HCNT)=Y
	1024	I RCINS=" S" S Z=0,Z 0="" F S Z=$O(RCINS ("S",Z)) Q :'Z S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
	1025	S Z0="PAY ERS: "_$S( RCINS="A": "ALL ",RCI NS="R":"RA NGE FROM " _RCINS("FR ")_" - "_R CINS("TO") ,1:"")_Z0
	1026	S HCNT=HC NT+1,RCHDR (HCNT)=Z0
	1027	I RCINS=" A" S HCNT= HCNT+1,RCH DR(HCNT)=" "
	1028	;
	1029	S Y="PATI ENT NAME S SN BILL#", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1030	S Y="INS CO NAME BA LANCE AMT BILLED AMT PAID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	1031	S Y=" TRA CE# ERA PD AMT REC'D DT POST", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1032	S RCHDR(0 )=HCNT
	1033	QModified Logic (Ch anges are in bold) - RCDPEACRC DPEAC ;ALB /TMK/PJH - ACTIVE BI LLS WITH E EOB ON FIL E ;Jun 06, 2014@19:1 1:19
	1034	;;4.5;Acc ounts Rece ivable;2 08,269,276 ,298,303 ;Mar 20, 1 995;Build 84
	1035	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1036	;
	1037	EN ; Entry point for Active Bi lls With E EOB Report [RCDPE AC TIVE WITH EEOB REPOR T]
	1038	N %ZIS,DT OUT,DUOUT, CHAM,HDR,P OP,RCCT,RC DISPTY,RCH DR,RCINS,R CLSTMGR,RC PGNUM,RCSO RT,RCSTOP, RCTMPND,TR IC,VAUTD,X ,Y
	1039	N START,E ND,RCZRO,R CMDRX
	1040	; PRCA4. 5276 - IA 1077 - Qu ery Divisi on
	1041	D DIVISIO N^VAUTOMA
	1042	I 'VAUTD&( $D(VAUTD)' =11) Q
	1043	; PRCA4. 5276 - se lect repor t format
	1044	Q:'$$SELE CT(.RCINS, .RCSORT,.R CZRO,.RCMD RX)
	1045	;
	1046	S RCTMPND ="",RCPGNU M=0,RCSTOP =0
	1047	I RCLSTMG R D G ENO UT
	1048	. S RCTMP ND=$T(+0)_ "^AR - ACT IVE BILLS WITH EEOB REPORT" K ^TMP($J,R CTMPND) ; clean any residue
	1049	. D ENQ
	1050	. M HDR=R CHDR
	1051	. D LMRPT ^RCDPEARL( .HDR,$NA(^ TMP($J,RCT MPND))) ; generate L istMan dis play
	1052	. I $D(RC TMPND) K ^ TMP($J,RCT MPND)
	1053	;
	1054	W !
	1055	S %ZIS="Q M" D ^%ZIS Q:POP
	1056	I $D(IO(" Q")) D Q
	1057	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
	1058	.S ZTRTN= "ENQ^RCDPE AC",ZTDESC ="AR - ACT IVE BILLS WITH EEOB REPORT",ZT SAVE("*")= ""
	1059	.D ^%ZTLO AD
	1060	.W !!,$S( $D(ZTSK):" Your task number"_ZT SK_" has b een queued .",1:"Unab le to queu e this job .")
	1061	.K IO("Q" ) D HOME^% ZIS
	1062	U IO
	1063
	1064	.
	1065	.
	1066	.
	1067	I 'RCLSTM GR D HDRLS T^RCDPEARL (0,.RCHDR) ; initial report he ader
	1068	S RCBILL= 0,RCDT=STA RT-.0001
	1069	; PRCA4. 5303 - Ch anged loop to use th e "AD" ind ex on 361. 1 so that the number of record s checked is limited by
	1070	; the STA RT and END dates of when the E EOB was re ceived in VistA
	1071	F S RCDT =$O(^IBM(3 61.1,"AD", RCDT)) Q:( RCDT>END)! (RCDT="") D
	1072	. S RCEIE N="" F S RCEIEN=$O( ^IBM(361.1 ,"AD",RCDT ,RCEIEN)) Q:RCEIEN=" " D ;
	1073	. . S RCB ILL=$P(^IB M(361.1,RC EIEN,0),U, 1)
	1074	. . I ($P (^PRCA(430 ,RCBILL,0) ,U,8)=RCAC T),$$INCLU DE(.RCINS, RCBILL,RCE IEN,RCMDRX ),$$EEOB(R CBILL,.RCE OB,RCZRO) D
	1075	. . . S ( RCTOT,RCEO B,SN)=0 F S RCEOB=$ O(RCEOB(RC EOB)) Q:'R CEOB F S SN=$O(RCE OB(RCEOB,S N)) Q:'SN D
	1076	. . . . S RCTOT=RCT OT+$G(^IBM (361.1,RCE OB,1))
	1077	. . . . S ^TMP($J," RCSORT",$$ INSNM(RCBI LL),$$SL1( RCSORT,RCB ILL),RCBIL L,+RCEOB(R CEOB,SN)_" _"_RCEOB_" _"_SN,RCEO B)=$P(RCEO B(RCEOB,SN ),U,2) ; P RCA*4.5.30 3 add ERA PD AMOUNT
	1078	. . . . I $O(RCEOB( 0)) S ^TMP ($J,"RCSOR T",$$INSNM (RCBILL),$ $SL1(RCSOR T,RCBILL), RCBILL)=RC TOT ;Thi s is from the eob an d will be the same f or each li ne.
	1079	.
	1080	.
	1081	OUTPUT(RCZ ,RCZ0,RCSO RT,RCSTOP, RCINS,RCNE W) ; Outpu t the data
	1082	; RCZ, RC Z0 are the first 2 s ort levels for the a rray
	1083	; RCINS = insurance co info a rray
	1084	; RCSTOP passed by ref - retu rned if us er chooses to stop
	1085	; RCNEW = 1 if the header sho uld be for ced to pri nt
	1086	N ZZ,RCEP D
	1087	S RCBILL= 0 F S RCB ILL=$O(^TM P($J,"RCSO RT",RCZ,RC Z0,RCBILL) ) Q:'RCBIL L!RCSTOP S RCZ1="" F S RCZ1= $O(^TMP($J ,"RCSORT", RCZ,RCZ0,R CBILL,RCZ1 )) Q:RCZ1= ""!RCSTOP D
	1088	. I $D(ZT QUEUED),$$ S^%ZTLOAD S (RCSTOP, ZTSTOP)=1 K ZTREQ I +$G(RCSTOP ) W !!,"** TASK STOP PED BY USE R**" Q
	1089	. ; IA 19 92 - BILL/ CLAIMS fil e (#399)
	1090	. S RC399 =$G(^DGCR( 399,RCBILL ,0)),RC399 M1=$G(^DGC R(399,RCBI LL,"M1")), RCPT=+$P(R C399,U,2), RC430=$G(^ PRCA(430,R CBILL,0)) ;RC430 is from the t op level
	1091	. ; PRCA* 4.5*276 - Check for Division
	1092	. I VAUTD =0 Q:$P(RC 399,U,22)= "" Q:$G(V AUTD($P(RC 399,U,22)) )=""
	1093	. ; PRCA* $.5*303 Ch eck for me dical or p harmacy cl aims, don' t check fu rther if w e are repo rting both
	1094	. I RCMDR X'="B" S Z Z=$S((RCMD RX="P")&($ P(RC399M1, U,8)'=""): 1,(RCMDRX= "M")&($P(R C399M1,U,8 )=""):1,1: 0) Q:ZZ=0
	1095	. S RCSTO P=$$NEWPG( .RCINS,RCN EW) S RCNE W=0 Q:RCST OP
	1096	. S RCSTO P=$$NEWPG( .RCINS,RCN EW) Q:RCST OP
	1097	.
	1098	.
	1099	.
	1100	INCLUDE(RC INS,RCZ,EO BIEN,RCMDR X,,TRI,CVA ) ; Functi on returns 1 if reco rd should be include d based
	1101	; on ins co
	1102	; RCINS = array con taining in surance co informati on
	1103	; RCZ = i en of the entry in f ile 430
	1104	N OK,RCI, RCINM,RCAI NP
	1105	S OK=0
	1106	S RCI=+$$ INS(RCZ)
	1107	;
	1108	I 'RCI G INCQ ; Not a third p arty bill
	1109	;
	1110	I RCINS=" A" S OK=1
	1111	;
	1112	I RCINS=" S"!(RCINS= "R") D
	1113	. I RCINS ="S" S:$D( RCINS("S", RCI)) OK=1 Q
	1114	. S RCINM =$$INSNM(R CZ) ; INS CO NAME
	1115	. I $S(RC INM=RCINS( "FR")!(RCI NM]RCINS(" FR")):RCIN M']RCINS(" TO"),1:0) S OK=1
	1116	;
	1117	I OK=0 G INCQ ;CHA MPVA and T RICARE doe s not matt er - do no t include
	1118	I OK=1,TR I,CVA G IN CQ ;Add c heck for C HAMPVA and TRICARE
	1119	S RCAINP= $P($G(^PRC A(430,RCZ, 0)),U,2)
	1120	I 'TRI,", 30,31,32," [(","_RCAI NP_",") S OK=0 ;Only exclude T RICARE
	1121	I 'CVA,", 27,28,29," [(","_RCAI NP_",") S OK=0 ;Only exclude C HAMPVA
	1122	I '$$ISTY PE^RCDPEU( 361.1,EOBI EN,RCMDRX) S OK=0
	1123	;
	1124	INCQ Q OK
	1125	;
	1126	.
	1127	.
	1128	.
	1129	SELECT(RCI NS,RCSORT, RCZRO,RCMD RX) ; Sele ct insuran ce co, sor t criteria , Zero Pay ment, Bill type (Med /RX) and i f output f or EXCEL f ormat is s elected
	1130	; Functio n returns values sel ected for RCSORT and RCINS - p assed by r ef
	1131	N RCQUIT, DONE,DIR,X ,Y,%DT
	1132	S (RCQUIT ,DONE,RCLS TMGR)=0
	1133	;
	1134	S RCMDRX= $$RTYPE^RC DPEU1("A") ; US786 - Standard prompt for MED/PHARM /TRIC/ALL
	1135	I RCMDRX= -1 G SELQ
	1136	;
	1137	S DIR(0)= "SA^A:ALL; S:SPECIFIC ;R:RANGE", DIR("A")=" RUN REPORT FOR (A)LL , (S)PECIF IC, OR (R) ANGE OF IN SURANCE CO MPANIES?: ",DIR("B") ="ALL" W ! D ^DIR K DIR
	1138	I $D(DTOU T)!$D(DUOU T) G SELQ
	1139	;
	1140	S RCINS=Y
	1141	I RCINS=" S" D G:RC QUIT SELQ
	1142	. W !
	1143	. F D LI ST(.DIR,.R CINS) S DI R("A")="SE LECT "_$S( $O(RCINS(" S",0)):"AN OTHER ",1: "")_"INSUR ANCE COMPA NY"_$S($O( RCINS("S", 0)):" (PRE SS RETURN WHEN DONE) ",1:"")_": ",DIR(0)= "PAO^DIC(3 6,:AEMQ" D ^DIR K DI R D Q:Y'> 0
	1144	.. I $D(D TOUT)!$D(D UOUT) S RC QUIT=1 Q
	1145	.. I Y>0 S RCINS("S ",+Y)=""
	1146	. I '$O(R CINS("S",0 )) S RCQUI T=1 W !!," NO INSURAN CE COMPANI ES SELECTE D - NO REP ORT GENERA TED" S DIR (0)="E" D ^DIR K DIR
	1147	;
	1148	I RCINS=" R" D I RC QUIT W !!, "NO INSURA NCE COMPAN Y NAME RAN GE SELECTE D - NO REP ORT GENERA TED" S DIR (0)="E" D ^DIR K DIR G SELQ
	1149	. W !
	1150	. S DIR(" ?")="ENTER 1-30 UPPE RCASE CHAR ACTERS OF THE FIRST NAME TO IN CLUDE"
	1151	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="START WI TH INSURAN CE COMPANY NAME: " D ^DIR K DI R
	1152	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	1153	. S RCINS ("FR")=Y
	1154	. S DIR(" ?")="ENTER 1-30 UPPE RCASE CHAR ACTERS OF THE LAST N AME TO INC LUDE"
	1155	. S DIR(0 )="FA^1:30 ^K:X'?.U X ",DIR("A") ="GO TO IN SURANCE CO MPANY NAME : ",DIR("B ")=$E(RCIN S("FR"),1, 27)_"ZZZ"
	1156	. F W ! D ^DIR Q:$ S($D(DTOUT )!$D(DUOUT ):1,1:RCIN S("FR")']Y ) W !,"'GO TO' NAME MUST COME AFTER 'STA RT WITH' N AME"
	1157	. K DIR
	1158	. I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
	1159	. S RCINS ("TO")=Y
	1160	; PRCA4. 5303 - Ad d Zero $ P rompt and Medical/Ph armacy EEO Bs Prompt
	1161	S DIR(0)= "SA^A:ALL; Z:ZERO PAY MENT EEOBs ",DIR("A") ="RUN REPO RT FOR (A) LL EEOBs o r (Z)ERO P AYMENT EEO Bs only: " ,DIR("B")= "ALL" W ! D ^DIR K D IR
	1162	I $D(DTOU T)!$D(DUOU T) G SELQ
	1163	;
	1164	S RCZRO=$ E(Y,1)
	1165	S DIR(0)= "SA^M:MEDI CAL;P:PHAR MACY;T:TRI CARE;A:ALL "
	1166	S DIR("A" )="RUN REP ORT FOR (M )EDICAL, ( P)HARMACY, (T)ICARE OR (A)LL: ",DIR("B") ="ALL"
	1167	W ! D ^DI R K DIR
	1168	I $D(DTOU T)!$D(DUOU T) G SELQ
	1169	;
	1170	S RCMDRX= $E(Y,1)
	1171	;
	1172	S DIR(0)= "SA^P:PATI ENT NAME;L :LAST 4 OF PATIENT S SN",DIR("A ")="WITHIN INS CO, S ORT BY (P) ATIENT NAM E OR (L)AS T 4 OF SSN ?: ",DIR(" B")="PATIE NT NAME" W ! D ^DIR K DIR
	1173	I $D(DTOU T)!$D(DUOU T) G SELQ
	1174	S RCSORT= $S(Y="P":" PN",1:"L4" )
	1175	S DIR(0)= "SA^F:FIRS T TO LAST; L:LAST TO FIRST",DIR ("A")="SOR T "_$S(RCS ORT="PN":" PATIENT NA ME",1:"LAS T 4")_" (F )IRST TO L AST OR (L) AST TO FIR ST?: ",DIR ("B")="FIR ST TO LAST " D ^DIR K DIR
	1176	I $D(DTOU T)!$D(DUOU T) G SELQ
	1177	I Y="L" S RCSORT=RC SORT_";-"
	1178	;
	1179	; PRCA4. 5298 - Ad d Date Ran ge Prompts
	1180	K DIR
	1181	S DIR("?" )="ENTER T HE EARLIES T RECEIVED DATE TO I NCLUDE ON THE REPORT "
	1182	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="ST ART DATE ( RECEIVED): ",DIR("B" )="T" D ^D IR K DIR
	1183	I $D(DTOU T)!$D(DUOU T)!(Y="") G SELQ
	1184	S START=Y
	1185	K DIR
	1186	S DIR("?" )="ENTER T HE LATEST RECEIVED D ATE TO INC LUDE ON TH E REPORT"
	1187	S DIR("B" )="T"
	1188	S DIR(0)= "DAO^"_STA RT_":"_DT_ ":APE",DIR ("A")="END DATE (REC EIVED): " D ^DIR K D IR
	1189	I $D(DTOU T)!$D(DUOU T)!(Y="") G SELQ
	1190	S END=Y
	1191	;
	1192	; PRCA4. 5298 - Ad d TRICARE Prompt
	1193	S TRIC=$$ INTRICAR^R CDPEARL G: TRIC<0 SEL Q
	1194	;
	1195	; PRCA4. 5298 - Ad d CHAMPVA Prompt
	1196	S CHAM=$$ INCHMPVA^R CDPEARL G: CHAM<0 SEL Q
	1197	;
	1198	; PRCA4. 5276 - De termine wh ether to g ather data for Excel report.
	1199	S RCDISPT Y=$$DISPTY ^RCDPEM3 G SELQ:RCDI SPTY<0
	1200	I RCDISPT Y D INFO^R CDPEM6 S D ONE=1 G SE LQ
	1201	;
	1202	; PRCA4. 5298 - Ad d ListMana ger Prompt s
	1203	S RCLSTMG R=$$ASKLM^ RCDPEARL G :RCLSTMGR< 0 SELQ
	1204	;
	1205	S DONE=1
	1206	;
	1207	SELQ ;
	1208	Q DONE
	1209	.
	1210	.
	1211	.
	1212	HDRBLD ; c reate the report hea der
	1213	; returns RCHDR,RCP GNUM,RCSTO P
	1214	; RCHDR(0 ) = header text line count
	1215	; RCHDR(" PGNUM") = page numbe r
	1216	; RCHDR(" XECUTE") = M code fo r page num ber
	1217	; RCHDR(" RUNDATE") = date/tim e report g enerated
	1218	; RCPGNUM - page co unter
	1219	; RCSTOP - flag to stop listi ng
	1220	;INPUT:
	1221	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	1222	; RCPAY - Payer fil ter value( s)
	1223	; RCLSTMG R
	1224	;
	1225	N Z0
	1226	S Z0=""
	1227	K RCHDR S RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
	1228	;
	1229	I RCDISPT Y D Q ; Excel form at, xecute code is Q UIT, null page numbe r
	1230	. S RCHDR (0)=1,RCHD R("XECUTE" )="Q",RCPG NUM=""
	1231	. S RCHDR (1)="PATIE NT NAME^SS N^BILL#^IN S CO NAME^ BALANCE^AM T BILLE^AM T PAID^TRA CE#^DT REC 'D^DT POST ^ERA PD AM T"
	1232	;
	1233	N MSG,DAT E,Y,DIV,HC NT
	1234	S RCHDR(1 )=$$HDRNM, HCNT=1 ; l ine 1 will be replac ed by XECU TE code be low
	1235	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"
	1236	;
	1237	S Y="RUN DATE: "_RC HDR("RUNDA TE"),HCNT= HCNT+1,RCH DR(HCNT)=$ J("",80-$L (Y)\2)_Y
	1238	I VAUTD=1 S Y="DIVI SIONS: ALL "
	1239	I VAUTD=0 D
	1240	. S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0="" S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
	1241	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Y )\2)_Y
	1242	I RCINS=" S" S Z=0,Z 0="" F S Z=$O(RCINS ("S",Z)) Q :'Z S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
	1243	S Z0="PAY ERS: "_$S( RCINS="A": "ALL ",RCI NS="R":"RA NGE FROM " _RCINS("FR ")_"-"_RCI NS("TO"),1 :"")_Z0
	1244	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0,Z 0=""
	1245	S Z0=Z0_" DATE RANGE : "_$$FMTE ^XLFDT(STA RT,"2Z")_" -"_$$FMTE^ XLFDT(END, "2Z")_" EE OBs: "_$S( RCMDRX="M" :"MEDICAL" ,RCMDRX="P ":"PHARMAC Y",RCMDRX= "T":"TRICA RE",1:"ALL ")
	1246	S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0
	1247	;
	1248	S HCNT=HC NT+1,RCHDR (HCNT)=""
	1249	S Y="PATI ENT NAME S SN BILL#", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1250	S Y="INS CO NAME BA LANCE AMT BILLED AMT PAID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	1251	S Y=" TRA CE# ERA PD AMT REC'D DT POST", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1252	S Y=$TR($ J("",IOM), " ","="),H CNT=HCNT+1 ,RCHDR(HCN T)=Y
	1253	S RCHDR(0 )=HCNT
	1254	Q
	1255	;
	1256	HDRLM ; cr eate the l ist manage r version of the rep ort header
	1257	; returns RCHDR,RCP GNUM,RCSTO P
	1258	; RCHDR(0 ) = header text line count
	1259	; RCHDR(" PGNUM") = page numbe r
	1260	; RCHDR(" XECUTE") = M code fo r page num ber
	1261	; RCHDR(" RUNDATE") = date/tim e report g enerated
	1262	; RCPGNUM - page co unter
	1263	; RCSTOP - flag to stop listi ng
	1264	;INPUT:
	1265	; RCDTRNG - date ra nge filter value to be printed as part o f the head er
	1266	; RCPAY - Payer fil ter value( s)
	1267	; RCLSTMG R
	1268	;
	1269	N Z0 S Z0 =""
	1270	K RCHDR S RCPGNUM=0 ,RCSTOP=0
	1271	N MSG,DAT E,Y,DIV,HC NT
	1272	S RCHDR(" TITLE")=$$ HDRNM,RCHD R("XECUTE" )="Q"
	1273	S RCHDR(1 )="DATE RA NGE: "_$$F MTE^XLFDT( START,"2Z" )_"-"_$$FM TE^XLFDT(E ND,"2Z")_" EEOBs: "_ $S(RCMDRX= "M":"MEDIC AL",RCMDRX ="P":"PHAR MACY",RCMD RX="T":"TR ICARE",1:" ALL"),HCNT =1
	1274	I VAUTD=1 S Y="DIVI SIONS: ALL "
	1275	I VAUTD=0 D
	1276	. S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0="" S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
	1277	S HCNT=HC NT+1,RCHDR (HCNT)=Y
	1278	I RCINS=" S" S Z=0,Z 0="" F S Z=$O(RCINS ("S",Z)) Q :'Z S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
	1279	S Z0="PAY ERS: "_$S( RCINS="A": "ALL ",RCI NS="R":"RA NGE FROM " _RCINS("FR ")_" - "_R CINS("TO") ,1:"")_Z0
	1280	S HCNT=HC NT+1,RCHDR (HCNT)=Z0
	1281	I RCINS=" A" S HCNT= HCNT+1,RCH DR(HCNT)=" "
	1282	;
	1283	S Y="PATI ENT NAME S SN BILL#", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1284	S Y="INS CO NAME BA LANCE AMT BILLED AMT PAID",HCN T=HCNT+1,R CHDR(HCNT) =Y
	1285	S Y=" TRA CE# ERA PD AMT REC'D DT POST", HCNT=HCNT+ 1,RCHDR(HC NT)=Y
	1286	S RCHDR(0 )=HCNT
	1287	Q
	1288	.
	1289	.
	1290	.
	1291	RoutinesAc tivitiesRo utine Name RCDPEADPEn hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE AUTO-DECRE ASE REPORT Related Ro utinesRout ines “Call ed By”Rout ines “Call ed” RCDP EAD1 CAR CS^RCDPEAD 1
	1292	COMPILE ^RCDPEAD1
	1293	HDR^RCD PEAD1
	1294	LMAN^RC DPEAD1
	1295	LMOUT^R CDPEAD1
	1296	TOTALD^ RCDPEAD1
	1297	TOTALG^ RCDPEAD1
	1298	$$ASKLM ^RCDPEARL
	1299	$$ENDOR PRT^RCDPEA RL
	1300	$$ASKST OP^RCDPELA R
	1301	INFO^RC DPEM6
	1302	$$PNM4^RCD PEWL1 Current Lo gic - RCDP EADPRCDPEA DP ;OI D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	1303	;;4.5;Acc ounts Rece ivable;2 98,318;M ar 20, 199 5;Build 12 1
	1304	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1305	; Read ^D GCR(399) v ia Private IA 3820
	1306	; Read ^D G(40.8) vi a Controll ed IA 417
	1307	; Read ^I BM(361.1) via Privat e IA 4051
	1308	; Use DIV ISION^VAUT OMA via Co ntrolled I A 664
	1309	;
	1310	RPT ; entr y point fo r Auto-Dec rease Adju stment rep ort [RCDPE AUTO-DECR EASE REPOR T]
	1311	N INPUT,R CVAUTD
	1312	S INPUT=$ $STADIV(.R CVAUTD) ; Division f ilter
	1313	Q:'INPUT ; '^ ' or timeo ut
	1314	S $P(INPU T,"^",2)=$ $ASKSORT() ; Select Sort Crite ria
	1315	Q:$P(INPU T,"^",2)=" 0" ; '^ ' or timeo ut
	1316	S $P(INPU T,"^",3)=$ $SORTORD($ P(INPUT,"^ ",2)) ; Se lect Sort Order
	1317	Q:$P(INPU T,"^",3)=" 0" ; '^ ' or timeo ut
	1318	S $P(INPU T,"^",4)=$ $DTRNG() ; Select Da te Range f or Report
	1319	Q:'$P(INP UT,"^",4) ; '^' or t imeout
	1320	S $P(INPU T,"^",4)=$ P($P(INPUT ,"^",4),"\| ",2,3)
	1321	S $P(INPU T,"^",6)=$ $ASKLM^RCD PEARL ; As k to Displ ay in List man Templa te
	1322	Q:$P(INPU T,"^",6)<0 ; '^' or timeout
	1323	I $P(INPU T,"^",6)=1 D Q ; Compile da ta and cal l listman to display
	1324	. D LMOUT ^RCDPEAD1( INPUT,.RCV AUTD,.IO)
	1325	S $P(INPU T,"^",5)=$ $DISPTY() ; Select D isplay Typ e
	1326	Q:$P(INPU T,"^",5)=- 1 ; '^' or timeout
	1327	D:$P(INPU T,"^",5)=1 INFO^RCDP EM6 ; Disp lay captur e informat ion for Ex cel
	1328	Q:'$$DEVI CE($P(INPU T,"^",5),. IO) ; Ask output dev ice
	1329	;
	1330	.
	1331	.
	1332	.
	1333	DTRNG() ; Get the da te range f or the rep ort
	1334	; Input: None
	1335	; Returns : A1\|A2\|A3 - Where:
	1336	; A1 - 0 - User up- arrowed or timed out , 1 otherw ise
	1337	; A2 - Au to-Post St art Date
	1338	; A3 - Au to-Post En d Date
	1339	N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RCEND,RC START,RNGF LG,X,Y
	1340	D DATES(. RCSTART,.R CEND)
	1341	Q:RCSTART =-1 0
	1342	Q:RCSTART "1\|"_RCST ART_"\|"_RC END
	1343	Q:'RCSTAR T "0\|\|"
	1344	Q 0
	1345	;Modified Logic (Ch anges are in bold) - RCDPEADPR CDPEADP ;O I D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	1346	;;4.5;Acc ounts Rece ivable;2 98,318;M ar 20, 199 5;Build 12 1
	1347	;;Per VA Directive 6402, this routine s hould not be modifie d.
	1348	; Read ^D GCR(399) v ia Private IA 3820
	1349	; Read ^D G(40.8) vi a Controll ed IA 417
	1350	; Read ^I BM(361.1) via Privat e IA 4051
	1351	; Use DIV ISION^VAUT OMA via Co ntrolled I A 664
	1352	;
	1353	RPT ; entr y point fo r Auto-Dec rease Adju stment rep ort [RCDPE AUTO-DECR EASE REPOR T]
	1354	N INPUT,R CVAUTD
	1355	S INPUT=$ $STADIV(.R CVAUTD) ; Division f ilter
	1356	Q:'INPUT ; '^ ' or timeo ut
	1357	S $P(INPU T,"^",2)=$ $ASKSORT() ; Select Sort Crite ria
	1358	Q:$P(INPU T,"^",2)=" 0" ; '^ ' or timeo ut
	1359	S $P(INPU T,"^",3)=$ $SORTORD($ P(INPUT,"^ ",2)) ; Se lect Sort Order
	1360	Q:$P(INPU T,"^",3)=" 0" ; '^ ' or timeo ut
	1361	S $P(INPU T,"^",4)=$ $DTRNG() ; Select Da te Range f or Report
	1362	Q:'$P(INP UT,"^",4) ; '^' or t imeout
	1363	S $P(INPU T,"^",4)=$ P($P(INPUT ,"^",4),"\| ",2,3)
	1364	S $P(INPU T,"^",7)=$ $RTYPE^RCD PEU1(DEF)
	1365	I $P(INPU T,"^",7)<0 Q
	1366	S $P(INPU T,"^",6)=$ $ASKLM^RCD PEARL ; As k to Displ ay in List man Templa te
	1367	Q:$P(INPU T,"^",6)<0 ; '^' or timeout
	1368	I $P(INPU T,"^",6)=1 D Q ; Compile da ta and cal l listman to display
	1369	. D LMOUT ^RCDPEAD1( INPUT,.RCV AUTD,.IO)
	1370	S $P(INPU T,"^",5)=$ $DISPTY() ; Select D isplay Typ e
	1371	Q:$P(INPU T,"^",5)=- 1 ; '^' or timeout
	1372	D:$P(INPU T,"^",5)=1 INFO^RCDP EM6 ; Disp lay captur e informat ion for Ex cel
	1373	Q:'$$DEVI CE($P(INPU T,"^",5),. IO) ; Ask output dev ice
	1374	;
	1375	.
	1376	.
	1377	.
	1378	.RoutinesA ctivitiesR outine Nam eRCDPEAD1E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE AUTO-DECR EASE REPOR TRelated R outinesRou tines “Cal led By”Rou tines “Cal led” RCD PEADP $$ CARCLMT^RC DPEAD
	1379	$$LINE^ RCDPEADP
	1380	ASK^RCD PEADP
	1381	REPORT^ RCDPEADP
	1382	SAVE^RC DPEADP
	1383	LMRPT^RCDP EARL Curre nt Logic – RCDPEAD1R CDPEAD1 ;O I D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	1384	.
	1385	.
	1386	.
	1387	COMPILE(IN PUTS,RCVAU TD,DTOTAL, GTOTAL) ; EP Generat e the Auto -Decrease report ^TM P array
	1388	; Input: INPUTS - A 1^A2^A3^.. .^An Where :
	1389	; A1 - 1 - All divi sions sele cted
	1390	; 2 - Sel ected divi sions
	1391	; A2 - C - Sort by Claim
	1392	; P - Sor t by Payer
	1393	; N - Sor t by Patie nt Name
	1394	; A3 - F - First to Last Sort Order
	1395	; L - Las t to First Sort Orde r
	1396	; A4 - B1 \|B2
	1397	; B1 - Au to-Post St art Date
	1398	; B2 - Au to-Post En d Date
	1399	; A5 - 1 - Output t o Excel
	1400	; 2 - Oth erwise
	1401	; RCVAUTD - Array o f selected Divisions
	1402	; Only pa ssed if A1 =2
	1403	; Output: DTOTAL() - Array of totals by Auto-Post Date
	1404	; GTOTAL - Grand to tals
	1405	; ^TMP("R CDPEADP",$ J) - Array of report data
	1406	; See SAV E for a fu ll descrip tion
	1407	N ADDATE, CARCS,END, ERAIEN,EOB IEN,EXCEL, RCTR,RCRZ, RCSORT,STA ,STNAM,STN UM,XX
	1408	;
	1409	S XX=$P(I NPUTS,"^", 4) ; Auto- Post Date range
	1410	S ADDATE= $$FMADD^XL FDT($P(XX, "\|",1),-1)
	1411	S END=$P( XX,"\|",2) ; Auto-Pos t End Date
	1412	S RCTR=0 ; Record c ounter
	1413	S EXCEL=$ P(INPUTS," ^",5) ; 1 output to Excel, 0 o therwise
	1414	S RCSORT= $P(INPUTS, "^",2) ; S ort Type
	1415	;
	1416	; ^RCY(34 4.4,0) = " ELECTRONIC REMITTANC E ADVICE^3 44.4I^"
	1417	; G cross -ref. REGU LAR WHOLE FILE (#344 .4)
	1418	; Field: AUTO-POST DATE (344. 41,9)
	1419	; Scan G index for ERA within date rang e
	1420	F S ADDA TE=$O(^RCY (344.4,"G" ,ADDATE)) Q:'ADDATE Q:(ADDATE \1)>END D
	1421	. S ERAIE N=""
	1422	. F D Q :'ERAIEN
	1423	. . S ERA IEN=$O(^RC Y(344.4,"G ",ADDATE,E RAIEN))
	1424	. . Q:'ER AIEN
	1425	. . D ERA STA(ERAIEN ,.STA,.STN UM,.STNAM) ; Check f or valid D ivision
	1426	. . I $P( INPUTS,"^" ,1)=2,'$D( RCVAUTD(ST A)) Q ; Not a vali d Division
	1427	. . ;Modi fied Logic (Changes are in bol d) – RCDPE AD1RCDPEAD 1 ;OI D N S /PJH - AUT O-DECREASE REPORT ;N ov 23, 201 4@12:48:50
	1428	.
	1429	.
	1430	.
	1431	COMPILE(IN PUTS,RCVAU TD,DTOTAL, GTOTAL) ; EP Generat e the Auto -Decrease report ^TM P array
	1432	; Input: INPUTS - A 1^A2^A3^.. .^An Where :
	1433	; A1 - 1 - All divi sions sele cted
	1434	; 2 - Sel ected divi sions
	1435	; A2 - C - Sort by Claim
	1436	; P - Sor t by Payer
	1437	; N - Sor t by Patie nt Name
	1438	; A3 - F - First to Last Sort Order
	1439	; L - Las t to First Sort Orde r
	1440	; A4 - B1 \|B2
	1441	; B1 - Au to-Post St art Date
	1442	; B2 - Au to-Post En d Date
	1443	; A5 - 1 - Output t o Excel
	1444	; 2 - Oth erwise
	1445	; RCVAUTD - Array o f selected Divisions
	1446	; Only pa ssed if A1 =2
	1447	; Output: DTOTAL() - Array of totals by Auto-Post Date
	1448	; GTOTAL - Grand to tals
	1449	; ^TMP("R CDPEADP",$ J) - Array of report data
	1450	; See SAV E for a fu ll descrip tion
	1451	N ADDATE, CARCS,END, ERAIEN,EOB IEN,EXCEL, RCTR,RCRZ, RCSORT,RCT YPE,STA,ST NAM,STNUM, XX
	1452	;
	1453	S XX=$P(I NPUTS,"^", 4) ; Auto- Post Date range
	1454	S ADDATE= $$FMADD^XL FDT($P(XX, "\|",1),-1)
	1455	S END=$P( XX,"\|",2) ; Auto-Pos t End Date
	1456	S RCTR=0 ; Record c ounter
	1457	S EXCEL=$ P(INPUTS," ^",5) ; 1 output to Excel, 0 o therwise
	1458	S RCSORT= $P(INPUTS, "^",2) ; S ort Type
	1459	S RCTYPE= $P(INPUTS, "^",7) ; U S786 Payer Type
	1460	;
	1461	; ^RCY(34 4.4,0) = " ELECTRONIC REMITTANC E ADVICE^3 44.4I^"
	1462	; G cross -ref. REGU LAR WHOLE FILE (#344 .4)
	1463	; Field: AUTO-POST DATE (344. 41,9)
	1464	; Scan G index for ERA within date rang e
	1465	F S ADDA TE=$O(^RCY (344.4,"G" ,ADDATE)) Q:'ADDATE Q:(ADDATE \1)>END D
	1466	. S ERAIE N=""
	1467	. F D Q :'ERAIEN
	1468	. . S ERA IEN=$O(^RC Y(344.4,"G ",ADDATE,E RAIEN))
	1469	. . Q:'ER AIEN
	1470	. . D ERA STA(ERAIEN ,.STA,.STN UM,.STNAM) ; Check f or valid D ivision
	1471	. . I $P( INPUTS,"^" ,1)=2,'$D( RCVAUTD(ST A)) Q ; Not a vali d Division
	1472	. . I RC TYPE'="A", '$$ISTYPE^ RCDPEU1(34 4.4,ERAIEN ,RCTYPE) Q ; Not a valid paye r type
	1473	. . ;Rout inesActivi tiesRoutin e NameRCDP EAPPEnhanc ement Cate gory New M odify Dele te No Chan geRTMRelat ed Options RCDPE AUTO -POST REPO RTRelated RoutinesRo utines “Ca lled By”Ro utines “Ca lled” No ne COMPI LE^RCDPEAP Q
	1474	$$ENDOR PRT^RCDPEA RL
	1475	INFO^RC DPEM6
	1476	$$GETPA Y^RCDPEM9
	1477	$$RTYPE^RC DPESP2 Current Lo gic - RCDP EAPPRCDPEA PP ;OI D N S /PJH - AUT O POST REP ORT ;Dec 2 0, 2014@18 :42
	1478	;;4.5;Acc ounts Rece ivable;2 98,304,326 ;Mar 20, 1995;Buil d 104
	1479	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1480	;Read ^DG CR(399) vi a Private IA 3820
	1481	;Read ^DG (40.8) via Controlle d IA 417
	1482	;Read ^IB M(361.1) v ia Private IA 4051
	1483	;Use DIVI SION^VAUTO MA via Con trolled IA 664
	1484	; PRCA4. 5326 - Ex tensive re -write of this routi ne to add selection/ sort by Pa yer TIN
	1485	RPT ; entr y point fo r Auto-Pos t Report [ RCDPE AUTO -POST REPO RT]
	1486	N POP,RCD ISP,RCDIV, RCDIVS,RCD TRNG,RCJOB ,RCLAIM,RC PAGE,RCPAR RAY,RCPAY, RCPROG,RCR ANGE
	1487	N RCSORT, RCTYPE,RCW HICH,STANA M,STANUM,X ,Y
	1488	S (RCDTRN G,RCPAGE)= 0,RCPROG=" RCDPEAPP", RCJOB=$J ; Initia lize page and start point
	1489	S RCDIV=$ $STADIV(.R CDIVS) Q:' RCDIV ; Select Filter/So rt by Divi sion
	1490	S RCTYPE= $$DETORSUM () Q:RCTYP E=-1 ; Det ail or Sum mary mode
	1491	S RCLAIM= $$RTYPE^RC DPESP2() Q :RCLAIM=-1 ; PRCA4. 5304 Clai m Type fil ter
	1492	S RCWHICH =$$NMORTIN () Q:RCWHI CH=-1 ; Fi lter by Pa yer Name o r TIN
	1493	S RCPAY=$ $GETPAY^RC DPEM9(344. 4,1,0,RCWH ICH,1) ; P ayer Name filter
	1494	I RCPAY<0 Q
	1495	D:$P(RCPA Y,U,1)'=2 SELPAY(RCJ OB,.RCPARR AY) ; Crea te local P ayer array
	1496	S RCSORT= $$SORTT() Q:RCSORT=- 1 ; Select Sort
	1497	S RCRANGE =$$DTRNG() Q:RCRANGE =0 ; Selec t Date Ran ge for Rep ort
	1498	S RCDISP= $$DISPTY() Q:RCDISP= -1 ; Outpu t to Excel ?
	1499	I RCDISP D INFO^RCD PEM6 ; Dis play captu re informa tion for E xcel
	1500	;
	1501	;
	1502	; PRCA4. 5304 - If not Excel , inform u ser to mak e sure pri nter/scree n will dis play 132
	1503	; columns
	1504	I 'RCDISP W !,"This report re quires 132 column di splay."
	1505	S %ZIS="Q M" D ^%ZIS Q:POP ; Select output de vice
	1506	;
	1507	; Option to queue
	1508	I 'RCDISP ,$D(IO("Q" )) D Q
	1509	. N ZTDES C,ZTQUEUED ,ZTRTN,ZTS AVE,ZTSK
	1510	. S ZTRTN ="REPORT^R CDPEAPP"
	1511	. S ZTDES C="EDI LOC KBOX AUTO POST REPOR T"
	1512	. S ZTSAV E("RC")=" " ;FA* ,ZTSAVE("V AUTD")=""
	1513	. D ^%ZTL OAD
	1514	. I $D(ZT SK) W !!," Task numbe r "_ZTSK_" was queue d."
	1515	. E W !! ,"Unable t o queue th is job."
	1516	. K IO("Q ")
	1517	. D HOME^ %ZIS
	1518	;
	1519	D REPORT ; Compil e and prin t report
	1520	Q
	1521	;Modified Logic (Ch anges are in bold) - RCDPEAPPR CDPEAPP ;O I D N S /PJH - AUT O POST REP ORT ;Dec 2 0, 2014@18 :42
	1522	;;4.5;Acc ounts Rece ivable;2 98,304,326 ;Mar 20, 1995;Buil d 104
	1523	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1524	;Read ^DG CR(399) vi a Private IA 3820
	1525	;Read ^DG (40.8) via Controlle d IA 417
	1526	;Read ^IB M(361.1) v ia Private IA 4051
	1527	;Use DIVI SION^VAUTO MA via Con trolled IA 664
	1528	; PRCA4. 5326 - Ex tensive re -write of this routi ne to add selection/ sort by Pa yer TIN
	1529	RPT ; entr y point fo r Auto-Pos t Report [ RCDPE AUTO -POST REPO RT]
	1530	N POP,RCD ISP,RCDIV, RCDIVS,RCD TRNG,RCJOB ,RCLAIM,RC PAGE,RCPAR ,RCPARRAY, RCPAY,RCPR OG,RCRANGE
	1531	N RCSORT, RCTYPE,RCW HICH,STANA M,STANUM,X ,Y
	1532	S (RCDTRN G,RCPAGE)= 0,RCPROG=" RCDPEAPP", RCJOB=$J ; Initia lize page and start point
	1533	S RCDIV=$ $STADIV(.R CDIVS) Q:' RCDIV ; Select Filter/So rt by Divi sion
	1534	S RCTYPE= $$DETORSUM () Q:RCTYP E=-1 ; Det ail or Sum mary mode
	1535	S RCLAIM= $$RTYPE^RC DPEU1() Q: RCLAIM=-1 ; PRCA4.5 304 Claim Type filt er
	1536	S RCWHICH =$$NMORTIN () Q:RCWHI CH=-1 ; Fi lter by Pa yer Name o r TIN
	1537	;
	1538	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	1539	Q:RCPAR(" SELC")=-1 ; US786 '^ ' or timeo ut
	1540	S RCPAY=R CPAR("SELC ")
	1541	;
	1542	I RCPAR(" SELC")'="A " D Q:XX= -1 ; US786 - Since w e don't wa nt all pay ers
	1543	. S RCPAR ("TYPE")=R CLAIM
	1544	. S RCPAR ("SRCH")=$ s(RCWHICH= 2:"T",1:"N ") ; promp t for paye rs we do w ant
	1545	. S RCPAR ("FILE")=3 44.4
	1546	. S RCPAR ("DICA")=" Select Ins urance Com pany"_$S(R CWHICH=1:" NAME: ",1 :" TIN: ")
	1547	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	1548	;
	1549	; D:$P(RC PAY,U,1)'= 2 SELPAY(R CJOB,.RCPA RRAY) ; Cr eate local Payer arr ay
	1550	S RCSORT= $$SORTT() Q:RCSORT=- 1 ; Select Sort
	1551	S RCRANGE =$$DTRNG() Q:RCRANGE =0 ; Selec t Date Ran ge for Rep ort
	1552	S RCDISP= $$DISPTY() Q:RCDISP= -1 ; Outpu t to Excel ?
	1553	I RCDISP D INFO^RCD PEM6 ; Dis play captu re informa tion for E xcel
	1554	;
	1555	; PRCA4. 5304 - If not Excel , inform u ser to mak e sure pri nter/scree n will dis play 132
	1556	; columns
	1557	I 'RCDISP W !,"This report re quires 132 column di splay."
	1558	S %ZIS="Q M" D ^%ZIS Q:POP ; Select output de vice
	1559	;
	1560	;
	1561	; Option to queue
	1562	I 'RCDISP ,$D(IO("Q" )) D Q
	1563	. N ZTDES C,ZTQUEUED ,ZTRTN,ZTS AVE,ZTSK
	1564	. S ZTRTN ="REPORT^R CDPEAPP"
	1565	. S ZTDES C="EDI LOC KBOX AUTO POST REPOR T"
	1566	. S ZTSAV E("RC")=" " ;FA* ,ZTSAVE("V AUTD")=""
	1567	. S ZTSAV E("^TMP("" RCDPEU1"", $J,")=""
	1568	. D ^%ZTL OAD
	1569	. I $D(ZT SK) W !!," Task numbe r "_ZTSK_" was queue d."
	1570	. E W !! ,"Unable t o queue th is job."
	1571	. K IO("Q ")
	1572	. D HOME^ %ZIS
	1573	;
	1574	D REPORT ; Compil e and prin t report
	1575	Q
	1576	.
	1577	.
	1578	.RoutinesA ctivitiesR outine Nam eRCDPEAPQE nhancement Category New Modify Delete No ChangeRTM Related Op tionsRelat ed Routine sRoutines “Called By ”Routines “Called” RCDPEAPP $$PHARM^ RCDPEAP1
	1579	$$PNM4^ RCDPEWL1 Current Logic - R CDPEAPQ.
	1580	.
	1581	.
	1582	COMPILE ; Generate t he Auto Po sting repo rt ^TMP ar ray
	1583	; Input: GLOB - "^T MP("RCDPEA PP",$J)"
	1584	; RCDISP - 0 - Outp ut to pape r or scree n, 1 - Out put to Exc el
	1585	; RCDIV - 1 - All d ivisions, 2 - Select ed divisio ns
	1586	; RCDIVS( )- Array o f selected divisions if RCDIV= 2
	1587	; RCRANGE - 1^Start Date^End Date
	1588	; RCJOB - $J
	1589	; RCLAIM - "M" - Me dical Clai ms, "P" - Pharmacy C laims, "B" - Both
	1590	; RCPAGE - Initiali zed to 0
	1591	; RCPARRA Y- Array o f selected payers
	1592	; RCPROG - "RCDPEAP P"
	1593	; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Pa yer TIN
	1594	; RCWHICH - 1 - Fil ter by Pay er Name, 2 - Filter by Payer T IN
	1595	; RCTYPE - 'D' for detail rep ort, 'S' f or summary
	1596	; ^TMP("R CSELPAY",R CJOB) - Se lected Pay er Names o r TINs
	1597	; Ouput: GTOTAL - A 1^A2^A3^A4 Where:
	1598	; A1 - To tal Count
	1599	; A2 - To tal Origin al Amounts
	1600	; A3 - To tal Paymen t Amounts
	1601	; A4 - To tal Balanc e
	1602	; ^TMP("R CSELPAY",R CJOB,A1)=A 2/A3 Where :
	1603	; A1 - CT R
	1604	; A2 - Pa yer Name i f RCWHICH= 1 else Pay er TIN
	1605	; A3 - Pa yer TIN if RCWHICH=1 else Paye r Name
	1606	N APDATE, CNT,END,ER AIEN,IEN,O KAY,RCECME ,RCRZ,STA, STNAM,STNU M
	1607	S APDATE= $$FMADD^XL FDT($P(RCR ANGE,U,2), -1)
	1608	S END=$P( RCRANGE,U, 3),CNT=0
	1609	;
	1610	; Scan F index for ERA within date rang e
	1611	F S APDA TE=$O(^RCY (344.4,"F" ,APDATE)) Q:'APDATE Q:(APDATE \1)>END D
	1612	. S ERAIE N=""
	1613	. F S ER AIEN=$O(^R CY(344.4," F",APDATE, ERAIEN)) Q :'ERAIEN D
	1614	. . ;
	1615	. . ; Che ck divisio n - Note r eturn valu es are set to UNKNOW N if not a vailable
	1616	. . D ERA STA(ERAIEN ,.STA,.STN UM,.STNAM)
	1617	. . I RCD IV=2,'$D(R CDIVS(STA) ) Q
	1618	. . ;
	1619	. . ; PRC A4.5304 - Check if we includ e this ERA in report
	1620	. . I RCL AIM'="B" D Q:'OKAY ; If both not speci fied check for inclu sion
	1621	. . . S O KAY=1
	1622	. . . S R CECME=$$PH ARM^RCDPEA P1(ERAIEN) ; See if ECME # exi sts for th is ERA
	1623	. . . I R CECME=1,RC LAIM="M" S OKAY=0 ; If ECME # and only w ant Medica l skip thi s ERA
	1624	. . . I R CECME=0,RC LAIM="P" S OKAY=0 ; If no ECME # and onl y want Pha rmacy skip this ERA
	1625	. . ;
	1626	. . ; Che ck Payer N ame
	1627	. . I RCW HICH=1,$P( RCPAY,U)'= 2 N ERAPAY ,MATCH D Q:'MATCH
	1628	. . . S E RAPAY=$$GE T1^DIQ(344 .4,ERAIEN, .06,"E"),M ATCH=0
	1629	. . . Q:E RAPAY=""
	1630	. . . S:$ D(RCPARRAY ($$UP^XLFS TR(ERAPAY) )) MATCH=1 ; payer n ames for 3 44.4 are U PPER CASE
	1631	. . ;
	1632	. . ; Che ck Payer T IN
	1633	. . I RCW HICH=2,$P( RCPAY,U)'= 2 N ERATIN ,MATCH D Q:'MATCH
	1634	. . . S E RATIN=$$GE T1^DIQ(344 .4,ERAIEN, .03,"E"),M ATCH=0
	1635	. . . Q:E RATIN=""
	1636	. . . S:$ D(RCPARRAY (ERATIN)) MATCH=1
	1637	. . ;
	1638	. . ; If it does no t already exist for this ERA, build X-re f of ERA d etail line s to the l ines in th e worklist
	1639	. . I '$D (^TMP("RCD PEAPP2",$J ,ERAIEN)) D BUILD(ER AIEN)
	1640	. . ;
	1641	. . ; Sca n index fo r auto pos ted claim lines with in the ERA
	1642	. . S RCR Z=""
	1643	. . F S RCRZ=$O(^R CY(344.4," F",APDATE, ERAIEN,RCR Z)) Q:'RCR Z D
	1644	. . . D S AVE(ERAIEN ,RCRZ,RCTY PE,APDATE, RCSORT) ; Save claim line deta il to ^TMP global
	1645	Q
	1646	;Modified Logic (Ch anges are in bold) - RCDPEAPQC OMPILE ; G enerate th e Auto Pos ting repor t ^TMP arr ay
	1647	; Input: GLOB - "^T MP("RCDPEA PP",$J)"
	1648	; RCDISP - 0 - Outp ut to pape r or scree n, 1 - Out put to Exc el
	1649	; RCDIV - 1 - All d ivisions, 2 - Select ed divisio ns
	1650	; RCDIVS( )- Array o f selected divisions if RCDIV= 2
	1651	; RCRANGE - 1^Start Date^End Date
	1652	; RCJOB - $J
	1653	; RCLAIM - "M" - Me dical Clai ms, "P" - Pharmacy C laims, "B" - Both
	1654	; RCPAGE - Initiali zed to 0
	1655	; RCPARRA Y- Array o f selected payers
	1656	; RCPROG - "RCDPEAP P"
	1657	; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Pa yer TIN
	1658	; RCWHICH - 1 - Fil ter by Pay er Name, 2 - Filter by Payer T IN
	1659	; RCTYPE - 'D' for detail rep ort, 'S' f or summary
	1660	; ^TMP("R CSELPAY",R CJOB) - Se lected Pay er Names o r TINs
	1661	; Ouput: GTOTAL - A 1^A2^A3^A4 Where:
	1662	; A1 - To tal Count
	1663	; A2 - To tal Origin al Amounts
	1664	; A3 - To tal Paymen t Amounts
	1665	; A4 - To tal Balanc e
	1666	; ^TMP("R CSELPAY",R CJOB,A1)=A 2/A3 Where :
	1667	; A1 - CT R
	1668	; A2 - Pa yer Name i f RCWHICH= 1 else Pay er TIN
	1669	; A3 - Pa yer TIN if RCWHICH=1 else Paye r Name
	1670	N APDATE, CNT,END,ER AIEN,IEN,O KAY,RCECME ,RCRZ,STA, STNAM,STNU M
	1671	S APDATE= $$FMADD^XL FDT($P(RCR ANGE,U,2), -1)
	1672	S END=$P( RCRANGE,U, 3),CNT=0
	1673	;
	1674	; Scan F index for ERA within date rang e
	1675	F S APDA TE=$O(^RCY (344.4,"F" ,APDATE)) Q:'APDATE Q:(APDATE \1)>END D
	1676	. S ERAIE N=""
	1677	. F S ER AIEN=$O(^R CY(344.4," F",APDATE, ERAIEN)) Q :'ERAIEN D
	1678	. . ;
	1679	. . ; Che ck divisio n - Note r eturn valu es are set to UNKNOW N if not a vailable
	1680	. . D ERA STA(ERAIEN ,.STA,.STN UM,.STNAM)
	1681	. . I RCD IV=2,'$D(R CDIVS(STA) ) Q
	1682	. . ;
	1683	. . ; PRC A4.5304 - Check if we includ e this ERA in report
	1684	. . I RCP AY="A",RCL AIM'="A" D Q:'OKAY ; If both not speci fied check for inclu sion
	1685	. . . S O KAY=$$ISTY PE^RCDPEU1 (344.4,ERA IEN,RCLAIM )
	1686	. . . ; S RCECME=$$ PHARM^RCDP EAP1(ERAIE N) ; See i f ECME # e xists for this ERA
	1687	. . . ; I RCECME=1, RCLAIM="M" S OKAY=0 ; If ECME # and only want Medi cal skip t his ERA
	1688	. . . ; I RCECME=0, RCLAIM="P" S OKAY=0 ; If no EC ME # and o nly want P harmacy sk ip this ER A
	1689	. . ;
	1690	. . ; Che ck Payer N ame
	1691	. . I RCP AY'="A" D Q:'OKAY
	1692	. . . S O KAY=$$ISSE L^RCDPEU1( 344.4,ERAI EN)
	1693	. . ; I R CWHICH=1,$ P(RCPAY,U) '=2 N ERAP AY,MATCH D Q:'MATCH
	1694	. . ; . S ERAPAY=$$ GET1^DIQ(3 44.4,ERAIE N,.06,"E") ,MATCH=0
	1695	. . ; . Q :ERAPAY=""
	1696	. . ; . S :$D(RCPARR AY($$UP^XL FSTR(ERAPA Y))) MATCH =1 ; payer names for 344.4 are UPPER CAS E
	1697	. . ;
	1698	. . ; Che ck Payer T IN
	1699	. . ; I R CWHICH=2,$ P(RCPAY,U) '=2 N ERAT IN,MATCH D Q:'MATCH
	1700	. . ; . S ERATIN=$$ GET1^DIQ(3 44.4,ERAIE N,.03,"E") ,MATCH=0
	1701	. . ; . Q :ERATIN=""
	1702	. . ; . S :$D(RCPARR AY(ERATIN) ) MATCH=1
	1703	. . ;
	1704	. . ; If it does no t already exist for this ERA, build X-re f of ERA d etail line s to the l ines in th e worklist
	1705	. . I '$D (^TMP("RCD PEAPP2",$J ,ERAIEN)) D BUILD(ER AIEN)
	1706	. . ;
	1707	. . ; Sca n index fo r auto pos ted claim lines with in the ERA
	1708	. . S RCR Z=""
	1709	. . F S RCRZ=$O(^R CY(344.4," F",APDATE, ERAIEN,RCR Z)) Q:'RCR Z D
	1710	. . . D S AVE(ERAIEN ,RCRZ,RCTY PE,APDATE, RCSORT) ; Save claim line deta il to ^TMP global
	1711	Q
	1712	;Routines Activities Routine Na meRCDPEAPS Enhancemen t Category New Modif y Delete N o ChangeRT MRelated O ptionsRCDP E ERA STAT US CHNG AU D REPRelat ed Routine sRoutines “Called By ”Routines “Called” None$$NOW ^RCDPRUCur rent Logic - RCDPEAP SRCDPEAPS ;ALB/DMB - ERA STATU S CHANGE A UDIT REPOR T ;Nov 25, 2015
	1713	;;4.5;Acc ounts Rece ivable;3 04;Mar 2 0, 1995;Bu ild 104
	1714	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1715	;
	1716	;
	1717	EN ;
	1718	; Entry p oint for E RA Status Change Rep ort [RCDPE ERA STATU S CHNG AUD REP]
	1719	;
	1720	; Prompt for report type
	1721	N DIR,X,Y ,DTOUT,DUO UT,DIRUT,D IROUT,RCTY PE,RCERA,R CRANGE
	1722	S DIR(0)= "SA^S:SING LE ERA;A:A LL"
	1723	S DIR("A" )="SELECT (S)ingle E RA or (A)L L: ",DIR(" B")="ALL"
	1724	D ^DIR
	1725	I Y'="S", Y'="A" Q
	1726	S RCTYPE= Y
	1727	;
	1728	; If Sing le ERA, se lect the E RA
	1729	S RCERA=" "
	1730	I RCTYPE= "S" S RCER A=$$SELERA () I 'RCER A Q
	1731	;
	1732	; If ALL ERAs, sele ct Date Ra nge for Re port
	1733	S RCRANGE =""
	1734	S RCRANGE =$$DTRNG() I 'RCRANG E Q
	1735	;
	1736	; Prompt for device
	1737	N %ZIS,ZT SK,ZTRTN,Z TIO,ZTDESC ,ZTSAVE,PO P
	1738	S %ZIS="Q M"
	1739	D ^%ZIS
	1740	I POP G E NQ
	1741	I $D(IO(" Q")) D G ENQ
	1742	. S ZTRTN ="RUN^RCDP EAPS(RCERA ,RCRANGE)"
	1743	. S ZTIO= ION
	1744	. S ZTSAV E("*")=""
	1745	. S ZTDES C="ERA STA TUS CHANGE AUDIT REP ORT"
	1746	. D ^%ZTL OAD
	1747	. W !,$S( $D(ZTSK):" REQUEST QU EUED TASK= "_ZTSK,1:" REQUEST CA NCELLED")
	1748	. D HOME^ %ZIS
	1749	U IO
	1750	;
	1751	D RUN(RCE RA,RCRANGE )
	1752	;
	1753	.
	1754	.
	1755	.
	1756	REPORT(RCR ANGE) ;
	1757	; Display output
	1758	;
	1759	; Initial ize Report Date, Pag e Number a nd Sting o f undersco res
	1760	N RCSCR,R CNOW,RCPG, RCHR,ERA,D ATE,CNT,DA TA,LINES
	1761	S RCSCR=$ S($E($G(IO ST),1,2)=" C-":1,1:0)
	1762	S RCNOW=$ $UP^XLFSTR ($$NOW^RCD PRU()),RCP G=0,RCHR=" ",$P(RCHR, "-",IOM+1) =""
	1763	;
	1764	U IO
	1765	D HEADER( RCNOW,.RCP G,RCHR,RCR ANGE)
	1766	I '$D(^TM P("RCDPEAP S",$J)) W !,"No data found"
	1767	;
	1768	; Display the detai l
	1769	S ERA="" F S ERA=$ O(^TMP("RC DPEAPS",$J ,ERA)) Q:' ERA D I RCPG=0 Q
	1770	. S DATE= "" F S DA TE=$O(^TMP ("RCDPEAPS ",$J,ERA,D ATE)) Q:'D ATE D I RCPG=0 Q
	1771	.. S CNT= 0 F S CNT =$O(^TMP(" RCDPEAPS", $J,ERA,DAT E,CNT)) Q: 'CNT D I RCPG=0 Q
	1772	Modified L ogic (Chan ges are in bold) - R CDPEAPSRCD PEAPS ;ALB /DMB - ERA STATUS CH ANGE AUDIT REPORT ;N ov 25, 201 5
	1773	;;4.5;Acc ounts Rece ivable;3 04;Mar 2 0, 1995;Bu ild 104
	1774	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1775	;
	1776	;
	1777	EN ;
	1778	; Entry p oint for E RA Status Change Rep ort [RCDPE ERA STATU S CHNG AUD REP]
	1779	;
	1780	; Prompt for report type
	1781	N DIR,X,Y ,DTOUT,DUO UT,DIRUT,D IROUT,RCTY PE,RCERA,R CRANGE,RCT YPE
	1782	S DIR(0)= "SA^S:SING LE ERA;A:A LL"
	1783	S DIR("A" )="SELECT (S)ingle E RA or (A)L L: ",DIR(" B")="ALL"
	1784	D ^DIR
	1785	I Y'="S", Y'="A" Q
	1786	S RCTYPE= Y
	1787	;
	1788	; If Sing le ERA, se lect the E RA
	1789	S RCERA=" "
	1790	I RCTYPE= "S" S RCER A=$$SELERA () I 'RCER A Q
	1791	;
	1792	; If ALL ERAs, sele ct Type of Payers to Include a nd Date Ra nge for Re port
	1793	S RCTYPE= $$RTYPE^RC DPEU1("")
	1794	S RCRANGE =""
	1795	S RCRANGE =$$DTRNG() I 'RCRANG E Q
	1796	;
	1797	; Prompt for device
	1798	N %ZIS,ZT SK,ZTRTN,Z TIO,ZTDESC ,ZTSAVE,PO P
	1799	S %ZIS="Q M"
	1800	D ^%ZIS
	1801	I POP G E NQ
	1802	I $D(IO(" Q")) D G ENQ
	1803	. S ZTRTN ="RUN^RCDP EAPS(RCERA ,RCRANGE)"
	1804	. S ZTIO= ION
	1805	. S ZTSAV E("*")=""
	1806	. S ZTDES C="ERA STA TUS CHANGE AUDIT REP ORT"
	1807	. D ^%ZTL OAD
	1808	. W !,$S( $D(ZTSK):" REQUEST QU EUED TASK= "_ZTSK,1:" REQUEST CA NCELLED")
	1809	. D HOME^ %ZIS
	1810	U IO
	1811	;
	1812	D RUN(RCE RA,RCRANGE )
	1813	;
	1814	.
	1815	.
	1816	.
	1817	REPORT(RCR ANGE) ;
	1818	; Display output
	1819	;
	1820	; Initial ize Report Date, Pag e Number a nd Sting o f undersco res
	1821	N RCSCR,R CNOW,RCPG, RCHR,ERA,D ATE,CNT,DA TA,LINES
	1822	S RCSCR=$ S($E($G(IO ST),1,2)=" C-":1,1:0)
	1823	S RCNOW=$ $UP^XLFSTR ($$NOW^RCD PRU()),RCP G=0,RCHR=" ",$P(RCHR, "-",IOM+1) =""
	1824	;
	1825	U IO
	1826	D HEADER( RCNOW,.RCP G,RCHR,RCR ANGE)
	1827	I '$D(^TM P("RCDPEAP S",$J)) W !,"No data found"
	1828	;
	1829	; Display the detai l
	1830	S ERA="" F S ERA=$ O(^TMP("RC DPEAPS",$J ,ERA)) Q:' ERA D I RCPG=0 Q
	1831	. I '$$IS TYPE^RCDPE U1(344.4,E RA,RCTYPE) Q ; US76 8 Filter b y Medical, Tricare o r Pharmacy
	1832	. S DATE= "" F S DA TE=$O(^TMP ("RCDPEAPS ",$J,ERA,D ATE)) Q:'D ATE D I RCPG=0 Q
	1833	.. S CNT= 0 F S CNT =$O(^TMP(" RCDPEAPS", $J,ERA,DAT E,CNT)) Q: 'CNT D I RCPG=0 Q
	1834	.
	1835	.
	1836	.RoutinesA ctivitiesR outine Nam eRCDPEAR1E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE ERA AGING REPORTRel ated Routi nesRoutine s “Called By”Routine s “Called” RCDPEAR SELPAY^ RCDPEAR3
	1837	$$ASKLM ^RCDPEARL
	1838	$$CLMCH MPV^RCDPEA RL
	1839	$$CLMTR ICR^RCDPEA RL
	1840	$$ENDOR PRT^RCDPEA RL
	1841	$$INCHM PVA^RCDPEA RL
	1842	$$INTRI CAR^RCDPEA RL
	1843	$$NOW^R CDPEARL
	1844	ASK^RCD PEARL
	1845	HDRLST^ RCDPEARL
	1846	SL^RCDP EARL
	1847	$$DISPT Y^RCDPEM3
	1848	$$DTRNG ^RCDPEM4
	1849	ERASTA^ RCDPEM4
	1850	INFO^RC DPEM6
	1851	$$GETPA Y^RCDPEM9
	1852	DISP^RC DPESR0
	1853	DISPADJ ^RCDPESR8
	1854	$$ADJ^R CDPEU
	1855	$$HACER A^RCDPEU
	1856	$$XCEPT ^RCDPEWLP
	1857	$$PAYTI N^RCDPRU2 Current Logic – RC DPEAR1RCDP EAR1 ;ALB/ TMK/PJH - ERA Unmatc hed Aging Report (fi le #344.4) ;Dec 20, 2014@18:41 :35
	1858	;;4.5;Acc ounts Rece ivable;1 73,269,276 ,284,293,2 98,321;M ar 20, 199 5;Build 12 1
	1859	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1860	Q
	1861	;
	1862	; PRCA4. 5298 rout ine comple tely refac tored
	1863	EN1 ; entr y point - ERA Unmatc hed Aging Report [RC DPE ERA AG ING REPORT ]
	1864	; data fr om ELECTRO NIC REMITT ANCE ADVIC E file (#3 44.4)
	1865	N RCDISPT Y,RCDT,RCD TRNG,RCHDR ,RCJOB,RCL NCNT,RCLST MGR,RCOUT, RCPGNUM,RC PYRLST,RCR ESPYR
	1866	N RCSTOP, RCTMPND,RC XCLUDE,RCZ ROBAL,VAUT D,Y
	1867	; RCDISPT Y - displa y type (Ex cel)
	1868	; RCDTRNG - selecte d date ran ge
	1869	; RCDT("B EG") - sta rt date, R CDT("END") - end dat e
	1870	; RCHDR - header ar ray
	1871	; RCLSTMG R - list m anager fla g
	1872	; RCRESPY R - payer info respo nse: "1^fi rst payer^ last payer " or "2^^" (for all) or "3^^" (for speci fic)
	1873	; RCDTRNG - "1^star t date^end date"
	1874	; RCPYRLS T - payer list for s elected pa yers
	1875	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	1876	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	1877	; RCZROBA L - zero b alance fla g
	1878	; VAUTD - division informatio n
	1879	;
	1880	K ^TMP($J ,"RC TOTAL ") ; clear old total s
	1881	W !,$$HDR NM D DIVIS ION^VAUTOM A ; return s VAUTD
	1882	I 'VAUTD& ($D(VAUTD) '=11) G EN 1Q
	1883	S RCLSTMG R="" ; in itial valu e, won't b e asked if non-null
	1884	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	1885	S RCDTRNG =$$DTRNG^R CDPEM4() I 'RCDTRNG G EN1Q
	1886	S RCDT("B EG")=$P(RC DTRNG,U,2) ,RCDT("END ")=$P(RCDT RNG,U,3)
	1887	;Get insu rance comp any to be used as fi lter
	1888	; PRCA4. 5284 - RC RESPYR (Ty pe of Resp onse(1=Ran ge,2=All,3 =Specific) ^From name ^To name)
	1889	S RCRESPY R=$$GETPAY ^RCDPEM9(3 44.4) G:RC RESPYR<0 E N1Q
	1890	; Get Zer o Balance Filter
	1891	S RCZROBA L=$$ZROBAL () G:RCZRO BAL<0 EN1Q
	1892	; CHAMPVA exclusion filter
	1893	S RCXCLUD E("CHAMPVA ")=$$INCHM PVA^RCDPEA RL ; user is asked w hether to include
	1894	G:RCXCLUD E("CHAMPVA ")<0 EN1Q
	1895	; TRICARE exclusion filter
	1896	S RCXCLUD E("TRICARE ")=$$INTRI CAR^RCDPEA RL ; user is asked w hether to include
	1897	G:RCXCLUD E("TRICARE ")<0 EN1Q
	1898	; display type, ask for Excel format
	1899	S RCDISPT Y=$$DISPTY ^RCDPEM3() I RCDISPT Y=-1 G EN1 Q
	1900	; display device in fo about E xcel forma t, set Lis tMan flag to prevent question
	1901	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	1902	I $D(DUOU T)!$D(DTOU T) G EN1Q
	1903	S RCJOB=$ J ; neede d in RPTOU T
	1904	;
	1905	I '(+RCRE SPYR=2) D ; get pay er list if not all p ayers
	1906	.N J,P S J=0
	1907	.F S J=$ O(^TMP("RC SELPAY",$J ,J)) Q:'J S P=$G(^( J)) S:P]"" RCPYRLST( P)=""
	1908	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	1909	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EN1Q
	1910	; display in ListMa n format a nd exit on return
	1911	I RCLSTMG R D G EN1 Q
	1912	.S RCTMPN D=$T(+0)_" ^ERA UNMAT CHED AGING " K ^TMP( $J,RCTMPND ) ; clean any residu e
	1913	.D RPTOUT
	1914	.N H,L,HD R S L=0
	1915	.S HDR("T ITLE")=$$H DRNM
	1916	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 7 lines of report header
	1917	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	1918	..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 )
	1919	.; invoke ListMan
	1920	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	1921	;
	1922	; Ask dev ice
	1923	N %ZIS S %ZIS="QM" D ^%ZIS G: POP EN1Q
	1924	I $D(IO(" Q")) D G EN1Q
	1925	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK,ZT STOP
	1926	.S ZTRTN= "RPTOUT^RC DPEAR1",ZT DESC="AR - EDI LOCKB OX ERA AGI NG REPORT"
	1927	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	1928	.; PRCA4 .5284 - ^ TMP may be on anothe r server, save off s pecific pa yers in lo cal
	1929	.;I +RCRE SPYR=3 M R CPYRLST=^T MP("RCSELP AY",$J)
	1930	.D ^%ZTLO AD
	1931	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	1932	.K ZTSK,I O("Q") D H OME^%ZIS
	1933	;
	1934	U IO S RC TMPND="" D RPTOUT
	1935	.
	1936	.
	1937	.
	1938	RPTOUT ; E ntry point for listi ng report
	1939	; RCTMPND = name of the subsc ript for ^ TMP to use to return all lines
	1940	; (for bu lletin). I f undefine d or null, output is printed
	1941	; Return global if RCTMPND no t null: ^T MP($J,RCTM PND,line#) =line text
	1942	N ERADT,P YMNTFRM,RC 0,RCEDT,RC EXCEP,RCFL IEN,RCITM, RCNT,RCPAY ,RCSF0,RCZ ,STA,STNAM ,STNUM,X,Y ,Z,Z0
	1943	; ERADT - date of e ntry
	1944	; RCFLIEN - entry n umber in f ile #344.4
	1945	; RCITM - entry in ^RCY(344.4 ,0) = ELEC TRONIC REM ITTANCE AD VICE^344.4 I
	1946	; RCSF0 - zero node of sub-fi le entry
	1947	;
	1948	S RCTMPND =$G(RCTMPN D) I RCTMP ND'="" K ^ TMP($J,RCT MPND) ; cl ear residu al data
	1949	; RCNT - count of i tems
	1950	K ^TMP($J ,"RCERA_AG ED"),^TMP( $J,"RCERA_ ADJ")
	1951	S RCRESPY R=+RCRESPY R
	1952	S RCFLIEN =0,RCNT=0
	1953	F S RCFL IEN=$O(^RC Y(344.4,"A MATCH",0,R CFLIEN)) Q :'RCFLIEN D
	1954	.K RCITM M RCITM=^R CY(344.4,R CFLIEN) ; grab entir e entry
	1955	.Q:$P($G( RCITM(6)), U) ; who r emoved the ERA - PRC A4.5293
	1956	.S ERADT= +$P($G(RCI TM(0)),U,7 ) ; (#.07) FILE DATE /TIME [7D]
	1957	.Q:'ERADT ; no dat e, don't i nclude
	1958	.; Check date range
	1959	.Q:(RCDT( "BEG")>ERA DT\1)!(ERA DT\1>RCDT( "END"))
	1960	.; Check Station/Di vision
	1961	.;I '$$CH KDIV^RCDPE DAR(RCFLIE N,1,.VAUTD ) Q
	1962	.I 'VAUTD D ERASTA^ RCDPEM4(RC FLIEN,.STA ,.STNUM,.S TNAM) I '$ D(VAUTD(ST A)) Q
	1963	.; Check for payer match
	1964	.S PYMNTF RM=$P($G(R CITM(0)),U ,6) ; PAYM ENT FROM f ield
	1965	.I '(RCRE SPYR=2),PY MNTFRM]"" Q:'$D(RCPY RLST($$UP^ XLFSTR(PYM NTFRM))) ; will incl ude null p ayers when ALL payer s selected
	1966	.Q:(PYMNT FRM="")&'( RCRESPYR=2 ) ; null p ayers excl uded when not ALL se lected
	1967	.; Check for Zero B al
	1968	.I 'RCZRO BAL,'$P($G (RCITM(0)) ,U,5) Q ; (#.05) TO TAL AMOUNT PAID [5N]
	1969	.; CHAMPV A check
	1970	.I $G(RCX CLUDE("CHA MPVA")),$$ CLMCHMPV^R CDPEARL("3 44.4;"_RCF LIEN) D Q ; count and quit i f true
	1971	..N N S N =$G(^TMP($ J,"RC TOTA L","CHAMPV A"))+1,^(" CHAMPVA")= N ; total can be li sted
	1972	.;
	1973	.; TRICAR E check
	1974	.I $G(RCX CLUDE("TRI CARE")),$$ CLMTRICR^R CDPEARL("3 44.4;"_RCF LIEN) D Q ; count and quit i f true
	1975	..N N S N =$G(^TMP($ J,"RC TOTA L","TRICAR E"))+1,^(" TRICARE")= N ; total can be li sted
	1976	.;
	1977	.; includ e on repor t
	1978	.S ^TMP($ J,"RCERA_A GED",$$FMD IFF^XLFDT( ERADT,DT), RCFLIEN)=0 ,RCNT=RCNT +1
	1979	.
	1980	.
	1981	.Modified Logic (Cha nges are i n bold) – RCDPEAR1RC DPEAR1 ;AL B/TMK/PJH - ERA Unma tched Agin g Report ( file #344. 4) ;Dec 20 , 2014@18: 41:35
	1982	;;4.5;Acc ounts Rece ivable;1 73,269,276 ,284,293,2 98,321;M ar 20, 199 5;Build 12 1
	1983	;Per VA D irective 6 402, this routine sh ould not b e modified .
	1984	Q
	1985	;
	1986	; PRCA4. 5298 rout ine comple tely refac tored
	1987	EN1 ; entr y point - ERA Unmatc hed Aging Report [RC DPE ERA AG ING REPORT ]
	1988	; data fr om ELECTRO NIC REMITT ANCE ADVIC E file (#3 44.4)
	1989	N RCDISPT Y,RCDT,RCD TRNG,RCHDR ,RCJOB,RCL NCNT,RCLST MGR,RCOUT, RCPGNUM,RC PAY,RCPYRL ST,RCRESPY R
	1990	N RCSTOP, RCTMPND,RC XCLUDE,,RC TYPE,RCZRO BAL,VAUTD, Y
	1991	; RCDISPT Y - displa y type (Ex cel)
	1992	; RCDTRNG - selecte d date ran ge
	1993	; RCDT("B EG") - sta rt date, R CDT("END") - end dat e
	1994	; RCHDR - header ar ray
	1995	; RCLSTMG R - list m anager fla g
	1996	; RCRESPY R - payer info respo nse: "1^fi rst payer^ last payer " or "2^^" (for all) or "3^^" (for speci fic)
	1997	; RCDTRNG - "1^star t date^end date"
	1998	; RCPYRLS T - payer list for s elected pa yers
	1999	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	2000	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	2001	; RCZROBA L - zero b alance fla g
	2002	; VAUTD - division informatio n
	2003	;
	2004	K ^TMP($J ,"RC TOTAL ") ; clear old total s
	2005	W !,$$HDR NM D DIVIS ION^VAUTOM A ; return s VAUTD
	2006	I 'VAUTD& ($D(VAUTD) '=11) G EN 1Q
	2007	S RCLSTMG R="" ; in itial valu e, won't b e asked if non-null
	2008	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	2009	S RCDTRNG =$$DTRNG^R CDPEM4() I 'RCDTRNG G EN1Q
	2010	S RCDT("B EG")=$P(RC DTRNG,U,2) ,RCDT("END ")=$P(RCDT RNG,U,3)
	2011	;Get insu rance comp any to be used as fi lter
	2012	; PRCA4. 5284 - RC RESPYR (Ty pe of Resp onse(1=Ran ge,2=All,3 =Specific) ^From name ^To name)
	2013	S RCRESPY R=$$GETPAY ^RCDPEM9(3 44.4) G:RC RESPYR<0 E N1Q
	2014	;
	2015	; US786 - Ask to s how Medica l/Pharmacy Tricare o r All
	2016	S RCTYPE= $$RTYPE^RC DPEU1("A")
	2017	I RCTYPE= -1 G EN1Q
	2018	;
	2019	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	2020	I RCPAR(" SELC")=-1 G EN1Q ; US786 '^' or timeout
	2021	S RCPAY=R CPAR("SELC ")
	2022	;
	2023	I RCPAR(" SELC")'="A " D Q:XX= -1 ; US786 - Since w e don't wa nt all pay ers
	2024	. S RCPAR ("TYPE")=R CTYPE ; prompt for payers we do want
	2025	. S RCPAR ("DICA")=" Select Ins urance Com pany NAME: "
	2026	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	2027	;
	2028	; Get Zer o Balance Filter
	2029	S RCZROBA L=$$ZROBAL () G:RCZRO BAL<0 EN1Q
	2030	; CHAMPVA exclusion filter
	2031	S RCXCLUD E("CHAMPVA ")=$$INCHM PVA^RCDPEA RL ; user is asked w hether to include
	2032	G:RCXCLUD E("CHAMPVA ")<0 EN1Q
	2033	; TRICARE exclusion filter
	2034	S RCXCLUD E("TRICARE ")=$$INTRI CAR^RCDPEA RL ; user is asked w hether to include
	2035	G:RCXCLUD E("TRICARE ")<0 EN1Q
	2036	; display type, ask for Excel format
	2037	S RCDISPT Y=$$DISPTY ^RCDPEM3() I RCDISPT Y=-1 G EN1 Q
	2038	; display device in fo about E xcel forma t, set Lis tMan flag to prevent question
	2039	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	2040	I $D(DUOU T)!$D(DTOU T) G EN1Q
	2041	S RCJOB=$ J ; neede d in RPTOU T
	2042	;
	2043	I '(+RCRE SPYR=2) D ; get pay er list if not all p ayers
	2044	.N J,P S J=0
	2045	.F S J=$ O(^TMP("RC SELPAY",$J ,J)) Q:'J S P=$G(^( J)) S:P]"" RCPYRLST( P)=""
	2046	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	2047	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EN1Q
	2048	; display in ListMa n format a nd exit on return
	2049	I RCLSTMG R D G EN1 Q
	2050	.S RCTMPN D=$T(+0)_" ^ERA UNMAT CHED AGING " K ^TMP( $J,RCTMPND ) ; clean any residu e
	2051	.D RPTOUT
	2052	.N H,L,HD R S L=0
	2053	.S HDR("T ITLE")=$$H DRNM
	2054	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 7 lines of report header
	2055	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	2056	..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 )
	2057	.; invoke ListMan
	2058	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	2059	;
	2060	; Ask dev ice
	2061	N %ZIS S %ZIS="QM" D ^%ZIS G: POP EN1Q
	2062	I $D(IO(" Q")) D G EN1Q
	2063	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK,ZT STOP
	2064	.S ZTRTN= "RPTOUT^RC DPEAR1",ZT DESC="AR - EDI LOCKB OX ERA AGI NG REPORT"
	2065	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	2066	.S ZTSAVE ("^TMP(""R CDPEU1"",$ J,")=""
	2067	.; PRCA4 .5284 - ^ TMP may be on anothe r server, save off s pecific pa yers in lo cal
	2068	.;I +RCRE SPYR=3 M R CPYRLST=^T MP("RCSELP AY",$J)
	2069	.D ^%ZTLO AD
	2070	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	2071	.K ZTSK,I O("Q") D H OME^%ZIS
	2072	;
	2073	U IO S RC TMPND="" D RPTOUT
	2074	.
	2075	.
	2076	.
	2077	RPTOUT ; E ntry point for listi ng report
	2078	; RCTMPND = name of the subsc ript for ^ TMP to use to return all lines
	2079	; (for bu lletin). I f undefine d or null, output is printed
	2080	; Return global if RCTMPND no t null: ^T MP($J,RCTM PND,line#) =line text
	2081	N ERADT,P YMNTFRM,RC 0,RCEDT,RC EXCEP,RCFL IEN,RCITM, RCNT,RCPAY ,RCSF0,RCZ ,STA,STNAM ,STNUM,X,Y ,Z,Z0
	2082	; ERADT - date of e ntry
	2083	; RCFLIEN - entry n umber in f ile #344.4
	2084	; RCITM - entry in ^RCY(344.4 ,0) = ELEC TRONIC REM ITTANCE AD VICE^344.4 I
	2085	; RCSF0 - zero node of sub-fi le entry
	2086	;
	2087	S RCTMPND =$G(RCTMPN D) I RCTMP ND'="" K ^ TMP($J,RCT MPND) ; cl ear residu al data
	2088	; RCNT - count of i tems
	2089	K ^TMP($J ,"RCERA_AG ED"),^TMP( $J,"RCERA_ ADJ")
	2090	S RCRESPY R=+RCRESPY R
	2091	S RCFLIEN =0,RCNT=0
	2092	F S RCFL IEN=$O(^RC Y(344.4,"A MATCH",0,R CFLIEN)) Q :'RCFLIEN D
	2093	.K RCITM M RCITM=^R CY(344.4,R CFLIEN) ; grab entir e entry
	2094	.Q:$P($G( RCITM(6)), U) ; who r emoved the ERA - PRC A4.5293
	2095	.S ERADT= +$P($G(RCI TM(0)),U,7 ) ; (#.07) FILE DATE /TIME [7D]
	2096	.Q:'ERADT ; no dat e, don't i nclude
	2097	.; Check date range
	2098	.Q:(RCDT( "BEG")>ERA DT\1)!(ERA DT\1>RCDT( "END"))
	2099	.; Check Station/Di vision
	2100	.;I '$$CH KDIV^RCDPE DAR(RCFLIE N,1,.VAUTD ) Q
	2101	.I 'VAUTD D ERASTA^ RCDPEM4(RC FLIEN,.STA ,.STNUM,.S TNAM) I '$ D(VAUTD(ST A)) Q
	2102	.; Check for payer match
	2103	.S PYMNTF RM=$P($G(R CITM(0)),U ,6) ; PAYM ENT FROM f ield
	2104	.I '(RCRE SPYR=2),PY MNTFRM]"" Q:'$D(RCPY RLST($$UP^ XLFSTR(PYM NTFRM))) ; will incl ude null p ayers when ALL payer s selected
	2105	.Q:(PYMNT FRM="")&'( RCRESPYR=2 ) ; null p ayers excl uded when not ALL se lected
	2106	;
	2107	.I RCPAY' ="A" D Q: 'XX
	2108	..S XX=$$ ISSEL^RCDP EU1(344.31 ,IEN34431) ; US786 C heck if pa yer was se lected
	2109	.E I RCT YPE'="A" D Q:'XX ; If all of a give type of payer s elected
	2110	..S XX=$$ ISTYPE^RCD PEU1(344.3 1,IEN34431 ,RCTYPE) ; check tha t payer ma tches type
	2111	;
	2112	.; Check for Zero B al
	2113	.I 'RCZRO BAL,'$P($G (RCITM(0)) ,U,5) Q ; (#.05) TO TAL AMOUNT PAID [5N]
	2114	.; CHAMPV A check
	2115	.I $G(RCX CLUDE("CHA MPVA")),$$ CLMCHMPV^R CDPEARL("3 44.4;"_RCF LIEN) D Q ; count and quit i f true
	2116	..N N S N =$G(^TMP($ J,"RC TOTA L","CHAMPV A"))+1,^(" CHAMPVA")= N ; total can be li sted
	2117	.;
	2118	.; TRICAR E check
	2119	.I $G(RCX CLUDE("TRI CARE")),$$ CLMTRICR^R CDPEARL("3 44.4;"_RCF LIEN) D Q ; count and quit i f true
	2120	..N N S N =$G(^TMP($ J,"RC TOTA L","TRICAR E"))+1,^(" TRICARE")= N ; total can be li sted
	2121	.;
	2122	.; includ e on repor t
	2123	.S ^TMP($ J,"RCERA_A GED",$$FMD IFF^XLFDT( ERADT,DT), RCFLIEN)=0 ,RCNT=RCNT +1
	2124	.
	2125	.
	2126	.RoutinesA ctivitiesR outine Nam eRCDPEAR2E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE EFT AGING REPORTRel ated Routi nesRoutine s “Called By”Routine s “Called” RCDPEAR RLOAD^R CDPEAR3
	2127	SELPAY^ RCDPEAR3
	2128	$$ASKLM ^RCDPEARL
	2129	$$ENDOR PRT^RCDPEA RL
	2130	$$NOW^R CDPEARL
	2131	ASK^RCD PEARL
	2132	HDRLST^ RCDPEARL
	2133	LMRPT^R CDPEARL
	2134	SL^RCDP EARL
	2135	$$CHKPY R^RCDPEDAR
	2136	$$DISPT Y^RCDPEM3
	2137	$$DTRNG ^RCDPEM4
	2138	INFO^RC DPEM6
	2139	$$GETPA Y^RCDPEM9 Current Logic – R CDPEAR2RCD PEAR2 ;ALB /TMK/PJH - EFT Unmat ched Aging Report - FILE 344.3 ;Nov 24, 2014@18:31 :57
	2140	;;4.5;Acc ounts Rece ivable;1 73,269,276 ,284,283,2 93,298,318 ,321,326 ;Mar 20, 1 995;Build 121
	2141	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2142	Q
	2143	;
	2144	; PRCA4. 5298 note s at botto m
	2145	EN1 ; opti on: EFT Un matched Ag ing Report [RCDPE EF T AGING RE PORT]
	2146	N %ZIS,DI C,DIR,DTOU T,DUOUT,PO P,RCDISPTY ,RCDTRNG,R CEND,RCHDR ,RCJOB
	2147	N RCJOB1, RCLSTMGR,R CNP,RCPYRL ST,RCPGNUM ,RCSTART,R CTMPND,X,Y
	2148	; RCDISPT Y = displa y type
	2149	; RCEND = end date
	2150	; RCLSTMG R = list m anager fla g
	2151	; RCNP = payer info : "1^first payer^las t payer" o r "2^^" (f or all)
	2152	; RCPYRLS T - payer list for s elected pa yers
	2153	; RCDTRNG = "1^start date^end date"
	2154	; RCSTART = start d ate
	2155	; RCTMPND = name of the subsc ript for ^ TMP to use
	2156	;
	2157	S RCLSTMG R="" ; in itial valu e
	2158	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) EN1Q
	2159	S RCSTART =$P(RCDTRN G,U,2)-1,R CEND=$P(RC DTRNG,U,3)
	2160	;Get insu rance comp any to be used as fi lter
	2161	; PRCA4. 5284 - RC NP (Type o f Response (1=Range,2 =All,3=Spe cific)^Fro m name^To name)
	2162	S RCNP=$$ GETPAY^RCD PEM9(344.3 1) G:RCNP< 0 EN1Q
	2163	;Get disp lay type
	2164	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 EN1Q
	2165	; display device in fo about E xcel forma t, set Lis tMan flag to prevent question
	2166	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	2167	I $D(DUOU T)!$D(DTOU T) G EN1Q
	2168	S RCJOB=$ J ; neede d in RPTOU T
	2169	;
	2170	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	2171	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL I RCLST MGR<0 G EN 1Q
	2172	; display in ListMa n format a nd exit on return
	2173	I RCLSTMG R D G EN1 Q
	2174	.S RCTMPN D=$T(+0)_" ^EFT UNMAT CHED AGING " K ^TMP( $J,RCTMPND ) ; clean any residu e
	2175	.D RPTOUT
	2176	.N H,L,HD R S L=0
	2177	.S HDR("T ITLE")=$$H DRNM
	2178	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 3 lines of report header
	2179	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	2180	..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 )
	2181	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	2182	;
	2183	S RCJOB=$ J,RCTMPND= ""
	2184	; Ask dev ice
	2185	S %ZIS="Q M" D ^%ZIS G:POP EN1 Q
	2186	I $D(IO(" Q")) D G EN1Q
	2187	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSTOP
	2188	.S ZTRTN= "RPTOUT^RC DPEAR2",ZT DESC="EFT AGING REPO RT"
	2189	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	2190	.; PRCA4 .5284 - B ecause TMP global ma y be on an other serv er, save o ff specifi c payers i n local
	2191	.I +RCNP= 3 M RCPYRL ST=^TMP("R CSELPAY",$ J)
	2192	.D ^%ZTLO AD
	2193	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	2194	.K ZTSK,I O("Q") D H OME^%ZIS
	2195	;
	2196	U IO D RP TOUT
	2197	;
	2198	EN1Q ; exi t and clea n up
	2199	I 'RCLSTM GR D ^%ZIS C
	2200	K ^TMP("R CSELPAY",$ J),^TMP("R CPAYER",$J )
	2201	Q
	2202	.
	2203	.
	2204	.
	2205	RPTOUT ; E ntry point for queue d job, nig htly job
	2206	; RCTMPND = name of the subsc ript for ^ TMP to use to return all lines
	2207	; If unde fined or n ull, outpu t is print ed
	2208	; Return global if RCTMPND no t null: ^T MP($J,RCTM PND,line#) =line text
	2209	N DIC,DUO UT,RC0,RC1 3,RC3443,R CCT,RCIEN, RCNT,RCOUT ,RCPAY,RCP AYER,RCPAY ID
	2210	N RCSTOP, RCTOT,RCZ, X,XX,YY,Z, Z0,ZZ
	2211	S RCTMPND =$G(RCTMPN D)
	2212	S (RCCT,R CSTOP,RCNT ,RCTOT)=0
	2213	K ^TMP($J ,"RCERA_AG ED"),^TMP( $J,"RCERA_ ADJ")
	2214	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	2215	I $G(RCJO B)'="",RCJ OB'=$J D
	2216	.K ^TMP(" RCSELPAY", $J)
	2217	.D RLOAD^ RCDPEAR3(3 44.31)
	2218	.S RCJOB= $J
	2219	; build l ocal payer array her e
	2220	S RCNP=+R CNP
	2221	D SELPAY^ RCDPEAR3(R CNP,RCJOB, .RCPAY)
	2222	I RCTMPND '="" K ^TM P($J,RCTMP ND)
	2223	; cross-r ef on file #344.31 f ield #.08 - MATCH ST ATUS
	2224	S RCIEN=0 F S RCIE N=$O(^RCY( 344.31,"AM ATCH",0,RC IEN)) Q:'R CIEN D ;unmatched entries o nly
	2225	.Q:$P($G( ^RCY(344.3 1,RCIEN,3) ),U) ; EFT has been removed
	2226	.Q:$P($G( ^RCY(344.3 1,RCIEN,0) ),U,7)=0 ; payment o f zero
	2227	.;
	2228	.S RC13=$ P($G(^RCY( 344.31,RCI EN,0)),U,1 3) ; date received
	2229	.; Check for payer match
	2230	.I '$$CHK PYR^RCDPED AR(RCIEN,0 ,RCJOB,RCN P) Q ;PR CA4.5318 passed ex isting var iable RCNP
	2231	.; Check date range
	2232	.Q:(RCSTA RT>RC13)!( RC13>RCEND )
	2233	.; Passed all the f ilters - i nclude on report
	2234	.S ^TMP($ J,"RCEFT_A GED",$$FMD IFF^XLFDT( RC13,DT),R CIEN)=0,RC NT=RCNT+1
	2235	;
	2236	.
	2237	.
	2238	.Modified Logic (Cha nges are i n bold) – RCDPEAR2RC DPEAR2 ;AL B/TMK/PJH - EFT Unma tched Agin g Report - FILE 344. 3 ;Nov 24, 2014@18:3 1:57
	2239	;;4.5;Acc ounts Rece ivable;1 73,269,276 ,284,283,2 93,298,318 ,321,326 ;Mar 20, 1 995;Build 121
	2240	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2241	Q
	2242	;
	2243	; PRCA4. 5298 note s at botto m
	2244	EN1 ; opti on: EFT Un matched Ag ing Report [RCDPE EF T AGING RE PORT]
	2245	N %ZIS,DI C,DIR,DTOU T,DUOUT,PO P,RCDISPTY ,RCDTRNG,R CEND,RCHDR ,RCJOB
	2246	N RCJOB1, RCLSTMGR,R CNP,RCPYRL ST,RCPAYS, RCPGNUM,RC START,RCTM PND,RCTYPE ,X,Y
	2247	; RCDISPT Y = displa y type
	2248	; RCEND = end date
	2249	; RCLSTMG R = list m anager fla g
	2250	; RCNP = payer info : "1^first payer^las t payer" o r "2^^" (f or all)
	2251	; RCPYRLS T - payer list for s elected pa yers
	2252	; RCTYPE = Type of payers to include M/ P/T/A MEDI CAL/PHARMA CY/TRICARE /ALL
	2253	; RCPAYS = A = All payers, "S " = Select ed Payers, "R" = Ran ge of Paye rs,
	2254	; RCDTRNG = "1^start date^end date"
	2255	; RCSTART = start d ate
	2256	; RCTMPND = name of the subsc ript for ^ TMP to use
	2257	;
	2258	S RCLSTMG R="" ; in itial valu e
	2259	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) EN1Q
	2260	S RCSTART =$P(RCDTRN G,U,2)-1,R CEND=$P(RC DTRNG,U,3)
	2261	;Get insu rance comp any to be used as fi lter
	2262	; PRCA4. 5284 - RC NP (Type o f Response (1=Range,2 =All,3=Spe cific)^Fro m name^To name)
	2263	S RCNP=$$ GETPAY^RCD PEM9(344.3 1) G:RCNP< 0 EN1Q
	2264	;
	2265	; US786 - Ask to sh ow Medical /Pharmacy Tricare or All
	2266	S RCTYPE= $$RTYPE^RC DPEU1("")
	2267	I RCTYPE= -1 G EN1Q
	2268	;
	2269	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	2270	I RCPAR(" SELC")=-1 G EN1Q ; US786 '^' or timeout
	2271	S RCPAYS= RCPAR("SEL C")
	2272	;
	2273	I RCPAR(" SELC")'="A " D I XX= -1 G EN1Q ; US786 - Si nce we don 't want al l payers
	2274	. S RCPAR ("TYPE")=R CTYPE ; pr ompt for p ayers we d o want
	2275	. S RCPAR ("SELC")=R CPAYS
	2276	. S RCPAR ("FILE")=3 44.31
	2277	. S RCPAR ("DICA")=" Select Ins urance Com pany NAME: "
	2278	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	2279	;
	2280	;Get disp lay type
	2281	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 EN1Q
	2282	; display device in fo about E xcel forma t, set Lis tMan flag to prevent question
	2283	I RCDISPT Y S RCLSTM GR="^" D I NFO^RCDPEM 6
	2284	I $D(DUOU T)!$D(DTOU T) G EN1Q
	2285	S RCJOB=$ J ; neede d in RPTOU T
	2286	;
	2287	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	2288	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL I RCLST MGR<0 G EN 1Q
	2289	; display in ListMa n format a nd exit on return
	2290	I RCLSTMG R D G EN1 Q
	2291	.S RCTMPN D=$T(+0)_" ^EFT UNMAT CHED AGING " K ^TMP( $J,RCTMPND ) ; clean any residu e
	2292	.D RPTOUT
	2293	.N H,L,HD R S L=0
	2294	.S HDR("T ITLE")=$$H DRNM
	2295	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 3 lines of report header
	2296	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	2297	..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 )
	2298	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	2299	;
	2300	S RCJOB=$J ,RCTMPND=" "
	2301	; Ask dev ice
	2302	S %ZIS="Q M" D ^%ZIS G:POP EN1 Q
	2303	I $D(IO(" Q")) D G EN1Q
	2304	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSTOP
	2305	.S ZTRTN= "RPTOUT^RC DPEAR2",ZT DESC="EFT AGING REPO RT"
	2306	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	2307	.S ZTSAVE ("^TMP(""R CDPEU1"",$ J,")=""
	2308	.; PRCA4 .5284 - B ecause TMP global ma y be on an other serv er, save o ff specifi c payers i n local
	2309	.I +RCNP= 3 M RCPYRL ST=^TMP("R CSELPAY",$ J)
	2310	.D ^%ZTLO AD
	2311	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" has been queued.",1 :"Unable t o queue th is task.")
	2312	.K ZTSK,I O("Q") D H OME^%ZIS
	2313	;
	2314	U IO D RP TOUT
	2315	;
	2316	EN1Q ; exi t and clea n up
	2317	I 'RCLSTM GR D ^%ZIS C
	2318	K ^TMP("R CSELPAY",$ J),^TMP("R CPAYER",$J )
	2319	Q
	2320	.
	2321	.
	2322	.
	2323	RPTOUT ; E ntry point for queue d job, nig htly job
	2324	; RCTMPND = name of the subsc ript for ^ TMP to use to return all lines
	2325	; If unde fined or n ull, outpu t is print ed
	2326	; Return global if RCTMPND no t null: ^T MP($J,RCTM PND,line#) =line text
	2327	N DIC,DUO UT,RC0,RC1 3,RC3443,R CCT,RCIEN, RCNT,RCOUT ,RCPAY,RCP AYER,RCPAY ID
	2328	N RCSTOP, RCTOT,RCZ, X,XX,YY,Z, Z0,ZZ
	2329	S RCTMPND =$G(RCTMPN D)
	2330	S (RCCT,R CSTOP,RCNT ,RCTOT)=0
	2331	K ^TMP($J ,"RCERA_AG ED"),^TMP( $J,"RCERA_ ADJ")
	2332	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	2333	I $G(RCJO B)'="",RCJ OB'=$J D
	2334	.K ^TMP(" RCSELPAY", $J)
	2335	.D RLOAD^ RCDPEAR3(3 44.31)
	2336	.S RCJOB= $J
	2337	; build l ocal payer array her e
	2338	S RCNP=+R CNP
	2339	I RCTMPND '="" K ^TM P($J,RCTMP ND)
	2340	; cross-r ef on file #344.31 f ield #.08 - MATCH ST ATUS
	2341	S RCIEN=0 F S RCIE N=$O(^RCY( 344.31,"AM ATCH",0,RC IEN)) Q:'R CIEN D ;unmatched entries o nly
	2342	.Q:$P($G( ^RCY(344.3 1,RCIEN,3) ),U) ; EFT has been removed
	2343	.Q:$P($G( ^RCY(344.3 1,RCIEN,0) ),U,7)=0 ; payment o f zero
	2344	.;
	2345	.S RC13=$ P($G(^RCY( 344.31,RCI EN,0)),U,1 3) ; date received
	2346	.; Check for payer match
	2347	.I '$$CHK PYR^RCDPED AR(RCIEN,0 ,RCJOB,RCN P) Q ;PR CA4.5318 passed ex isting var iable RCNP
	2348	D SELPAY^R CDPEAR3(RC NP,RCJOB,. RCPAY)
	2349	.I RCPAYS '="A" D Q :'XX
	2350	.. S XX=$ $ISSEL^RCD PEU1(344.4 ,IEN3444) ; US786 Ch eck if pay er was sel ected
	2351	.E I RCT YPE'="A" D Q:'XX ; If all of a g ive type o f payer se lected
	2352	.. S XX=$ $ISTYPE^RC DPEU1(344. 4,IEN3444, RCTYPE) ; check that payer mat ches type
	2353	.; Check date range
	2354	.Q:(RCSTA RT>RC13)!( RC13>RCEND )
	2355	.; Passed all the f ilters - i nclude on report
	2356	.S ^TMP($ J,"RCEFT_A GED",$$FMD IFF^XLFDT( RC13,DT),R CIEN)=0,RC NT=RCNT+1
	2357	;
	2358	.
	2359	.
	2360	.RoutinesA ctivitiesR outine Nam eRCDPEDARE nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE EDI LOCKB OX ACT REP ORTRelated RoutinesR outines “C alled By”R outines “C alled” R CDPEAR1
	2361	RCDPEAR2
	2362	RCDPELAR $$ASKLM^R CDPEARL
	2363	$$ENDOR PRT^RCDPEA RL
	2364	ASK^RCD PEARL
	2365	LMRPT^R CDPEARL
	2366	RPT2^RC DPEDA2
	2367	HDR^RCD PEDA3
	2368	SL^RCDP EDA3
	2369	TOTSDAY ^RCDPEDA3
	2370	TOTSF^R CDPEDA3
	2371	LMHDR^R CDPEDA4
	2372	$$ERAST A^RCDPEM3
	2373	$$GETPA Y^RCDPEM9C urrent Log ic - RCDPE DARRCDPEDA R ;ALB/TMK - ACTIVIT Y REPORT ; Jun 06, 20 14@19:11:1 9
	2374	;;4.5;Acc ounts Rece ivable;1 73,276,284 ,283,298,3 04,318,321 ;Mar 20, 1995;Buil d 99
	2375	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2376	Q
	2377	;
	2378	RPT ; Dail y Activity Rpt On De mand
	2379	N POP,RCD ET,RCDIV,R CDONLY,RCD T1,RCDT2,R CHDR,RCINC ,RCLSTMGR, RCNP,RCNJ
	2380	N RCPYRSE L,RCRANGE, RCSTOP,RCT MPND,VAUTD ,X,XX,Y,%Z IS
	2381	S RCNJ=0 ; Not the nightly jo b, user in teractions
	2382	D DIVISIO N^VAUTOMA ; IA 664 S elect Divi sion/Stati on - sets VAUTD
	2383	I 'VAUTD, ($D(VAUTD) '=11) Q
	2384	S RCDET=$ $RTYPE() ; Select Re port Type (Summary/D etail)
	2385	Q:RCDET=- 1
	2386	S XX=$$DT RANGE(.RCD T1,.RCDT2) ; Select Date Range to be use d
	2387	Q:'XX
	2388	;
	2389	; Get ins urance com pany to be used as f ilter
	2390	; PRCA4. 5284 - RC NP is Type of Respon se (1=Rang e,2=All,3= Specific) ^ From Ran ge^ Thru R ange
	2391	S RCNP=$$ GETPAY^RCD PEM9(344.3 1)
	2392	Q:+RCNP=- 1 ; No Ins urance Com pany selec ted
	2393	;
	2394	S RCDONLY =$$DBTONLY () ; Debit only filt er ;PRCA4 .5321
	2395	Q:RCDONLY =-1 ; '^' or timeout
	2396	S RCLSTMG R=$$ASKLM^ RCDPEARL ; Ask to Di splay in L istman Tem plate
	2397	Q:RCLSTMG R<0 ; '^' or timeout
	2398	;
	2399	;
	2400	I RCLSTMG R=1 D Q ; List Man Templa te format, put in ar ray
	2401	. S RCTMP ND="RCDPE_ DAR"
	2402	. K ^TMP( $J,RCTMPND )
	2403	. D EN(RC DET,RCDT1, RCDT2,RCLS TMGR,RCDON LY)
	2404	. D LMHDR ^RCDPEDA4( .RCSTOP,RC DET,1,RCDT 1,RCDT2,.R CHDR,RCDON LY)
	2405	. D LMRPT ^RCDPEARL( .RCHDR,$NA (^TMP($J,R CTMPND))) ; Generate ListMan d isplay
	2406	. K ^TMP( $J,RCTMPND )
	2407	;
	2408	; Ask dev ice
	2409	S %ZIS="Q M"
	2410	D ^%ZIS
	2411	Q:POP
	2412	;
	2413	I $D(IO(" Q")) D Q ; Queu ed Report
	2414	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	2415	. S ZTRTN ="EN^RCDPE DAR("_RCDE T_","_RCDT 1_","_RCDT 2_",0,"_RC DONLY_")" ;PRCA4.5 321 added RCDONLY
	2416	. S ZTDES C="AR - ED I LOCKBOX EFT DAILY ACTIVITY R EPORT"
	2417	. S ZTSAV E("RC*")=" ",ZTSAVE(" VAUTD")=""
	2418	. ;
	2419	. ; PRCA* 4.5*284 - Because TM P global m ay be on a nother ser ver, save off specif ic payers in local
	2420	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	2421	. D ^%ZTL OAD
	2422	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	2423	. K ZTSK, IO("Q")
	2424	. D HOME^ %ZIS
	2425	;
	2426	U IO
	2427	D EN(RCDE T,RCDT1,RC DT2,RCLSTM GR,RCDONLY )
	2428	Q
	2429	.
	2430	.
	2431	.
	2432	EN(RCDET,R CDT1,RCDT2 ,RCLSTMGR, DONLY) ; E ntry point for repor t, might b e queued
	2433	; Input: RCDET - 1 - Detail R eport, 0 - Summary
	2434	; RCDT1 - Internal Fileman St art date
	2435	; RCDT2 - Internal Fileman En d date
	2436	; RCLSTMG R - 1 disp lay in lis t manager, 0 otherwi se
	2437	; Optiona l, default s to 0
	2438	; DONLY - 1 only di splay EFTs with a de bit flag o f 'D'
	2439	; 0 displ ay all EFT s
	2440	; RCNP - A1^A2^A3 W here:
	2441	; A1 - 1 - Range of Payers
	2442	; 2 - All Payers se lected
	2443	; 3 - Spe cific paye rs
	2444	; A2 - Fr om Range ( When a fro m/thru ran ge is sele cted by us er)
	2445	; A3 - Th ru Range ( When a fro m/thru ran ge is sele cted by us er)
	2446	; RCPYRSE L - Array of selecte d payers ( Only prese nt if A1=3 above
	2447	; VAUTD - 1 - All s elected di visions OR an array of selecte d division s
	2448	N DFLG,DT ADD,IEN344 3,IEN34431 ,INPUT,RCF LG,RCJOB,R CT,XX,Z ; PRCA4.5 321 Added DFLG
	2449	N:$G(ZTSK ) ZTSTOP ; Job was tasked , ZTSTOP = flag to s top
	2450	S:'$D(RCL STMGR) RCL STMGR=0
	2451	;
	2452	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	2453	I $D(RCPY RSEL) D
	2454	. K ^TMP( "RCSELPAY" ,$J)
	2455	. M ^TMP( "RCSELPAY" ,$J)=RCPYR SEL
	2456	;
	2457	S XX=$S(R CLSTMGR:1, 1:0)
	2458	S INPUT=X X_"^"_RCLS TMGR_"^"_+ RCDET
	2459	S RCNP=+R CNP,RCJOB= $J
	2460	K ^TMP("R CDAILYACT" ,$J)
	2461	K ^TMP($J ,"TOTALS") ; Initial ize Totals temp work space
	2462	;
	2463	; Loop th rough all of the EDI LOCKBOX D EPOSIT rec ords in th e selected date
	2464	; range a nd add any that pass the payer and divis ion filter s into ^TM P
	2465	; by the internal d ate added
	2466	S DTADD=R CDT1-.0001 ,RCT=0
	2467	S $P(INPU T,"^",4)=0 ; Current Page Numb er
	2468	S $P(INPU T,"^",5)=0 ; Stop Fl ag
	2469	S $P(INPU T,"^",10)= DONLY
	2470	F D Q:' DTADD Q:D TADD>(RCDT 2_".9999") Q:$P(INPU T,"^",5)=1
	2471	. S DTADD =$O(^RCY(3 44.3,"AREC DT",DTADD) )
	2472	. Q:'DTAD D
	2473	. Q:DTADD >(RCDT2_". 9999")
	2474	. S IEN34 43=0
	2475	. F D Q :'IEN3443 Q:$P(INPU T,"^",5)=1
	2476	. . S IEN 3443=$O(^R CY(344.3," ARECDT",DT ADD,IEN344 3))
	2477	. . Q:'IE N3443
	2478	. . S IEN 34431="",R CFLG=0
	2479	. . F D Q:IEN3443 1=""
	2480	. . . S I EN34431=$O (^RCY(344. 31,"B",IEN 3443,IEN34 431))
	2481	. . . Q:I EN34431=""
	2482	. . . Q:' $$CHKPYR(I EN34431,0, RCJOB,RCNP ) ; Not a selected p ayer PRCA* 4.5*318 ad ded ,RCNP
	2483	. . . Q:' $$CHKDIV(I EN34431,0, .VAUTD) ; Not a sele cted stati on/divisio n
	2484	. . . ;
	2485	. . . ; P RCA4.532 1 Added fi lter for D ebit EFTs Only below
	2486	. . . I D ONLY D Q: DFLG'="D" ; Not an EFT wit h a debit flag of 'D '
	2487	. . . . S DFLG=$$GE T1^DIQ(344 .31,IEN344 31,3,"E")
	2488	. . . S R CFLG=1
	2489	. . . S ^ TMP("RCDAI LYACT",$J, DTADD\1,IE N3443,"EFT ",IEN34431 )=""
	2490	.
	2491	.
	2492	.Modified Logic (Cha nges are i n bold) - RCDPEDARRC DPEDAR ;AL B/TMK - AC TIVITY REP ORT ;Jun 0 6, 2014@19 :11:19
	2493	;;4.5;Acc ounts Rece ivable;1 73,276,284 ,283,298,3 04,318,321 ;Mar 20, 1995;Buil d 99
	2494	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2495	Q
	2496	;
	2497	RPT ; Dail y Activity Rpt On De mand
	2498	N POP,RCD ET,RCDIV,R CDONLY,RCD T1,RCDT2,R CHDR,RCINC ,RCLSTMGR, RCNP,RCNJ
	2499	N RCPAR,R CPAY,RCPYR SEL,RCRANG E,RCSTOP,R CTMPND,VAU TD,X,XX,Y, %ZIS
	2500	S RCNJ=0 ; Not the nightly jo b, user in teractions
	2501	D DIVISIO N^VAUTOMA ; IA 664 S elect Divi sion/Stati on - sets VAUTD
	2502	I 'VAUTD, ($D(VAUTD) '=11) Q
	2503	S RCDET=$ $RTYPE() ; Select Re port Type (Summary/D etail)
	2504	Q:RCDET=- 1
	2505	S XX=$$DT RANGE(.RCD T1,.RCDT2) ; Select Date Range to be use d
	2506	Q:'XX
	2507	;
	2508	; Get ins urance com pany to be used as f ilter
	2509	; PRCA4. 5284 - RC NP is Type of Respon se (1=Rang e,2=All,3= Specific) ^ From Ran ge^ Thru R ange
	2510	S RCNP=$$ GETPAY^RCD PEM9(344.3 1)
	2511	Q:+RCNP=- 1 ; No Ins urance Com pany selec ted
	2512	; US786 - Ask to sh ow Medical /Pharmacy Tricare or All
	2513	S $P(INPU T,"^",10)= $$RTYPE^RC DPEU1("")
	2514	I $P(INPU T,"^",10)< 0 Q
	2515	;
	2516	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	2517	Q:RCPAR(" SELC")=-1 ; US786 '^ ' or timeo ut
	2518	S RCPAY=R CPAR("SELC ")
	2519	;
	2520	I RCPAR(" SELC")'="A " D Q:XX= -1 ; US786 - Since w e don't wa nt all pay ers
	2521	. S RCPAR ("TYPE")=$ P(INPUT,"^ ",10) ; pr ompt for p ayers we d o want
	2522	. S RCPAR ("FILE")=3 44.4
	2523	. S RCPAR ("DICA")=" Select Ins urance Com pany NAME: "
	2524	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	2525	;
	2526	S RCDONLY =$$DBTONLY () ; Debit only filt er ;PRCA4 .5321
	2527	Q:RCDONLY =-1 ; '^' or timeout
	2528	S RCLSTMG R=$$ASKLM^ RCDPEARL ; Ask to Di splay in L istman Tem plate
	2529	Q:RCLSTMG R<0 ; '^' or timeout
	2530	;
	2531	;
	2532	I RCLSTMG R=1 D Q ; List Man Templa te format, put in ar ray
	2533	. S RCTMP ND="RCDPE_ DAR"
	2534	. K ^TMP( $J,RCTMPND )
	2535	. D EN(RC DET,RCDT1, RCDT2,RCLS TMGR,RCDON LY)
	2536	. D LMHDR ^RCDPEDA4( .RCSTOP,RC DET,1,RCDT 1,RCDT2,.R CHDR,RCDON LY)
	2537	. D LMRPT ^RCDPEARL( .RCHDR,$NA (^TMP($J,R CTMPND))) ; Generate ListMan d isplay
	2538	. K ^TMP( $J,RCTMPND )
	2539	;
	2540	; Ask dev ice
	2541	S %ZIS="Q M"
	2542	D ^%ZIS
	2543	Q:POP
	2544	;
	2545	I $D(IO(" Q")) D Q ; Queu ed Report
	2546	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	2547	. S ZTRTN ="EN^RCDPE DAR("_RCDE T_","_RCDT 1_","_RCDT 2_",0,"_RC DONLY_")" ;PRCA4.5 321 added RCDONLY
	2548	. S ZTDES C="AR - ED I LOCKBOX EFT DAILY ACTIVITY R EPORT"
	2549	. S ZTSAV E("RC*")=" ",ZTSAVE(" VAUTD")=""
	2550	. S ZTSAV E("^TMP("" RCDPEU1"", $J,")=""
	2551	. ;
	2552	. ; PRCA* 4.5*284 - Because TM P global m ay be on a nother ser ver, save off specif ic payers in local
	2553	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	2554	. D ^%ZTL OAD
	2555	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	2556	. K ZTSK, IO("Q")
	2557	. D HOME^ %ZIS
	2558	;
	2559	U IO
	2560	D EN(RCDE T,RCDT1,RC DT2,RCLSTM GR,RCDONLY )
	2561	Q
	2562	.
	2563	.
	2564	.
	2565	EN(RCDET,R CDT1,RCDT2 ,RCLSTMGR, DONLY) ; E ntry point for repor t, might b e queued
	2566	; Input: RCDET - 1 - Detail R eport, 0 - Summary
	2567	; RCDT1 - Internal Fileman St art date
	2568	; RCDT2 - Internal Fileman En d date
	2569	; RCLSTMG R - 1 disp lay in lis t manager, 0 otherwi se
	2570	; Optiona l, default s to 0
	2571	; DONLY - 1 only di splay EFTs with a de bit flag o f 'D'
	2572	; 0 displ ay all EFT s
	2573	; RCNP - A1^A2^A3 W here:
	2574	; A1 - 1 - Range of Payers
	2575	; 2 - All Payers se lected
	2576	; 3 - Spe cific paye rs
	2577	; A2 - Fr om Range ( When a fro m/thru ran ge is sele cted by us er)
	2578	; A3 - Th ru Range ( When a fro m/thru ran ge is sele cted by us er)
	2579	; RCPYRSE L - Array of selecte d payers ( Only prese nt if A1=3 above
	2580	; VAUTD - 1 - All s elected di visions OR an array of selecte d division s
	2581	N DFLG,DT ADD,IEN344 3,IEN34431 ,INPUT,RCF LG,RCJOB,R CT,XX,Z ; PRCA4.5 321 Added DFLG
	2582	N:$G(ZTSK ) ZTSTOP ; Job was tasked , ZTSTOP = flag to s top
	2583	S:'$D(RCL STMGR) RCL STMGR=0
	2584	;
	2585	; PRCA4. 5284 - Qu eued job n eeds to re load payer selection list
	2586	I $D(RCPY RSEL) D
	2587	. K ^TMP( "RCSELPAY" ,$J)
	2588	. M ^TMP( "RCSELPAY" ,$J)=RCPYR SEL
	2589	;
	2590	S XX=$S(R CLSTMGR:1, 1:0)
	2591	S INPUT=X X_"^"_RCLS TMGR_"^"_+ RCDET
	2592	S RCNP=+R CNP,RCJOB= $J
	2593	K ^TMP("R CDAILYACT" ,$J)
	2594	K ^TMP($J ,"TOTALS") ; Initial ize Totals temp work space
	2595	;
	2596	; Loop th rough all of the EDI LOCKBOX D EPOSIT rec ords in th e selected date
	2597	; range a nd add any that pass the payer and divis ion filter s into ^TM P
	2598	; by the internal d ate added
	2599	S DTADD=R CDT1-.0001 ,RCT=0
	2600	S $P(INPU T,"^",4)=0 ; Current Page Numb er
	2601	S $P(INPU T,"^",5)=0 ; Stop Fl ag
	2602	S $P(INPU T,"^",10)= DONLY
	2603	F D Q:' DTADD Q:D TADD>(RCDT 2_".9999") Q:$P(INPU T,"^",5)=1
	2604	. S DTADD =$O(^RCY(3 44.3,"AREC DT",DTADD) )
	2605	. Q:'DTAD D
	2606	. Q:DTADD >(RCDT2_". 9999")
	2607	. S IEN34 43=0
	2608	. F D Q :'IEN3443 Q:$P(INPU T,"^",5)=1
	2609	. . S IEN 3443=$O(^R CY(344.3," ARECDT",DT ADD,IEN344 3))
	2610	. . Q:'IE N3443
	2611	. . S IEN 34431="",R CFLG=0
	2612	. . F D Q:IEN3443 1=""
	2613	. . . S I EN34431=$O (^RCY(344. 31,"B",IEN 3443,IEN34 431))
	2614	. . . Q:I EN34431=""
	2615	. . . Q:' $$CHKPYR(I EN34431,0, RCJOB,RCNP ) ; Not a selected p ayer PRCA* 4.5*318 ad ded ,RCNP
	2616	. . . ;
	2617	. . . I R CPAYS'="A" D Q:'XX
	2618	. . . . S XX=$$ISSE L^RCDPEU1( 344.31,IEN 34431) ; U S786 Check if payer was select ed
	2619	. . . E I RCTYPE'= "A" D Q:' XX ; If all of a give type of pa yer select ed
	2620	. . . . S XX=$$ISTY PE^RCDPEU1 (344.31,IE N34431,RCT YPE) ; che ck that pa yer matche s type
	2621	. . . ;
	2622	. . . Q:' $$CHKDIV(I EN34431,0, .VAUTD) ; Not a sele cted stati on/divisio n
	2623	. . . ;
	2624	. . . ; P RCA4.532 1 Added fi lter for D ebit EFTs Only below
	2625	. . . I D ONLY D Q: DFLG'="D" ; Not an EFT wit h a debit flag of 'D '
	2626	. . . . S DFLG=$$GE T1^DIQ(344 .31,IEN344 31,3,"E")
	2627	. . . S R CFLG=1
	2628	. . . S ^ TMP("RCDAI LYACT",$J, DTADD\1,IE N3443,"EFT ",IEN34431 )=""
	2629	.
	2630	.
	2631	.RoutinesA ctivitiesR outine Nam eRCDPELARE nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE AUTO-POST RECEIPT R EPORTRelat ed Routine sRoutines “Called By ”Routines “Called” RCDPEADP
	2632	$$ASKLM ^RCDPEARL
	2633	LMRPT^R CDPEARL
	2634	$$CHKDI V^RCDPEDAR
	2635	$$ERAHD R2^RCDPELA 1
	2636	$$HDRLN 2^RCDPELA1
	2637	$$HDRLN 3^RCDPELA1
	2638	RPTOUT^ RCDPELA1
	2639	INFO^RC DPEM6
	2640	$$GETPA Y^RCDPEM9 Current L ogicRCDPEL AR ;EDE/FA - LIST AL L AUTO-POS TED RECEIP TS REPORT ;Nov 17, 2 016
	2641	;;4.5;Acc ounts Rece ivable;3 18,321;M ar 20, 199 5;Build 12 1
	2642	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2643	;
	2644	EN ; Main entry poin t
	2645	N INPUT,R CVAUTD,XX, YY
	2646	K ^TMP($J ,"RCDPE_LA R"),^TMP(" RCDPE_LAR" ,$J)
	2647	K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER ")
	2648	;
	2649	S INPUT=$ $STADIV(.R CVAUTD) ; Division f ilter
	2650	Q:'INPUT ; '^' or tim eout
	2651	S $P(INPU T,"^",2)=$ $APORERA() ; Filter by Auto-Po st Date or ERA Date Received
	2652	Q:'$P(INP UT,"^",2) ; '^' or t imeout
	2653	S $P(INPU T,"^",3)=$ $DTRNG(0) ; Start Da te\|End dat e
	2654	Q:'$P(INP UT,"^",3) ; '^' or t imeout
	2655	S $P(INPU T,"^",4)=$ $SELERA() ; Select t ype of ERA S to be di splayed
	2656	Q:'$P(INP UT,"^",4) ; '^' or t imeout
	2657	S XX=+$$G ETPAY^RCDP EM9(344.4, 1,0) ; Ins urance Com pany filte r
	2658	S XX=$S(X X=-1:-1,XX =2:1,1:2)
	2659	S $P(INPU T,"^",5)=X X ; Insurance Company fi lter
	2660	Q:$P(INPU T,"^",5)<0 ; '^' or timeout
	2661	S XX=$P(I NPUT,"^",2 ),YY=$P(IN PUT,"^",4)
	2662	S $P(INPU T,"^",6)=$ $RPTSORT(X X,YY) ; Se lect Secon dary sort
	2663	Q:'$P(INP UT,"^",6) ; '^' or t imeout
	2664	S $P(INPU T,"^",7)=$ $ASKLM^RCD PEARL ; As k to Displ ay in List man Templa te
	2665	Q:$P(INPU T,"^",7)<0 ; '^' or timeout
	2666	I $P(INPU T,"^",7)=1 D Q ; Compile da ta and cal l listman to display
	2667	. D LMOUT (INPUT,.RC VAUTD,.IO)
	2668	S $P(INPU T,"^",8)=$ $EXCEL() ; Ask to ou tput to Ex cel
	2669	Q:$P(INPU T,"^",8)=- 1 ; '^' or timeout
	2670	D:$P(INPU T,"^",8)=1 INFO^RCDP EM6 ; Disp lay captur e informat ion for Ex cel
	2671	S $P(INPU T,"^",9)=$ $DEVICE($P (INPUT,"^" ,8),.IO) ; Ask outpu t device
	2672	Q:'$P(INP UT,"^",9)
	2673	;
	2674	; Option to queue
	2675	I $D(IO(" Q")) D Q
	2676	. N JOB S JOB=$J
	2677	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	2678	. S ZTRTN ="REPORT^R CDPELAR(IN PUT,.RCVAU TD,.IO,JOB )"
	2679	. S ZTDES C="LIST AL L AUTO-POS TED RECEIP TS REPORT"
	2680	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	2681	. S ZTSAV E("RC")=" ",ZTSAVE(" VAUTD")="" ,ZTSAVE("I O")=""
	2682	. S ZTSAV E("INPUT") ="",ZTSAVE ("JOB")=""
	2683	. D ^%ZTL OAD
	2684	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	2685	. K ZTSK, IO("Q")
	2686	. D HOME^ %ZIS
	2687	;
	2688	D REPORT( INPUT,.RCV AUTD,.IO) ; Compile and Displa y Report d ata
	2689	Q
	2690	.
	2691	.
	2692	.
	2693	REPORT(INP UT,RCVAUTD ,IO,JOB) ; Compile a nd run the report
	2694	; Expects ZTQUEUED to be defi ned alread y if queue d
	2695	; Input: INPUT - A1 ^A2^A3^... ^An Where:
	2696	; A1 - 1 - All divi sions sele cted
	2697	; 2 - Sel ected divi sions
	2698	; A2 - 1 - Filter b y Auto-Pos t date ran ge
	2699	; 2 - Fil ter by ERA Date Rece ived date range
	2700	; A3 - B1 \|B2 - Wher e:
	2701	; B1 - ER A Date Rec eived Star t Date if A2=2
	2702	; Auto-Po st Start D ate of A2= 1
	2703	; B2 - ER A Date Rec eived End Date if A2 =2
	2704	; Auto-Po st End Dat e of A2=1
	2705	; A4 - 1 - Posted/C ompleted R eceipts
	2706	; 2 - Onl y ERAs wit h Missing Receipts
	2707	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	2708	; A5 - 1 - All insu rance comp anies sele cted
	2709	; 2 - Sel ected insu rance comp anies chos en
	2710	; A6 - 1 - Auto-Pos t Date/ERA Date Rece ived Sort
	2711	; 2 - Pay er sort
	2712	; 3 - Mis sing Recei pts
	2713	; A7 - 0 - Do not d isplay in a listman template
	2714	; 1 - Dis play in a listman te mplate
	2715	; A8 - 0 - Output t o paper
	2716	; 1 - Out put to Exc el
	2717	; A9 - Li ne counter for Listm an output
	2718	; RCVAUTD - Array o f selected Divisions
	2719	; Only pa ssed if A1 =2
	2720	; IO - In terface de vice
	2721	; JOB - $ J (optiona l, only pa ssed in wh en report is queued)
	2722	; ^TMP("R CSELPAY",$ J)- Global Array of selected i nsurance c ompanies
	2723	; Output: ^TMP("RCD PE_LAR",$J ,CTR)=Line - Array o f display lines (no headers)
	2724	; for out put to Lis tman
	2725	; Only se t when A7- 1
	2726	N CURDT,D IVFLT,DTEN D,DTSTART, ERAFILT,WH ICH,SORT,S TOP,XX
	2727	K ^TMP("R CDPE_LAR", $J),^TMP($ J,"RCDPE_L AR")
	2728	I '$G(JOB ) S JOB=""
	2729	U IO
	2730	D PAYERS( JOB) ; Rea rrange pay er global for easier use
	2731	S DIVFLT= $P(INPUT," ^",1) ; Di vision fil ter
	2732	S WHICH=$ P(INPUT,"^ ",2) ; 1 - Auto-Post date, 2 - ERA Date Received
	2733	S SORT=$P (INPUT,"^" ,6) ; Type of second ary sort
	2734	S DTEND=$ P($P(INPUT ,"^",3),"\| ",2)_".999 9" ; End of Date Ra nge
	2735	S DTSTART =$P($P(INP UT,"^",3), "\|",1) ; E nd of Date Range
	2736	S ERAFILT =$P(INPUT, "^",4) ; E RA Filter
	2737	;
	2738	; First f ilter and sort the r eport
	2739	S CURDT=( DTSTART-1) _.9999 ;PR CA4.5321 Added '_. 9999'
	2740	F D Q:' CURDT Q:C URDT>(DTEN D)
	2741	. S:WHICH =1 CURDT=$ O(^RCY(344 .4,"F",CUR DT))
	2742	. S:WHICH =2 CURDT=$ O(^RCY(344 .4,"AFD",C URDT))
	2743	. Q:'CURD T
	2744	. Q:CURDT >(DTEND)
	2745	. I WHICH =2 D RPTE( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD) Q
	2746	. D RPTA( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD)
	2747	.
	2748	.
	2749	.
	2750	RPTE(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD) ; Use the ER A Date Rec eived inde x and filt er out
	2751	; divisio ns, payers that were n't select ed
	2752	; Input: DIVFLT - 1 - All Div isions sel ected, 2 o therwise
	2753	; CURDT - Date bein g processe d
	2754	; SORT - 1 - Auto-P ost Date S ort
	2755	; 2 - Mis sing Recei pts
	2756	; ERAFILT - 1 - Pos ted/Comple ted Receip ts
	2757	; 2 - Onl y ERAs wit h Missing Receipts
	2758	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	2759	; VAUTD - Array of selected d ivisions
	2760	; ^TMP("R CSELPAY",$ J) - Globa l Array of selected insurance companies
	2761	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	2762	; A1 - "R CDPE_LAR"
	2763	; A2 - Up percased P ayer Name (primary s ort)
	2764	; A3 - Se condary So rt Value
	2765	; A4 - In ternal IEN for file 344.4
	2766	; A5 - In ternal IEN for sub f ile 344.41
	2767	N COMPLET E,IEN3444, IEN34441,I ENS,PAYER, RECEIPT,SV AL,XX
	2768	S IEN3444 =0
	2769	F D Q:' IEN3444
	2770	. S IEN34 44=$O(^RCY (344.4,"AF D",CURDT,I EN3444))
	2771	. Q:'IEN3 444
	2772	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pay ment From field
	2773	. S PAYER =$$UP^XLFS TR(PAYER)
	2774	. Q:'$D(^ TMP($J,"SE LPAYER",PA YER)) ; No t a select ed payer
	2775	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; Not a selected Division
	2776	. S XX=$$ GET1^DIQ(3 44.4,IEN34 44,4.01,"I ") ; Auto- Post date on ERA
	2777	. Q:'XX ; sk ip if not auto-poste d ERA
	2778	. S COMPL ETE=$$COMP LETE(IEN34 44) ; Chec k for miss ing receip ts
	2779	. I ERAFI LT=1,'COMP LETE Q ; Mi ssing Rece ipt
	2780	. I ERAFI LT=2,COMPL ETE Q ; No t a Missin g Receipt
	2781	.
	2782	.
	2783	.
	2784	RPTA(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD) ; Use the Au to-Post Da te index a nd filter out
	2785	; divisio ns, payers that were n't select ed
	2786	; Input: DIVFLT - 1 - All Div isions sel ected, 2 o therwise
	2787	; CURDT - Date bein g processe d
	2788	; SORT - 1 - Auto-P ost Date S ort
	2789	; 2 - Mis sing Recei pts
	2790	; ERAFILT - 1 - Pos ted/Comple ted Receip ts
	2791	; 2 - Onl y ERAs wit h Missing Receipts
	2792	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	2793	; VAUTD - Array of selected d ivisions
	2794	; ^TMP("R CSELPAY",$ J) - Globa l Array of selected insurance companies
	2795	; ^TMP($J ,"RCDPE_LA R","ERA") - see outp ut for def inition
	2796	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	2797	; A1 - "R CDPE_LAR"
	2798	; A2 - Up percased P ayer Name (primary s ort)
	2799	; A3 - Se condary So rt Value
	2800	; A4 - In ternal IEN for file 344.4
	2801	; A5 - In ternal IEN for sub f ile 344.41
	2802	; ^TMP($J ,A1,"ERA", A2)="" - L ist of ERA s that wer e already pulled Whe re:
	2803	; A1 - "R CDPE_LAR"
	2804	; A2 - IE N of #344. 4 (ERA #)
	2805	;
	2806	N COMPLET E,IEN3444, IEN3441,PA YER,SVAL
	2807	S IEN3444 =0
	2808	F D Q:' IEN3444
	2809	. S IEN34 44=$O(^RCY (344.4,"F" ,CURDT,IEN 3444))
	2810	. Q:'IEN3 444
	2811	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; Not a selected Division
	2812	. S COMPL ETE=$$COMP LETE(IEN34 44)
	2813	. I ERAFI LT=1,'COMP LETE Q ; Mis sing Recei pt
	2814	. I ERAFI LT=2,COMPL ETE Q ; Not a Missing Receipt
	2815	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pay ment From field
	2816	. S PAYER =$$UP^XLFS TR(PAYER)
	2817	. Q:'$D(^ TMP($J,"SE LPAYER",PA YER)) ; No t a select ed payer
	2818	. Q:$D(^T MP($J,"RCD PE_LAR","E RA",IEN344 4)) ; Alre ady pulled this ERA
	2819	. ;
	2820	. S ^TMP( $J,"RCDPE_ LAR","ERA" ,IEN3444)= ""
	2821	. S IEN34 441=0
	2822	. F D Q :'IEN34441
	2823	. . S IEN 34441=$O(^ RCY(344.4, IEN3444,1, IEN34441))
	2824	. . Q:'IE N34441
	2825	. . S SVA L=$S(SORT= 1:CURDT,1: COMPLETE) ; Get the sort value
	2826	. . S ^TM P($J,"RCDP E_LAR","SE L",PAYER,S VAL,IEN344 4,IEN34441 )=""
	2827	Q
	2828	;Modified Logic (Ch anges are in bold)RC DPELAR ;ED E/FA - LIS T ALL AUTO -POSTED RE CEIPTS REP ORT ;Nov 1 7, 2016
	2829	;;4.5;Acc ounts Rece ivable;3 18,321;M ar 20, 199 5;Build 12 1
	2830	;Per VA D irective 6 402, this routine sh ould not b e modified .
	2831	;
	2832	EN ; Main entry poin t
	2833	N INPUT,R CVAUTD,XX, YY
	2834	K ^TMP($J ,"RCDPE_LA R"),^TMP(" RCDPE_LAR" ,$J)
	2835	K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER ")
	2836	;
	2837	S INPUT=$ $STADIV(.R CVAUTD) ; Division f ilter
	2838	Q:'INPUT ; '^' or tim eout
	2839	S $P(INPU T,"^",2)=$ $APORERA() ; Filter by Auto-Po st Date or ERA Date Received
	2840	Q:'$P(INP UT,"^",2) ; '^' or t imeout
	2841	S $P(INPU T,"^",3)=$ $DTRNG(0) ; Start Da te\|End dat e
	2842	Q:'$P(INP UT,"^",3) ; '^' or t imeout
	2843	S $P(INPU T,"^",4)=$ $SELERA() ; Select t ype of ERA S to be di splayed
	2844	Q:'$P(INP UT,"^",4) ; '^' or t imeout
	2845	; US786 - Ask to s how Medica l/Pharmacy Tricare o r All
	2846	S $P(INPU T,"^",10)= $$RTYPE^RC DPEU("")
	2847	I $P(INPU T,"^",10)< 0 Q
	2848	;
	2849	;
	2850	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	2851	Q:RCPAR(" SELC")=-1 ; US786 '^ ' or timeo ut
	2852	;
	2853	I RCPAR(" SELC")'="A " D Q:XX= -1 ; US786 - Since w e don't wa nt all pay ers
	2854	. S RCPAR ("TYPE")=$ P(INPUT,"^ ",10) ; pr ompt for p ayers we d o want
	2855	. S RCPAR ("FILE")=3 44.4
	2856	. S RCPAR ("DICA")=" Select Ins urance Com pany NAME: "
	2857	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	2858	;
	2859	S XX=+$$G ETPAY^RCDP EM9(344.4, 1,0) ; Ins urance Com pany filte r
	2860	S XX=$S(X X=-1:-1,XX =2:1,1:2)
	2861	S $P(INPU T,"^",5)=X X ; Insurance Company fi lter
	2862	Q:$P(INPU T,"^",5)<0 ; '^' or timeout
	2863	S XX=$P(I NPUT,"^",2 ),YY=$P(IN PUT,"^",4)
	2864	S $P(INPU T,"^",6)=$ $RPTSORT(X X,YY) ; Se lect Secon dary sort
	2865	Q:'$P(INP UT,"^",6) ; '^' or t imeout
	2866	S $P(INPU T,"^",7)=$ $ASKLM^RCD PEARL ; As k to Displ ay in List man Templa te
	2867	Q:$P(INPU T,"^",7)<0 ; '^' or timeout
	2868	I $P(INPU T,"^",7)=1 D Q ; Compile da ta and cal l listman to display
	2869	. D LMOUT (INPUT,.RC VAUTD,.IO)
	2870	S $P(INPU T,"^",8)=$ $EXCEL() ; Ask to ou tput to Ex cel
	2871	Q:$P(INPU T,"^",8)=- 1 ; '^' or timeout
	2872	D:$P(INPU T,"^",8)=1 INFO^RCDP EM6 ; Disp lay captur e informat ion for Ex cel
	2873	S $P(INPU T,"^",9)=$ $DEVICE($P (INPUT,"^" ,8),.IO) ; Ask outpu t device
	2874	Q:'$P(INP UT,"^",9)
	2875	;
	2876	; Option to queue
	2877	I $D(IO(" Q")) D Q
	2878	. N JOB S JOB=$J
	2879	. N ZTDES C,ZTRTN,ZT SAVE,ZTSK
	2880	. S ZTRTN ="REPORT^R CDPELAR(IN PUT,.RCVAU TD,.IO,JOB )"
	2881	. S ZTDES C="LIST AL L AUTO-POS TED RECEIP TS REPORT"
	2882	. M RCPYR SEL=^TMP(" RCSELPAY", $J)
	2883	. S ZTSAV E("RC")=" ",ZTSAVE(" VAUTD")="" ,ZTSAVE("I O")=""
	2884	. S ZTSAV E("INPUT") ="",ZTSAVE ("JOB")=""
	2885	. S ZTSA VE("^TMP(" "RCDPEU1"" ,$J,")=""
	2886	. D ^%ZTL OAD
	2887	. W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
	2888	. K ZTSK, IO("Q")
	2889	. D HOME^ %ZIS
	2890	;
	2891	D REPORT( INPUT,.RCV AUTD,.IO) ; Compile and Displa y Report d ata
	2892	Q
	2893	.
	2894	.
	2895	.
	2896	REPORT(INP UT,RCVAUTD ,IO,JOB) ; Compile a nd run the report
	2897	; Expects ZTQUEUED to be defi ned alread y if queue d
	2898	; Input: INPUT - A1 ^A2^A3^... ^An Where:
	2899	; A1 - 1 - All divi sions sele cted
	2900	; 2 - Sel ected divi sions
	2901	; A2 - 1 - Filter b y Auto-Pos t date ran ge
	2902	; 2 - Fil ter by ERA Date Rece ived date range
	2903	; A3 - B1 \|B2 - Wher e:
	2904	; B1 - ER A Date Rec eived Star t Date if A2=2
	2905	; Auto-Po st Start D ate of A2= 1
	2906	; B2 - ER A Date Rec eived End Date if A2 =2
	2907	; Auto-Po st End Dat e of A2=1
	2908	; A4 - 1 - Posted/C ompleted R eceipts
	2909	; 2 - Onl y ERAs wit h Missing Receipts
	2910	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	2911	; A5 - 1 - All insu rance comp anies sele cted
	2912	; 2 - Sel ected insu rance comp anies chos en
	2913	; A6 - 1 - Auto-Pos t Date/ERA Date Rece ived Sort
	2914	; 2 - Pay er sort
	2915	; 3 - Mis sing Recei pts
	2916	; A7 - 0 - Do not d isplay in a listman template
	2917	; 1 - Dis play in a listman te mplate
	2918	; A8 - 0 - Output t o paper
	2919	; 1 - Out put to Exc el
	2920	; A9 - Li ne counter for Listm an output
	2921	; RCVAUTD - Array o f selected Divisions
	2922	; Only pa ssed if A1 =2
	2923	; IO - In terface de vice
	2924	; JOB - $ J (optiona l, only pa ssed in wh en report is queued)
	2925	; ^TMP("R CSELPAY",$ J)- Global Array of selected i nsurance c ompanies
	2926	; Output: ^TMP("RCD PE_LAR",$J ,CTR)=Line - Array o f display lines (no headers)
	2927	; for out put to Lis tman
	2928	; Only se t when A7- 1
	2929	N CURDT,D IVFLT,DTEN D,DTSTART, ERAFILT,WH ICH,RCTYPE ,RCPAYS,SO RT,STOP,XX
	2930	K ^TMP("R CDPE_LAR", $J),^TMP($ J,"RCDPE_L AR")
	2931	I '$G(JOB ) S JOB=""
	2932	U IO
	2933	D PAYERS( JOB) ; Rea rrange pay er global for easier use
	2934	S DIVFLT= $P(INPUT," ^",1) ; Di vision fil ter
	2935	S WHICH=$ P(INPUT,"^ ",2) ; 1 - Auto-Post date, 2 - ERA Date Received
	2936	S SORT=$P (INPUT,"^" ,6) ; Type of second ary sort
	2937	S DTEND=$ P($P(INPUT ,"^",3),"\| ",2)_".999 9" ; End of Date Ra nge
	2938	S DTSTART =$P($P(INP UT,"^",3), "\|",1) ; E nd of Date Range
	2939	S ERAFILT =$P(INPUT, "^",4) ; E RA Filter
	2940	S RCTYPE= $P(INPUT," ^",10) ; U S786 Medic al/Pharmac y/Tricare/ All
	2941	S RCPAYS= $P(INPUT," ^",5) ; Pa yers All/S elected/Ra nge
	2942	;
	2943	; First f ilter and sort the r eport
	2944	S CURDT=( DTSTART-1) _.9999 ;PR CA4.5321 Added '_. 9999'
	2945	F D Q:' CURDT Q:C URDT>(DTEN D)
	2946	. S:WHICH =1 CURDT=$ O(^RCY(344 .4,"F",CUR DT))
	2947	. S:WHICH =2 CURDT=$ O(^RCY(344 .4,"AFD",C URDT))
	2948	. Q:'CURD T
	2949	. Q:CURDT >(DTEND)
	2950	. I WHICH =2 D RPTE( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD,RCTYP E,RCPAYS) Q
	2951	. D RPTA( DIVFLT,CUR DT,SORT,ER AFILT,.RCV AUTD,RCTYP E,RCPAYS)
	2952	.
	2953	.
	2954	.
	2955	RPTE(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD,RCT YPE,RCPAYS ) ; Use th e ERA Date Received index and filter out
	2956	; divisio ns, payers that were n't select ed
	2957	; Input: DIVFLT - 1 - All Div isions sel ected, 2 o therwise
	2958	; CURDT - Date bein g processe d
	2959	; SORT - 1 - Auto-P ost Date S ort
	2960	; 2 - Mis sing Recei pts
	2961	; ERAFILT - 1 - Pos ted/Comple ted Receip ts
	2962	; 2 - Onl y ERAs wit h Missing Receipts
	2963	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	2964	; VAUTD - Array of selected d ivisions
	2965	; RCTYPE - Type of payer - M/ P/T/A
	2966	; RCPAYS - A - All payers, S - Selected Payers, R - Range o f Payers
	2967	; ^TMP("R CSELPAY",$ J) - Globa l Array of selected insurance companies
	2968	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	2969	; A1 - "R CDPE_LAR"
	2970	; A2 - Up percased P ayer Name (primary s ort)
	2971	; A3 - Se condary So rt Value
	2972	; A4 - In ternal IEN for file 344.4
	2973	; A5 - In ternal IEN for sub f ile 344.41
	2974	N COMPLET E,IEN3444, IEN34441,I ENS,PAYER, RECEIPT,SV AL,XX
	2975	S IEN3444 =0
	2976	F D Q:' IEN3444
	2977	. S IEN34 44=$O(^RCY (344.4,"AF D",CURDT,I EN3444))
	2978	. Q:'IEN3 444
	2979	. I RCPAY S’=A”
	2980	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pay ment From field
	2981	. S PAYER =$$UP^XLFS TR(PAYER)
	2982	. Q:'$D(^ TMP($J,"SE LPAYER",PA YER)) ; No t a select ed payer
	2983	. S XX=1
	2984	. I RCPAY S'="A" D Q:'XX
	2985	. . S XX= $$ISSEL^RC DPEU1(344. 4,IEN3444) ; Check i f payer wa s selected
	2986	. E I RC TYPE'="A" D Q:'XX ; If all of a give type of payer s elected
	2987	. . S XX= $$ISTYPE^R CDPEU1(344 .4,IEN3444 ,RCTYPE) ; check tha t payer ma tches type
	2988	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; Not a selected Division
	2989	. S XX=$$ GET1^DIQ(3 44.4,IEN34 44,4.01,"I ") ; Auto- Post date on ERA
	2990	. Q:'XX ; sk ip if not auto-poste d ERA
	2991	. S COMPL ETE=$$COMP LETE(IEN34 44) ; Chec k for miss ing receip ts
	2992	. I ERAFI LT=1,'COMP LETE Q ; Mi ssing Rece ipt
	2993	. I ERAFI LT=2,COMPL ETE Q ; No t a Missin g Receipt
	2994	.
	2995	.
	2996	.
	2997	RPTA(DIVFL T,CURDT,SO RT,ERAFILT ,VAUTD,RCT YPE,RCPAYS ) ; Use th e Auto-Pos t Date ind ex and fil ter out
	2998	; divisio ns, payers that were n't select ed
	2999	; Input: DIVFLT - 1 - All Div isions sel ected, 2 o therwise
	3000	; CURDT - Date bein g processe d
	3001	; SORT - 1 - Auto-P ost Date S ort
	3002	; 2 - Mis sing Recei pts
	3003	; ERAFILT - 1 - Pos ted/Comple ted Receip ts
	3004	; 2 - Onl y ERAs wit h Missing Receipts
	3005	; 3 - Bot h Posted/C ompleted a nd Missing Receipts
	3006	; VAUTD - Array of selected d ivisions
	3007	; RCTYPE - Type of payer - M/ P/T/A
	3008	; RCPAYS - A - All payers, S - Selected Payers, R - Range o f Payers
	3009	; ^TMP("R CSELPAY",$ J) - Globa l Array of selected insurance companies
	3010	; ^TMP($J ,"RCDPE_LA R","ERA") - see outp ut for def inition
	3011	; Output: ^TMP($J,A 1,"SEL",A2 ,A3,A4,A5) ="" - if r ecord pass ed filters Where:
	3012	; A1 - "R CDPE_LAR"
	3013	; A2 - Up percased P ayer Name (primary s ort)
	3014	; A3 - Se condary So rt Value
	3015	; A4 - In ternal IEN for file 344.4
	3016	; A5 - In ternal IEN for sub f ile 344.41
	3017	; ^TMP($J ,A1,"ERA", A2)="" - L ist of ERA s that wer e already pulled Whe re:
	3018	; A1 - "R CDPE_LAR"
	3019	; A2 - IE N of #344. 4 (ERA #)
	3020	;
	3021	N COMPLET E,IEN3444, IEN3441,PA YER,SVAL
	3022	S IEN3444 =0
	3023	F D Q:' IEN3444
	3024	. S IEN34 44=$O(^RCY (344.4,"F" ,CURDT,IEN 3444))
	3025	. Q:'IEN3 444
	3026	. I DIVFL T'=1 Q:'$$ CHKDIV^RCD PEDAR(IEN3 444,1,.VAU TD) ; Not a selected Division
	3027	. S COMPL ETE=$$COMP LETE(IEN34 44)
	3028	. I ERAFI LT=1,'COMP LETE Q ; Mi ssing Rece ipt
	3029	. I ERAFI LT=2,COMPL ETE Q ; No t a Missin g Receipt
	3030	. S PAYER =$$GET1^DI Q(344.4,IE N3444,.06, "I") ; Pay ment From field
	3031	. S PAYER =$$UP^XLFS TR(PAYER)
	3032	. ; Q:'$D (^TMP($J," SELPAYER", PAYER)) ; Not a sele cted payer
	3033	. S XX=1
	3034	. I RCPAY S'="A" D Q:'XX
	3035	. . S XX= $$ISSEL^RC DPEU1(344. 4,IEN3444) ; Check i f payer wa s selected
	3036	. E I RC TYPE'="A" D Q:'XX ; If all of a give type of payer s elected
	3037	. . S XX= $$ISTYPE^R CDPEU1(344 .4,IEN3444 ,RCTYPE) ; check tha t payer ma tches type
	3038	. Q:$D(^T MP($J,"RCD PE_LAR","E RA",IEN344 4)) ; Alre ady pulled this ERA
	3039	. ;
	3040	. S ^TMP( $J,"RCDPE_ LAR","ERA" ,IEN3444)= ""
	3041	. S IEN34 441=0
	3042	. F D Q :'IEN34441
	3043	. . S IEN 34441=$O(^ RCY(344.4, IEN3444,1, IEN34441))
	3044	. . Q:'IE N34441
	3045	. . S SVA L=$S(SORT= 1:CURDT,1: COMPLETE) ; Get the sort value
	3046	. . S ^TM P($J,"RCDP E_LAR","SE L",PAYER,S VAL,IEN344 4,IEN34441 )=""
	3047	QRoutines Activities Routine Na meRCDPEM3E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE REMOVED E RA AUDITRe lated Rout inesRoutin es “Called By”Routin es “Called ” RCDPE8 NZ
	3048	RCDPEAR
	3049	RCDPEAR2
	3050	RCDPEDAR
	3051	RCDPEM2
	3052	RCDPEM6
	3053	RCDPESP2 $$ASKLM^R CDPEARL
	3054	$$CLMCH MPV^RCDPEA RL
	3055	$$CLMTR ICR^RCDPEA RL
	3056	$$ENDOR PRT^RCDPEA RL
	3057	$$INCHM PVA^RCDPEA RL
	3058	$$INTRI CAR^RCDPEA RL
	3059	$$NOW^R CDPEARL
	3060	$$PAD^R CDPEARL
	3061	HDRLST^ RCDPEARL
	3062	LMRPT^R CDPEARL
	3063	SL^RCDP EARL
	3064	$$DTPRB ^RCDPEM4
	3065	$$DTRNG ^RCDPEM4
	3066	INFO^RC DPEM6 Current Logic – RC DPEM3.
	3067	.
	3068	.
	3069	EN ; entry point for Remove ER A from Act ive Workli st Audit R eport [RCD PE REMOVED ERA AUDIT ]
	3070	N %ZIS,I, RCDISPTY,R CDIV,RCDTR NG,RCEND,R CHDR,RCLNC NT,RCLSTMG R,RCPAGE,R CPG,RCSSD, RCSTA,RCST ART,RCSTNO ,RCSTOP,RC TMPND
	3071	N RCXCLUD E,VAUTD,X, Y
	3072	; RCDTRNG - Date/Ti me range o f report ( range flag ^start dat e^end date )
	3073	; RCDISPT Y - Displa y/print/Ex cel flag
	3074	; RCPAGE - page num ber of the report
	3075	; RCSSD - Selected Start Date (W:Date R emoved fro m Worklist ;R:Date ER A Received ;B:Both Da tes
	3076	; RCLNCNT - counter for SL^RC DPEARL
	3077	; RCSTOP - flag to exit listi ng
	3078	; RCTMPND - storage node for SL^RCDPEAR L
	3079	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	3080	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	3081	;
	3082	S RCLSTMG R="" ; Li stMan flag , set to ' ^' if sent to Excel
	3083	S RCTMPND ="" ; if null, repo rt lines n ot stored in ^TMP, w ritten dir ectly
	3084	S (RCSTOP ,RCPG,RCLN CNT)=0 ; i nitial val ues of zer o
	3085	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	3086	S RCPAGE= 0 ; report page numb er
	3087	; PRCA4. 5276 - Mo dify Heade r display
	3088	S RCDIV=" ALL" ; de fault to A ll divisio ns
	3089	S RCSSD=$ $DTPRB^RCD PEM4() G:R CSSD=0 EXI T
	3090	S RCDTRNG =$$DTRNG^R CDPEM4() G :'RCDTRNG EXIT
	3091	S RCSTART =$P(RCDTRN G,U,2),RCE ND=$P(RCDT RNG,U,3)
	3092	; VAUTD=1 for 'ALL'
	3093	D DIVISIO N^VAUTOMA Q:Y=-1
	3094	I 'VAUTD& ($D(VAUTD) '=11) G EX IT
	3095	I VAUTD=0 D
	3096	.N J,C S (J,C)=0,RC DIV="" F S J=$O(VAU TD(J)) Q:' J S C=C+1 ,$P(RCDIV, ", ",C)=VA UTD(J)
	3097	;
	3098	; CHAMPVA exclusion filter
	3099	S RCXCLUD E("CHAMPVA ")=$$INCHM PVA^RCDPEA RL ; user is asked w hether to include
	3100	G:RCXCLUD E("CHAMPVA ")<0 EXIT
	3101	; TRICARE exclusion filter
	3102	S RCXCLUD E("TRICARE ")=$$INTRI CAR^RCDPEA RL ; user is asked w hether to include
	3103	G:RCXCLUD E("TRICARE ")<0 EXIT
	3104	; ask dis play type for Excel
	3105	S RCDISPT Y=$$DISPTY () G:RCDIS PTY<0 EXIT
	3106	; display Excel inf o, set Lis tMan flag to prevent question
	3107	I RCDISPT Y D INFO^R CDPEM6 S R CLSTMGR="^ "
	3108	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	3109	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3110	; display in ListMa n format a nd exit on return
	3111	I RCLSTMG R D G EXI T
	3112	.S RCTMPN D=$T(+0)_" ^REMOVE ER A AUDIT" K ^TMP($J, RCTMPND) ; clean any residue
	3113	.D REPRT, DISP(RCDIS PTY)
	3114	.N H,L,HD R S L=0
	3115	.S HDR("T ITLE")=$$H DRNM
	3116	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 7 lines of report header
	3117	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	3118	..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 )
	3119	.; invoke ListMan
	3120	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	3121	;
	3122	S %ZIS="Q M" D ^%ZIS Q:POP
	3123	I $D(IO(" Q")) D Q
	3124	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
	3125	.S ZTRTN= "ENFRMQ^RC DPEM3"
	3126	.S ZTDESC =$$HDRNM
	3127	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	3128	.D ^%ZTLO AD
	3129	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" queued.", 1:"Unable to queue t his task." )
	3130	.K IO("Q" ) D HOME^% ZIS
	3131	;
	3132	U IO
	3133	;
	3134	.
	3135	.
	3136	.
	3137	REPRT ; Ge nerate the report ^T MP array
	3138	; INPUT:
	3139	; RCSSD
	3140	; RCDTRNG
	3141	N DTXREF, START,END, ERAIEN,X,D TERA,ZROND
	3142	; DTXREF - date fro m cross-re ference, " AC" is ERA DATE (#.0 4), "AD" i s REMOVED DATE (#.17 )
	3143	; DTERA - Date ERA received
	3144	; START - Start dat e of repor t date ran ge
	3145	; END - E nd date of report da te range
	3146	; ERAIEN - IEN of E RA
	3147	; RCSSD - Start dat e (W:Date Removed fr om Worklis t;R:Date E RA Receive d;B:Both D ates)
	3148	; ZROND - node zero of entry in file #3 44.4
	3149	;
	3150	; ^RCY(34 4.4,D0,6)= (#.16) RE MOVED BY [ 1P:200] ^ (#.17) REM OVED DATE [2D] ^ (#. 18) REMOVE REASON [3 F] ^
	3151	;
	3152	K ^TMP($J ,"RC REMV ERA"),^TMP ($J,"RC TO TAL")
	3153	; If user picked W: Date Remov ed from Wo rklist or B:Both Dat es, use x- ref "AD" ( REMOVED DA TE)
	3154	I (RCSSD= "W")!(RCSS D="B") D
	3155	.S END=$P (RCDTRNG,U ,3),START= $P(RCDTRNG ,U,2),DTXR EF=START-. 0000001
	3156	.F S DTX REF=$O(^RC Y(344.4,"A D",DTXREF) ) Q:'DTXRE F!(DTXREF\ 1>END) D
	3157	..S ERAIE N=0
	3158	..F S ER AIEN=$O(^R CY(344.4," AD",DTXREF ,ERAIEN)) Q:'ERAIEN I $D(^RCY (344.4,ERA IEN,6)) S ZROND=$G(^ (0)) D:ZRO ND]""
	3159	...; CHAM PVA check
	3160	...I $G(R CXCLUDE("C HAMPVA")), $$CLMCHMPV ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3161	....N N S N=$G(^TMP ($J,"RC TO TAL","CHAM PVA"))+1,^ ("CHAMPVA" )=N ; tot al can be listed
	3162	...;
	3163	...; TRIC ARE check
	3164	...I $G(R CXCLUDE("T RICARE")), $$CLMTRICR ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3165	....N N S N=$G(^TMP ($J,"RC TO TAL","TRIC ARE"))+1,^ ("TRICARE" )=N ; tot al can be listed
	3166	...;
	3167	...D PROC (ERAIEN)
	3168	;
	3169	; If user picked R: Date ERA R eceived or B:Both Da tes, use x -ref "AC" (ERA DATE)
	3170	I (RCSSD= "R")!(RCSS D="B") D
	3171	.S END=$P (RCDTRNG,U ,3),START= $P(RCDTRNG ,U,2),DTXR EF=START-. 0000001
	3172	.F S DTX REF=$O(^RC Y(344.4,"A C",DTXREF) ) Q:'DTXRE F!(DTXREF\ 1>END) D
	3173	..S ERAIE N=0 F S E RAIEN=$O(^ RCY(344.4, "AC",DTXRE F,ERAIEN)) Q:'ERAIEN D
	3174	...Q:'$D( ^RCY(344.4 ,ERAIEN,6) ) S ZROND= $G(^(0)) Q :ZROND=""
	3175	...Q:$D(^ TMP($J,"RC REMV ERA" ,$P(ZROND, U))) ; dat a is in ^T MP
	3176	...; CHAM PVA check
	3177	...I $G(R CXCLUDE("C HAMPVA")), $$CLMCHMPV ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3178	....N N S N=$G(^TMP ($J,"RC TO TAL","CHAM PVA"))+1,^ ("CHAMPVA" )=N ; tot al can be listed
	3179	...;
	3180	...; TRIC ARE check
	3181	...I $G(R CXCLUDE("T RICARE")), $$CLMTRICR ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3182	....N N S N=$G(^TMP ($J,"RC TO TAL","TRIC ARE"))+1,^ ("TRICARE" )=N ; tot al can be listed
	3183	...;
	3184	...S DTER A=$P(ZROND ,U,4) Q:'D TERA D PR OC(ERAIEN)
	3185	;
	3186	Q
	3187	;
	3188	.
	3189	.
	3190	.Modified Logic (Cha nges are i n bold) – RCDPEM3.
	3191	.
	3192	.
	3193	EN ; entry point for Remove ER A from Act ive Workli st Audit R eport [RCD PE REMOVED ERA AUDIT ]
	3194	N %ZIS,I, RCDISPTY,R CDIV,RCDTR NG,RCEND,R CHDR,RCLNC NT,RCLSTMG R,RCPAGE,R CPG,RCSSD, RCSTA,RCST ART,RCSTNO ,RCSTOP,RC TMPND
	3195	N RCTYPE, RCXCLUDE,V AUTD,X,Y
	3196	; RCDTRNG - Date/Ti me range o f report ( range flag ^start dat e^end date )
	3197	; RCDISPT Y - Displa y/print/Ex cel flag
	3198	; RCPAGE - page num ber of the report
	3199	; RCSSD - Selected Start Date (W:Date R emoved fro m Worklist ;R:Date ER A Received ;B:Both Da tes
	3200	; RCLNCNT - counter for SL^RC DPEARL
	3201	; RCSTOP - flag to exit listi ng
	3202	; RCTMPND - storage node for SL^RCDPEAR L
	3203	; RTYPE – M/P/T/A M EDICAL/PHA RMACY/TRIC ARE/ALL
	3204	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	3205	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	3206	;
	3207	S RCLSTMG R="" ; Li stMan flag , set to ' ^' if sent to Excel
	3208	S RCTMPND ="" ; if null, repo rt lines n ot stored in ^TMP, w ritten dir ectly
	3209	S (RCSTOP ,RCPG,RCLN CNT)=0 ; i nitial val ues of zer o
	3210	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	3211	S RCPAGE= 0 ; report page numb er
	3212	; PRCA4. 5276 - Mo dify Heade r display
	3213	S RCDIV=" ALL" ; de fault to A ll divisio ns
	3214	S RCSSD=$ $DTPRB^RCD PEM4() G:R CSSD=0 EXI T
	3215	S RCDTRNG =$$DTRNG^R CDPEM4() G :'RCDTRNG EXIT
	3216	S RCSTART =$P(RCDTRN G,U,2),RCE ND=$P(RCDT RNG,U,3)
	3217	; VAUTD=1 for 'ALL'
	3218	D DIVISIO N^VAUTOMA Q:Y=-1
	3219	I 'VAUTD& ($D(VAUTD) '=11) G EX IT
	3220	I VAUTD=0 D
	3221	.N J,C S (J,C)=0,RC DIV="" F S J=$O(VAU TD(J)) Q:' J S C=C+1 ,$P(RCDIV, ", ",C)=VA UTD(J)
	3222	;
	3223	; CHAMPVA exclusion filter
	3224	S RCXCLUD E("CHAMPVA ")=$$INCHM PVA^RCDPEA RL ; user is asked w hether to include
	3225	G:RCXCLUD E("CHAMPVA ")<0 EXIT
	3226	; TRICARE exclusion filter
	3227	S RCXCLUD E("TRICARE ")=$$INTRI CAR^RCDPEA RL ; user is asked w hether to include
	3228	G:RCXCLUD E("TRICARE ")<0 EXIT
	3229	S RCTYPE= $$RTYPE^RC DPEU1("A") G:RCTYPE= -1 EXIT ; US786
	3230	; ask disp lay type f or Excel
	3231	S RCDISPT Y=$$DISPTY () G:RCDIS PTY<0 EXIT
	3232	; display Excel inf o, set Lis tMan flag to prevent question
	3233	I RCDISPT Y D INFO^R CDPEM6 S R CLSTMGR="^ "
	3234	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	3235	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3236	; display in ListMa n format a nd exit on return
	3237	I RCLSTMG R D G EXI T
	3238	.S RCTMPN D=$T(+0)_" ^REMOVE ER A AUDIT" K ^TMP($J, RCTMPND) ; clean any residue
	3239	.D REPRT, DISP(RCDIS PTY)
	3240	.N H,L,HD R S L=0
	3241	.S HDR("T ITLE")=$$H DRNM
	3242	.F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H) ; take firs t 7 lines of report header
	3243	.I $O(RCH DR(L)) D ; any rema ining head er lines a t top of r eport
	3244	..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 )
	3245	.; invoke ListMan
	3246	.D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
	3247	;
	3248	S %ZIS="Q M" D ^%ZIS Q:POP
	3249	I $D(IO(" Q")) D Q
	3250	.N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
	3251	.S ZTRTN= "ENFRMQ^RC DPEM3"
	3252	.S ZTDESC =$$HDRNM
	3253	.S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
	3254	.D ^%ZTLO AD
	3255	.W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_" queued.", 1:"Unable to queue t his task." )
	3256	.K IO("Q" ) D HOME^% ZIS
	3257	;
	3258	U IO
	3259	;
	3260	.
	3261	.
	3262	.
	3263	REPRT ; Ge nerate the report ^T MP array
	3264	; INPUT:
	3265	; RCSSD
	3266	; RCDTRNG
	3267	N DTXREF, START,END, ERAIEN,X,D TERA,ZROND
	3268	; DTXREF - date fro m cross-re ference, " AC" is ERA DATE (#.0 4), "AD" i s REMOVED DATE (#.17 )
	3269	; DTERA - Date ERA received
	3270	; START - Start dat e of repor t date ran ge
	3271	; END - E nd date of report da te range
	3272	; ERAIEN - IEN of E RA
	3273	; RCSSD - Start dat e (W:Date Removed fr om Worklis t;R:Date E RA Receive d;B:Both D ates)
	3274	; ZROND - node zero of entry in file #3 44.4
	3275	;
	3276	; ^RCY(34 4.4,D0,6)= (#.16) RE MOVED BY [ 1P:200] ^ (#.17) REM OVED DATE [2D] ^ (#. 18) REMOVE REASON [3 F] ^
	3277	;
	3278	K ^TMP($J ,"RC REMV ERA"),^TMP ($J,"RC TO TAL")
	3279	; If user picked W: Date Remov ed from Wo rklist or B:Both Dat es, use x- ref "AD" ( REMOVED DA TE)
	3280	I (RCSSD= "W")!(RCSS D="B") D
	3281	.S END=$P (RCDTRNG,U ,3),START= $P(RCDTRNG ,U,2),DTXR EF=START-. 0000001
	3282	.F S DTX REF=$O(^RC Y(344.4,"A D",DTXREF) ) Q:'DTXRE F!(DTXREF\ 1>END) D
	3283	..S ERAIE N=0
	3284	..F S ER AIEN=$O(^R CY(344.4," AD",DTXREF ,ERAIEN)) Q:'ERAIEN I $D(^RCY (344.4,ERA IEN,6)) S ZROND=$G(^ (0)) D:ZRO ND]""
	3285	...; CHAM PVA check
	3286	...I $G(R CXCLUDE("C HAMPVA")), $$CLMCHMPV ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3287	....N N S N=$G(^TMP ($J,"RC TO TAL","CHAM PVA"))+1,^ ("CHAMPVA" )=N ; tot al can be listed
	3288	...;
	3289	...; TRIC ARE check
	3290	...I $G(R CXCLUDE("T RICARE")), $$CLMTRICR ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3291	... I $$I STYPE^RCDP EU1(344.4, ERAIEN,"T" )) D ;
	3292	....N N S N=$G(^TMP ($J,"RC TO TAL","TRIC ARE"))+1,^ ("TRICARE" )=N ; tot al can be listed
	3293	... I '$$ ISTYPE^RCD PEU1(344.4 ,ERAIEN,RC TYPE)) Q ; US786 Fil ter by Typ e
	3294	...;
	3295	...D PROC (ERAIEN)
	3296	;
	3297	; If user picked R: Date ERA R eceived or B:Both Da tes, use x -ref "AC" (ERA DATE)
	3298	I (RCSSD= "R")!(RCSS D="B") D
	3299	.S END=$P (RCDTRNG,U ,3),START= $P(RCDTRNG ,U,2),DTXR EF=START-. 0000001
	3300	.F S DTX REF=$O(^RC Y(344.4,"A C",DTXREF) ) Q:'DTXRE F!(DTXREF\ 1>END) D
	3301	..S ERAIE N=0 F S E RAIEN=$O(^ RCY(344.4, "AC",DTXRE F,ERAIEN)) Q:'ERAIEN D
	3302	...Q:'$D( ^RCY(344.4 ,ERAIEN,6) ) S ZROND= $G(^(0)) Q :ZROND=""
	3303	...Q:$D(^ TMP($J,"RC REMV ERA" ,$P(ZROND, U))) ; dat a is in ^T MP
	3304	...; CHAM PVA check
	3305	...I $G(R CXCLUDE("C HAMPVA")), $$CLMCHMPV ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3306	....N N S N=$G(^TMP ($J,"RC TO TAL","CHAM PVA"))+1,^ ("CHAMPVA" )=N ; tot al can be listed
	3307	...;
	3308	...; TRIC ARE check
	3309	...I $G(R CXCLUDE("T RICARE")), $$CLMTRICR ^RCDPEARL( "344.4;"_E RAIEN) D Q ; count and quit if true
	3310	....N N S N=$G(^TMP ($J,"RC TO TAL","TRIC ARE"))+1,^ ("TRICARE" )=N ; tot al can be listed
	3311	...;
	3312	...S DTER A=$P(ZROND ,U,4) Q:'D TERA D PR OC(ERAIEN)
	3313	;
	3314	Q
	3315	;
	3316	.
	3317	.
	3318	.RoutinesA ctivitiesR outine Nam eRCDPEM4En hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE EEOB MOVE/ COPY/RMOVE RPT
	3319	RCDPE ERA W/PAPER EO B REPORTRe lated Rout inesRoutin es “Called By”Routin es “Called ” RCDPE8 NZ
	3320	RCDPEAR1
	3321	RCDPEAR
	3322	RCDPEM3
	3323	RCDPEM6
	3324	RCDPPLB $$ASKLM^RC DPEARL
	3325	$$CLMCH MPV^RCDPEA RL
	3326	$$CLMTR ICR^RCDPEA RL
	3327	$$ENDOR PRT^RCDPEA RL
	3328	$$EXCHM PVA^RCDPEA RL
	3329	$$EXTRI CAR^RCDPEA RL
	3330	$$NOW^R CDPEARL
	3331	$$PAD^R CDPEARL
	3332	HDRLST^ RCDPEARL
	3333	LMRPT^R CDPEARL
	3334	SL^RCDP EARL
	3335	SVEOB^R CDPEM41
	3336	SVERA^R CDPEM41
	3337	INFO^RC DPEM6 Current Logic – RC DPEM4.
	3338	.
	3339	.
	3340	ASKUSR ;co llect filt er and dev ice option s
	3341	Q:$G(RCRT YP)="" ; must have record typ e
	3342	N %ZIS,PO P,RCACT,RC DISPTY,RCD IV,RCDTRNG ,RCHDR,RCL STMGR,RCLN CNT,RCPGNU M,RCPROG,R CSTA,RCSTO P,RCTMPND, RCXCLUDE,V AUTD,X,Y
	3343	; RCACT - selected actions fo r EOB
	3344	; RCDISPT Y - displa y type
	3345	; RCDIV - selected divs.
	3346	; RCDTRNG - date ra nge for re port
	3347	; RCHDR - header ar ray
	3348	; RCLSTMG R - ListMa n output f lag
	3349	; RCPGNUM - report page count
	3350	; RCPROG - ^TMP sto rage node for entrie s
	3351	; RCSTA - station
	3352	; RCSTOP - flag to stop repor t
	3353	; RCTMPND - ListMan storage n ode
	3354	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	3355	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	3356	;
	3357	S RCPROG= $T(+0),RCL STMGR="",R CACT="",(R CLNCNT,RCS TOP)=0,RCT MPND=""
	3358	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	3359	;Select D ate Range for Report
	3360	S RCDTRNG =$$DTRNG() G:'RCDTRN G EXIT
	3361	;Select F ilter for Action Typ e (Move,Co py,Remove or All)
	3362	I RCRTYP= "EOB" S RC ACT=$$ACTI ON G:RCACT <0 EXIT
	3363	;Select F ilter/Sort by Divisi on
	3364	D STADIV G:'RCDIV E XIT
	3365	; Begin P RCA4.532 1
	3366	; CHAMPVA exclusion filter
	3367	S RCXCLUD E("CHAMPVA ")=$$EXCHM PVA^RCDPEA RL ; user is asked w hether to exclude
	3368	G:RCXCLUD E("CHAMPVA ")<0 EXIT
	3369	; TRICARE exclusion filter
	3370	S RCXCLUD E("TRICARE ")=$$EXTRI CAR^RCDPEA RL ; user is asked w hether to exclude
	3371	G:RCXCLUD E("TRICARE ")<0 EXIT
	3372	; End PRC A4.5321
	3373	; Select Display Ty pe , exit if indicat ed
	3374	S RCDISPT Y=$$DISPTY () G:RCDIS PTY<0 EXIT
	3375	;Display capture in formation for Excel, set RCLST MGR to pre vent quest ion
	3376	I RCDISPT Y D INFO^R CDPEM6 S R CLSTMGR="^ "
	3377	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3378	.
	3379	.
	3380	.
	3381	CMPLERA ;G enerate th e ERA post ed with pa per EOB re port ^TMP array
	3382	; ^RCY(34 4.4,0) = E LECTRONIC REMITTANCE ADVICE^34 4.4I^
	3383	N START,E ND,ERAIEN, STA,STNAM, STNUM
	3384	;Date Ran ge
	3385	S START=0 ,END="9999 999",SUB=0
	3386	S:$P(RCDT RNG,U) STA RT=$P(RCDT RNG,U,2),E ND=$P(RCDT RNG,U,3)
	3387	;Selected division or All
	3388	;Scan AFL index for ERA withi n date ran ge
	3389	F S STAR T=$O(^RCY( 344.4,"AFL ",START)) Q:'START Q:START>EN D D
	3390	.S ERAIEN =""
	3391	.F S ERA IEN=$O(^RC Y(344.4,"A FL",START, ERAIEN)) Q :'ERAIEN D
	3392	..;Ignore if not po sted with paper EOB
	3393	..Q:'$D(^ RCY(344.4, ERAIEN,7))
	3394	..;Check division
	3395	..D ERAST A(ERAIEN,. STA,.STNUM ,.STNAM)
	3396	..I RCDIV =2,'$D(VAU TD(STA)) Q
	3397	..; CHAMP VA check
	3398	..I $G(RC XCLUDE("CH AMPVA")),$ $CLMCHMPV^ RCDPEARL(" 344.4;"_ER AIEN) D Q ; count and quit i f true
	3399	...N N S N=$G(^TMP( $J,"RC TOT AL","CHAMP VA"))+1,^( "CHAMPVA") =N ; tota l can be l isted
	3400	..;
	3401	..; TRICA RE check
	3402	..I $G(RC XCLUDE("TR ICARE")),$ $CLMTRICR^ RCDPEARL(" 344.4;"_ER AIEN) D Q ; count and quit i f true
	3403	...N N S N=$G(^TMP( $J,"RC TOT AL","TRICA RE"))+1,^( "TRICARE") =N ; tota l can be l isted
	3404	..;
	3405	..D SVERA ^RCDPEM41( ERAIEN,STA ,STNUM,STN AM)
	3406	;
	3407	Q
	3408	;
	3409	CMPLEOB ;G enerate th e EOB Move d/Copy/Rem ove report ^TMP arra y
	3410	N DTSUB,S TART,END,E OBIEN,IEN1 01,STA,STN AM,STNUM
	3411	;Date Ran ge
	3412	S START=$ P(RCDTRNG, U,2),END=$ P(RCDTRNG, U,3)
	3413	;Selected division or All
	3414	;Scan AEO B index fo r EOB with in date ra nge
	3415	F S STAR T=$O(^IBM( 361.1,"AEO B",START)) Q:'START Q:(START\ 1)>END D
	3416	.S EOBIEN =""
	3417	.F S EOB IEN=$O(^IB M(361.1,"A EOB",START ,EOBIEN)) Q:'EOBIEN D
	3418	..; Ignor e if not M OVED/COPIE D
	3419	..S IEN10 1=$O(^IBM( 361.1,"AEO B",START,E OBIEN,"")) Q:'IEN101
	3420	..; Check division
	3421	..D EOBST A(EOBIEN,. STA,.STNUM ,.STNAM)
	3422	..I RCDIV =2,'$D(VAU TD(STA)) Q
	3423	..; CHAMP VA check
	3424	..I $G(RC XCLUDE("CH AMPVA")),$ $CLMCHMPV^ RCDPEARL(" 361.1;"_EO BIEN) D Q ; count and quit i f true
	3425	...N N S N=$G(^TMP( $J,"RC TOT AL","CHAMP VA"))+1,^( "CHAMPVA") =N ; tota l can be l isted
	3426	..; TRICA RE check
	3427	..I $G(RC XCLUDE("TR ICARE")),$ $CLMTRICR^ RCDPEARL(" 361.1;"_EO BIEN) D Q ; count and quit i f true
	3428	...N N S N=$G(^TMP( $J,"RC TOT AL","TRICA RE"))+1,^( "TRICARE") =N ; tota l can be l isted
	3429	..;
	3430	..;
	3431	..D SVEOB ^RCDPEM41( EOBIEN,IEN 101,STA,ST NUM,STNAM)
	3432	;
	3433	QModified Logic (Ch anges are in bold) – RCDPEM4.
	3434	.
	3435	.
	3436	ASKUSR ;co llect filt er and dev ice option s
	3437	Q:$G(RCRT YP)="" ; must have record typ e
	3438	N %ZIS,PO P,RCACT,RC DISPTY,RCD IV,RCDTRNG ,RCHDR,RCL STMGR,RCLN CNT,RCPGNU M,RCPROG,R CSTA,RCSTO P
	3439	N RCTMPND ,RCXCLUDE, RCTYPE,VAU TD,X,Y
	3440	; RCACT - selected actions fo r EOB
	3441	; RCDISPT Y - displa y type
	3442	; RCDIV - selected divs.
	3443	; RCDTRNG - date ra nge for re port
	3444	; RCHDR - header ar ray
	3445	; RCLSTMG R - ListMa n output f lag
	3446	; RCPGNUM - report page count
	3447	; RCPROG - ^TMP sto rage node for entrie s
	3448	; RCSTA - station
	3449	; RCSTOP - flag to stop repor t
	3450	; RCTMPND - ListMan storage n ode
	3451	; RCTYPE – Type of EEOBs to i nclude M/P /T/A MEDIC AL/PHARMAC Y/TRICARE/ ALL
	3452	; RCXCLUD E("CHAMPVA ") - boole an, exclud e CHAMPVA
	3453	; RCXCLUD E("TRICARE ") - boole an, exclud e TriCare
	3454	;
	3455	S RCPROG= $T(+0),RCL STMGR="",R CACT="",(R CLNCNT,RCS TOP)=0,RCT MPND=""
	3456	S (RCXCLU DE("CHAMPV A"),RCXCLU DE("TRICAR E"))=0 ; d efault to false
	3457	;Select D ate Range for Report
	3458	S RCDTRNG =$$DTRNG() G:'RCDTRN G EXIT
	3459	;Select F ilter for Action Typ e (Move,Co py,Remove or All)
	3460	I RCRTYP= "EOB" S RC ACT=$$ACTI ON G:RCACT <0 EXIT
	3461	;Select F ilter/Sort by Divisi on
	3462	D STADIV G:'RCDIV E XIT
	3463	; Begin P RCA4.532 1
	3464	; CHAMPVA exclusion filter
	3465	S RCXCLUD E("CHAMPVA ")=$$EXCHM PVA^RCDPEA RL ; user is asked w hether to exclude
	3466	G:RCXCLUD E("CHAMPVA ")<0 EXIT
	3467	; TRICARE exclusion filter
	3468	S RCXCLUD E("TRICARE ")=$$EXTRI CAR^RCDPEA RL ; user is asked w hether to exclude
	3469	G:RCXCLUD E("TRICARE ")<0 EXIT
	3470	; End PRC A4.5321
	3471	; US786 S tandardize filter Me dical/Phar macy/Trica re
	3472	S RCTYPE= $$RTYPE^RC DPEU1("A")
	3473	; Select Display Ty pe , exit if indicat ed
	3474	S RCDISPT Y=$$DISPTY () G:RCDIS PTY<0 EXIT
	3475	;Display capture in formation for Excel, set RCLST MGR to pre vent quest ion
	3476	I RCDISPT Y D INFO^R CDPEM6 S R CLSTMGR="^ "
	3477	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3478	.
	3479	.
	3480	.
	3481	CMPLERA ;G enerate th e ERA post ed with pa per EOB re port ^TMP array
	3482	; ^RCY(34 4.4,0) = E LECTRONIC REMITTANCE ADVICE^34 4.4I^
	3483	N START,E ND,ERAIEN, STA,STNAM, STNUM
	3484	;Date Ran ge
	3485	S START=0 ,END="9999 999",SUB=0
	3486	S:$P(RCDT RNG,U) STA RT=$P(RCDT RNG,U,2),E ND=$P(RCDT RNG,U,3)
	3487	;Selected division or All
	3488	;Scan AFL index for ERA withi n date ran ge
	3489	F S STAR T=$O(^RCY( 344.4,"AFL ",START)) Q:'START Q:START>EN D D
	3490	.S ERAIEN =""
	3491	.F S ERA IEN=$O(^RC Y(344.4,"A FL",START, ERAIEN)) Q :'ERAIEN D
	3492	..;Ignore if not po sted with paper EOB
	3493	..Q:'$D(^ RCY(344.4, ERAIEN,7))
	3494	..;Check division
	3495	..D ERAST A(ERAIEN,. STA,.STNUM ,.STNAM)
	3496	..I RCDIV =2,'$D(VAU TD(STA)) Q
	3497	..; CHAMP VA check
	3498	..I $G(RC XCLUDE("CH AMPVA")),$ $CLMCHMPV^ RCDPEARL(" 344.4;"_ER AIEN) D Q ; count and quit i f true
	3499	...N N S N=$G(^TMP( $J,"RC TOT AL","CHAMP VA"))+1,^( "CHAMPVA") =N ; tota l can be l isted
	3500	..;
	3501	..; TRICA RE check
	3502	..I $G(RC XCLUDE("TR ICARE")),$ $CLMTRICR^ RCDPEARL(" 344.4;"_ER AIEN) D Q ; count and quit i f true
	3503	..I '$$IS TYPE^RCDPE U1(344.4,E RAIEN,RCTY PE) Q ; U S786 - M/P /T/A filte r
	3504	...N N S N=$G(^TMP( $J,"RC TOT AL","TRICA RE"))+1,^( "TRICARE") =N ; tota l can be l isted
	3505	..;
	3506	..D SVERA ^RCDPEM41( ERAIEN,STA ,STNUM,STN AM)
	3507	;
	3508	Q
	3509	;
	3510	CMPLEOB ;G enerate th e EOB Move d/Copy/Rem ove report ^TMP arra y
	3511	N DTSUB,S TART,END,E OBIEN,IEN1 01,STA,STN AM,STNUM
	3512	;Date Ran ge
	3513	S START=$ P(RCDTRNG, U,2),END=$ P(RCDTRNG, U,3)
	3514	;Selected division or All
	3515	;Scan AEO B index fo r EOB with in date ra nge
	3516	F S STAR T=$O(^IBM( 361.1,"AEO B",START)) Q:'START Q:(START\ 1)>END D
	3517	.S EOBIEN =""
	3518	.F S EOB IEN=$O(^IB M(361.1,"A EOB",START ,EOBIEN)) Q:'EOBIEN D
	3519	..; Ignor e if not M OVED/COPIE D
	3520	..S IEN10 1=$O(^IBM( 361.1,"AEO B",START,E OBIEN,"")) Q:'IEN101
	3521	..; Check division
	3522	..D EOBST A(EOBIEN,. STA,.STNUM ,.STNAM)
	3523	..I RCDIV =2,'$D(VAU TD(STA)) Q
	3524	..; CHAMP VA check
	3525	..I $G(RC XCLUDE("CH AMPVA")),$ $CLMCHMPV^ RCDPEARL(" 361.1;"_EO BIEN) D Q ; count and quit i f true
	3526	...N N S N=$G(^TMP( $J,"RC TOT AL","CHAMP VA"))+1,^( "CHAMPVA") =N ; tota l can be l isted
	3527	..; TRICA RE check
	3528	..I $G(RC XCLUDE("TR ICARE")),$ $CLMTRICR^ RCDPEARL(" 361.1;"_EO BIEN) D Q ; count and quit i f true
	3529	...N N S N=$G(^TMP( $J,"RC TOT AL","TRICA RE"))+1,^( "TRICARE") =N ; tota l can be l isted
	3530	..I '$$IS TYPE^RCDPE U1(344.4,E RAIEN,RCTY PE) Q ; U S786 - M/P /T/A filte r
	3531	..;
	3532	..;
	3533	..D SVEOB ^RCDPEM41( EOBIEN,IEN 101,STA,ST NUM,STNAM)
	3534	;
	3535	QRoutines Activities Routine Na meRCDPEM6E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE EFT AUDIT REPORTRel ated Routi nesRoutine s “Called By”Routine s “Called” RCDPE8N Z
	3536	RCDPEAC
	3537	RCDPEADP
	3538	RCDPEAPP
	3539	RCDPEAR1
	3540	RCDPEAR2
	3541	RCDPELAR
	3542	RCDPEM3
	3543	RCDPEM4 $$ASKLM^RC DPEARL
	3544	$$ENDOR PRT^RCDPEA RL
	3545	$$NOW^R CDPEARL
	3546	$$PAD^R CDPEARL
	3547	HDRLST^ RCDPEARL
	3548	LMRPT^R CDPEARL
	3549	SL^RCDP EARL
	3550	$$DISPT Y^RCDPEM3
	3551	$$DTRNG ^RCDPEM4Cu rrent Logi c.
	3552	.
	3553	.
	3554	EN1 ; entr y point fo r EFT Audi t Report
	3555	N I,RCDIS PTY,RCDTRN G,RCHDR,RC LSTMGR,RCP GNUM,RCSTO P,RCTMPND, X,Y
	3556	; RCDISPT Y - Displa y/print/Ex cel flag
	3557	; RCDTRNG - date ra nge select ed
	3558	; RCHDR - header ar ray
	3559	; RCLSTMG R - ListMa n flag
	3560	; RCPGNUM - report page numbe r
	3561	; RCSTOP - boolean, User indi cated to s top
	3562	; RCTMPND - storage node in ^ TMP
	3563	;
	3564	W !," "_$ $HDRNM,!
	3565	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) EXIT
	3566	S RCLSTMG R="" ; Li stMan flag , set to ' ^' if sent to Excel
	3567	S RCTMPND ="" ; if null, repo rt lines n ot stored in ^TMP, w ritten dir ectly
	3568	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 EXIT
	3569	; display informati on for Exc el, indica te not to ask for Li stMan
	3570	I RCDISPT Y D INFO S RCLSTMGR= U
	3571	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	3572	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3573	I RCLSTMG R D G EXI T
	3574	.S RCTMPN D=$T(+0)_" ^DUP EFT" K ^TMP($J ,RCTMPND) ; clean an y residue
	3575	.D GENRPR T,DSPRPRT ; generat e report a nd store i t in ^TMP
	3576	.
	3577	.
	3578	.
	3579	GENRPRT ; Generate t he report ^TMP array
	3580	; INPUT: RCDTRNG - date range for repor t
	3581	;
	3582	N EFTIEN, FRSTDT,IND XDT,LSTDT, X,Y
	3583	; INDXDT - date of EFT from " E" x-ref
	3584	; FRSTDT - Start da te of repo rt date ra nge
	3585	; LSTDT - End date of report date range
	3586	; EFTIEN - IEN of E FT
	3587	;
	3588	K ^TMP($J ,"RC DUP E FT") ; use d for repo rt
	3589	S FRSTDT= $P(RCDTRNG ,U,2) S:FR STDT<1 FRS TDT=201010 1 ; 1 Jan 1901
	3590	S LSTDT=$ P(RCDTRNG, U,3) S:LST DT<1 LSTDT =4010101 ; 1 Jan 210 1
	3591	S INDXDT= FRSTDT-.00 000001 ; i nitial val ue for x-r ef
	3592	;
	3593	; ^RCY(34 4.31,D0,3) = (#.17) USER WHO R EMOVED EFT [1P:200] ^ (#.18) D ATE/TIME D UPLICATE R EMOVED [2D ] ^ (#.19) EFT REMOV AL REASON [3F]
	3594	F S INDX DT=$O(^RCY (344.31,"E ",INDXDT)) Q:'INDXDT !(INDXDT>L STDT) D
	3595	.S EFTIEN =0 F S EF TIEN=$O(^R CY(344.31, "E",INDXDT ,EFTIEN)) Q:'EFTIEN D:$D(^RCY (344.31,EF TIEN,3)) P ROC(EFTIEN )
	3596	;
	3597	Q
	3598	;
	3599	.
	3600	.
	3601	.Modified Logic (Cha nges are i n bold).
	3602	.
	3603	.
	3604	EN1 ; entr y point fo r EFT Audi t Report
	3605	N I,RCDIS PTY,RCDTRN G,RCHDR,RC LSTMGR,RCP GNUM,RCSTO P,RCTMPND, X,Y
	3606	; RCDISPT Y - Displa y/print/Ex cel flag
	3607	; RCDTRNG - date ra nge select ed
	3608	; RCHDR - header ar ray
	3609	; RCLSTMG R - ListMa n flag
	3610	; RCPGNUM - report page numbe r
	3611	; RCSTOP - boolean, User indi cated to s top
	3612	; RCTMPND - storage node in ^ TMP
	3613	;
	3614	W !," "_$ $HDRNM,!
	3615	S RCDTRNG =$$DTRNG^R CDPEM4() G :'(RCDTRNG >0) EXIT
	3616	S RCTYPE= $$RTYPE^RC DPEU1("A") I RCTYPE= -1 G EXIT
	3617	S RCLSTMG R="" ; Li stMan flag , set to ' ^' if sent to Excel
	3618	S RCTMPND ="" ; if null, repo rt lines n ot stored in ^TMP, w ritten dir ectly
	3619	S RCDISPT Y=$$DISPTY ^RCDPEM3() G:RCDISPT Y<0 EXIT
	3620	; display informati on for Exc el, indica te not to ask for Li stMan
	3621	I RCDISPT Y D INFO S RCLSTMGR= U
	3622	; if not output to Excel ask for ListMa n display, exit if t imeout or '^' - PRCA 4.5298
	3623	I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
	3624	I RCLSTMG R D G EXI T
	3625	.S RCTMPN D=$T(+0)_" ^DUP EFT" K ^TMP($J ,RCTMPND) ; clean an y residue
	3626	.D GENRPR T,DSPRPRT ; generat e report a nd store i t in ^TMP
	3627	.
	3628	.
	3629	.
	3630	GENRPRT ; Generate t he report ^TMP array
	3631	; INPUT: RCDTRNG - date range for repor t
	3632	;
	3633	N EFTIEN, FRSTDT,IND XDT,LSTDT, X,Y
	3634	; INDXDT - date of EFT from " E" x-ref
	3635	; FRSTDT - Start da te of repo rt date ra nge
	3636	; LSTDT - End date of report date range
	3637	; EFTIEN - IEN of E FT
	3638	;
	3639	K ^TMP($J ,"RC DUP E FT") ; use d for repo rt
	3640	S FRSTDT= $P(RCDTRNG ,U,2) S:FR STDT<1 FRS TDT=201010 1 ; 1 Jan 1901
	3641	S LSTDT=$ P(RCDTRNG, U,3) S:LST DT<1 LSTDT =4010101 ; 1 Jan 210 1
	3642	S INDXDT= FRSTDT-.00 000001 ; i nitial val ue for x-r ef
	3643	;
	3644	; ^RCY(34 4.31,D0,3) = (#.17) USER WHO R EMOVED EFT [1P:200] ^ (#.18) D ATE/TIME D UPLICATE R EMOVED [2D ] ^ (#.19) EFT REMOV AL REASON [3F]
	3645	F S INDX DT=$O(^RCY (344.31,"E ",INDXDT)) Q:'INDXDT !(INDXDT>L STDT) D
	3646	. S EFTIE N=0 F S E FTIEN=$O(^ RCY(344.31 ,"E",INDXD T,EFTIEN)) Q:'EFTIEN D ;
	3647	. . I '$$ ISTYPE^RCD PEU1(344.3 1,EFTIEN,R CTYPE) Q
	3648	. . D:$D( ^RCY(344.3 1,EFTIEN,3 )) PROC(EF TIEN)
	3649	;
	3650	Q
	3651	;
	3652	.
	3653	.
	3654	.RoutinesA ctivitiesR outine Nam eRCDPENR2E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE EFT-ERA T RENDING RE PORTRelate d Routines Routines “ Called By” Routines “ Called” RCDPENR1
	3655	RCDPENR3
	3656	RCDPENR4
	3657	RCDPENRU $$ENDORPR T^RCDPEARL
	3658	$$DIVTX T^RCDPENR1
	3659	$$INITA RCH^RCDPEN R1
	3660	$$PAYER TXT^RCDPEN R1
	3661	SAVEDAT A^RCDPENR1
	3662	COMPILE ^RCDPENR3
	3663	GETEFT^ RCDPENR3
	3664	PRINTGT ^RCDPENR3
	3665	$$INTRS CT^RCDPENR 4
	3666	GETERA^ RCDPENR4
	3667	TINARY^ RCDPENR4
	3668	$$XM^RC DPENRU
	3669	PYRARY^ RCDPENRU
	3670	$$DISPT Y^RCDPRU
	3671	$$GETPA Y^RCDPRU
	3672	$$GETTI N^RCDPRU
	3673	INFO^RC DPRU
	3674	$$PAYTI N^RCDPRU2 Current Logic – RC DPENR2.
	3675	.
	3676	.
	3677	;
	3678	EFTERA() ; EFT/ERA T RENDING RE PORT
	3679	;
	3680	N DIRUT,D IROUT,DTOU T,DUOUT,X, Y,POP
	3681	N RCBGDT, RCDATA,RCD ATE,RCDISP ,RCENDDT,R CPYRLST,RC SDT,RCEDT, RCRQDIV,RC RPT
	3682	N RCTIN,R CDIV,RCEXC EL,RCEX,RC PAYR,RCTIN R
	3683	;
	3684	; Alert s oftware to display t o screen
	3685	S RCDISP= 1
	3686	;
	3687	; Ask for Division
	3688	S RCRQDIV =$$GETDIV( .RCDIV)
	3689	Q:RCRQDIV =-1
	3690	;
	3691	; Ask the user for all payers or range of payers
	3692	S RCEX=$$ GETPAY^RCD PRU(.RCPAY R) Q:'RCEX
	3693	Q:'RCEX
	3694	S RCPYRLS T("START") =$P($G(RCP AYR("START ")),U,4),R CPYRLST("E ND")=$P($G (RCPAYR("E ND")),U,4)
	3695	;
	3696	; Ask the user for all payers or range of payers by Tin
	3697	S RCEX=$$ GETTIN^RCD PRU(.RCTIN R) ;Get th e list of payers usi ng their T IN's
	3698	Q:'RCEX
	3699	S RCPYRLS T("TIN","S TART")=$P( $G(RCTINR( "START")), U,2),RCPYR LST("TIN", "END")=$P( $G(RCTINR( "END")),U, 2)
	3700	Q:$D(RCPY RLST("QUIT "))
	3701	;
	3702	; Ask the user for rate type
	3703	S RCRATE= $$GETRATE( )
	3704	Q:RCRATE= -1
	3705	;
	3706	; Ask the user for report typ e, with a prompt for the main report.
	3707	S RCRPT=$ $GETRPT(1)
	3708	Q:RCRPT=- 1
	3709	;
	3710	; Retriev e start da te
	3711	S RCBGDT= $$GETSDATE ()
	3712	Q:RCBGDT= -1
	3713	;
	3714	; Retriev e end date . Send use r start da te as the lower boun d.
	3715	S RCENDDT =$$GETEDAT E(RCBGDT)
	3716	Q:RCENDDT =-1
	3717	;
	3718	;If the u ser is run ning the m ain report , ask if t hey wish t o export t o Excel
	3719	S RCEXCEL =0
	3720	S:RCRPT=" M" RCEXCEL =$$DISPTY^ RCDPRU()
	3721	D:RCEXCEL INFO^RCDP RU
	3722	I 'RCEXCE L,(RCRPT=" M") W !!," This repor t requires 132 colum ns.",!!
	3723	D AUTO(1, RCBGDT,RCE NDDT,.RCPY RLST,RCRQD IV,RCRPT,R CEXCEL,RCR ATE,.RCDIV )
	3724	Q
	3725	;
	3726	AUTO(RCDIS P,RCBGDT,R CENDDT,RCP YRLST,RCRQ DIV,RCRPT, RCEXCEL,RC RATE,RCDIV ) ;
	3727	; RCDISP - Display results to screen or archive f ile flag
	3728	; RCBGDT - begin da te of the report
	3729	; RCENDDT - End dat e of the r eport
	3730	; RCPYRLS T - Payers to report on (All, range, or single pay er)
	3731	; RCRQDIV - Divisio n to repor t on - (A) ll or a si ngle divis ion
	3732	; RCRPT - (M)ain, ( S)ummary o r (G)rand Total Repo rt
	3733	; RCEXCEL - Flag to indicate output in "^" delimi ted format
	3734	; RCRATE - Billing Rate Type flag
	3735	; RCDIV - Divisions to report on.
	3736	;
	3737	;Select o utput devi ce
	3738	W !
	3739	I RCDISP S %ZIS="QM " D ^%ZIS Q:POP
	3740	;Option t o queue
	3741	I 'RCDISP ,$D(IO("Q" )) D Q
	3742	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK
	3743	.S ZTRTN= "REPORT^RC DPENR2"
	3744	.S ZTDESC ="EFT/ERA Trending R eport"
	3745	.S ZTSAVE ("RC*")=""
	3746	.D ^%ZTLO AD
	3747	.I $D(ZTS K) W !!,"T ask number "_ZTSK_" has been q ueued."
	3748	.E W !!, "Unable to queue thi s job."
	3749	.K ZTSK,I O("Q") D H OME^%ZIS
	3750	;
	3751	;Compile and Print Report
	3752	D REPORT
	3753	Q
	3754	;
	3755	REPORT ; Trace the ERA file for the gi ven date r ange
	3756	;
	3757	N RCPYRS, RCINS,RCDA TA,RCDTLDT ,RCDTLIEN, RCIEN,RCEO B,RCBILLNO ,RCBATCH,R CTYPE,RCPH ARM,RCPYRF LG,RCPYALL ,RCTINALL
	3758	;
	3759	;Note: RC PYALL an R CTINALL ar e used in tag HEADER to determ ine header output.
	3760	;
	3761	; Clear t emp arrays
	3762	K ^TMP("R CDPEADP",$ J),^TMP("R CDPENR2",$ J)
	3763	;
	3764	; Compile list of d ivisions
	3765	D DIV(.RC DIV)
	3766	;
	3767	; Compile the list of payers
	3768	; by name
	3769	D PYRARY^ RCDPENRU(R CPYRLST("S TART"),RCP YRLST("END "),1) ; us e insuranc e file pay er list
	3770	;
	3771	; and by TIN
	3772	D TINARY^ RCDPENR4(R CPYRLST("T IN","START "),RCPYRLS T("TIN","E ND")) ; us e insuranc e file pay er list
	3773	;
	3774	; Set pri ntout para meters
	3775	I $D(^TMP ("RCDPEADP ",$J,"INS" ,"A")) S R CPYALL=1
	3776	I $D(^TMP ("RCDPEADP ",$J,"TIN" ,"A")) S R CTINALL=1
	3777	;
	3778	; Now fin d only tho se payers in both li sts
	3779	S RCPYRFL G=$$INTRSC T^RCDPENR4 ()
	3780	;
	3781	; If no p ayers, qui t.
	3782	Q:'RCPYRF LG
	3783	;
	3784	; Gather raw data
	3785	D GETEFT^ RCDPENR3(R CBGDT,RCEN DDT,RCRATE )
	3786	D GETERA^ RCDPENR4(R CBGDT,RCEN DDT,RCRATE )
	3787	;
	3788	;Check fo r data cap tures
	3789	I '$D(^TM P("RCDPENR 2",$J,"MAI N")) D Q
	3790	. W !!,"T here was n o data ava ilable for the reque sted repor t. Please try again. "
	3791	;
	3792	;Generate the stati stics if a ny data ca ptured
	3793	D COMPILE ^RCDPENR3
	3794	.
	3795	.
	3796	.Modified Logic (Cha nges are i n bold) – RCDPENR2.
	3797	.
	3798	.
	3799	;
	3800	EFTERA() ; EFT/ERA T RENDING RE PORT
	3801	;
	3802	N DIRUT,D IROUT,DTOU T,DUOUT,X, Y,POP
	3803	N RCBGDT, RCDATA,RCD ATE,RCDISP ,RCENDDT,R CPYRLST,RC SDT,RCEDT, RCRQDIV,RC RPT
	3804	N RCTIN,R CDIV,RCEXC EL,RCEX,RC PAY,RCPAR, RCPAYR,RCT INR,RCTYPE ,RCWHICH
	3805	;
	3806	; Alert s oftware to display t o screen
	3807	S RCDISP= 1
	3808	;
	3809	; Ask for Division
	3810	S RCRQDIV =$$GETDIV( .RCDIV)
	3811	Q:RCRQDIV =-1
	3812	;
	3813	; Ask the user for all payers or range of payers
	3814	S RCEX=$$ GETPAY^RCD PRU(.RCPAY R) Q:'RCEX
	3815	Q:'RCEX
	3816	S RCPYRLS T("START") =$P($G(RCP AYR("START ")),U,4),R CPYRLST("E ND")=$P($G (RCPAYR("E ND")),U,4)
	3817	;
	3818	; Ask the user for all payers or range of payers by Tin
	3819	S RCEX=$$ GETTIN^RCD PRU(.RCTIN R) ;Get th e list of payers usi ng their T IN's
	3820	Q:'RCEX
	3821	S RCPYRLS T("TIN","S TART")=$P( $G(RCTINR( "START")), U,2),RCPYR LST("TIN", "END")=$P( $G(RCTINR( "END")),U, 2)
	3822	Q:$D(RCPY RLST("QUIT "))
	3823	;
	3824	S RCTYPE= $$RTYPE^RC DPEU1() Q: RCTYPE=-1 ; US786 - Add Tricar e filter t o Med/Phar m/Both
	3825	S RCWHICH =$$NMORTIN ^RCDPEAPP( ) Q:RCWHIC H=-1 ; US7 86 Filter by Payer N ame or TIN
	3826	;
	3827	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	3828	Q:RCPAR(" SELC")=-1 ; US786 '^ ' or timeo ut
	3829	S RCPAY=R CPAR("SELC ")
	3830	;
	3831	I RCPAR(" SELC")'="A " D Q:XX= -1 ; US786 - Since w e don't wa nt all pay ers
	3832	. S RCPAR ("TYPE")=R CTYPE ; prompt f or payers we do want
	3833	. S RCPAR ("SRCH")=$ S(RCWHICH= 2:"T",1:"N ")
	3834	. S RCPAR ("FILE")=3 44.4
	3835	. S RCPAR ("DICA")=" Select Ins urance Com pany"_$S(R CWHICH=1:" NAME: ",1 :" TIN: ")
	3836	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	3837	;
	3838	; Ask the user for rate type
	3839	S RCRATE= $$GETRATE( )
	3840	Q:RCRATE= -1
	3841	;
	3842	; Ask the user for report typ e, with a prompt for the main report.
	3843	S RCRPT=$ $GETRPT(1)
	3844	Q:RCRPT=- 1
	3845	;
	3846	; Retriev e start da te
	3847	S RCBGDT= $$GETSDATE ()
	3848	Q:RCBGDT= -1
	3849	;
	3850	; Retriev e end date . Send use r start da te as the lower boun d.
	3851	S RCENDDT =$$GETEDAT E(RCBGDT)
	3852	Q:RCENDDT =-1
	3853	;
	3854	;If the u ser is run ning the m ain report , ask if t hey wish t o export t o Excel
	3855	S RCEXCEL =0
	3856	S:RCRPT=" M" RCEXCEL =$$DISPTY^ RCDPRU()
	3857	D:RCEXCEL INFO^RCDP RU
	3858	I 'RCEXCE L,(RCRPT=" M") W !!," This repor t requires 132 colum ns.",!!
	3859	D AUTO(1, RCBGDT,RCE NDDT,.RCPY RLST,RCRQD IV,RCRPT,R CEXCEL,RCR ATE,.RCDIV )
	3860	Q
	3861	;
	3862	AUTO(RCDIS P,RCBGDT,R CENDDT,RCP YRLST,RCRQ DIV,RCRPT, RCEXCEL,RC RATE,RCDIV ) ;
	3863	; RCDISP - Display results to screen or archive f ile flag
	3864	; RCBGDT - begin da te of the report
	3865	; RCENDDT - End dat e of the r eport
	3866	; RCPYRLS T - Payers to report on (All, range, or single pay er)
	3867	; RCRQDIV - Divisio n to repor t on - (A) ll or a si ngle divis ion
	3868	; RCRPT - (M)ain, ( S)ummary o r (G)rand Total Repo rt
	3869	; RCEXCEL - Flag to indicate output in "^" delimi ted format
	3870	; RCRATE - Billing Rate Type flag
	3871	; RCDIV - Divisions to report on.
	3872	;
	3873	;Select o utput devi ce
	3874	W !
	3875	I RCDISP S %ZIS="QM " D ^%ZIS Q:POP
	3876	;Option t o queue
	3877	I 'RCDISP ,$D(IO("Q" )) D Q
	3878	.N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK
	3879	.S ZTRTN= "REPORT^RC DPENR2"
	3880	.S ZTDESC ="EFT/ERA Trending R eport"
	3881	.S ZTSAVE ("RC*")=""
	3882	.S ZTSAVE ("^TMP(""R CDPEU1"",$ J,")=""
	3883	.D ^%ZTLO AD
	3884	.I $D(ZTS K) W !!,"T ask number "_ZTSK_" has been q ueued."
	3885	.E W !!, "Unable to queue thi s job."
	3886	.K ZTSK,I O("Q") D H OME^%ZIS
	3887	;
	3888	;Compile and Print Report
	3889	D REPORT
	3890	Q
	3891	;
	3892	REPORT ; Trace the ERA file for the gi ven date r ange
	3893	;
	3894	N RCPYRS, RCINS,RCDA TA,RCDTLDT ,RCDTLIEN, RCIEN,RCEO B,RCBILLNO ,RCBATCH,R CTYPE,RCPH ARM,RCPYRF LG,RCPYALL ,RCTINALL
	3895	;
	3896	;Note: RC PYALL an R CTINALL ar e used in tag HEADER to determ ine header output.
	3897	;
	3898	; Clear t emp arrays
	3899	K ^TMP("R CDPEADP",$ J),^TMP("R CDPENR2",$ J)
	3900	;
	3901	; Compile list of d ivisions
	3902	D DIV(.RC DIV)
	3903	;
	3904	; Compile the list of payers
	3905	; by name
	3906	D PYRARY^ RCDPENRU(R CPYRLST("S TART"),RCP YRLST("END "),1) ; us e insuranc e file pay er list
	3907	;
	3908	; and by TIN
	3909	D TINARY^ RCDPENR4(R CPYRLST("T IN","START "),RCPYRLS T("TIN","E ND")) ; us e insuranc e file pay er list
	3910	;
	3911	; Set pri ntout para meters
	3912	I $D(^TMP ("RCDPEADP ",$J,"INS" ,"A")) S R CPYALL=1
	3913	I $D(^TMP ("RCDPEADP ",$J,"TIN" ,"A")) S R CTINALL=1
	3914	;
	3915	; Now fin d only tho se payers in both li sts
	3916	S RCPYRFL G=$$INTRSC T^RCDPENR4 ()
	3917	;
	3918	; If no p ayers, qui t.
	3919	Q:'RCPYRF LG
	3920	;
	3921	; Gather raw data
	3922	D GETEFT^ RCDPENR3(R CBGDT,RCEN DDT,RCRATE )
	3923	D GETERA^ RCDPENR4(R CBGDT,RCEN DDT,RCRATE )
	3924	;
	3925	;Check fo r data cap tures
	3926	I '$D(^TM P("RCDPENR 2",$J,"MAI N")) D Q
	3927	. W !!,"T here was n o data ava ilable for the reque sted repor t. Please try again. "
	3928	;
	3929	;Generate the stati stics if a ny data ca ptured
	3930	D COMPILE ^RCDPENR3
	3931	.
	3932	.
	3933	.RoutinesA ctivitiesR outine Nam eRCDPENR3E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE EFT-ERA T RENDING RE PORTRelate d Routines Routines “ Called By” Routines “ Called” RCDPENR2 $$DIV^IBJ DF2
	3934	ASK^RCD PEADP
	3935	$$BILLI EN^RCDPENR 1
	3936	SAVEDAT A^RCDPENR1
	3937	$$GETAR PYR^RCDPEN R2
	3938	$$INSCH K^RCDPENR2
	3939	HEADER^ RCDPENR2
	3940	PRINTHD R^RCDPENR2 Current L ogic – RCD PENR3.
	3941	.
	3942	.
	3943	N RCLDATE ,RCINS,RCI EN,RCEFTDT ,RCERA,RCE FT,RCRCPT, RCPOSTED,R CPAYTYP,RC ERADT,RCTR ACE,RCERAI DX
	3944	N RCTRLN, RCTRBD,RCE RANUM,RCTI N,RCPAYER, RCINSTIN,R CLPIEN,RCD TDATA,RCEO B,RCBILL,R CDIV,RCDOS ,RCAMTBL
	3945	N RCDTBIL L,RCMETHOD ,RCPAPER,R CEFTTYP,RC EFTPD,RCTR NTYP,RCDAT A,RCAMTPD, RCEFTRCD,R CERARCD,RC RATETP
	3946	N RCMSTAT ,RCESUMDT, RCPSUMDT,Z ZPNAME
	3947	;
	3948	;Get the EFT Detail informati on for the report ba tches sent within th e given da te range.
	3949	S RCLDATE =RCSDATE-. 001
	3950	F S RCLD ATE=$O(^RC Y(344.31," ADR",RCLDA TE)) Q:RCL DATE="" Q :RCLDATE>R CEDATE D
	3951	. S RCIEN =0
	3952	. F S RC IEN=$O(^RC Y(344.31," ADR",RCLDA TE,RCIEN)) Q:'RCIEN D
	3953	. . S RCE FTDT=$G(^R CY(344.31, RCIEN,0))
	3954	. . Q:RCE FTDT=""
	3955	. . S RCE RA=$P(RCEF TDT,U,10) ; ERA IEN
	3956	. . S RCE FTRCD=$P(R CEFTDT,U,1 3)
	3957	. . S RCE FT=$P(RCEF TDT,U)
	3958	. . S ZZP NAME=$P(RC EFTDT,U,2)
	3959	. . S RCM STAT=$P(RC EFTDT,U,8)
	3960	. . S RCR CPT=$P(RCE FTDT,U,9)
	3961	. . S RCE FTPD=$P(RC EFTDT,U,7)
	3962	. . S RCP OSTED=$$GE T1^DIQ(344 .3,RCEFT_" ,",.11,"I" )
	3963	. . S RCP AYTYP=$$GE T1^DIQ(344 ,RCRCPT_", ",.04,"I")
	3964	. . I RCE RA D Q
	3965	. . . S R CERADT=$G( ^RCY(344.4 ,RCERA,0)) ; ERA Dat a extracte d
	3966	. . . Q:' RCERADT
	3967	. . . S R CTRACE=$P( RCERADT,U, 2) ; Trace #
	3968	. . . S R CTRLN=$L(R CTRACE),RC TRBD=$S(RC TRLN<11:1, 1:RCTRLN-9 )
	3969	. . . S R CTRACE=$E( RCTRACE,RC TRBD,RCTRL N) ; get t he last 10 digits of Trace #
	3970	. . . S R CERARCD=$P ($P(RCERAD T,U,7),"." ,1) ;get t he date of the ERA
	3971	. . . S R CERANUM=$P (RCERADT,U ,11)
	3972	. . . S R CTIN=$P(RC ERADT,U,3)
	3973	. . . S R CINS=$P(RC ERADT,U,6)
	3974	. . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
	3975	. . . Q:' RCPAYER ; Qui t if Payer /TIN not f ound
	3976	. . . Q:' $$INSCHK^R CDPENR2(RC PAYER) ; P ayer is no t in the i ncluded li st for the report
	3977	. . . S R CINSTIN=RC INS_"/"_RC TIN
	3978	. . . S R CLPIEN=0
	3979	. . . F S RCLPIEN= $O(^RCY(34 4.4,RCERA, 1,RCLPIEN) ) Q:'RCLPI EN D
	3980	. . . . S RCDTDATA= $G(^RCY(34 4.4,RCERA, 1,RCLPIEN, 0))
	3981	. . . . S RCEOB=$P( RCDTDATA,U ,2)
	3982	. . . . S RCBILL=$$ BILLIEN^RC DPENR1(RCE OB)
	3983	. . . . Q :RCBILL="" ; no bi lling info rmation
	3984	. . . . Q :$D(^TMP(" RCDPENR2", $J,"MAIN", RCBILL)) ; already ca ptured.
	3985	. . . . S RCDIV=$$D IV^IBJDF2( RCBILL)
	3986	. . . . S RCDIV=$$G ET1^DIQ(40 .8,RCDIV_" ,",".01"," E")
	3987	. . . . ;
	3988	. . . . ;
	3989	. . . . S RCRATETP= $$GET1^DIQ (399,RCBIL L_",",.07, "I")
	3990	. . . . Q :RCRATETP' =RCRATE
	3991	. . . . ; Quit if u ser specif ied a spec ific divis ion and bi ll is not in that Di vision
	3992	. . . . I '$D(^TMP( "RCDPENR2" ,$J,"DIVAL L"))&'$D(^ TMP("RCDPE NR2",$J,"D IV",RCDIV) ) Q
	3993	. . . . S RCDOS=$$G ET1^DIQ(39 9,RCBILL_" ,",.03,"I" )
	3994	. . . . S RCAMTBL=$ $GET1^DIQ( 361.1,RCEO B_",",2.04 ,"I")
	3995	. . . . S RCAMTPD=$ $GET1^DIQ( 361.1,RCEO B_",",1.01 ,"I")
	3996	. . . . S RCDTBILL= $$GET1^DIQ (399,RCBIL L_",",12," I")
	3997	. . . . Q :RCDTBILL= "" ;cant calculate if date f irst print ed is NULL
	3998	. . . . ;
	3999	. . . . S RCMETHOD= $S($$GET1^ DIQ(344,RC ERA_",",4. 02,"I")="" :"MANUAL", 1:"AUTOPOS T")
	4000	. . . . S RCPAPER=$ P($G(^RCY( 344.4,RCER A,20)),U,3 ) ; Paper EOB ERA?
	4001	. . . . ; ERA not a paper ERA, is the EO B a Paper EOB
	4002	. . . . S :'RCPAPER RCPAPER=$S ($$GET1^DI Q(361.1,RC EOB_",",.1 7,"I")=0:" ERA",1:"PA PER")
	4003	. . . . S RCEFTTYP= $S(RCPAYTY P=4:"PAPER ",1:"EFT")
	4004	. . . . S RCTRNTYP= RCPAPER_"/ "_RCEFTTYP
	4005	. . . . S RCERAIDX= $S(RCTRNTY P="ERA/EFT ":1,RCTRNT YP="ERA/PA PER":2,RCT RNTYP="PAP ER/EFT":3, 1:4)
	4006	. . . . Q :RCERAIDX= 4 ;Paper C heck Paper EOB not s upported
	4007	. . . . S RCDATA=RC BILL_U_RCE RA_U_RCIEN _U_RCEOB_U _RCDOS_U_R CAMTBL_U_R CAMTPD_U_R CDTBILL_U_ RCERARCD
	4008	. . . . S RCDATA=RC DATA_U_RCE FTRCD_U_RC POSTED_U_R CTRACE_U_R CMETHOD_U
	4009	. . . . S RCDATA=RC DATA_RCTRN TYP_U_RCER ANUM_U_RCD IV_U_RCINS TIN_U_RCEF TPD
	4010	. . . . S ^TMP("RCD PENR2",$J, "MAIN",RCI NSTIN,RCER AIDX,RCBIL L)=RCDATA
	4011	. . I (RC MSTAT=2),( RCIEN),('$ D(^TMP("RC DPENR2",$J ,"EFT",RCI EN))) D
	4012	. . . S R CTIN=$P(RC EFTDT,U,3)
	4013	. . . S R CINS=$P(RC EFTDT,U,2)
	4014	. . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
	4015	. . . Q:' RCPAYER ; Quit if Pa yer/TIN no t found
	4016	. . . Q:' $$INSCHK^R CDPENR2(RC PAYER) ; P ayer is no t in the i ncluded li st for the report
	4017	. . . S R CINSTIN=RC INS_"/"_RC TIN
	4018	. . . S R CESUMDT=$G (^TMP("RCD PENR2",$J, "GTOT",3))
	4019	. . . S R CPSUMDT=$G (^TMP("RCD PENR2",$J, "PAYER",RC INSTIN,3))
	4020	. . . S $ P(RCESUMDT ,U,14)=$P( RCESUMDT,U ,14)+1
	4021	. . . S $ P(RCPSUMDT ,U,14)=$P( RCPSUMDT,U ,14)+1
	4022	. . . S $ P(RCESUMDT ,U,15)=$P( RCESUMDT,U ,15)+RCEFT PD
	4023	. . . S $ P(RCPSUMDT ,U,15)=$P( RCPSUMDT,U ,15)+RCEFT PD
	4024	. . . S ^ TMP("RCDPE NR2",$J,"G TOT",3)=RC ESUMDT
	4025	. . . S ^ TMP("RCDPE NR2",$J,"P AYER",RCIN STIN,3)=RC PSUMDT
	4026	Q
	4027	.
	4028	.
	4029	.
	4030	Modified L ogic (Chan ges are in bold) – R CDPENR3.
	4031	.
	4032	.
	4033	N OKAY,RC LDATE,RCIN S,RCIEN,RC EFTDT,RCER A,RCEFT,RC RCPT,RCPOS TED,RCPAYT YP,RCERADT ,RCTRACE,R CERAIDX
	4034	N RCTRLN, RCTRBD,RCE RANUM,RCTI N,RCPAYER, RCINSTIN,R CLPIEN,RCD TDATA,RCEO B,RCBILL,R CDIV,RCDOS ,RCAMTBL
	4035	N RCDTBIL L,RCMETHOD ,RCPAPER,R CEFTTYP,RC EFTPD,RCTR NTYP,RCDAT A,RCAMTPD, RCEFTRCD,R CERARCD,RC RATETP
	4036	N RCMSTAT ,RCESUMDT, RCPSUMDT,Z ZPNAME
	4037	;
	4038	;Get the EFT Detail informati on for the report ba tches sent within th e given da te range.
	4039	S RCLDATE =RCSDATE-. 001
	4040	F S RCLD ATE=$O(^RC Y(344.31," ADR",RCLDA TE)) Q:RCL DATE="" Q :RCLDATE>R CEDATE D
	4041	. S RCIEN =0
	4042	. F S RC IEN=$O(^RC Y(344.31," ADR",RCLDA TE,RCIEN)) Q:'RCIEN D
	4043	. . S RCE FTDT=$G(^R CY(344.31, RCIEN,0))
	4044	. . Q:RCE FTDT=""
	4045	. . I RCP AY="A",RCT YPE'="A" D Q:'OKAY ; US786 I f all paye rs include d, check b y type
	4046	. . . S O KAY=$$ISTY PE^RCDPEU1 (344.31,RC IEN,RTYPE)
	4047	. . ;
	4048	. . ; Che ck Payer N ame
	4049	. . . I R CPAY'="A" D Q:'OKAY ; US7 86
	4050	. . .S OK AY=$$ISSEL ^RCDPEU1(3 44.31,RCIE N)’
	4051	. . ;
	4052	. . S RCE RA=$P(RCEF TDT,U,10) ; ERA IEN
	4053	. . S RCE FTRCD=$P(R CEFTDT,U,1 3)
	4054	. . S RCE FT=$P(RCEF TDT,U)
	4055	. . S ZZP NAME=$P(RC EFTDT,U,2)
	4056	. . S RCM STAT=$P(RC EFTDT,U,8)
	4057	. . S RCR CPT=$P(RCE FTDT,U,9)
	4058	. . S RCE FTPD=$P(RC EFTDT,U,7)
	4059	. . S RCP OSTED=$$GE T1^DIQ(344 .3,RCEFT_" ,",.11,"I" )
	4060	. . S RCP AYTYP=$$GE T1^DIQ(344 ,RCRCPT_", ",.04,"I")
	4061	. . I RCE RA D Q
	4062	. . . S R CERADT=$G( ^RCY(344.4 ,RCERA,0)) ; ERA Dat a extracte d
	4063	. . . Q:' RCERADT
	4064	. . . S R CTRACE=$P( RCERADT,U, 2) ; Trace #
	4065	. . . S R CTRLN=$L(R CTRACE),RC TRBD=$S(RC TRLN<11:1, 1:RCTRLN-9 )
	4066	. . . S R CTRACE=$E( RCTRACE,RC TRBD,RCTRL N) ; get t he last 10 digits of Trace #
	4067	. . . S R CERARCD=$P ($P(RCERAD T,U,7),"." ,1) ;get t he date of the ERA
	4068	. . . S R CERANUM=$P (RCERADT,U ,11)
	4069	. . . S R CTIN=$P(RC ERADT,U,3)
	4070	. . . S R CINS=$P(RC ERADT,U,6)
	4071	. . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
	4072	. . . Q:' RCPAYER ; Qui t if Payer /TIN not f ound
	4073	. . . Q:' $$INSCHK^R CDPENR2(RC PAYER) ; P ayer is no t in the i ncluded li st for the report
	4074	. . . S RCINSTIN=R CINS_"/"_R CTIN
	4075	. . . S R CLPIEN=0
	4076	. . . F S RCLPIEN= $O(^RCY(34 4.4,RCERA, 1,RCLPIEN) ) Q:'RCLPI EN D
	4077	. . . . S RCDTDATA= $G(^RCY(34 4.4,RCERA, 1,RCLPIEN, 0))
	4078	. . . . S RCEOB=$P( RCDTDATA,U ,2)
	4079	. . . . S RCBILL=$$ BILLIEN^RC DPENR1(RCE OB)
	4080	. . . . Q :RCBILL="" ; no bi lling info rmation
	4081	. . . . Q :$D(^TMP(" RCDPENR2", $J,"MAIN", RCBILL)) ; already ca ptured.
	4082	. . . . S RCDIV=$$D IV^IBJDF2( RCBILL)
	4083	. . . . S RCDIV=$$G ET1^DIQ(40 .8,RCDIV_" ,",".01"," E")
	4084	. . . . ;
	4085	. . . . ;
	4086	. . . . S RCRATETP= $$GET1^DIQ (399,RCBIL L_",",.07, "I")
	4087	. . . . Q :RCRATETP' =RCRATE
	4088	. . . . ; Quit if u ser specif ied a spec ific divis ion and bi ll is not in that Di vision
	4089	. . . . I '$D(^TMP( "RCDPENR2" ,$J,"DIVAL L"))&'$D(^ TMP("RCDPE NR2",$J,"D IV",RCDIV) ) Q
	4090	. . . . S RCDOS=$$G ET1^DIQ(39 9,RCBILL_" ,",.03,"I" )
	4091	. . . . S RCAMTBL=$ $GET1^DIQ( 361.1,RCEO B_",",2.04 ,"I")
	4092	. . . . S RCAMTPD=$ $GET1^DIQ( 361.1,RCEO B_",",1.01 ,"I")
	4093	. . . . S RCDTBILL= $$GET1^DIQ (399,RCBIL L_",",12," I")
	4094	. . . . Q :RCDTBILL= "" ;cant calculate if date f irst print ed is NULL
	4095	. . . . ;
	4096	. . . . S RCMETHOD= $S($$GET1^ DIQ(344,RC ERA_",",4. 02,"I")="" :"MANUAL", 1:"AUTOPOS T")
	4097	. . . . S RCPAPER=$ P($G(^RCY( 344.4,RCER A,20)),U,3 ) ; Paper EOB ERA?
	4098	. . . . ; ERA not a paper ERA, is the EO B a Paper EOB
	4099	. . . . S :'RCPAPER RCPAPER=$S ($$GET1^DI Q(361.1,RC EOB_",",.1 7,"I")=0:" ERA",1:"PA PER")
	4100	. . . . S RCEFTTYP= $S(RCPAYTY P=4:"PAPER ",1:"EFT")
	4101	. . . . S RCTRNTYP= RCPAPER_"/ "_RCEFTTYP
	4102	. . . . S RCERAIDX= $S(RCTRNTY P="ERA/EFT ":1,RCTRNT YP="ERA/PA PER":2,RCT RNTYP="PAP ER/EFT":3, 1:4)
	4103	. . . . Q :RCERAIDX= 4 ;Paper C heck Paper EOB not s upported
	4104	. . . . S RCDATA=RC BILL_U_RCE RA_U_RCIEN _U_RCEOB_U _RCDOS_U_R CAMTBL_U_R CAMTPD_U_R CDTBILL_U_ RCERARCD
	4105	. . . . S RCDATA=RC DATA_U_RCE FTRCD_U_RC POSTED_U_R CTRACE_U_R CMETHOD_U
	4106	. . . . S RCDATA=RC DATA_RCTRN TYP_U_RCER ANUM_U_RCD IV_U_RCINS TIN_U_RCEF TPD
	4107	. . . . S ^TMP("RCD PENR2",$J, "MAIN",RCI NSTIN,RCER AIDX,RCBIL L)=RCDATA
	4108	. . I (RC MSTAT=2),( RCIEN),('$ D(^TMP("RC DPENR2",$J ,"EFT",RCI EN))) D
	4109	. . . S R CTIN=$P(RC EFTDT,U,3)
	4110	. . . S R CINS=$P(RC EFTDT,U,2)
	4111	. . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
	4112	. . . Q:' RCPAYER ; Quit if Pa yer/TIN no t found
	4113	. . . Q:' $$INSCHK^R CDPENR2(RC PAYER) ; P ayer is no t in the i ncluded li st for the report
	4114	. . . S R CINSTIN=RC INS_"/"_RC TIN
	4115	. . . S R CESUMDT=$G (^TMP("RCD PENR2",$J, "GTOT",3))
	4116	. . . S R CPSUMDT=$G (^TMP("RCD PENR2",$J, "PAYER",RC INSTIN,3))
	4117	. . . S $ P(RCESUMDT ,U,14)=$P( RCESUMDT,U ,14)+1
	4118	. . . S $ P(RCPSUMDT ,U,14)=$P( RCPSUMDT,U ,14)+1
	4119	. . . S $ P(RCESUMDT ,U,15)=$P( RCESUMDT,U ,15)+RCEFT PD
	4120	. . . S $ P(RCPSUMDT ,U,15)=$P( RCPSUMDT,U ,15)+RCEFT PD
	4121	. . . S ^ TMP("RCDPE NR2",$J,"G TOT",3)=RC ESUMDT
	4122	. . . S ^ TMP("RCDPE NR2",$J,"P AYER",RCIN STIN,3)=RC PSUMDT
	4123	Q
	4124	.
	4125	.
	4126	.
	4127	RoutinesAc tivitiesRo utine Name RCDPENR4En hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE EFT-ERA TR ENDING REP ORTRelated RoutinesR outines “C alled By”R outines “C alled” R CDPENR1
	4128	RCDPENR2
	4129	RCDPENRU $$DIV^IBJ DF2
	4130	ASK^RCD PEADP
	4131	$$BILLI EN^RCDPENR 1
	4132	HEADER^ RCDPENR1
	4133	SAVEDAT A^RCDPENR1
	4134	$$GETAR PYR^RCDPEN R2
	4135	$$INSCH K^RCDPENR2 Current Lo gic – RCDP ENR4.
	4136	.
	4137	.
	4138	GETERA(RCS DATE,RCEDA TE,RCRATE) ;
	4139	;
	4140	N RCLDATE ,RCBDIV,RC IEN,RCDATA ,RCLIEN,RC DTLDT,RCEO B,RCBILL,R CTRACE
	4141	N RCEFTST ,RCDOS,RCA MTBL,RCAMT PD,RCDTBIL L,RCTIN,RC INS,RCERAR CD,RCINS
	4142	N RCPAPER ,RCMETHOD, RCEFTTYP,R CTRNTYP,RC INSTIN,RCE RAIDX,RCEF TST
	4143	N RCEFTPD ,RCDIV,RCE RANUM,RCRA TETP,RCPAY ER,RCTRLN, RCTRBD,RCP OSTED
	4144	;
	4145	S RCLDATE =RCSDATE-. 001
	4146	;
	4147	F S RCLD ATE=$O(^RC Y(344.4,"A FD",RCLDAT E)) Q:RCLD ATE>RCEDAT E Q:RCLDA TE="" D
	4148	. S RCIEN =""
	4149	. F S RC IEN=$O(^RC Y(344.4,"A FD",RCLDAT E,RCIEN)) Q:'RCIEN D Q
	4150	.. S RCDA TA=$G(^RCY (344.4,RCI EN,0))
	4151	.. Q:RCDA TA="" ;No da ta defined in the tr ansaction
	4152	.. Q:'$P( RCDATA,U,1 0) ;Transa ction is a n MRA
	4153	.. ;
	4154	.. ; Only calculate if status is NULL, Unmatched or Matched to Paper Check
	4155	.. ; GETE FT will ha ve grabbed there res t
	4156	.. S RCEF TST=$P(RCD ATA,U,9)
	4157	.. I (RCE FTST=1)!(R CEFTST>2) Q
	4158	.. ;
	4159	.. S RCER ARCD=$P($P (RCDATA,U, 7),".",1) ;get the d ate of the ERA
	4160	.. S RCTR ACE=$P(RCD ATA,U,2) ; get the tr ace number
	4161	.. S RCTR LN=$L(RCTR ACE),RCTRB D=$S(RCTRL N<11:1,1:R CTRLN-9)
	4162	.. S RCTR ACE=$E(RCT RACE,RCTRB D,RCTRLN) ; get the last 10 di gits of Tr ace #
	4163	.. S RCTI N=$P(RCDAT A,U,3) ;Pa yer TIN
	4164	.. S RCIN S=$P(RCDAT A,U,6) ;In surance fr ee text
	4165	.. S RCPA YER=$$GETA RPYR^RCDPE NR2(RCTIN, RCINS) ; f ind the AR Payer IEN PRCA4.5 321
	4166	.. Q:'RCP AYER ; Quit if Payer/TIN not found
	4167	.. Q:'$$I NSCHK^RCDP ENR2(RCPAY ER) ; Paye r is not i n the incl uded list for the re port
	4168	.. S RCER ANUM=$P(RC DATA,U,11) ;# EOBs i n ERA
	4169	.. ;
	4170	.. S RCLI EN=0
	4171	.. F S R CLIEN=$O(^ RCY(344.4, RCIEN,1,RC LIEN)) Q:R CLIEN="" D Q
	4172	... S RCD TLDT=$G(^R CY(344.4,R CIEN,1,RCL IEN,0)) ;G et the ERA Detail
	4173	... Q:RCD TLDT="" ;Quit if n o ERA Deta il
	4174	... ;
	4175	.
	4176	.
	4177	.Modified Logic (Cha nges are i n bold) – RCDPENR4GE TERA(RCSDA TE,RCEDATE ,RCRATE) ;
	4178	;
	4179	N OKAY,RC LDATE,RCBD IV,RCIEN,R CDATA,RCLI EN,RCDTLDT ,RCEOB,RCB ILL,RCTRAC E
	4180	N RCEFTST ,RCDOS,RCA MTBL,RCAMT PD,RCDTBIL L,RCTIN,RC INS,RCERAR CD,RCINS
	4181	N RCPAPER ,RCMETHOD, RCEFTTYP,R CTRNTYP,RC INSTIN,RCE RAIDX,RCEF TST
	4182	N RCEFTPD ,RCDIV,RCE RANUM,RCRA TETP,RCPAY ER,RCTRLN, RCTRBD,RCP OSTED
	4183	;
	4184	S RCLDATE =RCSDATE-. 001
	4185	;
	4186	F S RCLD ATE=$O(^RC Y(344.4,"A FD",RCLDAT E)) Q:RCLD ATE>RCEDAT E Q:RCLDA TE="" D
	4187	. S RCIEN =""
	4188	. F S RC IEN=$O(^RC Y(344.4,"A FD",RCLDAT E,RCIEN)) Q:'RCIEN D Q
	4189	.. S RCDA TA=$G(^RCY (344.4,RCI EN,0))
	4190	.. Q:RCDA TA="" ;No da ta defined in the tr ansaction
	4191	.. Q:'$P( RCDATA,U,1 0) ;Transa ction is a n MRA
	4192	.. ;
	4193	.. ; Only calculate if status is NULL, Unmatched or Matched to Paper Check
	4194	.. ; GETE FT will ha ve grabbed there res t
	4195	.. S RCEF TST=$P(RCD ATA,U,9)
	4196	.. I (RCE FTST=1)!(R CEFTST>2) Q
	4197	.. ;
	4198	.. S RCER ARCD=$P($P (RCDATA,U, 7),".",1) ;get the d ate of the ERA
	4199	.. S RCTR ACE=$P(RCD ATA,U,2) ; get the tr ace number
	4200	.. S RCTR LN=$L(RCTR ACE),RCTRB D=$S(RCTRL N<11:1,1:R CTRLN-9)
	4201	.. S RCTR ACE=$E(RCT RACE,RCTRB D,RCTRLN) ; get the last 10 di gits of Tr ace #
	4202	.. S RCTI N=$P(RCDAT A,U,3) ;Pa yer TIN
	4203	.. S RCIN S=$P(RCDAT A,U,6) ;In surance fr ee text
	4204	.. S RCPA YER=$$GETA RPYR^RCDPE NR2(RCTIN, RCINS) ; f ind the AR Payer IEN PRCA4.5 321
	4205	.. Q:'RCP AYER ; Quit if Payer/TIN not found
	4206	.. Q:'$$I NSCHK^RCDP ENR2(RCPAY ER) ; Paye r is not i n the incl uded list for the re port
	4207	.. I RCPA Y="A",RCTY PE'="A" D Q:'OKAY ; US786 If all payer s included , check by type
	4208	... S OKA Y=$$ISTYPE ^RCDPEU1(3 44.4,ERAIE N,RCTYPE)
	4209	.. ;
	4210	.. ; Chec k Payer Na me
	4211	... I RCP AY'="A" D Q:'OKAY ; US786
	4212	... S OKA Y=$$ISSEL^ RCDPEU1(34 4.4,ERAIEN )
	4213	.. S RCER ANUM=$P(RC DATA,U,11) ;# EOBs i n ERA
	4214	.. ;
	4215	.. S RCLI EN=0
	4216	.. F S R CLIEN=$O(^ RCY(344.4, RCIEN,1,RC LIEN)) Q:R CLIEN="" D Q
	4217	... S RCD TLDT=$G(^R CY(344.4,R CIEN,1,RCL IEN,0)) ;G et the ERA Detail
	4218	... Q:RCD TLDT="" ;Quit if n o ERA Deta il
	4219	... ;
	4220	.
	4221	.
	4222	.RoutinesA ctivitiesR outine Nam eRCDPESP3E nhancement Category New Modify Delete No ChangeRTM Related Op tionsRCDPE PAYER EXC LUSION NAM E TINRelat ed Routine sRoutines “Called By ”Routines “Called” None AS K^RCDPEARL
	4223	$$CNTR^ RCDPESP2 C urrent Log ic – RCDPE SP3RCDPESP 3 ;BIRM/EW L - ePayme nt Lockbox Payer Imp lementatio n Report ; Jun 11, 20 14@13:00:0 5
	4224	;;4.5;Acc ounts Rece ivable;2 98,326;N ov 11, 201 3;Build 12 1
	4225	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4226	RPT ; RUN THE D A N E S M L MENTATION REPORT
	4227	;
	4228	; DESCRIP TION: This report is a simple listing of the RCDPE PARAMETER AUDIT fil e
	4229	; includi ng data co ncerning c hanges to the RCDPE AUTO PAY E XCLUSION f ile.
	4230	;
	4231	; GLOBALS : ^RCY(344 .7, RCDPE PARAMETER AUDIT
	4232	; ^RCY(34 4.6, RCDPE AUTO PAY EXCLUSION
	4233	; ^TMP("R CDPESP2",$ J, TMP FIL E FOR LIST DIC OUTPU T
	4234	;
	4235	; INPUT P ARAMETERS: NONE
	4236	;
	4237	; LOCAL V ARIABLES:
	4238	; RCGET - HOLDS POI NTER TO TM P FILE RES ULTS FROM LIST^DIC C ALL
	4239	; RCMSG - HOLDS ERR ORS FROM L IST^DIC
	4240	; RCRUN - DATE THE REPORT RAN
	4241	; RCLINEC T- LINE CO UNTER
	4242	; RCPAGE - PAGE COU NTER
	4243	; RCSTOP - STOP DIS PLAYING TH E REPORT
	4244	; RCIEN - IEN OF CU RRENT PAYE R
	4245	; RCPAYER - PAYER N AME
	4246	; RC ID - DANES D RC TIME - TIM ESTAMP PAY ER WAS ADD ED

	4247	;
	4248	; FOR REP ORT FORMAT TING
	4249	; SPT - T OTAL LINE SPACE - DA TE & 2 SPA CES
	4250	; SPI - L INE SPACE AVAILABLE FOR DANES D SPN - LINE SPACE AVA ILABLE FOR PAYER NAME

	4251	; T1 - 1S T TAB STOP
	4252	; T2 - 2N D TAB STOP
	4253	N %ZIS,CT ,RCGET,RCI D,RCIEN,RC LINECT,RCP AGE,RCPAYE R,RCRUNDT, RCSTOP,RCT IME,SPI,SP N,SPT,T1,T 2
	4254	; FILEMAN VARIABLES
	4255	N POP,X,X 1,X2,Y,ZIS
	4256	S (RCPAGE ,RCSTOP,RC IEN,RCLINE CT)=0
	4257	;
	4258	;Select o utput devi ce
	4259	S %ZIS="M " D ^%ZIS Q:POP U I O
	4260	; SET UP PAGE FORMA TTING
	4261	I IOM<100 D
	4262	. S SPT=I OM-10 ; SP ACE AVAILA BLE FOR D A N E S D A D PAYER NA ME
	4263	. S SP I=(SPT\3)- 1 ; SPACE FOR DANES D S SP N=SPT-SPI ; SPACE FO R PAYER NA ME

	4264	I IOM'<10 0 D
	4265	. S SPT=9 0 ; SPACE AVAILABLE FOR D A N E S D A D PAYER NA ME
	4266	. S SP I=30 ; SPA CE FOR DAN ES D S SP N=60 ; SPA CE FOR PAY ER NAME

	4267	S T1=SPI+ 1,T2=SPT+2
	4268	;
	4269	; ***** ****** ****** ***
	4270	; PROCESS THE PAYER S
	4271	; ***** ****** ****** ***
	4272	D HDR S R CLINECT=6
	4273	F S RCIE N=$O(^RCY( 344.6,RCIE N)) Q:('RC IEN)!RCSTO P D
	4274	. S RCPAY ER=$$GET1^ DIQ(344.6, RCIEN_",", .01)
	4275	. S RCID= $$GET1^DIQ (344.6,RCI EN_",",.02 )
	4276	. S RCTIM E=$$FMTE^X LFDT($$GET 1^DIQ(344. 6,RCIEN_", ",.03,"I") ,"2D")
	4277	. I $L($P (RCTIME,"/ ",1))=1 S $P(RCTIME, "/",1)="0" _$P(RCTIME ,"/",1)
	4278	. I $L($P (RCTIME,"/ ",2))=1 S $P(RCTIME, "/",2)="0" _$P(RCTIME ,"/",2)
	4279	. I RCLIN ECT+1>IOSL D HDR S R CLINECT=6
	4280	. S RCLIN ECT=RCLINE CT+1
	4281	. W !,$E( RCID,1,SPI ),?T1,$E(R CPAYER,1,S PN),?T2,RC TIME
	4282	I 'RCSTOP D ASK^RCD PEARL()
	4283	Q
	4284	;
	4285	HDR ; Repo rt header
	4286	; LOCAL V ARIABLES
	4287	; LN - SE PARATION L INE
	4288	N LN
	4289	I RCPAGE D ASK^RCDP EARL(.RCST OP) Q:RCST OP
	4290	W @IOF
	4291	S RCPAGE= RCPAGE+1 I RCPAGE=1 S RCRUNDT= $$FMTE^XLF DT($$NOW^X LFDT,2)
	4292	W $$CNTR^ RCDPESP2(" D A N E S M L MENTATION REPORT"),? IOM-8,"Pag e: "_RCPAG E ; PRCA4 .5326
	4293	W !,$$CNT R^RCDPESP2 ("RUN DATE : "_RCRUND T)
	4294	W !!,"PAY ER TIN",?T 1,"PAYER N AME",?T2-2 ,"DATE ADD ED"
	4295	S $P(LN," =",SPT+11) ="" W !,LN
	4296	QModified Logic (Ch anges are in bold) – RCDPESP3R CDPESP3 ;B IRM/EWL - ePayment L ockbox Pay er Impleme ntation Re port ;Jun 11, 2014@1 3:00:05
	4297	;;4.5;Acc ounts Rece ivable;2 98,326;N ov 11, 201 3;Build 12 1
	4298	;Per VA D irective 6 402, this routine sh ould not b e modified .
	4299	RPT ; RUN THE D A N E S M L MENTATION REPORT
	4300	;
	4301	; DESCRIP TION: This report is a simple listing of the RCDPE PARAMETER AUDIT fil e
	4302	; includi ng data co ncerning c hanges to the RCDPE AUTO PAY E XCLUSION f ile.
	4303	;
	4304	; GLOBALS : ^RCY(344 .7, RCDPE PARAMETER AUDIT
	4305	; ^RCY(34 4.6, RCDPE AUTO PAY EXCLUSION
	4306	; ^TMP("R CDPESP2",$ J, TMP FIL E FOR LIST DIC OUTPU T
	4307	;
	4308	; INPUT P ARAMETERS: NONE
	4309	;
	4310	; LOCAL V ARIABLES:
	4311	; RCGET - HOLDS POI NTER TO TM P FILE RES ULTS FROM LIST^DIC C ALL
	4312	; RCMSG - HOLDS ERR ORS FROM L IST^DIC
	4313	; RCRUN - DATE THE REPORT RAN
	4314	; RCLINEC T- LINE CO UNTER
	4315	; RCPAGE - PAGE COU NTER
	4316	; RCSTOP - STOP DIS PLAYING TH E REPORT
	4317	; RCIEN - IEN OF CU RRENT PAYE R
	4318	; RCPAYER - PAYER N AME
	4319	; RC ID - DANES D RC TIME - TIM ESTAMP PAY ER WAS ADD ED

	4320	;
	4321	; FOR REP ORT FORMAT TING
	4322	; SPT - T OTAL LINE SPACE - DA TE & 2 SPA CES
	4323	; SPI - L INE SPACE AVAILABLE FOR DANES D SPN - LINE SPACE AVA ILABLE FOR PAYER NAME

	4324	; T1 - 1S T TAB STOP
	4325	; T2 - 2N D TAB STOP
	4326	N %ZIS,CT ,RCGET,RCI D,RCIEN,RC LINECT,RCP AGE,RCPAYE R,RCRUNDT, RCSTOP,RCT IME,RCTYPE ,SPI,SPN,S PT,T1,T2
	4327	; FILEMAN VARIABLES
	4328	N POP,X,X 1,X2,Y,ZIS
	4329	S (RCPAGE ,RCSTOP,RC IEN,RCLINE CT)=0
	4330	;
	4331	;Select o utput devi ce
	4332	S %ZIS="M " D ^%ZIS Q:POP U I O
	4333	; SET UP PAGE FORMA TTING
	4334	I IOM<100 D
	4335	. S SPT=I OM-10 ; SP ACE AVAILA BLE FOR D A N E S D A D PAYER NA ME
	4336	. S SP I=(SPT\3)- 1 ; SPACE FOR DANES D S SP N=SPT-SPI ; SPACE FO R PAYER NA ME

	4337	I IOM'<10 0 D
	4338	. S SPT=9 0 ; SPACE AVAILABLE FOR D A N E S D A D PAYER NA ME
	4339	. S SP I=30 ; SPA CE FOR DAN ES D S SP N=60 ; SPA CE FOR PAY ER NAME

	4340	S T1=SPI+ 1,T2=SPT+2
	4341	;
	4342	; ***** ****** ****** ***
	4343	; PROCESS THE PAYER S
	4344	; ***** ****** ****** ***
	4345	D HDR S R CLINECT=6
	4346	F S RCIE N=$O(^RCY( 344.6,RCIE N)) Q:('RC IEN)!RCSTO P D
	4347	. I '$$CH KTYPE^RCDP EU1(RCIEN, RCTYPE) Q
	4348	. S RCPAY ER=$$GET1^ DIQ(344.6, RCIEN_",", .01)
	4349	. S RCID= $$GET1^DIQ (344.6,RCI EN_",",.02 )
	4350	. S RCTIM E=$$FMTE^X LFDT($$GET 1^DIQ(344. 6,RCIEN_", ",.03,"I") ,"2D")
	4351	. I $L($P (RCTIME,"/ ",1))=1 S $P(RCTIME, "/",1)="0" _$P(RCTIME ,"/",1)
	4352	. I $L($P (RCTIME,"/ ",2))=1 S $P(RCTIME, "/",2)="0" _$P(RCTIME ,"/",2)
	4353	. I RCLIN ECT+1>IOSL D HDR S R CLINECT=6
	4354	. S RCLIN ECT=RCLINE CT+1
	4355	. W !,$E( RCID,1,SPI ),?T1,$E(R CPAYER,1,S PN),?T2,RC TIME
	4356	I 'RCSTOP D ASK^RCD PEARL()
	4357	Q
	4358	;
	4359	HDR ; Repo rt header
	4360	; LOCAL V ARIABLES
	4361	; LN - SE PARATION L INE
	4362	N LN
	4363	I RCPAGE D ASK^RCDP EARL(.RCST OP) Q:RCST OP
	4364	W @IOF
	4365	S RCPAGE= RCPAGE+1 I RCPAGE=1 S RCRUNDT= $$FMTE^XLF DT($$NOW^X LFDT,2)
	4366	W $$CNTR^ RCDPESP2(" D A N E S M L MENTATION REPORT"),? IOM-8,"Pag e: "_RCPAG E ; PRCA4 .5326
	4367	W !,$$CNT R^RCDPESP2 ("RUN DATE : "_RCRUND T)
	4368	W !!,"PAY ER TIN",?T 1,"PAYER N AME",?T2-2 ,"DATE ADD ED"
	4369	S $P(LN," =",SPT+11) ="" W !,LN
	4370	QRoutines Activities Routine Na meRCDPEU1E nhancement Category New Modify Delete No ChangeRTM Related Op tionsN/A U tility rou tine calle d from a v ariety of placesRela ted Routin esRoutines “Called B y”Routines “Called” N/A (new routine)N oneCurrent Logic – R CDPEU1N/AM odified Lo gic (Chang es are in bold) – RC DPEU1RCDPE U1 ;AITC/C JE - ELECT RONIC PAYE R UTILITIE S ;05-NOV- 02
	4371	;;4.5;Acc ounts Rece ivable;1 73;Mar 2 0, 1995
	4372	;;Per VHA Directive 10-93-142 , this rou tine shoul d not be m odified.
	4373
	4374	Q
	4375	SELPAY(PAR AM) ; EP
	4376	; New all purpose p ayer selec tion subro utine. Bas ed off fil e 344.6
	4377	; Includi ng options to includ e only giv en payer t ypes (Medi cal/Pharma cy/Tricare /All)
	4378	; and to filter sel ection to include on ly payers that have entries in file 344. 4 or 344.3 1
	4379	; This su broutine m ay be used to replac e all prev ious payer seletion prompts.
	4380	; Input - PARAM arr ay of para meters pas sed by ref erence
	4381	; PARAM(" TYPE") - T ypes of pa yers to in clude in t he selecti on (option al default s to A)
	4382	; P - Pha rmacy, T - Tricare, M - Medica l (neither P nor T), A - All
	4383	; PARAM(" FILE") - O nly includ e payers t hat have e ntries on the ERA or EFT file (optional)
	4384	; 344.4 - ERA, 344. 31 - EFT
	4385	; PARAM(" SRCH") - S earch by p ayer name or TIN (op tional def aults to N )
	4386	; N - Pay er Name, T - TIN
	4387	; PARAM(" SELC") - S eclect ind ividual pa yers, or r ange of pa yers (opti onal defau lts to S)
	4388	; S - Sel ected paye rs, R - Ra nge of pay ers
	4389	; PARAM(" DICA") - T ext that w ill be use d to promp t the user (optional )
	4390	; default s to "Sele ct payer " _$S(PARAM( "SRCH")="N ":"name",1 :"TIN")
	4391	;
	4392	; Output - ^TMP("RC DPEU1",$J, DNS EN)=""
	4393	; ^TMP("R CDPEU1",$J ,"N",NAME, DNS EN)=""
	4394	; ^TMP("R CDPEU1",$J ,"T",TIN, DNS EN)=""
	4395	; ^TMP("R CDPEU1",$J ,"F",FLAG, DNS EN)=""
	4396	; Where:
	4397	; DNS EN = Inter nal entry number of the payer from file 344.6
	4398	; NAME = Payer name , TIN = Pa yer TIN
	4399	; FLAG = Pharmacy o r Tricare or Medical flag base d on Pharm acy and Tr icare flag s from fil e 344.6
	4400	; T - has tricare f lag, P - h as pharmac y flag, M - has neit her T or P flag.
	4401	;
	4402	; Returns - 1 - Suc cess, -1 - Abort
	4403	;
	4404	N RCA,RET ,RETURN,QU IT
	4405	;
	4406	D INIT
	4407	S RETURN= 1
	4408	;
	4409	S QUIT=0
	4410	I PARAM(" SELC")="R" D ;
	4411	. S RCA=" Select STA RT range f or payer n ames: "
	4412	. S RET=$ $PROMPT(.P ARAM,RCA) I RET=-1 S RETURN=-1 Q
	4413	. S RCA=" Select END range for payer nam es: "
	4414	. S RET=$ $PROMPT(.P ARAM,RCA) I RET=-1 S RETURN=-1 Q
	4415	. D EXPAN D
	4416	;
	4417	I PARAM(" SELC")="S" D ;
	4418	. S QUIT= 0
	4419	. F D Q :QUIT ;
	4420	. . S RET =$$PROMPT( .PARAM,PAR AM("DICA") )
	4421	. . I RET =-1 S RETU RN=-1,QUIT =1 Q
	4422	. . I RET =0 S QUIT= 1
	4423	;
	4424	I RETURN= -1 D CLEAN Q -1
	4425	S RETURN= $S($D(^TMP ("RCDPEU1" ,$J)):1,1: 0)
	4426	Q RETURN
	4427	;
	4428	PROMPT(PAR AM,RCA) ; Prompt for a payer f rom file 3 44.6 with varios fil ter option s
	4429	; Input: PARAM - ar ray of par ameters de fined in s ubroutine SELPAY abo ve
	4430	; Output: ^TMP("RCD PEU1",$J) as defined in subrou tine SELPA Y above
	4431	;
	4432
	4433	N DIC,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,RETU RN,X,Y
	4434	S RETURN= 1
	4435	;
	4436	I PARAM(" SRCH")="N" D ; Sele ct payers by name
	4437	. S DIC=3 44.6
	4438	. S DIC(0 )="QEA"
	4439	. S DIC(" A")=RCA
	4440	. S DIC(" S")="I $$C HKPAY^RCDP EU1
	4441	(Y,"""_PAR AM("TYPE") _""","""_P ARAM("FILE ")_""")"
	4442	. I PARAM ("SELC")=" R",$D(^TMP ("RCDPEU1" ,$J)) D ; Choo sing secon d name of a range
	4443	. . S DIC ("S")=DIC( "S")_",$$C HKRNG^RCDP EU1(Y)" ; only offe r payer na mes that f ollow star t range
	4444	. D ^DIC
	4445	. I $D(DT OUT)!$D(DU OUT) S RET URN=-1 Q
	4446	. I Y=-1 S RETURN=0 Q
	4447	. D ADDPA Y(+Y)
	4448	;
	4449	I PARAM(" SRCH")="T" D ; Sele ct payers by TIN
	4450	. N RET
	4451	. S DIR(" A")="Selec t Insuranc e Company TIN"
	4452	. S DIR(0 )="FO^1:30 "
	4453	. S DIR(" ?")="Enter the TIN o f the paye r or '??' to list pa yers"
	4454	. S DIR(" ??")="^D T LIST^RCDPE U1"
	4455	. D ^DIR
	4456	. I $D(DT OUT)!$D(DU OUT) S RET URN=-1 Q
	4457	. I Y="" S RETURN=0 Q
	4458	. S RET=$ $SRCHTIN(Y ,.PARAM)
	4459	. I RET=- 1 S RETURN =-1 Q
	4460	. I RET'= "" D ADDTI N(RET)
	4461	Q RETURN
	4462	;
	4463	EXPAND ; E xpand rang e of payer names giv en start a nd end poi nts.
	4464	; Input: Start and end points of the ra nge in the global ^T MP("RCDPEU 1",$J) doc umented in SELPAY ab ove.
	4465	; Output: More entr ies in ^TM P("RCDPEU1 ",$J), one for each matching p ayer in th e range.
	4466	N K1,NAME ,PAYIEN
	4467	S NAME(1) =$O(^TMP(" RCDPEU1",$ J,"N",""))
	4468	S NAME(2) =$O(^TMP(" RCDPEU1",$ J,"N",NAME (1)))
	4469	;
	4470	S K1=$O(^ RCY(344.6, "B",NAME(1 )),-1)
	4471	F S K1=$ O(^RCY(344 .6,"B",K1) ) Q:K1=""! (K1]NAME(2 )) D ;
	4472	. S PAYIE N=""
	4473	. F S PA YIEN=$O(^R CY(344.6," B",K1,PAYI EN)) Q:PAY IEN="" D ;
	4474	. . I $$C HKPAY(PAYI EN,PARAM(" TYPE"),PAR AM("FILE") ) D ADDPAY (PAYIEN)
	4475	Q
	4476	;
	4477	ADDPAY(PAY IEN)
	4478	; Add paye r to the o utput arra y.
	4479	N NAME,TI N
	4480	S ^TMP("R CDPEU1",$J ,PAYIEN)=" "
	4481	S NAME=$$ GET1^DIQ(3 44.6,PAYIE N_",",.01, "E")
	4482	S TIN=$$G ET1^DIQ(34 4.6,PAYIEN _",",.02," E")
	4483	S ^TMP("R CDPEU1",$J ,"N",NAME, TIN,PAYIEN )=""
	4484	S ^TMP("R CDPEU1",$J ,"T",TIN,N AME,PAYIEN )=""
	4485	Q
	4486	;
	4487	ADDTIN(TIN )
	4488	; Add all payers wit h TIN to t he output array
	4489	N PAYIEN
	4490	S PAYIEN= ""
	4491	F S PAYI EN=$O(^RCY (344.6,"C" ,TIN,PAYIE N)) Q:'PAY IEN D ;
	4492	. D ADDPA Y(PAYIEN)
	4493	Q
	4494	;
	4495	SRCHTIN(RC X,PARAM) ; Given use r input na rrow down the TIN th at the use r wants
	4496	; Input
	4497	: RCX - Us er input t o use in T IN lookup.
	4498	N CNT,COU NT,DIR,DTO UT,DUOUT,K 1,LIST,QUI T,RETURN,S X,X,Y
	4499	I $D(^RCY (344.6,"C" ,RCX_" ")) D CHKTIN( RCX_" ",.P ARAM,.LIST )
	4500	S K1=RCX_ " "
	4501	F S K1=$ O(^RCY(344 .6,"C",K1) ) Q:K1=""! ($E(K1,1,$ L(RCX))'=R CX) D ;
	4502	. D CHKTI N(K1,.PARA M,.LIST)
	4503	;
	4504	I '$D(LIS T) D Q 0
	4505	. W !,"No matching TIN found" ,!
	4506	;
	4507	S COUNT=0 ,K1=""
	4508	F S K1=$ O(LIST("T" ,K1)) Q:K1 ="" D ;
	4509	. S COUNT =COUNT+1
	4510	. S LIST( COUNT)=K1
	4511	; Show re sults and let user p ick a TIN by sequenc e number o r TIN
	4512	S (COUNT, K1,K2,K3,R ETURN)="", (CNT,QUIT, SX)=0
	4513	F S COUN T=$O(LIST( COUNT)) Q: 'COUNT D I QUIT Q
	4514	. S CNT=C NT+1
	4515	. W !,$J( COUNT_".", 4)_" " S S PACE=0
	4516	. S K1=LI ST(COUNT)
	4517	. F S K2 =$O(LIST(" T",K1,K2)) Q:K2="" D I QUIT Q
	4518	. . I SPA CE W !," "
	4519	. . W $E( K1_$J("",3 1),1,30)
	4520	. . W $E( K2,1,42)
	4521	. . I 'SP ACE S SPAC E=1
	4522	S DIR(0)= "NO^1:"_CN T_":0"
	4523	D ^DIR
	4524	I $D(DTOU T)!$D(DUOU T) Q -1
	4525	I Y S RET URN=LIST(Y )
	4526	Q RETURN
	4527	;
	4528	CHKPAY(PAY IEN,TYPE,F ILE) ; Che ck if paye r meets th e filter r equirement s
	4529	; Input: PAYIEN - I nternal en try number of the pa yer from f ile 344.6
	4530	; TYPE - M - Medica l, P - Pha rmacy, T- Tricare, A - All
	4531	; FILE
	4532	- 344.4 - ERA, 344.3 1 EFT - Pa yer must h ave entrie s in the g iven file
	4533	;
	4534	N NAME,FL AG,RETURN, TIN
	4535	I TYPE="A ",FILE="" Q 1
	4536	;
	4537	S RETURN= 1
	4538	I TYPE'=" A" D I 'R ETURN Q 0
	4539	. S RETUR N=$$CHKTYP E(PAYIEN,T YPE)
	4540	;
	4541	I FILE D I 'RETURN Q 0
	4542	. S NAME= $$GET1^DIQ (344.6,PAY IEN_",",.0 1,"I")
	4543	. S TIN=$ $GET1^DIQ( 344.6,PAYI EN_",",.01 ,"I")
	4544	. I '$D(^ RCY(FILE," APT",NAME, TIN)) S RE TURN=0
	4545	Q 1
	4546	;
	4547	CHKRNG(PAY IEN)
	4548	; Check if second pi cked payer name foll ows the fi rst
	4549	N NAME,RE TURN
	4550	S RETURN= 0
	4551	S NAME(1) =$O(^TMP(" RCDPEU1",$ J,"N",""))
	4552	S NAME(2) =$$GET1^DI Q(344.6,PA YIEN_",",. 01,"E")
	4553	I NAME(2) ]NAME(1) S RETURN=1
	4554	Q RETURN
	4555	;
	4556	CHKTIN(TIN ,PARAM,OUT )
	4557	; Given a TIN check filter cri teria and add passin g entries to the OUT array
	4558	N PAYIEN
	4559	S PAYIEN= ""
	4560	F S PAYI EN=$O(^RCY (344.6,"C" ,TIN,PAYIE N)) Q:PAYI EN="" D ;
	4561	. I $$CHK PAY(PAYIEN ,PARAM("TY PE"),PARAM ("FILE")) D ;
	4562	. . N PNA ME
	4563	. . S PNA ME=$$GET1^ DIQ(344.6, PAYIEN_"," ,.01,"E")
	4564	. . I PNA ME="" Q
	4565	. . S OUT ("T",TIN,P NAME,PAYIE N)=""
	4566	Q
	4567	;
	4568	TLIST ; Li st TINS fo r user hel p. Only TI NS matchin g filter c riteria ar e displaye d.
	4569	N COUNT,P AYIEN,QUIT ,TIN
	4570	S (QUIT,C OUNT)=0
	4571	S TIN=""
	4572	F S TIN= $O(^RCY(34 4.6,"C",TI N)) Q:TIN= "" D I Q UIT Q
	4573	. S PAYIE N=""
	4574	. F S PA YIEN=$O(^R CY(344.6," C",TIN,PAY IEN)) Q:PA YIEN="" D I QUIT Q
	4575	. . I '$$ CHKPAY(PAY IEN,$G(PAR AM("TYPE") ,"A"),$G(P ARAM("FILE "))) Q
	4576	. . S COU NT=COUNT+1
	4577	. . I COU NT>21 S CO UNT=1 I '$ $GOON^VALM 1() S QUIT =1 Q
	4578	. . W !,$ E(TIN_$J(" ",30),1,30 )_" "_$E($ $GET1^DIQ( 344.6,PAYI EN_",",.01 ,"E"),1,39 )
	4579	Q
	4580	;
	4581	INIT ; Ini tialize pa rameters a nd return array
	4582	; Input - PARAM arr ay see com ments for SELPAY abo ve
	4583	;
	4584	S PARAM(" TYPE")=$G( PARAM("TYP E"),"A")
	4585	S PARAM(" FILE")=$G( PARAM("FIL E"))
	4586	S PARAM(" SRCH")=$G( PARAM("SRC H"),"N")
	4587	S PARAM(" SELC")=$G( PARAM("SEL C"),"S")
	4588	S PARAM(" DICA")=$G( PARAM("DIC A"),"Selec t payer "_ $S(PARAM(" SRCH")="N" :"name",1: "TIN")_": ")
	4589	;
	4590	K ^TMP("R CDPEU1",$J )
	4591	Q
	4592	;
	4593	CLEAN ; Cl ean up out put array if user ab orts
	4594	K ^TMP("R CDPEU1",$J )
	4595	Q
	4596	;
	4597	RTYPE(DEF) ;EP
	4598	; Input:
	4599	DEF - Val ue to use a default
	4600	; Returns : -1 - Use r ^ or tim ed out
	4601	; A - Use r selected ALL
	4602	; M - Use r selected MEDICAL
	4603	; P - Use r selected PHARMACY
	4604	; B - Use r selected BOTH
	4605	N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT,R CTYPE
	4606	S RCTYPE= ""
	4607	S DIR("?" )="Enter t he type of payer to include"
	4608	S DIR(0)= "SA^M:MEDI CAL;P:PHAR MACY;T:TRI CARE;A:ALL "
	4609	S DIR("A" )="(M)EDIC AL, (P)HAR MACY, (T)R ICARE or ( A)LL: "
	4610	S DIR("B" )=$S($G(DE F)'="":DEF ,1:"ALL")
	4611	D ^DIR
	4612	K DIR
	4613	I $D(DTOU T)!$D(DUOU T) Q -1
	4614	Q:Y="" "A "
	4615	Q $E(Y)
	4616	;
	4617	PAYTYPE(NA ME,TIN,TYP E) ; EP
	4618	; Is a pa yer Medica l, Pharmac y or Trica re based o n flags in the payer exclusion file.
	4619	; Inputs: NAME - Th e free tex t name of the payer
	4620	; TIN - T he ID if t he payer
	4621	; TYPE - M : Medica l, P : Pha rmacy, T: Tricare
	4622	; Returns : 1 - Yes , payer ma tches type , 0 - No, payer does not match type
	4623	N IEN,FLA G
	4624	S IEN=$$G ETPAY(NAME ,TIN)
	4625	I 'IEN Q 0
	4626	Q $$CHKTY PE(IEN,TYP E)
	4627	;
	4628	GETPAY(NAM E,TIN) ; E P - Get pa yer IEN gi ven name a nd TIN
	4629	; Inputs: NAME - Th e free tex t name of the payer
	4630	; TIN - T he ID if t he payer
	4631	; Returns : Internal entry num ber from f ile 344.6
	4632	I NAME="" !(TIN)="" Q 0
	4633	Q +$O(^RC Y(344.6,"C PID",NAME, TIN,""))
	4634	;
	4635	CHKTYPE(IE N,TYPE) ;
	4636	; Inputs: IEN - Int ernal entr y number f rom file 3 44.6
	4637	; TYPE - M : Medica l, P : Pha rmacy, T: Tricare, A : All
	4638	; Returns : 1 if the payer mat ches the t ype, other wise 0
	4639	I RTYPE=" A" Q 1
	4640	S FLAG("P ")=+$$GET1 ^DIQ(344.6 ,IEN_",",. 09,"I")
	4641	S FLAG("T ")=+$$GET1 ^DIQ(344.6 ,IEN_",",. 1,"I")
	4642	;
	4643	I TYPE="T ",FLAG("T" ) Q 1
	4644	I TYPE="P ",FLAG("P" ) Q 1
	4645	I TYPE="M ",'FLAG("P "),'FLAG(" T") Q 1
	4646	Q 0
	4647	;
	4648	ISTYPE(FIL E,IEN,TYPE ) ; EP
	4649	; Check i f payer is a given t ype based on IEN fro m a FLE
	4650	; Input: FILE - fil e from whi ch to get Payer name and TIN
	4651	; allowed values 34 4.4 - ERA, 344.31 - EFT, 361.1 - EOB
	4652	; IEN - I nternal en try number of entry in FILE
	4653	; TYPE - M : Medica l, P : Pha rmacy, T: Tricare
	4654	; Returns 1 payer m atches typ e, else 0.
	4655	I TYPE="A " Q 1
	4656	N FIELD,N AME,TIN
	4657	S FIELD(" NAME")=$S( FILE=344.4 :.06,1:.02 )
	4658	S FIELD(" TIN")=$S(F ILE=344.4: .02,1:.03)
	4659	S NAME=$$ GET1^DIQ(F ILE,IEN_", ",FIELD("N AME"),"E")
	4660	S NAME=$$ GET1^DIQ(F ILE,IEN_", ",FIELD("T IN"),"E")
	4661	Q $$PAYTY PE(NAME,TI N,TYPE)Rou tinesActiv itiesRouti ne NameRCD PEX1Enhanc ement Cate gory New M odify Dele te No Chan geRTMRelat ed Options RCDPE EXCE PTION PROC ESSINGRela ted Routin esRoutines “Called B y”Routines “Called” RCDPEWLP
	4662	RCDPEXGETP AYER^RCDPE NRUCurrent Logic – R CDPEX1RCDP EX1 ;ALB/T MK - ELECT RONIC EOB MESSAGE EX CEPTIONS P ROCESS ;Au g 14, 2014 @15:07:12
	4663	;;4.5;Acc ounts Rece ivable;1 73,262,298 ,304;Mar 20, 1995; Build 104
	4664	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4665	;
	4666	EN ; Main entry poin t
	4667	D DT^DICR W
	4668	N RCFASTX T,RCDA,RCE XCTYP,RCIN CEX,DIR,Y, X,RCPYRLST ;XQORS,VA LMEVL
	4669	; Ask for TRANSMISS ION except ions or DA TA excepti ons
	4670	S DIR("A" )="DO YOU WANT TO SE E (T)RANSM ISSION OR (D)ATA EXC EPTIONS?: ",DIR("B") ="T",DIR(0 )="SAO^T:T RANSMISSIO N;D:DATA"
	4671	S DIR("?" ,1)="TRANS MISSION EX CEPTIONS I NCLUDE ANY PROBLEM E NCOUNTERED WHEN AN E RA/EEOB",D IR("?",2)= " IS RECEI VED AT THE SITE AND BEFORE IT IS STORED PERMANENTL Y IN VISTA ."
	4672	S DIR("?" ,3)=" THIS INCLUDES PARTIAL ME SSAGE RECE IPTS, EXTR ACT PROBLE MS AND EEO Bs THAT ", DIR("?",4) =" WERE TR ANSFERRED IN FROM AN OTHER SITE ."
	4673	S DIR("?" ,5)="DATA EXCEPTIONS INCLUDE E EOB DETAIL RECORDS F OR SPECIFI C BILLS TH AT CAN'T B E"
	4674	S DIR("?" ,6)=" FULL Y PROCESSE D INTO THE VISTA SYS TEM. THIS INCLUDES E EOB DETAIL FOR",DIR( "?",7)=" C LAIMS THAT NEED TO B E TRANSFER RED TO ANO THER SITE OR WHOSE D ETAIL COUL D",DIR("?" )=" NOT BE STORED IN IB"
	4675	D ^DIR K DIR
	4676	I Y=""!(Y ="^") Q
	4677	S RCEXCTY P=Y
	4678	I RCEXCTY P="D" D ; Include e xceptions for MEDICA L, PHARMAC Y or BOTH - PRCA4.5 298 Filte r question for medic al, pharma cy or both
	4679	. S DIR(" A")="INCLU DE EXCEPTI ONS FOR (M )EDICAL, ( P)HARMACY, OR (B)OTH ?: ",DIR(" B")="B",DI R(0)="SAO^ M:MEDICAL; P:PHARMACY ;B:BOTH"
	4680	. S DIR(" ?",1)="INC LUDE EXCEP TIONS RISI NG FROM ME DICAL CLAI MS, PHARMA CY CLAIMS OR BOTH",D IR("?",2)= " MEDICAL AND PHARMA CY CLAIMS. "
	4681	. D ^DIR K DIR
	4682	. S RCINC EX=Y
	4683	. ;
	4684	. ;Get th e payer fi lter - PRC A4.5304
	4685	. D GETPA YER^RCDPEN RU(.RCPYRL ST)
	4686	;
	4687	; Exit if the user asks to ex it.
	4688	Q:$D(RCPY RLST("QUIT "))
	4689	;
	4690	I RCEXCTY P="D",(RCI NCEX=""!(R CINCEX="^" )) Q
	4691	; Transmi ssion exce ptions
	4692	.
	4693	.
	4694	.Modified Logic (Cha nges are i n bold) – RCDPEX1RCD PEX1 ;ALB/ TMK - ELEC TRONIC EOB MESSAGE E XCEPTIONS PROCESS ;A ug 14, 201 4@15:07:12
	4695	;;4.5;Acc ounts Rece ivable;1 73,262,298 ,304;Mar 20, 1995; Build 104
	4696	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4697	;
	4698	EN ; Main entry poin t
	4699	D DT^DICR W
	4700	N RCFASTX T,RCDA,RCE XCTYP,RCIN CEX,DIR,Y, X,XX,RCPAY ,RCPYRLST, RCQUIT,RCT YPE ;XQORS ,VALMEVL
	4701	; Ask for TRANSMISS ION except ions or DA TA excepti ons
	4702	S DIR("A" )="DO YOU WANT TO SE E (T)RANSM ISSION OR (D)ATA EXC EPTIONS?: ",DIR("B") ="T",DIR(0 )="SAO^T:T RANSMISSIO N;D:DATA"
	4703	S DIR("?" ,1)="TRANS MISSION EX CEPTIONS I NCLUDE ANY PROBLEM E NCOUNTERED WHEN AN E RA/EEOB",D IR("?",2)= " IS RECEI VED AT THE SITE AND BEFORE IT IS STORED PERMANENTL Y IN VISTA ."
	4704	S DIR("?" ,3)=" THIS INCLUDES PARTIAL ME SSAGE RECE IPTS, EXTR ACT PROBLE MS AND EEO Bs THAT ", DIR("?",4) =" WERE TR ANSFERRED IN FROM AN OTHER SITE ."
	4705	S DIR("?" ,5)="DATA EXCEPTIONS INCLUDE E EOB DETAIL RECORDS F OR SPECIFI C BILLS TH AT CAN'T B E"
	4706	S DIR("?" ,6)=" FULL Y PROCESSE D INTO THE VISTA SYS TEM. THIS INCLUDES E EOB DETAIL FOR",DIR( "?",7)=" C LAIMS THAT NEED TO B E TRANSFER RED TO ANO THER SITE OR WHOSE D ETAIL COUL D",DIR("?" )=" NOT BE STORED IN IB"
	4707	D ^DIR K DIR
	4708	I Y=""!(Y ="^") Q
	4709	S RCEXCTY P=Y
	4710	I RCEXCTY P="D" D ; Include e xceptions for MEDICA L, PHARMAC Y or BOTH - PRCA4.5 298 Filte r question for medic al, pharma cy or both
	4711	. S DIR(" A")="INCLU DE EXCEPTI ONS FOR (M )EDICAL, ( P)HARMACY, OR (B)OTH ?: ",DIR(" B")="B",DI R(0)="SAO^ M:MEDICAL; P:PHARMACY ;B:BOTH"
	4712	. S DIR(" ?",1)="INC LUDE EXCEP TIONS RISI NG FROM ME DICAL CLAI MS, PHARMA CY CLAIMS OR BOTH",D IR("?",2)= " MEDICAL AND PHARMA CY CLAIMS. "
	4713	. D ^DIR K DIR
	4714	. S RCINC EX=Y
	4715	. ;
	4716	. ;Get th e payer fi lter - PRC A4.5304
	4717	. D GETPA YER^RCDPEN RU(.RCPYRL ST)
	4718	. S RTYPE =$$RTYPE^R CDPEU1("A" ) ; US786 Pick MEDIC AL/PHARMAC Y/TRICARE/ ALL
	4719	. I RTYPE =-1 S RCQU IT=1 Q
	4720	. S RCPAY =$$PAYRNG^ ZZCJERCDPE U1()
	4721	. I RTYPE =-1 S RCQU IT=1 Q
	4722	. I RCPAY '="A" D ;
	4723	. . S RCP AR("TYPE") =RTYPE,RCP AR("SELC") =RCPAY
	4724	. . S RCP AR("DICA") ="Select I nsurance C ompany NAM E: "
	4725	. . S XX= $$SELPAY^R CDPEU1(.RC PAR)
	4726	. . I XX= -1 S RCQUI T=1
	4727	;
	4728	; Exit if the user asks to ex it.
	4729	I RCQUIT Q ;
	4730	I RCEXCTY P="D",(RCI NCEX=""!(R CINCEX="^" )) Q
	4731	; Transmi ssion exce ptions
	4732	.
	4733	.
	4734	.RoutinesA ctivitiesR outine Nam eRCDPEX2En hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE EXCEPTION PROCESSING Related Ro utinesRout ines “Call ed By”Rout ines “Call ed” RCDP EX3
	4735	RCDPEX31
	4736	RCDPEX32 $$RXRLDT^ PSOBPSUT
	4737	$$INSCH K^RCDPENRU
	4738	PYRARY^ RCDPENRU Current Logic – RC DPEX2.
	4739	.
	4740	.
	4741	BLD ;EP fr om RCDPEX3 ,RCDPEX31, RCDEPEX32
	4742	; Build l ist of mes sages from file 344. 4
	4743	; Input: RCDWLIEN - Optional set to a s elected ER A if the u ser opts t o see
	4744	; excepti ons after receiving an 'ACCESS DENIED' m essage
	4745	; in the ERA WORKLI ST when th ey tried t o create a scratch
	4746	; pad for the ERA ( EXCDENY^RC DPEWLP). O therwise, undefined
	4747	; RCINCEX - 'M' - O nly displa y Medical Exceptions
	4748	; 'P' - O nly displa y Pharmacy Exception s
	4749	; 'B' - D isplay bot h Medical and Pharma cy Excepti ons
	4750	; RCPYRLS T("END") - End of Pa yer Range (if a rang e was sele cted)
	4751	; "" othe rwise
	4752	; RCPYRLS T("START") - Start o f Payer Ra nge (if a range was selected)
	4753	; "" othe rwise
	4754	N DA,DR,R C0,RCBILL, RCDECME,RC DPDATA,RCP YRIEN,RCER ,RCEXC,RCM SG1,RCS,RC SEQ,RCSUB, RCX,RCX1,X ,XX,Y,YY
	4755	K ^TMP("R CDPEX_SUM- EOB",$J),^ TMP("RCDPE X_SUM-EOBD X",$J)
	4756	K ^TMP("R CDPEADP",$ J) ; Temp insurance array
	4757	S (RCSEQ, VALMCNT)=0
	4758	;
	4759	; Get lis t of payer s if list isn't alre ady built - PRCA4.5 304
	4760	D PYRARY^ RCDPENRU(R CPYRLST("S TART"),RCP YRLST("END "),1)
	4761	;
	4762	; Extract from 344. 4
	4763	S RCER=0
	4764	F D Q:' RCER
	4765	. S RCER= $O(^RCY(34 4.4,"AEXC" ,RCER))
	4766	. Q:'RCER
	4767	. S RCMSG =0
	4768	. F D Q :'RCMSG
	4769	. . S RCM SG=$O(^RCY (344.4,"AE XC",RCER,R CMSG))
	4770	. . Q:'RC MSG
	4771	. . S RCS UB=RCMSG_" ,",DR=".02 :.06",DA=R CMSG K DA( 1)
	4772	. . D DIQ 3444(DA,DR ,.RCDPDATA ) ; Extrac t Trace #, Payer Nam e/TIN, ERA Date
	4773	. . ;
	4774	. . ; HIP PA 5010 - display of the Trace # on a se parate lin e due to t he increas ed
	4775	. . ; len gth from 3 0 to 50 ch aracters
	4776	. . S RCX ("TRACE")= $G(RCDPDAT A(344.4,RC SUB,.02,"E "))
	4777	. . S RCX ("INCOID") =$G(RCDPDA TA(344.4,R CSUB,.03," E"))
	4778	. . S RCX ("PAYFROM" )=$G(RCDPD ATA(344.4, RCSUB,.06, "E"))
	4779	. . ;
	4780	. . ; Qui t if the e xception i s not for a specifie d ERA (whe n called f rom the ER A worklist )
	4781	. . I $G( RCDWLIEN)' ="",(RCDWL IEN'=+RCSU B) Q
	4782	. . ; Sta rt changes for PRCA* 4.5*326
	4783	. . S XX= RCX("PAYFR OM"),YY=RC X("INCOID" )
	4784	. . S RCP YRIEN=$O(^ RCY(344.6, "CPID",XX, YY,"")) ; Payer IEN for the pa yer lookup /filter
	4785	. . S XX= $$GET1^DIQ (344.6,RCP YRIEN,.09, "I") ; Pha rmacy Paye r Flag
	4786	. . I RCI NCEX="P",X X'=1 Q ; Not a phar macy excep tion
	4787	. . I RCI NCEX="M",X X=1 Q ; Not a medi cal except ion
	4788	. . ; End changes f or PRCA4. 5326
	4789	. . ;
	4790	.
	4791	.
	4792	.Modified Logic (Cha nges are i n bold) – RCDPEX2.
	4793	.
	4794	.
	4795	BLD ;EP fr om RCDPEX3 ,RCDPEX31, RCDEPEX32
	4796	; Build l ist of mes sages from file 344. 4
	4797	; Input: RCDWLIEN - Optional set to a s elected ER A if the u ser opts t o see
	4798	; excepti ons after receiving an 'ACCESS DENIED' m essage
	4799	; in the ERA WORKLI ST when th ey tried t o create a scratch
	4800	; pad for the ERA ( EXCDENY^RC DPEWLP). O therwise, undefined
	4801	; RCINCEX - 'M' - O nly displa y Medical Exceptions
	4802	; 'P' - O nly displa y Pharmacy Exception s
	4803	; 'B' - D isplay bot h Medical and Pharma cy Excepti ons
	4804	; RCPYRLS T("END") - End of Pa yer Range (if a rang e was sele cted)
	4805	; "" othe rwise
	4806	; RCPYRLS T("START") - Start o f Payer Ra nge (if a range was selected)
	4807	; "" othe rwise
	4808	N DA,DR,R C0,RCBILL, RCDECME,RC DPDATA,RCP YRIEN,RCER ,RCEXC,RCM SG1,RCS,RC SEQ,RCSUB, RCX,RCX1,X ,XX,Y,YY
	4809	K ^TMP("R CDPEX_SUM- EOB",$J),^ TMP("RCDPE X_SUM-EOBD X",$J)
	4810	K ^TMP("R CDPEADP",$ J) ; Temp insurance array
	4811	S (RCSEQ, VALMCNT)=0
	4812	;
	4813	; Get lis t of payer s if list isn't alre ady built - PRCA4.5 304
	4814	D PYRARY^ RCDPENRU(R CPYRLST("S TART"),RCP YRLST("END "),1)
	4815	;
	4816	; Extract from 344. 4
	4817	S RCER=0
	4818	F D Q:' RCER
	4819	. S RCER= $O(^RCY(34 4.4,"AEXC" ,RCER))
	4820	. Q:'RCER
	4821	. S RCMSG =0
	4822	. F D Q :'RCMSG
	4823	. . S RCM SG=$O(^RCY (344.4,"AE XC",RCER,R CMSG))
	4824	. . Q:'RC MSG
	4825	. . S RCS UB=RCMSG_" ,",DR=".02 :.06",DA=R CMSG K DA( 1)
	4826	. . ;
	4827	. . I RC PAY'="A" D Q:'XX
	4828	. . . S X X=$$ISSEL^ RCDPEU1(34 4.44,DA) ; US786 Che ck if paye r was sele cted
	4829	. . E I RCTYPE'="A " D Q:'XX ; If a ll of a gi ve type of payer sel ected
	4830	. . . S X X=$$ISTYPE ^RCDPEU1(3 44.44,DA,R CTYPE) ; c heck that payer matc hes type
	4831	. . ;
	4832	. . D DIQ 3444(DA,DR ,.RCDPDATA ) ; Extrac t Trace #, Payer Nam e/TIN, ERA Date
	4833	. . ;
	4834	. . ; HIP PA 5010 - display of the Trace # on a se parate lin e due to t he increas ed
	4835	. . ; len gth from 3 0 to 50 ch aracters
	4836	. . S RCX ("TRACE")= $G(RCDPDAT A(344.4,RC SUB,.02,"E "))
	4837	. . S RCX ("INCOID") =$G(RCDPDA TA(344.4,R CSUB,.03," E"))
	4838	. . S RCX ("PAYFROM" )=$G(RCDPD ATA(344.4, RCSUB,.06, "E"))
	4839	. . ;
	4840	. . ; Qui t if the e xception i s not for a specifie d ERA (whe n called f rom the ER A worklist )
	4841	. . I $G( RCDWLIEN)' ="",(RCDWL IEN'=+RCSU B) Q
	4842	. . ; Sta rt changes for PRCA* 4.5*326
	4843	. . S XX= RCX("PAYFR OM"),YY=RC X("INCOID" )
	4844	. . S RCP YRIEN=$O(^ RCY(344.6, "CPID",XX, YY,"")) ; Payer IEN for the pa yer lookup /filter
	4845	. . S XX= $$GET1^DIQ (344.6,RCP YRIEN,.09, "I") ; Pha rmacy Paye r Flag
	4846	. . I RCI NCEX="P",X X'=1 Q ; Not a phar macy excep tion
	4847	. . I RCI NCEX="M",X X=1 Q ; Not a medi cal except ion
	4848	. . ; End changes f or PRCA4. 5326
	4849	. . ;
	4850	.
	4851	.
	4852	.RoutinesA ctivitiesR outine Nam eRCDPPLBEn hancement Category N ew Modify Delete No ChangeRTMR elated Opt ionsRCDPE PROVIDER L VL ADJ REP ORTRelated RoutinesR outines “C alled By”R outines “C alled” N one ERAS TA^RCDPEM4
	4853	$$CHECK DT^RCDPRU
	4854	$$DATE^ RCDPRU
	4855	$$GETPA Y^RCDPRU
	4856	$$GETTI N^RCDPRU
	4857	$$NOW^R CDPRU
	4858	$$UP^RC DPRU
	4859	$$VAL^R CDPRU
	4860	ASK^RCD PRU
	4861	RNG^RCD PRU
	4862	SUMIT^R CDPRU
	4863	$$PAYTI N^RCDPRU2 Current Logic - R CDPPLBRCDP PLB ;ALB/T JB - ERA/P ROVIDER LE VEL ADJUST MENTS REPO RT ;1/02/1 5 10:00am
	4864	;;4.5;Acc ounts Rece ivable;3 03,321;M ar 20, 199 5;Build 84
	4865	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4866	Q
	4867	; PRCA4. 5303 - ER A/PROVIDER LEVEL ADJ USTMENTS R EPORT
	4868	;
	4869	; DESCRIP TION : The following generates a report to display ERA data with PLB
	4870	; data de tails. The report is ad-hoc an d allow th e user to extract re port
	4871	; data, a s well as view and m anage refu nd request s for all PLB adjust ment
	4872	; codes ( FB, WO, 72 , IR, J1, L6, CS, WU , etc.):
	4873	;
	4874	EN ; Entry point for Report
	4875	N %ZIS,CD ,CRHDR,CZ, DIVHDR,DUO UT,DTOUT,D IR,DTOK,DL ,DX0,EXLN, FILE,I,IEN ,IDX,IX,JJ ,KK,PCT,PO P,PY,R,RCC D,RCODE
	4876	N RCDET,R CDISP,RCDO NE,RCDT1,R CDT2,RCDET ,RCDONE,RC EXCEL,RCHR ,RCJOB,RCP G,RCTLIST, RCRD,RCNOW ,RCLPAY,RC PAY
	4877	N RCQUIT, RCSORT,RCS TAT,RCTIN, TY,X,XCNT, Y,Z,ZN,ZPP Y,ZPY,ZTDE SC,ZTRTN,Z TSAVE,ZTSK ,ZTSTOP,ZZ ,ZZPNAME
	4878	S RCQUIT= 0,RCODE="" ; Global variable t o signal e xit
	4879	;
	4880	; ICR 107 7 - Get di vision/sta tion
	4881	D DIVISIO N^VAUTOMA
	4882	I 'VAUTD& ($D(VAUTD) '=11) G PL BQ
	4883	S DIR("A" )="(S)umma ry or(D)et ail Report format? " ,DIR(0)="S A^S:Summar y Informat ion only;D :Detail an d Totals"
	4884	S DIR("B" )="SUMMARY " D ^DIR K DIR
	4885	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	4886	S RCDET=( Y="D")
	4887	;
	4888	; Get PLB Codes for report
	4889	D PLBC(.R CODE) G:$G (RCODE)']" " PLBQ
	4890	; Payer N ames from 344.6
	4891	S RCDONE= $$GETPAY^R CDPRU(.RCP AY) G:RCDO NE=0 PLBQ
	4892	S:$G(RCPA Y("DATA")) '="" RCPAY =$G(RCPAY( "DATA"))
	4893	;
	4894	S RCDONE= $$GETTIN^R CDPRU(.RCT IN) G:RCDO NE=0 PLBQ
	4895	S:$G(RCTI N("DATA")) '="" RCTIN =$G(RCTIN( "DATA"))
	4896	;
	4897	S DIR("A" )="Sort Re port (C)od es or (P)a yer?: ",DI R(0)="SA^C :PLB Codes ;P:Payer N ame;CODES: PLB Codes"
	4898	S DIR("B" )="CODES" D ^DIR K D IR
	4899	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	4900	S RCSORT= $E(Y,1)
	4901	;
	4902	S DIR("?" )="Enter t he Beginni ng date fo r the repo rt"
	4903	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date: ",DIR("B") ="T" D ^DI R K DIR
	4904	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	4905	S RCDT1=Y
	4906	S DIR("?" )="Enter t he end dat e for the report"
	4907	S DIR("B" )="T"
	4908	S DIR(0)= "DAO^"_RCD T1_":"_DT_ ":APE",DIR ("A")="End Date: " D ^DIR K DI R
	4909	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	4910	S RCDT2=Y
	4911	S DTOK=$$ CHECKDT^RC DPRU(RCDT1 ,RCDT2,344 .4)
	4912	I 'DTOK W !!,"* N ote: Date Range "_$$ DATE^RCDPR U(RCDT1)_" - "_$$DAT E^RCDPRU(R CDT2)," ",! W "* * No Recor ds found * **",! D AS K^RCDPRU(. RCQUIT) G PLBQ
	4913	; Removed Excel per Susan on 03/24/2015 meeting
	4914	; Get inp ut to expo rt to exce l.
	4915	S RCEXCEL =""
	4916	;S RCEXCE L=$$DISPTY ^RCDPRU()
	4917	;D:RCEXCE L INFO^RCD PRU
	4918	;
	4919	;S RCEXC EL=$$DISPT Y^RCDPRU()
	4920	;D:RCEXCE L INFO^RCD PRU
	4921	;
	4922	S %ZIS="Q M" D ^%ZIS Q:POP
	4923	I $D(IO(" Q")) D Q
	4924	. S ZTRTN ="ENQ^RCDP ARC",ZTDES C="AR - 83 5 Provider Adjustmen t & Payer Data Repor t",ZTSAVE( "*")=""
	4925	. D ^%ZTL OAD
	4926	. W !!,$S ($D(ZTSK): "Your task number"_Z TSK_" has been queue d.",1:"Una ble to que ue this jo b.")
	4927	. K ZTSK, IO("Q") D HOME^%ZIS
	4928	U IO
	4929	;
	4930	ENQ ; Star t here for queued re port
	4931	S RCNOW=$ $NOW^RCDPR U(),RCPG=0 ,$P(RCHR," =",IOM)=""
	4932	;
	4933	K ^TMP("R CDPPLB_REP ORT",$J)
	4934	; Collect the data and put it into the ^TMP globa l
	4935	D GETDATA ($G(RCODE) ,.RCPAY,.R CTIN,$G(RC SORT),RCDT 1,RCDT2,$N A(^TMP("RC DPPLB_REPO RT",$J)),. VAUTD)
	4936	;
	4937	.
	4938	.
	4939	.
	4940	; Get dat a for repo rt and app ly filters if necess ary
	4941	GETDATA(GP LB,GPAYER, GTIN,GSORT ,GSTART,GS TOP,GARRAY ,GDIV) ;
	4942	N SDT,IEN ,CD,CNT,IX ,ZX,XY,RM, PARR,PNARR ,PTARR,RCS ET,GLINE,Z N,ZED,ZEN, ZPAY,ZTIN, ZDESC,ZZ,R CERR,RCGX, RCEB,EOBTO T,STA,STNU M,STNAM,ZL VL
	4943	S SDT=$O( ^RCY(344.4 ,"AC",GSTA RT),-1)
	4944	S ZLVL=$S (GSORT="C" :"ERA",1:" PAYR")
	4945	; Set up arrays for filtering on PLB, P AYER name and Payer TINs
	4946	D RNG^RCD PRU("PLB", .GPLB,.PAR R),RNG^RCD PRU("PAYER ",GPAYER,. PARR),RNG^ RCDPRU("TI N",GTIN,.P ARR)
	4947	;Get poss ible ERAs to work on from ^RCY (344.4,"AC ") index
	4948	F S SDT= $O(^RCY(34 4.4,"AC",S DT)) Q:SDT =""!(SDT>G STOP) D
	4949	. S IEN=" " F S IEN =$O(^RCY(3 44.4,"AC", SDT,IEN)) Q:IEN="" S ZN=^RCY( 344.4,IEN, 0) D
	4950	.. I GDIV =0 D ERAST A^RCDPEM4( IEN,.STA,. STNUM,.STN AM) Q:'$D( GDIV(STA)) ; If not the right Division/s tation the n get next ERA
	4951	.. K RCGX D GETS^DI Q(344.4,IE N_",","2*; ","E","RCG X") Q:$D(R CGX)=0 ; Q uit if no PLBs on th is ERA
	4952	.. S ZTIN =$$GET1^DI Q(344.4,IE N_",",.03, "E"),ZPAY= $$GET1^DIQ (344.4,IEN _",",.06," E")
	4953	.. Q:'$$C HECK("TIN" ,ZTIN,.PAR R) Q:'$$CH ECK("PAYER ",ZPAY,.PA RR) ; Quit if not in cluding th is tin or payer
	4954	.. ; Bill ed amount on the EOB s, Get EOB Details
	4955	.. K RCEB D GETS^DI Q(344.4,IE N_",","1*; ","I","RCE B")
	4956	.. ; Walk EOB Detai ls and get the total amount bi lled
	4957	.. S EOBT OT=0
	4958	.
	4959	.
	4960	.
	4961	.Modified Logic (Cha nges are i n bold) - RCDPPLBRCD PPLB ;ALB/ TJB - ERA/ PROVIDER L EVEL ADJUS TMENTS REP ORT ;1/02/ 15 10:00am
	4962	;;4.5;Acc ounts Rece ivable;3 03,321;M ar 20, 199 5;Build 84
	4963	;;Per VA Directive 6402, this routine s hould not be modifie d.
	4964	Q
	4965	; PRCA4. 5303 - ER A/PROVIDER LEVEL ADJ USTMENTS R EPORT
	4966	;
	4967	; DESCRIP TION : The following generates a report to display ERA data with PLB
	4968	; data de tails. The report is ad-hoc an d allow th e user to extract re port
	4969	; data, a s well as view and m anage refu nd request s for all PLB adjust ment
	4970	; codes ( FB, WO, 72 , IR, J1, L6, CS, WU , etc.):
	4971	;
	4972	EN ; Entry point for Report
	4973	N %ZIS,CD ,CRHDR,CZ, DIVHDR,DUO UT,DTOUT,D IR,DTOK,DL ,DX0,EXLN, FILE,I,IEN ,IDX,IX,JJ ,KK,PCT,PO P,PY,R,RCC D,RCODE
	4974	N RCDET,R CDISP,RCDO NE,RCDT1,R CDT2,RCDET ,RCDONE,RC EXCEL,RCHR ,RCJOB,RCP G,RCTLIST, RCRD,RCNOW ,RCLPAY,RC PAY,RCPAYS
	4975	N RCQUIT, RCSORT,RCS TAT,RCTIN, RCTYPE,RCW HICH
	4976	N TY,X,XX ,XCNT,Y,Z, ZN,ZPPY,ZP Y,ZTDESC,Z TRTN,ZTSAV E,ZTSK,ZTS TOP,ZZ,ZZP NAME
	4977	S RCQUIT= 0,RCODE="" ; Global variable t o signal e xit
	4978	;
	4979	; ICR 107 7 - Get di vision/sta tion
	4980	D DIVISIO N^VAUTOMA
	4981	I 'VAUTD& ($D(VAUTD) '=11) G PL BQ
	4982	S DIR("A" )="(S)umma ry or(D)et ail Report format? " ,DIR(0)="S A^S:Summar y Informat ion only;D :Detail an d Totals"
	4983	S DIR("B" )="SUMMARY " D ^DIR K DIR
	4984	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	4985	S RCDET=( Y="D")
	4986	;
	4987	; Get PLB Codes for report
	4988	D PLBC(.R CODE) G:$G (RCODE)']" " PLBQ
	4989	; Payer N ames from 344.6
	4990	S RCDONE= $$GETPAY^R CDPRU(.RCP AY) G:RCDO NE=0 PLBQ
	4991	S:$G(RCPA Y("DATA")) '="" RCPAY =$G(RCPAY( "DATA"))
	4992	;
	4993	S RCDONE= $$GETTIN^R CDPRU(.RCT IN) G:RCDO NE=0 PLBQ
	4994	S:$G(RCTI N("DATA")) '="" RCTIN =$G(RCTIN( "DATA"))
	4995	;
	4996	S RCTYPE= $$RTYPE^RC DPEU1() G: RCTYPE=-1 PLBQ ; US786 - A dd Tricare filter to Med/Pharm /Both
	4997	S RCWHICH =$$NMORTIN ^RCDPEAPP( ) Q:RCWHIC H=-1 ; US7 86 - Filte r by Payer Name or T IN
	4998	;
	4999	S RCPAR(" SELC")=$$P AYRNG^RCDP EU1() ; US 786 - Sele cted or Ra nge of Pay ers
	5000	G:RCPAR(" SELC")=-1 PLBQ ; US78 6 '^' or t imeout
	5001	S RCPAYS= RCPAR("SEL C")
	5002	;
	5003	I RCPAR(" SELC")'="A " D G:XX= -1 PLBQ ; US78 6 - Since we don't w ant all pa yers
	5004	. S RCPAR ("TYPE")=R CTYPE ; prom pt for pay ers we do want
	5005	. S RCPAR ("SRCH")=$ S(RCWHICH= 2:"T",1:"N ")
	5006	. S RCPAR ("FILE")=3 44.4
	5007	. S RCPAR ("DICA")=" Select Ins urance Com pany"_$S(R CWHICH=1:" NAME: ",1 :" TIN: ")
	5008	. S XX=$$ SELPAY^RCD PEU1(.RCPA R)
	5009	;
	5010	S DIR("A" )="Sort Re port (C)od es or (P)a yer?: ",DI R(0)="SA^C :PLB Codes ;P:Payer N ame;CODES: PLB Codes"
	5011	S DIR("B" )="CODES" D ^DIR K D IR
	5012	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	5013	S RCSORT= $E(Y,1)
	5014	;
	5015	S DIR("?" )="Enter t he Beginni ng date fo r the repo rt"
	5016	S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date: ",DIR("B") ="T" D ^DI R K DIR
	5017	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	5018	S RCDT1=Y
	5019	S DIR("?" )="Enter t he end dat e for the report"
	5020	S DIR("B" )="T"
	5021	S DIR(0)= "DAO^"_RCD T1_":"_DT_ ":APE",DIR ("A")="End Date: " D ^DIR K DI R
	5022	I $D(DTOU T)!$D(DUOU T)!(Y="") G PLBQ
	5023	S RCDT2=Y
	5024	S DTOK=$$ CHECKDT^RC DPRU(RCDT1 ,RCDT2,344 .4)
	5025	I 'DTOK W !!,"* N ote: Date Range "_$$ DATE^RCDPR U(RCDT1)_" - "_$$DAT E^RCDPRU(R CDT2)," ",! W "* * No Recor ds found * **",! D AS K^RCDPRU(. RCQUIT) G PLBQ
	5026	; Removed Excel per Susan on 03/24/2015 meeting
	5027	; Get inp ut to expo rt to exce l.
	5028	S RCEXCEL =""
	5029	;S RCEXCE L=$$DISPTY ^RCDPRU()
	5030	;D:RCEXCE L INFO^RCD PRU
	5031	;
	5032	;S RCEXCE L=$$DISPTY ^RCDPRU()
	5033	;D:RCEXCE L INFO^RCD PRU
	5034	;
	5035	S %ZIS="Q M" D ^%ZIS Q:POP
	5036	I $D(IO(" Q")) D Q
	5037	. S ZTRTN ="ENQ^RCDP PLB",ZTDES C="AR - 83 5 Provider Adjustmen t & Payer Data Repor t"
	5038	. S ZTSAV E("*")=""
	5039	. S ZTSAV E("^TMP("" RCDPEU1"", $J,")=""
	5040	. D ^%ZTL OAD
	5041	. W !!,$S ($D(ZTSK): "Your task number"_Z TSK_" has been queue d.",1:"Una ble to que ue this jo b.")
	5042	. K ZTSK, IO("Q") D HOME^%ZIS
	5043	U IO
	5044	;
	5045	ENQ ; Star t here for queued re port
	5046	S RCNOW=$ $NOW^RCDPR U(),RCPG=0 ,$P(RCHR," =",IOM)=""
	5047	;
	5048	K ^TMP("R CDPPLB_REP ORT",$J)
	5049	; Collect the data and put it into the ^TMP globa l
	5050	D GETDATA ($G(RCODE) ,.RCPAY,.R CTIN,RCPAY S,RCTYPE,$ G(RCSORT), RCDT1,RCDT 2,$NA(^TMP ("RCDPPLB_ REPORT",$J )),.VAUTD)
	5051	;
	5052	.
	5053	.
	5054	.
	5055	; Get dat a for repo rt and app ly filters if necess ary
	5056	GETDATA(GP LB,GPAYER, GTIN,RCPAY S,RCTYPE,G SORT,GSTAR T,GSTOP,GA RRAY,GDIV) ;
	5057	N SDT,IEN ,CD,CNT,IX ,ZX,XY,RM, PARR,PNARR ,PTARR,RCS ET,GLINE,Z N,ZED,ZEN, ZPAY,ZTIN, ZDESC,ZZ,R CERR,RCGX, RCEB,EOBTO T,STA,STNU M,STNAM,ZL VL
	5058	S SDT=$O( ^RCY(344.4 ,"AC",GSTA RT),-1)
	5059	S ZLVL=$S (GSORT="C" :"ERA",1:" PAYR")
	5060	; Set up arrays for filtering on PLB, P AYER name and Payer TINs
	5061	D RNG^RCD PRU("PLB", .GPLB,.PAR R),RNG^RCD PRU("PAYER ",GPAYER,. PARR),RNG^ RCDPRU("TI N",GTIN,.P ARR)
	5062	;Get poss ible ERAs to work on from ^RCY (344.4,"AC ") index
	5063	F S SDT= $O(^RCY(34 4.4,"AC",S DT)) Q:SDT =""!(SDT>G STOP) D
	5064	. S IEN=" " F S IEN =$O(^RCY(3 44.4,"AC", SDT,IEN)) Q:IEN="" S ZN=^RCY( 344.4,IEN, 0) D
	5065	.. I GDIV =0 D ERAST A^RCDPEM4( IEN,.STA,. STNUM,.STN AM) Q:'$D( GDIV(STA)) ; If not the right Division/s tation the n get next ERA
	5066	.. K RCGX D GETS^DI Q(344.4,IE N_",","2*; ","E","RCG X") Q:$D(R CGX)=0 ; Q uit if no PLBs on th is ERA
	5067	.. S ZTIN =$$GET1^DI Q(344.4,IE N_",",.03, "E"),ZPAY= $$GET1^DIQ (344.4,IEN _",",.06," E")
	5068	.. Q:'$$C HECK("TIN" ,ZTIN,.PAR R) Q:'$$CH ECK("PAYER ",ZPAY,.PA RR) ; Quit if not in cluding th is tin or payer
	5069	.. ;
	5070	.. I RCPA Ys="A",RCT YPE'="A" D Q:'ZZ ; US786 If all payers included, check by type
	5071	... S ZZ= $$ISTYPE^R CDPEU1(344 .4,ERAIEN, RCTYPE)
	5072	.. ; Chec k Payer Na me
	5073	.. I RCPA Y'="A" D Q:'ZZ ; US786
	5074	... S ZZ= $$ISSEL^RC DPEU1(344. 4,ERAIEN)
	5075	.. ;
	5076	.. ; Bill ed amount on the EOB s, Get EOB Details
	5077	.. K RCEB D GETS^DI Q(344.4,IE N_",","1*; ","I","RCE B")
	5078	.. ; Walk EOB Detai ls and get the total amount bi lled
	5079	.. S EOBT OT=0
	5080	.
	5081	.
	5082	.�Wrong di rective
	5083	�Add retur n value
	5084	�Shouldn’t this be $ $CHKPAY an d all othe r referenc es to RCDP EU1 inside this rout ine
	5085	�Add input comment
	5086	�Add input comment
	5087	�Add PARAM input com ment, Retu rns commen t
	5088	�Add Reurn s comment
	5089	�Add PAYIE N input co mment, Ret urns comme nt
	5090	�Add input comments
	5091	�Add retur ns value
	5092