//BCHJOB JOB(JSPEC) JOBD(QBATCH) OUTQ(QPRINT) ENDSEV(60) + LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Open source scaricabile da www.neroni.it */ /* SE L'USO DELLA JOB DESCRIPTION "QBATCH" TI E' IMPEDITO, */ /* UTILIZZANE UNA DIVERSA. */ /* From System: "S65D69DA" */ /* From Library: "NERONI2" */ /* Unload Time: 2014-02-03 15:50 */ /* To File : "JSPEC" */ /* To Library : "NERONI2" */ /* To Text : "Specifications. 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 "JSPEC.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:\JSPEC.txt" "/qsys.lib/NERONI2.lib/stringhe.file/JSPEC.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(JSPEC) 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/JSPEC" */ /* FACENDO ATTENZIONE ALL'ORDINE DI ESECUZIONE INDICATO NEL */ /* MEMBRO FACOLTATIVO "A.LEGGIMI", AD ESEMPIO: */ /* SBMDBJOB FILE(NERONI2/JSPEC) MBR(JSPEC.) 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/JSPEC) CRTSRCPF FILE(NERONI2/JSPEC) RCDLEN(112) + TEXT('Specifications. Src') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CICCIA1) TOFILE(NERONI2/JSPEC) + TOMBR(CICCIA1) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(CICCIA1) + SRCTYPE(PF) + TEXT('Specifications. Test') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(CICCIA1CLP) TOFILE(NERONI2/JSPEC) + TOMBR(CICCIA1CLP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(CICCIA1CLP) + SRCTYPE(CLLE) + TEXT('Specifications. Test') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPEC) TOFILE(NERONI2/JSPEC) + TOMBR(JSPEC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPEC) + SRCTYPE(CMD) + TEXT('Specifications. Cmd') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPEC.) TOFILE(NERONI2/JSPEC) + TOMBR(JSPEC.) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPEC.) + SRCTYPE(CL) + TEXT('Specifications. CrtJs') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECC) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECC) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECC) + SRCTYPE(CLLE) + TEXT('Specifications. Cpp') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECPCLP) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECPCLP) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECPCLP) + SRCTYPE(RPGLE) + TEXT('Specifications. Print For CLP') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECPDBW2) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECPDBW2) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECPDBW2) + SRCTYPE(RPGLE) + TEXT('Specifications. Print Routines') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECPEXT) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECPEXT) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECPEXT) + SRCTYPE(RPGLE) + TEXT('Specifications. Print Extemporaneous') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECPPF) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECPPF) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECPPF) + SRCTYPE(RPGLE) + TEXT('Specifications. Print For PF') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(JSPECPRTVS) TOFILE(NERONI2/JSPEC) + TOMBR(JSPECPRTVS) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(JSPECPRTVS) + SRCTYPE(RPGLE) + TEXT('Specifications. Retrieve PF source') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(PROVA) TOFILE(NERONI2/JSPEC) + TOMBR(PROVA) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(PROVA) + SRCTYPE(PF) + TEXT('Originale prova') /* Copia il sorgente dalla stringa al membro del file sorgente. */ /* Modifica testo e tipo seu del sorgente caricato. */ CPYF FROMFILE(PROVAR) TOFILE(NERONI2/JSPEC) + TOMBR(PROVAR) MBROPT(*REPLACE) SRCOPT(*SEQNBR) CHGPFM FILE(NERONI2/JSPEC) MBR(PROVAR) + SRCTYPE(PF) + TEXT('Prova recuperato') /*---------------------------------------------------------------------*/ //DATA FILE(CICCIA1) FILETYPE(*SRC) ENDCHAR('//ENDSRC') A R CIC A TEXT('Specifications. DbTest') A CICGRU 2 A COLHDG('Gruppo') A CICDAT 8P 0 A COLHDG('Data' + A 'inizio' + A 'validitą') A EDTWRD(' - - ') A CICCLA 3P 0 A COLHDG('Classe' + A 'bps') A EDTCDE(M) A CICFIL 1 A COLHDG('Filler') A CICBIN 9B 0 A COLHDG('Binario') A EDTCDE(M) A CICZON 7S 0 A COLHDG('Zonato') A EDTCDE(M) A CICTXT 10 A COLHDG('Testo') A CICBI2 4B 0 A COLHDG('Binarietto') A EDTCDE(M) A CICBIG 18B 0 A COLHDG('BinariONE') A EDTCDE(M) //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(CICCIA1CLP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') PGM PARM(&NO) /* + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +*/ /* Parametro globale da cui si estraggono gli altri parametri. */ DCL VAR(&NO ) TYPE(*CHAR) LEN( 33) /* Campo numerico di comodo per l'uso di JCHAPAK. */ DCL VAR(&N15) TYPE(*DEC) LEN(15 0) /* Definisce campi dalla Struttura dati CICCIA1 record CIC */ /* Parametri per Specifications. DbTest */ /* Gruppo */ DCL VAR(&CICGRU ) TYPE(*CHAR) LEN( 2) /* Data inizio validitą */ DCL VAR(&CICDAT ) TYPE(*CHAR) LEN( 5) DCL VAR(&CICDAT$ ) TYPE(*DEC ) LEN( 8 0) /* Classe bps */ DCL VAR(&CICCLA ) TYPE(*CHAR) LEN( 2) DCL VAR(&CICCLA$ ) TYPE(*DEC ) LEN( 3 0) /* Filler */ DCL VAR(&CICFIL ) TYPE(*CHAR) LEN( 1) /* Binario */ DCL VAR(&CICBIN ) TYPE(*CHAR) LEN( 4) DCL VAR(&CICBIN$ ) TYPE(*DEC ) LEN( 9 0) /* Zonato */ DCL VAR(&CICZON ) TYPE(*CHAR) LEN( 7) DCL VAR(&CICZON$ ) TYPE(*DEC ) LEN( 7 0) /* Testo */ DCL VAR(&CICTXT ) TYPE(*CHAR) LEN( 10) /* Binarietto */ DCL VAR(&CICBI2 ) TYPE(*CHAR) LEN( 2) DCL VAR(&CICBI2$ ) TYPE(*DEC ) LEN( 4 0) /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ /* + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +*/ /* Estrae Parametri per Specifications. DbTest */ /* Estrae Gruppo */ CHGVAR VAR(&CICGRU ) VALUE(%SST(&NO 1 2)) /* Estrae Data inizio validitą */ CHGVAR VAR(&CICDAT ) VALUE(%SST(&NO 3 5)) JCHAPAK FROMCHAR(&CICDAT ) DGTNBR( 8) TOPACKED(&N15) CHGVAR VAR(&CICDAT$ ) VALUE(&N15) /* Estrae Classe bps */ CHGVAR VAR(&CICCLA ) VALUE(%SST(&NO 8 2)) JCHAPAK FROMCHAR(&CICCLA ) DGTNBR( 3) TOPACKED(&N15) CHGVAR VAR(&CICCLA$ ) VALUE(&N15) /* Estrae Filler */ CHGVAR VAR(&CICFIL ) VALUE(%SST(&NO 10 1)) /* Estrae Binario */ CHGVAR VAR(&CICBIN ) VALUE(%SST(&NO 11 4)) CHGVAR VAR(&CICBIN$ ) VALUE(%BIN(&CICBIN )) /* Estrae Zonato */ CHGVAR VAR(&CICZON ) VALUE(%SST(&NO 15 7)) CHGVAR VAR(&CICZON$ ) VALUE(&CICZON ) /* Estrae Testo */ CHGVAR VAR(&CICTXT ) VALUE(%SST(&NO 22 10)) /* Estrae Binarietto */ CHGVAR VAR(&CICBI2 ) VALUE(%SST(&NO 32 2)) CHGVAR VAR(&CICBI2$ ) VALUE(%BIN(&CICBI2 )) /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/ ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPEC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Specifications. Cmd */ /* Claudio Neroni 18-04-1996 Creato. */ CMD PROMPT('Specifications') PARM KWD(FILE) TYPE(FILE) MIN(1) PROMPT('File to + print specifications') FILE: QUAL TYPE(*NAME) MIN(1) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) + PROMPT('library') PARM KWD(PGM) TYPE(*NAME) LEN(4) DFT(CLP) + SPCVAL((CLP) (DBW2) (EXT) (PF) (RTVS)) + PROMPT('Generator program (JSPECPxxxx)') PARM KWD(VAR) TYPE(*NAME) DFT(KPJBA) + SPCVAL((KPJBA) (*FILE)) PROMPT('Variable + from which extract') PARM KWD(LEN) TYPE(*DEC) LEN(5 0) DFT(502) + PROMPT('Variable length') PARM KWD(INI) TYPE(*DEC) LEN(5 0) DFT(247) + PROMPT('Initial extraction position') //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPEC.) FILETYPE(*SRC) ENDCHAR('//ENDSRC') //BCHJOB JOB(JSPEC.) JOBD(QBATCH) OUTQ(QPRINTS) + ENDSEV(60) LOG(4 00 *SECLVL) MSGQ(*USRPRF) /* Claudio Neroni 18-04-1996 Creato. */ /* JSPEC */ /* Print Rpg Rename Spec. */ /* Prerequisiti: JRSNMSG */ /* Imposta la lista librerie. */ CHGLIBL LIBL(QTEMP QGPL) ADDLIBLE LIB(NERONI2) POSITION(*AFTER QTEMP) /* Cancella gli oggetti preesistenti. */ DLTCMD CMD(NERONI2/JSPEC) DLTPGM PGM(NERONI2/JSPECC) DLTPGM PGM(NERONI2/JSPECCLP) DLTPGM PGM(NERONI2/JSPECDBW2) DLTPGM PGM(NERONI2/JSPECEXT) DLTPGM PGM(NERONI2/JSPECPF) DLTPGM PGM(NERONI2/JSPECRTVS) DLTF FILE(NERONI2/JSPECP) /* Crea gli oggetti. */ CRTPRTF FILE(NERONI2/JSPECP) TEXT('Specifications. Print') + PAGESIZE(66 80) LPI(6) CPI(10) MAXRCDS(*NOMAX) HOLD(*YES) CRTBNDCL PGM(NERONI2/JSPECC) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSPECPCLP) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSPECPDBW2) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSPECPEXT) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSPECPPF) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTBNDRPG PGM(NERONI2/JSPECPRTVS) SRCFILE(JSPEC) DBGVIEW(*ALL) CRTCMD CMD(NERONI2/JSPEC) PGM(JSPECC) SRCFILE(JSPEC) PRDLIB(NERONI2) //ENDBCHJOB //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECC) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /* Specifications. Cpp */ /* Claudio Neroni 18-04-1996 Creato. */ /* */ /* Genera specifiche DS per CLP. */ /* */ PGM PARM(&FILEQ &PGM4 &VAR &LEN &INI) /* Riceve Nome qualificato del file di cui generare le specifiche. */ DCL VAR(&FILEQ) TYPE(*CHAR) LEN(20) /* Riceve Suffisso del programma generatore delle specifiche. */ DCL VAR(&PGM4) TYPE(*CHAR) LEN(4) /* Riceve Nome della variabile da cui effettuare l'estrazione. */ DCL VAR(&VAR) TYPE(*CHAR) LEN(10) /* Riceve Lunghezza della variabile da cui effettuare l'estrazione. */ DCL VAR(&LEN) TYPE(*DEC) LEN(5 0) /* Riceve Posizione di inizio dell'estrazione. */ DCL VAR(&INI) TYPE(*DEC) LEN(5 0) /* Nome del programma generatore delle specifiche. */ DCL VAR(&PGM) TYPE(*CHAR) LEN(10) /* Nome del file. */ DCL VAR(&FILE) TYPE(*CHAR) LEN(10) /* Libreria del file. */ DCL VAR(&FILEL) 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 MCH0000 CEE0000) EXEC(GOTO + CMDLBL(ERRORE)) /* Recupera attributi del lavoro. */ RTVJOBA TYPE(&TYPE) /* Estrae parametri. */ CHGVAR VAR(&FILE) VALUE(%SST(&FILEQ 1 10)) CHGVAR VAR(&FILEL) VALUE(%SST(&FILEQ 11 10)) /* Informa sullo stato di avanzamento. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Esamino + il file' *BCAT &FILEL *TCAT '/' *CAT + &FILE *TCAT '.') TOPGMQ(*EXT) + MSGTYPE(*STATUS) /* Scarica su data base la descrizione dei campi del file. */ DSPFFD FILE(&FILEL/&FILE) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/JSPEC1) /* Ridirige e */ /* chiama la generazione delle specifiche sotto forma di stampa. */ OVRDBF FILE(QADSPFFD) TOFILE(QTEMP/JSPEC1) + SECURE(*YES) OVRPRTF FILE(JSPECP) HOLD(*YES) USRDTA(&FILE) + SPLFNAME(&FILE) SECURE(*YES) CHGVAR VAR(&PGM) VALUE(JSPECP *CAT &PGM4) CALL PGM(&PGM) PARM(&VAR &LEN &INI) /* Se corre un lavoro interattivo, visualizza la stampa. */ IF COND(&TYPE *EQ '1') THEN(DO) DSPSPLF FILE(&FILE) SPLNBR(*LAST) ENDDO /* Attivitą finali. */ RCLRSC: /* Riacquisisce le risorse. */ RCLRSC MONMSG MSGID(CPF0000 MCH0000) /* Dealloca. */ /* ... */ /* Cancella i file di lavoro. */ DLTF FILE(QTEMP/JSPEC1) MONMSG MSGID(CPF0000 MCH0000) /* Pulisce il messaggio di stato. */ SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) TOPGMQ(*EXT) + MSGTYPE(*STATUS) MONMSG MSGID(CPF0000 MCH0000) /* Se richiesto, rilascia il CPF0001. */ IF COND(&CPF0001) THEN(DO) SNDPGMMSG MSGID(CPF0001) MSGF(QCPFMSG) + MSGDTA(JSPEC ) MSGTYPE(*ESCAPE) MONMSG MSGID(CPF0000 MCH0000) ENDDO /* Ritorna. */ RETURN /* Errore. */ ERRORE: /* Restituisce i messaggi al chiamante, */ /* trasformando eventuali escape in diagnostici. */ JRSNMSG MONMSG MSGID(CPF0000 MCH0000) /* Prenotazione del CPF0001. */ CPF0001: /* Prenota il CPF0001. */ CHGVAR VAR(&CPF0001) VALUE('1') MONMSG MSGID(CPF0000 MCH0000) /* Salta ad Attivitą finali. */ GOTO CMDLBL(RCLRSC) ENDPGM //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECPCLP) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Specifications. Print For CLP * Claudio Neroni 18/04/1996 Creato. * Stampa fac-simile di specifiche di definizione * e di estrazione campi dalla KPJBA secondo il tracciato * definito nella struttura dati ricevuta. * Tali specifiche potranno essere raccolte nel source * interessato tramite un SEU. *--------------------------------------------------------------------------------------------- * Elenco campi. FQADSPFFD IF E DISK * Stampa. FJSPECP O F 80 PRINTER OFLIND(*INOF) *--------------------------------------------------------------------------------------------- * Scambia parametri. C *ENTRY PLIST C PARM VAR 10 I Variabile C PARM LEN 5 0 I Lunghezza C PARM INI 5 0 I Inizio C INI SUB 1 INI$ 5 0 * Primo giro: dichiarazioni. *--------------------------- C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL B01 C READ QWHDRFFD 50 01 C 50 LEAVE 01 * Se corre primo record. C *IN51 IFEQ *OFF B02 C SETON 51 02 * Se variabile uguale a file, prende informazioni dal primo record. C if var = '*FILE' C eval var = WHFILE C eval len = WHRLEN C clear ini$ C endif * Stampa pił. C EXCEPT PIU 02 * Dichiara comodo. C EXCEPT FI1 02 * Dichiara globale. C EXCEPT FI2 02 * Se corre primo record. C ENDIF E02 C WHNAME IFNE NAMEP B02 C MOVEL WHNAME NAMEP 10 02 C EXCEPT RC1 02 C ENDIF E02 C WHFLDE CAT(P) '$':0 FLDE$ 10 01 C EXCEPT FL1 01 C SELECT B02 C WHFLDT WHENEQ 'A' X02 C WHFLDT WHENEQ 'S' X02 C EXCEPT FL1S 02 C WHFLDT WHENEQ 'P' X02 C EXCEPT FL1P 02 C WHFLDT WHENEQ 'B' X02 C EXCEPT FL1B 02 C OTHER X02 C EXCEPT FL1$ 02 C ENDSL E02 C ENDDO E01 * Secondo giro: estrazioni. *-------------------------- C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL B01 C READ QWHDRFFD 50 01 C 50 LEAVE 01 C *IN52 IFEQ *OFF B02 C SETON 52 02 C EXCEPT MEN 02 C EXCEPT PIU 02 C ENDIF E02 C WHNAME IFNE NAMEP B02 C MOVEL WHNAME NAMEP 10 02 C EXCEPT RC2 02 C ENDIF E02 C WHFLDE CAT(P) '$':0 FLDE$ 10 01 C WHFOBO ADD INI$ WHFOB$ 5 0 01 C EXCEPT FL2 01 C SELECT B02 C WHFLDT WHENEQ 'A' X02 C WHFLDT WHENEQ 'S' X02 C EXCEPT FL2S 02 C WHFLDT WHENEQ 'P' X02 C EXCEPT FL2P 02 C WHFLDT WHENEQ 'B' X02 C EXCEPT FL2B 02 C OTHER X02 C EXCEPT FL2$ 02 C ENDSL E02 C ENDDO E01 * Chiude. C EXCEPT MEN C SETON LR *--------------------------------------------------------------------------------------------- * Dichiara globale. OJSPECP E FI1 1 O '/*' O ' Parametro globale ' O 'da cui si estraggono ' O 'gli altri parametri.' O 80 '*/' O E FI1 1 O 13 ' ' O 'DCL VAR(&' O VAR O ') TYPE(*CHAR) LEN(' O LEN 3 O ')' * Dichiara comodo. O E FI2 1 O '/*' O ' Campo numerico di comodo ' O 'per l''uso di JCHAPAK.' O 80 '*/' O E FI2 1 O 13 ' ' O 'DCL VAR(&N15) TYPE(*DEC) ' O 'LEN(15 0)' * Intesta dichiarazioni. O E RC1 1 O '/*' O ' Definisce campi dalla ' O 'Struttura dati ' O WHFILE O ' record ' O WHNAME O 80 '*/' O E RC1 1 O '/*' O ' Parametri per ' O WHTEXT O 80 '*/' * Dichiara campo testo. O E FL1 1 O '/* ' O WHFTXT O 80 '*/' O E FL1 1 O 13 ' ' O 'DCL VAR(&' O WHFLDE O ') TYPE(*CHAR) LEN(' O WHFLDB 3 O ')' * Dichiara campo segnato. O E FL1S 1 O 13 ' ' O 'DCL VAR(&' O FLDE$ O ') TYPE(*DEC ) LEN(' O WHFLDD 3 O WHFLDP 3 + 1 O ')' * Dichiara campo impaccato. O E FL1P 1 O 13 ' ' O 'DCL VAR(&' O FLDE$ O ') TYPE(*DEC ) LEN(' O WHFLDD 3 O WHFLDP 3 + 1 O ')' * Dichiara campo binario. O E FL1B 1 O 13 ' ' O 'DCL VAR(&' O FLDE$ O ') TYPE(*DEC ) LEN(' O WHFLDD 3 O WHFLDP 3 + 1 O ')' * Dichiara campo altro tipo. O E FL1$ 1 O 13 ' ' O '/* DCL VAR(&' O FLDE$ O ') TYPE(*DEC ) LEN(' O WHFLDD 3 O WHFLDP 3 + 1 O ') */' * Meno. O E MEN 1 O '/* - - - - - - - - - - -' O ' - - - - - - - - - - - -' O ' - - - - - - - - - - - -' O ' - - -*/' * Pił. O E PIU 1 O '/* + + + + + + + + + + +' O ' + + + + + + + + + + + +' O ' + + + + + + + + + + + +' O ' + + +*/' * Intesta estrazioni. O E RC2 1 O '/*' O ' Estrae Parametri per ' O WHTEXT * Estrae campo testo. O 80 '*/' O E FL2 1 O '/* Estrae ' O WHFTXT O 80 '*/' O E FL2 1 O 13 ' ' O 'CHGVAR VAR(&' O WHFLDE O ') VALUE(%SST(&' O VAR O WHFOB$ 3 + 1 O WHFLDB 3 + 1 O '))' * Estrae campo segnato. O E FL2S 1 O 13 ' ' O 'CHGVAR VAR(&' O FLDE$ O ') VALUE(&' O WHFLDE O ')' * Estrae campo impaccato. O E FL2P 1 O 13 ' ' O 'JCHAPAK FROMCHAR(&' O WHFLDE O ') DGTNBR(' O WHFLDD 3 O ') TOPACKED(&N15)' O E FL2P 1 O 13 ' ' O 'CHGVAR VAR(&' O FLDE$ O ') VALUE(&N15)' * Estrae campo binario. O E FL2B 1 O 13 ' ' O 'CHGVAR VAR(&' O FLDE$ O ') VALUE(%BIN(&' O WHFLDE O '))' * Estrae campo altro tipo. O E FL2$ 1 O 13 ' ' O '/* CHGVAR VAR(&' O FLDE$ O ') VALUE(&' O WHFLDE O ') */' *--------------------------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECPDBW2) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Genera specifiche estemporanee. * Claudio Neroni 25/07/1996 Creato. * Stampa fac-simile di specifiche rpg * Tali specifiche potranno essere raccolte nel source * interessato tramite un SEU. FQADSPFFD IF E DISK FJSPECP O F 80 PRINTER OFLIND(*INOF) D UC C CONST('ABCDEFGHIJKLMNOPQRST- D UVWXYZ') D LC C CONST('abcdefghijklmnopqrst- D uvwxyz') * Scambia parametri. C *ENTRY PLIST C PARM VAR 10 I Variabile C PARM LEN 5 0 I Lunghezza C PARM INI 5 0 I Inizio C INI SUB 1 INI$ 5 0 * Primo giro: Da database a video. C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC1 C ENDIF C MOVEL(P) WHFLDE FLDE 14 C 'W2' CAT(P) WHFLDE:0 FLDEWW 14 C UC:LC XLATE FLDE FLDE C UC:LC XLATE FLDEWW FLDEWW C SELECT C WHFLDT WHENEQ 'S' C WHFLDT OREQ 'P' C EXCEPT FL1N C OTHER C EXCEPT FL1A C ENDSL C ENDDO C EXCEPT ENDSR C EXCEPT TRA * Secondo giro: Da video a database. C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC2 C ENDIF C MOVEL(P) WHFLDE FLDE 14 C 'W2' CAT(P) WHFLDE:0 FLDEWW 14 C UC:LC XLATE FLDE FLDE C UC:LC XLATE FLDEWW FLDEWW C SELECT C WHFLDT WHENEQ 'S' C WHFLDT OREQ 'P' C EXCEPT FL2N C OTHER C EXCEPT FL2A C ENDSL C ENDDO C EXCEPT ENDSR C EXCEPT TRA * Terzo giro: Duplicazione. C MOVEL *HIVAL NAMEP C Z-ADD 20 DUP 2 0 C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC3 C ENDIF C 'W2' CAT(P) WHFLDE:0 FLDEWW 14 C 'U' CAT(P) WHFLDE:0 FLDEU 14 C UC:LC XLATE FLDEWW FLDEWW C UC:LC XLATE FLDEU FLDEU C SELECT C WHFLDT WHENEQ 'S' C WHFLDT OREQ 'P' C ADD 1 DUP C EXCEPT FL3N C OTHER C EXCEPT FL3A C ENDSL C ENDDO C EXCEPT ENDSR C EXCEPT TRA * Chiude. C EXCEPT LR C SETON LR *--------------------------------------------------------------------- OJSPECP E FI1 1 O ' *+ + + + + + + + +' O ' + + + + + + + + + + + +' O ' + + + + + + + + + + + +' O ' + +' *--------------------------------------------------------------------- O E RC1 1 O 6 ' ' O '* Trascrive da database ' O 'a video dati.' O WHNAME + 1 O E RC1 1 O 6 'C' O 25 'dbw2 ' O 35 'begsr ' *--------------------------------------------------------------------- O E RC2 1 O 6 ' ' O '* Trascrive da video ' O 'dati a database.' O WHNAME + 1 O E RC2 1 O 6 'C' O 25 'w2db ' O 35 'begsr ' *--------------------------------------------------------------------- O E RC3 1 O 6 ' ' O '* Duplica dati da ' O 'ultima modifica ' O 'o aggiunta ' O 'a video dati.' O WHNAME + 1 O E RC3 1 O 6 'C' O 25 'duw2 ' O 35 'begsr ' *--------------------------------------------------------------------- O E FL1A 1 O 6 'C' O 35 'movel(p) ' O FLDE 49 O FLDEWW 63 O E FL1N 1 O 6 'C' O 35 'z-add ' O FLDE 49 O FLDEWW 63 *--------------------------------------------------------------------- O E FL2A 1 O 6 'C' O 35 'movel(p) ' O FLDEWW 49 O FLDE 63 O E FL2N 1 O 6 'C' O 35 'z-add ' O FLDEWW 49 O FLDE 63 *--------------------------------------------------------------------- O E FL3A 1 O 6 'C' O FLDEWW 25 O 35 'ifeq ' O 49 '*allx''1c'' ' O E FL3A 1 O 6 'C' O 35 'movel(p) ' O FLDEU 49 O FLDEWW 63 O E FL3A 1 O 6 'C' O 35 'endif ' *-------- O E FL3N 1 O 6 'C' O 14 '*in' O DUP 16 O 35 'ifeq ' O 49 '*on ' O E FL3N 1 O 6 'C' O 35 'z-add ' O FLDEU 49 O FLDEWW 63 O E FL3N 1 O 6 'C' O 35 'endif ' *--------------------------------------------------------------------- O E ENDSR 1 O 6 'C' O 35 'endsr ' *--------------------------------------------------------------------- O E LR 1 O ' *- - - - - - - - -' O ' - - - - - - - - - - - -' O ' - - - - - - - - - - - -' O ' - -' *--------------------------------------------------------------------- O E TRA 1 O ' *-----------------' O '------------------------' O '------------------------' O '----' *--------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECPEXT) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Genera specifiche estemporanee. * Claudio Neroni 18/04/1996 Creato. * Stampa fac-simile di specifiche rpg * Tali specifiche potranno essere raccolte nel source * interessato tramite un SEU. FQADSPFFD IF E DISK FJSPECP O F 80 PRINTER OFLIND(*INOF) * Scambia parametri. C *ENTRY PLIST C PARM VAR 10 I Variabile C PARM LEN 5 0 I Lunghezza C PARM INI 5 0 I Inizio C INI SUB 1 INI$ 5 0 * Primo giro: dichiarazioni. C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC1 C ENDIF C WHFLDE CAT(P) '''':0 FLDEX 11 C EXCEPT FL1 C SELECT C WHFLDT WHENEQ 'A' C WHFLDT WHENEQ 'S' C** EXCPTFL1S C WHFLDT WHENEQ 'P' C** EXCPTFL1P C OTHER C** EXCPTFL1$ C ENDSL C ENDDO * Chiude. C EXCEPT LR C SETON LR OJSPECP E FI1 1 O ' *+ + + + + + + + +' O ' + + + + + + + + + + + +' O ' + + + + + + + + + + + +' O ' + + +*/' O E RC1 1 O 6 'C' O 35 'select ' O E FL1 1 O 6 'C' O 15 'ppso' O 35 'wheneq ' O '''' O FLDEX O E FL1 1 O 6 'C' O 35 'movel(p) ' O WHFLDE O 52 'lev' O E LR 1 O 6 'C' O 35 'endsl ' O E LR 1 O ' *- - - - - - - - -' O ' - - - - - - - - - - - -' O ' - - - - - - - - - - - -' O ' - - -*/' //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECPPF) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Genera specifiche estemporanee. * Claudio Neroni 18/04/1996 Creato. * Stampa fac-simile di specifiche rpg * Tali specifiche potranno essere raccolte nel source * interessato tramite un SEU. FQADSPFFD IF E DISK FJSPECP O F 80 PRINTER OFLIND(*INOF) * Scambia parametri. C *ENTRY PLIST C PARM VAR 10 I Variabile C PARM LEN 5 0 I Lunghezza C PARM INI 5 0 I Inizio C INI SUB 1 INI$ 5 0 * Primo giro: dichiarazioni. C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC1 C ENDIF C WHFLDD COMP *ZERO 35 C EXCEPT FL1 C ENDDO * Chiude. C EXCEPT LR C SETON LR OJSPECP E FI1 1 O ' *-----------------' O '------------------------' O '------------------------' O '--------' O E RC1 1 O 6 'A' O 17 'R' O WHNAME 28 O E FL1 1 O 6 'A' O WHFLDE 28 O 29 'R' O 35 35 'S' O 51 'REFFLD(' O WHFLDE O WHFILE + 1 O ')' O E LR 1 O ' *-----------------' O '------------------------' O '------------------------' O '--------' //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(JSPECPRTVS) FILETYPE(*SRC) ENDCHAR('//ENDSRC') /TITLE Specifications. Retrieve PF source * Claudio Neroni 30/01/2014 Creato. * Stampa fac-simile di specifiche pf. * Tali specifiche potranno essere raccolte nel source * interessato tramite un SEU. *------------------------------------------------------------------------- FQADSPFFD IF E DISK FJSPECP O F 132 PRINTER OFLIND(*INOF) *------------------------------------------------------------------------- D WHTEXT ds D WHTEXT1 25 D WHTEXT2 25 D WHFTXT ds D WHFTXT1 25 D WHFTXT2 25 D WHECDE ds D WHECDE1 1 D WHECDE2 1 D WHEWRD ds D WHEWRD1 25 D WHEWRD2 7 *------------------------------------------------------------------------- * Scambia parametri. C *ENTRY PLIST C PARM VAR 10 I Variabile C PARM LEN 5 0 I Lunghezza C PARM INI 5 0 I Inizio C INI SUB 1 INI$ 5 0 * Un solo giro. C MOVEL *HIVAL NAMEP C 1 SETLL QWHDRFFD C DO *HIVAL C READ QWHDRFFD 50 C 50 LEAVE * Sostituisce nei campi di testo l'apice col doppio apice. C eval qxllen = %size(WHTEXT) C call 'QDCXLATE' C parm qxllen 5 0 I Data len C parm WHTEXT U Data C parm 'JTBLNOAPEX' qxltab 10 I Table C eval qxllen = %size(WHFTXT) C call 'QDCXLATE' C parm qxllen 5 0 I Data len C parm WHFTXT U Data C parm 'JTBLNOAPEX' qxltab 10 I Table C eval qxllen = %size(WHCHD1) C call 'QDCXLATE' C parm qxllen 5 0 I Data len C parm WHCHD1 U Data C parm 'JTBLNOAPEX' qxltab 10 I Table C eval qxllen = %size(WHCHD2) C call 'QDCXLATE' C parm qxllen 5 0 I Data len C parm WHCHD2 U Data C parm 'JTBLNOAPEX' qxltab 10 I Table C eval qxllen = %size(WHCHD3) C call 'QDCXLATE' C parm qxllen 5 0 I Data len C parm WHCHD3 U Data C parm 'JTBLNOAPEX' qxltab 10 I Table C *IN51 IFEQ *OFF C SETON 51 C EXCEPT FI1 C ENDIF C WHNAME IFNE NAMEP C MOVEL WHNAME NAMEP 10 C EXCEPT RC1 C ENDIF C WHFLDD COMP *ZERO 35 C EXCEPT FL1 C if whecde1 <> *blank C EXCEPT FLEDTCDE C endif C if whewrd <> *blank C EXCEPT FLEDTWRD C endif C ENDDO * Chiude. C EXCEPT LR C SETON LR *------------------------------------------------------------------------- OJSPECP E FI1 1 O ' *-----------------' O '------------------------' O '------------------------' O '--------' O E RC1 1 O 6 'A' O 17 'R' O WHNAME 28 O E RC1 1 O 6 'A' O 45 'T' O 'EXT(''' O WHTEXT1 O '-' O E RC1 1 O 6 'A' O 44 ' ' O WHTEXT2 O ''')' O E FL1 1 O 6 'A' O WHFLDE 28 O n35 WHFLDB z 34 O 35 WHFLDD z 34 O WHFLDT 35 O WHFLDP z 37 O E FL1 1 O 6 'A' O 45 'T' O 'EXT(''' O WHFTXT1 O '-' O E FL1 1 O 6 'A' O 44 ' ' O WHFTXT2 O ''')' O E FL1 1 O 6 'A' O 45 'C' O 'OLHDG(''' O WHCHD1 O ''' +' O E FL1 1 O 6 'A' O 45 ' ' O ' ''' O WHCHD2 O ''' +' O E FL1 1 O 6 'A' O 45 ' ' O ' ''' O WHCHD3 O ''')' O E FLEDTCDE 1 O 6 'A' O 45 'E' O 'DTCDE(' O WHECDE1 O ')' O E FLEDTWRD 1 O 6 'A' O 45 'E' O 'DTWRD(' O WHEWRD1 O '-' O E FLEDTWRD 1 O 6 'A' O 44 ' ' O WHEWRD2 O ')' O E LR 1 O ' *-----------------' O '------------------------' O '------------------------' O '--------' *------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(PROVA) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *------------------------------------------------------------------------- A R RAMBO A TEXT('Marameo po'' acc''''identi a- A l ramo d''aria.') A PERFON 2A A TEXT('Fondo'' Roma') A COLHDG('Fondo' + A 'l''aria fritta') A PERDAT 8P 2 A TEXT('Data NAV - A ') A COLHDG('Data ' + A 'NAV ' + A ' ') A EDTWRD(' / / ' - A ) A PERESE 6S 3 A TEXT('Percentuale di valore ese- A nte da imposta ') A COLHDG('Percentuale di ' + A 'valore esente ' + A 'da imposta ') A EDTCDE(K) A PERNAV 9B 2 A TEXT('NAV netto (100-%esenzione- A ) * NAV/100 ') A COLHDG('NAV netto ' + A '(100-%esenzione) ' + A '* NAV/100 ') A EDTCDE(K) *------------------------------------------------------------------------- //ENDSRC /*---------------------------------------------------------------------*/ //DATA FILE(PROVAR) FILETYPE(*SRC) ENDCHAR('//ENDSRC') *------------------------------------------------------------------------- A R RAMBO A TEXT('Marameo po" acc""identi a- A l ramo d"aria. ') A PERFON 2A A TEXT('Fondo" Roma - A ') A COLHDG('Fondo ' + A 'l"aria fritta ' + A ' ') A PERDAT 8P 2 A TEXT('Data NAV - A ') A COLHDG('Data ' + A 'NAV ' + A ' ') A EDTWRD(' / / ' - A ) A PERESE 6S 3 A TEXT('Percentuale di valore ese- A nte da imposta ') A COLHDG('Percentuale di ' + A 'valore esente ' + A 'da imposta ') A EDTCDE(K) A PERNAV 9B 2 A TEXT('NAV netto (100-%esenzione- A ) * NAV/100 ') A COLHDG('NAV netto ' + A '(100-%esenzione) ' + A '* NAV/100 ') A EDTCDE(K) *------------------------------------------------------------------------- //ENDSRC //ENDBCHJOB