开发临床数据多列ICD-10编码检索并生成二值变量的R函数

问题背景 #

我正在处理一份包含数十万人15年住院episode的临床数据表，每行对应一个episode，包含主诊断列diag_icd10、21个次诊断列（sec_diag_0至sec_diag_20），所有诊断列存储ICD-10编码字符串。需要针对60种疾病（每种对应若干ICD-10编码）生成二值变量：若对应编码出现在指定诊断列则为1，否则为0。目前已实现主诊断列的单疾病判断，但需重复编写大量代码，希望优化为批量处理逻辑。

1. 批量生成主诊断二值变量（condition_prim） #

先将所有疾病的ICD-10编码整理为命名列表（列表名作为疾病标识），通过批量遍历列表自动生成带_prim后缀的二值列：

library(dplyr)
library(purrr)
library(stringr)

# 整理所有疾病的ICD-10编码为命名列表（示例，需补充剩余疾病）
condition_codes <- list(
  anxiety = c("F400", "F401", "F402"),
  asthma = c("J450", "J451", "J458", "J459", "J46X"),
  chronic_lyme = c("A692", "G630", "M012")
)

# 批量生成主诊断二值变量
data <- data |>
  mutate(
    imap_dfc(condition_codes, ~ ifelse(grepl(paste(.x, collapse = "|"), diag_icd10), 1, 0)) |>
      rename_with(~ paste0(.x, "_prim"))
  )

2. 批量生成次诊断二值变量（condition_sec） #

次诊断需检查21列中是否存在匹配编码，通过自定义函数批量处理：

# 定义次诊断列名
sec_diagnosis_cols <- paste0("sec_diag_", 0:20)

# 批量生成次诊断二值变量的函数
create_sec_vars <- function(data, code_list, sec_cols) {
  imap_dfc(code_list, function(codes, cond_name) {
    # 对每行的所有次诊断列检查匹配，只要有一个匹配则为1
    rowSums(across(all_of(sec_cols), ~ grepl(paste(codes, collapse = "|"), .x))) %>%
      as.integer() %>%
      ifelse(. > 0, 1, 0) %>%
      set_names(paste0(cond_name, "_sec"))
  })
}

# 应用函数生成_sec列
data <- data |>
  bind_cols(create_sec_vars(., condition_codes, sec_diagnosis_cols))

3. 合并主/次诊断生成单个二值变量（condition） #

匹配_prim和_sec后缀的列，判断每行是否在主或次诊断中存在目标编码，生成最终的单疾病二值列：

# 合并主/次诊断结果
data <- data |>
  mutate(
    imap_dfc(names(condition_codes), ~ ifelse(get(paste0(.x, "_prim")) | get(paste0(.x, "_sec")), 1, 0)) |>
      set_names(names(condition_codes))
  )

补充说明 #

• 若ICD编码存在大小写不一致的情况，可在grepl中添加ignore.case = TRUE参数
• 若需要精确匹配编码（避免部分匹配），可调整正则表达式为paste(paste0("^", .x, "$"), collapse = "|")

内容的提问来源于stack exchange，提问作者L.Steell