Marco Estratégico del Proyecto

Contexto del Problema

La institución de salud administra un registro histórico de 1,000 citas médicas ejecutadas entre el 1 de enero de 2020 y el 31 de diciembre de 2023. La falta de visibilidad analítica sobre la dinámica temporal de la demanda, el nivel de recurrencia de los usuarios y la atomización de la oferta médica dificulta la optimización de turnos, genera ineficiencias en el uso de la capacidad instalada y fragmenta la continuidad en la atención del paciente.

Audiencia Objetivo: Este informe está dirigido a la Gerencia General, la Dirección Operativa de Servicios de Salud y la Jefatura de Planeación Sanitaria, entregando evidencia cuantitativa para respaldar decisiones de contratación médica, gestión de agendas y fidelización de usuarios.

Objetivo Analítico: * 1. Mapear la demanda temporal a nivel interanual, mensual, trimestral y por día de la semana. * 2. Evaluar la concentración de carga médica y la eficiencia en la asignación del talento humano. * Diagnosticar el grado de reatención y la continuidad asistencial entre la pareja médico-paciente. * 3. Suministrar un cuadro de mando reproducible en R Markdown con gráficos interactivos y en 3D.

Carga de Librerías y Preparación del Entorno

# Carga de paquetes para procesamiento de datos, tablas ejecutivas y gráficos 2D/3D
library(readxl)
library(dplyr)
library(tidyr)
library(lubridate)
library(ggplot2)
library(plotly)
library(knitr)
library(kableExtra)
library(viridis)

Exploración Inicial y Diagnóstico de Calidad de Datos

Se audita la integridad del archivo Appointment . Proyecto.xlsx (Hoja: Appointment (1)), el cual consta de 1,000 observaciones y 5 columnas (AppointmentID, Date, Time, PatientID, DoctorID).

# Carga de la base de datos
ruta_base <- "Appointment . Proyecto.xlsx"
df_citas <- read_excel(ruta_base, sheet = "Appointment (1)")

# Inspección de estructura
glimpse(df_citas)
## Rows: 1,000
## Columns: 5
## $ AppointmentID <dbl> 639, 404, 281, 628, 889, 551, 769, 385, 813, 986, 943, 9…
## $ Date          <dttm> 2022-04-08, 2023-04-10, 2022-12-09, 2020-01-08, 2023-08…
## $ Time          <chr> "2023-12-23T14:33:46.406Z", "2023-12-23T14:33:46.407Z", …
## $ PatientID     <dbl> 109, 823, 465, 443, 852, 160, 886, 480, 634, 898, 116, 2…
## $ DoctorID      <dbl> 462, 774, 226, 656, 262, 748, 580, 438, 662, 653, 889, 4…
# Diagnóstico de nulos y tipos de variable
resumen_calidad <- data.frame(
  Variable = names(df_citas),
  Tipo_Dato = sapply(df_citas, function(x) paste(class(x), collapse = "/")),
  Valores_Nulos = colSums(is.na(df_citas)),
  Valores_Unicos = sapply(df_citas, function(x) n_distinct(x)),
  stringsAsFactors = FALSE
)

resumen_calidad %>%
  kbl(caption = "Tabla 1: Auditoría de Calidad e Integridad del Dataset") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = FALSE)
Tabla 1: Auditoría de Calidad e Integridad del Dataset
Variable Tipo_Dato Valores_Nulos Valores_Unicos
AppointmentID AppointmentID numeric 0 602
Date Date POSIXct/POSIXt 0 721
Time Time character 0 12
PatientID PatientID numeric 0 610
DoctorID DoctorID numeric 0 611

Análisis de Calidad de Datos:
El dataset no presenta registros faltantes (0% nulos en 1,000 observaciones). El periodo abarca 1,461 días calendario, con atenciones registradas en 721 días únicos (49.3% de tasa de actividad diaria en el sistema) y un promedio general de 1.39 citas por día con servicio.

Procesamiento e Ingeniería de Variables

Se estructuran dimensiones temporales continuas y categóricas para habilitar la construcción de mapas de calor, series cronológicas y ejes tridimensionales.

df_procesado <- df_citas %>%
  mutate(
    Fecha = as.Date(Date),
    Año = year(Fecha),
    Mes_Num = month(Fecha),
    Mes_Nombre = factor(month(Fecha, label = TRUE, abbr = FALSE), 
                        levels = c("enero", "febrero", "marzo", "abril", "mayo", "junio", 
                                   "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")),
    DiaSemana = factor(wday(Fecha, label = TRUE, abbr = FALSE, week_start = 1),
                       levels = c("lunes", "martes", "miércoles", "jueves", "viernes", "sábado", "domingo")),
    Año_Trimestre = paste0(Año, "-Q", quarter(Fecha)),
    Trimestre = paste0("Q", quarter(Fecha))
  )

# Resumen de variables procesadas
summary(df_procesado %>% select(Año, Mes_Num, Trimestre, DiaSemana))
##       Año          Mes_Num          Trimestre        DiaSemana  
##  Min.   :2020   Min.   : 1.00   Length   :1000   lunes    :146  
##  1st Qu.:2020   1st Qu.: 3.00   N.unique :   4   martes   :146  
##  Median :2021   Median : 6.00   N.blank  :   0   miércoles:145  
##  Mean   :2021   Mean   : 6.43   Min.nchar:   2   jueves   :137  
##  3rd Qu.:2023   3rd Qu.: 9.00   Max.nchar:   2   viernes  :157  
##  Max.   :2023   Max.   :12.00                    sábado   :134  
##                                                  domingo  :135

Dashboard de Indicadores Clave (KPIs)

kpi_df <- data.frame(
  Métrica = c("Total Citas Registradas", 
              "Pacientes Únicos Atendidos", 
              "Médicos Únicos Registrados", 
              "Promedio Citas / Paciente", 
              "Promedio Citas / Médico",
              "Rango de Fechas Evaluado"),
  Valor = c(nrow(df_procesado),
            n_distinct(df_procesado$PatientID),
            n_distinct(df_procesado$DoctorID),
            round(nrow(df_procesado) / n_distinct(df_procesado$PatientID), 2),
            round(nrow(df_procesado) / n_distinct(df_procesado$DoctorID), 2),
            paste(min(df_procesado$Fecha), "al", max(df_procesado$Fecha)))
)

kpi_df %>%
  kbl(caption = "Tabla 2: Cuadro de Mando de Indicadores Ejecutivos") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "bordered"), full_width = FALSE)
Tabla 2: Cuadro de Mando de Indicadores Ejecutivos
Métrica Valor
Total Citas Registradas 1000
Pacientes Únicos Atendidos 610
Médicos Únicos Registrados 611
Promedio Citas / Paciente 1.64
Promedio Citas / Médico 1.64
Rango de Fechas Evaluado 2020-01-01 al 2023-12-31

Explicación del Cuadro de Mando:
Se identifican 610 pacientes únicos y 611 médicos únicos. El promedio de 1.64 citas por médico y 1.64 citas por paciente anticipa un sistema con dispersión en la oferta y una tasa de reatención moderada de usuarios.

Análisis Secuencial y Accionabilidad

Módulo 1: Análisis de Tendencia Temporal y Demanda

Gráfico 1: Evolución del Volumen Anual de Citas (2020 - 2023)

citas_año <- df_procesado %>%
  count(Año) %>%
  mutate(Porcentaje = round(n / sum(n) * 100, 1))

ggplot(citas_año, aes(x = factor(Año), y = n, fill = factor(Año))) +
  geom_col(width = 0.55, show.legend = FALSE) +
  geom_text(aes(label = paste0(n, " (", Porcentaje, "%)")), vjust = -0.4, fontface = "bold", size = 4) +
  scale_fill_brewer(palette = "Blues") +
  scale_y_continuous(limits = c(0, 300)) +
  labs(title = "Gráfico 1: Evolución del Volumen Anual de Citas",
       x = "Año Evaluado", y = "Total de Citas") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Análisis: Demuestra una demanda interanual completamente estable con 261 citas en 2020 (26.1%), 247 en 2021 (24.7%), 239 en 2022 (23.9%) y 253 en 2023 (25.3%). El promedio es de 250.0 citas/año con un Coeficiente de Variación (\(CV\)) de apenas 3.72%.

Gráfico 2: Ciclo Mensual Acumulado de la Demanda

citas_mes <- df_procesado %>%
  count(Mes_Nombre, Mes_Num) %>%
  arrange(Mes_Num)

ggplot(citas_mes, aes(x = reorder(Mes_Nombre, Mes_Num), y = n, group = 1)) +
  geom_line(color = "#1F77B4", size = 1.2) +
  geom_point(color = "#D62728", size = 3.5) +
  geom_text(aes(label = n), vjust = -0.8, size = 3.5, fontface = "bold") +
  scale_y_continuous(limits = c(60, 110)) +
  labs(title = "Gráfico 2: Agregación Mensual Acumulada de la Demanda",
       x = "Mes del Año", y = "Total de Citas") +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", hjust = 0.5))

Análisis: Identifica a Enero (97 citas) y Abril (96 citas) como los picos de mayor demanda acumulada, frente a valles moderados en Marzo y Mayo (77 citas c/u). La media mensual es de 83.3 citas (\(CV = 8.41\%\)).

Gráfico 3: Serie Cronológica Trimestral (2020-Q1 a 2023-Q4)

citas_trim <- df_procesado %>%
  count(Año_Trimestre)

ggplot(citas_trim, aes(x = Año_Trimestre, y = n, group = 1)) +
  geom_area(fill = "#5DADE2", alpha = 0.4) +
  geom_line(color = "#1B4F72", size = 1) +
  geom_point(color = "#1B4F72", size = 2.5) +
  geom_text(aes(label = n), vjust = -0.6, size = 3, fontface = "bold") +
  scale_y_continuous(limits = c(40, 85)) +
  labs(title = "Gráfico 3: Trayectoria Cronológica Trimestral (2020 - 2023)",
       x = "Trimestre (Año - Q)", y = "Cantidad de Citas") +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 60, hjust = 1),
        plot.title = element_text(face = "bold", hjust = 0.5))

Análisis: Muestra la continuidad operativa a lo largo de 16 trimestres, con una media de 62.5 citas/trimestre (\(CV = 9.26\%\)), un máximo en 2020-Q1 (73 citas) y un mínimo en 2022-Q3 (51 citas). —

Gráfico 4: Distribución por Día de la Semana

citas_dia <- df_procesado %>%
  count(DiaSemana)

ggplot(citas_dia, aes(x = DiaSemana, y = n, fill = DiaSemana)) +
  geom_col(show.legend = FALSE, width = 0.6) +
  geom_text(aes(label = paste0(n, " (", round(n/10, 1), "%)")), vjust = -0.4, fontface = "bold") +
  scale_fill_viridis_d(option = "mako") +
  scale_y_continuous(limits = c(0, 180)) +
  labs(title = "Gráfico 4: Distribución Semanal de la Demanda",
       x = "Día de la Semana", y = "Total de Citas") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Análisis:
* ¿Qué evidencia el gráfico?: Muestra que el Viernes es el día con mayor demanda (157 citas / 15.7%), mientras que el fin de semana (Sábado + Domingo) absorbe 269 citas (26.9% del total), operando con baja variabilidad diaria (\(CV = 5.71\%\)).

Gráfico 5: Mapa de Calor (Heatmap) Interactivo: Mes vs. Día

matriz_mes_dia <- df_procesado %>%
  group_by(Mes_Nombre, Mes_Num, DiaSemana) %>%
  summarise(Citas = n(), .groups = 'drop')

p_heat_mes_dia <- ggplot(matriz_mes_dia, aes(x = reorder(Mes_Nombre, Mes_Num), y = DiaSemana, fill = Citas)) +
  geom_tile(color = "white", size = 0.5) +
  scale_fill_viridis_c(option = "magma") +
  labs(title = "Gráfico 5: Mapa de Calor - Mes del Año vs. Día de la Semana",
       x = "Mes del Año", y = "Día de la Semana", fill = "Citas") +
  theme_minimal(base_size = 11) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        plot.title = element_text(face = "bold", hjust = 0.5))

ggplotly(p_heat_mes_dia)

Análisis: Ubica las mayores concentraciones de citas en celdas específicas, resaltando los Viernes de Enero (19 citas) y los Martes de Abril (18 citas).
—

Módulo 2: Capacidad y Estructura del Cuerpo Médico

Gráfico 6: Distribución de la Carga de Trabajo por Médico

carga_medicos <- df_procesado %>%
  count(DoctorID, name = "Atenciones") %>%
  count(Atenciones, name = "Num_Medicos") %>%
  mutate(Porcentaje = round(Num_Medicos / sum(Num_Medicos) * 100, 1))

ggplot(carga_medicos, aes(x = factor(Atenciones), y = Num_Medicos, fill = factor(Atenciones))) +
  geom_col(show.legend = FALSE, width = 0.55) +
  geom_text(aes(label = paste0(Num_Medicos, " (", Porcentaje, "%)")), vjust = -0.4, fontface = "bold") +
  scale_fill_brewer(palette = "Oranges") +
  scale_y_continuous(limits = c(0, 380)) +
  labs(title = "Gráfico 6: Frecuencia de Atenciones por Médico",
       x = "Cantidad de Citas Atendidas en 4 Años", y = "Número de Médicos") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Análisis: * ¿Qué evidencia el gráfico?: Revela que 342 médicos (56.0%) atendieron solo 1 cita en 4 años y 180 médicos (29.5%) atendieron 2 citas. Solo el 14.6% atendió 3 o más consultas (\(HHI = 0.002086\)).

