tests/tests-verifs/Exploration-DatesDeces.R

In INESSS-QC/admissibilite1: Admissibilité des individus

library(data.table)
library(lubridate)
library(stringr)
library(inesss)
library(writexl)

excel <- list()  # où stocker les résultats pour visualisation excel
# Importation du dataset
DT <- readRDS("V:/GI-Data/_ADMIS/R data/DECES_2020-01-07.rds")  # import
setkey(DT)  # tri
DT <- unique(DT)  # certaines obs sont double

# Nouvelles variables
DT[, ID := as.integer(ID)]  # convertir integer
# Indiquer âge et groupe d'âge au 15 janvier 2020
DT[, Age := as.integer(floor(difftime(as_date("2020-01-15"), DDN, units = "weeks") / 52.1429))]
DT[, CatAge := cut(Age, breaks = seq(0, max(Age)+5, 5), right = FALSE)]
# Indiquer si personne est vivante ou pas
DT[, Deces := TRUE]
DT[
  is.na(DECES_FIPA) & is.na(DECES_HOSPIT_AUTRE) & is.na(DECES_HOSPIT_POSTMORTEM),
  Deces := FALSE
]
### Description du dataset : 24 355 629 obs


### Extraire tous les ID qui n'ont pas d'information
###   - Pas de date de décès ni de date de service
idx <- DT[, .I[Deces == FALSE & is.na(DERNIER_SERVICE)]]  # numéro de lignes
#   Note code précédent : intersect entre idx et ceux qui ont seulement 1obs dans le cas où un ID
#   aurait une ligne sans info et une autre avec info. -> Ce n'est pas le cas en ce moment.
dt <- DT[idx]  # sélection des obs
IDs <- sunique(dt$ID)  # liste des ID présents - concorde avec nombre d'obs - cette ligne pourra être
                       # évité grâce à la note précédente : ID avec une seule obs
dt <- dt[, .N, keyby = .(CatAge)]  # indiquer nombre d'observations
dt[, Pourcent := round(N / sum(N) * 100, 2)]  # pourcentage des observations
dt[, CumPourcent := cumsum(Pourcent)]  # pourcentage cumulé
excel[["SansInfos"]] <- dt  # sauvegarder pour excel
DT <- DT[!idx]  # filtrer les cas gérés
any(IDs %in% sunique(DT$ID))  # vérifier si tous les cas d'un même ID sont gérés
                              # -> ce code sera aussi évité
### Description :
###     dt avant fréquence : 1 330 789 obs
###     DT après filtre : 23 024 840 obs


### Individus avec une ou des dates de service, mais sans date de décès.
### Afficher la dernière date de service
idx <- DT[, .I[Deces == FALSE]]  # numéro de ligne
dt <- DT[idx]  # sélection des obs
IDs <- sunique(dt$ID)
dt <- dt[  # conserver la dernière date de service par ID
  , .(DERNIER_SERVICE = max(DERNIER_SERVICE)),
  .(ID, CatAge)
]
dt[, nJours := as.integer(as_date("2020-01-15") - DERNIER_SERVICE)]  # nbre de jours depuis le service
summary(dt$nJours)
### -18022 jours -> dernier service = 2069-05-19
dt[, nAn := as.integer(floor(nJours / 365.25))]  # jours en années
summary(dt$nAn)
dt <- dt[, .(Freq = .N), keyby = .(nAn, CatAge)]  # tableau de fréquence
dt[, Freq_An := sum(Freq), .(nAn)]  # fréquence par année
dt[, Freq_An_p100 := round(Freq_An / sum(dt$Freq) * 100, 2), .(nAn)]  # pourcentage
Freq_An_p100_cum <- unique(dt[, .(nAn, Freq_An_p100)])  # ajouté % cumulé au tableau
Freq_An_p100_cum[, Freq_An_p100_cum := cumsum(Freq_An_p100)]
dt <- merge(dt, Freq_An_p100_cum[, .(nAn, Freq_An_p100_cum)], by = c("nAn"))
excel[["VivDernServ"]] <- dt
DT <- DT[!idx]  # filtrer cas
any(IDs %in% sunique(DT$ID))  # vérifier si tous les cas d'un même ID sont gérés
### Description :
###     dt avec plusieurs dernier service : 19 981 262
###     dt avec dernier service unique : 8 860 978
###     DT après filtre : 3 043 578


### On doit avoir une seule date de décès par variable
### Décider d'une méthode pour choisir entre deux dates pour une même variable
# FIPA
dt <- unique(DT[, .(ID, DECES_FIPA)])  # sélection des colonnes
dt[dt[, .I[.N > 1], .(ID)]$V1]  # vérifier si obs
### -> Méthode : Pas nécessaire
# Hospit Postmortem
dt <- unique(DT[, .(ID, DECES_HOSPIT_POSTMORTEM)])  # sélection colonnes
dt[dt[, .I[.N > 1], .(ID)]$V1]  # ID ayant plus d'une date de décès
dt <- dt[  # indiquer dates min et max de décès
  dt[, .I[.N > 1], .(ID)]$V1,  # sélection des lignes
  .(minDeces = min(DECES_HOSPIT_POSTMORTEM),  # dates min et max
    maxDeces = max(DECES_HOSPIT_POSTMORTEM)),
  .(ID)
]
dt[, nJours := as.integer(maxDeces - minDeces)]  # nbre de jours max - min
summary(dt$nJours)
### -> Méthode : utiliser le minimum
# Hospit
dt <- unique(DT[, .(ID, DECES_HOSPIT_AUTRE, DERNIER_SERVICE)])  # sélection des colonnes
dt <- dt[, .(DERNIER_SERVICE = max(DERNIER_SERVICE)), .(ID, DECES_HOSPIT_AUTRE)]  # indiquer service récent
dt[dt[, .I[.N > 1], .(ID)]$V1]  # vérifier ID avec plusieurs obs
dt <- dt[  # indiquer min et max date de décès
  dt[, .I[.N > 1], .(ID)]$V1,
  .(minDeces = min(DECES_HOSPIT_AUTRE),
    maxDeces = max(DECES_HOSPIT_AUTRE)),
  .(ID, DERNIER_SERVICE)
]
dt[, nJours_Deces := as.integer(maxDeces - minDeces)]  # nbre de jours max - min
summary(dt$nJours)
dt[, nJours_dern_service := as.integer(maxDeces - DERNIER_SERVICE)]  # nbre jours max - service
summary(dt$nJours_dern_service)
# -> Méthode : Combiner l'analyse de NJours_Deces (max - min) et nJours_der_service (max - service).
#               Si nJours_Deces <= (X où X est un nombre de jours)
#                   DECES_HOSPIT = mininimum
#               Sinon Si nJours_Deces > X & nJours_dern_service < nJours_Deces
#                   DECES_HOSPIT = maximum
#               Sinon
#                   !!! JE NE SAIS PAS !!! - À VOIR ***
dt <- unique(dt[, .(nJours_Deces, nJours_dern_service)])  # combinaison possibles
setorder(dt, -nJours_Deces)  # tri décroissant
excel[["CombnDecesHospit"]] <- dt  # save excel

# Appliquer méthode où X = 2 ans = 730. Il faudrait voir jusqu'à combien de temps il est vraisemblable
# de facturer des actes sur un mort dans le but d'utiliser une bonne valeur de X.
dt <- unique(DT[!is.na(DECES_HOSPIT_AUTRE), .(ID, DECES_HOSPIT_AUTRE, DERNIER_SERVICE)])  # sélection colonne
dt <- dt[, .(DERNIER_SERVICE = max(DERNIER_SERVICE)), .(ID, DECES_HOSPIT_AUTRE)]  # service le plus récent
dt <- dt[  # min et max date de décès
  , .(minDeces = min(DECES_HOSPIT_AUTRE),
      maxDeces = max(DECES_HOSPIT_AUTRE)),
  .(ID, DERNIER_SERVICE)
]
dt[, nJours_Deces := as.integer(maxDeces - minDeces)]  # nbre jours max - min
dt[, nJours_dern_service := as.integer(maxDeces - DERNIER_SERVICE)]  # nbre jours max - service
# Ajuster la date de décès selon méthode
dt[, DecesHospitAjust := minDeces]  # sélection du minimum
dt[  # si plus que 2 ans et max-Service < max-min -> maxDeces
  nJours_Deces > 730 & nJours_dern_service < nJours_Deces,
  DecesHospitAjust := maxDeces
]
DecesHospitAjust <- dt[, .(ID, DECES_HOSPIT_AUTRE = DecesHospitAjust)]  # tableau des décès hospit

### Reconstruire DT avec une seule date de décès par variable
Source_Dernier_Serv <- unique(DT[  # conserver les derniers services au cas où
  !is.na(DERNIER_SERVICE),
  .(ID, SOURCE_DERN_SERVICE, DERNIER_SERVICE)
])

DT <- DT[  # hospit postmortem -> sélection du minimum
  , .(DECES_HOSPIT_POSTMORTEM = min(DECES_HOSPIT_POSTMORTEM)),
  .(ID, DDN, DECES_FIPA)
]
DT <- merge(DT, DecesHospitAjust, by = "ID", all.x = TRUE)  # ajouter les deces hospit
DT <- merge(DT, Source_Dernier_Serv, by = "ID", all.x = TRUE)  # ajouter les Derniers services
###  -> Nous avons maintenant le même dataset initial, mais avec des dates de décès ajustées
### Description :
###     DT avec une date de décès par ID : 1 146 672
###     DT avec derniers services :


### Décès, mais sans dernier service
idx <- DT[, .I[is.na(DERNIER_SERVICE)], .(ID)]$V1  # no de lignes
length(idx)  # nbre de lignes
dt <- DT[idx]  # sélection des obs
# Indiquer la date de décès min et max
dt[
  , `:=` (minDeces = DECES_FIPA,
          maxDeces = DECES_FIPA)
][  # sélectionner postmortem si fipa absent
  is.na(minDeces),
  `:=` (minDeces = DECES_HOSPIT_POSTMORTEM,
        maxDeces = DECES_HOSPIT_POSTMORTEM)
][  # remplacer fipa par postmortem si plus petit
  DECES_HOSPIT_POSTMORTEM < minDeces, minDeces := DECES_HOSPIT_POSTMORTEM
][  # remplacer fipa par postmortem si plus grand
  DECES_HOSPIT_POSTMORTEM > maxDeces, maxDeces := DECES_HOSPIT_POSTMORTEM
][  # sélectionner hospit si fipa et postmortem absents
  is.na(minDeces),
  `:=` (minDeces = DECES_HOSPIT_AUTRE,
        maxDeces = DECES_HOSPIT_AUTRE)
][  # remplacer postmortem ou fipa par hospit si plus petit
  DECES_HOSPIT_AUTRE < minDeces, minDeces := DECES_HOSPIT_AUTRE
][  # remplacer postmortem ou fipa par hospit si plus grand
  DECES_HOSPIT_AUTRE > maxDeces, maxDeces := DECES_HOSPIT_AUTRE
][
  , nJours := as.integer(maxDeces - minDeces)  # nbre jours max - min
]
summary(dt$nJours)
DT <- DT[!idx]  # filtrer cas gérés
nrow(DT)


### Gérer les cas selon le nombre de variables qui indiquant la mort d'un individu
dt <- unique(DT[, .(ID, DDN, DECES_FIPA, DECES_HOSPIT_AUTRE, DECES_HOSPIT_POSTMORTEM)])
uniqueN(dt$ID); nrow(dt)
# Indiquer date de décès minimum et maximum
dt[
  , `:=` (minDeces = DECES_FIPA,
          maxDeces = DECES_FIPA)
][  # sélectionner postmortem si fipa absent
  is.na(minDeces),
  `:=` (minDeces = DECES_HOSPIT_POSTMORTEM,
        maxDeces = DECES_HOSPIT_POSTMORTEM)
][  # remplacer fipa par postmortem si plus petit
  DECES_HOSPIT_POSTMORTEM < minDeces, minDeces := DECES_HOSPIT_POSTMORTEM
][  # remplacer fipa par postmortem si plus grand
  DECES_HOSPIT_POSTMORTEM > maxDeces, maxDeces := DECES_HOSPIT_POSTMORTEM
][  # sélectionner hospit si fipa et postmortem absents
  is.na(minDeces),
  `:=` (minDeces = DECES_HOSPIT_AUTRE,
        maxDeces = DECES_HOSPIT_AUTRE)
][  # remplacer postmortem ou fipa par hospit si plus petit
  DECES_HOSPIT_AUTRE < minDeces, minDeces := DECES_HOSPIT_AUTRE
][  # remplacer postmortem ou fipa par hospit si plus grand
  DECES_HOSPIT_AUTRE > maxDeces, maxDeces := DECES_HOSPIT_AUTRE
][
  , nJours := as.integer(maxDeces - minDeces)  # nbre jours max - min
]
summary(dt$nJours)

dt <- dt[nJours > 30]  # obs ayant max - min > 30
nrow(dt)
dt <- merge(dt, Source_Dernier_Serv, all.x = TRUE)  # ajouter derniers services
dt <- dt[  # conserver le dernier service le plus récent
  , .(DERNIER_SERVICE = max(DERNIER_SERVICE)),
  .(ID, DDN, minDeces, maxDeces, nJours)
]
dt[, nJours_dernier_service := as.integer(maxDeces - DERNIER_SERVICE)]  # nbre jours max - service
dt <- unique(dt[, .(nJours, nJours_dernier_service)])  # combinaisons possibles
setorder(dt, -nJours)  # tri
excel[["CombnDecesTousDernServ"]] <- dt  # save excel


write_xlsx(  # sauvegarder les résultats dans fichier excel
  excel,
  "C:/Users/ms045/Desktop/Git/INESSS-admissibilite1/tests/tests-datas/Exploration_DatesDeces.xlsx"
)