Proyecciones de Consumo de Insumos Esenciales

1 1. Alcance y objetivo analítico

Este estudio construye un flujo reproducible para:

1. Consolidar archivos administrativos de recetas 2025 a partir de CSV por mes o parte.

2. Normalizar encabezados y tipificar variables operativas (fecha y cantidades).

3. Clasificar líneas de receta en un conjunto de insumos esenciales mediante reglas de texto.

4. Construir series mensuales completas por insumo.

5. Estimar proyecciones de consumo para un horizonte de 3 meses, con intervalos de predicción y selección automática de modelo según desempeño reciente.

6. Integrar datos de stock observados para análisis de riesgo operacional, como meses de cobertura y alertas de criticidad con umbrales expandidos.

Unidad de análisis: línea de receta, agregada a mes–insumo.
Variable de consumo: por defecto se usa cantidad_recetada como aproximación operativa. Si dispones de cantidad_dispensada consistente, puede reemplazarse con mínimos cambios.
Stock: se integra stock_en_farmacia_ventanilla (o equivalente) para calcular cobertura y criticidad.

2 2. Ingesta masiva y normalización de metadatos

ruta_dir <- params$ruta_dir_csv 
patron <- params$patron_archivos
archivos <- list.files(path = ruta_dir, pattern = patron, full.names = TRUE) 
if (length(archivos) == 0) stop("No se encontraron CSV con el patrón indicado en la ruta_dir_csv.")
leer_archivo <- function(fp) { 
  dt <- data.table::fread(fp, encoding = "UTF-8", colClasses = "character", showProgress = FALSE) 
  if (isTRUE(params$incluir_archivo_fuente)) { 
    dt[, fuente_archivo := basename(fp)] 
  } 
  dt 
}
lista <- lapply(archivos, leer_archivo) 
datos_raw <- rbindlist(lista, fill = TRUE, use.names = TRUE)

2.1 Normalización robusta de nombres de columnas

nms <- names(datos_raw) 
nms <- stringi::stri_trans_general(nms, "Latin-ASCII") 
nms <- tolower(nms) 
nms <- str_replace_all(nms, "[^a-z0-9]+", "_") 
nms <- str_replace_all(nms, "_+", "_") 
nms <- str_replace_all(nms, "^_|_$", "") 
setnames(datos_raw, nms)
data.table( 
  n_archivos = length(archivos), 
  n_filas = nrow(datos_raw), 
  n_columnas = ncol(datos_raw) 
)

##    n_archivos n_filas n_columnas
##         <int>   <int>      <int>
## 1:         18 1859277         25

3 2.1 Identificación de columnas operativas

Se detectan automáticamente las columnas más relevantes, priorizando encabezados típicos en tus bases:

• Fecha de necesidad

• Cantidad recetada

• Texto breve del ítem

• Stock en farmacia/ventanilla

pick_col <- function(nms, prefer, fallback_regex) { 
  hit <- prefer[prefer %in% nms] 
  if (length(hit) > 0) return(hit[1]) 
  hit2 <- grep(fallback_regex, nms, value = TRUE) 
  if (length(hit2) > 0) return(hit2[1]) 
  NA_character_ 
}
nms <- names(datos_raw)
col_fecha <- pick_col(nms, prefer = c("fecha_necesidad","fechanecesidad"), fallback_regex = "fecha" )
col_cant <- pick_col(nms, prefer = c("cantidad_recetada","cantidadrecetada","cant_recetada"), fallback_regex = "cantidad.*recet" )
col_texto <- pick_col(nms, prefer = c("texto_breve_medicamento","textobrevemedicamento","texto_breve"), fallback_regex = "texto.*breve|descripcion|medic" )
col_stock <- pick_col(nms, prefer = c("stock_en_farmacia_ventanilla","stockfarmaciaventa","stock"), fallback_regex = "stock.*(farmacia|ventanilla)" )
if (is.na(col_fecha) || is.na(col_cant) || is.na(col_texto)) { 
  stop("No se pudieron detectar columnas clave (fecha, cantidad recetada, texto breve). Revisar encabezados.") 
}
if (is.na(col_stock)) {
  warning("No se detectó columna de stock; análisis de criticidad no disponible.")
  col_stock <- NA_character_
}
data.table( 
  col_fecha = col_fecha, 
  col_cantidad = col_cant, 
  col_texto = col_texto,
  col_stock = col_stock
)

##         col_fecha     col_cantidad             col_texto
##            <char>           <char>                <char>
## 1: fechanecesidad cantidadrecetada textobrevemedicamento
##                    col_stock
##                       <char>
## 1: stockenfarmaciaventanilla

4 3. Limpieza, tipificación y control de calidad

4.1 3.1 Funciones de parseo robusto

parse_fecha_multi <- function(x) { 
  x <- ifelse(is.na(x), NA_character_, trimws(x)) 
  x <- substr(x, 1, 19)
  # intentos en orden: dmy, mdy, ymd, con hora opcional
  out <- suppressWarnings(parse_date_time(x, orders = c("dmy HMS","mdy HMS","ymd HMS","dmy","mdy","ymd"))) 
  as.Date(out) 
}
parse_num_int <- function(x) { 
  x <- ifelse(is.na(x), NA_character_, trimws(x)) 
  x <- str_replace_all(x, "[^0-9\\-]", "") 
  suppressWarnings(as.numeric(x)) 
}

4.2 3.2 Construcción de base analítica mínima

datos <- as.data.table(datos_raw)
datos[, fecha := parse_fecha_multi(get(col_fecha))] 
datos[, cantidad_recetada := parse_num_int(get(col_cant))] 
datos[, texto_med := str_to_lower(stringi::stri_trans_general(ifelse(is.na(get(col_texto)),"",get(col_texto)), "Latin-ASCII"))]
if (!is.na(col_stock)) {
  datos[, stock := parse_num_int(get(col_stock))]
}
# Variables temporales consistentes a nivel mes
datos[, periodo := as.Date(format(fecha, "%Y-%m-01"))] 
datos[, anio := year(periodo)] 
datos[, mes := month(periodo)]
# Filtros mínimos de integridad
datos <- datos[!is.na(fecha) & !is.na(periodo)] 
datos <- datos[!is.na(cantidad_recetada)]
data.table( 
  n_filas_post = nrow(datos), 
  fecha_min = as.character(min(datos$fecha, na.rm = TRUE)), 
  fecha_max = as.character(max(datos$fecha, na.rm = TRUE)), 
  prop_cant_missing = mean(is.na(datos$cantidad_recetada)),
  prop_stock_missing = if (!is.na(col_stock)) mean(is.na(datos$stock)) else NA_real_
)

##    n_filas_post  fecha_min  fecha_max prop_cant_missing prop_stock_missing
##           <int>     <char>     <char>             <num>              <num>
## 1:      1859277 2025-01-01 2025-12-05                 0                  0

4.3 3.3 Perfil de calidad por variable clave

vars_qc <- c("fecha","periodo","cantidad_recetada","texto_med")
if (!is.na(col_stock)) vars_qc <- c(vars_qc, "stock")
qc <- data.table( 
  variable = vars_qc, 
  n_total = nrow(datos), 
  n_na = sapply(vars_qc, function(v) sum(is.na(datos[[v]]))), 
  prop_na = sapply(vars_qc, function(v) mean(is.na(datos[[v]]))) 
) 
datatable(qc, options = list(pageLength = 10), rownames = FALSE, caption = "Control de calidad, variables operativas")

5 4. Diccionario de insumos esenciales y clasificación

Se define un diccionario explícito de patrones, con orden deliberado para evitar colisiones, por ejemplo 1000 antes que 100.

