CRHAP/index.Rmd

---
title: CRHAP
runtime: shiny
output:
  html_document:
    toc: true
    toc_float: true
---

```{r init, warning = F, message = F, echo = F}
library(tidyverse)
library(DT)
library(magrittr)
library(stringr)
library(knitr)
library(lubridate)
library(plotly)

opts_chunk$set(warning = F,
               message = F,
               fig.width = 9,
               fig.height = 6,
               echo = F)
options(DT.options = list(paging = F,
                          info = F,
                          searching = F,
                          dom = "Bfrtip",
                          buttons = c('copy', 'excel')),
        shiny.maxRequestSize = 500*1024^2)

pdf(NULL)
```

# {.tabset}

## Méthode

### Chargement des données

Le fichier doit être fournis au format CSV avec les paramètres suivants :

* séparateur de champs = ,
* guillemets = "
* encodage = UTF-8
* séparateur de décimales = ,

Il doit être issu de la [requête suivante](https://livenne.chu-nancy.fr/shiny_files/CRHAP/CRHAP.wid).

```{r data}
if (!dir.exists("/var/www/html/shiny_files/CRHAP"))
  dir.create("/var/www/html/shiny_files/CRHAP")

file.copy("CRHAP.wid", "/var/www/html/shiny_files/CRHAP", overwrite = T) -> null

inputPanel(
  numericInput("mois", "Mois", (Sys.Date() %>% month) - 1),
  numericInput("annee", "Année", Sys.Date() %>% year),
  fileInput("crhap", "CRHAP", accept = "text/csv"),
  actionButton("report", "Publier le rapport")
)

CRH <- reactive(
  {
    req(input$crhap, input$annee, input$mois)

    read_csv(input$crhap$datapath, col_types = cols(`Numéro d'hospitalisation` = col_character()), progress = F) %>%
      setNames(c("RUM", "NDA", "DP", "GHM", "Notes", "Pole", "Service", "Date_DP", "Date_sortie")) %>%
      mutate(Notes = Notes %>%
               str_to_upper %>%
               str_replace_all(" ", "") %>%
               str_replace("CHR", "CRH") %>%
               str_extract("CRH."),
             Notes = ifelse(Notes %in% c("CRHP", "CRHA"), Notes, NA),
             Date_DP = as.Date(Date_DP),
             Date_sortie = as.Date(Date_sortie),
             Delai = as.numeric(Date_DP - Date_sortie),
             Pole = ifelse(Pole == "GSP : GÉRONTOLOGIE ET SOINS PALLIATIFS", "GSP", Pole),
             Pole = ifelse(Pole == "POLE LORRAIN DE CHIRURGIE DE L'APPAREIL LOCOMOTEUR", "CCEG", Pole)) %>%
      filter(!(Service %in% c("MEDECINE INFANTILE", "NEPHROLOGIE") & DP == "Z49.1"),
             !(Service %in% c("AMP CLINIQUE", "ORTHOGENIE"))) %>%
      filter(Date_sortie < ceiling_date(as.Date(str_c(input$annee, "-", input$mois, "-01")), unit = "month"),
             Date_sortie > floor_date(as.Date(str_c(input$annee - 1, "-", input$mois, "-01")), unit = "month")) %>%
      mutate(Notes = ifelse(Service == "STRUCTURE D'URGENCES" & Delai <= 15 & is.na(Notes), "CRHP", Notes),
             Mois = str_c(year(Date_sortie), "-", str_pad(month(Date_sortie), 2, "left", "0")))
  }
)


CRH_sans_seance <- reactive(
  {
    req(CRH())

    CRH() %>%
      filter(!(GHM %>% str_detect("^28")))
  }
)

CRH_seance <- reactive(
  {
    req(CRH())

    CRH() %>%
      filter(GHM %>% str_detect("^28")) 
  }
)

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

```{r report}
observeEvent(input$report,
             {
               rmarkdown::render("CRHAP.Rmd", output_file = "/var/www/html/cloture/crhap.html", params = list(CRH = CRH(), CRH_seance = CRH_seance(), CRH_sans_seance = CRH_sans_seance()))

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

### Présence du CRH pour le codage des séjours

Ces tableaux concernent les RUMs sur une année glissante.  
Les RUMs **sans DP** et **codés en erreur** (CMD 90) sont **exclus** de l'analyse.  
Le pourcentage d'absents est calculé sur la **totalité** des RUMs, *Non renseignés* compris.  
Le délai médian est le délai médian entre la date de fin du RSS et la date de codage du DP pour le RUM.  
Les données sont disponibles avec les **séances incluses**, et les **séances excluses**.

Les séances automatiquement codées (dialyse en néphrologie et médecine infantile) sont *exclues*.  
Les séjours en AMP clinique et orthogénie sont également *exclus*.  
Les séjours automatiquement codés d'UHCD (séjour en UHCD avec délai de codage <= 15j et sans marque de codage) sont considérés comme *#CRHP*.

Il est possible pour chaque tableau de **trier** chaque colonne en cliquant sur son intitulé.  
Pour les tableaux par service, il est également possible de **filtrer** par pôle ou selon les valeurs (par exemple, ne faire apparaître que les services avec plus de 50% de CRH absents).

Les tableaux sont **exportables** sous Excel à l'aide du bouton en haut à gauche de chaque tableau.  
**Attention : les *tris* et *filtres* sont pris en compte pour l'export !**

----

### Saisie

Les marques **#CRHA** (CRH absent) et **#CRHP** (CRH présent) sont saisies dans les **Notes** lors du codage des séjours dans WebPIMS.

#### Format

Les marques sont saisies selon le format suivant :

* marque en début de Notes
* précédée du #
* tout attaché
* attention aux fautes de frappe ! (#C*HR*P, #CR*PH*)
* **seules ces marques seront analysées !**

#### Conditions

Les marques sont saisies selon les conditions suivantes :

* **\#CRHP** dès lors qu'un compte-rendu permettant le codage du séjour est présent :
    * au moins un CRH lors de l'hospitalisation
    * CRH papier accepté
    * CRH au «mauvais» format accepté
    * CRH pour venues multiples (séances) accepté
* **\#CRHA** dès lors qu'il n'existe aucun compte-rendu d'aucune forme permettant le codage du séjour, et **en respectant un délai d'au moins une semaine après la fin de l'hospitalisation**.

Il est recommandé de coder les séjours par ordre **chronologique**.

----

### Analyse

#### Extraction

Les marques sont extraites par le médecin DIM responsable de la clôture, à l'aide d'une requête BO dans l'univers **WebPIMS MCO Prod**. Cette requête est exécutée tous les mois, *une semaine après la clôture mensuelle*. Les marques sont tirées des RUMs remplissant les conditions suivantes :

* RUM de RSS sorti durant la période allant du début de ce recueil (avril 2016) à la fin du mois de la dernière clôture
* les RUMs sans DP (non codés) sont *exclus*
* les RUMs de RSS groupés en erreur sont *exclus*

#### Traitement

Les données extraites sont séparées en trois groupes pour l'analyse :

* tous RUMs confondus
* RUMs séances uniquement
* RUMs à l'exclusion des séances

Pour chaque jeu de données, les tableaux suivants sont générés :

* par mois de sortie du **RSS**
* par pôle
* par service

Chaque tableau présente les indicateurs suivants :

* le nombre de RUMs dans le mois/pôle/service concerné
* le nombre de RUMs avec marque #CRHP
* le nombre de RUMs avec marque #CRHA
* le nombre de RUMs non marqués
* le **pourcentage de #CRHA**, calculé par rapport au nombre total de RUMs (y compris RUMs non marqués)

## Rapport

### Tous RUMs confondus

#### Par mois

```{r}
renderDataTable({
  CRH() %>%
    count(Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH() %>% count(Mois)) %>%
    select(Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH() %>% group_by(Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH() %>%

    ggplot(aes(x = Mois, fill = Notes)) +
    geom_bar(position = "fill") +
    ylab("Proportion") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ggtitle("Proportion des #CRHA et #CRHP par mois de sortie du RSS") -> p

  ggplotly(p)
})
```

#### Par Pôle

```{r}
renderDataTable({
  CRH() %>%
    count(Pole, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH() %>% count(Pole)) %>%
    select(Pole, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH() %>% group_by(Pole) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH() %>%

    ggplot(aes(x = Pole, fill = Notes)) +
    geom_bar(position = "fill") +
    ylab("Proportion") +
    ggtitle("Proportion des #CRHA et #CRHP par pôle, depuis avril 2016") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) -> p

  ggplotly(p)
})
```

#### Par Pôle, par service et par mois

```{r}
renderDataTable({
  CRH() %>%
    count(Pole, Service, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH() %>% count(Pole, Service, Mois)) %>%
    ungroup %>%
    select(Pole, Service, Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH() %>% group_by(Pole, Service, Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM,
           Pole = Pole %>% factor,
           Mois = Mois %>% factor) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP"),
              filter = "top",
              options = list(searching = T, paging = T)) %>%
    formatPercentage(9)
})
```
<br/>  
```{r}
renderPlotly({
  CRH() %>%
    count(Pole, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    mutate(Manquant = ifelse(is.na(Manquant), integer(1), Manquant),
           CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           pourcent = CRHA / (CRHA + CRHP + Manquant)) %>%

    ggplot(aes(x = Mois, y = pourcent, colour = Pole, group = Pole)) +
    geom_line(stat = "identity") +
    geom_point() +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ylab("Proportion de #CRHA") +
    ggtitle("Évolution des proportions de #CRHA par pôle") -> p

  ggplotly(p, tooltip = c("x", "y", "colour"))
})
```

----

### RUMs non séance

#### Par mois

```{r}
renderDataTable({
  CRH_sans_seance() %>%
    count(Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_sans_seance() %>% count(Mois)) %>%
    select(Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_sans_seance() %>% group_by(Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_sans_seance() %>%

    ggplot(aes(x = Mois, fill = Notes)) +
    geom_bar(position = "fill") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ylab("Proportion") +
    ggtitle("Proportion des #CRHA et #CRHP par mois de sortie du RSS") -> p

  ggplotly(p)
})
```

#### Par Pôle

```{r}
renderDataTable({
  CRH_sans_seance() %>%
    count(Pole, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_sans_seance() %>% count(Pole)) %>%
    select(Pole, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_sans_seance() %>% group_by(Pole) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_sans_seance() %>%

    ggplot(aes(x = Pole, fill = Notes)) +
    geom_bar(position = "fill") +
    ylab("Proportion") +
    ggtitle("Proportion des #CRHA et #CRHP par pôle, depuis avril 2016") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) -> p

  ggplotly(p)
})
```

#### Par Pôle, par service et par mois

```{r}
renderDataTable({
  CRH_sans_seance() %>%
    count(Pole, Service, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_sans_seance() %>% count(Pole, Service, Mois)) %>%
    ungroup %>%
    select(Pole, Service, Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_sans_seance() %>% group_by(Pole, Service, Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM,
           Pole = Pole %>% factor,
           Mois = Mois %>% factor) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP"),
              filter = "top",
              options = list(searching = T, paging = T)) %>%
    formatPercentage(9)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_sans_seance() %>%
    count(Pole, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    mutate(Manquant = ifelse(is.na(Manquant), integer(1), Manquant),
           CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           pourcent = CRHA / (CRHA + CRHP + Manquant)) %>%

    ggplot(aes(x = Mois, y = pourcent, colour = Pole, group = Pole)) +
    geom_line(stat = "identity") +
    geom_point() +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ylab("Proportion de #CRHA") +
    ggtitle("Évolution des proportions de #CRHA par pôle") -> p

  ggplotly(p, tooltip = c("x", "y", "colour"))
})
```

----

### RUMs séance

#### Par mois

```{r}
renderDataTable({
  CRH_seance() %>%
    count(Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_seance() %>% count(Mois)) %>%
    select(Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_seance()  %>% group_by(Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_seance() %>%

    ggplot(aes(x = Mois, fill = Notes)) +
    geom_bar(position = "fill") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ylab("Proportion") +
    ggtitle("Proportion des #CRHA et #CRHP par mois de sortie du RSS") -> p

  ggplotly(p)
})
```

#### Par Pôle

```{r}
renderDataTable({
  CRH_seance() %>%
    count(Pole, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_seance() %>% count(Pole)) %>%
    select(Pole, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_seance()  %>% group_by(Pole) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP")) %>%
    formatPercentage(7)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_seance() %>%

    ggplot(aes(x = Pole, fill = Notes)) +
    geom_bar(position = "fill") +
    ylab("Proportion") +
    ggtitle("Proportion des #CRHA et #CRHP par pôle, depuis avril 2016") +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) -> p

  ggplotly(p)
})
```

#### Par Pôle, par service et par mois

```{r}
renderDataTable({
  CRH_seance() %>%
    count(Pole, Service, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    full_join(CRH_seance() %>% count(Pole, Service, Mois)) %>%
    ungroup %>%
    select(Pole, Service, Mois, RUM = n, CRHP, CRHA, Manquant) %>%
    full_join(CRH_seance() %>% group_by(Pole, Service, Mois) %>% summarise(`Délai médian (j)` = median(Delai))) %>%
    mutate(CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           `% absents` = CRHA / RUM,
           Pole = Pole %>% factor,
           Mois = Mois %>% factor) %>%
    datatable(rownames = F,
              extensions = 'Buttons',
              colnames = c("Pôle" = "Pole",
                           "Non renseigné" = "Manquant",
                           "#CRHA" = "CRHA",
                           "#CRHP" = "CRHP"),
              filter = "top",
              options = list(searching = T, paging = T)) %>%
    formatPercentage(9)
})
```
<br/>  
```{r}
renderPlotly({
  CRH_seance() %>%
    count(Pole, Mois, Notes) %>%
    mutate(Notes = ifelse(is.na(Notes), "Manquant", Notes)) %>%
    spread(Notes, n) %>%
    mutate(Manquant = ifelse(is.na(Manquant), integer(1), Manquant),
           CRHA = ifelse(is.na(CRHA), integer(1), CRHA),
           CRHP = ifelse(is.na(CRHP), integer(1), CRHP),
           pourcent = CRHA / (CRHA + CRHP + Manquant)) %>%

    ggplot(aes(x = Mois, y = pourcent, colour = Pole, group = Pole)) +
    geom_line(stat = "identity") +
    geom_point() +
    theme(axis.text.x = element_text(angle = -45, hjust = 1)) +
    ylab("Proportion de #CRHA") +
    ggtitle("Évolution des proportions de #CRHA par pôle") -> p

  ggplotly(p, tooltip = c("x", "y", "colour"))
})
```