---
title: "ONCO | Inteligencia de urgencias"
subtitle: "Diagnóstico asistencial y decisiones de inversión · Junta Directiva"
author: "Oficina de Planeación y Gerencia Hospitalaria"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
    self_contained: true
    theme: cosmo
    source_code: embed
---

```{r configuracion, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, warning=FALSE, message=FALSE, fig.width=10, fig.height=4.5)
for(pkg in c('flexdashboard','ggplot2','plotly','dplyr','tidyr','DT','scales')) {
 if(!requireNamespace(pkg,quietly=TRUE)) stop('Instale el paquete: ',pkg)
}
library(flexdashboard);library(ggplot2);library(plotly);library(dplyr);library(tidyr)
fmt<-function(x,d=0) format(round(x,d),nsmall=d,decimal.mark=',',big.mark='.',trim=TRUE)

# Las tarjetas KPI se escriben como HTML en el documento ya renderizado;
# no requieren JavaScript, Shiny ni el componente valueBox.
tarjeta_kpi <- function(valor, titulo, nota, acento='#2463EB') {
  sprintf(paste0('<div class="kpi-solid" style="border-top:6px solid %s">',
    '<div class="kpi-title">%s</div>',
    '<div class="kpi-value">%s</div>',
    '<div class="kpi-note">%s</div></div>'), acento, titulo, valor, nota)
}

```

```{r fuente, include=FALSE}
set.seed(20261029)
fechas <- seq(as.Date("2026-01-01"), as.Date("2026-06-29"), by="day")
turnos <- c("Madrugada", "Mañana", "Tarde-noche")
base <- tidyr::expand_grid(fecha=fechas, turno=factor(turnos, levels=turnos)) %>%
  mutate(mes=format(fecha,"%Y-%m"), indice=as.integer(fecha-min(fecha)),
         mejora=fecha>=as.Date("2026-04-01"),
         periodo=ifelse(mejora,"Después de mejoras","Antes de mejoras"),
         crisis=(fecha>=as.Date("2026-02-09") & fecha<=as.Date("2026-02-16")) |
           (fecha>=as.Date("2026-04-20") & fecha<=as.Date("2026-04-28")) |
           (fecha>=as.Date("2026-05-11") & fecha<=as.Date("2026-05-24")) |
           (fecha>=as.Date("2026-06-08") & fecha<=as.Date("2026-06-16")),
         crisis_fuerte=fecha>=as.Date("2026-05-11") & fecha<=as.Date("2026-05-24"),
         fin_semana=as.integer(as.POSIXlt(fecha)$wday %in% c(0,6)),
         id=as.integer(turno),
         lambda=pmax(2,33+c(-9,12,15)[id]+.10*indice+13*crisis+9*crisis_fuerte+5*fin_semana+3*sin(indice/5)),
         ingresos=rpois(n(),lambda), capacidad=ifelse(mejora,29,27),
         ocupacion_pct=round(pmin(190,pmax(60,100*(ingresos/capacidad)*.96+7*crisis+rnorm(n(),0,11))),1),
         espera_min=round(pmax(12,30+1.55*ingresos+1.28*pmax(ocupacion_pct-90,0)+22*crisis+
           12*crisis_fuerte-10*mejora+rnorm(n(),0,15)),1),
         no_atendidos=rbinom(n(),size=ingresos,prob=pmin(.32,pmax(.005,plogis(-4.8+.025*espera_min-.15*mejora)))),
         eventos_alerta=rbinom(n(),size=ingresos,prob=pmin(.24,pmax(.001,plogis(-5.9+.018*espera_min))))) %>%
  select(fecha,mes,turno,periodo,crisis,mejora,ingresos,capacidad,ocupacion_pct,espera_min,no_atendidos,eventos_alerta)
stopifnot(nrow(base)==540, !anyNA(base), all(base$no_atendidos<=base$ingresos), sum(base$ingresos)>0)

resumen_turno <- base %>% group_by(turno) %>% summarise(
 espera=weighted.mean(espera_min,ingresos),
 ocupacion=weighted.mean(ocupacion_pct,ingresos),
 abandonos=sum(no_atendidos), ingresos=sum(ingresos), .groups='drop')
resumen_diario <- base %>% group_by(fecha) %>% summarise(
 espera=weighted.mean(espera_min,ingresos),
 ingresos=sum(ingresos),.groups='drop')
meses <- base %>% group_by(mes) %>% summarise(
 espera=weighted.mean(espera_min,ingresos),
 saturacion=100*mean(ocupacion_pct>90),
 abandono=100*sum(no_atendidos)/sum(ingresos),
 ingresos=sum(ingresos),.groups='drop')
q_espera<-weighted.mean(base$espera_min,base$ingresos)
q_saturacion<-100*mean(base$ocupacion_pct>90)
q_abandono<-100*sum(base$no_atendidos)/sum(base$ingresos)
ref<-base %>% filter(fecha>=max(fecha)-89)
no_atendidos_anual<-sum(ref$no_atendidos)*365/length(unique(ref$fecha))
exceso<-function(x,multiplicador=1) sum(pmax(x$ingresos-x$capacidad*multiplicador,0))
exceso_anual<-exceso(ref)*365/length(unique(ref$fecha))
escenarios<-data.frame(Escenario=c('Sin ampliación','Optimización','Modular','Integral'),
 factor=c(1,1.10,1.30,1.55),CAPEX=c(0,320,1800,4100),OPEX=c(0,160,720,1380))
escenarios$brecha_anual<-vapply(escenarios$factor,function(z) exceso(ref,z)*365/length(unique(ref$fecha)),numeric(1))
escenarios$brecha_evitada<-exceso_anual-escenarios$brecha_anual
# Diagnóstico ampliado y auditable; una fila representa un turno.
periodos <- base %>% group_by(periodo) %>% summarise(
  dias=n_distinct(fecha), turnos=n(),
  espera_ponderada=weighted.mean(espera_min, ingresos),
  ingresos=sum(ingresos),
  mediana_espera=median(espera_min), p90_espera=as.numeric(quantile(espera_min,.90)),
  sd_espera=sd(espera_min), saturacion=100*mean(ocupacion_pct>90),
  abandonos=sum(no_atendidos), tasa_abandono=100*sum(no_atendidos)/sum(ingresos),
  .groups='drop')
resumen_detalle <- base %>% group_by(turno) %>% summarise(
  promedio_ingresos=mean(ingresos),
  mediana_espera=median(espera_min), p90_espera=as.numeric(quantile(espera_min,.90)),
  promedio_espera=weighted.mean(espera_min, ingresos),
  ocupacion_media=weighted.mean(ocupacion_pct, ingresos),
  ingresos=sum(ingresos), saturacion=100*mean(ocupacion_pct>90),
  abandonos=sum(no_atendidos), tasa_abandono=100*sum(no_atendidos)/sum(ingresos),
  .groups='drop')
mensual_diagnostico <- meses %>% mutate(
  variacion_ingresos_pct=100*(ingresos/lag(ingresos)-1),
  variacion_espera_pct=100*(espera/lag(espera)-1))
coef_var_demanda <- 100*sd(base$ingresos)/mean(base$ingresos)
cor_ocup_espera <- cor(base$ocupacion_pct,base$espera_min)
modelo_asociacion <- lm(espera_min ~ ingresos + ocupacion_pct + turno + mejora, data=base)
r2_modelo <- summary(modelo_asociacion)$r.squared
ultimo_mes <- tail(meses,1)
comparacion_inversion <- escenarios %>% mutate(
  reduccion_brecha_pct=ifelse(exceso_anual>0,100*brecha_evitada/exceso_anual,0),
  capex_millones_por_brecha_evitada=ifelse(brecha_evitada>0,CAPEX/brecha_evitada,NA_real_))
# Exportación sin servidor Shiny: descarga de base desde tabla interactiva DT Buttons.
pal<-c('#2463EB','#00A8B8','#FF6B55','#E0A42F')
base_theme<-theme_minimal(base_size=13)+theme(plot.title=element_text(face='bold',color='#0B2447',size=15),
 panel.grid.minor=element_blank(),legend.position='bottom',plot.caption=element_text(color='#66758A'))
```

```{r estilos, results='asis'}
cat('<style>
body{background:#F3F7FD;color:#142945;font-family:Arial,Helvetica,sans-serif}
.navbar{background:#0B2447!important;border:0!important}.navbar .navbar-brand{font-weight:800;color:white!important}
.navbar .navbar-nav>li>a{color:#E1EDFA!important;font-weight:700}
h1,h2,h3{color:#0B2447;font-weight:800}
.chart-title{font-size:18px;font-weight:800}.hero-x{background:linear-gradient(112deg,#0B2447,#2463EB 65%,#00A8B8);padding:23px 28px;border-radius:14px;color:#fff;margin:4px 0 18px;box-shadow:0 8px 23px #153c7726}
.hero-x strong{font-size:23px}.hero-x p{margin-top:8px;font-size:15px;color:#EBF5FF}
.alert-x{background:#FFF2EF;border-left:6px solid #FF6B55;padding:15px 19px;border-radius:8px;color:#5F2730}
.note-x{font-size:11px;color:#66758A;padding:6px 8px;margin-top:10px}
.section.level3{background:white;border:1px solid #E1E9F5;border-radius:12px;overflow:hidden}
.kpi-solid{min-height:154px;padding:18px 21px 16px;background:#fff;border-radius:12px;color:#0B2447;box-shadow:0 5px 19px #203b5a19}
.kpi-title{font-size:13px;letter-spacing:.2px;font-weight:800;color:#425873;text-transform:uppercase}
.kpi-value{font-size:35px;line-height:1.18;font-weight:850;margin:8px 0;color:#122B52}
.kpi-note{font-size:12px;color:#61748D;font-weight:600}
@media(max-width:700px){.kpi-value{font-size:27px}.kpi-solid{min-height:120px}}
</style>')
```

01 · Diagnóstico asistencial
=====================================

Row
-------------------------------------

### El desafío de capacidad {data-height=135}
<div class="hero-x"><strong>La presión asistencial rebasa la capacidad nominal</strong><p>La Junta necesita saber dónde se concentra la demanda, cuánto se extiende la espera y qué ocurre en los episodios de mayor presión.</p></div>

Row {data-height=165}
-------------------------------------

### KPI 1 · Espera promedio ponderada
```{r kpi-1, results='asis'}
cat(tarjeta_kpi(paste0(fmt(q_espera,1),' min'),'Tiempo de espera','Meta indicativa: 60 minutos','#FF6B55'))
```

### KPI 2 · Turnos con saturación
```{r kpi-2, results='asis'}
cat(tarjeta_kpi(paste0(fmt(q_saturacion,1),' %'),'Turnos saturados','Ocupación superior al 90 %','#E0A42F'))
```

### KPI 3 · Salida sin atención
```{r kpi-3, results='asis'}
cat(tarjeta_kpi(paste0(fmt(q_abandono,2),' %'),'Salida sin atención','Porcentaje de las llegadas','#2463EB'))
```

Row {data-height=460}
-------------------------------------

### Evolución diaria de tiempos de espera
```{r tendencia}
p<-ggplot(resumen_diario,aes(fecha,espera))+
 geom_line(color=pal[1],linewidth=.8)+
 geom_hline(yintercept=60,linetype='dashed',color=pal[3])+
 labs(x='Fecha',y='Minutos',title='Esperas que demandan una respuesta estructural',
 subtitle='Línea roja: meta ilustrativa de oportunidad')+base_theme
plotly::ggplotly(p,tooltip=c('x','y'))
```

### Presión asistencial según turno
```{r turnos}
p<-ggplot(resumen_turno,aes(turno,espera,fill=turno))+
 geom_col(width=.67)+scale_fill_manual(values=pal[1:3])+
 labs(x='',y='Minutos',title='El problema no es uniforme por turno')+base_theme+
 theme(legend.position='none')
plotly::ggplotly(p)
```

Row {data-height=420}
-------------------------------------

### Indicadores mensuales · evolución de la presión
```{r mensual}
DT::datatable(meses,rownames=FALSE,
 colnames=c('Mes','Espera (min)','Franjas saturadas (%)','Salida sin atención (%)','Ingresos'),
 extensions='Buttons', options=list(pageLength=6,dom='Btip',buttons=c('copy','csv','excel'),scrollX=TRUE),filter='top')
```

### Análisis de variabilidad y esperas extremas
```{r percentil}
p<-ggplot(base,aes(x=periodo,y=espera_min,fill=periodo))+
 geom_boxplot(outlier.alpha=.18)+scale_fill_manual(values=c('#2463EB','#FF6B55'))+
 labs(x='',y='Minutos',title='Mediana, dispersión y episodios extremos')+base_theme+
 theme(legend.position='none')
plotly::ggplotly(p)
```

Row {data-height=430}
-------------------------------------

### Antes y después · ¿qué pasó con las mejoras?
```{r antes-despues}
DT::datatable(
  periodos %>% mutate(across(where(is.numeric),~round(.x,1))),
  rownames=FALSE,filter='none',
  colnames=c('Período','Días','Turnos','Ingresos','Espera media (min)','Mediana (min)','P90 (min)','Desviación (min)','Saturación (%)','Salidas sin atención','Abandono (%)'),
  extensions='Buttons',options=list(dom='Btip',buttons=c('copy','csv'),pageLength=2,scrollX=TRUE))
```

### ¿Qué tan extremo es el tiempo de espera por turno?
```{r dispersion-turno}
p <- ggplot(base,aes(turno,espera_min,fill=turno))+
 geom_boxplot(outlier.alpha=.20)+
 scale_fill_manual(values=pal[1:3])+
 labs(title='No basta con mirar la espera promedio',subtitle='Distribución por turno y eventos extremos',x='',y='Tiempo de espera (min)')+base_theme+theme(legend.position='none')
plotly::ggplotly(p)
```

Row {data-height=445}
-------------------------------------

### Variación mensual de ingresos y demoras
```{r variacion-mensual}
DT::datatable(mensual_diagnostico %>% mutate(across(where(is.numeric),~round(.x,1))),
 rownames=FALSE, colnames=c('Mes','Espera (min)','Saturación (%)','Abandono (%)','Ingresos','Crecimiento ingresos (%)','Crecimiento espera (%)'),
 extensions='Buttons', options=list(dom='Btip',buttons=c('copy','csv'),pageLength=6,scrollX=TRUE))
```

### ¿A mayor ocupación, mayor espera?
```{r relacion-ocupacion}
p <- ggplot(base,aes(ocupacion_pct,espera_min,color=turno))+
 geom_point(alpha=.48,size=1.5)+geom_smooth(method='lm',se=FALSE,linewidth=.65)+
 scale_color_manual(values=pal[1:3])+
 labs(title='Presión asistencial y demora',subtitle='Asociación descriptiva, no prueba causal',x='Ocupación (%)',y='Espera (min)',color='Turno')+base_theme
plotly::ggplotly(p)
```

Row {data-height=225}
-------------------------------------

### Lectura gerencial del diagnóstico
```{r diagnostico-narrativa, results='asis'}
cat(sprintf('<div class="alert-x"><strong>Los promedios esconden riesgos.</strong> La demanda presenta una variabilidad del <strong>%s %%</strong> (coeficiente de variación); la correlación entre ocupación y espera es <strong>%s</strong>. El modelo asociativo explica <strong>%s %%</strong> de la variación observada dentro de este conjunto de datos. Estas asociaciones no prueban efectos causales de una ampliación.</div>',fmt(coef_var_demanda,1),fmt(cor_ocup_espera,2),fmt(100*r2_modelo,1)))
```

02 · Decisión de inversión
=====================================

Row
-------------------------------------

### El costo de no decidir {data-height=135}
<div class="hero-x"><strong>No ampliar también genera una brecha cuantificable</strong><p>Comparamos cuatro alternativas con las mismas condiciones de demanda reciente. La brecha de capacidad es una presión operativa estimada, no un conteo de pacientes rechazados.</p></div>

Row {data-height=170}
-------------------------------------

### Salidas sin atención · anualización
```{r annual-abandon, results='asis'}
cat(tarjeta_kpi(fmt(no_atendidos_anual,0),'Sin atención · año','Proyección a 365 días','#FF6B55'))
```

### Llegadas por encima de la capacidad · anualización
```{r annual-excess, results='asis'}
cat(tarjeta_kpi(fmt(exceso_anual,0),'Exceso de capacidad · año','Brecha operativa nominal','#E0A42F'))
```

### Brecha que evitaría la ampliación modular
```{r annual-modular, results='asis'}
cat(tarjeta_kpi(fmt(escenarios$brecha_evitada[3],0),'Brecha evitable · modular','Escenario hipotético anual','#00A8B8'))
```

Row {data-height=445}
-------------------------------------

### Exceso de demanda anual por alternativa
```{r escenario-plot}
p<-ggplot(escenarios,aes(x=reorder(Escenario,brecha_anual),y=brecha_anual,fill=Escenario))+
 geom_col(width=.62)+coord_flip()+scale_fill_manual(values=c('#FF6B55','#00A8B8','#2463EB','#E0A42F'))+
 labs(x='',y='Llegadas que exceden capacidad nominal',
 title='El precio asistencial de mantener la misma capacidad')+base_theme+
 theme(legend.position='none')
plotly::ggplotly(p)
```

### Capital inicial y costo operativo recurrente
```{r presupuesto-plot}
long<-tidyr::pivot_longer(escenarios,c(CAPEX,OPEX),names_to='Concepto',values_to='Millones')
p<-ggplot(long,aes(Escenario,Millones,fill=Concepto))+
 geom_col(position='dodge')+scale_fill_manual(values=c('#2463EB','#00A8B8'))+
 labs(x='',y='Millones de COP',title='Inversión versus gasto recurrente')+base_theme+
 theme(axis.text.x=element_text(angle=18,hjust=1))
plotly::ggplotly(p)
```

Row {data-height=380}
-------------------------------------

### Comparador de decisiones · costos y brechas
```{r escenarios-tabla}
DT::datatable(transform(escenarios,factor=NULL),rownames=FALSE,
 colnames=c('Alternativa','CAPEX (mill. COP)','OPEX anual (mill. COP)','Brecha anual','Brecha evitada'),
 extensions='Buttons',options=list(dom='Btip',buttons=c('copy','csv','excel'),pageLength=4,scrollX=TRUE))
```

### Brecha bajo cuatro decisiones: lectura comparativa
```{r tabla-beneficios}
DT::datatable(comparacion_inversion %>% select(Escenario,CAPEX,OPEX,brecha_anual,brecha_evitada,reduccion_brecha_pct) %>%
 mutate(across(where(is.numeric),~round(.x,1))),rownames=FALSE,
 colnames=c('Alternativa','Inversión inicial (M COP)','OPEX anual (M COP)','Demanda excedente anual','Brecha nominal evitada','Reducción de brecha (%)'),
 extensions='Buttons',options=list(dom='Btip',buttons=c('copy','csv'),pageLength=4,scrollX=TRUE))
```

Row {data-height=390}
-------------------------------------

### Registros de gestión · 540 turnos disponibles
```{r registros-descarga}
DT::datatable(base %>% mutate(fecha=as.character(fecha)),rownames=FALSE,
 extensions='Buttons',filter='top',
 options=list(dom='Bftip',buttons=c('copy','csv','excel'),pageLength=10,scrollX=TRUE))
```

### Ruta para decisión financiera
<div class="alert-x"><strong>Sin intervención:</strong> persiste el exceso de demanda nominal. <strong>Con optimización:</strong> puede reducirse parte de la brecha, sin asegurar capacidad suficiente. <strong>Con ampliación modular:</strong> se compara una capacidad 30 % mayor con sus costos de inversión y operación. <strong>Con ampliación integral:</strong> se analiza una expansión de 55 %, sujeta a viabilidad técnica y financiera.<br/><br/><strong>Se solicita:</strong> aprobar estudios técnicos, presupuesto detallado, análisis de flujo del paciente y un plan de implementación por etapas antes de comprometer inversión definitiva.</div>

Row {data-height=250}
-------------------------------------

### Decisión que se presenta a la Junta
<div class="alert-x"><strong>Propuesta:</strong> autorizar la fase de estructuración técnica y financiera de una ampliación modular, sujeta a validación de demanda real, seguridad asistencial, costos, talento humano y cronograma. La alternativa integral permanece como opción para evaluación posterior.</div>

<p class="note-x">Nota metodológica: datos de origen sintético; no corresponden a registros asistenciales verificados. Escenarios anuales extrapolados de los últimos 90 días. La demanda que excede capacidad nominal no equivale necesariamente a pacientes sin atención; las cifras presupuestales son ilustrativas. El dashboard es HTML autónomo: los gráficos permiten zoom, selección y consulta de valores, pero no recalcula KPI con filtros Shiny.</p>