Files
MBS/PROYECTO/cgdir/cgprmt017old.4gl
T

227 lines
6.4 KiB
Plaintext

{
------------------------------------------------------------------------------
PROGRAMA : CGPRMT017
OBJETIVO : Mantenimiento Presupuesto
PROGRAMADOR : Ing. Juan F. Soto
FECHA REALIZACION : Septiembre 11, 1997.
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO
------------------------------------------------------------------------------
}
GLOBALS
"cgprgb000.4gl"
FUNCTION cgprmt017()
WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 9,
ERROR LINE 24,
COMMENT LINE 23
CALL pantalla()
OPEN FORM cgfmmt017 FROM "cgfmmt017"
DISPLAY FORM cgfmmt017
CLEAR FORM
DISPLAY "cgprmt017" AT 4,3
DISPLAY "Presupuesto de G a s t o s" AT 6,27
MENU "OPCION"
COMMAND "Adicionar" "<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
LET int_flag = false
CALL cgpcad17()
COMMAND "Consultar-modificar"
"<Esc> Busca Registro <Ctrl-C> Cancela Operacion"
CALL cgpcmod17()
COMMAND "Salir"
EXIT MENU
END MENU
END FUNCTION
FUNCTION cgpcad17()
# Captura de informacion
INITIALIZE presupa.* TO NULL
LET nombre = NULL
LET nombre_m = NULL
DISPLAY BY NAME nombre,nombre_m
INPUT BY NAME presupa.* WITHOUT DEFAULTS ATTRIBUTE (BOLD)
AFTER FIELD cuenta_no
SELECT a.* INTO catalogo.* FROM cgtb00001 a
WHERE a.cuenta_no = presupa.cuenta_no and
a.status_t is null
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
LET nombre = catalogo.descripcion
DISPLAY BY NAME nombre ATTRIBUTE(CYAN)
AFTER FIELD mes
SELECT a.descrip INTO nombre_m
FROM mestable a
WHERE a.mes = presupa.mes
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME nombre_m ATTRIBUTE(CYAN)
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
INSERT INTO cgtb00023 values
(presupa.*)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
UPDATE cgtb00023 set us_crea = user,
fech_crea = current
WHERE @cuenta_no = presupa.cuenta_no AND
@ano = presupa.ano AND
@mes = presupa.mes
LET numero_msg = 1
CALL msg(numero_msg)
#INITIALIZE presupa.* TO NULL
#CLEAR FORM
NEXT FIELD cuenta_no
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION cgpcmod17()
# Captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON cgtb00023.*
LET selec2 =
"SELECT * FROM cgtb00023 WHERE ",criterio clipped," and status_t is null ",
" ORDER BY 1"
PREPARE comando FROM selec2
DECLARE busca SCROLL CURSOR FOR comando
OPEN busca
FETCH FIRST busca INTO presupa.*
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
DISPLAY BY NAME presupa.* ATTRIBUTE(CYAN)
CALL busca_c()
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT busca INTO presupa.*
IF status = notfound THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME presupa.* ATTRIBUTE(CYAN)
CALL busca_c()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS busca INTO presupa.*
IF status = notfound THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME presupa.* ATTRIBUTE(CYAN)
CALL busca_c()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST busca INTO presupa.*
LET numero_msg = 5
CALL msg(numero_msg)
DISPLAY BY NAME presupa.* ATTRIBUTE(CYAN)
CALL busca_c()
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH FIRST busca INTO presupa.*
LET numero_msg = 4
CALL msg(numero_msg)
DISPLAY BY NAME presupa.* ATTRIBUTE(CYAN)
CALL busca_c()
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
IF presupa.status_t = "E" THEN
LET numero_msg = 39
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME presupa.presupuesto WITHOUT DEFAULTS ATTRIBUTE (BOLD)
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
EXIT INPUT
END INPUT
UPDATE cgtb00023 set presupuesto = presupa.presupuesto,
us_mod = user,
fech_mod = current
WHERE cuenta_no = presupa.cuenta_no AND
ano = presupuesto.ano AND
mes = presupuesto.mes
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY("L") "eLiminar"
UPDATE cgtb00023 set status_t = "E",
us_mod = user,
fech_mod = current
WHERE cuenta_no = presupa.cuenta_no AND
ano = presupuesto.ano AND
mes = presupuesto.mes
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_c()
SELECT a.* INTO catalogo.* FROM cgtb00001 a
WHERE a.cuenta_no = presupa.cuenta_no and
a.status_t is null
IF status = notfound THEN
LET nombre = "CUENTA NO EXISTE"
ELSE
LET nombre = catalogo.descripcion
END IF
SELECT a.descrip INTO nombre_m
FROM mestable a
WHERE a.mes = presupa.mes
DISPLAY BY NAME nombre,nombre_m ATTRIBUTE(CYAN)
END FUNCTION