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

469 lines
14 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : COPRPC001
FUNCION : Funcion para actualizar campo de la tabla cotb00025, para
determinar lo que se ha recibido de cada orden en cada entrega
PROGRAMADOR : Ing. Juan Fco. Soto
FECHA : Marzo 18, 1993
FUNCION : MUEVE_FECHA mueve las fechas parciales a un mes mas adelante
para que intervenga en la proyeccion.
FECHA : Abril 14, 1993
-----------------------------------------------------------------------------
}
GLOBALS
"coprgb000.4gl"
DEFINE a_dia ARRAY[12] OF SMALLINT
DEFINE fecha_final CHAR(6)
DEFINE mes2,total_registros,dia,dia_ini,mes_ini,mes_fin,meses_py,mes INTEGER
DEFINE rango_p,ano_fin,ano CHAR(4)
DEFINE id INTEGER
DEFINE p_ordenes RECORD LIKE cotb00014.*
DEFINE p_entregas RECORD LIKE cotb00025.*
DEFINE rid INTEGER
DEFINE select_1 CHAR(1000)
DEFINE p_entrega1 RECORD
orden INTEGER,
fecha date,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(13,4)
END RECORD
DEFINE p_entrega RECORD
orden INTEGER,
fecha date,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
cantidad DECIMAL(13,4)
END RECORD
DEFINE up_fecha CHAR(6)
DEFINE up_fecha1 DATE
DEFINE idx1 INTEGER
DEFINE basura,pendiente,recibidas DECIMAL(13,2)
DEFINE orden_anterior INTEGER,
ch_ord,primera_vez CHAR(1)
DEFINE ant RECORD
cod_n SMALLINT,
cod_Grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT
END RECORD
FUNCTION coprpc001()
OPTIONS
FORM LINE 8
CLEAR SCREEN
LET formulario = formulario CLIPPED,"cofmpc001"
OPEN FORM cofmpc001 FROM formulario
DISPLAY FORM cofmpc001
CALL pantalla()
DISPLAY "coprpc001" AT 4,3
DISPLAY "Actualizacion Cantidades Llegadas" AT 6,23
#PEN FORM fmres FROM "fmres"
#ISPLAY FORM fmres
#NPUT BY NAME ordenes
#F ordenes is null THEN
# GOTO sale
#ND IF
LET idx1 = 1
LET pendiente = 0
LET recibidas = 0
LET ch_ord = "N"
#DISPLAY "EN PROCESO DE ACTUALIZACION... ESPERE POR FAVOR" AT 12,10
#CALL actualiza()
#END FUNCTION
#FUNCTION actualiza()
#OPTIONS
#FORM LINE 10,
#ERROR LINE 24
CONSTRUCT BY NAME criterio ON tipo,num_oc
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET select_1 =
"SELECT num_oc,fech_ent,cod_n,cod_grupo,cod_tipo,cod_sec,cantidad,rowid ",
"FROM cotb00025 ",
"WHERE ",criterio clipped,
"ORDER BY 1,3,4,5,6,2 "
PREPARE buscate FROM select_1
DECLARE fecha SCROLL CURSOR FOR buscate
OPEN fecha
LET primera_vez = "S"
WHILE status != notfound
FETCH ABSOLUTE idx1 fecha INTO p_entrega.*,rid
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 pendiente = 0
DISPLAY "ORDEN : " AT 14,2
DISPLAY p_entrega.orden at 14,12 attribute (bold)
DISPLAY "MATERIAL: " AT 14,20
DISPLAY p_entrega.cod_n at 14,30 attribute (bold)
DISPLAY p_entrega.cod_grupo at 14,40 attribute (bold)
DISPLAY p_entrega.cod_tipo at 14,50 attribute (bold)
DISPLAY p_entrega.cod_sec at 14,60 attribute (bold)
IF orden_anterior = p_entrega.orden and
ant.cod_n = p_entrega.cod_n and
ant.cod_grupo = p_entrega.cod_grupo and
ant.cod_tipo = p_entrega.cod_tipo and
ant.cod_sec = p_entrega.cod_Sec THEN
LET primera_vez = "N"
ELSE
LET primera_vez = "S"
END IF
IF primera_vez = "S" THEN
LET primera_vez = "N"
LET orden_anterior = p_entrega.orden
LET ant.cod_n = p_entrega.cod_n
LET ant.cod_grupo = p_entrega.cod_grupo
LET ant.cod_tipo = p_entrega.cod_tipo
LET ant.cod_sec = p_entrega.cod_sec
IF ch_ord = "S" THEN
SELECT unique num_oc FROM cotb00025
WHERE num_oc = p_entrega.orden and
cod_n = p_entrega.cod_n and
cod_grupo = p_entrega.cod_grupo and
cod_tipo = p_entrega.cod_tipo and
cod_sec = p_entrega.cod_sec and
status_t is null
IF STATUS = NOTFOUND then
let status = 0
END IF
ELSE
SELECT sum(cantidad_2) INTO recibidas FROM intb00006
WHERE orden_compra = p_entrega.orden and
cod_n = p_entrega.cod_n and
cod_grupo = p_entrega.cod_grupo and
cod_tipo = p_entrega.cod_tipo and
cod_sec = p_entrega.cod_sec and
status_t is null and
cantidad_2 > 0
IF STATUS = NOTFOUND then
let status = 0
END IF
END IF
END IF
LET idx1 = idx1 + 1
IF recibidas = 0 or recibidas is null THEN
LET ch_ord = "S"
END IF
IF ch_ord = "S" THEN
GOTO alli
END IF
IF orden_anterior = p_entrega.orden and
ant.cod_n = p_entrega.cod_n and
ant.cod_grupo = p_entrega.cod_grupo and
ant.cod_tipo = p_entrega.cod_tipo and
ant.cod_sec = p_entrega.cod_Sec THEN
IF recibidas > 0 THEN
LET recibidas = recibidas - p_entrega.cantidad
LET pendiente = p_entrega.cantidad
END IF
IF recibidas = 0 THEN
LET pendiente = p_entrega.cantidad
END IF
IF recibidas < 0 THEN
LET pendiente = recibidas + p_entrega.cantidad
END IF
LABEL alli:
FETCH ABSOLUTE idx1 fecha INTO p_entrega1.*
IF p_entrega1.orden = p_entrega.orden and
p_entrega1.cod_n = p_entrega.cod_n and
p_entrega1.cod_grupo = p_entrega.cod_grupo and
p_entrega1.cod_tipo = p_entrega.cod_tipo and
p_entrega1.cod_sec = p_entrega.cod_Sec THEN
LET basura = 0
ELSE
IF ch_ord = "S" THEN
GOTO actual
END IF
IF recibidas < 0 or recibidas > 0 THEN
LET pendiente = recibidas + p_entrega.cantidad
ELSE
LET pendiente = p_entrega.cantidad
END IF
END IF
END IF
LABEL actual:
UPDATE cotb00025 set cantidad_r = pendiente
WHERE rowid = rid
LET ch_ord = "N"
IF pendiente < p_entrega.cantidad THEN
LET pendiente = 0
LET ch_ord = "S"
IF p_entrega1.orden = p_entrega.orden and
p_entrega1.cod_n = p_entrega.cod_n and
p_entrega1.cod_grupo = p_entrega.cod_grupo and
p_entrega1.cod_tipo = p_entrega.cod_tipo and
p_entrega1.cod_sec = p_entrega.cod_Sec THEN
LET basura = 0
ELSE
LET ch_ord = "N"
END IF
END IF
END WHILE
LABEL sale:
END FUNCTION
FUNCTION mueve_fecha()
DEFINE archivo CHAR(17),
hoy date,
tiempo CHAR(12)
OPTIONS
PROMPT LINE 16,
ERROR LINE 24
CLEAR SCREEN
DISPLAY "ESTE PORCESO MUEVE LAS FECHAS DE ENTREGAS " AT 8,8 ATTRIBUTE (BOLD)
DISPLAY "A UNA FECHA QUE ESTE EN EL RANGO DE LA " AT 9,8 ATTRIBUTE (BOLD)
DISPLAY "PROYECCION. " AT 10,8 ATTRIBUTE (BOLD)
DISPLAY "ANTES DE IMPRIMIR EL REPORTE DE PROYECCION" AT 11,8 ATTRIBUTE (BOLD)
DISPLAY "SE DEBE HACER ESTE PROCESO. " AT 12,8 ATTRIBUTE (BOLD)
DISPLAY "LAS FECHAS ORIGINALES DE LAS ENTREGAS SE " AT 13,8 ATTRIBUTE (BOLD)
DISPLAY "ACTUALIZARAN. ESTA SEGURO DE HACER ESTO " AT 14,8 ATTRIBUTE (BOLD)
PROMPT
"Preciones Cualquier Tecla Para Proceder o <Ctrl> - <Back Space> Cancela"
FOR CHAR OPT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
OPEN WINDOW mueve AT 12,8 WITH FORM "cofmwd011" ATTRIBUTE
(BORDER,FORM LINE FIRST + 1,MESSAGE LINE FIRST, PROMPT LINE LAST)
INPUT BY NAME meses_py,
fecha_inicial_py
AFTER FIELD meses_py
IF meses_py IS NULL OR
meses_py = 0 THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD meses_py
END IF
AFTER FIELD fecha_inicial_py
IF fecha_inicial_py IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_inicial_py
END IF
LET mes_fin = MONTH(fecha_inicial_py)
LET ano_fin = YEAR(fecha_inicial_py)
FOR idx = 1 TO meses_py
LET mes_fin = mes_fin + 1
IF mes_fin > 12 THEN
LET mes_fin = 1
LET ano_fin = ano_fin + 1
END IF
END FOR
LET dia_ini = DAY(fecha_inicial_py)
LET mes_ini = MONTH(fecha_inicial_py)
IF dia_ini > 15 THEN
LET mes2 = mes_fin
LET mes_fin = mes_fin + 1
IF mes_fin > 12 THEN
LET mes_fin = 1
END IF
END IF
LET rango_p = MONTH(fecha_inicial_py) using "&&",
mes_fin using "&&"
IF dia_ini > 15 THEN
LET mes_fin = mes2
LET mes2 = 0
END IF
LET fecha_final = DAY(fecha_inicial_py) using "&&",
mes_fin using "&&",
ano_fin[3,4] using "&&"
LET fecha_final_py = fecha_final
LET total_registros = null
SELECT count(*) INTO total_registros FROM cotb00026
WHERE rango_plan=rango_p AND fecha_ini=fecha_inicial_py AND
status_t is NULL
IF total_registros = 0 OR
total_registros IS NULL THEN
LET numero_msg = 48
CALL msg(numero_msg)
NEXT FIELD meses_py
END IF
AFTER INPUT
IF int_flag THEN
LET int_flag = FALSE
LET numero_msg = 2
CALL msg(numero_msg)
RETURN
END IF
EXIT INPUT
LET dia_ini = DAY(fecha_inicial_py)
LET mes_ini = MONTH(fecha_inicial_py)
LET mes_fin = MONTH(fecha_inicial_py) + meses_py
IF dia_ini > 15 THEN
LET mes2 = mes_fin
LET mes_fin = mes_fin + 1
IF mes_fin > 12 THEN
LET mes_fin = 1
END IF
END IF
LET rango_p = MONTH(fecha_inicial_py) using "&&",
mes_fin using "&&"
IF dia_ini > 15 THEN
LET mes_fin = mes2
LET mes2 = 0
END IF
LET total_registros = null
SELECT count(*) INTO total_registros FROM cotb00026
WHERE rango_plan=rango_p AND fecha_ini=fecha_inicial_py AND
status_t is NULL
IF total_registros = 0 OR
total_registros IS NULL THEN
LET numero_msg = 48
CALL msg(numero_msg)
NEXT FIELD meses_py
END IF
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
GO TO cierra
END IF
PROMPT "Esta Seguro De Proceder (S/N)? " FOR CHAR clasifica
LET clasifica = upshift(clasifica)
IF clasifica = "S" THEN
LET hoy = today
LET tiempo = time
LET archivo = hoy using "ddmmyy",tiempo[1,8],".up"
START REPORT actua TO archivo
DECLARE fecha_p CURSOR FOR
SELECT rowid,* FROM cotb00025 WHERE fech_ent < fecha_inicial_py and
cantidad - cantidad_r > 0 and
cod_n = 1
FOREACH fecha_p INTO id,p_entregas.*
IF status = notfound THEN
EXIT FOREACH
END IF
LET dia = DAY(p_entregas.fech_ent)
LET mes = MONTH(fecha_inicial_py)
LET ano = YEAR(fecha_inicial_py)
CALL tabla_dias()
DISPLAY dia at 1,2
IF a_dia[mes] < dia THEN
LET dia = a_dia[mes]
END IF
LET up_fecha = dia using "&&",mes using "&&",ano[3,4]
display up_fecha at 2,2
LET up_fecha1 = up_fecha
DISPLAY BY NAME p_entregas.num_oc,
p_entregas.fech_ent,
up_fecha1 ATTRIBUTE (BOLD)
UPDATE cotb00025 set fech_ent = up_fecha1,
us_mod = user,
fech_mod = current
WHERE rowid = id
OUTPUT TO REPORT actua()
END FOREACH
END IF
LABEL cierra:
CLOSE WINDOW mueve
END FUNCTION
REPORT actua()
FORMAT
ON EVERY ROW
PRINT COLUMN 1, p_entregas.num_oc using "&&&&&"," ",
p_entregas.cod_n using "&","-",
p_entregas.cod_grupo using "&","-",
p_entregas.cod_tipo using "&&","-",
p_entregas.cod_sec using "&&&","-",
p_entregas.fech_ent using "dd/mm/yy"," ",
up_fecha1 using "dd/mm/yy"
END REPORT
FUNCTION tabla_dias()
LET a_dia[1] = 31
LET a_dia[2] = 28
LET a_dia[3] = 31
LET a_dia[4] = 30
LET a_dia[5] = 31
LET a_dia[6] = 30
LET a_dia[7] = 31
LET a_dia[8] = 31
LET a_dia[9] = 30
LET a_dia[10] = 31
LET a_dia[11] = 30
LET a_dia[12] = 31
END FUNCTION