library(ggplot2)
library(tidyr)
library(dplyr)
library(tidyr)
library(glmnet)
library(dplyr)
library(plm)
library(rmarkdown)
library(data.table)
library(dummies)
library(readxl)
library(stargazer)
library(stringr)
library(gsubfn)
library(fuzzyjoin)rm(list = ls())
setwd("C:/O/OneDrive - DCCP/Catálogo de Insumos Médicos")
proveedores <- read.csv("insumos_medicos.csv", sep=";")
load("mp.RData")
load("trx_insumos_cm.RData")tp_insumos <- c("ACCESORIO DE IMPRESIÓN DENTAL",
"APÓSITO",
"AGUJA",
"ALARGADOR ARTERIAL",
"BRACE",
"GUANTE LATEX",
"GUANTE NITRILO",
"ADHESIVOS IMPRESIÓN DENTAL",
"AGUJA HIPODERMICA CONTROLADA",
"CAGE",
"CINTA ESTERILIZACIÓN",
"CONTENEDOR DESECHABLE",
"ENVOLTURA ",
"CATÉTER DE SUCCIÓN",
"BOBINA DE ESTERILIZACIÓN",
"BANDEJA DE CURACIÓN ",
"FRESA DENTAL",
"GUANTE NEOPRENO",
"ALARGADOR VENOSO",
"AMALGAMA",
"ADHESIVO",
"ALGODÓN",
"ELECTROBISTURI",
"COMPOSITE",
"BARRAS",
"CINTA ADHESIVA MEDICA",
"EQUIPO SCALP-VEIN",
"ESCALPELO",
"ELECTRODO",
"GASA",
"KIT DE ESTERILIZACIÓN",
"COMPRESA FRIA",
"KIT ENDOPRÓTESIS DE COLUMNA VERTEBRAL",
"JERINGA HIPODERMICA CONTROLADA",
"FIJACION",
"EQUIPO PARA ADMINISTRAR SOLUCIONES",
"BOLSA PARA SANGRE",
"INJERTO",
"KIT DE INSTRUMENTAL DE COLUMNA",
"TORNILLO",
"EQUIPO AUTOCLAVE ",
"GUANTE VINILO",
"LLAVE DE TRES PASOS",
"MASCARILLA",
"AEROCAMARA",
"PARCHE MÉDICO",
"MASCARILLA DESECHABLE",
"SUTURA",
"HIDROGEL",
"PLACAS",
"PLANA QUIRÚRGICA",
"SUSTITUTO OSEO",
"TROCAR QUIRÚRGICO ",
"CANULA TRAQUEOSTOMIA",
"PROTESIS TRANSFEMORAL",
"PROTESIS TRANSHUMERAL",
"COMPRESA RADIO OPACA",
"PRESERVATIVO LATEX",
"ENGRAPADORA",
"KIT ENDOPROTESIS DE CADERA",
"ORTESIS DE TRONCO",
"JERINGA",
"PINZA QUIRÚRGICA",
"TIJERA QUIRÚRGICA",
"CATÉTER INTRAVENOSO",
"TUBO ENDOTRAQUEAL",
"KIT ENDOPROTESIS DE RODILLA",
"CALZADO ORTOPEDICO",
"CANULA",
"GORRO",
"FRASCO HUMIDIFICADOR",
"RESUCITADOR MANUAL",
"VENDA CON YESO",
"VENDA",
"PROTESIS DE MANO",
"BOLSA DE ASPIRACIÓN",
"MOLDE QUIRURGICO",
"COTILO",
"JERINGA PARA INSULINA",
"VASTAGO",
"MANGAS DE COMPRESIÓN",
"SONDA PARA OXÍGENO",
"SELLANTE FOTOCURADO",
"TUBO PARA ESTERILIZACIÓN",
"GUANTE POLISOPRENO",
"PAPEL PARA ESTERILIZACIÓN",
"VIDRIO IONOMERO",
"PLANTILLA ORTOPEDICA",
"MEDIAS ANTIEMBÓLICAS",
"ESTILETE DE INTUBACIÓN",
"MASCARILLA LARINGEA",
"SONDA PROSTÁTICA",
"INMOVILIZADOR DE MUÑECA",
"ORTESIS TOBILLO PIE",
"TAPA DE OBTURACIÓN",
"ACCESORIOS DE ORTODONCIA",
"LIMPIADOR DE HERIDAS",
"ORTESIS OTP LARGA",
"FERULA ESTABILIZADORA DE CODO",
"PULSERA DE IDENTIFICACIÓN",
"CONECTOR",
"SONDA ALIMENTACION",
"GANCHOS",
"LAPIZ MARCADOR DE PIEL",
"ESTETOSCOPIO",
"SONDA NELATON",
"SENSOR RADIOLÓGICO DENTAL",
"PROTESIS TRANSRADIAL",
"ALCOHOL",
"TERMÓMETRO",
"SONDA DE ASPIRACIÓN",
"SONDA NASOGASTRICA",
"COLLAR CERVICAL",
"HOJA DE BISTURI",
"ESTABILIZADOR DE PULGAR",
"ORTESIS DE CADERA",
"SELLADOR DE ESTERILIZACIÓN",
"PROTESIS TRANSTIBIAL",
"NEBULIZADOR",
"PASTA DE ODONTOLOGÍA ",
"MALLA PARA HERNIA",
"QUITA SUTURA",
"LAPIZ ELECTROBISTURI",
"GEL ECOGRAFÍA",
"ELECTRODO DE RETORNO",
"CABEZA",
"PRESERVATIVO POLIURETANO",
"DETERGENTES ENZIMÁTICOS",
"LIMPIADOR DE ELECTROBISTURI",
"CATETER PERCUTANEO",
"VENDAJE DE PETROLATUM",
"EQUIPO ASPIRACION CONTINUA",
"PELICULA RADIOLOGICA",
"BAJA LENGUA",
"TROCAR PUNCIÓN LUMBAR",
"DESFIBRILADOR",
"CATETER VENOSO CENTRAL",
"CIRCUITO DE VENTILACIÓN",
"MONITOR SIGNOS VITALES",
"MONITOR MULTIPARAMETRICO",
"ORTESIS DE DEDO",
"CIRCUITO DE ANESTESIA",
"BATERIA DESFIBRILADOR",
"CEPILLO LIMPIEZA",
"FILTRO TRAQUEOSTOMÍA",
"INSERTO",
"NIPLE",
"FRASCO ATRAPA-POLIPOS",
"GUIA",
"COMPONENTE PATELAR",
"COMPONENTE TIBIAL",
"CATETER ARTERIAL",
"KIT ENDOPROTESIS DE HOMBRO",
"ESCAFANDRA",
"COMPONENTE FEMORAL",
"KIT ANESTESIA",
"GUANTE DE ASEO",
"ELECTROCARDIOGRAFO",
"PAPEL ELECTROCARDIOGRAMA",
"BABERO DESECHABLE",
"BRAZALETE TENSIOMETRO",
"GUANTE ACRILONITRILO-BUTADIENO",
"HUINCHA PARA PULIDO",
"STENT",
"VALVULA BIOPSIA",
"CINTA COLESTEROL",
"ASA POLIPECTOMIA",
"AGUJA DE INYECCIÓN",
"PAPILOTOMO",
"LAMPARA FOTOCURADO",
"FIJACION CROSSLINK",
"MATERIAL FABRICACION ORTESIS",
"MANTA TÉRMINA CLÍNICA",
"REPLASTIFICADO CAVIDAD",
"LIGADOR DE BANDAS",
"MALLA",
"SURECLIP",
"CAMBIO DE CABLE",
"PROTESIS MIEMBRO INFERIOR CONVENCIONAL",
"CAMBIO DE LINER DE SILICONA",
"PROTESIS DESARTICULADO DE RODILLA",
"CAMBIO DE SOCKET",
"REPLASTIFICADO MANO",
"PROTESIS DESARTICULADO CADERA",
"CAMBIO DE HOMBRO",
"PROTESIS CADERA",
"ISQUIOPIE CON ANILLO",
"ISQUIOPIE BLOQUEO DE PALANCA",
"FERULA EXTENSORA DINAMICA",
"PROTESIS MIEMBRO SUPERIOR DESARTICULADO",
"PROTESIS DE HOMBRO",
"ESPUMAS DETERGENTES",
"CAMBIO DE CAVIDAD TRANSTIBIAL",
"CAMBIO DE SUJECION",
"PROTESIS PIE",
"CAMBIO DE RODILLA",
"OTP METALICA CON ZAPATO",
"CLAMP UMBILICAL",
"GRAPA",
"TABLETAS REVELADORAS DE PLACA BACTERIANA",
"PROTESIS BILIAL",
"PLANTILLA CON SOPORTE DE TOBILLO",
"PROTESIS CONVENCIONAL PIE DINAMICO",
"TRIDENT",
"COMPONENTE ROTULIANO",
"CAMBIO DE INTERFASE",
"KIT DE INSTRUMENTAL DE PIE",
"CEPILLO CITOLOGÍA",
"BALON DE DILATACIÓN",
"TUERCA",
"ENDOPRÓTESIS BARRAS PECTUM",
"PROTESIS MODULAR PIE DINAMICO",
"LUBRICANTE INSTRUMENTAL",
"Guante",
"Escudo Facial",
"Vestuario Médico",
"Tubo para Toma de Muestras",
"Mariposa Scalp-vein",
"Kit de Curación",
"Curación de Heridas",
"Toallita impregnada alcohol",
"Cinta Adhesiva Médica",
"Solución para el Lavado de Heridas",
"Alargador",
"Equipo de Infusión Intravenosa",
"Tapa",
"Jeringa Hipodérmica Controlada",
"Catéter Urinario",
"Cánula Mayo",
"Recolector",
"INDICADOR QUÍMICO",
"Cinta Indicadora",
"Detergente",
"Indicador Biológico",
"Equipo de Aspiración Continua",
"Trocar Quirúrgico",
"Cánula Trocar"
)
#seleccion <- lapply(tp_insumos, tolower)
seleccion <- tolower(tp_insumos)
proveedores$TIPO.DE.PRODUCTO <- tolower(proveedores$TIPO.DE.PRODUCTO)
trim <- function (x) gsub("^\\s+|\\s+$", "", x)
proveedores$TIPO.DE.PRODUCTO <- trim(proveedores$TIPO.DE.PRODUCTO)
existentes <- proveedores %>% filter(TIPO.DE.PRODUCTO %in% seleccion)
existentes$TIPO.DE.PRODUCTO <- toupper(existentes$TIPO.DE.PRODUCTO)names(mp)[1]="fecha"
Proveedores= c( "77.237.150-0", "93.745.000-1")
mp = mp %>% filter(RUT.PROVEEDOR %in% Proveedores & length(ESPECIFICACIONES.PRODUCTO)>5)
TP=existentes$TIPO.DE.PRODUCTO
cm_actual= cm_actual %>% filter(TipoProducto %in% TP & FechaOC>"01-01-2018")
mp = mp%>% filter(fecha< "30-04-2021" & fecha>"01-01-2018" ) %>% select(OC,LICITACIÃ.N,ESPECIFICACIONES.PRODUCTO,MONTO.USD)
mp= separate(data = mp,
col = OC,
into = c("n1", " n2","code"),
sep = "-")
mp = mp %>% mutate(Canal.de.compra = case_when(code=="CM11" |
code=="CM12"|
code== "CM13"|
code=="CM14"|
code=="CM15"|
code=="CM16"|
code=="CM16"|
code=="CM18"|
code=="CM19"|
code=="CM20"~ "Convenio Marco",
LICITACIÃ.N =="" & (code!="CM11" |
code!="CM12"|
code!= "CM13"|
code!="CM14"|
code!="CM15"|
code!="CM16"|
code!="CM16"|
code!="CM18"|
code!="CM19"|
code!="CM20") ~ "Trato directo",TRUE ~ "Licitacion"))
names(mp)[2]= "n2"
mp = unite(data = mp,
col = OC,
sep = "-",
n1, n2 ,code)
TD= mp %>% filter(Canal.de.compra=="Trato directo") %>% distinct(OC)
LC= mp %>% filter(Canal.de.compra=="Licitacion") %>% distinct(OC)
CM= cm_actual %>% distinct(CodigoOC)
mp = mp[!is.na(mp$ESPECIFICACIONES.PRODUCTO),]
mp = mp[!is.na(mp$OC),]
mp = mp[!is.na(mp$MONTO.USD),]
cm_actual = cm_actual[!is.na(cm_actual$Producto),]
cm_actual = cm_actual[!is.na(cm_actual$Monto..),]
cm_actual = cm_actual[!is.na(cm_actual$CodigoOC),]
mp$MONTO.USD <- lapply(mp$MONTO.USD, function(x) {
gsub("\\,", ".", x)
})
mp$MONTO.USD = as.numeric(mp$MONTO.USD)
mp= mp %>% filter(ESPECIFICACIONES.PRODUCTO!="" & MONTO.USD!="" & OC!="")
cm_actual= cm_actual %>% filter(Producto!="" & Monto..!="" & CodigoOC!="")
print(paste("Número de Tratos directo:",length(TD$OC)))## [1] "Número de Tratos directo: 20597"print(paste("Número de Licitaciones:",length(LC$OC)))## [1] "Número de Licitaciones: 47469"print(paste("Número de Convenio marco:",length(CM$CodigoOC)))## [1] "Número de Convenio marco: 50603"Licitaciones= mp %>% filter(Canal.de.compra=="Licitacion"& length(ESPECIFICACIONES.PRODUCTO)>5) %>% mutate(one=1) %>% group_by(ESPECIFICACIONES.PRODUCTO) %>% summarise(Monto=sum(as.numeric(MONTO.USD)), OC=sum(one))
cm_actual= cm_actual %>% select(CodigoOC,Producto,Monto..) %>% mutate(one=1) %>% group_by(Producto)%>% summarise(Monto=sum(Monto..), OC=sum(one))
TD= mp %>% filter(Canal.de.compra=="Trato directo" & length(ESPECIFICACIONES.PRODUCTO)>5) %>% mutate(one=1) %>% group_by(ESPECIFICACIONES.PRODUCTO) %>% summarise(Monto=sum(as.numeric(MONTO.USD)), OC=sum(one))#Stringdist CM
Engrapadoras_potenciales= existentes %>% distinct(MODELO)
names(Engrapadoras_potenciales)[1]="Producto"
Convenios_marco= stringdist_join(cm_actual, Engrapadoras_potenciales,
by = "Producto",
mode = "inner",
ignore_case = FALSE,
method = "jw",
max_dist = 99,
distance_col = "dist") %>%
group_by(Producto.y) %>%
slice_min(order_by = dist, n = 1)Engrapadoras_potenciales= existentes %>% distinct(MODELO)
names(Engrapadoras_potenciales)[1]="ESPECIFICACIONES.PRODUCTO"
LT_TD= stringdist_join(Licitaciones, Engrapadoras_potenciales,
by = "ESPECIFICACIONES.PRODUCTO",
mode = "inner",
ignore_case = FALSE,
method = "jw",
max_dist = 99,
distance_col = "dist") %>%
group_by(ESPECIFICACIONES.PRODUCTO.y) %>%
slice_min(order_by = dist, n = 1)Engrapadoras_potenciales= existentes %>% distinct(MODELO)
names(Engrapadoras_potenciales)[1]="ESPECIFICACIONES.PRODUCTO"
TD= stringdist_join(TD, Engrapadoras_potenciales,
by = "ESPECIFICACIONES.PRODUCTO",
mode = "inner",
ignore_case = FALSE,
method = "jw",
max_dist = 99,
distance_col = "dist") %>%
group_by(ESPECIFICACIONES.PRODUCTO.y) %>%
slice_min(order_by = dist, n = 1)print(paste("Número promedio de OC entre las fichas a evaluar en Tratos directo:",mean(TD$OC)))## [1] "Número promedio de OC entre las fichas a evaluar en Tratos directo: 1.848"print(paste("Número promedio de OC entre las fichas a evaluar en Licitaciones:",mean(LT_TD$OC)))## [1] "Número promedio de OC entre las fichas a evaluar en Licitaciones: 2.67843137254902"print(paste("Número promedio de OC entre las fichas a evaluar en Convenio marco:",mean(Convenios_marco$OC)))## [1] "Número promedio de OC entre las fichas a evaluar en Convenio marco: 97.2645914396887"print(paste("Monto total tranzado entre las fichas a evaluar en Tratos directo:",round(sum(TD$Monto)/1000000,2), "Millones"))## [1] "Monto total tranzado entre las fichas a evaluar en Tratos directo: 0.64 Millones"print(paste("Monto total tranzado entre las fichas a evaluar en Licitaciones:",round(sum(LT_TD$Monto)/1000000,2), "Millones"))## [1] "Monto total tranzado entre las fichas a evaluar en Licitaciones: 1.28 Millones"print(paste("Monto total tranzado entre las fichas a evaluar en Convenio marco:",round(sum(Convenios_marco$Monto)/1000000,2), "Millones"))## [1] "Monto total tranzado entre las fichas a evaluar en Convenio marco: 20999.83 Millones"Convenios_marco= Convenios_marco %>% select(Producto.y, Producto.x, Monto,OC, dist) %>% arrange(desc(dist))
names(Convenios_marco)[1]="Producto potencial"
names(Convenios_marco)[2]="Producto existente"