La inasistencia a citas médicas genera pérdidas de recursos hospitalarios, incrementa los tiempos de espera y afecta la eficiencia institucional. Comprender los factores asociados a la asistencia permite optimizar la gestión de los recursos sanitarios.
¿Qué factores influyen en la inasistencia a las citas médicas y cómo afectan la eficiencia en la utilización de los recursos hospitalarios?
library(ggplot2)
library(dplyr)
library(readr)
library(caret)
library(pROC)
appointments <- read_csv("C:/Users/MIBCo/Downloads/appointments.csv")
## Rows: 111488 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): appointment_id, slot_id, status, patient_id, sex, age_group
## dbl (4): scheduling_interval, appointment_duration, waiting_time, age
## date (2): scheduling_date, appointment_date
## time (4): appointment_time, check_in_time, start_time, end_time
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(appointments)
## # A tibble: 6 × 16
## appointment_id slot_id scheduling_date appointment_date appointment_time
## <chr> <chr> <date> <date> <time>
## 1 0000138 0000001 2014-12-28 2015-01-01 08:00
## 2 0000146 0000023 2014-12-29 2015-01-01 13:30
## 3 0000021 0000024 2014-12-17 2015-01-01 13:45
## 4 0000233 0000025 2014-12-31 2015-01-01 14:00
## 5 0000090 0000026 2014-12-26 2015-01-01 14:15
## 6 0000180 0000027 2014-12-30 2015-01-01 14:30
## # ℹ 11 more variables: scheduling_interval <dbl>, status <chr>,
## # check_in_time <time>, appointment_duration <dbl>, start_time <time>,
## # end_time <time>, waiting_time <dbl>, patient_id <chr>, sex <chr>,
## # age <dbl>, age_group <chr>
#Exploración de datos
str(appointments)
## spc_tbl_ [111,488 × 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ appointment_id : chr [1:111488] "0000138" "0000146" "0000021" "0000233" ...
## $ slot_id : chr [1:111488] "0000001" "0000023" "0000024" "0000025" ...
## $ scheduling_date : Date[1:111488], format: "2014-12-28" "2014-12-29" ...
## $ appointment_date : Date[1:111488], format: "2015-01-01" "2015-01-01" ...
## $ appointment_time : 'hms' num [1:111488] 08:00:00 13:30:00 13:45:00 14:00:00 ...
## ..- attr(*, "units")= chr "secs"
## $ scheduling_interval : num [1:111488] 4 3 15 1 6 2 2 2 4 4 ...
## $ status : chr [1:111488] "did not attend" "did not attend" "attended" "attended" ...
## $ check_in_time : 'hms' num [1:111488] NA NA 13:36:45 13:59:32 ...
## ..- attr(*, "units")= chr "secs"
## $ appointment_duration: num [1:111488] NA NA 5.2 28.9 NA 7.7 4.2 27.1 NA 1.2 ...
## $ start_time : 'hms' num [1:111488] NA NA 13:37:57 14:00:40 ...
## ..- attr(*, "units")= chr "secs"
## $ end_time : 'hms' num [1:111488] NA NA 13:43:09 14:29:34 ...
## ..- attr(*, "units")= chr "secs"
## $ waiting_time : num [1:111488] NA NA 1.2 1.1 NA 21.7 16.2 1 NA 8.5 ...
## $ patient_id : chr [1:111488] "08285" "05972" "06472" "05376" ...
## $ sex : chr [1:111488] "Male" "Male" "Male" "Female" ...
## $ age : num [1:111488] 37 84 77 37 72 51 28 33 29 90 ...
## $ age_group : chr [1:111488] "35-39" "80-84" "75-79" "35-39" ...
## - attr(*, "spec")=
## .. cols(
## .. appointment_id = col_character(),
## .. slot_id = col_character(),
## .. scheduling_date = col_date(format = ""),
## .. appointment_date = col_date(format = ""),
## .. appointment_time = col_time(format = ""),
## .. scheduling_interval = col_double(),
## .. status = col_character(),
## .. check_in_time = col_time(format = ""),
## .. appointment_duration = col_double(),
## .. start_time = col_time(format = ""),
## .. end_time = col_time(format = ""),
## .. waiting_time = col_double(),
## .. patient_id = col_character(),
## .. sex = col_character(),
## .. age = col_double(),
## .. age_group = col_character()
## .. )
## - attr(*, "problems")=<pointer: 0x00000205c91ee350>
# summary(appointments)
colSums(is.na(appointments))
## appointment_id slot_id scheduling_date
## 0 0 0
## appointment_date appointment_time scheduling_interval
## 0 0 0
## status check_in_time appointment_duration
## 0 25456 25456
## start_time end_time waiting_time
## 25456 25456 25456
## patient_id sex age
## 0 0 0
## age_group
## 0
#Estadísticas descriptivas
summary(appointments$age)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 15.00 40.00 59.00 57.21 74.00 100.00
table(appointments$sex)
##
## Female Male
## 66086 45402
table(appointments$status)
##
## attended cancelled did not attend scheduled unknown
## 86032 18254 6615 141 446
#Histograma de edades
ggplot(appointments, aes(x=age)) +
geom_histogram(fill="lightblue", bins=20)
Interpretación: El histograma muestra la distribución de edades de los pacientes incluidos en la base de datos. Se observa que la mayor concentración de pacientes se encuentra entre los 50 y 85 años, con un pico aproximado entre los 65 y 75 años. Esto indica que la población atendida está compuesta principalmente por adultos y adultos mayores, quienes presentan una mayor demanda de servicios de salud.
#Distribución por sexo
ggplot(appointments, aes(x=sex)) +
geom_bar(fill="lightgreen")
Interpretación: La distribución de pacientes por sexo muestra un predominio de mujeres sobre hombres en la población estudiada. Aproximadamente el 60 % de los registros corresponden al sexo femenino, mientras que el 40 % restante corresponde al sexo masculino. Esto sugiere una mayor utilización de los servicios de salud por parte de las mujeres durante el periodo analizado.
appointments <- appointments %>%
mutate(no_show = ifelse(status == "did not attend", 1, 0))
table(appointments$no_show)
##
## 0 1
## 104873 6615
#Construir el modelo logístico
Se construyó un modelo de regresión logística con el objetivo de identificar los factores asociados a la inasistencia de los pacientes a las citas médicas. Para ello se incluyeron las variables edad, sexo y tiempo de espera.
modelo <- glm(
no_show ~ age + sex + waiting_time,
data=appointments,
family=binomial
)
## Warning: glm.fit: algorithm did not converge
summary(modelo)
##
## Call:
## glm(formula = no_show ~ age + sex + waiting_time, family = binomial,
## data = appointments)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.657e+01 3.909e+03 -0.007 0.995
## age 5.935e-15 6.109e+01 0.000 1.000
## sexMale 3.265e-13 2.507e+03 0.000 1.000
## waiting_time -3.827e-15 2.977e+01 0.000 1.000
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 0.0000e+00 on 86031 degrees of freedom
## Residual deviance: 4.9912e-07 on 86028 degrees of freedom
## (25456 observations deleted due to missingness)
## AIC: 8
##
## Number of Fisher Scoring iterations: 25
El modelo permite evaluar la relación entre edad, sexo y tiempo de espera con la probabilidad de inasistencia a las citas médicas.
Con el fin de evaluar la capacidad predictiva del modelo, se dividió la base de datos en un conjunto de entrenamiento (70%) y un conjunto de prueba (30%). Posteriormente se ajustó un modelo de regresión logística y se evaluó mediante matriz de confusión, curva ROC y área bajo la curva (AUC).
#Dividir los datos
set.seed(123)
indice <- createDataPartition(
appointments$no_show,
p = 0.7,
list = FALSE
)
train_data <- appointments[indice, ]
test_data <- appointments[-indice, ]
#Entrenar el modelo
modelo_train <- glm(
no_show ~ age + sex,
data = train_data,
family = binomial
)
summary(modelo_train)
##
## Call:
## glm(formula = no_show ~ age + sex, family = binomial, data = train_data)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.763e+00 4.565e-02 -60.521 <2e-16 ***
## age 2.738e-05 7.569e-04 0.036 0.971
## sexMale 4.240e-02 3.091e-02 1.372 0.170
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 35615 on 78041 degrees of freedom
## Residual deviance: 35614 on 78039 degrees of freedom
## AIC: 35620
##
## Number of Fisher Scoring iterations: 5
}
#Generar predicciones
pred <- predict(
modelo_train,
newdata=test_data,
type="response"
)
pred_clase <- ifelse(pred > 0.5,1,0)
#Matriz de confusión
confusionMatrix(
factor(pred_clase),
factor(test_data$no_show)
)
## Warning in confusionMatrix.default(factor(pred_clase),
## factor(test_data$no_show)): Levels are not in the same order for reference and
## data. Refactoring data to match.
## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 31548 1898
## 1 0 0
##
## Accuracy : 0.9433
## 95% CI : (0.9407, 0.9457)
## No Information Rate : 0.9433
## P-Value [Acc > NIR] : 0.5061
##
## Kappa : 0
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9433
## Neg Pred Value : NaN
## Prevalence : 0.9433
## Detection Rate : 0.9433
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : 0
##
library(pROC)
roc_obj <- roc(
test_data$no_show,
pred
)
## Setting levels: control = 0, case = 1
## Setting direction: controls > cases
plot(roc_obj)
auc(roc_obj)
## Area under the curve: 0.5057
Interpretación: La curva ROC se aproxima a la línea diagonal, indicando una capacidad limitada para diferenciar entre pacientes que asistieron y aquellos que no asistieron a la cita médica. El área bajo la curva (AUC = 0.5057) muestra un desempeño predictivo muy bajo, similar al obtenido mediante una clasificación aleatoria. Esto sugiere que las variables incluidas en el modelo no son suficientes para explicar adecuadamente la inasistencia a las citas médicas.
tasa_inasistencia <- mean(appointments$no_show)
tasa_inasistencia
## [1] 0.05933374
appointments %>%
group_by(sex) %>%
summarise(
tasa_inasistencia = mean(no_show)
)
## # A tibble: 2 × 2
## sex tasa_inasistencia
## <chr> <dbl>
## 1 Female 0.0590
## 2 Male 0.0598
ggplot(appointments,
aes(x=age,y=no_show)) +
geom_jitter(alpha=0.3) +
geom_smooth(
method="glm",
method.args=list(family="binomial")
)
## `geom_smooth()` using formula = 'y ~ x'
Interpretación: La dispersión de los datos y la línea de tendencia prácticamente horizontal indican que la edad no presenta una relación significativa con la inasistencia a las citas médicas. Los pacientes de diferentes grupos etarios muestran comportamientos similares respecto a la asistencia, lo que sugiere que otros factores distintos a la edad podrían tener una mayor influencia sobre el ausentismo.
#Gráfico de variabilidad
ggplot(
appointments,
aes(x=sex,y=no_show,fill=sex)
) +
geom_boxplot()
Interpretación: La gráfica evidencia que tanto hombres como mujeres presentan una proporción similar de asistencia e inasistencia a las citas médicas. No se observan diferencias marcadas entre los grupos, lo que sugiere que el sexo no constituye un factor relevante para explicar la inasistencia en la población analizada.
La matriz de confusión permitió evaluar la capacidad predictiva del modelo. El indicador Accuracy muestra el porcentaje de clasificaciones correctas. La curva ROC y el valor AUC permiten evaluar la capacidad de discriminación del modelo.
El análisis permitió identificar factores asociados a la asistencia a citas médicas. La validación realizada mostró la capacidad predictiva del modelo logístico. Se recomienda incorporar nuevas variables para mejorar el desempeño del modelo y fortalecer la gestión de los recursos hospitalarios. En el presente análisis se desarrollaron dos modelos de regresión logística. El primero tuvo un enfoque explicativo para identificar factores asociados a la inasistencia a citas médicas, mientras que el segundo tuvo un enfoque predictivo mediante partición de datos y validación con curva ROC y AUC. Los resultados evidenciaron una capacidad predictiva limitada (AUC = 0.5057), lo que sugiere la necesidad de incorporar variables adicionales para mejorar el desempeño del modelo.