Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPEAD

RCDPEAD.m

Go to the documentation of this file.
  1. RCDPEAD ;ALB/PJH - AUTO DECREASE ;Jun 06, 2014@19:11:19
  1. ;;4.5;Accounts Receivable;**298,304,318,326,332,345,349**;Mar 20, 1995;Build 44
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;Read ^IBM(361.1) via Private IA 4051
  1. ;
  1. EN ;Auto Decrease - applies to auto-posted claims only
  1. ;
  1. ; Begin PRCA*4.5*345
  1. N AD,AP,J,RCDAY
  1. S AP=$$GET1^DIQ(344.61,"1,",.02,"I") ; Medical Claims Auto-Posting on/off
  1. S AD=$$GET1^DIQ(344.61,"1,",.03,"I") ; Medical Claims Auto-Decrease on/off
  1. I AP,AD D ; Attempt to Auto-Decrease Medical Claims w/Payments
  1. . S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.04))
  1. . D EN1A(RCDAY,1,1)
  1. ;
  1. S AD=$$GET1^DIQ(344.61,"1,",.11,"I") ; Medical Claims Auto-Decrease no-pay on/off
  1. I AP,AD D ; Attempt to Auto-Decrease Medical Claims w/No Payments
  1. . S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12))
  1. . D EN1A(RCDAY,2,1)
  1. ;
  1. S AP=$$GET1^DIQ(344.61,"1,",1.01,"I") ; Rx Claims Auto-Posting on/off
  1. S AD=$$GET1^DIQ(344.61,"1,",1.02,"I") ; Rx Claims Auto-Decrease on/off
  1. I AP,AD D ; Attempt to Auto-Decrease Rx Claims w/Payments
  1. . S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.03))
  1. . D EN1A(RCDAY,1,2)
  1. ;
  1. ; PRCA*4.5*349 - Begin added block
  1. S AP=$$GET1^DIQ(344.61,"1,",1.05,"I") ; TRICARE Claims Auto-Posting on/off
  1. S AD=$$GET1^DIQ(344.61,"1,",1.06,"I") ; TRICARE Claims w/payments Auto-Decrease on/off
  1. I AP,AD D ; Attempt to Auto-Decrease TRICARE Claims w/Payments
  1. . S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",1.08))
  1. . D EN1A(RCDAY,1,3)
  1. ;
  1. S AD=$$GET1^DIQ(344.61,"1,",1.09,"I") ; TRICARE Claims Auto-Decrease no-pay on/off
  1. I AP,AD D ; Attempt to Auto-Decrease TRICARE Claims w/No Payments
  1. . D REJ^RCDPEAD4(3)
  1. ; PRCA*4.5*349 - End added block
  1. ;
  1. ; Payer Rejects for Medical Claims
  1. S AP=$$GET1^DIQ(344.61,"1,",.02,"I") ; Medical Claims Auto-Posting on/off
  1. S AD=$$GET1^DIQ(344.61,"1,",.03,"I") ; Medical Claims Auto-Decrease on/off
  1. I AP,AD D ; Attempt to Auto-Decrease Rx Claims w/Payments
  1. . D REJ^RCDPEAD4(1)
  1. ; End PRCA*4.5*345
  1. Q
  1. ;
  1. EN1A(RCDAY,PAID,WHICH) ; Scan ERA's for auto-posted lines on RCDAY
  1. ; PRCA*4.5*345 - Added WHICH
  1. ; Input: RCDAY - Day to begin search for auto-posted but not decreased lines
  1. ; PAID - 1 - Decrease paid lines only, 2 - Decrease no-pay lines only
  1. ; WHICH - 1 - Checking for Medical Claims, 2 - Checking for Rx Claims
  1. ; Output: Auto-decreases claims (potentially)
  1. ;
  1. ; Scan F (Auto-Post) index for ERAs within date range
  1. S RCDATE=$$FMADD^XLFDT(RCDAY,-1)
  1. F D Q:'RCDATE Q:(RCDATE\1)>RCDAY
  1. . S RCDATE=$O(^RCY(344.4,"F",RCDATE))
  1. . Q:'RCDATE
  1. . Q:(RCDATE\1)>RCDAY
  1. . ;
  1. . ; Scan ERA detail lines for claims with AUTOPOST DATE field #4.03 matching RCDAY
  1. . D EN2(RCDATE,RCDAY,PAID,WHICH) ; PRCA*4.5*345 - Added WHICH
  1. Q
  1. ;
  1. EN2(RCDATE,RCDAY,PAID,WHICH) ; Scans the 'F' index of the ERA file for ERA entries with an
  1. ; AUTOPOST DATE field (#4.03) matching RCDAY
  1. ; PRCA*4.5*345 - Added WHICH
  1. ; Input: RCDATE - Auto-Post Date of the ERA
  1. ; RCDAY - Day to begin search for auto-posted but not decreased lines
  1. ; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
  1. ; WHICH - 1 - Checking for Medical Claims
  1. ; 2 - Checking for Rx Claims
  1. ; 3 - Checking for TRICARE Claims
  1. N IEN3446,PAYID,PAYNAM,RCARRAY,RCERA,RCRTYPE ; PRCA*4.5*345 - Added IEN3446
  1. S RCERA=0
  1. F D Q:'RCERA
  1. . K RCARRAY
  1. . S RCERA=$O(^RCY(344.4,"F",RCDATE,RCERA))
  1. . Q:'RCERA
  1. . S XX=$$ISTYPE^RCDPEU1(344.4,RCERA,"T") ; PRCA*4.5*349 - Added line
  1. . I XX S RCRTYPE=2 ; PRCA*4.5*349 - Check if this is TRICARE ERA
  1. . E S RCRTYPE=$$PHARM^RCDPEAP1(RCERA) ; It must be a Medical or Rx ERA
  1. . I RCRTYPE'=0,WHICH=1 Q ; PRCA*4.5*345 - Not processing Medical Claims
  1. . I RCRTYPE'=1,WHICH=2 Q ; PRCA*4.5*345 - Not processing Rx Claims
  1. . I RCRTYPE'=2,WHICH=3 Q ; PRCA*4.5*349 - Not processing TRICARE Claims
  1. . S PAYID=$$GET1^DIQ(344.4,RCERA_",",.03,"E") ; Payer TIN
  1. . S PAYNAM=$$GET1^DIQ(344.4,RCERA_",",.06,"E") ; Payer Name
  1. . S PAYNAM=$P($G(^RCY(344.4,RCERA,0)),U,6)
  1. . S IEN3446=""
  1. . I PAYID'="",PAYNAM'="" D
  1. . . S IEN3446=$O(^RCY(344.6,"CPID",PAYNAM,PAYID,""))
  1. . ;
  1. . ; Skip if payer is excluded from Auto-Post or Auto-Decrease
  1. . I $$PAYEX(WHICH,IEN3446) Q
  1. . ;
  1. . ; Build index to scratchpad for this ERA
  1. . D BUILD^RCDPEAP(RCERA,.RCARRAY)
  1. . ;
  1. . ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
  1. . D EN3(RCDATE,RCERA,.RCARRAY,PAID,WHICH) ; PRCA*4.5*345 - Added WHICH
  1. Q
  1. ;
  1. EN3(RCDATE,RCERA,RCARRAY,PAID,WHICH) ; Scan ERA Detail lines in #344.41 for
  1. ; auto-posted Medical/Rx claims - PRCA*4.5*345 added WHICH
  1. ; Input: RCDATE - Auto-Post Date
  1. ; RCERA - IEN of the ERA (#344.4)
  1. ; RCARRAY - Array of ERA Scratchpad lines
  1. ; PAID - 1 - Decrease paid lines, 2 - Decrease no-pay lines
  1. ; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
  1. N IENS,RCADJ,RCLINE
  1. S RCLINE=0
  1. ;
  1. ; Find auto-posted claim lines to auto-decrease
  1. F D Q:'RCLINE
  1. . S RCLINE=$O(^RCY(344.4,"F",RCDATE,RCERA,RCLINE))
  1. . Q:'RCLINE
  1. . ;
  1. . ; Ignore claim line if already auto decreased
  1. . Q:$P($G(^RCY(344.4,RCERA,1,RCLINE,5)),U,3)
  1. . ;
  1. . ; Process line
  1. . D EN4(RCDATE,RCERA,.RCARRAY,PAID,RCLINE,WHICH) ; PRCA*4.5*345 - Added WHICH
  1. Q
  1. ;
  1. EN4(RCDATE,RCERA,RCARRAY,PAID,RCLINE,WHICH) ; Auto-decrease selected lines
  1. ; PRCA*4.5*345 - Added WHICH
  1. ; Input: RCDATE - Auto-Post Date
  1. ; RCERA - IEN of the ERA (#344.4)
  1. ; RCARRAY - Array of scratch pad lines
  1. ; PAID - 1 - Decrease paid lines
  1. ; 2 - Decrease no-pay lines
  1. ; RCLINE - IEN of the detail ilne in sub-file 344.41
  1. ; WHICH - 1 - Processing Medical Claims, 2 - Processing Rx Claims
  1. ;
  1. ; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
  1. ; BEGIN PRCA*4.5*326
  1. N COMMENT,EOBIEN,J,PENDING,RCAMT,RCBAL,RCBILL,RCIARR,RCITEN,RCJ,RCK,RCMAX,RCTRANDA,RCZERO,STATUS
  1. ;
  1. ; Check if this is a zero payment line
  1. S RCZERO=$S($$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)=0:1,1:0)
  1. ;
  1. ; Quit if this is a no-payment line and loop is for payment lines
  1. I PAID=1,RCZERO Q
  1. ;
  1. ; Quit if this is not a no-payment line and loop is for no-payment lines
  1. I PAID=2,'RCZERO Q
  1. ;
  1. ; Ignore zero amount reversals
  1. I RCZERO Q:'$G(RCARRAY(RCLINE))
  1. ;
  1. ; Ignore zero lines if status is unverified in scratchpad (#344.491,.13)
  1. I RCZERO D Q:'$$GET1^DIQ(344.491,IENS,.13,"I")
  1. . S IENS=$G(RCARRAY(RCLINE))_","_RCERA
  1. ; END PRCA*4.5*326
  1. ;
  1. ; Get pointer to EOB file #361.1 from ERA DETAIL
  1. S EOBIEN=$P($G(^RCY(344.4,RCERA,1,RCLINE,0)),U,2),RCBILL=0
  1. ;
  1. ; Get ^DGCR(399 pointer (DINUM for #430 file)
  1. S:EOBIEN RCBILL=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCBILL
  1. ;
  1. ; If claim has been split/edit and claim changed in APAR do not auto decrease
  1. Q:$$SPLIT(RCERA,RCLINE,RCBILL,.RCARRAY)
  1. ;
  1. ; Do not auto decrease if claim is referred to General Council
  1. Q:$P($G(^PRCA(430,RCBILL,6)),U,4)'=""
  1. ;
  1. ; Claim must be OPEN or ACTIVE
  1. S STATUS=$P($G(^PRCA(430,RCBILL,0)),"^",8)
  1. I STATUS'=42,STATUS'=16 Q
  1. ;
  1. S RCAMT=$$CARCLMT(EOBIEN,RCZERO,WHICH) ; PRCA*4.5*345 - Added WHICH
  1. Q:$L(RCAMT)=0 ; No CARCs on EOB were eligible for auto-decrease
  1. ;
  1. ; Order CARCs for Auto-Decrease in largest to smallest amount order
  1. K RCIARR
  1. F J=1:1 S RCITEM=$P(RCAMT,U,J) Q:RCITEM="" S RCIARR(-($P(RCITEM,";",1)),J)=RCITEM
  1. Q:$D(RCIARR)<10 ; Quit if CARC adjustment array doesn't have any elements to process
  1. ;
  1. ; Get top limit for auto-decrease
  1. I WHICH=1 S RCMAX=+$$GET1^DIQ(344.61,"1,",.05) ; Medical Claims limit PRCA*4.5*345
  1. E I WHICH=2 S RCMAX=+$$GET1^DIQ(344.61,"1,",1.04) ; Rx Claims limit PRCA*4.5*349
  1. E S RCMAX=+$$GET1^DIQ(344.61,"1,",1.07) ; TRICARE Claims limit PRCA*4.5*349
  1. ;
  1. ; Walk the RCIARR and apply CARC based adjustments to the bill.
  1. S RCJ="",RCADJ=0
  1. F S RCJ=$O(RCIARR(RCJ)) Q:RCJ="" S RCK="" F S RCK=$O(RCIARR(RCJ,RCK)) Q:RCK="" D
  1. . ; Get current balance on Bill
  1. . S RCBAL=$P($G(^PRCA(430,RCBILL,7)),U)
  1. . ;
  1. . ; Check pending payment amount and bill balance
  1. . S PENDING=$$PENDPAY^RCDPURET(RCBILL)
  1. . K ^TMP($J,"RCDPUREC","PP")
  1. . Q:(RCBAL-PENDING)<(+$P(RCIARR(RCJ,RCK),";",1))
  1. . ;
  1. . Q:(RCADJ+$P(RCIARR(RCJ,RCK),";",1))>RCMAX ; Don't apply decrease if over top limit
  1. . ;
  1. . S XX=$S(WHICH=1:"MEDICAL",WHICH=2:"PHARMACY",1:"TRICARE") ; PRCA*4.5*345, PRCA*4.5*349 Rx and TRICARE
  1. . S COMMENT(1)=XX+" AUTO-DECREASE FOR CARC: "_$P(RCIARR(RCJ,RCK),";",2) ; PRCA*4.5*345
  1. . S COMMENT(1)=COMMENT(1)_" AMOUNT: "_+$P(RCIARR(RCJ,RCK),";",1) ; PRCA*4.5*326
  1. . S COMMENT(1)=COMMENT(1)_" (MAX DEC: "
  1. . S COMMENT(1)=COMMENT(1)_+$P($$ACTCARC^RCDPEAD2($P(RCIARR(RCJ,RCK),";",2),RCZERO,WHICH),U,2)_")" ; PRCA*4.5*326
  1. . ;
  1. . ; If this CARC is expired then add that information to the comment
  1. . I $P(RCIARR(RCJ,RCK),";",3)'="" D
  1. . . S COMMENT(1)=COMMENT(1)_" CARC expired on "_$$FMTE^XLFDT($P(RCIARR(RCJ,RCK),";",3),"6D")
  1. . ;
  1. . ; Apply contract adjustment for CARC adjustment amount from claim information
  1. . S RCTRANDA=$$INCDEC^RCBEUTR1(RCBILL,-$P(RCIARR(RCJ,RCK),";",1),.COMMENT,"","",1)
  1. . Q:'RCTRANDA
  1. . ;
  1. . ; Update total adjustments for line
  1. . S RCADJ=RCADJ+$P(RCIARR(RCJ,RCK),";",1)
  1. ;
  1. ; Update auto-decrease indicator, auto decrease amount and auto decrease date
  1. N DA,DIE,DR
  1. S DA(1)=RCERA,DA=RCLINE,DIE="^RCY(344.4,"_DA(1)_",1,",DR="7///1;8///"_RCADJ_";10///"_DT
  1. D ^DIE
  1. ;
  1. ; Update last auto decrease date on ERA
  1. N DA,DIE,DR
  1. S DA=RCERA,DIE="^RCY(344.4,",DR="4.03///"_DT
  1. ;
  1. ; PRCA*4.5*332 - If we just did an Auto-Decrease of a zero-dollar ERA set
  1. ; the Match Status to MATCH - 0 PAYMENT and the Posting Status to POSTING NOT NEEDED
  1. I PAID=0,RCZERO D
  1. . S DR=DR_";.09////3;.14////3"
  1. D ^DIE
  1. Q
  1. ;
  1. SPLIT(RCSCR,RCLINE,RCBILL,RCARRAY) ;Check for SPLIT/EDIT in scratchpad
  1. ;Input RCSCR - IEN of #344.49
  1. ; RCLINE - ERA detail line sequence number
  1. ; RCBILL - IEN of #430
  1. ; ARRAY - reference to passed array (from BUILD^RCDPEAP)
  1. ;Output return value 1/0 = Split/Not Split
  1. N SUB,SUB1
  1. ;Find ERA line in scratchpad
  1. S SUB=$G(RCARRAY(RCLINE)) Q:'SUB 0
  1. ;Get n.001 line
  1. S SUB1=$O(^RCY(344.49,RCSCR,1,SUB)) Q:'SUB1 0
  1. ;Check sequence number is the same
  1. Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),".")'=$P($G(^RCY(344.49,RCSCR,1,SUB,0)),U) 0
  1. ;Check that claim number is unchanged from original ERA
  1. Q:$P($G(^RCY(344.49,RCSCR,1,SUB1,0)),U,7)=RCBILL 0
  1. ;Otherwise claim was edited (and should not be decreased)
  1. Q 1
  1. ;
  1. CARCLMT(RCEOB,RCZERO,WHICH,FROMADP,ADATE) ;EP from COMPILE^RCDPEADP and AUTO^RCDPEWLZ
  1. ; Checks to see if CARCs are included and eligible for auto-decrease
  1. ; PRCA*4.5*345 - Added WHICH
  1. ; Returns 0 if not, Max Amount ^ CARC if it is.
  1. ; Input: RCEOB - Internal IEN for the explanation of benefits field (361.1)
  1. ; FROMADP - 1 if being called from COMPILE^RCDPEADP, 0 otherwise
  1. ; Optional, default to 0
  1. ; ADATE - Internal Auto-Post Date (only passed if FROMADP=1)
  1. ; RCZERO - 0 = ERA Line with payment 1 = ERA Line without payment
  1. ; WHICH - 1 - Checking Auto-Decrease for Medical CARCs
  1. ; 2 - Checking Auto-Decrease for Rx CARCs
  1. ; 3 - Checking Auto-Decrease for TRICARE CARCs
  1. ; Optional, defaults to 1 (Medical)
  1. ; Returns: A1;A2;A3;A4^B1;B2;B3;B4^...^N1;N2;N3;N4 Where:
  1. ; A1 - Auto-Decrease amount of the 1st CARC code in the EOB
  1. ; A2 - 1st CARC code in the EOB
  1. ; A3 - Deactivation Date of the 1st CARC code in the EOB if
  1. ; it has one and is less than today AND FROMADP=0
  1. ; Otherwise Quantity of the first CARC code in the EOB if
  1. ; FROMADP=1
  1. ; A4 - Reason of the 1st CARC code in the EOB
  1. ; only passed if FROMADP=1
  1. N I,RCAMT,RCCAMT,RCCODE,RCCODES,RCDATA,RCITEM,RCTAMT,XDT,XIEN
  1. I $G(WHICH)="" S WHICH=1
  1. S:'$D(FROMADP) FROMADP=0
  1. S RCAMT="",RCCODES=""
  1. ;
  1. ; Extract the CARC codes from the EOB.
  1. ; Returned are ^A1;A2;A3;A4^A1;A2;A3;A4^... Where
  1. ; A1 - CARC code
  1. ; A2 - Auto Decrease Amount
  1. ; A3 - Quantity (only returned if FROMADP=1)
  1. ; A4 - REASON (only returned if FROMADP=1)
  1. D GETCARCS^RCDPEAD2(RCEOB,.RCCODES,FROMADP)
  1. ;
  1. ; Loop through all of the CARC codes found. If none, it will exit.
  1. F I=2:1:$L(RCCODES,"^") D
  1. . S RCITEM=$P(RCCODES,"^",I)
  1. . Q:RCITEM=""
  1. . S RCCODE=$P(RCITEM,";",1),RCCAMT=$P(RCITEM,";",2)
  1. . ;
  1. . ; Quit If the Adjustment amount is a negative amount
  1. . Q:+RCCAMT<0
  1. . ;
  1. . ; Look up code in CARC table and get max adjustment
  1. . S RCDATA=$$ACTCARC^RCDPEAD2(RCCODE,RCZERO,WHICH) ; PRCA*4.5*345 - added WHICH
  1. . ;
  1. . ; Quit If auto decrease is not active on this code
  1. . Q:+RCDATA=0
  1. . ;
  1. . ; Get code inactive date if it exists
  1. . S XIEN=$$FIND1^DIC(345,,"O",RCCODE)
  1. . S:$G(XIEN)'="" XDT=$$GET1^DIQ(345,XIEN_",",2,"I")
  1. . I $G(XDT)'="" S:XDT'<DT XDT=""
  1. . S RCTAMT=$P(RCDATA,U,2) ; Get limit
  1. . ;
  1. . ; 11/11/2015: Compare the max adjustment in parameters to the adjustment on EEOB
  1. . ; Quit if over
  1. . ;
  1. . ; If the CARC payer adjustment <= CARC max adjustment amount, Then add to list
  1. . ; for possible adjustments.
  1. . I RCCAMT<(RCTAMT+.01)!FROMADP D
  1. . . ;
  1. . . ; If we're being called from the auto-decrease report, return all CARC information
  1. . . I FROMADP D Q
  1. . . . S XX=RCCAMT_";"_RCCODE_";"_$P(RCITEM,";",3,4)
  1. . . . S RCAMT=$S(RCAMT'[";":XX,1:RCAMT_"^"_XX)
  1. . . S RCAMT=$S($L(RCAMT)=0:RCCAMT_";"_RCCODE_";"_XDT,1:RCAMT_U_RCCAMT_";"_RCCODE_";"_XDT)
  1. Q RCAMT
  1. ;
  1. OTHER(RCBILLDA,ORIG) ; Check if APAR/WL entries exist on other ERA for this bill
  1. ; INPUT
  1. ; RCBILLDA - IEN for claim in #430 or #399
  1. ; ORIG - IEN for current ERA
  1. ; OUTPUT
  1. ; RCPEND - 1 = Other ERA payments exist 0 - No other ERA payments exit
  1. ;
  1. N AUTOSTA,RCERA,RCEOB,RCLINE,RCPAID,RCPEND,RCTOT,RCZ,RCZL
  1. ; Find EEOB's for this claim
  1. S RCEOB=0,RCPEND=0
  1. F S RCEOB=$O(^IBM(361.1,"B",RCBILLDA,RCEOB)) Q:'RCEOB Q:RCPEND D
  1. . ;Find ERAs for this EOB - may be multiple
  1. . S RCERA=0
  1. . F S RCERA=$O(^RCY(344.4,"ADET",RCEOB,RCERA)) Q:'RCERA Q:RCPEND D
  1. . . ; Ignore original ERA
  1. . . Q:RCERA=ORIG
  1. . . ; Get auto-post status for ERA
  1. . . S AUTOSTA=$$GET1^DIQ(344.4,RCERA_",",4.02,"I")
  1. . . ; Ignore completely processed auto-post ERA
  1. . . Q:AUTOSTA=2
  1. . . ; Ignore non-auto-post ERA which already have a receipt - processed or otherwise
  1. . . I AUTOSTA="",$$GET1^DIQ(344.4,RCERA_",",.08,"I") Q
  1. . . ; Get ERA lines for this EOB
  1. . . S RCLINE=0,RCTOT=0
  1. . . F S RCLINE=$O(^RCY(344.4,"ADET",RCEOB,RCERA,RCLINE)) Q:'RCLINE Q:RCPEND D
  1. . . . ; Ignore auto-posted lines (which have a receipt)
  1. . . . I AUTOSTA]"",$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.25) Q
  1. . . . ; Get paid amount from ERA line
  1. . . . S RCPAID=$$GET1^DIQ(344.41,RCLINE_","_RCERA_",",.03)
  1. . . . ; Ignore zero lines
  1. . . . Q:'RCPAID
  1. . . . ; If no scratchpad use paid amount from ERA
  1. . . . I '$D(^RCY(344.49,RCERA)) S RCTOT=RCTOT+RCPAID Q
  1. . . . ; Find ERA line in scratchpad
  1. . . . S RCZL=$$FIND(RCERA,RCLINE) Q:'RCZL
  1. . . . ; If scratchpad exists scan B index for split lines(344.49 is DINUM with 344.4)
  1. . . . S RCSUB=RCZL
  1. . . . F S RCSUB=$O(^RCY(344.49,RCERA,1,"B",RCSUB)) Q:(RCSUB\1)'=RCZL D
  1. . . . . S RCZ=$O(^RCY(344.49,RCERA,1,"B",RCSUB,"")) Q:'RCZ
  1. . . . . ; Check AR BILL is for this claim
  1. . . . . Q:$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.07,"I")'=RCBILLDA
  1. . . . . ; Add AMOUNT TO POST ON RECEIPT to pending total - should resolve reversals
  1. . . . . S RCTOT=RCTOT+$$GET1^DIQ(344.491,RCZ_","_RCERA_",",.03)
  1. . . ; If claim total for the ERA is non-zero auto-decrease is blocked
  1. . . S:RCTOT>0 RCPEND=1
  1. Q RCPEND
  1. ;
  1. FIND(RCERA,RCLINE) ; Search ORIGINAL ERA SEQUENCES for this line
  1. ; Input RCERA - Scratchpad IEN
  1. ; RCLINE - ERA line to find
  1. ; Output RET - Scratchpad line number
  1. ;
  1. N DA,ORIG,RCSUB,RET
  1. S RCSUB=0,RET=0
  1. F S RCSUB=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB)) Q:RET Q:'RCSUB D
  1. . S DA=$O(^RCY(344.49,RCERA,1,"ASEQ",RCSUB,"")) Q:'DA
  1. . ;Get Original sequences
  1. . S ORIG=$$GET1^DIQ(344.491,DA_","_RCERA_",",.09) Q:ORIG=""
  1. . ;Check if scratchpad line is for original ERA line
  1. . S ORIG=","_ORIG_","
  1. . S:$F(ORIG,","_RCLINE_",") RET=RCSUB
  1. Q RET
  1. ;
  1. PAYEX(WHICH,IEN3446) ; Check if payer is excluded
  1. ; Subroutine added for PRCA*4.5*349
  1. ; Input: WHICH - 1=Medical, 2=Rx, 3=TRICARE
  1. ; IEN3446 - Internal Entry number of Payer Exclusion file entry
  1. ; Returns: 1 if payer is excluded, otherwise 0.
  1. ;
  1. N FLDA,FLDD,RETURN,XX
  1. S RETURN=0
  1. S FLDA=$S(WHICH=1:.06,WHICH=2:.08,1:.13)
  1. S FLDD=$S(WHICH=1:.07,WHICH=2:.12,1:.14)
  1. ; If processing Rx Claims, skip if payer is excluded from Auto-Post or Auto-Decrease
  1. I IEN3446'="" D ;
  1. . S XX=$$GET1^DIQ(344.6,IEN3446_",",FLDA,"I")
  1. . I XX S RETURN=1 Q ; Payer excluded from Rx Auto-Post
  1. . S XX=$$GET1^DIQ(344.6,IEN3446_",",FLDD,"I")
  1. . I XX S RETURN=1 ; Payer excluded from Rx Auto-Decrease
  1. Q RETURN