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

544 lines
14 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : CGPRMT007
OBJETIVO : Mantenimiento Entrega de Cheques
REALIZADO POR : Ing. Juan F. Soto
FECHA : Diciembre 4, 1995.
-----------------------------------------------------------------------------
}
GLOBALS "cgprgb000.4gl"
DEFINE salir,nohay,tecla CHAR(1),
tiempo CHAR(5),
portador CHAR(30)
DEFINE arr_cro ARRAY[200] OF RECORD
cod_cro LIKE cgtb00031.cod_cro,
beneficiario LIKE cgtb00031.beneficiario
END RECORD
DEFINE factura2 ARRAY[20] OF CHAR(10),
ff CHAR(1),
cu_f,fi_f INTEGER
FUNCTION cgprmt007()
OPTIONS
FORM LINE 8,
ERROR LINE 24,
COMMENT LINE 23
CALL pantalla()
OPEN FORM cgfmmt007 FROM "cgfmmt007"
DISPLAY FORM cgfmmt007
DISPLAY "cgprmt007" AT 4,3
DISPLAY "Entrega de Cheques" AT 6,29
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL cgpcad007()
COMMAND KEY ("C","M") "Consultar-Modificar"
"<Esc> Busca Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
CALL cgpcmf007()
COMMAND "Salir"
EXIT MENU
END MENU
END FUNCTION
####### Funcion para agregar una entrada de diario
FUNCTION cgpcad007()
LET hoy = today
LET tiempo = time
LABEL volver:
INPUT BY NAME entrega.* ATTRIBUTE (BOLD)
ON KEY (CONTROL-O)
IF INFIELD(banco) THEN
CALL busca_banco()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
NEXT FIELD banco
END IF
IF numero_msg = 3 THEN
NEXT FIELD banco
END IF
LET entrega.banco = entrega1.banco
DISPLAY BY NAME entrega1.banco,nombre_bco
END IF
ON KEY (CONTROL-W)
IF INFIELD(cod_cro) THEN
CALL busca_cro()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD cod_cro
END IF
LET entrega.cod_cro = cronologico.cod_cro
DISPLAY BY NAME entrega.cod_cro,cronologico.beneficiario
NEXT FIELD recibido_por
END IF
BEFORE FIELD hora_ent
LET entrega.hora_ent = tiempo
DISPLAY BY NAME entrega.hora_ent
LET tiempo = entrega.hora_ent
BEFORE FIELD fecha_ent
LET entrega.fecha_ent = hoy
DISPLAY BY NAME entrega.fecha_ent
LET hoy = entrega.fecha_ent
AFTER FIELD fecha_ent
IF entrega.fecha_ent is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_ent
END IF
{
Se Puso en comentario porque el usuario esta atrasado
IF entrega.fecha_ent < today THEN
LET numero_msg = 189
CALL msg(numero_msg)
NEXT FIELD fecha_ent
END IF
}
AFTER FIELD cheque_no
IF entrega.cheque_no is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cheque_no
END IF
AFTER FIELD banco
IF entrega.banco is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD banco
END IF
SELECT a.nombre_bco INTO nombre_bco
FROM cgtb00012 a
WHERE cuenta_no = entrega.banco
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD banco
END IF
DISPLAY BY NAME nombre_bco
SELECT a.fecha,a.portador,a.monto
INTO entrega.fecha,portador,monto
FROM cgtb00005 a
WHERE a.cheque_no = entrega.cheque_no and
a.cuenta_no = entrega.banco
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
CALL msg_err()
NEXT FIELD banco
END IF
DISPLAY BY NAME entrega.fecha,portador,monto ATTRIBUTE (BOLD)
SELECT UNIQUE * INTO entrega.* FROM cgtb00032
WHERE cheque_no = entrega.cheque_no and
banco = entrega.banco
IF status != notfound THEN
LET numero_msg = 352
CALL msg(numero_msg)
SELECT a.beneficiario INTO cronologico.beneficiario
FROM cgtb00031 a
WHERE a.cod_cro = entrega.cod_cro
DISPLAY BY NAME entrega.*,cronologico.beneficiario
NEXT FIELD cheque_no
END IF
AFTER FIELD direccion
LET referencia = "CK.",entrega.cheque_no using "&&&&&&"
LET referencia = referencia CLIPPED
SELECT UNIQUE a.cuenta_no FROM cgtb00004 a
WHERE a.cuenta_no = "2173" and
a.detalles matches entrega.banco and
a.ref = referencia
IF STATUS != NOTFOUND THEN
IF entrega.direccion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD direccion
END IF
END IF
AFTER FIELD cod_cro
IF entrega.cod_cro is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cro
END IF
SELECT a.beneficiario INTO cronologico.beneficiario
FROM cgtb00031 a
WHERE a.cod_cro = entrega.cod_cro
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_cro
END IF
DISPLAY BY NAME cronologico.beneficiario
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LABEL chk:
PROMPT "Cheque Paga Facturas (S/N)?... " FOR CHAR ff
LET ff = UPSHIFT(ff)
IF (ff != "S" AND ff != "N") OR ff IS NULL THEN
GOTO chk
END IF
IF ff = "S" THEN
CALL facturas1()
END IF
INSERT INTO cgtb00032 VALUES (entrega.*)
UPDATE cgtb00032 SET (us_crea,fech_crea) = (USER,CURRENT)
WHERE cheque_no = entrega.cheque_no AND banco = entrega.banco
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
GOTO volver
END FUNCTION
## Funcion para consultar/modificar una entrada de diario
FUNCTION cgpcmf007()
## SE PREPARA EL CRITERIO PARA CONSULTAR/MODIFICAR UN REGISTRO
CONSTRUCT BY NAME CRITERIO ON cheque_no,banco,cod_cro
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
LET selec = "SELECT UNIQUE * FROM cgtb00032 ",
"WHERE ", criterio clipped, "ORDER BY banco,cheque_no"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO entrega.*
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL busca_datos()
DISPLAY BY NAME entrega.*
LABEL vuelve:
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO entrega.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL busca_datos()
DISPLAY BY NAME entrega.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO entrega.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL busca_datos()
DISPLAY BY NAME entrega.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO entrega.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL busca_datos()
DISPLAY BY NAME entrega.*
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO entrega.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL busca_datos()
DISPLAY BY NAME entrega.*
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
## AQUI SE MODIFICAN/ACTUALIZAN LOS DATOS DEL REGISTRO
INPUT BY NAME entrega.cod_cro,entrega.recibido_por,
entrega.cedula,entrega.direccion
WITHOUT DEFAULTS ATTRIBUTE(BOLD)
ON KEY (CONTROL-W)
IF INFIELD(cod_cro) THEN
CALL busca_cro()
IF int_flag THEN
NEXT FIELD cod_cro
END IF
DISPLAY BY NAME entrega.cod_cro
NEXT FIELD recibido_por
END IF
AFTER FIELD direccion
LET referencia = "CK.",entrega.cheque_no using "&&&&&&"
LET referencia = referencia CLIPPED
SELECT UNIQUE a.cuenta_no FROM cgtb00004 a
WHERE a.cuenta_no = "2173" and
a.detalles matches entrega.banco and
a.ref = referencia
IF STATUS != NOTFOUND THEN
IF entrega.direccion IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD direccion
END IF
END IF
AFTER FIELD cod_cro
IF entrega.cod_cro is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_cro
END IF
SELECT beneficiario
FROM cgtb00031
WHERE cod_cro = entrega.cod_cro
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_cro
END IF
AFTER FIELD recibido_por
IF entrega.recibido_por is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD recibido_por
END IF
AFTER FIELD cedula
IF entrega.cedula is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cedula
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
END INPUT
LABEL chk1:
PROMPT "Cheque Paga Facturas (S/N)?... " FOR CHAR ff
LET ff = UPSHIFT(ff)
IF (ff != "S" AND ff != "N") OR ff IS NULL THEN
GOTO chk1
END IF
IF ff = "S" THEN
CALL facturas1()
END IF
UPDATE cgtb00032 set cod_cro = entrega.cod_cro,
recibido_por = entrega.recibido_por,
cedula = entrega.cedula,
us_mod = user,
fech_mod = current
WHERE @cheque_no = entrega.cheque_no and
@banco = entrega.banco
LET numero_msg = 13
CALL msg(numero_msg)
## AQUI SE REALIZA LA ANULACION DE UN REGISTRO
COMMAND KEY ("N") "aNular"
UPDATE CGTB00032 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE cheque_no = entrega.cheque_no and
banco = entrega.banco
UPDATE cgtb00021 SET status_t = "E",
us_mod = user,
fech_mod = current
WHERE @cheque_no = entrega.cheque_no and
@banco = entrega.banco
LET numero_msg = 82
CALL msg(numero_msg)
COMMAND "Retornar"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_datos()
SELECT a.fecha,a.portador,a.monto
INTO entrega.fecha,portador,monto
FROM cgtb00005 a
WHERE a.cheque_no = entrega.cheque_no and
a.cuenta_no = entrega.banco
SELECT a.nombre_bco INTO nombre_bco
FROM cgtb00012 a
WHERE cuenta_no = entrega.banco
SELECT a.beneficiario INTO cronologico.beneficiario
FROM cgtb00031 a
WHERE a.cod_cro = entrega.cod_cro
DISPLAY BY NAME cronologico.beneficiario,portador,monto,nombre_bco
END FUNCTION
FUNCTION busca_cro()
OPEN WINDOW cons_cro AT 10,3 WITH FORM "cgfmwd008" ATTRIBUTE(BORDER,
FORM LINE FIRST + 1,COMMENT LINE LAST)
CONSTRUCT BY NAME CRITERIO ON beneficiario
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GOTO salir
END IF
LET selec1 = "SELECT cod_cro,beneficiario FROM cgtb00031 ",
"WHERE ",criterio clipped," ORDER BY 2"
PREPARE comando FROM selec1
DECLARE busca10 CURSOR FOR comando
OPEN busca10
LET nohay = "N"
LET idx = 1
WHILE status != notfound
FETCH busca10 INTO cronologico.cod_cro,cronologico.beneficiario
IF status = notfound THEN
EXIT WHILE
END IF
LET arr_cro[idx].cod_cro = cronologico.cod_cro
LET arr_cro[idx].beneficiario = cronologico.beneficiario
LET idx = 1 + idx
END WHILE
IF idx = 1 THEN
LET numero_msg = 3
CALL msg(numero_msg)
GOTO salir
END IF
IF idx > 1 THEN
CALL set_count(idx -1)
DISPLAY ARRAY arr_cro TO scr_cro.*
LET scr_l = scr_line()
LET entrega.cod_cro = arr_cro[scr_l].cod_cro
LET cronologico.beneficiario = arr_cro[scr_l].beneficiario
END IF
LABEL salir:
CLOSE WINDOW cons_cro
END FUNCTION
FUNCTION msg_err()
OPEN WINDOW errores AT 12,4 WITH 10 ROWS,64 COLUMNS ATTRIBUTE(BORDER)
DISPLAY "1.Este Cheque Puede Que No Este Procesado Por El Computador" AT 2,2
DISPLAY "2.Si Este Cheque No Fue Procesado Por El Computador Entonces" AT 4,2
DISPLAY " Dirijase A La Opcion No. 3. " AT 6,2
PROMPT " Presione Cualquier Tecla Para Continuar " FOR
CHAR tecla
CLOSE WINDOW errores
END FUNCTION
#### FUncion Para Buscar Las Facturas Aplicadas AL Cheque (Si Existen)
FUNCTION facturas1()
OPEN WINDOW fact_10 AT 10,3 WITH FORM "cgfmwd010" ATTRIBUTE(BORDER,
FORM LINE FIRST + 1,COMMENT LINE LAST)
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
LET ff = "N"
GOTO salir2
END IF
DECLARE busca_f CURSOR FOR
SELECT a.factura FROM cgtb00021 a WHERE a.cuenta_no = entrega.banco AND
a.cheque_no = entrega.cheque_no
ORDER BY 1
LET idx = 1
FOREACH busca_f INTO factura2[idx]
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx-1)
INPUT ARRAY factura2 WITHOUT DEFAULTS FROM s_fact.*
BEFORE ROW
LET cu_f = ARR_CURR()
LET fi_f = SCR_LINE()
AFTER FIELD factura2
LET cu_f = cu_f
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
GOTO salir2
END IF
DELETE FROM cgtb00021 WHERE @cuenta_no = entrega.banco AND
@cheque_no = entrega.cheque_no
FOR idx = 1 TO ARR_COUNT()
IF factura2[idx] IS NOT NULL THEN
INSERT INTO cgtb00021 VALUES (entrega.banco,entrega.cheque_no,
factura2[idx],NULL,USER,CURRENT,NULL,NULL)
END IF
END FOR
LABEL salir2:
CLOSE WINDOW fact_10
END FUNCTION