- 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 Feb 18, 2025@23:11:43 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