Files
DECOMARMOL/PROYECTO/codir/coprmt016.4gl
T
2026-09-22 20:38:51 -04:00

254 lines
6.5 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : COPRMT016
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Terminos de Pago
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : AGOSTO 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL coprmt016()
END MAIN
FUNCTION coprmt016()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmmt016 FROM "cofmmt016"
DISPLAY FORM cofmmt016
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL copcad016()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
LET int_flag = false
CALL copcmf016()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION copcad016()
WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME pagos.*
## Verifica que el pago exista en el catalogo de pago. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD term_sp
IF pagos.term_sp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD term_sp
ELSE
SELECT * INTO pagos.* FROM cotb00024
WHERE term_sp = pagos.term_sp
IF STATUS != NOTFOUND THEN
IF pagos.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD term_sp
END IF
DISPLAY BY NAME pagos.*
LET numero_msg = 12
CALL msg(numero_msg)
LET pagos.descrip_term = NULL
NEXT FIELD term_sp
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
INITIALIZE pagos.descrip_term TO NULL
DISPLAY BY NAME pagos.descrip_term,pagos.descrip_ting
END IF
END IF
AFTER FIELD descrip_term
IF pagos.descrip_term IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_term
END IF
AFTER FIELD descrip_ting
IF pagos.descrip_ting IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_ting
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
INSERT INTO cotb00024 VALUES (pagos.term_sp,pagos.descrip_term,
pagos.descrip_ting,null,suser_sname(),GETDATE(),null,null)
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION copcmf016()
WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON cotb00024.* FROM cotb00024.*
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 cotb00024 ",
"WHERE status_t is null and ", criterio clipped,
"ORDER BY 1"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
FETCH FIRST datos INTO pagos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 36
CALL msg(numero_msg)
RETURN
END IF
DISPLAY BY NAME pagos.*
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO pagos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME pagos.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO pagos.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME pagos.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO pagos.*
DISPLAY BY NAME pagos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO pagos.*
DISPLAY BY NAME pagos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
IF pagos.status_t != "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME pagos.descrip_term,pagos.descrip_ting,
pagos.us_crea, pagos.fech_crea,
pagos.us_mod, pagos.fech_mod WITHOUT DEFAULTS
AFTER FIELD descrip_term
IF pagos.descrip_term IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_term
END IF
AFTER FIELD descrip_ting
IF pagos.descrip_ting IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD descrip_ting
END IF
AFTER INPUT
## Verifica si el usuario presiono la tecla <Delete>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
UPDATE cotb00024 SET descrip_term = pagos.descrip_term,
descrip_ting = pagos.descrip_ting,
us_mod = suser_sname(),
fech_mod = GETDATE()
WHERE term_sp = pagos.term_sp
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE cotb00024 SET status_t = "E"
WHERE term_sp = pagos.term_sp
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION