-
Notifications
You must be signed in to change notification settings - Fork 4
/
PERMIT CPRD renal decline variables
107 lines (89 loc) · 3.92 KB
/
PERMIT CPRD renal decline variables
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
library(data.table)
library(dplyr)
#This script requires MDRD and/or CKD-EPI eGFR to have been previously added via codes within the simple formula variables scipt
## create working data frame for calculations
crea.t <- crea.rep[,c("PatientID","event.date","Creatinine","Age","CKDEPIeGFR","MDRDeGFR")]
setDT(crea.t)
setorder(crea.t, PatientID, -event.date)
crea.t[,event.date := as.Date.character(event.date)]
####/// RRD based on Creatinine
crea.t[,RRD_crea:=as.numeric(NA)]
crea.t[,AnnualPerc_crea:=as.numeric(NA)]
crea.t[,eventYear:=substr(event.date,1,4)]
lapply(unique(crea.t$PatientID), function(x)
{
rows <- which(crea.t$PatientID %in% x)
data.x <- crea.t[PatientID == x]
for(i in 1:nrow(data.x))
{
theDate <- data.x[,event.date][i]
if(theDate >= "2011-12-31") ##dates before 31.12.2011 will not have 4 years of data
{
d <- as.Date(theDate) - 1460
idata <- data.x[data.x$event.date <= theDate & data.x$event.date>= d,]
creaRow <- rows[i]
if(uniqueN(idata$eventYear) >= 5) # if uniqueN < 5 that means that we only have data in 3, e.g. the year we are looking at (2016) and the 4 years before (2012), but no data from years between (2013,2014, 2015)
{
coef <- round(as.numeric(coef(lm(Creatinine ~ Age, data=idata))[2]), digits = 3) #regress 4 full years of creatinine data on Age (age of the patient at the time of creatinine measurement); take the slope
crea.t[creaRow, RRD_crea:=coef]
perc <- round(coef/idata[which.min(event.date), Creatinine], digits = 3) # this is for annual percentage change. the slope is divided by the lowest value in the particular 4 year period
crea.t[creaRow, AnnualPerc_crea := perc]
}
}
}
})
####///// RRD based on CKDEPI eGFR
crea.t[,RRD_CKDEPI:=as.numeric(NA)]
crea.t[,AnnualPerc_CKDEPI:=as.numeric(NA)]
print("lapply started RRD CKD EPI")
lapply(unique(crea.t$PatientID), function(x)
{
rows <- which(crea.t$PatientID %in% x)
data.x <- crea.t[PatientID == x]
for(i in 1:nrow(data.x))
{
theDate <- data.x[,event.date][i]
if(theDate >= "2011-12-31") ##dates before 31.12.2011 will not have 4 years of data
{
d <- as.Date(theDate) - 1460
idata <- data.x[data.x$event.date <= theDate & data.x$event.date>= d,]
creaRow <- rows[i]
if(uniqueN(idata$eventYear) >= 5) # if uniqueN < 5 that means that we only have data in 3, e.g. the year we are looking at (2016) and the 4 years before (2012), but no data from years between (2013,2014, 2015)
{
coef <- round(as.numeric(coef(lm(CKDEPIeGFR ~ Age, data=idata))[2]), digits = 3)
crea.t[creaRow, RRD_CKDEPI:=coef]
perc <- round(coef/idata[which.min(event.date), CKDEPIeGFR], digits = 3)
crea.t[creaRow, AnnualPerc_CKDEPI := perc]
}
}
}
})
####///// RRD based on MDRD eGFR
crea.t[,RRD_MDRD:=as.numeric(NA)]
crea.t[,AnnualPerc_MDRD:=as.numeric(NA)]
print("lapply started RRD MDRD")
lapply(unique(crea.t$PatientID), function(x)
{
rows <- which(crea.t$PatientID %in% x)
data.x <- crea.t[PatientID == x]
for(i in 1:nrow(data.x))
{
theDate <- data.x[,event.date][i]
if(theDate >= "2011-12-31") ##dates before 31.12.2011 will not have 4 years of data
{
d <- as.Date(theDate) - 1460
idata <- data.x[data.x$event.date <= theDate & data.x$event.date>= d,]
creaRow <- rows[i]
if(uniqueN(idata$eventYear) >= 5) # if uniqueN < 5 that means that we only have data in 3, e.g. the year we are looking at (2016) and the 4 years before (2012), but no data from years between (2013,2014, 2015)
{
coef <- round(as.numeric(coef(lm(MDRDeGFR ~ Age, data=idata))[2]), digits = 3)
crea.t[creaRow, RRD_MDRD:=coef]
perc <- round(coef/idata[which.min(event.date), MDRDeGFR], digits = 3)
crea.t[creaRow, AnnualPerc_MDRD := perc]
}
}
}
})
crea.t<-unique(crea.t)#DO SOME CHECKS HERE
save(crea.t,file="crea.t.rda")
crea.rep<-merge(crea.rep,crea.t,all.x=TRUE)