{ ------------------------------------------------------------------ PROGRAMA : ISPRMT002 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla Maestra Suministro. PROGRAMADOR : Ing. Juan Fco. Soto FECHA REALIZACION : Octubre 21, 1993. ------------------------------------------------------------------ } GLOBALS "isprgb000.4gl" FUNCTION isprmt002() CLEAR SCREEN OPTIONS FORM LINE 8, ERROR LINE 23, COMMENT LINE 21 OPEN FORM isfmmt002 FROM "isfmmt002" DISPLAY FORM isfmmt002 CALL pantalla() DISPLAY "isprmt002" AT 4,3 ATTRIBUTE(RED) DISPLAY "Catalogo Suministros" at 6,30 ATTRIBUTE(BLACK) MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" CLEAR FORM LET INT_FLAG = FALSE CALL ispcad002() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" LET INT_FLAG = FALSE CALL ispcmf002() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION ispcad002() DEFINE fech_ant CHAR(8) #WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro INPUT BY NAME m_articulos.cod_n THRU m_articulos.cod_sec,descrip1,descrip2, medida,m_articulos.pto_reorden THRU m_articulos.fech_mod ## Verifica que el codigo no exista en el catalogo de m_articulos. Si existe, ## entonces despliega los datos del registro existente. AFTER FIELD cod_sec IF ( m_articulos.cod_n = 0 AND m_articulos.cod_grupo = 0 AND m_articulos.cod_tipo = 0 AND m_articulos.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n END IF SELECT i.* FROM intb00001 i WHERE i.cod_n = m_articulos.cod_n AND i.cod_grupo = m_articulos.cod_grupo AND i.cod_tipo = m_articulos.cod_tipo AND i.cod_sec = m_articulos.cod_sec and i.status_t is null IF status != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n END IF SELECT max(num_doc),max(fecha) INTO datos_gen.num_doc,datos_gen.fecha FROM istb00006 WHERE cod_mov = 99 IF status = notfound THEN LET datos_gen.num_doc = 0 LET datos_gen.fecha = today END IF LET datos_gen.num_doc = datos_gen.num_doc + 1 AFTER FIELD cod_nab IF m_articulos.cod_nab IS NOT NULL THEN SELECT * FROM cotb00005 WHERE cod_nab = m_articulos.cod_nab and status_t is null IF status >= 0 THEN IF status = notfound THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD cod_nab END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF AFTER FIELD existencia IF m_articulos.existencia IS null then LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD existencia END IF AFTER FIELD bodega IF m_articulos.bodega IS NOT NULL THEN SELECT * FROM istb00009 WHERE cod_bodega = m_articulos.bodega IF status >= 0 THEN IF status = notfound THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD bodega END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF AFTER FIELD dia_llegada IF m_articulos.dia_llegada IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dia_llegada END IF END INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF INSERT INTO intb00001 VALUES (m_articulos.cod_n,m_articulos.cod_grupo, m_articulos.cod_tipo,m_articulos.cod_sec,descrip1,descrip2, medida,NULL,USER,CURRENT,NULL,NULL) INSERT INTO istb00002 VALUES (m_articulos.cod_n,m_articulos.cod_grupo, m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.pto_reorden, m_articulos.existencia,m_articulos.cod_nab,m_articulos.base, m_articulos.bodega, m_articulos.categoria, m_articulos.dia_llegada,m_articulos.gravamen, null,user,current,null,null) # Verifica el Status que retorna luego de insertar el registro en la tabla. # Si el Status es diferente de cero quiere decir que hubo problemas durante # la creacion del registro, entonces despliega un mensaje de alerta para que # el usuario sepa que hubo problemas en la creacion del registro. SELECT * FROM istb00006 WHERE cod_mov = 99 AND cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec IF status = notfound THEN INSERT INTO istb00006 (num_doc,fecha,cod_mov,cod_n,cod_grupo,cod_tipo, cod_sec,cantidad_2,bodega,us_crea,fech_crea) VALUES (1,datos_gen.fecha,99,m_articulos.cod_n,m_articulos.cod_grupo, m_articulos.cod_tipo,m_articulos.cod_sec,m_articulos.existencia, m_articulos.bodega,user,current) END IF LET numero_msg = 1 CALL msg(numero_msg) CLEAR FORM END FUNCTION FUNCTION ispcmf002() #WHENEVER ERROR CONTINUE CLEAR FORM ## Aqui se prepara para la captura del criterio de seleccion CONSTRUCT BY NAME criterio ON istb00002.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = " SELECT UNIQUE * FROM istb00002 WHERE ", " status_t is null AND ", criterio clipped, " ORDER BY 1,2,3,4" PREPARE busca FROM selec CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF DECLARE datos SCROLL CURSOR WITH HOLD FOR busca OPEN datos FETCH FIRST datos INTO m_articulos.* IF status >= 0 THEN IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida FROM intb00001 WHERE cod_n = m_articulos.cod_n and cod_grupo = m_articulos.cod_grupo and cod_tipo = m_articulos.cod_tipo and cod_sec = m_articulos.cod_sec DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO m_articulos.* IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida FROM intb00001 WHERE cod_n = m_articulos.cod_n and cod_grupo = m_articulos.cod_grupo and cod_tipo = m_articulos.cod_tipo and cod_sec = m_articulos.cod_sec DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO m_articulos.* IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida FROM intb00001 WHERE cod_n = m_articulos.cod_n and cod_grupo = m_articulos.cod_grupo and cod_tipo = m_articulos.cod_tipo and cod_sec = m_articulos.cod_sec DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO m_articulos.* SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida FROM intb00001 WHERE cod_n = m_articulos.cod_n and cod_grupo = m_articulos.cod_grupo and cod_tipo = m_articulos.cod_tipo and cod_sec = m_articulos.cod_sec DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO m_articulos.* SELECT descrip_esp,descrip_ing,unidad_med INTO descrip1,descrip2,medida FROM intb00001 WHERE cod_n = m_articulos.cod_n and cod_grupo = m_articulos.cod_grupo and cod_tipo = m_articulos.cod_tipo and cod_sec = m_articulos.cod_sec DISPLAY BY NAME m_articulos.*,descrip1,descrip2,medida LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" INPUT BY NAME descrip1,descrip2,medida,m_articulos.pto_reorden THRU m_articulos.fech_mod WITHOUT DEFAULTS AFTER FIELD pto_reorden NEXT FIELD existencia AFTER FIELD cod_nab IF m_articulos.cod_nab IS NOT NULL THEN SELECT * FROM cotb00005 WHERE cod_nab = m_articulos.cod_nab IF status = notfound THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD cod_nab END IF END IF END INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF UPDATE intb00001 SET (descrip_esp,descrip_ing,unidad_med,us_mod,fech_mod)= (descrip1,descrip2,medida,USER,CURRENT) WHERE @cod_n= m_articulos.cod_n AND @cod_grupo = m_articulos.cod_grupo AND @cod_tipo = m_articulos.cod_tipo AND @cod_sec = m_articulos.cod_sec UPDATE istb00002 SET pto_reorden = m_articulos.pto_reorden, existencia = m_articulos.existencia, cod_nab = m_articulos.cod_nab, bodega = m_articulos.bodega, dia_llegada = m_articulos.dia_llegada, gravamen = m_articulos.gravamen, base = m_articulos.base, categoria = m_articulos.categoria, us_mod = USER, fech_mod = CURRENT WHERE cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec UPDATE istb00006 SET cantidad_2 = m_articulos.existencia, us_mod = USER, fech_mod = CURRENT WHERE cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec LET numero_msg = 13 CALL msg(numero_msg) COMMAND KEY ("L") "eLiminar" UPDATE intb00001 SET status_t = "E", us_mod = user, fech_mod = current WHERE cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec UPDATE istb00002 SET status_t = "E", us_mod = user, fech_mod = current WHERE cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec UPDATE istb00006 SET status_t = "E", us_mod = user, fech_mod = current WHERE cod_n = m_articulos.cod_n AND cod_grupo = m_articulos.cod_grupo AND cod_tipo = m_articulos.cod_tipo AND cod_sec = m_articulos.cod_sec LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION