//BCHJOB JOB(JRTVFD) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source from 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: "DEV720" */ /* From Library: "NERONI2" */ /* Unload Time: 2016-04-05 18:17 */ /* To File : "JRTVFD" */ /* To Library : "NERONI2" */ /* To Text : "Retrieve File Description. 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 "JRTVFD.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:\JRTVFD.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JRTVFD.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(JRTVFD) 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/JRTVFD" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JRTVFD) MBR(JRTVFD.) JOBQ(QBATCH) */ /********* FINE ISTRUZIONI *********************************************/ /* Crea la libreria. */ MKDIR DIR('/qsys.lib/NERONI2.lib') CHGLIB LIB(NERONI2) TEXT('Claudio Neroni Utility') /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP NERONI2 QGPL) /* Crea il file sorgente. */ DLTF FILE(NERONI2/JRTVFD) CRTSRCPF FILE(NERONI2/JRTVFD) RCDLEN(112) + TEXT('Retrieve File Description. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRTVFD) TOFILE(NERONI2/JRTVFD) + TOMBR(JRTVFD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRTVFD) MBR(JRTVFD) + SRCTYPE(CMD) + TEXT('Retrieve File Description. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRTVFD.) TOFILE(NERONI2/JRTVFD) + TOMBR(JRTVFD.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRTVFD) MBR(JRTVFD.) + SRCTYPE(CL) + TEXT('Retrieve File Description. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRTVFDC) TOFILE(NERONI2/JRTVFD) + TOMBR(JRTVFDC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRTVFD) MBR(JRTVFDC) + SRCTYPE(CLLE) + TEXT('Retrieve File Description. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRTVFDI) TOFILE(NERONI2/JRTVFD) + TOMBR(JRTVFDI) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRTVFD) MBR(JRTVFDI) + SRCTYPE(CMD) + TEXT('Retrieve File Description. CmdInter') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JRTVFDIC) TOFILE(NERONI2/JRTVFD) + TOMBR(JRTVFDIC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JRTVFD) MBR(JRTVFDIC) + SRCTYPE(CLLE) + TEXT('Retrieve File Description. CppInter') /*---------------------------------------------------------------------*/ //DATA FILE(JRTVFD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 29-05-2014 Creato. */ /* Retrieve file description. */ /* Claudio Neroni 10-12-2015 Modificato. */ /* Aggiunto Numero corrente di membri nel file. */ /* Claudio Neroni 03-03-2016 Modificato. */ /* Aggiunto Level Identifier for Level Check. */ /* Claudio Neroni 05-04-2016 Modificato. */ /* Aggiunto File Attribute. */ /* */ CMD PROMPT('Retrieve File Description') PARM KWD(FILE) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('File name') PARM KWD(LIB) TYPE(*CHAR) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) PROMPT('Library') PARM KWD(RTNFILE) TYPE(*CHAR) LEN(10) + RTNVAL(*YES) PROMPT('Return File name Var + 10') PARM KWD(RTNLIB) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Return Library Var 10') PARM KWD(MAXRCDLEN) TYPE(*DEC) LEN(5 0) + RTNVAL(*YES) PROMPT('Max Record Length + Var 5,0') PARM KWD(NBRRCDFMT) TYPE(*DEC) LEN(4 0) + RTNVAL(*YES) PROMPT('Nbr of Record Format + Var 4,0') PARM KWD(ACCPTHTYP) TYPE(*CHAR) LEN(2) + RTNVAL(*YES) PROMPT('Access Path Type Var 2') PARM KWD(INLRCDS) TYPE(*DEC) LEN(10 0) + RTNVAL(*YES) PROMPT('Initial Records Var + 10,0') PARM KWD(INCRCDS) TYPE(*DEC) LEN(5 0) + RTNVAL(*YES) PROMPT('Increment Records + Var 5,0') PARM KWD(MAXINCS) TYPE(*DEC) LEN(5 0) + RTNVAL(*YES) PROMPT('Max Increments Var 5,0') PARM KWD(FILETYPE) TYPE(*CHAR) LEN(5) + RTNVAL(*YES) PROMPT('File Type (*DATA + *SRC) Var 5') PARM KWD(MBRSNBR) TYPE(*DEC) LEN(5 0) + RTNVAL(*YES) PROMPT('Current Members + Number Var 5,0') PARM KWD(LVLCHK) TYPE(*CHAR) LEN(13) RTNVAL(*YES) + PROMPT('Level Id for LevelCheck Var 13') PARM KWD(FILEATR) TYPE(*CHAR) LEN(3) RTNVAL(*YES) + PROMPT('File Attribute (*PF *LF) Var 3') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRTVFD.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JRTVFD.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 29-05-2014 Creato. */ /* JRTVFD */ /* Retrieve File Description. CrtJs */ /* Prerequisiti: JAI */ jmy /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella il file messaggi preesistente. */ DLTMSGF MSGF(NERONI2/JRTVFD) /* Cancella i testi d'aiuto preesistenti. */ DLTPNLGRP PNLGRP(NERONI2/JRTVFDP) /* Cancella i logici preesistenti. */ /* Cancella i fisici preesistenti. */ /* Cancella i comandi preesistenti. */ DLTCMD CMD(NERONI2/JRTVFD) DLTCMD CMD(NERONI2/JRTVFDI) /* Cancella i programmi preesistenti. */ DLTPGM PGM(NERONI2/JRTVFDC) DLTPGM PGM(NERONI2/JRTVFDIC) /* Crea i file fisici. */ /* Crea i file logici. */ /* Crea i comandi. */ CRTCMD CMD(NERONI2/JRTVFD) PGM(JRTVFDC) SRCFILE(JRTVFD) + ALLOW(*IPGM *BPGM) HLPPNLGRP(JRTVFDP) HLPID(CMD) + PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JRTVFDI) PGM(JRTVFDIC) SRCFILE(JRTVFD) + ALLOW(*ALL) HLPPNLGRP(JRTVFDP) HLPID(CMD) PRDLIB(NERONI2) /* Duplica i comandi in QGPL. */ CRTPRXCMD CMD(QGPL/JRTVFD) TGTCMD(NERONI2/JRTVFD) AUT(*USE) + REPLACE(*YES) CRTPRXCMD CMD(QGPL/JRTVFDI) TGTCMD(NERONI2/JRTVFDI) AUT(*USE) + REPLACE(*YES) /* Crea i programmi. */ CRTBNDCL PGM(NERONI2/JRTVFDIC) SRCFILE(JRTVFD) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JRTVFDC) SRCFILE(JRTVFD) TGTRLS(*CURRENT) + DBGVIEW(*ALL) /* Crea il file messaggi. */ CRTMSGF MSGF(NERONI2/JRTVFD) TEXT('Retrieve File Description. Msgf') /* Fotografia comandi (xxxA001). */ /* Messaggi comuni a pgm di comandi diversi (xxx0001). */ ADDMSGD MSGID(JFD0000) MSGF(NERONI2/JRTVFD) MSG('File messaggi + vuoto') /* Messaggi nei pgm del Cmd 1 (xxx0101). */ /* Messaggi nei pgm del Cmd 2 (xxx0201). */ /* Messaggi dei Cmd (xxx1001). */ /* Crea i testi d'aiuto. */ CRTPNLGRP PNLGRP(NERONI2/JRTVFDP) SRCFILE(JRTVFD) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRTVFDC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 03-06-2014 Creato. */ /* Retrieve File Description. */ /* Cpp del comando di interfaccia verso l'api QDBRTVFD. */ /* Claudio Neroni 10-12-2015 Modificato. */ /* Aggiunto Numero corrente di membri nel file. */ /* Claudio Neroni 03-03-2016 Modificato. */ /* Aggiunto Level Identifier for Level Check. */ /* Claudio Neroni 05-04-2016 Modificato. */ /* Aggiunto File Attribute. */ /* */ PGM PARM(&FILE &LIB &RTNFILE &RTNLIB &MAXRCDLEN + &NBRRCDFMT &ACCPTHTYP &INLRCDS &INCRCDS + &MAXINCS &FILETYPE &MBRSNBR &LVLCHK &FILEATR) /* Riceve File da esaminare. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Riceve Libreria del File da esaminare. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Restituisce File da esaminare. */ DCL VAR(&RTNFILE) TYPE(*CHAR) LEN(10) /* Restituisce Libreria del File da esaminare. */ DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) /* Restituisce Massima Lunghezza Record. */ DCL VAR(&MAXRCDLEN) TYPE(*DEC) LEN(5 0) /* Restituisce Numero di Formati Record. */ DCL VAR(&NBRRCDFMT) TYPE(*DEC) LEN(4 0) /* Restituisce Tipo accesso. */ DCL VAR(&ACCPTHTYP) TYPE(*CHAR) LEN(2) /* Restituisce Numero Iniziale di Record. */ DCL VAR(&INLRCDS) TYPE(*DEC) LEN(10 0) /* Restituisce Numero di Record in un Incremento. */ DCL VAR(&INCRCDS) TYPE(*DEC) LEN(5 0) /* Restituisce Numero Massimo di Incrementi. */ DCL VAR(&MAXINCS) TYPE(*DEC) LEN(5 0) /* Restituisce File Type (*DATA *SRC) */ DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) /* Restituisce Numero corrente di Membri nel File. */ DCL VAR(&MBRSNBR) TYPE(*DEC) LEN(5 0) /* Restituisce Level Check. */ DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(13) /* Restituisce File Attribute (*PF *LF) */ DCL VAR(&FILEATR) TYPE(*CHAR) LEN(3) /* Ridefinisce una copia di tutti i parametri. */ DCL VAR(&RTNFILE2) TYPE(*CHAR) LEN(10) DCL VAR(&RTNLIB2) TYPE(*CHAR) LEN(10) DCL VAR(&MAXRCDLEN2) TYPE(*DEC) LEN(5 0) DCL VAR(&NBRRCDFMT2) TYPE(*DEC) LEN(4 0) DCL VAR(&ACCPTHTYP2) TYPE(*CHAR) LEN(2) DCL VAR(&INLRCDS2) TYPE(*DEC) LEN(10 0) DCL VAR(&INCRCDS2) TYPE(*DEC) LEN(5 0) DCL VAR(&MAXINCS2) TYPE(*DEC) LEN(5 0) DCL VAR(&FILETYPE2) TYPE(*CHAR) LEN(5) DCL VAR(&MBRSNBR2) TYPE(*DEC) LEN(5 0) DCL VAR(&LVLCHK2) TYPE(*CHAR) LEN(13) DCL VAR(&FILEATR2) TYPE(*CHAR) LEN(3) /* Copia File e Libreria dei doppioni. */ CHGVAR VAR(&RTNFILE2) VALUE(&FILE) CHGVAR VAR(&RTNLIB2) VALUE(&LIB) /* Chiama l'interfaccia verso la api QDBRTVFD */ /* facendo uso dei duplicati dei parametri. */ CALL PGM(JAIRFD) PARM(&RTNFILE2 &RTNLIB2 + &MAXRCDLEN2 &NBRRCDFMT2 &ACCPTHTYP2 + &INLRCDS2 &INCRCDS2 &MAXINCS2 &FILETYPE2 + &MBRSNBR2 &LVLCHK2 &FILEATR2) /* Per ogni parametro, */ /* se ricevuto parametro, ne restituisce il valore recuperato. */ IF COND(%ADDR(&RTNFILE) *NE *NULL) THEN(DO) CHGVAR VAR(&RTNFILE) VALUE(&RTNFILE2) ENDDO IF COND(%ADDR(&RTNLIB) *NE *NULL) THEN(DO) CHGVAR VAR(&RTNLIB) VALUE(&RTNLIB2) ENDDO IF COND(%ADDR(&MAXRCDLEN) *NE *NULL) THEN(DO) CHGVAR VAR(&MAXRCDLEN) VALUE(&MAXRCDLEN2) ENDDO IF COND(%ADDR(&NBRRCDFMT) *NE *NULL) THEN(DO) CHGVAR VAR(&NBRRCDFMT) VALUE(&NBRRCDFMT2) ENDDO IF COND(%ADDR(&ACCPTHTYP) *NE *NULL) THEN(DO) CHGVAR VAR(&ACCPTHTYP) VALUE(&ACCPTHTYP2) ENDDO IF COND(%ADDR(&INLRCDS) *NE *NULL) THEN(DO) CHGVAR VAR(&INLRCDS) VALUE(&INLRCDS2) ENDDO IF COND(%ADDR(&INCRCDS) *NE *NULL) THEN(DO) CHGVAR VAR(&INCRCDS) VALUE(&INCRCDS2) ENDDO IF COND(%ADDR(&MAXINCS) *NE *NULL) THEN(DO) CHGVAR VAR(&MAXINCS) VALUE(&MAXINCS2) ENDDO IF COND(%ADDR(&FILETYPE) *NE *NULL) THEN(DO) CHGVAR VAR(&FILETYPE) VALUE(&FILETYPE2) ENDDO IF COND(%ADDR(&MBRSNBR) *NE *NULL) THEN(DO) CHGVAR VAR(&MBRSNBR) VALUE(&MBRSNBR2) ENDDO IF COND(%ADDR(&LVLCHK) *NE *NULL) THEN(DO) CHGVAR VAR(&LVLCHK) VALUE(&LVLCHK2) ENDDO IF COND(%ADDR(&FILEATR) *NE *NULL) THEN(DO) CHGVAR VAR(&FILEATR) VALUE(&FILEATR2) ENDDO ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRTVFDI) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 29-05-2014 Creato. */ /* Retrieve File Description Interactive */ /* */ CMD PROMPT('Retrieve File Description Int') PARM KWD(FILE) TYPE(*NAME) LEN(10) MIN(1) + PROMPT('File name') PARM KWD(LIB) TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) PROMPT('Library') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JRTVFDIC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 03-06-2014 Creato. */ /* Retrieve File Description. CppInter */ /* Cpp del comando di interfaccia verso l'api QDBRTVFD. */ /* Versione interattiva di prova. */ /* Claudio Neroni 10-12-2015 Modificato. */ /* Aggiunto Numero corrente di membri nel file. */ /* Claudio Neroni 03-03-2016 Modificato. */ /* Aggiunto Level Identifier for Level Check. */ /* Claudio Neroni 05-04-2016 Modificato. */ /* Aggiunto File Attribute. */ /* */ PGM PARM(&FILE &LIB) /* Riceve file e libreria di cui recuperare informazioni. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Dati di ritorno dal comando JRTVFD Retrieve File Description. */ DCL VAR(&RTNFILE) TYPE(*CHAR) LEN(10) DCL VAR(&RTNLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MAXRCDLEN) TYPE(*DEC) LEN(5 0) DCL VAR(&NBRRCDFMT) TYPE(*DEC) LEN(4 0) DCL VAR(&ACCPTHTYP) TYPE(*CHAR) LEN(2) DCL VAR(&INLRCDS) TYPE(*DEC) LEN(10 0) DCL VAR(&INCRCDS) TYPE(*DEC) LEN(5 0) DCL VAR(&MAXINCS) TYPE(*DEC) LEN(5 0) DCL VAR(&FILETYPE) TYPE(*CHAR) LEN(5) DCL VAR(&MBRSNBR) TYPE(*DEC) LEN(5 0) DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(13) DCL VAR(&FILEATR) TYPE(*CHAR) LEN(3) /* Copia alfa dei parametri numerici. */ DCL VAR(&MAXRCDLENA) TYPE(*CHAR) LEN(6) DCL VAR(&NBRRCDFMTA) TYPE(*CHAR) LEN(5) DCL VAR(&INLRCDSA) TYPE(*CHAR) LEN(11) DCL VAR(&INCRCDSA) TYPE(*CHAR) LEN(6) DCL VAR(&MAXINCSA) TYPE(*CHAR) LEN(6) DCL VAR(&MBRSNBRA) TYPE(*CHAR) LEN(6) /* Comodo per subroutine ALLINEA. */ DCL VAR(&ALLI) TYPE(*CHAR) LEN(20) DCL VAR(&ALLIS) TYPE(*CHAR) LEN(1) /* Chiama il comando JRTVFD Retrieve File Description. */ JRTVFD FILE(&FILE) LIB(&LIB) RTNFILE(&RTNFILE) + RTNLIB(&RTNLIB) MAXRCDLEN(&MAXRCDLEN) + NBRRCDFMT(&NBRRCDFMT) + ACCPTHTYP(&ACCPTHTYP) INLRCDS(&INLRCDS) + INCRCDS(&INCRCDS) MAXINCS(&MAXINCS) + FILETYPE(&FILETYPE) MBRSNBR(&MBRSNBR) + LVLCHK(&LVLCHK) FILEATR(&FILEATR) /* Edit dei campi numerici. */ CHGVAR VAR(&ALLI) VALUE(&MAXRCDLEN) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&MAXRCDLENA) VALUE(&ALLI) CHGVAR VAR(&ALLI) VALUE(&NBRRCDFMT) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&NBRRCDFMTA) VALUE(&ALLI) CHGVAR VAR(&ALLI) VALUE(&INLRCDS) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&INLRCDSA) VALUE(&ALLI) CHGVAR VAR(&ALLI) VALUE(&INCRCDS) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&INCRCDSA) VALUE(&ALLI) CHGVAR VAR(&ALLI) VALUE(&MAXINCS) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&MAXINCSA) VALUE(&ALLI) CHGVAR VAR(&ALLI) VALUE(&MBRSNBR) CALLSUBR SUBR(ALLINEA) CHGVAR VAR(&MBRSNBRA) VALUE(&ALLI) /* Messaggia il risultato. */ SNDPGMMSG MSG('File:' *TCAT &LIB *TCAT '/' *CAT &FILE + *BCAT 'Return_File:' *TCAT &RTNLIB *TCAT + '/' *CAT &RTNFILE *BCAT + 'Max_Record_Length:' *TCAT &MAXRCDLENA + *BCAT 'Nbr_of_Record_Format:' *TCAT + &NBRRCDFMTA *BCAT 'Access_Path_Type:' + *TCAT &ACCPTHTYP *BCAT 'Initial_Records:' + *TCAT &INLRCDSA *BCAT + 'Increment_Records:' *TCAT &INCRCDSA + *BCAT 'Max_Increments:' *TCAT &MAXINCSA + *BCAT 'File_Type:' *TCAT &FILETYPE *BCAT + 'Members_Number:' *TCAT &MBRSNBRA *BCAT + 'Level_Check:' *TCAT &LVLCHK *BCAT + 'File_Attribute:' *TCAT &FILEATR) RETURN /*----------------------------------------------------------------------------*/ /* Subroutine ALLINEA. */ SUBR SUBR(ALLINEA) /* Allinea a sinistra il contenuto numerico di un campo alfanumerico */ /* fino a 20 caratteri con segno "-" a sinistra sopprimendo gli zeri */ /* non significativi. */ CHGVAR VAR(&ALLIS) VALUE(%SST(&ALLI 1 1)) IF COND(&ALLIS = '-') THEN(CHGVAR + VAR(%SST(&ALLI 1 1)) VALUE('0')) DOWHILE COND('1') IF COND(%SST(&ALLI 1 1) *NE '0' *OR %SST(&ALLI + 2 1) *EQ ' ') THEN(LEAVE) CHGVAR VAR(&ALLI) VALUE(%SST(&ALLI 2 19)) ENDDO IF COND(&ALLIS = '-') THEN(CHGVAR VAR(&ALLI) + VALUE(&ALLIS *TCAT &ALLI)) ENDSUBR /*----------------------------------------------------------------------------*/ ENDPGM //ENDSRC //ENDBCHJOB