- 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 Feb 18, 2025@23:11:27 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