{ ------------------------------------------------------------------ PROGRAMA : ADPRMT031 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Departamentos Corporativos PROGRAMADOR : Oscar Castillo FECHA REALIZACION : Tuesday, 23 January, 2001 ------------------------------------------------------------------ } GLOBALS "adprgb000.4gl" DEFINE corpo RECORD LIKE adtb00042.* 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 adprmt031() END MAIN FUNCTION adprmt031() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM adfmmt031 FROM "adfmmt031" DISPLAY FORM adfmmt031 DISPLAY "adprmt031" AT 4,3 ATTRIBUTE(RED) DISPLAY "Departamentos Corporativos" AT 6,29 ATTRIBUTE(BLACK) MENU ON ACTION nuevo let int_flag = false INITIALIZE emplea.* TO NULL CALL adpcad031() ON ACTION buscar let int_flag = false CALL adpcmf031() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION adpcad031() # WHENEVER ERROR CONTINUE ## CAPTURA LOS DATOS QUE VA A CONTENER EL REGISTRO INPUT BY NAME corpo.dep_corp, corpo.nombre_depto ## VERIFICA QUE EL CODIGO NO EXISTA EN EL CATALOGO DE NACIONALIDADES. SI ## EXISTE ENTONCES DESPLIEGA LOS DATOS DEL REGISTRO EXISTENTE. AFTER FIELD dep_corp IF corpo.dep_corp IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dep_corp END IF SELECT a.* FROM adtb00042 a WHERE a.dep_corp = corpo.dep_corp AND a.status_t IS NULL IF STATUS != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD dep_corp END IF AFTER FIELD nombre_depto IF corpo.nombre_depto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nombre_depto 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 INSERT INTO adtb00042 VALUES (corpo.dep_corp,corpo.nombre_depto, null, SUSER_SNAME (), GETDATE (), null, null) LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM END INPUT END FUNCTION FUNCTION adpcmf031() ## AQUI SE PREPARA PARA LA CAPTURA DEL CRITERIO DE SELECCION PARA LA ## MODIFICACION DE REGISTROS. # WHENEVER ERROR CONTINUE CONSTRUCT BY NAME criterio ON a.dep_corp,a.nombre_depto IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT a.* FROM adtb00042 a 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 corpo.* 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 corpo.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT dato INTO corpo.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME corpo.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS dato INTO corpo.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME corpo.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST dato INTO corpo.* DISPLAY BY NAME corpo.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST dato INTO corpo.* DISPLAY BY NAME corpo.* 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 corpo.nombre_depto WITHOUT DEFAULTS AFTER FIELD nombre_depto IF corpo.nombre_depto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD nombre_depto 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 adtb00042 SET nombre_depto = corpo.nombre_depto, us_mod = SUSER_SNAME (), fech_mod = GETDATE () WHERE @dep_corp = corpo.dep_corp LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT ## AQUI SE ELIMINAN LOS REGISTROS COMMAND KEY ("L") "eLiminar" UPDATE adtb00042 SET status_t = "E", us_mod = SUSER_SNAME (), fech_mod = GETDATE () WHERE @dep_corp = corpo.dep_corp LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION