Files
MBS/PROYECTO/codir/coprmt009.150508
T

2125 lines
69 KiB
Plaintext

{
-------------------------------------------------------------------------
PROGRAMA : COPRMT009
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Ordenes de Compras
PROGRAMADOR : JUAN SOTO
FECHA REALIZACION : AGOSTO 1997
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
--------------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
DEFINE c_i_d,c_i_d1,nota,nota1,nombre_mon CHAR(30)
DEFINE simb_mon CHAR(4)
DEFINE nom_via CHAR(10)
DEFINE req_ant ARRAY[100] OF INTEGER
DEFINE opc1,opc2,opc4,salir,proce CHAR(1)
DEFINE cod_mon,control_item,idx2,total_parc INTEGER
DEFINE itbis,valor2,total DECIMAL(12,2)
DEFINE j1,k1,arr_1,requis INTEGER
DEFINE idx4,num_reg SMALLINT,
descrip CHAR(70)
DEFINE requisiciones ARRAY[50] 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
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
CALL pantalla()
DISPLAY "coprmt009" AT 4,3 ATTRIBUTE (YELLOW)
DISPLAY "Ordenes de Compras" AT 6,31 ATTRIBUTE (YELLOW)
SELECT dia INTO dia_aduana FROM cotb00028
MENU "OPCIONES"
COMMAND "Adicionar" "<Esc> Adiciona Registro <Delete> Cancela Operacion"
CLEAR FORM
LET opc = "S"
LET existe = null
LET int_flag = FALSE
{LOCK TABLE cotb00014 IN SHARE MODE
IF status < 0 THEN
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
SLEEP 3
RETURN
END IF
END IF}
CALL copcad009()
# UNLOCK TABLE cotb00014
COMMAND "Consultar-Modificar"
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
CLEAR FORM
LET existe = null
LET int_flag = FALSE
CALL copcmf009()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION copcad009()
#WHENEVER ERROR CONTINUE
CLEAR FORM
DISPLAY " "
AT 24,1
INITIALIZE ordenes.* 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:
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
#SELECT a.itbi INTO itbis FROM vetb00019 a
#WHERE ano = YEAR(TODAY) AND mes_ini = 1 AND mes_fin = 12
LET ordenes.num_oc = ordenes.num_oc + 1
LET numero_orden = ordenes.num_oc
DISPLAY BY NAME ordenes.num_oc
# Captura las informaciones generales de la orden de compras
LABEL atras:
MESSAGE " "
INPUT BY NAME ordenes.*,cod_mon WITHOUT DEFAULTS ATTRIBUTE (YELLOW)
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
# Ventana para los terminos de pagos
WHEN INFIELD (term_sp)
LET identifica = "O"
CALL busca_terminos()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD term_sp
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
NEXT FIELD term_sp
END IF
DISPLAY BY NAME ordenes.term_sp,pagos.descrip_term
LET identifica = NULL
NEXT FIELD term_sp
# Ventana para la busqueda de los puertos
WHEN INFIELD (cod_pt)
LET identifica = "O"
CALL busca_puertos()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
# NEXT FIELD cod_pt
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
# NEXT FIELD cod_pt
END IF
LET ordenes.cod_pt = puertos.cod_pt
DISPLAY BY NAME puertos.cod_pt,nombre_p
LET identifica = NULL
# Ventana para la busqueda de las monedas
WHEN INFIELD (cod_mon)
LET identifica = "O"
CALL busca_monedas()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
# NEXT FIELD cod_mon
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
# NEXT FIELD cod_mon
END IF
LET cod_mon = monedas.cod_mon
DISPLAY BY NAME cod_mon,nombre_mon
LET identifica = NULL
EXIT INPUT
END CASE
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
AFTER FIELD num_oc
IF ordenes.num_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_oc
END IF
SELECT UNIQUE num_oc FROM cotb00014 WHERE num_oc = ordenes.num_oc
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_oc
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
INTO suplidor.nom_sp,suplidor.dir_sp,suplidor.ciu_sp
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 status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME suplidor.nom_sp
END IF
AFTER FIELD term_sp
# Chequeo de los terminos de pagos para desplegue de informacion
IF ordenes.term_sp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD term_sp
ELSE
IF ordenes.cod_sp = 23 THEN
SELECT b.descrip_term INTO pagos.descrip_term FROM cotb00024 b
WHERE b.term_sp = ordenes.term_sp and b.status_t is null
ELSE
SELECT b.descrip_ting INTO pagos.descrip_term FROM cotb00024 b
WHERE b.term_sp = ordenes.term_sp and b.status_t is null
END IF
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD term_sp
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME pagos.descrip_term
END IF
AFTER FIELD enviada
IF ordenes.enviada = "N" THEN
NEXT FIELD pago
END IF
AFTER FIELD pago
IF ordenes.pago = "N" THEN
NEXT FIELD cierre
END IF
AFTER FIELD via
# Validacion de la via para determinar su via
IF ordenes.via IS NOT NULL THEN
IF ordenes.via = "01" THEN
LET nom_via = "MARITIMA"
END IF
IF ordenes.via = "02" THEN
LET nom_via = "AEREA"
END IF
IF ordenes.via = "03" THEN
LET nom_via = "TERRESTRE"
END IF
ELSE
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD via
END IF
DISPLAY BY NAME nom_via
BEFORE FIELD cod_pt
IF ordenes.via = "03" THEN
EXIT INPUT
END IF
AFTER FIELD cod_pt
# Chequeo del puerto y busqueda del su descripcion
IF ordenes.tipo = "01" THEN
IF ordenes.cod_pt IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD cod_pt
END IF
END IF
IF ordenes.cod_pt IS NOT NULL THEN
SELECT a.nom_pt,a.duracion INTO nombre_p,m_articulos.dia_llegada
FROM cotb00019 a
WHERE cod_pt = ordenes.cod_pt
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD cod_pt
END IF
DISPLAY BY NAME nombre_p
END IF
AFTER FIELD cod_mon
# Chequeo del codigo de la moneda y busqueda del su descripcion
IF cod_mon is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD cod_mon
END IF
SELECT a.descrip_mon,a.simbolo INTO nombre_mon,simb_mon
FROM cotb00031 a
WHERE a.cod_mon = cod_mon AND a.status_t IS NULL
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD cod_mon
END IF
DISPLAY BY NAME nombre_mon
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
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
# 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
FOR idx = 1 TO 26
LET arr_ordenes[idx].num_req = null
LET arr_ordenes[idx].cod_n = null
LET arr_ordenes[idx].cod_grupo = null
LET arr_ordenes[idx].cod_tipo = null
LET arr_ordenes[idx].cod_sec = null
LET arr_ordenes[idx].cantidad = null
LET arr_ordenes[idx].precio = null
LET arr_ordenes[idx].valor = null
END FOR
END IF
LET opc = "N"
MESSAGE "Ctrl-B Se Dirige A La Pantalla Anterior" ATTRIBUTE (YELLOW)
INPUT ARRAY arr_ordenes WITHOUT DEFAULTS FROM consart.* ATTRIBUTE (YELLOW)
ON KEY (ESCAPE)
EXIT INPUT
ON KEY (CONTROL-B)
GOTO atras
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD cod_sec
IF arr_ordenes[curr].cod_n IS NOT NULL THEN
IF ordenes.tipo = "01" THEN
SELECT UNIQUE a.descrip_esp,a.unidad_med,b.cod_nab
INTO articulos.descrip_esp,articulos.unidad_med,m_articulos.cod_nab
FROM intb00001 a,intb00002 b
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,m_articulos.cod_nab,
articulos.unidad_med ATTRIBUTE(CYAN)
END IF
IF ordenes.tipo = "02" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM iptb00002 a
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,articulos.unidad_med ATTRIBUTE(CYAN)
END IF
IF ordenes.tipo = "03" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM irtb00002 a
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,articulos.unidad_med ATTRIBUTE(CYAN)
END IF
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 INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
END INPUT
LET valor_total = 0
LET flete1.ot_valor = 0
LET flete1.valor = 0
LET flete1.total_b = 0
FOR idx = 1 TO ARR_COUNT()
IF arr_ordenes[idx].valor IS NOT NULL THEN
LET valor_total = valor_total + arr_ordenes[idx].valor
END IF
END FOR
LET opc1 = "N"
#PROMPT "Desea Incluir ITBI? " FOR opc1
LET flete1.total_b = valor_total
#IF opc1 = "S" OR opc1 = "s" THEN
# LET flete1.valor = flete1.total_b * itbis
#END IF}
LET programa = 9
CALL notas20()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET opc = "N"
LABEL prob:
PROMPT "Toda la informacion esta correcta (S/N)?" FOR CHAR OPC
LET opc = UPSHIFT(opc)
IF (opc IS NULL) OR ( opc != "S" AND opc != "N") THEN
GOTO prob
END IF
IF opc = "N" THEN
GOTO incorrecta
END IF
IF opc = "S" THEN
LET ordenes.num_oc = numero_orden
UPDATE cotb00030 SET num_oc = numero_orden,
us_mod = user,
fech_mod = current
DISPLAY "Actualizando Maestra de Ordenes" AT 24,1 ATTRIBUTE(BOLD)
INSERT INTO cotb00014 VALUES(ordenes.*,flete1.valor,flete1.ot_valor,
null,null,user,current,null,null)
DISPLAY BY NAME ordenes.num_oc
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n is not null 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,user,current,null,null)
END IF
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
START REPORT orden9 TO "rpco09"
DISPLAY "Impresion en Proceso... Espere Por Favor" AT 23,1
ATTRIBUTE(YELLOW)
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n IS NOT NULL THEN
OUTPUT TO REPORT orden9(ordenes.num_oc,
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,
arr_ordenes[idx].valor)
END IF
END FOR
FINISH REPORT orden9
CLEAR FORM
RUN "TYPE rpco09 > %USPRINT%"
END IF
FOR idx = 1 to 100
LET busca_parte[idx].num_req = NULL
LET busca_parte[idx].cod_n = NULL
LET busca_parte[idx].cod_grupo = NULL
LET busca_parte[idx].cod_tipo = NULL
LET busca_parte[idx].cod_sec = NULL
LET busca_parte[idx].cantidad = NULL
LET busca_parte[idx].precio = NULL
END FOR
LET flete1.total_b = 0
LET flete1.ot_valor= 0
LET int_flag = FALSE
LET numero_msg = 1
CALL msg(numero_msg)
END FUNCTION
FUNCTION copcmf009()
#WHENEVER ERROR CONTINUE
# Aqui se prepara para la captura del criterio de seleccion
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 ",
" FROM cotb00014,cotb00015 ",
" WHERE cotb00014.num_oc = cotb00015.num_oc AND ",
" cotb00014.tipo = cotb00015.tipo AND ",
" cotb00014.status_t is null AND ",criterio clipped," ORDER BY 1"
PREPARE busca FROM selec
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
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
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
# Funcion para la busqueda de lo suplidores, Terminos ded pago,
# descripcion del puesto y la via
CALL escoge()
DISPLAY BY NAME ordenes.num_oc THRU ordenes.cod_pt,
suplidor.nom_sp,pagos.descrip_term,
nombre_p,nom_via,cod_mon,nombre_mon,
ordenes.fech_oc ATTRIBUTE(CYAN)
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
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
CALL escoge()
DISPLAY BY NAME ordenes.*,suplidor.nom_sp,pagos.descrip_term,
nombre_p,nom_via,cod_mon,nombre_mon,
ordenes.fech_oc ATTRIBUTE(CYAN)
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
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
CALL escoge()
DISPLAY BY NAME ordenes.*,suplidor.nom_sp,pagos.descrip_term,
nombre_p,nom_via,cod_mon,nombre_mon,
ordenes.fech_oc ATTRIBUTE(CYAN)
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
CALL escoge()
DISPLAY BY NAME ordenes.*,suplidor.nom_sp,pagos.descrip_term,
nombre_p,nom_via,cod_mon,nombre_mon,
ordenes.fech_oc ATTRIBUTE(CYAN)
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
CALL escoge()
DISPLAY BY NAME ordenes.*,suplidor.nom_sp,pagos.descrip_term,
nombre_p,nom_via,cod_mon,nombre_mon,
ordenes.fech_oc ATTRIBUTE(CYAN)
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger" "<Esc> Continua Consultando <Delete> Cancela Operacion"
INPUT BY NAME ordenes.*,cod_mon WITHOUT DEFAULTS ATTRIBUTE (YELLOW)
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
# Ventana para los terminos de pagos
WHEN INFIELD (term_sp)
LET identifica = "O"
CALL busca_terminos()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
NEXT FIELD term_sp
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
NEXT FIELD term_sp
END IF
DISPLAY BY NAME ordenes.term_sp,pagos.descrip_term
LET identifica = NULL
NEXT FIELD term_sp
# Ventana para la busqueda de los puertos
WHEN INFIELD (cod_pt)
LET identifica = "O"
CALL busca_puertos()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
# NEXT FIELD cod_pt
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
# NEXT FIELD cod_pt
END IF
LET ordenes.cod_pt = puertos.cod_pt
DISPLAY BY NAME puertos.cod_pt,nombre_p
LET identifica = NULL
# Ventana para la busqueda de las monedas
WHEN INFIELD (cod_mon)
LET identifica = "O"
CALL busca_monedas()
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
# NEXT FIELD cod_mon
END IF
IF existe = "N" THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET existe = null
# NEXT FIELD cod_mon
END IF
LET cod_mon = monedas.cod_mon
DISPLAY BY NAME cod_mon,nombre_mon
LET identifica = NULL
EXIT INPUT
END CASE
BEFORE FIELD num_oc
NEXT FIELD tipo
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
AFTER FIELD num_oc
IF ordenes.num_oc IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fech_oc
END IF
SELECT UNIQUE num_oc FROM cotb00014 WHERE num_oc = ordenes.num_oc
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_oc
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
INTO suplidor.nom_sp,suplidor.dir_sp,suplidor.ciu_sp
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 status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME suplidor.nom_sp
END IF
AFTER FIELD term_sp
# Chequeo de los terminos de pagos para desplegue de informacion
IF ordenes.term_sp IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD term_sp
ELSE
IF ordenes.cod_sp = 23 THEN
SELECT b.descrip_term INTO pagos.descrip_term FROM cotb00024 b
WHERE b.term_sp = ordenes.term_sp and b.status_t is null
ELSE
SELECT b.descrip_ting INTO pagos.descrip_term FROM cotb00024 b
WHERE b.term_sp = ordenes.term_sp and b.status_t is null
END IF
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD term_sp
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
RETURN
END IF
END IF
DISPLAY BY NAME pagos.descrip_term
END IF
AFTER FIELD enviada
IF ordenes.enviada = "N" THEN
NEXT FIELD pago
END IF
AFTER FIELD pago
IF ordenes.pago = "N" THEN
NEXT FIELD cierre
END IF
AFTER FIELD via
# Validacion de la via para determinar su via
IF ordenes.via IS NOT NULL THEN
IF ordenes.via = "01" THEN
LET nom_via = "MARITIMA"
END IF
IF ordenes.via = "02" THEN
LET nom_via = "AEREA"
END IF
IF ordenes.via = "03" THEN
LET nom_via = "TERRESTRE"
END IF
ELSE
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD via
END IF
DISPLAY BY NAME nom_via
BEFORE FIELD cod_pt
IF ordenes.via = "03" THEN
EXIT INPUT
END IF
AFTER FIELD cod_pt
# Chequeo del puerto y busqueda del su descripcion
IF ordenes.tipo = "01" THEN
IF ordenes.cod_pt IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD cod_pt
END IF
END IF
IF ordenes.cod_pt IS NOT NULL THEN
SELECT a.nom_pt,a.duracion INTO nombre_p,m_articulos.dia_llegada
FROM cotb00019 a
WHERE cod_pt = ordenes.cod_pt
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD cod_pt
END IF
DISPLAY BY NAME nombre_p
END IF
AFTER FIELD cod_mon
# Chequeo del codigo de la moneda y busqueda del su descripcion
IF cod_mon is null THEN
LET numero_msg = 16
CALL msg(numero_msg)
# NEXT FIELD cod_mon
END IF
SELECT a.descrip_mon,a.simbolo INTO nombre_mon,simb_mon
FROM cotb00031 a
WHERE a.cod_mon = cod_mon AND a.status_t IS NULL
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
# NEXT FIELD cod_mon
END IF
DISPLAY BY NAME nombre_mon
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
END INPUT
DECLARE busca20 CURSOR FOR
SELECT a.num_req,a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_Sec,a.cantidad,
a.precio
FROM cotb00015 a
WHERE (a.num_oc = ordenes.num_oc AND a.tipo = ordenes.tipo) AND
a.status_t is null
LET idx = 1
FOREACH busca20 INTO arr_ordenes[idx].*
LET arr_ordenes[idx].valor=arr_ordenes[idx].cantidad *
arr_ordenes[idx].precio
LET idx = idx + 1
END FOREACH
MESSAGE "Para Buscar La Descripcion Del Producto Presione Ctrl-B"
ATTRIBUTE(YELLOW)
CALL set_count(idx -1)
INPUT ARRAY arr_ordenes WITHOUT DEFAULTS FROM consart.* ATTRIBUTE (YELLOW)
ON KEY (ESCAPE)
EXIT INPUT
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD cod_sec
IF arr_ordenes[curr].cod_n IS NOT NULL THEN
IF ordenes.tipo = "01" THEN
SELECT UNIQUE a.descrip_esp,a.unidad_med,b.cod_nab
INTO articulos.descrip_esp,articulos.unidad_med,m_articulos.cod_nab
FROM intb00001 a,intb00002 b
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.cod_n = b.cod_n AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.cod_grupo = b.cod_grupo AND
a.cod_tipo = b.cod_tipo AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,m_articulos.cod_nab,
articulos.unidad_med ATTRIBUTE(CYAN)
END IF
IF ordenes.tipo = "02" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM iptb00002 a
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,articulos.unidad_med ATTRIBUTE(CYAN)
END IF
IF ordenes.tipo = "03" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,articulos.unidad_med
FROM irtb00002 a
WHERE a.cod_n = arr_ordenes[curr].cod_n AND
a.cod_grupo =arr_ordenes[curr].cod_grupo AND
a.cod_tipo = arr_ordenes[curr].cod_tipo AND
a.cod_sec = arr_ordenes[curr].cod_sec AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
LET arr_ordenes[curr].cod_n = NULL
LET arr_ordenes[curr].cod_grupo = NULL
LET arr_ordenes[curr].cod_tipo = NULL
LET arr_ordenes[curr].cod_sec = NULL
NEXT FIELD cod_n
END IF
LET descrip = articulos.descrip_esp CLIPPED
DISPLAY BY NAME descrip,articulos.unidad_med ATTRIBUTE(CYAN)
END IF
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 INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
DELETE FROM cotb00014 WHERE num_oc = ordenes.num_oc
INSERT INTO cotb00014 VALUES(ordenes.*,flete1.valor,flete1.ot_valor,
null,null,user,current,null,null)
DISPLAY BY NAME ordenes.num_oc
DELETE FROM cotb00015 WHERE num_oc = ordenes.num_oc
FOR idx = 1 TO arr_count()
IF arr_ordenes[idx].cod_n is not null 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,user,current,null,null)
END IF
END FOR
LET numero_msg = 1
CALL msg(numero_msg)
COMMAND KEY ("N") "aNular"
# Actualizacion de la eliminacion logica de las tablas que intervienen el la
# orden de compras
UPDATE cotb00014 set status_t = "N",
us_mod = user,
fech_mod = current
WHERE @num_oc = ordenes.num_oc and
@tipo = ordenes.tipo
UPDATE cotb00015 set status_t = "N",
us_mod = user,
fech_mod = current
WHERE @num_oc = ordenes.num_oc and
@tipo = ordenes.tipo
UPDATE cotb00029 set status_t = "N",
us_mod = user,
fech_mod = current
WHERE @num_oc = ordenes.num_oc AND
@tipo = ordenes.tipo
LET numero_msg = 39
CALL msg(numero_msg)
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 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
IF ordenes.cod_sp = 23 THEN
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = ordenes.term_sp AND status_t is null
ELSE
SELECT descrip_ting INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = ordenes.term_sp AND status_t is null
END IF
LET nombre_mon = null
LET simb_mon = null
SELECT a.descrip_mon,a.simbolo INTO nombre_mon,simb_mon FROM cotb00031 a
WHERE a.cod_mon = cod_mon AND a.status_t is null
LET nombre_p = null
IF ordenes.cod_pt IS NOT NULL THEN
SELECT nom_pt INTO nombre_p FROM cotb00019
WHERE cod_pt = ordenes.cod_pt AND
status_t is null
END IF
IF ordenes.via = "01" THEN
LET nom_via = "MARITIMA"
END IF
IF ordenes.via = "02" THEN
LET nom_via = "AEREA"
END IF
IF ordenes.via = "03" THEN
LET nom_via = "TERRESTRE"
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 busca_terminos()
OPEN WINDOW busqueda AT 10,10 WITH FORM "cofmwd008"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last -1)
CONSTRUCT criterio ON cotb00024.term_sp
FROM cotb00024.term_sp
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
IF ordenes.tipo = "01" THEN
LET selec = "SELECT term_sp,descrip_term FROM cotb00024 ",
"WHERE status_t is null AND ",criterio clipped,
"ORDER BY 1 "
ELSE
LET selec = "SELECT term_sp,descrip_ting FROM cotb00024 ",
"WHERE status_t is null AND ",criterio clipped,
"ORDER BY 1 "
END IF
PREPARE localiza FROM selec
DECLARE pagar CURSOR FOR localiza
LET idx = 1
FOREACH pagar INTO termino_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET term_pago_wd[idx].term_sp = termino_wd[idx].term_sp
LET term_pago_wd[idx].descrip_term = termino_wd[idx].descrip_term clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY term_pago_wd TO consart.*
LET curr1 = arr_curr()
LET ordenes.term_sp = term_pago_wd[curr1].term_sp
LET pagos.descrip_term = term_pago_wd[curr1].descrip_term
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION busca_puertos()
OPEN WINDOW busqueda_p AT 10,10 WITH FORM "cofmwd010"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last -1)
CONSTRUCT criterio ON cotb00019.nom_pt
FROM cotb00019.nom_pt
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec = "SELECT cod_pt,nom_pt FROM cotb00019 ",
" WHERE ",
" status_t is null AND ",
criterio clipped,
"ORDER BY 1 "
PREPARE localiza_p FROM selec
DECLARE puerto CURSOR FOR localiza_p
LET idx = 1
FOREACH puerto INTO puerto_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET puertos_wd[idx].cod_pt = puerto_wd[idx].cod_pt
LET puertos_wd[idx].nom_pt = puerto_wd[idx].nom_pt clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY puertos_wd TO consart.*
LET curr1 = arr_curr()
IF identifica = "O" THEN
LET puertos.cod_pt = puertos_wd[curr1].cod_pt
LET puertos.nom_pt = puertos_wd[curr1].nom_pt
END IF
LET nombre_p = puertos_wd[curr1].nom_pt
CLOSE WINDOW busqueda_p
END FUNCTION
FUNCTION busca_monedas()
OPEN WINDOW busqueda_mon AT 10,10 WITH FORM "cofmwd013"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last -1)
CONSTRUCT criterio ON a.cod_mon FROM cod_mon
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec = "SELECT a.cod_mon,a.descrip_mon FROM cotb00031 a ",
" WHERE a.status_t is null AND ",
criterio clipped," ORDER BY 1 "
PREPARE localiza_mon FROM selec
DECLARE moneda CURSOR FOR localiza_mon
LET idx = 1
FOREACH moneda INTO monedas_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET monedas_wd[idx].cod_mon = monedas_wd[idx].cod_mon
LET monedas_wd[idx].nombre_mon = monedas_wd[idx].nombre_mon clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY monedas_wd TO consart_mon.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GOTO sale
END IF
LET curr1 = arr_curr()
IF identifica = "O" THEN
LET monedas.cod_mon = monedas_wd[curr1].cod_mon
LET nombre_mon = monedas_wd[curr1].nombre_mon
END IF
LET cod_mon = monedas_wd[curr1].cod_mon
LET nombre_mon = monedas_wd[curr1].nombre_mon
LABEL sale:
CLOSE WINDOW busqueda_mon
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,USER,CURRENT,
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
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 comp_off, normal
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 COLUMN 1, negrillas_on,"TERMS: ",negrillas_off,doce,
pagos.descrip_term
PRINT COLUMN 1, negrillas_on,
"----------------------------------------------------------------------------------",
"------------------"
PRINT COLUMN 8, "QUANTITY",
COLUMN 17, "DESCRIPCION / DESCRIPCION ",
COLUMN 75, "UNIT PRICE",
COLUMN 95, "TOTAL"
PRINT COLUMN 8, "CANTIDAD",
COLUMN 75, "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 = "01" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,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 = "03" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,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 = "02" THEN
SELECT a.descrip_esp,a.unidad_med
INTO articulos.descrip_esp,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
LET descripcion = articulos.descrip_esp CLIPPED
LET descripcion = descripcion CLIPPED
PRINT COLUMN 1, x.cantidad USING "###,###,###.##",
COLUMN 17, x.cod_n USING "&","-",
x.cod_grupo USING "&","-",
x.cod_tipo USING "&&","-",x.cod_sec USING "&&&",
" ",articulos.unidad_med," ",
descripcion[1,40],
COLUMN 70, x.precio USING "###,###,###.###",
COLUMN 85, 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
LET total = total + x.valor
AFTER GROUP OF x.num_oc
PRINT COLUMN 88, "--------------"
PRINT COLUMN 40, "FOB ",desc1 ,
COLUMN 88, flete1.total_b USING "###,###,###.##"
IF flete1.valor IS NOT NULL AND flete1.valor > 0 THEN
PRINT COLUMN 40, "FREIGHT ",desc2 CLIPPED,
COLUMN 88, 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 88, flete1.ot_valor USING "###,###,###.##"
END IF
PRINT COLUMN 88, "--------------"
PRINT COLUMN 40, "C&F ",desc4 ,
COLUMN 64, simb_mon ,
COLUMN 88, flete1.total_1 USING "###,###,###.##"
PRINT COLUMN 88, "=============="
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 articulos.descrip_esp,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
END FUNCTION
FUNCTION busca_req()
OPEN WINDOW busqueda11 AT 10,3 WITH FORM "cofmwd019"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
LET selec =
"SELECT UNIQUE 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 1 "
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)
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 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
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
WITHOUT DEFAULTS
BEFORE FIELD ship_to
LET notas.ship_to = p_companias.nombre CLIPPED
DISPLAY BY NAME notas.ship_to
BEFORE FIELD valor
IF flete1.valor IS NULL THEN
LET flete1.valor = 0
END IF
{
Esto se puso en comentario porque el usuario desea cargarle otros gastos a
las ordenes de los suplidores locales (Laura fue el usuario. Fecha: 9/2/96
IF ordenes.cod_sp = 23 THEN
EXIT INPUT
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 INPUT
IF int_flag THEN
EXIT INPUT
END IF
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
LET flete1.total_1 = flete1.total_b + flete1.valor + flete1.ot_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
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,USER,CURRENT,
NULL,NULL)
LABEL salir:
CLOSE WINDOW apl1_notas
END FUNCTION