Gráfico 7: Top 10 Médicos con Mayor Volumen de Atenciones

top10_medicos <- df_procesado %>%
  count(DoctorID, name = "Total_Citas") %>%
  arrange(desc(Total_Citas)) %>%
  head(10)

ggplot(top10_medicos, aes(x = reorder(paste("Médico", DoctorID), Total_Citas), y = Total_Citas)) +
  geom_col(fill = "#2E86C1", width = 0.6) +
  geom_text(aes(label = Total_Citas), hjust = -0.3, fontface = "bold") +
  coord_flip() +
  scale_y_continuous(limits = c(0, 6.5)) +
  labs(title = "Gráfico 7: Top 10 Médicos con Mayor Carga Registrada",
       x = "ID del Médico", y = "Total Citas Atendidas") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Análisis:
* ¿Qué evidencia el gráfico?: Muestra que los médicos más activos (IDs 170, 254 y 637) alcanzaron un máximo de apenas 5 citas atendidas en un periodo de 4 años. * Acciones: Rediseñar el esquema de asignación de agendas para aumentar la carga horaria por profesional seleccionado.

Gráfico 8: Carga Médico vs. Año vs. Citas

sample_3d <- df_procesado %>%
  group_by(DoctorID, Año) %>%
  summarise(Citas_Medico = n(), Pacientes_Atendidos = n_distinct(PatientID), .groups = 'drop')

plot_ly(
  sample_3d,
  x = ~as.numeric(DoctorID),
  y = ~Año,
  z = ~Citas_Medico,
  type = 'scatter3d',
  mode = 'markers',
  color = ~Citas_Medico,
  size = ~Pacientes_Atendidos,
  colors = viridis::plasma(100),
  marker = list(symbol = 'circle', sizemode = 'diameter')
) %>%
  layout(
    title = list(text = "<b>Gráfico 8: Matriz 3D - ID Médico vs. Año vs. Citas</b>"),
    scene = list(
      xaxis = list(title = "ID Médico"),
      yaxis = list(title = "Año"),
      zaxis = list(title = "Citas Atendidas")
    )
  )

Análisis:
* ¿Qué evidencia el gráfico?: Visualiza la dispersión de los 611 médicos a través del tiempo y confirma la presencia de 1,000 parejas únicas (PatientID, DoctorID).
* Acciones: Implementar un algoritmo en la plataforma de agendamiento que vincule obligatoriamente las citas subsecuentes de un usuario con su médico tratante previo.

Módulo 3: Recurrencia y Fidelización de Pacientes

Gráfico 9: Frecuencia de Asistencia y Recurrencia del Paciente

recurrencia_pacientes <- df_procesado %>%
  count(PatientID, name = "Citas_Paciente") %>%
  count(Citas_Paciente, name = "Num_Pacientes") %>%
  mutate(Porcentaje = round(Num_Pacientes / sum(Num_Pacientes) * 100, 1))

ggplot(recurrencia_pacientes, aes(x = factor(Citas_Paciente), y = Num_Pacientes, fill = factor(Citas_Paciente))) +
  geom_col(show.legend = FALSE, width = 0.55) +
  geom_text(aes(label = paste0(Num_Pacientes, " (", Porcentaje, "%)")), vjust = -0.4, fontface = "bold") +
  scale_fill_brewer(palette = "Greens") +
  scale_y_continuous(limits = c(0, 380)) +
  labs(title = "Gráfico 9: Nivel de Recurrencia de la Base de Pacientes",
       x = "Cantidad de Citas Solicitadas por Paciente", y = "Número de Pacientes") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Síntesis Analítica:
* ¿Qué evidencia el gráfico?: Muestra que 335 usuarios (54.9%) son ocasionales (1 sola cita), mientras que 275 usuarios (45.1%) son recurrentes (2 a 6 citas).
* ¿Por qué es relevante para la gestión?: Resalta que casi la mitad de los pacientes reincide en la institución, representando una base sólida para programas de retención y control crónico.
* ¿Qué ruta de acción sugiere?: Crear un programa integral de seguimiento clínico y preventivo enfocado en los 275 pacientes recurrentes.

Gráfico 10: Top 10 Pacientes con Mayor Frecuencia de Citas

top10_pacientes <- df_procesado %>%
  count(PatientID, name = "Total_Citas") %>%
  arrange(desc(Total_Citas)) %>%
  head(10)

ggplot(top10_pacientes, aes(x = reorder(paste("Paciente", PatientID), Total_Citas), y = Total_Citas)) +
  geom_col(fill = "#27AE60", width = 0.6) +
  geom_text(aes(label = Total_Citas), hjust = -0.3, fontface = "bold") +
  coord_flip() +
  scale_y_continuous(limits = c(0, 7.5)) +
  labs(title = "Gráfico 10: Top 10 Pacientes con Mayor Recurrencia",
       x = "ID del Paciente", y = "Total de Citas Atendidas") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5))

Síntesis Analítica:
* ¿Qué evidencia el gráfico?: Identifica a los pacientes con mayor demanda, encabezados por los usuarios ID 864 y 717 con 6 citas c/u, seguidos por los ID 276, 447 y 531 con 5 citas.
* ¿Qué ruta de acción sugiere?: Asignar gestores de atención personalizada para los pacientes del Top 10 que optimicen sus tiempos de consulta y seguimiento diagnóstico.

Gráfico 11: Densidad por Día y Mes

matriz_demanda <- df_procesado %>%
  group_by(DiaSemana, Mes_Num) %>%
  summarise(Total = n(), .groups = 'drop') %>%
  pivot_wider(names_from = Mes_Num, values_from = Total, values_fill = 0) %>%
  arrange(DiaSemana)

z_matrix <- as.matrix(matriz_demanda[, -1])
dias_labels <- levels(df_procesado$DiaSemana)
meses_labels <- 1:12

plot_ly(
  z = ~z_matrix, 
  x = ~meses_labels, 
  y = ~dias_labels, 
  type = 'surface',
  colorscale = 'Viridis'
) %>%
  layout(
    title = list(text = "<b>Gráfico 11: Superficie 3D - Densidad de Demanda Operativa</b>", y = 0.95),
    scene = list(
      xaxis = list(title = "Mes (1 - 12)"),
      yaxis = list(title = "Día de la Semana"),
      zaxis = list(title = "Total Citas")
    )
  )

Análisis:
* ¿Qué evidencia el gráfico?: Integra la variabilidad espacio-temporal mostrando elevaciones suaves en Viernes de Enero/Abril y valles menores los Sábados de Mayo.
* ¿Qué ruta de acción sugiere?: Mantener la distribución actual de salas físicas y turnos de atención general, enfocando los esfuerzos en la optimización de las agendas médicas.

Conclusiones y Diagnóstico Estadístico

Análisis Narrativo Dimensiones Claves

  • 1. Calidad de Datos: La base de datos es 100% confiable (0% nulos en 1,000 registros). La institución opera el 49.3% de los días del año con un promedio de 1.39 citas diarias.
  • 2. Comportamiento Anual: La demanda es plana y predecible (~250 citas/año, variabilidad de 3.72%), eliminando riesgos por picos o valles severos de facturación.
  • 3. Operación Semanal: Distribución homogénea de lunes a domingo (\(CV = 5.71\%\)). Los fines de semana concentran el 26.9% de las consultas totales.
  • 4. Capacidad Médica: Gran dispersión del talento humano. Se contrataron 611 médicos para 1,000 citas; el 56.0% de los médicos atendió solo 1 cita en 4 años.
  • 5. Continuidad Asistencial: La tasa de reatención con el mismo médico es del 0.0%. Ningún paciente recurrente volvió a ver a su médico previo.

Ruta para la Gestión

  1. Consolidar la Planta Médica: Reducir la nómina dispersa de 611 médicos y concentrar las horas en un equipo base de tiempo completo para maximizar el rendimiento por hora contratada.
  2. Automatizar el Agendamiento Continuo: Configurar el software de citas para reasignar automáticamente al 45.1% de pacientes recurrentes con su médico tratante previo.

Recomendaciones Ejecutivas Concretas

  1. Rediseño del Modelo de Agenda y Reestructuración del Plantel Médico:
    • Iniciativa: Implementar una política de consolidación de agendas que reduzca gradualmente la dispersión de 611 profesionales, concentrando las atenciones en un núcleo médico de tiempo completo o medio tiempo.
    • Resultado Esperado: Aumentar el rendimiento por hora médica contratada, reducir costos de gestión administrativa y optimizar el uso de consultorios.
  2. Implementación de un Algoritmo de Continuidad Asistencial en el Software de Agendamiento:
    • Iniciativa: Configurar en el sistema de agendamiento una regla de negocio automatizada que identifique al 45.1% de usuarios recurrentes (275 pacientes) y los reasigne prioritariamente a su médico tratante de la consulta anterior.
    • Resultado Esperado: Incrementar la tasa de seguimiento longitudinal de los paciente hacia una meta institucional del 70%, mejorando la adherencia al tratamiento, la calidad del diagnóstico y la fidelización del usuario.