What’s Worse than Missing Objects?

There’s nothing I dislike more than running a program only to discover that some of the files I need for that program aren’t on my library list. This is especially annoying when the missing files are found in a program buried within another job stream. I may have files that are only partially updated, or I may have a nearly irrecoverable situation because my procedure abends because of missing files.

To avoid this problem, I have developed the Check Program References (CHKPGMREF) command to ensure that all the files I need for a given program are on the library list before I begin (Figure 1). This command uses CL program CHKPGMREFC to check for the existence of the program’s files by running Display Program Reference (DSPPGMREF) to get a list of files used by the program and sending that list to an outfile (Figure 2). CHKPGMREF then reads the outfile and uses Check Objects (CHKOBJ) to ensure the file can be found on the library list. If the file is not found, a message containing the name of the file is sent to the external message queue, where the user can view it.

Thanks to this little utility, running a program with missing files has become a thing of the past!

— Paul Ladouceur This email address is being protected from spambots. You need JavaScript enabled to view it.

/*===================================================================*/

/* TO COMPILE: */
/* */

/* CRTCMD CMD(XXX/CHKPGMREF) PGM(XXX/CHKPGMREFC) */
/* SRCFILE(XXX/QCMDSRC) */
/* TEXT(‘CHECK PGM REFERENCE ‘) */
/* PRDLIB(XXX) */
/*===================================================================*/

CMD PROMPT(‘Check PGM References in *LIBL’)

PARM KWD(PGMNAME) TYPE(QUALPGM) PROMPT(‘Program +

Name’)

QUALPGM: QUAL TYPE(*NAME) LEN(10)

QUAL TYPE(*NAME) LEN(10) DFT(*LIBL ) +

SPCVAL((*LIBL )) PROMPT(‘Library’) /*===================================================================*/

/* TO COMPILE: */

Figure 1: CHKPGMREF finds missing files before you run your program.

/* */

/* CRTCLPGM PGM(XXX/CHKPGMREFC) SRCFILE(XXX/QCLSRC) */
/* */

/*===================================================================*/

PGM PARM(&PGMPATH )

/***************************************************/

/* declare parameters */
/***************************************************/

DCL VAR(&PGMPATH) TYPE(*CHAR) LEN(20)

/***************************************************/

/* Working Fields */
/***************************************************/

DCL VAR(&PLIB) TYPE(*CHAR) LEN(10)

DCL VAR(&PGM ) TYPE(*CHAR) LEN(10)

DCL VAR(&BLANKS10) TYPE(*CHAR) LEN(10) VALUE(‘ ‘)

DCL VAR(&MSG) TYPE(*CHAR) LEN(128)

DCL VAR(&SVWHFNAM) TYPE(*CHAR) LEN(11)

DCL VAR(&SVWHOTYP) TYPE(*CHAR) LEN(10)

DCL VAR(&ALLOBJFND) TYPE(*CHAR) LEN(1) VALUE(‘Y’)

/***************************************************/

/* Global Message Monitor Declares */
/***************************************************/

