Significant tidy up of code to support no indications in drop down

OHDSI · Dec 13, 2023 · 084c149 · 084c149
1 parent fb2282c
commit 084c149
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 41 deletions.
diff --git a/R/helpers-sccsDataPulls.R b/R/helpers-sccsDataPulls.R
@@ -35,15 +35,17 @@ sccsGetOutcomes <- function(
 }
 
 
-sccsGetIndications <- function(connectionHandler,
-                               resultDatabaseSettings) {
+sccsGetExposureIndications <- function(connectionHandler,
+                                       resultDatabaseSettings) {
 
   sql <- "SELECT
-      c.cohort_definition_id as indication_id,
-      c.cohort_name as indication_name,
-      e.era_id AS exposure_id
-   FROM @schema.@cg_table_prefixcohort_definition c
-   INNER JOIN @schema.@sccs_table_prefixexposures_outcome_set eos on eos.nesting_cohort_id = c.cohort_definition_id
+      e.era_id AS exposure_id,
+      c2.cohort_name as exposure_name,
+      coalesce(c.cohort_definition_id, -1) as indication_id,
+      coalesce(c.cohort_name, 'No indication') as indication_name
+
+   FROM @schema.@sccs_table_prefixexposures_outcome_set eos
+   LEFT JOIN @schema.@cg_table_prefixcohort_definition c on eos.nesting_cohort_id = c.cohort_definition_id
 
   INNER JOIN @schema.@sccs_table_prefixcovariate cov
         ON eos.exposures_outcome_set_id = cov.exposures_outcome_set_id
@@ -52,7 +54,8 @@ sccsGetIndications <- function(connectionHandler,
         ON eos.exposures_outcome_set_id = e.exposures_outcome_set_id
         AND cov.era_id = e.era_id
 
-   GROUP BY c.cohort_definition_id,  c.cohort_name, e.era_id
+   INNER JOIN @schema.@cg_table_prefixcohort_definition c2 on e.era_id = c2.cohort_definition_id
+   GROUP BY c.cohort_definition_id,  c.cohort_name, e.era_id, c2.cohort_name
   "
   result <- connectionHandler$queryDb(
     sql,

diff --git a/R/sccs-main.R b/R/sccs-main.R
@@ -74,30 +74,38 @@ sccsServer <- function(
     connectionHandler = connectionHandler,
     resultDatabaseSettings = resultDatabaseSettings
     )
-  exposures <- sccsGetExposures(
-    connectionHandler = connectionHandler,
-    resultDatabaseSettings = resultDatabaseSettings
-  )
+
   analyses <- sccsGetAnalyses(
     connectionHandler = connectionHandler,
     resultDatabaseSettings = resultDatabaseSettings
   )
 
   if (useNestingIndications) {
-    indicationsTbl <- sccsGetIndications(
+    # Requires migration in 5.1.0 of cohort generator
+    expIndicationsTbl <- sccsGetExposureIndications(
       connectionHandler = connectionHandler,
       resultDatabaseSettings = resultDatabaseSettings
     )
 
-    exposuresTbl <- data.frame(exposureId = exposures,
-                               exposureName = names(exposures))
+  } else {
+    # Backwards compatability
+    expIndicationsTbl <- sccsGetExposures(
+      connectionHandler = connectionHandler,
+      resultDatabaseSettings = resultDatabaseSettings
+    )
+  }
 
-    expIndicationsTbl <- indicationsTbl %>%
-      dplyr::inner_join(exposuresTbl, by = "exposureId") %>%
+ expIndicationsTbl <- expIndicationsTbl %>%
       dplyr::mutate(exposureIndicationId = paste(.data$exposureId,
                                                  .data$indicationId))
 
-    namesCallback <- function(inputSelected) {
+  exposureChoices <- expIndicationsTbl %>%
+      shinyWidgets::prepare_choices(label = .data$indicationName,
+                                    value = .data$exposureIndicationId,
+                                    group_by = .data$exposureName,
+                                    alias = .data$exposureName)
+
+  namesCallback <- function(inputSelected) {
       if (is.null(inputSelected))
         return("")
 
@@ -112,13 +120,7 @@ sccsServer <- function(
       paste(res$exposureName, "\n\t-", res$indicationName)
     }
 
-    exposureChoices <- expIndicationsTbl %>%
-      shinyWidgets::prepare_choices(label = .data$indicationName,
-                                    value = .data$exposureIndicationId,
-                                    group_by = .data$exposureName,
-                                    alias = .data$exposureName)
-
-    exposureSelectionInput <- createInputSetting(
+  exposureSelectionInput <- createInputSetting(
       rowNumber = 1,
       columnWidth = 6,
       varName = 'exposure',
@@ -132,22 +134,6 @@ sccsServer <- function(
       ),
       namesCallback = namesCallback
     )
-  } else {
-    exposureSelectionInput <- createInputSetting(
-      rowNumber = 1,
-      columnWidth = 6,
-      varName = 'exposure',
-      uiFunction = 'shinyWidgets::virtualSelectInput',
-      updateFunction = "shinyWidgets::updateVirtualSelectInput",
-      uiInputs = list(
-        label = 'Target: ',
-        choices = exposures,
-        selected = exposures[1],
-        multiple = F,
-        search = TRUE
-      )
-    )
-  }
 
   shiny::moduleServer(id, function(input, output, session) {