RCDPESP7 ;AITC/PJH - ePayment Lockbox Site Parameters Definition - auto-decrease ;29 Jan 2019 18:00:14
;;4.5;Accounts Receivable;**298,304,318,321,326,345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
PAID(PARMTYP) ;function, Paid claim auto-decrease parameters, PRCA*4.5*345 added PARMTYP
; Input: PARMTYP - 2 - Paid TRICARE Auto-Decrease parameters
; 1 - Paid Rx Auto-Decrease parameters
; 0 - Paid Medical Auto-Decrease parameters
; Optional, defaults to 0
; Returns: 0 - "OK"
; 1 - "ABORT"
; 2 - "SKIP"
;
; PRCA*4.5*345 logic changed below, FLD and CLMTYP variables added
N ADAMT,ADMC,ADNAMT,CLMTYP,DIR,DTOUT,DUOUT,FDAEDI,FLD,RCAUDVAL,RCOK,RCQUIT,X,XX,Y
S:'$G(PARMTYP) PARMTYP=0,CLMTYP="MEDICAL"
S:PARMTYP=2 CLMTYP="TRICARE" ; PRCA*4.5*349 - Added line
S:PARMTYP=1 CLMTYP="PHARMACY" ; PRCA*4.5*349 - Added line
S FLD=$S(PARMTYP=2:1.06,PARMTYP=0:.03,1:1.02) ; PRCA*4.5*349 - Added line
S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I") ; Current value PRCA*4.5*349 - Changed .03 to FLD
K DIR
S DIR(0)="YA",DIR("B")=$S(ADMC=""!(ADMC=1):"Yes",1:"No")
;
S DIR("A")="ENABLE AUTO-DECREASE OF "_CLMTYP_" CLAIMS WITH PAYMENTS (Y/N): "
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
W ! D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
;
; If user changed value, update and audit
S FLD=$S(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06) ; PRCA*4.5*349
I ADMC'=Y D ;
. S FDAEDI(344.61,"1,",FLD)=Y
. S RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC
. D:$D(FDAEDI) FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
. K RCAUDVAL
I Y=0 Q 2 ; Value set to No, update if needed
;
; Set auto-decrease maximum amount
ADAMT ; BEGIN - PRCA*4.5*326
S FLD=$S(PARMTYP=0:.05,PARMTYP=1:1.04,1:1.07) ; PRCA*4.5*349
S ADAMT=$$GET1^DIQ(344.61,"1,",FLD)
K DIR
S DIR("B")=ADAMT
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
S DIR(0)="NA^1:99999:0"
S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I ADAMT'=Y D
. S FDAEDI(344.61,"1,",FLD)=Y,RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADAMT
S ADNAMT=Y
;
; Check if any CARCs need reset and give choice to proceed
S RCOK=$$CARCDSP^RCDPESP5(ADNAMT,PARMTYP)
;
; Finish if user exit selected
Q:RCOK="QUIT" 1
;
; If user chooses to not reset then go back to re-enter maximum
I RCOK=0 K FDAEDI(344.61,"1,",FLD),RCAUDVAL(2) G ADAMT
; END - PRCA*4.5*326
;
; File changes to Medical/Pharmacy Auto-Decrease parameters
D:$D(FDAEDI) FILE^DIE(,"FDAEDI")
D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
K FDAEDI,RCAUDVAL
; PRCA*4.5*345 - updated logic below with FLD and PARMTYP
; If auto-decrease on, ask about CARC/RARC auto-decrease setup
W !
S RCQUIT=0 D CARC(.RCQUIT,1,PARMTYP)
W !
S FLD=$S(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06) ; PRCA*4.5*349
;
; If no active CARCs turn Auto-Decrease off
I ($$COUNT^RCDPESP(1,0,PARMTYP)=0),($$GET1^DIQ(344.61,"1,",FLD,"I")=1) D Q 2
. N FDAEDI,MSGTXT,RCAUDVAL
. S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
. S FDAEDI(344.61,"1,",FLD)=0
. S RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U
. S XX=$S(PARMTYP=0:"Medical",PARMTYP=1:"Pharmacy",1:"TRICARE") ; PRCA*4.5*349 - Added line
. S MSGTXT="SYSTEM disabled "_XX_" Auto-decrease, there are NO active CARCs"
. S RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U_MSGTXT
. D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
. W !,"*** The "_MSGTXT_".",!
. D PAUSE^RCDPESP
Q:RCQUIT 1
;
; Set number of days to wait before auto-decrease amount with payments
S FLD=$S(PARMTYP=0:.04,PARMTYP=1:1.03,1:1.08) ; PRCA*4.5*349
S ADMT=$$GET1^DIQ(344.61,"1,",FLD) ; PRCA*4.5*349
K DIR
S:ADMT'="" DIR("B")=ADMT
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT"),DIR(0)="NA^0:7:0"
S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I ADMT'=Y D ;
. S FDAEDI(344.61,"1,",FLD)=Y ; PRCA*4.5*349
. S RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT ; PRCA*4.5*349
. ; File changes to medical no-pay auto-decrease parameters
. D FILE^DIE(,"FDAEDI")
. D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
. K RCAUDVAL
Q 0
;
NOPAY(CLMTYP) ; function, No-payment claim auto-decrease parameters
; PRCA*4.5*345- Added CLMTYP
; Input CLMTYP - 0: Medical Claims, 1:Pharmacy, 2 - TRICARE
; Returns: 0: no issues, 1: ABORT, 2: SKIP
;
N ADMC,ADMT,DIR,DTOUT,DUOUT,FDAEDI,FLD,MSGTXT,RCAUDVAL,RCQUIT,X,XX,Y
; If auto-decrease of paid claims is off skip auto-decrease no-pay parameters
S FLD=$S(CLMTYP=0:.03,1:1.06) ; PRCA*4.5*349
I '$$GET1^DIQ(344.61,"1,",FLD,"I") Q 0 ; PRCA*4.5*349
;
S FLD=$S(CLMTYP=0:.11,1:1.09) ; PRCA*4.5*349
S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I") ; Get current value
S DIR(0)="YA",DIR("B")=$S(ADMC=""!(ADMC=1):"Yes",1:"No")
;
S XX=$S(CLMTYP=0:"MEDICAL",1:"TRICARE")
S DIR("A")="ENABLE AUTO-DECREASE OF "_XX_" CLAIMS WITH NO PAYMENTS (Y/N): "
S FLD=$S(CLMTYP=0:.11,1:1.09) ; PRCA*4.5*349 - Added line
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
W !
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
; if user changed value, update and audit
I ADMC'=Y D ;
. S FDAEDI(344.61,"1,",FLD)=Y,RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC ; PRCA*4.5*349
. D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
. K RCAUDVAL
;
I Y=0 Q 2 ; Value set to No, update (if needed), go to Pharmacy params.
;
; If no-pay auto-decrease on, ask about CARC/RARC auto-decrease setup
W !
S RCQUIT=0
D CARC(.RCQUIT,0,CLMTYP)
W !
; If no active CARCs Turn medical no-pay auto-decrease off, Then go to Pharmacy params
S ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I") ; PRCA*4.5*349
I ($$COUNT^RCDPESP(1,1,CLMTYP)=0)&(ADMC=1) D Q 1
. K FDAEDI,MSGTXT,RCAUDVAL
. S FDAEDI(344.61,"1,",FLD)=0 ; PRCA*4.5*349
. S XX=$S(CLMTYP=0:"Medical",1:"TRICARE") ; PRCA*4.5*349 - Added line
. S MSGTXT="SYSTEM disabled "_XX_" No-pay Auto-decrease, there are NO active CARCs"
. S RCAUDVAL(1)="344.61^"_FLD_"^1^0^"_ADMC_U_MSGTXT ; PRCA*4.5*349
. D FILE^DIE(,"FDAEDI"),AUDIT^RCDPESP(.RCAUDVAL)
. W !,"*** The "_MSGTXT,!
. D PAUSE^RCDPESP
Q:RCQUIT 1
;
; Set number of days to wait before no-pay auto-decrease amount
S FLD=$S(CLMTYP=0:.12,1:1.1) ; PRCA*4.5*349
S ADMT=$$GET1^DIQ(344.61,"1,",FLD) ; PRCA*4.5*349
K DIR
S:ADMT'="" DIR("B")=ADMT
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT"),DIR(0)="NA^0:45:0"
S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I ADMT'=Y D ;
. S FDAEDI(344.61,"1,",FLD)=Y ; PRCA*4.5*349
. S RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT ; PRCA*4.5*349
. ; File changes to medical no-pay auto-decrease parameters
. D FILE^DIE(,"FDAEDI")
. D:$D(RCAUDVAL) AUDIT^RCDPESP(.RCAUDVAL)
. K RCAUDVAL
Q 0
;
CARC(RCQUIT,PAID,RCARCTYP) ; Update the CARC/RARC inclusion table
; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
; PRCA*4.5*345 - Added RCARCTYP for Rx Auto-Decrease CARC/RARC inclusion table
; Input: RCQUIT - Added RCQUIT as input parameter - PRCA*4.5*321
; PAID - 1 - Payment lines 0 = no-payment lines - PRCA*4.5*326
; RCARCTYP - 2 - TRICARE, 1 - Pharmacy, 0 - Medical
; Optional defaults to 0
N F1,F2,RCANS,RCAUDARY,RCCARC,RCCHG,RCCDATA,RCCIEN,RCDESC,RCRSN,RCSTAT
N RCAMT,RCNAMT,RCCARCDS,RCYN,RCVAL,RCACTV,RCTXT,XX
S:'$D(RCARCTYP) RCARCTYP=0
S RCTXT=$S(PAID:"",1:"NO-PAY ") ; PRCA*4.5*326
;
; PRCA*4.5*349 - Fields for medical, Rx or TRICARE
I PAID=1 D ; Payment lines
. S F1=$S(RCARCTYP=0:.02,RCARCTYP=1:2.01,1:3.01) ; Enabled
. S F2=$S(RCARCTYP=0:.06,RCARCTYP=1:2.05,1:3.05) ; Amount
E D ; No payment lines
. S F1=$S(RCARCTYP=0:.08,RCARCTYP=1:2.01,1:3.07) ; Enabled (Note Rx does not have separate no-pay)
. S F2=$S(RCARCTYP=0:.12,RCARCTYP=1:2.05,1:3.11) ; Amount
;
; Display initial entry line
W !,"AUTO-DECREASE "_RCTXT
;
; PRCA*4.5*345, PRCA*4.5*349 - Added pharmacy and TRICARE checks below
W $S(RCARCTYP=0:"MEDICAL",RCARCTYP=1:"PHARMACY",1:"TRICARE")
W " CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:",!
;
; Loop until the user quits
S RCANS=""
F D Q:RCANS="Q"
. ; Display list of currently enabled/disabled CARCs/RARCs
. W !
. D PRTCARC^RCDPESP5(PAID,RCARCTYP) ; PRCA*4.5*326, PRCA*4.5*345 added RCARCTYP
. W !! ; skip lines
. ; Ask user for the CARC/RARC to enable/disable (QUIT) [default] to exit
. S RCCARC=$$GETCARC^RCDPESPB
. I RCCARC=-1 S RCQUIT=1,RCANS="Q" Q
. I RCCARC=0 S RCANS="Q" Q
. ; Validate CARC entered
. S RCVAL=$$VAL^RCDPCRR(345,RCCARC) ; Validate CARC against File 345
. S RCACTV=$$ACT^RCDPRU(345,RCCARC,DT) ; Check if CARC is an active code
. ; If the CARC is invalid, warn user and quit
. I 'RCVAL D Q
. . W !,"The CARC code you have entered is not a valid CARC code. Please try again"
. ; Print CARC and description
. S RCCARCDS=""
. D GETCODES^RCDPCRR(RCCARC,"","A",$$DT^XLFDT,"RCCARCDS","1^100")
. I $D(RCCARCDS("CARC",RCCARC))'=10 D
. . D GETCODES^RCDPCRR(RCCARC,"","I",$$DT^XLFDT,"RCCARCDS","1^100")
. S RCCIEN=$O(RCCARCDS("CARC",RCCARC,""))
. S RCDESC=$P(RCCARCDS("CARC",RCCARC,RCCIEN),U,6)
. ; If description longer than 70 characters, truncate add ellipsis
. S:$L(RCDESC)>70 RCDESC=$E(RCDESC,1,70)_"..."
. W !,?3," "_RCDESC,! ; PRCA*4.5*349 add ?3
. I 'RCACTV W " *** WARNING: CARC code "_RCCARC_" is no longer active.",!
. ;
. ; Look up CARC/RARC in table.
. S RCCIEN=$O(^RCY(344.62,"B",RCCARC,""))
. S (RCAMT,RCSTAT)=0 ; Initialize if new code entry for table
. I RCCIEN D ; Code exists in table
. . ; PRCA*4.5*326, PRCA*4.5*345 begin
. . ; Get current payment Auto-decrease status and Max decrease amount
. . I PAID=1 D ; Payment lines
. . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
. . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
. . I PAID=0 D ; No payment lines
. . . S RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
. . . S RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
. . ; PRCA*4.5*326, PRCA*4.5*345 end
. ; If CARC enabled
. I RCCIEN,RCSTAT D Q
. . S RCNAMT=0,RCRSN=""
. . ; Confirm that this is the correct CARC
. . S RCYN=$$CONFIRM(4,PAID,RCARCTYP) ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
. . Q:RCYN=-1
. . ; Ask for reason
. . S RCRSN=$$GETREASN^RCDPESP5(RCCARC)
. . Q:RCRSN=-1 ; User indicated to quit
. . ; Confirm the disabling
. . S RCYN=$$CONFIRM(3,PAID,RCARCTYP) ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
. . Q:RCYN=-1
. . D UPDDATA^RCDPESP5(RCCIEN,0,RCAMT,RCRSN,PAID,RCARCTYP) ; If disabling - PRCA4*5*345 - Added RCARCTYP
. . ; audit disabled CARC: "File^Field^IEN^New Value^Old Value^Comment"
. . S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^0^1^"_RCRSN ; PRCA*4.5*326
. . D AUDIT^RCDPESP(.RCAUDARY)
. ;
. ; Confirm that this is the correct CARC to Enable
. S RCYN=$$CONFIRM(1,PAID,RCARCTYP) ; Added PAID - PRCA*4.5*326
. Q:RCYN=-1
. ;
. ; Ask for new amount
. S RCNAMT=$$GETAMT^RCDPESPB(RCARCTYP) ; PRCA4*5*345 - Added RCARCTYP
. Q:RCNAMT=-1 ; User indicated to quit
. ;
. ; Ask for reason
. S RCRSN=$$GETREASN^RCDPESP5(RCCARC)
. Q:RCRSN=-1 ;User indicated to quit
. ;
. ; Confirm save
. S RCYN=$$CONFIRM(2,PAID,RCARCTYP) ; Added PAID - PRCA*4.5*326 Added RCARCTYP
. I (RCYN="N")!(RCYN=-1) W !,"NOT SAVED",! Q
. ;
. ; Re-enable if disabled and quit
. I RCCIEN D Q
. . D UPDDATA^RCDPESP5(RCCIEN,1,RCNAMT,RCRSN,PAID,RCARCTYP) ; Re-enable, update amount - PRCA*4.5*326 added RCARCTYP
. . ; Update audit file with reason and changes (field format above)
. . S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN ; PRCA*4.5*326
. . S RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^"_RCAMT_"^"_RCRSN ; PRCA*4.5*326
. . D AUDIT^RCDPESP(.RCAUDARY)
. ;
. ; Store new entry
. D ADDDATA^RCDPESP5(RCCARC,RCNAMT,RCRSN,PAID,RCARCTYP) ; PAID added PRCA*4.5*326, PRCA4*5*345 - Added RCARCTYP
. ;
. ; Update audit file with reason and amount changes.
. S RCCIEN=$$FIND1^DIC(344.62,"","",RCCARC,"","","RCERR")
. S:RCCIEN="" RCCIEN="ERROR"
. ;
. S RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN ; PRCA*4.5*326
. S RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^0^"_RCRSN ; PRCA*4.5*326
. D AUDIT^RCDPESP(.RCAUDARY)
. ;
Q
;
CONFIRM(RCIDX,PAID,RCARCTYP) ; Ask user to change or disable an enabled CARC auto-decrement
; Added PAID - PRCA*4.5*326
; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
; PRCA*4.5*345 - Added RCARCTYP parameter
; Input: RCIDX: 1 - Enable Auto-Decrease CARC
; 2 - Confirm Enable of Auto-Decrease CARC,
; 3 - Confirm disable of Auto-Decrease CARC
; 4 - Disable Auto-Decrease CARC
; PAID: 1 - Auto-Decrease CARCs for paid claims
; 0 - Auto-Decrease CARCs for no-pay claims
; RCARCTYP: 0 - Medical Auto-Decrease CARCs
; 1 - Rx Auto-Decrease CARCs
; 2 - TRICARE CARCs
; Optional, defaults to 0
;
N DA,DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCTXT,X,XX,Y
S:'$D(RCARCTYP) RCARCTYP=0 ; PRCA4*5*345 - Added line
S RCTXT=$S(PAID:"",1:"NO-PAY ") ; PRCA*4.5*326
;
; Confirm if the CARC code is correct
I RCIDX=1 D
. S XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
. S DIR("?")=XX
. S XX="ENABLE this CARC for Auto-Decrease of "_RCTXT
. ;
. ; PRCA*4.5*349 - added Rx/TRICARE Check below
. S XX=XX_$S(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")
. S XX=XX_" Claims (Y/N)? "
. S DIR("A")=XX
;
; Confirm user wishes to Enable changes
I RCIDX=2 D
. S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
. S DIR("A")="Save this CARC? (Y)es or (N)o: "
;
; Confirm user wishes to Disable changes
I RCIDX=3 D
. S DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
. S DIR("A")="Remove this CARC? (Y)es or (N)o: "
;
; Confirm CARC code is correct
I RCIDX=4 D
. S XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
. S DIR("?")=XX
. S XX="DISABLE this CARC for Auto-Decrease of "_RCTXT
. ;
. ; PRCA*4.5*349 - Added Rx/Tricare check below
. S XX=XX_$S(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")_" Claims (Y/N)? "
. S DIR("A")=XX
;
S DIR(0)="YA",DIR("S")="Y:Yes;N:No"
D ^DIR
K DIR
I $G(DTOUT)!$G(DUOUT) S Y=-1
I Y="0" S Y=-1
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESP7 14647 printed Nov 22, 2024@16:55:29 Page 2
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
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
PAID(PARMTYP) ;function, Paid claim auto-decrease parameters, PRCA*4.5*345 added PARMTYP
+1 ; Input: PARMTYP - 2 - Paid TRICARE Auto-Decrease parameters
+2 ; 1 - Paid Rx Auto-Decrease parameters
+3 ; 0 - Paid Medical Auto-Decrease parameters
+4 ; Optional, defaults to 0
+5 ; Returns: 0 - "OK"
+6 ; 1 - "ABORT"
+7 ; 2 - "SKIP"
+8 ;
+9 ; PRCA*4.5*345 logic changed below, FLD and CLMTYP variables added
+10 NEW ADAMT,ADMC,ADNAMT,CLMTYP,DIR,DTOUT,DUOUT,FDAEDI,FLD,RCAUDVAL,RCOK,RCQUIT,X,XX,Y
+11 if '$GET(PARMTYP)
SET PARMTYP=0
SET CLMTYP="MEDICAL"
+12 ; PRCA*4.5*349 - Added line
if PARMTYP=2
SET CLMTYP="TRICARE"
+13 ; PRCA*4.5*349 - Added line
if PARMTYP=1
SET CLMTYP="PHARMACY"
+14 ; PRCA*4.5*349 - Added line
SET FLD=$SELECT(PARMTYP=2:1.06,PARMTYP=0:.03,1:1.02)
+15 ; Current value PRCA*4.5*349 - Changed .03 to FLD
SET ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
+16 KILL DIR
+17 SET DIR(0)="YA"
SET DIR("B")=$SELECT(ADMC=""!(ADMC=1):"Yes",1:"No")
+18 ;
+19 SET DIR("A")="ENABLE AUTO-DECREASE OF "_CLMTYP_" CLAIMS WITH PAYMENTS (Y/N): "
+20 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
+21 WRITE !
DO ^DIR
+22 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+23 ;
+24 ; If user changed value, update and audit
+25 ; PRCA*4.5*349
SET FLD=$SELECT(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06)
+26 ;
IF ADMC'=Y
Begin DoDot:1
+27 SET FDAEDI(344.61,"1,",FLD)=Y
+28 SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC
+29 if $DATA(FDAEDI)
DO FILE^DIE(,"FDAEDI")
DO AUDIT^RCDPESP(.RCAUDVAL)
+30 KILL RCAUDVAL
End DoDot:1
+31 ; Value set to No, update if needed
IF Y=0
QUIT 2
+32 ;
+33 ; Set auto-decrease maximum amount
ADAMT ; BEGIN - PRCA*4.5*326
+1 ; PRCA*4.5*349
SET FLD=$SELECT(PARMTYP=0:.05,PARMTYP=1:1.04,1:1.07)
+2 SET ADAMT=$$GET1^DIQ(344.61,"1,",FLD)
+3 KILL DIR
+4 SET DIR("B")=ADAMT
+5 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
+6 SET DIR(0)="NA^1:99999:0"
+7 SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+10 IF ADAMT'=Y
Begin DoDot:1
+11 SET FDAEDI(344.61,"1,",FLD)=Y
SET RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADAMT
End DoDot:1
+12 SET ADNAMT=Y
+13 ;
+14 ; Check if any CARCs need reset and give choice to proceed
+15 SET RCOK=$$CARCDSP^RCDPESP5(ADNAMT,PARMTYP)
+16 ;
+17 ; Finish if user exit selected
+18 if RCOK="QUIT"
QUIT 1
+19 ;
+20 ; If user chooses to not reset then go back to re-enter maximum
+21 IF RCOK=0
KILL FDAEDI(344.61,"1,",FLD),RCAUDVAL(2)
GOTO ADAMT
+22 ; END - PRCA*4.5*326
+23 ;
+24 ; File changes to Medical/Pharmacy Auto-Decrease parameters
+25 if $DATA(FDAEDI)
DO FILE^DIE(,"FDAEDI")
+26 if $DATA(RCAUDVAL)
DO AUDIT^RCDPESP(.RCAUDVAL)
+27 KILL FDAEDI,RCAUDVAL
+28 ; PRCA*4.5*345 - updated logic below with FLD and PARMTYP
+29 ; If auto-decrease on, ask about CARC/RARC auto-decrease setup
+30 WRITE !
+31 SET RCQUIT=0
DO CARC(.RCQUIT,1,PARMTYP)
+32 WRITE !
+33 ; PRCA*4.5*349
SET FLD=$SELECT(PARMTYP=0:.03,PARMTYP=1:1.02,1:1.06)
+34 ;
+35 ; If no active CARCs turn Auto-Decrease off
+36 IF ($$COUNT^RCDPESP(1,0,PARMTYP)=0)
IF ($$GET1^DIQ(344.61,"1,",FLD,"I")=1)
Begin DoDot:1
+37 NEW FDAEDI,MSGTXT,RCAUDVAL
+38 SET ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
+39 SET FDAEDI(344.61,"1,",FLD)=0
+40 SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U
+41 ; PRCA*4.5*349 - Added line
SET XX=$SELECT(PARMTYP=0:"Medical",PARMTYP=1:"Pharmacy",1:"TRICARE")
+42 SET MSGTXT="SYSTEM disabled "_XX_" Auto-decrease, there are NO active CARCs"
+43 SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_0_U_ADMC_U_MSGTXT
+44 DO FILE^DIE(,"FDAEDI")
DO AUDIT^RCDPESP(.RCAUDVAL)
+45 WRITE !,"*** The "_MSGTXT_".",!
+46 DO PAUSE^RCDPESP
End DoDot:1
QUIT 2
+47 if RCQUIT
QUIT 1
+48 ;
+49 ; Set number of days to wait before auto-decrease amount with payments
+50 ; PRCA*4.5*349
SET FLD=$SELECT(PARMTYP=0:.04,PARMTYP=1:1.03,1:1.08)
+51 ; PRCA*4.5*349
SET ADMT=$$GET1^DIQ(344.61,"1,",FLD)
+52 KILL DIR
+53 if ADMT'=""
SET DIR("B")=ADMT
+54 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
SET DIR(0)="NA^0:7:0"
+55 SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
+56 DO ^DIR
+57 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+58 ;
IF ADMT'=Y
Begin DoDot:1
+59 ; PRCA*4.5*349
SET FDAEDI(344.61,"1,",FLD)=Y
+60 ; PRCA*4.5*349
SET RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT
+61 ; File changes to medical no-pay auto-decrease parameters
+62 DO FILE^DIE(,"FDAEDI")
+63 if $DATA(RCAUDVAL)
DO AUDIT^RCDPESP(.RCAUDVAL)
+64 KILL RCAUDVAL
End DoDot:1
+65 QUIT 0
+66 ;
NOPAY(CLMTYP) ; function, No-payment claim auto-decrease parameters
+1 ; PRCA*4.5*345- Added CLMTYP
+2 ; Input CLMTYP - 0: Medical Claims, 1:Pharmacy, 2 - TRICARE
+3 ; Returns: 0: no issues, 1: ABORT, 2: SKIP
+4 ;
+5 NEW ADMC,ADMT,DIR,DTOUT,DUOUT,FDAEDI,FLD,MSGTXT,RCAUDVAL,RCQUIT,X,XX,Y
+6 ; If auto-decrease of paid claims is off skip auto-decrease no-pay parameters
+7 ; PRCA*4.5*349
SET FLD=$SELECT(CLMTYP=0:.03,1:1.06)
+8 ; PRCA*4.5*349
IF '$$GET1^DIQ(344.61,"1,",FLD,"I")
QUIT 0
+9 ;
+10 ; PRCA*4.5*349
SET FLD=$SELECT(CLMTYP=0:.11,1:1.09)
+11 ; Get current value
SET ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
+12 SET DIR(0)="YA"
SET DIR("B")=$SELECT(ADMC=""!(ADMC=1):"Yes",1:"No")
+13 ;
+14 SET XX=$SELECT(CLMTYP=0:"MEDICAL",1:"TRICARE")
+15 SET DIR("A")="ENABLE AUTO-DECREASE OF "_XX_" CLAIMS WITH NO PAYMENTS (Y/N): "
+16 ; PRCA*4.5*349 - Added line
SET FLD=$SELECT(CLMTYP=0:.11,1:1.09)
+17 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
+18 WRITE !
+19 DO ^DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+21 ; if user changed value, update and audit
+22 ;
IF ADMC'=Y
Begin DoDot:1
+23 ; PRCA*4.5*349
SET FDAEDI(344.61,"1,",FLD)=Y
SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_ADMC
+24 DO FILE^DIE(,"FDAEDI")
DO AUDIT^RCDPESP(.RCAUDVAL)
+25 KILL RCAUDVAL
End DoDot:1
+26 ;
+27 ; Value set to No, update (if needed), go to Pharmacy params.
IF Y=0
QUIT 2
+28 ;
+29 ; If no-pay auto-decrease on, ask about CARC/RARC auto-decrease setup
+30 WRITE !
+31 SET RCQUIT=0
+32 DO CARC(.RCQUIT,0,CLMTYP)
+33 WRITE !
+34 ; If no active CARCs Turn medical no-pay auto-decrease off, Then go to Pharmacy params
+35 ; PRCA*4.5*349
SET ADMC=$$GET1^DIQ(344.61,"1,",FLD,"I")
+36 IF ($$COUNT^RCDPESP(1,1,CLMTYP)=0)&(ADMC=1)
Begin DoDot:1
+37 KILL FDAEDI,MSGTXT,RCAUDVAL
+38 ; PRCA*4.5*349
SET FDAEDI(344.61,"1,",FLD)=0
+39 ; PRCA*4.5*349 - Added line
SET XX=$SELECT(CLMTYP=0:"Medical",1:"TRICARE")
+40 SET MSGTXT="SYSTEM disabled "_XX_" No-pay Auto-decrease, there are NO active CARCs"
+41 ; PRCA*4.5*349
SET RCAUDVAL(1)="344.61^"_FLD_"^1^0^"_ADMC_U_MSGTXT
+42 DO FILE^DIE(,"FDAEDI")
DO AUDIT^RCDPESP(.RCAUDVAL)
+43 WRITE !,"*** The "_MSGTXT,!
+44 DO PAUSE^RCDPESP
End DoDot:1
QUIT 1
+45 if RCQUIT
QUIT 1
+46 ;
+47 ; Set number of days to wait before no-pay auto-decrease amount
+48 ; PRCA*4.5*349
SET FLD=$SELECT(CLMTYP=0:.12,1:1.1)
+49 ; PRCA*4.5*349
SET ADMT=$$GET1^DIQ(344.61,"1,",FLD)
+50 KILL DIR
+51 if ADMT'=""
SET DIR("B")=ADMT
+52 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
SET DIR(0)="NA^0:45:0"
+53 SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
+54 DO ^DIR
+55 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+56 ;
IF ADMT'=Y
Begin DoDot:1
+57 ; PRCA*4.5*349
SET FDAEDI(344.61,"1,",FLD)=Y
+58 ; PRCA*4.5*349
SET RCAUDVAL(2)="344.61^"_FLD_"^1^"_Y_U_ADMT
+59 ; File changes to medical no-pay auto-decrease parameters
+60 DO FILE^DIE(,"FDAEDI")
+61 if $DATA(RCAUDVAL)
DO AUDIT^RCDPESP(.RCAUDVAL)
+62 KILL RCAUDVAL
End DoDot:1
+63 QUIT 0
+64 ;
CARC(RCQUIT,PAID,RCARCTYP) ; Update the CARC/RARC inclusion table
+1 ; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
+2 ; PRCA*4.5*345 - Added RCARCTYP for Rx Auto-Decrease CARC/RARC inclusion table
+3 ; Input: RCQUIT - Added RCQUIT as input parameter - PRCA*4.5*321
+4 ; PAID - 1 - Payment lines 0 = no-payment lines - PRCA*4.5*326
+5 ; RCARCTYP - 2 - TRICARE, 1 - Pharmacy, 0 - Medical
+6 ; Optional defaults to 0
+7 NEW F1,F2,RCANS,RCAUDARY,RCCARC,RCCHG,RCCDATA,RCCIEN,RCDESC,RCRSN,RCSTAT
+8 NEW RCAMT,RCNAMT,RCCARCDS,RCYN,RCVAL,RCACTV,RCTXT,XX
+9 if '$DATA(RCARCTYP)
SET RCARCTYP=0
+10 ; PRCA*4.5*326
SET RCTXT=$SELECT(PAID:"",1:"NO-PAY ")
+11 ;
+12 ; PRCA*4.5*349 - Fields for medical, Rx or TRICARE
+13 ; Payment lines
IF PAID=1
Begin DoDot:1
+14 ; Enabled
SET F1=$SELECT(RCARCTYP=0:.02,RCARCTYP=1:2.01,1:3.01)
+15 ; Amount
SET F2=$SELECT(RCARCTYP=0:.06,RCARCTYP=1:2.05,1:3.05)
End DoDot:1
+16 ; No payment lines
IF '$TEST
Begin DoDot:1
+17 ; Enabled (Note Rx does not have separate no-pay)
SET F1=$SELECT(RCARCTYP=0:.08,RCARCTYP=1:2.01,1:3.07)
+18 ; Amount
SET F2=$SELECT(RCARCTYP=0:.12,RCARCTYP=1:2.05,1:3.11)
End DoDot:1
+19 ;
+20 ; Display initial entry line
+21 WRITE !,"AUTO-DECREASE "_RCTXT
+22 ;
+23 ; PRCA*4.5*345, PRCA*4.5*349 - Added pharmacy and TRICARE checks below
+24 WRITE $SELECT(RCARCTYP=0:"MEDICAL",RCARCTYP=1:"PHARMACY",1:"TRICARE")
+25 WRITE " CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:",!
+26 ;
+27 ; Loop until the user quits
+28 SET RCANS=""
+29 FOR
Begin DoDot:1
+30 ; Display list of currently enabled/disabled CARCs/RARCs
+31 WRITE !
+32 ; PRCA*4.5*326, PRCA*4.5*345 added RCARCTYP
DO PRTCARC^RCDPESP5(PAID,RCARCTYP)
+33 ; skip lines
WRITE !!
+34 ; Ask user for the CARC/RARC to enable/disable (QUIT) [default] to exit
+35 SET RCCARC=$$GETCARC^RCDPESPB
+36 IF RCCARC=-1
SET RCQUIT=1
SET RCANS="Q"
QUIT
+37 IF RCCARC=0
SET RCANS="Q"
QUIT
+38 ; Validate CARC entered
+39 ; Validate CARC against File 345
SET RCVAL=$$VAL^RCDPCRR(345,RCCARC)
+40 ; Check if CARC is an active code
SET RCACTV=$$ACT^RCDPRU(345,RCCARC,DT)
+41 ; If the CARC is invalid, warn user and quit
+42 IF 'RCVAL
Begin DoDot:2
+43 WRITE !,"The CARC code you have entered is not a valid CARC code. Please try again"
End DoDot:2
QUIT
+44 ; Print CARC and description
+45 SET RCCARCDS=""
+46 DO GETCODES^RCDPCRR(RCCARC,"","A",$$DT^XLFDT,"RCCARCDS","1^100")
+47 IF $DATA(RCCARCDS("CARC",RCCARC))'=10
Begin DoDot:2
+48 DO GETCODES^RCDPCRR(RCCARC,"","I",$$DT^XLFDT,"RCCARCDS","1^100")
End DoDot:2
+49 SET RCCIEN=$ORDER(RCCARCDS("CARC",RCCARC,""))
+50 SET RCDESC=$PIECE(RCCARCDS("CARC",RCCARC,RCCIEN),U,6)
+51 ; If description longer than 70 characters, truncate add ellipsis
+52 if $LENGTH(RCDESC)>70
SET RCDESC=$EXTRACT(RCDESC,1,70)_"..."
+53 ; PRCA*4.5*349 add ?3
WRITE !,?3," "_RCDESC,!
+54 IF 'RCACTV
WRITE " *** WARNING: CARC code "_RCCARC_" is no longer active.",!
+55 ;
+56 ; Look up CARC/RARC in table.
+57 SET RCCIEN=$ORDER(^RCY(344.62,"B",RCCARC,""))
+58 ; Initialize if new code entry for table
SET (RCAMT,RCSTAT)=0
+59 ; Code exists in table
IF RCCIEN
Begin DoDot:2
+60 ; PRCA*4.5*326, PRCA*4.5*345 begin
+61 ; Get current payment Auto-decrease status and Max decrease amount
+62 ; Payment lines
IF PAID=1
Begin DoDot:3
+63 SET RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
+64 SET RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
End DoDot:3
+65 ; No payment lines
IF PAID=0
Begin DoDot:3
+66 SET RCSTAT=$$GET1^DIQ(344.62,RCCIEN,F1,"I")
+67 SET RCAMT=$$GET1^DIQ(344.62,RCCIEN,F2)
End DoDot:3
+68 ; PRCA*4.5*326, PRCA*4.5*345 end
End DoDot:2
+69 ; If CARC enabled
+70 IF RCCIEN
IF RCSTAT
Begin DoDot:2
+71 SET RCNAMT=0
SET RCRSN=""
+72 ; Confirm that this is the correct CARC
+73 ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
SET RCYN=$$CONFIRM(4,PAID,RCARCTYP)
+74 if RCYN=-1
QUIT
+75 ; Ask for reason
+76 SET RCRSN=$$GETREASN^RCDPESP5(RCCARC)
+77 ; User indicated to quit
if RCRSN=-1
QUIT
+78 ; Confirm the disabling
+79 ; PRCA*4.5*326 -Added PAID, PRCA4*5*345 -Added RCARCTYP
SET RCYN=$$CONFIRM(3,PAID,RCARCTYP)
+80 if RCYN=-1
QUIT
+81 ; If disabling - PRCA4*5*345 - Added RCARCTYP
DO UPDDATA^RCDPESP5(RCCIEN,0,RCAMT,RCRSN,PAID,RCARCTYP)
+82 ; audit disabled CARC: "File^Field^IEN^New Value^Old Value^Comment"
+83 ; PRCA*4.5*326
SET RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^0^1^"_RCRSN
+84 DO AUDIT^RCDPESP(.RCAUDARY)
End DoDot:2
QUIT
+85 ;
+86 ; Confirm that this is the correct CARC to Enable
+87 ; Added PAID - PRCA*4.5*326
SET RCYN=$$CONFIRM(1,PAID,RCARCTYP)
+88 if RCYN=-1
QUIT
+89 ;
+90 ; Ask for new amount
+91 ; PRCA4*5*345 - Added RCARCTYP
SET RCNAMT=$$GETAMT^RCDPESPB(RCARCTYP)
+92 ; User indicated to quit
if RCNAMT=-1
QUIT
+93 ;
+94 ; Ask for reason
+95 SET RCRSN=$$GETREASN^RCDPESP5(RCCARC)
+96 ;User indicated to quit
if RCRSN=-1
QUIT
+97 ;
+98 ; Confirm save
+99 ; Added PAID - PRCA*4.5*326 Added RCARCTYP
SET RCYN=$$CONFIRM(2,PAID,RCARCTYP)
+100 IF (RCYN="N")!(RCYN=-1)
WRITE !,"NOT SAVED",!
QUIT
+101 ;
+102 ; Re-enable if disabled and quit
+103 IF RCCIEN
Begin DoDot:2
+104 ; Re-enable, update amount - PRCA*4.5*326 added RCARCTYP
DO UPDDATA^RCDPESP5(RCCIEN,1,RCNAMT,RCRSN,PAID,RCARCTYP)
+105 ; Update audit file with reason and changes (field format above)
+106 ; PRCA*4.5*326
SET RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN
+107 ; PRCA*4.5*326
SET RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^"_RCAMT_"^"_RCRSN
+108 DO AUDIT^RCDPESP(.RCAUDARY)
End DoDot:2
QUIT
+109 ;
+110 ; Store new entry
+111 ; PAID added PRCA*4.5*326, PRCA4*5*345 - Added RCARCTYP
DO ADDDATA^RCDPESP5(RCCARC,RCNAMT,RCRSN,PAID,RCARCTYP)
+112 ;
+113 ; Update audit file with reason and amount changes.
+114 SET RCCIEN=$$FIND1^DIC(344.62,"","",RCCARC,"","","RCERR")
+115 if RCCIEN=""
SET RCCIEN="ERROR"
+116 ;
+117 ; PRCA*4.5*326
SET RCAUDARY(1)="344.62^"_F1_"^"_RCCIEN_"^1^0^"_RCRSN
+118 ; PRCA*4.5*326
SET RCAUDARY(2)="344.62^"_F2_"^"_RCCIEN_"^"_RCNAMT_"^0^"_RCRSN
+119 DO AUDIT^RCDPESP(.RCAUDARY)
+120 ;
End DoDot:1
if RCANS="Q"
QUIT
+121 QUIT
+122 ;
CONFIRM(RCIDX,PAID,RCARCTYP) ; Ask user to change or disable an enabled CARC auto-decrement
+1 ; Added PAID - PRCA*4.5*326
+2 ; PRCA*4.5*349 - Subroutine moved from RCDPESP5 for size.
+3 ; PRCA*4.5*345 - Added RCARCTYP parameter
+4 ; Input: RCIDX: 1 - Enable Auto-Decrease CARC
+5 ; 2 - Confirm Enable of Auto-Decrease CARC,
+6 ; 3 - Confirm disable of Auto-Decrease CARC
+7 ; 4 - Disable Auto-Decrease CARC
+8 ; PAID: 1 - Auto-Decrease CARCs for paid claims
+9 ; 0 - Auto-Decrease CARCs for no-pay claims
+10 ; RCARCTYP: 0 - Medical Auto-Decrease CARCs
+11 ; 1 - Rx Auto-Decrease CARCs
+12 ; 2 - TRICARE CARCs
+13 ; Optional, defaults to 0
+14 ;
+15 NEW DA,DIR,DTOUT,DUOUT,DIRUT,DIROUT,RCTXT,X,XX,Y
+16 ; PRCA4*5*345 - Added line
if '$DATA(RCARCTYP)
SET RCARCTYP=0
+17 ; PRCA*4.5*326
SET RCTXT=$SELECT(PAID:"",1:"NO-PAY ")
+18 ;
+19 ; Confirm if the CARC code is correct
+20 IF RCIDX=1
Begin DoDot:1
+21 SET XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
+22 SET DIR("?")=XX
+23 SET XX="ENABLE this CARC for Auto-Decrease of "_RCTXT
+24 ;
+25 ; PRCA*4.5*349 - added Rx/TRICARE Check below
+26 SET XX=XX_$SELECT(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")
+27 SET XX=XX_" Claims (Y/N)? "
+28 SET DIR("A")=XX
End DoDot:1
+29 ;
+30 ; Confirm user wishes to Enable changes
+31 IF RCIDX=2
Begin DoDot:1
+32 SET DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
+33 SET DIR("A")="Save this CARC? (Y)es or (N)o: "
End DoDot:1
+34 ;
+35 ; Confirm user wishes to Disable changes
+36 IF RCIDX=3
Begin DoDot:1
+37 SET DIR("?")="Either (Y)es to confirm changes or (N)o to exit without saving."
+38 SET DIR("A")="Remove this CARC? (Y)es or (N)o: "
End DoDot:1
+39 ;
+40 ; Confirm CARC code is correct
+41 IF RCIDX=4
Begin DoDot:1
+42 SET XX="Either (Y)es to confirm that this is the correct code or (N)o to enter a different code."
+43 SET DIR("?")=XX
+44 SET XX="DISABLE this CARC for Auto-Decrease of "_RCTXT
+45 ;
+46 ; PRCA*4.5*349 - Added Rx/Tricare check below
+47 SET XX=XX_$SELECT(RCARCTYP=0:"Medical",RCARCTYP=1:"Pharmacy",1:"TRICARE")_" Claims (Y/N)? "
+48 SET DIR("A")=XX
End DoDot:1
+49 ;
+50 SET DIR(0)="YA"
SET DIR("S")="Y:Yes;N:No"
+51 DO ^DIR
+52 KILL DIR
+53 IF $GET(DTOUT)!$GET(DUOUT)
SET Y=-1
+54 IF Y="0"
SET Y=-1
+55 QUIT Y
