//BCHJOB JOB(JREFEXP) JOBD(NERONI2/NERONI2) OUTQ(QPRINT) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it */ /* LA JOB DESCRIPTION "NERONI2/NERONI2" DEVE PREESISTERE. PUO' ESSERE */ /* IDENTICA A QBATCH E PUO' ESSERE SOSTITUITA DA QBATCH O SIMILE. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2015-06-15 15:56 */ /* To File : "JREFEXP" */ /* To Library : "NERONI2" */ /* To Text : "Reference Explode. 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 "JREFEXP.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:\JREFEXP.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JREFEXP.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(JREFEXP) 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/JREFEXP" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JREFEXP) MBR(JREFEXP.) 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/JREFEXP) CRTSRCPF FILE(NERONI2/JREFEXP) RCDLEN(112) + TEXT('Reference Explode. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXP) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXP) + SRCTYPE(CMD) + TEXT('Reference Explode. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXP.) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXP.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXP.) + SRCTYPE(CL) + TEXT('Reference Explode. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXPP) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXPP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXPP) + SRCTYPE(PNLGRP) + TEXT('Reference Explode. Help') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXP1) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXP1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXP1) + SRCTYPE(CLLE) + TEXT('Reference Explode. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXP2) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXP2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXP2) + SRCTYPE(RPGLE) + TEXT('Reference Explode. Exe') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JREFEXP2_1) TOFILE(NERONI2/JREFEXP) + TOMBR(JREFEXP2_1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JREFEXP) MBR(JREFEXP2_1) + SRCTYPE(RPGLE) + TEXT('Reference Explode. Exe') /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Reference Explode. Cmd */ /* Claudio Neroni 15-04-2008 Creato. */ /* */ CMD PROMPT('Program reference Explode') PARM KWD(OBJ) TYPE(*NAME) MIN(1) PROMPT('Object + name') PARM KWD(OBJTYPE) TYPE(*CHAR) LEN(8) RSTD(*YES) + DFT(*PGM) VALUES(*PGM *DTAARA *FILE + *SRVPGM *ALL) PROMPT('Object type') PARM KWD(DEVELOP) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*ALL) VALUES(*ALL *PGM) + PROMPT('Development type') PARM KWD(TOLAST) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) PROMPT('To last + elements only') PARM KWD(SEEN) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*YES) VALUES(*YES *NO) + PROMPT('Already seen') PARM KWD(PGMATR) TYPE(*CHAR) LEN(2) SPCVAL((BA) + (CB) (CL) (DF) (QR) (RP)) MAX(20) + PROMPT('Program attribute') PARM KWD(OBJATR) TYPE(*CHAR) LEN(10) + SPCVAL((PRTF) (DSPF) (PF) (LF) (RPG) + (CLP) (RPGLE) (CLLE) (BLANK) (BLANKF) + (TAPF)) MAX(50) PROMPT('Object attribute') PARM KWD(MAXLVL) TYPE(*DEC) LEN(3 0) DFT(100) + RANGE(1 100) PROMPT('Max level') PARM KWD(INPUT) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) + PROMPT('Input use') PARM KWD(OUTPUT) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) + PROMPT('Output use') PARM KWD(UPDATE) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) + PROMPT('Update use') PARM KWD(UNKNOWN) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) + PROMPT('Unknown use') PARM KWD(DBREL) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) + PROMPT('Database relation use') PARM KWD(NOUSE) TYPE(*LGL) RSTD(*YES) DFT(*YES) + SPCVAL((*YES '1') (*NO '0')) PROMPT('No use') PARM KWD(DTALIB) TYPE(*NAME) LEN(10) DFT(REFALL) + SPCVAL((REFALL)) PROMPT('Data library') PARM KWD(OUTFILE) TYPE(OUTFILE) PROMPT('Output + File') OUTFILE: QUAL TYPE(*NAME) DFT(JREFDBFWT) QUAL TYPE(*NAME) DFT(QTEMP) MIN(0) PROMPT('library') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXP.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JREFEXP.) JOBD(NERONI2/NERONI2) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 26/04/2008 Creato. */ /* JREFEXP */ /* Reference Explode. */ /* Prerequisiti: JRSNMSG */ /* Prerequisiti: Creazione data base eseguito */ /* con la stringa "JREFDBF." */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JREFEXP) DLTPNLGRP PNLGRP(NERONI2/JREFEXPP) DLTPGM PGM(NERONI2/JREFEXP1) DLTPGM PGM(NERONI2/JREFEXP2) DLTF FILE(NERONI2/JREFEXPF) /* Crea gli oggetti. */ CRTPF FILE(NERONI2/JREFEXPF) SRCFILE(JREFEXP) SIZE(*NOMAX) CRTBNDCL PGM(NERONI2/JREFEXP1) SRCFILE(JREFEXP) TGTRLS(*CURRENT) + DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JREFEXP2) SRCFILE(JREFEXP) DBGVIEW(*ALL) + TGTRLS(*CURRENT) CRTPNLGRP PNLGRP(NERONI2/JREFEXPP) SRCFILE(JREFEXP) CRTCMD CMD(NERONI2/JREFEXP) PGM(JREFEXP1) SRCFILE(JREFEXP) + HLPPNLGRP(JREFEXPP) HLPID(CMD) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXPP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') :PNLGRP. .*--------------------------------------------------------------------- :HELP NAME=CMD. :H3.Comando JREFEXP :H2.Espode un programma elencando i programmi chiamati e gli oggetti usati. :P.Il comando permette di vedere e stampare un elenco annidato dei programmi chiamati in cascata dal programma di partenza. :P.I comandi :HP2.JREFEXP:EHP2. e :HP2.JREFIMP:EHP2. possono essere eseguiti solo dopo aver generato una libreria con il comando preparatorio :HP2.JREFDBF:EHP2. . La libreria di informazioni estratta dal comando :HP2.JREFDBF:EHP2. con il nome indicato nel parametro :HP2.DTALIB:EHP2. va comunicata ai comandi :HP2.JREFEXP:EHP2. e :HP2.JREFIMP:EHP2. tramite il parametro omonimo :HP2.DTALIB.:EHP2. :P.Si elencano le intestazioni di colonna della stampa. :XMP. Re = Indicatori di recursione F = Figlio già presente in lista chiamata G = Figlio già sviluppato Row = Numero progressivo di riga Level = Grafismo rappresentativo del livello di annidamento Father = Padre ovvero nome del chiamante dell'oggetto indicato sulla stessa riga come figlio Type = Tipo oggetto del padre Attrib = Attributo del padre Son = Figlio ovvero nome del chiamato dall'oggetto indicato sulla stessa riga come padre Type = Tipo oggetto del figlio Attrib = Attributo del figlio Usag = Uso del figlio all'interno del padre I = Input O = Output U = Update ? = Sconosciuto dbr = relazione proveniente dal Display Data Base Relation Text = Descrizione del figlio :EXMP. :NOTE.Il comando sopporta 100 livelli di annidamento ma si tratta di un limite arbitrario che può essere incrementato con una modesta manipolazione del sorgente RPGLE-JREFEXP2 (1: Variazione di una costante che determina il numero di elementi delle schiere di servizio della lista di chiamata 2: Schiera dei grafismi) e del sorgente CMD-JREFEXP (3: Aumento del range di valori per la keyword MAXLVL e del default) :ENOTE. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/obj'. :H3.Object name (OBJ) - Nome dell'oggetto :P.Nome dell'oggetto da cui parte l'esplosione. :P.Valori permessi: :PARML. :PT.nome-oggetto :PD.Il valore è obbligatorio. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/objtype'. :H3.Object type (OBJTYPE) - Tipo dell'oggetto :P.Tipo dell'oggetto da cui parte l'esplosione. :P.Valori permessi: :PARML. :PT.:PK DEF.*PGM:EPK. :PD.Programma. :PT.*DTAARA :PD.Area dati. :PT.*FILE :PD.File. :PT.*SRVPGM :PD.Programma di servizio. :PT.*ALL :PD.Tutti i tipi di oggetto. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/develop'. :H3.Development type (DEVELOP) :P.Definisce il tipo di sviluppo da stampare. :P.Con la scelta :HP1.DEVELOP(*ALL):EHP1. si ottiene la lista di tutti gli oggetti. Con la scelta :HP1.DEVELOP(*PGM):EHP1. si ottiene la lista dei soli programmi. :P.Valori permessi: :PARML. :PT.:PK DEF.*ALL:EPK. :PD.Lista tutti gli oggetti incontrati durante lo sviluppo. :PT.*PGM :PD.Lista solo i programmi incontrati durante lo sviluppo. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/tolast'. :H3.To last elements only (TOLAST) :P.Sceglie se stampare solo le righe degli oggetti senza altri oggetti dipendenti. :P.Valori permessi: :PARML. :PT.:PK DEF.*NO:EPK.€ :PD.Stampa solo gli ultimi oggetti. :PT.*YES :PD.Stampa tutti gli oggetti. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/seen'. :H3.Already seen (SEEN) :P.Sceglie se stampare le righe degli oggetti gia' visti. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/pgmatr'. :H3.Program attribute (PGMATR) :P.Il campo permette di scegliere quelle righe di emissione nelle quali il padre, per ora sempre un programma, ha un attributo che inizia con le due lettere qui indicate. Così se si vogliono i programmi :HP2.RPG, RPGLE o RPG38:EHP2. si richiede :HP2.RP:EHP2. . :NOTE.La lista di iniziali di attributi è solo un suggerimento, visto il numero elevato di attributi possibili. :ENOTE. :P.Valori permessi: qualunque coppia di caratteri alfabetici. :PARML. :PT.:PK DEF.lista vuota:EPK.€ :PD.Elenca tutti i programmi. :PT.BA :PD.Elenca i programmi il cui attributo inizia con BA, quindi i vari Basic. :PT.CB :PD.Elenca i programmi il cui attributo inizia con CB, quindi i vari Cobol. :PT.CL :PD.Elenca i programmi il cui tipo inizia con CL, quindi i vari Control Language. :PT.DF :PD.Elenca i programmi il cui tipo inizia con DF, quindi i vari Dfu. :PT.QR :PD.Elenca i programmi il cui tipo inizia con QR, quindi i vari Query. :PT.RP :PD.Elenca i programmi il cui tipo inizia con RP, quindi i vari RPG (Report Program Generator). :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/objatr'. :H3.Object attribute (OBJATR) :P.Il campo permette di scegliere quelle righe di emissione nelle quali il figlio ha un attributo che coincide con quello qui indicato. Così se si vogliono i programmi :HP2.RPGLE:EHP2. si richiede :HP2.RPGLE:EHP2. . :NOTE.La lista di attributi è solo un suggerimento, visto il numero elevato di attributi possibili. :ENOTE. :P.Valori permessi: qualunque gruppo di caratteri alfabetici. :PARML. :PT.:PK DEF.lista vuota:EPK.€ :PD.Elenca tutti gli oggetti. :PT.PRTF :PD.Elenca gli oggetti Printer File. :PT.DSPF :PD.Elenca gli oggetti Display File. :PT.PF :PD.Elenca gli oggetti Physical File. :PT.LF :PD.Elenca gli oggetti Logical File. :PT.RPG :PD.Elenca gli oggetti Report Program Generator. :PT.CLP :PD.Elenca gli oggetti Control Language Program. :PT.RPGLE :PD.Elenca gli oggetti Report Program Generator Integrated Language Environment. :PT.CLLE :PD.Elenca gli oggetti Control Language Integrated Language Environment. :PT.BLANK :PD.Elenca gli oggetti con Attributo in bianco. :PT.BLANKF :PD.Elenca gli oggetti con Attributo in bianco ma Tipo oggetto *FILE. :PT.TAPF :PD.Elenca gli oggetti Tape File. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/maxlvl'. :H3.Max level (MAXLVL) - Massimo livello :P.Numero del massimo livello da raggiungere nell'esplosione. :P.Valori permessi: :PARML. :PT.:PK DEF.100:EPK. :PD.Raggiunge il massimo livello permesso dal programma. :PT.Da 1 a 100 :PD.Raggiunge il livello richiesto come se gli oggetti al livello massimo richiesto non contenessero chiamate ad altri oggetti. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/input'. :H3.Input use (INPUT) :P.Sceglie se stampare le righe degli oggetti elaborati in immissione. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/output'. :H3.Output use (OUTPUT) :P.Sceglie se stampare le righe degli oggetti elaborati in emissione. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/update'. :H3.Update use (UPDATE) :P.Sceglie se stampare le righe degli oggetti elaborati in sovrascrittura (update). :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/unknown'. :H3.Unknown use (UNKNOWN) :P.Sceglie se stampare le righe degli oggetti elaborati in modo sconosciuto. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/dbrel'. :H3.Database relation use (DBREL) :P.Sceglie se stampare le righe degli oggetti elaborati tramite le relazioni di database. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/nouse'. :H3.No use (NOUSE) :P.Sceglie se stampare le righe degli oggetti senza alcuna indicazione di utilizzo. :P.Valori permessi: :PARML. :PT.:PK DEF.*YES:EPK.€ :PD.Compresi. :PT.*NO :PD.Esclusi. :EPARML. :EHELP. .*--------------------------------------------------------------------- :HELP name='CMD/dtalib'. :H3.Data library (DTALIB) :P.Libreria dati :P.Nome della libreria nella quale giacciono i dati da usare per l'esplosione e preparati con :HP2.JREFDBF:EHP2. . :P.Valori permessi: :PARML. :PT.:PK DEF.REFALL:EPK.€ :PD.I dati per l'esplosione vengono cercati nella libreria REFALL. :PT.nome-libreria :PD.Il nome della libreria dati. :EPARML. :EHELP. .*--------------------------------------------------------------------- :EPNLGRP. //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXP1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Reference Explode. Cpp */ /* Claudio Neroni 15/04/2008 Creato. */ /* */ PGM PARM(&OBJ &OBJTYPE &SVIL &TOLAST &SEEN + &PGMATR &OBJATR &MAXLVL &INPUT &OUTPUT + &UPDATE &UNKNOWN &DBREL &NOUSE &DTALIB + &OUTFQ) /* Riceve Nome dell'oggetto da esplodere. */ DCL VAR(&OBJ) TYPE(*CHAR) LEN(10) /* Riceve Tipo dell'oggetto da esplodere. */ DCL VAR(&OBJTYPE) TYPE(*CHAR) LEN(8) /* Riceve Tipo di sviluppo da eseguire. */ DCL VAR(&SVIL) TYPE(*CHAR) LEN(10) /* Riceve To last elements only. */ DCL VAR(&TOLAST) TYPE(*CHAR) LEN(10) /* Riceve Already seen. */ DCL VAR(&SEEN) TYPE(*CHAR) LEN(10) /* Riceve Param Attributi programma da considerare 2bin + 20el*2char. */ DCL VAR(&PGMATR) TYPE(*CHAR) LEN(42) /* Riceve Param Attributi oggetto da considerare 2bin + 50el*10char. */ DCL VAR(&OBJATR) TYPE(*CHAR) LEN(502) /* Riceve Nome sistema. */ DCL VAR(&SYSNAME) TYPE(*CHAR) LEN(8) /* Riceve Massimo livello. */ DCL VAR(&MAXLVL) TYPE(*DEC) LEN(3 0) /* Riceve Uso Input. */ DCL VAR(&INPUT) TYPE(*LGL) /* Riceve Uso Output. */ DCL VAR(&OUTPUT) TYPE(*LGL) /* Riceve Uso Update. */ DCL VAR(&UPDATE) TYPE(*LGL) /* Riceve Uso Sconosciuto. */ DCL VAR(&UNKNOWN) TYPE(*LGL) /* Riceve Uso Relazione di database. */ DCL VAR(&DBREL) TYPE(*LGL) /* Riceve Uso Nessuno. */ DCL VAR(&NOUSE) TYPE(*LGL) /* Riceve Nome della libreria dei dati di servizio. */ DCL VAR(&DTALIB) TYPE(*CHAR) LEN(10) /* Riceve Nome qualificato del file di output. */ DCL VAR(&OUTFQ) TYPE(*CHAR) LEN(20) /* File di output. Nome. */ DCL VAR(&OUTF) TYPE(*CHAR) LEN(10) /* File di output. Libreria. */ DCL VAR(&OUTFLIB) TYPE(*CHAR) LEN(10) /* Utente corrente. */ DCL VAR(&CURUSER) TYPE(*CHAR) LEN(10) /* To directory. */ DCL VAR(&TODIR) TYPE(*CHAR) LEN(50) /* Prenotazione del CPF0001. */ DCL VAR(&CPF0001) TYPE(*LGL) /* Intercetta gli errori. */ MONMSG MSGID(CPF0000 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Estrae parametri. */ CHGVAR VAR(&OUTF) VALUE(%SST(&OUTFQ 1 10)) CHGVAR VAR(&OUTFLIB) VALUE(%SST(&OUTFQ 11 10)) /* Recupera Nome sistema. */ RTVNETA SYSNAME(&SYSNAME) /* Recupera Utente corrente. */ RTVJOBA CURUSER(&CURUSER) /* Compone To Directory. */ CHGVAR VAR(&TODIR) VALUE('/webufhtml/' *CAT + &CURUSER *TCAT '/XX') /* Testa l'esistenza della libreria dati. */ CHKOBJ OBJ(&DTALIB) OBJTYPE(*LIB) /* Testa l'esistenza dei file dati. */ CHKOBJ OBJ(&DTALIB/JREFDBFF1) OBJTYPE(*FILE) CHKOBJ OBJ(&DTALIB/JREFDBFD1) OBJTYPE(*FILE) /* Crea outfile in libreria richiesta. */ JCPYCLR FROMFILE(JREFDBFW) TOFILE(&OUTFLIB/&OUTF) /* Reindirizza outfile. */ OVRDBF FILE(JREFDBFW) TOFILE(&OUTFLIB/&OUTF) /* Reindirizza i file di servizio alla libreria dei dati di servizio. */ OVRDBF FILE(JREFDBFF1) TOFILE(&DTALIB/JREFDBFF1) OVRDBF FILE(JREFDBFD1) TOFILE(&DTALIB/JREFDBFD1) /* Reindirizza la stampa. */ OVRPRTF FILE(QSYSPRT) USRDTA(&OBJ) SPLFNAME(JREFEXP) /* Esegue lo sviluppo. */ CALL PGM(JREFEXP2) PARM(&OBJ &OBJTYPE &SVIL + &TOLAST &SEEN &PGMATR &OBJATR &SYSNAME + &MAXLVL &INPUT &OUTPUT &UPDATE &UNKNOWN + &DBREL &NOUSE &DTALIB) DLTOVR FILE(*ALL) /* Visualizza la stampa. */ DSPSPLF FILE(JREFEXP) SPLNBR(*LAST) MONMSG MSGID(CPF0000 MCH0000) /* Invita a visualizzare l'outfile. */ JRQS CMD(RUNQRY QRYFILE((&OUTFLIB/&OUTF)) + RCDSLT(*YES)) MONMSG MSGID(CPF0000 MCH0000) /* Invita a scaricare l'outfile. */ JRQS CMD(JTOCSV FROMFILE(&OUTFLIB/&OUTF) + TODIR(&TODIR)) MONMSG MSGID(CPF0000 MCH0000) /* Label di esecuzione delle 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(JREFEXP) + MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Label di errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Label di prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta alle attività finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXP2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *EXP /TITLE Reference Explode. Exe *IMP **/TITLE Reference Implode. Exe * Claudio Neroni 14-04-2008 Creato. * Per ottenere la versione IMPLODE, * asteriscare le specifice "*EXP" e * disasteriscare le specifice "*IMP". *--------------------------------------------------------------------------------------------- * Definito un ambiente come un insieme di librerie di dati * e delle librerie dei relativi programmi: * 1) Riceve il Display Program Reference di tutti i programmi * di un ambiente. * 2) Riceve il Display Object Description di tutti gli oggetti * dello stesso ambiente. * 3) Riceve il nome di un programma da esplodere in tutti i programmi * e in tutti gli oggetti chiamati. * 4) Riceve il tipo di sviluppo da eseguire. * *ALL=Elenca tutti gli oggetti * *PGM=Elenca solo i programmi * Restituisce una lista contenente l'esplosione richiesta. *--------------------------------------------------------------------------------------------- H decedit('0,') datfmt(*dmy/) datedit(*dmy/) *--------------------------------------------------------------------------------------------- * File di emissione di DSPPGMREF ristrutturato. *EXP Fjrefdbff1 if e k disk *IMP F**jrefdbff2 if e k disk * File di emissione di DSPOBJD. Fjrefdbfd1 if e k disk * Outfile esplosione. Fjrefdbfw o e disk * Stampa. Fqsysprt o f 132 printer oflind(*inof) *--------------------------------------------------------------------------------------------- * Scaletta di annidamento. D sca s 12 dim(max) ctdata perrcd(1) * Decodifica uso. D usg s 2 0 dim(17) ctdata perrcd(1) D usgd s 4 dim(17) alt(usg) *--------------------------------------------------------------------------------------------- * Numero massimo di programmi in lista di chiamata. D max c 100 * Lista di chiamata. D lds ds D l 36 dim(max) * Chiamante + Tipo dell'oggetto chiamante. D lpa 18 overlay(l:1) * Chiamante. D lpan 10 overlay(l:1) * Tipo dell'oggetto chiamante. D lpat 8 overlay(l:11) * Chiamato + Tipo dell'oggetto chiamato. D lfi 18 overlay(l:19) * Chiamato. D lfin 10 overlay(l:19) * Tipo dell'oggetto chiamato. D lfit 8 overlay(l:29) * Chiamato + Tipo. Search word. D reffiw s like(lfi) *--------------------------------------------------------------------------------------------- * Programmi già sviluppati. D lpags s 18 dim(10000) * Indice di riempimento dei Programmi già sviluppati. D ip s 7 0 D ip0 s like(ip) D ips s like(ip) *--------------------------------------------------------------------------------------------- * Numero massimo di elementi Attributo programma. D maxqa c 20 * Spezza la simple list del parametro Attributo programma. D pppgmatr ds D qan 1 2b 0 D qa 2 dim(maxqa) * Numero massimo di elementi Attributo oggetto. D maxoa c 50 * Spezza la simple list del parametro Attributo oggetto. D ppobjatr ds D oan 1 2b 0 D oa 10 dim(maxoa) *--------------------------------------------------------------------------------------------- * Doppioni dei parametri. D qax s like(qa) dim(maxqa) D oax s like(oa) dim(maxoa) *--------------------------------------------------------------------------------------------- * Comando di chiamata. D cmd ds D cmdel 130 dim(10) *--------------------------------------------------------------------------------------------- * Trattini. D tra s 132 inz(*all'-') *--------------------------------------------------------------------------------------------- * Campi della riga di emissione. D outds e ds extname(jrefdbfw) inz * Campi della riga di emissione. Precedente. D outpre e ds extname(jrefdbfw) prefix(pre) inz * Campi della riga di emissione. Stampa. D outprt e ds extname(jrefdbfw) prefix(prt) inz * Accorcia i campi per la stampa. D prtoutfitz 7 overlay(prtoutfit) D prtoutfiaz 6 overlay(prtoutfia) D prtoutpatz 7 overlay(prtoutpat) D prtoutpaaz 6 overlay(prtoutpaa) * Campi della riga di emissione. Ultimo stampato. D outult e ds extname(jrefdbfw) prefix(ult) inz D outulz e ds extname(jrefdbfw) prefix(ulz) inz *--------------------------------------------------------------------------------------------- *IMP * Rovescia padre e figlio per sfruttare il programma senza altre modifiche. *IMP I**ref *IMP I** REFPAN REFFIN *IMP I** REFPAT REFFIT *IMP I** REFPAA REFFIA *IMP I** REFPAL REFFIL *IMP I** REFPAX REFFIX *IMP I** REFFIN REFPAN *IMP I** REFFIT REFPAT *IMP I** REFFIA REFPAA *IMP I** REFFIL REFPAL *IMP I** REFFIX REFPAX *IMP *--------------------------------------------------------------------------------------------- * Predispone chiusura. C seton lr * Scambia parametri. C *entry plist * Riceve Nome dell'oggetto da esplodere. C parm pppan 10 * Riceve Tipo dell'oggetto da esplodere. C parm pppat 8 * Riceve Sviluppo. * *ALL=Elenca tutti gli oggetti * *PGM=Elenca solo i programmi C parm ppsvil 10 * Riceve To last elements only. * *NO =Elenca tutti gli oggetti * *YES=Elenca solo gli oggetti senza ulteriori componenti. C parm pptola 10 * Riceve Already seen. * *YES=Elenca anche le righe segnate con G=Già viste. * *NO =Non elenca le righe segnate con G=Già viste. C parm ppseen 10 * Riceve Attributo programma. C parm pppgmatr * Riceve Attributo oggetto. * Blank =Elenca tutti gli oggetti * NonBlank=Elenca solo gli oggetti con l'attributo richiesto. C parm ppobjatr * Riceve Nome del sistema. C parm ppsnam 8 * Riceve Massimo livello. C parm ppmaxl 3 0 * Riceve Uso Input. C parm ppinput 1 * Riceve Uso Output. C parm ppoutput 1 * Riceve Uso Update. C parm ppupdate 1 * Riceve Uso Sconosciuto. C parm ppunknown 1 * Riceve Uso Relazione di database. C parm ppdbrel 1 * Riceve Uso Nessuno. C parm ppnouse 1 * Riceve Libreria dati. C parm ppdtali 10 * Trascrive i parametri a numero di elementi variabili nei doppioni. C clear qax C *like define qan px C do qan px B01 C movel(p) qa(px) qax(px) 01 C enddo E01 C clear oax C do oan px B01 C movel(p) oa(px) oax(px) 01 C enddo E01 * Compone il comando ricevuto per stamparlo. C clear cmd *EXP C eval cmd='JREFEXP OBJ(' + *IMP C** eval cmd='JREFIMP OBJ(' + C %trim(pppan ) + C ') OBJTYPE(' + C %trim(pppat ) + C ') DEVELOP(' + C %trim(ppsvil) + C ') TOLAST(' + C %trim(pptola) + C ') SEEN(' + C %trim(ppseen) + C ') PGMATR(' C do qan px B01 C if px=1 B02 C eval cmd= %trim(cmd) + 02 C %trim(qax(px)) 02 C else X02 C eval cmd= %trim(cmd) + 02 C ' ' + 02 C %trim(qax(px)) 02 C endif E02 C enddo E01 C eval cmd= %trim(cmd) + C ') OBJATR(' C do oan px B01 C if px=1 B02 C eval cmd= %trim(cmd) + 02 C %trim(oax(px)) 02 C else X02 C eval cmd= %trim(cmd) + 02 C ' ' + 02 C %trim(oax(px)) 02 C endif E02 C enddo E01 C eval cmd= %trim(cmd) + C ') MAXLVL(' + C %trim(%editc(ppmaxl:'Z')) + C ')' * Uso. C if ppinput = *off B01 C eval cmd= %trim(cmd) + ' INPUT(*NO)' 01 C endif E01 C if ppoutput = *off B01 C eval cmd= %trim(cmd) + ' OUTPUT(*NO)' 01 C endif E01 C if ppupdate = *off B01 C eval cmd= %trim(cmd) + ' UPDATE(*NO)' 01 C endif E01 C if ppunknown = *off B01 C eval cmd= %trim(cmd) + ' UNKNOWN(*NO)' 01 C endif E01 C if ppdbrel = *off B01 C eval cmd= %trim(cmd) + ' DBREL(*NO)' 01 C endif E01 C if ppnouse = *off B01 C eval cmd= %trim(cmd) + ' NOUSE(*NO)' 01 C endif E01 * Libreria dati. C eval cmd= %trim(cmd) + C ' DTALIB(' + C %trim(ppdtali) + C ')' * Stampa l'intestazione della prima pagina. C except int1 C do 10 ix 3 0 B01 C if cmdel(ix)<>*blank B02 C except int2 02 C endif E02 C enddo E01 C except int3 * Chiave di ricerca degli oggetti chiamati da un programma. C k1a klist * Usante. C kfld lpan(xx) * Tipo usante. C kfld lpat(xx) * Chiave di riposizionamento. C k1b klist * Usante. C kfld lpan(xx) * Tipo usante. C kfld lpat(xx) * Usato. C kfld lfin(xx) * Tipo usato. C kfld lfit(xx) * Pulisce la lista di chiamata. C clear lpan C clear lpat C clear lfin C clear lfit * STAMPA LA PRIMA RIGA. INIZIO * Assume il programma richiesto nella prima emissione. C clear xx C clear refpan C clear refpat C movel(p) pppan reffin C movel(p) pppat reffit * Decodifica il programma richiesto. C kd1 klist C kfld pppan C kfld pppat C kd1 chain jrefdbfd1 C if %found B01 C movel(p) odobat reffia 01 C movel(p) odobtx reffix 01 C else X01 C movel(p) *all'?' reffia 01 C movel(p) *all'?' reffix 01 C endif E01 * Emette il dettaglio del programma di partenza. C exsr outsave * Trascrive la riga ricevuta nei campi di stampa. C movel(p) outds outprt * Emette la riga scelta in stampa. C exsr outprint * Trascrive la riga ricevuta nei campi precedenti. C movel(p) outds outpre * STAMPA LA PRIMA RIGA. FINE * Annota il programma di partenza nella prima posizione lista. C z-add 1 xx 3 0 C movel(p) pppan lpan(1) C movel(p) pppat lpat(1) C clear lfin(1) C clear lfit(1) * Si posiziona all'inizio degli oggetti usati dal pgm di partenza. C k1a setll ref * Balla sulla lista di chiamata. C do *hival B01 * Se l'indice è zero, abbandona. C if xx<=*zero B02 C leave 02 C endif E02 * Legge il prossimo oggetto usato dal prgm corrente. C k1a reade ref 01 * Se gli oggetti chiamati sono finiti. C if %eof B02 * Pulisce la posizione corrente della lista di chiamata. C clear lpan(xx) 02 C clear lpat(xx) 02 C clear lfin(xx) 02 C clear lfit(xx) 02 * Arretra l'indice corrente sulla lista di chiamata. C eval xx=xx-1 02 * Se l'indice è zero, abbandona. C if xx<=*zero B03 C leave 03 C endif E03 * Si riposiziona oltre l'ultima lettura per l'indice corrente. C k1b setgt ref 02 * Ricicla. C iter 02 * Se gli oggetti chiamati sono finiti. C endif E02 * Chiave di scavalco gruppo. C k1s klist 01 * Usante. C kfld refpan 01 * Tipo usante. C kfld refpat 01 * Usato. C kfld reffin 01 * Tipo usato. C kfld reffit 01 * Scavalca il gruppo di record uguali all'ultimo letto. C k1s setgt ref 01 * Legge l'ultimo record del gruppo. C k1s readpe ref h2 01 C h2 return 01 * Assume recursioni assenti. C setoff 5153 01 * Compone Chiamato + Tipo. C eval reffiw = reffin + reffit 01 * Annota la recursione se l'usato corrente è presente in lista usanti. C reffiw lookup lfi 51 01 * Se sono già stati sviluppati programmi. C if ip < ip0 B02 * Se il pgm è già stato sviluppato, annota recursione. C eval ips = ip 02 C reffiw lookup lpags(ips) 53 02 * Se sono già stati sviluppati programmi. C endif E02 * Trascrive l'usato corrente nella lista di chiamata. C eval lpan(xx)=refpan 01 C eval lpat(xx)=refpat 01 C eval lfin(xx)=reffin 01 C eval lfit(xx)=reffit 01 * Annota il pgm nell'elenco dei pgm già sviluppati. C if 1=1 B02 * Assume scrittura in elenco necessaria. C setoff 50 02 * Se sono già stati sviluppati programmi * e il pgm è già annotato, toglie consenso. C if ip < ip0 B03 C eval ips = ip 03 C reffiw lookup lpags(ips) 50 03 C endif E03 * Se scrittura in elenco necessaria, * annota il pgm nell'elenco dei pgm già sviluppati. C if not *in50 B03 C sub 1 ip 03 C eval lpags(ip)=reffiw 03 C endif E03 * Annota il pgm nell'elenco dei pgm già sviluppati. C endif E02 * Se lo sviluppo è tutti e l'usato corrente è valorizzato, * o se lo sviluppo è pgm e l'usato corrente è pgm. C if ppsvil='*ALL' B02 C and lfin(xx)<>*blank 02 C or ppsvil='*PGM' 02 C and lfit(xx)='*PGM' 02 * Se l'usato corrente è diverso dall'ultimo emesso. C if refpan <> preoutpan B03 C or refpat <> preoutpat 03 C or reffin <> preoutfin 03 C or reffit <> preoutfit 03 * Costruisce un attributo oggetto di comodo per la ricerca. C eval reffiaw = reffia 03 C *like define reffia reffiaw 03 C if reffia = *blank B04 C eval reffiaw = 'BLANK' 04 C if reffit = '*FILE' B05 C and %lookup('BLANKF':oax:1:oan) > *zero 05 C eval reffiaw = 'BLANKF' 05 C endif E05 C endif E04 * Se l'attributo oggetto corrente soddisfa la richiesta. C if oan = *zero B04 C or oan > *zero 04 C and %lookup(reffiaw:oax:1:oan) 04 C > *zero 04 * Se l'attributo programma corrente soddisfa la richiesta. C if qan = *zero B05 C or qan > *zero 05 C and %lookup(%subst(refpaa:1:2):qax:1:qan) 05 C > *zero 05 * Decodifica uso. C z-add 1 ux 3 0 05 C refuso lookup usg(ux) 50 05 C n50 movel *all'?' refusod 05 C 50 movel(p) usgd(ux) refusod 05 C *like define usgd refusod 05 * Se l'uso corrente soddisfa la richiesta. C if %subst(refusod:1:1) = 'I' B06 C and ppinput = *on 06 C or %subst(refusod:2:1) = 'O' 06 C and ppoutput = *on 06 C or %subst(refusod:3:1) = 'U' 06 C and ppupdate = *on 06 C or %subst(refusod:4:1) = '?' 06 C and ppunknown = *on 06 C or %subst(refusod:1:3) = 'dbr' 06 C and ppdbrel = *on 06 C or %subst(refusod:1:4) = '....' 06 C and ppnouse = *on 06 * LA RIGA E' DA STAMPARE. INIZIO * Trascrive i dati della riga in una struttura dati. C exsr outsave 06 * Se richieste materie prime e se non aumenta livello. C if pptola = '*YES' B07 C and outian <= preoutian 07 * Trascrive la riga precedente nei campi di stampa. C movel(p) outpre outprt 07 * Emette la riga scelta. C exsr outprint 07 * Se richieste materie prime e se non aumenta livello. C endif E07 * Se non richieste materie prime. C if pptola <> '*YES' B07 * Trascrive la riga ricevuta nei campi di stampa. C movel(p) outds outprt 07 * Emette la riga scelta. C exsr outprint 07 * Se non richieste materie prime. C endif E07 * Trascrive la riga ricevuta nei campi precedenti. C movel(p) outds outpre 06 * LA RIGA E' DA STAMPARE. FINE * Se l'uso corrente soddisfa la richiesta. C endif E06 * Se l'attributo programma corrente soddisfa la richiesta. C endif E05 * Se l'attributo oggetto corrente soddisfa la richiesta. C endif E04 * Se l'usato corrente è diverso dall'ultimo emesso. C endif E03 * Se corre recursione. C if *in51 B03 * Pulisce l'elemento corrente dalla lista di chiamata. C clear lpan(xx) 03 C clear lpat(xx) 03 C clear lfin(xx) 03 C clear lfit(xx) 03 * Arretra l'indice corrente sulla lista di chiamata. C eval xx=xx-1 03 * Se l'indice è zero, abbandona. C if xx<=*zero B04 C leave 04 C endif E04 * Si riposiziona oltre l'ultima lettura per l'indice corrente. C k1b setgt ref 03 * Ricicla. C iter 03 * Se corre recursione. C endif E03 * Se lo sviluppo è tutti e l'usato corrente è valorizzato, * o se lo sviluppo è pgm e l'usato corrente è pgm. C endif E02 * Se l'elemento corrente non è già sviluppato * e se l'indice corrente è minore del massimo. C if not *in53 B02 C and xx < ppmaxl 02 * Incrementa l'indice corrente sulla lista di chiamata. C eval xx=xx+1 02 * Annota il programma nella posizione corrente della lista. C eval lpan(xx)=reffin 02 C eval lpat(xx)=reffit 02 C clear lfin(xx) 02 C clear lfit(xx) 02 * Si posiziona all'inizio degli oggetti usati dal pgm corrente. C k1a setll ref 02 * Se l'elemento corrente non è già sviluppato * e se l'indice corrente è minore o uguale al massimo. C endif E02 * Balla sulla lista di chiamata. C enddo E01 * Stampa fine. C except eop *--------------------------------------------------------------------------------------------- * Trascrive i dati della riga in una struttura dati. C outsave begsr * Pulisce i dati della riga. C clear outds * Numera la riga. C add 1 cnt * Riempie i campi della iga. C 51 movel(p) 'F' outrcs C 53 movel(p) 'G' outgia C z-add cnt outcnt C z-add xx outian C if xx = *zero B01 C movel(p) '|0' outiand 01 C else X01 C movel(p) sca(xx) outiand 01 C endif E01 C movel(p) refpan outpan C movel(p) refpat outpat C movel(p) refpaa outpaa C movel(p) reffin outfin C movel(p) reffit outfit C movel(p) reffia outfia C z-add refuso outuso C movel(p) refusod outusod C movel(p) reffix outfix C endsr *--------------------------------------------------------------------------------------------- * Stampa la riga su stampa. C outprint begsr * Emette la riga in outfile. C exsr outfile * Se sono richieste anche le righe già viste * o se la riga non è già vista. C if ppseen = '*YES' B01 C or prtoutgia = *blank 01 * Salva i dati ricevuti in un comodo. C movel(p) outprt outulz 01 * Se non corre la prima riga, * annota usante e tipo usante uguale a precedente. C if prtoutcnt <> 1 B02 C and prtoutpan = ultoutpan 02 C and prtoutpat = ultoutpat 02 C and prtoutpaa = ultoutpaa 02 C movel(p) '"' prtoutpan 02 C movel(p) '"' prtoutpat 02 C movel(p) '"' prtoutpaa 02 C endif E02 * Se overflow, stampa l'intestazione delle pagine * successive alla prima. C if *inof B02 C except int1 02 C except int3 02 C endif E02 * Stampa la riga. C except outrow 01 * Salva i dati ricevuti nell'ultimo stampato. C movel(p) outulz outult 01 * Se sono richieste anche le righe già viste * o se la riga non è già vista. C endif E01 C endsr *--------------------------------------------------------------------------------------------- * Emette la riga in outfile. C outfile begsr * Trascrive la lista di chiamata in outfile. C eval out001 = lpa(001) C eval out002 = lpa(002) C eval out003 = lpa(003) C eval out004 = lpa(004) C eval out005 = lpa(005) C eval out006 = lpa(006) C eval out007 = lpa(007) C eval out008 = lpa(008) C eval out009 = lpa(009) C eval out010 = lpa(010) C eval out011 = lpa(011) C eval out012 = lpa(012) C eval out013 = lpa(013) C eval out014 = lpa(014) C eval out015 = lpa(015) C eval out016 = lpa(016) C eval out017 = lpa(017) C eval out018 = lpa(018) C eval out019 = lpa(019) C eval out020 = lpa(020) C eval out021 = lpa(021) C eval out022 = lpa(022) C eval out023 = lpa(023) C eval out024 = lpa(024) C eval out025 = lpa(025) C eval out026 = lpa(026) C eval out027 = lpa(027) C eval out028 = lpa(028) C eval out029 = lpa(029) C eval out030 = lpa(030) C eval out031 = lpa(031) C eval out032 = lpa(032) C eval out033 = lpa(033) C eval out034 = lpa(034) C eval out035 = lpa(035) C eval out036 = lpa(036) C eval out037 = lpa(037) C eval out038 = lpa(038) C eval out039 = lpa(039) C eval out040 = lpa(040) C eval out041 = lpa(041) C eval out042 = lpa(042) C eval out043 = lpa(043) C eval out044 = lpa(044) C eval out045 = lpa(045) C eval out046 = lpa(046) C eval out047 = lpa(047) C eval out048 = lpa(048) C eval out049 = lpa(049) C eval out050 = lpa(050) C eval out051 = lpa(051) C eval out052 = lpa(052) C eval out053 = lpa(053) C eval out054 = lpa(054) C eval out055 = lpa(055) C eval out056 = lpa(056) C eval out057 = lpa(057) C eval out058 = lpa(058) C eval out059 = lpa(059) C eval out060 = lpa(060) C eval out061 = lpa(061) C eval out062 = lpa(062) C eval out063 = lpa(063) C eval out064 = lpa(064) C eval out065 = lpa(065) C eval out066 = lpa(066) C eval out067 = lpa(067) C eval out068 = lpa(068) C eval out069 = lpa(069) C eval out070 = lpa(070) C eval out071 = lpa(071) C eval out072 = lpa(072) C eval out073 = lpa(073) C eval out074 = lpa(074) C eval out075 = lpa(075) C eval out076 = lpa(076) C eval out077 = lpa(077) C eval out078 = lpa(078) C eval out079 = lpa(079) C eval out080 = lpa(080) C eval out081 = lpa(081) C eval out082 = lpa(082) C eval out083 = lpa(083) C eval out084 = lpa(084) C eval out085 = lpa(085) C eval out086 = lpa(086) C eval out087 = lpa(087) C eval out088 = lpa(088) C eval out089 = lpa(089) C eval out090 = lpa(090) C eval out091 = lpa(091) C eval out092 = lpa(092) C eval out093 = lpa(093) C eval out094 = lpa(094) C eval out095 = lpa(095) C eval out096 = lpa(096) C eval out097 = lpa(097) C eval out098 = lpa(098) C eval out099 = lpa(099) C eval out100 = lpa(100) C write out C endsr *--------------------------------------------------------------------------------------------- * Inizializza. C *inzsr begsr * Annota il numero di elementi dei pgm già sviluppati. C eval ip0=%elem(lpags)+1 C eval ip =ip0 * Azzera il contatore righe. C clear cnt 6 0 * Time. C time time 6 0 C endsr *--------------------------------------------------------------------------------------------- * Intestazione. Oqsysprt e int1 2 1 O e int2 1 O cmdel(ix) O e int3 1 O 97 'SysName:' O ppsnam +1 O *date y 120 O time +2 '0 : : ' O e int3 1 O 'Re' O 8 'Row' O 10 'L' O 'evel' *EXP O 23 'F' *EXP O 'ather' *IMP O** 23 'S' *IMP O** 'on' O 34 'T' O 'ype' O 42 'A' O 'ttrib' *EXP O 49 'S' *EXP O 'on' *IMP O** 49 'F' *IMP O** 'ather' O 60 'T' O 'ype' O 68 'A' O 'ttrib' O 75 'U' O 'sag' O 80 'T' O 'ext' O e int3 1 O tra * Dettaglio esplosione ritardato. O e outrow 1 O prtoutrcs O prtoutgia O prtoutcnt 3 O prtoutiand +1 O prtoutpan +1 O prtoutpatz +1 O prtoutpaaz +1 O prtoutfin +1 O prtoutfitz +1 O prtoutfiaz +1 O prtoutusod +1 O prtoutfix +1 O********************** prtoutian +1 * Fine stampa. O e eop 1 O '*** End of print ***' *--------------------------------------------------------------------------------------------- ** Scaletta di annidamento. | 1 | .2 | ..3 | ...4 | ....5 | .....6 | ......7 | .......8 | ........9 | ........10 |11 | 12 | .13 | ..14 | ...15 | ....16 | .....17 | ......18 | .......19 | ........20 |21 | 22 | .23 | ..24 | ...25 | ....26 | .....27 | ......28 | .......29 | ........20 |31 | 32 | .33 | ..34 | ...35 | ....36 | .....37 | ......38 | .......39 | ........40 |41 | 42 | .43 | ..44 | ...45 | ....46 | .....47 | ......48 | .......49 | ........50 |51 | 52 | .53 | ..54 | ...55 | ....56 | .....57 | ......58 | .......59 | ........60 |61 | 62 | .63 | ..64 | ...65 | ....66 | .....67 | ......68 | .......69 | ........70 |71 | 72 | .73 | ..74 | ...75 | ....76 | .....77 | ......78 | .......79 | ........80 |81 | 82 | .83 | ..84 | ...85 | ....86 | .....87 | ......88 | .......89 | ........90 |91 | 92 | .93 | ..94 | ...95 | ....96 | .....97 | ......98 | .......99 | .......100 ** Decodifica uso. 00.... 01I... 02.O.. 03IO.. 04..U. 05I.U. 06.OU. 07IOU. 08...? 09I..? 10.O.? 11IO.? 12..U? 13I.U? 14.OU? 15IOU? 90dbr //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JREFEXP2_1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *EXP /TITLE Reference Explode. Exe *IMP **/TITLE Reference Implode. Exe * Claudio Neroni 14-04-2008 Creato. * Per ottenere la versione IMPLODE, * asteriscare le specifice "*EXP" e * disasteriscare le specifice "*IMP". *--------------------------------------------------------------------------------------------- * Definito un ambiente come un insieme di librerie di dati * e delle librerie dei relativi programmi: * 1) Riceve il Display Program Reference di tutti i programmi * di un ambiente. * 2) Riceve il Display Object Description di tutti gli oggetti * dello stesso ambiente. * 3) Riceve il nome di un programma da esplodere in tutti i programmi * e in tutti gli oggetti chiamati. * 4) Riceve il tipo di sviluppo da eseguire. * *ALL=Elenca tutti gli oggetti * *PGM=Elenca solo i programmi * Restituisce una lista contenente l'esplosione richiesta. *--------------------------------------------------------------------------------------------- H decedit('0,') datfmt(*dmy/) datedit(*dmy/) *--------------------------------------------------------------------------------------------- * File di emissione di DSPPGMREF ristrutturato. *EXP Fjrefdbff1 if e k disk *IMP F**jrefdbff2 if e k disk * File di emissione di DSPOBJD. Fjrefdbfd1 if e k disk * Outfile esplosione. Fjrefdbfw o e disk * Stampa. Fqsysprt o f 132 printer oflind(*inof) *--------------------------------------------------------------------------------------------- * Scaletta di annidamento. D sca s 11 dim(max) ctdata perrcd(1) * Decodifica uso. D usg s 2 0 dim(17) ctdata perrcd(1) D usgd s 4 dim(17) alt(usg) *--------------------------------------------------------------------------------------------- * Numero massimo di programmi in lista di chiamata. D max c 100 * Lista di chiamata. D lds ds D l 36 dim(max) * Chiamante + Tipo dell'oggetto chiamante. D lpa 18 overlay(l:1) * Chiamante. D lpan 10 overlay(l:1) * Tipo dell'oggetto chiamante. D lpat 8 overlay(l:11) * Chiamato + Tipo dell'oggetto chiamato. D lfi 18 overlay(l:19) * Chiamato. D lfin 10 overlay(l:19) * Tipo dell'oggetto chiamato. D lfit 8 overlay(l:29) * Chiamato + Tipo. Search word. D reffiw s like(lfi) *--------------------------------------------------------------------------------------------- * Programmi già sviluppati. D lpags s 18 dim(10000) * Indice di riempimento dei Programmi già sviluppati. D ip s 7 0 D ip0 s like(ip) D ips s like(ip) *--------------------------------------------------------------------------------------------- * Numero massimo di elementi Attributo programma. D maxqa c 20 * Spezza la simple list del parametro Attributo programma. D pppgmatr ds D qan 1 2b 0 D qa 2 dim(maxqa) * Numero massimo di elementi Attributo oggetto. D maxoa c 50 * Spezza la simple list del parametro Attributo oggetto. D ppobjatr ds D oan 1 2b 0 D oa 10 dim(maxoa) *--------------------------------------------------------------------------------------------- * Doppioni dei parametri. D qax s like(qa) dim(maxqa) D oax s like(oa) dim(maxoa) *--------------------------------------------------------------------------------------------- * Comando di chiamata. D cmd ds D cmdel 130 dim(10) *--------------------------------------------------------------------------------------------- * Trattini. D tra s 132 inz(*all'-') *--------------------------------------------------------------------------------------------- * Campi della riga di emissione. D outds e ds extname(jrefdbfw) inz * Campi della riga di emissione. Precedente. D outpre e ds extname(jrefdbfw) prefix(pre) inz * Campi della riga di emissione. Stampa. D outprt e ds extname(jrefdbfw) prefix(prt) inz * Accorcia i campi per la stampa. D prtoutfitz 7 overlay(prtoutfit) D prtoutfiaz 6 overlay(prtoutfia) D prtoutpatz 7 overlay(prtoutpat) D prtoutpaaz 6 overlay(prtoutpaa) * Campi della riga di emissione. Ultimo stampato. D outult e ds extname(jrefdbfw) prefix(ult) inz D outulz e ds extname(jrefdbfw) prefix(ulz) inz *--------------------------------------------------------------------------------------------- *IMP * Rovescia padre e figlio per sfruttare il programma senza altre modifiche. *IMP I**ref *IMP I** REFPAN REFFIN *IMP I** REFPAT REFFIT *IMP I** REFPAA REFFIA *IMP I** REFPAL REFFIL *IMP I** REFPAX REFFIX *IMP I** REFFIN REFPAN *IMP I** REFFIT REFPAT *IMP I** REFFIA REFPAA *IMP I** REFFIL REFPAL *IMP I** REFFIX REFPAX *IMP *--------------------------------------------------------------------------------------------- * Predispone chiusura. C seton lr * Scambia parametri. C *entry plist * Riceve Nome dell'oggetto da esplodere. C parm pppan 10 * Riceve Tipo dell'oggetto da esplodere. C parm pppat 8 * Riceve Sviluppo. * *ALL=Elenca tutti gli oggetti * *PGM=Elenca solo i programmi C parm ppsvil 10 * Riceve To last elements only. * *NO =Elenca tutti gli oggetti * *YES=Elenca solo gli oggetti senza ulteriori componenti. C parm pptola 10 * Riceve Already seen. * *YES=Elenca anche le righe segnate con G=Già viste. * *NO =Non elenca le righe segnate con G=Già viste. C parm ppseen 10 * Riceve Attributo programma. C parm pppgmatr * Riceve Attributo oggetto. * Blank =Elenca tutti gli oggetti * NonBlank=Elenca solo gli oggetti con l'attributo richiesto. C parm ppobjatr * Riceve Nome del sistema. C parm ppsnam 8 * Riceve Massimo livello. C parm ppmaxl 3 0 * Riceve Uso Input. C parm ppinput 1 * Riceve Uso Output. C parm ppoutput 1 * Riceve Uso Update. C parm ppupdate 1 * Riceve Uso Sconosciuto. C parm ppunknown 1 * Riceve Uso Relazione di database. C parm ppdbrel 1 * Riceve Uso Nessuno. C parm ppnouse 1 * Riceve Libreria dati. C parm ppdtali 10 * Trascrive i parametri a numero di elementi variabili nei doppioni. C clear qax C *like define qan px C do qan px B01 C movel(p) qa(px) qax(px) 01 C enddo E01 C clear oax C do oan px B01 C movel(p) oa(px) oax(px) 01 C enddo E01 * Compone il comando ricevuto per stamparlo. C clear cmd *EXP C eval cmd='JREFEXP OBJ(' + *IMP C** eval cmd='JREFIMP OBJ(' + C %trim(pppan ) + C ') OBJTYPE(' + C %trim(pppat ) + C ') DEVELOP(' + C %trim(ppsvil) + C ') TOLAST(' + C %trim(pptola) + C ') SEEN(' + C %trim(ppseen) + C ') PGMATR(' C do qan px B01 C if px=1 B02 C eval cmd= %trim(cmd) + 02 C %trim(qax(px)) 02 C else X02 C eval cmd= %trim(cmd) + 02 C ' ' + 02 C %trim(qax(px)) 02 C endif E02 C enddo E01 C eval cmd= %trim(cmd) + C ') OBJATR(' C do oan px B01 C if px=1 B02 C eval cmd= %trim(cmd) + 02 C %trim(oax(px)) 02 C else X02 C eval cmd= %trim(cmd) + 02 C ' ' + 02 C %trim(oax(px)) 02 C endif E02 C enddo E01 C eval cmd= %trim(cmd) + C ') MAXLVL(' + C %trim(%editc(ppmaxl:'Z')) + C ')' * Uso. C if ppinput = *off B01 C eval cmd= %trim(cmd) + ' INPUT(*NO)' 01 C endif E01 C if ppoutput = *off B01 C eval cmd= %trim(cmd) + ' OUTPUT(*NO)' 01 C endif E01 C if ppupdate = *off B01 C eval cmd= %trim(cmd) + ' UPDATE(*NO)' 01 C endif E01 C if ppunknown = *off B01 C eval cmd= %trim(cmd) + ' UNKNOWN(*NO)' 01 C endif E01 C if ppdbrel = *off B01 C eval cmd= %trim(cmd) + ' DBREL(*NO)' 01 C endif E01 C if ppnouse = *off B01 C eval cmd= %trim(cmd) + ' NOUSE(*NO)' 01 C endif E01 * Libreria dati. C eval cmd= %trim(cmd) + C ' DTALIB(' + C %trim(ppdtali) + C ')' * Stampa l'intestazione della prima pagina. C except int1 C do 10 ix 3 0 B01 C if cmdel(ix)<>*blank B02 C except int2 02 C endif E02 C enddo E01 C except int3 * Chiave di ricerca degli oggetti chiamati da un programma. C k1a klist * Usante. C kfld lpan(xx) * Tipo usante. C kfld lpat(xx) * Chiave di riposizionamento. C k1b klist * Usante. C kfld lpan(xx) * Tipo usante. C kfld lpat(xx) * Usato. C kfld lfin(xx) * Tipo usato. C kfld lfit(xx) * Pulisce la lista di chiamata. C clear lpan C clear lpat C clear lfin C clear lfit * STAMPA LA PRIMA RIGA. INIZIO * Assume il programma richiesto nella prima emissione. C clear xx C clear refpan C clear refpat C movel(p) pppan reffin C movel(p) pppat reffit * Decodifica il programma richiesto. C kd1 klist C kfld pppan C kfld pppat C kd1 chain jrefdbfd1 C if %found B01 C movel(p) odobat reffia 01 C movel(p) odobtx reffix 01 C else X01 C movel(p) *all'?' reffia 01 C movel(p) *all'?' reffix 01 C endif E01 * Emette il dettaglio del programma di partenza. C exsr outsave * Trascrive la riga ricevuta nei campi di stampa. C movel(p) outds outprt * Emette la riga scelta in stampa. C exsr outprint * Trascrive la riga ricevuta nei campi precedenti. C movel(p) outds outpre * STAMPA LA PRIMA RIGA. FINE * Annota il programma di partenza nella prima posizione lista. C z-add 1 xx 3 0 C movel(p) pppan lpan(1) C movel(p) pppat lpat(1) C clear lfin(1) C clear lfit(1) * Si posiziona all'inizio degli oggetti usati dal pgm di partenza. C k1a setll ref * Balla sulla lista di chiamata. C do *hival B01 * Se l'indice è zero, abbandona. C if xx<=*zero B02 C leave 02 C endif E02 * Legge il prossimo oggetto usato dal prgm corrente. C k1a reade ref 01 * Se gli oggetti chiamati sono finiti. C if %eof B02 * Pulisce la posizione corrente della lista di chiamata. C clear lpan(xx) 02 C clear lpat(xx) 02 C clear lfin(xx) 02 C clear lfit(xx) 02 * Arretra l'indice corrente sulla lista di chiamata. C eval xx=xx-1 02 * Se l'indice è zero, abbandona. C if xx<=*zero B03 C leave 03 C endif E03 * Si riposiziona oltre l'ultima lettura per l'indice corrente. C k1b setgt ref 02 * Ricicla. C iter 02 * Se gli oggetti chiamati sono finiti. C endif E02 * Chiave di scavalco gruppo. C k1s klist 01 * Usante. C kfld refpan 01 * Tipo usante. C kfld refpat 01 * Usato. C kfld reffin 01 * Tipo usato. C kfld reffit 01 * Scavalca il gruppo di record uguali all'ultimo letto. C k1s setgt ref 01 * Legge l'ultimo record del gruppo. C k1s readpe ref h2 01 C h2 return 01 * Assume recursioni assenti. C setoff 5153 01 * Compone Chiamato + Tipo. C eval reffiw = reffin + reffit 01 * Annota la recursione se l'usato corrente è presente in lista usanti. C reffiw lookup lfi 51 01 * Se sono già stati sviluppati programmi. C if ip < ip0 B02 * Se il pgm è già stato sviluppato, annota recursione. C eval ips = ip 02 C reffiw lookup lpags(ips) 53 02 * Se sono già stati sviluppati programmi. C endif E02 * Trascrive l'usato corrente nella lista di chiamata. C eval lpan(xx)=refpan 01 C eval lpat(xx)=refpat 01 C eval lfin(xx)=reffin 01 C eval lfit(xx)=reffit 01 * Annota il pgm nell'elenco dei pgm già sviluppati. C if 1=1 B02 * Assume scrittura in elenco necessaria. C setoff 50 02 * Se sono già stati sviluppati programmi * e il pgm è già annotato, toglie consenso. C if ip < ip0 B03 C eval ips = ip 03 C reffiw lookup lpags(ips) 50 03 C endif E03 * Se scrittura in elenco necessaria, * annota il pgm nell'elenco dei pgm già sviluppati. C if not *in50 B03 C sub 1 ip 03 C eval lpags(ip)=reffiw 03 C endif E03 * Annota il pgm nell'elenco dei pgm già sviluppati. C endif E02 * Se lo sviluppo è tutti e l'usato corrente è valorizzato, * o se lo sviluppo è pgm e l'usato corrente è pgm. C if ppsvil='*ALL' B02 C and lfin(xx)<>*blank 02 C or ppsvil='*PGM' 02 C and lfit(xx)='*PGM' 02 * Se l'usato corrente è diverso dall'ultimo emesso. C if refpan <> preoutpan B03 C or refpat <> preoutpat 03 C or reffin <> preoutfin 03 C or reffit <> preoutfit 03 * Costruisce un attributo oggetto di comodo per la ricerca. C eval reffiaw = reffia 03 C *like define reffia reffiaw 03 C if reffia = *blank B04 C eval reffiaw = 'BLANK' 04 C if reffit = '*FILE' B05 C and %lookup('BLANKF':oax:1:oan) > *zero 05 C eval reffiaw = 'BLANKF' 05 C endif E05 C endif E04 * Se l'attributo oggetto corrente soddisfa la richiesta. C if oan = *zero B04 C or oan > *zero 04 C and %lookup(reffiaw:oax:1:oan) 04 C > *zero 04 * Se l'attributo programma corrente soddisfa la richiesta. C if qan = *zero B05 C or qan > *zero 05 C and %lookup(%subst(refpaa:1:2):qax:1:qan) 05 C > *zero 05 * Decodifica uso. C z-add 1 ux 3 0 05 C refuso lookup usg(ux) 50 05 C n50 movel *all'?' refusod 05 C 50 movel(p) usgd(ux) refusod 05 C *like define usgd refusod 05 * Se l'uso corrente soddisfa la richiesta. C if %subst(refusod:1:1) = 'I' B06 C and ppinput = *on 06 C or %subst(refusod:2:1) = 'O' 06 C and ppoutput = *on 06 C or %subst(refusod:3:1) = 'U' 06 C and ppupdate = *on 06 C or %subst(refusod:4:1) = '?' 06 C and ppunknown = *on 06 C or %subst(refusod:1:3) = 'dbr' 06 C and ppdbrel = *on 06 C or %subst(refusod:1:4) = '....' 06 C and ppnouse = *on 06 * LA RIGA E' DA STAMPARE. INIZIO * Trascrive i dati della riga in una struttura dati. C exsr outsave 06 * Se richieste materie prime e se non aumenta livello. C if pptola = '*YES' B07 C and outian <= preoutian 07 * Trascrive la riga precedente nei campi di stampa. C movel(p) outpre outprt 07 * Emette la riga scelta. C exsr outprint 07 * Se richieste materie prime e se non aumenta livello. C endif E07 * Se non richieste materie prime. C if pptola <> '*YES' B07 * Trascrive la riga ricevuta nei campi di stampa. C movel(p) outds outprt 07 * Emette la riga scelta. C exsr outprint 07 * Se non richieste materie prime. C endif E07 * Trascrive la riga ricevuta nei campi precedenti. C movel(p) outds outpre 06 * LA RIGA E' DA STAMPARE. FINE * Se l'uso corrente soddisfa la richiesta. C endif E06 * Se l'attributo programma corrente soddisfa la richiesta. C endif E05 * Se l'attributo oggetto corrente soddisfa la richiesta. C endif E04 * Se l'usato corrente è diverso dall'ultimo emesso. C endif E03 * Se corre recursione. C if *in51 B03 * Pulisce l'elemento corrente dalla lista di chiamata. C clear lpan(xx) 03 C clear lpat(xx) 03 C clear lfin(xx) 03 C clear lfit(xx) 03 * Arretra l'indice corrente sulla lista di chiamata. C eval xx=xx-1 03 * Se l'indice è zero, abbandona. C if xx<=*zero B04 C leave 04 C endif E04 * Si riposiziona oltre l'ultima lettura per l'indice corrente. C k1b setgt ref 03 * Ricicla. C iter 03 * Se corre recursione. C endif E03 * Se lo sviluppo è tutti e l'usato corrente è valorizzato, * o se lo sviluppo è pgm e l'usato corrente è pgm. C endif E02 * Se l'elemento corrente non è già sviluppato * e se l'indice corrente è minore del massimo. C if not *in53 B02 C and xx < ppmaxl 02 * Incrementa l'indice corrente sulla lista di chiamata. C eval xx=xx+1 02 * Annota il programma nella posizione corrente della lista. C eval lpan(xx)=reffin 02 C eval lpat(xx)=reffit 02 C clear lfin(xx) 02 C clear lfit(xx) 02 * Si posiziona all'inizio degli oggetti usati dal pgm corrente. C k1a setll ref 02 * Se l'elemento corrente non è già sviluppato * e se l'indice corrente è minore o uguale al massimo. C endif E02 * Balla sulla lista di chiamata. C enddo E01 * Stampa fine. C except eop *--------------------------------------------------------------------------------------------- * Trascrive i dati della riga in una struttura dati. C outsave begsr * Pulisce i dati della riga. C clear outds * Numera la riga. C add 1 cnt * Riempie i campi della iga. C 51 movel(p) 'F' outrcs C 53 movel(p) 'G' outgia C z-add cnt outcnt C z-add xx outian C if xx = *zero B01 C movel(p) '0' outiand 01 C else X01 C movel(p) sca(xx) outiand 01 C endif E01 C movel(p) refpan outpan C movel(p) refpat outpat C movel(p) refpaa outpaa C movel(p) reffin outfin C movel(p) reffit outfit C movel(p) reffia outfia C z-add refuso outuso C movel(p) refusod outusod C movel(p) reffix outfix C endsr *--------------------------------------------------------------------------------------------- * Stampa la riga su stampa. C outprint begsr * Emette la riga in outfile. C exsr outfile * Se sono richieste anche le righe già viste * o se la riga non è già vista. C if ppseen = '*YES' B01 C or prtoutgia = *blank 01 * Salva i dati ricevuti in un comodo. C movel(p) outprt outulz 01 * Se non corre la prima riga, * annota usante e tipo usante uguale a precedente. C if prtoutcnt <> 1 B02 C and prtoutpan = ultoutpan 02 C and prtoutpat = ultoutpat 02 C and prtoutpaa = ultoutpaa 02 C movel(p) '"' prtoutpan 02 C movel(p) '"' prtoutpat 02 C movel(p) '"' prtoutpaa 02 C endif E02 * Se overflow, stampa l'intestazione delle pagine * successive alla prima. C if *inof B02 C except int1 02 C except int3 02 C endif E02 * Stampa la riga. C except outrow 01 * Salva i dati ricevuti nell'ultimo stampato. C movel(p) outulz outult 01 * Se sono richieste anche le righe già viste * o se la riga non è già vista. C endif E01 C endsr *--------------------------------------------------------------------------------------------- * Emette la riga in outfile. C outfile begsr * Trascrive la lista di chiamata in outfile. C eval out001 = lpa(001) C eval out002 = lpa(002) C eval out003 = lpa(003) C eval out004 = lpa(004) C eval out005 = lpa(005) C eval out006 = lpa(006) C eval out007 = lpa(007) C eval out008 = lpa(008) C eval out009 = lpa(009) C eval out010 = lpa(010) C eval out011 = lpa(011) C eval out012 = lpa(012) C eval out013 = lpa(013) C eval out014 = lpa(014) C eval out015 = lpa(015) C eval out016 = lpa(016) C eval out017 = lpa(017) C eval out018 = lpa(018) C eval out019 = lpa(019) C eval out020 = lpa(020) C eval out021 = lpa(021) C eval out022 = lpa(022) C eval out023 = lpa(023) C eval out024 = lpa(024) C eval out025 = lpa(025) C eval out026 = lpa(026) C eval out027 = lpa(027) C eval out028 = lpa(028) C eval out029 = lpa(029) C eval out030 = lpa(030) C eval out031 = lpa(031) C eval out032 = lpa(032) C eval out033 = lpa(033) C eval out034 = lpa(034) C eval out035 = lpa(035) C eval out036 = lpa(036) C eval out037 = lpa(037) C eval out038 = lpa(038) C eval out039 = lpa(039) C eval out040 = lpa(040) C eval out041 = lpa(041) C eval out042 = lpa(042) C eval out043 = lpa(043) C eval out044 = lpa(044) C eval out045 = lpa(045) C eval out046 = lpa(046) C eval out047 = lpa(047) C eval out048 = lpa(048) C eval out049 = lpa(049) C eval out050 = lpa(050) C eval out051 = lpa(051) C eval out052 = lpa(052) C eval out053 = lpa(053) C eval out054 = lpa(054) C eval out055 = lpa(055) C eval out056 = lpa(056) C eval out057 = lpa(057) C eval out058 = lpa(058) C eval out059 = lpa(059) C eval out060 = lpa(060) C eval out061 = lpa(061) C eval out062 = lpa(062) C eval out063 = lpa(063) C eval out064 = lpa(064) C eval out065 = lpa(065) C eval out066 = lpa(066) C eval out067 = lpa(067) C eval out068 = lpa(068) C eval out069 = lpa(069) C eval out070 = lpa(070) C eval out071 = lpa(071) C eval out072 = lpa(072) C eval out073 = lpa(073) C eval out074 = lpa(074) C eval out075 = lpa(075) C eval out076 = lpa(076) C eval out077 = lpa(077) C eval out078 = lpa(078) C eval out079 = lpa(079) C eval out080 = lpa(080) C eval out081 = lpa(081) C eval out082 = lpa(082) C eval out083 = lpa(083) C eval out084 = lpa(084) C eval out085 = lpa(085) C eval out086 = lpa(086) C eval out087 = lpa(087) C eval out088 = lpa(088) C eval out089 = lpa(089) C eval out090 = lpa(090) C eval out091 = lpa(091) C eval out092 = lpa(092) C eval out093 = lpa(093) C eval out094 = lpa(094) C eval out095 = lpa(095) C eval out096 = lpa(096) C eval out097 = lpa(097) C eval out098 = lpa(098) C eval out099 = lpa(099) C eval out100 = lpa(100) C write out C endsr *--------------------------------------------------------------------------------------------- * Inizializza. C *inzsr begsr * Annota il numero di elementi dei pgm già sviluppati. C eval ip0=%elem(lpags)+1 C eval ip =ip0 * Azzera il contatore righe. C clear cnt 6 0 * Time. C time time 6 0 C endsr *--------------------------------------------------------------------------------------------- * Intestazione. Oqsysprt e int1 2 1 O e int2 1 O cmdel(ix) O e int3 1 O 97 'SysName:' O ppsnam +1 O *date y 120 O time +2 '0 : : ' O e int3 1 O 'Re' O 8 'Row' O 10 'L' O 'evel' *EXP O 22 'F' *EXP O 'ather' *IMP O** 22 'S' *IMP O** 'on' O 33 'T' O 'ype' O 41 'A' O 'ttrib' *EXP O 48 'S' *EXP O 'on' *IMP O** 48 'F' *IMP O** 'ather' O 59 'T' O 'ype' O 67 'A' O 'ttrib' O 74 'U' O 'sag' O 79 'T' O 'ext' O e int3 1 O tra * Dettaglio esplosione ritardato. O e outrow 1 O prtoutrcs O prtoutgia O prtoutcnt 3 O prtoutiand +1 O prtoutpan +1 O prtoutpatz +1 O prtoutpaaz +1 O prtoutfin +1 O prtoutfitz +1 O prtoutfiaz +1 O prtoutusod +1 O prtoutfix +1 O********************** prtoutian +1 * Fine stampa. O e eop 1 O '*** End of print ***' *--------------------------------------------------------------------------------------------- ** Scaletta di annidamento. 1 .2 ..3 ...4 ....5 .....6 ......7 .......8 ........9 ........10 11 12 .13 ..14 ...15 ....16 .....17 ......18 .......19 ........20 21 22 .23 ..24 ...25 ....26 .....27 ......28 .......29 ........20 31 32 .33 ..34 ...35 ....36 .....37 ......38 .......39 ........40 41 42 .43 ..44 ...45 ....46 .....47 ......48 .......49 ........50 51 52 .53 ..54 ...55 ....56 .....57 ......58 .......59 ........60 61 62 .63 ..64 ...65 ....66 .....67 ......68 .......69 ........70 71 72 .73 ..74 ...75 ....76 .....77 ......78 .......79 ........80 81 82 .83 ..84 ...85 ....86 .....87 ......88 .......89 ........90 91 92 .93 ..94 ...95 ....96 .....97 ......98 .......99 .......100 ** Decodifica uso. 00.... 01I... 02.O.. 03IO.. 04..U. 05I.U. 06.OU. 07IOU. 08...? 09I..? 10.O.? 11IO.? 12..U? 13I.U? 14.OU? 15IOU? 90dbr //ENDSRC //ENDBCHJOB