Katheterzahl pro Operateur im lfd. Jahr eingefügt.

vhk.Rmd

@@ -11,15 +11,18 @@ output:
 ```{r setup, include=FALSE}
 knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
 library(tidyverse)
+library(lubridate)
 
 raw_data = read_csv('vhk.csv') %>%
-  mutate(Year = lubridate::year(Date))
+  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
@@ -32,10 +35,24 @@ cath_by_year %>%
   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 = lubridate::month(Date)) %>%
+raw_data %>% mutate(Month = month(Date)) %>%
   group_by(Year) %>%
   count(Month) %>%
   ggplot(aes(x = Month, y = n, group = Year, alpha = Year)) +
@@ -47,7 +64,7 @@ raw_data %>% mutate(Month = lubridate::month(Date)) %>%
 
 ## Katheterexplantationen pro Jahr
 ```{r expl_by_year}
-raw_data %>% mutate(ExplYear = lubridate::year(RemovalDate)) %>%
+raw_data %>% mutate(ExplYear = year(RemovalDate)) %>%
   # group_by(InsertionSite, Side) %>%
   count(ExplYear) %>%
   ggplot(aes(x = ExplYear, y = n)) +
@@ -59,7 +76,7 @@ raw_data %>% mutate(ExplYear = lubridate::year(RemovalDate)) %>%
 
 ## Explantationen pro Implantation pro Jahr
 ```{r expl_by_cath_by_year}
-raw_data %>% mutate(ImplYear = lubridate::year(Date), ExplYear = lubridate::year(RemovalDate)) %>%
+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)) +
@@ -70,7 +87,7 @@ raw_data %>% mutate(ImplYear = lubridate::year(Date), ExplYear = lubridate::year
 
 ## Verweildauern der Katheter
 ```{r durations, message=FALSE}
-raw_data %>% mutate(Year = lubridate::year(Date), Duration = RemovalDate - Date) %>%
+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)) +
@@ -83,7 +100,7 @@ raw_data %>% mutate(Year = lubridate::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 = lubridate::year(RemovalDate) %% 100) %>%
+  mutate(ExplYear = year(RemovalDate) %% 100) %>%
   group_by(ExplYear) %>%
   count(RemovalReason) %>%
   ggplot(aes(x = ExplYear, y = n)) +
@@ -98,11 +115,11 @@ raw_data %>% filter(!is.na(RemovalDate), !is.na(RemovalReason)) %>%
 ```{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)
+impl_per_year = raw_data %>% mutate(ImplYear = year(Date)) %>% count(ImplYear)
 
 raw_data %>% 
   select(Date, RemovalDate, RemovalReason) %>%
-  mutate(ImplYear = lubridate::year(Date) %% 100, ExplYear = lubridate::year(RemovalDate)) %>%
+  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) %>%
@@ -121,6 +138,21 @@ raw_data %>%
   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
 ```{r patient_age}
@@ -190,8 +222,11 @@ raw_data %>%
 Nur Operateure der letzten 4 Jahre
 
 ```{r individual_fluoroscopy, message=FALSE}
-raw_data %>% filter(Year > lubridate::year(lubridate::today()) - 4, !is.na(InsertionFluoroscopyDuration)) %>%
+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() %>%
@@ -199,6 +234,7 @@ raw_data %>% filter(Year > lubridate::year(lubridate::today()) - 4, !is.na(Inser
   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]")
 ```