library(dplyr) library(magrittr)
db <- readRDS('../produced_data/20_vvs_2017_avec_manquants.rds')
Les séjours non valorisés sont ceux dont la variable valo
= 0.
# Rechercher s'il y a des séjours qui ont un code valo valide (1, 2, 3, 4, 5) with(db, any(!(valo == 0 | is.na(valo)) & (mnt_tot_am == 0 | is.na(mnt_tot_am))))
Ils ne donnent aucune information sur les montants. On ne sait pas s'ils ne sont pas valorisé par un défaut dans le PMSI ou dans la facturation.
Tous les cas existent :
Il paraît pertinent de les garder et d'identifier les premiers séjours valorisés avec une autre variable plus bas.
Il est nécessaire de séparer les montants qui prenent en compte le taux et ceux qui ne le prennent pas en compte.
Les montants qui dépendent du taux de remboursement (variable taux
) sont :
mnt_ghs_am
en partie mais il faut sortir mnt_18
(forfait de 18 euros) et mnt_fj2
montant forfaitaire journalier, ainsi que prendre en compte une exception (voir la documentation de vvs, cas traité à part plus loin) ;mnt_ghs50_am
utilisé une fois.Pour certains séjours (IVG, AME, SU) le taux de prise en charge est absent (NA) et fausse les calculs de part de base remboursable.
La documentation indique que pour les prestations IVG (GHS = AMD, IMD, APD, IPD, ou AMF) le taux de de remboursement devrait être de 100% depuis le 31/03/2013.
Attribuer ce taux de 100% aux IVG
# liste des GHS décrivant les IVG ghs_ivg <- c('AMD', 'IMD', 'APD', 'IPD', 'AMF') # Compter le nombre d'occurence selon le ghs et le taux db %>% filter(ghs %in% ghs_ivg) %>% group_by(ghs, taux) %>% summarise(n = n()) # attribuer un taux de 100% à ces cas db$taux[db$ghs %in% ghs_ivg] <- 100
Les séjours en aide médicale d'état (AME, valo = 3) et soins d'urgence (SU, valo = 4) ont un taux de 80% d'après la documentation.
# Compter le nombre d'occurence d'ame et su avec taux db %>% filter(valo %in% c(3, 4)) %>% group_by(valo, taux) %>% summarise(n = n()) # Attribuer un taux de 100% à ces cas db$taux[db$valo %in% c(3, 4)] <- 80
taux_manquants <- is.na(db$taux) & db$mnt_tot_am != 0 & !is.na(db$mnt_tot_am) sum(taux_manquants)
Il s'agit d'un prélèvement d'organe pour lequel, d'après la documentation, seul le PO est valorisé. Donc attribuer une valeur de 0 au taux
db$taux[taux_manquants] <- 0
Vérifier
db %>% filter(mnt_tot_am != 0 & !is.na(mnt_tot_am)) %>% group_by(taux) %>% summarise(n = n())
Créer une nouvelle variable mnt_br
qui contient (mntBR GHS + EXB + EXH)xCoeff transitionxcoef prudentiel sans le taux.
mnt_br
est la valeur du GHS et bornes avec les coefs.
db$mnt_br <- with(db, (mnt_ghs_am + mnt_exh_am + mnt_exinf_am) / (taux / 100) + mnt_18 + mnt_fj2) db %>% select(taux, ghs, mnt_br, mnt_ghs_am, mnt_exh_am, mnt_exinf_am, mnt_18, mnt_fj2, mnt_tot_am) %>% head
Ce montant GHS 100% est utile pour pouvoir résoudre le problème des variations dues à plusieurs facteurs concomitants
Ce sont les montants qui dépendent du taux de remboursement à l'exclusion des valeurs GHS et bornes (incluses dans la variable mnt_br
). Il s'agit des suppléments sauf des prélèvement d'organe.
db$mnt_variables <- with(db, (mnt_dialyse + mnt_rxt + mnt_rea + mnt_nn + mnt_caisson_am + mnt_ant_am + mnt_ivg_am + mnt_ghs50_am + ghsminam) / (taux/100) )
Ce sont les montants qui ne dépendent pas du taux de remboursement.
En 2017 par rapport à 2016 est ajouté mnt_med_atu
et le montant pour défibrilateur cardiaque (retrouvé par calcul, variable mnt_scd
).
db$mnt_constants <- with(db, mnt_mon + mnt_dmi + mnt_po - mnt_18 - mnt_fj2 + mnt_med_atu + mnt_scd)
En théorie, le mnt_tot_am doit être $mnt_br \times taux + mnt_variables \times taux + mnt_constants$
valo_calc = with(db, mnt_br * taux /100 + mnt_variables * taux / 100 + mnt_constants) db$diffe <- valo_calc - db$mnt_tot_am summary(db$diffe) acorriger <- db %>% filter(!is.na(diffe) & diffe < -1) nrow(acorriger)
Ceci correspond à la règle Pour les séjours valorisée à 80% où (durée de séjour X 18) > (0.20 X BR) alors le taux n'est pas pris en compte
acorriger %>% filter(valo != 5) %>% select(mois_envoi, dds, valo, taux, ghs, mnt_ghs_am, mnt_br, mnt_fj2, diffe)
Pour ces cas recalculer le mnt_br avec taux à 100 %
cas_probleme <- which(db$valo != 5 & !is.na(db$diffe) & db$diffe < -10) # Il faut annuler l'effet taux qui sera réappliqué après dans les sommes pour ces valeurs de GHS # !!!! Danger zone # Recalcul pour avoir un taux comme si valait 100 % db$taux[cas_probleme] <- 100 db$mnt_br[cas_probleme] <- with(db[cas_probleme,], (mnt_ghs_am + mnt_exh_am + mnt_exinf_am) / (taux / 100) + mnt_18 + mnt_fj2)
Vérifier
valo_calc = with(db, mnt_br * taux /100 + mnt_variables * taux / 100 + mnt_constants) db$diffe <- valo_calc - db$mnt_tot_am acorriger <- db %>% filter(!obs_virtuelle & diffe < -1) summary(db$diffe) nrow(acorriger) acorriger %>% select(mois_envoi, valo, taux, ghs, mnt_ghs_am, mnt_br, mnt_18, mnt_fj2, diffe) %>% filter(valo != 5)
Ce sont des cas marginaux (détenus).
Pour un RSS donné, numéroter les envois. Ceci permet d'identifier un premier envois et le dernier envois du RSS.
Trouver égelement le premier envoi avec valorisation.
db2 <- db %>% group_by(rss) %>% mutate( # Rang d'envoi envoi_rang = rank(mois_envoi, ties.method = 'first'), # Identifier la première valorisation valo_0 = valo == 0 | obs_virtuelle, premiere_valo = envoi_rang == min(envoi_rang[!valo_0]), # Identifier le dernier envoi envoi_dernier = envoi_rang == max(envoi_rang[!obs_virtuelle]) ) %>% ungroup()
db2 %<>% arrange(mois_sortie, mois_envoi, rss) # Identifiant unique db2$id <- as.integer(as.factor(db2$rss)) correspondance <- unique(db2[, c('rss', 'id')]) # Identifiant unique aléatoire correspondance$ida <- sample(correspondance$id, size = nrow(correspondance), replace = F) any(duplicated(correspondance$ida)) write.csv2(correspondance, '../produced_data/correspondance_id_rss.csv') db2 <- merge(db2, correspondance[,c('id', 'ida')])
Pour les calculs finaux, les variables utiles sont minimes
db3 <- db2 %>% mutate(taux = taux / 100) %>% select(id, ida, rss, mois_sortie, mois_envoi, valo, obs_virtuelle, envoi_rang, premiere_valo, envoi_dernier, taux, mnt_br, mnt_variables, mnt_constants, mnt_tot_am, mnt_mon, mnt_dmi, mnt_po, mnt_18, mnt_fj2, ghsminam, mnt_med_atu, mnt_scd) %>% ungroup pryr::object_size(db2) pryr::object_size(db3) str(db3) summary(db3)
saveRDS(db3, file = '../produced_data/21-vvs_2017_minimal_anonyme.rds')
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.