My favorite file definition keywords in free format

This all started with a question, and then I got carried away. I was asked did I have a free format example code for what I described in my post about Useful keywords for your F-specs. Recently I have not used file definitions in my programs as I use SQL for my file I/O. I relished the thought of giving these file definition keywords, and then went on to show how they could be used.

The scenario is I have a file, TESTFILE, that I want to make a "work" copy in QTEMP. Then I want to have two members in the file and I fill the first with the contents of TESTFILE in ascending key order, and the second in descending key order. Just to make it interesting for myself, I will not use SQL for any of this, or for showing the results.

TESTFILE contains one field, NAME, and I can use the Run Query command, RUNQRY, to views it contents:

RUNQRY *NONE TESTFILE

If you are not familiar with what the *NONE is it is the name of an existing query.

This displays:

NAME 000001 SIMON 000002 ANNE 000003 ZOE 000004 CLIVE

And now onto the program. It has main section and three subprocedures. I am going to start just showing the main section:

01 **free 02 ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no) ; 03 dcl-f TESTFILE keyed ; 04 dcl-f ANY_NAME extfile('QTEMP/WORK_FILE') 05 extdesc('TESTFILE') 06 extmbr(Member) 07 rename(TESTFILER : WORKRCD) 08 usage(*output) 09 usropn ; 10 dcl-s Member char(10) ; 11 CreateOutfile() ; 12 AscendingMember() ; 13 DescendingMember() ; 14 *inlr = *on ;

Line 1: No matter what I am going to write this program in totally free format RPG.

Line 2: My favorite control options are in the OPTION keyword. I need the DFTACTGRP(*NO) as the program contains subprocedures.

Line 3: This is the file definition for the input file, TESTFILE. Notice that I will be reading it in keyed order, which is in name order.

Lines 4 – 9: Definition for the output file.

Line 4: I can call the file anything I like in the RPG program as I have given its "true" name in the EXTFILE keyword.

Line 5: The file only exists when this program is run. Therefore, it is not present when I compile this program. The EXTDESC, external description, keyword "tells" the compiler which file to use for the definition of this file.

Line 6: The output file will be multiple member, and the EXTMBR is used to "tell" which member to use. Here I have a variable name in the keyword as I will be opening multiple members in this example.

Line 7: As the output file is a copy of TESTFILE it will have the same record format name. I use RENAME to rename the output file's record format to a new unique name.

Line 8: The file will only be used for output.

Line 9: USROPN, means that I will open and close the file myself in the program. That way I can open different members.

Line 10: This is the definition of the variable that will contain the member's name I want to open. As this variable is defined in the main part of the program it is a global variable, which can be used in all of the subprocedures.

Line 11: This is the call to the subprocedure to create the output file.

Line 12: Following is the call to fill a member with the records in ascending order.

Line 13: Then why not fill another member with the records in descending order.

The first procedure is the one that creates the output file from TESTFILE. It looks longs, in reality it is just a lot of CL commands executed by the QCMDEXC API.

15 dcl-proc CreateOutfile ; 16 dcl-pr QCMDEXC extpgm ; 17 *n char(200) const ; 18 *n packed(15 : 5) const ; 19 end-pr ; 20 dcl-s Command varchar(200) ; 21 dcl-s Length packed(15 : 5) ; 22 Command = 'DLTF QTEMP/WORK_FILE' ; 23 Length = %len(Command) ; 24 callp(e) QCMDEXC(Command : Length) ; 25 Command = 'CRTDUPOBJ OBJ(TESTFILE) FROMLIB(*LIBL) OBJTYPE(*FILE) + TOLIB(QTEMP) NEWOBJ(WORK_FILE) + CST(*NO) TRG(*NO) ACCCTL(*NONE)' ; 26 Length = %len(Command) ; 27 QCMDEXC(Command : Length) ; 28 Command = 'CHGPF FILE(QTEMP/WORK_FILE) MAXMBRS(*NOMAX) + SIZE(*NOMAX)' ; 29 Length = %len(Command) ; 30 QCMDEXC(Command : Length) ; 31 Command = 'RMVM FILE(QTEMP/WORK_FILE) MBR(*ALL)' ; 32 Length = %len(Command) ; 33 QCMDEXC(Command : Length) ; 34 Command = 'ADDPFM FILE(QTEMP/WORK_FILE) MBR(ONE)' ; 35 Length = %len(Command) ; 36 QCMDEXC(Command : Length) ; 37 Command = 'ADDPFM FILE(QTEMP/WORK_FILE) MBR(TWO)' ; 38 Length = %len(Command) ; 39 QCMDEXC(Command : Length) ; 40 end-proc ;

