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
LATEST COMMENTS
MC Press Online