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

BMCCHSE.m

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