R/SQL_cohorte_RPAM.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 médicament.
#'
#' Le résultat est une table de la cohorte de base qui va servir à 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 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_RPAM <- 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

  FIPA<- 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,
                    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
                       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

  )

  FIPA<-as.data.table(FIPA)
  #transformer ID en integer au lieu de numeric
  FIPA[,ID:=as.integer(ID)]
  #ajuster date de deces
  FIPA<-FIPA[,`:=`(DDC=pmin(DDC,POST_MORTEM,na.rm=T))]

  #enlever colomnes inutiles
  FIPA<-FIPA[,POST_MORTEM:=NULL]
  M0<-paste("Nombre totale dans personne dans FIPA=",nrow(FIPA))

  DT<-dbGetQuery(
    .connexion(statement, user, pwd, database),
    paste0("
            SELECT DISTINCT BENF_NO_INDIV_BEN_BANLS AS ID,
                            BENF_DD_PLAN_MED_BEN as DDP,
									          BENF_DF_PLAN_MED_BEN as DFP,
									          'V_PLAN_MED_BEN_CM' AS VUE_SRC,
									          CAST(BENF_COD_PLAN AS INT) AS CODE,
									          CASE WHEN BENF_COD_PLAN in(96,97,98) THEN 0 ELSE 1
									          END as PER_ADMIS
            FROM PROD.V_PLAN_MED_BEN_CM
            where BENF_DD_PLAN_MED_BEN < '",FinExtraction,"'
                 AND BENF_DF_PLAN_MED_BEN>'",DebutExtraction,"'
                 AND BENF_COD_PLAN IN (96,97,98,10,11,12,13,14,15,16,17,18,20,21,22,23,30,31,32,33)
            UNION

            SELECT DISTINCT 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 (20,05,19) THEN 0 ELSE 1
									          END AS PER_ADMIS
            from PROD.V_ADMIS_BEN_CM
            where BENF_DD_ADMIS_BEN < '",FinExtraction,"'
            AND BENF_DF_ADMIS_BEN> '",DebutExtraction,"'
            AND BENF_COD_CLA_SITU_ADMIS in (05,20,21,22,19)

            UNION

            SELECT DISTINCT
                          BENF_NO_INDIV_BEN_BANLS AS ID,
                          BENF_DD_ADMIS_ASSU_MED as DDP,
                          BENF_DF_ADMIS_ASSU_MED as DFP,
                          'PLAN_PRIOR_CM' AS VUE_SRC,
                          CAST(999 AS int) AS CODE,
                          CASE WHEN BENF_IND_ADMIS_ASSU_MED='N'THEN 0 ELSE 1
                          END AS PER_ADMIS
                          from   PROD.V_ADMIS_ASSU_MED_PLAN_PRIOR_CM
                          where BENF_DD_ADMIS_ASSU_MED < '",FinExtraction,"'
                          AND BENF_DF_ADMIS_ASSU_MED> '",DebutExtraction,"'
                          order BY 1,2 "))
  DT<-as.data.table(DT)
  DT[,ID:=as.integer(ID)]
  ADMIS<-merge(DT,FIPA,by="ID",all.x=T)
  setcolorder(ADMIS,c("ID", "SEXE" ,"DDN","DDC","DDP","DFP", "PER_ADMIS","DDextract","DFextract", "VUE_SRC", "CODE"))

  #enelever ceux qui n'existe pas dans FIPA
  idx<-ADMIS[,.I[is.na(SEXE)]]
  M1<-paste ("Nombre de personnes qui n'existent pas dans FIPA mais qui ont des enregistrements Rx=",uniqueN (ADMIS[idx,]$ID))
  ADMIS<-ADMIS[!idx,]

  #Exclure les situations impossibles : DFP < DDN

  idx<-ADMIS[,.I[DFP<DDN]]
  M2<-paste("nombre de lignes avec Date de fin de période < date de naissance",length(idx) )
  ADMIS<-ADMIS[!idx,]

  #exclure les personnes avec DDC ≤ DDExtraction
  idx<-ADMIS[,.I[!is.na(DDC) & DDC<=DDextract]]
  M3<-paste ("nombre de personnes avec décès <= date de début d'extraction=",uniqueN(ADMIS[idx,]$ID))
  ADMIS<-ADMIS[!idx,]

  #exclure les personnes avec DDN>DFextract
  idx<-ADMIS[,.I[DDN>DFextract ]]
  M4<-paste ("Nombre de personnes avec date de naissance > date fin extraction=",uniqueN(ADMIS[idx,]$ID))
  ADMIS<-ADMIS[!idx,]



  attr(ADMIS, "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_PLAN_MED_BEN/BENF_DD_ADMIS_BEN",
    DFP = "BENF_DD_PLAN_MED_BEN/BENF_DF_ADMIS_BEN"
  )
  attr(ADMIS, "date_extraction")<-Sys.time()

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

  ADMIS$CODE[ADMIS$CODE == 999] <- NA # transformer la valeur créee 999 en NA (sa véritable `valeur`)
  ADMIS$VUE_SRC[ADMIS$VUE_SRC == "PLAN_PRIOR_CM"] <- "V_ADMIS_ASSU_MED_PLAN_PRIOR_CM"

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

}