R/download_ccsr.R

Defines functions normalize_ccsr_character_columns strip_surrounding_quotes format_icd_codes try_fetch_versions_direct get_latest_from_versions try_fetch_versions_from_url fetch_hcup_versions get_latest_version find_icd_column clean_column_names extract_and_read_ccsr download_file download_ccsr

Documented in download_ccsr

#' Download CCSR Mapping Files from HCUP
#'
#' Downloads and loads Clinical Classifications Software Refined (CCSR) mapping
#' files directly from the Agency for Healthcare Research and Quality (AHRQ)
#' Healthcare Cost and Utilization Project (HCUP) website.
#'
#' @param type Character string specifying the type of CCSR file to download.
#'   Must be one of: "diagnosis" (or "dx") for ICD-10-CM diagnosis codes, or
#'   "procedure" (or "pr") for ICD-10-PCS procedure codes. Default is "diagnosis".
#' @param version Character string specifying the CCSR version to download.
#'   Use "latest" to download the most recent version, or specify a version
#'   like "v2026.1", "v2025.1", etc. Default is "latest".
#' @param cache Logical. If TRUE (default), the downloaded file is cached in
#'   a temporary directory to avoid re-downloading on subsequent calls.
#' @param clean_names Logical. If TRUE (default), column names are cleaned to
#'   follow R naming conventions (snake_case).
#'
#' @return A tibble containing the CCSR mapping data with the following columns:
#'   - For diagnosis files: ICD-10-CM code, CCSR category, default CCSR category,
#'     and clinical descriptions
#'   - For procedure files: ICD-10-PCS code, CCSR category, and descriptions
#'
#' @details
#' This function downloads CCSR mapping files directly from the HCUP website.
#' The package does not redistribute these files but facilitates access to the
#' official AHRQ data sources.
#'
#' The function handles:
#' - Automatic URL construction based on type and version
#' - ZIP file download and extraction
#' - Proper encoding of special characters
#' - Preservation of leading zeros in ICD-10 codes
#' - Conversion to tidy tibble format
#'
#' @examples
#' \donttest{
#' # Download latest diagnosis CCSR mapping
#' dx_map <- download_ccsr("diagnosis")
#'
#' # Download specific version of procedure CCSR mapping
#' pr_map <- download_ccsr("procedure", version = "v2025.1")
#'
#' # Download without caching
#' dx_map <- download_ccsr("diagnosis", cache = FALSE)
#' }
#'
#' @importFrom httr2 request req_timeout req_user_agent req_perform resp_body_string resp_body_raw
#' @importFrom readr read_csv cols locale
#' @importFrom tibble as_tibble
#' @importFrom utils unzip
#' @importFrom xml2 read_html xml_find_all xml_attr xml_text
#' @export
download_ccsr <- function(type = "diagnosis",
                          version = "latest",
                          cache = TRUE,
                          clean_names = TRUE) {
  # Validate type
  type <- tolower(type)
  if (type %in% c("dx", "diagnosis")) {
    type <- "diagnosis"
  } else if (type %in% c("pr", "procedure")) {
    type <- "procedure"
  } else {
    stop("`type` must be one of: 'diagnosis'/'dx' or 'procedure'/'pr'")
  }

  # Get version information - do this early to ensure we have latest
  original_version <- version
  if (version == "latest") {
    # Always clear version cache when user explicitly requests "latest"
    # This ensures we get the freshest version from the website
    cache_name <- paste0("ccsr_latest_version_", type)
    cache_path <- file.path(tempdir(), cache_name)
    if (file.exists(cache_path)) {
      unlink(cache_path)  # Always clear to force fresh discovery
    }
    
    # Force refresh when requesting "latest" to ensure we get the actual latest
    version <- get_latest_version(type, force_refresh = TRUE)
    # Store the actual latest version for later comparison
    actual_latest_version <- version
  } else {
    actual_latest_version <- version
  }

  # Validate version format (accept both v2026.1 and v2026-1)
  if (!grepl("^v\\d{4}[-.]\\d+$", version)) {
    stop("`version` must be in format 'vYYYY.N' or 'vYYYY-N' (e.g., 'v2026.1' or 'v2026-1')")
  }

  # Convert version format to URL format (v2026.1 -> v2026-1)
  version_url <- gsub("\\.", "-", version)
  
  base_url <- "https://hcup-us.ahrq.gov/toolssoftware/ccsr/"
  
  # URL pattern varies by type and version:
  # - Recent diagnosis files (v2026+): DXCCSR-v2026-1.zip (hyphen)
  # - Older diagnosis files (v2025 and earlier): DXCCSR_v2025-1.zip (underscore)
  # - All procedure files: PRCCSR_v2026-1.zip (underscore)
  
  if (type == "diagnosis") {
    # Try hyphen first (newer versions), fall back to underscore (older versions)
    file_name_hyphen <- paste0("DXCCSR-", version_url, ".zip")
    file_name_underscore <- paste0("DXCCSR_", version_url, ".zip")
    
    # Check which pattern exists (try hyphen first for newer versions)
    url_hyphen <- paste0(base_url, file_name_hyphen)
    url_underscore <- paste0(base_url, file_name_underscore)
    
    # For v2026+, use hyphen; for older versions, use underscore
    year <- as.numeric(sub("v(\\d{4})[-.].*", "\\1", version))
    if (year >= 2026) {
      url <- url_hyphen
      file_name <- file_name_hyphen
    } else {
      url <- url_underscore
      file_name <- file_name_underscore
    }
  } else {
    # Procedure files always use underscore
    file_name <- paste0("PRCCSR_", version_url, ".zip")
    url <- paste0(base_url, file_name)
  }

  # Check cache if enabled
  if (cache) {
    cache_dir <- file.path(tempdir(), "HCUPtools_cache")
    if (!dir.exists(cache_dir)) {
      dir.create(cache_dir, recursive = TRUE)
    }
    cache_file <- file.path(cache_dir, file_name)
    
    # If version is "latest", check ALL cached files and find the best match
    if (original_version == "latest") {
      # Find all cached files for this type
      pattern <- if (type == "diagnosis") "DXCCSR.*\\.zip$" else "PRCCSR.*\\.zip$"
      all_cached <- list.files(cache_dir, pattern = pattern, full.names = TRUE, ignore.case = TRUE)
      
      if (length(all_cached) > 0) {
        # Extract versions from all cached files
        cached_versions <- sapply(all_cached, function(f) {
          version_match <- regmatches(basename(f), 
                                     regexpr("v\\d{4}[-.]\\d+", basename(f), 
                                            ignore.case = TRUE))
          if (length(version_match) > 0) {
            gsub("-", ".", version_match[1])
          } else {
            NA_character_
          }
        })
        
        # Find the cached file with the latest version
        valid_cached <- all_cached[!is.na(cached_versions)]
        valid_versions <- cached_versions[!is.na(cached_versions)]
        
        if (length(valid_cached) > 0) {
          # Compare with actual latest version
          actual_latest_normalized <- gsub("-", ".", actual_latest_version)
          
          # Check if any cached file matches the latest version
          matching_idx <- which(valid_versions == actual_latest_normalized)
          
          if (length(matching_idx) > 0) {
            # Found a cached file matching latest version
            cache_file <- valid_cached[matching_idx[1]]
            message("Using cached file: ", cache_file)
            zip_path <- cache_file
          } else {
            # No cached file matches latest version - download new one
            message("Cached files found (", paste(valid_versions, collapse = ", "), 
                   ") but latest is ", actual_latest_version, 
                   ". Downloading latest version...")
            # Remove old cached files (optional - could keep them)
            # unlink(valid_cached)
            zip_path <- download_file(url, cache_file)
          }
        } else {
          # Couldn't parse versions from cached files
          zip_path <- download_file(url, cache_file)
        }
      } else {
        # No cached files found
        zip_path <- download_file(url, cache_file)
      }
    } else {
      # Specific version requested - check if exact file exists
      if (file.exists(cache_file)) {
        message("Using cached file: ", cache_file)
        zip_path <- cache_file
      } else {
        zip_path <- download_file(url, cache_file)
      }
    }
  } else {
    zip_path <- download_file(url, tempfile(fileext = ".zip"))
  }

  mapping_data <- extract_and_read_ccsr(zip_path, type, version, clean_names)
  return(mapping_data)
}

#' Helper function to download file with error handling
#'
#' @noRd
download_file <- function(url, destfile) {
  message("Downloading from: ", url)
  
  tryCatch({
    resp <- httr2::request(url) |>
      httr2::req_timeout(60) |>
      httr2::req_user_agent("HCUPtools R package") |>
      httr2::req_perform()
    
    httr2::resp_body_raw(resp) |>
      writeBin(destfile)
    
    message("Download complete: ", destfile)
    return(destfile)
  }, error = function(e) {
    # Try alternative URL pattern if first attempt fails
    if (grepl("DXCCSR", url)) {
      alt_url <- gsub("DXCCSR-", "DXCCSR_", url)
      alt_url <- gsub("DXCCSR_", "DXCCSR-", alt_url)
      
      if (alt_url != url) {
        tryCatch({
          message("Trying alternative URL pattern: ", alt_url)
          resp <- httr2::request(alt_url) |>
            httr2::req_timeout(60) |>
            httr2::req_user_agent("HCUPtools R package") |>
            httr2::req_perform()
          
          httr2::resp_body_raw(resp) |>
            writeBin(destfile)
          
          message("Download complete: ", destfile)
          return(destfile)
        }, error = function(e2) {
          stop("Failed to download file from both URL patterns. ",
               "Original error: ", conditionMessage(e), ". ",
               "Alternative error: ", conditionMessage(e2))
        })
      }
    }
    stop("Failed to download file: ", conditionMessage(e))
  })
}

#' Extract and read CCSR mapping file from ZIP
#'
#' @noRd
extract_and_read_ccsr <- function(zip_path, type, version, clean_names) {
  # Create temporary extraction directory
  extract_dir <- tempfile("ccsr_extract_")
  dir.create(extract_dir, showWarnings = FALSE)
  on.exit(unlink(extract_dir, recursive = TRUE), add = TRUE)
  
  # Extract ZIP file
  utils::unzip(zip_path, exdir = extract_dir)
  
  # Find CSV or Excel file in extracted directory
  all_files <- list.files(extract_dir, recursive = TRUE, full.names = TRUE)
  
  # Look for CSV files first (preferred)
  csv_files <- all_files[grepl("\\.csv$", all_files, ignore.case = TRUE)]
  xlsx_files <- all_files[grepl("\\.xlsx?$", all_files, ignore.case = TRUE)]
  
  # Filter by type if possible
  if (type == "diagnosis") {
    csv_files <- csv_files[grepl("DX|diagnosis", basename(csv_files), ignore.case = TRUE)]
    xlsx_files <- xlsx_files[grepl("DX|diagnosis", basename(xlsx_files), ignore.case = TRUE)]
  } else {
    csv_files <- csv_files[grepl("PR|procedure", basename(csv_files), ignore.case = TRUE)]
    xlsx_files <- xlsx_files[grepl("PR|procedure", basename(xlsx_files), ignore.case = TRUE)]
  }
  
  # If no type-specific files found, use all CSV/Excel files
  if (length(csv_files) == 0 && length(xlsx_files) == 0) {
    csv_files <- all_files[grepl("\\.csv$", all_files, ignore.case = TRUE)]
    xlsx_files <- all_files[grepl("\\.xlsx?$", all_files, ignore.case = TRUE)]
  }
  
  mapping_file <- NULL
  if (length(csv_files) > 0) {
    mapping_file <- csv_files[1]
  } else if (length(xlsx_files) > 0) {
    if (!requireNamespace("readxl", quietly = TRUE)) {
      stop("Package 'readxl' is required for reading Excel files. ",
           "Install it with: install.packages('readxl')")
    }
    mapping_file <- xlsx_files[1]
  } else {
    stop("No CSV or Excel file found in the downloaded ZIP archive")
  }
  
  if (length(mapping_file) > 1) {
    warning("Multiple mapping files found, using: ", mapping_file[1])
    mapping_file <- mapping_file[1]
  }

  message("Reading mapping file: ", basename(mapping_file))
  
  mapping_data <- readr::read_csv(
    mapping_file,
    col_types = readr::cols(.default = "c"),
    locale = readr::locale(encoding = "UTF-8"),
    show_col_types = FALSE
  )

  mapping_data <- tibble::as_tibble(mapping_data)

  if (clean_names) {
    names(mapping_data) <- clean_column_names(names(mapping_data))
  }

  # Normalize quoted values found in HCUP files (e.g., 'DIG001')
  mapping_data <- normalize_ccsr_character_columns(mapping_data)

  icd_col <- find_icd_column(mapping_data, type)
  if (!is.null(icd_col)) {
    mapping_data[[icd_col]] <- format_icd_codes(mapping_data[[icd_col]])
  }

  return(mapping_data)
}

