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

BLREXEC3.m

Go to the documentation of this file. 
  1. BLREXEC3 ;IHS/OIT/MKK - IHS Implementation of the Chronic Kidney Disease Epidemiology Collaboration (CKD-EPI) eGFR equation ; 13-Oct-2017 14:04 ;  MKK
  1.  ;;5.2;IHS LABORATORY;**1038,1041**;NOV 01, 1997;Build 23
  1.  ;
  1.  ; Equation and Warning are from the National Kidney Disease web-page (as of 12/21/2015):
  1.  ;      http://nkdep.nih.gov/lab-evaluation/gfr/estimating.shtml
  1.  ;
  1. EEP ; Ersatz EP
  1.  D EEP^BLRGMENU
  1.  Q
  1.  ;
  1.  ;
  1. CKDEPI(CRET) ; EP - Creatinine value is passed in
  1.  Q:+$G(CRET)'>0 ""    ; IHS/MSC/MKK - LR*5.2*1041 -- If CRET variable is not > 0, then return null.
  1.  ;
  1.  Q:(AGE<18) "N/A"    ; Cannot calculate if AGE < 18.
  1.  Q:(SEX="U") "N/A"   ; Cannot calculate if SEX is Undetermined/Unknown.
  1.  ;
  1.  S SEXFACTR=$S(SEX="F":1.018,1:1)
  1.  ;
  1.  S:$D(BLRTFLAG)<1 RACE=$$RACE(DFN)
  1.  ;
  1.  S RACEFACT=$S(RACE="B":1.159,1:1)
  1.  ;
  1.  S K=$S(SEX="F":.7,1:.9)
  1.  S ALPHA=$S(SEX="F":-.329,1:-.411)
  1.  ;
  1.  S CHKEPI=141*(($$MIN(CRET/K,1))**ALPHA)*(($$MAX(CRET/K,1))**-1.209)*(.993**AGE)*SEXFACTR*RACEFACT
  1.  ;
  1.  Q $FN(CHKEPI,"",2)  ; Round Result to 2 decimal places
  1.  ;
  1. MIN(VALUE,MIN) ; EP
  1.  Q $S(VALUE<MIN:VALUE,1:MIN)
  1.  ;
  1. MAX(VALUE,MAX) ; EP
  1.  Q $S(VALUE>MAX:VALUE,1:MAX)
  1.  ;
  1. RACE(DFN) ; EP - Race of patient: defined as black or non-black
  1.  NEW RACEPTR,RACEENT
  1.  ;
  1.  S RACEPTR=$P($G(^DPT(+$G(DFN),0)),U,6)
  1.  Q:RACEPTR="" "N"             ; If no entry, consider non-black
  1.  ;
  1.  S RACEENT=$P($G(^DIC(10,RACEPTR,0)),U)
  1.  Q:RACEENT[("BLACK") "B"      ; If RACEENT contains BLACK it implies race = Black
  1.  ;
  1.  Q "N"                        ; Default is non-black
  1.  ;
  1. TESTEQUA ; EP - Debug -- Allows user to TEST the equation
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  S (BLRTFLAG,ONGO)="YES"
  1.  S TAB=$J("",5),TAB2=TAB_TAB,TAB3=TAB_TAB_TAB
  1.  S HEADER(1)="IHS LAB"
  1.  S HEADER(2)="CKD-EPI Equation Testing"
  1.  ;
  1.  F  Q:ONGO'="YES"  D
  1.  . Q:$$GETSEX(.SEX)="Q"
  1.  . Q:$$GETAGE(.AGE)="Q"
  1.  . Q:$$GETRACE(.RACE,.FULLRACE)="Q"
  1.  . Q:$$GETCREAT(.CREATININE)="Q"
  1.  . ;
  1.  . D HEADERDT^BLRGMENU
  1.  . W !!,?9,"For SEX:",SEX,"; AGE:",AGE,"; RACE:",FULLRACE,!
  1.  . W ?13,"Creatinine:",CREATININE_" mg/dL"
  1.  . W !!,?14,"CKD-EPI Equation's Estimated GFR = ",$$CKDEPI(CREATININE),!!
  1.  . ;
  1.  . D ^XBFMK
  1.  . S DIR(0)="YO"
  1.  . S DIR("A")=TAB3_"Again"
  1.  . S DIR("B")="NO"
  1.  . D ^DIR
  1.  . S ONGO=$S(Y=1:"YES",1:"NO")
  1.  ;
  1.  Q
  1.  ;
  1. GETSEX(SEX) ; EP - Get Sex function
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="SO^1:F;2:M;3:U"
  1.  S DIR("L",1)=TAB_"Select Sex:"
  1.  S DIR("L",2)=TAB2_"1: FEMALE"
  1.  S DIR("L",3)=TAB2_"2: MALE"
  1.  S DIR("L",4)=TAB2_"3: UNKNOWN"
  1.  S DIR("L")=""
  1.  S DIR("A")=TAB3_"SEX"
  1.  D ^DIR
  1.  ;
  1.  I Y<1!(+$G(DIRUT)) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  I +X S SEX=$S(X=1:"F",X=2:"M",1:"U")
  1.  E  S SEX=$$UP^XLFSTR($E(X))
  1.  Q "OK"
  1.  ;
  1. GETAGE(AGE) ; EP - Age Function
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  W TAB,"Select Age:"
  1.  S DIR(0)="NO^18:150"
  1.  S DIR("A")=TAB3_"AGE"
  1.  D ^DIR
  1.  ;
  1.  I Y<1!(+$G(DIRUT)) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  S AGE=Y
  1.  Q "OK"
  1.  ;
  1. GETRACE(RACE,FULLRACE) ; EP - Race Function
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  W TAB,"Select Race:"
  1.  S DIR(0)="PO^10:EMZ"
  1.  S DIR("A")=TAB3_"RACE"
  1.  D ^DIR
  1.  ;
  1.  I Y<1!(+$G(DIRUT)) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  S FULLRACE=$P(Y,"^",2)
  1.  S RACE=$$UP^XLFSTR($E(FULLRACE))
  1.  Q "OK"
  1.  ;
  1. GETCREAT(CREATININE) ; EP - Creatinine function
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="NO^::2"
  1.  S DIR("A")=TAB3_"Enter Creatinine Value (mg/dL Units)"
  1.  D ^DIR
  1.  ;
  1.  I X=""!(+$G(DIRUT)) D GQMFDIRR  S ONGO="NO"  Q "Q"
  1.  ;
  1.  S CREATININE=+Y
  1.  Q "OK"
  1.  ;
  1.  ;
  1. NEWDELTA ; EP - Allows users to create new Delta Check utilizing the CKD-EPI function
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  D SETBLRVS("NEWDELTA")
  1.  ;
  1.  S HEADER(1)="IHS LAB"
  1.  S HEADER(2)="CKD-EPI Delta Check Creation"
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D ^XBFMK
  1.  S DIR(0)="PO^60:EMZ"
  1.  S DIR("A")="Test to hold CKD-EPI Results"
  1.  D ^DIR
  1.  I +$G(DIRUT) D GQMFDIRR  Q
  1.  ;
  1.  S F60PTR=+Y
  1.  S CKDEPI60=$P(Y,"^",2)
  1.  S CKDEPIDN=$$GET1^DIQ(60,F60PTR,"DATA NAME")
  1.  I $L(CKDEPIDN)<1 D BADSTUFF("Test "_CKDEPIDN_" has no DataName.")  Q
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="PO^60:EMZ"
  1.  S DIR("A")="Creatinine Test to use for CKD-EPI calculation"
  1.  D ^DIR
  1.  I +$G(DIRUT) D GQMFDIRR  Q
  1.  ;
  1.  S F60PTR=+Y
  1.  S CREAT60=$P(Y,"^",2)
  1.  S CREATDN=$$GET1^DIQ(60,F60PTR,"DATA NAME")
  1.  I $L(CREATDN)<1 D BADSTUFF("Test "_CREAT60_" has no DataName.")  Q
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Name of the Delta Check"
  1.  D ^DIR
  1.  I +$G(DIRUT) D GQMFDIRR  Q
  1.  ;
  1.  S NAME=$G(X)
  1.  ;
  1.  ; Make sure it's not a duplicate Delta Check Name
  1.  I +$O(^LAB(62.1,"B",NAME,0)) D BADSTUFF(NAME_" is a duplicate Delta Check Name.")  Q
  1.  ;
  1.  S XCODE="S %X="""" X:$D(LRDEL(1)) LRDEL(1) W:$G(%X)'="""" ""  CKD-EPI Calculated GFR:"",%X S:LRVRM>10 LRSB($$GETDNAM^BLREXEC2("""_CKDEPIDN_"""))=%X K %,%X,%Y,%Z,%ZZ"
  1.  S OVER1STR="S %ZZ=$$GETDNAM^BLREXEC2("""_CREAT60_""") X:LRVRM>10 ""F %=%ZZ S %X(%)=$S(%=LRSB:X,$D(LRSB(%)):+LRSB(%),1:0)"" X:LRVRM>10 ""F %=%ZZ S %X(%)=$S($D(LRSB(%)):LRSB(%),1:0)"""
  1.  S OVER1=OVER1STR_" S %X=$$CKDEPI^BLREXEC3(X)"
  1.  ;
  1.  S DESC(1)="This delta check, when added to a test named "
  1.  S DESC(2)="     "_$$LJ^XLFSTR(CREAT60,75)
  1.  S DESC(3)="will calculate an estimated Glomerular Filtration Rate (GFR)"
  1.  S DESC(4)="using the CKD-EPI equation."
  1.  S DESC(5)=" "
  1.  S DESC(6)="The CKD-EPI Equation's result will be stuffed into the test called"
  1.  S DESC(7)="     "_CKDEPI60
  1.  S DESC(8)=" "
  1.  ;
  1.  ; Warning
  1.  S DESC(9)="Creatinine-based estimating equations are not recommended for use with:"
  1.  S DESC(10)=" "
  1.  S DESC(11)="     Individuals with unstable creatinine concentrations. This includes"
  1.  S DESC(12)="     pregnant women; patients with serious co-morbid conditions; and"
  1.  S DESC(13)="     hospitalized patients, particularly those with acute renal failure."
  1.  S DESC(14)="     Creatinine-based estimating equations should be used only for"
  1.  S DESC(15)="     patients with stable creatinine concentrations."
  1.  S DESC(16)=" "
  1.  S DESC(17)="     Persons with extremes in muscle mass and diet. This includes, but"
  1.  S DESC(18)="     is not limited to, individuals who are amputees, paraplegics, body"
  1.  S DESC(19)="     builders, or obese; patients who have a muscle-wasting disease or"
  1.  S DESC(20)="     a neuromuscular disorder; and those suffering from malnutrition,"
  1.  S DESC(21)="     eating a vegetarian or low-meat diet, or taking creatine dietary"
  1.  S DESC(22)="     supplements."
  1.  ;
  1.  ;
  1.  D HEADERDT^BLRGMENU
  1.  ;
  1.  D DLTADICA(NAME,XCODE,OVER1,.DESC)
  1.  ;
  1.  D PRESSKEY^BLRGMENU(9)
  1.  Q
  1.  ;
  1. DLTADICA(NAME,XCODE,OVER1,DESC) ; EP
  1.  NEW DICT0,DICT1,FDA,ERRS,PTR
  1.  NEW HEREYAGO
  1.  ;
  1.  W !!,"Adding "_NAME_" to Delta Check Dictionary.",!
  1.  ;
  1.  D ^XBFMK
  1.  K ERRS,FDA,IENS,DIE
  1.  ; 
  1.  S DICT1="62.1"
  1.  S FDA(DICT1,"?+1,",.01)=NAME   ; Find the Name node, or create it.
  1.  S FDA(DICT1,"?+1,",10)=XCODE   ; Execute Code
  1.  S FDA(DICT1,"?+1,",20)=OVER1   ; Overflow 1
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . D BADSTUFF("Error in adding "_NAME_" to the Delta Check Dictionary.")
  1.  ;
  1.  W !,?5,NAME_" Delta Check added to Delta Check Dictionary.",!
  1.  ;
  1.  ; Now, add the Description
  1.  K ERRS
  1.  S PTR=$$FIND1^DIC(62.1,,,NAME)
  1.  M WPARRAY("WP")=DESC
  1.  D WP^DIE(62.1,PTR_",",30,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding DESCRIPTION to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  W !,?5,NAME_" Delta Check DESCRIPTION added to Delta Check Dictionary.",!
  1.  ;
  1.  ; Now, add the SITE NOTES DATE
  1.  K ERRS,FDA
  1.  S FDA(62.131,"?+1,"_PTR_",",.01)=$P($$NOW^XLFDT,".",1)
  1.  D UPDATE^DIE("S","FDA",,"ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding SITES NOTES DATE to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  ; Now, add the TEXT
  1.  K ERRS,WPARRAY
  1.  S WPARRAY("WP",1)="Created by "_$$GET1^DIQ(200,DUZ,"NAME")_"     DUZ:"_DUZ
  1.  D WP^DIE(62.131,"1,"_PTR_",",1,"K","WPARRAY(""WP"")","ERRS")
  1.  ;
  1.  I $D(ERRS("DIERR"))>0 D  Q
  1.  . W !!,"Error in adding TEXT to "_NAME_" Delta Check in the Delta Check Dictionary."
  1.  . D BADSTUFF("")
  1.  ;
  1.  W !,?5,NAME_" Delta Check TEXT added to Delta Check Dictionary."
  1.  Q
  1.  ;
  1.  ; ============================= UTILITIES =============================
  1.  ;
  1. JUSTNEW ; EP - Generic RPMS EXCLUSIVE NEW
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q
  1.  ;
  1. SETBLRVS(TWO) ; EP - Set the BLRVERN variable(s)
  1.  K BLRVERN,BLRVERN2
  1.  ;
  1.  S BLRVERN=$P($P($T(+1),";")," ")
  1.  S:$L($G(TWO)) BLRVERN2=$G(TWO)
  1.  Q
  1.  ;
  1. GQMFDIRR ; Generic "Quit" message for D ^DIR response
  1.  D BADSTUFF("No/Invalid/Quit Entry.")
  1.  Q
  1.  ;
  1. BADSTUFF(MSG,TAB) ; EP - Simple Message
  1.  S:+$G(TAB)<1 TAB=4
  1.  W !!,?TAB,$$TRIM^XLFSTR(MSG,"LR"," "),"  Routine Ends."
  1.  D PRESSKEY^BLRGMENU(TAB+5)
  1.  Q