###############################################################################
# #
# TRABAJO DE INVESTIGACIÓN CUANTITATIVA — MANEJO DE RStudio #
# Maestría en Administración en Salud #
# #
# Estudiante : Carlos David Argüello López
# Nasly Estefania Chaucanes Guerrero #
# Docente : Carlos Mario García Diaz #
# Módulo : Seminario de Investigación Cuantitativa #
# Fecha : 07 de junio del 2026 #
# #
# Base de datos: "2022-standard-list-of-charges-professional.csv" #
# Fuente: Children's Minnesota — Transparencia de precios profesionales #
# (cargos profesionales por procedimiento médico, año 2022) #
# #
###############################################################################
#
# ¿QUÉ CONTIENE ESTA BASE DE DATOS?
# Para cada procedimiento médico (identificado por su código CPT) la base
# reporta la "tarifa lista" del hospital (Master Fee Schedule) y el monto
# que paga cada uno de los 14 aseguradores con los que el hospital negocia.
# Es decir: el miso procedimiento tiene PRECIOS DISTINTOS según el pagador.
# Este es un tema central en administración en salud: la TRANSPARENCIA DE
# PRECIOS Y LA VARIACIÓN DE COSTOS ENTRE ASEGURADORES.
#
#
#
###############################################################################
###############################################################################
# SECCIÓN 0. CONFIGURACIÓN INICIAL #
# (Preparar el entorno: ubicación del archivo y librerías necesarias) #
###############################################################################
# --- 0.1 Definir el "directorio de trabajo" -------------------------------
# El directorio de trabajo es la CARPETA donde R buscará tu archivo .csv.
# Reemplaza la ruta de ejemplo por la carpeta donde guardaste el CSV.
# IMPORTANTE en Windows: usa barras "/" o barras dobles "\\", NUNCA una sola "\".
#
# Ejemplo Windows: setwd("C:/Users/TuUsuario/Documents/TrabajoR")
# Ejemplo Mac : setwd("/Users/TuUsuario/Documents/TrabajoR")
#
# Si prefieres no escribir la ruta, en RStudio puedes usar el menú:
# Session > Set Working Directory > Choose Directory... (elige la carpeta)
# setwd("C:/Users/TuUsuario/Documents/TrabajoR") # <- QUITA EL "#" Y EDITA
# getwd() muestra en qué carpeta está parado R en este momento (para verificar)
getwd()
## [1] "C:/Users/Carlos/Documents/Trabajos Maestria fucs/TrabajoR"
# --- 0.2 Instalar las librerías (SOLO la primera vez) ---------------------
# Una "librería" (o paquete) es un conjunto de funciones extra que amplían R.
# install.packages() las DESCARGA de internet. Solo se hace una vez por equipo.
# Si ya las tienes instaladas, deja estas líneas comentadas (con el "#").
# install.packages("readr") # leer archivos .csv de forma robusta
# install.packages("dplyr") # manipular datos (filtrar, agrupar, resumir)
# install.packages("tidyr") # reorganizar datos (formato largo/ancho)
# install.packages("stringr") # manipular texto (limpiar símbolos $, comas)
# install.packages("ggplot2") # crear gráficos de alta calidad
# --- 0.3 Activar (cargar) las librerías -----------------------------------
# install.packages() instala; library() ACTIVA el paquete en esta sesión.
# Esto SÍ debe ejecutarse cada vez que abras RStudio.
library(readr)
library(dplyr)
##
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
library(stringr)
library(ggplot2)
###############################################################################
# SECCIÓN 1. EXPLORACIÓN DE LA BASE DE DATOS #
# (Reconocer variables, tipos, unidades, volumen, periodo e ideas) #
###############################################################################
# --- 1.1 Cargar el archivo CSV en un objeto llamado "datos" ---------------
# read.csv() lee un archivo de texto separado por comas y lo convierte en un
# "data.frame" (una tabla con filas y columnas, similar a una hoja de Excel).
# - check.names = FALSE -> conserva los nombres de columna tal cual (con
# espacios y símbolos), sin "arreglarlos".
# - stringsAsFactors = FALSE -> deja el texto como texto, no como factor.
datos <- read.csv("2022-standard-list-of-charges-professional.csv",
check.names = FALSE,
stringsAsFactors = FALSE)
# --- 1.2 Tamaño y volumen de la base --------------------------------------
dim(datos) # devuelve: número de FILAS y número de COLUMNAS
## [1] 14373 22
nrow(datos) # solo el número de filas (registros / observaciones)
## [1] 14373
ncol(datos) # solo el número de columnas (variables)
## [1] 22
# --- 1.3 Nombres de las variables (columnas) ------------------------------
names(datos) # lista los nombres de todas las columnas
## [1] "index" "Procedure Code"
## [3] "Procedure Description" "CPT Code"
## [5] "Revenue Code" "Standard Modifiers"
## [7] "Fee Schedule Effective Date" "Master Fee Schedule"
## [9] "Blue Cross Blue Shield MN" "HealthPartners"
## [11] "Medica Choice" "Medica Elect"
## [13] "Medica Narrow" "Preferred One"
## [15] "Preferred One PPO" "United Health"
## [17] "Allina Aetna" "America's PPO"
## [19] "Laborcare" "MultiPlan"
## [21] "SelectCare" "Ucare QHP"
# --- 1.4 Primeras y últimas filas para "ver" los datos --------------------
head(datos, 5) # muestra las primeras 5 filas
## index Procedure Code
## 1 0 56810
## 2 1 61600
## 3 2 95933
## 4 3 61333
## 5 4 70370
## Procedure Description CPT Code
## 1 56810 Perineoplasty-Non Obstetrical 56810
## 2 61600 RESCJ/EXC LES BASE ANT CRANIAL FOSSA EXTRADURAL 61600
## 3 95933 Blink Reflex Test 95933
## 4 61333 Explore Orbit Transcranial Approach W/ Removal Lesion 61333
## 5 70370 PF FL Neck Lateral Airway & Fluoroscopy 70370
## Revenue Code Standard Modifiers Fee Schedule Effective Date
## 1 960 01-01-22
## 2 960 01-01-22
## 3 960 01-01-22
## 4 960 01-01-22
## 5 960 01-01-22
## Master Fee Schedule Blue Cross Blue Shield MN HealthPartners Medica Choice
## 1 1125 793.84 671.97 534.279264
## 2 6353 6340.73 5284.19 4200.828503
## 3 290 252.95 212.4 169.173358
## 4 6264 5945.81 4729.4 3758.987793
## 5 66 42.99 37.53 30.163763
## Medica Elect Medica Narrow Preferred One Preferred One PPO United Health
## 1 675 1023.75 559.39 783.73 486.5
## 2 3811.8 5781.23 4446.15 6229.27 3901.99
## 3 174 263.9 168.83 236.54 154.05
## 4 3758.4 5700.24 4231.66 5928.77 3526.52
## 5 24.65827 17417.4 30.43 42.64 31.55
## Allina Aetna America's PPO Laborcare MultiPlan SelectCare Ucare QHP
## 1 499.114 753.75 503.189708 $323.51 503.189708 457.134503
## 2 4038.58 4256.51 4176.406302 $2,594.75 4176.406302 3651.318663
## 3 62.23 194.3 151.571391 $103.29 151.571391 145.661246
## 4 3589.4068 4196.88 4063.75189 $2,345.08 4063.75189 3423.902884
## 5 31.556 44.22 33.263776 $16.43 33.263776 24.756654
tail(datos, 5) # muestra las últimas 5 filas
## index Procedure Code Procedure Description
## 14369 14368 93010A 93010 EKG 12 Lead Interp And Report Only-CHMN
## 14370 14369 90649 90649 Vaccine HPV Quadrivalent
## 14371 14370 92586 92586 Auditory Evoked Potentials Limited
## 14372 14371
## 14373 14372
## CPT Code Revenue Code Standard Modifiers Fee Schedule Effective Date
## 14369 93010 960 01-01-22
## 14370 90649 960 01-01-22
## 14371 92586 960 01-01-22
## 14372
## 14373
## Master Fee Schedule Blue Cross Blue Shield MN HealthPartners
## 14369 103 9.52 21.05
## 14370 320 163.41 163.39
## 14371 255 140.25 247.18
## 14372
## 14373
## Medica Choice Medica Elect Medica Narrow Preferred One Preferred One PPO
## 14369 17.060554 61.8 93.73 17.39 24.36
## 14370 207.264374 192 291.2 153.64 153.64
## 14371 153 153 232.05 194.19 272.07
## 14372
## 14373
## United Health Allina Aetna America's PPO Laborcare MultiPlan SelectCare
## 14369 15.73 16.4836 69.01 16.386096 $10.55 16.386096
## 14370 181.48 319.9504 214.4 213.24368 $163.24 213.24368
## 14371 102 173.4404 170.85 172.736765 $118.29 172.736765
## 14372
## 14373
## Ucare QHP
## 14369 0
## 14370 0
## 14371 0
## 14372
## 14373
# --- 1.5 Estructura: tipo de cada variable y ejemplos ---------------------
# str() (de "structure") es la función MÁS útil para explorar: indica el tipo
# de dato de cada columna (chr = texto, int = entero, num = decimal, etc.)
str(datos)
## 'data.frame': 14373 obs. of 22 variables:
## $ index : int 0 1 2 3 4 5 6 7 8 9 ...
## $ Procedure Code : chr "56810" "61600" "95933" "61333" ...
## $ Procedure Description : chr "56810 Perineoplasty-Non Obstetrical" "61600 RESCJ/EXC LES BASE ANT CRANIAL FOSSA EXTRADURAL" "95933 Blink Reflex Test" "61333 Explore Orbit Transcranial Approach W/ Removal Lesion" ...
## $ CPT Code : chr "56810" "61600" "95933" "61333" ...
## $ Revenue Code : chr "960" "960" "960" "960" ...
## $ Standard Modifiers : chr "" "" "" "" ...
## $ Fee Schedule Effective Date: chr "01-01-22" "01-01-22" "01-01-22" "01-01-22" ...
## $ Master Fee Schedule : chr "1125" "6353" "290" "6264" ...
## $ Blue Cross Blue Shield MN : chr "793.84" "6340.73" "252.95" "5945.81" ...
## $ HealthPartners : chr "671.97" "5284.19" "212.4" "4729.4" ...
## $ Medica Choice : chr "534.279264" "4200.828503" "169.173358" "3758.987793" ...
## $ Medica Elect : chr "675" "3811.8" "174" "3758.4" ...
## $ Medica Narrow : chr "1023.75" "5781.23" "263.9" "5700.24" ...
## $ Preferred One : chr "559.39" "4446.15" "168.83" "4231.66" ...
## $ Preferred One PPO : chr "783.73" "6229.27" "236.54" "5928.77" ...
## $ United Health : chr "486.5" "3901.99" "154.05" "3526.52" ...
## $ Allina Aetna : chr "499.114" "4038.58" "62.23" "3589.4068" ...
## $ America's PPO : chr "753.75" "4256.51" "194.3" "4196.88" ...
## $ Laborcare : chr "503.189708" "4176.406302" "151.571391" "4063.75189" ...
## $ MultiPlan : chr "$323.51" "$2,594.75" "$103.29" "$2,345.08" ...
## $ SelectCare : chr "503.189708" "4176.406302" "151.571391" "4063.75189" ...
## $ Ucare QHP : chr "457.134503" "3651.318663" "145.661246" "3423.902884" ...
# --- 1.6 Resumen estadístico rápido de todas las columnas -----------------
summary(datos)
## index Procedure Code Procedure Description CPT Code
## Min. : 0 Length :14373 Length :14373 Length :14373
## 1st Qu.: 3593 N.unique : 3920 N.unique : 3920 N.unique : 3641
## Median : 7186 N.blank : 10 N.blank : 10 N.blank : 16
## Mean : 7186 Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## 3rd Qu.:10779 Max.nchar: 14 Max.nchar: 102 Max.nchar: 8
## Max. :14372
## Revenue Code Standard Modifiers Fee Schedule Effective Date
## Length :14373 Length :14373 Length :14373
## N.unique : 4 N.unique : 16 N.unique : 3
## N.blank : 54 N.blank :14275 N.blank : 10
## Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## Max.nchar: 12 Max.nchar: 18 Max.nchar: 27
##
## Master Fee Schedule Blue Cross Blue Shield MN HealthPartners
## Length :14373 Length :14373 Length :14373
## N.unique : 2203 N.unique : 7016 N.unique : 2501
## N.blank : 10 N.blank : 10 N.blank : 10
## Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## Max.nchar: 31 Max.nchar: 25 Max.nchar: 14
##
## Medica Choice Medica Elect Medica Narrow Preferred One
## Length :14373 Length :14373 Length :14373 Length :14373
## N.unique : 3333 N.unique : 2546 N.unique : 2648 N.unique : 2421
## N.blank : 10 N.blank : 10 N.blank : 10 N.blank : 10
## Min.nchar: 0 Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## Max.nchar: 13 Max.nchar: 12 Max.nchar: 18 Max.nchar: 13
##
## Preferred One PPO United Health Allina Aetna America's PPO
## Length :14373 Length :14373 Length :14373 Length :14373
## N.unique : 2415 N.unique : 4123 N.unique : 4065 N.unique : 2201
## N.blank : 10 N.blank : 10 N.blank : 10 N.blank : 10
## Min.nchar: 0 Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## Max.nchar: 17 Max.nchar: 13 Max.nchar: 21 Max.nchar: 13
##
## Laborcare MultiPlan SelectCare Ucare QHP
## Length :14373 Length :14373 Length :14373 Length :14373
## N.unique : 2982 N.unique : 3831 N.unique : 2982 N.unique : 2238
## N.blank : 10 N.blank : 10 N.blank : 10 N.blank : 10
## Min.nchar: 0 Min.nchar: 0 Min.nchar: 0 Min.nchar: 0
## Max.nchar: 12 Max.nchar: 9 Max.nchar: 12 Max.nchar: 11
##
# --- 1.7 Lectura interpretativa de la exploración -------------------------
# A partir de los resultados anteriores documentamos lo siguiente:
#
# * NÚMERO DE VARIABLES : 22 columnas.
# * VOLUMEN DE DATOS : ~14.373 filas (registros de procedimientos).
# * TIPO DE VARIABLES : en bruto casi todas se leen como texto (chr),
# porque los precios traen símbolos "$" y comas.
# Las corregiremos en las Secciones 2 y 3.
# * UNIDADES DE MEDIDA :
# - "Procedure Code", "CPT Code", "Revenue Code": CÓDIGOS (identificadores,
# no son cantidades; aunque parezcan números NO se suman ni promedian).
# - "Fee Schedule Effective Date": FECHA (formato día-mes-año).
# - "Master Fee Schedule" y las 14 columnas de aseguradores:
# DINERO en DÓLARES estadounidenses (USD).
# * PERIODO DE TIEMPO : tarifario vigente desde el 01-01-2022, calculado
# con la población de pacientes del año 2021.
# * IDEAS DE INVESTIGACIÓN posibles a partir de esta base:
# 1. ¿Qué tanto VARÍA el precio de un mismo procedimiento entre
# aseguradores? (dispersión de precios = equidad/transparencia)
# 2. ¿Qué asegurador paga, en promedio, más cerca o más lejos de la
# tarifa lista del hospital? (poder de negociación)
# 3. ¿Cuáles son los procedimientos más costosos del portafolio?
# 4. ¿Existen procedimientos cuyo precio es altamente inconsistente
# entre pagadores? (señal de poca transparencia)
###############################################################################
# SECCIÓN 2. LIMPIEZA DE LA BASE DE DATOS #
# (Completar, corregir o eliminar datos erróneos, vacíos o duplicados) #
###############################################################################
# Guardamos cuántas filas tenemos al inicio para comparar al final.
filas_iniciales <- nrow(datos)
cat("Filas antes de limpiar:", filas_iniciales, "\n")
## Filas antes de limpiar: 14373
# --- 2.1 Eliminar FILAS DE CABECERA REPETIDAS dentro de los datos ---------
# Al inspeccionar la base notamos que algunas filas, en lugar de datos, repiten
# los TÍTULOS de las columnas (p. ej. la celda dice literalmente
# "Procedure Code"). Esas filas son basura y deben eliminarse.
# El operador "!=" significa "DIFERENTE DE". Conservamos solo las filas cuya
# celda NO sea igual al texto "Procedure Code".
datos <- datos[datos$`Procedure Code` != "Procedure Code", ]
# --- 2.2 Eliminar FILAS COMPLETAMENTE VACÍAS ------------------------------
# Algunas filas están vacías (sirven como separadores). is.na() detecta valores
# faltantes (NA). Conservamos las filas donde el código de procedimiento NO está
# vacío ni faltante.
datos <- datos[!is.na(datos$`Procedure Code`) &
datos$`Procedure Code` != "", ]
# --- 2.3 Eliminar una COLUMNA casi totalmente vacía -----------------------
# La columna "Standard Modifiers" está vacía en más del 99% de los registros,
# por lo que no aporta y la eliminamos. Asignar NULL a una columna la borra.
datos$`Standard Modifiers` <- NULL
# La columna "index" es solo un consecutivo heredado del archivo original;
# tampoco aporta al análisis, así que también la eliminamos.
datos$index <- NULL
# --- 2.4 Revisar y eliminar FILAS DUPLICADAS EXACTAS ----------------------
# duplicated() marca como TRUE las filas que son copias idénticas de otra.
# sum() cuenta cuántas hay (TRUE cuenta como 1).
cat("Filas duplicadas exactas:", sum(duplicated(datos)), "\n")
## Filas duplicadas exactas: 3599
# Nos quedamos solo con filas únicas (el "!" invierte: conserva las NO duplicadas)
datos <- datos[!duplicated(datos), ]
# --- 2.5 Verificación final de la limpieza --------------------------------
filas_finales <- nrow(datos)
cat("Filas después de limpiar:", filas_finales, "\n")
## Filas después de limpiar: 10760
cat("Filas eliminadas en total:", filas_iniciales - filas_finales, "\n")
## Filas eliminadas en total: 3613
# NOTA: muchos códigos CPT se repiten LEGÍTIMAMENTE (un mismo procedimiento
# puede aparecer con distintos códigos de ingreso/Revenue Code). Por eso NO
# eliminamos por CPT duplicado, solo las filas idénticas completas.
###############################################################################
# SECCIÓN 3. TIPOS DE VARIABLE, OPERACIONES BÁSICAS Y GRÁFICOS #
###############################################################################
# --- 3.1 DEFINIR EL TIPO DE CADA VARIABLE ---------------------------------
# Aquí "le decimos" a R qué es cada columna realmente, para poder analizarla.
# (a) Los CÓDIGOS deben tratarse como FACTOR o texto (categorías), NUNCA como
# números a promediar. as.factor() los convierte en variable categórica.
datos$`Revenue Code` <- as.factor(datos$`Revenue Code`)
# (b) La FECHA: la convertimos de texto a tipo Date con as.Date().
# El formato "%m-%d-%y" indica mes-día-año de dos dígitos (ej. 01-01-22).
datos$`Fee Schedule Effective Date` <-
as.Date(datos$`Fee Schedule Effective Date`, format = "%m-%d-%y")
# (c) Los PRECIOS: están como texto con símbolos "$" y comas (ej. "$2,594.75").
# Creamos una FUNCIÓN PROPIA para limpiarlos y convertirlos a número.
# - str_remove_all() elimina TODAS las apariciones de un patrón de texto.
# - "\\$" representa el símbolo dólar; "," representa la coma de miles.
# - as.numeric() convierte el texto ya limpio en número decimal.
convertir_a_numero <- function(columna_texto) {
columna_texto <- str_remove_all(columna_texto, "\\$") # quita el $
columna_texto <- str_remove_all(columna_texto, ",") # quita las comas
as.numeric(columna_texto) # texto -> número
}
# Aplicamos la función a la tarifa lista del hospital (Master Fee Schedule).
datos$`Master Fee Schedule` <- convertir_a_numero(datos$`Master Fee Schedule`)
# (Las 14 columnas de aseguradores se convertirán en la Sección 4 con un BUCLE,
# para demostrar el uso de ciclos y evitar repetir el mismo código 14 veces.)
# Verificamos que la tarifa lista ya es numérica:
class(datos$`Master Fee Schedule`) # debe responder "numeric"
## [1] "numeric"
# --- 3.2 OPERACIONES BÁSICAS ----------------------------------------------
# Estadísticos descriptivos de la tarifa lista (en dólares).
# na.rm = TRUE le pide a R que IGNORE los valores faltantes en el cálculo.
mean(datos$`Master Fee Schedule`, na.rm = TRUE) # media (promedio)
## [1] 1583.661
median(datos$`Master Fee Schedule`, na.rm = TRUE) # mediana (valor central)
## [1] 715.5
min(datos$`Master Fee Schedule`, na.rm = TRUE) # mínimo
## [1] 0.01
max(datos$`Master Fee Schedule`, na.rm = TRUE) # máximo
## [1] 18078
sd(datos$`Master Fee Schedule`, na.rm = TRUE) # desviación estándar
## [1] 2016.679
# Operación con dplyr: TOP 10 procedimientos MÁS COSTOSOS según la tarifa lista.
# El operador "%>%" (pipe) encadena pasos y se lee como "y luego...".
top10_costosos <- datos %>%
arrange(desc(`Master Fee Schedule`)) %>% # ordenar de mayor a menor
select(`CPT Code`, `Procedure Description`, `Master Fee Schedule`) %>%
head(10) # tomar los 10 primeros
print(top10_costosos)
## CPT Code Procedure Description
## 1 39503 39503 Rpr Neon Diaph Hernia WWO Ch Tube
## 2 39503 39503 Rpr Neon Diaph Hernia WWO Ch Tube
## 3 39503 39503 Rpr Neon Diaph Hernia WWO Ch Tube
## 4 33945 33945 Heart Transplant With or Without Recipient Cardiectomy
## 5 33945 33945 Heart Transplant With or Without Recipient Cardiectomy
## 6 33945 33945 Heart Transplant With or Without Recipient Cardiectomy
## 7 33945 33945 Heart Transplant With or Without Recipient Cardiectomy
## 8 33507 33507 Rpr Anom Aor Orig Coronary Artery
## 9 33507 33507 Rpr Anom Aor Orig Coronary Artery
## 10 33507 33507 Rpr Anom Aor Orig Coronary Artery
## Master Fee Schedule
## 1 18078
## 2 18078
## 3 18078
## 4 17290
## 5 17290
## 6 17290
## 7 17290
## 8 15143
## 9 15143
## 10 15143
# --- 3.3 GRÁFICOS ----------------------------------------------------------
# (a) HISTOGRAMA: cómo se distribuyen las tarifas lista.
# Usamos un tope de 8000 USD en el eje X para que el gráfico sea legible
# (hay valores extremos muy altos que aplastarían la figura).
ggplot(datos, aes(x = `Master Fee Schedule`)) +
geom_histogram(bins = 40, fill = "#2c7fb8", color = "white") +
coord_cartesian(xlim = c(0, 8000)) +
labs(title = "Distribución de la tarifa lista del hospital",
subtitle = "Children's Minnesota — cargos profesionales 2022",
x = "Tarifa lista (USD)", y = "Número de procedimientos") +
theme_minimal()
# (b) GRÁFICO DE BARRAS: los 10 procedimientos más costosos.
# reorder() ordena las barras por precio; coord_flip() las pone horizontales.
ggplot(top10_costosos,
aes(x = reorder(`Procedure Description`, `Master Fee Schedule`),
y = `Master Fee Schedule`)) +
geom_col(fill = "#d95f0e") +
coord_flip() +
labs(title = "Top 10 procedimientos más costosos (tarifa lista)",
x = NULL, y = "Tarifa lista (USD)") +
theme_minimal()
###############################################################################
# SECCIÓN 4. FUNCIONES INTERMEDIAS: LÓGICAS + BUCLE (con propósito claro) #
###############################################################################
# OBJETIVO DE ESTA SECCIÓN:
# 1) Usar un BUCLE "for" para convertir a número las 14 columnas de aseguradores
# de una sola vez (en lugar de escribir 14 líneas casi idénticas).
# 2) Usar FUNCIONES LÓGICAS (ifelse, %in%) para CLASIFICAR los procedimientos.
# 3) Calcular, con el mismo bucle, un indicador de gestión: qué proporción de
# la tarifa lista paga, en promedio, cada asegurador.
# --- 4.1 Identificar las columnas de aseguradores -------------------------
# Son todas las columnas de precio EXCEPTO la tarifa lista. Las nombramos
# explícitamente para tener control total sobre qué se procesa.
aseguradores <- c("Blue Cross Blue Shield MN", "HealthPartners",
"Medica Choice", "Medica Elect", "Medica Narrow",
"Preferred One", "Preferred One PPO", "United Health",
"Allina Aetna", "America's PPO", "Laborcare",
"MultiPlan", "SelectCare", "Ucare QHP")
# --- 4.2 BUCLE "for": convertir a número cada columna de asegurador --------
# El bucle recorre la lista "aseguradores" una por una. En cada vuelta, la
# variable "aseg" toma el nombre de un asegurador y aplicamos nuestra función
# de limpieza a esa columna. PROPÓSITO: automatizar una tarea repetitiva.
for (aseg in aseguradores) {
datos[[aseg]] <- convertir_a_numero(datos[[aseg]])
}
cat("Conversión de", length(aseguradores), "columnas de aseguradores completada.\n")
## Conversión de 14 columnas de aseguradores completada.
# --- 4.3 FUNCIÓN LÓGICA con ifelse(): clasificar por nivel de costo --------
# ifelse(condición, valor_si_VERDADERO, valor_si_FALSO) crea una nueva columna
# categórica. Usamos la mediana como umbral: por encima = "Alto costo".
umbral <- median(datos$`Master Fee Schedule`, na.rm = TRUE)
datos$Nivel_costo <- ifelse(datos$`Master Fee Schedule` > umbral,
"Alto costo", "Bajo costo")
# table() cuenta cuántos procedimientos quedaron en cada categoría.
table(datos$Nivel_costo)
##
## Alto costo Bajo costo
## 5380 5380
# --- 4.4 FUNCIÓN LÓGICA con %in%: marcar vacunas COVID-19 -----------------
# El operador "%in%" pregunta "¿está este valor dentro de esta lista?" y
# devuelve TRUE/FALSE. grepl() busca un patrón de texto dentro de una columna.
# Marcamos las filas cuya descripción CONTENGA la palabra "Covid".
datos$Es_vacuna_covid <- grepl("Covid", datos$`Procedure Description`,
ignore.case = TRUE)
cat("Registros de vacunas COVID-19 encontrados:",
sum(datos$Es_vacuna_covid), "\n")
## Registros de vacunas COVID-19 encontrados: 17
# --- 4.5 BUCLE "for" con propósito de GESTIÓN -----------------------------
# Calculamos, para cada asegurador, la PROPORCIÓN PROMEDIO que paga respecto
# a la tarifa lista del hospital. Esto es un indicador del "descuento"
# negociado: una proporción de 0.60 significa que paga, en promedio, el 60%
# de la tarifa lista. Usamos la MEDIANA (más robusta que la media frente a
# valores atípicos presentes en estos datos reales).
#
# Creamos primero una tabla vacía donde iremos guardando los resultados.
resultado <- data.frame(Asegurador = character(),
Prop_mediana = numeric(),
stringsAsFactors = FALSE)
for (aseg in aseguradores) {
# proporción pagada respecto a la tarifa lista, fila por fila
proporcion <- datos[[aseg]] / datos$`Master Fee Schedule`
# eliminamos infinitos/atípicos imposibles (cuando la tarifa lista es ~0)
proporcion <- proporcion[is.finite(proporcion) & proporcion > 0 &
proporcion < 5]
prop_med <- round(median(proporcion, na.rm = TRUE), 3)
# rbind() agrega una fila nueva a la tabla de resultados
resultado <- rbind(resultado,
data.frame(Asegurador = aseg, Prop_mediana = prop_med))
}
# Ordenamos del que paga MENOR proporción al que paga MAYOR proporción.
resultado <- resultado %>% arrange(Prop_mediana)
print(resultado)
## Asegurador Prop_mediana
## 1 MultiPlan 0.396
## 2 Ucare QHP 0.546
## 3 United Health 0.594
## 4 Medica Elect 0.600
## 5 Blue Cross Blue Shield MN 0.613
## 6 Allina Aetna 0.618
## 7 Laborcare 0.645
## 8 SelectCare 0.645
## 9 Medica Choice 0.651
## 10 America's PPO 0.670
## 11 Preferred One 0.683
## 12 HealthPartners 0.797
## 13 Medica Narrow 0.910
## 14 Preferred One PPO 0.956
# Gráfico del indicador: ranking de aseguradores por proporción pagada.
ggplot(resultado,
aes(x = reorder(Asegurador, Prop_mediana), y = Prop_mediana)) +
geom_col(fill = "#1b9e77") +
geom_hline(yintercept = 1, linetype = "dashed", color = "red") +
coord_flip() +
labs(title = "Proporción mediana pagada respecto a la tarifa lista",
subtitle = "Línea roja = 100% de la tarifa lista",
x = NULL, y = "Proporción pagada (mediana)") +
theme_minimal()
###############################################################################
# SECCIÓN 5. TAREA DISRUPTIVA (inspirada en revisión de RPubs) #
# #
# ÍNDICE DE DISPERSIÓN DE PRECIOS POR PROCEDIMIENTO #
###############################################################################
# CONTEXTO Y JUSTIFICACIÓN:
# En múltiples publicaciones de RPubs sobre análisis de costos en salud, una
# técnica recurrente y de alto valor es medir la VARIABILIDAD de un precio
# usando el COEFICIENTE DE VARIACIÓN (CV = desviación estándar / media). Aquí
# lo aplicamos de forma original a la transparencia de precios: calculamos,
# PARA CADA PROCEDIMIENTO, qué tan disperso es su precio ENTRE los 14
# aseguradores. Un CV alto significa que el MISMO servicio se paga de forma
# muy desigual según el pagador —una señal de inequidad y de oportunidad de
# negociación—. Esto convierte una base de precios estática en un TABLERO
# que prioriza dónde enfocar políticas de transparencia.
# --- 5.1 Calcular media, desviación y CV por fila (procedimiento) ---------
# apply(matriz, 1, función) aplica una función a CADA FILA (el "1" = filas).
# Construimos una matriz solo con las columnas de aseguradores.
matriz_precios <- as.matrix(datos[, aseguradores])
datos$Precio_medio <- apply(matriz_precios, 1, function(fila) {
mean(fila, na.rm = TRUE)
})
datos$Precio_desv <- apply(matriz_precios, 1, function(fila) {
sd(fila, na.rm = TRUE)
})
# Coeficiente de variación, expresado en porcentaje.
datos$CV_precio <- ifelse(datos$Precio_medio > 0,
round(100 * datos$Precio_desv / datos$Precio_medio, 1),
NA)
# --- 5.2 Ranking: procedimientos con mayor INEQUIDAD de precio ------------
# Filtramos procedimientos con un precio medio razonable (> 50 USD) para evitar
# distorsiones de montos minúsculos, y tomamos los 15 de mayor dispersión.
top_dispersos <- datos %>%
filter(Precio_medio > 50, !is.na(CV_precio)) %>%
distinct(`CPT Code`, .keep_all = TRUE) %>% # un registro por código CPT
arrange(desc(CV_precio)) %>%
select(`CPT Code`, `Procedure Description`,
Precio_medio, CV_precio) %>%
head(15)
print(top_dispersos)
## CPT Code Procedure Description
## 1 70390 70390 PF FL Sialogram
## 2 93971 PF US Duplex Venous Extrem Right Limit Port
## 3 95930 95930 Visual Evoked Potential Checker/Flash
## 4 95937 95937 Neuromuscular Junction Test (Repetitive Stim) Ea Nerve
## 5 88302 88302 Level 2 - Surgical Path
## 6 88304 88304 Level 3 - Surgical Path
## 7 88300 88300 Level 1 - Surgical Path
## 8 93922 PF US Doppler Art Extrem (ABI) Bilateral
## 9 88348 88348 Electron Microscopy, Diagnostic
## 10 93454 93454 Coronary Artery Angio Inaging Supervision and Interp
## 11 94060 94060 Spirometry Pre-Post Broncho Dilation Interp Only
## 12 93923 PF US Doppler Arteries Extrem Upper Bil Cmp
## 13 93976 PF US Duplex Organ Art/Vein Flow Limited
## 14 73615 73615 IR Arthro Ankle S&I-PF-73615
## 15 78472 PF NM Cardiac Gated Blood SGL
## Precio_medio CV_precio
## 1 24727.8682 373.6
## 2 11470.9505 371.8
## 3 8120.1118 371.6
## 4 13599.4798 371.1
## 5 1785.9988 371.0
## 6 2567.1171 370.7
## 7 951.1128 370.5
## 8 3196.3241 370.4
## 9 14225.4651 370.1
## 10 54469.0226 370.0
## 11 2895.8674 369.9
## 12 4497.5806 369.8
## 13 8065.7446 369.6
## 14 5738.9739 369.6
## 15 9098.7433 369.4
# --- 5.3 Visualización del tablero de dispersión --------------------------
ggplot(top_dispersos,
aes(x = reorder(`Procedure Description`, CV_precio), y = CV_precio)) +
geom_col(fill = "#7570b3") +
coord_flip() +
labs(title = "Procedimientos con mayor dispersión de precio entre aseguradores",
subtitle = "Coeficiente de variación alto = mismo servicio, precios muy desiguales",
x = NULL, y = "Coeficiente de variación (%)") +
theme_minimal()
# --- 5.4 Conclusión analítica (interpretación para el lector) -------------
# Los procedimientos en la parte superior del gráfico son aquellos donde un
# mismo servicio se paga de manera más desigual dependiendo del asegurador.
# Desde la administración en salud, ESTOS son los procedimientos prioritarios
# para auditar contratos, exigir transparencia y renegociar tarifas, porque es
# donde la falta de estandarización de precios es más marcada.
###############################################################################
# SECCIÓN 6. GUARDAR RESULTADOS #
###############################################################################
# Guardamos la base ya limpia y enriquecida en un nuevo archivo .csv, por si
# el docente desea revisar el resultado del procesamiento.
# El archivo se creará en tu directorio de trabajo (el de la Sección 0).
write.csv(datos, "base_procesada_resultado.csv", row.names = FALSE)
cat("\nArchivo 'base_procesada_resultado.csv' guardado correctamente.\n")
##
## Archivo 'base_procesada_resultado.csv' guardado correctamente.
cat("FIN DEL SCRIPT.\n")
## FIN DEL SCRIPT.
###############################################################################
# FIN DEL TRABAJO #
###############################################################################