Nice Date, Wrong Century!

Does the code in Figure 1 look familiar by now? If so, maybe you have the same exposure to an inaccurate date that we had. This code does a great job of checking for month 13, day 32, etc., but the year range may be a bit larger than most of our applications are expecting. For example, 1066- 10-14 (Battle of Hastings) and 1492-10-12 (Columbus’ arrival to America) also pass the edit check of TEST(D):

IBM does draw the line at year 0001. But, for most of us, something like Figure 2 may be a better test when validating 8-digit dates.

— Skip Forster ACS Healthcare Services Consultant to Cook Children’s Hospital, Fort Worth

Converting Case in CL

Converting the case of character data when you’re writing RPG code is a pretty simple task. Just use the XLATE op code to convert uppercase to lowercase and vice versa. But what if you’re coding a CL program and you need to convert the case of character data?

One option would be to call an RPG program, pass it the data to be converted, and let it use the XLATE function to convert the data for you. However, that method adds an unnecessary step.

Another option is to call API QDCXLATE, but the use of that API requires the existence of a table object (*TBL) describing the conversion to be performed; if you’re converting to uppercase, you can use IBM-supplied table QSYSTRNTBL, but there’s no IBM-supplied table for converting to lowercase.

Instead of using either of those problematic methods, use the Convert Case (QLGCNVCS) API to convert the case data from within your CL program, or, better yet, use our Convert Case (CVTCASE) utility command (see Figure 3), whose CPP (Figure 4)

invokes the API. Using the command is easy, because you don’t have to remember the API’s parameters.

The API uses five parameters: Control Block, Input Data, Output Data, Data Length, and Error Parameter.

• The Control Block parameter consists of the following:

Type of Request—This is a 1-byte character field that specifies the input format of the data to be converted. A value of 1 tells the API to use the CCSID as the data format, 2 tells the API to use a Table Object as the data format, and 3 tells the API to use a user- defined format for the data. The value you place in this field controls what you put in the rest of the Control Block. In this example, I am using the CCSID, or value 1.

To see how the other types of data formatting work (i.e., Table Data and User Defined) in the Control Block parameter, read chapter 13, section 1 of the System API Reference Manual.

CCSID—This is a 4-byte binary field that specifies which CCSID to use. A value of 0 here tells the API to use the CCSID of the job running this command. You may also enter any valid CCSID in this field.

Case Request—This 4-byte binary field tells the API in which direction to convert the data, either lowercase to uppercase or uppercase to lowercase. A value of 0 tells the API to convert lower-case data to uppercase while a value of 1 tells the API to convert the uppercase data to lowercase.

Reserved—The last field you’ll need is a 10-byte character field that you must set to hexadecimal zeros.

• The Input Data parameter is the data you want converted, and you can pass it a length of up to 16,773,104 bytes.

• The Output Data parameter will contain the converted data when the API finishes. Make sure you define this as long enough to hold the data returned from the Input Data parameter. Otherwise, your data will be truncated when returned.

• The Length of Input Data parameter is a 4-byte binary field that tells the API how long the Input Data parameter is. Don’t confuse this with the actual number of characters to be converted. You can pass embedded blanks to the API, and it will ignore them. For example, you may have only 50 characters to convert, but your input string may be 69 characters long because of the embedded blanks.

• The Error parameter is the standard API error parameter. You must initialize the bytes provided (&BYTE_PRV) field with a value that specifies how many bytes you are passing in this error parameter. If the API returns an error, the bytes available (&BYTE_AVL) field will contain something other than zero. For more information on the standard API error parameter, check out the System API Reference Manual, chapter 1, section 2.1.

All binary variables are coded in the CL program as character variables. The decimal representation of the number is then passed in its hexadecimal format. This format is required for passing binary data as a parameter. This process requires that you create your character variable with a length of twice the size required for the binary field. For example, if you need to pass a field that has a length of binary four, you would define a character variable with a length of eight. You then place the hexadecimal representation of the decimal value into this field, left padded with zeros. In this example, the &BYTE_PRV field needs to pass a value of decimal 272, which translates to hexadecimal 110 (1 x 256 + 1 x 16 + 0 = 272).

To use the CVTCASE command, you need to have utility command FWDPGMMSG already installed (see “How to Forward Messages in CL,” MC, January 1998).

In your CL program, you could code the following:

CVTCASE INPUT(&NAME) +

CONVERT(*UPPER) +

OUTPUT(&NEWNAME)

After the above statement, variable &NEWNAME contains the same value as &NAME, but in uppercase. You have to declare &NEWNAME as a character variable of 2,000 bytes. The prompter will remind you of this fact.

— Shannon O’Donnell This email address is being protected from spambots. You need JavaScript enabled to view it.

— Ernie Malaga Senior Technical Editor Midrange Computing

Calling Native Programs from a S/36 Program

Q: I am trying to call the Send to Data Queue (QSNDDTAQ) API from a S/36 RPG II program, but it’s not working. I believe the problem is with one of my parameters, but I can’t tell for sure. Can you find the problem?

A: S/36 RPG programs pass numeric parameters in zoned decimal format. Your problem is that your program is passing zoned decimal data into the third parameter of QSNDDTAQ, which should be five digits, packed decimal. S/36 programs do not have a way to pack variables.

I ran into a similar situation a few years back in my consulting practice. I wrote a program NBR011RG to handle the needed data conversion (see Figure 5). It’s far from rocket science, but it does the job.

Call NBR011RG from your RPG II program, passing it the following parameters:
• A zoned decimal variable
• The length (number of digits) in the zoned number
• A character variable the same size (in bytes) as the packed variable needs to be
• A 1 to deactivate NBR011RG, or a 0 to leave it active. NBR011RG will return a packed value in the third parameter. Pass this as a character variable, instead of a numeric variable, to QSNDDTAQ. Since QSNDDTAQ’s third parameter is fivc digits long, you’ll need to pass a 3-byte character variable to NBR011RG and QSNDDTAQ. Look for that program in next month’s “Tech Talk.”

— Ted Holt Senior Technical Editor Midrange Computing

Restoring the Free User Tools to a RISC system

You may have noticed that QUSRTOOL is not what it used to be. The TAATOOL portion has been removed, and other tools have been added.

If you bring the old QUSRTOOL library from a CISC machine to a RISC machine, you won’t be able to recreate the tools using the old methods. Here’s what you’ll have to do to recreate the tools:

1. Save the library QUSRTOOL library to tape on your CISC machine.
2. Restore library QUSRTOOL to some other library name on the RISC machine. I call it QUSRTOOLV3 in this example.

3. Create the libraries QUSRTOOL and TAATOOL.

4. If you want a copy of the QATTINFO source file in QUSRTOOL, copy it from QUSRTOOLV3. This is not required.

5. The source files in the original QUSRTOOLV3 library are save files. Restore them to the QUSRTOOL library, using the commands in Figure 6.

6. Compile member TAATOLAC in QUSRTOOL/QATTCL into library TAATOOL. This will provide the code necessary to create the user tools.

CRTCLPGM PGM(TAATOOL/TAATOLAC) +

SRCFILE(QUSRTOOL/QATTCL)
7. Do not use the CRTTAATOOL *ALL command. There are some tools that will not create, and there is no restart command when one fails. The entire process comes to an end. Instead, display the member description of QATTINFO file to a data base file, and loop through all members in a CL program, creating them one at a time. (See Figure 7.)

Notice that I created these tools with observability to aid in moving them to other RISC boxes if the need exists. I also did not compress the objects, for the same purpose. Monitoring for CPF9898 after the CRTTAATOOL command will trap when a member name does not equate to a tool (such as the member AAAAREADME).

When I created the tools, there were three that failed—JOBSCH, PRTPRM, and SAVWHLACT. I did not use these three tools, so I saved researching the problem until I needed one of them. When you receive an error message, simply take option I to ignore the message and continue.

— Tim Johnston Manager of Information Systems Hapco, a Kearney National Inc., Company

Hot New AS/400 Toolbox for Java!

IBM has done a great job with the newest version of the AS/400 Toolbox for Java (jt400). Now in beta, jt400 modification 1 is available for downloading at http://iws. as400.ibm.com/toolbox/welcome.htm. This latest version includes many enhancements:

• Direct access to AS/400 user spaces
• Access to digital certificates stored on the AS/400
• Job listing capabilities
• Access to AS/400 message queues
• User listing capabilities
• Access to files in the AS/400 Integrated File System (IFS)
• AS/400 print resources Jt400 also contains a set of classes that are built on top of JFC’s JTable component and associated classes to simplify the creation of forms and tables (subfiles). (For more information about grids, see “Grids: Subfiles for Java Programmers,” MC, April 1998.)

IBM AS/400 Toolbox for Java Modification 1 Beta 1 also contains a set of components that improve the performance of the Toolbox classes running on the AS/400’s JVM. Performance is improved by bypassing the network-based server processing where appropriate and directly invoking AS/400 APIs.

— Don Denoncourt Senior Technical Editor Midrange Computing

C* * HiLoEq

C *ISO TEST(D) DATE80 30

C *IN30 IFEQ *ON C *ISO TEST(D) DATE80 30

C *IN30 IFEQ *ON

C DATE80 ORLT 18000000 /*===================================================================*/

