RCDPEAP1 ;ALB/KML - AUTO POST MATCHING EFT ERA PAIR - CONT. ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**298,304,318,321,326,345,349,424,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;Read ^IBM(361.1) via Private IA 4051
;
;-------------------------------
;RCDPEM0 and RCDPEAP SUBROUTINES
;-------------------------------
AUTOCHK(RCERA) ;Verify if ERA can be auto-posted - PRE-CHECK USED IN RCDPEM0
; Input: RCERA - IEN for file 344.4
; Returns: 1 - Auto-Post candidate, 0 - Not an Auto-Post candidate
; Many checks done by this are also done AUTOCHK2 below so if these are changed,
; may also need to be changed
N NOTOK,RCDSUB,RCD0,RCMATCH,RCSCR,RCZERO
K ^TMP($J,"RCDPEWLA")
;
; Check for exceptions
S RCDSUB=0,NOTOK=0
F S RCDSUB=$O(^RCY(344.4,RCERA,1,RCDSUB)) Q:'RCDSUB D Q:NOTOK
. ;
. ; Exception exists if INVALID BILL NUMBER field is populated in #344.41
. S RCD0=$G(^RCY(344.4,RCERA,1,RCDSUB,0)) S:($P(RCD0,U,5)]"") NOTOK=1
;
; Cannot auto-post if exceptions exist
Q:NOTOK 0
;
; Ignore ERA if ERA level Adjustments exist
I $O(^RCY(344.4,RCERA,2,0)) Q 0
;
; Ignore non-ACH type ERA to prevent CHK type ERA from automatically auto-posting in nightly job - PRCA*4.5*321
;I $$GET1^DIQ(344.4,RCERA_",",.15)'="ACH" Q 0 ; extended - PRCA*4.5*326
; Ignore non-valid auto-post ERA types
I "^ACH^CHK^BOP^NON^"'[(U_$$GET1^DIQ(344.4,RCERA_",",.15)_U) Q 0
;
; PRCA*4.5*424 - allow auto-post of zero dollar ERA
; ERA must be matched to an EFT to be eligible for mark for autopost
S RCMATCH=$$MATCHED(RCERA)
S RCZERO=$$ISZERO(RCERA)
I RCZERO I $$ISTYPE^RCDPEU1(344.4,RCERA,"C") Q 0 ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
I 'RCZERO,'RCMATCH Q 0 ; ERAs much be matched unless they are zero balance
;
; If this is a zero balance ERA and the site parameter for posting zero balance
; ERAs is turned off, don't auto-post it
I RCZERO,'$$GET1^DIQ(344.61,"1,",1.11,"I") Q 0
; PRCA*4.5*424 - end modified code block
;
; Create scratchpad
;I 'RCZERO S RCSCR=$$SCRPAD^RCDPEAP(RCERA) Q:'RCSCR 0 ;PRCA*4.5*424 added I 'RCZERO
S RCSCR=$$SCRPAD^RCDPEAP(RCERA,RCZERO) Q:'RCSCR 0 ;PRCA*4.5*424 added ,RCZERO
;
; Ignore ERA if claim level adjustments without payment exist
; This will only get set if the scratchpad is created, not if it already exists.
; Looking at the code, it will mainly set if there are ERA level adjustments and
; may get set for unbalanced pairs, which is found by the ZEROBAL function. So,
; I think this does not have a real purpose but was not 100% sure.
I $D(^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")) D CLEAR^RCDPEAP(RCSCR) Q 0
;
; PRCA*4.5*424 added line
I RCZERO Q 1
;
; ERA needs to drop to standard worklist if adjustment between matching
; positive/negative does not create a zero balance
I '$$ZEROBAL(RCSCR) D CLEAR^RCDPEAP(RCSCR) Q 0
;
; Clear scratchpad
D CLEAR^RCDPEAP(RCSCR)
;
; This is valid auto-post - return to MATCH^RCPDEM0
Q 1
;
AUTOCHK2(RCERA,RCTYP) ; RCTYP added PRCA*4.5*321
; Check if this entry is an auto-post candidate
; This has the same/similar checks as MATCH^RCDPEM0 and AUTOCHK above. If those procedures are
; changed, this may need to updated as well.
; ; Input: RCERA - IEN for file 344.4
; RCTYP - 0 - Called from Worklist/Mark for autopost
; 1 - Called from Manual match
; Returns: 1 - Auto-Post candidate
; 0^Reason - Not an auto-post candidate and reason
; Validate Parameter
I '$G(RCERA) Q "0^Invalid Parameter"
I $G(RCTYP)="" Q "0^Invalid Parameter" ; PRCA*4.5*321
I (RCTYP>1)!(RCTYP<0) Q "0^Invalid Parameter" ; PRCA*4.5*321
;
; PRCA*4.5*345 - Added PNAM,PTIN,XX
N NOTOK,PNAM,PTIN,RCCREATE,RCDSUB,RCERATYP,RCMATCH,RCSCR,RCXCLDE,RC0,RCZERO,STATUS,XX
K ^TMP($J,"RCDPEWLA")
;
; Check if record exists
I '$D(^RCY(344.4,RCERA,0)) Q "0^Invalid ERA record"
;
; Check current status
S STATUS=$$GET1^DIQ(344.4,RCERA_",",4.02,"I")
I STATUS=0 Q "0^Already marked for Auto-Posting"
I STATUS=1 Q "0^Already partially Auto-Posted"
I STATUS=2 Q "0^Already completely Auto-Posted"
;
; PRCA*4.5*424 - allow auto-post of zero dollar ERA
; ERA must be matched to an EFT to be eligible for mark for autopost
S RC0=$G(^RCY(344.4,RCERA,0))
S RCMATCH=$$MATCHED(RCERA)
S RCZERO=$$ISZERO(RCERA)
I RCZERO I $$ISTYPE^RCDPEU1(344.4,RCERA,"C") Q "0^CHAMPVA 0 balance ERA" ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
I 'RCZERO,'RCMATCH Q "0^ERA not matched" ; ERAs much be matched unless they are zero balance
; Only Auto-post zero pay ERA if parameter is enabled
I RCZERO,'$$GET1^DIQ(344.61,"1,",1.11,"I") Q "0^Auto-post 0 balance disabled"
; PRCA*4.5*424 - end modified code block
;
; Determine if ERA should be excluded using the site parameters
S PNAM=$$GET1^DIQ(344.4,RCERA_",",.06,"E") ; PRCA*4.5*345 - Added line - Payer Name
S PTIN=$$GET1^DIQ(344.4,RCERA_",",.03,"E") ; PRCA*4.5*345 - Added line - Payer TIN
S XX=$$GETPAY^RCDPEU1(PNAM,PTIN) ; PRCA*4.5*345 - Get the IEN from 344.6
I $$CHKTYPE^RCDPEU1(XX,"T") S RCERATYP=2 ; PRCA*4.5*349 - Check if this is TRICARE ERA
E S RCERATYP=$$PHARM^RCDPEAP1(RCERA) ; Else it must be a Medical or Rx ERA
;
; Check if medical claim and auto-posting is turned off
S XX=$$GET1^DIQ(344.61,"1,",.02,"I") ; PRCA*4.5*345 - Added line - Med Auto-Posting on/off
I RCERATYP=0,'XX Q "0^Medical auto-posting off" ; PRCA*4.5*345 - Changed 'RCERATYP to RCEARTYP=0
;
; Check if pharmacy claim and auto-posting is turned off
S XX=$$GET1^DIQ(344.61,"1,",1.01,"I") ; PRCA*4.5*345 - Added line - Rx Auto-Posting on/off
I RCERATYP=1,'XX Q "0^Pharmacy auto-posting off" ; PRCA*4.5*345 - Changed RCERATYP to RCEARTYP=1
;
; Check if TRICARE claim and auto-posting is turned off
S XX=$$GET1^DIQ(344.61,"1,",1.05,"I") ; PRCA*4.5*349 - Added line - TRICARE Auto-Posting on/off
I RCERATYP=2,'XX Q "0^TRICARE auto-posting off" ; PRCA*4.5*349 - Added line
;
; Check if ERA payer is excluded from autopost
S RCXCLDE=0
S:RCERATYP=0 RCXCLDE=$$EXCLUDE(RCERA) ; PRCA*4.5*345 - Changed to =0 from 'RCERATYP
S:RCERATYP=1 RCXCLDE=$$EXCLDRX(RCERA) ; PRCA*4.5*345 - Changed to =1 from RCERATYP
S:RCERATYP=2 RCXCLDE=$$EXCLDTR(RCERA) ; PRCA*4.5*349 - Added Line
I RCXCLDE Q "0^"_$S(RCERATYP=1:"Pharmacy",RCERATYP=2:"TRICARE",1:"Medical")_" payer excluded" ; PRCA*4.5*349
;
; Check for invalid bill number exception
S RCDSUB=0,NOTOK=0
F S RCDSUB=$O(^RCY(344.4,RCERA,1,RCDSUB)) Q:'RCDSUB D Q:NOTOK
. S RCD0=$G(^RCY(344.4,RCERA,1,RCDSUB,0))
. I $P(RCD0,U,5)]"" S NOTOK=1
I NOTOK Q "0^Invalid Bill Number Exception(s)"
;
; Check for ERA level Adjustments
I $O(^RCY(344.4,RCERA,2,0)) Q "0^ERA level Adjustment(s)"
;
; Check if receipt already created
I +$P(RC0,U,8) Q "0^ERA has a receipt"
;
; BEGIN PRCA*4.5*326
; Check payment type of ERA - CHK type is allowed for a manual match
;I "^ACH^CHK^"'[(U_$P(RC0,U,15)_U) Q "0^Payment Type is not ACH or CHK" ; PRCA*4.5*321
; Check payment type of ERA - now also includes CHK, NON and BOP type from manual match
I "^ACH^CHK^BOP^NON^"'[(U_$P(RC0,U,15)_U) Q "0^Payment Type is not ACH, CHK, BOP or NON"
;
; CHK type ERA must be matched to an EFT to be eligible for mark for autopost
;I $P(RC0,U,15)="CHK",'$O(^RCY(344.31,"AERA",RCERA,"")) Q "0^ERA is not matched to an EFT" ; PRCA*4.5*321
; CHK, NON and BOP type ERA must be matched to an EFT to be eligible for mark for autopost
;PRCA*4.5*424 Added 'RCZERO
I 'RCZERO,"^CHK^BOP^NON^"'[(U_$P(RC0,U,15)_U),'$O(^RCY(344.31,"AERA",RCERA,"")) Q "0^ERA is not matched to an EFT" ;
; END PRCA*4.5*326
;
; Create scratchpad if needed
S RCCREATE=0
S RCSCR=+$O(^RCY(344.49,"B",RCERA,0))
I 'RCSCR S RCSCR=$$SCRPAD^RCDPEAP(RCERA,RCZERO) S RCCREATE=1 ;PRCA*4.5*424 Added ,RCZERO
I 'RCSCR,'RCZERO Q "0^Unable to create scratchpad" ;PRCA*4.5*424 added 'RCZERO
;
; Check if claim level adjustments without payment exist
; Note that PRCA*298 sets this temp global only if the scratchpad is created by the call above ($$SCRPAD^RCDPEAP). If the
; scratchpad already exists, the TMP global will never get set. Looking at the code, it will mainly set if there
; are ERA level adjustments and may get set for unbalanced pairs, which is found by the ZEROBAL function. So, I think
; this does not have a real purpose but was not 100% sure and wanted to mimic what AUTOCHK does.
I $D(^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")) D:RCCREATE CLEAR^RCDPEAP(RCSCR) Q "0^Claim Level Adjustments w/o payment"
;
; Check if adjustment between matching positive/negative does not create a zero balance
I '$$ZEROBAL(RCSCR) D:RCCREATE CLEAR^RCDPEAP(RCSCR) Q "0^+/- pairs do not balance"
;
; Clear scratchpad if it was created by this function
D:RCCREATE CLEAR^RCDPEAP(RCSCR)
;
;If we got this far, this is an autopost candidate so quit with 1
Q 1
;
EXCLUDE(RCERA) ; Verify if auto-posting is allowed for this Payer - PRECHECK USED IN RCDPEM0
; Not allowed if medical auto-posting is switched off
; Input: RCERA - IEN for file 344.4
; Returns: 1 - Exclude ERA becaus Payer is in exclusion table, 0 otherwise
; PRCA*4.5*345 - changed to $$GET1^DIQ calls below
Q:'$$GET1^DIQ(344.61,"1,",.02,"I") 1 ; Medical Auto-Posting is turned OFF
;
; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
N RCPID,RCPNM,RCPXDA
S RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
Q:RCPNM="" 1 ; No Payer Name
S RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
Q:RCPID="" 1 ; No Payer TIN
;
; Auto-post is allowed if this is a new payer (not in table)
S RCPXDA=$O(^RCY(344.6,"CPID",RCPNM,RCPID,""))
Q:RCPXDA="" 0
;
; If payer table entry found check if payer is excluded from medical auto-post
Q:$$GET1^DIQ(344.6,RCPXDA_",",.06,"I")=1 1
;
; Otherwise it is OK to auto-post
Q 0
;
PHARM(RCERA) ;Check if ERA is for Pharmacy only (ECME number on first line) - CALLED FROM RCDPEM0
N SUB S SUB=$O(^RCY(344.4,RCERA,1,0)) Q:'SUB 0
Q:$P($G(^RCY(344.4,RCERA,1,SUB,4)),U,2)]"" 1
Q 0
;
ERADET(RCERA,RCRCPTDA,RCLINES) ; called on subsequent attempts of auto-post for a given ERA (DAY 2, DAY 3, ex.)
; update ERA with receipt or if not posted then update the AUTO-POST REJECTION REASON (#5)
;
; RCERA = ien of entry in file 344.4
; RCRCPTDA = ien of receipt number (344, .01) - optional
; RCLINES = array of ERA line references
;
I '$G(RCERA) Q
S RCRCPTDA=$G(RCRCPTDA)
;
N DA,DIC,DIE,DLAYGO,DO,DR,X
; Update receipt. If this is the first receipt, put it in the RECEIPT (#08) field. If not, put in OTHER RECEIPTS multiple (#344.48)
I RCRCPTDA D
. I $P($G(^RCY(344.4,RCERA,0)),U,8)]"" S DA(1)=RCERA,DIC="^RCY(344.4,"_DA(1)_",8,",DIC(0)="L",X=RCRCPTDA D FILE^DICN I 1
. E S DIE="^RCY(344.4,",DR=".14////1;.08////"_RCRCPTDA,DA=RCERA D ^DIE
;
; Update ERA detail line with Receipt or reject reason as appropriate
; PRCA*4.5*318 begins
N RCLIN,REJECT
S RCLIN=0
F S RCLIN=$O(RCLINES(RCLIN)) Q:'RCLIN D
. ; Set REJECT to true if the line was rejected during validation
. S REJECT=0 I '$P(RCLINES(RCLIN),U) S REJECT=1
. ;If not posted then update the AUTO-POST REJECTION REASON (#5)
. ;Otherwise update line with receipt number and autopost date
. S DA(1)=RCERA,DA=RCLIN,DIE="^RCY(344.4,"_DA(1)_",1,"
. I 'REJECT,'RCRCPTDA Q
. I REJECT S DR="5///"_$P(RCLINES(RCLIN),U,3)
. E S DR=".25///"_RCRCPTDA_";9///"_DT
. D ^DIE
; PRCA*4.5*318 ends
Q
;
ZEROBAL(RCSCR) ;
; per requirements, only positive/negative payment pairs where payment
; calculates to zero are allowed for auto-post
; if payment ends up less than zero or greater than zero then ERA cannot
; be autoposted.
; ERA gets sent to the standard worklist for manual receipt processing
; note: a payment pair represents 2 EEOB sequences with the same claim
; RCSCR - 344.49 ien
; X - returns 1 or 0
;
N SUB,SUB1,WLINE,X,ERALINE
S SUB=0,X=1,ERALINE=""
F S SUB=$O(^RCY(344.49,RCSCR,1,"B",SUB)) Q:SUB="" D
. ;Get scratchpad line and data
. S SUB1=$O(^RCY(344.49,RCSCR,1,"B",SUB,"")) Q:'SUB1 S WLINE=$G(^RCY(344.49,RCSCR,1,SUB1,0))
. ;If integer sequence, get ERA line reference then quit for this sequence and go on to the non-integer sequence to finish validation
. I $P(WLINE,U)?1N.N S ERALINE=$P(WLINE,U,9) Q
. ; there are multiple EEOB sequences for the specific bill number so an adjustment took place;
. ; if payment adjustment doesn't generate a zero payment balance at 344.491,.06 then this ERA needs to drop to standard worklist
. I ERALINE[",",+$P(WLINE,U,6)'=0 S X=0 Q
. ;do not autopost ERA if one of payments is negative amount
. I $P(WLINE,U,6)<0 S X=0
Q X
;
EXCLDRX(RCERA) ; Verify if auto-posting is allowed for Pharmacy claims
; and for the Payer - PRECHECK USED IN RCDPEM0. Not allowed if pharmacy
; auto-posting is switched off
; Input: RCERA - IEN for file 344.4
; Returns: 1 - ERA is excluded from Auto-Posting, 0 otherwise
Q:'$$GET1^DIQ(344.61,"1,",1.01,"I") 1 ; Rx Auto-Posting is turned OFF
N RCPID,RCPNM,RCPXDA
;
; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
S RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
Q:RCPNM="" 1 ; No Payer Name
S RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
Q:RCPID="" 1 ; No Payer TIN
;
; Auto-post is allowed if this is a new payer (not in table)
S RCPXDA=$O(^RCY(344.6,"CPID",RCPNM,RCPID,"")) Q:RCPXDA="" 0
;
; If payer table entry found check if payer is excluded from pharmacy auto-post
Q:$$GET1^DIQ(344.6,RCPXDA_",",.08,"I")=1 1
;
; Otherwise it is OK to auto-post
Q 0
;
EXCLDTR(RCERA) ; Verify if auto-posting is allowed for TRICARE claims
; and for the Payer - PRECHECK USED IN RCDPEM0. Not allowed if TRICARE
; auto-posting is switched off
; PRCA*4.5*349 - Added function
; Input: RCERA - IEN for file 344.4
; Returns: 1 - ERA is excluded from Auto-Posting, 0 otherwise
Q:'$$GET1^DIQ(344.61,"1,",1.05,"I") 1 ; TRICARE Auto-Posting is turned OFF
N RCPID,RCPNM,RCPXDA
;
; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
S RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
Q:RCPNM="" 1 ; No Payer Name
S RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
Q:RCPID="" 1 ; No Payer TIN
;
; Auto-post is allowed if this is a new payer (not in table)
S RCPXDA=$O(^RCY(344.6,"CPID",RCPNM,RCPID,"")) Q:RCPXDA="" 0
;
; If payer table entry found check if payer is excluded from TRICARE auto-post
Q:$$GET1^DIQ(344.6,RCPXDA_",",.13,"I")=1 1
;
; Otherwise it is OK to auto-post
Q 0
;
VALID(RCERA,RCLINES) ;
;Verify which scratchpad lines are able to auto-post - called by EN2^RCDPEAP
;
; RCERA - Electronic Remittance Advice (#344.4) IEN
; RCLINES - Array of ERA line references (passed in by reference)
; RCLINES(ERALINE)=1 - ERA line(s) are postable. Also RCLINES counter is incremented.
; RCLINES(ERALINE)=0^^Reject Reason Code - ERA line(s) are not postable
; NOTE: ORIGINAL ERA SEQUENCES (#.09) can have multiple ERA line references separated by commas (e.g.,"3,4")
;
;Check for ScratchPad entry. If missing (should not happen), quit
N RCSCR
S RCSCR=$O(^RCY(344.49,"B",+$G(RCERA),""))
I RCSCR="" S RCLINES=0 Q
;Loop through scratchpad for this ERA
N SUB,SUB1,WLINE,ERALINE,PIECE,SEQ,CLAIM,STATUS,CLARRAY,AUTOPOST
S SUB=0 F S SUB=$O(^RCY(344.49,RCSCR,1,"B",SUB)) Q:SUB="" D
. ;Get scratchpad line and data
. S SUB1=$O(^RCY(344.49,RCSCR,1,"B",SUB,""))
. I 'SUB1 Q
. S WLINE=$G(^RCY(344.49,RCSCR,1,SUB1,0))
. ;If integer sequence, get ERA line reference and check for auto-post flag
. I $P(WLINE,U)?1N.N D Q
.. S ERALINE=$P(WLINE,U,9)
.. ; If ERA reference is missing (should not happen), skip ahead to next integer sequence
.. I ERALINE="" S SUB=SUB\1_".999" Q
.. ; Check for receipt - PRCA*4.5*318
.. I $$GET1^DIQ(344.41,ERALINE_","_RCERA_",",.25)]"" S SUB=SUB\1_".999" Q ; PRCA*4.5*318
.. S AUTOPOST=1
.. F PIECE=1:1 S SEQ=$P(ERALINE,",",PIECE) Q:'SEQ I '$P($G(^RCY(344.4,RCERA,1,SEQ,5)),U,2) S AUTOPOST=0 Q
.. ; Unless all of the associated ERA detail lines are set for auto-post, skip ahead to next integer sequence
.. I 'AUTOPOST S SUB=SUB\1_".999" Q
. ;If no claim number (suspense), set to autopost but check the rest of the lines for the ERA reference
. S CLAIM=$P(WLINE,U,7)
. I 'CLAIM S RCLINES(ERALINE)=1 Q
. ;Quit with error if claim is not OPEN or ACTIVE
. S STATUS=$P($G(^PRCA(430,CLAIM,0)),"^",8)
. I STATUS'=42,STATUS'=16 S RCLINES(ERALINE)="0^^5",SUB=SUB\1_".999" Q
. ;Quit with error if referred to general council
. I $P($G(^PRCA(430,CLAIM,6)),U,4)]"" S RCLINES(ERALINE)="0^^7",SUB=SUB\1_".999" Q
. ;Check for negative payment amount
. I $P(WLINE,U,6)<0 S RCLINES(ERALINE)="0^^6",SUB=SUB\1_".999" Q
. ;Increment claim balance. If payment exceeds claim balance and no pending payments (at the time of auto posting), quit
. ; with error. Also deduct the amount from the balance so subsequent, smaller amounts may get posted
. S CLARRAY(CLAIM)=+$G(CLARRAY(CLAIM))+$P(WLINE,U,3)
. I '$$CHECKPAY^RCDPEAP(.CLARRAY,CLAIM) S RCLINES(ERALINE)="0^^3",SUB=SUB\1_".999",CLARRAY(CLAIM)=+$G(CLARRAY(CLAIM))-$P(WLINE,U,3) Q
. ;Line is potentially postable - update flag
. S RCLINES(ERALINE)=1
;
;Reset the MARK FOR AUTOPOST flag on ERA lines and return count of auto-postable lines - PRCA*4.5*318
N DA,DIE,DR,RCLIN,RCI
S RCLIN=0,RCLINES=0 F S RCLIN=$O(RCLINES(RCLIN)) Q:'RCLIN D
. I +RCLINES(RCLIN) S RCLINES=RCLINES+1
. ;Set MARK FOR AUTO-POST (#6) to NO for every line
. S DA(1)=RCERA,DA=RCLIN,DIE="^RCY(344.4,"_DA(1)_",1,"
. S DR="6///0"
. D ^DIE
Q
;
UNBAL(RCERA) ; PRCA*4.5*318 added method
; Determine if the ERA total matches the EFT total for the selected ERA
; Input: RCERA - Internal IEN of the selected ERA
; Returns: 1 - ERA is unbalanced, 0 otherwise
N RCLTOT,RCSUB,RCTOT
;ERA total balance - on matched ERAs the ERA total balance is the same as the EFT total
S RCTOT=+$$GET1^DIQ(344.4,RCERA_",",.05)
;Sum of ERA claim line payments
S RCSUB=0,RCLTOT=0
F S RCSUB=$O(^RCY(344.4,RCERA,1,RCSUB)) Q:'RCSUB D
. S RCLTOT=RCLTOT+$$GET1^DIQ(344.41,RCSUB_","_RCERA_",",.03)
;Plus sum of ERA adjustment lines
S RCSUB=0
F S RCSUB=$O(^RCY(344.4,RCERA,2,RCSUB)) Q:'RCSUB D
. S RCLTOT=RCLTOT+$$GET1^DIQ(344.42,RCSUB_","_RCERA_",",.03)
;Return 1 if total of ERA lines does not match EFT
Q $S(RCTOT=RCLTOT:0,1:1)
;
; PRCA*4.5*424 New subroutines MATCHED and is ZERO added
MATCHED(IEN) ; Check if ERA is matched
; Input IEN - Internal entry number of ERA #344.4
; Returns 1 if ERA is matched, otherwise 0
I $O(^RCY(344.31,"AERA",RCERA,"")) Q 1
Q 0
ISZERO(IEN) ; Check is ERA is zero balance (EP)
; Input IEN - Internal entry number of ERA #344.4
; Returns 1 if ERA is zero balance, otherwise 0
I +$P($G(^RCY(344.4,IEN,0)),U,5)=0 Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAP1 19460 printed Dec 13, 2024@01:44:17 Page 2
RCDPEAP1 ;ALB/KML - AUTO POST MATCHING EFT ERA PAIR - CONT. ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**298,304,318,321,326,345,349,424,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Read ^IBM(361.1) via Private IA 4051
+4 ;
+5 ;-------------------------------
+6 ;RCDPEM0 and RCDPEAP SUBROUTINES
+7 ;-------------------------------
AUTOCHK(RCERA) ;Verify if ERA can be auto-posted - PRE-CHECK USED IN RCDPEM0
+1 ; Input: RCERA - IEN for file 344.4
+2 ; Returns: 1 - Auto-Post candidate, 0 - Not an Auto-Post candidate
+3 ; Many checks done by this are also done AUTOCHK2 below so if these are changed,
+4 ; may also need to be changed
+5 NEW NOTOK,RCDSUB,RCD0,RCMATCH,RCSCR,RCZERO
+6 KILL ^TMP($JOB,"RCDPEWLA")
+7 ;
+8 ; Check for exceptions
+9 SET RCDSUB=0
SET NOTOK=0
+10 FOR
SET RCDSUB=$ORDER(^RCY(344.4,RCERA,1,RCDSUB))
if 'RCDSUB
QUIT
Begin DoDot:1
+11 ;
+12 ; Exception exists if INVALID BILL NUMBER field is populated in #344.41
+13 SET RCD0=$GET(^RCY(344.4,RCERA,1,RCDSUB,0))
if ($PIECE(RCD0,U,5)]"")
SET NOTOK=1
End DoDot:1
if NOTOK
QUIT
+14 ;
+15 ; Cannot auto-post if exceptions exist
+16 if NOTOK
QUIT 0
+17 ;
+18 ; Ignore ERA if ERA level Adjustments exist
+19 IF $ORDER(^RCY(344.4,RCERA,2,0))
QUIT 0
+20 ;
+21 ; Ignore non-ACH type ERA to prevent CHK type ERA from automatically auto-posting in nightly job - PRCA*4.5*321
+22 ;I $$GET1^DIQ(344.4,RCERA_",",.15)'="ACH" Q 0 ; extended - PRCA*4.5*326
+23 ; Ignore non-valid auto-post ERA types
+24 IF "^ACH^CHK^BOP^NON^"'[(U_$$GET1^DIQ(344.4,RCERA_",",.15)_U)
QUIT 0
+25 ;
+26 ; PRCA*4.5*424 - allow auto-post of zero dollar ERA
+27 ; ERA must be matched to an EFT to be eligible for mark for autopost
+28 SET RCMATCH=$$MATCHED(RCERA)
+29 SET RCZERO=$$ISZERO(RCERA)
+30 ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
IF RCZERO
IF $$ISTYPE^RCDPEU1(344.4,RCERA,"C")
QUIT 0
+31 ; ERAs much be matched unless they are zero balance
IF 'RCZERO
IF 'RCMATCH
QUIT 0
+32 ;
+33 ; If this is a zero balance ERA and the site parameter for posting zero balance
+34 ; ERAs is turned off, don't auto-post it
+35 IF RCZERO
IF '$$GET1^DIQ(344.61,"1,",1.11,"I")
QUIT 0
+36 ; PRCA*4.5*424 - end modified code block
+37 ;
+38 ; Create scratchpad
+39 ;I 'RCZERO S RCSCR=$$SCRPAD^RCDPEAP(RCERA) Q:'RCSCR 0 ;PRCA*4.5*424 added I 'RCZERO
+40 ;PRCA*4.5*424 added ,RCZERO
SET RCSCR=$$SCRPAD^RCDPEAP(RCERA,RCZERO)
if 'RCSCR
QUIT 0
+41 ;
+42 ; Ignore ERA if claim level adjustments without payment exist
+43 ; This will only get set if the scratchpad is created, not if it already exists.
+44 ; Looking at the code, it will mainly set if there are ERA level adjustments and
+45 ; may get set for unbalanced pairs, which is found by the ZEROBAL function. So,
+46 ; I think this does not have a real purpose but was not 100% sure.
+47 IF $DATA(^TMP($JOB,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS"))
DO CLEAR^RCDPEAP(RCSCR)
QUIT 0
+48 ;
+49 ; PRCA*4.5*424 added line
+50 IF RCZERO
QUIT 1
+51 ;
+52 ; ERA needs to drop to standard worklist if adjustment between matching
+53 ; positive/negative does not create a zero balance
+54 IF '$$ZEROBAL(RCSCR)
DO CLEAR^RCDPEAP(RCSCR)
QUIT 0
+55 ;
+56 ; Clear scratchpad
+57 DO CLEAR^RCDPEAP(RCSCR)
+58 ;
+59 ; This is valid auto-post - return to MATCH^RCPDEM0
+60 QUIT 1
+61 ;
AUTOCHK2(RCERA,RCTYP) ; RCTYP added PRCA*4.5*321
+1 ; Check if this entry is an auto-post candidate
+2 ; This has the same/similar checks as MATCH^RCDPEM0 and AUTOCHK above. If those procedures are
+3 ; changed, this may need to updated as well.
+4 ; ; Input: RCERA - IEN for file 344.4
+5 ; RCTYP - 0 - Called from Worklist/Mark for autopost
+6 ; 1 - Called from Manual match
+7 ; Returns: 1 - Auto-Post candidate
+8 ; 0^Reason - Not an auto-post candidate and reason
+9 ; Validate Parameter
+10 IF '$GET(RCERA)
QUIT "0^Invalid Parameter"
+11 ; PRCA*4.5*321
IF $GET(RCTYP)=""
QUIT "0^Invalid Parameter"
+12 ; PRCA*4.5*321
IF (RCTYP>1)!(RCTYP<0)
QUIT "0^Invalid Parameter"
+13 ;
+14 ; PRCA*4.5*345 - Added PNAM,PTIN,XX
+15 NEW NOTOK,PNAM,PTIN,RCCREATE,RCDSUB,RCERATYP,RCMATCH,RCSCR,RCXCLDE,RC0,RCZERO,STATUS,XX
+16 KILL ^TMP($JOB,"RCDPEWLA")
+17 ;
+18 ; Check if record exists
+19 IF '$DATA(^RCY(344.4,RCERA,0))
QUIT "0^Invalid ERA record"
+20 ;
+21 ; Check current status
+22 SET STATUS=$$GET1^DIQ(344.4,RCERA_",",4.02,"I")
+23 IF STATUS=0
QUIT "0^Already marked for Auto-Posting"
+24 IF STATUS=1
QUIT "0^Already partially Auto-Posted"
+25 IF STATUS=2
QUIT "0^Already completely Auto-Posted"
+26 ;
+27 ; PRCA*4.5*424 - allow auto-post of zero dollar ERA
+28 ; ERA must be matched to an EFT to be eligible for mark for autopost
+29 SET RC0=$GET(^RCY(344.4,RCERA,0))
+30 SET RCMATCH=$$MATCHED(RCERA)
+31 SET RCZERO=$$ISZERO(RCERA)
+32 ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
IF RCZERO
IF $$ISTYPE^RCDPEU1(344.4,RCERA,"C")
QUIT "0^CHAMPVA 0 balance ERA"
+33 ; ERAs much be matched unless they are zero balance
IF 'RCZERO
IF 'RCMATCH
QUIT "0^ERA not matched"
+34 ; Only Auto-post zero pay ERA if parameter is enabled
+35 IF RCZERO
IF '$$GET1^DIQ(344.61,"1,",1.11,"I")
QUIT "0^Auto-post 0 balance disabled"
+36 ; PRCA*4.5*424 - end modified code block
+37 ;
+38 ; Determine if ERA should be excluded using the site parameters
+39 ; PRCA*4.5*345 - Added line - Payer Name
SET PNAM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
+40 ; PRCA*4.5*345 - Added line - Payer TIN
SET PTIN=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
+41 ; PRCA*4.5*345 - Get the IEN from 344.6
SET XX=$$GETPAY^RCDPEU1(PNAM,PTIN)
+42 ; PRCA*4.5*349 - Check if this is TRICARE ERA
IF $$CHKTYPE^RCDPEU1(XX,"T")
SET RCERATYP=2
+43 ; Else it must be a Medical or Rx ERA
IF '$TEST
SET RCERATYP=$$PHARM^RCDPEAP1(RCERA)
+44 ;
+45 ; Check if medical claim and auto-posting is turned off
+46 ; PRCA*4.5*345 - Added line - Med Auto-Posting on/off
SET XX=$$GET1^DIQ(344.61,"1,",.02,"I")
+47 ; PRCA*4.5*345 - Changed 'RCERATYP to RCEARTYP=0
IF RCERATYP=0
IF 'XX
QUIT "0^Medical auto-posting off"
+48 ;
+49 ; Check if pharmacy claim and auto-posting is turned off
+50 ; PRCA*4.5*345 - Added line - Rx Auto-Posting on/off
SET XX=$$GET1^DIQ(344.61,"1,",1.01,"I")
+51 ; PRCA*4.5*345 - Changed RCERATYP to RCEARTYP=1
IF RCERATYP=1
IF 'XX
QUIT "0^Pharmacy auto-posting off"
+52 ;
+53 ; Check if TRICARE claim and auto-posting is turned off
+54 ; PRCA*4.5*349 - Added line - TRICARE Auto-Posting on/off
SET XX=$$GET1^DIQ(344.61,"1,",1.05,"I")
+55 ; PRCA*4.5*349 - Added line
IF RCERATYP=2
IF 'XX
QUIT "0^TRICARE auto-posting off"
+56 ;
+57 ; Check if ERA payer is excluded from autopost
+58 SET RCXCLDE=0
+59 ; PRCA*4.5*345 - Changed to =0 from 'RCERATYP
if RCERATYP=0
SET RCXCLDE=$$EXCLUDE(RCERA)
+60 ; PRCA*4.5*345 - Changed to =1 from RCERATYP
if RCERATYP=1
SET RCXCLDE=$$EXCLDRX(RCERA)
+61 ; PRCA*4.5*349 - Added Line
if RCERATYP=2
SET RCXCLDE=$$EXCLDTR(RCERA)
+62 ; PRCA*4.5*349
IF RCXCLDE
QUIT "0^"_$SELECT(RCERATYP=1:"Pharmacy",RCERATYP=2:"TRICARE",1:"Medical")_" payer excluded"
+63 ;
+64 ; Check for invalid bill number exception
+65 SET RCDSUB=0
SET NOTOK=0
+66 FOR
SET RCDSUB=$ORDER(^RCY(344.4,RCERA,1,RCDSUB))
if 'RCDSUB
QUIT
Begin DoDot:1
+67 SET RCD0=$GET(^RCY(344.4,RCERA,1,RCDSUB,0))
+68 IF $PIECE(RCD0,U,5)]""
SET NOTOK=1
End DoDot:1
if NOTOK
QUIT
+69 IF NOTOK
QUIT "0^Invalid Bill Number Exception(s)"
+70 ;
+71 ; Check for ERA level Adjustments
+72 IF $ORDER(^RCY(344.4,RCERA,2,0))
QUIT "0^ERA level Adjustment(s)"
+73 ;
+74 ; Check if receipt already created
+75 IF +$PIECE(RC0,U,8)
QUIT "0^ERA has a receipt"
+76 ;
+77 ; BEGIN PRCA*4.5*326
+78 ; Check payment type of ERA - CHK type is allowed for a manual match
+79 ;I "^ACH^CHK^"'[(U_$P(RC0,U,15)_U) Q "0^Payment Type is not ACH or CHK" ; PRCA*4.5*321
+80 ; Check payment type of ERA - now also includes CHK, NON and BOP type from manual match
+81 IF "^ACH^CHK^BOP^NON^"'[(U_$PIECE(RC0,U,15)_U)
QUIT "0^Payment Type is not ACH, CHK, BOP or NON"
+82 ;
+83 ; CHK type ERA must be matched to an EFT to be eligible for mark for autopost
+84 ;I $P(RC0,U,15)="CHK",'$O(^RCY(344.31,"AERA",RCERA,"")) Q "0^ERA is not matched to an EFT" ; PRCA*4.5*321
+85 ; CHK, NON and BOP type ERA must be matched to an EFT to be eligible for mark for autopost
+86 ;PRCA*4.5*424 Added 'RCZERO
+87 ;
IF 'RCZERO
IF "^CHK^BOP^NON^"'[(U_$PIECE(RC0,U,15)_U)
IF '$ORDER(^RCY(344.31,"AERA",RCERA,""))
QUIT "0^ERA is not matched to an EFT"
+88 ; END PRCA*4.5*326
+89 ;
+90 ; Create scratchpad if needed
+91 SET RCCREATE=0
+92 SET RCSCR=+$ORDER(^RCY(344.49,"B",RCERA,0))
+93 ;PRCA*4.5*424 Added ,RCZERO
IF 'RCSCR
SET RCSCR=$$SCRPAD^RCDPEAP(RCERA,RCZERO)
SET RCCREATE=1
+94 ;PRCA*4.5*424 added 'RCZERO
IF 'RCSCR
IF 'RCZERO
QUIT "0^Unable to create scratchpad"
+95 ;
+96 ; Check if claim level adjustments without payment exist
+97 ; Note that PRCA*298 sets this temp global only if the scratchpad is created by the call above ($$SCRPAD^RCDPEAP). If the
+98 ; scratchpad already exists, the TMP global will never get set. Looking at the code, it will mainly set if there
+99 ; are ERA level adjustments and may get set for unbalanced pairs, which is found by the ZEROBAL function. So, I think
+100 ; this does not have a real purpose but was not 100% sure and wanted to mimic what AUTOCHK does.
+101 IF $DATA(^TMP($JOB,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS"))
if RCCREATE
DO CLEAR^RCDPEAP(RCSCR)
QUIT "0^Claim Level Adjustments w/o payment"
+102 ;
+103 ; Check if adjustment between matching positive/negative does not create a zero balance
+104 IF '$$ZEROBAL(RCSCR)
if RCCREATE
DO CLEAR^RCDPEAP(RCSCR)
QUIT "0^+/- pairs do not balance"
+105 ;
+106 ; Clear scratchpad if it was created by this function
+107 if RCCREATE
DO CLEAR^RCDPEAP(RCSCR)
+108 ;
+109 ;If we got this far, this is an autopost candidate so quit with 1
+110 QUIT 1
+111 ;
EXCLUDE(RCERA) ; Verify if auto-posting is allowed for this Payer - PRECHECK USED IN RCDPEM0
+1 ; Not allowed if medical auto-posting is switched off
+2 ; Input: RCERA - IEN for file 344.4
+3 ; Returns: 1 - Exclude ERA becaus Payer is in exclusion table, 0 otherwise
+4 ; PRCA*4.5*345 - changed to $$GET1^DIQ calls below
+5 ; Medical Auto-Posting is turned OFF
if '$$GET1^DIQ(344.61,"1,",.02,"I")
QUIT 1
+6 ;
+7 ; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
+8 NEW RCPID,RCPNM,RCPXDA
+9 SET RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
+10 ; No Payer Name
if RCPNM=""
QUIT 1
+11 SET RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
+12 ; No Payer TIN
if RCPID=""
QUIT 1
+13 ;
+14 ; Auto-post is allowed if this is a new payer (not in table)
+15 SET RCPXDA=$ORDER(^RCY(344.6,"CPID",RCPNM,RCPID,""))
+16 if RCPXDA=""
QUIT 0
+17 ;
+18 ; If payer table entry found check if payer is excluded from medical auto-post
+19 if $$GET1^DIQ(344.6,RCPXDA_",",.06,"I")=1
QUIT 1
+20 ;
+21 ; Otherwise it is OK to auto-post
+22 QUIT 0
+23 ;
PHARM(RCERA) ;Check if ERA is for Pharmacy only (ECME number on first line) - CALLED FROM RCDPEM0
+1 NEW SUB
SET SUB=$ORDER(^RCY(344.4,RCERA,1,0))
if 'SUB
QUIT 0
+2 if $PIECE($GET(^RCY(344.4,RCERA,1,SUB,4)),U,2)]""
QUIT 1
+3 QUIT 0
+4 ;
ERADET(RCERA,RCRCPTDA,RCLINES) ; called on subsequent attempts of auto-post for a given ERA (DAY 2, DAY 3, ex.)
+1 ; update ERA with receipt or if not posted then update the AUTO-POST REJECTION REASON (#5)
+2 ;
+3 ; RCERA = ien of entry in file 344.4
+4 ; RCRCPTDA = ien of receipt number (344, .01) - optional
+5 ; RCLINES = array of ERA line references
+6 ;
+7 IF '$GET(RCERA)
QUIT
+8 SET RCRCPTDA=$GET(RCRCPTDA)
+9 ;
+10 NEW DA,DIC,DIE,DLAYGO,DO,DR,X
+11 ; Update receipt. If this is the first receipt, put it in the RECEIPT (#08) field. If not, put in OTHER RECEIPTS multiple (#344.48)
+12 IF RCRCPTDA
Begin DoDot:1
+13 IF $PIECE($GET(^RCY(344.4,RCERA,0)),U,8)]""
SET DA(1)=RCERA
SET DIC="^RCY(344.4,"_DA(1)_",8,"
SET DIC(0)="L"
SET X=RCRCPTDA
DO FILE^DICN
IF 1
+14 IF '$TEST
SET DIE="^RCY(344.4,"
SET DR=".14////1;.08////"_RCRCPTDA
SET DA=RCERA
DO ^DIE
End DoDot:1
+15 ;
+16 ; Update ERA detail line with Receipt or reject reason as appropriate
+17 ; PRCA*4.5*318 begins
+18 NEW RCLIN,REJECT
+19 SET RCLIN=0
+20 FOR
SET RCLIN=$ORDER(RCLINES(RCLIN))
if 'RCLIN
QUIT
Begin DoDot:1
+21 ; Set REJECT to true if the line was rejected during validation
+22 SET REJECT=0
IF '$PIECE(RCLINES(RCLIN),U)
SET REJECT=1
+23 ;If not posted then update the AUTO-POST REJECTION REASON (#5)
+24 ;Otherwise update line with receipt number and autopost date
+25 SET DA(1)=RCERA
SET DA=RCLIN
SET DIE="^RCY(344.4,"_DA(1)_",1,"
+26 IF 'REJECT
IF 'RCRCPTDA
QUIT
+27 IF REJECT
SET DR="5///"_$PIECE(RCLINES(RCLIN),U,3)
+28 IF '$TEST
SET DR=".25///"_RCRCPTDA_";9///"_DT
+29 DO ^DIE
End DoDot:1
+30 ; PRCA*4.5*318 ends
+31 QUIT
+32 ;
ZEROBAL(RCSCR) ;
+1 ; per requirements, only positive/negative payment pairs where payment
+2 ; calculates to zero are allowed for auto-post
+3 ; if payment ends up less than zero or greater than zero then ERA cannot
+4 ; be autoposted.
+5 ; ERA gets sent to the standard worklist for manual receipt processing
+6 ; note: a payment pair represents 2 EEOB sequences with the same claim
+7 ; RCSCR - 344.49 ien
+8 ; X - returns 1 or 0
+9 ;
+10 NEW SUB,SUB1,WLINE,X,ERALINE
+11 SET SUB=0
SET X=1
SET ERALINE=""
+12 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+13 ;Get scratchpad line and data
+14 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
if 'SUB1
QUIT
SET WLINE=$GET(^RCY(344.49,RCSCR,1,SUB1,0))
+15 ;If integer sequence, get ERA line reference then quit for this sequence and go on to the non-integer sequence to finish validation
+16 IF $PIECE(WLINE,U)?1N.N
SET ERALINE=$PIECE(WLINE,U,9)
QUIT
+17 ; there are multiple EEOB sequences for the specific bill number so an adjustment took place;
+18 ; if payment adjustment doesn't generate a zero payment balance at 344.491,.06 then this ERA needs to drop to standard worklist
+19 IF ERALINE[","
IF +$PIECE(WLINE,U,6)'=0
SET X=0
QUIT
+20 ;do not autopost ERA if one of payments is negative amount
+21 IF $PIECE(WLINE,U,6)<0
SET X=0
End DoDot:1
+22 QUIT X
+23 ;
EXCLDRX(RCERA) ; Verify if auto-posting is allowed for Pharmacy claims
+1 ; and for the Payer - PRECHECK USED IN RCDPEM0. Not allowed if pharmacy
+2 ; auto-posting is switched off
+3 ; Input: RCERA - IEN for file 344.4
+4 ; Returns: 1 - ERA is excluded from Auto-Posting, 0 otherwise
+5 ; Rx Auto-Posting is turned OFF
if '$$GET1^DIQ(344.61,"1,",1.01,"I")
QUIT 1
+6 NEW RCPID,RCPNM,RCPXDA
+7 ;
+8 ; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
+9 SET RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
+10 ; No Payer Name
if RCPNM=""
QUIT 1
+11 SET RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
+12 ; No Payer TIN
if RCPID=""
QUIT 1
+13 ;
+14 ; Auto-post is allowed if this is a new payer (not in table)
+15 SET RCPXDA=$ORDER(^RCY(344.6,"CPID",RCPNM,RCPID,""))
if RCPXDA=""
QUIT 0
+16 ;
+17 ; If payer table entry found check if payer is excluded from pharmacy auto-post
+18 if $$GET1^DIQ(344.6,RCPXDA_",",.08,"I")=1
QUIT 1
+19 ;
+20 ; Otherwise it is OK to auto-post
+21 QUIT 0
+22 ;
EXCLDTR(RCERA) ; Verify if auto-posting is allowed for TRICARE claims
+1 ; and for the Payer - PRECHECK USED IN RCDPEM0. Not allowed if TRICARE
+2 ; auto-posting is switched off
+3 ; PRCA*4.5*349 - Added function
+4 ; Input: RCERA - IEN for file 344.4
+5 ; Returns: 1 - ERA is excluded from Auto-Posting, 0 otherwise
+6 ; TRICARE Auto-Posting is turned OFF
if '$$GET1^DIQ(344.61,"1,",1.05,"I")
QUIT 1
+7 NEW RCPID,RCPNM,RCPXDA
+8 ;
+9 ; Check if Payer Name and Payer ID from ERA are in auto-posting payer table
+10 SET RCPNM=$$GET1^DIQ(344.4,RCERA_",",.06,"E")
+11 ; No Payer Name
if RCPNM=""
QUIT 1
+12 SET RCPID=$$GET1^DIQ(344.4,RCERA_",",.03,"E")
+13 ; No Payer TIN
if RCPID=""
QUIT 1
+14 ;
+15 ; Auto-post is allowed if this is a new payer (not in table)
+16 SET RCPXDA=$ORDER(^RCY(344.6,"CPID",RCPNM,RCPID,""))
if RCPXDA=""
QUIT 0
+17 ;
+18 ; If payer table entry found check if payer is excluded from TRICARE auto-post
+19 if $$GET1^DIQ(344.6,RCPXDA_",",.13,"I")=1
QUIT 1
+20 ;
+21 ; Otherwise it is OK to auto-post
+22 QUIT 0
+23 ;
VALID(RCERA,RCLINES) ;
+1 ;Verify which scratchpad lines are able to auto-post - called by EN2^RCDPEAP
+2 ;
+3 ; RCERA - Electronic Remittance Advice (#344.4) IEN
+4 ; RCLINES - Array of ERA line references (passed in by reference)
+5 ; RCLINES(ERALINE)=1 - ERA line(s) are postable. Also RCLINES counter is incremented.
+6 ; RCLINES(ERALINE)=0^^Reject Reason Code - ERA line(s) are not postable
+7 ; NOTE: ORIGINAL ERA SEQUENCES (#.09) can have multiple ERA line references separated by commas (e.g.,"3,4")
+8 ;
+9 ;Check for ScratchPad entry. If missing (should not happen), quit
+10 NEW RCSCR
+11 SET RCSCR=$ORDER(^RCY(344.49,"B",+$GET(RCERA),""))
+12 IF RCSCR=""
SET RCLINES=0
QUIT
+13 ;Loop through scratchpad for this ERA
+14 NEW SUB,SUB1,WLINE,ERALINE,PIECE,SEQ,CLAIM,STATUS,CLARRAY,AUTOPOST
+15 SET SUB=0
FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+16 ;Get scratchpad line and data
+17 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
+18 IF 'SUB1
QUIT
+19 SET WLINE=$GET(^RCY(344.49,RCSCR,1,SUB1,0))
+20 ;If integer sequence, get ERA line reference and check for auto-post flag
+21 IF $PIECE(WLINE,U)?1N.N
Begin DoDot:2
+22 SET ERALINE=$PIECE(WLINE,U,9)
+23 ; If ERA reference is missing (should not happen), skip ahead to next integer sequence
+24 IF ERALINE=""
SET SUB=SUB\1_".999"
QUIT
+25 ; Check for receipt - PRCA*4.5*318
+26 ; PRCA*4.5*318
IF $$GET1^DIQ(344.41,ERALINE_","_RCERA_",",.25)]""
SET SUB=SUB\1_".999"
QUIT
+27 SET AUTOPOST=1
+28 FOR PIECE=1:1
SET SEQ=$PIECE(ERALINE,",",PIECE)
if 'SEQ
QUIT
IF '$PIECE($GET(^RCY(344.4,RCERA,1,SEQ,5)),U,2)
SET AUTOPOST=0
QUIT
+29 ; Unless all of the associated ERA detail lines are set for auto-post, skip ahead to next integer sequence
+30 IF 'AUTOPOST
SET SUB=SUB\1_".999"
QUIT
End DoDot:2
QUIT
+31 ;If no claim number (suspense), set to autopost but check the rest of the lines for the ERA reference
+32 SET CLAIM=$PIECE(WLINE,U,7)
+33 IF 'CLAIM
SET RCLINES(ERALINE)=1
QUIT
+34 ;Quit with error if claim is not OPEN or ACTIVE
+35 SET STATUS=$PIECE($GET(^PRCA(430,CLAIM,0)),"^",8)
+36 IF STATUS'=42
IF STATUS'=16
SET RCLINES(ERALINE)="0^^5"
SET SUB=SUB\1_".999"
QUIT
+37 ;Quit with error if referred to general council
+38 IF $PIECE($GET(^PRCA(430,CLAIM,6)),U,4)]""
SET RCLINES(ERALINE)="0^^7"
SET SUB=SUB\1_".999"
QUIT
+39 ;Check for negative payment amount
+40 IF $PIECE(WLINE,U,6)<0
SET RCLINES(ERALINE)="0^^6"
SET SUB=SUB\1_".999"
QUIT
+41 ;Increment claim balance. If payment exceeds claim balance and no pending payments (at the time of auto posting), quit
+42 ; with error. Also deduct the amount from the balance so subsequent, smaller amounts may get posted
+43 SET CLARRAY(CLAIM)=+$GET(CLARRAY(CLAIM))+$PIECE(WLINE,U,3)
+44 IF '$$CHECKPAY^RCDPEAP(.CLARRAY,CLAIM)
SET RCLINES(ERALINE)="0^^3"
SET SUB=SUB\1_".999"
SET CLARRAY(CLAIM)=+$GET(CLARRAY(CLAIM))-$PIECE(WLINE,U,3)
QUIT
+45 ;Line is potentially postable - update flag
+46 SET RCLINES(ERALINE)=1
End DoDot:1
+47 ;
+48 ;Reset the MARK FOR AUTOPOST flag on ERA lines and return count of auto-postable lines - PRCA*4.5*318
+49 NEW DA,DIE,DR,RCLIN,RCI
+50 SET RCLIN=0
SET RCLINES=0
FOR
SET RCLIN=$ORDER(RCLINES(RCLIN))
if 'RCLIN
QUIT
Begin DoDot:1
+51 IF +RCLINES(RCLIN)
SET RCLINES=RCLINES+1
+52 ;Set MARK FOR AUTO-POST (#6) to NO for every line
+53 SET DA(1)=RCERA
SET DA=RCLIN
SET DIE="^RCY(344.4,"_DA(1)_",1,"
+54 SET DR="6///0"
+55 DO ^DIE
End DoDot:1
+56 QUIT
+57 ;
UNBAL(RCERA) ; PRCA*4.5*318 added method
+1 ; Determine if the ERA total matches the EFT total for the selected ERA
+2 ; Input: RCERA - Internal IEN of the selected ERA
+3 ; Returns: 1 - ERA is unbalanced, 0 otherwise
+4 NEW RCLTOT,RCSUB,RCTOT
+5 ;ERA total balance - on matched ERAs the ERA total balance is the same as the EFT total
+6 SET RCTOT=+$$GET1^DIQ(344.4,RCERA_",",.05)
+7 ;Sum of ERA claim line payments
+8 SET RCSUB=0
SET RCLTOT=0
+9 FOR
SET RCSUB=$ORDER(^RCY(344.4,RCERA,1,RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+10 SET RCLTOT=RCLTOT+$$GET1^DIQ(344.41,RCSUB_","_RCERA_",",.03)
End DoDot:1
+11 ;Plus sum of ERA adjustment lines
+12 SET RCSUB=0
+13 FOR
SET RCSUB=$ORDER(^RCY(344.4,RCERA,2,RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+14 SET RCLTOT=RCLTOT+$$GET1^DIQ(344.42,RCSUB_","_RCERA_",",.03)
End DoDot:1
+15 ;Return 1 if total of ERA lines does not match EFT
+16 QUIT $SELECT(RCTOT=RCLTOT:0,1:1)
+17 ;
+18 ; PRCA*4.5*424 New subroutines MATCHED and is ZERO added
MATCHED(IEN) ; Check if ERA is matched
+1 ; Input IEN - Internal entry number of ERA #344.4
+2 ; Returns 1 if ERA is matched, otherwise 0
+3 IF $ORDER(^RCY(344.31,"AERA",RCERA,""))
QUIT 1
+4 QUIT 0
ISZERO(IEN) ; Check is ERA is zero balance (EP)
+1 ; Input IEN - Internal entry number of ERA #344.4
+2 ; Returns 1 if ERA is zero balance, otherwise 0
+3 IF +$PIECE($GET(^RCY(344.4,IEN,0)),U,5)=0
QUIT 1
+4 QUIT 0
