Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPENR3

RCDPENR3.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Read ^DGCR(399) via Private IA 3820
  1. ;Read ^DG(40.8) via Controlled IA 417
  1. ;Read ^IBM(361.1) via Private IA 4051
  1. ;Use DIV^IBJDF2 via Private IA 3130
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;Generate the needed statistics for the report
  1. COMPILE ;
  1. ;
  1. ;RCERATYP values 1="ERA/EFT" 2="ERA/PAPER CHECK" 3="PAPER EOB/EFT"
  1. ; needed for the correct report sort order
  1. N I,J,RCINSTIN,RCERATYP,RCCLAIM,RCDATA,RCDAYS,RCEFTPD,RCEPDT,RCERAIEN,RCERANUM,RCEFTIEN ; Looping variable
  1. N RCGPDATA,RCGPCT,RCGPBILL,RCGPPD,RCGPBECT,RCGPBEDY,RCGPEECT,RCGPEEDY,RCGPEPCT,RCGPEPDY,RCGPBPCT,RCGPBPDY,RCGPECT,RCGPENM,RCGPFCT,RCGPFPD ; Grand Total W/Payment method variables
  1. N RCPPDATA,RCPPCT,RCPPBILL,RCPPPD,RCPPBECT,RCPPBEDY,RCPPEECT,RCPPEEDY,RCPPEPCT,RCPPEPDY,RCPPBPCT,RCPPBPDY,RCPPECT,RCPPENM,RCPPFCT,RCPPFPD ; Payer W/Payment method variables
  1. ;
  1. ;Initialize all valid ERA/EFT combinations to report on.
  1. ; init grand total
  1. F I=1:1:3 D ; US 767
  1. . I '$D(^TMP("RCDPENR2",$J,"GTOT","MANUAL",I)) S ^TMP("RCDPENR2",$J,"GTOT","MANUAL",I)=0 ; PRCA*4.5*349
  1. . I '$D(^TMP("RCDPENR2",$J,"GTOT","AUTOPOST",I)) S ^TMP("RCDPENR2",$J,"GTOT","AUTOPOST",I)=0 ; PRCA*4.5*349
  1. ;
  1. ; init insurance grand totals
  1. S RCINSTIN=""
  1. F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D
  1. . F I=1:1:3 D ;
  1. . . I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"MANUAL",I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"MANUAL",I)=0 ; PRCA*4.5*349
  1. . . I '$D(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"AUTOPOST",I)) S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,"AUTOPOST",I)=0 ; PRCA*4.5*349
  1. ;
  1. ; Compile results
  1. S RCINSTIN=""
  1. F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN)) Q:RCINSTIN="" D
  1. . S RCMETHOD="" ; PRCA*4.5*349
  1. . F S RCMETHOD=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD)) Q:RCMETHOD="" D ; PRCA*4.5*349 add $O on RCMETHOD
  1. . . S RCERATYP="" ; PRCA*4.5*349 add 1 "." to this line and every line below
  1. . . F S RCERATYP=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP)) Q:RCERATYP="" D
  1. . . . S RCCLAIM=""
  1. . . . F S RCCLAIM=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)) Q:RCCLAIM="" D
  1. . . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM))
  1. . . . . Q:RCDATA=""
  1. . . . . I RCAUTO="A"&(RCMETHOD="M")!(RCAUTO="N"&(RCMETHOD="A")) Q ; PRCA*4.5*349
  1. . . . . F J=RCMETHOD,"TOTAL" D COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM)
  1. Q
  1. ;
  1. COMPILEX(J,RCDATA,RCINSTIN,RCMETHOD,RCERATYP,RCCLAIM) ; PRCA*4.5*349 subroutine split off
  1. ; Extract the Grand Total by EFT/ERA type
  1. S RCGPDATA=$G(^TMP("RCDPENR2",$J,"GTOT",J,RCERATYP))
  1. S RCGPCT=$P(RCGPDATA,U)
  1. S RCGPBILL=$P(RCGPDATA,U,2)
  1. S RCGPPD=$P(RCGPDATA,U,3)
  1. S RCGPBECT=$P(RCGPDATA,U,4)
  1. S RCGPBEDY=$P(RCGPDATA,U,5)
  1. S RCGPEECT=$P(RCGPDATA,U,6)
  1. S RCGPEEDY=$P(RCGPDATA,U,7)
  1. S RCGPEPCT=$P(RCGPDATA,U,8)
  1. S RCGPEPDY=$P(RCGPDATA,U,9)
  1. S RCGPBPCT=$P(RCGPDATA,U,10)
  1. S RCGPBPDY=$P(RCGPDATA,U,11)
  1. S RCGPECT=$P(RCGPDATA,U,12)
  1. S RCGPENM=$P(RCGPDATA,U,13)
  1. S RCGPFCT=$P(RCGPDATA,U,14)
  1. S RCGPFPD=$P(RCGPDATA,U,15)
  1. ;
  1. ; Extract the Payer specific information by EFT/ERA type
  1. S RCPPDATA=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,J,RCERATYP))
  1. S RCPPCT=$P(RCPPDATA,U)
  1. S RCPPBILL=$P(RCPPDATA,U,2)
  1. S RCPPPD=$P(RCPPDATA,U,3)
  1. S RCPPBECT=$P(RCPPDATA,U,4)
  1. S RCPPBEDY=$P(RCPPDATA,U,5)
  1. S RCPPEECT=$P(RCPPDATA,U,6)
  1. S RCPPEEDY=$P(RCPPDATA,U,7)
  1. S RCPPEPCT=$P(RCPPDATA,U,8)
  1. S RCPPEPDY=$P(RCPPDATA,U,9)
  1. S RCPPBPCT=$P(RCPPDATA,U,10)
  1. S RCPPBPDY=$P(RCPPDATA,U,11)
  1. S RCPPECT=$P(RCPPDATA,U,12)
  1. S RCPPENM=$P(RCPPDATA,U,13)
  1. S RCPPFCT=$P(RCPPDATA,U,14)
  1. S RCPPFPD=$P(RCPPDATA,U,15)
  1. ;
  1. ; Total counts - Grand/Payment Method
  1. S RCGPCT=RCGPCT+1
  1. S RCGPBILL=RCGPBILL+$P(RCDATA,U,6)
  1. S RCGPPD=RCGPPD+$P(RCDATA,U,7)
  1. ;
  1. ; Total counts - Payer/Payment method
  1. S RCPPCT=RCPPCT+1
  1. S RCPPBILL=RCPPBILL+$P(RCDATA,U,6)
  1. S RCPPPD=RCPPPD+$P(RCDATA,U,7)
  1. ;
  1. ; Billed to ERA received
  1. I $P(RCDATA,U,8),$P(RCDATA,U,9) D
  1. . S RCGPBECT=RCGPBECT+1
  1. . S RCPPBECT=RCPPBECT+1
  1. . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,9),$P(RCDATA,U,8),1)
  1. . S RCGPBEDY=RCGPBEDY+RCDAYS
  1. . S RCPPBEDY=RCPPBEDY+RCDAYS
  1. ;
  1. ; ERA to EFT received
  1. I $P(RCDATA,U,10),$P(RCDATA,U,9) D
  1. . S RCGPEECT=RCGPEECT+1
  1. . S RCPPEECT=RCPPEECT+1
  1. . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,10),$P(RCDATA,U,9),1)
  1. . S RCGPEEDY=RCGPEEDY+RCDAYS
  1. . S RCPPEEDY=RCPPEEDY+RCDAYS
  1. ;
  1. ; ERA and EFT received, and payment Posted
  1. I $P(RCDATA,U,10),$P(RCDATA,U,9),$P(RCDATA,U,11) D
  1. . S RCGPEPCT=RCGPEPCT+1
  1. . S RCPPEPCT=RCPPEPCT+1
  1. . S RCEPDT=$S($P(RCDATA,U,9)>$P(RCDATA,U,10):9,1:10) ;determine which date is later
  1. . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,RCEPDT),1)
  1. . S RCGPEPDY=RCGPEPDY+RCDAYS
  1. . S RCPPEPDY=RCPPEPDY+RCDAYS
  1. ;
  1. ; Bill to Payment Posted
  1. I $P(RCDATA,U,8),$P(RCDATA,U,11) D
  1. . S RCGPBPCT=RCGPBPCT+1
  1. . S RCPPBPCT=RCPPBPCT+1
  1. . S RCDAYS=$$FMDIFF^XLFDT($P(RCDATA,U,11),$P(RCDATA,U,8),1)
  1. . S RCGPBPDY=RCGPBPDY+RCDAYS
  1. . S RCPPBPDY=RCPPBPDY+RCDAYS
  1. ;
  1. ; If the ERA hasn't already been counted, add it to the totals
  1. S RCERAIEN=$P(RCDATA,U,2)
  1. I RCERAIEN,'$D(^TMP("RCDPENR2",$J,"ERA",RCERAIEN,J)) D
  1. . S ^TMP("RCDPENR2",$J,"ERA",RCERAIEN,J)=""
  1. . S RCERANUM=$P(RCDATA,U,15)
  1. . S RCGPECT=RCGPECT+1,RCPPECT=RCPPECT+1
  1. . S RCGPENM=RCGPENM+RCERANUM,RCPPENM=RCPPENM+RCERANUM
  1. ;
  1. ; If the EFT hasn't already been counted, add it to the totals
  1. S RCEFTIEN=$P(RCDATA,U,3)
  1. I (RCEFTIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCEFTIEN,J))) D
  1. . S ^TMP("RCDPENR2",$J,"EFT",RCEFTIEN,J)=""
  1. . S RCEFTPD=$P(RCDATA,U,18)
  1. . S RCGPFCT=RCGPFCT+1,RCPPFCT=RCPPFCT+1
  1. . S RCGPFPD=RCGPFPD+RCEFTPD,RCPPFPD=RCPPFPD+RCEFTPD
  1. ;
  1. ; Update the payer specific information By Payment Method
  1. S $P(RCPPDATA,U)=RCPPCT
  1. S $P(RCPPDATA,U,2)=RCPPBILL
  1. S $P(RCPPDATA,U,3)=RCPPPD
  1. S $P(RCPPDATA,U,4)=RCPPBECT
  1. S $P(RCPPDATA,U,5)=RCPPBEDY
  1. S $P(RCPPDATA,U,6)=RCPPEECT
  1. S $P(RCPPDATA,U,7)=RCPPEEDY
  1. S $P(RCPPDATA,U,8)=RCPPEPCT
  1. S $P(RCPPDATA,U,9)=RCPPEPDY
  1. S $P(RCPPDATA,U,10)=RCPPBPCT
  1. S $P(RCPPDATA,U,11)=RCPPBPDY
  1. S $P(RCPPDATA,U,12)=RCPPECT
  1. S $P(RCPPDATA,U,13)=RCPPENM
  1. S $P(RCPPDATA,U,14)=RCPPFCT
  1. S $P(RCPPDATA,U,15)=RCPPFPD
  1. S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,J,RCERATYP)=RCPPDATA
  1. ;
  1. ; Update the Grand Total specific information By Payment Method
  1. S $P(RCGPDATA,U)=RCGPCT
  1. S $P(RCGPDATA,U,2)=RCGPBILL
  1. S $P(RCGPDATA,U,3)=RCGPPD
  1. S $P(RCGPDATA,U,4)=RCGPBECT
  1. S $P(RCGPDATA,U,5)=RCGPBEDY
  1. S $P(RCGPDATA,U,6)=RCGPEECT
  1. S $P(RCGPDATA,U,7)=RCGPEEDY
  1. S $P(RCGPDATA,U,8)=RCGPEPCT
  1. S $P(RCGPDATA,U,9)=RCGPEPDY
  1. S $P(RCGPDATA,U,10)=RCGPBPCT
  1. S $P(RCGPDATA,U,11)=RCGPBPDY
  1. S $P(RCGPDATA,U,12)=RCGPECT
  1. S $P(RCGPDATA,U,13)=RCGPENM
  1. S $P(RCGPDATA,U,14)=RCGPFCT
  1. S $P(RCGPDATA,U,15)=RCGPFPD
  1. S ^TMP("RCDPENR2",$J,"GTOT",J,RCERATYP)=RCGPDATA ; PRCA*4.5*349
  1. Q
  1. ;
  1. ;Retrieve all necessary information for the EFTs sent during the requested period.
  1. ; PRCA*4.5*349 - Add Closed Claims filter
  1. GETEFT(RCSDATE,RCEDATE,RCRATE,RCCLM) ;EP
  1. ;RCSDATE - Start date of extraction
  1. ;RCEDATE - End date of extraction
  1. ;
  1. ;^TMP("RCDPENR2",$J,"MAIN",IEN of Claim/Bill #) =
  1. ; Where:
  1. ; Piece Variable
  1. ; 1 RCBILL - IEN of Bill/Claim #
  1. ; 2 RCERA - IEN of the ERA the bill was paid on.
  1. ; 3 RCIEN - IEN of the EFT the money for the bill arrived on
  1. ; 4 RCEOB - IEN of the EOB within the ERA
  1. ; 5 RCDOS - Date of Service
  1. ; 6 RCAMTBL - Amount Billed
  1. ; 7 RCAMTPD - Amount Paid
  1. ; 8 RCDTBILL - Date of Bill
  1. ; 9 RCERARCD - Date ERA received
  1. ; 10 RCEFTRCD - Date EFT received
  1. ; 11 RCPOSTED - Date Payment Posted to claim
  1. ; 12 RCTRACE - ERA Trace number for EOB
  1. ; 13 RCMETHOD - Method of Payment transmittal
  1. ; 14 RCTRNTYP - Was payment EFT or Paper Check / Was the ERA Paper or EDI Lockbox
  1. ; 15 RCERANUM - # EOB'S in ERA
  1. ; 16 RCDIV - Division of the bill
  1. ; 17 RCINSTIN - Insurance/Insurance TIN
  1. ; 18 RCEFTPD - Amount paid as an EFT, not as a check.
  1. ;
  1. N OKAY,RCLDATE,RCINS,RCIEN,RCEFTDT,RCERA,RCEFT,RCRCPT,RCPOSTED,RCPAYTYP,RCERADT,RCTRACE,RCERAIDX
  1. N RCTRLN,RCTRBD,RCERANUM,RCTIN,RCPAYER,RCINSTIN,RCLPIEN,RCDTDATA,RCEOB,RCBILL,RCDIV,RCDOS,RCAMTBL
  1. N RCDTBILL,RCMETHOD,RCPAPER,RCEFTTYP,RCEFTPD,RCTRNTYP,RCDATA,RCAMTPD,RCEFTRCD,RCERARCD,RCRATETP
  1. N RCMSTAT,RCESUMDT,RCPSUMDT,X,ZZPNAME ; PRCA*4.5*349
  1. ;
  1. ;Get the EFT Detail information for the report batches sent within the given date range.
  1. S RCLDATE=RCSDATE-.001
  1. F S RCLDATE=$O(^RCY(344.31,"ADR",RCLDATE)) Q:RCLDATE="" Q:RCLDATE>RCEDATE D
  1. . S RCIEN=0
  1. . F S RCIEN=$O(^RCY(344.31,"ADR",RCLDATE,RCIEN)) Q:'RCIEN D
  1. . . S RCEFTDT=$G(^RCY(344.31,RCIEN,0))
  1. . . Q:RCEFTDT=""
  1. . . I '$$CHKEFT^RCDPEU1(RCIEN) Q ; Only include posted EFTs - PRCA*4.5*349
  1. . . I RCPAY="A",RCTYPE'="A" D Q:'OKAY ; PRCA*4.5*326 If all payers included, check by type
  1. . . . S OKAY=$$ISTYPE^RCDPEU1(344.31,RCIEN,RCTYPE)
  1. . . ; Check Payer Name
  1. . . I RCPAY'="A" D Q:'OKAY ; PRCA*4.5*326
  1. . . . S OKAY=$$ISSEL^RCDPEU1(344.31,RCIEN)
  1. . . ;
  1. . . S RCERA=$P(RCEFTDT,U,10) ; ERA IEN
  1. . . S RCEFTRCD=$P(RCEFTDT,U,13)
  1. . . S RCEFT=$P(RCEFTDT,U)
  1. . . S ZZPNAME=$P(RCEFTDT,U,2)
  1. . . S RCMSTAT=$P(RCEFTDT,U,8)
  1. . . S RCRCPT=$P(RCEFTDT,U,9)
  1. . . S RCEFTPD=$P(RCEFTDT,U,7)
  1. . . S RCPOSTED=$$GET1^DIQ(344.3,RCEFT_",",.11,"I")
  1. . . S RCPAYTYP=$$GET1^DIQ(344,RCRCPT_",",.04,"I")
  1. . . I RCERA D Q
  1. . . . S RCERADT=$G(^RCY(344.4,RCERA,0)) ; ERA Data extracted
  1. . . . Q:'RCERADT
  1. . . . S RCTRACE=$P(RCERADT,U,2) ; Trace #
  1. . . . S RCTRLN=$L(RCTRACE),RCTRBD=$S(RCTRLN<11:1,1:RCTRLN-9)
  1. . . . S RCTRACE=$E(RCTRACE,RCTRBD,RCTRLN) ; get the last 10 digits of Trace #
  1. . . . S RCERARCD=$P($P(RCERADT,U,7),".",1) ;get the date of the ERA
  1. . . . S RCERANUM=$P(RCERADT,U,11)
  1. . . . S RCTIN=$P(RCERADT,U,3)
  1. . . . S RCINS=$P(RCERADT,U,6)
  1. . . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN
  1. . . . ; Q:'RCPAYER ; Quit if Payer/TIN not found
  1. . . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
  1. . . . S RCINSTIN=RCINS_"/"_RCTIN
  1. . . . S RCLPIEN=0
  1. . . . F S RCLPIEN=$O(^RCY(344.4,RCERA,1,RCLPIEN)) Q:'RCLPIEN D
  1. . . . . ; I $$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",.25,"I")="" Q ; PRCA*4.5*349 - No receipt, line is not posted
  1. . . . . S RCDTDATA=$G(^RCY(344.4,RCERA,1,RCLPIEN,0))
  1. . . . . S RCEOB=$P(RCDTDATA,U,2)
  1. . . . . S RCBILL=$$BILLIEN^RCDPENR1(RCEOB)
  1. . . . . Q:RCBILL="" ; no billing information
  1. . . . . I RCCLM="C",'$$CLOSEDB(RCBILL) Q ; Bill isn't closed - PRCA*4.5*349 added line
  1. . . . . Q:$D(^TMP("RCDPENR2",$J,"MAIN",RCBILL)) ;already captured.
  1. . . . . S RCDIV=$$DIV^IBJDF2(RCBILL)
  1. . . . . S RCDIV=$$GET1^DIQ(40.8,RCDIV_",",".01","E")
  1. . . . . ;
  1. . . . . S RCRATETP=$$GET1^DIQ(399,RCBILL_",",.07,"I")
  1. . . . . Q:RCRATETP'=RCRATE
  1. . . . . ; Quit if user specified a specific division and bill is not in that Division
  1. . . . . I '$D(^TMP("RCDPENR2",$J,"DIVALL"))&'$D(^TMP("RCDPENR2",$J,"DIV",RCDIV)) Q
  1. . . . . S RCDOS=$$GET1^DIQ(399,RCBILL_",",.03,"I")
  1. . . . . S RCAMTBL=$$GET1^DIQ(361.1,RCEOB_",",2.04,"I")
  1. . . . . S RCAMTPD=$$GET1^DIQ(361.1,RCEOB_",",1.01,"I")
  1. . . . . S RCDTBILL=$$GET1^DIQ(399,RCBILL_",",12,"I")
  1. . . . . Q:RCDTBILL="" ;cant calculate if date first printed is NULL
  1. . . . . ;
  1. . . . . S RCMETHOD=$S($$GET1^DIQ(344.41,RCLPIEN_","_RCERA_",",9,"I")="":"MANUAL",1:"AUTOPOST") ; PRCA*4.5*349
  1. . . . . S RCPAPER=$P($G(^RCY(344.4,RCERA,20)),U,3) ; Paper EOB ERA?
  1. . . . . ;ERA not a paper ERA, is the EOB a Paper EOB
  1. . . . . S:'RCPAPER RCPAPER=$S($$GET1^DIQ(361.1,RCEOB_",",.17,"I")=0:"ERA",1:"PAPER")
  1. . . . . S RCEFTTYP=$S(RCPAYTYP=4:"PAPER",1:"EFT")
  1. . . . . S RCTRNTYP=RCPAPER_"/"_RCEFTTYP
  1. . . . . S RCERAIDX=$S(RCTRNTYP="ERA/EFT":1,RCTRNTYP="ERA/PAPER":2,RCTRNTYP="PAPER/EFT":3,1:4)
  1. . . . . Q:RCERAIDX=4 ;Paper Check Paper EOB not supported
  1. . . . . S RCDATA=RCBILL_U_RCERA_U_RCIEN_U_RCEOB_U_RCDOS_U_RCAMTBL_U_RCAMTPD_U_RCDTBILL_U_RCERARCD
  1. . . . . S RCDATA=RCDATA_U_RCEFTRCD_U_RCPOSTED_U_RCTRACE_U_RCMETHOD_U
  1. . . . . S RCDATA=RCDATA_RCTRNTYP_U_RCERANUM_U_RCDIV_U_RCINSTIN_U_RCEFTPD
  1. . . . . S ^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,RCERAIDX,RCBILL)=RCDATA ; PRCA*4.5*349 add post method
  1. . . I (RCMSTAT=2),(RCIEN),('$D(^TMP("RCDPENR2",$J,"EFT",RCIEN))) D
  1. . . . S RCTIN=$P(RCEFTDT,U,3)
  1. . . . S RCINS=$P(RCEFTDT,U,2)
  1. . . . S RCPAYER=$$GETARPYR^RCDPENR2(RCTIN,ZZPNAME) ; find the AR Payer IEN
  1. . . . ; Q:'RCPAYER ; Quit if Payer/TIN not found
  1. . . . ; Q:'$$INSCHK^RCDPENR2(RCPAYER) ; Payer is not in the included list for the report
  1. . . . S RCINSTIN=RCINS_"/"_RCTIN
  1. . . . S RCMETHOD="MANUAL" ; PRCA*4.5*349 - Unmatched EFT must be manually posted
  1. . . . F X=RCMETHOD,"TOTAL" D ; PRCA*4.5*349
  1. . . . . S RCESUMDT=$G(^TMP("RCDPENR2",$J,"GTOT",X,3)) ; PRCA*4.5*349
  1. . . . . S RCPSUMDT=$G(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,X,3)) ; PRCA*4.5*349
  1. . . . . S $P(RCESUMDT,U,14)=$P(RCESUMDT,U,14)+1
  1. . . . . S $P(RCPSUMDT,U,14)=$P(RCPSUMDT,U,14)+1
  1. . . . . S $P(RCESUMDT,U,15)=$P(RCESUMDT,U,15)+RCEFTPD
  1. . . . . S $P(RCPSUMDT,U,15)=$P(RCPSUMDT,U,15)+RCEFTPD
  1. . . . . S ^TMP("RCDPENR2",$J,"GTOT",X,3)=RCESUMDT ; PRCA*4.5*349
  1. . . . . S ^TMP("RCDPENR2",$J,"PAYER",RCINSTIN,X,3)=RCPSUMDT ; PRCA*4.5*349
  1. Q
  1. ;
  1. CLOSEDB(RCBILL) ;EP
  1. ; PRCA*4.5*349 - Added subroutine
  1. ; Check to see if a bill is closed
  1. ; Input: RCBILL - IEN for 361.1 of the bill to be checked
  1. ; Returns: 1 - Bill is closed, 0 Otherwise
  1. N XX
  1. S XX=$$GET1^DIQ(430,RCBILL_",",8,"I")
  1. S XX=$$GET1^DIQ(430.3,XX_",",1)
  1. I XX="CC" Q 1
  1. Q 0
  1. ;
  1. ;Print the Grand Total/Summary data for the EFT/ERA Trending Report
  1. 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
  1. ; Input: RCTITLE - Name of the report
  1. ; RCDATA - Array of compiled data being processed. RCDATA("A") autoposted, RCDATA("M") manually posted
  1. ; RCDISP - 1 - Display to screen, 0 otherwise
  1. ; RCERAFLG - 1 if we're in the ERA matched to an EFT section
  1. ; 0 otherwise
  1. ; RCEXCEL - 1 output to excel, 0 otherwise
  1. ; RCSTOP - Initialized to 0
  1. ; Output: RCSTOP - User stopped the display of the report
  1. ;
  1. ; Undeclared Parameter(s) - RCRPIEN,RCLINE,RCSTOP
  1. ; RCRPIEN - IEN of the archive file (344.91(
  1. ; RCLINE - String of '-' to be used as a separator line
  1. ; RCSUMFLG - 'M' - Main Report
  1. ; 'G' - Grand totals
  1. ; 'S' - Summary
  1. ;
  1. ;PRCA*4.5*332 comments end
  1. ;
  1. N RCCOUNT,RCBILL,RCPAID,RCPCT,RCBECT,RCBEDY,RCAVGBE,RCEECT,RCEEDY
  1. N RCEPCT,RCEPDY,RCAVGEP,RCBPCT,RCBPDY,RCAVGBP,RCBORDER,RCSCDATA
  1. N RCC,RCB,RCAVGEE,RCLTXT,I,RCSTRDTA,RCSTRNG,RCDTXT
  1. ;
  1. S RCERAFLG=+$G(RCERAFLG),RCDISP=$G(RCDISP)
  1. I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER^RCDPENR2
  1. ;
  1. ; Display report type being displayed
  1. D PRINTHDR^RCDPENR2(RCTITLE)
  1. ;
  1. ; Extract data from string and build string for output
  1. S $P(RCSCDATA,U,1)=+$P(RCDATA,U)
  1. S RCBILL=+$P(RCDATA,U,2)
  1. S RCPAID=+$P(RCDATA,U,3)
  1. S $P(RCSCDATA,U,2)=RCBILL
  1. S $P(RCSCDATA,U,3)=RCPAID
  1. S $P(RCSCDATA,U,4)=$S(+RCBILL=0:0,1:RCPAID/RCBILL)*100 ; Convert to percent format
  1. S RCBECT=+$P(RCDATA,U,4)
  1. S RCBEDY=+$P(RCDATA,U,5)
  1. S $P(RCSCDATA,U,6)=$FN($S(+RCBECT=0:0,1:RCBEDY/RCBECT),"",0)
  1. S RCEECT=+$P(RCDATA,U,6)
  1. S RCEEDY=+$P(RCDATA,U,7)
  1. S $P(RCSCDATA,U,7)=$FN($S(+RCEECT=0:0,1:RCEEDY/RCEECT),"",0)
  1. S RCEPCT=+$P(RCDATA,U,8)
  1. S RCEPDY=+$P(RCDATA,U,9)
  1. S $P(RCSCDATA,U,8)=$FN($S(+RCEPCT=0:0,1:RCEPDY/RCEPCT),"",0)
  1. S RCBPCT=+$P(RCDATA,U,10)
  1. S RCBPDY=+$P(RCDATA,U,11)
  1. S $P(RCSCDATA,U,9)=$FN($S(+RCBPCT=0:0,1:RCBPDY/RCBPCT),"",0)
  1. S $P(RCSCDATA,U,11)=+$P(RCDATA,U,12)
  1. S $P(RCSCDATA,U,12)=+$P(RCDATA,U,13)
  1. S $P(RCSCDATA,U,14)=+$P(RCDATA,U,14)
  1. S $P(RCSCDATA,U,15)=+$P(RCDATA,U,15)
  1. S $P(RCSCDATA,U,16)=RCPAID-$P(RCDATA,U,15)
  1. F I=1:1:16 D Q:RCSTOP
  1. . ; PRC*4.5*332, added (RCSUMFLG'="G") below
  1. . I (RCSUMFLG'="G"),RCDISP,($Y>(IOSL-4)) D Q:RCSTOP
  1. . . D ASK^RCDPEADP(.RCSTOP,0)
  1. . . Q:RCSTOP
  1. . . D HEADER^RCDPENR2
  1. . ;if printing from monthly background job save in file and quit
  1. . ;Otherwise print to screen
  1. . S (RCLTXT,RCDTXT)=$P($T(GDTXT+I),";;",2)
  1. . I RCTITLE["PAPER" D
  1. . . I (I>5),(I<9) D ; correct display for lines 6,7,8,16
  1. . . . I (I=6),RCTITLE["CHECK" Q ;Dont change line 6 if Paper check section
  1. . . . S RCB="EFT",RCC="CHK" ; Correct display for Paper check section
  1. . . . I RCTITLE["EOB" S RCB="ERA",RCC="EOB" ;correct display for paper eob
  1. . . . S RCDTXT=$P(RCLTXT,RCB,1)_RCC_$P(RCLTXT,RCB,2)
  1. . I 'RCDISP!RCEXCEL D Q
  1. . . S RCSTRDTA=$P(RCSCDATA,U,I)
  1. . . ;Format lines: lines 2&3 are amounts, 4 is a percentage, remainder are integers.
  1. . . S RCSTRNG=RCDTXT_"^"_$S(I=4:$J($P(RCSTRDTA,"."),2)_"%",1:RCSTRDTA)
  1. . . I 'RCDISP D SAVEDATA^RCDPENR1(RCSTRNG,RCRPIEN) Q
  1. . .;if printing in an EXCEL format, print "^" delimited and quit
  1. . . I RCEXCEL W RCSTRNG,! Q
  1. . ;Output to screen
  1. . ;currency format
  1. . I (I=2)!(I=3)!(I=15) W RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),! Q
  1. . ; For the line items that are percentages. Not using $J formatting due to rounding errors.
  1. . I I=4 W RCDTXT,?65,$J($P($P(RCSCDATA,U,I),"."),12),"%",! Q
  1. . ;Otherwise print Number format
  1. . I (I=16) D Q
  1. . . W:RCERAFLG RCDTXT,?65,$J($P(RCSCDATA,U,I),13,2),!
  1. . W RCDTXT,?65,$J($P(RCSCDATA,U,I),13),!
  1. I RCSTOP Q RCSTOP
  1. I RCDISP W RCLINE,! ;Otherwise print Number format
  1. I 'RCDISP D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
  1. Q RCSTOP
  1. ;
  1. GDTXT ;
  1. ;;TOTAL NUMBER OF CLAIMS
  1. ;;TOTAL AMOUNT BILLED
  1. ;;TOTAL AMOUNT PAID
  1. ;;PERCENTAGE AMOUNT PAID: (%Total Paid/Billed)
  1. ;;
  1. ;;AVG #DAYS BETWEEN BILLED/ERA
  1. ;;AVG #DAYS BETWEEN ERA/EFT
  1. ;;AVG #DAYS BETWEEN ERA+EFT REC'D/PMT POSTED
  1. ;;AVG #DAYS BETWEEN BILLED/PMT POSTED
  1. ;;
  1. ;;TOTAL NUMBER OF ERAs
  1. ;;TOTAL NUMBER OF EEOBs
  1. ;;
  1. ;;TOTAL NUMBER OF EFTs
  1. ;;TOTAL AMOUNT COLLECTED
  1. ;;TOTAL DIFFERENCE BETWEEN ERAs (PAID) - EFTs (COLLECTED):
  1. Q