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

RCDPEWLZ.m

Go to the documentation of this file.
  1. RCDPEWLZ ;ALB/PJH-Block Auto-decrease protocol ;09 Feb 2018
  1. ;;4.5;Accounts Receivable;**326,332**;Mar 20, 1995;Build 40
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. BLOCK(RCERA) ; Stop/Allow Auto Decrease of zero balance denials
  1. ;
  1. ; Input - RCERA - IEN of ERA in #344.4
  1. ;
  1. ; Check that the ERA has auto-decrease CARCs which are not decreased
  1. N RCARRAY
  1. D AUTO(RCERA,.RCARRAY)
  1. ;
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. I 'RCARRAY D G QUIT
  1. .W !!,"This option is only valid if an ERA has auto-decrease CARCs."
  1. ;
  1. I RCARRAY("D") D G QUIT
  1. .W !!,"This option is not valid, the ERA has already been auto-decreased."
  1. ;
  1. N RCSTA,X
  1. S RCSTA=$$GET1^DIQ(344.4,RCERA_",",.19,"I")
  1. ;
  1. ;
  1. W !!,"This option will "
  1. W $S(RCSTA:"ALLOW the nightly process to auto-decrease",1:"STOP the nightly process from auto-decreasing")
  1. W !," the CARCs on this ERA.",!
  1. ;
  1. I $$ASKSTAT(RCSTA)'=1 Q
  1. ;
  1. ; Update ERA
  1. D UPD(RCERA,RCSTA)
  1. ;
  1. W !,"... CARCs on this ERA will "_$S(RCSTA:"",1:"NOT ")_"be auto-decreased ..."
  1. ;
  1. QUIT ; pause and rebuild the header
  1. W !!,"press RETURN to continue: "
  1. R X:DTIME
  1. ;
  1. N RCARC
  1. S RCARC=$$WLH^RCDPEWLZ(+RCSCR)
  1. S:RCARC]"" VALMHDR(4)=RCARC
  1. Q
  1. ;
  1. ASKSTAT(RCSTA) ; ask if its okay to block to unblock from auto-decrease
  1. ; 1 is yes, otherwise no
  1. N DIR,DIQ2,DTOUT,DUOUT,X,Y
  1. S DIR(0)="YO",DIR("B")="Y"
  1. S DIR("A")="Do you want to "_$S(RCSTA:"ALLOW",1:"STOP")_" auto-decrease of this ERA"
  1. D ^DIR
  1. I $G(DTOUT)!($G(DUOUT)) S Y=-1
  1. Q Y
  1. ;
  1. AUTO(RCERA,RCARRAY) ; Search ERA for Auto-Decrease CARCs
  1. ; INPUT - RCERA = ERA number/IEN
  1. ; RCARRAY = return array reference
  1. ; OUTPUT - RCARRAY = list of ERA lines and auto-decrease CARC/amounts for each line
  1. ;
  1. ; RCARRAY=1
  1. ; RCARRAY(1)="5.71;22;^10.00;23;" - list of decrease amounts for each auto-decrease CARC
  1. ; RCARRAY(1,"D")=1 - indicates line is decreased already
  1. ; RCARRAY(1,"B")=1 - indicates line is/was blocked
  1. ;
  1. N EOBIEN,PAYID,PAYNAM,RC3446,RCARC,RCBLK,RCDAY,RCPARM,RCRCVD,RCSUB,RCRTYPE,RCZERO
  1. K RCARRAY
  1. S RCARRAY=0,RCARRAY("D")=0
  1. ; Ignore ERA if total paid is not zero
  1. Q:+$$GET1^DIQ(344.4,RCERA_",",.05)
  1. ; Ignore ERA if removed from worklist
  1. Q:+$$GET1^DIQ(344.4,RCERA_",",.16,"I")
  1. ; Calculate process date by subtracting DENIAL decrease days from today's date
  1. S RCDAY=$$FMADD^XLFDT(DT\1,-$$GET1^DIQ(344.61,"1,",.12))
  1. ; Compare to ERA received date
  1. S RCRCVD=$$GET1^DIQ(344.4,RCERA_",",.07,"I")
  1. ; If not already decreased then check that auto-decrease date is not already past
  1. I $$GET1^DIQ(344.4,RCERA_",",4.03,"I")="",RCRCVD\1<RCDAY Q
  1. ; Ignore ERA if not payment type of NON
  1. I $$GET1^DIQ(344.4,RCERA_",",.15)'="NON"
  1. ; Ignore ERA if it has PLBs
  1. Q:$D(^TMP($J,"RCDPEWLA","ERA LEVEL ADJUSTMENT EXISTS"))
  1. ; Quit if ERA is for Pharmacy
  1. S RCRTYPE=$$PHARM^RCDPEAP1(RCERA)
  1. Q:RCRTYPE
  1. ; Check payer exclusion file for this ERA's payer
  1. S PAYID=$P($G(^RCY(344.4,RCERA,0)),U,3)
  1. S PAYNAM=$P($G(^RCY(344.4,RCERA,0)),U,6)
  1. I PAYID'="",PAYNAM'="" D
  1. . S RCPARM=$O(^RCY(344.6,"CPID",PAYNAM,PAYID,""))
  1. . S:RCPARM'="" RC3446=$G(^RCY(344.6,RCPARM,0))
  1. ; Ignore ERA if EXCLUDE MED CLAIMS POSTING (#.06) or EXCLUDE MED CLAIMS DECREASE (#.07) fields set to 'yes'
  1. I $G(RC3446)'="" Q:$P(RC3446,U,6)=1 Q:$P(RC3446,U,7)=1
  1. ; Scan ERA for EOB - do NOT use scratchpad
  1. S RCSUB=0,RCZERO=1
  1. F S RCSUB=$O(^RCY(344.4,RCERA,1,RCSUB)) Q:'RCSUB D
  1. .; Get IEN of EOB
  1. .S EOBIEN=$$GET1^DIQ(344.41,RCSUB_","_RCERA,.02,"I")
  1. .Q:'EOBIEN
  1. .; Get CARCS
  1. .S RCARC=$$CARCLMT^RCDPEAD(EOBIEN,RCZERO)
  1. .; No CARCs on EOB were eligible for auto-decrease
  1. .Q:$L(RCARC)=0
  1. .; Save CARCs agains line number
  1. .S RCARRAY(RCSUB)=RCARC
  1. .; CARCs found indicator
  1. .S RCARRAY=1
  1. .; Determine if line is already auto-decreased
  1. .S:$$GET1^DIQ(344.41,RCSUB_","_RCERA_",",10,"I")]"" RCARRAY("D")=1
  1. Q
  1. ;
  1. UPD(RCERA,RCSTA) ; Update AUTO-DECREASE BLOCKED status of an ERA
  1. N DA,DIE,DR
  1. S DA=RCERA
  1. S DIE="^RCY(344.4,",DR=".19///"_$S(RCSTA:0,1:1) D ^DIE
  1. Q
  1. ;
  1. WLF(RCERA) ; Return auto-decrease flag - EP EXTRACT^RCDPEWL7
  1. ; INPUT - RCERA = IEN of ERA in #344.4
  1. ; OUTPUT - 'c' or null
  1. N RCARRAY
  1. ; Check for CARCs
  1. D AUTO(RCERA,.RCARRAY)
  1. ; Return result
  1. Q $S(RCARRAY:"c",1:"")
  1. ;
  1. WLH(RCERA) ; Auto-decrease status for ERA - EP HDR^RCDPEWL
  1. ; INPUT - RCERA = IEN of ERA in #344.4
  1. ; OUTPUT - RCTXT = display text
  1. N RCARRAY
  1. ; Check for CARCs
  1. D AUTO(RCERA,.RCARRAY)
  1. ; If none return null
  1. I 'RCARRAY Q ""
  1. ; Check if ERA is auto-decrease blocked
  1. Q:$$GET1^DIQ(344.4,RCERA_",",.19,"I") "Auto-Decrease CARCS are stopped from auto-decrease"
  1. ; Check if already auto-decreased
  1. Q:RCARRAY("D") "ERA has processed Auto-Decrease CARCS"
  1. ; Else
  1. Q "ERA has unprocessed Auto-Decrease CARCS"
  1. ;
  1. WLL(RCERA,RCLINE) ; Auto-decrease status for ERA line - EP - RCDPEWL0
  1. ; INPUT - RCERA = IEN of ERA in #344.4
  1. ; RCLINE = ERA line number
  1. ; OUTPUT - RCTXT = display text
  1. N I,RCARC,RCARRAY,RCTOT
  1. ; Check for CARCs on ERA
  1. D AUTO(RCERA,.RCARRAY)
  1. ; Check for CARCs on line
  1. Q:'$D(RCARRAY(RCLINE)) ""
  1. ; Total line CARCS
  1. S RCTOT=0
  1. F I=1:1 S RCARC=$P(RCARRAY(RCLINE),U,I) Q:RCARC="" S RCTOT=RCTOT+$P(RCARC,";")
  1. Q $S(RCTOT:"Auto-decrease CARC total: $"_RCTOT,1:"")
  1. ;
  1. SCRPAD(RCERA) ;Build Scratchpad entry in #344.49 for the ERA - EP REJ^RCDPEAD
  1. ;
  1. ; Input - RCERA - IEN for #344.4
  1. ;
  1. ; Output - RCSCR = Scratchpad IEN (Success) or 0 (Fail)
  1. ;
  1. N RC0,RC5,RCSCR,RCDAT,X
  1. S RC0=$G(^RCY(344.4,RCERA,0)),RC5=$G(^RCY(344.4,RCERA,5))
  1. ;Ignore is this ERA already has a receipt
  1. I +$P(RC0,U,8) Q 0
  1. ;Denial ERA must be expected payment type NON
  1. I $P(RC0,U,15)'="NON" Q 0
  1. ;Scratchpad already exists
  1. S RCSCR=+$O(^RCY(344.49,"B",RCERA,0)) I RCSCR G SCRPADX
  1. ;Create new Scratchpad
  1. S RCSCR=+$$ADDREC^RCDPEWL(RCERA,.RCDAT) I 'RCSCR Q 0
  1. ;Add all the ERA lines to the Scratchpad entry
  1. D ADDLINES^RCDPEWLA(RCSCR)
  1. SCRPADX ;Return Scratchpad IEN
  1. Q RCSCR