Files
MBS/PROYECTO/otrodir/msg00000.4gl
T

285 lines
7.9 KiB
Plaintext

{
--------------------------------------------------------------------------------
PROGRAMA : MSG00000
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Mensajes.
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Julio 29, 1992.
--------------------------------------------------------------------------------
}
SCHEMA smarmotech
GLOBALS
DEFINE bandera CHAR(1)
DEFINE mensajes RECORD like msgtable.*
DEFINE criterio char(1000)
DEFINE selec char(500)
DEFINE fecha CHAR(8),
hora char(5)
DEFINE numero_msg smallint
END GLOBALS
MAIN
CLEAR SCREEN
DEFER INTERRUPT
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM msgtable FROM "msgtable"
DISPLAY FORM msgtable
CALL pantalla()
DISPLAY "msgtable" AT 4,3
DISPLAY "Mantenimiento Mensajes" AT 6,29
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
CALL msgpcad01()
COMMAND "Consultar-modificar" "<Esc> Realiza busqueda"
CALL msgpcmf01()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END MAIN
FUNCTION pantalla()
LET fecha = today USING "dd/mm/yy"
LET hora = time
DISPLAY "M A R M O T E C H, S. A." AT 4,27 ATTRIBUTE (REVERSE,YELLOW)
DISPLAY fecha AT 4,70 ATTRIBUTE (YELLOW)
DISPLAY "Mensajes de Errores" AT 5,30
DISPLAY hora AT 6,73 ATTRIBUTE(YELLOW)
CALL fgl_drawbox(5,79,3,1)
CALL fgl_drawbox(1,79,22,1)
END FUNCTION
FUNCTION msgpcad01()
WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
LABEL volver:
INPUT BY NAME mensajes.*
## Verifica que el codigo no exista en la tabla de mensajes. Si existe
## entonces, despliega los datos del registro existente.
AFTER FIELD cod_msg
SELECT * INTO mensajes.* FROM msgtable
WHERE cod_msg = mensajes.cod_msg
IF STATUS != NOTFOUND THEN
DISPLAY BY NAME mensajes.*
LET numero_msg = 12
CALL msg(numero_msg)
LET mensajes.desc_msg = NULL
NEXT FIELD cod_msg
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
AFTER FIELD desc_msg
IF mensajes.desc_msg IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD desc_msg
END IF
IF mensajes.desc_msg IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD desc_msg
ELSE
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
ELSE
INSERT INTO msgtable VALUES (mensajes.cod_msg, mensajes.desc_msg,
USER, CURRENT, null, null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
LET mensajes.cod_msg = NULL
LET mensajes.desc_msg = NULL
GOTO volver
END IF
END IF
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
END FUNCTION
FUNCTION msgpcmf01()
WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
DISPLAY " " at 23,1
CONSTRUCT criterio ON a.cod_msg,a.desc_msg FROM cod_msg,desc_msg
LET SELEC = " SELECT UNIQUE a.* FROM msgtable a where ",
criterio clipped,
" ORDER BY 1"
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO mensajes.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 19
CALL msg(numero_msg)
FETCH LAST datos INTO mensajes.*
END IF
DISPLAY BY NAME mensajes.*
MENU "OPCIONES "
COMMAND "Siguiente"
FETCH NEXT datos INTO mensajes.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
FETCH LAST datos INTO mensajes.*
END IF
DISPLAY BY NAME mensajes.*
COMMAND "Anterior"
FETCH PREVIOUS datos INTO mensajes.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
FETCH FIRST datos INTO mensajes.*
END IF
DISPLAY BY NAME mensajes.*
COMMAND "Primero"
FETCH FIRST datos INTO mensajes.*
DISPLAY BY NAME mensajes.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
FETCH LAST datos INTO mensajes.*
DISPLAY BY NAME mensajes.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro -- <Supr> Cancela Operacion"
INPUT BY NAME mensajes.* WITHOUT DEFAULTS
BEFORE FIELD cod_msg
NEXT FIELD desc_msg
AFTER FIELD desc_msg
IF mensajes.desc_msg IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD desc_msg
END IF
#### Chequee que la variable boleana de interrupcion (INT_FLAG) este falsa o
#### verdadera, si esta verdadera el usuario presiono la techa (DEL)A
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE msgtable SET desc_msg = mensajes.desc_msg,
us_mod = USER,
fech_mod = CURRENT
where cod_msg = mensajes.cod_msg
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
COMMAND "Retornar"
EXIT MENU
END MENU
END FUNCTION
#GLOBALS "inprgb000.4gl"
FUNCTION msg(numero_msg)
{
Esta funcion se utiliza para desplegar mensajes de errores en todos
los sistemas de Ray-O-Vac Dominicana.
Esta funcion busca el mensaje deseado en la tabla "msgtable" y lo
despliega en la linea de mensajes
}
DEFINE numero_msg smallint,
descripcion CHAR(60)
WHENEVER ERROR CONTINUE
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
ERROR descripcion
LET numero_msg = 0
END FUNCTION
FUNCTION integridad()
IF sqlca.sqlcode < 0 THEN
LET numero_msg = sqlca.sqlcode
CALL msg(numero_msg)
DISPLAY numero_msg AT 23,70
LET bandera = 1
SLEEP 2
RETURN
END IF
END FUNCTION