data-prod/Etudes_Cas/Obj2_GrpAge.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 <- 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)
  ]
  # 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)
  ]
  # N_fin_etude
  N_fin_etude <- x[
    Dsortie == FinEtude,
    .(Nbre = .N), keyby = .(CatAge)
  ]
  # N_debut_fin
  N_debut_fin <- x[
    Dsortie == FinEtude  # admissible à la fin
    & Dentree == DebutEtude,  # et au début
    .(Nbre = .N), keyby = .(CatAge)
  ]
  # N_admis_etude_continue
  N_admis_etude_continue <- x[
    Admis_Continue_Etude == TRUE,
    .(Nbre = .N), keyby = .(CatAge)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]
  # 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)
  ]


  # 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]
    dt <- dt[, .(Variable, CatAge, Nbre, Ratio, nID)]
    return(dt)
  }))
  return(tab_result)
}

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

### Années financières séparées
# RQAM
RQAMsep <- readRDS("V:/GI-Data/_ADMIS/R data/Etudes_Cas/EtudeA_RQAM_AFsep2007-2016_2020-01-31.rds")
dt_rqam <- lapply(names(RQAMsep), function(an_fin){
  dt <- RQAMsep[[an_fin]]$Obj1
  dt <- Grp_Age(.data = dt, AF = an_fin, group_age = seq(0,200,5))
  dt <- obj2_GrpAge(.data = dt)
})
names(dt_rqam) <- names(RQAMsep)
write_xlsx(dt_rqam,
           paste0("V:/GI-Data/_ADMIS/Résultats Analyse/RQAM_Obj2_AFsep2007-2016_GrpAge_",Sys.Date(),".xlsx"))
# RPAM - selon âge 65,66,67,68,69,70,75,80,85,90+
RPAMsep <- readRDS("V:/GI-Data/_ADMIS/R data/Etudes_Cas/EtudeA_RPAM_AFsep2007-2016_2020-03-02.rds")
dt_rpam <- lapply(names(RPAMsep), function(an_fin){
  dt <- RPAMsep[[an_fin]]$Obj1
  dt <- Grp_Age(.data = dt, AF = an_fin, group_age = c(0, 65:70, 75, 80, 85, 90, 999))
  dt <- obj2_GrpAge(.data = dt)
})
names(dt_rpam) <- names(RPAMsep)
write_xlsx(dt_rpam,
           paste0("V:/GI-Data/_ADMIS/Résultats Analyse/RPAM_Obj2_AFsep2007-2016_GrpAge_",Sys.Date(),".xlsx"))
# RPAM - selon <65 ou >= 65
RPAMsep <- readRDS("V:/GI-Data/_ADMIS/R data/Etudes_Cas/EtudeA_RPAM_AFsep2007-2016_2020-03-02.rds")
dt_rpam <- lapply(names(RPAMsep), function(an_fin){
  dt <- RPAMsep[[an_fin]]$Obj1
  dt <- Grp_Age(.data = dt, AF = an_fin, group_age = c(0, 65, 999))
  dt <- obj2_GrpAge(.data = dt)
})
names(dt_rpam) <- names(RPAMsep)
write_xlsx(dt_rpam,
           paste0("V:/GI-Data/_ADMIS/Résultats Analyse/RPAM_Obj2_AFsep2007-2016_GrpAge0-65-max_",Sys.Date(),".xlsx"))

# RPAM - selon âge au 5 ans
RPAMsep <- readRDS("V:/GI-Data/_ADMIS/R data/Etudes_Cas/EtudeA_RPAM_AFsep2007-2016_2020-03-02.rds")
dt_rpam <- lapply(names(RPAMsep), function(an_fin){
  dt <- RPAMsep[[an_fin]]$Obj1
  dt <- Grp_Age(.data = dt, AF = an_fin, group_age = seq(0, 999, 5))
  dt <- obj2_GrpAge(.data = dt)
})
names(dt_rpam) <- names(RPAMsep)
write_xlsx(dt_rpam,
           paste0("V:/GI-Data/_ADMIS/Résultats Analyse/RPAM_Obj2_AFsep2007-2016_GrpAge-au5ans_",Sys.Date(),".xlsx"))