//BCHJOB JOB(JDECCHA53) 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: 2015-06-25 14:26 */ /* To File : "JDECCHA53" */ /* To Library : "NERONI2" */ /* To Text : "From Dec To Char. Src ANTE %ADDR" */ /********* 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 "JDECCHA53.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:\JDECCHA53.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JDECCHA53.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(JDECCHA53) 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/JDECCHA53" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JDECCHA53) MBR(JDECCHA53.) 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/JDECCHA53) CRTSRCPF FILE(NERONI2/JDECCHA53) RCDLEN(112) + TEXT('From Dec To Char. Src ANTE %ADDR') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHA) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHA) + SRCTYPE(CMD) + TEXT('From Dec To Char. Cmd ANTE %ADDR') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHA.) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHA.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHA.) + SRCTYPE(CL) + TEXT('From Dec To Char. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHAC) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHAC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHAC) + SRCTYPE(CLLE) + TEXT('From Dec To Char. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHAP) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHAP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHAP) + SRCTYPE(PNLGRP) + TEXT('From Dec To Char. Help') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHAR) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHAR) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHAR) + SRCTYPE(RPGLE) + TEXT('From Dec To Char. ConvertDataFormat') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JDECCHASAM) TOFILE(NERONI2/JDECCHA53) + TOMBR(JDECCHASAM) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JDECCHA53) MBR(JDECCHASAM) + SRCTYPE(CLLE) + TEXT('From Dec To Char. Sample') /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* From Dec To Char. Cmd */ /* Claudio Neroni 15-05-2015 Creato. */ CMD PROMPT('From Decimal to Character') PARM KWD(FROMDEC) TYPE(*DEC) LEN(15 0) MIN(1) + PROMPT('From Decimal (15,0)') PARM KWD(TOCHAR1) TYPE(*CHAR) LEN(1) RTNVAL(*YES) + PROMPT('To Character (Var 1) Max 01,0') PARM KWD(TOCHAR2) TYPE(*CHAR) LEN(2) RTNVAL(*YES) + PROMPT('To Character (Var 2) Max 03,0') PARM KWD(TOCHAR3) TYPE(*CHAR) LEN(3) RTNVAL(*YES) + PROMPT('To Character (Var 3) Max 05,0') PARM KWD(TOCHAR4) TYPE(*CHAR) LEN(4) RTNVAL(*YES) + PROMPT('To Character (Var 4) Max 07,0') PARM KWD(TOCHAR5) TYPE(*CHAR) LEN(5) RTNVAL(*YES) + PROMPT('To Character (Var 5) Max 09,0') PARM KWD(TOCHAR6) TYPE(*CHAR) LEN(6) RTNVAL(*YES) + PROMPT('To Character (Var 6) Max 11,0') PARM KWD(TOCHAR7) TYPE(*CHAR) LEN(7) RTNVAL(*YES) + PROMPT('To Character (Var 7) Max 13,0') PARM KWD(TOCHAR8) TYPE(*CHAR) LEN(8) RTNVAL(*YES) + PROMPT('To Character (Var 8) Max 15,0') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHA.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JDECCHA.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 18-05-2015 Creato. */ /* JDECCHA */ /* From Dec To Char. CrtJs ANTE %ADDR */ /* Prerequisiti: nessuno */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JDECCHA) DLTPNLGRP PNLGRP(NERONI2/JDECCHAP) DLTPGM PGM(NERONI2/JDECCHAC) DLTPGM PGM(NERONI2/JDECCHAR) DLTPGM PGM(NERONI2/JDECCHASAM) /* Crea gli oggetti. */ CRTBNDCL PGM(NERONI2/JDECCHAC) SRCFILE(JDECCHA53) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JDECCHAR) SRCFILE(JDECCHA53) DBGVIEW(*ALL) + TGTRLS(*CURRENT) CRTPNLGRP PNLGRP(NERONI2/JDECCHAP) SRCFILE(JDECCHA) CRTCMD CMD(NERONI2/JDECCHA) PGM(JDECCHAC) SRCFILE(JDECCHA53) + ALLOW(*BPGM *IPGM *BMOD *IMOD) HLPPNLGRP(JDECCHAP) + HLPID(CMD) PRDLIB(NERONI2) CRTBNDCL PGM(NERONI2/JDECCHASAM) SRCFILE(JDECCHA53) + TGTRLS(*CURRENT) DBGVIEW(*ALL) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHAC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* From Dec To Char. Cpp */ /* Claudio Neroni 15/05/2015 Creato. */ /* Trasforma un campo impaccato di lunghezza 15 */ /* in 8 campi carattere di lunghezza da 1 a 8. */ /* Tutti i campi di ritorno sono facoltativi e restituisce solo i campi */ /* che il comando passa al programma. */ /* Nato, in attesa del rel 7.2 con le nuove built in function, */ /* per passare numerici ai dati messaggi. */ /* Questa versione non usa nemmeno la bif %ADDR nata nel rel 7.1 */ /* */ PGM PARM(&FROMDEC &TOCHAR1 &TOCHAR2 &TOCHAR3 + &TOCHAR4 &TOCHAR5 &TOCHAR6 &TOCHAR7 &TOCHAR8) DCL VAR(&FROMDEC) TYPE(*DEC) LEN(15 0) DCL VAR(&TOCHAR1) TYPE(*CHAR) LEN(1) DCL VAR(&TOCHAR2) TYPE(*CHAR) LEN(2) DCL VAR(&TOCHAR3) TYPE(*CHAR) LEN(3) DCL VAR(&TOCHAR4) TYPE(*CHAR) LEN(4) DCL VAR(&TOCHAR5) TYPE(*CHAR) LEN(5) DCL VAR(&TOCHAR6) TYPE(*CHAR) LEN(6) DCL VAR(&TOCHAR7) TYPE(*CHAR) LEN(7) DCL VAR(&TOCHAR8) TYPE(*CHAR) LEN(8) DCL VAR(&CHAR8) TYPE(*CHAR) LEN(8) DCL VAR(&NBRCIF) TYPE(*DEC) LEN(3 0) DCL VAR(&CPF0001) TYPE(*LGL) CALL PGM(JDECCHAR) PARM(&FROMDEC &CHAR8 &NBRCIF) CHGVAR VAR(&TOCHAR1) VALUE(&TOCHAR1) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO1)) CHGVAR VAR(&TOCHAR1) VALUE(%SST(&CHAR8 8 1)) IF COND(&NBRCIF *GT 1) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO1: CHGVAR VAR(&TOCHAR2) VALUE(&TOCHAR2) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO2)) CHGVAR VAR(&TOCHAR2) VALUE(%SST(&CHAR8 7 2)) IF COND(&NBRCIF *GT 3) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO2: CHGVAR VAR(&TOCHAR3) VALUE(&TOCHAR3) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO3)) CHGVAR VAR(&TOCHAR3) VALUE(%SST(&CHAR8 6 3)) IF COND(&NBRCIF *GT 5) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO3: CHGVAR VAR(&TOCHAR4) VALUE(&TOCHAR4) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO4)) CHGVAR VAR(&TOCHAR4) VALUE(%SST(&CHAR8 5 4)) IF COND(&NBRCIF *GT 7) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO4: CHGVAR VAR(&TOCHAR5) VALUE(&TOCHAR5) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO5)) CHGVAR VAR(&TOCHAR5) VALUE(%SST(&CHAR8 4 5)) IF COND(&NBRCIF *GT 9) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO5: CHGVAR VAR(&TOCHAR6) VALUE(&TOCHAR6) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO6)) CHGVAR VAR(&TOCHAR6) VALUE(%SST(&CHAR8 3 6)) IF COND(&NBRCIF *GT 11) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO6: CHGVAR VAR(&TOCHAR7) VALUE(&TOCHAR7) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO7)) CHGVAR VAR(&TOCHAR7) VALUE(%SST(&CHAR8 2 7)) IF COND(&NBRCIF *GT 13) THEN(CHGVAR + VAR(&CPF0001) VALUE('1')) NO7: CHGVAR VAR(&TOCHAR8) VALUE(&TOCHAR8) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(NO8)) CHGVAR VAR(&TOCHAR8) VALUE(%SST(&CHAR8 1 8)) NO8: IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSG('Il numero da convertire non puņ essere + contenuto nel campo scelto.') MSGTYPE(*DIAG) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JDECCHA) + MSGTYPE(*ESCAPE) ENDDO ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHAP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') :PNLGRP. .*--------------------------------------------------------------------- :HELP NAME=CMD. :H3.Comando JDECCHA :H2.From Decimal to Character. :H2.Converte un numero in carattere nella forma numero impaccato. :P.Adatto all'uso in un programma Control Language per convertire le variabili numeriche in formato "carattere impaccato". :P.Trasforma un campo numerico con lunghezza da 1,0 a lunghezza 15,0 in 8 campi di ritorno di tipo carattere di lunghezza da 1 a 8. :P.Tutti i campi di ritorno sono facoltativi e il comando restituisce solo i campi gestiti. :P.Nato, in attesa del rel 7.2 con le nuove built in function, per passare numerici ai dati messaggi che li vogliono in tale formato. :P.Il comando restituisce errore se la variabile di ritorno scelta non e' abbastanza grande per contenere tutte le cifre significative ricevute in input. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/fromdec'. :H3.From Decimal (15,0) (FROMDEC) :P.Riceve un numero da 1 a 15 cifre con 0 decimali come costante o come variabile di tipo *DEC, sempre da 1 a 15 cifre con 0 decimali. :P.Valori permessi: :PARML. :PT.numero-in formato-decimale :PD.Il valore č obbligatorio. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar1'. :H3.To Character (Var 1) Max 01,0 (TOCHAR1) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri di una sola cifra in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di un carattere. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar2'. :H3.To Character (Var 2) Max 03,0 (TOCHAR2) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 3 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 2 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar3'. :H3.To Character (Var 3) Max 05,0 (TOCHAR3) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 5 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 3 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar4'. :H3.To Character (Var 4) Max 07,0 (TOCHAR4) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 7 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 4 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar5'. :H3.To Character (Var 5) Max 09,0 (TOCHAR5) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 9 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 5 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar6'. :H3.To Character (Var 6) Max 11,0 (TOCHAR6) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 11 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 6 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar7'. :H3.To Character (Var 7) Max 13,0 (TOCHAR7) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 13 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 7 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tochar8'. :H3.To Character (Var 8) Max 15,0 (TOCHAR8) :P.Variabile di ritorno di tipo carattere adatta a contenere numeri fino a 15 cifre in forma impaccata. :P.Valori permessi: :PARML. :PT.Variabile di 8 caratteri. :PD.La variabile e' facoltativa. :EPARML. :EHELP. .*--------------------------------------------------------------------- :EPNLGRP. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHAR) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE From Dec To Char. ConvertDataFormat * Claudio Neroni 15/05/2015 Creato. * Trasforma un campo impaccato di lunghezza 15 * in un campo carattere di lunghezza 8. * Nato, in attesa del rel 7.2 con le nuove built in function, * per passare numerici ai dati messaggi. *--------------------------------------------------------------------- * Fa coincidere un impaccato di lunghezza 15 * con un alfanumerico di lunghezza 8. D ds D pak 15p 0 D cha 1 8 * Numero cifre ricevute. D ncif s 3 0 * Fa coincidere un segnato di lunghezza 15 * con una schiera alfanumerica di 15 elementi lunghi 1. D ds D sig 15s 0 D cif 1 15 dim(15) *--------------------------------------------------------------------- * Scambia parametri. C *entry plist * Riceve il campo numerico. C parm inp 15 0 I Numero * Restituisce il campo carattere contenente il numerico impaccato. C parm out 8 O Alfa impaccato * Numero di cifre significative del numero ricevuto. C parm nc 3 0 I Numero cifre * Predispona chiusura. C seton lr * Trova il numero di cifre ricevute. C eval sig=inp C clear nc C 1 do 15 xx 3 0 C if cif(xx)<>*zero C eval nc=15+1-xx C leave C endif C enddo * Trascrive input in ds. C eval pak=inp * Trascrive ds in output. C eval out=cha * Ritorna. C return *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JDECCHASAM) FILETYPE(*SRC) ENDCHAR('//ENDSRC') PGM PARM(&N7) DCL VAR(&N7) TYPE(*DEC) LEN(15 0) DCL VAR(&CHA8) TYPE(*CHAR) LEN(8) VALUE('ZZZZZZZZ') DCL VAR(&CHA3) TYPE(*CHAR) LEN(3) VALUE('XXX') JDECCHA FROMDEC(&N7) TOCHAR3(&CHA3) TOCHAR8(&CHA8) ENDPGM //ENDSRC //ENDBCHJOB