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

222 lines
7.5 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : IRPRRP22
OBJETIVO : Repuestos con existencia y costo en cero (0)
PROGRAMADOR : Tadeo A. Ferreras F.
FECHA REALIZACION : Diciembre 30, 1994
-------------------------------------------------------------------------------
}
GLOBALS "irprgb000.4gl"
FUNCTION irprrp22()
DEFINE mes CHAR(2)
DEFINE ano_c CHAR(4)
DEFINE idx_ant,idx_cos,idx_act SMALLINT
DEFINE salir,primera CHAR(1)
DEFINE balance_in DECIMAL(12,2)
DEFINE existe RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
existencia DECIMAL(12,2),
costo LIKE intb00013.costo_st
END RECORD
DEFINE select_cost,select_act,select_ant CHAR(1000)
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmrp22 FROM "irfmrp005"
DISPLAY FORM infmrp22
CALL pantalla()
DISPLAY "irprrp22" AT 4,3
DISPLAY "Repuestos Sin Compra y Con Existencia" AT 6,22
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME datos_cons.fech_fi
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET datos_cons.fech_fi = TODAY
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET ano_c = year(datos_cons.fech_fi)
CONSTRUCT criterio ON d.cod_n,d.cod_grupo,d.cod_tipo,d.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 d.cod_n,d.cod_grupo,d.cod_tipo,d.cod_sec,d.descrip_esp, ",
" d.unidad_med,SUM(a.cantidad_2),MAX(b.precio) ",
"FROM irtb00002 d,irtb00006 a,OUTER cotb00015 b ",
"WHERE ",criterio CLIPPED," AND d.cod_n=b.cod_n and ",
" d.cod_grupo = b.cod_grupo and d.cod_tipo = b.cod_tipo and ",
" d.cod_sec = b.cod_sec and d.status_t is null AND ",
" d.cod_n = a.cod_n AND d.cod_grupo = a.cod_grupo and ",
" d.cod_tipo = a.cod_tipo and d.cod_sec = a.cod_sec and ",
" a.fecha <= ? GROUP BY 1,2,3,4,5,6 ORDER BY 1,2,3,4 "
DISPLAY "<< Estoy Buscando Los Costos Actuales >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_costo FROM select_cost
DECLARE material_costo SCROLL CURSOR FOR busca_costo
OPEN material_costo USING datos_cons.fech_fi
DISPLAY " "
AT 19,14
START REPORT reporte_22 TO "C:\\archivo"
DISPLAY "<< Reporte Generandose.. Espere Por Favor"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
WHILE status != notfound
FETCH material_costo INTO existe.*
IF status = notfound THEN
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
IF existe.existencia <> 0 AND (existe.costo IS NULL OR existe.costo=0) THEN
LET existe.costo = 0
OUTPUT TO REPORT reporte_22(existe.*)
END IF
END WHILE
FINISH REPORT reporte_22
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT reporte_22(x)
DEFINE x RECORD
cod_n LIKE intb00001.cod_n,
cod_grupo LIKE intb00001.cod_grupo,
cod_tipo LIKE intb00001.cod_tipo,
cod_sec LIKE intb00001.cod_sec,
descrip_esp LIKE intb00001.descrip_esp,
unidad_med LIKE intb00001.unidad_med,
existencia DECIMAL(12,2),
costo LIKE intb00013.costo_st
END RECORD
DEFINE total_c,total_p DECIMAL (12,2)
DEFINE doble_on CHAR(2)
DEFINE doble_off CHAR(2)
DEFINE negrillas_on CHAR(2)
DEFINE negrillas_off CHAR(2)
DEFINE comp_on CHAR(2)
DEFINE comp_off CHAR(2)
DEFINE doce CHAR(2)
DEFINE hora CHAR(5)
OUTPUT
TOP MARGIN 0
LEFT MARGIN 0
BOTTOM 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 15
LET comp_off = ASCII 18
LET doce = ASCII 27, ASCII 77
LET hora = time
PRINT COLUMN 1, ASCII 27,ASCII 80
PRINT COLUMN 1, "irprrp22",
COLUMN 10, comp_on,doble_on,negrillas_on,
COLUMN 19, " M A R M O T E C H S. A.",
COLUMN 64, negrillas_off,doble_off,comp_off,
COLUMN 76, "Pag. ",pageno using "###"
PRINT COLUMN 1,
COLUMN 19, " Sistema de Inventario de Repuestos",
COLUMN 75, today using "dd/mm/yy"
PRINT COLUMN 19, " Repuestos Sin Compras y Con Existencia",
COLUMN 78, hora
SKIP 1 LINES
PRINT COLUMN 1,doce
PRINT COLUMN 1, " FECHA DE CORTE: ",datos_cons.fech_fi
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
PRINT COLUMN 1, "Codigo",
COLUMN 12, "Descripcion",
COLUMN 60, "Existencia",
COLUMN 75, "Precio"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------"
skip 1 line
ON EVERY ROW
SELECT UNIQUE *FROM irtb00013
WHERE @cod_n = x.cod_n and
@cod_grupo = x.cod_grupo and
@cod_tipo = x.cod_tipo and
@cod_sec = x.cod_sec and
mes_ini = "1" and mes_fin = "12" and ano = "1994"
IF status = notfound THEN
INSERT INTO irtb00013 VALUES
("1","12","1994",x.cod_n,x.cod_grupo,x.cod_tipo,x.cod_sec,
1.00,null,"beato",current,null,null)
ELSE
UPDATE irtb00013 set costo_st = 1.00,
us_crea = "beato",
fech_crea = current
WHERE cod_n = x.cod_n and
cod_grupo = x.cod_grupo and
cod_tipo = x.cod_tipo and
cod_sec = x.cod_sec and
mes_ini ="1" and mes_fin = "12" and ano = "1994"
END IF
PRINT COLUMN 1, x.cod_n USING "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",x.descrip_esp CLIPPED,
COLUMN 50, x.unidad_med CLIPPED,
COLUMN 55, x.existencia USING "###,###,###.##",
COLUMN 70, x.costo USING "#,###,###.####"
ON LAST ROW
PRINT COLUMN 1, "==================================================",
"=================================================="
PRINT COLUMN 4, "Total Registros Impresos =", count(*) USING "<<<<"
PRINT COLUMN 1, "==================================================",
"=================================================="
PRINT COLUMN 4, ASCII 27, ASCII 80
END REPORT