Formatting and style

R/demodata.R

@@ -101,7 +101,7 @@ populate_concept <- function(ont, modi, name, scheme, host = "", admin = "", pas
                   concept_path = stringr::str_replace_all(concept_path, "\\\\(.+?) [^\\\\]+", "\\\\\\1"),
                   update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
     # Push the dataframe into the new ontology table
-    dbPush(demodata, "concept_dimension")
+  dbPush(demodata, "concept_dimension")
 
   if (length(modi) > 0)
   {
@@ -110,7 +110,7 @@ populate_concept <- function(ont, modi, name, scheme, host = "", admin = "", pas
                     modifier_path = stringr::str_c("\\", name_char, "\\"),
                     modifier_cd = stringr::str_c(scheme, ":", modi %>% stringr::str_extract("^.+? ") %>% stringr::str_trim()),
                     update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
-    dplyr::select(-modi) %>%
+      dplyr::select(-modi) %>%
     # Push the dataframe into the new ontology table
     dbPush(demodata, "modifier_dimension")
   }
@@ -153,7 +153,7 @@ populate_provider <- function(ont, name, scheme, host = "", admin = "", pass = "
                   provider_path = stringr::str_replace_all(provider_path, "\\\\(.+?) [^\\\\]+", "\\\\\\1"),
                   update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
     # Push the dataframe into the new ontology table
-    dbPush(demodata, "provider_dimension")
+  dbPush(demodata, "provider_dimension")
 
   RPostgreSQL::dbDisconnect(demodata)
 }
@@ -179,24 +179,24 @@ add_patients_demodata <- function(patients, project, host = "", admin = "", pass
   demodata <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = host, dbname = "i2b2demodata", user = admin, password = pass)
 
 # Upsert patients mappings
-patients %>%
-  dplyr::mutate(patient_ide_source = "HIVE",
-                patient_ide_status = "A",
-                project_id = project,
-                patient_num = patient_ide,
-                update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
-  dplyr::select(patient_ide, patient_ide_source, patient_num, patient_ide_status, project_id, update_date) %>%
-dbUpsert(demodata, "patient_mapping", c("patient_ide", "patient_ide_source", "project_id"))
+  patients %>%
+    dplyr::mutate(patient_ide_source = "HIVE",
+                  patient_ide_status = "A",
+                  project_id = project,
+                  patient_num = patient_ide,
+                  update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
+    dplyr::select(patient_ide, patient_ide_source, patient_num, patient_ide_status, project_id, update_date) %>%
+  dbUpsert(demodata, "patient_mapping", c("patient_ide", "patient_ide_source", "project_id"))
 
 # Upsert patients mappings
-patients %>%
-  dplyr::mutate(patient_ide_source = project,
-                patient_ide_status = "A",
-                project_id = project,
-                patient_num = patient_ide,
-                update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
-  dplyr::select(patient_ide, patient_ide_source, patient_num, patient_ide_status, project_id, update_date) %>%
-dbUpsert(demodata, "patient_mapping", c("patient_ide", "patient_ide_source", "project_id"))
+  patients %>%
+    dplyr::mutate(patient_ide_source = project,
+                  patient_ide_status = "A",
+                  project_id = project,
+                  patient_num = patient_ide,
+                  update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
+    dplyr::select(patient_ide, patient_ide_source, patient_num, patient_ide_status, project_id, update_date) %>%
+  dbUpsert(demodata, "patient_mapping", c("patient_ide", "patient_ide_source", "project_id"))
 
   patients %>%
     dplyr::mutate(age_in_years_num = ifelse(is.na(death_date), floor(as.numeric(Sys.Date() - birth_date)/365.25), floor(as.numeric(death_date - birth_date)/365.25)),
@@ -243,7 +243,7 @@ add_encounters <- function(encounters, project, patient_mapping = "", host = "",
                     encounter_num = encounter_ide,
                     update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
       dplyr::select(encounter_ide, encounter_ide_source, project_id, encounter_num, patient_ide, patient_ide_source, encounter_ide_status, update_date) %>%
-    dbUpsert(demodata, "encounter_mapping", c("encounter_ide", "encounter_ide_source", "project_id", "patient_ide", "patient_ide_source"))
+  dbUpsert(demodata, "encounter_mapping", c("encounter_ide", "encounter_ide_source", "project_id", "patient_ide", "patient_ide_source"))
 
   encounters %>%
       dplyr::mutate(encounter_ide_source = project,
@@ -253,7 +253,7 @@ add_encounters <- function(encounters, project, patient_mapping = "", host = "",
                     encounter_num = encounter_ide,
                     update_date = format(Sys.Date(), "%m/%d/%Y")) %>%
       dplyr::select(encounter_ide, encounter_ide_source, project_id, encounter_num, patient_ide, patient_ide_source, encounter_ide_status, update_date) %>%
-    dbUpsert(demodata, "encounter_mapping", c("encounter_ide", "encounter_ide_source", "project_id", "patient_ide", "patient_ide_source"))
+  dbUpsert(demodata, "encounter_mapping", c("encounter_ide", "encounter_ide_source", "project_id", "patient_ide", "patient_ide_source"))
 
   encounters %>%
     dplyr::mutate(length_of_stay = ifelse(is.na(end_date), floor(as.numeric(Sys.Date() - start_date)), floor(as.numeric(end_date - start_date))),
@@ -310,7 +310,7 @@ add_observations <- function(observations, patient_mapping = "", encounter_mappi
                   encounter_num = encounter_ide,
                   update_date = format(Sys.Date(), "%m/%d/%Y"),
                   text_search_index = (nextval+1):(nextval + nrow(.))) %>%
-  dplyr::select(-patient_ide, -encounter_ide) %>%
+    dplyr::select(-patient_ide, -encounter_ide) %>%
   dbUpsert(demodata, "observation_fact", c("patient_num", "concept_cd", "modifier_cd", "start_date", "encounter_num", "instance_num", "provider_id"))
 
   RPostgreSQL::dbDisconnect(demodata)

R/i2b2_msg.R

@@ -77,13 +77,13 @@ add_header <- function(msg, domain, username, password)
 #' @export
 add_body <- function(msg, service, ..., attrib = NULL)
 {
-# Create param nodes
+  # Create param nodes
   params <- list(...) %>% purrr::map(list)
 
   mb <- list()
   mb[[service]] <- params
 
-# Set attributes
+  # Set attributes
   if(!is.null(attrib))
   {
     names(attrib) %>%
@@ -108,7 +108,7 @@ add_body <- function(msg, service, ..., attrib = NULL)
 #' @export
 send_msg <- function(msg, cellurl)
 {
-# Correct the base tag
+  # Correct the base tag
   request <- msg %>%
     xml2::as_xml_document() %>% 
     as.character %>%

R/imdata.R

@@ -33,14 +33,16 @@ add_patients_imdata <- function(patients, project, host = "", admin = "", pass =
   dplyr::src_postgres("i2b2imdata", host, user = admin, password = pass) %>%
     dplyr::tbl("im_mpi_mapping") %>%
     dplyr::select(global_id, lcl_site, lcl_id) %>%
-    dplyr::collect() -> existing
+    dplyr::collect() ->
+  existing
 
 # Create new IDEs
   new_id_start <- ifelse(nrow(existing) == 0, 100000001, existing$global_id %>% as.numeric %>% max + 1)
 
   data.frame(lcl_id = as.character(patients)) %>%
     dplyr::anti_join(existing) %>%
-    dplyr::mutate(global_id = seq(new_id_start, length.out = nrow(.))) -> new_patients
+    dplyr::mutate(global_id = seq(new_id_start, length.out = nrow(.))) ->
+  new_patients
 
 # Push the new patient mappings
   new_patients %>%

R/import.R

@@ -27,18 +27,20 @@ import_data <- function(data, project, host = "", admin = "", pass = "")
   data %>%
     dplyr::select(patient_ide, birth_date, death_date, gender) %>%
     dplyr::distinct() %>%
-    add_patients_demodata(project, host, admin, pass) -> patient_mapping
+    add_patients_demodata(project, host, admin, pass) ->
+  patient_mapping
 
   # Encounters
   data %>%
     dplyr::select(patient_ide, encounter_ide, start_date, end_date) %>%
     dplyr::distinct() %>%
-    add_encounters(project, patient_mapping, host, admin, pass) -> encounter_mapping
+    add_encounters(project, patient_mapping, host, admin, pass) ->
+  encounter_mapping
 
   # Observations
   data %>%
     dplyr::distinct() %>%
-    add_observations(patient_mapping, encounter_mapping, host, admin, pass)
+  add_observations(patient_mapping, encounter_mapping, host, admin, pass)
 
   # Rebuild indexes
   rebuild_indexes_demodata(host, admin, pass)

R/metadata.R

@@ -167,15 +167,15 @@ populate_ont <- function(ont, modi = NULL, name, scheme, include_code = T, def_f
   # Tag explicit folders and root leaves
   ont %>%
     dplyr::mutate(type = dplyr::case_when(c_fullname %>% purrr::map_lgl(~stringr::str_detect(setdiff(c_fullname, .x), stringr::fixed(.x)) %>% any) ~ "folder",
-                            c_fullname %>% stringr::str_detect("\\\\") ~ "leaf",
-                            T ~ "root_leaf"),
-           c_visualattributes = ifelse(type == "folder", "FA", "LA")) ->
+                                          c_fullname %>% stringr::str_detect("\\\\") ~ "leaf",
+                                          T ~ "root_leaf"),
+                  c_visualattributes = ifelse(type == "folder", "FA", "LA")) ->
   ont
 
   # Add the folders for orphaned leaves by 'deconstructing' the paths
   ont %>%
     dplyr::filter(! (purrr::map(ont$c_fullname[ont$type == "folder"], ~stringr::str_detect(ont$c_fullname, .x)) %>% purrr::reduce(`|`) %||% F),
-           type == "leaf") %>%
+                  type == "leaf") %>%
     dplyr::pull(c_fullname) ->
   leaves
 
@@ -185,6 +185,7 @@ populate_ont <- function(ont, modi = NULL, name, scheme, include_code = T, def_f
       stringr::str_replace("\\\\[^\\\\]+$", "") %>%
       unique ->
     leaves
+
     ont %>%
       dplyr::add_row(c_fullname = leaves, c_visualattributes = "FA") ->
     ont
@@ -201,13 +202,13 @@ populate_ont <- function(ont, modi = NULL, name, scheme, include_code = T, def_f
     dplyr::add_row(c_fullname = stringr::str_c("\\", name), c_visualattributes = "FA") %>%
     # Populate the other columns if they are not given, with a default to concept_dimension
     dplyr::bind_cols(tibble::tibble(c_synonym_cd = rep(NA, nrow(.)),
-                            c_facttablecolumn = rep(NA, nrow(.)),
-                            c_tablename = rep(NA, nrow(.)),
-                            c_columnname = rep(NA, nrow(.)),
-                            c_columndatatype = rep(NA, nrow(.)),
-                            c_operator = rep(NA, nrow(.)),
-                            c_tooltip = rep(NA, nrow(.)),
-                            c_dimcode = rep(NA, nrow(.)))) %>%
+                                    c_facttablecolumn = rep(NA, nrow(.)),
+                                    c_tablename = rep(NA, nrow(.)),
+                                    c_columnname = rep(NA, nrow(.)),
+                                    c_columndatatype = rep(NA, nrow(.)),
+                                    c_operator = rep(NA, nrow(.)),
+                                    c_tooltip = rep(NA, nrow(.)),
+                                    c_dimcode = rep(NA, nrow(.)))) %>%
     dplyr::select(-dplyr::ends_with("1")) %>%
     dplyr::mutate(c_hlevel = stringr::str_count(c_fullname, "\\\\") - 1,
                   c_name = stringr::str_extract(c_fullname, "[^\\\\]+$"),
@@ -254,8 +255,8 @@ populate_ont <- function(ont, modi = NULL, name, scheme, include_code = T, def_f
                     update_date = format(Sys.Date(), "%m/%d/%Y")) ->
     modi
 
-  # Push the dataframe into the new ontology table
-  dbPush(modi, metadata, scheme)
+    # Push the dataframe into the new ontology table
+    dbPush(modi, metadata, scheme)
   }
 
 

R/pm.R

@@ -12,24 +12,24 @@
 #' @export
 set_domain <- function(admin, pass, domain_id, domain_name)
 {
-# Connect to the db
+  # Connect to the db
   hive <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = "127.0.0.1", dbname = "i2b2hive", user = admin, password = pass)
   pm   <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = "127.0.0.1", dbname = "i2b2pm",   user = admin, password = pass)
 
-# Set the domain id to all cells in i2b2hive
+  # Set the domain id to all cells in i2b2hive
   c("crc", "im", "ont", "work") %>%
     purrr::walk(~RPostgreSQL::dbGetQuery(hive, stringr::str_c("UPDATE ", .x, "_db_lookup SET c_domain_id = '", domain_id, "';")))
 
-# Set the domain id and name in pm_hive_data
+  # Set the domain id and name in pm_hive_data
   RPostgreSQL::dbGetQuery(pm, stringr::str_c("UPDATE pm_hive_data SET domain_id = '", domain_id, "', domain_name = '", domain_id, "';"))
 
-# Set the domain name for the webclient
+  # Set the domain name for the webclient
   "/var/www/html/webclient/i2b2_config_data.js" %>%
     readLines %>%
     stringr::str_c(collapse = "\n") %>%
     stringr::str_replace("domain: *\"[^\"]+\"", stringr::str_c("domain: \"", domain_id, "\"")) %>%
     stringr::str_replace("name: *\"[^\"]+\"",   stringr::str_c("name: \"", domain_name, "\"")) %>%
-    write(file = "/var/www/html/webclient/i2b2_config_data.js")
+  write(file = "/var/www/html/webclient/i2b2_config_data.js")
 
   # Disconnect the db
   RPostgreSQL::dbDisconnect(hive)
@@ -50,16 +50,17 @@ set_domain <- function(admin, pass, domain_id, domain_name)
 #' @export
 set_project <- function(host = "127.0.0.1", admin, pass, project_id, project_name)
 {
-# Connect to the db
+  # Connect to the db
   hive <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host, dbname = "i2b2hive", user = admin, password = pass)
   pm   <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host, dbname = "i2b2pm",   user = admin, password = pass)
 
-# Set the project id to all cells in i2b2hive
+  # Set the project id to all cells in i2b2hive
   c("im", "ont", "work") %>%
     purrr::walk(~RPostgreSQL::dbGetQuery(hive, stringr::str_c("UPDATE ", .x, "_db_lookup SET c_project_path = '", project_id, "/';")))
+
   RPostgreSQL::dbGetQuery(hive, stringr::str_c("UPDATE crc_db_lookup SET c_project_path = '/", project_id, "/';"))
 
-# Set the project id and name in pm_hive_data
+  # Set the project id and name in pm_hive_data
   RPostgreSQL::dbGetQuery(pm, stringr::str_c("UPDATE pm_project_data SET project_id = '", project_id, "', project_name = '", project_name, "', project_path = '/", project_id, "';"))
   RPostgreSQL::dbGetQuery(pm, stringr::str_c("UPDATE pm_project_user_roles SET project_id = '", project_id, "' WHERE (project_id = 'Demo');"))
 

R/system.R

@@ -10,7 +10,7 @@ clear_webclient <- function()
     stringr::str_c(collapse = "\n") %>%
     stringr::str_replace("demo", "") %>%
     stringr::str_replace("demouser", "") %>%
-    write("/var/www/html/webclient/js-i2b2/i2b2_ui_config.js")
+  write("/var/www/html/webclient/js-i2b2/i2b2_ui_config.js")
 }
 
 #' Set the permissions for the webclient and wildfly folders
@@ -43,28 +43,28 @@ set_permissions <- function()
 #' @export
 create_admin <- function(admin = "i2b2admin", pass= NULL, pass_length = 8)
 {
-# Generate a new password of default length 10
+  # Generate a new password of default length 10
   if (is.null(pass))
     pass <- create_password(pass_length)
 
-# Create the system user
+  # Create the system user
   system(stringr::str_c("useradd ", admin, " -g users -G wildfly -m"))
   system(stringr::str_c("echo \"", admin, ":", pass, "\" | chpasswd"))
   print(stringr::str_c(admin, " system account created with password: ", pass))
-  
-# Connect to the db
+
+  # Connect to the db
   con <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = "127.0.0.1", user = "postgres", password = "demouser")
-  
-# Create the database user and its database
+
+  # Create the database user and its database
   RPostgreSQL::dbGetQuery(con, stringr::str_c("create user ", admin, " with superuser createrole createdb password '", pass, "';"))
   RPostgreSQL::dbGetQuery(con, stringr::str_c("create database ", admin, ";"))
   print(stringr::str_c(admin, " postgresql account created with password: ", pass))
 
-# Reset the root account password
+  # Reset the root account password
   RPostgreSQL::dbGetQuery(con, stringr::str_c("alter user postgres password '", pass, "';"))
   print(stringr::str_c("Changed password for user postgres to: ", pass))
 
-# Disconnect the db
+  # Disconnect the db
   RPostgreSQL::dbDisconnect(con)
 
   pass
@@ -85,7 +85,7 @@ create_admin <- function(admin = "i2b2admin", pass= NULL, pass_length = 8)
 #' @export
 secure_db <- function(admin, pass, pass_length = 8)
 {
-# Connect to the db
+  # Connect to the db
   con <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), host = "127.0.0.1", user = admin, password = pass)
 
 # Generate passwords

R/users.R

@@ -17,7 +17,7 @@ add_user <- function(domain, admin, pass, id, name, email, password, url = "http
   base_msg() %>%
     add_header(domain, admin, pass) %>%
     add_body("pm:set_user", user_name = id, full_name = name, email = email, password = password, is_admin = 0) %>%
-    send_msg(url)
+  send_msg(url)
 }
 
 #' Add user roles

R/utils.R

@@ -40,8 +40,8 @@ dbPush <- function(df, con, table)
               stringr::str_c("(", ., ")") %>%
               stringr::str_replace("'NULL'", "NULL")
           }) %>%
-  stringr::str_c(collapse = ",") %>%
-  stringr::str_c("INSERT INTO ", table, " (", columns, ") VALUES ", ., ";") %>%
+    stringr::str_c(collapse = ",") %>%
+    stringr::str_c("INSERT INTO ", table, " (", columns, ") VALUES ", ., ";") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)
 }
 
@@ -66,7 +66,7 @@ dbUpdate <- function(df, con, table, PK)
 
               stringr::str_c("UPDATE ", table, " SET ", set, " WHERE ", where, ";") %>%
               RPostgreSQL::dbGetQuery(conn = con, .)
-            })
+          })
 }
 
 #' Clear a database table
@@ -102,15 +102,15 @@ dbUpsert <- function(df, con, table, PK)
 
   temp <- stringr::str_c(table, "_tmp")
 
-# Create a temp table
+  # Create a temp table
   stringr::str_c("CREATE TEMP TABLE ", temp, " (LIKE ", table, ");") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)
 
-# Load data in the temp table
+  # Load data in the temp table
   stringr::str_c("COPY ", temp, " (", names(df) %>% stringr::str_c(collapse = ","), ") FROM '/tmp/data.csv' WITH CSV HEADER;") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)
 
-# Update existing rows
+  # Update existing rows
   stringr::str_c("UPDATE", table,
                  "SET", stringr::str_c(columns, "=", temp, ".", columns, collapse = ","),
                  "FROM", temp,
@@ -118,7 +118,7 @@ dbUpsert <- function(df, con, table, PK)
                  ";", sep = " ") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)
 
-# Insert new rows
+  # Insert new rows
   stringr::str_c("INSERT INTO", table,
                  "SELECT", stringr::str_c(temp, ".*"),
                  "FROM", temp,
@@ -128,7 +128,7 @@ dbUpsert <- function(df, con, table, PK)
                  ";", sep = " ") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)
 
-# Delete the temp table and file
+  # Delete the temp table and file
   stringr::str_c("DROP TABLE", temp, ";", sep = " ") %>%
   RPostgreSQL::dbGetQuery(conn = con, .)