Files
MBS/PROYECTO/tedir/teprmt004.4gl
T

233 lines
6.6 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : TEPRMT004
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Partidas del Cash Flow
PROGRAMADOR : Tadeo A. Ferreras
FECHA REALIZACION : Diciembre 06, 1995.
------------------------------------------------------------------
}
GLOBALS "teprgb000.4gl"
DEFINE cod INT,descrip CHAR(100)
DEFINE p_tetb03b DYNAMIC ARRAY OF RECORD
codigo INT,
descripcion CHAR(30),
tipo CHAR(2),
us_crea CHAR(100),
fech_crea DATE,
us_mod CHAR(100),
fech_mod date
END record
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL STARTLOG("teprmt004.txt")
CONNECT to "smarmotech" USER usuarios USING clave
DISPLAY "user",usuarios
CALL teprmt004()
END MAIN
FUNCTION teprmt004()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
MESSAGE LINE 24,
COMMENT LINE 21
OPEN FORM tefmmt004 FROM "tefmmt004"
DISPLAY FORM tefmmt004
DISPLAY "teprmt004" AT 4,3 ATTRIBUTE(RED)
DISPLAY "Maestra de Partidas Del Cash-Flow" at 6,24 ATTRIBUTE(BLACK)
MENU "OPCIONES"
ON ACTION Adicionar
LET INT_FLAG = FALSE
CLEAR FORM
CALL tepcad004()
ON ACTION Consultar
LET int_flag = FALSE
CALL tepcmf004()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION tepcad004()
# WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME p_tetb03.*
AFTER FIELD codigo
IF p_tetb03.codigo is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD codigo
END IF
SELECT UNIQUE descripcion INTO p_tetb03.descripcion
FROM tetb00003 WHERE @codigo = p_tetb03.codigo
IF STATUS != NOTFOUND THEN
DISPLAY BY NAME p_tetb03.descripcion
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD codigo
END IF
AFTER FIELD descripcion
IF p_tetb03.descripcion[1] =" " OR p_tetb03.descripcion is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
AFTER FIELD tipo
IF p_tetb03.tipo IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET numero_msg = FALSE
RETURN
END IF
INSERT INTO tetb00003 VALUES (p_tetb03.*)
UPDATE tetb00003 SET (us_crea,fech_crea) = (usuarios,getdate())
WHERE @codigo = p_tetb03.codigo
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION tepcmf004()
## Aqui se prepara para la captura del criterio de seleccion
CLEAR FORM
DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM)
CONSTRUCT criterio ON a.codigo,a.descripcion FROM cod,descrip
BEFORE CONSTRUCT
END CONSTRUCT
ON ACTION buscar
LET SELEC =
" SELECT UNIQUE a.codigo,a.descripcion,a.us_crea,a.fech_crea,
a.us_mod,a.fech_mod,a.tipo FROM tetb00003 a ",
" WHERE a.status_t IS NULL AND ",criterio clipped," ORDER BY a.codigo "
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
LET idx=1
FOREACH datos INTO p_tetb03b[idx].codigo,p_tetb03b[idx].descripcion,p_tetb03b[idx].us_crea,p_tetb03b[idx].fech_crea,
p_tetb03b[idx].us_mod,p_tetb03b[idx].fech_mod,p_tetb03b[idx].tipo
LET idx=idx+1
END FOREACH
IF idx=1 THEN
CALL FGL_winmessage("error","NO HAY REGISTROS CON ESA CONDICION","STOP")
CALL p_tetb03b.clear()
EXIT DIALOG
END IF
DISPLAY array p_tetb03b TO record3.*
ON ACTION eLiminar
BEGIN WORK
UPDATE tetb00003 SET status_t="E",us_mod=usuarios,fech_mod=getdate()
WHERE codigo = p_tetb03b[arr_curr()].codigo
IF status<0 THEN
ROLLBACK WORK
CALL fgl_winmessage("error","NO SE PUDO ELIMINAR","STOP")
ELSE
COMMIT WORK
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
ON ACTION actualizar
DIALOG ATTRIBUTES(UNBUFFERED,FIELD ORDER FORM )
INPUT BY NAME p_tetb03.descripcion,p_tetb03.tipo
BEFORE INPUT
LET curr=arr_curr()
LET p_tetb03.codigo=p_tetb03b[curr].codigo
LET p_tetb03.descripcion=p_tetb03b[curr].descripcion
LET p_tetb03.tipo=p_tetb03b[curr].tipo
LET p_tetb03.us_crea=p_tetb03b[curr].us_crea
LET p_tetb03.fech_crea=p_tetb03b[curr].fech_crea
LET p_tetb03.us_mod=p_tetb03b[curr].us_mod
LET p_tetb03.fech_mod=p_tetb03b[curr].fech_mod
DISPLAY BY NAME p_tetb03.*
# END INPUT
ON ACTION guardar
BEGIN WORK
IF p_tetb03.descripcion[1] = " " OR
p_tetb03.descripcion is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descripcion
END IF
UPDATE tetb00003 SET descripcion=p_tetb03.descripcion,tipo=p_tetb03.tipo,us_mod=usuarios,fech_mod=getdate()
WHERE codigo = p_tetb03.codigo
IF status<0 THEN
ROLLBACK WORK
CALL fgl_winmessage("error","NO SE PUDO ACTUALIZAR","STOP")
ELSE
COMMIT WORK
LET numero_msg = 13
CALL msg(numero_msg)
RETURN
END IF
END INPUT
ON ACTION CANCEL
CLEAR FORM
EXIT dialog
END DIALOG
END DISPLAY
ON ACTION CANCEL
CLEAR FORM
EXIT dialog
END dialog
END FUNCTION
FUNCTION msg(numero_msg)
DEFINE numero_msg SMALLINT
DEFINE descripcion CHAR (60)
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = numero_msg
IF status = NOTFOUND THEN
SELECT desc_msg INTO descripcion FROM msgtable
WHERE cod_msg = 22
LET descripcion = descripcion CLIPPED,numero_msg using "<<<<"
ERROR descripcion ATTRIBUTE(BOLD)
ELSE
ERROR descripcion ATTRIBUTE(BOLD)
LET numero_msg = 0
END IF
END FUNCTION