In farhadsalimi/registryr: Functions for the Clinical Registries Analyses

knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, fig.showtext = TRUE)

library(pacman)
p_load(
  tidyverse, lubridate, cowplot, arsenal, gtsummary, scales, knitr, flextable, janitor,
  registryr,
  conflicted,
  readxl,
  kableExtra,
  patchwork,
  REDCapR
)

theme_define("adnet")

conflict_prefer("filter", "stats")

data <- data_cleaned
eval_site <- str_to_lower(params$site_name) != "all"
# sites_dag <- read_excel(here::here(params$site_dag))

data_all <-
  data %>%
  rename(site_name = site_name_in_report) %>%
  mutate(category = if_else(str_to_lower(str_remove_all(site_name, " ")) == str_to_lower(str_remove_all(params$site_name, " ")),
    params$site_name,
    "Other sites"
  ))

data <-
  data %>%
  rename(site_name = site_name_in_report) %>%
  dplyr::filter(str_to_lower(str_remove_all(site_name, " ")) == str_to_lower(str_remove_all(params$site_name, " ")))

data_all <-
  data %>%
  rename(site_name = site_name_in_report) %>%
  mutate(category = "All sites")


data <-
  data %>%
  rename(site_name = site_name_in_report)

RECRUITMENT

Overall recruitment

n_participating <- data_all %>% nrow()

n_adnet <- data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  nrow()

n_holding <- 
  data_all %>%
  dplyr::filter(database == "ADNeT Holding Database" &
    data_completeness___1 == "Checked") %>%
  nrow()

n_optout <- data_all %>%
  dplyr::filter(database == "ADNeT Opt-out Database") %>%
  nrow()

n_sites <- 
  data_all %>%
  select(site_name) %>%
  distinct() %>%
  nrow()

The total number of unique patients across the three ADNeT databases: r n_participating from r n_sites sites

Of these patients, r n_adnet (r round(100*n_adnet/n_participating, 1)%) are in the ADNeT registry
Of these patients, r n_holding (r round(100*n_holding/n_participating, 1)%) are in the ADNeT Holding database (excluding unsubmitted records)
Of these patients, r n_optout (r round(100*n_optout/n_participating, 1)%) are in the ADNeT Opt-out database

A breakdown of participation by database and state/site can be seen in the table below:

table <-
  data_all %>%
  count(state, database) %>%
  mutate(state = fct_explicit_na(state, "Missing"),
         state = fct_reorder(state, n, sum),
         state = fct_relevel(state, "Missing", after = 0),
         n_tot = sum(n))%>%
  pivot_wider(names_from = database, values_from = n)%>%
  adorn_totals("row") %>%
  pivot_longer(-c(state, n_tot)) 

table <-
  table %>%
  mutate(n_tot = if_else(state == "Total", NA_integer_, n_tot)) %>%
  fill(n_tot, .direction = "downup") %>%
  mutate(pct = percent(value / n_tot, accuracy = 1),
         n_pct = glue::glue("{comma(value)} ({pct})"))

table %>%
  select(State = state,
         Database = name,
         `N (%)` = n_pct) %>%
  pivot_wider(names_from = Database, values_from = `N (%)`) %>%
  arrange(desc(parse_number(`ADNeT Registry`))) %>%
  flextable()

table <-
  data_all %>%
  dplyr::filter(data_completeness___1 == "Checked" | is.na(data_completeness___1)) %>%
  mutate(state = fct_explicit_na(state, "Missing")) %>%
  select(dt_completed, state, site_name, database, opt_out_timepoint, opt_out_yes___1) %>%
  mutate(
    database = if_else(
      opt_out_timepoint == "At time of diagnosis" | opt_out_yes___1 == "Checked",
      "ADNeT Opt-out Database",
      as.character(database),
      as.character(database)
      )) %>%
  select(-c(opt_out_timepoint, opt_out_yes___1)) %>%
  mutate(database = as_factor(database))

table <-
  table %>%
  group_by(site_name) %>%
  mutate(first_record_submitted = as_date(min(dt_completed, na.rm = TRUE))) %>%
  ungroup() %>%
  select(-dt_completed)

table <-
  table %>%
  count(state, site_name, first_record_submitted, database, .drop = FALSE) %>%
  group_by(state) %>%
  mutate(pct = percent(n / sum(n), accuracy = 0.1)) %>%
  ungroup() %>%
  mutate(n_pct = glue::glue("{comma(n, accuracy = 1)} ({pct})")) %>%
  select(-c(n, pct))

table %>%
  pivot_wider(names_from = database, values_from = n_pct) %>%
  arrange(state, desc(parse_number(`ADNeT Registry`)))%>%
  rename(Site = site_name,
         Jurisdiction = state,
         `First record submitted on` = first_record_submitted) %>%
  flextable()

pyramid_df <-
  data_all %>%
  select(pt_sex, pt_age_diagnosis, category) %>%
  dplyr::filter(pt_sex %in% c("Male", "Female"),
                !is.na(pt_age_diagnosis)) %>%
  mutate(age_group = cut(pt_age_diagnosis,
                         breaks = c(-Inf, 55, 60, 65, 70, 75, 80, 85, 90, Inf),
                         label = c("<55", "55-59", "60-64", "65-69", "70-74", "74-79", "80-84",
                                   "85-89", ">= 90"),
                         right = FALSE),
         age_group = as_factor(age_group),
         pt_sex = as_factor(pt_sex),
         category = as_factor(category)) %>%
  count(pt_sex, age_group, category, .drop = FALSE) %>%
  rename(sex = pt_sex) %>%
  mutate(category = str_wrap(category, 30))

g1 <- population_pyramid(pyramid_df %>% dplyr::filter(category == "Other sites")) +
  labs(subtitle = "Other sites")

g2 <- population_pyramid(pyramid_df %>% dplyr::filter(category != "Other sites")) +
  labs(subtitle = params$site_name)

g1 / g2

Opt-out rate

Overall opt-out table

#calc_opt_out <- read_xlsx(here::here(glue::glue("assets/","Opt_out_rate.xlsx")))

# for i in (1:nrow(calc_opt_out)){
#  QI.variables.list[[i]] <- data_all %>%
#     dplyr::filter_(calc_opt_out[i,"Denominator"]) %>%
#     summarise(complete = sum(eval(parse(text=calc_opt_out[i,"Numerator"])), na.rm = T),
#               total = n(),
#               opt_out = calc.QI[i,"Opt_out"]) 
# }

## Overall Opt-Out
overall_num <-
  data_all %>%
  dplyr::filter(opt_out_yes___1 == "Checked"|
                database == "ADNeT Opt-out Database"|
                (database == "ADNeT Holding Database" & opt_out_diagnosis == "Yes")) %>%
  nrow()

overall_den <-
  data_all %>%
  dplyr::filter(database == "ADNeT Opt-out Database"|
                  opt_out_group %in% c(
        "Patient contacted",
        "Person responsible contacted",
        "Carer contacted"
      )) %>%
  nrow()

## Complete Recruitment
compl_den <- data_all %>%
  dplyr::filter(database == "ADNeT Opt-out Database"|
                (database == "ADNeT Registry" & 
                  opt_out_group %in% c(
        "Patient contacted",
        "Person responsible contacted",
        "Carer contacted"
      ))) %>%
  nrow()

## At Diagnosis  
diag_num <-
  data_all %>%
  dplyr::filter((database == "ADNeT Opt-out Database" & opt_out_timepoint == "At time of diagnosis")|
                (database == "ADNeT Holding Database" & opt_out_diagnosis == "Yes")) %>%
  nrow()

## During Recruitment
recruit_num <-
  data_all %>%
  dplyr::filter(database %in% c("ADNeT Opt-out Database", "ADNeT Holding Database") 
                & opt_out_timepoint == "During recruitment" 
                & opt_out_yes___1 == "Checked") %>%
  nrow()

## Post Recruitment
post_recruit_num <-
  data_all %>%
  dplyr::filter(database %in% c("ADNeT Opt-out Database", "ADNeT Holding Database") 
                & opt_out_timepoint == "Post recruitment" 
                & opt_out_yes___1 == "Checked") %>%
  nrow()

## Externam denominator
overall_den_ext <- data_all %>%
  dplyr::filter(!is.na(database)) %>%
  nrow()

compl_den_ext <- data_all %>%
  dplyr::filter(database != "ADNeT Holding Database")%>%
  nrow()

opt_out_rate <- data.frame(
  `opt-out rate` = c("Overall opt-out rate",
                     "Overall opt-out rate for those who complete recruitment",
                     "Overall opt-out rate at diagnosis",
                     "Overall opt-out rate during recruitment",
                     "Overall post-recruitment opt-out rate"),

  denominator_int = c(overall_den, 
                  compl_den, 
                  overall_den, 
                  overall_den,
                  overall_den),

  denominator_ext = c(overall_den_ext, 
                  compl_den_ext, 
                  overall_den_ext, 
                  overall_den_ext,
                  overall_den_ext),

  numerator = c(overall_num,
              overall_num,
              diag_num,
              recruit_num, 
              post_recruit_num)
) %>%
  mutate(`Internal value – excluding WOC` = percent(numerator/denominator_int, accuracy = 1),
         `External value – including WOC` = percent(numerator/denominator_ext, accuracy = 1))

opt_out_rate %>% 
  select(`Opt out rate` = opt.out.rate,
         `Internal value – excluding WOC`,
         `External value – including WOC`) %>%
  flextable() %>%
  flextable::width(width = 1.5)

Culminative overall opt-out rates (internal value) over the past 12 months

## Cumulative monthly opt-out rate
monthly_dem <- data_all %>%
  mutate(month_year = case_when(database == "ADNeT Holding Database" ~ as_date(round_date(as.Date(dt_completed), "month")),
                                database =="ADNeT Registry" ~ as_date(round_date(date_of_data_transfer, "month")),
                                database == "ADNeT Opt-out Database" ~ as_date(round_date(dt_optout, "month")))) %>%
  group_by(month_year) %>%
  summarise(n = n()) %>%
  mutate(csum = cumsum(n)) %>%
  drop_na()

monthly_num <- data_all %>%
  dplyr::filter(opt_out_yes___1 == "Checked"|
                database == "ADNeT Opt-out Database"|
                (database == "ADNeT Holding Database" & opt_out_diagnosis == "Yes")) %>%
  mutate(month_year = as_date(round_date(dt_optout, "month"))) %>%
  group_by(month_year) %>%
  summarise(opt_out = n()) %>%
  mutate(csum_opt_out = cumsum(opt_out)) %>%
  drop_na()

graph_df <- monthly_dem %>%
  left_join(monthly_num, by = "month_year") %>%
  mutate(rate = csum_opt_out/csum)


graph_df %>%
  dplyr::filter(difftime(Sys.Date(),month_year, "days") <= 365) %>%
  ggplot(aes(x = month_year, y = rate)) +
  geom_line(size = 1.3, color = "#00A480") +
  scale_x_date(expand = c(0.02,1.5), 
               date_breaks = "1 month", 
               date_labels =  "%b %Y") +
  scale_y_continuous(limits = c(0, NA),
                     labels = percent) +
  geom_point(shape = 21,
             size = 2,
             lwd = 1.5,
             show.legend = T,
              alpha=1,
             fill = "#00A480",
             colour = "#00A480") +
  labs(x = "Date",
       y = "Opt-out rate")+
  theme(text = element_text(size = 8),
        axis.ticks = element_line(),
        axis.text = element_text(size = 8),
        axis.title = element_text(face = "bold"),
        axis.line = element_line(),
        axis.text.y = element_text(margin = margin(0.05,0,0.25,0)),
        plot.subtitle  = element_text(size = 10),
        panel.grid.minor = element_blank())

\newpage

Site specific recruitment

Recruitment (Registry database)

n_missing_dateoftransfer <-
  data %>%
  dplyr::filter(database == "ADNeT Registry",
                is.na(date_of_data_transfer))  %>%
  nrow()

graph_df <-
  data %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  mutate(
    date_of_data_transfer = as_date(date_of_data_transfer),
    date_of_data_transfer = round_date(date_of_data_transfer, "month")
  ) %>%
  arrange(date_of_data_transfer) %>%
  select(date_of_data_transfer) %>%
  drop_na()

graph_df <-
  graph_df %>%
  mutate(n_tot = row_number()) %>%
  group_by(date_of_data_transfer) %>%
  mutate(n_permonth = row_number()) %>%
  ungroup()

graph_df <-
  graph_df %>%
  group_by(date_of_data_transfer) %>%
  summarise(across(where(is.numeric), max)) %>%
  mutate(n_tot = n_tot - n_permonth) %>%
  pivot_longer(-date_of_data_transfer) %>%
  mutate(name = recode_factor(name,
    n_tot = "Cumulative",
    n_permonth = "Newly added"
  ))

graph_df <-
  graph_df %>%
  group_by(date_of_data_transfer) %>%
  mutate(n_tot = sum(value))

