RCDPENR3 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report, part 2 ;20 Aug 2018 13:01:41
;;4.5;Accounts Receivable;**304,321,326,332,349,432**;Mar 20, 1995;Build 16
;;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
;
Q
;
;
;Generate the needed statistics for the report
COMPILE ;
;
;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT"
; needed for the correct report sort order
N I,J,RCINSTIN,RCERATYP,RCCLAIM,RCDATA,RCDAYS,RCEFTPD,RCEPDT,RCERAIEN,RCERANUM,RCEFTIEN ; Looping variable
N RCGPDATA,RCGPCT,RCGPBILL,RCGPPD,RCGPBECT,RCGPBEDY,RCGPEECT,RCGPEEDY,RCGPEPCT,RCGPEPDY,RCGPBPCT,RCGPBPDY,RCGPECT,RCGPENM,RCGPFCT,RCGPFPD ; Grand Total W/Payment method variables
N RCPPDATA,RCPPCT,RCPPBILL,RCPPPD,RCPPBECT,RCPPBEDY,RCPPEECT,RCPPEEDY,RCPPEPCT,RCPPEPDY,RCPPBPCT,RCPPBPDY,RCPPECT,RCPPENM,RCPPFCT,RCPPFPD ; Payer W/Payment method variables
;
;Initialize all valid ERA/EFT combinations to report on.
; init grand total
F I=1:1:3 D ; US 767
. I '$D(^TMP("RCDPENR2",$J,"GTOT","MANUAL",I)) S ^TMP("RCDPENR2",$J,"GTOT","MANUAL",I)=0 ; PRCA*4.5*349
. I '$D(^TMP("RCDPENR2",$J,"GTOT","AUTOPOST",I)) S ^TMP("RCDPENR2",$J,"GTOT","AUTOPOST",I)=0 ; PRCA*4.5*349
;
; init insurance grand totals
S RCINSTIN=""
F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D
. F I=1:1:3 D ;
. . I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"MANUAL",I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"MANUAL",I)=0 ; PRCA*4.5*349
. . I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"AUTOPOST",I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"AUTOPOST",I)=0 ; PRCA*4.5*349
;
; Compile results
S RCINSTIN=""
F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN)) Q:RCINSTIN="" D
. S RCMETHOD="" ; PRCA*4.5*349
. F S RCMETHOD=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD)) Q:RCMETHOD="" D ; PRCA*4.5*349 add $O on RCMETHOD
. . S RCERATYP="" ; PRCA*4.5*349 add 1 "." to this line and every line below
. . F S RCERATYP=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP)) Q:RCERATYP="" D
. . . S RCCLAIM=""
. . . F S RCCLAIM=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)) Q:RCCLAIM="" D
. . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
. . . . Q:RCDATA=""
. . . . I RCAUTO="A"&(RCMETHOD="M")!(RCAUTO="N"&(RCMETHOD="A")) Q ; PRCA*4.5*349
. . . . F J=RCMETHOD,"TOTAL" D COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)
Q
;
COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM) ; PRCA*4.5*349 subroutine split off
; Extract the Grand Total by EFT/ERA type
S RCGPDATA=$G(^TMP("RCDPENR2",$J,"GTOT",J,RCERATYP))
S RCGPCT=$P(RCGPDATA,U)
S RCGPBILL=$P(RCGPDATA,U,2)
S RCGPPD=$P(RCGPDATA,U,3)
S RCGPBECT=$P(RCGPDATA,U,4)
S RCGPBEDY=$P(RCGPDATA,U,5)
S RCGPEECT=$P(RCGPDATA,U,6)
S RCGPEEDY=$P(RCGPDATA,U,7)
S RCGPEPCT=$P(RCGPDATA,U,8)
S RCGPEPDY=$P(RCGPDATA,U,9)
S RCGPBPCT=$P(RCGPDATA,U,10)
S RCGPBPDY=$P(RCGPDATA,U,11)
S RCGPECT=$P(RCGPDATA,U,12)
S RCGPENM=$P(RCGPDATA,U,13)
S RCGPFCT=$P(RCGPDATA,U,14)
S RCGPFPD=$P(RCGPDATA,U,15)
;
; Extract the Payer specific information by EFT/ERA type
S RCPPDATA=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,J,RCERATYP))
S RCPPCT=$P(RCPPDATA,U)
S RCPPBILL=$P(RCPPDATA,U,2)
S RCPPPD=$P(RCPPDATA,U,3)
S RCPPBECT=$P(RCPPDATA,U,4)
S RCPPBEDY=$P(RCPPDATA,U,5)
S RCPPEECT=$P(RCPPDATA,U,6)
S RCPPEEDY=$P(RCPPDATA,U,7)
S RCPPEPCT=$P(RCPPDATA,U,8)
S RCPPEPDY=$P(RCPPDATA,U,9)
S RCPPBPCT=$P(RCPPDATA,U,10)
S RCPPBPDY=$P(RCPPDATA,U,11)
S RCPPECT=$P(RCPPDATA,U,12)
S RCPPENM=$P(RCPPDATA,U,13)
S RCPPFCT=$P(RCPPDATA,U,14)
S RCPPFPD=$P(RCPPDATA,U,15)
;
; Total counts - Grand/Payment Method
S RCGPCT=RCGPCT+1
S RCGPBILL=RCGPBILL+$P(RCDATA,U,6)
S RCGPPD=RCGPPD+$P(RCDATA,U,7)
;
; Total counts - Payer/Payment method
S RCPPCT=RCPPCT+1
S RCPPBILL=RCPPBILL+$P(RCDATA,U,6)
S RCPPPD=RCPPPD+$P(RCDATA,U,7)
;
; Billed to ERA received
I $P(RCDATA,U,8),$P(RCDATA,U,9) D
. S RCGPBECT=RCGPBECT+1
. S RCPPBECT=RCPPBECT+1
. S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,9),$P(RCDATA,U,8),1)
. S RCGPBEDY=RCGPBEDY+RCDAYS
. S RCPPBEDY=RCPPBEDY+RCDAYS
;
; ERA to EFT received
I $P(RCDATA,U,10),$P(RCDATA,U,9) D
. S RCGPEECT=RCGPEECT+1
. S RCPPEECT=RCPPEECT+1
. S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,10),$P(RCDATA,U,9),1)
. S RCGPEEDY=RCGPEEDY+RCDAYS
. S RCPPEEDY=RCPPEEDY+RCDAYS
;
; ERA and EFT received, and payment Posted
I $P(RCDATA,U,10),$P(RCDATA,U,9),$P(RCDATA,U,11) D
. S RCGPEPCT=RCGPEPCT+1
. S RCPPEPCT=RCPPEPCT+1
. S RCEPDT=$S($P(RCDATA,U,9)>$P(RCDATA,U,10):9,1:10) ;determine which date is later
. S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,RCEPDT),1)
. S RCGPEPDY=RCGPEPDY+RCDAYS
. S RCPPEPDY=RCPPEPDY+RCDAYS
;
; Bill to Payment Posted
I $P(RCDATA,U,8),$P(RCDATA,U,11) D
. S RCGPBPCT=RCGPBPCT+1
. S RCPPBPCT=RCPPBPCT+1
. S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,8),1)
. S RCGPBPDY=RCGPBPDY+RCDAYS
. S RCPPBPDY=RCPPBPDY+RCDAYS
;
; If the ERA hasn't already been counted, add it to the totals
S RCERAIEN=$P(RCDATA,U,2)
I RCERAIEN,'$D(^TMP("RCDPENR2",$J,"ERA",RCERAIEN,J)) D
. S ^TMP("RCDPENR2",$J,"ERA",RCERAIEN,J)=""
. S RCERANUM=$P(RCDATA,U,15)
. S RCGPECT=RCGPECT+1,RCPPECT=RCPPECT+1
. S RCGPENM=RCGPENM+RCERANUM,RCPPENM=RCPPENM+RCERANUM
;
; If the EFT hasn't already been counted, add it to the totals
S RCEFTIEN=$P(RCDATA,U,3)
I (RCEFTIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCEFTIEN,J))) D
. S ^TMP("RCDPENR2",$J,"EFT",RCEFTIEN,J)=""
. S RCEFTPD=$P(RCDATA,U,18)
. S RCGPFCT=RCGPFCT+1,RCPPFCT=RCPPFCT+1
. S RCGPFPD=RCGPFPD+RCEFTPD,RCPPFPD=RCPPFPD+RCEFTPD
;
; Update the payer specific information By Payment Method
S $P(RCPPDATA,U)=RCPPCT
S $P(RCPPDATA,U,2)=RCPPBILL
S $P(RCPPDATA,U,3)=RCPPPD
S $P(RCPPDATA,U,4)=RCPPBECT
S $P(RCPPDATA,U,5)=RCPPBEDY
S $P(RCPPDATA,U,6)=RCPPEECT
S $P(RCPPDATA,U,7)=RCPPEEDY
S $P(RCPPDATA,U,8)=RCPPEPCT
S $P(RCPPDATA,U,9)=RCPPEPDY
S $P(RCPPDATA,U,10)=RCPPBPCT
S $P(RCPPDATA,U,11)=RCPPBPDY
S $P(RCPPDATA,U,12)=RCPPECT
S $P(RCPPDATA,U,13)=RCPPENM
S $P(RCPPDATA,U,14)=RCPPFCT
S $P(RCPPDATA,U,15)=RCPPFPD
S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,J,RCERATYP)=RCPPDATA
;
; Update the Grand Total specific information By Payment Method
S $P(RCGPDATA,U)=RCGPCT
S $P(RCGPDATA,U,2)=RCGPBILL
S $P(RCGPDATA,U,3)=RCGPPD
S $P(RCGPDATA,U,4)=RCGPBECT
S $P(RCGPDATA,U,5)=RCGPBEDY
S $P(RCGPDATA,U,6)=RCGPEECT
S $P(RCGPDATA,U,7)=RCGPEEDY
S $P(RCGPDATA,U,8)=RCGPEPCT
S $P(RCGPDATA,U,9)=RCGPEPDY
S $P(RCGPDATA,U,10)=RCGPBPCT
S $P(RCGPDATA,U,11)=RCGPBPDY
S $P(RCGPDATA,U,12)=RCGPECT
S $P(RCGPDATA,U,13)=RCGPENM
S $P(RCGPDATA,U,14)=RCGPFCT
S $P(RCGPDATA,U,15)=RCGPFPD
S ^TMP("RCDPENR2",$J,"GTOT",J,RCERATYP)=RCGPDATA ; PRCA*4.5*349
Q
;
;Retrieve all necessary information for the EFTs sent during the requested period.
; PRCA*4.5*349 - Add Closed Claims filter
GETEFT(RCSDATE,RCEDATE,RCRATE,RCCLM) ;EP
;RCSDATE - Start date of extraction
;RCEDATE - End date of extraction
;
;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) =
; Where:
; Piece Variable
; 1 RCBILL - IEN of Bill/Claim #
; 2 RCERA - IEN of the ERA the bill was paid on.
; 3 RCIEN - IEN of the EFT the money for the bill arrived on
; 4 RCEOB - IEN of the EOB within the ERA
; 5 RCDOS - Date of Service
; 6 RCAMTBL - Amount Billed
; 7 RCAMTPD - Amount Paid
; 8 RCDTBILL - Date of Bill
; 9 RCERARCD - Date ERA received
; 10 RCEFTRCD - Date EFT received
; 11 RCPOSTED - Date Payment Posted to claim
; 12 RCTRACE - ERA Trace number for EOB
; 13 RCMETHOD - Method of Payment transmittal
; 14 RCTRNTYP - Was payment EFT or Paper Check / Was the ERA Paper or EDI Lockbox
; 15 RCERANUM - # EOB'S in ERA
; 16 RCDIV - Division of the bill
; 17 RCINSTIN - Insurance/Insurance TIN
; 18 RCEFTPD - Amount paid as an EFT, not as a check.
;
N OKAY,RCLDATE,RCINS,RCIEN,RCEFTDT,RCERA,RCEFT,RCRCPT,RCPOSTED,RCPAYTYP,RCERADT,RCTRACE,RCERAIDX
N RCTRLN,RCTRBD,RCERANUM,RCTIN,RCPAYER,RCINSTIN,RCLPIEN,RCDTDATA,RCEOB,RCBILL,RCDIV,RCDOS,RCAMTBL
N RCDTBILL,RCMETHOD,RCPAPER,RCEFTTYP,RCEFTPD,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP
N RCMSTAT,RCESUMDT,RCPSUMDT,X,ZZPNAME ; PRCA*4.5*349
;
;Get the EFT Detail information for the report batches sent within the given date range.
S RCLDATE=RCSDATE-.001
F S RCLDATE=$O(^RCY(344.31,"ADR",RCLDATE)) Q:RCLDATE="" Q:RCLDATE>RCEDATE D
. S RCIEN=0
. F S RCIEN=$O(^RCY(344.31,"ADR",RCLDATE,RCIEN)) Q:'RCIEN D
. . S RCEFTDT=$G(^RCY(344.31,RCIEN,0))
. . Q:RCEFTDT=""
. . I '$$CHKEFT^RCDPEU1(RCIEN) Q ; Only include posted EFTs - PRCA*4.5*349
. . I RCPAY="A",RCTYPE'="A" D Q:'OKAY ; PRCA*4.5*326 If all payers included, check by type
. . . S OKAY=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE)
. . ; Check Payer Name
. . I RCPAY'="A" D Q:'OKAY ; PRCA*4.5*326
. . . S OKAY=$$ISSEL^RCDPEU1(344.31,RCIEN)
. . ;
. . S RCERA=$P(RCEFTDT,U,10) ; ERA IEN
. . S RCEFTRCD=$P(RCEFTDT,U,13)
. . S RCEFT=$P(RCEFTDT,U)
. . S ZZPNAME=$P(RCEFTDT,U,2)
. . S RCMSTAT=$P(RCEFTDT,U,8)
. . S RCRCPT=$P(RCEFTDT,U,9)
. . S RCEFTPD=$P(RCEFTDT,U,7)
. . S RCPOSTED=$$GET1^DIQ(344.3,RCEFT_",",.11,"I")
. . S RCPAYTYP=$$GET1^DIQ(344,RCRCPT_",",.04,"I")
. . I RCERA D Q
. . . S RCERADT=$G(^RCY(344.4,RCERA,0)) ; ERA Data extracted
. . . Q:'RCERADT
. . . S RCTRACE=$P(RCERADT,U,2) ; Trace #
. . . S RCTRLN=$L(RCTRACE),RCTRBD=$S(RCTRLN<11:1,1:RCTRLN-9)
. . . S RCTRACE=$E(RCTRACE,RCTRBD,RCTRLN) ; get the last 10 digits of Trace #
. . . S RCERARCD=$P($P(RCERADT,U,7),".",1) ;get the date of the ERA
. . . S RCERANUM=$P(RCERADT,U,11)
. . . S RCTIN=$P(RCERADT,U,3)
. . . S RCINS=$P(RCERADT,U,6)
. . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN
. . . ; Q:'RCPAYER ; Quit if Payer/TIN not found
. . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
. . . S RCINSTIN=RCINS_"/"_RCTIN
. . . S RCLPIEN=0
. . . F S RCLPIEN=$O(^RCY(344.4,RCERA,1,RCLPIEN)) Q:'RCLPIEN D
. . . . ; I $$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",.25,"I")="" Q ; PRCA*4.5*349 - No receipt, line is not posted
. . . . S RCDTDATA=$G(^RCY(344.4,RCERA,1,RCLPIEN,0))
. . . . S RCEOB=$P(RCDTDATA,U,2)
. . . . S RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
. . . . Q:RCBILL="" ; no billing information
. . . . I RCCLM="C",'$$CLOSEDB(RCBILL) Q ; Bill isn't closed - PRCA*4.5*349 added line
. . . . Q:$D(^TMP("RCDPENR2",$J,"MAIN",RCBILL)) ;already captured.
. . . . S RCDIV=$$DIV^IBJDF2(RCBILL)
. . . . S RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
. . . . ;
. . . . S RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
. . . . Q:RCRATETP'=RCRATE
. . . . ; Quit if user specified a specific division and bill is not in that Division
. . . . I '$D(^TMP("RCDPENR2",$J,"DIVALL"))&'$D(^TMP("RCDPENR2",$J,"DIV",RCDIV)) Q
. . . . S RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
. . . . S RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
. . . . S RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
. . . . S RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
. . . . Q:RCDTBILL="" ;cant calculate if date first printed is NULL
. . . . ;
. . . . S RCMETHOD=$S($$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",9,"I")="":"MANUAL",1:"AUTOPOST") ; PRCA*4.5*349
. . . . S RCPAPER=$P($G(^RCY(344.4,RCERA,20)),U,3) ; Paper EOB ERA?
. . . . ;ERA not a paper ERA, is the EOB a Paper EOB
. . . . S:'RCPAPER RCPAPER=$S($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
. . . . S RCEFTTYP=$S(RCPAYTYP=4:"PAPER",1:"EFT")
. . . . S RCTRNTYP=RCPAPER_"/"_RCEFTTYP
. . . . S RCERAIDX=$S(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
. . . . Q:RCERAIDX=4 ;Paper Check Paper EOB not supported
. . . . S RCDATA=RCBILL_U_RCERA_U_RCIEN_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
. . . . S RCDATA=RCDATA_U_RCEFTRCD_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
. . . . S RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U_RCEFTPD
. . . . S ^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL)=RCDATA ; PRCA*4.5*349 add post method
. . I (RCMSTAT=2),(RCIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCIEN))) D
. . . S RCTIN=$P(RCEFTDT,U,3)
. . . S RCINS=$P(RCEFTDT,U,2)
. . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN
. . . ; Q:'RCPAYER ; Quit if Payer/TIN not found
. . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
. . . S RCINSTIN=RCINS_"/"_RCTIN
. . . S RCMETHOD="MANUAL" ; PRCA*4.5*349 - Unmatched EFT must be manually posted
. . . F X=RCMETHOD,"TOTAL" D ; PRCA*4.5*349
. . . . S RCESUMDT=$G(^TMP("RCDPENR2",$J,"GTOT",X,3)) ; PRCA*4.5*349
. . . . S RCPSUMDT=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,X,3)) ; PRCA*4.5*349
. . . . S $P(RCESUMDT,U,14)=$P(RCESUMDT,U,14)+1
. . . . S $P(RCPSUMDT,U,14)=$P(RCPSUMDT,U,14)+1
. . . . S $P(RCESUMDT,U,15)=$P(RCESUMDT,U,15)+RCEFTPD
. . . . S $P(RCPSUMDT,U,15)=$P(RCPSUMDT,U,15)+RCEFTPD
. . . . S ^TMP("RCDPENR2",$J,"GTOT",X,3)=RCESUMDT ; PRCA*4.5*349
. . . . S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,X,3)=RCPSUMDT ; PRCA*4.5*349
Q
;
CLOSEDB(RCBILL) ;EP
; PRCA*4.5*349 - Added subroutine
; Check to see if a bill is closed
; Input: RCBILL - IEN for 361.1 of the bill to be checked
; Returns: 1 - Bill is closed, 0 Otherwise
N XX
S XX=$$GET1^DIQ(430,RCBILL_",",8,"I")
S XX=$$GET1^DIQ(430.3,XX_",",1)
I XX="CC" Q 1
Q 0
;
;Print the Grand Total/Summary data for the EFT/ERA Trending Report
PRINTGT(RCTITLE,RCDATA,RCDISP,RCERAFLG,RCEXCEL) ;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
; 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 '-' to be used as a 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,I,RCSTRDTA,RCSTRNG,RCDTXT
;
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)
;
; 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)
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 ;
;;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR3 18477 printed Dec 13, 2024@01:45:03 Page 2
RCDPENR3 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report, part 2 ;20 Aug 2018 13:01:41
+1 ;;4.5;Accounts Receivable;**304,321,326,332,349,432**;Mar 20, 1995;Build 16
+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 ;
+9 QUIT
+10 ;
+11 ;
+12 ;Generate the needed statistics for the report
COMPILE ;
+1 ;
+2 ;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT"
+3 ; needed for the correct report sort order
+4 ; Looping variable
NEW I,J,RCINSTIN,RCERATYP,RCCLAIM,RCDATA,RCDAYS,RCEFTPD,RCEPDT,RCERAIEN,RCERANUM,RCEFTIEN
+5 ; Grand Total W/Payment method variables
NEW RCGPDATA,RCGPCT,RCGPBILL,RCGPPD,RCGPBECT,RCGPBEDY,RCGPEECT,RCGPEEDY,RCGPEPCT,RCGPEPDY,RCGPBPCT,RCGPBPDY,RCGPECT,RCGPENM,RCGPFCT,RCGPFPD
+6 ; Payer W/Payment method variables
NEW RCPPDATA,RCPPCT,RCPPBILL,RCPPPD,RCPPBECT,RCPPBEDY,RCPPEECT,RCPPEEDY,RCPPEPCT,RCPPEPDY,RCPPBPCT,RCPPBPDY,RCPPECT,RCPPENM,RCPPFCT,RCPPFPD
+7 ;
+8 ;Initialize all valid ERA/EFT combinations to report on.
+9 ; init grand total
+10 ; US 767
FOR I=1:1:3
Begin DoDot:1
+11 ; PRCA*4.5*349
IF '$DATA(^TMP("RCDPENR2",$JOB,"GTOT","MANUAL",I))
SET ^TMP("RCDPENR2",$JOB,"GTOT","MANUAL",I)=0
+12 ; PRCA*4.5*349
IF '$DATA(^TMP("RCDPENR2",$JOB,"GTOT","AUTOPOST",I))
SET ^TMP("RCDPENR2",$JOB,"GTOT","AUTOPOST",I)=0
End DoDot:1
+13 ;
+14 ; init insurance grand totals
+15 SET RCINSTIN=""
+16 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+17 ;
FOR I=1:1:3
Begin DoDot:2
+18 ; PRCA*4.5*349
IF '$DATA(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"MANUAL",I))
SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"MANUAL",I)=0
+19 ; PRCA*4.5*349
IF '$DATA(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"AUTOPOST",I))
SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"AUTOPOST",I)=0
End DoDot:2
End DoDot:1
+20 ;
+21 ; Compile results
+22 SET RCINSTIN=""
+23 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+24 ; PRCA*4.5*349
SET RCMETHOD=""
+25 ; PRCA*4.5*349 add $O on RCMETHOD
FOR
SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD))
if RCMETHOD=""
QUIT
Begin DoDot:2
+26 ; PRCA*4.5*349 add 1 "." to this line and every line below
SET RCERATYP=""
+27 FOR
SET RCERATYP=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP))
if RCERATYP=""
QUIT
Begin DoDot:3
+28 SET RCCLAIM=""
+29 FOR
SET RCCLAIM=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
if RCCLAIM=""
QUIT
Begin DoDot:4
+30 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
+31 if RCDATA=""
QUIT
+32 ; PRCA*4.5*349
IF RCAUTO="A"&(RCMETHOD="M")!(RCAUTO="N"&(RCMETHOD="A"))
QUIT
+33 FOR J=RCMETHOD,"TOTAL"
DO COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM) ; PRCA*4.5*349 subroutine split off
+1 ; Extract the Grand Total by EFT/ERA type
+2 SET RCGPDATA=$GET(^TMP("RCDPENR2",$JOB,"GTOT",J,RCERATYP))
+3 SET RCGPCT=$PIECE(RCGPDATA,U)
+4 SET RCGPBILL=$PIECE(RCGPDATA,U,2)
+5 SET RCGPPD=$PIECE(RCGPDATA,U,3)
+6 SET RCGPBECT=$PIECE(RCGPDATA,U,4)
+7 SET RCGPBEDY=$PIECE(RCGPDATA,U,5)
+8 SET RCGPEECT=$PIECE(RCGPDATA,U,6)
+9 SET RCGPEEDY=$PIECE(RCGPDATA,U,7)
+10 SET RCGPEPCT=$PIECE(RCGPDATA,U,8)
+11 SET RCGPEPDY=$PIECE(RCGPDATA,U,9)
+12 SET RCGPBPCT=$PIECE(RCGPDATA,U,10)
+13 SET RCGPBPDY=$PIECE(RCGPDATA,U,11)
+14 SET RCGPECT=$PIECE(RCGPDATA,U,12)
+15 SET RCGPENM=$PIECE(RCGPDATA,U,13)
+16 SET RCGPFCT=$PIECE(RCGPDATA,U,14)
+17 SET RCGPFPD=$PIECE(RCGPDATA,U,15)
+18 ;
+19 ; Extract the Payer specific information by EFT/ERA type
+20 SET RCPPDATA=$GET(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,J,RCERATYP))
+21 SET RCPPCT=$PIECE(RCPPDATA,U)
+22 SET RCPPBILL=$PIECE(RCPPDATA,U,2)
+23 SET RCPPPD=$PIECE(RCPPDATA,U,3)
+24 SET RCPPBECT=$PIECE(RCPPDATA,U,4)
+25 SET RCPPBEDY=$PIECE(RCPPDATA,U,5)
+26 SET RCPPEECT=$PIECE(RCPPDATA,U,6)
+27 SET RCPPEEDY=$PIECE(RCPPDATA,U,7)
+28 SET RCPPEPCT=$PIECE(RCPPDATA,U,8)
+29 SET RCPPEPDY=$PIECE(RCPPDATA,U,9)
+30 SET RCPPBPCT=$PIECE(RCPPDATA,U,10)
+31 SET RCPPBPDY=$PIECE(RCPPDATA,U,11)
+32 SET RCPPECT=$PIECE(RCPPDATA,U,12)
+33 SET RCPPENM=$PIECE(RCPPDATA,U,13)
+34 SET RCPPFCT=$PIECE(RCPPDATA,U,14)
+35 SET RCPPFPD=$PIECE(RCPPDATA,U,15)
+36 ;
+37 ; Total counts - Grand/Payment Method
+38 SET RCGPCT=RCGPCT+1
+39 SET RCGPBILL=RCGPBILL+$PIECE(RCDATA,U,6)
+40 SET RCGPPD=RCGPPD+$PIECE(RCDATA,U,7)
+41 ;
+42 ; Total counts - Payer/Payment method
+43 SET RCPPCT=RCPPCT+1
+44 SET RCPPBILL=RCPPBILL+$PIECE(RCDATA,U,6)
+45 SET RCPPPD=RCPPPD+$PIECE(RCDATA,U,7)
+46 ;
+47 ; Billed to ERA received
+48 IF $PIECE(RCDATA,U,8)
IF $PIECE(RCDATA,U,9)
Begin DoDot:1
+49 SET RCGPBECT=RCGPBECT+1
+50 SET RCPPBECT=RCPPBECT+1
+51 SET RCDAYS=$$FMDIFF^XLFDT($PIECE(RCDATA,U,9),$PIECE(RCDATA,U,8),1)
+52 SET RCGPBEDY=RCGPBEDY+RCDAYS
+53 SET RCPPBEDY=RCPPBEDY+RCDAYS
End DoDot:1
+54 ;
+55 ; ERA to EFT received
+56 IF $PIECE(RCDATA,U,10)
IF $PIECE(RCDATA,U,9)
Begin DoDot:1
+57 SET RCGPEECT=RCGPEECT+1
+58 SET RCPPEECT=RCPPEECT+1
+59 SET RCDAYS=$$FMDIFF^XLFDT($PIECE(RCDATA,U,10),$PIECE(RCDATA,U,9),1)
+60 SET RCGPEEDY=RCGPEEDY+RCDAYS
+61 SET RCPPEEDY=RCPPEEDY+RCDAYS
End DoDot:1
+62 ;
+63 ; ERA and EFT received, and payment Posted
+64 IF $PIECE(RCDATA,U,10)
IF $PIECE(RCDATA,U,9)
IF $PIECE(RCDATA,U,11)
Begin DoDot:1
+65 SET RCGPEPCT=RCGPEPCT+1
+66 SET RCPPEPCT=RCPPEPCT+1
+67 ;determine which date is later
SET RCEPDT=$SELECT($PIECE(RCDATA,U,9)>$PIECE(RCDATA,U,10):9,1:10)
+68 SET RCDAYS=$$FMDIFF^XLFDT($PIECE(RCDATA,U,11),$PIECE(RCDATA,U,RCEPDT),1)
+69 SET RCGPEPDY=RCGPEPDY+RCDAYS
+70 SET RCPPEPDY=RCPPEPDY+RCDAYS
End DoDot:1
+71 ;
+72 ; Bill to Payment Posted
+73 IF $PIECE(RCDATA,U,8)
IF $PIECE(RCDATA,U,11)
Begin DoDot:1
+74 SET RCGPBPCT=RCGPBPCT+1
+75 SET RCPPBPCT=RCPPBPCT+1
+76 SET RCDAYS=$$FMDIFF^XLFDT($PIECE(RCDATA,U,11),$PIECE(RCDATA,U,8),1)
+77 SET RCGPBPDY=RCGPBPDY+RCDAYS
+78 SET RCPPBPDY=RCPPBPDY+RCDAYS
End DoDot:1
+79 ;
+80 ; If the ERA hasn't already been counted, add it to the totals
+81 SET RCERAIEN=$PIECE(RCDATA,U,2)
+82 IF RCERAIEN
IF '$DATA(^TMP("RCDPENR2",$JOB,"ERA",RCERAIEN,J))
Begin DoDot:1
+83 SET ^TMP("RCDPENR2",$JOB,"ERA",RCERAIEN,J)=""
+84 SET RCERANUM=$PIECE(RCDATA,U,15)
+85 SET RCGPECT=RCGPECT+1
SET RCPPECT=RCPPECT+1
+86 SET RCGPENM=RCGPENM+RCERANUM
SET RCPPENM=RCPPENM+RCERANUM
End DoDot:1
+87 ;
+88 ; If the EFT hasn't already been counted, add it to the totals
+89 SET RCEFTIEN=$PIECE(RCDATA,U,3)
+90 IF (RCEFTIEN)
IF ('$DATA(^TMP("RCDPENR2",$JOB,"EFT",RCEFTIEN,J)))
Begin DoDot:1
+91 SET ^TMP("RCDPENR2",$JOB,"EFT",RCEFTIEN,J)=""
+92 SET RCEFTPD=$PIECE(RCDATA,U,18)
+93 SET RCGPFCT=RCGPFCT+1
SET RCPPFCT=RCPPFCT+1
+94 SET RCGPFPD=RCGPFPD+RCEFTPD
SET RCPPFPD=RCPPFPD+RCEFTPD
End DoDot:1
+95 ;
+96 ; Update the payer specific information By Payment Method
+97 SET $PIECE(RCPPDATA,U)=RCPPCT
+98 SET $PIECE(RCPPDATA,U,2)=RCPPBILL
+99 SET $PIECE(RCPPDATA,U,3)=RCPPPD
+100 SET $PIECE(RCPPDATA,U,4)=RCPPBECT
+101 SET $PIECE(RCPPDATA,U,5)=RCPPBEDY
+102 SET $PIECE(RCPPDATA,U,6)=RCPPEECT
+103 SET $PIECE(RCPPDATA,U,7)=RCPPEEDY
+104 SET $PIECE(RCPPDATA,U,8)=RCPPEPCT
+105 SET $PIECE(RCPPDATA,U,9)=RCPPEPDY
+106 SET $PIECE(RCPPDATA,U,10)=RCPPBPCT
+107 SET $PIECE(RCPPDATA,U,11)=RCPPBPDY
+108 SET $PIECE(RCPPDATA,U,12)=RCPPECT
+109 SET $PIECE(RCPPDATA,U,13)=RCPPENM
+110 SET $PIECE(RCPPDATA,U,14)=RCPPFCT
+111 SET $PIECE(RCPPDATA,U,15)=RCPPFPD
+112 SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,J,RCERATYP)=RCPPDATA
+113 ;
+114 ; Update the Grand Total specific information By Payment Method
+115 SET $PIECE(RCGPDATA,U)=RCGPCT
+116 SET $PIECE(RCGPDATA,U,2)=RCGPBILL
+117 SET $PIECE(RCGPDATA,U,3)=RCGPPD
+118 SET $PIECE(RCGPDATA,U,4)=RCGPBECT
+119 SET $PIECE(RCGPDATA,U,5)=RCGPBEDY
+120 SET $PIECE(RCGPDATA,U,6)=RCGPEECT
+121 SET $PIECE(RCGPDATA,U,7)=RCGPEEDY
+122 SET $PIECE(RCGPDATA,U,8)=RCGPEPCT
+123 SET $PIECE(RCGPDATA,U,9)=RCGPEPDY
+124 SET $PIECE(RCGPDATA,U,10)=RCGPBPCT
+125 SET $PIECE(RCGPDATA,U,11)=RCGPBPDY
+126 SET $PIECE(RCGPDATA,U,12)=RCGPECT
+127 SET $PIECE(RCGPDATA,U,13)=RCGPENM
+128 SET $PIECE(RCGPDATA,U,14)=RCGPFCT
+129 SET $PIECE(RCGPDATA,U,15)=RCGPFPD
+130 ; PRCA*4.5*349
SET ^TMP("RCDPENR2",$JOB,"GTOT",J,RCERATYP)=RCGPDATA
+131 QUIT
+132 ;
+133 ;Retrieve all necessary information for the EFTs sent during the requested period.
+134 ; PRCA*4.5*349 - Add Closed Claims filter
GETEFT(RCSDATE,RCEDATE,RCRATE,RCCLM) ;EP
+1 ;RCSDATE - Start date of extraction
+2 ;RCEDATE - End date of extraction
+3 ;
+4 ;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) =
+5 ; Where:
+6 ; Piece Variable
+7 ; 1 RCBILL - IEN of Bill/Claim #
+8 ; 2 RCERA - IEN of the ERA the bill was paid on.
+9 ; 3 RCIEN - IEN of the EFT the money for the bill arrived on
+10 ; 4 RCEOB - IEN of the EOB within the ERA
+11 ; 5 RCDOS - Date of Service
+12 ; 6 RCAMTBL - Amount Billed
+13 ; 7 RCAMTPD - Amount Paid
+14 ; 8 RCDTBILL - Date of Bill
+15 ; 9 RCERARCD - Date ERA received
+16 ; 10 RCEFTRCD - Date EFT received
+17 ; 11 RCPOSTED - Date Payment Posted to claim
+18 ; 12 RCTRACE - ERA Trace number for EOB
+19 ; 13 RCMETHOD - Method of Payment transmittal
+20 ; 14 RCTRNTYP - Was payment EFT or Paper Check / Was the ERA Paper or EDI Lockbox
+21 ; 15 RCERANUM - # EOB'S in ERA
+22 ; 16 RCDIV - Division of the bill
+23 ; 17 RCINSTIN - Insurance/Insurance TIN
+24 ; 18 RCEFTPD - Amount paid as an EFT, not as a check.
+25 ;
+26 NEW OKAY,RCLDATE,RCINS,RCIEN,RCEFTDT,RCERA,RCEFT,RCRCPT,RCPOSTED,RCPAYTYP,RCERADT,RCTRACE,RCERAIDX
+27 NEW RCTRLN,RCTRBD,RCERANUM,RCTIN,RCPAYER,RCINSTIN,RCLPIEN,RCDTDATA,RCEOB,RCBILL,RCDIV,RCDOS,RCAMTBL
+28 NEW RCDTBILL,RCMETHOD,RCPAPER,RCEFTTYP,RCEFTPD,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP
+29 ; PRCA*4.5*349
NEW RCMSTAT,RCESUMDT,RCPSUMDT,X,ZZPNAME
+30 ;
+31 ;Get the EFT Detail information for the report batches sent within the given date range.
+32 SET RCLDATE=RCSDATE-.001
+33 FOR
SET RCLDATE=$ORDER(^RCY(344.31,"ADR",RCLDATE))
if RCLDATE=""
QUIT
if RCLDATE>RCEDATE
QUIT
Begin DoDot:1
+34 SET RCIEN=0
+35 FOR
SET RCIEN=$ORDER(^RCY(344.31,"ADR",RCLDATE,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+36 SET RCEFTDT=$GET(^RCY(344.31,RCIEN,0))
+37 if RCEFTDT=""
QUIT
+38 ; Only include posted EFTs - PRCA*4.5*349
IF '$$CHKEFT^RCDPEU1(RCIEN)
QUIT
+39 ; PRCA*4.5*326 If all payers included, check by type
IF RCPAY="A"
IF RCTYPE'="A"
Begin DoDot:3
+40 SET OKAY=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE)
End DoDot:3
if 'OKAY
QUIT
+41 ; Check Payer Name
+42 ; PRCA*4.5*326
IF RCPAY'="A"
Begin DoDot:3
+43 SET OKAY=$$ISSEL^RCDPEU1(344.31,RCIEN)
End DoDot:3
if 'OKAY
QUIT
+44 ;
+45 ; ERA IEN
SET RCERA=$PIECE(RCEFTDT,U,10)
+46 SET RCEFTRCD=$PIECE(RCEFTDT,U,13)
+47 SET RCEFT=$PIECE(RCEFTDT,U)
+48 SET ZZPNAME=$PIECE(RCEFTDT,U,2)
+49 SET RCMSTAT=$PIECE(RCEFTDT,U,8)
+50 SET RCRCPT=$PIECE(RCEFTDT,U,9)
+51 SET RCEFTPD=$PIECE(RCEFTDT,U,7)
+52 SET RCPOSTED=$$GET1^DIQ(344.3,RCEFT_",",.11,"I")
+53 SET RCPAYTYP=$$GET1^DIQ(344,RCRCPT_",",.04,"I")
+54 IF RCERA
Begin DoDot:3
+55 ; ERA Data extracted
SET RCERADT=$GET(^RCY(344.4,RCERA,0))
+56 if 'RCERADT
QUIT
+57 ; Trace #
SET RCTRACE=$PIECE(RCERADT,U,2)
+58 SET RCTRLN=$LENGTH(RCTRACE)
SET RCTRBD=$SELECT(RCTRLN<11:1,1:RCTRLN-9)
+59 ; get the last 10 digits of Trace #
SET RCTRACE=$EXTRACT(RCTRACE,RCTRBD,RCTRLN)
+60 ;get the date of the ERA
SET RCERARCD=$PIECE($PIECE(RCERADT,U,7),".",1)
+61 SET RCERANUM=$PIECE(RCERADT,U,11)
+62 SET RCTIN=$PIECE(RCERADT,U,3)
+63 SET RCINS=$PIECE(RCERADT,U,6)
+64 ; find the AR Payer IEN
SET RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME)
+65 ; Q:'RCPAYER ; Quit if Payer/TIN not found
+66 ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
+67 SET RCINSTIN=RCINS_"/"_RCTIN
+68 SET RCLPIEN=0
+69 FOR
SET RCLPIEN=$ORDER(^RCY(344.4,RCERA,1,RCLPIEN))
if 'RCLPIEN
QUIT
Begin DoDot:4
+70 ; I $$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",.25,"I")="" Q ; PRCA*4.5*349 - No receipt, line is not posted
+71 SET RCDTDATA=$GET(^RCY(344.4,RCERA,1,RCLPIEN,0))
+72 SET RCEOB=$PIECE(RCDTDATA,U,2)
+73 SET RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
+74 ; no billing information
if RCBILL=""
QUIT
+75 ; Bill isn't closed - PRCA*4.5*349 added line
IF RCCLM="C"
IF '$$CLOSEDB(RCBILL)
QUIT
+76 ;already captured.
if $DATA(^TMP("RCDPENR2",$JOB,"MAIN",RCBILL))
QUIT
+77 SET RCDIV=$$DIV^IBJDF2(RCBILL)
+78 SET RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
+79 ;
+80 SET RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
+81 if RCRATETP'=RCRATE
QUIT
+82 ; Quit if user specified a specific division and bill is not in that Division
+83 IF '$DATA(^TMP("RCDPENR2",$JOB,"DIVALL"))&'$DATA(^TMP("RCDPENR2",$JOB,"DIV",RCDIV))
QUIT
+84 SET RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
+85 SET RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
+86 SET RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
+87 SET RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
+88 ;cant calculate if date first printed is NULL
if RCDTBILL=""
QUIT
+89 ;
+90 ; PRCA*4.5*349
SET RCMETHOD=$SELECT($$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",9,"I")="":"MANUAL",1:"AUTOPOST")
+91 ; Paper EOB ERA?
SET RCPAPER=$PIECE($GET(^RCY(344.4,RCERA,20)),U,3)
+92 ;ERA not a paper ERA, is the EOB a Paper EOB
+93 if 'RCPAPER
SET RCPAPER=$SELECT($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
+94 SET RCEFTTYP=$SELECT(RCPAYTYP=4:"PAPER",1:"EFT")
+95 SET RCTRNTYP=RCPAPER_"/"_RCEFTTYP
+96 SET RCERAIDX=$SELECT(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
+97 ;Paper Check Paper EOB not supported
if RCERAIDX=4
QUIT
+98 SET RCDATA=RCBILL_U_RCERA_U_RCIEN_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
+99 SET RCDATA=RCDATA_U_RCEFTRCD_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
+100 SET RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U_RCEFTPD
+101 ; PRCA*4.5*349 add post method
SET ^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL)=RCDATA
End DoDot:4
End DoDot:3
QUIT
+102 IF (RCMSTAT=2)
IF (RCIEN)
IF ('$DATA(^TMP("RCDPENR2",$JOB,"EFT",RCIEN)))
Begin DoDot:3
+103 SET RCTIN=$PIECE(RCEFTDT,U,3)
+104 SET RCINS=$PIECE(RCEFTDT,U,2)
+105 ; find the AR Payer IEN
SET RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME)
+106 ; Q:'RCPAYER ; Quit if Payer/TIN not found
+107 ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
+108 SET RCINSTIN=RCINS_"/"_RCTIN
+109 ; PRCA*4.5*349 - Unmatched EFT must be manually posted
SET RCMETHOD="MANUAL"
+110 ; PRCA*4.5*349
FOR X=RCMETHOD,"TOTAL"
Begin DoDot:4
+111 ; PRCA*4.5*349
SET RCESUMDT=$GET(^TMP("RCDPENR2",$JOB,"GTOT",X,3))
+112 ; PRCA*4.5*349
SET RCPSUMDT=$GET(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,X,3))
+113 SET $PIECE(RCESUMDT,U,14)=$PIECE(RCESUMDT,U,14)+1
+114 SET $PIECE(RCPSUMDT,U,14)=$PIECE(RCPSUMDT,U,14)+1
+115 SET $PIECE(RCESUMDT,U,15)=$PIECE(RCESUMDT,U,15)+RCEFTPD
+116 SET $PIECE(RCPSUMDT,U,15)=$PIECE(RCPSUMDT,U,15)+RCEFTPD
+117 ; PRCA*4.5*349
SET ^TMP("RCDPENR2",$JOB,"GTOT",X,3)=RCESUMDT
+118 ; PRCA*4.5*349
SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,X,3)=RCPSUMDT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+119 QUIT
+120 ;
CLOSEDB(RCBILL) ;EP
+1 ; PRCA*4.5*349 - Added subroutine
+2 ; Check to see if a bill is closed
+3 ; Input: RCBILL - IEN for 361.1 of the bill to be checked
+4 ; Returns: 1 - Bill is closed, 0 Otherwise
+5 NEW XX
+6 SET XX=$$GET1^DIQ(430,RCBILL_",",8,"I")
+7 SET XX=$$GET1^DIQ(430.3,XX_",",1)
+8 IF XX="CC"
QUIT 1
+9 QUIT 0
+10 ;
+11 ;Print the Grand Total/Summary data for the EFT/ERA Trending Report
PRINTGT(RCTITLE,RCDATA,RCDISP,RCERAFLG,RCEXCEL) ;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 ; RCSTOP - Initialized to 0
+9 ; Output: RCSTOP - User stopped the display of the report
+10 ;
+11 ; Undeclared Parameter(s) - RCRPIEN,RCLINE,RCSTOP
+12 ; RCRPIEN - IEN of the archive file (344.91(
+13 ; RCLINE - String of '-' to be used as a separator line
+14 ; RCSUMFLG - 'M' - Main Report
+15 ; 'G' - Grand totals
+16 ; 'S' - Summary
+17 ;
+18 ;PRCA*4.5*332 comments end
+19 ;
+20 NEW RCCOUNT,RCBILL,RCPAID,RCPCT,RCBECT,RCBEDY,RCAVGBE,RCEECT,RCEEDY
+21 NEW RCEPCT,RCEPDY,RCAVGEP,RCBPCT,RCBPDY,RCAVGBP,RCBORDER,RCSCDATA
+22 NEW RCC,RCB,RCAVGEE,RCLTXT,I,RCSTRDTA,RCSTRNG,RCDTXT
+23 ;
+24 SET RCERAFLG=+$GET(RCERAFLG)
SET RCDISP=$GET(RCDISP)
+25 IF $Y>(IOSL-7)
IF RCDISP
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER^RCDPENR2
+26 ;
+27 ; Display report type being displayed
+28 DO PRINTHDR^RCDPENR2(RCTITLE)
+29 ;
+30 ; Extract data from string and build string for output
+31 SET $PIECE(RCSCDATA,U,1)=+$PIECE(RCDATA,U)
+32 SET RCBILL=+$PIECE(RCDATA,U,2)
+33 SET RCPAID=+$PIECE(RCDATA,U,3)
+34 SET $PIECE(RCSCDATA,U,2)=RCBILL
+35 SET $PIECE(RCSCDATA,U,3)=RCPAID
+36 ; Convert to percent format
SET $PIECE(RCSCDATA,U,4)=$SELECT(+RCBILL=0:0,1:RCPAID/RCBILL)*100
+37 SET RCBECT=+$PIECE(RCDATA,U,4)
+38 SET RCBEDY=+$PIECE(RCDATA,U,5)
+39 SET $PIECE(RCSCDATA,U,6)=$FNUMBER($SELECT(+RCBECT=0:0,1:RCBEDY/RCBECT),"",0)
+40 SET RCEECT=+$PIECE(RCDATA,U,6)
+41 SET RCEEDY=+$PIECE(RCDATA,U,7)
+42 SET $PIECE(RCSCDATA,U,7)=$FNUMBER($SELECT(+RCEECT=0:0,1:RCEEDY/RCEECT),"",0)
+43 SET RCEPCT=+$PIECE(RCDATA,U,8)
+44 SET RCEPDY=+$PIECE(RCDATA,U,9)
+45 SET $PIECE(RCSCDATA,U,8)=$FNUMBER($SELECT(+RCEPCT=0:0,1:RCEPDY/RCEPCT),"",0)
+46 SET RCBPCT=+$PIECE(RCDATA,U,10)
+47 SET RCBPDY=+$PIECE(RCDATA,U,11)
+48 SET $PIECE(RCSCDATA,U,9)=$FNUMBER($SELECT(+RCBPCT=0:0,1:RCBPDY/RCBPCT),"",0)
+49 SET $PIECE(RCSCDATA,U,11)=+$PIECE(RCDATA,U,12)
+50 SET $PIECE(RCSCDATA,U,12)=+$PIECE(RCDATA,U,13)
+51 SET $PIECE(RCSCDATA,U,14)=+$PIECE(RCDATA,U,14)
+52 SET $PIECE(RCSCDATA,U,15)=+$PIECE(RCDATA,U,15)
+53 SET $PIECE(RCSCDATA,U,16)=RCPAID-$PIECE(RCDATA,U,15)
+54 FOR I=1:1:16
Begin DoDot:1
+55 ; PRC*4.5*332, added (RCSUMFLG'="G") below
+56 IF (RCSUMFLG'="G")
IF RCDISP
IF ($Y>(IOSL-4))
Begin DoDot:2
+57 DO ASK^RCDPEADP(.RCSTOP,0)
+58 if RCSTOP
QUIT
+59 DO HEADER^RCDPENR2
End DoDot:2
if RCSTOP
QUIT
+60 ;if printing from monthly background job save in file and quit
+61 ;Otherwise print to screen
+62 SET (RCLTXT,RCDTXT)=$PIECE($TEXT(GDTXT+I),";;",2)
+63 IF RCTITLE["PAPER"
Begin DoDot:2
+64 ; correct display for lines 6,7,8,16
IF (I>5)
IF (I<9)
Begin DoDot:3
+65 ;Dont change line 6 if Paper check section
IF (I=6)
IF RCTITLE["CHECK"
QUIT
+66 ; Correct display for Paper check section
SET RCB="EFT"
SET RCC="CHK"
+67 ;correct display for paper eob
IF RCTITLE["EOB"
SET RCB="ERA"
SET RCC="EOB"
+68 SET RCDTXT=$PIECE(RCLTXT,RCB,1)_RCC_$PIECE(RCLTXT,RCB,2)
End DoDot:3
End DoDot:2
+69 IF 'RCDISP!RCEXCEL
Begin DoDot:2
+70 SET RCSTRDTA=$PIECE(RCSCDATA,U,I)
+71 ;Format lines: lines 2&3 are amounts, 4 is a percentage, remainder are integers.
+72 SET RCSTRNG=RCDTXT_"^"_$SELECT(I=4:$JUSTIFY($PIECE(RCSTRDTA,"."),2)_"%",1:RCSTRDTA)
+73 IF 'RCDISP
DO SAVEDATA^RCDPENR1(RCSTRNG,RCRPIEN)
QUIT
+74 ;if printing in an EXCEL format, print "^" delimited and quit
+75 IF RCEXCEL
WRITE RCSTRNG,!
QUIT
End DoDot:2
QUIT
+76 ;Output to screen
+77 ;currency format
+78 IF (I=2)!(I=3)!(I=15)
WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13,2),!
QUIT
+79 ; For the line items that are percentages. Not using $J formatting due to rounding errors.
+80 IF I=4
WRITE RCDTXT,?65,$JUSTIFY($PIECE($PIECE(RCSCDATA,U,I),"."),12),"%",!
QUIT
+81 ;Otherwise print Number format
+82 IF (I=16)
Begin DoDot:2
+83 if RCERAFLG
WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13,2),!
End DoDot:2
QUIT
+84 WRITE RCDTXT,?65,$JUSTIFY($PIECE(RCSCDATA,U,I),13),!
End DoDot:1
if RCSTOP
QUIT
+85 IF RCSTOP
QUIT RCSTOP
+86 ;Otherwise print Number format
IF RCDISP
WRITE RCLINE,!
+87 IF 'RCDISP
DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
+88 QUIT RCSTOP
+89 ;
GDTXT ;
+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
