Fragilità in PS
Caratteristiche generali del campione
Rapporto tra % di accessi e % ricoveri sul totale, per gruppi di età
df %>%
group_by(age.gr,) %>%
summarise(accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = ricoveri/sum(ricoveri),
p.accessi = accessi/sum(accessi)) %>%
pivot_longer(-c(age.gr, accessi, ricoveri), values_to = "prop", names_to = "tipo") %>%
ggplot(aes(x = age.gr, y = prop, col = tipo)) +
geom_point(size = 1.5) + geom_line(aes(x = as.numeric(age.gr)), size = 1.1)+
xlab("Età")+
ylab("% Totale")+
theme_light()+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),
axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
scale_color_discrete(name = "", labels = c("Accessi", "Ricoveri"))
Percentuale di ricovero per classi di età
df %>%
group_by(age.gr,) %>%
summarise(accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = ricoveri/accessi,
p.accessi = accessi/sum(accessi)) %>%
ggplot(aes(x = age.gr, y = p.ricovero)) +
geom_bar(stat = "identity", col = "black", fill = "lightblue", linewidth = 1.2) +
theme_light()+
xlab("Età")+
ylab("% Ricoverati")+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
Percentuale di ricovero per presa in carico, per età (solo 65+, esclusi ROSSI)
df %>%
filter(ETÀ >= 65 & (TRIAGE_INGRESSO != "ROSSO" | TRIAGE_INGRESSO != "1 - EMERGENZA")) %>%
group_by(age.gr) %>%
summarise(accessi = n(),
argento = sum(frag),
ricoveri = sum(ESITO == "Ricoverato"),
ric.argento= sum(ESITO == "Ricoverato" & frag == 1),
ric.NA = sum(ESITO == "Ricoverato" & frag == 0)) %>%
mutate(p.accesso = accessi/sum(accessi),
p.argento = argento/sum(argento))%>%
select(age.gr, p.accesso, p.argento) %>%
pivot_longer(-age.gr, values_to = "p", names_to = "t") %>%
ggplot(aes(x = age.gr, y = p, fill = t))+
geom_bar(stat = "identity", position = "dodge", col = "black", linewidth = 1.2)+
xlab("Età")+
ylab("% Accessi")+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
theme_light()+
scale_fill_discrete(name = "Presa in carico", labels = c("Ordinaria", "Geriatra"))
Percentuale di ricovero per presa in carico, per età (solo 65+, esclusi ROSSI)
df %>%
filter(ETÀ >= 65 & (TRIAGE_INGRESSO != "ROSSO" | TRIAGE_INGRESSO != "1 - EMERGENZA")) %>%
group_by(age.gr) %>%
summarise(accessi = n(),
argento = sum(frag),
ricoveri = sum(ESITO == "Ricoverato"),
ric.argento= sum(ESITO == "Ricoverato" & frag == 1),
ric.NA = sum(ESITO == "Ricoverato" & frag == 0)) %>%
mutate(p.r.arg = ric.argento/argento,
p.r.NA = ric.NA/(accessi-argento)) %>%
select(age.gr, p.r.arg, p.r.NA) %>%
pivot_longer(-age.gr, values_to = "p", names_to = "t") %>%
mutate(t.2 = as.numeric(as.factor(t))*-1) %>%
ggplot(aes(x = age.gr, y = p, fill = factor(t.2)))+
geom_bar(stat = "identity", position = "dodge", col = "black", linewidth = 1.2)+
xlab("Età")+
ylab("% Ricoverati")+
scale_y_continuous(labels = scales::percent_format())+
theme_light()+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))+
scale_fill_discrete(name = "Presa in carico", labels = c("Ordinaria", "Geriatra"))
#I geriatri ricoverano meno over 65 verdi o gialli?
df$triage.2 <- ifelse(df$TRIAGE_INGRESSO == "1 - EMERGENZA", "ROSSO",
ifelse(df$TRIAGE_INGRESSO == "2 - URGENZA" | df$TRIAGE_INGRESSO == "3 - URGENZA DIFFERIBILE", "GIALLO",
ifelse(df$TRIAGE_INGRESSO == "4 - URGENZA MINORE", "VERDE",
ifelse(df$TRIAGE_INGRESSO == "5 - NON URGENZA", "BIANCO", df$TRIAGE_INGRESSO))))
df$triage.2 <- factor(df$triage.2, levels = c("BIANCO","VERDE","GIALLO","ROSSO"))
df %>%
filter(ETÀ >= 65 & (triage.2 == "VERDE" | triage.2 == "GIALLO")) %>%
group_by(frag) %>%
summarise(accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = ricoveri/accessi,
se = sqrt((p.ricovero * (1-p.ricovero)) / accessi),
l.b = p.ricovero - 1.96*se,
u.b = p.ricovero + 1.96*se)# A tibble: 2 × 7
frag accessi ricoveri p.ricovero se l.b u.b
<dbl> <int> <int> <dbl> <dbl> <dbl> <dbl>
1 0 3549 1339 0.377 0.00814 0.361 0.393
2 1 156 16 0.103 0.0243 0.0550 0.150#I geriatri ricoverano in modo diverso gli over65 verdi o gialli??
df %>%
filter(ETÀ >= 65 & (triage.2 == "VERDE" | triage.2 == "GIALLO")) %>%
group_by(frag, age.gr) %>%
summarise(accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = ricoveri/accessi,
se = sqrt((p.ricovero*(1-p.ricovero))/accessi),
l.b = p.ricovero - 1.96*se,
u.b = p.ricovero + 1.96*se)# A tibble: 12 × 8
# Groups: frag [2]
frag age.gr accessi ricoveri p.ricovero se l.b u.b
<dbl> <fct> <int> <int> <dbl> <dbl> <dbl> <dbl>
1 0 65-69 578 131 0.227 0.0174 0.193 0.261
2 0 70-74 639 181 0.283 0.0178 0.248 0.318
3 0 75-79 681 226 0.332 0.0180 0.296 0.367
4 0 80-84 794 351 0.442 0.0176 0.408 0.477
5 0 85-89 497 241 0.485 0.0224 0.441 0.529
6 0 90+ 360 209 0.581 0.0260 0.530 0.632
7 1 65-69 2 1 0.5 0.354 -0.193 1.19
8 1 70-74 14 0 0 0 0 0
9 1 75-79 25 3 0.12 0.0650 -0.00738 0.247
10 1 80-84 50 5 0.1 0.0424 0.0168 0.183
11 1 85-89 36 5 0.139 0.0576 0.0259 0.252
12 1 90+ 29 2 0.0690 0.0471 -0.0233 0.161df %>%
filter(ETÀ >= 65 & (triage.2 == "VERDE" | triage.2 == "GIALLO"))%>%
group_by(frag, age.gr) %>%
summarise(accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = ricoveri/accessi,
se = sqrt((p.ricovero*(1-p.ricovero))/accessi),
l.b = p.ricovero - 1.96*se,
u.b = p.ricovero + 1.96*se) %>%
ggplot(aes(x = age.gr, y = p.ricovero, col = factor(frag)))+
geom_point(size = 1.5)+
geom_errorbar(aes(ymin = l.b, ymax = u.b), width = .2, size = 1.1, alpha = .7)+
theme_light() +
scale_color_discrete(name = "Presa in carico", labels = c("Ordinaria", "Geriatrica"))+
xlab("Età")+
ylab("Ricoverati")+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
#Si ricovera meno quando ci sono i geriatri?
df %>%
group_by(date) %>%
summarise(geriatra = ifelse(sum(frag) >0 ,1,0),
accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
group_by(geriatra) %>%
summarise(tot.acc = sum(accessi),
tot.ric = sum(ricoveri)) %>%
mutate(p.ric = tot.ric/tot.acc,
se = sqrt((p.ric * (1-p.ric)) / tot.acc),
l.b = p.ric - 1.96*se,
u.b = p.ric + 1.96*se)# A tibble: 2 × 7
geriatra tot.acc tot.ric p.ric se l.b u.b
<dbl> <int> <int> <dbl> <dbl> <dbl> <dbl>
1 0 6968 1400 0.201 0.00480 0.192 0.210
2 1 4658 901 0.193 0.00579 0.182 0.205#Si ricovera in modo diverso nei giorni in cui è presente il geriatra in PS?
df %>%
group_by(date, age.gr) %>%
summarise(geriatra = ifelse(sum(frag) >0 ,1,0),
accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
group_by(geriatra, age.gr) %>%
summarise(tot.acc = sum(accessi),
tot.ric = sum(ricoveri)) %>%
mutate(p.ric = tot.ric/tot.acc,
se = sqrt((p.ric * (1-p.ric)) / tot.acc),
l.b = p.ric - 1.96*se,
u.b = p.ric + 1.96*se) %>%
ggplot(aes(x = age.gr, y = p.ric, col = factor(geriatra)))+
geom_point(size = 1.5)+
geom_errorbar(aes(ymin = l.b, ymax = u.b), width = .2, size = 1.1, alpha = .7)+
theme_light() +
scale_color_discrete(name = "Geriatra", labels = c("Assente", "Presente"))+
xlab("Età")+
ylab("Ricoverati")+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
df %>%
filter(triage.2 != "ARGENTO") %>%
group_by(date, triage.2) %>%
summarise(geriatra = ifelse(sum(frag) >0 ,1,0),
accessi = n(),
ricoveri = sum(ESITO == "Ricoverato")) %>%
group_by(geriatra, triage.2) %>%
summarise(tot.acc = sum(accessi),
tot.ric = sum(ricoveri)) %>%
mutate(p.ric = tot.ric/tot.acc,
se = sqrt((p.ric * (1-p.ric)) / tot.acc),
l.b = p.ric - 1.96*se,
u.b = p.ric + 1.96*se) %>%
ggplot(aes(x = triage.2, y = p.ric, col = factor(geriatra)))+
geom_point(size = 1.5)+
geom_errorbar(aes(ymin = l.b, ymax = u.b), width = .2, size = 1.1, alpha = .7)+
theme_light() +
scale_color_discrete(name = "Geriatra", labels = c("Assente", "Presente"))+
xlab("Età")+
ylab("Ricoverati")+
scale_y_continuous(labels = scales::percent_format())+
theme(text=element_text(size=14),axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
#divisione per codice
df %>%
filter(ETÀ >= 65 & !is.na(triage.2)) %>%
group_by(frag, triage.2) %>%
summarise(n.accessi = n(),
n.ricovero = sum(ESITO == "Ricoverato")) %>%
mutate(p.ricovero = n.ricovero/n.accessi)# A tibble: 6 × 5
# Groups: frag [2]
frag triage.2 n.accessi n.ricovero p.ricovero
<dbl> <fct> <int> <int> <dbl>
1 0 BIANCO 107 3 0.0280
2 0 VERDE 2028 452 0.223
3 0 GIALLO 1521 887 0.583
4 0 ROSSO 176 146 0.830
5 1 VERDE 100 11 0.11
6 1 GIALLO 56 5 0.0893glm(ifelse(ESITO == "Ricoverato",1,0) ~
frag + ETÀ + triage.2, data = df, binomial("logit")) %>% broom::tidy(.,exponentiate = TRUE, conf.int = TRUE)# A tibble: 6 × 7
term estimate std.error statistic p.value conf.low conf.high
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 0.000945 0.458 -15.2 2.76e- 52 0.000334 0.00209
2 frag 0.149 0.277 -6.88 5.83e- 12 0.0835 0.249
3 ETÀ 1.04 0.00139 29.6 5.12e-193 1.04 1.04
4 triage.2VERDE 11.1 0.452 5.32 1.02e- 7 5.10 31.1
5 triage.2GIALLO 56.8 0.452 8.94 3.84e- 19 26.1 160.
6 triage.2ROSSO 236. 0.475 11.5 1.24e- 30 103. 687. glm(ifelse(ESITO == "Ricoverato",1,0) ~
frag + ETÀ + triage.2, data = df, binomial("logit")) -> fit
df.synt <- expand.grid(seq(65,100), c(0,1), c("BIANCO","VERDE","GIALLO","ROSSO") ) %>% as.data.frame
names(df.synt) <- c("ETÀ", "frag", "triage.2")
df.synt$pred.p <- predict(fit, type = "response", newdata = df.synt)
df.synt %>%
ggplot(aes(x = ETÀ, y = pred.p, col = triage.2, shape = factor(frag))) +
geom_point() + geom_line()+
theme_light()