DCL VAR(&##MSGFLIB) TYPE(*CHAR) LEN(10)

DCL VAR(&##MSGF) TYPE(*CHAR) LEN(10)

DCL VAR(&##MSGID) TYPE(*CHAR) LEN(7)

DCL VAR(&##MSGDTA) TYPE(*CHAR) LEN(128)

/***************************************************/

/* declare File */
/***************************************************/

DCLF FILE(QSYS/QADSPPGM) /* Outfile used by +

DSPPGMREF */

/***************************************************/

/* Global Message Monitor */
/***************************************************/

MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO +

CMDLBL(##ERROR))

START:

/* Get Program/library */

CHGVAR VAR(&PLIB) VALUE(%SST(&PGMPATH 11 10))

CHGVAR VAR(&PGM) VALUE(%SST(&PGMPATH 1 10))

/* Retreive LIBRARY If *LIBL was defaulted from command */

IF COND(&PLIB *EQ *LIBL) THEN(RTVOBJD +

OBJ(&PGM) OBJTYPE(*PGM ) RTNLIB(&PLIB))
/* get all Referenced objects */ DSPPGMREF PGM(&PLIB/&PGM) OUTPUT(*OUTFILE) +

OUTFILE(QTEMP/WRKPGM)

/* override System outfile definition to work file */

OVRDBF FILE(QADSPPGM) TOFILE(QTEMP/WRKPGM)

/* Read each object referenced in the program and loop for next read */

READ: RCVF RCDFMT(QWHDRPPR) /* Read a record */

MONMSG MSGID(CPF0864) EXEC(GOTO EOF)

/* */

/* Check mult-format files once */

IF COND(&SVWHFNAM *EQ &WHFNAM *AND &SVWHOTYP +

*EQ &WHOTYP) THEN(DO)

GOTO CMDLBL(READ)

ENDDO

/* Does object exist */

IF COND(%SST(&WHFNAM 1 1) *NE ‘*’ *AND &WHFNAM +

*NE &BLANKS10) THEN(DO)

CHKOBJ OBJ(*LIBL/&WHFNAM) OBJTYPE(&WHOTYP)

MONMSG MSGID(CPF0000) EXEC(DO)

CHGVAR VAR(&MSG) VALUE(‘Object’ *BCAT &WHFNAM +

*BCAT ‘Object Type’ *BCAT &WHOTYP *BCAT +

‘Not Found’ )

SNDPGMMSG MSG(&MSG)

CHGVAR VAR(&ALLOBJFND) VALUE(‘N’)

ENDDO

CHGVAR VAR(&SVWHFNAM) VALUE(&WHFNAM)

CHGVAR VAR(&SVWHOTYP) VALUE(&WHOTYP)
ENDDO

GOTO READ /* Loop back for next record */

EOF: /* All records have been read */

IF COND(&ALLOBJFND *EQ ‘Y’) THEN(DO)

SNDPGMMSG MSG(‘OK, All objects found’) MSGTYPE(*COMP)

ENDDO

GOTO ENDPGM

/* if error occured, send to program message queue */

##ERROR: RCVMSG MSGTYPE(*EXCP) MSGDTA(&##MSGDTA) +

MSGID(&##MSGID) MSGF(&##MSGF) +

MSGFLIB(&##MSGFLIB)

MONMSG MSGID(CPF0000 MCH0000)

SNDPGMMSG MSGID(&##MSGID) MSGF(&##MSGFLIB/&##MSGF) +

MSGDTA(&##MSGDTA) MSGTYPE(*ESCAPE)

MONMSG MSGID(CPF0000 MCH0000)

RETURN

ENDPGM:

ENDPGM

Figure 2: CHKPGMREFC uses DSPPGMREF and CHKOBJ to ensure that your program files are not missing.

Pick a Date, Any Date

The enhanced display functionality of OS/400 is one of its most powerful and probably most underused features. These functions, controlled through DDS keywords, can give you a GUI-like display from standard AS/400 programs. A good example of this is the RPG IV program CAL001R, which you can find at www. midrangecomputing.com/mc/. This program displays a one-month calendar and allows a user to select a date in that month simply by using the arrow and Enter keys to highlight and then select the desired date. The program then returns the selected date in the CalendarDate parameter. This program can be very useful when added to other programs requiring a date entry. Simply allow for a prompting function and call the CAL001R program.

The *ENTRY parameters allow you to define both a start date for the calendar (that is, the month to be displayed at startup) and the format (M for MDY or Y for YMD). This program accepts 6-, 7-, or 8-digit (left-adjusted) dates in either MDY or YDM format. If a 7-digit date is used, the first digit must be either a 0 or a 1; a blank returns an “Invalid Date Format” message, as do any other errors in the date format. You can easily add an Error parameter, return to the calling program, and allow it to display the error message. The program returns the date in the same format and length provided. Roll keys can also be used to move forward or backward one month at a time.

This program uses the PSHBTNFLD and PSHBTNCHC DDS keywords, which allow you to define a single field as a push-button control. You then define available choices for that control by using PSHBTNCHC. The program also controls the availability of choices by using the CHCCTL function, which allows you to specify, through a defined hidden field, whether or not the choice can be selected. This program uses one push-button field with 42 choices defined. The program then allows only choices that contain valid days for the displayed month to be selected. Once you have entered the DDS source for display file CAL001D (also on the Web at www.midrangecomputing.com/mc/) and RPG IV program CAL001R, you will find a million programs you want to add this to.

This program shows a simple use of one of the more powerful enhanced display functions, which also include option buttons, windows, and pull-down menus. Coupled together, these functions can give all your programs an “almost GUI” look.

— Mike Faust The Lehigh Group This email address is being protected from spambots. You need JavaScript enabled to view it.

FTP the Easy Way

We all like to make things easier so we can perform better and accomplish more in a shorter amount of time. If you find yourself making a lot of repetitive keystrokes, you may find that you’re wasting a lot of time—time that could be better spent doing something else. I found myself in this situation when sending data and objects between multiple AS/400s. I was constantly typing the same commands over and over again. I finally got tired of repeating myself, so, one day, I sat back and wrote a command to eliminate almost all the keying required to send objects from one system to another. What I needed was a way to automate the save and restore processes on the source and target systems. I ended up with the AUTOFTP command (Figure 3). You can download the source for this command and all the objects it uses at www.midrangecomputing.com/mc/.

The command works like this. Enter the command name on a command line and give it the following parameters:

• A valid user ID and password on the remote system
• The library on the source system from which objects are to be saved
• The library on the remote system to which objects are to be restored
• The TCP/IP address of the remote system When the command runs, you are prompted for the names of the objects you want to save. The objects are saved in a temporary save file created in QTEMP. CL program FS001C (Figure 4), which is also the command processor, builds the FTP command variables by using the information you enter on the command. You then write these variables to the temporary FTP script file QTEMP/FTPCMD by using RPG program FS001R. All that’s left is for the program to run the FTP command, and your saved objects are on their way to the remote system, where they are restored. This little utility has made my life a whole lot easier!

— Reza Rafiee This email address is being protected from spambots. You need JavaScript enabled to view it.

<>
<>
<>

Figure 3: The AUTOFTP utility helps you automate the saving and restoring of objects on remote AS/400s.

/*********************************************************************/

/* */

/* CRTCLPGM PGM(XXX/FS001C) SRCFILE(XXX/QCLSRC) + */
/* MBR(FS001C) */
/* */

/* */

/*********************************************************************/

PGM PARM(&RMTUSER &PASSWORD &FROMLIB &TOLIB +

&RMTSYS)

DCL VAR(&FROMLIB) TYPE(*CHAR) LEN(10)

DCL VAR(&TOLIB) TYPE(*CHAR) LEN(10)

DCL VAR(&RMTSYS) TYPE(*CHAR) LEN(20)

DCL VAR(&JOB) TYPE(*CHAR) LEN(10)

DCL VAR(&USER) TYPE(*CHAR) LEN(10)

DCL VAR(&RMTUSER) TYPE(*CHAR) LEN(10)

DCL VAR(&PASSWORD) TYPE(*CHAR) LEN(10)

DCL VAR(&SIGNON) TYPE(*CHAR) LEN(256)

DCL VAR(&RSTOBJ) TYPE(*CHAR) LEN(256)

DCL VAR(&CRTSAV ) TYPE(*CHAR) LEN(256)

DCL VAR(&PUTCMD) TYPE(*CHAR) LEN(256)

DCL VAR(&TFRTYP ) TYPE(*CHAR) LEN(256) +

VALUE(‘binary fixed 528’)

DCL VAR(&ENDFTP) TYPE(*CHAR) LEN(256) VALUE(‘quit’)

RTVJOBA JOB(&JOB) USER(&USER)

CRTSAVF FILE(QTEMP/&USER) TEXT(‘temp sav file’)

MONMSG MSGID(CPF0000)

CLRSAVF FILE(QTEMP/&USER)

? SAVOBJ ??OBJ(*N) ?-LIB(&FROMLIB) ?-DEV(*SAVF) +

??OBJTYPE(*FILE) ?-VOL(*N) ?-SEQNBR(*N) +

?-LABEL(*N) ?-EXPDATE(*N) ?-ENDOPT(*N) +

?-SAVF(QTEMP/&USER) ?-UPDHST(*N) +

?-CLEAR(*N) ?-PRECHK(*N) ?-SAVACT(*N) +

?-FILEMBR(*N) ?-ACCPTH(*N) ?-STG(*N) +

?-DTACPR(*N)

/* CPF6801 - F3 OR F12 PRESSED */

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

/* ANY OTHER ERROR MESSAGE */

MONMSG MSGID(CPF0000) EXEC(DO)

SNDBRKMSG MSG(‘INVALID LIBRARY OR OBJECT(S)’) TOMSGQ(&JOB)

GOTO CMDLBL(END)

ENDDO

/* BUILD REMOTE FTP COMMAND STRINGS */

CHGVAR VAR(&SIGNON) VALUE(&RMTUSER *BCAT &PASSWORD)

CHGVAR VAR(&RSTOBJ) VALUE(‘quote rcmd RSTOBJ +

OBJ(*ALL) SAVLIB(‘ *TCAT &FROMLIB *TCAT +

‘)’ *TCAT ‘ DEV(*SAVF) SAVF(QTEMP/’ *TCAT +

&USER *TCAT ‘) MBROPT(*ALL) +

ALWOBJDIF(*ALL) RSTLIB(‘ *TCAT &TOLIB +

*TCAT ‘)’)

CHGVAR VAR(&CRTSAV ) VALUE(‘quote rcmd CRTSAVF +

FILE(QTEMP/’ || &USER || ‘)’)

CHGVAR VAR(&PUTCMD) VALUE(‘put’ *BCAT ‘QTEMP’ *TCAT +

‘/’ *TCAT &USER *BCAT ‘QTEMP’ *TCAT ‘/’ +

*TCAT &USER *BCAT ‘ ‘)

/* CREATE TEMP FILES FOR STORING FTP COMMAND OUTPUT */

CRTSRCPF FILE(QTEMP/FTPCMD) RCDLEN(500) MBR(*FILE) +

AUT(*EXCLUDE)

MONMSG MSGID(CPF0000) EXEC(CLRPFM FILE(QTEMP/FTPCMD))

CRTSRCPF FILE(QTEMP/FTPLOG) MBR(*FILE) AUT(*EXCLUDE)

MONMSG MSGID(CPF0000) EXEC(CLRPFM FILE(QTEMP/FTPLOG))

/* WRITE FTP COMMANDS TO TEMP FTP COMMAND SCRIPT FILE */

CALL PGM(FS001R) PARM(&SIGNON &TFRTYP &CRTSAV +

&PUTCMD &RSTOBJ &ENDFTP)

/* EXECUTE FTP SCRIPT */

OVRDBF FILE(INPUT) TOFILE(QTEMP/FTPCMD) MBR(*FIRST)

OVRDBF FILE(OUTPUT) TOFILE(QTEMP/FTPLOG) MBR(*FIRST)

FTP RMTSYS(&RMTSYS)

DLTOVR FILE(INPUT OUTPUT)

/* PRINT LOG OF OUTPUT FROM FTP RUN */

CPYF FROMFILE(QTEMP/FTPLOG) TOFILE(QSYSPRT)

/* DELETE FTP WORK FILE */

DLTF FILE(QTEMP/&USER)

END: ENDPGM

Figure 4: Program FS001C assembles the FTP script and runs the FTP command.

Being Held *LIBL for Job Descriptions

Q: Is there a command to print all job descriptions from *LIBL?

— Lyco Tran This email address is being protected from spambots. You need JavaScript enabled to view it.

A: You’d think you could use the Display Job Description (DSPJOBD) command with a wild card as follows:

DSPJOBD JOBD(QSYS/*ALL)

But the wild card is invalid, so you would get this error:

Value ‘*ALL ‘ for parameter JOBD not a valid name.

To get around this, use the DSPJOBD command but qualify the object type as job description (*JOBD):

DSPJOBD OBJ(QSYS/*ALL) OBJTYPE(*JOBD)

This command displays a screen with all the job descriptions. If you want to automate this process, use the Outfile parameter of the DSPJOBD command and use Query/400 or whatever to list the outfile.

— Don Denoncourt Senior Technical Editor

Midrange Computing

No More Fear of Commitment (Control)

If you are running an interactive session on the AS/400 and are desperate to get to a command line, here’s one method. Press and hold the Shift key and then press the SysRq key. (This is the sequence of keystrokes for terminals; you may have to use another sequence from a PC.) When the Display Job (DSPJOB) screen appears, select option 16 (Display Commitment Control Status) and press Enter. Surprise! You are now on a screen that has access to the command line via the F9 key. I rarely use commitment control or option 16 on the DSPJOB screen, so I was surprised to find this.

— Chris Ringer This email address is being protected from spambots. You need JavaScript enabled to view it.

Won’t You Join Me for a Little Update?

Q: I have an UPDATE statement that works in SQLServer. Do you know how it could be made to work on a DB2 database? I tried running it in DB2 as is, but it gives me a syntax error with the period (.). When I remove the period and reference to the StgMfrMst table in the SET statement, it gives me a syntax error on the word FROM. According to the error message, it’s not a valid token for the UPDATE statement; valid tokens are the comma (,), WITH, and WHERE. Figure 5 shows a simplified version of the SQLServer UPDATE statement.

My goal is to update table A with data from table B all in one SQL statement without having to loop through each record in table B programmatically. When I use this (and the full-blown) statement in SQLServer 7.0, I get remarkable performance. I’d like to see whether the same could be accomplished in DB2.

— Jim Blizzard Inmar Enterprises, Inc.

This email address is being protected from spambots. You need JavaScript enabled to view it.

A: Yes, it is possible. Look at the code in Figure 6. This demonstrates the syntax to make SQL work the way you want it to.

Here’s an example we ran on our own system. You’re given tables A and B with columns Adesc and Acode (primary key). In each table, update all rows in A that have Adesc starting with L with values from B where primary keys match:

UPDATE A

SET Adesc =

(SELECT B.Adesc FROM B

WHERE A.Acode = B.Acode)

WHERE A.Adesc LIKE ‘L%’;

Note that the select cannot return more than one row; otherwise, the query would end in error.

If the column (field) updated does not allow null values, use the COALESCE function to assign a default value:

UPDATE A

SET Adesc =

(SELECT COALESCE(B.Adesc, ‘ ‘) FROM
...

Also be aware that all the rows that match the last WHERE are updated, even if no matching record is in the other file. In your example, all rows that have account number 10 are updated, even if the manufacturer number in A does not exist in B. To make sure the statement does not update rows that do not exist in B, use the following form:

UPDATE A

SET Adesc =

(SELECT B.Adesc FROM B

WHERE A.Acode = B.Acode)

WHERE A.Adesc LIKE ‘L%’ and a.acode in (select acode from b);

— Howard F. Arner, Jr. Associate Technical Editor

Midrange Computing

— Ted Holt Senior Technical Editor

Midrange Computing

UPDATE CbcMfrMst
SET CbcMfrMst.MfrName = StgMfrMst.MfrName

FROM StgMfrMst

WHERE CbcMfrMst.AcctNbr = 10
AND CbcMfrMst.MfrNbr = StgMfrMst.MfrNbr UPDATE CbcMfrMst as A SET MfrName = ( SELECT B.MfrName
FROM StgMfrMst as B

WHERE a.MfrNbr = B.MfrNbr)

WHERE A.AcctNbr = 10

Figure 5: This SQL statement works great on an SQLServer but not so well in DB2/400.

Figure 6: This SQL code updates one table with values from another table.

All I Ever Need to Know I Learned from Y2K

Having written a tool that analyzes and modifies RPG code, I have learned some valuable lessons from the Y2K challenge:

• “Sneaky” code is bad. That is, the less intuitive a piece of code is, the more likely someone or something else (including a Y2K tool) is to break it.

• Hardcoded library names are absolutely horrible, and any program that plays with the library list had better have a darn good reason to do so. If you need to test a job stream and some part of the stream does library list manipulation, you are in serious trouble.

• Cross-library logicals are the single most difficult thing to manage on the AS/400. When a logical and its physical reside in the same library, there is magic that is not present when the two reside in different libraries, and this shows up in save/restore and duplication. Trust me; this is seriously bad mojo.

• “Special values” in fields are bad. If a field is a date field and you need to specify “no date,” you should try to have a second field specify whether or not the first field contains a date. While not always practical, it should be a goal.

• Never, ever trust that the source matches the object. When in doubt, recompile. — Joe Pluta Nexgen Software Technologies, Inc. This email address is being protected from spambots. You need JavaScript enabled to view it.

Also Read

The Power of Writing Code in a Low-Code Solution

TechTip: Let’s Have a Date, Part 2

Going off the Rails