dicc <- data.table::data.table( 
  insumo_esencial = c( 
    "Alcohol 70°", 
    "Iodopovidona Solución (IOP solución)", 
    "Iodopovidona Jabón (IOP jabón)", 
    "Clorhexidina Jabón", 
    "Solución Fisiológica 1000 ml", 
    "Solución Fisiológica 500 ml", 
    "Solución Fisiológica 100 ml", 
    "Solución Ringer", 
    "Guantes procedimiento estériles", 
    "Punzocath 18", 
    "Punzocath 20", 
    "Punzocath 22", 
    "Punzocath 24", 
    "Jeringas de 5ml", 
    "Jeringas de 10ml", 
    "Algodón", 
    "Macrogotero", 
    "Microgotero", 
    "Volutrol", 
    "Cinta adhesiva 5cm", 
    "Cinta adhesiva 10cm", 
    "Llave 3 vias", 
    "Frasco de drenaje pleural", 
    "Micro nebulizador tb", 
    "Cánula de oxígeno", 
    "Mascarilla de oxígeno" 
  ), 
  patron_regex = c( 
    "\\balcohol\\b.*\\b70\\b", 
    "iodo.*(\\bsol\\b|solucion)|iop.sol", 
    "iodo.*jabon|iop.jab", 
    "clorhex.*jabon", 
    "fisiolog.*\\b1000\\b", 
    "fisiolog.*\\b500\\b", 
    "fisiolog.*\\b100\\b(?!0)", 
    "ringer", 
    "guant.*(procedimiento|ester)", 
    "punzocath.*\\b18\\b", 
    "punzocath.*\\b20\\b", 
    "punzocath.*\\b22\\b", 
    "punzocath.*\\b24\\b", 
    "jering.*(\\b5\\b).?(ml|cc)", 
    "jering.*(\\b10\\b).?(ml|cc)", 
    "algod", 
    "macrogot", 
    "microgot", 
    "volutrol", 
    "cinta.*adhes.*\\b5\\b.*cm", 
    "cinta.*adhes.*\\b10\\b.*cm", 
    "llave.*(\\b3\\b|tres).*via", 
    "(frasco.*drenaje.*pleur)|(pleur.*dren)", 
    "micro.*nebul", 
    "canula.*oxigen|c[aá]nula.*oxigen", 
    "mascar.*oxigen" 
  ) 
)

5.1 Clasificación secuencial por patrón

datos[, insumo_esencial := NA_character_] 
for (i in seq_len(nrow(dicc))) { 
  idx <- is.na(datos$insumo_esencial) & str_detect(datos$texto_med, dicc$patron_regex[i])
  if (any(idx)) datos[idx, insumo_esencial := dicc$insumo_esencial[i]] 
}

5.2 Cobertura de clasificación

tab_cov <- datos[, .N, by = .(clasificado = !is.na(insumo_esencial))] 
tab_cov[, prop := N / sum(N)] 
datatable(tab_cov, options = list(dom = "t"), rownames = FALSE, caption = "Cobertura de clasificación a insumos esenciales")

6 4.1 Tabla de frecuencias por insumo

freq_ins <- datos[!is.na(insumo_esencial), .N, by = insumo_esencial][order(-N)] 
datatable(freq_ins, options = list(pageLength = 10), rownames = FALSE, caption = "Frecuencia de líneas clasificadas por insumo")

7 5. Consumo mensual, estructura de series y estadísticos descriptivos

7.1 5.1 Consumo mensual por insumo

consumo_mensual <- datos[!is.na(insumo_esencial), .(consumo = sum(cantidad_recetada, na.rm = TRUE)), by = .(insumo_esencial, periodo) ][order(insumo_esencial, periodo)]
datatable(consumo_mensual, options = list(pageLength = 10), rownames = FALSE, caption = "Consumo mensual por insumo esencial")

7.2 5.2 Completar grilla mensual y métricas de variabilidad

Para modelar de manera consistente se completa la grilla de meses. Meses sin registros se imputan como 0, lo cual equivale a ausencia de consumo registrado en la fuente.

grid <- expand.grid( 
  insumo_esencial = unique(consumo_mensual$insumo_esencial), 
  periodo = seq(min(consumo_mensual$periodo), max(consumo_mensual$periodo), by = "month"), 
  stringsAsFactors = FALSE 
) %>% as.data.table()
consumo_full <- merge(grid, consumo_mensual, by = c("insumo_esencial","periodo"), all.x = TRUE) 
consumo_full[is.na(consumo), consumo := 0]

7.2.1 Métricas descriptivas

met <- consumo_full[, .( 
  meses = .N, 
  consumo_total = sum(consumo), 
  promedio = mean(consumo), 
  mediana = median(consumo), 
  sd = sd(consumo), 
  cv = ifelse(mean(consumo) > 0, sd(consumo)/mean(consumo), NA_real_), 
  p90 = quantile(consumo, 0.90, na.rm = TRUE) 
), by = insumo_esencial][order(-consumo_total)]
datatable(met, options = list(pageLength = 10), rownames = FALSE, caption = "Estadísticos descriptivos por insumo (serie mensual completa)")

