Files
MBS/PROYECTO/vedir/veprmt004.4gl
T
2026-08-21 09:12:24 -04:00

363 lines
11 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : VEPRMT004
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Zonas.
PROGRAMADOR : Lic. Abner Montalvo Z.
FECHA REALIZACION : Septiembre 14, 1992.
------------------------------------------------------------------
}
GLOBALS "veprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT TO "smarmotech" USER usuarios USING clave
CALL veprmt004()
END MAIN
FUNCTION veprmt004()
# WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS FORM LINE 9,
ERROR LINE 23,
HELP FILE "vepray000.exe",
HELP KEY CONTROL-W,
COMMENT LINE 21
OPEN FORM vefmmt004 FROM "vefmmt004"
DISPLAY FORM vefmmt004
# CALL ayuda()
DISPLAY "veprmt004" AT 4, 3
DISPLAY "Zonas" AT 6, 37
MENU "OPCIONES"
ON ACTION Adicionar
LET int_flag = FALSE
CLEAR FORM
CALL vepcad004()
ON ACTION Consultar_modificar
LET int_flag = FALSE
CALL vepcmf004()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION vepcad004()
## Captura los datos que va a contener el registro
# WHENEVER ERROR CONTINUE
MESSAGE ""
LET int_flag = FALSE
INPUT BY NAME zona.cod_zona, zona.descrip, zona.codigo
BEFORE INPUT
SELECT ISNULL(MAX(a.cod_zona), 0)
INTO zona.cod_zona
FROM vetb00008 a
LET zona.cod_zona = zona.cod_zona + 1
DISPLAY BY NAME zona.cod_zona
## Verifica que el codigo no exista en el catalogo de zona. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_zona
IF zona.cod_zona IS NULL OR zona.cod_zona = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_zona
ELSE
SELECT *
INTO zona.*
FROM vetb00008
WHERE cod_zona = zona.cod_zona
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF zona.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_zona
END IF
DISPLAY BY NAME zona.*
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_zona
ELSE
INITIALIZE zona.descrip,
zona.status_t,
zona.us_crea,
zona.fech_crea,
zona.us_mod,
zona.fech_mod TO NULL
DISPLAY BY NAME zona.descrip,
zona.status_t,
zona.us_crea,
zona.fech_crea,
zona.us_mod,
zona.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
AFTER FIELD descrip
IF zona.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
# CALL ayuda()
RETURN
END IF
# Verifica si la zona existe. Si existe, despliega los datos de la zona.
IF zona.cod_zona IS NULL OR zona.cod_zona = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_zona
ELSE
SELECT *
INTO zona.*
FROM vetb00008
WHERE cod_zona = zona.cod_zona
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
IF zona.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_zona
END IF
DISPLAY BY NAME zona.descrip
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_zona
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END IF
# Valida que el codigo de la zona 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 zona.cod_zona IS NULL OR zona.cod_zona = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
ELSE
INSERT INTO vetb00008(
cod_zona,
descrip,
us_crea,
fech_crea,
codigo,
porcTransporte)
VALUES(zona.cod_zona,
zona.descrip,
SUSER_SNAME(),
GETDATE(),
zona.codigo,
zona.porctransporte)
# 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_zona
END IF
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION vepcmf004()
# WHENEVER ERROR CONTINUE
MESSAGE ""
LET int_flag = FALSE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.cod_zona, a.descrip FROM cod_Zona, descrip
BEFORE CONSTRUCT
CALL paises()
AFTER CONSTRUCT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
# CALL ayuda()
RETURN
END IF
EXIT CONSTRUCT
END CONSTRUCT
LET SELEC =
"SELECT UNIQUE a.* FROM vetb00008 a ",
"WHERE a.status_t is null and ",
criterio CLIPPED,
" ORDER BY 1"
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 zona.*
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 zona.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO zona.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME zona.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO zona.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME zona.*
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO zona.*
DISPLAY BY NAME zona.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO zona.*
DISPLAY BY NAME zona.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
IF zona.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME zona.descrip,
zona.codigo,
zona.us_crea,
zona.fech_crea,
zona.us_mod,
zona.fech_mod
WITHOUT DEFAULTS
BEFORE INPUT
CALL paises()
AFTER FIELD descrip
IF zona.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
AFTER INPUT
#### Verifica si el usuario presiono la tecla <Delete>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
# CALL ayuda()
RETURN
END IF
IF zona.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
EXIT INPUT
END INPUT
#### Verifica si el usuario presiono la tecla <Delete>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
# CALL ayuda()
RETURN
END IF
UPDATE vetb00008
SET descrip = zona.descrip,
codigo = zona.codigo,
us_mod = usuarios,
fech_mod = GETDATE()
WHERE cod_zona = zona.cod_zona
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY("L") "eLiminar" "Elimina registro que esta en la pantalla"
UPDATE vetb00008 SET status_t = "E" WHERE cod_zona = zona.cod_zona
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
# CALL ayuda()
EXIT MENU
END MENU
END FUNCTION