From aaf002616301b0e61f6f7a32d1a7a3a77ed015fb Mon Sep 17 00:00:00 2001 From: Maxime Wack Date: Tue, 4 Apr 2017 20:13:56 +0200 Subject: [PATCH] =?UTF-8?q?Ajout=20shiny=20applet=20pour=20g=C3=A9n=C3=A9r?= =?UTF-8?q?ation=20interactive=20du=20rapport?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- index.rmd | 1054 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1054 insertions(+) create mode 100644 index.rmd diff --git a/index.rmd b/index.rmd new file mode 100644 index 0000000..febe910 --- /dev/null +++ b/index.rmd @@ -0,0 +1,1054 @@ +--- +title: Bilan de clôture +runtime: shiny +output: + html_document: + toc: true + toc_float: true +--- + +```{r init, echo = F, message = F, warning = F} +library(tidyverse) +library(DT) +library(knitr) +library(stringr) +library(plotly) +library(lubridate) +library(RMySQL) +source("functionsOvalide.R") + +opts_chunk$set(echo = F, + message = F, + warning = F, + fig.width = 10, + fig.height = 6) + +options(DT.options = list(paging = F, + searching = F, + info = F, + dom = "Bfrtip", + buttons = c("copy", "excel"))) +``` + +# {.tabset} + +## Chargement des données + +```{r data} +inputPanel( + numericInput("annee", "Année", Sys.Date() %>% year), + numericInput("mois", "Mois", Sys.Date() %>% month - 1) +) +inputPanel( + textInput("CHUuser", "Utilisateur CHU"), + passwordInput("CHUpass", "Mot de passe CHU") +) +inputPanel( + textInput("ATIHuser", "Utilisateur ePMSI"), + passwordInput("ATIHpass", "Mot de passe ePMSI"), + actionButton("goATIH", "Ok") +) +inputPanel( + textInput("user", "Utilisateur mysql livenne"), + passwordInput("password", "Mot de passe mysql livenne"), + actionButton("goLivenne", "Ok") +) +inputPanel( + fileInput("exhau_pims", "Fichier d'exhaustivité", accept = "text/csv"), + downloadButton("report", "Télécharger le rapport") +) + +# Récupération des fichiers ePMSI ---- +connected <- eventReactive(input$goATIH, { + req(input$CHUuser, input$CHUpass, input$ATIHuser, input$ATIHpass, input$annee, input$mois) + + withProgress(min = 0, max = 3, message = "Téléchargement des fichiers ePMSI", + { + + incProgress(1, detail = "Connexion à ePMSI") + connectOvalide(input$CHUuser, input$CHUpass, input$ATIHuser, input$ATIHpass) + + incProgress(1, detail = str_c("Téléchargement du tableau de", input$mois, input$annee, sep = " ")) + getOvalide(input$CHUuser, input$CHUpass, input$annee, input$mois) + + incProgress(1, detail = str_c("Téléchargement du tableau de", input$mois, input$annee - 1, sep = " ")) + getOvalide(input$CHUuser, input$CHUpass, input$annee - 1, input$mois) + }) + + T +}) + +# Extraction des données des fichiers ePMSI ---- +Ovalide <- reactive({ + req(connected()) + + liste <- read.csv2("listOvalide.csv") + + withProgress(min = 0, max = nrow(liste), message = "Extraction des tableaux ePMSI année courante", + { + + liste %>% + apply(1, . %>% + { + incProgress(1, detail = str_c("Tableau", .["table"], "-", .["subtable"], sep = " ")) + extractOvalide(input$annee, input$mois, .["table"], .["subtable"]) %>% + setNames(LETTERS[seq_along(.)]) + }) %>% + setNames(liste$name) + }) +}) + +OvalideP <- reactive({ + req(connected()) + + liste <- read.csv2("listOvalide.csv") + + withProgress(min = 0, max = nrow(liste), message = "Extraction des tableaux ePMSI année précédente", + { + + liste %>% + apply(1, . %>% + { + incProgress(1, detail = str_c("Tableau", .["table"], "-", .["subtable"], sep = " ")) + extractOvalide(input$annee - 1, input$mois, .["table"], .["subtable"]) %>% + setNames(LETTERS[seq_along(.)]) + }) %>% + setNames(liste$name) + }) +}) + +# Nettoyage des fichiers extraits. Les archives sont conservées. ---- +observe({ + req(Ovalide()) + + unlink(str_c("OVALIDE T2A.MCO.DGF", input$annee, input$mois, "html", sep = ".")) +}) + +observe({ + req(OvalideP()) + + unlink(str_c("OVALIDE T2A.MCO.DGF", input$annee - 1, input$mois, "html", sep = ".")) +}) + +# RSS depuis RDS +rss <- eventReactive(input$goLivenne, +{ + req(input$user, input$password, input$annee) + + withProgress(min = 0, max = 2, message = "Extraction des RSSs", detail = "rdsR01", + { + src_mysql("pmsi_dim", "localhost", user = input$user, password = input$password) %>% + tbl("rdsR01") %>% + filter(ANS_SORTIE > input$annee - 3) %>% + select(finess, idrss, CMD, DUREE_RSS, ANS_SORTIE, MOIS_SORTIE) %>% + collect(n = Inf) -> rdsR01 + + incProgress(1, detail = "rdsR02") + src_mysql("pmsi_dim", "localhost", user = input$user, password = input$password) %>% + tbl("rdsR02") %>% + filter(ANS_SORTIE > input$annee - 3) %>% + select(finess, idrss, CMD, DUREE_RSS, ANS_SORTIE, MOIS_SORTIE) %>% + collect(n = Inf) -> rdsR02 + + incProgress(1, detail = "Fusion R01+R02") + rdsR01 %>% bind_rows(rdsR02) %>% + rename(annee_sortie = ANS_SORTIE, + mois_sortie = MOIS_SORTIE, + cmd = CMD, + duree_rss = DUREE_RSS) + }) +}) + + +# RUM +rum <- reactive({ + req(rss()) + + withProgress(min = 0, max = 4, message = "Extraction des RUMs", detail = "fix116", + { + src_mysql("pmsi_dim", "localhost", user = input$user, password = input$password) %>% + tbl("fix116") %>% + select(finess, idrss, um) %>% + collect(n = Inf) -> fix116 + + incProgress(1, detail = "fix117") + src_mysql("pmsi_dim", "localhost", user = input$user, password = input$password) %>% + tbl("fix117") %>% + select(finess, idrss, um) %>% + collect(n = Inf) -> fix117 + + incProgress(1, detail = "Fusion fix116+fix117") + fix116 %>% bind_rows(fix117) -> fix + + incProgress(1, detail = "structure") + src_mysql("pmsi_dim_nom", "localhost", user = input$user, password = input$password) %>% + tbl("structure") %>% + filter(um != "") %>% + select(uf_date_ferm, um, pole_libelle) %>% + arrange(um, uf_date_ferm) %>% + distinct %>% + collect(n = Inf) %>% + tibble::rownames_to_column(var = "dummy") %>% # Dédoublonnage : 1 um -> 1 couple libellés + group_by(um) %>% + filter(dummy == last(dummy)) %>% + select(-dummy, -uf_date_ferm) %>% + ungroup -> struct + + + incProgress(1, detail = "Fusion RSS-RUM-Structure") + rss() %>% + left_join(fix) %>% + left_join(struct) %>% + mutate(pole_libelle = ifelse(pole_libelle == "CLOS14 HEMATOLOGIE", "SPECIALITES MEDICALES", pole_libelle)) + }) +}) + +# Exhaustivité ---- +exhau_pims <- reactive({ + req(input$exhau_pims) + + withProgress(min = 0, max = 1, message = "Exhaustivité - Lecture fichier", + { + read_csv(input$exhau_pims$datapath) %>% + setNames(c("Pole", "Service", "RUM", "DP", "Erreur", "Sortie", "Duree", "RSS")) %>% + mutate(Sortie = Sortie %>% as.Date) %>% + filter(month(Sortie) <= input$mois) + }) +}) + +db_updated <- reactive({ + req(exhau_pims(), input$user, input$password, input$annee, input$mois) + + withProgress(min = 0, max = 1, message = "Enregistrement historique exhaustivité", + { + + try({ + dbConnect(MySQL(), host = "localhost", dbname = "pmsi_dim", user = input$user, password = input$password) %>% + dbWriteTable("exhaustivite", data.frame(annee = input$annee, + mois = input$mois, + nb_rss_tot = exhau_pims() %>% + distinct(RSS, .keep_all = T) %>% + nrow, + nb_rss_manq = exhau_pims() %>% + filter(is.na(DP)) %>% + distinct(RSS) %>% + nrow), + row.names = F, + append = T) + }) + }) + + T +}) + +exhau <- reactive({ + req(input$user, input$password, db_updated(), input$annee) + + withProgress(min = 0, max = 1, message = "Lecture historique exhaustivité", + { + src_mysql("pmsi_dim", "localhost", user = input$user, password = input$password) %>% + tbl("exhaustivite") %>% + collect(n = Inf) %>% + filter(annee == input$annee) %>% + full_join(data.frame(mois = 1:12), by = "mois") %>% + select(annee, mois, rss = nb_rss_tot, manq = nb_rss_manq) + }) +}) + +output$report <- downloadHandler(filename = "bilan.html", + content = function(file) + { + rmarkdown::render("cloture.Rmd", + output_file = file, + params = list(annee = input$annee, + mois = input$mois, + rum = rum(), + rss = rss(), + exhau = exhau(), + exhau_pims = exhau_pims(), + Ovalide = tibble::data_frame(nom = names(Ovalide()), tab = Ovalide()), + OvalideP = tibble::data_frame(nom = names(OvalideP()), tab = OvalideP()))) + }) + +mois_label <- c("Janvier", + "Février", + "Mars", + "Avril", + "Mai", + "Juin", + "Juillet", + "Août", + "Septembre", + "Octobre", + "Novembre", + "Décembre") + +previous <- reactive({ + req(input$mois, input$annee) + + str_c("M", sprintf("%02.f", input$mois), "-", input$annee - 1) +}) + +current <- reactive({ + req(input$mois, input$annee) + + str_c("M", sprintf("%02.f", input$mois), "-", input$annee) +}) + +periode <- reactive({ + req(previous(), current()) + + str_c(previous(), " et de ", current()) +}) + +``` + +## Rapport + +### Production + +#### Nombre total de RUM et de RSS transmis +```{r tab1} +DT::renderDataTable({ + req(input$annee, rum(), rss()) + + rum() %>% + filter(annee_sortie == input$annee) %>% + tally %>% + bind_rows(rss() %>% + filter(annee_sortie == input$annee) %>% + tally) %>% + + datatable(rownames = c("RUM", "RSS"), + extensions = "Buttons", + colnames = c("Type de résumé", "Nombre transmis")) +}) +``` + +#### Nombre de RUM transmis par mois pour les 3 dernières années +```{r tab2a} +DT::renderDataTable({ + req(rum(), input$mois, input$annee) + + rum() %>% + count(annee_sortie, mois_sortie) %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= input$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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12"), + extensions = "Buttons") %>% + formatPercentage(c(4,5), digits = 2) +}) +``` +```{r fig2a} +renderPlotly({ + req(rum()) + + rum() %>% + count(annee_sortie, mois_sortie) %>% + ungroup %>% + mutate(annee_sortie = annee_sortie %>% factor) %>% + + ggplot( + aes(x = mois_sortie, + y = n, + color = annee_sortie, + shape = annee_sortie)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RUM") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p, tooltip = c("x", "y", "colour")) +}) +``` + +#### Nombre de RSS transmis par mois pour les 3 dernières années +```{r tab2b} +DT::renderDataTable({ + req(rss(), input$mois, input$annee) + + rss() %>% + count(annee_sortie, mois_sortie) %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= input$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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(rownames = c(mois_label, "Total clôture", "Total M12"), + extensions = "Buttons") %>% + formatPercentage(c(4,5), digits = 2) +}) +``` +```{r fig2b} +renderPlotly({ + req(rss()) + + rss() %>% + count(annee_sortie, mois_sortie) %>% + ungroup %>% + mutate(annee_sortie = annee_sortie %>% factor) %>% + + ggplot( + aes(x = mois_sortie, + y = n, + color = annee_sortie, + shape = annee_sortie)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p, tooltip = c("x", "y", "colour")) +}) +``` + +##### Nombre de RSS de 1 jour et plus transmis par mois pour les 3 dernières années +```{r tab3a} +DT::renderDataTable({ + req(rss(), input$mois, input$annee) + + rss() %>% + filter(duree_rss >= 1) %>% + count(annee_sortie, mois_sortie) %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= input$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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(extensions = "Buttons", rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +}) +``` +```{r fig3a} +renderPlotly({ + req(rss()) + + rss() %>% + filter(duree_rss >= 1) %>% + count(annee_sortie, mois_sortie) %>% + ungroup %>% + mutate(annee_sortie = annee_sortie %>% factor) %>% + + ggplot( + aes(x = mois_sortie, + y = n, + color = annee_sortie, + shape = annee_sortie)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de 1 jour et +") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p, tooltip = c("x", "y", "colour")) +}) +``` + +##### Nombre de RSS de 0 jour (hors séances) transmis par mois pour les 3 dernières années +```{r tab3b} +DT::renderDataTable({ + req(rss(), input$mois, input$annee) + + rss() %>% + filter(duree_rss == 0, cmd != 28) %>% + count(annee_sortie, mois_sortie) %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= input$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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(extensions = "Buttons", rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +}) +``` +```{r fig3b} +renderPlotly({ + req(rss()) + + rss() %>% + filter(duree_rss == 0, cmd != 28) %>% + count(annee_sortie, mois_sortie) %>% + ungroup %>% + mutate(annee_sortie = annee_sortie %>% factor) %>% + + ggplot( + aes(x = mois_sortie, + y = n, + color = annee_sortie, + shape = annee_sortie)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de 0 jour, hors séances") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p, tooltip = c("x", "y", "colour")) +}) +``` + +##### Nombre de RSS de séance transmis par mois pour les 3 dernières années +```{r tab3c} +DT::renderDataTable({ + req(rss(), input$mois, input$annee) + + rss() %>% + filter(duree_rss == 0, cmd == 28) %>% + count(annee_sortie, mois_sortie) %>% + spread(annee_sortie, n) %>% + bind_rows(filter(., mois_sortie <= input$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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + select(-mois_sortie) %>% + + datatable(extensions = "Buttons", rownames = c(mois_label, "Total clôture", "Total M12")) %>% + formatPercentage(c(4,5), digits = 2) +}) +``` +```{r fig3c} +renderPlotly({ + req(rss()) + + rss() %>% + filter(duree_rss == 0, cmd == 28) %>% + count(annee_sortie, mois_sortie) %>% + ungroup %>% + mutate(annee_sortie = annee_sortie %>% factor) %>% + + ggplot( + aes(x = mois_sortie, + y = n, + color = annee_sortie, + shape = annee_sortie)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = "RSS de séances") + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p, tooltip = c("x", "y", "colour")) +}) +``` + +#### Nombre de RUM transmis par pôle pour les 3 dernières années +```{r tab4} +DT::renderDataTable({ + req(rum(), input$mois, input$annee) + + rum() %>% + filter(mois_sortie <= input$mois) %>% + filter(! is.na(pole_libelle)) %>% + count(pole_libelle, annee_sortie) %>% + ungroup %>% + mutate(pole_libelle = pole_libelle %>% str_replace("\xc9", "É")) %>% + 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("(`",input$annee,"`-`", input$annee - 2,"`)/`", input$annee - 2,"`"), str_c(input$annee, "-", input$annee - 2))) %>% + mutate_(.dots = setNames(str_c("(`",input$annee,"`-`", input$annee - 1,"`)/`", input$annee - 1,"`"), str_c(input$annee, "-", input$annee - 1))) %>% + + datatable(extensions = "Buttons", colnames = c("Pôle" = 1), rownames = F) %>% + formatPercentage(c(5,6), digits = 2) +}) +``` +```{r fig4} +renderPlotly({ + req(rum(), input$mois, input$annee) + + rum() %>% + filter(mois_sortie <= input$mois) %>% + filter(! is.na(pole_libelle)) %>% + count(pole_libelle, annee_sortie) %>% + ungroup %>% + mutate(pole_libelle = pole_libelle %>% str_replace("\xc9", "É")) %>% + + ggplot( + aes(x = annee_sortie, + y = n, + color = pole_libelle)) + + scale_x_continuous(breaks = (input$annee - 2):input$annee) + + facet_wrap(~ pole_libelle, scales = "free") + + geom_point() + + geom_line() + + labs(x = NULL, + y = NULL, + title = "RUM par pôle") + + theme_bw() + + theme(legend.position = "none", + plot.title = element_text(hjust = 0)) +}) +``` + +### Exhaustivité + +#### Exhaustivité des RSS en fonction du mois et de l'année de clôture + +##### Nombre de RSS produits et transmis, et taux d'exhaustivité : historique des clôtures de l'année +```{r tab5} +DT::renderDataTable({ + req(exhau()) + + exhau() %>% + mutate(rss_trans = rss - manq, + exh = rss_trans / rss) %>% + select(rss, rss_trans, exh) %>% + + datatable(colnames = c("Clôture", "Total RSS produits", "Nombre de RSS transmis", "Taux d'exhaustivité RSS (%)"), + extensions = "Buttons", + rownames = mois_label) %>% + formatPercentage(3, digits = 2) +}) +``` + +##### Taux d'exhaustivité selon le mois clôturé de l'année courante +```{r fig5a} +renderPlotly({ + req(exhau()) + + exhau() %>% + mutate(rss_trans = rss - manq, + exh = 100 * rss_trans / rss) %>% + + ggplot( + aes(x = mois, + y = exh)) + + geom_point() + + geom_line() + + labs(x = NULL, + y = NULL, + title = NULL) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) -> p + ggplotly(p) +}) +``` + +#### Exhaustivité mensuelle de la clôture + +##### Taux d'exhaustivité des RSS pour la clôture actuelle selon le mois de sortie du RSS +```{r fig7} +renderPlotly({ + req(exhau_pims()) + + exhau_pims() %>% + mutate(mois_sortie = month(Sortie)) %>% + filter(is.na(DP)) %>% + distinct(RSS, .keep_all = T) %>% + count(mois_sortie) %>% + full_join(exhau_pims() %>% + mutate(mois_sortie = month(Sortie)) %>% + distinct(RSS, .keep_all = T) %>% + count(mois_sortie), + by = "mois_sortie") %>% + mutate(n = 100 * (n.y - n.x) / n.y) %>% + complete(mois_sortie = 1:input$mois, fill = list(n = 100)) %>% + + ggplot( + aes(x = mois_sortie, + y = n)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = NULL) + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p) +}) +``` + +##### Nombre de RSS manquants pour la clôture actuelle selon le mois de sortie du RSS +```{r fig8} +renderPlotly({ + req(exhau_pims()) + + exhau_pims() %>% + mutate(mois_sortie = month(Sortie)) %>% + filter(is.na(DP)) %>% + distinct(RSS, .keep_all = T) %>% + count(mois_sortie) %>% + complete(mois_sortie = 1:input$mois, fill = list(n = 0)) %>% + + ggplot( + aes(x = mois_sortie, + y = n)) + + scale_x_discrete(limits = mois_label, expand = c(.05, 0)) + + geom_line() + + geom_point() + + labs(x = NULL, + y = NULL, + title = NULL) + + theme_bw() + + theme(axis.text.x = element_text(angle = 45, hjust = 1), + legend.title = element_blank(), + plot.title = element_text(hjust = 0)) -> p + ggplotly(p) +}) +``` + +#### Exhaustivité par pôle et par service +```{r tab9} +DT::renderDataTable({ + req(exhau_pims()) + + exhau_pims() %>% + group_by(Pole, Service) %>% + summarise(Prod = n()) %>% + full_join(exhau_pims() %>% + filter(is.na(DP)) %>% + group_by(Pole, Service) %>% + summarise(Manquants = n())) %>% + full_join(exhau_pims() %>% + filter(Erreur == 4) %>% + group_by(Pole, Service) %>% + summarise(Rumrss = n())) %>% + bind_rows(exhau_pims() %>% + group_by(Pole) %>% + summarise(Prod = n()) %>% + full_join(exhau_pims() %>% + filter(is.na(DP)) %>% + group_by(Pole) %>% + summarise(Manquants = n())) %>% + full_join(exhau_pims() %>% + filter(Erreur == 4) %>% + group_by(Pole) %>% + summarise(Rumrss = n()))) %>% + bind_rows(exhau_pims() %>% + summarise(Prod = n()) %>% + bind_cols(exhau_pims() %>% + filter(is.na(DP)) %>% + summarise(Manquants = n())) %>% + bind_cols(exhau_pims() %>% + filter(Erreur == 4) %>% + summarise(Rumrss = n()))) %>% + ungroup %>% + arrange(Pole, Service) %>% + select(Pole, Service, Manquants, Rumrss, Prod) %>% + mutate(Service = ifelse(is.na(Service), "TOTAL", Service), + Exh_rum = (Prod - Manquants) / Prod, + Exh_rumrss = (Prod - Rumrss) / Prod, + Exh_rum = ifelse(is.na(Exh_rum), 1, Exh_rum), + Pole = Pole %>% factor, + Exh_rumrss = ifelse(is.na(Exh_rumrss), 1, Exh_rumrss)) %>% + + datatable(colnames = c("Pôle", "Service", "RUM manquants", "RUM dans RSS manquant", "Production RUM", "Exhaustivité RUM", "Exhaustivité RUM-RSS"), + extensions = "Buttons", + rownames = F, + filter = "top", + options = list(searching = T, + paging = T)) %>% + formatPercentage(c(6,7), digits = 2) +}) +``` + +### Valorisation + +#### Nombre et valorisation des RSA transmis, traités et valorisés +```{r tab10} +DT::renderDataTable({ + req(OvalideP(), Ovalide()) + + OvalideP()$SVA %>% + full_join(Ovalide()$SVA, by = "A") %>% + mutate(D = C.y - C.x, + E = (C.y - C.x) / C.x) %>% + + datatable(rownames = F, + extensions = "Buttons", + escape = F, + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "RSA"), + th(colspan = 2, previous()), + th(colspan = 2, current()), + th(colspan = 2, "Évolution")), + tr(th("Effectif"), + th("Montant BR"), + th("Effectif"), + th("Montant BR"), + th("€"), + th("%")) + ) + ))) %>% + formatCurrency(c(3,5,6), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>% + formatPercentage(7, digits = 2) +}) +``` +*Données issues des tableaux OVALIDE [1.V.1.SV] A de `r renderText(periode())`* + +#### Valorisation des RSA non pris en charge par l'Assurance Maladie +```{r tab11} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + OvalideP()$VSS %>% select(1:3) %>% + full_join(Ovalide()$VSS %>% select(1:3), by = "A") %>% + mutate(D = C.y - C.x, + E = (C.y - C.x) / C.x) %>% + + datatable(rownames = F, + extensions = "Buttons", + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "Composante"), + th(colspan = 2, previous()), + th(colspan = 2, current()), + th(colspan = 2, "Évolution")), + tr(th("Effectif"), + th("Montant BR"), + th("Effectif"), + th("Montant BR"), + th("€"), + th("%")) + ) + ) + )) %>% + formatCurrency(c(3,5,6), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>% + formatPercentage(7, digits = 2) +}) +``` +*Données issues des tableaux [1.V.1.VSS] A de `r renderText(periode())`* + +#### Taux de remboursement des RSA pris en charge par l'Assurance Maladie +```{r tab12} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + OvalideP()$TXR %>% + full_join(Ovalide()$TXR, by = c("A", "B")) %>% + + datatable(rownames = F, + extensions = "Buttons", + container = htmltools::withTags(table(class = 'display', + thead(tr(th(rowspan = 2, "Taux de remboursement"), + th(rowspan = 2, "Type"), + th(colspan = 2, previous()), + th(colspan = 2, current())), + tr(th("Effectif"), + th("%"), + th("Effectif"), + th("%")) + ) + ) + )) %>% + formatCurrency(c(4, 6), digits = 2, currency = "", dec.mark = ",") +}) +``` +*Données issues des tableaux OVALIDE [1.V.1.TXR] C de `r renderText(periode())`* +_\* Séjours de NN, radiothérape ou PO_ + +#### Valorisation des RSA pris en charge par l'Assurance Maladie +```{r tab13} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + OvalideP()$RAV[-(1:2), c(1,4,6)] %>% + full_join(Ovalide()$RAV[-(1:2), c(1,4,6)], by = "A") %>% + mutate(D.z = (D.y - D.x) / D.x, + F.z = (F.y - F.x) / F.x) %>% + .[names(.) %>% sort] %>% + + datatable(rownames = F, + extensions = "Buttons", + 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 remboursé AM²"), + th(rowspan = 2, "Evol. montant remboursé AM²")), + tr(rep(c(previous(), current()), 2) %>% + lapply(th)) + ) + ) + )) %>% + formatPercentage(c(4, 7), digits = 2) %>% + formatCurrency(c(2, 3, 5, 6), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +}) +``` +*Données issues des tableaux OVALIDE [1.V.1.RAV] C de `r renderText(periode())`* +1 Montant Brut +2 Montant Remboursé par l'Assurance Maladie + +#### Valorisation des IVG, ATU, SE, actes et consultations +```{r tab14} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + data_frame(A = c(OvalideP()$VATU[is.na(OvalideP()$VATU$A), 3:5] %>% unlist, + OvalideP()$VSE[OvalideP()$VSE$A == "", 3:5] %>% unlist, + OvalideP()$VCCAM[OvalideP()$VCCAM$A == "", 2:4] %>% unlist, + OvalideP()$VNGAP[OvalideP()$VNGAP$A == "", 3:5] %>% unlist), + B = c(Ovalide()$VATU[is.na(Ovalide()$VATU$A), 3:5] %>% unlist, + Ovalide()$VSE[Ovalide()$VSE$A == "", 3:5] %>% unlist, + Ovalide()$VCCAM[Ovalide()$VCCAM$A == "", 2:4] %>% unlist, + Ovalide()$VNGAP[Ovalide()$VNGAP$A == "", 3:5] %>% unlist)) %>% + mutate(C = B - A, + D = (B - A) / A) %>% + + 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(previous(), current(), "Évolution (n ou €)", "Évolution"), + extensions = "Buttons", + escape = F) %>% + formatCurrency(1:3, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>% + formatPercentage(4, digits = 2) +}) +``` +1*Données issues des tableaux OVALIDE [2.V.VATU] de `r renderText(periode())`* +2*Données issues des tableaux OVALIDE [2.V.VSE] de `r renderText(periode())`* +3*Données issues des tableaux OVALIDE [2.V.VCCAM] de `r renderText(periode())`* +4*Données issues des tableaux OVALIDE [2.V.VNGAP] de `r renderText(periode())`* + +#### Nombre de Suppléments valorisés, Performance et Valorisation des séjours non envoyés +```{r tab15} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + OvalideP()$UMAS %>% + full_join(Ovalide()$UMAS, by = "A") %>% + mutate(C = B.y - B.x, + D = (B.y - B.x) / B.x) %>% + + datatable(rownames = F, + extensions = "Buttons", + colnames = c(previous(), current(), "É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 renderText(periode())`* + +#### Prix Moyen du Cas Traité\* de l'année en cours et de l'année précédente +```{r tab16} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + OvalideP()$SVB %>% + mutate(B = C/B) %>% + select(-C) %>% + full_join(Ovalide()$SVB %>% + mutate(B = C/B) %>% + select(-C), + by = "A") %>% + mutate(C = B.y - B.x, + D = (B.y - B.x) / (B.x)) %>% + + datatable(escape = F, + extensions = "Buttons", + rownames = F, + colnames = c("Type de séjours", previous(), current(), "Évolution (€)", "Évolution")) %>% + formatPercentage(5, digits = 2) %>% + formatCurrency(2:4, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +}) +``` +*Données issues des tableaux OVALIDE [1.V.1.SV] B de `r renderText(periode())`* +_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_ + +#### Estimation de la valorisation des séjours non transmis de l'année en cours +```{r tab17} +DT::renderDataTable({ + req(exhau_pims(), Ovalide(), OvalideP()) + + exhau_pims() %>% filter(is.na(DP), Duree == 0) %>% distinct(RSS) %>% nrow -> zero + exhau_pims() %>% filter(is.na(DP), Duree > 0) %>% distinct(RSS) %>% nrow -> plus + + data.frame(zero = c(zero, Ovalide()$SVB$C[3]/Ovalide()$SVB$B[3], zero * Ovalide()$SVB$C[3]/Ovalide()$SVB$B[3]), + plus = c(plus, Ovalide()$SVB$C[2]/Ovalide()$SVB$B[2], plus * Ovalide()$SVB$C[2]/Ovalide()$SVB$B[2])) %>% + + datatable(escape = F, + extensions = "Buttons", + rownames = c("Nombre", "PMCT*", "Valorisation"), + colnames = c("Indicateur", "0 jour", "Plus de 0 jour")) %>% + formatCurrency(1:2, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") +}) +``` +*Données issues de la requête BO «`r renderText(current())`» et des tableaux OVALIDE [1.V.1.SV] B de `r renderText(periode())`* +_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_ + +#### 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} +DT::renderDataTable({ + req(Ovalide(), OvalideP()) + + if (nrow(Ovalide()$EDMS) == 6) + { + 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]]) + } else { + IP_current <- Ovalide()$EDMS[[1, 2]] / Ovalide()$EDMS[[2, 2]] + IP_previous <- OvalideP()$EDMS[[1, 2]] / OvalideP()$EDMS[[2, 2]] + } + + data_frame(IP_previous, IP_current) %>% + datatable(rownames = "Indice de performance", + extensions = "Buttons", + colnames = c(previous(), current())) %>% + formatCurrency(1:2, currency = "", digits = 3, dec.mark = ",") +}) +``` +*Données issues des tableaux OVALIDE [1.D2.EDMS] de `r renderText(periode())`* +_\* Nb de journées / Nb de journées standardisées sur la DMS théorique_