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

BLREXECU.m

Go to the documentation of this file. 
  1. BLREXECU ;IHS/ITSC/TPF - IHS EXECUTE CODES ; 22-Oct-2013 09:22 ; MKK
  1.  ;;5.2;LR;**1016,1017,1018,1022,1033**;NOV 01, 1997
  1.  ;;
  1. GETDNAM(NAME) ;
  1.  S DNAME=$O(^DD(63.04,"B",NAME,0))
  1.  Q:DNAME="" "NULL"
  1.  Q DNAME
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1. GETDNAMT(NAME) ; EP - Get DataName from File 60 Test
  1.  NEW F60IEN
  1.  S F60IEN=+$$FIND1^DIC(60,,,NAME)
  1.  Q:F60IEN<1 "NULL"
  1.  ;
  1.  S DNAME=+$$GET1^DIQ(60,F60IEN_",",400,"I")
  1.  ;
  1.  Q $S(DNAME:DNAME,1:"NULL")
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  ;GET RACE OF PATIENT; DEFINED AS BLACK OR NON-BLACK PER DR. NARVA'S
  1.  ;APPLICATION OF THE GFR CALCULATION
  1. RACE(DFN) ;
  1.  S RACEPTR=$P($G(^DPT(DFN,0)),U,6)
  1.  Q:RACEPTR="" "N"  ;IF NO ENTRY CONSIDER NON-BLACK PER DR. NARVA
  1.  S RACEENT=$P($G(^DIC(10,RACEPTR,0)),U)
  1.  Q:RACEENT[("BLACK") "B"  ;IF NAME FIELD  CONTAINS BLACK RACE= BLACK
  1.  Q "N"  ;OTHERWISE NON-BLACK
  1. GFRDEL(CRET) ;
  1.  ;NOW THAT WE HAVE A CREATININE RESULT CHECK VARIABLES NEEDED FOR GFR
  1.  ;CALCULATION
  1.  Q:$G(CRET)="" ""
  1.  N BLRERR
  1.  S BLRERR="N/A"
  1.  ;FOLLOWING LINE ADDED TO HANDLE CANCELS ETC IHS/ITSC/TPF 7/1/03 **1017*
  1.  I $G(CRET)?1A.A S %X=BLRERR Q %X
  1.  ;FOLLOWING LINE ADDED TO HANDLE ERRORS SENT BY SOME INSTRUMENTS
  1.  ;FOR INSTANCE "#########" AS OUT OF RANGE
  1.  I $E($G(CRET))="#" S %X=BLRERR Q %X
  1.  I $E($G(CRET))="<" S %X=BLRERR Q %X  ;IHS/ITSC/TPF 02/23/2004 ADDED FOR VTROS RESULTS WITH "<" AND "<" INCLUDED
  1.  I $E($G(CRET))="-" S %X=BLRERR Q %X  ;IHS/ITSC/MKK 11/18/2004 ADDED FOR NEGATIVE RESULTS
  1.  I +$G(CRET)=0 S %X=BLRERR Q %X  ;IHS/ITSC/MKK 11/18/2004 ADDED FOR ZERO RESULTS
  1.  I AGE["DYS"!(AGE["MOS") S %X=BLRERR Q %X
  1.  I AGE<17 S %X=BLRERR Q %X  ;16 AND YOUNGER NOT DONE
  1.  I SEX="" S %X=BLRERR Q %X  ;CANNOT CALCULATE WITHOUT SEX
  1.  ;
  1.  ;CONSTANTS, EXPONENTS
  1.  S SEXFACTR=$S(SEX="M":1,1:.742)             ;SEX FACTOR
  1.  ;
  1.  ; S RACEFACT=$S($$RACE(DFN)="B":1.21,1:1)     ;RACE FACTOR
  1.  ; ----- BEGIN IHS/OIT/MKK - Modifications -- 1022
  1.  ; NOTE: the DFN is the Patient Pointer from the ^LR global
  1.  ;
  1.  ; If DFN is NOT null, then calculate Race Factor
  1.  I $G(DFN)'="" S RACEFACT=$S($$RACE(DFN)="B":1.21,1:1)     ;RACE FACTOR
  1.  ;
  1.  ; If DFN IS null, try to set temporary variable to Patient Pointer
  1.  ; using LRDFN.  If it can be set, then use that to caculate the
  1.  ; Race Factor.
  1.  NEW TMPVAR
  1.  I $G(DFN)="" D
  1.  . I $G(LRDFN)'="" S TMPVAR=$P($G(^LR(LRDFN,0)),"^",3)
  1.  . I $G(TMPVAR)'="" S RACEFACT=$S($$RACE(TMPVAR)="B":1.21,1:1)     ;RACE FACTOR
  1.  ;
  1.  ; If RACEFACT still not set, default is Non-Black, per Dr. Narva
  1.  I $G(RACEFACT)="" S RACEFACT=1
  1.  ; ----- END IHS/OIT/MKK - Modifications -- 1022
  1.  ; 
  1.  S CONSTA=186       ;CONSTANT A
  1.  S CRETEXP=-1.154   ;CREATININE EXPONENT
  1.  S AGEEXP=-.203     ;AGE EXPONENT
  1.  ;
  1.  ;
  1.  ;FORMULA BELOW IS ON PAGE 10 OF WEB PAGE
  1.  ;HTTP://WWW.KIDNEY.ORG/PROFESSIONALS/DOQI/KDOQI/P5_LAB_G4.HTM
  1.  ;AND IS REFERENCED BY DR. NARVA IN HIS CORRSPONDENCE
  1.  S %X=CONSTA*(CRET**CRETEXP)*(AGE**AGEEXP)*$G(SEXFACTR)*$G(RACEFACT)
  1.  ;
  1.  S %X=$TR($FN(%X,"",0)," ")          ;ROUND RESULT
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - Modifications -- 1022
  1.  ; Change requested by Lab PSG
  1.  ; See www.nkdep.nih.gov/resources/laboratory_reporting.htm
  1.  I %X>60 S %X=">60"
  1.  ; ----- END IHS/OIT/MKK - Modifications -- 1022
  1.  ;
  1.  Q %X