Uploaded Audit-snippets
parent
063bcbf450
commit
686403a832
|
|
@ -0,0 +1,677 @@
|
|||
---
|
||||
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)
|
||||
|
||||
|
||||
```
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue