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

RCDPESP7.m

Go to the documentation of this file. 
  1. RCDPESP7 ;AITC/PJH - ePayment Lockbox Site Parameters Definition - auto-decrease ;29 Jan 2019 18:00:14
  1.  ;;4.5;Accounts Receivable;**298,304,318,321,326,345,349**;Mar 20, 1995;Build 44
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; Input: PARMTYP - 2 - Paid TRICARE Auto-Decrease parameters
  1.  ;                  1 - Paid Rx Auto-Decrease parameters
  1.  ;                  0 - Paid Medical Auto-Decrease parameters
  1.  ;                  Optional, defaults to 0
  1.  ; Returns: 0 - "OK"
  1.  ;          1 - "ABORT"
  1.  ;          2 - "SKIP"
  1.  ;
  1.  ; PRCA*4.5*345 logic changed below, FLD and CLMTYP variables added
  1.  N ADAMT,ADMC,ADNAMT,CLMTYP,DIR,DTOUT,DUOUT,FDAEDI,FLD,RCAUDVAL,RCOK,RCQUIT,X,XX,Y
  1.  S:'$G(PARMTYP) PARMTYP=0,CLMTYP="MEDICAL"
  1.  S:PARMTYP=2 CLMTYP="TRICARE"                     ; PRCA*4.5*349 - Added line
  1.  S:PARMTYP=1 CLMTYP="PHARMACY"                    ; PRCA*4.5*349 - Added line
  1.  S FLD=$S(PARMTYP=2:1.06,PARMTYP=0:.03,1:1.02)    ; PRCA*4.5*349 - Added line
  1.  S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I") ; Current value PRCA*4.5*349 - Changed .03 to FLD
  1.  K DIR
  1.  S DIR(0)="YA",DIR("B")=$S(ADMC=""!(ADMC=1):"Yes",1:"No")
  1.  ;
  1.  S DIR("A")="ENABLE AUTO-DECREASE OF "_CLMTYP_" CLAIMS WITH PAYMENTS (Y/N): "
  1.  S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
  1.  W ! D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q 1
  1.  ;
  1.  ; If user changed value, update and audit
  1.  S FLD=$S(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06) ; PRCA*4.5*349
  1.  I ADMC'=Y D  ;
  1.  . S FDAEDI(344.61,"1,",FLD)=Y
  1.  . S RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC
  1.  . D:$D(FDAEDI) FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
  1.  . K RCAUDVAL
  1.  I Y=0 Q 2  ; Value set to No, update if needed
  1.  ;
  1.  ; Set auto-decrease maximum amount
  1. ADAMT ; BEGIN - PRCA*4.5*326
  1.  S FLD=$S(PARMTYP=0:.05,PARMTYP=1:1.04,1:1.07) ; PRCA*4.5*349
  1.  S ADAMT=$$GET1^DIQ(344.61,"1,",FLD)
  1.  K DIR
  1.  S DIR("B")=ADAMT
  1.  S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
  1.  S DIR(0)="NA^1:99999:0"
  1.  S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q 1
  1.  I ADAMT'=Y D
  1.  . S FDAEDI(344.61,"1,",FLD)=Y,RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADAMT
  1.  S ADNAMT=Y
  1.  ;
  1.  ; Check if any CARCs need reset and give choice to proceed
  1.  S RCOK=$$CARCDSP^RCDPESP5(ADNAMT,PARMTYP)
  1.  ;
  1.  ; Finish if user exit selected
  1.  Q:RCOK="QUIT" 1
  1.  ;
  1.  ; If user chooses to not reset then go back to re-enter maximum
  1.  I RCOK=0 K FDAEDI(344.61,"1,",FLD),RCAUDVAL(2) G ADAMT
  1.  ; END - PRCA*4.5*326
  1.  ;
  1.  ; File changes to Medical/Pharmacy Auto-Decrease parameters
  1.  D:$D(FDAEDI) FILE^DIE(,"FDAEDI")
  1.  D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
  1.  K FDAEDI,RCAUDVAL
  1.  ; PRCA*4.5*345 - updated logic below with FLD and PARMTYP
  1.  ; If auto-decrease on, ask about CARC/RARC auto-decrease setup
  1.  W !
  1.  S RCQUIT=0 D CARC(.RCQUIT,1,PARMTYP)
  1.  W !
  1.  S FLD=$S(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06) ; PRCA*4.5*349
  1.  ;
  1.  ; If no active CARCs turn Auto-Decrease off 
  1.  I ($$COUNT^RCDPESP(1,0,PARMTYP)=0),($$GET1^DIQ(344.61,"1,",FLD,"I")=1) D  Q 2
  1.  . N FDAEDI,MSGTXT,RCAUDVAL
  1.  . S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
  1.  . S FDAEDI(344.61,"1,",FLD)=0
  1.  . S RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U
  1.  . S XX=$S(PARMTYP=0:"Medical",PARMTYP=1:"Pharmacy",1:"TRICARE") ; PRCA*4.5*349 - Added line
  1.  . S MSGTXT="SYSTEM disabled "_XX_" Auto-decrease, there are NO active CARCs"
  1.  . S RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U_MSGTXT
  1.  . D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
  1.  . W !,"*** The "_MSGTXT_".",!
  1.  . D PAUSE^RCDPESP
  1.  Q:RCQUIT 1
  1.  ;
  1.  ; Set number of days to wait before auto-decrease amount with payments
  1.  S FLD=$S(PARMTYP=0:.04,PARMTYP=1:1.03,1:1.08)       ; PRCA*4.5*349
  1.  S ADMT=$$GET1^DIQ(344.61,"1,",FLD) ; PRCA*4.5*349
  1.  K DIR
  1.  S:ADMT'="" DIR("B")=ADMT
  1.  S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT"),DIR(0)="NA^0:7:0"
  1.  S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q 1
  1.  I ADMT'=Y D  ;
  1.  . S FDAEDI(344.61,"1,",FLD)=Y                ; PRCA*4.5*349
  1.  . S RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT ; PRCA*4.5*349
  1.  . ; File changes to medical no-pay auto-decrease parameters
  1.  . D FILE^DIE(,"FDAEDI")
  1.  . D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
  1.  . K RCAUDVAL
  1.  Q 0
  1.  ;
  1. NOPAY(CLMTYP) ; function, No-payment claim auto-decrease parameters
  1.  ; PRCA*4.5*345- Added CLMTYP
  1.  ; Input CLMTYP - 0: Medical Claims, 1:Pharmacy, 2 - TRICARE
  1.  ; Returns: 0: no issues, 1: ABORT, 2: SKIP
  1.  ;
  1.  N ADMC,ADMT,DIR,DTOUT,DUOUT,FDAEDI,FLD,MSGTXT,RCAUDVAL,RCQUIT,X,XX,Y
  1.  ; If auto-decrease of paid claims is off skip auto-decrease no-pay parameters
  1.  S FLD=$S(CLMTYP=0:.03,1:1.06)          ; PRCA*4.5*349
  1.  I '$$GET1^DIQ(344.61,"1,",FLD,"I") Q 0 ; PRCA*4.5*349
  1.  ;
  1.  S FLD=$S(CLMTYP=0:.11,1:1.09)          ; PRCA*4.5*349
  1.  S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")  ; Get current value
  1.  S DIR(0)="YA",DIR("B")=$S(ADMC=""!(ADMC=1):"Yes",1:"No")
  1.  ;
  1.  S XX=$S(CLMTYP=0:"MEDICAL",1:"TRICARE")
  1.  S DIR("A")="ENABLE AUTO-DECREASE OF "_XX_" CLAIMS WITH NO PAYMENTS (Y/N): "
  1.  S FLD=$S(CLMTYP=0:.11,1:1.09) ; PRCA*4.5*349 - Added line
  1.  S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
  1.  W !
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q 1
  1.  ; if user changed value, update and audit
  1.  I ADMC'=Y D  ;
  1.  . S FDAEDI(344.61,"1,",FLD)=Y,RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC ; PRCA*4.5*349
  1.  . D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
  1.  . K RCAUDVAL
  1.  ;
  1.  I Y=0 Q 2  ; Value set to No, update (if needed), go to Pharmacy params.
  1.  ;
  1.  ; If no-pay auto-decrease on, ask about CARC/RARC auto-decrease setup
  1.  W !
  1.  S RCQUIT=0
  1.  D CARC(.RCQUIT,0,CLMTYP)
  1.  W !
  1.  ; If no active CARCs Turn medical no-pay auto-decrease off, Then go to Pharmacy params
  1.  S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I") ; PRCA*4.5*349
  1.  I ($$COUNT^RCDPESP(1,1,CLMTYP)=0)&(ADMC=1) D  Q 1
  1.  . K FDAEDI,MSGTXT,RCAUDVAL
  1.  . S FDAEDI(344.61,"1,",FLD)=0 ; PRCA*4.5*349
  1.  . S XX=$S(CLMTYP=0:"Medical",1:"TRICARE") ; PRCA*4.5*349 - Added line
  1.  . S MSGTXT="SYSTEM disabled "_XX_" No-pay Auto-decrease, there are NO active CARCs"
  1.  . S RCAUDVAL(1)="344.61^"_FLD_"^1^0^"_ADMC_U_MSGTXT ; PRCA*4.5*349
  1.  . D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
  1.  . W !,"*** The "_MSGTXT,!
  1.  . D PAUSE^RCDPESP
  1.  Q:RCQUIT 1
  1.  ;
  1.  ; Set number of days to wait before no-pay auto-decrease amount
  1.  S FLD=$S(CLMTYP=0:.12,1:1.1)       ; PRCA*4.5*349
  1.  S ADMT=$$GET1^DIQ(344.61,"1,",FLD) ; PRCA*4.5*349
  1.  K DIR
  1.  S:ADMT'="" DIR("B")=ADMT
  1.  S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT"),DIR(0)="NA^0:45:0"
  1.  S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
  1.  D ^DIR
  1.  I $D(DTOUT)!$D(DUOUT) Q 1
  1.  I ADMT'=Y D  ;
  1.  . S FDAEDI(344.61,"1,",FLD)=Y                ; PRCA*4.5*349
  1.  . S RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT ; PRCA*4.5*349
  1.  . ; File changes to medical no-pay auto-decrease parameters
  1.  . D FILE^DIE(,"FDAEDI")
  1.  . D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
  1.  . K RCAUDVAL
  1.  Q 0
  1.  ;
  1. CARC(RCQUIT,PAID,RCARCTYP) ; Update the CARC/RARC inclusion table
  1.  ; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
  1.  ; PRCA*4.5*345 - Added RCARCTYP for Rx Auto-Decrease CARC/RARC inclusion table
  1.  ; Input:   RCQUIT  - Added RCQUIT as input parameter - PRCA*4.5*321
  1.  ;          PAID    - 1 - Payment lines  0 = no-payment lines - PRCA*4.5*326
  1.  ;          RCARCTYP   - 2 - TRICARE, 1 - Pharmacy, 0 - Medical
  1.  ;                    Optional defaults to 0
  1.  N F1,F2,RCANS,RCAUDARY,RCCARC,RCCHG,RCCDATA,RCCIEN,RCDESC,RCRSN,RCSTAT
  1.  N RCAMT,RCNAMT,RCCARCDS,RCYN,RCVAL,RCACTV,RCTXT,XX
  1.  S:'$D(RCARCTYP) RCARCTYP=0
  1.  S RCTXT=$S(PAID:"",1:"NO-PAY ")  ; PRCA*4.5*326
  1.  ;
  1.  ; PRCA*4.5*349 - Fields for medical, Rx or TRICARE
  1.  I PAID=1 D  ; Payment lines
  1.  . S F1=$S(RCARCTYP=0:.02,RCARCTYP=1:2.01,1:3.01) ; Enabled
  1.  . S F2=$S(RCARCTYP=0:.06,RCARCTYP=1:2.05,1:3.05) ; Amount
  1.  E  D  ; No payment lines
  1.  . S F1=$S(RCARCTYP=0:.08,RCARCTYP=1:2.01,1:3.07) ; Enabled (Note Rx does not have separate no-pay)
  1.  . S F2=$S(RCARCTYP=0:.12,RCARCTYP=1:2.05,1:3.11) ; Amount
  1.  ; 
  1.  ; Display initial entry line
  1.  W !,"AUTO-DECREASE "_RCTXT
  1.  ;
  1.  ; PRCA*4.5*345, PRCA*4.5*349 - Added pharmacy and TRICARE checks below
  1.  W $S(RCARCTYP=0:"MEDICAL",RCARCTYP=1:"PHARMACY",1:"TRICARE")
  1.  W " CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:",!
  1.  ;
  1.  ; Loop until the user quits
  1.  S RCANS=""
  1.  F  D  Q:RCANS="Q"
  1.  . ; Display list of currently enabled/disabled CARCs/RARCs
  1.  . W !
  1.  . D PRTCARC^RCDPESP5(PAID,RCARCTYP)  ; PRCA*4.5*326, PRCA*4.5*345 added RCARCTYP
  1.  . W !!  ; skip lines
  1.  . ; Ask user for the CARC/RARC to enable/disable (QUIT) [default] to exit
  1.  . S RCCARC=$$GETCARC^RCDPESPB
  1.  . I RCCARC=-1 S RCQUIT=1,RCANS="Q" Q
  1.  . I RCCARC=0 S RCANS="Q" Q
  1.  . ; Validate CARC entered
  1.  . S RCVAL=$$VAL^RCDPCRR(345,RCCARC)   ; Validate CARC against File 345
  1.  . S RCACTV=$$ACT^RCDPRU(345,RCCARC,DT)   ; Check if CARC is an active code
  1.  . ; If the CARC is invalid, warn user and quit
  1.  . I 'RCVAL D  Q
  1.  . . W !,"The CARC code you have entered is not a valid CARC code.  Please try again"
  1.  . ; Print CARC and description
  1.  . S RCCARCDS=""
  1.  . D GETCODES^RCDPCRR(RCCARC,"","A",$$DT^XLFDT,"RCCARCDS","1^100")
  1.  . I $D(RCCARCDS("CARC",RCCARC))'=10 D
  1.  . . D GETCODES^RCDPCRR(RCCARC,"","I",$$DT^XLFDT,"RCCARCDS","1^100")
  1.  . S RCCIEN=$O(RCCARCDS("CARC",RCCARC,""))
  1.  . S RCDESC=$P(RCCARCDS("CARC",RCCARC,RCCIEN),U,6)
  1.  . ; If description longer than 70 characters, truncate add ellipsis
  1.  . S:$L(RCDESC)>70 RCDESC=$E(RCDESC,1,70)_"..."
  1.  . W !,?3,"  "_RCDESC,! ; PRCA*4.5*349 add ?3
  1.  . I 'RCACTV W "   *** WARNING: CARC code "_RCCARC_" is no longer active.",!
  1.  . ;
  1.  . ; Look up CARC/RARC in table.
  1.  . S RCCIEN=$O(^RCY(344.62,"B",RCCARC,""))
  1.  . S (RCAMT,RCSTAT)=0  ; Initialize if new code entry for table
  1.  . I RCCIEN D  ; Code exists in table
  1.  . . ; PRCA*4.5*326, PRCA*4.5*345 begin
  1.  . . ; Get current payment Auto-decrease status and Max decrease amount
  1.  . . I PAID=1 D  ; Payment lines
  1.  . . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
  1.  . . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
  1.  . . I PAID=0 D  ; No payment lines
  1.  . . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
  1.  . . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
  1.  . . ; PRCA*4.5*326, PRCA*4.5*345 end
  1.  . ; If CARC enabled
  1.  . I RCCIEN,RCSTAT D  Q
  1.  . . S RCNAMT=0,RCRSN=""
  1.  . . ; Confirm that this is the correct CARC
  1.  . . S RCYN=$$CONFIRM(4,PAID,RCARCTYP)  ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
  1.  . . Q:RCYN=-1
  1.  . . ; Ask for reason
  1.  . . S RCRSN=$$GETREASN^RCDPESP5(RCCARC)
  1.  . . Q:RCRSN=-1  ; User indicated to quit
  1.  . . ; Confirm the disabling
  1.  . . S RCYN=$$CONFIRM(3,PAID,RCARCTYP)  ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
  1.  . . Q:RCYN=-1
  1.  . . D UPDDATA^RCDPESP5(RCCIEN,0,RCAMT,RCRSN,PAID,RCARCTYP) ; If disabling - PRCA4*5*345 - Added RCARCTYP
  1.  . . ; audit disabled CARC: "File^Field^IEN^New Value^Old Value^Comment"
  1.  . . S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^0^1^"_RCRSN ; PRCA*4.5*326
  1.  . . D AUDIT^RCDPESP(.RCAUDARY)
  1.  . ;
  1.  . ; Confirm that this is the correct CARC to Enable
  1.  . S RCYN=$$CONFIRM(1,PAID,RCARCTYP) ; Added PAID - PRCA*4.5*326
  1.  . Q:RCYN=-1
  1.  . ;
  1.  . ; Ask for new amount
  1.  . S RCNAMT=$$GETAMT^RCDPESPB(RCARCTYP)  ; PRCA4*5*345 - Added RCARCTYP
  1.  . Q:RCNAMT=-1  ; User indicated to quit
  1.  . ;
  1.  . ; Ask for reason
  1.  . S RCRSN=$$GETREASN^RCDPESP5(RCCARC)
  1.  . Q:RCRSN=-1  ;User indicated to quit
  1.  . ;
  1.  . ; Confirm save
  1.  . S RCYN=$$CONFIRM(2,PAID,RCARCTYP) ; Added PAID - PRCA*4.5*326 Added RCARCTYP
  1.  . I (RCYN="N")!(RCYN=-1) W !,"NOT SAVED",! Q
  1.  . ;
  1.  . ; Re-enable if disabled and quit
  1.  . I RCCIEN D  Q
  1.  . . D UPDDATA^RCDPESP5(RCCIEN,1,RCNAMT,RCRSN,PAID,RCARCTYP)  ; Re-enable, update amount - PRCA*4.5*326 added RCARCTYP
  1.  . . ; Update audit file with reason and changes (field format above)
  1.  . . S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN  ; PRCA*4.5*326
  1.  . . S RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^"_RCAMT_"^"_RCRSN ; PRCA*4.5*326
  1.  . . D AUDIT^RCDPESP(.RCAUDARY)
  1.  . ;
  1.  . ; Store new entry
  1.  . D ADDDATA^RCDPESP5(RCCARC,RCNAMT,RCRSN,PAID,RCARCTYP) ; PAID added PRCA*4.5*326, PRCA4*5*345 - Added RCARCTYP
  1.  . ;
  1.  . ; Update audit file with reason and amount changes.
  1.  . S RCCIEN=$$FIND1^DIC(344.62,"","",RCCARC,"","","RCERR")
  1.  . S:RCCIEN="" RCCIEN="ERROR"
  1.  . ;
  1.  . S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN   ; PRCA*4.5*326
  1.  . S RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^0^"_RCRSN ; PRCA*4.5*326
  1.  . D AUDIT^RCDPESP(.RCAUDARY)
  1.  . ;
  1.  Q
  1.  ;
  1. CONFIRM(RCIDX,PAID,RCARCTYP) ; Ask user to change or disable an enabled CARC auto-decrement
  1.  ; Added PAID - PRCA*4.5*326
  1.  ; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
  1.  ; PRCA*4.5*345 - Added RCARCTYP parameter
  1.  ; Input: RCIDX: 1 - Enable Auto-Decrease CARC
  1.  ;               2 - Confirm Enable of Auto-Decrease CARC, 
  1.  ;               3 - Confirm disable of Auto-Decrease CARC
  1.  ;               4 - Disable Auto-Decrease CARC
  1.  ;         PAID: 1 - Auto-Decrease CARCs for paid claims
  1.  ;               0 - Auto-Decrease CARCs for no-pay claims
  1.  ;     RCARCTYP: 0 - Medical Auto-Decrease CARCs
  1.  ;               1 - Rx Auto-Decrease CARCs
  1.  ;               2 - TRICARE CARCs
  1.  ;               Optional, defaults to 0
  1.  ;
  1.  N DA,DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCTXT,X,XX,Y
  1.  S:'$D(RCARCTYP) RCARCTYP=0                 ; PRCA4*5*345 - Added line
  1.  S RCTXT=$S(PAID:"",1:"NO-PAY ")            ; PRCA*4.5*326
  1.  ;
  1.  ; Confirm if the CARC code is correct
  1.  I RCIDX=1 D
  1.  . S XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
  1.  . S DIR("?")=XX
  1.  . S XX="ENABLE this CARC for Auto-Decrease of "_RCTXT
  1.  . ;
  1.  . ; PRCA*4.5*349 - added Rx/TRICARE Check below
  1.  . S XX=XX_$S(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")
  1.  . S XX=XX_" Claims (Y/N)? "
  1.  . S DIR("A")=XX
  1.  ;
  1.  ; Confirm user wishes to Enable changes
  1.  I RCIDX=2 D
  1.  . S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
  1.  . S DIR("A")="Save this CARC? (Y)es or (N)o: "
  1.  ;
  1.  ; Confirm user wishes to Disable changes
  1.  I RCIDX=3 D
  1.  . S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
  1.  . S DIR("A")="Remove this CARC? (Y)es or (N)o: "
  1.  ;
  1.  ; Confirm CARC code is correct
  1.  I RCIDX=4 D
  1.  . S XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
  1.  . S DIR("?")=XX
  1.  . S XX="DISABLE this CARC for Auto-Decrease of "_RCTXT
  1.  . ;
  1.  . ; PRCA*4.5*349 - Added Rx/Tricare check below
  1.  . S XX=XX_$S(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")_" Claims (Y/N)? "
  1.  . S DIR("A")=XX
  1.  ;
  1.  S DIR(0)="YA",DIR("S")="Y:Yes;N:No"
  1.  D ^DIR
  1.  K DIR
  1.  I $G(DTOUT)!$G(DUOUT) S Y=-1
  1.  I Y="0" S Y=-1
  1.  Q Y