RCDPEAPQ ;AITC/CJE - AUTO POST REPORT -CONTINUED ;Dec 20, 2014@18:42
;;4.5;Accounts Receivable;**298,304,326,345,424**;Mar 20, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
; PRCA*4.5*326 - Routine created as an overflow for RCDPEAPP due to size
Q
SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,RCSORT) ; EP - Save to ^TMP global
; Input: ERAIEN - Internal IEN into file 344.4
; RCRZ - Internal IEN into sub-file 344.41
; RCTYPE - 'D' for detail report, 'S' for summary
; APDATE - Internal Auto-Posting date
; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
; STNAM - Division Name (Primary Sort)
; STNUM - Station Number
; ^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ) - Array of detail lines
; Output: GTOTAL - A1^A2^A3^A4 Where:
; A1 - Total Count
; A2 - Total Original Amounts
; A3 - Total Payment Amounts
; A4 - Total Balance
N BALANCE,BAMT,BILL,CLAIMIEN,COLLECT,DATE,DEPNO,EFTIEN,EFTNUM,EOBIEN,ERADATE,ERANUM ; PRCA*4.5*345
N PAMT,PAYIX1,PAYIX2,PAYNAM,PTNAM,RECEIPT,SEQ,SEQ1,SEQ2,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 (TOTBAMT,TOTBAL,TOTPAMT)=0
;
; Detail mode, get these extra fields
I RCTYPE="D" D
. 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 DATE=$$FMTE^XLFDT(APDATE,"2DZ") ; Auto-Posting DATE
. S EFTNUM=$O(^RCY(344.31,"AERA",ERANUM,"")) ; EFT Number
. S EFTIEN="" I EFTNUM D ; PRCA*4.5*345
. . S EFTIEN=$$GET1^DIQ(344.31,EFTNUM,.01,"I")
. . S EFTNUM=$$GET1^DIQ(344.31,EFTNUM,.01,"E")
. S XX=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.25,"I") ; Receipt IEN
. S RECEIPT=$$EXTERNAL^DILFD(344.41,.25,,XX)
. S DEPNO="" ; PRCA*4.5*345 Deposit ticket number
. I EFTIEN S DEPNO=$$GET1^DIQ(344.3,EFTIEN_",",.03,"E") ; PRCA*4.5*345
;
; Get link to the scratchpad detail line. If the worklist detail records exist,
; loop through the ones with the same prefix to get the data (this will have split-edits)
S SEQ=$G(^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ))
I SEQ D
. S SEQ1=SEQ
. F S SEQ1=$O(^RCY(344.49,ERAIEN,1,"B",SEQ1)) Q:'SEQ1!(SEQ1\1'=SEQ) D
. . S SEQ2=$O(^RCY(344.49,ERAIEN,1,"B",SEQ1,""))
. . Q:SEQ2=""
. . S (BAMT,BALANCE,COLLECT)=""
. . S CLAIMIEN=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.07,"I") ; AR Bill
. . S BILL=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.02,"I") ; Claim #
. . I BILL="" S BILL="<blank>"
. . S PAMT=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.06,"I") ; Amount Paid on Claim
. . ;
. . ; If there is a claim, get billed amount and balance from the claim
. . I CLAIMIEN D
. . . S BAMT=$J(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2) ; Original Amount
. . . S BALANCE=$J(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2) ; Principal Balance
. . ;
. . ; Update total amounts
. . S TOTBAMT=TOTBAMT+BAMT,TOTBAL=TOTBAL+BALANCE,TOTPAMT=TOTPAMT+PAMT
. . I RCTYPE="D" D ; Get extra data for detail report
. . . S PTNAM=$S('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
. . . S:BAMT COLLECT=$J(PAMT/BAMT*100,0,2)_"%"
. . . S CNT=CNT+1
. . . S XX=STNAM_U_STNUM_U_$S(RCSORT:TIN_"/"_PAYNAM,1:PAYNAM_"/"_TIN)_U ; PRCA*4.5*326 add TIN
. . . S XX=XX_PTNAM_U_ERANUM_U_ERADATE_U_DATE_U_EFTNUM
. . . S XX=XX_U_RECEIPT_U_BILL_U_BAMT_U_PAMT_U_BALANCE_U_COLLECT_U_TRACE_U_DEPNO ; PRCA*4.5*345
. . . S @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX ; Add data for detail report
;
; If the worklist detail record does not exist, get data from ERA detail
I 'SEQ D
. S (TOTBAMT,TOTBAL,COLLECT,CLAIMIEN)=0
. S EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.02,"I") ; IEN for 361.1
. S:EOBIEN CLAIMIEN=$$GET1^DIQ(361.1,EOBIEN,.01,"I") ; IEN for 399
. 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 TOTPAMT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.03,"I") ; Amount Paid on Claim
. ;
. ; Balance from AR (Principal Balance)
. S:CLAIMIEN TOTBAL=$J(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2) ; Principal Balance
. ;
. ; Detail Report, get extra data and then update the detail global
. I RCTYPE="D" D
. . 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_U_DATE_U_EFTNUM
. . S XX=XX_U_RECEIPT_U_BILL_U_TOTBAMT_U_TOTPAMT_U_TOTBAL_U_COLLECT_U_TRACE_U_DEPNO ; PRCA*4.5*345
. . S @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
;
; Update totals for individual division
S $P(@GLOB@(STIX),U,1)=$P($G(@GLOB@(STIX)),U,1)+1
S $P(@GLOB@(STIX),U,2)=$P($G(@GLOB@(STIX)),U,2)+TOTBAMT
S $P(@GLOB@(STIX),U,3)=$P($G(@GLOB@(STIX)),U,3)+TOTPAMT
S $P(@GLOB@(STIX),U,4)=$P($G(@GLOB@(STIX)),U,4)+TOTBAL
;
; Update totals for individual division/payer
S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,1)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,1)+1
S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,2)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,2)+TOTBAMT
S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,3)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,3)+TOTPAMT
S $P(@GLOB@(STIX,PAYIX1,PAYIX2),U,4)=$P($G(@GLOB@(STIX,PAYIX1,PAYIX2)),U,4)+TOTBAL
;
; Update grand totals
S $P(GTOTAL,U,1)=$P($G(GTOTAL),U,1)+1,$P(GTOTAL,U,2)=$P($G(GTOTAL),U,2)+TOTBAMT
S $P(GTOTAL,U,3)=$P($G(GTOTAL),U,3)+TOTPAMT,$P(GTOTAL,U,4)=$P($G(GTOTAL),U,4)+TOTBAL
Q
;
ERASTA(ERAIEN,STA,STNUM,STNAM) ; EP - Get the station (Division) for this ERA
; Input: ERAIEN -
; Output: STA - Internal Division IEN
; STNUM - Division Number
; STNAME - Division Name
N ERAEOB,ERABILL,FOUND,STAIEN
S (ERAEOB,ERABILL,FOUND)=""
S (STA,STNUM,STNAM)="UNKNOWN"
D
. S ERAEOB=$$GET1^DIQ(344.41,"1,"_ERAIEN_",",.02,"I") Q:'ERAEOB
. S ERABILL=$$GET1^DIQ(361.1,ERAEOB,.01,"I") Q:'ERABILL
. S STAIEN=$$GET1^DIQ(399,ERABILL,.22,"I") Q:'STAIEN
. S STA=STAIEN
. S STNAM=$$EXTERNAL^DILFD(399,.22,,STA)
. S STNUM=$$GET1^DIQ(40.8,STAIEN,1,"E")
Q
;
COMPILE ; Generate the Auto Posting report ^TMP array
; Input: GLOB - "^TMP("RCDPEAPP",$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 - "RCDPEAPP"
; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
; RCTYPE - 'D' for detail report, 'S' for summary
; RCPAYMNT - 'Z' - Zero pay ERAs only, 'P' - Non-Zero ERAs only, 'A' All - PRCA*4.5*424
; ^TMP("RCSELPAY",RCJOB) - Selected Payer Names or TINs
; Ouput: GTOTAL - A1^A2^A3^A4 Where:
; A1 - Total Count
; A2 - Total Original Amounts
; A3 - Total Payment Amounts
; A4 - Total Balance
; ^TMP("RCSELPAY",RCJOB,A1)=A2/A3 Where:
; A1 - CTR
; A2 - Payer Name if RCWHICH=1 else Payer TIN
; A3 - Payer TIN if RCWHICH=1 else Payer Name
N APDATE,CNT,END,ERAIEN,IEN,OKAY,RCECME,RCAMT,RCRZ,STA,STNAM,STNUM ; PRCA*4.5*424 add RCAMT
S APDATE=$$FMADD^XLFDT($P(RCRANGE,U,2),-1)
S END=$P(RCRANGE,U,3),CNT=0
;
; Scan F index for ERA within date range
F S APDATE=$O(^RCY(344.4,"F",APDATE)) Q:'APDATE Q:(APDATE\1)>END D
. S ERAIEN=""
. F S ERAIEN=$O(^RCY(344.4,"F",APDATE,ERAIEN)) Q:'ERAIEN D
. . ;
. . ; Check division - Note return values are set to UNKNOWN if not available
. . D ERASTA(ERAIEN,.STA,.STNUM,.STNAM)
. . I RCDIV=2,'$D(RCDIVS(STA)) Q
. . ;
. . ; PRCA*4.5*424 - Filter by payment type
. . S RCAMT=+$P($G(^RCY(344.4,ERAIEN,0)),"^",5)
. . I RCPAYMNT'="A",(RCAMT=0&(RCPAYMNT="P"))!(RCAMT&(RCPAYMNT="Z")) Q
. . ;
. . ; PRCA*4.5*304 - Check if we include this ERA in report
. . I RCPAY="A",RCLAIM'="A" D Q:'OKAY ; PRCA*4.5*326 If all payers included, check by type
. . . S OKAY=$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCLAIM)
. . ;
. . ; Check Payer Name
. . I RCPAY'="A" D Q:'OKAY ; PRCA*4.5*326
. . . 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(ERAIEN)
. . ;
. . ; Scan index for auto posted claim lines within the ERA
. . S RCRZ=""
. . F S RCRZ=$O(^RCY(344.4,"F",APDATE,ERAIEN,RCRZ)) Q:'RCRZ D
. . . D SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,RCSORT) ; Save claim line detail to ^TMP global
Q
;
BUILD(RCSCR) ; Build cross-reference of ERA detail lines to ERA scratch-pad lines
; Input: RCSCR - Internal IEN of file 344.4/344.49
N CNT,ERADET,ERALINE,SUB,SUB1
Q:'$G(RCSCR) ; No ERA IEN
Q:'$D(^RCY(344.49,RCSCR)) ; No scratch pad entry for ERA
S SUB=0
F S SUB=$O(^RCY(344.49,RCSCR,1,"B",SUB)) Q:SUB="" D
. Q:SUB["." ; Skip split edit lines
. S SUB1=$O(^RCY(344.49,RCSCR,1,"B",SUB,"")) ; Get scratchpad ^RCY(344.49,RCSCR,1) node
. Q:'SUB1
. ;
. ; Get pointer back to ERA detail line(s) - This can be a set of comma pieces
. S ERALINE=$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,9)
. F CNT=1:1:$L(ERALINE,",") D
. . S ERADET=$P(ERALINE,",",CNT)
. . I ERADET S ^TMP("RCDPEAPP2",$J,RCSCR,ERADET)=+$G(^RCY(344.49,RCSCR,1,SUB1,0))
Q
;
; PRCA*4.5*424 - Subroutine added
PAYMNT() ; Payment Type (Zero/Payment or Both) Selection. EP from RCDPEAPP
; Input: None
; Output: None
; Returns: A - All ERAs, P - ERAs with payments, Z - Zero payment ERAs
N DIR,DTOUT,DUOUT,RCTYPEDF
K DIR S DIR(0)="SA^A:ALL;P:PAYMENT;Z:ZERO;"
S DIR("A")="Display (A)ll ERAs, those with (P)ayments or (Z)ero Dollar ERAs?: "
S DIR("B")="B"
S DIR("?",1)="Select (A)ALL to see both zero and non-zero amount ERAs."
S DIR("?",2)="Select (P)AYMENT to only see ERAs with a non-zero amount paid."
S DIR("?")="Select (Z)ERO to only see ERAs with a zero total amount paid."
S DIR("B")="A" ; Default is all ERAs
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAPQ 11237 printed Dec 13, 2024@01:44:20 Page 2
RCDPEAPQ ;AITC/CJE - AUTO POST REPORT -CONTINUED ;Dec 20, 2014@18:42
+1 ;;4.5;Accounts Receivable;**298,304,326,345,424**;Mar 20, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; PRCA*4.5*326 - Routine created as an overflow for RCDPEAPP due to size
+4 QUIT
SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,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 ; RCTYPE - 'D' for detail report, 'S' for summary
+4 ; APDATE - Internal Auto-Posting date
+5 ; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
+6 ; STNAM - Division Name (Primary Sort)
+7 ; STNUM - Station Number
+8 ; ^TMP("RCDPEAPP2",$J,ERAIEN,RCRZ) - Array of detail lines
+9 ; Output: GTOTAL - A1^A2^A3^A4 Where:
+10 ; A1 - Total Count
+11 ; A2 - Total Original Amounts
+12 ; A3 - Total Payment Amounts
+13 ; A4 - Total Balance
+14 ; PRCA*4.5*345
NEW BALANCE,BAMT,BILL,CLAIMIEN,COLLECT,DATE,DEPNO,EFTIEN,EFTNUM,EOBIEN,ERADATE,ERANUM
+15 NEW PAMT,PAYIX1,PAYIX2,PAYNAM,PTNAM,RECEIPT,SEQ,SEQ1,SEQ2,STIX
+16 NEW TIN,TOTBAL,TOTBAMT,TOTPAMT,TRACE,XX
+17 ; Payer Name from ERA Record
SET PAYNAM=$$GET1^DIQ(344.4,ERAIEN,.06,"E")
+18 ; Payer TIN from ERA Record
SET TIN=$$GET1^DIQ(344.4,ERAIEN,.03,"E")
+19 if RCSORT=0
SET PAYIX1=PAYNAM
SET PAYIX2=TIN
+20 if RCSORT=1
SET PAYIX1=TIN
SET PAYIX2=PAYNAM
+21 if PAYNAM=""
SET PAYNAM="UNKNOWN"
+22 SET STIX=STNAM_"/"_STNUM
+23 SET (TOTBAMT,TOTBAL,TOTPAMT)=0
+24 ;
+25 ; Detail mode, get these extra fields
+26 IF RCTYPE="D"
Begin DoDot:1
+27 ; Trace Number
SET TRACE=$$GET1^DIQ(344.4,ERAIEN,.02,"E")
+28 ; Patient name from claim file #399
SET PTNAM=$$PNM4^RCDPEWL1(ERAIEN,RCRZ)
+29 ; ERA Number
SET ERANUM=$$GET1^DIQ(344.4,ERAIEN,.01,"E")
+30 ; Date received (file date/time)
SET ERADATE=$$GET1^DIQ(344.4,ERAIEN,.07,"I")
+31 SET ERADATE=$$FMTE^XLFDT(ERADATE,"2DZ")
+32 ; Auto-Posting DATE
SET DATE=$$FMTE^XLFDT(APDATE,"2DZ")
+33 ; EFT Number
SET EFTNUM=$ORDER(^RCY(344.31,"AERA",ERANUM,""))
+34 ; PRCA*4.5*345
SET EFTIEN=""
IF EFTNUM
Begin DoDot:2
+35 SET EFTIEN=$$GET1^DIQ(344.31,EFTNUM,.01,"I")
+36 SET EFTNUM=$$GET1^DIQ(344.31,EFTNUM,.01,"E")
End DoDot:2
+37 ; Receipt IEN
SET XX=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.25,"I")
+38 SET RECEIPT=$$EXTERNAL^DILFD(344.41,.25,,XX)
+39 ; PRCA*4.5*345 Deposit ticket number
SET DEPNO=""
+40 ; PRCA*4.5*345
IF EFTIEN
SET DEPNO=$$GET1^DIQ(344.3,EFTIEN_",",.03,"E")
End DoDot:1
+41 ;
+42 ; Get link to the scratchpad detail line. If the worklist detail records exist,
+43 ; loop through the ones with the same prefix to get the data (this will have split-edits)
+44 SET SEQ=$GET(^TMP("RCDPEAPP2",$JOB,ERAIEN,RCRZ))
+45 IF SEQ
Begin DoDot:1
+46 SET SEQ1=SEQ
+47 FOR
SET SEQ1=$ORDER(^RCY(344.49,ERAIEN,1,"B",SEQ1))
if 'SEQ1!(SEQ1\1'=SEQ)
QUIT
Begin DoDot:2
+48 SET SEQ2=$ORDER(^RCY(344.49,ERAIEN,1,"B",SEQ1,""))
+49 if SEQ2=""
QUIT
+50 SET (BAMT,BALANCE,COLLECT)=""
+51 ; AR Bill
SET CLAIMIEN=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.07,"I")
+52 ; Claim #
SET BILL=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.02,"I")
+53 IF BILL=""
SET BILL="<blank>"
+54 ; Amount Paid on Claim
SET PAMT=$$GET1^DIQ(344.491,SEQ2_","_ERAIEN,.06,"I")
+55 ;
+56 ; If there is a claim, get billed amount and balance from the claim
+57 IF CLAIMIEN
Begin DoDot:3
+58 ; Original Amount
SET BAMT=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2)
+59 ; Principal Balance
SET BALANCE=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2)
End DoDot:3
+60 ;
+61 ; Update total amounts
+62 SET TOTBAMT=TOTBAMT+BAMT
SET TOTBAL=TOTBAL+BALANCE
SET TOTPAMT=TOTPAMT+PAMT
+63 ; Get extra data for detail report
IF RCTYPE="D"
Begin DoDot:3
+64 SET PTNAM=$SELECT('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
+65 if BAMT
SET COLLECT=$JUSTIFY(PAMT/BAMT*100,0,2)_"%"
+66 SET CNT=CNT+1
+67 ; PRCA*4.5*326 add TIN
SET XX=STNAM_U_STNUM_U_$SELECT(RCSORT:TIN_"/"_PAYNAM,1:PAYNAM_"/"_TIN)_U
+68 SET XX=XX_PTNAM_U_ERANUM_U_ERADATE_U_DATE_U_EFTNUM
+69 ; PRCA*4.5*345
SET XX=XX_U_RECEIPT_U_BILL_U_BAMT_U_PAMT_U_BALANCE_U_COLLECT_U_TRACE_U_DEPNO
+70 ; Add data for detail report
SET @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
End DoDot:3
End DoDot:2
End DoDot:1
+71 ;
+72 ; If the worklist detail record does not exist, get data from ERA detail
+73 IF 'SEQ
Begin DoDot:1
+74 SET (TOTBAMT,TOTBAL,COLLECT,CLAIMIEN)=0
+75 ; IEN for 361.1
SET EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.02,"I")
+76 ; IEN for 399
if EOBIEN
SET CLAIMIEN=$$GET1^DIQ(361.1,EOBIEN,.01,"I")
+77 ; Bill Number
SET BILL=$$EXTERNAL^DILFD(344.41,.02,,EOBIEN)
+78 ;
+79 ; Get Billed Amount from AR (Original Balance)
+80 IF CLAIMIEN
Begin DoDot:2
+81 ; Original Amount
SET TOTBAMT=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,3,"I"),0,2)
End DoDot:2
+82 ; Amount Paid on Claim
SET TOTPAMT=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN,.03,"I")
+83 ;
+84 ; Balance from AR (Principal Balance)
+85 ; Principal Balance
if CLAIMIEN
SET TOTBAL=$JUSTIFY(+$$GET1^DIQ(430,CLAIMIEN,71,"I"),0,2)
+86 ;
+87 ; Detail Report, get extra data and then update the detail global
+88 IF RCTYPE="D"
Begin DoDot:2
+89 SET PTNAM=$SELECT('CLAIMIEN:"",1:$$PNM4^RCDPEWL1(ERAIEN,RCRZ))
+90 if TOTBAMT
SET COLLECT=$JUSTIFY(TOTPAMT/TOTBAMT*100,0,2)_"%"
+91 SET CNT=CNT+1
+92 SET XX=STNAM_U_STNUM_U_PAYNAM_U_PTNAM_U_ERANUM_U_ERADATE_U_DATE_U_EFTNUM
+93 ; PRCA*4.5*345
SET XX=XX_U_RECEIPT_U_BILL_U_TOTBAMT_U_TOTPAMT_U_TOTBAL_U_COLLECT_U_TRACE_U_DEPNO
+94 SET @GLOB@(STIX,PAYIX1,PAYIX2,CNT)=XX
End DoDot:2
End DoDot:1
+95 ;
+96 ; Update totals for individual division
+97 SET $PIECE(@GLOB@(STIX),U,1)=$PIECE($GET(@GLOB@(STIX)),U,1)+1
+98 SET $PIECE(@GLOB@(STIX),U,2)=$PIECE($GET(@GLOB@(STIX)),U,2)+TOTBAMT
+99 SET $PIECE(@GLOB@(STIX),U,3)=$PIECE($GET(@GLOB@(STIX)),U,3)+TOTPAMT
+100 SET $PIECE(@GLOB@(STIX),U,4)=$PIECE($GET(@GLOB@(STIX)),U,4)+TOTBAL
+101 ;
+102 ; Update totals for individual division/payer
+103 SET $PIECE(@GLOB@(STIX,PAYIX1,PAYIX2),U,1)=$PIECE($GET(@GLOB@(STIX,PAYIX1,PAYIX2)),U,1)+1
+104 SET $PIECE(@GLOB@(STIX,PAYIX1,PAYIX2),U,2)=$PIECE($GET(@GLOB@(STIX,PAYIX1,PAYIX2)),U,2)+TOTBAMT
+105 SET $PIECE(@GLOB@(STIX,PAYIX1,PAYIX2),U,3)=$PIECE($GET(@GLOB@(STIX,PAYIX1,PAYIX2)),U,3)+TOTPAMT
+106 SET $PIECE(@GLOB@(STIX,PAYIX1,PAYIX2),U,4)=$PIECE($GET(@GLOB@(STIX,PAYIX1,PAYIX2)),U,4)+TOTBAL
+107 ;
+108 ; Update grand totals
+109 SET $PIECE(GTOTAL,U,1)=$PIECE($GET(GTOTAL),U,1)+1
SET $PIECE(GTOTAL,U,2)=$PIECE($GET(GTOTAL),U,2)+TOTBAMT
+110 SET $PIECE(GTOTAL,U,3)=$PIECE($GET(GTOTAL),U,3)+TOTPAMT
SET $PIECE(GTOTAL,U,4)=$PIECE($GET(GTOTAL),U,4)+TOTBAL
+111 QUIT
+112 ;
ERASTA(ERAIEN,STA,STNUM,STNAM) ; EP - Get the station (Division) for this ERA
+1 ; Input: ERAIEN -
+2 ; Output: STA - Internal Division IEN
+3 ; STNUM - Division Number
+4 ; STNAME - Division Name
+5 NEW ERAEOB,ERABILL,FOUND,STAIEN
+6 SET (ERAEOB,ERABILL,FOUND)=""
+7 SET (STA,STNUM,STNAM)="UNKNOWN"
+8 Begin DoDot:1
+9 SET ERAEOB=$$GET1^DIQ(344.41,"1,"_ERAIEN_",",.02,"I")
if 'ERAEOB
QUIT
+10 SET ERABILL=$$GET1^DIQ(361.1,ERAEOB,.01,"I")
if 'ERABILL
QUIT
+11 SET STAIEN=$$GET1^DIQ(399,ERABILL,.22,"I")
if 'STAIEN
QUIT
+12 SET STA=STAIEN
+13 SET STNAM=$$EXTERNAL^DILFD(399,.22,,STA)
+14 SET STNUM=$$GET1^DIQ(40.8,STAIEN,1,"E")
End DoDot:1
+15 QUIT
+16 ;
COMPILE ; Generate the Auto Posting report ^TMP array
+1 ; Input: GLOB - "^TMP("RCDPEAPP",$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 - "RCDPEAPP"
+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 ; RCTYPE - 'D' for detail report, 'S' for summary
+14 ; RCPAYMNT - 'Z' - Zero pay ERAs only, 'P' - Non-Zero ERAs only, 'A' All - PRCA*4.5*424
+15 ; ^TMP("RCSELPAY",RCJOB) - Selected Payer Names or TINs
+16 ; Ouput: GTOTAL - A1^A2^A3^A4 Where:
+17 ; A1 - Total Count
+18 ; A2 - Total Original Amounts
+19 ; A3 - Total Payment Amounts
+20 ; A4 - Total Balance
+21 ; ^TMP("RCSELPAY",RCJOB,A1)=A2/A3 Where:
+22 ; A1 - CTR
+23 ; A2 - Payer Name if RCWHICH=1 else Payer TIN
+24 ; A3 - Payer TIN if RCWHICH=1 else Payer Name
+25 ; PRCA*4.5*424 add RCAMT
NEW APDATE,CNT,END,ERAIEN,IEN,OKAY,RCECME,RCAMT,RCRZ,STA,STNAM,STNUM
+26 SET APDATE=$$FMADD^XLFDT($PIECE(RCRANGE,U,2),-1)
+27 SET END=$PIECE(RCRANGE,U,3)
SET CNT=0
+28 ;
+29 ; Scan F index for ERA within date range
+30 FOR
SET APDATE=$ORDER(^RCY(344.4,"F",APDATE))
if 'APDATE
QUIT
if (APDATE\1)>END
QUIT
Begin DoDot:1
+31 SET ERAIEN=""
+32 FOR
SET ERAIEN=$ORDER(^RCY(344.4,"F",APDATE,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:2
+33 ;
+34 ; Check division - Note return values are set to UNKNOWN if not available
+35 DO ERASTA(ERAIEN,.STA,.STNUM,.STNAM)
+36 IF RCDIV=2
IF '$DATA(RCDIVS(STA))
QUIT
+37 ;
+38 ; PRCA*4.5*424 - Filter by payment type
+39 SET RCAMT=+$PIECE($GET(^RCY(344.4,ERAIEN,0)),"^",5)
+40 IF RCPAYMNT'="A"
IF (RCAMT=0&(RCPAYMNT="P"))!(RCAMT&(RCPAYMNT="Z"))
QUIT
+41 ;
+42 ; PRCA*4.5*304 - Check if we include this ERA in report
+43 ; PRCA*4.5*326 If all payers included, check by type
IF RCPAY="A"
IF RCLAIM'="A"
Begin DoDot:3
+44 SET OKAY=$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCLAIM)
End DoDot:3
if 'OKAY
QUIT
+45 ;
+46 ; Check Payer Name
+47 ; PRCA*4.5*326
IF RCPAY'="A"
Begin DoDot:3
+48 SET OKAY=$$ISSEL^RCDPEU1(344.4,ERAIEN)
End DoDot:3
if 'OKAY
QUIT
+49 ;
+50 ; If it does not already exist for this ERA, build X-ref of ERA detail lines to the lines in the worklist
+51 IF '$DATA(^TMP("RCDPEAPP2",$JOB,ERAIEN))
DO BUILD(ERAIEN)
+52 ;
+53 ; Scan index for auto posted claim lines within the ERA
+54 SET RCRZ=""
+55 FOR
SET RCRZ=$ORDER(^RCY(344.4,"F",APDATE,ERAIEN,RCRZ))
if 'RCRZ
QUIT
Begin DoDot:3
+56 ; Save claim line detail to ^TMP global
DO SAVE(ERAIEN,RCRZ,RCTYPE,APDATE,RCSORT)
End DoDot:3
End DoDot:2
End DoDot:1
+57 QUIT
+58 ;
BUILD(RCSCR) ; Build cross-reference of ERA detail lines to ERA scratch-pad lines
+1 ; Input: RCSCR - Internal IEN of file 344.4/344.49
+2 NEW CNT,ERADET,ERALINE,SUB,SUB1
+3 ; No ERA IEN
if '$GET(RCSCR)
QUIT
+4 ; No scratch pad entry for ERA
if '$DATA(^RCY(344.49,RCSCR))
QUIT
+5 SET SUB=0
+6 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+7 ; Skip split edit lines
if SUB["."
QUIT
+8 ; Get scratchpad ^RCY(344.49,RCSCR,1) node
SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
+9 if 'SUB1
QUIT
+10 ;
+11 ; Get pointer back to ERA detail line(s) - This can be a set of comma pieces
+12 SET ERALINE=$PIECE($GET(^RCY(344.49,RCSCR,1,SUB1,0)),U,9)
+13 FOR CNT=1:1:$LENGTH(ERALINE,",")
Begin DoDot:2
+14 SET ERADET=$PIECE(ERALINE,",",CNT)
+15 IF ERADET
SET ^TMP("RCDPEAPP2",$JOB,RCSCR,ERADET)=+$GET(^RCY(344.49,RCSCR,1,SUB1,0))
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ; PRCA*4.5*424 - Subroutine added
PAYMNT() ; Payment Type (Zero/Payment or Both) Selection. EP from RCDPEAPP
+1 ; Input: None
+2 ; Output: None
+3 ; Returns: A - All ERAs, P - ERAs with payments, Z - Zero payment ERAs
+4 NEW DIR,DTOUT,DUOUT,RCTYPEDF
+5 KILL DIR
SET DIR(0)="SA^A:ALL;P:PAYMENT;Z:ZERO;"
+6 SET DIR("A")="Display (A)ll ERAs, those with (P)ayments or (Z)ero Dollar ERAs?: "
+7 SET DIR("B")="B"
+8 SET DIR("?",1)="Select (A)ALL to see both zero and non-zero amount ERAs."
+9 SET DIR("?",2)="Select (P)AYMENT to only see ERAs with a non-zero amount paid."
+10 SET DIR("?")="Select (Z)ERO to only see ERAs with a zero total amount paid."
+11 ; Default is all ERAs
SET DIR("B")="A"
+12 WRITE !
+13 DO ^DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+15 QUIT Y
