{ ------------------------------------------------------------------ PROGRAMA : IPPRMT002 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla Maestra Productos PROGRAMADOR : Juan Fco. Soto FECHA REALIZACION : AGOSTO 1997 ASESOR : JOSE ALFREDO PAULINO ------------------------------------------------------------------ } GLOBALS "ipprgb000.4gl" DEFINE p_tipo_prod LIKE iptb00013.tipo_prod, descrip_medida,descrip_grupo CHAR(30), despiece CHAR(1), USUARIOS, CLAVE CHAR(50), pcodid INT, pmaterial,plabor,pgastos,pfactor DEC(12,4) DEFINE t_marca ARRAY [100] OF RECORD cod_marca LIKE iptb00019.marca, nombre LIKE iptb00019.nombre_marca END RECORD, descrip_tipo CHAR(40), pcodn,pcodgrupo,pcodtipo,pcodsec SMALLINT, descripcion CHAR(40) MAIN DEFER INTERRUPT CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CONNECT to "decomarmol" USER usuarios USING clave SELECT * INTO p_companias.* FROM companias CALL ipprmt002() END MAIN FUNCTION ipprmt002() CLEAR SCREEN OPTIONS FORM LINE 8, ERROR LINE 24, COMMENT LINE 23 OPEN FORM ipfmmt002 FROM "ipfmmt002_3" DISPLAY FORM ipfmmt002 DISPLAY "ipprmt002" AT 4,3 DISPLAY "Catalogo Productos" AT 6,32 MENU ON ACTION Adicionar CLEAR FORM LET INT_FLAG = FALSE INITIALIZE p_iptb02.* TO NULL LET tipo_p = "A" CALL ippcad002() ON ACTION consultar CLEAR FORM LET INT_FLAG = FALSE INITIALIZE p_iptb02.* TO NULL LET tipo_p = "C" CALL ippcmf002() ON ACTION Salir EXIT MENU END MENU END FUNCTION FUNCTION ippcad002() DEFINE fech_ant CHAR(8) # WHENEVER ERROR CONTINUE ## Captura los datos que va a contener el registro IF tipo_p = "A" THEN INPUT BY NAME p_iptb02.*, pcodsec AFTER FIELD cod_cia IF p_iptb02.cod_cia is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_cia END IF IF p_iptb02.cod_cia = 1 THEN LET nombre_cia = "PRODUCTO LOCAL" ELSE LET nombre_cia = "PRODUCTO IMPORTADO" END IF DISPLAY BY NAME nombre_cia SELECT UNIQUE a.descrip_esp FROM tmpiptb00002 a WHERE a.cod_n = p_iptb02.cod_n AND a.cod_grupo = p_iptb02.cod_grupo AND a.cod_tipo = p_iptb02.cod_tipo AND a.cod_sec = p_iptb02.cod_sec IF STATUS != NOTFOUND THEN LET numero_msg = 12 CALL msg(numero_msg) NEXT FIELD cod_tipo END IF AFTER INPUT IF INT_FLAG THEN LET numero_msg = 2 CALL msg(numero_msg) LET INT_FLAG = FALSE RETURN END IF IF p_iptb02.cod_cia IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_cia END IF IF p_iptb02.cod_sec IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_sec END IF END INPUT ELSE INPUT BY NAME p_iptb02.cod_cia,p_iptb02.cod_sec, p_iptb02.descrip_esp,p_iptb02.unidad_med,p_iptb02.bodega, p_iptb02.exist_max,p_iptb02.exist_min, p_iptb02.status_t,p_iptb06.cantidad_2,p_iptb02.control_itbis, p_iptb02.control_existencia WITHOUT DEFAULTS AFTER FIELD cod_cia IF p_iptb02.cod_cia is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_cia END IF IF p_iptb02.cod_cia = 1 THEN LET nombre_cia = "PRODUCTO LOCAL" ELSE LET nombre_cia = "PRODUCTO IMPORTADO" END IF DISPLAY BY NAME nombre_cia AFTER FIELD descrip_esp IF p_iptb02.descrip_esp is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD descrip_esp END IF AFTER FIELD unidad_med IF p_iptb02.descrip_esp is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD descrip_esp END IF AFTER FIELD bodega IF p_iptb02.bodega is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD bodega END IF AFTER FIELD exist_max IF p_iptb02.exist_max is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD exist_max END IF AFTER FIELD exist_min IF p_iptb02.exist_min is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD exist_min END IF AFTER INPUT IF INT_FLAG THEN LET numero_msg = 2 CALL msg(numero_msg) LET INT_FLAG = FALSE RETURN END IF IF p_iptb02.cod_cia is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_cia END IF IF p_iptb02.descrip_esp is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD descrip_esp END IF IF p_iptb02.descrip_esp is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD descrip_esp END IF IF p_iptb02.bodega is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD bodega END IF IF p_iptb02.exist_max is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD exist_max END IF IF p_iptb02.exist_min is null THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD exist_min END IF END INPUT END IF END FUNCTION FUNCTION ippcmf002() #WHENEVER ERROR CONTINUE CLEAR FORM ## Aqui se prepara para la captura del criterio de seleccion CONSTRUCT criterio ON a.cod_cia,a.cod_sec, a.descrip_esp FROM cod_cia,cod_sec,descrip_esp IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET SELEC = "SELECT UNIQUE a.* FROM iptb00036 a ", "WHERE ",criterio clipped, " ORDER BY a.cod_Sec" PREPARE busca FROM selec DECLARE datos SCROLL CURSOR WITH HOLD FOR busca OPEN datos FETCH FIRST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor CALL despl1() IF STATUS = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor IF STATUS = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF CALL despl1() COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor IF STATUS = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF CALL despl1() COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor CALL despl1() LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO p_iptb02.*,pcodid,pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor CALL despl1() LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Escoger" " Actualiza Registro Cancela Operacion" CALL ippcad002() COMMAND KEY ("T") "acTivar" UPDATE tmpiptb00002 SET status_t = null,us_mod = user,fech_mod = GETDATE() WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND @cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec LET numero_msg = 13 CALL msg(numero_msg) COMMAND KEY ("L") "eLiminar" UPDATE tmpiptb00002 SET status_t = "E",us_mod = usuarios, fech_mod = GETDATE() WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND @cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec { UPDATE iptb00006 SET status_t = "E", us_mod = user, fech_mod = GETDATE() WHERE @cod_n = p_iptb02.cod_n AND @cod_grupo = p_iptb02.cod_grupo AND @cod_tipo = p_iptb02.cod_tipo AND @cod_sec = p_iptb02.cod_sec } LET numero_msg = 39 CALL msg(numero_msg) COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION FUNCTION busca_prod() OPEN WINDOW producto AT 12,3 WITH FORM "ipfmwd006" ATTRIBUTE(BORDER,CYAN, FORM LINE FIRST +1) DECLARE busca11 CURSOR FOR SELECT a.* FROM iptb00020 a ORDER BY 2 LET idx = 1 FOREACH busca11 INTO t_marca[idx].* LET idx = idx + 1 END FOREACH IF idx = 1 THEN LET numero_msg = 3 CALL msg(numero_msg) SLEEP 4 END IF CALL set_count(idx-1) DISPLAY ARRAY t_marca TO s_pilas.* LET idx = arr_curr() LET p_iptb20.cod_n = t_marca[idx].cod_marca LET p_iptb20.producto = t_marca[idx].nombre CLOSE WINDOW producto END FUNCTION FUNCTION despl1() LET p_iptb06.cantidad_2 = 0 SELECT SUM(a.cantidad_2) INTO p_iptb06.cantidad_2 FROM iptb00006 a WHERE a.cod_n=p_iptb02.cod_n and a.cod_grupo=p_iptb02.cod_grupo and a.cod_tipo=p_iptb02.cod_tipo and a.cod_sec=p_iptb02.cod_sec AND a.status_t IS NULL IF p_iptb06.cantidad_2 IS NULL THEN LET p_iptb06.cantidad_2 = 0 END IF LET p_iptb20.producto = NULL SELECT UNIQUE a.descripcion INTO p_iptb20.producto FROM tmpclase a WHERE a.cod_n = p_iptb02.cod_n LET p_iptb21.nombre_cia = NULL SELECT UNIQUE a.nombre_cia INTO p_iptb21.nombre_cia FROM iptb00021 a WHERE a.cod_cia = p_iptb02.cod_cia SELECT UNIQUE a.cod_n FROM tmpiptb00027 a WHERE a.cod_n=p_iptb02.cod_n and a.cod_grupo=p_iptb02.cod_grupo and a.cod_tipo=p_iptb02.cod_tipo and a.cod_sec=p_iptb02.cod_sec IF STATUS != NOTFOUND THEN LET despiece = "S" ELSE LET despiece = "N" END IF LET descrip_tipo = null SELECT UNIQUE a.descripcion INTO descrip_tipo FROM tmptipo a WHERE a.cod_tipo = p_iptb02.cod_tipo SELECT a.descripcion INTO descrip_grupo FROM tmpgrupo a WHERE a.cod_grupo = p_iptb02.cod_grupo SELECT a.descripcion INTO descrip_medida FROM tmpmedida a WHERE a.cod_sec = p_iptb02.cod_sec LET selec = "SELECT a.descrip_esp ", " FROM historicoMTECH.dbo.iptb00002 a ", " WHERE a.cod_n = ? AND ", " a.cod_grupo = ? AND ", " a.cod_tipo = ? AND ", " a.cod_Sec = ? " PREPARE cmdi2ptb02 FROM selec EXECUTE cmdi2ptb02 INTO descripcion USING pcodn,pcodgrupo,pcodtipo,pcodsec DISPLAY BY NAME p_iptb02.*,p_iptb21.nombre_cia,p_iptb06.cantidad_2, p_iptb20.producto,despiece,descrip_tipo,descrip_grupo, descrip_medida,descripcion, pcodn,pcodgrupo,pcodtipo,pcodsec, pmaterial,plabor,pgastos,pfactor END FUNCTION