R/phq.R

In nrkoehler/qscorer: Procedures for Scoring Health-related Questionnaires

#' @title {Scoring the PHQ-9 questionnaire}
#' @description {\emph{The PHQ-9 (PHQ-D in some sources) is the 9-question depression scale from the
#' Patient Health Questionnaire (PHQ). The results of the PHQ-9 may be used to make a depression diagnosis
#' according to DSM-IV criteria.} (see: Wikipedia)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {9}
#' \item \code{Item range:} {0 to 3}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 27}
#' \item \code{Cut-off-values:} {
#' < 5 = "minimal";
#' 5 to 9 = "mild";
#' 10 to 15 =  "moderate";
#' 15 to 19 = "moderately severe",
#' \eqn{\ge} 20 = "severe"}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {\emph{Questionnaires with up to two missing values are scored,
#' replacing any missing values with the average score of the completed items.} (Arrietta et al. 2017)}}
#'
#' @references
#' Arrieta et al. (2017) (\url{https://doi.org/10.1002/jclp.22390})
#'
#' Kroenke et al. (2010) (\url{https://doi.org/10.1016/j.genhosppsych.2010.03.006})
#' @return The function returns 3 variables:
#' \itemize{
#'  \item \code{nvalid.phq9:} {Number of valid values (MAX=9)}
#'  \item \code{score.phq9:} {PHQ-9 score}
#'  \item \code{cutoff.phq9:} {PHQ-9 as categorical variable}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.phq9 <- paste0("phq_", seq(1, 9, 1))
#' scoring_phq9(mydata, items = items.phq9)
#' }
#' @param data a \code{\link{data.frame}} containing the PHQ-9 items
#' orderd from 1 to 9. The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the PHQ-9 item names ordered from 1 to 9,
#' or a numeric vector indicating the column numbers of the PHQ-9 items in \code{data}.
#' @param keep Logical, whether to keep the single items and  whether to return variables containing
#' the number of non-missing items on each scale for each respondent. The default is TRUE.
#' @param nvalid A numeric value indicating the number of non-missing items required for score
#' calculations. The default is 7.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_phq9 <- function(data, items = 1:9, keep = TRUE, nvalid = 6, digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  if (min(data[, items], na.rm = T) < 0) {
    stop("Minimum possible value for PHQ-9 items is 0")
  } else if (max(data[, items], na.rm = T) > 3) {
    stop("Maximum possible value for PHQ-9 items is 3")
  }
  # check for number of specified items
  if (length(items) != 9) {
    stop("Number of items must be 9!")
  }
  items <- items
  data <- data %>%
    mutate(
      nvalid.phq9 = rowSums(!is.na(select(., items))),
      mean.temp = rowSums(select(., items), na.rm = TRUE) / nvalid.phq9
    ) %>%
    mutate_at(
      vars(!!!items),
      list(~ ifelse(is.na(.), mean.temp, .))
    ) %>%
    mutate(
      score.temp = rowSums(select(., items), na.rm = TRUE),
      score.phq9 = ifelse(nvalid.phq9 >= nvalid, score.temp, NA),
      cutoff.phq9 = case_when(
        score.phq9 >= 20 ~ "Severe",
        score.phq9 >= 15 ~ "Moderately Severe",
        score.phq9 >= 10 ~ "Moderate",
        score.phq9 >= 5 ~ "Mild",
        score.phq9 < 5 ~ "Minimal"
      ),
      cutoff.phq9 = factor(cutoff.phq9, levels = c(
        "Minimal",
        "Mild",
        "Moderate",
        "Moderately Severe",
        "Severe"
      ))
    ) %>%
    select(-mean.temp, -score.temp)
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.phq9)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(vars(score.phq9), list(~ round(., digits)))
  } else {
    data <- data
  }
  data
}
NULL
#' @title {Scoring the PHQ-15 questionnaire}
#' @description {\emph{The Patient Health Questionnaire 15 item (PHQ-15)
#' contains the PHQ's somatic symptom scale. It is a well-validated measure,
#' which asks whether symptoms are present and about their severity.} (see: Wikipedia)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {15}
#' \item \code{Item range:} {0 to 2}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 30}
#' \item \code{Cut-off-values:} {< 5 = "minimal"; 5 to 9 = "mild"; 10 to 14 =  "moderate"; \eqn{\ge} 15 = "severe"}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {Questionnaires with up to three missing values (20\%) are scored,
#' replacing any missing values with the average score of the completed items.}}
#' @references
#' Kroenke et al. 2010 (\url{https://doi.org/10.1016/j.genhosppsych.2010.03.006})
#'
#' Kocalevent et al. 2013 (\url{https://doi.org/10.1186/1471-244X-13-91})
#' @return The function returns 3 variables:
#' \itemize{
#'  \item \code{nvalid.phq15:} Number of valid values (MAX=15)
#'  \item \code{score.phq15:} PHQ-15 score
#'  \item \code{cutoff.phq15:} PHQ-15 as categorical variable
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.phq15 <- paste0("phq_", seq(1, 15, 1))
#' scoring_phq15(mydata, items = items.phq15)
#' }
#' @param data a \code{\link{data.frame}} containing the PHQ-15 items
#' orderd from 1 to 15. The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the PHQ-15 item names ordered from 1 to 15,
#' or a numeric vector indicating the column numbers of the PHQ-15 items in \code{data}.
#' @param keep Logical, whether to keep the single items and  whether to return variables containing
#' the number of non-missing items on each scale for each respondent. The default is TRUE.
#' @param nvalid A numeric value indicating the number of non-missing items required for score
#' calculations. The default is 12.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_phq15 <- function(data, items = 1:15, keep = TRUE, nvalid = 12, digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  if (min(data[, items], na.rm = T) < 0) {
    stop("Minimum possible value for PHQ-15 items is 0")
  } else if (max(data[, items], na.rm = T) > 2) {
    stop("Maximum possible value for PHQ-15 items is 2")
  }
  # check for number of specified items
  if (length(items) != 15) {
    stop("Number of items must be 15!")
  }
  items <- items
  data <- data %>%
    mutate(
      nvalid.phq15 = rowSums(!is.na(select(., items))),
      mean.temp = rowSums(select(., items), na.rm = TRUE) / nvalid.phq15
    ) %>%
    mutate_at(
      vars(items),
      list(~ ifelse(is.na(.), mean.temp, .))
    ) %>%
    mutate(
      score.temp = rowSums(select(., items), na.rm = TRUE),
      score.phq15 = ifelse(nvalid.phq15 >= nvalid, score.temp, NA),
      cutoff.phq15 = case_when(
        score.phq15 >= 15 ~ "Severe",
        score.phq15 >= 10 ~ "Moderate",
        score.phq15 >= 5 ~ "Mild",
        score.phq15 < 5 ~ "Minimal"
      ),
      cutoff.phq15 = factor(cutoff.phq15, levels = c(
        "Minimal",
        "Mild",
        "Moderate",
        "Severe"
      ))
    ) %>%
    select(-mean.temp, -score.temp)
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.phq15)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(vars(score.phq15), list(~ round(., digits)))
  } else {
    data <- data
  }
  data
}
NULL