Got a Date?

Recently, I was asked how to use the RPG IV date addition and subtraction op codes to determine a date one month from the current date. Not being the type of person who likes to use five words when 105 will do, I wrote a little demo program, shown in Figure 1, to show how to perform a variety of date calculations:

• How to retrieve the current date

• How to add one month to the current date

• How to subtract one month from the current date

• How to add 30 days to the current date

• How to subtract 30 days from the current date

The reason I show not only how to add an entire month but also how to add 30 days is to demonstrate the difference between how the ADDUR and SUBDUR op codes work. When you run the program, you'll notice that adding an entire month may not necessarily return the same value as adding 30 days would, even if the month has only 30 days. This is because of the way RPG IV handles the addition and subtraction of dates. It does this to prevent invalid dates. Consider this example: Add one month to January 31, and you get February 28 (or February 29 if it's a leap year). However, if you add 30 days to January 31, you end up with a date of March 2.

Use this little program as a guideline the next time you need to perform date arithmetic.

— Shannon O'Donnell Senior Technical Editor

Midrange Computing

à **********************************************************************

* TO COMPILE:

*

* CRTBNDRPG PGM(xxx/ADDSUBR1) SRCFILE(xxx/QRPGLESRC)

*

*

à **********************************************************************

* This program demonstrates how to retrieve the current date,

* how to add one month to the current date, how to subtract

* one month from the current date, how to add 30 days to the

* current date, and how to subtract 30 days from the current date.

*

*

*

à **********************************************************************

HDATEDIT(*YMD)

D Current_Date S 8 0

D WorkDate S D DATFMT(*YMD)

* Retrieve current date

C Eval Current_Date = *Date

* Move Current Date to WorkDate

C Move Current_Date WorkDate

* Add 1 Month to WorkDate

C Adddur 1:*Months WorkDate

* Subtract 1 Month from WorkDate

C Subdur 1:*Months WorkDate

* Add 30 Days to WorkDate

C Adddur 30:*D WorkDate

* Subtract 30 days from WorkDate

C Subdur 30:*D WorkDate

C Eval *Inlr = *On

Figure 1: Use this RPG IV date arithmetic blueprint to make sure your dates come out like they're supposed to.

A Commanding Idea

Q: I have a CL that calls QCMDEXC to execute a command built as a string. If that command has an error, I get the CPF0001 from QCMDEXC, but the original CPF0001 sent by the command to QCMDEXC is still in the job log. I'd really like the job log to be clean, since I'm handling the error. How can I receive or remove that message sent to QCMDEXC (which is, of course, no longer on the call stack) when I don't have the message key and don't want to use RMVMSG CLEAR(*ALL) or *ALLINACT?

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

A: Use QCAPCMD instead of QCMDEXC. It returns the actual exception rather than the silly "command failed" exception that QCMDEXC returns.

— Derek Butland

Do It OR Else

Q: What is the equivalent of binary ORing in RPG? What is the result of ORing X'00000F' with another variable? What is the result of ORing X'F0F0' with another variable?

— Anonymous

A: RPG does not have a binary OR operator or function. Binary OR compares corresponding bits of two character strings from left to right. If a bit is on in either string, the corresponding bit is turned on in the resulting string. If both bits are off, the corresponding bit is turned off in the resulting string.

ORing X'00000F' with a five-digit packed decimal number ensures that that variable is positive. ORing X'F0F0' with a two-digit alpha field or zoned decimal number

ensures that the zone portion of each byte of the field is X'F'. This not only prevents a decimal data error in the field but also makes it a positive number.

— Ted Holt Senior Technical Editor

Midrange Computing

A: Use the following code to get the RPG equivalent of X=A OR B for 1-byte fields:

C* X = A OR B
C MOVE A X 1
C BITONB X

— Douglas Handy

A: To perform a bitwise inclusive OR of two strings, use the machine interface's (MI) _ORSTR function, as shown in Figure 2. This function, along with other bitwise functions, logarithms, copy and compare null-terminated strings, and translation functions, is documented in chapter 3 of the Machine Interface Functional Reference manual.

— Gene Gaunt Gene_Gaunt/This email address is being protected from spambots. You need JavaScript enabled to view it.

*===============================================================

* Demonstrate use of bitwise inclusive OR in RPG program

*===============================================================

* To compile:

*

* CRTRPGMOD MODULE(XXX/ORTEST) SRCFILE(XXX/QRPGLESRC) +

* DBGVIEW(*SOURCE)

* CRTPGM PGM(XXX/ORTEST) BNDDIR(QC2LE)

*

*===============================================================

D OR PR extproc('_ORSTR')
D Receiver * value
D Source_1 * value
D Source_2 * value
D Length 10I 0 value

D A s 4
D B s 4 inz(x'00F00F11')
D C s 4 inz(x'0001F044')
D

C* A = B OR C
C callp OR(%addr(A) : %addr(B) :
C %addr(C) : %size(A))

* Using the debugger, view variable A in hex: (eval a :x).

* A has the value X'00F1FF55'

C eval *inLR = *on

Figure 2: Use MI for bitwise OR.

Missing Anything?

We at my company made an interesting discovery recently. We had a client who had migrated from a CISC AS/400 to a RISC AS/400 running V4R4. This client also had an electronic data interchange (EDI) application running on an old DOS machine, and the EDI application required a file transfer from the AS/400 to process EDI data. In the past, we accomplished this by using the Copy to PC Document (CPYTOPCD) command. The strange thing was that, on the new RISC system, the CPYTOPCD and Copy from PC Document (CPYFRMPCD) commands weren't there! After much searching, we finally learned that these commands are available only if you install the OS/400 Licensed Program

OS/400—Host Servers. This licensed program comes standard as part of OS/400, so it was simple to load it from CD-ROM. As soon as we did that, we were back in business.

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

Know Your Limits

Q: I am on an AS/400 at V4R2 and keep getting an error whenever I try to add more than eight printer files to an RPGLE program. The files are all externally described, but when the program is compiled, it tells me that I cannot have more than eight printer files in the program. I thought there were no limitations to RPGLE printer files.

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

A: Actually, you are allowed only eight printer files per program. For more information, refer to chapter 14 of the ILE RPG for AS/400 Reference (SC09-2508-02) manual, which you can also find online at publib.boulder. ibm.com/cgi-bin/bookmgr/books/qb3agz03/3.3.

This link takes you right to the page that lists the limits (maxima) for each type of file you can have in an RPG IV program.

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

Editing Numbers in CL

Q: I have retrieved the number of records in a file and want to use that number in a message. Is there a way to move a number to text in CL?

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

A: If you want an edited number, there is an easy way. You can define a message in a message file and specify a message data field with a type of binary and a length of 2 or 4 bytes. (The maximum value of 2-byte binary numbers is 32,767; 4-byte binary numbers go up to 2,147,483,647.) In your CL program, define a 2- or 4-byte character value to contain the binary numeric value. Convert your decimal value to binary by using %bin. To test this, try the program shown in Figure 3.

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

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

/* To compile: */
/* */

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

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

PGM

DCL VAR(&BIN) TYPE(*CHAR) LEN(4)
DCL VAR(&DEC) TYPE(*DEC) LEN(9 0)

CRTMSGF MSGF(QTEMP/TESTMSG)

ADDMSGD MSGID(TST0000) MSGF(TESTMSG) MSG('Number is &1') FMT((*BIN 4))

CHGVAR VAR(&DEC) VALUE(100)

CHGVAR VAR(%BIN(&BIN)) VALUE(&DEC)

SNDPGMMSG MSGID(TST0000) MSGF(TESTMSG) MSGDTA(&BIN)

ENDPGM

Figure 3: Here's a handy way to edit variables in CL.

Invisible Passwords

Q: I have a command that contains an AS/400 password. I use Display Input (DSPINPUT) with a value of *NO for the password on the PARM statement of the command definition. However, when I wrap this command in a Submit Job (SBMJOB) command, my password is visible in the submitted job's job log. Is there a way to avoid this? By the way, I use data type *CHAR. Will this cover everyone's password?

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

