Files
MBS/PROYECTO/vedir/veprrp062.4gl
T

385 lines
16 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : VEPRRP062
OBJETIVO : Margen de Beneficio por Grupo de Productos (Gerencia).
Matriz Grupo x Ano (2020..2026) con Ventas Netas,
Costo de Ventas (costo estandar iptb00004), Margen RD$,
Margen % y Compras (informativo, cotb00014/cotb00015).
PROGRAMADOR : Ing. Juan Soto (Johnny) / Asistido
FECHA REALIZACION : Agosto 10, 2026
NOTA PERFORMANCE : No usa la vista ventas_facturas_c_costo (20 tablas).
Empuja el filtro cod_grupo directo sobre vetb00003 y
elimina los joins de cliente/vendedor/zona que no se
agregan, agregando a nivel grupo x ano.
-------------------------------------------------------------------------------
}
GLOBALS "veprgb000.4gl"
DEFINE ano_ini, ano_fin INTEGER,
grupos_txt CHAR(40),
cod_usd SMALLINT -- cod_mon (cotb00031) que representa USD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT TO "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL veprrp062()
END MAIN
FUNCTION veprrp062()
DEFINE w RECORD -- fila cruda de la consulta (grupo x ano)
cod_grupo SMALLINT,
grupo CHAR(40),
ano SMALLINT,
ventas DECIMAL(18,2),
costo DECIMAL(18,2),
compras DECIMAL(18,2)
END RECORD
-- Acumuladores en memoria: [indice_grupo, indice_ano] (ano 1=2020 .. 7=2026)
DEFINE mvent, mmarg, mcomp ARRAY[12,7] OF DECIMAL(18,2)
DEFINE mgcod ARRAY[12] OF SMALLINT
DEFINE mgnom ARRAY[12] OF CHAR(40)
DEFINE tvent, tmarg, tcomp ARRAY[7] OF DECIMAL(18,2) -- totales por ano (todos los grupos)
DEFINE ngr, gi, yy, yidx SMALLINT
DEFINE vtot, mtot DECIMAL(18,2)
-- Registro de salida al reporte: UNA fila por grupo, anos 2020..2026 en columnas.
-- pN = margen % del ano N ; cN = compras RD$ del ano N ; ptot/ctot = totales de la fila
DEFINE g RECORD
cod_grupo SMALLINT,
grupo CHAR(40),
p1 DECIMAL(9,2), c1 DECIMAL(18,2),
p2 DECIMAL(9,2), c2 DECIMAL(18,2),
p3 DECIMAL(9,2), c3 DECIMAL(18,2),
p4 DECIMAL(9,2), c4 DECIMAL(18,2),
p5 DECIMAL(9,2), c5 DECIMAL(18,2),
p6 DECIMAL(9,2), c6 DECIMAL(18,2),
p7 DECIMAL(9,2), c7 DECIMAL(18,2),
ptot DECIMAL(9,2), ctot DECIMAL(18,2),
mrd DECIMAL(18,2), -- margen RD$ total del grupo
m1 DECIMAL(18,2), m2 DECIMAL(18,2), m3 DECIMAL(18,2), m4 DECIMAL(18,2),
m5 DECIMAL(18,2), m6 DECIMAL(18,2), m7 DECIMAL(18,2), -- margen RD$ por ano (grafico de barras)
v1 DECIMAL(18,2), v2 DECIMAL(18,2), v3 DECIMAL(18,2), v4 DECIMAL(18,2),
v5 DECIMAL(18,2), v6 DECIMAL(18,2), v7 DECIMAL(18,2), -- ventas netas RD$ por ano
vtotv DECIMAL(18,2) -- ventas netas total del grupo
END RECORD
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM vefmrp062 FROM "vefmrp062"
DISPLAY FORM vefmrp062
LET ano_ini = 2020
LET ano_fin = YEAR(TODAY)
LET grupos_txt = "657, 658, 668"
LET cod_usd = 2 -- <-- ajustar si el cod_mon de USD no es 2
DISPLAY BY NAME grupos_txt
INPUT BY NAME ano_ini, ano_fin WITHOUT DEFAULTS
AFTER FIELD ano_ini
IF ano_ini IS NULL OR ano_ini < 1990 THEN
CALL msg(16)
NEXT FIELD ano_ini
END IF
AFTER FIELD ano_fin
IF ano_fin IS NULL OR ano_fin < ano_ini THEN
CALL msg(16)
NEXT FIELD ano_fin
END IF
AFTER INPUT
IF int_flag THEN
LET int_flag = FALSE
CALL msg(2)
RETURN
END IF
IF ano_ini IS NULL OR ano_fin IS NULL OR ano_fin < ano_ini THEN
CALL msg(16)
NEXT FIELD ano_ini
END IF
EXIT INPUT
END INPUT
IF int_flag THEN
LET int_flag = FALSE
CALL msg(2)
RETURN
END IF
----------------------------------------------------------------------
-- Consulta magra: VENTAS (+) UNION ALL NOTAS DE CREDITO (-) UNION ALL
-- COMPRAS (informativo). Todo filtrado por cod_grupo y rango de anos.
----------------------------------------------------------------------
LET selec =
"SELECT t.cod_grupo, ISNULL(m.descripcion,'(SIN DESCRIP)'), t.ano, ",
" SUM(t.neto), SUM(t.costo), SUM(t.compras) ",
"FROM ( ",
--------------------------- VENTAS ---------------------------------
" SELECT j.cod_grupo AS cod_grupo, b.ano AS ano, ",
" (j.cantidad*j.precio - (j.cantidad*j.precio)*(j.cantidad_2/100)) * k.tasa AS neto, ",
" j.cantidad * (ISNULL(c.material,0)+ISNULL(c.labor,0)+ISNULL(c.gastos,0)) AS costo, ",
" CAST(0 AS DECIMAL(18,2)) AS compras ",
" FROM vetb00002 a ",
" INNER JOIN prdtable b ON a.fecha_factura BETWEEN b.fecha_inicio AND b.fecha_corte ",
" INNER JOIN vetb00003 j ON j.factura = a.factura AND j.sucid = a.sucid ",
" INNER JOIN cgtb00084 k ON k.ventas = a.ventas AND k.tipo_cliente = a.tipo_cliente ",
" AND k.ano = b.ano AND k.mes = b.mes ",
" LEFT OUTER JOIN iptb00004 c ON c.cod_n=j.cod_n AND c.cod_grupo=j.cod_grupo ",
" AND c.cod_tipo=j.cod_tipo AND c.cod_sec=j.cod_sec ",
" AND c.ano=b.ano AND c.status_t IS NULL ",
" WHERE a.status_t IS NULL ",
" AND j.cod_grupo IN (657,658,668) ",
" AND b.ano BETWEEN ? AND ? ",
" UNION ALL ",
---------------------- NOTAS DE CREDITO ----------------------------
" SELECT j.cod_grupo AS cod_grupo, b.ano AS ano, ",
" (q.cantidad_2*j.precio - (q.cantidad_2*j.precio)*(j.cantidad_2/100)) * k.tasa * -1 AS neto, ",
" q.cantidad_2 * (ISNULL(c.material,0)+ISNULL(c.labor,0)+ISNULL(c.gastos,0)) * -1 AS costo, ",
" CAST(0 AS DECIMAL(18,2)) AS compras ",
" FROM vetb00002 a ",
" INNER JOIN vetb00003 j ON j.factura = a.factura AND j.sucid = a.sucid ",
" INNER JOIN iptb00006 q ON q.cod_mov IN (12,13) ",
" AND q.cod_n=j.cod_n AND q.cod_grupo=j.cod_grupo ",
" AND q.cod_tipo=j.cod_tipo AND q.cod_sec=j.cod_sec ",
" AND q.factura=j.factura AND q.cod_sp=a.tipo_cliente ",
" AND q.cod_sp_sec=a.sec_cliente AND q.status_t IS NULL ",
" INNER JOIN cctb00001 x1 ON x1.num_cheque=q.num_doc AND x1.tipo_doc='NC' ",
" AND x1.status_t IS NULL AND x1.banco=q.cod_mov ",
" AND x1.tipo_cliente=q.cod_sp AND x1.sec_cliente=q.cod_sp_sec ",
" INNER JOIN prdtable b ON x1.fecha_orig BETWEEN b.fecha_inicio AND b.fecha_corte ",
" INNER JOIN cgtb00084 k ON k.ventas = a.ventas AND k.tipo_cliente = a.tipo_cliente ",
" AND k.ano = b.ano AND k.mes = b.mes ",
" LEFT OUTER JOIN iptb00004 c ON c.cod_n=j.cod_n AND c.cod_grupo=j.cod_grupo ",
" AND c.cod_tipo=j.cod_tipo AND c.cod_sec=j.cod_sec ",
" AND c.ano=b.ano AND c.status_t IS NULL ",
" WHERE a.status_t IS NULL ",
" AND j.cod_grupo IN (657,658,668) ",
" AND b.ano BETWEEN ? AND ? ",
" UNION ALL ",
----------------------- COMPRAS (informativo, en RD$) --------------
-- Si la OC es en USD (cod_mon = cod_usd) se convierte a RD$ con la
-- tasa financiera mensual de cgtb00084 (ventas=3, por ano y mes de la
-- OC). fx agrega la tasa a UNA fila por ano/mes (cgtb00084 tiene
-- tipo_cliente en su llave) para no duplicar las compras. Cascada de
-- respaldo: tasa mensual -> tasa del maestro de monedas -> 1.
" SELECT d.cod_grupo AS cod_grupo, b.ano AS ano, ",
" CAST(0 AS DECIMAL(18,2)) AS neto, ",
" CAST(0 AS DECIMAL(18,2)) AS costo, ",
" ((d.cantidad*d.precio) - ISNULL(d.monto_desc,0)) * ",
" CASE WHEN d.cod_mon = ", cod_usd USING "<<<<", " ",
" THEN COALESCE(fx.tasa, cm.tasa_cambio, 1) ELSE 1 END AS compras ",
" FROM cotb00015 d ",
" INNER JOIN cotb00014 h ON h.num_oc = d.num_oc ",
" INNER JOIN prdtable b ON h.fech_oc BETWEEN b.fecha_inicio AND b.fecha_corte ",
" LEFT OUTER JOIN ( SELECT ano, mes, MAX(tasa) AS tasa FROM cgtb00084 ",
" WHERE ventas = 3 GROUP BY ano, mes ) fx ",
" ON fx.ano = b.ano AND fx.mes = b.mes ",
" LEFT OUTER JOIN cotb00031 cm ON cm.cod_mon = d.cod_mon ",
" WHERE d.cod_grupo IN (657,658,668) ",
" AND h.status_t IS NULL ",
" AND d.status_t IS NULL ",
" AND b.ano BETWEEN ? AND ? ",
") t ",
"LEFT OUTER JOIN iptb00029 m ON m.cod_grupo = t.cod_grupo ",
"GROUP BY t.cod_grupo, m.descripcion, t.ano ",
"ORDER BY t.cod_grupo, t.ano "
PREPARE busca_margen FROM selec
DECLARE cur_margen CURSOR FOR busca_margen
-- Inicializar acumuladores
LET ngr = 0
FOR gi = 1 TO 12
LET mgcod[gi] = 0
FOR yy = 1 TO 7
LET mvent[gi,yy] = 0
LET mmarg[gi,yy] = 0
LET mcomp[gi,yy] = 0
END FOR
END FOR
-- Leer la consulta y PIVOTAR por grupo/ano en memoria
FOREACH cur_margen USING ano_ini, ano_fin,
ano_ini, ano_fin,
ano_ini, ano_fin
INTO w.cod_grupo, w.grupo, w.ano,
w.ventas, w.costo, w.compras
IF w.ventas IS NULL THEN LET w.ventas = 0 END IF
IF w.costo IS NULL THEN LET w.costo = 0 END IF
IF w.compras IS NULL THEN LET w.compras = 0 END IF
LET yidx = w.ano - 2019 -- 2020->1 ... 2026->7
IF yidx < 1 OR yidx > 7 THEN
CONTINUE FOREACH
END IF
LET gi = 0
FOR yy = 1 TO ngr
IF mgcod[yy] = w.cod_grupo THEN
LET gi = yy
EXIT FOR
END IF
END FOR
IF gi = 0 THEN
LET ngr = ngr + 1
LET gi = ngr
LET mgcod[gi] = w.cod_grupo
LET mgnom[gi] = w.grupo
END IF
LET mvent[gi,yidx] = mvent[gi,yidx] + w.ventas
LET mmarg[gi,yidx] = mmarg[gi,yidx] + (w.ventas - w.costo)
LET mcomp[gi,yidx] = mcomp[gi,yidx] + w.compras
END FOREACH
IF ngr = 0 THEN
CALL fgl_winmessage("INFO",
"No se encontraron datos para los grupos 657/658/668 en el rango indicado.",
"info")
RETURN
END IF
-- Totales por ano (suma de todos los grupos)
FOR yy = 1 TO 7
LET tvent[yy] = 0
LET tmarg[yy] = 0
LET tcomp[yy] = 0
END FOR
FOR gi = 1 TO ngr
FOR yy = 1 TO 7
LET tvent[yy] = tvent[yy] + mvent[gi,yy]
LET tmarg[yy] = tmarg[yy] + mmarg[gi,yy]
LET tcomp[yy] = tcomp[yy] + mcomp[gi,yy]
END FOR
END FOR
-- Configuracion del motor de reportes (.4rp)
LET r_filename = "veprrp062.4rp"
LET preview = TRUE
IF NOT fgl_report_loadCurrentSettings(r_filename) THEN
CALL fgl_winmessage("INFO",
"No se pudo cargar el diseno veprrp062.4rp", "stop")
RETURN
END IF
CALL seleccionarSalida() RETURNING r_output
CALL fgl_report_selectDevice(r_output)
CALL fgl_report_selectPreview(preview)
IF r_output = "XLSX" THEN
CALL fgl_report_configurexlsxdevice(NULL,NULL,NULL,FALSE,FALSE,NULL,1)
END IF
LET handler = fgl_report_commitCurrentSettings()
IF handler IS NULL THEN
RETURN
END IF
START REPORT margen TO XML HANDLER handler
-- Una fila por grupo
FOR gi = 1 TO ngr
LET g.cod_grupo = mgcod[gi]
LET g.grupo = mgnom[gi]
LET g.p1 = pct_calc(mmarg[gi,1], mvent[gi,1]) LET g.c1 = mcomp[gi,1]
LET g.p2 = pct_calc(mmarg[gi,2], mvent[gi,2]) LET g.c2 = mcomp[gi,2]
LET g.p3 = pct_calc(mmarg[gi,3], mvent[gi,3]) LET g.c3 = mcomp[gi,3]
LET g.p4 = pct_calc(mmarg[gi,4], mvent[gi,4]) LET g.c4 = mcomp[gi,4]
LET g.p5 = pct_calc(mmarg[gi,5], mvent[gi,5]) LET g.c5 = mcomp[gi,5]
LET g.p6 = pct_calc(mmarg[gi,6], mvent[gi,6]) LET g.c6 = mcomp[gi,6]
LET g.p7 = pct_calc(mmarg[gi,7], mvent[gi,7]) LET g.c7 = mcomp[gi,7]
LET vtot = mvent[gi,1]+mvent[gi,2]+mvent[gi,3]+mvent[gi,4]+mvent[gi,5]+mvent[gi,6]+mvent[gi,7]
LET mtot = mmarg[gi,1]+mmarg[gi,2]+mmarg[gi,3]+mmarg[gi,4]+mmarg[gi,5]+mmarg[gi,6]+mmarg[gi,7]
LET g.ctot = mcomp[gi,1]+mcomp[gi,2]+mcomp[gi,3]+mcomp[gi,4]+mcomp[gi,5]+mcomp[gi,6]+mcomp[gi,7]
LET g.ptot = pct_calc(mtot, vtot)
LET g.mrd = mtot -- margen RD$ total del grupo
LET g.m1 = mmarg[gi,1] LET g.m2 = mmarg[gi,2] LET g.m3 = mmarg[gi,3] LET g.m4 = mmarg[gi,4]
LET g.m5 = mmarg[gi,5] LET g.m6 = mmarg[gi,6] LET g.m7 = mmarg[gi,7]
LET g.v1 = mvent[gi,1] LET g.v2 = mvent[gi,2] LET g.v3 = mvent[gi,3] LET g.v4 = mvent[gi,4]
LET g.v5 = mvent[gi,5] LET g.v6 = mvent[gi,6] LET g.v7 = mvent[gi,7]
LET g.vtotv = vtot
OUTPUT TO REPORT margen(g.*)
END FOR
-- Fila TOTAL GENERAL (todos los grupos)
LET g.cod_grupo = 0
LET g.grupo = "TOTAL GENERAL"
LET g.p1 = pct_calc(tmarg[1], tvent[1]) LET g.c1 = tcomp[1]
LET g.p2 = pct_calc(tmarg[2], tvent[2]) LET g.c2 = tcomp[2]
LET g.p3 = pct_calc(tmarg[3], tvent[3]) LET g.c3 = tcomp[3]
LET g.p4 = pct_calc(tmarg[4], tvent[4]) LET g.c4 = tcomp[4]
LET g.p5 = pct_calc(tmarg[5], tvent[5]) LET g.c5 = tcomp[5]
LET g.p6 = pct_calc(tmarg[6], tvent[6]) LET g.c6 = tcomp[6]
LET g.p7 = pct_calc(tmarg[7], tvent[7]) LET g.c7 = tcomp[7]
LET vtot = tvent[1]+tvent[2]+tvent[3]+tvent[4]+tvent[5]+tvent[6]+tvent[7]
LET mtot = tmarg[1]+tmarg[2]+tmarg[3]+tmarg[4]+tmarg[5]+tmarg[6]+tmarg[7]
LET g.ctot = tcomp[1]+tcomp[2]+tcomp[3]+tcomp[4]+tcomp[5]+tcomp[6]+tcomp[7]
LET g.ptot = pct_calc(mtot, vtot)
LET g.mrd = 0
LET g.m1=0 LET g.m2=0 LET g.m3=0 LET g.m4=0 LET g.m5=0 LET g.m6=0 LET g.m7=0 -- TOTAL sin barras
LET g.v1 = tvent[1] LET g.v2 = tvent[2] LET g.v3 = tvent[3] LET g.v4 = tvent[4]
LET g.v5 = tvent[5] LET g.v6 = tvent[6] LET g.v7 = tvent[7]
LET g.vtotv = vtot
OUTPUT TO REPORT margen(g.*)
FINISH REPORT margen
END FUNCTION
FUNCTION pct_calc(m, v)
DEFINE m, v DECIMAL(18,2)
IF v <> 0 THEN
RETURN (m / v) * 100
END IF
RETURN 0
END FUNCTION
REPORT margen(x)
DEFINE x RECORD
cod_grupo SMALLINT,
grupo CHAR(40),
p1 DECIMAL(9,2), c1 DECIMAL(18,2),
p2 DECIMAL(9,2), c2 DECIMAL(18,2),
p3 DECIMAL(9,2), c3 DECIMAL(18,2),
p4 DECIMAL(9,2), c4 DECIMAL(18,2),
p5 DECIMAL(9,2), c5 DECIMAL(18,2),
p6 DECIMAL(9,2), c6 DECIMAL(18,2),
p7 DECIMAL(9,2), c7 DECIMAL(18,2),
ptot DECIMAL(9,2), ctot DECIMAL(18,2),
mrd DECIMAL(18,2),
m1 DECIMAL(18,2), m2 DECIMAL(18,2), m3 DECIMAL(18,2), m4 DECIMAL(18,2),
m5 DECIMAL(18,2), m6 DECIMAL(18,2), m7 DECIMAL(18,2),
v1 DECIMAL(18,2), v2 DECIMAL(18,2), v3 DECIMAL(18,2), v4 DECIMAL(18,2),
v5 DECIMAL(18,2), v6 DECIMAL(18,2), v7 DECIMAL(18,2),
vtotv DECIMAL(18,2)
END RECORD
DEFINE hora CHAR(8)
DEFINE fecha_rep CHAR(10)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM MARGIN 4
FORMAT
FIRST PAGE HEADER
LET hora = CURRENT HOUR TO SECOND
LET fecha_rep = TODAY USING "dd/mm/yyyy"
PRINTX p_companias.nombre, hora, fecha_rep
ON EVERY ROW
PRINTX x.grupo,
x.p1, x.c1, x.p2, x.c2, x.p3, x.c3, x.p4, x.c4,
x.p5, x.c5, x.p6, x.c6, x.p7, x.c7,
x.ptot, x.ctot, x.mrd,
x.m1, x.m2, x.m3, x.m4, x.m5, x.m6, x.m7,
x.v1, x.v2, x.v3, x.v4, x.v5, x.v6, x.v7, x.vtotv
END REPORT