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

200 lines
5.7 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : COPRCS004
OBJETIVO : Consulta Relacion Forma de Embarque - Materia Prima
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : Agosto 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
DEFINE idx_c SMALLINT
DEFINE embarque_p RECORD
cod_embarque LIKE cotb00027.cod_embarque,
descrip_emb LIKE cotb00027.descrip_emb
END RECORD
FUNCTION coprcs004()
WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmcs004 FROM "cofmcs004"
DISPLAY FORM cofmcs004
CALL PANTALLA()
DISPLAY "<Esc> Continua Consulta" AT 2,3
DISPLAY "<Delete> Cancela Operacion" AT 2,50
DISPLAY "coprcs004" AT 4,3
DISPLAY "Forma de Embarque - Materia Prima" AT 6,23
LABEL volver:
CONSTRUCT criterio ON b.cod_embarque FROM cod_embarque
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = "SELECT cod_embarque,descrip_emb ",
" FROM cotb00027 b ",
" WHERE ",
"status_t is null AND ",
criterio clipped,
" ORDER BY 1 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
DISPLAY "Buscando Informacion... Espere Por Favor" AT 21,2
ATTRIBUTE (YELLOW)
PREPARE busca FROM SELEC
DECLARE accion SCROLL CURSOR FOR busca
OPEN accion
DISPLAY " " AT 21,2
LET idx = 1
FETCH FIRST accion INTO embarque_p.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
GOTO volver
END IF
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
# CALL detalle()
MENU "OPCION"
COMMAND "Siguiente"
"Presenta en pantalla el registro Siguiente encontrado"
LET idx = 1
FETCH NEXT accion INTO embarque_p.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
# CALL detalle()
COMMAND "Anterior"
"Presenta en pantalla el registro Anterior encontrado"
LET idx = 1
FETCH PREVIOUS accion INTO embarque_p.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
# CALL detalle()
COMMAND "Primero"
"Presenta en pantalla el Primer registro encontrado"
LET idx = 1
FETCH FIRST accion INTO embarque_p.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
# CALL detalle()
COMMAND "Ultimo"
"Presenta en pantalla el Ultimo registro encontrado"
LET idx = 1
FETCH LAST accion INTO embarque_p.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
# CALL detalle()
COMMAND "Ver"
"Presenta los materiales que utilizan esta forma de embarque"
CALL detalle()
COMMAND "Retornar"
EXIT MENU
END MENU
GOTO volver
END FUNCTION
FUNCTION detalle()
## Se seleccionan los campos que el usuario debe ver en pantalla
DECLARE accion4 CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,
e.descrip_esp,e.unidad_med,a.cantidad,a.cod_furg
FROM cotb00004 a,intb00001 e
WHERE a.cod_embarque = embarque_p.cod_embarque AND
a.cod_n = e.cod_n AND
a.cod_grupo = e.cod_grupo AND
a.cod_tipo = e.cod_tipo AND
a.cod_sec = e.cod_sec AND
a.status_t is null
ORDER BY 1,2,3,4
## Busca los registros que cumplan con la condicion dada y verifica si el
## furgon existe en el catalogo de furgones
LET idx_c = 1
FOREACH accion4 INTO fmp[idx_c].*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
SLEEP 2
EXIT FOREACH
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
IF fmp[idx_c].cod_furg is not null THEN
SELECT UNIQUE descrip_furg INTO descrip5 FROM cotb00003
WHERE cod_furg = fmp[idx_c].cod_furg
LET fmp[idx_c].descrip6 = descrip5
ELSE
LET fmp[idx_c].descrip6 = NULL
END IF
LET idx_c = idx_c + 1
END FOREACH
CALL set_count (idx_c-1)
DISPLAY BY NAME embarque_p.cod_embarque,embarque_p.descrip_emb
DISPLAY ARRAY fmp TO consart.*
## Verifica si el usuario presiono la tecla <Delete>
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
CLEAR FORM
END FUNCTION