Release v0.0.4

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: Strategus
 Type: Package
 Title: Coordinating and Executing Analytics Using HADES Modules
-Version: 0.0.3
-Date: 2023-03-10
+Version: 0.0.4
+Date: 2023-03-29
 Authors@R: c(
  person("Martijn", "Schuemie", email = "schuemie@ohdsi.org", role = c("aut", "cre")),
  person("Anthony", "Sena", email = "sena@ohdsi.org", role = c("aut")),
@@ -32,11 +32,12 @@ Imports:
  tibble,
  SqlRender (>= 1.11.0)
 Suggests:
- testthat (>= 3.0.0),
- fs,
- knitr,
- rmarkdown,
- Eunomia
+ testthat (>= 3.0.0),
+ fs,
+ knitr,
+ rmarkdown,
+ Eunomia,
+ withr
 Remotes:
  ohdsi/CohortGenerator,
  ohdsi/Eunomia

NEWS.md

@@ -1,3 +1,10 @@
+Strategus 0.0.4
+===============
+
+- Add DB Platform Tests (#53)
+- Add error handling for missing/empty tables (#54)
+- Remove uniqueness check for module table prefix (#55)
+
 Strategus 0.0.3
 ===============
 

R/DatabaseMetaData.R

@@ -34,6 +34,21 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
  connection <- DatabaseConnector::connect(connectionDetails)
  on.exit(DatabaseConnector::disconnect(connection))
 
+ # Verify the CDM tables required by this function exist prior to
+ # querying. Then we can stop the processing and provide an informative
+ # message to the user.
+ requiredTables <- c("cdm_source", "vocabulary", "observation_period")
+ cdmTableList <- DatabaseConnector::getTableNames(
+ connection = connection,
+ databaseSchema = executionSettings$cdmDatabaseSchema
+ )
+
+
+ if (!length(cdmTableList[which(x = cdmTableList %in% requiredTables)]) == length(requiredTables)) {
+ missingCdmTables <- requiredTables[!(requiredTables %in% cdmTableList)]
+ stop(sprintf("FATAL ERROR: Your OMOP CDM is missing the following required tables: %s", paste(missingCdmTables, collapse = ", ")))
+ }
+
  resultsDataModel <- CohortGenerator::readCsv(
  file = system.file("databaseMetaDataRdms.csv", package = "Strategus"),
  warnOnCaseMismatch = FALSE
@@ -47,6 +62,11 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
  cdm_database_schema = executionSettings$cdmDatabaseSchema
  )
 
+ # Verify that the cdmSource table has information
+ if (nrow(cdmSource) == 0) {
+ stop("FATAL ERROR: The CDM_SOURCE table in your OMOP CDM is empty. Please populate this table with information about your CDM and organization. For more information, please see: https://ohdsi.github.io/CommonDataModel/cdm53.html#CDM_SOURCE")
+ }
+
  # Restrict the cdmSource columns to those that are
  # expected in the resultsDataModel
  cdmSource <- cdmSource[, which(names(cdmSource) %in% SqlRender::snakeCaseToCamelCase(resultsDataModel$columnName))]
@@ -67,6 +87,12 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
  cdm_database_schema = executionSettings$cdmDatabaseSchema
  )
 
+ # Verify that the vocabulary_version is found
+ if (nrow(vocabVersion) == 0) {
+ stop("FATAL ERROR: The VOCABULARY table in your OMOP CDM is missing the version. Please verify that your process for loading the vocabulary included an entry in the vocabulary table with vocabulary_id == 'None'")
+ }
+
+
  sql <- "SELECT MAX(observation_period_end_date) as max_obs_period_end_date
  FROM @cdm_database_schema.observation_period;"
  observationPeriodMax <- renderTranslateQuerySql(
@@ -76,6 +102,11 @@ createDatabaseMetaData <- function(executionSettings, keyringName = NULL) {
  cdm_database_schema = executionSettings$cdmDatabaseSchema
  )
 
+ # Verify that the MAX(observation_period_end_date) is a valid date
+ if (is.na(observationPeriodMax$maxObsPeriodEndDate)) {
+ stop("FATAL ERROR: The OBSERVATION_PERIOD table in your OMOP CDM lacks a maximum observation_period_end_date. This may be a result of an error in the ETL as each person in the OMOP CDM must have an observation period with a valid start and end date.")
+ }
+
  databaseId <- digest::digest2int(paste(cdmSource$cdmSourceName, cdmSource$cdmReleaseDate))
  database <- cdmSource %>%
  mutate(

R/ModuleInstantiation.R

@@ -73,29 +73,6 @@ ensureAllModulesInstantiated <- function(analysisSpecifications) {
  stop(message)
  }
 
- # Check for colliding result table prefixes
- moduleTablePrefixes <- getModuleTablePrefixes(moduleList = modules)
- if (nrow(moduleTablePrefixes) != length(unique(moduleTablePrefixes$tablePrefix))) {
- moduleTablePrefixesInConflict <- moduleTablePrefixes %>%
- group_by(.data$tablePrefix) %>%
- summarise(totalCount = n()) %>%
- filter(.data$totalCount > 1)
-
- message <- paste(
- c(
- "Detected colliding result table prefixes:",
- sprintf(
- "- Module '%s' (v'%s') table prefix: '%s'",
- moduleTablePrefixesInConflict$moduleName,
- moduleTablePrefixesInConflict$moduleVersion,
- moduleTablePrefixesInConflict$tablePrefix
- )
- ),
- collapse = "\n"
- )
- stop(message)
- }
-
  return(modules)
 }