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