updates for new cdmconnector

darwin-eu · Feb 2, 2024 · 19b0c28 · 19b0c28
1 parent 52e59d9
commit 19b0c28
Show file tree

Hide file tree

Showing 4 changed files with 59 additions and 54 deletions.
diff --git a/R/findOrphanCodes.R b/R/findOrphanCodes.R
@@ -56,6 +56,35 @@ findOrphanCodes <- function(x,
                             includeAncestor = TRUE,
                             minCellCount = 5){
 
+  errorMessage <- checkmate::makeAssertCollection()
+  checkDbType(cdm = cdm, type = "cdm_reference", messageStore = errorMessage)
+  checkmate::assertVector(domains, add = errorMessage)
+  checkmate::assertVector(standardConcept, add = errorMessage)
+  standardConceptCheck <- all(tolower(standardConcept) %in%
+                                c(
+                                  "standard",
+                                  "classification",
+                                  "non-standard"
+                                ))
+  if (!isTRUE(standardConceptCheck)) {
+    errorMessage$push(
+      "- standardConcept must be from Standard, Non-standard, or Classification"
+    )
+  }
+  checkmate::assertTRUE(standardConceptCheck, add = errorMessage)
+  checkmate::assert_logical(searchInSynonyms, add = errorMessage)
+  checkmate::assert_logical(searchNonStandard, add = errorMessage)
+  checkmate::assert_logical(includeDescendants, add = errorMessage)
+  checkmate::assert_logical(includeAncestor, add = errorMessage)
+  checkmate::assert_numeric(minCellCount, len = 1,
+                            add = errorMessage)
+  checkmate::reportAssertions(collection = errorMessage)
+
+  checkmate::assertList(x)
+  if(length(names(x)) != length(x)){
+    cli::cli_abort("Must be a named list")
+  }
+
 
 x <- addDetails(cdm = cdm, conceptList = x)
 

diff --git a/R/runSearch.R b/R/runSearch.R
@@ -55,14 +55,6 @@ runSearch <- function(keywords,
       )
     )
 
-  if(!is.null(attr(cdm, "dbcon"))){
-    conceptDb <- conceptDb %>%
-    CDMConnector::computeQuery(name = paste0("cg_",prefix, "_1"),
-                                temporary = FALSE,
-                                schema = attr(cdm, "write_schema"),
-                                overwrite = TRUE)
-  }
-
   cli::cli_inform("{domains} domain: Limiting to domains of interest")
   concept <- conceptDb %>%
     dplyr::filter(.data$standard_concept %in% .env$standardConceptFlags,
@@ -76,13 +68,6 @@ runSearch <- function(keywords,
         dplyr::select("concept_id", "domain_id", "standard_concept"),
       by = "concept_id"
     )
-  if(!is.null(attr(cdm, "dbcon"))){
-  conceptSynonymDb <- conceptSynonymDb %>%
-    CDMConnector::computeQuery(name = paste0("cg_",prefix, "_2"),
-                               temporary = FALSE,
-                               schema = attr(cdm, "write_schema"),
-                               overwrite = TRUE)
-  }
 
   conceptSynonymDb <- conceptSynonymDb %>%
     dplyr::filter(.data$domain_id %in% .env$domains &
@@ -208,10 +193,6 @@ runSearch <- function(keywords,
 
   candidateCodesList[[domains]] <- candidateCodes
 
-  # candidateCodes <- dplyr::bind_rows(candidateCodes %>%
-  #                                      dplyr::collect()) %>%
-  #   dplyr::distinct()
-
 
   # 5) add any codes lower in the hierarchy
   if (includeDescendants == TRUE) {

diff --git a/tests/testthat/test-dbms.R b/tests/testthat/test-dbms.R
@@ -23,29 +23,29 @@ test_that("achilles code use", {
     dplyr::mutate(stratum_2 = NA,
                   stratum_3 = NA,
                   analysis_id = 401) %>%
-    CDMConnector::computeQuery()
+    dplyr::compute()
 
   asthma <- list(asthma = c(317009, 257581))
   result_achilles <- achillesCodeUse(asthma,
                                      cdm = cdm)
   result_cdm <- summariseCodeUse(asthma, cdm = cdm)
 
-  expect_equal(result_achilles %>%
-                 dplyr::filter(standard_concept_id == 317009,
-                               group_name == "By concept",
+  expect_equal(as.numeric(result_achilles %>%
+                 dplyr::filter(group_level == "standard concept: Asthma (317009)",
+                               group_name == "by_concept",
                                variable_name == "Record count") %>%
-                 dplyr::pull("estimate"),
+                 dplyr::pull("estimate_value")),
                result_cdm %>%
                  dplyr::filter(standard_concept_id == 317009,
                                group_name == "By concept",
                                variable_name == "Record count") %>%
                  dplyr::pull("estimate"))
 
-  expect_equal(result_achilles %>%
-                 dplyr::filter(standard_concept_id == 257581,
-                               group_name == "By concept",
+  expect_equal(as.numeric(result_achilles %>%
+                 dplyr::filter(group_level == "standard concept: Exacerbation of asthma (257581)",
+                               group_name == "by_concept",
                                variable_name == "Record count") %>%
-                 dplyr::pull("estimate"),
+                 dplyr::pull("estimate_value")),
                result_cdm %>%
                  dplyr::filter(standard_concept_id == 257581,
                                group_name == "By concept",
@@ -71,22 +71,22 @@ test_that("achilles code use", {
   result_cdm <- summariseCodeUse(asthma, cdm = cdm)
 
 
-  expect_equal(result_achilles %>%
-                 dplyr::filter(standard_concept_id == 317009,
-                               group_name == "By concept",
+  expect_equal(as.numeric(result_achilles %>%
+                 dplyr::filter(group_level == "standard concept: Asthma (317009)",
+                               group_name == "by_concept",
                                variable_name == "Person count") %>%
-                 dplyr::pull("estimate"),
+                 dplyr::pull("estimate_value")),
                result_cdm %>%
                  dplyr::filter(standard_concept_id == 317009,
                                group_name == "By concept",
                                variable_name == "Person count") %>%
                  dplyr::pull("estimate"))
 
-  expect_equal(result_achilles %>%
-                 dplyr::filter(standard_concept_id == 257581,
-                               group_name == "By concept",
-                               variable_name == "Person count") %>%
-                 dplyr::pull("estimate"),
+  expect_equal(as.numeric(result_achilles %>%
+                            dplyr::filter(group_level == "standard concept: Exacerbation of asthma (257581)",
+                                          group_name == "by_concept",
+                                          variable_name == "Person count") %>%
+                            dplyr::pull("estimate_value")),
                result_cdm %>%
                  dplyr::filter(standard_concept_id == 257581,
                                group_name == "By concept",

diff --git a/tests/testthat/test-synthea_sql_server.R b/tests/testthat/test-synthea_sql_server.R
@@ -1,26 +1,21 @@
 test_that("test with synthea on sql server", {
   skip_if(Sys.getenv("darwinDbDatabaseServer") == "")
 
-  db <- DBI::dbConnect(odbc::odbc(),
-    Driver   = "ODBC Driver 11 for SQL Server",
-    Server   = Sys.getenv("darwinDbDatabaseServer"),
-    Database = Sys.getenv("darwinDbDatabase"),
-    UID      = Sys.getenv("darwinDbUser"),
-    PWD      = Sys.getenv("darwinDbPassword"),
-    Port     = Sys.getenv("darwinDbDatabasePort")
-  )
+  db <-DBI::dbConnect(odbc::odbc(),
+                      Driver   = Sys.getenv("SQL_SERVER_DRIVER"),
+                      # Driver   = "ODBC Driver 17 for SQL Server", #asdf
+                      Server   = Sys.getenv("CDM5_SQL_SERVER_SERVER"),
+                      Database = Sys.getenv("CDM5_SQL_SERVER_CDM_DATABASE"),
+                      UID      = Sys.getenv("CDM5_SQL_SERVER_USER"),
+                      PWD      = Sys.getenv("CDM5_SQL_SERVER_PASSWORD"),
+                      TrustServerCertificate="yes",
+                      Port     = Sys.getenv("CDM5_SQL_SERVER_PORT"))
 
   cdm <- CDMConnector::cdm_from_con(
     con = db,
-    cdm_schema = "cdm_synthea_100k",
-    cdm_tables = tidyselect::all_of(c(
-      "concept",
-      "concept_relationship",
-      "concept_ancestor",
-      "concept_synonym",
-      "vocabulary"
-    ))
-  )
+    cdm_schema = strsplit(Sys.getenv("CDM5_SQL_SERVER_CDM_SCHEMA"), "\\.")[[1]],
+    write_schema =  strsplit(Sys.getenv("CDM5_SQL_SERVER_SCRATCH_SCHEMA"), "\\.")[[1]])
+
   vocabVersion <- getVocabVersion(cdm = cdm)
   expect_true(length(vocabVersion) == 1)
   expect_true(is.character(vocabVersion))