Files
MBS/PROYECTO/indir/inprrp013.4gl
T
jpeguero efdf8953dd Reorganiza MATERIA PRIMA a PROYECTO y avanza inprmt002/005/013/046
- Mueve todo el contenido de PROYECTOS/indir y varias funciones
  compartidas de PROYECTOS/otrodir hacia PROYECTO, siguiendo
  instruccion de Johnny (PROYECTOS se va a eliminar).
- inprmt002: agrega campo Desglose faltante, corrige typo "eLiminar".
- inprmt005: agrega formulario y 3 campos faltantes (Consumo,
  Requiere Autorizacion, Requisiciones), corrige typo "eLiminar".
- inprmt013: agrega formulario, titulo, corrige typo "eLiminar".
- inprmt046: agrega formulario y varias funciones/dependencias
  faltantes (cincodmov, clasf_bloque, medidas, defecto,
  buscaEmp, consultaTransportista, busca_departamento);
  corrige nombres de campo desalineados con el codigo
  (depto_a, bodega) y los convierte a ComboBox donde el
  codigo lo requiere.
- Corrige dependencia faltante de FORMULARIOS_IN a la libreria
  Database (bloqueaba todo el modulo de MATERIA PRIMA).
2026-08-26 13:31:09 -04:00

316 lines
9.2 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : INPRRP013
OBJETIVO : Reporte de ajustes
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA REALIZACION : Noviembre 26, 1992.
-------------------------------------------------------------------------------
}
GLOBALS "inprgb000.4gl"
MAIN
DEFER INTERRUPT
SELECT * INTO p_companias.* FROM companias
CALL inprrp013()
END MAIN
FUNCTION inprrp013()
DEFINE salir CHAR(1)
DEFINE select_ac,select_ant,select_p CHAR(1000)
DEFINE idx_ac,ano,idx_a,idx_c SMALLINT
DEFINE ano_act,c_ano CHAR(4)
DEFINE fecha_2 CHAR(8)
DEFINE fecha_ini_per CHAR(8)
DEFINE ajustes 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,
cantidad DECIMAL(12,2),
fecha DATE
END RECORD
DEFINE acumulado 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,
balance LIKE intb00006.cantidad_2,
cantidad_2 LIKE intb00006.cantidad_2,
fecha DATE
END RECORD
#WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM infmrp013 FROM "infmrp013"
DISPLAY FORM infmrp013
CALL pantalla()
DISPLAY "inprrp013" AT 4,3
DISPLAY "Ajuste Material" AT 6,32
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME datos_cons.fech_in,datos_cons.fech_fi
AFTER FIELD fech_in
IF datos_cons.fech_in IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER FIELD fech_fi
IF datos_cons.fech_fi IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_fi
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 c.cod_n,c.cod_grupo,
c.cod_tipo,c.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
# Busca movimientos de ajuste
LET select_ac = "SELECT c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec, ",
"c.cantidad_2,c.fecha ",
" FROM intb00006 c ",
" WHERE ",criterio clipped,
" and (c.cod_mov = 25 or c.cod_mov = 52) and ",
" c.fecha between ? and ? and ",
" c.status_t is null ",
"ORDER BY c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec, ",
"c.cantidad_2,c.fecha"
PREPARE busca_movi FROM select_ac
DECLARE cur_busca SCROLL CURSOR FOR busca_movi
OPEN cur_busca USING datos_cons.fech_in,datos_cons.fech_fi
# Datos Generales de los materiales
LET selec = "SELECT c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec,c.descrip_esp,",
"c.unidad_med,a.balance,a.fecha ",
"FROM intb00001 c,intb00011 a ",
" WHERE ",criterio clipped,
" and c.status_t is null ",
" and c.cod_n = a.cod_n and ",
" c.cod_grupo = a.cod_grupo and ",
" c.cod_tipo = a.cod_tipo and ",
" c.cod_sec = a.cod_sec ",
" and a.fecha between ? and ? ",
"ORDER BY c.cod_n,c.cod_grupo,c.cod_tipo,c.cod_sec,c.descrip_esp,",
"c.unidad_med,a.balance,a.fecha"
DISPLAY "<< Estoy Buscando Materiales >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
DECLARE accion SCROLL CURSOR FOR busca
OPEN accion using datos_cons.fech_in,datos_cons.fech_fi
DISPLAY " "
AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
START REPORT opera8 TO "C:\\archivo"
LET idx_a = 1
LET idx_ac = 1
WHILE status != notfound
FETCH ABSOLUTE idx_a accion INTO acumulado.*
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
LET idx_a = idx_a + 1
LET salir = "N"
WHILE salir != "S"
FETCH ABSOLUTE idx_ac cur_busca INTO ajustes.*
IF status = notfound THEN
LET idx_ac = 1
LET salir = "S"
EXIT WHILE
END IF
LET idx_ac = idx_ac + 1
IF ajustes.cod_n = acumulado.cod_n and
ajustes.cod_grupo = acumulado.cod_grupo and
ajustes.cod_tipo = acumulado.cod_tipo and
ajustes.cod_sec = acumulado.cod_sec THEN
LET acumulado.cantidad_2 = ajustes.cantidad
LET acumulado.fecha = ajustes.fecha
EXIT WHILE
ELSE
LET acumulado.cantidad_2 = 0
END IF
END WHILE
OUTPUT TO REPORT opera8(acumulado.*)
END WHILE
FINISH REPORT opera8
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT opera8(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,
balance LIKE intb00006.cantidad_2,
cantidad_2 LIKE intb00006.cantidad_2,
fecha DATE
END RECORD
DEFINE codigo_act,codigo_ant CHAR(7)
DEFINE c_ano1 char(4)
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(2)
DEFINE doce CHAR(2)
DEFINE normal CHAR(2)
DEFINE hora CHAR(5)
DEFINE total_p,total_m DECIMAL(12,2)
DEFINE primera CHAR(1)
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 031
LET comp_off = ASCII 18
LET hora = time
LET doce = ASCII 27, ASCII 77
LET lj = (98 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT doce
PRINT COLUMN 1, "inprrp013",
COLUMN lj, p_companias.nombre CLIPPED,
COLUMN 91, "Pag. ",pageno using "###"
PRINT COLUMN 24, " Sistema de Inventario de Materia Prima",
COLUMN 91, today using "dd/mm/yyyy"
PRINT COLUMN 24, " Ajustes de Materiales",
COLUMN 94, hora
SKIP 1 LINES
PRINT COLUMN 2, "Desde ",datos_cons.fech_in using "dd/mm/yyyy",
COLUMN 21, "Hasta ", datos_cons.fech_fi using "dd/mm/yyyy"
PRINT COLUMN 1, "--------------------------------------------------",
"------------------------------------------------"
PRINT COLUMN 63, "Balance",
COLUMN 92, "Balance"
PRINT COLUMN 4, "Materia Prima ",
COLUMN 49, "Fecha",
COLUMN 63, "Antes ",
COLUMN 76, "Cantidad",
COLUMN 92, "Despues"
PRINT COLUMN 1, "--------------------------------------------------",
"------------------------------------------------"
ON EVERY ROW
IF x.fecha >= datos_cons.fech_in and x.fecha <= datos_cons.fech_fi THEN
IF x.cantidad_2 != 0 THEN
LET actual = x.balance + x.cantidad_2
IF codigo_ant is null THEN
LET codigo_ant = "0"
END IF
LET codigo_act = x.cod_n using "&",x.cod_grupo using "&",
x.cod_tipo using "&&",x.cod_sec using "&&&"
IF codigo_act != codigo_ant THEN
SKIP 1 LINE
LET codigo_ant = codigo_act
LET primera = "S"
END IF
IF primera = "S" THEN
LET primera = "N"
PRINT COLUMN 1, x.cod_n using "&","-",x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&"," ",
x.descrip_esp," ",x.unidad_med;
END IF
PRINT COLUMN 48, x.fecha using "dd/mm/yyyy",
COLUMN 57, x.balance using "--,---,---.##",
COLUMN 71, x.cantidad_2 USING "--,---,---.##",
COLUMN 85, actual USING "---,---,---.##"
END IF
END IF
END REPORT