In jomuller/vvs: Analyse des fichiers VisualValoSej

library(dplyr)
library(magrittr)

db <- readRDS('../produced_data/20_vvs_2017_avec_manquants.rds')

Séjours non valorisés

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 :

• séjours initialement non valorisés puis valorisés ;
• séjours jamais valorisés ;
• séjours initialement valorisés qui ne sont plus valorisés par la suite.

Il paraît pertinent de les garder et d'identifier les premiers séjours valorisés avec une autre variable plus bas.

Autres variables utiles pour l'analyse

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 :

• Le 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) ;
• les suppléments (hors MO et DMI);
• le mnt_ghs50_am utilisé une fois.

Taux manquants

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.

IVG

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

AME et et SU

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

Autres cas

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())

Montant BR de GHS et bornes et coeff

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

Montants variables

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)
  )

Montants constants

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)

Vérifier sommes,

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).

Rang d'envois, premier et dernier

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()

Créer identifiant unique

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')])

Ne garder que les variables utiles

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')

jomuller/vvs documentation built on May 21, 2019, 2:05 p.m.