678 lines
24 KiB
Plaintext
678 lines
24 KiB
Plaintext
---
|
|
title: "Code Snippets Audit"
|
|
output: html_notebook
|
|
---
|
|
|
|
|
|
# collection of snippets for the data collection
|
|
|
|
# Setup and calculations
|
|
|
|
|
|
|
|
```{r setup, include=FALSE, echo=FALSE}
|
|
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=FALSE, 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=FALSE, 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=FALSE}
|
|
|
|
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=FALSE, 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=FALSE, 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=FALSE, 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=FALSE, 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=FALSE, 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=FALSE, 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=FALSE}
|
|
|
|
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=FALSE, 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)
|
|
|
|
|
|
```
|
|
|
|
|
|
|