Explantationsstatistik hinzugefügt.

vhk.Rmd

@@ -32,6 +32,96 @@ cath_by_year %>%
   labs(x = NULL, y = "Anzahl Katheter")
 ```
 
+<!--
+## Katheterimplantationen im Jahresverlauf
+```{r cath_by_month}
+raw_data %>% mutate(Month = lubridate::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 = lubridate::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 = lubridate::year(Date), ExplYear = lubridate::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 = lubridate::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 = lubridate::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 = lubridate::year(Date)) %>% count(ImplYear)
+
+raw_data %>% 
+  select(Date, RemovalDate, RemovalReason) %>%
+  mutate(ImplYear = lubridate::year(Date) %% 100, ExplYear = lubridate::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")
+```
+
+
 ## Alter der Patienten
 ```{r patient_age}
 raw_data %>%
@@ -49,6 +139,7 @@ raw_data %>% group_by(Year) %>% summarise(PercentFemale = sum(Sex == "weiblich")
   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")
 ```
@@ -95,6 +186,23 @@ raw_data %>%
   labs(x = NULL, y = "Median der Durchleuchtungsdauer [s]")
 ```
 
+## Individuelle Durchleuchtungsdauern
+Nur Operateure der letzten 4 Jahre
+
+```{r individual_fluoroscopy, message=FALSE}
+raw_data %>% filter(Year > lubridate::year(lubridate::today()) - 4, !is.na(InsertionFluoroscopyDuration)) %>%
+  mutate(Year = Year %% 100) %>%
+  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() +
+  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)) %>%