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

411 lines
12 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IPPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Productos
PROGRAMADOR : Juan Fco. Soto
FECHA REALIZACION : AGOSTO 1997
ASESOR : JOSE ALFREDO PAULINO
------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
DEFINE p_tipo_prod LIKE iptb00013.tipo_prod,
descrip_medida,descrip_grupo CHAR(30),
despiece CHAR(1),
USUARIOS, CLAVE CHAR(50),
pcodid INT,
pmaterial,plabor,pgastos,pfactor DEC(12,4)
DEFINE t_marca ARRAY [100] OF RECORD
cod_marca LIKE iptb00019.marca,
nombre LIKE iptb00019.nombre_marca
END RECORD,
descrip_tipo CHAR(40),
pcodn,pcodgrupo,pcodtipo,pcodsec SMALLINT,
descripcion CHAR(40)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "decomarmol" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL ipprmt002()
END MAIN
FUNCTION ipprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 23
OPEN FORM ipfmmt002 FROM "ipfmmt002_3"
DISPLAY FORM ipfmmt002
DISPLAY "ipprmt002" AT 4,3
DISPLAY "Catalogo Productos" AT 6,32
MENU
ON ACTION Adicionar
CLEAR FORM
LET INT_FLAG = FALSE
INITIALIZE p_iptb02.* TO NULL
LET tipo_p = "A"
CALL ippcad002()
ON ACTION consultar
CLEAR FORM
LET INT_FLAG = FALSE
INITIALIZE p_iptb02.* TO NULL
LET tipo_p = "C"
CALL ippcmf002()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION ippcad002()
DEFINE fech_ant CHAR(8)
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
IF tipo_p = "A" THEN
INPUT BY NAME p_iptb02.*,
pcodsec
AFTER FIELD cod_cia
IF p_iptb02.cod_cia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
IF p_iptb02.cod_cia = 1 THEN
LET nombre_cia = "PRODUCTO LOCAL"
ELSE
LET nombre_cia = "PRODUCTO IMPORTADO"
END IF
DISPLAY BY NAME nombre_cia
SELECT UNIQUE a.descrip_esp FROM tmpiptb00002 a
WHERE a.cod_n = p_iptb02.cod_n AND a.cod_grupo = p_iptb02.cod_grupo AND
a.cod_tipo = p_iptb02.cod_tipo AND a.cod_sec = p_iptb02.cod_sec
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_tipo
END IF
AFTER INPUT
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
IF p_iptb02.cod_cia IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
IF p_iptb02.cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sec
END IF
END INPUT
ELSE
INPUT BY NAME p_iptb02.cod_cia,p_iptb02.cod_sec,
p_iptb02.descrip_esp,p_iptb02.unidad_med,p_iptb02.bodega,
p_iptb02.exist_max,p_iptb02.exist_min,
p_iptb02.status_t,p_iptb06.cantidad_2,p_iptb02.control_itbis,
p_iptb02.control_existencia
WITHOUT DEFAULTS
AFTER FIELD cod_cia
IF p_iptb02.cod_cia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
IF p_iptb02.cod_cia = 1 THEN
LET nombre_cia = "PRODUCTO LOCAL"
ELSE
LET nombre_cia = "PRODUCTO IMPORTADO"
END IF
DISPLAY BY NAME nombre_cia
AFTER FIELD descrip_esp
IF p_iptb02.descrip_esp is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
AFTER FIELD unidad_med
IF p_iptb02.descrip_esp is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
AFTER FIELD bodega
IF p_iptb02.bodega is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
AFTER FIELD exist_max
IF p_iptb02.exist_max is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD exist_max
END IF
AFTER FIELD exist_min
IF p_iptb02.exist_min is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD exist_min
END IF
AFTER INPUT
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
IF p_iptb02.cod_cia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cia
END IF
IF p_iptb02.descrip_esp is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
IF p_iptb02.descrip_esp is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
IF p_iptb02.bodega is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
IF p_iptb02.exist_max is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD exist_max
END IF
IF p_iptb02.exist_min is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD exist_min
END IF
END INPUT
END IF
END FUNCTION
FUNCTION ippcmf002()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.cod_cia,a.cod_sec,
a.descrip_esp
FROM cod_cia,cod_sec,descrip_esp
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE a.* FROM iptb00036 a ",
"WHERE ",criterio clipped,
" ORDER BY a.cod_Sec"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
CALL despl1()
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL despl1()
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL despl1()
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
CALL despl1()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
CALL despl1()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Delete> Cancela Operacion"
CALL ippcad002()
COMMAND KEY ("T") "acTivar"
UPDATE tmpiptb00002 SET status_t = null,us_mod = user,fech_mod = GETDATE()
WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND
@cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE tmpiptb00002 SET status_t = "E",us_mod = usuarios,
fech_mod = GETDATE()
WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND
@cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec
{ UPDATE iptb00006 SET status_t = "E", us_mod = user, fech_mod = GETDATE()
WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND
@cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec
}
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_prod()
OPEN WINDOW producto AT 12,3 WITH FORM "ipfmwd006" ATTRIBUTE(BORDER,CYAN,
FORM LINE FIRST +1)
DECLARE busca11 CURSOR FOR
SELECT a.* FROM iptb00020 a ORDER BY 2
LET idx = 1
FOREACH busca11 INTO t_marca[idx].*
LET idx = idx + 1
END FOREACH
IF idx = 1 THEN
LET numero_msg = 3
CALL msg(numero_msg)
SLEEP 4
END IF
CALL set_count(idx-1)
DISPLAY ARRAY t_marca TO s_pilas.*
LET idx = arr_curr()
LET p_iptb20.cod_n = t_marca[idx].cod_marca
LET p_iptb20.producto = t_marca[idx].nombre
CLOSE WINDOW producto
END FUNCTION
FUNCTION despl1()
LET p_iptb06.cantidad_2 = 0
SELECT SUM(a.cantidad_2) INTO p_iptb06.cantidad_2 FROM iptb00006 a
WHERE a.cod_n=p_iptb02.cod_n and a.cod_grupo=p_iptb02.cod_grupo and
a.cod_tipo=p_iptb02.cod_tipo and a.cod_sec=p_iptb02.cod_sec AND
a.status_t IS NULL
IF p_iptb06.cantidad_2 IS NULL THEN
LET p_iptb06.cantidad_2 = 0
END IF
LET p_iptb20.producto = NULL
SELECT UNIQUE a.descripcion INTO p_iptb20.producto FROM tmpclase a
WHERE a.cod_n = p_iptb02.cod_n
LET p_iptb21.nombre_cia = NULL
SELECT UNIQUE a.nombre_cia INTO p_iptb21.nombre_cia FROM iptb00021 a
WHERE a.cod_cia = p_iptb02.cod_cia
SELECT UNIQUE a.cod_n FROM tmpiptb00027 a
WHERE a.cod_n=p_iptb02.cod_n and
a.cod_grupo=p_iptb02.cod_grupo and
a.cod_tipo=p_iptb02.cod_tipo and
a.cod_sec=p_iptb02.cod_sec
IF STATUS != NOTFOUND THEN
LET despiece = "S"
ELSE
LET despiece = "N"
END IF
LET descrip_tipo = null
SELECT UNIQUE a.descripcion INTO descrip_tipo FROM tmptipo a WHERE a.cod_tipo = p_iptb02.cod_tipo
SELECT a.descripcion INTO descrip_grupo FROM tmpgrupo a
WHERE a.cod_grupo = p_iptb02.cod_grupo
SELECT a.descripcion INTO descrip_medida FROM tmpmedida a
WHERE a.cod_sec = p_iptb02.cod_sec
LET selec =
"SELECT a.descrip_esp ",
" FROM historicoMTECH.dbo.iptb00002 a ",
" WHERE a.cod_n = ? AND ",
" a.cod_grupo = ? AND ",
" a.cod_tipo = ? AND ",
" a.cod_Sec = ? "
PREPARE cmdi2ptb02 FROM selec
EXECUTE cmdi2ptb02 INTO descripcion USING pcodn,pcodgrupo,pcodtipo,pcodsec
DISPLAY BY NAME p_iptb02.*,p_iptb21.nombre_cia,p_iptb06.cantidad_2,
p_iptb20.producto,despiece,descrip_tipo,descrip_grupo,
descrip_medida,descripcion,
pcodn,pcodgrupo,pcodtipo,pcodsec,
pmaterial,plabor,pgastos,pfactor
END FUNCTION