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