A: The password value does not appear in the submitted job's job log if the job log runs under the QCMD routing entry program. The password value does appear in any job log running under a custom routing entry program, but you can remove it and other DSPINPUT(*NO) values by passing the message reference key of the request message to the Process Command (QCAPCMD) API's options control block. For example, the job log may first look like this:

CHGUSRPRF USRPRF(AAA) PASSWORD(BBB)

However, pass the message reference key to QCAPCMD API, and the job log will look like this:

CHGUSRPRF USRPRF(AAA) PASSWORD()

— Gene Gaunt Gene_Gaunt/This email address is being protected from spambots. You need JavaScript enabled to view it.

How Many Copies Do You Need?

Q: The number-of-copies option on my remote output queue doesn't work. How do I fix this?

— Anonymous

A: First, end the writer associated with the remote output queue. Then, use the Change Output Queue (CHGOUTQ) command and enter XAIX XAUTOQ on the Destinations option (DESTOPT) parameter. Finally, restart the writer.

— Bradley V. Stone www.bvstools.com

A Batch of Debugs

A good way to debug a program running within a batch job is to use a special routing program, such as the DEBUG program, the source for which is shown in Figure 4. Compile this program and then add a routing entry to your batch subsystem as shown in the program comments. To debug a program in batch, specify RTGDTA(DEBUG) on the Submit Job (SBMJOB) command. When you submit the job, you’ll receive a message on

your message queue that reads, “Waiting for reply to message on message queue QSYSOPR.”

Press Enter to leave the Display Messages screen. To find the list of jobs you’ve submitted, enter the Work with Submitted Job (WRKSBMJOB) command as follows:

WRKSBMJOB *JOB

The job you have just submitted is the last one, and you should see a status of MSGW indicating that a message is waiting to be answered. Enter 5 (Work with Job) and press Enter. Notice the job name, user, and number, which appear at the top of the display.

On a command line, enter the Start Service Job (STRSRVJOB) command as shown here and press Enter:

STRSRVJOB nnnnnn/uuuuu/jjjjj

In this command, nnnnnn is the job number, uuuuu is the user name, and jjjjj is the job name.

Now enter the Start Debug (STRDBG) command on a command line as follows and press Enter:

STRDBG ppppp

In this command, ppppp is the program name. You can also enter the following command:

STRDBG lllll/ppppp

In this instance, ppppp is the program name, and lllll is the library name. You should now be able to see your source code. Set one or more break points as you would if you were debugging this program interactively. Then reply to the message waiting on the system operator message queue with the value READY. The program will begin execution within your debug session.

When you exit the debugger, the job ends normally. Run the End Debug (ENDDBG) and End Service Program (ENDSRVPGM) commands to clean up.

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

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

/* Routing program for debugging programs running in batch. */

/* */

/* To install: */

/* Place this into a source member. */

/* Compile as an OPM CL program. */

/* CRTCLPGM PGM(QGPL/DEBUG) SRCFILE(QGPL/QCLSRC) */

/* Add a routing entry to your batch subsystem. */

/* ADDRTGE SBSD(QBATCH) SEQNBR(5005) CMPVAL(DEBUG) + */

/* PGM(QGPL/DEBUG) */

/* */

/* */

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

PGM

DCL VAR(&RPYVAL) TYPE(*CHAR) LEN(5)

BEGIN:

SNDUSRMSG MSG(‘Enter READY to start the job, or C to +

cancel.’) VALUES(READY C) DFT(NORPY) +

MSGTYPE(*INQ) TOUSR(*REQUESTER) +

MSGRPY(&RPYVAL)

IF (&RPYVAL *EQ ‘C’) THEN(GOTO END)

IF (&RPYVAL *NE ‘READY’) THEN(GOTO BEGIN)

QSYS/TFRCTL PGM(QSYS/QCMD)

RETURN

END:

ENDPGM

Figure 4: This routing program makes debugging in batch easier.

Also Read

The Power of Writing Code in a Low-Code Solution

TechTip: Let’s Have a Date, Part 2

Going off the Rails