diff --git a/README.md b/README.md
index f5dd92d..8df091c 100644
--- a/README.md
+++ b/README.md
@@ -5,32 +5,64 @@
Les scripts ont été développés sous R version 3.3.1, à l'aide des packages suivants :
* Versions stables (CRAN)
- * tidyverse
+ * tidyr 0.5.1
* ggplot2 2.1.0
* lubridate 1.5.6
* rvest 0.3.2
* stringr 1.0.0
+ * readr 0.2.2
* magrittr 1.5
+ * dplyr 0.5.0
* knitr 1.13
* rmarkdown 1.0
* htmlwidgets 0.7
+
+* Versions de développement (github)
* DT 0.1.57
Ces paquets sont installés au niveau système pour tous les utilisateurs livenne.
## Utilisation
-Le rapport est sous la forme d'une application shiny+rmarkdown.
-Une page permet d'entrer les informations nécessaires à la génération du rapport (codes d'accès, fichier d'exhaustivité issu de la requête BO), qui est généré au fur et à mesure dans un second onglet.
-Une fois le rapport généré, il est possible d'en télécharger une version statique.
+La génération du rapport est séparée en deux parties :
+* l'acquisition et le pré-traitement des données
+* la génération du rapport en lui-même
### Acquisition des données
-Une première étape manuelle consiste à utiliser la requête Business Objects **exhaustivite.wid** présente dans le répertoire et de sauvegarder le fichier csv (choisir les options de format : encodage en UTF8, séparateur = ",").
+Une première étape manuelle consiste à utiliser la requête Business Objects **exhaustivite.wid** présente dans le répertoire et de sauvegarder le fichier csv (choisir les options de format : encodage en UTF8, séparateur = ",") sous le nom **exhau_pims.csv** dans le répertoire du script.
+Le script **donnees.sh** appelle le script **donnees.R** qui récupère les autres données depuis les différentes sources (base de données MySQL (tables fix116, fix117, mvt_gam et structure) sur livenne et données ePMSI sur le site de l'ATIH, exhaustivité WebBIMS dans le fichier **exhau_pims.csv**, tableaux ePMSI CCEG+CHU de 2015 pré-assemblés dans le fichier **Ovalide.Rdata** (nécessaires uniquement pour les bilans de 2016).
Les tableaux ePMSI sont archivés dans le dossier **ePMSI**.
+Il nécessite un appel en ligne de commande avec les paramètres suivants :
+* nom d'utilisateur de session CHU
+* mot de passe de session CHU (pour passer à travers le proxy)
+
+* nom d'utilisateur ePMSI
+* mot de passe ePMSI (pour télécharger les tableaux depuis ePMSI)
+
+* nom d'utilisateur MySQL livenne
+* mot de passe MySQL livenne (pour interroger la base de données)
+
+* annee de la clôture
+* mois de la clôture
+
+Un appel incorrect au script rappelle les paramètres de ligne de commande à utiliser.
+Les noms d'utilisateurs/mots de passe contenant des caractères spéciaux (autres qu'alphanumériques) doivent être entourés de guillemets.
+
+Le script **donnees.R** utilise le fichier **Ovalide.Rdata** contenant les données fusionnées du CHU et du CCEG pour 2015. Après 2016 ce fichier ne sera plus utile. Il utilise également le fichier **exhau.Rdata** pour sauvegarder les données d'exhaustivité depuis le début de l'année en cours. Ce fichier est réinitialisé en début d'année.
+
+Les données récupérées et pré-traitées son enregistrées dans le fichier **donnees.Rdata** pour l'utilisation par le script de génération du rapport.
+
+Le fichier **gam.csv** est généré. Il contient les séjours présents dans la base de mouvements (GAM), mais qui n'ont ni été envoyés à l'ATIH, ni sont connus comme étant non exhaustifs dans WebPIMS. Il s'agit principalement d'erreurs de la base GAM (annulations, transformations) à corriger.
+
### Génération du rapport
-Le fichier **cloture.html** généré peut être vérifié avant publication. La publication se fait en copiant le fichier dans le répertoire /var/www/html/cloture.
+Le script **render.sh** appelle la commande *render* de Rmarkdown pour générer le rapport de clôture **cloture.html** à partir du fichier **cloture.Rmd**.
+Celui-ci génère les différents tableaux et figures à la volée à partir des données pré-traitées fournies par **donnees.R** dans le fichier **donnees.Rdata**.
+
+Le fichier **cloture.html** généré peut être vérifié avant publication. La publication se fait en copiant le fichier dans le répertoire au-dessus dans l'arborescence (/var/www/html/cloture).
Ce fichier doit également être copié dans le répertoire **archive** sous la forme **cloture*ANNEE_MOIS*.html** pour archivage.
+
+
diff --git a/README.png b/README.png
new file mode 100644
index 0000000..b6395a1
Binary files /dev/null and b/README.png differ
diff --git a/README.svg b/README.svg
new file mode 100644
index 0000000..3963684
--- /dev/null
+++ b/README.svg
@@ -0,0 +1,1583 @@
+
+
+
+
diff --git a/cloture.Rmd b/cloture.Rmd
index eb381e9..045e25a 100644
--- a/cloture.Rmd
+++ b/cloture.Rmd
@@ -4,22 +4,15 @@ output:
html_document:
toc: true
toc_float: true
-params:
- annee: NA
- mois: NA
- rum: NA
- rss: NA
- exhau: NA
- exhau_pims: NA
- Ovalide: NA
- OvalideP: NA
---
```{r init, echo = F, message = F}
-library(tidyverse)
library(DT)
+library(ggplot2)
library(knitr)
+library(tidyr)
library(stringr)
+library(dplyr)
library(plotly)
library(lubridate)
@@ -34,19 +27,10 @@ options(DT.options = list(paging = F,
info = F,
dom = "Bfrtip",
buttons = c("copy", "excel")))
-
-pdf(NULL)
```
```{r data}
-Ovalide <- params$Ovalide$tab
-OvalideP <- params$OvalideP$tab
-annee <- params$annee
-mois <- params$mois
-rum <- params$rum
-rss <- params$rss
-exhau <- params$exhau
-exhau_pims <- params$exhau_pims
+load("donnees.Rdata")
mois_label <- c("Janvier",
"Février",
diff --git a/donnees.R b/donnees.R
new file mode 100644
index 0000000..8233213
--- /dev/null
+++ b/donnees.R
@@ -0,0 +1,136 @@
+source("functionsOvalide.R")
+library(lubridate)
+library(RMySQL)
+
+# Récupération des arguments pour utilisation non interactive ----
+arguments <- commandArgs()
+if (length(arguments) != 13)
+{
+ print ("Usage : donnees.sh CHUuser CHUpass ATIHuser ATIHpass LivenneUser LivennePass annee mois")
+ quit()
+} else
+{
+ CHUuser <- arguments[6]
+ CHUpass <- arguments[7]
+ ATIHuser <- arguments[8]
+ ATIHpass <- arguments[9]
+ user <- arguments[10]
+ password <- arguments[11]
+ annee <- as.numeric(arguments[12])
+ mois <- as.numeric(arguments[13])
+}
+
+# Récupération des fichiers ePMSI ----
+print("1/9 - Connexion à ePMSI")
+connectOvalide(CHUuser, CHUpass, ATIHuser, ATIHpass)
+print(str_c("2/9 - Téléchargement du tableau de", mois, annee, sep = " "))
+getOvalide(CHUuser, CHUpass, annee, mois)
+print(str_c("3/9 - Téléchargement du tableau de", mois, annee - 1, sep = " "))
+getOvalide(CHUuser, CHUpass, annee - 1, mois)
+
+# Extraction des données des fichiers ePMSI ----
+print("4/9 - Extraction des tableaux ePMSI")
+read.csv2("listOvalide.csv") %>%
+{
+ apply(., 1, . %>%
+ {
+ df <- extractOvalide(annee, mois, .[2], .[3])
+ names(df) <- LETTERS[1:length(df)]
+ df
+ }) ->> Ovalide
+ names(Ovalide) <<- .$name
+
+ apply(., 1, . %>%
+ {
+ df <- extractOvalide(annee - 1, mois, .[2], .[3])
+ names(df) <- LETTERS[1:length(df)]
+ df
+ }) ->> OvalideP
+ names(OvalideP) <<- .$name
+}
+
+# Récupération des données ePMSI de 2015 fusionnées CCEG-CHU ----
+if (annee == 2016)
+{
+ load("Ovalide.Rdata")
+ OvalideP <- CCEGCHU2015[[str_c("mois", mois, sep = "")]]
+ rm("CCEGCHU2015")
+}
+
+# Nettoyage des fichiers extraits. Les archives sont conservées. ----
+unlink(str_c("OVALIDE T2A.MCO.DGF", annee, mois, "html", sep = "."))
+unlink(str_c("OVALIDE T2A.MCO.DGF", annee - 1, mois, "html", sep = "."))
+
+# RUM + structure + calcul durée de séjour ----
+print("5/9 - LIVENNE : RUM et structure")
+src_mysql("pmsi_dim", "localhost", user = user, password = password) %>%
+ tbl(sql("SELECT finess, idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix116
+ UNION
+ SELECT finess, idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix117")) %>%
+ collect(n = Inf) %>%
+ mutate(date_entree = date_entree %>% as.Date,
+ date_sortie = date_sortie %>% as.Date) %>%
+ left_join(src_mysql("pmsi_dim_nom", "localhost", user = user, password = password) %>%
+ tbl("structure") %>%
+ filter(um != "") %>%
+ select(uf_date_ferm, um, service_libelle, pole_libelle) %>%
+ arrange(um, uf_date_ferm) %>%
+ distinct %>%
+ collect(n = Inf) %>%
+ add_rownames(var = "dummy") %>% # Dédoublonnage : 1 um -> 1 couple libellés
+ group_by(um) %>%
+ filter(dummy == last(dummy)) %>%
+ select(-dummy, -uf_date_ferm) %>%
+ ungroup) %>%
+ mutate(idrss = ifelse(finess == "540000031", str_c("m", idrss), idrss)) %>% # maternité
+ mutate(idrss = ifelse(finess == "540020112", str_c("c", idrss), idrss)) %>% # CCEG
+ mutate(idhosp = idhosp %>% str_replace_all(" ", "")) %>%
+ mutate(duree_rum = date_sortie - date_entree) %>% # durée rum
+ left_join(group_by(., idrss) %>%
+ summarise(duree_rss = sum(duree_rum))) -> rum
+
+# CLOS14 Hémato ----
+rum %<>%
+ mutate(pole_libelle = ifelse(pole_libelle == "CLOS14 HEMATOLOGIE", "SPECIALITES MEDICALES", pole_libelle),
+ service_libelle = ifelse(service_libelle == "CLOS14 HEMATO.S.INTENSIFS", "SERVICE HEMATOLOGIE", service_libelle))
+
+# Création des RSSs des 3 dernières années à partir des RUMs ----
+print("6/9 - Création des RSS")
+rum %>%
+ group_by(idrss) %>%
+ filter(idrum == max(idrum)) %>%
+ ungroup %>%
+ mutate(annee_sortie = year(date_sortie),
+ mois_sortie = month(date_sortie)) %>%
+ filter(annee_sortie > annee - 3) -> rss
+
+# Sélection uniquement des RUMs appartenant aux RSS ----
+print("7/9 - Sélection des RUMs")
+rum %<>%
+ right_join(rss %>% select(idrss, annee_sortie, mois_sortie))
+
+# Exhaustivité ----
+print("8/9 - Exhaustivité")
+exhau_pims <- read_csv("exhau_pims.csv")
+names(exhau_pims) <- c("Pole", "Service", "RUM", "DP", "Erreur", "Sortie", "Duree", "RSS")
+
+exhau_pims %<>%
+ mutate(Sortie = Sortie %>% as.Date) %>%
+ filter(month(Sortie) <= mois)
+
+dbConnect(MySQL(), host = "localhost", dbname = "pmsi_dim", user = user, password = password) %>%
+ dbWriteTable("exhaustivite", data.frame(annee = annee, mois = 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)
+
+an <- annee
+
+src_mysql("pmsi_dim", "localhost", user = user, password = password) %>%
+ tbl("exhaustivite") %>%
+ collect(n = Inf) %>%
+ filter(annee == an) %>%
+ full_join(data.frame(mois = 1:12), by = "mois") %>%
+ select(annee, mois, rss = nb_rss_tot, manq = nb_rss_manq) -> exhau
+
+# Écriture des données ----
+print("9/9 - Écriture des données")
+
+save(Ovalide, OvalideP, annee, mois, rum, rss, exhau, exhau_pims, file = "donnees.Rdata")
diff --git a/donnees.sh b/donnees.sh
new file mode 100755
index 0000000..d375000
--- /dev/null
+++ b/donnees.sh
@@ -0,0 +1,4 @@
+#!/bin/bash
+
+R --vanilla --quiet --slave --args $1 $2 $3 $4 $5 $6 $7 $8 < donnees.R
+
diff --git a/functionsOvalide.R b/functionsOvalide.R
index b65bf55..46a49ac 100644
--- a/functionsOvalide.R
+++ b/functionsOvalide.R
@@ -1,7 +1,7 @@
-library(tidyverse)
+library(dplyr)
library(magrittr)
-library(httr)
-#library(RCurl)
+library(RCurl)
+library(readr)
library(stringr)
library(rvest)
@@ -45,53 +45,80 @@ extractOvalide <- function(annee, mois, table, subtable = "")
connectOvalide <- function(CHUuser, CHUpass, ATIHuser, ATIHpass)
{
+ curlopts <- list(proxy = str_c(CHUuser, ':', CHUpass, '@ssl-proxy.chu-nancy.fr:8080'),
+ follow = T,
+ cookiejar = 'cookie.jar',
+ cookiefile = 'cookie.jar')
+
+ curl <- str_c('curl -x "', CHUuser, ':', CHUpass, '@ssl-proxy.chu-nancy.fr:8080" -b cookie.jar -c cookie.jar -L ')
pasrel <- 'https://pasrel.atih.sante.fr/cas/login'
epmsi <- 'https://epmsi.atih.sante.fr/'
- # Config proxy
- set_config(use_proxy(url = "ssl-proxy.chu-nancy.fr", port = 8080, username = CHUuser, password = CHUpass))
-
+ unlink("cookie.jar")
+
+ # Cookie
+ print("ePMSI : COOKIE")
+ system(str_c(curl, pasrel))
+
# Token
print("ePMSI : TOKEN")
- GET(pasrel) %>%
- content %>%
+ getURL(pasrel, .opts = curlopts) %>%
+ read_html %>%
html_node("input[name='lt']") %>%
html_attr("value") -> token
+ print(token)
# Login
print("ePMSI : LOGIN")
- POST(pasrel, body = list(username = ATIHuser, password = ATIHpass, lt = token, "_eventId" = "submit", submit = "SE+CONNECTER"), encode = "form") %>% cookies -> cookie
+ system(str_c(curl, '-d "username=', ATIHuser, '&password=', curlPercentEncode(ATIHpass), '<=', token, '&_eventId=submit&submit=SE+CONNECTER" ', pasrel))
# Auth
print("ePMSI : AUTH")
- GET(str_c(epmsi, 'authenticate.do'), set_cookies(cookie$value %>% setNames(cookie$name))) %>% cookies
+ system(str_c(curl, epmsi, 'authenticate.do'))
}
getOvalide <- function(CHUuser, CHUpass, annee, mois)
{
+ curlopts <- list(proxy = str_c(CHUuser, ':', CHUpass, '@ssl-proxy.chu-nancy.fr:8080'),
+ follow = T,
+ cookiejar = 'cookie.jar',
+ cookiefile = 'cookie.jar')
+
epmsi <- 'https://epmsi.atih.sante.fr/'
# Applis
print("ePMSI : APPLIS")
- GET(str_c(epmsi, 'jsp/epmsi/applis/applis.jsp'))
-
+ getURL(str_c(epmsi, 'jsp/epmsi/applis/applis.jsp'),
+ .opts = curlopts) %>%
+ cat
+
# Ovalide
print("ePMSI : OVALIDE")
- GET(str_c(epmsi, 'jsp/epmsi/applis/applisMat2a.jsp'))
-
+ getURL(str_c(epmsi, 'jsp/epmsi/applis/applisMat2a.jsp'),
+ referer = str_c(epmsi, 'jsp/epmsi/applis/applis.jsp'),
+ .opts = curlopts) %>%
+ cat
+
# Ovalide MCO T2A
print("ePMSI : MCO T2A")
- GET(str_c(epmsi, 'appli_16.do?champPmsi=1&statut=1&applicationType=3'))
-
+ getURL(str_c(epmsi, 'appli_16.do?champPmsi=1&statut=1&applicationType=3'),
+ referer = str_c(epmsi, 'jsp/epmsi/applis/applisMat2a.jsp'),
+ .opts = curlopts) %>%
+ cat
+
# Resultats pour annee/mois
print("ePMSI : RESULTATS")
- GET(str_c(epmsi, 'appli_05.do?year=', annee, '&period=', mois))
-
+ getURL(str_c(epmsi, 'appli_05.do?year=', annee, '&period=', mois),
+ referer = str_c(epmsi, 'appli_16.do?champPmsi=1&statut=1&applicationType=3'),
+ .opts = curlopts) %>%
+ cat
+
# Tableaux
print("ePMSI : TABLEAUX")
- GET(str_c(epmsi, 'appli_05.zip?action=4&win=1')) %>%
- content %>%
- writeBin(con = str_c('ePMSI/', annee, '_', mois, '.zip'))
+ getBinaryURL(str_c(epmsi, 'appli_05.zip?action=4&win=1'),
+ referer = str_c(epmsi, 'appli_05.do?year=', annee, '&period=', mois),
+ .opts = curlopts) %>%
+ writeBin(con = str_c('ePMSI/', annee, '_', mois, '.zip'))
unzip(str_c('ePMSI/', annee, '_', mois, '.zip'))
}
diff --git a/index.rmd b/index.rmd
deleted file mode 100644
index f9bde75..0000000
--- a/index.rmd
+++ /dev/null
@@ -1,1078 +0,0 @@
----
-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 = " ", digits = 2, dec.mark = ",") %>%
- formatPercentage(7, digits = 2)
-})
-```
-*Données issues des tableaux OVALIDE [1.V.1.SV] A de `r renderText(periode())`*
-
-#### Valorisation des RSA non pris en charge par l'Assurance Maladie
-```{r tab11}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- OvalideP()$VSS %>% select(1:3) %>%
- full_join(Ovalide()$VSS %>% select(1:3), by = "A") %>%
- mutate(D = C.y - C.x,
- E = (C.y - C.x) / C.x) %>%
-
- datatable(rownames = F,
- extensions = "Buttons",
- container = htmltools::withTags(table(class = 'display',
- thead(tr(th(rowspan = 2, "Composante"),
- th(colspan = 2, previous()),
- th(colspan = 2, current()),
- th(colspan = 2, "Évolution")),
- tr(th("Effectif"),
- th("Montant BR"),
- th("Effectif"),
- th("Montant BR"),
- th("€"),
- th("%"))
- )
- )
- )) %>%
- formatCurrency(c(3,5,6), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>%
- formatPercentage(7, digits = 2)
-})
-```
-*Données issues des tableaux [1.V.1.VSS] A de `r renderText(periode())`*
-
-#### Taux de remboursement des RSA pris en charge par l'Assurance Maladie
-```{r tab12}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- OvalideP()$TXR %>%
- full_join(Ovalide()$TXR, by = c("A", "B")) %>%
-
- datatable(rownames = F,
- extensions = "Buttons",
- container = htmltools::withTags(table(class = 'display',
- thead(tr(th(rowspan = 2, "Taux de remboursement"),
- th(rowspan = 2, "Type"),
- th(colspan = 2, previous()),
- th(colspan = 2, current())),
- tr(th("Effectif"),
- th("%"),
- th("Effectif"),
- th("%"))
- )
- )
- )) %>%
- formatCurrency(c(4, 6), digits = 2, currency = "", dec.mark = ",")
-})
-```
-*Données issues des tableaux OVALIDE [1.V.1.TXR] C de `r renderText(periode())`*
-_\* Séjours de NN, radiothérape ou PO_
-
-#### Valorisation des RSA pris en charge par l'Assurance Maladie
-```{r tab13}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- OvalideP()$RAV[-(1:2), c(1,4,6)] %>%
- full_join(Ovalide()$RAV[-(1:2), c(1,4,6)], by = "A") %>%
- mutate(D.z = (D.y - D.x) / D.x,
- F.z = (F.y - F.x) / F.x) %>%
- .[names(.) %>% sort] %>%
-
- datatable(rownames = F,
- extensions = "Buttons",
- escape = F,
- container = htmltools::withTags(table(class = 'display',
- thead(tr(th(rowspan = 2, "Composante"),
- th(colspan = 2, "Montant BR¹"),
- th(rowspan = 2, "Evol. montant BR¹"),
- th(colspan = 2, "Montant remboursé AM²"),
- th(rowspan = 2, "Evol. montant remboursé AM²")),
- tr(rep(c(previous(), current()), 2) %>%
- lapply(th))
- )
- )
- )) %>%
- formatPercentage(c(4, 7), digits = 2) %>%
- formatCurrency(c(2, 3, 5, 6), currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",")
-})
-```
-*Données issues des tableaux OVALIDE [1.V.1.RAV] C de `r renderText(periode())`*
-1 Montant Brut
-2 Montant Remboursé par l'Assurance Maladie
-
-#### Valorisation des IVG, ATU, SE, actes et consultations
-```{r tab14}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- data_frame(A = c(OvalideP()$VATU[is.na(OvalideP()$VATU$A), 3:5] %>% unlist,
- OvalideP()$VSE[OvalideP()$VSE$A == "", 3:5] %>% unlist,
- OvalideP()$VCCAM[OvalideP()$VCCAM$A == "", 2:4] %>% unlist,
- OvalideP()$VNGAP[OvalideP()$VNGAP$A == "", 3:5] %>% unlist),
- B = c(Ovalide()$VATU[is.na(Ovalide()$VATU$A), 3:5] %>% unlist,
- Ovalide()$VSE[Ovalide()$VSE$A == "", 3:5] %>% unlist,
- Ovalide()$VCCAM[Ovalide()$VCCAM$A == "", 2:4] %>% unlist,
- Ovalide()$VNGAP[Ovalide()$VNGAP$A == "", 3:5] %>% unlist)) %>%
- mutate(C = B - A,
- D = (B - A) / A) %>%
-
- datatable(rownames = str_c(rep(c("Nombre de prestations",
- "Valorisation brute",
- "Valorisation AM"),4),
- rep(c("ATU1",
- "SE2",
- "CCAM3",
- "NGAP4"), each = 3), sep = " "),
- colnames = c(previous(), current(), "Évolution (n ou €)", "Évolution"),
- extensions = "Buttons",
- escape = F) %>%
- formatCurrency(1:3, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",") %>%
- formatPercentage(4, digits = 2)
-})
-```
-1*Données issues des tableaux OVALIDE [2.V.VATU] de `r renderText(periode())`*
-2*Données issues des tableaux OVALIDE [2.V.VSE] de `r renderText(periode())`*
-3*Données issues des tableaux OVALIDE [2.V.VCCAM] de `r renderText(periode())`*
-4*Données issues des tableaux OVALIDE [2.V.VNGAP] de `r renderText(periode())`*
-
-#### Nombre de Suppléments valorisés, Performance et Valorisation des séjours non envoyés
-```{r tab15}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- OvalideP()$UMAS %>%
- full_join(Ovalide()$UMAS, by = "A") %>%
- mutate(C = B.y - B.x,
- D = (B.y - B.x) / B.x) %>%
-
- datatable(rownames = F,
- extensions = "Buttons",
- colnames = c(previous(), current(), "Évolution (n)", "Évolution")) %>%
- formatCurrency(2:4, currency = "", interval = 3, mark = " ", digits = 0) %>%
- formatPercentage(5, digits = 2)
-})
-```
-*Données issues des tableaux OVALIDE [1.V.1.UMAS] E de `r renderText(periode())`*
-
-#### Prix Moyen du Cas Traité\* de l'année en cours et de l'année précédente
-```{r tab16}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- OvalideP()$SVB %>%
- mutate(B = C/B) %>%
- select(-C) %>%
- full_join(Ovalide()$SVB %>%
- mutate(B = C/B) %>%
- select(-C),
- by = "A") %>%
- mutate(C = B.y - B.x,
- D = (B.y - B.x) / (B.x)) %>%
-
- datatable(escape = F,
- extensions = "Buttons",
- rownames = F,
- colnames = c("Type de séjours", previous(), current(), "Évolution (€)", "Évolution")) %>%
- formatPercentage(5, digits = 2) %>%
- formatCurrency(2:4, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",")
-})
-```
-*Données issues des tableaux OVALIDE [1.V.1.SV] B de `r renderText(periode())`*
-_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_
-
-#### Estimation de la valorisation des séjours non transmis de l'année en cours
-```{r tab17}
-DT::renderDataTable({
- req(exhau_pims(), Ovalide(), OvalideP())
-
- exhau_pims() %>% filter(is.na(DP), Duree == 0) %>% distinct(RSS) %>% nrow -> zero
- exhau_pims() %>% filter(is.na(DP), Duree > 0) %>% distinct(RSS) %>% nrow -> plus
-
- data.frame(zero = c(zero, Ovalide()$SVB$C[3]/Ovalide()$SVB$B[3], zero * Ovalide()$SVB$C[3]/Ovalide()$SVB$B[3]),
- plus = c(plus, Ovalide()$SVB$C[2]/Ovalide()$SVB$B[2], plus * Ovalide()$SVB$C[2]/Ovalide()$SVB$B[2])) %>%
-
- datatable(escape = F,
- extensions = "Buttons",
- rownames = c("Nombre", "PMCT*", "Valorisation"),
- colnames = c("Indicateur", "0 jour", "Plus de 0 jour")) %>%
- formatCurrency(1:2, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",")
-})
-```
-*Données issues de la requête BO «`r renderText(current())`» et des tableaux OVALIDE [1.V.1.SV] B de `r renderText(periode())`*
-_\* Prix Moyen du Cas Traité = Total valorisation / nombre de RSA valorisés_
-
-#### Indice de performance de la durée moyenne de séjours (IP-DMS) de l'année en cours et de l'année précédente
-```{r tab18}
-DT::renderDataTable({
- req(Ovalide(), OvalideP())
-
- if (nrow(Ovalide()$EDMS) == 6)
- {
- IP_current <- (Ovalide()$EDMS[[1, 2]] + Ovalide()$EDMS[[4, 2]]) / (Ovalide()$EDMS[[2, 2]] + Ovalide()$EDMS[[5, 2]])
- IP_previous <- (OvalideP()$EDMS[[1, 2]] + OvalideP()$EDMS[[4, 2]]) / (OvalideP()$EDMS[[2, 2]] + OvalideP()$EDMS[[5, 2]])
- } else {
- IP_current <- Ovalide()$EDMS[[1, 2]] / Ovalide()$EDMS[[2, 2]]
- IP_previous <- OvalideP()$EDMS[[1, 2]] / OvalideP()$EDMS[[2, 2]]
- }
-
- data_frame(IP_previous, IP_current) %>%
- datatable(rownames = "Indice de performance",
- extensions = "Buttons",
- colnames = c(previous(), current())) %>%
- formatCurrency(1:2, currency = "", digits = 3, dec.mark = ",")
-})
-```
-*Données issues des tableaux OVALIDE [1.D2.EDMS] de `r renderText(periode())`*
-_\* Nb de journées / Nb de journées standardisées sur la DMS théorique_
diff --git a/render.sh b/render.sh
new file mode 100755
index 0000000..5e73e36
--- /dev/null
+++ b/render.sh
@@ -0,0 +1,2 @@
+#!/bin/bash
+R --vanilla -e 'rmarkdown::render("cloture.Rmd")'