server commit

NEWS.md

@@ -1,3 +1,8 @@
+# EHDEN HMB v1.0.2
+
+* Fixed cohort picker in shiny app
+* Updated renv.lock file for package dependency
+
 # EHDEN HMB v1.0.1
 
 * Corrected NEWS.md file

analysis/private/_treatmentHistory.R

@@ -44,8 +44,9 @@ get_tx_history <- function(con,
 
   # Extract person ids and start date of target cohort index(start) date (hmb diagnosis)
   pids <- current_cohorts %>%
-    dplyr::filter(cohort_id == 1) %>%
-    dplyr::select(person_id, start_date)
+    dplyr::filter(cohort_id == 1 & rnk == 1) %>%
+    dplyr::select(person_id, start_date) %>%
+    dplyr::distinct()
 
   # Add target cohort index date in Treatment History data frame
   resIdDate <- res %>%

analysis/private/_treatmentHistory_helpers.R

@@ -24,15 +24,16 @@ collect_cohorts <- function(con,
     FROM @write_schema.@cohort_table
     WHERE cohort_definition_id = @cohortId
   )
-  SELECT a.*
+  SELECT a.*,
+  rank() over(partition by a.subject_id, a.cohort_definition_id order by a.cohort_start_date) as rnk
   FROM (
-  SELECT * FROM
-  @write_schema.@cohort_table
-  WHERE cohort_definition_id in (@allIds)
+    SELECT * FROM
+    @write_schema.@cohort_table
+    WHERE cohort_definition_id in (@allIds)
   ) a
   JOIN T1
     ON a.subject_id = t1.subject_id
-  " %>%
+    order by subject_id, cohort_definition_id, rnk;" %>%
     SqlRender::render(
       write_schema = workDatabaseSchema,
       cohort_table = cohortTable,
@@ -44,7 +45,7 @@ collect_cohorts <- function(con,
     )
 
   current_cohorts <- DatabaseConnector::querySql(connection = con, sql = sql)
-  names(current_cohorts) <- c("cohort_id", "person_id", "start_date", "end_date")
+  names(current_cohorts) <- c("cohort_id", "person_id", "start_date", "end_date", "rnk")
   current_cohorts <- data.table::as.data.table(current_cohorts)
 
   return(current_cohorts)

analysis/private/_treatmentPatterns.R

@@ -304,6 +304,8 @@ executePostIndexDrugUtilization <- function(con,
 
 ## Treatment Patterns -------------------------
 
+#prepSankey <- function(th, minNumPatterns, flag = c("6m","1y","2y","end")) {
+
 prepSankey <- function(th, minNumPatterns) {
 
   treatment_pathways <- th %>%
@@ -315,6 +317,16 @@ prepSankey <- function(th, minNumPatterns) {
     dplyr::mutate(End = "end", .before = "n") %>%
     dplyr::filter(n >= 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) %>%
+  #   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()) %>%
@@ -395,6 +407,7 @@ executeTreatmentPatterns <- function(con,
     ## All time ----------------------------------------------
 
     # Create object to export
+    #debug(prepSankey)
     patterns <- th %>%
       prepSankey(minNumPatterns = 30L)
 
@@ -412,6 +425,7 @@ executeTreatmentPatterns <- function(con,
     patterns6m <- th %>%
       dplyr::filter(flag %in% c("6m")) %>%
       prepSankey(minNumPatterns = 30L)
+      #prepSankey(minNumPatterns = 30L, flag %in% c("6m"))
 
     # Save file
     save_path_6m <- fs::path(paste0(txPatFolder, "/6m")) %>%
@@ -427,6 +441,7 @@ executeTreatmentPatterns <- function(con,
     patterns1y <- th %>%
       dplyr::filter(flag %in% c("6m", "1y")) %>%
       prepSankey(minNumPatterns = 30L)
+    #prepSankey(minNumPatterns = 30L, flag %in% c("6m", "1y"))
 
     # Save file
     save_path_1y <- fs::path(paste0(txPatFolder, "/1y")) %>%
@@ -442,6 +457,7 @@ executeTreatmentPatterns <- function(con,
     patterns2y <- th %>%
       dplyr::filter(flag %in% c("6m", "1y", "2y")) %>%
       prepSankey(minNumPatterns = 30L)
+    #prepSankey(minNumPatterns = 30L, flag %in% c("6m", "1y", "2y))
 
     # Save file
     save_path_2y <- fs::path(paste0(txPatFolder, "/2y")) %>%

renv.lock

@@ -496,14 +496,14 @@
     },
     "Ulysses": {
       "Package": "Ulysses",
-      "Version": "0.0.4",
+      "Version": "0.0.2",
       "Source": "GitHub",
       "RemoteType": "github",
       "RemoteHost": "api.github.com",
       "RemoteRepo": "Ulysses",
       "RemoteUsername": "ohdsi",
-      "RemoteRef": "HEAD",
-      "RemoteSha": "72963e7edc6ee2604f6feaa963a43aecf6441515",
+      "RemoteRef": "v0.0.2",
+      "RemoteSha": "c3c513a683ea4ecdc12b7ceac1a9053aa6ebd23a",
       "Requirements": [
         "cli",
         "crayon",
@@ -525,7 +525,7 @@
         "withr",
         "yaml"
       ],
-      "Hash": "0325633f166534d87b2ff4c3feecac15"
+      "Hash": "69b2935ecbd7409be44cf489d88341de"
     },
     "abind": {
       "Package": "abind",