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_