jsoto/MBS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
MBS/PROYECTO/indir/inprmt012.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

456 lines
12 KiB
Plaintext
Raw Permalink Blame History

{
------------------------------------------------------------------
PROGRAMA : INPRMT012
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Resoluciones.(Aprobacion de interna-
miento de material para produccion de pilas.
PROGRAMADOR : Tadeo A. Ferreas
FECHA REALIZACION : Julio 22, 1993.
------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
DEFINE resoluc RECORD
num_res INTEGER,
num_sol INTEGER,
fecha DATE
END RECORD
DEFINE codgp SMALLINT
#### Variables para manejar arreglo en los diferentes item que intervienen en
#### una resolucion.
##### registro para manejar arreglos en la maestra de resolucion
DEFINE arr_form4 ARRAY[200] OF RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip1 CHAR(30),
unidad1 CHAR(10),
cantidad DECIMAL(12,2)
END RECORD
DEFINE descrip CHAR(30)
DEFINE unidad CHAR(10)
DEFINE curr,i INTEGER
FUNCTION inprmt012()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt012 FROM "infmmt012"
DISPLAY FORM infmmt012
CALL pantalla()
DISPLAY "inprmt012" AT 4,3
DISPLAY "Aprobacion de Solicitud (Resolucion)" AT 6,22
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL inmtad019()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
CALL inmtmd019()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION inmtad019()
##### WHENEVER ERROR CONTINUE
##### Captura los datos que va a contener el registro
INPUT BY NAME resoluc.*
AFTER FIELD num_res
IF resoluc.num_res = 0 OR resoluc.num_res IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_res
END IF
SELECT UNIQUE a.num_res FROM intb00019 a WHERE a.num_res = resoluc.num_res
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_res
END IF
AFTER FIELD num_sol
IF resoluc.num_sol = 0 OR resoluc.num_sol IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_sol
END IF
########## Chequea que el numero de solicitud no exista en alguna resolucion
SELECT UNIQUE a.num_sol FROM intb00019 a
WHERE a.num_sol = resoluc.num_sol
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_sol
END IF
######### Chequea que el numero de solicitud exista en la maestra de solicitud
SELECT UNIQUE a.num_sol FROM intb00017 a
WHERE a.num_sol = resoluc.num_sol
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_sol
END IF
BEFORE FIELD fecha
LET resoluc.fecha = today
DISPLAY BY NAME resoluc.fecha
AFTER FIELD fecha
IF resoluc.fecha IS NULL THEN
LET resoluc.fecha = today
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 manejar arreglos #########
INPUT ARRAY arr_form4 FROM arr_form5.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
AFTER FIELD cod_sec
IF arr_form4[curr].cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
FOR i = 1 TO ARR_COUNT() - 1
IF arr_form4[curr].cod_grupo = arr_form4[i].cod_grupo AND
arr_form4[curr].cod_tipo = arr_form4[i].cod_tipo AND
arr_form4[curr].cod_sec = arr_form4[i].cod_sec THEN
LET numero_msg = 135
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END FOR
SELECT UNIQUE a.descrip_esp,unidad_med INTO descrip,unidad
FROM intb00022 a
WHERE a.cod_n = arr_form4[curr].cod_n AND
a.cod_grupo = arr_form4[curr].cod_grupo AND
a.cod_tipo = arr_form4[curr].cod_tipo AND
a.cod_sec = arr_form4[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET arr_form4[curr].descrip1 = descrip CLIPPED
LET arr_form4[curr].unidad1 = unidad CLIPPED
DISPLAY arr_form4[curr].descrip1,arr_form4[curr].unidad1
TO arr_form5[fila].descrip1,arr_form5[fila].unidad1
AFTER FIELD cantidad
IF arr_form4[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
RETURN
END IF
###### Proceso para insertar valores en la tabla o maestra de resolucion ####
FOR i = 1 TO ARR_COUNT()
IF arr_form4[i].cod_n IS NOT NULL AND
arr_form4[i].cod_grupo IS NOT NULL AND
arr_form4[i].cod_tipo IS NOT NULL AND
arr_form4[i].cod_sec IS NOT NULL THEN
INSERT INTO intb00019
VALUES (resoluc.*,arr_form4[i].cod_n,arr_form4[i].cod_grupo,
arr_form4[i].cod_tipo,arr_form4[i].cod_sec,
arr_form4[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 modificar una resolucion #######
FUNCTION inmtmd019()
# Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.num_res,a.num_sol,a.fecha FROM num_res,num_sol,fecha
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
######## Selecionando datos a modificar ########
LET SELEC = "SELECT UNIQUE a.num_res,a.num_sol,a.fecha FROM intb00019 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
FETCH FIRST datos INTO resoluc.*
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
DISPLAY BY NAME resoluc.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO resoluc.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME resoluc.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO resoluc.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME resoluc.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO resoluc.*
DISPLAY BY NAME resoluc.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO resoluc.*
DISPLAY BY NAME resoluc.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
INPUT BY NAME resoluc.num_sol,resoluc.fecha WITHOUT DEFAULTS
AFTER FIELD num_sol
IF resoluc.num_sol IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_sol
END IF
SELECT UNIQUE a.num_sol FROM intb00017 a WHERE a.num_sol = resoluc.num_sol
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_sol
END IF
AFTER FIELD fecha
IF resoluc.fecha IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DECLARE buscar1 CURSOR FOR
SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp,
b.unidad_med,a.cantidad
FROM intb00019 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.status_t IS NULL AND
a.num_res = resoluc.num_res
LET i = 1
FOREACH buscar1 INTO arr_form4[i].*
LET i = i + 1
END FOREACH
CALL SET_COUNT(i - 1)
INPUT ARRAY arr_form4 WITHOUT DEFAULTS FROM arr_form5.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
AFTER FIELD cod_sec
IF arr_form4[curr].cod_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
FOR i = 1 TO ARR_COUNT()
IF i <> curr THEN
IF arr_form4[curr].cod_grupo = arr_form4[i].cod_grupo AND
arr_form4[curr].cod_tipo = arr_form4[i].cod_tipo AND
arr_form4[curr].cod_sec = arr_form4[i].cod_sec THEN
LET numero_msg = 135
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
END IF
END FOR
SELECT UNIQUE a.descrip_esp,a.unidad_med INTO descrip,unidad
FROM intb00022 a
WHERE a.cod_n = arr_form4[curr].cod_n AND
a.cod_grupo = arr_form4[curr].cod_grupo AND
a.cod_tipo = arr_form4[curr].cod_tipo AND
a.cod_sec = arr_form4[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET arr_form4[curr].descrip1 = descrip
LET arr_form4[curr].unidad1 = unidad
DISPLAY arr_form4[curr].descrip1,arr_form4[curr].unidad1
TO arr_form5[fila].descrip1,arr_form5[fila].unidad1
AFTER FIELD cantidad
IF arr_form4[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
RETURN
END IF
####### Proceso para modificar los datos ########
DELETE FROM intb00019 WHERE num_res = resoluc.num_res
FOR i = 1 TO ARR_COUNT()
IF arr_form4[i].cod_n IS NOT NULL AND
arr_form4[i].cod_grupo IS NOT NULL AND
arr_form4[i].cod_tipo IS NOT NULL AND
arr_form4[i].cod_sec IS NOT NULL THEN
INSERT INTO intb00019
VALUES (resoluc.*,arr_form4[i].cod_n,arr_form4[i].cod_grupo,
arr_form4[i].cod_tipo,arr_form4[i].cod_sec,
arr_form4[i].cantidad,
NULL,USER,CURRENT,USER,CURRENT)
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
##### Proceso para eliminar una resolucion #######
COMMAND KEY ("L") "eLiminar"
UPDATE intb00019 set (status_t,us_mod,fech_mod) =
("E",USER,CURRENT)
WHERE num_res = resoluc.num_res
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