- 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,432**;Mar 20, 1995;Build 16
- ;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
- .I RCZERO I $$ISTYPE^RCDPEU1(344.4,RCRZ,"C") Q ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
- .;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 19916 printed Jan 18, 2025@02:45:30 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,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 ;
- 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 ; PRCA*4.5*432 Zero balance ERA with CHAMPVA payer is not an auto-post candidate
- IF RCZERO
- IF $$ISTYPE^RCDPEU1(344.4,RCRZ,"C")
- QUIT
- +7 ;Get EFT reference
- +8 ;PRCA*4.5*424 next, line don't require matched EFT for zero balance ERAs
- +9 SET RCEFTDA=$ORDER(^RCY(344.31,"AERA",RCRZ,""))
- IF 'RCZERO
- if 'RCEFTDA
- QUIT
- +10 ;Check that EFT funds were posted to FMS and Accepted by FMS. If not, quit and go to next unposted ERA
- +11 NEW RCOK,RCDEPTDA,RCRECTDA
- +12 SET RCOK=1
- +13 ;PRCA*4.5*424 next, line don't check matched EFT for zero balance ERAs
- +14 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
- +15 ; 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))
- +16 ; 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
- +17 SET RCOK=0
- End DoDot:2
- if 'RCOK
- QUIT
- +18 ;
- +19 ;Auto-Post
- +20 ; PRCA*4.5*424 add parameter
- DO AUTOPOST(RCEFTDA,RCRZ,RCZERO)
- End DoDot:1
- +21 QUIT
- +22 ;
- +23 ; 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