RCDPENE1 ;AITC/CJE - NEGATIVE ERA LINE REPORT ;Dec 20, 2014@18:42
;;4.5;Accounts Receivable;**424**;Mar 20, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
Q
COMPILE ; Generate the Auto Posting report ^TMP array
; Input: GLOB - "^TMP("RCDPENER",$J)"
; RCDISP - 0 - Output to paper or screen, 1 - Output to Excel
; RCDIV - 1 - All divisions, 2 - Selected divisions
; RCDIVS()- Array of selected divisions if RCDIV=2
; RCRANGE - 1^Start Date^End Date
; RCJOB - $J
; RCLAIM - "M" - Medical Claims, "P" - Pharmacy Claims, "B" - Both
; RCPAGE - Initialized to 0
; RCPARRAY- Array of selected payers
; RCPROG - "RCDPENER"
; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
; ^TMP("RCSELPAY",RCJOB) - Selected Payer Names or TINs
;
; Output: ^TMP("RCDPENER",$J) Contains report details in ^ delimited format
; (See SAVE subroutine for details)
;
N AMT,APDATE,CNT,END,ERAIEN,IEN,OKAY,RCECME,RCRZ,STA,STNAM,STNUM
S APDATE=$$FMADD^XLFDT($P(RCRANGE,U,2),-1)
S APDATE=APDATE+.24 ; File date has time stamp, prevent it from including date/time before selected range
S END=$P(RCRANGE,U,3),CNT=0
;
; Scan AC index for ERA within date range of ERA created dates
F S APDATE=$O(^RCY(344.4,"AFD",APDATE)) Q:'APDATE Q:(APDATE\1)>END D
. S ERAIEN=""
. F S ERAIEN=$O(^RCY(344.4,"AFD",APDATE,ERAIEN)) Q:'ERAIEN D
. . ;
. . ; Check division - Note return values are set to UNKNOWN if not available
. . D ERASTA^RCDPEAPQ(ERAIEN,.STA,.STNUM,.STNAM)
. . I RCDIV=2,'$D(RCDIVS(STA)) Q
. . ;
. . ; PRCA*4.5*304 - Check if we include this ERA in report
. . I RCPAY="A",RCLAIM'="A" D Q:'OKAY
. . . S OKAY=$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCLAIM)
. . ;
. . ; Check Payer Name
. . I RCPAY'="A" D Q:'OKAY
. . . S OKAY=$$ISSEL^RCDPEU1(344.4,ERAIEN)
. . ;
. . ; If it does not already exist for this ERA, build X-ref of ERA detail lines to the lines in the worklist
. . I '$D(^TMP("RCDPEAPP2",$J,ERAIEN)) D BUILD^RCDPEAPQ(ERAIEN)
. . ;
. . ; Scan index for negative lines within the ERA and save to ^TMP if there is one
. . S RCRZ=0 I ERAIEN=92933
. . F S RCRZ=$O(^RCY(344.4,ERAIEN,1,RCRZ)) Q:'RCRZ D ;
. . . S AMT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.03,"I")
. . . I AMT<0 D SAVE(ERAIEN,RCRZ,RCSORT) ; Save negative claim line detail to ^TMP global
Q
SAVE(ERAIEN,RCRZ,RCSORT) ; EP - Save to ^TMP global
; Input: ERAIEN - Internal IEN into file 344.4
; RCRZ - Internal IEN into sub-file 344.41
; STNAM - Division Name (Primary Sort)
; STNUM - Station Number
; ^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ) - Array of detail lines
; Output: ^TMP("RCDPENER",$J) Contains report details in ^ delimited format
;
; 1 - Station Name (STNAM)
; 2 - Station Number (STNUM)
; 3 - Payer Name (PAYNAM)
; 4 - Patient Name (PTNAM)
; 5 - ERA # (ERANUM)
; 6 - ERA Date (ERADATE)
; 7 - Claim # (BILL)
; 8 - Amount Paid (TOTPAMT)
; 9 - Claim Balance (TOTBAL)
; 10 - Claim Status (STATUS)
; 11 - Trace # (TRACE)
; 12 - Date of Service (DOS)
;
N BALANCE,BAMT,BILL,CLAIMIEN,COLLECT,DATE,DOS,EOBIEN,ERADATE,ERANUM ; PRCA*4.5*345
N PAMT,PAYIX1,PAYIX2,PAYNAM,PTNAM,RECEIPT,SEQ,SEQ1,SEQ2,STATUS,STIX
N TIN,TOTBAL,TOTBAMT,TOTPAMT,TRACE,XX
S PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E") ; Payer Name from ERA Record
S TIN=$$GET1^DIQ(344.4,ERAIEN,.03,"E") ; Payer TIN from ERA Record
S:RCSORT=0 PAYIX1=PAYNAM,PAYIX2=TIN
S:RCSORT=1 PAYIX1=TIN,PAYIX2=PAYNAM
S:PAYNAM="" PAYNAM="UNKNOWN"
S STIX=STNAM_"/"_STNUM
;
S TRACE=$$GET1^DIQ(344.4,ERAIEN,.02,"E") ; Trace Number
S PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ) ; Patient name from claim file #399
S ERANUM=$$GET1^DIQ(344.4,ERAIEN,.01,"E") ; ERA Number
S ERADATE=$$GET1^DIQ(344.4,ERAIEN,.07,"I") ; Date received (file date/time)
S ERADATE=$$FMTE^XLFDT(ERADATE,"2DZ")
S XX=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.25,"I") ; Receipt IEN
;
S (TOTBAMT,TOTBAL,COLLECT,CLAIMIEN,TOTPAMT)=0,DOS="UNKNOWN",BILL="",STATUS=""
S EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.02,"I") ; IEN for 361.1
I EOBIEN D ;
. S CLAIMIEN=$$GET1^DIQ(361.1,EOBIEN,.01,"I") ; IEN for 399
. S DOS=$$GET1^DIQ(361.1,EOBIEN,1.1,"I") ; Date of Service
. S DOS=$$FMTE^XLFDT(DOS,"2DZ")
. S BILL=$$EXTERNAL^DILFD(344.41,.02,,EOBIEN) ; Bill Number
. ; Get Billed Amount from AR (Original Balance)
. I CLAIMIEN D
. . S TOTBAMT=$J(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2) ; Original Amount
. . S TOTBAL=$J(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2) ; Principal Balance
. . S STATUS=$$GET1^DIQ(430,CLAIMIEN,8,"E") ; Claim Status
S TOTPAMT=$J($$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.03,"I"),0,2) ; Amount Paid on Claim
; Balance from AR (Principal Balance)
;
S PTNAM=$S('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
S:TOTBAMT COLLECT=$J(TOTPAMT/TOTBAMT*100,0,2)_"%"
S CNT=CNT+1
S XX=STNAM_U_STNUM_U_PAYNAM_U_PTNAM_U_ERANUM_U_ERADATE
S XX=XX_U_BILL_U_TOTPAMT_U_TOTBAL_U_STATUS_U_TRACE_U_DOS
S @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENE1 5425 printed Sep 23, 2025@19:21:03 Page 2
RCDPENE1 ;AITC/CJE - NEGATIVE ERA LINE REPORT ;Dec 20, 2014@18:42
+1 ;;4.5;Accounts Receivable;**424**;Mar 20, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
COMPILE ; Generate the Auto Posting report ^TMP array
+1 ; Input: GLOB - "^TMP("RCDPENER",$J)"
+2 ; RCDISP - 0 - Output to paper or screen, 1 - Output to Excel
+3 ; RCDIV - 1 - All divisions, 2 - Selected divisions
+4 ; RCDIVS()- Array of selected divisions if RCDIV=2
+5 ; RCRANGE - 1^Start Date^End Date
+6 ; RCJOB - $J
+7 ; RCLAIM - "M" - Medical Claims, "P" - Pharmacy Claims, "B" - Both
+8 ; RCPAGE - Initialized to 0
+9 ; RCPARRAY- Array of selected payers
+10 ; RCPROG - "RCDPENER"
+11 ; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
+12 ; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
+13 ; ^TMP("RCSELPAY",RCJOB) - Selected Payer Names or TINs
+14 ;
+15 ; Output: ^TMP("RCDPENER",$J) Contains report details in ^ delimited format
+16 ; (See SAVE subroutine for details)
+17 ;
+18 NEW AMT,APDATE,CNT,END,ERAIEN,IEN,OKAY,RCECME,RCRZ,STA,STNAM,STNUM
+19 SET APDATE=$$FMADD^XLFDT($PIECE(RCRANGE,U,2),-1)
+20 ; File date has time stamp, prevent it from including date/time before selected range
SET APDATE=APDATE+.24
+21 SET END=$PIECE(RCRANGE,U,3)
SET CNT=0
+22 ;
+23 ; Scan AC index for ERA within date range of ERA created dates
+24 FOR
SET APDATE=$ORDER(^RCY(344.4,"AFD",APDATE))
if 'APDATE
QUIT
if (APDATE\1)>END
QUIT
Begin DoDot:1
+25 SET ERAIEN=""
+26 FOR
SET ERAIEN=$ORDER(^RCY(344.4,"AFD",APDATE,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:2
+27 ;
+28 ; Check division - Note return values are set to UNKNOWN if not available
+29 DO ERASTA^RCDPEAPQ(ERAIEN,.STA,.STNUM,.STNAM)
+30 IF RCDIV=2
IF '$DATA(RCDIVS(STA))
QUIT
+31 ;
+32 ; PRCA*4.5*304 - Check if we include this ERA in report
+33 IF RCPAY="A"
IF RCLAIM'="A"
Begin DoDot:3
+34 SET OKAY=$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCLAIM)
End DoDot:3
if 'OKAY
QUIT
+35 ;
+36 ; Check Payer Name
+37 IF RCPAY'="A"
Begin DoDot:3
+38 SET OKAY=$$ISSEL^RCDPEU1(344.4,ERAIEN)
End DoDot:3
if 'OKAY
QUIT
+39 ;
+40 ; If it does not already exist for this ERA, build X-ref of ERA detail lines to the lines in the worklist
+41 IF '$DATA(^TMP("RCDPEAPP2",$JOB,ERAIEN))
DO BUILD^RCDPEAPQ(ERAIEN)
+42 ;
+43 ; Scan index for negative lines within the ERA and save to ^TMP if there is one
+44 SET RCRZ=0
IF ERAIEN=92933
+45 ;
FOR
SET RCRZ=$ORDER(^RCY(344.4,ERAIEN,1,RCRZ))
if 'RCRZ
QUIT
Begin DoDot:3
+46 SET AMT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.03,"I")
+47 ; Save negative claim line detail to ^TMP global
IF AMT<0
DO SAVE(ERAIEN,RCRZ,RCSORT)
End DoDot:3
End DoDot:2
End DoDot:1
+48 QUIT
SAVE(ERAIEN,RCRZ,RCSORT) ; EP - Save to ^TMP global
+1 ; Input: ERAIEN - Internal IEN into file 344.4
+2 ; RCRZ - Internal IEN into sub-file 344.41
+3 ; STNAM - Division Name (Primary Sort)
+4 ; STNUM - Station Number
+5 ; ^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ) - Array of detail lines
+6 ; Output: ^TMP("RCDPENER",$J) Contains report details in ^ delimited format
+7 ;
+8 ; 1 - Station Name (STNAM)
+9 ; 2 - Station Number (STNUM)
+10 ; 3 - Payer Name (PAYNAM)
+11 ; 4 - Patient Name (PTNAM)
+12 ; 5 - ERA # (ERANUM)
+13 ; 6 - ERA Date (ERADATE)
+14 ; 7 - Claim # (BILL)
+15 ; 8 - Amount Paid (TOTPAMT)
+16 ; 9 - Claim Balance (TOTBAL)
+17 ; 10 - Claim Status (STATUS)
+18 ; 11 - Trace # (TRACE)
+19 ; 12 - Date of Service (DOS)
+20 ;
+21 ; PRCA*4.5*345
NEW BALANCE,BAMT,BILL,CLAIMIEN,COLLECT,DATE,DOS,EOBIEN,ERADATE,ERANUM
+22 NEW PAMT,PAYIX1,PAYIX2,PAYNAM,PTNAM,RECEIPT,SEQ,SEQ1,SEQ2,STATUS,STIX
+23 NEW TIN,TOTBAL,TOTBAMT,TOTPAMT,TRACE,XX
+24 ; Payer Name from ERA Record
SET PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E")
+25 ; Payer TIN from ERA Record
SET TIN=$$GET1^DIQ(344.4,ERAIEN,.03,"E")
+26 if RCSORT=0
SET PAYIX1=PAYNAM
SET PAYIX2=TIN
+27 if RCSORT=1
SET PAYIX1=TIN
SET PAYIX2=PAYNAM
+28 if PAYNAM=""
SET PAYNAM="UNKNOWN"
+29 SET STIX=STNAM_"/"_STNUM
+30 ;
+31 ; Trace Number
SET TRACE=$$GET1^DIQ(344.4,ERAIEN,.02,"E")
+32 ; Patient name from claim file #399
SET PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ)
+33 ; ERA Number
SET ERANUM=$$GET1^DIQ(344.4,ERAIEN,.01,"E")
+34 ; Date received (file date/time)
SET ERADATE=$$GET1^DIQ(344.4,ERAIEN,.07,"I")
+35 SET ERADATE=$$FMTE^XLFDT(ERADATE,"2DZ")
+36 ; Receipt IEN
SET XX=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.25,"I")
+37 ;
+38 SET (TOTBAMT,TOTBAL,COLLECT,CLAIMIEN,TOTPAMT)=0
SET DOS="UNKNOWN"
SET BILL=""
SET STATUS=""
+39 ; IEN for 361.1
SET EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.02,"I")
+40 ;
IF EOBIEN
Begin DoDot:1
+41 ; IEN for 399
SET CLAIMIEN=$$GET1^DIQ(361.1,EOBIEN,.01,"I")
+42 ; Date of Service
SET DOS=$$GET1^DIQ(361.1,EOBIEN,1.1,"I")
+43 SET DOS=$$FMTE^XLFDT(DOS,"2DZ")
+44 ; Bill Number
SET BILL=$$EXTERNAL^DILFD(344.41,.02,,EOBIEN)
+45 ; Get Billed Amount from AR (Original Balance)
+46 IF CLAIMIEN
Begin DoDot:2
+47 ; Original Amount
SET TOTBAMT=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2)
+48 ; Principal Balance
SET TOTBAL=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2)
+49 ; Claim Status
SET STATUS=$$GET1^DIQ(430,CLAIMIEN,8,"E")
End DoDot:2
End DoDot:1
+50 ; Amount Paid on Claim
SET TOTPAMT=$JUSTIFY($$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.03,"I"),0,2)
+51 ; Balance from AR (Principal Balance)
+52 ;
+53 SET PTNAM=$SELECT('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
+54 if TOTBAMT
SET COLLECT=$JUSTIFY(TOTPAMT/TOTBAMT*100,0,2)_"%"
+55 SET CNT=CNT+1
+56 SET XX=STNAM_U_STNUM_U_PAYNAM_U_PTNAM_U_ERANUM_U_ERADATE
+57 SET XX=XX_U_BILL_U_TOTPAMT_U_TOTBAL_U_STATUS_U_TRACE_U_DOS
+58 SET @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
+59 ;
+60 QUIT