#' Helper function to clean column names
#'
#' @noRd
clean_column_names <- function(names) {
  names <- gsub("\\s+", "_", names)
  names <- gsub("[^A-Za-z0-9_]", "", names)
  names <- tolower(names)
  names <- gsub("_+", "_", names)
  names <- gsub("^_|_$", "", names)
  return(names)
}

#' Helper function to find ICD code column
#'
#' @noRd
find_icd_column <- function(df, type) {
  col_names <- tolower(names(df))
  original_names <- names(df)
  
  if (type == "diagnosis") {
    patterns <- c("icd.*10.*cm", "icd.*10", "diagnosis.*code", "^code$", "^dx$")
  } else {
    patterns <- c("icd.*10.*pcs", "icd.*10", "procedure.*code", "^code$", "^pr$")
  }
  
  for (pattern in patterns) {
    match_idx <- grep(pattern, col_names)
    if (length(match_idx) > 0) {
      return(original_names[match_idx[1]])
    }
  }
  
  return(original_names[1])
}

#' Get latest available CCSR version from HCUP website
#'
#' Fetches the latest available CCSR version from the HCUP website
#' for the specified type (diagnosis or procedure). Results are cached for
#' 6 hours to minimize website requests.
#'
#' @param type Character string, either "diagnosis" or "procedure"
#' @return Character string with version (e.g., "v2026.1")
#'
#' @noRd
get_latest_version <- function(type, force_refresh = FALSE) {
  # Cache the result to avoid repeated requests
  cache_name <- paste0("ccsr_latest_version_", type)
  cache_path <- file.path(tempdir(), cache_name)
  
  # If force_refresh is TRUE, clear cache and fetch fresh
  if (force_refresh && file.exists(cache_path)) {
    unlink(cache_path)
  }
  
  # Check cache (valid for 6 hours)
  if (!force_refresh && file.exists(cache_path)) {
    cache_info <- file.info(cache_path)
    cache_age <- as.numeric(Sys.time() - cache_info$mtime, units = "hours")
    if (cache_age < 6) {
      cached_version <- readLines(cache_path, n = 1, warn = FALSE)
      if (nchar(cached_version) > 0 && grepl("^v\\d{4}[-.]\\d+$", cached_version)) {
        # Verify cached version is not too old (should be within last 2 years)
        year_match <- regmatches(cached_version, regexec("v(\\d{4})", cached_version))[[1]]
        if (length(year_match) >= 2) {
          cached_year <- as.numeric(year_match[2])
          current_year <- as.numeric(format(Sys.Date(), "%Y"))
          # Accept cached version if it's from current year or next year
          if (cached_year >= current_year) {
            return(cached_version)
          }
        }
      }
    }
  }
  
  file_prefix <- if (type == "diagnosis") "DXCCSR" else "PRCCSR"
  
  latest_version <- tryCatch({
    fetch_hcup_versions(file_prefix)
  }, error = function(e) {
    warning("Could not fetch latest version from HCUP website: ", 
            conditionMessage(e), 
            ". Using fallback version based on current year")
    NULL
  })
  
  # Validate the version format
  if (is.null(latest_version) || !grepl("^v\\d{4}[-.]\\d+$", latest_version)) {
    # If we can't fetch, try direct file checking as last resort
    latest_version <- try_fetch_versions_direct(file_prefix)
    if (is.null(latest_version) || length(latest_version) == 0) {
      # Last resort: use current year + 1 as fallback (to catch early releases)
      current_year <- as.numeric(format(Sys.Date(), "%Y"))
      # Check if next year version exists, otherwise use current year
      test_year <- current_year + 1
      test_file <- if (file_prefix == "DXCCSR" && test_year >= 2026) {
        paste0(file_prefix, "-v", test_year, "-1.zip")
      } else {
        paste0(file_prefix, "_v", test_year, "-1.zip")
      }
      test_url <- paste0("https://hcup-us.ahrq.gov/toolssoftware/ccsr/", test_file)
      
      next_year_exists <- tryCatch({
        resp <- httr2::request(test_url) |>
          httr2::req_method("HEAD") |>
          httr2::req_user_agent("HCUPtools R package") |>
          httr2::req_timeout(3) |>
          httr2::req_perform()
        httr2::resp_status(resp) %in% c(200, 302, 301)
      }, error = function(e) FALSE)
      
      if (next_year_exists) {
        latest_version <- paste0("v", test_year, ".1")
      } else {
        latest_version <- paste0("v", current_year, ".1")
      }
      warning("Could not determine latest version from HCUP website. ",
              "Using fallback version: ", latest_version,
              ". This may not be the actual latest version.")
    } else {
      latest_version <- get_latest_from_versions(latest_version)
    }
  }
  
  writeLines(latest_version, cache_path)
  return(latest_version)
}

#' Fetch available CCSR versions from HCUP website
#'
#' @param file_prefix Character string, either "DXCCSR" or "PRCCSR"
#' @return Character string with latest version, or NULL if not found
#'
#' @noRd
fetch_hcup_versions <- function(file_prefix) {
  # Try direct file checking FIRST (most reliable)
  # This directly checks if files exist, which is more accurate than parsing HTML
  versions_direct <- try_fetch_versions_direct(file_prefix)
  if (!is.null(versions_direct) && length(versions_direct) > 0) {
    # Direct file check found versions - use these (most reliable)
    return(get_latest_from_versions(versions_direct))
  }
  
  # Fallback: Try multiple URLs to find versions
  urls_to_try <- c(
    "https://hcup-us.ahrq.gov/toolssoftware/ccsr/ccs_refined.jsp",
    "https://hcup-us.ahrq.gov/toolssoftware/ccsr/",
    "https://hcup-us.ahrq.gov/toolssoftware/ccsr/ccsr_archive.jsp"
  )
  
  all_versions <- character(0)
  
  for (url in urls_to_try) {
    versions <- try_fetch_versions_from_url(url, file_prefix)
    if (!is.null(versions) && length(versions) > 0) {
      all_versions <- c(all_versions, versions)
    }
  }
  
  if (length(all_versions) > 0) {
    # Remove duplicates and get latest
    all_versions <- unique(all_versions)
    return(get_latest_from_versions(all_versions))
  }
  
  NULL
}

