diff --git a/DESCRIPTION b/DESCRIPTION index 1f7306b..be77555 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,7 +34,12 @@ Authors@R: family = "Teo", role = "ctb", email = "ed_teo8@yahoo.com.sg", - comment = c(ORCID = "0000-0003-3936-4082"))) + comment = c(ORCID = "0000-0003-3936-4082")), + person(given = "Matthew", + family = "Moore", + role = "ctb", + email = "matthew.moore@auckland.ac.nz", + comment = c(ORCID = "0000-0003-0730-8027"))) Maintainer: Alessandro Gasparini URL: https://ellessenne.github.io/comorbidity/, https://github.com/ellessenne/comorbidity/ BugReports: https://github.com/ellessenne/comorbidity/issues diff --git a/R/assign0.R b/R/assign0.R index 92ba202..4d901f5 100644 --- a/R/assign0.R +++ b/R/assign0.R @@ -21,6 +21,24 @@ # "Solid tumour" (`solidtum`) and "Metastatic cancer" (`metacanc`) x[metacanc == 1, solidtum := 0] # x$solidtum[x$metacanc == 1] <- 0 + } else if (grepl("m3", map)) { + # Diabetes complicated: add if has diabetes uncomplicated + one or more complication codes... + x[diabunc == 1 & flag_comp_diab == 1, diabc := 1] + # Set Diabetes uncomplicated to zero if diabetes complicated recorded or complications found + x[diabc == 1 | flag_comp_diab == 1, diabunc := 0] + # Exclusions for osteoporosis and hypertension. + x[flag_exc_osteo == 1, osteounc := 0] + x[flag_exc_hyp == 1, hypunc := 0] + # Exclude other cancers if metastatic cancer found. + # for (canc_col_name in names(x)[names(x) %like% '^canc']) { + data.table::set( + x, + i = which(x[, metacanc == 1]), + j = names(x)[data.table::like(names(x), '^canc')], + value = 0 + ) + # } + } return(x) } diff --git a/R/comorbidity.R b/R/comorbidity.R index fbf31dd..141f985 100644 --- a/R/comorbidity.R +++ b/R/comorbidity.R @@ -1,6 +1,6 @@ #' @title Comorbidity mapping. #' -#' @description Maps comorbidity conditions using algorithms from the Charlson and the Elixhauser comorbidity scores. +#' @description Maps comorbidity conditions using algorithms from the Charlson, Elixhauser, and M3 Multimorbidity Index comorbidity scores. #' #' @param x A tidy `data.frame` (or a `data.table`; `tibble`s are supported too) with one column containing an individual ID and a column containing all diagnostic codes. #' Extra columns other than ID and codes are discarded. @@ -9,7 +9,7 @@ #' @param code Column of `x` containing diagnostic codes. #' Codes must be in upper case with no punctuation in order to be properly recognised. #' @param map The mapping algorithm to be used (values are case-insensitive). -#' Possible values are the Charlson score with either ICD-10 or ICD-9-CM codes (`charlson_icd10_quan`, `charlson_icd9_quan`) and the Elixhauser score, again using either ICD-10 or ICD-9-CM (`elixhauser_icd10_quan`, `elixhauser_icd9_quan`). +#' Possible values are the Charlson score with either ICD-10 or ICD-9-CM codes (`charlson_icd10_quan`, `charlson_icd9_quan`), the Elixhauser score, again using either ICD-10 or ICD-9-CM (`elixhauser_icd10_quan`, `elixhauser_icd9_quan`), and the M3 Multimorbidity Index (`m3_icd10_am`) . #' These mapping are based on the paper by Quan et al. (2011). #' It is also possible to obtain a Swedish (`charlson_icd10_se`) or Australian (`charlson_icd10_am`) modification of the Charlson score using ICD-10 codes. #' @param assign0 Apply a hierarchy of comorbidities: should a comorbidity be present in a patient with different degrees of severity, then the milder form will be assigned a value of 0. @@ -21,6 +21,9 @@ #' * "Hypertension, uncomplicated" (`hypunc`) and "Hypertension, complicated" (`hypc`) for the Elixhauser score; #' * "Diabetes, uncomplicated" (`diabunc`) and "Diabetes, complicated" (`diabc`) for the Elixhauser score; #' * "Solid tumour" (`solidtum`) and "Metastatic cancer" (`metacanc`) for the Elixhauser score. +#' * "Diabetes" (`diab`) and "Diabetes with complications" (`diabwc`) for the M3 score; +#' * "Osteoporosis, uncomplicated" (`ostunc`) and "Hypertension, uncomplicated" (`hypunc`) for the M3 score; +#' * All cancers (`canc.+`) for the M3 score; #' #' @param labelled Attach labels to each comorbidity, compatible with the RStudio viewer via the [utils::View()] function. #' Defaults to `TRUE`. @@ -51,7 +54,7 @@ #' * `aids`, for AIDS/HIV. #' Please note that we combine "chronic obstructive pulmonary disease" and "chronic other pulmonary disease" for the Swedish version of the Charlson index, for comparability (and compatibility) with other definitions/implementations. #' -#' Conversely, for the Elixhauser score the dataset contains the following variables: +#' For the Elixhauser score the dataset contains the following variables: #' * The `id` variable as defined by the user; #' * `chf`, for congestive heart failure; #' * `carit`, for cardiac arrhythmias; @@ -84,11 +87,78 @@ #' * `drug`, for drug abuse; #' * `psycho`, for psychoses; #' * `depre`, for depression; +#' +#' * The `id` variable as defined by the user; +#' * `aids`, for AIDS/HIV; +#' * `alcohol`, for Alcohol abuse; +#' * `dane`, for Anemia deficiency; +#' * `anxbd`, for Anxiety and Behavioural disorders; +#' * `aneur`, for Aortic and other aneurysms; +#' * `bone`, for Bone disorders; +#' * `bdi`, for Bowel disease inflammatory; +#' * `cancbreast`, for Breast cancer; +#' * `carit`, for Cardiac arrhythmia; +#' * `valv`, for Cardiac valve; +#' * `cevd`, for Cerebrovascular disease; +#' * `copd`, for Chronic pulmonary; +#' * `rend`, for Chronic renal; +#' * `blood`, for Coagulopathy and other blood disorder; +#' * `canccolrec`, for Colorectal cancer; +#' * `chf`, for Congestive heart failure; +#' * `conntiss`, for Connective tissue disease; +#' * `dementia`, for Dementia; +#' * `diabc`, for Diabetes (complicated); +#' * `diabunc`, for Diabetes (uncomplicated); +#' * `drug`, for Drug abuse; +#' * `endo`, for Endocrine disorder; +#' * `epi`, for Epilepsy; +#' * `ceye`, for Eye problem long term; +#' * `cancgyn`, for Gynaecological cancers; +#' * `cvhep`, for Hepatitis, chronic viral; +#' * `hypunc`, for Hypertension (uncomplicated); +#' * `immsys`, for Immune system disorder; +#' * `inear`, for Inner ear disorder; +#' * `jsd`, for Joint or spinal disorder; +#' * `msld`, for Liver disease (moderate or severe); +#' * `canclung`, for Lung cancer; +#' * `canclymphleuk`, for Lymphomas and leukaemias; +#' * `mpd`, for Major psychiatric disorder; +#' * `cancmela`, for Malignant melanoma; +#' * `maln`, for Malnutrition and other nutritional disorders; +#' * `bd`, for Mental and behavioural disorders due to brain damage; +#' * `mentret`, for Mental retardation; +#' * `metab`, for Metabolic disorder; +#' * `metacanc`, for Metastatic cancer; +#' * `mpnd`, for Muscular peripheral nerve disorder; +#' * `ami`, for Myocardial infarction; +#' * `obes`, for Obesity; +#' * `osteounc`, for Osteoporosis (uncomplicated); +#' * `cancoth`, for Other cancers; +#' * `ond`, for Other neurologic disorders (excluding epilepsy); +#' * `para`, for Paralysis; +#' * `pud`, for Peptic ulcer disease; +#' * `pvd`, for Peripheral vascular disease; +#' * `cancprost`, for Prostate cancer; +#' * `pcd`, for Pulmonary circulation disorders; +#' * `sleep`, for Sleep disorder; +#' * `cancuppergi`, for Upper gastrointestinal cancer; +#' * `utc`, for Urinary tract problem (chronic); +#' * `ven`, for Venous insufficiency; +#' * `ang`, for Angina; +#' * `cdnos`, for Cardiac disease (other); +#' * `cinfnos`, for Infection chronic NOS; +#' * `intest`, for Intestinal disorder; +#' * `panc`, for Pancreatitis; +#' * `tub`, for Tuberculosis; +#' * `flag_comp_diab`, for flagging for diabetes complications; +#' * `flag_exc_osteo`, for flagging for osteoporosis exclusions; +#' * `flag_exc_hyp`, for flagging for hypertension exclusions; #' #' Labels are presented to the user when using the RStudio viewer (e.g. via the [utils::View()] function) for convenience. #' #' @details #' The ICD-10 and ICD-9-CM coding for the Charlson and Elixhauser scores is based on work by Quan _et al_. (2005). +#' The ICD-10-AM coding for the M3 Multimorbidity Index is based on work by Stanley and Sarfati (2017). #' ICD-10 and ICD-9 codes must be in upper case and with alphanumeric characters only in order to be properly recognised; set `tidy.codes = TRUE` to properly tidy the codes automatically. #' A message is printed to the R console when non-alphanumeric characters are found. #' @@ -96,6 +166,7 @@ #' @references Charlson ME, Pompei P, Ales KL, et al. _A new method of classifying prognostic comorbidity in longitudinal studies: development and validation_. Journal of Chronic Diseases 1987; 40:373-383. #' @references Ludvigsson JF, Appelros P, Askling J et al. _Adaptation of the Charlson Comorbidity Index for register-based research in Sweden_. Clinical Epidemiology 2021; 13:21-41. #' @references Sundararajan V, Henderson T, Perry C, Muggivan A, Quan H, Ghali WA. _New ICD-10 version of the Charlson comorbidity index predicted in-hospital mortality_. Journal of Clinical Epidemiology 2004; 57(12):1288-1294. +#' @references Stanley J, Sarfati D. (2017) _The new measuring multimorbidity index predicted mortality better than Charlson and Elixhauser indices among the general population_. Journal of Clinical Epidemiology 2017;92:99-110. DOI: 10.1016/j.jclinepi.2017.08.005 #' @examples #' set.seed(1) #' x <- data.frame( diff --git a/R/labelled.R b/R/labelled.R index 7ca64b5..5a31647 100644 --- a/R/labelled.R +++ b/R/labelled.R @@ -2,8 +2,10 @@ .labelled <- function(x, map) { attr(x, "variable.labels") <- if (grepl("^charlson_", map)) { c("ID", "Myocardial infarction", "Congestive heart failure", "Peripheral vascular disease", "Cerebrovascular disease", "Dementia", "Chronic pulmonary disease", "Rheumatoid disease", "Peptic ulcer disease", "Mild liver disease", "Diabetes without chronic complications", "Diabetes with chronic complications", "Hemiplegia or paraplegia", "Renal disease", "Cancer (any malignancy)", "Moderate or severe liver disease", "Metastatic solid tumour", "AIDS/HIV") + } else if (grepl("^m3_", map)) { + labs = c( "ID", "AIDS/HIV", "Alcohol abuse", "Anemia deficiency", "Anxiety and Behavioural disorders", "Aortic and other aneurysms", "Bone disorders", "Bowel disease inflammatory", "Breast cancer", "Cardiac arrhythmia", "Cardiac valve", "Cerebrovascular disease", "Chronic pulmonary", "Chronic renal", "Coagulopathy and other blood disorders", "Colorectal cancer", "Congestive heart failure", "Connective tissue disease", "Dementia", "Diabetes (complicated)", "Diabetes (uncomplicated)", "Drug abuse", "Endocrine disorder", "Epilepsy", "Eye problem long term", "Gynaecological cancers", "Hepatitis, chronic viral", "Hypertension (uncomplicated)", "Immune system disorder", "Inner ear disorder", "Joint or spinal disorder", "Liver disease (moderate or severe)", "Lung cancer", "Lymphomas and leukaemias", "Major psychiatric disorder", "Malignant melanoma", "Malnutrition and other nutritional disorders", "Mental and behavioural disorders due to brain damage", "Mental retardation", "Metabolic disorder", "Metastatic cancer", "Muscular peripheral nerve disorders", "Myocardial infarction", "Obesity", "Osteoporosis (uncomplicated)", "Other cancers", "Other neurologic disorders (excluding epilepsy)", "Paralysis", "Peptic ulcer disease", "Peripheral vascular disease", "Prostate cancer", "Pulmonary circulation disorders", "Sleep disorder", "Upper gastrointestinal cancer", "Urinary tract problem (chronic)", "Venous insufficiency", "Angina", "Cardiac disease (other)", "Infection chronic NOS", "Intestinal disorder", "Pancreatitis", "Tuberculosis", "Flag for diabetes complications", "Flag for osteoporosis exclusions", "Flag for hypertension exclusions" ) } else { c("ID", "Congestive heart failure", "Cardiac arrhythmias", "Valvular disease", "Pulmonary circulation disorders", "Peripheral vascular disorders", "Hypertension, uncomplicated", "Hypertension, complicated", "Paralysis", "Other neurological disorders", "Chronic pulmonary disease", "Diabetes, uncomplicated", "Diabetes, complicated", "Hypothyroidism", "Renal failure", "Liver disease", "Peptic ulcer disease excluding bleeding", "AIDS/HIV", "Lymphoma", "Metastatic cancer", "Solid tumour without metastasis", "Rheumatoid artritis/collaged vascular disease", "Coagulopathy", "Obesity", "Weight loss", "Fluid and electrolyte disorders", "Blood loss anaemia", "Deficiency anaemia", "Alcohol abuse", "Drug abuse", "Psychoses", "Depression") } return(x) -} +} \ No newline at end of file diff --git a/R/score.R b/R/score.R index fc30299..9680a1f 100644 --- a/R/score.R +++ b/R/score.R @@ -1,6 +1,6 @@ #' @title Compute (weighted) comorbidity scores #' -#' @param x An object of class `comorbidty` returned by a call to the [comorbidity()] function. +#' @param x An object of class `comorbidity` returned by a call to the [comorbidity()] function. #' #' @param weights The weighting system to be used. #' This will depend on the mapping algorithm. @@ -10,6 +10,8 @@ #' Possible values for the Elixhauser score are: #' * `vw`, for the weights by van Walraven et al. (2009); #' * `swiss`, for the Swiss Elixhauser weights by Sharma et al. (2021). +#' Possible values for the M3 score are: +#' * `m3`, for the weights by Stanley and Sarfati (2017); #' #' Defaults to `NULL`, in which case an unweighted score will be used. #' @@ -22,11 +24,15 @@ #' * "Hypertension, uncomplicated" (`hypunc`) and "Hypertension, complicated" (`hypc`) for the Elixhauser score; #' * "Diabetes, uncomplicated" (`diabunc`) and "Diabetes, complicated" (`diabc`) for the Elixhauser score; #' * "Solid tumour" (`solidtum`) and "Metastatic cancer" (`metacanc`) for the Elixhauser score. +#' * "Diabetes" (`diab`) and "Diabetes with complications" (`diabwc`) for the M3 score; +#' * "Osteoporosis, uncomplicated" (`ostunc`) and "Hypertension, uncomplicated" (`hypunc`) for the M3 score; +#' * All cancers (`canc.+`) for the M3 score; #' #' @references Charlson ME, Pompei P, Ales KL, et al. _A new method of classifying prognostic comorbidity in longitudinal studies: development and validation_. Journal of Chronic Diseases 1987; 40:373-383. #' @references Quan H, Li B, Couris CM, et al. _Updating and validating the Charlson Comorbidity Index and Score for risk adjustment in hospital discharge abstracts using data from 6 countries_. American Journal of Epidemiology 2011; 173(6):676-682. #' @references van Walraven C, Austin PC, Jennings A, Quan H and Forster AJ. _A modification of the Elixhauser comorbidity measures into a point system for hospital death using administrative data_. Medical Care 2009; 47(6):626-633. #' @references Sharma N, Schwendimann R, Endrich O, et al. _Comparing Charlson and Elixhauser comorbidity indices with different weightings to predict in-hospital mortality: an analysis of national inpatient data_. BMC Health Services Research 2021; 21(13). +#' @references Stanley J, Sarfati D. (2017) _The new measuring multimorbidity index predicted mortality better than Charlson and Elixhauser indices among the general population_. Journal of Clinical Epidemiology 2017;92:99-110. DOI: 10.1016/j.jclinepi.2017.08.005 #' #' @return A numeric vector with the (weighted) comorbidity score for each subject from the input dataset. #' diff --git a/R/sysdata.rda b/R/sysdata.rda index c7bab13..19f241e 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/data-raw/make-mapping.R b/data-raw/make-mapping.R index 0f70b61..7559325 100644 --- a/data-raw/make-mapping.R +++ b/data-raw/make-mapping.R @@ -154,3 +154,70 @@ .maps[[.tmpn]][["drug"]] <- c("F11", "F12", "F13", "F14", "F15", "F16", "F18", "F19", "Z715", "Z722") .maps[[.tmpn]][["psycho"]] <- c("F20", "F22", "F23", "F24", "F25", "F28", "F29", "F302", "F312", "F315") .maps[[.tmpn]][["depre"]] <- c("F204", "F313", "F314", "F315", "F32", "F33", "F341", "F412", "F432") + +#m3 index, ICD10 +.tmpn <- "m3_icd10_am" +.maps[[.tmpn]][["aids"]] <- c("B20", "B21", "B22", "B23", "B24", "F024", "Z21") +.maps[[.tmpn]][["alcohol"]] <- c("F101", "F102", "F103", "F104", "F105", "F106", "F107", "F108", "F109", "Z502", "Z714") +.maps[[.tmpn]][["dane"]] <- c("D50", "D51", "D52", "D53") +.maps[[.tmpn]][["anxbd"]] <- c("F40", "F41", "F42", "F44", "F45", "F48", "F50", "F55", "F59", "F60", "F61", "F63", "F64", "F65", "F66", "F68", "F69") +.maps[[.tmpn]][["aneur"]] <- c("I71", "I72") +.maps[[.tmpn]][["bone"]] <- c("M80", "M830", "M831", "M832", "M833", "M834", "M835", "M838", "M839", "M85", "M863", "M864", "M865", "M866", "M88") +.maps[[.tmpn]][["bdi"]] <- c("K50", "K51", "K522", "K528", "K529") +.maps[[.tmpn]][["cancbreast"]] <- c("C50") +.maps[[.tmpn]][["carit"]] <- c("I441", "I442", "I443", "I456", "I459", "I47", "I48", "I49", "T821", "Z450", "Z950") +.maps[[.tmpn]][["valv"]] <- c("I05", "I06", "I07", "I08", "I091", "I098", "I34", "I35", "I36", "I37", "I38", "T820", "Q230", "Q231", "Q232", "Q233", "Q238", "Q239", "Z952", "Z953", "Z954") +.maps[[.tmpn]][["cevd"]] <- c("I60", "I61", "I62", "I63", "I64", "I65", "I66", "I67", "I69", "G45", "G46") +.maps[[.tmpn]][["copd"]] <- c("E84", "J40", "J41", "J42", "J43", "J44", "J45", "J46", "J47", "J60", "J61", "J62", "J63", "J64", "J65", "J66", "J67", "J684", "J701", "J703", "J84", "J961", "J980", "J982", "J983", "J984") +.maps[[.tmpn]][["rend"]] <- c("I120", "I129", "I131", "I139", "Q60", "Q611", "Q612", "Q613", "N032", "N033", "N034", "N035", "N036", "N037", "N038", "N039", "N042", "N043", "N044", "N045", "N046", "N047", "N048", "N049", "N052", "N053", "N054", "N055", "N056", "N057", "N058", "N059", "N11", "N18", "N19", "N250", "N258", "N259", "Z49", "Z940", "Z992") +.maps[[.tmpn]][["blood"]] <- c("D55", "D56", "D57", "D58", "D590", "D591", "D592", "D593", "D594", "D598", "D599", "D60", "D61", "D64", "D66", "D67", "D680", "D681", "D682", "D688", "D689", "D691", "D692", "D693", "D694", "D696", "D698", "D699", "D70", "D71", "D72", "D74", "D750", "D752", "D758", "D759") +.maps[[.tmpn]][["canccolrec"]] <- c("C18", "C19", "C20", "C21") +.maps[[.tmpn]][["chf"]] <- c("I099", "I110", "I130", "I132", "I255", "I420", "I425", "I426", "I427", "I428", "I429", "I43", "I50") +.maps[[.tmpn]][["conntiss"]] <- c("L93", "M05", "M06", "M08", "M120", "M123", "M30", "M31", "M32", "M33", "M34", "M350", "M351", "M352", "M353", "M354", "M355", "M356", "M358", "M359") +.maps[[.tmpn]][["dementia"]] <- c("F00", "F01", "F020", "F021", "F022", "F023", "F03", "F051", "G30", "G310", "G311") +.maps[[.tmpn]][["diabc"]] <- c("E102", "E103", "E104", "E105", "E106", "E107", "E108", "E112", "E113", "E114", "E115", "E116", "E117", "E118", "E122", "E123", "E124", "E125", "E126", "E127", "E128", "E132", "E133", "E134", "E135", "E136", "E137", "E138", "E142", "E143", "E144", "E145", "E146", "E147", "E148") +.maps[[.tmpn]][["diabunc"]] <- c("E100", "E101", "E109", "E110", "E111", "E119", "E120", "E121", "E129", "E130", "E131", "E139", "E140", "E141", "E149") +.maps[[.tmpn]][["drug"]] <- c("F11", "F12", "F13", "F14", "F15", "F16", "F18", "F19", "Z503", "Z715", "Z722") +.maps[[.tmpn]][["endo"]] <- c("E01", "E02", "E03", "E05", "E062", "E063", "E065", "E07", "E163", "E164", "E168", "E169", "E20", "E210", "E212", "E213", "E214", "E215", "E22", "E230", "E232", "E233", "E236", "E237", "E240", "E241", "E243", "E244", "E248", "E249", "E25", "E26", "E27", "E31", "E32", "E345", "E348", "E349") +.maps[[.tmpn]][["epi"]] <- c("G400", "G401", "G402", "G403", "G404", "G406", "G407", "G408", "G409", "G41") +.maps[[.tmpn]][["ceye"]] <- c("H16", "H181", "H184", "H185", "H186", "H201", "H212", "H301", "H311", "H312", "H313", "H314", "H330", "H332", "H333", "H334", "H335", "H34", "H35", "H43", "H46", "H47", "H49", "H50", "H51", "H530", "H531", "H532", "H533", "H534", "H536", "H538", "H539", "H54", "Q12", "Q13", "Q14", "Q15") +.maps[[.tmpn]][["cancgyn"]] <- c("C51", "C52", "C53", "C54", "C55", "C56", "C57", "C58") +.maps[[.tmpn]][["cvhep"]] <- c("B18", "B942", "Z225") +.maps[[.tmpn]][["hypunc"]] <- c("I10") +.maps[[.tmpn]][["immsys"]] <- c("D80", "D81", "D82", "D83", "D84", "D86", "D89") +.maps[[.tmpn]][["inear"]] <- c("H80", "H81", "H83", "H90", "H910", "H911", "H913", "H918", "H919", "H930", "H931", "H932", "H933") +.maps[[.tmpn]][["jsd"]] <- c("M07", "M13", "M150", "M151", "M152", "M154", "M158", "M159", "M400", "M402", "M403", "M404", "M405", "M41", "M42", "M43", "M45", "M460", "M461", "M462", "M47", "M480", "M481", "M482", "M485", "M488", "M489", "G950", "G951") +.maps[[.tmpn]][["msld"]] <- c("I85", "I864", "I982", "K70", "K711", "K713", "K714", "K715", "K717", "K721", "K729", "K73", "K74", "K760", "K762", "K763", "K764", "K765", "K766", "K767", "K768", "K769", "Z944") +.maps[[.tmpn]][["canclung"]] <- c("C33", "C34") +.maps[[.tmpn]][["canclymphleuk"]] <- c("C81", "C82", "C83", "C84", "C85", "C91", "C92", "C93", "C94", "C95", "C96") +.maps[[.tmpn]][["mpd"]] <- c("F20", "F22", "F25", "F28", "F29", "F302", "F31", "F321", "F322", "F323", "F328", "F329", "F33", "F39") +.maps[[.tmpn]][["cancmela"]] <- c("C43") +.maps[[.tmpn]][["maln"]] <- c("E40", "E41", "E42", "E43", "E44", "E45", "E46", "E50", "E51", "E52", "E53", "E54", "E55", "E56", "E58", "E59", "E60", "E61", "E63", "E64") +.maps[[.tmpn]][["bd"]] <- c("F04", "F06", "F070", "F071", "F078", "F079", "F09", "G931") +.maps[[.tmpn]][["mentret"]] <- c("F70", "F71", "F72", "F73", "F78", "F79", "F842", "F843", "F844", "E000", "E001", "E002", "E009", "Q90") +.maps[[.tmpn]][["metab"]] <- c("E70", "E71", "E72", "E74", "E75", "E76", "E77", "E78", "E791", "E798", "E799", "E80", "E83", "E85") +.maps[[.tmpn]][["metacanc"]] <- c("C77", "C78", "C79") +.maps[[.tmpn]][["mpnd"]] <- c("G60", "G61", "G620", "G621", "G622", "G628", "G629", "G64", "G70", "G71", "G720", "G721", "G722", "G723", "G724", "G728", "G729", "G731") +.maps[[.tmpn]][["ami"]] <- c("I21", "I22", "I23", "I241", "I252") +.maps[[.tmpn]][["obes"]] <- c("E66") +.maps[[.tmpn]][["osteounc"]] <- c("M810", "M811", "M815", "M818", "M819") +.maps[[.tmpn]][["cancoth"]] <- c("C0", "C10", "C11", "C12", "C13", "C14", "C26", "C30", "C31", "C32", "C37", "C38", "C39", "C40", "C41", "C45", "C46", "C47", "C48", "C49", "C60", "C62", "C63", "C64", "C65", "C66", "C67", "C68", "C69", "C70", "C71", "C72", "C73", "C74", "C75", "C76", "C88", "C90") +.maps[[.tmpn]][["ond"]] <- c("G10", "G110", "G111", "G112", "G113", "G118", "G119", "G12", "G13", "G20", "G21", "G23", "G255", "G312", "G318", "G319", "G35", "G36", "G37", "G90", "G934", "R470") +.maps[[.tmpn]][["para"]] <- c("G041", "G114", "G800", "G801", "G802", "G81", "G82", "G830", "G831", "G832", "G833", "G834", "G839") +.maps[[.tmpn]][["pud"]] <- c("K220", "K221", "K224", "K225", "K228", "K229", "K25", "K26", "K27", "K28", "K311", "K312", "K314", "K316") +.maps[[.tmpn]][["pvd"]] <- c("I70", "I731", "I738", "I739", "I74", "I771", "K551", "K552", "K558", "K559") +.maps[[.tmpn]][["cancprost"]] <- c("C61") +.maps[[.tmpn]][["pcd"]] <- c("I26", "I27", "I280", "I281", "I288", "I289") +.maps[[.tmpn]][["sleep"]] <- c("F51", "G470", "G471", "G472", "G473") +.maps[[.tmpn]][["cancuppergi"]] <- c("C15", "C16", "C17", "C22", "C23", "C24", "C25") +.maps[[.tmpn]][["utc"]] <- c("N301", "N302", "N31", "N32", "N35", "N36") +.maps[[.tmpn]][["ven"]] <- c("I830", "I832", "I872") +.maps[[.tmpn]][["ang"]] <- c("I20") +.maps[[.tmpn]][["cdnos"]] <- c("I119", "I248", "I249", "I250", "I251", "I253", "I254", "I256", "I258", "I259", "I310", "I311", "I421", "I422", "I424") +.maps[[.tmpn]][["cinfnos"]] <- c("A30", "A31", "A52", "B91", "B92", "B941", "B948", "B949") +.maps[[.tmpn]][["intest"]] <- c("K57", "K592", "K593", "K90") +.maps[[.tmpn]][["panc"]] <- c("K85", "K860", "K861", "K868") +.maps[[.tmpn]][["tub"]] <- c("A15", "A16", "A17", "A18", "A19", "B90") +.maps[[.tmpn]][["flag_comp_diab"]] <- c("I20", "I21", "I22", "I23", "I24", "I25", "I6", "I7", "N03", "N04", "N18", "G603", "G62", "G638", "H35", "H36", "L97") +.maps[[.tmpn]][["flag_exc_osteo"]] <- c("M80", "S220", "S320", "S52", "S720") +.maps[[.tmpn]][["flag_exc_hyp"]] <- c("I11", "I12", "I13", "I20", "I21", "I22", "I23", "I24", "I25", "I6", "I70", "I71", "I72", "N03", "N04", "N18") \ No newline at end of file diff --git a/data-raw/make-weights.R b/data-raw/make-weights.R index 017bc12..ddebc13 100644 --- a/data-raw/make-weights.R +++ b/data-raw/make-weights.R @@ -44,6 +44,76 @@ for (w in names(.maps)) { metacanc = 6, aids = 4 ) + } else if (grepl(pattern = "m3", x = w)) { + # m3 weights + .weights[[w]][["m3"]] <- c( + aids = 0.452647425, + alcohol = 0.576907507, + dane = 0.180927466, + anxbd = 0.121481351, + aneur = 0.260195993, + bone = 0.132827597, + bdi = 0.086960591, + cancbreast = 0.411891435, + carit = 0.173859876, + valv = 0.256577208, + cevd = 0.097803808, + copd = 0.6253395, + rend = 0.334155906, + blood = 0.265142145, + canccolrec = 0.372878764, + chf = 0.539809861, + conntiss = 0.290446442, + dementia = 1.021975368, + diabc = 0.271607393, + diabunc = 0.299383867, + drug = 0.558979499, + endo = 0.112673001, + epi = 0.594991823, + ceye = 0.179923774, + cancgyn = 0.70658858, + cvhep = 0.569092852, + hypunc = 0.117746303, + immsys = 0.398529751, + inear = 0.06090681, + jsd = 0.095585857, + msld = 0.474321939, + canclung = 1.972481401, + canclymphleuk = 1.190108503, + mpd = 0.212789563, + cancmela = 0.342233292, + maln = 0.331335106, + bd = 0.039711074, + mentret = 1.405761403, + metab = 0.006265195, + metacanc = 2.468586878, + mpnd = 0.208276284, + ami = 0.197491908, + obes = 0.248243722, + osteounc = 0.083506878, + cancoth = 1.103452294, + ond = 0.564391512, + para = 0.281895685, + pud = 0.152986438, + pvd = 0.349250005, + cancprost = 0.432343447, + pcd = 0.398432833, + sleep = 0.245749995, + cancuppergi = 1.941498638, + utc = 0.046548658, + ven = 0.214050369, + # Zero weighted comorbidities + ang = 0, #-0.082399267 + cdnos = 0, #-0.104225698 + cinfnos = 0, #-0.237983891 + intest = 0, #-0.254089697 + panc = 0, #-0.237983891 + tub = 0, #-0.104290289 + # Zero weight exclusion/complication flags + flag_comp_diab = 0, # Diabetes + flag_exc_osteo = 0, # Osteoporosis + flag_exc_hyp = 0 # Hypertension + ) } else { # Elixhauser-compatible weights: # van Walraven diff --git a/tests/testthat/test-comorbidity.R b/tests/testthat/test-comorbidity.R index b97b23e..f818ec4 100644 --- a/tests/testthat/test-comorbidity.R +++ b/tests/testthat/test-comorbidity.R @@ -137,6 +137,8 @@ test_that("comorbidity returns a data.frame", { expect_s3_class(cs, "data.frame") cs <- comorbidity(x = x9, id = "id", code = "code", map = "elixhauser_icd9_quan", assign0 = FALSE) expect_s3_class(cs, "data.frame") + cs <- comorbidity(x = x9, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + expect_s3_class(cs, "data.frame") }) test_that("comorbidity returns a data.frame with the correct number of rows", { @@ -166,6 +168,8 @@ test_that("if labelled = TRUE, comorbidity returns variable labels", { expect_false(is.null(attr(cs, "variable.labels"))) cs <- comorbidity(x = x, id = "id", code = "code", map = "elixhauser_icd10_quan", labelled = TRUE, assign0 = FALSE) expect_false(is.null(attr(cs, "variable.labels"))) + cs <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", labelled = TRUE, assign0 = FALSE) + expect_false(is.null(attr(cs, "variable.labels"))) }) test_that("if labelled = FALSE, comorbidity does not return variable labels", { @@ -178,6 +182,8 @@ test_that("if labelled = FALSE, comorbidity does not return variable labels", { expect_true(is.null(attr(cs, "variable.labels"))) cs <- comorbidity(x = x, id = "id", code = "code", map = "elixhauser_icd10_quan", labelled = FALSE, assign0 = FALSE) expect_true(is.null(attr(cs, "variable.labels"))) + cs <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", labelled = FALSE, assign0 = FALSE) + expect_true(is.null(attr(cs, "variable.labels"))) x9 <- data.frame( id = sample(1:5, size = 10 * 5, replace = TRUE), code = sample_diag(10 * 5, version = "ICD9_2015"), @@ -211,6 +217,8 @@ test_that("comorbidity domains are 0 or 1", { expect_true(object = all(elixhauser10 >= 0 & elixhauser10 <= 1)) charlson10 <- comorbidity(x = x, id = "id", code = "code", map = "charlson_icd10_quan", assign0 = FALSE)[, -1] expect_true(object = all(charlson10 >= 0 & charlson10 <= 1)) + m3_10 <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE)[, -1] + expect_true(object = all(m3_10 >= 0 & m3_10 <= 1)) x <- data.frame( id = sample(1:5, size = 50, replace = TRUE), code = sample_diag(50, version = "ICD9_2015"), @@ -241,6 +249,10 @@ test_that("duplicate codes are not counted twice (or more)", { ex2 <- comorbidity(x = x2, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) ex3 <- comorbidity(x = x3, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) ex4 <- comorbidity(x = x4, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) + mx <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + mx2 <- comorbidity(x = x2, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + mx3 <- comorbidity(x = x3, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + mx4 <- comorbidity(x = x4, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) expect_equal(object = cx, expected = cx2) expect_equal(object = cx, expected = cx3) expect_equal(object = cx, expected = cx4) @@ -261,6 +273,16 @@ test_that("duplicate codes are not counted twice (or more)", { expect_true(object = all(ex2[, -1] >= 0 & ex2[, -1] <= 1)) expect_true(object = all(ex3[, -1] >= 0 & ex3[, -1] <= 1)) expect_true(object = all(ex4[, -1] >= 0 & ex4[, -1] <= 1)) + expect_equal(object = mx, expected = mx2) + expect_equal(object = mx, expected = mx3) + expect_equal(object = mx, expected = mx4) + expect_equal(object = mx2, expected = mx3) + expect_equal(object = mx2, expected = mx4) + expect_equal(object = mx3, expected = mx4) + expect_true(object = all(mx[, -1] >= 0 & mx[, -1] <= 1)) + expect_true(object = all(mx2[, -1] >= 0 & mx2[, -1] <= 1)) + expect_true(object = all(mx3[, -1] >= 0 & mx3[, -1] <= 1)) + expect_true(object = all(mx4[, -1] >= 0 & mx4[, -1] <= 1)) } for (i in seq(20)) { @@ -318,6 +340,9 @@ test_that("input dataset with additional columns", { e <- comorbidity(x = x, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) e2 <- comorbidity(x = x2, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) expect_equal(object = e2, expected = e) + m <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + m2 <- comorbidity(x = x2, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + expect_equal(object = m2, expected = m) x <- data.frame( id = sample(1:20, size = 50, replace = TRUE), @@ -340,14 +365,18 @@ test_that("all comorbidities", { icd10_2011$id <- 1 c <- comorbidity(x = icd10_2011, id = "id", code = "Code", map = "charlson_icd10_quan", assign0 = FALSE) e <- comorbidity(x = icd10_2011, id = "id", code = "Code", map = "elixhauser_icd10_quan", assign0 = FALSE) + m <- comorbidity(x = icd10_2011, id = "id", code = "Code", map = "m3_icd10_am", assign0 = FALSE) expect_true(object = all(c[, -1] == 1)) expect_true(object = all(e[, -1] == 1)) + expect_true(object = all(m[, -1] == 1)) data("icd10_2009", package = "comorbidity") icd10_2009$id <- 1 c <- comorbidity(x = icd10_2009, id = "id", code = "Code", map = "charlson_icd10_quan", assign0 = FALSE) e <- comorbidity(x = icd10_2009, id = "id", code = "Code", map = "elixhauser_icd10_quan", assign0 = FALSE) + m <- comorbidity(x = icd10_2009, id = "id", code = "Code", map = "m3_icd10_am", assign0 = FALSE) expect_true(object = all(c[, -1] == 1)) expect_true(object = all(e[, -1] == 1)) + expect_true(object = all(m[, -1] == 1)) data("icd9_2015", package = "comorbidity") icd9_2015$id <- 1 c <- comorbidity(x = icd9_2015, id = "id", code = "Code", map = "charlson_icd9_quan", assign0 = FALSE) @@ -368,6 +397,9 @@ test_that("break output checks", { ex <- comorbidity(x = x, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE) ex[, -1] <- ex[, -1] + rnorm(n = nrow(ex)) expect_error(.check_output(x = ex, id = "id"), regexp = "unexpected state") + mx <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + mx[, -1] <- mx[, -1] + rnorm(n = nrow(mx)) + expect_error(.check_output(x = mx, id = "id"), regexp = "unexpected state") }) test_that("works ok with data.table", { diff --git a/tests/testthat/test-m3-icd10-am.R b/tests/testthat/test-m3-icd10-am.R new file mode 100644 index 0000000..75325d8 --- /dev/null +++ b/tests/testthat/test-m3-icd10-am.R @@ -0,0 +1,34 @@ +context("ICD-10-AM codes for the M3 score are properly identified") + +test_that("M3, ICD-10 codes", { + + this <- .maps[["m3_icd10_am"]] + for (i in seq_along(this)) { + cmb <- names(this)[i] + for (j in seq_along(this[[i]])) { + # For debugging: cat(this[[i]][j], "\n") + x <- data.frame(id = 1, code = this[[i]][j]) + test <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE) + + if (x$code %in% c("I20", "I20", "I20", "I21", "I21", "I21", "I22", "I22", "I22", + "I23", "I23", "I23", "I241", "I248", "I249", "I250", "I251", + "I252", "I253", "I254", "I255", "I256", "I258", "I259", "I60", + "I61", "I62", "I63", "I64", "I65", "I66", "I67", "I69", "I70", + "I70", "I71", "I71", "I72", "I72", "N032", "N033", "N034", "N035", + "N036", "N037", "N038", "N039", "N042", "N043", "N044", "N045", + "N046", "N047", "N048", "N049", "N18", "N18", "N18")) { + # These codes here overlap three different domains + expect_equal(object = sum(test[, -1]), expected = 3) + } else if (x$code %in% c("G603", "G620", "G621", "G622", "G628", "G629", "H35", "H35", + "I110", "I119", "I120", "I129", "I130", "I131", "I132", "I139", + "I24", "I24", "I25", "I25", "I6", "I6", "I731", "I738", "I739", + "I74", "I771", "M80", "M80", "N03", "N03", "N04", "N04")) { + # These codes here overlap two different domains + expect_equal(object = sum(test[, -1]), expected = 2) + } else { + expect_equal(object = sum(test[, -1]), expected = 1) + } + + } + } +}) diff --git a/tests/testthat/test-nrow.R b/tests/testthat/test-nrow.R index ff22e8e..7800535 100644 --- a/tests/testthat/test-nrow.R +++ b/tests/testthat/test-nrow.R @@ -18,5 +18,7 @@ test_that("'comorbidity' returns a df with the proper (expected) number of rows expect_equal(object = nrow(res), expected = n) res <- comorbidity(x = x, id = "id", code = "code", map = "elixhauser_icd10_quan", assign0 = FALSE, tidy.codes = TRUE) expect_equal(object = nrow(res), expected = n) + res <- comorbidity(x = x, id = "id", code = "code", map = "m3_icd10_am", assign0 = FALSE, tidy.codes = TRUE) + expect_equal(object = nrow(res), expected = n) } })