diff --git a/R/charlson.R b/R/charlson.R index 1a1cae2b..2d7a7834 100644 --- a/R/charlson.R +++ b/R/charlson.R @@ -7,6 +7,8 @@ #' @param iddf A `data.frame` of unique IDs #' @param cmrb A `data.frame` containing at least `id.vars` and #' `condition` columns; i.e., the 'comorbidity' `data.frame`. +#' @param primarydx.var Character (scalar) with the name of the column in +#' `cmrb` denoting if the condition was flaged as a primary diagnostic or not. #' @param method Character scalar; name of the Charlson variant to assess #' #' @return A `data.frame` with `id.vars`, per-condition 0/1 @@ -15,8 +17,12 @@ #' @family internal comorbidity functions #' @noRd #' @keywords internal -.charlson <- function(id.vars, iddf, cmrb, method) { - ccc <- unique(mdcr_select(cmrb, cols = c(id.vars, "condition"))) +.charlson <- function(id.vars, iddf, cmrb, primarydx.var, method) { + ccc <- unique(mdcr_select(cmrb, cols = c(id.vars, "condition", primarydx.var))) + + # omit primary dx + idx <- which(ccc[[primarydx.var]] == 0L) + ccc <- mdcr_subset(ccc, i = idx) # get the method weights and conditions conditions <- mdcr_subset(..mdcr_internal_charlson_index_scores.., diff --git a/R/comorbidities.R b/R/comorbidities.R index 2002dc13..68a8fab0 100644 --- a/R/comorbidities.R +++ b/R/comorbidities.R @@ -257,7 +257,7 @@ comorbidities.data.frame <- function(data, } } - if (startsWith(method, "elixhauser") & !is.null(primarydx.var)) { + if ((startsWith(method, "elixhauser") | startsWith(method, "charlson")) & !is.null(primarydx.var)) { is_a_column(primarydx.var, names(data)) pn <- primarydx.var %in% ..protected_names.. if (pn) { @@ -268,6 +268,9 @@ comorbidities.data.frame <- function(data, ) ) } + } else if (startsWith(method, "pccc") & (!is.null(primarydx.var) | !is.null(primarydx))) { + warning("primarydx.var and primarydx are ignored when method = '%s'", method) + primarydx.var <- primarydx <- NULL } flag.method <- @@ -447,7 +450,7 @@ comorbidities.data.frame <- function(data, is_a_column(poa.var, nms) } - if (startsWith(method, "elixhauser")) { + if (startsWith(method, "elixhauser") | startsWith(method, "charlson")) { if (is.null(primarydx.var)) { if (!is.null(primarydx)) { stopifnot(inherits(primarydx, "numeric") | inherits(primarydx, "integer")) @@ -455,18 +458,14 @@ comorbidities.data.frame <- function(data, primarydx <- as.integer(primarydx) stopifnot(primarydx %in% c(0L, 1L)) } else { - if (grepl("^elixhauser", method)) { - warning("Assuming all codes provided are secondary diagnostic codes. Define `primarydx.var` or `primarydx` if this assumption is incorrect.", call. = FALSE) - } + warning("Assuming all codes provided are secondary diagnostic codes. Define `primarydx.var` or `primarydx` if this assumption is incorrect.", call. = FALSE) primarydx <- 0L } primarydx.var <- build_name("..medicalcoder_primarydx..", nms) - if (grepl("^elixhauser", method)) { - on_full <- mdcr_set(on_full, j = primarydx.var, value = rep(primarydx, nrow(on_full))) - on_comp <- mdcr_set(on_comp, j = primarydx.var, value = rep(primarydx, nrow(on_comp))) - } + on_full <- mdcr_set(on_full, j = primarydx.var, value = rep(primarydx, nrow(on_full))) + on_comp <- mdcr_set(on_comp, j = primarydx.var, value = rep(primarydx, nrow(on_comp))) } else { if (!is.null(primarydx)) { @@ -556,7 +555,12 @@ comorbidities.data.frame <- function(data, cmrb <- do.call(rbind, foc) - cmrb[[poa.var]][cmrb[[encid]] > cmrb[["first_occurrance"]]] <- 1L + # set poa to 1 and primarydx to 0 for prior conditions + idx <- cmrb[[encid]] > cmrb[["first_occurrance"]] + cmrb[[poa.var]][idx] <- 1L + if (!is.null(primarydx.var)) { + cmrb[[primarydx.var]][cmrb[[encid]] > cmrb[["first_occurrance"]]] <- 0L + } cmrb <- mdcr_set(cmrb, j = "first_occurrance", value = NULL) cmrb <- unique(cmrb) @@ -577,7 +581,7 @@ comorbidities.data.frame <- function(data, } else if (startsWith(method, "pccc_v3")) { ccc <- .pccc_v3(id.vars = id.vars, iddf = iddf, cmrb = cmrb, subconditions = subconditions) } else if (startsWith(method, "charlson")) { - ccc <- .charlson(id.vars = id.vars, iddf = iddf, cmrb = cmrb, method) + ccc <- .charlson(id.vars = id.vars, iddf = iddf, cmrb = cmrb, primarydx.var = primarydx.var, method = method) if (!is.null(age.var)) { ages <- unique(mdcr_select(data, cols = c(id.vars, age.var))) ages[["age_score"]] <- as.integer(cut(ages[[age.var]], breaks = c(-Inf, 50, 60, 70, 80, Inf), right = FALSE)) - 1L @@ -587,7 +591,7 @@ comorbidities.data.frame <- function(data, ccc[["age_score"]] <- rep(NA_integer_, nrow(ccc)) } } else if (startsWith(method, "elixhauser")) { - ccc <- .elixhauser(id.vars = id.vars, iddf = iddf, cmrb = cmrb, poa.var = poa.var, primarydx.var = primarydx.var, method) + ccc <- .elixhauser(id.vars = id.vars, iddf = iddf, cmrb = cmrb, poa.var = poa.var, primarydx.var = primarydx.var, method = method) } else { stop(sprintf("method '%s' has not yet been implemented", method)) } diff --git a/man-roxygen/params-comorbidities.R b/man-roxygen/params-comorbidities.R index 8388ecc9..783f1108 100644 --- a/man-roxygen/params-comorbidities.R +++ b/man-roxygen/params-comorbidities.R @@ -45,9 +45,9 @@ #' #' @param primarydx.var Character scalar naming the column in `data` that #' indicates whether `data[[icd.codes]]` are primary diagnostic codes (`1L`) -#' or not (`0L`). Primary diagnosis is used only for Elixhauser comorbidities -#' and is ignored when the method is PCCC or Charlson. `primarydx.var` takes -#' precedence over `primarydx` if both are provided. +#' or not (`0L`). Primary diagnosis is used only for Elixhauser and Charlson +#' comorbidities and is ignored when the method is a PCCC variant. +#' `primarydx.var` takes precedence over `primarydx` if both are provided. #' #' @param primarydx An integer value of `0` or `1`. If `0`, #' treat all codes as non-primary diagnoses; if `1`, treat all codes as diff --git a/man/comorbidities.Rd b/man/comorbidities.Rd index 8f93efd0..00b05a4c 100644 --- a/man/comorbidities.Rd +++ b/man/comorbidities.Rd @@ -78,9 +78,9 @@ patient age in years. Only applicable to Charlson comorbidities.} \item{primarydx.var}{Character scalar naming the column in \code{data} that indicates whether \code{data[[icd.codes]]} are primary diagnostic codes (\code{1L}) -or not (\code{0L}). Primary diagnosis is used only for Elixhauser comorbidities -and is ignored when the method is PCCC or Charlson. \code{primarydx.var} takes -precedence over \code{primarydx} if both are provided.} +or not (\code{0L}). Primary diagnosis is used only for Elixhauser and Charlson +comorbidities and is ignored when the method is a PCCC variant. +\code{primarydx.var} takes precedence over \code{primarydx} if both are provided.} \item{primarydx}{An integer value of \code{0} or \code{1}. If \code{0}, treat all codes as non-primary diagnoses; if \code{1}, treat all codes as diff --git a/tests/test-comorbidities.R b/tests/test-comorbidities.R index 5f92909a..d2703beb 100644 --- a/tests/test-comorbidities.R +++ b/tests/test-comorbidities.R @@ -233,6 +233,21 @@ stopifnot( inherits(out4, "error") ) +################################################################################ +# when a primarydx.var was passed to comorbidities when not needed an error was +# thrown. https://github.com/dewittpe/medicalcoder/issues/16 +# +# This has been corrected to be a warning - ignore primarydx.var unless +# elixhauser_ahrq2022 or newer +comorbidities( + data = mdcr, + id.var = "patid", + #primarydx.var = "full_code", + method = "charlson_quan2005", + icd.codes = "code", + poa = 1 +) + ################################################################################ # End of File # ################################################################################ diff --git a/vignettes/charlson.Rmd b/vignettes/charlson.Rmd index fe622729..f51c573c 100644 --- a/vignettes/charlson.Rmd +++ b/vignettes/charlson.Rmd @@ -66,6 +66,7 @@ mdcr_results <- dx.var = "dx", flag.method = "current", poa = 1, + primarydx = 0, method = "charlson_quan2005" ) ``` diff --git a/vignettes/comorbidities.Rmd b/vignettes/comorbidities.Rmd index afe49efe..57c685bc 100644 --- a/vignettes/comorbidities.Rmd +++ b/vignettes/comorbidities.Rmd @@ -216,7 +216,7 @@ subset( record <- structure( list( - patid = c("A", "A", "A", "A", "A", "A", "A"), + patid = c("A", "A", "A", "A", "A", "A", "A"), encid = c(1L, 2L, 3L, 4L, 5L, 5L, 6L), code = c(NA, "C78.4", "I50.40", NA, "C78.4", "I50.40", NA), poa = c(NA, 0L, 1L, NA, 1L, 0L, NA)), @@ -236,12 +236,11 @@ args <- icd.codes = "code", id.vars = c("patid", "encid"), icdv = 10L, - dx = 1, - primarydx = 0L + dx = 1 ) -args_current_poa0 <- c(args, poa = 0L, flag.method = "current") -args_current_poa1 <- c(args, poa = 1L, flag.method = "current") -args_current_poav <- c(args, poa.var = "poa", flag.method = "current") +args_current_poa0 <- c(args, poa = 0L, flag.method = "current") +args_current_poa1 <- c(args, poa = 1L, flag.method = "current") +args_current_poav <- c(args, poa.var = "poa", flag.method = "current") args_cumulative_poa0 <- c(args, poa = 0L, flag.method = "cumulative") args_cumulative_poa1 <- c(args, poa = 1L, flag.method = "cumulative") args_cumulative_poav <- c(args, poa.var = "poa", flag.method = "cumulative") @@ -256,29 +255,29 @@ rtn <- do.call(cbind, list( left_cols, - do.call(comorbidities, c(args_current_poa0, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_current_poa0, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_current_poa0, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], - do.call(comorbidities, c(args_current_poa1, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_current_poa1, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_current_poa1, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], - do.call(comorbidities, c(args_current_poav, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_current_poav, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_current_poav, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)] + do.call(comorbidities, c(args_current_poa0, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_current_poa0, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_current_poa0, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], + do.call(comorbidities, c(args_current_poa1, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_current_poa1, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_current_poa1, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], + do.call(comorbidities, c(args_current_poav, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_current_poav, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_current_poav, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)] )) , do.call(cbind, list( left_cols, - do.call(comorbidities, c(args_cumulative_poa0, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_cumulative_poa0, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_cumulative_poa0, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], - do.call(comorbidities, c(args_cumulative_poa1, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_cumulative_poa1, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_cumulative_poa1, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], - do.call(comorbidities, c(args_cumulative_poav, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], - do.call(comorbidities, c(args_cumulative_poav, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], - do.call(comorbidities, c(args_cumulative_poav, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)] + do.call(comorbidities, c(args_cumulative_poa0, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_cumulative_poa0, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_cumulative_poa0, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], + do.call(comorbidities, c(args_cumulative_poa1, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_cumulative_poa1, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_cumulative_poa1, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)], + do.call(comorbidities, c(args_cumulative_poav, method = "pccc_v3.0"))[, .(CVD = cvd_dxpr_or_tech, CANCER = malignancy_dxpr_or_tech)], + do.call(comorbidities, c(args_cumulative_poav, primarydx = 0L, method = "charlson_quan2011"))[, .(CVD = chf, CANCER = mst)], + do.call(comorbidities, c(args_cumulative_poav, primarydx = 0L, method = "elixhauser_ahrq2025"))[, .(CVD = HF, CANCER = CANCER_METS)] )) ) ``` @@ -366,7 +365,8 @@ cmdf_mdcr <- dx.var = "dx", method = "charlson_cdmf2019", flag.method = "current", - poa = 1) + primarydx = 0L, + poa = 1L) data.table::setDT(cmdf_mdcr) cmdf_mdcr[, .N, keyby = .(hiv, aids)]