{ ------------------------------------------------------------------ PROGRAMA : ADPRMT001 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Departamentos PROGRAMADOR : Ing. Betania Guerrero Perez FECHA REALIZACION : Mayo 19, 1993 ------------------------------------------------------------------ } GLOBALS "adprgb000.4gl" FUNCTION adprmt001() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM adfmmt001 FROM "adfmmt001" DISPLAY FORM adfmmt001 CALL pantalla() DISPLAY "adprmt001" AT 4,3 DISPLAY "Departamentos" AT 6,36 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 depto.* ## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE DEPARTAMENTO. SI EXISTE, ## ENTONCES DESPLEGA LOS DATOS DEL REGISTRO EXISTENTE. AFTER FIELD departamento IF depto.departamento IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD departamento ELSE SELECT * INTO depto.* FROM adtb00001 WHERE departamento = depto.departamento IF status >= 0 THEN IF status != NOTFOUND THEN IF depto.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD departamento END IF DISPLAY BY NAME depto.* LET numero_msg = 12 CALL msg(numero_msg) LET depto.nom_dpto = NULL NEXT FIELD departamento END IF ELSE CALL integridad() IF bandera = 1 THEN CLEAR SCREEN RETURN END IF END IF END IF 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 AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF ## 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