Files
MBS/PROYECTOS/indir/inprmt001.4gl
T

476 lines
16 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : INPRMT001
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Catalogo de Bienes y Servicios
PROGRAMADOR : Lic. Abner Montalvo Z.
MODIFICADO : ING. PAULINO Y LIC. JUAN FCO SOTO
FECHA REALIZACION : Julio 27, 1992.
------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
FUNCTION inprmt001()
WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmmt001 FROM "infmmt001"
DISPLAY FORM infmmt001
CALL pantalla()
DISPLAY "inprmt001" AT 4,3
DISPLAY "Mantenimiento Catalogo Bienes y Servicios" AT 6,19
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
LET int_flag = FALSE
CLEAR FORM
CALL inpcad001()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
LET INT_FLAG = FALSE
CALL inpcmf001()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION inpcad001()
WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
LET int_flag = false
INPUT BY NAME articulos.*
## Verifica que el codigo no exista en el catalogo de articulos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_n
IF articulos.cod_n is null then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER FIELD cod_tipo
IF articulos.cod_tipo is null then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_tipo
END IF
AFTER FIELD cod_grupo
IF articulos.cod_grupo is null then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_grupo
END IF
AFTER FIELD cod_sec
IF (articulos.cod_n is null AND articulos.cod_grupo is null AND
articulos.cod_tipo is null AND articulos.cod_sec is null) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT * INTO articulos.* FROM intb00001
WHERE cod_n = articulos.cod_n AND
cod_grupo = articulos.cod_grupo AND
cod_tipo = articulos.cod_tipo AND
cod_sec = articulos.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF articulos.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME articulos.*
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
{ ELSE
INITIALIZE articulos.descrip_esp,articulos.descrip_ing,
articulos.unidad_med TO NULL
DISPLAY BY NAME
articulos.descrip_esp,articulos.descrip_ing,
articulos.unidad_med }
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
AFTER FIELD descrip_esp
IF articulos.descrip_esp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
## Verifica si la unidad de medida existe en la tabla correspondiente.
AFTER FIELD unidad_med
IF articulos.unidad_med IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD unidad_med
ELSE
SELECT codigo_unidad FROM intb00007
WHERE codigo_unidad = articulos.unidad_med and
status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 17
CALL msg(numero_msg)
NEXT FIELD unidad_med
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF articulos.unidad_med IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD unidad_med
ELSE
SELECT codigo_unidad FROM intb00007
WHERE codigo_unidad = articulos.unidad_med and
status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 17
CALL msg(numero_msg)
NEXT FIELD unidad_med
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
# Verifica si el articulo existe. Si existe, despliega los datos del articulo.
IF ( articulos.cod_n is null AND articulos.cod_grupo is null AND
articulos.cod_tipo is null AND articulos.cod_sec is null) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT * INTO articulos.* FROM intb00001
WHERE cod_n = articulos.cod_n AND
cod_grupo = articulos.cod_grupo AND
cod_tipo = articulos.cod_tipo AND
cod_sec = articulos.cod_sec
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
IF articulos.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME articulos.*
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
{ELSE
INITIALIZE articulos.descrip_esp,articulos.descrip_ing,
articulos.unidad_med TO NULL
DISPLAY BY NAME
articulos.descrip_esp,articulos.descrip_ing,
articulos.unidad_med }
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
# 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.
IF ( articulos.cod_n is null AND articulos.cod_grupo is null AND
articulos.cod_tipo is null AND articulos.cod_sec is null) THEN
LET numero_msg = 16
CALL msg(numero_msg)
ELSE
INSERT INTO intb00001 VALUES (articulos.cod_n, articulos.cod_grupo,
articulos.cod_tipo, articulos.cod_sec, articulos.descrip_esp,
articulos.descrip_ing, articulos.unidad_med, null,USER,
CURRENT, null, null)
# 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 .
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION inpcmf001()
WHENEVER ERROR CONTINUE
LET int_flag = false
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON intb00001.* FROM intb00001.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM intb00001 where ",
" status_t is null and ",
criterio clipped,
" 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 FOR busca
OPEN datos
FETCH FIRST datos INTO 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
DISPLAY BY NAME articulos.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME articulos.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO articulos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME articulos.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO articulos.*
DISPLAY BY NAME articulos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO articulos.*
DISPLAY BY NAME articulos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF articulos.status_t="E" THEN
LET numero_msg= 36
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME articulos.descrip_esp,
articulos.descrip_ing,
articulos.unidad_med,
articulos.us_crea,
articulos.fech_crea,
articulos.us_mod,
articulos.fech_mod WITHOUT DEFAULTS
AFTER FIELD descrip_esp
IF articulos.descrip_esp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
AFTER FIELD unidad_med
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF articulos.unidad_med IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD unidad_med
ELSE
SELECT codigo_unidad FROM intb00007
WHERE codigo_unidad = articulos.unidad_med
IF STATUS = NOTFOUND THEN
LET numero_msg = 17
CALL msg(numero_msg)
NEXT FIELD unidad_med
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
## Chequea que el codigo se encuentre en la tabla de articulos
IF STATUS = NOTFOUND THEN
LET numero_msg = 19
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF articulos.unidad_med IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD unidad_med
ELSE
SELECT codigo_unidad FROM intb00007
WHERE codigo_unidad = articulos.unidad_med
AND status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 17
CALL msg(numero_msg)
NEXT FIELD unidad_med
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
IF articulos.descrip_esp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
## Chequea que el codigo se encuentre en la tabla de articulos
{ IF STATUS = NOTFOUND THEN
LET numero_msg = 19
CALL msg(numero_msg)
NEXT FIELD descrip_esp
END IF
}
EXIT INPUT
END INPUT
#### Verifica si el usuario presiono la tecla <Supr>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
{ IF articulos.unidad_med IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
ELSE
} UPDATE intb00001 SET descrip_esp = articulos.descrip_esp,
descrip_ing = articulos.descrip_ing,
unidad_med = articulos.unidad_med,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = articulos.cod_n AND
cod_grupo = articulos.cod_grupo AND
cod_tipo = articulos.cod_tipo AND
cod_sec = articulos.cod_sec
{ END IF
}
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE intb00001 SET status_t ="E" ,
us_mod = user,
fech_mod = current
where cod_n = articulos.cod_n and
cod_grupo = articulos.cod_grupo AND
cod_tipo = articulos.cod_tipo AND
cod_sec = articulos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
EXIT MENU
END MENU
END FUNCTION