{ ------------------------------------------------------------------ PROGRAMA : IPPRMT003 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla Grupos iptb00029. PROGRAMADOR : Ing. Juan Soto. FECHA REALIZACION : Enero 20, 2010. ------------------------------------------------------------------ } GLOBALS "ipprgb000.4gl" DEFINE intb32 RECORD LIKE iptb00029.* MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CONNECT to "smarmotech" USER usuarios USING clave SELECT * INTO p_companias.* FROM companias CALL ipprmt012() END MAIN FUNCTION ipprmt012() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, COMMENT LINE 21 OPEN FORM ipfmmt012 FROM "ipfmmt012" DISPLAY FORM ipfmmt012 MENU ON ACTION nuevo let int_flag = false CLEAR FORM let int_flag = false CALL ippcad012() ON ACTION buscar CALL ippcmf012() ON ACTION salir EXIT MENU END MENU END FUNCTION FUNCTION ippcad012() ## Captura los datos que va a contener el registro #WHENEVER ERROR CONTINUE INPUT BY NAME intb32.* AFTER INPUT IF int_flag THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF END INPUT SELECT MAX(a.cod_grupo) INTO intb32.cod_grupo FROM iptb00029 a IF intb32.cod_grupo IS NULL THEN LET intb32.cod_grupo = 0 END IF LET intb32.cod_grupo = intb32.cod_grupo + 1 DISPLAY intb32.cod_grupo TO cod_grupo INSERT INTO iptb00029 VALUES (intb32.*) UPDATE iptb00029 set us_crea = SUSER_SNAME(), fech_crea = GETDATE() WHERE cod_grupo = intb32.cod_grupo LET numero_msg = 1 CALL msg(numero_msg) END FUNCTION FUNCTION ippcmf012() DEFINE encontrados INTEGER ## Aqui se prepara para la captura del criterio de seleccion #WHENEVER ERROR CONTINUE CONSTRUCT BY NAME criterio ON iptb00029.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT DISTINCT * FROM iptb00029 ", " WHERE ", criterio clipped, " ORDER BY cod_grupo" PREPARE busca FROM selec DECLARE datos SCROLL CURSOR WITH HOLD FOR busca OPEN datos FETCH FIRST datos INTO intb32.* IF status >= 0 THEN IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF ELSE END IF DISPLAY BY NAME intb32.* MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO intb32.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME intb32.* COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO intb32.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME intb32.* COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO intb32.* DISPLAY BY NAME intb32.* LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO intb32.* DISPLAY BY NAME intb32.* LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" # Verifica que el movimiento sea del usuario creador IF intb32.status_t IS NOT NULL THEN CALL msg(36) EXIT MENU END IF INPUT BY NAME intb32.descripcion WITHOUT DEFAULTS AFTER INPUT #### Verifica si el usuario presiono la tecla IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE EXIT INPUT END IF UPDATE iptb00029 SET descripcion = intb32.descripcion, us_mod = SUSER_SNAME(), fech_mod = GETDATE() WHERE cod_grupo = intb32.cod_grupo LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT COMMAND KEY ("L") "eLiminar" LET encontrados = 0 SELECT count(*) INTO encontrados FROM iptb00002 WHERE cod_grupo = intb32.cod_grupo AND status_t IS NULL IF encontrados = 0 THEN UPDATE iptb00029 SET status_t = "E", us_mod = SUSER_SNAME(), fech_mod = GETDATE() WHERE cod_grupo = intb32.cod_grupo LET numero_msg = 39 CALL msg(numero_msg) ELSE LET numero_msg = 383 CALL msg(numero_msg) END IF COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION