Adding option to override database thread settings for CM & SCCS

OHDSI · Dec 4, 2024 · 38f68db · 38f68db
2 parents ae4e5df + f5f678b
commit 38f68db
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 0 deletions.
diff --git a/R/Module-CohortMethod.R b/R/Module-CohortMethod.R
@@ -23,6 +23,14 @@ CohortMethodModule <- R6::R6Class(
       jobContext <- private$jobContext
       multiThreadingSettings <- CohortMethod::createDefaultMultiThreadingSettings(jobContext$moduleExecutionSettings$maxCores)
 
+      # Provide hook to allow for overriding the number of threads
+      # used for database operations
+      getDbCohortMethodDataThreads <- as.integer(getOption("strategus.CohortMethodModule.getDbCohortMethodDataThreads"))
+      if (isTRUE(getDbCohortMethodDataThreads > 0)) {
+        private$.message(paste0("Detected strategus.CohortMethodModule.getDbCohortMethodDataThreads - setting value to: ", getDbCohortMethodDataThreads))
+        multiThreadingSettings$getDbCohortMethodDataThreads <- getDbCohortMethodDataThreads
+      }
+
       args <- jobContext$settings
       args$connectionDetails <- connectionDetails
       args$cdmDatabaseSchema <- jobContext$moduleExecutionSettings$cdmDatabaseSchema

diff --git a/R/Module-SelfControlledCaseSeries.R b/R/Module-SelfControlledCaseSeries.R
@@ -25,6 +25,14 @@ SelfControlledCaseSeriesModule <- R6::R6Class(
       jobContext <- private$jobContext
       sccsMultiThreadingSettings <- SelfControlledCaseSeries::createDefaultSccsMultiThreadingSettings(jobContext$moduleExecutionSettings$maxCores)
 
+      # Provide hook to allow for overriding the number of threads
+      # used for database operations
+      getDbSccsDataThreads <- as.integer(getOption("strategus.SelfControlledCaseSeriesModule.getDbSccsDataThreads"))
+      if (isTRUE(getDbSccsDataThreads > 0)) {
+        private$.message(paste0("Detected strategus.SelfControlledCaseSeriesModule.getDbSccsDataThreads - setting value to: ", getDbSccsDataThreads))
+        sccsMultiThreadingSettings$getDbSccsDataThreads <- getDbSccsDataThreads
+      }
+
       args <- jobContext$settings
       args$connectionDetails <- connectionDetails
       args$cdmDatabaseSchema <- jobContext$moduleExecutionSettings$cdmDatabaseSchema