RCDPEAD ;ALB/PJH - AUTO DECREASE ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**298,304,318,326,332,345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;Read ^IBM(361.1) via Private IA 4051
;
EN ;Auto Decrease - applies to auto-posted claims only
;
; Begin PRCA*4.5*345
N AD,AP,J,RCDAY
S AP=$$GET1^DIQ(344.61,"1,",.02,"I") ; Medical Claims Auto-Posting on/off
S AD=$$GET1^DIQ(344.61,"1,",.03,"I") ; Medical Claims Auto-Decrease on/off
I AP,AD D ; Attempt to Auto-Decrease Medical Claims w/Payments
. S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.04))
. D EN1A(RCDAY,1,1)
;
S AD=$$GET1^DIQ(344.61,"1,",.11,"I") ; Medical Claims Auto-Decrease no-pay on/off
I AP,AD D ; Attempt to Auto-Decrease Medical Claims w/No Payments
. S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12))
. D EN1A(RCDAY,2,1)
;
S AP=$$GET1^DIQ(344.61,"1,",1.01,"I") ; Rx Claims Auto-Posting on/off
S AD=$$GET1^DIQ(344.61,"1,",1.02,"I") ; Rx Claims Auto-Decrease on/off
I AP,AD D ; Attempt to Auto-Decrease Rx Claims w/Payments
. S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.03))
. D EN1A(RCDAY,1,2)
;
; PRCA*4.5*349 - Begin added block
S AP=$$GET1^DIQ(344.61,"1,",1.05,"I") ; TRICARE Claims Auto-Posting on/off
S AD=$$GET1^DIQ(344.61,"1,",1.06,"I") ; TRICARE Claims w/payments Auto-Decrease on/off
I AP,AD D ; Attempt to Auto-Decrease TRICARE Claims w/Payments
. S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.08))
. D EN1A(RCDAY,1,3)
;
S AD=$$GET1^DIQ(344.61,"1,",1.09,"I") ; TRICARE Claims Auto-Decrease no-pay on/off
I AP,AD D ; Attempt to Auto-Decrease TRICARE Claims w/No Payments
. D REJ^RCDPEAD4(3)
; PRCA*4.5*349 - End added block
;
; Payer Rejects for Medical Claims
S AP=$$GET1^DIQ(344.61,"1,",.02,"I") ; Medical Claims Auto-Posting on/off
S AD=$$GET1^DIQ(344.61,"1,",.03,"I") ; Medical Claims Auto-Decrease on/off
I AP,AD D ; Attempt to Auto-Decrease Rx Claims w/Payments
. D REJ^RCDPEAD4(1)
; End PRCA*4.5*345
Q
;
EN1A(RCDAY,PAID,WHICH) ; Scan ERA's for auto-posted lines on RCDAY
; PRCA*4.5*345 - Added WHICH
; Input: RCDAY - Day to begin search for auto-posted but not decreased lines
; PAID - 1 - Decrease paid lines only, 2 - Decrease no-pay lines only
; WHICH - 1 - Checking for Medical Claims, 2 - Checking for Rx Claims
; Output: Auto-decreases claims (potentially)
;
; Scan F (Auto-Post) index for ERAs within date range
S RCDATE=$$FMADD^XLFDT(RCDAY,-1)
F D Q:'RCDATE Q:(RCDATE\1)>RCDAY
. S RCDATE=$O(^RCY(344.4,"F",RCDATE))
. Q:'RCDATE
. Q:(RCDATE\1)>RCDAY
. ;
. ; Scan ERA detail lines for claims with AUTOPOST DATE field #4.03 matching RCDAY
. D EN2(RCDATE,RCDAY,PAID,WHICH) ; PRCA*4.5*345 - Added WHICH
Q
;
EN2(RCDATE,RCDAY,PAID,WHICH) ; Scans the 'F' index of the ERA file for ERA entries with an
; AUTOPOST DATE field (#4.03) matching RCDAY
; PRCA*4.5*345 - Added WHICH
; Input: RCDATE - Auto-Post Date of the ERA
; RCDAY - Day to begin search for auto-posted but not decreased lines
; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
; WHICH - 1 - Checking for Medical Claims
; 2 - Checking for Rx Claims
; 3 - Checking for TRICARE Claims
N IEN3446,PAYID,PAYNAM,RCARRAY,RCERA,RCRTYPE ; PRCA*4.5*345 - Added IEN3446
S RCERA=0
F D Q:'RCERA
. K RCARRAY
. S RCERA=$O(^RCY(344.4,"F",RCDATE,RCERA))
. Q:'RCERA
. S XX=$$ISTYPE^RCDPEU1(344.4,RCERA,"T") ; PRCA*4.5*349 - Added line
. I XX S RCRTYPE=2 ; PRCA*4.5*349 - Check if this is TRICARE ERA
. E S RCRTYPE=$$PHARM^RCDPEAP1(RCERA) ; It must be a Medical or Rx ERA
. I RCRTYPE'=0,WHICH=1 Q ; PRCA*4.5*345 - Not processing Medical Claims
. I RCRTYPE'=1,WHICH=2 Q ; PRCA*4.5*345 - Not processing Rx Claims
. I RCRTYPE'=2,WHICH=3 Q ; PRCA*4.5*349 - Not processing TRICARE Claims
. S PAYID=$$GET1^DIQ(344.4,RCERA_",",.03,"E") ; Payer TIN
. S PAYNAM=$$GET1^DIQ(344.4,RCERA_",",.06,"E") ; Payer Name
. S PAYNAM=$P($G(^RCY(344.4,RCERA,0)),U,6)
. S IEN3446=""
. I PAYID'="",PAYNAM'="" D
. . S IEN3446=$O(^RCY(344.6,"CPID",PAYNAM,PAYID,""))
. ;
. ; Skip if payer is excluded from Auto-Post or Auto-Decrease
. I $$PAYEX(WHICH,IEN3446) Q
. ;
. ; Build index to scratchpad for this ERA
. D BUILD^RCDPEAP(RCERA,.RCARRAY)
. ;
. ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
. D EN3(RCDATE,RCERA,.RCARRAY,PAID,WHICH) ; PRCA*4.5*345 - Added WHICH
Q
;
EN3(RCDATE,RCERA,RCARRAY,PAID,WHICH) ; Scan ERA Detail lines in #344.41 for
; auto-posted Medical/Rx claims - PRCA*4.5*345 added WHICH
; Input: RCDATE - Auto-Post Date
; RCERA - IEN of the ERA (#344.4)
; RCARRAY - Array of ERA Scratchpad lines
; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
N IENS,RCADJ,RCLINE
S RCLINE=0
;
; Find auto-posted claim lines to auto-decrease
F D Q:'RCLINE
. S RCLINE=$O(^RCY(344.4,"F",RCDATE,RCERA,RCLINE))
. Q:'RCLINE
. ;
. ; Ignore claim line if already auto decreased
. Q:$P($G(^RCY(344.4,RCERA,1,RCLINE,5)),U,3)
. ;
. ; Process line
. D EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE,WHICH) ; PRCA*4.5*345 - Added WHICH
Q
;
EN4(RCDATE,RCERA,RCARRAY,PAID,RCLINE,WHICH) ; Auto-decrease selected lines
; PRCA*4.5*345 - Added WHICH
; Input: RCDATE - Auto-Post Date
; RCERA - IEN of the ERA (#344.4)
; RCARRAY - Array of scratch pad lines
; PAID - 1 - Decrease paid lines
; 2 - Decrease no-pay lines
; RCLINE - IEN of the detail ilne in sub-file 344.41
; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
;
; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
; BEGIN PRCA*4.5*326
N COMMENT,EOBIEN,J,PENDING,RCAMT,RCBAL,RCBILL,RCIARR,RCITEN,RCJ,RCK,RCMAX,RCTRANDA,RCZERO,STATUS
;
; Check if this is a zero payment line
S RCZERO=$S($$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)=0:1,1:0)
;
; Quit if this is a no-payment line and loop is for payment lines
I PAID=1,RCZERO Q
;
; Quit if this is not a no-payment line and loop is for no-payment lines
I PAID=2,'RCZERO Q
;
; Ignore zero amount reversals
I RCZERO Q:'$G(RCARRAY(RCLINE))
;
; Ignore zero lines if status is unverified in scratchpad (#344.491,.13)
I RCZERO D Q:'$$GET1^DIQ(344.491,IENS,.13,"I")
. S IENS=$G(RCARRAY(RCLINE))_","_RCERA
; END PRCA*4.5*326
;
; Get pointer to EOB file #361.1 from ERA DETAIL
S EOBIEN=$P($G(^RCY(344.4,RCERA,1,RCLINE,0)),U,2),RCBILL=0
;
; Get ^DGCR(399 pointer (DINUM for #430 file)
S:EOBIEN RCBILL=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCBILL
;
; If claim has been split/edit and claim changed in APAR do not auto decrease
Q:$$SPLIT(RCERA,RCLINE,RCBILL,.RCARRAY)
;
; Do not auto decrease if claim is referred to General Council
Q:$P($G(^PRCA(430,RCBILL,6)),U,4)'=""
;
; Claim must be OPEN or ACTIVE
S STATUS=$P($G(^PRCA(430,RCBILL,0)),"^",8)
I STATUS'=42,STATUS'=16 Q
;
S RCAMT=$$CARCLMT(EOBIEN,RCZERO,WHICH) ; PRCA*4.5*345 - Added WHICH
Q:$L(RCAMT)=0 ; No CARCs on EOB were eligible for auto-decrease
;
; Order CARCs for Auto-Decrease in largest to smallest amount order
K RCIARR
F J=1:1 S RCITEM=$P(RCAMT,U,J) Q:RCITEM="" S RCIARR(-($P(RCITEM,";",1)),J)=RCITEM
Q:$D(RCIARR)<10 ; Quit if CARC adjustment array doesn't have any elements to process
;
; Get top limit for auto-decrease
I WHICH=1 S RCMAX=+$$GET1^DIQ(344.61,"1,",.05) ; Medical Claims limit PRCA*4.5*345
E I WHICH=2 S RCMAX=+$$GET1^DIQ(344.61,"1,",1.04) ; Rx Claims limit PRCA*4.5*349
E S RCMAX=+$$GET1^DIQ(344.61,"1,",1.07) ; TRICARE Claims limit PRCA*4.5*349
;
; Walk the RCIARR and apply CARC based adjustments to the bill.
S RCJ="",RCADJ=0
F S RCJ=$O(RCIARR(RCJ)) Q:RCJ="" S RCK="" F S RCK=$O(RCIARR(RCJ,RCK)) Q:RCK="" D
. ; Get current balance on Bill
. S RCBAL=$P($G(^PRCA(430,RCBILL,7)),U)
. ;
. ; Check pending payment amount and bill balance
. S PENDING=$$PENDPAY^RCDPURET(RCBILL)
. K ^TMP($J,"RCDPUREC","PP")
. Q:(RCBAL-PENDING)<(+$P(RCIARR(RCJ,RCK),";",1))
. ;
. Q:(RCADJ+$P(RCIARR(RCJ,RCK),";",1))>RCMAX ; Don't apply decrease if over top limit
. ;
. S XX=$S(WHICH=1:"MEDICAL",WHICH=2:"PHARMACY",1:"TRICARE") ; PRCA*4.5*345, PRCA*4.5*349 Rx and TRICARE
. S COMMENT(1)=XX+" AUTO-DECREASE FOR CARC: "_$P(RCIARR(RCJ,RCK),";",2) ; PRCA*4.5*345
. S COMMENT(1)=COMMENT(1)_" AMOUNT: "_+$P(RCIARR(RCJ,RCK),";",1) ; PRCA*4.5*326
. S COMMENT(1)=COMMENT(1)_" (MAX DEC: "
. S COMMENT(1)=COMMENT(1)_+$P($$ACTCARC^RCDPEAD2($P(RCIARR(RCJ,RCK),";",2),RCZERO,WHICH),U,2)_")" ; PRCA*4.5*326
. ;
. ; If this CARC is expired then add that information to the comment
. I $P(RCIARR(RCJ,RCK),";",3)'="" D
. . S COMMENT(1)=COMMENT(1)_" CARC expired on "_$$FMTE^XLFDT($P(RCIARR(RCJ,RCK),";",3),"6D")
. ;
. ; Apply contract adjustment for CARC adjustment amount from claim information
. S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILL,-$P(RCIARR(RCJ,RCK),";",1),.COMMENT,"","",1)
. Q:'RCTRANDA
. ;
. ; Update total adjustments for line
. S RCADJ=RCADJ+$P(RCIARR(RCJ,RCK),";",1)
;
; Update auto-decrease indicator, auto decrease amount and auto decrease date
N DA,DIE,DR
S DA(1)=RCERA,DA=RCLINE,DIE="^RCY(344.4,"_DA(1)_",1,",DR="7///1;8///"_RCADJ_";10///"_DT
D ^DIE
;
; Update last auto decrease date on ERA
N DA,DIE,DR
S DA=RCERA,DIE="^RCY(344.4,",DR="4.03///"_DT
;
; PRCA*4.5*332 - If we just did an Auto-Decrease of a zero-dollar ERA set
; the Match Status to MATCH - 0 PAYMENT and the Posting Status to POSTING NOT NEEDED
I PAID=0,RCZERO D
. S DR=DR_";.09////3;.14////3"
D ^DIE
Q
;
SPLIT(RCSCR,RCLINE,RCBILL,RCARRAY) ;Check for SPLIT/EDIT in scratchpad
;Input RCSCR - IEN of #344.49
; RCLINE - ERA detail line sequence number
; RCBILL - IEN of #430
; ARRAY - reference to passed array (from BUILD^RCDPEAP)
;Output return value 1/0 = Split/Not Split
N SUB,SUB1
;Find ERA line in scratchpad
S SUB=$G(RCARRAY(RCLINE)) Q:'SUB 0
;Get n.001 line
S SUB1=$O(^RCY(344.49,RCSCR,1,SUB)) Q:'SUB1 0
;Check sequence number is the same
Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),".")'=$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U) 0
;Check that claim number is unchanged from original ERA
Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,7)=RCBILL 0
;Otherwise claim was edited (and should not be decreased)
Q 1
;
CARCLMT(RCEOB,RCZERO,WHICH,FROMADP,ADATE) ;EP from COMPILE^RCDPEADP and AUTO^RCDPEWLZ
; Checks to see if CARCs are included and eligible for auto-decrease
; PRCA*4.5*345 - Added WHICH
; Returns 0 if not, Max Amount ^ CARC if it is.
; Input: RCEOB - Internal IEN for the explanation of benefits field (361.1)
; FROMADP - 1 if being called from COMPILE^RCDPEADP, 0 otherwise
; Optional, default to 0
; ADATE - Internal Auto-Post Date (only passed if FROMADP=1)
; RCZERO - 0 = ERA Line with payment 1 = ERA Line without payment
; WHICH - 1 - Checking Auto-Decrease for Medical CARCs
; 2 - Checking Auto-Decrease for Rx CARCs
; 3 - Checking Auto-Decrease for TRICARE CARCs
; Optional, defaults to 1 (Medical)
; Returns: A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where:
; A1 - Auto-Decrease amount of the 1st CARC code in the EOB
; A2 - 1st CARC code in the EOB
; A3 - Deactivation Date of the 1st CARC code in the EOB if
; it has one and is less than today AND FROMADP=0
; Otherwise Quantity of the first CARC code in the EOB if
; FROMADP=1
; A4 - Reason of the 1st CARC code in the EOB
; only passed if FROMADP=1
N I,RCAMT,RCCAMT,RCCODE,RCCODES,RCDATA,RCITEM,RCTAMT,XDT,XIEN
I $G(WHICH)="" S WHICH=1
S:'$D(FROMADP) FROMADP=0
S RCAMT="",RCCODES=""
;
; Extract the CARC codes from the EOB.
; Returned are ^A1;A2;A3;A4^A1;A2;A3;A4^... Where
; A1 - CARC code
; A2 - Auto Decrease Amount
; A3 - Quantity (only returned if FROMADP=1)
; A4 - REASON (only returned if FROMADP=1)
D GETCARCS^RCDPEAD2(RCEOB,.RCCODES,FROMADP)
;
; Loop through all of the CARC codes found. If none, it will exit.
F I=2:1:$L(RCCODES,"^") D
. S RCITEM=$P(RCCODES,"^",I)
. Q:RCITEM=""
. S RCCODE=$P(RCITEM,";",1),RCCAMT=$P(RCITEM,";",2)
. ;
. ; Quit If the Adjustment amount is a negative amount
. Q:+RCCAMT<0
. ;
. ; Look up code in CARC table and get max adjustment
. S RCDATA=$$ACTCARC^RCDPEAD2(RCCODE,RCZERO,WHICH) ; PRCA*4.5*345 - added WHICH
. ;
. ; Quit If auto decrease is not active on this code
. Q:+RCDATA=0
. ;
. ; Get code inactive date if it exists
. S XIEN=$$FIND1^DIC(345,,"O",RCCODE)
. S:$G(XIEN)'="" XDT=$$GET1^DIQ(345,XIEN_",",2,"I")
. I $G(XDT)'="" S:XDT'<DT XDT=""
. S RCTAMT=$P(RCDATA,U,2) ; Get limit
. ;
. ; 11/11/2015: Compare the max adjustment in parameters to the adjustment on EEOB
. ; Quit if over
. ;
. ; If the CARC payer adjustment <= CARC max adjustment amount, Then add to list
. ; for possible adjustments.
. I RCCAMT<(RCTAMT+.01)!FROMADP D
. . ;
. . ; If we're being called from the auto-decrease report, return all CARC information
. . I FROMADP D Q
. . . S XX=RCCAMT_";"_RCCODE_";"_$P(RCITEM,";",3,4)
. . . S RCAMT=$S(RCAMT'[";":XX,1:RCAMT_"^"_XX)
. . S RCAMT=$S($L(RCAMT)=0:RCCAMT_";"_RCCODE_";"_XDT,1:RCAMT_U_RCCAMT_";"_RCCODE_";"_XDT)
Q RCAMT
;
OTHER(RCBILLDA,ORIG) ; Check if APAR/WL entries exist on other ERA for this bill
; INPUT
; RCBILLDA - IEN for claim in #430 or #399
; ORIG - IEN for current ERA
; OUTPUT
; RCPEND - 1 = Other ERA payments exist 0 - No other ERA payments exit
;
N AUTOSTA,RCERA,RCEOB,RCLINE,RCPAID,RCPEND,RCTOT,RCZ,RCZL
; Find EEOB's for this claim
S RCEOB=0,RCPEND=0
F S RCEOB=$O(^IBM(361.1,"B",RCBILLDA,RCEOB)) Q:'RCEOB Q:RCPEND D
. ;Find ERAs for this EOB - may be multiple
. S RCERA=0
. F S RCERA=$O(^RCY(344.4,"ADET",RCEOB,RCERA)) Q:'RCERA Q:RCPEND D
. . ; Ignore original ERA
. . Q:RCERA=ORIG
. . ; Get auto-post status for ERA
. . S AUTOSTA=$$GET1^DIQ(344.4,RCERA_",",4.02,"I")
. . ; Ignore completely processed auto-post ERA
. . Q:AUTOSTA=2
. . ; Ignore non-auto-post ERA which already have a receipt - processed or otherwise
. . I AUTOSTA="",$$GET1^DIQ(344.4,RCERA_",",.08,"I") Q
. . ; Get ERA lines for this EOB
. . S RCLINE=0,RCTOT=0
. . F S RCLINE=$O(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE)) Q:'RCLINE Q:RCPEND D
. . . ; Ignore auto-posted lines (which have a receipt)
. . . I AUTOSTA]"",$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.25) Q
. . . ; Get paid amount from ERA line
. . . S RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)
. . . ; Ignore zero lines
. . . Q:'RCPAID
. . . ; If no scratchpad use paid amount from ERA
. . . I '$D(^RCY(344.49,RCERA)) S RCTOT=RCTOT+RCPAID Q
. . . ; Find ERA line in scratchpad
. . . S RCZL=$$FIND(RCERA,RCLINE) Q:'RCZL
. . . ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4)
. . . S RCSUB=RCZL
. . . F S RCSUB=$O(^RCY(344.49,RCERA,1,"B",RCSUB)) Q:(RCSUB\1)'=RCZL D
. . . . S RCZ=$O(^RCY(344.49,RCERA,1,"B",RCSUB,"")) Q:'RCZ
. . . . ; Check AR BILL is for this claim
. . . . Q:$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA
. . . . ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals
. . . . S RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03)
. . ; If claim total for the ERA is non-zero auto-decrease is blocked
. . S:RCTOT>0 RCPEND=1
Q RCPEND
;
FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line
; Input RCERA - Scratchpad IEN
; RCLINE - ERA line to find
; Output RET - Scratchpad line number
;
N DA,ORIG,RCSUB,RET
S RCSUB=0,RET=0
F S RCSUB=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB)) Q:RET Q:'RCSUB D
. S DA=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,"")) Q:'DA
. ;Get Original sequences
. S ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09) Q:ORIG=""
. ;Check if scratchpad line is for original ERA line
. S ORIG=","_ORIG_","
. S:$F(ORIG,","_RCLINE_",") RET=RCSUB
Q RET
;
PAYEX(WHICH,IEN3446) ; Check if payer is excluded
; Subroutine added for PRCA*4.5*349
; Input: WHICH - 1=Medical, 2=Rx, 3=TRICARE
; IEN3446 - Internal Entry number of Payer Exclusion file entry
; Returns: 1 if payer is excluded, otherwise 0.
;
N FLDA,FLDD,RETURN,XX
S RETURN=0
S FLDA=$S(WHICH=1:.06,WHICH=2:.08,1:.13)
S FLDD=$S(WHICH=1:.07,WHICH=2:.12,1:.14)
; If processing Rx Claims, skip if payer is excluded from Auto-Post or Auto-Decrease
I IEN3446'="" D ;
. S XX=$$GET1^DIQ(344.6,IEN3446_",",FLDA,"I")
. I XX S RETURN=1 Q ; Payer excluded from Rx Auto-Post
. S XX=$$GET1^DIQ(344.6,IEN3446_",",FLDD,"I")
. I XX S RETURN=1 ; Payer excluded from Rx Auto-Decrease
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAD 17867 printed Sep 23, 2025@19:20:12 Page 2
RCDPEAD ;ALB/PJH - AUTO DECREASE ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**298,304,318,326,332,345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Read ^IBM(361.1) via Private IA 4051
+4 ;
EN ;Auto Decrease - applies to auto-posted claims only
+1 ;
+2 ; Begin PRCA*4.5*345
+3 NEW AD,AP,J,RCDAY
+4 ; Medical Claims Auto-Posting on/off
SET AP=$$GET1^DIQ(344.61,"1,",.02,"I")
+5 ; Medical Claims Auto-Decrease on/off
SET AD=$$GET1^DIQ(344.61,"1,",.03,"I")
+6 ; Attempt to Auto-Decrease Medical Claims w/Payments
IF AP
IF AD
Begin DoDot:1
+7 SET RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.04))
+8 DO EN1A(RCDAY,1,1)
End DoDot:1
+9 ;
+10 ; Medical Claims Auto-Decrease no-pay on/off
SET AD=$$GET1^DIQ(344.61,"1,",.11,"I")
+11 ; Attempt to Auto-Decrease Medical Claims w/No Payments
IF AP
IF AD
Begin DoDot:1
+12 SET RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12))
+13 DO EN1A(RCDAY,2,1)
End DoDot:1
+14 ;
+15 ; Rx Claims Auto-Posting on/off
SET AP=$$GET1^DIQ(344.61,"1,",1.01,"I")
+16 ; Rx Claims Auto-Decrease on/off
SET AD=$$GET1^DIQ(344.61,"1,",1.02,"I")
+17 ; Attempt to Auto-Decrease Rx Claims w/Payments
IF AP
IF AD
Begin DoDot:1
+18 SET RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.03))
+19 DO EN1A(RCDAY,1,2)
End DoDot:1
+20 ;
+21 ; PRCA*4.5*349 - Begin added block
+22 ; TRICARE Claims Auto-Posting on/off
SET AP=$$GET1^DIQ(344.61,"1,",1.05,"I")
+23 ; TRICARE Claims w/payments Auto-Decrease on/off
SET AD=$$GET1^DIQ(344.61,"1,",1.06,"I")
+24 ; Attempt to Auto-Decrease TRICARE Claims w/Payments
IF AP
IF AD
Begin DoDot:1
+25 SET RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.08))
+26 DO EN1A(RCDAY,1,3)
End DoDot:1
+27 ;
+28 ; TRICARE Claims Auto-Decrease no-pay on/off
SET AD=$$GET1^DIQ(344.61,"1,",1.09,"I")
+29 ; Attempt to Auto-Decrease TRICARE Claims w/No Payments
IF AP
IF AD
Begin DoDot:1
+30 DO REJ^RCDPEAD4(3)
End DoDot:1
+31 ; PRCA*4.5*349 - End added block
+32 ;
+33 ; Payer Rejects for Medical Claims
+34 ; Medical Claims Auto-Posting on/off
SET AP=$$GET1^DIQ(344.61,"1,",.02,"I")
+35 ; Medical Claims Auto-Decrease on/off
SET AD=$$GET1^DIQ(344.61,"1,",.03,"I")
+36 ; Attempt to Auto-Decrease Rx Claims w/Payments
IF AP
IF AD
Begin DoDot:1
+37 DO REJ^RCDPEAD4(1)
End DoDot:1
+38 ; End PRCA*4.5*345
+39 QUIT
+40 ;
EN1A(RCDAY,PAID,WHICH) ; Scan ERA's for auto-posted lines on RCDAY
+1 ; PRCA*4.5*345 - Added WHICH
+2 ; Input: RCDAY - Day to begin search for auto-posted but not decreased lines
+3 ; PAID - 1 - Decrease paid lines only, 2 - Decrease no-pay lines only
+4 ; WHICH - 1 - Checking for Medical Claims, 2 - Checking for Rx Claims
+5 ; Output: Auto-decreases claims (potentially)
+6 ;
+7 ; Scan F (Auto-Post) index for ERAs within date range
+8 SET RCDATE=$$FMADD^XLFDT(RCDAY,-1)
+9 FOR
Begin DoDot:1
+10 SET RCDATE=$ORDER(^RCY(344.4,"F",RCDATE))
+11 if 'RCDATE
QUIT
+12 if (RCDATE\1)>RCDAY
QUIT
+13 ;
+14 ; Scan ERA detail lines for claims with AUTOPOST DATE field #4.03 matching RCDAY
+15 ; PRCA*4.5*345 - Added WHICH
DO EN2(RCDATE,RCDAY,PAID,WHICH)
End DoDot:1
if 'RCDATE
QUIT
if (RCDATE\1)>RCDAY
QUIT
+16 QUIT
+17 ;
EN2(RCDATE,RCDAY,PAID,WHICH) ; Scans the 'F' index of the ERA file for ERA entries with an
+1 ; AUTOPOST DATE field (#4.03) matching RCDAY
+2 ; PRCA*4.5*345 - Added WHICH
+3 ; Input: RCDATE - Auto-Post Date of the ERA
+4 ; RCDAY - Day to begin search for auto-posted but not decreased lines
+5 ; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
+6 ; WHICH - 1 - Checking for Medical Claims
+7 ; 2 - Checking for Rx Claims
+8 ; 3 - Checking for TRICARE Claims
+9 ; PRCA*4.5*345 - Added IEN3446
NEW IEN3446,PAYID,PAYNAM,RCARRAY,RCERA,RCRTYPE
+10 SET RCERA=0
+11 FOR
Begin DoDot:1
+12 KILL RCARRAY
+13 SET RCERA=$ORDER(^RCY(344.4,"F",RCDATE,RCERA))
+14 if 'RCERA
QUIT
+15 ; PRCA*4.5*349 - Added line
SET XX=$$ISTYPE^RCDPEU1(344.4,RCERA,"T")
+16 ; PRCA*4.5*349 - Check if this is TRICARE ERA
IF XX
SET RCRTYPE=2
+17 ; It must be a Medical or Rx ERA
IF '$TEST
SET RCRTYPE=$$PHARM^RCDPEAP1(RCERA)
+18 ; PRCA*4.5*345 - Not processing Medical Claims
IF RCRTYPE'=0
IF WHICH=1
QUIT
+19 ; PRCA*4.5*345 - Not processing Rx Claims
IF RCRTYPE'=1
IF WHICH=2
QUIT
+20 ; PRCA*4.5*349 - Not processing TRICARE Claims
IF RCRTYPE'=2
IF WHICH=3
QUIT
+21 ; Payer TIN
SET PAYID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
+22 ; Payer Name
SET PAYNAM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
+23 SET PAYNAM=$PIECE($GET(^RCY(344.4,RCERA,0)),U,6)
+24 SET IEN3446=""
+25 IF PAYID'=""
IF PAYNAM'=""
Begin DoDot:2
+26 SET IEN3446=$ORDER(^RCY(344.6,"CPID",PAYNAM,PAYID,""))
End DoDot:2
+27 ;
+28 ; Skip if payer is excluded from Auto-Post or Auto-Decrease
+29 IF $$PAYEX(WHICH,IEN3446)
QUIT
+30 ;
+31 ; Build index to scratchpad for this ERA
+32 DO BUILD^RCDPEAP(RCERA,.RCARRAY)
+33 ;
+34 ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
+35 ; PRCA*4.5*345 - Added WHICH
DO EN3(RCDATE,RCERA,.RCARRAY,PAID,WHICH)
End DoDot:1
if 'RCERA
QUIT
+36 QUIT
+37 ;
EN3(RCDATE,RCERA,RCARRAY,PAID,WHICH) ; Scan ERA Detail lines in #344.41 for
+1 ; auto-posted Medical/Rx claims - PRCA*4.5*345 added WHICH
+2 ; Input: RCDATE - Auto-Post Date
+3 ; RCERA - IEN of the ERA (#344.4)
+4 ; RCARRAY - Array of ERA Scratchpad lines
+5 ; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
+6 ; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
+7 NEW IENS,RCADJ,RCLINE
+8 SET RCLINE=0
+9 ;
+10 ; Find auto-posted claim lines to auto-decrease
+11 FOR
Begin DoDot:1
+12 SET RCLINE=$ORDER(^RCY(344.4,"F",RCDATE,RCERA,RCLINE))
+13 if 'RCLINE
QUIT
+14 ;
+15 ; Ignore claim line if already auto decreased
+16 if $PIECE($GET(^RCY(344.4,RCERA,1,RCLINE,5)),U,3)
QUIT
+17 ;
+18 ; Process line
+19 ; PRCA*4.5*345 - Added WHICH
DO EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE,WHICH)
End DoDot:1
if 'RCLINE
QUIT
+20 QUIT
+21 ;
EN4(RCDATE,RCERA,RCARRAY,PAID,RCLINE,WHICH) ; Auto-decrease selected lines
+1 ; PRCA*4.5*345 - Added WHICH
+2 ; Input: RCDATE - Auto-Post Date
+3 ; RCERA - IEN of the ERA (#344.4)
+4 ; RCARRAY - Array of scratch pad lines
+5 ; PAID - 1 - Decrease paid lines
+6 ; 2 - Decrease no-pay lines
+7 ; RCLINE - IEN of the detail ilne in sub-file 344.41
+8 ; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
+9 ;
+10 ; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
+11 ; BEGIN PRCA*4.5*326
+12 NEW COMMENT,EOBIEN,J,PENDING,RCAMT,RCBAL,RCBILL,RCIARR,RCITEN,RCJ,RCK,RCMAX,RCTRANDA,RCZERO,STATUS
+13 ;
+14 ; Check if this is a zero payment line
+15 SET RCZERO=$SELECT($$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)=0:1,1:0)
+16 ;
+17 ; Quit if this is a no-payment line and loop is for payment lines
+18 IF PAID=1
IF RCZERO
QUIT
+19 ;
+20 ; Quit if this is not a no-payment line and loop is for no-payment lines
+21 IF PAID=2
IF 'RCZERO
QUIT
+22 ;
+23 ; Ignore zero amount reversals
+24 IF RCZERO
if '$GET(RCARRAY(RCLINE))
QUIT
+25 ;
+26 ; Ignore zero lines if status is unverified in scratchpad (#344.491,.13)
+27 IF RCZERO
Begin DoDot:1
+28 SET IENS=$GET(RCARRAY(RCLINE))_","_RCERA
End DoDot:1
if '$$GET1^DIQ(344.491,IENS,.13,"I")
QUIT
+29 ; END PRCA*4.5*326
+30 ;
+31 ; Get pointer to EOB file #361.1 from ERA DETAIL
+32 SET EOBIEN=$PIECE($GET(^RCY(344.4,RCERA,1,RCLINE,0)),U,2)
SET RCBILL=0
+33 ;
+34 ; Get ^DGCR(399 pointer (DINUM for #430 file)
+35 if EOBIEN
SET RCBILL=$PIECE($GET(^IBM(361.1,EOBIEN,0)),U)
if 'RCBILL
QUIT
+36 ;
+37 ; If claim has been split/edit and claim changed in APAR do not auto decrease
+38 if $$SPLIT(RCERA,RCLINE,RCBILL,.RCARRAY)
QUIT
+39 ;
+40 ; Do not auto decrease if claim is referred to General Council
+41 if $PIECE($GET(^PRCA(430,RCBILL,6)),U,4)'=""
QUIT
+42 ;
+43 ; Claim must be OPEN or ACTIVE
+44 SET STATUS=$PIECE($GET(^PRCA(430,RCBILL,0)),"^",8)
+45 IF STATUS'=42
IF STATUS'=16
QUIT
+46 ;
+47 ; PRCA*4.5*345 - Added WHICH
SET RCAMT=$$CARCLMT(EOBIEN,RCZERO,WHICH)
+48 ; No CARCs on EOB were eligible for auto-decrease
if $LENGTH(RCAMT)=0
QUIT
+49 ;
+50 ; Order CARCs for Auto-Decrease in largest to smallest amount order
+51 KILL RCIARR
+52 FOR J=1:1
SET RCITEM=$PIECE(RCAMT,U,J)
if RCITEM=""
QUIT
SET RCIARR(-($PIECE(RCITEM,";",1)),J)=RCITEM
+53 ; Quit if CARC adjustment array doesn't have any elements to process
if $DATA(RCIARR)<10
QUIT
+54 ;
+55 ; Get top limit for auto-decrease
+56 ; Medical Claims limit PRCA*4.5*345
IF WHICH=1
SET RCMAX=+$$GET1^DIQ(344.61,"1,",.05)
+57 ; Rx Claims limit PRCA*4.5*349
IF '$TEST
IF WHICH=2
SET RCMAX=+$$GET1^DIQ(344.61,"1,",1.04)
+58 ; TRICARE Claims limit PRCA*4.5*349
IF '$TEST
SET RCMAX=+$$GET1^DIQ(344.61,"1,",1.07)
+59 ;
+60 ; Walk the RCIARR and apply CARC based adjustments to the bill.
+61 SET RCJ=""
SET RCADJ=0
+62 FOR
SET RCJ=$ORDER(RCIARR(RCJ))
if RCJ=""
QUIT
SET RCK=""
FOR
SET RCK=$ORDER(RCIARR(RCJ,RCK))
if RCK=""
QUIT
Begin DoDot:1
+63 ; Get current balance on Bill
+64 SET RCBAL=$PIECE($GET(^PRCA(430,RCBILL,7)),U)
+65 ;
+66 ; Check pending payment amount and bill balance
+67 SET PENDING=$$PENDPAY^RCDPURET(RCBILL)
+68 KILL ^TMP($JOB,"RCDPUREC","PP")
+69 if (RCBAL-PENDING)<(+$PIECE(RCIARR(RCJ,RCK),";",1))
QUIT
+70 ;
+71 ; Don't apply decrease if over top limit
if (RCADJ+$PIECE(RCIARR(RCJ,RCK),";",1))>RCMAX
QUIT
+72 ;
+73 ; PRCA*4.5*345, PRCA*4.5*349 Rx and TRICARE
SET XX=$SELECT(WHICH=1:"MEDICAL",WHICH=2:"PHARMACY",1:"TRICARE")
+74 ; PRCA*4.5*345
SET COMMENT(1)=XX+" AUTO-DECREASE FOR CARC: "_$PIECE(RCIARR(RCJ,RCK),";",2)
+75 ; PRCA*4.5*326
SET COMMENT(1)=COMMENT(1)_" AMOUNT: "_+$PIECE(RCIARR(RCJ,RCK),";",1)
+76 SET COMMENT(1)=COMMENT(1)_" (MAX DEC: "
+77 ; PRCA*4.5*326
SET COMMENT(1)=COMMENT(1)_+$PIECE($$ACTCARC^RCDPEAD2($PIECE(RCIARR(RCJ,RCK),";",2),RCZERO,WHICH),U,2)_")"
+78 ;
+79 ; If this CARC is expired then add that information to the comment
+80 IF $PIECE(RCIARR(RCJ,RCK),";",3)'=""
Begin DoDot:2
+81 SET COMMENT(1)=COMMENT(1)_" CARC expired on "_$$FMTE^XLFDT($PIECE(RCIARR(RCJ,RCK),";",3),"6D")
End DoDot:2
+82 ;
+83 ; Apply contract adjustment for CARC adjustment amount from claim information
+84 SET RCTRANDA=$$INCDEC^RCBEUTR1(RCBILL,-$PIECE(RCIARR(RCJ,RCK),";",1),.COMMENT,"","",1)
+85 if 'RCTRANDA
QUIT
+86 ;
+87 ; Update total adjustments for line
+88 SET RCADJ=RCADJ+$PIECE(RCIARR(RCJ,RCK),";",1)
End DoDot:1
+89 ;
+90 ; Update auto-decrease indicator, auto decrease amount and auto decrease date
+91 NEW DA,DIE,DR
+92 SET DA(1)=RCERA
SET DA=RCLINE
SET DIE="^RCY(344.4,"_DA(1)_",1,"
SET DR="7///1;8///"_RCADJ_";10///"_DT
+93 DO ^DIE
+94 ;
+95 ; Update last auto decrease date on ERA
+96 NEW DA,DIE,DR
+97 SET DA=RCERA
SET DIE="^RCY(344.4,"
SET DR="4.03///"_DT
+98 ;
+99 ; PRCA*4.5*332 - If we just did an Auto-Decrease of a zero-dollar ERA set
+100 ; the Match Status to MATCH - 0 PAYMENT and the Posting Status to POSTING NOT NEEDED
+101 IF PAID=0
IF RCZERO
Begin DoDot:1
+102 SET DR=DR_";.09////3;.14////3"
End DoDot:1
+103 DO ^DIE
+104 QUIT
+105 ;
SPLIT(RCSCR,RCLINE,RCBILL,RCARRAY) ;Check for SPLIT/EDIT in scratchpad
+1 ;Input RCSCR - IEN of #344.49
+2 ; RCLINE - ERA detail line sequence number
+3 ; RCBILL - IEN of #430
+4 ; ARRAY - reference to passed array (from BUILD^RCDPEAP)
+5 ;Output return value 1/0 = Split/Not Split
+6 NEW SUB,SUB1
+7 ;Find ERA line in scratchpad
+8 SET SUB=$GET(RCARRAY(RCLINE))
if 'SUB
QUIT 0
+9 ;Get n.001 line
+10 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,SUB))
if 'SUB1
QUIT 0
+11 ;Check sequence number is the same
+12 if $PIECE($GET(^RCY(344.49,RCSCR,1,SUB1,0)),".")'=$PIECE($GET(^RCY(344.49,RCSCR,1,SUB,0)),U)
QUIT 0
+13 ;Check that claim number is unchanged from original ERA
+14 if $PIECE($GET(^RCY(344.49,RCSCR,1,SUB1,0)),U,7)=RCBILL
QUIT 0
+15 ;Otherwise claim was edited (and should not be decreased)
+16 QUIT 1
+17 ;
CARCLMT(RCEOB,RCZERO,WHICH,FROMADP,ADATE) ;EP from COMPILE^RCDPEADP and AUTO^RCDPEWLZ
+1 ; Checks to see if CARCs are included and eligible for auto-decrease
+2 ; PRCA*4.5*345 - Added WHICH
+3 ; Returns 0 if not, Max Amount ^ CARC if it is.
+4 ; Input: RCEOB - Internal IEN for the explanation of benefits field (361.1)
+5 ; FROMADP - 1 if being called from COMPILE^RCDPEADP, 0 otherwise
+6 ; Optional, default to 0
+7 ; ADATE - Internal Auto-Post Date (only passed if FROMADP=1)
+8 ; RCZERO - 0 = ERA Line with payment 1 = ERA Line without payment
+9 ; WHICH - 1 - Checking Auto-Decrease for Medical CARCs
+10 ; 2 - Checking Auto-Decrease for Rx CARCs
+11 ; 3 - Checking Auto-Decrease for TRICARE CARCs
+12 ; Optional, defaults to 1 (Medical)
+13 ; Returns: A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where:
+14 ; A1 - Auto-Decrease amount of the 1st CARC code in the EOB
+15 ; A2 - 1st CARC code in the EOB
+16 ; A3 - Deactivation Date of the 1st CARC code in the EOB if
+17 ; it has one and is less than today AND FROMADP=0
+18 ; Otherwise Quantity of the first CARC code in the EOB if
+19 ; FROMADP=1
+20 ; A4 - Reason of the 1st CARC code in the EOB
+21 ; only passed if FROMADP=1
+22 NEW I,RCAMT,RCCAMT,RCCODE,RCCODES,RCDATA,RCITEM,RCTAMT,XDT,XIEN
+23 IF $GET(WHICH)=""
SET WHICH=1
+24 if '$DATA(FROMADP)
SET FROMADP=0
+25 SET RCAMT=""
SET RCCODES=""
+26 ;
+27 ; Extract the CARC codes from the EOB.
+28 ; Returned are ^A1;A2;A3;A4^A1;A2;A3;A4^... Where
+29 ; A1 - CARC code
+30 ; A2 - Auto Decrease Amount
+31 ; A3 - Quantity (only returned if FROMADP=1)
+32 ; A4 - REASON (only returned if FROMADP=1)
+33 DO GETCARCS^RCDPEAD2(RCEOB,.RCCODES,FROMADP)
+34 ;
+35 ; Loop through all of the CARC codes found. If none, it will exit.
+36 FOR I=2:1:$LENGTH(RCCODES,"^")
Begin DoDot:1
+37 SET RCITEM=$PIECE(RCCODES,"^",I)
+38 if RCITEM=""
QUIT
+39 SET RCCODE=$PIECE(RCITEM,";",1)
SET RCCAMT=$PIECE(RCITEM,";",2)
+40 ;
+41 ; Quit If the Adjustment amount is a negative amount
+42 if +RCCAMT<0
QUIT
+43 ;
+44 ; Look up code in CARC table and get max adjustment
+45 ; PRCA*4.5*345 - added WHICH
SET RCDATA=$$ACTCARC^RCDPEAD2(RCCODE,RCZERO,WHICH)
+46 ;
+47 ; Quit If auto decrease is not active on this code
+48 if +RCDATA=0
QUIT
+49 ;
+50 ; Get code inactive date if it exists
+51 SET XIEN=$$FIND1^DIC(345,,"O",RCCODE)
+52 if $GET(XIEN)'=""
SET XDT=$$GET1^DIQ(345,XIEN_",",2,"I")
+53 IF $GET(XDT)'=""
if XDT'<DT
SET XDT=""
+54 ; Get limit
SET RCTAMT=$PIECE(RCDATA,U,2)
+55 ;
+56 ; 11/11/2015: Compare the max adjustment in parameters to the adjustment on EEOB
+57 ; Quit if over
+58 ;
+59 ; If the CARC payer adjustment <= CARC max adjustment amount, Then add to list
+60 ; for possible adjustments.
+61 IF RCCAMT<(RCTAMT+.01)!FROMADP
Begin DoDot:2
+62 ;
+63 ; If we're being called from the auto-decrease report, return all CARC information
+64 IF FROMADP
Begin DoDot:3
+65 SET XX=RCCAMT_";"_RCCODE_";"_$PIECE(RCITEM,";",3,4)
+66 SET RCAMT=$SELECT(RCAMT'[";":XX,1:RCAMT_"^"_XX)
End DoDot:3
QUIT
+67 SET RCAMT=$SELECT($LENGTH(RCAMT)=0:RCCAMT_";"_RCCODE_";"_XDT,1:RCAMT_U_RCCAMT_";"_RCCODE_";"_XDT)
End DoDot:2
End DoDot:1
+68 QUIT RCAMT
+69 ;
OTHER(RCBILLDA,ORIG) ; Check if APAR/WL entries exist on other ERA for this bill
+1 ; INPUT
+2 ; RCBILLDA - IEN for claim in #430 or #399
+3 ; ORIG - IEN for current ERA
+4 ; OUTPUT
+5 ; RCPEND - 1 = Other ERA payments exist 0 - No other ERA payments exit
+6 ;
+7 NEW AUTOSTA,RCERA,RCEOB,RCLINE,RCPAID,RCPEND,RCTOT,RCZ,RCZL
+8 ; Find EEOB's for this claim
+9 SET RCEOB=0
SET RCPEND=0
+10 FOR
SET RCEOB=$ORDER(^IBM(361.1,"B",RCBILLDA,RCEOB))
if 'RCEOB
QUIT
if RCPEND
QUIT
Begin DoDot:1
+11 ;Find ERAs for this EOB - may be multiple
+12 SET RCERA=0
+13 FOR
SET RCERA=$ORDER(^RCY(344.4,"ADET",RCEOB,RCERA))
if 'RCERA
QUIT
if RCPEND
QUIT
Begin DoDot:2
+14 ; Ignore original ERA
+15 if RCERA=ORIG
QUIT
+16 ; Get auto-post status for ERA
+17 SET AUTOSTA=$$GET1^DIQ(344.4,RCERA_",",4.02,"I")
+18 ; Ignore completely processed auto-post ERA
+19 if AUTOSTA=2
QUIT
+20 ; Ignore non-auto-post ERA which already have a receipt - processed or otherwise
+21 IF AUTOSTA=""
IF $$GET1^DIQ(344.4,RCERA_",",.08,"I")
QUIT
+22 ; Get ERA lines for this EOB
+23 SET RCLINE=0
SET RCTOT=0
+24 FOR
SET RCLINE=$ORDER(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE))
if 'RCLINE
QUIT
if RCPEND
QUIT
Begin DoDot:3
+25 ; Ignore auto-posted lines (which have a receipt)
+26 IF AUTOSTA]""
IF $$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.25)
QUIT
+27 ; Get paid amount from ERA line
+28 SET RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)
+29 ; Ignore zero lines
+30 if 'RCPAID
QUIT
+31 ; If no scratchpad use paid amount from ERA
+32 IF '$DATA(^RCY(344.49,RCERA))
SET RCTOT=RCTOT+RCPAID
QUIT
+33 ; Find ERA line in scratchpad
+34 SET RCZL=$$FIND(RCERA,RCLINE)
if 'RCZL
QUIT
+35 ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4)
+36 SET RCSUB=RCZL
+37 FOR
SET RCSUB=$ORDER(^RCY(344.49,RCERA,1,"B",RCSUB))
if (RCSUB\1)'=RCZL
QUIT
Begin DoDot:4
+38 SET RCZ=$ORDER(^RCY(344.49,RCERA,1,"B",RCSUB,""))
if 'RCZ
QUIT
+39 ; Check AR BILL is for this claim
+40 if $$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA
QUIT
+41 ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals
+42 SET RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03)
End DoDot:4
End DoDot:3
+43 ; If claim total for the ERA is non-zero auto-decrease is blocked
+44 if RCTOT>0
SET RCPEND=1
End DoDot:2
End DoDot:1
+45 QUIT RCPEND
+46 ;
FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line
+1 ; Input RCERA - Scratchpad IEN
+2 ; RCLINE - ERA line to find
+3 ; Output RET - Scratchpad line number
+4 ;
+5 NEW DA,ORIG,RCSUB,RET
+6 SET RCSUB=0
SET RET=0
+7 FOR
SET RCSUB=$ORDER(^RCY(344.49,RCERA,1,"ASEQ",RCSUB))
if RET
QUIT
if 'RCSUB
QUIT
Begin DoDot:1
+8 SET DA=$ORDER(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,""))
if 'DA
QUIT
+9 ;Get Original sequences
+10 SET ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09)
if ORIG=""
QUIT
+11 ;Check if scratchpad line is for original ERA line
+12 SET ORIG=","_ORIG_","
+13 if $FIND(ORIG,","_RCLINE_",")
SET RET=RCSUB
End DoDot:1
+14 QUIT RET
+15 ;
PAYEX(WHICH,IEN3446) ; Check if payer is excluded
+1 ; Subroutine added for PRCA*4.5*349
+2 ; Input: WHICH - 1=Medical, 2=Rx, 3=TRICARE
+3 ; IEN3446 - Internal Entry number of Payer Exclusion file entry
+4 ; Returns: 1 if payer is excluded, otherwise 0.
+5 ;
+6 NEW FLDA,FLDD,RETURN,XX
+7 SET RETURN=0
+8 SET FLDA=$SELECT(WHICH=1:.06,WHICH=2:.08,1:.13)
+9 SET FLDD=$SELECT(WHICH=1:.07,WHICH=2:.12,1:.14)
+10 ; If processing Rx Claims, skip if payer is excluded from Auto-Post or Auto-Decrease
+11 ;
IF IEN3446'=""
Begin DoDot:1
+12 SET XX=$$GET1^DIQ(344.6,IEN3446_",",FLDA,"I")
+13 ; Payer excluded from Rx Auto-Post
IF XX
SET RETURN=1
QUIT
+14 SET XX=$$GET1^DIQ(344.6,IEN3446_",",FLDD,"I")
+15 ; Payer excluded from Rx Auto-Decrease
IF XX
SET RETURN=1
End DoDot:1
+16 QUIT RETURN