graph_df %>%
  ggplot(aes(
    x = date_of_data_transfer,
    y = value,
    fill = name
  )) +
  geom_col(
    # fill = "#00A480",
    col = "black"
  ) +
  geom_text(
    data = graph_df %>% dplyr::filter(name == "Cumulative"),
    aes(
      label = comma(n_tot, accuracy = 1),
      y = n_tot
    ),
    vjust = -1
  ) +
  labs(
    x = "Date",
    y = "Cumulative number of participants",
    fill = " ",
    caption = glue::glue("There are {n_missing_dateoftransfer} cases with missing date of data transfer")
  ) +
  scale_y_continuous(sec.axis = dup_axis(name = "")) +
  theme(legend.position = "bottom",
        legend.box = "horizontal")

graph_df %>%
  dplyr::filter(name == "Newly added") %>%
  ggplot(aes(
    x = date_of_data_transfer,
    y = value
  )) +
  geom_col(
    fill = "#00A480",
    col = "black"
  ) +
  geom_text(
    data = graph_df %>% dplyr::filter(name == "Newly added"),
    aes(
      label = comma(value, accuracy = 1),
      y = value
    ),
    vjust = -1
  ) +
  labs(
    x = "Date",
    y = "Number of newly added participants",
    fill = " ",
    caption = glue::glue("There are {n_missing_dateoftransfer} cases with missing date of data transfer")
  ) +
  scale_y_continuous(sec.axis = dup_axis(name = "")) +
  theme(legend.position = "bottom",
        legend.box = "horizontal")

Submission (All databases)

n_missing_completion_date <-
  data %>%
  dplyr::filter(is.na(dt_completed)) %>%
  nrow()

graph_df <-
  data %>%
  mutate(
    dt_completed = as_date(dt_completed),
    dt_completed = round_date(dt_completed, "month")
  ) %>%
  arrange(dt_completed) %>%
  select(dt_completed) %>%
  drop_na()

graph_df <-
  graph_df %>%
  mutate(n_tot = row_number()) %>%
  group_by(dt_completed) %>%
  mutate(n_permonth = row_number()) %>%
  ungroup()

graph_df <-
  graph_df %>%
  group_by(dt_completed) %>%
  summarise(across(where(is.numeric), max)) %>%
  mutate(n_tot = n_tot - n_permonth) %>%
  pivot_longer(-dt_completed) %>%
  mutate(name = recode_factor(name,
    n_tot = "Cumulative",
    n_permonth = "Newly added"
  ))

graph_df <-
  graph_df %>%
  group_by(dt_completed) %>%
  mutate(n_tot = sum(value))

graph_df %>%
  ggplot(aes(
    x = dt_completed,
    y = value,
    fill = name
  )) +
  geom_col(
    # fill = "#00A480",
    col = "black"
  ) +
  geom_text(
    data = graph_df %>% dplyr::filter(name == "Cumulative"),
    aes(
      label = comma(n_tot, accuracy = 1),
      y = n_tot
    ),
    vjust = -1
  ) +
  labs(
    x = "Date",
    y = "Cumulative number of participants",
    fill = " ",
    caption = glue::glue("There are {n_missing_completion_date} cases with missing date of completion")
  ) +
  scale_y_continuous(sec.axis = dup_axis(name = "")) +
  # scale_fill_manual(values = ADNeT_colour$accent) +
  # theme_cowplot() +
  theme(legend.position = "bottom",
        legend.box = "horizontal")

graph_df %>%
  dplyr::filter(name == "Newly added") %>%
  ggplot(aes(
    x = dt_completed,
    y = value,
    fill = name
  )) +
  geom_col(
    fill = "#00A480",
    col = "black"
  )+
  geom_text(
    data = graph_df %>% dplyr::filter(name == "Newly added"),
    aes(
      label = comma(value, accuracy = 1),
      y = value
    ),
    vjust = -1
  ) +
  labs(
    x = "Date",
    y = "Number of newly added participants",
    fill = " ",
    caption = glue::glue("There are {n_missing_completion_date} cases with missing date of completion")
  ) +
  scale_y_continuous(sec.axis = dup_axis(name = "")) +
  # scale_fill_manual(values = ADNeT_colour$accent) +
  # theme_cowplot() +
  theme(legend.position = "bottom",
        legend.box = "horizontal")

Demographics

tbl_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  mutate(
    pt_age_diagnosis = pt_age_diagnosis,
    pt_sex = fct_recode(pt_sex, `Not stated` = "Not stated/inadequately described") %>%
      fct_relevel(c("Female", "Male", "Not stated")),
    pt_atsi = fct_collapse(
      pt_atsi,
      `Aboriginal and/or Torres Strait Islander` = c(
        "Aboriginal, not Torres Strait Islander",
        "Torres Strait Islander, not Aboriginal"
      ),
      `Neither Aboriginal or Torres Strait Islander` =
        "Neither Aboriginal or Torres Strait Islander",
      `Not stated` = "Not stated/inadequately described"
    ) %>%
      fct_relevel(c(
        "Aboriginal and/or Torres Strait Islander",
        "Neither Aboriginal or Torres Strait Islander",
        "Not stated"
      )),

    # country of birth
    country_of_birth = na_if(pt_countryofbirth, "Not stated/inadequately described"),
    country_of_birth = fct_lump(country_of_birth, n = 5),
    country_of_birth = fct_other(country_of_birth, drop = "Other, please specify"),
    country_of_birth = fct_explicit_na(country_of_birth, "Not stated"),

    # preferred language
    preferred_language = na_if(pt_spokenlanguage, "Not stated/inadequately described"),
    preferred_language = fct_lump(preferred_language, n = 5),
    preferred_language = fct_other(preferred_language, drop = "Other, please specify"),
    preferred_language = fct_explicit_na(preferred_language, "Not stated"),
    pt_edu = pt_edu %>%
      fct_collapse(
        `Primary education or less` = c("No education", "Primary education or lower"),
        `Secondary education` = c(
          "Junior secondary education (up to year 10)",
          "Senior secondary education (year 11 and above)"
        ),
        `Tertiary education or higher` = "Tertiary education",
        `Not stated` = "Not stated/inadequately described"
      ) %>%
      factor(levels = c(
        "Primary education or less",
        "Secondary education",
        "Tertiary education or higher",
        "Not stated"
      )),
    pt_emp_status = pt_emp_status %>%
      fct_collapse(
        `Employed` = "Employed",
        `Retired/not in labour force` = c("Unemployed", "Not in the labour force"),
        `Not stated` = "Not stated/inadequately described"
      ) %>%
      factor(levels = c(
        "Employed", "Retired/not in labour force",
        "Not stated"
      )),
    pt_residential = na_if(pt_residential, "Not stated/inadequately described"),
    pt_residential = fct_lump(pt_residential, n = 5),
    pt_residential = fct_other(pt_residential, drop = "Other, please specify"),
    pt_residential = fct_explicit_na(pt_residential, "Not stated"),
    pt_living = pt_living %>%
      fct_collapse(
        `Living alone` = "Lives alone",
        `Living with family or others` = c(
          "Lives with others",
          "Lives with family"
        ),
        `Not stated` = "Not stated/inadequately described"
      ) %>%
      factor(levels = c(
        "Living alone", "Living with family or others",
        "Not stated"
      )) %>%
      fct_explicit_na("Not stated")
  ) %>%
  mutate(across(where(is.factor), fct_drop))

tbl_labels <- list(
  pt_age_diagnosis = "Age at diagnosis (years)",
  pt_sex = "Sex, n (%)",
  pt_atsi = "Aboriginal and/or Torres Strait Islander, n (%)",
  country_of_birth = "Country of birth, n (%)",
  preferred_language = "Preferred spoken language, n (%)",
  pt_edu = "Highest education level, n (%)",
  pt_emp_status = "Labour force status, n (%)",
  pt_residential = "Residential setting, n (%)",
  pt_living = "Living arrangement, n (%)",
  dx = "Diagnosis",
  dx_dementia = "Dementia subtype",
  dx_mci_subtype = "MCI subtype"
)

tbl_control <-
  tableby.control(
    test = FALSE,
    total = TRUE,
    numeric.stats = c("N",  "meansd", "medianq1q3", "range", "Nmiss2"),
    cat.stats = c("N", "countpct"),
    stats.labels = c(Nmiss2 = "Missing"),
    digits = 1
  )

tab1 <- tableby(dx ~ pt_age_diagnosis + pt_sex + pt_atsi + country_of_birth + preferred_language +
  pt_edu + pt_emp_status + pt_residential + pt_living,
data = tbl_df,
control = tbl_control
)

summary(tab1, labelTranslations = tbl_labels)

graph_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  count(category, dx) %>%
  group_by(category) %>%
  mutate(pct = n / sum(n),
         label = glue::glue("{n} ({percent(pct, accuracy = 1)})"),
         category = str_wrap(category, 20))

graph_df %>%
  ggplot(aes(x = pct, y = category, fill = dx)) +
  geom_col(width = 0.5) +
  geom_text(aes(label = label),
            hjust = 1.5) +
  scale_x_continuous(expand = c(0, 0),
                     label = percent) +
  labs(x = "Percentage of participants",
       y = "",
       fill = "")

graph_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  mutate(pt_edu = as.factor(pt_edu),
         pt_edu = fct_explicit_na(pt_edu, "Not stated/inadequately described"),
         pt_edu = fct_relevel(pt_edu, 
                              "Not stated/inadequately described",
                              "No education",
                              "Primary education or lower",
                              "Junior secondary education (up to year 10)",
                              "Senior secondary education (year 11 and above)")
         ) %>%
  count(category, pt_edu, .drop = FALSE) %>%
  group_by(category) %>%
  mutate(pct = n / sum(n),
         label = glue::glue("{n} ({percent(pct, accuracy = 1)})"),
         category = str_wrap(category, 30),
         pt_edu = str_wrap(pt_edu, 30))

graph_df %>%
  ggplot(aes(x = pct, y = pt_edu, fill = category)) +
  geom_col(width = 0.5,
           position = position_dodge()) +
  geom_text(aes(label = label),
            hjust = 0,
            position = position_dodge(width = 0.5)) +
  scale_x_continuous(expand = c(0, 0),
                     label = percent,
                     limits = c(0, max(graph_df$pct) + 0.1)) +
  labs(x = "Percentage of participants",
       y = "",
       fill = "") +
  theme(legend.position = "bottom")

graph_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  mutate(pt_living = as.factor(pt_living),
         pt_living = fct_explicit_na(pt_living, "Not stated/inadequately described"),
         pt_living = fct_relevel(pt_living,
                              "Not stated/inadequately described")
         ) %>%
  count(category, pt_living, .drop = FALSE) %>%
  group_by(category) %>%
  mutate(pct = n / sum(n),
         label = glue::glue("{n} ({percent(pct, accuracy = 1)})"),
         category = str_wrap(category, 30),
         pt_living = str_wrap(pt_living, 30))

graph_df %>%
  ggplot(aes(x = pct, y = pt_living, fill = category)) +
  geom_col(width = 0.5,
           position = position_dodge()) +
  geom_text(aes(label = label),
            hjust = 0,
            position = position_dodge(width = 0.5)) +
  scale_x_continuous(expand = c(0, 0),
                     label = percent,
                     limits = c(0, max(graph_df$pct) + 0.1)) +
  labs(x = "Percentage of participants",
       y = "",
       fill = "") +
  theme(legend.position = "bottom")

Participant Clinical Profile

tbl_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  select(dx, pt_time_to_appt, date_ref, initial_appt, date_dx, category)

tab1 <- tableby(category ~ dx,
  data = tbl_df,
  control = tbl_control
)

summary(tab1,
  labelTranslations = tbl_labels,
  title = "Diagnosis"
)

tbl_df <-
  data_all %>%
  dplyr::filter(
    database == "ADNeT Registry",
    dx == "Dementia"
  )

tab1 <- tableby(category ~ dx_dementia,
  data = tbl_df,
  control = tbl_control
)

summary(tab1,
  labelTranslations = tbl_labels,
  title = "Dementia subtype"
)

graph_df <-
  data_all %>%
  dplyr::filter(
    database == "ADNeT Registry",
    dx == "Dementia"
  ) %>%
  count(category, dx_dementia, .drop = FALSE) %>%
  group_by(category) %>%
  mutate(pct = n /sum(n),
         label = glue::glue("{n} ({percent(pct, accuracy = 1)})"),
         dx_dementia = fct_rev(dx_dementia),
         category = str_wrap(category, 30))

graph_df %>%
  ggplot(aes(x = pct, y = dx_dementia, fill = category)) +
  geom_col(position = position_dodge()) +
  geom_text(aes(label = label),
            position = position_dodge(width = 0.5),
            hjust = -0.2) +
  scale_x_continuous(limits = c(0, max(graph_df$pct) + 0.1),
                     expand = c(0, 0),
                     label = percent_format()) +
  labs(x = "Percentage of participants",
       y = "",
       fill = "") +
  theme(legend.position = "bottom")

tbl_df <-
  data_all %>%
  dplyr::filter(
    database == "ADNeT Registry",
    dx == "MCI"
  ) %>%
  select(dx_mci_subtype, category) %>%
  mutate(
    dx_mci_subtype = fct_relevel(
      dx_mci_subtype,
      "Amnestic, single domain",
      "Amnestic, multi-domain",
      "Non-amnestic, single domain",
      "Non-amnestic, multi-domain",
      "Not stated/inadequately described"
    ),
    dx_mci_subtype = fct_recode(dx_mci_subtype,
      `Not stated` = "Not stated/inadequately described"
    )
  )

tab1 <- tableby(category ~ dx_mci_subtype,
  data = tbl_df,
  control = tbl_control
)

summary(tab1,
  labelTranslations = tbl_labels,
  title = "MCI subtype"
)

PROPORTION OF DEMENTIA AND MCI

graph_df <-
  data_all %>%
  dplyr::filter(!is.na(dx) & database == "ADNeT Registry") %>%
  count(dx, category, .drop = FALSE) %>%
  group_by(category) %>%
  mutate(
    pct = round(100 * n / sum(n)),
    label = glue::glue("{n} ({pct}%)"),
    category = str_wrap(category, 30)
  )

graph_df %>%
  ggplot(aes(x = category, y = pct, fill = factor(dx) %>% fct_rev())) +
  geom_col(
    width = 0.5,
    col = "black"
  ) +
  geom_text(aes(label = label),
    position = position_stack(vjust = 0.5),
    col = "white"
  ) +
  scale_y_continuous(expand = c(0, 0)) +
  labs(x = "", 
       y = "Percentage of patients",
       fill = "") +
  # scale_fill_manual(
  #   name = "",
  #   values = c("#152144", "#00A480")
  # ) +
  # theme_cowplot() +
  theme(
    text = element_text(size = 16), axis.text = element_text(size = rel(1)),
    legend.position = "top",
    legend.direction = "horizontal"
  )

DISTRIBUTION OF DEMENTIA SUBTYPE

graph_df <-
  data_all %>%
  dplyr::filter(database == "ADNeT Registry", dx == "Dementia") %>%
  mutate(dx_dementia = as_factor(dx_dementia),
         category = as_factor(category)) %>%
  count(dx_dementia, category, .drop = FALSE)%>%
  group_by(category) %>%
  mutate(
    pct = n / sum(n),
    dx_dementia = fct_rev(dx_dementia),
    label = glue::glue("{n} ({percent(pct, accuracy = 0.1)})"),
    hjust = if_else(pct < 0.1,
      -0.2,
      1
    ),
    col = pct < 0.1
  )

graph_df %>%
  ggplot(aes(x = pct, y = dx_dementia, fill = category)) +
  geom_col(width = 0.8, position = "dodge")+
  geom_text(aes(label = label, 
                # hjust = hjust, 
                # col = col
                ),
            hjust = -0.2,
    position = position_dodge(width = 0.5)
  ) +
  labs(
    y = "", x = "Percentage of patients",
    caption = "* Mixed Alzheimer’s and Vascular include participants with both Alzheimer’s Disease and 
    Vascular Dementia with or without another dementia subtype"
  ) +
  scale_fill_manual(name = "", values = c("#152144", "#00A480")) +
  # scale_colour_manual(name = "", values = c("white", "black")) +
  scale_x_continuous(labels = percent,
                     limits = c(NA, max(graph_df$pct) + 0.2)) +
  # scale_y_discrete(drop = FALSE) +
  # theme_cowplot() +
  theme(
    text = element_text(size = 16),
    axis.text = element_text(size = rel(1)),
    axis.text.y = element_text(size = rel(1)),
    # legend.position = "none",
    plot.caption.position =  "plot",
    plot.caption = element_text(hjust = 0, size = 12, margin = margin(t = 30))
  ) +
  guides(fill = guide_legend(reverse = TRUE), 
         colour = "none"
         )

\newpage

Clinical information

