Files
2026-09-22 20:38:51 -04:00

586 lines
18 KiB
Plaintext

{
------------------------------------------------------------------
PROGRAMA : COPRMT001
OBJETIVO : Capturar, Modificar, Eliminar registros de la
Tabla de Suplidores.
PROGRAMADOR : JUAN SOTO .
FECHA REALIZACION : Agosto 1997.
DIRECTOR PROYECTO : JOSE ALFREDO PAULINO
------------------------------------------------------------------
}
GLOBALS "coprgb000.4gl"
DEFINE cuenta_no varchar(30)
DEFINE descripcion_cuenta varchar(80)
MAIN
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
#LET usuarios="lsoto"
#LET clave="1234"
CONNECT to "decomarmol" USER usuarios USING clave
SELECT a.* INTO p_companias.* FROM companias a
CALL coprmt001()
END MAIN
FUNCTION coprmt001()
OPTIONS
FORM LINE 9,
ERROR LINE 23,
COMMENT LINE 21
OPEN FORM cofmmt001 FROM "cofmmt001"
DISPLAY FORM cofmmt001
MENU "OPCIONES"
ON ACTION Adicionar
LET selec = "SELECT a.razon_social,RTRIM(a.calle) + ' #'+RTRIM(a.no_local) + ' '+a.sector,a.telefono
FROM DGII.dbo.dgii_rnc a
WHERE a.rnc = ?"
PREPARE dgii FROM selec
CLEAR FORM
CALL copcad001()
ON ACTION Consultar_modificar
LET selec = "SELECT a.razon_social,RTRIM(a.calle) + ' #'+RTRIM(a.no_local) + ' '+a.sector,a.telefono
FROM DGII.dbo.dgii_rnc a
WHERE a.rnc = ?"
PREPARE dgii1 FROM selec
CALL copcmf001()
ON ACTION Salir
EXIT MENU
END MENU
END FUNCTION
FUNCTION copcad001()
DEFINE ultimo_codigo INTEGER
# Captura los datos que va a contener el registro
INITIALIZE suplidor.* TO NULL
INPUT BY NAME suplidor.tipo_doc,suplidor.rnc,
suplidor.cod_sp,suplidor.cod_sp_sec,suplidor.nom_sp,
suplidor.dir_sp,suplidor.ciu_sp,suplidor.cod_pais,
suplidor.tel_sp,suplidor.area_sp,suplidor.fax_sp,
suplidor.cont_sp,suplidor.term_sp,suplidor.cuenta_no
AFTER FIELD rnc
SELECT UNIQUE a.rnc FROM cotb00001 a
WHERE a.rnc=suplidor.rnc
IF status != NOTFOUND THEN
LET numero_msg = 502
CALL msg(numero_msg)
NEXT FIELD rnc
END IF
IF suplidor.rnc IS NOT NULL THEN
IF suplidor.tipo_doc = 'RNC' THEN
EXECUTE dgii INTO suplidor.nom_sp,suplidor.dir_sp,suplidor.tel_sp USING suplidor.rnc
DISPLAY BY NAME suplidor.nom_sp,suplidor.dir_sp,suplidor.tel_sp
END IF
END IF
ON KEY(CONTROL-W)
CALL busca_pais()
DISPLAY BY NAME paises.nom_pais,suplidor.cod_pais
# Verifica que el codigo del suplidor no exista. Si existe,
# entonces despliega los datos del registro existente.
AFTER FIELD cod_sp
IF suplidor.cod_sp IS NOT NULL THEN
SELECT MAX(cod_sp_sec) INTO ultimo_codigo
FROM cotb00001 a
WHERE a.cod_sp = suplidor.cod_sp
IF ultimo_codigo IS NULL THEN
LET ultimo_codigo = 0
END IF
LET suplidor.cod_sp_sec = ultimo_codigo + 1
DISPLAY BY NAME suplidor.cod_sp_sec
END IF
AFTER FIELD cod_sp_sec
SELECT a.* INTO suplidor.* FROM cotb00001 a
WHERE a.cod_sp = suplidor.cod_sp and
a.cod_sp_sec = suplidor.cod_sp_sec
IF status != NOTFOUND THEN
IF suplidor.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
# Llamado a la rutina que despliega el mensaje del error retornado despues del
# SELECT. Solamente despliega mensaje si hay error.
DISPLAY BY NAME suplidor.*
LET numero_msg = 12
CALL msg(numero_msg)
NEXT FIELD cod_sp
END IF
AFTER FIELD cod_pais
SELECT a.nom_pais INTO paises.nom_pais FROM cotb00018 a
WHERE a.cod_pais = suplidor.cod_pais
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_pais
END IF
DISPLAY BY NAME paises.nom_pais
AFTER FIELD term_sp
SELECT a.descrip_term INTO pagos.descrip_term FROM cotb00024 a
WHERE a.term_sp = suplidor.term_sp
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD term_sp
END IF
DISPLAY BY NAME pagos.descrip_term
AFTER FIELD cuenta_no
SELECT a.descripcion INTO descripcion_cuenta
FROM cgtb00001 a
WHERE a.cuenta_no=suplidor.cuenta_no AND a.nivel>2
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME descripcion_cuenta
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
INSERT INTO cotb00001 (cod_sp,cod_sp_sec,nom_sp,
dir_sp,ciu_sp,cod_pais,tel_sp,area_sp,fax_sp,
cont_sp,term_sp,status_t,us_crea,fech_crea,
cuenta_no,tipo_doc,rnc)
VALUES (suplidor.cod_sp, suplidor.cod_sp_sec,
suplidor.nom_sp,
suplidor.dir_sp, suplidor.ciu_sp, suplidor.cod_pais,
suplidor.tel_sp, suplidor.area_sp, suplidor.fax_sp,
suplidor.cont_sp, suplidor.term_sp,null, usuarios, GETDATE(),
suplidor.cuenta_no,suplidor.tipo_doc,suplidor.rnc)
# Verifica el Status que retorna luego de insertar el registro en la tabla.
# Si hubo problemas en la insercion del registro, se despliega un mensaje.
EXIT INPUT
END INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
LET numero_msg = 1
CALL msg(numero_msg)
CLEAR FORM
END FUNCTION
FUNCTION copcmf001()
#WHENEVER ERROR CONTINUE
# Aqui se prepara para la captura del criterio de seleccion
CONSTRUCT BY NAME criterio ON cotb00001.*
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET SELEC = " SELECT tipo_Doc
,rnc
,cod_sp
,cod_sp_sec
,nom_sp
,dir_sp
,ciu_sp
,cod_pais
,tel_sp
,area_sp
,fax_sp
,cont_sp
,term_sp
,status_t
,us_crea
,fech_crea
,us_mod
,fech_mod
,cuenta_no FROM cotb00001 where ",
" status_t is null AND ",
criterio clipped,
" ORDER BY nom_sp"
PREPARE busca FROM selec
DECLARE datos SCROLL CURSOR FOR busca
OPEN datos
FETCH FIRST datos INTO suplidor.tipo_Doc
,suplidor.rnc
,suplidor.cod_sp
,suplidor.cod_sp_sec
,suplidor.nom_sp
,suplidor.dir_sp
,suplidor.ciu_sp
,suplidor.cod_pais
,suplidor.tel_sp
,suplidor.area_sp
,suplidor.fax_sp
,suplidor.cont_sp
,suplidor.term_sp
,suplidor.status_t
,suplidor.us_crea
,suplidor.fech_crea
,suplidor.us_mod
,suplidor.fech_mod
,suplidor.cuenta_no
IF status >= 0 THEN
IF status = NOTFOUND THEN
LET numero_msg = 3
CALL msg(numero_msg)
RETURN
END IF
END IF
SELECT descripcion INTO descripcion_cuenta
FROM cgtb00001
WHERE cuenta_no=suplidor.cuenta_no
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
DISPLAY BY NAME suplidor.*,paises.nom_pais,pagos.descrip_term,
suplidor.cuenta_no,descripcion_cuenta
MENU "OPCIONES "
COMMAND "Siguiente"
"Presenta en pantalla el proximo registro encontrado"
FETCH NEXT datos INTO suplidor.tipo_Doc
,suplidor.rnc
,suplidor.cod_sp
,suplidor.cod_sp_sec
,suplidor.nom_sp
,suplidor.dir_sp
,suplidor.ciu_sp
,suplidor.cod_pais
,suplidor.tel_sp
,suplidor.area_sp
,suplidor.fax_sp
,suplidor.cont_sp
,suplidor.term_sp
,suplidor.status_t
,suplidor.us_crea
,suplidor.fech_crea
,suplidor.us_mod
,suplidor.fech_mod
,suplidor.cuenta_no
IF status = NOTFOUND THEN
LET numero_msg = 4
CALL msg(numero_msg)
END IF
SELECT descripcion INTO descripcion_cuenta
FROM cgtb00001
WHERE cuenta_no=suplidor.cuenta_no
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
DISPLAY BY NAME suplidor.*,paises.nom_pais,pagos.descrip_term,descripcion_cuenta
COMMAND "Anterior"
"Presenta en pantalla el registro anterior encontrado"
FETCH PREVIOUS datos INTO suplidor.tipo_Doc
,suplidor.rnc
,suplidor.cod_sp
,suplidor.cod_sp_sec
,suplidor.nom_sp
,suplidor.dir_sp
,suplidor.ciu_sp
,suplidor.cod_pais
,suplidor.tel_sp
,suplidor.area_sp
,suplidor.fax_sp
,suplidor.cont_sp
,suplidor.term_sp
,suplidor.status_t
,suplidor.us_crea
,suplidor.fech_crea
,suplidor.us_mod
,suplidor.fech_mod
,suplidor.cuenta_no
IF status = NOTFOUND THEN
LET numero_msg = 5
CALL msg(numero_msg)
END IF
SELECT descripcion INTO descripcion_cuenta
FROM cgtb00001
WHERE cuenta_no=suplidor.cuenta_no
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
DISPLAY BY NAME suplidor.*,paises.nom_pais,pagos.descrip_term,descripcion_cuenta
COMMAND "Primero"
"Presenta en pantalla el primer registro encontrado"
FETCH FIRST datos INTO suplidor.tipo_Doc
,suplidor.rnc
,suplidor.cod_sp
,suplidor.cod_sp_sec
,suplidor.nom_sp
,suplidor.dir_sp
,suplidor.ciu_sp
,suplidor.cod_pais
,suplidor.tel_sp
,suplidor.area_sp
,suplidor.fax_sp
,suplidor.cont_sp
,suplidor.term_sp
,suplidor.status_t
,suplidor.us_crea
,suplidor.fech_crea
,suplidor.us_mod
,suplidor.fech_mod
,suplidor.cuenta_no
SELECT descripcion INTO descripcion_cuenta
FROM cgtb00001
WHERE cuenta_no=suplidor.cuenta_no
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
DISPLAY BY NAME suplidor.*,paises.nom_pais,pagos.descrip_term,descripcion_cuenta
LET numero_msg = 5
CALL msg(numero_msg)
COMMAND "Ultimo"
"Presenta en pantalla el ultimo registro encontrado"
FETCH LAST datos INTO suplidor.tipo_Doc
,suplidor.rnc
,suplidor.cod_sp
,suplidor.cod_sp_sec
,suplidor.nom_sp
,suplidor.dir_sp
,suplidor.ciu_sp
,suplidor.cod_pais
,suplidor.tel_sp
,suplidor.area_sp
,suplidor.fax_sp
,suplidor.cont_sp
,suplidor.term_sp
,suplidor.status_t
,suplidor.us_crea
,suplidor.fech_crea
,suplidor.us_mod
,suplidor.fech_mod
,suplidor.cuenta_no
SELECT descripcion INTO descripcion_cuenta
FROM cgtb00001
WHERE cuenta_no=suplidor.cuenta_no
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
DISPLAY BY NAME suplidor.*,paises.nom_pais,pagos.descrip_term,descripcion_cuenta
LET numero_msg = 4
CALL msg(numero_msg)
COMMAND "Escoger"
"<Esc> Actualiza Registro <Delete> Cancela Operacion"
IF suplidor.status_t = "E" THEN
LET numero_msg = 36
CALL msg(numero_msg)
RETURN
END IF
INPUT BY NAME suplidor.tipo_doc,suplidor.rnc,suplidor.nom_sp,suplidor.dir_sp,suplidor.cod_pais,
suplidor.term_sp,suplidor.ciu_sp,suplidor.tel_sp,
suplidor.area_sp,suplidor.fax_sp,suplidor.cont_sp,
suplidor.cuenta_no
WITHOUT DEFAULTS
AFTER FIELD rnc
IF suplidor.rnc IS NOT NULL THEN
IF suplidor.tipo_doc = 'RNC' THEN
EXECUTE dgii1 INTO suplidor.nom_sp,suplidor.dir_sp,suplidor.tel_sp USING suplidor.rnc
DISPLAY BY NAME suplidor.nom_sp,suplidor.dir_sp,suplidor.tel_sp
END IF
END IF
AFTER FIELD cuenta_no
SELECT a.descripcion INTO descripcion_cuenta
FROM cgtb00001 a
WHERE a.cuenta_no=suplidor.cuenta_no AND a.nivel>2
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cuenta_no
END IF
DISPLAY BY NAME descripcion_cuenta
AFTER FIELD cod_pais
SELECT nom_pais INTO paises.nom_pais FROM cotb00018
WHERE cod_pais = suplidor.cod_pais
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD cod_pais
END IF
DISPLAY BY NAME paises.nom_pais
AFTER FIELD term_sp
SELECT descrip_term INTO pagos.descrip_term FROM cotb00024
WHERE term_sp = suplidor.term_sp
IF status = notfound THEN
LET numero_msg = 3
CALL msg(numero_msg)
NEXT FIELD term_sp
END IF
DISPLAY BY NAME pagos.descrip_term
AFTER INPUT
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = FALSE
CLEAR FORM
RETURN
END IF
UPDATE cotb00001 SET nom_sp = suplidor.nom_sp,
dir_sp = suplidor.dir_sp,
ciu_sp = suplidor.ciu_sp,
cod_pais = suplidor.cod_pais,
tel_sp = suplidor.tel_sp,
area_sp = suplidor.area_sp,
fax_sp = suplidor.fax_sp,
cont_sp = suplidor.cont_sp,
term_sp = suplidor.term_sp,
us_mod = usuarios,
fech_mod = GETDATE(),
cuenta_no =suplidor.cuenta_no,
rnc = suplidor.rnc,
tipo_doc = suplidor.tipo_doc
WHERE cod_sp = suplidor.cod_sp and
cod_sp_sec = suplidor.cod_sp_sec
LET numero_msg = 13
CALL msg(numero_msg)
END INPUT
COMMAND KEY ("L") "eLiminar"
SELECT unique a.cod_sp,a.cod_sp_sec FROM cptb00001 a
WHERE a.cod_sp = suplidor.cod_sp AND
a.cod_sp_sec = suplidor.cod_sp_sec
AND a.status_t IS NULL AND a.tipo_doc='FT'
IF STATUS <> NOTFOUND THEN
CALL fgl_Winmessage("INFO","SUPLIDOR TIENE FACTURA","INFO")
return
END IF
UPDATE cotb00001 set status_t = "E",us_mod=usuarios,fech_mod=GETDATE()
WHERE cod_sp = suplidor.cod_sp AND
cod_sp_sec = suplidor.cod_sp_sec
LET numero_msg = 39
CALL msg(numero_msg)
COMMAND "Retornar"
"Retorna al menu anterior"
CLEAR FORM
EXIT MENU
END MENU
END FUNCTION
FUNCTION busca_pais()
OPEN WINDOW busqueda1 AT 10,10 WITH FORM "cofmwd019"
ATTRIBUTE (BORDER,FORM LINE FIRST + 1, comment line last)
CONSTRUCT criterio ON cotb00018.cod_pais,cotb00018.nom_pais
FROM cotb00018.cod_pais,cotb00018.nom_pais
IF int_flag THEN
LET numero_msg = 2
CALL msg(numero_msg)
LET int_flag = false
RETURN
END IF
LET selec = "SELECT cod_pais,nom_pais FROM cotb00018 ",
"WHERE status_t is null AND ",criterio clipped,
"ORDER BY 1 "
PREPARE localiza1 FROM selec
DECLARE country CURSOR FOR localiza1
LET idx = 1
FOREACH country INTO pais_wd[idx].*
IF status = NOTFOUND THEN
LET existe = "N"
EXIT FOREACH
END IF
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
DISPLAY ARRAY pais_wd TO consart.*
LET curr1 = arr_curr()
LET suplidor.cod_pais = pais_wd[curr1].cod_pais
LET paises.nom_pais = pais_wd[curr1].nom_pais
CLOSE WINDOW busqueda1
END FUNCTION