From f49d4ee4cd583e53f5338b59bde4c467711bcdc5 Mon Sep 17 00:00:00 2001 From: Maxime Wack Date: Fri, 11 Dec 2015 11:13:19 +0100 Subject: [PATCH] Init commit --- README.md | 1 + cloture.R | 2 + cloture.Rmd | 637 +++++++++++++++++++++++++++++++++++++++++++++ donnees.R | 59 +++++ functionsOvalide.R | 36 +++ listOvalide.csv | 12 + render.R | 61 +++++ 7 files changed, 808 insertions(+) create mode 100644 README.md create mode 100644 cloture.R create mode 100644 cloture.Rmd create mode 100644 donnees.R create mode 100644 functionsOvalide.R create mode 100644 listOvalide.csv create mode 100644 render.R diff --git a/README.md b/README.md new file mode 100644 index 0000000..a8df8ec --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# Scripts d'automatisation de cloture mensuelle diff --git a/cloture.R b/cloture.R new file mode 100644 index 0000000..278fbcd --- /dev/null +++ b/cloture.R @@ -0,0 +1,2 @@ +source("render.R") +render_with_widgets("cloture.Rmd") diff --git a/cloture.Rmd b/cloture.Rmd new file mode 100644 index 0000000..582bd81 --- /dev/null +++ b/cloture.Rmd @@ -0,0 +1,637 @@ +```{r init, echo = F, message = F} +library(DT) +library(ggplot2) +library(knitr) +library(tidyr) +library(stringr) +library(dplyr) + +opts_chunk$set(echo = F, + message = F, + error = F, + warning = F, + fig.width = 12, + fig.height = 7) + +options(DT.options = list(paging = F, + searching = F, + info = "")) +``` + +```{r data} +load("donnees.Rdata") + +mois_label <- c("Janvier", + "Février", + "Mars", + "Avril", + "Mai", + "Juin", + "Juillet", + "Août", + "Septembre", + "Octobre", + "Novembre", + "Décembre") + +sprintf("%02.f", mois) %>% +{ + previous <<- str_c("M", ., "-", annee - 1) + current <<- str_c("M", ., "-", annee) + periode <<- str_c(previous, " et de ", current) +} + +``` + +# Outils informatiques + +```{r outils} +data_frame(Logiciels = c("Fichsup", + "Genrsa", + "Magic", + "Preface"), + `N° de version` = c("9.4.1", + "11.6.6.2", + "4.5.0.0", + "2.2.3.0")) %>% + + datatable(rownames = F) +``` + +# Calendrier + +```{r calendrier} +data_frame(Dates = rep(date, 5), + `Évènement` = c("Clôture et arrêté des données Webpims, Extraction Webpims", + "Création des fichiers, vérifications et corrections", + "Traitements réglementaires, vérifications et corrections", + "Retour traitement e-PMSI", + "Validation de l'envoi")) %>% + + datatable(rownames = F) +``` + +# Nombre total de RUM et de RSS transmis + +**Tableau 1 : Nombre de RUM et de RSS transmis pour la clôture** +```{r tab1} +rum %>% + filter(annee_sortie == annee) %>% + tally %>% + bind_rows(rum %>% + filter(annee_sortie == annee) %>% + distinct(idrss) %>% + tally) %>% + + datatable(rownames = c("RUM", "RSS"), + colnames = c("Type de résumé", "Nombre produit")) +``` + +# Nombre de RUM et de RSS transmis par mois pour les 3 dernières années + +**Tableau 2a : Nombre de RUM transmis par mois pour les 3 dernières années** +```{r tab2a} +rum %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= mois) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + bind_rows(filter(., mois_sortie <= 12) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +``` + +**Figure 2a : Nombre de RUM transmis par mois pour les 3 dernières années** +```{r fig2a} +rum %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = mois_sortie, + y = n, + color = annee_sortie %>% factor, + shape = annee_sortie %>% factor) + + scale_x_discrete(labels = mois_label) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RUM") + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 2a + +**Tableau 2b : Nombre de RSS transmis par mois pour les 3 dernières années** +```{r tab2b} +rum %>% + distinct(idrss) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= mois) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + bind_rows(filter(., mois_sortie <= 12) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +``` + +**Figure 2b : Nombre de RSS transmis par mois pour les 3 dernières années** +```{r fig2b} +rum %>% + distinct(idrss) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = mois_sortie, + y = n, + color = annee_sortie %>% factor, + shape = annee_sortie %>% factor) + + scale_x_discrete(labels = mois_label) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS") + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 2b + +# Nombre de RSS transmis par mois et par type de séjours pour les 3 dernières années + +**Tableau 3a : Nombre de RSS de 1 jour et plus transmis par mois pour les 3 dernières années** +```{r tab3a} +rum %>% + distinct(idrss) %>% + filter(duree_rss >= 1) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= mois) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + bind_rows(filter(., mois_sortie <= 12) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +``` + +**Figure 3a : Nombre de RSS de 1 jour et plus transmis par mois pour les 3 dernières années** +```{r fig3a} +rum %>% + distinct(idrss) %>% + filter(duree_rss >= 1) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = mois_sortie, + y = n, + color = annee_sortie %>% factor, + shape = annee_sortie %>% factor) + + scale_x_discrete(labels = mois_label) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de 1 jour et +") + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 3a + +**Tableau 3b : Nombre de RSS de 0 jour (hors séances) transmis par mois pour les 3 dernières années** +```{r tab3b} +rum %>% + distinct(idrss) %>% + filter(duree_rss == 0, cmd != 28) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= mois) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum)) + ) %>% + bind_rows(filter(., mois_sortie <= 12) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum)) + ) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +``` + +**Figure 3b : Nombre de RSS de 0 jour (hors séances) transmis par mois pour les 3 dernières années** +```{r fig3b} +rum %>% + distinct(idrss) %>% + filter(duree_rss == 0, cmd != 28) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = mois_sortie, + y = n, + color = annee_sortie %>% factor, + shape = annee_sortie %>% factor) + + scale_x_discrete(labels = mois_label) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de 0 jour, hors séances") + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 3b + +**Tableau 3c : Nombre de RSS de séance transmis par mois pour les 3 dernières années** +```{r tab3c} +rum %>% + distinct(idrss) %>% + filter(duree_rss == 0, cmd == 28) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= mois) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + bind_rows(filter(., mois_sortie <= 12) %>% + select(-mois_sortie) %>% + summarise_each(funs(sum))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +``` + +**Figure 3c : Nombre de RSS de séance transmis par mois pour les 3 dernières années** +```{r fig3c} +rum %>% + distinct(idrss) %>% + filter(duree_rss == 0, cmd == 28) %>% + group_by(annee_sortie, mois_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = mois_sortie, + y = n, + color = annee_sortie %>% factor, + shape = annee_sortie %>% factor) + + scale_x_discrete(labels = mois_label) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de séances") + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 3c + +# Nombre de RUM transmis par pôle pour les 3 dernières années + +**Tableau 4 : Nombre de RUM transmis par pôle depuis le début de l'année, pour les 3 dernières années** +```{r tab4} +rum %>% + filter(mois_sortie <= mois) %>% + group_by(pole_libelle, annee_sortie) %>% + tally %>% + ungroup %>% + spread(annee_sortie, n) %>% + bind_rows(select(., -pole_libelle) %>% + summarise_each(funs(sum(., na.rm = T))) %>% + mutate(pole_libelle = "TOTAL")) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>% + + datatable(colnames = c("Pôle" = 1), rownames = F) %>% + formatPercentage(c(5,6), digits = 2) +``` + +**Figure 4 : Nombre de RUM transmis par pôle depuis le début de l'année, pour les 3 dernières années** +```{r fig4} +rum %>% + filter(mois_sortie <= mois) %>% + group_by(pole_libelle, annee_sortie) %>% + tally %>% + ungroup %>% + + ggplot + + aes(x = annee_sortie, + y = n, + color = pole_libelle) + + scale_x_continuous(breaks = (annee - 2):annee) + + facet_wrap(~ pole_libelle, scales = "free") + + geom_point() + + geom_line() + + labs(x = NULL, + y = NULL, + title = "RUM par pôle") + + theme(legend.position = "none", + plot.title = element_text(hjust = 0)) +``` + +Données issues du tableau 4 + +# Exhaustivité des RUM et des RSS en fonction du mois et de l'année de clôture + +**Tableau 5 : Nombre de RUM et de RSS produits et transmis, et taux d'exhaustivité** +```{r tab5} + +``` + +**Figure 5a** +```{r fig5a} + +``` + +**Figure 5b** +```{r fig5b} + +``` + +**Figure 5c** +```{r fig5c} + +``` + +# Exhaustivité des RSS au moment de la clôture pour les 2 dernières années + +**Figure 6** +```{r fig6} + +``` + +# Exhaustivité mensuelle de la clôture + +**Figure 7 : Taux d'exhaustivité des RSS pour la clôture actuelle selon le mois de sortie du RSS** +```{r fig7} + +``` + +**Figure 8 : Nombre de RSS manquants pour la clôture actuelle selon le mois de sortie du RSS** +```{r fig8} + +``` + +# Exhaustivité par pôle et par service + +**Tableau 9 : Nombre de RUM et taux d'exhaustivité par pole et par service** +```{r fig9} + +``` + +# Nombre et valorisation des RSA transmis, traités et valorisés + +**Tableau 10 : Nombre de RSA transmis et valorisés de l'année en cours et de l'année précédente** +```{r tab10} +Ovalide$SVA %>% + full_join(OvalideP$SVA, by = "A") %>% + + datatable(rownames = F, + escape = F, + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "RSA"), + th(colspan = 2, current), + th(colspan = 2, previous)), + tr(th("Effectif"), + th("Montant BR"), + th("Effectif"), + th("Montant BR")) + ) + ))) %>% + formatCurrency(c(3,5), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +``` + +Données issues des tableaux OVALIDE [1.V.1.SV] A de `r periode` + +# Valorisation des RSA non pris en charge par l'Assurance Maladie + +**Tableau 11 : Valorisation des RSA supprimés de l'année en cours et de l'année précédente** +```{r tab11} +Ovalide$VSS %>% select(1:3) %>% + full_join(OvalideP$VSS %>% select(1:3), by = "A") %>% + + datatable(rownames = F, + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "Composante"), + th(colspan = 2, current), + th(colspan = 2, previous)), + tr(th("Effectif"), + th("Montant BR"), + th("Effectif"), + th("Montant BR")) + ) + ) + )) %>% + formatCurrency(c(3,5), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +``` + +Données issues des tableaux [1.V.1.VSS] A de `r periode` + +# Taux de remboursement des RSA pris en charge par l'Assurance Maladie + +**Tableau 12 : Taux de remboursement des séjours de l'année en cours et de l'année précédente** +```{r tab12} +Ovalide$TXR %>% + full_join(OvalideP$TXR, by = c("A", "B")) %>% + + datatable(rownames = F, + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "Taux de remboursement"), + th(rowspan = 2, "Type"), + th(colspan = 2, current), + th(colspan = 2, previous)), + tr(th("Effectif"), + th("%"), + th("Effectif"), + th("%")) + ) + ) + )) %>% + formatCurrency(c(4, 6), digits = 2, currency = "", dec.mark = ",") +``` +_\* Séjours de NN, radiothérape ou PO_ +Données issues des tableaux OVALIDE [1.V.1.TXR] C de `r periode` + +# Valorisation des RSA pris en charge par l'Assurance Maladie + +**Tableau 13 : Détail de la valorisation des séjours et séances pris en charge par l'Assurance Maladie de l'année en cours et de l'année précédente** +```{r tab13} +Ovalide$RAV[-(1:2), c(1,4:6)] %>% + full_join(OvalideP$RAV[-(1:2), c(1,4:6)], by = "A") %>% + mutate(D.z = (D.x - D.y) / D.y, + E.z = (E.x - E.y) / E.y, + F.z = (F.x - F.y) / F.y) %>% + .[names(.) %>% sort] %>% + + datatable(rownames = F, + escape = F, + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "Composante"), + th(colspan = 2, "Montant BR¹"), + th(rowspan = 2, "Evol. montant BR¹"), + th(colspan = 2, "Montant CP²"), + th(rowspan = 2, "Evol. montant CP²"), + th(colspan = 2, "Montant remboursé AM³"), + th(rowspan = 2, "Evol. montant remboursé AM³")), + tr(rep(c(current, previous), 3) %>% + lapply(th)) + ) + ) + )) %>% + formatPercentage(c(4, 7, 10), digits = 2) %>% + formatCurrency(c(2, 3, 5, 6, 8, 9), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +``` + +1 Montant Brut +2 Montant avec Coefficient Prudentiel +3 Montant Remboursé par l'Assurance Maladie + +Données issues des tableaux OVALIDE [1.V.1.RAV] C de `r periode` + +# Valorisation des IVG, ATU, SE, actes et consultations + +**Tableau 14 : Effectifs et valorisation ACE de l'année en cours et de l'année précédente** +```{r tab14} +data_frame(A = c(Ovalide$VATU[nrow(Ovalide$VATU), 3:5] %>% unlist, + Ovalide$VSE[nrow(Ovalide$VSE), 3:5] %>% unlist, + Ovalide$VCCAM[nrow(Ovalide$VCCAM), 2:4] %>% unlist, + Ovalide$VNGAP[nrow(Ovalide$VNGAP), 3:5] %>% unlist), + B = c(OvalideP$VATU[nrow(OvalideP$VATU), 3:5] %>% unlist, + OvalideP$VSE[nrow(OvalideP$VSE), 3:5] %>% unlist, + OvalideP$VCCAM[nrow(OvalideP$VCCAM), 2:4] %>% unlist, + OvalideP$VNGAP[nrow(OvalideP$VNGAP), 3:5] %>% unlist)) %>% + mutate(C = A - B, + D = (A - B) / B) %>% + + datatable(rownames = str_c(rep(c("Nombre de prestations", + "Valorisation brute", + "Valorisation AM"),4), + rep(c("ATU1", + "SE2", + "CCAM3", + "NGAP4"), each = 3), sep = " "), + colnames = c(current, previous, "Évolution (n ou €)", "Évolution"), + escape = F) %>% + formatCurrency(1:3, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>% + formatPercentage(4, digits = 2) +``` + +1Données issues des tableaux OVALIDE [2.V.VATU] de `r periode` +2Données issues des tableaux OVALIDE [2.V.VSE] de `r periode` +3Données issues des tableaux OVALIDE [2.V.VCCAM] de `r periode` +4Données issues des tableaux OVALIDE [2.V.VNGAP] de `r periode` + +# Nombre de Suppléments valorisés, Performance et Valorisation des séjours non envoyés + +**Tableau 15 : Nombre de suppléments valorisés de l'année en cours et de l'année précédente** +```{r tab15} +Ovalide$UMAS %>% + full_join(OvalideP$UMAS, by = "A") %>% + mutate(C = B.x - B.y, + D = (B.x - B.y) / B.y) %>% + + datatable(rownames = F, + colnames = c(current, previous, "Évolution (n)", "Évolution")) %>% + formatCurrency(2:4, currency = "", interval = 3, mark = " ", digits = 0) %>% + formatPercentage(5, digits = 2) +``` + +Données issues des tableaux OVALIDE [1.V.1.UMAS] E de `r periode` + +**Tableau 16 : Prix Moyen du Cas Traité\* de l'année en cours et de l'année précédente** +```{r tab16} +Ovalide$SVB %>% + mutate(B = C/B) %>% + select(-C) %>% + full_join(OvalideP$SVB %>% + mutate(B = C/B) %>% + select(-C), + by = "A") %>% + mutate(C = B.x - B.y, + D = (B.x - B.y) / (B.y)) %>% + + datatable(escape = F, + rownames = F, + colnames = c("Type de séjours", current, previous, "Évolution (€)", "Évolution")) %>% + formatPercentage(5, digits = 2) %>% + formatCurrency(2:4, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +``` +_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_ + +Données issues des tableaux OVALIDE [1.V.1.SV] B de `r periode` + +**Tableau 17 : Estimation de la valorisation des séjours non transmis de l'année en cours et de l'année précédente** +```{r tab17} + + +``` +_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_ + +Données issues de la requête BO «`r current`» exécutée le `r date` et des tableaux OVALIDE [1.V.1.SV] B de `r periode` + +**Tableau 18 : Indice de performance de la durée moyenne de séjours (IP-DMS) de l'année en cours et de l'année précédente** +```{r tab18} +Ovalide$EDMS %<>% + filter(A != ".") %>% + mutate(B = B %>% str_replace(",",".")) %>% + mutate(B = B %>% as.numeric) +OvalideP$EDMS %<>% + filter(A != ".") %>% + mutate(B = B %>% str_replace(",",".")) %>% + mutate(B = B %>% as.numeric) +IP_current <- (Ovalide$EDMS[[1, 2]] + Ovalide$EDMS[[4, 2]]) / (Ovalide$EDMS[[2, 2]] + Ovalide$EDMS[[5, 2]]) +IP_previous <- (OvalideP$EDMS[[1, 2]] + OvalideP$EDMS[[4, 2]]) / (OvalideP$EDMS[[2, 2]] + OvalideP$EDMS[[5, 2]]) +data_frame(IP_current, IP_previous) %>% + datatable(rownames = "Indice de performance", + colnames = c(current, previous)) %>% + formatCurrency(1:2, currency = "", digits = 3, dec.mark = ",") +``` +_\* Nb de journées / Nb de journées standardisées sur la DMS théorique_ + +Données issues des tableaux OVALIDE [1.D2.EDMS] de `r periode` diff --git a/donnees.R b/donnees.R new file mode 100644 index 0000000..13308e3 --- /dev/null +++ b/donnees.R @@ -0,0 +1,59 @@ +source("functionsOvalide.R") +library(lubridate) + +annee <- 2015 +mois <- 10 +date <- "04/12/2015" + +read.csv2("listOvalide.csv") %>% +{ + apply(., 1, . %>% + { + df <- extractOvalide(annee, mois, .[2], .[3]) + names(df) <- LETTERS[1:length(df)] + df + }) ->> Ovalide + names(Ovalide) <<- .$name + + apply(., 1, . %>% + { + df <- extractOvalide(annee - 1, mois, .[2], .[3]) + names(df) <- LETTERS[1:length(df)] + df + }) ->> OvalideP + names(OvalideP) <<- .$name +} + +src_mysql("pmsi_dim", "livenne.chu-nancy.fr", user = "u992093", password = "Md;8G4iSm") %>% + tbl(sql("SELECT idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix116 + UNION + SELECT idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix117")) %>% + collect %>% + mutate(date_entree = date_entree %>% as.Date, + date_sortie = date_sortie %>% as.Date, + annee_sortie = year(date_sortie), + mois_sortie = month(date_sortie)) %>% + filter(annee_sortie > annee - 3) %>% # Données rum/rss depuis 3 ans + left_join( # + libellés pôles et services + src_mysql("pmsi_dim_nom", "livenne.chu-nancy.fr", user = "u992093", password = "Md;8G4iSm") %>% + tbl("structure") %>% + filter(um != "") %>% + select(uf_date_ferm, um, service_libelle, pole_libelle) %>% + arrange(um, uf_date_ferm) %>% + distinct %>% + collect %>% + add_rownames(var = "dummy") %>% # Dédoublonnage : 1 um -> 1 couple libellés + group_by(um) %>% + filter(dummy == last(dummy)) %>% + select(-dummy, -uf_date_ferm) %>% + ungroup + ) %>% + mutate(idrss = ifelse(idhosp %>% str_detect("^13"), str_c("m", idrss), idrss)) %>% # Dédoublonnage rss maternité 2013 + select(-idhosp) %>% + mutate(duree_rum = date_sortie - date_entree) %>% # durée rum + left_join( # durée rss + group_by(., idrss) %>% + summarise(duree_rss = sum(duree_rum)) + ) -> rum + +save(Ovalide, OvalideP, annee, mois, rum, date, file = "donnees.Rdata") \ No newline at end of file diff --git a/functionsOvalide.R b/functionsOvalide.R new file mode 100644 index 0000000..55a262a --- /dev/null +++ b/functionsOvalide.R @@ -0,0 +1,36 @@ +library(dplyr) +library(readr) +library(stringr) +library(rvest) + +extractOvalide <- function(annee, mois, table, subtable = "") +{ + # Lire le fichier + corrections + str_c("OVALIDE T2A.MCO.DGF", annee, mois, "html", sep = ".") %>% + read_file(locale = locale(encoding = "ISO8859-1")) %>% + str_replace_all("\\n", "") %>% + str_replace_all("
", " ") -> current + + # Extraction de la table + if (table == "1.D.2.EDMS") + { + current %>% + str_extract(str_c('Tableau \\[', table, '\\] ', subtable, '(.*?<\\/table>){3}')) %>% + str_replace_all("(\\d) (\\d)", "\\1\\2") %>% + str_replace_all("\\.<\\/td>", "<\\/td>") %>% + str_replace_all(" ", " ") %>% + read_html %>% + html_table(trim = T, dec = ",", header = F) %>% + bind_rows + } else + { + current %>% + str_extract(str_c('Tableau \\[', table, '\\] ', subtable, '(.*?<\\/table>){2}')) %>% + str_replace_all("(\\d) (\\d)", "\\1\\2") %>% + str_replace_all("\\.<\\/td>", "<\\/td>") %>% + str_replace_all(" ", " ") %>% + read_html %>% + html_table(trim = T, dec = ",") %>% + .[[1]] + } +} \ No newline at end of file diff --git a/listOvalide.csv b/listOvalide.csv new file mode 100644 index 0000000..271eeb0 --- /dev/null +++ b/listOvalide.csv @@ -0,0 +1,12 @@ +name;table;subtable +SVA;1.V.1.SV;A +VSS;1.V.1.VSS; +TXR;1.V.1.TXR;C +RAV;1.V.1.RAV; +VATU;2.V.VATU; +VSE;2.V.VSE; +VCCAM;2.V.VCCAM; +VNGAP;2.V.VNGAP; +UMAS;1.V.1.UMAS;E +SVB;1.V.1.SV;B +EDMS;1.D.2.EDMS diff --git a/render.R b/render.R new file mode 100644 index 0000000..1b9beea --- /dev/null +++ b/render.R @@ -0,0 +1,61 @@ +library("knitr") +library("htmltools") +library("base64enc") +library("markdown") +render_with_widgets <- function(input_file, + output_file = sub("\\.Rmd$", ".html", input_file, ignore.case = TRUE), + self_contained = TRUE, + deps_path = file.path(dirname(output_file), "deps")) +{ + # Read input and convert to Markdown + input <- readLines(input_file) + md <- knit(text = input) + # Get dependencies from knitr + deps <- knit_meta() + + # Convert script dependencies into data URIs, and stylesheet + # dependencies into inline stylesheets + + dep_scripts <- lapply(deps, function(x) + { + lapply(x$script, function(script) file.path(x$src$file, script)) + }) + dep_stylesheets <- lapply(deps, function(x) + { + lapply(x$stylesheet, function(stylesheet) file.path(x$src$file, stylesheet)) + }) + dep_scripts <- unique(unlist(dep_scripts)) + dep_stylesheets <- unique(unlist(dep_stylesheets)) + if (self_contained) { + dep_html <- c(sapply(dep_scripts, function(script) + { + sprintf('', dataURI(file = script)) + }), + sapply(dep_stylesheets, function(sheet) + { + sprintf('', paste(readLines(sheet), collapse = "\n")) + }) + ) + } else { + if (!dir.exists(deps_path)) + { + dir.create(deps_path) + } + for (fil in c(dep_scripts, dep_stylesheets)) + { + file.copy(fil, file.path(deps_path, basename(fil))) + } + dep_html <- c(sprintf('', file.path(deps_path, basename(dep_scripts))), + sprintf('', file.path(deps_path, basename(dep_stylesheets)))) + } + + # Extract the bits + preserved <- extractPreserveChunks(md) + + # Render the HTML, and then restore the preserved chunks + html <- markdownToHTML(text = preserved$value, header = dep_html) + html <- restorePreserveChunks(html, preserved$chunks) + + # Write the output + writeLines(html, output_file) +}