jsoto/MBS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
MBS/PROYECTO/indir/inprmt002.4gl
T
jpeguero efdf8953dd Reorganiza MATERIA PRIMA a PROYECTO y avanza inprmt002/005/013/046 
- Mueve todo el contenido de PROYECTOS/indir y varias funciones
  compartidas de PROYECTOS/otrodir hacia PROYECTO, siguiendo
  instruccion de Johnny (PROYECTOS se va a eliminar).
- inprmt002: agrega campo Desglose faltante, corrige typo "eLiminar".
- inprmt005: agrega formulario y 3 campos faltantes (Consumo,
  Requiere Autorizacion, Requisiciones), corrige typo "eLiminar".
- inprmt013: agrega formulario, titulo, corrige typo "eLiminar".
- inprmt046: agrega formulario y varias funciones/dependencias
  faltantes (cincodmov, clasf_bloque, medidas, defecto,
  buscaEmp, consultaTransportista, busca_departamento);
  corrige nombres de campo desalineados con el codigo
  (depto_a, bodega) y los convierte a ComboBox donde el
  codigo lo requiere.
- Corrige dependencia faltante de FORMULARIOS_IN a la libreria
  Database (bloqueaba todo el modulo de MATERIA PRIMA).
2026-08-26 13:31:09 -04:00

531 lines
20 KiB
Plaintext
Raw Permalink Blame History

{
------------------------------------------------------------------
PROGRAMA : INPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Materia Prima.
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Julio 30, 1992.
------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
DEFINE arrarticulos DYNAMIC ARRAY OF RECORD
codigo CHAR(16),
descripcion CHAR(40),
unidad1 CHAR(4)
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL inprmt002()
END MAIN
FUNCTION inprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt002 FROM "infmmt002"
DISPLAY FORM infmmt002
#CALL pantalla()
DISPLAY "inprmt002" AT 4,3
DISPLAY "Catalogo Materia Prima" at 6,29
MENU "OPCIONES"
ON ACTION nuevo
CLEAR FORM
LET INT_FLAG = FALSE
CALL inpcad002()
ON ACTION buscar
LET INT_FLAG = FALSE
CALL inpcmf002()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION inpcad002()
DEFINE fech_ant CHAR(8)
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
CALL articulos()
DIALOG ATTRIBUTE(UNBUFFERED)
DISPLAY ARRAY arrarticulos TO sarticulo.*
{BEFORE ROW
LET idx = arr_curr()
AFTER DISPLAY
LET m_articulos.cod_n = arrarticulos[idx].cod_n
LET m_articulos.cod_grupo = arrarticulos[idx].cod_grupo
LET m_articulos.cod_tipo = arrarticulos[idx].cod_tipo
LET m_articulos.cod_sec = arrarticulos[idx].cod_sec
LET articulos.descrip_esp = arrarticulos[idx].descripcion
EXIT DISPLAY
END DISPLAY}
END DISPLAY
INPUT BY NAME m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.cod_sec,descrip1,descrip2,medida,
m_articulos.pto_reorden THRU m_articulos.desglose
## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
IF ( m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND
m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT i.* INTO articulos.* FROM intb00001 i
WHERE i.cod_n = m_articulos.cod_n AND
i.cod_grupo = m_articulos.cod_grupo AND
i.cod_tipo = m_articulos.cod_tipo AND
i.cod_sec = m_articulos.cod_sec
IF STATUS != NOTFOUND THEN
IF articulos.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
END IF
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.existencia
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT a.* FROM cotb00005 a
WHERE a.cod_nab = m_articulos.cod_nab and a.status_t is null
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
AFTER FIELD bodega
IF m_articulos.bodega IS NOT NULL THEN
SELECT a.* FROM intb00009 a
WHERE a.cod_bodega = m_articulos.bodega
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD bodega
END IF
END IF
AFTER FIELD dia_llegada
IF m_articulos.dia_llegada IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dia_llegada
END IF
END INPUT
ON ACTION cancelar
LET numero_msg = 2
CALL msg(numero_msg)
RETURN
ON ACTION guardar
IF m_articulos.bodega IS NULL THEN
CALL msg(16)
NEXT FIELD bodega
END IF
# BUSCA EL ULTIMO CODIGO ASIGNADO AL REGISTRO
SELECT MAX(a.codid) INTO pcodid FROM intb00001 a
IF pcodid IS NULL THEN
LET pcodid = 0
END IF
LET pcodid = pcodid + 1
# Valida que el codigo del articulo no sea cero. Si no es cero, adiciona el
# registro en la tabla, de lo contrario, presenta mensaje de error y acepta
# el codigo de nuevo.
BEGIN WORK
INSERT INTO intb00001 (cod_n,cod_grupo,cod_tipo,cod_Sec,descrip_esp,descrip_ing,unidad_med,
us_crea,fech_crea,codid)
VALUES (m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.cod_sec,descrip1,descrip2,medida,SUSER_SNAME(),
GETDATE(),pcodid)
INSERT INTO intb00002
VALUES(m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.cod_sec,m_articulos.pto_reorden,
m_articulos.existencia,m_articulos.cod_nab,m_articulos.base,
m_articulos.bodega,m_articulos.categoria,m_articulos.dia_llegada,
m_articulos.gravamen,null,SUSER_SNAME(),GETDATE(),null,NULL,m_articulos.desglose)
IF m_articulos.categoria is not null THEN
INSERT INTO intb00014 VALUES(m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,
m_articulos.categoria,today,null,
SUSER_SNAME(),GETDATE(),null,null)
END IF
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
SELECT a.cod_n FROM intb00006 a
WHERE a.cod_mov = 99 AND a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec
IF status = notfound THEN
LET datos_gen.num_doc = 0
SELECT MAX(a.num_doc) INTO datos_gen.num_doc FROM intb00006 a
WHERE a.status_t IS NULL AND a.cod_mov = 99
IF datos_gen.num_doc IS NULL THEN
LET datos_gen.num_doc = 0
END IF
LET datos_gen.num_doc = datos_gen.num_doc + 1
INSERT INTO intb00006 (num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad_2,bodega,us_crea,fech_crea)
VALUES (datos_gen.num_doc,datos_gen.fecha,99,m_articulos.cod_n,
m_articulos.cod_grupo, m_articulos.cod_tipo,m_articulos.cod_sec,
m_articulos.existencia,m_articulos.bodega,SUSER_SNAME(),GETDATE())
END IF
COMMIT WORK
LET numero_msg = 1
CALL msg(numero_msg)
END DIALOG
END FUNCTION
FUNCTION inpcmf002()
#WHENEVER ERROR CONTINUE
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,
a.cod_sec,b.descrip_esp
FROM cod_n,cod_grupo,cod_tipo,cod_sec,descrip1
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 intb00002 a,intb00001 b ",
"WHERE a.status_t is null AND ",criterio clipped,
" and 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 ",
"ORDER BY 1,2,3,4"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO m_articulos.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO m_articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO m_articulos.*
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO m_articulos.*
SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida
FROM intb00001
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec
LET m_articulos.existencia = 0
SELECT SUM(a.cantidad_2) INTO m_articulos.existencia FROM intb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec and
a.status_t is null
IF m_articulos.existencia IS null then
LET m_articulos.existencia = 0
END IF
DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
INPUT BY NAME descrip1,descrip2,medida,m_articulos.pto_reorden THRU
m_articulos.desglose WITHOUT DEFAULTS
AFTER FIELD pto_reorden
NEXT FIELD cod_nab
AFTER FIELD cod_nab
IF m_articulos.cod_nab IS NOT NULL THEN
SELECT * FROM cotb00005 WHERE
cod_nab = m_articulos.cod_nab
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_nab
END IF
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE intb00001 SET (descrip_esp,descrip_ing,unidad_med,
us_mod,fech_mod) =
(descrip1,descrip2,medida,SUSER_SNAME(),GETDATE())
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
UPDATE intb00002 SET pto_reorden = m_articulos.pto_reorden,
cod_nab = m_articulos.cod_nab,
bodega = m_articulos.bodega,
dia_llegada = m_articulos.dia_llegada,
gravamen = m_articulos.gravamen,
base = m_articulos.base,
categoria = m_articulos.categoria,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE(),
desglose = m_articulos.desglose
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
IF m_articulos.categoria is not null THEN
UPDATE intb00014 set categoria = m_articulos.categoria
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
END IF
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "Eliminar"
BEGIN WORK
UPDATE intb00001 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
UPDATE intb00002 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
UPDATE intb00006 SET status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE intb00006.cod_n = m_articulos.cod_n AND
intb00006.cod_grupo = m_articulos.cod_grupo AND
intb00006.cod_tipo = m_articulos.cod_tipo AND
intb00006.cod_sec = m_articulos.cod_sec AND
intb00006.cod_mov = 99
UPDATE intb00014 set status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
COMMIT WORK
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION articulos()
DECLARE busca_art CURSOR FOR
SELECT CAST(a.cod_n as char(2)) + '-' +
CAST(a.cod_grupo AS CHAR(4)) + '-' +
CAST(a.cod_tipo AS CHAR(4)) + '-' +
CAST(a.cod_Sec AS CHAR(4)), a.descrip_Esp,a.unidad_med,
a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM intb00001 a WHERE a.status_t IS NULL
ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
LET idx = 1
FOREACH busca_art INTO arrarticulos[idx].*,datos_mt[idx].cod_n,
datos_mt[idx].cod_grupo,
datos_mt[idx].cod_tipo,
datos_mt[idx].cod_sec
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink