get site detail function

NAMESPACE

@@ -23,12 +23,14 @@ export(get_bulk_order_detail)
 export(get_bulk_order_items)
 export(get_bulk_orders)
 export(get_bulk_query)
+export(get_bulk_site_details)
 export(get_event_id)
 export(get_find_study_id)
 export(get_order_detail)
 export(get_order_items)
 export(get_orders)
 export(get_os_query)
+export(get_os_site)
 export(get_patient_id)
 export(get_site_id)
 export(get_specimen_type_id)
@@ -41,6 +43,7 @@ export(parse_order_detail_data)
 export(parse_os_oder_list)
 export(parse_os_order_data)
 export(parse_os_response)
+export(parse_site_details)
 export(process_save_selected_aliquots)
 export(read_multiple_files)
 export(read_multiple_sheets)

R/get_bulk_site_details.R

@@ -0,0 +1,53 @@
+# WARNING - Generated by {fusen} from dev/OpenSpecimenAPI.Rmd: do not edit by hand
+
+#' Get Bulk Site Details
+#'
+#' Use this function to retrieve details of multiple sites in bulk from the OpenSpecimen application.
+#'
+#' @param auth_response The authentication response object.
+#' @param site_ids A vector of integers representing the IDs of the sites to retrieve details for.
+#' @param ... Additional parameters to be passed to the underlying `get_os_site` function.
+#'
+#' @return A data table containing the details of the requested sites.
+#'
+#' @export
+#' @examples
+#' #get_bulk_site_details()
+get_bulk_site_details <- function(auth_response, site_ids, ...) {
+
+  # Check if site_ids is a vector of integers
+  if (isTRUE(any(round(site_ids) != site_ids))) {
+    stop("site_ids must be an integer")
+  }
+
+  # Use tryCatch to handle errors
+
+  list_dfs <- vector("list", length(site_ids))
+
+  for (i in seq_along(site_ids)) {
+
+    list_dfs[[i]] <- tryCatch(
+      get_os_site(auth_response, site_id = site_ids[i], ...),
+      error = function(e) {
+        cli::cli_alert_warning(paste0("Error in site id: ", site_ids[i], " ", e$message))
+        return(NULL)
+      }
+    )
+
+    if (i %% 10 == 0) {
+      cli::cli_alert_success(
+        paste0("Retrieved ", i, " sites",
+               " out of ", length(site_ids))
+      )
+    }
+  }
+
+  ## Combine the list of data.tables into a single data.table
+  dt_final = data.table::rbindlist(list_dfs, fill = TRUE)
+
+  cli::cli_alert_success(paste0("Done: Site details retrieved"))
+
+  return(dt_final)
+
+}
+

R/get_os_site.R

@@ -0,0 +1,47 @@
+# WARNING - Generated by {fusen} from dev/OpenSpecimenAPI.Rmd: do not edit by hand
+
+#' Get OpenSpecimen Site
+#'
+#' Use this function to retrieve details of a site from the OpenSpecimen application.
+#'
+#' @param auth_response Authentication response object obtained from the OpenSpecimen API.
+#' @param site_id The unique identifier of the site to fetch.
+#'
+#' @return A data frame containing the details of the specified site.
+#'
+#' @export
+#' @examples
+#' #get_os_site()
+get_os_site <- function(auth_response, site_id) {
+
+  # Get the site details
+  # Specify the content type as JSON in the header
+  # Extract the authentication token from the response
+  auth_token <- auth_response$auth_response$token
+  url <- auth_response$url
+
+  headers <- add_headers(
+    "Content-Type" = "application/json",
+    "X-OS-API-TOKEN" = auth_token
+  )
+
+  # Make the GET request for the query
+  response <- GET(
+    url = paste0(url, "/sites/", site_id),
+    config = headers,
+    encode = "json"
+  )
+
+  # Parse the response and return the results
+  results <- parse_os_response(response, 
+                               parse_data_function = "parse_site_details")
+
+  # If inherits data.frame, return results, else return NULL
+  if (inherits(results, "data.frame")) {
+    return(results)
+  } else {
+    return(NULL)
+  }
+
+}
+

R/parse_os_response.R

@@ -30,7 +30,9 @@ parse_os_response <- function(response, parse_data_function) {
     # if inherits data.frame apply timestamp_to_date
 
     if(inherits(df, "data.frame")){
-      df <- timestamp_to_date(df)
+
+
+      timestamp_to_date(df)
     }
 
     return(df)

R/parse_site_details.R

@@ -0,0 +1,51 @@
+# WARNING - Generated by {fusen} from dev/OpenSpecimenAPI.Rmd: do not edit by hand
+
+#' Parse OpenSpecimen Site Details
+#'
+#' Use this function to parse the response and extract details of a site from the OpenSpecimen application.
+#'
+#' @param response The API response object.
+#'
+#' @return A data table containing the parsed details of the site.
+#'
+#' @export
+#' @examples
+#' #parse_site_details()
+parse_site_details <- function(response) {
+
+  # Extract the content from the response
+  mycontent2 <- content(response, "parsed")
+
+  # Extract extension details
+  extension_details <- mycontent2$extensionDetail
+
+  # Extract attribute details
+  attr_dp <- extension_details$attrs
+
+  # Create clean column names
+  col_nms <- sapply(attr_dp, function(x) x$caption) %>% 
+    janitor::make_clean_names()
+
+  # Extract attribute values
+  values <- lapply(attr_dp, function(x) x$value)
+
+  # Set names for values
+  names(values) <- col_nms
+
+  # Convert values to data.table
+  dt1 = as.data.table(values)
+
+  # Remove extension details from parsed content
+  mycontent2$extensionDetail <- NULL
+  mycontent2$coordinators <- NULL
+  # Convert remaining parsed content to data.table
+  mycontentdf <- mycontent2 %>% as.data.table()
+
+  # Combine data.tables
+  mycontentdf <- cbind(mycontentdf, dt1)
+
+  # Return the final data.table
+  mycontentdf
+
+}
+

R/timestamp_to_date.R

@@ -72,9 +72,15 @@ timestamp_to_date.data.frame <- function(timestamp, date_cols = NULL){
 
   data.table::setDT(timestamp)
 
+  leng <- length(date_cols)
+
+  if(leng != 0){
+
+    timestamp[, (date_cols) := lapply(.SD, timestamp_to_date.numeric), .SDcols = date_cols]
+  }
+
 
 
-  timestamp[, (date_cols) := lapply(.SD, timestamp_to_date.numeric), .SDcols = date_cols]
 
 
 

README.Rmd

@@ -277,3 +277,12 @@ sites <- get_all_sites(auth_response)
 kable(sites[1:5])
 ```
 
+
+## Get all Sites details
+
+```{r, message=FALSE}
+
+sites_details <- get_bulk_site_details(auth_response, 
+                               site_ids = sites$id)
+kable(sites_details[1:5])
+```

README.md

@@ -325,9 +325,6 @@ query114 <- get_os_query(auth_response, query_id = 114,
                          wide_row_mode = "OFF",
                          start_at = 0,
                          max_results = 5)
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 
 kable(query114)
 ```
@@ -345,21 +342,9 @@ kable(query114)
 ``` r
 
 cv_samples <- get_bulk_query(auth_response, query_id = 105)
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 #> ✔ 5,000 rows retrieved
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 #> ✔ 10,000 rows retrieved
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 #> ✔ 15,000 rows retrieved
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 #> ✔ 18,897 rows retrieved
 
 
@@ -382,9 +367,6 @@ orders <- get_bulk_orders(auth_response)
 #> ✔ 36 rows retrieved
 #> Warning in `[.data.table`(df, , `:=`((personal_info), NULL)): length(LHS)==0;
 #> no columns to delete or assign RHS to.
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 
 kable(orders[1:5])
 ```
@@ -456,9 +438,6 @@ kable(distributed_samples[1:5])
 
 ``` r
 sites <- get_all_sites(auth_response)
-#> Warning in `[.data.table`(timestamp, , `:=`((date_cols), lapply(.SD,
-#> timestamp_to_date.numeric)), : length(LHS)==0; no columns to delete or assign
-#> RHS to.
 kable(sites[1:5])
 ```
 
@@ -469,3 +448,22 @@ kable(sites[1:5])
 | 130 | Access Bio, Inc         | Access Bio, Inc                   | NA   | Not Specified   | Active         |       0 |
 | 131 | Alere Technologies GmbH | Alere Technologies GmbH           | NA   | Not Specified   | Active         |       0 |
 | 124 | ARC                     | American Red Cross                | NA   | Collection Site | Active         |       0 |
+
+## Get all Sites details
+
+``` r
+
+sites_details <- get_bulk_site_details(auth_response, 
+                               site_ids = sites$id)
+kable(sites_details[1:5])
+```
+
+|                       id | name                    | instituteName                     | code | type            | activityStatus | cpCount | address                                                                                            | country |
+|-------------------------:|:------------------------|:----------------------------------|:-----|:----------------|:---------------|--------:|:---------------------------------------------------------------------------------------------------|:--------|
+|                       80 | AAMI                    | Australian Army Malaria Institute | 09   | Not Specified   | Active         |       0 | Australian Army Malaria InstituteWeary Dunlop DriveGallipoli Barracks, Enoggera Qld Australia 4051 | NA      |
+|                      132 | Access Bio Site 2       | Access Bio, Inc                   | NA   | Not Specified   | Active         |       0 | other dept, 65 Clude Rd Suite A,                                                                   |         |
+| Somerset, NJ, 08873, USA | NA                      |                                   |      |                 |                |         |                                                                                                    |         |
+|                      130 | Access Bio, Inc         | Access Bio, Inc                   | NA   | Not Specified   | Active         |       0 | 65 Clude Rd Suite A,                                                                               |         |
+| Somerset, NJ, 08873, USA | NA                      |                                   |      |                 |                |         |                                                                                                    |         |
+|                      131 | Alere Technologies GmbH | Alere Technologies GmbH           | NA   | Not Specified   | Active         |       0 | Loebstedter Str. 103-105, Jena, 07749, Germany                                                     | NA      |
+|                      124 | ARC                     | American Red Cross                | NA   | Collection Site | Active         |       0 | NA                                                                                                 | NA      |