Files
MBS/PROYECTO/codir/coprmt002.4gl
T

476 lines
16 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : COPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Suplidor - Materia Prima.
PROGRAMADOR : Lic. Abner Montalvo Z.
FECHA REALIZACION : Agosto 5, 1992.
------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
DEFINE existe_s CHAR(1)
DEFINE existe_a CHAR(1)
FUNCTION coprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmmt002 FROM "cofmmt002"
DISPLAY FORM cofmmt002
CALL pantalla()
DISPLAY "coprmt002" AT 4,3
DISPLAY "Suplidores-Materia Prima" AT 6,28
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
CLEAR FORM
CALL copcad002()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
CALL copcmf002()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION copcad002()
WHENEVER ERROR CONTINUE
# Captura los datos que va a contener el registro
INPUT BY NAME supliart.*
BEFORE FIELD cod_n
LET suplidor.cod_sp = supliart.cod_sp
LET suplidor.cod_sp_sec = supliart.cod_sp_sec
INITIALIZE supliart.* TO NULL
LET supliart.cod_sp = suplidor.cod_sp
LET supliart.cod_sp_sec = suplidor.cod_sp_sec
DISPLAY BY NAME supliart.*
# Verifica que el codigo del suplidor exista en la tabla de suplidores.
# Si no existe, entonces presenta mensaje de error y acepta el codigo
# del suplidor.
AFTER FIELD cod_sp_sec
IF (supliart.cod_sp = 0 OR supliart.cod_sp IS NULL) AND
(suplidor.cod_sp_sec = 0 or suplidor.cod_sp_sec is null) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp
ELSE
CALL nombre_suplidor()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
IF existe_s = "N" THEN
LET numero_msg = 25
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME suplidor.nom_sp
END IF
# Verifica que el codigo de la materia prima exista en la tabla de materia prima
# Si no existe, entonces presenta mensaje de error y acepta el codigo
# de la materia prima.
AFTER FIELD cod_sec
IF ( supliart.cod_n = 0 AND supliart.cod_grupo = 0 AND
supliart.cod_tipo = 0 AND supliart.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
CALL nombre_articulo()
IF existe_a = "N" THEN
LET numero_msg = 26
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME articulos.descrip_esp
END IF
SELECT * INTO supliart.* FROM cotb00002
WHERE cod_n = supliart.cod_n AND
cod_grupo = supliart.cod_grupo AND
cod_tipo = supliart.cod_tipo AND
cod_sec = supliart.cod_sec AND
cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
IF supliart.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
# Llamado a la rutina que despliega el mensaje del error retornado despues del
# SELECT. Solamente despliega mensaje si hay error.
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
end if
AFTER FIELD fech_mod
EXIT INPUT
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
# Chequea que los codigos de suplidor y articulo no sean nulos o ceros y
# tambien chequea que no se repita el suplidor y el articulo en la tabla
# de suplidor-articulo.
IF supliart.cod_sp = 0 OR supliart.cod_sp IS NULL OR
supliart.cod_sp_sec = 0 or supliart.cod_sp_sec is null or
(supliart.cod_n IS NULL AND supliart.cod_grupo IS NULL AND
supliart.cod_tipo IS NULL AND supliart.cod_sec IS NULL) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_sp
ELSE
SELECT * FROM cotb00002
WHERE cod_n = supliart.cod_n AND
cod_grupo = supliart.cod_grupo AND
cod_tipo = supliart.cod_tipo AND
cod_sec = supliart.cod_sec AND
cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
IF STATUS != NOTFOUND THEN
IF supliart.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
END IF
# Llamado a la rutina que despliega el mensaje del error retornado despues del
# SELECT. Solamente despliega mensaje si hay error.
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
INSERT INTO cotb00002 VALUES (supliart.cod_sp, supliart.cod_sp_sec,
supliart.cod_n,
supliart.cod_grupo, supliart.cod_tipo, supliart.cod_sec,
NULL,USER, CURRENT,
null, null)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si el Status es diferente de cero quiere decir que hubo problemas durante
# la creacion del registro, entonces despliega un mensaje de alerta para que
# el usuario sepa que hubo problemas en la creacion del registro.
IF STATUS != 0 THEN
LET numero_msg = 14
CALL msg(numero_msg)
NEXT FIELD cod_sp
ELSE
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
INITIALIZE supliart.* TO NULL
NEXT FIELD cod_sp
END IF
END INPUT
END FUNCTION
FUNCTION copcmf002()
# Aqui se prepara para la captura del criterio de seleccion
WHENEVER ERROR CONTINUE
CONSTRUCT criterio ON cotb00002.cod_sp,
cotb00002.cod_sp_sec,
cotb00002.cod_n,cotb00002.cod_grupo,
cotb00002.cod_tipo,cotb00002.cod_sec
FROM
cotb00002.cod_sp,
cotb00002.cod_sp_sec,
cotb00002.cod_n,cotb00002.cod_grupo,
cotb00002.cod_tipo,cotb00002.cod_sec
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 cotb00002 where ",
" status_t is null and ",
criterio clipped,
" ORDER BY 1,2,3,4,5"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO supliart.*
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 supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO supliart.*
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO supliart.*
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO supliart.*
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO supliart.*
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
INPUT BY NAME supliart.* WITHOUT DEFAULTS
BEFORE FIELD cod_sp
NEXT FIELD cod_n
BEFORE FIELD cod_n
LET detalle1.cod_n = supliart.cod_n
LET detalle1.cod_grupo = supliart.cod_grupo
LET detalle1.cod_tipo = supliart.cod_tipo
LET detalle1.cod_sec = supliart.cod_sec
AFTER FIELD cod_sec
IF ( supliart.cod_n = 0 AND supliart.cod_grupo = 0 AND
supliart.cod_tipo = 0 AND supliart.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
ELSE
CALL nombre_articulo()
IF existe_a = "N" THEN
LET numero_msg = 26
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME articulos.descrip_esp
END IF
SELECT * INTO supliart.* FROM cotb00002
WHERE cod_n = supliart.cod_n AND
cod_grupo = supliart.cod_grupo AND
cod_tipo = supliart.cod_tipo AND
cod_sec = supliart.cod_sec AND
cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
IF status >= 0 THEN
IF STATUS != NOTFOUND THEN
IF supliart.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
DISPLAY BY NAME supliart.*
CALL nombre_suplidor()
DISPLAY BY NAME suplidor.nom_sp
CALL nombre_articulo()
DISPLAY BY NAME articulos.descrip_esp
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
# Llamado a la rutina que despliega el mensaje del error retornado despues del
# SELECT. Solamente despliega mensaje si hay error.
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
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
UPDATE cotb00002 SET cod_n = supliart.cod_n,
cod_grupo = supliart.cod_grupo,
cod_tipo = supliart.cod_tipo,
cod_sec = supliart.cod_sec,
us_mod = USER,
fech_mod = CURRENT
WHERE cod_n = detalle1.cod_n and
cod_grupo = detalle1.cod_grupo and
cod_tipo = detalle1.cod_tipo and
cod_sec = detalle1.cod_sec and
cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
and status_t is null
IF status != 0 THEN
LET numero_msg = 14
CALL msg(numero_msg)
CLEAR FORM
RETURN
ELSE
LET numero_msg = 13
CALL msg(numero_msg)
END IF
END INPUT
COMMAND KEY ("L") "eLiminar"
UPDATE cotb00002 SET status_t = "E"
WHERE cod_n = supliart.cod_n AND
cod_grupo = supliart.cod_grupo AND
cod_tipo = supliart.cod_tipo AND
cod_sec = supliart.cod_sec AND
cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION nombre_suplidor()
# Esta funcion busca el nombre del suplidor, en la tabla de suplidores, y lo
# despliega en pantalla.
LET existe_s = "S"
SELECT nom_sp INTO suplidor.nom_sp FROM cotb00001
WHERE cod_sp = supliart.cod_sp and
cod_sp_sec = supliart.cod_sp_sec
and status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET suplidor.nom_sp = "SUPLIDOR NO EXISTE"
LET existe_s = "N"
END IF
ELSE
CALL integridad()
LET bandera = 1
END IF
END FUNCTION
FUNCTION nombre_articulo()
# Esta funcion busca el nombre del articulo, en el catalogo de articulos, y lo
# despliega en pantalla.
LET existe_a = "S"
SELECT descrip_esp INTO articulos.descrip_esp FROM intb00001
WHERE cod_n = supliart.cod_n AND
cod_grupo = supliart.cod_grupo AND
cod_tipo = supliart.cod_tipo AND
cod_sec = supliart.cod_sec AND
status_t is null
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET articulos.descrip_esp = "ARTICULO NO EXISTE"
LET existe_a = "N"
END IF
ELSE
CALL integridad()
LET bandera = 1
END IF
END FUNCTION