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

251 lines
6.8 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : ADPRMT004
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Niveles Educativos
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Mayo 20, 1993
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT to "smarmotech" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL adprmt004()
END MAIN
FUNCTION adprmt004()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt004 FROM "adfmmt004"
DISPLAY FORM adfmmt004
DISPLAY "adprmt004" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Niveles Educativos" AT 6,34 ATTRIBUTE(BLACK)
MENU
ON ACTION nuevo
let int_flag = false
INITIALIZE emplea.* TO NULL
CALL adpcad004()
ON ACTION buscar
let int_flag = false
CALL adpcmf004()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad004()
{WHENEVER ERROR CONTINUE}
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME nivel.*
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE NIVELES EDUCATIVOS. SI
## EXISTE ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE.
BEFORE FIELD cod_educa
NEXT FIELD nom_educa
AFTER FIELD nom_educa
IF nivel.nom_educa IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_educa
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
IF nivel.nom_educa IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_educa
ELSE
SELECT MAX(a.cod_educa) INTO nivel.cod_educa FROM adtb00005 a
IF nivel.cod_educa IS NULL THEN
LET nivel.cod_educa = 0
END IF
LET nivel.cod_educa = nivel.cod_educa + 1
INSERT INTO adtb00005 VALUES (nivel.cod_educa,nivel.nom_educa,
null, SUSER_SNAME(), GETDATE(), null, null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET nivel.cod_educa = NULL
LET nivel.nom_educa = NULL
NEXT FIELD cod_educa
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION adpcmf004()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS.
{WHENEVER ERROR CONTINUE}
CONSTRUCT criterio ON adtb00005.cod_educa,adtb00005.nom_educa FROM cod_educa,nom_educa
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM adtb00005 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 nivel.*
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 nivel.cod_educa,nivel.nom_educa
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO nivel.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME nivel.cod_educa,nivel.nom_educa
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO nivel.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME nivel.cod_educa,nivel.nom_educa
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO nivel.*
DISPLAY BY NAME nivel.cod_educa,nivel.nom_educa
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO nivel.*
DISPLAY BY NAME nivel.cod_educa,nivel.nom_educa
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF nivel.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS MODIFICABLES
INPUT BY NAME nivel.nom_educa,
nivel.us_crea,
nivel.fech_crea,
nivel.us_mod,
nivel.fech_mod WITHOUT DEFAULTS
AFTER FIELD nom_educa
IF nivel.nom_educa IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_educa
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 ACTUALIZAN LOS REGISTRO
UPDATE adtb00005 SET nom_educa = nivel.nom_educa,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_educa = nivel.cod_educa
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00005 SET status_t = "E"
WHERE cod_educa = nivel.cod_educa
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION