{ ------------------------------------------------------------------ PROGRAMA : ADPRMT006 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Nacionalidades PROGRAMADOR : Ing. Betania Guerrero Perez FECHA REALIZACION : Mayo 20, 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 CONNECT to "smarmotech" USER usuarios USING clave SELECT a.* INTO p_companias.* FROM companias a CALL adprmt006() END MAIN FUNCTION adprmt006() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM adfmmt006 FROM "adfmmt006" DISPLAY FORM adfmmt006 DISPLAY "adprmt006" AT 4,3 ATTRIBUTE(RED) DISPLAY "Nacionalidades" AT 6,36 ATTRIBUTE(BLACK) MENU ON ACTION nuevo let int_flag = false INITIALIZE emplea.* TO NULL CALL adpcad006() ON ACTION buscar let int_flag = false CALL adpcmf006() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION adpcad006() WHENEVER ERROR CONTINUE ## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO INPUT BY NAME nacion.* ## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE NACIONALIDADES. SI ## EXISTE ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE. BEFORE FIELD cod_nac NEXT FIELD nom_nac AFTER FIELD nom_nac IF nacion.nom_nac IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_nac 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 nacion.nom_nac IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_nac ELSE SELECT MAX(a.cod_nac) INTO nacion.cod_nac FROM adtb00007 a IF nacion.cod_nac IS NULL THEN LET nacion.cod_nac =0 END IF LET nacion.cod_nac = nacion.cod_nac + 1 INSERT INTO adtb00007 VALUES (nacion.cod_nac,nacion.nom_nac, null, SUSER_SNAME (), GETDATE(), null, null) LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM LET nacion.cod_nac = NULL LET nacion.nom_nac = NULL NEXT FIELD cod_nac END IF AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION adpcmf006() ## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA ## MODIFICACION DE REGISTROS. #WHENEVER ERROR CONTINUE CONSTRUCT criterio ON adtb00007.cod_nac FROM cod_nac IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM adtb00007 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 nacion.* 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 nacion.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT dato INTO nacion.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME nacion.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS dato INTO nacion.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME nacion.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST dato INTO nacion.* DISPLAY BY NAME nacion.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST dato INTO nacion.* DISPLAY BY NAME nacion.* LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" IF nacion.status_t = "E" THEN LET numero_msg = 39 CALL msg(numero_msg) RETURN END IF ## SE SELECCIONAN LOS CAMPOS MODIFICABLES INPUT BY NAME nacion.nom_nac, nacion.us_crea, nacion.fech_crea, nacion.us_mod, nacion.fech_mod WITHOUT DEFAULTS AFTER FIELD nom_nac IF nacion.nom_nac IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nom_nac 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 ACTUALIZA EL REGISTRO UPDATE adtb00007 SET nom_nac = nacion.nom_nac, us_mod = SUSER_SNAME (), fech_mod = GETDATE() WHERE cod_nac = nacion.cod_nac LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT ## AQUI SE ELIMINAN LOS REGISTROS COMMAND KEY ("L") "eLiminar" UPDATE adtb00007 SET status_t = "E" WHERE cod_nac = nacion.cod_nac LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION