Nothing
# nocov start
#' Download AHRQ CCS ICD-9 definitions
#' @template ccs-single
#' @template dotdotdot
#' @keywords internal
#' @noRd
icd9_fetch_ahrq_ccs <- function(single = TRUE) {
assert_flag(single)
ccs_base <- "https://www.hcup-us.ahrq.gov/toolssoftware/ccs"
if (single) {
.unzip_to_data_raw(
url = paste0(c(ccs_base, "Single_Level_CCS_2015.zip"), collapse = "/"),
file_name = "$dxref 2015.csv"
)
} else {
.unzip_to_data_raw(
url = paste0(c(ccs_base, "Multi_Level_CCS_2015.zip"), collapse = "/"),
file_name = "ccs_multi_dx_tool_2015.csv"
)
}
}
#' Download AHRQ CCS ICD-10 definitions
#' @param version Default \code{2018.1}
#' @template dotdotdot
#' @keywords internal
#' @noRd
icd10_fetch_ahrq_ccs <- function(version = "2018.1", ...) {
assert_character(version, pattern = "^20[0-9]{2}\\.[1-9]$")
version <- gsub(".", "_", version, fixed = TRUE)
# all information in one file, no need for single vs multi
.unzip_to_data_raw(
url = paste0(
"https://www.hcup-us.ahrq.gov/toolssoftware/ccs10/ccs_dx_icd10cm_",
version, ".zip"
),
file_name = paste0("ccs_dx_icd10cm_", version, ".csv"),
...
)
}
#' parse AHRQ CCS for mapping
#'
#' Data is downloaded from AHRQ website. ICD9 codes were frozen so no updates
#' are needed. CCS codes are available in a Multi level format and a Single
#' level format. Single level is most common for risk adjustment (Ex. CMS
#' Readmission metric)
#' @template ccs-single
#' @param save_pkg_data logical whether to save the result in the source tree.
#' Defaults to \code{FALSE}.
#' @template offline
#' @importFrom utils read.csv
#' @examples
#' \dontrun{
#' icd:::icd9_parse_ahrq_ccs(single = TRUE, offline = FALSE)
#' icd:::icd9_parse_ahrq_ccs(single = TRUE, offline = TRUE)
#' icd:::icd9_parse_ahrq_ccs(single = FALSE, offline = FALSE)
#' icd:::icd9_parse_ahrq_ccs(single = FALSE, offline = TRUE)
#' }
#' @keywords internal manip
#' @noRd
icd9_parse_ahrq_ccs <- function(single = TRUE,
save_pkg_data = FALSE) {
assert_flag(single)
assert_flag(save_pkg_data)
ahrq_ccs <- icd9_fetch_ahrq_ccs(single = single)
clean_icd9 <- function(x) as.short_diag(as.icd9(trimws(x)))
resort_lvls <- function(x) {
# Function to reorder numbers of CCS
lvls_names <- names(x)
lvls_has_empty <- any(lvls_names == " ")
lvls <- lvls_names[lvls_names != " "]
lvls <- strsplit(lvls, ".", fixed = TRUE)
number_splits <- length(lvls[[1]])
lvls <- matrix(
as.numeric(unlist(lvls)),
ncol = number_splits, byrow = TRUE,
dimnames = list(rownames = lvls_names[lvls_names != " "])
)
# complicated call needed or order using all columns of matrix
lvls <- lvls[do.call(order, as.data.frame(lvls)), ]
# if only looking at lvl1, then this becomes a vector, not a matrix
if (is.null(dim(lvls))) {
lvls <- names(lvls)
} else {
lvls <- rownames(lvls)
}
if (lvls_has_empty) lvls <- c(lvls, " ")
x[lvls]
}
rsrt <- function(x) comorbidity_map(resort_lvls(x))
if (!single) {
ahrq_df <- read.csv(ahrq_ccs$file_path,
quote = "'\"",
colClasses = "character"
)
lvl1 <- rsrt(tapply(
ahrq_df[["ICD.9.CM.CODE"]],
ahrq_df[["CCS.LVL.1"]],
clean_icd9
))
lvl2 <- rsrt(tapply(
ahrq_df[["ICD.9.CM.CODE"]],
ahrq_df[["CCS.LVL.2"]],
clean_icd9
))
lvl3 <- rsrt(tapply(
ahrq_df[["ICD.9.CM.CODE"]],
ahrq_df[["CCS.LVL.3"]],
clean_icd9
))
lvl4 <- rsrt(tapply(
ahrq_df[["ICD.9.CM.CODE"]],
ahrq_df[["CCS.LVL.4"]],
clean_icd9
))
icd9_map_multi_ccs <- list(
lvl1 = lvl1,
lvl2 = lvl2,
lvl3 = lvl3,
lvl4 = lvl4
)
make_labels <- function(lvl = 1) {
values_col <- paste0("CCS.LVL.", lvl)
label_col <- paste0("CCS.LVL.", lvl, ".LABEL")
lkp_chr <- trimws(ahrq_df[[label_col]])
names(lkp_chr) <- trimws(ahrq_df[[values_col]])
lkp_chr <- lkp_chr[nchar(names(lkp_chr)) != 0]
lkp_chr[!duplicated(names(lkp_chr))]
}
icd9_names_multi_ccs <- list(
lvl1 = make_labels(1),
lvl2 = make_labels(2),
lvl3 = make_labels(3),
lvl4 = make_labels(4)
)
if (save_pkg_data) {
.save_in_data_dir(icd9_map_multi_ccs)
.save_in_data_dir(icd9_names_multi_ccs)
}
out <- icd9_map_multi_ccs
} else {
ahrq_df <- read.csv(ahrq_ccs$file_path,
quote = "'\"",
colClasses = "character", skip = 1
)
icd9_names_single_ccs <- trimws(ahrq_df$CCS.CATEGORY.DESCRIPTION)
names(icd9_names_single_ccs) <- trimws(ahrq_df$CCS.CATEGORY)
# look for duplicated lkps because there may be different spellings
# in the labels
duplicated_rows <- duplicated(names(icd9_names_single_ccs))
icd9_names_single_ccs <- icd9_names_single_ccs[!duplicated_rows]
icd9_map_single_ccs <-
rsrt(tapply(
ahrq_df[["ICD.9.CM.CODE"]],
trimws(ahrq_df$CCS.CATEGORY),
clean_icd9
))
if (save_pkg_data) {
.save_in_data_dir(icd9_map_single_ccs)
.save_in_data_dir("icd9_names_single_ccs")
}
out <- icd9_map_single_ccs
}
invisible(out)
}
#' Parse AHRQ CCS for mapping - ICD10
#'
#' Data is downloaded from AHRQ website. ICD10 codes are continually being
#' updated so a parameter for \code{version} is provided. This parameter should
#' mimic those found in
#' \url{https://www.hcup-us.ahrq.gov/toolssoftware/ccs10/ccs10.jsp#archive}.
#' These are in the format of \code{YYYY.1}, \code{YYYY.2} etc.
#' @param version string in format like \sQuote{2018.1} where \sQuote{1} is the
#' version number as shown on the website
#' @param save_pkg_data logical whether to save the result in the source tree.
#' Defaults to \code{FALSE}.
#' @template offline
#' @importFrom utils read.csv
#' @examples
#' \dontrun{
#' # offline = FALSE
#' icd:::icd10_parse_ahrq_ccs(
#' version = "2018.1",
#' save_pkg_data = FALSE, offline = FALSE
#' )
#' icd:::icd10_parse_ahrq_ccs(
#' version = "2018.1",
#' save_pkg_data = FALSE, offline = TRUE
#' )
#' }
#' @keywords internal manip
#' @noRd
icd10_parse_ahrq_ccs <- function(version = "2018.1",
save_pkg_data = FALSE) {
assert_character(version, pattern = "^20[0-9]{2}\\.[1-9]$")
assert_flag(save_pkg_data)
ahrq_ccs <-
icd10_fetch_ahrq_ccs(version = version)
# simpler structure than icd9, all categories in one file
ahrq_df <- read.csv(ahrq_ccs$file_path,
quote = "'\"",
colClasses = "character"
)
# rename columsn to make it easier later to create lookups
names(ahrq_df) <- gsub(".DESCRIPTION", ".LABEL", names(ahrq_df))
clean_icd10 <- function(x) as.icd10(trimws(x))
resort_lvls <- function(x) {
# Function to reorder numbers of CCS
lvls_names <- names(x)
lvls_has_empty <- any(lvls_names == " ")
lvls <- lvls_names[lvls_names != " "]
lvls <- strsplit(lvls, ".", fixed = TRUE)
number_splits <- length(lvls[[1]])
lvls <- matrix(as.numeric(unlist(lvls)),
ncol = number_splits,
byrow = TRUE,
dimnames = list(rownames = lvls_names[lvls_names != " "])
)
# complicated call needed or order using all columns of matrix
lvls <- lvls[do.call(order, as.data.frame(lvls)), ]
# if only looking at lvl1, then this becomes a vector, not a matrix
if (is.null(dim(lvls))) {
lvls <- names(lvls)
} else {
lvls <- rownames(lvls)
}
if (lvls_has_empty) {
lvls <- c(lvls, " ")
}
x[lvls]
}
ccs_lvl_map <- function(col_name) {
comorbidity_map(
resort_lvls(
tapply(
ahrq_df[["ICD.10.CM.CODE"]],
ahrq_df[[col_name]],
clean_icd10
)
)
)
}
# list to define which columns match to which definition
icd10_map_def <- list(
single = "CCS.CATEGORY",
lvl1 = "MULTI.CCS.LVL.1",
lvl2 = "MULTI.CCS.LVL.2"
)
# Because data is in one file, only have one mapping file to save
icd10_map_ccs <- lapply(icd10_map_def, ccs_lvl_map)
ccs_lvl_name <- function(values_col) {
label_col <- paste0(values_col, ".LABEL")
lkp_chr <- trimws(ahrq_df[[label_col]])
names(lkp_chr) <- trimws(ahrq_df[[values_col]])
lkp_chr <- lkp_chr[nchar(names(lkp_chr)) != 0]
lkp_chr[!duplicated(names(lkp_chr))]
}
icd10_names_ccs <- lapply(icd10_map_def, ccs_lvl_name)
icd10_map_ccs <- sapply(icd10_map_ccs,
.apply_over_icd10cm_vers,
simplify = FALSE,
USE.NAMES = TRUE
)
# not applying over WHO codes because CCS is a US-oriented classification.
if (save_pkg_data) {
.save_in_data_dir(icd10_map_ccs)
.save_in_data_dir(icd10_names_ccs)
}
invisible(icd10_map_ccs)
}
# nocov end
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.