R/womac.R

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

#' @title {Scoring the Western Ontario and McMaster Universities Osteoarthritis Index (WOMAC)}
#' @description {\emph{The Western Ontario and McMaster Universities Osteoarthritis Index (WOMAC)
#' is a widely used, proprietary set of standardized questionnaires used by health professionals
#' to evaluate the condition of patients with osteoarthritis of the knee and hip, including pain,
#' stiffness, and physical functioning of the joints.} (Wikipedia)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {24}
#' \item \code{Item range:} {0 to 4}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:}
#'      \itemize{
#'      \item \code{Pain} {0 to 20}
#'      \item \code{Stiffness} {0 to 8}
#'      \item \code{Physical Function} {0 to 68}
#'              }
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {unknown}
#' }
#' @references
#' Quintana et al (2005) (\doi{10.1016/j.joca.2005.06.012})
#'
#' Link to questionnaire (\url{https://www.yrmc.org/docs/default-source/medservices/womac-osteoarthritis-index.pdf?sfvrsn=0})
#' @return The function returns 7 variables:
#' \itemize{
#'  \item \code{nvalid.womac.pai:} {Number of valid values of Pain Scale (MAX=5)}
#'  \item \code{nvalid.womac.sti:} {Number of valid values of Stiffness Scale (MAX=2)}
#'  \item \code{nvalid.womac.phy:} {Number of valid values of Physical Function Scale (MAX=17)}
#'  \item \code{score.womac.pai:} {WOMAC Pain Score}
#'  \item \code{score.womac.sti:} {WOMAC Stiffness Score}
#'  \item \code{score.womac.phy:} {WOMAC Physical Function Score}
#'  \item \code{score.womac.glo:} {WOMAC Global Score}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' library(qscorer)
#' df.womac <- simulate_items(num_cols = 24, item_range = 0:4, item_name = "womac")
#' scoring_womac(df.womac, items = 2:25, keep = FALSE)
#' }
#' @param data a \code{\link{data.frame}} containing the WOMAC items orderd from 1 to 24.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the WOMAC item names ordered from 1 to 24,
#' or a numeric vector indicating the column numbers of the WOMAC 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 defaults are:
#' \itemize{
#'  \item \code{pain = 5} {(Pain)}
#'  \item \code{stiff = 2} {(Stiffness)}
#'  \item \code{physical = 14} {(Physical Function)}
#' }
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_womac <- function(data, items = 1:24, keep = TRUE, nvalid = list(
                            pain = 5,
                            stiff = 2,
                            physical = 14
                          ), digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  # check whether item values are within the defined range
  if (min(data[, items], na.rm = T) < 0) {
    stop("Minimum possible value for WOMAC items is 0")
  } else if (max(data[, items], na.rm = T) > 4) {
    stop("Maximum possible value for WOMAC items is 4")
  }
  # check for number of specified items
  if (length(items) != 24) {
    stop("Number of items must be 24!")
  }
  input <- data %>%
    mutate(id.temp = as.character(row_number()))
  items <- items
  items.pai <- items[1:5]
  items.sti <- items[6:7]
  items.phy <- items[8:24]
  data <- input %>%
    mutate(
      nvalid.womac.pai = rowSums(!is.na(select(., all_of(items.pai)))),
      nvalid.womac.sti = rowSums(!is.na(select(., all_of(items.sti)))),
      nvalid.womac.phy = rowSums(!is.na(select(., all_of(items.phy)))),
      mean.pai.temp = rowSums(select(., all_of(items.pai)), na.rm = TRUE) / nvalid.womac.pai,
      mean.sti.temp = rowSums(select(., all_of(items.sti)), na.rm = TRUE) / nvalid.womac.sti,
      mean.phy.temp = rowSums(select(., all_of(items.phy)), na.rm = TRUE) / nvalid.womac.phy
    ) %>%
    mutate_at(
      vars(items.pai),
      list(~ ifelse(is.na(.), mean.pai.temp, .))
    ) %>%
    mutate_at(
      vars(items.sti),
      list(~ ifelse(is.na(.), mean.sti.temp, .))
    ) %>%
    mutate_at(
      vars(items.phy),
      list(~ ifelse(is.na(.), mean.phy.temp, .))
    ) %>%
    mutate(
      score.womac.pai = ifelse(nvalid.womac.pai >= nvalid.womac.pai, rowSums(select(., items.pai), na.rm = TRUE), NA),
      score.womac.sti = ifelse(nvalid.womac.sti >= nvalid.womac.sti, rowSums(select(., items.sti), na.rm = TRUE), NA),
      score.womac.phy = ifelse(nvalid.womac.phy >= nvalid.womac.phy, rowSums(select(., items.phy), na.rm = TRUE), NA)
    ) %>%
    mutate(score.womac.glo = rowSums(select(., score.womac.pai:score.womac.phy), na.rm = FALSE)) %>%
    select(id.temp, starts_with("nvalid."), starts_with("score.womac"))
  data <- input %>%
    inner_join(data, by = "id.temp") %>%
    select(-id.temp)
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -starts_with("nvalid.womac."))
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(
      vars(
        score.womac.pai, score.womac.sti,
        score.womac.phy, score.womac.glo
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}
NULL