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

253 lines
7.4 KiB
Plaintext

{
----------------------------------------------------------------------------
PROGRAMA : ADPRMT024
OBJETIVO : Modificar y Eliminar registros de la
Tabla de Registro de Informacion Personal
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Junio 16, 1993
MODIFICADOR : Tadeo A. Ferreras
FECHA MODIFICACION: Noviembre 01, 1995
OBJETIVO : Modificacion de la tabla para asignar codigo a los
dependientes
----------------------------------------------------------------------------
}
GLOBALS "adprgb000.4gl"
DEFINE datos_p34 RECORD
num_emp INTEGER,
departamento INTEGER,
nivel_emp INTEGER,
cod_puesto INTEGER,
nombre1 CHAR(30)
END RECORD,
arr_reg34 ARRAY[200] OF RECORD
cod_par INTEGER,
sec_par INTEGER,
nombre CHAR(30),
cedula CHAR(20),
sexo CHAR(1),
fecha DATE
END RECORD
FUNCTION adprmt024()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 23
CALL pantalla()
DISPLAY "adprmt024" AT 4,3 ATTRIBUTE (RED)
DISPLAY "Dependientes de Empleados" AT 6,27 ATTRIBUTE(BLACK)
OPEN FORM adfmmt024 FROM "adfmmt024"
DISPLAY FORM adfmmt024
MENU "OPCIONES"
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
LET INT_FLAG = FALSE
CALL adpcmf024()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION adpcmf024()
## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA CONSULTA Y
## MODIFICACION DE REGISTROS
# WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto
FROM num_emp,departamento,nivel_emp,cod_puesto
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC =
"SELECT UNIQUE a.num_emp,a.departamento,a.nivel_emp,a.cod_puesto,b.nombre ",
"FROM adtb00003 a,adtb00034 b ",
"WHERE (a.status_t IS NULL OR a.status_t IN ('I','D')) AND ",
" (a.num_emp = b.num_emp) AND ",criterio clipped," AND ",
" (b.cod_par = 0 AND b.sec_par = 0) ORDER BY 2,1"
PREPARE comando FROM selec
DECLARE datos SCROLL CURSOR FOR comando
OPEN datos
FETCH FIRST datos INTO datos_p34.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
END IF
DISPLAY BY NAME datos_p34.*
MENU "OPCION"
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO datos_p34.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME datos_p34.*
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO datos_p34.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME datos_p34.*
COMMAND "Primero" "Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO datos_p34.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO datos_p34.*
LET numero_msg = 4
CALL msg(numero_msg)
DISPLAY BY NAME datos_p34.*
COMMAND "Escoger" "<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
## SE SELECCIONAN LOS CAMPOS QUE PUEDEN SER MODIFICABLES
DECLARE busca CURSOR FOR
SELECT a.cod_par,a.sec_par,a.nombre,a.cedula,a.sexo,a.fecha_nac
FROM adtb00034 a
WHERE (a.status_t IS NULL ) AND (a.num_emp = datos_p34.num_emp) AND
(a.cod_par > 0 AND a.sec_par > 0) ORDER BY 1,2
LET idx = 1
FOREACH busca INTO arr_reg34[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
INPUT ARRAY arr_reg34 WITHOUT DEFAULTS FROM scr_reg34.*
BEFORE ROW
LET curr = ARR_CURR()
LET fila = SCR_LINE()
AFTER FIELD cod_par
IF arr_reg34[curr].cod_par IS NOT NULL THEN
IF arr_reg34[curr].cod_par = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_par
END IF
SELECT UNIQUE a.cod_par FROM adtb00025 a
WHERE a.cod_par = arr_reg34[curr].cod_par
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_par
END IF
END IF
AFTER FIELD sec_par
IF arr_reg34[curr].sec_par IS NOT NULL THEN
IF arr_reg34[curr].sec_par = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sec_par
END IF
FOR idx = 1 TO ARR_COUNT()
IF idx <> curr THEN
IF arr_reg34[idx].cod_par = arr_reg34[curr].cod_par AND
arr_reg34[idx].sec_par = arr_reg34[curr].sec_par THEN
ERROR "CODIGO EXISTE EN LA LINEA ",idx USING "<<<"
NEXT FIELD cod_par
END IF
END IF
END FOR
END IF
AFTER FIELD nombre
IF arr_reg34[curr].cod_par IS NOT NULL THEN
IF arr_reg34[curr].nombre IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD nombre
END IF
END IF
AFTER FIELD sexo
IF arr_reg34[curr].cod_par IS NOT NULL THEN
IF arr_reg34[curr].sexo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD sexo
END IF
END IF
### Controlando que la fecha no sea nula ni mayor a la fecha actual
AFTER FIELD fecha
IF arr_reg34[curr].cod_par IS NOT NULL AND
arr_reg34[curr].cod_par = 4 THEN
IF arr_reg34[curr].fecha IS NULL OR arr_reg34[curr].fecha>TODAY THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
END IF
END INPUT
#### Proceso Para Cancelar La Operacion
IF INT_FLAG THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET INT_FLAG = FALSE
RETURN
END IF
DELETE FROM adtb00034 WHERE @num_emp = datos_p34.num_emp AND @cod_par > 0
## AQUI SE MODIFICA Y ACTUALIZA LA INFORMACION DE LOS HIJOS DE LOS EMPLEADOS
FOR idx = 1 TO ARR_COUNT()
IF arr_reg34[idx].cod_par IS NOT NULL AND
arr_reg34[idx].sec_par IS NOT NULL THEN
INSERT INTO adtb00034
VALUES (datos_p34.num_emp,arr_reg34[idx].cod_par,arr_reg34[idx].sec_par,
arr_reg34[idx].nombre,arr_reg34[idx].cedula,arr_reg34[idx].sexo,
arr_reg34[idx].fecha,NULL,USER,CURRENT,NULL,NULL)
END IF
END FOR
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
UPDATE adtb00034 SET status_t = "E" WHERE num_emp = datos_p34.num_emp
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION