{ ------------------------------------------------------------------ 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" " Adiciona Registro Cancela Operacion" let int_flag = false CLEAR FORM CALL adpcad001() COMMAND "Consultar-modificar" " Realiza Busqueda 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" " Actualiza Registro 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 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