BLREXEC2.m

BLREXEC2 ;IHS/OIT/MKK - IHS MDRD STUDY EQUATION EXECUTE CODES ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;IHS LABORATORY;**1025,1026,1033**;NOV 01, 1997

 ;

 ; Cloned from BLREXECU

 ;

 ; There are a total of four MDRD Study Equation tests in this file.

 ; 

 ;      Two are NON IDMS-Traceable MDRD Study Equation tests.

 ;      Two are IDMS-Traceable MDRD Study Equation tests.

 ; 

 ; Equations are from the National Kidney Disease website:

 ;               www.nkdep.nih.gov/resources

 ;

 ; IDMS-Traceable MDRD Study Equation 1 -- Conventional Units

GFRSE1CU(CRET) ; EP

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE1CU^BLREXEC2")

 D ENTRYAUD^BLRUTIL("GFRSE1CU^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 ;

 S %X=$$CHKERRS             ; Check for Errors

 I %X'="OK" Q %X            ; If NOT OK, quit with error

 ;

 NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 D SETVARS1                 ; Setup constants & exponents

 ;

 S %X=CONSTA*(CRET**CRETEXP)*(AGE**AGEEXP)*$G(SEXFACTR)*$G(RACEFACT)

 ;

 S %X=$TR($FN(%X,"",0)," ")          ;ROUND RESULT

 ;

 ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 I %X>60 S %X=">60"

 ;

 Q %X

 ;

CHKERRS() ; EP

 N BLRERR

 S BLRERR="N/A"

 ;

 I $TR($G(CRET)," ")="" Q BLRERR   ; If creatinine null, then quit

 ;

 ; If 1st character not numeric, then quit

 ; I $E($G(CRET))'?1N Q BLRERR

 I $G(CRET)?1A.A S %X=BLRERR Q %X  ; IHS/OIT/MKK - LR*5.2*1026

 ;

 ; Following lines added to handle errors sent by some instruments

 ; Quit if any are true

 I $E($G(CRET))="" Q BLRERR        ; If Null

 I $E($G(CRET))="#" Q BLRERR       ; Out of Range

 I $E($G(CRET))="<" Q BLRERR       ; Vitros results with "<"

 I ($G(CRET))="-" Q BLRERR         ; Negative results

 ;

 I +$G(CRET)=0 Q BLRERR            ; If zero results, then quit

 ;

 I AGE["DYS"!(AGE["MOS")!(AGE<17) Q BLRERR  ; 16 & younger not done, quit

 ;

 I SEX="" Q BLRERR                 ; Cannot calculate without SEX

 ;

 Q "OK"

 ;

SETVARS1 ; EP

 ;CONSTANTS, EXPONENTS

 S SEXFACTR=$S(SEX="M":1,1:.742)   ; Sex Factor

 ;

 S RACEFACT=$S($$RACE(DFN)="B":1.21,1:1)

 ;

 S CONSTA=186       ; CONSTANT A

 S CRETEXP=-1.154   ; CREATININE EXPONENT

 S AGEEXP=-.203     ; AGE EXPONENT

 ;

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVARS1^BLREXEC2")

 D ENTRYAUD^BLRUTIL("SETVARS1^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 Q

 ;

 ; Race of patient: defined as black or non-black

RACE(DFN) ; EP

 NEW RACEPTR,RACEENT

 ;

 S RACEPTR=$P($G(^DPT(+$G(DFN),0)),U,6)

 Q:RACEPTR="" "N"             ; If no entry, consider non-black

 ;

 S RACEENT=$P($G(^DIC(10,RACEPTR,0)),U)

 Q:RACEENT[("BLACK") "B"      ; If RACEENT contains BLACK => race = Black

 Q "N"                        ; otherwise, non-black

 ;

 ; IDMS-Traceable MDRD Study Equation 1 -- SI Units

GFRSE1SI(CRET) ; EP

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE1SI^BLREXEC2")

 D ENTRYAUD^BLRUTIL("GFRSE1SI^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 Q:$G(CRET)="" ""           ; If creatinine null, then quit

 ;

 S %X=$$CHKERRS             ; Check for Errors

 I %X'="OK" Q %X            ; If NOT OK, quit with error

 ;

 NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 D SETVARS1                 ; Setup constants & exponents

 ;

 S %X=CONSTA*((CRET/88.4)**CRETEXP)*(AGE**AGEEXP)*$G(SEXFACTR)*$G(RACEFACT)

 ;

 S %X=$TR($FN(%X,"",0)," ")          ;ROUND RESULT

 ;

 ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 I %X>60 S %X=">60"

 ;

 Q %X

 ;

 ; IDMS-Traceable MDRD Study Equation 2 -- Conventional units

 ; GFRSE2CU ; EP

GFRSE2CU(CRET) ; EP -- Added paramater -- IHS/OIT/MKK - LR*5.2*1026

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE2CU^BLREXEC2")

 D ENTRYAUD^BLRUTIL("GFRSE2CU^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 Q:$G(CRET)="" ""           ; If creatinine null, then quit

 ;

 S %X=$$CHKERRS             ; Check for Errors

 I %X'="OK" Q %X            ; If NOT OK, quit with error

 ;

 NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 D SETVARS2                 ; Setup constants & exponents

 ;

 S %X=CONSTA*(CRET**CRETEXP)*(AGE**AGEEXP)*$G(SEXFACTR)*$G(RACEFACT)

 ;

 S %X=$TR($FN(%X,"",0)," ")          ;ROUND RESULT

 ;

 ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 I %X>60 S %X=">60"

 ;

 Q %X

 ;

SETVARS2 ; EP

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVARS2^BLREXEC2")

 D ENTRYAUD^BLRUTIL("SETVARS2^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 ;CONSTANTS, EXPONENTS

 S SEXFACTR=$S($G(SEX)="M":1,1:.742)   ; Sex Factor

 ;

 S RACEFACT=$S($$RACE($G(DFN))="B":1.21,1:1)

 ;

 S CONSTA=175       ; CONSTANT A

 S CRETEXP=-1.154   ; CREATININE EXPONENT

 S AGEEXP=-.203     ; AGE EXPONENT

 ;

 Q

 ;

 ; IDMS-Traceable MDRD Study Equation 2 -- SI units

 ; GFRSE2SI ; EP

GFRSE2SI(CRET) ; EP -- Added paramater -- IHS/OIT/MKK - LR*5.2*1026

 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE2SI^BLREXEC2")

 D ENTRYAUD^BLRUTIL("GFRSE2SI^BLREXEC2")  ; IHS/OIT/MKK - LR*5.2*1033

 Q:$G(CRET)="" ""           ; If creatinine null, then quit

 ;

 S %X=$$CHKERRS             ; Check for Errors

 I %X'="OK" Q %X            ; If NOT OK, quit with error

 ;

 NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 D SETVARS2                 ; Setup constants & exponents

 ;

 S %X=CONSTA*((CRET/88.4)**CRETEXP)*(AGE**AGEEXP)*$G(SEXFACTR)*$G(RACEFACT)

 ;

 S %X=$TR($FN(%X,"",0)," ")          ;ROUND RESULT

 ;

 ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 I %X>60 S %X=">60"

 ;

 Q %X

 ;

 ; Get the Data Name of the test

GETDNAM(NAME) ; EP

 S DNAME=$O(^DD(63.04,"B",NAME,0))

 Q:DNAME="" "NULL"

 Q DNAME

BLREXEC2  ;IHS/OIT/MKK - IHS MDRD STUDY EQUATION EXECUTE CODES ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;IHS LABORATORY;**1025,1026,1033**;NOV 01, 1997

 +2       ;

 +3       ; Cloned from BLREXECU

 +4       ;

 +5       ; There are a total of four MDRD Study Equation tests in this file.

 +6       ; 

 +7       ;      Two are NON IDMS-Traceable MDRD Study Equation tests.

 +8       ;      Two are IDMS-Traceable MDRD Study Equation tests.

 +9       ; 

 +10      ; Equations are from the National Kidney Disease website:

 +11      ;               www.nkdep.nih.gov/resources

 +12      ;

 +13      ; IDMS-Traceable MDRD Study Equation 1 -- Conventional Units

GFRSE1CU(CRET) ; EP

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE1CU^BLREXEC2")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("GFRSE1CU^BLREXEC2")

 +3       ;

 +4       ; Check for Errors

           SET %X=$$CHKERRS

 +5       ; If NOT OK, quit with error

           IF %X'="OK"

               QUIT %X

 +6       ;

 +7        NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 +8       ; Setup constants & exponents

           DO SETVARS1

 +9       ;

 +10       SET %X=CONSTA*(CRET**CRETEXP)*(AGE**AGEEXP)*$GET(SEXFACTR)*$GET(RACEFACT)

 +11      ;

 +12      ;ROUND RESULT

           SET %X=$TRANSLATE($FNUMBER(%X,"",0)," ")

 +13      ;

 +14      ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 +15       IF %X>60

               SET %X=">60"

 +16      ;

 +17       QUIT %X

 +18      ;

CHKERRS() ; EP

 +1        NEW BLRERR

 +2        SET BLRERR="N/A"

 +3       ;

 +4       ; If creatinine null, then quit

           IF $TRANSLATE($GET(CRET)," ")=""

               QUIT BLRERR

 +5       ;

 +6       ; If 1st character not numeric, then quit

 +7       ; I $E($G(CRET))'?1N Q BLRERR

 +8       ; IHS/OIT/MKK - LR*5.2*1026

           IF $GET(CRET)?1A.A

               SET %X=BLRERR

               QUIT %X

 +9       ;

 +10      ; Following lines added to handle errors sent by some instruments

 +11      ; Quit if any are true

 +12      ; If Null

           IF $EXTRACT($GET(CRET))=""

               QUIT BLRERR

 +13      ; Out of Range

           IF $EXTRACT($GET(CRET))="#"

               QUIT BLRERR

 +14      ; Vitros results with "<"

           IF $EXTRACT($GET(CRET))="<"

               QUIT BLRERR

 +15      ; Negative results

           IF ($GET(CRET))="-"

               QUIT BLRERR

 +16      ;

 +17      ; If zero results, then quit

           IF +$GET(CRET)=0

               QUIT BLRERR

 +18      ;

 +19      ; 16 & younger not done, quit

           IF AGE["DYS"!(AGE["MOS")!(AGE<17)

               QUIT BLRERR

 +20      ;

 +21      ; Cannot calculate without SEX

           IF SEX=""

               QUIT BLRERR

 +22      ;

 +23       QUIT "OK"

 +24      ;

SETVARS1  ; EP

 +1       ;CONSTANTS, EXPONENTS

 +2       ; Sex Factor

           SET SEXFACTR=$SELECT(SEX="M":1,1:.742)

 +3       ;

 +4        SET RACEFACT=$SELECT($$RACE(DFN)="B":1.21,1:1)

 +5       ;

 +6       ; CONSTANT A

           SET CONSTA=186

 +7       ; CREATININE EXPONENT

           SET CRETEXP=-1.154

 +8       ; AGE EXPONENT

           SET AGEEXP=-.203

 +9       ;

 +10      ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVARS1^BLREXEC2")

 +11      ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("SETVARS1^BLREXEC2")

 +12       QUIT 

 +13      ;

 +14      ; Race of patient: defined as black or non-black

RACE(DFN) ; EP

 +1        NEW RACEPTR,RACEENT

 +2       ;

 +3        SET RACEPTR=$PIECE($GET(^DPT(+$GET(DFN),0)),U,6)

 +4       ; If no entry, consider non-black

           IF RACEPTR=""

               QUIT "N"

 +5       ;

 +6        SET RACEENT=$PIECE($GET(^DIC(10,RACEPTR,0)),U)

 +7       ; If RACEENT contains BLACK => race = Black

           IF RACEENT[("BLACK")

               QUIT "B"

 +8       ; otherwise, non-black

           QUIT "N"

 +9       ;

 +10      ; IDMS-Traceable MDRD Study Equation 1 -- SI Units

GFRSE1SI(CRET) ; EP

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE1SI^BLREXEC2")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("GFRSE1SI^BLREXEC2")

 +3       ; If creatinine null, then quit

           IF $GET(CRET)=""

               QUIT ""

 +4       ;

 +5       ; Check for Errors

           SET %X=$$CHKERRS

 +6       ; If NOT OK, quit with error

           IF %X'="OK"

               QUIT %X

 +7       ;

 +8        NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 +9       ; Setup constants & exponents

           DO SETVARS1

 +10      ;

 +11       SET %X=CONSTA*((CRET/88.4)**CRETEXP)*(AGE**AGEEXP)*$GET(SEXFACTR)*$GET(RACEFACT)

 +12      ;

 +13      ;ROUND RESULT

           SET %X=$TRANSLATE($FNUMBER(%X,"",0)," ")

 +14      ;

 +15      ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 +16       IF %X>60

               SET %X=">60"

 +17      ;

 +18       QUIT %X

 +19      ;

 +20      ; IDMS-Traceable MDRD Study Equation 2 -- Conventional units

 +21      ; GFRSE2CU ; EP

GFRSE2CU(CRET) ; EP -- Added paramater -- IHS/OIT/MKK - LR*5.2*1026

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE2CU^BLREXEC2")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("GFRSE2CU^BLREXEC2")

 +3       ; If creatinine null, then quit

           IF $GET(CRET)=""

               QUIT ""

 +4       ;

 +5       ; Check for Errors

           SET %X=$$CHKERRS

 +6       ; If NOT OK, quit with error

           IF %X'="OK"

               QUIT %X

 +7       ;

 +8        NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 +9       ; Setup constants & exponents

           DO SETVARS2

 +10      ;

 +11       SET %X=CONSTA*(CRET**CRETEXP)*(AGE**AGEEXP)*$GET(SEXFACTR)*$GET(RACEFACT)

 +12      ;

 +13      ;ROUND RESULT

           SET %X=$TRANSLATE($FNUMBER(%X,"",0)," ")

 +14      ;

 +15      ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 +16       IF %X>60

               SET %X=">60"

 +17      ;

 +18       QUIT %X

 +19      ;

SETVARS2  ; EP

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("SETVARS2^BLREXEC2")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("SETVARS2^BLREXEC2")

 +3       ;CONSTANTS, EXPONENTS

 +4       ; Sex Factor

           SET SEXFACTR=$SELECT($GET(SEX)="M":1,1:.742)

 +5       ;

 +6        SET RACEFACT=$SELECT($$RACE($GET(DFN))="B":1.21,1:1)

 +7       ;

 +8       ; CONSTANT A

           SET CONSTA=175

 +9       ; CREATININE EXPONENT

           SET CRETEXP=-1.154

 +10      ; AGE EXPONENT

           SET AGEEXP=-.203

 +11      ;

 +12       QUIT 

 +13      ;

 +14      ; IDMS-Traceable MDRD Study Equation 2 -- SI units

 +15      ; GFRSE2SI ; EP

GFRSE2SI(CRET) ; EP -- Added paramater -- IHS/OIT/MKK - LR*5.2*1026

 +1       ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("GFRSE2SI^BLREXEC2")

 +2       ; IHS/OIT/MKK - LR*5.2*1033

           DO ENTRYAUD^BLRUTIL("GFRSE2SI^BLREXEC2")

 +3       ; If creatinine null, then quit

           IF $GET(CRET)=""

               QUIT ""

 +4       ;

 +5       ; Check for Errors

           SET %X=$$CHKERRS

 +6       ; If NOT OK, quit with error

           IF %X'="OK"

               QUIT %X

 +7       ;

 +8        NEW CONSTA,CRETEXP,AGEEXP,SEXFACTR,RACEFACT

 +9       ; Setup constants & exponents

           DO SETVARS2

 +10      ;

 +11       SET %X=CONSTA*((CRET/88.4)**CRETEXP)*(AGE**AGEEXP)*$GET(SEXFACTR)*$GET(RACEFACT)

 +12      ;

 +13      ;ROUND RESULT

           SET %X=$TRANSLATE($FNUMBER(%X,"",0)," ")

 +14      ;

 +15      ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm

 +16       IF %X>60

               SET %X=">60"

 +17      ;

 +18       QUIT %X

 +19      ;

 +20      ; Get the Data Name of the test

GETDNAM(NAME) ; EP

 +1        SET DNAME=$ORDER(^DD(63.04,"B",NAME,0))

 +2        IF DNAME=""

               QUIT "NULL"

 +3        QUIT DNAME