cloture/cloture.Rmd

```{r init, echo = F, message = F}
library(DT)
library(ggplot2)
library(knitr)
library(tidyr)
library(stringr)
library(dplyr)

opts_chunk$set(echo = F,
               message = F,
               error = F,
               warning = F,
               fig.width = 12,
               fig.height = 7)

options(DT.options = list(paging = F,
                          searching = F,
                          info = ""))
```

```{r data}
load("donnees.Rdata")

mois_label <- c("Janvier",
                "Février",
                "Mars",
                "Avril",
                "Mai",
                "Juin",
                "Juillet",
                "Août",
                "Septembre",
                "Octobre",
                "Novembre",
                "Décembre")

sprintf("%02.f", mois) %>%
{
  previous <<- str_c("M", ., "-", annee - 1)
  current <<- str_c("M", ., "-", annee)
  periode <<- str_c(previous, " et de ", current)
}

```

# Outils informatiques

```{r outils}
data_frame(Logiciels = c("Fichsup",
                         "Genrsa",
                         "Magic",
                         "Preface"),
           `N° de version` = c("9.4.1",
                               "11.6.6.2",
                               "4.5.0.0",
                               "2.2.3.0")) %>%

  datatable(rownames = F)
```

# Calendrier

```{r calendrier}
data_frame(Dates = rep(date, 5),
           `Évènement` = c("Clôture et arrêté des données Webpims, Extraction Webpims",
                           "Création des fichiers, vérifications et corrections",
                           "Traitements réglementaires, vérifications et corrections",
                           "Retour traitement e-PMSI",
                           "Validation de l'envoi")) %>%

  datatable(rownames = F)
```

# Nombre total de RUM et de RSS transmis

**Tableau 1 : Nombre de RUM et de RSS transmis pour la clôture**
```{r tab1}
rum %>%
  filter(annee_sortie == annee) %>%
  tally %>%
  bind_rows(rum %>%
              filter(annee_sortie == annee) %>%
              distinct(idrss) %>%
              tally) %>%

  datatable(rownames = c("RUM", "RSS"),
            colnames = c("Type de résumé", "Nombre produit"))
```

# Nombre de RUM et de RSS transmis par mois pour les 3 dernières années

**Tableau 2a : Nombre de RUM transmis par mois pour les 3 dernières années**
```{r tab2a}
rum %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  spread(annee_sortie, n) %>%
  bind_rows(filter(., mois_sortie <= mois) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  bind_rows(filter(., mois_sortie <= 12) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%
  select(-mois_sortie) %>%

  datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>%
  formatPercentage(c(4,5), digits = 2)
```

**Figure 2a : Nombre de RUM transmis par mois pour les 3 dernières années**
```{r fig2a}
rum %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  ungroup %>%
  
  ggplot +
    aes(x = mois_sortie,
        y = n,
        color = annee_sortie %>% factor,
        shape = annee_sortie %>% factor) +
    scale_x_discrete(labels = mois_label) +
    geom_line() +
    geom_point() +
    labs(x = NULL,
         y = NULL,
         title = "RUM") +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.title = element_blank(),
          plot.title = element_text(hjust = 0))
```

Données issues du tableau 2a

**Tableau 2b : Nombre de RSS transmis par mois pour les 3 dernières années**
```{r tab2b}
rum %>%
  distinct(idrss) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  spread(annee_sortie, n) %>%
  bind_rows(filter(., mois_sortie <= mois) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  bind_rows(filter(., mois_sortie <= 12) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%
  select(-mois_sortie) %>%

  datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>%
  formatPercentage(c(4,5), digits = 2)
```

**Figure 2b : Nombre de RSS transmis par mois pour les 3 dernières années**
```{r fig2b}
rum %>%
  distinct(idrss) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  ungroup %>%

  ggplot +
  aes(x = mois_sortie,
      y = n,
      color = annee_sortie %>% factor,
      shape = annee_sortie %>% factor) +
  scale_x_discrete(labels = mois_label) +
  geom_line() +
  geom_point() +
  labs(x = NULL,
       y = NULL,
       title = "RSS") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0))
```

Données issues du tableau 2b

# Nombre de RSS transmis par mois et par type de séjours pour les 3 dernières années

**Tableau 3a : Nombre de RSS de 1 jour et plus transmis par mois pour les 3 dernières années**
```{r tab3a}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss >= 1) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  spread(annee_sortie, n) %>%
  bind_rows(filter(., mois_sortie <= mois) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  bind_rows(filter(., mois_sortie <= 12) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%
  select(-mois_sortie) %>%

  datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>%
  formatPercentage(c(4,5), digits = 2)
```

**Figure 3a : Nombre de RSS de 1 jour et plus transmis par mois pour les 3 dernières années**
```{r fig3a}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss >= 1) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  ungroup %>%

  ggplot +
  aes(x = mois_sortie,
      y = n,
      color = annee_sortie %>% factor,
      shape = annee_sortie %>% factor) +
  scale_x_discrete(labels = mois_label) +
  geom_line() +
  geom_point() +
  labs(x = NULL,
       y = NULL,
       title = "RSS de 1 jour et +") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0))
```

Données issues du tableau 3a

**Tableau 3b : Nombre de RSS de 0 jour (hors séances) transmis par mois pour les 3 dernières années**
```{r tab3b}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss == 0, cmd != 28) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  spread(annee_sortie, n) %>%
  bind_rows(filter(., mois_sortie <= mois) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))
            ) %>%
  bind_rows(filter(., mois_sortie <= 12) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))
            ) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%
  select(-mois_sortie) %>%

  datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>%
  formatPercentage(c(4,5), digits = 2)
```

**Figure 3b : Nombre de RSS de 0 jour (hors séances) transmis par mois pour les 3 dernières années**
```{r fig3b}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss == 0, cmd != 28) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  ungroup %>%

  ggplot +
  aes(x = mois_sortie,
      y = n,
      color = annee_sortie %>% factor,
      shape = annee_sortie %>% factor) +
  scale_x_discrete(labels = mois_label) +
  geom_line() +
  geom_point() +
  labs(x = NULL,
       y = NULL,
       title = "RSS de 0 jour, hors séances") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0))
```

Données issues du tableau 3b

**Tableau 3c : Nombre de RSS de séance transmis par mois pour les 3 dernières années**
```{r tab3c}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss == 0, cmd == 28) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  spread(annee_sortie, n) %>%
  bind_rows(filter(., mois_sortie <= mois) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  bind_rows(filter(., mois_sortie <= 12) %>%
            select(-mois_sortie) %>%
            summarise_each(funs(sum))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%
  select(-mois_sortie) %>%

  datatable(rownames = c(mois_label, "Total clôture", "Total M12")) %>%
  formatPercentage(c(4,5), digits = 2)
```

**Figure 3c : Nombre de RSS de séance transmis par mois pour les 3 dernières années**
```{r fig3c}
rum %>%
  distinct(idrss) %>%
  filter(duree_rss == 0, cmd == 28) %>%
  group_by(annee_sortie, mois_sortie) %>%
  tally %>%
  ungroup %>%
  
  ggplot +
  aes(x = mois_sortie,
      y = n,
      color = annee_sortie %>% factor,
      shape = annee_sortie %>% factor) +
  scale_x_discrete(labels = mois_label) +
  geom_line() +
  geom_point() +
  labs(x = NULL,
       y = NULL,
       title = "RSS de séances") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0))
```

Données issues du tableau 3c

# Nombre de RUM transmis par pôle pour les 3 dernières années

**Tableau 4 : Nombre de RUM transmis par pôle depuis le début de l'année, pour les 3 dernières années**
```{r tab4}
rum %>%
  filter(mois_sortie <= mois) %>%
  group_by(pole_libelle, annee_sortie) %>%
  tally %>%
  ungroup %>%
  spread(annee_sortie, n) %>%
  bind_rows(select(., -pole_libelle) %>%
            summarise_each(funs(sum(., na.rm = T))) %>%
            mutate(pole_libelle = "TOTAL")) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 2,"`)/`", annee - 2,"`"), str_c(annee, "-", annee - 2))) %>%
  mutate_(.dots = setNames(str_c("(`",annee,"`-`", annee - 1,"`)/`", annee - 1,"`"), str_c(annee, "-", annee - 1))) %>%

  datatable(colnames = c("Pôle" = 1), rownames = F) %>%
  formatPercentage(c(5,6), digits = 2)
```

**Figure 4 : Nombre de RUM transmis par pôle depuis le début de l'année, pour les 3 dernières années**
```{r fig4}
rum %>%
  filter(mois_sortie <= mois) %>%
  group_by(pole_libelle, annee_sortie) %>%
  tally %>%
  ungroup %>%

  ggplot +
  aes(x = annee_sortie,
      y = n,
      color = pole_libelle) +
  scale_x_continuous(breaks = (annee - 2):annee) +
  facet_wrap(~ pole_libelle, scales = "free") +
  geom_point() +
  geom_line() +
  labs(x = NULL,
       y = NULL,
       title = "RUM par pôle") +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0))
```

Données issues du tableau 4

# Exhaustivité des RUM et des RSS en fonction du mois et de l'année de clôture

**Tableau 5 : Nombre de RUM et de RSS produits et transmis, et taux d'exhaustivité**
```{r tab5}

```

**Figure 5a**
```{r fig5a}

```

**Figure 5b**
```{r fig5b}

```

**Figure 5c**
```{r fig5c}

```

# Exhaustivité des RSS au moment de la clôture pour les 2 dernières années

**Figure 6**
```{r fig6}

```

# Exhaustivité mensuelle de la clôture

**Figure 7 : Taux d'exhaustivité des RSS pour la clôture actuelle selon le mois de sortie du RSS**
```{r fig7}

```

**Figure 8 : Nombre de RSS manquants pour la clôture actuelle selon le mois de sortie du RSS**
```{r fig8}

```

# Exhaustivité par pôle et par service

**Tableau 9 : Nombre de RUM et taux d'exhaustivité par pole et par service**
```{r fig9}

```

# Nombre et valorisation des RSA transmis, traités et valorisés

**Tableau 10 : Nombre de RSA transmis et valorisés de l'année en cours et de l'année précédente**
```{r tab10}
Ovalide$SVA %>%
  full_join(OvalideP$SVA, by = "A") %>%

  datatable(rownames = F,
            escape = F,
            container = htmltools::withTags(table(class = 'display',
                                                  thead(tr(th(rowspan = 2, "RSA"),
                                                           th(colspan = 2, current),
                                                           th(colspan = 2, previous)),
                                                        tr(th("Effectif"),
                                                           th("Montant BR"),
                                                           th("Effectif"),
                                                           th("Montant BR"))
                                                        )
                                                  ))) %>%
  formatCurrency(c(3,5), currency = "", interval = 3, mark = "&nbsp;", digits = 2, dec.mark = ",")
```

Données issues des tableaux OVALIDE [1.V.1.SV] A de `r periode`

# Valorisation des RSA non pris en charge par l'Assurance Maladie

**Tableau 11 : Valorisation des RSA supprimés de l'année en cours et de l'année précédente**
```{r tab11}
Ovalide$VSS %>% select(1:3) %>%
  full_join(OvalideP$VSS %>% select(1:3), by = "A") %>%

  datatable(rownames = F,
            container = htmltools::withTags(table(class = 'display',
                                                  thead(tr(th(rowspan = 2, "Composante"),
                                                           th(colspan = 2, current),
                                                           th(colspan = 2, previous)),
                                                        tr(th("Effectif"),
                                                           th("Montant BR"),
                                                           th("Effectif"),
                                                           th("Montant BR"))
                                                        )
                                                  )
            )) %>%
  formatCurrency(c(3,5), currency = "", interval = 3, mark = "&nbsp;", digits = 2, dec.mark = ",")
```

Données issues des tableaux [1.V.1.VSS] A de `r periode`

# Taux de remboursement des RSA pris en charge par l'Assurance Maladie

**Tableau 12 : Taux de remboursement des séjours de l'année en cours et de l'année précédente**
```{r tab12}
Ovalide$TXR %>%
  full_join(OvalideP$TXR, by = c("A", "B")) %>%

  datatable(rownames = F,
            container = htmltools::withTags(table(class = 'display',
                                                  thead(tr(th(rowspan = 2, "Taux de remboursement"),
                                                           th(rowspan = 2, "Type"),
                                                           th(colspan = 2, current),
                                                           th(colspan = 2, previous)),
                                                        tr(th("Effectif"),
                                                           th("%"),
                                                           th("Effectif"),
                                                           th("%"))
                                                        )
                                                  )
            )) %>%
  formatCurrency(c(4, 6), digits = 2, currency = "", dec.mark = ",")
```
_\* Séjours de NN, radiothérape ou PO_
Données issues des tableaux OVALIDE [1.V.1.TXR] C de `r periode`

# Valorisation des RSA pris en charge par l'Assurance Maladie

**Tableau 13 : Détail de la valorisation des séjours et séances pris en charge par l'Assurance Maladie de l'année en cours et de l'année précédente**
```{r tab13}
Ovalide$RAV[-(1:2), c(1,4:6)] %>%
 full_join(OvalideP$RAV[-(1:2), c(1,4:6)], by = "A") %>%
 mutate(D.z = (D.x - D.y) / D.y,
        E.z = (E.x - E.y) / E.y,
        F.z = (F.x - F.y) / F.y) %>%
  .[names(.) %>% sort] %>%

  datatable(rownames = F,
            escape = F,
            container = htmltools::withTags(table(class = 'display',
                                                  thead(tr(th(rowspan = 2, "Composante"),
                                                           th(colspan = 2, "Montant BR¹"),
                                                           th(rowspan = 2, "Evol. montant BR¹"),
                                                           th(colspan = 2, "Montant CP²"),
                                                           th(rowspan = 2, "Evol. montant CP²"),
                                                           th(colspan = 2, "Montant remboursé AM³"),
                                                           th(rowspan = 2, "Evol. montant remboursé AM³")),
                                                        tr(rep(c(current, previous), 3) %>%
                                                           lapply(th))
                                                        )
                                                  )
            )) %>%
  formatPercentage(c(4, 7, 10), digits = 2) %>%
  formatCurrency(c(2, 3, 5, 6, 8, 9), currency = "", interval = 3, mark = "&nbsp;", digits = 2, dec.mark = ",")
```

<sup>1</sup> Montant Brut  
<sup>2</sup> Montant avec Coefficient Prudentiel  
<sup>3</sup> Montant Remboursé par l'Assurance Maladie  

Données issues des tableaux OVALIDE [1.V.1.RAV] C de `r periode`

# Valorisation des IVG, ATU, SE, actes et consultations

**Tableau 14 : Effectifs et valorisation ACE de l'année en cours et de l'année précédente**
```{r tab14}
data_frame(A = c(Ovalide$VATU[nrow(Ovalide$VATU), 3:5] %>% unlist,
                 Ovalide$VSE[nrow(Ovalide$VSE), 3:5] %>% unlist,
                 Ovalide$VCCAM[nrow(Ovalide$VCCAM), 2:4] %>% unlist,
                 Ovalide$VNGAP[nrow(Ovalide$VNGAP), 3:5] %>% unlist),
           B = c(OvalideP$VATU[nrow(OvalideP$VATU), 3:5] %>% unlist,
                 OvalideP$VSE[nrow(OvalideP$VSE), 3:5] %>% unlist,
                 OvalideP$VCCAM[nrow(OvalideP$VCCAM), 2:4] %>% unlist,
                 OvalideP$VNGAP[nrow(OvalideP$VNGAP), 3:5] %>% unlist)) %>%
  mutate(C = A - B,
         D = (A - B) / B) %>%

  datatable(rownames = str_c(rep(c("Nombre de prestations",
                                   "Valorisation brute",
                                   "Valorisation AM"),4),
                             rep(c("ATU<sup>1</sup>",
                                   "SE<sup>2</sup>",
                                   "CCAM<sup>3</sup>",
                                   "NGAP<sup>4</sup>"), each = 3), sep = " "),
            colnames = c(current, previous, "Évolution (n ou &euro;)", "Évolution"),
            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 periode`  
<sup>2</sup>Données issues des tableaux OVALIDE [2.V.VSE] de `r periode`  
<sup>3</sup>Données issues des tableaux OVALIDE [2.V.VCCAM] de `r periode`  
<sup>4</sup>Données issues des tableaux OVALIDE [2.V.VNGAP] de `r periode`  

# Nombre de Suppléments valorisés, Performance et Valorisation des séjours non envoyés

**Tableau 15 : Nombre de suppléments valorisés de l'année en cours et de l'année précédente**
```{r tab15}
Ovalide$UMAS %>%
  full_join(OvalideP$UMAS, by = "A") %>%
  mutate(C = B.x - B.y,
         D = (B.x - B.y) / B.y) %>%

  datatable(rownames = F,
            colnames = c(current, previous, "Évolution (n)", "Évolution")) %>%
  formatCurrency(2:4, currency = "", interval = 3, mark = "&nbsp;", digits = 0) %>%
  formatPercentage(5, digits = 2)
```

Données issues des tableaux OVALIDE [1.V.1.UMAS] E de `r periode`

**Tableau 16 : Prix Moyen du Cas Traité\* de l'année en cours et de l'année précédente**
```{r tab16}
Ovalide$SVB %>%
  mutate(B = C/B) %>%
  select(-C) %>%
  full_join(OvalideP$SVB %>%
            mutate(B = C/B) %>%
            select(-C),
            by = "A") %>%
  mutate(C = B.x - B.y,
         D = (B.x - B.y) / (B.y)) %>%

  datatable(escape = F,
            rownames = F,
            colnames = c("Type de séjours", current, previous, "Évolution (&euro;)", "Évolution")) %>%
  formatPercentage(5, digits = 2) %>%
  formatCurrency(2:4, currency = "", interval = 3, mark = "&nbsp;", digits = 2, dec.mark = ",")
```
_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_

Données issues des tableaux OVALIDE [1.V.1.SV] B de `r periode`

**Tableau 17 : Estimation de la valorisation des séjours non transmis de l'année en cours et de l'année précédente**
```{r tab17}


```
_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_

Données issues de la requête BO «`r current`» exécutée le `r date` et des tableaux OVALIDE [1.V.1.SV] B de `r periode`

**Tableau 18 : Indice de performance de la durée moyenne de séjours (IP-DMS) de l'année en cours et de l'année précédente**
```{r tab18}
Ovalide$EDMS %<>%
  filter(A != ".") %>%
  mutate(B = B %>% str_replace(",",".")) %>%
  mutate(B = B %>% as.numeric)
OvalideP$EDMS %<>%
  filter(A != ".") %>%
  mutate(B = B %>% str_replace(",",".")) %>%
  mutate(B = B %>% as.numeric)
IP_current <- (Ovalide$EDMS[[1, 2]] + Ovalide$EDMS[[4, 2]]) / (Ovalide$EDMS[[2, 2]] + Ovalide$EDMS[[5, 2]])
IP_previous <- (OvalideP$EDMS[[1, 2]] + OvalideP$EDMS[[4, 2]]) / (OvalideP$EDMS[[2, 2]] + OvalideP$EDMS[[5, 2]])
data_frame(IP_current, IP_previous) %>%
  datatable(rownames = "Indice de performance",
            colnames = c(current, previous)) %>%
  formatCurrency(1:2, currency = "", digits = 3, dec.mark = ",")
```
_\* Nb de journées / Nb de journées standardisées sur la DMS théorique_

Données issues des tableaux OVALIDE [1.D2.EDMS] de `r periode`