|
- ---
- 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
-
- Le fichier d'exhaustivité doit être fourni au format CSV avec les paramètres suivants :
-
- * séparateur de champs = ,
- * guillemets = "
- * encodage = UTF-8
- * séparateur de décimales = ,
-
- et doit être issu de la [requête suivante](https://livenne.chu-nancy.fr/shiny_files/cloture/exhaustivite.wid), exécutée le jour de la cloture.
-
- ```{r data}
- if (!dir.exists("/var/www/html/shiny_files/cloture"))
- dir.create("/var/www/html/shiny_files/cloture")
-
- file.copy("exhaustivite.wid", "/var/www/html/shiny_files/cloture", overwrite = T) -> null
-
- 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())`*
- <sup>1</sup> Montant Brut
- <sup>2</sup> 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("ATU<sup>1</sup>",
- "SE<sup>2</sup>",
- "CCAM<sup>3</sup>",
- "NGAP<sup>4</sup>"), 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)
- })
- ```
- <sup>1</sup>*Données issues des tableaux OVALIDE [2.V.VATU] de `r renderText(periode())`*
- <sup>2</sup>*Données issues des tableaux OVALIDE [2.V.VSE] de `r renderText(periode())`*
- <sup>3</sup>*Données issues des tableaux OVALIDE [2.V.VCCAM] de `r renderText(periode())`*
- <sup>4</sup>*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_
|