Merge pull request #362 from OHDSI/issue361

Issue361 - adding Clean Window selector to Incidence
OHDSI · Oct 18, 2024 · 3ae21f6 · 3ae21f6
2 parents 15015be + 5b932c5
commit 3ae21f6
Showing 1 changed file with 45 additions and 7 deletions.
diff --git a/R/characterization-incidence.R b/R/characterization-incidence.R
@@ -353,6 +353,23 @@ characterizationIncidenceServer <- function(
             )
           ),
 
+          shinyWidgets::pickerInput(
+            inputId = session$ns('cleanWindows'),
+            label = 'Select Clean Window',
+            choices = ciOptions$cleanWindows,
+            selected = ciOptions$cleanWindows,
+            multiple = F,
+            options = shinyWidgets::pickerOptions(
+              actionsBox = TRUE,
+              liveSearch = TRUE,
+              size = 10,
+              dropupAuto = TRUE,
+              liveSearchStyle = "contains",
+              liveSearchPlaceholder = "Type here to search",
+              virtualScroll = 50
+            )
+          ),
+
           shinyWidgets::pickerInput(
             inputId = session$ns('tars'),
             label = 'Select Time at risk (TAR)',
@@ -370,6 +387,7 @@ characterizationIncidenceServer <- function(
             )
           ),
 
+
           shiny::actionButton(
             inputId = session$ns('generate'), 
             label = 'Generate',
@@ -384,12 +402,14 @@ characterizationIncidenceServer <- function(
       incidenceRateAgeFilter <- shiny::reactiveVal(NULL)
       incidenceRateGenderFilter <- shiny::reactiveVal(NULL)
       incidenceRateDbFilter <- shiny::reactiveVal(NULL)
+      incidenceRateCleanWindowsFilter <- shiny::reactiveVal(NULL)
       shiny::observeEvent(input$generate,{
         incidenceRateTarFilter(names(ciOptions$tar)[(ciOptions$tar == input$tars)]) # filter needs actual value
         incidenceRateCalendarFilter(input$startYears)
         incidenceRateAgeFilter(input$ageIds)
         incidenceRateGenderFilter(input$sexIds)
         incidenceRateDbFilter(input$databaseSelector)
+        incidenceRateCleanWindowsFilter(input$cleanWindows)
         outcomeIds(input$outcomeIds)
       })
 
@@ -594,11 +614,13 @@ characterizationIncidenceServer <- function(
                               shiny::validate("Please wait...")
                             }
 
-                            else if(targetIds()[1] == outcomeIds()[1] &&
-                                    length(targetIds())==1 && length(outcomeIds())==1
-                            ){
-                              shiny::validate("Target and outcome cohorts must differ from each other. Make a different selection.")
-                            }
+                            #causing an issue when we want the same target & outcome for recurrent events
+
+                            # else if(targetIds()[1] == outcomeIds()[1] &&
+                            #         length(targetIds())==1 && length(outcomeIds())==1
+                            # ){
+                            #   shiny::validate("Target and outcome cohorts must differ from each other. Make a different selection.")
+                            # }
 
                             else {
                               result <- getIncidenceData(targetIds = targetIds(),
@@ -625,7 +647,8 @@ characterizationIncidenceServer <- function(
                             .data$genderId %in% !! incidenceRateGenderFilter() & 
                             .data$startYear %in% !! incidenceRateCalendarFilter() & 
                             .data$tar %in% incidenceRateTarFilter() &
-                            .data$cdmSourceAbbreviation %in% !! incidenceRateDbFilter()
+                            .data$cdmSourceAbbreviation %in% !! incidenceRateDbFilter() &
+                            .data$cleanWindow %in% !! incidenceRateCleanWindowsFilter()
             ) %>%
             dplyr::relocate("targetName", .after = "cdmSourceAbbreviation") %>%
             dplyr::relocate("outcomeName", .after = "targetName") %>%
@@ -654,7 +677,7 @@ characterizationIncidenceServer <- function(
         id = "incidenceRateTable",
         df = filteredData,
         selectedCols = c("cdmSourceAbbreviation", "targetName", "targetNameShort", "outcomeName", "outcomeNameShort",
-                         "ageGroupName", "genderName", "startYear", "tar", "outcomes",
+                         "ageGroupName", "genderName", "startYear", "cleanWindow", "tar", "outcomes",
                          "incidenceProportionP100p", "incidenceRateP100py"),
         sortedCols = c("ageGroupName", "genderName", "startYear", "incidenceRateP100py"),
         elementId = "incidence-select",
@@ -1809,6 +1832,20 @@ from @result_schema.@incidence_table_prefixOUTCOME_DEF
   outcomes <- outcomeDf$outcomeId
   names(outcomes) <- outcomeDf$outcomeName
 
+  #getting clean window options
+  sql <- '
+select clean_window 
+from @result_schema.@incidence_table_prefixOUTCOME_DEF
+'
+  cleanWindowDf <- connectionHandler$queryDb(
+    sql = sql, 
+    result_schema = resultDatabaseSettings$schema,
+    incidence_table_prefix = resultDatabaseSettings$incidenceTablePrefix
+  )
+  cleanWindows <- cleanWindowDf$cleanWindow
+  names(cleanWindows) <- cleanWindowDf$cleanWindow
+
+
   irPlotCategoricalChoices <- list(
     "cdmSourceAbbreviation",
     "ageGroupName",
@@ -1867,6 +1904,7 @@ from @result_schema.@incidence_table_prefixOUTCOME_DEF
       startYear = startYear,
       tar = tar,
       outcomes = outcomes,
+      cleanWindows = cleanWindows,
       irPlotNumericChoices = irPlotNumericChoices,
       irPlotCategoricalChoices = irPlotCategoricalChoices
     )