Files
MBS/PROYECTO/vedir/veprmt002.4gl
T

297 lines
8.5 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : VEPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Condiciones de Pago.
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 veprmt002()
END MAIN
FUNCTION veprmt002()
# WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
HELP FILE "vepray000.exe",
HELP KEY CONTROL-W,
MESSAGE LINE 24,
COMMENT LINE 21
OPEN FORM vefmmt002 FROM "vefmmt002"
DISPLAY FORM vefmmt002
CALL ayuda()
DISPLAY "veprmt002" AT 4,3
DISPLAY "Condiciones de Pago" AT 6,30
MENU
ON ACTION nuevo
LET int_flag = FALSE
CLEAR FORM
CALL vepcad002()
ON ACTION buscar
LET int_flag = FALSE
CALL vepcmf002()
ON ACTION salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION vepcad002()
## Captura los datos que va a contener el registro
# WHENEVER ERROR CONTINUE
MESSAGE ""
LET int_flag = false
INPUT BY NAME pago.*
## Verifica que el codigo no exista en la tabla de pago. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cond_pago
IF pago.cond_pago IS NULL OR
pago.cond_pago = 0 then
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cond_pago
END IF
SELECT a.* INTO pago.* FROM vetb00012 a
WHERE a.cond_pago = pago.cond_pago
IF status != NOTFOUND THEN
IF pago.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cond_pago
END IF
DISPLAY BY NAME pago.*
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cond_pago
ELSE
INITIALIZE pago.descrip,pago.dias,pago.status_t,pago.us_crea,
pago.fech_crea,pago.us_mod, pago.fech_mod TO NULL
DISPLAY BY NAME pago.descrip,pago.dias,pago.status_t,pago.us_crea,
pago.fech_crea,pago.us_mod,pago.fech_mod
END IF
AFTER FIELD descrip
IF pago.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
AFTER FIELD dias
IF pago.dias IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dias
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# Verifica si la pago existe. Si existe, despliega los datos de la pago.
INSERT INTO vetb00012 (cond_pago,descrip,dias,defecto,us_crea,fech_crea)
VALUES (pago.cond_pago,pago.descrip,pago.dias, pago.defecto,
usuarios,GETDATE())
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION vepcmf002()
# WHENEVER ERROR CONTINUE
MESSAGE ""
LET int_flag = false
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON vetb00012.*
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 vetb00012 ",
"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 pago.*
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 pago.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO pago.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME pago.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO pago.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME pago.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO pago.*
DISPLAY BY NAME pago.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO pago.*
DISPLAY BY NAME pago.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
IF pago.status_t= "E" THEN
LET numero_msg= 36
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME pago.descrip,
pago.dias,
pago.defecto,
pago.us_crea,
pago.fech_crea,
pago.us_mod,
pago.fech_mod WITHOUT DEFAULTS
AFTER FIELD descrip
IF pago.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
AFTER FIELD dias
IF pago.dias IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dias
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 pago.descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip
END IF
IF pago.dias IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD dias
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 vetb00012 SET descrip = pago.descrip,
dias = pago.dias,
defecto = pago.defecto,
us_mod = usuarios,
fech_mod = GETDATE()
WHERE cond_pago = pago.cond_pago
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
"Elimina registro que esta en la pantalla"
UPDATE vetb00012 SET status_t ="E" ,
fech_mod = getdate(),
us_mod = usuarios
WHERE cond_pago = pago.cond_pago
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CALL ayuda()
EXIT MENU
END MENU
END FUNCTION