This vignette covers the descriptive data analysis of demographics for the evaluation of the CLAHRC NWL Heart Failure Care Bundle project at North West London Hospitals.

Ethnicity - all NPH discharges

library(knitr)
emergency_adms <- clahrcnwlhf::emergency_adms
emergency_spells <- emergency_adms[
  which(emergency_adms[,"EpisodeNumber"] == 1),]
emergency_spells_nph <- emergency_spells[which(emergency_spells[,"StartWardSite"] == "NPH"),]
knitr::kable(t(as.data.frame.table(table(emergency_spells_nph$EthnicGroup))))

The overall proportions in each ethnic group show that the groups within the category "Mixed" (D - G) account for a very small proportion of spells. Thus it makes sense to combine them into a single new group, X. Group K (Bangladeshi) also represents a very small proportion of spells, and will be merged with Group L (Any other Asian background) to form a new group I. Codes M, N, P will be treated as their category, Black or Black British, labelled U. Chinese (R) is a small group and will be merged with the other group in its category (S, any other ethnic group) to form group V.

knitr::kable(t(as.data.frame.table(table(emergency_spells_nph$EthnicGroupComp))))

First let us examine the number of discharges each month by ethnic group.

library(ggplot2, reshape2)

X <- clahrcnwlhf::ethn_time_table(emergency_spells_nph, ethn_col = 'EthnicGroupComp')
Y <- as.data.frame.matrix(t(X))
Y$timepoint <- c(1:58)
Y.melted <- reshape2::melt(Y, id = "timepoint")
ggplot(data = Y.melted, aes(x = timepoint, y = value, color = variable)) + geom_point() + geom_line()

Next, we consider this data as a proportion of all discharges.

Y <- as.data.frame.matrix(t(X))
n <- ncol(Y)
Y$total <- rowSums(Y)
Y[,1:n] <- Y[,1:n] / Y[,n+1]
Z <- Y
Y$total <- NULL
Y$timepoint <- c(1:58)
Y.melted <- reshape2::melt(Y, id = "timepoint")
ggplot(data = Y.melted, aes(x = timepoint, y = value, color = variable)) + geom_point() + geom_line()

We now consider the distribution of ethnicity between the two time periods.

library(pander, descr)
emergency_spells_nph <- clahrcnwlhf::group_by_date(emergency_spells_nph, cutoff_dates = c(as.Date("31/12/2011", "%d/%m/%Y"),as.Date("31/03/2014", "%d/%m/%Y"),as.Date("30/11/2016", "%d/%m/%Y")), period_labels = c('Before', 'After'), new_col = 'period')
Table1 <- descr::CrossTable(emergency_spells_nph$EthnicGroupComp, emergency_spells_nph$period, expected = FALSE, prop.r = FALSE, prop.t = FALSE, prop.chisq = TRUE, chisq = TRUE)
Table1$RowData <- 'Ethnicity Group'
Table1$ColData <- 'Period'
pander(Table1)
pander(Table1$CST)

This shows that there is a statistically significant difference between the ethnicity distributions of all NPH spells across the two periods.

ggplot(data=emergency_spells_nph, aes(x=EthnicGroupComp, fill=period.date)) + geom_bar(position=position_dodge())
ntab <- table(emergency_spells_nph$EthnicGroupComp,emergency_spells_nph$period.date)
nprops <- prop.table(ntab,2)
npmelt <- reshape2::melt(nprops)
colnames(npmelt)<-c("Ethnicity","Period","Value")
p <- ggplot(data=npmelt, aes(x=Ethnicity, y=Value, fill=Period))
p + geom_bar(position=position_dodge(), stat="identity")

Ethnicity - primary diagnosis heart failure

Now let us repeat the above for only those spells with primary diagnosis heart failure.

knitr::kable(t(as.data.frame.table(table(emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,]$EthnicGroupComp))))

Let us examine the number of primary coded heart failure discharges each month by ethnic group.

X <- clahrcnwlhf::ethn_time_table(emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,], ethn_col = 'EthnicGroupComp')
Y <- as.data.frame.matrix(t(X))
Y$timepoint <- c(1:nrow(Y))
Y.melted <- reshape2::melt(Y, id = "timepoint")
ggplot(data = Y.melted, aes(x = timepoint, y = value, color = variable)) + geom_point() + geom_line()

Next, we consider this data as a proportion of all primary coded heart failure discharges.

Y <- as.data.frame.matrix(t(X))
n <- ncol(Y)
Y$total <- rowSums(Y)
Y[,1:n] <- Y[,1:n] / Y[,n+1]
Z <- Y
Y$total <- NULL
Y$timepoint <- c(1:nrow(Y))
Y.melted <- reshape2::melt(Y, id = "timepoint")
ggplot(data = Y.melted, aes(x = timepoint, y = value, color = variable)) + geom_point() + geom_line()

We now consider the distribution of ethnicity between the two time periods.

library(pander, descr)
Table1 <- descr::CrossTable(emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,"EthnicGroupComp"], emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,"period"], expected = FALSE, prop.r = FALSE, prop.t = FALSE, prop.chisq = TRUE, chisq = TRUE)
Table1$RowData <- 'Ethnicity Group'
Table1$ColData <- 'Period'
pander(Table1)
pander(Table1$CST)

This shows that there is a statistically significant difference between the ethnicity distributions of spells primary coded heart failure, across the two periods.

ggplot(data=emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,], aes(x=EthnicGroupComp, fill=period.date)) + geom_bar(position=position_dodge())
ntab <- table(emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,"EthnicGroupComp"], emergency_spells_nph[emergency_spells_nph$Heart.Failure.Episode == TRUE,"period"])
nprops <- prop.table(ntab,2)
npmelt <- reshape2::melt(nprops)
colnames(npmelt)<-c("Ethnicity","Period","Value")
p <- ggplot(data=npmelt, aes(x=Ethnicity, y=Value, fill=Period))
p + geom_bar(position=position_dodge(), stat="identity")

This simplistic analysis does not take into account the "hierarchical" nature of the data, in the sense that each patient in the dataset may have one or more admission spells during the time period covered. Some approaches that may be of value here are:

  1. For each patient in the dataset, label the first spell as the "index" spell for that patient. Run the above hypothesis test for changes in distribution of ethnicity across index spells commencing in the two periods.
  2. Use a hierarchical event history model to examine the impact of i) ethnicity ii) time period on frequency of admission. This may be the approach we ultimately take to examine the research question of interest regarding (re-)admissions before and after the intervention.


HorridTom/clahrcnwlhf documentation built on May 7, 2019, 4:02 a.m.