Files
MBS/PROYECTOS/irdir/irprmt002_1.4gl
T

436 lines
16 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : IRPRMT002
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla Maestra Repuestos.
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Febrero 15, 1992.
------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
DEFINE exist_act DECIMAL(12,2)
DEFINE user1 CHAR(9)
DEFINE fech1 DATETIME YEAR TO MINUTE,
arr_tabla DYNAMIC ARRAY OF RECORD
articulo VARCHAR(150),
existencia FLOAT,
exist_minima FLOAT,
dias_transito INT,
codn,codgrupo,codtipo,codsec INT
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CALL ARG_VAL(3) RETURNING impresor
CONNECT TO "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL irprmt002()
END MAIN
FUNCTION irprmt002()
CLEAR SCREEN
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM irfmmt002 FROM "irfmmt002"
DISPLAY FORM irfmmt002
#CALL pantalla()
DISPLAY "irprmt002" AT 4,3
DISPLAY "Maestra de Repuestos" at 6,30
CALL busca_maestra()
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Ctrl-C> Cancela Operacion"
CLEAR FORM
LET INT_FLAG = FALSE
CALL irpcad002()
COMMAND "Consultar-modificar"
"<Esc> Realiza Busqueda <Ctrl-C> Cancela Operacion"
LET INT_FLAG = FALSE
CALL irpcmf002()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION irpcad002()
## Captura los datos que va a contener el registro
INPUT BY NAME m_articulos.*
## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe,
## entonces despliega los datos del registro existente.
BEFORE FIELD cod_sec
SELECT MAX(a.cod_sec) INTO m_articulos.cod_sec
FROM irtb00002 a
WHERE a.cod_n = m_articulos.cod_n and
a.cod_grupo = m_articulos.cod_grupo and
a.cod_tipo = m_articulos.cod_tipo
IF m_articulos.cod_sec IS NULL THEN
LET m_articulos.cod_sec = 1
ELSE
LET m_articulos.cod_sec = m_articulos.cod_sec + 1
END IF
DISPLAY m_articulos.cod_sec
AFTER FIELD cod_sec
IF (m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND
m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
SELECT a.* INTO articulos.* FROM irtb00002 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec
IF status != NOTFOUND THEN
IF articulos.status_t IS NOT NULL THEN
LET numero_msg = 39
CALL msg(numero_msg)
DISPLAY BY NAME articulos.descrip_esp,
articulos.status_t THRU articulos.fech_mod
END IF
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
AFTER FIELD existencia
IF m_articulos.existencia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD existencia
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT unique cod_n FROM irtb00006
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec and
cod_mov = 99 and status_t is null
IF status = notfound THEN
LET datos_gen.num_doc = 0
SELECT MAX(a.num_doc) INTO datos_gen.num_doc FROM irtb00006 a
WHERE a.status_t IS NULL AND a.cod_mov = 99
IF datos_gen.num_doc IS NULL THEN
LET datos_gen.num_doc = 0
END IF
LET datos_gen.num_doc = datos_gen.num_doc + 1
INSERT INTO irtb00006
VALUES (1,today,null,null,null,null,null,null,99,null,
m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,null,
m_articulos.existencia,null,null,null,null,
USUARIOS,GETDATE(),null,null,1)
END IF
INSERT INTO irtb00002
(cod_n,cod_grupo,cod_tipo,cod_sec,descrip_esp,descrip_ing,unidad_med,existencia
,exist_min,dia_llegada,categoria,us_crea,fech_crea)
VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec, m_articulos.descrip_esp,
m_articulos.descrip_ing,m_articulos.unidad_med,
m_articulos.existencia,
m_articulos.exist_min,m_articulos.dia_llegada,
m_articulos.categoria,usuarios,getdate())
IF m_articulos.categoria IS NOT NULL THEN
INSERT INTO irtb00016
VALUES (m_articulos.cod_n,m_articulos.cod_grupo,
m_articulos.cod_tipo,m_articulos.cod_sec,
m_articulos.categoria,TODAY,null,usuarios,getdate(),null,null)
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION irpcmf002()
DEFINE xcodid INT
CLEAR FORM
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,
a.descrip_esp,a.descrip_ing
FROM cod_n,cod_grupo,cod_tipo,cod_sec,descrip_esp,
descrip_ing
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
{LET SELEC = "SELECT UNIQUE a.* ",
"FROM irtb00002 a ",
"WHERE ",
criterio clipped," ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec "}
LET SELEC = "SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" a.existencia,a.exist_min,a.dia_llegada,a.categoria, ",
" a.status_t,a.us_crea,a.fech_crea,a.us_mod,a.fech_mod, ",
" a.descrip_esp,a.descrip_ing,a.unidad_med,a.codid ",
"FROM irtb00002 a ",
"WHERE ",
criterio clipped," ORDER BY 1,2,3,4 "
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO m_articulos.cod_n ,m_articulos.cod_grupo ,m_articulos.cod_tipo ,m_articulos.cod_sec ,
m_articulos.existencia,m_articulos.exist_min,m_articulos.dia_llegada,m_articulos.categoria,
m_articulos.status_t,m_articulos.us_crea,m_articulos.fech_crea,m_articulos.us_mod,
m_articulos.fech_mod,
descrip_esp,descrip_ing,medida,xcodid
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL art_existe()
DISPLAY BY NAME m_articulos.*
MENU "OPCIONES "
COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO m_articulos.cod_n ,m_articulos.cod_grupo ,m_articulos.cod_tipo ,m_articulos.cod_sec ,
m_articulos.existencia,m_articulos.exist_min,m_articulos.dia_llegada,m_articulos.categoria,
m_articulos.status_t,m_articulos.us_crea,m_articulos.fech_crea,m_articulos.us_mod,
m_articulos.fech_mod,
descrip_esp,descrip_ing,medida,xcodid
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL art_existe()
DISPLAY BY NAME m_articulos.*
COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO m_articulos.cod_n ,m_articulos.cod_grupo ,m_articulos.cod_tipo ,m_articulos.cod_sec ,
m_articulos.existencia,m_articulos.exist_min,m_articulos.dia_llegada,m_articulos.categoria,
m_articulos.status_t,m_articulos.us_crea,m_articulos.fech_crea,m_articulos.us_mod,
m_articulos.fech_mod,
descrip_esp,descrip_ing,medida,xcodid
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL art_existe()
DISPLAY BY NAME m_articulos.*
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO m_articulos.cod_n ,m_articulos.cod_grupo ,m_articulos.cod_tipo ,m_articulos.cod_sec ,
m_articulos.existencia,m_articulos.exist_min,m_articulos.dia_llegada,m_articulos.categoria,
m_articulos.status_t,m_articulos.us_crea,m_articulos.fech_crea,m_articulos.us_mod,
m_articulos.fech_mod,
descrip_esp,descrip_ing,medida,xcodid
CALL art_existe()
DISPLAY BY NAME m_articulos.*
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
LET user1 = m_articulos.us_crea
LET fech1 = m_articulos.fech_crea
INPUT BY NAME m_articulos.* WITHOUT DEFAULTS
BEFORE FIELD cod_n
NEXT FIELD descrip_esp
AFTER FIELD existencia
IF m_articulos.existencia is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD existencia
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
UPDATE irtb00002 SET (descrip_esp,descrip_ing,unidad_med,existencia
,exist_min,dia_llegada,categoria,us_mod,fech_mod)
=
(m_articulos.descrip_esp,
m_articulos.descrip_ing,m_articulos.unidad_med,
m_articulos.existencia,m_articulos.exist_min,
m_articulos.dia_llegada,m_articulos.categoria,
usuarios,GETDATE())
WHERE coid = xcodid
IF m_articulos.existencia is null THEN
LET m_articulos.existencia = 0
END IF
SELECT a.* FROM irtb00006 a
WHERE a.cod_n=m_articulos.cod_n and
a.cod_grupo=m_articulos.cod_grupo and
a.cod_tipo=m_articulos.cod_tipo and
a.cod_sec=m_articulos.cod_sec and
a.cod_mov = 99 and status_t is null
IF STATUS = NOTFOUND THEN
INSERT INTO irtb00006
VALUES (1,today,null,null,null,null,null,null,99,null,
m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.cod_sec,null,m_articulos.existencia,null,null,null,
null,user1,fech1,useruarios,getdate())
ELSE
UPDATE irtb00006 SET (cantidad_2,us_mod,fech_mod) =
(m_articulos.existencia,usuarios,getdate())
WHERE @cod_n=m_articulos.cod_n and @cod_grupo=m_articulos.cod_grupo and
@cod_tipo=m_articulos.cod_tipo and @cod_sec=m_articulos.cod_sec
and @cod_mov = 99 and status_t is null
END IF
SELECT a.* FROM irtb00016 a
WHERE a.cod_n=m_articulos.cod_n and a.cod_grupo=m_articulos.cod_grupo and
a.cod_tipo=m_articulos.cod_tipo and a.cod_sec=m_articulos.cod_sec
IF STATUS = NOTFOUND THEN
IF m_articulos.categoria IS NOT NULL THEN
INSERT INTO irtb00016
VALUES(m_articulos.cod_n,m_articulos.cod_grupo,m_articulos.cod_tipo,
m_articulos.cod_sec,m_articulos.categoria,today,null,usarios,
GETDATE(),null,null)
END IF
ELSE
IF m_articulos.categoria IS NOT NULL THEN
UPDATE irtb00016 SET categoria = m_articulos.categoria,
us_mod = USERUARIOS,
fech_mod = getdate()
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
ELSE
DELETE FROM irtb00016
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
END IF
END IF
LET numero_msg = 13
CALL msg(numero_msg)
COMMAND KEY ("L") "eLiminar"
LET exist_act = 0
SELECT SUM(a.cantidad_2) INTO exist_act FROM irtb00006 a
WHERE a.cod_n = m_articulos.cod_n AND
a.cod_grupo = m_articulos.cod_grupo AND
a.cod_tipo = m_articulos.cod_tipo AND
a.cod_sec = m_articulos.cod_sec AND
a.status_t IS NULL
IF exist_act IS NULL THEN
LET exist_act = 0
END IF
IF exist_act = 0 THEN
UPDATE irtb00002 SET (status_t,us_mod,fech_mod) = ("E",uarios,GETDATE())
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
UPDATE irtb00016 SET (status_t,us_mod,fech_mod) = ("E",USARIOS,GETDATE())
WHERE @cod_n = m_articulos.cod_n AND
@cod_grupo = m_articulos.cod_grupo AND
@cod_tipo = m_articulos.cod_tipo AND
@cod_sec = m_articulos.cod_sec
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar" "Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION art_existe()
SELECT cantidad_2 INTO m_articulos.existencia
FROM irtb00006
WHERE cod_n = m_articulos.cod_n and
cod_grupo = m_articulos.cod_grupo and
cod_tipo = m_articulos.cod_tipo and
cod_sec = m_articulos.cod_sec and
cod_mov = 99 and
status_t IS NULL
END FUNCTION
FUNCTION busca_maestra()
DECLARE busca_maestra CURSOR FOR
SELECT CAST(a.cod_n AS VARCHAR(5))+'-'+CAST(a.cod_grupo AS VARCHAR(5))+'-'+CAST(a.cod_tipo AS VARCHAR(5))+'-'+
CAST(a.cod_sec AS VARCHAR(5))+' '+RTRIM(a.descrip_esp)+' '+a.unidad_med,
ISNULL(SUM(b.cantidad_2),0),a.exist_min,a.dia_llegada,
a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec
FROM irtb00002 a,irtb00006 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.status_t IS NULL) AND (a.status_t IS NULL)
GROUP BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec,a.descrip_Esp,a.exist_min,a.dia_llegada,a.unidad_med
ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec
LET idx = 1
FOREACH busca_maestra INTO arr_tabla[idx].*
LET idx =idx + 1
END FOREACH
DISPLAY ARRAY arr_tabla TO stabla.*
END FUNCTION