R/struct_RX.R

In INESSS-QC/polymed1: Polymédication

#' Structure Rx
#'
#' Structure le dataset des médicaments pour l'analyse.
#'
#' @param x dataset des Rx.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param Rx Nom de la colonne contenant le code de médicament.
#' @param DateServ Nom de la colonne contenant la date où la prescription a eu lieu.
#' @param Duree Nom de la colonne ayant comme valeurs les durées de chaque service, la durée de la prescription, la durée du traitement.
#' @param DebutAnalyse,FinAnalyse "AAAA-MM-JJ". Date de début et de fin d'analyse. Permet de filtrer les observations.
#' @param nbrMois Nombre entier. Nombre de mois à conserver avant la date de service. Conserve les observations où `DateServ >= DebutAnalyse - nbrMois`.
#'
#' @return data.table. 4 colonnes : `ID`, `Rx`, `DateServ` et `Duree`.
#' @import data.table
#' @export
struct_Rx <- function(x, ID, Rx, DateServ, Duree, DebutAnalyse = NULL, FinAnalyse = NULL, nbrMois = 7){
  x <- struct_Rx_verifications(x, ID, Rx, DateServ, Duree)  # verifications
  x <- struct_Rx_colSelect(x, ID, Rx, DateServ, Duree)  # sélection colonnes + renomme
  x <- struct_Rx_colTypes(x)  # type colonne DATE
  return(x)
}

#' Vérifications
#'
#' @param x dataset des Rx.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param Rx Nom de la colonne contenant le code de médicament.
#' @param DateServ Nom de la colonne contenant la date où la prescription a eu lieu.
#' @param Duree Nom de la colonne ayant comme valeurs les durées de chaque service, la durée de la prescription, la durée du traitement.
#'
#' @return `x` converti en data.table.
#' @keywords internal
#' @importFrom stringr str_detect
#' @importFrom lubridate is.Date as_date
#' @export
struct_Rx_verifications <- function(x, ID, Rx, DateServ, Duree){
  check <- newArgCheck()
  if(!is.data.frame(x)) addError("x n'est pas de type DATA.FRAME.", check)
  finishArgCheck(check)

  if(!is.data.table(x)) x <- as.data.table(x)

  for(var in c(ID, Rx, DateServ, Duree)) if(!is.character(var)) addError(paste0(var," n'est pas de type CHR."), check)
  finishArgCheck(check)
  for(col in c(ID, Rx, DateServ, Duree)) if(!col %in% names(x)) addError(paste0(var," n'est pas une colonne de x."), check)
  finishArgCheck(check)
  for(col in c(ID, Rx, DateServ, Duree)) if(anyNA(x[[col]])) addError(paste0("La colonne ",col," a des NA."), check)
  if(!(is.character(x[[DateServ]]) | is.Date(x[[DateServ]]))) addError(paste0("La colonne ",DateServ," (DateServ) n'est pas de type CHR ou DATE."), check)
  if(!is.numeric(x[[Duree]])) addError(paste0("La colonne ",Duree," (Duree) n'est pas de type NUM."), check)
  ### Erreur de mémoire
  # if(any(!str_detect(x[[DateServ]], "^[1-2][0-9][0-9][0-9]-[0-1][0-9]-[0-3][0-9]$"))) addError(paste0("La colonne ",DateServ," n'est pas de la forme 'AAAA-MM-JJ'."),
  #                                                                                              check)
  ###
  finishArgCheck(check)

  return(x)
}

#' Structure Rx
#'
#' Sélection des colonne nécessaires et les renomme.
#'
#' Le nom des colonnes résultantes sont `ID`, `Rx`, `DateServ` et `Duree`.
#'
#' @param x dataset des Rx.
#' @param ID Nom de la colonne contenant le code unique des individus.
#' @param Rx Nom de la colonne contenant le code de médicament.
#' @param DateServ Nom de la colonne contenant la date où la prescription a eu lieu.
#' @param Duree Nom de la colonne ayant comme valeurs les durées de chaque service, la durée de la prescription, la durée du traitement.
#'
#' @keywords internal
#' @export
struct_Rx_colSelect <- function(x, ID, Rx, DateServ, Duree){
  cols <- c(ID, Rx, DateServ, Duree)
  x <- x[, ..cols]
  setnames(x, names(x), c("ID", "Rx", "DateServ", "Duree"))
  return(x)
}

#' Structure Rx
#'
#' Convertit la colonne `DateServ` sous format DATE si nécessaire.
#'
#' @param x dataset créé par `struct_Rx_colSelect()`.
#'
#' @keywords internal
#' @importFrom lubridate is.Date as_date
#' @export
struct_Rx_colTypes <- function(x){
  x <- copy(x)
  if(!is.integer(x$Rx)) x[, Rx := as.integer(Rx)]
  if(!is.Date(x$DateServ)) x[, DateServ := as_date(DateServ)]  # convertir en format DATE si nécessaire
  if(!is.integer(x$Duree)) x[, Duree := as.integer(Duree)]  # convertir en INT
  return(x)
}

#' Title
#'
#' @param x dataset.
#' @param DebutAnalyse,FinAnalyse "AAAA-MM-JJ". Date de début et de fin d'analyse. Permet de filtrer les observations.
#' @param nbrMois Nombre entier. Nombre de mois à conserver avant la date de service. Conserve les observations où `DateServ >= DebutAnalyse - nbrMois`.
#'
#' @keywords internal
#' @importFrom lubridate is.Date as_date
#' @export
struct_Rx_rowSelect <- function(x, DebutAnalyse, FinAnalyse, nbrMois){
  x <- copy(x)
  DebutAnalyse <- as_date(DebutAnalyse) %m-% months(nbrMois)  # date de départ à utiliser
  FinAnalyse <- as_date(FinAnalyse)  # date de fin à utiliser
  return(x[DateServ >= DebutAnalyse & DateServ <= FinAnalyse])  # filtrer les observations
}