Files
DECOMARMOL/PROYECTOS/ipdir - Copy/ipprcs042.4gl
T
2026-09-22 20:38:51 -04:00

475 lines
16 KiB
Plaintext

{
=============================================================================
PROGRAMA : IPPRCS042.4GL
OBJETIVO : BUSCAR INFORMACION RELACIONADA A UN PRODUCTO ESPECIFICO
PROGRAMADOR : ING. JUAN SOTO
FECHA : ENERO 22,2014
============================================================================
}
GLOBALS
"ipprgb000.4gl"
DEFINE t_marca ARRAY [100] OF RECORD
cod_marca LIKE iptb00019.marca,
nombre LIKE iptb00019.nombre_marca
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT TO "sistemas" USER usuarios USING clave
CALL ipprcs042()
END MAIN
FUNCTION ipprcs042()
DEFINE p1 RECORD
pinventario char(30),
pcodn smallint,
pcodgrupo smallint,
pcodtipo smallint,
pcodsec smallint,
pfecha_inicial DATE,
pfecha_final DATE,
palmacen smallint
END RECORD
DEFINE aproveedor DYNAMIC ARRAY OF RECORD
proveedor CHAR(80),
pais CHAR(50),
num_oc INT,
fechaOrden DATE,
moneda CHAR(20),
precio DEC(12,2),
unidad CHAR(4),
cantidad DEC(12,4),
descuento DEC(12,2),
totalItem DEC(12,2),
costoLQ DEC(12,4),
costoSTD DEC(12,2),
factorLiquidacion DEC(12,2),
tasa DEC(8,2)
END RECORD,
descripcion VARCHAR(100),
entradas,salidas,existencia,pcosto,consumo DEC(12,4),
ptasa DEC(8,2)
DEFINE aprecios DYNAMIC ARRAY OF RECORD
pmoneda VARCHAR(30),
precio DEC(12,2),
factorPrecio DEC(12,2),
pcodlista SMALLINT
END RECORD,
dias,diasinventario smallint
OPEN WINDOW Fo1 WITH FORM "ipfmcs042"
DIALOG ATTRIBUTE (FIELD ORDER FORM,UNBUFFERED)
INPUT BY NAME p1.*
AFTER FIELD pfecha_inicial
LET p1.pfecha_final = TODAY
DISPLAY BY NAME p1.pfecha_inicial
ON ACTION busca_producto
IF p1.pinventario IS NULL THEN
CALL fgl_winmessage("ERROR","INVENTARIO NO PUEDE ESTAR EN BLANCO","INFO")
LET p1.pinventario = '02'
NEXT FIELD pinventario
END IF
CALL busca_prod(P1.pinventario) RETURNING p1.pcodn,p1.pcodgrupo,p1.pcodtipo,p1.pcodsec,articulos.descrip_esp
LET descripcion = articulos.descrip_esp,' ',articulos.unidad_med
DISPLAY BY NAME descripcion
AFTER FIELD pcodsec
IF p1.pinventario = '02' THEN
SELECT a.descrip_esp,a.unidad_med INTO articulos.descrip_esp,articulos.unidad_med
FROM iptb00002 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("ERROR","REGISTRO NO EXISTE","information")
NEXT FIELD pcodn
END IF
END IF
IF p1.pinventario = '01' THEN
SELECT a.descrip_esp,a.unidad_med INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("ERROR","REGISTRO NO EXISTE","information")
NEXT FIELD pcodn
END IF
# COSTO STD
LET pcosto = 0
SELECT a.costo_st INTO pcosto
FROM intb00013 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.ano = YEAR(p1.pfecha_final) AND a.status_t IS NULL
END IF
IF p1.pinventario = '03' THEN
SELECT a.descrip_esp,a.unidad_med INTO articulos.descrip_esp,articulos.unidad_med
FROM irtb00001 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("ERROR","REGISTRO NO EXISTE","information")
NEXT FIELD pcodn
END IF
# COSTO STD
LET pcosto = 0
SELECT a.costo_st INTO pcosto
FROM irtb00013 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.ano = YEAR(p1.pfecha_final) AND a.status_t IS NULL
END IF
LET descripcion = articulos.descrip_esp,' ',articulos.unidad_med
DISPLAY BY NAME descripcion
ON ACTION buscar
# busca la informacion de los proveedores
CALL aproveedor.clear()
CALL aprecios.clear()
DECLARE busca_prov CURSOR FOR
SELECT CAST(a.cod_sp AS CHAR(2))+' '+
CAST(a.cod_sp_Sec AS CHAR(8))+' '+a.nom_sp,c.nom_pais,b.num_oc,
CONVERT(CHAR(10),b.fech_oc,103),f.descrip_mon,d.precio,' ',
d.cantidad
FROM cotb00001 a,cotb00014 b,cotb00031 f,cotb00015 d, OUTER cotb00018 c
WHERE a.cod_sp = b.cod_sp AND
a.cod_sp_Sec = b.cod_sp_sec AND
a.cod_pais = c.cod_pais AND
b.tipo = p1.pinventario AND
d.cod_n = p1.pcodn AND
d.cod_grupo = p1.pcodgrupo AND
d.cod_tipo = p1.pcodtipo AND
d.cod_sec = p1.pcodsec AND
b.num_oc = d.num_oc AND
d.cod_mon = f.cod_mon AND
b.fech_oc BETWEEN p1.pfecha_inicial AND p1.pfecha_final AND
b.status_t IS NULL
LET idx = 1
FOREACH busca_prov INTO aproveedor[idx].*
IF p1.pinventario = '02' THEN
# COSTO STD
LET pcosto = 0
SELECT a.material+a.labor+a.gastos INTO pcosto
FROM iptb00004 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.ano = YEAR(aproveedor[idx].fechaOrden) AND a.status_t IS NULL
END IF
IF p1.pinventario = '01' THEN
# COSTO STD
LET pcosto = 0
SELECT a.costo_st INTO pcosto
FROM intb00013 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.ano = YEAR(aproveedor[idx].fechaOrden) AND a.status_t IS NULL
END IF
IF p1.pinventario = '03' THEN
# COSTO STD
LET pcosto = 0
SELECT a.costo_st INTO pcosto
FROM intb00013 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.ano = YEAR(aproveedor[idx].fechaOrden) AND a.status_t IS NULL
END IF
# COSTO LIQUIDACION
LET aproveedor[idx].costoLQ = 0
SELECT MAX(a.costo_lq) INTO aproveedor[idx].costoLQ
FROM cttb00013 a
WHERE a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_Sec = p1.pcodsec AND
a.tipo_orden = p1.pinventario AND
a.num_oc = aproveedor[idx].num_oc
LET ptasa = 1
SELECT AVG(a.prima_us) INTO ptasa
FROM cgtb00017 a
WHERE a.tipo = p1.pinventario AND
a.num_oc = aproveedor[idx].num_oc
LET aproveedor[idx].costoSTD = pcosto
LET aproveedor[idx].tasa = ptasa
LET aproveedor[idx].factorLiquidacion = (aproveedor[idx].precio * ptasa) / aproveedor[idx].costoLQ
LET idx = idx + 1
END FOREACH
# informacion inventarios
LET entradas = 0
LET salidas = 0
LET existencia = 0
IF p1.pinventario = '02' THEN
SELECT SUM(a.cantidad_2) INTO entradas
FROM iptb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 1 AND
a.status_t IS NULL
DISPLAY p1.*
SELECT SUM(a.cantidad_2) INTO salidas
FROM iptb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 2 AND
a.status_t IS NULL
SELECT SUM(a.cantidad_2) INTO existencia
FROM iptb00006 a
WHERE
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha <= p1.pfecha_final AND
a.status_t IS NULL
LET dias = (p1.pfecha_final - p1.pfecha_inicial)+1
LET diasinventario = (existencia/(salidas*-1))*dias
DISPLAY BY NAME entradas,salidas,existencia,diasinventario
END IF
IF p1.pinventario = '01' THEN
SELECT SUM(a.cantidad_2) INTO entradas
FROM intb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 1 AND
a.status_t IS NULL
SELECT SUM(a.cantidad_2) INTO salidas
FROM intb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 2 AND
a.status_t IS NULL
SELECT SUM(a.cantidad_2) INTO existencia
FROM intb00006 a
WHERE
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha <= p1.pfecha_final AND
a.status_t IS NULL
DISPLAY BY NAME entradas,salidas,existencia
END IF
IF p1.pinventario = '03' THEN
SELECT SUM(a.cantidad_2) INTO entradas
FROM irtb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 1 AND
a.status_t IS NULL
SELECT SUM(a.cantidad_2) INTO salidas
FROM irtb00006 a,iptb00005 b
WHERE a.cod_mov = b.cod_mov AND
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha BETWEEN p1.pfecha_inicial AND
p1.pfecha_final AND
b.status_mov = 2 AND
a.status_t IS NULL
SELECT SUM(a.cantidad_2) INTO existencia
FROM irtb00006 a
WHERE
a.cod_n = p1.pcodn AND
a.cod_grupo = p1.pcodgrupo AND
a.cod_tipo = p1.pcodtipo AND
a.cod_sec = p1.pcodsec AND
a.fecha <= p1.pfecha_final AND
a.status_t IS NULL
DISPLAY BY NAME entradas,salidas,existencia
END IF
# INFORMACION PRECIOS
DECLARE busca_precio CURSOR FOR
SELECT a.descripcion,b.precio,'0',b.cod_lista
FROM vetb00061 a,vetb00025 b
WHERE a.ventas = b.ventas AND
b.cod_n = p1.pcodn AND
b.cod_grupo = p1.pcodgrupo AND
b.cod_tipo = p1.pcodtipo AND
b.cod_sec = p1.pcodsec AND
b.status_t IS NULL
LET idx = 1
FOREACH busca_precio INTO aprecios[idx].*
LET idx = idx + 1
END FOREACH
END INPUT
DISPLAY ARRAY aproveedor TO record1.*
END DISPLAY
DISPLAY ARRAY aprecios TO record3.*
END DISPLAY
ON ACTION cancel
LET INT_FLAG = FALSE
RETURN
END DIALOG
END FUNCTION
FUNCTION busca_prod(pinventario)
DEFINE arr_prod DYNAMIC ARRAY OF RECORD
cod_n INTEGER,
cod_grupo INTEGER,
cod_tipo INTEGER,
cod_sec INTEGER,
descrip_esp CHAR(50),
unidad_med CHAR(4),
cantidad_o DEC(18,4),
cantidad_c DEC(18,4),
existencia DEC(18,4)
END RECORD,
selec_pt,criterio string,f,
pinventario,idx smallint,
pcodn,pcodgrupo,pcodtipo,pcodsec INT,
pdescripcion CHAR(100)
OPEN WINDOW busca_2 AT 8,4 WITH FORM "vefmwd100" ATTRIBUTE (BORDER,FORM LINE
FIRST + 1,PROMPT LINE LAST)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.descrip_esp FROM
cod_n,cod_grupo,cod_tipo,descrip_esp
IF pinventario = '02' THEN
LET selec_pt =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med,'0','0',SUM(b.cantidad_2) ",
" FROM iptb00002 AS a INNER JOIN iptb00001 AS c ON a.cod_n = c.cod_n AND a.cod_grupo = c.cod_grupo AND ",
" a.cod_tipo = c.cod_tipo and a.cod_Sec = c.cod_Sec LEFT OUTER JOIN ",
" iptb00006 AS b ON a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND b.status_t IS NULL ",
" WHERE a.status_t IS NULL AND ",CRITERIO CLIPPED,
" GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med ",
" ORDER BY a.descrip_esp "
END IF
IF pinventario = '01' THEN
LET selec_pt =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med,'0','0',SUM(b.cantidad_2) ",
" FROM intb00001 AS a ",
" LEFT OUTER JOIN ",
" intb00006 AS b ON a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND b.status_t IS NULL ",
" WHERE a.status_t IS NULL AND ",CRITERIO CLIPPED,
" GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med ",
" ORDER BY a.descrip_esp "
END IF
IF pinventario = '03' THEN
LET selec_pt =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med,'0','0',SUM(b.cantidad_2) ",
" FROM irtb00002 AS a ",
" LEFT OUTER JOIN ",
" irtb00006 AS b ON a.cod_n = b.cod_n AND a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND a.cod_sec = b.cod_sec AND b.status_t IS NULL ",
" WHERE a.status_t IS NULL AND ",CRITERIO CLIPPED,
" GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,a.unidad_med ",
" ORDER BY a.descrip_esp "
END IF
IF int_flag THEN
LET Int_flag = FALSE
CLOSE WINDOW busca_2
RETURN pcodn,pcodgrupo,pcodtipo,pcodsec,pdescripcion
END IF
PREPARE comando_p FROM selec_pt
DECLARE busca_2 CURSOR FOR comando_p
LET idx = 1
FOREACH busca_2 INTO arr_prod[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
DISPLAY ARRAY arr_prod TO s_prod.*
AFTER ROW
LET idx = arr_curr()
LET pcodn = arr_prod[idx].cod_n
LET pcodgrupo = arr_prod[idx].cod_grupo
LET pcodtipo = arr_prod[idx].cod_tipo
LET pcodsec = arr_prod[idx].cod_sec
LET pdescripcion = arr_prod[idx].descrip_esp
AFTER DISPLAY
EXIT DISPLAY
END DISPLAY
CLOSE WINDOW busca_2
RETURN pcodn,pcodgrupo,pcodtipo,pcodsec,pdescripcion
END FUNCTION