/* To compile: */
/* */

/* CRTCMD CMD(XXX/CVTCASE) PGM(XXX/CAS001CL) + */
/* SRCFILE(XXX/QCMDSRC) TEXT(‘Convert Case’) +*/
/* ALLOW(*IPGM *BPGM *IMOD *BMOD) */
/* */

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

CMD PROMPT(‘Convert Case’)

PARM KWD(INPUT) TYPE(*CHAR) LEN(2000) MIN(1) +

EXPR(*YES) PROMPT(‘Input string’)

PARM KWD(CONVERT) TYPE(*CHAR) LEN(6) RSTD(*YES) +

DFT(*UPPER) VALUES(*UPPER *LOWER) +

PROMPT(‘Conversion option’)

PARM KWD(OUTPUT) TYPE(*CHAR) LEN(2000) +

RTNVAL(*YES) PROMPT(‘Output string (2000A)’) /*===================================================================*/

/* To compile: */
/* */

/* CRTCLPGM PGM(XXX/CAS001CL) SRCFILE(XXX/QCLSRC) + */
/* TEXT(‘CPP for CVTCASE command’) */
/* */

/* Prerequisite: */
/* FWDPGMMSG utility command (see January 1998 issue). */
/* */

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

PGM PARM(&INPUT &CONVERT &OUTPUT)

DCL VAR(&CONVERT) TYPE(*CHAR) LEN(6)

DCL VAR(&CTLBLK) TYPE(*CHAR) LEN(22)

DCL VAR(&ERRPARM) TYPE(*CHAR) LEN(8) +

VALUE(X’0000000000000000’)

DCL VAR(&INPUT) TYPE(*CHAR) LEN(2000)

DCL VAR(&INPUTLEN) TYPE(*CHAR) LEN(4)

DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(2000)

MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR))

/* Build options control block */

CHGVAR VAR(%SST(&CTLBLK 1 4)) VALUE(X’00000001’)

CHGVAR VAR(%SST(&CTLBLK 5 4)) VALUE(X’00000000’)

IF COND(&CONVERT *EQ ‘*UPPER’) THEN(DO)

CHGVAR VAR(%SST(&CTLBLK 9 4)) VALUE(X’00000000’)

ENDDO

ELSE CMD(DO)

CHGVAR VAR(%SST(&CTLBLK 9 4)) VALUE(X’00000001’)

ENDDO

CHGVAR VAR(%SST(&CTLBLK 13 10)) +

VALUE(X’00000000000000000000’)

/* Convert string */

CHGVAR VAR(%BIN(&INPUTLEN)) VALUE(2000)

CALL PGM(QLGCNVCS) PARM(&CTLBLK &INPUT &OUTPUT +

&INPUTLEN &ERRPARM)

RETURN

ERROR:

FWDPGMMSG

Figure 1: This code tests for valid dates but isn’t adequate for robust applications

Figure 2: This code tests for valid dates and restricts the range of permitted dates

Figure 3: Example of using the Convert Case API

MONMSG MSGID(CPF0000)

ENDPGM *===============================================================

* To compile:

*

* CRTRPGPGM PGM(XXX/NBR011RG) SRCFILE(XXX/QRPGSRC)

*

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

* Convert a zoned decimal number to packed decimal.

* This program is meant to be called by S/36 RPG II programs,

* but must be compiled as an RPG III program.

*

* Parameter list

* Name Length Description

* ZONED * any zoned decimal value

* ZONELN 2,0 length of ZONED as a 2-digit zoned number

* PACKED * defined as character in RPG II caller

* must be defined as the length of ZONED

* when packed

* SETLR 1 ‘1’ sets on LR indicator, unloading this

* program from memory

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

IZONED DS

I 1 10ZONE01

I 1 20ZONE02

I 1 30ZONE03

I 1 40ZONE04

I 1 50ZONE05

I 1 60ZONE06

I 1 70ZONE07

I 1 80ZONE08

I 1 90ZONE09

I 1 100ZONE10

I 1 110ZONE11

I 1 120ZONE12

I 1 130ZONE13

I 1 140ZONE14

I 1 150ZONE15

I 1 160ZONE16

I 1 170ZONE17

I 1 180ZONE18

I 1 190ZONE19

I 1 200ZONE20

I 1 210ZONE21

I 1 220ZONE22

I 1 230ZONE23

I 1 240ZONE24

I 1 250ZONE25

I 1 260ZONE26

I 1 270ZONE27

I 1 280ZONE28

I 1 290ZONE29

I 1 300ZONE30

IPACKED DS

I P 1 10PACK01

I P 1 20PACK03

I P 1 30PACK05

I P 1 40PACK07

I P 1 50PACK09

I P 1 60PACK11

I P 1 70PACK13

I P 1 80PACK15

I P 1 90PACK17

I P 1 100PACK19

I P 1 110PACK21

I P 1 120PACK23

I P 1 130PACK25

I P 1 140PACK27

I P 1 150PACK29

I P 1 160PACK31

IZONELN DS

I 1 20ZL

C *ENTRY PLIST

C PARM ZONED

C PARM ZONELN

C PARM PACKED

Figure 4: CPP for CVTCASE command

C PARM SETLR 1

C*

C SELEC

C ZL WHEQ 1

C Z-ADDZONE01 PACK01

C ZL WHEQ 2

C Z-ADDZONE02 PACK03

C ZL WHEQ 3

C Z-ADDZONE03 PACK03

C ZL WHEQ 4

C Z-ADDZONE04 PACK05

C ZL WHEQ 5

C Z-ADDZONE05 PACK05

C ZL WHEQ 6

C Z-ADDZONE06 PACK07

C ZL WHEQ 7

C Z-ADDZONE07 PACK07

C ZL WHEQ 8

C Z-ADDZONE08 PACK09

C ZL WHEQ 9

C Z-ADDZONE09 PACK09

C ZL WHEQ 10

C Z-ADDZONE10 PACK11

C ZL WHEQ 11

C Z-ADDZONE11 PACK11

C ZL WHEQ 12

C Z-ADDZONE12 PACK13

C ZL WHEQ 13

C Z-ADDZONE13 PACK13

C ZL WHEQ 14

C Z-ADDZONE14 PACK15

C ZL WHEQ 15

C Z-ADDZONE15 PACK15

C ZL WHEQ 16

C Z-ADDZONE16 PACK17

C ZL WHEQ 17

C Z-ADDZONE17 PACK17

C ZL WHEQ 18

C Z-ADDZONE18 PACK19

C ZL WHEQ 19

C Z-ADDZONE19 PACK19

C ZL WHEQ 20

C Z-ADDZONE20 PACK21

C ZL WHEQ 21

C Z-ADDZONE21 PACK21

C ZL WHEQ 22

C Z-ADDZONE22 PACK23

C ZL WHEQ 23

C Z-ADDZONE23 PACK23

C ZL WHEQ 24

C Z-ADDZONE24 PACK25

C ZL WHEQ 25

C Z-ADDZONE25 PACK25

C ZL WHEQ 26

C Z-ADDZONE26 PACK27

C ZL WHEQ 27

C Z-ADDZONE27 PACK27

C ZL WHEQ 28

C Z-ADDZONE28 PACK29

C ZL WHEQ 29

C Z-ADDZONE29 PACK29

C ZL WHEQ 30

C Z-ADDZONE30 PACK31

C ENDSL

C*

C SETLR IFEQ ‘1’

C SETON LR

C ENDIF

C*

C RETRN RSTOBJ OBJ(QUSRTOOL/QATTCL) SAVLIB(QUSRTOOL) +
SAVF(QUSRTOOLV3/QATTCL) RSTLIB(QUSRTOOL)
RSTOBJ OBJ(QUSRTOOL/QATTRPG) SAVLIB(QUSRTOOL) +

SAVF(QUSRTOOLV3/QATTRPG) RSTLIB(QUSRTOOL)
RSTOBJ OBJ(QUSRTOOL/QATTDDS) SAVLIB(QUSRTOOL) +

Figure 5: This RPG III program allows RPG II programs to pass packed-decimal parameters to other programs

SAVF(QUSRTOOLV3/QATTDDS) RSTLIB(QUSRTOOL)
RSTOBJ OBJ(QUSRTOOL/QATTCMD) SAVLIB(QUSRTOOL) + SAVF(QUSRTOOLV3/QATTCMD) RSTLIB(QUSRTOOL)

CREATETAA:
PGM

DCLF FILE(QAFDMBRL)

DSPFD FILE(QUSRTOOLV3/QATTINFO) TYPE(*MBRLIST) +

OUTPUT(*OUTFILE) OUTFILE(QTEMP/DSPFD)

OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/DSPFD)
RCV:

RCVF

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

CRTTAATOOL TOOL(&MLNAME) CRTFILLIB(QTEMP) RMVOBS(*NO) +

ALWRTVSRC(*YES) CPROBJ(*NO)

MONMSG MSGID(CPF9898)

GOTO CMDLBL(RCV)
END:

ENDPGM

Figure 6: Use these commands to restore the QUSRTOOL tools

Figure 7: This program recreates tools from QUSRTOOL on RISC systems

Also Read

The Power of Writing Code in a Low-Code Solution

TechTip: Let’s Have a Date, Part 2

Going off the Rails