Derniers pas de notre fonction de valorisation

Résumé des épisodes précédents

Nous avons écrit une fonction de valorsation utilisant ce prototype :

function(ghs, ds, bb, bh, ghsprix, forfait_exb = 0, exb, exh)

Cette fonction quelle que soit son implémentation est insensible à la variation de la table de GHS vu qu’on en extrait les données auparavant.

Dans l’avant dernier article nous avons aussi créé la fonction permettant de réaliser la valorisation directement depuis un RSA via RSA %>% valorise.ghs_df(GHSs), GHSs contenant les éléments permettant de lancer ensuite la fonction décrite plus haut.

Mais persistait un problème : nous n’appliquions pas le principe de l’arrêté tarifaire qui intervient le 1er mars tous les ans. Ainsi un séjour se terminant en janvier ou février est valorisé au tarif de l’année précédente et non selon les données des GHS de l’année PMSI.

Dans la mesure où c’est la dernière touche à notre exercice, je vais m’appliquer pour la définition des fonctions, paramètres etc afin que je puisse ne plus y revenir et capitaliser sur le travail fourni au long des derniers article (jusqu’à ce que le mode de valorisation change).

Pour la suite nous allons avoir besoin de quelques libraires :

library(dplyr)     # pour toute la logique relationnelle
library(tidyr)     # pour certaines sélections de colonnes
library(readr)     # pour lire le RSA et les csv
library(lubridate) # pour la manipulation de dates

Actualisons le RSA

Dans la précédente mouture, nous n’avions pas importé les données calendaires du RSA. Il va donc falloir modifier la fonction créant la data.frame RSA. J’en porfite pour en tirer une fonction réutilisable :

chargeRSA <- function(fichierRSA) {
  read_fwf(
    file          = fichierRSA,
    col_positions = fwf_cols(
      GHMIN   = c(31, 36),
      RGHMIN  = c(31, 35),
      SEVIN   = c(36, 36),
      GHMOUT  = c(42, 47),
      RGHMOUT = c(42, 46),
      SEVOUT  = c(47, 47),
      MOIS    = c(62, 63),
      ANNEE   = c(64, 67),
      GHS     = c(96, 99),
      DS      = c(71, 74),
      RAAC    = c(199, 199)
    ),
    col_types = list(
      col_character(),
      col_character(),
      col_character(),
      col_character(),
      col_character(),
      col_character(),
      col_number(),
      col_number(),
      col_number(),
      col_number(),
      col_character()
    )
  )
}

Il s’agit donc là de simplement rajouter la définition des 2 champs supplémentaires :

  • MOIS, situé sur 2 caractères en position 62 et 63 que nous allons interpréter comme un entier (i)
  • ANNEE, situé sur 4 caractères en position 64 et 67 que nous importons de même comme un entier.

(A noter qu’il n’y a pas de JOUR dans le RSA, pour participer à l’anonymisation partielle des séjours. Ca tombe bien, nous n’en avons pas besoin !)

Dans mon effort de propreté, j’ai mis à jour le paramètre col_types pour une version plus expressive. La fonctionnalité est cependant la même.

On peut donc charger notre RSA restreint, par exemple, par :

chargeRSA("~/R/000000001.2022.00.rsa")

Définissons l’année de valorisation

Nous pourions définir un nouveau champ anneeValo ainsi permettant de calculer le fichier annuel de GHS à utiliser :

RSA %>% mutate(anneeValo = as.character(ifelse(MOIS < 3, ANNEE - 1, ANNEE))) 

Mais le but n’est peut être pas de modifier le RSA. Nous y reviendrons donc plus tard.

Charger les bons GHS

Selon le ou les RSA que vous importez, il est possible de déterminer quels fichiers annuels de GHS il va falloir charger : Il faut charger ANNEE-1 et ANNEE en cas d’un RSA d’une seule année et en cas de RSA concaténés sur plusieurs années, on faudra les fichiers des années min(ANNEE)-1 à max(ANNEE)

Avec refpmsi

Si vous utilisez refpmsi, il est possible de spécifier en 2ème paramètre une année PMSI mais aussi un vecteur d’années PMSI.
Ainsi pour charger les années de 2020 à 2022, on peut faire :

refpmsi("ghs_public", 2020 : 2022)

le : permet de créer un vecteur de type entier contenant toutes les valeurs entre la 1ère et la 2nde par incrément de 1 (ou -1 si besoin).

Fort des 2 constatations ci-dessus, il nous faut donc utiliser refpmsi ainsi :

library(refpmsi)
refpmsi("ghs_public", (min(RSA$ANNEE)-1) : (max(RSA$ANNEE)))
# ou, si nous nous avons déjà calculé les années de valorisation :
refpmsi("ghs_public", unique(RSA$anneeValo))

Attention, il n’y a ni erreur ni warning si les données d’une ou plusieurs années ne sont pas disponible dans le référentiel.

Il restera ensuite à mettre en forme pour que les colonnes portent les noms attendus, soient aux bons formats (cf l’articles précédents) et rajouter ANNEE = annee_pmsi.

Directement depuis les fichiers ATIH

Cette méthode est bien plus intéressante et stimulante pour l’apprentissage de R. Elle va vous amener à réfléchir au stockage rationnel de vos données et surtout pour le moment de celles de référence.

La problématique ici est de charger l’ensemble des fichiers nécessaires à la valorisation. Nous avons vu dans l’article Il est l’hooore, mon seignooor (d’écrire une fonction de valorisation) où les récupérer sur le site de l’ATIH au format CSV.

Ranger les fichiers de façon pertinente.

Il convient, pour pouvoir y accéder, de ranger ces fichiers de façon logique et “sérialisable”.

J’ai pour ma part pris le parti de ranger l’ensemble de mes données d’export et de valorisation de cette façon :

  • Mes Documents (Sous Windows, R considère qu’il s’agit du répertoire racine par défaut, si vous écrivez “~/EXPORTS/REF/2022″ cela correspondra donc à “C:\Users\<nom d’utilisateur>\Documents\EXPORTS\REF\2022″
    • EXPORTS
      • SITE1 (…) : contenant les fichiers d’export du PMSI ainsi que les in.zip et out.zip mensuels
      • SITE2(…)
      • REF :
        • (Des fichiers de référentiels non datés comme par exemple les fichiers de l’inca ou les motifs de recours sfmu)
        • (C’est aussi ici que je mets les versions successives des fichiers LPP qui sont produits très régulièrement, un peu au fil de l’eau)
        • 20.. (1 répertoire par année PMSI)
        • 2022
          • OVALIDE
            • (Le contenu de l’archive ovalide.zip de l’année, récupérée sur le site de l’ATIH)
          • (Les autres fichiers nécessaires correspondant à l’année, ici 2022)

Ainsi, selon mon rangement, le fichier ghs ex-DG 2019 se trouve à “~/EXPORTS/REF/2019/ghs_pub.csv”

Cette organisation peut ne pas vous correspondre, il ne tient qu’à vous de choisir celle qui vous convient. Il faut juste garder à l’esprit de rester homogène afin de pouvoir bénéficier d’un accès facile et stéréotypé.

Généraliser la déduction du chemin d’accès

Si nous avons plusieurs années à charger (et si on respecte mon type de nommage) il faudra par exemple pour 2021 et 2022 charger “~/EXPORTS/REF/2021//ghs_pub.csv” et “~/EXPORTS/REF/2022/ghs_pub.csv”. Mais pour être polyvalent, il faut pouvoir automatiser cette tâche. Nous allons donc écrire une fonction qui crée un vecteur de chemins à partir d’un vecteur d’années :

Voici la version adaptée à ma façon de nommer mon arborescence :

genereChemin = function(fp, annees){
   lapply(annees, function(x){sub("%ANNEE%",x, fp)}) %>% as.character
}

> genereChemin("~/EXPORTS/REF/%ANNEE%", 2020 : 2022)
[1] "~/EXPORTS/REF/2020/" "~/EXPORTS/REF/2021/" "~/EXPORTS/REF/2022/"

Explication :

Nous créons une fonction attendant un chemin générique (à adapter à votre rangement) où l’endroit où se trouve l’année est marqué par %ANNEE% et un vecteur de données sensées représenter les années à charger.

A l’intérieur, nous utilisons un lapply() pour appliquer à chaque valeur du vecteur annees la fonction anonyme définie en 2ème paramètre. Celle-ci appelle exclusivement la fonction sub()qui sert à remplacer dans une chaine de caractères (ici fp, 3ème paramètre) un motif (ici “%ANNEE%”) par une valeur de remplacement (ici x, qui va à tour de rôle prendre les valeurs du vecteur annees grace au lapply()). Enfin, vu que le résultat d’un lapply() est une liste, nous la convertissons en vecteur de chaines de caractères (c’est juste pour faire plus propre).

Il nous reste à accrocher le nom du fichier par :

paste(genereChemin("~/EXPORTS/REF/%ANNEE%", 2020:2022), "ghs_pub.csv", sep="/")

On aurait bien sûr pu faire tout en un temps via :

fichiersGHSs <- genereChemin("~/EXPORTS/REF/%ANNEE%/ghs_pub.csv", 2020:2022)

Le seul intérêt de la 1ère solution est si vous avez besoin de récupérer plusieurs fichiers dans ces répertoires alors pour pouvez réutiliser le vecteur déjà créé en le rangeant dans une variable.

Charger les fichiers proprement dit

Nous avons donc un vecteur contenant les fichiers à charger, il ne nous manque plus qu’à réellement les importer dans notre environnement.

Nous allons utiliser la fonction read_csv2() de la librairie readr.

Dans l’article Il est l’hooore, mon seignooor (d’écrire une fonction de valorisation), nous avons utilisé un read_delim(). read_csv2() est une version préconfigurée sur certains items (revoyez le tableau dans l’article).

Toujours dans l’intention de faire propre, nous allons créer une fonction englobante que nous nommerons chargeGHSs() qui va utiliser directement genereChemin() afin de simplifier au maximum l’usage, ainsi en lui passant le RSA que nous allons étudier, la fonction va calculer et charger comme une grande l’ensemble des GHSs nécessaires.

Nous y rajoutons aussi un paramètre simplify qui par défaut est à FALSE mais peut être mis à TRUE et permet de contrôler si nous voulons dédoublonner les fichiers.

Ce dédoublonnage est impératif pour pouvoir faire les calculs de valorisation, mais peut être non désiré si vous voulez travailler sur les GHM et leurs libellés.

chargeGHSs <- function(rsa,fp,simplify = FALSE){
  t <- read_csv2(genereChemin(fp,seq(min(rsa$ANNEE)-1,max(rsa$ANNEE))),
            col_types = list(
              col_number(),
              col_character(),
              col_character(),
              col_character(),
              col_character(),
              col_number(),
              col_number(),
              col_number(),
              col_number(),
              col_number(),
              col_number(),
              col_date(format="%d/%M/%Y")),
            col_names = c("GHS", 
                          "CMD",
                          "DCS",
                          "GHM",
                          "LIB",
                          "BB",
                          "BH",
                          "GHSPRIX",
                          "FORFAIT_EXB",
                          "EXBPRIX",
                          "EXHPRIX",
                          "DEFFET"),
            skip = 1 # On saute une ligne, vu qu'on définit directement les noms de colonnes
  )
  if (simplify == TRUE){
  t <- t %>% group_by(GHS,DEFFET) %>% summarise(
              CMD = first(CMD),
              DCS = first(DCS),
              GHM = first(GHM),
              LIB = first(LIB),
              BB = first(BB),
              BH = first(BH),
              GHSPRIX = first(GHSPRIX),
              FORFAIT_EXB = first(FORFAIT_EXB),
              EXBPRIX = first(EXBPRIX),
              EXHPRIX = first(EXHPRIX),
              DEFFET = first(DEFFET)
            )
  }
 t %>% mutate(ANNEE = as.character(year(DEFFET)))
}

Le code est assez peu retouché (juste mis au propre avec une explicitation du col_types comme plus haut) car tant que le format de chaque fichier est identique, read_csv/read_delim() peut tout lire en une passe, cette fonction étant vectorisée sur le nom de fichier. Il a juste été rajouté l’étape de dédoublonnage qui consiste à grouper par GHS et DEFFET, et de ne prendre que les champs de la première ligne (group_by() / summarise() / first()).

A la différence de refpmsi, cette fonction génère une erreur si un fichier annuel est manquant. A titre personnel, je préfère car ainsi je sais que ce fichier manquant est une erreur bloquante pour la suite du traitement et qu’il me faut la corriger avant d’aller plus loin.

N’est-il pas écrit, mieux vaut pas de valorisation qu’une valorisation fausse ?

Lou-Tsé (selon la Voie de Madame Cosmopilite)

La seule étape supplémentaire est de récupérer l’année de la date d’effet. Pour cela, ci-dessus, nous avons configuré col_types pour qu’il convertisse directement le champ en Date. Il ne nous reste plus qu’à en extraire l’année. 2 possibilités s’offrent à nous :

# En utilisant la librairie lubridate
# pensez à ajouter library(lubridate)

(...) %>% mutate(ANNEE = as.character(year(DEFFET)))

# sans lubridate

(...) %>% mutate(ANNEE = format(DEFFET,"%Y"))

Dans le cas présent, j’ai utilisé lubridate, car manipulant des dates assez fréquemment, j’y suis habitué. Pour un si petit usage, c’est totalement superflu. (Je tenterai d’évoquer lubridate ou clock, les 2 librairies du tidyverse pour manipuler des dates, à l’occasion)

Nous récupérons donc un data.frame similaire au précédent mais avec un champ ANNEE en plus.

Croisons enfin !

Ayant enfin les données prêtes, nous pouvons croiser les données PMSI en précisant les 2 champs de jointure le numéro de GHS et l’année de valorisation.

RSA %>% left_join(GHSs, by=("GHS","anneeValo"="ANNEE))

Et… ça marche !

Nous pouvons alors adapter aussi notre fonction valorise.ghs_df() .

Rappel de la fonction valorise()

Je n’ai pas modifié la fonction valorise()des articles précédents. J’ai décidé d’utiliser ma version “ésotérique” :

valorise <- function(ghs, ds, bb, bh, ghsprix, forfait_exb = 0, exb, exh){
  dna = !is.na(ghsprix)
  dexb=  dna & (ds < bb) & (forfait_exb == 0)
  dexh = dna & (ds > bh) 
  dforfait = dna & (ds < bb) & (forfait_exb >= 0) 
  dghs = dna & (ds >= bb) & (ds <= bh)
  
  x<-double()
  x[!dna]      <- NA
  x[dghs]     <- ghsprix[dghs]
  x[dforfait] <- ghsprix[dforfait] - forfait_exb[dforfait]
  x[dexb]     <- ghsprix[dexb] + (bb[dexb] - ds[dexb]) * exb[dexb]
  x[dexh]     <- ghsprix[dexh] + (ds[dexh] - bh[dexh]) * exh[dexh]
  x
}

Cependant, vu que j’ai l’esprit tordu, je vais préparer valorise.ghs_df() pour pouvoir “changer” de fonction de valorisation à la volée au cas-où :

La version finale de valorise.ghs_df()

valorise.ghs_df <- function (x, ghss, ghs_col = "GHS", ds_col = "DS",
                             annee_col = NA, out_col = "valo",
                             FUN = "valorise"){

  if (out_col %in% names(x))
    stop("la colonne de sortie `", out_col, "`` existe déjà.")
  
  if (!(ghs_col %in% names(x)))
    stop("la colonne du GHS `", ghs_col, "` est absente du jeu source.")
  
  if (!(ds_col %in% names(x)))
    stop("la colonne de durée de séjours `", ds_col, "` est absente du jeu source.")
  
  suppressWarnings(
    if (is.na(ghss) | !("data.frame" %in% class(ghss))) 
      error("ghss doit être une data.frame au format attendu.")
  )
  
  if(is.na(annee_col)) {
    y <- x %>% mutate(anneeValo=as.character(ifelse(MOIS<3,ANNEE-1,ANNEE)))
    annee_col <- "anneeValo"

  } else {
    if (annee_col %in% names(x))
      y <- x
 
    else {
      y <- x %>% mutate(anneeValo=as.character(ifelse(MOIS<3,ANNEE-1,ANNEE)))

      message("La colonne \"",
              annee_col,
              "\" correspondant au paramètre `annee_col` n'a pas été trouvée. `anneeValo` a été utilisée à sa place en interne.")

      annee_col <- "anneeValo"

    }
  }
  
  y <- y%>% select(all_of(c("GHS","DS",
                             annee_col)))
  
  y <- y  %>% left_join(ghss,by=c(setNames(c("GHS", "ANNEE"),c(ghs_col,annee_col))))

  x[,out_col] <-  do.call(FUN, args = list(NA,
                                           y[, ds_col],
                                           y[, "BB"],
                                           y[, "BH"],
                                           y[, "GHSPRIX"],
                                           y[, "FORFAIT_EXB"],
                                           y[, "EXBPRIX"],
                                           y[, "EXHPRIX"]))
  x
}

Je vous présente les modifications faites, qui sont peu nombreuses :

  • D’abord, nous acceptons un paramètre annee_col qui peut, éventuellement, contenir l’année de valorisation. Si cette colonne existe, elle sera utilisée telle quelle, sinon une colonne temporaire “anneeValo” est crée dans ce but.
  • Nous acceptons aussi un paramètre FUN pouvant contenir soit le nom d’une fonction, soit directement une fonction anonyme correspondant au prototype de la fonction décrite en introduction. Nous utilisons la fonction do.call() pour l’exécuter.
  • Enfin nous faisons une jointure sur le n° de GHS et l’année de valorisation.

Bien sûr, il faut que le fichier de GHSs soit dédoublonné.

Au final

Tout ce code nous permet donc d’avoir notre parcours de valorisation en quelques lignes (on pourrait aussi tout mettre sur la même mais qui fait ça… 🤪 ):

RSA  <- chargeRSA("~/R/000000001.2022.11.rsa")
GHSs <- chargeGHSs(RSA, "~/EXPORTS/REF/%ANNEE%/ghs_pub.csv")

RSAvalorise <- RSA %>% valorise.ghs_df(GHSs)

valoTotale <- sum(RSAvalorise$valo,na.rm=TRUE)
pmct <- mean(RSAvalorise$valo,na.rm=TRUE) # na.rm exclut les GHS non valorisés

Et voilà, nous avons nos fonctions et de quoi valoriser (sur la part ghs) tout notre RSA en moins de temps qu’il ne faut pour le dire.

Et la RAAC ?

Maintenant que nous pouvons avoir un RSA valorisé, nous pouvons étudier la RAAC en calculant le PMCT RAAC et non RAAC.

(GHMRAAC provient de l’article Etude de la RAAC grâce au RSA et R)

RSAvalorise %>% filter(RGHM %in% GHMRAAC) %>%
                group_by(RGHM, RAAC) %>%
                summarise(pmct = mean(valo, rm.na = TRUE)) %>%
                pivot_wider(names_from = RAAC,
                            values_from = pmct,
                            values_fill = 0)

Je vous laisse regarder comment améliorer l’aspect (ajouter les libellés des regroupements de GHM, changer le libellé des colonnes,…) en vous basant sur ce qu’on a vu dans l’article Etude de la RAAC grâce au RSA et R.

Puis, toujours en vous basant sur ce que nous avons déjà vu dans cet article, essayez de repérer de combien la RAAC améliore la valorisation journalière . Si vous séchez, postez votre essai dans les commentaires de l’article, je vous accompagnerai.

Gros morceau ! C’est tout pour aujourd’hui. Les prochaines fois, quelque chose de très différent : On va débuter doucement les graphiques.

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *