Raport NEWSTAT

Author

Tomasz Lonc

Setup + import

Pokaż kod

pacman::p_load(
  rio,
  here,
  tidyverse, #zawiera dplyr, forcats, ggplot2, readr, tibble, purr
  lubridate,
  openxlsx,
  skimr,        # get overview of data
  gtsummary,    # summary statistics and tests
  rstatix,      # summary statistics and statistical tests
  janitor,      # adding totals and percents to tables
  scales,       # easily convert proportions to percents  
  flextable,     # converting tables to pretty images
  hrbrthemes,
  viridis,
  gt,
  DT
)

# here("NEWSTAT.Rproj")

data_cleaned <- readRDS(here::here("data", "data_cleaned.rds"))

data_alerty <- data_cleaned %>% 
  filter(outcome != "HOT NEWS reocena")

Słownik, definicje i założenia

Interwencje - wszystkie wpisy, w tym reoceny HOT NEWS (przedłużenie/ zakończenie nadzoru).
Alerty - wszystkie interwencje bez uwzględnienia reocen HOT NEWS, czyli interwencje zakończone:
- wdrożeniem do HOT NEWS,
- SOFT NEWS,
- przyjęciem do OIT,
- decyzją o braku eskalacji leczenia (DNR).
Wzmożony nadzór HOT NEWS zakończyć się może:
- poprawą,
- przyjęciem do OIT,
- decyzją o braku eskalacji leczenia (DNR).
Wskaźniki jakości opieki ZWR - pozytywne :
- uniknięcie przyjęcia do OIT = HOT NEWS zakończony poprawą (bez przyjęcia do OIT i NZK w ciągu 24h),
- zapobieganie nieplanowemu przyjęciu do OIT :
  - alert zakończony przyjęciem do OIT,
  - HOT NEWS zakończony przyjęciem do OIT,
- ograniczenie terapii daremnej,
  - alert zakończony DNR.
Wskaźniki jakości opieki ZWR - negatywne :
- NZK w ciągu 24 h od alertu (nie dotyczy alertów zakończonych przyjęciem do OIT).

Okres

04.08.2025 - 30.09.2025

343 interwencje, w tym 134 w sierpniu i 209 we wrześniu.

13 oddziałów.

lista_cleaned <- lapply(data_cleaned, identity)

Tabela

Pokaż kod

library(DT)
library(dplyr)
library(lubridate)

df_tbl <- data_cleaned %>%
  select(-c(patient, score_cat, brak_lekarza, hotnews_details)) %>%
  mutate(
    time = format(ymd_hms(time), "%d.%m.%Y %H:%M")  # 05.08.2025 11:55
  )

Warning: There was 1 warning in `mutate()`.
ℹ In argument: `time = format(ymd_hms(time), "%d.%m.%Y %H:%M")`.
Caused by warning:
!  4 failed to parse.

Pokaż kod

# indeksy kolumn (0-based)
u_idx <- match("uwagi", names(df_tbl)) - 1
t_idx <- match("time", names(df_tbl)) - 1

datatable(
  df_tbl,
  rownames = FALSE,
  escape   = which(names(df_tbl) != "uwagi"),
  options  = list(
    pageLength = 5,
    autoWidth  = TRUE,
    columnDefs = list(
      list(width = "160px", targets = t_idx),   # szersza kolumna 'time'
      list(width = "300px", targets = u_idx),   # szersza kolumna 'uwagi'
      list(
        targets = u_idx,
        render  = JS("
          function(data, type, row, meta) {
            if (data == null) return data;
            function escHTML(x){return x.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(/>/g,'&gt;');}
            function escAttr(x){return x.replace(/&/g,'&amp;').replace(/</g,'&lt;').replace(/>/g,'&gt;').replace(/\"/g,'&quot;');}
            if (type !== 'display') return data;
            var full  = String(data);
            var short = full.length > 50 ? full.substr(0, 50) + '…' : full;
            return '<span title=\"' + escAttr(full) + '\">' + escHTML(short) + '</span>';
          }"
        )
      )
    )
  )
) %>%
  formatStyle(
    columns = names(df_tbl),
    fontSize = "12px"
  )

Liczba interwencji dziennie

Pokaż kod

# 1) Tabela z liczbą alertów dziennie
interwencje_daily <- data_cleaned %>%
  mutate(data = as.Date(time)) %>%
  count(data, name = "interwencje") %>%
  arrange(data)

# 2) Wykres
ggplot(interwencje_daily, aes(x = data, y = interwencje)) +
  geom_col(
    fill  = "#69b3a2",
    color = "#e9ecef",
    alpha = 0.9,
    width = 0.9
  ) +
  ggtitle("Liczba interwencji dziennie") +
  scale_y_continuous(
    breaks = seq(0, max(interwencje_daily$interwencje, na.rm = TRUE), by = 2)  # co 2
  ) +
  scale_x_date(
    date_labels = "%d.%m",
    date_breaks = "3 day"
  ) +
  theme_ipsum() +
  theme(
    plot.title = element_text(size = 15),
    axis.text.x = element_text(angle = 45, hjust = 1),
    panel.grid.major.x = element_blank(),
    panel.grid.minor   = element_blank(),
    panel.grid.major.y = element_line(color = "gray80", linewidth = 0.3) # poprawione
  )

Pokaż kod

hist_data <- interwencje_daily %>%
  count(interwencje, name = "dni") %>%
  complete(interwencje = 0:max(interwencje, na.rm = TRUE),
           fill = list(dni = 0)) %>%
  arrange(interwencje)

max_interwencje <- max(hist_data$interwencje, na.rm = TRUE)
max_count       <- max(hist_data$dni, na.rm = TRUE)

ggplot(hist_data, aes(x = interwencje, y = dni)) +
  geom_col(fill = "#69b3a2", color = "#e9ecef", alpha = 0.9, width = 0.9) +
  ggtitle("Rozkład liczby interwencji dziennie") +
  scale_x_continuous(breaks = 0:max_interwencje,
                     expand = expansion(mult = c(0.01, 0.01))) +
  scale_y_continuous(breaks = 0:max_count,
                     expand = expansion(mult = c(0, 0.05))) +
  theme_ipsum() +
  labs(x = "Interwencje", y = "Liczba dni") +
  theme(plot.title = element_text(size = 15),
        panel.grid.major.x = element_blank(),
        panel.grid.minor   = element_blank(),
        panel.grid.major.y = element_line(color = "gray80", linewidth = 0.3))

Alerty

Ilość i rodzaj alertów NEWS wykonanych przez SWIT.

Pokaż kod

# Przygotowanie danych
outcome_counts <- data_alerty %>%
  count(outcome) %>%
  mutate(
    pct = n / sum(n),
    label = paste0(n, " (", percent(pct, accuracy = 0.1), ")"),
    outcome = fct_relevel(outcome, "HOT NEWS", "SOFT NEWS", "DNR", "Błąd pomiaru", "Przyjęcie do OIT")
  )

# Wykres
ggplot(outcome_counts, aes(x = outcome, y = n, fill = outcome)) +
  geom_col() +
  geom_text(aes(label = label), vjust = -0.5, size = 4) +
  scale_fill_hue(c = 40) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(
    title = "Liczba alertów według wyniku",
    x = NULL,
    y = "Liczba alertów"
  )

Pokaż kod

data_alerty %>%
  count(outcome) %>%
  mutate(
        outcome = fct_relevel(outcome, "HOT NEWS", "SOFT NEWS", "Przyjęcie do OIT", "DNR", "Błąd pomiaru"),
    pct = scales::percent(n / sum(n), accuracy = 0.1)) %>%
  arrange(outcome) %>%  # posortuj zgodnie z kolejnością faktora
  bind_rows(
    summarise(., 
      outcome = "Razem",
      n = sum(n),
      pct = scales::percent(1, accuracy = 0.1)
    )
  ) %>%
  gt::gt() %>% 
  gt::cols_label(
    outcome = "Alert",
    n = "Ilość",
    pct = "Odsetek"
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wybierz etykiety kolumn
      columns = everything()                  # wszystkie kolumny
    )
  )

Alert	Ilość	Odsetek
HOT NEWS	81	16.8%
SOFT NEWS	288	59.6%
Przyjęcie do OIT	34	7.0%
DNR	56	11.6%
Błąd pomiaru	24	5.0%
Razem	483	100.0%

Oddziały

Ilość alertów w podziale na oddziały (bez uwzględnienia reocen HOT NEWS).

Pokaż kod

data_alerty %>%
  count(oddzial) %>%
  arrange(n) %>%
  mutate(oddzial = factor(oddzial, levels = oddzial)) %>%
  ggplot(aes(x = oddzial, y = n)) +
  geom_segment(aes(xend = oddzial, y = 0, yend = n), color = "gray70") +
  geom_point(size = 4, color = "orange") +
  coord_flip() +
  theme_bw() +
  labs(
    title = "Liczba alertów SWIT wg oddziału",
    x = NULL,
    y = "Liczba alertów"
  )

Pokaż kod

data_alerty %>%
  count(oddzial) %>%
  arrange(desc(n)) %>%           # opcjonalnie sortowanie
  bind_rows(
    summarise(., 
      oddzial = "Razem",
      n = sum(n)
    )
  ) %>%
  gt() %>% 
  gt::cols_label(
    oddzial = "Oddział",
    n = "Ilość alertów"
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wszystkie nagłówki
      columns = everything()
    )
  )