#' Fetch versions from a specific URL
#'
#' @param url Character string, URL to fetch
#' @param file_prefix Character string, either "DXCCSR" or "PRCCSR"
#' @return Character vector of version strings, or NULL if error
#'
#' @noRd
try_fetch_versions_from_url <- function(url, file_prefix) {
  tryCatch({
    resp <- httr2::request(url) |>
      httr2::req_user_agent("HCUPtools R package") |>
      httr2::req_timeout(10) |>
      httr2::req_perform()
    
    html_content <- httr2::resp_body_string(resp)
    doc <- xml2::read_html(html_content)
    
    links <- xml2::xml_find_all(doc, "//a[@href]")
    hrefs <- xml2::xml_attr(links, "href")
    
    text_nodes <- xml2::xml_find_all(doc, "//text()[normalize-space()]")
    text_content <- xml2::xml_text(text_nodes)
    all_text <- paste(text_content, collapse = " ")
    
    all_content <- c(hrefs, all_text)
    
    # Pattern to match both v2026.1 and v2026-1 formats
    version_pattern <- paste0(file_prefix, ".*?(v\\d{4}[-.]\\d+)")
    version_matches <- regmatches(all_content, 
                                 gregexpr(version_pattern, all_content, 
                                         ignore.case = TRUE))
    versions <- unlist(version_matches)
    
    if (length(versions) > 0) {
      versions <- gsub(paste0(".*(v\\d{4}[-.]\\d+).*"), "\\1", versions, 
                      ignore.case = TRUE)
      versions <- unique(versions)
      # Normalize to dot format for internal use (v2026-1 -> v2026.1)
      versions <- gsub("-", ".", versions)
      versions <- grep("^v\\d{4}\\.\\d+$", versions, value = TRUE, ignore.case = TRUE)
      return(versions)
    }
    
    NULL
  }, error = function(e) {
    NULL
  })
}

#' Get the latest version from a vector of version strings
#'
#' @param versions Character vector of version strings (e.g., c("v2026.1", "v2025.1"))
#' @return Character string with the latest version
#'
#' @noRd
get_latest_from_versions <- function(versions) {
  if (length(versions) == 0) {
    return(NULL)
  }
  
  # Normalize all versions to vYYYY.N format
  normalized <- vapply(versions, function(v) {
    # Handle both v2026.1 and v2026-1 formats
    v_clean <- gsub("-", ".", v)
    parts <- regmatches(v_clean, regexec("v(\\d{4})\\.(\\d+)", v_clean, ignore.case = TRUE))[[1]]
    if (length(parts) >= 3) {
      year <- as.numeric(parts[2])
      minor <- as.numeric(parts[3])
      # Create sortable numeric value: year * 1000 + minor
      # This ensures v2026.1 > v2025.10
      sort_value <- year * 1000 + minor
      return(sort_value)
    } else {
      return(NA_real_)
    }
  }, numeric(1))
  
  valid_idx <- !is.na(normalized)
  if (any(valid_idx)) {
    # Find the maximum sort value
    max_idx <- which.max(normalized[valid_idx])
    latest_version <- versions[valid_idx][max_idx]
    # Normalize to dot format
    latest_version <- gsub("-", ".", latest_version)
    return(latest_version)
  }
  
  # Fallback: return first version
  return(gsub("-", ".", versions[1]))
}

#' Try to fetch versions by attempting direct file access
#'
#' @param file_prefix Character string, either "DXCCSR" or "PRCCSR"
#' @return Character vector of version strings, or NULL if error
#'
#' @noRd
try_fetch_versions_direct <- function(file_prefix) {
  # Try to find versions by checking common patterns
  # Check next year, current year, and previous year (to catch early releases)
  current_year <- as.numeric(format(Sys.Date(), "%Y"))
  versions_found <- character(0)
  
  # Determine correct separator based on file type and year
  # DXCCSR v2026+ uses hyphen, DXCCSR v2025 and earlier uses underscore
  # PRCCSR always uses underscore
  use_hyphen_for_year <- function(year) {
    file_prefix == "DXCCSR" && year >= 2026
  }
  
  # Check years in order: next year (2026), current year (2025), previous year (2024)
  # This catches early releases of next year's version
  years_to_check <- c(current_year + 1, current_year, current_year - 1)
  
  for (year in years_to_check) {
    # Check minor versions (usually 1-2, but check up to 3)
    for (minor in 1:3) {
      # Determine separator BEFORE version (not between year and minor)
      # Year and minor are always separated by hyphen: v2026-1
      # But the separator before "v" depends on file type and year
      prefix_sep <- if (use_hyphen_for_year(year)) "-" else "_"
      version_str <- paste0("v", year, "-", minor)  # Always hyphen between year and minor
      file_name <- paste0(file_prefix, prefix_sep, version_str, ".zip")
      url <- paste0("https://hcup-us.ahrq.gov/toolssoftware/ccsr/", file_name)
      
      # Quick HEAD request to check if file exists
      file_exists <- tryCatch({
        resp <- httr2::request(url) |>
          httr2::req_method("HEAD") |>
          httr2::req_user_agent("HCUPtools R package") |>
          httr2::req_timeout(5) |>
          httr2::req_perform()
        
        status <- httr2::resp_status(resp)
        status %in% c(200, 302, 301, 303)
      }, error = function(e) FALSE)
      
      if (file_exists) {
        versions_found <- c(versions_found, paste0("v", year, ".", minor))
        # If we found next year version, return immediately (it's the latest)
        if (year > current_year) {
          return(versions_found)  # Next year found - this is definitely the latest
        }
        # For current year or previous year, continue checking all minor versions
      }
      
      # If hyphen didn't work for DXCCSR v2026+, try underscore as fallback (only for first minor)
      if (!file_exists && use_hyphen_for_year(year) && minor == 1) {
        prefix_sep <- "_"
        version_str <- paste0("v", year, "-", minor)  # Always hyphen between year and minor
        file_name <- paste0(file_prefix, prefix_sep, version_str, ".zip")
        url <- paste0("https://hcup-us.ahrq.gov/toolssoftware/ccsr/", file_name)
        
        file_exists <- tryCatch({
          resp <- httr2::request(url) |>
            httr2::req_method("HEAD") |>
            httr2::req_user_agent("HCUPtools R package") |>
            httr2::req_timeout(5) |>
            httr2::req_perform()
          
          status <- httr2::resp_status(resp)
          status %in% c(200, 302, 301, 303)
        }, error = function(e) FALSE)
        
        if (file_exists) {
          versions_found <- c(versions_found, paste0("v", year, ".", minor))
          # If we found next year version, return immediately
          if (year > current_year) {
            return(versions_found)
          }
        }
      }
    }
    
    # After checking all minor versions for next year, if we found any, return them
    if (year > current_year && length(versions_found) > 0) {
      return(versions_found)
    }
  }
  
  if (length(versions_found) > 0) {
    return(unique(versions_found))
  }
  
  NULL
}

#' Helper function to format ICD codes (preserve leading zeros)
#'
#' @noRd
format_icd_codes <- function(codes) {
  # Remove surrounding quotes and whitespace, preserve leading zeros
  codes <- strip_surrounding_quotes(codes)
  codes <- trimws(as.character(codes))
  return(codes)
}

#' Strip surrounding quotes from character values
#'
#' @noRd
strip_surrounding_quotes <- function(x) {
  x <- as.character(x)
  x <- trimws(x)
  x <- gsub("^[\"'`]+|[\"'`]+$", "", x)
  x <- gsub("^[\u2018\u2019\u201C\u201D]+|[\u2018\u2019\u201C\u201D]+$", "", x)
  x
}

#' Normalize character columns in CCSR mapping data
#'
#' @noRd
normalize_ccsr_character_columns <- function(df) {
  chr_cols <- vapply(df, is.character, logical(1))
  if (any(chr_cols)) {
    df[chr_cols] <- lapply(df[chr_cols], strip_surrounding_quotes)
  }
  df
}

Try the HCUPtools package in your browser

Any scripts or data that you put into this service are public.

HCUPtools documentation built on July 13, 2026, 9:06 a.m.