Line 15: Start of the CreateOutfile procedure.

Lines 16 – 19: Procedure prototype for calling the QCMDEXC API.

Line 16: I am going to use the API's name, QCMDEXC, when I use it. I still need the EXTPGM, but don't need to name the program following it.

Line 17: Notice here that this parameter is defined as CHAR, fixed length character.

Line 20: This is the variable that will contain the CL command, that QCMDEXC will execute. This is variable length character, VARCHAR.

Line 21: The API requires the length of the CL command passed to it.

Lines 22 – 24: First I want to delete WORK_FILE if it already exists in QTEMP.

Line 22: I move the CL command string to the variable Command.

Line 23: As Command is VARCHAR it is only as long as its contents. This allows me to just to use the %LEN built in function to determine the length of the command, without need to right trim Command that I would need to do if it was CHAR.

Line 24: Finally I call QCMDEXC to execute the CL command. Here I have used the CALLP with the error operation code extender (E) to prevent this from erroring if the file does not already exist.

Lines 25 – 27: This is where I create WORK_FILE in QTEMP by using thew Create Duplicate Object command, CRTDUPOBJ.

Lines 28 – 30: I need to change WORK_FILE to allow more than one member, and while I am at let me make sure its size is set to *NOMAX.

Lines 31 – 33: I am removing all existing members from WORK_FILE.

Lines 34 – 36: Add a new member, called ONE, to WORK_FILE.

Lines 37 – 39: Add a second member, TWO.

As I have WORK_FILE ready what is next? Writing data to the first member from TESTFILE.

41 dcl-proc AscendingMember ; 42 Member = 'ONE' ; 43 open ANY_NAME ; 44 dow (*on) ; 45 read TESTFILER ; 46 if (%eof) ; 47 leave ; 48 endif ; 49 write WORKRCD ; 50 enddo ; 51 close ANY_NAME ; 52 end-proc ;

Line 41: Start of the subprocedure.

Line 42: I want to open the first member when the file is opened.

Line 43: Open the output file, WORKFILE.

Line 44: Start of a "never ending" Do loop.

Line 45: Read TESTFILE, the records are retrieved in keyed order.

Lines 46 – 48: If end of file is encountered leave the Do loop.

Line 49: Write a record to WORK_FILE.

Line 51: When TESTFILE's end of file was encounter, and the Do loop left, I close WORK_FILE before the subprocedure end.

The last subprocedure is very similar to the above. The only differences are so TESTFILE can be read in descending key order.

53 dcl-proc DescendingMember ; 54 Member = 'TWO' ; 55 open ANY_NAME ; 56 setgt *hival TESTFILER ; 57 dow (*on) ; 58 readp TESTFILER ; 59 if (%eof) ; 60 leave ; 70 endif ; 71 write WORKRCD ; 72 enddo ; 73 close ANY_NAME ; 74 end-proc ;

The only differences from the previous subprocedure are:

Line 56: I need to use this to set the file pointer to the end of file.

Line 58: I am using the READP to read TESTFILE in descending key order.

After running this program I want to look at what is in each member. I can do this RUNQRY. Let me start with the first member, ONE:

RUNQRY QRY(*NONE) QRYFILE((QTEMP/WORK_FILE ONE)) NAME 000001 ANNE 000002 CLIVE 000003 SIMON 000004 ZOE

And what does the second member, TWO, contain?

RUNQRY *NONE ((QTEMP/WORK_FILE TWO)) NAME 000001 ZOE 000002 SIMON 000003 CLIVE 000004 ANNE

This shows that the two members' records are in the order I desired.

I know I exceeded what the original question was, but it was a good excuse to have a "play" with RPG.

 

This article was written for IBM i 7.5, and should work for some earlier releases too.