Files
MBS/PROYECTOS/ipdir/ipprmt007.4gl
T

656 lines
26 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IPPRMT007
OBJETIVO : Precios Minimos y de Listas
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : Agosto 25, 1997.
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
------------------------------------------------------------------
}
GLOBALS "ipprgb000.4gl"
FUNCTION ipprmt007()
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
HELP KEY CONTROL-W,
MESSAGE LINE 24,
COMMENT LINE 21
OPEN FORM ipfmmt007 FROM "ipfmmt007"
DISPLAY FORM ipfmmt007
CALL pantalla()
DISPLAY "ipprmt007" AT 4,3
DISPLAY "Mantenimiento Precios Minimos Y De Lista " at 6,22
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
HELP 5
LET INT_FLAG = FALSE
CLEAR FORM
LET INT_FLAG = FALSE
CALL ippcad007()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
HELP 6
CALL ippcmf007()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION ippcad007()
MESSAGE ""
## Captura los datos que va a contener el registro
INPUT BY NAME p_iptb14.*
{
ON KEY (CONTROL-W)
CASE
WHEN INFIELD (cod_n)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
IF NOT int_flag THEN
LET p_iptb14.cod_n = p_conteo.cod_n
LET p_iptb14.cod_grupo = p_conteo.cod_grupo
LET p_iptb14.cod_tipo = p_conteo.cod_tipo
LET p_iptb14.cod_sec = p_conteo.cod_sec
DISPLAY p_iptb14.cod_n TO cod_n
DISPLAY p_iptb14.cod_grupo TO cod_grupo
DISPLAY p_iptb14.cod_tipo TO cod_tipo
DISPLAY p_iptb14.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
SELECT * INTO p_iptb14.* FROM iptb00014 WHERE
cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF p_iptb14.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
INITIALIZE p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod TO NULL
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
NEXT FIELD peso_bruto
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_grupo)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_grupo
END IF
IF NOT int_flag THEN
LET p_iptb14.cod_n = p_conteo.cod_n
LET p_iptb14.cod_grupo = p_conteo.cod_grupo
LET p_iptb14.cod_tipo = p_conteo.cod_tipo
LET p_iptb14.cod_sec = p_conteo.cod_sec
DISPLAY p_iptb14.cod_n TO cod_n
DISPLAY p_iptb14.cod_grupo TO cod_grupo
DISPLAY p_iptb14.cod_tipo TO cod_tipo
DISPLAY p_iptb14.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
SELECT * INTO p_iptb14.* FROM iptb00014 WHERE
cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF p_iptb14.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
INITIALIZE p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod TO NULL
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
NEXT FIELD peso_bruto
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_tipo)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_tipo
END IF
IF NOT int_flag THEN
LET p_iptb14.cod_n = p_conteo.cod_n
LET p_iptb14.cod_grupo = p_conteo.cod_grupo
LET p_iptb14.cod_tipo = p_conteo.cod_tipo
LET p_iptb14.cod_sec = p_conteo.cod_sec
DISPLAY p_iptb14.cod_n TO cod_n
DISPLAY p_iptb14.cod_grupo TO cod_grupo
DISPLAY p_iptb14.cod_tipo TO cod_tipo
DISPLAY p_iptb14.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
SELECT * INTO p_iptb14.* FROM iptb00014 WHERE
cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF p_iptb14.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
INITIALIZE p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod TO NULL
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
NEXT FIELD peso_bruto
END IF
LET int_flag = FALSE
WHEN INFIELD (cod_sec)
CALL busca_pt()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
NEXT FIELD cod_sec
END IF
IF NOT int_flag THEN
LET p_iptb14.cod_n = p_conteo.cod_n
LET p_iptb14.cod_grupo = p_conteo.cod_grupo
LET p_iptb14.cod_tipo = p_conteo.cod_tipo
LET p_iptb14.cod_sec = p_conteo.cod_sec
DISPLAY p_iptb14.cod_n TO cod_n
DISPLAY p_iptb14.cod_grupo TO cod_grupo
DISPLAY p_iptb14.cod_tipo TO cod_tipo
DISPLAY p_iptb14.cod_sec TO cod_sec
DISPLAY descrip1 TO descrip_esp
SELECT * INTO p_iptb14.* FROM iptb00014 WHERE
cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
IF status >= 0 THEN
IF status != NOTFOUND THEN
IF p_iptb14.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
INITIALIZE p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod TO NULL
DISPLAY BY NAME p_iptb14.peso_bruto,
p_iptb14.peso_neto,
p_iptb14.dim_caja,
p_iptb14.us_crea,
p_iptb14.fech_crea,
p_iptb14.us_mod,
p_iptb14.fech_mod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
NEXT FIELD peso_bruto
END IF
LET int_flag = FALSE
END CASE
}
## Verifica que el codigo no exista en el catalogo de p_iptb14. Si existe,
## entonces despliega los datos del registro existente.
AFTER FIELD cod_sec
SELECT i.descrip_esp,i.descrip_ing INTO descrip1, descrip2
FROM iptb00002 i
WHERE i.cod_n = p_iptb14.cod_n AND
i.cod_grupo = p_iptb14.cod_grupo AND
i.cod_tipo = p_iptb14.cod_tipo AND
i.cod_sec = p_iptb14.cod_sec and
i.status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 35
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT i.*FROM iptb00014 i
WHERE i.cod_n = p_iptb14.cod_n AND
i.cod_grupo = p_iptb14.cod_grupo AND
i.cod_tipo = p_iptb14.cod_tipo AND
i.cod_sec = p_iptb14.cod_sec and
i.status_t is null
IF status != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET descripcion= descrip1 CLIPPED
DISPLAY BY NAME descripcion ATTRIBUTE(CYAN)
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT i.descrip_esp,i.descrip_ing INTO descrip1, descrip2
FROM iptb00002 i
WHERE i.cod_n = p_iptb14.cod_n AND
i.cod_grupo = p_iptb14.cod_grupo AND
i.cod_tipo = p_iptb14.cod_tipo AND
i.cod_sec = p_iptb14.cod_sec and
i.status_t is null
IF status = NOTFOUND THEN
LET numero_msg = 35
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
LET descripcion= descrip1 CLIPPED
DISPLAY BY NAME descripcion ATTRIBUTE(CYAN)
INSERT INTO iptb00014 VALUES (p_iptb14.*)
UPDATE iptb00014 SET us_crea = user,
fech_crea = current
WHERE cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
LET numero_msg = 1
CALL msg(numero_msg)
NEXT FIELD cod_n
AFTER FIELD fech_mod
EXIT INPUT
END INPUT
END FUNCTION
FUNCTION ippcmf007()
## Aqui se prepara para la captura del criterio de seleccion
MESSAGE ""
CLEAR FORM
CONSTRUCT criterio ON iptb00014.* FROM iptb00014.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE * FROM iptb00014 WHERE ",
" status_t is null AND ",
criterio clipped,
" ORDER BY 1,2,3,4"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR WITH HOLD FOR busca
OPEN datos
FETCH FIRST datos INTO p_iptb14.*
IF status >= 0 THEN
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME p_iptb14.*
CALL busca_articulo()
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO p_iptb14.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb14.*
CALL busca_articulo()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO p_iptb14.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME p_iptb14.*
CALL busca_articulo()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO p_iptb14.*
DISPLAY BY NAME p_iptb14.*
CALL busca_articulo()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO p_iptb14.*
DISPLAY BY NAME p_iptb14.*
CALL busca_articulo()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
INPUT BY NAME p_iptb14.precio_min,
p_iptb14.precio_lista
WITHOUT DEFAULTS
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE iptb00014 SET precio_min = p_iptb14.precio_min,
precio_lista = p_iptb14.precio_lista,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
EXIT INPUT
END INPUT
COMMAND KEY ("L") "eLiminar"
"Elimina registro que esta en la pantalla"
DELETE FROM iptb00014
WHERE cod_n = p_iptb14.cod_n AND
cod_grupo = p_iptb14.cod_grupo AND
cod_tipo = p_iptb14.cod_tipo AND
cod_sec = p_iptb14.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
# CALL ayuda()
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_articulo()
# Esta funcion busca el nombre del articulo y lo despliega en pantalla
# Esta funcion es valida solamente para la consulta-modificacion.
SELECT i.descrip_esp,i.descrip_ing INTO descrip1 ,descrip2
FROM iptb00002 i
WHERE i.cod_n = p_iptb14.cod_n AND
i.cod_grupo = p_iptb14.cod_grupo AND
i.cod_tipo = p_iptb14.cod_tipo AND
i.cod_sec = p_iptb14.cod_sec
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 26
CALL msg(numero_msg)
ELSE
IF p_iptb14.status_t = "E" THEN
LET numero_msg = 44
CALL msg(numero_msg)
END IF
END IF
LET descripcion= descrip1 CLIPPED
DISPLAY BY NAME descripcion ATTRIBUTE(CYAN)
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
END FUNCTION
{
FUNCTION busca_pt()
OPEN WINDOW busqueda AT 7,12 WITH FORM "vefmwd003"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.descrip_esp FROM descrip_esp
LET selec2 =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
" a.descrip_ing,a.cod_grupo ",
"FROM iptb00002 a ",
"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 ",
" a.status_t is null AND ", criterio clipped," ORDER BY 5 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale9
END IF
PREPARE busca_pila FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_pila CURSOR FOR busca_pila
LET idx = 1
FOREACH buscar_pila INTO pilas[idx].*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Producto Terminado donde esta el cursor"
DISPLAY ARRAY pilas TO s_pilas.*
LET curr1 = arr_curr()
LET pterminado.cod_n = pilas[curr1].cod_n
LET pterminado.cod_grupo = pilas[curr1].cod_grupo
LET pterminado.cod_tipo = pilas[curr1].cod_tipo
LET pterminado.cod_sec = pilas[curr1].cod_sec
LET descuento.cod_n = pilas[curr1].cod_n
LET descuento.cod_grupo = pilas[curr1].cod_grupo
LET descuento.cod_tipo = pilas[curr1].cod_tipo
LET descuento.cod_sec = pilas[curr1].cod_sec
LET descrip1 = pilas[curr1].descrip_esp
LABEL sale9:
CLOSE WINDOW busqueda
END FUNCTION
}