|
- source("functionsOvalide.R")
- library(lubridate)
-
- # Date pour le rapport
- date <- format.Date(today(),format="%d/%m/%Y")
-
- # 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 %>%
- 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 %>%
- 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))
-
- # 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 %>%
- 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, 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")),
- !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
- exhau_pims <- read_csv("exhau_pims.csv", locale = locale(encoding = "ISO-8859-1"))
- names(exhau_pims) <- c("Pole", "Service", "RUM", "DP", "Erreur", "Sortie")
-
- exhau_pims %<>%
- mutate(Sortie = Sortie %>% as.Date) %>%
- filter(month(Sortie) <= mois)
-
- save(Ovalide, OvalideP, annee, mois, rum, rss, gam, exhau, exhau_pims, date, file = "donnees.Rdata")
-
- write.csv2(gam, "gam.csv")
|