Introduction

Students took an informal survey at the beginning of the MCID module.

Data Wrangling

setwd("C:/Users/jkempke/Box Sync/MSCR 761/Fall 2020/Modules/6 - Study Measures 2/Activities and Assignments")
survey <- read.csv("survey.csv")

survey.summary <- survey %>% group_by(q1) %>% count(q1)
survey.summary <- survey.summary %>% ungroup() %>% mutate(percent = round(100 * n/(sum(n)), 
    digits = 1))

survey.noMD.summary <- survey %>% group_by(noMD, q1) %>% count(q1) %>% mutate(wt.n = noMD * 
    n)
survey.noMD.summary <- survey.noMD.summary %>% select(q1, wt.n) %>% group_by(q1) %>% 
    tally(wt = wt.n)
survey.noMD.summary <- survey.noMD.summary %>% mutate(percent = round(100 * n/(sum(n)), 
    digits = 1))

survey.MD.summary <- survey %>% group_by(MD, q1) %>% count(q1) %>% mutate(wt.n = MD * 
    n)
survey.MD.summary <- survey.MD.summary %>% select(q1, wt.n) %>% group_by(q1) %>% 
    tally(wt = wt.n)
survey.MD.summary <- survey.MD.summary %>% mutate(percent = round(100 * n/(sum(n)), 
    digits = 1))

As of 2020-09-25 the total number of observations in dataset = 26

Responses to Individual Questions

Question 1

What is the minimum threshold of patient reported pain (0 to 10), to which he/she should be considered to receive a dose of narcotic pain medication for relief?

Unweighted

ggplot(data = survey.summary, aes(x = q1, y = percent)) + geom_bar(stat = "identity", 
    fill = "light blue", color = "black") + geom_text(aes(label = percent), nudge_y = 2, 
    angle = 90) + labs(title = "", x = "Numeric rating scale", y = "Percent responses") + 
    scale_x_continuous(breaks = seq(0, 10, 1), limits = c(0, 10)) + scale_y_continuous(breaks = seq(0, 
    100, 10), limits = c(0, 50)) + theme_bw() + theme(axis.title = element_text(size = 22), 
    axis.text.x = element_text(size = 20), axis.text.y = element_text(size = 20))

Clinicians weighted quadruple

ggplot(data = survey.noMD.summary, aes(x = q1, y = percent)) + geom_bar(stat = "identity", 
    fill = "light blue", color = "black") + geom_text(aes(label = percent), nudge_y = 2, 
    angle = 90) + labs(title = "", x = "Numeric rating scale", y = "Percent responses") + 
    scale_x_continuous(breaks = seq(0, 10, 1), limits = c(0, 10)) + scale_y_continuous(breaks = seq(0, 
    100, 10), limits = c(0, 50)) + theme_bw() + theme(axis.title = element_text(size = 22), 
    axis.text.x = element_text(size = 20), axis.text.y = element_text(size = 20))

Non-clinicians weighted quadruple

ggplot(data = survey.MD.summary, aes(x = q1, y = percent)) + geom_bar(stat = "identity", 
    fill = "light blue", color = "black") + geom_text(aes(label = percent), nudge_y = 2, 
    angle = 90) + labs(title = "", x = "Numeric rating scale", y = "Percent responses") + 
    scale_x_continuous(breaks = seq(0, 10, 1), limits = c(0, 10)) + scale_y_continuous(breaks = seq(0, 
    100, 10), limits = c(0, 50)) + theme_bw() + theme(axis.title = element_text(size = 22), 
    axis.text.x = element_text(size = 20), axis.text.y = element_text(size = 20))

Question 2

The patient is administered a dose of narcotic pain medication and is reassess 1 hour later. What is the minimum absolute value of the threshold of change (i.e. follow-up NRS minus baseline NRS) in NRS for the dose to be considered effective?

ggplot(data = survey, aes(x = q2)) + geom_bar(aes(y = 100 * (..count..)/sum(..count..)), 
    fill = "light blue", color = "black") + labs(title = "", x = "Numeric rating scale", 
    y = "Percent responses") + scale_x_continuous(breaks = seq(0, 10, 1), limits = c(0, 
    10)) + theme_bw()

Question 3

You reconsider your prior thinking. Maybe it isn’t the absolute change that is applicable across all baseline severity of pain. Maybe considering relative change in NRS is a better way to think about this. With this line of reasoning, what is the minimum relative change (i.e. follow-up NRS minus baseline NRS divided by baseline NRS) in NRS for the dose to be considered effective?

ggplot(data = survey, aes(x = 100 * q3)) + geom_bar(aes(y = 100 * (..count..)/sum(..count..)), 
    fill = "light blue", color = "black") + labs(title = "", x = "% Change from Baseline", 
    y = "Percent responses") + scale_x_continuous(breaks = seq(0, 100, 10), limits = c(0, 
    100)) + theme_bw()