532 lines
18 KiB
Plaintext
532 lines
18 KiB
Plaintext
{
|
|
------------------------------------------------------------------
|
|
PROGRAMA : CCPRMT002
|
|
OBJETIVO : Capturar, Modificar, Eliminar registros de la
|
|
Tabla Recibos de pago de los vendedores.
|
|
PROGRAMADOR : Ing. Juan Soto.
|
|
FECHA REALIZACION : Marzo 1997
|
|
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO ALEJO
|
|
------------------------------------------------------------------
|
|
}
|
|
GLOBALS "ccprgb000.4gl"
|
|
DEFINE ultimo RECORD LIKE cctb00003.*
|
|
DEFINE secu_de,secu_a INTEGER
|
|
MAIN
|
|
DEFER INTERRUPT
|
|
CALL ARG_VAL(1) RETURNING usuarios
|
|
CALL ARG_VAL(2) RETURNING clave
|
|
|
|
CONNECT to "smarmotech" USER usuarios USING clave
|
|
|
|
CALL ccprmt002()
|
|
END MAIN
|
|
FUNCTION ccprmt002()
|
|
CLEAR SCREEN
|
|
OPTIONS
|
|
FORM LINE 9,
|
|
ERROR LINE 23,
|
|
COMMENT LINE 21
|
|
|
|
OPEN FORM ccfmmt002 FROM "ccfmmt002"
|
|
DISPLAY FORM ccfmmt002
|
|
#CALL pantalla()
|
|
DISPLAY "ccprmt002" AT 4,3
|
|
DISPLAY "Asignacion de Recibos por Vendedor" AT 6,23
|
|
|
|
MENU "OPCIONES"
|
|
COMMAND "Adicionar"
|
|
"<Esc> Adiciona Registro <Delete> Cancela Operacion"
|
|
let int_flag = false
|
|
CLEAR FORM
|
|
let int_flag = false
|
|
CALL ccpcad002()
|
|
COMMAND "Consultar-modificar"
|
|
"<Esc> Realiza Busqueda <Delete> Cancela Operacion"
|
|
CALL ccpcmf002()
|
|
COMMAND "Salir" "Retorna Menu Anterior"
|
|
EXIT MENU
|
|
END MENU
|
|
END FUNCTION
|
|
|
|
FUNCTION ccpcad002()
|
|
|
|
DEFINE hoy CHAR(10)
|
|
## Captura los datos que va a contener el registro
|
|
# WHENEVER ERROR CONTINUE
|
|
|
|
LET hoy = today USING "dd/mm/yyyy"
|
|
INPUT BY NAME relacion.fecha,relacion.sec_vend,relacion.sec_de,
|
|
relacion.sec_a
|
|
|
|
ON KEY (CONTROL-W)
|
|
CASE
|
|
WHEN INFIELD (sec_vend)
|
|
CALL consulta_empleados()
|
|
|
|
LET relacion.sec_vend = transportista.sec_transp
|
|
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3 FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
DISPLAY BY NAME relacion.sec_vend ATTRIBUTE (BOLD)
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
|
|
NEXT FIELD sec_de
|
|
END CASE
|
|
|
|
## Verifica que el codigo no exista en el catalogo de relaciones. Si existe,
|
|
## entonces despliega los datos del registro existente.
|
|
BEFORE FIELD fecha
|
|
LET relacion.fecha = hoy
|
|
DISPLAY relacion.fecha TO fecha
|
|
|
|
AFTER FIELD fecha
|
|
IF relacion.fecha IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD fecha
|
|
END IF
|
|
LET hoy = relacion.fecha
|
|
|
|
LET p_fechas = relacion.fecha
|
|
CALL prd(p_fechas,usuarios)
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
NEXT FIELD fecha
|
|
END IF
|
|
|
|
AFTER FIELD sec_vend
|
|
IF relacion.sec_vend IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_vend
|
|
ELSE
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
IF status >= 0 THEN
|
|
IF STATUS = NOTFOUND THEN
|
|
LET numero_msg = 3
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_vend
|
|
END IF
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME nombre_emp
|
|
|
|
ELSE
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
END IF
|
|
|
|
AFTER FIELD sec_de
|
|
IF relacion.sec_de IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
SELECT unique sec_de FROM cctb00002
|
|
WHERE sec_de = relacion.sec_de
|
|
IF status != notfound THEN
|
|
LET numero_msg = 12
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
SELECT unique sec_de FROM cctb00002
|
|
WHERE sec_a = relacion.sec_de
|
|
IF status != notfound THEN
|
|
LET numero_msg = 12
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
SELECT max(@sec_de),max(@sec_a) FROM cctb00002
|
|
WHERE sec_vend = relacion.sec_vend
|
|
|
|
IF relacion.sec_de > secu_de and
|
|
relacion.sec_de < secu_a THEN
|
|
LET numero_msg = 239
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
AFTER FIELD sec_a
|
|
IF relacion.sec_a IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_a
|
|
END IF
|
|
SELECT unique sec_de FROM cctb00002
|
|
WHERE sec_a = relacion.sec_a
|
|
IF status != notfound THEN
|
|
LET numero_msg = 12
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_a
|
|
END IF
|
|
|
|
IF relacion.sec_de > relacion.sec_a THEN
|
|
LET numero_msg = 123
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
AFTER INPUT
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = FALSE
|
|
RETURN
|
|
END IF
|
|
|
|
IF relacion.sec_de IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
IF relacion.sec_de > relacion.sec_a THEN
|
|
LET numero_msg = 123
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
IF relacion.sec_a IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_a
|
|
END IF
|
|
SELECT *FROM cctb00003 WHERE sec_vend = relacion.sec_vend AND
|
|
tipo_doc = "PG"
|
|
IF status = notfound THEN
|
|
INSERT INTO cctb00003 (cod_vend,sec_vend,ult_recibo,us_crea,
|
|
fech_crea,tipo_doc)
|
|
VALUES (null,relacion.sec_vend,relacion.sec_de,
|
|
SUSER_SNAME(),GETDATE(),"PG")
|
|
END IF
|
|
|
|
INSERT INTO cctb00002 VALUES (relacion.fecha,null,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,null,
|
|
SUSER_SNAME(),GETDATE(),null,null)
|
|
|
|
LET relacion.sec_de = relacion.sec_de - 1
|
|
|
|
UPDATE cctb00003 SET ult_recibo = relacion.sec_de
|
|
WHERE sec_vend = relacion.sec_vend AND
|
|
tipo_doc = "PG"
|
|
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
|
|
LET numero_msg = 1
|
|
CALL msg(numero_msg)
|
|
CLEAR FORM
|
|
NEXT FIELD fecha
|
|
|
|
END INPUT
|
|
END FUNCTION
|
|
|
|
FUNCTION ccpcmf002()
|
|
## Aqui se prepara para la captura del criterio de seleccion
|
|
#WHENEVER ERROR CONTINUE
|
|
CONSTRUCT criterio ON fecha,sec_vend,sec_de,sec_a
|
|
FROM cctb00002.fecha,cctb00002.sec_vend,
|
|
cctb00002.sec_de,cctb00002.sec_a
|
|
|
|
IF int_flag THEN
|
|
LET numero_msg = 2
|
|
CALL msg(numero_msg)
|
|
LET int_flag = FALSE
|
|
RETURN
|
|
END IF
|
|
|
|
LET SELEC = " SELECT UNIQUE fecha,sec_vend,sec_de,sec_a ",
|
|
" FROM cctb00002 where ",
|
|
" 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 WITH HOLD FOR busca
|
|
OPEN datos
|
|
|
|
FETCH FIRST datos INTO relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a
|
|
|
|
IF status >= 0 THEN
|
|
IF STATUS = NOTFOUND THEN
|
|
LET numero_msg = 3
|
|
CALL msg(numero_msg)
|
|
RETURN
|
|
END IF
|
|
ELSE
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,nombre_emp
|
|
|
|
MENU "OPCIONES "
|
|
COMMAND "Siguiente"
|
|
"Presenta en pantalla el proximo registro encontrado"
|
|
FETCH NEXT datos INTO relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a
|
|
IF STATUS = NOTFOUND THEN
|
|
LET numero_msg = 4
|
|
CALL msg(numero_msg)
|
|
END IF
|
|
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,nombre_emp
|
|
|
|
COMMAND "Anterior"
|
|
"Presenta en pantalla el registro anterior encontrado"
|
|
FETCH PREVIOUS datos INTO relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a
|
|
IF STATUS = NOTFOUND THEN
|
|
LET numero_msg = 5
|
|
CALL msg(numero_msg)
|
|
END IF
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,nombre_emp
|
|
|
|
COMMAND "Primero"
|
|
"Presenta en pantalla el primer registro encontrado"
|
|
FETCH FIRST datos INTO relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,nombre_emp
|
|
LET numero_msg = 5
|
|
CALL msg(numero_msg)
|
|
|
|
COMMAND "Ultimo"
|
|
"Presenta en pantalla el ultimo registro encontrado"
|
|
FETCH LAST datos INTO relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a
|
|
SELECT nom1_emp,apell1_emp INTO descrip2,descrip3
|
|
FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME relacion.fecha,relacion.sec_vend,
|
|
relacion.sec_de,relacion.sec_a,nombre_emp
|
|
LET numero_msg = 4
|
|
CALL msg(numero_msg)
|
|
|
|
COMMAND "Escoger"
|
|
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
|
|
|
|
SELECT sec_vend,ult_recibo INTO ultimo.sec_vend,ultimo.ult_recibo
|
|
FROM cctb00003
|
|
WHERE sec_vend = relacion.sec_vend AND
|
|
tipo_doc = "PG"
|
|
IF ultimo.ult_recibo > relacion.sec_de THEN
|
|
LET numero_msg = 143
|
|
CALL msg(numero_msg)
|
|
RETURN
|
|
END IF
|
|
|
|
INPUT BY NAME relacion.sec_de,relacion.sec_a
|
|
WITHOUT DEFAULTS
|
|
ON KEY (CONTROL-W)
|
|
CASE
|
|
WHEN INFIELD (sec_vend)
|
|
CALL consulta_empleados()
|
|
|
|
LET relacion.sec_vend = transportista.sec_transp
|
|
|
|
SELECT nom1_emp,apell1_emp
|
|
INTO descrip2,descrip3 FROM adtb00003
|
|
WHERE num_emp = relacion.sec_vend
|
|
|
|
DISPLAY BY NAME relacion.sec_vend ATTRIBUTE (BOLD)
|
|
LET nombre_emp = descrip2 clipped," ",descrip3 clipped
|
|
DISPLAY BY NAME nombre_emp ATTRIBUTE (BOLD)
|
|
NEXT FIELD sec_de
|
|
END CASE
|
|
|
|
AFTER FIELD sec_de
|
|
IF relacion.sec_de IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
SELECT max(@sec_de),max(@sec_a) FROM cctb00002
|
|
WHERE sec_vend = relacion.sec_vend
|
|
|
|
IF relacion.sec_de > secu_de and
|
|
relacion.sec_de < secu_a THEN
|
|
LET numero_msg = 239
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
|
|
AFTER FIELD sec_a
|
|
IF relacion.sec_a IS NULL THEN
|
|
LET numero_msg = 16
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_a
|
|
END IF
|
|
|
|
IF relacion.sec_de > relacion.sec_a THEN
|
|
LET numero_msg = 123
|
|
CALL msg(numero_msg)
|
|
NEXT FIELD sec_de
|
|
END IF
|
|
EXIT INPUT
|
|
END INPUT
|
|
|
|
UPDATE cctb00002 SET sec_de = relacion.sec_de,
|
|
sec_a = relacion.sec_a,
|
|
us_mod = SUSER_SNAME(),
|
|
fech_mod = GETDATE()
|
|
WHERE sec_vend = relacion.sec_vend and
|
|
fecha = relacion.fecha
|
|
|
|
|
|
LET relacion.sec_de = relacion.sec_de - 1
|
|
UPDATE cctb00003 SET ult_recibo = relacion.sec_de
|
|
WHERE sec_vend = relacion.sec_vend AND
|
|
tipo_doc = "PG"
|
|
|
|
IF status < 0 THEN
|
|
CALL integridad()
|
|
IF bandera = 1 THEN
|
|
LET bandera = 0
|
|
RETURN
|
|
END IF
|
|
END IF
|
|
|
|
LET numero_msg = 13
|
|
CALL msg(numero_msg)
|
|
|
|
COMMAND KEY ("L") "eLiminar"
|
|
UPDATE cctb00002 SET status_t = "E",
|
|
us_mod = SUSER_SNAME(),
|
|
fech_mod = GETDATE()
|
|
WHERE sec_vend = relacion.sec_vend and
|
|
fecha = relacion.fecha and
|
|
sec_de = relacion.sec_de
|
|
|
|
LET numero_msg = 39
|
|
CALL msg(numero_msg)
|
|
|
|
COMMAND "Retornar"
|
|
"Retorna al menu anterior"
|
|
CLEAR FORM
|
|
EXIT MENU
|
|
END MENU
|
|
END FUNCTION
|
|
|
|
FUNCTION consulta_empleados()
|
|
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 num_emp,a.nom1_emp,a.apell1_emp ",
|
|
"FROM adtb00003 a",
|
|
"WHERE 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].num_emp = 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 = arr_curr()
|
|
|
|
LET transportista.sec_transp = empleados[curr1].num_emp
|
|
LET descrip6 = empleados[curr1].descrip6
|
|
|
|
LABEL salir_consulta_e:
|
|
CLOSE WINDOW busqueda2
|
|
|
|
END FUNCTION
|