jsoto/MBS
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
282c4ce7fa00ecde332b6d3c8800cf938880f1e6
MBS/PROYECTO/PRDIR/prprmt006.4gl
T
jpegueroandClaude Sonnet 5.5 0f48fc5afc Bloqueados: enlazan prprmt006, ipprmt044 y lqprrp009 (licencia Genero activa) 
- lqprrp009: se quita la copia local de defecto(); msgrp000 (restaurado por
  Johnny el 16/10) ya la trae y duplicaba (-6203).
- prprmt006: se anulan las dos llamadas a pantalla() (encabezado de la
  pantalla de texto antigua, no existe en el proyecto y los demas programas
  de PRODUCCION no la usan) y se pone titulo de ventana.
- ipprmt044: fotos.4gl ahora incluye ctramo() y cseccion() (copiadas de
  otrodir/tramos.4gl y secciones.4gl) porque importar FUNCIONES_IR completa
  mete modulos de Repuestos que chocan.
- ipdir/ipautorizareq.4gl: IMPORT FGL greruntime. msgrp000 importa ese
  paquete y libgre.42m tambien define fgl_report_*, por lo que cualquier
  modulo de libreria que los llamara sin importar quedaba ambiguo (-8401)
  cuando el programa lo usaba (solo ipprmt044). Verificado: las 34
  aplicaciones que usan FUNCIONES_IP enlazan, salvo ipprmt002 e ipprrp052
  que siguen con el problema conocido de columnas de iptb00002 en el
  esquema.

Pendiente: probar funcionalmente estos programas.

Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
2026-10-19 13:11:45 -04:00

860 lines
28 KiB
Plaintext
Raw Blame History

{
------------------------------------------------------------------
PROGRAMA : PRPRMT006
OBJETIVO : Matenimiento Ordenes Produccion
PROGRAMADOR : JUAN F. SOTO
FECHA REALIZACION : MARZO 09, 1998
------------------------------------------------------------------
}
GLOBALS "prprgb000.4gl"
DEFINE arrprtb08 DYNAMIC ARRAY OF RECORD
cod_n_c LIKE prtb00008.cod_n,
cod_grupo_c LIKE prtb00008.cod_grupo,
cod_tipo_c LIKE prtb00008.cod_tipo,
cod_sec_c LIKE prtb00008.cod_sec,
cantidad_c LIKE prtb00008.cantidad,
descrip_esp_c LIKE intb00001.descrip_esp,
unidad_c LIKE intb00001.unidad_med
END RECORD
DEFINE nombre LIKE vetb00004.nombre,
descrip_esp_c,descrip_esp LIKE iptb00002.descrip_esp,
unidad LIKE iptb00002.unidad_med,
unidad_c LIKE intb00001.unidad_med,
descrip CHAR(20),
esta,opt4 CHAR(1),
nombre_vend,nombres,apellidos CHAR(40)
DEFINE numero_oc INTEGER
DEFINE datos_mt ARRAY[200] OF RECORD
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descrip_esp CHAR(30),
unidad_med CHAR(3)
END RECORD
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT to "smarmotech" USER usuarios USING clave
CALL prprmt006()
END MAIN
FUNCTION prprmt006()
# WHENEVER ERROR CONTINUE
CLEAR SCREEN
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
# (pantalla() es el encabezado de la pantalla de texto antigua; no aplica en GUI)
OPEN FORM ctfmmt006 FROM "prfmmt006"
DISPLAY FORM ctfmmt006
CALL ui.Window.getCurrent().setText("Ordenes de Produccion")
# (pantalla() es el encabezado de la pantalla de texto antigua; no aplica en GUI)
DISPLAY "prprmt006" AT 4,3
DISPLAY "Ordenes De Produccion" AT 6,32
MENU "OPCIONES"
COMMAND "Adicionar"
"<Esc> Adiciona Registro <Supr> Cancela Operacion"
LET int_flag = FALSE
CLEAR FORM
CALL prpcad006()
COMMAND "Consultar"
LET INT_FLAG = FALSE
CALL prpcmf006()
COMMAND "Salir" "Retorna Menu Anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION prpcad006()
## Captura los datos que va a contener el registro
LET int_flag = false
SELECT MAX(a.num_oc) INTO prtb07.num_oc FROM prtb00007 a
LET prtb07.num_oc = prtb07.num_oc + 1
INPUT BY NAME prtb07.num_oc THRU prtb07.cantidad WITHOUT DEFAULTS
ON KEY(CONTROL-W)
CASE
WHEN INFIELD(cod_n)
# CALL busca_pt()
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
DISPLAY BY NAME prtb07.cod_n,prtb07.cod_grupo,prtb07.cod_tipo,prtb07.cod_sec
ATTRIBUTE (BLUE)
EXIT CASE
WHEN INFIELD(cod_grupo)
# CALL busca_pt()
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
DISPLAY BY NAME prtb07.cod_n,prtb07.cod_grupo,prtb07.cod_tipo,prtb07.cod_sec
ATTRIBUTE (BLUE)
EXIT CASE
WHEN INFIELD(cod_tipo)
# CALL busca_pt()
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
DISPLAY BY NAME prtb07.cod_n,prtb07.cod_grupo,prtb07.cod_tipo,prtb07.cod_sec
ATTRIBUTE (BLUE)
EXIT CASE
WHEN INFIELD(cod_sec)
# CALL busca_pt()
IF int_flag THEN
LET int_flag = FALSE
RETURN
END IF
DISPLAY BY NAME prtb07.cod_n,prtb07.cod_grupo,prtb07.cod_tipo,prtb07.cod_sec
ATTRIBUTE (BLUE)
EXIT CASE
WHEN INFIELD(sec_vend)
CALL vendedores()
DISPLAY BY NAME prtb07.sec_vend,nombre_vend ATTRIBUTE(BLUE)
EXIT CASE
WHEN INFIELD (tipo_cliente)
CALL busca_cliente()
DISPLAY BY NAME prtb07.tipo_cliente,prtb07.sec_cliente,
nombre ATTRIBUTE(BLUE)
EXIT CASE
WHEN INFIELD (sec_cliente)
CALL busca_cliente()
DISPLAY BY NAME prtb07.tipo_cliente,prtb07.sec_cliente,
nombre ATTRIBUTE(BLUE)
EXIT CASE
END CASE
BEFORE FIELD fecha_termina
LET prtb07.fecha_termina = prtb07.fecha + 15
DISPLAY BY NAME prtb07.fecha_termina
AFTER FIELD fecha_termina
IF prtb07.fecha_termina IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD fecha_termina
END IF
IF prtb07.fecha_termina < prtb07.fecha THEN
LET numero_msg =51
CALL msg(numero_msg)
NEXT FIELD fecha_termina
END IF
AFTER FIELD orden_pedido
IF prtb07.orden_pedido IS NOT NULL AND prtb07.orden_pedido != 0 THEN
SELECT UNIQUE a.num_oc
FROM prtb00012 a
WHERE a.num_oc = prtb07.orden_pedido
IF STATUS = NOTFOUND THEN
LET numero_msg =3
CALL msg(numero_msg)
NEXT FIELD orden_pedido
END IF
END IF
AFTER FIELD sec_vend
IF prtb07.sec_vend IS NOT NULL THEN
SELECT a.nom1_emp,a.apell1_emp INTO nombres,apellidos
FROM adtb00003 a
WHERE a.num_emp = prtb07.sec_vend
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD sec_vend
END IF
LET nombre_vend = nombres CLIPPED," ",apellidos CLIPPED
DISPLAY BY NAME nombre_vend ATTRIBUTE(BLUE)
END IF
BEFORE FIELD fecha
LET prtb07.fecha = TODAY
DISPLAY BY NAME prtb07.fecha ATTRIBUTE(BLUE)
AFTER FIELD fecha
IF prtb07.fecha > TODAY THEN
LET numero_msg = 189
CALL msg(numero_msg)
NEXT FIELD fecha
END IF
AFTER FIELD sec_cliente
SELECT a.nombre INTO nombre
FROM vetb00004 a
WHERE a.tipo_cliente = prtb07.tipo_cliente AND
a.sec_cliente = prtb07.sec_cliente AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
DISPLAY BY NAME nombre ATTRIBUTE(BLUE)
AFTER FIELD cod_n
SELECT a.producto INTO descrip
FROM iptb00020 a
WHERE a.cod_n = prtb07.cod_n
DISPLAY BY NAME descrip ATTRIBUTE(BLUE)
AFTER FIELD cod_sec
SELECT a.descrip_esp,a.unidad_med INTO descrip_esp,unidad
FROM iptb00002 a
WHERE a.cod_n = prtb07.cod_n AND
a.cod_grupo = prtb07.cod_grupo AND
a.cod_tipo = prtb07.cod_tipo AND
a.cod_sec = prtb07.cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME unidad,descrip_esp ATTRIBUTE(BLUE)
SELECT UNIQUE a.num_oc FROM prtb00007 a
WHERE a.num_oc = prtb07.num_oc AND
a.cod_n = prtb07.cod_n AND
a.cod_grupo = prtb07.cod_grupo AND
a.cod_tipo = prtb07.cod_tipo AND
a.cod_sec = prtb07.cod_sec
IF STATUS != NOTFOUND THEN
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD num_oc
END IF
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
SELECT a.descrip_esp INTO descrip_esp
FROM iptb00002 a
WHERE a.cod_n = prtb07.cod_n AND
a.cod_grupo = prtb07.cod_grupo AND
a.cod_tipo = prtb07.cod_tipo AND
a.cod_sec = prtb07.cod_sec
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n
END IF
DISPLAY BY NAME unidad,descrip_esp ATTRIBUTE(BLUE)
SELECT UNIQUE a.num_oc FROM prtb00007 a
WHERE a.num_oc = prtb07.num_oc AND
a.cod_n = prtb07.cod_n AND
a.cod_grupo = prtb07.cod_grupo AND
a.cod_tipo = prtb07.cod_tipo AND
a.cod_sec = prtb07.cod_sec
IF STATUS != NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD num_oc
END IF
SELECT a.nombre INTO nombre
FROM vetb00004 a
WHERE a.tipo_cliente = prtb07.tipo_cliente AND
a.sec_cliente = prtb07.sec_cliente AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD tipo_cliente
END IF
DISPLAY BY NAME descrip_esp,nombre ATTRIBUTE(BLUE)
END INPUT
{ ESTE QUERY ES PARA BUSCAR LA COMPOSICION DE LOS PRODUCTOS
DECLARE buscame CURSOR FOR
SELECT UNIQUE a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec
FROM prtb00008 a,prtb00007 b
WHERE b.cod_n = prtb07.cod_n AND
b.cod_grupo = prtb07.cod_grupo AND
b.cod_tipo = prtb07.cod_tipo AND
b.cod_sec = prtb07.cod_sec AND
a.num_oc = b.num_oc
LET idx = 1
FOREACH buscame INTO arrprtb08[idx].*
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
}
INPUT ARRAY arrprtb08 FROM s_orden.*
ON KEY(CONTROL-W)
CALL busca_material()
BEFORE ROW
LET curr = arr_curr()
LET scr_l = scr_line()
AFTER FIELD cod_sec_c
LET descrip_esp_c = NULL
IF arrprtb08[curr].cod_sec_c IS NOT NULL THEN
SELECT a.descrip_esp,a.unidad_med INTO descrip_esp_c,unidad_c
FROM intb00001 a
WHERE a.cod_n = arrprtb08[curr].cod_n_c AND
a.cod_grupo = arrprtb08[curr].cod_grupo_c AND
a.cod_tipo = arrprtb08[curr].cod_tipo_c AND
a.cod_sec = arrprtb08[curr].cod_sec_c AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_n_c
END IF
END IF
LET arrprtb08[curr].descrip_esp_c = descrip_esp_c
LET arrprtb08[curr].unidad_c = unidad_c
DISPLAY arrprtb08[curr].descrip_esp_c TO s_orden[scr_l].descrip_esp_c
ATTRIBUTE(BLUE)
DISPLAY arrprtb08[curr].unidad_c TO s_orden[scr_l].unidad_c
ATTRIBUTE(BLUE)
AFTER FIELD cantidad_c
IF arrprtb08[curr].cod_n_c IS NOT NULL THEN
IF arrprtb08[curr].cantidad_c IS NULL THEN
LET numero_msg = 16
CALL msg(numero_msg)
NEXT FIELD cantidad_c
END IF
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
PROMPT "TODA LA INFORMACION ESTA CORRECTA? " FOR opt4
LET opt4 = upshift(opt4)
IF opt4 = "S" THEN
START REPORT ordenes TO "c:\\archivo"
INSERT INTO prtb00007 VALUES (prtb07.*)
UPDATE prtb00007 set us_crea = SUSER_SNAME(),
fech_crea = current
WHERE num_oc = prtb07.num_oc
INSERT INTO prtb00009 VALUES (prtb07.num_oc,prtb07.fecha,"S","INICIO ORDEN...",NULL,SUSER_SNAME(),CURRENT,NULL,NULL)
# SE ESTA VALIDANDO EL PRODUCTO TERMINADO EN EL CODIGO DE LA MATERIA PRIMA
# PARA CUANDO LA ORDEN SEA PARA PRODUCTOS IMPORTADOS QUE NO TIENEN COMPOSICION
IF arrprtb08[1].cod_n_c IS NULL THEN
LET arrprtb08[1].cod_n_c = prtb07.cod_n
LET arrprtb08[1].cod_grupo_c = prtb07.cod_grupo
LET arrprtb08[1].cod_tipo_c = prtb07.cod_tipo
LET arrprtb08[1].cod_sec_c = prtb07.cod_Sec
OUTPUT TO REPORT ordenes(prtb07.num_oc,arrprtb08[idx].*)
END IF
FOR idx = 1 TO arr_count()
IF arrprtb08[idx].cod_n_c IS NOT NULL THEN
INSERT INTO prtb00008 VALUES (prtb07.num_oc,
arrprtb08[idx].cod_n_c,
arrprtb08[idx].cod_grupo_c,
arrprtb08[idx].cod_tipo_c,
arrprtb08[idx].cod_sec_c,
arrprtb08[idx].cantidad_c,
SUSER_SNAME(),current,null,null)
OUTPUT TO REPORT ordenes(prtb07.num_oc,arrprtb08[idx].*)
END IF
END FOR
FINISH REPORT ordenes
RUN "TYPE c:\\archivo > LPT3"
LET numero_msg = 1
CALL msg(numero_msg)
END IF
CLEAR FORM
END FUNCTION
FUNCTION prpcmf006()
## Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON a.num_oc,a.tipo_cliente,a.sec_cliente
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
RETURN
END IF
LET SELEC = " SELECT UNIQUE a.* FROM prtb00007 a ",
" WHERE ",criterio CLIPPED, " AND a.status_t IS NULL"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO prtb07.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
DISPLAY BY NAME prtb07.num_oc THRU prtb07.cantidad ATTRIBUTE(BLUE)
LET numero_oc = prtb07.num_oc
CALL busca_detalle()
CALL busca_clientem()
CALL busca_vendm()
CALL busca_product()
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proprtb07.mo registro encontrado"
FETCH NEXT datos INTO prtb07.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
DISPLAY BY NAME prtb07.num_oc THRU prtb07.cantidad ATTRIBUTE(BLUE)
LET numero_oc = prtb07.num_oc
CALL limpia()
CALL busca_detalle()
CALL busca_clientem()
CALL busca_vendm()
CALL busca_product()
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO prtb07.*
IF STATUS = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
DISPLAY BY NAME prtb07.num_oc THRU prtb07.cantidad ATTRIBUTE(BLUE)
LET numero_oc = prtb07.num_oc
CALL limpia()
CALL busca_detalle()
CALL busca_clientem()
CALL busca_vendm()
CALL busca_product()
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO prtb07.*
DISPLAY BY NAME prtb07.num_oc THRU prtb07.cantidad ATTRIBUTE(BLUE)
LET numero_oc = prtb07.num_oc
CALL limpia()
CALL busca_detalle()
CALL busca_clientem()
CALL busca_vendm()
CALL busca_product()
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO prtb07.*
DISPLAY BY NAME prtb07.num_oc THRU prtb07.cantidad
ATTRIBUTE(BLUE)
LET numero_oc = prtb07.num_oc
CALL limpia()
CALL busca_detalle()
CALL busca_clientem()
CALL busca_vendm()
CALL busca_product()
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND KEY ("N") "aNular"
PROMPT "Esta seguro?" FOR esta
LET esta = UPSHIFT(esta)
IF esta = "S" THEN
UPDATE prtb00007 set status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = current
WHERE num_oc = prtb07.num_oc
UPDATE prtb00009 set status_t = "E",
us_mod = SUSER_SNAME(),
fech_mod = current
WHERE num_oc = prtb07.num_oc
LET numero_msg = 39
CALL msg(numero_msg)
END IF
COMMAND "Retornar"
"Retorna al menu anterior"
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_pt()
OPEN WINDOW busqueda AT 7,12 WITH FORM "vefmwd003"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.descrip_esp FROM descrip_esp
LET selec2 =
"SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp ",
"FROM iptb00002 a ",
"WHERE a.status_t is null AND ",criterio clipped," ORDER BY 5 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO sale9
END IF
PREPARE busca_pila FROM selec2
DECLARE buscar_pila CURSOR FOR busca_pila
LET idx= 1
FOREACH buscar_pila INTO pilas[idx].*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET idx= idx+ 1
END FOREACH
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GOTO sale9
END IF
CALL set_count(idx -1)
MESSAGE " <Esc> Selecciona Producto Terminado donde esta el cursor"
DISPLAY ARRAY pilas TO s_pilas.*
LET curr1 = arr_curr()
LET prtb07.cod_n = pilas[curr1].cod_n
LET prtb07.cod_grupo = pilas[curr1].cod_grupo
LET prtb07.cod_tipo = pilas[curr1].cod_tipo
LET prtb07.cod_sec = pilas[curr1].cod_sec
LET descrip_esp = pilas[curr1].descrip_esp
LABEL sale9:
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION limpia()
FOR idx = 1 TO 10
LET arrprtb08[idx].cod_n_c = null
LET arrprtb08[idx].cod_grupo_c = null
LET arrprtb08[idx].cod_tipo_c = null
LET arrprtb08[idx].cod_sec_c = null
LET arrprtb08[idx].unidad_c = null
LET arrprtb08[idx].cantidad_c = null
LET arrprtb08[idx].descrip_esp_c = null
END FOR
FOR idx = 1 TO 5
DISPLAY arrprtb08[idx].cod_n_c TO s_orden[idx].cod_n_c
DISPLAY arrprtb08[idx].cod_grupo_c TO s_orden[idx].cod_grupo_c
DISPLAY arrprtb08[idx].cod_tipo_c TO s_orden[idx].cod_tipo_c
DISPLAY arrprtb08[idx].cod_sec_c TO s_orden[idx].cod_sec_c
DISPLAY arrprtb08[idx].cantidad_c TO s_orden[idx].cantidad_c
DISPLAY arrprtb08[idx].descrip_esp_c TO s_orden[idx].descrip_esp_c
ATTRIBUTE(BLUE)
DISPLAY arrprtb08[idx].unidad_c TO s_orden[idx].unidad_c
ATTRIBUTE(BLUE)
END FOR
END FUNCTION
FUNCTION busca_detalle()
DECLARE busca_d CURSOR FOR
SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.cantidad FROM prtb00008 a
WHERE a.num_oc = numero_oc
LET idx = 1
FOREACH busca_d INTO arrprtb08[idx].*
SELECT a.descrip_esp,a.unidad_med INTO descrip_esp_c,unidad_c
FROM intb00001 a
WHERE a.cod_n = arrprtb08[idx].cod_n_c AND
a.cod_grupo = arrprtb08[idx].cod_grupo_c AND
a.cod_tipo = arrprtb08[idx].cod_tipo_c AND
a.cod_sec = arrprtb08[idx].cod_sec_c AND
a.status_t IS NULL
IF idx > 5 THEN
EXIT FOREACH
END IF
LET arrprtb08[idx].descrip_esp_c = descrip_esp_c
LET arrprtb08[idx].unidad_c = unidad_c
DISPLAY arrprtb08[idx].cod_n_c TO s_orden[idx].cod_n_c
DISPLAY arrprtb08[idx].cod_grupo_c TO s_orden[idx].cod_grupo_c
DISPLAY arrprtb08[idx].cod_tipo_c TO s_orden[idx].cod_tipo_c
DISPLAY arrprtb08[idx].cod_sec_c TO s_orden[idx].cod_sec_c
DISPLAY arrprtb08[idx].cantidad_c TO s_orden[idx].cantidad_c
DISPLAY arrprtb08[idx].descrip_esp_c TO s_orden[idx].descrip_esp_c
ATTRIBUTE(BLUE)
DISPLAY arrprtb08[idx].unidad_c TO s_orden[idx].unidad_c
ATTRIBUTE(BLUE)
LET idx = idx + 1
END FOREACH
END FUNCTION
REPORT ordenes(xnumero,z)
DEFINE z RECORD
cod_n_c LIKE prtb00008.cod_n,
cod_grupo_c LIKE prtb00008.cod_grupo,
cod_tipo_c LIKE prtb00008.cod_tipo,
cod_sec_c LIKE prtb00008.cod_sec,
cantidad_c LIKE prtb00008.cantidad ,
descrip_esp_c LIKE intb00001.descrip_esp,
unidad_c LIKE intb00001.unidad_med
END RECORD,
i,xnumero INTEGER,
negrillas_on,negrillas_off,doble CHAR(2)
OUTPUT
LEFT MARGIN 0
ORDER BY xnumero
FORMAT
PAGE HEADER
LET negrillas_on = ASCII 27, ASCII 69
LET negrillas_off = ASCII 27, ASCII 70
LET doble = ASCII 14
LET l = (80 - LENGTH(p_compania.nombre CLIPPED))/2
PRINT COLUMN l, p_compania.nombre CLIPPED,
COLUMN 70, TODAY USING "DD/MM/YY"
LET l = (80 - LENGTH("ORDEN DE PRODUCCION"))/2
PRINT COLUMN l, "ORDEN DE PRODUCCION",
COLUMN 70, TIME
PRINT COLUMN 1, "NO. ORDEN: ",doble_on,xnumero USING "<<<<<<"
PRINT COLUMN 1, "FECHA : ",negrillas_on,prtb07.fecha
USING "DD/MM/YY",negrillas_off
PRINT COLUMN 1, "VENDEDOR : ",negrillas_on,prtb07.sec_vend USING "<<<<",
" ",nombre_vend,negrillas_off
PRINT COLUMN 1, "CLIENTE : ",negrillas_on,prtb07.tipo_cliente USING "<<",
prtb07.sec_cliente
USING "<<<<"," "," ",
nombre,negrillas_off
PRINT COLUMN 1, "PRODUCTO : ",negrillas_on,prtb07.cod_n USING "&","-",
prtb07.cod_grupo USING "&","-",
prtb07.cod_tipo USING "&&","-",
prtb07.cod_sec
USING "&&&"," ",negrillas_off,descrip_esp," ",
unidad,negrillas_off
PRINT COLUMN 1, "CANTIDAD : ",negrillas_on, prtb07.cantidad USING "<<,<<<",
negrillas_off
FOR i = 1 TO 70
PRINT "-";
END FOR
PRINT "-"
PRINT "COMPOSICION PRODUCTO..."
FOR i = 1 TO 70
PRINT "-";
END FOR
PRINT "-"
ON EVERY ROW
PRINT COLUMN 1, z.cod_n_c USING "&","-",
z.cod_grupo_c USING "&","-",
z.cod_tipo_c USING "&&","-",
z.cod_sec_c USING "&&&","-",
" ",z.descrip_esp_c," ",z.unidad_c,
" ",z.cantidad_c USING "###,###.###"
PAGE TRAILER
PRINT COLUMN 10, "-------------------",
COLUMN 35, "-------------------"
PRINT COLUMN 13, "AUTORIZADO POR",
COLUMN 39, "REVISADO POR"
END REPORT
FUNCTION busca_material()
LET int_flag = FALSE
OPEN WINDOW material1 AT 10,9 WITH FORM "infmwd004"
ATTRIBUTE(BORDER,FORM LINE FIRST + 2)
CONSTRUCT criterio ON a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp,
a.unidad_med
FROM cod_n,cod_grupo,cod_tipo,cod_sec,descrip_esp,
unidad_med
LET selec = "SELECT a.cod_n,a.cod_grupo,a.cod_tipo,a.cod_sec,a.descrip_esp, ",
"a.unidad_med FROM intb00001 a ",
"WHERE a.status_t IS NULL AND ",criterio CLIPPED,
"ORDER BY 1,2,3,4"
PREPARE comando4 FROM selec
DECLARE comp4 CURSOR FOR comando4
LET idx = 1
FOREACH comp4 INTO datos_mt[idx].*
LET idx = idx + 1
END FOREACH
CALL SET_COUNT(idx - 1)
DISPLAY ARRAY datos_mt TO datos_mt1.*
LET idx = ARR_CURR()
CLOSE WINDOW material1
END FUNCTION
FUNCTION vendedores()
DEFINE descrip6 LIKE adtb00003.nom1_emp
OPEN WINDOW busqueda2 AT 7,12 WITH FORM "vefmwd001"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.nom1_emp FROM descrip6
LET selec2 = "SELECT UNIQUE a.num_emp,a.nom1_emp,a.apell1_emp ",
" FROM adtb00003 a,vetb00028 b",
" WHERE a.num_emp = b.sec_vend AND ",
"a.status_t is null AND ",
criterio clipped,
"ORDER BY 1 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_e
END IF
PREPARE busca_empleados FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_empleados CURSOR FOR busca_empleados
LET idx = 1
FOREACH buscar_empleados INTO arr_empleados[idx].*
IF status = NOTFOUND THEN
EXIT FOREACH
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET empleados[idx].cod_emp_sec = arr_empleados[idx].num_emp
LET empleados[idx].descrip6 =
arr_empleados[idx].nom1_emp clipped," ",arr_empleados[idx].apell1_emp clipped
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Empleado donde esta el cursor"
DISPLAY ARRAY empleados TO s_empleados.*
LET curr1 = scr_line()
LET prtb07.sec_vend = empleados[curr1].cod_emp_sec
LET nombre_vend = empleados[curr1].descrip6
LABEL salir_consulta_e:
CLOSE WINDOW busqueda2
END FUNCTION
FUNCTION busca_cliente()
OPEN WINDOW busqueda AT 7,12 WITH FORM "vefmwd002"
ATTRIBUTE (BORDER,FORM LINE FIRST + 2,COMMENT LINE LAST,MESSAGE LINE LAST)
LET int_flag = false
CONSTRUCT criterio ON a.nombre FROM nombre
LET selec2 = "SELECT a.tipo_cliente, a.sec_cliente, a.nombre ",
" FROM vetb00004 a",
" WHERE ",
"a.status_t is null AND ",
criterio clipped,
"ORDER BY 1,2 "
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
GO TO salir_consulta_c
END IF
PREPARE busca_clientes FROM selec2
IF status >= 0 THEN
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
END IF
ELSE
CALL integridad()
IF bandera = 1 THEN
LET bandera = 0
END IF
END IF
DECLARE buscar_clientes CURSOR FOR busca_clientes
LET idx = 1
FOREACH buscar_clientes INTO arr_clientes[idx].*
IF status = NOTFOUND THEN
EXIT FOREACH
END IF
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
EXIT FOREACH
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
MESSAGE " <Esc> Selecciona Cliente donde esta el cursor"
DISPLAY ARRAY arr_clientes TO s_clientes.*
LET curr1 = arr_curr()
LET prtb07.tipo_cliente = arr_clientes[curr1].tipo_cliente
LET prtb07.sec_cliente = arr_clientes[curr1].sec_cliente
LET nombre = arr_clientes[curr1].nombre
LABEL salir_consulta_c:
CLOSE WINDOW busqueda
END FUNCTION
FUNCTION busca_clientem()
SELECT a.nombre INTO nombre
FROM vetb00004 a
WHERE a.tipo_cliente = prtb07.tipo_cliente AND
a.sec_cliente = prtb07.sec_cliente AND
a.status_t IS NULL
DISPLAY BY NAME nombre ATTRIBUTE(BLUE)
END FUNCTION
FUNCTION busca_vendm()
IF prtb07.sec_vend IS NOT NULL THEN
SELECT a.nom1_emp,a.apell1_emp INTO nombres,apellidos
FROM adtb00003 a
WHERE a.num_emp = prtb07.sec_vend
LET nombre_vend = nombres CLIPPED," ",apellidos CLIPPED
DISPLAY BY NAME nombre_vend ATTRIBUTE(BLUE)
END IF
END FUNCTION
FUNCTION busca_product()
SELECT a.descrip_esp,a.unidad_med INTO descrip_esp,unidad
FROM iptb00002 a
WHERE a.cod_n = prtb07.cod_n AND
a.cod_grupo = prtb07.cod_grupo AND
a.cod_tipo = prtb07.cod_tipo AND
a.cod_sec = prtb07.cod_sec
DISPLAY BY NAME unidad,descrip_esp ATTRIBUTE(BLUE)
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink