- 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 Jan 18, 2025@02:45:31 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