{ ------------------------------------------------------------------ PROGRAMA : VEPRMT006 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Pesos y Medidas de las Pilas. PROGRAMADOR : Lic. Abner Montalvo Zapata FECHA REALIZACION : Septiembre 15, 1992. ------------------------------------------------------------------ } GLOBALS "veprgb000.4gl" DEFINE p_cod_prod SMALLINT, p_descrip LIKE cttb00001.descripcion, usuario LIKE prtb00006.us_crea, creacion LIKE prtb00006.fech_crea FUNCTION veprmt006() CLEAR SCREEN OPTIONS FORM LINE 9, ERROR LINE 23, HELP FILE "vepray000.exe", HELP KEY CONTROL-W, MESSAGE LINE 24, COMMENT LINE 21 OPEN FORM vefmmt006 FROM "vefmmt006" DISPLAY FORM vefmmt006 CALL pantalla() CALL ayuda() DISPLAY "veprmt006" AT 4,3 DISPLAY " Pesos y Medidas " at 6,25 MENU "OPCIONES" COMMAND "Adicionar" " Adiciona Registro Cancela Operacion" HELP 5 LET INT_FLAG = FALSE CLEAR FORM LET INT_FLAG = FALSE CALL vepcad006() COMMAND "Consultar-modificar" " Realiza Busqueda Cancela Operacion" HELP 6 CALL vepcmf006() COMMAND "Salir" "Retorna Menu Anterior" EXIT MENU END MENU END FUNCTION FUNCTION vepcad006() DEFINE fech_ant CHAR(8) # WHENEVER ERROR CONTINUE MESSAGE "" ## Captura los datos que va a contener el registro LET p_descrip = NULL INPUT BY NAME medidas.*,p_cod_prod ON KEY (CONTROL-W) CASE WHEN INFIELD (cod_n) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_n END IF IF NOT int_flag THEN LET medidas.cod_n = descuento.cod_n LET medidas.cod_grupo = descuento.cod_grupo LET medidas.cod_tipo = descuento.cod_tipo LET medidas.cod_sec = descuento.cod_sec DISPLAY medidas.cod_n TO cod_n DISPLAY medidas.cod_grupo TO cod_grupo DISPLAY medidas.cod_tipo TO cod_tipo DISPLAY medidas.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod TO NULL DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto END IF LET int_flag = FALSE WHEN INFIELD (cod_grupo) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_grupo END IF IF NOT int_flag THEN LET medidas.cod_n = descuento.cod_n LET medidas.cod_grupo = descuento.cod_grupo LET medidas.cod_tipo = descuento.cod_tipo LET medidas.cod_sec = descuento.cod_sec DISPLAY medidas.cod_n TO cod_n DISPLAY medidas.cod_grupo TO cod_grupo DISPLAY medidas.cod_tipo TO cod_tipo DISPLAY medidas.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod TO NULL DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto END IF LET int_flag = FALSE WHEN INFIELD (cod_tipo) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_tipo END IF IF NOT int_flag THEN LET medidas.cod_n = descuento.cod_n LET medidas.cod_grupo = descuento.cod_grupo LET medidas.cod_tipo = descuento.cod_tipo LET medidas.cod_sec = descuento.cod_sec DISPLAY medidas.cod_n TO cod_n DISPLAY medidas.cod_grupo TO cod_grupo DISPLAY medidas.cod_tipo TO cod_tipo DISPLAY medidas.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod TO NULL DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto END IF LET int_flag = FALSE WHEN INFIELD (cod_sec) CALL busca_pt() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) NEXT FIELD cod_sec END IF IF NOT int_flag THEN LET medidas.cod_n = descuento.cod_n LET medidas.cod_grupo = descuento.cod_grupo LET medidas.cod_tipo = descuento.cod_tipo LET medidas.cod_sec = descuento.cod_sec DISPLAY medidas.cod_n TO cod_n DISPLAY medidas.cod_grupo TO cod_grupo DISPLAY medidas.cod_tipo TO cod_tipo DISPLAY medidas.cod_sec TO cod_sec DISPLAY descrip1 TO descrip_esp SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod TO NULL DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF NEXT FIELD peso_bruto END IF LET int_flag = FALSE END CASE ## Verifica que el codigo no exista en el catalogo de medidas. Si existe, ## entonces despliega los datos del registro existente. AFTER FIELD cod_sec IF ( medidas.cod_n = 0 AND medidas.cod_grupo = 0 AND medidas.cod_tipo = 0 AND medidas.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n ELSE SELECT i.descrip_esp INTO descrip1 FROM iptb00002 i WHERE i.cod_n = medidas.cod_n AND i.cod_grupo = medidas.cod_grupo AND i.cod_tipo = medidas.cod_tipo AND i.cod_sec = medidas.cod_sec and i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INITIALIZE medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod TO NULL DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF AFTER FIELD peso_bruto IF medidas.peso_bruto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_bruto END IF AFTER FIELD peso_neto IF medidas.peso_neto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_neto END IF AFTER FIELD dim_caja IF medidas.dim_caja IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dim_caja END IF AFTER FIELD cantidad IF medidas.cantidad is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF AFTER FIELD p_cod_prod IF p_cod_prod IS NOT NULL THEN SELECT UNIQUE a.descripcion INTO p_descrip FROM cttb00001 a WHERE a.cod_prod = p_cod_prod and a.status_t is null IF status = notfound THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD p_cod_prod END IF DISPLAY BY NAME p_descrip END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF ( medidas.cod_n = 0 AND medidas.cod_grupo = 0 AND medidas.cod_tipo = 0 AND medidas.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n ELSE SELECT i.descrip_esp INTO descrip1 FROM iptb00002 i WHERE i.cod_n = medidas.cod_n AND i.cod_grupo = medidas.cod_grupo AND i.cod_tipo = medidas.cod_tipo AND i.cod_sec = medidas.cod_sec and i.status_t is null IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF SELECT * INTO medidas.* FROM vetb00014 WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec IF status >= 0 THEN IF status != NOTFOUND THEN IF medidas.status_t = "E" THEN LET numero_msg = 36 CALL msg(numero_msg) NEXT FIELD cod_n END IF DISPLAY BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.us_crea, medidas.fech_crea, medidas.us_mod, medidas.fech_mod LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_n END IF ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END IF IF medidas.peso_bruto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_bruto END IF IF medidas.peso_neto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_neto END IF IF medidas.dim_caja IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dim_caja END IF # Valida que el codigo del articulo no sea cero. Si no es cero, adiciona el # registro en la tabla, de lo contrario, presenta mensaje de error y acepta # el codigo de nuevo. IF ( medidas.cod_n = 0 AND medidas.cod_grupo = 0 AND medidas.cod_tipo = 0 AND medidas.cod_sec = 0 ) THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_n ELSE INSERT INTO vetb00014 VALUES (medidas.cod_n,medidas.cod_grupo, medidas.cod_tipo,medidas.cod_sec, medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja,medidas.cantidad, null,USER, CURRENT, null,null) INSERT INTO prtb00006 VALUES (p_cod_prod,medidas.cod_n, medidas.cod_grupo,medidas.cod_tipo, medidas.cod_sec,medidas.cantidad, 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. CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF LET numero_msg = 1 CALL msg(numero_msg) NEXT FIELD cod_n END IF AFTER FIELD fech_mod EXIT INPUT END INPUT END FUNCTION FUNCTION vepcmf006() ## Aqui se prepara para la captura del criterio de seleccion MESSAGE "" CLEAR FORM CONSTRUCT BY NAME criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = "SELECT UNIQUE a.*,b.cod_prod FROM vetb00014 a, ", "OUTER prtb00006 b ", "WHERE a.status_t is null AND ",criterio clipped, " and 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 ", " 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 medidas.*,p_cod_prod 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 DISPLAY BY NAME medidas.*,p_cod_prod CALL busca_articulo() CALL busca_prod() MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO medidas.*,p_cod_prod IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF DISPLAY BY NAME medidas.* ,p_cod_prod CALL busca_articulo() CALL busca_prod() COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO medidas.*,p_cod_prod IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF DISPLAY BY NAME medidas.* ,p_cod_prod CALL busca_articulo() CALL busca_prod() COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO medidas.*,p_cod_prod DISPLAY BY NAME medidas.* ,p_cod_prod CALL busca_articulo() CALL busca_prod() LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO medidas.*,p_cod_prod DISPLAY BY NAME medidas.* ,p_cod_prod CALL busca_articulo() CALL busca_prod() LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" LET p_descrip = NULL INPUT BY NAME medidas.peso_bruto, medidas.peso_neto, medidas.dim_caja, medidas.cantidad, p_cod_prod WITHOUT DEFAULTS AFTER FIELD peso_bruto IF medidas.peso_bruto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_bruto END IF AFTER FIELD peso_neto IF medidas.peso_neto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_neto END IF AFTER FIELD dim_caja IF medidas.dim_caja IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dim_caja END IF AFTER FIELD cantidad IF medidas.cantidad is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF AFTER FIELD p_cod_prod IF p_cod_prod IS NOT NULL THEN SELECT UNIQUE a.descripcion INTO p_descrip FROM cttb00001 a WHERE a.cod_prod = p_cod_prod and a.status_t is null IF status = notfound THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD p_cod_prod END IF DISPLAY BY NAME p_descrip END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF IF medidas.peso_bruto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_bruto END IF IF medidas.peso_neto IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD peso_neto END IF IF medidas.dim_caja IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD dim_caja END IF UPDATE vetb00014 SET peso_bruto = medidas.peso_bruto, peso_neto = medidas.peso_neto, dim_caja = medidas.dim_caja, cantidad = medidas.cantidad, us_mod = USER, fech_mod = CURRENT WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF DELETE FROM prtb00006 WHERE @cod_prod = p_cod_prod SELECT us_crea,fech_crea INTO usuario,creacion FROM prtb00006 WHERE cod_prod = p_cod_prod INSERT INTO prtb00006 VALUES (p_cod_prod,medidas.cod_n, medidas.cod_grupo,medidas.cod_tipo, medidas.cod_sec,medidas.cantidad, null,usuario,creacion,user,current) LET numero_msg = 13 CALL msg(numero_msg) EXIT INPUT END INPUT COMMAND KEY ("L") "eLiminar" "Elimina registro que esta en la pantalla" UPDATE vetb00014 SET status_t = "E" WHERE cod_n = medidas.cod_n AND cod_grupo = medidas.cod_grupo AND cod_tipo = medidas.cod_tipo AND cod_sec = medidas.cod_sec LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM CALL ayuda() EXIT MENU END MENU END FUNCTION FUNCTION busca_articulo() # Esta funcion busca el nombre del articulo y lo despliega en pantalla # Esta funcion es valida solamente para la consulta-modificacion. SELECT i.descrip_esp INTO descrip1 FROM iptb00002 i WHERE i.cod_n = medidas.cod_n AND i.cod_grupo = medidas.cod_grupo AND i.cod_tipo = medidas.cod_tipo AND i.cod_sec = medidas.cod_sec IF status >= 0 THEN IF status = NOTFOUND THEN LET numero_msg = 26 CALL msg(numero_msg) ELSE IF medidas.status_t = "E" THEN LET numero_msg = 44 CALL msg(numero_msg) END IF END IF DISPLAY descrip1 TO descrip_esp ELSE CALL integridad() IF bandera = 1 THEN LET bandera = 0 RETURN END IF END IF END FUNCTION FUNCTION busca_prod() SELECT descripcion INTO p_descrip FROM cttb00001 WHERE cod_prod = p_cod_prod DISPLAY BY NAME p_descrip ATTRIBUTE(BOLD) END FUNCTION