Oddział	Ilość alertów
Chirurgia Czerwona	123
Chirurgia Biała	43
Interna I0	43
Ortopedia	39
Urologia	33
Diabetologia	30
Nefrologia	28
Neurochirurgia	26
Pulmonologia	25
Geriatria I5	19
Endokrynologia	18
Kardiologia 1 G0	15
Neurologia Udary	10
Kardiologia 2 G1	8
OK Neurologii	6
OK Przeszczepu Szpiku Kostnego	4
OK Chorób Zakaźnych	3
Reumatologia	2
Stacja Dializ	2
OK Angiologii	1
OK Chirurgii Naczyń	1
OK Gastroenterologii i Hepatologii	1
OK Hematologii	1
Sala Nadzoru Pooperacyjnego	1
Toksykologia	1
Razem	483

Ratownik

Ilość wpisanych interwencji w zależności od ratownika.

Pokaż kod

data_cleaned %>% 
  count(ratownik) %>% 
  arrange(ratownik) %>%
  mutate(ratownik = forcats::fct_inorder(ratownik) |> forcats::fct_rev()) %>%
  ggplot(aes(x = n, y = ratownik)) +
  geom_segment(aes(xend = 0, yend = ratownik), color = "gray70") +
  geom_point(size = 4, color = "darkred") +
  theme_bw() +
  labs(
    title = "Ilość wpisanych interwencji",
    x = NULL,
    y = "Ratownik"
  )

Pokaż kod

data_cleaned %>% 
  count(ratownik) %>% 
  gt::gt() %>% 
  gt::cols_label(
    ratownik = "Ratownik",
    n = "Ilość interwencji"
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wybierz etykiety kolumn
      columns = everything()                  # wszystkie kolumny
    )
  )

Ratownik	Ilość interwencji
Andrzej	46
Grzesiek	38
Hubert	69
Jurek	42
Justyna	71
Kuba	48
Maciek	90
Marcin	77
Marek	26
Mateusz	34
Michał	4
Piotrek	94
Sebastian	80
Tomek	19

HOT NEWS

Efekty działań po kwalifikacji chorego do HOT NEWS.

Pokaż kod

hotnews_efekt <- data_cleaned %>%
  filter(hotnews_details %in% c("Poprawa", "OIT", "DNR")) %>%
  count(hotnews_details) %>%
  mutate(
    pct = n/sum(n),
    label = paste0(n, " (", percent(pct, accuracy = 0.1), ")"),
    hotnews_details = fct_relevel(hotnews_details, "Poprawa", "OIT", "DNR")
    )

# Wykres
ggplot(hotnews_efekt, aes(x = hotnews_details, y = n, fill = hotnews_details)) +
  geom_col() +
  geom_text(aes(label = label), vjust = -0.5, size = 4) +
  scale_fill_hue(c = 40) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(
    title = "Efekty działań u chorych HOT NEWS",
    x = NULL,
    y = "Liczba"
  )

Pokaż kod

data_cleaned %>% 
  filter(hotnews_details %in% c("Poprawa", "OIT", "DNR")) %>% 
  count(hotnews_details) %>% 
  gt::gt() %>% 
  gt::cols_label(
    hotnews_details = "Efekt końcowy",
    n = "Ilość"
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wybierz etykiety kolumn
      columns = everything()                  # wszystkie kolumny
    )
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wybierz etykiety kolumn
      columns = everything()                  # wszystkie kolumny
    )
  )

Efekt końcowy	Ilość
DNR	10
OIT	18
Poprawa	44

Wynik NEWS

Boxplot przedstawia medianę (pogrubiona linia), kwartyle Q1 i Q3 (granice boxplot) oraz minimalne i maksymalne wartości w próbie (wąsy). Nałożone punkty pokazują indywidualne wyniki pacjentów.

Pokaż kod

# 1) Przygotuj dane: tylko HOT/ SOFT, bez braków score, ustaw kolejność słupków
df_box <- data_cleaned %>%
  filter(outcome %in% c("HOT NEWS", "SOFT NEWS"),
         !is.na(score)) %>%
  mutate(outcome = fct_relevel(outcome, "HOT NEWS", "SOFT NEWS"))

df_box %>%
  ggplot(aes(x = outcome, y = score, fill = outcome)) +
  geom_boxplot(width = 0.6, outlier.shape = NA) +
  geom_jitter(color = "black", size = 0.6, alpha = 0.9, width = 0.15) +
  geom_hline(yintercept = 7, color = "red", alpha = 0.4, linewidth = 0.6) + # linia na 7
  scale_fill_viridis(discrete = TRUE, alpha = 0.6) +
  scale_y_continuous(
    breaks = c(seq(0, max(df_box$score, na.rm = TRUE), by = 2), 7) |> sort() # <--- dodane 7
  ) +
  theme_ipsum() +
  theme(
    legend.position = "none",
    plot.title = element_text(size = 11)
  ) +
  ggtitle("Rozkład punktacji HOT NEWS vs SOFT NEWS") +
  xlab("") +
  ylab("Score")

Pokaż kod

# policz statystyki opisowe dla HOT NEWS i SOFT NEWS
summary_stats <- data_cleaned %>%
  filter(outcome %in% c("HOT NEWS", "SOFT NEWS")) %>%
  group_by(outcome) %>%
  summarise(
    n       = n(),
    Min     = min(score, na.rm = TRUE),
    Q1      = quantile(score, 0.25, na.rm = TRUE),
    Median  = median(score, na.rm = TRUE),
    Mean    = mean(score, na.rm = TRUE),
    Q3      = quantile(score, 0.75, na.rm = TRUE),
    Max     = max(score, na.rm = TRUE),
    SD      = sd(score, na.rm = TRUE),
    .groups = "drop"
  )

# tabela w gt
summary_stats %>%
  gt() %>%
  cols_label(
    outcome = "Alert",
    n       = "N",
    Min     = "Min",
    Q1      = "Q1",
    Median  = "Median",
    Mean    = "Mean",
    Q3      = "Q3",
    Max     = "Max",
    SD      = "SD"
  ) %>%
  fmt_number(
    columns = c(Min, Q1, Median, Mean, Q3, Max, SD),  # tylko numeryczne
    decimals = 1
  ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_column_labels(columns = everything())
  )

Alert	N	Min	Q1	Median	Mean	Q3	Max	SD
SOFT NEWS	288	0.0	3.0	5.0	4.9	7.0	13.0	2.5
HOT NEWS	81	0.0	5.0	6.0	6.4	8.0	13.0	2.6

Sposób zgłoszenia alertu

Pokaż kod

zgloszenie_cat <- data_cleaned %>%
  filter(zgloszenie %in% c("Obchód", "Telefoniczny", "Lekarz SWIT")) %>%
  count(zgloszenie) %>%
  mutate(
    pct = n/sum(n),
    label = paste0(n, " (", percent(pct, accuracy = 0.1), ")")
    )

# Wykres
ggplot(zgloszenie_cat, aes(x = zgloszenie, y = n, fill = zgloszenie)) +
  geom_col(width = 0.4) +   # <-- domyślnie 0.9, mniejsza wartość = węższe słupki
  geom_text(aes(label = label), vjust = -0.5, size = 4) +
  scale_fill_hue(c = 40) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(
    title = "Sposób zgłoszenia",
    x = NULL,
    y = "Liczba"
  )

Pokaż kod

data_cleaned %>% 
  filter(zgloszenie %in% c("Obchód", "Telefoniczny", "Lekarz SWIT")) %>% 
  count(zgloszenie) %>% 
  mutate(
    pct = scales::percent(n/sum(n), accuracy = 0.1)) %>% 
  gt::gt() %>% 
  gt::cols_label(
    zgloszenie = "Sposób zgłoszenia",
    n = "Ilość",
    pct = "Odsetek"
  ) %>% 
  gt::tab_style(
    style = gt::cell_text(weight = "bold"),   # pogrubienie
    locations = gt::cells_column_labels(      # wybierz etykiety kolumn
      columns = everything()                  # wszystkie kolumny
    )
  )

Sposób zgłoszenia	Ilość	Odsetek
Lekarz SWIT	32	6.6%
Obchód	285	59.0%
Telefoniczny	166	34.4%