From eaa1c45d13159f0d5c79932b55e1696ac30e6d58 Mon Sep 17 00:00:00 2001 From: edward-burn <9583964+edward-burn@users.noreply.github.com> Date: Thu, 11 Jul 2024 16:55:33 +0100 Subject: [PATCH] 3.1.0 --- DESCRIPTION | 2 +- R/stratifyByDoseUnit.R | 11 ++++++++--- R/stratifyByRoute.R | 12 ++++++++++-- R/summariseOrphanCodes.R | 5 +++-- man/summariseOrphanCodes.Rd | 6 ++++-- tests/testthat/test-dbms.R | 6 ++++++ tests/testthat/test-stratifyByDoseUnit.R | 9 +++++++++ tests/testthat/test-stratifyByRouteCategory.R | 11 +++++++++++ 8 files changed, 52 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7661175..5f9cca7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: CodelistGenerator Title: Identify Relevant Clinical Codes and Evaluate Their Use -Version: 3.0.0.900 +Version: 3.1.0 Authors@R: c( person("Edward", "Burn", email = "edward.burn@ndorms.ox.ac.uk", role = c("aut", "cre"), diff --git a/R/stratifyByDoseUnit.R b/R/stratifyByDoseUnit.R index cfcaba3..04deddf 100644 --- a/R/stratifyByDoseUnit.R +++ b/R/stratifyByDoseUnit.R @@ -69,10 +69,12 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){ workingName <- names(x)[i] workingCodesWithDoseUnit <- cdm[[tableCodelist]] |> + dplyr::left_join(cdm$concept, + by = "concept_id")|> dplyr::left_join(drugStrengthNamed, by = c("concept_id" = "drug_concept_id") ) |> - dplyr::select("concept_id", + dplyr::select("concept_id", "domain_id", "amount_concept_name", "numerator_concept_name") |> dplyr::distinct() |> @@ -83,9 +85,10 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){ unit_group = dplyr::case_when( !is.na(.data$amount_concept_name) ~ omopgenerics::toSnakeCase(.data$amount_concept_name), !is.na(.data$numerator_concept_name) ~ omopgenerics::toSnakeCase(.data$numerator_concept_name), - .default = "unkown_dose_unit" + tolower(.data$domain_id) == "drug" ~ "unkown_dose_unit" ) - ) + ) |> + dplyr::filter(!is.na(.data$unit_group)) if(isTRUE(withDetails)){ workingCodesWithDoseUnit <- x_original[[i]] |> @@ -98,8 +101,10 @@ stratifyByDoseUnit <- function(x, cdm, keepOriginal = FALSE){ workingCodesWithDoseUnit[, c("unit_group")] ) + if(length(workingCodesWithDoseUnit)>0){ names(workingCodesWithDoseUnit) <- paste0(workingName, "_", names(workingCodesWithDoseUnit)) + } if(isFALSE(withDetails)){ for(j in seq_along(workingCodesWithDoseUnit)){ diff --git a/R/stratifyByRoute.R b/R/stratifyByRoute.R index 0d6feee..9980345 100644 --- a/R/stratifyByRoute.R +++ b/R/stratifyByRoute.R @@ -32,6 +32,7 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){ withDetails <- TRUE x <- codelistFromCodelistWithDetails(x) } else { + omopgenerics::newCodelist(x) withDetails <- FALSE } @@ -59,23 +60,28 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){ workingName <- names(x)[i] workingCodesWithRoute <- cdm[[tableCodelist]] |> + dplyr::left_join(cdm$concept |> + dplyr::select("concept_id", "domain_id"), + by = "concept_id") |> dplyr::left_join(cdm$concept_relationship |> dplyr::filter(.data$relationship_id == "RxNorm has dose form"), by = c("concept_id" = "concept_id_1") ) |> dplyr::select("concept_id", - "concept_id_2") |> + "concept_id_2", + "domain_id") |> dplyr::collect() |> dplyr::left_join( doseRouteData, by = c("concept_id_2" = "dose_form_concept_id") ) |> dplyr::mutate(route_category = dplyr::if_else( - is.na(.data$route_category), + is.na(.data$route_category) & (tolower(.data$domain_id) == "drug"), "unclassified_route", .data$route_category )) |> dplyr::select("concept_id", "route_category") |> dplyr::distinct() |> + dplyr::filter(!is.na(.data$route_category)) |> dplyr::collect() if(isTRUE(withDetails)){ @@ -89,8 +95,10 @@ stratifyByRouteCategory <- function(x, cdm, keepOriginal = FALSE){ workingCodesWithRoute[, c("route_category")] ) + if(length(workingCodesWithRoute) > 0){ names(workingCodesWithRoute) <- paste0(workingName, "_", names(workingCodesWithRoute)) + } if(isFALSE(withDetails)){ for(j in seq_along(workingCodesWithRoute)){ diff --git a/R/summariseOrphanCodes.R b/R/summariseOrphanCodes.R index e874057..ea4b8f8 100644 --- a/R/summariseOrphanCodes.R +++ b/R/summariseOrphanCodes.R @@ -1,4 +1,5 @@ -#' Find orphan codes related to a codelist +#' Find orphan codes related to a codelist using achilles counts and, if +#' available, PHOEBE concept recommendations #' #' @param x A codelist for which to find related codes used in the database #' @param cdm cdm_reference via CDMConnector @@ -68,7 +69,7 @@ summariseOrphanCodes <- function(x, } else { phoebe <- FALSE cli::cli_inform(c("PHOEBE results not available", - "i" = "The concept_recommened table is not present in the cdm.")) + "i" = "The concept_recommended table is not present in the cdm.")) } orphanCodes <- list() diff --git a/man/summariseOrphanCodes.Rd b/man/summariseOrphanCodes.Rd index 75d3ba4..eaa6b48 100644 --- a/man/summariseOrphanCodes.Rd +++ b/man/summariseOrphanCodes.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/summariseOrphanCodes.R \name{summariseOrphanCodes} \alias{summariseOrphanCodes} -\title{Find orphan codes related to a codelist} +\title{Find orphan codes related to a codelist using achilles counts and, if +available, PHOEBE concept recommendations} \usage{ summariseOrphanCodes( x, @@ -24,7 +25,8 @@ A summarised result containg the frequency of codes related to (but not in) the codelist } \description{ -Find orphan codes related to a codelist +Find orphan codes related to a codelist using achilles counts and, if +available, PHOEBE concept recommendations } \examples{ \dontrun{ diff --git a/tests/testthat/test-dbms.R b/tests/testthat/test-dbms.R index aaec40c..1df9713 100644 --- a/tests/testthat/test-dbms.R +++ b/tests/testthat/test-dbms.R @@ -324,6 +324,12 @@ test_that("postgres", { codes <- getDrugIngredientCodes(cdm, "metformin") codes[["asthma"]] <- 317009 + expect_no_error(stratifyByDoseUnit(codes, cdm)) + expect_no_error(stratifyByDoseUnit(codes, cdm, keepOriginal = TRUE)) + expect_no_error(stratifyByRouteCategory(codes, cdm)) + expect_no_error(stratifyByRouteCategory(codes, cdm, keepOriginal = TRUE)) + + drug_codes <- getDrugIngredientCodes(cdm, name = c("metformin", "diclofenac")) diff --git a/tests/testthat/test-stratifyByDoseUnit.R b/tests/testthat/test-stratifyByDoseUnit.R index 5cc1486..b23d489 100644 --- a/tests/testthat/test-stratifyByDoseUnit.R +++ b/tests/testthat/test-stratifyByDoseUnit.R @@ -5,6 +5,15 @@ test_that("stratifyByDoseUnit in mock", { # no dose units in the mock expect_no_error(stratifyByDoseUnit(x = ing, cdm = cdm)) + # if concepts are not from the drug domain we should get empty codelist back + oa <- getCandidateCodes(cdm = cdm, "osteoarthritis") + oa_str <- stratifyByDoseUnit(list(oa = oa$concept_id), + cdm, keepOriginal = FALSE) + expect_true(length(oa_str)==0) + + oa_str <- stratifyByDoseUnit(omopgenerics::newCodelistWithDetails(list(oa = oa)), + cdm, keepOriginal = FALSE) + expect_true(length(oa_str)==0) # expected errors expect_error(stratifyByDoseUnit(x = ing, cdm = "a")) diff --git a/tests/testthat/test-stratifyByRouteCategory.R b/tests/testthat/test-stratifyByRouteCategory.R index a674898..3816cb6 100644 --- a/tests/testthat/test-stratifyByRouteCategory.R +++ b/tests/testthat/test-stratifyByRouteCategory.R @@ -15,6 +15,17 @@ test_that("stratify by route works", { keepOriginal = TRUE) expect_true(length(ing_codes_str_all) == 4) + + # if concepts are not from the drug domain we should get empty codelist back + oa <- getCandidateCodes(cdm = cdm, "osteoarthritis") + oa_str <- stratifyByRouteCategory(list(oa = oa$concept_id), + cdm, keepOriginal = FALSE) + expect_true(length(oa_str)==0) + + oa_str <- stratifyByRouteCategory(omopgenerics::newCodelistWithDetails(list(oa = oa)), + cdm, keepOriginal = FALSE) + expect_true(length(oa_str)==0) + # expected errors expect_error(stratifyByRouteCategory("a", cdm)) expect_error(stratifyByRouteCategory(ing_codes, "a"))