jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
69b4500eed3dbe651bbb0edfd7758d1f633e8e2a
MBS/PROYECTO/indir/inprmt017.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

557 lines
16 KiB
Plaintext
Raw Blame History

{
------------------------------------------------------------------
PROGRAMA : INPRMT017
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Formulas Prod. por tipo de PILA
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Julio 22, 1993.
------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
###### Registro que almacena la informacion pricipal en la maestra de formula
DEFINE formula RECORD
cod_n_p SMALLINT,
cod_grupo_p SMALLINT
END RECORD
DEFINE codgp SMALLINT
###### Registro que maneja arreglo para los diferentes item que contiene
##### una formula en la produccion de pila.
DEFINE arr_form ARRAY[200] OF RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip1 CHAR(30),
unidad CHAR(10),
cantidad DECIMAL(13,3)
END RECORD
DEFINE descrip CHAR(30)
DEFINE curr,i INTEGER
##### Funcion que maneja el menu general para los proceso a realizar en el
##### mantenimiento de la creacion y/o modificacion de formula.
FUNCTION inprmt017()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt017 FROM "infmmt017"
DISPLAY FORM infmmt017
CALL pantalla()
DISPLAY "inprmt017" AT 4,3
DISPLAY "Formula Produccion de Pilas (INDOTEC)" AT 6,21
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL inmtad017()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
CALL inmtmd017()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
#### Funcion que maneja la informacion a insertar.
FUNCTION inmtad017()
WHENEVER ERROR CONTINUE
# Captura los datos que va a contener el registro
##### Proceso para aceptar los nuevos registro para la maestra de formula
INPUT BY NAME formula.*
BEFORE FIELD cod_n_p
LET formula.cod_n_p = 3
DISPLAY BY NAME formula.cod_n_p
AFTER FIELD cod_grupo_p
IF formula.cod_n_p != 3 OR formula.cod_grupo_p IS NULL AND
formula.cod_grupo_p = 0 OR formula.cod_n_p IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n_p
ELSE
#### Chequea que el codigo digitado de la pila exista en la maestra
#### de producto terminado.
SELECT UNIQUE cod_n,cod_grupo FROM intb00001
WHERE cod_n = formula.cod_n_p and
cod_grupo = formula.cod_grupo_p
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n_p
END IF
END IF
SELECT UNIQUE a.cod_n_p,a.cod_grupo_p FROM intb00016 a
WHERE a.cod_n_p = formula.cod_n_p and
a.cod_grupo_p = formula.cod_grupo_p
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n_p
END IF
###### Dependiendo del codigo especifica el tipo de pila.
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME descrip
END INPUT
###### En caso de presionar DELETE cancela la operacion.
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
###### Manejando arreglo para los diferentes item que intervienen en
###### en la produccion de un tipo de pila.
INPUT ARRAY arr_form FROM arr_form1.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
AFTER FIELD cod_grupo
IF arr_form[curr].cod_grupo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER FIELD cod_tipo
IF arr_form[curr].cod_tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
LET arr_form[curr].cod_tipo = null
DISPLAY arr_form[curr].cod_tipo TO arr_form1[fila].cod_tipo
NEXT FIELD cod_n
END IF
AFTER FIELD cod_sec
IF arr_form[curr].cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
LET arr_form[curr].cod_grupo = NULL
LET arr_form[curr].cod_tipo = NULL
DISPLAY arr_form[curr].cod_grupo,arr_form[curr].cod_tipo TO
arr_form1[fila].cod_grupo,arr_form1[fila].cod_grupo
NEXT FIELD cod_n
END IF
##### Proceso para impedir que digite un codigo de material mas de una vez.
FOR i = 1 TO ARR_COUNT() - 1
IF arr_form[curr].cod_n = arr_form[i].cod_n AND
arr_form[curr].cod_grupo = arr_form[i].cod_grupo AND
arr_form[curr].cod_tipo = arr_form[i].cod_tipo AND
arr_form[curr].cod_sec = arr_form[i].cod_sec THEN
LET numero_msg = 135
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END FOR
##### Chequea que el codigo de material digitado exista en la mestra de
##### material.
SELECT a.descrip_esp,a.unidad_med
INTO arr_form[curr].descrip1,arr_form[curr].unidad FROM intb00022 a
WHERE a.cod_n = arr_form[curr].cod_n AND
a.cod_grupo = arr_form[curr].cod_grupo AND
a.cod_tipo = arr_form[curr].cod_tipo AND
a.cod_sec = arr_form[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY arr_form[curr].descrip1,arr_form[curr].unidad to
arr_form1[fila].descrip1,arr_form1[fila].unidad
AFTER FIELD cantidad
IF arr_form[curr].cantidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
##### Proceso para insertar los diferentes item que intervienen
##### en un tipo de pila
FOR i = 1 TO ARR_COUNT()
IF arr_form[i].cod_n IS NOT NULL THEN
INSERT INTO intb00016 VALUES (formula.*,arr_form[i].cod_n,
arr_form[i].cod_grupo,arr_form[i].cod_tipo,arr_form[i].cod_sec,
arr_form[i].cantidad, NULL, USER, CURRENT, NULL, NULL)
END IF
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
##### Funcion para consultar y/o modificar un registro
FUNCTION inmtmd017()
# Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.cod_n_p,a.cod_grupo_p FROM cod_n_p,cod_grupo_p
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
CLEAR FORM
RETURN
END IF
###### Seleciona los materiales a consultar y/o modificar que cumplan el
###### criterio de busqueda
LET SELEC = "SELECT UNIQUE a.cod_n_p,a.cod_grupo_p FROM intb00016 a WHERE ",
"a.status_t is null AND ",
criterio clipped,
"ORDER BY 1,2"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
##### Busca el primer registro que esta en la memoria y lo muestra en la pant.
FETCH FIRST datos INTO formula.*
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME formula.*,descrip
###### Menu para elgir registro a consultar y/o modificar
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO formula.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME formula.*,descrip
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO formula.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME formula.*,descrip
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO formula.*
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME formula.*,descrip
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO formula.*
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME formula.*,descrip
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
INPUT BY NAME formula.cod_grupo_p WITHOUT DEFAULTS
BEFORE FIELD cod_grupo_p
LET codgp = formula.cod_grupo_p
AFTER FIELD cod_grupo_p
IF formula.cod_grupo_p = 0 OR formula.cod_grupo_p IS NULL AND
formula.cod_n_p = 0 OR formula.cod_n_p IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_grupo_p
ELSE
###### Chequea que el codigo del tipo de pila a digitar exista en la
###### maestra de producto terminao.
SELECT UNIQUE cod_n,cod_grupo FROM intb00001
WHERE cod_n = 3 AND
cod_grupo = formula.cod_grupo_p
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n_p
END IF
END IF
IF formula.cod_grupo_p = 1 THEN
LET descrip = "PILA TIPO D (2LP)"
ELSE
IF formula.cod_grupo_p = 2 THEN
LET descrip = "PILA TIPO C (1LP)"
ELSE
LET descrip = "PILA TIPO AA (R6/7HD)"
END IF
END IF
DISPLAY BY NAME descrip
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
###### Busca los items que pertenecen al registro elegido para modificar
DECLARE buscar CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,b.unidad_med,
a.cantidad FROM intb00016 a,intb00022 b WHERE 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 a.cod_n_p = 3 AND a.cod_grupo_p = codgp
LET i = 1
FOREACH buscar INTO arr_form[i].*
LET i = i + 1
END FOREACH
CALL SET_COUNT(i - 1)
INPUT ARRAY arr_form WITHOUT DEFAULTS FROM arr_form1.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
AFTER FIELD cod_grupo
IF arr_form[curr].cod_grupo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER FIELD cod_tipo
IF arr_form[curr].cod_tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
LET arr_form[curr].cod_grupo = null
DISPLAY arr_form[curr].cod_grupo TO arr_form1[fila].cod_grupo
NEXT FIELD cod_n
END IF
AFTER FIELD cod_sec
IF arr_form[curr].cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
LET arr_form[curr].cod_grupo = null
LET arr_form[curr].cod_tipo = null
DISPLAY arr_form[curr].cod_grupo,arr_form[curr].cod_tipo TO
arr_form1[fila].cod_grupo,arr_form1[fila].cod_tipo
NEXT FIELD cod_n
END IF
FOR i = 1 TO ARR_COUNT()
IF i <> curr THEN
IF arr_form[curr].cod_n = arr_form[i].cod_n AND
arr_form[curr].cod_grupo = arr_form[i].cod_grupo AND
arr_form[curr].cod_tipo = arr_form[i].cod_tipo AND
arr_form[curr].cod_sec = arr_form[i].cod_sec THEN
LET numero_msg = 135
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
END FOR
###### Chequea que el codigo de material a digitar exista en la mestra de
###### material.
SELECT a.descrip_esp,unidad_med
INTO arr_form[curr].descrip1,arr_form[curr].unidad FROM intb00022 a
WHERE a.cod_n = arr_form[curr].cod_n AND
a.cod_grupo = arr_form[curr].cod_grupo AND
a.cod_tipo = arr_form[curr].cod_tipo AND
a.cod_sec = arr_form[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY arr_form[curr].descrip1,arr_form[curr].unidad
TO arr_form1[fila].descrip1,arr_form1[fila].unidad
AFTER FIELD cantidad
IF arr_form[curr].cantidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
###### Proceso para actualizar el registro elegido.
DELETE FROM intb00016 WHERE cod_n_p = 3 AND cod_grupo_p = codgp
FOR i = 1 TO ARR_COUNT()
IF arr_form[i].cod_n IS NOT NULL THEN
INSERT INTO intb00016 VALUES (formula.*,arr_form[i].cod_n,
arr_form[i].cod_grupo,arr_form[i].cod_tipo,arr_form[i].cod_sec,
arr_form[i].cantidad, NULL, USER, CURRENT, USER, CURRENT)
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
##### Proceso para eliminar un registro logicamente.
COMMAND KEY ("L") "eLiminar"
UPDATE intb00017 set status_t = "E"
WHERE cod_n_p = 3 AND
cod_grupo_p = formula.cod_grupo_p
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink