R/admis_period_indiv.R

In INESSS-QC/admissibilite1: Admissibilité des individus

#' Périodes individuelle
#'
#' Identique à la fonction \link{admis_analyse}, mais la période d'étude est différente pour chaque individu.
#'
#' @param database Sélection du type de données. `"RPAM"` ou `"RQAM"`.
#' @param dt Dataset contenant les périodes index.
#' @param ID Nom de la colonne indiquant le numéro d'identification de l'individu.
#' @param DebutIndex Nom de la colonne indiquant la date de début de la période index.
#' @param FinIndex Nom de la colonne indiquant la date fin de la période index.
#' @param method `1` : renvoie un tableau ayant une ligne par individu (voir \link{admis_analyse}).\cr
#' `2` : Semblable à `method = 1`, sauf que l'**on conserve la ou les périodes où l'individu est admissible** (Peut y avoir plusieurs observations pour un même individu).
#'
#' @return data.table
#' * `ID` : Numéro de l'identifiant.
#' * `DDN`, `DDC` : Date de naissance, de décès.
#' * `DDsld` : Première date de soin de longue durée.
#' * `DebutIndex`, `FinIndex` : Date de début et de fin de la période index.
#' * `NJRSpotentiel_Idx` : Nombre de jours maximum qu'un individu peut être admissible entre la date de début et la date de fin de la période index.
#' * `DDP`, `DFP` : Date de début et de fin de la période d'admissibilité. (Si `method = 2`).
#' * `NJRSadmis_Idx` : Nombre de jours où l’individu est admissible à l'intérieur de la période index. \eqn{\sum (DFP_i - DDP_i + 1)}.
#' * `Admis_Continue_Idx` : `TRUE` ou `FALSE.` Indique si l’individu est admissible en continue par rapport à la période index (`NJRSadmis_Idx`/`NJRSpotentiel_Idx` = 1).
#' * `DDsuivi_Idx`, `DFsuivi_Idx` : Date de début et de fin de suivi.
#' * `NJRSpotentiel_Suivi_Idx` : Nombre de jours maximum qu’un individu peut être admissible entre la date de fin et la date de début de suivi.
#' * `Admis_Continue_Suivi_Idx` : `TRUE` ou `FALSE`. Indique si l’individu est admissible en continue par rapport aux dates de suivi (`NJRSadmis_Idx`/`NJRSpotentiel_Suivi_Idx``` = 1).
#' * `Dentree_Idx`, `Dsortie_Idx` : Date d'entrée et date de sortie.
#' * `NJRSpotentiel_ES_Idx` : Nombre de jours maximum qu’un individu peut être admissible entre la date d’entrée et la date de sortie.
#' * `Admis_Continue_ES_Idx` : `TRUE` ou `FALSE`. Indique si l’individu est admissible en continue entre la date d'entrée et celle de sortie. (`NJRSadmis_Idx`/`NJRSpotentiel_ES_Idx` = 1).
#' * `Enais_Idx`, `Sdc_Idx` : `TRUE` ou `FALSE`. Indique si l'individu est né ou décédé durant la période index.
#' @import data.table
#' @importFrom lubridate is.Date as_date
#' @export
admis_period_indiv <- function(
  database,  # type de données
  dt,  # data contenant les périodes index par individu
  ID, DebutIndex, FinIndex = NULL,  # nom des colonnes
  method = 1  # 1 : table cohorte -> voir admis_analyse(). 2 : Conserve toutes les DDP-DFP
){

# Fonctions ---------------------------------------------------------------------------------------

  ### Sélection des colonnes nécessaires & renommer les colonnes
  ### Vérification si les colonnes ont le bon format :
  ###   - ID = integer
  ###   - DebutIndex = Date
  ###   - FinIndex = Date
  ### Vérification s'il y a au moins une ligne par ID
  .dt_selectCols <- function(dt, DebutIndex, FinIndex){
    dt <- copy(dt)
    check <- newArgCheck()  # variable contenant les messages, erreurs ou avertissements
    setnames(dt, c(ID, DebutIndex), c("ID", "DebutIndex"))  # renommer les colonnes obligatoires
    if(!is.integer(dt$ID)){  # ID doit être de type integer
      dt[, ID := as.integer(ID)]  # convertir au besoin
      addWarning("La colonne ID a été convertie en integer. Vérifier si les valeurs sont les mêmes.", check)
    }
    if(anyNA(dt$ID))  # ID ne doit pas contenir de NA
      addError("La colonne des ID ne peut contenir de NA", check)
    if(!is.Date(dt$DebutIndex))  # colonne DebutIndex doit être de type DATE
      dt[, DebutIndex := as_date(DebutIndex)]  # convertir au besoin
    if(anyNA(dt$DebutIndex))  # ne doit pas contenir de NA
      addError(paste(DebutIndex, "(DebutIndex) ne doit pas contenir de NA et doit être du format 'AAAA-MM-JJ'."), check)
    if(is.null(FinIndex)){  # si colonne FinIndex est absente
      dt[, FinIndex := DebutIndex]  # prend même valeur que DebutIndex
    } else {  # si colonne FinIndex existe
      setnames(dt, FinIndex, "FinIndex")  # renommer colonne FinIndex
      if(!is.Date(dt$FinIndex))  # doit être de type DATE
        dt[, FinIndex := as_date(FinIndex)]  # convertir au besoin
      if(anyNA(dt$FinIndex))  # ne doit pas contenir de NA
        addError(paste(FinIndex, "(FinIndex) ne doit pas contenir de NA et doit être du format 'AAAA-MM-JJ'."), check)
    }
    if(uniqueN(dt, "ID") < nrow(dt))  # il doit y avoir une seule période index par ID
      addError("Il y a plusieurs périodes index pour un même individu. Le nombre d'observations de 'dt' doit être égale au nombre d'individus.", check)
    if(nrow(dt[DebutIndex > FinIndex]))  # il ne doit pas y avoir de date de début plus grande qu'une date de fin
      addError("dt : au moins une date de début est plus grande que la date de fin.", check)
    finishArgCheck(check)
    return(dt[, .(ID, DebutIndex, FinIndex)])
  }
  ### Vérification des arguments de la fonction
  .verif_args <- function(database, dt, ID, DebutIndex, FinIndex, method){
    check <- newArgCheck()
    if(!is.data.frame(dt))  # dt doit être un tableau
      addError("'dt' n'est pas de type data.frame.", check)
    if(!is.character(DebutIndex))  # nom de la colonne = character
      addError("'DebutIndex' n'est pas de type character.", check)
    if(!is.null(FinIndex) && !is.character(FinIndex))  # nom de la colonne facultative = character
      addError("'FinIndex' n'est pas de type character.", check)
    if(!method %in% c(1, 2))
      addError("Les valeurs permises de 'method' sont 1 ou 2.", check)
    finishArgCheck(check)
    if(!DebutIndex %in% names(dt))  # DebutIndex doit être une colonne de dt
      addError(paste0(DebutIndex," (DebutIndex) n'est pas le nom d'une colonne de dt."), check)
    if(!is.null(FinIndex) && !FinIndex %in% names(dt))  # FinIndex doit être une colonne de dt
      addError(paste0(FinIndex, " (FinIndex) n'est pas le nom d'une colonne de dt."), check)
    finishArgCheck(check)
  }

# Code --------------------------------------------------------------------------------------------

  .verif_args(database, dt, ID, DebutIndex, FinIndex, method)  # vérifier valeurs des arguments
  if(!is.data.table(dt)) dt <- as.data.table(dt) else dt <- copy(dt)  # dt doit être un data.table
  dt <- .dt_selectCols(dt, DebutIndex, FinIndex)  # sélectionner + renommer + convertir
  setkey(dt, ID)
  dt_admis <- import_struct(  # créer la base de données indiquant l'admissibilité des individus
    database = database,  # type de la base de données
    DebutEtude = min(dt$DebutIndex),  # date début index la plus vieille = début
    FinEtude = max(dt$FinIndex),  # date fin index la plus récente = fin
    id_list = sunique(dt$ID)
  )
  dt_index <- copy(dt)  # conserver le dataset initial pour plus tard
  dt <- merge(dt, dt_admis, by = "ID")  # ajouter les périodes d'admissibilité aux périodes index
  dt <- dt[DebutIndex <= DFP & FinIndex >= DDP]  # conserver les périodes qui se chevauchent
  dt[DDP < DebutIndex, DDP := DebutIndex]  # ajuster les dates qui sont à l'extéreur de l'intervalle index
  dt[DFP > FinIndex, DFP := FinIndex]
  dt <- rbind(  # ajouter les ID qui n'ont pas de périodes admissibles
    dt, dt_index[!ID %in% dt$ID],
    fill = TRUE
  ); rm(dt_index, dt_admis)  # supprimer datasets qui ne sont plus utilisés
  dt[, DDsuivi_Idx := DebutIndex][DDN > DebutIndex, DDsuivi_Idx := DDN]  # dates de suivi - selon naissance/décès
  dt[, DFsuivi_Idx := FinIndex][DDC < FinIndex, DFsuivi_Idx := DDC]
  dt[, Dentree_Idx := DDsuivi_Idx][DDP > DDsuivi_Idx, Dentree_Idx := DDP]  # dates entree et sortie - selon admissibilité
  dt[, Dsortie_Idx := DFsuivi_Idx][DFP < DFsuivi_Idx, Dsortie_Idx := DFP]
  dt[, NJRSadmis_Idx := as.integer(DFP - DDP + 1)]  # nbre de jours admis
  dt[, `:=` (Dentree_Idx = min(Dentree_Idx),
             Dsortie_Idx = max(Dsortie_Idx),
             NJRSadmis_Idx = sum(NJRSadmis_Idx)),
     .(ID)]
  dt[, Enais_Idx := FALSE][Dentree_Idx == DDN, Enais_Idx := TRUE]  # si naissance durant période
  dt[, Sdc_Idx := FALSE][Dsortie_Idx == DDC, Sdc_Idx := TRUE]  # si décès durant période
  dt[, NJRSpotentiel_ES_Idx := as.integer(Dsortie_Idx - Dentree_Idx + 1)]  # nbre jours potentiel
  dt[, Admis_Continue_ES_Idx := FALSE][NJRSadmis_Idx == NJRSpotentiel_ES_Idx, Admis_Continue_ES_Idx := TRUE]  # si admis en continue
  dt[, NJRSpotentiel_Suivi_Idx := as.integer(DFsuivi_Idx - DDsuivi_Idx + 1)]  # nbre de jours de suivi
  dt[, Admis_Continue_Suivi_Idx := FALSE][NJRSadmis_Idx == NJRSpotentiel_Suivi_Idx, Admis_Continue_Suivi_Idx := TRUE]  # si admis continue par rapport au suivi
  dt[, NJRSpotentiel_Idx := as.integer(FinIndex - DebutIndex + 1)]  # nbre de jours d'index
  dt[, Admis_Continue_Idx := FALSE][NJRSadmis_Idx == NJRSpotentiel_Idx, Admis_Continue_Idx := TRUE]  # si admis continue par rapport à l'étude
  col_order <- c(  # ordre des colonnes souhaité
    "ID", "SEXE", "DDN", "DDC", "DDsld",  # infos sur ID
    "DebutIndex", "FinIndex", "NJRSpotentiel_Idx",  # infos période index
    "DDP", "DFP", "NJRSadmis_Idx", "Admis_Continue_Idx",  # infos périodes admis + admis en continue sur index
    "DDsuivi_Idx", "DFsuivi_Idx", "NJRSpotentiel_Suivi_Idx", "Admis_Continue_Suivi_Idx",  # infos sur période suivi + admis en continue
    "Dentree_Idx", "Dsortie_Idx", "NJRSpotentiel_ES_Idx", "Admis_Continue_ES_Idx",  # infos sur période entree-sortie
    "Enais_Idx", "Sdc_Idx"  # indiquer si né ou décédé durant la période index
  )
  setcolorder(dt, col_order)  # appliquer nouvel ordre des colonnes
  if(method == 1){  # si on veut une ligne par individu - jours où ID admissible par important
    dt[, `:=` (DDP = NULL,  # supprimer les périodes non nécessaires
               DFP = NULL)]
    dt <- unique(dt)  # 1 ligne par ID
  }
  return(dt)
}