Files
MBS/PROYECTO/ctdir/prprmt003.4gl
T

632 lines
19 KiB
Plaintext

{
-----------------------------------------------------------------------------
PROGRAMA : prprmt003
OBJETIVO : Mantenimiento de Produccion por Centro de Costos
REALIZADO POR : Ing. Juan F. Soto.
FECHA : Junio 17, 1993
-----------------------------------------------------------------------------
}
GLOBALS "prprgb000.4gl"
DEFINE nomb_mq ARRAY[200] OF CHAR(30)
DEFINE dep_ant,p_codigo SMALLINT
DEFINE medida,nomb1,nomb2 CHAR(20)
DEFINE descrip2,nombre,nombre_mq,descrip_ant,descripcion CHAR(30)
DEFINE hoy DATE
DEFINE tiene CHAR(1)
DEFINE temporero RECORD LIKE adtb00036.*
DEFINE datos_c RECORD
num_doc INTEGER,
fecha DATE,
departamento SMALLINT
END RECORD
DEFINE arr_costos ARRAY[200] OF RECORD
tipo LIKE cttb00003.cod_mq,
emp_no LIKE cttb00003.emp_no,
h_directa LIKE cttb00003.h_directa,
h_indirecta LIKE cttb00003.h_indirecta,
e_directa LIKE cttb00003.e_directa,
e_indirecta LIKE cttb00003.e_indirecta,
cod_prod LIKE cttb00011.cod_prod,
cantidad LIKE cttb00003.cantidad
END RECORD
FUNCTION prprmt003()
OPTIONS
FORM LINE 5,
ERROR LINE 24,
PROMPT LINE 1
CLEAR SCREEN
OPEN FORM prfmmt003 FROM "prfmmt003"
DISPLAY FORM prfmmt003
DISPLAY "Registro de Produccion Diaria" AT 4,25
DISPLAY "prprmt003" AT 4,3
# CALL pantalla1()
MENU "OPCION"
COMMAND "Adicionar"
"<Esc> Adiciona Registo <Ctrl-C> Cancela Operacion"
CALL prpradd()
COMMAND "Consultar-modificar"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
CALL prprmod()
COMMAND KEY ("N") "aNular"
CALL prpranula()
COMMAND "Retornar"
EXIT MENU
END MENU
END FUNCTION
FUNCTION prpradd()
LET hoy = null
LABEL volver:
LET nombre = null
DISPLAY BY NAME nombre
SELECT ult_num INTO datos_c.num_doc FROM cttb00010
LET datos_c.num_doc = datos_c.num_doc + 1
LET idx = 1
INPUT BY NAME datos_c.* WITHOUT DEFAULTS
# Permanece la ultima fecha que el introdujo
BEFORE FIELD fecha
LET datos_c.fecha = hoy
DISPLAY BY NAME datos_c.fecha
AFTER FIELD fecha
IF datos_c.fecha is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
IF datos_c.fecha > today THEN
LET numero_msg = 189
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
# Control del registro de produccion diaria para la no duplicidad
SELECT UNIQUE a. fecha FROM cttb00003 a
WHERE a.fecha = datos_c.fecha and
a.num_doc = datos_c.num_doc
IF status != notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
# Control busqueda departamento
AFTER FIELD departamento
IF datos_c.departamento is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD departamento
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME descrip2
# Busqueda del nombre del empleado
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
FOR idx = 1 to 100
LET arr_costos[idx].tipo = null
LET arr_costos[idx].emp_no = null
LET arr_costos[idx].h_directa = null
LET arr_costos[idx].h_indirecta = null
LET arr_costos[idx].e_directa = null
LET arr_costos[idx].e_indirecta = null
LET arr_costos[idx].cod_prod = null
LET arr_costos[idx].cantidad = null
END FOR
# Arreglo para la captura de la produccion
INPUT ARRAY arr_costos WITHOUT DEFAULTS FROM scr_costos.*
BEFORE ROW
# Variables para controlar el indice del vector
LET curr = arr_curr()
LET scr_l = scr_line()
# Busca descripcion de la maquina
AFTER FIELD tipo
IF arr_costos[curr].tipo is not null THEN
SELECT a.descripcion INTO nombre_mq FROM prtb00005 a
WHERE a.codigo = arr_costos[curr].tipo and a.status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
DISPLAY BY NAME nombre_mq
LET nomb_mq[curr] = nombre_mq
END IF
# Busca el nombre del empleado
AFTER FIELD emp_no
IF arr_costos[curr].emp_no is not null THEN
SELECT a.nom1_emp,a.apell1_emp INTO nomb1,nomb2
FROM adtb00003 a
WHERE a.num_emp = arr_costos[curr].emp_no
# and a.nomina = "S"
IF status = notfound THEN
SELECT * INTO temporero.* FROM adtb00036
WHERE num_emp = arr_costos[curr].emp_no
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD emp_no
END IF
LET nomb1 = temporero.nom1_emp
LET nomb2 = temporero.apell1_emp
END IF
LET nombre = nomb1 clipped,",",nomb2 clipped
DISPLAY BY NAME NOMBRE ATTRIBUTE (BOLD)
END IF
# Control del codigo de la produccion que estan acumulando
AFTER FIELD cod_prod
IF arr_costos[curr].cod_prod is not null THEN
# Busca la descripcion de la pila de la formula que se introdujo
# anteriormente
SELECT unique a.cod_prod,a.descripcion,a.unidad_med
INTO p_codigo,descripcion,medida
FROM cttb00001 a
WHERE
a.cod_prod = arr_costos[curr].cod_prod and
a.status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_prod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME medida
DISPLAY BY NAME descripcion
END IF
#--------------------------------------------------------------------------
AFTER FIELD cantidad
IF arr_costos[curr].cantidad is null THEN
LET arr_costos[curr].cantidad = 0
END IF
AFTER INPUT
# Control de la cancelacion de la operacion que se esta realizando en
# el momento.
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
#----------------------------------------------------------------------------
EXIT INPUT
END INPUT
# Control para chequeo de las informaciones si estan correctas
# da oportunidad al usuario de arreglar en el momento errores
LABEL atras:
FOR idx = 1 to arr_count()
IF arr_costos[idx].emp_no is not null THEN
IF arr_costos[idx].h_directa is null THEN
LET arr_costos[idx].h_directa = 0
END IF
IF arr_costos[idx].h_indirecta is null THEN
LET arr_costos[idx].h_indirecta = 0
END IF
IF arr_costos[idx].e_directa is null THEN
LET arr_costos[idx].e_directa = 0
END IF
IF arr_costos[idx].e_indirecta is null THEN
LET arr_costos[idx].e_indirecta = 0
END IF
INSERT INTO cttb00003 values
(datos_c.num_doc,datos_c.fecha,datos_c.departamento,
arr_costos[idx].emp_no,arr_costos[idx].tipo,nomb_mq[idx],
arr_costos[idx].h_directa,arr_costos[idx].h_indirecta,
arr_costos[idx].e_directa,arr_costos[idx].e_indirecta,
arr_costos[idx].cod_prod,
arr_costos[idx].cantidad,null,USER,CURRENT,null,null)
END IF
END FOR
UPDATE cttb00010 set ult_num = datos_c.num_doc
CALL integridad()
IF bandera = "1" THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
# Vuelve hacia el campo inicial de la pantalla para proseguir con el
# siguiente documento
GOTO volver
#---------------------------------------------------------------------------
END FUNCTION
# -------------------------- FUNCION DE MODIFICACION --------------------
FUNCTION prprmod()
CONSTRUCT BY NAME criterio ON a.num_doc,a.fecha,a.departamento
LET selec =
"SELECT UNIQUE a.num_doc,a.fecha,a.departamento ",
"FROM cttb00003 a ",
"WHERE ",criterio clipped, " And a.status_t is null",
" ORDER BY 1,2,3"
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
PREPARE comando FROM selec
DECLARE buscate SCROLL CURSOR FOR comando
OPEN buscate
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
FETCH FIRST buscate INTO datos_c.*
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME datos_c.*,descrip2
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT buscate INTO datos_c.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
DISPLAY BY NAME datos_c.*
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS buscate INTO datos_c.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
DISPLAY BY NAME datos_c.*
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST buscate INTO datos_c.*
DISPLAY BY NAME datos_c.*
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST buscate INTO datos_c.*
DISPLAY BY NAME datos_c.*
LET numero_msg = 4
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Ctrl-C> Cancela Operacion"
SELECT a.nom_dpto INTO descrip2 FROM adtb00001 a
WHERE a.departamento = datos_c.departamento and
a.status_t is null
DISPLAY BY NAME descrip2 ATTRIBUTE (BOLD)
INPUT BY NAME datos_c.fecha THRU datos_c.departamento
WITHOUT DEFAULTS
AFTER INPUT
IF int_flag THEN
LET int_flag = false
LET numero_msg = 2
CALL msg(numero_msg)
RETURN
END IF
EXIT INPUT
END INPUT
DECLARE busca10 CURSOR FOR
SELECT a.cod_mq,a.emp_no,a.h_directa,a.h_indirecta,a.e_directa,a.e_indirecta,
a.cod_prod,a.cantidad
FROM cttb00003 a
WHERE a.num_doc =datos_c.num_doc
LET idx = 1
FOREACH busca10 INTO arr_costos[idx].*
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
# Arreglo para la captura de la produccion
INPUT ARRAY arr_costos WITHOUT DEFAULTS FROM scr_costos.*
BEFORE ROW
# Variables para controlar el indice del vector
LET curr = arr_curr()
LET scr_l = scr_line()
# Busca descripcion de la maquina
AFTER FIELD tipo
IF arr_costos[curr].tipo is not null THEN
SELECT a.descripcion INTO nombre_mq FROM prtb00005 a
WHERE a.codigo = arr_costos[curr].tipo and a.status_t is null
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo
END IF
DISPLAY BY NAME nombre_mq
LET nomb_mq[curr] = nombre_mq
END IF
# Busca el nombre del empleado
AFTER FIELD emp_no
IF arr_costos[curr].emp_no is not null THEN
SELECT a.nom1_emp,a.apell1_emp INTO nomb1,nomb2
FROM adtb00003 a
WHERE a.num_emp = arr_costos[curr].emp_no
# and a.nomina = "S"
IF status = notfound THEN
SELECT * INTO temporero.* FROM adtb00036
WHERE num_emp = arr_costos[curr].emp_no
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD emp_no
END IF
LET nomb1 = temporero.nom1_emp
LET nomb2 = temporero.apell1_emp
END IF
LET nombre = nomb1 clipped," ",nomb2 clipped
DISPLAY BY NAME NOMBRE ATTRIBUTE (BOLD)
END IF
# Control del codigo de la produccion que estan acumulando
AFTER FIELD cod_prod
IF arr_costos[curr].cod_prod is not null THEN
# Busca la descripcion de la pila de la formula que se introdujo
# anteriormente
SELECT unique a.cod_prod,a.descripcion,a.unidad_med
INTO p_codigo,descripcion,medida
FROM cttb00001 a
WHERE
a.cod_prod = arr_costos[curr].cod_prod and
a.status_t is null
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_prod
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME medida
DISPLAY BY NAME descripcion
END IF
#--------------------------------------------------------------------------
AFTER FIELD cantidad
IF arr_costos[curr].cantidad is null THEN
LET arr_costos[curr].cantidad = 0
END IF
AFTER INPUT
# Control de la cancelacion de la operacion que se esta realizando en
# el momento.
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
#----------------------------------------------------------------------------
EXIT INPUT
END INPUT
DELETE FROM cttb00003 WHERE @num_doc = datos_c.num_doc
FOR idx = 1 to arr_count()
IF arr_costos[idx].emp_no is not null THEN
INSERT INTO cttb00003 values
(datos_c.num_doc,datos_c.fecha,datos_c.departamento,
arr_costos[idx].emp_no,arr_costos[idx].tipo,nomb_mq[idx],
arr_costos[idx].h_directa,arr_costos[idx].h_indirecta,
arr_costos[idx].e_directa,arr_costos[idx].e_indirecta,
arr_costos[idx].cod_prod,arr_costos[idx].cantidad,
null,USER,CURRENT,USER,CURRENT)
END IF
END FOR
CALL integridad()
IF bandera = "1" THEN
LET bandera = 0
RETURN
END IF
LET numero_msg = 13
CALL msg(numero_msg)
CLEAR FORM
COMMAND "Retornar"
"Retorna al menu Anterior"
EXIT MENU
END MENU
END FUNCTION
{
FUNCTION repite()
DEFINE producto,codigo SMALLINT
LET codigo = arr_costos[curr].departamento
LET producto = arr_costos[curr].cod_prod
FOR idx = 1 TO arr_count()
IF idx != curr THEN
IF arr_costos[idx].departamento IS NOT NULL THEN
IF arr_costos[idx].departamento = codigo and
arr_costos[idx].cod_prod = producto THEN
LET numero_msg = 21
CALL msg(numero_msg)
LET existe = "S"
ELSE
IF existe != "S" THEN
LET existe = "N"
END IF
END IF
END IF
END IF
END FOR
END FUNCTION
}
FUNCTION prpranula()
INPUT BY NAME datos_c.fecha WITHOUT DEFAULTS
# Permanece la ultima fecha que el introdujo
BEFORE FIELD fecha
LET datos_c.fecha = hoy
DISPLAY BY NAME datos_c.fecha
AFTER FIELD fecha
LET hoy = datos_c.fecha
IF datos_c.fecha is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
SELECT unique fecha FROM cttb00003
WHERE fecha = datos_c.fecha and
status_t is null
IF status = notfound THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF datos_c.fecha is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
EXIT INPUT
END INPUT
PROMPT "Desea Anular este reporte (S/N) ?" for char opcion
LET opcion = upshift (opcion)
IF opcion = "S" THEN
DELETE FROM cttb00003
WHERE fecha = datos_c.fecha
LET numero_msg = 82
CALL msg(numero_msg)
END IF
END FUNCTION