LREGFR ;DALOI/STAFF - Calculate Creatinine-eGFR ;Nov 12, 2020@15:02
;;5.2;LAB SERVICE;**289,313,350,449,541**;Sep 27, 1994;Build 7
;
; 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,LRFLG,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
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Delta check not configured**") 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
. . I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not in test editing profile - Creatinine Changed**") Q
. . D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not in test editing profile - Creatinine Changed**")
;
; Calculate age based on specimen date/time
S AGE=""
; If no collection date/time then set from specimen LRIDT.
I $G(LRCDT)="" N LRCDT S LRCDT=$P(^LR(LRDFN,"CH",LRIDT,0),"^")
I LRCDT,DOB S AGE=($$FMDIFF^XLFDT(LRCDT,DOB,1))\365.25
I 'AGE D Q
. S $P(LRSB(LRTN),"^")="canc"
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Age Recorded**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Age Recorded**")
;
;LR*5.2*541: Erroneous collection date precedes patient's DOB
I AGE<0 D Q
. S $P(LRSB(LRTN),"^")="canc"
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Coll. Date Before Patient's DOB**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Coll. Date Before Patient's DOB**")
S LRFLG=0
I AGE<18!(AGE>70) S LRFLG=$$GET^XPAR("DIV^PKG","LR EGFR AGE CUTOFF",1,"Q")
I AGE<18,LRFLG?1(1"1",1"3") D Q
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age <18**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age <18**")
. S $P(LRSB(LRTN),"^")="canc"
I AGE>70,LRFLG>1 D Q
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age >70**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age >70**")
. S $P(LRSB(LRTN),"^")="canc"
;
S SEX=""
I LRDPF=2 S SEX=$P(VADM(5),U)
I LRDPF=67 S SEX=$$GET1^DIQ(67,DFN_",",.02,"I")
I LRDPF=67.1 S SEX=$$GET1^DIQ(67.1,DFN_",",2,"I")
I SEX=""!("MF"'[SEX) D Q
. S $P(LRSB(LRTN),"^")="canc"
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Sex Recorded**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Sex Recorded**")
;
; Determine race
S LRRC=$$RACE(DFN)
;
I LRTR'>0 D Q
. S $P(LRSB(LRTN),"^")="canc"
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Creatinine <=0**") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Creatinine <=0**")
;
; Compute eGFR return-value
; Set user(DUZ) and site(DUZ(2) in case delta check calculated during entry of reference lab results.
N LRCMETH,LREGFR,LRFACTOR,LRX
S LRCMETH=+$$GET^XPAR("DIV^PKG","LR EGFR METHOD",1,"Q")
S LRFACTOR=$S(LRCMETH=0:186,LRCMETH=1:175,1:186)
S LREGFR=LRFACTOR*(LRTR**-1.154)*(AGE**-.203)
I SEX="F" S LREGFR=LREGFR*.742
I LRRC=1 S LREGFR=LREGFR*1.21
;
I 'LREGFR Q
;
I LREGFR>60,$$GET^XPAR("DIV^PKG","LR EGFR RESULT SUPPRESS",1,"Q") S LREGFR=">60"
E S LRX=+$$GET1^DID(63.04,LRTN,"","DECIMAL DEFAULT"),LREGFR=$FN(LREGFR,"",LRX)
;
S $P(LRSB(LRTN),"^")=LREGFR
S $P(LRSB(LRTN),"^",4)=$G(DUZ),$P(LRSB(LRTN),"^",9)=$G(DUZ(2))
;
I LRRC="U" D
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: Race unknown, if African American multiply result by 1.210") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: Race unknown, if African American multiply result by 1.210")
;
I LREGFR=">60" D
. I $$CHKDUP(LRDFN,LRIDT,"For eGFR: eGFR results >60 are imprecise. Many variables affect the") Q
. D FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: eGFR results >60 are imprecise. Many variables affect the")
. D FILECOM^LRVR4(LRDFN,LRIDT,"calculated result. Interpretation of eGFR results >60 must be")
. D FILECOM^LRVR4(LRDFN,LRIDT,"monitored over time.")
;
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 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
;
;
CHKDUP(LRDFN,LRIDT,LRSBCOM) ; Check for duplicate comment
; Call with LRDFN = File #63 internal entry number
; LRIDT = inverse date/time
; LRSBCOM = comment to check if duplicate
;
; Returns LRDUP = 0 (not a duplicate), 1 (comment exists - duplicate)
;
N LRDUP,LRI,LRY,LRX
S (LRDUP,LRI)=0,LRY=$TR(LRSBCOM," ",""),LRY=$$UP^XLFSTR(LRY)
F S LRI=$O(^LR(LRDFN,"CH",LRIDT,1,LRI)) Q:'LRI D Q:LRDUP
. S LRX=$P($G(^LR(LRDFN,"CH",LRIDT,1,LRI,0)),"^")
. S LRX=$TR(LRX," ",""),LRX=$$UP^XLFSTR(LRX)
. I LRX=LRY S LRDUP=1
Q LRDUP
;
;*************************************************************
;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 *
;*************************************************************
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREGFR 7109 printed Apr 09, 2024@21:18:30 Page 2
LREGFR ;DALOI/STAFF - Calculate Creatinine-eGFR ;Nov 12, 2020@15:02
+1 ;;5.2;LAB SERVICE;**289,313,350,449,541**;Sep 27, 1994;Build 7
+2 ;
+3 ; Reference to EN^DDIOL supported by IA #10142
+4 ; Reference to $$GET1^DIQ supported by IA #2056
+5 ; Reference to DEM^VADPT supported by IA # 10061
+6 ;
+7 ; This routine is a delta check for the lab test eGFR called by delta
+8 ; check CREATININE-EGFR. The eGFR test is calculated.
+9 ;
+10 ; Provided Data
+11 ; DOB - Patient's date of birth
+12 ; LRDFN - entry in LAB DATA file
+13 ; LRIDT - inverse date/time of entry in LAB DATA file
+14 ; LRNG - variable containing normals/units and delta check
+15 ; LRSB - dataname for creatinine result
+16 ;
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,LRFLG,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 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Delta check not configured**")
QUIT
+16 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Delta check not configured**")
End DoDot:1
QUIT
+17 ;
+18 ; Quit if creatinine unchanged and eGFR already calculated and not 'pending'.
+19 IF $PIECE($GET(LRSB(LRSB)),"^")=LRTR
IF $PIECE($GET(LRSB(LRTN)),"^")'=""
IF $PIECE(LRSB(LRTN),"^")'="pending"
QUIT
+20 ;
+21 ; Check for eGFR dataname in test editing profile.
+22 ; If creatinine changed and eGFR previously calculated then warn.
+23 IF '$DATA(^TMP("LR",$JOB,"TMP",LRTN))
Begin DoDot:1
+24 IF $PIECE($GET(LRSB(LRSB)),"^")=LRTR
QUIT
+25 IF $PIECE($GET(^LR(LRDFN,"CH",LRIDT,LRTN)),"^")'=""
Begin DoDot:2
+26 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not in test editing profile - Creatinine Changed**")
QUIT
+27 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not in test editing profile - Creatinine Changed**")
End DoDot:2
End DoDot:1
QUIT
+28 ;
+29 ; Calculate age based on specimen date/time
+30 SET AGE=""
+31 ; If no collection date/time then set from specimen LRIDT.
+32 IF $GET(LRCDT)=""
NEW LRCDT
SET LRCDT=$PIECE(^LR(LRDFN,"CH",LRIDT,0),"^")
+33 IF LRCDT
IF DOB
SET AGE=($$FMDIFF^XLFDT(LRCDT,DOB,1))\365.25
+34 IF 'AGE
Begin DoDot:1
+35 SET $PIECE(LRSB(LRTN),"^")="canc"
+36 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Age Recorded**")
QUIT
+37 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Age Recorded**")
End DoDot:1
QUIT
+38 ;
+39 ;LR*5.2*541: Erroneous collection date precedes patient's DOB
+40 IF AGE<0
Begin DoDot:1
+41 SET $PIECE(LRSB(LRTN),"^")="canc"
+42 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Coll. Date Before Patient's DOB**")
QUIT
+43 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Coll. Date Before Patient's DOB**")
End DoDot:1
QUIT
+44 SET LRFLG=0
+45 IF AGE<18!(AGE>70)
SET LRFLG=$$GET^XPAR("DIV^PKG","LR EGFR AGE CUTOFF",1,"Q")
+46 IF AGE<18
IF LRFLG?1(1"1",1"3")
Begin DoDot:1
+47 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age <18**")
QUIT
+48 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age <18**")
+49 SET $PIECE(LRSB(LRTN),"^")="canc"
End DoDot:1
QUIT
+50 IF AGE>70
IF LRFLG>1
Begin DoDot:1
+51 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age >70**")
QUIT
+52 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Age >70**")
+53 SET $PIECE(LRSB(LRTN),"^")="canc"
End DoDot:1
QUIT
+54 ;
+55 SET SEX=""
+56 IF LRDPF=2
SET SEX=$PIECE(VADM(5),U)
+57 IF LRDPF=67
SET SEX=$$GET1^DIQ(67,DFN_",",.02,"I")
+58 IF LRDPF=67.1
SET SEX=$$GET1^DIQ(67.1,DFN_",",2,"I")
+59 IF SEX=""!("MF"'[SEX)
Begin DoDot:1
+60 SET $PIECE(LRSB(LRTN),"^")="canc"
+61 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Sex Recorded**")
QUIT
+62 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - No Sex Recorded**")
End DoDot:1
QUIT
+63 ;
+64 ; Determine race
+65 SET LRRC=$$RACE(DFN)
+66 ;
+67 IF LRTR'>0
Begin DoDot:1
+68 SET $PIECE(LRSB(LRTN),"^")="canc"
+69 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Creatinine <=0**")
QUIT
+70 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: **eGFR not Calculated - Creatinine <=0**")
End DoDot:1
QUIT
+71 ;
+72 ; Compute eGFR return-value
+73 ; Set user(DUZ) and site(DUZ(2) in case delta check calculated during entry of reference lab results.
+74 NEW LRCMETH,LREGFR,LRFACTOR,LRX
+75 SET LRCMETH=+$$GET^XPAR("DIV^PKG","LR EGFR METHOD",1,"Q")
+76 SET LRFACTOR=$SELECT(LRCMETH=0:186,LRCMETH=1:175,1:186)
+77 SET LREGFR=LRFACTOR*(LRTR**-1.154)*(AGE**-.203)
+78 IF SEX="F"
SET LREGFR=LREGFR*.742
+79 IF LRRC=1
SET LREGFR=LREGFR*1.21
+80 ;
+81 IF 'LREGFR
QUIT
+82 ;
+83 IF LREGFR>60
IF $$GET^XPAR("DIV^PKG","LR EGFR RESULT SUPPRESS",1,"Q")
SET LREGFR=">60"
+84 IF '$TEST
SET LRX=+$$GET1^DID(63.04,LRTN,"","DECIMAL DEFAULT")
SET LREGFR=$FNUMBER(LREGFR,"",LRX)
+85 ;
+86 SET $PIECE(LRSB(LRTN),"^")=LREGFR
+87 SET $PIECE(LRSB(LRTN),"^",4)=$GET(DUZ)
SET $PIECE(LRSB(LRTN),"^",9)=$GET(DUZ(2))
+88 ;
+89 IF LRRC="U"
Begin DoDot:1
+90 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: Race unknown, if African American multiply result by 1.210")
QUIT
+91 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: Race unknown, if African American multiply result by 1.210")
End DoDot:1
+92 ;
+93 IF LREGFR=">60"
Begin DoDot:1
+94 IF $$CHKDUP(LRDFN,LRIDT,"For eGFR: eGFR results >60 are imprecise. Many variables affect the")
QUIT
+95 DO FILECOM^LRVR4(LRDFN,LRIDT,"For eGFR: eGFR results >60 are imprecise. Many variables affect the")
+96 DO FILECOM^LRVR4(LRDFN,LRIDT,"calculated result. Interpretation of eGFR results >60 must be")
+97 DO FILECOM^LRVR4(LRDFN,LRIDT,"monitored over time.")
End DoDot:1
+98 ;
+99 QUIT
+100 ;
+101 ;
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
SET XRC=$$GET1^DIQ(67,DFN_",",.06)
+19 ;
+20 ; If race not defined then set to unknown.
+21 IF XRC=""
SET XRC="U"
+22 ;
+23 ; If race contains "BLACK" or "AFRICAN" but not HISPANIC then return "1"
+24 IF XRC[XA!(XRC[XB)
IF XRC'[XC
SET XRC=1
+25 ;
+26 ; If unknown or declined then return "U"
+27 IF XRC[XD!(XRC[XE)
SET XRC="U"
+28 ; If not unknown or African-American then return "0"
+29 IF XRC'=1
IF XRC'="U"
SET XRC=0
+30 QUIT XRC
+31 ;
+32 ;
CHKDUP(LRDFN,LRIDT,LRSBCOM) ; Check for duplicate comment
+1 ; Call with LRDFN = File #63 internal entry number
+2 ; LRIDT = inverse date/time
+3 ; LRSBCOM = comment to check if duplicate
+4 ;
+5 ; Returns LRDUP = 0 (not a duplicate), 1 (comment exists - duplicate)
+6 ;
+7 NEW LRDUP,LRI,LRY,LRX
+8 SET (LRDUP,LRI)=0
SET LRY=$TRANSLATE(LRSBCOM," ","")
SET LRY=$$UP^XLFSTR(LRY)
+9 FOR
SET LRI=$ORDER(^LR(LRDFN,"CH",LRIDT,1,LRI))
if 'LRI
QUIT
Begin DoDot:1
+10 SET LRX=$PIECE($GET(^LR(LRDFN,"CH",LRIDT,1,LRI,0)),"^")
+11 SET LRX=$TRANSLATE(LRX," ","")
SET LRX=$$UP^XLFSTR(LRX)
+12 IF LRX=LRY
SET LRDUP=1
End DoDot:1
if LRDUP
QUIT
+13 QUIT LRDUP
+14 ;
+15 ;*************************************************************
+16 ;LR(E)stimated(G)lomerular(F)iltration(R)ate: LREGFR
+17 ;LR(T)est(N)ame: LRTN
+18 ; (R)esults: LRTR
+19 ;LR(R)ace: LRRC
+20 ;
+21 ;*************************************************************
+22 ;* end of routine *
+23 ;*************************************************************