7.3 5.3 Figura, series mensuales (facetas)

ggplot(consumo_full, aes(x = periodo, y = consumo)) + 
  geom_line() + 
  geom_point(size = 1) + 
  facet_wrap(~ insumo_esencial, scales = "free_y", ncol = 2) + 
  labs( 
    title = "Series mensuales de consumo por insumo esencial", 
    x = "Periodo (mes)", 
    y = "Consumo (unidades)" 
  ) + 
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

8 5.4 Integración de stock: stock mensual observado

Se agrega stock promedio por insumo y mes (si disponible). Para simplicidad, se usa promedio de stock observado en líneas del mes; en producción, considerar snapshot de stock al final del mes.

if (!is.na(col_stock)) {
  stock_mensual <- datos[!is.na(insumo_esencial) & !is.na(stock), .(stock_promedio = mean(stock, na.rm = TRUE)), by = .(insumo_esencial, periodo) ][order(insumo_esencial, periodo)]
  datatable(stock_mensual, options = list(pageLength = 10), rownames = FALSE, caption = "Stock promedio mensual por insumo esencial")
  stock_full <- merge(grid, stock_mensual, by = c("insumo_esencial","periodo"), all.x = TRUE) 
  stock_full[is.na(stock_promedio), stock_promedio := 0]  # Asumir 0 si no observado
} else {
  message("No hay datos de stock; saltando integración.")
}

9 6. Metodología de proyección y selección automática de modelo

Con series mensuales cortas, la sobreparametrización es un riesgo. Por ello se evalúa un conjunto restringido de modelos por insumo:

• Media histórica: meanf

• Naive: naive

• ETS: ets

• ARIMA automática: auto.arima

Se selecciona el modelo por el menor error de pronóstico a un paso en una ventana reciente de tamaño 4 meses, cuando la longitud de serie lo permite. Si no lo permite, se prioriza ETS por parsimonia. Error CV: rolling origin 1-step

cv_rmse_1step <- function(y, fit_fun, window = 4) { 
  n <- length(y)
  if (n < (window + 2)) return(NA_real_) 
  idx_test <- (n - window + 1):n 
  errs <- c() 
  for (t in idx_test) { 
    y_train <- y[1:(t-1)] 
    y_test <- y[t] 
    fit <- tryCatch(fit_fun(y_train), error = function(e) NULL) 
    if (is.null(fit)) { 
      errs <- c(errs, NA_real_) 
    } else { 
      fc <- tryCatch(forecast::forecast(fit, h = 1), error = function(e) NULL) 
      if (is.null(fc)) errs <- c(errs, NA_real_) else errs <- c(errs, (y_test - as.numeric(fc$mean[1]))^2) 
    } 
  } 
  sqrt(mean(errs, na.rm = TRUE)) 
}
fit_mean <- function(y) forecast::meanf(ts(y, frequency = 12)) 
fit_naive <- function(y) forecast::naive(ts(y, frequency = 12)) 
fit_ets <- function(y) forecast::ets(ts(y, frequency = 12)) 
fit_arima <- function(y) forecast::auto.arima(ts(y, frequency = 12), seasonal = FALSE, stepwise = TRUE, approximation = FALSE)

9.1 Selección

seleccionar_modelo <- function(y, window = 4) { 
  modelos <- list( 
    MEAN = function(z) forecast::meanf(ts(z, frequency = 12)), 
    NAIVE = function(z) forecast::naive(ts(z, frequency = 12)), 
    ETS = function(z) forecast::ets(ts(z, frequency = 12)), 
    ARIMA = function(z) forecast::auto.arima(ts(z, frequency = 12), seasonal = FALSE, stepwise = TRUE, approximation = FALSE) 
  )
  rmses <- sapply(names(modelos), function(nm) cv_rmse_1step(y, fit_fun = modelos[[nm]], window = window))
  # fallback si todo NA
  if (all(is.na(rmses))) { 
    return(list(best = "ETS", rmse = NA_real_, rmses = rmses)) 
  } 
  best <- names(rmses)[which.min(rmses)] 
  list(best = best, rmse = rmses[best], rmses = rmses) 
}
ajustar_y_proyectar <- function(y, h, best_name) { 
  yts <- ts(y, frequency = 12) 
  fit <- switch( 
    best_name, 
    MEAN = forecast::meanf(yts), 
    NAIVE = forecast::naive(yts), 
    ETS = forecast::ets(yts), 
    ARIMA = forecast::auto.arima(yts, seasonal = FALSE, stepwise = TRUE, approximation = FALSE), 
    forecast::ets(yts) 
  ) 
  fc <- forecast::forecast(fit, h = h, level = c(80,95)) 
  list(fit = fit, fc = fc) 
}

10 7. Proyecciones por insumo, tablas y figuras

h <- params$horizonte_meses 
w <- params$ventana_cv
series_list <- split(consumo_full[order(periodo)], by = "insumo_esencial", keep.by = TRUE)
res_modelos <- rbindlist(lapply(names(series_list), function(ins) { 
  dt_ins <- series_list[[ins]] 
  y <- dt_ins$consumo 
  sel <- seleccionar_modelo(y, window = w) 
  data.table( 
    insumo_esencial = ins, 
    modelo_seleccionado = sel$best, 
    rmse_cv_1step = sel$rmse 
  ) 
}), use.names = TRUE, fill = TRUE)
datatable(res_modelos[order(rmse_cv_1step)], options = list(pageLength = 10), rownames = FALSE, caption = "Selección de modelo por insumo (criterio: RMSE CV 1-step en ventana reciente)")

10.1 7.1 Tabla de proyecciones (horizonte 3 meses)

forecast_tbl <- rbindlist(lapply(names(series_list), function(ins) { 
  dt_ins <- series_list[[ins]] 
  y <- dt_ins$consumo
  best <- res_modelos[insumo_esencial == ins, modelo_seleccionado][1] 
  out <- ajustar_y_proyectar(y, h = h, best_name = best)
  # construir eje temporal mensual para pronóstico
  last_period <- max(dt_ins$periodo) 
  fc_periods <- seq(from = as.Date(last_period %m+% months(1)), by = "month", length.out = h)
  data.table( 
    insumo_esencial = ins, 
    modelo = best, 
    periodo = fc_periods, 
    pronostico = as.numeric(out$fc$mean), 
    li_80 = as.numeric(out$fc$lower[,"80%"]), 
    ls_80 = as.numeric(out$fc$upper[,"80%"]), 
    li_95 = as.numeric(out$fc$lower[,"95%"]), 
    ls_95 = as.numeric(out$fc$upper[,"95%"]) 
  ) 
}), use.names = TRUE, fill = TRUE)
datatable(forecast_tbl, options = list(pageLength = 10), rownames = FALSE, caption = "Pronósticos por insumo (con intervalos 80% y 95%)")

10.2 7.2 Figura, histórico y pronóstico por insumo (facetas)

hist_plot <- consumo_full[, .(insumo_esencial, periodo, consumo)] 
fc_plot <- forecast_tbl[, .(insumo_esencial, periodo, pronostico, li_95, ls_95)]
ggplot() + 
  geom_line(data = hist_plot, aes(x = periodo, y = consumo)) + 
  geom_point(data = hist_plot, aes(x = periodo, y = consumo), size = 0.8) + 
  geom_ribbon(data = fc_plot, aes(x = periodo, ymin = li_95, ymax = ls_95), alpha = 0.20) + 
  geom_line(data = fc_plot, aes(x = periodo, y = pronostico), linetype = 2) + 
  facet_wrap(~ insumo_esencial, scales = "free_y", ncol = 2) + 
  labs( 
    title = "Histórico y pronóstico por insumo esencial", 
    x = "Periodo (mes)", 
    y = "Consumo (unidades)" 
  ) + 
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

11 8. Tablas ejecutivas y priorización operativa

11.1 8.1 Proyección trimestral agregada y ranking

rank_trimestral <- forecast_tbl %>% 
  group_by(insumo_esencial) %>% 
  summarise( 
    proyeccion_trimestral = sum(pronostico, na.rm = TRUE), 
    li_95_trimestral = sum(li_95, na.rm = TRUE), 
    ls_95_trimestral = sum(ls_95, na.rm = TRUE), 
    modelo = first(modelo), 
    .groups = "drop" 
  ) %>% 
  arrange(desc(proyeccion_trimestral))
datatable(rank_trimestral, options = list(pageLength = 10), rownames = FALSE, caption = "Ranking por proyección trimestral (suma de pronósticos mensuales)")

11.2 8.2 Figura, top 15 por proyección trimestral

top15 <- head(rank_trimestral, 15)
ggplot(top15, aes(x = reorder(insumo_esencial, proyeccion_trimestral), y = proyeccion_trimestral)) + 
  geom_col() + 
  coord_flip() + 
  labs( 
    title = "Top 15 insumos esenciales, proyección trimestral", 
    x = "Insumo esencial", 
    y = "Proyección trimestral (unidades)" 
  ) + 
  theme_minimal()

12 8.3 Análisis de criticidad con stock integrado

Si hay datos de stock, se calcula cobertura (meses de stock basado en pronóstico promedio mensual) y criticidad (ej. ABC por CV y cobertura baja). Se expanden los umbrales para una clasificación más granular: <0.5 mes (Crítica Inmediata), 0.5-1 mes (Alta), 1-3 meses (Media), 3-6 meses (Baja), 6-12 meses (Segura), 6-12 meses (Segura), >12 meses (Excedente).

if (!is.na(col_stock)) {
  # Stock más reciente por insumo (último periodo observado)
  stock_reciente <- stock_full[periodo == max(periodo), .(insumo_esencial, stock_ultimo = stock_promedio)]
  # Pronóstico promedio mensual desde métricas
  pron_prom <- met[, .(insumo_esencial, pron_mensual_prom = promedio)]
  crit <- merge(stock_reciente, pron_prom, by = "insumo_esencial")
  crit[, cobertura_meses := ifelse(pron_mensual_prom > 0, stock_ultimo / pron_mensual_prom, Inf)]
  crit[, alerta_critica := ifelse(cobertura_meses < 0.5, "Crítica Inmediata (<0.5 mes)",
                                  ifelse(cobertura_meses < 1, "Alta (0.5-1 mes)",
                                         ifelse(cobertura_meses < 3, "Media (1-3 meses)",
                                                ifelse(cobertura_meses < 6, "Baja (3-6 meses)",
                                                       ifelse(cobertura_meses < 12, "Segura (6-12 meses)",
                                                              "Excedente (>12 meses)")))))]
  datatable(crit[order(cobertura_meses)], options = list(pageLength = 10), rownames = FALSE, caption = "Criticidad por insumo: cobertura de stock vs pronóstico mensual promedio")
}

13 9. Notas metodológicas y consideraciones de interpretación

1. Censura por dispensación: si la variable cantidad_recetada difiere sistemáticamente de la dispensación efectiva, el pronóstico refleja demanda administrativa más que consumo real. Se recomienda migrar el agregado a cantidad_dispensada si es operativamente consistente.

2. Series cortas: con pocos meses disponibles, modelos complejos pueden sobreajustar. Por eso se prioriza un conjunto limitado de modelos y se utiliza validación reciente por ventana.

3. Clasificación por texto: la regla de regex es reproducible, pero depende de la calidad del campo descriptivo. Se recomienda construir una tabla de referencia por código (por ejemplo medicamento_sap) para clasificación determinística.

4. Meses con cero: se imputan como 0 cuando no hay registros para un insumo en un mes, interpretado como ausencia de consumo registrado, no necesariamente ausencia de demanda real. Este punto debe validarse con la operación.

5. Stock: se usa promedio mensual observado; para precisión, usar snapshots de fin de mes. Criticidad es indicativa con umbrales expandidos; ajustar según operación (ej. agregar factores como lead time de proveedores).

14 10. Exportación de resultados

if (isTRUE(params$exportar_csv)) { 
  fwrite(consumo_full, "consumo_mensual_insumos_2025.csv") 
  fwrite(res_modelos, "modelos_seleccionados_por_insumo.csv") 
  fwrite(forecast_tbl, "pronosticos_por_insumo.csv") 
  fwrite(rank_trimestral, "ranking_proyeccion_trimestral.csv") 
  if (!is.na(col_stock)) fwrite(crit, "criticidad_stock_insumos.csv")
}