In jomuller/vvs: Analyse des fichiers VisualValoSej

library(dplyr)

Objectif

Exploration des variables, contrôles et simplification.

Note : l'objectif de simplification était nécessaire lorsque la machine utilisée pour exécuter ces scripts étaient limitée en RAM. Ceci n'est pas nécessaire pour une machine moderne.

Import

Les données 2017 ont déjà été agrégées avec la fonction vvs::import_dir.

db <- readRDS('../produced_data/05-raw_vvs_2017.rds')

Exploration variable par variable

Finess

Un seul chez nous qui correspond au FINESS juridique

unique(db$FINESS)

Non informatif, à retirer

# Créer une copie. Retirer tout attribut.
db_clean <- as.data.frame(as.list(db))

# Supprimer le FINESS
db_clean$FINESS <- NULL

no_rss

Nombre de RSS différents.

length(unique(db$NO_RSS))

Répartition du nombre d'occurrence de chaque RSS

db$NO_RSS %>%
  table %>%
  as.integer %>%
  table %>%
  as.data.frame %>%
  knitr::kable(col.names = c("Nombre d'occurences", "Fréquence"), 
               caption = "Nombre d'occurence de chaque RSS")

Ceci correspond aux envois multiple des RSS. Par exemple ceux qui sont envoyés 12 fois sont les RSS de janvier.

Utile dans la suite pour les transfert geo.

NO_Admin

length(unique(db$NO_ADMIN))

Même nombre de NDA et de numéro de RSS

Date d'entrée

Voir les dates d'entrées première pour chaque RSS

dates_entree_unique <- db$DATE_ENT[!duplicated(db$NO_RSS)]
summary(dates_entree_unique)

library(ggplot2)
library(scales)
library(magrittr)

# Préparation des données avant représentation graphique avec ggplot
db_dates <- data.frame(date_entree = dates_entree_unique)

db_dates %<>%
  mutate(mois = lubridate::month(date_entree), 
         mois_nom = ordered(x = mois, levels = 1:12, labels = month.name),
         annee = lubridate::year(date_entree))

# Représentation graphique
ggplot(db_dates) +
  aes(x = mois_nom) +
  geom_histogram(stat = 'count') +
  facet_grid(annee ~ ., scales = 'free_y') +
  xlab("Mois d'entrée") +
  ylab("Nombre de RSS") +
  theme_bw()

Pas utile pour l'analyse, uniquement pour calculer une durée de séjours.

# Calculer la durée de séjour en jours
db_clean$dds <- as.integer(db$DATE_SOR - db$DATE_ENT)

# Supprimer la date d'entrée
db_clean$DATE_ENT <- NULL

Date de sortie

Voir les dates d'entrées première pour chaque RSS

dates_sortie_unique <- db$DATE_SOR[!duplicated(db$NO_RSS)]
summary(dates_sortie_unique)

Pas de surprise, elles sont toutes en 2017.

# Préparation des données pour représentation graphique
db_dates %<>%
  mutate(
    date_sortie = dates_sortie_unique,
    mois_sortie = lubridate::month(date_sortie), 
    mois_sortie_nom = ordered(x = mois_sortie, levels = 1:12, labels = month.name),
    annee = lubridate::year(date_sortie)
    )

# Déssiner
ggplot(db_dates) +
  aes(x = mois_sortie_nom) +
  geom_histogram(stat = 'count') +
  facet_grid(annee ~ ., scales = 'free_y') +
  xlab("Mois d'entrée") +
  ylab("Nombre de RSS") +
  theme_bw()

Date de sortie en fonction du mois d'entrée

ggplot(db_dates) +
  aes(x = mois_sortie_nom, fill = mois_nom) +
  geom_histogram(stat = 'count') +
  facet_grid(annee ~ ., scales = 'free_y') +
  xlab("Mois d'entrée") +
  ylab("Nombre de RSS") +
  theme_bw()

Seul le mois de sortie est utile.

# Créer une nouvelle variable avec le mois de sortie
db_clean$mois_sortie <- as.integer(format(db$DATE_SOR, format = '%m'))

# Supprimer la date de sortie
db_clean$DATE_SOR <- NULL

VALO

db %>% filter(is.na(TAUX2)) %>% group_by(VALO) %>% summarise(n = n())

Lorsque le TAUX2 n'est pas renseigné (NA) alors VALO peut tout de même prendre n'importe quelle valeur (pas de cas pour les détenus, VALO = 5).

# Visualiser les types de VALO
db %>%
  mutate(
    valo = factor(VALO, levels = 0:5, 
                  labels = c('non valorisé', 'valorisé', "non valorisé avec prélèvement d'organe", "aide médicale d'état", "soins d'urgence", "détenu"))) %>%
  group_by(VALO, valo) %>%
  summarise(n = n())

A garder comme un entier (plus simple à manipuler par la suite).

db_clean$VALO <- as.integer(as.character(db$VALO))

Tous les dossiers du fichiers de RSS apparaissent dans le VVS, qu’ils soient ou non chaînés avec leur VIDHOSP correspondant.

db %>%
  filter(VALO == 0) %>%
  group_by(TAUX2) %>%
  summarise(n = n())

Les dossiers « valo = 0 » ont tous un « taux2 = . » (. = NA dans les fichiers VisualValoSej 2017, contrairement à ce qui est indiqué dans la documentation, voir question sur Agora).

• Les dossiers codés PMSI absents du VIDHOSP apparaissent « valo = 0 » et « taux2 = . ».
• Les dossiers codés PMSI, présents dans le VIDHOSP mais avec un taux à 0 apparaissent eux aussi en « valo =0 » et « taux2 = . ».

Conclusion : On ne peut donc pas, avec le fichier VVS seul, distinguer les dossiers non valorisés car non chaînés, des dossiers non valorisés car à taux=0.

sejxinf

Permet de distinguer les GHS dont la borne basse est calculée à la journée et ceux calculés au forfait. "Type de séjour inférieur à la borne extrème basse".

Non utile pour le reste des calculs. A retirer.

db_clean$SEJXINF <- NULL

GHS

Nombre de GHS différents.

length(unique(db$GHS))

GHS les plus fréquents

# Importer une base des GHS
ghs <- readRDS(file = system.file("extdata", "ghs2017.rds", package = "vvs"))

# GHS les plus fréquents à M12
top_ghs <- db %>%
  filter(mois_envoi == 12) %>%
  group_by(GHS) %>%
  summarise(n = n()) %>%
  arrange(desc(n)) %>%
  top_n(10) %>%
  ungroup


top_ghs %>%
  left_join(ghs, by = c('GHS' = 'ghs')) %>%
  select(GHS, ghm, n, libelle, prix) %>%
  knitr::kable()

Mettre en factor car pèse deux fois moins lourd (objectif de performance)

db_clean$GHS <- as.factor(db_clean$GHS)

Ponder

Nombre de séjours ou de séances

summary(db$PONDER)

Utile pour le recalcul. A garder.

Coefficiens

summary(db[,c('COEFTRANS', 'COEFGEO') ])

Ces deux coefficiens sont sans intérêt pour nous.

db_clean$COEFTRANS <- NULL
db_clean$COEFGEO <- NULL

TAUX2

table(db$TAUX2)

Les valeurs qui ne sont pas celles attendues (80, 90 ou 100) sont expliquées par les patients détenus (valo = 5).

evolution_taux <- db %>%
  filter(VALO != 5) %>%
  group_by(TAUX2, mois_envoi) %>%
  summarise(n = n()) %>%
  ungroup() %>%
  arrange(TAUX2) %>%
  knitr::kable(caption = 'Répartition des taux de remboursement en dehors des séjours de détenus')

L'explication données sur agora.

Le taux pour les détenus utilisé est un taux de remboursement moyen calculé sur l'année N-1 et sur la base nationale Ex-DGF. Ce taux moyen est calculé par GHS.

Montants

Rechercher les montants avec que des NA ou 0 et les suppirmer

# Recherche les colonnes inutiles (mnt avec que des NA et 0
db %>%
  select(starts_with('MNT')) %>%
  lapply(FUN = function(x) {all(is.na(x) | x == 0)}) -> col_mnt_inutiles

# Lister
col_mnt_inutiles

# Supprimer ces colonnes inutiles
col_mnt_inutiles <- names(col_mnt_inutiles)[as.logical(col_mnt_inutiles)]

GHS

db %>%
  select(starts_with('GHS')) %>%
  summary

Mnt rac

summary(db$MNT_RAC)

Nb

grep(names(db), pattern = '^NB', value = T)

Typorg

db %>%
  select(starts_with('TYPORG')) %>%
  lapply(unique)

Coef prudentiel

Il change en mars, donc deux valeurs possibles.

unique(db$coefp)

Flag FIDES

Non utile

unique(db_clean$FLAG_FIDES)
db_clean$FLAG_FIDES <- NULL

Noms en miniuscules

Mettre les noms de colonnes en minuscule pour faciliter leur accès.

names(db_clean) <- stringr::str_to_lower(names(db_clean))

Montant total

En théorie le montant total est la somme des montants en retirant 'mnt_tot_am' et 'mnt_rac'.

Sélection des colonnes de calcul telles que décrites dans le manuel de VisualValoSej. Attention : ces noms de colonnes sont décrits en minuscule. De plus il y a une erreur dans un des noms : mnt_ghsmin_am est dans la base ghsminam.

Enfin, il y a des modifications en 2017 en particulier l'ajout de la variable montant_med_atu. (non indiqué dans le calcul dans la documentation 2017 mais présent dans la documentation 2018). Il est également indiqué qu'un supplément pour pose de défibrillateur cardiaque est possible mais n'a pas de variable en 2017. S'appelle mnt_scd en 2018. Ce supplément est fixé dans l'arrêté tarifaire 2017 à 13445,19€.

Cette erreur est documentée sur Agora.

# Définir les noms des colonnes permettant le calcul du montant tot am
noms_colonnes_calcul <- c(
  'mnt_mon', 'mnt_dmi', 'mnt_ghs_am', 'mnt_exinf_am', 'mnt_ghs50_am', 'ghsminam',
  'mnt_exh_am', 'mnt_supphd_am', 'mnt_suppent1_am', 'mnt_suppent2_am',
  'mnt_suppent3_am', 'mnt_dip_am', 'mnt_po1_am', 'mnt_po2_am', 'mnt_po3_am',
  'mnt_po4_am', 'mnt_po5_am', 'mnt_po6_am', 'mnt_po7_am', 'mnt_po8_am',
  'mnt_po9_am', 'mnt_poa_am', 'mnt_9610_am', 'mnt_9619_am', 'mnt_9620_am',
  'mnt_9621_am', 'mnt_9622_am', 'mnt_9623_am', 'mnt_9625_am', 'mnt_9631_am',
  'mnt_9632_am', 'mnt_9633_am', 'mnt_9615_am', 'mnt_rap_am', 'mnt_ant_am',
  'mnt_rea_am', 'mnt_rep_am', 'mnt_si_am', 'mnt_sc_am', 'mnt_nn1_am',
  'mnt_nn2_am', 'mnt_nn3_am', 'mnt_caisson_am', 'mnt_ivg_am', 'mnt_med_atu'
  )

col_calcul <- names(db_clean) %in% noms_colonnes_calcul

# Vérifier que toutes les colonnes attendues soient disponibles
all(noms_colonnes_calcul %in% names(db_clean))

Tester le calcul sur quelques cas

db_recalcul_valo <- db_clean
db_recalcul_valo$mnt_am_calcul <- apply(X = db_recalcul_valo[, col_calcul], MARGIN = 1, FUN = sum, na.rm = TRUE)
head(db_recalcul_valo$mnt_am_calcul)
head(db_recalcul_valo$mnt_tot_am)

# Rechercher des différences à l'arrondis près
db_recalcul_valo$diff <- db_recalcul_valo$mnt_am_calcul - db_recalcul_valo$mnt_tot_am

summary(db_recalcul_valo$diff)

Comprendre les différences

diff <- db_recalcul_valo[abs(db_recalcul_valo$diff) > 1 & !is.na(db_recalcul_valo$diff),]
length(unique(diff$no_admin))

Il y a 4 RSS.

La valeur est celle du tarif BO * le coefficient prudentiel.

C'est presque toujours la même valeur (à l'arrondi près).

J'ai vérifié dans le dossier patient de ces dossiers, et il semble qu'à chaque fois il y a un événement du type pose d'un défibrillateur cardiaque qui sort de la prise en charge initiale. Donc ceci est peutre être lié au supplément pour pose de défibrillateur cardiaque dont la variable n'est pas présente. Ceci va avoir un impact sur les calculs car cette variable est impactée par le taux de prise en charge.

Je vais donc ajouter "virtuellement" ce montant pour avoir des calculs juste sur ces cas, en espérant qu'il n'y a pas d'autres cas.

ajoute_sdc <- which(db_recalcul_valo$diff < -13351)
db_clean$mnt_scd <- 0
db_clean$mnt_scd[ajoute_sdc] <- 13351

Refaire les calculs

noms_colonnes_calcul <- c(noms_colonnes_calcul, 'mnt_scd')
col_calcul <- names(db_clean) %in% noms_colonnes_calcul
db_clean$mnt_am_calcul <- apply(X = db_clean[, col_calcul], MARGIN = 1, FUN = sum, na.rm = TRUE)
db_clean$diff <- db_clean$mnt_am_calcul - db_clean$mnt_tot_am
summary(db_clean$diff)

J'ai posé la question sur agora

Dans la documentation de VisualValoSej 1.7.5.0 est indiqué dans les éléments entrant dans la valorisation (page 12) un nouvel élément « Les suppléments pour pose de défibrillateur cardiaque ». Je ne retrouve pas de variable décrivant ce supplément ni dans le cahier de variable (pages 5 à 7) ni dans les données téléchargées. Cette variable est cependant décrite dans la documentation de VisualValoSej 1.7.6.0 avec le nom mnt_scd. Lorsque je tente de recalculer le montant total assurance maladie j'ai une différence pour quelques patients dont le montant semble correspondre à ce supplément. Ces patients ont effectivement bénéficié de la pose d'un défibrillateur. Est-ce un oubli dans la version de 2017 ? Est-il possible de récupérer cette variable ou est-elle présente sous un autre nom ?

La réponse est qu'il s'agit d'un oubli

Oui, effectivement, il manquait cette variable mnt_sdc dans la version VisualValoSej du M12 2017.

Année

Non utile puisque je travaille sur la même année. A retirer

db_clean$annee_envois <- NULL

Regrouper

Regrouper certaines variables pour simplifier la base

Dialyse

col_nb_dialyse <- c('supphd', 'suppent1', 'suppent2', 'suppent3', 'nb_dip')
db_clean$nb_dialyse <- as.integer(apply(db_clean[, col_nb_dialyse], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_nb_dialyse] <- NULL
rm(col_nb_dialyse)

col_mnt_dialyse <- c('mnt_dip_am', 'mnt_supphd_am', 'mnt_suppent1_am',  'mnt_suppent2_am',  'mnt_suppent3_am')
db_clean$mnt_dialyse <- as.numeric(apply(db_clean[, col_mnt_dialyse], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_mnt_dialyse] <- NULL
rm(col_mnt_dialyse)

Prélèvements d'organe

col_nb_po <- c("typorg", "typorg5", "typorg6", "typorg7", "typorg8", "typorg9", "typorga")
db_clean$nb_po <- as.integer(apply(db_clean[, col_nb_po], 
                                        MARGIN = 1, 
                                        FUN = function(x) sum(as.integer(x) > 0, na.rm = TRUE)))
summary(db_clean$nb_po)
db_clean[, col_nb_po] <- NULL
rm(col_nb_po)

col_mnt_po <- c("mnt_po1_am", "mnt_po2_am", "mnt_po3_am", "mnt_po4_am", "mnt_po5_am",  "mnt_po6_am", "mnt_po7_am", "mnt_po8_am", "mnt_po9_am", "mnt_poa_am")
db_clean$mnt_po <- as.numeric(apply(db_clean[, col_mnt_po], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_mnt_po] <- NULL

rm(col_mnt_po)

Radiothérapie

col_nb_rxt <- c("nb_9610", "nb_9619", "nb_9620", "nb_9621", "nb_9622", "nb_9623", "nb_9625", "nb_9631", "nb_9632", "nb_9633", "nb_9615", 'nb_rap')
db_clean$nb_rxt <- as.integer(apply(db_clean[, col_nb_rxt], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_nb_rxt] <- NULL
rm(col_nb_rxt)

col_mnt_rxt <- c("mnt_9610_am", "mnt_9619_am", "mnt_9620_am", "mnt_9621_am",
"mnt_9622_am", "mnt_9623_am", "mnt_9625_am", "mnt_9631_am", "mnt_9632_am", 
"mnt_9633_am", "mnt_9615_am", 'mnt_rap_am')
db_clean$mnt_rxt <- as.numeric(apply(db_clean[, col_mnt_rxt], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_mnt_rxt] <- NULL
rm(col_mnt_rxt)

Réanimation

col_nb_rea <- c('nbjrea', 'nbrep', 'nb_stf2', 'nb_src2')
db_clean$nb_rea <- as.integer(apply(db_clean[, col_nb_rea], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_nb_rea] <- NULL
rm(col_nb_rea)

col_mnt_rea <- c('mnt_rea_am', 'mnt_rep_am', 'mnt_si_am', 'mnt_sc_am')
db_clean$mnt_rea <- as.numeric(apply(db_clean[, col_mnt_rea], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_mnt_rea] <- NULL
rm(col_mnt_rea)

Néonat

col_nb_nn <- c("nb_nn1", "nb_nn2", "nb_nn3")
db_clean$nb_nn <- as.integer(apply(db_clean[, col_nb_nn], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_nb_nn] <- NULL
rm(col_nb_nn)

col_mnt_nn <- c("mnt_nn1_am", "mnt_nn2_am", "mnt_nn3_am")
db_clean$mnt_nn <- as.numeric(apply(db_clean[, col_mnt_nn], MARGIN = 1, FUN = sum, na.rm = TRUE))
db_clean[, col_mnt_nn] <- NULL
rm(col_mnt_nn)

Ordonner

db_clean %<>%
  select( rss = no_rss, nda = no_admin, mois_sortie, mois_envoi, dds,
          valo, taux = taux2, ponder,
          ghs, mnt_ghs_am, nbexb, mnt_exinf_am, nbexh, mnt_exh_am, mnt_ghs50_am,
          mnt_majo, mnt_18, mnt_fj2, ghsmin, ghsminam,
          nb_dialyse, mnt_dialyse, nb_po, mnt_po, nb_rxt, mnt_rxt,
          nb_rea, mnt_rea, nb_nn, mnt_nn, nbcaisson, mnt_caisson_am, 
          nb_ant, mnt_ant_am, mnt_mon, mnt_dmi, mnt_med_atu,
          mnt_ivg_am, mnt_scd, mnt_rac,
          mnt_tot_am) %>%
  arrange(mois_sortie, rss, mois_envoi)

Résultat

pryr::object_size(db)
pryr::object_size(db_clean)

Taille divisée par 3.

Sauvegarder

saveRDS(db_clean, '../produced_data/10-vvs_2017_clean.rds')

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