all_df <- 
  data %>%
  dplyr::filter(database == "ADNeT Registry", dx %in% c("Dementia", "MCI")) %>%
  mutate(
    mobil = case_when(
      mobil == "Yes, independent with/without gait aid" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    bladder_bowel_inc = case_when(
      bladder_bowel_inc == "Continent of urine and faeces" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_stroke = case_when(
      pt_stroke > 0 & pt_stroke != 99 ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_hypertension = case_when(
      str_detect(pt_hypertension, "Yes") ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_diabetes = case_when(
      pt_diabetes == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_heart_disease = case_when(
      pt_heart_disease == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_cancer = case_when(
      pt_cancer == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_falls = case_when(
      pt_falls == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    instrumental_adl = case_when(
      instrumental_adl == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    personal_adl = case_when(
      personal_adl == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes")),
    pt_driving = case_when(
      pt_driving == "Yes" ~ "Yes",
      TRUE ~ "No"
    ) %>%
      factor(levels = c("No", "Yes"))
  )

tbl_all <- all_df %>%
  select(
    dx,

    # Subgroup 1: Cognitive tests
    mmse_score, moca_score, rudas_score,

    # Subgroup 2: Function and falls
    mobil, pt_falls, bladder_bowel_inc, personal_adl, instrumental_adl, pt_driving,

    # Subgroup 3: Medications
    tot_med,

    # Subgroup 4: Medical history
    pt_hypertension, pt_diabetes, pt_heart_disease, pt_stroke, pt_cancer
  )


tbl_labels <- list(
  mmse_score = "MMSE",
  rudas_score = "RUDAS",
  moca_score = "MoCA",
  mobil = "Mobility independent",
  pt_falls = "Falls in past 12 months",
  bladder_bowel_inc = "Continent",
  personal_adl = "pADLs independent",
  instrumental_adl = "iADLs independent",
  pt_driving = "Driving",
  tot_med = "Number of medications, median (Q1-Q3)",
  pt_stroke = "Stroke",
  pt_hypertension = "Hypertension",
  pt_diabetes = "Diabetes",
  pt_heart_disease = "Cardiovascular disease",
  pt_cancer = "Cancer"
)

tbl_control <-
  tableby.control(
    test = FALSE,
    total = TRUE,
    numeric.stats = c("N",  "meansd", "medianq1q3", "range", "Nmiss2"),
    cat.stats = c("N", "countpct"),
    stats.labels = c(Nmiss2 = "Not completed"),
    digits = 1
  )

tab1 <- tableby(dx ~ mmse_score + rudas_score + moca_score,
data = tbl_all,
control = tbl_control,
cat.simplify = TRUE
)

tbl_control <-
  tableby.control(
    test = FALSE,
    total = TRUE,
    numeric.stats = c("N",  "meansd", "medianq1q3", "range", "Nmiss2"),
    cat.stats = c("N", "countpct"),
    stats.labels = c(Nmiss2 = "Missing"),
    digits = 1
  )

tab2 <- tableby(dx ~ mobil + pt_falls + bladder_bowel_inc +
  personal_adl + instrumental_adl + pt_driving + tot_med + pt_stroke +
  pt_hypertension + pt_diabetes + pt_heart_disease + pt_cancer,
data = tbl_all,
control = tbl_control,
cat.simplify = TRUE
)

tab12 <- merge(tab1, tab2)

summary(tab12, labelTranslations = tbl_labels)

\newpage

Clinical Processes

all_df <-
  data %>%
  dplyr::filter(database == "ADNeT Registry",
                (pt_exist_dx_mci != "Yes" | is.na(pt_exist_dx_mci))
                ) %>%
  select(
    dx,
    site_name,

    # Subgroup 1: Referral time intervals
    pt_time_to_appt, date_ref, initial_appt, date_dx) %>%
  transmute(
    dx = dx,
    site = site_name,
    pt_time_ref_dx = difftime(date_dx, date_ref, unit = "days"),
    pt_time_to_appt = pt_time_to_appt,
    pt_time_appt_dx = difftime(date_dx, initial_appt, unit = "days"))

tbl_labels <-
  list(
    pt_time_ref_dx = "Referral to diagnosis, median (Q1-Q3)",
    pt_time_to_appt = "Referral to first appointment, median (Q1-Q3)",
    pt_time_appt_dx = "First appointment to diagnosis, median (Q1-Q3)"
  )

tab1 <- tableby(dx ~ pt_time_ref_dx + pt_time_to_appt + pt_time_appt_dx,
data = all_df,
control = tbl_control,
cat.simplify = TRUE
)

summary(tab1, labelTranslations = tbl_labels)

all_df <-
  data %>%
  dplyr::filter(database == "ADNeT Registry") %>%
  select(
    dx,
    site_name,
    date_ref,

    # Subgroup 1: Referral time intervals
    #pt_time_to_appt,  initial_appt, date_dx,

    # Subgroup 2: Investigations
    blood_test,
    structural_imaging___1, structural_imaging___2, structural_imaging___3,
    structural_imaging___99,
    functional_imaging___1, functional_imaging___2, functional_imaging___3,
    functional_imaging___4, functional_imaging___5, functional_imaging___99,
    lp,

    # Subgroup 3: CHEI Prescription
    achei,

    # Subgroup 4: CHEI Prescription details
    dx_dem_subtype___1, mmse_score,

    # Subgroup 5: Interest in research participation
    pt_research_interest
  ) %>%
  transmute(
    dx = dx,
    site = site_name,
    # pt_time_ref_dx = difftime(date_dx, date_ref, unit = "days"),
    # pt_time_to_appt = pt_time_to_appt,
    # pt_time_appt_dx = difftime(date_dx, initial_appt, unit = "days"),
    unknown_referral = is.na(date_ref),
    blood_test = case_when(
      blood_test == "Yes" ~ "Completed",
      blood_test == "No" ~ "Not Completed",
      is.na(blood_test) | blood_test == "Not stated/inadequately described" ~ "Not stated"
    ) %>% factor(c("Completed", "Not completed", "Not stated")),
    structural_imaging___1 = case_when(
      structural_imaging___1 == "Checked" ~ "Yes",
      structural_imaging___1 == "Unchecked" ~ "No"
    ),
    structural_imaging___2 = case_when(
      structural_imaging___2 == "Checked" ~ "Yes",
      structural_imaging___2 == "Unchecked" ~ "No"
    ),
    structural_imaging___3 = case_when(
      structural_imaging___3 == "Checked" ~ "Yes",
      structural_imaging___3 == "Unchecked" ~ "No"
    ),
    structural_imaging___99 = case_when(
      structural_imaging___99 == "Checked" ~ "Yes",
      structural_imaging___99 == "Unchecked" ~ "No"
    ),
    functional_imaging___2 = case_when(
      functional_imaging___2 == "Checked" ~ "Yes",
      functional_imaging___2 == "Unchecked" ~ "No"
    ),
    functional_imaging___1 = case_when(
      functional_imaging___1 == "Checked" ~ "Yes",
      functional_imaging___1 == "Unchecked" ~ "No"
    ),
    functional_imaging___3_4 = case_when(
      functional_imaging___3 == "Checked" | functional_imaging___4 == "Checked" ~ "Yes",
      functional_imaging___3 == "Unchecked" & functional_imaging___4 == "Unchecked" ~ "No"
    ),
    functional_imaging___5 = case_when(
      functional_imaging___5 == "Checked" ~ "Yes",
      functional_imaging___5 == "Unchecked" ~ "No",
    ),
    functional_imaging___99 = case_when(
      functional_imaging___99 == "Checked" ~ "Yes",
      functional_imaging___99 == "Unchecked" ~ "No",
    ),
    lp = case_when(
      lp == "Yes" ~ "Completed",
      lp == "No" ~ "Not completed",
      is.na(lp) | lp == "Not stated/inadequately described" ~ "Not stated"
    ) %>% factor(c("Completed", "Not completed", "Not stated")),
    chei_status = case_when(
      achei %in% c(
        "Yes, donepezil (Aricept)", "Yes, rivastigmine (Exelon)",
        "Yes, galantamine (Reminyl)"
      ) ~ "Any CHEI recommended or prescribed",
      achei == "No" ~ "No CHEI recommended or prescribed",
      achei %in% c(
        "Yes, drug not specified",
        "Not stated/inadequately described"
      ) | is.na(achei) ~ "Not Stated"
    ) %>% factor(levels = c("Any CHEI recommended or prescribed", "No CHEI recommended or prescribed", " Not Stated")),
    chei_prescribed = case_when(
      achei == "Yes, donepezil (Aricept)" ~ "Donepezil",
      achei == "Yes, rivastigmine (Exelon)" ~ "Rivastigmine",
      achei == "Yes, galantamine (Reminyl)" ~ "Galantamine"
    ) %>% factor(levels = c("Donepezil", "Rivastigmine", "Galantamine")),
    chei_subtype = case_when(
      chei_status == "Any CHEI recommended or prescribed" & dx_dem_subtype___1 == "Checked" ~ "In Dementia with AD subtype (all)",
      chei_status == "Any CHEI recommended or prescribed" & dx_dem_subtype___1 != "Checked" ~ "In Dementia with non-AD subtypes"
    ) %>% factor(levels = c("In Dementia with AD subtype (all)", "In Dementia with non-AD subtypes")),
    chei_ad_mmse = case_when(
      chei_status == "Any CHEI recommended or prescribed" & dx_dem_subtype___1 == "Checked" & mmse_score >= 10 ~ "In Dementia with AD subtype, MMSE >= 10",
      chei_status == "Any CHEI recommended or prescribed" & dx_dem_subtype___1 == "Checked" & mmse_score < 10 ~ "In Dementia with AD subtype, MMSE < 10",
      chei_status == "Any CHEI recommended or prescribed" & dx_dem_subtype___1 == "Checked" & is.na(mmse_score) ~ "In Dementia with AD subtype, No MMSE"
    ) %>% factor(levels = c("In Dementia with AD subtype, MMSE >= 10", "In Dementia with AD subtype, MMSE < 10", "In Dementia with AD subtype, No MMSE")),
    pt_research_interest = factor(pt_research_interest, c("Yes", "No", "Not determined"))
  )


tbl_labels <-
  list(
    unknown_referral = "Unknown referral date, n (\\%)",
    blood_test = "Core blood tests, n (\\%)",
    structural_imaging___2 = "MRI Brain",
    structural_imaging___1 = "CT Brain",
    structural_imaging___3 = "None completed",
    structural_imaging___99 = "Not stated",
    functional_imaging___2 = "FDG PET",
    functional_imaging___1 = "SPECT",
    functional_imaging___3_4 = "Amyloid/Tau PET",
    functional_imaging___5 = "None completed",
    functional_imaging___99 = "Not stated",
    lp = "Lumbar puncture, n (\\%)",
    chei_status = "CHEI Prescription Status",
    chei_prescribed = "Type of CHEI recommended/prescribed",
    # chei_unspecified ~ "CHEI unspecified",

    chei_ad_mmse = "CHEI in AD subtype by MMSE status",
    chei_subtype = "CHEI by AD subtype",
    pt_research_interest = "Interest in Research participation"
  )

# tbl_control <-
#   tableby.control(numeric.stats = c("Nmiss", "medianq1q3"),
#                   stats.labels = c(Nmiss = "Missing"))

tab1 <- tableby(dx ~ unknown_referral + blood_test +
  structural_imaging___1 + structural_imaging___2 + structural_imaging___3 +
  structural_imaging___99 + functional_imaging___2 + functional_imaging___1 +
  functional_imaging___3_4 + functional_imaging___5 +
  functional_imaging___99 + lp + chei_status + chei_prescribed + chei_ad_mmse + chei_subtype +
  pt_research_interest,
data = all_df,
control = tbl_control,
cat.simplify = TRUE
)

summary(tab1, labelTranslations = tbl_labels)

\newpage

Baseline Patient and Survey Results

all_df <- data %>% 
  dplyr::filter(
      (database == "ADNeT Registry" &
      #  dt_pes_sent >= "2021-01-16" &
      # pt_optoutcapacity == "Yes" & dx_communicated == "Yes" &
      !is.na(dt_bs_ptsur_sent)) |

      (database == "ADNeT Registry" &
      #  dt_pes_sent >= "2021-01-16" &
      # (pr_also_cr == "Yes" | (pt_optoutcapacity == "Yes" & cr_dx_communicated == "Yes")) &
      !is.na(dt_bs_crsur_sent))
  ) %>%
  transmute(

    site_name = site_name, 

    patient.survey = case_when(

      database == "ADNeT Registry" &
      !between(dt_bs_ptsur_sent,Sys.Date()-14, Sys.Date()) &
      is.na(bs_ptsur_rts) & 
      is.na(bs_ptsur_rem_rts) &
      adnet_registry_baseline_patient_survey_complete == "Complete" ~ 1,

      database == "ADNeT Registry" &
      dt_pes_sent >= "2021-01-16" &
      pt_optoutcapacity == "Yes" & dx_communicated == "Yes" &
      is.na(bs_ptsur_rts) &
      !is.na(dt_bs_ptsur_sent) ~ 0
    ) %>% factor(levels = c(0,1)),

    carer.survey = case_when(

      database == "ADNeT Registry" & 
        dt_pes_sent >= "2021-01-16" &
      # dt_bs_crsur_en <= "2021-11-08" & dt_bs_crsur_rec <= "2021-11-08" &
      (pr_also_cr == "Yes" | (pt_optoutcapacity == "Yes" & cr_dx_communicated == "Yes")) &
      is.na(bs_crsur_rts) &
      !between(dt_bs_crsur_sent,Sys.Date()-14, Sys.Date()) &
      adnet_registry_baseline_carer_survey_complete == "Complete" ~ 1,

      database == "ADNeT Registry" &
      is.na(bs_crsur_rts) &
      !is.na(dt_bs_crsur_sent) ~ 0
    ) %>% factor(levels = c(0,1))
  ) %>%
  mutate(site_name = "All sites")

tbl_control <-
  tableby.control(
    test = FALSE,
    total = FALSE,
    numeric.stats = c("N",  "meansd", "medianq1q3", "range", "Nmiss2"),
    cat.stats = c("countpct"),
    stats.labels = c(Nmiss2 = "Missing"),
    digits = 1
  )

tbl_labels <-
  list(
    # pt_time_ref_dx = "Referral to diagnosis, median (Q1-Q3)",
    # pt_time_to_appt = "Referral to first appointment, median (Q1-Q3)",
    # pt_time_appt_dx = "First appointment to diagnosis, median (Q1-Q3)",
    patient.survey = "Patient survey, n/N (\\%)",
    carer.survey = "Carer survey, n/N (\\%)"
  )


tab1 <- tableby(site_name ~ patient.survey + carer.survey,
data = all_df,
control = tbl_control,
cat.simplify = TRUE
)


summary(tab1, labelTranslations = tbl_labels)

graph_df <- 
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>% 
  select(category, site_name, pt_wellbeing, cr_wellbeing) %>%
  mutate(across(c("pt_wellbeing", "cr_wellbeing"), ~case_when(
      str_detect(., "poor|Poor") ~ "Very Poor / Poor",
      str_detect(., "good|Good") ~ "Good / Very Good",
      # str_detect(x, "Poor") ~ "Poor",
      str_detect(., "Fair") ~ "Fair",
      # str_detect(x, "Good") ~ "Good",
    ) %>%
      factor(levels = c("Very Poor / Poor", "Fair", "Good / Very Good"),
             labels = c("Very Poor/Poor", "Fair", "Good/Very Good"))
  )) %>% 
  pivot_longer(c(pt_wellbeing, cr_wellbeing)) %>% 
  drop_na() %>%
  count(category, name, value) %>% 
  mutate(
    name = case_when(
      name == "pt_wellbeing" ~ "Patient",
      name == "cr_wellbeing" ~ "Carer"
    ) %>% factor(c("Patient", "Carer"))) %>%
  group_by(category, name) %>%
  mutate(
    pct = n/sum(n),
    label = glue::glue("{n} ({percent(pct, accuracy = 1)})"),
    category = str_wrap(category, 30)
  )


graph_df %>% 
  dplyr::filter(name == "Patient") %>%
  ggplot(aes(x = pct, y = category, fill = value, label = label)) +
  geom_col(width = 0.4) +
  geom_text(col = "white",
            position = position_stack(vjust = 0.5)) +
  scale_x_continuous(label = percent_format(accuracy = 1),
                     expand = c(0, 0)) +
  labs(x = "Percentage of participants",
       y = "",
       fill = "",
       title = "Patient reported wellbeing")

vars <- c("pt_exp_dx","pt_exp_deci","pt_exp_quest","pt_exp_concern", "pt_exp_treatm",
          "pt_exp_advice","pt_exp_expect",
          "cr_adeq_info","cr_involvment","cr_opp_quest","cr_listened",
          "cr_treated","cr_advice_given","cr_exp_expect")


graph_df <- 
  data_all %>%
  dplyr::filter(database == "ADNeT Registry") %>% 
  select(category, record_id, vars, pt_exp, cr_exp) %>%
  mutate(across(vars, ~case_when(
      str_detect(., "disagree|Disagree") ~ "Disagree / Totally Disagree",
      str_detect(., "agree|Agree") ~ "Agree / Totally Agree",
      str_detect(., "Neutral") ~ "Neutral",
    ) %>%
      factor(
        levels = c("Disagree / Totally Disagree", "Neutral", "Agree / Totally Agree"),
        labels = c(
          "Disagree / Totally Disagree ",
          "Neutral",
          "Agree / Totally Agree")
        ))
    )  %>% 
  mutate(across(c("pt_exp","cr_exp"), ~ case_when(
      str_detect(., "poor|Poor") ~ "Very Poor / Poor",
      str_detect(., "good|Good") ~ "Good / Very Good",
      str_detect(., "Fair") ~ "Fair",
    ) %>%
      factor(
        levels = c("Very Poor / Poor", "Fair", "Good / Very Good"),
        labels = c(
          "Very Poor / Poor  ",
          "Fair             ",
          "Good / Very Good "
        )
    ))
    ) %>%
  pivot_longer(-c(record_id, category)) %>% 
  drop_na() %>%
  mutate(
    type = case_when(
      str_detect(name,"pt_") ~ "Patient",
      str_detect(name,"cr_") ~ "Carer"
    ) %>% factor(c("Patient", "Carer")),
    name = case_when(
      name %in% c("pt_exp_dx","cr_adeq_info") ~ "Received adequate diagnosis information",
      name %in% c("pt_exp_deci","cr_involvment") ~ "Involved in making decisions",
      name %in% c("pt_exp_quest","cr_opp_quest") ~ "Opportunity to ask questions",
      name %in% c("pt_exp_concern","cr_listened") ~ "Views and concerns were heard",
      name %in% c("pt_exp_treatm","cr_treated") ~ "Treated with dignity and respect",
      name %in% c("pt_exp_advice","cr_advice_given") ~ "Advised about more info",
      name %in% c("pt_exp","cr_exp") ~ "Overall experience",
      name %in% c("pt_exp_expect","cr_exp_expect") ~ "Meeting expectations"
    ) %>%
      factor(levels = c("Received adequate diagnosis information",
                        "Involved in making decisions",
                        "Opportunity to ask questions",
                        "Views and concerns were heard",
                        "Treated with dignity and respect",
                        "Advised about more info",
                        "Overall experience",
                        "Meeting expectations"))
    )

graph_df <-
  graph_df %>%
  group_by(name,type, category) %>%
  add_count() %>%
  group_by(name,type,value,category) %>%
  summarise(total = max(n),
            complete = n(),
            pct = complete/total,
            label = glue::glue("{complete} ", "({percent(pct, accuracy = 1)})")) %>%
  mutate(name = str_wrap(name, 30),
         category = str_wrap(category, 30))

graph_df %>%
  dplyr::filter(type == "Patient",
                str_detect(name, "Advised|Overall|Meeting")) %>%
  ggplot(aes(x = value, y = pct, fill = category, group = category)) +
  geom_col(position = position_dodge(width = 0.9)) +
  # facet_wrap(~name, scales = "free", nrow = 4) +
  geom_text(aes( x = value,
              y = pct, 
              label = label,
              group = category),
          position = position_dodge(width = 0.9),
          hjust = -0.35,
          size = 3) +
  facet_wrap(~ name, scales = "free_y", ncol = 1) +
  labs(title = "Patient reported experience") +
  theme(axis.text = element_text(size = 10),
        plot.subtitle = element_text(size = 10,
                                     hjust = 0.5),
        legend.title = element_blank(),
        legend.text = element_text(size = 10),
        axis.title = element_blank(),
        legend.position = "bottom"
      # axis.text = element_text(size = 12)
    ) +
  scale_y_continuous(expand = c(0,0), 
                     limits = c(0, max(graph_df$pct) + 0.01),
                     label = percent_format(accuracy = 1)) +
  scale_x_discrete(expand = c(0.1,0.5)) +
  coord_flip()

farhadsalimi/registryr documentation built on June 24, 2022, 12:23 a.m.

rdrr.io home R language documentation Run R code online

CRAN packages Bioconductor packages R-Forge packages GitHub packages

Note that we can't provide technical support on individual packages. You should contact the package authors for that.

farhadsalimi/registryr
Functions for the Clinical Registries Analyses

In farhadsalimi/registryr: Functions for the Clinical Registries Analyses

RECRUITMENT

Overall recruitment

Opt-out rate

Overall opt-out table

Culminative overall opt-out rates (internal value) over the past 12 months

Site specific recruitment

Recruitment (Registry database)

Submission (All databases)

Demographics

Participant Clinical Profile

PROPORTION OF DEMENTIA AND MCI

DISTRIBUTION OF DEMENTIA SUBTYPE

Clinical information

Clinical Processes

Baseline Patient and Survey Results

R Package Documentation

Browse R Packages

We want your feedback!

farhadsalimi/registryr Functions for the Clinical Registries Analyses

In farhadsalimi/registryr: Functions for the Clinical Registries Analyses

RECRUITMENT

Overall recruitment

Opt-out rate

Overall opt-out table

Culminative overall opt-out rates (internal value) over the past 12 months

Site specific recruitment

Recruitment (Registry database)

Submission (All databases)

Demographics

Participant Clinical Profile

PROPORTION OF DEMENTIA AND MCI

DISTRIBUTION OF DEMENTIA SUBTYPE

Clinical information

Clinical Processes

Baseline Patient and Survey Results

R Package Documentation

Browse R Packages

We want your feedback!

farhadsalimi/registryr
Functions for the Clinical Registries Analyses