BMCCHSE ;IHS/OIT/FCJ - CHS EDIT INFORMATION
;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
;
;IHS.OIT.FCJ; NEW RTN IN PATCH 8 TO ALLOW ADDING CHS DENIAL REASONS
;
;
DENR ;ENTRY POINT FROM BMCMOD
;
TOF ;
;S BMCRIEN=113239
S BMCOPTR="E"
W @IOF,$$REPEAT^XLFSTR("=",79),!?30,"DENIAL REASONS EDIT",!,$$REPEAT^XLFSTR("=",79),!!,"PRIMARY DENIAL REASON: ",!
PRIREAS ; PRIMARY REASON
S X=$P($G(^BMCREF(BMCRIEN,11)),U,14),X1=$P($G(^BMCREF(BMCRIEN,61)),U,20)
S BMCREA(1)=U_X_U_X1
I X,$D(^ACHSDENS(X,0)) D
.W !?10,"1. ",$P($G(^ACHSDENS(X,0)),U),!
.W:X1 ?15,$P($G(^ACHSDENS(X,20,X1,0)),U)
E W !!,*7,*7,"No Primary Denial Reason Has Been Entered" S BMCRED="",BMCOPTR="N",%=1,BMCR="Primary " D PRIM G TOF
;
OTHREAS ; List other Denial Reasons
I $D(^BMCREF(BMCRIEN,43)) D
.S BMCREA=0,BMCCNT=2
.F S BMCREA=$O(^BMCREF(BMCRIEN,43,BMCREA)) Q:BMCREA'?1.N D
..I BMCCNT=2 W !!,"OTHER DENIAL REASONS: ",!
..S BMCOTR=$P(^BMCREF(BMCRIEN,43,BMCREA,0),U),BMCROPT=$P(^(0),U,2)
..W !?10,BMCCNT,". ",$P($G(^ACHSDENS(BMCOTR,0)),U),!
..I BMCROPT W ?15,$P($G(^ACHSDENS(BMCOTR,20,BMCROPT,0)),U)
..S BMCREA(BMCCNT)=BMCREA_U_BMCOTR_U_BMCROPT
..S BMCCNT=BMCCNT+1
;
EDIT ; EDIT REASONS
;
S %=$$DIR^ACHS("FO","Enter Number Of Reason To Edit, 'A' To ADD Reason","","","",2)
I (%="")!$D(DUOUT)!$D(DTOUT) D END Q
S Y=+%,%=$S(+%=1:"PRIM","Aa"[%:"ADD",1:"OTHER")
I (Y>BMCCNT)!((%="OTHER")&('$D(BMCREA(Y)))) W !,"Please enter a number from 1 to ",BMCCNT,"." G EDIT
S BMCRED=+Y,BMCR=$S(%=1:"Primary",1:"Other ")
D @%
K BMCREA G TOF
;
END ;
K BMCREA,TMP,BMCCNT,BMCDEN
K BMCENR,BMCENS,BMCOPTR,BMCOREO,BMCORNM,BMCOTR,BMCR,BMCRED,BMCREDT,CT,L
Q
;
PRIM ;
D REA Q:$D(DUOUT)
I X="@" W !!?5,"Must have a Primary Denial Reason." H 1 Q
;EDITING REASON THEN CHECK TO SEE IF DUPLICATE
S (X,BMCOTR,BMCENR)=+Y
S:BMCRED BMCORNM=$P(BMCREA(BMCRED),U)
S BMCOREO=$P($G(^ACHSDENS(BMCOTR,0)),U)
I BMCRED,BMCOTR'=$P(BMCREA(BMCRED),U,2) G PRIM:$$REASCK() S BMCENR=+Y
Q:$D(DUOUT)
D REAOPT
I $D(Y),+Y<0 W !?5,"Denial Option did not change." H 1
Q
;
OTHER ;EDIT OTHER DENIAL REASON
D REA Q:$D(DUOUT)
S BMCORNM=$P(BMCREA(BMCRED),U)
I X="@" D OTHSET Q ;THEN DELETE ENTRY...
;I EDITING REASON THEN CHECK TO SEE IF DUPLICATE
S (X,BMCOTR)=+Y
S BMCOREO=$P($G(^ACHSDENS(BMCOTR,0)),U)
I BMCOTR'=$P(BMCREA(BMCRED),U,2) G OTHER:$$REASCK() D OTHSET
D OPTSET
Q
;
REA ; Denial Reason
S X=0,CT=0,BMCREDT=""
W !!?3,"Denial Reason List:"
F S X=$O(^ACHSDENS(X)) Q:X'?1N.N D
.I $D(^ACHSDENS(X,10)),$P(^ACHSDENS(X,10),U)>"" Q:$P(^ACHSDENS(X,10),U)<DT
.S CT=CT+1 W !?5,CT,". ",$P(^ACHSDENS(X,0),U)
.S BMCENS(CT)=X_U_$P(^ACHSDENS(X,0),U)
.I BMCRED,X=$P($G(BMCREA(BMCRED)),U,2) S BMCREDT=CT
I CT=0 W !,"No active Denial Reasons" S Y=-1 Q
W !
S BMCDEN="" I BMCRED>0 S BMCDEN=$P(^ACHSDENS($P(BMCREA(BMCRED),U,2),0),U)
S DIR(0)="NO^1:"_CT
S DIR("A")="Enter "_BMCR_" Denial Reason: "_BMCDEN
S DIR("B")=BMCREDT
D ^DIR
Q:$D(DUOUT)
S TMP=""
I +Y>0 S TMP=BMCENS(Y)
I BMCR["Other",+Y>0,Y'=BMCREDT,BMCCNT>1,%="OTHER" S X="@",BMCORNM=$P(BMCREA(BMCRED),U) D
.D OTHSET
.I $P(^BMCREF(BMCRIEN,43,0),U,4)<1 S $P(^(0),U,3,4)="1^1"
S:TMP Y=TMP
K DIR
Q
REASCK() ; --- Check if the Denial reason has already been entered.
N X,X1,Y
S (X,X1,Y)=0
;X1=TOTAL OPTIONS AVAILABLE;X=TOTAL REASON OR OPTIONS USED
F S X=$O(^ACHSDENS(BMCOTR,20,X)) Q:X'?1N.N D
.I $P(^ACHSDENS(BMCOTR,20,X,0),U,2)'="",$P(^(0),U,2)<DT Q
.S X1=X1+1
;I X1=0 NO OPTION AVAILABLE JUST USING REASON
I X1<2,BMCOTR=$P(^BMCREF(BMCRIEN,11),U,14),BMCOPTR="N" W !!,*7,*7,"DENIAL REASON/OPTIONS ALREADY SELECTED.",!! Q 1
S X=0 I BMCOTR=$P(^BMCREF(BMCRIEN,11),U,14) S X=X+1
I $D(^BMCREF(BMCRIEN,43)) S L=0 F S L=$O(^BMCREF(BMCRIEN,43,L)) Q:L'?1N.N D
.I $P(^BMCREF(BMCRIEN,43,L,0),U)=BMCOTR S X=X+1
I X<X1 Q Y
W !!?5,"DENIAL REASON/OPTIONS ALREADY SELECTED. Need to select another.",!!
Q 1
;
REAOPT ; Primary Reason Option
S Y=+$$DICOPT(BMCENR,"Primary ")
I BMCOPTR="E" Q:+Y<0 G REAOPT:$$OPTCK("P")
I +Y<0,(BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(ACHSDREA["Indian") W !,"Must select an option for this Denial Reason." G REAOPT
S BMCROPT=+Y
I Y>0 S DA=BMCRIEN,DIE="^BMCREF(" D PRMSET,PRMOSET
Q
PRMSET ;PRIMARY DENIAL REASON SET
S DR="1114////"_BMCENR
D ^DIE
K DR
Q
PRMOSET ;
S DR="6120///"_BMCROPT
D ^DIE
K DA,DIE,DR
Q
OTHSET ;SET OTHER DENIAL REASON - NODE 43
S (DIC,DIE)="^BMCREF("_BMCRIEN_",43,"
S DIC(0)="L",DA(1)=BMCRIEN,DA=BMCORNM
S DR=".01_///"_X
D ^DIE
K DIE,DA,DR
Q
OPTSET ;SET OPTION FOR OTHER DENIAL REASON NODE 43
;ask for option
S Y=$$DICOPT(BMCOTR,"Other ")
I $D(DUOUT),BMCOPTR'="E" S X="@" D OTHSET Q
I $D(DUOUT),BMCOPTR="E" D Q
.;TEST FOR REASONS REQ AN OPTION, IF NONE SELECTED DELETE
.I (BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(BMCOREO["Indian") D
..S BMCROPT=$P(^BMCREF(BMCRIEN,43,BMCORNM,0),U,2)
..I BMCROPT="" S X="@" D OTHSET Q
G OPTSET:$$OPTCK("O") ;TEST FOR USING SAME OPT
I +Y<0,(BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(BMCOREO["Indian") W !,"Must select an option for this Denial Reason." G OPTSET
I +Y<0 Q
S (DIC,DIE)="^BMCREF("_BMCRIEN_",43,"
S DIC(0)="L",DA(1)=BMCRIEN,DA=BMCORNM
S DR=".02///"_+Y
D ^DIE
S BMCROPT=$P(^BMCREF(BMCRIEN,43,BMCORNM,0),U,2)
K DA,DIE
Q
;
DICOPT(X,R) ; --- Select Denial reason Option.
I '$D(^ACHSDENS(X,20,0)) Q -1
;DISPLAY REA OPTIONS
W !!?3,"Denial Reason Option list:"
S X1=0,CT=0
F S X1=$O(^ACHSDENS(X,20,X1)) Q:X1'?1N.N D
.I $P(^ACHSDENS(X,20,X1,0),U,2)'="",$P(^(0),U,2)<DT Q
.S CT=CT+1 W !?5,CT,". ",$P(^ACHSDENS(X,20,X1,0),U)
.S BMCENO(CT)=X1_U_$P(^ACHSDENS(X,20,X1,0),U)
I CT=0 W !,"No active Denial Reasons Options" S Y=-1 Q
W !
S DIR(0)="NO^1:"_CT
S DIR("A")="Enter "_$G(R)_"Denial Reason Option "
D ^DIR
I +Y>0 S Y=BMCENO(Y)
E S Y=-1
K BMCENO
Q +Y
;
OPTCK(T) ; CHECK FOR OPTIONS ALREADY SELECTED ;ACHS*3.1*19 NEW SECTION
S (X,X1)=0
I T="O",$P(^BMCREF(BMCRIEN,11),U,14)=BMCOTR,$P(^BMCREF(BMCRIEN,61),U,20)=+Y W !!,*7,*7,"DENIAL REASON OPTION ALREADY SELECTED.",!! S X1=1 H 1 Q X1
F S X=$O(^BMCREF(BMCRIEN,43,X)) Q:+X=0 D Q:X1
.I BMCOPTR="E",X=BMCORNM Q
.Q:$P($G(^BMCREF(BMCRIEN,43,X,0)),U)'=BMCOTR
.I $P($G(^BMCREF(BMCRIEN,43,X,0)),U,2)=+Y W !!,*7,*7,"DENIAL REASON OPTION ALREADY SELECTED.....",!! S X1=1 H 1
Q X1
;
ADD ;ADD OTHER DENIAL REASON
S BMCOPTR="N"
D REA
Q:+Y<1
;I BMCCNT=1 ADD PRIMARY REASON AND DO NOT NEED TO CHECK for duplicates
I BMCR["Primary" S BMCENR=+Y D REAOPT Q
;I BMCCNT>1 ADD OTHER REASON AND NEED TO CHECK FOR DUPLICATES
S BMCOTR=+Y
S BMCOREO=$P($G(^ACHSDENS(BMCOTR,0)),U)
G ADD:$$REASCK()
;I '$D(^BMCREF(BMCRIEN,43,0)) D
S DIC="^BMCREF("_BMCRIEN_",43,"
S DIC("P")=$P(^DD(90001,4300,0),U,2)
S DIC(0)="L",DA(1)=BMCRIEN,X=BMCOTR
S DIC("DR")=".01///"_X
D FILE^BMCFMC S BMCORNM=+Y
D:+Y>0 OPTSET
Q
;
BMCCHSE ;IHS/OIT/FCJ - CHS EDIT INFORMATION
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**8**;JAN 09, 2006;Build 101
+2 ;
+3 ;IHS.OIT.FCJ; NEW RTN IN PATCH 8 TO ALLOW ADDING CHS DENIAL REASONS
+4 ;
+5 ;
DENR ;ENTRY POINT FROM BMCMOD
+1 ;
TOF ;
+1 ;S BMCRIEN=113239
+2 SET BMCOPTR="E"
+3 WRITE @IOF,$$REPEAT^XLFSTR("=",79),!?30,"DENIAL REASONS EDIT",!,$$REPEAT^XLFSTR("=",79),!!,"PRIMARY DENIAL REASON: ",!
PRIREAS ; PRIMARY REASON
+1 SET X=$PIECE($GET(^BMCREF(BMCRIEN,11)),U,14)
SET X1=$PIECE($GET(^BMCREF(BMCRIEN,61)),U,20)
+2 SET BMCREA(1)=U_X_U_X1
+3 IF X
IF $DATA(^ACHSDENS(X,0))
Begin DoDot:1
+4 WRITE !?10,"1. ",$PIECE($GET(^ACHSDENS(X,0)),U),!
+5 IF X1
WRITE ?15,$PIECE($GET(^ACHSDENS(X,20,X1,0)),U)
End DoDot:1
+6 IF '$TEST
WRITE !!,*7,*7,"No Primary Denial Reason Has Been Entered"
SET BMCRED=""
SET BMCOPTR="N"
SET %=1
SET BMCR="Primary "
DO PRIM
GOTO TOF
+7 ;
OTHREAS ; List other Denial Reasons
+1 IF $DATA(^BMCREF(BMCRIEN,43))
Begin DoDot:1
+2 SET BMCREA=0
SET BMCCNT=2
+3 FOR
SET BMCREA=$ORDER(^BMCREF(BMCRIEN,43,BMCREA))
IF BMCREA'?1.N
QUIT
Begin DoDot:2
+4 IF BMCCNT=2
WRITE !!,"OTHER DENIAL REASONS: ",!
+5 SET BMCOTR=$PIECE(^BMCREF(BMCRIEN,43,BMCREA,0),U)
SET BMCROPT=$PIECE(^(0),U,2)
+6 WRITE !?10,BMCCNT,". ",$PIECE($GET(^ACHSDENS(BMCOTR,0)),U),!
+7 IF BMCROPT
WRITE ?15,$PIECE($GET(^ACHSDENS(BMCOTR,20,BMCROPT,0)),U)
+8 SET BMCREA(BMCCNT)=BMCREA_U_BMCOTR_U_BMCROPT
+9 SET BMCCNT=BMCCNT+1
End DoDot:2
End DoDot:1
+10 ;
EDIT ; EDIT REASONS
+1 ;
+2 SET %=$$DIR^ACHS("FO","Enter Number Of Reason To Edit, 'A' To ADD Reason","","","",2)
+3 IF (%="")!$DATA(DUOUT)!$DATA(DTOUT)
DO END
QUIT
+4 SET Y=+%
SET %=$SELECT(+%=1:"PRIM","Aa"[%:"ADD",1:"OTHER")
+5 IF (Y>BMCCNT)!((%="OTHER")&('$DATA(BMCREA(Y))))
WRITE !,"Please enter a number from 1 to ",BMCCNT,"."
GOTO EDIT
+6 SET BMCRED=+Y
SET BMCR=$SELECT(%=1:"Primary",1:"Other ")
+7 DO @%
+8 KILL BMCREA
GOTO TOF
+9 ;
END ;
+1 KILL BMCREA,TMP,BMCCNT,BMCDEN
+2 KILL BMCENR,BMCENS,BMCOPTR,BMCOREO,BMCORNM,BMCOTR,BMCR,BMCRED,BMCREDT,CT,L
+3 QUIT
+4 ;
PRIM ;
+1 DO REA
IF $DATA(DUOUT)
QUIT
+2 IF X="@"
WRITE !!?5,"Must have a Primary Denial Reason."
HANG 1
QUIT
+3 ;EDITING REASON THEN CHECK TO SEE IF DUPLICATE
+4 SET (X,BMCOTR,BMCENR)=+Y
+5 IF BMCRED
SET BMCORNM=$PIECE(BMCREA(BMCRED),U)
+6 SET BMCOREO=$PIECE($GET(^ACHSDENS(BMCOTR,0)),U)
+7 IF BMCRED
IF BMCOTR'=$PIECE(BMCREA(BMCRED),U,2)
IF $$REASCK()
GOTO PRIM
SET BMCENR=+Y
+8 IF $DATA(DUOUT)
QUIT
+9 DO REAOPT
+10 IF $DATA(Y)
IF +Y<0
WRITE !?5,"Denial Option did not change."
HANG 1
+11 QUIT
+12 ;
OTHER ;EDIT OTHER DENIAL REASON
+1 DO REA
IF $DATA(DUOUT)
QUIT
+2 SET BMCORNM=$PIECE(BMCREA(BMCRED),U)
+3 ;THEN DELETE ENTRY...
IF X="@"
DO OTHSET
QUIT
+4 ;I EDITING REASON THEN CHECK TO SEE IF DUPLICATE
+5 SET (X,BMCOTR)=+Y
+6 SET BMCOREO=$PIECE($GET(^ACHSDENS(BMCOTR,0)),U)
+7 IF BMCOTR'=$PIECE(BMCREA(BMCRED),U,2)
IF $$REASCK()
GOTO OTHER
DO OTHSET
+8 DO OPTSET
+9 QUIT
+10 ;
REA ; Denial Reason
+1 SET X=0
SET CT=0
SET BMCREDT=""
+2 WRITE !!?3,"Denial Reason List:"
+3 FOR
SET X=$ORDER(^ACHSDENS(X))
IF X'?1N.N
QUIT
Begin DoDot:1
+4 IF $DATA(^ACHSDENS(X,10))
IF $PIECE(^ACHSDENS(X,10),U)>""
IF $PIECE(^ACHSDENS(X,10),U)<DT
QUIT
+5 SET CT=CT+1
WRITE !?5,CT,". ",$PIECE(^ACHSDENS(X,0),U)
+6 SET BMCENS(CT)=X_U_$PIECE(^ACHSDENS(X,0),U)
+7 IF BMCRED
IF X=$PIECE($GET(BMCREA(BMCRED)),U,2)
SET BMCREDT=CT
End DoDot:1
+8 IF CT=0
WRITE !,"No active Denial Reasons"
SET Y=-1
QUIT
+9 WRITE !
+10 SET BMCDEN=""
IF BMCRED>0
SET BMCDEN=$PIECE(^ACHSDENS($PIECE(BMCREA(BMCRED),U,2),0),U)
+11 SET DIR(0)="NO^1:"_CT
+12 SET DIR("A")="Enter "_BMCR_" Denial Reason: "_BMCDEN
+13 SET DIR("B")=BMCREDT
+14 DO ^DIR
+15 IF $DATA(DUOUT)
QUIT
+16 SET TMP=""
+17 IF +Y>0
SET TMP=BMCENS(Y)
+18 IF BMCR["Other"
IF +Y>0
IF Y'=BMCREDT
IF BMCCNT>1
IF %="OTHER"
SET X="@"
SET BMCORNM=$PIECE(BMCREA(BMCRED),U)
Begin DoDot:1
+19 DO OTHSET
+20 IF $PIECE(^BMCREF(BMCRIEN,43,0),U,4)<1
SET $PIECE(^(0),U,3,4)="1^1"
End DoDot:1
+21 IF TMP
SET Y=TMP
+22 KILL DIR
+23 QUIT
REASCK() ; --- Check if the Denial reason has already been entered.
+1 NEW X,X1,Y
+2 SET (X,X1,Y)=0
+3 ;X1=TOTAL OPTIONS AVAILABLE;X=TOTAL REASON OR OPTIONS USED
+4 FOR
SET X=$ORDER(^ACHSDENS(BMCOTR,20,X))
IF X'?1N.N
QUIT
Begin DoDot:1
+5 IF $PIECE(^ACHSDENS(BMCOTR,20,X,0),U,2)'=""
IF $PIECE(^(0),U,2)<DT
QUIT
+6 SET X1=X1+1
End DoDot:1
+7 ;I X1=0 NO OPTION AVAILABLE JUST USING REASON
+8 IF X1<2
IF BMCOTR=$PIECE(^BMCREF(BMCRIEN,11),U,14)
IF BMCOPTR="N"
WRITE !!,*7,*7,"DENIAL REASON/OPTIONS ALREADY SELECTED.",!!
QUIT 1
+9 SET X=0
IF BMCOTR=$PIECE(^BMCREF(BMCRIEN,11),U,14)
SET X=X+1
+10 IF $DATA(^BMCREF(BMCRIEN,43))
SET L=0
FOR
SET L=$ORDER(^BMCREF(BMCRIEN,43,L))
IF L'?1N.N
QUIT
Begin DoDot:1
+11 IF $PIECE(^BMCREF(BMCRIEN,43,L,0),U)=BMCOTR
SET X=X+1
End DoDot:1
+12 IF X<X1
QUIT Y
+13 WRITE !!?5,"DENIAL REASON/OPTIONS ALREADY SELECTED. Need to select another.",!!
+14 QUIT 1
+15 ;
REAOPT ; Primary Reason Option
+1 SET Y=+$$DICOPT(BMCENR,"Primary ")
+2 IF BMCOPTR="E"
IF +Y<0
QUIT
IF $$OPTCK("P")
GOTO REAOPT
+3 IF +Y<0
IF (BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(ACHSDREA["Indian")
WRITE !,"Must select an option for this Denial Reason."
GOTO REAOPT
+4 SET BMCROPT=+Y
+5 IF Y>0
SET DA=BMCRIEN
SET DIE="^BMCREF("
DO PRMSET
DO PRMOSET
+6 QUIT
PRMSET ;PRIMARY DENIAL REASON SET
+1 SET DR="1114////"_BMCENR
+2 DO ^DIE
+3 KILL DR
+4 QUIT
PRMOSET ;
+1 SET DR="6120///"_BMCROPT
+2 DO ^DIE
+3 KILL DA,DIE,DR
+4 QUIT
OTHSET ;SET OTHER DENIAL REASON - NODE 43
+1 SET (DIC,DIE)="^BMCREF("_BMCRIEN_",43,"
+2 SET DIC(0)="L"
SET DA(1)=BMCRIEN
SET DA=BMCORNM
+3 SET DR=".01_///"_X
+4 DO ^DIE
+5 KILL DIE,DA,DR
+6 QUIT
OPTSET ;SET OPTION FOR OTHER DENIAL REASON NODE 43
+1 ;ask for option
+2 SET Y=$$DICOPT(BMCOTR,"Other ")
+3 IF $DATA(DUOUT)
IF BMCOPTR'="E"
SET X="@"
DO OTHSET
QUIT
+4 IF $DATA(DUOUT)
IF BMCOPTR="E"
Begin DoDot:1
+5 ;TEST FOR REASONS REQ AN OPTION, IF NONE SELECTED DELETE
+6 IF (BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(BMCOREO["Indian")
Begin DoDot:2
+7 SET BMCROPT=$PIECE(^BMCREF(BMCRIEN,43,BMCORNM,0),U,2)
+8 IF BMCROPT=""
SET X="@"
DO OTHSET
QUIT
End DoDot:2
End DoDot:1
QUIT
+9 ;TEST FOR USING SAME OPT
IF $$OPTCK("O")
GOTO OPTSET
+10 IF +Y<0
IF (BMCOREO["Residency")!(BMCOREO["Notification")!(BMCOREO["Alternate")!(BMCOREO["Medical")!(BMCOREO["Indian")
WRITE !,"Must select an option for this Denial Reason."
GOTO OPTSET
+11 IF +Y<0
QUIT
+12 SET (DIC,DIE)="^BMCREF("_BMCRIEN_",43,"
+13 SET DIC(0)="L"
SET DA(1)=BMCRIEN
SET DA=BMCORNM
+14 SET DR=".02///"_+Y
+15 DO ^DIE
+16 SET BMCROPT=$PIECE(^BMCREF(BMCRIEN,43,BMCORNM,0),U,2)
+17 KILL DA,DIE
+18 QUIT
+19 ;
DICOPT(X,R) ; --- Select Denial reason Option.
+1 IF '$DATA(^ACHSDENS(X,20,0))
QUIT -1
+2 ;DISPLAY REA OPTIONS
+3 WRITE !!?3,"Denial Reason Option list:"
+4 SET X1=0
SET CT=0
+5 FOR
SET X1=$ORDER(^ACHSDENS(X,20,X1))
IF X1'?1N.N
QUIT
Begin DoDot:1
+6 IF $PIECE(^ACHSDENS(X,20,X1,0),U,2)'=""
IF $PIECE(^(0),U,2)<DT
QUIT
+7 SET CT=CT+1
WRITE !?5,CT,". ",$PIECE(^ACHSDENS(X,20,X1,0),U)
+8 SET BMCENO(CT)=X1_U_$PIECE(^ACHSDENS(X,20,X1,0),U)
End DoDot:1
+9 IF CT=0
WRITE !,"No active Denial Reasons Options"
SET Y=-1
QUIT
+10 WRITE !
+11 SET DIR(0)="NO^1:"_CT
+12 SET DIR("A")="Enter "_$GET(R)_"Denial Reason Option "
+13 DO ^DIR
+14 IF +Y>0
SET Y=BMCENO(Y)
+15 IF '$TEST
SET Y=-1
+16 KILL BMCENO
+17 QUIT +Y
+18 ;
OPTCK(T) ; CHECK FOR OPTIONS ALREADY SELECTED ;ACHS*3.1*19 NEW SECTION
+1 SET (X,X1)=0
+2 IF T="O"
IF $PIECE(^BMCREF(BMCRIEN,11),U,14)=BMCOTR
IF $PIECE(^BMCREF(BMCRIEN,61),U,20)=+Y
WRITE !!,*7,*7,"DENIAL REASON OPTION ALREADY SELECTED.",!!
SET X1=1
HANG 1
QUIT X1
+3 FOR
SET X=$ORDER(^BMCREF(BMCRIEN,43,X))
IF +X=0
QUIT
Begin DoDot:1
+4 IF BMCOPTR="E"
IF X=BMCORNM
QUIT
+5 IF $PIECE($GET(^BMCREF(BMCRIEN,43,X,0)),U)'=BMCOTR
QUIT
+6 IF $PIECE($GET(^BMCREF(BMCRIEN,43,X,0)),U,2)=+Y
WRITE !!,*7,*7,"DENIAL REASON OPTION ALREADY SELECTED.....",!!
SET X1=1
HANG 1
End DoDot:1
IF X1
QUIT
+7 QUIT X1
+8 ;
ADD ;ADD OTHER DENIAL REASON
+1 SET BMCOPTR="N"
+2 DO REA
+3 IF +Y<1
QUIT
+4 ;I BMCCNT=1 ADD PRIMARY REASON AND DO NOT NEED TO CHECK for duplicates
+5 IF BMCR["Primary"
SET BMCENR=+Y
DO REAOPT
QUIT
+6 ;I BMCCNT>1 ADD OTHER REASON AND NEED TO CHECK FOR DUPLICATES
+7 SET BMCOTR=+Y
+8 SET BMCOREO=$PIECE($GET(^ACHSDENS(BMCOTR,0)),U)
+9 IF $$REASCK()
GOTO ADD
+10 ;I '$D(^BMCREF(BMCRIEN,43,0)) D
+11 SET DIC="^BMCREF("_BMCRIEN_",43,"
+12 SET DIC("P")=$PIECE(^DD(90001,4300,0),U,2)
+13 SET DIC(0)="L"
SET DA(1)=BMCRIEN
SET X=BMCOTR
+14 SET DIC("DR")=".01///"_X
+15 DO FILE^BMCFMC
SET BMCORNM=+Y
+16 IF +Y>0
DO OPTSET
+17 QUIT
+18 ;
