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

LREGFR2.m

Go to the documentation of this file. 
  1. LREGFR2 ;DALOI/SDV/AH/GDU Calculate Creatinine-eGFR ;Feb 2, 2004
  1.  ;;5.2;LAB SERVICE;**1031**;NOV 1, 1997
  1.  ;
  1.  ;;VA LR Patche(s): 377
  1.  ;
  1.  ; Reference to EN^DDIOL supported by IA #10142
  1.  ; Reference to $$GET1^DIQ supported by IA #2056
  1.  ; Reference to DEM^VADPT supported by IA # 10061
  1.  ; 
  1.  ; This routine is a delta check for the lab test eGFR called by delta
  1.  ; check CREATININE-EGFR. The eGFR test is calculated.
  1.  ;
  1.  ; Provided Data
  1.  ;   DOB - Patient's date of birth
  1.  ; LRDFN - entry in LAB DATA file
  1.  ; LRIDT - inverse date/time of entry in LAB DATA file
  1.  ;  LRNG - variable containing normals/units and delta check 
  1.  ;  LRSB - dataname for creatinine result
  1.  ;
  1. STRT(DFN,LRTR) ; Start Processing the Routine
  1.  ; Call with DFN = parent file ien
  1.  ;          LRTR = serum creatinine value as mg/dl
  1.  ;
  1.  ; Do not calculate eGFR if called from group data review.
  1.  I $D(LRGVP) Q
  1.  ;
  1.  N AGE,LRTN,LRDC,LRRC,LRX,LRY,SEX,X,Y
  1.  ;
  1.  ; Determine test to store eFGR
  1.  S LRDC=$P(LRNG,"^",8),LRY=""
  1.  S LRX=$$GET1^DIQ(62.1,LRDC_",",61.1,"I")
  1.  I LRX S LRY=$$GET1^DIQ(60,LRX_",",5,"I")
  1.  S LRTN=$P(LRY,";",2)
  1.  I LRTN="" D  Q
  1.  . D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Delta check not configured**")
  1.  ;
  1.  ; Quit if creatinine unchanged and eGFR already calculated and not 'pending'.
  1.  I $P($G(LRSB(LRSB)),"^")=LRTR,$P($G(LRSB(LRTN)),"^")'="",$P(LRSB(LRTN),"^")'="pending" Q
  1.  ;
  1.  ; Check for eGFR dataname in test editing profile.
  1.  ; If creatinine changed and eGFR previously calculated then warn.
  1.  I '$D(^TMP("LR",$J,"TMP",LRTN)) D  Q
  1.  . I $P($G(LRSB(LRSB)),"^")=LRTR Q
  1.  . I $P($G(^LR(LRDFN,"CH",LRIDT,LRTN)),"^")'="" D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not in test editing profile - Creatinine Changed**")
  1.  ;
  1.  ; Calculate age based on specimen date/time
  1.  S AGE=""
  1.  I LRCDT,DOB S AGE=($$FMDIFF^XLFDT(LRCDT,DOB,1))\365.25
  1.  I 'AGE D  Q
  1.  . S $P(LRSB(LRTN),"^")="canc"
  1.  . D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Age Recorded**")
  1.  ;
  1.  S SEX=""
  1.  I LRDPF=2 S SEX=$P(VADM(5),U)
  1.  I LRDPF=67 S SEX=$$GET1^DIQ(67,DFN_",",.02,"I")
  1.  I SEX=""!("MF"'[SEX) D  Q
  1.  . S $P(LRSB(LRTN),"^")="canc"
  1.  . D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Sex Recorded**")
  1.  ;
  1.  ; Determine race
  1.  S LRRC=$$RACE(DFN)
  1.  ;
  1.  ; Compute eGFR return-value
  1.  ; Set user(DUZ) and site(DUZ(2) in case delta check calculated during
  1.  ; entry of reference lab results. 
  1.  I LRTR D
  1.  . N LREGFR,LRX,PRMT
  1.  . S LREGFR=175*(LRTR**-1.154)*(AGE**-.203)  ; Using a constant of 175. This is to support the updated creatinine methodology
  1.  . I SEX="F" S LREGFR=LREGFR*.742
  1.  . I LRRC=1 S LREGFR=LREGFR*1.21
  1.  . I 'LREGFR Q
  1.  . S LRX=+$$GET1^DID(63.04,LRTN,"","DECIMAL DEFAULT")
  1.  . S $P(LRSB(LRTN),"^")=$FN(LREGFR,"",LRX)
  1.  . S $P(LRSB(LRTN),"^",4)=$G(DUZ),$P(LRSB(LRTN),"^",9)=$G(DUZ(2))
  1.  . I LRRC="U" D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: Race unknown, if African American multiply result by 1.210")
  1.  Q
  1.  ;
  1.  ;
  1. RACE(DFN) ; Get Race
  1.  ;  Call with DFN = ien of PATIENT file (#2)
  1.  ;  Returns   XRC = 1 (African American)
  1.  ;                  0 (non African American)
  1.  ;                  U (unknown)
  1.  ;
  1.  N XA,XB,XC,XD,XE,XRC
  1.  S XA="BLACK",XB="AFRICAN",XC="HISPANIC,",XD="UNKNOWN",XE="DECLINED"
  1.  S XRC=""
  1.  ;
  1.  ; If patient from PATIENT file (#2).
  1.  I LRDPF=2 D
  1.  . N VADM
  1.  . D DEM^VADPT
  1.  . S XRC=$P($G(VADM(12,1)),U,2)
  1.  . S:XRC="" XRC=$P($G(VADM(8)),U,2)
  1.  ;
  1.  ; If patient from REFERRAL file (#67).
  1.  I LRDPF=67 D
  1.  . S XRC=$$GET1^DIQ(67,DFN_",",.06)
  1.  ;
  1.  ; If race not defined then set to unknown.
  1.  I XRC="" S XRC="U"
  1.  ;
  1.  ; If race contains "BLACK" or "AFRICAN" but not HISPANIC then return "1"
  1.  I XRC[XA!(XRC[XB) I XRC'[XC S XRC=1
  1.  ;
  1.  ; If unknown or declined then return "U"
  1.  I XRC[XD!(XRC[XE) S XRC="U"
  1.  ; If not unknown or African-American then return "0"
  1.  I XRC'=1,XRC'="U" S XRC=0
  1.  Q XRC
  1.  ;
  1.  ;*************************************************************
  1.  ;LR(E)stimated(G)lomerular(F)iltration(R)ate: LREGFR
  1.  ;LR(T)est(N)ame:            LRTN
  1.  ;        (R)esults:         LRTR
  1.  ;LR(R)ace:                  LRRC
  1.  ;
  1.  ;*************************************************************
  1.  ;*                      end of routine                       *
  1.  ;*************************************************************