fixing issue 211

OHDSI · Sep 20, 2024 · cdf8f48 · cdf8f48
1 parent 1c2d516
commit cdf8f48
Show file tree

Hide file tree

Showing 3 changed files with 42 additions and 14 deletions.
diff --git a/R/cohort-diagnostics-characterization.R b/R/cohort-diagnostics-characterization.R
@@ -862,6 +862,8 @@ cohortDiagCharacterizationModule <- function(
       params$time_id <- ""
       params$use_database_id <- TRUE
       params$database_table <- dataSource$databaseTable
+      params$database_table_prefix <- dataSource$databaseTablePrefix
+      params$database_name <- ifelse(tolower(dataSource$databaseTable) == 'database_meta_data', 'cdm_source_name', 'database_name')
       return(params)
     })
 
@@ -1054,11 +1056,11 @@ cohortDiagCharacterizationModule <- function(
           FROM @results_database_schema.@table_prefixtemporal_covariate_ref tcr
           INNER JOIN @results_database_schema.@table_prefixtemporal_analysis_ref tar ON tar.analysis_id = tcr.analysis_id
           INNER JOIN @results_database_schema.@table_prefixtemporal_covariate_value tcv ON tcr.covariate_id = tcv.covariate_id
-          INNER JOIN @results_database_schema.@database_table db ON db.database_id = tcv.database_id
+          INNER JOIN @results_database_schema.@database_table_prefix@database_table db ON db.database_id = tcv.database_id
           WHERE tcr.covariate_id IS NOT NULL
         "
 
-        selectSt <- "db.database_name,
+        selectSt <- "db.@database_name as database_name,
             tcr.covariate_name,
             tar.analysis_name,
             is_binary,
@@ -1076,13 +1078,21 @@ cohortDiagCharacterizationModule <- function(
         # Select casees for each db
         for (i in 1:length(timeIds)) {
           timeId <- timeIds[i]
-          tplSql <- c(tplSql, SqlRender::render(selectTemplate, i = i, time_id = timeId))
-          havingSql <- c(havingSql, SqlRender::render(havingTemplate, time_id = timeId))
+          tplSql <- c(tplSql, SqlRender::render(
+            sql = selectTemplate, 
+            i = i, 
+            time_id = timeId)
+            )
+          havingSql <- c(havingSql, SqlRender::render(
+            sql = havingTemplate, 
+            time_id = timeId
+            )
+            )
         }
 
         tplSql <- paste(tplSql, collapse = ", \n")
         groupClause <- SqlRender::render("
-        GROUP BY db.database_name, tcr.covariate_name, tar.analysis_name, tcr.concept_id, is_binary
+        GROUP BY db.@database_name, tcr.covariate_name, tar.analysis_name, tcr.concept_id, is_binary
         HAVING @having_clasuse
         ", having_clasuse = paste(havingSql, collapse = " OR\n"))
 

diff --git a/R/cohort-diagnostics-databaseInformation.R b/R/cohort-diagnostics-databaseInformation.R
@@ -212,7 +212,7 @@ getExecutionMetadata <- function(dataSource, databaseId) {
 
 
 getDatabaseMetadata <- function(dataSource, databaseTable) {
-  data <- loadResultsTable(dataSource, "metadata", required = TRUE, cdTablePrefix = dataSource$cdTablePrefix)
+  data <- loadResultsTable(dataSource, "metadata", required = TRUE, cdTablePrefix = dataSource$cdTablePrefix, databaseTablePrefix = dataSource$databaseTablePrefix)
   data <- data %>%
     tidyr::pivot_wider(
       id_cols = c("startTime", "databaseId"),

diff --git a/R/cohort-diagnostics-main.R b/R/cohort-diagnostics-main.R
@@ -35,8 +35,8 @@
 
 # NOTE: here it would be nice to use dbplyr tables - this would allow lazy loading of resources
 # however, renaming the columns causes an error and its not obvious how it could be resolved
-loadResultsTable <- function(dataSource, tableName, required = FALSE, cdTablePrefix = "") {
-  selectTableName <- paste0(cdTablePrefix, tableName)
+loadResultsTable <- function(dataSource, tableName, required = FALSE, cdTablePrefix = "", databaseTablePrefix = "") {
+  selectTableName <- paste0(ifelse(!tolower(tableName) == 'database_meta_data', cdTablePrefix,databaseTablePrefix), tableName)
   resultsTablesOnServer <-
     tolower(.availableTables(dataSource$connectionHandler, dataSource$schema))
 
@@ -47,9 +47,20 @@ loadResultsTable <- function(dataSource, tableName, required = FALSE, cdTablePre
 
     tryCatch(
       {
-        table <- dataSource$connectionHandler$queryDb("SELECT * FROM @schema.@table",
-                                                      schema = dataSource$schema,
-                                                      table = selectTableName)
+
+        if(tolower(tableName) == 'database_meta_data'){
+          table <- dataSource$connectionHandler$queryDb(
+            "SELECT *, cdm_source_name as database_name FROM @schema.@table",
+            schema = dataSource$schema,
+            table = selectTableName
+          )
+        } else{
+          table <- dataSource$connectionHandler$queryDb(
+            "SELECT * FROM @schema.@table",
+            schema = dataSource$schema,
+            table = selectTableName
+          )
+        }
       },
       error = function(err) {
         stop(
@@ -224,7 +235,13 @@ createCdDatabaseDataSource <- function(
     dbms = connectionHandler$dbms(),
     resultsTablesOnServer = .availableTables(connectionHandler, resultDatabaseSettings$schema),
     cdTablePrefix = resultDatabaseSettings$cdTablePrefix,
-    prefixTable = function(tableName) { paste0(resultDatabaseSettings$cdTablePrefix, tableName) },
+    prefixTable = function(tableName) {
+      if(tableName != resultDatabaseSettings$databaseTable){
+        return(paste0(resultDatabaseSettings$cdTablePrefix, tableName))
+      } else{
+        return(paste0(resultDatabaseSettings$databaseTablePrefix, tableName))
+      }
+      },
     prefixVocabTable = function(tableName) {
       # don't prexfix table if we us a dedicated vocabulary schema
       if (resultDatabaseSettings$vocabularyDatabaseSchema == resultDatabaseSettings$schema)
@@ -235,8 +252,8 @@ createCdDatabaseDataSource <- function(
     cgTable = resultDatabaseSettings$cgTable,
     cgTablePrefix = resultDatabaseSettings$cgTablePrefix,
     useCgTable = FALSE,
-    databaseTable = "database",
-    databaseTablePrefix = "cd_",
+    databaseTable = resultDatabaseSettings$databaseTable,#"database",
+    databaseTablePrefix = resultDatabaseSettings$databaseTablePrefix,#"cd_",
     dataModelSpecifications = modelSpec
   )
 
@@ -317,6 +334,7 @@ createCdDatabaseDataSource <- function(
 
 getDatabaseTable <- function(dataSource) {
   databaseTable <- loadResultsTable(dataSource, dataSource$prefixTable(dataSource$databaseTable), required = TRUE)
+
   if (nrow(databaseTable) > 0 &
       "vocabularyVersion" %in% colnames(databaseTable)) {
     databaseTable <- databaseTable %>%