jpegueroandClaude Sonnet 5.5
83fffcd31f
ccprmt001/003/005 leen cctb00003 por tipo_doc esperando una sola fila. En SQL Server un SELECT INTO que devuelve varias filas da -284 (en Informix tomaba la primera). Al dar de alta un rango, ccprmt002 insertaba una fila PG por vendedor y, con ella, nadie podia registrar recibos. Ahora solo crea la fila si no existe ninguna PG. Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>
539 lines
18 KiB
Plaintext
539 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)
|
|
DEFINE n_pg INTEGER
|
|
## 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) RETURNING bandera
|
|
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
|
|
-- G6: el contador de recibos PG es uno solo (ccprmt001/003/005 lo leen por tipo_doc);
|
|
-- crear otra fila por vendedor hace que esos programas fallen con -284
|
|
LET n_pg = 0
|
|
SELECT COUNT(*) INTO n_pg FROM cctb00003 WHERE tipo_doc = "PG"
|
|
IF n_pg = 0 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()
|
|
DEFINE ult_rec INTEGER
|
|
## Aqui se prepara para la captura del criterio de seleccion
|
|
#WHENEVER ERROR CONTINUE
|
|
CONSTRUCT criterio ON fecha,sec_vend,sec_de,sec_a
|
|
FROM formonly.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 ult_rec = relacion.sec_de - 1
|
|
UPDATE cctb00003 SET ult_recibo = ult_rec
|
|
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
|
|
IF sqlca.sqlerrd[3] = 0 THEN
|
|
LET numero_msg = 3
|
|
ELSE
|
|
LET numero_msg = 39
|
|
END IF
|
|
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
|