Files
2026-09-22 20:38:51 -04:00

334 lines
10 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 "decomarmol" 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"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
HELP 5
LET int_flag = FALSE
CLEAR FORM
CALL vepcad004()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
HELP 6
LET int_flag = FALSE
CALL vepcmf004()
COMMAND "Salir" "Retorna Menu Anterior"
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.*
## 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.*
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 VALUES (zona.cod_zona, zona.descrip,
null,SUSER_SNAME(), GETDATE(), 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_zona
END IF
AFTER FIELD fech_mod
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 vetb00008.* FROM vetb00008.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CALL ayuda()
RETURN
END IF
LET SELEC = "SELECT UNIQUE * FROM vetb00008 ",
"WHERE 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.us_crea,
zona.fech_crea,
zona.us_mod,
zona.fech_mod WITHOUT DEFAULTS
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,
us_mod = SUSER_SNAME(),
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