Which Programs Use a Module?
Q: How can I get a list of programs that have a particular *MODULE bound into them?
—Joe O’Hara
A: Use the Display Module Where Used (DSPMODWU) command. The source code needed to create it is in Figure 1. It drives the REXX procedure shown in Figure 2.
—Gene Gaunt
. . . . . . .
/*==================================================================*/
/* To compile: */
/* */
/* CRTCMD CMD(XXX/DSPMODWU) PGM(*REXX) + */
/* SRCFILE(XXX/QCMDSRC) + */
/* REXSRCFILE(XXX/QREXSRC) REXSRCMBR(DSPMODWURX) */
/* */
/*==================================================================*/
CMD PROMPT('Display Module Where Used')
PARM KWD(MOD) TYPE(*NAME) MIN(1) PROMPT('Module')
PARM KWD(LIBL) TYPE(*NAME) LEN(10) MIN(1) MAX(200) +
PROMPT('Libraries to be searched')
PARM KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) DFT(*) +
VALUES(* *PRINT) PROMPT('Output') /******************************************************************************/
Signal On Error
Arg 'MOD(' Module ')'
Arg 'LIBL(' List ')'
Arg 'OUTPUT(' Output ')'
If Output = '*PRINT' Then 'OVRPRTF FILE(STDOUT) TOFILE(QSYSPRT)'
"CALL QUSDLTUS ('LISTSPACE QTEMP' X'0000000800000000' ) "
"CALL QUSCRTUS ('LISTSPACE QTEMP' ' ' X'00001600' X'00' '*ALL' ' ' ) "
Api.1 = QBNLPGMI; Fmt.1 = PGML0100; Type.1 = 'program'
Api.2 = QBNLSPGM; Fmt.2 = SPGL0100; Type.2 = 'service program'
Do While List ' '
Parse Var List Item List
Do N = 1 To 2
Data = Copies( '00'x, 192 )
"CALL" Api.N "('LISTSPACE QTEMP' "Fmt.N" '*ALL "Item" ' X'00000000')"
"CALL QUSRTVUS ('LISTSPACE QTEMP' X'00000001' X'000000C0' &Data) "
Do X = Int( 125 ) + 1 For Int( 133 ) By Int( 137 )
"CALL QUSRTVUS ('LISTSPACE QTEMP' X'"D2X( X, 8 )"' X'00000038' &Data) "
If Substr( Data, 21, 10 ) = Module Then Say 'module' Module 'is used in',
Type.N Strip( Substr( Data, 11, 10 ))'/'Substr( Data, 1, 10 )
End X; End N; End
Return
INT: Return C2D( Substr( Data, Arg( 1 ), 4 ), 4 )
ERROR: 'SNDPGMMSG MSG(''Error' RC 'occured. Check job log for details.'')'
Figure 1: The DSPMODWU command will help you obtain a list of programs that have a certain *MODULE bound into them.
Figure 2: To use the DSPMODWU command, you need this REXX procedure.
Data Conversion Problem
Q: I received a file that I need to process in RPG. It contains numeric data that has been “superpacked” so each digit is contained in a half-byte (only without the x’F’ or x’D’ in the final byte). For example, if field 1 = 123, field 2 = 50, field 3 = 0000012345, and field 4 = 6, the record starts with hexadecimal 12 35 00 00 00 12 34 56.
I need to convert these into truly packed fields. I’ve worked out a method that uses data structures and bit manipulation, but it’s really laborious whenever the field ends on a full byte. With several hundred fields involved, I’m hoping there’s an easier way. Can you help me?
— Bill R. Adams
A: This is easy to solve with REXX. If your input file is packed by 3, 2, 10, and 1 nibbles, use the REXX procedure in Figure 3.
The first two lines are CL override commands that make the procedure read records from FILE1 and write the modified records into FILE2. The DO, IF, and END instructions create a “do while not end of file” structure. The PARSE PULL instruction reads records from FILE1 into a variable named RECORD. The C2X function returns, in character format, the hexadecimal digits of a character string.
The PARSE VALUE C2X(RECORD) WITH instruction parses RECORD from hexadecimal into characters. For example, if RECORD contains hexadecimal 12 35 00 00 00 12 34 56 (eight bytes), field A receives 123 (three bytes), field B receives 50 (two bytes), field C receives 0000012345 (10 bytes), and field D receives 6 (one byte).
The SAY instruction writes records into FILE2. The X2C function converts strings of hexadecimal digits into characters and concatenates a hexadecimal F to each. The corresponding FILE2 output record contains hexadecimal 12 3F 05 0F 00 00 00 12 34 5F 6F (11 bytes) in a packed-decimal form that your RPG program can read.
—Gene Gaunt
"OVRDBF STDIN FILE1"
"OVRDBF STDOUT FILE2"
Do Forever
Parse Pull Record
If Record = '' Then Leave
Parse Value C2X( Record ) With A +3 ,
B +2 ,
C +10 ,
D +1
Say X2C( A'F' ) ||,
X2C( B'F' ) ||,
X2C( C'F' ) ||,
X2C( D'F' )
End
Figure 3: This REXX procedure converts “superpacked” numbers into packed decimals.
Renaming Problem in WRKLNK
Q: I created a new Java class with the Edit File (EDTF) command but neglected to save it with the first character uppercase, according to the Java standard. I used the Work with Link (WRKLNK) command to view the directory and then took option 7 next to the file and renamed the file, changing only the first letter from lowercase to uppercase. When I refreshed the view, nothing changed. Why was the file not renamed?
—Paul Roubekas
A: Under the AS/400 Integrated File System (AS/400 IFS), you cannot change case by renaming in a non-case-sensitive file system. If you had created a file in /QOpenSys/QIBM, which is case-sensitive, you would have been able to change the case in one rename operation.
Non-case-sensitive systems require an actual name change to retain case changes, so you have to do two renames: the first to something different and the second to, in the proper case, whatever you wanted the original name to be.
To find out whether or not a file system is case-sensitive, use the Display Mounted File System Information (DSPMFSINF or STATFS) command. This command is not case-sensitive itself, so you can, for example, key /qopensys instead of /QopenSys.
—Ken Rokos
A Better DSPPFM
The Display Physical File Member (DSPPFM) command is good for looking at a file when you want to see raw data, but I find the Run Query (RUNQRY) command much more useful because it displays individual, formatted fields. However, RUNQRY is also a little cumbersome to use, because I have to either key in *N for the query name parameter or type the FILE keyword.
Over the past several years, I have saved myself many keystrokes by using the Q command, shown in Figure 4. For example, to view a file called CUSTPF, I just key this:
q custpf
Q has a command-processing program (CPP) that I call QC. It is listed in Figure 5.
—Ted Holt Senior Technical Editor
Midrange Computing
/*==================================================================*/
/* To compile: */
/* */
/* CRTCMD CMD(XXX/Q) PGM(XXX/QC) SRCFILE(QCMDSRC) */
/* */
/*==================================================================*/
CMD PROMPT('Query a file')
PARM KWD(FILE) TYPE(FILENAME) MIN(1) FILE(*IN) +
PROMPT('File name')
PARM KWD(SELECT) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(N) VALUES(Y N) PROMPT('Select records?')
PARM KWD(DEVICE) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(D) VALUES(D P) CHOICE('D=display, +
P=printer') PROMPT('Device')
FILENAME: ELEM TYPE(QUALNAME) MIN(1) PROMPT('File name')
ELEM TYPE(*NAME) DFT(*FIRST) SPCVAL((*FIRST) +
(*LAST)) PROMPT('Member')
ELEM TYPE(*NAME) DFT(*ONLY) SPCVAL((*ONLY)) +
PROMPT('Record format')
QUALNAME: QUAL TYPE(*NAME) LEN(10)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
Figure 4: The Q command can save you many keystrokes when you want to view files.
/*==================================================================*/
/* To compile: */
/* */
/* CRTCLPGM PGM(XXX/QC) SRCFILE(XXX/QCLSRC) */
/* */
/*==================================================================*/
PGM PARM(&FILE &SELECT &P_DEV)
DCL &DEVICE *CHAR 10 VALUE(*DISPLAY)
DCL &FILE *CHAR 42
DCL &FILEFMT *CHAR 10
DCL &FILELIB *CHAR 10
DCL &FILEMBR *CHAR 10
DCL &FILENAME *CHAR 10
DCL &MSG *CHAR 80
DCL &P_DEV *CHAR 1
DCL &SELECT *CHAR 1
DCL &RCDSLT *CHAR 4 VALUE(*NO)
/* Declare error processing variables */
DCL VAR(&ERRBYTES) TYPE(*CHAR) LEN( 4) VALUE(X'00000000')
DCL VAR(&ERROR) TYPE(*LGL) VALUE('0')
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN( 4)
DCL VAR(&MSGTYP) TYPE(*CHAR) LEN(10) VALUE('*DIAG')
DCL VAR(&MSGTYPCTR) TYPE(*CHAR) LEN( 4) VALUE(X'00000001')
DCL VAR(&PGMMSGQ) TYPE(*CHAR) LEN(10) VALUE('*')
DCL VAR(&STKCTR) TYPE(*CHAR) LEN( 4) VALUE(X'00000001')
MONMSG CPF0000 EXEC(GOTO ERRPROC)
CHGVAR &FILENAME (%SST(&FILE 3 10))
CHGVAR &FILELIB (%SST(&FILE 13 10))
CHGVAR &FILEMBR (%SST(&FILE 23 10))
CHGVAR &FILEFMT (%SST(&FILE 33 10))
IF (&SELECT *EQ 'Y') CHGVAR &RCDSLT *YES
IF (&P_DEV *EQ 'P') +
THEN(CHGVAR &DEVICE '*PRINTER')
RUNQRY QRYFILE((&FILELIB/&FILENAME &FILEMBR)) +
OUTTYPE(&DEVICE) RCDSLT(&RCDSLT)
RETURN
/*==================================================================*/
/* Error processing routine */
/*==================================================================*/
ERRPROC:
IF COND(&ERROR) THEN(GOTO CMDLBL(ERRDONE))
ELSE CMD(CHGVAR VAR(&ERROR) VALUE('1'))
/* Move all *DIAG messages to previous program queue */
CALL PGM(QMHMOVPM) PARM(&MSGKEY &MSGTYP &MSGTYPCTR &PGMMSGQ +
&STKCTR &ERRBYTES)
/* Resend last *ESCAPE message */
ERRDONE:
CALL PGM(QMHRSNEM) PARM(&MSGKEY &ERRBYTES)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF3CF2) MSGF(QCPFMSG) +
MSGDTA('QMHRSNEM') MSGTYPE(*ESCAPE)
MONMSG MSGID(CPF0000)
ENDDO
ENDPGM
Figure 5: QC is the CPP for Q.
LATEST COMMENTS
MC Press Online