Files
MBS/PROYECTOS/indir/inprrp002.4gl
T

312 lines
9.7 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : INPRRP002
OBJETIVO : CATALOGO DE MATERIA PRIMA
PROGRAMADOR : Ing. Betania Guerrero Perez
FECHA REALIZACION : Agosto 19, 1992
MODIFICADO POR : Ing. Juan Fco. Soto
FECHA MODIFICACION : Octubre 26, 1992.
-------------------------------------------------------------------------------
}
globals
"inprgb000.4gl"
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
SELECT * INTO p_companias.* FROM companias
CALL inprrp002()
END MAIN
FUNCTION inprrp002()
DEFINE idx_c SMALLINT
DEFINE salir CHAR(1)
DEFINE mes CHAR(2)
DEFINE materia RECORD
cod_n LIKE intb00002.cod_n,
cod_grupo LIKE intb00002.cod_grupo,
cod_tipo LIKE intb00002.cod_tipo,
cod_sec LIKE intb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
pto_reorden LIKE intb00002.pto_reorden,
dia_llegada LIKE intb00002.dia_llegada,
cod_nab LIKE intb00002.cod_nab,
bodega LIKE intb00002.bodega ,
unidad_med LIKE intb00001.unidad_med,
base LIKE intb00002.base,
costo LIKE intb00013.costo_st
END RECORD,
cod smallint
DEFINE select_cost CHAR(1000)
DEFINE costos RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
fecha CHAR(2),
costo LIKE intb00013.costo_st
END RECORD
WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
CLEAR SCREEN
OPEN FORM infmrp002 FROM "infmrp002"
DISPLAY FORM infmrp002
CALL pantalla()
DISPLAY "inprrp002" AT 4,3
DISPLAY "Catalogo de Materia Prima" AT 6,27
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
INPUT BY NAME decide
AFTER FIELD decide
IF decide IS NULL THEN
NEXT FIELD decide
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
CONSTRUCT criterio ON b.cod_n,b.cod_grupo,b.cod_tipo,b.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 select_cost =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,max(a.mes_fin), ",
" a.costo_st ",
"FROM intb00013 a,intb00002 c ",
"WHERE a.cod_n = c.cod_n AND a.cod_grupo = c.cod_grupo AND ",
" a.cod_tipo = c.cod_tipo AND a.cod_sec = c.cod_sec AND ",
" c.status_t is null ",
"GROUP BY 1,2,3,4,6 ORDER BY 1,2,3,4 "
DISPLAY "<< Estoy Buscando Los Costos de las Materias Primas >>"
AT 19,14 ATTRIBUTE (REVERSE)
PREPARE busca_costo FROM select_cost
DECLARE material_costo SCROLL CURSOR FOR busca_costo
OPEN material_costo
DISPLAY " "
AT 19,14
CALL defecto(usuarios,clave,impresor) RETURNING imprime,negrilla_on,negrillas_of,
doble_on,doble_off,comp_on,comp_off,
doce,normal,archivo,copia
START REPORT maestra TO archivo
IF decide = "A" THEN
LET SELEC =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" a.pto_reorden,a.dia_llegada,a.cod_nab,a.bodega,b.unidad_med, ",
" a.base ",
"FROM intb00002 a, intb00001 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 ",
" a.status_t is NULL AND b.status_t is NULL AND ",
criterio clipped," ORDER BY b.descrip_esp"
ELSE
LET SELEC =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,b.descrip_esp, ",
" a.pto_reorden,a.dia_llegada,a.cod_nab,a.bodega,b.unidad_med, ",
" a.base ",
"FROM intb00002 a, intb00001 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 ",
" a.status_t is NULL AND b.status_t is NULL AND ",
criterio clipped," ORDER BY a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec"
END IF
DISPLAY "<< Estoy Buscando Las Materias Primas >>"
AT 19,14 ATTRIBUTE (REVERSE)
PREPARE busca FROM selec
DECLARE accion CURSOR FOR busca
OPEN accion
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
WHILE status != notfound
FETCH accion INTO materia.*
IF status = notfound THEN
EXIT WHILE
END IF
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_c material_costo INTO costos.*
IF status = notfound THEN
LET idx_c = 1
LET salir = "S"
EXIT WHILE
END IF
LET idx_c = idx_c + 1
IF costos.cod_n = materia.cod_n AND
costos.cod_grupo = materia.cod_grupo AND
costos.cod_tipo = materia.cod_tipo AND
costos.cod_sec = materia.cod_sec THEN
LET materia.costo = costos.costo
LET salir = "S"
END IF
IF salir = "S" THEN
LET idx_c = 1
EXIT WHILE
END IF
END WHILE
OUTPUT TO REPORT maestra(materia.*)
IF status = notfound THEN
LET status = 0
END IF
END WHILE
FINISH REPORT maestra
CLEAR SCREEN
RUN imprime
END FUNCTION
REPORT maestra(x)
DEFINE x RECORD
cod_n LIKE intb00002.cod_n,
cod_grupo LIKE intb00002.cod_grupo,
cod_tipo LIKE intb00002.cod_tipo,
cod_sec LIKE intb00002.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
pto_reorden LIKE intb00002.pto_reorden,
dia_llegada LIKE intb00002.dia_llegada,
cod_nab LIKE intb00002.cod_nab,
bodega LIKE intb00002.bodega,
unidad_med LIKE intb00001.unidad_med,
base LIKE intb00002.base,
costo LIKE intb00013.costo_st
END RECORD
DEFINE l SMALLINT
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(2)
DEFINE negrillas_off CHAR(2)
DEFINE comp_on CHAR(3)
DEFINE comp_off CHAR(3)
DEFINE doce CHAR(2)
DEFINE hora CHAR(5)
DEFINE varia CHAR(19)
OUTPUT
LEFT MARGIN 2
FORMAT
PAGE HEADER
LET doble_on = ASCII 14
LET doble_off = ASCII 20
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET comp_on = ASCII 031
LET comp_off = ASCII 18
LET doce = ASCII 27, ASCII 77
LET hora = time
LET lj = (141 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 1, comp_on
PRINT COLUMN 1, "inprrp002",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 134, "Pag. ",pageno using "###"
PRINT COLUMN 51, "Sistema de Inventario de Materia Prima",
COLUMN 134, today using "dd/mm/yyyy"
PRINT COLUMN 56, "Catalogo de Materia Prima",
COLUMN 137, hora
IF decide = "N" THEN
LET varia = "N u m e r i c o" clipped
ELSE
LET varia = "A l f a b e t i c o"
END IF
LET l = (142 - LENGTH(varia)) / 2
PRINT COLUMN l, varia
# ESTA LINEA TIENE 50 GUIONES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"------------------------------------------"
PRINT COLUMN 59, "Punto",
COLUMN 76, "Costo",
COLUMN 93, "Base De",
COLUMN 105, "Dia de"
PRINT COLUMN 1, "Nivel",
COLUMN 15, "Descripcion",
COLUMN 59, "Reorden",
COLUMN 76, "Standard",
COLUMN 93, "Cotizacion",
COLUMN 105, "Llegada",
COLUMN 120, "Arancel",
COLUMN 131, "Bodega"
# ESTA LINEA TIENE 50 GUIONES
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"------------------------------------------"
ON EVERY ROW
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
COLUMN 15, x.descrip_esp,
COLUMN 46, x.unidad_med,
COLUMN 53, x.pto_reorden USING "##,###,###.##",
COLUMN 70, x.costo USING "#,###,###.####",
COLUMN 88, x.base using "##,###,###.##",
COLUMN 105, x.dia_llegada USING "###",
COLUMN 116, x.cod_nab clipped,
COLUMN 135, x.bodega USING "&&"
ON LAST ROW
SKIP 1 LINE
PRINT COLUMN 3, "Total de Registros Impresos = ", count(*) USING "####"
PRINT COLUMN comp_off
END REPORT