Exhaustivité à partir de webpims exclusivement

cloture.Rmd

@@ -372,17 +372,17 @@ exhau %>%
 
 ## Exhaustivité mensuelle de la clôture
 
-*L'exhaustivité est calculée à partir de la base GAM*
-
 ### Taux d'exhaustivité des RSS pour la clôture actuelle selon le mois de sortie du RSS
 ```{r fig7}
-rss %>%
-  filter(annee_sortie == annee) %>%
+exhau_pims %>%
+  mutate(mois_sortie = month(Sortie)) %>%
+  filter(!is.na(DP)) %>%
   count(mois_sortie) %>%
-  full_join(gam %>%
+  full_join(exhau_pims %>%
+            mutate(mois_sortie = month(Sortie)) %>%
             count(mois_sortie),
             by = "mois_sortie") %>%
-  mutate(n = 100 * (n.x - n.y) / n.x,
+  mutate(n = 100 * n.x / n.y,
          n = ifelse(is.na(n), 100, n)) %>%
 
   ggplot(
@@ -403,9 +403,16 @@ rss %>%
 
 ### Nombre de RSS manquants pour la clôture actuelle selon le mois de sortie du RSS
 ```{r fig8}
-gam %>%
+exhau_pims %>%
+  mutate(mois_sortie = month(Sortie)) %>%
+  filter(!is.na(DP)) %>%
   count(mois_sortie) %>%
-  full_join(data.frame(mois_sortie = setdiff(1:mois, .$mois_sortie), n = rep(0, length(setdiff(1:mois, .$mois_sortie))))) %>%
+  full_join(exhau_pims %>%
+            mutate(mois_sortie = month(Sortie)) %>%
+            count(mois_sortie),
+            by = "mois_sortie") %>%
+  mutate(n = n.y - n.x,
+         n = ifelse(is.na(n), 0, n)) %>%
 
   ggplot(
   aes(x = mois_sortie,
@@ -425,34 +432,12 @@ gam %>%
 
 ## Exhaustivité par pôle et par service
 ```{r tab9}
-#rss %>%
-#  filter(annee_sortie == annee) %>%
-#  count(pole_libelle, service_libelle) %>%
-#  bind_rows(rss %>%
-#            filter(annee_sortie == annee) %>%
-#            count(pole_libelle)) %>%
-#  full_join(gam %>%
-#            count(pole_libelle, service_libelle) %>%
-#            bind_rows(gam %>%
-#                      count(pole_libelle)),
-#            by = c("pole_libelle", "service_libelle")) %>%
-#  mutate(n.y = ifelse(is.na(n.y), 0, n.y),
-#         n.x = n.x + n.y,
-#         exh_service = (n.x - n.y) / n.x,
-#         pole_libelle = pole_libelle %>% factor) %>%
-#  arrange(pole_libelle, service_libelle) %>%
-#  mutate(service_libelle = ifelse(is.na(service_libelle), "TOTAL", service_libelle)) %>%
-#
-#  datatable(colnames = c("Pôle", "Service de responsabilité", "RSS produits", "RSS manquants", "Exhaustivité"),
-#            extensions = "Buttons",
-#            rownames = F) %>%
-#  formatPercentage(5, digits = 2)
 exhau_pims %>%
   group_by(Pole, Service) %>%
   summarise(Prod = n()) %>%
 full_join(
   exhau_pims %>%
-    filter(DP == "") %>%
+    filter(is.na(DP)) %>%
     group_by(Pole, Service) %>%
     summarise(Manquants = n())
 ) %>%
@@ -468,7 +453,7 @@ bind_rows(
     summarise(Prod = n()) %>%
     full_join(
       exhau_pims %>%
-        filter(DP == "") %>%
+        filter(is.na(DP)) %>%
         group_by(Pole) %>%
         summarise(Manquants = n())
     ) %>%
@@ -484,7 +469,7 @@ bind_rows(
     summarise(Prod = n()) %>%
     bind_cols(
       exhau_pims %>%
-        filter(DP == "") %>%
+        filter(is.na(DP)) %>%
         summarise(Manquants = n())
     ) %>%
     bind_cols(
@@ -693,8 +678,8 @@ _\* 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}
-gam %>% filter(date_sortie - date_entree == 0) %>% nrow -> zero
-gam %>% filter(date_sortie - date_entree > 0) %>% nrow -> plus
+exhau_pims %>% filter(is.na(DP), Duree == 0) %>% nrow -> zero
+exhau_pims %>% filter(is.na(DP), Duree > 0) %>% 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])) %>%
@@ -706,7 +691,7 @@ datatable(escape = F,
 formatCurrency(1:2, currency = "", interval = 3, mark = " ", digits = 2, dec.mark = ",")
 rm(plus, zero)
 ```
-*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`*  
+*Données issues de la requête BO «`r current`» et des tableaux OVALIDE [1.V.1.SV] B de `r 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
@@ -730,33 +715,3 @@ rm(IP_previous, IP_current)
 ```
 *Données issues des tableaux OVALIDE [1.D2.EDMS] de `r periode`*  
 _\* Nb de journées / Nb de journées standardisées sur la DMS théorique_
-
-<!---
-## Généralités
-
-### 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(extensions = "Buttons", 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(extensions = "Buttons", rownames = F)
-```
---->

donnees.R

@@ -111,54 +111,8 @@ print("7/9 - Sélection des RUMs")
 rum %<>%
   right_join(rss %>% select(idrss, annee_sortie, mois_sortie))
 
-# GAM et structure --> hospit non codées
-print("8/9 - LIVENNE : GAM")
-src_mysql("pmsi_dim", "localhost", user = user, password = password) %>%
-  tbl("mvt_gam") %>%
-  select(idhosp, date_entree, date_sortie, uf, pass_typ, type_resp) %>%
-  filter(pass_typ != "EXT",
-         type_resp == "M") %>%
-  distinct %>%
-  collect(n = Inf) %>%
-  mutate(date_entree = as.Date(date_entree),
-         date_sortie = as.Date(date_sortie)) %>%
-  anti_join(filter(., is.na(date_sortie) | date_sortie >= as.Date(str_c(annee, mois, "01", sep = "-")) + period(1, "month")),
-            by = "idhosp") %>% # supprimer séjours non terminés à la fin de la période étudiée
-  filter(date_sortie >= as.Date(str_c(annee, "01", "01", sep = "-"))) %>%
-  select(-pass_typ, -type_resp) %>%
-  left_join(src_mysql("pmsi_dim_nom", "localhost", user = user, password = password) %>%
-            tbl("structure") %>%
-            filter(um != "") %>%
-            select(uf, service, service_libelle, pole, pole_libelle) %>%
-            distinct %>%
-            collect(n = Inf), by = "uf") %>%
-  anti_join(rum, by="idhosp") %>% # supprimer séjours codés
-  arrange(idhosp, date_sortie) %>%
-  filter(!(service %in% c("5110", "5140", "1700", "1170", "1600", "2350", "9090")),
-         !is.na(service)) %>%
-  group_by(idhosp) %>%
-  summarise(date_entree = first(date_entree),
-            date_sortie = last(date_sortie),
-            service_libelle= last(service_libelle),
-            pole_libelle = last(pole_libelle)) %>%
-  mutate(mois_sortie = month(date_sortie)) -> gam
-
-print("9/9 - Écriture des données")
-# Enregistrement de l'exhaustivité au moment de la cloture
-if (mois == 1)
-{
-  exhau <- data.frame(mois = 1:12, rss = NA, manq = NA)
-} else
-{
-  load("exhau.Rdata")
-}
-
-exhau[exhau$mois == mois,]$rss <- rss %>% filter(annee_sortie == annee) %>% nrow
-exhau[exhau$mois == mois,]$manq <- gam %>% nrow
-
-save(exhau, file = "exhau.Rdata")
-
-# Données extraites de web100T pour l'exhaustivité par service
+# Exhaustivité ----
+print("8/9 - Exhaustivité")
 exhau_pims <- read_csv("exhau_pims.csv")
 names(exhau_pims) <- c("Pole", "Service", "RUM", "DP", "Erreur", "Sortie")
 
@@ -167,5 +121,3 @@ exhau_pims %<>%
   filter(month(Sortie) <= mois)
 
 save(Ovalide, OvalideP, annee, mois, rum, rss, gam, exhau, exhau_pims, date, file = "donnees.Rdata")
-
-write.csv2(gam, "gam.csv")