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

589 lines
19 KiB
Plaintext

{
-------------------------------------------------------------------------------
PROGRAMA : COPRRP003
OBJETIVO : Relacion Suplidor - Ordenes de Compra
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : AGOSTO 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
-------------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
FUNCTION coprrp003()
DEFINE select_fech,select_movi,select_ent CHAR(1000)
DEFINE idx_o,idx_e,idx_p,idx_m SMALLINT
DEFINE esta,encontre,salir2,salir1,salir CHAR(1)
DEFINE recibida,pendiente DECIMAL(12,2)
DEFINE movi_t RECORD
num_oc INTEGER,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(12,2)
END RECORD
DEFINE entregas RECORD
num_oc INTEGER,
tipo LIKE cotb00014.tipo,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(12,2),
precio LIKE cotb00015.precio,
fecha DATE
END RECORD
DEFINE supliorden RECORD
num_oc LIKE cotb00014.num_oc,
tipo LIKE cotb00014.tipo,
fech_oc LIKE cotb00014.fech_oc,
cod_sp LIKE cotb00001.cod_sp,
cod_sp_sec LIKE cotb00001.cod_sp_sec,
nom_sp LIKE cotb00001.nom_sp,
cantidad LIKE cotb00015.cantidad,
cantidad_2 LIKE iptb00006.cantidad_2,
remanente LIKE iptb00006.cantidad_2,
precio LIKE cotb00015.precio,
c_flete LIKE cotb00014.c_flete,
otros_g LIKE cotb00014.otros_g,
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
END RECORD
DEFINE ordenes RECORD
num_oc INTEGER,
tipo LIKE cotb00014.tipo,
fech_oc DATE,
cod_sp SMALLINT,
cod_sp_sec SMALLINT,
nom_sp CHAR(30),
c_flete DECIMAL(12,2),
otros_g DECIMAL(12,2),
cierre CHAR(1)
END RECORD
DEFINE materiales RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip_esp CHAR(30),
unidad_med CHAR(3)
END RECORD
DEFINE fechas RECORD
num_oc INTEGER,
fecha DATE
END RECORD
# WHENEVER ERROR CONTINUE
OPTIONS
FORM LINE 8,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmrp003 FROM "cofmrp003"
DISPLAY FORM cofmrp003
CALL pantalla()
DISPLAY "coprrp003" AT 4,3 ATTRIBUTE(YELLOW)
DISPLAY "Ordenes de Compras" AT 6,31
LET tipo_papel = 1
CALL msgrp000(tipo_papel)
INPUT BY NAME clasifica
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
INPUT BY NAME rango.*
BEFORE FIELD fech_fi
LET rango.fech_fi = TODAY
DISPLAY BY NAME rango.fech_fi
AFTER FIELD fech_in
IF rango.fech_in is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_in
END IF
AFTER FIELD fech_fi
IF rango.fech_fi is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_fi
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
EXIT INPUT
END INPUT
CONSTRUCT criterio ON a.tipo,a.num_oc,a.cod_n,a.cod_grupo,a.cod_tipo,
a.cod_sec
FROM tipo,num_oc,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 Las Ordenes de Compras
IF clasifica = "P" THEN
LET select_ent =
"SELECT a.num_oc,a.tipo,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" a.cantidad,a.precio ",
"FROM cotb00015 a,cotb00014 c ",
"WHERE a.status_t is null and ",
" c.num_oc = a.num_oc and c.fech_oc between ? and ? and ",
" c.cierre = 'N' and ",
criterio clipped," GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 3,4,5,6,1"
ELSE
LET select_ent =
"SELECT a.num_oc,a.tipo,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" a.cantidad,a.precio ",
"FROM cotb00015 a,cotb00014 c ",
"WHERE a.status_t is null and ",
" c.num_oc = a.num_oc and c.fech_oc between ? and ? ",
" GROUP BY 1,2,3,4,5,6,7,8 ORDER BY 3,4,5,6,1"
END IF
DISPLAY "<< Estoy Buscando Las Cantidades Ordenadas >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca_entrega FROM select_ent
DECLARE ent_curs SCROLL CURSOR FOR busca_entrega
OPEN ent_curs USING rango.fech_in,rango.fech_fi
# Busca Los Movimientos de los materiales
LET select_movi =
"SELECT a.orden_compra,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec, ",
" sum(a.cantidad_2) ",
"FROM iptb00006 a ",
"WHERE a.status_t is null and a.orden_compra is not null and ",
" a.cantidad_2 > 0 ",
"GROUP BY 1,2,3,4,5 ORDER BY 2,3,4,5,1"
DISPLAY " "
AT 19,14
DISPLAY "<< Estoy Buscando Los movimientos de las Ordenes >>"
AT 19,14 ATTRIBUTE(REVERSE,BOLD)
PREPARE busca_movi FROM select_movi
DECLARE movi_curs SCROLL CURSOR FOR busca_movi
OPEN movi_curs
# Busca Las descripcion de los Materiales
LET SELEC4 =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
" a.unidad_med ",
"FROM intb00001 a, iptb00002 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 ORDER BY 1,2,3,4"
DISPLAY "<< Estoy Buscando Los Materiales Con Su Descripcion >>"
AT 19,14 ATTRIBUTE (REVERSE,BOLD)
PREPARE busca3 FROM selec4
DECLARE accion3 SCROLL CURSOR FOR busca3
OPEN accion3
START REPORT ordenar TO "C:\\archivo"
DISPLAY " " AT 19,14
DISPLAY "<< Reporte Generandose ... Por Favor Espere. >>"
AT 19,14 ATTRIBUTE (REVERSE)
LET idx_e = 1
LET idx_m = 1
LET idx_p = 1
LET salir1 = "N"
# Loop Para los materiales con su descripcion
WHILE salir1 != "S"
FETCH ABSOLUTE idx_p accion3 INTO materiales.*
IF STATUS = NOTFOUND THEN
LET salir1 = "S"
EXIT WHILE
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
FINISH REPORT ordenar
RETURN
END IF
LET idx_p = idx_p + 1
LET supliorden.cod_n = materiales.cod_n
LET supliorden.cod_grupo = materiales.cod_grupo
LET supliorden.cod_tipo = materiales.cod_tipo
LET supliorden.cod_sec = materiales.cod_sec
LET supliorden.descrip_esp = materiales.descrip_esp
LET supliorden.unidad_med = materiales.unidad_med
LET supliorden.num_oc = null
LET supliorden.tipo = null
LET supliorden.cantidad = null
LET supliorden.cantidad_2 = null
LET supliorden.remanente = null
LET recibida = 0
LET esta = "N"
LET salir2= "N"
# Loop para cantidades de la orden
WHILE salir2 != "S"
FETCH ABSOLUTE idx_m ent_curs INTO entregas.*
IF STATUS = NOTFOUND THEN
LET idx_m = 1
EXIT WHILE
END IF
LET idx_m = idx_m + 1
IF materiales.cod_n = entregas.cod_n AND
materiales.cod_grupo = entregas.cod_grupo AND
materiales.cod_tipo = entregas.cod_tipo AND
materiales.cod_sec = entregas.cod_sec THEN
LET pendiente = entregas.cantidad
LET supliorden.cantidad = entregas.cantidad
LET supliorden.precio = entregas.precio
LET recibida = 0
LET esta = "S"
LET encontre = "N"
LET salir = "N"
# Loop para movimientos de ordenes de compras
LET supliorden.cantidad_2 = 0
WHILE salir != "S"
FETCH ABSOLUTE idx_e movi_curs INTO movi_t.*
IF status = notfound THEN
LET salir = "S"
LET idx_e = 1
EXIT WHILE
END IF
LET idx_e = idx_e + 1
IF movi_t.cod_n = entregas.cod_n AND
movi_t.cod_grupo = entregas.cod_grupo AND
movi_t.cod_tipo = entregas.cod_tipo AND
movi_t.cod_sec = entregas.cod_sec AND
movi_t.num_oc = entregas.num_oc THEN
LET pendiente = pendiente - movi_t.cantidad
LET recibida = recibida + movi_t.cantidad
LET encontre = "S"
LET salir = "S"
#LET idx_e = 1
EXIT WHILE
END IF
END WHILE
IF clasifica = "T" THEN
LET supliorden.num_oc = entregas.num_oc
LET supliorden.tipo = entregas.tipo
LET supliorden.cantidad_2 = recibida
LET supliorden.remanente = recibida - supliorden.cantidad
END IF
IF clasifica = "P" THEN
IF pendiente > 0 THEN
LET supliorden.num_oc = entregas.num_oc
LET supliorden.tipo = entregas.tipo
LET supliorden.cantidad_2 = recibida
LET supliorden.remanente = pendiente
END IF
END IF
SELECT c.num_oc,c.tipo,c.fech_oc,
e.cod_sp,e.cod_sp_sec,e.nom_sp,
c.c_flete,c.otros_g,c.cierre
INTO ordenes.*
FROM cotb00001 e,cotb00014 c
WHERE c.num_oc = supliorden.num_oc AND
c.tipo = supliorden.tipo AND
e.cod_sp = c.cod_sp AND
e.cod_sp_sec = c.cod_sp_sec AND
c.status_t is null
LET supliorden.fech_oc = ordenes.fech_oc
LET supliorden.cod_sp = ordenes.cod_sp
LET supliorden.cod_sp_sec = ordenes.cod_sp_sec
LET supliorden.nom_sp = ordenes.nom_sp
LET supliorden.c_flete = ordenes.c_flete
LET supliorden.otros_g = ordenes.otros_g
IF clasifica = "C" THEN
LET supliorden.cantidad = null
END IF
IF ordenes.cierre = "S" THEN
IF clasifica = "C" THEN
LET supliorden.num_oc = ordenes.num_oc
LET supliorden.tipo = ordenes.tipo
LET supliorden.cantidad = entregas.cantidad
LET supliorden.cantidad_2 = recibida
LET supliorden.remanente = pendiente
END IF
END IF
IF supliorden.cantidad is not null THEN
OUTPUT TO REPORT ordenar(supliorden.*)
#display " " at 24,1
END IF
ELSE
IF esta = "S" THEN
EXIT WHILE
END IF
END IF
END WHILE
END WHILE
FINISH REPORT ordenar
CLEAR SCREEN
RUN "type C:\\archivo > %USPRINT%" END FUNCTION
REPORT ordenar(x)
DEFINE x RECORD
num_oc LIKE cotb00014.num_oc,
tipo LIKE cotb00014.tipo,
fech_oc LIKE cotb00014.fech_oc,
cod_sp LIKE cotb00001.cod_sp,
cod_sp_sec LIKE cotb00001.cod_sp_sec,
nom_sp LIKE cotb00001.nom_sp,
cantidad LIKE cotb00015.cantidad,
cantidad_2 LIKE iptb00006.cantidad_2,
remanente LIKE iptb00006.cantidad_2,
precio LIKE cotb00015.precio,
c_flete LIKE cotb00014.c_flete,
otros_g LIKE cotb00014.otros_g,
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
END RECORD
DEFINE bandera,bandera1 CHAR(1)
DEFINE descrip CHAR(10)
DEFINE moneda CHAR(2)
DEFINE varia CHAR(12)
DEFINE cantidad DECIMAL(12,3)
DEFINE P2 DECIMAL(12,3)
DEFINE monto2,monto DECIMAL(14,3)
DEFINE b_oc,b_suplidor,imp CHAR(1)
DEFINE l SMALLINT
DEFINE doc_ant INTEGER
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 normal 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 imp = "T"
LET doce = ASCII 27, ASCII 77
LET normal = ASCII 27, ASCII 80
LET hora = time
IF clasifica = "P" THEN
LET varia = "*Pendientes*"
END IF
IF clasifica = "C" THEN
LET varia = "*Cerradas*"
END IF
IF clasifica = "T" THEN
LET varia = "*Todas*"
END IF
LET l = (141 - LENGTH(p_companias.nombre CLIPPED))/2
PRINT COLUMN 3, comp_on,negrillas_on
PRINT COLUMN 1, "coprrp003",
COLUMN l, p_companias.nombre CLIPPED,
COLUMN 134, "Pag. ",pageno using "###"
PRINT COLUMN 61, "Sistema de Compras",
COLUMN 134, today using "dd/mm/yy"
PRINT COLUMN 61, "Ordenes de Compras",
COLUMN 137, hora
LET l = (141 - LENGTH(varia))/2
PRINT COLUMN L, varia
SKIP 1 LINES
PRINT COLUMN 1, "Desde ",rango.fech_in using "dd/mm/yy",
" Hasta ",rango.fech_fi using "dd/mm/yy"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-----------------------------------------"
PRINT COLUMN 1, "Orden de",
COLUMN 23, "Fecha",
COLUMN 32, "Fecha",
COLUMN 86, "Cantidad",
COLUMN 100, "Cantidad"
PRINT COLUMN 3, "Compra",
COLUMN 12, "Tipo",
COLUMN 23, "Pedido",
COLUMN 32, "Entrega",
COLUMN 42, "Suplidor",
COLUMN 86, "Ordenada",
COLUMN 100, "Recibida",
COLUMN 112, "Diferencia"
PRINT COLUMN 1, "--------------------------------------------------",
"--------------------------------------------------",
"-----------------------------------------"
SKIP 1 LINE
BEFORE GROUP OF x.cod_n
LET bandera = "S"
BEFORE GROUP OF x.cod_grupo
LET bandera = "S"
BEFORE GROUP OF x.cod_tipo
LET bandera = "S"
BEFORE GROUP OF x.cod_sec
LET bandera = "S"
BEFORE GROUP OF x.cod_sp
LET b_suplidor = "S"
BEFORE GROUP OF x.cod_sp_sec
LET b_suplidor = "S"
BEFORE GROUP OF x.num_oc
LET b_oc = "S"
LET cantidad = x.cantidad
ON EVERY ROW
IF x.fech_oc >= rango.fech_in and x.fech_oc <= rango.fech_fi THEN
IF bandera = "S" AND bandera1 IS NULL THEN
SKIP 1 LINE
IF x.cantidad_2 is not null THEN
PRINT COLUMN 1, negrillas_on,
COLUMN 2, "Codigo ",x.cod_n USING "&","-",
x.cod_grupo USING "&","-",x.cod_tipo USING "&&","-",
x.cod_sec USING "&&&"," ", COLUMN 26, "Descripcion",
" ",x.descrip_esp," ",x.unidad_med,negrillas_off
LET bandera = "N"
END IF
END IF
IF x.tipo = "01" THEN
LET descrip = "GENERAL"
IF x.c_flete IS NOT NULL THEN
LET moneda = "US"
END IF
IF x.c_flete IS NULL OR x.c_flete = 0 THEN
LET moneda = "RD"
END IF
END IF
IF x.tipo = "02" THEN
LET descrip = "ROV-LTD"
IF x.c_flete IS NOT NULL THEN
LET moneda = "US"
END IF
END IF
IF x.tipo = "03" THEN
LET descrip = "LOCAL"
LET moneda = "RD"
END IF
IF x.tipo = "04" THEN
LET descrip = "MISCELANEA"
LET moneda = "RD"
END IF
IF x.cantidad_2 is not null THEN
IF b_oc = "S" THEN
PRINT COLUMN 3, x.num_oc using "<<<<<<",
COLUMN 12, descrip,
COLUMN 23, x.fech_oc USING "dd/mm/yy";
END IF
LET b_oc = "N"
IF b_suplidor = "S" THEN
PRINT COLUMN 42, x.cod_sp USING "<<","-",x.cod_sp_sec USING "<<<<",
" ",x.nom_sp CLIPPED;
END IF
LET b_suplidor = "N"
PRINT COLUMN 82, x.cantidad USING "##,###,###.##",
COLUMN 96, x.cantidad_2 USING "##,###,###.##",
COLUMN 110, x.cantidad - x.cantidad_2
USING "--,---,---.##"
END IF
END IF
AFTER GROUP OF x.cod_n
LET bandera = "N"
LET bandera1 = NULL
AFTER GROUP OF x.cod_grupo
LET bandera = "N"
LET bandera1 = NULL
AFTER GROUP OF x.cod_tipo
LET bandera = "N"
LET bandera1 = NULL
AFTER GROUP OF x.cod_sec
LET bandera = "N"
LET bandera1 = NULL
ON LAST ROW
PRINT comp_off
END REPORT