A handy utility with a bit of REXX
Data areas are unique and useful AS/400 objects. They are used to pass data between programs or jobs. For example, a batch job passes information through a data area from program to program to keep track of the steps completed, in case the job aborts. If the job is restarted, the value found in the data area can allow the program to determine where it left off. Another use of the data areas is to store the next available key for an indexed file or the current version of a software product. One programmer told me that he thinks of them as objects to be used whenever a "one record" control file could be used. The difference here is that data areas require less programming effort.
No matter how you use data areas, you have probably found the need to change the information they contain from time to time. This is where a weakness appears--OS/400 has no Edit Data Area command. IBM gave us a Display Data Area (DSPDTAARA) command, a Retrieve Data Area (RTVDTAARA) command and a Change Data Area (CHGDTARA) command but provided no convenient way to edit a data area interactively; that is, presenting a panel that shows the contents of the data area and allows you to change it. There is an Edit Data Area (EDTDTAARA) command in the QUSRTOOL library, but it has some major limitations: it cannot edit a character data area with a length greater than 450 and it doesn't provide a template or any means of determining the relative position of the data in the data area.
So here it is, a better EDTDTAARA. The command only requires one parameter-- the qualified name of a character data area. Decimal data areas are not allowed. When you start the EDTDTAARA command, a panel will be presented displaying the first 1000 characters of the data area, the qualified data area name you submitted and its length (see 1).
So here it is, a better EDTDTAARA. The command only requires one parameter-- the qualified name of a character data area. Decimal data areas are not allowed. When you start the EDTDTAARA command, a panel will be presented displaying the first 1000 characters of the data area, the qualified data area name you submitted and its length (see Figure 1).
What makes this simple command quite useful is the input field at the top of the panel, "Start display at data area position." This input field allows you to specify the starting position within the data area from which you would like to display and/or change the data area. It eliminates the need for a scale template and the need for more than one panel when data area lengths are greater than 1000.
If you key a start location that is greater than the data area length, you will receive an error message on line 24 and the display will not reposition itself. Trying to determine the data area length caused me to use REXX for part of this utility.
I needed to know the data area length but had no direct way of getting it. You have probably seen part of my solution before when the only way to get information is through a spool file: create the output to a spool file, copy it to a database file and then read the database file to retrieve the data. I decided to use REXX, since it handles string manipulation so eloquently. REXX made it easy to determine what record in the file contained the data area length and then isolate the length and right-justify, zero-fill it. Look at the program DTA001RX in 4 and see how easily things can be done in REXX.
I needed to know the data area length but had no direct way of getting it. You have probably seen part of my solution before when the only way to get information is through a spool file: create the output to a spool file, copy it to a database file and then read the database file to retrieve the data. I decided to use REXX, since it handles string manipulation so eloquently. REXX made it easy to determine what record in the file contained the data area length and then isolate the length and right-justify, zero-fill it. Look at the program DTA001RX in Figure 4 and see how easily things can be done in REXX.
Since REXX is interpreted, it's slow--but fast enough for this situation. Who knows? Maybe IBM will someday make REXX a compiled language like it is on mainframes. I hope so.
I encourage you to look at the Procedures Language 400/REXX Programmer's Guide manual (SC24-5552) and the Procedures Language 400/REXX Reference manual (SC24-5553) and A Look at REXX, October 1991, MC to learn more about REXX.
To get this utility ready to use, key the source members in Figures 2 through 6 or download them from OpenBBS. Compile the members in 2, 3, 5 and 6 according to the instruction at the bottom each each figure.
Edit Character Data Areas Interactively
Figure 1 The EDTDTAARA display F3=Exit F5=Refresh F19=Save with changes
Edit Character Data Areas Interactively
Figure 2 Command EDTDTAARA
EDTDTAARA: CMD PROMPT('Edit Data Area') PARM KWD(DTAARA) TYPE(Q1) SNGVAL((*LDA) (*GDA)) + MIN(1) PROMPT('Data area') Q1: QUAL
TYPE(*NAME) LEN(10) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
Edit Character Data Areas Interactively
Figure 3 CL program DTA001CL
DTA001CL: + PGM PARM(&DTAARA) DCL VAR(&FILLER) TYPE(*CHAR) LEN(1) VALUE(X'1F') DCL VAR(&DTAARA) TYPE(*CHAR) LEN(20)
DCL
VAR(&DTAARADTA) TYPE(*CHAR) LEN(2000) DCL VAR(&DTAARALIB) TYPE(*CHAR) LEN(10) DCL VAR(&DTAARANAME) TYPE(*CHAR) LEN(10)
DCL VAR(&DTAARALN) TYPE(*CHAR) LEN(21) DCL VAR(&DTAARALEN) TYPE(*DEC) LEN(4 0) DCL VAR(&DTAQDTA) TYPE(*CHAR) LEN(5)
DCL VAR(&MSG) TYPE(*CHAR) LEN(80) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(80) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&RTNCDE) TYPE(*CHAR) LEN(1)
DCL VAR(&QRTNCDE) TYPE(*CHAR) LEN(1) DCL VAR(&REXXLIB) TYPE(*CHAR) LEN(10) MONMSG MSGID(CPF0000)
EXEC(GOTO CMDLBL(ERROR)) /* Separate data area name and library */ CHGVAR VAR(&DTAARANAME) VALUE(%SST(&DTAARA 1 10))
CHGVAR VAR(&DTAARALIB) VALUE(%SST(&DTAARA 11 10)) CHGVAR VAR(&DTAARALN) VALUE(&DTAARALIB *BCAT &DTAARANAME)
IF COND(&DTAARANAME *NE '*LDA' *AND &DTAARANAME *NE '*GDA') + THEN(DO) /* Check for existence of user data area */
CHKOBJ OBJ(&DTAARALIB/&DTAARANAME) OBJTYPE(*DTAARA) /* Get library in which this program resides and use it to + find the
REXX procedure */ RTVOBJD OBJ(DTA001CL) OBJTYPE(*PGM) RTNLIB(&REXXLIB) STRREXPRC SRCMBR(DTA001RX)
SRCFILE(&REXXLIB/QREXSRC) + PARM(&DTAARALN) CALL PGM(QREXQ) PARM(P &DTAQDTA X'00000005' X'0000' &QRTNCDE)
IF COND(%SST(&DTAQDTA 1 1) *NE 'C') THEN(DO) CHGVAR VAR(&MSGDTA) VALUE('Data area must be type character')
SNDPGMMSG MSGID(CPF9898) MSGF(*LIBL/QCPFMSG) + MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE) GOTO CMDLBL(ENDPGM)
ENDDO CHGVAR VAR(&DTAARALEN) VALUE(%SST(&DTAQDTA 2 4)) ENDDO ELSE CMD(DO) IF COND(&DTAARANAME *EQ '*LDA')
THEN(CHGVAR VAR(&DTAARALEN) + VALUE(1024)) ELSE CMD(CHGVAR VAR(&DTAARALEN) VALUE(512)) ENDDO /
* Get current value of data area */ IF COND(%SST(&DTAARANAME 1 1) *EQ '*') THEN(DO) RTVDTAARA DTAARA(&DTAARANAME)
RTNVAR(&DTAARADTA) ENDDO ELSE CMD(DO) IF COND(&DTAARALIB *EQ ' ') THEN(CHGVAR VAR(&DTAARALIB) + VALUE(*LIBL))
IF COND(&DTAARALIB *EQ '*LIBL') THEN(RTVOBJD + OBJ(*LIBL/&DTAARANAME) OBJTYPE(*DTAARA) RTNLIB(&DTAARALIB))
IF COND(&DTAARALIB *EQ '*CURLIB') THEN(RTVJOBA + CURLIB(&DTAARALIB)) RTVDTAARA DTAARA(&DTAARALIB/&DTAARANAME)
RTNVAR(&DTAARADTA) ENDDO /* Call RPG program to allow edit of data area */ RETRY: + CALL PGM(DTA001RG) PARM(&DTAARADTA
&MSG
&FILLER &DTAARALIB + &DTAARANAME &DTAARALEN &RTNCDE) /* If return code is 1, update the data area with the new value. +
If an error is found on the update, trap it and send it to + the RPG program */ IF COND(&RTNCDE *EQ '1') THEN(DO)
IF COND(%SST(&DTAARANAME 1 1) *EQ '*') THEN(DO) CHGDTAARA DTAARA(&DTAARANAME *ALL) VALUE(%SST(&DTAARADTA 1 +
&DTAARALEN)) MONMSG MSGID(CPF0000) EXEC(DO) RCVMSG MSG(&MSG) GOTO CMDLBL(RETRY) ENDDO ENDDO ELSE CMD(DO)
CHGDTAARA DTAARA(&DTAARALIB/&DTAARANAME) + VALUE(%SST(&DTAARADTA 1 &DTAARALEN)) MONMSG MSGID(CPF0000)
EXEC(DO) RCVMSG MSG(&MSG) GOTO CMDLBL(RETRY) ENDDO ENDDO ENDDO /* Return point for normal end of job */ RETURN /*
Return point for abnormal end of job. Trap errors and send + them to the calling program */ ERROR: + RCVMSG MSGTYPE(*EXCP)
MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + MSGFLIB(&MSGFLIB) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF)
MSGDTA(&MSGDTA) + MSGTYPE(*ESCAPE) ENDPGM: + ENDPGM
Edit Character Data Areas Interactively
Figure 4 REXX program DTA001RX
/* get data area information */ parse arg lib dtaara 'ovrprtf file(qpdspdta) hold(*yes)' 'dspdtaara dtaara(&lib/&dtaara) output(*print)'
'crtpf file(qtemp/splf)
rcdlen(132)' 'cpysplf file(qpdspdta) tofile(qtemp/splf) splnbr(*last)' 'dltsplf file(qpdspdta) splnbr(*last)' 'ovrdbf file(stdin) tofile(qtemp/splf)'
do forever parse pull linein /* get data area type */ parse var linein 'Type' stmtrmd if (pos('*CHAR', stmtrmd,1) > 0)
then type = 'C' if (pos('*DEC', stmtrmd,1) > 0) then type = 'D' if (pos('*LGL', stmtrmd,1) > 0) then type = 'L' /*
get length and decimal positions */
if (pos(': LEN', linein,1) > 0) then do parse var linein junk ': LEN' len dec leave end end /* right justify number */
len = right(len,4,'0') typelen = type len typelen = space(typelen,0) /* place type and length on to rexx queue */ push typelen return
Edit Character Data Areas Interactively
Figure 5 Display file DTA001DF
A DSPSIZ(24 80 *DS3) A PRINT A CF03(03 'Exit') A CF05(05 'Refresh') A CF19(19 'Save with changes')
A R SCRN1 A BLINK A PGMNAM 10A O 1 2 A 1 24'Edit Data Area' A DSPATR(HI) A DANAME 21A O 1 39DSPATR(HI)
A 1 72DATE A EDTCDE(Y) A 2 35'Length' A DALEN 4Y 0O 2 42EDTCDE(3) A 2 72TIME A 5 2'Start display at data area positio- A n:'
A POS 4D 0B 5 40DSPATR(HI) A DSPATR(UL) A CHANGE(30 'Indicates this input fie- A ld has been changed') A DINOUT 1000A B 7 1
A 30 DSPATR(PC) A CHECK(LC) A 23 2'F3=Exit F5=Refresh F19=Save wi- A th changes' A COLOR(BLU) A MSG79 79A O 24 1DSPATR(HI)
Edit Character Data Areas Interactively
Figure 6 RPG program DTA001RG
FDTA001DFCF E WORKSTN * E M 1 1 79 E UP 2000 1 E FLR 1000 1 * IDIN DS I 12000 UP IDINOUT DS 1000 IDSAV DS 2000
IMSG DS 80 I 1 79 MSG79 I SDS I *PROGRAM PGMNAM * C MOVELDIN DINOUT C Z-ADD1 POS * C 1 DOWEQ1 C MOVEAUP DSAV
C ERROR IFEQ 'N' C Z-ADDPOS PSV 50 C ENDIF C EXFMTSCRN1 C POS IFEQ *ZERO C Z-ADD1 POS C ENDIF C MOVE *BLANKS MSG79
C MOVE 'N' ERROR * CANCEL C *IN03 IFEQ *ON C LEAVE C ENDIF * C MOVEADINOUT UP,PSV * REFRESH DISPLAY C *IN05 IFEQ *ON
C MOVELDSAV DINOUT C ITER C ENDIF * UPDATE DATA AREA C *IN19 IFEQ *ON C MOVE '1' RTNCOD C MOVEADINOUT UP,POS C LEAVE
C ENDIF * REPOSITION DISPLAY C *IN30 IFEQ *ON C POS IFGT DALEN C MOVE 'Y' ERROR C MOVE *OFF *IN30 C MOVE M,1 MSG79
C ELSE C MOVE FILLER FLR C MOVEAFLR DINOUT C MOVEAUP,POS DINOUT C ENDIF C ITER C ENDIF C ENDDO * C MOVE *ON *INLR
*================================================================
C *INZSR BEGSR
C *ENTRY PLIST C PARM DIN C PARM MSG 80 C PARM FILLER 1 C PARM DALIB 10 C PARM DANAM 10 C PARM DALEN 40
C PARM RTNCOD 1 C EXSR PAD C MOVE *BLANK RTNCOD C MOVE 'N' ERROR 1 C DALIB IFGT *BLANKS C DALIB CAT '/':0 DANAME
C END C DANAME CAT DANAM:0 DANAME C ENDSR
*================================================================
C PAD BEGSR C DALEN ADD 1 N 50 C N DO 2000 W 50 C MOVE FILLER UP,W C ENDDO C ENDSR
*================================================================
** Position is greater than data area length
Ted Holt is IT manager of Manufacturing Systems Development for Day-Brite Capri Omega, a manufacturer of lighting fixtures in Tupelo, Mississippi. He has worked in the information processing industry since 1981 and is the author or co-author of seven books.
MC Press books written by Ted Holt available now on the MC Press Bookstore.
 |
||
 |
|
Complete CL: Fifth Edition Become a CL guru and fully leverage the abilities of your system. List Price $79.95 Now On Sale
|
|
||
 |
|
Complete CL: Sixth Edition Now fully updated! Get the master guide to Control Language programming. List Price $79.95
Now On Sale
|
|
||
 |
|
IBM i5/iSeries Primer Check out the ultimate resource and “must-have” guide for every professional working with the i5/iSeries. List Price $99.95 Now On Sale
|
|
||
 |
|
Qshell for iSeries Check out this Unix-style shell and utilities command interface for OS/400. List Price $79.95
Now On Sale
|
More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.
TRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now! Request Now.
Forms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.
Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:
Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.
IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn:
LATEST COMMENTS
MC Press Online