//BCHJOB JOB(JFDR) 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-03-22 17:22 */ /* To File : "JFDR" */ /* To Library : "NERONI2" */ /* To Text : "File desc & rel. 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 "JFDR.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:çJFDR.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JFDR.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(JFDR) 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/JFDR" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JFDR) MBR(JFDR.) 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/JFDR) CRTSRCPF FILE(NERONI2/JFDR) RCDLEN(112) + TEXT('File desc & rel. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR) TOFILE(NERONI2/JFDR) + TOMBR(JFDR) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR) + SRCTYPE(CMD) + TEXT('File desc & rel. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR.) TOFILE(NERONI2/JFDR) + TOMBR(JFDR.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR.) + SRCTYPE(CL) + TEXT('File desc & rel. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDRC) TOFILE(NERONI2/JFDR) + TOMBR(JFDRC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDRC) + SRCTYPE(CLLE) + TEXT('File desc & rel. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDRL) TOFILE(NERONI2/JFDR) + TOMBR(JFDRL) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDRL) + SRCTYPE(CLLE) + TEXT('File desc & rel. MsgPhyOfLgl') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDRP) TOFILE(NERONI2/JFDR) + TOMBR(JFDRP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDRP) + SRCTYPE(RPGLE) + TEXT('File desc & rel. Print') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDRX) TOFILE(NERONI2/JFDR) + TOMBR(JFDRX) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDRX) + SRCTYPE(PF) + TEXT('File desc & rel. BasAtrPhy&Lgl') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR1) TOFILE(NERONI2/JFDR) + TOMBR(JFDR1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR1) + SRCTYPE(PF) + TEXT('File desc & rel. Acc (1=Phy 4=Lgl)') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR2) TOFILE(NERONI2/JFDR) + TOMBR(JFDR2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR2) + SRCTYPE(PF) + TEXT('File desc & rel. FfdPhy') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR3) TOFILE(NERONI2/JFDR) + TOMBR(JFDR3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR3) + SRCTYPE(PF) + TEXT('File desc & rel. Dbr') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR6) TOFILE(NERONI2/JFDR) + TOMBR(JFDR6) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR6) + SRCTYPE(PF) + TEXT('File desc & rel. FfdPhy&LglInternal') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR7) TOFILE(NERONI2/JFDR) + TOMBR(JFDR7) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR7) + SRCTYPE(PF) + TEXT('File desc & rel. Join') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR8) TOFILE(NERONI2/JFDR) + TOMBR(JFDR8) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR8) + SRCTYPE(PF) + TEXT('File desc & rel. SelLgl') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDR9) TOFILE(NERONI2/JFDR) + TOMBR(JFDR9) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDR9) + SRCTYPE(PF) + TEXT('File desc & rel. FfdPhy&LglExternal') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT.) TOFILE(NERONI2/JFDR) + TOMBR(JFDT.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT.) + SRCTYPE(CL) + TEXT('File desc & rel. DbTest CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDTBIS) TOFILE(NERONI2/JFDR) + TOMBR(JFDTBIS) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDTBIS) + SRCTYPE(LF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDTJOI) TOFILE(NERONI2/JFDR) + TOMBR(JFDTJOI) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDTJOI) + SRCTYPE(LF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT1) TOFILE(NERONI2/JFDR) + TOMBR(JFDT1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT1) + SRCTYPE(PF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT1L) TOFILE(NERONI2/JFDR) + TOMBR(JFDT1L) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT1L) + SRCTYPE(LF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT2) TOFILE(NERONI2/JFDR) + TOMBR(JFDT2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT2) + SRCTYPE(PF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT2L) TOFILE(NERONI2/JFDR) + TOMBR(JFDT2L) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT2L) + SRCTYPE(LF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT3) TOFILE(NERONI2/JFDR) + TOMBR(JFDT3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT3) + SRCTYPE(PF) + TEXT('File desc & rel. DbTest') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFDT4) TOFILE(NERONI2/JFDR) + TOMBR(JFDT4) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFDR) MBR(JFDT4) + SRCTYPE(PF) + TEXT('File desc & rel. DbTest') /*---------------------------------------------------------------------*/ //DATA FILE(JFDR) FILETYPE(*SRC) ENDCHAR('//ENDSRC') CMD PROMPT('File description & relations') PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('File + fisico') FILE: QUAL TYPE(*NAME) MIN(1) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*USRLIBL) + (*ALLUSR) (*LIBL) (*ALL)) PROMPT('nella + libreria') PARM KWD(TYPE) TYPE(*CHAR) LEN(8) RSTD(*YES) + DFT(*ALL) VALUES(*ALL *FORMAT) + PROMPT('Tipo informazioni da stampare') PARM KWD(FORMSIZE) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*NARROW) VALUES(*NORMAL *COMPACT + *NARROW *NORMAL12 *COMPACT12 *NARROW12) + PROMPT('Misura del modulo') PARM KWD(OUTQ) TYPE(OUTQ) DFT(*JOB) SNGVAL((*JOB)) + PROMPT('Coda di emissione') OUTQ: QUAL TYPE(*NAME) MIN(1) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('nella libreria') PARM KWD(RETAINWORK) TYPE(*CHAR) LEN(10) + RSTD(*YES) DFT(*YES_EMPTY) VALUES(*NO + *YES_EMPTY *YES_FULL) PROMPT('Ritiene i + file di lavoro') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JFDR.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 20-04-1988 Creato. */ /* JFDR */ /* File description & relations. */ /* Prerequisiti: JCPYCLR, JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTF FILE(NERONI2/JFDRX) DLTF FILE(NERONI2/JFDR1) DLTF FILE(NERONI2/JFDR2) DLTF FILE(NERONI2/JFDR3) DLTF FILE(NERONI2/JFDR6) DLTF FILE(NERONI2/JFDR7) DLTF FILE(NERONI2/JFDR8) DLTF FILE(NERONI2/JFDR9) DLTF FILE(NERONI2/JFDRP) DLTCMD CMD(NERONI2/JFDR) DLTPGM PGM(NERONI2/JFDRC) DLTPGM PGM(NERONI2/JFDRL) DLTPGM PGM(NERONI2/JFDRP) DLTMSGF MSGF(NERONI2/JFDR) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JFDRX) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR1) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR2) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR3) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR6) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR7) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR8) SRCFILE(JFDR) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFDR9) SRCFILE(JFDR) SIZE(*NOMAX) CRTPRTF FILE(NERONI2/JFDRP) TEXT('File desc & rel. Prtf') + PAGESIZE(66 198) LPI(6) CPI(15) OVRFLW(60) + MAXRCDS(*NOMAX) SCHEDULE(*FILEEND) CRTBNDCL PGM(NERONI2/JFDRC) SRCFILE(JFDR) DBGVIEW(*LIST) CRTBNDCL PGM(NERONI2/JFDRL) SRCFILE(JFDR) DBGVIEW(*LIST) CRTCMD CMD(NERONI2/JFDR) PGM(JFDRC) SRCFILE(JFDR) PRDLIB(NERONI2) OVRDBF FILE(JFDR4) TOFILE(JFDR1) CRTBNDRPG PGM(NERONI2/JFDRP) SRCFILE(JFDR) DBGVIEW(*LIST) DLTOVR FILE(JFDR4) CRTMSGF MSGF(NERONI2/JFDR) TEXT('File desc & rel. Msgf') /* Messaggi del Cpp. */ ADDMSGD MSGID(JST0001) MSGF(NERONI2/JFDR) MSG('* &1') FMT((*CHAR 76)) ADDMSGD MSGID(JST0002) MSGF(NERONI2/JFDR) MSG(' ') ADDMSGD MSGID(JFD0003) MSGF(NERONI2/JFDR) MSG('Il file &1/&2 + attributo &3 non e'' un file fisico.') FMT((*CHAR 10) + (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JFD0004) MSGF(NERONI2/JFDR) MSG('File fisico di + base: &1/&2') FMT((*CHAR 10) (*CHAR 10)) /* Duplica i comandi in QGPL. */ CRTPRXCMD CMD(QGPL/JFDR) TGTCMD(NERONI2/JFDR) AUT(*USE) REPLACE(*YES) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDRC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP JFDR. */ /* */ /* File description and relations. */ /* */ PGM PARM(&FILEQ &TYPE &FORMSIZE &OUTQQ &RETAINWORK) /* Nome qualificato del file da esplorare. */ DCL VAR(&FILEQ) TYPE(*CHAR) LEN(20) /* Tipo delle informazioni da visualizzare. */ DCL VAR(&TYPE) TYPE(*CHAR) LEN(8) /* Misura del modulo. */ DCL VAR(&FORMSIZE) TYPE(*CHAR) LEN(10) /* Nome qualificato della coda di emissione. */ DCL VAR(&OUTQQ) TYPE(*CHAR) LEN(20) /* Ritiene file di lavoro. */ DCL VAR(&RETAINWORK) TYPE(*CHAR) LEN(10) /* Elenco dei file che hanno relazione col file da esplorare. */ DCLF FILE(JFDR3) /* Nome del file da esplorare. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file da esplorare. */ DCL VAR(&FILEL) TYPE(*CHAR) LEN(10) /* Nome del file da esplorare. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Nome della libreria del file da esplorare. */ DCL VAR(&FILEL) TYPE(*CHAR) LEN(10) /* Nome della coda di emissione. */ DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10) /* Nome della libreria della coda di emissione. */ DCL VAR(&OUTQL) TYPE(*CHAR) LEN(10) /* Linee per pagina. */ DCL VAR(&LPP) TYPE(*DEC) LEN(3) /* Caratteri per linea. */ DCL VAR(&CPL) TYPE(*DEC) LEN(3) /* Linee per pollice. */ DCL VAR(&LPI) TYPE(*DEC) LEN(1) /* Caratteri per pollice. */ DCL VAR(&CPI) TYPE(*DEC) LEN(2) /* Linea di eccedenza. */ DCL VAR(&OVRFLW) TYPE(*DEC) LEN(3) /* Ultimo file letto da elenco file correlati. */ DCL VAR(&WHREFILAST) TYPE(*CHAR) LEN(10) DCL VAR(&WHRELILAST) TYPE(*CHAR) LEN(10) /* Tipo del lavoro corrente. */ DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) /* Attributo del file da esplorare. */ DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta tutti gli errori saltando a fine con errore. */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORE)) /* Congela messaggi. */ /*********** JHLDMSG ************************************************** */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + l''ambiente.') TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Recupera attributi del lavoro. */ RTVJOBA TYPE(&JOBTYPE) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILEQ 1 10)) CHGVAR VAR(&FILEL) VALUE(%SST(&FILEQ 11 10)) CHGVAR VAR(&OUTQ) VALUE(%SST(&OUTQQ 1 10)) CHGVAR VAR(&OUTQL) VALUE(%SST(&OUTQQ 11 10)) /* Se la libreria e' Lista librerie, recupera la libreria effettiva. */ IF COND(&FILEL *EQ *LIBL) THEN(DO) RTVOBJD OBJ(*LIBL/&FILE) OBJTYPE(*FILE) RTNLIB(&FILEL) ENDDO /* Controlla l'esistenza del file da esplorare. */ IF COND((&FILEL *NE *ALL) *AND (&FILEL *NE + *ALLUSR)) THEN(DO) CHKOBJ OBJ(&FILEL/&FILE) OBJTYPE(*FILE) ENDDO /* Controlla che il file da esplorare sia un fisico. */ /* Se logico, elenca fisici. */ IF COND((&FILEL *NE *ALL) *AND (&FILEL *NE + *ALLUSR)) THEN(DO) RTVOBJD OBJ(&FILEL/&FILE) OBJTYPE(*FILE) + OBJATR(&OBJATR) IF COND(&OBJATR *NE PF) THEN(DO) SNDPGMMSG MSGID(JFD0003) MSGF(JFDR) MSGDTA(&FILEL *CAT + &FILE *CAT &OBJATR) MSGTYPE(*DIAG) IF COND(&OBJATR *EQ LF) THEN(CALL PGM(JFDRL) + PARM(&FILEL &FILE)) GOTO CMDLBL(CPF0001) ENDDO ENDDO /* Controlla l'esistenza della coda di emissione. */ IF COND(&OUTQQ *NE *JOB) THEN(DO) CHKOBJ OBJ(&OUTQL/&OUTQ) OBJTYPE(*OUTQ) AUT(*CHANGE) ENDDO /* Prepara file di lavoro 1. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 1.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR1T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR1) TOFILE(JFDR1T) MBR1(ZERO) + MBR2(UNO) MBR3(DUE) ENDDO CLRPFM FILE(QTEMP/JFDR1T) MBR(ZERO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR1T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR1T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 2. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 2.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR2T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR2) TOFILE(JFDR2T) ENDDO CLRPFM FILE(QTEMP/JFDR2T) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 3. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 3.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR3T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR3) TOFILE(JFDR3T) ENDDO CLRPFM FILE(QTEMP/JFDR3T) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 6. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 6.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR6T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR6) TOFILE(JFDR6T) MBR1(UNO) + MBR2(DUE) ENDDO CLRPFM FILE(QTEMP/JFDR6T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR6T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 7. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 7.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR7T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR7) TOFILE(JFDR7T) MBR1(UNO) + MBR2(DUE) ENDDO CLRPFM FILE(QTEMP/JFDR7T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR7T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 8. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 8.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR8T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR8) TOFILE(JFDR8T) MBR1(UNO) + MBR2(DUE) ENDDO CLRPFM FILE(QTEMP/JFDR8T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR8T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro 9. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro 9.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDR9T) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDR9) TOFILE(JFDR9T) MBR1(UNO) ENDDO CLRPFM FILE(QTEMP/JFDR9T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro X. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Preparo + il file di lavoro X.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) CHKOBJ OBJ(QTEMP/JFDRXT) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(DO) JCPYCLR FROMFILE(JFDRX) TOFILE(JFDRXT) MBR1(UNO) + MBR2(DUE) ENDDO CLRPFM FILE(QTEMP/JFDRXT) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDRXT) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) /* Estrae informazioni sul file. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file' *BCAT &FILEL *TCAT + '/' *CAT &FILE) TOPGMQ(*EXT) + MSGTYPE(*STATUS) DSPFD FILE(&FILEL/&FILE) TYPE(*ACCPTH) + OUTPUT(*OUTFILE) FILEATR(*PF) + OUTFILE(JFDR1T) OUTMBR(ZERO) DSPFFD FILE(&FILEL/&FILE) OUTPUT(*OUTFILE) + OUTFILE(JFDR2T) CPYF FROMFILE(JFDR2T) TOFILE(JFDR6T) TOMBR(UNO) + MBROPT(*REPLACE) /* Estrae informazioni sul file. Attributi di base. */ SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file' *BCAT &FILEL *TCAT + '/' *CAT &FILE) TOPGMQ(*EXT) + MSGTYPE(*STATUS) DSPFD FILE(&FILEL/&FILE) TYPE(*BASATR) + OUTPUT(*OUTFILE) OUTFILE(*LIBL/JFDRXT) + OUTMBR(UNO) /* Se richiesto solo tracciato, salta a stampa. */ IF COND(&TYPE *EQ *FORMAT) THEN(GOTO + CMDLBL(PRINT)) /* Estrae l'elenco dei logici che si basano sul fisico. */ DSPDBR FILE(&FILEL/&FILE) OUTPUT(*OUTFILE) + OUTFILE(JFDR3T) /* Estrae informazioni dai logici. */ CHGVAR VAR(&WHREFILAST) VALUE(' ') CHGVAR VAR(&WHRELILAST) VALUE(' ') OVRDBF FILE(JFDR3) TOFILE(JFDR3T) SECURE(*YES) READBEG: RCVF MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(READEND)) IF COND(&WHREFI *EQ ' ') THEN(GOTO + CMDLBL(READBEG)) IF COND((&WHREFI *EQ &WHREFILAST) *AND (&WHRELI + *EQ &WHRELILAST)) THEN(GOTO CMDLBL(READBEG)) CHGVAR VAR(&WHREFILAST) VALUE(&WHREFI) CHGVAR VAR(&WHRELILAST) VALUE(&WHRELI) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file correlato' *BCAT + &WHRELI *TCAT '/' *CAT &WHREFI) + TOPGMQ(*EXT) MSGTYPE(*STATUS) DSPFD FILE(&WHRELI/&WHREFI) TYPE(*ACCPTH) + OUTPUT(*OUTFILE) OUTFILE(JFDR1T) OUTMBR(DUE) CPYF FROMFILE(JFDR1T) TOFILE(JFDR1T) FROMMBR(DUE) + TOMBR(UNO) MBROPT(*ADD) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file correlato' *BCAT + &WHRELI *TCAT '/' *CAT &WHREFI) + TOPGMQ(*EXT) MSGTYPE(*STATUS) DSPFD FILE(&WHRELI/&WHREFI) TYPE(*JOIN) + OUTPUT(*OUTFILE) OUTFILE(JFDR7T) OUTMBR(DUE) CPYF FROMFILE(JFDR7T) TOFILE(JFDR7T) FROMMBR(DUE) + TOMBR(UNO) MBROPT(*ADD) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file correlato' *BCAT + &WHRELI *TCAT '/' *CAT &WHREFI) + TOPGMQ(*EXT) MSGTYPE(*STATUS) DSPFFD FILE(&WHRELI/&WHREFI) OUTPUT(*OUTFILE) + OUTFILE(JFDR6T) OUTMBR(DUE) CPYF FROMFILE(JFDR6T) TOFILE(JFDR6T) FROMMBR(DUE) + TOMBR(UNO) MBROPT(*ADD) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file correlato' *BCAT + &WHRELI *TCAT '/' *CAT &WHREFI) + TOPGMQ(*EXT) MSGTYPE(*STATUS) DSPFD FILE(&WHRELI/&WHREFI) TYPE(*SELECT) + OUTPUT(*OUTFILE) OUTFILE(JFDR8T) OUTMBR(DUE) CPYF FROMFILE(JFDR8T) TOFILE(JFDR8T) FROMMBR(DUE) + TOMBR(UNO) MBROPT(*ADD) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Estraggo + informazioni dal file correlato' *BCAT + &WHRELI *TCAT '/' *CAT &WHREFI) + TOPGMQ(*EXT) MSGTYPE(*STATUS) DSPFD FILE(&WHRELI/&WHREFI) TYPE(*BASATR) + OUTPUT(*OUTFILE) OUTFILE(JFDRXT) OUTMBR(DUE) CPYF FROMFILE(JFDRXT) TOFILE(JFDRXT) FROMMBR(DUE) + TOMBR(UNO) MBROPT(*ADD) GOTO CMDLBL(READBEG) READEND: /* Copia un file di lavoro in un altro con chiave diversa. */ /* Da elenco campi per nome interno a nome esterno. */ CPYF FROMFILE(JFDR6T) TOFILE(JFDR9T) FROMMBR(UNO) + TOMBR(UNO) MBROPT(*REPLACE) MONMSG MSGID(CPF0000 MCH0000) PRINT: SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Eseguo la + stampa.') TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Annota i valori per la stampa stretta. */ CHGVAR VAR(&LPP) VALUE(66) CHGVAR VAR(&CPL) VALUE(198) CHGVAR VAR(&LPI) VALUE(6) CHGVAR VAR(&CPI) VALUE(15) CHGVAR VAR(&OVRFLW) VALUE(60) /* Se e' richiesta la stampa normale. */ IF COND(&FORMSIZE *EQ *NORMAL) THEN(DO) /* Annota i valori per la stampa normale. */ CHGVAR VAR(&LPP) VALUE(66) CHGVAR VAR(&CPL) VALUE(132) CHGVAR VAR(&LPI) VALUE(6) CHGVAR VAR(&CPI) VALUE(10) CHGVAR VAR(&OVRFLW) VALUE(60) /* End. */ ENDDO /* Se e' richiesta la stampa compatta. */ IF COND(&FORMSIZE *EQ *COMPACT) THEN(DO) /* Annota i valori per la stampa compatta. */ CHGVAR VAR(&LPP) VALUE(88) CHGVAR VAR(&CPL) VALUE(198) CHGVAR VAR(&LPI) VALUE(8) CHGVAR VAR(&CPI) VALUE(15) CHGVAR VAR(&OVRFLW) VALUE(80) /* End. */ ENDDO /* Se e' richiesta la stampa stretta a 12 pollici. */ IF COND(&FORMSIZE *EQ *NARROW12) THEN(DO) /* Annota i valori per la stampa stretta a 12 pollici. */ CHGVAR VAR(&LPP) VALUE(72) CHGVAR VAR(&CPL) VALUE(198) CHGVAR VAR(&LPI) VALUE(6) CHGVAR VAR(&CPI) VALUE(15) CHGVAR VAR(&OVRFLW) VALUE(66) /* End. */ ENDDO /* Se e' richiesta la stampa normale a 12 pollici. */ IF COND(&FORMSIZE *EQ *NORMAL12) THEN(DO) /* Annota i valori per la stampa normale a 12 pollici. */ CHGVAR VAR(&LPP) VALUE(72) CHGVAR VAR(&CPL) VALUE(132) CHGVAR VAR(&LPI) VALUE(6) CHGVAR VAR(&CPI) VALUE(10) CHGVAR VAR(&OVRFLW) VALUE(66) /* End. */ ENDDO /* Se e' richiesta la stampa compatta a 12 pollici. */ IF COND(&FORMSIZE *EQ *COMPACT12) THEN(DO) /* Annota i valori per la stampa compatta a 12 pollici. */ CHGVAR VAR(&LPP) VALUE(96) CHGVAR VAR(&CPL) VALUE(198) CHGVAR VAR(&LPI) VALUE(8) CHGVAR VAR(&CPI) VALUE(15) CHGVAR VAR(&OVRFLW) VALUE(88) /* End. */ ENDDO /* Ridirige il file di stampa. */ IF COND(&OUTQQ *NE *JOB) THEN(DO) OVRPRTF FILE(JFDRP) PAGESIZE(&LPP &CPL) LPI(&LPI) + CPI(&CPI) OVRFLW(&OVRFLW) RPLUNPRT(*YES ' + ') OUTQ(&OUTQL/&OUTQ) USRDTA(&FILE) + SECURE(*YES) ENDDO ELSE CMD(DO) OVRPRTF FILE(JFDRP) PAGESIZE(&LPP &CPL) LPI(&LPI) + CPI(&CPI) OVRFLW(&OVRFLW) RPLUNPRT(*YES ' + ') OUTQ(*JOB) USRDTA(&FILE) SECURE(*YES) ENDDO OVRDBF FILE(JFDR1) TOFILE(JFDR1T) MBR(ZERO) + SECURE(*YES) OVRDBF FILE(JFDR2) TOFILE(JFDR2T) SECURE(*YES) OVRDBF FILE(JFDR4) TOFILE(JFDR1T) MBR(UNO) + SECURE(*YES) OVRDBF FILE(JFDR6) TOFILE(JFDR6T) MBR(UNO) + SECURE(*YES) OVRDBF FILE(JFDR7) TOFILE(JFDR7T) MBR(UNO) + SECURE(*YES) OVRDBF FILE(JFDR8) TOFILE(JFDR8T) MBR(UNO) + SECURE(*YES) OVRDBF FILE(JFDR9) TOFILE(JFDR9T) MBR(UNO) + SECURE(*YES) OVRDBF FILE(JFDRX) TOFILE(JFDRXT) MBR(UNO) + SECURE(*YES) CALL PGM(JFDRP) PARM(&TYPE) /* Completa. */ SNDPGMMSG MSG('Stampata la descrizione del file' *BCAT + &FILEL *TCAT '/' *CAT &FILE *TCAT '.') + MSGTYPE(*COMP) /* Se corre un lavoro interattivo, visualizza la stampa. */ IF COND(&JOBTYPE *EQ '1') THEN(DO) DSPSPLF FILE(JFDRP) SPLNBR(*LAST) ENDDO /* Attivita' finali. */ RCLRSC: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Dealloca. */ /* ... */ /* Cancella i file di lavoro. */ IF COND(&RETAINWORK *EQ *YES_EMPTY) THEN(DO) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Pulisco i + file di lavoro.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR1T) MBR(ZERO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR1T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR1T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR2T) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR3T) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR6T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR6T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR7T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR7T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR8T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR8T) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDR9T) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDRXT) MBR(UNO) MONMSG MSGID(CPF0000 MCH0000) CLRPFM FILE(QTEMP/JFDRXT) MBR(DUE) MONMSG MSGID(CPF0000 MCH0000) ENDDO IF COND(&RETAINWORK *EQ *NO) THEN(DO) SNDPGMMSG MSGID(JST0001) MSGF(JFDR) MSGDTA('Cancello + i file di lavoro.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR1T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR2T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR3T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR6T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR7T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR8T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDR9T) MONMSG MSGID(CPF0000 MCH0000) DLTF FILE(QTEMP/JFDRXT) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(JST0002) MSGF(JFDR) TOPGMQ(*EXT) + MSGTYPE(*STATUS) MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JFDR) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta ad Attivita' finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDRL) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Claudio Neroni 04-04-2014. Creato */ /* CLLE JFDRL. */ /* File description and relations. MsgPhyOfLgl */ /* Messaggia su quali fisici si basa un logico. */ PGM PARM(&FILEL &FILE) /* Riceve Nome del file da esplorare. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Riceve Libreria del file da esplorare. */ DCL VAR(&FILEL) TYPE(*CHAR) LEN(10) /* Ultimo file letto. */ DCL VAR(&UAPBOF) TYPE(*CHAR) LEN(10) DCL VAR(&UAPBOL) TYPE(*CHAR) LEN(10) /* Elenco delle chiavi del logico. */ DCLF FILE(JFDR1) /* Intercetta tutti gli errori. */ MONMSG MSGID(CPF0000 MCH0000) /* Prepara file di lavoro L. */ JCPYCLR FROMFILE(JFDR1) TOFILE(JFDRLT) /* Estrae informazioni sul file. */ DSPFD FILE(&FILEL/&FILE) TYPE(*ACCPTH) + OUTPUT(*OUTFILE) FILEATR(*LF) + OUTFILE(JFDRLT) /* Ridirige la lettura del file di lavoro. */ OVRDBF FILE(JFDR1) TOFILE(JFDRLT) SECURE(*YES) /* Inizializza ultimo file letto. */ CHGVAR VAR(&UAPBOF) VALUE('9999999999') CHGVAR VAR(&UAPBOL) VALUE('9999999999') /* Cicla sull'elenco. */ DOWHILE COND('1') /* Legge un record dall'elenco. */ RCVF /* Se non ce ne sono altri, abbandona. */ MONMSG MSGID(CPF0864) EXEC(LEAVE) /* Se corre il primo record di un gruppo con lo stesso file. */ IF COND(&APBOF *NE &UAPBOF *OR &APBOL *NE + &UAPBOL) THEN(DO) /* Messaggia il file. */ SNDPGMMSG MSGID(JFD0004) MSGF(JFDR) MSGDTA(&APBOL *CAT + &APBOF) TOPGMQ(*PRV (JFDRC)) MSGTYPE(*INFO) /* Se corre il primo record di un gruppo con lo stesso file. */ ENDDO /* Aggiorna ultimo file letto. */ CHGVAR VAR(&UAPBOF) VALUE(&APBOF) CHGVAR VAR(&UAPBOL) VALUE(&APBOL) /* Cicla sull'elenco. */ ENDDO ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDRP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE File description and relations. Print * Display file field description Physical file. * Claudio Neroni 07/04/1988 Creato. *--------------------------------------------------------------------------------------------- * Display file field description Physical file. FJFDR2 IP E DISK F RENAME(QWHDRFFD:JFDR2R) * Display file description Access path Physical file. FJFDR1 IS E DISK F RENAME(QWHFDACP:JFDR1R) * Display file description Access path Logical file. FJFDR4 IS E DISK F RENAME(QWHFDACP:JFDR4R) *--------------------------------------------------------------------------------------------- * Display file field description Physical & Logical file. * Chiave su nome interno. FJFDR6 IF E K DISK F RENAME(QWHDRFFD:JFDR6R) * Display file description Join. FJFDR7 IF E K DISK F RENAME(QWHFDJN:JFDR7R) * Display file description Select Logical file. FJFDR8 IF E K DISK F RENAME(QWHFDSO:JFDR8R) * Display file field description Physical & Logical file. * Chiave su nome esterno. FJFDR9 IF E K DISK F RENAME(QWHDRFFD:JFDR9R) * Display file description Basic attribute Phy & Lgl file. FJFDRX IF E K DISK F RENAME(QWHFDBAS:JFDRXR) *--------------------------------------------------------------------------------------------- * Stampa. FJFDRP O F 198 PRINTER OFLIND(*INOF) *--------------------------------------------------------------------------------------------- * Diciture di servizio. D senzachiavi c 'Senza chiavi.' D testomancante c 'Testo mancante.' *--------------------------------------------------------------------------------------------- PSDS * Program status data structure. PSDS D PSDS SDS PSDS * Job name. PSDS D PSDSJB 244 253 PSDS * User. PSDS D PSDSUS 254 263 *--------------------------------------------------------------------------------------------- * Identifica i campi del fisico. IJFDR2R 02 * Identifica le chiavi del fisico. IJFDR1R 01 I APFILE L2 I APLIB L2 I APBOLF L1 * Identifica le chiavi dei logici. IJFDR4R 04 I APFILE L2 I APLIB L2 I APBOLF L1 *--------------------------------------------------------------------------------------------- * Scambia parametri. C *ENTRY PLIST * Riceve tipo di stampa. * *ALL = Stampa tutto, tracciato e logici. * *FORMAT = Stampa solo tracciato. C PARM PPTYPE 8 * Se corre campo del fisico. C if *in02 B01 * Se corre primo campo del fisico. C if not *in12 B02 * Compone intestazioni di tabulato e di file fisico. C SETON 12 02 C TIME TIME 12 0 02 C WHK KLIST 02 C KFLD WHFILE 02 C KFLD WHLIB 02 C WHK CHAIN JFDRXR 50 02 C 50 MOVEL *ALL'?' ATTXT 02 C N50ATTXT IFEQ *BLANK B03 C MOVEL(p) testomancante ATTXT 03 C END E03 C MOVEL WHFILE HDFILE 02 C MOVEL WHLIB HDLIB 02 C *LIKE DEFINE WHFILE HDFILE 02 C *LIKE DEFINE WHLIB HDLIB 02 * Stampa intestazioni di tabulato. C EXCEPT $HDR 02 * Stampa intestazioni di file fisico. C EXCEPT $FIL 02 * Salva il nome del file fisico. C MOVEL WHNAME SVNAME 02 C *LIKE DEFINE WHNAME SVNAME 02 * Se corre primo campo del fisico. C endif E02 * Calcola posizione di fine campo. C WHFOBO ADD WHFLDB FINE1 5 0 01 C SUB 1 FINE1 01 * Se overflow, stampa intestazioni. C OF EXCEPT $HDR 01 * Conta le righe del fisico. C ADD 1 CNT02 5 0 01 * Stampa il campo del fisico C EXCEPT $FLD 01 * Se corre record campo del fisico. C endif E01 * Se corre record chiave del fisico e il nome del fisico * manca sul record corrente, lo ripristina. C 01APBOLF IFEQ *BLANK B01 C MOVEL SVNAME APBOLF 01 C END E01 * Se corre record chiave del fisico o dei logici. C if *in01 or *in04 B01 * Se corre il primo record di una chiave ed e' overflow, * stampa intestazioni. C if *inl2 and *inof B02 C EXCEPT $HDR 02 C endif E02 * Se corre il primo record di una chiave. C if *inl2 B02 * Compone le intestazioni delle chiavi di un file. C APK2 KLIST 02 C KFLD APFILE 02 C KFLD APLIB 02 C APK2 CHAIN JFDRXR 50 02 C 50 MOVEL *ALL'?' ATTXT 02 C N50ATTXT IFEQ *BLANK B03 C MOVEL(p) testomancante ATTXT 03 C ENDIF E03 * Stampa le intestazioni delle chiavi di un file. C EXCEPT $LGL 02 * Annota presenza di select e omit. C APSELO COMP 'Y' 30 02 * Stampa i join. C if atjoin = 'Y' B03 C EXSR join 03 C endif E03 * Se corre il primo record di una chiave. C endif E02 * Sceglie. C select B02 * Se il nome del campo chiave e' vuoto. C when APKEYF = *BLANK X02 * Decodifica il record logico. C APK3 KLIST 02 C KFLD APFILE 02 C KFLD APLIB 02 C KFLD APBOLF 02 C APK3 CHAIN JFDR6R 50 02 C 50 MOVEL *ALL'?' WHTEXT 02 C MOVEL(p) senzachiavi WHFTXT 02 C clear WHFLDT 02 C clear WHFLDB 02 C clear WHFLDD 02 C clear WHFLDP 02 C clear WHFLDE 02 C clear WHFLDI 02 * Se il nome del campo chiave e' *NONE. C when APKEYF = '*NONE' X02 * Decodifica il record logico. C APK3 CHAIN JFDR6R 50 02 C 50 MOVEL *ALL'?' WHTEXT 02 C clear WHFTXT 02 C clear WHFLDT 02 C clear WHFLDB 02 C clear WHFLDD 02 C clear WHFLDP 02 C clear WHFLDE 02 C clear WHFLDI 02 * Se il nome del campo chiave ha altri valori. C other X02 * Decodifica il campo chiave * e, implicitamente, il record logico. C clear WHFLDT 02 C clear WHFLDB 02 C clear WHFLDD 02 C clear WHFLDP 02 C clear WHFLDE 02 C clear WHFLDI 02 C APK KLIST 02 C KFLD APFILE 02 C KFLD APLIB 02 C KFLD APBOLF 02 C KFLD APKEYF 02 C APK CHAIN JFDR6R 50 02 C 50 MOVEL *ALL'?' WHTEXT 02 C 50 MOVEL *ALL'?' WHFTXT 02 * Sceglie. C endsl E02 * Se overflow, stampa intestazioni. C OF EXCEPT $HDR 01 * Se corre la prima chiave di un record. C if *inl1 B02 * Se manca il testo del record, annota testo mancante. C WHTEXT IFEQ *BLANK B03 C MOVEL(p) testomancante WHTEXT 03 C ENDIF E03 * Accantona il level check del record fisico. C N51 MOVEL WHSEQ WHSEQ$ 02 C *LIKE DEFINE WHSEQ WHSEQ$ 02 * Annota la diversita' del level check rispetto al fisico. C WHSEQ COMP WHSEQ$ 5252 02 * Stampa l'intestazione di record logico. C EXCEPT $RCD 02 * Annota l'avvenuto passaggio del primo record, il fisico. C N51 SETON 51 02 * Se corre la prima chiave di un record. C endif E02 * Decodifica il campo chiave. C APK CHAIN JFDR6R 50 01 C 50 CLEAR WHFLDI 01 C 50APK CHAIN JFDR9R 50 01 * Se il nome campo chiave e' significativo * ed e' diverso dal nome interno, lo annota. C SETOFF 53 01 C APKEYF IFNE *BLANK B02 C WHFLDE ANDNE WHFLDI 02 C SETON 53 02 C ENDIF E02 * Emette il campo chiave. C EXCEPT $KEY 01 * Se corre record chiave del fisico o dei logici. C endif E01 *--------------------------------------------------------------------------------------------- * Se corre fine file logico e se presenti select e omit, * esamina select e omit per stamparli. CL1 30 exsr sele *--------------------------------------------------------------------------------------------- * Se corre fine, stampa fine. CLR EXCEPT $LR *--------------------------------------------------------------------------------------------- * Esamina select e omit per stamparli. C sele begsr * Si posiziona ad inizio select-omit. C APK3 SETLL JFDR8R 50 * Se non trova select-omit, abbandona. C N50 leavesr * Elabora select-omit del logico. C DO *HIVAL B01 * Legge una select-omit. C APK3 READE JFDR8R 50 01 * Se non ce ne sono altre, abbandona. C 50 leave 01 * Pulisce le decodifiche del campo select-omit. C clear WHFLDT 01 C clear WHFLDB 01 C clear WHFLDD 01 C clear WHFLDP 01 * Se il nome del campo select-omit e' vuoto. C SOFLD IFEQ *BLANK B02 * Pulisce decodifica. C clear WHFTXT 02 * Se il nome del campo select-omit e' valorizzato. C else X02 * Decodifica il campo. C SOK KLIST 02 C KFLD SOFILE 02 C KFLD SOLIB 02 C KFLD SORFMT 02 C KFLD SOFLD 02 C SOK CHAIN JFDR6R 50 02 C 50 MOVEL *ALL'?' WHFTXT 02 * Se il nome del campo select-omit e' valorizzato. C endif E02 * Se overflow, stampa intestazioni. C OF EXCEPT $HDR 01 * Stampa select-omit. C EXCEPT $SEL 01 * Elabora select-omit del logico.. C enddo E01 C endsr *--------------------------------------------------------------------------------------------- * Esamina join per stamparli. C join begsr * Si posiziona ad inizio join. C APK2 SETLL JFDR7R 50 * Se non trova join, abbandona. C N50 leavesr * Elabora join del logico. C DO *HIVAL B01 * Legge un join. C APK2 READE JFDR7R 50 01 * Se non ce ne sono altri, abbandona. C 50 leave 01 * Se overflow, stampa intestazioni. C OF EXCEPT $HDR 01 ***************+++ * Se il nome del campo join e' vuoto. C JNJFD1 IFEQ *BLANK B02 * Pulisce decodifica. C clear WHFTXT 02 * Se il nome del campo join e' valorizzato. C else X02 * Decodifica il campo. C JOK KLIST 02 C KFLD JNFILE 02 C KFLD JNLIB 02 C KFLD APBOLF 02 C KFLD JNJFD1 02 C JOK CHAIN JFDR6R 50 02 C 50 MOVEL *ALL'?' WHFTXT 02 * Se il nome del campo join e' valorizzato. C endif E02 ***************+++ * Stampa join. C EXCEPT $JOI 01 * Elabora join del logico. C enddo E01 C endsr *--------------------------------------------------------------------------------------------- * Intestazioni di tabulato. OJFDRP E $HDR 1 02 O '------------------------' O '------------------------' O '------------------------' O '------------------------' O '------------------------' O E $HDR 1 O HDFILE O HDLIB + 1 O PSDSUS + 1 O PSDSJB + 1 O + 3 'File description and ' O 'relations' O PPTYPE + 1 O TIME + 3 '0 : : & / / ' O + 3 'Pag' O PAGE O E $HDR 2 O '------------------------' O '------------------------' O '------------------------' O '------------------------' O '------------------------' * Intestazioni di file fisico. O E $FIL 2 O ATTXT O E $FIL 2 O WHFILE O WHLIB + 1 O WHNAME + 1 O WHRLEN M + 1 O WHTEXT * Dettaglio di campo del fisico. O E $FLD 1 O CNT02 M O WHFOBO M O FINE1 M O WHFLDE O WHFLDT + 11 O WHFLDB M + 1 O WHFLDD M O WHFLDP M O WHFTXT O WHCHD1 + 1 O WHCHD2 + 1 O WHCHD3 + 1 O WHALIS + 1 * Intestazioni di un file logico. O E $LGL 1 1 O APFILE O APLIB + 1 O APFILA + 1 O + 2 'Maint: ' O APMANT O + 2 'Unique: ' O APUNIQ O + 2 'Join: ' O ATJOIN O + 2 'Testo file: ' O ATTXT * Campi join di un file logico. O E $JOI 1 O ' Join: ' O JNDNAM + 1 O JNDLNM + 1 O JNJFNM + 1 O JNJTNM + 1 O JNJFD1 + 1 O JNJFD2 + 1 O WHFTXT + 1 * Intestazioni di un recod logico. O E $RCD 1 O APBOLF + 3 O WHTEXT + 1 O N51 70 ' ' O N51 'Level check:' O N51 WHSEQ + 1 O 52 70 ' ' O 52 'Level check diverso:' O 52 WHSEQ + 1 O 52 + 1 'Fisico di base:' O 52 APBOF + 1 * Dettaglio di un campo chiave del record logico. O E $KEY 1 O APKSEQ + 6 O WHFLDE + 1 O 53 WHFLDI + 1 O WHFLDT + 1 O WHFLDB M + 1 O WHFLDD M O WHFLDP M O WHFTXT * Dettaglio di un campo select-omit del record logico. O E $SEL 1 O SORULE + 9 O SOFLD + 1 O SOCOMP + 1 O SOVALU + 1 O WHFLDT + 1 O WHFLDB M + 1 O WHFLDD M O WHFLDP M O WHFTXT * Fine stampa. O E $LR 1 O '*** Fine stampa ***' O PPTYPE + 1 *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDRX) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDBAS FORMAT(QAFDBASI) A K ATFILE A K ATLIB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDACP FORMAT(QAFDACCP) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHDRFFD FORMAT(QADSPFFD) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHDRDBR FORMAT(QADSPDBR) A K WHREFI A K WHRELI A K WHREMB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR6) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHDRFFD FORMAT(QADSPFFD) A K WHFILE A K WHLIB A K WHNAME * CORRETTO DA 10-07-1989 PER BLDKEY S36 A********* K WHFLDI CORRETTO DA 890710 PER BLDKEY S36 * ROVESCIATA CORREZIONE E RIPRISTINATA PRIMA INTENZIONE DA 31-10-2008 A********* K WHFLDE A K WHFLDI //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR7) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDJN FORMAT(QAFDJOIN) A K JNFILE A K JNLIB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR8) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHFDSO FORMAT(QAFDSELO) A K SOFILE A K SOLIB A K SORFMT //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDR9) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R QWHDRFFD FORMAT(QADSPFFD) A K WHFILE A K WHLIB A K WHNAME A K WHFLDE //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JFDT.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 20/04/1988 Creato. */ /* JFDR */ /* File description & relations. DbTest */ /* Prerequisiti: nessuno */ /* Crea un database adatto a testare l'utility JFDR. */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella tutti i file di test. */ DLTF FILE(NERONI2/JFDT*) /* Crea i file fisici. */ CRTPF FILE(NERONI2/JFDT1 ) SRCFILE(JFDR) CRTPF FILE(NERONI2/JFDT2 ) SRCFILE(JFDR) CRTPF FILE(NERONI2/JFDT3 ) SRCFILE(JFDR) CRTPF FILE(NERONI2/JFDT4 ) SRCFILE(JFDR) /* Crea i file logici. */ CRTLF FILE(NERONI2/JFDT1L ) SRCFILE(JFDR) CRTLF FILE(NERONI2/JFDT2L ) SRCFILE(JFDR) CRTLF FILE(NERONI2/JFDTBIS ) SRCFILE(JFDR) CRTLF FILE(NERONI2/JFDTJOI ) SRCFILE(JFDR) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDTBIS) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *--------------------------------------------------------------------------------------------- A R BPS1 PFILE(JFDT1) A TEXT('Bella gioia') A BPSGRU A BPDATA1 RENAME(BPSDAT) A TEXT('Data rinominata') A BPSCLA A BPSINF A K BPSGRU A K BPSDAT A K BPSCLA A O BPSDAT CMP(EQ 1) *--------------------------------------------------------------------------------------------- A R BPS2 PFILE(JFDT2) A TEXT('Della mamma') A BPSGRU A BPSDAT A BPSCLA A BPSINF A K BPSGRU A K BPSDAT A K BPSCLA A O BPSDAT CMP(EQ 2) *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDTJOI) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *--------------------------------------------------------------------------------------------- A R BPSJ A TEXT('Giunta comunale.') A JFILE(JFDT1 JFDT3 JFDT4) A J JOIN(JFDT1 JFDT3) A JFLD(BPSGRU GRUGRU) A J JOIN(JFDT1 JFDT4) A JFLD(BPSGR2 GR2GR2) A BPSGRU JREF(1) A BPSDAT JREF(1) A BPSCLA JREF(1) A BPSINF JREF(1) A BPSGR2 JREF(1) A GRUDES JREF(2) A GR2DES JREF(3) A K BPSGRU A K BPSDAT A K BPSCLA *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 19-06-2008 Creato. A UNIQUE A R BPS A TEXT('ConvComm. + A ClasseBps') A BPSGRU 2 A COLHDG('Gruppo') A BPSDAT 8 0 A COLHDG('Data' + A 'inizio' + A 'validita''') A EDTWRD(' - - ') A BPSCLA 2 0 A COLHDG('Classe' + A 'bps') A EDTCDE(M) A BPSINF 5 0 A COLHDG('Limite' + A 'inferiore' + A 'incluso') A EDTCDE(M) A BPSGR2 2 A COLHDG('Gruppo' 'due') A K BPSDAT A K BPSGRU A K BPSCLA //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT1L) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 19-06-2008 Creato. * ConvComm. ClasseBps A UNIQUE A R BPS A PFILE(JFDT1) A K BPSGRU A K BPSDAT A K BPSINF //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 19-06-2008 Creato. A** UNIQUE A R BPS A TEXT('ConvComm. + A ClasseBps') A BPSGRU 2 A COLHDG('Gruppo') A BPSDAT 8 0 A COLHDG('Data' + A 'inizio' + A 'validita''') A EDTWRD(' - - ') A BPSCLA 2 0 A COLHDG('Classe' + A 'bps') A EDTCDE(M) A BPSINF 5 0 A COLHDG('Limite' + A 'inferiore' + A 'incluso') A EDTCDE(M) A** K BPSGRU A** K BPSDAT A** K BPSCLA //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT2L) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 19-06-2008 Creato. * ConvComm. ClasseBps A UNIQUE A R BPS A PFILE(JFDT1) A BPSGRU A BPSGRU1 1 I SST(BPSGRU 1) A TEXT('Gruppo primo byte') A COLHDG('Gruppo' 'primo' 'byte') A BPSGRU2 1 I SST(BPSGRU 2) A COLHDG('Gruppo' 'secondo' 'byte') A BPSDAT A BPSCLA A BPSGRUCLA I CONCAT(BPSGRU BPSCLA) A COLHDG('Gruppo' '+classe') A BPSINF A K BPSGRU A K BPSDAT A K BPSINF A K BPSGRU1 A K BPSGRUCLA //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 27-06-2008 Creato. A UNIQUE A R GRU A TEXT('Gruppo') A GRUGRU 2 A COLHDG('Gruppo') A GRUDES 20 A COLHDG('Descrizione' + A 'gruppo') A K GRUGRU //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFDT4) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * CN09 Claudio Neroni 27-06-2008 Creato. A UNIQUE A R GR2 A TEXT('Gruppo due') A GR2GR2 2 A COLHDG('Gruppo' 'due') A GR2DES 20 A COLHDG('Descrizione' + A 'gruppo' 'due') A K GR2GR2 //ENDSRC //ENDBCHJOB