RCDPEAP ;ALB/PJH - AUTO POST MATCHING EFT ERA PAIR ;Oct 15, 2014@12:36:51
;;4.5;Accounts Receivable;**298,304,318,321,326,424**;Mar 20, 1995;Build 11
;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,RCZERO ; PRCA*4.5*424 Add RCZERO
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
.S RCZERO=$$ISZERO^RCDPEAP1(RCRZ) ; PRCA*4.5*424 Check for Zero balance ERA
.;Get EFT reference
.;PRCA*4.5*424 next, line don't require matched EFT for zero balance ERAs
.S RCEFTDA=$O(^RCY(344.31,"AERA",RCRZ,"")) I 'RCZERO 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
.;PRCA*4.5*424 next, line don't check matched EFT for zero balance ERAs
.I 'RCZERO,$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" Q:$E(Z)="O" ; EFT Accepted by FMS or ON-LINE ENTRY - PRCA*4.5*326
..S RCOK=0
.;
.;Auto-Post
.D AUTOPOST(RCEFTDA,RCRZ,RCZERO) ; PRCA*4.5*424 add parameter
Q
;
; Process ERA
AUTOPOST(RCEFTDA,RCERA,RCZERO) ; PRCA*4.5*424 add parameter
; RCEFTDA = ien of file #344.31
; RCERA = ien of file #344.4
; RCZERO = 1 if this ERA is zero balance, otherwise 0 ; PRCA*4.5*424
;
;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,RCZERO) ;**PRCA*4.5*424 Added ,RCZERO
; Re-set AUTO-POST STATUS if unable to create scratchpad
I 'RCSCR,'RCZERO D Q ;PRCA*4.5*424 Added 'RCZERO
. D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create scratchpad")
. D 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 Q
. D SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-ERA level Adjustment(s)")
. D 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
. D AUTOQ
;
; Check if all lines can be posted
S ALLOK=$$ALLOK(RCERA,RCSCR,.ZEROBAL,.RCLINES)
;
; ; PRCA*4.5*424 Added line - post zero balance ERA
I RCZERO D Q ;
. I ZEROBAL D ;
. . D POST0^RCDPEAP2(RCERA)
. I 'ZEROBAL D ;
. . D SETSTA(RCERA,"@","Auto Posting: Removed zero pay ERA has +/- Payments")
. D AUTOQ
;
;If $$ALLOK post entire ERA and reset AUTO-POST STATUS = COMPLETE
I ALLOK D POSTALL(RCERA)
;
;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
. . 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
;
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"
. S ZEROBAL=0 ; PRCA*4.5*424 at least one line has non-zero balance
. ;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,RCZERO) ;Build Scratchpad entry in #344.49 for the ERA
; Input - RCERA - IEN for #344.4
; RCZERO - Optional, if passed, 1 if zero balance ERA. 0 otherwise
; 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 '$G(RCZERO),+$P(RC0,U,5)=0 Q 0 ;PRCA*4.5*424 Added '$G(RCZERO),
; 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 '$G(RCZERO),'$O(^RCY(344.31,"AERA",RCERA,"")) Q 0 ;PRCA*4.5*424 Added '$G(RCZERO),
; 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 19780 printed Oct 16, 2024@17:45:07 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,424**;Mar 20, 1995;Build 11
+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 ; PRCA*4.5*424 Add RCZERO
NEW RCRZ,RCEFTDA,RCZERO
+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 ; PRCA*4.5*424 Check for Zero balance ERA
SET RCZERO=$$ISZERO^RCDPEAP1(RCRZ)
+6 ;Get EFT reference
+7 ;PRCA*4.5*424 next, line don't require matched EFT for zero balance ERAs
+8 SET RCEFTDA=$ORDER(^RCY(344.31,"AERA",RCRZ,""))
IF 'RCZERO
if 'RCEFTDA
QUIT
+9 ;Check that EFT funds were posted to FMS and Accepted by FMS. If not, quit and go to next unposted ERA
+10 NEW RCOK,RCDEPTDA,RCRECTDA
+11 SET RCOK=1
+12 ;PRCA*4.5*424 next, line don't check matched EFT for zero balance ERAs
+13 IF 'RCZERO
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
+14 ; 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))
+15 ; EFT Accepted by FMS or ON-LINE ENTRY - PRCA*4.5*326
IF RCRECTDA
NEW Z
SET Z=$PIECE($$FMSSTAT^RCDPUREC(RCRECTDA),U,2)
if $EXTRACT(Z)="A"
QUIT
if $EXTRACT(Z)="O"
QUIT
+16 SET RCOK=0
End DoDot:2
if 'RCOK
QUIT
+17 ;
+18 ;Auto-Post
+19 ; PRCA*4.5*424 add parameter
DO AUTOPOST(RCEFTDA,RCRZ,RCZERO)
End DoDot:1
+20 QUIT
+21 ;
+22 ; Process ERA
AUTOPOST(RCEFTDA,RCERA,RCZERO) ; PRCA*4.5*424 add parameter
+1 ; RCEFTDA = ien of file #344.31
+2 ; RCERA = ien of file #344.4
+3 ; RCZERO = 1 if this ERA is zero balance, otherwise 0 ; PRCA*4.5*424
+4 ;
+5 ;Lock ERA
+6 LOCK +^RCY(344.4,RCERA):5
if '$TEST
QUIT
+7 ;
+8 ;Build Scratchpad and Verify Lines
+9 ; PRCA*4.5*318 Variables placed in alpha order
NEW ALLOK,RCERR,RCLINES,RCRCPTDA,RCSCR,RCTRDA,ZEROBAL
+10 KILL ^TMP($JOB,"RCDPEWLA")
+11 ;**PRCA*4.5*424 Added ,RCZERO
SET RCSCR=$$SCRPAD(RCERA,RCZERO)
+12 ; Re-set AUTO-POST STATUS if unable to create scratchpad
+13 ;PRCA*4.5*424 Added 'RCZERO
IF 'RCSCR
IF 'RCZERO
Begin DoDot:1
+14 DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create scratchpad")
+15 DO AUTOQ
End DoDot:1
QUIT
+16 ;
+17 ; ERA cannot be autoposted
+18 ; remove any pre-existing value to the AUTO-POST STATUS so ERA can be processed manually in the Worklist
+19 IF $DATA(^TMP($JOB,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS"))
Begin DoDot:1
+20 DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-ERA level Adjustment(s)")
+21 DO AUTOQ
End DoDot:1
QUIT
+22 ;
+23 ; PRCA*4.5*318 Added line
IF $$UNBAL^RCDPEAP1(RCERA)
Begin DoDot:1
+24 ; PRCA*4.5*321
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unbalanced ERA")
+25 DO AUTOQ
End DoDot:1
QUIT
+26 ;
+27 ; Check if all lines can be posted
+28 SET ALLOK=$$ALLOK(RCERA,RCSCR,.ZEROBAL,.RCLINES)
+29 ;
+30 ; ; PRCA*4.5*424 Added line - post zero balance ERA
+31 ;
IF RCZERO
Begin DoDot:1
+32 ;
IF ZEROBAL
Begin DoDot:2
+33 DO POST0^RCDPEAP2(RCERA)
End DoDot:2
+34 ;
IF 'ZEROBAL
Begin DoDot:2
+35 DO SETSTA(RCERA,"@","Auto Posting: Removed zero pay ERA has +/- Payments")
End DoDot:2
+36 DO AUTOQ
End DoDot:1
QUIT
+37 ;
+38 ;If $$ALLOK post entire ERA and reset AUTO-POST STATUS = COMPLETE
+39 IF ALLOK
DO POSTALL(RCERA)
+40 ;
+41 ;If 'ALLOK and some of the lines passed validation then post receipt to summary ERA and set AUTO-POST STATUS = PARTIAL
+42 ;Un-posted lines fall to APAR list for processing.
+43 IF 'ALLOK
DO POSTERA(RCERA,.RCLINES)
+44 ;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 ; PRCA*4.5*318 - Do not attempt to process partially filed receipt
IF $ORDER(RCERR(""))
QUIT
+28 ;Lock ERA receipt and deposit ticket
+29 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+30 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+31 ;Process Receipt to FMS
+32 DO PROCESS^RCDPURE1(RCRCPTDA,2)
IF $DATA(^TMP("RCDPE-RECEIPT-ERROR",$JOB))
DO UNLOCKR
QUIT
+33 ; update 344, .18 ERA REFERENCE field
+34 DO ERAREF(RCERA,RCRCPTDA)
+35 ;Unlock deposit ticket and receipt
+36 DO UNLOCKR
End DoDot:2
+37 ;Update ERA and ERA detail lines with receipt # or auto-post rejection reason
+38 DO ERADET^RCDPEAP1(RCERA,RCRCPTDA,.RCLINES)
+39 ;Determine if posting complete for this ERA
+40 SET COMPLETE=$$COMPLETE(RCERA)
+41 ;If complete update ERA detail post status to POSTED
+42 IF COMPLETE
SET DIE="^RCY(344.4,"
SET DR=".14////1"
SET DA=RCERA
DO ^DIE
+43 ;Update the audit log
+44 DO AUDITLOG(RCERA,$SELECT(COMPLETE:2,1:1),"Auto Posting: Previously processed ERA posting attempt")
+45 ;Set ERA auto-post status and update latest auto-post date
+46 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
+47 ;Unlock ERA
+48 DO UNLOCKE
+49 QUIT
+50 ;
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
+4 ; matched positive/negative pairs, passed by reference
+5 ; RCLINES - array of ERA line references (passed in by reference)
+6 ; NOTE: ORIGINAL ERA SEQUENCES (344.491, .09) can have multiple ERA line
+7 ; references separated by commas (e.g., 3,4)
+8 ; returns 0 or 1 (ALLOK)
+9 NEW ALLOK,AMT,ERALINE,STATUS,SUB,SUB1,CLAIM,WLINE,VERIFY
+10 KILL CLARRAY
+11 SET (ZEROBAL,ALLOK)=1
+12 SET (SUB,RCLINES)=0
+13 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
Begin DoDot:1
+14 ;Get scratchpad line and data
+15 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)
+16 ;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
+17 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
+18 ; ignore zero valued lines
+19 if AMT=0
QUIT
if AMT="0.00"
QUIT
+20 ; PRCA*4.5*424 at least one line has non-zero balance
SET ZEROBAL=0
+21 ;Get claim number from N.001 line - if not found treat as inactive
+22 SET CLAIM=$PIECE(WLINE,U,7)
IF 'CLAIM
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=2
QUIT
+23 ;Save claim number
+24 SET $PIECE(RCLINES(ERALINE),U,2)=$PIECE($GET(^PRCA(430,CLAIM,0)),U)
if 'VERIFY
QUIT
+25 ;Claim must be OPEN or ACTIVE
+26 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
+27 ;Check that payment does not exceed balance and no pending payments (at the time of auto posting)
+28 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
+29 ;Check if referred to general council
+30 IF $PIECE($GET(^PRCA(430,CLAIM,6)),U,4)]""
SET ALLOK=0
SET $PIECE(RCLINES(ERALINE),U,3)=4
QUIT
+31 ;Line is potentially postable
+32 SET $PIECE(RCLINES(ERALINE),U)=1
SET $PIECE(RCLINES(ERALINE),U,3)=$PIECE(WLINE,U,6)
SET RCLINES=$GET(RCLINES)+1
End DoDot:1
+33 QUIT ALLOK
+34 ;
AUDITLOG(DA,RCNEWST,RCREASON) ;
+1 ; Update the Auto-post Audit Log
+2 IF '$GET(DA)
QUIT
+3 IF $GET(RCREASON)=""
QUIT
+4 ;
+5 NEW RCAUDIT,RCOLDST,DIE,DR,X,Y,DTOUT,DUOUT,DROUT,DIRUT
+6 ; Get the current status
+7 SET RCOLDST=$$GET1^DIQ(344.4,DA_",",4.02,"I")
+8 ; If the new status is null, set to old status (no change)
+9 IF $GET(RCNEWST)=""
SET RCNEWST=RCOLDST
+10 ; File
+11 ;Date/Time Stamp
SET RCAUDIT(344.72,"+1,",.01)=$$NOW^XLFDT
+12 ;User PRCA*4.5*321 Use RCDUZ if defined
SET RCAUDIT(344.72,"+1,",.02)=$SELECT($GET(RCDUZ):RCDUZ,1:DUZ)
+13 ;ERA #
SET RCAUDIT(344.72,"+1,",.03)=DA
+14 ;Old Status
SET RCAUDIT(344.72,"+1,",.04)=RCOLDST
+15 ;New status
IF RCNEWST'="@"
SET RCAUDIT(344.72,"+1,",.05)=RCNEWST
+16 ;Reason text
SET RCAUDIT(344.72,"+1,",.06)=$EXTRACT(RCREASON,1,80)
+17 DO UPDATE^DIE(,"RCAUDIT")
+18 QUIT
+19 ;
BUILD(RCSCR,ARRAY) ; EP from EN2^RCDPEAD - Build list of ERA lines
+1 ; RCSCR = ien of file 344.49
+2 ; ARRAY = the array that will hold the list of ERA lines, passed by reference
+3 NEW ERALINE,FOUND,SCRLINE,SUB,SUB1
+4 KILL ARRAY
+5 SET SUB=0
SET ARRAY=0
+6 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB))
if SUB=""
QUIT
if SUB'["."
Begin DoDot:1
+7 ;Get actual scratchpad ^RCY(344.49,RCSCR,1) node
+8 SET SUB1=$ORDER(^RCY(344.49,RCSCR,1,"B",SUB,""))
if 'SUB1
QUIT
+9 ;;Ignore zero lines - removed PRCA*4.5*326
+10 ;Q:'$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,3)
+11 ; Get ERA line
+12 ; PRCA*4.5*326
SET ERALINE=$$GET1^DIQ(344.491,SUB1_","_RCSCR,.09)
+13 ; Ignore reversals
+14 ; PRCA*4.5*326
if ERALINE[","
QUIT
+15 ;Index scratchpad line by ERA sequence
+16 ; PRCA*4.5*326
SET ARRAY(ERALINE)=SUB1
SET ARRAY=$GET(ARRAY)+1
End DoDot:1
+17 QUIT
+18 ;
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 ; BEGIN PRCA*4.5*326
+6 NEW RCADMIN,RCBAL,RCCOURT,RCINT,RCMAR,RCPRIN
+7 ; Principle Balance
SET RCPRIN=$$GET1^DIQ(430,CLAIM_",",71)
+8 ; Interest
SET RCINT=$$GET1^DIQ(430,CLAIM_",",72)
+9 ; Admin Cost
SET RCADMIN=$$GET1^DIQ(430,CLAIM_",",73)
+10 ; Marshal Fee
SET RCMAR=$$GET1^DIQ(430,CLAIM_",",74)
+11 ; Court Cost
SET RCCOURT=$$GET1^DIQ(430,CLAIM_",",75)
+12 ; Total balance
SET RCBAL=RCPRIN+RCINT+RCADMIN+RCMAR+RCCOURT
+13 ; get the payment amount to be posted to the claim
+14 SET AMT=ARRAY(CLAIM)
+15 ;Payment exceeds principle balance
+16 if AMT>RCBAL
QUIT 0
+17 ; END PRCA*4.5*326
+18 ;Check pending payments for claim
+19 NEW PENDING
SET PENDING=$$PENDPAY^RCDPURET(CLAIM)
KILL ^TMP($JOB,"RCDPUREC","PP")
+20 ;Pending payments is > billed
+21 IF PENDING>AMT
QUIT 0
+22 ;otherwise OK to post payment
+23 QUIT 1
+24 ;
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 ; RCSCR = ien of file 344.49
+2 ; Returns status of check (1 or 0)
+3 NEW RCSUB,SCRSUB,COMPLETE,SCRLINE,RCERA
+4 ;Default to complete
+5 SET SCRSUB=0
SET COMPLETE=1
SET RCERA=RCSCR
+6 ;Scan scratchpad
+7 FOR
SET SCRSUB=$ORDER(^RCY(344.49,RCSCR,1,SCRSUB))
if 'SCRSUB
QUIT
Begin DoDot:1
+8 ;Ignore zero and split lines (splitting line should not change balance)
+9 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
+10 ;Check if non-zero line has receipt on ERA, DETAIL line
+11 SET RCSUB=$PIECE(SCRLINE,U,9)
IF RCSUB
IF $PIECE($GET(^RCY(344.4,RCERA,1,RCSUB,4)),U,3)]""
QUIT
+12 ;Otherwise more AUTO-posting to do
+13 SET COMPLETE=0
End DoDot:1
if 'COMPLETE
QUIT
+14 QUIT COMPLETE
+15 ;
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 ; RCSCR = ien of file 344.49
+2 ; Returns status of check (1 or 0)
+3 NEW NOTOK,SUB
+4 SET SUB=0
SET NOTOK=0
+5 FOR
SET SUB=$ORDER(^RCY(344.49,RCSCR,1,SUB))
if 'SUB
QUIT
Begin DoDot:1
+6 ;Set NOTOK if any single line is unverified
+7 if $PIECE($GET(^RCY(344.49,RCSCR,1,SUB,0)),U,13)'=1
SET NOTOK=1
End DoDot:1
if NOTOK
QUIT
+8 QUIT NOTOK
+9 ;
POSTALL(RCERA) ; all lines in ERA get posted on first attempt of auto-post
+1 ; RCERA = ien of 344.4
+2 ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
+3 ; PRCA*4.5*326 begin modified code block
+4 NEW RCDUZ
+5 SET RCDUZ=$$GET1^DIQ(344.4,RCERA_",",4.04,"I")
+6 ; 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)
+7 ; Adds detail to a receipt based on file 344.49
DO RCPTDET^RCDPEM(RCSCR,RCRCPTDA,.RCERR,RCDUZ)
+8 ; PRCA*4.5*326 end modified code block
+9 ;
+10 ;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
+11 IF $ORDER(RCERR(""))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt")
QUIT
+12 ;
+13 ;Lock ERA receipt and deposit ticket
+14 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+15 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+16 ;
+17 ;Process Receipt to FMS
+18 DO PROCESS^RCDPURE1(RCRCPTDA,2)
+19 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
+20 ;
+21 ; update 344, .18 ERA REFERENCE field
+22 DO ERAREF(RCSCR,RCRCPTDA)
+23 ;
+24 ;Unlock deposit ticket and receipt
+25 DO UNLOCKR
+26 ;
+27 ;Update the audit log
+28 DO AUDITLOG(RCERA,2,"Auto Posting: ERA posted successfully")
+29 ;Update ERA receipt and detail post status
+30 SET DIE="^RCY(344.4,"
SET DR=".14////1;.08////"_RCRCPTDA
SET DA=RCERA
DO ^DIE
+31 ;Set ERA auto-post status to 'complete' and update latest auto-post date
+32 SET DIE="^RCY(344.4,"
+33 SET DR="4.01////"_DT_";4.02////2"
+34 SET DA=RCERA
+35 DO ^DIE
+36 ;Update auto-post date for each claim line
+37 NEW RCLINE,RCSCSUB,RCSCD0
+38 SET RCSCSUB=0
+39 FOR
SET RCSCSUB=$ORDER(^RCY(344.49,RCERA,1,RCSCSUB))
if 'RCSCSUB
QUIT
Begin DoDot:1
+40 SET RCSCD0=$GET(^RCY(344.49,RCERA,1,RCSCSUB,0))
+41 ;Ignore if zero value (line not on receipt) otherwise get original ERA line sequence
+42 if '+$PIECE(RCSCD0,U,3)
QUIT
SET RCLINE=$PIECE(RCSCD0,U,9)
if 'RCLINE
QUIT
+43 ;Update ERA line with receipt number and auto-post date
+44 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
+45 QUIT
+46 ;
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 ; RCERA = ien of 344.4
+3 ; RCLINES = array of ERA line references
+4 ; no lines passed validation; at lease 1 EEOB line needs to pass validation before assigning a receipt to the ERA
+5 IF RCLINES=0
SET RCRCPTDA=""
GOTO POSTERAQ
+6 ;ERA Receipt is created from scratchpad entry - type 14 is EDI Lockbox payment
+7 ; Creates basic receipt for ERA of payment type EDI LOCKBOXA
SET RCRCPTDA=$$BLDRCPT^RCDPEMA(RCERA)
+8 ; Adds detail to a receipt based on file 344.49 and RCLINES array
DO RCPTDET^RCDPEMA(RCSCR,RCRCPTDA,.RCLINES,.RCERR)
+9 ;
+10 ;Unable to create receipt - clear scratchpad, reset AUTO-POST STATUS = NULL
+11 IF $ORDER(RCERR(""))
DO CLEAR(RCSCR)
DO SETSTA(RCERA,"@","Auto Posting: Removed from Auto Posting-Unable to create receipt")
QUIT
+12 ;
+13 ;Lock ERA receipt and deposit ticket
+14 IF '$$LOCKREC^RCDPRPLU(RCRCPTDA)
QUIT
+15 IF '$$LOCKDEP^RCDPDPLU(RCDEPTDA)
DO UNLOCKR
QUIT
+16 ;
+17 ;Process Receipt to FMS
+18 DO PROCESS^RCDPURE1(RCRCPTDA,2)
+19 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
+20 ;
+21 ; update 344, .18 ERA REFERENCE field
+22 DO ERAREF(RCSCR,RCRCPTDA)
+23 ;
+24 ;Unlock deposit ticket and receipt
+25 DO UNLOCKR
+26 ;Update ERA receipt and detail post status
+27 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 ; RCERA = ien of ERA entry in 344.4
+3 ; RCRCPTDA = ien of receipt entry in 344 or undefined if receipt not created since none of the lines passed validation
+4 ; RCLINES = array of ERA line references
+5 ;Mark ERA as processed to prevent reprocessing in EN2^RCDPEAP which runs next
+6 SET ^TMP("RCDPEAP",$JOB,RCERA)=""
+7 SET RCRCPTDA=$GET(RCRCPTDA)
+8 ;Update individual claim lines on ERA
+9 NEW RCLIN,DA,DIE,DR,LNUM,RCI,REJECT
+10 SET RCLIN=0
FOR
SET RCLIN=$ORDER(RCLINES(RCLIN))
if 'RCLIN
QUIT
Begin DoDot:1
+11 ; flag the line if it was rejected during validation
+12 SET REJECT=0
IF '$PIECE(RCLINES(RCLIN),U)
SET REJECT=1
+13 ;get all ERA line references (e.g. RCLINES(RCLIN) could have multiple line # references)
+14 ;Need to parse out each line reference so that the necessary fields can be updated for the specific line
+15 FOR RCI=1:1
SET LNUM=$PIECE(RCLIN,",",RCI)
if LNUM=""
QUIT
Begin DoDot:2
+16 SET DA(1)=RCERA
SET DA=LNUM
SET DIE="^RCY(344.4,"_DA(1)_",1,"
+17 ;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
+18 IF REJECT
SET DR="5////"_$PIECE(RCLINES(RCLIN),U,3)
+19 IF '$TEST
SET DR=".25////"_RCRCPTDA_";9////"_DT
+20 DO ^DIE
End DoDot:2
End DoDot:1
+21 ;Update the Audit Log
+22 DO AUDITLOG(RCERA,1,"Auto Posting: Some of the ERA lines went to APAR")
+23 ;Set ERA AUTO-POST STATUS = PARTIAL and update auto-post date
+24 SET DIE="^RCY(344.4,"
SET DR="4.01////"_DT_";4.02////1"
SET DA=RCERA
DO ^DIE
+25 QUIT
+26 ;
SCRPAD(RCERA,RCZERO) ;Build Scratchpad entry in #344.49 for the ERA
+1 ; Input - RCERA - IEN for #344.4
+2 ; RCZERO - Optional, if passed, 1 if zero balance ERA. 0 otherwise
+3 ; Output - RCSCR = Scratchpad IEN (Success) or 0 (Fail)
+4 NEW RC0,RC5,RCSCR,RCDAT,X
+5 SET RC0=$GET(^RCY(344.4,RCERA,0))
SET RC5=$GET(^RCY(344.4,RCERA,5))
+6 ;Ignore is this ERA already has a receipt
+7 IF +$PIECE(RC0,U,8)
QUIT 0
+8 ;Ignore if this is zero ERA
+9 ;PRCA*4.5*424 Added '$G(RCZERO),
IF '$GET(RCZERO)
IF +$PIECE(RC0,U,5)=0
QUIT 0
+10 ; BEGIN PRCA*4.5*326
+11 ;Ignore if this is not a valid auto-post ERA type
+12 ;I "^ACH^CHK^"'[(U_$P(RC0,U,15)_U) Q 0 ; added CHK - PRCA*4.5*321
+13 IF "^ACH^CHK^NON^BOP^"'[(U_$PIECE(RC0,U,15)_U)
QUIT 0
+14 ;ERA must be matched to an EFT to be eligible for mark for autopost
+15 ;PRCA*4.5*424 Added '$G(RCZERO),
IF '$GET(RCZERO)
IF '$ORDER(^RCY(344.31,"AERA",RCERA,""))
QUIT 0
+16 ; END PRCA*4.5*326
+17 ;Scratchpad already exists
+18 SET RCSCR=+$ORDER(^RCY(344.49,"B",RCERA,0))
IF RCSCR
GOTO SCRPADX
+19 ;Create new Scratchpad
+20 SET RCSCR=+$$ADDREC^RCDPEWL(RCERA,.RCDAT)
IF 'RCSCR
QUIT 0
+21 ;Add all the ERA lines to the Scratchpad entry
+22 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 DO AUDITLOG(DA,STATUS,$GET(RCREASON))
+5 ; Update status
+6 NEW DIE,DR
+7 SET DIE="^RCY(344.4,"
+8 SET DR="4.02////"_STATUS
+9 SET DR=DR_";4.04///"_$SELECT(STATUS=0&(DUZ'=.5):DUZ,1:"@")
+10 DO ^DIE
+11 QUIT
+12 ;
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
