262 lines
8.6 KiB
Plaintext
262 lines
8.6 KiB
Plaintext
---
|
|
title: "Vorhofkatheter-Statistik"
|
|
author: "Daniel Kraus"
|
|
date: '2018-12-29'
|
|
output:
|
|
slidy_presentation: default
|
|
ioslides_presentation: default
|
|
beamer_presentation: default
|
|
---
|
|
|
|
```{r setup, include=FALSE}
|
|
knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
|
|
library(tidyverse)
|
|
library(lubridate)
|
|
|
|
raw_data = read_csv('vhk.csv') %>%
|
|
mutate(Year = year(Date))
|
|
|
|
cath_by_year = raw_data %>% count(Year)
|
|
first_year = min(raw_data$Year)
|
|
last_year = max(raw_data$Year)
|
|
max_y_break = ((max(cath_by_year$n) %/% 10) + 1) * 10
|
|
|
|
reference_year = year(today()) - (today() < make_date(year(today()), 1, 31))
|
|
|
|
```
|
|
|
|
## Katheterimplantationen pro Jahr
|
|
```{r cath_by_year }
|
|
cath_by_year %>%
|
|
ggplot(aes(x = Year, y = n)) +
|
|
geom_col() +
|
|
scale_y_continuous(breaks = seq(from = 0, to = max_y_break, by = 10)) +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
labs(x = NULL, y = "Anzahl Katheter")
|
|
```
|
|
|
|
## Katheterimplantationen pro Operateur im Jahr `r reference_year`
|
|
```{r}
|
|
raw_data %>% mutate(Year = year(Date)) %>% filter(Year == reference_year) %>%
|
|
count(Surgeon) %>%
|
|
arrange(n) %>%
|
|
mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
|
|
ggplot(aes(x = Surgeon, y = n)) +
|
|
geom_col() +
|
|
coord_flip() +
|
|
labs(x = NULL, y = stringr::str_c("Anzahl Katheter im Jahr ", reference_year))
|
|
```
|
|
|
|
|
|
|
|
<!--
|
|
## Katheterimplantationen im Jahresverlauf
|
|
```{r cath_by_month}
|
|
raw_data %>% mutate(Month = month(Date)) %>%
|
|
group_by(Year) %>%
|
|
count(Month) %>%
|
|
ggplot(aes(x = Month, y = n, group = Year, alpha = Year)) +
|
|
geom_point() +
|
|
geom_line()
|
|
|
|
```
|
|
-->
|
|
|
|
## Katheterexplantationen pro Jahr
|
|
```{r expl_by_year}
|
|
raw_data %>% mutate(ExplYear = year(RemovalDate)) %>%
|
|
# group_by(InsertionSite, Side) %>%
|
|
count(ExplYear) %>%
|
|
ggplot(aes(x = ExplYear, y = n)) +
|
|
geom_col() +
|
|
# facet_grid(rows = vars(InsertionSite), cols = vars(Side)) +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
labs(x = NULL, y = "Explantationen")
|
|
```
|
|
|
|
## Explantationen pro Implantation pro Jahr
|
|
```{r expl_by_cath_by_year}
|
|
raw_data %>% mutate(ImplYear = year(Date), ExplYear = year(RemovalDate)) %>%
|
|
group_by(ImplYear) %>%
|
|
summarise(ExplByImpl = sum(!is.na(ExplYear)) / n()) %>%
|
|
ggplot(aes(x = ImplYear, y = ExplByImpl)) +
|
|
geom_col() +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
labs(x = NULL, y = "Explantationen pro Implantation")
|
|
```
|
|
|
|
## Verweildauern der Katheter
|
|
```{r durations, message=FALSE}
|
|
raw_data %>% mutate(Year = year(Date), Duration = RemovalDate - Date) %>%
|
|
group_by(Year) %>%
|
|
summarize(MedianDuration = median(Duration, na.rm = TRUE)) %>%
|
|
ggplot(aes(x = Year, y = MedianDuration)) +
|
|
geom_col() +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
labs(x = NULL, y = "Mediane Katheter-Verweildauer [Tage]")
|
|
```
|
|
|
|
## Gründe der Katheterexplantation
|
|
### Variante A: Absolute Zahlen
|
|
```{r removal_reasons, message=FALSE}
|
|
raw_data %>% filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
|
|
mutate(ExplYear = year(RemovalDate) %% 100) %>%
|
|
group_by(ExplYear) %>%
|
|
count(RemovalReason) %>%
|
|
ggplot(aes(x = ExplYear, y = n)) +
|
|
geom_point() + geom_line() +
|
|
scale_x_continuous(breaks = scales::pretty_breaks()) +
|
|
scale_y_continuous(breaks = scales::pretty_breaks()) +
|
|
facet_wrap(vars(RemovalReason)) +
|
|
labs(x = NULL, y = "Anzahl entfernter Katheter")
|
|
```
|
|
|
|
### Variante B: auf die Zahl der in dem Jahr gelegten Katheter bezogen
|
|
```{r removal_reasons_normalized, message=FALSE}
|
|
# Zur Berechnung dieses Index muß man zunächst für jeden explantierten Katheter
|
|
# berechnen, wie viele Katheter im *ex*plantationsjahr *im*plantiert wurden.
|
|
impl_per_year = raw_data %>% mutate(ImplYear = year(Date)) %>% count(ImplYear)
|
|
|
|
raw_data %>%
|
|
select(Date, RemovalDate, RemovalReason) %>%
|
|
mutate(ImplYear = year(Date) %% 100, ExplYear = year(RemovalDate)) %>%
|
|
left_join(impl_per_year, by = c("ExplYear" = "ImplYear")) %>% # creates column "n"
|
|
filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
|
|
group_by(ExplYear) %>%
|
|
add_count(RemovalReason) %>% # creates column "nn"
|
|
ungroup() %>%
|
|
select(ExplYear, RemovalReason, n, nn) %>%
|
|
mutate(i = nn/n) %>%
|
|
group_by(ExplYear, RemovalReason) %>%
|
|
# summarize(i = sum(i)) %>%
|
|
distinct() %>%
|
|
ggplot(aes(x = ExplYear, y = i)) +
|
|
geom_point() + geom_line() +
|
|
scale_x_continuous(breaks = scales::pretty_breaks()) +
|
|
scale_y_continuous(breaks = scales::pretty_breaks()) +
|
|
facet_wrap(vars(RemovalReason)) +
|
|
labs(x = NULL, y = "Anzahl entfernter Katheter / gelegter Katheter")
|
|
```
|
|
|
|
<!--
|
|
## Explantationsgründe je Implanteur
|
|
```{r removal_reasons_by_surgeon, message=FALSE}
|
|
raw_data %>% filter(!is.na(RemovalDate)) %>%
|
|
mutate(ExplYear = year(RemovalDate)) %>%
|
|
filter(ExplYear > year(today()) - 4) %>%
|
|
group_by(ExplYear, Surgeon) %>%
|
|
count(RemovalReason) %>%
|
|
ggplot(aes(x = ExplYear, y = n)) +
|
|
geom_point() + geom_line() +
|
|
facet_grid(rows = vars(Surgeon), cols = vars(RemovalReason)) +
|
|
labs(x = NULL, y = "Anzahl expl. Katheter")
|
|
```
|
|
-->
|
|
|
|
|
|
## Alter der Patienten bei Implantation
|
|
```{r patient_age}
|
|
raw_data %>%
|
|
ggplot(aes(group = Year, x = Year, y = Age)) +
|
|
geom_boxplot() +
|
|
coord_cartesian(ylim = c(20, 100)) +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
scale_y_continuous(breaks = seq(from = 20, to = 100, by = 10)) +
|
|
labs(x = NULL, y = "Jahre")
|
|
```
|
|
|
|
## Geschlecht der Patienten bei Implantation
|
|
```{r patient_sex}
|
|
raw_data %>% group_by(Year) %>% summarise(PercentFemale = sum(Sex == "weiblich") / n()) %>%
|
|
ggplot(aes(x = Year, y = PercentFemale)) +
|
|
geom_col() +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
coord_cartesian(ylim = c(0, 1)) +
|
|
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
|
|
labs(x = NULL, y = "Anteil Frauen")
|
|
```
|
|
|
|
## Katheterlokalisation
|
|
Ist da ein Trend hin zu immer mehr Kathetern von links?!
|
|
|
|
```{r insertion_site}
|
|
raw_data %>% mutate(Side = factor(Side, levels = c("rechts", "links"))) %>%
|
|
ggplot(aes(x = Year)) +
|
|
facet_grid(InsertionSite ~ Side) +
|
|
geom_bar() +
|
|
labs(x = NULL, y = "Anzahl Katheter")
|
|
```
|
|
|
|
## Anteil der Arztrollen
|
|
Um 2014 herum haben einige die Facharztprüfung abgelegt, ist das der Grund für die Auffälligkeit 2015/2016?
|
|
|
|
```{r percent_residents}
|
|
raw_data %>% group_by(Year) %>%
|
|
summarize(Assistenzarzt = sum(SurgeonRole == "Assistenzarzt") / n(),
|
|
Facharzt = sum(SurgeonRole == "Facharzt") / n(),
|
|
Oberarzt = sum(SurgeonRole == "Oberarzt") / n()) %>%
|
|
gather(key = Role, value = Percent, Assistenzarzt, Facharzt, Oberarzt) %>%
|
|
ggplot(aes(x = Year, y = Percent)) +
|
|
scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
|
|
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
|
|
facet_grid(Role ~ .) +
|
|
geom_col() +
|
|
labs(x = NULL, y = "Anteil in den gelegten Kathetern")
|
|
```
|
|
|
|
## Hitparade der Durchleuchtungsdauern
|
|
```{r greatest_fluoroscopy}
|
|
raw_data %>%
|
|
group_by(Surgeon) %>%
|
|
summarize(FluoroscopyIndex = median(InsertionFluoroscopyDuration, na.rm = TRUE)) %>%
|
|
arrange(desc(FluoroscopyIndex)) %>%
|
|
top_n(-10, FluoroscopyIndex) %>%
|
|
mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
|
|
ggplot(aes(x = Surgeon, y = FluoroscopyIndex)) +
|
|
geom_col() +
|
|
coord_flip() +
|
|
labs(x = NULL, y = "Median der Durchleuchtungsdauer [s]")
|
|
```
|
|
|
|
## Individuelle Durchleuchtungsdauern
|
|
Nur Operateure der letzten 4 Jahre
|
|
|
|
```{r individual_fluoroscopy, message=FALSE}
|
|
to_year = year(today()) %% 100
|
|
from_year = to_year - 3
|
|
raw_data %>%
|
|
mutate(Year = Year %% 100) %>%
|
|
filter(Year >= from_year, !is.na(InsertionFluoroscopyDuration)) %>%
|
|
group_by(Surgeon, Year) %>%
|
|
summarize(FluoroscopyIndex = median(InsertionFluoroscopyDuration, na.rm = TRUE)) %>%
|
|
ungroup() %>%
|
|
# mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
|
|
ggplot(aes(x = Year, y = FluoroscopyIndex)) +
|
|
geom_point() +
|
|
geom_line() +
|
|
scale_x_continuous(breaks = seq(from = from_year, to = to_year, by = 1 )) +
|
|
facet_wrap(vars(Surgeon)) +
|
|
labs(x = NULL, y = "Median der Durchleuchtungsdauer [s]")
|
|
```
|
|
|
|
## Hitparade der Implanteure
|
|
```{r greatest_surgeons}
|
|
raw_data %>% count(Surgeon) %>% arrange(n) %>% top_n(10, n) %>% mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
|
|
ggplot(aes(x = Surgeon, y = n)) +
|
|
geom_col() +
|
|
coord_flip() +
|
|
labs(x = NULL, y = "Gesamtzahl Katheter")
|
|
```
|
|
|
|
## Hitparade der Assistenten
|
|
Einsame Spitze... Romana Ziegler!
|
|
|
|
```{r greatest_assistants}
|
|
raw_data %>% count(Assistant) %>% arrange(n) %>% top_n(10, n) %>% mutate(Assistant = factor(Assistant, levels = Assistant)) %>%
|
|
ggplot(aes(x = Assistant, y = n)) +
|
|
geom_col() +
|
|
coord_flip() +
|
|
labs(x = NULL, y = "Gesamtzahl Katheter")
|
|
```
|
|
|