//BCHJOB JOB(JCLRHEX) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it */ /* LA JOB DESCRIPTION "NERONI2/NERONI2" DEVE PREESISTERE. PUO' ESSERE */ /* IDENTICA A QBATCH E PUO' ESSERE SOSTITUITA DA QBATCH O SIMILE. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2014-06-26 14:01 */ /* To File : "JCLRHEX" */ /* To Library : "NERONI2" */ /* To Text : "Clear hex on source. Src" */ /********* INIZIO ISTRUZIONI *******************************************/ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI RICARICARE I SORGENTI. */ /* 1) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* CREARE UN FILE SORGENTE DI LUNGHEZZA RECORD 112: */ /* CRTSRCPF FILE(NERONI2/STRINGHE) RCDLEN(112) */ /* 2) SPOSTARE IL FILE "JCLRHEX.txt" NELL'INDIRIZZARIO */ /* DI UN PC CONNESSO IN RETE CON L'AS400 RICEVENTE */ /* (AD ES.: "c:\"). */ /* 3) DAL VIDEO COMANDI DEL PC CHIAMARE FTP: */ /* ftp nomeas400 */ /* 4) DIGITARE UTENTE E PASSWORD. */ /* 5) ESEGUIRE IL COMANDO DI COPIA DA FILE PC A MEMBRO AS400: */ /* put "c:\JCLRHEX.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JCLRHEX.mbr" */ /* 6) ABBANDONARE FTP: */ /* quit */ /* 7) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA COPIATA NEL MEMBRO SORGENTE: */ /* SBMDBJOB FILE(NERONI2/STRINGHE) MBR(JCLRHEX) JOBQ(QBATCH) */ /* LE SUCCESSIVE ISTRUZIONI PERMETTONO DI CREARE L'UTILITY. */ /* 8) DA UN VIDEO COMANDI DELL'AS400 RICEVENTE */ /* ESEGUIRE LA STRINGA O LE STRINGHE SORGENTE DI TIPO SEU "CL" */ /* (IL CUI NOME TERMINA SEMPRE CON ".") */ /* PRESENTI NEL FILE RICARICATO "NERONI2/JCLRHEX" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JCLRHEX) MBR(JCLRHEX.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Utility di Claudio Neroni') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JCLRHEX) CRTSRCPF FILE(NERONI2/JCLRHEX) RCDLEN(112) + TEXT('Clear hex on source. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEX) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEX) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEX) + SRCTYPE(CMD) + TEXT('Clear hex on source. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEX.) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEX.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEX.) + SRCTYPE(CL) + TEXT('Clear hex on source. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEXC) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEXC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEXC) + SRCTYPE(CLLE) + TEXT('Clear hex on source. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEXE) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEXE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEXE) + SRCTYPE(RPGLE) + TEXT('Clear hex on source. Upd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEXP) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEXP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEXP) + SRCTYPE(PNLGRP) + TEXT('Clear hex on source. Help') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JCLRHEXT) TOFILE(NERONI2/JCLRHEX) + TOMBR(JCLRHEXT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(JCLRHEXT) + SRCTYPE(TXT) + TEXT('Clear hex on source. Tbl') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(NULL) TOFILE(NERONI2/JCLRHEX) + TOMBR(NULL) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(NULL) + SRCTYPE(TXT) + TEXT('Null table') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(TEST) TOFILE(NERONI2/JCLRHEX) + TOMBR(TEST) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(TEST) + SRCTYPE(RPGLE) + TEXT('ORIGINALE per prova JCLRHEX') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(TESTXX) TOFILE(NERONI2/JCLRHEX) + TOMBR(TESTXX) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JCLRHEX) MBR(TESTXX) + SRCTYPE(RPGLE) + TEXT('ORIGINALE per prova JCLRHEX') /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEX) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Clear hex on source. Cmd */ /* Claudio Neroni 11/10/2007 Creato. */ /* Pulisce source da caratteri esadecimali */ /* inferiori a blank (x'40'). */ CMD PROMPT('Clear hex on source') PARM KWD(SRCFILE) TYPE(SRCFILE) MIN(1) + PROMPT('Source file') SRCFILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('library') PARM KWD(SRCMBR) TYPE(*NAME) MIN(1) + PROMPT('Source member') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEX.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JCLRHEX.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 11/10/2007 Creato. */ /* JCLRHEX */ /* Clear hex on source. */ /* Prerequisiti: JAI, JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JCLRHEX) DLTPNLGRP PNLGRP(NERONI2/JCLRHEXP) DLTTBL TBL(NERONI2/JCLRHEXT) DLTPGM PGM(NERONI2/JCLRHEXC) DLTPGM PGM(NERONI2/JCLRHEXE) DLTMSGF MSGF(NERONI2/JCLRHEX) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JCLRHEXC) SRCFILE(JCLRHEX) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JCLRHEXE) SRCFILE(JCLRHEX) DBGVIEW(*ALL) CRTTBL TBL(NERONI2/JCLRHEXT) SRCFILE(JCLRHEX) TEXT('Clear hex on + source. Tbl') CRTPNLGRP PNLGRP(NERONI2/JCLRHEXP) SRCFILE(JCLRHEX) CRTCMD CMD(NERONI2/JCLRHEX) PGM(JCLRHEXC) SRCFILE(JCLRHEX) + MSGF(JCLRHEX) HLPPNLGRP(JCLRHEXP) HLPID(CMD) PRDLIB(NERONI2) CRTMSGF MSGF(NERONI2/JCLRHEX) TEXT('Clear hex on source. Msgf') /* Messaggi del Cpp. */ ADDMSGD MSGID(JHX0001) MSGF(NERONI2/JCLRHEX) MSG('Il file &2/&1 non + è di tipo source.') SECLVL('Il file &1 nella libreria + &2 contente il membro &3 non è un file source.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JHX0003) MSGF(NERONI2/JCLRRPG) MSG('Il membro &3 del + file &2/&1 è vuoto.') SECLVL('Il membro &3 del file &1 + nella libreria &2 non contiene record. Perciò + l''attività richiesta su di esso non ha significato.') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JHX0009) MSGF(NERONI2/JCLRHEX) MSG('Il membro &3 del + file &2/&1 seu &4 è stato pulito dagli esadecimali.') + SECLVL('Il membro &3 del file &1 nella libreria &2 con + tipo seu &4 è stato pulito dagli esadecimali inferiori + a blank (x''40'').') FMT((*CHAR 10) (*CHAR 10) (*CHAR + 10) (*CHAR 10)) /* Messaggi del Cmd. */ /* Nessuno. */ //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEXC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Clear hex on source. Cpp */ /* Claudio Neroni 11/10/2007 Creato. */ /* Pulisce source da caratteri esadecimali minori di x'40'. */ PGM PARM(&FILELIB &MBR) /* File source qualificato. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Membro source da pulire. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* File source. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Tipo di seu. */ DCL VAR(&SRCTYPE) TYPE(*CHAR) LEN(10) /* Tipo di file. */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Lunghezza record del File. */ DCL VAR(&MRL) TYPE(*DEC) LEN(5 0) /* Numero di record nel Membro. */ DCL VAR(&NR) TYPE(*DEC) LEN(10 0) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Recupera le caratteristiche del File. */ JRTVFD FILE(&FILE) LIB(&LIB) MAXRCDLEN(&MRL) /* Controlla l'esistenza e recupera le caratteristiche */ /* del Membro da pulire. */ RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) + FILETYPE(&FILETYPE) SRCTYPE(&SRCTYPE) + NBRCURRCD(&NR) /* Se il file non è di tipo source, messaggia e rilascia. */ IF COND(&FILETYPE *NE *SRC) THEN(DO) SNDPGMMSG MSGID(JHX0001) MSGF(JCLRHEX) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Se il Membro è vuoto, messaggia e rilascia. */ IF COND(&NR *EQ 0) THEN(DO) SNDPGMMSG MSGID(JHX0003) MSGF(JCLRHEX) MSGDTA(&FILE + *CAT &LIB *CAT &MBR) MSGTYPE(*DIAG) GOTO CMDLBL(CPF0001) ENDDO /* Dealloca e alloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000) ALCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) WAIT(2) /* Ridirige la lettura sul Membro. */ OVRDBF FILE(JCLRHEX) TOFILE(&LIB/&FILE) MBR(&MBR) + SECURE(*YES) /* Chiama la pulizia del source. */ CALL PGM(JCLRHEXE) /* Manda messaggio di felice esecuzione. */ SNDPGMMSG MSGID(JHX0009) MSGF(JCLRHEX) MSGDTA(&FILELIB + *CAT &MBR *CAT &SRCTYPE) MSGTYPE(*COMP) /* Label di esecuzione delle attività finali. */ RCLRSC: /* Dealloca il membro. */ DLCOBJ OBJ((&LIB/&FILE *FILE *EXCL &MBR)) MONMSG MSGID(CPF0000 MCH0000) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JCLRHEX) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEXE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Clear hex on source. Upd * Claudio Neroni 11/10/2007 Creato. * Pulisce source da caratteri esadecimali minori di x'40'. *--------------------------------------------------------------------- * File source. FJclrhex uf f 112 disk *--------------------------------------------------------------------- * Record source. IJclrhex no * Statement. I 13 112 stm *--------------------------------------------------------------------- * Predispone il termine del programma. C seton lr * Si posiziona all'inizio del file. C 1 setll Jclrhex * Elabora il file. C do *hival * Legge il prossimo record. C read Jclrhex 50 * Se non ci sono altri record, salta a fine file. C 50 leave * Esamina lo statement. C do * Assume non ricalco della specifica. C setoff 71 * Elimina gli esadecimali bassi. C movel(p) stm stmnohex C *like define stm stmnohex C call 'QDCXLATE' C parm 100 qxllen 5 0 I Data len C stmnohex parm stm qxldta 100 U Data C parm 'JCLRHEXT' qxltab 10 I Table * Se lo statement resta inalterato, abbandona. C if stmnohex=stm C leave C endif * Prenota il ricalco della specifica. C seton 71 * Esamina lo statement. C enddo * Se è prenotato il ricalco. C if *in71 * Esegue il ricalco della specifica. C movel(p) stmnohex stm * Ricalca il record. C except $upd * Se non è prenotato il ricalco. C else * Rilascia il record. C unlock Jclrhex * Se non è prenotato il ricalco. C endif * Elabora il file. C enddo * Ritorna. C return *--------------------------------------------------------------------- OJclrhex E $upd O 71 stm 112 *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEXP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') :PNLGRP. .*--------------------------------------------------------------------- :HELP NAME=CMD. :H3.Comando JCLRHEX :H2.Pulisce sorgente di qualunque tipo da caratteri esadecimali inferiori a blank x'40'. :P.Il comando permette di eliminare tutti i caratteri esadecimali compresi tra x'00' e x'3F' presenti sulle istruzioni di un sorgente di qualsiasi tipo. :P.In particolare i caratteri compresi tra x'20' e x'3F' sono quelli che servono ad imporre luminosità e colori sulle istruzioni di un sorgente. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcfile'. :H3.Source file (SRCFILE) - file :P.Nome del file sorgente in cui risiede il membro da modificare. :P.Valori permessi: :PARML. :PT.nome-file-sorgente € :PD.Il valore è obbligatorio. :EPARML. :H3.Source file (SRCFILE) - library :P.Nome della libreria in cui risiede il file. :P.Valori permessi: :PARML. :PT.:PK DEF.*LIBL:EPK.€ :PD.Il file sorgente viene cercato in lista librerie. :PT.nome-libreria :PD.Il file sorgente viene cercato nella libreria richiesta. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/srcmbr'. :H3.Source member (SRCMBR) :P.Nome del membro sorgente da modificare. :P.Valori permessi: :PARML. :PT.nome-membro-sorgente € :PD.Il valore è obbligatorio. :EPARML. :EHELP. .*--------------------------------------------------------------------- :EPNLGRP. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JCLRHEXT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') 4040404040404040404040404040404040404040404040404040404040404040 4040404040404040404040404040404040404040404040404040404040404040 404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F 606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F 808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF C0C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(NULL) FILETYPE(*SRC) ENDCHAR('//ENDSRC') 000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F 202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F 404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F 606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F 808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF C0C1C2C3C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(TEST) FILETYPE(*SRC) ENDCHAR('//ENDSRC') ‚* =================================================================== ˜* ADDLIBLE UTI ˜* RICERCA BMB001R ˜* X0 by BMB001R ˜* So create BMB001r ‚* =================================================================== ˜* BMB001R - BAM - MPS - BAV - fusione/cessione ‚* =================================================================== fjfromcsvg ip e disk fcdbankl if e k disk fcdbank8l if e k disk rename(banche: banche8) fbmb002f o e disk usropn ‚*================================================================ ‚* Definizioni d cmd s 23a dim(1) ctdata perrcd(1) d len s 15 5 inz(20) d c§ c const('0123456789') ‚* =================================================================== ‚* MAIN programma ‚* =================================================================== c clear bmbrec c eval bmbank = 5024 c eval bmcodi = %int(%subst(%trimr(f001): 1: %len( c %trimr(f001)))) ‚* Testa esistenza file su CDBANKL - se non esiste segnala c key_banche chain banche c if not %found(cdbankl) c eval bmsegn = '1.Banca inesistente.' c endif c eval bmdeno = f002 c eval bmdeuf = f003 ‚* x xx xxx xxxx xxxxx >>> f004 c if %check(c§: %trimr(f004)) > 1 c eval bmocab = %int(%subst(%trimr(f004): 1: c %check(c§: %trimr(f004)) - 1)) c endif ‚* Testa se il CAB è valido su quella banca c if %found(cdbankl) and bmocab <> bkcab c eval bmsegn = '2.Codice CAB dipendenza non valido' c + ' su record banca.' c endif ‚* complete f004 c eval bmoca0 = %trimr(f004) c eval bmvia = f005 ‚* Testa se l'indirizzo è valido su quella banca c if %found(cdbankl) and bmvia <> banvia ‚* Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '3.Indirizzo non corrispondente alla banca.' c else c eval bmsegn = c '3.Indirizzo non corrispondente alla banca.' c endif c endif c eval bmcap = %int(%subst(%trimr(f006): 1: %len( c %trimr(f006)))) c eval bmcomu = f007 ‚* Testa se il comune è valido su quella banca c if %found(cdbankl) and bmcomu <> bancom ‚* Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '4.Il comune non corrispondente alla banca.' c else c eval bmsegn = c '4.Il comune non corrispondente alla banca.' c endif c endif c eval bmsgpv = f008 c eval bmtele = f009 c eval bmtel2 = f010 c eval bmfax = f011 c eval bmdest = f012 c eval bmnabi = %int(%subst(%trimr(f013): 1: %len( c %trimr(f013)))) c eval bmncod = %int(%subst(%trimr(f014): 1: %len( c %trimr(f014)))) ‚* Testa inesistenza sul file CDBANK8L - se esiste segnala c eval bkint = bmncod c key_banche8 setll banche8 c if %equal(cdbank8l) ‚* Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '5.La banca non può esistere come nuova.' c else c eval bmsegn = c '5.La banca non può esistere come nuova.' c endif c endif ‚* x xx xxx xxxx xxxxx >>> f015 c if %check(c§: %trimr(f015)) > 1 c eval bmncab = %int(%subst(%trimr(f015): 1: c %check(c§: %trimr(f015)) - 1)) c endif ‚* complete f015 c eval bmnca0 = %trimr(f015) c eval bmnden = f016 c eval bmnote = f017 c write bmbrec ‚* =================================================================== ‚* Inizializzazione programma ‚* =================================================================== cSR *inzsr begsr ‚* Definizione chiavi file c key_banche klist c kfld bmbank c kfld bmcodi c key_banche8 klist c kfld bmnabi c kfld bkint ‚* CLRPFM file destinatario finale c call 'QCMDEXC' c parm cmd(1) c parm len c open bmb002f c if not %open(bmb002f) or %error c eval *inLR = *ON c endif cSR endsr ** CMD CLRPFM FILE(BMB002F) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(TESTXX) FILETYPE(*SRC) ENDCHAR('//ENDSRC') x“y€› * =================================================================== €x * ADDLIBLE UTI *›RICERCA BMB001R xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz * X0 by BMB001R * So create BMB001r * =================================================================== * BMB001R - BAM - MPS - BAV - fusione/cessione * =================================================================== fjfromcsvg ip e disk fcdbankl if e k disk fcdbank8l if e k disk rename(banche: banche8) fbmb002f o e disk usropn *================================================================ * Definizioni d cmd s 23a dim(1) ctdata perrcd(1) d len s 15 5 inz(20) d c§ c const('0123456789') * =================================================================== * MAIN programma * =================================================================== c clear bmbrec c eval bmbank = 5024 c eval bmcodi = %int(%subst(%trimr(f001): 1: %len( c %trimr(f001)))) * Testa esistenza file su CDBANKL - se non esiste segnala c key_banche chain banche c if not %found(cdbankl) c eval bmsegn = '1.Banca inesistente.' c endif c eval bmdeno = f002 c eval bmdeuf = f003 * x xx xxx xxxx xxxxx >>> f004 c if %check(c§: %trimr(f004)) > 1 c eval bmocab = %int(%subst(%trimr(f004): 1: c %check(c§: %trimr(f004)) - 1)) c endif * Testa se il CAB è valido su quella banca c if %found(cdbankl) and bmocab <> bkcab c eval bmsegn = '2.Codice CAB dipendenza non valido' c + ' su record banca.' c endif * complete f004 c eval bmoca0 = %trimr(f004) c eval bmvia = f005 * Testa se l'indirizzo è valido su quella banca c if %found(cdbankl) and bmvia <> banvia * Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '3.Indirizzo non corrispondente alla banca.' c else c eval bmsegn = c '3.Indirizzo non corrispondente alla banca.' c endif c endif c eval bmcap = %int(%subst(%trimr(f006): 1: %len( c %trimr(f006)))) c eval bmcomu = f007 * Testa se il comune è valido su quella banca c if %found(cdbankl) and bmcomu <> bancom * Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '4.Il comune non corrispondente alla banca.' c else c eval bmsegn = c '4.Il comune non corrispondente alla banca.' c endif c endif c eval bmsgpv = f008 c eval bmtele = f009 c eval bmtel2 = f010 c eval bmfax = f011 c eval bmdest = f012 ‚c eval bmnabi = %int(%subst(%trimr(f013): 1: %len( c %trimr(f013)))) c eval bmncod = %int(%subst(%trimr(f014): 1: %len( c %trimr(f014)))) * Testa inesistenza sul file CDBANK8L - se esiste segnala c eval bkint = bmncod c key_banche8 setll banche8 c if %equal(cdbank8l) * Aggiungi o no a segnalazione precedente c if bmsegn <> *blanks c eval bmsegn = %trimr(bmsegn) + ' ' + c '5.La banca non può esistere come nuova.' c else c eval bmsegn = c '5.La banca non può esistere come nuova.' c endif c endif * x xx xxx xxxx xxxxx >>> f015 c if %check(c§: %trimr(f015)) > 1 c eval bmncab = %int(%subst(%trimr(f015): 1: c %check(c§: %trimr(f015)) - 1)) c endif * complete f015 c eval bmnca0 = %trimr(f015) c eval bmnden = f016 c eval bmnote = f017 c write bmbrec * =================================================================== * Inizializzazione programma * =================================================================== cSR *inzsr begsr * Definizione chiavi file c key_banche klist c kfld bmbank c kfld bmcodi c key_banche8 klist c kfld bmnabi c kfld bkint * CLRPFM file destinatario finale c call 'QCMDEXC' c parm cmd(1) c parm len c open bmb002f c if not %open(bmb002f) or %error c eval *inLR = *ON c endif cSR endsr ** CMD CLRPFM FILE(BMB002F) //ENDSRC //ENDBCHJOB