Files
MBS/PROYECTO/otrodir/codigos.4gl
T

185 lines
6.6 KiB
Plaintext

MAIN
DEFINE descripcion,usuarios,clave CHAR(50),
idx,curr,scurr SMALLINT,
selec,criterio CHAR(500)
DEFINE arrcodigos DYNAMIC ARRAY OF RECORD
prowid INTEGER,
cod_n SMALLINT,
cod_grupo SMALLINT,
cod_tipo SMALLINT,
cod_sec SMALLINT,
descripcion CHAR(30),
cod_n1 SMALLINT,
cod_grupo1 SMALLINT,
cod_tipo1 SMALLINT,
cod_sec1 SMALLINT,
cod_espesor SMALLINT
END RECORD,
descripClase,descripGrupo,descripTipo,descripMedida,descripEspesor CHAR(30)
DEFER INTERRUPT
CALL ARG_VAL(1) RETURNING usuarios
CALL ARG_VAL(2) RETURNING clave
CONNECT TO "smarmotech" USER usuarios USING clave
#WHENEVER ERROR CONTINUE
OPEN FORM f1 FROM "codigos"
DISPLAY FORM f1
CONSTRUCT BY NAME criterio on b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_Sec
LET selec =
" SELECT a.rowid,b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_Sec,b.descrip_Esp,a.cod_n1,a.cod_grupo1, ",
" a.cod_tipo1,a.cod_Sec1,a.espesor ",
" FROM iptb00002 b LEFT OUTER JOIN tmpiptb00002 a ON ",
" a.cod_n = b.cod_n AND ",
" a.cod_grupo = b.cod_grupo AND ",
" a.cod_tipo = b.cod_tipo AND ",
" a.cod_sec = b.cod_sec ",
" WHERE ",criterio CLIPPED," AND b.status_t iS NULL ", " ORDER BY b.cod_n,b.cod_grupo,b.cod_tipo,b.cod_Sec "
PREPARE comando FROM selec
DECLARE busca CURSOR FOR comando
LET idx = 1
FOREACH busca INTO arrcodigos[idx].*
LET idx = idx + 1
END FOREACH
CALL set_count(idx-1)
INPUT ARRAY arrcodigos WITHOUT DEFAULTS FROM scodigos.*
BEFORE ROW
LET curr = arr_curr()
LET scurr = scr_line()
AFTER FIELD cod_sec
IF arrcodigos[curr].cod_sec IS NOT NULL THEN
SELECT a.descrip_esp INTO descripcion FROM iptb00002 a
WHERE a.cod_n = arrcodigos[curr].cod_n AND
a.cod_grupo = arrcodigos[curr].cod_grupo AND
a.cod_tipo = arrcodigos[curr].cod_tipo AND
a.cod_sec = arrcodigos[curr].cod_sec AND
a.status_t IS NULL
IF STATUS = NOTFOUND THEN
ERROR "CODIGO NO EXISTE"
NEXT FIELD cod_n
END IF
LET arrcodigos[curr].descripcion = descripcion
DISPLAY arrcodigos[curr].descripcion TO scodigos[scurr].descripcion
NEXT FIELD cod_n1
END IF
AFTER FIELD cod_n1
IF arrcodigos[curr].cod_n IS NOT NULL THEN
SELECT a.descripcion iNTO descripClase FROM tmpClase a
WHERE a.cod_n = arrcodigos[curr].cod_n1
IF STATUS = NOTFOUND THEN
ERROR "REGISTRO NO EXISTE"
NEXT FIELD cod_n1
END IF
DISPLAY BY NAME descripClase
END IF
AFTER FIELD cod_grupo1
IF arrcodigos[curr].cod_n IS NOT NULL THEN
SELECT a.descripcion iNTO descripGRUPO FROM tmpgrupo a
WHERE a.cod_grupo = arrcodigos[curr].cod_grupo1
IF STATUS = NOTFOUND THEN
ERROR "REGISTRO NO EXISTE"
NEXT FIELD cod_grupo1
END IF
DISPLAY BY NAME descripGRUPO
END IF
AFTER FIELD cod_tipo1
IF arrcodigos[curr].cod_n IS NOT NULL THEN
SELECT a.descripcion iNTO descripTIPO FROM tmpTIPO a
WHERE a.cod_tipo = arrcodigos[curr].cod_tipo1
IF STATUS = NOTFOUND THEN
ERROR "REGISTRO NO EXISTE"
NEXT FIELD cod_tipo1
END IF
DISPLAY BY NAME descripTIPO
END IF
AFTER FIELD cod_sec1
IF arrcodigos[curr].cod_n IS NOT NULL THEN
SELECT a.descripcion iNTO descripMEDIDA FROM tmpMEDIDA a
WHERE a.cod_sec = arrcodigos[curr].cod_sec1
IF STATUS = NOTFOUND THEN
ERROR "REGISTRO NO EXISTE"
NEXT FIELD cod_sec1
END IF
DISPLAY BY NAME descripMEDIDA
END IF
AFTER FIELD cod_espesor
IF arrcodigos[curr].cod_n IS NOT NULL THEN
SELECT a.descripcion iNTO descripESPESOR FROM tmpESPESOR a
WHERE a.cod_ESPESOR = arrcodigos[curr].cod_ESPESOR
IF STATUS = NOTFOUND THEN
ERROR "REGISTRO NO EXISTE"
NEXT FIELD cod_ESPESOR
END IF
DISPLAY BY NAME descripESPESOR
END IF
AFTER INPUT
IF int_flag THEN
ERROR "OPERACION CANCELADA"
LET int_flag = FALSE
EXIT PROGRAM -1
END IF
# BEGIN WORK
FOR idx=1 TO arr_count()
IF arrcodigos[idx].cod_n1 IS NOT NULL THEN
LET arrcodigos[idx].prowid = idx
SELECT DISTINCT a.cod_n FROM tmpiptb00002 a
WHERE a.cod_n = arrcodigos[idx].cod_n AND
a.cod_grupo =arrcodigos[idx].cod_grupo AND
a.cod_tipo = arrcodigos[idx].cod_tipo AND
a.cod_sec = arrcodigos[idx].cod_sec
IF STATUS = NOTFOUND THEN
INSERT INTO tmpiptb00002 (rowid,cod_n,cod_grupo,cod_tipo,cod_sec,cod_n1,cod_grupo1,cod_tipo1,cod_sec1,espesor,us_mod,fech_mod)
VALUES (arrcodigos[idx].prowid,arrcodigos[idx].cod_n,arrcodigos[idx].cod_grupo,
arrcodigos[idx].cod_tipo,arrcodigos[idx].cod_sec,
arrcodigos[idx].cod_n1,arrcodigos[idx].cod_grupo1,
arrcodigos[idx].cod_tipo1,arrcodigos[idx].cod_sec1,arrcodigos[idx].cod_espesor,SUSER_SNAME(),GETDATE())
ELSE
UPDATE tmpiptb00002 SET cod_n1 =arrcodigos[idx].cod_n1,
cod_grupo1 =arrcodigos[idx].cod_grupo1,
cod_tipo1 =arrcodigos[idx].cod_tipo1,
cod_sec1 =arrcodigos[idx].cod_sec1,
us_mod = SUSER_SNAME(),
fech_mod = GETDATE()
WHERE cod_n = arrcodigos[idx].cod_n AND
cod_grupo = arrcodigos[idx].cod_grupo AND
cod_tipo = arrcodigos[idx].cod_tipo AND
cod_Sec = arrcodigos[idx].cod_sec
END IF
{ IF STATUS < 0 THEN
CALL fgl_winmessage('ERROR','ACTUALIZACION FALLIDA','STOP')
ROLLBACK WORK
EXIT INPUT
ELSE
COMMIT WORK
CALL fgl_winmessage('ERROR','ACTUALIZACION FALLIDA','STOP')
END IF }
END IF
END FOR
CALL fgl_winmessage('INFORMACION','REGISTROS ACTUALIZADOS','information')
CONTINUE INPUT
END INPUT
END MAIN