R/pretty_mrn.R

In parseRPDR: Parse and Manipulate Research Patient Data Registry ('RPDR') Text Queries

#' @title Converts MRN integer to string compatible with RPDR.
#' @export
#'
#' @description Adds or removes zeros from integers to comply with MRN code standards for given institution and adds institution prefix.
#'
#' @param v vector, integer or sting vector with MRNs.
#' @param prefix string or vector, hospital ID from where the MRNs are from. Defaults to \emph{MGH}. If a vector is provided then it must be the same length as \emph{v}.
#' This allows to potentially use different prefixes for different IDs using the same vector of values.
#' @param sep string, divider between hospital ID and MRN. Defaults to \emph{:}.
#' @param id_length string, indicating whether to modify MRN length based-on required values \emph{id_length = standard}, or to keep lengths as is \emph{id_length = asis}.
#' If \emph{id_length = standard} then in case of \emph{MGH, BWH, MCL, EMPI and PMRN} the length of the MRNs are corrected accordingly by adding zeros, or removing numeral from the beginning.
#' In other cases the lengths are unchanged. Defaults to \emph{standard}.
#' @param nThread integer, number of threads to use by \emph{dopar} for parallelization. If it is set to 1, then no parallel backends are created and the function is executed sequentially.
#'
#' @return vector, with characters formatted to specified lengths. If length of the ID does not match the required length, then leading zeros are added to the ID.
#' If the ID is longer then the required length, then numerals from the beginning of the ID are cut off until it is the required length.
#'
#' @encoding UTF-8
#'
#' @examples \dontrun{
#' mrns <- sample(1e4:1e7, size = 10) #Simulate MRNs
#'
#' #MGH format
#' pretty_mrn(v = mrns, prefix = "MGH")
#'
#' #BWH format
#' pretty_mrn(v = mrns, prefix = "BWH")
#'
#' #Multiple sources using space as a separator
#' pretty_mrn(v = mrns[1:3], prefix = c("MGH", "BWH", "EMPI"), sep = " ")
#'
#' #Keeping the length of the IDs despite not adhering to the requirements
#' pretty_mrn(v = mrns, prefix = "EMPI", id_length = "asis")
#' }

pretty_mrn <- function(v, prefix = "MGH", sep = ":", id_length = "standard", nThread = 1) {

  .SD=.N=.I=.GRP=.BY=.EACHI=..=..cols=.SDcols=i=j=time_to_db=..which_ids_to=..which_ids_from <- NULL
  options(future.globals.maxSize = +Inf)

  #Initialize multicore
  if(nThread == 1) {
    `%exec%` <- foreach::`%do%`
    future::plan(future::sequential)
  } else {
    if(parallelly::supportsMulticore()) {
      future::plan(future::multicore, workers = nThread)
    } else {
      future::plan(future::multisession, workers = nThread)
    }
    `%exec%` <- doFuture::`%dofuture%`
  }

  #Initiate chunks
  v_split <- split(v, sort(rep_len(1:nThread, length(v))))
  if(length(prefix) == 1) {
    prefix_split <- prefix
  } else {
    prefix_split <- split(prefix, sort(rep_len(1:nThread, length(v))))
  }


  result <- foreach::foreach(i = 1:nThread, .combine="c",
                             .inorder=TRUE, .options.future = list(chunk.size = 1.0),
                             .options.future = list(globals = structure(TRUE, add = "prefix_split"), globals.maxSize = 100 * 1024 ^ 3),
                             .errorhandling = c("pass"), .verbose=FALSE) %exec%
    {
      v_i <- v_split[[i]]

      #Create vectors of same length
      if(length(prefix_split) == 1) {
        prefix_i <- rep(prefix, length(v_i))
      } else{
        prefix_i <- prefix_split[[i]]
      }

      #Create length vector
      length <- len <- nchar(as.character(v_i))

      if(id_length == "standard") {
        length[prefix_i == "MGH"] <- 7
        length[prefix_i == "BWH"] <- 8
        length[prefix_i == "MCL"] <- 6
        length[prefix_i == "EMPI"] <- 9
        length[prefix_i == "PMRN"] <- 11
      }

      dif <- length - len
      v_out <- rep(NA, length(v_i))

      for(j in  1:length(v_i)) {
        if(!is.na(v_i[j])) {
          if(dif[j]<0) {
            v_out[j] <- paste0(prefix_i[j], sep, sub(paste0(rep(".", abs(dif[j])), collapse = ""), "", v_i[j])) #If string is longer than anticipated
          } else{
            v_out[j] <- paste0(prefix_i[j], sep, strrep("0", dif[j]), v_i[j]) #If string is shorter or equal than anticipated
          }
        }
      }
      v_out
    }

  on.exit(options(future.globals.maxSize = 1.0 * 1e9))
  future::plan(future::sequential)
  return(result)
}