RORX020B ;BPOIFO/ACS - RENAL FUNCTION BY RANGE RPT (cont) ; 9/1/11 2:13pm
;;1.5;CLINICAL CASE REGISTRIES;**15**;Feb 17, 2006;Build 27
;
; This routine uses the following IAs:
;
; #4290 ^PXRMINDX(120.5 (controlled)
; #3647 $$EN^GMVPXRM (controlled)
; #10061 DEM^VADPT (supported)
; #3556 GCPR^LA7QRY (supported)
;
;************************************************************************
;CALCULATE THE RENAL FUNCTION VALUE(S)
;Note1: If no range has been passed in and a patient has a Creatinine
; result > 12, the patient will be listed on the report with an
; asterisk (*) next to the test result value, but no scores will be
; calculated.
;Note2: If no range has been passed in and a patient has an invalid Height
; result, the patient will be listed on the report with an asterisk (*)
; next to the test result value, but no CrCl score will be calculated.
;Note3: If a range has been passed in and the patient has a Creatinine result
; >12, the patient will NOT be listed on the report.
;
;INPUT
; DFN Patient DFN in PATIENT file (#2)
; RORDATA Array with ROR data
; RORDATA("BAM") - 'black' or 'african american' race pointers
; RORPTIEN Patient IEN in the ROR registry
; RORLC sub-file and LOINC codes to search for
;
;OUTPUT
; RORDATA Array with ROR data
; 1 Patient will be listed on report
; -1 Patient will not be listed on report
;************************************************************************
CALCRF(DFN,RORDATA,RORPTIEN,RORLC) ;
N RORID,RORST,ROREND,RORLAB,RORMSG,RC
N RORXXX,RORRACES
S RORDATA("CALC")=1 ;default - the score for this patient should be calculated
K RORDATA("SCORE",1),RORDATA("SCORE",2),RORDATA("SCORE",3) ;test scores
K RORDATA("CVAL"),RORDATA("CINV"),RORDATA("CR"),RORDATA("CRDATE") ;Cr data
K RORDATA("HGT"),RORDATA("HDATE") ;height data
;get patient ICN or SSN
S RORID=$$PTID^RORUTL02(DFN)
Q:'$G(RORID) -1
;---SET UP LAB API INPUT/OUTPUT PARMS---
S RORST="2000101^CD" ;start date 1/1/1900
S ROREND=$G(RORDATA("DATE"))\1 ;end date
;add 1 to the end date so the Lab API INCLUDES tests on that date
N X1,X2,X3 S X1=ROREND,X2=1 D C^%DTC S ROREND=X K X,X1,X2
S ROREND=ROREND_"^CD"
S RORLAB=$NA(^TMP("ROROUT",$J)) ;lab API output global
K RORMSG,@RORLAB ;initialize prior to call
;---CALL LAB API USING COLLECTION DATE AND LOINC CODE LIST---
S RC=$$GCPR^LA7QRY(RORID,RORST,ROREND,.RORLC,"*",.RORMSG,RORLAB)
I $G(RC)="",$D(RORMSG)>1 D ;quit if error returned
. N ERR,I,LST,TMP
. S (ERR,LST)=""
. F I=1:1 S ERR=$O(RORMSG(ERR)) Q:ERR="" D
. . S LST=LST_","_ERR,TMP=RORMSG(ERR)
. . K RORMSG(ERR) S RORMSG(I)=TMP
. S LST=$P(LST,",",2,999) Q:(LST=3)!(LST=99)
. S RC=$$ERROR^RORERR(-27,,.RORMSG,RORPTIEN)
I RC<0 Q -1
;Note: the Lab API returns data in the form of HL7 segments
N TMP,RORSPEC,RORVAL,RORNODE,RORSEG,SEGTYPE,RORLOINC,RORDONE,RORDATE,FS
S FS="|" ;default HL7 field separator for lab data
S RORDONE=0 ;flag to indicate if 'valid' data has been found
S RORNODE=0 F S RORNODE=$O(^TMP("ROROUT",$J,RORNODE)) Q:((RORNODE="")!(RORDONE)) D
. S RORSEG=$G(^TMP("ROROUT",$J,RORNODE)) ;get entire HL7 segment
. S SEGTYPE=$P(RORSEG,FS,1) ;get segment type (PID,OBR,OBX,etc.)
. Q:SEGTYPE'="OBX" ;we want OBX segments only
. S RORSPEC=$P($P(RORSEG,FS,4),U,2) ;specimen type string (urine, serum, etc.)
. S RORSPEC=":"_RORSPEC_":" ;append ":" as prefix and suffix
. I ((RORSPEC[":UA:")!(RORSPEC[":UR:")) Q ;quit if specimen type is urine
. S RORLOINC=$P($P(RORSEG,FS,4),"^",1) ;get LOINC code
. Q:(RORDATA("LOINC")'[(";"_RORLOINC_";")) ;LOINC must match Creatinine
. ;test result found
. S RORVAL=$P(RORSEG,FS,6) ;Creatinine test result value
. Q:($G(RORVAL)'>0) ;quit if no value
. S RORDATE=$$HL7TFM^XLFDT($P(RORSEG,FS,15)) ;get date collected
. S RORDATE=RORDATE\1
. ;store 'valid' (12 or less) value if no 'valid' value has been stored yet
. I RORVAL'>12,$O(RORDATA("CVAL",0))="" S RORDATA("CVAL",RORDATE)=RORVAL,RORDONE=1 Q
. ;store 'invalid' (>12) value if no other value has been stored
. I RORVAL>12,$O(RORDATA("CVAL",0))="",$O(RORDATA("CINV",0))="" D
.. S RORDATA("CINV",RORDATE)=$G(RORVAL)_"*" ;mark as 'invalid' value
;
;quit if patient had no Creatinine results (valid or invalid)
Q:(($D(RORDATA("CVAL"))'>1)&($D(RORDATA("CINV"))'>1)) -1
;
;--- set Creatinine result and date into data array
N DATE
S DATE=$O(RORDATA("CVAL",0)) ;'valid' Cr date
I $G(DATE)="" D ;if no 'valid' Cr value, get 'invalid' value
. S DATE=$O(RORDATA("CINV",0))
. S RORDATA("CVAL",DATE)=$G(RORDATA("CINV",DATE))
. S RORDATA("CALC")=0 ;no score calculations can be done on 'invalid' data
S RORDATA("CR")=$G(RORDATA("CVAL",DATE))
;S RORDATA("CRDATE")=$P((9999999-$G(DATE)),".",1)
S RORDATA("CRDATE")=DATE\1
;
;--- get height date and height IEN
N RORHTDT,RORHTIEN,RORARY
S RORDATE=RORDATA("DATE")
S RORHTDT=$O(^PXRMINDX(120.5,"PI",DFN,RORDATA("HGTP"),RORDATE),-1) ;height date
Q:$G(RORHTDT)="" -1
S RORHTIEN=$O(^PXRMINDX(120.5,"PI",DFN,RORDATA("HGTP"),RORHTDT,0)) ;height IEN
Q:$G(RORHTIEN)="" -1
;--- call API to get get height measurement
K RORARY D EN^GMVPXRM(.RORARY,RORHTIEN,"I")
S RORDATA("HGT")=$G(RORARY(7)),RORDATA("HDATE")=$P(RORHTDT,".",1)
I ($G(RORDATA("HGT"))'>0) Q -1 ;quit if height not > 0
;strip out characters "IN", ",E"
I ((RORDATA("HGT")["IN")!(RORDATA("HGT")[",E")) S RORDATA("HGT")=+RORDATA("HGT")
;mark as 'invalid' if height contains "CM", or "'" or double quote
I ((RORDATA("HGT")["CM")!(RORDATA("HGT")["'")!(RORDATA("HGT")["""")) D
. I RORDATA("IDLST")[1 S RORDATA("CALC")=0 ;no CrCl calculations can be done on 'invalid' data
. S RORDATA("HGT")=RORDATA("HGT")_"*" ;mark as 'invalid' value
;set CALC flag to 0 and add "*" if invalid height: not between 36 and 96 inches
I ((RORDATA("HGT")'["*")&((RORDATA("HGT")<36)!(RORDATA("HGT")>96))) D
. I RORDATA("IDLST")[1 S RORDATA("CALC")=0 ;no CrCl calculations can be done on 'invalid' data
. S RORDATA("HGT")=RORDATA("HGT")_"*" ;mark as 'invalid' value
;
;include patient on reports but don't calculate score if no high/low
;range passed in and invalid CR data exists
I RORDATA("CR")["*",RORDATA("RANGE")=0 Q 1
;don't include patient on report if range IS passed in and invalid Cr data
;exists since neither score can't be calculated
I RORDATA("CR")["*",RORDATA("RANGE")=1 Q -1
;
;---CALCULATE RENAL TEST SCORES USING VALID CR VALUE
;
;--- get patient race, gender, age, and dob using DEM^VADPT
N RORDEM,RORGENDER,RORRACE,RORM,RORF,RORAGE,VAROOT
S (RORF,RORM)=0
S VAROOT="RORDEM" D DEM^VADPT
S RORGENDER=$P($G(RORDEM(5)),U,1) ;M or F
Q:$G(RORGENDER)="" -1
S:RORGENDER="F" RORF=1 S:RORGENDER="M" RORM=1
;--- get age
;if 'most recent' date, use age returned from DEM^VADPT
;if not 'most recent', calculate age
I $$PARAM^RORTSK01("OPTIONS","MOST_RECENT") S RORAGE=RORDEM(4)
E S RORAGE=$$AGE^RORX019A(DFN,RORDATE)
;
;--- construct race array
K RORRACES
S RORCNT=$G(RORDEM(12)) I RORCNT>0 D
.F RORXXX=1:1:RORCNT D
..S RORRACES($P($G(RORDEM(12,RORXXX)),U,1))=""
;
;--- Cockcroft-Gault CrCl ---
;Calculation: (140-age) x ideal weight in kg (*.85 if female)/(creatinine*72)
;Ideal weight in kg:
; males = 51.65+(1.85*(height-60))
; females = 48.67+(1.65*(height-60))
;
N RORMIW,RORFIW,MULT2,TMP
D
. ;if male, use this calculation
. I RORM=1 D ;get male ideal weight in kg
.. S MULT2=1 ;no additional multiplier if male
.. Q:RORDATA("HGT")["*" ;quit if invalid height value
.. S RORMIW=51.65+(1.85*(RORDATA("HGT")-60)) ;male ideal weight
.. S TMP=(140-RORAGE)*RORMIW/(RORDATA("CR")*72) ;CrCl score
. ;if female, use this calculation
. I RORF=1 D
.. S MULT2=.742 ;set multiplier for eGFR calculation if female
.. Q:RORDATA("HGT")["*" ;quit if invalid height value
.. S RORFIW=48.67+(1.65*(RORDATA("HGT")-60)) ;female ideal weight
.. S TMP=(140-RORAGE)*RORFIW*.85/(RORDATA("CR")*72) ;CrCl score
. ;
. I RORDATA("IDLST")[1 S RORDATA("SCORE",1)=$S($G(TMP)>0:$J($G(TMP),0,0),1:"") ;round CrCl score to whole number
;
;--- eGFR by MDRD ---
;default race multiplier set to 1 (i.e. no multiplier)
N RORCNT,MULT1,I S MULT1=1
D
. ;get count of race values (could be more than 1 entry)
. S RORCNT=$G(RORDEM(12)) I RORCNT>0 D
.. ;check each race value for match on 'black or 'african american'
.. F I=1:1:RORCNT D Q:MULT1=1.212
... S RORRACE=$P($G(RORDEM(12,I)),U,1) ;race pointer value
... ;if any of the race values are black or african american, set multiplier
... I $G(RORDATA("BAM"))[(";"_$G(RORRACE)_";") S MULT1=1.212
. ;--- calculate eGFR by MDRD score Calculation:
. ;(175 * (creatinine ^ -1.154) * (age ^ -.203) *1.212 (if black) * .742 (if female)
. S TMP=175*($$PWR^XLFMTH(RORDATA("CR"),-1.154))*($$PWR^XLFMTH(RORAGE,-0.203))*MULT1*MULT2 ;eGFR
. ;
. I RORDATA("IDLST")[2 S RORDATA("SCORE",2)=$J($G(TMP),0,0) ;round eGFR score to whole number
;
;--- eGFR by CKD-EPI ---
;141*MIN(RORDATA("CR")/(.7 if female;.9 if male))**(-0.329 if female; -0.411 if male)*max(RORDATA("CR")/(.7 if female;.9 if male))**AGE*(1.018 if female)*(1.159 if black)
I RORDATA("IDLST")[3 D
.N RORFX
.S RORFX(1)=$S(RORGENDER="F":.7,1:.9)
.S RORFX(2)=$S(RORGENDER="F":-.329,1:-.411)
.S RORFX(3)=$S(RORGENDER="F":1.018,1:1)
.S RORFX(4)=$S($D(RORRACES(9)):1.159,1:1)
.S RORFX(5)=RORDATA("CR")/RORFX(1)
.S TMP=141*($$PWR^XLFMTH($$MIN^XLFMTH(RORFX(5),1),RORFX(2)))*($$PWR^XLFMTH($$MAX^XLFMTH(RORFX(5),1),-1.209))*($$PWR^XLFMTH(.993,RORAGE))*(RORFX(3))*(RORFX(4))
.S RORDATA("SCORE",3)=$J($G(TMP),0,0)
;
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX020B 9798 printed Sep 23, 2025@19:20:54 Page 2
RORX020B ;BPOIFO/ACS - RENAL FUNCTION BY RANGE RPT (cont) ; 9/1/11 2:13pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**15**;Feb 17, 2006;Build 27
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #4290 ^PXRMINDX(120.5 (controlled)
+6 ; #3647 $$EN^GMVPXRM (controlled)
+7 ; #10061 DEM^VADPT (supported)
+8 ; #3556 GCPR^LA7QRY (supported)
+9 ;
+10 ;************************************************************************
+11 ;CALCULATE THE RENAL FUNCTION VALUE(S)
+12 ;Note1: If no range has been passed in and a patient has a Creatinine
+13 ; result > 12, the patient will be listed on the report with an
+14 ; asterisk (*) next to the test result value, but no scores will be
+15 ; calculated.
+16 ;Note2: If no range has been passed in and a patient has an invalid Height
+17 ; result, the patient will be listed on the report with an asterisk (*)
+18 ; next to the test result value, but no CrCl score will be calculated.
+19 ;Note3: If a range has been passed in and the patient has a Creatinine result
+20 ; >12, the patient will NOT be listed on the report.
+21 ;
+22 ;INPUT
+23 ; DFN Patient DFN in PATIENT file (#2)
+24 ; RORDATA Array with ROR data
+25 ; RORDATA("BAM") - 'black' or 'african american' race pointers
+26 ; RORPTIEN Patient IEN in the ROR registry
+27 ; RORLC sub-file and LOINC codes to search for
+28 ;
+29 ;OUTPUT
+30 ; RORDATA Array with ROR data
+31 ; 1 Patient will be listed on report
+32 ; -1 Patient will not be listed on report
+33 ;************************************************************************
CALCRF(DFN,RORDATA,RORPTIEN,RORLC) ;
+1 NEW RORID,RORST,ROREND,RORLAB,RORMSG,RC
+2 NEW RORXXX,RORRACES
+3 ;default - the score for this patient should be calculated
SET RORDATA("CALC")=1
+4 ;test scores
KILL RORDATA("SCORE",1),RORDATA("SCORE",2),RORDATA("SCORE",3)
+5 ;Cr data
KILL RORDATA("CVAL"),RORDATA("CINV"),RORDATA("CR"),RORDATA("CRDATE")
+6 ;height data
KILL RORDATA("HGT"),RORDATA("HDATE")
+7 ;get patient ICN or SSN
+8 SET RORID=$$PTID^RORUTL02(DFN)
+9 if '$GET(RORID)
QUIT -1
+10 ;---SET UP LAB API INPUT/OUTPUT PARMS---
+11 ;start date 1/1/1900
SET RORST="2000101^CD"
+12 ;end date
SET ROREND=$GET(RORDATA("DATE"))\1
+13 ;add 1 to the end date so the Lab API INCLUDES tests on that date
+14 NEW X1,X2,X3
SET X1=ROREND
SET X2=1
DO C^%DTC
SET ROREND=X
KILL X,X1,X2
+15 SET ROREND=ROREND_"^CD"
+16 ;lab API output global
SET RORLAB=$NAME(^TMP("ROROUT",$JOB))
+17 ;initialize prior to call
KILL RORMSG,@RORLAB
+18 ;---CALL LAB API USING COLLECTION DATE AND LOINC CODE LIST---
+19 SET RC=$$GCPR^LA7QRY(RORID,RORST,ROREND,.RORLC,"*",.RORMSG,RORLAB)
+20 ;quit if error returned
IF $GET(RC)=""
IF $DATA(RORMSG)>1
Begin DoDot:1
+21 NEW ERR,I,LST,TMP
+22 SET (ERR,LST)=""
+23 FOR I=1:1
SET ERR=$ORDER(RORMSG(ERR))
if ERR=""
QUIT
Begin DoDot:2
+24 SET LST=LST_","_ERR
SET TMP=RORMSG(ERR)
+25 KILL RORMSG(ERR)
SET RORMSG(I)=TMP
End DoDot:2
+26 SET LST=$PIECE(LST,",",2,999)
if (LST=3)!(LST=99)
QUIT
+27 SET RC=$$ERROR^RORERR(-27,,.RORMSG,RORPTIEN)
End DoDot:1
+28 IF RC<0
QUIT -1
+29 ;Note: the Lab API returns data in the form of HL7 segments
+30 NEW TMP,RORSPEC,RORVAL,RORNODE,RORSEG,SEGTYPE,RORLOINC,RORDONE,RORDATE,FS
+31 ;default HL7 field separator for lab data
SET FS="|"
+32 ;flag to indicate if 'valid' data has been found
SET RORDONE=0
+33 SET RORNODE=0
FOR
SET RORNODE=$ORDER(^TMP("ROROUT",$JOB,RORNODE))
if ((RORNODE="")!(RORDONE))
QUIT
Begin DoDot:1
+34 ;get entire HL7 segment
SET RORSEG=$GET(^TMP("ROROUT",$JOB,RORNODE))
+35 ;get segment type (PID,OBR,OBX,etc.)
SET SEGTYPE=$PIECE(RORSEG,FS,1)
+36 ;we want OBX segments only
if SEGTYPE'="OBX"
QUIT
+37 ;specimen type string (urine, serum, etc.)
SET RORSPEC=$PIECE($PIECE(RORSEG,FS,4),U,2)
+38 ;append ":" as prefix and suffix
SET RORSPEC=":"_RORSPEC_":"
+39 ;quit if specimen type is urine
IF ((RORSPEC[":UA:")!(RORSPEC[":UR:"))
QUIT
+40 ;get LOINC code
SET RORLOINC=$PIECE($PIECE(RORSEG,FS,4),"^",1)
+41 ;LOINC must match Creatinine
if (RORDATA("LOINC")'[(";"_RORLOINC_";"))
QUIT
+42 ;test result found
+43 ;Creatinine test result value
SET RORVAL=$PIECE(RORSEG,FS,6)
+44 ;quit if no value
if ($GET(RORVAL)'>0)
QUIT
+45 ;get date collected
SET RORDATE=$$HL7TFM^XLFDT($PIECE(RORSEG,FS,15))
+46 SET RORDATE=RORDATE\1
+47 ;store 'valid' (12 or less) value if no 'valid' value has been stored yet
+48 IF RORVAL'>12
IF $ORDER(RORDATA("CVAL",0))=""
SET RORDATA("CVAL",RORDATE)=RORVAL
SET RORDONE=1
QUIT
+49 ;store 'invalid' (>12) value if no other value has been stored
+50 IF RORVAL>12
IF $ORDER(RORDATA("CVAL",0))=""
IF $ORDER(RORDATA("CINV",0))=""
Begin DoDot:2
+51 ;mark as 'invalid' value
SET RORDATA("CINV",RORDATE)=$GET(RORVAL)_"*"
End DoDot:2
End DoDot:1
+52 ;
+53 ;quit if patient had no Creatinine results (valid or invalid)
+54 if (($DATA(RORDATA("CVAL"))'>1)&($DATA(RORDATA("CINV"))'>1))
QUIT -1
+55 ;
+56 ;--- set Creatinine result and date into data array
+57 NEW DATE
+58 ;'valid' Cr date
SET DATE=$ORDER(RORDATA("CVAL",0))
+59 ;if no 'valid' Cr value, get 'invalid' value
IF $GET(DATE)=""
Begin DoDot:1
+60 SET DATE=$ORDER(RORDATA("CINV",0))
+61 SET RORDATA("CVAL",DATE)=$GET(RORDATA("CINV",DATE))
+62 ;no score calculations can be done on 'invalid' data
SET RORDATA("CALC")=0
End DoDot:1
+63 SET RORDATA("CR")=$GET(RORDATA("CVAL",DATE))
+64 ;S RORDATA("CRDATE")=$P((9999999-$G(DATE)),".",1)
+65 SET RORDATA("CRDATE")=DATE\1
+66 ;
+67 ;--- get height date and height IEN
+68 NEW RORHTDT,RORHTIEN,RORARY
+69 SET RORDATE=RORDATA("DATE")
+70 ;height date
SET RORHTDT=$ORDER(^PXRMINDX(120.5,"PI",DFN,RORDATA("HGTP"),RORDATE),-1)
+71 if $GET(RORHTDT)=""
QUIT -1
+72 ;height IEN
SET RORHTIEN=$ORDER(^PXRMINDX(120.5,"PI",DFN,RORDATA("HGTP"),RORHTDT,0))
+73 if $GET(RORHTIEN)=""
QUIT -1
+74 ;--- call API to get get height measurement
+75 KILL RORARY
DO EN^GMVPXRM(.RORARY,RORHTIEN,"I")
+76 SET RORDATA("HGT")=$GET(RORARY(7))
SET RORDATA("HDATE")=$PIECE(RORHTDT,".",1)
+77 ;quit if height not > 0
IF ($GET(RORDATA("HGT"))'>0)
QUIT -1
+78 ;strip out characters "IN", ",E"
+79 IF ((RORDATA("HGT")["IN")!(RORDATA("HGT")[",E"))
SET RORDATA("HGT")=+RORDATA("HGT")
+80 ;mark as 'invalid' if height contains "CM", or "'" or double quote
+81 IF ((RORDATA("HGT")["CM")!(RORDATA("HGT")["'")!(RORDATA("HGT")[""""))
Begin DoDot:1
+82 ;no CrCl calculations can be done on 'invalid' data
IF RORDATA("IDLST")[1
SET RORDATA("CALC")=0
+83 ;mark as 'invalid' value
SET RORDATA("HGT")=RORDATA("HGT")_"*"
End DoDot:1
+84 ;set CALC flag to 0 and add "*" if invalid height: not between 36 and 96 inches
+85 IF ((RORDATA("HGT")'["*")&((RORDATA("HGT")<36)!(RORDATA("HGT")>96)))
Begin DoDot:1
+86 ;no CrCl calculations can be done on 'invalid' data
IF RORDATA("IDLST")[1
SET RORDATA("CALC")=0
+87 ;mark as 'invalid' value
SET RORDATA("HGT")=RORDATA("HGT")_"*"
End DoDot:1
+88 ;
+89 ;include patient on reports but don't calculate score if no high/low
+90 ;range passed in and invalid CR data exists
+91 IF RORDATA("CR")["*"
IF RORDATA("RANGE")=0
QUIT 1
+92 ;don't include patient on report if range IS passed in and invalid Cr data
+93 ;exists since neither score can't be calculated
+94 IF RORDATA("CR")["*"
IF RORDATA("RANGE")=1
QUIT -1
+95 ;
+96 ;---CALCULATE RENAL TEST SCORES USING VALID CR VALUE
+97 ;
+98 ;--- get patient race, gender, age, and dob using DEM^VADPT
+99 NEW RORDEM,RORGENDER,RORRACE,RORM,RORF,RORAGE,VAROOT
+100 SET (RORF,RORM)=0
+101 SET VAROOT="RORDEM"
DO DEM^VADPT
+102 ;M or F
SET RORGENDER=$PIECE($GET(RORDEM(5)),U,1)
+103 if $GET(RORGENDER)=""
QUIT -1
+104 if RORGENDER="F"
SET RORF=1
if RORGENDER="M"
SET RORM=1
+105 ;--- get age
+106 ;if 'most recent' date, use age returned from DEM^VADPT
+107 ;if not 'most recent', calculate age
+108 IF $$PARAM^RORTSK01("OPTIONS","MOST_RECENT")
SET RORAGE=RORDEM(4)
+109 IF '$TEST
SET RORAGE=$$AGE^RORX019A(DFN,RORDATE)
+110 ;
+111 ;--- construct race array
+112 KILL RORRACES
+113 SET RORCNT=$GET(RORDEM(12))
IF RORCNT>0
Begin DoDot:1
+114 FOR RORXXX=1:1:RORCNT
Begin DoDot:2
+115 SET RORRACES($PIECE($GET(RORDEM(12,RORXXX)),U,1))=""
End DoDot:2
End DoDot:1
+116 ;
+117 ;--- Cockcroft-Gault CrCl ---
+118 ;Calculation: (140-age) x ideal weight in kg (*.85 if female)/(creatinine*72)
+119 ;Ideal weight in kg:
+120 ; males = 51.65+(1.85*(height-60))
+121 ; females = 48.67+(1.65*(height-60))
+122 ;
+123 NEW RORMIW,RORFIW,MULT2,TMP
+124 Begin DoDot:1
+125 ;if male, use this calculation
+126 ;get male ideal weight in kg
IF RORM=1
Begin DoDot:2
+127 ;no additional multiplier if male
SET MULT2=1
+128 ;quit if invalid height value
if RORDATA("HGT")["*"
QUIT
+129 ;male ideal weight
SET RORMIW=51.65+(1.85*(RORDATA("HGT")-60))
+130 ;CrCl score
SET TMP=(140-RORAGE)*RORMIW/(RORDATA("CR")*72)
End DoDot:2
+131 ;if female, use this calculation
+132 IF RORF=1
Begin DoDot:2
+133 ;set multiplier for eGFR calculation if female
SET MULT2=.742
+134 ;quit if invalid height value
if RORDATA("HGT")["*"
QUIT
+135 ;female ideal weight
SET RORFIW=48.67+(1.65*(RORDATA("HGT")-60))
+136 ;CrCl score
SET TMP=(140-RORAGE)*RORFIW*.85/(RORDATA("CR")*72)
End DoDot:2
+137 ;
+138 ;round CrCl score to whole number
IF RORDATA("IDLST")[1
SET RORDATA("SCORE",1)=$SELECT($GET(TMP)>0:$JUSTIFY($GET(TMP),0,0),1:"")
End DoDot:1
+139 ;
+140 ;--- eGFR by MDRD ---
+141 ;default race multiplier set to 1 (i.e. no multiplier)
+142 NEW RORCNT,MULT1,I
SET MULT1=1
+143 Begin DoDot:1
+144 ;get count of race values (could be more than 1 entry)
+145 SET RORCNT=$GET(RORDEM(12))
IF RORCNT>0
Begin DoDot:2
+146 ;check each race value for match on 'black or 'african american'
+147 FOR I=1:1:RORCNT
Begin DoDot:3
+148 ;race pointer value
SET RORRACE=$PIECE($GET(RORDEM(12,I)),U,1)
+149 ;if any of the race values are black or african american, set multiplier
+150 IF $GET(RORDATA("BAM"))[(";"_$GET(RORRACE)_";")
SET MULT1=1.212
End DoDot:3
if MULT1=1.212
QUIT
End DoDot:2
+151 ;--- calculate eGFR by MDRD score Calculation:
+152 ;(175 * (creatinine ^ -1.154) * (age ^ -.203) *1.212 (if black) * .742 (if female)
+153 ;eGFR
SET TMP=175*($$PWR^XLFMTH(RORDATA("CR"),-1.154))*($$PWR^XLFMTH(RORAGE,-0.203))*MULT1*MULT2
+154 ;
+155 ;round eGFR score to whole number
IF RORDATA("IDLST")[2
SET RORDATA("SCORE",2)=$JUSTIFY($GET(TMP),0,0)
End DoDot:1
+156 ;
+157 ;--- eGFR by CKD-EPI ---
+158 ;141*MIN(RORDATA("CR")/(.7 if female;.9 if male))**(-0.329 if female; -0.411 if male)*max(RORDATA("CR")/(.7 if female;.9 if male))**AGE*(1.018 if female)*(1.159 if black)
+159 IF RORDATA("IDLST")[3
Begin DoDot:1
+160 NEW RORFX
+161 SET RORFX(1)=$SELECT(RORGENDER="F":.7,1:.9)
+162 SET RORFX(2)=$SELECT(RORGENDER="F":-.329,1:-.411)
+163 SET RORFX(3)=$SELECT(RORGENDER="F":1.018,1:1)
+164 SET RORFX(4)=$SELECT($DATA(RORRACES(9)):1.159,1:1)
+165 SET RORFX(5)=RORDATA("CR")/RORFX(1)
+166 SET TMP=141*($$PWR^XLFMTH($$MIN^XLFMTH(RORFX(5),1),RORFX(2)))*($$PWR^XLFMTH($$MAX^XLFMTH(RORFX(5),1),-1.209))*($$PWR^XLFMTH(.993,RORAGE))*(RORFX(3))*(RORFX(4))
+167 SET RORDATA("SCORE",3)=$JUSTIFY($GET(TMP),0,0)
End DoDot:1
+168 ;
+169 QUIT 1
