Files
MBS/PROYECTO/ctdir/ctprmt018.4gl
T

365 lines
13 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : CTPRMT018
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Costo Real sin impuesto y con impuesto.
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Diciembre 20, 1993
-------------------------------------------------------------------------------
}
GLOBALS "ctprgb000.4gl"
DEFINE s_imp RECORD LIKE cttb00023.*
FUNCTION ctprmt018()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM ctfmmt018 FROM "ctfmmt018"
DISPLAY FORM ctfmmt018
CALL pantalla()
DISPLAY "ctprmt018" AT 4,3
DISPLAY "Costo Real con y sin Impuestos" AT 6,24
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
CLEAR FORM
LET int_flag = false
CALL ctpcad018()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Supr> Cancela Operacion"
LET int_flag = false
CALL ctpcmf018()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ctpcad018()
#WHENEVER ERROR CONTINUE
## Captura los datos que va a contener el registro
INPUT BY NAME s_imp.*
## Verifica que el costo exista en el catalogo de costos. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
SELECT cod_n,cod_grupo,cod_tipo,cod_sec,costo_imp,costo_s_imp
FROM cttb00023
WHERE cod_n = s_imp.cod_n AND
cod_grupo = s_imp.cod_grupo AND
cod_tipo = s_imp.cod_tipo AND
cod_sec = s_imp.cod_sec AND
costo_imp = s_imp.costo_imp AND
costo_s_imp = s_imp.costo_s_imp
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF ( s_imp.cod_n = 0 AND s_imp.cod_grupo = 0 AND
s_imp.cod_tipo = 0 AND s_imp.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec AND
a.status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME articulos.descrip_esp,articulos.unidad_med
END IF
AFTER FIELD costo_imp
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
IF s_imp.costo_imp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_imp
END IF
AFTER FIELD costo_s_imp
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
IF s_imp.costo_s_imp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_s_imp
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF s_imp.costo_s_imp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_s_imp
ELSE
INSERT INTO cttb00023 VALUES ( s_imp.cod_n,s_imp.cod_grupo,
s_imp.cod_tipo,s_imp.cod_sec,s_imp.costo_imp,
s_imp.costo_s_imp,null,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 s_imp.cod_n = NULL
LET s_imp.cod_grupo = NULL
LET s_imp.cod_tipo = NULL
LET s_imp.cod_sec = NULL
LET s_imp.costo_imp = NULL
LET s_imp.costo_s_imp = NULL
NEXT FIELD cod_n
END IF
END INPUT
END FUNCTION
FUNCTION ctpcmf018()
#WHENEVER ERROR CONTINUE
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON d.cod_n,d.cod_grupo,d.cod_tipo,d.cod_sec
FROM cod_n,cod_grupo,cod_tipo,cod_sec
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT UNIQUE d.cod_n,d.cod_grupo,d.cod_tipo, ",
"d.cod_sec,c.costo_imp,c.costo_s_imp,c.status_t, ",
"c.us_crea,c.fech_crea,c.us_mod,c.fech_mod ",
" FROM cttb00023 c, intb00001 d where ",
"c.cod_n = d.cod_n and ",
"c.cod_grupo = d.cod_grupo and ",
"c.cod_tipo = d.cod_tipo and ",
"c.cod_sec = d.cod_sec and ",
"c.status_t is null and ",
criterio clipped,
" ORDER BY 1,2,3,4"
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 s_imp.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec
DISPLAY BY NAME s_imp.*,articulos.descrip_esp,articulos.unidad_med
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
MENU "OPCIONES"
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO s_imp.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec
DISPLAY BY NAME s_imp.*,articulos.descrip_esp,articulos.unidad_med
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO s_imp.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec
DISPLAY BY NAME s_imp.*,articulos.descrip_esp,articulos.unidad_med
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO s_imp.*
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec
DISPLAY BY NAME s_imp.*,articulos.descrip_esp,articulos.unidad_med
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO s_imp.*
SELECT descrip_esp,unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM intb00001 a, intb00002 b
WHERE a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_sec = b.cod_sec AND
b.cod_n = s_imp.cod_n AND
b.cod_grupo = s_imp.cod_grupo AND
b.cod_tipo = s_imp.cod_tipo AND
b.cod_sec = s_imp.cod_sec
DISPLAY BY NAME s_imp.*,articulos.descrip_esp,articulos.unidad_med
# DISPLAY s_imp.costo_imp USING "##,###,###.####" AT 13,17
# DISPLAY s_imp.costo_s_imp USING "##,###,###.####" AT 13,17
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Supr> Cancela Operacion"
INPUT BY NAME s_imp.costo_imp,
s_imp.costo_s_imp,
s_imp.us_crea,
s_imp.fech_crea,
s_imp.us_mod,
s_imp.fech_mod WITHOUT DEFAULTS
AFTER FIELD costo_imp
IF s_imp.costo_imp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_imp
END IF
AFTER FIELD costo_s_imp
IF s_imp.costo_s_imp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD costo_s_imp
END IF
## Verifica si el usuario presiono la tecla <Supr>
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE cttb00023 SET costo_imp = s_imp.costo_imp,
costo_s_imp = s_imp.costo_s_imp,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = s_imp.cod_n and
cod_grupo = s_imp.cod_grupo and
cod_tipo = s_imp.cod_tipo and
cod_sec = s_imp.cod_sec
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE cttb00023 SET status_t = "E"
WHERE cod_n = s_imp.cod_n and
cod_grupo = s_imp.cod_grupo and
cod_tipo = s_imp.cod_tipo and
cod_sec = s_imp.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION