R/eortc.R

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

#' @title {Scoring the EORTC QLQ-C30}
#' @description {\emph{The European Organization for Research and Treatment o  Cancer
#' quality of life questionnaire (EORTC QLQ-C30) is designed for use with a wide range of
#' cancer patient populations, and is intended to be supplemented by tumour-specific
#' questionnaire modules or supplements.} (Scoring Manual)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {30}
#' \item \code{Item range:} {Item 1 to 28: 1 to 4; Item 29 and 30: 1 to 7}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 100}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {5 points (Osoba et al. 1998)}
#' \item \code{Treatment of missing values:} {"If at least half of the items from the scale
#' have been answered, assume that the missing items have values equal
#' to the average of those items which are present for that respondent." (Scoring Manual)}
#' }
#' @references
#' Scoring Manual \url{https://www.eortc.org/app/uploads/sites/2/2018/02/SCmanual.pdf}
#'
#' Aaronson et al. (1993) \url{https://doi.org/10.1093/jnci/85.5.365}
#'
#' Osoba et al. (1998) \url{https://doi.org/10.1200/JCO.1998.16.1.139}
#' @return The function returns 24 variables:
#' \itemize{
#'  \item \code{nvalid.gs:} {Number of valid values of Global health status/QoL (MAX=2)}
#'  \item \code{nvalid.pf:} {Number of valid values of Physical functioning (MAX=5)}
#'  \item \code{nvalid.rf:} {Number of valid values of Role functioning (MAX=2)}
#'  \item \code{nvalid.ef:} {Number of valid values of Emotional functioning (MAX=4)}
#'  \item \code{nvalid.cf:} {Number of valid values of Cognitive functioning (MAX=2)}
#'  \item \code{nvalid.sf:} {Number of valid values of Social functioning (MAX=2)}
#'  \item \code{nvalid.fa:} {Number of valid values of Fatigue (MAX=3)}
#'  \item \code{nvalid.nv:} {Number of valid values of Nausea and vomiting (MAX=2)}
#'  \item \code{nvalid.pa:} {Number of valid values of Pain (MAX=2)}
#'  \item \code{score.eortcc30.gs:} {Global health status/QoL Score}
#'  \item \code{score.eortcc30.pf:} {Physical functioning Score}
#'  \item \code{score.eortcc30.rf:} {Role functioning Score}
#'  \item \code{score.eortcc30.ef:} {Emotional functioning Score}
#'  \item \code{score.eortcc30.cf:} {Cognitive functioning Score}
#'  \item \code{score.eortcc30.sf:} {Social functioning Score}
#'  \item \code{score.eortcc30.fa:} {Fatigue}
#'  \item \code{score.eortcc30.nv:} {Nausea and vomiting Score}
#'  \item \code{score.eortcc30.pa:} {Pain Score}
#'  \item \code{score.eortcc30.dy:} {Dyspnoea}
#'  \item \code{score.eortcc30.in:} {Insomnia}
#'  \item \code{score.eortcc30.ap:} {Appetite loss}
#'  \item \code{score.eortcc30.co:} {Constipation}
#'  \item \code{score.eortcc30.di:} {Diarrhoea}
#'  \item \code{score.eortcc30.fi:} {Financial difficulties}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' scoring_eortcc30(mydata, items = c(3:32))
#' }
#' @param data a \code{\link{data.frame}} containing the EORTC QLQ-C30 items orderd from 1 to 30.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the EORTC QLQ-C30 item names ordered from 1 to 30,
#' or a numeric vector indicating the column numbers of the EORTC QLQ-C30 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 pct_valid A numeric value between > 0 and 1 indicating the percentage of non-missing items required for score
#' calculations. The default is 0.5 (50\%).
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_eorc30 <- function(data, items = 1:30, keep = TRUE,
                              pct_valid = 0.5,
                              digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  # check whether item values are within the defined range
  if (min(data[, items], na.rm = T) < 1) {
    stop("Minimum possible value for EORTC items is 1")
  } else if (max(data[, items[1:28]], na.rm = T) > 4) {
    stop("Maximum possible value for EORCT items 1 to 28 is 4")
  } else if (max(data[, items[29:30]], na.rm = T) > 7) {
    stop("Maximum possible value for EORCT items 29 and 30 is 7")
  }
  # check for number of specified items
  if (length(items) != 30) {
    stop("Number of items must be 30!")
  }
  items <- items
  items.gs <- items[c(29, 30)]
  items.pf <- items[c(1:5)]
  items.rf <- items[c(6, 7)]
  items.ef <- items[c(21:24)]
  items.cf <- items[c(20, 25)]
  items.sf <- items[c(26, 27)]
  items.fa <- items[c(10, 12, 18)]
  items.nv <- items[c(14, 15)]
  items.pa <- items[c(9, 19)]
  items.dy <- items[8]
  items.in <- items[11]
  items.ap <- items[13]
  items.co <- items[16]
  items.di <- items[17]
  items.fi <- items[28]
  data <- data %>%
    mutate(
      # number of valid items for multi item scales
      nvalid.gs = rowSums(!is.na(select(., items.gs))),
      nvalid.pf = rowSums(!is.na(select(., items.pf))),
      nvalid.rf = rowSums(!is.na(select(., items.rf))),
      nvalid.ef = rowSums(!is.na(select(., items.ef))),
      nvalid.cf = rowSums(!is.na(select(., items.cf))),
      nvalid.sf = rowSums(!is.na(select(., items.sf))),
      nvalid.fa = rowSums(!is.na(select(., items.fa))),
      nvalid.nv = rowSums(!is.na(select(., items.nv))),
      nvalid.pa = rowSums(!is.na(select(., items.pa)))
      ) %>%
    mutate(
      score.eortcc30.gs = rowSums(select(., items.gs)) / nvalid.gs,
      score.eortcc30.gs = ((score.eortcc30.gs - 1) / 6) * 100,
      score.eortcc30.gs = ifelse(nvalid.gs < ceiling(length(items.gs) * pct_valid), NA, score.eortcc30.gs),
      score.eortcc30.pf = rowSums(select(., items.pf)) / nvalid.pf,
      score.eortcc30.pf = (1 - (score.eortcc30.pf - 1) / 3) * 100,
      score.eortcc30.pf = ifelse(nvalid.pf < ceiling(length(items.pf) * pct_valid), NA, score.eortcc30.pf),
      score.eortcc30.rf = rowSums(select(., items.rf), na.rm = TRUE) / nvalid.rf,
      score.eortcc30.rf = (1 - (score.eortcc30.rf - 1) / 3) * 100,
      score.eortcc30.rf = ifelse(nvalid.rf < ceiling(length(items.rf) * pct_valid), NA, score.eortcc30.rf),
      score.eortcc30.ef = rowSums(select(., items.ef)) / nvalid.ef,
      score.eortcc30.ef = (1 - (score.eortcc30.ef - 1) / 3) * 100,
      score.eortcc30.ef = ifelse(nvalid.ef < ceiling(length(items.ef) * pct_valid), NA, score.eortcc30.ef),
      score.eortcc30.cf = rowSums(select(., items.cf)) / nvalid.cf,
      score.eortcc30.cf = (1 - (score.eortcc30.cf - 1) / 3) * 100,
      score.eortcc30.cf = ifelse(nvalid.cf < ceiling(length(items.cf) * pct_valid), NA, score.eortcc30.cf),
      score.eortcc30.sf = rowSums(select(., items.sf)) / nvalid.sf,
      score.eortcc30.sf = (1 - (score.eortcc30.sf - 1) / 3) * 100,
      score.eortcc30.sf = ifelse(nvalid.sf < ceiling(length(items.sf) * pct_valid), NA, score.eortcc30.sf),
      score.eortcc30.fa = rowSums(select(., items.fa)) / nvalid.fa,
      score.eortcc30.fa = ((score.eortcc30.fa - 1) / 3) * 100,
      score.eortcc30.fa = ifelse(nvalid.fa < ceiling(length(items.fa) * pct_valid), NA, score.eortcc30.fa),
      score.eortcc30.nv = rowSums(select(., items.nv)) / nvalid.nv,
      score.eortcc30.nv = ((score.eortcc30.nv - 1) / 3) * 100,
      score.eortcc30.nv = ifelse(nvalid.nv < ceiling(length(items.nv) * pct_valid), NA, score.eortcc30.nv),
      score.eortcc30.pa = rowSums(select(., items.pa)) / nvalid.pa,
      score.eortcc30.pa = ((score.eortcc30.pa - 1) / 3) * 100,
      score.eortcc30.pa = ifelse(nvalid.pa < ceiling(length(items.pa) * pct_valid), NA, score.eortcc30.pa),
      score.eortcc30.dy = rowSums(select(., items.dy)),
      score.eortcc30.dy = ((score.eortcc30.dy - 1) / 3) * 100,
      score.eortcc30.in = rowSums(select(., items.in)),
      score.eortcc30.in = ((score.eortcc30.in - 1) / 3) * 100,
      score.eortcc30.ap = rowSums(select(., items.ap)),
      score.eortcc30.ap = ((score.eortcc30.ap - 1) / 3) * 100,
      score.eortcc30.co = rowSums(select(., items.co)),
      score.eortcc30.co = ((score.eortcc30.co - 1) / 3) * 100,
      score.eortcc30.di = rowSums(select(., items.di)),
      score.eortcc30.di = ((score.eortcc30.di - 1) / 3) * 100,
      score.eortcc30.fi = rowSums(select(., items.fi)),
      score.eortcc30.fi = ((score.eortcc30.fi - 1) / 3) * 100
    )
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -starts_with('nvalid.'))
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(
      vars(
        starts_with('score.eor')
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}