//BCHJOB JOB(JFNC) JOBD(QBATCH) OUTQ(QPRINT) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it di Claudio Neroni */ /* SE L'USO DELLA JOB DESCRIPTION "QBATCH" TI E' IMPEDITO, */ /* UTILIZZANE UNA DIVERSA. */ /* From System: "PUB1" */ /* From Library: "NERONI2" */ /* Unload Time: 2009-01-26 00:06 */ /* To File : "JFNC" */ /* To Library : "NERONI2" */ /* To Text : "Function. 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 "JFNC.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:\JFNC.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JFNC.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(JFNC) 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/JFNC" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JFNC) MBR(JFNC.) 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/JFNC) CRTSRCPF FILE(NERONI2/JFNC) RCDLEN(112) + TEXT('Function. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(§FNCAPA) TOFILE(NERONI2/JFNC) + TOMBR(§FNCAPA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(§FNCAPA) + SRCTYPE(CLP) + TEXT('Esegue tutti i param per azione architetturale.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(§FNCMS) TOFILE(NERONI2/JFNC) + TOMBR(§FNCMS) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(§FNCMS) + SRCTYPE(CLP) + TEXT('Gestisce subfile messaggi.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(§FNCMS1) TOFILE(NERONI2/JFNC) + TOMBR(§FNCMS1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(§FNCMS1) + SRCTYPE(RPG) + TEXT('Scrive record in subfile messaggi.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNC) TOFILE(NERONI2/JFNC) + TOMBR(JFNC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNC) + SRCTYPE(CMD) + TEXT('Function. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNC.) TOFILE(NERONI2/JFNC) + TOMBR(JFNC.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNC.) + SRCTYPE(CL) + TEXT('Function. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCAP) TOFILE(NERONI2/JFNC) + TOMBR(JFNCAP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCAP) + SRCTYPE(CMD) + TEXT('Restituisce parametro per azione architetturale.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCAPE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCAPE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCAPE) + SRCTYPE(RPG) + TEXT('Restituisce parametro per azione architetturale.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCB) TOFILE(NERONI2/JFNC) + TOMBR(JFNCB) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCB) + SRCTYPE(CLLE) + TEXT('Function. CreateCollection') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCC) TOFILE(NERONI2/JFNC) + TOMBR(JFNCC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCC) + SRCTYPE(RPG) + TEXT('Function. ActivatePgm') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCHK) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCHK) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCHK) + SRCTYPE(CLLE) + TEXT('Function. CheckCommand') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCVTZ) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCVTZ) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCVTZ) + SRCTYPE(RPG) + TEXT('Function. CvtFileFromRelZ') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCVT0) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCVT0) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCVT0) + SRCTYPE(RPG) + TEXT('Function. CvtFileFromRel0') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCVT1) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCVT1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCVT1) + SRCTYPE(RPG) + TEXT('Function. CvtFileFromRel1') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCVT2) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCVT2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCVT2) + SRCTYPE(RPG) + TEXT('Function. CvtFileFromRel2') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCVT3) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCVT3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCVT3) + SRCTYPE(RPG) + TEXT('Function. CvtFileFromRel3') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCCW) TOFILE(NERONI2/JFNC) + TOMBR(JFNCCW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCCW) + SRCTYPE(DSPF) + TEXT('Function. ActivatePgm') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCE) + SRCTYPE(RPG) + TEXT('Function. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCEW) TOFILE(NERONI2/JFNC) + TOMBR(JFNCEW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCEW) + SRCTYPE(DSPF) + TEXT('Function. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCEXE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCEXE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCEXE) + SRCTYPE(CLLE) + TEXT('Function. ExecCommand') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCFG) TOFILE(NERONI2/JFNC) + TOMBR(JFNCFG) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCFG) + SRCTYPE(CMD) + TEXT('Function. Restituisce funzione nel gruppo.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCFGE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCFGE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCFGE) + SRCTYPE(RPG) + TEXT('Function. Restituisce funzione nel gruppo.') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCGE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCGE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCGE) + SRCTYPE(CBL) + TEXT('Function. MngFile') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCGEIND) TOFILE(NERONI2/JFNC) + TOMBR(JFNCGEIND) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCGEIND) + SRCTYPE(CBL) + TEXT('Function. MngFileIndicatorUsage') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCGEW) TOFILE(NERONI2/JFNC) + TOMBR(JFNCGEW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCGEW) + SRCTYPE(DSPF) + TEXT('Function. MngFile') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCK) TOFILE(NERONI2/JFNC) + TOMBR(JFNCK) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCK) + SRCTYPE(CMD) + TEXT('Function. KeyCmd. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCKA) TOFILE(NERONI2/JFNC) + TOMBR(JFNCKA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCKA) + SRCTYPE(CMD) + TEXT('Function. GrpCmd. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCKAE) TOFILE(NERONI2/JFNC) + TOMBR(JFNCKAE) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCKAE) + SRCTYPE(CLLE) + TEXT('Function. GrpCmd. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCK0) TOFILE(NERONI2/JFNC) + TOMBR(JFNCK0) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCK0) + SRCTYPE(CLLE) + TEXT('Function. KeyCmd. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCK1) TOFILE(NERONI2/JFNC) + TOMBR(JFNCK1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCK1) + SRCTYPE(RPG) + TEXT('Function. KeyCmd. RtvCmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCMANCA) TOFILE(NERONI2/JFNC) + TOMBR(JFNCMANCA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCMANCA) + SRCTYPE(CLP) + TEXT('Function. Manca') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCNEW) TOFILE(NERONI2/JFNC) + TOMBR(JFNCNEW) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCNEW) + SRCTYPE(RPG) + TEXT('Function. CheckLevelNew') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLD) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLD) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLD) + SRCTYPE(CLP) + TEXT('Function. CvtFileFromRel...') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLDZ) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLDZ) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLDZ) + SRCTYPE(RPG) + TEXT('Function. CtlLvlRelZ') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLD0) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLD0) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLD0) + SRCTYPE(RPG) + TEXT('Function. CtlLvlRel0') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLD1) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLD1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLD1) + SRCTYPE(RPG) + TEXT('Function. CtlLvlRel1') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLD2) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLD2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLD2) + SRCTYPE(RPG) + TEXT('Function. CtlLvlRel2') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCOLD3) TOFILE(NERONI2/JFNC) + TOMBR(JFNCOLD3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCOLD3) + SRCTYPE(RPG) + TEXT('Function. CtlLvlRel3') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCR) TOFILE(NERONI2/JFNC) + TOMBR(JFNCR) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCR) + SRCTYPE(CLLE) + TEXT('Function. ReceiveDiagnostics') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCUSR) TOFILE(NERONI2/JFNC) + TOMBR(JFNCUSR) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCUSR) + SRCTYPE(RPG) + TEXT('Function. RtvUsr') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCX) TOFILE(NERONI2/JFNC) + TOMBR(JFNCX) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCX) + SRCTYPE(PF) + TEXT('Function. FileNew') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCXZ) TOFILE(NERONI2/JFNC) + TOMBR(JFNCXZ) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCXZ) + SRCTYPE(PF) + TEXT('Function. FileRelZ') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCX0) TOFILE(NERONI2/JFNC) + TOMBR(JFNCX0) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCX0) + SRCTYPE(PF) + TEXT('Function. FileRel0') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCX1) TOFILE(NERONI2/JFNC) + TOMBR(JFNCX1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCX1) + SRCTYPE(PF) + TEXT('Function. FileRel1') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCX2) TOFILE(NERONI2/JFNC) + TOMBR(JFNCX2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCX2) + SRCTYPE(PF) + TEXT('Function. FileRel2') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JFNCX3) TOFILE(NERONI2/JFNC) + TOMBR(JFNCX3) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JFNC) MBR(JFNCX3) + SRCTYPE(PF) + TEXT('Function. FileRel3') /*---------------------------------------------------------------------*/ //DATA FILE(§FNCAPA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §FNCAPA. */ /* */ /* Esegue tutti i comandi scritti */ /* nei parametri per l'azione architetturale. */ /* */ PGM PARM(&KPJBA) /* Parametro architetturale. */ DCL VAR(&KPJBA) TYPE(*CHAR) LEN(502) /* Azione in esecuzione. */ DCL VAR(&KCDAZ) TYPE(*CHAR) LEN(10) /* Riga del parametro per l'azione. */ DCL VAR(&ROW) TYPE(*CHAR) LEN(10) /* Parametro per l'azione. */ DCL VAR(&PARM) TYPE(*CHAR) LEN(512) /* Descrizione della funzione. */ DCL VAR(&DES) TYPE(*CHAR) LEN(50) /* Messaggio di esecuzione. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(80) /* Recupero felice del parametro per l'azione. */ DCL VAR(&FOUND) TYPE(*LGL) /* Ultimo parametro per l'azione. */ DCL VAR(&LAST) TYPE(*LGL) /* File dei parametri per l'azione. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) VALUE(§FNCAP) /* Libreria del file dei parametri per l'azione. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) VALUE(*LIBL) /* Membro del file dei parametri per l'azione. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Funzione richiesta. */ DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(6) /* Tipo lavoro. */ DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) /* Message reference key. */ DCL VAR(&MRK) TYPE(*CHAR) LEN(4) /* Tipo macchina AS400 o S38. */ DCL VAR(&AS400) TYPE(*CHAR) LEN(1) /* Esecutore del comando. */ DCL VAR(&EXEC) TYPE(*CHAR) LEN(10) /* Recupera le caratteristiche del lavoro corrente. */ RTVJOBA TYPE(&TYPE) /* Estrae il codice dell'azione in esecuzione */ /* dal parametro di architettura. */ CHGVAR VAR(&KCDAZ) VALUE(%SST(&KPJBA 60 4)) /* Predispone la ricerca del primo parametro per l'azione. */ CHGVAR VAR(&FUNCTION) VALUE(*FIRST) /* Label di ricerca parametro. */ PARMSEARCH: /* Chiama la ricerca del parametro per l'azione. */ §FNCFG GROUP(&KCDAZ) FUNCTION(&ROW) + REQUEST(&FUNCTION) DES(&DES) CMD(&PARM) + MSG(&MSG) FOUND(&FOUND) LAST(&LAST) + AS400(&AS400) FILE(&FILE) LIB(&LIB) MBR(&MBR) /* Se non lo trova. */ IF COND(*NOT &FOUND) THEN(DO) /* Salta a fine. */ GOTO CMDLBL(END) /* End. */ ENDDO /* Se il messaggio è in bianco. */ IF COND(&MSG *EQ ' ') THEN(DO) /* Assume la descrizione come messaggio. */ CHGVAR VAR(&MSG) VALUE(&DES) /* End. */ ENDDO /* Segnala l'avanzamento del lavoro. */ SNDPGMMSG MSGID(§ST0001) MSGF(§MSGF) MSGDTA(&MSG) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Sceglie l'esecutore del comando. */ IF COND(&AS400 *EQ '1') THEN(CHGVAR VAR(&EXEC) + VALUE(QCMDEXC)) ELSE CMD(CHGVAR VAR(&EXEC) VALUE(QCAEXEC)) /* Esegue il parametro trovato come comando. */ CALL PGM(&EXEC) PARM(&PARM 512) /* Se il comando in esecuzione viene annullato con CMD 1 sul prompter, */ /* se ne frega. */ MONMSG MSGID(CPF6801) /* Se eseguendo riscontra errori. */ MONMSG MSGID(CPF0000 MCH0000 EDT0000 RPG0000 + CBL0000) EXEC(DO) /* Segnala alla coda errori e al video. */ §ERRQ MSGID(§PZ0012) MSGF(§MSGF) MSGFLIB(*LIBL) + MSGDTA(&KCDAZ *CAT &ROW *CAT &FILE *CAT + &LIB *CAT &MBR *CAT &PARM) TOCALLER(*NO) /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(§ST0002) MSGF(§MSGF) TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* Se il lavoro è interattivo. */ IF COND(&TYPE *EQ '1') THEN(DO) /* Visualizza i messaggi del chiamante. */ §WRNMSGD CALLERPGM(§FNCAPA) MSGID(§WM0011) /* End. */ ENDDO /* Manda un rilascio al chiamante, tanto per incidentarlo. */ SNDPGMMSG MSGID(§EX0030) MSGF(§MSGF) MSGDTA('Voglio + job log!') MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000) /* Salta a fine. */ GOTO CMDLBL(END) /* End. */ ENDDO /* Se l'ultimo parametro è già stato restituito. */ IF COND(&LAST) THEN(DO) /* Salta a fine. */ GOTO CMDLBL(END) /* End. */ ENDDO /* Se la ricerca appena avvenuta era per il primo parametro. */ IF COND(&FUNCTION *EQ *FIRST) THEN(DO) /* Predispone la ricerca del successivo parametro per l'azione. */ CHGVAR VAR(&FUNCTION) VALUE(*NEXT) /* End. */ ENDDO /* Salta alla ricerca di un altro parametro. */ GOTO CMDLBL(PARMSEARCH) /* Label di fine. */ END: /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(§ST0002) MSGF(§MSGF) TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* Se il lavoro è interattivo. */ IF COND(&TYPE *EQ '1') THEN(DO) /* Riceve un messaggio dalla propria coda. */ RCVMSG RMV(*NO) KEYVAR(&MRK) /* Se c'è in coda almeno un messaggio. */ IF COND(&MRK *NE ' ') THEN(DO) /* Visualizza i messaggi del chiamante. */ §WRNMSGD CALLERPGM(§FNCAPA) MSGID(§WM0011) /* End. */ ENDDO /* End. */ ENDDO /* Ritorna. */ RETURN ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(§FNCMS) FILETYPE(*SRC) ENDCHAR('//ENDSRC') PGM PARM(&RECNBR) /* Chiave messaggio. */ DCL VAR(&MRK) TYPE(*CHAR) LEN(4) /* Numero di record. */ DCL VAR(&RECNBR) TYPE(*DEC) LEN(5 0) VALUE(0) /* Messaggio. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(80) CHGVAR VAR(&RECNBR) VALUE(0) CHGVAR VAR(&MSG) VALUE(' ') /* Label di ricezione messaggi. */ RCVMSG: /* Riceve un messaggio per volta e lo scrive nel sfl messaggi */ /* tramite l'uso della message reference key. */ RCVMSG PGMQ(*SAME §FNX) RMV(*NO) KEYVAR(&MRK) + MSG(&MSG) IF COND(&MRK *EQ ' ') THEN(GOTO CMDLBL(ENDRCV)) CHGVAR VAR(&RECNBR) VALUE((&RECNBR + 1)) CALL PGM(§FNCMS1) PARM(&MRK '§FNX ' &RECNBR) MONMSG MSGID(RPG9001) CMPDTA('§FNCMS1 RPG1299') + EXEC(GOTO CMDLBL(ENDPGM)) GOTO CMDLBL(RCVMSG) ENDRCV: ENDPGM: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(§FNCMS1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') F§FNXW O E WORKSTN F RECNBRKSFILE MSGR C *ENTRY PLIST C PARM MRK C PARM PGM C PARM RECNBR 50 C WRITEMSGR C RETRN //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §FNC. */ /* */ /* Esegue collezione funzioni. */ /* */ CMD PROMPT('Esegue collezione funzioni') PARM KWD(KPJBA) TYPE(*CHAR) LEN(502) + CONSTANT(*NOKPJBA) PARM KWD(FILE) TYPE(FILE) PROMPT('File collezione') FILE: QUAL TYPE(*NAME) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('nella libreria') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNC.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JFNC.) JOBD(QBATCH) OUTQ(QPRINTS) ENDSEV(60) LOG(4 + 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 13-08-1982 Creato. */ /* JFNC */ /* Function. */ /* Prerequisiti: nessuno */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JFNC) DLTCMD CMD(NERONI2/JFNCK) DLTCMD CMD(NERONI2/JFNCFG) DLTCMD CMD(NERONI2/JFNCAP) DLTCMD CMD(NERONI2/JFNCKA) DLTPNLGRP PNLGRP(NERONI2/JFNCP) DLTF FILE(NERONI2/JFNCEW) DLTPGM PGM(NERONI2/JFNCE) DLTPGM PGM(NERONI2/JFNCB) DLTPGM PGM(NERONI2/JFNCNEW) DLTPGM PGM(NERONI2/JFNCCHK) DLTPGM PGM(NERONI2/JFNCEXE) DLTPGM PGM(NERONI2/JFNCUSR) DLTPGM PGM(NERONI2/JFNCK0) DLTPGM PGM(NERONI2/JFNCK1) DLTPGM PGM(NERONI2/JFNCR) DLTPGM PGM(NERONI2/JFNCFGE) DLTPGM PGM(NERONI2/JFNCAPE) DLTPGM PGM(NERONI2/JFNCKAE) DLTPGM PGM(NERONI2/JFNCOLD) DLTPGM PGM(NERONI2/JFNCOLDZ) DLTPGM PGM(NERONI2/JFNCOLD0) DLTPGM PGM(NERONI2/JFNCOLD1) DLTPGM PGM(NERONI2/JFNCOLD2) DLTPGM PGM(NERONI2/JFNCOLD3) DLTPGM PGM(NERONI2/JFNCCVTZ) DLTPGM PGM(NERONI2/JFNCCVT0) DLTPGM PGM(NERONI2/JFNCCVT1) DLTPGM PGM(NERONI2/JFNCCVT2) DLTPGM PGM(NERONI2/JFNCCVT3) DLTF FILE(NERONI2/JFNCX ) DLTF FILE(NERONI2/JFNCXZ) DLTF FILE(NERONI2/JFNCX0) DLTF FILE(NERONI2/JFNCX1) DLTF FILE(NERONI2/JFNCX2) DLTF FILE(NERONI2/JFNCX3) DLTF FILE(NERONI2/JFNCCW) DLTPGM PGM(NERONI2/JFNCC) DLTMSGF MSGF(NERONI2/JFNC) /* Crea gli oggetti. */ CRTCMD CMD(NERONI2/JFNC) PGM(JFNCE) SRCFILE(JFNC) ALLOW(*INTERACT + *IPGM *EXEC) MSGF(JFNC) HLPPNLGRP(JFNCP) HLPID(CMD) + PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JFNCK) PGM(JFNCK0) SRCFILE(JFNC) MSGF(JFNC) + HLPPNLGRP(JFNCKP) HLPID(CMD) PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JFNCKA) PGM(JFNCKAE) SRCFILE(JFNC) MSGF(JFNC) + HLPPNLGRP(JFNCKAP) HLPID(CMD) PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JFNCFG) PGM(JFNCFGE) SRCFILE(JFNC) ALLOW(*BPGM + *IPGM) MSGF(JFNC) HLPPNLGRP(JFNCFGP) HLPID(CMD) + PRDLIB(NERONI2) CRTCMD CMD(NERONI2/JFNCAP) PGM(JFNCAPE) SRCFILE(JFNC) ALLOW(*BPGM + *IPGM) MSGF(JFNC) HLPPNLGRP(JFNCAPP) HLPID(CMD) + PRDLIB(NERONI2) CRTPF FILE(NERONI2/JFNCX ) SRCFILE(JFNC) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFNCXZ) SRCFILE(JFNC) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFNCX0) SRCFILE(JFNC) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFNCX1) SRCFILE(JFNC) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFNCX2) SRCFILE(JFNC) SIZE(*NOMAX) CRTPF FILE(NERONI2/JFNCX3) SRCFILE(JFNC) SIZE(*NOMAX) CRTDSPF FILE(NERONI2/JFNCEW) SRCFILE(JFNC) RSTDSP(*YES) CRTDSPF FILE(NERONI2/JFNCGEW) SRCFILE(JFNC) RSTDSP(*YES) CRTRPGPGM PGM(NERONI2/JFNCE) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCNEW) SRCFILE(JFNC) OPTION(*LSTDBG) CRTCBLPGM PGM(NERONI2/JFNCGE) SRCFILE(JFNC) OPTION(*LSTDBG) CRTBNDCL PGM(NERONI2/JFNCB) SRCFILE(JFNC) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JFNCCHK) SRCFILE(JFNC) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JFNCEXE) SRCFILE(JFNC) DBGVIEW(*ALL) CRTRPGPGM PGM(NERONI2/JFNCUSR) SRCFILE(JFNC) OPTION(*LSTDBG) CRTBNDCL PGM(NERONI2/JFNCK0) SRCFILE(JFNC) DBGVIEW(*ALL) CRTRPGPGM PGM(NERONI2/JFNCK1) SRCFILE(JFNC) OPTION(*LSTDBG) CRTBNDCL PGM(NERONI2/JFNCR) SRCFILE(JFNC) DBGVIEW(*ALL) CRTPNLGRP PNLGRP(NERONI2/JFNCP) SRCFILE(JFNC) CRTDSPF FILE(NERONI2/JFNCCW) SRCFILE(JFNC) RSTDSP(*YES) CRTRPGPGM PGM(NERONI2/JFNCC) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCFGE) SRCFILE(JFNC) GENLVL(21) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCAPE) SRCFILE(JFNC) GENLVL(21) OPTION(*LSTDBG) CRTBNDCL PGM(NERONI2/JFNCKAE) SRCFILE(JFNC) DBGVIEW(*ALL) CRTBNDCL PGM(NERONI2/JFNCOLD) SRCFILE(JFNC) DBGVIEW(*ALL) CRTRPGPGM PGM(NERONI2/JFNCOLDZ) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCOLD0) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCOLD1) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCOLD2) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCOLD3) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCCVTZ) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCCVT0) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCCVT1) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCCVT2) SRCFILE(JFNC) OPTION(*LSTDBG) CRTRPGPGM PGM(NERONI2/JFNCCVT3) SRCFILE(JFNC) OPTION(*LSTDBG) CRTMSGF MSGF(NERONI2/JFNC) TEXT('Function. Msgf') /* Messaggi del Ccp. */ ADDMSGD MSGID(JKY0001) MSGF(NERONI2/JFNC) MSG('La chiave "&1" manca + nell''anagrafico.') SECLVL('La chiave "&1", o la chiave + sostituente a cui essa punta, manca nell''anagrafico dei + comandi con chiave. Aggiungi il record nell''anagrafico. + Il dfu §KEYU sull''anagrafico §KEY può essere chiamato + con "§KEY §KEY".') FMT((*CHAR 10)) ADDMSGD MSGID(JKY0002) MSGF(NERONI2/JFNC) MSG('Errore durante + l''esecuzione del comando chiave "&1".') SECLVL('E'' + avvenuto un errore durante l''esecuzione tramite QCAEXEC + del comando trovato sul record anagrafico reperito + tramite la chiave "&1". Il dfu §KEYU sull''anagrafico + §KEY può essere chiamato con "§KEY §KEY".') FMT((*CHAR + 10)) ADDMSGD MSGID(JKY0011) MSGF(NERONI2/JFNC) MSG('La chiave &1 &2 manca + nel file &3.&4.') SECLVL('La chiave con gruppo "&1" e + funzione "&2", o la chiave sostituente a cui essa punta, + manca nell''anagrafico dei comandi con chiave &3.&4. + Aggiungi il record nell''anagrafico. Il programma di + manutenzione può essere ottenuto tramite CMD10 dal menù + di lavoro chiamato dal comando "JFNC FILE(&3.&4)".') + FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JKY0012) MSGF(NERONI2/JFNC) MSG('Errore durante + l''esecuzione del comando &1 &2 dal file &3.&4.') + SECLVL('Si è verificato un errore imprevisto durante + l''esecuzione tramite QCAEXEC del comando trovato sul + record con chiave gruppo "&1" funzione "&2" o sul record + sostituente a cui esso punta nell''anagrafico dei + comandi con chiave &3.&4. Correggi il record + nell''anagrafico o correggi la situazione che provoca + l''errore. Il programma di manutenzione può essere + ottenuto tramite CMD10 dal menù di lavoro chiamato dal + comando "JFNC FILE(&3.&4)".') FMT((*CHAR 10) (*CHAR 10) + (*CHAR 10) (*CHAR 10)) ADDMSGD MSGID(JKY0013) MSGF(NERONI2/JFNC) MSG('Il gruppo &1 manca + nel file &2.&3.') SECLVL('Il gruppo "&1" manca + nell''anagrafico dei comandi con chiave &2.&3. Aggiungi + il gruppo nell''anagrafico aggiungendo almeno un record + funzione per tale gruppo. Il programma di manutenzione + può essere ottenuto tramite CMD10 dal menù di lavoro + chiamato dal comando "JFNC FILE(&2.&3)".') FMT((*CHAR + 10) (*CHAR 10) (*CHAR 10)) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCAP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §FNCAP. */ /* */ /* Restituisce parametro per azione architetturale. */ /* */ CMD PROMPT('Parametro per azione arch') PARM KWD(ACTION) TYPE(*CHAR) LEN(10) MIN(1) + EXPR(*YES) PROMPT('Azione architetturale') PARM KWD(ROW) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var Riga nell''azione') PARM KWD(FUNCTION) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*FIRST) VALUES(*FIRST *NEXT) EXPR(*YES) + PROMPT('Funzione richiesta') PARM KWD(PARM) TYPE(*CHAR) LEN(512) RTNVAL(*YES) + PROMPT('Var Parametro per l''azione') PARM KWD(MSG) TYPE(*CHAR) LEN(80) RTNVAL(*YES) + PROMPT('Var Messaggio di esecuzione') PARM KWD(FOUND) TYPE(*LGL) RTNVAL(*YES) + PROMPT('Var Trovato parametro') PARM KWD(LAST) TYPE(*LGL) RTNVAL(*YES) + PROMPT('Var Ultimo parametro') PARM KWD(FILE) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var File parametri') PARM KWD(LIB) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var Libreria file parametri') PARM KWD(MBR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var Membro file parametri') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCAPE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Restituisce parametro per azione architetturale. * * RPG §FNCAP. * FJFNCX IF E K DISK * Parametro per azione architetturale. * Chiave unica su * azione, * riga. FIDS F KINFDS FIDS FIDS * Riga di continuazione del file di cui serve la FIDS * file information data structure. ERRQ E §N 122 1 Dati corti msg FIDS IFIDS DS FIDS * File information data structure. FIDS I 83 92 FIDSFL FIDS * File. FIDS I 93 102 FIDSLB FIDS * Libreria. FIDS I 129 138 FIDSMB FIDS * Membro. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PGRP I Azione C PARM PFNC U Riga C PARM PFRQ 6 I Funzione rich C PARM PCMD O Parametro C PARM PMSG O Parametro C PARM PFND 1 O Trovato C PARM PLAS 1 O Ultimo C PARM FIDSFL PFIL O File C PARM FIDSLB PLIB O Libreria C PARM FIDSMB PMBR O Membro * Definisce i parametri. C *LIKE DEFN U1GRP PGRP C *LIKE DEFN U1FNC PFNC C *LIKE DEFN U1CMD PCMD C *LIKE DEFN U1MSG PMSG C *LIKE DEFN FIDSFL PFIL C *LIKE DEFN FIDSLB PLIB C *LIKE DEFN FIDSMB PMBR * Definisce azione ricevuta come chiave. C H1 KLIST C KFLD PGRP * Definisce azione e riga ricevute come chiave. C H2 KLIST C KFLD PGRP C KFLD PFNC * Definisce gruppo e funzione sostitutivi come chiave. C S2 KLIST C KFLD U1GR2 C KFLD U1FN2 * Disdice il riposizionamento. C SETOF 55 * Se la funzione richiesta è *ONLY. C* PFRQ IFEQ '*ONLY' * Cerca il primo del gruppo di record * relativi all'azione richiesta. C* H1 CHAINU1R 50 * Se non ci sono record per l'azione. C* 50 DO * Segnala l'errore. C* EXSR §ERR * Asterisca i parametri da restituire. C* MOVEL*ALL'*' PCMD C* MOVEL*ALL'*' PMSG * Annota non trovato parametro. C* MOVEL*ZERO PFND * Annota ultimo parametro ormai restituito. C* MOVEL'1' PLAS * Predispone la chiusura del programma. C* SETON LR * Ritorna. C* RETRN * End. C* END * Trascrive i parametri da restituire. C* MOVELU1FNC PFNC C* MOVELU1CMD PCMD C* MOVELU1MSG PMSG * Annota trovato parametro. C* MOVEL'1' PFND * Annota ultimo parametro ormai restituito. C* MOVEL'1' PLAS * Predispone la chiusura del programma. C* SETON LR * Ritorna. C* RETRN * End. C* END * Se la funzione richiesta è *FIRST. C PFRQ IFEQ '*FIRST' * Cerca il primo del gruppo di record * relativi all'azione richiesta. C H1 CHAINU1R 50 *****++++++++++++++++++++++++ * Se il record è stato trovato. C N50 DO * Trascrive la funzione da restituire. C MOVELU1FNC PFNC * Se il gruppo o la funzione sostitutivi non sono in bianco. C U1GR2 IFNE *BLANK C U1FN2 ORNE *BLANK * Cerca il record sostitutivo. C S2 CHAINU1R 50 * Se il record sostitutivo esiste, * prenota il riposizionamento. C N50 SETON 55 * End. C END * End. C END *****------------ * Se non ci sono record per l'azione. C 50 DO * Segnala l'errore. C EXSR §ERR * Asterisca i parametri da restituire. C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG * Annota non trovato parametro. C MOVEL*ZERO PFND * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Trascrive i parametri da restituire. C MOVELU1CMD PCMD C MOVELU1MSG PMSG * Annota trovato parametro. C MOVEL'1' PFND * Annota ultimo parametro non ancora restituito. C MOVEL*ZERO PLAS ******************** * Se prenotato il riposizionamento. C 55 DO * Si riposiziona lungo il file * oltre il record titolare appena recuperato. C H2 SETGTU1R * End. C END *** * * * * * * * * * * * * * * * Legge il prossimo record del gruppo * relativo all'azione ricevuta. C H1 READEU1R 50 * Se nel gruppo relativo all'azione ricevuta * non ci sono altri record. C 50 DO * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END **************** * Ritorna. C RETRN * End. C END * Se la funzione richiesta è *NEXT. C PFRQ IFEQ '*NEXT' * Si posiziona lungo il file * oltre il record con azione e riga ricevute. C H2 SETGTU1R 50 * Se non ci sono altri record nel file. C 50 DO * Asterisca i parametri da restituire. C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG * Annota non trovato parametro. C MOVEL*ZERO PFND * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Legge il prossimo record del gruppo * relativo all'azione ricevuta. C H1 READEU1R 50 *****++++++++++++++++++++++++ * Se il record è stato trovato. C N50 DO * Trascrive la funzione da restituire. C MOVELU1FNC PFNC * Se il gruppo o la funzione sostitutivi non sono in bianco. C U1GR2 IFNE *BLANK C U1FN2 ORNE *BLANK * Cerca il record sostitutivo. C S2 CHAINU1R 50 * Se il record sostitutivo esiste, * prenota il riposizionamento. C N50 SETON 55 * End. C END * End. C END *****------------ * Se nel gruppo relativo all'azione ricevuta * non ci sono altri record. C 50 DO * Asterisca i parametri da restituire. C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG * Annota non trovato parametro. C MOVEL*ZERO PFND * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Trascrive i parametri da restituire. C MOVELU1CMD PCMD C MOVELU1MSG PMSG * Annota trovato parametro. C MOVEL'1' PFND * Annota ultimo parametro non ancora restituito. C MOVEL*ZERO PLAS ******************** * Se prenotato il riposizionamento. C 55 DO * Si riposiziona lungo il file * oltre il record titolare appena recuperato. C H2 SETGTU1R * End. C END *** * * * * * * * * * * * * * * ******************** * Legge il prossimo record del gruppo * relativo all'azione ricevuta. C H1 READEU1R 50 * Se nel gruppo relativo all'azione ricevuta * non ci sono altri record. C 50 DO * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END **************** * Ritorna. C RETRN * End. C END * Se la funzione richiesta è diversa da quelle sin qui considerate. C DO * Segnala parametro imprevisto. C *M§PR0002 DSPLY §DSPLY 1 * Asterisca i parametri da restituire. C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG * Annota non trovato parametro. C MOVEL*ZERO PFND * Annota ultimo parametro ormai restituito. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END /EJECT *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C §ERR BEGSR * Compone il messaggio di errore e lo spedisce. *------------------------------------------------------------------- * Decide il messaggio. C MOVEL'§PZ0011' ERRQID * Compone i dati per il messaggio. C MOVE *BLANK §N C MOVEAPGRP §N,1 C MOVEAFIDSFL §N,11 C MOVEAFIDSLB §N,21 C MOVEAFIDSMB §N,31 * Chiama la spedizione. C EXSR ERRQ C ENDSR ERRQ /EJECT ERRQ *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ERRQ C ERRQ BEGSR ERRQ * Segnala alla coda degli errori di elaborazione. ERRQ *------------------------------------------------------------------- ERRQ * Chiama la spedizione del messaggio ad una coda di errori. ERRQ * Il modulo riceve solo 122 caratteri per il messaggio ERRQ * perché autonomamente si incarica di riempire i primi 10 ERRQ * mancanti col nome di suo padre o di suo nonno. ERRQ C CALL '§ERRQ' ERRQ C PARM ERRQID 7 I Msg identific ERRQ C PARM '§MSGF' ERRQFI 10 I Msg file ERRQ C PARM '*LIBL' ERRQLB 10 I Msg lib ERRQ C PARM §N I Msg dati ERRQ C PARM '*DFT' ERRQQU 10 I Msg coda ERRQ C PARM '*NONE' ERRQQ2 10 I Msg coda 2 ERRQ C PARM '0' ERRQFH 1 I Msg al padre ERRQ C PARM '1' ERRQWS 1 I Msg al video ERRQ C PARM '0' ERRQSY 1 I Msg a sysopr ERRQ C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCB) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* ------- CREAZIONE FILE COLLEZIONE FUNZIONI */ PGM PARM(&FILE &LIB &RTCODE) DCL VAR(&FILE) TYPE(*CHAR) LEN(10) DCL VAR(&LIB) TYPE(*CHAR) LEN(10) DCL VAR(&RTCODE) TYPE(*LGL) /* Errore di livello sul file aperto come nuovo. */ DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(1) /* Stato del file secondo rpg aperto come nuovo. */ DCL VAR(&STS) TYPE(*CHAR) LEN(5) MONMSG MSGID(CPF0000 MCH0000 RPG0000) EXEC(GOTO + CMDLBL(FINE)) CHGVAR VAR(&RTCODE) VALUE('0') /* ------- TEST PRESENZA FILE */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(CREATE)) GOTO CMDLBL(ERRORE) /* ------- CREAZIONE FILE */ CREATE: JCPYCLR FROMFILE(JFNCX) TOFILE(&LIB/&FILE) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORE)) RNMM FILE(&LIB/&FILE) MBR(JFNCX) NEWMBR(&FILE) MONMSG MSGID(CPF0000) GOTO CMDLBL(EXIT) /* ------- ERRORI */ ERRORE: CHGVAR VAR(&RTCODE) VALUE('1') /* ------- FINE LAVORO */ EXIT: /* Controlla l'esistenza e l'autorità sul file. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(*FIRST) + AUT(*OBJEXIST) /* Se il file non esiste o non è autorizzato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Ritorna subito. */ RETURN /* End. */ ENDDO /* Ridirige il controllo di livello sul file nuovo. */ OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del nuovo. */ CALL PGM(*LIBL/JFNCNEW) PARM(&LVLCHK &STS) /* Se il file è quello ultima edizione. */ IF COND(&LVLCHK *NE '1') THEN(DO) /* Crea il file commenti. */ CRTSRCPF FILE(&LIB/(%SST(&FILE 1 9) *TCAT H)) + TEXT('Collezione di funzioni: testi + d''aiuto.') SIZE(*NOMAX) /* End. */ ENDDO /* Fine. */ FINE: ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Attiva il programma scelto. FJFNCCW CF E WORKSTN $P IKPJBA E DS * PARAMETRI DI STATO ********************************************** I SDS I 1 10 PGMNAM I 37 390NPARM I 254 263 WUSERD C EXSR OPEN OPEN ******************************************************************** * RICHIESTA PROGRAMMA E ATTIVAZIONE ******************************************************************** C PGMLD TAG * ------- PUT FORMATO RICHIESTA PARAMETRI C EXFMTGETPGM C SETOF 8182 C 01 GOTO EXIT EOJ C WPGM COMP *BLANKS 81 C 81 GOTO PGMLD * ------- ATTIVAZIONE PROGRAMMA C WKPJBA IFEQ 'SI' * CON KPJBA C 10 MOVE KPJBU XPJBU SAVE KPJBU C CALL WPGM 82 C PARM KPJBA C 10 MOVE XPJBU KPJBU RESTORE KPJBU C 82 GOTO PGMLD LOAD ERROR C ELSE * SENZA KPJBA C CALL WPGM 82 C 82 GOTO PGMLD C END * -------- RIPROPONE NUOVA RICHIESTA C GOTO PGMLD * -------- FINE LAVORO C EXIT TAG C CALL 'QCAEXEC' 50 C PARM 'RCLRSC '§EXECM 8 C PARM 8 §EXELE 155 C RETRN ******************************************************************** * ROUTINE DI APERTURA E INIZIALIZZAZIONE ******************************************************************** C OPEN BEGSR * ACQUISIZIONE KPJBA DALL'ARCHITETTURA C *ENTRY PLIST C PARM KPJBA * TEST PRESENZA KPJBA C NPARM COMP 1 10 * IMPOSTA PARAMETRI DI DEFAULT C WKPJBA IFEQ *BLANKS C 10 MOVE 'SI' WKPJBA C N10 MOVE 'NO' WKPJBA C END * DEFINIZIONI C *LIKE DEFN KPJBU XPJBU C OPENE ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCHK) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §CACHECK. */ /* */ /* Copre controllo comando per cobol. */ /* */ PGM PARM(&CMD2000 &CMDLEN &MODE400 &QCACHECKOK) /* Riceve. Comando eseguibile. */ DCL VAR(&CMD2000) TYPE(*CHAR) LEN(2000) /* Riceve. Lunghezza del comando eseguibile. */ DCL VAR(&CMDLEN) TYPE(*DEC) LEN(15 5) /* Riceve. Ordine di eseguire in modo 400. */ DCL VAR(&MODE400) TYPE(*LGL) /* Restituisce. Il comando eseguibile è giusto. */ DCL VAR(&QCACHECKOK) TYPE(*LGL) /* Assume comando giusto. */ CHGVAR VAR(&QCACHECKOK) VALUE('1') /* Se richiesto il controllo in modo 400. */ IF COND(&MODE400) THEN(DO) /* Chiama il controllo del comando in modo 400. */ CALL PGM(QCMDCHK) PARM(&CMD2000 &CMDLEN) /* Se il comando è sbagliato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Annota comando in errore. */ CHGVAR VAR(&QCACHECKOK) VALUE('0') /* End. */ ENDDO /* End. */ ENDDO /* Se non richiesto il controllo in modo 400. */ ELSE CMD(DO) /* Chiama il controllo del comando. */ CALL PGM(QCACHECK) PARM(&CMD2000 &CMDLEN) /* Se il comando è sbagliato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Annota comando in errore. */ CHGVAR VAR(&QCACHECKOK) VALUE('0') /* End. */ ENDDO /* End. */ ENDDO /* Ritorna. */ ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCVTZ) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Converte collezione da rilascio Z a corrente. * * RPG §FNCCVTZ. * FJFNCXZ IP E DISK F §PRMAZNR KRENAMEOLD FJFNCX O E DISK C EJECT TAG /EJECT C MOVEL*BLANK U1GRP C MOVEL§PAZN U1GRP C MOVEL*BLANK U1FNC C MOVEL§PRIG U1FNC C MOVEL*BLANK U1GR2 C MOVEL*BLANK U1FN2 C MOVEL*BLANK U1DES C MOVEL*BLANK U1TYP C MOVEL*BLANK U1ATR C MOVEL*BLANK U1CMD C MOVEL§PJBU U1CMD C MOVEL*BLANK U1HLM C MOVEL*BLANK U1MSG C WRITEU1R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCVT0) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Converte collezione da rilascio 0 a corrente. * * RPG §FNCCVT0. * FJFNCX0 IP E DISK F §KEYR KRENAMEOLD FJFNCX O E DISK C EJECT TAG /EJECT C MOVEL*BLANK U1GRP C MOVEL*BLANK U1FNC C MOVELLLKEY U1FNC C MOVEL*BLANK U1GR2 C MOVEL*BLANK U1FN2 C MOVELLLKEYS U1FN2 C MOVEL*BLANK U1DES C MOVELLLMSG U1DES C MOVEL*BLANK U1TYP C MOVEL*BLANK U1TYP C MOVEL*BLANK U1ATR C MOVEL*BLANK U1ATR C MOVEL*BLANK U1CMD C MOVELLLCMD U1CMD C MOVEL*BLANK U1HLM C MOVEL*BLANK U1MSG C MOVELLLMSG U1MSG C WRITEU1R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCVT1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Converte collezione da rilascio 1 a corrente. * * RPG §FNCCVT1. * FJFNCX1 IP E DISK F U$COLRK KRENAMEOLD FJFNCX O E DISK C EJECT TAG /EJECT C MOVEL*BLANK U1GRP C MOVEL*BLANK U1FNC C MOVELUNAME U1FNC C MOVEL*BLANK U1GR2 C MOVEL*BLANK U1FN2 C MOVEL*BLANK U1DES C MOVELUDESCR U1DES C MOVEL*BLANK U1TYP C MOVELUTYPE U1TYP C MOVEL*BLANK U1ATR C MOVELUATTR U1ATR C MOVEL*BLANK U1CMD C MOVELUCMD U1CMD C MOVEL*BLANK U1HLM C MOVEL*BLANK U1MSG C MOVELUDESCR U1MSG C WRITEU1R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCVT2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Converte collezione da rilascio 2 a corrente. * * RPG §FNCCVT2. * FJFNCX2 IP E DISK F U1R KRENAMEOLD FJFNCX O E DISK C EJECT TAG /EJECT C MOVEL*BLANK U1HLM C MOVEL*BLANK U1GR2 C MOVEL*BLANK U1FN2 C MOVEL*BLANK U1MSG C MOVELU1DES U1MSG C WRITEU1R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCVT3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Converte collezione da rilascio 3 a corrente. * * RPG §FNCCVT3. * FJFNCX3 IP E DISK F U1R KRENAMEOLD FJFNCX O E DISK C EJECT TAG /EJECT C MOVEL*BLANK U1GR2 C MOVEL*BLANK U1FN2 C MOVEL*BLANK U1MSG C MOVELU1DES U1MSG C WRITEU1R //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCCW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A DSPSIZ(24 80 *DS3) A MSGLOC(24) A PRINT A CA03(01 'Fine Lavoro') A CHGINPDFT A R GETPGM A TEXT('RICHIESTA PROGRAMMA + A DA ATTIVARE') A BLINK A KEEP A WUSERD 10A O 1 2DSPATR(HI) A TEXT('DESCRIZIONE UTENTE') A 1 23' ATTIVAZIONE PROGRAMMI A SCELTA - A ' A DSPATR(UL) A 1 69'-- ----- --' A DSPATR(HI) A 6 14'Nome Programma:' A WPGM 10A B 6 31DSPATR(CS) A DSPATR(HI) A CHECK(VN) A 81 ERRMSG('Nome programma errato.') A 82 ERRMSG('Attivazione con errori') A 6 44'Passaggio KPJBA ?' A WKPJBA 2A B 6 63DSPATR(CS) A DSPATR(HI) A N10 DSPATR(PR) A VALUES('SI' 'NO') A 23 2'F3' A DSPATR(HI) A +1'Fine lavoro' A 4 2' - A - A ' A DSPATR(UL) A 7 2' - A - A ' A DSPATR(UL) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Esegue collezione funzioni. * * RPG §FNC. * * 44 Indicatore di comodo di Claudio Neroni. * * Giovanni Pozzi xx/xx/82 * Creato. * Claudio Neroni 30/12/85 * Riaggiustato e completato. FJFNCX IF E K DISK UC FIDS F KINFDS FIDS FIDS * Riga di continuazione del file di cui serve la FIDS * file information data structure. FJFNCEW CF E WORKSTN $P F RECNUMKSFILE SUBFILE E CMD 1 3 80 CMD INTERNI E QCA 600 1 CMD WORK-AREA E** WRK 21 1 E C 512 1 Comando spezzato E H 10 1 File aiuto spezz IKPJBA E DS * PARAMETRI DI STATO ********************************************** I SDS I 1 10 PGMNAM I 37 390NPARM I 254 263 WUSERD * RIDEFINIZIONE CHIAVI PER GESTIONE SUBFILE *********************** I DS $P I 1 1 U01RAD $K I DS $P I 1 20 U01KEY $K I 1 10 XCOD1 $K I 11 20 XCOD2 $K I DS $P I 1 1 U01FRD $K I DS $P I 1 20 U01FKY $K I 1 10 U1GRP $K I 11 20 U1FNC $K I DS $P I 1 20 WSVKEY $K I 1 10 WSVKE1 $K I 11 20 WSVKE2 $K IPARM2 DS $P I 1 10 PFILE I 11 20 PLIBR $K IJFNCD UDS $P I 1 10 LFILE I 11 20 LLIBR $K IU1CMD DS $P * Spezza il comando nei suoi caratteri. I 1 512 C I DS $P * Isola i primi dieci caratteri del nome qualificato * del file di aiuto. I 1 20 HLPF I 1 10 H FIDS IFIDS DS FIDS * File information data structure. FIDS I 83 92 FIDSFI FIDS * File. FIDS I 93 102 FIDSLB FIDS * Libreria. C EXSR OPEN OPEN C 01 GOTO EXIT EXIT C RERUN TAG C EXSR SRU01 DISPLAY C EXSR CLOSEF CLOSE C EXIT TAG C SETON LR CLR CALL 'QCMDEXC' 50 RECLAIM CLR PARM 'RCLRSC '§EXECM 8 CLR PARM 8 §EXELE 155 ********************************************************************* ** ** ROUTINE GENERALIZZATA DI GESTIONE SUBFILE ** ----------------------------------------- ** ** LA ROUTINE RICEVE IN INPUT: ** U01RAD - CHIAVE DI RADICE ** U01KEY - CHIAVE DI SUFFISSO ** U01MOD - SENSO DI LETTURA B=INDIETRO ** ** LA ROUTINE RITORNA IN OUTPUT: ** U01KRR - CHIAVE DI RADICE DELLA SCELTA ** U01KRK - CHIAVE DI SUFFISSO SCELTA ** U01SCE - TIPO DI SCELTA ** ** INDICATORI N25 - TASTO ENTR SU SUB-FILE ** 26 - ROLL UP / FINE PAGIN. IN AVANTI ** 27 - ROLL DOWN / FINE PAGINAZ. INDIETRO ** 28 - SUB-FILE VUOTO ** 29 - REIMPOSTAZIONE SUB-FILE ** 30 - INDICATORE DI LAVORO (RIUSABILE ESTERN) ** ********************************************************************* CSR SRU01 BEGSR ****** ABILITAZIONE ROLLUP/ROLLDOWN ******************************* C SETON 08 ****** DEFINIZIONI ************************************************ C *LIKE DEFN U01RAD U01KRR DEF. RAD RITOR. C *LIKE DEFN U01KEY U01KRK DEF. KEY RITOR. C *LIKE DEFN U01RAD U01KSR DEF. SAVE RAD C *LIKE DEFN U01KEY U01KSK DEF. SAVE KEY C *LIKE DEFN U01KEY U01KSC DEF.KEY SCELTA C *LIKE DEFN U01KEY U01KBG DEF. FIRST KEY C *LIKE DEFN U01KEY U01KEN DEF. LAST KEY ****** SAVE PARAMETRI DI INGRESSO *************************** C MOVE U01MOD U01MOD 1 DEFINIZIONE C MOVE U01RAD U01KSR SAVE RADICE C MOVE U01KEY U01KSK SAVE KEY C MOVE U01KEY U01KSC SET KEY SCELTA C MOVE *BLANKS U01KRR BLANK RAD RIT. C MOVE *BLANKS U01KRK BLANK KEY RIT. C MOVE *BLANKS U01SCE 1 BLANK TIPO RIT. C MOVE *IN30 U01I30 1 SAVE IND. 30 ****** IMPOSTAZIONE PARAMETRI INIZIALI *************************** C SETON 01 NO PUTRETAIN C SETON 29 NUOVO SUBFILE C SETOF 262799RESET C Z-ADD0 U01PAG 50 DIMENS.PAGINA C Z-ADD0 U01SCR 50 DIMENS.SCORRIM. C Z-ADD0 U01DIM 50 DIMENS.LETTURA C Z-ADD0 U01LIM 50 LIMITE RIEMPIM. C Z-ADD0 U01MAX 50 RRNN ULT.PAGINA C Z-ADD0 U01HIG 50 RRNN MAXIMO C Z-ADD0 U01LOW 50 RRNN MINIMO C Z-ADD0 U01RRN 50 RRNN SUBFILE C Z-ADD0 U01RRC 50 RRNN RK RICERC. C Z-ADD0 U01SVF 50 SAVE RRNN FIRST C Z-ADD0 U01SVR 50 SAVE RRNN C Z-ADD0 U01SVM 50 SAVE MAX C Z-ADD0 U01CNT 50 RES. COUNTER C MOVE '0' U01SW1 1 SW.PAG. VUOTA C EXSR SRU01A SET DIMENSIONI ****** TEST SENSO DI LETTURA INIZIALE **************************** C T01MOD TAG C U01MOD CABNE'B' T01TOP IN AVANTI C U01KEY CABNE*BLANKS T01TOP C MOVE *HIVAL U01KEY DAL FONDO C GOTO T01BCK ****** OPERAZIONI DI PREPARAZIONE LETTURA IN AVANTI ************** C T01TOP TAG C Z-ADD1 U01ADD 10 INCREMENTO C EXSR SRU01D SETLL C *IN99 IFEQ '0' NO ERRORE C U01FKY IFNE U01KEY NON TROVATA C SETON 99 ERRORE C END C END C *IN99 IFEQ '1' PER ERRORE C SETOF 99 C Z-ADD-1 U01ADD ARRETRA C EXSR SRU01D SETLL C N99 MOVE U01FKY U01KEY SET CHIAVE C END C Z-ADD0 U01RRN RRNN SUBFILE C Z-ADD1 U01ADD FORZA AVANTI C Z-ADDU01SCR U01DIM DIM. LETTURA C GOTO T01CLR ****** OPERAZIONI DI PREPARAZIONE LETTURA INDIETRO *************** C T01BCK TAG C Z-ADDU01PAG U01DIM DIM. LETTURA C U01DIM ADD 1 U01RRN IMPOSTA A FINE C Z-ADD-1 U01ADD DECREMENTO ****** OPERAZIONI GENERALI DI PREPARAZIONE LETTURA *************** C T01CLR TAG C SETON 28 SUBFILE VUOTO C MOVE *HIVAL U01KBG PULIZIA C MOVE *LOVAL U01KEN PULIZIA C MOVE '1' U01SW1 RESET C Z-ADD0 U01HIG RESET C Z-ADD0 U01LOW RESET C Z-ADD0 U01RRC RESET PC C Z-ADDU01DIM U01MAX MASSIMO RRN C EXSR SRU01B PREP.DATI HEAD C EXSR SRU01C CLEAR/DISP.HEAD C EXSR SRU01D IMPOST.SETLL C *IN99 IFEQ '1' SE FILE VUOTO C U01ADD IFEQ 1 SE AVANTI C MOVE *HIVAL U01KEN IMPOSTA EOF C ELSE SE INDIETRO C MOVE *LOVAL U01KBG IMPOSTA BOF C END C Z-ADD0 U01RRN PAGINA 1 C GOTO T01WRT SCRIVE SFL C END ****** LETTURA E RIEMPIMENTO PAGINA SUBFILE ********************** C T01RDS TAG C MOVE '0' U01SW1 RESET C Z-ADD0 U01SVF RESET SAVE C Z-ADD0 U01CNT RESET COUNTER C DO *HIVAL LOOP/CARICAMEN. C EXSR SRU01E LETT.INPUT C *IN99 IFEQ '1' SE FINE LETTURA C U01ADD IFEQ 1 IN AVANTI C MOVE *HIVAL U01KEN IMPOSTA EOF C ELSE SE FINE INDIETR C MOVE *LOVAL U01KBG IMPOSTA INIZIO C END C GOTO T01RDE FINE LETTURA C END C U01SW1 IFEQ '0' PRIMO CICLO C U01MAX IFGT U01LIM OLTRE IL LIMITE C MOVE U01FKY U01KEY IMPOSTO KEY C GOTO T01TOP RIT. ALL'INIZIO C END C END C U01FKY IFLT U01KBG C MOVE U01FKY U01KBG IMP.KEY INIZIO C END C U01FKY IFGT U01KEN C MOVE U01FKY U01KEN IMP.KEY FINE C END C ADD U01ADD U01RRN AGG. RRNN SUBF. C U01RRN IFGT U01HIG C Z-ADDU01RRN U01HIG RRNN PIU' ALTO C END C U01LOW IFEQ 0 C Z-ADDU01RRN U01LOW RRNN PIU' BASSO C END C U01RRN IFLT U01LOW C Z-ADDU01RRN U01LOW RRNN PIU' BASSO C END C EXSR SRU01F SCRITT.SUBFILE C U01FKY IFEQ U01KSC SE = KEY SCELTA C MOVE U01RRN U01RRF C EXSR SRU01O POS. CURSORE C END C SETOF 28 C U01SW1 IFEQ '0' C MOVE '1' U01SW1 ALMENO 1 RK C Z-ADDU01RRN U01SVF SAVE FIRST RRNN C END C ADD 1 U01CNT INCR. CONTATORE C U01CNT CABEQU01DIM T01RDE PAGINA PIENA C T01RDN TAG RITORNO A LEGG. C END C T01RDE TAG C Z-ADDU01SVF U01RRN SET RRN X DISPL C *IN99 IFEQ '1' TEST ERRORE C U01SW1 IFEQ '0' NESSUN DATO C Z-ADDU01SVM U01MAX RESTORE C Z-ADDU01SVR U01RRN RESTORE C SETON 26 C END C END ****** DISPLAY SUBFILE SU VIDEO ********************************** C T01WRT TAG C MOVE *IN28 SVIN28 1 SAVE INDICATOR C EXSR SRU01G WRITE SUBFILE C SETOF 262799 C Z-ADDU01MAX U01SVM SAVE C Z-ADDU01RRN U01SVR SAVE ****** LETTURA RISPOSTA DAL TERMINALE ***************************** C EXSR SRU01H READ INPUT C MOVE SVIN28 *IN28 C 01 GOTO T01END FINE LAVORO C 05 MOVE U01KSK U01KEY REIMPOSTA KEY C 05 GOTO T01MOD RINFRESCO DATI C 03 EXSR CMD03 CALL QCL C 03 GOTO T01WRT RIENTRO C 06 EXSR CMD06 DSPMSG C 06 GOTO T01WRT RIENTRO C 07 EXSR CMD07 CALL A RICH. C 07 GOTO T01WRT RIENTRO C 13 EXSR CMD13 CAMBIO FILE C 88 EXSR CMD10 Gestisce collez C 88 MOVE U01KSK U01KEY REIMPOSTA KEY C 88 GOTO T01MOD RINFRESCO DATI C 02 DO C EXSR HELP HELP C GOTO T01WRT C END ****** TEST ROLL IN AVANTI *************************************** C T01RUP TAG C *IN26 IFEQ '1' C SETOF 26 C Z-ADDU01HIG U01RRN ULT. PAGINA C U01KEN IFEQ *HIVAL TEST FINE AVANT C SETON 2699 FINE AVANTI C GOTO T01WRT PUT ERROR C END * ELIMINAZIONE CADAVERI C U01LOW IFNE 1 SE C'ERANO C MOVE U01KBG U01KEY CADAV.INIZ. C GOTO T01TOP LEGGI DA INIZ. C END * CONTINUAZIONE LETTURA IN AVANTI C EXSR SRU01M RIPOSIZIONA C U01ADD IFEQ -1 SE INDIETRO C Z-ADDU01SCR U01DIM DIM. LETTURA C Z-ADD1 U01ADD FORZA AVANTI C END C ADD U01DIM U01MAX INCREMENTO C GOTO T01RDS NUOVA PAGINA C END ****** TEST ROLL INDIETRO ***************************************** C *IN27 IFEQ '1' C SETOF 27 C Z-ADD1 U01RRN FORZA 1A-PAG C U01KBG IFEQ *LOVAL C SETON 2799 C GOTO T01WRT C END C MOVE U01KBG U01KEY C MOVE U01ADD U01SVA 10 SAVE SENSO C Z-ADD-1 U01ADD SET INDIETRO C EXSR SRU01D SETLL C MOVE U01SVA U01ADD RESTORE C *IN99 IFEQ '1' C EXSR SRU01M RIPOSIZIONA C SETON 27 ERRORE C GOTO T01WRT PUT-ERROR C END C GOTO T01BCK VA A LEGGERE C END ****** TEST OPERAZIONI CONNESSE AL TASTO ENTR ******************** C *IN25 IFEQ '0' C SETOF 30 * TEST SCELTA C EXSR SRU01I TEST SCELTA C N30 DO USCITA X SCELTA C EXSR PGMLD ATTIVA PGM C 29 GOTO T01MOD NUOVO SUBFILE C GOTO T01WRT RIENTRO NORMALE C END * TEST PRESENZA CHIAVE DI RICERCA C EXSR SRU01J TEST RICERCA C 30 SETON 26 FORZA ROLLUP C 30 GOTO T01RUP C MOVE U01KEY U01KSC SAVE KEY SCELTA * TEST SE LA RICERCA E' NEI LIMITI VISUALIZZATI C *IN29 CABEQ'1' T01MOD NUOVO SUBFILE C EXSR SRU01K CERCA IN SUBFLE C *IN30 CABEQ'1' T01TOP NON COMPRESO C Z-ADDU01RRF U01RRN SET RRNN C GOTO T01WRT PUT DISPLAY C END ****** IMPOSTAZIONE PARAMETRI USCITA ****************************** C T01END TAG C MOVE U01I30 *IN30 RESTORE *IN30 C ENDSR ******************************************************************** * IMPOSTA PARAMETRI DIMENSIONI SUB-FILE $P ******************************************************************** C SRU01A BEGSR C Z-ADD14 U01PAG AMPIEZZA PAGE C Z-ADD14 U01SCR RIGHE DA RIEMP. C Z-ADD140 U01LIM LIMITE MASSIMO C ENDSR ******************************************************************** * PREPARAZIONE DATI PER EMISSIONE SUBFILE CONTROL RECORD $P ******************************************************************** C SRU01B BEGSR C ENDSR ******************************************************************** * CLEAR SUB-FILE ET DISPLAY FORMATO DI TESTA ******************************************************************** C SRU01C BEGSR C 01 WRITETESTA TESTATE C SETON 60 CLEAR/DISPLAY C WRITECONTROL WRITE/CONTROL C SETOF 600129RESET 01 C ENDSR ******************************************************************** * POSIZIONA LETTURA CON SETLL - 99 ON FINE FILE - ******************************************************************** C SRU01D BEGSR C U01KLS SETLLJFNCX 99 POSIZIONAM. $P C SETOF 99 NO FINE FILERA C EXSR SRU01E RIPOSIZIONA TI C N99 U01KLS SETLLJFNCX RIPOSIZIONA $P C TS01DE ENDSR ******************************************************************** * LETTURA DATI DA CARICARE NEL SUB-FILE ******************************************************************** C SRU01E BEGSR C TS01E1 TAG C U01ADD IFEQ 1 TEST SENSO LET. C READ JFNCX 99LETTURA AVANTI $P C ELSE C READPJFNCX 99LETT. INDIETRO $P C END C N99 EXSR SRU01L TEST FINE DATI C N99 EXSR SRU01P INCLUSIONE C N99N30 GOTO TS01E1 NUOVA RICERCA C ENDSR ******************************************************************** * SCRITTURA DATI NEL SUBFILE $P ******************************************************************** C SRU01F BEGSR * SPOSTAMENTO DATI NELL'AREA DI EMISSIONE DEL SUB-FILE C EXSR SCMBS * POSIZIONA RECNUM DEL SUB-FILE C Z-ADDU01RRN SVRRNN SAVE RECNUM C Z-ADDU01RRN RECNUM SET RECNUM * ATTIVA INDICATORI DI RIGA C SETOF 72 PC/BLINK * EMISSIONE RIGA SUB-FILE C WRITESUBFILE WRITE RECORDRD C ENDSR ******************************************************************** * EMISSIONE SUB-FILE E FORMATO DI FONDO PAGINA ******************************************************************** C SRU01G BEGSR C Z-ADDU01RRN RECNUM SET RECNUM C EXSR ERRMSG SET ERRORS C 01 WRITETESTA TESTATE C SETON 61 SFL/DISPLAY C WRITECONTROL SFL/CONTROL C 28 WRITESFLMSG SFL-VUOTO C EXSR RESERR RESET ERRORS C EXSR RESMSG RESET MSG C SETOF 61 C ENDSR ******************************************************************** * LETTURA RISPOSTA DAL TERMINALE ******************************************************************** C SRU01H BEGSR C SETOF 012627RESET C READ CONTROL 3030READ SUBFILE C 01 GOTO TS01HE CM01-EOJ C EXSR CMDKEY TEST CMD-KEYS C TS01HE ENDSR ******************************************************************** * TEST SCELTA SULLE RIGHE DEL SUBFILE - SE NO 30 ON - ******************************************************************** C SRU01I BEGSR C DO *HIVAL C READCSUBFILE 3030READ CHANGE C 30 GOTO TS01IE NO CHANGE C WSCELT COMP 'X' 3030 C 30 WSCELT COMP 'P' 3030 C 30 WSCELT COMP 'H' 3030 C N30 MOVE WSCELT XSCELT C N30 MOVE SVRRNN U01RRF GET RECNUM C N30 EXSR SRU01O SET ATTRIBUTES C N30 MOVE U01RRF U01RRN POSIZ. DISPLAY C N30 GOTO TS01IE C END C TS01IE ENDSR ******************************************************************** * TEST PRESENZA CHIAVE DI RICERCA - SE NO 30 ON - ******************************************************************** C SRU01J BEGSR C WCOD1 COMP *BLANKS 30 $K C 30 WCOD2 COMP *BLANKS 30 $K C 30 GOTO TS01JE C MOVE *BLANKS XCOD1 RESET C MOVE WCOD1 XCOD1 SET KEY $K C MOVE *BLANKS XCOD2 RESET C MOVE WCOD2 XCOD2 SET KEY $K C TS01JE ENDSR ******************************************************************** * RICERCA ENTRO I LIMITI DEL SUB-FILE - SE NO 30 ON - ******************************************************************** C SRU01K BEGSR C U01LOW CABEQ0 TS01KE 30 * TEST SE COMPRESO NEL SUBFILE C U01LOW CHAINSUBFILE 30 GET FIRST C N30 U01KEY COMP WSVKEY 30 TEST C N30 U01HIG CHAINSUBFILE 30 GET LAST C N30 U01KEY COMP WSVKEY 30 TEST C 30 GOTO TS01KE NON COMPRESO * RICERCA NEL SUBFILE PER UGUALE O MAGGIORE C U01LOW DO *HIVAL U01RRF 50 C U01RRF CHAINSUBFILE 30 GET SFL/RECORD C 30 GOTO TS01KE FINE SUB-FILE C WSVKEY COMP U01KEY 30 C 30 END C WSVKEY IFEQ U01KEY PER UGUALE C EXSR SRU01O POS. CURSOR C ELSE ALTRIMENTI C EXSR SRU01N RESET PRECED C END C TS01KE ENDSR ******************************************************************** * CONTROLLO FINE LETTURA - SE FINE 99 ON - ******************************************************************** C SRU01L BEGSR C SETOF 99 C ENDSR ******************************************************************** * RIPOSIZIONAMENTO LETTURA IN AVANTI ******************************************************************** C SRU01M BEGSR C MOVE U01KEN U01KEY RESTORE KEY C U01KLS SETGTJFNCX 99 SET GREATER $P C SETOF 99 C ENDSR ******************************************************************** * RIPRISTINA ATTRIBUTI PRECEDENTE RIGA DI SUBFILE ******************************************************************** C SRU01N BEGSR C U01RRC IFGT 0 C U01RRC CHAINSUBFILE 30 GET PRECED. C N30 SETOF 72 RESET PC C N30 WSCELT COMP *BLANK 4343 Sflnxtchg C N30 UPDATSUBFILE UPDATE C SETOF 43 C Z-ADD0 U01RRC RESET RRNN C END C ENDSR ******************************************************************** * ATTIVA ATTRIBUTI CORRENTE RIGA DI SUBFILE ******************************************************************** C SRU01O BEGSR C EXSR SRU01N C U01RRF CHAINSUBFILE 30 GET RECORD C N30 SETON 72 SETON PC C N30 MOVE *BLANK WSCELT RESET WSCELT C N30 UPDATSUBFILE UPDATE C N30 MOVE U01RRF U01RRC SAVE C ENDSR ******************************************************************** * TESTA INCLUSIONE RECORD DA VISUALIZZARE SE SI 30 ON ******************************************************************** C SRU01P BEGSR C SETON 30 SET VALID C 10 U1TYP COMP 'P' 50 C 10 50 U1ATR COMP 'K' 50 C 10 50 SETOF 30 INVALID C TS01PE ENDSR ******************************************************************** * USCITA PER ESECUZIONE SCELTA FUNZIONE ******************************************************************** C PGMLD BEGSR * ------- GET RECORD FUNZIONE C WSVKE0 KLIST C KFLD WSVKE1 C KFLD WSVKE2 C WSVKE0 CHAINJFNCX 50 GET FUNZIONE C 50 SETON 91 ERRORE C 50 GOTO PGMLDE EXIT C U1CMD COMP *BLANKS 50 Cmd bianco C 50 SETON 95 ERRORE C 50 GOTO PGMLDE EXIT * ------- TEST CONGRUENZA FRA TIPO SCELTA E FUNZIONE C U1TYP COMP 'P' 50 C XSCELT COMP 'P' 52 C 50 52 SETON 94 C 50 52 GOTO PGMLDE * ------- RESET PUTRETAIN E PRE-RICEZIONE MSG. DIAGNOSTICI C SETON 01 RESTORE DISPLAY C EXSR RCVDIA * Se è richiesto il testo di aiuto della funzione. C XSCELT IFEQ 'H' * Costruisce il nome qualificato del file contenente * il testo di aiuto. C MOVELLFILE HLPF C Z-ADD1 HI 30 C *BLANK LOKUPH,HI 44 C N44 Z-ADD10 HI C MOVEL'H' H,HI C MOVE LLIBR HLPF * Chiama la visualizzazione del testo di aiuto. C CALL 'JDSPSRCC' 50 C PARM HLPF C PARM U1HLM * Annota l'eventuale errore nella visualizzazione. C 50 SETON 92 LOAD ERROR * Salta a fine esecuzione. C GOTO PGMLDE EXIT * End. C END * ------- ATTIVAZIONE PROGRAMMA C U1TYP IFEQ 'P' C MOVELU1CMD UPGM 10 PROGRAM NAME * Rialza il nome del programma. C CALL 'QDCXLATE' C PARM 10 XLATLE 50 I Lungh dati C UPGM PARM UPGM XLATDA 10 U Dati C PARM 'JTBLUP' XLATTB 10 I Tabella C PARM '*LIBL' XLATLB 10 I Libreria * CALL CON KPJBA C U1ATR IFEQ 'K' C 10 SETON 92 MANCA KPJBA C 10 GOTO PGMLDE EXIT C MOVE KPJBU XPJBU SAVE KPJBU C CALL UPGM 50 C PARM KPJBA C 50 SETON 92 LOAD ERROR C MOVE XPJBU KPJBU RESTORE KPJBU C ELSE * CALL SENZA KPJBA C CALL UPGM 50 C 50 SETON 92 LOAD ERROR C END C GOTO PGMLDE EXIT C END * -------- ATTIVAZIONE COMANDO CON QCAEXEC C MOVE *BLANKS QCA C 52 C,1 COMP '?' 50 C 52 50 MOVEAU1CMD QCA,1 C 52N50 MOVE '?' QCA,1 C 52N50 MOVEAU1CMD QCA,2 C N52 MOVEAU1CMD QCA,1 §§ C U1ATR IFEQ *BLANK C CALL 'QCAEXEC' 50 C PARM QCA C PARM 600 LENGTH 155 §§ C ELSE §§ C CALL 'QCMDEXC' 50 §§ C PARM QCA §§ C PARM 600 LENGTH 155 §§ C END C 50 SETON 92 LOAD ERROR C PGMLDE ENDSR ******************************************************************** * TEST CHIAVI FUNZ. E ATTIVAZ. INDICATORI OPERATIVI ******************************************************************** C CMDKEY BEGSR C ENDSR ******************************************************************** * HELP - VISUALIZZAZIONE NOTE ******************************************************************** C HELP BEGSR C EXFMTHELP1 C SETON 01 RESTORE DISPLAY C ENDSR ******************************************************************** * CMD03 - ATTIVAZIONE SERVIZIO - QCL - ******************************************************************** C CMD03 BEGSR C EXSR §RIV Rivitalizza C CALL 'QCMD' 92 C 92 SETON 01 RESTORE DISPLAY C N92 SETON 31 NO SFLDSP C ENDSR ******************************************************************** * CMD06 - ATTIVAZIONE SERVIZIO - DSPMSG - ******************************************************************** C CMD06 BEGSR C EXSR §RIV Rivitalizza C MOVE *BLANKS QCA C MOVE CMD,2 CMDEL 80 BUILD CMD C MOVEACMDEL QCA,1 BUILD CMD C CALL 'QCMDEXC' 92 C PARM QCA C PARM 600 LENGTH C 92 SETON 01 RESTORE DISPLAY C N92 SETON 31 NO SFLDSP C ENDSR ******************************************************************** * CMD07 - ATTIVAZIONE SERVIZIO - §FNCC - ******************************************************************** C CMD07 BEGSR C EXSR §RIV Rivitalizza C SETON 01 RESTORE DISPLAY * CALL CON KPJBA C *IN10 IFEQ '0' C MOVE KPJBU XPJBU SAVE KPJBU C CALL 'JFNCC' 92 C PARM KPJBA C MOVE XPJBU KPJBU RESTORE KPJBU C ELSE * CALL SENZA KPJBA C CALL 'JFNCC' 92 C END C ENDSR ******************************************************************** * Rivitalizza lo stato di modifica sul record di subfile. ******************************************************************** C §RIV BEGSR C DO *HIVAL C READCSUBFILE 4444READ CHANGE C 44 GOTO §RIVE NO CHANGE C SETOF 72 RESET PC C WSCELT COMP *BLANK 4343 Sflnxtchg C 43 UPDATSUBFILE UPDATE C SETOF 43 C END C §RIVE ENDSR ******************************************************************** * Gestisce collezione. ******************************************************************** C CMD10 BEGSR C CALL 'JFNCGE' 44 C ENDSR ******************************************************************** * CMD13 - CAMBIO FILE DI COLLEZIONE ******************************************************************** C CMD13 BEGSR C EXSR CLOSEF CLOSE FILE C EXSR GETF CHANGE FILE C 01 GOTO EXIT EOJ C GOTO RERUN RERUN C ENDSR ******************************************************************** * TEST/DECODIFICA MESSAGGI PER WORKSTN ******************************************************************** C ERRMSG BEGSR C SETOF 39 RESET C WMSG IFNE *BLANKS C SETON 39 PRESENZA MSG. C END C ERRMSE ENDSR ******************************************************************** * RIPRISTINO MESSAGGI PER WORKSTN ******************************************************************** C RESMSG BEGSR C MOVE *BLANKS WMSG C ENDSR ******************************************************************** * RIPRISTINO INDICATORI PER WORKSTN ******************************************************************** C RESERR BEGSR C SETOF 282931 C SETOF 3999 C SETOF 808182ERRMSG C SETOF 84 ERRMSG C SETOF 9192 SFLMSG C SETOF 9495 SFLMSG C MOVE *BLANKS WMSG C ENDSR ******************************************************************** * SCAMBIO DATI DISCO-WORKSTN PER RECORD DI SUB-FILE $P ******************************************************************** C SCMBS BEGSR C MOVE U1GRP WGRP Per video $K C MOVE U1FNC WNAME Per video $K C MOVE U1GRP WSVKE1 PER RICERCA $K C MOVE U1FNC WSVKE2 PER RICERCA $K C MOVE U1DES WDESCR DESCRIZ. $P * EDIT TIPO E ATTRIBUTI C MOVE *BLANKS WTA * C U1TYP IFEQ 'P' C MOVEL'P' WTA C U1ATR COMP 'K' 50 C 50 MOVE 'K' WTA C END * Se il tipo non è programma. C U1TYP IFNE 'P' * Annota trattarsi di comando. C MOVEL'C' WTA * Se il primo carattere del comando è interrogativo. C C,1 IFEQ '?' * Annota trattarsi di comando con prompter totale. C MOVE '?' WTA * Se il primo carattere del comando non è interrogativo. C ELSE * Predispone la ricerca nel comando * a partire dal secondo carattere. C Z-ADD2 X 50 * Label di ricerca interrogativo. C SCAN TAG * Cerca interrogativo lungo il comando. C '?' LOKUPC,X 50 * Se ha trovato interrogativo. C 50 DO * Se il carattere precedente non è bianco. C X SUB 1 X1 50 C C,X1 IFNE *BLANK * Incrementa il punto di partenza della ricerca. C ADD 1 X * Salta a ricerca interrogativo. C GOTO SCAN * End. C END * Annota trattarsi di probabile prompter parziale. C MOVE '!' WTA * End. C END * End. C END * End. C END C ENDSR ******************************************************************** * ROUTINE DI APERTURA E INIZIALIZZAZIONE ******************************************************************** C OPEN BEGSR * ACQUISIZIONE KPJBA DALL'ARCHITETTURA C *ENTRY PLIST C PARM KPJBA C PARM PARM2 * SE MANCA LA KPJBA AVVISA L'OPERATORE DI TERMINALE C NPARM IFLT 1 C EXSR NKPJBA C 01 GOTO OPENE C END * SE E' UNA KPJBA FASULLA ASSUME CHE NON SIA PASSATA C N10 DO C KNMUS COMP '*NOKPJBA' 10 C END * SE RICEVE 2 PARAMETRI ASSUME DI RICEVERE * IL NOME DEL FILE E LA RELATIVA LIBRERIA C NPARM IFEQ 2 C SETON 11 C END * DEFINIZIONI C *LIKE DEFN KPJBU XPJBU C *LIKE DEFN WSCELT XSCELT * DEFINIZIONE CHIAVE DI LETTURA C U01KLS KLIST C KFLD XCOD1 $K C KFLD XCOD2 $K * RICHIESTA E APERTURA FILE COLLEZIONE C EXSR GETF C 01 GOTO OPENE * RICEZIONE DIAGNOSTICI C EXSR RCVDIA C OPENE ENDSR ******************************************************************** * SEGNALAZIONE MANCANZA KPJBA ******************************************************************** C NKPJBA BEGSR C SETON 10 NON C'E' KPJBA C EXFMTNOKPJBA PUT MESSAGGIO C ENDSR ******************************************************************** * RICHIESTA NOME FILE COLLEZIONE ******************************************************************** C GETF BEGSR C SETON 01 * PRE-RICEZIONE MESSAGGI DIAGNOSTICI C EXSR RCVDIA * SE RICHIESTO CAMBIO FILE NON PREIMPOSTA C GETF0 TAG C 13 GOTO GETF1 * SET VALORI DA DATA AREA C N11 DO C MOVE LFILE WFILE 50 C MOVE LLIBR WLIBR 50 C END * SET VALORI DA PARAMETRI ESTERNI C 11 DO C MOVE PFILE WFILE 50SE BLANK C 50 MOVE LFILE WFILE ASSUME PREC. C MOVE PLIBR WLIBR C 50 MOVE LLIBR WLIBR ASSUME PREC. C END * IMPOSTAZIONE DEFAULTS C WFILE IFEQ *BLANKS C N11 MOVEL'??FNC 'WFILE C END C WLIBR IFEQ *BLANKS C MOVEL'*LIBL 'WLIBR C END * SKIP RICHIESTA FILE SE IMPOSTATO ESTERNAMENTE C 11 GOTO GETF1B * GET NOME FILE C GETF1 TAG C 11 01 WRITEGETFILE 1A-EMISSIONE C SETOF 01 C EXFMTGETFILE C EXSR RESERR C 01 GOTO GETFE EXIT C 05 GOTO GETF0 RIPRISTINO C GETF1B TAG C WFILE COMP *BLANKS 80 C 80 GOTO GETF1 * Se richiesto, * tenta di convertire il file collezione * dal vecchio al nuovo tracciato. C 12 DO C EXSR CLOSEF CLOSE FILE C CALL 'JFNCOLD' C PARM WFILE C PARM WLIBR C END * CREAZIONE FILE C 09 DO C MOVE *BLANKS QCA C MOVE CMD,3 CMDEL C MOVEACMDEL QCA,1 C CALL 'QCMDEXC' 50 C PARM QCA C PARM 600 LENGTH C CALL 'JFNCB' 50 C PARM WFILE C PARM WLIBR C *IN84 PARM XINXX 1 C 50 SETON 84 C 84 GOTO GETF1 C END * OVERRIDE FILE C** MOVE *BLANK WRK C** MOVE '(' WRK,1 C** MOVE ')' WRK,21 C** MOVEAWFILE WRK,2 C** WLIBR IFNE *BLANKS C** MOVEL'.' A11 11 C** MOVE WLIBR A11 C** Z-ADD1 O 20 C** *BLANK LOKUPWRK,O 50 C** 50 MOVEAA11 WRK,O C** END C MOVE *BLANKS QCA C MOVEACMD,1 CMDEL BUILD CMD C MOVEACMDEL QCA,1 BUILD CMD C** MOVEAWRK QCA,26 BUILD CMD C MOVEAWFILE QCA,43 C MOVEAWLIBR QCA,31 C CALL 'QCMDEXC' 81 C PARM QCA C PARM 600 LENGTH 155 C 81 GOTO GETF1 * OPEN FILE C GETOPN TAG C OPEN JFNCX 82 OPEN FILE C 82 GOTO GETF1 OPEN ERROR C MOVE '1' SWOPEN 1 OPEN OK C MOVELFIDSFI WFILE C MOVELFIDSLB WLIBR * PROVA UNA LETTURA SUL FILE C MOVE *LOVAL U01KEY C U01KLS SETLLJFNCX 5082 C N82N50 READ JFNCX 8250 C 82 EXSR CLOSEF CLOSE-FILE C 82 GOTO GETF1 READ/ERROR * IMPOSTA VALORI SCELTA-FILE NELLA LOCAL DATA AREA C MOVE WFILE LFILE UPDATE DTAARA C MOVE WLIBR LLIBR UPDATE DTAARA * RESET CONDIZIONE FILE ESTERNO E INDIC. PRIMO CICLO C SETOF 0111 C GETFE ENDSR ******************************************************************** * CHIUSURA FILE COLLEZIONE ******************************************************************** C CLOSEF BEGSR * CLOSE FILE C SWOPEN IFEQ '1' C CLOSEJFNCX 50 CLOSE FILE C MOVE '0' SWOPEN RESET OPEN C END C ENDSR ******************************************************************** * RICEZIONE MESSAGGI DIAGNOSTICI CPF ******************************************************************** C RCVDIA BEGSR C CALL 'JFNCR' 50 C ENDSR ** CMD / TABELLA COMANDI INTERNI AL PROGRAMMA OVRDBF FILE(JFNCX) TOFILE((llllllllll)/ffffffffff) DSPMSG DLTOVR FILE(*ALL) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCEW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A*%%TS SD 20090122 095715 ANPRO15 REL-V5R4M0 5722-WDS A* 12:00:17 QPGMR1 REL-R07M00 5714-UT1 A*%%EC A DSPSIZ(24 80 *DS3) A REF(*LIBL/JFNCX) A CHGINPDFT A MSGLOC(24) A PRINT A N42 CA03(01 'Fine Lavoro') A VLDCMDKEY(25) A R HELP1 A* 12:00:17 QPGMR1 REL-R07M00 5714-UT1 A TEXT('PRIMA PAGINA NOTE OPERATIVE') A KEEP A 1 11'RIEPILOGO TASTI FUNZIONALI' A DSPATR(UL) A 3 4'F3' A DSPATR(HI) A 3 11'Fine lavoro o ritorno alla funzion- A e precedente.' A 4 4'F1' A DSPATR(HI) A 4 11'Chiama immissione comandi.' A 5 4'F5' A DSPATR(HI) A 5 11'Rinfresca l''elenco funzioni.' A 6 4'F6' A DSPATR(HI) A 6 11'Visualizza i messaggi del terminal- A e.' A 7 4'F7' A DSPATR(HI) A 7 11'Attiva un programma.' A 8 4'F10' A DSPATR(HI) A 8 11'Gestisce la collezione di funzioni- A .' A 9 4'F13' A DSPATR(HI) A 9 11'Sceglie la collezione di funzioni.' A 13 11'SIGNIFICATO CAMPI CON INTESTAZIONE- A RIDOTTA' A DSPATR(UL) A 15 4'S' A DSPATR(HI) A 15 11'Scelta' A 16 4'T' A DSPATR(HI) A 16 11'Tipo funzione: C=comando P=program- A ma' A 17 4'A' A DSPATR(HI) A 17 11'Attributo funzione: K=parametro_di- A _architettura' A 18 31'?=prompt totale !=probabile prompt- A parziale' A* 18:32:27 QPGMR1 REL-R06M00 5714-UT1 A R NOKPJBA A*%%TS SD 20090122 095715 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('SEGNALAZIONE MANCANZA KPJBA') A BLINK A KEEP A ALARM A WUSERD 10A O 1 2DSPATR(HI) A TEXT('DESCRIZIONE UTENTE') A 1 30' COLLEZIONE FUNZIONI ' A DSPATR(UL) A 1 70'-- KPJBA --' A DSPATR(HI) A 4 26' ' A DSPATR(RI) A 5 26' ' A DSPATR(RI) A 5 35'ATTENZIONE' A DSPATR(HI) A 5 49' ' A DSPATR(RI) A 6 26' ' A DSPATR(RI) A 9 2'Il programma è stato attivato al d- A i fuori della Architettura; pertant- A o non potranno essere eseguite- A le funzioni per le quali è previst- A a la variabile KPJBA. Tali Fu- A nzioni non saranno rese disponibili- A sullo schermo di attivazione.' A DSPATR(HI) A 22 2'ENTR' A DSPATR(HI) A 22 7'Accetta' A 22 16'F3' A DSPATR(HI) A 22 19'Ritorna' A* 12:00:17 QPGMR1 REL-R07M00 5714-UT1 A R GETFILE A*%%TS SD 20090122 095715 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('RICHIESTA FILE DA ELABORARE') A N13 CA05(05 'RIPR. VALORI PR.') A CF09(09 'CREAZIONE FILE') A 11 CA23(12 'Tenta conversione da vecch- A io tracciato.') A 11 CA24(24 'Tenta conversione da vecch- A io tracciato.') A KEEP A BLINK A LOCK A N01 PUTOVR A WUSERD 10A O 1 2DSPATR(HI) A TEXT('DESCRIZIONE UTENTE') A 1 30' COLLEZIONE FUNZIONI ' A DSPATR(UL) A 1 69'SCELTA FILE' A DSPATR(HI) A 6 19'File:' A WFILE 10A B 6 25DSPATR(CS) A CHECK(VN) A DSPATR(HI) A 80 ERRMSG('Non specificato nome file.') A 81 ERRMSG('File errato o inesistente.') A 82 ERRMSG('Errore di apertura sul file- A collezione.') A 84 ERRMSG('Creazione del file collezio- A ne non riuscita.') A 6 39'Libreria:' A WLIBR 10A B 6 49DSPATR(CS) A DSPATR(HI) A 81 ERRMSG('File errato o inesistente.') A 82 ERRMSG('Errore di apertura sul file- A collezione.') A 84 ERRMSG('Creazione del file collezio- A ne non riuscita.') A 20 2'ENTR' A DSPATR(HI) A 20 7'Accetta dati' A 20 21'F3' A DSPATR(HI) A 20 24'Fine lavoro' A N13 20 39'F5' A DSPATR(HI) A N13 20 42'Ripristina' A 21 2'F9' A DSPATR(HI) A 21 5'Crea file collezione e file testi - A d''aiuto' A 11 22 2'F23' A DSPATR(HI) A 11 22 6'Tenta conversione da vecchi tracci- A ati' A R TESTA A* 13:40:34 QPGMR1 REL-R06M00 5714-UT1 A TEXT('TESTA') A BLINK A LOCK A WUSERD 10A O 1 2DSPATR(HI) A TEXT('DESCRIZIONE UTENTE') A 1 14'SCELTA FUNZIONI DA ATTIVARE' A DSPATR(UL) A 1 43'File:' A WFILE 10A O 1 49DSPATR(HI) A 1 60'Libreria:' A WLIBR 10A O 1 70DSPATR(HI) A 3 2'S Gruppo Funzione Descrizio- A ne funzione - A TA' A DSPATR(UL) A R SUBFILE SFL A* 19:02:59 QPGMR1 REL-R07M00 5714-UT1 A TEXT('CAMPI DEL SUBFILE') A 43 SFLNXTCHG A WSVKE1 R H REFFLD(U1GRP) A WSVKE2 R H REFFLD(U1FNC) A SVIN72 1A H A SVRRNN 4S 0H A WSCELT 1A B 4 2DSPATR(CS) A DSPATR(HI) A 72 DSPATR(PC) A VALUES('X' 'P' 'H' ' ') A TEXT('Scelta.') A WGRP R O 4 5REFFLD(U1GRP) A 72 DSPATR(HI) A WNAME R O 4 16REFFLD(U1FNC) A 72 DSPATR(HI) A WDESCR R O 4 27REFFLD(U1DES) A DSPATR(HI) A WTA 2A O 4 78 A* 12:00:17 QPGMR1 REL-R07M00 5714-UT1 *****A**61**********************************SFLEND********************* A R CONTROL SFLCTL(SUBFILE) A*%%TS SD 20090122 095715 ANPRO15 REL-V5R4M0 5722-WDS A SFLSIZ(0028) A SFLPAG(0014) A TEXT('Subfile control') A KEEP A BLINK A CF01(03 'QCL') A CA05(05 'RINFRESCO DATI') A CF06(06 'DISPLAY MESSAGGI') A CF07(07 'CALL A RICHIESTA') A CA10(88 'Gestisce collezione.') A CA13(13 'CAMBIO FILE') A HELP(02 'RICHIESTA AIUTO') A N28 08 ROLLUP(26) A N28 08 ROLLDOWN(27) A 39 ALARM A 60 LOCK A OVERLAY A 61N28N31 SFLDSP A 61 SFLDSPCTL A 60 SFLCLR A 91 SFLMSG('Record funzione sparito.') A 95 SFLMSG('Funzione in bianco.') A 92 SFLMSG('Funzione terminata in modo - A anomalo.') A 94 SFLMSG('P(prompter) non permesso pe- A r questa funzione.') A RECNUM 4S 0H SFLRCDNBR A 18 2'----------------------------------- A ------------------------------------ A ---------' A WCOD1 R I 20 4REFFLD(U1GRP) A DSPATR(UL) A DSPATR(PC) A 99 PUTRETAIN A WCOD2 R I 20 15REFFLD(U1FNC) A DSPATR(UL) A DSPATR(PC) A 99 PUTRETAIN A 20 26':Gruppo e funzione per ricerca.' A N01 PUTRETAIN A 22 2'X' A DSPATR(HI) A 22 4'Esegue' A 22 12'P' A DSPATR(HI) A 22 14'Esegue con prompt' A 22 33'H' A DSPATR(HI) A 22 35'Visualizza testo d''aiuto' A 23 2'RICH AIUTO' A N01 PUTRETAIN A DSPATR(HI) A 23 13'Note' A N01 PUTRETAIN A 23 19'F3' A N01 PUTRETAIN A DSPATR(HI) A 23 22'Ritorna' A N01 PUTRETAIN A WMSG 78A O 24 2 A 39 DSPATR(RI) A N39 DSPATR(ND) A N39 PUTRETAIN A 26 61 AO 27 61 ERRMSGID(CPF5203 *LIBL/QCPFMSG) A* 18:32:27 QPGMR1 REL-R06M00 5714-UT1 A R SFLMSG A*%%TS SD 20090122 095715 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('SEGNALAZIONE SUBFILE VUOTO') A BLINK A OVERLAY A CF01(03 'QCL') A CF06(06 'DISPLAY MESSAGGI') A CF07(07 'CALL A RICHIESTA') A CA10(88 'Gestisce collezione.') A CA13(13 'CAMBIO FILE') A HELP(02 'RICHIESTA AIUTO') A 8 2'ATTENZIONE:' A DSPATR(HI) A 10 2'Nessuna funzione disponibile.' A 12 2'F10' A DSPATR(HI) A 12 6'Gestisce la collezione di funzioni- A .' //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCEXE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §CAEXEC. */ /* */ /* Copre esecuzione comando per cobol. */ /* */ PGM PARM(&CMD2000 &CMDLEN &MODE400 &QCAEXECOK) /* Riceve. Comando eseguibile. */ DCL VAR(&CMD2000) TYPE(*CHAR) LEN(2000) /* Riceve. Lunghezza del comando eseguibile. */ DCL VAR(&CMDLEN) TYPE(*DEC) LEN(15 5) /* Riceve. Ordine di eseguire in modo 400. */ DCL VAR(&MODE400) TYPE(*LGL) /* Restituisce. Il comando eseguibile è giusto. */ DCL VAR(&QCAEXECOK) TYPE(*LGL) /* Assume comando giusto. */ CHGVAR VAR(&QCAEXECOK) VALUE('1') /* Se richiesta l'esecuzione in modo 400. */ IF COND(&MODE400) THEN(DO) /* Chiama l'esecuzione del comando in modo 400. */ CALL PGM(QCMDEXC) PARM(&CMD2000 &CMDLEN) /* Se il comando è sbagliato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Annota comando in errore. */ CHGVAR VAR(&QCAEXECOK) VALUE('0') /* End. */ ENDDO /* End. */ ENDDO /* Se non richiesta l'esecuzione in modo 400. */ ELSE CMD(DO) /* Chiama l'esecuzione del comando in modo 38. */ CALL PGM(QCAEXEC) PARM(&CMD2000 &CMDLEN) /* Se il comando è sbagliato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Annota comando in errore. */ CHGVAR VAR(&QCAEXECOK) VALUE('0') /* End. */ ENDDO /* End. */ ENDDO /* Ritorna. */ ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCFG) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §FNCFG. */ /* */ /* Restituisce funzione nel gruppo. */ /* */ CMD PROMPT('Restituisce funzione') PARM KWD(GROUP) TYPE(*CHAR) LEN(10) MIN(1) + EXPR(*YES) PROMPT('Gruppo di funzioni') PARM KWD(FUNCTION) TYPE(*CHAR) LEN(10) + RTNVAL(*YES) PROMPT('Var Funzione nel + gruppo') PARM KWD(REQUEST) TYPE(*CHAR) LEN(6) RSTD(*YES) + DFT(*FIRST) VALUES(*FIRST *NEXT) EXPR(*YES) + PROMPT('Richiesta') PARM KWD(SNDERRMSG) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) EXPR(*YES) + PROMPT('Manda messaggio di errore') PARM KWD(DES) TYPE(*CHAR) LEN(50) RTNVAL(*YES) + PROMPT('Var Descrizione funzione') PARM KWD(CMD) TYPE(*CHAR) LEN(512) RTNVAL(*YES) + PROMPT('Var Comando eseguibile') PARM KWD(MSG) TYPE(*CHAR) LEN(80) RTNVAL(*YES) + PROMPT('Var Messaggio di esecuzione') PARM KWD(FOUND) TYPE(*LGL) RTNVAL(*YES) + PROMPT('Var Trovata funzione') PARM KWD(LAST) TYPE(*LGL) RTNVAL(*YES) + PROMPT('Var Ultima funzione') PARM KWD(AS400) TYPE(*CHAR) LEN(1) RTNVAL(*YES) + PROMPT('Var Comando in formato AS/400') PARM KWD(FILE) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var File funzioni') PARM KWD(LIB) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var Libreria file funzioni') PARM KWD(MBR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('Var Membro file funzioni') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCFGE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Restituisce funzione nel gruppo. * * RPG §FNCFG. * FJFNCX IF E K DISK UC * Collezione di funzioni. * Chiave unica * su gruppo, funzione. FIDS F KINFDS FIDS FIDS * Riga di continuazione del file di cui serve la FIDS * file information data structure. ERRQ E §N 502 1 Dati corti msg E C1 80 80 1 Comando 1 FIDS IFIDS DS FIDS * File information data structure. FIDS I 83 92 FIDSFL FIDS * File. FIDS I 93 102 FIDSLB FIDS * Libreria. FIDS I 129 138 FIDSMB FIDS * Membro. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PGRP I Gruppo C PARM PFNC U Funzione C PARM PRQS 6 I Richiesta C PARM PSEM 4 I Manda err msg C PARM PDES O Descrizione C PARM PCMD O Comando exe C PARM PMSG O Messaggio C PARM PFND 1 O Trovato C PARM PLAS 1 O Ultimo C PARM PATR O Attributo C PARM FIDSFL PFIL O File C PARM FIDSLB PLIB O Libreria C PARM FIDSMB PMBR O Membro * Definisce i parametri. C *LIKE DEFN U1GRP PGRP C *LIKE DEFN U1FNC PFNC C *LIKE DEFN U1DES PDES C *LIKE DEFN U1CMD PCMD C *LIKE DEFN U1MSG PMSG C *LIKE DEFN U1ATR PATR C *LIKE DEFN FIDSFL PFIL C *LIKE DEFN FIDSLB PLIB C *LIKE DEFN FIDSMB PMBR * Definisce il gruppo ricevuto come chiave. C H1 KLIST C KFLD PGRP * Definisce il gruppo e la funzione ricevuti come chiave. C H2 KLIST C KFLD PGRP C KFLD PFNC * Definisce il gruppo e la funzione sostitutivi come chiave. C S2 KLIST C KFLD U1GR2 C KFLD U1FN2 * Se il file richiesto non coincide con quello aperto. C $OPEN IFEQ '1' C PFIL ANDNEFIDSFL C PLIB ANDNEFIDSLB * Chiude il file. C CLOSEJFNCX * Annota file chiuso. C MOVEL*ZERO $OPEN * End. C END * Se il file non è aperto. C $OPEN IFNE '1' * Prepara la ridirezione di apertura. C MOVEAPLIB C1,31 C MOVEAPFIL C1,43 * Ridirige l'apertura. C CALL 'QCMDEXC' 50 C PARM C1 C PARM 80 $LEN 155 * Apre il file. C OPEN JFNCX * Annota file aperto. C MOVEL'1' $OPEN 1 * End. C END * Disdice il riposizionamento sul file. C SETOF 55 * Se la richiesta è *FIRST. C PRQS IFEQ '*FIRST' * Cerca la prima funzione del gruppo. C H1 CHAINU1R 50 * Se il record è stato trovato. C N50 DO * Trascrive la funzione da restituire. C MOVELU1FNC PFNC * Se il gruppo o la funzione sostitutivi non sono in bianco. C U1GR2 IFNE *BLANK C U1FN2 ORNE *BLANK * Cerca il record sostitutivo. C S2 CHAINU1R 50 * Se il record sostitutivo esiste, * prenota il riposizionamento sul file. C N50 SETON 55 * End. C END * End. C END * Se non ci sono funzioni nel gruppo. C 50 DO * Segnala l'errore. C EXSR §ERR * Asterisca i parametri da restituire. C MOVEL*ALL'*' PDES C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG C MOVEL*ALL'*' PATR * Annota non trovata funzione. C MOVEL*ZERO PFND * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Trascrive i parametri da restituire. C MOVELU1DES PDES C MOVELU1CMD PCMD C MOVELU1MSG PMSG C MOVELU1ATR PATR * Annota trovata funzione. C MOVEL'1' PFND * Annota ultima funzione non ancora restituita. C MOVEL*ZERO PLAS * Se prenotato il riposizionamento. C 55 DO * Si riposiziona lungo il file * oltre il record titolare appena recuperato. C H2 SETGTU1R * End. C END * Cerca la prossima funzione nel gruppo. C H1 READEU1R 50 * Se non ci sono altre funzioni nel gruppo. C 50 DO * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Ritorna. C RETRN * End. C END * Se la richiesta è *NEXT. C PRQS IFEQ '*NEXT' * Si posiziona lungo il file * oltre la funzione richiesta. C H2 SETGTU1R 50 * Se non ci sono altri record nel file. C 50 DO * Asterisca i parametri da restituire. C MOVEL*ALL'*' PDES C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG C MOVEL*ALL'*' PATR * Annota non trovata funzione.. C MOVEL*ZERO PFND * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Cerca la prossima funzione nel gruppo. C H1 READEU1R 50 * Se il record è stato trovato. C N50 DO * Trascrive la funzione da restituire. C MOVELU1FNC PFNC * Se il gruppo o la funzione sostitutivi non sono in bianco. C U1GR2 IFNE *BLANK C U1FN2 ORNE *BLANK * Cerca il record sostitutivo. C S2 CHAINU1R 50 * Se il record sostitutivo esiste, * prenota il riposizionamento sul file. C N50 SETON 55 * End. C END * End. C END * Se nel gruppo non ci sono altre funzioni. C 50 DO * Asterisca i parametri da restituire. C MOVEL*ALL'*' PDES C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG C MOVEL*ALL'*' PATR * Annota non trovata funzione. C MOVEL*ZERO PFND * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Trascrive i parametri da restituire. C MOVELU1DES PDES C MOVELU1CMD PCMD C MOVELU1MSG PMSG C MOVELU1ATR PATR * Annota trovata funzione. C MOVEL'1' PFND * Annota ultima funzione non ancora restituito. C MOVEL*ZERO PLAS * Se prenotato il riposizionamento sul file. C 55 DO * Si riposiziona lungo il file * oltre il record titolare appena recuperato. C H2 SETGTU1R * End. C END * Cerca la prossima funzione nel gruppo. C H1 READEU1R 50 * Se non ci sono altre funzioni nel gruppo. C 50 DO * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END * Ritorna. C RETRN * End. C END * Se la richiesta è diversa da quelle sin qui considerate. C DO * Segnala parametro imprevisto. C *M§PR0002 DSPLY §DSPLY 1 * Asterisca i parametri da restituire. C MOVEL*ALL'*' PDES C MOVEL*ALL'*' PCMD C MOVEL*ALL'*' PMSG C MOVEL*ALL'*' PATR * Annota non trovata funzione. C MOVEL*ZERO PFND * Annota ultima funzione ormai restituita. C MOVEL'1' PLAS * Predispone la chiusura del programma. C SETON LR * Ritorna. C RETRN * End. C END /EJECT *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C §ERR BEGSR * Compone il messaggio di errore e lo spedisce. *------------------------------------------------------------------- * Se è richiesta la spedizione del messaggio di errore. C PSEM IFEQ '*YES' * Decide il messaggio. C MOVEL'§PZ0021' ERRQID * Compone i dati per il messaggio. C MOVE *BLANK §N C MOVEAPGRP §N,1 C MOVEAFIDSFL §N,11 C MOVEAFIDSLB §N,21 C MOVEAFIDSMB §N,31 * Chiama la spedizione. C EXSR ERRQ * End. C END C ENDSR ERRQ /EJECT ERRQ *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ERRQ C ERRQ BEGSR ERRQ * Segnala alla coda degli errori di elaborazione. ERRQ *------------------------------------------------------------------- ERRQ * Chiama la spedizione del messaggio ad una coda di errori. ERRQ * Il modulo riceve solo 502 caratteri per il messaggio ERRQ * perché autonomamente si incarica di riempire i primi 10 ERRQ * mancanti col nome di suo padre o di suo nonno. ERRQ C CALL '§ERRQ' ERRQ C PARM ERRQID 7 I Msg identific ERRQ C PARM '§MSGF' ERRQFI 10 I Msg file ERRQ C PARM '*LIBL' ERRQLB 10 I Msg lib ERRQ C PARM §N I Msg dati ERRQ C PARM '*DFT' ERRQQU 10 I Msg coda ERRQ C PARM '*NONE' ERRQQ2 10 I Msg coda 2 ERRQ C PARM '0' ERRQFH 1 I Msg al padre ERRQ C PARM '1' ERRQWS 1 I Msg al video ERRQ C PARM '0' ERRQSY 1 I Msg a sysopr ERRQ C ENDSR ** Comando 1. OVRDBF FILE(JFNCX) TOFILE((llllllllll)/ffffffffff) SECURE(*YES) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCGE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') ‚****** Note. Aggiusta overlay. ‚****** Accetta cambio modo anche come ENTR. IDENTIFICATION DIVISION. PROGRAM-ID. JFNCGE. AUTHOR. CLAUDIO NERONI. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. SPECIAL-NAMES. DECIMAL-POINT IS COMMA I-O-FEEDBACK IS I-O-FEEDBACK. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT LGL1 ASSIGN DATABASE-JFNCX ORGANIZATION INDEXED ACCESS DYNAMIC RECORD KEY EXTERNALLY-DESCRIBED-KEY. SELECT PHY1CHG ASSIGN DATABASE-JFNCX ORGANIZATION RELATIVE ACCESS DYNAMIC RELATIVE RELATIVE-RECORD-NUMBER STATUS FILE-STATUS. SELECT PHY1ADD ASSIGN DATABASE-JFNCX ORGANIZATION SEQUENTIAL ACCESS SEQUENTIAL STATUS FILE-STATUS. SELECT VIDEO ASSIGN WORKSTATION-JFNCGEW-SI ORGANIZATION TRANSACTION STATUS FILE-STATUS. DATA DIVISION. FILE SECTION. FD LGL1. 01 RECORD-LGL1. COPY DDS-ALL-FORMAT OF JFNCX REPLACING ==§== BY ==X==. FD PHY1CHG. 01 RECORD-PHY1CHG. COPY DDS-ALL-FORMAT OF JFNCX REPLACING ==§== BY ==X==. FD PHY1ADD. 01 RECORD-PHY1ADD. COPY DDS-ALL-FORMAT OF JFNCX REPLACING ==§== BY ==X==. FD VIDEO. 01 RECORD-VIDEO. COPY DDS-ALL-FORMAT OF JFNCGEW REPLACING ==§== BY ==X==. WORKING-STORAGE SECTION. COPY JFNCGEIND IN JFNC. 05 PROMPTER PIC 99 VALUE 04. 05 DUPLICA PIC 99 VALUE 06. 05 CAMPO-IN-BIANCO PIC 99 VALUE 70. 05 DUMMY PIC 99 VALUE 71. 05 CMD-ERRATO PIC 99 VALUE 72. 05 RECORD-SPARITO PIC 99 VALUE 73. 05 RECORD-MODIFICATO-DA-ALTRI PIC 99 VALUE 74. 05 RECORD-GIA-ESISTENTE PIC 99 VALUE 75. 05 RECORD-BLOCCATO PIC 99 VALUE 76. 05 TASTO-NON-PERMESSO PIC 99 VALUE 77. 05 TIPO-ERRATO PIC 99 VALUE 78. 05 ATTRIBUTO-ERRATO PIC 99 VALUE 79. 05 ATTRIBUTO-INCOERENTE-CON-TIPO PIC 99 VALUE 80. 05 NOME-PROGRAMMA-NON-VALIDO PIC 99 VALUE 81. 05 TASTO-NON-PERMESSO-PER-PGM PIC 99 VALUE 82. 05 NOME-MEMBRO-NON-VALIDO PIC 99 VALUE 83. 05 GRUPPO-GIA-ESISTENTE PIC 99 VALUE 84. 05 GRUPPO-INESISTENTE PIC 99 VALUE 85. 05 ERRORE-DUPLICANDO PIC 99 VALUE 86. 01 I-O-FEEDBACK-AREA. 05 FILLER PIC X(174). 05 RELATIVE-RECORD-NUMBER PIC 9(9) COMP-4. 77 ULTIMO-VIDEO-EMESSO PIC X(10). 77 UTENTE PIC X(10). 77 LAVORO PIC X(10). 77 MODO-CORRENTE PIC X(3). 77 MODO-PRECEDENTE PIC X(3). 77 MESSAGGIO PIC X(116). 77 CMD-OK PIC X(1). 77 MODE400 PIC X(1). 77 MODE400-0 PIC X(1) VALUE "0". 77 WMSG-PRECEDENTE PIC X(78). 77 RISPOSTA PIC X(1). 77 FILE-STATUS PIC X(2). 77 UN-CARATTERE PIC X(1). 01 FILLER PIC X VALUE "0". 88 PHY1CHG-APERTO VALUE "1". 01 FILLER PIC X VALUE "0". 88 PHY1ADD-APERTO VALUE "1". 01 FILLER PIC X VALUE "0". 88 W1-GIUSTO VALUE "0". 88 W1-SBAGLIATO VALUE "1". 01 FILLER PIC X VALUE "0". 88 W2-GIUSTO VALUE "0". 88 W2-SBAGLIATO VALUE "1". 01 PERFORM-STATUS PIC 9 VALUE 0. 88 PERFORM-OK VALUE 0. 88 PERFORM-ER VALUE 1. 01 CMD-ESEGUIBILE PIC X(512). 01 FILLER REDEFINES CMD-ESEGUIBILE. 05 CMD-PRIMO-CARATTERE PIC X(1). 77 CMD-LENGTH PIC 9(10)V9(5) COMP-3 VALUE 512. 77 PROMPTER-RQD PIC 9(3). 01 FILLER. 05 OVR-LENGTH PIC 9(10)V9(5) COMP-3 VALUE 80. 05 OVRDSPF PIC X(80) VALUE "OVRDSPF JFNCGEW JFNCGEW". 05 OVRDBF PIC X(80) VALUE "OVRDBF JFNCX JFNCX". 01 FILLER. COPY DDS-W1-I OF JFNCGEW REPLACING W1-I BY W1-I-SAVE ==§== BY ==X==. 01 FILLER. COPY DDS-W1-O OF JFNCGEW REPLACING W1-O BY W1-O-SAVE ==§== BY ==X==. 01 FILLER. COPY DDS-W2-I OF JFNCGEW REPLACING W2-I BY W2-I-SAVE ==§== BY ==X==. 01 FILLER. COPY DDS-W2-O OF JFNCGEW REPLACING W2-O BY W2-O-SAVE ==§== BY ==X==. PROCEDURE DIVISION. FLUSSO-PRINCIPALE. CALL "JFNCUSR" USING UTENTE LAVORO OVERFLOW MOVE "??????????" TO UTENTE LAVORO PERFORM ERRORE-IMPREVISTO. CALL "QCAEXEC" USING OVRDBF OVR-LENGTH. OPEN INPUT LGL1. CALL "QCAEXEC" USING OVRDSPF OVR-LENGTH. OPEN I-O VIDEO. MOVE SPACE TO ULTIMO-VIDEO-EMESSO. MOVE "CHG" TO MODO-CORRENTE. GO GUIDA-CHG. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Gestisce la modifica, la visualizzazione e la cancellazione * dei record. *---------------------------------------------------------------- GUIDA-CHG. PERFORM EMETTE-PIEDE-W0. MOVE UTENTE TO W0USR OF W0-O. MOVE MODO-CORRENTE TO W0MOD OF W0-O. MOVE SPACE TO W0GRP OF W0-O. MOVE SPACE TO W0FNC OF W0-O. IF MODO-PRECEDENTE EQUAL "DUP" MOVE W2GRP OF W2-I-SAVE TO W0GRP OF W0-O. SET ACCESO (OVERLAY) TO TRUE. PERFORM DECIDE-PUTRETAIN-SU-W0. WRITE RECORD-VIDEO FORMAT "W0" INDICATOR INDICATORI. READ VIDEO FORMAT "W0" INDICATOR INDICATORI. IF FILE-STATUS NOT EQUAL "00" GO FINE. IF ACCESO (RITORNA) GO FINE. IF ACCESO (PASSO-PRECEDENTE) GO FINE. IF ACCESO (DUPLICA) MOVE "DUP" TO MODO-CORRENTE GO GUIDA-DUPLICA. IF ACCESO (VISUALIZZA) MOVE "DSP" TO MODO-CORRENTE GO GUIDA-CHG. IF ACCESO (AGGIUNGE) MOVE "ADD" TO MODO-CORRENTE GO GUIDA-ADD. IF ACCESO (MODIFICA) MOVE "CHG" TO MODO-CORRENTE GO GUIDA-CHG. IF ACCESO (CANCELLA) MOVE "DSP" TO MODO-CORRENTE GO GUIDA-CHG. IF ACCESO (HOME) GO GUIDA-CHG. IF ACCESO (ROLL-DOWN) PERFORM LEGGE-ULTIMO-RECORD GO GUIDA-CHG DEPENDING PERFORM-STATUS GO RECORD-LETTO. MOVE W0GRP OF W0-I TO U1GRP OF RECORD-LGL1. MOVE W0FNC OF W0-I TO U1FNC OF RECORD-LGL1. POSIZIONA-CURSORE. START LGL1 KEY NOT LESS EXTERNALLY-DESCRIBED-KEY INVALID GO GUIDA-CHG. LEGGE-PROSSIMO-RECORD. READ LGL1 NEXT END GO GUIDA-CHG. ACCEPT I-O-FEEDBACK-AREA FROM I-O-FEEDBACK FOR LGL1. RECORD-LETTO. PERFORM EMETTE-PIEDE-W1-CHG. MOVE UTENTE TO W1USR OF W1-O. MOVE MODO-CORRENTE TO W1MOD OF W1-O. PERFORM MUOVE-DA-LGL1-A-W1. IF MODO-CORRENTE EQUAL "DSP" SET ACCESO (PROTECT-FIELD) TO TRUE SET SPENTO (POSITION-CURSOR) TO TRUE. IF MODO-CORRENTE EQUAL "CHG" SET SPENTO (PROTECT-FIELD) TO TRUE SET ACCESO (POSITION-CURSOR) TO TRUE. IF MODO-CORRENTE EQUAL "DLT" SET ACCESO (PROTECT-FIELD) TO TRUE SET SPENTO (POSITION-CURSOR) TO TRUE. SET ACCESO (OVERLAY) TO TRUE. EMETTE-W1-CHG. PERFORM DECIDE-PUTRETAIN-SU-W1. WRITE RECORD-VIDEO FORMAT "W1" INDICATOR INDICATORI. READ VIDEO FORMAT "W1" INDICATOR INDICATORI. IF FILE-STATUS NOT EQUAL "00" GO FINE. MOVE W1-I TO W1-I-SAVE MOVE ZERO TO INDICATORI-DI-ERRORE. SET SPENTO (MODIFIED-DATA-TAG) TO TRUE. MOVE MODO-CORRENTE TO MODO-PRECEDENTE. IF SPENTO (CANCELLA) AND MODO-CORRENTE EQUAL "DLT" MOVE "DSP" TO MODO-CORRENTE. IF ACCESO (RITORNA) GO FINE. IF ACCESO (PASSO-PRECEDENTE) GO GUIDA-CHG. IF ACCESO (DUPLICA) MOVE "DUP" TO MODO-CORRENTE GO GUIDA-DUPLICA. IF ACCESO (VISUALIZZA) AND MODO-CORRENTE EQUAL "DSP" AND MODO-PRECEDENTE EQUAL "DSP" OR ACCESO (MODIFICA) AND MODO-CORRENTE EQUAL "CHG" OR ACCESO (PASSO-SUCCESSIVO) AND (MODO-CORRENTE NOT EQUAL "DSP" OR MODO-PRECEDENTE NOT EQUAL "DSP") OR ACCESO (PROMPTER) AND MODO-CORRENTE NOT EQUAL "CHG" OR ACCESO (CONTROLLA-ERRORI) AND MODO-CORRENTE NOT EQUAL "CHG" SET ACCESO (TASTO-NON-PERMESSO) TO TRUE MOVE MODO-PRECEDENTE TO MODO-CORRENTE GO EMETTE-W1-CHG. IF ACCESO (PROMPTER) AND W1TYP OF W1-I EQUAL "P" SET ACCESO (TASTO-NON-PERMESSO-PER-PGM) TO TRUE MOVE MODO-PRECEDENTE TO MODO-CORRENTE GO EMETTE-W1-CHG. IF ACCESO (CANCELLA) AND MODO-CORRENTE NOT EQUAL "DLT" MOVE "DLT" TO MODO-CORRENTE GO RECORD-LETTO. IF ACCESO (RINFRESCA) GO POSIZIONA-CURSORE. IF ACCESO (HOME) GO RECORD-LETTO. IF MODO-CORRENTE EQUAL "CHG" AND ACCESO (CONTROLLA-ERRORI) PERFORM CONTROLLA-CMD GO EMETTE-W1-CHG. IF MODO-CORRENTE EQUAL "CHG" AND ACCESO (PROMPTER) PERFORM MANIPOLA-CMD GO EMETTE-W1-CHG. ESEGUE-CMD. IF MODO-CORRENTE EQUAL "DSP" AND ACCESO (PASSO-SUCCESSIVO) NEXT SENTENCE ELSE GO ESEGUE-CMD-FINE. IF W1TYP OF W1-I EQUAL "P" MOVE SPACE TO CMD-ESEGUIBILE STRING "CALL " W1CMD OF W1-I DELIMITED SIZE INTO CMD-ESEGUIBILE ELSE MOVE SPACE TO CMD-ESEGUIBILE MOVE W1CMD OF W1-I TO CMD-ESEGUIBILE. IF W1ATR OF W1-I EQUAL "1" MOVE "1" TO MODE400 ELSE MOVE "0" TO MODE400. CALL "JFNCEXE" USING CMD-ESEGUIBILE CMD-LENGTH MODE400 CMD-OK. IF CMD-OK EQUAL "1" MOVE CORRESPONDING W1-I-SAVE TO W1-O MOVE MODO-CORRENTE TO W1MOD OF W1-O ELSE SET ACCESO (CMD-ERRATO) TO TRUE. GO EMETTE-W1-CHG. ESEGUE-CMD-FINE. IF MODO-CORRENTE EQUAL "DSP" GO FINE-RISCRITTURA. IF MODO-CORRENTE EQUAL "CHG" AND SPENTO (CHANGE) GO FINE-RISCRITTURA. IF MODO-CORRENTE NOT EQUAL "CHG" GO CONTROLLA-W1-FINE. PERFORM CONTROLLA-W1 THRU CONTROLLA-W1-EXIT. IF W1-SBAGLIATO GO EMETTE-W1-CHG. CONTROLLA-W1-FINE. IF NOT PHY1CHG-APERTO PERFORM APRE-PHY1CHG. READ PHY1CHG. IF FILE-STATUS EQUAL "23" SET ACCESO (RECORD-SPARITO) TO TRUE GO EMETTE-W1-CHG. IF FILE-STATUS EQUAL "9D" SET ACCESO (RECORD-BLOCCATO) TO TRUE GO EMETTE-W1-CHG. IF FILE-STATUS NOT EQUAL "00" STRING "File status " FILE-STATUS DELIMITED SIZE INTO MESSAGGIO DISPLAY MESSAGGIO ACCEPT RISPOSTA GO EMETTE-W1-CHG. IF RECORD-PHY1CHG NOT EQUAL RECORD-LGL1 PERFORM RECORD-PHY1CHG-MODIFICATO GO GUIDA-CHG DEPENDING PERFORM-STATUS GO EMETTE-W1-CHG. IF MODO-CORRENTE NOT EQUAL "DLT" GO FINE-DELETE. DELETE PHY1CHG. MOVE "DSP" TO MODO-CORRENTE. FINE-DELETE. IF MODO-CORRENTE NOT EQUAL "CHG" GO FINE-RISCRITTURA. PERFORM MUOVE-DA-W1-A-PHY1CHG. REWRITE RECORD-PHY1CHG INVALID PERFORM RILASCIA-RECORD-PHY1CHG THRU RILASCIA-RECORD-PHY1CHG-EXIT GO GUIDA-CHG DEPENDING PERFORM-STATUS SET ACCESO (RECORD-GIA-ESISTENTE) TO TRUE GO EMETTE-W1-CHG. MOVE RECORD-PHY1CHG TO RECORD-LGL1. FINE-RISCRITTURA. IF ACCESO (VISUALIZZA) MOVE "DSP" TO MODO-CORRENTE GO RECORD-LETTO. IF ACCESO (AGGIUNGE) MOVE "ADD" TO MODO-CORRENTE GO GUIDA-ADD. IF ACCESO (MODIFICA) MOVE "CHG" TO MODO-CORRENTE GO RECORD-LETTO. IF ACCESO (ROLL-DOWN) PERFORM LEGGE-RECORD-PRECEDENTE GO GUIDA-CHG DEPENDING PERFORM-STATUS GO RECORD-LETTO. GO LEGGE-PROSSIMO-RECORD. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Gestisce l'aggiunta di nuovi record. *---------------------------------------------------------------- GUIDA-ADD. PERFORM EMETTE-PIEDE-W1-ADD. MOVE UTENTE TO W1USR OF W1-O. MOVE MODO-CORRENTE TO W1MOD OF W1-O. PERFORM SBIANCA-W1. SET SPENTO (PROTECT-FIELD) TO TRUE. SET SPENTO (POSITION-CURSOR) TO TRUE. SET ACCESO (OVERLAY) TO TRUE. EMETTE-W1-ADD. PERFORM DECIDE-PUTRETAIN-SU-W1. WRITE RECORD-VIDEO FORMAT "W1" INDICATOR INDICATORI. READ VIDEO FORMAT "W1" INDICATOR INDICATORI. IF FILE-STATUS NOT EQUAL "00" GO FINE. MOVE W1-I TO W1-I-SAVE MOVE ZERO TO INDICATORI-DI-ERRORE. SET SPENTO (MODIFIED-DATA-TAG) TO TRUE. IF ACCESO (RITORNA) GO FINE. IF ACCESO (PASSO-PRECEDENTE) GO GUIDA-CHG. IF ACCESO (RINFRESCA) GO GUIDA-ADD. IF ACCESO (HOME) GO GUIDA-ADD. IF ACCESO (DUPLICA) MOVE "DUP" TO MODO-CORRENTE GO GUIDA-DUPLICA. IF ACCESO (AGGIUNGE) OR ACCESO (ROLL-DOWN) OR ACCESO (ROLL-UP) SET ACCESO (TASTO-NON-PERMESSO) TO TRUE GO EMETTE-W1-ADD. IF ACCESO (PROMPTER) AND W1TYP OF W1-I EQUAL "P" SET ACCESO (TASTO-NON-PERMESSO-PER-PGM) TO TRUE GO EMETTE-W1-ADD. IF ACCESO (CONTROLLA-ERRORI) PERFORM CONTROLLA-CMD GO EMETTE-W1-ADD. IF ACCESO (PROMPTER) PERFORM MANIPOLA-CMD GO EMETTE-W1-ADD. IF SPENTO (CHANGE) GO FINE-SCRITTURA. PERFORM CONTROLLA-W1 THRU CONTROLLA-W1-EXIT. IF W1-SBAGLIATO GO EMETTE-W1-ADD. IF NOT PHY1ADD-APERTO PERFORM APRE-PHY1ADD. PERFORM MUOVE-DA-W1-A-PHY1ADD. WRITE RECORD-PHY1ADD. IF FILE-STATUS NOT EQUAL "00" SET ACCESO (RECORD-GIA-ESISTENTE) TO TRUE GO EMETTE-W1-ADD. FINE-SCRITTURA. IF ACCESO (VISUALIZZA) MOVE "DSP" TO MODO-CORRENTE GO GUIDA-CHG. IF ACCESO (MODIFICA) MOVE "CHG" TO MODO-CORRENTE GO GUIDA-CHG. IF ACCESO (CANCELLA) MOVE "DSP" TO MODO-CORRENTE GO GUIDA-CHG. GO GUIDA-ADD. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Gestisce la duplicazione di un gruppo. *---------------------------------------------------------------- GUIDA-DUPLICA. PERFORM EMETTE-PIEDE-W2. MOVE UTENTE TO W2USR OF W2-O. MOVE MODO-CORRENTE TO W2MOD OF W2-O. PERFORM SBIANCA-W2. SET ACCESO (OVERLAY) TO TRUE. EMETTE-W2. PERFORM DECIDE-PUTRETAIN-SU-W2. WRITE RECORD-VIDEO FORMAT "W2" INDICATOR INDICATORI. READ VIDEO FORMAT "W2" INDICATOR INDICATORI. IF FILE-STATUS NOT EQUAL "00" GO FINE. MOVE W2-I TO W2-I-SAVE MOVE ZERO TO INDICATORI-DI-ERRORE. SET SPENTO (MODIFIED-DATA-TAG) TO TRUE. MOVE MODO-CORRENTE TO MODO-PRECEDENTE. IF ACCESO (RITORNA) GO FINE. IF ACCESO (PASSO-PRECEDENTE) OR ACCESO (HOME) OR SPENTO (CHANGE) MOVE "CHG" TO MODO-CORRENTE GO GUIDA-CHG. PERFORM CONTROLLA-W2 THRU CONTROLLA-W2-EXIT. IF W2-SBAGLIATO GO EMETTE-W2. PERFORM DUPLICA-GRUPPO THRU DUPLICA-GRUPPO-EXIT. GO EMETTE-W2 DEPENDING PERFORM-STATUS. MOVE "CHG" TO MODO-CORRENTE. GO GUIDA-CHG. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Chiude i file e ritorna. *---------------------------------------------------------------- FINE. CLOSE LGL1. IF PHY1CHG-APERTO CLOSE PHY1CHG. IF PHY1ADD-APERTO CLOSE PHY1ADD. CLOSE VIDEO. STOP RUN. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Routine. *---------------------------------------------------------------- CONTROLLA-W1. SET W1-GIUSTO TO TRUE. IF W1DES OF W1-I EQUAL SPACE SET ACCESO (CAMPO-IN-BIANCO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1TYP OF W1-I NOT EQUAL SPACE AND "P" SET ACCESO (TIPO-ERRATO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1ATR OF W1-I NOT EQUAL SPACE AND "K" AND "1" SET ACCESO (ATTRIBUTO-ERRATO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1ATR OF W1-I EQUAL "K" AND W1TYP OF W1-I NOT EQUAL "P" SET ACCESO (ATTRIBUTO-INCOERENTE-CON-TIPO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1ATR OF W1-I EQUAL "1" AND W1TYP OF W1-I NOT EQUAL SPACE SET ACCESO (ATTRIBUTO-INCOERENTE-CON-TIPO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1ATR OF W1-I EQUAL "1" MOVE "1" TO MODE400 ELSE MOVE "0" TO MODE400. IF W1CMD OF W1-I NOT EQUAL SPACE AND W1TYP OF W1-I NOT EQUAL "P" MOVE SPACE TO CMD-ESEGUIBILE MOVE W1CMD OF W1-I TO CMD-ESEGUIBILE CALL "JFNCCHK" USING CMD-ESEGUIBILE CMD-LENGTH MODE400 CMD-OK IF CMD-OK NOT EQUAL "1" SET ACCESO (CMD-ERRATO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1CMD OF W1-I NOT EQUAL SPACE AND W1TYP OF W1-I EQUAL "P" MOVE SPACE TO CMD-ESEGUIBILE STRING "CALL " W1CMD OF W1-I DELIMITED SIZE INTO CMD-ESEGUIBILE CALL "JFNCCHK" USING CMD-ESEGUIBILE CMD-LENGTH MODE400-0 CMD-OK IF CMD-OK NOT EQUAL "1" SET ACCESO (NOME-PROGRAMMA-NON-VALIDO) TO TRUE GO CONTROLLA-W1-ERRORE. IF W1HLM OF W1-I NOT EQUAL SPACE MOVE W1HLM OF W1-I TO UN-CARATTERE MOVE SPACE TO CMD-ESEGUIBILE STRING "DSPPFM NN " W1HLM OF W1-I DELIMITED SIZE INTO CMD-ESEGUIBILE CALL "JFNCCHK" USING CMD-ESEGUIBILE CMD-LENGTH MODE400-0 CMD-OK IF CMD-OK NOT EQUAL "1" OR UN-CARATTERE EQUAL SPACE SET ACCESO (NOME-MEMBRO-NON-VALIDO) TO TRUE GO CONTROLLA-W1-ERRORE. GO CONTROLLA-W1-EXIT. CONTROLLA-W1-ERRORE. SET W1-SBAGLIATO TO TRUE. CONTROLLA-W1-EXIT. EXIT. CONTROLLA-W2. SET W2-GIUSTO TO TRUE. CONTROLLA-W2-UNO-BEG. MOVE W2GRP OF W2-I TO U1GRP OF RECORD-LGL1. MOVE LOW-VALUES TO U1FNC OF RECORD-LGL1. START LGL1 KEY NOT LESS EXTERNALLY-DESCRIBED-KEY INVALID GO CONTROLLA-W2-UNO-END. READ LGL1 NEXT END GO CONTROLLA-W2-UNO-END. IF W2GRP OF W2-I EQUAL U1GRP OF RECORD-LGL1 SET ACCESO (GRUPPO-GIA-ESISTENTE) TO TRUE GO CONTROLLA-W2-ERRORE. CONTROLLA-W2-UNO-END. CONTROLLA-W2-DUE-BEG. MOVE W2GR2 OF W2-I TO U1GRP OF RECORD-LGL1. MOVE LOW-VALUES TO U1FNC OF RECORD-LGL1. START LGL1 KEY NOT LESS EXTERNALLY-DESCRIBED-KEY INVALID GO CONTROLLA-W2-ERRORE. READ LGL1 NEXT END GO CONTROLLA-W2-ERRORE. IF W2GR2 OF W2-I NOT EQUAL U1GRP OF RECORD-LGL1 SET ACCESO (GRUPPO-INESISTENTE) TO TRUE GO CONTROLLA-W2-ERRORE. CONTROLLA-W2-DUE-END. GO CONTROLLA-W2-EXIT. CONTROLLA-W2-ERRORE. SET W2-SBAGLIATO TO TRUE. CONTROLLA-W2-EXIT. EXIT. SBIANCA-W1. MOVE SPACE TO W1GRP OF W1-O. MOVE SPACE TO W1FNC OF W1-O. MOVE SPACE TO W1GR2 OF W1-O. MOVE SPACE TO W1FN2 OF W1-O. MOVE SPACE TO W1DES OF W1-O. MOVE SPACE TO W1TYP OF W1-O. MOVE SPACE TO W1ATR OF W1-O. MOVE SPACE TO W1CMD OF W1-O. MOVE SPACE TO W1HLM OF W1-O. MOVE SPACE TO W1MSG OF W1-O. SBIANCA-W2. MOVE SPACE TO W2GRP OF W2-O. MOVE SPACE TO W2GR2 OF W2-O. MUOVE-DA-LGL1-A-W1. MOVE U1GRP OF RECORD-LGL1 TO W1GRP OF W1-O. MOVE U1FNC OF RECORD-LGL1 TO W1FNC OF W1-O. MOVE U1GR2 OF RECORD-LGL1 TO W1GR2 OF W1-O. MOVE U1FN2 OF RECORD-LGL1 TO W1FN2 OF W1-O. MOVE U1DES OF RECORD-LGL1 TO W1DES OF W1-O. MOVE U1TYP OF RECORD-LGL1 TO W1TYP OF W1-O. MOVE U1ATR OF RECORD-LGL1 TO W1ATR OF W1-O. MOVE U1CMD OF RECORD-LGL1 TO W1CMD OF W1-O. MOVE U1HLM OF RECORD-LGL1 TO W1HLM OF W1-O. MOVE U1MSG OF RECORD-LGL1 TO W1MSG OF W1-O. MUOVE-DA-W1-A-PHY1CHG. MOVE W1GRP OF W1-I TO U1GRP OF RECORD-PHY1CHG. MOVE W1FNC OF W1-I TO U1FNC OF RECORD-PHY1CHG. MOVE W1GR2 OF W1-I TO U1GR2 OF RECORD-PHY1CHG. MOVE W1FN2 OF W1-I TO U1FN2 OF RECORD-PHY1CHG. MOVE W1DES OF W1-I TO U1DES OF RECORD-PHY1CHG. MOVE W1TYP OF W1-I TO U1TYP OF RECORD-PHY1CHG. MOVE W1ATR OF W1-I TO U1ATR OF RECORD-PHY1CHG. MOVE W1CMD OF W1-I TO U1CMD OF RECORD-PHY1CHG. MOVE W1HLM OF W1-I TO U1HLM OF RECORD-PHY1CHG. MOVE W1MSG OF W1-I TO U1MSG OF RECORD-PHY1CHG. MUOVE-DA-W1-A-PHY1ADD. MOVE W1GRP OF W1-I TO U1GRP OF RECORD-PHY1ADD. MOVE W1FNC OF W1-I TO U1FNC OF RECORD-PHY1ADD. MOVE W1GR2 OF W1-I TO U1GR2 OF RECORD-PHY1ADD. MOVE W1FN2 OF W1-I TO U1FN2 OF RECORD-PHY1ADD. MOVE W1DES OF W1-I TO U1DES OF RECORD-PHY1ADD. MOVE W1TYP OF W1-I TO U1TYP OF RECORD-PHY1ADD. MOVE W1ATR OF W1-I TO U1ATR OF RECORD-PHY1ADD. MOVE W1CMD OF W1-I TO U1CMD OF RECORD-PHY1ADD. MOVE W1HLM OF W1-I TO U1HLM OF RECORD-PHY1ADD. MOVE W1MSG OF W1-I TO U1MSG OF RECORD-PHY1ADD. DECIDE-PUTRETAIN-SU-W0. IF ULTIMO-VIDEO-EMESSO EQUAL "W0" SET ACCESO (PUT-RETAIN) TO TRUE ELSE SET SPENTO (PUT-RETAIN) TO TRUE MOVE "W0" TO ULTIMO-VIDEO-EMESSO. DECIDE-PUTRETAIN-SU-W1. IF ULTIMO-VIDEO-EMESSO EQUAL "W1" SET ACCESO (PUT-RETAIN) TO TRUE ELSE SET SPENTO (PUT-RETAIN) TO TRUE MOVE "W1" TO ULTIMO-VIDEO-EMESSO. DECIDE-PUTRETAIN-SU-W2. IF ULTIMO-VIDEO-EMESSO EQUAL "W2" SET ACCESO (PUT-RETAIN) TO TRUE ELSE SET SPENTO (PUT-RETAIN) TO TRUE MOVE "W2" TO ULTIMO-VIDEO-EMESSO. LEGGE-RECORD-PRECEDENTE. SET PERFORM-OK TO TRUE. READ LGL1 PRIOR END SET PERFORM-ER TO TRUE. ACCEPT I-O-FEEDBACK-AREA FROM I-O-FEEDBACK FOR LGL1. LEGGE-ULTIMO-RECORD. SET PERFORM-OK TO TRUE. READ LGL1 LAST END SET PERFORM-ER TO TRUE. ACCEPT I-O-FEEDBACK-AREA FROM I-O-FEEDBACK FOR LGL1. EMETTE-PIEDE-W0. SET ACCESO (ALARM) TO TRUE. SET ACCESO (OVERLAY) TO TRUE. MOVE "Scegli una chiave!" TO WMSG OF P1-O. PERFORM EMETTE-PIEDE. EMETTE-PIEDE-W1-CHG. SET ACCESO (OVERLAY) TO TRUE. SET SPENTO (ALARM) TO TRUE. IF MODO-CORRENTE EQUAL "DSP" MOVE "Esamina i dati!" TO WMSG OF P1-O. IF MODO-CORRENTE EQUAL "CHG" MOVE "Modifica i dati!" TO WMSG OF P1-O. IF MODO-CORRENTE EQUAL "DLT" SET ACCESO (ALARM) TO TRUE MOVE "ƒ Cancellazione pendente! €" TO WMSG OF P1-O. PERFORM EMETTE-PIEDE. EMETTE-PIEDE-W1-ADD. SET SPENTO (ALARM) TO TRUE. SET ACCESO (OVERLAY) TO TRUE. MOVE "Aggiungi i nuovi dati!" TO WMSG OF P1-O. PERFORM EMETTE-PIEDE. EMETTE-PIEDE-W2. SET SPENTO (ALARM) TO TRUE. SET ACCESO (OVERLAY) TO TRUE. MOVE "Indica nuovo gruppo e prototipo!" TO WMSG OF P1-O. PERFORM EMETTE-PIEDE. EMETTE-PIEDE. IF WMSG EQUAL WMSG-PRECEDENTE SET ACCESO (PUT-RETAIN) TO TRUE ELSE SET SPENTO (PUT-RETAIN) TO TRUE MOVE WMSG OF P1-O TO WMSG-PRECEDENTE. WRITE RECORD-VIDEO FORMAT "P1" INDICATOR INDICATORI. DUPLICA-GRUPPO. SET PERFORM-OK TO TRUE. MOVE W2GR2 OF W2-I TO U1GRP OF RECORD-LGL1. MOVE LOW-VALUES TO U1FNC OF RECORD-LGL1. START LGL1 KEY NOT LESS EXTERNALLY-DESCRIBED-KEY INVALID GO DUPLICA-GRUPPO-END. DUPLICA-GRUPPO-BEG. READ LGL1 NEXT END GO DUPLICA-GRUPPO-END. IF W2GR2 OF W2-I NOT EQUAL U1GRP OF RECORD-LGL1 GO DUPLICA-GRUPPO-END. IF NOT PHY1ADD-APERTO PERFORM APRE-PHY1ADD. MOVE RECORD-LGL1 TO RECORD-PHY1ADD. MOVE W2GRP OF W2-I TO U1GRP OF RECORD-PHY1ADD. WRITE RECORD-PHY1ADD. IF FILE-STATUS NOT EQUAL "00" SET ACCESO (ERRORE-DUPLICANDO) TO TRUE SET PERFORM-ER TO TRUE GO DUPLICA-GRUPPO-EXIT. GO DUPLICA-GRUPPO-BEG. DUPLICA-GRUPPO-END. DUPLICA-GRUPPO-EXIT. EXIT. APRE-PHY1CHG. OPEN I-O PHY1CHG. SET PHY1CHG-APERTO TO TRUE. APRE-PHY1ADD. OPEN EXTEND PHY1ADD. SET PHY1ADD-APERTO TO TRUE. RECORD-PHY1CHG-MODIFICATO. SET PERFORM-OK TO TRUE. SET ACCESO (RECORD-MODIFICATO-DA-ALTRI) TO TRUE. REWRITE RECORD-PHY1CHG INVALID DISPLAY "Errore imprevisto 01 durante " "il rilascio di un record bloccato." ACCEPT RISPOSTA SET PERFORM-ER TO TRUE. RILASCIA-RECORD-PHY1CHG. SET PERFORM-OK TO TRUE. READ PHY1CHG INVALID DISPLAY "Errore imprevisto 02 durante " "il rilascio di un record bloccato." ACCEPT RISPOSTA SET PERFORM-ER TO TRUE GO RILASCIA-RECORD-PHY1CHG-EXIT. REWRITE RECORD-PHY1CHG INVALID DISPLAY "Errore imprevisto 03 durante " "il rilascio di un record bloccato." ACCEPT RISPOSTA SET PERFORM-ER TO TRUE. RILASCIA-RECORD-PHY1CHG-EXIT. EXIT. ERRORE-IMPREVISTO. DISPLAY "Errore imprevisto 04 durante " "la chiamata di un programma." ACCEPT RISPOSTA. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SCN-PROMPTER-RQD. * Cerca la richiesta di prompter * nella stringa del comando da validare. *---------------------------------------------------------------- MOVE ZERO TO PROMPTER-RQD. IF CMD-PRIMO-CARATTERE EQUAL "?" ADD 1 TO PROMPTER-RQD GO SCN-PROMPTER-RQD-EXIT. INSPECT CMD-ESEGUIBILE TALLYING PROMPTER-RQD FOR ALL " ?". SCN-PROMPTER-RQD-EXIT. EXIT. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CONTROLLA-CMD. * Controlla la stringa del comando. *---------------------------------------------------------------- IF W1TYP OF W1-I EQUAL "P" MOVE SPACE TO CMD-ESEGUIBILE STRING "CALL " W1CMD OF W1-I DELIMITED SIZE INTO CMD-ESEGUIBILE ELSE MOVE SPACE TO CMD-ESEGUIBILE MOVE W1CMD OF W1-I TO CMD-ESEGUIBILE. IF W1ATR OF W1-I EQUAL "1" MOVE "1" TO MODE400 ELSE MOVE "0" TO MODE400. CALL "JFNCCHK" USING CMD-ESEGUIBILE CMD-LENGTH MODE400 CMD-OK. IF CMD-OK EQUAL "1" MOVE CORRESPONDING W1-I-SAVE TO W1-O MOVE MODO-CORRENTE TO W1MOD OF W1-O ELSE SET ACCESO (CMD-ERRATO) TO TRUE. IF ACCESO (CHANGE) SET ACCESO (MODIFIED-DATA-TAG) TO TRUE. *++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ MANIPOLA-CMD. * Manipola la stringa del comando. *---------------------------------------------------------------- MOVE SPACE TO CMD-ESEGUIBILE MOVE W1CMD OF W1-I TO CMD-ESEGUIBILE PERFORM SCN-PROMPTER-RQD THRU SCN-PROMPTER-RQD-EXIT. IF PROMPTER-RQD EQUAL ZERO MOVE SPACE TO CMD-ESEGUIBILE STRING "?" W1CMD OF W1-I DELIMITED SIZE INTO CMD-ESEGUIBILE. IF W1ATR OF W1-I EQUAL "1" MOVE "1" TO MODE400 ELSE MOVE "0" TO MODE400. CALL "JFNCCHK" USING CMD-ESEGUIBILE CMD-LENGTH MODE400 CMD-OK. IF CMD-OK EQUAL "1" MOVE CORRESPONDING W1-I-SAVE TO W1-O MOVE MODO-CORRENTE TO W1MOD OF W1-O MOVE CMD-ESEGUIBILE TO W1CMD OF W1-O ELSE SET ACCESO (CMD-ERRATO) TO TRUE. IF ACCESO (CHANGE) OR W1CMD OF W1-I NOT EQUAL CMD-ESEGUIBILE SET ACCESO (MODIFIED-DATA-TAG) TO TRUE. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCGEIND) FILETYPE(*SRC) ENDCHAR('//ENDSRC') 01 INDICATORI. 05 INDICATORE OCCURS 99 PIC 1 INDICATOR 1. 88 SPENTO VALUE B"0". 88 ACCESO VALUE B"1". 01 FILLER REDEFINES INDICATORI. 05 FILLER PIC X(69). 05 INDICATORI-DI-ERRORE PIC X(21). 01 USO-DEGLI-INDICATORI. 05 RITORNA PIC 99 VALUE 01. 05 PASSO-PRECEDENTE PIC 99 VALUE 02. 05 PASSO-SUCCESSIVO PIC 99 VALUE 03. 05 FUNZIONI-ALTERNATIVE PIC 99 VALUE 04. 05 RINFRESCA PIC 99 VALUE 05. 05 SUPER-ROLL-UP PIC 99 VALUE 06. 05 SUPER-ROLL-DOWV PIC 99 VALUE 07. 05 VISUALIZZA PIC 99 VALUE 08. 05 AGGIUNGE PIC 99 VALUE 09. 05 MODIFICA PIC 99 VALUE 10. 05 CANCELLA PIC 99 VALUE 11. 05 CONTROLLA-ERRORI PIC 99 VALUE 12. 05 FINE-DOCUMENTO PIC 99 VALUE 14. 05 FINE-DOCUMENTO-CON-TOTALI PIC 99 VALUE 15. 05 APPROVA-ERRORI-LIEVI PIC 99 VALUE 16. 05 DECODIFICA PIC 99 VALUE 18. 05 POSIZIONA PIC 99 VALUE 20. 05 IMPOSTA-BATCH PIC 99 VALUE 21. 05 LOWERCASSE-UPPERCASE-SWITCH PIC 99 VALUE 23. 05 NOTA PIC 99 VALUE 24. 05 HELP PIC 99 VALUE 25. 05 HOME PIC 99 VALUE 26. 05 CLEAR PIC 99 VALUE 27. 05 ROLL-DOWN PIC 99 VALUE 28. 05 ROLL-UP PIC 99 VALUE 29. 05 ALARM PIC 99 VALUE 30. 05 CHANGE PIC 99 VALUE 31. 05 OVERLAY PIC 99 VALUE 32. 05 PROTECT PIC 99 VALUE 33. 05 PUT-OVERRIDE PIC 99 VALUE 34. 05 PUT-RETAIN PIC 99 VALUE 35. 05 SUBFILE-CLEAR PIC 99 VALUE 36. 05 SUBFILE-DELETE PIC 99 VALUE 37. 05 SUBFILE-DISPLAY PIC 99 VALUE 38. 05 SUBFILE-DISPLAY-CONTROL PIC 99 VALUE 39. 05 SUBFILE-END PIC 99 VALUE 40. 05 SUBFILE-INITIALISE PIC 99 VALUE 41. 05 SUBFILE-NEXT-CHANGE PIC 99 VALUE 42. 05 PROTECT-FIELD PIC 99 VALUE 43. 05 MODIFIED-DATA-TAG PIC 99 VALUE 44. 05 SPECIAL-PROTECT-FIELD PIC 99 VALUE 45. 05 PERMESSO-MINUSCOLO PIC 99 VALUE 46. 05 VIGE-MODIFICA PIC 99 VALUE 57. 05 POSITION-CURSOR PIC 99 VALUE 58. 05 PERMESSA-GESTIONE PIC 99 VALUE 59. 05 SWITCH-INTESTAZIONI PIC 99 VALUE 60. 05 SUBFILE-NON-VUOTO PIC 99 VALUE 61. 05 PRIMA-SEQUENZA PIC 99 VALUE 62. 05 SECONDA-SEQUENZA PIC 99 VALUE 63. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCGEW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A*%%TS SD 20090122 100425 ANPRO15 REL-V5R4M0 5722-WDS A* 89/04/04 17:06:46 NERONI REL-R01M00 5728-PW1 A* 21:37:46 NERONI REL-R07M00 5714-UT1 A*%%EC A DSPSIZ(24 80 *DS3) A CHGINPDFT A MSGLOC(24) A PRINT A INDTXT(01 'Ritorna.') A INDTXT(02 'Passo precedente.') A INDTXT(03 'Passo successivo.') A INDTXT(04 'Funzioni alternative.') A INDTXT(05 'Rinfresca.') A INDTXT(06 'Duplica.(Ex Super roll u- A p.)') A INDTXT(07 'Super roll down.') A INDTXT(08 'Visualizza.') A INDTXT(09 'Aggiunge.') A INDTXT(10 'Modifica.') A INDTXT(11 'Cancella.') A INDTXT(12 'Controlla errori.') A INDTXT(14 'Fine documento.') A INDTXT(15 'Fine documento con total- A i.') A INDTXT(16 'Approva errori lievi.') A INDTXT(18 'Decodifica.') A INDTXT(20 'Posiziona.') A INDTXT(21 'Imposta batch.') A INDTXT(23 'Lowercase uppercase swit- A ch.') A INDTXT(24 'Nota.') A INDTXT(25 'Help.') A INDTXT(26 'Home.') A INDTXT(27 'Clear.') A INDTXT(28 'Roll down.') A INDTXT(29 'Roll up.') A INDTXT(30 'Alarm.') A INDTXT(31 'Change.') A INDTXT(32 'Overlay.') A INDTXT(33 'Protect.') A INDTXT(34 'Put override.') A INDTXT(35 'Put retain.') A INDTXT(36 'Subfile clear.') A INDTXT(37 'Subfile delete.') A INDTXT(38 'Subfile display.') A INDTXT(39 'Subfile display control.- A ') A INDTXT(40 'Subfile end.') A INDTXT(41 'Subfile inizialize.') A INDTXT(42 'Subfile next changed.') A INDTXT(43 'Protect field.') A INDTXT(44 'Set on MDT.') A INDTXT(45 'Special protect field.') A INDTXT(46 'Permesso minuscolo.') A INDTXT(58 'Posiziona cursore.') A INDTXT(59 'Permessa gestione.') A INDTXT(60 'Switch intestazioni.') A INDTXT(61 'Subfile non vuoto.') A INDTXT(62 'Prima sequenza.') A INDTXT(63 'Seconda sequenza.') A 25N25 CLEAR A INDTXT(70 'Campo in bianco.') A INDTXT(71 'Dummy.') A INDTXT(72 'Comando errato.') A INDTXT(73 'Record sparito.') A INDTXT(74 'Record modificato da alt- A ri.') A INDTXT(75 'Record già esistente.') A INDTXT(76 'Record bloccato.') A INDTXT(77 'Tasto non permesso.') A INDTXT(78 'Valori permessi: P(progr- A amma); blank(comando).') A INDTXT(79 'Valori permessi: K(passa- A architettura); blank(non') A INDTXT(80 'K(passa architettura) pe- A rmesso solo se Tipo=P(prog') A INDTXT(81 'Nome programma non valid- A o.') A INDTXT(82 'Tasto non permesso per T- A ipo=P(programma).') A INDTXT(83 'Nome membro non valido.') A INDTXT(84 'Gruppo già esistente.') A INDTXT(85 'Gruppo inesistente.') A INDTXT(86 'Errore durante la duplic- A azione del gruppo.') A INDARA A* 89/04/04 17:06:46 NERONI REL-R01M00 5728-PW1 A* 21:37:46 NERONI REL-R07M00 5714-UT1 A R W0 A*%%TS SD 20090122 100425 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('Video guida.') A CA03(01) A CA12(02) A CF06(06) A CF08(08) A CF09(09) A CF10(10) A CF11(11) A 25 HELP(25) A HOME(26) A ROLLDOWN(28) A ROLLUP(29) A CHANGE(31) A BLINK A LOCK A 32 OVERLAY A 1 2DATE A EDTCDE(Y) A 1 11TIME A 1 31' Guida Collezione ' A DSPATR(UL) A 35 PUTRETAIN A W0MOD 3A O 1 66TEXT('Modo.') A DSPATR(HI) A W0USR 10A O 1 70 A 35 PUTRETAIN A TEXT('Utente.') A 71 ERRMSG('Dummy.') A 77 ERRMSG('Tasto non permesso') A 3 16'Gruppo:' A 35 PUTRETAIN A DSPATR(HI) A W0GRP R B 3 25REFFLD(U1GRP JFNCX) A DSPATR(HI) A DSPATR(CS) A 4 14'Funzione:' A 35 PUTRETAIN A DSPATR(HI) A W0FNC R B 4 25REFFLD(U1FNC JFNCX) A DSPATR(HI) A DSPATR(CS) A 22 2'F3 F12' A 35 PUTRETAIN A DSPATR(HI) A 22 9'Ritorna' A 35 PUTRETAIN A 22 18'F6' A 35 PUTRETAIN A DSPATR(HI) A 22 21'Duplica' A 35 PUTRETAIN A 22 31'F8 F11' A 35 PUTRETAIN A DSPATR(HI) A 22 38'Visualizza' A 35 PUTRETAIN A 22 50'F9' A 35 PUTRETAIN A DSPATR(HI) A 22 53'Aggiunge' A 35 PUTRETAIN A 22 64'F10' A 35 PUTRETAIN A DSPATR(HI) A 22 68'Modifica' A 35 PUTRETAIN A 23 3'HOME' A 35 PUTRETAIN A DSPATR(HI) A 23 8'Riemette' A 35 PUTRETAIN A 23 17'ROLLUP' A 35 PUTRETAIN A DSPATR(HI) A 23 24'Primo' A 35 PUTRETAIN A 23 30'ROLLDW' A 35 PUTRETAIN A DSPATR(HI) A 23 37'Ultimo' A 35 PUTRETAIN A* 89/04/04 17:06:46 NERONI REL-R01M00 5728-PW1 A* 21:37:46 NERONI REL-R07M00 5714-UT1 A R W1 A*%%TS SD 20090122 100425 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('Video dati.') A CA03(01) A CA12(02) A CA01(03) A CF04(04) A CF05(05) A CF06(06) A CF08(08) A CF09(09) A CF10(10) A CF11(11) A CF02(12) A 25 HELP(25) A HOME(26) A ROLLDOWN(28) A ROLLUP(29) A CHANGE(31) A BLINK A LOCK A 32 OVERLAY A 1 2DATE A EDTCDE(Y) A 1 11TIME A 1 35' Funzione ' A DSPATR(UL) A 35 PUTRETAIN A W1MOD 3A O 1 66TEXT('Modo.') A DSPATR(HI) A W1USR 10A O 1 70 A 35 PUTRETAIN A TEXT('Utente.') A 71 ERRMSG('Dummy.') A 77 ERRMSG('Tasto non permesso') A 73 ERRMSG('Record sparito.') A 74 ERRMSG('Record modificato da altri.- A ') A 76 ERRMSG('Record bloccato.') A 3 16'Gruppo:' A 35 PUTRETAIN A DSPATR(HI) A W1GRP R B 3 25REFFLD(U1GRP JFNCX) A DSPATR(HI) A N43 DSPATR(CS) A 43 DSPATR(PR) A 44 DSPATR(MDT) A 75 ERRMSG('Record già esistente.') A 4 14'Funzione:' A 35 PUTRETAIN A DSPATR(HI) A W1FNC R B 4 25REFFLD(U1FNC JFNCX) A DSPATR(HI) A N43 DSPATR(CS) A 43 DSPATR(PR) A 75 ERRMSG('Record già esistente.') A 6 4'Gruppo sostitutivo:' A 35 PUTRETAIN A W1GR2 R B 6 25REFFLD(U1GR2 JFNCX) A N43 DSPATR(CS) A 43 DSPATR(PR) A TEXT('Gruppo funzione sostitutiva.') A 7 2'Funzione sostitutiva:' A 35 PUTRETAIN A W1FN2 R B 7 25REFFLD(U1FN2 JFNCX) A N43 DSPATR(CS) A 43 DSPATR(PR) A 8 11'Descrizione:' A 35 PUTRETAIN A W1DES R B 8 25REFFLD(U1DES JFNCX) A CHECK(LC) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 70 ERRMSG('Campo in bianco.') A 9 18'Tipo:' A 35 PUTRETAIN A W1TYP R B 9 25REFFLD(U1TYP JFNCX) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 78 ERRMSG('Valori permessi: P(programm- A a); blank(comando).') A 82 ERRMSG('Tasto non permesso per Tipo- A =P(programma).') A 10 13'Attributo:' A 35 PUTRETAIN A W1ATR R B 10 25REFFLD(U1ATR JFNCX) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 79 ERRMSG('Valori permessi: K(passa ar- A chitettura); blank(non') A 80 ERRMSG('K(passa architettura) perme- A sso solo se Tipo=P(prog') A 10 29'blank=Cmd38 1=Cmd400' A 35 PUTRETAIN A 11 15'Comando:' A 35 PUTRETAIN A W1CMD R B 11 25REFFLD(U1CMD JFNCX) A CHECK(LC) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 72 ERRMSG('Comando errato.') A 81 ERRMSG('Nome programma non valido.') A 18 10'Membro aiuto:' A 35 PUTRETAIN A W1HLM R B 18 25REFFLD(U1HLM JFNCX) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 83 ERRMSG('Nome membro non valido.') A 19 13'Messaggio:' A 35 PUTRETAIN A W1MSG R B 19 25REFFLD(U1MSG JFNCX) A CHECK(LC) A N43 DSPATR(CS) A 43 DSPATR(PR) A 58 DSPATR(PC) A 21 1'F3' A 35 PUTRETAIN A DSPATR(HI) A 21 4'Ritorna' A 35 PUTRETAIN A 21 14'F12' A 35 PUTRETAIN A DSPATR(HI) A 21 18'Guida' A 35 PUTRETAIN A 21 26'F1' A 35 PUTRETAIN A DSPATR(HI) A 21 29'Esegue cmd in DSP' A 35 PUTRETAIN A 21 49'F4' A 35 PUTRETAIN A DSPATR(HI) A 21 52'Manipola cmd' A 35 PUTRETAIN A 21 67'F5' A 35 PUTRETAIN A DSPATR(HI) A 21 70'Rinfresca' A 35 PUTRETAIN A 22 2'F6' A 35 PUTRETAIN A DSPATR(HI) A 22 5'Duplica' A 35 PUTRETAIN A 22 15'F8' A 35 PUTRETAIN A DSPATR(HI) A 22 18'Visualizza' A 35 PUTRETAIN A 22 31'F9' A 35 PUTRETAIN A DSPATR(HI) A 22 34'Aggiunge' A 35 PUTRETAIN A 22 45'F10' A 35 PUTRETAIN A DSPATR(HI) A 22 49'Modifica' A 35 PUTRETAIN A 22 60'F11' A 35 PUTRETAIN A DSPATR(HI) A 22 64'Cancella' A 35 PUTRETAIN A 23 3'F2' A 35 PUTRETAIN A DSPATR(HI) A 23 6'Controlla' A 35 PUTRETAIN A 23 18'HOME' A 35 PUTRETAIN A DSPATR(HI) A 23 23'Riemette' A 35 PUTRETAIN A 23 32'ROLLUP' A 35 PUTRETAIN A DSPATR(HI) A 23 39'Successivo' A 35 PUTRETAIN A 23 50'ROLLDW' A 35 PUTRETAIN A DSPATR(HI) A 23 57'Precedente' A 35 PUTRETAIN A R P1 A* 89/04/04 17:06:46 NERONI REL-R01M00 5728-PW1 A* 14:36:43 NERONI REL-R07M00 5714-UT1 A TEXT('Piede del video.') A BLINK A LOCK A 32 OVERLAY A 30 ALARM A WMSG 78A O 24 2 A 71 ERRMSG('Dummy.') A 35 PUTRETAIN A TEXT('Messaggio di piede.') A DSPATR(HI) A* 89/04/04 17:06:46 NERONI REL-R01M00 5728-PW1 A* 21:37:46 NERONI REL-R07M00 5714-UT1 A R W2 A*%%TS SD 20090122 100425 ANPRO15 REL-V5R4M0 5722-WDS A TEXT('Video duplicazione.') A CA03(01) A CA12(02) A 25 HELP(25) A HOME(26) A CHANGE(31) A BLINK A LOCK A 32 OVERLAY A 1 2DATE A EDTCDE(Y) A 1 11TIME A 1 32' Duplica gruppo ' A DSPATR(UL) A 35 PUTRETAIN A W2MOD 3A O 1 66TEXT('Modo.') A DSPATR(HI) A W2USR 10A O 1 70 A 35 PUTRETAIN A TEXT('Utente.') A 71 ERRMSG('Dummy.') A 3 2'Gruppo da aggiungere:' A 35 PUTRETAIN A DSPATR(HI) A W2GRP R B 3 25REFFLD(U1GRP JFNCX) A DSPATR(HI) A DSPATR(CS) A 44 DSPATR(MDT) A 84 ERRMSG('Gruppo già esistente.') A 86 ERRMSG('Errore durante la duplicazi- A one del gruppo.') A 4 6'Gruppo prototipo:' A 35 PUTRETAIN A W2GR2 R B 4 25REFFLD(U1GR2 JFNCX) A DSPATR(CS) A TEXT('Gruppo prototipo.') A 85 ERRMSG('Gruppo inesistente.') A 86 ERRMSG('Errore durante la duplicazi- A one del gruppo.') A 23 2'F3' A 35 PUTRETAIN A DSPATR(HI) A 23 5'Ritorna' A 35 PUTRETAIN A 23 15'F12' A 35 PUTRETAIN A DSPATR(HI) A 23 19'Passo precedente' A 35 PUTRETAIN //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCK) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §FNCK. */ /* */ /* Esegue il comando di cui riceve la chiave e restituisce */ /* un messaggio di avvenuta esecuzione. */ /* */ CMD PROMPT('Esegue comando con chiave') PARM KWD(KEY) TYPE(KEY) PROMPT('Chiave del + comando') KEY: ELEM TYPE(*CHAR) LEN(10) DFT(*SYSVAL) + PROMPT('Gruppo') ELEM TYPE(*CHAR) LEN(10) PROMPT('Funzione') PARM KWD(FILE) TYPE(FILE) PROMPT('File collezione') FILE: QUAL TYPE(*NAME) DFT(§LIBL) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('nella libreria') PARM KWD(PROMPT) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) SPCVAL((P *YES)) + PROMPT('Richiesto prompt') PARM KWD(CLOF) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*NO *YES) PROMPT('Chiude + il file comandi') PARM KWD(ABSENTMSGT) TYPE(*CHAR) LEN(7) RSTD(*YES) + DFT(*ESCAPE) VALUES(*ESCAPE *INFO) + PROMPT('Tipo del messaggio di assenza') PARM KWD(ESCAPE) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*NO *YES) + PROMPT('Considera messaggi di rilascio') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCKA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CMD §FNCKA. */ /* */ /* Esegue gruppo di comandi con chiave. */ /* */ CMD PROMPT('Esegue gruppo comandi chiave') PARM KWD(GRP) TYPE(*CHAR) LEN(10) PROMPT('Gruppo + di comandi') PARM KWD(FILE) TYPE(FILE) PROMPT('File collezione') FILE: QUAL TYPE(*NAME) DFT(§PGMR) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('nella libreria') PARM KWD(PROMPT) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) SPCVAL((P *YES)) + PROMPT('Richiesto prompt') PARM KWD(ESCAPE) TYPE(*CHAR) LEN(4) RSTD(*YES) + DFT(*YES) VALUES(*NO *YES) + PROMPT('Considera messaggi di rilascio') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCKAE) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §FNCKA. */ /* */ /* Esegue gruppo di comandi con chiave. */ /* */ PGM PARM(&GRP &FILELIB &PROMPT &ESCAPE) /* Gruppo della funzione da eseguire. */ DCL VAR(&GRP) TYPE(*CHAR) LEN(10) /* Nome qualificato del file delle funzioni. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Richiesta di prompt. */ DCL VAR(&PROMPT) TYPE(*CHAR) LEN(4) /* Considera i messaggi di rilascio. */ DCL VAR(&ESCAPE) TYPE(*CHAR) LEN(4) /* Funzione da eseguire. */ DCL VAR(&FNC) TYPE(*CHAR) LEN(10) /* File delle funzioni. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file delle funzioni. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Membro del file delle funzioni. */ DCL VAR(&MBR) TYPE(*CHAR) LEN(10) /* Stringa letta sull'anagrafico contenente il comando. */ DCL VAR(&CMD) TYPE(*CHAR) LEN(512) /* Stringa da eseguire. */ DCL VAR(&CMDE) TYPE(*CHAR) LEN(513) /* Descrizione della funzione. */ DCL VAR(&DES) TYPE(*CHAR) LEN(50) /* Messaggio di completamento del comando. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(80) /* Tipo del lavoro corrente. */ DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) /* Recupero felice della funzione nel gruppo. */ DCL VAR(&FOUND) TYPE(*LGL) /* Ultima funzione nel gruppo. */ DCL VAR(&LAST) TYPE(*LGL) /* Comando in forma AS/400. */ DCL VAR(&AS400) TYPE(*CHAR) LEN(1) /* Esecutore del comando. */ DCL VAR(&CMDEXC) TYPE(*CHAR) LEN(10) /* Richiesta. */ DCL VAR(&REQUEST) TYPE(*CHAR) LEN(6) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta tutti gli errori saltando a fine con errore. */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORE)) /* Estrae dai parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Recupera il tipo lavoro. */ RTVJOBA TYPE(&TYPE) /* Predispone la ricerca della prima funzione nel gruppo. */ CHGVAR VAR(&REQUEST) VALUE(*FIRST) /* Label di ricerca funzione. */ FNCSEARCH: /* Chiama la ricerca della funzione nel gruppo. */ JFNCFG GROUP(&GRP) FUNCTION(&FNC) REQUEST(&REQUEST) + SNDERRMSG(*NO) DES(&DES) CMD(&CMD) + MSG(&MSG) FOUND(&FOUND) LAST(&LAST) + AS400(&AS400) FILE(&FILE) LIB(&LIB) MBR(&MBR) /* Se non trova la prima funzione. */ IF COND((*NOT &FOUND) *AND (&REQUEST *EQ + *FIRST)) THEN(DO) /* Diagnostica. */ SNDPGMMSG MSGID(JKY0013) MSGF(JFNC) MSGDTA(&GRP *CAT + &FILELIB) MSGTYPE(*DIAG) /* Salta a Prenotazione rilascio. */ GOTO CMDLBL(CPF0001) /* End. */ ENDDO /* Se non trova altre funzioni. */ IF COND(*NOT &FOUND) THEN(DO) /* Salta a fine. */ GOTO CMDLBL(END) /* End. */ ENDDO /* Se il messaggio è in bianco. */ IF COND(&MSG *EQ ' ') THEN(DO) /* Assume la descrizione come messaggio. */ CHGVAR VAR(&MSG) VALUE(&DES) /* End. */ ENDDO /* Segnala l'avanzamento del lavoro. */ IF COND(&MSG *NE ' ') THEN(DO) SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) + TOPGMQ(*EXT) MSGTYPE(*STATUS) ENDDO /* Trascrive la stringa trovata nella stringa da eseguire. */ CHGVAR VAR(&CMDE) VALUE(&CMD) /* Se è richiesto il prompt */ /* e se il lavoro è interattivo. */ IF COND((&PROMPT *EQ *YES) *AND (&TYPE *EQ '1')) + THEN(DO) /* Inserisce la richiesta di prompt in testa alla stringa */ /* contenente il comando eseguibile. */ CHGVAR VAR(&CMDE) VALUE('?' *CAT &CMD) /* End. */ ENDDO /* Se il comando è per AS/400, assume l'appropriato esecutore. */ IF COND(&AS400 *EQ '1') THEN(CHGVAR VAR(&CMDEXC) + VALUE(QCMDEXC)) /* Se il comando non è per AS/400, assume l'appropriato esecutore. */ ELSE CMD(CHGVAR VAR(&CMDEXC) VALUE(QCAEXEC)) /* Esegue il comando trovato. */ CALL PGM(&CMDEXC) PARM(&CMDE 513) /* Se il comando in esecuzione viene annullato con CMD 1 sul prompter, */ /* salta a fine segnalazione avanzamento. */ MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MSGEND)) /* Se eseguendo riscontra errori. */ MONMSG MSGID(CPF0000 MCH0000 EDT0000 RPG0000 + CBE0000) EXEC(DO) /* Diagnostica. */ SNDPGMMSG MSGID(JKY0012) MSGF(JFNC) MSGDTA(&GRP *CAT + &FNC *CAT &FILELIB) MSGTYPE(*DIAG) /* Se è richiesto rilascio in caso di errori. */ IF COND(&ESCAPE *EQ *YES) THEN(DO) /* Salta a Prenotazione rilascio. */ GOTO CMDLBL(CPF0001) /* End. */ ENDDO /* End. */ ENDDO /* Segnala l'avanzamento del lavoro. */ IF COND(&MSG *NE ' ') THEN(DO) SNDPGMMSG MSG(&MSG) ENDDO /* Fine segnalazione avanzamento. */ MSGEND: /* Se l'ultima funzione è già stata restituita. */ IF COND(&LAST) THEN(DO) /* Salta a fine. */ GOTO CMDLBL(END) /* End. */ ENDDO /* Se la ricerca appena avvenuta era per la prima funzione del gruppo. */ IF COND(&REQUEST *EQ *FIRST) THEN(DO) /* Predispone la ricerca della funzione successiva del gruppo. */ CHGVAR VAR(&REQUEST) VALUE(*NEXT) /* End. */ ENDDO /* Salta alla ricerca di un'altra funzione. */ GOTO CMDLBL(FNCSEARCH) /* Label di fine. */ END: /* Attività finali. */ RCLRSC: /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) + MSGDTA(JFNCKA ) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG RMV(*NO) MONMSG MSGID(CPF0000 MCH0000) /* Prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta ad Attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCK0) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §FNCK. */ /* */ /* Esegue comando con chiave. */ /* */ /* Esegue il comando di cui riceve la chiave e restituisce */ /* un messaggio di avvenuta esecuzione. */ /* */ PGM PARM(&GRPFNC &FILELIB &PROMPT &CLOSE + &ABSENTMSGT &ESCAPE) /* Gruppo e funzione della funzione da eseguire. */ DCL VAR(&GRPFNC) TYPE(*CHAR) LEN(22) /* Nome qualificato del file delle funzioni. */ DCL VAR(&FILELIB) TYPE(*CHAR) LEN(20) /* Richiesta di prompt. */ DCL VAR(&PROMPT) TYPE(*CHAR) LEN(4) /* Richiesta di chiusura del file contenente i comandi eseguibili. */ DCL VAR(&CLOSE) TYPE(*CHAR) LEN(4) /* Tipo del messaggio di assenza. */ DCL VAR(&ABSENTMSGT) TYPE(*CHAR) LEN(7) /* Considera i messaggi di rilascio. */ DCL VAR(&ESCAPE) TYPE(*CHAR) LEN(4) /* Funzione da eseguire. */ DCL VAR(&FNC) TYPE(*CHAR) LEN(10) /* Gruppo della funzione da eseguire. */ DCL VAR(&GRP) TYPE(*CHAR) LEN(10) /* File delle funzioni. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file delle funzioni. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Richiesta di chiusura del file contenente i comandi eseguibili */ /* nella forma di indicatore logico. */ DCL VAR(&CLOSELGL) TYPE(*LGL) /* Stringa letta sull'anagrafico contenente il comando. */ DCL VAR(&CMD) TYPE(*CHAR) LEN(512) /* Stringa da eseguire. */ DCL VAR(&CMDE) TYPE(*CHAR) LEN(513) /* Messaggio di completamento del comando. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(80) /* Errore nella lettura dell'anagrafico. */ DCL VAR(&ERRORE) TYPE(*LGL) /* Comando per AS/400. */ DCL VAR(&AS400) TYPE(*CHAR) LEN(1) /* Esecutore del comando. */ DCL VAR(&CMDEXC) TYPE(*CHAR) LEN(10) /* Tipo del lavoro corrente. */ DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta tutti gli errori saltando a fine con errore. */ MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERRORE)) /* Estrae dai parametri. */ CHGVAR VAR(&GRP) VALUE(%SST(&GRPFNC 3 10)) CHGVAR VAR(&FNC) VALUE(%SST(&GRPFNC 13 10)) CHGVAR VAR(&FILE) VALUE(%SST(&FILELIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILELIB 11 10)) /* Converte un parametro dalla forma *NO/*YES alla forma 0/1. */ IF COND(&CLOSE *EQ *YES) THEN(CHGVAR + VAR(&CLOSELGL) VALUE('1')) ELSE CMD(CHGVAR VAR(&CLOSELGL) VALUE('0')) /* Controlla l'esistenza e l'autorità sul file. */ /********* CHKOBJ OBJ(&FILE.&LIB) OBJTYPE(*FILE) MBR(*FIRST) + AUT(*READ) **********/ /* Ridirige la lettura sul file dei comandi con chiave. */ OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) /* Cerca nel file la chiave ricevuta. */ CALL PGM(JFNCK1) PARM(&GRP &FNC &CLOSELGL &CMD + &MSG &ERRORE &AS400) /* Se non la trova. */ IF COND(&ERRORE) THEN(DO) /* Diagnostica. */ SNDPGMMSG MSGID(JKY0011) MSGF(JFNC ) MSGDTA(&GRP *CAT + &FNC *CAT &FILELIB) /* Se chiesto rilascio, salta a Prenotazione del CPF0001. */ IF COND(&ABSENTMSGT *EQ *ESCAPE) THEN(GOTO + CMDLBL(CPF0001)) /* Se non chiesto rilascio, salta ad Attività finali. */ ELSE CMD(GOTO CMDLBL(RCLRSC)) /* End. */ ENDDO /* Trascrive la stringa trovata nella stringa da eseguire. */ CHGVAR VAR(&CMDE) VALUE(&CMD) /* Se è richiesto il prompt. */ IF COND(&PROMPT *EQ *YES) THEN(DO) /* Recupera il tipo lavoro. */ RTVJOBA TYPE(&TYPE) /* Se il lavoro è interattivo. */ IF COND(&TYPE *EQ '1') THEN(DO) /* Inserisce la richiesta di prompt in testa alla stringa */ /* contenente il comando eseguibile. */ CHGVAR VAR(&CMDE) VALUE('?' *CAT &CMD) ENDDO ENDDO /* Se il comando è per AS/400, assume l'appropriato esecutore. */ IF COND(&AS400 *EQ '1') THEN(CHGVAR VAR(&CMDEXC) + VALUE(QCMDEXC)) /* Se il comando non è per AS/400, assume l'appropriato esecutore. */ ELSE CMD(CHGVAR VAR(&CMDEXC) VALUE(QCAEXEC)) /* Esegue il comando trovato. */ CALL PGM(&CMDEXC) PARM(&CMDE 513) /* Se il comando in esecuzione viene annullato con CMD 1 sul prompter, */ /* salta a fine segnalazione avanzamento. */ MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(MSGEND)) /* Se eseguendo riscontra errori. */ MONMSG MSGID(CPF0000 MCH0000 EDT0000 RPG0000 + CBE0000) EXEC(DO) /* Diagnostica. */ SNDPGMMSG MSGID(JKY0012) MSGF(JFNC ) MSGDTA(&GRP *CAT + &FNC *CAT &FILELIB) MSGTYPE(*DIAG) /* Se è richiesto rilascio in caso di errori. */ IF COND(&ESCAPE *EQ *YES) THEN(DO) /* Salta a Prenotazione rilascio. */ GOTO CMDLBL(CPF0001) /* End. */ ENDDO /* End. */ ENDDO /* Segnala l'avanzamento del lavoro. */ IF COND(&MSG *NE ' ') THEN(DO) SNDPGMMSG MSG(&MSG) ENDDO /* Fine segnalazione avanzamento. */ MSGEND: /* Attività finali. */ RCLRSC: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) MSGDTA(JFNCK) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG RMV(*NO) MONMSG MSGID(CPF0000 MCH0000) /* Prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta ad Attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCK1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Recupera il comando con chiave. * * RPG §FNCK1. * * Riceve in GRP il gruppo della funzione. * Riceve in FNC la funzione. * Riceve in CLOSE la richiesta di chiusura del file. * Restituisce in U1CMD il testo del comando presente sul record. * Restituisce in U1MSG il testo del messaggio di avvenuta * esecuzione. * Restituisce ERRORE in on se il record non viene trovato. * Restituisce in AS400 un 1 se il comando è per AS/400. * Se il record trovato porta una chiave sostituente, * cerca tale chiave e restituisce i campi di questo secondo record. * FJFNCX IF E K DISK UC C *ENTRY PLIST C PARM GRP I Gruppo C PARM FNC I Funzione C PARM CLOSE 1 I Chiude C PARM U1CMD O Comando C PARM U1MSG O Messaggio C PARM *IN51 ERRORE 1 O Errore C PARM U1ATR O Attributo C *LIKE DEFN U1FNC FNC C *LIKE DEFN U1GRP GRP C KEY KLIST C KFLD GRP C KFLD FNC C U1KEY KLIST C KFLD U1GR2 C KFLD U1FN2 C N52 DO C SETON 52 C OPEN JFNCX 51 C 51 SETON LR C 51 RETRN C END C KEY CHAINU1R 51 C N51 U1GR2 IFNE *BLANK C U1FN2 ORNE *BLANK C U1KEY CHAINU1R 51 C END C U1MSG IFEQ *BLANK C MOVELU1DES U1MSG C END C CLOSE COMP '1' LR C RETRN //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCMANCA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') PGM SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) + MSGDTA('Programma mancante. PROVA') + TOPGMQ(*EXT) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCNEW) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello nuova collezione funzioni. * * RPG §FNCNEW. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCX UF E DISK A UC F U1R KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCX * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL U1GRP C MOVEL*LOVAL U1FNC C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLD) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* */ /* CLP §FNCOLD. */ /* */ /* Converte da vecchie collezioni funzioni. */ /* */ PGM PARM(&FILE &LIB) /* File da convertire. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file da convertire. */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) /* Errore di livello sul file aperto come vecchio. */ DCL VAR(&LVLCHK1) TYPE(*CHAR) LEN(1) /* Errore di livello sul file aperto come nuovo. */ DCL VAR(&LVLCHK) TYPE(*CHAR) LEN(1) /* Stato del file secondo rpg aperto come vecchio. */ DCL VAR(&STS1) TYPE(*CHAR) LEN(5) /* Stato del file secondo rpg aperto come nuovo. */ DCL VAR(&STS) TYPE(*CHAR) LEN(5) /* Rilascio del file collezione. */ DCL VAR(&REL) TYPE(*CHAR) LEN(1) /* Messaggio. */ DCL VAR(&MSG) TYPE(*CHAR) LEN(132) /* Controlla l'esistenza e l'autorità sul file. */ CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(*FIRST) AUT(*OBJEXIST) /* Se il file non esiste o non è autorizzato. */ MONMSG MSGID(CPF0000) EXEC(DO) /* Ritorna subito. */ RETURN /* End. */ ENDDO /* Se la libreria del file è *LIBL. */ IF COND(&LIB *EQ *LIBL) THEN(DO) /* Recupera la libreria del file. */ RTVOBJD OBJ(&FILE) OBJTYPE(*FILE) RTNLIB(&LIB) /* End. */ ENDDO /* Ridirige il controllo di livello per il rilascio corrente. */ OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio corrente. */ CALL PGM(JFNCNEW) PARM(&LVLCHK &STS) /* Se il file è del rilascio corrente, ritorna subito. */ IF COND(&LVLCHK *NE '1') THEN(RETURN) /* Rimuove gli indirizzamenti. */ DLTOVR FILE(*ALL) /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Ridirige il controllo di livello per il rilascio Z. */ OVRDBF FILE(JFNCXZ) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio Z. */ CALL PGM(JFNCOLDZ) PARM(&LVLCHK1 &STS1) /* Se il file è del rilascio Z. */ IF COND(&LVLCHK1 *NE '1') THEN(DO) /* Annota che il file è del rilascio Z. */ CHGVAR VAR(&REL) VALUE('Z') /* Salta a Fine controllo rilascio. */ GOTO CMDLBL(ENDREL) /* End. */ ENDDO /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Ridirige il controllo di livello per il rilascio 0. */ OVRDBF FILE(JFNCX0) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio 0. */ CALL PGM(JFNCOLD0) PARM(&LVLCHK1 &STS1) /* Se il file è del rilascio 0. */ IF COND(&LVLCHK1 *NE '1') THEN(DO) /* Annota che il file è del rilascio 0. */ CHGVAR VAR(&REL) VALUE('0') /* Salta a Fine controllo rilascio. */ GOTO CMDLBL(ENDREL) /* End. */ ENDDO /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Ridirige il controllo di livello per il rilascio 1. */ OVRDBF FILE(JFNCX1) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio 1. */ CALL PGM(JFNCOLD1) PARM(&LVLCHK1 &STS1) /* Se il file è del rilascio 1. */ IF COND(&LVLCHK1 *NE '1') THEN(DO) /* Annota che il file è del rilascio 1. */ CHGVAR VAR(&REL) VALUE('1') /* Salta a Fine controllo rilascio. */ GOTO CMDLBL(ENDREL) /* End. */ ENDDO /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Ridirige il controllo di livello per il rilascio 2. */ OVRDBF FILE(JFNCX2) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio 2. */ CALL PGM(JFNCOLD2) PARM(&LVLCHK1 &STS1) /* Se il file è del rilascio 2. */ IF COND(&LVLCHK1 *NE '1') THEN(DO) /* Annota che il file è del rilascio 2. */ CHGVAR VAR(&REL) VALUE('2') /* Salta a Fine controllo rilascio. */ GOTO CMDLBL(ENDREL) /* End. */ ENDDO /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Ridirige il controllo di livello per il rilascio 3. */ OVRDBF FILE(JFNCX3) TOFILE(&LIB/&FILE) SECURE(*YES) /* Apre il file come se si trattasse del rilascio 3. */ CALL PGM(JFNCOLD3) PARM(&LVLCHK1 &STS1) /* Se il file è del rilascio 3. */ IF COND(&LVLCHK1 *NE '1') THEN(DO) /* Annota che il file è del rilascio 3. */ CHGVAR VAR(&REL) VALUE('3') /* Salta a Fine controllo rilascio. */ GOTO CMDLBL(ENDREL) /* End. */ ENDDO /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/ /* Fine controllo rilascio. */ ENDREL: /* Se il file non è tra quelli previsti, ritorna subito. */ IF COND(&REL *EQ ' ') THEN(RETURN) /* Informa chiamante e video circa il test avvenuto. */ CHGVAR VAR(&MSG) VALUE('Conversione da rilascio ' + *CAT &REL *BCAT &FILE *TCAT '.' *CAT &LIB + *BCAT 'Old sts:' *CAT &STS1 *BCAT 'New + sts:' *CAT &STS) SNDPGMMSG MSG(&MSG) SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) + TOPGMQ(*EXT) MSGTYPE(*STATUS) /* Controlla l'esistenza del file rinominato. */ CHKOBJ OBJ(&LIB/(&FILE *TCAT '_§')) OBJTYPE(*FILE) /* Se il file rinominato esiste. */ DOBEG: MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(DOEND)) /* Annota la necessità di rinominare il file rinominato. */ SNDPGMMSG MSG('Rinomina il file ' *CAT &FILE *TCAT + '_§.' *CAT &LIB *BCAT 'se vuoi la + conversione!') /* Ritorna subito. */ RETURN /* End. */ DOEND: /* Rinomina il file. */ RNMOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) NEWOBJ(&FILE + *TCAT '_§') /* Crea il nuovo file. */ JCPYCLR FROMFILE(JFNCX) TOFILE(&LIB/&FILE) /* Rimuove gli indirizzamenti. */ DLTOVR FILE(*ALL) /* Se il file è del rilascio Z. */ IF COND(&REL *EQ 'Z') THEN(DO) /* Copia i dati dal file rinominato al nuovo. */ OVRDBF FILE(JFNCXZ) TOFILE(&LIB/(&FILE *TCAT '_§')) + SECURE(*YES) OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) CALL PGM(JFNCCVTZ) /* Salta a Fine copiatura. */ GOTO CMDLBL(ENDCPY) /* End. */ ENDDO /* Se il file è del rilascio 0. */ IF COND(&REL *EQ '0') THEN(DO) /* Copia i dati dal file rinominato al nuovo. */ OVRDBF FILE(JFNCX0) TOFILE(&LIB/(&FILE *TCAT '_§')) + SECURE(*YES) OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) CALL PGM(JFNCCVT0) /* Salta a Fine copiatura. */ GOTO CMDLBL(ENDCPY) /* End. */ ENDDO /* Se il file è del rilascio 1. */ IF COND(&REL *EQ '1') THEN(DO) /* Copia i dati dal file rinominato al nuovo. */ OVRDBF FILE(JFNCX1) TOFILE(&LIB/(&FILE *TCAT '_§')) + SECURE(*YES) OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) CALL PGM(JFNCCVT1) /* Salta a Fine copiatura. */ GOTO CMDLBL(ENDCPY) /* End. */ ENDDO /* Se il file è del rilascio 2. */ IF COND(&REL *EQ '2') THEN(DO) /* Copia i dati dal file rinominato al nuovo. */ OVRDBF FILE(JFNCX2) TOFILE(&LIB/(&FILE *TCAT '_§')) + SECURE(*YES) OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) CALL PGM(JFNCCVT2) /* End. */ ENDDO /* Se il file è del rilascio 3. */ IF COND(&REL *EQ '3') THEN(DO) /* Copia i dati dal file rinominato al nuovo. */ OVRDBF FILE(JFNCX3) TOFILE(&LIB/(&FILE *TCAT '_§')) + SECURE(*YES) OVRDBF FILE(JFNCX) TOFILE(&LIB/&FILE) SECURE(*YES) CALL PGM(JFNCCVT3) /* End. */ ENDDO /* Fine copiatura. */ ENDCPY: /* Cancella il file rinominato. */ DLTF FILE(&LIB/(&FILE *TCAT '_§')) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLDZ) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello collezione rilascio Z. * * RPG §FNCOLDZ. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCXZ UF E DISK A UC F §PRMAZNR KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCXZ * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL §PAZN C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLD0) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello collezione rilascio 0. * * RPG §FNCOLD0. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCX0 UF E DISK A UC F §KEYR KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCX0 * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL LLKEY C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLD1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello collezione rilascio 1. * * RPG §FNCOLD1. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCX1 UF E DISK A UC F U$COLRK KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCX1 * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL UNAME C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLD2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello collezione rilascio 2. * * RPG §FNCOLD2. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCX2 UF E DISK A UC F U1R KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCX2 * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL U1GRP C MOVEL*LOVAL U1FNC C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCOLD3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Controlla livello collezione rilascio 3. * * RPG §FNCOLD3. * * Apre il file e legge un record per provocare l'eventuale errore * di livello di controllo sul record. * L'errore viene governato dalla subroutine apposita. * FJFNCX3 UF E DISK A UC F U1R KRENAMERCD * File da controllare. F KINFSR SR * Routine di errore sul file. FIDS F KINFDS FIDS FIDS * File information data structure. FIDS IFIDS DS FIDS * File information data structure. FIDS I 11 15 FIDSST FIDS * Codice di stato. FIDS I B 397 4000FIDSRR FIDS * Relative record number in data member. C EJECT TAG /EJECT * Scambia parametri. C *ENTRY PLIST C PARM PERR 1 O Errore C PARM PSTS 5 O Stato * Predispone la chiusura del programma. C SETON LR * Assume file non in errore. C MOVEL*ZERO PERR * Apre il file. C OPEN JFNCX3 * Legge un record. C READ RCD 50 * Se il file è vuoto. C 50 DO * L'errore di livello non si manifesta. * Per stuzzicare l'errore cercato tenta perciò * la scrittura di un record con chiave assurda. C MOVEL*LOVAL U1GRP C MOVEL*LOVAL U1FNC C WRITERCD * Cancella il record appena aggiunto. C FIDSRR DELETRCD 50 * End. C END * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C SR BEGSR * Routine di errore sul file. *------------------------------------------------------------------- * Annota errore sul file. C MOVEL'1' PERR * Restituisce stato. C MOVELFIDSST PSTS * Ritorna. C RETRN C ENDSR //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCR) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* §FNCR - RICEVE MESSAGGI DIAGNOSTICI */ PGM RCVMSG PGMQ(*PRV) MSGTYPE(*DIAG) MONMSG MSGID(CPF0000) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCUSR) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Restituisce utente e altre informazioni. * * RPG §USER. * * Restituisce in PUSR il nome dell'utente al lavoro. * Restituisce in PJOB il nome del lavoro corrente. * PSDS H Y I PSDS PSDS * Per avere anno-mese-giorno del sistema. PSDS IPSDS SDS PSDS * Program status data structure. PSDS I 244 253 PSDSJB PSDS * Job name. PSDS I 254 263 PSDSUS PSDS * User. PSDS I 276 277 PSDSYY PSDS * System year. PSDS I 278 279 PSDSMM PSDS * System month. PSDS I 280 281 PSDSDD PSDS * System day. PSDS I 282 283 PSDSHH PSDS * System hour. PSDS I 284 285 PSDSPP PSDS * System minute. PSDS I 286 287 PSDSSS PSDS * System second. PSDS I 276 287 PSDSTT PSDS * System time. /EJECT C EJECT TAG * Scambia parametri. C *ENTRY PLIST C PARM PSDSUS PUSR 10 O Utente C PARM PSDSJB PJOB 10 O Lavoro * Predispone la chiusura del programma. C SETON LR * Ritorna al chiamante. C RETRN //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCX) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * * PF §FNC. * * Collezione di funzioni. * * Chiave unica * su gruppo, funzione. * A UNIQUE A R U1R TEXT('Collezione di funzioni.') A U1GRP 10 TEXT('Gruppo funzione.') A COLHDG('Gruppo') A U1FNC 10 TEXT('Funzione.') A COLHDG('Funzione') A U1GR2 10 TEXT('Gruppo funzione sostitutiva.') A COLHDG('Gruppo' 'sostit') A U1FN2 10 TEXT('Funzione sostitutiva.') A COLHDG('Funzione' 'sostit') A U1DES 50 TEXT('Descrizione funzione.') A COLHDG('Descrizione') A U1TYP 1 TEXT('Tipo funzione.') A COLHDG('Tipo') A U1ATR 1 TEXT('Attributo funzione.') A COLHDG('Attributo') A U1CMD 512 TEXT('Comando eseguibile.') A COLHDG('Comando') A U1HLM 10 TEXT('Membro testo di aiuto.') A COLHDG('Membro' 'aiuto') A U1MSG 80 TEXT('Messaggio di avvenuta + A esecuzione.') A COLHDG('Messaggio') A K U1GRP A K U1FNC //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCXZ) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * * PF §FNCOLD3. *(PF §PRMAZN.) * * Collezione funzioni rilascio 3. *(Parametro per azione architetturale.) * * Chiave unica su * azione, * riga. * * Contiene parametri per le azioni di architettura * che lo richiedono. * A UNIQUE A** REF(KFDZARCH.KLCSYS) A R §PRMAZNR TEXT('Parametro per + A azione architetturale.') A** §PAZN R REFFLD(KCDAZ) A §PAZN 4 A TEXT('Azione di architettura + A bisognosa di parametri.') A COLHDG('Azione') A §PRIG 3 A TEXT('Riga per più + A parametri nell''azione.') A COLHDG('Riga') A** §PJBU R REFFLD(KPJBU) A §PJBU 256 A TEXT('Parametro per l''azione.') A COLHDG('Parametro') A K §PAZN A K §PRIG //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCX0) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * * PF §FNCOLD0. *(PF §KEY.) * * Collezione funzioni rilascio 0. *(Comandi con chiave.) * A UNIQUE A R §KEYR TEXT('Comandi con chiave.') A LLKEY 10 TEXT('Chiave di identificazione + A del record.') A COLHDG('Chiave') A LLKEYS 10 TEXT('Chiave del record + A contenente il comando.') A COLHDG('Chiave sostituente') A LLCMD 400 TEXT('Comando pronto per + A l''esecuzione.') A COLHDG('Comando eseguibile') A LLMSG 80 TEXT('Messaggio di avvenuta + A esecuzione.') A COLHDG('Messaggio finale') A K LLKEY //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCX1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A********************************************************************** A* A* FILE FISICO - U$COL A* COLLEZIONE COMANDI E FUNZIONI DI SERVIZIO A* A********************************************************************** A R U$COLRK TEXT('FILE DI UTILITY') A UNAME 10 TEXT('NOME FUNZIONE') A COLHDG('Funzione') A UDESCR 40 TEXT('DESCR. FUNZIONE') A COLHDG('Descrizione') A UTYPE 1 TEXT('TIPO FUNZIONE') A COLHDG('Tipo') A UATTR 1 TEXT('ATTRIBUTI LANCIO') A COLHDG('Attributi') A UCMD 80 TEXT('COMANDO/STRINGA') A COLHDG('Stringa') A K UNAME //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCX2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * * PF §FNCOLD2. * * Collezione funzioni rilascio 2. * * Chiave unica * su gruppo, funzione. * A UNIQUE A R U1R TEXT('Collezione di funzioni.') A U1GRP 10 TEXT('Gruppo funzione.') A COLHDG('Gruppo') A U1FNC 10 TEXT('Funzione.') A COLHDG('Funzione') A U1DES 50 TEXT('Descrizione funzione.') A COLHDG('Descrizione') A U1TYP 1 TEXT('Tipo funzione.') A COLHDG('Tipo') A U1ATR 1 TEXT('Attributo funzione.') A COLHDG('Attributo') A U1CMD 512 TEXT('Comando eseguibile.') A COLHDG('Comando') A K U1GRP A K U1FNC //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JFNCX3) FILETYPE(*SRC) ENDCHAR('//ENDSRC') * * PF §FNCOLD3. * * Collezione funzioni rilascio 3. * * Chiave unica * su gruppo, funzione. * A UNIQUE A R U1R TEXT('Collezione di funzioni.') A U1GRP 10 TEXT('Gruppo funzione.') A COLHDG('Gruppo') A U1FNC 10 TEXT('Funzione.') A COLHDG('Funzione') A U1DES 50 TEXT('Descrizione funzione.') A COLHDG('Descrizione') A U1TYP 1 TEXT('Tipo funzione.') A COLHDG('Tipo') A U1ATR 1 TEXT('Attributo funzione.') A COLHDG('Attributo') A U1CMD 512 TEXT('Comando eseguibile.') A COLHDG('Comando') A U1HLM 10 TEXT('Membro testo di aiuto.') A COLHDG('Membro' 'aiuto') A K U1GRP A K U1FNC //ENDSRC //ENDBCHJOB