RCDPENR2 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report ; 7/1/19 2:02pm
;;4.5;Accounts Receivable;**304,321,326,349,432,446**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
;Read ^DGCR(399) via Private IA 3820
;Read ^DG(40.8) via Controlled IA 417
;Read ^IBM(361.1) via Private IA 4051
;Use DIV^IBJDF2 via Private IA 3130
;Use DIVISION^VAUTOMA via Controlled IA 664
;
Q
;
EFTERA() ; EFT/ERA TRENDING REPORT
;
N DIRUT,DIROUT,DTOUT,DUOUT,X,XX,Y,POP
N RCBGDT,RCAUTO,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
N RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCPUZ,RCTIN,RCTINR
N RCRATE,RCTYPE,RCWHICH
;
; Alert software to display to screen
S RCDISP=1
;
; Ask for Division
S RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
Q:RCRQDIV=-1
;
S RCAUTO=$$ASKAUTO^RCDPEU1() Q:RCAUTO=-1 ; PRCA*4.5*349
;
S RCPUZ=$$ASKPUZ^RCDPENR4() Q:RCPUZ=-1 ; PRCA*4.5*446 Payment, Unmatched, Zero, All
;
S RCTYPE=$$RTYPE^RCDPEU1() Q:RCTYPE=-1
S RCWHICH=$$NMORTIN^RCDPEAPP() Q:RCWHICH=-1
;
S RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
Q:RCPAR("SELC")=-1
S RCPAY=RCPAR("SELC")
;
I RCPAR("SELC")'="A" D Q:XX=-1
. S RCPAR("TYPE")=RCTYPE
. S RCPAR("SRCH")=$S(RCWHICH=2:"T",1:"N")
. S RCPAR("FILE")=344.4
. S RCPAR("DICA")="Select Insurance Company"_$S(RCWHICH=1:" NAME: ",1:" TIN: ")
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
;
; Ask the user for rate type
S RCRATE=$$GETRATE^RCDPENR4() ;PRCA*4.5*446 moved subroutine to RCDPENR4
Q:RCRATE=-1
;
; PRCA*4.5*349 - Add Closed Claims filter
S RCCLM=$$CLOSEDC^RCDPEU1()
Q:RCCLM=-1
;
; Ask the user for report type, with a prompt for the main report.
S RCRPT=$$GETRPT(1)
Q:RCRPT=-1
;
; Ask the user for sort type if Main report is selected. Options: by Payer, by Amount of Payment
; PRCA*4.5*446
S RCSORT="P"
S:RCRPT="M" RCSORT=$$ASKSORT^RCDPENR5()
Q:$G(RCSORT)=-1
;
; Retrieve start date
S RCBGDT=$$GETSDATE^RCDPENR4() ;PRCA*4.5*446 moved subroutine to RCDPENR4
Q:RCBGDT=-1
;
; Retrieve end date. Send user start date as the lower bound.
S RCENDDT=$$GETEDATE^RCDPENR4(RCBGDT) ;PRCA*4.5*446 moved subroutine to RCDPENR4
Q:RCENDDT=-1
;
;If the user is running the main report, ask if they wish to export to Excel
S RCEXCEL=0
S:RCRPT="M" RCEXCEL=$$DISPTY^RCDPRU()
D:RCEXCEL INFO^RCDPRU
I 'RCEXCEL,(RCRPT="M") W !!,"This report requires 132 columns.",!!
D AUTO(1,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,.RCDIV,RCAUTO,RCPUZ)
Q
;
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO,RCPUZ) ;
; Inputs: RCAUTO (Optional) - A - Auto-Post, N-Non-Auto-Post, B-Both (Defaults to B)
; RCDISP - Display results to screen or archive file flag
; RCBGDT - begin date of the report
; RCENDDT - End date of the report
; RCPYRLST - Payers to report on (All, range, or single payer)
; RCRQDIV - Division to report on - (A)ll or a single division
; RCRPT - (M)ain, (S)ummary or (G)rand Total Report
; RCEXCEL - Flag to indicate output in "^" delimited format
; RCRATE - Billing Rate Type flag
; RCDIV - Divisions to report on.
; RCPAY - Payers to report on (All, range, or single payer)
; RCTYPE - Types of payers to include (M - Medical, P - Pharmacy, T - Tricare C - CHAMPVA)
; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
; RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
;
;Select output device
W !
I $G(RCAUTO)="" S RCAUTO="B" ; PRCA*4.5*349
I $G(RCCLM)="" S RCCLM="A" ; PRCA*4.5*349
I $G(RCPAY)="" S RCPAY="A" ; PRCA*4.5*349
I $G(RCTYPE)="" S RCTYPE="A" ; PRCA*4.5*349
I $G(RCWHICH)="" S RCWHICH=2 ; PRCA*4.5*349
I RCDISP S %ZIS="QM" D ^%ZIS Q:POP
;Option to queue
I 'RCDISP,$D(IO("Q")) D Q
.N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="REPORT^RCDPENR2"
.S ZTDESC="EFT/ERA Trending Report"
.S ZTSAVE("RC*")=""
.S ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
.D ^%ZTLOAD
.I $D(ZTSK) W !!,"Task number "_ZTSK_" has been queued."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q") D HOME^%ZIS
;
;Compile and Print Report
D REPORT
Q
;
REPORT ; Trace the ERA file for the given date range
;
N RCPYRS,RCINS,RCDATA,RCDTLDT,RCDTLIEN,RCIEN,RCEOB,RCBILLNO,RCBATCH,RCPHARM,RCPYALL,RCTINALL
;
;Note: RCPYALL an RCTINALL are used in tag HEADER to determine header output.
;
; Clear temp arrays
K ^TMP("RCDPEADP",$J),^TMP("RCDPENR2",$J)
;
; Compile list of divisions
D DIV^RCDPENR4(.RCDIV)
;
; Gather raw data
; PRCA*4.5*349 - Add Closed Claims filter
D GETEFT^RCDPENR3(RCBGDT,RCENDDT,RCRATE,RCCLM,RCPUZ,RCSORT)
D GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM,RCPUZ,RCSORT)
;
;Check for data captures
I '$D(^TMP("RCDPENR2",$J,"MAIN")) D Q
. W !!,"There was no data available for the requested report. Please try again."
;
;Generate the statistics if any data captured
D COMPILE^RCDPENR3
;
; Print out the results
D PRINT(RCRPT,RCPUZ) ; PRCA*4.5*446 Add RCPUZ
;
;Clean up temp array afterwards
K ^TMP("RCDPENR2",$J)
K ^TMP("RCDPEU1",$J)
Q
;
;Print the results.
PRINT(RCSUMFLG,RCPUZ) ;Print the results
;
; Temp Array format
; ^TMP("RCDPENR1",$J,"TOT")=# Medical 835's ^ # Pharmacy 835's ^
N RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCSUBJ,RCXMZ,SECTION
;
;set separator print line.
S RCLINE="",$P(RCLINE,"-",IOM)=""
S SECTION=RCSUMFLG
;
; Init the stop flag, page count
S RCSTOP=0,RCPAGE=0
;
; Set the Run date for the report
S RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
;
; Open the device
I RCDISP U IO
;
I 'RCDISP D Q:'RCRPIEN
. S RCRPIEN=$$INITARCH^RCDPENR1("EFT/ERA TRENDING")
;
D HEADER
;
; Display the Main Level report
I RCSUMFLG="M" D
. I RCSORT="A" S RCSTOP=$$MAINAMT^RCDPENR5(RCPUZ,RCAUTO,RCEXCEL) ; PRCA*4.5*446 Add RCPUZ, new sort by amount
. I RCSORT="P" S RCSTOP=$$MAIN(RCPUZ) ; PRCA*4.5*446 Add RCPUZ, old sort by payer
Q:RCSTOP
;
S SECTION="S"
I +$G(RCEXCEL)=0,RCSUMFLG="M" D
. D ASK^RCDPEADP(.RCSTOP,0)
. Q:RCSTOP
. D HEADER
I RCSTOP Q
;
; Display the Payer/TIN summary information
I RCSUMFLG="S" S RCSTOP=$$SUMMARY(RCPUZ) ; PRCA*4.5*446 Add RCPUZ
Q:RCSTOP
;
; Display the grand total at the end
S SECTION="G"
S RCSTOP=$$GRAND(RCPUZ) ; PRCA*4.5*446 Add RCPUZ
Q:RCSTOP
;
; If not displaying to screen, send
I 'RCDISP D
. S RCSUBJ="ERA/EFT TRENDING REPORT"
. S RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,RCSUBJ)
;
;Report finished
I $Y>(IOSL-4),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
I RCDISP,'$G(RCEXCEL) W !,$$ENDORPRT^RCDPEARL
W !
;
;Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
;
; Undeclared Parameters - RCDISP and RCRPIEN
;
N RCAUTOT,RCDIVTXT,RCPYRTXT,RCSTR,RCTYPTXT,RCCLMTXT,RCPUZT
;
S RCDIVTXT=$$DIVTXT^RCDPENR1()
S RCPYRTXT=$S(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL")_" "
S RCPYRTXT=RCPYRTXT_$S(RCWHICH=2:"TINS",1:"PAYERS")
S RCTYPTXT=$S('+$G(RCEXCEL):"MEDICAL/PHARMACY/TRICARE/CHAMPVA: ",1:"")
S RCTYPTXT=RCTYPTXT_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
S RCAUTOT="MANUAL/AUTOPOST: "_$S(RCAUTO="N":"MANUAL",RCAUTO="A":"AUTOPOST",1:"BOTH")
S RCCLMTXT="Claims: "_$S(RCCLM="C":"CLOSED",1:"ALL") ; PRCA*4.5*349
S RCPUZT="PAYMENT/UNMATCHED/ZERO PAY: "_$S(RCPUZ="P":"PAYMENT",RCPUZ="U":"UNMATCHED",RCPUZ="Z":"ZERO PAY",1:"ALL")
;
S RCPAGE=RCPAGE+1
I '+RCDISP D Q
. S RCSTR="EFT/ERA TRENDING REPORT^PAGE "_$J(RCPAGE,5)
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="^"_RCDIVTXT_"^"_RCPYRTXT_"^"_RCTYPTXT
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. S RCSTR="^"_"DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)_"^"_"RUN DATE: "_RCRUNDT_"^"_RCPUZT ; PRCA*4.5*446
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
W @IOF,"EFT/ERA TRENDING REPORT"
I '$G(RCEXCEL) D ;
. W ?122,"PAGE ",$J(RCPAGE,5),!
. W " "_$E(RCDIVTXT,1,23),?25,$E(RCPYRTXT,1,20),?46,$E(RCTYPTXT,1,43) ;PRCA*4.5*432 35 -> 43
. W ?90,RCAUTOT,?118,RCCLMTXT,! ;PRCA*4.5*432 80 -> 90, 108 -> 118
. W ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
. W ?51,"RUN DATE: ",RCRUNDT,?90,RCPUZT,! ;PRCA*4.5*446, add RCPUZT
. W:RCSORT="P" "PAYER NAME/TIN",! ;PRCA*4.5*446 Move label to header
. W RCLINE,!
I +$G(RCEXCEL) D
. W "^PAGE ",$J(RCPAGE,5)
. W "^",RCDIVTXT,"^",RCPYRTXT,"^",RCTYPTXT
. W "^","DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
. W "^","RUN DATE: ",RCRUNDT
. W "^",RCAUTOT,"^",RCCLMTXT,!
;
;On the first page of the Main report, display the payer name and TIN above the column headers
;I RCFIRST S RCSTOP=$$PRINTINS($S(RCINSTIN["^":$P(RCINSTIN,U,2),1:RCINSTIN)),RCFIRST=0 ; PRCA*4.5*349 add "." to this and every subsequent line
;
; Re-display the column headers
I '$G(RCEXCEL),(SECTION="M") D COLHEAD
I $G(RCEXCEL),(RCPAGE=1) D COLHEAD
Q
;
;Print the Detailed portion of the report, sort by payer
MAIN(RCPUZ) ;
; ***** IMPORTANT ***** If this section needs to be modified, also check MAINAMT^RCDPENR5
;
S:'$L($G(RCPUZ)) RCPUZ="A" ; PRCA*4.5*446
;
N I,I1,I2,I3,RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCCLAIM2,RCBILL ; PRCA*4.5*446 I1,I2,I3,RCCLAIM2
N RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
N RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCTOTDY,RCTMP,RCSTOP,RCIDX
;
; Print ERA/EFT combinations for each Insurance Company/Tin combination
S RCINSTIN="",RCSTOP=0
F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN)) Q:RCINSTIN="" D Q:RCSTOP
. S RCMETHOD=""
. F S RCMETHOD=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD)) Q:RCMETHOD="" D Q:RCSTOP
. . I (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST")) Q ; PRCA*4.5*349
. . ;
. . I RCPUZ="U" I RCMETHOD'="UNPOSTED" Q
. . I RCPUZ="Z" I RCMETHOD'="UNPOSTED" Q
. . I RCPUZ="P" I RCMETHOD="UNPOSTED" Q
. . ;
. . ; PRCA*4.5*446, add I1,I2,I3
. . S I1=1,I2=1,I3=5 ; default for RCPUZ="A", ALL
. . I RCPUZ="U" S I1=4,I3=4
. . I RCPUZ="Z" S I1=5,I3=5
. . I RCPUZ="P" S I3=3
. . I RCPUZ="P" I RCMETHOD="AUTOPOST" S I3=1 ; Must be EFT/ERA(1) for autopost. Exclude Paper Check(2), Paper EOB(3)
. . ;If RCPUZ="A" for all and user selected AUTOPOST, exclude 2, 3 but keep 1, 4, 5. This case is handled inside next for loop.
. . ;
. . S RCSTOP=$$PRINTINS($S(RCINSTIN["^":$P(RCINSTIN,U,2),1:RCINSTIN)) ; PRCA*4.5*349 add "." to this and every subsequent line
. . Q:RCSTOP
. . ;
. . F I=I1:I2:I3 D Q:RCSTOP ; PRCA*4.5*446 use I1,I2,I3
. . . ;
. . . I RCMETHOD="MANUAL",I>3 Q ; Unmatched and Zero pay are Unposted
. . . I RCMETHOD="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
. . . I RCMETHOD="UNPOSTED",I<4 Q ; Unmatched and Zero pay are Unposted
. . . S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",I=3:"EFT/PAPER EOB",I=4:"UNMATCHED EOB",1:"ZERO PAYMENTS") ; PRCA*4.5*446 Add types for UNMATCHED EOB and ZERO PAYMENTS
. . . I I<4 D ; PRCA*4.5*446 Logic for types 1-3
. . . . S RCEFTTXT=$P(RCERATYP,"/")
. . . . S RCERATXT=$P(RCERATYP,"/",2)
. . . . S RCEFT=$S(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
. . . . S RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_RCMETHOD ; PRCA*4.5*349
. . . I I>3 D ; PRCA*4.5*446 Logic for types 4 and 5
. . . . S RCSTRING=$S(I=4:"UNMATCHED ERA - UNPOSTED",1:"ZERO PAYMENTS")
. . . S RCSTOP=$$PRINTHDR^RCDPENR5(RCSTRING,131) ;PRCA*4.5*446 131=line length
. . . Q:RCSTOP
. . . I '$G(RCEXCEL),$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,""))="" D ; PRCA*4.5*349
. . . . W "No data captured for this section during the specified time period.",! ; PRCA*4.5*349
. . . S RCCLAIM2=""
. . . F S RCCLAIM2=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM2)) Q:RCCLAIM2="" D Q:RCSTOP ; PRCA*4.5*446 Add RCCLAIM2
. . . . I $Y>(IOSL-5) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
. . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM2))
. . . . S RCCLAIM=$P(RCCLAIM2,"/",1) ; PRCA*4.5*446
. . . . I RCDATA="" D Q
. . . . . W !,"No data captured for this section during the specified time period.",!
. . . . ;
. . . . ;Init display values for the days
. . . . S (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
. . . . S RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
. . . . I $P(RCDATA,U,9),$P(RCDATA,U,8) S RCBEDY=$$FMTH^XLFDT($P(RCDATA,U,9),1)-$$FMTH^XLFDT($P(RCDATA,U,8),1)
. . . . I $P(RCDATA,U,10),$P(RCDATA,U,9) S RCEEDY=$$FMTH^XLFDT($P(RCDATA,U,10),1)-$$FMTH^XLFDT($P(RCDATA,U,9),1)
. . . . S RCIDX=$S($$FMTH^XLFDT($P(RCDATA,U,10),1)>$$FMTH^XLFDT($P(RCDATA,U,10),1):10,1:9) ; Find the latest date between ERA and EFT
. . . . I $P(RCDATA,U,11),$P(RCDATA,U,RCIDX) S RCEPDY=$$FMTH^XLFDT($P(RCDATA,U,11),1)-$$FMTH^XLFDT($P(RCDATA,U,RCIDX),1) ; Use latest date to determ days btw ERA/EFT and Posting
. . . . I $P(RCDATA,U,11),$P(RCDATA,U,8) S RCBPDY=$$FMTH^XLFDT($P(RCDATA,U,11),1)-$$FMTH^XLFDT($P(RCDATA,U,8),1)
. . . . I (I=4)!(I=5) S RCEPDY="N/A",RCBPDY="N/A" I I=4 S RCEEDY="N/A" ;PRCA*4.5*446 some fields are N/A for Unmatched and Zero Pay
. . . . I RCEXCEL D
. . . . . S RCTMP=RCBILL_"^"_$$FMTE^XLFDT($P(RCDATA,U,5),2)_"^"_$P(RCDATA,U,6)_"^"_$P(RCDATA,U,7)_"^"_$$FMTE^XLFDT($P(RCDATA,U,8),2)
. . . . . S RCTMP=RCTMP_"^"_$$FMTE^XLFDT($P(RCDATA,U,9),2)_"^"_$$FMTE^XLFDT($P(RCDATA,U,10),2)_"^"_$$FMTE^XLFDT($P(RCDATA,U,11),2)_"^"_$P(RCDATA,U,12)_"^"_$P(RCDATA,U,13)
. . . . . S RCTMP=RCTMP_"^"_$P(RCDATA,U,14)_"^"_$P(RCDATA,U,2)_"^"_$P(RCDATA,U,15)_"^"_$P(RCDATA,U,3)_"^"
. . . . . S RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
. . . . . I I=4 S $P(RCTMP,"^",8)="N/A" ;PRCA*4.5*446 posted date is N/A for Unmatched and Zero Pay
. . . . . W RCTMP,!
. . . . I 'RCEXCEL D
. . . . . W RCBILL,?21,$$FMTE^XLFDT($P(RCDATA,U,5),2),?30,$J($P(RCDATA,U,6),10,2),?41,$J($P(RCDATA,U,7),10,2),?52,$$FMTE^XLFDT($P(RCDATA,U,8),2)
. . . . . W ?61,$$FMTE^XLFDT($P(RCDATA,U,9),2),?75,$$FMTE^XLFDT($P(RCDATA,U,10),2),?89,$$FMTE^XLFDT($P(RCDATA,U,11),2),?98,$P(RCDATA,U,12),?109,$P(RCDATA,U,13),!
. . . . . W ?5,$P(RCDATA,U,14),?17,$P(RCDATA,U,2),?28,$J($P(RCDATA,U,15),6),?39,$P(RCDATA,U,3),?50,$J(RCBEDY,8)
. . . . . W ?67,$J(RCEEDY,8),?83,$J(RCEPDY,8),?106,$J(RCBPDY,8),!
. . . ;I '$G(RCEXCEL) W RCLINE,! ; PRCA*4.5*466, Remove line of "-"
;
I RCSTOP Q RCSTOP
; Section break - ask user if they wish to continue...
;
Q RCSTOP
;
SUMMARY(RCPUZ) ;Print the Payer Summary portion of the report
;
S:'$L($G(RCPUZ)) RCPUZ="A" ; PRCA*4.5*446
I $G(RCEXCEL) Q 0
N RCSTOP ; PRCA*4.5*349
N RCINSTIN ; PRCA*4.5*446
;
; Print ERA/EFT combinations for each Insurance Company/Tin combination
S RCINSTIN="",RCSTOP=0
F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D Q:RCSTOP
. D PAYSUM^RCDPENR4(RCINSTIN,RCPUZ)
Q RCSTOP
;
;Total for all payers in report
GRAND(RCPUZ) ;
; PRCA*4.5*446 - Moved to RCDPENR5 for size
S:'$L($G(RCPUZ)) RCPUZ="A" ; PRCA*4.5*446
Q $$GRAND^RCDPENR5(RCPUZ)
;
PRINTINS(RCINS) ; Print the insurance header line
; Input: RCINS - Payer Name/TIN to be displayed
; RCLINE - line of dashes used for separation
; Returns 1 - User quit out of report, 0 otherwise
I $G(RCEXCEL) Q 0
N RCSTOP,XX,YY,ZZ
;
S RCSTOP=0
I $Y>(IOSL-7) D
. D ASK^RCDPEADP(.RCSTOP,0)
. Q:RCSTOP
. D HEADER
I RCSTOP Q RCSTOP
W:(RCPAGE>1) ! W RCLINE,!
W " ",$$PAYTIN^RCDPRU2(RCINS,78),!
W RCLINE,!
Q RCSTOP
;
;Print the Payment Method header lines
PRINTHDR(RCTITLE,RCLL) ;
; PRCA*4.5*446 - Moved to RCDPENR5 for size
Q $$PRINTHDR^RCDPENR5(RCTITLE,RCLL)
;
GETDIV(RCDIV) ; Retrieve the Division
; PRCA*4.5*349 - Moved to RCDPENR4 for size
Q $$GETDIV^RCDPENR4(.RCDIV)
;
;Retrieve the Report Type
GETRPT(RCMNFLG) ;
; PRCA*4.5*446 - Moved to RCDPENR5 for size
Q $$GETRPT^RCDPENR5(RCMNFLG)
;
GETARPYR(RCTIN,RCPAY) ; Retrieve the Payer IEN from the RCDPE AUTO-PAY EXCLUSION file (#344.6)
; Input: RCTIN - Payer ID
; RCPAY - Payer Name (optional)
; Return: Payer IEN (#344.6)
;
N RCIEN,QUIT,ZZ
S RCPAY=$G(RCPAY)
;
; Send the IEN entry in the file if the Payer is in it. Otherwise, send 0.
S RCIEN=0
;
; PRCA*4.5*321 - Add optional payer name to search to narrow down payer
I RCPAY'="" D ;
. S ZZ="",QUIT=0
. F S ZZ=$O(^RCY(344.6,"C",RCTIN_" ",ZZ)) Q:ZZ="" D I RCIEN Q ;
. . I $$GET1^DIQ(344.6,ZZ_",",.01,"E")=RCPAY S RCIEN=ZZ
;
I 'RCIEN D ;
. S RCIEN=$O(^RCY(344.6,"C",RCTIN_" ",""))
;
Q +RCIEN
;
; Determine if the payer in the ERA or EFT should be included in the report.
INSCHK(RCINS) ;
;
;Send yes if all payers are being reported on.
Q:$D(^TMP("RCDPENR2",$J,"INS","A")) 1
;
; Send yes if Payer is in the list to report on
Q:$D(^TMP("RCDPENR2",$J,"INS",RCINS)) 1
;
; Otherwise, send no
Q 0
;
DIV(RCDIV) ; build the list of divisions to report on.
; PRCA*4.5*349 - Moved to RCDPENR4 for size
D DIV^RCDPENR4(.RCDIV)
Q
;Determine the text to display for the Payer TINs
TINTXT() ;
;
N RCTIN,RCTXT,RCTNTXT
;
Q:$D(^TMP("RCDPEADP",$J,"TIN","A")) "ALL PAYER TINS"
;
;Build list of Payer Tins
;
S RCTIN="",RCTXT=""
F S RCTIN=$O(^TMP("RCDPEADP",$J,"TIN",RCTIN)) Q:RCTIN="" D
. S RCTNTXT=$$GET1^DIQ(344.6,+RCTIN_",",".02","I")
. S RCTXT=RCTXT_RCTNTXT_","
;
; Remove comma at the end.
S RCTXT=$E(RCTXT,1,$L(RCTXT)-1)
;
; Display the first 35 characters of the division text list,
Q $E(RCTXT,1,35)
;
COLHEAD ;
;
N RCTMP
;
;Display the column headers
I RCEXCEL D
. S RCTMP="CLAIM#^DOS^AMT BILLED^AMT PAID^BILLED^ERA/EOB REC'D^EFT/PMT REC'D^POSTED^TRACE #^AUTOPOST/MANUAL"
. S RCTMP=RCTMP_"^ETRANS TYPE^ERA#^#EEOBS^EFT#^#DAYS:(BILL/ERA)^#DAYS:(ERA/EFT)^#DAYS:(ERA+EFT/POSTED)^"
. S RCTMP=RCTMP_"TOTAL #DAYS(BILL/POSTED)"
. W RCTMP,!
I 'RCEXCEL D
. W "CLAIM#",?21,"DOS",?30,"AMT BILLED",?41,"AMT PAID",?52,"BILLED",?61,"ERA/EOB REC'D",?75,"EFT/PMT REC'D",?89,"POSTED",?98,"TRACE #",?109,"AUTOPOST/MANUAL",!
. W ?5,"ETRANS TYPE",?17,"ERA#",?28,"#EEOBS",?39,"EFT#",?50,"#DAYS:(BILL/ERA)",?67,"#DAYS:(ERA/EFT)",?83,"#DAYS:(ERA+EFT/POSTED)",?106,"TOTAL #DAYS(BILL/POSTED)",!
. W:RCSORT="A" ?10,"PAYER NAME/TIN",!
. W RCLINE,!
Q
;
;Entry point for reprinting the header.
REPRINT(RCIEN) ;
;
N I,RCDATA,J,RCSTOP,PAGE
;
;
S PAGE=1
D RPTHDR(RCIEN,PAGE)
;
S I=4,RCSTOP=0 ;loop through the main body
F S I=$O(^RCDM(344.91,RCIEN,1,I)) Q:'I D Q:RCSTOP
. S RCDATA=$G(^RCDM(344.91,RCIEN,1,I,0))
. ;
. I $Y>(IOSL-4) D Q:RCSTOP
. . D ASK^RCDPEADP(.RCSTOP,0)
. . Q:RCSTOP
. . S PAGE=PAGE+1
. . D RPTHDR(RCIEN,PAGE)
. ; main body of report
. W $P(RCDATA,U)
. I RCDATA["^" W ?65,$P(RCDATA,U,2)
. W ! ;Add <CRLF>
Q
;
RPTHDR(RCIEN,PAGE) ; Reprint the header
;
N I,RCDATA
;
W @IOF ; Create new page
;
F I=1:1:4 D
. S RCDATA=$G(^RCDM(344.91,RCIEN,1,I,0))
. ; header lines formatting
. I I=1 W ?15,$P(RCDATA,U),?70,PAGE,! Q
. I I=2 W ?5,$P(RCDATA,U,2),! Q
. I I=3!(I=4) W ?5,$P(RCDATA,U,2),?45,$P(RCDATA,U,3),! Q
Q
;
GETSDATE() ;PRCA*4.5*446 moved subroutine to RCDPENR4
Q $$GETSDATE^RCDPENR4()
;
GETEDATE() ;PRCA*4.5*446 moved subroutine to RCDPENR4
Q $$GETEDATE^RCDPENR4(RCBGDT)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR2 19806 printed Sep 23, 2025@19:21:05 Page 2
RCDPENR2 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report ; 7/1/19 2:02pm
+1 ;;4.5;Accounts Receivable;**304,321,326,349,432,446**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Read ^DGCR(399) via Private IA 3820
+5 ;Read ^DG(40.8) via Controlled IA 417
+6 ;Read ^IBM(361.1) via Private IA 4051
+7 ;Use DIV^IBJDF2 via Private IA 3130
+8 ;Use DIVISION^VAUTOMA via Controlled IA 664
+9 ;
+10 QUIT
+11 ;
EFTERA() ; EFT/ERA TRENDING REPORT
+1 ;
+2 NEW DIRUT,DIROUT,DTOUT,DUOUT,X,XX,Y,POP
+3 NEW RCBGDT,RCAUTO,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
+4 NEW RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCPUZ,RCTIN,RCTINR
+5 NEW RCRATE,RCTYPE,RCWHICH
+6 ;
+7 ; Alert software to display to screen
+8 SET RCDISP=1
+9 ;
+10 ; Ask for Division
+11 SET RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
+12 if RCRQDIV=-1
QUIT
+13 ;
+14 ; PRCA*4.5*349
SET RCAUTO=$$ASKAUTO^RCDPEU1()
if RCAUTO=-1
QUIT
+15 ;
+16 ; PRCA*4.5*446 Payment, Unmatched, Zero, All
SET RCPUZ=$$ASKPUZ^RCDPENR4()
if RCPUZ=-1
QUIT
+17 ;
+18 SET RCTYPE=$$RTYPE^RCDPEU1()
if RCTYPE=-1
QUIT
+19 SET RCWHICH=$$NMORTIN^RCDPEAPP()
if RCWHICH=-1
QUIT
+20 ;
+21 SET RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
+22 if RCPAR("SELC")=-1
QUIT
+23 SET RCPAY=RCPAR("SELC")
+24 ;
+25 IF RCPAR("SELC")'="A"
Begin DoDot:1
+26 SET RCPAR("TYPE")=RCTYPE
+27 SET RCPAR("SRCH")=$SELECT(RCWHICH=2:"T",1:"N")
+28 SET RCPAR("FILE")=344.4
+29 SET RCPAR("DICA")="Select Insurance Company"_$SELECT(RCWHICH=1:" NAME: ",1:" TIN: ")
+30 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT
+31 ;
+32 ; Ask the user for rate type
+33 ;PRCA*4.5*446 moved subroutine to RCDPENR4
SET RCRATE=$$GETRATE^RCDPENR4()
+34 if RCRATE=-1
QUIT
+35 ;
+36 ; PRCA*4.5*349 - Add Closed Claims filter
+37 SET RCCLM=$$CLOSEDC^RCDPEU1()
+38 if RCCLM=-1
QUIT
+39 ;
+40 ; Ask the user for report type, with a prompt for the main report.
+41 SET RCRPT=$$GETRPT(1)
+42 if RCRPT=-1
QUIT
+43 ;
+44 ; Ask the user for sort type if Main report is selected. Options: by Payer, by Amount of Payment
+45 ; PRCA*4.5*446
+46 SET RCSORT="P"
+47 if RCRPT="M"
SET RCSORT=$$ASKSORT^RCDPENR5()
+48 if $GET(RCSORT)=-1
QUIT
+49 ;
+50 ; Retrieve start date
+51 ;PRCA*4.5*446 moved subroutine to RCDPENR4
SET RCBGDT=$$GETSDATE^RCDPENR4()
+52 if RCBGDT=-1
QUIT
+53 ;
+54 ; Retrieve end date. Send user start date as the lower bound.
+55 ;PRCA*4.5*446 moved subroutine to RCDPENR4
SET RCENDDT=$$GETEDATE^RCDPENR4(RCBGDT)
+56 if RCENDDT=-1
QUIT
+57 ;
+58 ;If the user is running the main report, ask if they wish to export to Excel
+59 SET RCEXCEL=0
+60 if RCRPT="M"
SET RCEXCEL=$$DISPTY^RCDPRU()
+61 if RCEXCEL
DO INFO^RCDPRU
+62 IF 'RCEXCEL
IF (RCRPT="M")
WRITE !!,"This report requires 132 columns.",!!
+63 DO AUTO(1,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,.RCDIV,RCAUTO,RCPUZ)
+64 QUIT
+65 ;
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO,RCPUZ) ;
+1 ; Inputs: RCAUTO (Optional) - A - Auto-Post, N-Non-Auto-Post, B-Both (Defaults to B)
+2 ; RCDISP - Display results to screen or archive file flag
+3 ; RCBGDT - begin date of the report
+4 ; RCENDDT - End date of the report
+5 ; RCPYRLST - Payers to report on (All, range, or single payer)
+6 ; RCRQDIV - Division to report on - (A)ll or a single division
+7 ; RCRPT - (M)ain, (S)ummary or (G)rand Total Report
+8 ; RCEXCEL - Flag to indicate output in "^" delimited format
+9 ; RCRATE - Billing Rate Type flag
+10 ; RCDIV - Divisions to report on.
+11 ; RCPAY - Payers to report on (All, range, or single payer)
+12 ; RCTYPE - Types of payers to include (M - Medical, P - Pharmacy, T - Tricare C - CHAMPVA)
+13 ; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
+14 ; RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
+15 ;
+16 ;Select output device
+17 WRITE !
+18 ; PRCA*4.5*349
IF $GET(RCAUTO)=""
SET RCAUTO="B"
+19 ; PRCA*4.5*349
IF $GET(RCCLM)=""
SET RCCLM="A"
+20 ; PRCA*4.5*349
IF $GET(RCPAY)=""
SET RCPAY="A"
+21 ; PRCA*4.5*349
IF $GET(RCTYPE)=""
SET RCTYPE="A"
+22 ; PRCA*4.5*349
IF $GET(RCWHICH)=""
SET RCWHICH=2
+23 IF RCDISP
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+24 ;Option to queue
+25 IF 'RCDISP
IF $DATA(IO("Q"))
Begin DoDot:1
+26 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+27 SET ZTRTN="REPORT^RCDPENR2"
+28 SET ZTDESC="EFT/ERA Trending Report"
+29 SET ZTSAVE("RC*")=""
+30 SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+31 DO ^%ZTLOAD
+32 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+33 IF '$TEST
WRITE !!,"Unable to queue this job."
+34 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+35 ;
+36 ;Compile and Print Report
+37 DO REPORT
+38 QUIT
+39 ;
REPORT ; Trace the ERA file for the given date range
+1 ;
+2 NEW RCPYRS,RCINS,RCDATA,RCDTLDT,RCDTLIEN,RCIEN,RCEOB,RCBILLNO,RCBATCH,RCPHARM,RCPYALL,RCTINALL
+3 ;
+4 ;Note: RCPYALL an RCTINALL are used in tag HEADER to determine header output.
+5 ;
+6 ; Clear temp arrays
+7 KILL ^TMP("RCDPEADP",$JOB),^TMP("RCDPENR2",$JOB)
+8 ;
+9 ; Compile list of divisions
+10 DO DIV^RCDPENR4(.RCDIV)
+11 ;
+12 ; Gather raw data
+13 ; PRCA*4.5*349 - Add Closed Claims filter
+14 DO GETEFT^RCDPENR3(RCBGDT,RCENDDT,RCRATE,RCCLM,RCPUZ,RCSORT)
+15 DO GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM,RCPUZ,RCSORT)
+16 ;
+17 ;Check for data captures
+18 IF '$DATA(^TMP("RCDPENR2",$JOB,"MAIN"))
Begin DoDot:1
+19 WRITE !!,"There was no data available for the requested report. Please try again."
End DoDot:1
QUIT
+20 ;
+21 ;Generate the statistics if any data captured
+22 DO COMPILE^RCDPENR3
+23 ;
+24 ; Print out the results
+25 ; PRCA*4.5*446 Add RCPUZ
DO PRINT(RCRPT,RCPUZ)
+26 ;
+27 ;Clean up temp array afterwards
+28 KILL ^TMP("RCDPENR2",$JOB)
+29 KILL ^TMP("RCDPEU1",$JOB)
+30 QUIT
+31 ;
+32 ;Print the results.
PRINT(RCSUMFLG,RCPUZ) ;Print the results
+1 ;
+2 ; Temp Array format
+3 ; ^TMP("RCDPENR1",$J,"TOT")=# Medical 835's ^ # Pharmacy 835's ^
+4 NEW RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCSUBJ,RCXMZ,SECTION
+5 ;
+6 ;set separator print line.
+7 SET RCLINE=""
SET $PIECE(RCLINE,"-",IOM)=""
+8 SET SECTION=RCSUMFLG
+9 ;
+10 ; Init the stop flag, page count
+11 SET RCSTOP=0
SET RCPAGE=0
+12 ;
+13 ; Set the Run date for the report
+14 SET RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
+15 ;
+16 ; Open the device
+17 IF RCDISP
USE IO
+18 ;
+19 IF 'RCDISP
Begin DoDot:1
+20 SET RCRPIEN=$$INITARCH^RCDPENR1("EFT/ERA TRENDING")
End DoDot:1
if 'RCRPIEN
QUIT
+21 ;
+22 DO HEADER
+23 ;
+24 ; Display the Main Level report
+25 IF RCSUMFLG="M"
Begin DoDot:1
+26 ; PRCA*4.5*446 Add RCPUZ, new sort by amount
IF RCSORT="A"
SET RCSTOP=$$MAINAMT^RCDPENR5(RCPUZ,RCAUTO,RCEXCEL)
+27 ; PRCA*4.5*446 Add RCPUZ, old sort by payer
IF RCSORT="P"
SET RCSTOP=$$MAIN(RCPUZ)
End DoDot:1
+28 if RCSTOP
QUIT
+29 ;
+30 SET SECTION="S"
+31 IF +$GET(RCEXCEL)=0
IF RCSUMFLG="M"
Begin DoDot:1
+32 DO ASK^RCDPEADP(.RCSTOP,0)
+33 if RCSTOP
QUIT
+34 DO HEADER
End DoDot:1
+35 IF RCSTOP
QUIT
+36 ;
+37 ; Display the Payer/TIN summary information
+38 ; PRCA*4.5*446 Add RCPUZ
IF RCSUMFLG="S"
SET RCSTOP=$$SUMMARY(RCPUZ)
+39 if RCSTOP
QUIT
+40 ;
+41 ; Display the grand total at the end
+42 SET SECTION="G"
+43 ; PRCA*4.5*446 Add RCPUZ
SET RCSTOP=$$GRAND(RCPUZ)
+44 if RCSTOP
QUIT
+45 ;
+46 ; If not displaying to screen, send
+47 IF 'RCDISP
Begin DoDot:1
+48 SET RCSUBJ="ERA/EFT TRENDING REPORT"
+49 SET RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,RCSUBJ)
End DoDot:1
+50 ;
+51 ;Report finished
+52 IF $Y>(IOSL-4)
IF RCDISP
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER
+53 IF RCDISP
IF '$GET(RCEXCEL)
WRITE !,$$ENDORPRT^RCDPEARL
+54 WRITE !
+55 ;
+56 ;Close device
+57 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+58 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+59 QUIT
+60 ;
+1 ;
+2 ; Undeclared Parameters - RCDISP and RCRPIEN
+3 ;
+4 NEW RCAUTOT,RCDIVTXT,RCPYRTXT,RCSTR,RCTYPTXT,RCCLMTXT,RCPUZT
+5 ;
+6 SET RCDIVTXT=$$DIVTXT^RCDPENR1()
+7 SET RCPYRTXT=$SELECT(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL")_" "
+8 SET RCPYRTXT=RCPYRTXT_$SELECT(RCWHICH=2:"TINS",1:"PAYERS")
+9 SET RCTYPTXT=$SELECT('+$GET(RCEXCEL):"MEDICAL/PHARMACY/TRICARE/CHAMPVA: ",1:"")
+10 ;PRCA*4.5*432 Add CHAMPVA
SET RCTYPTXT=RCTYPTXT_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
+11 SET RCAUTOT="MANUAL/AUTOPOST: "_$SELECT(RCAUTO="N":"MANUAL",RCAUTO="A":"AUTOPOST",1:"BOTH")
+12 ; PRCA*4.5*349
SET RCCLMTXT="Claims: "_$SELECT(RCCLM="C":"CLOSED",1:"ALL")
+13 SET RCPUZT="PAYMENT/UNMATCHED/ZERO PAY: "_$SELECT(RCPUZ="P":"PAYMENT",RCPUZ="U":"UNMATCHED",RCPUZ="Z":"ZERO PAY",1:"ALL")
+14 ;
+15 SET RCPAGE=RCPAGE+1
+16 IF '+RCDISP
Begin DoDot:1
+17 SET RCSTR="EFT/ERA TRENDING REPORT^PAGE "_$JUSTIFY(RCPAGE,5)
+18 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+19 SET RCSTR="^"_RCDIVTXT_"^"_RCPYRTXT_"^"_RCTYPTXT
+20 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+21 ; PRCA*4.5*446
SET RCSTR="^"_"DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)_"^"_"RUN DATE: "_RCRUNDT_"^"_RCPUZT
+22 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+23 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
End DoDot:1
QUIT
+24 WRITE @IOF,"EFT/ERA TRENDING REPORT"
+25 ;
IF '$GET(RCEXCEL)
Begin DoDot:1
+26 WRITE ?122,"PAGE ",$JUSTIFY(RCPAGE,5),!
+27 ;PRCA*4.5*432 35 -> 43
WRITE " "_$EXTRACT(RCDIVTXT,1,23),?25,$EXTRACT(RCPYRTXT,1,20),?46,$EXTRACT(RCTYPTXT,1,43)
+28 ;PRCA*4.5*432 80 -> 90, 108 -> 118
WRITE ?90,RCAUTOT,?118,RCCLMTXT,!
+29 WRITE ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
+30 ;PRCA*4.5*446, add RCPUZT
WRITE ?51,"RUN DATE: ",RCRUNDT,?90,RCPUZT,!
+31 ;PRCA*4.5*446 Move label to header
if RCSORT="P"
WRITE "PAYER NAME/TIN",!
+32 WRITE RCLINE,!
End DoDot:1
+33 IF +$GET(RCEXCEL)
Begin DoDot:1
+34 WRITE "^PAGE ",$JUSTIFY(RCPAGE,5)
+35 WRITE "^",RCDIVTXT,"^",RCPYRTXT,"^",RCTYPTXT
+36 WRITE "^","DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
+37 WRITE "^","RUN DATE: ",RCRUNDT
+38 WRITE "^",RCAUTOT,"^",RCCLMTXT,!
End DoDot:1
+39 ;
+40 ;On the first page of the Main report, display the payer name and TIN above the column headers
+41 ;I RCFIRST S RCSTOP=$$PRINTINS($S(RCINSTIN["^":$P(RCINSTIN,U,2),1:RCINSTIN)),RCFIRST=0 ; PRCA*4.5*349 add "." to this and every subsequent line
+42 ;
+43 ; Re-display the column headers
+44 IF '$GET(RCEXCEL)
IF (SECTION="M")
DO COLHEAD
+45 IF $GET(RCEXCEL)
IF (RCPAGE=1)
DO COLHEAD
+46 QUIT
+47 ;
+48 ;Print the Detailed portion of the report, sort by payer
MAIN(RCPUZ) ;
+1 ; ***** IMPORTANT ***** If this section needs to be modified, also check MAINAMT^RCDPENR5
+2 ;
+3 ; PRCA*4.5*446
if '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+4 ;
+5 ; PRCA*4.5*446 I1,I2,I3,RCCLAIM2
NEW I,I1,I2,I3,RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCCLAIM2,RCBILL
+6 NEW RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
+7 NEW RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCTOTDY,RCTMP,RCSTOP,RCIDX
+8 ;
+9 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
+10 SET RCINSTIN=""
SET RCSTOP=0
+11 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+12 SET RCMETHOD=""
+13 FOR
SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD))
if RCMETHOD=""
QUIT
Begin DoDot:2
+14 ; PRCA*4.5*349
IF (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST"))
QUIT
+15 ;
+16 IF RCPUZ="U"
IF RCMETHOD'="UNPOSTED"
QUIT
+17 IF RCPUZ="Z"
IF RCMETHOD'="UNPOSTED"
QUIT
+18 IF RCPUZ="P"
IF RCMETHOD="UNPOSTED"
QUIT
+19 ;
+20 ; PRCA*4.5*446, add I1,I2,I3
+21 ; default for RCPUZ="A", ALL
SET I1=1
SET I2=1
SET I3=5
+22 IF RCPUZ="U"
SET I1=4
SET I3=4
+23 IF RCPUZ="Z"
SET I1=5
SET I3=5
+24 IF RCPUZ="P"
SET I3=3
+25 ; Must be EFT/ERA(1) for autopost. Exclude Paper Check(2), Paper EOB(3)
IF RCPUZ="P"
IF RCMETHOD="AUTOPOST"
SET I3=1
+26 ;If RCPUZ="A" for all and user selected AUTOPOST, exclude 2, 3 but keep 1, 4, 5. This case is handled inside next for loop.
+27 ;
+28 ; PRCA*4.5*349 add "." to this and every subsequent line
SET RCSTOP=$$PRINTINS($SELECT(RCINSTIN["^":$PIECE(RCINSTIN,U,2),1:RCINSTIN))
+29 if RCSTOP
QUIT
+30 ;
+31 ; PRCA*4.5*446 use I1,I2,I3
FOR I=I1:I2:I3
Begin DoDot:3
+32 ;
+33 ; Unmatched and Zero pay are Unposted
IF RCMETHOD="MANUAL"
IF I>3
QUIT
+34 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF RCMETHOD="AUTOPOST"
IF I>1
QUIT
+35 ; Unmatched and Zero pay are Unposted
IF RCMETHOD="UNPOSTED"
IF I<4
QUIT
+36 ; PRCA*4.5*446 Add types for UNMATCHED EOB and ZERO PAYMENTS
SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",I=3:"EFT/PAPER EOB",I=4:"UNMATCHED EOB",1:"ZERO PAYMENTS")
+37 ; PRCA*4.5*446 Logic for types 1-3
IF I<4
Begin DoDot:4
+38 SET RCEFTTXT=$PIECE(RCERATYP,"/")
+39 SET RCERATXT=$PIECE(RCERATYP,"/",2)
+40 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
+41 ; PRCA*4.5*349
SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_RCMETHOD
End DoDot:4
+42 ; PRCA*4.5*446 Logic for types 4 and 5
IF I>3
Begin DoDot:4
+43 SET RCSTRING=$SELECT(I=4:"UNMATCHED ERA - UNPOSTED",1:"ZERO PAYMENTS")
End DoDot:4
+44 ;PRCA*4.5*446 131=line length
SET RCSTOP=$$PRINTHDR^RCDPENR5(RCSTRING,131)
+45 if RCSTOP
QUIT
+46 ; PRCA*4.5*349
IF '$GET(RCEXCEL)
IF $ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,""))=""
Begin DoDot:4
+47 ; PRCA*4.5*349
WRITE "No data captured for this section during the specified time period.",!
End DoDot:4
+48 SET RCCLAIM2=""
+49 ; PRCA*4.5*446 Add RCCLAIM2
FOR
SET RCCLAIM2=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM2))
if RCCLAIM2=""
QUIT
Begin DoDot:4
+50 IF $Y>(IOSL-5)
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER
+51 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM2))
+52 ; PRCA*4.5*446
SET RCCLAIM=$PIECE(RCCLAIM2,"/",1)
+53 IF RCDATA=""
Begin DoDot:5
+54 WRITE !,"No data captured for this section during the specified time period.",!
End DoDot:5
QUIT
+55 ;
+56 ;Init display values for the days
+57 SET (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
+58 SET RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
+59 IF $PIECE(RCDATA,U,9)
IF $PIECE(RCDATA,U,8)
SET RCBEDY=$$FMTH^XLFDT($PIECE(RCDATA,U,9),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,8),1)
+60 IF $PIECE(RCDATA,U,10)
IF $PIECE(RCDATA,U,9)
SET RCEEDY=$$FMTH^XLFDT($PIECE(RCDATA,U,10),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,9),1)
+61 ; Find the latest date between ERA and EFT
SET RCIDX=$SELECT($$FMTH^XLFDT($PIECE(RCDATA,U,10),1)>$$FMTH^XLFDT($PIECE(RCDATA,U,10),1):10,1:9)
+62 ; Use latest date to determ days btw ERA/EFT and Posting
IF $PIECE(RCDATA,U,11)
IF $PIECE(RCDATA,U,RCIDX)
SET RCEPDY=$$FMTH^XLFDT($PIECE(RCDATA,U,11),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,RCIDX),1)
+63 IF $PIECE(RCDATA,U,11)
IF $PIECE(RCDATA,U,8)
SET RCBPDY=$$FMTH^XLFDT($PIECE(RCDATA,U,11),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,8),1)
+64 ;PRCA*4.5*446 some fields are N/A for Unmatched and Zero Pay
IF (I=4)!(I=5)
SET RCEPDY="N/A"
SET RCBPDY="N/A"
IF I=4
SET RCEEDY="N/A"
+65 IF RCEXCEL
Begin DoDot:5
+66 SET RCTMP=RCBILL_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,5),2)_"^"_$PIECE(RCDATA,U,6)_"^"_$PIECE(RCDATA,U,7)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,8),2)
+67 SET RCTMP=RCTMP_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,9),2)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,10),2)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,11),2)_"^"_$PIECE(RCDATA,U,12)_"^"_$PIECE(RCDATA,U,13)
+68 SET RCTMP=RCTMP_"^"_$PIECE(RCDATA,U,14)_"^"_$PIECE(RCDATA,U,2)_"^"_$PIECE(RCDATA,U,15)_"^"_$PIECE(RCDATA,U,3)_"^"
+69 SET RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
+70 ;PRCA*4.5*446 posted date is N/A for Unmatched and Zero Pay
IF I=4
SET $PIECE(RCTMP,"^",8)="N/A"
+71 WRITE RCTMP,!
End DoDot:5
+72 IF 'RCEXCEL
Begin DoDot:5
+73 WRITE RCBILL,?21,$$FMTE^XLFDT($PIECE(RCDATA,U,5),2),?30,$JUSTIFY($PIECE(RCDATA,U,6),10,2),?41,$JUSTIFY($PIECE(RCDATA,U,7),10,2),?52,$$FMTE^XLFDT($PIECE(RCDATA,U,8),2)
+74 WRITE ?61,$$FMTE^XLFDT($PIECE(RCDATA,U,9),2),?75,$$FMTE^XLFDT($PIECE(RCDATA,U,10),2),?89,$$FMTE^XLFDT($PIECE(RCDATA,U,11),2),?98,$PIECE(RCDATA,U,12),?109,$PIECE(RCDATA,U,13),!
+75 WRITE ?5,$PIECE(RCDATA,U,14),?17,$PIECE(RCDATA,U,2),?28,$JUSTIFY($PIECE(RCDATA,U,15),6),?39,$PIECE(RCDATA,U,3),?50,$JUSTIFY(RCBEDY,8)
+76 WRITE ?67,$JUSTIFY(RCEEDY,8),?83,$JUSTIFY(RCEPDY,8),?106,$JUSTIFY(RCBPDY,8),!
End DoDot:5
End DoDot:4
if RCSTOP
QUIT
+77 ;I '$G(RCEXCEL) W RCLINE,! ; PRCA*4.5*466, Remove line of "-"
End DoDot:3
if RCSTOP
QUIT
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
if RCSTOP
QUIT
+78 ;
+79 IF RCSTOP
QUIT RCSTOP
+80 ; Section break - ask user if they wish to continue...
+81 ;
+82 QUIT RCSTOP
+83 ;
SUMMARY(RCPUZ) ;Print the Payer Summary portion of the report
+1 ;
+2 ; PRCA*4.5*446
if '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+3 IF $GET(RCEXCEL)
QUIT 0
+4 ; PRCA*4.5*349
NEW RCSTOP
+5 ; PRCA*4.5*446
NEW RCINSTIN
+6 ;
+7 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
+8 SET RCINSTIN=""
SET RCSTOP=0
+9 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+10 DO PAYSUM^RCDPENR4(RCINSTIN,RCPUZ)
End DoDot:1
if RCSTOP
QUIT
+11 QUIT RCSTOP
+12 ;
+13 ;Total for all payers in report
GRAND(RCPUZ) ;
+1 ; PRCA*4.5*446 - Moved to RCDPENR5 for size
+2 ; PRCA*4.5*446
if '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+3 QUIT $$GRAND^RCDPENR5(RCPUZ)
+4 ;
PRINTINS(RCINS) ; Print the insurance header line
+1 ; Input: RCINS - Payer Name/TIN to be displayed
+2 ; RCLINE - line of dashes used for separation
+3 ; Returns 1 - User quit out of report, 0 otherwise
+4 IF $GET(RCEXCEL)
QUIT 0
+5 NEW RCSTOP,XX,YY,ZZ
+6 ;
+7 SET RCSTOP=0
+8 IF $Y>(IOSL-7)
Begin DoDot:1
+9 DO ASK^RCDPEADP(.RCSTOP,0)
+10 if RCSTOP
QUIT
+11 DO HEADER
End DoDot:1
+12 IF RCSTOP
QUIT RCSTOP
+13 if (RCPAGE>1)
WRITE !
WRITE RCLINE,!
+14 WRITE " ",$$PAYTIN^RCDPRU2(RCINS,78),!
+15 WRITE RCLINE,!
+16 QUIT RCSTOP
+17 ;
+18 ;Print the Payment Method header lines
PRINTHDR(RCTITLE,RCLL) ;
+1 ; PRCA*4.5*446 - Moved to RCDPENR5 for size
+2 QUIT $$PRINTHDR^RCDPENR5(RCTITLE,RCLL)
+3 ;
GETDIV(RCDIV) ; Retrieve the Division
+1 ; PRCA*4.5*349 - Moved to RCDPENR4 for size
+2 QUIT $$GETDIV^RCDPENR4(.RCDIV)
+3 ;
+4 ;Retrieve the Report Type
GETRPT(RCMNFLG) ;
+1 ; PRCA*4.5*446 - Moved to RCDPENR5 for size
+2 QUIT $$GETRPT^RCDPENR5(RCMNFLG)
+3 ;
GETARPYR(RCTIN,RCPAY) ; Retrieve the Payer IEN from the RCDPE AUTO-PAY EXCLUSION file (#344.6)
+1 ; Input: RCTIN - Payer ID
+2 ; RCPAY - Payer Name (optional)
+3 ; Return: Payer IEN (#344.6)
+4 ;
+5 NEW RCIEN,QUIT,ZZ
+6 SET RCPAY=$GET(RCPAY)
+7 ;
+8 ; Send the IEN entry in the file if the Payer is in it. Otherwise, send 0.
+9 SET RCIEN=0
+10 ;
+11 ; PRCA*4.5*321 - Add optional payer name to search to narrow down payer
+12 ;
IF RCPAY'=""
Begin DoDot:1
+13 SET ZZ=""
SET QUIT=0
+14 ;
FOR
SET ZZ=$ORDER(^RCY(344.6,"C",RCTIN_" ",ZZ))
if ZZ=""
QUIT
Begin DoDot:2
+15 IF $$GET1^DIQ(344.6,ZZ_",",.01,"E")=RCPAY
SET RCIEN=ZZ
End DoDot:2
IF RCIEN
QUIT
End DoDot:1
+16 ;
+17 ;
IF 'RCIEN
Begin DoDot:1
+18 SET RCIEN=$ORDER(^RCY(344.6,"C",RCTIN_" ",""))
End DoDot:1
+19 ;
+20 QUIT +RCIEN
+21 ;
+22 ; Determine if the payer in the ERA or EFT should be included in the report.
INSCHK(RCINS) ;
+1 ;
+2 ;Send yes if all payers are being reported on.
+3 if $DATA(^TMP("RCDPENR2",$JOB,"INS","A"))
QUIT 1
+4 ;
+5 ; Send yes if Payer is in the list to report on
+6 if $DATA(^TMP("RCDPENR2",$JOB,"INS",RCINS))
QUIT 1
+7 ;
+8 ; Otherwise, send no
+9 QUIT 0
+10 ;
DIV(RCDIV) ; build the list of divisions to report on.
+1 ; PRCA*4.5*349 - Moved to RCDPENR4 for size
+2 DO DIV^RCDPENR4(.RCDIV)
+3 QUIT
+4 ;Determine the text to display for the Payer TINs
TINTXT() ;
+1 ;
+2 NEW RCTIN,RCTXT,RCTNTXT
+3 ;
+4 if $DATA(^TMP("RCDPEADP",$JOB,"TIN","A"))
QUIT "ALL PAYER TINS"
+5 ;
+6 ;Build list of Payer Tins
+7 ;
+8 SET RCTIN=""
SET RCTXT=""
+9 FOR
SET RCTIN=$ORDER(^TMP("RCDPEADP",$JOB,"TIN",RCTIN))
if RCTIN=""
QUIT
Begin DoDot:1
+10 SET RCTNTXT=$$GET1^DIQ(344.6,+RCTIN_",",".02","I")
+11 SET RCTXT=RCTXT_RCTNTXT_","
End DoDot:1
+12 ;
+13 ; Remove comma at the end.
+14 SET RCTXT=$EXTRACT(RCTXT,1,$LENGTH(RCTXT)-1)
+15 ;
+16 ; Display the first 35 characters of the division text list,
+17 QUIT $EXTRACT(RCTXT,1,35)
+18 ;
COLHEAD ;
+1 ;
+2 NEW RCTMP
+3 ;
+4 ;Display the column headers
+5 IF RCEXCEL
Begin DoDot:1
+6 SET RCTMP="CLAIM#^DOS^AMT BILLED^AMT PAID^BILLED^ERA/EOB REC'D^EFT/PMT REC'D^POSTED^TRACE #^AUTOPOST/MANUAL"
+7 SET RCTMP=RCTMP_"^ETRANS TYPE^ERA#^#EEOBS^EFT#^#DAYS:(BILL/ERA)^#DAYS:(ERA/EFT)^#DAYS:(ERA+EFT/POSTED)^"
+8 SET RCTMP=RCTMP_"TOTAL #DAYS(BILL/POSTED)"
+9 WRITE RCTMP,!
End DoDot:1
+10 IF 'RCEXCEL
Begin DoDot:1
+11 WRITE "CLAIM#",?21,"DOS",?30,"AMT BILLED",?41,"AMT PAID",?52,"BILLED",?61,"ERA/EOB REC'D",?75,"EFT/PMT REC'D",?89,"POSTED",?98,"TRACE #",?109,"AUTOPOST/MANUAL",!
+12 WRITE ?5,"ETRANS TYPE",?17,"ERA#",?28,"#EEOBS",?39,"EFT#",?50,"#DAYS:(BILL/ERA)",?67,"#DAYS:(ERA/EFT)",?83,"#DAYS:(ERA+EFT/POSTED)",?106,"TOTAL #DAYS(BILL/POSTED)",!
+13 if RCSORT="A"
WRITE ?10,"PAYER NAME/TIN",!
+14 WRITE RCLINE,!
End DoDot:1
+15 QUIT
+16 ;
+17 ;Entry point for reprinting the header.
REPRINT(RCIEN) ;
+1 ;
+2 NEW I,RCDATA,J,RCSTOP,PAGE
+3 ;
+4 ;
+5 SET PAGE=1
+6 DO RPTHDR(RCIEN,PAGE)
+7 ;
+8 ;loop through the main body
SET I=4
SET RCSTOP=0
+9 FOR
SET I=$ORDER(^RCDM(344.91,RCIEN,1,I))
if 'I
QUIT
Begin DoDot:1
+10 SET RCDATA=$GET(^RCDM(344.91,RCIEN,1,I,0))
+11 ;
+12 IF $Y>(IOSL-4)
Begin DoDot:2
+13 DO ASK^RCDPEADP(.RCSTOP,0)
+14 if RCSTOP
QUIT
+15 SET PAGE=PAGE+1
+16 DO RPTHDR(RCIEN,PAGE)
End DoDot:2
if RCSTOP
QUIT
+17 ; main body of report
+18 WRITE $PIECE(RCDATA,U)
+19 IF RCDATA["^"
WRITE ?65,$PIECE(RCDATA,U,2)
+20 ;Add <CRLF>
WRITE !
End DoDot:1
if RCSTOP
QUIT
+21 QUIT
+22 ;
RPTHDR(RCIEN,PAGE) ; Reprint the header
+1 ;
+2 NEW I,RCDATA
+3 ;
+4 ; Create new page
WRITE @IOF
+5 ;
+6 FOR I=1:1:4
Begin DoDot:1
+7 SET RCDATA=$GET(^RCDM(344.91,RCIEN,1,I,0))
+8 ; header lines formatting
+9 IF I=1
WRITE ?15,$PIECE(RCDATA,U),?70,PAGE,!
QUIT
+10 IF I=2
WRITE ?5,$PIECE(RCDATA,U,2),!
QUIT
+11 IF I=3!(I=4)
WRITE ?5,$PIECE(RCDATA,U,2),?45,$PIECE(RCDATA,U,3),!
QUIT
End DoDot:1
+12 QUIT
+13 ;
GETSDATE() ;PRCA*4.5*446 moved subroutine to RCDPENR4
+1 QUIT $$GETSDATE^RCDPENR4()
+2 ;
GETEDATE() ;PRCA*4.5*446 moved subroutine to RCDPENR4
+1 QUIT $$GETEDATE^RCDPENR4(RCBGDT)
+2 ;
