Develop

.github/workflows/pkgdown.yaml

@@ -0,0 +1,51 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, develop]
+  release:
+    types: [published]
+  workflow_dispatch:
+
+name: pkgdown
+
+jobs:
+  pkgdown:
+    runs-on: ubuntu-latest
+    # Only restrict concurrency for non-PR jobs
+    concurrency:
+      group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          cache: always
+          extra-packages: any::pkgdown, ohdsi/OhdsiRTools
+          needs: website
+
+      - uses: lycheeverse/lychee-action@v2
+        with:
+          args: --base . --verbose --no-progress --accept '100..=103, 200..=299, 403' './**/*.md' './**/*.Rmd'
+
+      - name: Build site
+        run: Rscript -e 'pkgdown::build_site_github_pages(new_process = FALSE, install = TRUE)'
+
+      - name: Fix Hades Logo
+        run: Rscript -e 'OhdsiRTools::fixHadesLogo()'
+
+      - name: Deploy to GitHub pages 🚀
+        if: github.event_name != 'pull_request'
+        uses: JamesIves/github-pages-deploy-action@v4
+        with:
+          clean: false
+          branch: gh-pages
+          folder: docs

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: OhdsiShinyModules
 Type: Package
 Title: Repository of Shiny Modules for OHDSI Result Viewers
-Version: 3.1.1
+Version: 3.1.2
 Authors@R: c(
   person("Jenna", "Reps", email = "jreps@its.jnj.com", role = c("aut", "cre")),
   person("Nathan", "Hall", role = c("aut")),
@@ -33,15 +33,14 @@ Imports:
     purrr,
     reactable,
     readr,
-    ReportGenerator,
+    OhdsiReportGenerator,
     RJSONIO,
     rlang,
     rmarkdown,
     scales,
     shiny, 
     shinycssloaders,
     shinydashboard,
-    shinyglide,
     shinyWidgets,
     SqlRender,
     stringi,
@@ -60,6 +59,6 @@ Suggests:
     testthat,
     withr
 Remotes:
-    ohdsi/ReportGenerator,
+    ohdsi/OhdsiReportGenerator,
     ohdsi/ResultModelManager
 RoxygenNote: 7.3.2

NAMESPACE

@@ -39,6 +39,7 @@ export(compareCohortCharacterizationView)
 export(conceptsInDataSourceView)
 export(createCdDatabaseDataSource)
 export(createCustomColDefList)
+export(createLargeSqlQueryDt)
 export(dataDiagnosticDrillServer)
 export(dataDiagnosticDrillViewer)
 export(dataDiagnosticHelperFile)
@@ -95,6 +96,7 @@ export(phevaluatorViewer)
 export(reportHelperFile)
 export(reportServer)
 export(reportViewer)
+export(resultTableViewer)
 export(timeDistributionsView)
 export(visitContextView)
 importFrom(dplyr,"%>%")

R/about-main.R

@@ -21,7 +21,7 @@
 #'
 #' @details
 #' Returns the location of the about helper file
-#' @family {About}
+#' @family About
 #' @return
 #' string location of the about helper file
 #'
@@ -38,7 +38,7 @@ aboutHelperFile <- function() {
 #' The user specifies the id for the module
 #'
 #' @param id  the unique reference id for the module
-#' @family {About}
+#' @family About
 #' @return
 #' The user interface to the home page module
 #'
@@ -102,7 +102,7 @@ targetedValueBox <- function(
 #' @param connectionHandler a connection to the database with the results
 #' @param resultDatabaseSettings a list containing the characterization result schema, dbms, tablePrefix, databaseTable and cgTablePrefix
 #' @param config the config from the app.R file that contains a list of which modules to include
-#' @family {About}
+#' @family About
 #' @return
 #' The server for the shiny app home
 #'

R/characterization-cohorts.R

@@ -303,17 +303,18 @@ characterizationCohortComparisonServer <- function(
         plotDf <- shiny::reactive({
 
           # Get the filtered and processed plot data
+          resultTable[is.na(resultTable)] <- 0
           plotData <- resultTable %>%
-            replace(is.na(.), 0) %>%
+            #replace(is.na(.), 0) %>%
             dplyr::mutate(domain = dplyr::case_when(
-              grepl("condition_", covariateName) | sub("\\s.*", "", covariateName) == "condition" ~ "Condition",
-              grepl("drug_", covariateName) | sub("\\s.*", "", covariateName) == "drug" ~ "Drug",
-              grepl("procedure_", covariateName) | sub("\\s.*", "", covariateName) == "procedure" ~ "Procedure",
-              grepl("measurement_", covariateName) | sub("\\s.*", "", covariateName) == "measurement" ~ "Measurement",
-              grepl("observation_", covariateName) | sub("\\s.*", "", covariateName) == "observation" ~ "Observation",
-              grepl("device_", covariateName) | sub("\\s.*", "", covariateName) == "device" ~ "Device",
-              grepl("cohort_", covariateName) | sub("\\s.*", "", covariateName) == "cohort" ~ "Cohort",
-              grepl("visit_", covariateName) | sub("\\s.*", "", covariateName) == "visit" ~ "Visit",
+              grepl("condition_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "condition" ~ "Condition",
+              grepl("drug_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "drug" ~ "Drug",
+              grepl("procedure_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "procedure" ~ "Procedure",
+              grepl("measurement_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "measurement" ~ "Measurement",
+              grepl("observation_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "observation" ~ "Observation",
+              grepl("device_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "device" ~ "Device",
+              grepl("cohort_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "cohort" ~ "Cohort",
+              grepl("visit_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "visit" ~ "Visit",
               .default = "Demographic"
             ))
 

R/characterization-database.R

@@ -381,9 +381,9 @@ characterizationDatabaseComparisonServer <- function(
                 currentDb <- plotResultDbSplit[[i]]
 
                 currentDbDf <- currentDb %>%
-                  dplyr::select(cdmSourceAbbreviation,
-                                covariateName,
-                                averageValue)
+                  dplyr::select("cdmSourceAbbreviation",
+                                "covariateName",
+                                "averageValue")
 
                 # Ensure only rows with selected xAxis or yAxis inputs are kept
                 currentDbDf <- currentDbDf %>%
@@ -397,7 +397,7 @@ characterizationDatabaseComparisonServer <- function(
 
                 # Remove the cdmSourceAbbreviation column for joining later
                 currentDbDf <- currentDbDf %>%
-                  dplyr::select(-cdmSourceAbbreviation)
+                  dplyr::select(-"cdmSourceAbbreviation")
 
                 # Append the processed dataframe to the list
                 processedDfs[[i]] <- currentDbDf
@@ -413,17 +413,18 @@ characterizationDatabaseComparisonServer <- function(
               }
 
               # Replace NA values with 0
+              plotResultDbComb[is.na(plotResultDbComb)] <- 0
               plotResultDbComb <- plotResultDbComb %>%
-                replace(is.na(.), 0) %>%
+                #replace(is.na(.), 0) %>%
                 dplyr::mutate(domain = dplyr::case_when(
-                  grepl("condition_", covariateName) | sub("\\s.*", "", covariateName) == "condition" ~ "Condition",
-                  grepl("drug_", covariateName) | sub("\\s.*", "", covariateName) == "drug" ~ "Drug",
-                  grepl("procedure_", covariateName) | sub("\\s.*", "", covariateName) == "procedure" ~ "Procedure",
-                  grepl("measurement_", covariateName) | sub("\\s.*", "", covariateName) == "measurement" ~ "Measurement",
-                  grepl("observation_", covariateName) | sub("\\s.*", "", covariateName) == "observation" ~ "Observation",
-                  grepl("device_", covariateName) | sub("\\s.*", "", covariateName) == "device" ~ "Device",
-                  grepl("cohort_", covariateName) | sub("\\s.*", "", covariateName) == "cohort" ~ "Cohort",
-                  grepl("visit_", covariateName) | sub("\\s.*", "", covariateName) == "visit" ~ "Visit",
+                  grepl("condition_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "condition" ~ "Condition",
+                  grepl("drug_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "drug" ~ "Drug",
+                  grepl("procedure_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "procedure" ~ "Procedure",
+                  grepl("measurement_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "measurement" ~ "Measurement",
+                  grepl("observation_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "observation" ~ "Observation",
+                  grepl("device_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "device" ~ "Device",
+                  grepl("cohort_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "cohort" ~ "Cohort",
+                  grepl("visit_", .data$covariateName) | sub("\\s.*", "", .data$covariateName) == "visit" ~ "Visit",
                   .default = "Demographic"
                 ))
 

R/characterization-incidence.R

@@ -62,7 +62,7 @@ break_setter = function(n = 5) {
 #' The user specifies the id for the module
 #'
 #' @param id  the unique reference id for the module
-#' @family {Characterization}
+#' @family Characterization
 #' @return
 #' The user interface to the description incidence module
 #'
@@ -234,7 +234,7 @@ characterizationIncidenceViewer <- function(id) {
 #' @param parentIndex an integer specifying the parent index of interest
 #' @param outcomes a reactive object specifying the outcomes of interest
 #' @param targetIds a reactive vector of integer specifying the targetIds of interest
-#' @family {Characterization}
+#' @family Characterization
 #' @return
 #' The server to the prediction incidence module
 #'

R/characterization-main.R

@@ -21,7 +21,7 @@
 #'
 #' @details
 #' Returns the location of the characterization helper file
-#' @family {Characterization}
+#' @family Characterization
 #' @return
 #' string location of the characterization helper file
 #'
@@ -37,7 +37,7 @@ characterizationHelperFile <- function(){
 #' The user specifies the id for the module
 #'
 #' @param id  the unique reference id for the module
-#' @family {Characterization}
+#' @family Characterization
 #' @return
 #' The user interface to the characterization viewer module
 #'
@@ -80,7 +80,7 @@ characterizationViewer <- function(id=1) {
 #' @param id  the unique reference id for the module
 #' @param connectionHandler a connection to the database with the results
 #' @param resultDatabaseSettings a list containing the characterization result schema, dbms, tablePrefix, databaseTable and cgTablePrefix
-#' @family {Characterization}
+#' @family Characterization
 #' @return
 #' The server for the characterization module
 #'
@@ -662,11 +662,18 @@ inner join @schema.@cg_table_prefixcohort_definition c on temp.outcome_cohort_id
   if(!'subsetDefinitionId' %in% colnames(cg)){
     cg$subsetDefinitionId <- cg$cohortDefinitionId
   }
-  cg$subsetParent[is.na(cg$isSubset)] <- cg$cohortDefinitionId
-  cg$subsetDefinitionId[is.na(cg$isSubset)] <- cg$cohortDefinitionId
-  cg$isSubset[is.na(cg$isSubset)] <- 0
 
-  parents <- unique(cg$cohortDefinitionId[cg$isSubset == 0])
+  # set subsetId to cohortId if NA as that means it is a parent
+  if(sum(is.na(cg$subsetDefinitionId)) > 0){
+  cg$subsetDefinitionId[is.na(cg$subsetDefinitionId)] <- cg$cohortDefinitionId[is.na(cg$subsetDefinitionId)]
+  }
+  # set parentId to cohortDefinitionId is it is NA
+  if(sum(is.na(cg$subsetParent)) > 0){
+    cg$subsetParent[is.na(cg$subsetParent)] <- cg$cohortDefinitionId[is.na(cg$subsetParent)]
+  }
+
+  # isSubset not being used now so use cg$subsetDefinitionId == cg$cohortDefinitionId
+  parents <- unique(cg$cohortDefinitionId[cg$subsetDefinitionId == cg$cohortDefinitionId])
   results <- lapply(parents, function(id){
     list(
       cohortName = cg$cohortName[cg$cohortDefinitionId == id],

R/cohort-diagnostics-characterization.R

@@ -19,7 +19,7 @@
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("characterization") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 cohortDiagCharacterizationView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-cohort-overlap.R

@@ -175,7 +175,7 @@ plotCohortOverlap <- function(data,
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("cohortOverlap") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 cohortOverlapView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-compareCharacterization.R

@@ -246,7 +246,7 @@ plotTemporalCompareStandardizedDifference <- function(balance,
 #'
 #' @param id    Namespace Id - use namespaced id ns("compareCohortCharacterization") inside diagnosticsExplorer module
 #' @param title     Optional string title field
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 compareCohortCharacterizationView <- function(id, title = "Compare cohort characterization") {
   ns <- shiny::NS(id)

R/cohort-diagnostics-conceptsInDataSource.R

@@ -19,7 +19,7 @@
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("conceptsInDataSource") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 conceptsInDataSourceView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-counts.R

@@ -18,7 +18,7 @@
 #' @description
 #' Shiny view for cohort counts module
 #' @param id            Namespace id
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 cohortCountsView <- function(id) {
   ns <- shiny::NS(id)
@@ -192,7 +192,7 @@ getInclusionRulesTable <- function(
 #' @param selectedCohorts           shiny::reactive - should return cohorts selected or NULL
 #' @param selectedDatabaseIds       shiny::reactive - should return cohorts selected or NULL
 #' @param cohortIds                 shiny::reactive - should return cohorts selected integers or NULL
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 cohortCountsModule <- function(id,
                                dataSource,
                                cohortTable = dataSource$cohortTable,

R/cohort-diagnostics-databaseInformation.R

@@ -20,7 +20,7 @@
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("databaseInformation") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 databaseInformationView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-definition.R

@@ -26,7 +26,7 @@
 #' @param cohortName Name for the cohort definition
 #'
 #' @param includeConceptSets Do you want to inclued concept set in the documentation
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @return list object
 #'
 getCirceRenderedExpression <- function(cohortDefinition,
@@ -302,7 +302,7 @@ exportCohortDefinitionsZip <- function(cohortDefinitions,
 #' @description
 #' Outputs cohort definitions
 #' @param id            Namespace id for module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 cohortDefinitionsView <- function(id) {
   ns <- shiny::NS(id)
@@ -523,7 +523,7 @@ getCountForConceptIdInCohort <-
 #' @param databaseTable                 data.frame of databasese, databaseId, name
 #' @param cohortTable                   data.frame of cohorts, cohortId, cohortName
 #' @param cohortCountTable              data.frame of cohortCounts, cohortId, subjects records
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 cohortDefinitionsModule <- function(
     id,
     dataSource,

R/cohort-diagnostics-incidenceRates.R

@@ -500,7 +500,7 @@ plotIncidenceRate <- function(data,
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("incidenceRates") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 incidenceRatesView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-inclusionRules.R

@@ -19,7 +19,7 @@
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("inclusionRules") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 inclusionRulesView <- function(id) {
   ns <- shiny::NS(id)

R/cohort-diagnostics-indexEventBreakdown.R

@@ -19,7 +19,7 @@
 #' Use for customizing UI
 #'
 #' @param id    Namespace Id - use namespaced id ns("indexEvents") inside diagnosticsExplorer module
-#' @family {CohortDiagnostics}
+#' @family CohortDiagnostics
 #' @export
 indexEventBreakdownView <- function(id) {
   ns <- shiny::NS(id)