R/SQL_cohorte_RQAM.R

In INESSS-QC/admissibilite1: Admissibilité des individus

#' Extraction
#'
#' Permet d'extraire la cohorte de base avec toutes les periodes d'asmissibilités et inadmissibilités de tous les adhérants du régime assurance maladie.
#'
#' Le résultat est une table de la cohorte de base qui va sevir à deteminer par la suite les periodes d'admissibilité au cours de la période d'étude,  on pourrait également voir le nombre de personnes exclues et la raison d'exclusion dans des messages séparés (M0 à M6) dans la console.
#'
#' @param user Identification de l'usager.
#' @param DebutExtraction,FinExtraction "AAAA-MM-JJ". Dates de début et de fin de l'étude.
#' @param savefile Répertoire où enregistrer le résultat se terminant par */nom_du_fichier.rds*. Inscrire `FALSE` si la sauvegarde n'est pas nécessaire.
#' @param statement Source de données machine.
#' @param database Database sur le serveur. Peut être `NULL`.
#'
#' @import data.table
#' @importFrom odbc odbc
#' @importFrom DBI dbGetQuery
#' @importFrom lubridate as_date
#' @importFrom askpass askpass
#' @export
SQL_cohorte_RQAM <- function(
  user,  # idenfication de l'usager
  DebutExtraction, FinExtraction,  # dates d'extraction
  savefile = FALSE,
  statement = "PEI_PRD",
  database = "ESPA_TRAV_16"
){

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

  .verif_args <- function(user, pwd, DebutExtraction,FinExtraction,statement, database){
    ### Vérification des arguments s'ils ont le type de variable requis pour qu'il n'y ait pas
    ### d'erreur dans la fonction. Si le type de variable n'est pas bon, renvoie une erreur.
    if(!is.character(user))
      stop("'user' n'est pas de type CHARACTER.")
    if(!is.character(pwd))
      stop("'pwd' n'est pas de type CHARACTER.")
    if(is.na(as_date(DebutExtraction)))
      stop("'DebutExtraction' n'est pas sous la forme 'AAAA-MM-JJ'.")
    if(is.na(as_date(FinExtraction)))
      stop("'FinExtraction' n'est pas sous la forme 'AAAA-MM-JJ'.")
    if(!is.character(statement))
      stop("'statement' n'est pas de type CHARACTER.")
    if(!is.null(database))
      if(!is.character(database))
        stop("'database' n'est pas de type CHARACTER.")
  }

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

  pwd <- askpass("Entrer votre mot de passe :")
  .verif_args(user, pwd, DebutExtraction,FinExtraction, database,statement)  # vérification des arguments


  DT<- dbGetQuery(  # extraction - requête SQL
    .connexion(statement, user, pwd, database),
    paste0( "

              SELECT BENF_NO_INDIV_BEN_BANLS AS ID,
                     BENF_COD_SEXE AS SEXE,
                     BENF_DAT_NAISS AS DDN,
                     POST_MORTEM,
                     BENF_DAT_DECES AS DDC,
                     BENF_DD_DERN_ADMIS_RAM AS DDP,
                     BENF_DF_DERN_ADMIS_RAM AS DFP,
                     'V_FICH_ID_BEN_CM' AS VUE_SRC,
                     case when ID is not null then cast ('",DebutExtraction,"' as Date) end as DDextract,
                     case when ID is not null then cast ('",FinExtraction,"' as Date) end  as DFextract
              FROM PROD.V_FICH_ID_BEN_CM
              LEFT JOIN (SELECT SHOP_NO_INDIV_BEN_BANLS AS BEN,
                         MIN(SHOP_DAT_ADMIS_SEJ_HOSP) AS POST_MORTEM,
                         'RES_SSS.V_SEJ_HOSP_CM' AS VUE_SRC
                         FROM RES_SSS.V_SEJ_HOSP_CM
                         WHERE SHOP_TYP_SOIN_SEJ_HOSP=29
                         GROUP BY BEN) AS V_SEJ
              ON ID=V_SEJ.BEN" # code de la requête SQL

    )

  )
  DT <- as.data.table(DT)# convertir en data.table
  DT[,ID:=as.integer(ID)]  #transformer ID en integer au lieu de numeric
  DT<-DT[,`:=`(DDC=pmin(DDC,POST_MORTEM,na.rm=T))]#ajuster date de deces
  M0<-paste0("nombre totale de personnes dans V_FICHE=", nrow(DT))
  #exclure les personnes avec DDfiche= NA & DFfiche = NA
  idx<-DT[,.I[is.na(DDP) & is.na(DFP)]]
  M1<-paste0("Nombre de personnes avec DDfiche= NA & DFfiche = NA = ",length(idx))
  DT<-DT[!idx,]
  #exclure les personnes avec DFP< DDN
  idx<-DT[,.I[DFP< DDN]]
  M2<-paste0("Nombre de personnes avec date de fin de période < date de naissance= ",length(idx))
  DT<-DT[!idx,]
  #exclure les personnes avec DDC ≤ DDextract
  idx<-DT[,.I[!is.na(DDC) & DDC<=DDextract]]
  M3<-paste0("Nombre de personnes avec date de décès <= date de début d'extraction= ",length(idx))
  DT<-DT[!idx,]
  #exclure les personnes avec DDN>DFextract
  idx<-DT[,.I[DDN>DFextract ]]
  M4<-paste0("Nombre de personnes avec date de naissance > date de début d'extraction= ",length(idx))
  DT<-DT[!idx,]

  #exclure les personnes avec DFP<DDextract
  idx<-DT[,.I[DFP< DDextract]]
  M5<-paste0 ("Nombre de personnes avec date de fin de periode < date de début de début d'extraction= ",length(idx)) #0
  DT<-DT[!idx,]

  #enlever colomnes inutiles
  DT<-DT[,POST_MORTEM:=NULL]
  DT<-DT[,PER_ADMIS:=1L]

  setcolorder(DT,c("ID","SEXE","DDN","DDC","DDP","DFP","PER_ADMIS","DDextract","DFextract", "VUE_SRC"))

  ADMIS<-dbGetQuery(.connexion(statement, user, pwd, database), paste0("

                               SELECT BENF_NO_INDIV_BEN_BANLS as ID,
                               BENF_DD_ADMIS_BEN as DDP,
                               BENF_DF_ADMIS_BEN AS DFP,
                               'V_ADMIS_BEN_CM' AS VUE_SRC,
                               CAST(BENF_COD_CLA_SITU_ADMIS AS INT) AS CODE,
                               CASE WHEN BENF_COD_CLA_SITU_ADMIS in (00,05) THEN 0 else 1 end as PER_ADMIS
                               FROM PROD.V_ADMIS_BEN_CM
                               WHERE BENF_COD_CLA_SITU_ADMIS in (01,02,03,00,05)

                               AND BENF_DF_ADMIS_BEN> '",DebutExtraction,"'
                               AND BENF_DD_ADMIS_BEN <'",FinExtraction,"'
                               order by 1,2"))
  ADMIS<-as.data.table(ADMIS)
  ADMIS[,ID:=as.integer(ID)]
  ADMIS<-merge(DT[DDP>DDextract,.(ID,SEXE,DDN,DDC,DDextract,DFextract)],ADMIS,by="ID")
  setcolorder(ADMIS,c("ID", "SEXE" ,"DDN","DDC","DDP","DFP", "PER_ADMIS","DDextract","DFextract", "VUE_SRC", "CODE"))

  DT <- DT[, `CODE` := as.integer(999)] # afin de pouvoir utiliser funion(). CODE 999 = NA.

  dt<-funion(DT,ADMIS)
  idx<-dt[,.I[DDP> DFextract]]
  M6<-paste0("Nombre de lignes avec dates de debut de période > date de fin d'extraction après rajout de V_ADMIS= ",length(idx))
  dt<-dt[!idx,]

  setorder(dt,ID,DDP)


  attr(dt, "initial_cols") <- list(  # inscrire le nom initial de chaque colonne. Utile pour possibles vérifications suivant l'extraction
    ID = "BENF_NO_INDIV_BEN_BANLS",
    SEXE = "BENF_COD_SEXE",
    DDN = "BENF_DAT_NAISS",
    DDC = "BENF_DAT_DECES",
    DDP = "BENF_DD_DERN_ADMIS_RAM/BENF_DD_ADMIS_BEN",
    DFP = "BENF_DF_DERN_ADMIS_RAM/BENF_DF_ADMIS_BEN"
  )
  attr(dt, "date_extraction")<-Sys.time()

  #### mettre `DDextract` et `DFextract` en attribut au lieu de variable.
  attr(dt, "dates_extract") <- list(
    debut = DebutExtraction,
    fin = FinExtraction
  )
  dt[, c("DDextract", "DFextract"):=NULL]
  ####

  dt$CODE[dt$CODE == 999] <- NA # transformer la valeur créee 999 en NA (sa véritable `valeur`)

  if(is.character(savefile))  # sauvegarder DT sur le disque dur
    saveRDS(dt, savefile)
  print(c(M0,M1,M2,M3,M4,M5,M6))
  return(dt)

}