data-prod/Etudes_Cas/Obj2_Age_SEXE_AFxxxx.R

In INESSS-QC/admissibilite1: Admissibilité des individus

library(admissibilite1)
library(data.table)
library(lubridate)
library(writexl)


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

Grp_Age <- function(.data, AF, group_age){
  ### À partir du dataset créé par admis_analyse(), insère l'âge d'un ID au 1er avril de l'année analysée
  ### Âge = nbre semaines (1er avril - DateNaissance) / 52 -> integer
  ### @.data : dataset créé par admis_analyse()
  ### @AF : Année financière d'analyse
  ### @group_age : vecteur indiquant les classes -> c(0,20,40,60) = [0,20[, [20,40[, [40,60[
  if(!is.integer(AF)) AF <- as.integer(AF)  # convertir en INT au besoin
  if(!is.data.table(.data)) dt <- as.data.table(.data) else dt <- copy(.data); rm(.data)  # dt = dataset d'analyse
  dt[, Age := as.integer(difftime(as_date(paste0(AF,"-04-01")), DDN, units = "weeks") / 52)]  # indiquer âge au 1er avril
  dt[, CatAge := cut(Age, breaks = group_age, right = FALSE)]  # créer groupe d'âge
  return(dt)
}
obj2_GrpAge_Sexe <- function(.data){
  ### Copier les conditions de la fonction admis_analyse2(), mais en tenant compte des groupes d'âge
  x <- copy(.data); rm(.data)
  data_cols <- attr(x, "data_cols")
  DebutEtude <- attr(x, "DatesEtude")$Debut  # extraire les dates d'étude de la fonction précédente
  FinEtude <- attr(x, "DatesEtude")$Fin
  nID <- uniqueN(x[[data_cols$ID]])
  # N_debut_etude
  N_debut_etude <- x[
    Dentree == DebutEtude,
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_debut_etude_nonsld
  N_debut_etude_nonsld <- x[
    Dentree == DebutEtude  # admissible au début
    & (is.na(get(data_cols$DateSLD))  # pas de date sld
       | get(data_cols$DateSLD) > DebutEtude),  # ou sld après debut d'étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_fin_etude
  N_fin_etude <- x[
    Dsortie == FinEtude,
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_debut_fin
  N_debut_fin <- x[
    Dsortie == FinEtude  # admissible à la fin
    & Dentree == DebutEtude,  # et au début
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_admis_etude_continue
  N_admis_etude_continue <- x[
    Admis_Continue_Etude == TRUE,
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_naissance
  N_naissance <- x[
    get(data_cols$DateNais) > DebutEtude  # naissance durant la période d'étude
    & Dentree > DebutEtude  # est devenu admissible durant l'étude
    & Dsortie == FinEtude,  # et l'est encore à la fin
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_deces
  N_deces <- x[
    get(data_cols$DateDeces) <= FinEtude  # décès avant la fin de l'étude
    & Dentree == DebutEtude,  # admissible au début
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_entree_autre
  N_entree_autre <- x[
    get(data_cols$DateNais) <= DebutEtude  # naissance avant l'étude = est vivant
    & Dentree > DebutEtude  # inadmissible au début, mais le devient par la suite
    & Dsortie == FinEtude,  # est admissible à la fin de l'étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_sortie_autre
  N_sortie_autre <- x[
    Dentree == DebutEtude  # admissible début étude
    & Dsortie < FinEtude  # inadmissible avant fin étude
    & (is.na(get(data_cols$DateDeces))  # n'est pas mort
       | get(data_cols$DateDeces) > FinEtude),  # mort après la fin de l'étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_sld
  N_sld <- x[
    Dentree == DebutEtude  # admissible au début de l'étude
    & get(data_cols$DateSLD) > DebutEtude & get(data_cols$DateSLD) <= FinEtude,  # a reçu des soins durant la période d'étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_fin_etude_nonsld
  N_fin_etude_nonsld <- x[
    Dsortie == FinEtude
    & (is.na(get(data_cols$DateSLD))
       | get(data_cols$DateSLD) > FinEtude),
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_debut_fin_nonsld
  N_debut_fin_nonsld <- x[
    Dsortie == FinEtude  # admissible à la fin
    & Dentree == DebutEtude  # et au début
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_admis_etude_continue_nonsld
  N_admis_etude_continue_nonsld <- x[
    Admis_Continue_Etude == TRUE  # admissible en continue
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_naissance_nonsld
  N_naissance_nonsld <- x[
    get(data_cols$DateNais) > DebutEtude  # naissance durant la période d'étude
    & Dentree > DebutEtude  # est devenu admissible durant l'étude
    & Dsortie == FinEtude  # et l'est encore à la fin
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_deces_nonsld
  N_deces_nonsld <- x[
    get(data_cols$DateDeces) <= FinEtude  # décès avant la fin de l'étude
    & Dentree == DebutEtude  # admissible au début
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_entree_autre_nonsld
  N_entree_autre_nonsld <- x[
    get(data_cols$DateNais) <= DebutEtude  # naissance avant l'étude = est vivant
    & Dentree > DebutEtude  # inadmissible au début, mais le devient par la suite
    & Dsortie == FinEtude  # est admissible à la fin de l'étude
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]
  # N_sortie_autre_nonsld
  N_sortie_autre_nonsld <- x[
    Dentree == DebutEtude  # admissible début étude
    & Dsortie < FinEtude  # inadmissible avant fin étude
    & (is.na(get(data_cols$DateDeces)) | get(data_cols$DateDeces) > FinEtude)  # pas mort durant l'étude
    & (is.na(get(data_cols$DateSLD)) | get(data_cols$DateSLD) > FinEtude),  # pas de sld durant étude
    .(Nbre = .N), keyby = .(CatAge, SEXE)
  ]


  # Résultat
  tab_result <- list(
    N_debut_etude = N_debut_etude,
    N_debut_etude_nonsld = N_debut_etude_nonsld,
    N_fin_etude = N_fin_etude,
    N_debut_fin = N_debut_fin,
    N_admis_etude_continue = N_admis_etude_continue,
    N_naissance = N_naissance,
    N_deces = N_deces,
    N_entree_autre = N_entree_autre,
    N_sortie_autre = N_sortie_autre,
    N_sld = N_sld,
    N_fin_etude_nonsld = N_fin_etude_nonsld,
    N_debut_fin_nonsld = N_debut_fin_nonsld,
    N_admis_etude_continue_nonsld = N_admis_etude_continue_nonsld,
    N_naissance_nonsld = N_naissance_nonsld,
    N_deces_nonsld = N_deces_nonsld,
    N_entree_autre_nonsld = N_entree_autre_nonsld,
    N_sortie_autre_nonsld = N_sortie_autre_nonsld
  )
  tab_result <- rbindlist(lapply(names(tab_result), function(var){
    dt <- tab_result[[var]]
    dt[, Ratio := Nbre / nID]  # ratios par rapport au nombre de ID
    dt[, nID := eval(nID)]  # indiquer nombre de ID
    dt[, Variable := var]  # indiquer variable
    dt[, Nbre_age := sum(Nbre), .(CatAge)]  # Nbre par âge sans le sexe
    dt[, Ratio_age := Nbre_age / nID]  # ratio par âge
    dt <- dt[, .(Variable, CatAge, Sexe = SEXE, Nbre, Ratio, Nbre_age, nID)]  # sélection des colonnes + ordre
    return(dt)
  }))
  return(tab_result)
}


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

fromAF <- 2007; toAF <- 2016  # les années à analyser
list_result <- list()  # où stocker les résultats
# Construire une table indiquant les sexes de chaque ID
RQAM <- readRDS("V:/GI-Data/_ADMIS/R data/Données Brutes/cohorte_admis_RQAM_2020-01-28.rds")
tab_sexe <- unique(RQAM[, .(ID, SEXE)])

for(AF in fromAF:toAF){
  DT <- import_struct(  # dataset contenant les observations nécessaires
    database = "RQAM",  # base de données à utiliser
    DebutEtude = paste0(AF,"-04-01"), FinEtude = paste0(AF+1,"-03-31"),  # date de début et de fin -> fin = debut
    id_list = NULL  # tous les ID
  )
  obj1 <- admis_analyse(DT)
  list_result[[paste(AF)]] <- list(Obj1 = obj1)  # stocker les résultats dans la liste
}

# Modifier les datasets pour ajouter l'age et le sexe
dt_rqam <- lapply(names(list_result), function(an_fin){  # indiquer le nombre d'observations par CatAge+Sexe pour chaque année
  dt <- list_result[[an_fin]]$Obj1  # sélection de l'année
  dt_attr <- list(  # conserver les attributs pcq merge() les supprime
    data_cols = attr(dt, "data_cols"),  # nom des colonnes
    DatesEtude = attr(dt, "DatesEtude")  # dates d'étude
  )
  dt <- merge(dt, tab_sexe, by = "ID", all.x = T)  # ajouter les sexes
  attr(dt, "data_cols") <- dt_attr$data_cols  # remettre les attributs
  attr(dt, "DatesEtude") <- dt_attr$DatesEtude
  dt <- Grp_Age(.data = dt, AF = an_fin, group_age = seq(0, 200, 5))  # indiquer Age+Catage
  dt <- obj2_GrpAge_Sexe(.data = dt)  # indiquer nombre d'obs
  return(dt)
})

names(dt_rqam) <- names(list_result)  # nommer les éléments : chaque élément est une année
write_xlsx(dt_rqam,  # export EXCEL
           paste0("V:/GI-Data/_ADMIS/Résultats Analyse/RQAM_Obj2_AFsep2007-2016_Age-Sexe_",  # répertoire
                  Sys.Date(),  # indiquer date
                  ".xlsx"))  # extension