Cd cohort table

R/cohort-diagnostics-cohort-overlap.R

@@ -211,18 +211,17 @@ cohortOverlapView <- function(id) {
               id = ns("overlapPlotContainer"),
               plotly::plotlyOutput(ns("overlapPlot"), width = "100%", height = "300px")
             )
-          )
-        ),
-
-          # complicated way of setting plot height based on number of rows and selection type
+          ),
+           # complicated way of setting plot height based on number of rows and selection type
           # Note that this code is only used because renderUI/ uiOutput didn't seem to update with plotly
           shiny::tags$script(sprintf("
         Shiny.addCustomMessageHandler('%s', function(height) {
           let plotSpace = document.getElementById('%s');
           plotSpace.querySelector('.svg-container').style.height = height;
           plotSpace.querySelector('.js-plotly-plot').style.height = height;
         });
-      ", ns("overlapPlotHeight"), ns("overlapPlotContainer"))),
+      ", ns("overlapPlotHeight"), ns("overlapPlotContainer")))
+        ),
         shiny::tabPanel(
           title = "Table",
           shiny::fluidRow(

R/cohort-diagnostics-compareCharacterization.R

@@ -480,20 +480,6 @@ compareCohortCharacterizationView <- function(id, title = "Compare cohort charac
   )
 }
 
-# Returns data from cohort table of Cohort Diagnostics results data model
-getResultsCohort <- function(dataSource, cohortIds = NULL) {
-  data <- dataSource$connectionHandler$queryDb(
-    sql = "SELECT * FROM @schema.@table_name
-                                          {@cohort_id != \"\"} ? { WHERE cohort_id IN (@cohort_id)};",
-    schema = dataSource$schema,
-    cohort_id = cohortIds,
-    table_name = paste0(dataSource$cgTablePrefix,dataSource$cgTable),
-    snakeCaseToCamelCase = TRUE
-  )
-  return(data)
-}
-
-
 # Returns cohort as feature characterization
 getCohortRelationshipCharacterizationResults <-
   function(dataSource,
@@ -505,7 +491,8 @@ getCohortRelationshipCharacterizationResults <-
         cohortIds = cohortIds,
         databaseIds = databaseIds
       )
-    cohort <- getResultsCohort(dataSource = dataSource)
+    cohort <- getCdCohortRows(dataSource = dataSource,
+                              cohortIds = cohortIds)
 
     cohortRelationships <-
       getResultsCohortRelationships(
@@ -577,6 +564,7 @@ getCohortRelationshipCharacterizationResults <-
                             dplyr::distinct(),
                           by = c("analysisId")
         )
+
     covariateRef <- tidyr::crossing(
       cohort,
       analysisRef %>%

R/cohort-diagnostics-definition.R

@@ -209,13 +209,15 @@ getConceptSetDetailsFromCohortDefinition <-
   }
 
 
-getCohortJsonSql <- function(dataSource, cohortIds) {
-  sql <- "SELECT * FROM @schema.@cohort_table WHERE cohort_id IN (@cohort_ids)"
+getCdCohortRows <- function(dataSource, cohortIds) {
+  sql <- "SELECT {@use_cg_table} ? {cohort_definition_id as cohort_id,} * FROM @schema.@cohort_table
+    WHERE {@use_cg_table} ? {cohort_definition_id} : {cohort_id} IN (@cohort_ids)"
   dataSource$connectionHandler$queryDb(
     sql = sql,
     schema = dataSource$schema,
-    cohort_table = paste0(dataSource$cgTablePrefix,dataSource$cgTable),
-    cohort_ids = cohortIds
+    cohort_table = dataSource$cohortTableName,
+    cohort_ids = cohortIds,
+    use_cg_table = dataSource$useCgTable
   )
 }
 
@@ -572,7 +574,7 @@ cohortDefinitionsModule <- function(
           return(NULL)
         }
         row <- subset[idx[1],]
-        return(getCohortJsonSql(dataSource, row$cohortId))
+        return(getCdCohortRows(dataSource, row$cohortId))
       }
     })
 
@@ -1093,7 +1095,7 @@ cohortDefinitionsModule <- function(
         shiny::withProgress(
           message = "Export is in progress",
         {
-          definitions <- getCohortJsonSql(dataSource, cohortTable$cohortId)
+          definitions <- getCdCohortRows(dataSource, cohortTable$cohortId)
           exportCohortDefinitionsZip(definitions, zipFile = file)
         },
           detail = "Please Wait"

R/cohort-diagnostics-main-ui.R

@@ -182,7 +182,7 @@ cohortDiagnosticsView <- function(id = "DiagnosticsExplorer") {
         )
       )
     ),
-    shiny::fluidPage(
+    shiny::tagList(
       shiny::conditionalPanel(
         ns = ns,
         condition = "input.tabs == 'cohortDefinitions'",

R/cohort-diagnostics-main.R

@@ -194,8 +194,9 @@ createCdDatabaseDataSource <- function(
     },
     cgTable = resultDatabaseSettings$cgTable,
     cgTablePrefix = resultDatabaseSettings$cgTablePrefix,
-    databaseTable = resultDatabaseSettings$databaseTable,
-    databaseTablePrefix = resultDatabaseSettings$databaseTablePrefix,
+    useCgTable = FALSE,
+    databaseTable = "database",
+    databaseTablePrefix = "cd_",
     dataModelSpecifications = modelSpec
   )
 
@@ -211,6 +212,9 @@ createCdDatabaseDataSource <- function(
   if (displayProgress)
     shiny::setProgress(value = 0.2, message = "Getting cohorts")
 
+
+  dataSource$cohortTableName <- paste0(dataSource$cdTablePrefix, "cohort")
+
   dataSource$cohortTable <- getCohortTable(dataSource)
 
   if (displayProgress)
@@ -269,24 +273,8 @@ createCdDatabaseDataSource <- function(
   return(dataSource)
 }
 
-# SO much of the app requires this table in memory - it would be much better to re-write queries to not need it!
 getDatabaseTable <- function(dataSource) {
-
-  # hot fix
-  if(tolower(paste0(dataSource$databaseTablePrefix, dataSource$databaseTable)) == 'database_meta_data'){
-    databaseTable <- dataSource$connectionHandler$queryDb(
-      "SELECT *, cdm_source_abbreviation as database_name FROM @schema.@table_name",
-      schema = dataSource$schema,
-      table_name = paste0(dataSource$databaseTablePrefix, dataSource$databaseTable)
-    ) # end hot fix
-  } else{
-  databaseTable <- loadResultsTable(
-    dataSource = dataSource, 
-    tableName = paste0(dataSource$databaseTablePrefix, dataSource$databaseTable), 
-    required = TRUE
-    )
-  }
-
+  databaseTable <- loadResultsTable(dataSource, dataSource$databaseTable, required = TRUE)
   if (nrow(databaseTable) > 0 &
     "vocabularyVersion" %in% colnames(databaseTable)) {
     databaseTable <- databaseTable %>%
@@ -300,33 +288,11 @@ getDatabaseTable <- function(dataSource) {
 
 # SO much of the app requires this table in memory - it would be much better to re-write queries to not need it!
 getCohortTable <- function(dataSource) {
-  if (tableIsEmpty(
-      dataSource = dataSource, 
-      tableName = paste0(dataSource$cgTablePrefix, dataSource$cgTable)
-    )
-    ) {
-    return(data.frame())
-  }
-  # hot fix
-  if(paste0(dataSource$cgTablePrefix, dataSource$cgTable) == 'cg_cohort_definition'){
-    cohortTable <- dataSource$connectionHandler$queryDb(
-      "SELECT cohort_definition_id as cohort_id, cohort_name FROM @schema.@table_name",
-      schema = dataSource$schema,
-      table_name = paste0(dataSource$cgTablePrefix, dataSource$cgTable)
-    )
-   # end hot fix
-  } else{
-    cohortTable <- dataSource$connectionHandler$queryDb(
-      "SELECT cohort_id, cohort_name FROM @schema.@table_name",
-      schema = dataSource$schema,
-      table_name = paste0(dataSource$cgTablePrefix, dataSource$cgTable)
-    )
-  }
-
-  # Old label - is this needed??
-  if ("cohortDefinitionId" %in% names(cohortTable)) {
-    cohortTable <- cohortTable %>% dplyr::mutate(cohortId = .data$cohortDefinitionId)
-  }
+  cohortTable <- dataSource$connectionHandler$queryDb(
+    "SELECT cohort_id, cohort_name FROM @schema.@cd_table_prefixcohort",
+    schema = dataSource$schema,
+    cd_table_prefix = dataSource$cdTablePrefix
+  )
 
   cohortTable <- cohortTable %>%
     dplyr::arrange(.data$cohortId) %>%

R/cohort-diagnostics-shared.R

@@ -134,7 +134,7 @@ getDatabaseCounts <- function(dataSource,
       sql = sql,
       schema = dataSource$schema,
       database_ids = quoteLiterals(databaseIds),
-      database_table = paste0(dataSource$databaseTablePrefix, dataSource$databaseTable),
+      database_table = dataSource$databaseTable,
       snakeCaseToCamelCase = TRUE
     ) %>%
       tidyr::tibble()

tests/testthat/setup.R

@@ -133,10 +133,6 @@ resultDatabaseSettingsCohortDiag <- list(
   dbms = 'sqlite',
   cdTablePrefix = '',
   schema = "main",
-  cgTablePrefix = '',
-  cgTable = "cohort",
-  databaseTablePrefix = '',
-  databaseTable = "database",
   vocabularyDatabaseSchema = "main"
 )
 

tests/testthat/test-cohort-diagnostics-definition.R

@@ -7,7 +7,7 @@ shiny::testServer(cohortDefinitionsModule, args = list(
 ), {
   getCohortDefinitionResolvedConceptsReactive()
   checkmate::expect_data_frame(cohortDefinitionTableData())
-  defs <- getCohortJsonSql(dataSourceCd, dataSourceCd$cohortTable$cohortId)
+  defs <- getCdCohortRows(dataSourceCd, dataSourceCd$cohortTable$cohortId)
   def <- defs$json[1] %>% RJSONIO::fromJSON(digits = 23)
   checkmate::expect_list(getCirceRenderedExpression(def))
 

tests/testthat/test-cohort-diagnostics-main.R

@@ -6,6 +6,7 @@ shiny::testServer(cohortDiagnosticsServer, args = list(
   resultDatabaseSettings = resultDatabaseSettingsCohortDiag,
   dataSource = dataSourceCd
 ), {
+
   ## input tests will go here
   session$setInputs(
     tabs = "cohortCounts",