commit Server 27/03

OdyOSG · Mar 27, 2024 · dd06a95 · dd06a95
1 parent 51f43e3
commit dd06a95
Show file tree

Hide file tree

Showing 12 changed files with 109 additions and 78 deletions.
diff --git a/analysis/private/_incidenceAnalysis.R b/analysis/private/_incidenceAnalysis.R
@@ -59,14 +59,15 @@ defineIncidenceAnalysis <- function(cohortId,
     )
   )
 
-  byYearStrata <- CohortIncidence::createStrataSettings(byYear = TRUE)
+  #strataSettings <- CohortIncidence::createStrataSettings(byYear = TRUE)
+  strataSettings <- CohortIncidence::createStrataSettings(byYear = TRUE, byAge = TRUE, ageBreaks = c(0,30,45,56))
 
   irDesign <- CohortIncidence::createIncidenceDesign(
     targetDefs = targets,
     outcomeDefs = list(o1),
     tars = tars,
     analysisList = analysisList,
-    strataSettings = byYearStrata
+    strataSettings = strataSettings
   )
 
   return(irDesign)

diff --git a/analysis/private/_procedureAnalysis.R b/analysis/private/_procedureAnalysis.R
@@ -278,8 +278,9 @@ executeProcedureAnalysis <- function(con,
     survDatKM <- getTteResKM(tb = tb, outcomeCohortId = procedureCohort)
 
     # Export time to event tables (survfit)
-    readr::write_rds(survDatKM,
-                     here::here(ttiFolder, paste0("tti_", databaseId, "_", targetCohortIds[i], ".rds"))
+    readr::write_rds(
+      survDatKM,
+      here::here(ttiFolder, paste0("tti_", databaseId, "_", targetCohortIds[i], ".rds"))
                      )
 
     fileNm2 <- glue::glue("procedure_survival_{idx}")

diff --git a/analysis/private/_treatmentHistory.R b/analysis/private/_treatmentHistory.R
@@ -12,6 +12,7 @@ get_tx_history <- function(con,
                            targetId,
                            targetName,
                            treatmentCohorts,
+                           database,
                            thSettings,
                            outputFolder) {
 
@@ -42,9 +43,15 @@ get_tx_history <- function(con,
 
   res$duration_era <- as.integer(res$duration_era)
 
+  #res <- arrow::read_parquet(here::here("results", database, "08_treatmentHistory", paste0("th_", targetId, ".parquet")))
+  #res <- arrow::read_parquet(here::here("results", database, "08_treatmentHistory2", paste0("th_", targetId, ".parquet")))
+
+  #res$flag <- NULL
+  #res$start_date <- NULL
+
   # Extract person ids and start date of target cohort index(start) date (hmb diagnosis)
   pids <- current_cohorts %>%
-    dplyr::filter(cohort_id == 1 & rnk == 1) %>%
+    dplyr::filter(cohort_id == targetId & rnk == 1) %>%
     dplyr::select(person_id, start_date) %>%
     dplyr::distinct()
 
@@ -137,6 +144,7 @@ runTreatmentHistory <- function(con,
                        targetId = tmp_targetId,
                        targetName = tmp_targetName,
                        treatmentCohorts = txCohorts,
+                       database = executionSettings$databaseName,
                        thSettings = thSettings,
                        outputFolder = save_path)
 

diff --git a/analysis/private/_treatmentPatterns.R b/analysis/private/_treatmentPatterns.R
@@ -304,30 +304,34 @@ executePostIndexDrugUtilization <- function(con,
 
 ## Treatment Patterns -------------------------
 
-#prepSankey <- function(th, minNumPatterns, flag = c("6m","1y","2y","end")) {
+prepSankey <- function(th, minNumPatterns, flag = c("6m","1y","2y","end")) {
 
-prepSankey <- function(th, minNumPatterns) {
-
-  treatment_pathways <- th %>%
-    tidyr::pivot_wider(id_cols = person_id,
-                       names_from = event_seq,
-                       names_prefix = "event_cohort_name",
-                       values_from = event_cohort_name) %>%
-    dplyr::count(dplyr::across(tidyselect::starts_with("event_cohort_name"))) %>%
-    dplyr::mutate(End = "end", .before = "n") %>%
-    dplyr::filter(n >= minNumPatterns)
+#prepSankey <- function(th, minNumPatterns) {
 
   # treatment_pathways <- th %>%
   #   tidyr::pivot_wider(id_cols = person_id,
   #                      names_from = event_seq,
   #                      names_prefix = "event_cohort_name",
-  #                      values_from = event_cohort_name,
-  #                      unused_fn = min) %>%
-  #   dplyr::filter(flag %in% flag) %>%
+  #                      values_from = event_cohort_name) %>%
   #   dplyr::count(dplyr::across(tidyselect::starts_with("event_cohort_name"))) %>%
   #   dplyr::mutate(End = "end", .before = "n") %>%
   #   dplyr::filter(n >= minNumPatterns)
 
+  treatment_pathways_in <- th %>%
+    tidyr::pivot_wider(id_cols = person_id,
+                       names_from = event_seq,
+                       names_prefix = "event_cohort_name",
+                       values_from = event_cohort_name,
+                       unused_fn = min)
+
+  treatment_pathways2 <- treatment_pathways_in[treatment_pathways_in$flag %in% flag, ]
+
+  treatment_pathways <- treatment_pathways2 %>%
+    #dplyr::filter(flag %in% flag) %>%
+    dplyr::count(dplyr::across(tidyselect::starts_with("event_cohort_name"))) %>%
+    dplyr::mutate(End = "end", .before = "n") %>%
+    dplyr::filter(n >= minNumPatterns)
+
   links <- treatment_pathways %>%
     dplyr::mutate(row = dplyr::row_number()) %>%
     tidyr::pivot_longer(cols = c(-row, -n),
@@ -407,7 +411,7 @@ executeTreatmentPatterns <- function(con,
     ## All time ----------------------------------------------
 
     # Create object to export
-    #debug(prepSankey)
+
     patterns <- th %>%
       prepSankey(minNumPatterns = 30L)
 
@@ -423,9 +427,9 @@ executeTreatmentPatterns <- function(con,
 
     # Create object to export
     patterns6m <- th %>%
-      dplyr::filter(flag %in% c("6m")) %>%
-      prepSankey(minNumPatterns = 30L)
-      #prepSankey(minNumPatterns = 30L, flag %in% c("6m"))
+      #dplyr::filter(flag %in% c("6m")) %>%
+      #prepSankey(minNumPatterns = 30L)
+      prepSankey(minNumPatterns = 30L, flag = c("6m"))
 
     # Save file
     save_path_6m <- fs::path(paste0(txPatFolder, "/6m")) %>%
@@ -439,9 +443,9 @@ executeTreatmentPatterns <- function(con,
 
     # Create object to export
     patterns1y <- th %>%
-      dplyr::filter(flag %in% c("6m", "1y")) %>%
-      prepSankey(minNumPatterns = 30L)
-    #prepSankey(minNumPatterns = 30L, flag %in% c("6m", "1y"))
+      #dplyr::filter(flag %in% c("6m", "1y")) %>%
+      #prepSankey(minNumPatterns = 30L)
+      prepSankey(minNumPatterns = 30L, flag = c("6m", "1y"))
 
     # Save file
     save_path_1y <- fs::path(paste0(txPatFolder, "/1y")) %>%
@@ -455,9 +459,9 @@ executeTreatmentPatterns <- function(con,
 
     # Create object to export
     patterns2y <- th %>%
-      dplyr::filter(flag %in% c("6m", "1y", "2y")) %>%
-      prepSankey(minNumPatterns = 30L)
-    #prepSankey(minNumPatterns = 30L, flag %in% c("6m", "1y", "2y))
+      #dplyr::filter(flag %in% c("6m", "1y", "2y")) %>%
+      #prepSankey(minNumPatterns = 30L)
+      prepSankey(minNumPatterns = 30L, flag = c("6m", "1y", "2y"))
 
     # Save file
     save_path_2y <- fs::path(paste0(txPatFolder, "/2y")) %>%

diff --git a/analysis/settings/incidenceAnalysis.yml b/analysis/settings/incidenceAnalysis.yml
@@ -3,21 +3,9 @@ incidenceAnalysis:
     targetCohort:
     - name: hmb
       id: 1
-    - name: hmb age_lt_30
-      id: 1001
-    - name: hmb age_30_45
-      id: 1002
-    - name: hmb age_45_55
-      id: 1003
     denominatorCohort:
     - name: incidenceDenominator
-      id: 2.0
-    - name: incidenceDenominator age_lt_30
-      id: 2001.0
-    - name: incidenceDenominator age_30_45
-      id: 2002.0
-    - name: incidenceDenominator age_45_55
-      id: 2003.0
+      id: 2
   incidenceSettings:
     cleanWindow: 0
     startWith: start

diff --git a/analysis/settings/incidenceAnalysis_old.yml b/analysis/settings/incidenceAnalysis_old.yml
@@ -0,0 +1,27 @@
+incidenceAnalysis:
+  cohorts:
+    targetCohort:
+    - name: hmb
+      id: 1
+    - name: hmb age_lt_30
+      id: 1001
+    - name: hmb age_30_45
+      id: 1002
+    - name: hmb age_45_55
+      id: 1003
+    denominatorCohort:
+    - name: incidenceDenominator
+      id: 2.0
+    - name: incidenceDenominator age_lt_30
+      id: 2001.0
+    - name: incidenceDenominator age_30_45
+      id: 2002.0
+    - name: incidenceDenominator age_45_55
+      id: 2003.0
+  incidenceSettings:
+    cleanWindow: 0
+    startWith: start
+    startOffset: 0
+    endsWith: end
+    endOffset: 0
+  outputFolder: 04_incidenceAnalysis
diff --git a/analysis/studyTasks/03_incidenceAnalysis.R b/analysis/studyTasks/03_incidenceAnalysis.R
@@ -17,7 +17,7 @@ source("analysis/private/_incidenceAnalysis.R")
 
 ### Set connection Block
 # <<<
-configBlock <- "[block]"
+configBlock <- "optum"
 # >>>
 
 ### Provide connection details
@@ -44,9 +44,10 @@ analysisSettings <- readSettingsFile(here::here("analysis/settings/incidenceAnal
 
 # E. Script --------------------
 
-#startSnowflakeSession(con = con, executionSettings = executionSettings)
+startSnowflakeSession(con = con, executionSettings = executionSettings)
 
 ### Incidence Analyses
+#debug(executeIncidenceAnalysis)
 executeIncidenceAnalysis(con = con,
                          executionSettings = executionSettings,
                          analysisSettings = analysisSettings)

diff --git a/analysis/studyTasks/05_treatmentPatterns.R b/analysis/studyTasks/05_treatmentPatterns.R
@@ -20,7 +20,7 @@ source("analysis/private/_treatmentHistory.R")
 
 ## Set connection Block
 # <<<
-configBlock <- "[block]"
+configBlock <- "cprdAurum"
 # >>>
 
 ## Provide connection details
@@ -49,15 +49,16 @@ analysisSettings3 <- readSettingsFile(here::here("analysis/settings/treatmentPat
 
 # E. Script --------------------
 
-#startSnowflakeSession(con = con, executionSettings = executionSettings)
+startSnowflakeSession(con = con, executionSettings = executionSettings)
 
-## Post index prevalence
-executePostIndexDrugUtilization(con = con,
-                                executionSettings = executionSettings,
-                                analysisSettings = analysisSettings1)
-
-### Without NSAIDS --------------------
-## Treatment history
+# ## Post index prevalence
+# executePostIndexDrugUtilization(con = con,
+#                                 executionSettings = executionSettings,
+#                                 analysisSettings = analysisSettings1)
+#
+# ### Without NSAIDS --------------------
+# ## Treatment history
+#
 runTreatmentHistory(con = con,
                     executionSettings = executionSettings,
                     analysisSettings = analysisSettings2)
@@ -66,28 +67,28 @@ runTreatmentHistory(con = con,
 executeTreatmentPatterns(con = con,
                          executionSettings = executionSettings,
                          analysisSettings = analysisSettings2)
-
-## Time to discontinuation
-executeTimeToEvent(con = con,
-                   executionSettings = executionSettings,
-                   analysisSettings = analysisSettings2)
-
-
+#
+# ## Time to discontinuation
+# executeTimeToEvent(con = con,
+#                    executionSettings = executionSettings,
+#                    analysisSettings = analysisSettings2)
+#
+#
 ### With NSAIDS (Sensitivity analysis) --------------------
 ## Treatment history
-runTreatmentHistory(con = con,
-                    executionSettings = executionSettings,
-                    analysisSettings = analysisSettings3)
-
-## Treatment patterns
-executeTreatmentPatterns(con = con,
-                         executionSettings = executionSettings,
-                         analysisSettings = analysisSettings3)
-
-## Time to discontinuation
-executeTimeToEvent(con = con,
-                   executionSettings = executionSettings,
-                   analysisSettings = analysisSettings3)
+# runTreatmentHistory(con = con,
+#                     executionSettings = executionSettings,
+#                     analysisSettings = analysisSettings3)
+#
+# ## Treatment patterns
+# executeTreatmentPatterns(con = con,
+#                          executionSettings = executionSettings,
+#                          analysisSettings = analysisSettings3)
+
+# ## Time to discontinuation
+# executeTimeToEvent(con = con,
+#                    executionSettings = executionSettings,
+#                    analysisSettings = analysisSettings3)
 
 # F. Session Info ------------------------
 

diff --git a/analysis/studyTasks/06_procedureAnalysis.R b/analysis/studyTasks/06_procedureAnalysis.R
@@ -44,7 +44,7 @@ analysisSettings <- readSettingsFile(here::here("analysis/settings/procedureAnal
 
 # E. Script --------------------
 
-#startSnowflakeSession(con = con, executionSettings = executionSettings)
+startSnowflakeSession(con = con, executionSettings = executionSettings)
 
 executeProcedureAnalysis(con = con,
                          executionSettings = executionSettings,

diff --git a/executeStudy.R b/executeStudy.R
@@ -13,7 +13,7 @@ source(here::here("analysis/private/_executeStudy.R"))
 # C. Variables -----------------------
 
 ### Edit to respective config block
-configBlock <- "[block]"
+configBlock <- "optum"
 
 ### Provide path to tasks
 studyTaskFolder <- here::here("analysis/studyTasks")

diff --git a/extras/KeyringSetup.R b/extras/KeyringSetup.R
@@ -14,9 +14,9 @@ library(keyring)
 
 ## B. Set Parameters ------------
 
-configBlock <- "[block_name]" # Name of config block
+configBlock <- "" # Name of config block
 
-database <- "[database_name]" # Name of the database in the config block
+database <- "" # Name of the database in the config block
 
 keyringName <- "ehden_hmb"   # Name of the keyring
 

diff --git a/shiny/migration/dataMigration.R b/shiny/migration/dataMigration.R
@@ -580,7 +580,7 @@ fctOrder <- c("All", as.character(2000:2022))
 inic2 <- inic %>%
   dplyr::mutate(
     START_YEAR = ifelse(is.na(START_YEAR), "All", as.character(START_YEAR)),
-    START_YEAR = factor(START_YEAR, levels = fctOrder),
+    #START_YEAR = factor(START_YEAR, levels = fctOrder),
     INCIDENCE_RATE_P1000PY = INCIDENCE_RATE_P100PY * 10
   ) %>%
   dplyr::select(databaseId,