DIM
/
cloture
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
Browse Source

Init commit

master
Maxime Wack 8 years ago
commit
f49d4ee4cd
7 changed files with 808 additions and 0 deletions
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +1
    -0
      README.md
  2. +2
    -0
      cloture.R
  3. +637
    -0
      cloture.Rmd
  4. +59
    -0
      donnees.R
  5. +36
    -0
      functionsOvalide.R
  6. +12
    -0
      listOvalide.csv
  7. +61
    -0
      render.R

+ 1
- 0
README.md View File

@@ -0,0 +1 @@
# Scripts d'automatisation de cloture mensuelle

+ 2
- 0
cloture.R View File

@@ -0,0 +1,2 @@
source("render.R")
render_with_widgets("cloture.Rmd")

+ 637
- 0
cloture.Rmd View File

@@ -0,0 +1,637 @@
```{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`

+ 59
- 0
donnees.R View File

@@ -0,0 +1,59 @@
source("functionsOvalide.R")
library(lubridate)

annee <- 2015
mois <- 10
date <- "04/12/2015"

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
}

src_mysql("pmsi_dim", "livenne.chu-nancy.fr", user = "u992093", password = "Md;8G4iSm") %>%
tbl(sql("SELECT idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix116
UNION
SELECT idhosp, idrss, idrum, date_entree, date_sortie, cmd, um FROM fix117")) %>%
collect %>%
mutate(date_entree = date_entree %>% as.Date,
date_sortie = date_sortie %>% as.Date,
annee_sortie = year(date_sortie),
mois_sortie = month(date_sortie)) %>%
filter(annee_sortie > annee - 3) %>% # Données rum/rss depuis 3 ans
left_join( # + libellés pôles et services
src_mysql("pmsi_dim_nom", "livenne.chu-nancy.fr", user = "u992093", password = "Md;8G4iSm") %>%
tbl("structure") %>%
filter(um != "") %>%
select(uf_date_ferm, um, service_libelle, pole_libelle) %>%
arrange(um, uf_date_ferm) %>%
distinct %>%
collect %>%
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(idhosp %>% str_detect("^13"), str_c("m", idrss), idrss)) %>% # Dédoublonnage rss maternité 2013
select(-idhosp) %>%
mutate(duree_rum = date_sortie - date_entree) %>% # durée rum
left_join( # durée rss
group_by(., idrss) %>%
summarise(duree_rss = sum(duree_rum))
) -> rum

save(Ovalide, OvalideP, annee, mois, rum, date, file = "donnees.Rdata")

+ 36
- 0
functionsOvalide.R View File

@@ -0,0 +1,36 @@
library(dplyr)
library(readr)
library(stringr)
library(rvest)

extractOvalide <- function(annee, mois, table, subtable = "")
{
# Lire le fichier + corrections
str_c("OVALIDE T2A.MCO.DGF", annee, mois, "html", sep = ".") %>%
read_file(locale = locale(encoding = "ISO8859-1")) %>%
str_replace_all("\\n", "") %>%
str_replace_all("<br>", " ") -> current

# Extraction de la table
if (table == "1.D.2.EDMS")
{
current %>%
str_extract(str_c('<td class="c systemtitle">Tableau \\[', table, '\\] ', subtable, '(.*?<\\/table>){3}')) %>%
str_replace_all("(\\d) (\\d)", "\\1\\2") %>%
str_replace_all("\\.<\\/td>", "<\\/td>") %>%
str_replace_all("&nbsp;", " ") %>%
read_html %>%
html_table(trim = T, dec = ",", header = F) %>%
bind_rows
} else
{
current %>%
str_extract(str_c('<td class="c systemtitle">Tableau \\[', table, '\\] ', subtable, '(.*?<\\/table>){2}')) %>%
str_replace_all("(\\d) (\\d)", "\\1\\2") %>%
str_replace_all("\\.<\\/td>", "<\\/td>") %>%
str_replace_all("&nbsp;", " ") %>%
read_html %>%
html_table(trim = T, dec = ",") %>%
.[[1]]
}
}

+ 12
- 0
listOvalide.csv View File

@@ -0,0 +1,12 @@
name;table;subtable
SVA;1.V.1.SV;A
VSS;1.V.1.VSS;
TXR;1.V.1.TXR;C
RAV;1.V.1.RAV;
VATU;2.V.VATU;
VSE;2.V.VSE;
VCCAM;2.V.VCCAM;
VNGAP;2.V.VNGAP;
UMAS;1.V.1.UMAS;E
SVB;1.V.1.SV;B
EDMS;1.D.2.EDMS

+ 61
- 0
render.R View File

@@ -0,0 +1,61 @@
library("knitr")
library("htmltools")
library("base64enc")
library("markdown")
render_with_widgets <- function(input_file,
output_file = sub("\\.Rmd$", ".html", input_file, ignore.case = TRUE),
self_contained = TRUE,
deps_path = file.path(dirname(output_file), "deps"))
{
# Read input and convert to Markdown
input <- readLines(input_file)
md <- knit(text = input)
# Get dependencies from knitr
deps <- knit_meta()

# Convert script dependencies into data URIs, and stylesheet
# dependencies into inline stylesheets

dep_scripts <- lapply(deps, function(x)
{
lapply(x$script, function(script) file.path(x$src$file, script))
})
dep_stylesheets <- lapply(deps, function(x)
{
lapply(x$stylesheet, function(stylesheet) file.path(x$src$file, stylesheet))
})
dep_scripts <- unique(unlist(dep_scripts))
dep_stylesheets <- unique(unlist(dep_stylesheets))
if (self_contained) {
dep_html <- c(sapply(dep_scripts, function(script)
{
sprintf('<script type="text/javascript" src="%s"></script>', dataURI(file = script))
}),
sapply(dep_stylesheets, function(sheet)
{
sprintf('<style>%s</style>', paste(readLines(sheet), collapse = "\n"))
})
)
} else {
if (!dir.exists(deps_path))
{
dir.create(deps_path)
}
for (fil in c(dep_scripts, dep_stylesheets))
{
file.copy(fil, file.path(deps_path, basename(fil)))
}
dep_html <- c(sprintf('<script type="text/javascript" src="%s"></script>', file.path(deps_path, basename(dep_scripts))),
sprintf('<link href="%s" type="text/css" rel="stylesheet">', file.path(deps_path, basename(dep_stylesheets))))
}

# Extract the <!--html_preserve--> bits
preserved <- extractPreserveChunks(md)

# Render the HTML, and then restore the preserved chunks
html <- markdownToHTML(text = preserved$value, header = dep_html)
html <- restorePreserveChunks(html, preserved$chunks)

# Write the output
writeLines(html, output_file)
}

Write Preview
Loading…
Cancel
Save