En fin de l’article Derniers pas de notre fonction de valorisation, je vous proposais de réfléchir et écrire les interrogations nécessaire à l’étude de la RAAC. Dans ce petit interarticle, je vous donne des solutions. C’est aussi l’occasion de fournir ci-dessous, en un bloc, le code sous-jacent à l’analyse.
Nous regroupons donc le source suivant basé sur différents éléments des articles de la série :
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(readxl) # pour lire le fichier excel du regroupement des GHM
library(lubridate) # pour la manipulation de dates
##########################################################
# Paramètres variables
# A paramétrer selon l'emplacement de vos données
motifFichiersGHS <- "~/EXPORTS/REF/%ANNEE%/ghs_pub.csv"
motifFichiersRGHM <- "~/EXPORTS/REF/2022/regroupements_racinesghm.xlsx"
fichierRSA <- "~/R/000000001.2022.11.rsa"
##########################################################
# Fonctions nécessaires
# Rien n'est à modifier à partir d'ici
# Fonction de chargement de RSA
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()
)
)
}
# Génération du chemin selon l'année
genereChemin = function(fp, annees){
lapply(annees, function(x){sub("%ANNEE%",x, fp)}) %>% as.character
}
# Fonction de chargement des GHSs
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)))
}
# Fonction de valorisation unitaire
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
}
# Fonction de valorisation en masse
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_col,"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
}
##################################################################
# Données initiales annexes
# Il serait tout à fait possible et potentiellement pertinent
# de créer un fichier csv à part que l'on chargerait afin de pouvoir
# centraliser ces données en cas de mise à jour
RGHMRAAC <- c("04C02", "04C04",
"06C03", "06C04","06C07","06C16",
"07C09",
"08C22", "08C24", "08C25", "08C27", "08C48", "08C52",
"10C13", "11C02",
"12C11",
"13C03", "13C14", "13C15")
#################################################################
# Création des tables de base
RSARAAC <- chargeRSA(fichierRSA) %>% filter(RGHMOUT %in% RGHMRAAC)
GHSs <- chargeGHSs(RSARAAC, motifFichiersGHS)
RGHM <- read_excel(motifFichiersRGHM, # Dans le cas actuel nous n'avons pas besoin de charger plusieurs fichiers
col_names = c("RGHM", "LIB", "ASO",
"DA", "DA-LIB",
"GP", "GP-LIB",
"GA", "GA-LIB",
"DA-GP", "DA-GP-GA"),
skip = 1)
#################################################################
# Valorisation
RSARAACvalorise <- RSARAAC %>% valorise.ghs_df(GHSs)
A l’issue de cette étape initiale, nous nous retrouvons donc avec :
RSARAAC: contenant les données initiales limitées aux séjours groupant dans les GHM éligibles à la RAACGHSs: la table des paramètres de valorisation adaptée aux dates du RSARGHM: la table d’où seront extraits les libellés des racines de GHM
et enfin
RSARAACValorise: contentant la table RSARAAC complétée de la valorisation du GHS pour chaque ligne
Traitements
Il n’y aplus maintenant qu’à faire des opérations de filtrage/regroupement/mise-en-page pour obtenir des données utilisables.
Améliorer l’aspect (ajouter les libellés des regroupements de GHM, changer le libellé des colonnes,…)
Pour rappel, voici la méthode pour récupérer une présentation plus conviviale. Il faut bien entendu adapter à votre traitement, en particulier au sein du summarise(), il faut remplacer « regroupement = <calcul> » par vos propres fonctions puis dans le pivot_wider() adapter le values_from=.
RSARAAC %>%
# Création d'un champ RAAC plus lisible
mutate(RAAC = if_else(RAAC == 1,"RAAC+","RAAC-","RAAC-")) %>%
# Calcul de la valorisation moyenne par racine de GHM
group_by(RGHMOUT,RAAC) %>% summarise(regroupement = <calcul>) %>%
# Présentation sous forme d'un tableau croisé
pivot_wider(names_from = RAAC, values_from = regroupement, values_fill = NA) %>%
# Ajout des libellés des racines de GHM et mise à la bonne place de la colonne du libellé
left_join(RGHM %>% select(RGHM, LIB), by = c("RGHMOUT" = "RGHM")) %>%
relocate(LIB, .after = RGHMOUT) %>%
# Impression de la totalité dans la console.
# Il aurait été possible de faire un "View" bien sûr
print(n=Inf)
Nous utilisons if_else() venant de dplyr car celui-ci permet de traiter dans le même temps les cas VRAI, FAUX et aussi si la donnée est non fixée (NA).
print(n = Inf) permet d’imprimer la totalité d’un vecteur (sinon, dans le cas d’un dataframe, seules les 10 premières lignes sont imprimées). A n’utiliser donc que sur des jeux dont vous connaissez la longueur, raisonnable. Ici, le tableau fera au maximum la longueur du vecteur RGHMRAAC, ce qui est acceptable.
Reprise des traitements du 1er article
Pour concentrer tout le code en une page, vous trouverez ici les morceaux de traitements réalisés tout au long du 1er article sur la RAAC, légèrement mis-à-jour.
Etude des volumes « RAAC » et « non RAAC »
RSARAAC %>% group_by(RGHMOUT, RAAC) %>%
mutate(RAAC = if_else(RAAC == 1, "RAAC+", "RAAC-", "RAAC-")) %>%
summarise(c = n()) %>%
pivot_wider(names_from = RAAC, values_from = c, values_fill = NA) %>%
print(n = Inf)
Etude des DMS « RAAC » et « non RAAC »
RSARAAC %>% group_by(RGHMOUT,RAAC) %>%
mutate(RAAC = if_else(RAAC == 1, "RAAC+", "RAAC-", "RAAC-")) %>%
summarise(DMS=mean(DS)) %>%
pivot_wider(names_from = RAAC, values_from =DMS, values_fill =NA) %>%
print(n = Inf)
Etude du débornage
en volume :
RSARAAC %>% inner_join(GHSs %>% select(GHS, GHM), by = "GHS") %>%
mutate(SEVVALO = substr(GHM,6,6),
LIB = ifelse(RAAC == 0,
paste("NR:", SEVVALO, sep = ""),
paste("R:", SEVOUT,"->",SEVVALO,sep="")
)
) %>%
group_by(RGHMOUT, LIB) %>% summarise(n = n()) %>%
pivot_wider(names_from = LIB, values_from = n, values_fill = NA) %>%
print(n = Inf)
et en DMS :
RSARAAC %>% inner_join(GHSs %>% select(GHS, GHM), by = "GHS") %>%
mutate(SEVVALO = substr(GHM,6,6),
LIB = ifelse(RAAC == 0,
paste("NR:", SEVVALO, sep = ""),
paste("R:", SEVOUT,"->",SEVVALO,sep="")
)
) %>%
group_by(RGHMOUT, LIB) %>% summarise(DMS = mean(DS)) %>%
pivot_wider(names_from = LIB, values_from = DMS, values_fill = NA) %>%
print(n = Inf)
Traitements sur la valorisation
Maintenant que nous avons notre fonction de valorisation et avons pu en tirer un RSARAACValorise. Nous pouvons produire diverses tables d’analyse en nous basant sur les mécanismes de traitement précédents.
PMCT des séjours RAAC et non RAAC
RSARAACvalorise %>%
mutate(RAAC = if_else(RAAC == 1,"RAAC+", "RAAC-", "RAAC-")) %>%
group_by(RGHMOUT, RAAC) %>% summarise(valo = mean(valo)) %>%
pivot_wider(names_from = RAAC, values_from = valo, values_fill = NA) %>%
left_join(RGHM %>% select(RGHM, LIB), by = c("RGHMOUT" = "RGHM")) %>%
relocate(LIB, .after = RGHMOUT) %>%
print(n = Inf)
La RAAC améliore-t-elle le PMCT ?
Sur le résultat précédent, il suffit de faire un mutate() de plus (avant le View ou le print):
(...) %>% mutate(Gain = `RAAC+`- `RAAC-`)
A noter que le PMCT par RGHM peut parfois être diminué, mais il ne faut pas oublier que la RAAC permet de revaloriser des séjours qui auraient été sans sévérité, ceux déclenchant des sévérités présentant déjà un meilleur PMCT. Il est assez peu pertinent de prendre en compte pour comparaison les séjours à sévérité dans le groupe RAAC-. De même, la RAAC est supposée améliorer la durée de séjour (donc le turnover, donc la valorisation globale) alors que le PMCT est insensible à cette variation.
C’est le moment de rentrer à nouveau dans le détail des séjours débornés :
De combien la RAAC améliore-t-elle la valorisation selon la sévérité réelle du dossier vs les séjours non RAAC ne bénéficiant pas du débornage?
RSARAACvalorise %>%
mutate(anneeValo = as.character(ifelse(MOIS <3, ANNEE-1, ANNEE))) %>%
left_join(GHSs %>% select(ANNEE, GHS, GHM),by=c("anneeValo"="ANNEE", "GHS")) %>%
mutate(SEVVALO = substr(GHM,6,6),
c = paste(if_else(RAAC==1,"R:","NR:","NR:"),
ifelse(SEVOUT==SEVVALO,
SEVOUT,
paste(SEVOUT,">",SEVVALO,
sep="")
),
sep=""
)
) %>%
group_by(RGHMOUT,c) %>% summarise( valo = mean(valo)) %>%
pivot_wider(names_from = c,values_from = c(valo), values_fill = NA) %>%
left_join(RGHM %>% select(RGHM, LIB), by = c("RGHMOUT" = "RGHM")) %>%
select(any_of(c("RGHMOUT", "LIB",
"NR:1", "R:1", "R:1>2", "R:1>3", "R:1>4",
"NR:2", "R:2", "R:2>3", "R:2>4",
"NR:3", "R:3", "R:3>4",
"NR:4", "R:4"
))) %>%
print(n = Inf)
Dans cette présentation, nous visualisons dans les colonnes R:1>2, R:1>3, R:1>4,… les valorisations des séjours ayant bénéficié du débornage du niveau de sévérité, le 1er chiffre est la sévérité selon le GHM produit (c’est à dire celui qui aurait été valorisé en l’absence de RAAC) et le second celui selon le GHS valorisé (avec la RAAC).
Notez l’usage de select(any_of(c(...))) qui permet de classer les colonnes sans s’occuper de leur existence ou non. J’ai été gourmand en imaginant que le débornage puisse servir à regrouper des séjours à sévérité vers des sévérités supérieures. C’est mon côté optimiste, mais de manière assez prévisible, il n’y a pas de tels séjours. La RAAC bénéficiant plutôt à transformer des « niveaux 1 » en « niveaux >1 ».
Synthétiser DMS et valorisation en une table
Enfin, sachez que pivot_wider() accepte un vecteur pour son paramètre names_from=. Cela permet par exemple de générer une table regroupant les DMS et les valorisations (voire plus, la limite étant la lisibilité) :
RSARAACvalorise %>%
mutate(anneeValo = as.character(ifelse(MOIS <3, ANNEE - 1, ANNEE))) %>%
left_join(GHSs %>% select(ANNEE, GHS, GHM),by = c("anneeValo" = "ANNEE", "GHS")) %>%
mutate(SEVVALO = substr(GHM,6,6),
c = paste(if_else(RAAC == 1,"R:","NR:","NR:"),
ifelse(SEVOUT == SEVVALO,
SEVOUT,
paste(SEVOUT, ">", SEVVALO,
sep="")
),
sep=""
)
) %>%
group_by(RGHMOUT, c) %>% summarise(DMS = round(mean(DS), 2), valo = mean(valo) / mean(DS)) %>%
pivot_wider(names_from = c, values_from = c(DMS, valo), values_fill = NA) %>%
left_join(RGHM %>% select(RGHM, LIB), by = c("RGHMOUT" = "RGHM")) %>%
select(any_of(c("RGHMOUT", "LIB",
"DMS_NR:1", "DMS_R:1", "DMS_R:1>2", "DMS_R:1>3", "DMS_R:1>4",
"DMS_NR:2", "DMS_R:2", "DMS_R:2>3", "DMS_R:2>4",
"DMS_NR:3", "DMS_R:3", "DMS_R:1>4",
"DMS_NR:4", "DMS_R:4",
"valo_NR:1", "valo_R:1", "valo_R:1>2", "valo_R:1>3", "valo_R:1>4",
"valo_NR:2", "valo_R:2", "valo_R:2>3", "valo_R:2>4",
"valo_NR:3", "valo_R:3", "valo_R:1>4",
"valo_NR:4", "valo_R:4"
))) %>% View
J’utilise View() pour l’affichage car print() le limiterait à ce qui passe à l’écran (ou tout du moins dans la fenêtre d’exécution).
Conclusion
Voilà, ce n’était pas vraiment un article original mais plus une résumé des traitements proposés dans les articles précédents et un moyen de rassembler tout le code produit au fur et à mesure de cette série sur la RAAC. Si vous copiez-collez chaque bloc de code à la suite dans un fichier (sous réserve bien sûr de régler les paramètres généraux en début du 1er bloc et de bien avoir les 4 libraires nécessaires), vous devriez avoir un traitement directement exécutable.
De nombreuses autres pistes d’analyse sont possibles, je vous laisse les explorer.
Nous allons maintenant pouvoir reprendre le fil de notre initiation avec l’approche des graphiques.