Wednesday, March 6, 2019

Copying part of an existing spool file to a new one

copying part of one spool file to a new one

I was asked this week how to send the last few pages of a report to a remote output queue. The queue had been configured in a way that even though I could change the range of pages to print, number of copies, etc. despite this a single copy of the entire report would be printed. Such a waste of paper when the report was 450 pages.

The way I overcame this is to create a new spool file, copying data from the original. In a previous post I have shown how to copy multiple spool files and have them print as one. The spool files are copied to a physical file, then the data from the physical file is copied back to a printer file. If I only want a few pages I just need to find the relative record number of the start and end of the section I want to print, and then enter that data when I use the Copy File command, CPYF. For the new spool file to look like the old I also need to know the page width of the original spool file, the characters and lines per inch, CPI and LPI. I can find these myself by looking at the original.

It is not a big deal to do this manually, but my philosophy is if I need to do it more than a few times then it is best to write a program to do it for me. This example program is based upon a program I wrote to do this, make a new spool file that contains a subset of some of the pages from the original spool file, that can then be sent to the remote output queue.

I decided to create this example in one SQLRPGLE program. It may appear long, 158 lines, and complicated, but in reality it is not. I placed each step of the process into its own procedure to make it easier to understand what is going on.

Let me jump right in and start with the beginning of the program, including the "global" variables.

001  **free
002  ctl-opt main(Main)
003            option(*nodebugio:*srcstmt)
004            dftactgrp(*no) ;

005  dcl-pr Main extpgm('PRTRANGE') ;
006    *n char(10) ;  //Spool file name
007    *n char(10) ;  //Job name
008    *n char(10) ;  //Job user
009    *n char(6) ;   //Job number
010    *n packed(6) ; //Spool file number
011    *n packed(6) ; //From page number
012    *n packed(6) ; //To page number
013  end-pr ;

014  dcl-ds *n ;
015    SplfName char(10) ;
016    JobName char(10) ;
017    JobUser char(10) ;
018    JobNbr char(6) ;
019    SplfNbr packed(6) ;
020    FromPage packed(6) ;
021    ToPage packed(6) ;
022    PageLength packed(3) ;
023    PageWidth packed(4) ;
024    PageLPI packed(5:1) ;
025    PageCPI packed(5:1) ;
026    TotalPages packed(6) ;
027  end-ds ;

028  dcl-s String char(200) ;

Line 1: I find the advantage of using totally free RPG is that I can use the entire width of the source member. Alas, in this example I cannot as I need to display the code within the limits of the format of this blog.

Lines 2 – 4: My control options. I am using a Main procedure, this means that none of the RPG cycle is used, therefore, this program is faster and more efficient than one that does. I always use the options on line 3 as they make debugging easier. As I am using subprocedures in this program I need this keyword.

Lines 5 – 13: This is the procedure definition for the Main procedure. I need this as the information about the spool file I will be using is passed from another program. I have not bothered to name the parameters as, in my opinion, there is little point as the names will be given in the procedure interface later in the program. I do not see the point in discussing what each of these parameters contains as the comment next to each one describes its purpose.

Lines 14 – 27: This un-named data structure contains all the information I need to make a copy of the spool file. I normally name all of my data structures, and qualify the subfields. In this example I wanted to show what an un-named data structure looks like. I have defined this data structure at the start of the program, rather than in one of the subprocedures, to make it "global" making it available to all of the subprocedures in this program.

Line 28: I have also defined this variable as "global" too.

And onto the Main procedure.

029  dcl-proc Main ;
030    dcl-pi *n ;
031      inSplfName char(10) ;
032      inJobName char(10) ;
033      inJobUser char(10) ;
034      inJobNbr char(6) ;
035      inSplfNbr packed(6) ;
036      inFromPage packed(6) ;
037      inToPage packed(6) ;
038    end-pi ;


040    SplfName = inSplfName ;
041    JobName = inJobName ;
042    JobUser = inJobUser ;
043    JobNbr = inJobNbr ;
044    SplfNbr = inSplfNbr ;
045    FromPage = inFromPage ;
046    ToPage = inToPage ;

047    GetAttributes() ;
048    MakeWorkFile() ;
049    OverridePrinterFile() ;
050    CreateNewSpoolFile() ;
051    DeleteFile() ;
052  end-proc ;

There is not much going on in the Main procedure.

Lines 30 – 38: This is the procedure interface the Main procedure must have as there are parameters passed to this program. The definitions of the parameters must match the procedure prototype, lines 5 – 13.

Line 39: I always add this line to all of my SQLRPGLE programs. It ensures that there is no commitment control and the cursor, if left open, is closed as the end of the module (program). I add these to make sure these compile options are not forgotten by another programmer, or myself, in the future.

Lines 40 – 46: The procedure's parameters are only available in the Main procedure. I am moving their values to the subfields in the "global" data structure so that I can use them in all the other subprocedures.

Lines 47 – 51: I just call subprocedures to perform each step of this process, one after another.

The first subprocedure is the one where I get all the attributes I need about the spool file.

053  dcl-proc GetAttributes ;
054    dcl-pr SplfAttributes extpgm('QUSRSPLA') ;
055      *n char(3841) ;      //Receiver value
056      *n int(10) const ;   //Receiver variable length
057      *n char(8) const ;   //API format
058      *n char(26) const ;  //Job name
059      *n char(16) const ;  //Not used
060      *n char(16) const ;  //Not used
061      *n char(10) const ;  //Spool file name
062      *n int(10) const ;   //Spool file number
063      *n char(32767) options(*varsize:*nopass) ;  //Error DS
064    end-pr ;

065  /include qsysinc/qrpglesrc,qusrspla
066  /include qsysinc/qrpglesrc,qusec

067    dcl-s ApiJobName char(26) ;
068    dcl-s ApiFileNbr int(10) ;

069    ApiJobName = JobName + JobUser + JobNbr ;
070    ApiFileNbr = SplfNbr ;

071    SplfAttributes(QUSA0200:3841:'SPLA0200':ApiJobName:
072                   '':'':SplfName:ApiFileNbr:QUSEC) ;

073    PageLength = QUSPL03 ;
074    PageWidth = QUSPW00 ;
075    PageLPI = QUSLPI00 / 10 ;
076    PageCPI = QUSCPI00 / 10 ;
077    TotalPages = QUSTP00 ;
078  end-proc ;

There are times when an API will return results faster than using a SQL Select to get the same. This was a good example, as using the Retrieve Spool File Attribute API, QUSRSPLA, returned the information in seconds. The equivalent SQL statement I used was taking minutes!

Lines 54 – 64: This is the procedure interface I need for the QUSRSPLA API. I have defined it within this subprocedure as will be "local" to this subprocedure, as I do not need to use it elsewhere.

Line 65: IBM provides a data structure to contain the results from the API in this source member, in the library QSYSINC. I am including the definition of the data structure into my program by using the /INCLUDE compiler directive. I have used /INCLUDE, but I could have used /COPY to do the same.

Line 66: IBM also provides a data structure for the error information returned by the API. Rather than creating my own I am including their definition into this program.

Line 67 and 68: As these variables are defined with this subprocedure they will remain "local" to it.

Line 69: I need the job name as a parameter for the API.

Line 70: The spool file number passed to the API must be an integer type number, rather than packed decimal.

Lines 71 and 72: The API has nine parameters:

  1. Data structure for the results, found in the source included from line 65
  2. Length of the data structure
  3. Format name of the type of results I want
  4. Full job name, see line 69
  5. I am not passing this parameter to the API
  6. Ditto
  7. Name of the spool file
  8. Spool file number, see line 70
  9. Error data structure, found in the source included from line 66

Lines 73 – 77: Moving the values from the API's results data structure's subfields to my "global" data structure's subfields.

Next step is to make the file the spool file will be copied into, and then copy the data into the made file.

080  dcl-proc MakeWorkFile ;
081    dcl-s FileWidth packed(4) ;

082    String = 'DLTF QTEMP/WSPLF' ;
083    RunCommand(String) ;

084    FileWidth = PageWidth + 1 ;

085    String = 'CRTPF FILE(QTEMP/WSPLF) ' +
086             'RCDLEN(' + %editc(FileWidth:'X') +
087             ') TEXT(''Selected pages spool file'') ' +
088             'SIZE(*NOMAX)' ;
089    RunCommand(String) ;

090    String = 'CPYSPLF FILE(' + %trim(SplfName) +
091             ') TOFILE(QTEMP/WSPLF) ' +
092             'JOB(' + JobNbr + '/' +
093                      %trimr(JobUser) + '/' +
094                      %trimr(JobName) +
095             ') SPLNBR(' + %editc(SplfNbr:'X') +
096             ') CTLCHAR(*FCFC)' ;
097    RunCommand(String) ;
098  end-proc ;

This subprocedure just builds CL command strings and passes them to the RunCommand subprocedure to execute.

Lines 82 and 83: Delete the work file in the library QTEMP.

Line 84: As I need to save the file control character to the file I need to make the file one character larger than the width of the spool file.

Lines 85 – 89: Create the work file. When concatenating strings together it is not possible to concatenate a numeric variable. Therefore, on line 86, I convert the numeric FileWidth to character using the %EDITC built in function with the edit code of X (= no formatting).

Lines 90 – 97: This copies the data from the spool file to the file I created above, using the Copy Spool File command, CPYSPLF.

I need to override the spool file before I can copy data to it.

099 dcl-proc OverridePrinterFile ;
100   String = 'OVRPRTF FILE(QSYSPRT) ' +
101            'PAGESIZE(' + %editc(PageLength:'X') +
102                      ' ' + %editc(PageWidth:'X') +
103             ') LPI(' + %triml(%char(PageLPI)) +
104             ') CPI(' + %triml(%char(PageCPI)) +
105             ') CTLCHAR(*FCFC) ' +
106             'DUPLEX(*YES) OUTQ(HOLDQ) SAVE(*NO) ' +
107             'USRDTA(''* SUBSET *'') ' +
108             'SPLFNAME(' + %trimr(SplfName) + ') ' +
109             'OVRSCOPE(*JOB)' ;
110    RunCommand(String) ;

111    String = 'HLDSPLF FILE(' + %trimr(SplfName) +
112             ') JOB(' + JobNbr + '/' +
113                        %trimr(JobUser) + '/' +
114                        %trimr(JobName) +
115             ') SPLNBR(' + %editc(SplfNbr:'X') +
116             ')' ;
117    RunCommand(String) ;
118  end-proc ;

Lines 99 – 110: Here I am overriding the spool file QSYSPRT to have the attributes I need to be identical to the spool file the data will be copied from. On lines 103 and 104 I have used %CHAR rather than %EDITC as the CPI and LPI contain a decimal place. %CHAR returns 15.1, while %EDITC with the edit code of X return 151. All of the spool files created by this program will always print both sides, why waste paper with single sided printing?, line 106. The new spool file will be in the HOLDQ output queue so that the user can transfer it to the output queue of their choice, also line 106. I also change the user data field, line 107, so that everyone knows this is a subset of the original spool file. In my testing I found the only way to make this override "stick" was to define it at the job level, line 109.

Lines 111 – 117: I hold the original spool file so that it is not lost or printed.

The following procedure is the one that copies the data from the work file, WSPLF, into a new spool file. Before it does that it has to determine the starting and ending point of the desired page range.

119  dcl-proc CreateNewSpoolFile ;
120    dcl-s FromRecordNbr packed(10) ;
121    dcl-s ToRecordNbr like(FromRecordNbr) ;
122    dcl-s Offset packed(10) ;

123    Offset = FromPage - 1 ;

124    exec sql SELECT RRN(A) into :FromRecordNbr
125               FROM QTEMP.WSPLF A
126              WHERE SUBSTRING(A.WSPLF,1,1) = '1'
127             OFFSET :Offset ROWS
128              FETCH FIRST ROW ONLY ;

129    if (ToPage = TotalPages) ;
130      exec sql SELECT MAX(RRN(A)) into :ToRecordNbr
131                 FROM QTEMP.WSPLF A ;
132    else ;
133      Offset = ToPage ;

134      exec sql SELECT RRN(A) into :ToRecordNbr
135                 FROM QTEMP.WSPLF A
136                WHERE SUBSTRING(A.WSPLF,1,1) = '1'
137               OFFSET :Offset ROWS
138                FETCH FIRST ROW ONLY ;

139      ToRecordNbr -= 1 ;
140    endif ;

141    String = 'CPYF FROMFILE(QTEMP/WSPLF) ' +
142             'FROMRCD(' + %editc(FromRecordNbr:'X') +
143             ') TORCD(' + %editc(ToRecordNbr:'X') +
144             ') TOFILE(QSYSPRT) MBROPT(*ADD)' ;
145    RunCommand(String) ;
146  end-proc ;

Let me start with a brief description of what is going on here. I need to find the start and the end of the range of pages in the work file, and get the relative record numbers for these. As I copied the format control characters into the work file, CTLCHAR(*FCFC), I know that the record for the top of every page starts with a "1" in the first position. If I am searching for pages 20 and 21 I need to find the 20th occurrence of a "1" in the first position, and find the last record before the start of the 22nd page. Once I have those relative record numbers I can just use a Copy File command, CPYF, to copy the records in the range to the overridden printer file.

Lines 120 and 121: These "local" variables will contain the from and to relative record numbers I will be using.

Line 122: This will contain the offset value when retrieving data from the work file.

Line 123: Here I am calculating the offset value. As the offset value for Page 1 is zero, Page 2 is one, etc. I need to subtract 1 from the from page number for the correct offset value.

Lines 124 – 128: This is a simple SQL select statement that will retrieve the relative record number, RRN, from the file into the variable FromRecordNbr where the first position of the record in the work file starts with a "1", and the offset will "position" the statement to the desired occurrence of records that start with "1". I need line 128 as I only want one result returned. As I said if I want to start at the 20th page, the offset needs to be 19 to retrieve the relative record number for the first record of the 20th page.

Line 129: Calculating the last record in the to page gets a bit more complicated. I need to check if the to page is the last page, value in the "global" data structure's subfield TotalPages.

Lines 130 and 131: If the to page is the last page of the spool file I can just retrieve the maximum value of the RRN to get the last record in the work file.

Lines 133 – 139: If the to page is not the last page of the spool file I can retrieve the RRN of the top of the next page and subtract 1 to get the last record of the previous (to) page. If I want the bottom of the 21st page I can use an offset of 21 to retrieve the relative record number of start of the 22nd page, lines 134 - 138, and subtract 1 from that number, line 139.

Lines 141 – 145: With the from and to RRN I can create my CPYF statement to copy the records from the work file into the overridden printer file. When the RunCommand subprocedure executes this statement the new spool file is generated.

Now the spool file has been generated I need to do some "clean up" before the program ends.

147  dcl-proc DeleteFile ;
148    String = 'DLTF QTEMP/WSPLF' ;
149    RunCommand(String) ;

150    String = 'DLTOVR FILE(QSYSPRT) LVL(*JOB)' ;
151    RunCommand(String) ;
152  end-proc ;

Lines 148 and 149: The statement to delete the work file is passed to the RunCommand subprocedures.

Lines 150 and 151: Rather than leave any overrides after the program has ended I delete the override to the new printer file defined on lines 100-110.

Lastly is the RunCommand subprocedure.

153  dcl-proc RunCommand ;
154    dcl-pi *n ;
155      Input char(200) ;
156    end-pi ;

157    exec sql CALL QSYS2.QCMDEXC(:Input) ;
158  end-proc ;

Lines 154 – 156: I want to have this subprocedure "closed", therefore I need to have a procedure interface defined for the parameter passed to it.

Line 157: The command string passed to the subprocedure, contained in the variable Input, is executed by the SQL QCMDEXC procedure.

When the program has finished when I go to the WRKSPLF I can see the original, and the new spool file this program created.

                         Work with All Spooled Files

Type options, press Enter.
  1=Send   2=Change   3=Hold   4=Delete   5=Display   6=Release
  8=Attributes        9=Work with printing status

                             Device or                     Total
Opt  File        User        Queue       User Data   Sts   Pages
 _   PGM0001     SIMON       HOLDQ       * SUBSET *  RDY       2
 _   PGM0001     SIMON       MYOUTQ                  HLD      39


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

No comments:

Post a Comment

To prevent "comment spam" all comments are moderated.
Learn about this website's comments policy here.

Some people have reported that they cannot post a comment using certain computers and browsers. If this is you feel free to use the Contact Form to send me the comment and I will post it for you, please include the title of the post so I know which one to post the comment to.