The More Digits, the Merrier

Q: I have a calculation that requires field lengths of more than 30 digits. Unfortunately, RPG IV allows up to only 30 digits for a numeric field definition. Is there any way to get around this?

— Premkumar Hexaware InfoSystems Ltd.

Chennai, India

A: If you need more than 30 digits of precision, try using REXX instead of RPG IV. REXX allows you to set the precision for numeric calculation via the NUMERIC DIGITS command. Using this command, you can make the size of the numeric field as large as you need. If you need to handle only very large or very small numbers and 17 or so digits of precision is enough, define your RPG IV numeric field as a floating point field on the D- spec:

D Numeric_Fld S 8f

Note: Floating point fields are supported only on V3R7 and above.

— Barbara Morris

IBM Toronto Lab RPG Compiler Development

In That CASE...

SQL-based conditional processing was added to DB2 UDB for AS/400 in V4R2 with the SQL CASE expression. However, Query/400 can use the SQL CASE expression indirectly to perform conditional processing in a Query/400 report. The idea is to create an SQL view that uses CASE to perform the necessary conditional processing. The SQL Create View statement creates a logical file that can then be referenced in your Query/400 definition.

Figure 1 shows how to use CASE to determine different vehicle license fees conditionally. The SQL Create View statement can be executed in any SQL interface, such as an AS/400 or PC client communicating with the AS/400. Once you’ve created the new

view, start a Query/400 session, create a new query, and specify the name of the new view as the file to be queried (in this case, “Licview,” which was created in library “mylib”).

— Kent Milligan

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

CREATE VIEW mylib/licview (license,licfee) AS

SELECT license,

CASE type WHEN 'Car' THEN 0.05 * weight

WHEN 'Truck' THEN 75 * nbr_wheels

WHEN 'Motorcyle' THEN 35.00 END

FROM vehicles

Figure 1: Use SQL to create a view that can then be queried by Query/400.

End Your Applications on a Good Note

When you end certain TCP/IP applications such as the HTTP server, you need to be careful not to end someone else’s instance. For example, to end the HTTP application, you don’t really need to use ENDTCPSVR SERVER(*HTTP), because the default value of the HTTPSVR parameter is *ALL. Instead, end your instance this way:

ENDTCPSVR SERVER(*HTTP) +

HTTPSVR(your_instance_name)

— Bradley Stone Associate Technical Editor

Midrange Computing

— Richard Shaler Midrange Computing This email address is being protected from spambots. You need JavaScript enabled to view it.

Join Me in Updating This File

OS/400 V4R3 has a feature many of us have requested for a long time. With V4R3, it is possible to update data in one file with field-level data from another file. In other words, you can now update through a join. Figure 2 illustrates how it’s done.

— David Babashanian

ValueOptions Norfolk, Virginia

