Liegedauern infizierter Katheter.

vhk.Rmd

@@ -13,13 +13,11 @@ knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
 library(tidyverse)
 library(lubridate)
 
-raw_data = read_csv('vhk.csv') %>%
-  mutate(Year = year(Date))
+raw_data = read_csv('vhk.csv') %>% mutate(ImplYear = year(Date)) %>% mutate(ExplYear = year(RemovalDate))
 
-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
+first_year = min(raw_data$ImplYear)
+last_year = max(raw_data$ImplYear)
+max_y_break = ((max((raw_data %>% count(ImplYear))$n) %/% 10) + 1) * 10
 
 reference_year = year(today()) - (today() < make_date(year(today()), 1, 31))
 
@@ -27,8 +25,9 @@ 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)) +
+raw_data %>%
+  count(ImplYear) %>%
+  ggplot(aes(x = ImplYear, 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)) +
@@ -37,7 +36,7 @@ cath_by_year %>%
 
 ## Katheterimplantationen pro Operateur im Jahr `r reference_year`
 ```{r}
-raw_data %>% mutate(Year = year(Date)) %>% filter(Year == reference_year) %>%
+raw_data %>% filter(Year == reference_year) %>%
   count(Surgeon) %>%
   arrange(n) %>%
   mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
@@ -64,7 +63,7 @@ raw_data %>% mutate(Month = month(Date)) %>%
 
 ## Katheterexplantationen pro Jahr
 ```{r expl_by_year}
-raw_data %>% mutate(ExplYear = year(RemovalDate)) %>%
+raw_data %>%
   # group_by(InsertionSite, Side) %>%
   count(ExplYear) %>%
   ggplot(aes(x = ExplYear, y = n)) +
@@ -76,7 +75,7 @@ raw_data %>% mutate(ExplYear = year(RemovalDate)) %>%
 
 ## Explantationen pro Implantation pro Jahr
 ```{r expl_by_cath_by_year}
-raw_data %>% mutate(ImplYear = year(Date), ExplYear = year(RemovalDate)) %>%
+raw_data %>%
   group_by(ImplYear) %>%
   summarise(ExplByImpl = sum(!is.na(ExplYear)) / n()) %>%
   ggplot(aes(x = ImplYear, y = ExplByImpl)) +
@@ -87,10 +86,10 @@ raw_data %>% mutate(ImplYear = year(Date), ExplYear = year(RemovalDate)) %>%
 
 ## Verweildauern der Katheter
 ```{r durations, message=FALSE}
-raw_data %>% mutate(Year = year(Date), Duration = RemovalDate - Date) %>%
-  group_by(Year) %>%
+raw_data %>% mutate(Duration = RemovalDate - Date) %>%
+  group_by(ImplYear) %>%
   summarize(MedianDuration = median(Duration, na.rm = TRUE)) %>%
-  ggplot(aes(x = Year, y = MedianDuration)) +
+  ggplot(aes(x = ImplYear, 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]")
@@ -100,7 +99,7 @@ raw_data %>% mutate(Year = year(Date), Duration = RemovalDate - Date) %>%
 ### Variante A: Absolute Zahlen
 ```{r removal_reasons, message=FALSE}
 raw_data %>% filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
-  mutate(ExplYear = year(RemovalDate) %% 100) %>%
+  mutate(ExplYear = ExplYear %% 100) %>%
   group_by(ExplYear) %>%
   count(RemovalReason) %>%
   ggplot(aes(x = ExplYear, y = n)) +
@@ -118,8 +117,8 @@ raw_data %>% filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
 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)) %>%
+  select(ImplYear, ExplYear, RemovalDate, RemovalReason) %>%
+  mutate(ImplYear = ImplYear %% 100) %>%
   left_join(impl_per_year, by = c("ExplYear" = "ImplYear")) %>% # creates column "n"
   filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
   group_by(ExplYear) %>%
@@ -138,6 +137,22 @@ raw_data %>%
   labs(x = NULL, y = "Anzahl entfernter Katheter / gelegter Katheter")
 ```
 
+## Wann treten Infektionen auf?
+```{r infections, message=FALSE}
+raw_data %>% filter(!is.na(RemovalDate), RemovalReason == "Infektion") %>%
+  mutate(Duration = RemovalDate - Date, Month = as.integer(Duration) %/% 30) %>%
+  ggplot(aes(x = Month)) +
+  geom_bar(width = 0.9) +
+  # raw_data %>% filter(!is.na(RemovalDate), RemovalReason == "Infektion") %>%
+  coord_cartesian(xlim = c(0, 56)) +
+  scale_x_continuous(breaks = seq(from = 0, to = 56, by = 4)) +
+  scale_y_continuous(breaks = seq(from = 0, to = 10, by = 1)) +
+  facet_grid(rows = vars(ImplYear)) +
+  labs(x = "Woche nach Implantation", y = "Anzahl wg. Infektion entfernter Katheter",
+       title = "Liegedauer infizierter Katheter nach Implantationsjahr")
+```
+
+
 <!--
 ## Explantationsgründe je Implanteur
 ```{r removal_reasons_by_surgeon, message=FALSE}
@@ -157,7 +172,7 @@ raw_data %>% filter(!is.na(RemovalDate)) %>%
 ## Alter der Patienten bei Implantation
 ```{r patient_age}
 raw_data %>%
-  ggplot(aes(group = Year, x = Year, y = Age)) +
+  ggplot(aes(group = ImplYear, x = ImplYear, y = Age)) +
   geom_boxplot() +
   coord_cartesian(ylim = c(20, 100)) +
   scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
@@ -167,8 +182,9 @@ raw_data %>%
 
 ## 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)) +
+raw_data %>% group_by(ImplYear) %>%
+  summarise(PercentFemale = sum(Sex == "weiblich") / n()) %>%
+  ggplot(aes(x = ImplYear, y = PercentFemale)) +
   geom_col() +
   scale_x_continuous(breaks = seq(from = first_year, to = last_year, by = 1)) +
   coord_cartesian(ylim = c(0, 1)) +
@@ -181,7 +197,7 @@ 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)) +
+  ggplot(aes(x = ImplYear)) +
   facet_grid(InsertionSite ~ Side) +
   geom_bar() +
   labs(x = NULL, y = "Anzahl Katheter")
@@ -191,12 +207,12 @@ raw_data %>% mutate(Side = factor(Side, levels = c("rechts", "links"))) %>%
 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) %>% 
+raw_data %>% group_by(ImplYear) %>% 
   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)) +
+  ggplot(aes(x = ImplYear, 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 ~ .) +
@@ -225,13 +241,13 @@ Nur Operateure der letzten 4 Jahre
 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) %>%
+  mutate(ImplYear = ImplYear %% 100) %>%
+  filter(ImplYear >= from_year, !is.na(InsertionFluoroscopyDuration)) %>%
+  group_by(Surgeon, ImplYear) %>%
   summarize(FluoroscopyIndex = median(InsertionFluoroscopyDuration, na.rm = TRUE)) %>%
   ungroup() %>%
   # mutate(Surgeon = factor(Surgeon, levels = Surgeon)) %>%
-  ggplot(aes(x = Year, y = FluoroscopyIndex)) +
+  ggplot(aes(x = ImplYear, y = FluoroscopyIndex)) +
   geom_point() +
   geom_line() +
   scale_x_continuous(breaks = seq(from = from_year, to = to_year, by = 1 )) +