Anàlisi de pacients amb dolor toràcic - SAP

EL present exercisi resolt es basa en dades provinents d’una explotació de GIBI de pacients amb dolor toràcic. Estan anonimitzats previament amb R. Poso aqui l’escript per anonimitzar sense que s’executi per no pujar les dades originals. Podem discutir el codi a classe.

#anonimitzacio
library(readxl)
library(dplyr)
library(writexl)

#Llegir l'arxiu Excel original treient les tres files del titol

df <- read_excel("dt_urg_2024.xlsx", skip = 3)

# Neteja de noms de columnes
df <- df %>% janitor::clean_names()
names(df)

# Crear un diccionari intern per conservar les relacions
nhc_unics <- unique(df$nhc)
diccionari_nhc <- data.frame(
  nhc_real = nhc_unics,
  nhc_anonim = paste0("PAC", seq_along(nhc_unics))
)

#Substituir els NHC reals pels anonimitzats
df <- df %>%
  left_join(diccionari_nhc, by = c("nhc" = "nhc_real")) %>%
  mutate(nhc = nhc_anonim) %>%
  select(-nhc_anonim)

#Anonimitzar també els episodis
df <- df %>%
  mutate(episodi = paste0("EP", row_number()))

#Guardar el nou fitxer anonimitzat
writexl::write_xlsx(df, "dt_urg_2024_anonimitzades.xlsx")

L’Objectiu de l’exercisi es a mes de carregar les dades, netejarles i inspeccionarles saber:

  1. Quants pacients van consultar en 2024 per dolor toràcic.

  2. Analitzar quantes reconsultes va haver, el numero maxim de reconsultes i les característiques (edat i sexe) dels reconsultadors. Investigar si hi han diferencies significatives en edat i sexe dels reconsultadors.

  3. Analitzar el temps d’estada a urgències en dies, si hi han diferencies per sexe i edat i el número d’ingressos que es van generar

  4. Analitzar el número d’ingresos que es van generar i determinar els diagnòstics més frequents de tota la població i dels ingressats.

1 1️⃣ Lectura, neteja i avaluació inicial de dades

# Llegir l'Excel
df <- read_excel("dt_urg_2024_anonimitzades.xlsx")

# Neteja de noms de columnes
df <- df %>% janitor::clean_names()
glimpse(df)
Rows: 1,710
Columns: 12
$ nhc                        <chr> "PAC1", "PAC2", "PAC3", "PAC4", "PAC5", "PA…
$ episodi                    <chr> "EP1", "EP2", "EP3", "EP4", "EP5", "EP6", "…
$ sexe                       <chr> "Home", "Dona", "Dona", "Dona", "Home", "Ho…
$ edat                       <dbl> 88, 66, 76, 74, 15, 46, 58, 51, 50, 69, 68,…
$ procedencia                <chr> "DOMICILIO", "DOMICILIO", "DOMICILIO", "DOM…
$ forma_darribar_del_pacient <chr> "TR.CONVENCIONAL", "MEDIOS PROPIOS", "MEDIO…
$ data_entrada               <dttm> 2024-09-01, 2024-03-15, 2024-10-09, 2024-0…
$ data_alta                  <dttm> 2024-09-02, 2024-03-15, 2024-10-09, 2024-0…
$ servei_alta_desc           <chr> "MEDICINA D'URGENCIES", "MEDICINA D'URGENCI…
$ classe_fi_episodi          <chr> "ALTA A DOMICILI", "ALTA A DOMICILI", "ALTA…
$ diagnostic_codi            <chr> "R07.9", "R07.9", "R07.9", "R07.9", "R07.9"…
$ diagnostic_descripcio      <chr> "Dolor toracic no especificat", "Dolor tora…
vis_miss(df)

# Descripció ràpida amb skimr
skim(df)
Data summary
Name df
Number of rows 1710
Number of columns 12
_______________________
Column type frequency:
character 9
numeric 1
POSIXct 2
________________________
Group variables None

Variable type: character

skim_variable n_missing complete_rate min max empty n_unique whitespace
nhc 0 1 4 7 0 1558 0
episodi 0 1 3 6 0 1710 0
sexe 1 1 4 4 0 2 0
procedencia 1 1 9 15 0 12 0
forma_darribar_del_pacient 2 1 11 15 0 4 0
servei_alta_desc 1 1 9 20 0 3 0
classe_fi_episodi 1 1 6 27 0 10 0
diagnostic_codi 1 1 5 6 0 9 0
diagnostic_descripcio 1 1 16 113 0 9 0

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
edat 1 1 58.17 19.53 3 47 61 73 98 ▁▂▆▇▂