UPDATE DABLIB/MYRECON2 SET (SMIFLG, SEDFLG, ASSSMI, ASSSED) = (SELECT
SMIFLG, SEDFLG, ASSSMI, ASSSED FROM MHSFLA/CISINT WHERE CISINT.CLIENT =
MYRECON2.CLIENT AND CISINT.INTDAT = MYRECON2.INT

Figure 2: V4R3 updates through a join.

Getting Around the Rounding Problem

Q: I have an end-of-day report I created in Query/400 that summarizes inventory adjustments by type. The problem is that the adjustments are accurate to the penny, but the report displays only whole dollars. I’m afraid the numbers are inaccurate because the cents

aren’t being accumulated. Figure 3 shows how I defined the fields in Query/400 on the Define Result Fields screen.

The problem is that the first result field, CSTDLR, does not truncate the cost field but rounds it up when the cents are greater than or equal to 50. Can you show me how to write this result field definition so the cost number is truncated instead of rounded?

— Michael Daly

Senior P/A FreshPoint, Inc.

A: Define your field as 9.2 instead of 7.0. Then, go to field formatting and make it 7.0. That should take care of the rounding problem for you.

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

Field Expression Column Heading Len Dec
CSTDLR INCST Dollar Amount 7 0
CSTCNT INCST – CSTDLR Adjustment Amount 7 2

Figure 3: Note that cents are not accumulated on this Define Results Fields screen.

Looking to Move Your AS/400 Spool Files to the Web?

Here’s a handy little utility I created to do just that! It transforms your AS/400 spool files into HTML documents so they can be displayed in almost any Web browser! The utility consists of four objects:

• CRTHTM converts your spool files to HTML documents. Give this command your spool file information, such as your name and job information and (optionally) the name and email address of the person to contact if questions about the document arise.

• CTLHTMCL is the command-processing program for command CRTHTM. It ensures the spool file exists and copies its contents to a temporary file named REPORT in library QTEMP. It then calls RPG program CRTHTMRG, which reads the REPORT file and generates HTML code from the document. The resulting HTML code is written to a temporary file named REPORTH in library QTEMP. When the RPG program is finished, the CPP FTPs QTEMP/REPORTH to the client’s hard drive using the FTP instructions stored in text file FTPSCRIPT.

• CRTHTMRG (Figure 4) reads temporary file REPORT and converts its records to HTML code. The resulting records are written to file REPORTH in library QTEMP. The HTML commands

 and 

preserve the formatting of the report. If a user name and email address are entered on the command, they’re added to the bottom of the HTML document using the mailto: tag so the user’s default email program is displayed when this link is clicked.

• FTPSCRIPT is a source file member that tells the FTP where to send the document. You can modify this member as needed. For example, you may want to pass on to it the actual name of the spool file to be created.

Code for CRTHTM, CTLHTMCL, and FTPSCRIPT can be found on the Midrange Computing Web site at www.midrangecomputing.com/mc/99/08.

The new HTML document is generated onto a white background. You can dress up the document using HTML keywords. Here are some possibilities:
• Bgcolor changes background colors.
• Font-1 changes default fonts.
• Meta Tag allows searching inside or outside the document.

— Ray Welgosh

Computer Consultant, Palarco, Inc. This email address is being protected from spambots. You need JavaScript enabled to view it.

/title crthtmrg create html from a spool file

**************************************************************

* To Compile:

* CRTBNDRPG(xxx/CRTHTMRG) SRCFILE(xxx/QRPGLESRC) +

* SRCMBR(xxx/QRPGLESRC)

***************************************************************

fReport if f 140 disk

fReporth o f 150 disk

d Lit s 65 dim(2) ctdata perrcd(1)

d A s 1 dim(150)

d Ename s 30

d Fout s 150

d F65 s 65

d Rname s 30

ireport ns

i 1 3 0skip

i 4 4 0spcb

i 5 136 data

*

c read Report 90

c dow *in90 = *off

c if Spcb > 1

c exsr Space

c endif

c exsr Html

c read Report 90

c enddo

*

c if Rname <> *blanks

c exsr Blank

c exsr Blank

c exsr Email

c endif

*

c movel *blanks Fout

c movel '' Fout

c except $out

c movel *blanks Fout

c movel '' Fout

c except $out

c move *on *inlr

c return

**************************************************************

* initial subroutine

**************************************************************

c *inzsr begsr

c *entry plist

c parm Rname

c parm Ename

c movel *blanks Fout

c movel '' Fout

c except $out

c movel *blanks Fout

c movel '' Fout

c except $out

c movel *blanks Fout

c movea Lit(1) F65

c movel F65 Fout

c except $out

c endsr

***************************************************************

* blank - this will write out a blank line to conform with spcb

***************************************************************

c Blank begsr

c movel *blanks Fout

c movel '

' Fout
 c move '

c except $out

c endsr

*

***************************************************************

* space - this will calculate how many blank lines to print

***************************************************************

c Space begsr

c sub 1 Spcb

c do Spcb

c exsr Blank

c enddo

c endsr

***************************************************************

* html - this will create the line for html with the

 tag
 * the 
 keeps the white space for columns allignment
 ***************************************************************
 c Html begsr
 c movel *blanks Fout
 c movea *blanks A
 c movea '
' A(1)
 c movea Data A(6)
 c movea '
' A(138)
 c movea A(1) Fout
 c except $out
 c movel *blanks Fout
 c endsr
 ***************************************************************
 * email - this will create an line on the bottom of the report
 * with a email link for questions about the report
 ***************************************************************
 c Email begsr
 c movel *blanks Fout
 c movea *blanks A
 c movea Lit(2) A(1)
 c movea Ename A(60)
 c movea '">' A(90)
 c movea Rname A(92)
 c movea '' A(122)
 c movea '
' A(126)
 c movea A(1) Fout
 c except $out
 c movel *blanks Fout
 c endsr
 oReporth e $out
 o Fout 150
** Messages
For questions about this report email This email address is being protected from spambots. You need JavaScript enabled to view it.
****** Function Prototypes *******************************************
 * Center Function
D Center PR 32767 Opdesc
D Instring 32767 Const Options(*Varsize)
D OutLength 10I 0
 * Retrieve Operational Descriptors API
D CEEDOD PR
D ParmNum 10I 0 Const
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 10I 0
D 12A Options(*Omit)
P Center B Export
 * Procedure Interface
D Center PI 32767 Opdesc
D InString 32767 Const Options(*Varsize)
D OutLength 10I 0
 * Center Local Variables
D Offset s 5 0 Inz(*Zero)
D WrkString s 32767 Inz(*Blanks)
D OutString s 32767 Inz(*Blanks)
 **********************************************************************
 * Retrieve the true length of the *VARSIZE input string using
 * the retrieve operational desriptors API.
C Callp CEEDOD(1:DescType : DataType : DescInfo1
C :DescInfo2 : DataLen : *OMIT)
 * Extract the actual input string
C Eval WrkString = %Subst(InString:1:DataLen)
 * If the Output length is smaller the the Input String length
 * change the output length to the input length.
 * ( The string will be truncated. )
C If OutLength < %Len(%Trim(WrkString))
C Eval OutLength = %Len(%Trim(WrkString))
C Endif
 * Calculate the number of blanks needed on each side of the string
C Eval Offset = ( OutLengthC %Len(%Trim(WrkString))) / 2
 * Substring the input string to the center of the output string
C Eval %Subst(OutString:Offset + 1:
C %Len(%Trim(WrkString))) = %Trim(WrkString)
 * Return the centered string
C Return OutString
P Center
Figure 5: This method of centering text uses the OPDESC keyword on the D-spec.
Whoa, Whoa...Timeout!
My company’s system has the system value Inactive Job Timeout (QINACTITV) set to 30 minutes. We do this so, if a user walks away from the desk, we can automatically sign that user off. This works great except for those few terminals or user profiles we don’t want to log off automatically. To get around this problem, we developed a little routine to monitor for a specific message ID (CPI1126) to be placed on a message queue (see Figure 6). Message CPI1126 indicates that a job has not been active for a given amount of time. Buried within the text of the message is the name of the job that has exceeded the time limit specified in system value QINACTITV. The utility checks the job name, and if it matches a predetermined job (one we don’t want to log off automatically), we bypass the logoff. We can also exempt certain users from being caught by this system value. Otherwise, if it is any other interactive job, we issue the ENDJOB command for that terminal to log it off. You need to create a new message queue named INACTIVE and point the Inactive Message Queue (QINACTMSGQ) system value to use the new message queue rather than the default message queue, QSYSOPR. This cuts down on the number of messages you need to read because the only messages going into this queue are about jobs that are timing out.
— Larry Bolhuis This email address is being protected from spambots. You need JavaScript enabled to view it.
/***********************************************************/
/* To Compile: */
/* CRTCLPGM PGM(xxx/DEVTIMMON) + */
/* SRCFILE(xxx/QCLSRC) MBR(DEVTIMMON) */
/* */
/***********************************************************/
 PGM
 DCL &JOB *CHAR 10 /* Job(WSID) Name */
 DCL &JOBNO *CHAR 6 /* Job Number */
 DCL &KEYVAR *CHAR 4 /* Key Var for retrieving response*/
 DCL &MSG *CHAR 132 /* Message */
 DCL &MSGDTA *CHAR 100 /* Message Data */
 DCL &MSGDTALEN *DEC (5 0) /* Message Data Length */
 DCL &MSGID *CHAR 7 /* Message ID */
 DCL &RTNTYPE *CHAR 2 /* Returned Message Type */
 DCL &TYPE *CHAR 1 /* Job Type (0=Batch, 1=OnLine) */
 DCL &USER *CHAR 10 /* User ID */
 /* Retreive and assemble Required Job Attributes */
 /* Also assure this job * HAS * been submitted to batch. */
 RTVJOBA TYPE(&TYPE)
 IF (&TYPE *EQ '1') (GOTO END) /* Not a Batch Process */
 /* Put a low level lock on the message Q so no other copies of */
 /* This job will be started. */
 ALCOBJ OBJ((INACTIVE *MSGQ *EXCL)) WAIT(30)
 MONMSG CPF1002 EXEC(GOTO END) /* Already Active */
 ALCOBJ OBJ((INACTIVE *MSGQ *SHRRD)) WAIT(30)
 DLCOBJ OBJ((INACTIVE *MSGQ *EXCL))
 /* Change Inactive Message Handling to correct Message Queue */
 CHGSYSVAL SYSVAL(QINACTMSGQ) VALUE('INACTIVE QGPL ')
 /* Sit here until a message is recieved. */
 MAINLOOP: RCVMSG MSGQ(INACTIVE) MSGTYPE(*ANY) WAIT(900) +
 RMV(*YES) KEYVAR(&KEYVAR) MSG(&MSG) +
 MSGDTA(&MSGDTA) MSGDTALEN(&MSGDTALEN) +
 MSGID(&MSGID) +
 RTNTYPE(&RTNTYPE)
 /* Check to see what type of message was received from the Q */
 IF (&MSGID *EQ 'CPI1126') THEN(GOTO INACTJOB)
 GOTO MAINLOOP
 /* An Inactive Job was Detected. */
 /* Retreive and extract attributes of timed out job. */
INACTJOB: CHGVAR VAR(&JOB) VALUE(%SST(&MSGDTA 1 10))
 CHGVAR VAR(&USER) VALUE(%SST(&MSGDTA 11 10))
 CHGVAR VAR(&JOBNO) VALUE(%SST(&MSGDTA 21 6))
 DMPCLPGM
 /* DON'T CANCEL VRU JOBS */
 IF COND(%SST(&JOB 1 3) *EQ 'VRU') THEN(DO)
 GOTO MAINLOOP
 ENDDO
/* DON'T CANCEL CERTAIN USER JOBS */
/* ADD ALL USERS NECESSARY IN A SIMILAR IF LOOP BEFORE THE ENDJOB COMMAND */ IF COND(&USER *EQ 'TIM') THEN(DO)
 GOTO MAINLOOP
 ENDDO
 /* If this is not a job we want to keep active, end it. */
 ENDJOB JOB(&JOBNO/&USER/&JOB) OPTION(*IMMED) +
 LOGLMT(0)
 MONMSG CPF0000
 GOTO MAINLOOP
END: DLCOBJ OBJ((INACTIVE *MSGQ *SHRRD))
 CHGSYSVAL SYSVAL(QINACTMSGQ) VALUE('*ENDJOB')
 CHGSYSVAL SYSVAL(QINACTITV) VALUE('120')
 ENDPGM
Figure 6: This routine lets you keep specific jobs or specific users active while the system automatically ends others.
Use SBMJOB to Get More Sleep
If you use “canned” software packages, you know that functions sometimes need to be performed during off-peak hours. Unfortunately, some of these packages do not provide the means for scheduling the work. Either a job is submitted immediately via a menu option, or you must sign on at some bizarre hour to run the job.
Taking full advantage of the Submit Job (SBMJOB) command, however, can make your life much easier. SBMJOB has two parameters, Schedule date (SCDDATE) and Schedule time (SCDTIME), that allow you to control when a batch job runs. Here is an example of how I use the parameters to save time for more important things, such as golf.
On the last day of the month, one of our canned systems needs a month-end close. I go to the menu and make the selection, and the job is submitted to batch. Unfortunately, because this job takes several hours and requires a dedicated system, I have to sign on at 1:00 a.m. to run it. Using SBMJOB, I simply put the appropriate job queue on hold before taking the menu option. Next, I use Work with Job Queue (WRKJOBQ) to display all pending jobs and find the one I have submitted. Using option 2 (Change Job), I then change the schedule date and time parameters to 1:00 a.m. the following day. The job now sits in the job queue until the specified time it is to be submitted. This is a great technique for submitting batch jobs at your leisure and having them run at the optimal time.
— David Mayle This email address is being protected from spambots. You need JavaScript enabled to view it.