RCDPENR5 ;ALB/CNF - EPay National Reports - ERA/EFT Report Utilities ;12/14/15
;;4.5;Accounts Receivable;**446**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
GETRPT(RCMNFLG) ;
; PRCA*4.5*446 - Moved from RCDPENR2 for size
;
;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
;
GRAND(RCPUZ) ; PRCA*4.5*446 - Moved from RCDPENR2 for size
; Input RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
;
S:'$L($G(RCPUZ)) RCPUZ="A"
I $G(RCEXCEL) Q 0
;
N I,I1,I2,I3,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP ; PRCA*4.5*349, PRCA*4.5*446 I1,I2,I3
;
S RCSTOP=0
; Print the Grand Total Banner
I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2
I RCSUMFLG'="G",RCDISP D
. W !,"GRAND TOTALS ALL PAYERS",!!
. W RCLINE,!
;
; 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 ;Unposted contains Zero Pay and Unmatched
I RCPUZ="Z" S I1=5,I3=5 ;Unposted contains Zero Pay and Unmatched
I RCPUZ="P" S I3=3 ;Don't include Unposted
;
; Print all EOB/Payment combinations
F J="AUTOPOST","MANUAL","UNPOSTED","TOTAL" Q:RCSTOP F I=I1:I2:I3 D Q:RCSTOP ; PRCA*4.5*349, PRCA*4.5*446 use I1,I2,I3
. ;
. ; PRCA*4.5*446 filter for RCPUZ
. I (RCPUZ="U")!(RCPUZ="Z") I (J="AUTOPOST")!(J="MANUAL") Q
. I (RCPUZ="U")!(RCPUZ="Z") I J="TOTAL" Q ; For Unmatched and Zero Pay, there are not 2 categories to total together like Autopost+Manual
. I RCPUZ="P" I J="UNPOSTED" Q
. ;
. I J="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
. I J="MANUAL",I>3 Q ; Unmatched and Zero pay are Unposted
. I J="UNPOSTED",I<4 Q ; Unmatched and Zero pay are Unposted
. I '("/Z/U/"[("/"_RCPUZ_"/")) I (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL")) Q ; PRCA*4.5*349, PRCA*4.5*446 check RCPUZ
. I RCPUZ="P" I J="UNPOSTED" Q ; PRCA*4.5*446, If user wants to see Posted, exclude Zero Pay and Unmatched (Unposted)
. 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",I=3:"EFT/PAPER EOB",I=4:"/UNMATCHED ERA",1:"/ZERO PAYMENTS") ; PRCA*4.5*446
. S RCERAFLG=0
. S RCEFTTXT=$P(RCERATYP,"/")
. S RCERATXT=$P(RCERATYP,"/",2)
. S RCEFT=$S(RCEFTTXT="EFT":"AN EFT",RCEFTTXT="PAPER CHECK":"A PAPER CHECK",1:"") ; PRCA*4.5*446
. I '((I=4)!(I=5)) S RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J ; PRCA*4.5*349, PRCA*4.5**446 If not unmatched or zero pay
. I ((I=4)!(I=5)) S RCSTRING=RCERATXT ; PRCA*4.5**446 If not unmatched or zero pay
. I (RCEFTTXT="EFT"),(RCERATXT["ERA") S RCERAFLG=1
. I (I=4)!(I=5) S RCERAFLG=1 ; PRCA*4.5*446 If unmatched or zero pay, then set ERA flag
. D PRINTGT(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL,RCPUZ)
;
Q RCSTOP
;
;Print the Grand Total/Summary data, Moved from ^RCDPENR3 because of routine size PRCA*4.5*446
PRINTGT(RCTITLE,RCDATA,RCDISP,RCERAFLG,RCEXCEL,RCPUZ) ;PRCA*4.5*332 - added comments below, 20 August 2018
; Print the Grand Total/Summary data for the EFT/ERA Trending Report
; Input: RCTITLE - Name of the report
; RCDATA - Array of compiled data being processed. RCDATA("A") autoposted, RCDATA("M") manually posted
; RCDISP - 1 - Display to screen, 0 otherwise
; RCERAFLG - 1 if we're in the ERA matched to an EFT section
; 0 otherwise
; RCEXCEL - 1 output to excel, 0 otherwise
; RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
; RCSTOP - Initialized to 0
; Output: RCSTOP - User stopped the display of the report
;
; Undeclared Parameter(s) - RCRPIEN,RCLINE,RCSTOP
; RCRPIEN - IEN of the archive file (344.91(
; RCLINE - String of '-' (separator line)
; RCSUMFLG - 'M' - Main Report
; 'G' - Grand totals
; 'S' - Summary
;
;PRCA*4.5*332 comments end
;
N RCCOUNT,RCBILL,RCPAID,RCPCT,RCBECT,RCBEDY,RCAVGBE,RCEECT,RCEEDY
N RCEPCT,RCEPDY,RCAVGEP,RCBPCT,RCBPDY,RCAVGBP,RCBORDER,RCSCDATA
N RCC,RCB,RCAVGEE,RCLTXT,RCNA,I,RCSTRDTA,RCSTRNG,RCDTXT
;
I '$L($G(RCPUZ)) S RCPUZ="A" ;PRCA*4.5*446
S RCERAFLG=+$G(RCERAFLG),RCDISP=$G(RCDISP)
I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2
;
; Display report type being displayed
D PRINTHDR^RCDPENR2(RCTITLE,79) ; PRCA*4.5*446, 79 (line length)
;
; Extract data from string and build string for output
S $P(RCSCDATA,U,1)=+$P(RCDATA,U)
S RCBILL=+$P(RCDATA,U,2)
S RCPAID=+$P(RCDATA,U,3)
S $P(RCSCDATA,U,2)=RCBILL
S $P(RCSCDATA,U,3)=RCPAID
S $P(RCSCDATA,U,4)=$S(+RCBILL=0:0,1:RCPAID/RCBILL)*100 ; Convert to percent format
S RCBECT=+$P(RCDATA,U,4)
S RCBEDY=+$P(RCDATA,U,5)
S $P(RCSCDATA,U,6)=$FN($S(+RCBECT=0:0,1:RCBEDY/RCBECT),"",0)
S RCEECT=+$P(RCDATA,U,6)
S RCEEDY=+$P(RCDATA,U,7)
S $P(RCSCDATA,U,7)=$FN($S(+RCEECT=0:0,1:RCEEDY/RCEECT),"",0)
S RCEPCT=+$P(RCDATA,U,8)
S RCEPDY=+$P(RCDATA,U,9)
S $P(RCSCDATA,U,8)=$FN($S(+RCEPCT=0:0,1:RCEPDY/RCEPCT),"",0)
S RCBPCT=+$P(RCDATA,U,10)
S RCBPDY=+$P(RCDATA,U,11)
S $P(RCSCDATA,U,9)=$FN($S(+RCBPCT=0:0,1:RCBPDY/RCBPCT),"",0)
S $P(RCSCDATA,U,11)=+$P(RCDATA,U,12)
S $P(RCSCDATA,U,12)=+$P(RCDATA,U,13)
S $P(RCSCDATA,U,14)=+$P(RCDATA,U,14)
S $P(RCSCDATA,U,15)=+$P(RCDATA,U,15)
S $P(RCSCDATA,U,16)=RCPAID-$P(RCDATA,U,15)
;
; PRCA*4.5*446 Correct data for Unmatched and Zero Payments
S RCNA=0 I (RCTITLE["UNMATCHED")!(RCTITLE["ZERO") S RCNA=1 F I=7,8,9,14 S $P(RCSCDATA,U,I)="N/A"
;
F I=1:1:16 D Q:RCSTOP
. ; PRC*4.5*332, added (RCSUMFLG'="G") below
. I (RCSUMFLG'="G"),RCDISP,($Y>(IOSL-4)) D Q:RCSTOP
. . D ASK^RCDPEADP(.RCSTOP,0)
. . Q:RCSTOP
. . D HEADER^RCDPENR2
. ;if printing from monthly background job save in file and quit
. ;Otherwise print to screen
. S (RCLTXT,RCDTXT)=$P($T(GDTXT+I),";;",2)
. I RCTITLE["PAPER" D
. . I (I>5),(I<9) D ; correct display for lines 6,7,8,16
. . . I (I=6),RCTITLE["CHECK" Q ;Dont change line 6 if Paper check section
. . . S RCB="EFT",RCC="CHK" ; Correct display for Paper check section
. . . I RCTITLE["EOB" S RCB="ERA",RCC="EOB" ;correct display for paper eob
. . . S RCDTXT=$P(RCLTXT,RCB,1)_RCC_$P(RCLTXT,RCB,2)
. I 'RCDISP!RCEXCEL D Q
. . S RCSTRDTA=$P(RCSCDATA,U,I)
. . ;Format lines: lines 2&3 are amounts, 4 is a percentage, remainder are integers.
. . S RCSTRNG=RCDTXT_"^"_$S(I=4:$J($P(RCSTRDTA,"."),2)_"%",1:RCSTRDTA)
. . I 'RCDISP D SAVEDATA^RCDPENR1(RCSTRNG,RCRPIEN) Q
. .;if printing in an EXCEL format, print "^" delimited and quit
. . I RCEXCEL W RCSTRNG,! Q
. ;Output to screen
. ;currency format
. I (I=2)!(I=3)!(I=15) W RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),! Q
. ; For the line items that are percentages. Not using $J formatting due to rounding errors.
. I I=4 W RCDTXT,?65,$J($P($P(RCSCDATA,U,I),"."),12),"%",! Q
. ;Otherwise print Number format
. I (I=16) D Q
. . W:RCERAFLG RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),!
. W RCDTXT,?65,$J($P(RCSCDATA,U,I),13),!
I RCSTOP Q RCSTOP
I RCDISP W RCLINE,! ;Otherwise print Number format
I 'RCDISP D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
Q RCSTOP
;
GDTXT ; Moved from ^RCDPENR3 because of routine size PRCA*4.5*446
;;TOTAL NUMBER OF CLAIMS
;;TOTAL AMOUNT BILLED
;;TOTAL AMOUNT PAID
;;PERCENTAGE AMOUNT PAID: (%Total Paid/Billed)
;;
;;AVG #DAYS BETWEEN BILLED/ERA
;;AVG #DAYS BETWEEN ERA/EFT
;;AVG #DAYS BETWEEN ERA+EFT REC'D/PMT POSTED
;;AVG #DAYS BETWEEN BILLED/PMT POSTED
;;
;;TOTAL NUMBER OF ERAs
;;TOTAL NUMBER OF EEOBs
;;
;;TOTAL NUMBER OF EFTs
;;TOTAL AMOUNT COLLECTED
;;TOTAL DIFFERENCE BETWEEN ERAs (PAID) - EFTs (COLLECTED):
Q
;
PRINTHDR(RCTITLE,RCLL,RCNOLINE) ;
; PRCA*4.5*446 - Moved from RCDPENR2 for size, add RCLL as parameter for line length, add RCNOLINE to suppress line
;
; 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 '$L($G(RCNOLINE)) S RCNOLINE=0 ;PRCA*4.5*446
I 'RCLL S RCLL=79 ;PRCA*4.5*446 If Line Length isn't set, make it 79
I $G(RCEXCEL) Q 0
N PAD,PAD1,PAD2,RCBORDER,RCSTOP,RCSTR,X ;PRCA*4.5*446 Add PAD,PAD1,PAD2,X
;
S RCBORDER="",$P(RCBORDER,"*",20)="",$P(PAD," ",132)="",RCSTOP=0 ;PRCA*4.5*446 PAD is a variable of spaces to pad title
I $Y>(IOSL-7),RCDISP D
. D ASK^RCDPEADP(.RCSTOP,0)
. Q:RCSTOP
. D HEADER^RCDPENR2
I RCSTOP Q RCSTOP
;
; Display report type being displayed
S X=$L(RCBORDER)+$L(RCTITLE)+$L(RCBORDER)
S X=RCLL-X
S PAD1=$E(PAD,1,(X/2\1)),PAD2=$E(PAD,1,(X/2+.5\1)) ;PRCA*4.5*446 Calculate # spaces for PAD1, PAD2 to center title
I 'RCDISP D Q
. S RCSTR=RCBORDER_PAD1_RCTITLE_PAD2_RCBORDER ;PRCA*4.5*446 Replace spaces with PAD1, PAD2 to center title
. D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
. D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
I RCDISP D
. W RCBORDER,PAD1,RCTITLE,PAD2,RCBORDER,! ;PRCA*4.5*446 Replace spaces with PAD1, PAD2 to center title
. W:'RCNOLINE RCLINE,! ;PRCA*4.5*446
;
Q RCSTOP
;
ASKSORT() ; EP from RCDPENR2 - added for PRCA*4.5*446
; Input: N/A
; Returns: -1 - User ^ or timed out
; P - Sort by Payer
; A - Sort by Amount of payment
;
N DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
S RCTYPE=""
S DIR("?",1)="Enter 'P' to sort by Payer"
S DIR("?")=" 'A' to sort by Amount of payment"
S DIR(0)="SA^P:PAYER;A:AMOUNT OF PAYMENT"
S DIR("A")="SORT BY (P)AYER or (A)MOUNT OF PAYMENT: "
S DIR("B")=$S($G(DEF)'="":DEF,1:"PAYER")
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q:Y="" "P"
S RETURN=$E(Y)
Q RETURN
;
;Print the Detailed portion of the report, sort by amount
MAINAMT(RCPUZ,RCAUTO,RCEXCEL) ;
; ***** IMPORTANT ***** If this section needs to be modified, also check MAIN^RCDPENR2
; New subroutine for PRCA*4.5*446, copied from MAIN^RCDPENR2 and modified for sort by amount
;
S:'$L($G(RCPUZ)) RCPUZ="A" ; PRCA*4.5*446
;
N I,RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCCLAIM,RCBILL
N RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
N RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCNOLINE,RCTOTDY,RCTMP,RCSTOP,RCIDX,RCSUB6
;
S RCMETHOD="",RCSTOP=0
S RCNOLINE=1
F S RCMETHOD=$O(^TMP("RCDPENR2",$J,"MAINAMT",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
. ;
. S RCSTOP=$$PRINTHDR^RCDPENR5(RCMETHOD,131,RCNOLINE) ;PRCA*4.5*446 131=line length, RCNOLINE
. Q:RCSTOP
. ;
. I '$G(RCEXCEL),$O(^TMP("RCDPENR2",$J,"MAINAMT",RCMETHOD,""))="" D ; PRCA*4.5*349
. . W "No data captured for this section during the specified time period.",! ; PRCA*4.5*349
. ;
. S RCAMTBL=""
. F S RCAMTBL=$O(^TMP("RCDPENR2",$J,"MAINAMT",RCMETHOD,RCAMTBL)) Q:RCAMTBL="" D Q:RCSTOP
. . S RCSUB6=""
. . F S RCSUB6=$O(^TMP("RCDPENR2",$J,"MAINAMT",RCMETHOD,RCAMTBL,RCSUB6)) Q:RCSUB6="" D Q:RCSTOP
. . . S RCDATA=^TMP("RCDPENR2",$J,"MAINAMT",RCMETHOD,RCAMTBL,RCSUB6)
. . . S I=$P(RCDATA,U,19)
. . . I RCPUZ="U" I I'=4 Q
. . . I RCPUZ="Z" I I'=5 Q
. . . I RCPUZ="P" I I>3 Q
. . . I RCPUZ="P" I RCMETHOD="AUTOPOST" I I'=1 Q ; 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.
. . . ;
. . . 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
. . . ;
. . . I $Y>(IOSL-5) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2
. . . ;Init display values for the days
. . . S RCCLAIM=$P(RCDATA,U,20)
. . . 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),!
. . . . W ?10,$P(RCDATA,U,17),!
. ;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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR5 14963 printed Jan 29, 2026@14:43:38 Page 2
RCDPENR5 ;ALB/CNF - EPay National Reports - ERA/EFT Report Utilities ;12/14/15
+1 ;;4.5;Accounts Receivable;**446**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
GETRPT(RCMNFLG) ;
+1 ; PRCA*4.5*446 - Moved from RCDPENR2 for size
+2 ;
+3 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
+4 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
+5 ;
+6 ; Prompt with Main (EFT/ERA Trending report (from RCDPENR2))
+7 IF $GET(RCMNFLG)
Begin DoDot:1
+8 SET DIR("A")="Print (M)AIN Report, (S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
+9 SET DIR(0)="SA^M:MAIN;S:SUMMARY;G:GRAND TOTAL"
End DoDot:1
+10 ;
+11 ; Prompt w/o main (Volume Statistics report (from RCDPENR1))
+12 IF '$GET(RCMNFLG)
Begin DoDot:1
+13 SET DIR("A")="(S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
+14 SET DIR(0)="SA^S:SUMMARY;G:GRAND TOTAL"
End DoDot:1
+15 ;
+16 SET DIR("?")="Select the type of report to Generate."
+17 SET DIR("B")="G"
+18 DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
QUIT -1
+20 QUIT Y
+21 ;
GRAND(RCPUZ) ; PRCA*4.5*446 - Moved from RCDPENR2 for size
+1 ; Input RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
+2 ;
+3 if '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+4 IF $GET(RCEXCEL)
QUIT 0
+5 ;
+6 ; PRCA*4.5*349, PRCA*4.5*446 I1,I2,I3
NEW I,I1,I2,I3,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP
+7 ;
+8 SET RCSTOP=0
+9 ; Print the Grand Total Banner
+10 IF $Y>(IOSL-7)
IF RCDISP
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER^RCDPENR2
+11 IF RCSUMFLG'="G"
IF RCDISP
Begin DoDot:1
+12 WRITE !,"GRAND TOTALS ALL PAYERS",!!
+13 WRITE RCLINE,!
End DoDot:1
+14 ;
+15 ; PRCA*4.5*446, add I1,I2,I3
+16 ; default for RCPUZ="A", ALL
SET I1=1
SET I2=1
SET I3=5
+17 ;Unposted contains Zero Pay and Unmatched
IF RCPUZ="U"
SET I1=4
SET I3=4
+18 ;Unposted contains Zero Pay and Unmatched
IF RCPUZ="Z"
SET I1=5
SET I3=5
+19 ;Don't include Unposted
IF RCPUZ="P"
SET I3=3
+20 ;
+21 ; Print all EOB/Payment combinations
+22 ; PRCA*4.5*349, PRCA*4.5*446 use I1,I2,I3
FOR J="AUTOPOST","MANUAL","UNPOSTED","TOTAL"
if RCSTOP
QUIT
FOR I=I1:I2:I3
Begin DoDot:1
+23 ;
+24 ; PRCA*4.5*446 filter for RCPUZ
+25 IF (RCPUZ="U")!(RCPUZ="Z")
IF (J="AUTOPOST")!(J="MANUAL")
QUIT
+26 ; For Unmatched and Zero Pay, there are not 2 categories to total together like Autopost+Manual
IF (RCPUZ="U")!(RCPUZ="Z")
IF J="TOTAL"
QUIT
+27 IF RCPUZ="P"
IF J="UNPOSTED"
QUIT
+28 ;
+29 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF J="AUTOPOST"
IF I>1
QUIT
+30 ; Unmatched and Zero pay are Unposted
IF J="MANUAL"
IF I>3
QUIT
+31 ; Unmatched and Zero pay are Unposted
IF J="UNPOSTED"
IF I<4
QUIT
+32 ; PRCA*4.5*349, PRCA*4.5*446 check RCPUZ
IF '("/Z/U/"[("/"_RCPUZ_"/"))
IF (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL"))
QUIT
+33 ; PRCA*4.5*446, If user wants to see Posted, exclude Zero Pay and Unmatched (Unposted)
IF RCPUZ="P"
IF J="UNPOSTED"
QUIT
+34 ; PRCA*4.5*349
SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"GTOT",J,I))
+35 ; PRCA*4.5*446
SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",I=3:"EFT/PAPER EOB",I=4:"/UNMATCHED ERA",1:"/ZERO PAYMENTS")
+36 SET RCERAFLG=0
+37 SET RCEFTTXT=$PIECE(RCERATYP,"/")
+38 SET RCERATXT=$PIECE(RCERATYP,"/",2)
+39 ; PRCA*4.5*446
SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",RCEFTTXT="PAPER CHECK":"A PAPER CHECK",1:"")
+40 ; PRCA*4.5*349, PRCA*4.5**446 If not unmatched or zero pay
IF '((I=4)!(I=5))
SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J
+41 ; PRCA*4.5**446 If not unmatched or zero pay
IF ((I=4)!(I=5))
SET RCSTRING=RCERATXT
+42 IF (RCEFTTXT="EFT")
IF (RCERATXT["ERA")
SET RCERAFLG=1
+43 ; PRCA*4.5*446 If unmatched or zero pay, then set ERA flag
IF (I=4)!(I=5)
SET RCERAFLG=1
+44 DO PRINTGT(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL,RCPUZ)
End DoDot:1
if RCSTOP
QUIT
+45 ;
+46 QUIT RCSTOP
+47 ;
+48 ;Print the Grand Total/Summary data, Moved from ^RCDPENR3 because of routine size PRCA*4.5*446
PRINTGT(RCTITLE,RCDATA,RCDISP,RCERAFLG,RCEXCEL,RCPUZ) ;PRCA*4.5*332 - added comments below, 20 August 2018
+1 ; Print the Grand Total/Summary data for the EFT/ERA Trending Report
+2 ; Input: RCTITLE - Name of the report
+3 ; RCDATA - Array of compiled data being processed. RCDATA("A") autoposted, RCDATA("M") manually posted
+4 ; RCDISP - 1 - Display to screen, 0 otherwise
+5 ; RCERAFLG - 1 if we're in the ERA matched to an EFT section
+6 ; 0 otherwise
+7 ; RCEXCEL - 1 output to excel, 0 otherwise
+8 ; RCPUZ - P: Payment EEOBs, U: Unmatched EEOBs, Z: Zero Payment EEOBs, A: All ;PRCA*4.5*446
+9 ; RCSTOP - Initialized to 0
+10 ; Output: RCSTOP - User stopped the display of the report
+11 ;
+12 ; Undeclared Parameter(s) - RCRPIEN,RCLINE,RCSTOP
+13 ; RCRPIEN - IEN of the archive file (344.91(
+14 ; RCLINE - String of '-' (separator line)
+15 ; RCSUMFLG - 'M' - Main Report
+16 ; 'G' - Grand totals
+17 ; 'S' - Summary
+18 ;
+19 ;PRCA*4.5*332 comments end
+20 ;
+21 NEW RCCOUNT,RCBILL,RCPAID,RCPCT,RCBECT,RCBEDY,RCAVGBE,RCEECT,RCEEDY
+22 NEW RCEPCT,RCEPDY,RCAVGEP,RCBPCT,RCBPDY,RCAVGBP,RCBORDER,RCSCDATA
+23 NEW RCC,RCB,RCAVGEE,RCLTXT,RCNA,I,RCSTRDTA,RCSTRNG,RCDTXT
+24 ;
+25 ;PRCA*4.5*446
IF '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+26 SET RCERAFLG=+$GET(RCERAFLG)
SET RCDISP=$GET(RCDISP)
+27 IF $Y>(IOSL-7)
IF RCDISP
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER^RCDPENR2
+28 ;
+29 ; Display report type being displayed
+30 ; PRCA*4.5*446, 79 (line length)
DO PRINTHDR^RCDPENR2(RCTITLE,79)
+31 ;
+32 ; Extract data from string and build string for output
+33 SET $PIECE(RCSCDATA,U,1)=+$PIECE(RCDATA,U)
+34 SET RCBILL=+$PIECE(RCDATA,U,2)
+35 SET RCPAID=+$PIECE(RCDATA,U,3)
+36 SET $PIECE(RCSCDATA,U,2)=RCBILL
+37 SET $PIECE(RCSCDATA,U,3)=RCPAID
+38 ; Convert to percent format
SET $PIECE(RCSCDATA,U,4)=$SELECT(+RCBILL=0:0,1:RCPAID/RCBILL)*100
+39 SET RCBECT=+$PIECE(RCDATA,U,4)
+40 SET RCBEDY=+$PIECE(RCDATA,U,5)
+41 SET $PIECE(RCSCDATA,U,6)=$FNUMBER($SELECT(+RCBECT=0:0,1:RCBEDY/RCBECT),"",0)
+42 SET RCEECT=+$PIECE(RCDATA,U,6)
+43 SET RCEEDY=+$PIECE(RCDATA,U,7)
+44 SET $PIECE(RCSCDATA,U,7)=$FNUMBER($SELECT(+RCEECT=0:0,1:RCEEDY/RCEECT),"",0)
+45 SET RCEPCT=+$PIECE(RCDATA,U,8)
+46 SET RCEPDY=+$PIECE(RCDATA,U,9)
+47 SET $PIECE(RCSCDATA,U,8)=$FNUMBER($SELECT(+RCEPCT=0:0,1:RCEPDY/RCEPCT),"",0)
+48 SET RCBPCT=+$PIECE(RCDATA,U,10)
+49 SET RCBPDY=+$PIECE(RCDATA,U,11)
+50 SET $PIECE(RCSCDATA,U,9)=$FNUMBER($SELECT(+RCBPCT=0:0,1:RCBPDY/RCBPCT),"",0)
+51 SET $PIECE(RCSCDATA,U,11)=+$PIECE(RCDATA,U,12)
+52 SET $PIECE(RCSCDATA,U,12)=+$PIECE(RCDATA,U,13)
+53 SET $PIECE(RCSCDATA,U,14)=+$PIECE(RCDATA,U,14)
+54 SET $PIECE(RCSCDATA,U,15)=+$PIECE(RCDATA,U,15)
+55 SET $PIECE(RCSCDATA,U,16)=RCPAID-$PIECE(RCDATA,U,15)
+56 ;
+57 ; PRCA*4.5*446 Correct data for Unmatched and Zero Payments
+58 SET RCNA=0
IF (RCTITLE["UNMATCHED")!(RCTITLE["ZERO")
SET RCNA=1
FOR I=7,8,9,14
SET $PIECE(RCSCDATA,U,I)="N/A"
+59 ;
+60 FOR I=1:1:16
Begin DoDot:1
+61 ; PRC*4.5*332, added (RCSUMFLG'="G") below
+62 IF (RCSUMFLG'="G")
IF RCDISP
IF ($Y>(IOSL-4))
Begin DoDot:2
+63 DO ASK^RCDPEADP(.RCSTOP,0)
+64 if RCSTOP
QUIT
+65 DO HEADER^RCDPENR2
End DoDot:2
if RCSTOP
QUIT
+66 ;if printing from monthly background job save in file and quit
+67 ;Otherwise print to screen
+68 SET (RCLTXT,RCDTXT)=$PIECE($TEXT(GDTXT+I),";;",2)
+69 IF RCTITLE["PAPER"
Begin DoDot:2
+70 ; correct display for lines 6,7,8,16
IF (I>5)
IF (I<9)
Begin DoDot:3
+71 ;Dont change line 6 if Paper check section
IF (I=6)
IF RCTITLE["CHECK"
QUIT
+72 ; Correct display for Paper check section
SET RCB="EFT"
SET RCC="CHK"
+73 ;correct display for paper eob
IF RCTITLE["EOB"
SET RCB="ERA"
SET RCC="EOB"
+74 SET RCDTXT=$PIECE(RCLTXT,RCB,1)_RCC_$PIECE(RCLTXT,RCB,2)
End DoDot:3
End DoDot:2
+75 IF 'RCDISP!RCEXCEL
Begin DoDot:2
+76 SET RCSTRDTA=$PIECE(RCSCDATA,U,I)
+77 ;Format lines: lines 2&3 are amounts, 4 is a percentage, remainder are integers.
+78 SET RCSTRNG=RCDTXT_"^"_$SELECT(I=4:$JUSTIFY($PIECE(RCSTRDTA,"."),2)_"%",1:RCSTRDTA)
+79 IF 'RCDISP
DO SAVEDATA^RCDPENR1(RCSTRNG,RCRPIEN)
QUIT
+80 ;if printing in an EXCEL format, print "^" delimited and quit
+81 IF RCEXCEL
WRITE RCSTRNG,!
QUIT
End DoDot:2
QUIT
+82 ;Output to screen
+83 ;currency format
+84 IF (I=2)!(I=3)!(I=15)
WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13,2),!
QUIT
+85 ; For the line items that are percentages. Not using $J formatting due to rounding errors.
+86 IF I=4
WRITE RCDTXT,?65,$JUSTIFY($PIECE($PIECE(RCSCDATA,U,I),"."),12),"%",!
QUIT
+87 ;Otherwise print Number format
+88 IF (I=16)
Begin DoDot:2
+89 if RCERAFLG
WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13,2),!
End DoDot:2
QUIT
+90 WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13),!
End DoDot:1
if RCSTOP
QUIT
+91 IF RCSTOP
QUIT RCSTOP
+92 ;Otherwise print Number format
IF RCDISP
WRITE RCLINE,!
+93 IF 'RCDISP
DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
+94 QUIT RCSTOP
+95 ;
GDTXT ; Moved from ^RCDPENR3 because of routine size PRCA*4.5*446
+1 ;;TOTAL NUMBER OF CLAIMS
+2 ;;TOTAL AMOUNT BILLED
+3 ;;TOTAL AMOUNT PAID
+4 ;;PERCENTAGE AMOUNT PAID: (%Total Paid/Billed)
+5 ;;
+6 ;;AVG #DAYS BETWEEN BILLED/ERA
+7 ;;AVG #DAYS BETWEEN ERA/EFT
+8 ;;AVG #DAYS BETWEEN ERA+EFT REC'D/PMT POSTED
+9 ;;AVG #DAYS BETWEEN BILLED/PMT POSTED
+10 ;;
+11 ;;TOTAL NUMBER OF ERAs
+12 ;;TOTAL NUMBER OF EEOBs
+13 ;;
+14 ;;TOTAL NUMBER OF EFTs
+15 ;;TOTAL AMOUNT COLLECTED
+16 ;;TOTAL DIFFERENCE BETWEEN ERAs (PAID) - EFTs (COLLECTED):
+17 QUIT
+18 ;
PRINTHDR(RCTITLE,RCLL,RCNOLINE) ;
+1 ; PRCA*4.5*446 - Moved from RCDPENR2 for size, add RCLL as parameter for line length, add RCNOLINE to suppress line
+2 ;
+3 ; Undeclared parameters
+4 ; RCLINE - line of "-" for report formating
+5 ; RCSUMFLG - Type of report (M=Main,S=Summary,G=Grand Total)
+6 ; RCDISP - Is the report being email (0) or Printed (1)
+7 ; RCRPIEN - IEN to store the report if emailing
+8 ;
+9 ;PRCA*4.5*446
IF '$LENGTH($GET(RCNOLINE))
SET RCNOLINE=0
+10 ;PRCA*4.5*446 If Line Length isn't set, make it 79
IF 'RCLL
SET RCLL=79
+11 IF $GET(RCEXCEL)
QUIT 0
+12 ;PRCA*4.5*446 Add PAD,PAD1,PAD2,X
NEW PAD,PAD1,PAD2,RCBORDER,RCSTOP,RCSTR,X
+13 ;
+14 ;PRCA*4.5*446 PAD is a variable of spaces to pad title
SET RCBORDER=""
SET $PIECE(RCBORDER,"*",20)=""
SET $PIECE(PAD," ",132)=""
SET RCSTOP=0
+15 IF $Y>(IOSL-7)
IF RCDISP
Begin DoDot:1
+16 DO ASK^RCDPEADP(.RCSTOP,0)
+17 if RCSTOP
QUIT
+18 DO HEADER^RCDPENR2
End DoDot:1
+19 IF RCSTOP
QUIT RCSTOP
+20 ;
+21 ; Display report type being displayed
+22 SET X=$LENGTH(RCBORDER)+$LENGTH(RCTITLE)+$LENGTH(RCBORDER)
+23 SET X=RCLL-X
+24 ;PRCA*4.5*446 Calculate # spaces for PAD1, PAD2 to center title
SET PAD1=$EXTRACT(PAD,1,(X/2\1))
SET PAD2=$EXTRACT(PAD,1,(X/2+.5\1))
+25 IF 'RCDISP
Begin DoDot:1
+26 ;PRCA*4.5*446 Replace spaces with PAD1, PAD2 to center title
SET RCSTR=RCBORDER_PAD1_RCTITLE_PAD2_RCBORDER
+27 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
+28 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
End DoDot:1
QUIT
+29 IF RCDISP
Begin DoDot:1
+30 ;PRCA*4.5*446 Replace spaces with PAD1, PAD2 to center title
WRITE RCBORDER,PAD1,RCTITLE,PAD2,RCBORDER,!
+31 ;PRCA*4.5*446
if 'RCNOLINE
WRITE RCLINE,!
End DoDot:1
+32 ;
+33 QUIT RCSTOP
+34 ;
ASKSORT() ; EP from RCDPENR2 - added for PRCA*4.5*446
+1 ; Input: N/A
+2 ; Returns: -1 - User ^ or timed out
+3 ; P - Sort by Payer
+4 ; A - Sort by Amount of payment
+5 ;
+6 NEW DA,DIR,DTOUT,DUOUT,X,Y,DIRUT,DIROUT,RCTYPE,RETURN
+7 SET RCTYPE=""
+8 SET DIR("?",1)="Enter 'P' to sort by Payer"
+9 SET DIR("?")=" 'A' to sort by Amount of payment"
+10 SET DIR(0)="SA^P:PAYER;A:AMOUNT OF PAYMENT"
+11 SET DIR("A")="SORT BY (P)AYER or (A)MOUNT OF PAYMENT: "
+12 SET DIR("B")=$SELECT($GET(DEF)'="":DEF,1:"PAYER")
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+16 if Y=""
QUIT "P"
+17 SET RETURN=$EXTRACT(Y)
+18 QUIT RETURN
+19 ;
+20 ;Print the Detailed portion of the report, sort by amount
MAINAMT(RCPUZ,RCAUTO,RCEXCEL) ;
+1 ; ***** IMPORTANT ***** If this section needs to be modified, also check MAIN^RCDPENR2
+2 ; New subroutine for PRCA*4.5*446, copied from MAIN^RCDPENR2 and modified for sort by amount
+3 ;
+4 ; PRCA*4.5*446
if '$LENGTH($GET(RCPUZ))
SET RCPUZ="A"
+5 ;
+6 NEW I,RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCCLAIM,RCBILL
+7 NEW RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
+8 NEW RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCNOLINE,RCTOTDY,RCTMP,RCSTOP,RCIDX,RCSUB6
+9 ;
+10 SET RCMETHOD=""
SET RCSTOP=0
+11 SET RCNOLINE=1
+12 FOR
SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD))
if RCMETHOD=""
QUIT
Begin DoDot:1
+13 ; PRCA*4.5*349
IF (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST"))
QUIT
+14 IF RCPUZ="U"
IF RCMETHOD'="UNPOSTED"
QUIT
+15 IF RCPUZ="Z"
IF RCMETHOD'="UNPOSTED"
QUIT
+16 IF RCPUZ="P"
IF RCMETHOD="UNPOSTED"
QUIT
+17 ;
+18 ;PRCA*4.5*446 131=line length, RCNOLINE
SET RCSTOP=$$PRINTHDR^RCDPENR5(RCMETHOD,131,RCNOLINE)
+19 if RCSTOP
QUIT
+20 ;
+21 ; PRCA*4.5*349
IF '$GET(RCEXCEL)
IF $ORDER(^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD,""))=""
Begin DoDot:2
+22 ; PRCA*4.5*349
WRITE "No data captured for this section during the specified time period.",!
End DoDot:2
+23 ;
+24 SET RCAMTBL=""
+25 FOR
SET RCAMTBL=$ORDER(^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD,RCAMTBL))
if RCAMTBL=""
QUIT
Begin DoDot:2
+26 SET RCSUB6=""
+27 FOR
SET RCSUB6=$ORDER(^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD,RCAMTBL,RCSUB6))
if RCSUB6=""
QUIT
Begin DoDot:3
+28 SET RCDATA=^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD,RCAMTBL,RCSUB6)
+29 SET I=$PIECE(RCDATA,U,19)
+30 IF RCPUZ="U"
IF I'=4
QUIT
+31 IF RCPUZ="Z"
IF I'=5
QUIT
+32 IF RCPUZ="P"
IF I>3
QUIT
+33 ; Must be EFT/ERA(1) for autopost. Exclude Paper Check(2), Paper EOB(3)
IF RCPUZ="P"
IF RCMETHOD="AUTOPOST"
IF I'=1
QUIT
+34 ;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.
+35 ;
+36 ; Unmatched and Zero pay are Unposted
IF RCMETHOD="MANUAL"
IF I>3
QUIT
+37 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
IF RCMETHOD="AUTOPOST"
IF I>1
QUIT
+38 ; Unmatched and Zero pay are Unposted
IF RCMETHOD="UNPOSTED"
IF I<4
QUIT
+39 ;
+40 IF $Y>(IOSL-5)
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER^RCDPENR2
+41 ;Init display values for the days
+42 SET RCCLAIM=$PIECE(RCDATA,U,20)
+43 SET (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
+44 SET RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
+45 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)
+46 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)
+47 ; 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)
+48 ; 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)
+49 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)
+50 ;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"
+51 IF RCEXCEL
Begin DoDot:4
+52 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)
+53 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)
+54 SET RCTMP=RCTMP_"^"_$PIECE(RCDATA,U,14)_"^"_$PIECE(RCDATA,U,2)_"^"_$PIECE(RCDATA,U,15)_"^"_$PIECE(RCDATA,U,3)_"^"
+55 SET RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
+56 ;PRCA*4.5*446 posted date is N/A for Unmatched and Zero Pay
IF I=4
SET $PIECE(RCTMP,"^",8)="N/A"
+57 WRITE RCTMP,!
End DoDot:4
+58 IF 'RCEXCEL
Begin DoDot:4
+59 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)
+60 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),!
+61 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)
+62 WRITE ?67,$JUSTIFY(RCEEDY,8),?83,$JUSTIFY(RCEPDY,8),?106,$JUSTIFY(RCBPDY,8),!
+63 WRITE ?10,$PIECE(RCDATA,U,17),!
End DoDot:4
End DoDot:3
if RCSTOP
QUIT
End DoDot:2
if RCSTOP
QUIT
+64 ;I '$G(RCEXCEL) W RCLINE,! ; PRCA*4.5*466, Remove line of "-"
End DoDot:1
if RCSTOP
QUIT
+65 ;
+66 IF RCSTOP
QUIT RCSTOP
+67 ; Section break - ask user if they wish to continue...
+68 ;
+69 QUIT RCSTOP
+70 ;
