Reference to issue #210

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: OhdsiShinyModules
 Type: Package
 Title: Repository of Shiny Modules for OHDSI Result Viewers
-Version: 2.1.2
+Version: 2.1.4
 Author: Jenna Reps
 Maintainer: Jenna Reps <[email protected]>
 Description: Install this package to access useful shiny modules for building shiny apps to explore results using the OHDSI tools .
@@ -56,4 +56,4 @@ Suggests:
 Remotes:
     ohdsi/CirceR,
     ohdsi/ResultModelManager
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NEWS.md

@@ -1,3 +1,12 @@
+OhdsiShinyModules v2.1.4
+========================
+Fixed missing call to dplyr in CohortDiagnostics load up
+
+OhdsiShinyModules v2.1.3
+========================
+Hotfix release to fix issue with cohort diagnostics reports hanging on load when using `DatabaseConnector::dbListTables`
+on postgres backends
+
 OhdsiShinyModules v2.1.2
 ========================
 Fixed bug in cohort diagnostics incidence rate plots not showing for different strata

R/cohort-diagnostics-characterization.R

@@ -1014,7 +1014,7 @@ cohortDiagCharacterizationModule <- function(
           "Concept Id" = "tcr.concept_id",
           "Analysis Name" = "tar.analysis_name",
           "Covariate Name" = "tcr.covariate_name",
-          "Database" = "db.database_name"
+          "Database" = "db.cdm_source_name"
         )
 
         for (i in 1:length(timeIds)) {
@@ -1047,17 +1047,18 @@ cohortDiagCharacterizationModule <- function(
 
         shiny::updateSelectInput(inputId = "sortByRawTemporal", choices = sortChoices, selected = "mean1")
 
+        #### Testing fix for main.Database error when viewing shiny app.
         sqlt <- "
           SELECT @select_stament
 
           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_META_DATA db ON db.database_id = tcv.database_id
           WHERE tcr.covariate_id IS NOT NULL
         "
 
-        selectSt <- "db.database_name,
+        selectSt <- "db.cdm_source_name,
             tcr.covariate_name,
             tar.analysis_name,
             is_binary,
@@ -1080,8 +1081,9 @@ cohortDiagCharacterizationModule <- function(
         }
 
         tplSql <- paste(tplSql, collapse = ", \n")
+        ### Edit to resolve column name in db.
         groupClause <- SqlRender::render("
-        GROUP BY db.database_name, tcr.covariate_name, tar.analysis_name, tcr.concept_id, is_binary
+        GROUP BY db.cdm_source_name, tcr.covariate_name, tar.analysis_name, tcr.concept_id, is_binary
         HAVING @having_clasuse
         ", having_clasuse = paste(havingSql, collapse = " OR\n"))
 

R/cohort-diagnostics-main.R

@@ -14,14 +14,29 @@
 # See the License for the specific language governing permissions and
 # limitations under the License.
 
+.availableTables <- function(connectionHandler, schema) {
+  if (connectionHandler$dbms() == "postgresql") {
+    sql <- "SELECT table_name FROM information_schema.tables where table_schema = '@schema'"
+    tables <- connectionHandler$queryDb(sql, schema = schema) |>
+      dplyr::pull("tableName") |>
+      tolower()
+    return(tables)
+  }
+
+  return(
+    DatabaseConnector::getTableNames(connectionHandler$getConnection(),
+                                     databaseSchema = schema) |>
+      tolower()
+  )
+}
+
 
 # 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)
   resultsTablesOnServer <-
-    tolower(DatabaseConnector::dbListTables(dataSource$connectionHandler$getConnection(),
-                                            schema = dataSource$schema))
+    tolower(.availableTables(dataSource$connectionHandler, dataSource$schema))
 
   if (required || selectTableName %in% resultsTablesOnServer) {
     if (tableIsEmpty(dataSource, selectTableName)) {
@@ -30,10 +45,9 @@ loadResultsTable <- function(dataSource, tableName, required = FALSE, cdTablePre
 
     tryCatch(
     {
-      table <- DatabaseConnector::dbReadTable(
-        dataSource$connectionHandler$getConnection(),
-        paste(dataSource$schema, selectTableName, sep = ".")
-      )
+      table <- dataSource$connectionHandler$queryDb("SELECT * FROM @schema.@table",
+                                                    schema = dataSource$schema,
+                                                    table = selectTableName)
     },
       error = function(err) {
         stop(
@@ -44,8 +58,7 @@ loadResultsTable <- function(dataSource, tableName, required = FALSE, cdTablePre
         )
       }
     )
-    colnames(table) <-
-      SqlRender::snakeCaseToCamelCase(colnames(table))
+
     return(table)
   }
 
@@ -70,13 +83,38 @@ tableIsEmpty <- function(dataSource, tableName) {
   return(nrow(row) == 0)
 }
 
+postgresEnabledReports <- function(connectionHandler, schema, tbls) {
+
+  sql <- "
+    select c.relname as table_name
+  from pg_class c
+  inner join pg_namespace n on n.oid = c.relnamespace
+  where c.relkind = 'r'
+        and n.nspname not in ('information_schema','pg_catalog')
+        and c.reltuples != 0
+        and n.nspname = '@schema'
+        "
+
+  return(connectionHandler$queryDb(sql, schema = schema) %>% dplyr::pull("tableName"))
+}
+
 #' Get enable cd reports from available data
-#' @param dataSource           C
+#' @param dataSource     Cohort diagnostics data source
 #' @export
 getEnabledCdReports <- function(dataSource) {
+
+  if (dataSource$connectionHandler$dbms() == "postgresql") {
+    tbls <- dataSource$dataModelSpecifications$tableName %>% unique()
+    possible <- paste0(dataSource$cdTablePrefix, tbls)
+    available <- postgresEnabledReports(dataSource$connectionHandler, dataSource$schema)
+    enabledReports <- c(tbls[possible %in% available], "cohort", "database") %>%
+      unique() %>%
+      SqlRender::snakeCaseToCamelCase()
+    return(enabledReports)
+  }
+
   enabledReports <- c()
-  resultsTables <- tolower(DatabaseConnector::dbListTables(dataSource$connectionHandler$getConnection(),
-                                                           schema = dataSource$schema))
+  resultsTables <- .availableTables(dataSource$connectionHandler, schema = dataSource$schema)
 
   for (table in dataSource$dataModelSpecifications$tableName %>% unique()) {
     if (dataSource$prefixTable(table) %in% resultsTables) {
@@ -87,7 +125,7 @@ getEnabledCdReports <- function(dataSource) {
   }
   enabledReports <- c(enabledReports, "cohort", "database")
 
-  enabledReports
+  return(enabledReports)
 }
 
 #' Create a CD data source from a database
@@ -181,8 +219,7 @@ createCdDatabaseDataSource <- function(
     schema = resultDatabaseSettings$schema,
     vocabularyDatabaseSchema = resultDatabaseSettings$vocabularyDatabaseSchema,
     dbms = connectionHandler$dbms(),
-    resultsTablesOnServer = tolower(DatabaseConnector::dbListTables(connectionHandler$getConnection(),
-                                                                    schema = resultDatabaseSettings$schema)),
+    resultsTablesOnServer = .availableTables(connectionHandler, resultDatabaseSettings$schema),
     cdTablePrefix = resultDatabaseSettings$cdTablePrefix,
     prefixTable = function(tableName) { paste0(resultDatabaseSettings$cdTablePrefix, tableName) },
     prefixVocabTable = function(tableName) {
@@ -375,9 +412,9 @@ getResultsTemporalTimeRef <- function(dataSource) {
 #' @param dataSource                    dataSource optionally created with createCdDatabaseDataSource
 #' @export
 cohortDiagnosticsServer <- function(id,
-                                   connectionHandler,
-                                   resultDatabaseSettings,
-                                   dataSource = NULL) {
+                                    connectionHandler,
+                                    resultDatabaseSettings,
+                                    dataSource = NULL) {
   ns <- shiny::NS(id)
 
   checkmate::assertClass(dataSource, "CdDataSource", null.ok = TRUE)
@@ -668,7 +705,7 @@ cohortDiagnosticsServer <- function(id,
                               selectedDatabaseIds = selectedDatabaseIds)
 
       cohortDiagCharacterizationModule(id = "characterization",
-                             dataSource = dataSource)
+                                       dataSource = dataSource)
 
       compareCohortCharacterizationModule(id = "compareCohortCharacterization",
                                           dataSource = dataSource)