RCDPEAP ;ALB/PJH - AUTO POST MATCHING EFT ERA PAIR ;Oct 15, 2014@12:36:51
;;4.5;Accounts Receivable;**298,304,318,321,326**;Mar 20, 1995;Build 26
;Per VA Directive 6402, this routine should not be modified.
;Read ^IBM(361.1) via Private IA 4051
;
EN ;Auto-post ERA Receipts
;Process newly matched and matched but unprocessed ERAs
D EN1
;Process previously processed ERA's
D EN2
Q
;
EN1 ;Auto-post newly matched and matched but unprocessed ERA
N RCRZ,RCEFTDA
S RCRZ=0
;Scan ERA file for auto-post candidates with AUTO-POST STATUS = UNPOSTED
F S RCRZ=$O(^RCY(344.4,"E",0,RCRZ)) Q:'RCRZ D
.;Get EFT reference
.S RCEFTDA=$O(^RCY(344.31,"AERA",RCRZ,"")) Q:'RCEFTDA
.;Check that EFT funds were posted to FMS and Accepted by FMS. If not, quit and go to next unposted ERA
.N RCOK,RCDEPTDA,RCRECTDA
.S RCOK=1
.I $P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFTDA,0)),0)),U,8),$P($G(^RCY(344.31,+RCEFTDA,0)),U,7) D Q:'RCOK
..S RCDEPTDA=+$P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFTDA,0)),0)),U,3),RCRECTDA=+$O(^RCY(344,"AD",+RCDEPTDA,0)) ; Get deposit ticket and EFT receipt (CR - 8NZZ)
..I RCRECTDA N Z S Z=$P($$FMSSTAT^RCDPUREC(RCRECTDA),U,2) Q:$E(Z)="A"
..S RCOK=0
.;
.;Auto-Post
.D AUTOPOST(RCEFTDA,RCRZ)
Q
;
; Process ERA
AUTOPOST(RCEFTDA,RCERA) ;
; RCEFTDA = ien of file #344.31
; RCERA = ien of file #344.4
;
;Lock ERA
L +^RCY(344.4,RCERA):5 Q:'$T
;
;Build Scratchpad and Verify Lines
N ALLOK,RCERR,RCLINES,RCRCPTDA,RCSCR,RCTRDA,ZEROBAL ; PRCA*4.5*318 Variables placed in alpha order
K ^TMP($J,"RCDPEWLA")
S RCSCR=$$SCRPAD(RCERA)
; Re-set AUTO-POST STATUS if unable to create scratchpad
I 'RCSCR D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create scratchpad") G AUTOQ
;
; ERA cannot be autoposted; remove any pre-existing value to the AUTO-POST STATUS so ERA can be processed manually in the Worklist
I $D(^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS")) D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-ERA level Adjustment(s)") G AUTOQ
;
I $$UNBAL^RCDPEAP1(RCERA) D Q ; PRCA*4.5*318 Added line
.D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unbalanced ERA") ; PRCA*4.5*321
;
;Check if all lines can be posted
S ALLOK=$$ALLOK(RCERA,RCSCR,.ZEROBAL,.RCLINES)
;
;If $$ALLOK post entire ERA and reset AUTO-POST STATUS = COMPLETE
I ALLOK D POSTALL(RCERA)
;
; If 'ALLOK and 'ZEROBAL(matching positive/negative pairs to not balance out to zero), then ERA needs to go to the standard worklist for manual receipt processing
I 'ALLOK,'ZEROBAL D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-+/- pairs do not balance") G AUTOQ
;
;If 'ALLOK and some of the lines passed validation then post receipt to summary ERA and set AUTO-POST STATUS = PARTIAL
;Un-posted lines fall to APAR list for processing.
I 'ALLOK D POSTERA(RCERA,.RCLINES)
;Unlock ERA
AUTOQ D UNLOCKE
Q
;
EN2 ;Auto-Post Previously Processed ERA
N AUTORCPT,CLAIM,COMPLETE,EOBIEN,RCDUZ,RCERA,RCIFN,RCRCPTDA,RCLINES
S RCERA=0,AUTORCPT=1 ;Variable AUTORCPT suppresses #344 trigger update to ERA receipt field
;Scan ERA file for auto-post candidates with AUTO-POST STATUS = PARTIAL
F S RCERA=$O(^RCY(344.4,"E",1,RCERA)) Q:'RCERA D
. ;Ignore if it was just partially posted in POSTLNS so we do not process again
. Q:$D(^TMP("RCDPEAP",$J,RCERA))
. S RCDUZ=$$GET1^DIQ(344.4,RCERA_",",4.04,"I") ; PRCA*4.5*326
. ;Set receipt variable to null for each ERA so that the receipt number from the previous ERA is not hanging around
. S RCRCPTDA=""
. ;Check if there are lines that are set for auto-posting and if they can be posted or have errors.
. K RCLINES
. S RCLINES=0
. D VALID^RCDPEAP1(RCERA,.RCLINES)
. ;If valid lines found create receipt for those lines (Variable RCLINES is only incremented for valid lines)
. I RCLINES D
. . N RCEFTDA,RCDEPTDA,RCRECTDA
. . ;Get EFT reference
. . S RCEFTDA=$O(^RCY(344.31,"AERA",RCERA,"")) Q:'RCEFTDA
. . ;Get deposit ticket and EFT receipt
. . S RCDEPTDA=+$P($G(^RCY(344.3,+$G(^RCY(344.31,+RCEFTDA,0)),0)),U,3),RCRECTDA=+$O(^RCY(344,"AD",+RCDEPTDA,0))
. . ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
. . ; Creates basic receipt for ERA of payment type EDI LOCKBOX; 2nd parameter means an alpha suffix on receipt number
. . S RCRCPTDA=$$BLDRCPT^RCDPEMA(RCERA,RCDUZ) ; PRCA*4.5*326 Add RCDUZ to call
. . I 'RCRCPTDA Q ;PRCA*4.5*318 - Problem building receipt header
. . K RCERR
. . D RCPTDET^RCDPEMA(RCERA,RCRCPTDA,.RCLINES,.RCERR) ; Adds detail to a receipt based on file 344.49 and RCLINES array
. . ;;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL - PRCA*4.5*318 - replaced following line
. . ;;I $O(RCERR("")) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt") Q
. . I $O(RCERR("")) Q ; PRCA*4.5*318 - Do not attempt to process partially filed receipt
. . ;Lock ERA receipt and deposit ticket
. . I '$$LOCKREC^RCDPRPLU(RCRCPTDA) Q
. . I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCKR Q
. . ;Process Receipt to FMS
. . D PROCESS^RCDPURE1(RCRCPTDA,2) I $D(^TMP("RCDPE-RECEIPT-ERROR",$J)) D UNLOCKR Q
. . ; update 344, .18 ERA REFERENCE field
. . D ERAREF(RCERA,RCRCPTDA)
. . ;Unlock deposit ticket and receipt
. . D UNLOCKR
. ;Update ERA and ERA detail lines with receipt # or auto-post rejection reason
. D ERADET^RCDPEAP1(RCERA,RCRCPTDA,.RCLINES)
. ;Determine if posting complete for this ERA
. S COMPLETE=$$COMPLETE(RCERA)
. ;If complete update ERA detail post status to POSTED
. I COMPLETE S DIE="^RCY(344.4,",DR=".14////1",DA=RCERA D ^DIE
. ;Update the audit log
. D AUDITLOG(RCERA,$S(COMPLETE:2,1:1),"Auto Posting: Previously processed ERA posting attempt")
. ;Set ERA auto-post status and update latest auto-post date
. S DIE="^RCY(344.4,",DR="4.01////"_DT_";4.02////"_$S(COMPLETE:2,1:1),DA=RCERA D ^DIE
;Unlock ERA
D UNLOCKE
Q
;
;Functions/Sub-routines in alpha order
;
ACTIVE(EOBIEN) ;Verify claim is active
; EOBIEN - IEN of file 361.1
N RCIFN,RCBILL,RCSTATUS
;Get EOB number (implies this is 3rd Party claim)
I 'EOBIEN Q 0
;Get #399 claim number from EOB
S RCIFN=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCIFN 0
S RCBILL=$P($G(^DGCR(399,RCIFN,0)),U) Q:RCBILL="" 0 ; IA 4051
;Check if bill is cancelled or closed
S RCSTATUS=$P($G(^DGCR(399,RCIFN,0)),U,13)
Q $S(RCSTATUS=0:0,RCSTATUS=7:0,1:1)
;
ALLOK(RCERA,RCSCR,ZEROBAL,RCLINES) ;Verify which scratchpad lines are able to auto-post
; RCERA - 344.4 ien
; RCSCR - 344.49 ien
; ZEROBAL - flag that represents if ERA has zero payment balance after processing matched positive/negative pairs, passed by reference
; RCLINES - array of ERA line references (passed in by reference)
; NOTE: ORIGINAL ERA SEQUENCES (344.491, .09) can have multiple ERA line references separated by commas (e.g., 3,4)
; returns 0 or 1 (ALLOK)
N ALLOK,AMT,ERALINE,STATUS,SUB,SUB1,CLAIM,WLINE,VERIFY
K CLARRAY
S (ZEROBAL,ALLOK)=1
S (SUB,RCLINES)=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,"")) Q:'SUB1 S WLINE=$G(^RCY(344.49,RCSCR,1,SUB1,0)),AMT=$P(WLINE,U,3)
. ;If integer sequence, get ERA line reference and verify flag and then quit for this sequence and go on to the non-integer sequence to finish validation
. I $P(WLINE,U)?1N.N S VERIFY=1 S ERALINE=$P(WLINE,U,9) S:'$P(WLINE,U,13) ALLOK=0,RCLINES(ERALINE)="0^^1",VERIFY=0 Q
. ; ignore zero valued lines
. Q:AMT=0 Q:AMT="0.00"
. ;Get claim number from N.001 line - if not found treat as inactive
. S CLAIM=$P(WLINE,U,7) I 'CLAIM S ALLOK=0,$P(RCLINES(ERALINE),U,3)=2 Q
. ;Save claim number
. S $P(RCLINES(ERALINE),U,2)=$P($G(^PRCA(430,CLAIM,0)),U) Q:'VERIFY
. ;Claim must be OPEN or ACTIVE
. S STATUS=$P($G(^PRCA(430,CLAIM,0)),"^",8) I STATUS'=42,STATUS'=16 S ALLOK=0,$P(RCLINES(ERALINE),U,3)=2 Q
. ;Check that payment does not exceed balance and no pending payments (at the time of auto posting)
. S CLARRAY(CLAIM)=+$G(CLARRAY(CLAIM))+$P(WLINE,U,3) I '$$CHECKPAY(.CLARRAY,CLAIM) S ALLOK=0,$P(RCLINES(ERALINE),U,3)=3 Q
. ;Check if referred to general council
. I $P($G(^PRCA(430,CLAIM,6)),U,4)]"" S ALLOK=0,$P(RCLINES(ERALINE),U,3)=4 Q
. ;Line is potentially postable
. S $P(RCLINES(ERALINE),U)=1,$P(RCLINES(ERALINE),U,3)=$P(WLINE,U,6),RCLINES=$G(RCLINES)+1
Q ALLOK
;
AUDITLOG(DA,RCNEWST,RCREASON) ;
; Update the Auto-post Audit Log
;
I '$G(DA) Q
I $G(RCREASON)="" Q
;
N RCAUDIT,RCOLDST,DIE,DR,X,Y,DTOUT,DUOUT,DROUT,DIRUT
; Get the current status
S RCOLDST=$$GET1^DIQ(344.4,DA_",",4.02,"I")
; If the new status is null, set to old status (no change)
I $G(RCNEWST)="" S RCNEWST=RCOLDST
; File
S RCAUDIT(344.72,"+1,",.01)=$$NOW^XLFDT ;Date/Time Stamp
S RCAUDIT(344.72,"+1,",.02)=$S($G(RCDUZ):RCDUZ,1:DUZ) ;User PRCA*4.5*321 Use RCDUZ if defined
S RCAUDIT(344.72,"+1,",.03)=DA ;ERA #
S RCAUDIT(344.72,"+1,",.04)=RCOLDST ;Old Status
I RCNEWST'="@" S RCAUDIT(344.72,"+1,",.05)=RCNEWST ;New status
S RCAUDIT(344.72,"+1,",.06)=$E(RCREASON,1,80) ;Reason text
D UPDATE^DIE(,"RCAUDIT")
Q
;
BUILD(RCSCR,ARRAY) ; EP from EN2^RCDPEAD - Build list of ERA lines
;
; RCSCR = ien of file 344.49
; ARRAY = the array that will hold the list of ERA lines, passed by reference
;
N ERALINE,FOUND,SCRLINE,SUB,SUB1
K ARRAY
S SUB=0,ARRAY=0
F S SUB=$O(^RCY(344.49,RCSCR,1,"B",SUB)) Q:SUB="" D:SUB'["."
. ;Get actual scratchpad ^RCY(344.49,RCSCR,1) node
. S SUB1=$O(^RCY(344.49,RCSCR,1,"B",SUB,"")) Q:'SUB1
. ;;Ignore zero lines - removed PRCA*4.5*326
. ;Q:'$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,3)
. ; Get ERA line
. S ERALINE=$$GET1^DIQ(344.491,SUB1_","_RCSCR,.09) ; PRCA*4.5*326
. ; Ignore reversals
. Q:ERALINE["," ; PRCA*4.5*326
. ;Index scratchpad line by ERA sequence
. S ARRAY(ERALINE)=SUB1,ARRAY=$G(ARRAY)+1 ; PRCA*4.5*326
Q
;
CHECKPAY(ARRAY,CLAIM) ;Check balance versus payments
; ARRAY = array of claim numbers and respective payment amounts
; e.g. ARRAY(430 ien) = 123.04
; CLAIM = AR BILL (344.491, .07) - IEN of file 430
Q:'CLAIM 0
;
; BEGIN PRCA*4.5*326
N RCADMIN,RCBAL,RCCOURT,RCINT,RCMAR,RCPRIN
S RCPRIN=$$GET1^DIQ(430,CLAIM_",",71) ; Principle Balance
S RCINT=$$GET1^DIQ(430,CLAIM_",",72) ; Interest
S RCADMIN=$$GET1^DIQ(430,CLAIM_",",73) ; Admin Cost
S RCMAR=$$GET1^DIQ(430,CLAIM_",",74) ; Marshal Fee
S RCCOURT=$$GET1^DIQ(430,CLAIM_",",75) ; Court Cost
S RCBAL=RCPRIN+RCINT+RCADMIN+RCMAR+RCCOURT ; Total balance
; get the payment amount to be posted to the claim
S AMT=ARRAY(CLAIM)
;Payment exceeds principle balance
Q:AMT>RCBAL 0
; END PRCA*4.5*326
;Check pending payments for claim
N PENDING S PENDING=$$PENDPAY^RCDPURET(CLAIM) K ^TMP($J,"RCDPUREC","PP")
;Pending payments is > billed
I PENDING>AMT Q 0
;otherwise OK to post payment
Q 1
;
CLEAR(DA) ;Clear scratchpad
N DIK S DIK="^RCY(344.49," D ^DIK
Q
;
COMPLETE(RCSCR) ;Check for non-zero lines without a receipt
;
; RCSCR = ien of file 344.49
; Returns status of check (1 or 0)
N RCSUB,SCRSUB,COMPLETE,SCRLINE,RCERA
;Default to complete
S SCRSUB=0,COMPLETE=1,RCERA=RCSCR
;Scan scratchpad
F S SCRSUB=$O(^RCY(344.49,RCSCR,1,SCRSUB)) Q:'SCRSUB D Q:'COMPLETE
. ;Ignore zero and split lines (splitting line should not change balance)
. S SCRLINE=$G(^RCY(344.49,RCSCR,1,SCRSUB,0)) Q:$P(SCRLINE,U)'?1N.N Q:$P(SCRLINE,U,3)=0 Q:$P(SCRLINE,U,3)="0.00"
. ;Check if non-zero line has receipt on ERA, DETAIL line
. S RCSUB=$P(SCRLINE,U,9) I RCSUB,$P($G(^RCY(344.4,RCERA,1,RCSUB,4)),U,3)]"" Q
. ;Otherwise more AUTO-posting to do
. S COMPLETE=0
Q COMPLETE
;
ERAREF(RCSCR,RCRCPTDA) ; update ERA reference and EFT record IEN in file 344
; RCSCR - IEN of record in file 344.49
; RCRCPTDA - ien of record in file 344 (receipt ien)
N Z,DR,DIE,DA
S Z=+$O(^RCY(344.31,"AERA",RCSCR,0))
S DIE="^RCY(344,",DA=RCRCPTDA,DR=".18////"_RCSCR_$S(Z:";.17////"_Z,1:"") D ^DIE
Q
;
NOTOK(RCSCR) ;Verify all scratchpad lines passed auto verify (V)
;
; RCSCR = ien of file 344.49
; Returns status of check (1 or 0)
N NOTOK,SUB
S SUB=0,NOTOK=0
F S SUB=$O(^RCY(344.49,RCSCR,1,SUB)) Q:'SUB D Q:NOTOK
. ;Set NOTOK if any single line is unverified
. S:$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U,13)'=1 NOTOK=1
Q NOTOK
;
POSTALL(RCERA) ; all lines in ERA get posted on first attempt of auto-post
;
; RCERA = ien of 344.4
;
;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
; PRCA*4.5*326 begin modified code block
N RCDUZ
S RCDUZ=$$GET1^DIQ(344.4,RCERA_",",4.04,"I")
S RCRCPTDA=$$BLDRCPT^RCDPUREC(DT,"",+$O(^RC(341.1,"AC",14,0)),RCDUZ) ; Creates basic receipt for ERA of payment type EDI LOCKBOX; 2nd parameter means no alpha suffix on receipt number
D RCPTDET^RCDPEM(RCSCR,RCRCPTDA,.RCERR,RCDUZ) ; Adds detail to a receipt based on file 344.49
; PRCA*4.5*326 end modified code block
;
;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
I $O(RCERR("")) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt") Q
;
;Lock ERA receipt and deposit ticket
I '$$LOCKREC^RCDPRPLU(RCRCPTDA) Q
I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCKR Q
;
;Process Receipt to FMS
D PROCESS^RCDPURE1(RCRCPTDA,2)
I $D(^TMP("RCDPE-RECEIPT-ERROR",$J)) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Error in receipt processing"),UNLOCKR Q
;
; update 344, .18 ERA REFERENCE field
D ERAREF(RCSCR,RCRCPTDA)
;
;Unlock deposit ticket and receipt
D UNLOCKR
;
;Update the audit log
D AUDITLOG(RCERA,2,"Auto Posting: ERA posted successfully")
;Update ERA receipt and detail post status
S DIE="^RCY(344.4,",DR=".14////1;.08////"_RCRCPTDA,DA=RCERA D ^DIE
;Set ERA auto-post status to 'complete' and update latest auto-post date
S DIE="^RCY(344.4,"
S DR="4.01////"_DT_";4.02////2"
S DA=RCERA
D ^DIE
;Update auto-post date for each claim line
N RCLINE,RCSCSUB,RCSCD0
S RCSCSUB=0
F S RCSCSUB=$O(^RCY(344.49,RCERA,1,RCSCSUB)) Q:'RCSCSUB D
. S RCSCD0=$G(^RCY(344.49,RCERA,1,RCSCSUB,0))
. ;Ignore if zero value (line not on receipt) otherwise get original ERA line sequence
. Q:'+$P(RCSCD0,U,3) S RCLINE=$P(RCSCD0,U,9) Q:'RCLINE
. ;Update ERA line with receipt number and auto-post date
. N DA,DIE,DR S DA(1)=RCERA,DA=RCLINE,DIE="^RCY(344.4,"_DA(1)_",1,",DR=".25////"_RCRCPTDA_";9////"_DT D ^DIE
Q
;
POSTERA(RCERA,RCLINES) ; only some of the EEOB lines passed validation on first attempt (DAY 1) of auto-post
; therefore assign the receipt number and 'partial' post status to ERA summary
;
; RCERA = ien of 344.4
; RCLINES = array of ERA line references
;
; no lines passed validation; at lease 1 EEOB line needs to pass validation before assigning a receipt to the ERA
I RCLINES=0 S RCRCPTDA="" G POSTERAQ
;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
S RCRCPTDA=$$BLDRCPT^RCDPEMA(RCERA) ; Creates basic receipt for ERA of payment type EDI LOCKBOXA
D RCPTDET^RCDPEMA(RCSCR,RCRCPTDA,.RCLINES,.RCERR) ; Adds detail to a receipt based on file 344.49 and RCLINES array
;
;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
I $O(RCERR("")) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt") Q
;
;Lock ERA receipt and deposit ticket
I '$$LOCKREC^RCDPRPLU(RCRCPTDA) Q
I '$$LOCKDEP^RCDPDPLU(RCDEPTDA) D UNLOCKR Q
;
;Process Receipt to FMS
D PROCESS^RCDPURE1(RCRCPTDA,2)
I $D(^TMP("RCDPE-RECEIPT-ERROR",$J)) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Error in receipt processing"),UNLOCKR Q
;
; update 344, .18 ERA REFERENCE field
D ERAREF(RCSCR,RCRCPTDA)
;
;Unlock deposit ticket and receipt
D UNLOCKR
;Update ERA receipt and detail post status
S DIE="^RCY(344.4,",DR=".14////5;.08////"_RCRCPTDA,DA=RCERA D ^DIE
POSTERAQ ;
D POSTLNS(RCERA,RCRCPTDA,.RCLINES)
Q
;
POSTLNS(RCERA,RCRCPTDA,RCLINES) ; this subroutine should only be called when some of the EEOB lines
; passed validation on FIRST attempt (DAY 1) of auto-post
;
; RCERA = ien of ERA entry in 344.4
; RCRCPTDA = ien of receipt entry in 344 or undefined if receipt not created since none of the lines passed validation
; RCLINES = array of ERA line references
;
;Mark ERA as processed to prevent reprocessing in EN2^RCDPEAP which runs next
S ^TMP("RCDPEAP",$J,RCERA)=""
S RCRCPTDA=$G(RCRCPTDA)
;Update individual claim lines on ERA
N RCLIN,DA,DIE,DR,LNUM,RCI,REJECT
S RCLIN=0 F S RCLIN=$O(RCLINES(RCLIN)) Q:'RCLIN D
. ; flag the line if it was rejected during validation
. S REJECT=0 I '$P(RCLINES(RCLIN),U) S REJECT=1
. ;get all ERA line references (e.g. RCLINES(RCLIN) could have multiple line # references)
. ;Need to parse out each line reference so that the necessary fields can be updated for the specific line
. F RCI=1:1 S LNUM=$P(RCLIN,",",RCI) Q:LNUM="" D
. . S DA(1)=RCERA,DA=LNUM,DIE="^RCY(344.4,"_DA(1)_",1,"
. . ;If not posted then the AUTO-POST REJECTION REASON (344.41,5) needs to be updated ;otherwise update line with receipt number and auto-post date
. . I REJECT S DR="5////"_$P(RCLINES(RCLIN),U,3)
. . E S DR=".25////"_RCRCPTDA_";9////"_DT
. . D ^DIE
;Update the Audit Log
D AUDITLOG(RCERA,1,"Auto Posting: Some of the ERA lines went to APAR")
;Set ERA AUTO-POST STATUS = PARTIAL and update auto-post date
S DIE="^RCY(344.4,",DR="4.01////"_DT_";4.02////1",DA=RCERA D ^DIE
Q
;
SCRPAD(RCERA) ;Build Scratchpad entry in #344.49 for the ERA
;
; Input - RCERA - IEN for #344.4
;
; Output - RCSCR = Scratchpad IEN (Success) or 0 (Fail)
;
N RC0,RC5,RCSCR,RCDAT,X
S RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
;Ignore is this ERA already has a receipt
I +$P(RC0,U,8) Q 0
;Ignore if this is zero ERA
I +$P(RC0,U,5)=0 Q 0
; BEGIN PRCA*4.5*326
;Ignore if this is not a valid auto-post ERA type
;I "^ACH^CHK^"'[(U_$P(RC0,U,15)_U) Q 0 ; added CHK - PRCA*4.5*321
I "^ACH^CHK^NON^BOP^"'[(U_$P(RC0,U,15)_U) Q 0
;ERA must be matched to an EFT to be eligible for mark for autopost
I '$O(^RCY(344.31,"AERA",RCERA,"")) Q 0
; END PRCA*4.5*326
;Scratchpad already exists
S RCSCR=+$O(^RCY(344.49,"B",RCERA,0)) I RCSCR G SCRPADX
;Create new Scratchpad
S RCSCR=+$$ADDREC^RCDPEWL(RCERA,.RCDAT) I 'RCSCR Q 0
;Add all the ERA lines to the Scratchpad entry
D ADDLINES^RCDPEWLA(RCSCR)
SCRPADX ;Return Scratchpad IEN
Q RCSCR
;
SETSTA(DA,STATUS,RCREASON) ;Set ERA auto-post status
; Log status change
I '$G(DA) Q
I $G(STATUS)="" Q
;
D AUDITLOG(DA,STATUS,$G(RCREASON))
; Update status
N DIE,DR
S DIE="^RCY(344.4,"
S DR="4.02////"_STATUS
S DR=DR_";4.04///"_$S(STATUS=0&(DUZ'=.5):"`"_DUZ,1:"@")
D ^DIE
Q
;
;
UNLOCKR ;Unlock ERA receipt and deposit ticket
L -^RCY(344,RCRCPTDA)
L -^RCY(344.1,RCDEPTDA)
Q
;
UNLOCKE ;Unlock ERA
L -^RCY(344.4,RCERA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAP 19269 printed Apr 09, 2024@20:48:20 Page 2
RCDPEAP ;ALB/PJH - AUTO POST MATCHING EFT ERA PAIR ;Oct 15, 2014@12:36:51
+1 ;;4.5;Accounts Receivable;**298,304,318,321,326**;Mar 20, 1995;Build 26
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Read ^IBM(361.1) via Private IA 4051
+4 ;
EN ;Auto-post ERA Receipts
+1 ;Process newly matched and matched but unprocessed ERAs
+2 DO EN1
+3 ;Process previously processed ERA's
+4 DO EN2
+5 QUIT
+6 ;
EN1 ;Auto-post newly matched and matched but unprocessed ERA
+1 NEW RCRZ,RCEFTDA
+2 SET RCRZ=0
+3 ;Scan ERA file for auto-post candidates with AUTO-POST STATUS = UNPOSTED
+4 FOR
SET RCRZ=$ORDER(^RCY(344.4,"E",0,RCRZ))
if 'RCRZ
QUIT
Begin DoDot:1
+5 ;Get EFT reference
+6 SET RCEFTDA=$ORDER(^RCY(344.31,"AERA",RCRZ,""))
if 'RCEFTDA
QUIT
+7 ;Check that EFT funds were posted to FMS and Accepted by FMS. If not, quit and go to next unposted ERA
+8 NEW RCOK,RCDEPTDA,RCRECTDA
+9 SET RCOK=1
+10 IF $PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFTDA,0)),0)),U,8)
IF $PIECE($GET(^RCY(344.31,+RCEFTDA,0)),U,7)
Begin DoDot:2
+11 ; Get deposit ticket and EFT receipt (CR - 8NZZ)
SET RCDEPTDA=+$PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFTDA,0)),0)),U,3)
SET RCRECTDA=+$ORDER(^RCY(344,"AD",+RCDEPTDA,0))
+12 IF RCRECTDA
NEW Z
SET Z=$PIECE($$FMSSTAT^RCDPUREC(RCRECTDA),U,2)
if $EXTRACT(Z)="A"
QUIT
+13 SET RCOK=0
End DoDot:2
if 'RCOK
QUIT
+14 ;
+15 ;Auto-Post
+16 DO AUTOPOST(RCEFTDA,RCRZ)
End DoDot:1
+17 QUIT
+18 ;
+19 ; Process ERA
AUTOPOST(RCEFTDA,RCERA) ;
+1 ; RCEFTDA = ien of file #344.31
+2 ; RCERA = ien of file #344.4
+3 ;
+4 ;Lock ERA
+5 LOCK +^RCY(344.4,RCERA):5
if '$TEST
QUIT
+6 ;
+7 ;Build Scratchpad and Verify Lines
+8 ; PRCA*4.5*318 Variables placed in alpha order
NEW ALLOK,RCERR,RCLINES,RCRCPTDA,RCSCR,RCTRDA,ZEROBAL
+9 KILL ^TMP($JOB,"RCDPEWLA")
+10 SET RCSCR=$$SCRPAD(RCERA)
+11 ; Re-set AUTO-POST STATUS if unable to create scratchpad
+12 IF 'RCSCR
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create scratchpad")
GOTO AUTOQ
+13 ;
+14 ; ERA cannot be autoposted; remove any pre-existing value to the AUTO-POST STATUS so ERA can be processed manually in the Worklist
+15 IF $DATA(^TMP($JOB,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS"))
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-ERA level Adjustment(s)")
GOTO AUTOQ
+16 ;
+17 ; PRCA*4.5*318 Added line
IF $$UNBAL^RCDPEAP1(RCERA)
Begin DoDot:1
+18 ; PRCA*4.5*321
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unbalanced ERA")
End DoDot:1
QUIT
+19 ;
+20 ;Check if all lines can be posted
+21 SET ALLOK=$$ALLOK(RCERA,RCSCR,.ZEROBAL,.RCLINES)
+22 ;
+23 ;If $$ALLOK post entire ERA and reset AUTO-POST STATUS = COMPLETE
+24 IF ALLOK
DO POSTALL(RCERA)
+25 ;
+26 ; If 'ALLOK and 'ZEROBAL(matching positive/negative pairs to not balance out to zero), then ERA needs to go to the standard worklist for manual receipt processing
+27 IF 'ALLOK
IF 'ZEROBAL
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-+/- pairs do not balance")
GOTO AUTOQ
+28 ;
+29 ;If 'ALLOK and some of the lines passed validation then post receipt to summary ERA and set AUTO-POST STATUS = PARTIAL
+30 ;Un-posted lines fall to APAR list for processing.
+31 IF 'ALLOK
DO POSTERA(RCERA,.RCLINES)
+32 ;Unlock ERA
AUTOQ DO UNLOCKE
+1 QUIT
+2 ;
EN2 ;Auto-Post Previously Processed ERA
+1 NEW AUTORCPT,CLAIM,COMPLETE,EOBIEN,RCDUZ,RCERA,RCIFN,RCRCPTDA,RCLINES
+2 ;Variable AUTORCPT suppresses #344 trigger update to ERA receipt field
SET RCERA=0
SET AUTORCPT=1
+3 ;Scan ERA file for auto-post candidates with AUTO-POST STATUS = PARTIAL
+4 FOR
SET RCERA=$ORDER(^RCY(344.4,"E",1,RCERA))
if 'RCERA
QUIT
Begin DoDot:1
+5 ;Ignore if it was just partially posted in POSTLNS so we do not process again
+6 if $DATA(^TMP("RCDPEAP",$JOB,RCERA))
QUIT
+7 ; PRCA*4.5*326
SET RCDUZ=$$GET1^DIQ(344.4,RCERA_",",4.04,"I")
+8 ;Set receipt variable to null for each ERA so that the receipt number from the previous ERA is not hanging around
+9 SET RCRCPTDA=""
+10 ;Check if there are lines that are set for auto-posting and if they can be posted or have errors.
+11 KILL RCLINES
+12 SET RCLINES=0
+13 DO VALID^RCDPEAP1(RCERA,.RCLINES)
+14 ;If valid lines found create receipt for those lines (Variable RCLINES is only incremented for valid lines)
+15 IF RCLINES
Begin DoDot:2
+16 NEW RCEFTDA,RCDEPTDA,RCRECTDA
+17 ;Get EFT reference
+18 SET RCEFTDA=$ORDER(^RCY(344.31,"AERA",RCERA,""))
if 'RCEFTDA
QUIT
+19 ;Get deposit ticket and EFT receipt
+20 SET RCDEPTDA=+$PIECE($GET(^RCY(344.3,+$GET(^RCY(344.31,+RCEFTDA,0)),0)),U,3)
SET RCRECTDA=+$ORDER(^RCY(344,"AD",+RCDEPTDA,0))
+21 ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
+22 ; Creates basic receipt for ERA of payment type EDI LOCKBOX; 2nd parameter means an alpha suffix on receipt number
+23 ; PRCA*4.5*326 Add RCDUZ to call
SET RCRCPTDA=$$BLDRCPT^RCDPEMA(RCERA,RCDUZ)
+24 ;PRCA*4.5*318 - Problem building receipt header
IF 'RCRCPTDA
QUIT
+25 KILL RCERR
+26 ; Adds detail to a receipt based on file 344.49 and RCLINES array
DO RCPTDET^RCDPEMA(RCERA,RCRCPTDA,.RCLINES,.RCERR)
+27 ;;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL - PRCA*4.5*318 - replaced following line
+28 ;;I $O(RCERR("")) D CLEAR(RCSCR),SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt") Q
+29 ; PRCA*4.5*318 - Do not attempt to process partially filed receipt
IF $ORDER(RCERR(""))
QUIT
+30 ;Lock ERA receipt and deposit ticket
+31 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+32 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+33 ;Process Receipt to FMS
+34 DO PROCESS^RCDPURE1(RCRCPTDA,2)
IF $DATA(^TMP("RCDPE-RECEIPT-ERROR",$JOB))
DO UNLOCKR
QUIT
+35 ; update 344, .18 ERA REFERENCE field
+36 DO ERAREF(RCERA,RCRCPTDA)
+37 ;Unlock deposit ticket and receipt
+38 DO UNLOCKR
End DoDot:2
+39 ;Update ERA and ERA detail lines with receipt # or auto-post rejection reason
+40 DO ERADET^RCDPEAP1(RCERA,RCRCPTDA,.RCLINES)
+41 ;Determine if posting complete for this ERA
+42 SET COMPLETE=$$COMPLETE(RCERA)
+43 ;If complete update ERA detail post status to POSTED
+44 IF COMPLETE
SET DIE="^RCY(344.4,"
SET DR=".14////1"
SET DA=RCERA
DO ^DIE
+45 ;Update the audit log
+46 DO AUDITLOG(RCERA,$SELECT(COMPLETE:2,1:1),"Auto Posting: Previously processed ERA posting attempt")
+47 ;Set ERA auto-post status and update latest auto-post date
+48 SET DIE="^RCY(344.4,"
SET DR="4.01////"_DT_";4.02////"_$SELECT(COMPLETE:2,1:1)
SET DA=RCERA
DO ^DIE
End DoDot:1
+49 ;Unlock ERA
+50 DO UNLOCKE
+51 QUIT
+52 ;
+53 ;Functions/Sub-routines in alpha order
+54 ;
ACTIVE(EOBIEN) ;Verify claim is active
+1 ; EOBIEN - IEN of file 361.1
+2 NEW RCIFN,RCBILL,RCSTATUS
+3 ;Get EOB number (implies this is 3rd Party claim)
+4 IF 'EOBIEN
QUIT 0
+5 ;Get #399 claim number from EOB
+6 SET RCIFN=$PIECE($GET(^IBM(361.1,EOBIEN,0)),U)
if 'RCIFN
QUIT 0
+7 ; IA 4051
SET RCBILL=$PIECE($GET(^DGCR(399,RCIFN,0)),U)
if RCBILL=""
QUIT 0
+8 ;Check if bill is cancelled or closed
+9 SET RCSTATUS=$PIECE($GET(^DGCR(399,RCIFN,0)),U,13)
+10 QUIT $SELECT(RCSTATUS=0:0,RCSTATUS=7:0,1:1)
+11 ;
ALLOK(RCERA,RCSCR,ZEROBAL,RCLINES) ;Verify which scratchpad lines are able to auto-post
+1 ; RCERA - 344.4 ien
+2 ; RCSCR - 344.49 ien
+3 ; ZEROBAL - flag that represents if ERA has zero payment balance after processing matched positive/negative pairs, passed by reference
+4 ; RCLINES - array of ERA line references (passed in by reference)
+5 ; NOTE: ORIGINAL ERA SEQUENCES (344.491, .09) can have multiple ERA line references separated by commas (e.g., 3,4)
+6 ; returns 0 or 1 (ALLOK)
+7 NEW ALLOK,AMT,ERALINE,STATUS,SUB,SUB1,CLAIM,WLINE,VERIFY
+8 KILL CLARRAY
+9 SET (ZEROBAL,ALLOK)=1
+10 SET (SUB,RCLINES)=0
+11 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+12 ;Get scratchpad line and data
+13 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
if 'SUB1
QUIT
SET WLINE=$GET(^RCY(344.49,RCSCR,1,SUB1,0))
SET AMT=$PIECE(WLINE,U,3)
+14 ;If integer sequence, get ERA line reference and verify flag and then quit for this sequence and go on to the non-integer sequence to finish validation
+15 IF $PIECE(WLINE,U)?1N.N
SET VERIFY=1
SET ERALINE=$PIECE(WLINE,U,9)
if '$PIECE(WLINE,U,13)
SET ALLOK=0
SET RCLINES(ERALINE)="0^^1"
SET VERIFY=0
QUIT
+16 ; ignore zero valued lines
+17 if AMT=0
QUIT
if AMT="0.00"
QUIT
+18 ;Get claim number from N.001 line - if not found treat as inactive
+19 SET CLAIM=$PIECE(WLINE,U,7)
IF 'CLAIM
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=2
QUIT
+20 ;Save claim number
+21 SET $PIECE(RCLINES(ERALINE),U,2)=$PIECE($GET(^PRCA(430,CLAIM,0)),U)
if 'VERIFY
QUIT
+22 ;Claim must be OPEN or ACTIVE
+23 SET STATUS=$PIECE($GET(^PRCA(430,CLAIM,0)),"^",8)
IF STATUS'=42
IF STATUS'=16
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=2
QUIT
+24 ;Check that payment does not exceed balance and no pending payments (at the time of auto posting)
+25 SET CLARRAY(CLAIM)=+$GET(CLARRAY(CLAIM))+$PIECE(WLINE,U,3)
IF '$$CHECKPAY(.CLARRAY,CLAIM)
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=3
QUIT
+26 ;Check if referred to general council
+27 IF $PIECE($GET(^PRCA(430,CLAIM,6)),U,4)]""
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=4
QUIT
+28 ;Line is potentially postable
+29 SET $PIECE(RCLINES(ERALINE),U)=1
SET $PIECE(RCLINES(ERALINE),U,3)=$PIECE(WLINE,U,6)
SET RCLINES=$GET(RCLINES)+1
End DoDot:1
+30 QUIT ALLOK
+31 ;
AUDITLOG(DA,RCNEWST,RCREASON) ;
+1 ; Update the Auto-post Audit Log
+2 ;
+3 IF '$GET(DA)
QUIT
+4 IF $GET(RCREASON)=""
QUIT
+5 ;
+6 NEW RCAUDIT,RCOLDST,DIE,DR,X,Y,DTOUT,DUOUT,DROUT,DIRUT
+7 ; Get the current status
+8 SET RCOLDST=$$GET1^DIQ(344.4,DA_",",4.02,"I")
+9 ; If the new status is null, set to old status (no change)
+10 IF $GET(RCNEWST)=""
SET RCNEWST=RCOLDST
+11 ; File
+12 ;Date/Time Stamp
SET RCAUDIT(344.72,"+1,",.01)=$$NOW^XLFDT
+13 ;User PRCA*4.5*321 Use RCDUZ if defined
SET RCAUDIT(344.72,"+1,",.02)=$SELECT($GET(RCDUZ):RCDUZ,1:DUZ)
+14 ;ERA #
SET RCAUDIT(344.72,"+1,",.03)=DA
+15 ;Old Status
SET RCAUDIT(344.72,"+1,",.04)=RCOLDST
+16 ;New status
IF RCNEWST'="@"
SET RCAUDIT(344.72,"+1,",.05)=RCNEWST
+17 ;Reason text
SET RCAUDIT(344.72,"+1,",.06)=$EXTRACT(RCREASON,1,80)
+18 DO UPDATE^DIE(,"RCAUDIT")
+19 QUIT
+20 ;
BUILD(RCSCR,ARRAY) ; EP from EN2^RCDPEAD - Build list of ERA lines
+1 ;
+2 ; RCSCR = ien of file 344.49
+3 ; ARRAY = the array that will hold the list of ERA lines, passed by reference
+4 ;
+5 NEW ERALINE,FOUND,SCRLINE,SUB,SUB1
+6 KILL ARRAY
+7 SET SUB=0
SET ARRAY=0
+8 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
if SUB'["."
Begin DoDot:1
+9 ;Get actual scratchpad ^RCY(344.49,RCSCR,1) node
+10 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
if 'SUB1
QUIT
+11 ;;Ignore zero lines - removed PRCA*4.5*326
+12 ;Q:'$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,3)
+13 ; Get ERA line
+14 ; PRCA*4.5*326
SET ERALINE=$$GET1^DIQ(344.491,SUB1_","_RCSCR,.09)
+15 ; Ignore reversals
+16 ; PRCA*4.5*326
if ERALINE[","
QUIT
+17 ;Index scratchpad line by ERA sequence
+18 ; PRCA*4.5*326
SET ARRAY(ERALINE)=SUB1
SET ARRAY=$GET(ARRAY)+1
End DoDot:1
+19 QUIT
+20 ;
CHECKPAY(ARRAY,CLAIM) ;Check balance versus payments
+1 ; ARRAY = array of claim numbers and respective payment amounts
+2 ; e.g. ARRAY(430 ien) = 123.04
+3 ; CLAIM = AR BILL (344.491, .07) - IEN of file 430
+4 if 'CLAIM
QUIT 0
+5 ;
+6 ; BEGIN PRCA*4.5*326
+7 NEW RCADMIN,RCBAL,RCCOURT,RCINT,RCMAR,RCPRIN
+8 ; Principle Balance
SET RCPRIN=$$GET1^DIQ(430,CLAIM_",",71)
+9 ; Interest
SET RCINT=$$GET1^DIQ(430,CLAIM_",",72)
+10 ; Admin Cost
SET RCADMIN=$$GET1^DIQ(430,CLAIM_",",73)
+11 ; Marshal Fee
SET RCMAR=$$GET1^DIQ(430,CLAIM_",",74)
+12 ; Court Cost
SET RCCOURT=$$GET1^DIQ(430,CLAIM_",",75)
+13 ; Total balance
SET RCBAL=RCPRIN+RCINT+RCADMIN+RCMAR+RCCOURT
+14 ; get the payment amount to be posted to the claim
+15 SET AMT=ARRAY(CLAIM)
+16 ;Payment exceeds principle balance
+17 if AMT>RCBAL
QUIT 0
+18 ; END PRCA*4.5*326
+19 ;Check pending payments for claim
+20 NEW PENDING
SET PENDING=$$PENDPAY^RCDPURET(CLAIM)
KILL ^TMP($JOB,"RCDPUREC","PP")
+21 ;Pending payments is > billed
+22 IF PENDING>AMT
QUIT 0
+23 ;otherwise OK to post payment
+24 QUIT 1
+25 ;
CLEAR(DA) ;Clear scratchpad
+1 NEW DIK
SET DIK="^RCY(344.49,"
DO ^DIK
+2 QUIT
+3 ;
COMPLETE(RCSCR) ;Check for non-zero lines without a receipt
+1 ;
+2 ; RCSCR = ien of file 344.49
+3 ; Returns status of check (1 or 0)
+4 NEW RCSUB,SCRSUB,COMPLETE,SCRLINE,RCERA
+5 ;Default to complete
+6 SET SCRSUB=0
SET COMPLETE=1
SET RCERA=RCSCR
+7 ;Scan scratchpad
+8 FOR
SET SCRSUB=$ORDER(^RCY(344.49,RCSCR,1,SCRSUB))
if 'SCRSUB
QUIT
Begin DoDot:1
+9 ;Ignore zero and split lines (splitting line should not change balance)
+10 SET SCRLINE=$GET(^RCY(344.49,RCSCR,1,SCRSUB,0))
if $PIECE(SCRLINE,U)'?1N.N
QUIT
if $PIECE(SCRLINE,U,3)=0
QUIT
if $PIECE(SCRLINE,U,3)="0.00"
QUIT
+11 ;Check if non-zero line has receipt on ERA, DETAIL line
+12 SET RCSUB=$PIECE(SCRLINE,U,9)
IF RCSUB
IF $PIECE($GET(^RCY(344.4,RCERA,1,RCSUB,4)),U,3)]""
QUIT
+13 ;Otherwise more AUTO-posting to do
+14 SET COMPLETE=0
End DoDot:1
if 'COMPLETE
QUIT
+15 QUIT COMPLETE
+16 ;
ERAREF(RCSCR,RCRCPTDA) ; update ERA reference and EFT record IEN in file 344
+1 ; RCSCR - IEN of record in file 344.49
+2 ; RCRCPTDA - ien of record in file 344 (receipt ien)
+3 NEW Z,DR,DIE,DA
+4 SET Z=+$ORDER(^RCY(344.31,"AERA",RCSCR,0))
+5 SET DIE="^RCY(344,"
SET DA=RCRCPTDA
SET DR=".18////"_RCSCR_$SELECT(Z:";.17////"_Z,1:"")
DO ^DIE
+6 QUIT
+7 ;
NOTOK(RCSCR) ;Verify all scratchpad lines passed auto verify (V)
+1 ;
+2 ; RCSCR = ien of file 344.49
+3 ; Returns status of check (1 or 0)
+4 NEW NOTOK,SUB
+5 SET SUB=0
SET NOTOK=0
+6 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,SUB))
if 'SUB
QUIT
Begin DoDot:1
+7 ;Set NOTOK if any single line is unverified
+8 if $PIECE($GET(^RCY(344.49,RCSCR,1,SUB,0)),U,13)'=1
SET NOTOK=1
End DoDot:1
if NOTOK
QUIT
+9 QUIT NOTOK
+10 ;
POSTALL(RCERA) ; all lines in ERA get posted on first attempt of auto-post
+1 ;
+2 ; RCERA = ien of 344.4
+3 ;
+4 ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
+5 ; PRCA*4.5*326 begin modified code block
+6 NEW RCDUZ
+7 SET RCDUZ=$$GET1^DIQ(344.4,RCERA_",",4.04,"I")
+8 ; Creates basic receipt for ERA of payment type EDI LOCKBOX; 2nd parameter means no alpha suffix on receipt number
SET RCRCPTDA=$$BLDRCPT^RCDPUREC(DT,"",+$ORDER(^RC(341.1,"AC",14,0)),RCDUZ)
+9 ; Adds detail to a receipt based on file 344.49
DO RCPTDET^RCDPEM(RCSCR,RCRCPTDA,.RCERR,RCDUZ)
+10 ; PRCA*4.5*326 end modified code block
+11 ;
+12 ;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
+13 IF $ORDER(RCERR(""))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt")
QUIT
+14 ;
+15 ;Lock ERA receipt and deposit ticket
+16 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+17 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+18 ;
+19 ;Process Receipt to FMS
+20 DO PROCESS^RCDPURE1(RCRCPTDA,2)
+21 IF $DATA(^TMP("RCDPE-RECEIPT-ERROR",$JOB))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Error in receipt processing")
DO UNLOCKR
QUIT
+22 ;
+23 ; update 344, .18 ERA REFERENCE field
+24 DO ERAREF(RCSCR,RCRCPTDA)
+25 ;
+26 ;Unlock deposit ticket and receipt
+27 DO UNLOCKR
+28 ;
+29 ;Update the audit log
+30 DO AUDITLOG(RCERA,2,"Auto Posting: ERA posted successfully")
+31 ;Update ERA receipt and detail post status
+32 SET DIE="^RCY(344.4,"
SET DR=".14////1;.08////"_RCRCPTDA
SET DA=RCERA
DO ^DIE
+33 ;Set ERA auto-post status to 'complete' and update latest auto-post date
+34 SET DIE="^RCY(344.4,"
+35 SET DR="4.01////"_DT_";4.02////2"
+36 SET DA=RCERA
+37 DO ^DIE
+38 ;Update auto-post date for each claim line
+39 NEW RCLINE,RCSCSUB,RCSCD0
+40 SET RCSCSUB=0
+41 FOR
SET RCSCSUB=$ORDER(^RCY(344.49,RCERA,1,RCSCSUB))
if 'RCSCSUB
QUIT
Begin DoDot:1
+42 SET RCSCD0=$GET(^RCY(344.49,RCERA,1,RCSCSUB,0))
+43 ;Ignore if zero value (line not on receipt) otherwise get original ERA line sequence
+44 if '+$PIECE(RCSCD0,U,3)
QUIT
SET RCLINE=$PIECE(RCSCD0,U,9)
if 'RCLINE
QUIT
+45 ;Update ERA line with receipt number and auto-post date
+46 NEW DA,DIE,DR
SET DA(1)=RCERA
SET DA=RCLINE
SET DIE="^RCY(344.4,"_DA(1)_",1,"
SET DR=".25////"_RCRCPTDA_";9////"_DT
DO ^DIE
End DoDot:1
+47 QUIT
+48 ;
POSTERA(RCERA,RCLINES) ; only some of the EEOB lines passed validation on first attempt (DAY 1) of auto-post
+1 ; therefore assign the receipt number and 'partial' post status to ERA summary
+2 ;
+3 ; RCERA = ien of 344.4
+4 ; RCLINES = array of ERA line references
+5 ;
+6 ; no lines passed validation; at lease 1 EEOB line needs to pass validation before assigning a receipt to the ERA
+7 IF RCLINES=0
SET RCRCPTDA=""
GOTO POSTERAQ
+8 ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
+9 ; Creates basic receipt for ERA of payment type EDI LOCKBOXA
SET RCRCPTDA=$$BLDRCPT^RCDPEMA(RCERA)
+10 ; Adds detail to a receipt based on file 344.49 and RCLINES array
DO RCPTDET^RCDPEMA(RCSCR,RCRCPTDA,.RCLINES,.RCERR)
+11 ;
+12 ;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
+13 IF $ORDER(RCERR(""))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt")
QUIT
+14 ;
+15 ;Lock ERA receipt and deposit ticket
+16 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+17 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+18 ;
+19 ;Process Receipt to FMS
+20 DO PROCESS^RCDPURE1(RCRCPTDA,2)
+21 IF $DATA(^TMP("RCDPE-RECEIPT-ERROR",$JOB))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Error in receipt processing")
DO UNLOCKR
QUIT
+22 ;
+23 ; update 344, .18 ERA REFERENCE field
+24 DO ERAREF(RCSCR,RCRCPTDA)
+25 ;
+26 ;Unlock deposit ticket and receipt
+27 DO UNLOCKR
+28 ;Update ERA receipt and detail post status
+29 SET DIE="^RCY(344.4,"
SET DR=".14////5;.08////"_RCRCPTDA
SET DA=RCERA
DO ^DIE
POSTERAQ ;
+1 DO POSTLNS(RCERA,RCRCPTDA,.RCLINES)
+2 QUIT
+3 ;
POSTLNS(RCERA,RCRCPTDA,RCLINES) ; this subroutine should only be called when some of the EEOB lines
+1 ; passed validation on FIRST attempt (DAY 1) of auto-post
+2 ;
+3 ; RCERA = ien of ERA entry in 344.4
+4 ; RCRCPTDA = ien of receipt entry in 344 or undefined if receipt not created since none of the lines passed validation
+5 ; RCLINES = array of ERA line references
+6 ;
+7 ;Mark ERA as processed to prevent reprocessing in EN2^RCDPEAP which runs next
+8 SET ^TMP("RCDPEAP",$JOB,RCERA)=""
+9 SET RCRCPTDA=$GET(RCRCPTDA)
+10 ;Update individual claim lines on ERA
+11 NEW RCLIN,DA,DIE,DR,LNUM,RCI,REJECT
+12 SET RCLIN=0
FOR
SET RCLIN=$ORDER(RCLINES(RCLIN))
if 'RCLIN
QUIT
Begin DoDot:1
+13 ; flag the line if it was rejected during validation
+14 SET REJECT=0
IF '$PIECE(RCLINES(RCLIN),U)
SET REJECT=1
+15 ;get all ERA line references (e.g. RCLINES(RCLIN) could have multiple line # references)
+16 ;Need to parse out each line reference so that the necessary fields can be updated for the specific line
+17 FOR RCI=1:1
SET LNUM=$PIECE(RCLIN,",",RCI)
if LNUM=""
QUIT
Begin DoDot:2
+18 SET DA(1)=RCERA
SET DA=LNUM
SET DIE="^RCY(344.4,"_DA(1)_",1,"
+19 ;If not posted then the AUTO-POST REJECTION REASON (344.41,5) needs to be updated ;otherwise update line with receipt number and auto-post date
+20 IF REJECT
SET DR="5////"_$PIECE(RCLINES(RCLIN),U,3)
+21 IF '$TEST
SET DR=".25////"_RCRCPTDA_";9////"_DT
+22 DO ^DIE
End DoDot:2
End DoDot:1
+23 ;Update the Audit Log
+24 DO AUDITLOG(RCERA,1,"Auto Posting: Some of the ERA lines went to APAR")
+25 ;Set ERA AUTO-POST STATUS = PARTIAL and update auto-post date
+26 SET DIE="^RCY(344.4,"
SET DR="4.01////"_DT_";4.02////1"
SET DA=RCERA
DO ^DIE
+27 QUIT
+28 ;
SCRPAD(RCERA) ;Build Scratchpad entry in #344.49 for the ERA
+1 ;
+2 ; Input - RCERA - IEN for #344.4
+3 ;
+4 ; Output - RCSCR = Scratchpad IEN (Success) or 0 (Fail)
+5 ;
+6 NEW RC0,RC5,RCSCR,RCDAT,X
+7 SET RC0=$GET(^RCY(344.4,RCERA,0))
SET RC5=$GET(^RCY(344.4,RCERA,5))
+8 ;Ignore is this ERA already has a receipt
+9 IF +$PIECE(RC0,U,8)
QUIT 0
+10 ;Ignore if this is zero ERA
+11 IF +$PIECE(RC0,U,5)=0
QUIT 0
+12 ; BEGIN PRCA*4.5*326
+13 ;Ignore if this is not a valid auto-post ERA type
+14 ;I "^ACH^CHK^"'[(U_$P(RC0,U,15)_U) Q 0 ; added CHK - PRCA*4.5*321
+15 IF "^ACH^CHK^NON^BOP^"'[(U_$PIECE(RC0,U,15)_U)
QUIT 0
+16 ;ERA must be matched to an EFT to be eligible for mark for autopost
+17 IF '$ORDER(^RCY(344.31,"AERA",RCERA,""))
QUIT 0
+18 ; END PRCA*4.5*326
+19 ;Scratchpad already exists
+20 SET RCSCR=+$ORDER(^RCY(344.49,"B",RCERA,0))
IF RCSCR
GOTO SCRPADX
+21 ;Create new Scratchpad
+22 SET RCSCR=+$$ADDREC^RCDPEWL(RCERA,.RCDAT)
IF 'RCSCR
QUIT 0
+23 ;Add all the ERA lines to the Scratchpad entry
+24 DO ADDLINES^RCDPEWLA(RCSCR)
SCRPADX ;Return Scratchpad IEN
+1 QUIT RCSCR
+2 ;
SETSTA(DA,STATUS,RCREASON) ;Set ERA auto-post status
+1 ; Log status change
+2 IF '$GET(DA)
QUIT
+3 IF $GET(STATUS)=""
QUIT
+4 ;
+5 DO AUDITLOG(DA,STATUS,$GET(RCREASON))
+6 ; Update status
+7 NEW DIE,DR
+8 SET DIE="^RCY(344.4,"
+9 SET DR="4.02////"_STATUS
+10 SET DR=DR_";4.04///"_$SELECT(STATUS=0&(DUZ'=.5):"`"_DUZ,1:"@")
+11 DO ^DIE
+12 QUIT
+13 ;
+14 ;
UNLOCKR ;Unlock ERA receipt and deposit ticket
+1 LOCK -^RCY(344,RCRCPTDA)
+2 LOCK -^RCY(344.1,RCDEPTDA)
+3 QUIT
+4 ;
UNLOCKE ;Unlock ERA
+1 LOCK -^RCY(344.4,RCERA)
+2 QUIT
