R/PatientContactsToDF.R

Defines functions PatientContactsToDF

Documented in PatientContactsToDF

#' A function rather aimed at developers
#' @description A function that does blabla, blabla.
#' @keywords internal
#' @export

PatientContactsToDF <- function(a){

  frwd_dir <- grep('-->',a,value = T)
  bkwd_dir <- grep('<--',a,value = T)

  first_column_frwd <- base::trimws(sub('-->.*$','', frwd_dir))
  second_column_frwd <- base::trimws(sub('.*\\-->', '', frwd_dir))
  third_column_frwd <- base::trimws(str_extract_all(second_column_frwd,  "(?<=\\().+?(?=\\))"))
  forth_column_frwd <- base::trimws(sub('.*\\)', '', second_column_frwd))
  #second_column_frwd <- trimws(sub("^\\s*(\\S+).*", "\\1", second_column_frwd))
  second_column_frwd <- base::trimws(gsub("\\(.+\\).*", "", second_column_frwd))


  first_column_bkwd <- base::trimws(sub('<--.*$','', bkwd_dir))
  second_column_bkwd <- base::trimws(sub('.*\\--', '', bkwd_dir))
  third_column_bkwd <- base::trimws(str_extract_all(second_column_bkwd,  "(?<=\\().+?(?=\\))"))
  forth_column_bkwd <- base::trimws(sub('.*\\)', '', second_column_bkwd))
  #second_column_bkwd <- trimws(sub("^\\s*(\\S+\\S+).*", "\\1", second_column_bkwd))
  second_column_bkwd <- base::trimws(gsub("\\(.+\\).*", "", second_column_bkwd))

  df_frwd <- data.frame(column1=first_column_frwd,
                        column2=second_column_frwd,
                        direction="-->",
                        visit_date=third_column_frwd,
                        stage=forth_column_frwd)
  df_bkwd <- data.frame(column1=first_column_bkwd,
                        column2=second_column_bkwd,
                        direction="<--",
                        visit_date=third_column_bkwd,
                        stage=forth_column_bkwd)

  df <- rbind(df_frwd,df_bkwd)
  return(df)

}
vnsny-bia/VisitContactTrace documentation built on July 30, 2020, 10:19 p.m.