Variable type: POSIXct

skim_variable n_missing complete_rate min max median n_unique
data_entrada 1 1 2023-12-31 2024-12-31 2024-06-20 363
data_alta 1 1 2024-01-01 2024-12-31 2024-06-21 361

2 2️⃣ Análisis de la reconsulta per DT

# Comprovar duplicats per NHC i episodis diferents
reconsultes <- df %>%
  group_by(nhc) %>%
  filter(n() > 1) %>% ungroup()


resum_reconsultes <- reconsultes %>%
  summarise(
    total_reconsultes = n(),
    pacients_amb_reconsulta = n_distinct(nhc),
    reconsultes_per_pacient = total_reconsultes / pacients_amb_reconsulta)

resum_reconsultes
# A tibble: 1 × 3
  total_reconsultes pacients_amb_reconsulta reconsultes_per_pacient
              <int>                   <int>                   <dbl>
1               276                     124                    2.23
taula_reconsultes <- reconsultes %>%
  group_by(nhc) %>%
  summarise(num_reconsultes = n()) %>%
  arrange(desc(num_reconsultes)) %>%
  slice(1:7)

taula_reconsultes %>%
  gt() %>%
  tab_header(
    title = "Top 7 Reconsultadors",
    subtitle = "Pacients amb més reconsultes"
  )
Top 7 Reconsultadors
Pacients amb més reconsultes
nhc num_reconsultes
PAC73 8
PAC423 5
PAC1131 4
PAC1141 4
PAC170 4
PAC650 4
PAC142 3 
descripcio_reconsultadors <- reconsultes %>%
  summarise(
    mitjana_edat = mean(edat, na.rm = TRUE),
    mediana_edat = median(edat, na.rm = TRUE),
    min_edat = min(edat, na.rm = TRUE),
    max_edat = max(edat, na.rm = TRUE),
    homes = sum(sexe == "Home", na.rm = TRUE),
    dones = sum(sexe == "Dona", na.rm = TRUE),
    total = n()
  )

descripcio_reconsultadors
# A tibble: 1 × 7
  mitjana_edat mediana_edat min_edat max_edat homes dones total
         <dbl>        <dbl>    <dbl>    <dbl> <int> <int> <int>
1         64.2           67       23       95   152   124   276
# COMPARACIO ENTRE RECONSULTADORS I NO

# primer marquem els pacients com reconsultadors o no

reconsultadors <- reconsultes %>%
  mutate(grup = "Reconsultador")

no_reconsultadors <- df %>%
  filter(!nhc %in% reconsultadors$nhc) %>%
  mutate(grup = "No Reconsultador")

dades_unides <- bind_rows(reconsultadors, no_reconsultadors)


# COMPAREM EDAT

ggplot(dades_unides, aes(x = grup, y = edat, fill = grup)) +
  geom_violin(alpha = 0.5) +
  geom_boxplot(width = 0.1, outlier.shape = NA, alpha = 0.5) +
  theme_minimal() +
  ggtitle("Distribució d'Edat: Reconsultadors vs No Reconsultadors") +
  scale_fill_manual(values = c("Reconsultador" = "lightblue", "No Reconsultador" = "lightgreen"))
Warning: Removed 1 row containing non-finite outside the scale range
(`stat_ydensity()`).
Warning: Removed 1 row containing non-finite outside the scale range
(`stat_boxplot()`).

t.test(edat ~ grup, data = dades_unides)

    Welch Two Sample t-test

data:  edat by grup
t = -6.1343, df = 424.61, p-value = 1.96e-09
alternative hypothesis: true difference in means between group No Reconsultador and group Reconsultador is not equal to 0
95 percent confidence interval:
 -9.435193 -4.856002
sample estimates:
mean in group No Reconsultador    mean in group Reconsultador 
                      57.01745                       64.16304 
# COMPAREM SEXE

ggplot(dades_unides, aes(x = grup, fill = sexe)) +
  geom_bar(position = "dodge") +
  theme_minimal() +
  ggtitle("Distribució per Sexe: Reconsultadors vs No Reconsultadors") +
  scale_fill_manual(values = c("Home" = "lightblue", "Dona" = "lightpink"))

taula_sexe <- table(dades_unides$sexe, dades_unides$grup)
taula_sexe
      
       No Reconsultador Reconsultador
  Dona              562           124
  Home              871           152
chisq.test(taula_sexe)

    Pearson's Chi-squared test with Yates' continuity correction

data:  taula_sexe
X-squared = 2.9062, df = 1, p-value = 0.08824
library(ggplot2)
ggplot(reconsultes, aes(x = sexe, fill = sexe)) +
  geom_bar() +
  ggtitle("Distribució de sexe dels reconsultadors")

ggplot(reconsultes, aes(x = edat)) +
  geom_histogram(bins = 20, fill = "lightblue", color = "black") +
  ggtitle("Distribució d'edats dels reconsultadors")

2.1 conclusions de reconsultes

Podem concloure que van haver 276 recunsultes de 124 pacients sobre un total de 1710 consultes a urgències de 1558 pacients. EL pacient 73 va venir 8 vegades.

No van haver diferencies significatives en el gènere dels reconsultadors, pero si eren una població significativament mes gran.

3 3️⃣ Càlcul de dies d’hospitalització

# Convertir les dates en format Date
df <- df %>%
  mutate(data_entrada = as.Date(data_entrada),
         data_alta = as.Date(data_alta))

# Calcular dies d'hospitalització
df <- df %>%
  mutate(dies_hospitalitzacio = as.numeric(difftime(data_alta, data_entrada, units = "days")))

# Resumir el nombre de dies
df %>%
  summarise(mitjana_dies = mean(dies_hospitalitzacio, na.rm = TRUE),
            mediana_dies = median(dies_hospitalitzacio, na.rm = TRUE),
            max_dies = max(dies_hospitalitzacio, na.rm = TRUE),
            min_dies = min(dies_hospitalitzacio, na.rm = TRUE))
# A tibble: 1 × 4
  mitjana_dies mediana_dies max_dies min_dies
         <dbl>        <dbl>    <dbl>    <dbl>
1        0.320            0        3        0
#test d'hipotesis. Comprovem normalitat

mean(df$dies_hospitalitzacio[df$sexe == "Home"], na.rm=T)
[1] 0.3000978
mean(df$dies_hospitalitzacio[df$sexe == "Dona"], na.rm=T)
[1] 0.3498542
shapiro.test(df$dies_hospitalitzacio[df$sexe == "Home"])

    Shapiro-Wilk normality test

data:  df$dies_hospitalitzacio[df$sexe == "Home"]
W = 0.58241, p-value < 2.2e-16
shapiro.test(df$dies_hospitalitzacio[df$sexe == "Dona"])

    Shapiro-Wilk normality test

data:  df$dies_hospitalitzacio[df$sexe == "Dona"]
W = 0.61766, p-value < 2.2e-16
#no normals
wilcox.test(dies_hospitalitzacio~sexe, data=df)

    Wilcoxon rank sum test with continuity correction

data:  dies_hospitalitzacio by sexe
W = 366852, p-value = 0.04762
alternative hypothesis: true location shift is not equal to 0
ggplot(df, aes(x = sexe, y = dies_hospitalitzacio, fill = sexe)) +
  geom_violin(trim = FALSE, alpha = 0.5) +
  geom_boxplot(width = 0.1, outlier.shape = NA, alpha = 0.7) +
  theme_minimal() +
  ggtitle("Dies d'Ingressió per Sexe") +
  ylab("Dies Ingressat") +
  scale_fill_manual(values = c("Home" = "lightblue", "Dona" = "lightpink"))
Warning: Removed 1 row containing non-finite outside the scale range
(`stat_ydensity()`).
Warning: Removed 1 row containing non-finite outside the scale range
(`stat_boxplot()`).

df <- df %>%
  mutate(grup_edat = cut(edat, 
                         breaks = seq(0, 100, by = 10), 
                         labels = c("0-10", "10-20", "20-30", "30-40", 
                                    "40-50", "50-60", "60-70", "70-80", "80-90", "90-100"),
                         include.lowest = TRUE))


ggplot(df, aes(x = grup_edat, y = dies_hospitalitzacio, fill = grup_edat)) +
  geom_boxplot() +
  theme_minimal() +
  ggtitle("Dies d'Ingressió per Grup d'Edat") +
  ylab("Dies Ingressat") +
  xlab("Grup d'Edat") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
Warning: Removed 1 row containing non-finite outside the scale range
(`stat_boxplot()`).

anova_result <- aov(dies_hospitalitzacio ~ grup_edat, data = df)
summary(anova_result)
              Df Sum Sq Mean Sq F value   Pr(>F)    
grup_edat      9    6.4  0.7102   3.162 0.000855 ***
Residuals   1699  381.5  0.2246                     
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
1 observation deleted due to missingness
TukeyHSD(anova_result)
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = dies_hospitalitzacio ~ grup_edat, data = df)

$grup_edat
                     diff           lwr        upr     p adj
10-20-0-10    0.186507937 -0.1735939355 0.54660981 0.8279197
20-30-0-10    0.169298246 -0.1736650988 0.51226159 0.8653872
30-40-0-10    0.210784314 -0.1251315898 0.54670022 0.6077840
40-50-0-10    0.212025316 -0.1095495575 0.53360019 0.5357547
50-60-0-10    0.251082251 -0.0670661252 0.56923063 0.2689369
60-70-0-10    0.190409683 -0.1261285655 0.50694793 0.6652954
70-80-0-10    0.293663472 -0.0243011559 0.61162810 0.0992516
80-90-0-10    0.304824561 -0.0249146291 0.63456375 0.0985271
90-100-0-10   0.441666667  0.0540557333 0.82927760 0.0116958
20-30-10-20  -0.017209691 -0.2611244694 0.22670509 1.0000000
30-40-10-20   0.024276377 -0.2096254351 0.25817819 0.9999992
40-50-10-20   0.025517380 -0.1872758604 0.23831062 0.9999973
50-60-10-20   0.064574315 -0.1430044726 0.27215310 0.9930787
60-70-10-20   0.003901747 -0.2012007314 0.20900423 1.0000000
70-80-10-20   0.107155535 -0.1001415173 0.31445259 0.8295842
80-90-10-20   0.118316625 -0.1066244725 0.34325772 0.8143778
90-100-10-20  0.255158730 -0.0483421747 0.55865964 0.1896329
30-40-20-30   0.041486068 -0.1650582497 0.24803039 0.9997798
40-50-20-30   0.042727071 -0.1395679113 0.22502205 0.9992230
50-60-20-30   0.081784005 -0.0943961588 0.25796417 0.9036813
60-70-20-30   0.021111438 -0.1521442230 0.19436710 0.9999969
70-80-20-30   0.124365226 -0.0514829055 0.30021336 0.4292517
80-90-20-30   0.135526316 -0.0608126632 0.33186529 0.4663461
90-100-20-30  0.272368421 -0.0105861630 0.55532301 0.0706620
40-50-30-40   0.001241003 -0.1674216760 0.16990368 1.0000000
50-60-30-40   0.040297937 -0.1217362841 0.20233216 0.9987528
60-70-30-40  -0.020374630 -0.1792241272 0.13847487 0.9999952
70-80-30-40   0.082879158 -0.0787939816 0.24455230 0.8365250
80-90-30-40   0.094040248 -0.0897113057 0.27779180 0.8378911
90-100-30-40  0.230882353 -0.0434877171 0.50525242 0.1885700
50-60-40-50   0.039056935 -0.0906581156 0.16877198 0.9945638
60-70-40-50  -0.021615633 -0.1473298645 0.10409860 0.9999402
70-80-40-50   0.081638155 -0.0476255650 0.21090188 0.5986219
80-90-40-50   0.092799245 -0.0631992764 0.24879777 0.6797164
90-100-40-50  0.229641350 -0.0269708877 0.48625359 0.1256312
60-70-50-60  -0.060672568 -0.1773432912 0.05599816 0.8244402
70-80-50-60   0.042581221 -0.0779057045 0.16306815 0.9827858
80-90-50-60   0.053742310 -0.0950647070 0.20254933 0.9800196
90-100-50-60  0.190584416 -0.0617206188 0.44288945 0.3305579
70-80-60-70   0.103253788 -0.0129149376 0.21942251 0.1318528
80-90-60-70   0.114414878 -0.0309178512 0.25974761 0.2722690
90-100-60-70  0.251256983  0.0009853226 0.50152864 0.0481589
80-90-70-80   0.011161090 -0.1372526684 0.15957485 1.0000000
90-100-70-80  0.148003195 -0.1040700991 0.40007649 0.6962066
90-100-80-90  0.136842105 -0.1299300350 0.40361425 0.8360104

3.1 conclusions

La mitjana de dies a urgències va ser 0.32, sent el maxim 3 i el minim 0. Les dones van estar significativament més temps a urgències que els homes pero podria ser a expenses de outliers que arroseguin la mitjana. El grup de 90 a 100 anys va estar signifcativament mes tems a urgències que el de 60 a 70. No es van detectar altres diferències significatives.

4 4️⃣ Anàlisi del nombre d’ingressats i diagnòstics

# Nombre total d'ingressats
n_ingressats <- df %>% filter(classe_fi_episodi == "INGRES A L'HOSPITAL") %>% count()

n_ingressats %>%
  gt() %>%
  tab_header(
    title = "Nombre Total d'Ingressats",
    subtitle = "Pacients ingressats l'any 2024"
  )
Nombre Total d'Ingressats
Pacients ingressats l'any 2024
n
358 
# Diàgnostics més comuns
diagnostics <- df %>%
  count(diagnostic_descripcio) %>%
  arrange(desc(n)) %>%
  mutate(percentatge = n / sum(n) * 100) %>%
  head(10)

diagnostics %>%
  gt() %>%
  tab_header(
    title = "Top 10 Diagnòstics",
    subtitle = "Distribució dels diagnòstics més comuns"
  )
Top 10 Diagnòstics
Distribució dels diagnòstics més comuns
diagnostic_descripcio n percentatge
Dolor toracic no especificat 1332 77.89473684
Infart agut de miocardi no especificat 134 7.83625731
Infart de miocardi sense elevacio del segment ST (IMSEST) 72 4.21052632
Angina de pit no especificada 54 3.15789474
Angina inestable 45 2.63157895
Altres formes d'angina de pit 44 2.57309942
Infart de miocardi amb elevacio del segment ST (IMEST) que afecta altres arteries coronaries de la paret inferior 24 1.40350877
Infart de miocardi amb elevacio del segment ST (IMEST) de localitzacio no especificada 3 0.17543860
Angina de pit amb espasme documentat 1 0.05847953
NA 1 0.05847953 
library(stringr)
ggplot(diagnostics, aes(x = reorder(str_wrap(diagnostic_descripcio, width = 30), n), y = n, fill = diagnostic_descripcio)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  theme_minimal() +
  ggtitle("Top 10 Diagnòstics Més Comuns") +
  xlab("Diagnòstic") +
  ylab("Nombre de pacients") +
  theme(legend.position = "none")

### DIAGNOSTICS dels ingressats.

diagnostics_ingressats <- df %>%
  filter(classe_fi_episodi == "INGRES A L'HOSPITAL") %>%
  count(diagnostic_descripcio) %>%
  arrange(desc(n)) %>%
  mutate(percentatge = n / sum(n) * 100) %>%
  head(10)

diagnostics_ingressats %>% gt() %>%
  tab_header(
    title = "Top 10 Diagnòstics dels pacients que ingressen",
    subtitle = "Distribució dels diagnòstics més comuns"
  )
Top 10 Diagnòstics dels pacients que ingressen
Distribució dels diagnòstics més comuns
diagnostic_descripcio n percentatge
Infart agut de miocardi no especificat 125 34.9162011
Dolor toracic no especificat 79 22.0670391
Infart de miocardi sense elevacio del segment ST (IMSEST) 65 18.1564246
Angina inestable 33 9.2178771
Infart de miocardi amb elevacio del segment ST (IMEST) que afecta altres arteries coronaries de la paret inferior 20 5.5865922
Angina de pit no especificada 19 5.3072626
Altres formes d'angina de pit 15 4.1899441
Angina de pit amb espasme documentat 1 0.2793296
Infart de miocardi amb elevacio del segment ST (IMEST) de localitzacio no especificada 1 0.2793296 
ggplot(diagnostics_ingressats, aes(x = reorder(str_wrap(diagnostic_descripcio, 30), n), y = n, fill = diagnostic_descripcio)) +
  geom_bar(stat = "identity", width = 0.7) +
  coord_flip() +
  theme_minimal() +
  ggtitle("Top 10 Diagnòstics en Pacients Ingressats") +
  xlab("Diagnòstic") +
  ylab("Nombre de pacients") +
  theme(legend.position = "none")

4.1 conclusions

Es váren causar 358 ingresos sobre 1710 consultes (21 %). El 77% de les consultes van tenir com a diagnòstic “dolor toracic no especificat”. En els pacients ingressats la totalitat va tenir un diagnòstic “cardiologic”.