{ --------------------------------------------------------------------------- PROGRAMA : ADPRMT007 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Acciones de Seleccion y Contratacion PROGRAMADOR : Ing. Betania Guerrero Perez FECHA REALIZACION : Mayo 21, 1993 --------------------------------------------------------------------------- } GLOBALS "adprgb000.4gl" MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CALL ARG_VAL(3) RETURNING impresor #let usuarios = "kpolanco" #let clave = "RevolutionX3" CONNECT to "smarmotech" USER usuarios USING clave SELECT a.* INTO p_companias.* FROM companias a CALL adprmt007() END MAIN FUNCTION adprmt007() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM adfmmt007 FROM "adfmmt007" DISPLAY FORM adfmmt007 DISPLAY "adprmt007" AT 4,3 ATTRIBUTE(RED) DISPLAY "Acciones de Seleccion y Contratacion" AT 6,24 ATTRIBUTE(BLACK) MENU ON ACTION nuevo let int_flag = false INITIALIZE emplea.* TO NULL CALL adpcmf007() ON ACTION buscar let int_flag = false CALL adpcad007() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION adpcad007() WHENEVER ERROR CONTINUE ## CAPTURA LOS DATOS QUE VA A CONTERNER EL REGISTRO INPUT BY NAME seleccion.* ## VERIFICA QUE EL CODIGO NO EXISTE EN EL CATALOGO DE ACCIONES. SI EXISTE ## ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE. AFTER FIELD cod_requi IF seleccion.cod_requi IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_requi ELSE SELECT * INTO seleccion.* FROM adtb00008 WHERE cod_requi = seleccion.cod_requi IF status >= 0 THEN IF status != NOTFOUND THEN IF seleccion.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_requi END IF DISPLAY BY NAME seleccion.* LET numero_msg = 12 CALL msg(numero_msg) LET seleccion.requisito = NULL NEXT FIELD cod_requi END IF ELSE IF bandera = 1 THEN CLEAR SCREEN RETURN END IF END IF END IF AFTER FIELD requisito IF seleccion.requisito IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD requisito 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 OCURRE NINGUN ERROR SE PROCEDE A INSERTAR EL REGISTRO IF seleccion.requisito IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD requisito ELSE INSERT INTO adtb00008 VALUES (seleccion.cod_requi,seleccion.requisito, null, SUSER_SNAME (), GETDATE(), null, null) LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM LET seleccion.cod_requi = NULL LET seleccion.requisito = NULL NEXT FIELD cod_requi END IF AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION adpcmf007() ## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA ## MODIFICACION DE REGISTROS. WHENEVER ERROR CONTINUE CONSTRUCT criterio ON adtb00008.* FROM adtb00008.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM adtb00008 where ", " status_t is null and ", criterio clipped, " ORDER BY 1" PREPARE busca FROM selec IF bandera = 1 THEN CLEAR SCREEN RETURN END IF DECLARE dato SCROLL CURSOR FOR busca OPEN dato FETCH FIRST dato INTO seleccion.* IF status >= 0 THEN IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF ELSE IF bandera = 1 THEN CLEAR SCREEN RETURN END IF END IF DISPLAY BY NAME seleccion.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT dato INTO seleccion.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME seleccion.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS dato INTO seleccion.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME seleccion.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST dato INTO seleccion.* DISPLAY BY NAME seleccion.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST dato INTO seleccion.* DISPLAY BY NAME seleccion.* LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" IF seleccion.status_t = "E" THEN LET numero_msg = 39 CALL msg(numero_msg) RETURN END IF ## SE SELECCINAN LOS CAMPOS MODIFICABLES INPUT BY NAME seleccion.requisito, seleccion.us_crea, seleccion.fech_crea, seleccion.us_mod, seleccion.fech_mod WITHOUT DEFAULTS AFTER FIELD requisito IF seleccion.requisito IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD requisito 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 IF bandera = 1 THEN CLEAR SCREEN RETURN END IF ## AQUI SE PROCEDE A ACTUALIZAR EL REGISTRO UPDATE adtb00008 SET requisito = seleccion.requisito, us_mod = SUSER_SNAME (), fech_mod = GETDATE() WHERE cod_requi = seleccion.cod_requi LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT ## AQUI SE ELIMINAN LOS REGISTROS COMMAND KEY ("L") "eLiminar" UPDATE adtb00008 SET status_t = "E" WHERE cod_requi = seleccion.cod_requi LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION