diff --git a/cloture.Rmd b/cloture.Rmd index bc83ce1..224cc49 100644 --- a/cloture.Rmd +++ b/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_ - - diff --git a/donnees.R b/donnees.R index 8b9e30d..1966da9 100644 --- a/donnees.R +++ b/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")