Files
MBS/PROYECTO/addir/adprmt029.4gl
T

293 lines
8.2 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : ADPRMT029
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Planes de Seguros de Vida
PROGRAMADOR : Oscar Castillo
FECHA REALIZACION : Wednesday, 22 November, 2000
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE seguro RECORD LIKE adtb00040.*
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
let usuarios = "kpolanco"
let clave = "RevolutionX3"
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL adprmt029()
END MAIN
FUNCTION adprmt029()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt029 FROM "adfmmt029"
DISPLAY FORM adfmmt029
DISPLAY "adprmt029" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Plan de Seguros de Vida" AT 6,29 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad029()
ON ACTION buscar
let int_flag = false
CALL adpcmf029()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad029()
# WHENEVER ERROR CONTINUE
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME seguro.cod_plan,
seguro.plan_descrip,
seguro.porc_vida,
seguro.porc_mid,
seguro.porc_comision
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE NACIONALIDADES. SI
## EXISTE ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE.
BEFORE FIELD porc_comision
LET seguro.porc_comision = 10.00
DISPLAY BY NAME seguro.porc_comision
AFTER FIELD cod_plan
IF seguro.cod_plan IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_plan
ELSE
SELECT *
FROM adtb00040
WHERE cod_plan = seguro.cod_plan
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_plan
END IF
END IF
AFTER FIELD plan_descrip
IF seguro.plan_descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD plan_descrip
END IF
AFTER FIELD porc_vida
IF seguro.porc_vida IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_vida
END IF
AFTER FIELD porc_mid
IF seguro.porc_mid IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_mid
END IF
AFTER FIELD porc_comision
IF seguro.porc_comision IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD porc_comision
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
## SI NO OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO
INSERT INTO adtb00040 VALUES (seguro.cod_plan,seguro.plan_descrip,
seguro.porc_vida,seguro.porc_mid,
seguro.porc_comision,
null, SUSER_SNAME (), GETDATE (), null, null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END INPUT
END FUNCTION
FUNCTION adpcmf029()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS.
# WHENEVER ERROR CONTINUE
CONSTRUCT BY NAME criterio ON a.cod_plan,a.plan_descrip
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT a.* FROM adtb00040 a where ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1"
PREPARE busca FROM selec
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
DECLARE dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO seguro.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
END IF
DISPLAY BY NAME seguro.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO seguro.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME seguro.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO seguro.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME seguro.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO seguro.*
DISPLAY BY NAME seguro.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO seguro.*
DISPLAY BY NAME seguro.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF nacion.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS MODIFICABLES
INPUT BY NAME seguro.plan_descrip,
seguro.porc_vida,
seguro.porc_mid,
seguro.porc_comision WITHOUT DEFAULTS
AFTER FIELD plan_descrip
IF seguro.plan_descrip IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD plan_descrip
END IF
#### Verifica si el usuario presiono la tecla <Ctrl-C>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
## AQUI SE ACTUALIZA EL REGISTRO
UPDATE adtb00040 SET plan_descrip = seguro.plan_descrip,
porc_vida = seguro.porc_vida,
porc_mid = seguro.porc_mid,
porc_comision = seguro.porc_comision,
us_mod = SUSER_SNAME (),
fech_mod = GETDATE ()
WHERE cod_plan = seguro.cod_plan
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00040 SET status_t = "E"
WHERE cod_plan = seguro.cod_plan
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION