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

678 lines
18 KiB
Plaintext
Raw Blame History

{
------------------------------------------------------------------
PROGRAMA : INPRMT010
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de la maestra de FIANZAS con entrada por
FACTURA Internamiento de Materia Prima locales.
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Julio 22, 1993.
------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
DEFINE fact RECORD
num_fianza INTEGER,
num_res INTEGER,
fecha DATE,
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
num_oc INTEGER,
num_emb SMALLINT,
valor_merc DECIMAL(12,2)
END RECORD
DEFINE fact3 ARRAY[200] OF RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
unidad CHAR(3),
descrip CHAR(30),
cantidad DECIMAL(12,2),
cantidad_c DECIMAL(12,2)
END RECORD
DEFINE estado RECORD
status_t LIKE intb00020.status_t,
us_crea LIKE intb00020.us_crea,
fech_crea LIKE intb00020.fech_crea,
us_mod LIKE intb00020.us_mod,
fech_mod LIKE intb00020.fech_mod
END RECORD
DEFINE datos_comp ARRAY[200] OF RECORD
cod_ca CHAR(4),
nom_ca CHAR(30)
END RECORD
DEFINE datos_pais ARRAY[200] OF RECORD
cod_pais CHAR(3),
nom_pais CHAR(30)
END RECORD
DEFINE datos_sp ARRAY[200] OF RECORD
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sp CHAR(30)
END RECORD
DEFINE curr INTEGER
DEFINE codgp SMALLINT
DEFINE nombre,nombre1,nombre2,nombre3,nomps,nom_comp,material CHAR(30)
DEFINE total1,total2,total3,cantidad1,cantidad2,cantidad3,gravamen DECIMAL(13,3)
DEFINE total_prima,cantidad4,cantidad5,cantidad6 DECIMAL(13,3)
DEFINE grava,tasa DECIMAL(7,2)
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL inprrp010()
END MAIN
FUNCTION inprmt010()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt010 FROM "infmmt010"
DISPLAY FORM infmmt010
CALL pantalla()
DISPLAY "inprmt010" AT 4,3
DISPLAY "Internamiento de Materiales Locales" AT 6,22
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL inmtad010()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL inmtmd010()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_material()
LET int_flag = FALSE
OPEN WINDOW material1 AT 10,9 WITH FORM "infmwd004"
ATTRIBUTE(BORDER,FORM LINE FIRST + 2)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,
a.unidad_med
FROM cod_n,cod_grupo,cod_tipo,cod_sec,descrip_esp,
unidad_med
LET selec = "SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
"a.unidad_med FROM intb00001 a ",
"WHERE a.status_t IS NULL AND ",criterio CLIPPED,
"ORDER BY 1,2,3,4"
PREPARE comando4 FROM selec
DECLARE comp4 CURSOR FOR comando4
LET idx = 1
FOREACH comp4 INTO datos_mt[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
IF idx = 1 THEN
LET numero_msg = 3
CALL msg(numero_msg)
GOTO salir
END IF
DISPLAY ARRAY datos_mt TO datos_mt1.*
LET idx = ARR_CURR()
LABEL salir:
CLOSE WINDOW material1
END FUNCTION
FUNCTION busca_suplidor()
LET int_flag = FALSE
OPEN WINDOW suplidor1 AT 10,9 WITH FORM "infmwd003"
ATTRIBUTE(BORDER,FORM LINE FIRST + 2)
CONSTRUCT criterio ON a.cod_sp,a.cod_sp_sec,a.nom_sp
FROM cod_sp,cod_sp_sec,nom_sp
LET selec = "SELECT a.cod_sp,a.cod_sp_sec,a.nom_sp FROM cotb00001 a ",
"WHERE a.status_t IS NULL AND ",criterio CLIPPED, "ORDER BY 1,2"
PREPARE comando3 FROM selec
DECLARE comp3 CURSOR FOR comando3
LET idx = 1
FOREACH comp3 INTO datos_sp[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
DISPLAY ARRAY datos_sp TO datos_sp1.*
LET idx = ARR_CURR()
CLOSE WINDOW suplidor1
END FUNCTION
FUNCTION inmtad010()
# WHENEVER ERROR CONTINUE
# Captura los datos que va a contener el registro
INPUT BY NAME fact.*
ON KEY (control-W)
CASE
WHEN INFIELD(cod_sp)
CALL busca_suplidor()
LET fact.cod_sp = datos_sp[idx].cod_sp
LET fact.cod_sp_sec = datos_sp[idx].cod_sp_sec
LET nombre = datos_sp[idx].nom_sp
DISPLAY BY NAME fact.cod_sp,fact.cod_sp_sec,nombre
END CASE
AFTER FIELD num_fianza
IF fact.num_fianza = 0 OR fact.num_fianza IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_fianza
END IF
########## Chequea que el numero de fact no exista en la tabla
SELECT UNIQUE a.num_fianza FROM intb00020 a
WHERE a.num_fianza = fact.num_fianza AND
a.tipo_doc = "L"
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_fianza
END IF
AFTER FIELD num_res
IF fact.num_res IS NOT NULL THEN
SELECT UNIQUE a.num_res FROM intb00019 a WHERE a.num_res = fact.num_res
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_res
END IF
END IF
BEFORE FIELD fecha
LET fact.fecha = today
DISPLAY BY NAME fact.fecha
AFTER FIELD fecha
IF fact.fecha IS NULL THEN
LET fact.fecha = today
END IF
AFTER FIELD cod_sp_sec
IF fact.cod_sp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp_sec
END IF
##### Busca el nombre del suplidor
SELECT a.nom_sp INTO nombre FROM cotb00001 a WHERE a.cod_sp = fact.cod_sp
AND a.cod_sp_sec = fact.cod_sp_sec AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME nombre
AFTER FIELD num_oc
IF fact.num_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD num_oc
END IF
AFTER FIELD valor_merc
IF fact.valor_merc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_merc
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
INPUT ARRAY fact3 FROM fact2.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
ON KEY (control-W)
CASE
WHEN INFIELD(cod_n)
LET curr = ARR_CURR()
CALL busca_material()
LET fact3[curr].cod_n = datos_mt[idx].cod_n
LET fact3[curr].cod_grupo = datos_mt[idx].cod_grupo
LET fact3[curr].cod_tipo = datos_mt[idx].cod_tipo
LET fact3[curr].cod_sec = datos_mt[idx].cod_sec
LET fact3[curr].descrip = datos_mt[idx].descrip_esp
LET fact3[curr].unidad = datos_mt[idx].unidad_med
DISPLAY fact3[curr].cod_n,fact3[curr].cod_grupo,fact3[curr].cod_tipo,
fact3[curr].cod_sec,fact3[curr].descrip,fact3[curr].unidad
TO
fact2[fila].cod_n,fact2[fila].cod_grupo,fact2[fila].cod_tipo,
fact2[fila].cod_sec,fact2[fila].descrip,fact2[fila].unidad
NEXT FIELD cod_sec
END CASE
AFTER FIELD cod_sec
IF fact3[curr].cod_sec IS NOT NULL THEN
IF fact3[curr].cod_n IS NULL OR fact3[curr].cod_n > 1 OR
fact3[curr].cod_grupo IS NULL OR
fact3[curr].cod_tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
##### Buscando la descripcion del material
SELECT a.descrip_esp,a.unidad_med
INTO fact3[curr].descrip,fact3[curr].unidad
FROM intb00022 a
WHERE a.cod_n = fact3[curr].cod_n AND a.cod_grupo = fact3[curr].cod_grupo
AND a.cod_tipo = fact3[curr].cod_tipo AND a.cod_sec = fact3[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY fact3[curr].descrip,fact3[curr].unidad TO
fact2[fila].descrip,fact2[fila].unidad
END IF
AFTER FIELD cantidad
IF fact3[curr].cantidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
#### Impide que la cantidad a digitar sea mayor que el balance para esa
#### Produccion y ese numero de resolucion
BEFORE FIELD cantidad_c
LET fact3[curr].cantidad_c = fact3[curr].cantidad
DISPLAY fact3[curr].cantidad_c TO fact2[fila].cantidad_c
AFTER FIELD cantidad_c
IF fact3[curr].cantidad_c IS NULL THEN
LET fact3[curr].cantidad_c = fact3[curr].cantidad
END IF
IF fact3[curr].cantidad_c > fact3[curr].cantidad THEN
LET numero_msg = 153
CALL msg(numero_msg)
NEXT FIELD cantidad_c
END IF
DISPLAY fact3[curr].cantidad_c TO fact2[curr].cantidad_c
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 solicitud #####
FOR idx = 1 TO ARR_COUNT()
IF fact3[idx].cod_n IS NOT NULL AND fact3[idx].cod_grupo IS NOT NULL OR
fact3[idx].cod_tipo IS NOT NULL OR fact3[idx].cod_sec IS NOT NULL THEN
INSERT INTO intb00020 (tipo_doc,num_fianza,num_res,fecha,cod_sp,cod_sp_sec,
num_oc,num_emb,valor_merc,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad,cantidad_c,status_t,us_crea,fech_crea,
us_mod,fech_mod)
VALUES("L",fact.*,fact3[idx].cod_n,fact3[idx].cod_grupo,fact3[idx].cod_tipo,
fact3[idx].cod_sec,fact3[idx].cantidad,fact3[idx].cantidad_c,
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 fact #######
FUNCTION inmtmd010()
# Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.num_fianza,a.num_res,a.fecha
FROM num_fianza,num_res,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_fianza,a.num_res,a.fecha,a.cod_sp,a.cod_sp_sec, ",
"a.num_oc,a.num_emb,a.valor_merc ",
"FROM intb00020 a WHERE a.status_t is null AND a.tipo_doc = 'L' AND ",
criterio clipped,
"ORDER BY 1,3"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
FETCH FIRST datos INTO fact.*
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
SELECT a.nom_sp INTO nombre FROM cotb00001 a
WHERE a.cod_sp = fact.cod_sp AND a.cod_sp_sec = fact.cod_sp_sec
AND a.status_t IS NULL
DISPLAY BY NAME fact.*,nombre
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO fact.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT a.nom_sp INTO nombre FROM cotb00001 a
WHERE a.cod_sp = fact.cod_sp AND a.cod_sp_sec = fact.cod_sp_sec
AND a.status_t IS NULL
DISPLAY BY NAME fact.*,nombre
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO fact.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT a.nom_sp INTO nombre FROM cotb00001 a
WHERE a.cod_sp = fact.cod_sp AND a.cod_sp_sec = fact.cod_sp_sec
AND a.status_t IS NULL
DISPLAY BY NAME fact.*,nombre
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO fact.*
SELECT a.nom_sp INTO nombre FROM cotb00001 a
WHERE a.cod_sp = fact.cod_sp AND a.cod_sp_sec = fact.cod_sp_sec
AND a.status_t IS NULL
DISPLAY BY NAME fact.*,nombre
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO fact.*
SELECT a.nom_sp INTO nombre FROM cotb00001 a
WHERE a.cod_sp = fact.cod_sp AND a.cod_sp_sec = fact.cod_sp_sec
AND a.status_t IS NULL
DISPLAY BY NAME fact.*,nombre
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
INPUT BY NAME fact.num_res THRU fact.valor_merc WITHOUT DEFAULTS
ON KEY (control-W)
CASE
WHEN INFIELD(cod_sp)
CALL busca_suplidor()
LET fact.cod_sp = datos_sp[idx].cod_sp
LET fact.cod_sp_sec= datos_sp[idx].cod_sp_sec
LET nombre = datos_sp[idx].nom_sp
DISPLAY BY NAME fact.cod_sp,fact.cod_sp_sec,nombre
END CASE
AFTER FIELD num_res
IF fact.num_res IS NOT NULL THEN
SELECT UNIQUE a.num_res FROM intb00019 a WHERE a.num_res = fact.num_res
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_res
END IF
END IF
AFTER FIELD fecha
IF fact.fecha IS NULL THEN
LET fact.fecha = today
END IF
AFTER FIELD cod_sp_sec
IF fact.cod_sp_sec IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp_sec
END IF
SELECT a.nom_sp INTO nombre FROM cotb00001 a WHERE a.cod_sp = fact.cod_sp
AND a.cod_sp_sec = fact.cod_sp_sec AND a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME nombre
AFTER FIELD valor_merc
IF fact.valor_merc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD valor_merc
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DECLARE buscar CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.unidad_med,b.descrip_esp,
a.cantidad,a.cantidad_c FROM intb00020 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.num_fianza = fact.num_fianza AND
a.tipo_doc="L"
LET idx = 1
FOREACH buscar INTO fact3[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
INPUT ARRAY fact3 WITHOUT DEFAULTS FROM fact2.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
ON KEY (control-W)
CASE
WHEN INFIELD(cod_n)
CALL busca_material()
LET fact3[curr].cod_n = datos_mt[idx].cod_n
LET fact3[curr].cod_grupo = datos_mt[idx].cod_grupo
LET fact3[curr].cod_tipo = datos_mt[idx].cod_tipo
LET fact3[curr].cod_sec = datos_mt[idx].cod_sec
LET fact3[curr].descrip = datos_mt[idx].descrip_esp
LET fact3[curr].unidad = datos_mt[idx].unidad_med
DISPLAY fact3[curr].cod_n,fact3[curr].cod_grupo,fact3[curr].cod_tipo,
fact3[curr].cod_sec,fact3[curr].descrip,fact3[curr].unidad
TO
fact2[fila].cod_n,fact2[fila].cod_grupo,fact2[fila].cod_tipo,
fact2[fila].cod_sec,fact2[fila].descrip,fact2[fila].unidad
NEXT FIELD cod_sec
END CASE
AFTER FIELD cod_sec
IF fact3[curr].cod_sec IS NOT NULL THEN
IF fact3[curr].cod_n IS NULL OR fact3[curr].cod_n > 1 OR
fact3[curr].cod_grupo IS NULL OR
fact3[curr].cod_tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
##### Buscando la descripcion del material
SELECT a.descrip_esp,a.unidad_med
INTO fact3[curr].descrip,fact3[curr].unidad
FROM intb00022 a
WHERE a.cod_n = fact3[curr].cod_n AND a.cod_grupo = fact3[curr].cod_grupo
AND a.cod_tipo = fact3[curr].cod_tipo AND a.cod_sec = fact3[curr].cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY fact3[curr].descrip,fact3[curr].unidad TO
fact2[fila].descrip,fact2[fila].unidad
END IF
AFTER FIELD cantidad
IF fact3[curr].cantidad IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad
END IF
AFTER FIELD cantidad_c
IF fact3[curr].cantidad_c IS NULL THEN
LET fact3[curr].cantidad_c = fact3[curr].cantidad
END IF
IF fact3[curr].cantidad_c > fact3[curr].cantidad THEN
LET numero_msg = 153
CALL msg(numero_msg)
NEXT FIELD cantidad_c
END IF
DISPLAY fact3[curr].cantidad_c TO fact2[curr].cantidad_c
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
###### Proceso para modificar valores en la tabla o maestra de solicitud #####
DELETE FROM intb00020 WHERE @num_fianza = fact.num_fianza AND @tipo_doc = "L"
FOR idx = 1 TO ARR_COUNT()
IF fact3[idx].cod_n IS NOT NULL AND fact3[idx].cod_grupo IS NOT NULL OR
fact3[idx].cod_tipo IS NOT NULL OR fact3[idx].cod_sec IS NOT NULL THEN
INSERT INTO intb00020 (tipo_doc,num_fianza,num_res,fecha,cod_sp,cod_sp_sec,
num_oc,num_emb,valor_merc,cod_n,cod_grupo,cod_tipo,
cod_sec,cantidad,cantidad_c,status_t,us_crea,fech_crea,
us_mod,fech_mod)
VALUES("L",fact.*,fact3[idx].cod_n,fact3[idx].cod_grupo,fact3[idx].cod_tipo,
fact3[idx].cod_sec,fact3[idx].cantidad,fact3[idx].cantidad_c,
NULL,USER,CURRENT,USER,CURRENT)
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
##### Proceso para eliminar una faction #######
COMMAND KEY ("L") "eLiminar"
UPDATE intb00020 set (status_t,us_mod,fech_mod) =
("E",USER,CURRENT)
WHERE @num_fianza = fact.num_fianza AND
@tipo_doc = "L"
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