689 lines
25 KiB
Plaintext
689 lines
25 KiB
Plaintext
---
|
|
title: "Code Snippets Audit"
|
|
output:
|
|
html_document:
|
|
df_print: paged
|
|
---
|
|
|
|
|
|
|
|
|
|
<!--This code imports the data from a validly labelled and named csv file, runs mathematical calculations on the data, and also generates charts to present the data. It is provided with my audit for reproducibility purposes if necessary. It requires the 'R' runtime environment to work and Rstudio is the recommended program to run it. -->
|
|
|
|
# collection of snippets for the data collection
|
|
|
|
# Setup and calculations
|
|
|
|
|
|
|
|
```{r setup, include=TRUE, echo=TRUE}
|
|
library(readr)
|
|
library(ggplot2)
|
|
library(dplyr)
|
|
library(tidyverse)
|
|
library(gridExtra)
|
|
library(ggflowchart)
|
|
library(tibble)
|
|
|
|
|
|
# Read the HtnData.csv file with specified column types
|
|
HtnData <- read_csv("HtnData.csv", col_types = cols(
|
|
row.names = col_integer(),
|
|
Patient_ID = col_integer(),
|
|
Progress_Note_Date = col_character(),
|
|
Age = col_integer(),
|
|
Patient_Female = col_logical(),
|
|
Patient_ATSI_Status = col_character(),
|
|
Presentation_Symptoms = col_character(),
|
|
Organisation_Name = col_integer(),
|
|
Inclusion_Crit = col_logical(),
|
|
HbA1c = col_logical(),
|
|
Lipid = col_logical(),
|
|
U_E = col_logical(),
|
|
Dip_Urine = col_logical(),
|
|
ACR_Urine = col_logical(),
|
|
Lifestyle_Discussion = col_logical(),
|
|
HTN_MGMT_PLN = col_logical(),
|
|
c715_Check = col_logical(),
|
|
c3_MO_FLWP_STBL = col_logical(),
|
|
c6_MO_BP = col_logical(),
|
|
c3_MO_RVW_LFSTL = col_logical(),
|
|
c2_4_WK_RVW_ACE = col_logical(),
|
|
))
|
|
|
|
|
|
|
|
# cleans the data somewhat. If there are inexplicable rows of NA, they will be removed
|
|
HtnData <- HtnData[!is.na(HtnData$Patient_ID), ]
|
|
|
|
# Display the dataframe for perusal
|
|
print(HtnData)
|
|
|
|
# Show data outputs below
|
|
|
|
## Calculate the average age of patients
|
|
average_age <- mean(HtnData$Age)
|
|
print(paste("The average age of patients is:", round(average_age, 0)))
|
|
|
|
|
|
# Convert Inclusion_Crit to numeric if it's not already
|
|
HtnData$Inclusion_Crit <- as.numeric(HtnData$Inclusion_Crit)
|
|
|
|
# Calculates the percentage of patients that met the inclusion criteria
|
|
inclusion_percentage <- mean(HtnData$Inclusion_Crit) * 100
|
|
print(paste("The percentage of patients who met the inclusion criteria is:", round(inclusion_percentage, 2), "%"))
|
|
|
|
# everything below this point only deals with data where Inclusion_Crit is equal to 1
|
|
HtnDataold <- HtnData
|
|
HtnData <- HtnData[HtnData$Inclusion_Crit == 1, ]
|
|
|
|
## Calculate the average age of patients
|
|
average_age_included <- mean(HtnData$Age)
|
|
print(paste("The average age of patients is:", round(average_age_included, 0)))
|
|
|
|
##histogram of the Age data
|
|
|
|
#New column for age categories
|
|
HtnData$Age_Group <- cut(HtnData$Age,
|
|
breaks = c(-Inf, 14, 24, 44, 64, 80, Inf),
|
|
labels = c("1-14", "15-24", "25-44", "45-64", "65-80","80+" ),
|
|
include.lowest = TRUE, right = FALSE)
|
|
|
|
# Create a histogram of the Age data. unused in final report
|
|
ggplot(HtnData, aes(x = Age_Group)) +
|
|
geom_bar(color = "black", fill = "lightblue") +
|
|
scale_x_discrete(drop = FALSE) +
|
|
theme_minimal() +
|
|
labs(title = "Age Distribution of Patients diagnosed with Hypertension between audited dates",
|
|
x = "Age Group", y = "Count")
|
|
|
|
|
|
|
|
### Male female ratio
|
|
|
|
# Create data frame with counts of males and females - unused testing out techniques
|
|
gender_count <- data.frame(
|
|
gender = c("Female", "Male"),
|
|
count = c(sum(HtnData$Patient_Female, na.rm = TRUE),
|
|
sum(!HtnData$Patient_Female, na.rm = TRUE))
|
|
)
|
|
|
|
# Create pie chart - unused
|
|
ggplot(gender_count, aes(x = "", y = count, fill = gender)) +
|
|
geom_bar(width = 1, stat = "identity") +
|
|
coord_polar("y", start = 0) +
|
|
theme_void() +
|
|
labs(title = "Gender Distribution") +
|
|
geom_label(aes(label = round((count/sum(count))*100, 1)),
|
|
position = position_stack(vjust = 0.5)) +
|
|
scale_fill_brewer(palette = "Set2")
|
|
|
|
|
|
|
|
#### checks if all investigations are done, then adds a column
|
|
# Create a new column `Investig_Met`
|
|
HtnData$Investig_Met <- HtnData$HbA1c & HtnData$Lipid & HtnData$U_E & HtnData$Dip_Urine & HtnData$ACR_Urine
|
|
|
|
HtnData$Investig_Sine_Urine_Met <- HtnData$HbA1c & HtnData$Lipid & HtnData$U_E & HtnData$ACR_Urine
|
|
|
|
#####
|
|
|
|
# Import previous audit results
|
|
|
|
|
|
HtnData$Old_audit_Std_1_Met <- 0.28
|
|
|
|
HtnData$Old_audit_Std_2_Met <- 0.28
|
|
|
|
|
|
#create new column for followup breakdown that doesn't switch the NA values
|
|
HtnData$c3_MO_FLWP_STBL_WITHNA <-HtnData$c3_MO_FLWP_STBL
|
|
|
|
|
|
# Sometimes 3 month followup not applicable due to never getting stable, so as not to disturb the score for the unbroken down pie chart, any null value is changed to whatever the 2-4week followup value is
|
|
# finds NA in c3_MO_FLWP_STBL and replaces it with the corresponding value from c2_4_WK_RVW_ACE
|
|
na_index <- which(is.na(HtnData$c3_MO_FLWP_STBL))
|
|
HtnData$c3_MO_FLWP_STBL[na_index] <- HtnData$c2_4_WK_RVW_ACE[na_index]
|
|
|
|
|
|
# Check **OLD** standard 1 met
|
|
|
|
HtnData$Old_Std_1_Met <- HtnData$Investig_Met & (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE ) & HtnData$Lifestyle_Discussion & HtnData$c3_MO_FLWP_STBL
|
|
|
|
# Check **OLD** standard 2 met
|
|
|
|
HtnData$Old_Std_2_Met <- HtnData$HTN_MGMT_PLN & HtnData$c715_Check & HtnData$c3_MO_FLWP_STBL & HtnData$c6_MO_BP
|
|
|
|
|
|
# Check ***NEW*** standard 1 met
|
|
|
|
HtnData$New_Std_1_Met <- HtnData$Investig_Met & HtnData$Lifestyle_Discussion & HtnData$c715_Check & HtnData$HTN_MGMT_PLN
|
|
|
|
# Check ***NEW Standard 1 sine lifestsyle met*** - unused. for comprehension purposes only
|
|
|
|
HtnData$New_Std_1_Sine_Lifestyle_Met <- HtnData$Investig_Met & HtnData$c715_Check & HtnData$HTN_MGMT_PLN
|
|
|
|
# Check **NEW** standard 2 met
|
|
|
|
|
|
HtnData$New_Std_2_Met <- HtnData$c3_MO_FLWP_STBL & HtnData$c6_MO_BP & (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
## Pie charts for each standard - ended up unused, bar graph better representation to compare by year
|
|
|
|
generate_pie_chart <- function(data, column) {
|
|
# Count TRUE and FALSE instances
|
|
counts <- table(data[[column]])
|
|
|
|
# Name counts for plotting
|
|
df <- data.frame(labels = names(counts), counts = as.vector(counts))
|
|
df$labels <- ifelse(df$labels == "TRUE", "Standard Met", "Standard Not Met")
|
|
|
|
# Calculate percentages for labeling
|
|
df$perc <- round((df$counts/sum(df$counts))*100, 1)
|
|
|
|
# Generate pie chart
|
|
p <- ggplot(df, aes(x = "", y = counts, fill = labels)) +
|
|
geom_bar(width = 1, stat = "identity", colour = 'black') +
|
|
coord_polar("y", start = 0) +
|
|
scale_fill_manual(values = c("Standard Not Met" = "#CC0000", "Standard Met" = "#FFFF00")) +
|
|
labs(fill = "") +
|
|
geom_text(data = subset(df, labels == "Standard Met"), aes(label = paste0("Standard Met: ", perc, "%")),
|
|
position = position_stack(vjust = 0.5), color = "black") +
|
|
ggtitle(paste("Percent of old standard 2 met")) +
|
|
theme_minimal() +
|
|
theme(axis.title.x=element_blank(),
|
|
axis.title.y=element_blank(),
|
|
panel.border = element_blank(),
|
|
panel.grid=element_blank(),
|
|
axis.ticks = element_blank(),
|
|
plot.title=element_text(hjust=0.5),
|
|
axis.text = element_blank())
|
|
|
|
print(p)
|
|
}
|
|
|
|
generate_pie_chart(HtnData, "Old_Std_2_Met")
|
|
generate_pie_chart(HtnData, "New_Std_1_Sine_Lifestyle_Met")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
###### Single bar chart for 715
|
|
|
|
# Calculate adherence for the 715 check
|
|
counts <- table(HtnData$c715_Check)
|
|
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100
|
|
|
|
# Create a data frame for the chart
|
|
df <- data.frame(label = "715 Check", adherence = percentage_adherence)
|
|
|
|
# Single Horizontal Bar Chart
|
|
p <- ggplot(df, aes(x = "", y = adherence)) +
|
|
geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
|
|
coord_flip() +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red",
|
|
aes(label = "60% standard")) +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
|
|
labs(x = "", y = "Adherence Percentage (%)",
|
|
title = "Adherence to 715 Check Standard") +
|
|
theme_minimal() +
|
|
ylim(0,100)
|
|
|
|
print(p)
|
|
|
|
###### Single bar chart for lifestyle discussion
|
|
|
|
# Calculate adherence for the 715 check
|
|
counts <- table(HtnData$Lifestyle_Discussion)
|
|
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100
|
|
|
|
# Create a data frame for the chart
|
|
df <- data.frame(label = "Lifestyle Discussion", adherence = percentage_adherence)
|
|
|
|
# Single Horizontal Bar Chart
|
|
p <- ggplot(df, aes(x = "", y = adherence)) +
|
|
geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
|
|
coord_flip() +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red",
|
|
aes(label = "60% standard")) +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
|
|
labs(x = "", y = "Adherence Percentage (%)",
|
|
title = "Adherence to Lifestyle Discussion Standard") +
|
|
theme_minimal() +
|
|
ylim(0,100)
|
|
|
|
print(p)
|
|
|
|
#### single bar chart for htn mgmt plan
|
|
|
|
|
|
# Calculate adherence for the htn mgmt plan
|
|
counts <- table(HtnData$HTN_MGMT_PLN)
|
|
percentage_adherence <- sum(counts["TRUE"]) / sum(counts) * 100
|
|
|
|
# Make a data frame for the chart
|
|
df <- data.frame(label = "Hypertension Management Plan", adherence = percentage_adherence)
|
|
|
|
# Single Horizontal Bar Chart
|
|
p <- ggplot(df, aes(x = "", y = adherence)) +
|
|
geom_bar(stat = "identity", width = 0.2, fill = "steelblue") +
|
|
coord_flip() +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red",
|
|
aes(label = "60% standard")) +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(data = df, aes(label = paste0(round(adherence, 1), "%")), vjust = -1.5, color = "black") +
|
|
labs(x = "", y = "Adherence Percentage (%)",
|
|
title = "Adherence to Hypertension Management Plan Standard") +
|
|
theme_minimal() +
|
|
ylim(0,100)
|
|
|
|
print(p)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#### Variables for use in the text
|
|
NoOfFemales <- (gender_count$count[gender_count$gender == "Female"])
|
|
NoOfMales <- (gender_count$count[gender_count$gender == "Male"])
|
|
AverageAge <- (round(average_age_included, 1))
|
|
FinalIncluded <- nrow(HtnDataold[HtnDataold$Inclusion_Crit == 1, ])
|
|
|
|
```
|
|
|
|
|
|
# Flow Chart
|
|
|
|
|
|
```{r flowchart, include=TRUE, echo=TRUE, fig.cap="Case Selection for Kimberley Hypertension Audit of 2022 Patients"}
|
|
# Define ineligibles, all others defined before
|
|
Ineligibles <- nrow(HtnDataold) - FinalIncluded
|
|
|
|
# Define edge data
|
|
edge_data <- tibble::tibble(
|
|
from = c("patients_attending","patients_attending","met_criteria"),
|
|
to = c("met_criteria","participants_not_eligible","study_sample")
|
|
)
|
|
|
|
# Define data for each box
|
|
node_data <- tibble::tibble(
|
|
name = c("patients_attending","met_criteria","participants_not_eligible","study_sample"),
|
|
label = c(paste0("Patients aged 10 or above attending KAMS clinics where hypertension\n was recorded as the presenting complaint between 01/01/22 and 01/06/22.\nn=", nrow(HtnDataold)),
|
|
paste0("Patients with no previously recorded\n diagnosis or treatment of hypertension \nn=", FinalIncluded),
|
|
paste0("Patients with a recorded diagnosis\n or treatment of hypertension\n outside of the specified dates \nn=", Ineligibles),
|
|
paste0("Audit sample n=", FinalIncluded)),
|
|
x_nudge = c(1.0, 0.48, 0.48, 0.5),
|
|
y_nudge = c(0.25, 0.3, 0.3, 0.25)
|
|
)
|
|
|
|
# Generates the flowchart
|
|
ggflowchart(
|
|
data = edge_data,
|
|
node_data = node_data,
|
|
fill = 'white',
|
|
colour = 'black',
|
|
text_colour = 'black',
|
|
text_size = 3.88,
|
|
arrow_colour = "black",
|
|
arrow_size = 0.3,
|
|
family = "sans",
|
|
horizontal = FALSE
|
|
)
|
|
|
|
|
|
```
|
|
|
|
|
|
|
|
# Table of age categories
|
|
|
|
```{r tableofage, echo=TRUE, include=TRUE, warning=FALSE, fig.cap='Age Distribution of Patient Sample', fig.pos ='H', message=FALSE}
|
|
library(kableExtra)
|
|
# Summarise data
|
|
AgeTable <- HtnData %>%
|
|
group_by(Age_Group) %>%
|
|
summarise(Count = n(),
|
|
Percentage = (Count / nrow(HtnData))*100) %>%
|
|
# formatting columns
|
|
mutate(Age_Group = as.character(Age_Group),
|
|
Percentage = paste0(round(Percentage, 2), "%")) %>%
|
|
rename(`Age Group` = Age_Group)
|
|
|
|
# making the table
|
|
kable(AgeTable, digits = 2, caption = "Age distribution of Patient Sample", align = 'c') %>%
|
|
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"),
|
|
full_width = F, latex_options = "HOLD_position")
|
|
```
|
|
|
|
|
|
|
|
|
|
|
|
# Converting variables to in text references
|
|
|
|
|
|
```{r calculatingstandards-results, echo=TRUE}
|
|
|
|
OldSt1Text <- round(mean(as.numeric(HtnData$Old_Std_1_Met)) * 100, 1)
|
|
OldSt2Text <- round(mean(as.numeric(HtnData$Old_Std_2_Met)) * 100, 1)
|
|
OldASt1Text <- mean(as.numeric(HtnData$Old_audit_Std_1_Met)) * 100
|
|
OldASt2Text <- mean(as.numeric(HtnData$Old_audit_Std_2_Met)) * 100
|
|
|
|
```
|
|
|
|
|
|
# Bar graph comparing previous and current audit results
|
|
|
|
```{r bargraphStandardOld, echo=TRUE, include=TRUE, fig.cap="Comparison of Previous and Present Audit Based on Previous Standard"}
|
|
# Unite the columns into one dataframe
|
|
standards <- HtnData %>%
|
|
select(Old_Std_1_Met, Old_Std_2_Met, Old_audit_Std_1_Met, Old_audit_Std_2_Met) %>%
|
|
pivot_longer(cols = everything(), names_to = "Standard", values_to = "Met") %>%
|
|
mutate(Met = as.numeric(Met)) %>%
|
|
group_by(Standard) %>%
|
|
summarise(Percentage = mean(Met, na.rm = TRUE) * 100)
|
|
|
|
|
|
standards$Condition <- ifelse(grepl("Old_audit", standards$Standard), "2022", "2023")
|
|
standards$Standard_No <- ifelse(grepl("1", standards$Standard), "Standard 1", "Standard 2")
|
|
|
|
# Create the bar plot
|
|
ggplot(standards, aes(x = Standard_No, y = Percentage, fill = Condition)) +
|
|
geom_bar(stat = "identity", position = "dodge", width = 0.5, color = "black") +
|
|
geom_text(aes(label = paste0(formatC(Percentage, format = "f", digits = 1), "%")),
|
|
position = position_dodge(width = 0.5), vjust = -0.5, color = "black") +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "black") +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
scale_fill_manual(values = c("2023" = "#c71d22", "2022" = "#ffd503")) +
|
|
labs(x = "Standards", y = "Percentage Adherence (%)",
|
|
fill = "Condition",
|
|
title = "") +
|
|
theme_minimal() +
|
|
ylim(0,100)
|
|
```
|
|
|
|
|
|
# New standard Pie Chart
|
|
|
|
```{r newstandard1, echo=TRUE, include=TRUE, fig.cap = "Proportion Of Present Audit Adherence With Standard 1"}
|
|
generate_pie_chart <- function(data, column, title) {
|
|
# Count TRUE and FALSE instances
|
|
counts <- table(data[[column]])
|
|
|
|
# Name counts for plotting
|
|
df <- data.frame(labels = names(counts), counts = as.vector(counts))
|
|
df$labels <- ifelse(df$labels == "TRUE", "Adherent", "Non-Adherent")
|
|
|
|
# Calculate percentages for labeling
|
|
df$perc <- round((df$counts/sum(df$counts))*100, 1)
|
|
|
|
df$newlabels <- paste(df$labels, ": ", df$perc, "%", sep = "")
|
|
|
|
# Generate pie chart
|
|
p <- ggplot(df, aes(x = "", y = counts, fill = newlabels)) +
|
|
geom_bar(width = 1, stat = "identity", colour = 'black') +
|
|
coord_polar("y", start = 0) +
|
|
scale_fill_manual(values = c("#ffd503", "#c71d22")) +
|
|
labs(fill = "") +
|
|
ggtitle(title) +
|
|
theme_minimal() +
|
|
theme(axis.title.x=element_blank(),
|
|
axis.title.y=element_blank(),
|
|
panel.border = element_blank(),
|
|
panel.grid=element_blank(),
|
|
axis.ticks = element_blank(),
|
|
plot.title=element_text(hjust=0.0),
|
|
axis.text = element_blank())
|
|
|
|
return(p)
|
|
}
|
|
|
|
# Create the pie chart for New_Std_1_Met
|
|
newstandard1 <- generate_pie_chart(HtnData, "New_Std_1_Met", "")
|
|
|
|
# Print the pie chart
|
|
print(newstandard1)
|
|
|
|
```
|
|
|
|
|
|
# Baseline investigations
|
|
|
|
```{r AdherenceBaselineFull, echo=TRUE, include=TRUE, fig.cap="Adherence to Standard for Baseline Investigations"}
|
|
|
|
|
|
columns_to_run <- c("HbA1c" = "HbA1c", "Lipid" = "Lipids", "U_E" = "U&Es", "Dip_Urine" = "Urine Dipstick", "ACR_Urine" = "Urine ACR")
|
|
|
|
# make new data frame to store the results
|
|
adherence_inv_perc <- data.frame()
|
|
|
|
# calculate adherence percentages for each column
|
|
for(column in names(columns_to_run)) {
|
|
counts <- table(HtnData[[column]])
|
|
df <- data.frame(label = column, adherence = sum(counts["TRUE"]) / sum(counts) * 100,
|
|
pretty_label = columns_to_run[[column]])
|
|
adherence_inv_perc <- rbind(adherence_inv_perc, df)
|
|
}
|
|
|
|
# calculate the adherence percentage for ALL the investigations
|
|
all_investigations <- HtnData %>%
|
|
rowwise() %>%
|
|
mutate(all_investigations_done = all(c(HbA1c, Lipid, U_E, Dip_Urine, ACR_Urine))) %>%
|
|
ungroup() %>%
|
|
summarize(all_adherence = mean(all_investigations_done) * 100)
|
|
|
|
# Add row for "All investigations" into the adherence_inv_perc df
|
|
df <- data.frame(label = "All", adherence = all_investigations$all_adherence, pretty_label = "All investigations")
|
|
adherence_inv_perc <- rbind(adherence_inv_perc, df)
|
|
|
|
# Reorder based on 'adherence'
|
|
adherence_inv_perc <- adherence_inv_perc[order(adherence_inv_perc$adherence, decreasing = TRUE), ]
|
|
adherence_inv_perc$pretty_label <- factor(adherence_inv_perc$pretty_label, levels = adherence_inv_perc$pretty_label)
|
|
|
|
|
|
adherence_inv_perc$color <- ifelse(adherence_inv_perc$pretty_label == "All investigations", "All investigations", "Single investigation")
|
|
|
|
# Make the bar chart
|
|
ggplot(adherence_inv_perc, aes(x = pretty_label, y = adherence, fill = color)) +
|
|
geom_bar(stat = "identity", width = 0.7, color="black") +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red") +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(aes(label = paste0(formatC(adherence, format = "f", digits = 1), "%")), vjust = -0.3, color = "black") +
|
|
labs(x = "Investigations", y = "Adherence Percentage (%)",
|
|
title = "") +
|
|
scale_fill_manual(values = c("Single investigation" = "#009aa6", "All investigations" = "#c54b00")) +
|
|
ylim(0, 100) +
|
|
theme_minimal() +
|
|
theme(legend.position = "none")
|
|
|
|
|
|
```
|
|
|
|
# Other management bar graph
|
|
|
|
```{r OtherManagement, include=TRUE, echo=TRUE, fig.cap="Adherence of Remaining Criteria"}
|
|
|
|
# Calculate adherence
|
|
counts_715 <- table(HtnData$c715_Check)
|
|
counts_life <- table(HtnData$Lifestyle_Discussion)
|
|
counts_htn <- table(HtnData$HTN_MGMT_PLN)
|
|
|
|
percentage_adherence_715 <- sum(counts_715["TRUE"]) / sum(counts_715) * 100
|
|
percentage_adherence_life <- sum(counts_life["TRUE"]) / sum(counts_life) * 100
|
|
percentage_adherence_htn <- sum(counts_htn["TRUE"]) / sum(counts_htn) * 100
|
|
|
|
# combine the different variables
|
|
df <- data.frame(label = c("715 Check", "Lifestyle Discussion", "Hypertension Management Plan"),
|
|
adherence = c(percentage_adherence_715, percentage_adherence_life, percentage_adherence_htn))
|
|
|
|
# Combined Bar Chart
|
|
p <- ggplot(df, aes(x = label, y = adherence, fill = label)) +
|
|
geom_bar(stat = "identity", width = 0.4, color="black") +
|
|
coord_flip() +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red") +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(aes(label = paste0(formatC(adherence, format = "f", digits = 1), "%")), vjust = -2.5, color = "black") +
|
|
labs(x = "", y = "Adherence Percentage (%)",
|
|
title = "") +
|
|
scale_fill_manual(values = c("Lifestyle Discussion" = "#231f20", "Hypertension Management Plan" = "#bc2026", "715 Check" = "#008596")) +
|
|
theme_minimal() +
|
|
theme(legend.position = "none") + # line added to remove the legend
|
|
ylim(0, 100)
|
|
|
|
print(p)
|
|
|
|
|
|
```
|
|
|
|
|
|
# Standard 2 Pie chart
|
|
|
|
```{r newstandard2, echo=TRUE, include=TRUE, fig.cap="Proportion of Present Audit Adherence with Standard 2"}
|
|
generate_pie_chart <- function(data, column, title) {
|
|
# Get proportions of true and false
|
|
counts <- table(data[[column]])
|
|
|
|
# Name counts for plotting
|
|
df <- data.frame(labels = names(counts), counts = as.vector(counts))
|
|
df$labels <- ifelse(df$labels == "TRUE", "Adherent", "Non-Adherent")
|
|
|
|
# Percentages for labeling
|
|
df$perc <- round((df$counts/sum(df$counts))*100, 1)
|
|
|
|
df$newlabels <- paste(df$labels, ": ", df$perc, "%", sep = "")
|
|
|
|
# Generate pie chart
|
|
p <- ggplot(df, aes(x = "", y = counts, fill = newlabels)) +
|
|
geom_bar(width = 1, stat = "identity", colour = 'black') +
|
|
coord_polar("y", start = 0) +
|
|
scale_fill_manual(values = c("#ffd503", "#c71d22")) +
|
|
labs(fill = "") +
|
|
ggtitle(title) +
|
|
theme_minimal() +
|
|
theme(axis.title.x=element_blank(),
|
|
axis.title.y=element_blank(),
|
|
panel.border = element_blank(),
|
|
panel.grid=element_blank(),
|
|
axis.ticks = element_blank(),
|
|
plot.title=element_text(hjust=0.0),
|
|
axis.text = element_blank())
|
|
|
|
return(p)
|
|
}
|
|
|
|
# Create the pie chart for New_Std_1_Met
|
|
newstandard1 <- generate_pie_chart(HtnData, "New_Std_2_Met", "")
|
|
|
|
# show the pie chart
|
|
print(newstandard1)
|
|
|
|
```
|
|
|
|
# Follow up criteria
|
|
|
|
```{r followupfinal, include=TRUE, echo=TRUE, fig.cap="Adherence to Criteria for Followup"}
|
|
# Calculate adherence to followup
|
|
HtnData$initial_flwp <- (HtnData$c3_MO_RVW_LFSTL | HtnData$c2_4_WK_RVW_ACE)
|
|
HtnData$complete_followup_adherence <- HtnData$initial_flwp & HtnData$c3_MO_FLWP_STBL_WITHNA & HtnData$c6_MO_BP
|
|
|
|
columns_to_run <- c("initial_flwp" = "Initial Followup",
|
|
"c3_MO_FLWP_STBL_WITHNA" = "Three Month Followup",
|
|
"c6_MO_BP" = "Six Month BP",
|
|
"complete_followup_adherence" = "Complete Followup") # add complete followup data here
|
|
|
|
adherence_flwp_perc <- data.frame()
|
|
|
|
for(column in names(columns_to_run)) {
|
|
counts <- table(HtnData[[column]])
|
|
df <- data.frame(label = column, adherence = sum(counts["TRUE"]) / sum(counts) * 100,
|
|
pretty_label = columns_to_run[[column]])
|
|
adherence_flwp_perc <- rbind(adherence_flwp_perc, df)
|
|
}
|
|
|
|
|
|
adherence_flwp_perc$pretty_label <- factor(adherence_flwp_perc$pretty_label,
|
|
levels = c("Initial Followup",
|
|
"Three Month Followup",
|
|
"Six Month BP",
|
|
"Complete Followup"))
|
|
|
|
# Bar chart below here
|
|
ggplot(adherence_flwp_perc, aes(x = pretty_label, y = adherence, fill = pretty_label)) +
|
|
geom_bar(stat = "identity", width = 0.5, color="black") +
|
|
scale_fill_manual(values=c("Initial Followup" = "#009aa6",
|
|
"Three Month Followup" = "#009aa6",
|
|
"Six Month BP" = "#009aa6",
|
|
"Complete Followup" = "#c54b00")) +
|
|
geom_hline(yintercept = 60, linetype = "dashed", color = "red") +
|
|
geom_hline(yintercept = 0, color = "black", size = 1.0) +
|
|
geom_text(aes(label = paste0(formatC(adherence, format ="f", digits = 1),"%")), vjust = -0.3, color = "black") +
|
|
labs(x = "Follow up Criteria", y = "Adherence Percentage (%)", title = "") +
|
|
theme_minimal() +
|
|
theme(legend.position = "none") + # line added to remove the legend
|
|
ylim(0,100)
|
|
```
|
|
|
|
|
|
|
|
# More in text references for variables
|
|
|
|
```{r calculatingstandards-discussion, echo=TRUE}
|
|
|
|
OldSt1Text <- round(mean(as.numeric(HtnData$Old_Std_1_Met)) * 100)
|
|
OldSt2Text <- round(mean(as.numeric(HtnData$Old_Std_2_Met)) * 100)
|
|
OldASt1Text <- round(mean(as.numeric(HtnData$Old_audit_Std_1_Met)) * 100, 1)
|
|
OldASt2Text <- round(mean(as.numeric(HtnData$Old_audit_Std_2_Met)) * 100, 1)
|
|
# for new standards
|
|
NewSt1Text <- round(mean(as.numeric(HtnData$New_Std_1_Met)) * 100, 1)
|
|
NewSt2Text <- round(mean(as.numeric(HtnData$New_Std_2_Met)) * 100, 1)
|
|
|
|
counts_715 <- table(HtnData$c715_Check)
|
|
counts_life <- table(HtnData$Lifestyle_Discussion)
|
|
counts_htn <- table(HtnData$HTN_MGMT_PLN)
|
|
counts_urin <- table(HtnData$Dip_Urine)
|
|
|
|
text715 <- round(sum(counts_715["TRUE"]) / sum(counts_715) * 100, 1)
|
|
textlfstl <- round(sum(counts_life["TRUE"]) / sum(counts_life) * 100, 1)
|
|
texturin <- round(sum(counts_urin["TRUE"]) /sum(counts_urin) * 100, 1)
|
|
```
|
|
|
|
|
|
|
|
## Action Plan
|
|
|
|
```{r actionplan, echo=TRUE, include=TRUE, message=FALSE, fig.pos ='H', fig.cap="Action Plan following 2023 Audit of Adherence to Kimberley Hypertension Guidelines"}
|
|
|
|
library(readxl)
|
|
library(kableExtra)
|
|
|
|
datadictionary <- read_excel("actionplan.xlsx")
|
|
|
|
|
|
datadictionary %>%
|
|
kableExtra::kable(df, format = "latex", booktabs = TRUE, linesep = "\\addlinespace", caption = "Data Dictionary for Collection") %>%
|
|
kable_styling(latex_options = c( "scale_down", "bordered", "HOLD_position")) %>%
|
|
column_spec(1, bold = FALSE, width = "15em") %>%
|
|
column_spec(2:5, width = "10em") %>%
|
|
row_spec(0, bold = TRUE, italic = FALSE)
|
|
|
|
|
|
```
|
|
|
|
|
|
Copyright 2023 Liam Jones
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
|
|
|
|
The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
|
|
|
|
THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |