{ ----------------------------------------------------------------------------- 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" " Adiciona Registo Cancela Operacion" CALL prpradd() COMMAND "Consultar-modificar" " Actualiza Registro 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" " Actualiza Registro 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