Article

CL Source Code

Eric Nepsund

==============
CL Source Code
==============

/******************************************************************************/ 
/* OBJECT NAME....: CVTSPLHTMC                                                */ 
/* DESCRIPTION....: Convert spooled file to HTML.                             */ 
/* RELEASE........: V4R2                                                      */ 
/* COMPILE NOTES..: 1) Execute the following prior to compile:                */ 
/*                        CRTPF FILE(QTEMP/CVTSPLHTMZ) RCDLEN(133) +          */ 
/*                        MBR(*FILE) OPTION(*NOSOURCE) SIZE(*NOMAX)           */ 
/* DATE WRITTEN...: 02/08/2001                                                */ 
/* AUTHOR.........: Eric Nepsund                                              */ 
/******************************************************************************/ 

             PGM        PARM(&SPLFNAME &DESTFIL &DESTFLR &PMQUALJOB + 
                          &SPLNBR) 

/* Input variables */ 
             DCL        VAR(&SPLFNAME)   TYPE(*CHAR) LEN(10) 
             DCL        VAR(&DESTFIL)    TYPE(*CHAR) LEN(8) 
             DCL        VAR(&DESTFLR)    TYPE(*CHAR) LEN(80) 
             DCL        VAR(&PMQUALJOB)  TYPE(*CHAR) LEN(26) 
             DCL        VAR(&SPLNBR)     TYPE(*DEC)  LEN(4) 

/* Input variables (Qualified names) */ 
             DCL        VAR(&PMJBNM) TYPE(*CHAR) LEN(10) 
             DCL        VAR(&PMUSNM) TYPE(*CHAR) LEN(10) 
             DCL        VAR(&PMJBNO) TYPE(*CHAR) LEN(6) 

/* Program variables */ 
             DCL        VAR(&PAGLEN)    TYPE(*CHAR) LEN(3) 
             DCL        VAR(&SPLNBRA)   TYPE(*CHAR) LEN(4) 
             DCL        VAR(&DESTFIL1)  TYPE(*CHAR) LEN(12) 

/* Program variables for default spool file number & page length */ 
             DCL        VAR(&PAGLENOVR) TYPE(*CHAR) LEN(3) 
             DCL        VAR(&SPLNBROVR) TYPE(*CHAR) LEN(4) 
             DCL        VAR(&SPLNMBGET) TYPE(*CHAR) LEN(5) 
             DCL        VAR(&SPLRECTYP) TYPE(*CHAR) LEN(21) 

/* Program variables for creating folder(s) to store HTML documents */ 
             DCL        VAR(&NWFLRFRM) TYPE(*DEC)  LEN(3) VALUE(001) 
             DCL        VAR(&NWFLRTO)  TYPE(*DEC)  LEN(3) VALUE(000) 
             DCL        VAR(&NWFLRLEN) TYPE(*DEC)  LEN(3) VALUE(000) 
             DCL        VAR(&INFLRLEN) TYPE(*DEC)  LEN(3) VALUE(1) 
             DCL        VAR(&INFLR)    TYPE(*CHAR) LEN(63) 
             DCL        VAR(&NWFLR)    TYPE(*CHAR) LEN(12) 
             DCL        VAR(&FLRCNT)   TYPE(*DEC)  LEN(3) VALUE(000) 
             DCL        VAR(&SCNSTR)    TYPE(*CHAR) LEN(80) 
             DCL        VAR(&SCNSTRLEN) TYPE(*DEC)  LEN(3) VALUE(80) 
             DCL        VAR(&SCNBEGPOS) TYPE(*DEC)  LEN(3) 
             DCL        VAR(&SCNPAT)    TYPE(*CHAR) LEN(1) 
             DCL        VAR(&SCNPATLEN) TYPE(*DEC)  LEN(3) 
             DCL        VAR(&SCNXLT)    TYPE(*CHAR) LEN(1) VALUE('1') 
             DCL        VAR(&SCNTRM)    TYPE(*CHAR) LEN(1) VALUE('1') 
             DCL        VAR(&SCNWLDCRD) TYPE(*CHAR) LEN(1) VALUE(' ') 
             DCL        VAR(&SCNRTNVAL) TYPE(*DEC)  LEN(3) 

/* Standard variables.                                                        */ 
             DCL        VAR(&MSGDTA)  TYPE(*CHAR) LEN(100) 
             DCL        VAR(&MSGERR)  TYPE(*LGL) LEN(1) VALUE('0') 
             DCL        VAR(&MSGF)    TYPE(*CHAR) LEN(10) 
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) 
             DCL        VAR(&MSGID)   TYPE(*CHAR) LEN(7) 

/* Files */ 
             DCLF       FILE(CVTSPLHTMZ) 

/******************************************************************************/ 
/* Standard logic                                                             */ 
/******************************************************************************/ 

/* Global message monitor. */ 
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(MSGSTART)) 

/* Global message monitor. */ 
             CHGVAR     VAR(&PMJBNM) VALUE(%SST(&PMQUALJOB 1 10)) 
             CHGVAR     VAR(&PMUSNM) VALUE(%SST(&PMQUALJOB 11 10)) 
             CHGVAR     VAR(&PMJBNO) VALUE(%SST(&PMQUALJOB 21 6)) 

/******************************************************************************/ 
/* Main logic.                                                                */ 
/******************************************************************************/ 

/* Delete temporary files, if they exist */ 
             DLTF       FILE(QTEMP/CVTSPLHTMX) 
             MONMSG     MSGID(CPF0000) 
             DLTF       FILE(QTEMP/CVTSPLHTMY) 
             MONMSG     MSGID(CPF0000) 
             DLTF       FILE(QTEMP/CVTSPLHTMZ) 
             MONMSG     MSGID(CPF0000) 

/* Retrieve job defaults. */ 
             IF COND(&PMQUALJOB *EQ '*') THEN(DO) 
               RTVJOBA    JOB(&PMJBNM) USER(&PMUSNM) NBR(&PMJBNO) 
             ENDDO 

/* Set defaults for page length & spooled file number */ 
             CHGVAR     VAR(&PAGLEN)    VALUE('068') /* Default */ 
             CHGVAR     VAR(&SPLNBRA)   VALUE(&SPLNBR) 

/* Retrieve default spooled file number for *LAST & *FIRST special   */ 
/* values, and also the actual page length of the spooled file.      */ 

             CHGVAR     VAR(&PAGLENOVR) VALUE('   ') 
             CHGVAR     VAR(&SPLNBROVR) VALUE(' ') 
             CHGVAR     VAR(&SPLNMBGET) VALUE(' ') 
             IF COND(&SPLNBR *EQ -1) THEN(DO) 
               CHGVAR     VAR(&SPLNMBGET) VALUE('*LAST') 
             ENDDO 
             IF COND(&SPLNBR *EQ 0) THEN(DO) 
               CHGVAR     VAR(&SPLNMBGET) VALUE('*ONLY') 
             ENDDO 
             IF COND(&SPLNMBGET *EQ ' ') THEN(DO) 
               CHGVAR     VAR(&SPLNMBGET) VALUE(&SPLNBR) 
             ENDDO 

             CRTPF      FILE(QTEMP/CVTSPLHTMZ) RCDLEN(133) + 
                        MBR(*FILE) OPTION(*NOSOURCE) SIZE(*NOMAX) 

             OVRPRTF    FILE(QPRTSPLQ) PRTTXT(*BLANK) HOLD(*YES) + 
                        USRDTA(@TEMP@) 
             WRKSPLFA   FILE(&SPLFNAME) JOB(&PMJBNO/&PMUSNM/&PMJBNM) + 
                        SPLNBR(&SPLNMBGET) OUTPUT(*PRINT) 
             DLTOVR     FILE(QPRTSPLQ) 

             CPYSPLF    FILE(QPDSPSFA) TOFILE(CVTSPLHTMZ) + 
                        SPLNBR(*LAST) MBROPT(*REPLACE) + 
                        CTLCHAR(*FCFC) 

             DLTSPLF    FILE(QPDSPSFA) SPLNBR(*LAST) 

READLP:      RCVF RCDFMT(CVTSPLHTMZ) 
             MONMSG CPF0864 EXEC(GOTO READLPX) 

               /* Retrieve spooled file number */ 
               CHGVAR     VAR(&SPLRECTYP)  VALUE(%SST(&CVTSPLHTMZ 46 21)) 
               IF COND(&SPLRECTYP *EQ 'Number  . . . . . . :') THEN(DO) 
               IF COND(&SPLNMBGET *EQ '*LAST' *OR  + 
                     &SPLNMBGET *EQ '*ONLY') THEN(DO) 
                 CHGVAR     VAR(&SPLNBROVR)  VALUE(%SST(&CVTSPLHTMZ 72 4)) 

                 IF COND((%SST(&SPLNBROVR 4 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&SPLNBROVR) VALUE(%SST(&SPLNBROVR 1 4)) 
                   GOTO CMDLBL(READLP) 
                 ENDDO 
                 IF COND((%SST(&SPLNBROVR 3 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&SPLNBROVR) VALUE('0' *CAT %SST(&SPLNBROVR 1 3)) 
                   GOTO CMDLBL(READLP) 
                 ENDDO 
                 IF COND((%SST(&SPLNBROVR 2 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&SPLNBROVR) + 
                   VALUE('00' *CAT %SST(&SPLNBROVR 1 2)) 
                   GOTO CMDLBL(READLP) 
                 ENDDO 
                 IF COND((%SST(&SPLNBROVR 1 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&SPLNBROVR) + 
                   VALUE('000' *CAT %SST(&SPLNBROVR 1 1)) 
                   GOTO CMDLBL(READLP) 
                 ENDDO 
                 IF COND((%SST(&SPLNBROVR 1 4)) *EQ ' ') THEN(DO) 
                   CHGVAR VAR(&SPLNBROVR) VALUE('0000') 
                   GOTO CMDLBL(READLP) 
                 ENDDO 
               ENDDO 
               ENDDO 

/* Retrieve page length */ 
               CHGVAR     VAR(&SPLRECTYP)  VALUE(%SST(&CVTSPLHTMZ 4 21)) 
               IF COND(&SPLRECTYP *EQ ' Length . . . . . . .') THEN(DO) 
                 CHGVAR VAR(&PAGLENOVR)  VALUE(%SST(&CVTSPLHTMZ 48 3)) 

                 IF COND((%SST(&PAGLENOVR 3 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&PAGLENOVR) VALUE(%SST(&PAGLENOVR 1 3)) 
                   GOTO CMDLBL(READLPX) 
                 ENDDO 
                 IF COND((%SST(&PAGLENOVR 2 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&PAGLENOVR) VALUE('0' *CAT %SST(&PAGLENOVR 1 2)) 
                   GOTO CMDLBL(READLPX) 
                 ENDDO 
                 IF COND((%SST(&PAGLENOVR 1 1)) *NE ' ') THEN(DO) 
                   CHGVAR VAR(&PAGLENOVR) VALUE('00' *CAT %SST(&PAGLENOVR 1 1)) 
                   GOTO CMDLBL(READLPX) 
                 ENDDO 
                 IF COND((%SST(&PAGLENOVR 1 3)) *EQ ' ') THEN(DO) 
                   CHGVAR VAR(&PAGLENOVR) VALUE('000') 
                   GOTO CMDLBL(READLPX) 
                 ENDDO 
                 GOTO CMDLBL(READLPX) 
               ENDDO 

             GOTO       CMDLBL(READLP) 

 READLPX:    IF COND(&SPLNBROVR *GE '0001' + 
                *AND &SPLNBROVR *LE '9999') THEN(DO) 
                   CHGVAR     VAR(&SPLNBR)  VALUE(&SPLNBROVR) 
                   CHGVAR     VAR(&SPLNBRA) VALUE(&SPLNBROVR) 
             ENDDO 
             IF COND(&PAGLENOVR *GE '001' + 
                *AND &PAGLENOVR *LE '999') THEN(DO) 
                   CHGVAR     VAR(&PAGLEN)  VALUE(&PAGLENOVR) 
             ENDDO 

/* Convert to HTML format in physical file  */ 
             CRTPF      FILE(QTEMP/CVTSPLHTMX) RCDLEN(202)  SIZE(*NOMAX) 
             CRTPF      FILE(QTEMP/CVTSPLHTMY) RCDLEN(1024) SIZE(*NOMAX) 
             CPYSPLF    FILE(&SPLFNAME) TOFILE(QTEMP/CVTSPLHTMX) + 
                          JOB(&PMJBNO/&PMUSNM/&PMJBNM) + 
                          SPLNBR(&SPLNBR) MBROPT(*ADD) CTLCHAR(*PRTCTL) 

             OVRDBF FILE(FILEIN)  TOFILE(QTEMP/CVTSPLHTMX) MBR(*FIRST) 
             OVRDBF FILE(FILEOUT) TOFILE(QTEMP/CVTSPLHTMY) MBR(*FIRST) 
             CALL   PGM(*LIBL/CVTSPLHTMR) PARM(&PAGLEN) 
             DLTOVR FILE(FILEIN) 
             DLTOVR FILE(FILEOUT) 

/* Create QDLS folder(s) if they do not exist */ 

             CHGVAR     VAR(&SCNSTR) VALUE(&DESTFLR) 
             CHGVAR     VAR(&SCNPAT)    VALUE('/') 
             CHGVAR     VAR(&SCNPATLEN) VALUE(001) 
             CHGVAR     VAR(&SCNBEGPOS) VALUE(001) 

             IF COND(&SCNSTR *NE ' ') THEN(DO) 
FLDRLP:        CALL QCLSCAN PARM(&SCNSTR &SCNSTRLEN &SCNBEGPOS &SCNPAT + 
                               &SCNPATLEN &SCNXLT &SCNTRM &SCNWLDCRD &SCNRTNVAL) 

               /* 2 or more folders */ 
               IF COND(&SCNRTNVAL *GT 0) THEN(DO) 
                 CHGVAR VAR(&FLRCNT)     VALUE(&FLRCNT + 1) 
                 CHGVAR VAR(&NWFLRFRM)   VALUE(&SCNBEGPOS) 
                 CHGVAR VAR(&NWFLRTO)    VALUE(&SCNRTNVAL -1) 
                 CHGVAR VAR(&NWFLRLEN)   VALUE(&NWFLRTO - &NWFLRFRM +1) 
                 CHGVAR VAR(&NWFLR)  VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN)) 
                 IF COND(&NWFLRFRM *EQ 1) THEN(DO) 
                   CHGVAR VAR(&INFLR) VALUE('*NONE') 
                 ENDDO 
                 IF COND(&NWFLRFRM *GT 1) THEN(DO) 
                   CHGVAR VAR(&INFLRLEN) VALUE(&NWFLRFRM -2) 
                   CHGVAR VAR(&INFLR) VALUE(%SST(&SCNSTR 1 &INFLRLEN)) 
                 ENDDO 
                 CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by + 
                        CVTSPLHTM command') 
                 MONMSG MSGID(CPF0000) 
                 CHGVAR VAR(&SCNBEGPOS) VALUE(&SCNRTNVAL +1) 
                 GOTO CMDLBL(FLDRLP) 
               ENDDO 

               /* Only 1 folder */ 
               IF COND(&FLRCNT *LE 0) THEN(DO) 
                 CHGVAR VAR(&NWFLRFRM)   VALUE(&SCNBEGPOS) 
                 CHGVAR VAR(&NWFLRTO)    VALUE(&SCNBEGPOS + 12) 
                 CHGVAR VAR(&NWFLRLEN)   VALUE(12) 
                 CHGVAR VAR(&NWFLR)  VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN)) 
                 CHGVAR VAR(&INFLR) VALUE('*NONE') 
                 CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by + 
                        CVTSPLHTM command') 
                 MONMSG MSGID(CPF0000) 
               ENDDO 

               /* Pickup last folder, if 2 or more folders */ 
               IF COND(&FLRCNT *GE 1) THEN(DO) 
                 CHGVAR VAR(&NWFLRFRM)   VALUE(&SCNBEGPOS) 
                 CHGVAR VAR(&NWFLRTO)    VALUE(&SCNBEGPOS + 12) 
                 CHGVAR VAR(&NWFLRLEN)   VALUE(12) 
                 CHGVAR VAR(&NWFLR)  VALUE(%SST(&SCNSTR &NWFLRFRM &NWFLRLEN)) 
                 IF COND(&NWFLRFRM *GT 1) THEN(DO) 
                   CHGVAR VAR(&INFLRLEN) VALUE(&NWFLRFRM -2) 
                   CHGVAR VAR(&INFLR) VALUE(%SST(&SCNSTR 1 &INFLRLEN)) 
                 ENDDO 
                 CRTFLR FLR(&NWFLR) INFLR(&INFLR) TEXT('Created by + 
                        CVTSPLHTM command') 
                 MONMSG MSGID(CPF0000) 
               ENDDO 

             ENDDO 

/* Move HTML document into folder  */ 
             CHGVAR     VAR(&DESTFIL1) VALUE(&DESTFIL *TCAT '.htm') 
             CPYTOPCD   FROMFILE(*LIBL/CVTSPLHTMY) TOFLR(&DESTFLR) + 
                          FROMMBR(*FIRST) TODOC(&DESTFIL1) + 
                          REPLACE(*YES) 

             DLTF       FILE(QTEMP/CVTSPLHTMX) 
             DLTF       FILE(QTEMP/CVTSPLHTMY) 

/* Return. */ 
RETRN:       RETURN 

/******************************************************************************/ 
/* Standard message handling routine.                                         */ 
/******************************************************************************/ 

 MSGSTART:   IF         COND(&MSGERR *EQ '1') THEN(SNDPGMMSG + 
                          MSGID(CPF9999) MSGF(QCPFMSG) + 
                          MSGTYPE(*ESCAPE)) 

             CHGVAR     VAR(&MSGERR) VALUE('1') 

/* Move the diagnostic messages up to the next level.                         */ 
 MSGDIAG:    RCVMSG     MSGTYPE(*DIAG) MSGDTA(&MSGDTA) MSGID(&MSGID) + 
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) 

             IF         COND(&MSGID *EQ '       ') THEN(GOTO + 
                          CMDLBL(MSGCOMP)) 

             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                          MSGDTA(&MSGDTA) MSGTYPE(*DIAG) 

             GOTO       CMDLBL(MSGDIAG) 

/* Move the completion messages up to the next level.                         */ 
 MSGCOMP:    RCVMSG     MSGTYPE(*COMP) MSGDTA(&MSGDTA) MSGID(&MSGID) + 
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) 

             IF         COND(&MSGID *EQ '       ') THEN(GOTO + 
                          CMDLBL(MSGESC)) 

             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                          MSGDTA(&MSGDTA) MSGTYPE(*COMP) 

             GOTO       CMDLBL(MSGCOMP) 

/* Re-send the last escape message (if there is one).                         */ 
 MSGESC:     RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) + 
                          MSGF(&MSGF) SNDMSGFLIB(&MSGFLIB) 

             IF         COND(&MSGID *EQ '       ') THEN(RETURN) 

             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) 

             ENDPGM 

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to: