{ ---------------------------------------------------------------------------- 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" " Realiza Busqueda 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" " Actualiza Registro 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