jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a3e88776a9b17aeeadbccd5832ddbb17b8366ecf
MBS/PROYECTO/ipdir/IPPRMT076.4gl
T
jpegueroandClaude Sonnet 5 b6085d4140 Mueve ipdir (Productos Terminados) de PROYECTOS a PROYECTO 
Instruccion de Johnny: todos los directorios de fuentes de inventario
deben migrarse de la carpeta temporal PROYECTOS a la carpeta real
PROYECTO, ya que PROYECTOS sera eliminada.

Se elimino tambien un archivo suelto sin relacion llamado "ipdir"
que existia en PROYECTO (del commit inicial) y bloqueaba el nombre
de la carpeta.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-09-04 09:29:01 -04:00

534 lines
19 KiB
Plaintext
Raw Blame History

{
==========================================================================
PROGRAMA : VEPRMT032
OBJETIVO : ADMINISTRAR LOS KIT DE LOS PRODUCTOS TERMINADOS
DESARROLLADO POR : ING. JUAN SOTO
FECHA : 17/10/2014
==========================================================================
}
GLOBALS "ipprgb000.4gl"
DEFINE dataR RECORD
pcodn SMALLINT,
pcodgrupo SMALLINT,
pcodtipo SMALLINT,
pcodsec SMALLINT,
descripcion_p1 VARCHAR(100),
factor_d DEC(12,5),
cantidad DEC(12,5),
umedida CHAR(10),
longitud DEC(12,5),
creferencia VARCHAR(100),
costo DEC(12,5),
precio DEC(12,2),
valor DEC(12,2)
END RECORD
DEFINE dproducto DYNAMIC ARRAY OF RECORD
pcodn SMALLINT,
pcodgrupo SMALLINT,
pcodtipo SMALLINT,
pcodsec SMALLINT,
descripcion_p1 VARCHAR(100),
cantidad DEC(12,5),
precio DEC(12,2),
porc_desc DEC(12,2),
valor DEC(12,2)
END RECORD
DEFINE x1 RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descripcion_p VARCHAR(100)
END RECORD,
pkit int,pdescripcion VARCHAR(100),
cuenta_reg,curr SMALLINT
DEFINE arr_producto DYNAMIC ARRAY OF RECORD
pcodn SMALLINT,
pcodgrupo SMALLINT,
pcodtipo SMALLINT,
pcodsec SMALLINT,
descripcion_p1 VARCHAR(100),
factor_d DEC(12,5),
cantidad DEC(12,5),
umedida CHAR(10),
longitud DEC(12,5),
creferencia VARCHAR(100),
costo DEC(12,5),
precio DEC(12,2),
valor DEC(12,2)
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(4) RETURNING impresor
--CALL STARTLOG("veprmt32.txt")
CONNECT to "smarmotech" AS "MSSQL" USER usuarios USING clave
CALL veprmt032()
END MAIN
FUNCTION veprmt032()
DEFINE mproducto RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descripcion_p VARCHAR(100)
END RECORD,
exito BOOLEAN,
modifica VARCHAR(3),
pprecio DEC(12,2)
OPEN FORM w1 FROM "ipfmmt076"
DISPLAY FORM w1
DIALOG ATTRIBUTES(UNBUFFERED)
INPUT BY NAME mproducto.* ATTRIBUTE(WITHOUT DEFAULTS)
AFTER FIELD cod_sec
IF mproducto.cod_sec IS NOT NULL THEN
CALL producto(mproducto.cod_n,mproducto.cod_grupo,mproducto.cod_tipo,mproducto.cod_sec)
RETURNING pdescripcion
IF pdescripcion IS NULL THEN
CALL msg(3)
NEXT FIELD cod_n
END IF
LET mproducto.descripcion_p = pdescripcion
DISPLAY BY NAME mproducto.descripcion_p
DISPLAY BY NAME mproducto.*
END IF
END INPUT
INPUT ARRAY arr_producto FROM sproducto.* ATTRIBUTE(WITHOUT DEFAULTS)
BEFORE INPUT
IF modifica ="NO" THEN
CALL arr_producto.clear()
END IF
BEFORE ROW
LET idx = arr_curr()
LET scr_l = scr_line()
DISPLAY "idx: ",idx
DISPLAY "scr_l: ", scr_l
AFTER FIELD pcodsec
IF arr_producto[idx].pcodn = mproducto.cod_n AND
arr_producto[idx].pcodgrupo = mproducto.cod_grupo AND
arr_producto[idx].pcodtipo = mproducto.cod_tipo AND
arr_producto[idx].pcodsec = mproducto.cod_sec THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO PUEDE SER IGUAL QUE EL CODIGO PRINCIPAL","INFO")
NEXT FIELD pcodsec
END IF
CALL productoDetalle(arr_producto[idx].pcodn,
arr_producto[idx].pcodgrupo,
arr_producto[idx].pcodtipo,
arr_producto[idx].pcodsec,
idx,
scr_l)
IF arr_producto[idx].descripcion_p1 IS NULL THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO EXISTE","INFO")
NEXT FIELD pcodsec
END IF
--LET arr_producto[idx].* = dataR.*
--DISPLAY dataR.* TO sproducto[scr_l].*
AFTER FIELD cantidad
IF arr_producto[idx].cantidad IS NULL THEN
CALL fgl_Winmessage("ERROR","DEBE INGRESAR LA CANTIDAD DE ESTE PRODUCTO","INFO")
NEXT FIELD cantidad
END IF
LET arr_producto[idx].valor = arr_producto[idx].cantidad * arr_producto[idx].costo
ON ACTION producto ATTRIBUTE(TEXT="Producto")
CALL busca_prod1()
DISPLAY "busca_p: ",busca_p.*
CALL productoDetalle(busca_p.cod_n,busca_p.cod_grupo,busca_p.cod_tipo,busca_p.cod_sec,idx,scr_l)
DISPLAY "length: ",arr_producto.getLength()
IF arr_producto.getLength()<= 0 THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO EXISTE","INFO")
NEXT FIELD pcodsec
END IF
END INPUT
ON ACTION buscar
CALL actualiza_kit()
ON ACTION guardar
IF arr_producto.getLength()<= 0 THEN
CALL fgl_winmessage("ERROR","NO PUEDE GUARDAR KIT SIN ELEMENTOS","INFO")
CONTINUE DIALOG
END IF
CALL inserta(mproducto.*,arr_producto,modifica) RETURNING exito
IF exito THEN
COMMIT WORK
CALL fgl_winmessage("ERROR","ADICION EXITOSA","INFO")
CALL arr_producto.clear()
CLEAR FORM
ELSE
ROLLBACK WORK
CALL fgl_winmessage("ERROR","LA TRANSACCION NO SE ACTUALIZO CON EXITO","INFO")
END IF
CONTINUE DIALOG
# ON ACTION buscar
# CALL buscar_kit()
ON ACTION CANCEL
LET INT_FLAG = FALSE
EXIT PROGRAM
END DIALOG
END FUNCTION
FUNCTION inserta(x,z,modificacion)
DEFINE x RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descripcion_p VARCHAR(100)
END RECORD
DEFINE z DYNAMIC ARRAY OF RECORD
pcodn SMALLINT,
pcodgrupo SMALLINT,
pcodtipo SMALLINT,
pcodsec SMALLINT,
descripcion_p1 VARCHAR(100),
factor_d DEC(12,5),
cantidad DEC(12,5),
umedida CHAR(10),
longitud DEC(12,5),
creferencia VARCHAR(100),
costo DEC(12,5),
precio DEC(12,2),
valor DEC(12,2)
END RECORD,
modificacion VARCHAR(3),
x_exito BOOLEAN,
codid INT
LET x_exito = TRUE
BEGIN WORK
DISPLAY "modificacion: ",modificacion
INSERT INTO iptb00060 (cod_n,cod_grupo,cod_tipo,cod_sec,us_crea,fech_crea)
VALUES(x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,usuarios,getdate())
LET codid = SQLCA.SQLERRD[2]
IF STATUS < 0 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","SE PRODUJO UN ERROR EN LA TABLA iptb00060","INFO")
LET x_exito = FALSE
RETURN x_exito
END IF
FOR curr = 1 TO z.getLength()
IF z[curr].pcodsec IS NOT NULL THEN
INSERT INTO iptb00061(codid,cod_n,cod_grupo,cod_tipo,cod_sec,descripcion,
factor_d,cantidad,umedida,longitud,creferencia,
costo,precio,valor,us_crea,fech_crea)
VALUES(codid,z[curr].pcodn,z[curr].pcodgrupo,z[curr].pcodtipo,z[curr].pcodsec,
z[curr].descripcion_p1,z[curr].factor_d,z[curr].cantidad,z[curr].umedida,
z[curr].longitud,z[curr].creferencia,z[curr].costo,z[curr].precio,z[curr].valor,
usuarios,getdate())
IF STATUS < 0 THEN
ROLLBACK WORK
CALL fgl_winmessage("ERROR","SE PRODUJO UN ERROR EN LA TABLA vetb00061","INFO")
LET x_exito = FALSE
EXIT FOR
END IF
END IF
END FOR
RETURN x_exito
END FUNCTION
FUNCTION producto(x)
DEFINE x RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT
END RECORD,
xdescripcion VARCHAR(100)
SELECT a.descrip_esp, a.codid INTO xdescripcion
FROM iptb00002 a
WHERE a.cod_n = x.cod_n AND
a.cod_grupo = x.cod_grupo AND
a.cod_tipo = x.cod_tipo AND
a.cod_sec = x.cod_sec AND
a.status_t IS NULL
RETURN xdescripcion
END FUNCTION
FUNCTION productoDetalle(x,ind,lin)
DEFINE x RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT
END RECORD,
ind,lin SMALLINT
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec,a.descrip_esp, b.factor_conv,null, a.unidad_med,
null,null,(c.gastos + c.labor + c.material),d.precio,NULL
INTO arr_producto[ind].pcodn, arr_producto[ind].pcodgrupo,arr_producto[ind].pcodtipo,
arr_producto[ind].pcodsec,arr_producto[ind].descripcion_p1,arr_producto[ind].factor_d,
arr_producto[ind].cantidad,arr_producto[ind].umedida,arr_producto[ind].longitud,
arr_producto[ind].creferencia,arr_producto[ind].costo,arr_producto[ind].precio,
arr_producto[ind].valor
FROM iptb00002 a
inner join iptb00001 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
inner join Iptb00004 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
inner join vetb00025 d on a.cod_n = d.cod_n AND a.cod_grupo = d.cod_grupo AND a.cod_tipo = d.cod_tipo AND a.cod_sec = d.cod_Sec
where a.cod_n = x.cod_n AND
a.cod_grupo = x.cod_grupo AND
a.cod_tipo = x.cod_tipo AND
a.cod_Sec = x.cod_sec and
c.ano = year(getdate()) and
d.ventas = 3
DISPLAY "ind,lin: ",ind,lin
DISPLAY "arr_producto[ind]: ",arr_producto[ind].*
--DISPLAY arr_producto[ind].* TO sproducto[lin].*
END FUNCTION
FUNCTION busca_prod1()
DEFINE arr_prod DYNAMIC ARRAY OF RECORD
cod_n INTEGER,
cod_grupo INTEGER,
cod_tipo INTEGER,
cod_sec INTEGER,
descrip_esp CHAR(30),
unidad_med CHAR(5)
END RECORD
OPEN WINDOW busca_2 AT 8,4 WITH FORM "ipfmwd001" ATTRIBUTE (BORDER,FORM LINE
FIRST + 1,PROMPT LINE LAST)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp
FROM cod_n,cod_grupo,cod_tipo,cod_sec,descrip_esp
LET selec_pt =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
" a.unidad_med FROM iptb00002 a ",
"WHERE a.status_t IS NULL AND ",criterio CLIPPED," ORDER BY a.descrip_esp "
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.*
LET idx = ARR_CURR()
LET busca_p.cod_n = arr_prod[idx].cod_n
LET busca_p.cod_grupo = arr_prod[idx].cod_grupo
LET busca_p.cod_tipo = arr_prod[idx].cod_tipo
LET busca_p.cod_sec = arr_prod[idx].cod_sec
LET busca_p.descrip_esp = arr_prod[idx].descrip_esp
LET busca_p.unidad_med = arr_prod[idx].unidad_med
# para el precio
LET p_vetb25.cod_n = arr_prod[idx].cod_n
LET p_vetb25.cod_grupo = arr_prod[idx].cod_grupo
LET p_vetb25.cod_tipo = arr_prod[idx].cod_tipo
LET p_vetb25.cod_sec = arr_prod[idx].cod_sec
LET descrip1 = arr_prod[idx].descrip_esp
LET medida = arr_prod[idx].unidad_med
CLOSE WINDOW busca_2
END FUNCTION
FUNCTION actualiza_kit()
DEFINE cod_n,cod_grupo,cod_tipo,cod_sec SMALLINT,
id INT
DEFINE arr_d DYNAMIC ARRAY OF RECORD
area SMALLINT,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descripcion VARCHAR(100),
cantidad DEC(12,5),
precio DEC(12,2),
porc_desc DEC(12,2)
END RECORD
CALL arr_producto.clear()
DIALOG ATTRIBUTES(UNBUFFERED)
INPUT BY NAME cod_n,cod_grupo,cod_tipo,cod_sec
BEFORE INPUT
NEXT FIELD cod_n
AFTER FIELD cod_sec
IF cod_sec IS NOT NULL THEN
CALL producto(cod_n,cod_grupo,cod_tipo,cod_sec) RETURNING pdescripcion
DISPLAY "pdescripcion: ",pdescripcion
IF pdescripcion IS NULL THEN
CALL msg(3)
NEXT FIELD cod_n
END IF
DISPLAY pdescripcion TO descripcion_p
SELECT DISTINCT a.id INTO id
FROM iptb00060 a
WHERE a.cod_n = cod_n AND
a.cod_grupo = cod_grupo AND
a.cod_tipo = cod_tipo AND
a.cod_sec = cod_sec
IF STATUS = NOTFOUND THEN
CALL fgl_winmessage("INFO","NO EXISTEN KIT CON ESTE CODIGO","INFO")
NEXT FIELD cod_n
ELSE
DECLARE busca_pdetalle CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec,a.descripcion,a.factor_d,a.cantidad,
a.umedida,a.longitud,a.creferencia,a.costo,a.precio,a.valor
FROM iptb00061 a
where a.codid = id
LET idx = 1
FOREACH busca_pdetalle INTO arr_producto[idx].pcodn,arr_producto[idx].pcodgrupo,arr_producto[idx].pcodtipo,
arr_producto[idx].pcodsec,arr_producto[idx].descripcion_p1,arr_producto[idx].factor_d,
arr_producto[idx].cantidad,arr_producto[idx].umedida,arr_producto[idx].longitud,
arr_producto[idx].creferencia,arr_producto[idx].costo,arr_producto[idx].precio,arr_producto[idx].valor
LET idx = idx + 1
END FOREACH
IF idx > 1 THEN
INPUT ARRAY arr_producto FROM sproducto.* ATTRIBUTE(WITHOUT DEFAULTS)
BEFORE ROW
LET idx = arr_curr()
LET scr_l = scr_line()
DISPLAY "idx-2: ",idx
DISPLAY "scr_l-2: ", scr_l
AFTER FIELD pcodsec
IF arr_producto[idx].pcodn = cod_n AND
arr_producto[idx].pcodgrupo = cod_grupo AND
arr_producto[idx].pcodtipo = cod_tipo AND
arr_producto[idx].pcodsec = cod_sec THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO PUEDE SER IGUAL QUE EL CODIGO PRINCIPAL","INFO")
NEXT FIELD pcodsec
END IF
IF arr_producto[idx].descripcion_p1 IS NULL THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO EXISTE","INFO")
NEXT FIELD pcodsec
END IF
AFTER FIELD cantidad
DISPLAY "valor: ", arr_producto[idx].valor
IF arr_producto[idx].cantidad IS NULL THEN
CALL fgl_Winmessage("ERROR","DEBE INGRESAR LA CANTIDAD DE ESTE PRODUCTO","INFO")
NEXT FIELD cantidad
END IF
LET arr_producto[idx].valor = arr_producto[idx].cantidad * arr_producto[idx].costo
ON ACTION producto ATTRIBUTE(TEXT="Producto")
CALL busca_prod1()
DISPLAY "busca_p: ",busca_p.*
CALL productoDetalle(busca_p.cod_n,busca_p.cod_grupo,busca_p.cod_tipo,busca_p.cod_sec,idx,scr_l)
DISPLAY "length: ",arr_producto.getLength()
IF arr_producto.getLength()<= 0 THEN
CALL fgl_Winmessage("ERROR","ESTE CODIGO NO EXISTE","INFO")
NEXT FIELD pcodsec
END IF
ON ACTION Actualizar
DISPLAY "arr_producto.getLength(): ", arr_producto.getLength()
FOR idx =1 TO arr_producto.getLength()
IF arr_producto[idx].pcodn IS NOT NULL THEN
DISPLAY "id: ",id
DISPLAY arr_producto[idx].pcodn
DISPLAY arr_producto[idx].pcodgrupo
DISPLAY arr_producto[idx].pcodtipo
DISPLAY arr_producto[idx].pcodsec
UPDATE iptb00061 SET factor_d = arr_producto[idx].factor_d,
cantidad = arr_producto[idx].cantidad,
umedida = arr_producto[idx].umedida,
longitud = arr_producto[idx].longitud,
creferencia = arr_producto[idx].creferencia,
costo = arr_producto[idx].costo,
precio = arr_producto[idx].precio,
valor = arr_producto[idx].valor
WHERE codid = id --AND
--cod_n = arr_producto[idx].pcodn AND
--cod_grupo = arr_producto[idx].pcodgrupo AND
--cod_tipo = arr_producto[idx].pcodtipo AND
--cod_sec = arr_producto[idx].pcodsec
END IF
END FOR
CALL fgl_Winmessage("ERROR","REGISTRO ACTUALIZADO","INFO")
ON ACTION Eliminar
DISPLAY "Eliminar"
END INPUT
END IF
END IF
END IF
AFTER INPUT
{IF INT_FLAG THEN
EXIT INPUT
END IF}
FOR idx = 1 TO arr_d.getLength()
LET arr_producto[idx].pcodn = arr_d[idx].cod_n
LET arr_producto[idx].pcodgrupo = arr_d[idx].cod_grupo
LET arr_producto[idx].pcodtipo = arr_d[idx].cod_tipo
LET arr_producto[idx].pcodsec = arr_d[idx].cod_sec
LET arr_producto[idx].descripcion_p1 = arr_d[idx].descripcion
LET arr_producto[idx].cantidad = arr_d[idx].cantidad
LET arr_producto[idx].precio = arr_d[idx].precio
END FOR
END INPUT
END DIALOG
IF INT_FLAG THEN
LET INT_FLAG = FALSE
RETURN
END IF
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink