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,446**;Mar 20, 1995;Build 15
;;Per VA Directive 6402, this routine should not be modified.
;
;Read ^DGCR(399) via Private IA 3820
;Read ^DG(40.8) via Controlled IA 417
;Read ^IBM(361.1) via Private IA 4051
;Use DIV^IBJDF2 via Private IA 3130
;
Q
;
;
;Generate statistics for report
COMPILE ;
;
;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT" 4="UNMATCHED EOB" 5="ZERO PAYMENTS"
; needed for correct report sort order, PRCA*4.5*446, Added values 4 and 5
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 RCMETHOD,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
;
F I=4:1:5 D ; PRCA*4.5*446, Added values 4 and 5
. I '$D(^TMP("RCDPENR2",$J,"GTOT","UNPOSTED",I)) S ^TMP("RCDPENR2",$J,"GTOT","UNPOSTED",I)=0 ; PRCA*4.5*446
;
; 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
. F I=4:1:5 D ; PRCA*4.5*446, Added values 4 and 5
. . I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"UNPOSTED",I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"UNPOSTED",I)=0 ; PRCA*4.5*446
;
; 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 RCPUZ="P" I RCAUTO="A"&(RCMETHOD="M")!(RCAUTO="N"&(RCMETHOD="A")) Q ; PRCA*4.5*349, PRCA*4.5*446 If user selected Payments
. . . . 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 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 info 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 payer specific info 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 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 info for EFTs sent during requested period.
; PRCA*4.5*349 - Add Closed Claims filter
GETEFT(RCSDATE,RCEDATE,RCRATE,RCCLM,RCPUZ,RCSORT) ;EP
;RCSDATE - Start date of extraction
;RCEDATE - End date of extraction
;RCPUZ - (P)ayment EEOBs, (U)nmatched EEOBs, (Z)ero payment EEOBs, (A)ll
;RCSORT - (P)ayer, (A)mount
;
;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) =
; Where:
; Piece Variable
; 1 RCBILL - IEN: Bill/Claim #
; 2 RCERA - IEN: ERA the bill was paid on.
; 3 RCIEN - IEN: EFT the money for the bill arrived on
; 4 RCEOB - IEN: 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.
;
I RCPUZ="U" Q ;PRCA*4.5*446 If user selected Unmatched, all entries will come from ERA search, not EFT
;
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,RCKEEP,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP
N RCMSTAT,RCEFTST,RCESUMDT,RCPSUMDT,RCZERO,X,ZZPNAME ; PRCA*4.5*349 ;PRCA*4.5*446 add RCEFTST
;
;Get EFT Detail info for report batches sent within given date range.
S RCLDATE=RCSDATE-.001,RCEDATE=RCEDATE+1
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 RCEFTST=$P(RCERADT,U,9)
. . . 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
. . . . ;
. . . . ; PRCA*4.5*446 Add logic for to filter zero-pay based on RCPUZ
. . . . S RCZERO=0 I RCPUZ="Z" S RCKEEP=0 S:RCEFTST=3 RCKEEP=1,RCZERO=1 Q:'RCKEEP ;RCEFTST=3 -> Match-0 Payment
. . . . I RCPUZ="Z" Q:'RCZERO
. . . . I (RCPUZ="U")!(RCPUZ="P") Q:RCZERO
. . . . ;
. . . . S RCMETHOD=$S(RCZERO:"UNPOSTED",$$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",9,"I")="":"MANUAL",1:"AUTOPOST") ; PRCA*4.5*349, PRCA*4.5*446
. . . . 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_"/"_RCERA_"/"_RCAMTBL)=RCDATA ; PRCA*4.5*349 add post method, PRCA*4.5*446 add pieces to last subscript to make unique
. . . . I RCSORT="A" S ^TMP("RCDPENR2",$J,"MAINAMT",RCMETHOD,RCAMTBL,RCBILL_"/"_RCERA)=RCDATA_U_RCERAIDX_U_RCBILL ;PRCA*4.5*446
. . 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
;
;Moved PRINTGT to ^RCDPENR5 because of routine size, PRCA*4.5*446
;Moved GDTXT to ^RCDPENR5 because of routine size, PRCA*4.5*446
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR3 15472 printed Sep 23, 2025@19:21:06 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,446**;Mar 20, 1995;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Read ^DGCR(399) via Private IA 3820
+5 ;Read ^DG(40.8) via Controlled IA 417
+6 ;Read ^IBM(361.1) via Private IA 4051
+7 ;Use DIV^IBJDF2 via Private IA 3130
+8 ;
+9 QUIT
+10 ;
+11 ;
+12 ;Generate statistics for report
COMPILE ;
+1 ;
+2 ;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT" 4="UNMATCHED EOB" 5="ZERO PAYMENTS"
+3 ; needed for correct report sort order, PRCA*4.5*446, Added values 4 and 5
+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 RCMETHOD,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 ; PRCA*4.5*446, Added values 4 and 5
FOR I=4:1:5
Begin DoDot:1
+15 ; PRCA*4.5*446
IF '$DATA(^TMP("RCDPENR2",$JOB,"GTOT","UNPOSTED",I))
SET ^TMP("RCDPENR2",$JOB,"GTOT","UNPOSTED",I)=0
End DoDot:1
+16 ;
+17 ; init insurance grand totals
+18 SET RCINSTIN=""
+19 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+20 FOR I=1:1:3
Begin DoDot:2
+21 ; PRCA*4.5*349
IF '$DATA(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"MANUAL",I))
SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"MANUAL",I)=0
+22 ; 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
+23 ; PRCA*4.5*446, Added values 4 and 5
FOR I=4:1:5
Begin DoDot:2
+24 ; PRCA*4.5*446
IF '$DATA(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"UNPOSTED",I))
SET ^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,"UNPOSTED",I)=0
End DoDot:2
End DoDot:1
+25 ;
+26 ; Compile results
+27 SET RCINSTIN=""
+28 FOR
SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN))
if RCINSTIN=""
QUIT
Begin DoDot:1
+29 ; PRCA*4.5*349
SET RCMETHOD=""
+30 ; PRCA*4.5*349 add $O on RCMETHOD
FOR
SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD))
if RCMETHOD=""
QUIT
Begin DoDot:2
+31 ; PRCA*4.5*349 add 1 "." to this line and every line below
SET RCERATYP=""
+32 FOR
SET RCERATYP=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP))
if RCERATYP=""
QUIT
Begin DoDot:3
+33 SET RCCLAIM=""
+34 FOR
SET RCCLAIM=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
if RCCLAIM=""
QUIT
Begin DoDot:4
+35 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
+36 if RCDATA=""
QUIT
+37 ; PRCA*4.5*349, PRCA*4.5*446 If user selected Payments
IF RCPUZ="P"
IF RCAUTO="A"&(RCMETHOD="M")!(RCAUTO="N"&(RCMETHOD="A"))
QUIT
+38 FOR J=RCMETHOD,"TOTAL"
DO COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM) ; PRCA*4.5*349 subroutine split off
+1 ; Extract 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 info 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 payer specific info 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 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 info for EFTs sent during requested period.
+134 ; PRCA*4.5*349 - Add Closed Claims filter
GETEFT(RCSDATE,RCEDATE,RCRATE,RCCLM,RCPUZ,RCSORT) ;EP
+1 ;RCSDATE - Start date of extraction
+2 ;RCEDATE - End date of extraction
+3 ;RCPUZ - (P)ayment EEOBs, (U)nmatched EEOBs, (Z)ero payment EEOBs, (A)ll
+4 ;RCSORT - (P)ayer, (A)mount
+5 ;
+6 ;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) =
+7 ; Where:
+8 ; Piece Variable
+9 ; 1 RCBILL - IEN: Bill/Claim #
+10 ; 2 RCERA - IEN: ERA the bill was paid on.
+11 ; 3 RCIEN - IEN: EFT the money for the bill arrived on
+12 ; 4 RCEOB - IEN: EOB within the ERA
+13 ; 5 RCDOS - Date of Service
+14 ; 6 RCAMTBL - Amount Billed
+15 ; 7 RCAMTPD - Amount Paid
+16 ; 8 RCDTBILL - Date of Bill
+17 ; 9 RCERARCD - Date ERA received
+18 ; 10 RCEFTRCD - Date EFT received
+19 ; 11 RCPOSTED - Date Payment Posted to claim
+20 ; 12 RCTRACE - ERA Trace number for EOB
+21 ; 13 RCMETHOD - Method of Payment transmittal
+22 ; 14 RCTRNTYP - Was payment EFT or Paper Check / Was the ERA Paper or EDI Lockbox
+23 ; 15 RCERANUM - # EOB'S in ERA
+24 ; 16 RCDIV - Division of the bill
+25 ; 17 RCINSTIN - Insurance/Insurance TIN
+26 ; 18 RCEFTPD - Amount paid as an EFT, not as a check.
+27 ;
+28 ;PRCA*4.5*446 If user selected Unmatched, all entries will come from ERA search, not EFT
IF RCPUZ="U"
QUIT
+29 ;
+30 NEW OKAY,RCLDATE,RCINS,RCIEN,RCEFTDT,RCERA,RCEFT,RCRCPT,RCPOSTED,RCPAYTYP,RCERADT,RCTRACE,RCERAIDX
+31 NEW RCTRLN,RCTRBD,RCERANUM,RCTIN,RCPAYER,RCINSTIN,RCLPIEN,RCDTDATA,RCEOB,RCBILL,RCDIV,RCDOS,RCAMTBL
+32 NEW RCDTBILL,RCMETHOD,RCPAPER,RCEFTTYP,RCEFTPD,RCKEEP,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP
+33 ; PRCA*4.5*349 ;PRCA*4.5*446 add RCEFTST
NEW RCMSTAT,RCEFTST,RCESUMDT,RCPSUMDT,RCZERO,X,ZZPNAME
+34 ;
+35 ;Get EFT Detail info for report batches sent within given date range.
+36 SET RCLDATE=RCSDATE-.001
SET RCEDATE=RCEDATE+1
+37 FOR
SET RCLDATE=$ORDER(^RCY(344.31,"ADR",RCLDATE))
if RCLDATE=""
QUIT
if RCLDATE>RCEDATE
QUIT
Begin DoDot:1
+38 SET RCIEN=0
+39 FOR
SET RCIEN=$ORDER(^RCY(344.31,"ADR",RCLDATE,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+40 SET RCEFTDT=$GET(^RCY(344.31,RCIEN,0))
+41 if RCEFTDT=""
QUIT
+42 ; Only include posted EFTs - PRCA*4.5*349
IF '$$CHKEFT^RCDPEU1(RCIEN)
QUIT
+43 ; PRCA*4.5*326 If all payers included, check by type
IF RCPAY="A"
IF RCTYPE'="A"
Begin DoDot:3
+44 SET OKAY=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE)
End DoDot:3
if 'OKAY
QUIT
+45 ; Check Payer Name
+46 ; PRCA*4.5*326
IF RCPAY'="A"
Begin DoDot:3
+47 SET OKAY=$$ISSEL^RCDPEU1(344.31,RCIEN)
End DoDot:3
if 'OKAY
QUIT
+48 ;
+49 ; ERA IEN
SET RCERA=$PIECE(RCEFTDT,U,10)
+50 SET RCEFTRCD=$PIECE(RCEFTDT,U,13)
+51 SET RCEFT=$PIECE(RCEFTDT,U)
+52 SET ZZPNAME=$PIECE(RCEFTDT,U,2)
+53 SET RCMSTAT=$PIECE(RCEFTDT,U,8)
+54 SET RCRCPT=$PIECE(RCEFTDT,U,9)
+55 SET RCEFTPD=$PIECE(RCEFTDT,U,7)
+56 SET RCPOSTED=$$GET1^DIQ(344.3,RCEFT_",",.11,"I")
+57 SET RCPAYTYP=$$GET1^DIQ(344,RCRCPT_",",.04,"I")
+58 IF RCERA
Begin DoDot:3
+59 ; ERA Data extracted
SET RCERADT=$GET(^RCY(344.4,RCERA,0))
+60 if 'RCERADT
QUIT
+61 ; Trace #
SET RCTRACE=$PIECE(RCERADT,U,2)
+62 SET RCTRLN=$LENGTH(RCTRACE)
SET RCTRBD=$SELECT(RCTRLN<11:1,1:RCTRLN-9)
+63 ; get the last 10 digits of Trace #
SET RCTRACE=$EXTRACT(RCTRACE,RCTRBD,RCTRLN)
+64 ;get the date of the ERA
SET RCERARCD=$PIECE($PIECE(RCERADT,U,7),".",1)
+65 SET RCERANUM=$PIECE(RCERADT,U,11)
+66 SET RCTIN=$PIECE(RCERADT,U,3)
+67 SET RCINS=$PIECE(RCERADT,U,6)
+68 SET RCEFTST=$PIECE(RCERADT,U,9)
+69 ; find the AR Payer IEN
SET RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME)
+70 ; Q:'RCPAYER ; Quit if Payer/TIN not found
+71 ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
+72 SET RCINSTIN=RCINS_"/"_RCTIN
+73 SET RCLPIEN=0
+74 FOR
SET RCLPIEN=$ORDER(^RCY(344.4,RCERA,1,RCLPIEN))
if 'RCLPIEN
QUIT
Begin DoDot:4
+75 ; I $$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",.25,"I")="" Q ; PRCA*4.5*349 - No receipt, line is not posted
+76 SET RCDTDATA=$GET(^RCY(344.4,RCERA,1,RCLPIEN,0))
+77 SET RCEOB=$PIECE(RCDTDATA,U,2)
+78 SET RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
+79 ; no billing information
if RCBILL=""
QUIT
+80 ; Bill isn't closed - PRCA*4.5*349 added line
IF RCCLM="C"
IF '$$CLOSEDB(RCBILL)
QUIT
+81 ;already captured.
if $DATA(^TMP("RCDPENR2",$JOB,"MAIN",RCBILL))
QUIT
+82 SET RCDIV=$$DIV^IBJDF2(RCBILL)
+83 SET RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
+84 ;
+85 SET RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
+86 if RCRATETP'=RCRATE
QUIT
+87 ; Quit if user specified a specific division and bill is not in that Division
+88 IF '$DATA(^TMP("RCDPENR2",$JOB,"DIVALL"))&'$DATA(^TMP("RCDPENR2",$JOB,"DIV",RCDIV))
QUIT
+89 SET RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
+90 SET RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
+91 SET RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
+92 SET RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
+93 ;cant calculate if date first printed is NULL
if RCDTBILL=""
QUIT
+94 ;
+95 ; PRCA*4.5*446 Add logic for to filter zero-pay based on RCPUZ
+96 ;RCEFTST=3 -> Match-0 Payment
SET RCZERO=0
IF RCPUZ="Z"
SET RCKEEP=0
if RCEFTST=3
SET RCKEEP=1
SET RCZERO=1
if 'RCKEEP
QUIT
+97 IF RCPUZ="Z"
if 'RCZERO
QUIT
+98 IF (RCPUZ="U")!(RCPUZ="P")
if RCZERO
QUIT
+99 ;
+100 ; PRCA*4.5*349, PRCA*4.5*446
SET RCMETHOD=$SELECT(RCZERO:"UNPOSTED",$$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",9,"I")="":"MANUAL",1:"AUTOPOST")
+101 ; Paper EOB ERA?
SET RCPAPER=$PIECE($GET(^RCY(344.4,RCERA,20)),U,3)
+102 ;ERA not a paper ERA, is the EOB a Paper EOB
+103 if 'RCPAPER
SET RCPAPER=$SELECT($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
+104 SET RCEFTTYP=$SELECT(RCPAYTYP=4:"PAPER",1:"EFT")
+105 SET RCTRNTYP=RCPAPER_"/"_RCEFTTYP
+106 SET RCERAIDX=$SELECT(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
+107 ;Paper Check Paper EOB not supported
if RCERAIDX=4
QUIT
+108 SET RCDATA=RCBILL_U_RCERA_U_RCIEN_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
+109 SET RCDATA=RCDATA_U_RCEFTRCD_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
+110 SET RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U_RCEFTPD
+111 ; PRCA*4.5*349 add post method, PRCA*4.5*446 add pieces to last subscript to make unique
SET ^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL_"/"_RCERA_"/"_RCAMTBL)=RCDATA
+112 ;PRCA*4.5*446
IF RCSORT="A"
SET ^TMP("RCDPENR2",$JOB,"MAINAMT",RCMETHOD,RCAMTBL,RCBILL_"/"_RCERA)=RCDATA_U_RCERAIDX_U_RCBILL
End DoDot:4
End DoDot:3
QUIT
+113 IF (RCMSTAT=2)
IF (RCIEN)
IF ('$DATA(^TMP("RCDPENR2",$JOB,"EFT",RCIEN)))
Begin DoDot:3
+114 SET RCTIN=$PIECE(RCEFTDT,U,3)
+115 SET RCINS=$PIECE(RCEFTDT,U,2)
+116 ; find the AR Payer IEN
SET RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME)
+117 ; Q:'RCPAYER ; Quit if Payer/TIN not found
+118 ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
+119 SET RCINSTIN=RCINS_"/"_RCTIN
+120 ; PRCA*4.5*349 - Unmatched EFT must be manually posted
SET RCMETHOD="MANUAL"
+121 ; PRCA*4.5*349
FOR X=RCMETHOD,"TOTAL"
Begin DoDot:4
+122 ; PRCA*4.5*349
SET RCESUMDT=$GET(^TMP("RCDPENR2",$JOB,"GTOT",X,3))
+123 ; PRCA*4.5*349
SET RCPSUMDT=$GET(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN,X,3))
+124 SET $PIECE(RCESUMDT,U,14)=$PIECE(RCESUMDT,U,14)+1
+125 SET $PIECE(RCPSUMDT,U,14)=$PIECE(RCPSUMDT,U,14)+1
+126 SET $PIECE(RCESUMDT,U,15)=$PIECE(RCESUMDT,U,15)+RCEFTPD
+127 SET $PIECE(RCPSUMDT,U,15)=$PIECE(RCPSUMDT,U,15)+RCEFTPD
+128 ; PRCA*4.5*349
SET ^TMP("RCDPENR2",$JOB,"GTOT",X,3)=RCESUMDT
+129 ; 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
+130 QUIT
+131 ;
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 ;Moved PRINTGT to ^RCDPENR5 because of routine size, PRCA*4.5*446
+12 ;Moved GDTXT to ^RCDPENR5 because of routine size, PRCA*4.5*446
+13 ;
