Monday, October 24, 2011

Programming in CL? Check out these five tips

Don't let CL programs trip you up. These tips show you how to do the following:
  • Retrieve the system date in a CL program



  • Retrieve the width value in a file



  • Use a CL program to obtain IP addresses for all printers



  • Determine if a file is empty in a CL program



  • Call a CL program from a VB program




  • 1. Retrieving the system date in a CL program


    You've retrieved the system date (QDATE) using RTVSYSVAL in my CL program and now you need to advance the date by one. How can you do this within the CL program?
    Search400.com expert Tim Granatir says, you would have to use the convert date to convert your date to Julian, add 1 to it, check for leap year and make adjustments and then convert it back. A good example of this technique used to be found in the old TAATools in the ADDDAT command.


    Here is that example. This command has a six-character, date but that can easily be changed with a very slight modification.
    /* Add date command source **



    CMD PROMPT('Add Date')

    PARM KWD(DAYS) TYPE(*DEC) LEN(5) RANGE(-35000 +

    35000) MIN(1) PROMPT('Nbr of days to +

    add/sub (5 0)')

    PARM KWD(TOVAR) TYPE(*CHAR) LEN(6) RTNVAL(*YES) +

    MIN(1) PROMPT('New date variable

    (6)')

    PARM KWD(DATE) TYPE(*DEC) LEN(6 0) DFT(*TODAY) +

    RANGE(000000 999999) SPCVAL((*TODAY 0)) +

    PROMPT('Date (sys fmt) (6 0)')







    /* Add date CL source **



    PGM PARM(&DAYS &TOVAR &DATE)

    DCL &DAYS *DEC LEN(5 0)

    DCL &TOVAR *CHAR LEN(6)

    DCL &DATE *DEC LEN(6 0)

    DCL &WRKDAT *CHAR LEN(6)

    DCL &JULIANA *CHAR LEN(5)

    DCL &YRD *DEC LEN(2 0)

    DCL &DAYSD *DEC LEN(3 0)

    DCL &LEAP *DEC LEN(2 0)

    DCL &DAYSINYEAR *DEC LEN(3 0)

    DCL &NUM5 *DEC LEN(5)

    DCL &NUM2 *DEC LEN(2)

    /* &DATE=0 is special value *TODAY */

    IF (&DATE *EQ 0) RTVJOBA DATE(&WRKDAT)

    IF (&DATE *NE 0) CHGVAR &WRKDAT &DATE

    CVTDAT DATE(&WRKDAT) TOVAR(&JULIANA) TOFMT(*JUL) +

    TOSEP(*NONE) /* Convert to Julian */

    MONMSG MSGID(CPF0555) EXEC(SNDPGMMSG +

    MSGID(CPF9898) MSGF(QCPFMSG) MSGTYPE(*ESCAPE) +

    MSGDTA('DATE parameter value cannot +

    be converted'))

    /* Substring for year and day */

    CHGVAR &YRD %SST(&JULIANA 1 2)

    CHGVAR &DAYSD %SST(&JULIANA 3 3)



    CHGVAR VAR(&NUM5) VALUE(&DAYSD + &DAYS) /* Add days */

    CHKPLUS: IF (&NUM5 *GT 0) GOTO CHKLEAP /* If positive */

    IF (&YRD *EQ 00) CHGVAR &YRD 99 /* Year 2000 */

    ELSE CHGVAR &YRD (&YRD -1) /* Decrement year */

    CHKLEAP: CHGVAR &NUM2 (&YRD / 4) /* Chk leap year */

    CHGVAR &LEAP (&YRD - (&NUM2 * 4))

    IF (&LEAP *GT 0) CHGVAR &DAYSINYEAR 365

    ELSE CHGVAR &DAYSINYEAR 366 /* Leap year */

    IF (&NUM5 *LE 0) DO /* Days are negative */

    CHGVAR &NUM5 (&NUM5 + &DAYSINYEAR)

    GOTO CHKPLUS /* Check for positive days */

    ENDDO /* End negative days */

    IF (&NUM5 *GT &DAYSINYEAR) DO /* Ovfl */

    IF (&YRD *EQ 99) CHGVAR &YRD -1 /* Year 2000 */

    CHGVAR &YRD (&YRD + 1) /* Bump year */

    CHGVAR &NUM5 (&NUM5 - &DAYSINYEAR) /* Subtract */

    GOTO CHKLEAP /* Test for next year */

    ENDDO /* End days greater than days-in-year */

    CHGVAR &DAYSD &NUM5 /* Chg to 3 digits */

    /* Substring back into Julian date */

    CHGVAR %SST(&JULIANA 1 2) &YRD

    CHGVAR %SST(&JULIANA 3 3) &DAYSD

    CVTDAT DATE(&JULIANA) TOVAR(&TOVAR) FROMFMT(*JUL) +

    TOSEP(*NONE) /* Convert to sys fmt */



    ENDPGM
    2. Retrieving the width value in a file


    According to site expert Tim Granatir, a quick way to retrieve the width value in the printer file is to make up a small CL program and pass it the file name and library of your print file. In that CL program, execute the following command on your print file. Read that file in your CL program, and then return the values that you want to your calling program.
    DSPFD FILE(QSYSPRT) TYPE(*ATR) OUTPUT(*OUTFILE) FILEATR(*PRTF) OUTFILE(QTEMP/QAFDPRT)
    3. CL program to obtain IP addresses for all printers


    A user needed to write a CL program to obtain the IP addresses for all printers (LAN & RMTOUTQ) that they have on their system. The only OS command he could find was WRKOUTQD, but that does not allow output to *file and only one can be specified. He wondered if there is an API that he can call that does that?
    Site expert Glen Bunnell says there is a process that you can go through to create this information. Below is an example CL that will create an external file with all the information that's required. You will need to write an RPG program or query to retrieve the desired information. The following are the steps that you need to do in order to make the CL work properly:
    1. Create an externally described physical file for use by the CL. Below are the field specifications that will be needed:
    *************** Beginning of data **

    0001.00 A R SPOOLTR

    0007.00 A FILL1 1A

    0007.01 A TEXT1 43A

    0007.02 A OPTION 87A

    ****************** End of data *****



    2. Execute the following command:
    DSPOBJD OBJ(QSYS/QGPL) OBJTYPE(*LIB) OUTPUT(*OUTFILE) OUTFILE(XXXX/DSPOBJ (Replace the XXXX with the library that you want the information stored into.)

    3. Create the following CL:
    PGM



    DCLF FILE(XXXX/DSPOBJ)



    CLRPFM FILE(XXXX/SPOOLT)



    DSPOBJD OBJ(*ALL/*ALL) OBJTYPE(*OUTQ) +

    OUTPUT(*OUTFILE) OUTFILE(GLEN/DSPOBJ)

    START:



    RCVF RCDFMT(QLIDOBJD)



    MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END))



    WRKOUTQD OUTQ(&ODLBNM/&ODOBNM) OUTPUT(*PRINT)



    CPYSPLF FILE(QPDSPSQD) TOFILE(XXXX/HHHHHH) +

    SPLNBR(*LAST) MBROPT(*ADD)



    DLTSPLF FILE(QPDSPSQD) SPLNBR(*LAST)



    GOTO CMDLBL(START)



    END: ENDPGM

    Replace the XXXX with the library name of where the object was created. Replace the HHHHHH with the name of the file that was created in step one.
    4. Run the CL.
    5. With the file created in step one, you can use an RPG program, iSeries query or even download the file and get all the necessary information that you need.

    4. Determine if a file is empty or not in a CL program


    Do you need to know if a file is empty or not in a CL program? Site expert Jim Mason says he isn't aware of any command that returns the number of records in a file, but you could easily create one with these steps.
    CHKF (Check file command) to create:
    CHKF FILE(MYLIB/MYFILE) NBRRCDS(&NBR)
    The second parm in this command definition is a return variable type to return the record number to the caller. Running interactively, this should take about one or two seconds to complete on an iSeries.
    In the CL program for your command:
    1. DSPFD FILE(&FILENAME) TYPE(*MBRLIST) OUTPUT(*OUTFILE) OUTFILE(QTEMP/FD)
    2. In a CALLED CL PGM, open the file QTEMP/FD.
    3. Do RCVF cmd on QTEMP/FD. This reads in the first record for the first member in the file. It has a record format (QWHFDML) and 2 fields: MLFILE (filename) and MLNRCD (number of records). You now have the record count of the first member.
    4. CHGVAR to set the return CL PGM VAR (&NBRRCDS) from the MLNRCD variable you accessed.
    5. Calling a CL program from a VB program


    Calling a CL program from a Visual Basic program is essentially the same as if you were calling a COBOL or RPG program, according to Search400.com expert Shahar Mor. That means you can call it from VB using the program call object or the QCMDEXC stored procedure. Some good examples can be found here.
    And since OLE database is thread-safe, you can run it on the server. That means that you can use the OLE database provider to call the CL program from your asp pages.



    User Feedback to "Determine if a file is empty or not in a CL program"
    Several Search400.com members wrote to say that you can use the RTVMBRD command to determine the number or records in a file. Here are few code examples:
    From Karen Hodge --
    DCL VAR(&RECCONT) TYPE(*DEC) LEN(10 0)



    RTVMBRD FILE(filename) NBRCURRCD(&RECCONT)


    From Kathy Adams --
    DCL VAR(&NBRRCDS) TYPE(*DEC) LEN(10 0)



    RTVMBRD FILE(MYLIB/MYFILE ) NBRCURRCD(&NBRRCDS)


    From Bob Abbott --
    PGM

    DCL VAR(&NOREC) TYPE(*DEC) LEN(10 0)

    RTVMBRD FILE(filename) NBRCURRCD(&NOREC)


    From Warren Schultz --
    DCL VAR(&RECS) TYPE(*DEC) LEN(10 0)

    RTVMBRD FILE(FILENM) NBRCURRCD(&RECS)

    IF (&RECS > 0) THEN(DO)


    From --
    PGM

    DCL VAR(&NBRCURRCD) +

    TYPE(*DEC) LEN(10 0)

    /* this variable will hold actual number of record */

    RTVMBRD FILE(YourFile) NBRCURRCD(&NBRCURRCD)



    IF COND(&NBRCURRCD *EQ 0) + THEN(SNDPGMMSG MSG('The file is empty'))



    ENDPGM


    From  --
    DCL VAR(&NUMRCDS) TYPE(*DEC) LEN(10)

    RTVMBRD FILE(MYLIB/MYFILE) NBRCURRCD(&NUMRCDS)

    IF COND(&NUMRCDS = 0) THEN(GOTO CMDLBL(ENDJOB))

    No comments:

    Post a Comment

    Related Posts Plugin for WordPress, Blogger...