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

RCDPESPB.m

Go to the documentation of this file.
  1. RCDPESPB ;ALB/SAB, OI&T/hrubovcak - ePayment Lockbox Site Parameters Definition - Files 344.71 ;29 Jan 2019 18:00:14
  1. ;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; code moved from RCDPESP5, 14 January 2019
  1. Q
  1. ;
  1. GETCARC() ; function, Retrieve the next CARC code to enable/disable
  1. ; Returns: CARC IEN or, -1 - User '^' out, or 0 - User didn't select a CARC
  1. N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR("?")="Enter a CARC code to enable/disable or Q to Quit."
  1. S DIR(0)="FAO"
  1. S DIR("??")="^D LIST^RCDPCRR(345)"
  1. S DIR("A")="CARC: "
  1. D ^DIR
  1. I $D(DTOUT)!$D(DUOUT) Q -1
  1. I Y="" Q 0
  1. Q Y
  1. ;
  1. GETAMT(RCARCTYP) ; Ask user the maximum amount to allow for auto-decrease
  1. ; PRCA4*5*345 - Added RCARCTYP
  1. ; Input: RCARCTYP - 0 - Medical, 1 - Pharmacy, 2 - TRICARE
  1. N DA,DIR,DIRUT,DIROUT,DTOUT,DUOUT,RCMAX,X,Y
  1. S RCMAX=+$$GET1^DIQ(344.61,"1,",$S(RCARCTYP=0:.05,RCARCTYP=1:1.04,1:1.07)) ; PRCA*4.5*349 TRICARE
  1. S DIR("?")="Enter the maximum amount the CARC can be auto-decreased between $1 and $"_RCMAX
  1. S DIR(0)="NA^1:"_RCMAX_":0"
  1. ; PRCA4*5*345 - Added X in next 2 lines
  1. S X=$S(RCARCTYP=0:"MEDICAL",RCARCTYP=1:"PHARMACY",1:"TRICARE") ; PRCA*4.5*349 TRICARE
  1. S DIR("A")="MAXIMUM DOLLAR AMOUNT TO AUTO-DECREASE PER "_X_" CLAIM (1-"_RCMAX_"): "
  1. D ^DIR
  1. K DIR
  1. I $G(DUOUT) S Y=-1
  1. Q Y
  1. ;
  1. CHECK(RCMAX,RCPAID,RCDSP,RCCNT,RCARCTYP) ; Display/Reset any CARC maximum values which exceed upper limit
  1. ; PRCA*4.5*345 - Added RCARCTYP
  1. ; Input: RCMAX - Maximum allowed $ decrease per claim (from #344.61, #.05)
  1. ; RCPAID - 1 - CARCs for paid claims, 0 - CARCs for NO-PAY claims
  1. ; RCDSP - 1 - Display only, 0 - Update only
  1. ; RCCNT - 1 - Cumulative count of pay and no-pay records found
  1. ; RCARCTYP - 0 - Medical CARCs, 1 - Rx CARCs, 2 - TRICARE CARCs
  1. ; Output: Updates #344.62 - RCDPE CARC-RARC AUTO DEC
  1. ; Updates #344.7 - RCDPE PARAMETER AUDIT
  1. ;
  1. N RCACT,RCAMT,RCARR,RCCIEN,RCCODE,RCCT,RCDESC,RCFLD,RCFLDA,RCI,RCSTAT,RCSUB,RCTXT
  1. ;
  1. ; Max Amount field PRCA*4.5*345, prca*4.5*349 - Added checks for pharmacy and TRICARE
  1. D:RCPAID
  1. . I RCARCTYP=0 S RCFLDA=.06 ; CARC DECREASE AMOUNT
  1. . I RCARCTYP=1 S RCFLDA=2.05 ; PHARM W. PAYMNTS CARC DEC AMNT
  1. . I RCARCTYP=2 S RCFLDA=3.05 ; TRICARE W PYMNTS CARC DEC AMNT
  1. I 'RCPAID D ;
  1. . I RCARCTYP=0 S RCFLDA=.12 ; CARC DECREASE AMOUNT NO-PAY
  1. . I RCARCTYP=2 S RCFLDA=3.11 ; CARC DECR AMNT TRICARE NO-PAY
  1. ;
  1. ; Auto-decrease Y/N field PRCA*4.5*345, PRCA*4.5*349 - Added checks for Pharmacy and TRICARE
  1. D:RCPAID
  1. . I RCARCTYP=0 S RCFLD=.02 ; CARC AUTO DECREASE
  1. . I RCARCTYP=1 S RCFLD=2.01 ; CARC PHARM AUTO DECREASE
  1. . I RCARCTYP=2 S RCFLD=3.01 ;CARC PHARM AUTO DECREASE
  1. ;
  1. I 'RCPAID D ;
  1. . I RCARCTYP=0 S RCFLD=.08 ; CARC AUTO DECREASE NO-PAY
  1. . I RCARCTYP=2 S RCFLD=3.07 ; CARC TRICARE AUTO-DECRS NO-PAY
  1. ;
  1. ; Search for entries that need reducing
  1. S RCI=0,RCARR=0
  1. F S RCI=$O(^RCY(344.62,RCI)) Q:'RCI D
  1. . S RCACT=$$GET1^DIQ(344.62,RCI_",",RCFLD,"I") ; Check if this is an active code
  1. . Q:'RCACT
  1. . S RCAMT=$$GET1^DIQ(344.62,RCI_",",RCFLDA) ; Maximum amount for CARC
  1. . Q:RCAMT'>RCMAX ; Check if limit exceeded
  1. . ; Save CARC for reset and/or display
  1. . S RCARR=RCARR+1,RCCNT=RCCNT+1,RCARR(RCARR)=RCI_U_RCAMT
  1. Q:RCARR=0
  1. ;
  1. I RCDSP=1 D
  1. . S RCTXT=$S('RCPAID:"NO-PAY ",1:"")
  1. . W !!,"Warning:"
  1. . W !," The following "_RCTXT_"CARC codes' max. amt will be changed to the new limit $"_RCMAX
  1. S RCSUB=0
  1. F S RCSUB=$O(RCARR(RCSUB)) Q:'RCSUB D
  1. . S RCI=$P(RCARR(RCSUB),U)
  1. . S RCAMT=$P(RCARR(RCSUB),U,2)
  1. . ; Display line
  1. . I RCDSP D
  1. .. S RCCODE=$$GET1^DIQ(344.62,RCI_",",.01)
  1. .. S RCCIEN=$O(^RC(345,"B",RCCODE,""))
  1. .. S RCDESC=$G(^RC(345,RCCIEN,1,1,0))
  1. .. I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_" ..."
  1. .. W !," "_RCCODE,?9,$E(RCDESC,1,55),?63,$J(RCAMT,10,0)
  1. . ; Reset CARC to top limit
  1. . I 'RCDSP D
  1. .. N RCAUDARY,RCSTAT,RCTXT
  1. .. S RCSTAT=$$GET1^DIQ(344.62,RCI_",",RCFLD) ; Leave status unchanged
  1. .. S RCTXT="Max. Amt reduced to top limit"
  1. .. ; Update #344.62 - RCDPE CARC-RARC AUTO DEC
  1. .. D UPDDATA^RCDPESP5(RCI,RCSTAT,RCMAX,RCTXT,RCPAID,RCARCTYP) ; PRCA*4.5*345 - Added RCARCTYP
  1. .. S RCTXT="Updated automatically - over maximum allowed"
  1. .. ; Update #344.7 - RCDPE PARAMETER AUDIT
  1. .. S RCAUDARY(1)="344.62^"_RCFLD_"^"_RCI_"^"_RCMAX_"^"_RCAMT_"^"_RCTXT
  1. .. D AUDIT^RCDPESP(.RCAUDARY)
  1. Q
  1. ; end PRCA*4.5*326
  1. XMSGBODY(TXT) ; create Mail message body, TXT passed by ref.
  1. ; TXT=line count
  1. N SITE K TXT
  1. S TXT=7,SITE=$$SITE^VASITE
  1. S TXT(1)=" "
  1. S TXT(2)=" Site: "_$P(SITE,U,2)
  1. S TXT(3)=" Station #: "_$P(SITE,U,3)
  1. S TXT(4)=" Domain: "_$G(^XMB("NETNAME"))
  1. S TXT(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"1PM")
  1. S TXT(6)=" Changed by: "_$P($G(^VA(200,DUZ,0)),U)_" (User #"_DUZ_")"
  1. S TXT(7)=" " Q
  1. ;
  1. PADPRMPT(P) ; add space to prompt if needed
  1. Q:'$L($G(P)) "" ; must have prompt
  1. S:'($E($RE(P))=" ") P=P_" " Q P
  1. ;
  1. ; Moved to RCDPESPB for size in PRCA*4.5*349
  1. SCREEN(IEN) ; Screen out payers that don't have an associated ERA - PRCA*4.5*326
  1. ; Input: IEN - Internal entry number from file 344.6
  1. ; Returns: 1 - Payer has an associated ERA, otherwise 0.
  1. N NAME,ID
  1. S NAME=$$GET1^DIQ(344.6,IEN_",",.01)
  1. S ID=$$GET1^DIQ(344.6,IEN_",",.02)
  1. I NAME=""!(ID="") Q 0
  1. I $D(^RCY(344.4,"APT",NAME,ID)) Q 1
  1. Q 0
  1. ;
  1. ; PRCA*4.5*349 - Subroutine PAYTYP added
  1. PAYTYP(TYP,FLD) ; Check if payer is eligible to be selected for a give exclusion type
  1. ; Input: TYP - 1 or 2=Medical, 3 or 4=Rx, 5 or 6=TRICARE
  1. ; FLD - Field number from file 344.6 representing the Auto-Post or Auto-Decrease excusion for TYP.
  1. ; Note variable Y is the IEN of file 344.6, set by FileMan for screen check
  1. ;
  1. N RCTYP
  1. I $$GET1^DIQ(344.6,Y_",",FLD,"I") Q 1 ; Payer already in list for this type
  1. I '$$SCREEN(Y) Q 0 ; Exclude payers with no associated ERA
  1. S RCTYP=$S(TYP=1!(TYP=2):"M",TYP=3!(TYP=4):"P",1:"T")
  1. I $$CHKTYPE^RCDPEU1(Y,RCTYP) Q 1
  1. Q 0