RCDPENR2 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report ; 7/1/19 2:02pm
;;4.5;Accounts Receivable;**304,321,326,349**;Mar 20, 1995;Build 44
;;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,Y,POP
N RCBGDT,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
N RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCTIN,RCTINR,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 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()
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
;
; Retrieve start date
S RCBGDT=$$GETSDATE()
Q:RCBGDT=-1
;
; Retrieve end date. Send user start date as the lower bound.
S RCENDDT=$$GETEDATE(RCBGDT)
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)
Q
;
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO) ;
; 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)
; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
;
;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)
D GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM)
;
;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)
;
;Clean up temp array afterwards
K ^TMP("RCDPENR2",$J)
K ^TMP("RCDPEU1",$J)
Q
;
;Print the results.
PRINT(RCSUMFLG) ;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")
;
; Display Header
D HEADER
;
; Display the Main Level report
I RCSUMFLG="M" D
. S RCSTOP=$$MAIN()
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()
Q:RCSTOP
;
; Display the grand total at the end
S SECTION="G"
S RCSTOP=$$GRAND()
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
;
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: ",1:"")
S RCTYPTXT=RCTYPTXT_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",1:"ALL")
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 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
. 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,35)
. W ?80,RCAUTOT,?108,RCCLMTXT,!
. W ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
. W ?51,"RUN DATE: ",RCRUNDT,!
. 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,!
;
; 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
MAIN() ;
;
N RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCBILL
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
. . S RCSTOP=$$PRINTINS(RCINSTIN) ; PRCA*4.5*349 add "." to this and every subsequent line
. . Q:RCSTOP
. . F I=1:1:3 D Q:RCSTOP
. . . I RCMETHOD="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
. . . S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
. . . 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
. . . S RCSTOP=$$PRINTHDR(RCSTRING)
. . . 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 RCCLAIM=""
. . . F S RCCLAIM=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM)) Q:RCCLAIM="" D Q:RCSTOP
. . . . I $Y>(IOSL-5) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
. . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
. . . . 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 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
. . . . . 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,!
;
I RCSTOP Q RCSTOP
; Section break - ask user if they wish to continue...
;
Q RCSTOP
;
SUMMARY() ;Print the Payer Summary portion of the report
;
I $G(RCEXCEL) Q 0
N RCSTOP ; PRCA*4.5*349
;
; 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)
Q RCSTOP
;
;Total for all payers in report
GRAND() ;
I $G(RCEXCEL) Q 0
;
N I,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP ; PRCA*4.5*349
;
S RCSTOP=0
; Print the Grand Total Banner
I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
I RCSUMFLG'="G",RCDISP D
. W !,"GRAND TOTALS ALL PAYERS",!!
. W RCLINE,!
;
; Print all 3 EOB/Payment combinations
F J="AUTOPOST","MANUAL","TOTAL" Q:RCSTOP F I=1:1:3 D Q:RCSTOP ; PRCA*4.5*349
. I J="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
. I (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL")) Q ; PRCA*4.5*349
. S RCDATA=$G(^TMP("RCDPENR2",$J,"GTOT",J,I)) ; PRCA*4.5*349
. S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
. S RCERAFLG=0
. 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_" - "_J ; PRCA*4.5*349
. I (RCEFTTXT="EFT"),(RCERATXT["ERA") S RCERAFLG=1
. D PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
;
Q RCSTOP
;
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 "PAYER NAME/TIN",!
W " ",$$PAYTIN^RCDPRU2(RCINS,78),!
W RCLINE,!
Q RCSTOP
;
;Print the Payment Method header lines
PRINTHDR(RCTITLE) ;
; Undeclared parameters
; RCLINE - line of "-" for report formating
; RCSUMFLG - Type of report (M=Main,S=Summary,G=Grand Total)
; RCDISP - Is the report being email (0) or Printed (1)
; RCRPIEN - IEN to store the report if emailing
;
I $G(RCEXCEL) Q 0
N RCBORDER,RCSTOP,RCSTR
;
S RCBORDER="",$P(RCBORDER,"*",20)="",RCSTOP=0
I $Y>(IOSL-7),RCDISP D
. D ASK^RCDPEADP(.RCSTOP,0)
. Q:RCSTOP
. D HEADER
I RCSTOP Q RCSTOP
;
; Display report type being displayed
I 'RCDISP D Q
. S RCSTR=RCBORDER_" "_RCTITLE_" "_RCBORDER
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
I RCDISP D
. W RCBORDER," ",RCTITLE," ",RCBORDER,!
. W RCLINE,!
;
Q RCSTOP
;
GETDIV(RCDIV) ; Retrieve the Division
; PRCA*4.5*349 - Moved to RCDPENR4 for size
Q $$GETDIV^RCDPENR4(.RCDIV)
;
;Retrieve the Report Type
GETRATE() ;
;
;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
N X,Y,DIC,DTOUT,DUOUT
;
S DIC="^DGCR(399.3,",DIC(0)="AEQMN"
S DIC("S")="I $P(^(0),U,7)=""i"""
D ^DIC K DIC
Q +Y
;
;Retrieve the Report Type
GETRPT(RCMNFLG) ;
;
;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
;
; Prompt with Main (EFT/ERA Trending report (from RCDPENR2))
I $G(RCMNFLG) D
. S DIR("A")="Print (M)AIN Report, (S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
. S DIR(0)="SA^M:MAIN;S:SUMMARY;G:GRAND TOTAL"
;
; Prompt w/o main (Volume Statistics report (from RCDPENR1))
I '$G(RCMNFLG) D
. S DIR("A")="(S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
. S DIR(0)="SA^S:SUMMARY;G:GRAND TOTAL"
;
S DIR("?")="Select the type of report to Generate."
S DIR("B")="G"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q Y
;
;
GETSDATE() ;
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
;
;Assume the start date is 45 days prior to the end date
;
;Get the start date.
S RCTODAY=$P($$NOW^XLFDT,".")
S DIR("?")="ENTER THE EARLIEST DATE TO INCLUDE ON THE REPORT"
S DIR(0)="DA^:"_RCTODAY_":APE",DIR("A")="Start with DATE: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q Y
;
; Retrieve the end date of the report from the user.
GETEDATE(RCBDATE) ;
; RCBDATE - Begin date of the report. Used as a lower bound
;
N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
;
; Get the End date first. Assume the end date is today.
S RCTODAY=$P($$NOW^XLFDT,".")
S DIR("?")="ENTER THE LATEST DATE TO INCLUDE ON THE REPORT"
S DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
S DIR(0)="DAO^"_$G(RCBDATE)_":"_RCTODAY_":APE",DIR("A")="Go to DATE: " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
Q Y
;
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 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR2 19549 printed Sep 15, 2024@21:09:17 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**;Mar 20, 1995;Build 44
+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,Y,POP
+3 NEW RCBGDT,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
+4 NEW RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCTIN,RCTINR,RCTYPE,RCWHICH
+5 ;
+6 ; Alert software to display to screen
+7 SET RCDISP=1
+8 ;
+9 ; Ask for Division
+10 SET RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
+11 if RCRQDIV=-1
QUIT
+12 ;
+13 ; PRCA*4.5*349
SET RCAUTO=$$ASKAUTO^RCDPEU1()
if RCAUTO=-1
QUIT
+14 ;
+15 SET RCTYPE=$$RTYPE^RCDPEU1()
if RCTYPE=-1
QUIT
+16 SET RCWHICH=$$NMORTIN^RCDPEAPP()
if RCWHICH=-1
QUIT
+17 ;
+18 SET RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
+19 if RCPAR("SELC")=-1
QUIT
+20 SET RCPAY=RCPAR("SELC")
+21 ;
+22 IF RCPAR("SELC")'="A"
Begin DoDot:1
+23 SET RCPAR("TYPE")=RCTYPE
+24 SET RCPAR("SRCH")=$SELECT(RCWHICH=2:"T",1:"N")
+25 SET RCPAR("FILE")=344.4
+26 SET RCPAR("DICA")="Select Insurance Company"_$SELECT(RCWHICH=1:" NAME: ",1:" TIN: ")
+27 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT
+28 ;
+29 ; Ask the user for rate type
+30 SET RCRATE=$$GETRATE()
+31 if RCRATE=-1
QUIT
+32 ;
+33 ; PRCA*4.5*349 - Add Closed Claims filter
+34 SET RCCLM=$$CLOSEDC^RCDPEU1()
+35 if RCCLM=-1
QUIT
+36 ;
+37 ; Ask the user for report type, with a prompt for the main report.
+38 SET RCRPT=$$GETRPT(1)
+39 if RCRPT=-1
QUIT
+40 ;
+41 ; Retrieve start date
+42 SET RCBGDT=$$GETSDATE()
+43 if RCBGDT=-1
QUIT
+44 ;
+45 ; Retrieve end date. Send user start date as the lower bound.
+46 SET RCENDDT=$$GETEDATE(RCBGDT)
+47 if RCENDDT=-1
QUIT
+48 ;
+49 ;If the user is running the main report, ask if they wish to export to Excel
+50 SET RCEXCEL=0
+51 if RCRPT="M"
SET RCEXCEL=$$DISPTY^RCDPRU()
+52 if RCEXCEL
DO INFO^RCDPRU
+53 IF 'RCEXCEL
IF (RCRPT="M")
WRITE !!,"This report requires 132 columns.",!!
+54 DO AUTO(1,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,.RCDIV,RCAUTO)
+55 QUIT
+56 ;
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO) ;
+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)
+13 ; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
+14 ;
+15 ;Select output device
+16 WRITE !
+17 ; PRCA*4.5*349
IF $GET(RCAUTO)=""
SET RCAUTO="B"
+18 ; PRCA*4.5*349
IF $GET(RCCLM)=""
SET RCCLM="A"
+19 ; PRCA*4.5*349
IF $GET(RCPAY)=""
SET RCPAY="A"
+20 ; PRCA*4.5*349
IF $GET(RCTYPE)=""
SET RCTYPE="A"
+21 ; PRCA*4.5*349
IF $GET(RCWHICH)=""
SET RCWHICH=2
+22 IF RCDISP
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+23 ;Option to queue
+24 IF 'RCDISP
IF $DATA(IO("Q"))
Begin DoDot:1
+25 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+26 SET ZTRTN="REPORT^RCDPENR2"
+27 SET ZTDESC="EFT/ERA Trending Report"
+28 SET ZTSAVE("RC*")=""
+29 SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+30 DO ^%ZTLOAD
+31 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+32 IF '$TEST
WRITE !!,"Unable to queue this job."
+33 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+34 ;
+35 ;Compile and Print Report
+36 DO REPORT
+37 QUIT
+38 ;
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)
+15 DO GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM)
+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 DO PRINT(RCRPT)
+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) ;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 ; Display Header
+23 DO HEADER
+24 ;
+25 ; Display the Main Level report
+26 IF RCSUMFLG="M"
Begin DoDot:1
+27 SET RCSTOP=$$MAIN()
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 IF RCSUMFLG="S"
SET RCSTOP=$$SUMMARY()
+39 if RCSTOP
QUIT
+40 ;
+41 ; Display the grand total at the end
+42 SET SECTION="G"
+43 SET RCSTOP=$$GRAND()
+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
+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: ",1:"")
+10 SET RCTYPTXT=RCTYPTXT_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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 ;
+14 SET RCPAGE=RCPAGE+1
+15 IF '+RCDISP
Begin DoDot:1
+16 SET RCSTR="EFT/ERA TRENDING REPORT^PAGE "_$JUSTIFY(RCPAGE,5)
+17 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+18 SET RCSTR="^"_RCDIVTXT_"^"_RCPYRTXT_"^"_RCTYPTXT
+19 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+20 SET RCSTR="^"_"DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)_"^"_"RUN DATE: "_RCRUNDT
+21 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+22 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
End DoDot:1
QUIT
+23 WRITE @IOF,"EFT/ERA TRENDING REPORT"
+24 ;
IF '$GET(RCEXCEL)
Begin DoDot:1
+25 WRITE ?122,"PAGE ",$JUSTIFY(RCPAGE,5),!
+26 WRITE " "_$EXTRACT(RCDIVTXT,1,23),?25,$EXTRACT(RCPYRTXT,1,20),?46,$EXTRACT(RCTYPTXT,1,35)
+27 WRITE ?80,RCAUTOT,?108,RCCLMTXT,!
+28 WRITE ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
+29 WRITE ?51,"RUN DATE: ",RCRUNDT,!
+30 WRITE RCLINE,!
End DoDot:1
+31 IF +$GET(RCEXCEL)
Begin DoDot:1
+32 WRITE "^PAGE ",$JUSTIFY(RCPAGE,5)
+33 WRITE "^",RCDIVTXT,"^",RCPYRTXT,"^",RCTYPTXT
+34 WRITE "^","DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
+35 WRITE "^","RUN DATE: ",RCRUNDT
+36 WRITE "^",RCAUTOT,"^",RCCLMTXT,!
End DoDot:1
+37 ;
+38 ; Re-display the column headers
+39 IF '$GET(RCEXCEL)
IF (SECTION="M")
DO COLHEAD
+40 IF $GET(RCEXCEL)
IF (RCPAGE=1)
DO COLHEAD
+41 QUIT
+42 ;
+43 ;Print the Detailed portion of the report
MAIN() ;
+1 ;
+2 NEW RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCBILL
+3 NEW RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
+4 NEW RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCTOTDY,RCTMP,RCSTOP,RCIDX
+5 ;
+6 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
+7 SET RCINSTIN=""
SET RCSTOP=0
+8 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+9 SET RCMETHOD=""
+10 FOR
SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD))
if RCMETHOD=""
QUIT
Begin DoDot:2
+11 ; PRCA*4.5*349
IF (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST"))
QUIT
+12 ; PRCA*4.5*349 add "." to this and every subsequent line
SET RCSTOP=$$PRINTINS(RCINSTIN)
+13 if RCSTOP
QUIT
+14 FOR I=1:1:3
Begin DoDot:3
+15 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF RCMETHOD="AUTOPOST"
IF I>1
QUIT
+16 SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
+17 SET RCEFTTXT=$PIECE(RCERATYP,"/")
+18 SET RCERATXT=$PIECE(RCERATYP,"/",2)
+19 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
+20 ; PRCA*4.5*349
SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_RCMETHOD
+21 SET RCSTOP=$$PRINTHDR(RCSTRING)
+22 if RCSTOP
QUIT
+23 ; PRCA*4.5*349
IF '$GET(RCEXCEL)
IF $ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,""))=""
Begin DoDot:4
+24 ; PRCA*4.5*349
WRITE "No data captured for this section during the specified time period.",!
End DoDot:4
+25 SET RCCLAIM=""
+26 FOR
SET RCCLAIM=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
if RCCLAIM=""
QUIT
Begin DoDot:4
+27 IF $Y>(IOSL-5)
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER
+28 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
+29 IF RCDATA=""
Begin DoDot:5
+30 WRITE !,"No data captured for this section during the specified time period.",!
End DoDot:5
QUIT
+31 ;
+32 ;Init display values for the days
+33 SET (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
+34 SET RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
+35 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)
+36 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)
+37 ; 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)
+38 ; 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)
+39 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)
+40 IF RCEXCEL
Begin DoDot:5
+41 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)
+42 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)
+43 SET RCTMP=RCTMP_"^"_$PIECE(RCDATA,U,14)_"^"_$PIECE(RCDATA,U,2)_"^"_$PIECE(RCDATA,U,15)_"^"_$PIECE(RCDATA,U,3)_"^"
+44 SET RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
+45 WRITE RCTMP,!
End DoDot:5
+46 IF 'RCEXCEL
Begin DoDot:5
+47 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)
+48 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),!
+49 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)
+50 WRITE ?67,$JUSTIFY(RCEEDY,8),?83,$JUSTIFY(RCEPDY,8),?106,$JUSTIFY(RCBPDY,8),!
End DoDot:5
End DoDot:4
if RCSTOP
QUIT
+51 IF '$GET(RCEXCEL)
WRITE RCLINE,!
End DoDot:3
if RCSTOP
QUIT
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
if RCSTOP
QUIT
+52 ;
+53 IF RCSTOP
QUIT RCSTOP
+54 ; Section break - ask user if they wish to continue...
+55 ;
+56 QUIT RCSTOP
+57 ;
SUMMARY() ;Print the Payer Summary portion of the report
+1 ;
+2 IF $GET(RCEXCEL)
QUIT 0
+3 ; PRCA*4.5*349
NEW RCSTOP
+4 ;
+5 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
+6 SET RCINSTIN=""
SET RCSTOP=0
+7 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+8 DO PAYSUM^RCDPENR4(RCINSTIN)
End DoDot:1
if RCSTOP
QUIT
+9 QUIT RCSTOP
+10 ;
+11 ;Total for all payers in report
GRAND() ;
+1 IF $GET(RCEXCEL)
QUIT 0
+2 ;
+3 ; PRCA*4.5*349
NEW I,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP
+4 ;
+5 SET RCSTOP=0
+6 ; Print the Grand Total Banner
+7 IF $Y>(IOSL-7)
IF RCDISP
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER
+8 IF RCSUMFLG'="G"
IF RCDISP
Begin DoDot:1
+9 WRITE !,"GRAND TOTALS ALL PAYERS",!!
+10 WRITE RCLINE,!
End DoDot:1
+11 ;
+12 ; Print all 3 EOB/Payment combinations
+13 ; PRCA*4.5*349
FOR J="AUTOPOST","MANUAL","TOTAL"
if RCSTOP
QUIT
FOR I=1:1:3
Begin DoDot:1
+14 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF J="AUTOPOST"
IF I>1
QUIT
+15 ; PRCA*4.5*349
IF (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL"))
QUIT
+16 ; PRCA*4.5*349
SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"GTOT",J,I))
+17 SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
+18 SET RCERAFLG=0
+19 SET RCEFTTXT=$PIECE(RCERATYP,"/")
+20 SET RCERATXT=$PIECE(RCERATYP,"/",2)
+21 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
+22 ; PRCA*4.5*349
SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J
+23 IF (RCEFTTXT="EFT")
IF (RCERATXT["ERA")
SET RCERAFLG=1
+24 DO PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
End DoDot:1
if RCSTOP
QUIT
+25 ;
+26 QUIT RCSTOP
+27 ;
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 WRITE "PAYER NAME/TIN",!
+14 WRITE " ",$$PAYTIN^RCDPRU2(RCINS,78),!
+15 WRITE RCLINE,!
+16 QUIT RCSTOP
+17 ;
+18 ;Print the Payment Method header lines
PRINTHDR(RCTITLE) ;
+1 ; Undeclared parameters
+2 ; RCLINE - line of "-" for report formating
+3 ; RCSUMFLG - Type of report (M=Main,S=Summary,G=Grand Total)
+4 ; RCDISP - Is the report being email (0) or Printed (1)
+5 ; RCRPIEN - IEN to store the report if emailing
+6 ;
+7 IF $GET(RCEXCEL)
QUIT 0
+8 NEW RCBORDER,RCSTOP,RCSTR
+9 ;
+10 SET RCBORDER=""
SET $PIECE(RCBORDER,"*",20)=""
SET RCSTOP=0
+11 IF $Y>(IOSL-7)
IF RCDISP
Begin DoDot:1
+12 DO ASK^RCDPEADP(.RCSTOP,0)
+13 if RCSTOP
QUIT
+14 DO HEADER
End DoDot:1
+15 IF RCSTOP
QUIT RCSTOP
+16 ;
+17 ; Display report type being displayed
+18 IF 'RCDISP
Begin DoDot:1
+19 SET RCSTR=RCBORDER_" "_RCTITLE_" "_RCBORDER
+20 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+21 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
End DoDot:1
QUIT
+22 IF RCDISP
Begin DoDot:1
+23 WRITE RCBORDER," ",RCTITLE," ",RCBORDER,!
+24 WRITE RCLINE,!
End DoDot:1
+25 ;
+26 QUIT RCSTOP
+27 ;
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
GETRATE() ;
+1 ;
+2 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
+3 NEW X,Y,DIC,DTOUT,DUOUT
+4 ;
+5 SET DIC="^DGCR(399.3,"
SET DIC(0)="AEQMN"
+6 SET DIC("S")="I $P(^(0),U,7)=""i"""
+7 DO ^DIC
KILL DIC
+8 QUIT +Y
+9 ;
+10 ;Retrieve the Report Type
GETRPT(RCMNFLG) ;
+1 ;
+2 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
+3 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+4 ;
+5 ; Prompt with Main (EFT/ERA Trending report (from RCDPENR2))
+6 IF $GET(RCMNFLG)
Begin DoDot:1
+7 SET DIR("A")="Print (M)AIN Report, (S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
+8 SET DIR(0)="SA^M:MAIN;S:SUMMARY;G:GRAND TOTAL"
End DoDot:1
+9 ;
+10 ; Prompt w/o main (Volume Statistics report (from RCDPENR1))
+11 IF '$GET(RCMNFLG)
Begin DoDot:1
+12 SET DIR("A")="(S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
+13 SET DIR(0)="SA^S:SUMMARY;G:GRAND TOTAL"
End DoDot:1
+14 ;
+15 SET DIR("?")="Select the type of report to Generate."
+16 SET DIR("B")="G"
+17 DO ^DIR
KILL DIR
+18 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+19 QUIT Y
+20 ;
+21 ;
GETSDATE() ;
+1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
+2 ;
+3 ;Assume the start date is 45 days prior to the end date
+4 ;
+5 ;Get the start date.
+6 SET RCTODAY=$PIECE($$NOW^XLFDT,".")
+7 SET DIR("?")="ENTER THE EARLIEST DATE TO INCLUDE ON THE REPORT"
+8 SET DIR(0)="DA^:"_RCTODAY_":APE"
SET DIR("A")="Start with DATE: "
+9 DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+11 QUIT Y
+12 ;
+13 ; Retrieve the end date of the report from the user.
GETEDATE(RCBDATE) ;
+1 ; RCBDATE - Begin date of the report. Used as a lower bound
+2 ;
+3 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
+4 ;
+5 ; Get the End date first. Assume the end date is today.
+6 SET RCTODAY=$PIECE($$NOW^XLFDT,".")
+7 SET DIR("?")="ENTER THE LATEST DATE TO INCLUDE ON THE REPORT"
+8 SET DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
+9 SET DIR(0)="DAO^"_$GET(RCBDATE)_":"_RCTODAY_":APE"
SET DIR("A")="Go to DATE: "
DO ^DIR
KILL DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+11 QUIT Y
+12 ;
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 WRITE RCLINE,!
End DoDot:1
+14 QUIT
+15 ;
+16 ;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
