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

340 lines
10 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : VEPRMT012
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Control de Itbi.
PROGRAMADOR : Ing. Juan Fco. Soto (Johnny)
FECHA REALIZACION : Febrero 2, 1993.
------------------------------------------------------------------
}
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 veprmt012()
END MAIN
FUNCTION veprmt012()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM vefmmt012 FROM "vefmmt012"
DISPLAY FORM vefmmt012
DISPLAY "veprmt012" AT 4,3
DISPLAY "Itbis y Prima" AT 6,33
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
let int_flag = false
CLEAR FORM
CALL vepcad012()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
let int_flag = false
CALL vepcmf012()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION vepcad012()
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME datos.*
AFTER FIELD ano
IF datos.ano IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
LET ano_c = year(today)
IF datos.ano != ano_c THEN
LET numero_msg = 59
CALL msg(numero_msg)
NEXT FIELD ano
END IF
AFTER FIELD mes_ini
IF datos.mes_ini IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_ini
END IF
SELECT descrip INTO descrip1 FROM mestable
WHERE mes = datos.mes_ini
DISPLAY BY NAME descrip1 ATTRIBUTE (BOLD)
AFTER FIELD mes_fin
IF datos.mes_fin IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_fin
END IF
SELECT descrip INTO descrip2 FROM mestable
WHERE mes = datos.mes_fin
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
SELECT * INTO datos.* FROM vetb00019
WHERE mes_ini = datos.mes_ini and mes_fin = datos.mes_fin and
ano = datos.ano
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
ELSE
IF status != notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
DISPLAY BY NAME datos.*
NEXT FIELD ano
END IF
END IF
AFTER FIELD disponible
IF datos.disponible = "S" THEN
SELECT unique disponible FROM vetb00019
WHERE disponible = datos.disponible and status_t is null
IF status != notfound THEN
LET numero_msg = 88
CALL msg(numero_msg)
NEXT FIELD disponible
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 datos.prima is null or datos.itbi is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD ano
END IF
IF datos.mes_fin IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD mes_fin
ELSE
INSERT INTO vetb00019
VALUES (datos.ano,datos.mes_ini,datos.mes_fin,datos.prima,
datos.itbi,datos.porciento,datos.disponible,null,SUSER_SNAME(),
GETDATE(),null,null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET datos.ano = NULL
LET datos.mes_ini = NULL
LET datos.mes_fin = NULL
LET datos.prima = NULL
LET datos.itbi = NULL
LET datos.porciento = NULL
NEXT FIELD ano
END IF
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION vepcmf012()
## Aqui se prepara para la captura del criterio de seleccion
# WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON vetb00019.* FROM vetb00019.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE * FROM vetb00019 WHERE status_t is null and ",
criterio clipped," ORDER BY 1"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO datos.*
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
CLEAR SCREEN
RETURN
end if
end if
SELECT descrip INTO descrip1 FROM mestable WHERE mes = datos.mes_ini
SELECT descrip INTO descrip2 FROM mestable WHERE mes = datos.mes_fin
DISPLAY BY NAME datos.*,descrip1,descrip2
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO datos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable WHERE mes = datos.mes_ini
SELECT descrip INTO descrip2 FROM mestable WHERE mes = datos.mes_fin
DISPLAY BY NAME datos.*
DISPLAY BY NAME descrip1,descrip2
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO datos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip INTO descrip1 FROM mestable WHERE mes = datos.mes_ini
SELECT descrip INTO descrip2 FROM mestable WHERE mes = datos.mes_fin
DISPLAY BY NAME datos.*
DISPLAY BY NAME descrip1,descrip2
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO datos.*
SELECT descrip INTO descrip1 FROM mestable WHERE mes = datos.mes_ini
SELECT descrip INTO descrip2 FROM mestable WHERE mes = datos.mes_fin
DISPLAY BY NAME datos.*
DISPLAY BY NAME descrip1,descrip2
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO datos.*
SELECT descrip INTO descrip1 FROM mestable WHERE mes = datos.mes_ini
SELECT descrip INTO descrip2 FROM mestable WHERE mes = datos.mes_fin
DISPLAY BY NAME datos.*
DISPLAY BY NAME descrip1,descrip2
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Delete> Cancela Operacion"
IF datos.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME datos.prima,datos.itbi,datos.porciento,
datos.disponible
WITHOUT DEFAULTS
AFTER FIELD prima
IF datos.prima is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD prima
END IF
AFTER FIELD itbi
IF datos.itbi is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD itbi
END IF
AFTER FIELD disponible
IF datos.disponible = "S" THEN
UPDATE vetb00019 SET disponible = null
WHERE ano = datos.ano and
mes_ini = datos.mes_ini and
mes_fin = datos.mes_fin
SELECT unique disponible FROM vetb00019
WHERE disponible = datos.disponible and
status_t is null
IF status != notfound THEN
LET numero_msg = 88
CALL msg(numero_msg)
NEXT FIELD disponible
END IF
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF datos.itbi is null or datos.prima is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD prima
END IF
UPDATE vetb00019 SET prima = datos.prima,
itbi = datos.itbi,
porciento = datos.porciento,
disponible = datos.disponible,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE ano = datos.ano and
mes_ini = datos.mes_ini and
mes_fin = datos.mes_fin
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE vetb00019 SET status_t = "E"
WHERE ano = datos.ano and
mes_ini = datos.mes_ini and
mes_fin = datos.mes_fin
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION