Files
MBS/PROYECTO/addir/adprmt026.4gl.txt
T

253 lines
6.9 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : adprmt026
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Vacaciones
PROGRAMADOR : Lic. Oscar Castillo
FECHA REALIZACION : Mayo 19, 1993
------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE vaca RECORD
num_emp SMALLINT,
cod_puesto SMALLINT,
nom1_emp CHAR(20),
nom2_emp CHAR(20),
apell1_emp CHAR(20),
apell2_emp CHAR(20),
cedula INTEGER,
serie SMALLINT,
nomina CHAR(1),
fecha_ing DATE,
nom_puesto CHAR(25),
fech_vac DATE
END RECORD
FUNCTION adprmt026()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM adfmmt026 FROM "adfmmt026"
DISPLAY FORM adfmmt001
CALL pantalla()
DISPLAY "adprmt026" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Vacaciones" AT 6,36 ATTRIBUTE(BLACK)
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
let int_flag = false
CLEAR FORM
CALL adpcad001()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
let int_flag = false
CALL adpcmf001()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcad001()
WHENEVER ERROR CONTINUE
## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO
INPUT BY NAME vaca.*
## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE DEPARTAMENTO. SI EXISTE,
## ENTONCES DESPLEGA LOS DATOS DEL REGISTRO EXISTENTE.
AFTER FIELD cod_puesto
IF vaca.cod_puesto IS NOT NULL THEN
SELECT a.nom_puesto INTO m_nom_puesto
FROM adtb00004 a
WHERE a.cod_puesto = vaca.cod_puesto
IF STATUS = NOTFOUND THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_puesto
END IF
DISPLAY BY NAME m_cod_puesto
AFTER FIELD nom_emp
IF vac.nom_emp IS NOT NULL THEN
SELECT a.nom1_emp,a.nom2_emp,a.apell1.emp
a.apell2.emp,a.cedula,a.serie,a.nomina
## SI NO HAY NINGUN PROBLEMA SE PROCEDE A INSERTAR EL REGISTRO
IF depto.nom_dpto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_dpto
ELSE
INSERT INTO adtb00001 VALUES (depto.departamento,depto.nom_dpto,
null, USER, CURRENT, null, null)
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET depto.departamento = NULL
LET depto.nom_dpto = NULL
NEXT FIELD departamento
END IF
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION adpcmf001()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA
## MODIFICACION DE REGISTROS
WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON adtb00001.* FROM adtb00001.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM adtb00001 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 dato SCROLL CURSOR FOR busca
OPEN dato
FETCH FIRST dato INTO depto.*
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
DISPLAY BY NAME depto.*
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT dato INTO depto.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME depto.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS dato INTO depto.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME depto.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST dato INTO depto.*
DISPLAY BY NAME depto.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST dato INTO depto.*
DISPLAY BY NAME depto.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF depto.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
## SE SELECCIONAN LOS CAMPOS QUE SON MODIFICABLES
INPUT BY NAME depto.nom_dpto,
depto.us_crea,
depto.fech_crea,
depto.us_mod,
depto.fech_mod WITHOUT DEFAULTS
AFTER FIELD nom_dpto
IF depto.nom_dpto IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nom_dpto
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
CALL integridad()
IF bandera = 1 THEN
CLEAR SCREEN
RETURN
END IF
## AQUI SE ACTUALIZA EL REGISTRO
UPDATE adtb00001 SET nom_dpto = depto.nom_dpto,
us_mod = USER,
fech_mod = CURRENT
WHERE departamento = depto.departamento
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
## AQUI SE ELIMINAN LOS REGISTROS
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00001 SET status_t = "E"
WHERE departamento = depto.departamento
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION