cloture/index.rmd

---
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")))
pdf(NULL)
```

# {.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"),
  actionButton("publish", "Publier et archiver 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)
               })
})

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())
})

```

```{r report}
observeEvent(input$publish,
  {
    req(input$annee, input$mois, exhau(), rum(), rss(), exhau_pims(), Ovalide(), OvalideP())


    rmarkdown::render("cloture.Rmd",
                      output_file = "cloture.html",
                      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())))
    file.copy("cloture.html", str_c("/var/www/html/cloture/archive/cloture", input$annee, "_", str_pad(input$mois, 2, "left", "0"), ".html"), overwrite = T)
    file.copy("cloture.html", str_c("archive/cloture", input$annee, "_", str_pad(input$mois, 2, "left", "0"), ".html"), overwrite = T)
    file.copy("cloture.html", "/var/www/html/cloture/", overwrite = T)

    showModal(modalDialog(title = "Publication", p("Fichier archivé et publié, disponible", a("ici", href = "https://livenne.chu-nancy.fr/sitedim/index.php/clot/bilan")), easyClose = T, footer = NULL))
  })
```

## 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 = "&nbsp;", 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 = "&nbsp;", 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 = "&nbsp;", 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 &euro;)", "Évolution"),
            extensions = "Buttons",
            escape = F) %>%
  formatCurrency(1:3, currency = "", interval = 3, mark = "&nbsp;", 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 = "&nbsp;", 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 (&euro;)", "Évolution")) %>%
    formatPercentage(5, digits = 2) %>%
    formatCurrency(2:4, currency = "", interval = 3, mark = "&nbsp;", 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 = "&nbsp;", 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_