{ ------------------------------------------------------------------------- PROGRAMA : COPRMT009 OBJETIVO : Capturar, Modificar, Eliminar registros de la Tabla de Ordenes de Compras PROGRAMADOR : JUAN SOTO FECHA REALIZACION : AGOSTO 1997 �LTIMA MODIFICACION : 20/01/2025 -------------------------------------------------------------------------- } GLOBALS "coprgb000.4gl" #file:///E:/marmotechc/imagenes/genero_logo.png DEFINE c_i_d, c_i_d1, nota, nota1 CHAR(30) DEFINE simb_mon, opt1, proce CHAR(4) DEFINE nom_via CHAR(10), zuso_req, xnota, knombre_cliente VARCHAR(100), xuso_requisicion, xdetalle_orden STRING, korden, ktipo_cliente, ksec_cliente INT DEFINE opc1, salir CHAR(3) DEFINE cod_mon, control_item, xnum_req INTEGER, pdescripcion CHAR(180), chmensaje STRING, fallo BOOLEAN DEFINE j1, k1 INTEGER DEFINE num_reg SMALLINT DEFINE requisiciones DYNAMIC ARRAY OF RECORD num_req LIKE cotb00006.num_req, fecha DATE, num_emp LIKE adtb00003.num_emp, nombre LIKE adtb00003.nom1_emp, APELLIDO LIKE adtb00003.apell1_emp END RECORD, itbis DEC(12, 2), moneda VARCHAR(20), xtipo_orden VARCHAR(20) DEFINE busca_parcial DYNAMIC ARRAY OF RECORD secuencia INT, cod_n SMALLINT, cod_grupo SMALLINT, cod_tipo SMALLINT, cod_sec SMALLINT, cantidad DEC(12, 5), fech_emb DATE, fech_ent DATE END RECORD DEFINE flag BOOLEAN, depa, cont INT DEFINE suplidor RECORD LIKE cotb00001.* DEFINE tabla STRING, anio STRING, fecha DATETIME YEAR TO FRACTION DEFINE nullcontainer STRING, precio DECIMAL(12, 2) MAIN DEFER INTERRUPT CALL STARTLOG("COPRMT09.TXT") CALL ARG_VAL(1) RETURNING usuarios CALL ARG_VAL(2) RETURNING clave CALL ARG_VAL(3) RETURNING impresor CONNECT TO "smarmotech" AS "MSSQL" USER usuarios USING clave SELECT a.* INTO p_companias.* FROM companias a SELECT a.itbi INTO itbis FROM vetb00019 a WHERE a.disponible = 'S' CALL coprmt009() END MAIN FUNCTION coprmt009() #WHENEVER ERROR CONTINUE CLEAR SCREEN OPTIONS FORM LINE 8, ERROR LINE 24, COMMENT LINE 22, PROMPT LINE 23, MESSAGE LINE 21 OPEN FORM cofmmt009 FROM "cofmmt009" DISPLAY FORM cofmmt009 SELECT dia INTO dia_aduana FROM cotb00028 MENU ON ACTION nuevo CLEAR FORM SET CONNECTION "MSSQL" LET opc = "S" LET existe = NULL LET int_flag = FALSE CALL copcad009() ON ACTION buscar CLEAR FORM SET CONNECTION "MSSQL" LET existe = NULL LET int_flag = FALSE CALL copcmf009() ON ACTION salir EXIT MENU END MENU END FUNCTION FUNCTION copcad009() #WHENEVER ERROR CONTINUE CLEAR FORM INITIALIZE ordenes.* TO NULL CALL lugarentregas() INITIALIZE xuso_requisicion, depa TO NULL LET ordenes.enviada = "N" LET ordenes.cierre = "N" LET ordenes.pago = "N" LET desc1 = NULL LET desc2 = NULL LET desc3 = NULL LET desc4 = NULL LABEL incorrecta: # Captura las informaciones generales de la orden de compras CALL arr_ordenes.clear() LABEL atras: -- ordenes.bodega no se incluye: es un combo oculto (tabIndex=-1) en -- cofmmt009 y "ordenes.*" fallaba con "Field (bodega) not found in form". INPUT BY NAME ordenes.num_oc, ordenes.tipo, ordenes.fech_oc, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, salida WITHOUT DEFAULTS BEFORE INPUT LET salida = "SVG" LET ordenes.fech_oc = TODAY DISPLAY BY NAME ordenes.fech_oc NEXT FIELD tipo ON ACTION suplidor LET identifica = "O" CALL busca_sup1() LET int_flag = FALSE IF existe = "N" THEN LET numero_msg = 3 CALL msg(numero_msg) LET existe = NULL NEXT FIELD cod_sp END IF DISPLAY BY NAME ordenes.cod_sp, ordenes.cod_sp_sec, suplidor.nom_sp LET identifica = NULL NEXT FIELD cod_sp AFTER FIELD tipo # Chequeo del numero del documento si el usuario elige numeracion manual IF ordenes.tipo IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD tipo END IF BEFORE FIELD term_sp CALL busca_terminos() BEFORE FIELD tipo CALL tipoorden() BEFORE FIELD cod_pt CALL busca_puertos() BEFORE FIELD cod_mon CALL busca_monedas() BEFORE FIELD via CALL fvia() AFTER FIELD cod_pt LET puertos.cod_pt = 0 IF ordenes.cod_pt IS NOT NULL THEN SELECT a.duracion INTO puertos.duracion FROM cotb00019 a WHERE a.cod_pt = ordenes.cod_pt END IF AFTER FIELD fech_oc IF ordenes.fech_oc IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD fech_oc END IF ### AQUI CONTROLA LA FECHA DEL DOCUMENTO { LET p_fechas = ordenes.fech_oc CALL prd() IF bandera = 1 THEN LET bandera = 0 NEXT FIELD fech_oc END IF } AFTER FIELD cod_sp IF ordenes.cod_sp IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_sp END IF AFTER FIELD cod_sp_sec # Chequeo del suplidor para el desplegue del nombre IF ordenes.cod_sp_sec IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_sp_sec ELSE SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais, b.nom_pais INTO suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais, paises.nom_pais FROM cotb00001 a LEFT OUTER JOIN cotb00018 b ON a.cod_pais = b.cod_pais WHERE a.cod_sp = ordenes.cod_sp AND a.cod_sp_sec = ordenes.cod_sp_sec 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_sp END IF END IF DISPLAY BY NAME suplidor.nom_sp, paises.nom_pais IF suplidor.cod_pais IS NULL THEN CALL fgl_winmessage( "ERROR", "PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA", "INFO") NEXT FIELD cod_sp END IF END IF AFTER FIELD fech_enviada IF ordenes.fech_enviada IS NOT NULL THEN IF ordenes.fech_enviada < ordenes.fech_oc THEN LET numero_msg = 364 CALL msg(numero_msg) # NEXT FIELD fech_enviada END IF END IF AFTER FIELD fech_pago IF ordenes.fech_pago IS NOT NULL THEN IF ordenes.fech_pago < ordenes.fech_oc THEN LET numero_msg = 364 CALL msg(numero_msg) # NEXT FIELD fech_pago END IF END IF AFTER INPUT IF int_flag THEN CALL msg(2) LET int_flag = FALSE RETURN END IF SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais INTO suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais FROM cotb00001 a WHERE a.cod_sp = ordenes.cod_sp AND a.cod_sp_sec = ordenes.cod_sp_sec AND a.status_t IS NULL IF suplidor.cod_pais IS NULL THEN CALL fgl_winmessage( "ERROR", "PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA", "INFO") NEXT FIELD cod_sp END IF IF cod_mon IS NULL THEN NEXT FIELD cod_mon END IF # DESCRIPCION MONEDA SELECT a.descrip_mon INTO moneda FROM cotb00031 a WHERE a.cod_mon = cod_mon IF ordenes.tipo IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD tipo END IF END INPUT # Captura de los articulos requeridos LET salir = NULL IF ordenes.cod_sp = 23 THEN LET control_item = 16 ELSE LET control_item = 14 END IF IF opc = "S" THEN CALL arr_ordenes.clear() END IF LET opc = "N" INPUT ARRAY arr_ordenes WITHOUT DEFAULTS FROM consart.* ON ACTION requisicion IF INFIELD(num_req) THEN LET curr = arr_curr() LET scr_l = scr_line() DISPLAY " tipo ", ordenes.tipo CALL busca_requi( arr_ordenes[curr].num_req, ordenes.tipo, arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_Sec, arr_ordenes) RETURNING arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_sec, arr_ordenes[curr].descripcion, arr_ordenes[curr].unidad, arr_ordenes[curr].cantidad, arr_ordenes[curr].precio, m_articulos.dia_llegada, arr_ordenes[curr].num_orden DISPLAY arr_ordenes[curr].cod_n DISPLAY arr_ordenes[curr].cod_grupo DISPLAY arr_ordenes[curr].cod_tipo DISPLAY arr_ordenes[curr].cod_sec DISPLAY arr_ordenes[curr].descripcion DISPLAY arr_ordenes[curr].unidad DISPLAY arr_ordenes[curr].cantidad DISPLAY arr_ordenes[curr].precio DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_Sec DISPLAY arr_ordenes[curr].descripcion TO consart[scr_l].descripcion DISPLAY arr_ordenes[curr].unidad TO consart[scr_l].unidad DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio IF INT_FLAG THEN LET INT_FLAG = FALSE END IF DISPLAY arr_ordenes[curr].num_req TO consart[scr_l].num_req END IF ON ACTION parciales IF arr_ordenes[arr_curr()].cantidad IS NOT NULL THEN LET m_articulos.cod_n = arr_ordenes[arr_curr()].cod_n LET m_articulos.cod_grupo = arr_ordenes[arr_curr()].cod_grupo LET m_articulos.cod_tipo = arr_ordenes[arr_curr()].cod_tipo LET m_articulos.cod_sec = arr_ordenes[arr_curr()].cod_sec CALL parcial( ordenes.fech_oc, puertos.duracion, ordenes.num_oc, ordenes.tipo, m_articulos.cod_n, m_articulos.cod_grupo, m_articulos.cod_tipo, m_articulos.cod_sec, arr_ordenes[arr_curr()].num_req, arr_ordenes[arr_curr()].cantidad) RETURNING busca_parcial END IF BEFORE ROW LET curr = arr_curr() LET scr_l = scr_line() AFTER FIELD num_req LET curr = arr_curr() IF arr_ordenes[curr].num_req IS NOT NULL THEN LET requi = arr_ordenes[curr].num_req LET zuso_req = NULL SELECT UNIQUE a.procesada, b.uso, b.depto_destino INTO proce, zuso_req, depa FROM cotb00008 a, cotb00006 b WHERE a.num_req = arr_ordenes[curr].num_req AND a.num_req = b.num_req AND a.procesada = "N" IF status = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD num_req END IF LET xuso_requisicion = zuso_req CLIPPED # Antepone el departamento DESTINO (al que se carga el gasto), # tomado de cotb00006.depto_destino, en lugar del departamento # que hizo la requisicion. INITIALIZE zuso_req TO NULL PREPARE query FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL" EXECUTE query USING depa INTO zuso_req IF zuso_req IS NOT NULL AND zuso_req CLIPPED != "" THEN LET xuso_requisicion = "(", zuso_req CLIPPED, ") ", xuso_requisicion CLIPPED END IF CALL busca_requi( arr_ordenes[curr].num_req, ordenes.tipo, arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_Sec, arr_ordenes) RETURNING arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_sec, arr_ordenes[curr].descripcion, arr_ordenes[curr].unidad, arr_ordenes[curr].cantidad, arr_ordenes[curr].precio, m_articulos.dia_llegada, arr_ordenes[curr].num_orden DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_Sec DISPLAY arr_ordenes[curr].descripcion TO consart[scr_l].descripcion DISPLAY arr_ordenes[curr].unidad TO consart[scr_l].unidad DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio IF INT_FLAG THEN LET INT_FLAG = FALSE END IF NEXT FIELD cantidad END IF AFTER FIELD tipo_Costo IF arr_ordenes[curr].tipo_costo IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD tipo_costo END IF AFTER FIELD precio LET arr_ordenes[curr].valor = arr_ordenes[curr].cantidad * arr_ordenes[curr].precio IF arr_ordenes[curr].valor IS NULL OR arr_ordenes[curr].valor = 0 THEN LET numero_msg = 207 CALL msg(numero_msg) NEXT FIELD cantidad END IF DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor ATTRIBUTE(CYAN) AFTER FIELD porc_Desc IF arr_ordenes[curr].porc_desc IS NOT NULL THEN LET arr_ordenes[curr].monto_desc = (arr_ordenes[curr].cantidad * arr_ordenes[curr].precio) * (arr_ordenes[curr].porc_desc / 100) DISPLAY arr_ordenes[curr].monto_desc TO consart[scr_l].monto_desc LET arr_ordenes[curr].valor = arr_ordenes[curr].valor - arr_ordenes[curr].monto_desc DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF FOR idx = 1 TO arr_ordenes.getLength() IF arr_ordenes[idx].porc_desc IS NOT NULL THEN LET arr_ordenes[idx].monto_desc = (arr_ordenes[idx].cantidad * arr_ordenes[idx].precio) * (arr_ordenes[idx].porc_desc / 100) DISPLAY arr_ordenes[idx].monto_desc TO consart[scr_line()].monto_desc LET arr_ordenes[idx].valor = arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc DISPLAY arr_ordenes[idx].valor TO consart[scr_line()].valor END IF # CONTROL REPETICION DE CODIGOS DE LOS ITEMS: NO SE PUEDE ACTIVAR CONTROL QUE NO SE REPITAN ITEM, # UNA REQUISICION DE COMPRAS PUEDE TENER UN ITEM, QUE OTRA REQUISICION TAMBIEN LO TENGA #IF arr_ordenes[idx].cod_sec IS NOT NULL THEN # CALL repite3() #END IF END FOR END INPUT LET valor_total = 0 LET flete1.ot_valor = 0 LET flete1.valor = 0 LET flete1.total_b = 0 LET flete1.descu_valor = 0 FOR idx = 1 TO arr_ordenes.getLength() IF arr_ordenes[idx].valor IS NOT NULL THEN LET arr_ordenes[idx].valor = arr_ordenes[idx].cantidad * arr_ordenes[idx].precio LET arr_ordenes[idx].monto_desc = 0 IF arr_ordenes[idx].porc_desc IS NOT NULL THEN LET arr_ordenes[idx].monto_desc = arr_ordenes[idx].valor * (arr_ordenes[idx].porc_desc / 100) LET flete1.descu_valor = flete1.descu_valor + arr_ordenes[idx].monto_desc END IF LET flete1.total_b = (arr_ordenes[idx].cantidad * arr_ordenes[idx].precio) + flete1.total_b LET valor_total = valor_total + arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc END IF END FOR # El ITBIS solo aplica a proveedores locales. En internacionales (tipo # 22/24) no hay ITBIS: el campo flete1.valor se usa como FLETE y se captura # en la ventana de notas (etiquetado FREIGH). IF NOT es_internacional() THEN LET opc1 = fgl_winquestion( "ITBIS", "DESEA INCLUIR ITBIS?", "YES", "YES|NO", "QUESTION", 0) IF opc1 = "YES" THEN LET flete1.valor = valor_total * (itbis / 100) END IF ELSE LET flete1.valor = 0 END IF LET programa = 9 LET int_flag = FALSE CALL notas20() LET opc = "N" LABEL prob: LET opc = fgl_winquestion( "INFORMACION", "TODA LA INFORMACION ESTA CORRECTA?", "YES", "YES|NO", "QUESTION", 0) LET opc = UPSHIFT(opc) IF (opc IS NULL) OR (opc != "YES" AND opc != "NO") THEN GOTO prob END IF IF opc = "NO" THEN GOTO incorrecta END IF LET fallo = FALSE WHENEVER ERROR STOP IF opc = "YES" THEN SELECT MAX(a.num_oc) INTO ordenes.num_oc FROM cotb00014 a IF ordenes.num_oc IS NULL THEN LET ordenes.num_oc = 0 END IF LET ordenes.num_oc = ordenes.num_oc + 1 LET numero_orden = ordenes.num_oc DISPLAY BY NAME ordenes.num_oc DISPLAY BY NAME ordenes.num_oc LET ordenes.num_oc = numero_orden # Asegura BRUTO/DESCUENTO/NETO consistentes antes de grabar CALL recalcula_totales() BEGIN WORK UPDATE cotb00030 SET num_oc = numero_orden, us_mod = SUSER_SNAME(), fech_mod = GETDATE() INSERT INTO cotb00014( num_oc, tipo, fech_oc, num_pr, cod_sp, cod_sp_Sec, term_sp, via, fech_enviada, pago, fech_pago, cierre, cod_pt, total_bruto, c_flete, otros_g, descuento, neto, detalle, us_crea, fech_crea, bodega) VALUES(ordenes.num_oc, ordenes.tipo, ordenes.fech_oc, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, flete1.total_b, flete1.valor, flete1.ot_valor, flete1.descu_valor, flete1.total_1, nota, usuarios, GETDATE(), ordenes.bodega) DELETE FROM cotb00029 WHERE num_oc = ordenes.num_oc INSERT INTO cotb00029 VALUES(ordenes.num_oc, ordenes.tipo, ordenes.cod_sp, ordenes.cod_sp_sec, notas.ship_to, notas.n_a_b, notas.c_i_d, c_i_d1, notas.nota, nota1, desc1, flete1.total_b, desc2, flete1.valor, desc5, flete1.descu_valor, desc3, flete1.ot_valor, desc4, NULL, usuarios, GETDATE(), NULL, NULL) LET xdetalle_orden = NULL LET flag = FALSE LET cont = 0 FOR idx = 1 TO arr_count() IF arr_ordenes[idx].cod_n IS NOT NULL AND arr_ordenes[idx].cod_n <> 0 THEN #ESTA PARTE DEL CODIGO ERA PARA MANDAR LOS SUPLIDORES A MAINTAINX AUTOMATICAMENTE #QUED� DESCARTADO EN LA REUNI�N DEL 12/12/24, NEGRIN Y OSCAR LO HAR�N MANUAL { INITIALIZE work_order TO NULL SELECT orden_trabajo INTO work_order FROM cotb00006 WHERE num_req = arr_ordenes[idx].num_req AND status_t IS NULL IF work_order IS NOT NULL THEN LET flag = TRUE END IF IF flag = TRUE AND cont = 0 THEN SELECT UNIQUE * INTO suplidor.* FROM cotb00001 WHERE cod_sp = ordenes.cod_sp AND cod_sp_sec = ordenes.cod_sp_sec LET work_order = NULL IF suplidor.id_maintainx IS NULL THEN CALL ApiMaintainC('POST', NULL, suplidor.*, usuarios) RETURNING answer, answer2 IF answer IS NULL OR answer = 0 THEN ROLLBACK WORK ELSE IF answer2 = 0 THEN INITIALIZE answer2 TO NULL END IF UPDATE cotb00001 SET id_maintainx = answer, contactID = answer2 WHERE cod_sp = suplidor.cod_sp AND cod_sp_sec = suplidor.cod_sp_sec LET cont = 1 END IF END IF END IF } IF arr_ordenes[idx].tipo_costo = 'EN PUERTO' THEN LET anio = YEAR(CURRENT) LET fecha = CURRENT YEAR TO FRACTION INITIALIZE nullcontainer, precio TO NULL #CALCULANDO COSTO IF arr_ordenes[idx].monto_desc IS NOT NULL THEN LET precio = arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc ELSE LET precio = arr_ordenes[idx].valor END IF DISPLAY "Valor: ", precio IF ordenes.tipo = '01' THEN #Materia prima LET tabla = 'intb00013' END IF IF ordenes.tipo = '02' THEN #Productos terminados LET tabla = 'iptb00004' END IF IF ordenes.tipo = '03' THEN #Repuesto LET tabla = 'irtb00013' END IF PREPARE checking FROM "SELECT * FROM " || tabla || " WHERE ano = YEAR(getdate()) and cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ?" EXECUTE checking USING arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec IF STATUS = NOTFOUND THEN IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN PREPARE insertar FROM "INSERT INTO " || tabla || " (mes_ini, mes_fin, ano, cod_n, cod_grupo, cod_tipo, cod_sec, costo_st, status_t, us_crea, fech_crea, us_mod, fech_mod) VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?)" ELSE PREPARE insertar FROM "INSERT INTO " || tabla || " (ventas, mes_ini, mes_fin, ano, cod_n, cod_grupo, cod_tipo, cod_sec, material, labor, gasto, status_t, us_crea, fech_crea, us_mod, fech_mod) VALUES(1,?,?,?,?,?,?,?,?,0,0,?,?,?,?,?)" END IF EXECUTE insertar USING '01', '12', anio, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, precio, nullcontainer, usuarios, fecha, nullcontainer, nullcontainer ELSE IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN PREPARE actualizar FROM "UPDATE " || tabla || " set costo_st = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())" ELSE PREPARE actualizar FROM "UPDATE " || tabla || " set material = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())" END IF EXECUTE actualizar USING precio, usuarios, fecha, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec END IF END IF INSERT INTO cotb00015 VALUES(ordenes.num_oc, arr_ordenes[idx].num_req, ordenes.tipo, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, NULL, arr_ordenes[idx].cantidad, arr_ordenes[idx].precio, arr_ordenes[idx].porc_desc, arr_ordenes[idx].monto_desc, cod_mon, NULL, SUSER_SNAME(), GETDATE(), NULL, NULL, arr_ordenes[idx].num_orden, arr_ordenes[idx].tipo_costo) IF STATUS < 0 THEN LET chmensaje = SQLERRMESSAGE CLIPPED, "NO ES POSIBLE GUARDAR LA TRANSACCION" ROLLBACK WORK LET fallo = TRUE CALL fgl_Winmessage("ERROR", chmensaje, "STOP") EXIT FOR END IF UPDATE cotb00006 SET estado = 'CERRADA', us_mod = usuarios, fech_mod = getdate() WHERE num_req = arr_ordenes[idx].num_req UPDATE cotb00008 SET procesada = 'S', us_mod = usuarios, fech_mod = getdate() WHERE num_req = arr_ordenes[idx].num_req AND cod_n = arr_ordenes[idx].cod_n AND cod_grupo = arr_ordenes[idx].cod_grupo AND cod_tipo = arr_ordenes[idx].cod_tipo AND COD_SEC = arr_ordenes[idx].cod_sec IF arr_ordenes[idx].num_orden IS NOT NULL THEN LET xdetalle_orden = arr_ordenes[idx].num_orden USING "<<<<<<", " ", ktipo_cliente USING "<<", "-", ksec_cliente USING "<<<<<<<", " ", knombre_cliente CLIPPED, "; ", xdetalle_orden CLIPPED END IF END IF END FOR # ENTREGAS PARCIALES FOR idx = 1 TO busca_parcial.getLength() IF busca_parcial[idx].cantidad IS NOT NULL THEN { INSERT INTO cotb00037 VALUES (ordenes.num_oc,ordenes.tipo,ch_cod,NULL, busca_parcial[idx].fech_emb,busca_parcial[idx].fech_emb, busca_parcial[idx].cod_n, busca_parcial[idx].cod_grupo,busca_parcial[idx].cod_tipo, busca_parcial[idx].cod_sec,busca_parcial[idx].cantidad, NULL,SUSER_SNAME(),GETDATE(),NULL,NULL) } INSERT INTO cotb00025( num_oc, tipo, num_req, cod_n, cod_grupo, cod_tipo, cod_sec, fech_ent, cantidad, us_crea, fech_crea, fech_emb, fecha_a, secuencia) VALUES(ordenes.num_oc, ordenes.tipo, requi, busca_parcial[idx].cod_n, busca_parcial[idx].cod_grupo, busca_parcial[idx].cod_tipo, busca_parcial[idx].cod_sec, busca_parcial[idx].fech_ent, busca_parcial[idx].cantidad, SUSER_SNAME(), GETDATE(), busca_parcial[idx].fech_emb, busca_parcial[idx].fech_ent, busca_parcial[idx].secuencia) END IF END FOR COMMIT WORK CALL recalcula_totales() DISPLAY "ANTES DE LLAMAR LA ORDEN" DISPLAY "flete1.total_b: ", flete1.total_b DISPLAY "flete1.ot_valor: ", flete1.ot_valor DISPLAY "flete1.valor: ", flete1.valor DISPLAY "flete1.total_1", flete1.total_1 LET opt1 = fgl_winquestion( "Atencion", "Desea Imprimir la orden?", "cancel", "YES|NO|", "question", 0) IF opt1 = "YES" THEN CALL orden( flete1.*, arr_ordenes, ordenes.*, suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, paises.*, notas.ship_to, moneda, salida, xnota, desc1, desc2, desc3, desc4, desc5, xdetalle_orden, xuso_requisicion) END IF CALL fgl_winmessage("MENSAJE", "ADICION EXITOSA", "STOP") END IF # INSERTA INFORMACION EN INFORMIX { SET CONNECTION "IFMX" INSERT INTO cotb00014 VALUES(ordenes.*,flete1.valor,flete1.ot_valor, null,null,usuarios,current,usuarios,current) FOR idx = 1 TO arr_count() IF arr_ordenes[idx].cod_n is not null and arr_ordenes[idx].cod_n <> 0 THEN INSERT INTO cotb00015 VALUES (ordenes.num_oc,arr_ordenes[idx].num_req, ordenes.tipo,arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, arr_ordenes[idx].cantidad, arr_ordenes[idx].precio, cod_mon,null,usuarios,current,null,null) END IF END FOR #------------------------------------------------------------------------------------------------------ } CALL busca_parte.clear() LET flete1.total_b = 0 LET flete1.ot_valor = 0 LET int_flag = FALSE END FUNCTION FUNCTION copcmf009() #WHENEVER ERROR CONTINUE DEFINE container STRING INITIALIZE xuso_requisicion, depa TO NULL CALL lugarentregas() # Aqui se prepara para la captura del criterio de seleccion -- cotb00014.bodega excluido: es el mismo combo oculto (tabIndex=-1) en -- cofmmt009 que ya se excluye en copcad009(); el CONSTRUCT fallaba con -- "Field (bodega) not found in form". CONSTRUCT criterio ON cotb00014.num_oc, cotb00014.tipo, cotb00014.fech_oc, cotb00014.num_pr, cotb00014.cod_sp, cotb00014.cod_sp_sec, cotb00014.term_sp, cotb00014.enviada, cotb00014.fech_enviada, cotb00014.pago, cotb00014.fech_pago, cotb00014.cierre FROM num_oc, tipo, fech_oc, num_pr, cod_sp, cod_sp_sec, term_sp, enviada, fech_enviada, pago, fech_pago, cierre IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET selec = " SELECT UNIQUE cotb00014.num_oc,cotb00014.tipo,cotb00014.num_pr, ", " cotb00014.cod_sp,cotb00014.cod_sp_sec,cotb00014.term_sp, ", " cotb00014.via,cotb00014.enviada,cotb00014.fech_enviada, ", " cotb00014.pago,cotb00014.fech_pago,cotb00014.cierre, ", " cotb00014.cod_pt,cotb00015.cod_mon,cotb00014.fech_oc, ", " cotb00014.c_flete,cotb00014.otros_g, cotb00014.bodega ", " FROM cotb00014,outer cotb00015 ", " WHERE cotb00014.num_oc = cotb00015.num_oc AND ", " cotb00014.tipo = cotb00015.tipo AND ", " cotb00014.status_t is null AND ", criterio CLIPPED, " ORDER BY cotb00014.num_oc" PREPARE busca FROM selec DECLARE datos SCROLL CURSOR FOR busca OPEN datos FETCH FIRST datos INTO ordenes.num_oc, ordenes.tipo, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, ordenes.fech_oc, flete1.valor, flete1.ot_valor, ordenes.bodega, korden, ktipo_cliente, ksec_cliente, knombre_cliente IF status = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) RETURN END IF # Funcion para la busqueda de lo suplidores, Terminos ded pago, # descripcion del puesto y la via CALL escoge() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF # Menu para la busqueda de las informaciones en forma direccional MENU "OPCIONES " COMMAND "Siguiente" "Presenta en pantalla el proximo registro encontrado" FETCH NEXT datos INTO ordenes.num_oc, ordenes.tipo, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, ordenes.fech_oc, flete1.valor, flete1.ot_valor, ordenes.bodega, korden, ktipo_cliente, ksec_cliente, knombre_cliente IF status = NOTFOUND THEN LET numero_msg = 4 CALL msg(numero_msg) END IF CALL escoge() COMMAND "Anterior" "Presenta en pantalla el registro anterior encontrado" FETCH PREVIOUS datos INTO ordenes.num_oc, ordenes.tipo, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, ordenes.fech_oc, flete1.valor, flete1.ot_valor, ordenes.bodega, korden, ktipo_cliente, ksec_cliente, knombre_cliente IF status = NOTFOUND THEN LET numero_msg = 5 CALL msg(numero_msg) END IF CALL escoge() COMMAND "Primero" "Presenta en pantalla el primer registro encontrado" FETCH FIRST datos INTO ordenes.num_oc, ordenes.tipo, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, ordenes.fech_oc, flete1.valor, flete1.ot_valor, ordenes.bodega, korden, ktipo_cliente, ksec_cliente, knombre_cliente CALL escoge() LET numero_msg = 5 CALL msg(numero_msg) COMMAND "Ultimo" "Presenta en pantalla el ultimo registro encontrado" FETCH LAST datos INTO ordenes.num_oc, ordenes.tipo, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, cod_mon, ordenes.fech_oc, flete1.valor, flete1.ot_valor, ordenes.bodega, korden, ktipo_cliente, ksec_cliente, knombre_cliente CALL escoge() LET numero_msg = 4 CALL msg(numero_msg) COMMAND "Imprime" # DESCRIPCION MONEDA INPUT BY NAME salida BEFORE INPUT LET salida = 'SCREEN' DISPLAY BY NAME salida AFTER INPUT IF salida IS NULL THEN CALL msg(16) NEXT FIELD salida END IF EXIT INPUT END INPUT SELECT a.descrip_mon INTO moneda FROM cotb00031 a WHERE a.cod_mon = cod_mon DECLARE items_ord CURSOR FOR SELECT a.num_req, a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_sec, a.cantidad, a.tipo_costo, a.precio, a.cantidad * a.precio, a.porc_desc, a.monto_desc, a.numero_orden FROM cotb00015 a WHERE a.num_oc = ordenes.num_oc LET idx = 1 SELECT a.descripcion INTO xtipo_orden FROM cotb00010 a WHERE a.tipo = ordenes.tipo FOREACH items_ord INTO arr_ordenes[idx].num_req, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, arr_ordenes[idx].cantidad, arr_ordenes[idx].tipo_costo, arr_ordenes[idx].precio, arr_ordenes[idx].valor, arr_ordenes[idx].porc_desc, arr_ordenes[idx].monto_desc, arr_ordenes[idx].num_orden LET requi = arr_ordenes[idx].num_req IF arr_ordenes[idx].monto_desc IS NOT NULL THEN LET arr_ordenes[idx].valor = arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc END IF CALL producto( xtipo_orden, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec) RETURNING arr_ordenes[idx].descripcion, arr_ordenes[idx].unidad IF xdetalle_orden IS NOT NULL THEN LET xdetalle_orden = arr_ordenes[idx].num_orden USING "<<<<<<", " ", ktipo_cliente USING "<<", "-", ksec_cliente USING "<<<<<<<", " ", knombre_cliente CLIPPED, "; ", xdetalle_orden CLIPPED END IF LET idx = idx + 1 END FOREACH DISPLAY ARRAY arr_ordenes TO consart.* AFTER DISPLAY SELECT ISNULL(a.nota, ' ') INTO xnota FROM cotb00029 a WHERE a.num_oc = ordenes.num_oc EXIT DISPLAY END DISPLAY DISPLAY "DATOS t1 ", flete1.total_1, " valor ", flete1.valor, " total_b ", flete1.total_b PREPARE query2 FROM "SELECT uso, depto_destino FROM cotb00006 WHERE num_req = ? AND status_t IS NULL" EXECUTE query2 USING requi INTO xuso_requisicion, depa # Antepone el departamento DESTINO (al que se carga el gasto), # tomado de cotb00006.depto_destino. LET container = NULL PREPARE query3 FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL" EXECUTE query3 USING depa INTO container IF container IS NOT NULL AND container CLIPPED != "" THEN LET xuso_requisicion = "(", container CLIPPED, ") ", xuso_requisicion CLIPPED END IF DISPLAY xuso_requisicion { IF flete1.total_1 = flete1.total_b + flete1.ot_valor THEN LET flete1.total_1 = flete1.total_b - flete1.ot_valor ELSE IF flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor THEN LET flete1.total_1 = flete1.total_b - flete1.ot_valor + flete1.valor END IF END IF } # ITBIS/flete (c_flete) y otros cargos (otros_g) se leen de la # maestra cotb00014 (fuente confiable); el BRUTO y el DESCUENTO se # recalculan desde los items y con ello el NETO. Esto corrige el # caso en que el NETO se imprimia en .00 al reimprimir. SELECT ISNULL(a.c_flete, 0), ISNULL(a.otros_g, 0) INTO flete1.valor, flete1.ot_valor FROM cotb00014 a WHERE a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo CALL recalcula_totales() # La reimpresion no pasa por notas20(); fijar aqui las etiquetas # (BRUTO/ITBIS/NETO vs FOB/FREIGH/C&F) segun el tipo de proveedor. CALL set_etiquetas() DISPLAY "ANTES DE LLAMAR LA ORDEN" DISPLAY "flete1.total_b: ", flete1.total_b DISPLAY "flete1.ot_valor: ", flete1.ot_valor DISPLAY "flete1.valor: ", flete1.valor DISPLAY "flete1.total_1", flete1.total_1 CALL orden( flete1.*, arr_ordenes, ordenes.*, suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, paises.*, notas.ship_to, moneda, salida, xnota, desc1, desc2, desc3, desc4, desc5, xdetalle_orden, xuso_requisicion) COMMAND "Escoger" " Continua Consultando Cancela Operacion" SELECT a.num_oc FROM cgtb00017 a WHERE a.num_oc = ordenes.num_oc AND a.status_t IS NULL IF STATUS <> NOTFOUND THEN CALL fgl_winmessage( "ERROR", "NO PUEDES MODIFICAR ORDEN, TIENE LIQUIDACION", "INFO") CONTINUE MENU END IF -- ordenes.bodega excluido (ver nota en copcad009()). INPUT BY NAME ordenes.num_oc, ordenes.tipo, ordenes.fech_oc, ordenes.num_pr, ordenes.cod_sp, ordenes.cod_sp_sec, ordenes.term_sp, ordenes.via, ordenes.enviada, ordenes.fech_enviada, ordenes.pago, ordenes.fech_pago, ordenes.cierre, ordenes.cod_pt, salida, cod_mon WITHOUT DEFAULTS ATTRIBUTE(YELLOW) BEFORE INPUT LET salida = "SVG" ON KEY(CONTROL-W) CASE # Control de ventana para la busqueda de los suplidores WHEN INFIELD(cod_sp) LET identifica = "O" CALL busca_sup1() LET int_flag = FALSE IF existe = "N" THEN LET numero_msg = 3 CALL msg(numero_msg) LET existe = NULL NEXT FIELD cod_sp END IF DISPLAY BY NAME ordenes.cod_sp, ordenes.cod_sp_sec, suplidor.nom_sp LET identifica = NULL NEXT FIELD cod_sp WHEN INFIELD(cod_sp_sec) LET identifica = "O" CALL busca_sup1() IF existe = "N" THEN LET numero_msg = 3 CALL msg(numero_msg) LET existe = NULL NEXT FIELD cod_sp END IF DISPLAY BY NAME ordenes.cod_sp, ordenes.cod_sp_sec, suplidor.nom_sp LET identifica = NULL NEXT FIELD cod_sp END CASE BEFORE FIELD num_oc NEXT FIELD tipo BEFORE FIELD term_sp CALL busca_terminos() BEFORE FIELD tipo CALL tipoorden() BEFORE FIELD cod_pt CALL busca_puertos() BEFORE FIELD cod_mon CALL busca_monedas() BEFORE FIELD via CALL fvia() AFTER FIELD tipo # Chequeo del numero del documento si el usuario elige numeracion manual IF ordenes.tipo IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD tipo END IF BEFORE FIELD fech_oc LET ordenes.fech_oc = TODAY USING "dd/mm/yyyy" DISPLAY BY NAME ordenes.fech_oc AFTER FIELD fech_oc IF ordenes.fech_oc IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD fech_oc END IF ### AQUI CONTROLA LA FECHA DEL DOCUMENTO IF ordenes.fech_oc < TODAY THEN LET numero_msg = 364 CALL msg(numero_msg) NEXT FIELD fech_oc END IF LET p_fechas = ordenes.fech_oc #CALL prd() IF bandera = 1 THEN LET bandera = 0 NEXT FIELD fech_oc END IF AFTER FIELD cod_sp IF ordenes.cod_sp IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_sp END IF AFTER FIELD cod_sp_sec # Chequeo del suplidor para el desplegue del nombre IF ordenes.cod_sp_sec IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cod_sp_sec ELSE SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais, b.nom_pais INTO suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais, paises.nom_pais FROM cotb00001 a LEFT OUTER JOIN cotb00018 b ON a.cod_pais = b.cod_pais WHERE a.cod_sp = ordenes.cod_sp AND a.cod_sp_sec = ordenes.cod_sp_sec 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_sp END IF END IF DISPLAY BY NAME suplidor.nom_sp, paises.nom_pais IF suplidor.cod_pais IS NULL THEN CALL fgl_winmessage( "ERROR", "PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA", "INFO") NEXT FIELD cod_sp END IF END IF AFTER FIELD fech_enviada IF ordenes.fech_enviada IS NOT NULL THEN IF ordenes.fech_enviada < ordenes.fech_oc THEN LET numero_msg = 364 CALL msg(numero_msg) # NEXT FIELD fech_enviada END IF END IF AFTER FIELD fech_pago IF ordenes.fech_pago IS NOT NULL THEN IF ordenes.fech_pago < ordenes.fech_oc THEN LET numero_msg = 364 CALL msg(numero_msg) # NEXT FIELD fech_pago END IF END IF AFTER INPUT IF INT_FLAG THEN CALL msg(2) LET INT_FLAG = FALSE RETURN END IF SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais INTO suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais FROM cotb00001 a WHERE a.cod_sp = ordenes.cod_sp AND a.cod_sp_sec = ordenes.cod_sp_sec AND a.status_t IS NULL IF suplidor.cod_pais IS NULL THEN CALL fgl_winmessage( "ERROR", "PROVEEDOR NO TIENE PAIS, FAVOR DE MODIFICAR EN MAESTRA", "INFO") NEXT FIELD cod_sp END IF IF cod_mon IS NULL THEN NEXT FIELD cod_mon END IF END INPUT SELECT a.descripcion INTO xtipo_orden FROM cotb00010 a WHERE a.tipo = ordenes.tipo CALL arr_ordenes.clear() DECLARE busca20 CURSOR FOR SELECT a.num_oc, a.num_req, a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_Sec, ' ', ' ', a.cantidad, a.tipo_costo, a.precio, a.porc_desc, a.monto_desc FROM cotb00015 a WHERE (a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo) AND a.status_t IS NULL ORDER BY a.cod_n, a.cod_grupo, a.cod_tipo, a.cod_Sec LET idx = 1 FOREACH busca20 INTO arr_ordenes[idx].* IF arr_ordenes[idx].cod_n IS NOT NULL THEN CALL producto( xtipo_orden, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec) RETURNING arr_ordenes[idx].descripcion, arr_ordenes[idx].unidad END IF LET arr_ordenes[idx].valor = (arr_ordenes[idx].cantidad * arr_ordenes[idx].precio) - arr_ordenes[idx].monto_desc LET idx = idx + 1 END FOREACH CALL set_count(idx - 1) INPUT ARRAY arr_ordenes WITHOUT DEFAULTS FROM consart.* ATTRIBUTE(YELLOW, INSERT ROW = FALSE, AUTO APPEND = FALSE) BEFORE ROW LET curr = arr_curr() LET scr_l = scr_line() CALL dialog.setFieldActive('numero_orden', FALSE) CALL dialog.setFieldActive('num_req', FALSE) CALL dialog.setFieldActive('cod_n', FALSE) CALL dialog.setFieldActive('cod_grupo', FALSE) CALL dialog.setFieldActive('cod_tipo', FALSE) CALL dialog.setFieldActive('cod_sec', FALSE) CALL dialog.setFieldActive('descripcion', FALSE) CALL dialog.setFieldActive('unidad', FALSE) CALL dialog.setFieldActive('cantidad', FALSE) CALL dialog.setFieldActive('precio', FALSE) CALL dialog.setFieldActive('porc_desc', FALSE) CALL dialog.setFieldActive('monto_desc', FALSE) CALL dialog.setFieldActive('valor', FALSE) CALL dialog.setFieldActive('numero_orden', FALSE) AFTER FIELD num_req LET curr = arr_curr() IF arr_ordenes[curr].num_req IS NOT NULL THEN LET requi = arr_ordenes[curr].num_req SELECT UNIQUE a.procesada INTO proce FROM cotb00008 a WHERE a.num_req = arr_ordenes[curr].num_req IF status = NOTFOUND THEN LET numero_msg = 3 CALL msg(numero_msg) NEXT FIELD num_req END IF CALL busca_requi( arr_ordenes[curr].num_req, ordenes.tipo, arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_Sec, arr_ordenes) RETURNING arr_ordenes[curr].cod_n, arr_ordenes[curr].cod_grupo, arr_ordenes[curr].cod_tipo, arr_ordenes[curr].cod_sec, arr_ordenes[curr].descripcion, arr_ordenes[curr].unidad, arr_ordenes[curr].cantidad, arr_ordenes[curr].precio, m_articulos.dia_llegada, arr_ordenes[curr].num_orden DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_Sec DISPLAY arr_ordenes[curr].descripcion TO consart[scr_l].descripcion DISPLAY arr_ordenes[curr].unidad TO consart[scr_l].unidad DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio NEXT FIELD cantidad END IF AFTER FIELD precio LET arr_ordenes[curr].valor = arr_ordenes[curr].cantidad * arr_ordenes[curr].precio IF arr_ordenes[curr].valor IS NULL OR arr_ordenes[curr].valor = 0 THEN LET numero_msg = 207 CALL msg(numero_msg) NEXT FIELD cantidad END IF DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor ATTRIBUTE(CYAN) AFTER FIELD porc_Desc IF arr_ordenes[curr].porc_desc IS NOT NULL THEN LET arr_ordenes[curr].monto_desc = (arr_ordenes[curr].cantidad * arr_ordenes[curr].precio) * (arr_ordenes[curr].porc_desc / 100) DISPLAY arr_ordenes[curr].monto_desc TO consart[scr_l].monto_desc LET arr_ordenes[curr].valor = arr_ordenes[curr].valor - arr_ordenes[curr].monto_desc DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor END IF AFTER INPUT IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF EXIT INPUT END INPUT LET valor_total = 0 LET flete1.ot_valor = 0 LET flete1.valor = 0 LET flete1.total_b = 0 LET flete1.descu_valor = 0 FOR idx = 1 TO arr_ordenes.getLength() IF arr_ordenes[idx].valor IS NOT NULL THEN LET arr_ordenes[idx].valor = arr_ordenes[idx].cantidad * arr_ordenes[idx].precio LET arr_ordenes[idx].monto_desc = 0 IF arr_ordenes[idx].porc_desc IS NOT NULL THEN LET arr_ordenes[idx].monto_desc = arr_ordenes[idx].valor * (arr_ordenes[idx].porc_desc / 100) LET flete1.descu_valor = flete1.descu_valor + arr_ordenes[idx].monto_desc END IF LET flete1.total_b = (arr_ordenes[idx].cantidad * arr_ordenes[idx].precio) + flete1.total_b LET valor_total = valor_total + arr_ordenes[idx].valor - arr_ordenes[idx].monto_desc END IF # CONTROL REPETICION DE CODIGOS DE LOS ITEMS IF arr_ordenes[idx].cod_sec IS NOT NULL THEN CALL repite3() END IF END FOR # El ITBIS solo aplica a proveedores locales. En internacionales # (tipo 22/24) no hay ITBIS: flete1.valor se usa como FLETE. LET opc1 = "NO" IF NOT es_internacional() THEN LET opc1 = fgl_winquestion( "ITBIS", "DESEA INCLUIR ITBIS?", "YES", "YES|NO", "QUESTION", 0) IF opc1 = "YES" THEN LET flete1.valor = valor_total * (itbis / 100) END IF END IF LET programa = 9 LET int_flag = FALSE CALL notas20() IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) LET int_flag = FALSE RETURN END IF LET fallo = FALSE # Asegura BRUTO/DESCUENTO/NETO consistentes antes de grabar CALL recalcula_totales() BEGIN WORK UPDATE cotb00014 SET (num_oc, tipo, fech_oc, num_pr, cod_sp, cod_sp_sec, term_sp, via, enviada, fech_enviada, pago, fech_pago, cierre, cod_pt, bodega, total_bruto, c_flete, otros_g, descuento, neto) = (ordenes.*, flete1.total_b, flete1.valor, flete1.ot_valor, flete1.descu_valor, flete1.total_1) WHERE num_oc = ordenes.num_oc IF STATUS < 0 THEN ROLLBACK WORK CALL fgl_winmessage( "MENSAJE", "HA OCURRIDO UN ERROR INSERTANDO EN TABLA MAESTRA", "STOP") LET fallo = TRUE EXIT MENU END IF DELETE FROM cotb00029 WHERE num_oc = ordenes.num_oc INSERT INTO cotb00029 VALUES(ordenes.num_oc, ordenes.tipo, ordenes.cod_sp, ordenes.cod_sp_sec, notas.ship_to, notas.n_a_b, notas.c_i_d, c_i_d1, notas.nota, nota1, desc1, flete1.total_b, desc2, flete1.valor, desc5, flete1.descu_valor, desc3, flete1.ot_valor, desc4, NULL, usuarios, GETDATE(), NULL, NULL) DELETE FROM cotb00015 WHERE num_oc = ordenes.num_oc FOR idx = 1 TO arr_count() IF arr_ordenes[idx].cod_n IS NOT NULL AND arr_ordenes[idx].cod_n <> 0 THEN IF arr_ordenes[idx].tipo_costo = 'EN PUERTO' THEN LET anio = YEAR(CURRENT) LET fecha = CURRENT YEAR TO FRACTION INITIALIZE nullcontainer TO NULL IF ordenes.tipo = '01' THEN #Materia prima LET tabla = 'intb00013' END IF IF ordenes.tipo = '02' THEN #Productos terminados LET tabla = 'iptb00004' END IF IF ordenes.tipo = '03' THEN #Repuesto LET tabla = 'irtb00013' END IF PREPARE checking FROM "SELECT * FROM " || tabla || " WHERE ano = YEAR(getdate()) and cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ?" EXECUTE checking USING arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec IF STATUS = NOTFOUND THEN IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN PREPARE insertar FROM "INSERT INTO " || tabla || " (mes_ini, mes_fin, ano, cod_n, cod_grupo, cod_tipo, cod_sec, costo_st, status_t, us_crea, fech_crea, us_mod, fech_mod) VALUES(?,?,?,?,?,?,?,?,?,?,?,?,?)" ELSE PREPARE insertar FROM "INSERT INTO " || tabla || " (ventas, mes_ini, mes_fin, ano, cod_n, cod_grupo, cod_tipo, cod_sec, material, labor, gasto, status_t, us_crea, fech_crea, us_mod, fech_mod) VALUES(1,?,?,?,?,?,?,?,?,0,0,?,?,?,?,?)" END IF EXECUTE insertar USING '01', '12', anio, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, arr_ordenes[idx].precio, nullcontainer, usuarios, fecha, nullcontainer, nullcontainer ELSE IF ordenes.tipo = '03' OR ordenes.tipo = '01' THEN PREPARE actualizar FROM "UPDATE " || tabla || " set costo_st = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())" ELSE PREPARE actualizar FROM "UPDATE " || tabla || " set material = ?, us_mod = ?, fech_mod = ? where cod_n = ? and cod_grupo = ? and cod_tipo = ? and cod_sec = ? and ano = YEAR(GETDATE())" END IF EXECUTE actualizar USING arr_ordenes[idx].precio, usuarios, fecha, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec END IF END IF INSERT INTO cotb00015 VALUES(ordenes.num_oc, arr_ordenes[idx].num_req, ordenes.tipo, arr_ordenes[idx].cod_n, arr_ordenes[idx].cod_grupo, arr_ordenes[idx].cod_tipo, arr_ordenes[idx].cod_sec, NULL, arr_ordenes[idx].cantidad, arr_ordenes[idx].precio, arr_ordenes[idx].porc_desc, arr_ordenes[idx].monto_desc, cod_mon, NULL, SUSER_SNAME(), GETDATE(), NULL, NULL, NULL, arr_ordenes[idx].tipo_costo) IF STATUS < 0 THEN ROLLBACK WORK CALL fgl_winmessage( "MENSAJE", "HA OCURRIDO UN ERROR INSERTANDO EN DETALLE", "STOP") LET fallo = TRUE EXIT FOR END IF UPDATE cotb00008 SET procesada = 'S', us_mod = usuarios, fech_mod = getdate() WHERE num_req = arr_ordenes[idx].num_req END IF END FOR IF fallo = FALSE THEN COMMIT WORK CALL fgl_winmessage("MENSAJE", "ADICION EXITOSA", "STOP") LET opt1 = fgl_winquestion( "Atencion", "Desea Imprimir la orden?", "cancel", "YES|NO|", "question", 0) IF opt1 = "YES" THEN PREPARE query4 FROM "SELECT uso, depto_destino FROM cotb00006 WHERE num_req = ? AND status_t IS NULL" EXECUTE query4 USING requi INTO xuso_requisicion, depa # Antepone el departamento DESTINO (al que se carga el gasto), # tomado de cotb00006.depto_destino. LET container = NULL PREPARE query5 FROM "SELECT nom_dpto FROM adtb00001 WHERE departamento = ? AND status_t IS NULL" EXECUTE query5 USING depa INTO container IF container IS NOT NULL AND container CLIPPED != "" THEN LET xuso_requisicion = "(", container CLIPPED, ") ", xuso_requisicion CLIPPED END IF DISPLAY xuso_requisicion SELECT ISNULL(a.c_flete, 0), ISNULL(a.otros_g, 0) INTO flete1.valor, flete1.ot_valor FROM cotb00014 a WHERE a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo CALL recalcula_totales() DISPLAY "ANTES DE LLAMAR LA ORDEN" DISPLAY "flete1.total_b: ", flete1.total_b DISPLAY "flete1.ot_valor: ", flete1.ot_valor DISPLAY "flete1.valor: ", flete1.valor DISPLAY "flete1.total_1", flete1.total_1 CALL orden( flete1.*, arr_ordenes, ordenes.*, suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, paises.*, notas.ship_to, moneda, salida, xnota, desc1, desc2, desc3, desc4, desc5, xdetalle_orden, xuso_requisicion) END IF END IF CALL msg(13) COMMAND KEY("N") "aNular" SELECT DISTINCT a.num_oc FROM cgtb00017 a WHERE a.num_oc = ordenes.num_oc AND a.status_t IS NULL IF STATUS = NOTFOUND THEN LET opc = fgl_winquestion( "ANULAR", "ESTA SEGURO DE ANULAR ORDEN?", "YES", "YES|NO", "QUESTION", 0) # Actualizacion de la eliminacion logica de las tablas que intervienen el la # orden de compras IF opc = "YES" THEN BEGIN WORK UPDATE cotb00014 SET status_t = "N", us_mod = SUSER_SNAME(), fech_mod = GETDATE() WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo UPDATE cotb00015 SET status_t = "N", us_mod = SUSER_SNAME(), fech_mod = GETDATE() WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo UPDATE cotb00029 SET status_t = "N", us_mod = SUSER_SNAME(), fech_mod = GETDATE() WHERE @num_oc = ordenes.num_oc AND @tipo = ordenes.tipo UPDATE cotb00025 SET status_t = "E", us_mod = usuarios, fech_mod = getdate() WHERE num_oc = ordenes.num_oc DECLARE busca_req CURSOR FOR SELECT DISTINCT a.num_req FROM cotb00015 a WHERE a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo FOREACH busca_req INTO xnum_req UPDATE cotb00006 SET estado = 'ABIERTA', fech_mod = getdate(), us_mod = usuarios WHERE num_req = xnum_req UPDATE cotb00008 SET procesada = 'N', us_mod = usuarios, fech_mod = getdate() WHERE num_req = xnum_req END FOREACH COMMIT WORK LET numero_msg = 39 CALL msg(numero_msg) END IF ELSE CALL fgl_winmessage( "INFO", "NO PUEDE ANULAR ORDEN, ESTA LIQUIDADA", "INFO") END IF COMMAND "Retornar" "Retorna al menu anterior" CLEAR FORM EXIT MENU END MENU END FUNCTION # Esta funcion no se esta utilizando actualmente al 08/09/93 # Su funcion es de enumerar las ordenes de forma automatica FUNCTION determina1() OPEN WINDOW realiza AT 10, 10 WITH 5 ROWS, 43 COLUMNS ATTRIBUTE(BORDER) MENU "OPCION" COMMAND "Automatica" "Enumera de Forma Automatica" SELECT UNIQUE MAX(num_oc) INTO ordenes.num_oc FROM cotb00014 IF ordenes.num_oc IS NULL THEN LET ordenes.num_oc = 1 END IF LET manual = "N" EXIT MENU COMMAND "Manual" "El usuario tiene que enumerar el documento" LET manual = "S" EXIT MENU END MENU CLOSE WINDOW realiza END FUNCTION FUNCTION busca_sup1() OPEN WINDOW busqueda AT 10, 10 WITH FORM "cofmwd005" ATTRIBUTE(BORDER, FORM LINE FIRST + 2, COMMENT LINE LAST) CONSTRUCT criterio ON cotb00001.nom_sp FROM cotb00001.nom_sp LET selec = "SELECT cod_sp,cod_sp_sec,nom_sp FROM cotb00001 ", " WHERE ", " status_t is null AND ", criterio CLIPPED, "ORDER BY 3 " PREPARE busco FROM selec DECLARE local CURSOR FOR busco LET idx = 1 FOREACH local INTO buscar_wd[idx].* IF status = NOTFOUND THEN LET existe = "N" EXIT FOREACH END IF LET despl_wd[idx].codigo = buscar_wd[idx].cod_sp USING "&&", "-", buscar_wd[idx].cod_sp_sec USING "&&&&" LET despl_wd[idx].nom_sp = buscar_wd[idx].nom_sp CLIPPED LET idx = idx + 1 IF idx > 200 THEN EXIT FOREACH END IF END FOREACH CALL set_count(idx - 1) DISPLAY ARRAY despl_wd TO s_muestra.* IF int_flag THEN LET numero_msg = 2 CALL msg(numero_msg) GOTO sale END IF LET curr = arr_curr() IF identifica = "O" THEN LET ordenes.cod_sp = despl_wd[curr].codigo[1, 2] LET ordenes.cod_sp_sec = despl_wd[curr].codigo[4, 7] LET suplidor.nom_sp = despl_wd[curr].nom_sp END IF LABEL sale: CLOSE WINDOW busqueda END FUNCTION FUNCTION escoge() SELECT a.nom_sp, a.dir_sp, ciu_sp, a.cod_pais, b.nom_pais INTO suplidor.nom_sp, suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais, paises.nom_pais FROM cotb00001 a LEFT OUTER JOIN cotb00018 b ON a.cod_pais = b.cod_pais WHERE a.cod_sp = ordenes.cod_sp AND a.cod_sp_sec = ordenes.cod_sp_sec AND a.status_t IS NULL # SELECT nom_sp INTO suplidor.nom_sp FROM cotb00001 # WHERE cod_sp = ordenes.cod_sp AND # cod_sp_sec = ordenes.cod_sp_sec AND # status_t is null CALL busca_monedas() CALL busca_puertos() CALL busca_terminos() CALL lugarentregas() CALL fvia() CALL tipoorden() SELECT a.descrip_mon INTO moneda FROM cotb00031 a WHERE a.cod_mon = cod_mon SELECT a.ship_to, a.n_a_b, a.c_i_d, a.c_i_d1, a.nota, a.nota1, a.desc_flete, a.total_flete, a.desc_otro, a.total_otro, a.descripcion, a.total_valor, a.desc_valor INTO notas.ship_to, notas.n_a_b, c_i_d, c_i_d1, nota, nota1, desc1, # bruto flete1.total_b, desc3, flete1.ot_valor, desc4, flete1.valor, desc2 FROM cotb00029 a WHERE a.num_oc = ordenes.num_oc DISPLAY BY NAME ordenes.tipo, ordenes.num_oc THRU ordenes.cod_pt, suplidor.nom_sp, ordenes.term_sp, ordenes.via, cod_mon, suplidor.nom_sp, ordenes.fech_oc, ordenes.enviada, ordenes.fech_enviada, ordenes.via, ordenes.pago, ordenes.fech_pago -- ordenes.bodega excluido (ver nota en copcad009()): no esta en el -- formulario, DISPLAY BY NAME fallaba con "Field (bodega) not found in form". IF ordenes.cod_sp = 22 OR ordenes.cod_sp = 24 THEN LET flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor ELSE LET flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor END IF END FUNCTION FUNCTION repite3() LET verdad = NULL LET codigo1 = arr_ordenes[curr].cod_n USING "&&&&", "-", arr_ordenes[curr].cod_grupo USING "&&&&", "-", arr_ordenes[curr].cod_tipo USING "&&&&&", "-", arr_ordenes[curr].cod_sec USING "&&&&&&&&" FOR idx = 1 TO num_reg {curr} IF idx != curr THEN LET codigo = arr_ordenes[idx].cod_n USING "&&&&", "-", arr_ordenes[idx].cod_grupo USING "&&&&", "-", arr_ordenes[idx].cod_tipo USING "&&&&&", "-", arr_ordenes[idx].cod_sec USING "&&&&&&&&" IF codigo1 = codigo THEN LET verdad = "S" LET numero_msg = 21 CALL msg(numero_msg) ELSE IF verdad != "S" THEN LET verdad = "N" END IF END IF END IF END FOR END FUNCTION {FUNCTION notas9() OPEN WINDOW apl_notas AT 10,10 WITH FORM "cofmwd012" ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last -1) INPUT BY NAME notas.ship_to,notas.n_a_b,c_i_d,c_i_d1,nota,nota1 WITOUT DEFAULTS BEFORE FIELD ship_to IF ordenes.cod_sp = 23 THEN LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota ELSE LET notas.ship_to = p_companias.nombre CLIPPED DISPLAY BY NAME notas.ship_to END IF AFTER FIELD ship_to IF ordenes.cod_sp != 23 THEN IF notas.ship_to IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD ship_to END IF ELSE LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF BEFORE FIELD n_a_b IF ordenes.cod_sp = 23 THEN LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF AFTER FIELD n_a_b IF ordenes.cod_sp != 23 THEN IF notas.n_a_b IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD n_a_b END IF ELSE LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF BEFORE FIELD c_i_d IF ordenes.cod_sp = 23 THEN LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF AFTER FIELD c_i_d IF ordenes.cod_sp != 23 THEN IF c_i_d IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD c_i_d END IF ELSE LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF AFTER INPUT LET notas.nota = nota,nota1 LET notas.c_i_d= c_i_d,c_i_d1 EXIT INPUT END INPUT IF int_flag THEN LET int_flag = FALSE END IF DELETE FROM cotb00029 WHERE num_oc = 0 OR num_oc IS NULL INSERT INTO cotb00029 VALUES (ordenes.num_oc,ordenes.tipo,ordenes.cod_sp, ordenes.cod_sp_sec,notas.ship_to,notas.n_a_b, notas.c_i_d,notas.nota,NULL,SUSER_SNAME(),GETDATE(), NULL,NULL) CLOSE WINDOW apl_notas END FUNCTION} REPORT orden9(x) DEFINE x RECORD num_oc LIKE cotb00014.num_oc, cod_n LIKE cotb00015.cod_n, cod_grupo LIKE cotb00015.cod_grupo, cod_tipo LIKE cotb00015.cod_tipo, cod_sec LIKE cotb00015.cod_sec, cantidad LIKE cotb00008.cantidad, precio LIKE cotb00008.precio, valor DECIMAL(12, 2) END RECORD, descripcion CHAR(70), nombre_m CHAR(20) DEFINE doble_on, doble_off, negrillas_on, negrillas_off, comp_on, comp_off, doble_st_on, doble_st_off, cuarto_off, cuarto, cuarto1, cuarto2, normal, doce CHAR(2) DEFINE hora CHAR(5) DEFINE l SMALLINT OUTPUT TOP MARGIN 0 LEFT MARGIN 0 BOTTOM MARGIN 3 ORDER BY x.num_oc, x.cod_n, x.cod_grupo, x.cod_tipo, x.cod_sec FORMAT PAGE HEADER LET doble_on = ASCII 14 LET doble_off = ASCII 20 LET doble_st_on = ASCII 27, ASCII 71 LET doble_st_off = ASCII 27, ASCII 72 LET negrillas_on = ASCII 27, ASCII 69 LET negrillas_off = ASCII 27, ASCII 70 LET cuarto = ASCII 27, ASCII 49 LET cuarto1 = ASCII 27, ASCII 48 LET cuarto2 = ASCII 27, ASCII 50 LET cuarto_off = ASCII 27, ASCII 50 LET comp_on = ASCII 15 LET comp_off = ASCII 18 LET doce = ASCII 27, ASCII 77 LET normal = ASCII 27, ASCII 80 LET hora = TIME BEFORE GROUP OF x.num_oc LET l = (40 - LENGTH(p_companias.nombre CLIPPED)) / 2 PRINT doce PRINT COLUMN l + 7, doble_on, negrillas_on, p_companias.nombre CLIPPED, doble_off, negrillas_off PRINT COLUMN 25, "Ave. Central, Madre Vieja Norte" PRINT COLUMN 24, "San Cristobal, Dominican Republic" PRINT COLUMN 21, "Tel. (809)528-0650, Fax. (809)528-0640" PRINT COLUMN 26, " RNC:101-52126-2" SKIP 1 LINE PRINT COLUMN 46, doble_on, negrillas_on, "Order No. ", ordenes.num_oc USING "<<&&&&", doble_off, negrillas_off #---------------------------------------------------------------------------- # CUANDO LA ORDEN ES INTERNACIONAL EL TIPO DE ORDEN ES DIFERENTE A 01 #---------------------------------------------------------------------------- PRINT COLUMN 49, "DATE : ", ordenes.fech_oc USING "dd/mm/yyyy", negrillas_off LET notas.c_i_d = notas.c_i_d CLIPPED LET l = LENGTH(notas.c_i_d) SKIP 2 LINE PRINT COLUMN 2, "SHIP TO : ", notas.ship_to CLIPPED SKIP 1 LINE PRINT COLUMN 2, "Via : ", nom_via CLIPPED SKIP 2 LINES PRINT COLUMN 1, negrillas_on, "PURCHASE ORDER/ORDEN DE COMPRA", negrillas_off PRINT COLUMN 2, "------------------------------------", COLUMN 49, negrillas_on, "DELIVERY DATE : ", negrillas_off, ordenes.fech_enviada USING "dd/mm/yyyy" PRINT COLUMN 1, negrillas_on, "TO/A: ", negrillas_off, suplidor.nom_sp CLIPPED, " (", ordenes.cod_sp USING "&&", "-", ordenes.cod_sp_sec USING "&&&&", ") " #COLUMN 57, notas.n_a_b PRINT COLUMN 8, suplidor.dir_sp CLIPPED, " ", suplidor.ciu_sp CLIPPED #--------------------------- # QUITE ESTE RENGLON PORQUE NO TIENE ESTO EN ESTA ORDEN #---------------------------- # PRINT COLUMN 92,notas.c_i_d CLIPPED #---------------------------- PRINT comp_on SELECT a.descrip_term INTO pagos.descrip_term FROM cotb00024 a WHERE a.term_sp = ordenes.term_sp PRINT COLUMN 1, negrillas_on, "TERMS: ", negrillas_off, doce, pagos.descrip_term PRINT COLUMN 1, "PROFORMA: ", ordenes.num_pr PRINT COLUMN 1, negrillas_off, "----------------------------------------------------------------------------------", "-------------------------------" PRINT doce PRINT COLUMN 4, "QUANTITY", COLUMN 17, "DESCRIPCION / DESCRIPCION ", COLUMN 90, "UNIT PRICE", COLUMN 107, "TOTAL" PRINT COLUMN 4, "CANTIDAD", COLUMN 90, "PRECIO UNITARIO" PRINT COLUMN 1, "==============================================================================", "===================================", negrillas_off ON EVERY ROW LET descripcion = NULL LET articulos.descrip_esp = NULL LET articulos.descrip_ing = NULL LET nombre_m = NULL IF ordenes.tipo = 1 THEN SELECT a.descrip_esp, a.unidad_med INTO pdescripcion, articulos.unidad_med FROM intb00001 a WHERE a.cod_n = x.cod_n AND a.cod_grupo = x.cod_grupo AND a.cod_tipo = x.cod_tipo AND a.cod_sec = x.cod_sec END IF IF ordenes.tipo = 3 THEN SELECT a.descrip_esp, a.unidad_med INTO pdescripcion, articulos.unidad_med FROM irtb00002 a WHERE a.cod_n = x.cod_n AND a.cod_grupo = x.cod_grupo AND a.cod_tipo = x.cod_tipo AND a.cod_sec = x.cod_sec END IF IF ordenes.tipo = 2 THEN SELECT a.descrip_esp, a.unidad_med INTO pdescripcion, articulos.unidad_med FROM iptb00002 a WHERE a.cod_n = x.cod_n AND a.cod_grupo = x.cod_grupo AND a.cod_tipo = x.cod_tipo AND a.cod_sec = x.cod_sec END IF PRINT COLUMN 1, x.cantidad USING "###,###.##", COLUMN 12, x.cod_n USING "&&", "-", x.cod_grupo USING "&&&&", "-", x.cod_tipo USING "&&&&", "-", x.cod_sec USING "&&&&", " ", articulos.unidad_med, " ", pdescripcion[1, 50], COLUMN 87, x.precio USING "##,###,###.###", COLUMN 102, x.valor USING "##,###,###.##" IF notas.n_a_b IS NOT NULL THEN PRINT COLUMN 27, comp_on, "(NAB:", notas.n_a_b CLIPPED, ")", comp_off END IF AFTER GROUP OF x.num_oc PRINT COLUMN 102, "--------------" PRINT COLUMN 40, "FOB ", desc1, COLUMN 102, GROUP SUM(x.cantidad * x.precio) USING "##,###,###.##" IF flete1.valor IS NOT NULL AND flete1.valor > 0 THEN PRINT COLUMN 40, "FREIGHT ", desc2 CLIPPED, COLUMN 102, flete1.valor USING "##,###,###.##" END IF IF flete1.ot_valor IS NOT NULL AND flete1.ot_valor > 0 THEN PRINT COLUMN 40, "OTHERS CHARGES ", desc3, COLUMN 102, flete1.ot_valor USING "##,###,###.##" END IF PRINT COLUMN 102, "--------------" PRINT COLUMN 40, "C&F ", desc4, COLUMN 64, simb_mon, COLUMN 102, flete1.total_1 USING "##,###,###.##" PRINT COLUMN 102, "==============" SKIP 1 LINE IF notas.c_i_d IS NOT NULL THEN SKIP 1 LINE PRINT COLUMN 22, "C. I. D.: ", notas.c_i_d CLIPPED END IF IF notas.nota IS NOT NULL THEN SKIP 1 LINE PRINT COLUMN 22, "NOTE: ", notas.nota END IF PAGE TRAILER PRINT COLUMN 7, "----------------------------", COLUMN 45, "----------------------------" PRINT COLUMN 10, "PREPARADO POR", COLUMN 50, "PRESIDENTE" ON LAST ROW PRINT comp_off END REPORT FUNCTION desplega_cod() DISPLAY arr_ordenes[curr].num_req TO consart[scr_l].num_req DISPLAY arr_ordenes[curr].cod_n TO consart[scr_l].cod_n DISPLAY arr_ordenes[curr].cod_grupo TO consart[scr_l].cod_grupo DISPLAY arr_ordenes[curr].cod_tipo TO consart[scr_l].cod_tipo DISPLAY arr_ordenes[curr].cod_sec TO consart[scr_l].cod_sec DISPLAY arr_ordenes[curr].cantidad TO consart[scr_l].cantidad DISPLAY arr_ordenes[curr].precio TO consart[scr_l].precio DISPLAY arr_ordenes[curr].valor TO consart[scr_l].valor SELECT descrip_esp, unidad_med INTO m_articulos.descrip_esp, m_articulos.unidad_med FROM intb00001 WHERE cod_n = arr_ordenes[curr].cod_n AND cod_grupo = arr_ordenes[curr].cod_grupo AND cod_tipo = arr_ordenes[curr].cod_tipo AND cod_sec = arr_ordenes[curr].cod_sec { SELECT a.cod_nab,a.descrip_esp INTO m_articulos.cod_nab,descrip1 FROM cotb00005 a,intb00002 b WHERE b.cod_n=arr_ordenes[curr].cod_n and b.cod_grupo=arr_ordenes[curr].cod_grupo and b.cod_tipo=arr_ordenes[curr].cod_tipo and b.cod_sec=arr_ordenes[curr].cod_sec and a.cod_nab = b.cod_nab DISPLAY BY NAME m_articulos.cod_nab,descrip1,articulos.descrip_esp, articulos.unidad_med } DISPLAY BY NAME descrip1, m_articulos.descrip_esp, m_articulos.unidad_med END FUNCTION FUNCTION busca_req() OPEN WINDOW busqueda11 AT 10, 3 WITH FORM "cofmwd020" ATTRIBUTE(BORDER, FORM LINE FIRST + 1, COMMENT LINE LAST) LET selec = "SELECT DISTINCT c.num_oc,a.num_req,c.fech_req,c.cod_emp_sec,b.nom1_emp, ", " b.apell1_emp ", "FROM cotb00008 a,adtb00003 b,cotb00006 c ", "WHERE a.num_req = c.num_req and a.procesada = 'N' AND ", " c.cod_emp_sec = b.num_emp ORDER BY a.num_req " PREPARE comando FROM selec DECLARE requisi CURSOR FOR comando IF status = NOTFOUND THEN LET existe = "N" ELSE LET existe = "S" END IF LET idx = 1 FOREACH requisi INTO requisiciones[idx].* LET idx = idx + 1 END FOREACH IF idx = 1 THEN LET existe = "N" GOTO salir END IF CALL set_count(idx - 1) DISPLAY ARRAY requisiciones TO busca_req.* LET curr1 = arr_curr() LET arr_ordenes[curr].num_req = requisiciones[curr1].num_req LABEL salir: CLOSE WINDOW busqueda11 END FUNCTION FUNCTION notas20() OPEN WINDOW apl1_notas AT 2, 3 WITH FORM "cofmwd014" ATTRIBUTE(BORDER, FORM LINE FIRST + 1, COMMENT LINE LAST - 1) # desc1 bruto, desc_fete # desc3 descuento, desc_ortro # desc4 neto, descripcion # desc2 itbis, desc_valor LET xnota = NULL CALL set_etiquetas() LET int_flag = FALSE SELECT a.ship_to, a.n_a_b, a.c_i_d, a.c_i_d1, a.nota, a.nota1, a.desc_flete, a.total_flete, a.desc_otro, a.total_otro, a.descripcion, a.total_valor, a.desc_valor, a.desc_descuento, a.descuento_valor INTO notas.ship_to, notas.n_a_b, c_i_d, c_i_d1, nota, nota1, desc1, # bruto flete1.total_b, desc3, flete1.ot_valor, desc4, flete1.valor, desc2, desc5, flete1.descu_valor FROM cotb00029 a WHERE a.num_oc = ordenes.num_oc # En una orden INTERNACIONAL ya existente (modificacion), el FLETE se # recupera de la maestra cotb00014.c_flete (fuente confiable) en lugar de # cotb00029. En ordenes nuevas (num_oc aun NULL) se conserva el valor en # memoria; en locales el campo es ITBIS y no se toca aqui. IF ordenes.num_oc IS NOT NULL AND ordenes.num_oc > 0 AND es_internacional() THEN SELECT ISNULL(a.c_flete, 0) INTO flete1.valor FROM cotb00014 a WHERE a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo END IF # Las etiquetas siempre se fijan por tipo de proveedor (cotb00029 pudo # traer otras almacenadas). CALL set_etiquetas() LET notas.ship_to = p_companias.nombre CLIPPED IF programa = 20 THEN INPUT BY NAME notas.ship_to, notas.n_a_b, c_i_d, c_i_d1, nota, nota1, desc1, flete1.total_b, desc2, flete1.valor, desc3, flete1.ot_valor, desc4, desc5, flete1.descu_valor WITHOUT DEFAULTS BEFORE FIELD ship_to IF ordenes.cod_sp = 23 THEN LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota ELSE LET notas.ship_to = p_companias.nombre CLIPPED DISPLAY BY NAME notas.ship_to END IF AFTER FIELD ship_to IF ordenes.cod_sp != 23 THEN IF notas.ship_to IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD ship_to END IF ELSE LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF BEFORE FIELD n_a_b IF ordenes.cod_sp = 23 THEN LET notas.ship_to = p_companias.nombre CLIPPED LET notas.n_a_b = NULL LET c_i_d = NULL LET c_i_d1 = NULL DISPLAY BY NAME notas.ship_to NEXT FIELD nota END IF AFTER INPUT LET notas.nota = nota, nota1 LET notas.c_i_d = c_i_d, c_i_d1 EXIT INPUT END INPUT END IF IF programa = 9 THEN DISPLAY BY NAME flete1.total_b, flete1.valor, flete1.ot_valor, flete1.total_1, flete1.descu_valor INPUT BY NAME notas.ship_to, notas.n_a_b, c_i_d, c_i_d1, nota, nota1, desc1, desc2, flete1.valor, desc3, flete1.ot_valor, desc4, desc5, flete1.descu_valor WITHOUT DEFAULTS BEFORE INPUT IF ordenes.cod_sp = 22 OR ordenes.cod_sp = 24 THEN LET flete1.total_1 = flete1.ot_valor + flete1.total_b + flete1.valor - flete1.descu_valor ELSE LET flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor END IF DISPLAY BY NAME flete1.total_1 BEFORE FIELD valor IF flete1.valor IS NULL THEN LET flete1.valor = 0 END IF AFTER FIELD valor IF flete1.valor IS NULL THEN LET flete1.valor = 0 END IF AFTER FIELD ot_valor IF flete1.ot_valor IS NULL THEN LET flete1.ot_valor = 0 END IF AFTER FIELD descu_valor IF flete1.descu_valor IS NULL THEN LET flete1.descu_valor = 0 END IF AFTER INPUT IF int_flag THEN EXIT INPUT END IF LET xnota = nota CLIPPED, " ", nota1 CLIPPED EXIT INPUT END INPUT END IF IF int_flag THEN GOTO salir END IF LET notas.nota = nota, nota1 LET notas.c_i_d = c_i_d, c_i_d1 IF flete1.total_b IS NULL THEN LET flete1.total_b = 0 END IF IF flete1.valor IS NULL THEN LET flete1.valor = 0 END IF IF flete1.ot_valor IS NULL THEN LET flete1.ot_valor = 0 END IF IF flete1.descu_valor IS NULL THEN LET flete1.descu_valor = 0 END IF LET flete1.total_1 = flete1.total_b + flete1.valor + flete1.ot_valor - flete1.descu_valor DISPLAY BY NAME flete1.total_1 SLEEP 2 IF programa = 20 THEN INPUT ARRAY arr_orden20 FROM sc_orden20.* BEFORE ROW LET j1 = ARR_CURR() LET k1 = SCR_LINE() AFTER FIELD valor1 IF arr_orden20[j1].cantidad IS NULL OR arr_orden20[j1].valor1 IS NULL THEN LET numero_msg = 16 CALL msg(numero_msg) NEXT FIELD cantidad END IF { LET flete1.total_b = 0 FOR idx = 1 TO ARR_COUNT() IF flete1.valor > 0 THEN LET flete1.total_b = flete1.total_b + arr_orden20[idx].valor1 END IF END FOR LET flete1.total_1 = flete1.total_b + flete1.valor + flete1.ot_valor DISPLAY BY NAME flete1.total_1 } END INPUT IF int_flag THEN LET int_flag = FALSE END IF END IF DISPLAY "BRUTO ", flete1.total_b LABEL salir: CLOSE WINDOW apl1_notas END FUNCTION FUNCTION busca_terminos() DEFINE ptermino ui.combobox, ktermino SMALLINT, kdescripcion CHAR(30) LET ptermino = ui.combobox.forname("formonly.term_sp") CALL ptermino.clear() DECLARE pagar CURSOR FOR SELECT term_sp, descrip_term FROM cotb00024 WHERE status_t IS NULL ORDER BY descrip_term FOREACH pagar INTO ktermino, kdescripcion CALL ptermino.additem(ktermino, kdescripcion) END FOREACH END FUNCTION FUNCTION fvia() DEFINE pvia ui.combobox LET pvia = ui.combobox.forname("formonly.via") CALL pvia.clear() LET pvia = ui.combobox.forname("formonly.via") CALL pvia.additem(1, "MARITIMA") CALL pvia.additem(2, "AEREA") CALL pvia.additem(3, "TERRESTRE") END FUNCTION FUNCTION busca_puertos() DEFINE ppuertos ui.combobox, kpuerto SMALLINT, kdescripcion CHAR(30) DECLARE puerto CURSOR FOR SELECT cod_pt, nom_pt FROM cotb00019 WHERE status_t IS NULL ORDER BY nom_pt LET ppuertos = ui.combobox.forname("formonly.cod_pt") CALL ppuertos.clear() FOREACH puerto INTO kpuerto, kdescripcion CALL ppuertos.additem(kpuerto, kdescripcion) END FOREACH END FUNCTION FUNCTION busca_monedas() DEFINE pmoneda ui.combobox, kmoneda SMALLINT, kdescripcion CHAR(30) DECLARE moneda CURSOR FOR SELECT a.cod_mon, a.descrip_mon FROM cotb00031 a WHERE a.status_t IS NULL ORDER BY a.descrip_mon LET pmoneda = ui.combobox.forname("formonly.cod_mon") CALL pmoneda.clear() FOREACH moneda INTO kmoneda, kdescripcion CALL pmoneda.additem(kmoneda, kdescripcion) END FOREACH END FUNCTION FUNCTION tipoCosto(cb ui.ComboBox) {DEFINE tipoCosto ui.combobox LET tipoCosto = ui.combobox.forname("formonly.tipo_costo") CALL tipoCosto.clear() LET tipoCosto = ui.combobox.forname("formonly.tipo_costo")} CALL cb.additem('FOB', 'FOB') CALL cb.additem('EN PUERTO', 'EN PUERTO') END FUNCTION FUNCTION es_internacional() # -------------------------------------------------------------------------- # Un proveedor es INTERNACIONAL cuando su TIPO (cotb00001.cod_sp, definido en # la tabla de tipos cotb00047) es 22 o 24. En esos casos la orden usa el # esquema FOB / FLETE / C&F (sin ITBIS), en vez de BRUTO / ITBIS / NETO. # Fuente unica de verdad para distinguir local vs internacional. # -------------------------------------------------------------------------- RETURN (ordenes.cod_sp = 22 OR ordenes.cod_sp = 24) END FUNCTION FUNCTION set_etiquetas() # -------------------------------------------------------------------------- # Fija las etiquetas de los totales (desc1..desc5) segun el tipo de proveedor. # Estas etiquetas se imprimen en coprmt009.4rp (xdesc1..xdesc5). # desc1 = bruto/FOB desc2 = itbis/flete desc3 = otros cargos # desc4 = neto/C&F desc5 = descuento # -------------------------------------------------------------------------- IF es_internacional() THEN LET desc1 = 'FOB' LET desc5 = 'DISCOUNT' LET desc3 = 'OTHERS CHARGES' LET desc4 = 'C&F' LET desc2 = 'FREIGH' ELSE LET desc1 = 'BRUTO' LET desc5 = 'DESCUENTO' LET desc3 = 'OTROS CARGOS' LET desc4 = 'NETO' LET desc2 = 'ITBIS' END IF END FUNCTION FUNCTION recalcula_totales() # -------------------------------------------------------------------------- # Recalcula el BRUTO (flete1.total_b) y el DESCUENTO (flete1.descu_valor) a # partir de los items cargados en arr_ordenes (cotb00015) y, con ello, el # NETO (flete1.total_1). # # NETO = BRUTO + OTROS CARGOS + (ITBIS o FLETE) - DESCUENTO # # NO modifica flete1.valor (ITBIS en ordenes locales / FREIGHT en las # internacionales) ni flete1.ot_valor (otros cargos): esos se capturan y se # guardan aparte en cotb00014 (c_flete y otros_g). Se debe llamar justo # antes de guardar o imprimir para garantizar un NETO correcto en ordenes # locales e internacionales, sin depender de cotb00029 (cuyo layout no es # confiable). # -------------------------------------------------------------------------- DEFINE i INTEGER LET flete1.total_b = 0 LET flete1.descu_valor = 0 FOR i = 1 TO arr_ordenes.getLength() IF arr_ordenes[i].cantidad IS NOT NULL AND arr_ordenes[i].precio IS NOT NULL THEN LET flete1.total_b = flete1.total_b + (arr_ordenes[i].cantidad * arr_ordenes[i].precio) IF arr_ordenes[i].monto_desc IS NOT NULL THEN LET flete1.descu_valor = flete1.descu_valor + arr_ordenes[i].monto_desc END IF END IF END FOR IF flete1.valor IS NULL THEN LET flete1.valor = 0 END IF IF flete1.ot_valor IS NULL THEN LET flete1.ot_valor = 0 END IF LET flete1.total_1 = flete1.total_b + flete1.ot_valor + flete1.valor - flete1.descu_valor END FUNCTION