Memories Remembering how to write programs that create procedures has its benefits
From "VS Workshop",  Access to Wang, March 1990
[ Prior Article ]     [ Return to the Catalog of articles ]     [ Next Article ]

At one time, Procedure was primarily a tool for job control, not a language. In those "bad old days", there was no screen control, no variables, no way to run a subroutine. It was common then to see programs that created procedures and then executed them. Such programs skirted the need to hard-code run-specific information into production procedures by creating a new procedure for each task.

Enhancements to the Procedure Interpreter in the early 1980's allowed the procedures themselves to become "smarter". Procedures could now extract system, user, or file information directly or through subroutines, perform complex logical tests, manipulate string text, and control the workstation. Information could be passed from programs through arguments, through GETPARMs, or through GLOBAL variables from other procedures. The RUN statement could even direct execution safely outside the procedure should an error or abnormal cancellation occur. In short, Procedure became more powerful than most high-level languages, and the need to use programs to create procedures was reduced. As a result, the technique of writing programs to create procedures became a lost art.

There are a few times when it might be desirable to dust off your COBOL or BASIC manuals and write programs to create procedures. Reasons for this might include the size or complexity of a task, the need for system information easily extracted within a procedure, the effort required to code it (e.g. string manipulations in COBOL - ugh!), or the desire to use special features of Procedure (SUBMIT to background, GLOBAL variables, etc.).

Careful system management often requires identification of files and mass reprocessing. I have found frequent need to create procedures that perform a single operation on many files - sometimes files scattered across the system. Recent examples include:

• Create and queue several hundred procedures for later execution in background

• Check the syntax of 745 procedures

• Identify and remove COBOL source files whose file names end in "OL"

• Compare several generations of modified source files with each other and a library of unmodified originals

• Release unused file space from selected files in a library

• "Compress" source and procedure file libraries by removing line numbers and modification codes

In all of these cases there was need to create a large list of files and then process each of them. I met this need with FINDGEN, a procedure generator I created in COBOL. FINDGEN accepts ambiguous file, library, and volume criteria (a.k.a. wild cards), extracts file names that meet these specifications, and creates a shell procedure. The generated procedure can then be edited to perform a task on each of the files found.

Procedure file format

Before I get into specifics on FINDGEN, though, let's establish the minimum requirements of the Procedure Interpreter. Procedure files must meet the following standards:

• Consecutive file organization

• 80-character record length

• Must have PROC or PROCEDURE in first executable line; remainder of line considered a comment

• Statements with an asterisk in column 1 are ignored

• Text between square brackets ([, ]) is ignored - even across multiple text lines

• Only columns 1 through 71 evaluated

• Statements should be separated by at least one space

• The procedure cannot have more than 32767 records (that should be sufficient!)

• Line numbers (columns 75 - 80) are not required for execution, but must be added before the Wang EDITOR will work

• Procedure statements may be upper case, lower case, or any combination of both

• Text within single or double quotes will be treated literally (i.e. character case will be observed)

• Statements must meet syntax requirements of the Procedure Interpreter

Any file that meets these specifications could be considered a procedure file, and virtually any method can be used to create such a file. Unlike COBOL and other languages, Procedure has no means of indicating when text is continued to another line - although text in column 71 is considered adjacent to column 1 of the next line. Thus,

RUN DISPLAY IN @SYSTEM@ ON VOLUME ENTER INPUT FILE=FILE, LIBRARY=@SYSTEM@, VOLUME=VOL555, ACCESS=PRINT ENTER DEFAULTS CASE=ANY

is identical in function to:

RUN DISPLAY IN @SYSTEM@ ON VOLUME ENTER INPUT FILE=FILE, LIBRARY=@SYSTEM@, VOLUME=VOL555, ACCESS=PRINT ENTER DEFAULTS CASE=ANY

FINDGEN specifications and use

FINDGEN was constructed with the following design requirements:

• Accept masked file, library, and volume input from the user

• Extract the file, library, and volume specifications that match the input and build a work file

• Sort the work file by file, then library, then volume

• Write the sorted file entries in Procedure format, without duplicates

To use FINDGEN, enter file specifications at the INPUT screen and press RETURN to process each. When all specifications have been entered, press PF1 to create a procedure file (of PF16 to exit without creating a file). Enter the location for the procedure to be created and press RETURN.

As shown in Figure 1, the generated procedure consists of three major sections: a header, the file-related middle portion, and an empty internal subroutine (labelled @RUN) for the actual task to be performed. The header contains the PROCEDURE line and declares variable &X, a 22-character string. The middle portion assigns a file, library, and volume name to &X and calls @RUN. A RETURN statement follows the last file assignment, then the @RUN label and an END statement to return after execution. All that remains is to insert your process into the @RUN subroutine, check syntax, and go!

I have inserted a sample code section within @RUN to show how you would complete the procedure. The added code - presented in lower case in the figure - checks the syntax of procedure files by invoking the Procedure Interpreter (@PROC@) itself. The hidden GETPARMs of @PROC@ are used to set the mode to CHECK and process the file. Error reports will be generated for files that contain syntax errors. (Note that this routine does NOT test whether the target file is a procedure. To see my point, try entering the name of a COBOL source file and review the results!)

And if you order today. . .

While publication space does not allow me to list the program here, I will be pleased to provide a copy of FINDGEN for all interested. Send $5 for postage and handling to my address below and I will return a 5-1/4" diskette containing COBOL source and object. (Sorry, no other diskette formats available.)

[ NOTE: COBOL source for FINDGEN is listed in Figure 2 ]

Figure 1: Sample procedure generated by FINDGEN

(With additional code added in @RUN)

PROCEDURE TESTIT - created 11/20/89 at 11:17 PM by DSB DECLARE &X STRING (22) ASSIGN &X = "FILE1 LIB1 VOL111" CALL @RUN ASSIGN &X = "FILE1 LIB2 VOL111" CALL @RUN ASSIGN &X = "FILE2 LIB1 VOL111" CALL @RUN ASSIGN &X = "FILE3 LIB1 VOL111" CALL @RUN RETURN @RUN: run @proc@ in @system@ enter options mode = check enter input file = &x(1,8), library = &x(9,8), library = &x(17,6) enter errors file = &x(1,8), library = procchk, volume = sysvol END

Figure 2: FINDGEN Program (COBOL Source)

IDENTIFICATION DIVISION. PROGRAM-ID. FINDFILE. *PROGRAM-TITLE. Text file generating utility. DATE-WRITTEN. 09/29/88. AUTHOR. Dennis S. Barnes * MODIFICATION NOTES ******************************************* * * * Accepts FILE, LIBRARY and VOLUME input from the user and * * creates a list of files meeting those specifications. * * Standard FIND wild card delimiters may be used. * * The 22-byte work file is sorted (order: VOL/LIB/FIL) and * * written to an 80-character consecutive file for use in * * procedures or for other purposes. * * * ***************************************************************** / **************************************************************** * * * ENVIRONMENT DIVISION * * * **************************************************************** * ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. WANG-VS. OBJECT-COMPUTER. WANG-VS. FIGURATIVE-CONSTANTS. G1-PFMASK-1 IS "8001" G1-PFMASK-2 IS "0001" HEX-0D IS "0D" HEX-40 IS "40" HEX-41 IS "41" HEX-61 IS "61" HEX-50 IS "50" HEX-70 IS "70". INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TEXT-FILE ASSIGN TO "TEXTFILE" "DISK" ORGANIZATION IS SEQUENTIAL ACCESS MODE IS DYNAMIC FILE STATUS IS TEXTFILE-FILE-STATUS. SELECT WORKFIL1 ASSIGN TO "WORKFIL1" "DISK" NODISPLAY ORGANIZATION IS SEQUENTIAL ACCESS MODE IS DYNAMIC FILE STATUS IS WORKFIL1-FILE-STATUS. SELECT WORKFIL2 ASSIGN TO "WORKFIL2" "DISK" NODISPLAY ORGANIZATION IS SEQUENTIAL ACCESS MODE IS DYNAMIC FILE STATUS IS WORKFIL2-FILE-STATUS. / **************************************************************** * DATA DIVISION * **************************************************************** * DATA DIVISION. FILE SECTION. FD TEXT-FILE RECORD CONTAINS 80 COMPRESSED CHARACTERS LABEL RECORDS ARE STANDARD VALUE OF SPACE IS WORKFILE-SPACE. 01 TEXTFILE-RECORD. 05 FILLER PIC X(09). 05 TEXTFILE-FILE PIC X(08). 05 FILLER PIC X(02). 05 TEXTFILE-LIBRARY PIC X(08). 05 FILLER PIC X(02). 05 TEXTFILE-VOLUME PIC X(06). 05 FILLER PIC X(39). 05 TEXTFILE-SEQ PIC 9(06). FD WORKFIL1 LABEL RECORDS ARE STANDARD VALUE OF FILENAME IS SORTCALL-IN-FILE LIBRARY IS SORTCALL-IN-LIBRARY VOLUME IS SORTCALL-IN-VOLUME SPACE IS WORKFILE-SPACE. 01 WORKFIL1-RECORD PIC X(22). FD WORKFIL2 LABEL RECORDS ARE STANDARD VALUE OF FILENAME IS SORTCALL-OUT-FILE LIBRARY IS SORTCALL-OUT-LIBRARY VOLUME IS SORTCALL-OUT-VOLUME SPACE IS WORKFILE-SPACE. 01 WORKFIL2-RECORD. 05 WORKFIL2-VOLUME PIC X(06). 05 WORKFIL2-LIBRARY PIC X(08). 05 WORKFIL2-FILE PIC X(08). / **************************************************************** * * * WORKING-STORAGE SECTION * * * **************************************************************** * WORKING-STORAGE SECTION. 01 LINE-NUMBER PIC S9(07) COMP VALUE ZERO. 01 WORKFIL2-HOLD PIC X(22). 01 WORKFILE-SPACE PIC S9(07) COMP VALUE +5000. / ****************************************************************** * LITERAL FIELDS * ****************************************************************** * 01 ANSWER-NO PIC X(01) VALUE "N". 01 ANSWER-YES PIC X(01) VALUE "Y". / ****************************************************************** * FILE CONTROL STATUS SWITCHES * ****************************************************************** * 01 TEXTFILE-FILE-STATUS PIC X(02) VALUE "00". 01 WORKFIL1-FILE-STATUS PIC X(02) VALUE "00". 01 WORKFIL2-FILE-STATUS PIC X(02) VALUE "00". 88 WORKFIL2-I-O-SUCCESSFUL VALUE "00". 88 WORKFIL2-END-OF-FILE VALUE "10". / ****************************************************************** * PROCESS CONTROL STATUS SWITCHES * ****************************************************************** * 01 FIRST-TIME-FLAG PIC X(01) VALUE "Y". 88 FIRST-TIME VALUE "Y". 88 WORK-FILE-OPEN VALUE "N". / **************************************************************** * ELEMENTS FOR CALL TO FIND * **************************************************************** * 01 FIND-STARTER USAGE BINARY PIC S9(08) VALUE ZERO. 01 FIND-COUNTER USAGE BINARY PIC S9(08) VALUE ZERO. 01 FIND-FILE-COUNT USAGE BINARY PIC S9(08) VALUE ZERO. 01 FIND-RECEIVER-TYPE PIC X(01) VALUE "F". / **************************************************************** * ELEMENTS FOR CALL TO SCRATCH * **************************************************************** * 01 SCRATCH-TYPE PIC X(01) VALUE "F". 01 SCRATCH-RETURN-CODE USAGE BINARY PIC S9(08) VALUE ZERO. / **************************************************************** * ELEMENTS FOR CALL TO SORTCALL * **************************************************************** * 01 SORTCALL-PARAMETERS. 05 SORTCALL-IN-FILE PIC X(08) VALUE "##WRK1". 05 SORTCALL-IN-LIBRARY PIC X(08) VALUE SPACES. 05 SORTCALL-IN-VOLUME PIC X(06) VALUE SPACES. 05 SORTCALL-OUT-FILE PIC X(08) VALUE "##WRK2". 05 SORTCALL-OUT-LIBRARY PIC X(08) VALUE SPACES. 05 SORTCALL-OUT-VOLUME PIC X(06) VALUE SPACES. 05 FILLER OCCURS 8 TIMES. 10 SORTCALL-FIELD-POSITION PIC Z(04). 10 SORTCALL-FIELD-LENGTH PIC Z(03). 10 SORTCALL-FIELD-TYPE PIC X(01). 10 SORTCALL-ORDER PIC X(01). 01 SORTCALL-RETURN-CODE USAGE BINARY PIC S9(08) VALUE ZERO. / **************************************************************** * ELEMENTS FOR CALL TO CGETPARM * **************************************************************** * 01 G1-PARMLIST . 05 G1-TYPE PIC X(01) VALUE "I". 05 G1-NODISP PIC X(01) VALUE " ". 05 G1-FORM PIC X(01) VALUE "I". 05 G1-PRNAME PIC X(08) VALUE "INPUT ". 05 G1-AID PIC X(01). 88 ENTER-KEY-PRESSED VALUE HEX-40. 88 PF1-PRESSED VALUE HEX-41 HEX-61. 88 PF16-PRESSED VALUE HEX-50 HEX-70. 88 INPUT-COMPLETE VALUE HEX-41 HEX-61 HEX-50 HEX-70. 05 G1-MESSAGE-NO PIC 9(04) VALUE 0000. 05 G1-MESSAGE-ID PIC X(06) VALUE "FINDGN". 05 G1-ENTER PIC X(01) VALUE "E". 05 G1-PFMSK-1 PIC X(02) VALUE G1-PFMASK-1. 05 G1-PFMSK-2 PIC X(02) VALUE G1-PFMASK-2. 05 G1-MSG-LENGTH PIC 9(04) VALUE 0413. 05 FILLER PIC X(50) VALUE " This utility accepts ambiguous file, library, an". 05 FILLER PIC X(27) VALUE "d volume specifications and". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(50) VALUE " returns the associated values in an 80-character". 05 FILLER PIC X(23) VALUE " consecutive file. The". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(50) VALUE " output file may be used as a skeleton for a proc". 05 FILLER PIC X(26) VALUE "edure or any other purpose". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(26) VALUE " desired. ". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(50) VALUE " Standard FIND wild cards (*, ?) may be used in t". 05 FILLER PIC X(27) VALUE "he FILE, LIBRARY, or VOLUME". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(09) VALUE " fields.". 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X VALUE HEX-0D. 05 FILLER PIC X(49) VALUE " Please enter the file, library or vol". 05 FILLER PIC X(18) VALUE "ume specification:". * 01 G1-K01-FILE . 05 G1-K01-FLAG PIC X(01) VALUE "K". 05 G1-K01-ROW-SKIP PIC 9(02) VALUE 0000 . 05 G1-K01-COL-SKIP PIC 9(02) VALUE 0009 . 05 G1-K01-TYPE PIC X(01) VALUE "U". 05 G1-K01-KEYWORD PIC X(08) VALUE "FILE ". 05 G1-K01-VALUE-LENGTH PIC 9(04) VALUE 0008 . 05 G1-K01-VALUE PIC X(08) VALUE SPACES. * 01 G1-K02-LIBRARY . 05 G1-K02-FLAG PIC X(01) VALUE "K". 05 G1-K02-ROW-SKIP PIC 9(02) VALUE 0000 . 05 G1-K02-COL-SKIP PIC 9(02) VALUE 0002 . 05 G1-K02-TYPE PIC X(01) VALUE "U". 05 G1-K02-KEYWORD PIC X(08) VALUE "LIBRARY ". 05 G1-K02-VALUE-LENGTH PIC 9(04) VALUE 0008 . 05 G1-K02-VALUE PIC X(08) VALUE SPACES. * 01 G1-K03-VOLUME . 05 G1-K03-FLAG PIC X(01) VALUE "K". 05 G1-K03-ROW-SKIP PIC 9(02) VALUE 0000 . 05 G1-K03-COL-SKIP PIC 9(02) VALUE 0002 . 05 G1-K03-TYPE PIC X(01) VALUE "U". 05 G1-K03-KEYWORD PIC X(08) VALUE "VOLUME ". 05 G1-K03-VALUE-LENGTH PIC 9(04) VALUE 0006 . 05 G1-K03-VALUE PIC X(06) VALUE SPACES. * 01 G1-T01-TEXTLIST. 05 G1-T01-FLAG PIC X(01) VALUE "T". 05 G1-T01-ROW-SKIP PIC 9(02) VALUE 0002 . 05 G1-T01-COL-SKIP PIC 9(02) VALUE 0025 . 05 G1-T01-TEXT-LENGTH PIC 9(04) VALUE 0029 . 05 FILLER PIC X(29) VALUE "PF1 - End input and process". * 01 G1-T02-TEXTLIST. 05 G1-T02-FLAG PIC X(01) VALUE "T". 05 G1-T02-ROW-SKIP PIC 9(02) VALUE 0001 . 05 G1-T02-COL-SKIP PIC 9(02) VALUE 0025 . 05 G1-T02-TEXT-LENGTH PIC 9(04) VALUE 0030 . 05 FILLER PIC X(30) VALUE "PF16 - End without processing". * / ****************************************************************** * * * PROCEDURE DIVISION * * * ****************************************************************** * PROCEDURE DIVISION. MAIN-PARAGRAPH. MOVE ZERO TO G1-MESSAGE-NO. PERFORM 1000-ACCEPT-INPUT UNTIL INPUT-COMPLETE. IF PF1-PRESSED AND WORK-FILE-OPEN CLOSE WORKFIL1 OPEN INPUT WORKFIL1 IF WORKFILE-SPACE > ZERO CLOSE WORKFIL1 PERFORM 2000-SORT-FILE PERFORM 3000-BUILD-TEXT-FILE PERFORM 4000-SCRATCH-WORK-FILES. STOP RUN. / ****************************************************************** * Accept masked input specification from user ****************************************************************** * 1000-ACCEPT-INPUT. CALL "CGETPARM" USING G1-PARMLIST G1-K01-FILE G1-K02-LIBRARY G1-K03-VOLUME G1-T01-TEXTLIST G1-T02-TEXTLIST. IF ENTER-KEY-PRESSED AND FIRST-TIME MOVE ANSWER-NO TO FIRST-TIME-FLAG OPEN OUTPUT WORKFIL1 CLOSE WORKFIL1 OPEN EXTEND WORKFIL1. IF ENTER-KEY-PRESSED COMPUTE G1-MESSAGE-NO = G1-MESSAGE-NO + 1 PERFORM 1100-FIND-FILES. / ****************************************************************** * Use the FIND subroutine to extract file list ****************************************************************** * 1100-FIND-FILES. MOVE +1 TO FIND-STARTER. MOVE +32767 TO FIND-COUNTER. MOVE ZERO TO FIND-FILE-COUNT. CALL "FIND" USING G1-K01-VALUE G1-K02-VALUE G1-K03-VALUE FIND-STARTER FIND-COUNTER WORKFIL1 FIND-FILE-COUNT FIND-RECEIVER-TYPE. / ****************************************************************** * Sort the output file ****************************************************************** * 2000-SORT-FILE. MOVE 0015 TO SORTCALL-FIELD-POSITION (1). MOVE 0008 TO SORTCALL-FIELD-LENGTH (1). MOVE "C" TO SORTCALL-FIELD-TYPE (1). MOVE "A" TO SORTCALL-ORDER (1). MOVE 0007 TO SORTCALL-FIELD-POSITION (2). MOVE 0008 TO SORTCALL-FIELD-LENGTH (2). MOVE "C" TO SORTCALL-FIELD-TYPE (2). MOVE "A" TO SORTCALL-ORDER (2). MOVE 0001 TO SORTCALL-FIELD-POSITION (3). MOVE 0006 TO SORTCALL-FIELD-LENGTH (3). MOVE "C" TO SORTCALL-FIELD-TYPE (3). MOVE "A" TO SORTCALL-ORDER (3). MOVE ZERO TO SORTCALL-FIELD-POSITION (4) SORTCALL-FIELD-POSITION (5) SORTCALL-FIELD-POSITION (6) SORTCALL-FIELD-POSITION (7) SORTCALL-FIELD-POSITION (8) SORTCALL-FIELD-LENGTH (4) SORTCALL-FIELD-LENGTH (5) SORTCALL-FIELD-LENGTH (6) SORTCALL-FIELD-LENGTH (7) SORTCALL-FIELD-LENGTH (8). CALL "SORTCALL" USING SORTCALL-PARAMETERS SORTCALL-RETURN-CODE. IF SORTCALL-RETURN-CODE NOT = ZERO IF SORTCALL-RETURN-CODE = 4 DISPLAY "NO RECORDS FOUND - PROGRAM WILL END." STOP RUN ELSE DISPLAY "ERROR SORTING FILE - STATUS = " SORTCALL-RETURN-CODE STOP RUN. / ****************************************************************** * Build text file ****************************************************************** * 3000-BUILD-TEXT-FILE. OPEN INPUT WORKFIL2. OPEN OUTPUT TEXT-FILE. PERFORM U-WORKFIL2-READ-NEXT. MOVE WORKFIL2-RECORD TO WORKFIL2-HOLD. IF WORKFIL2-I-O-SUCCESSFUL PERFORM 3200-PROCESS-TEXT-FILE UNTIL WORKFIL2-END-OF-FILE. CLOSE TEXT-FILE WORKFIL2. / ****************************************************************** * Move fields to text file ****************************************************************** * 3200-PROCESS-TEXT-FILE. MOVE SPACES TO TEXTFILE-RECORD. COMPUTE LINE-NUMBER = LINE-NUMBER + 100. MOVE WORKFIL2-FILE TO TEXTFILE-FILE. MOVE WORKFIL2-LIBRARY TO TEXTFILE-LIBRARY. MOVE WORKFIL2-VOLUME TO TEXTFILE-VOLUME. MOVE LINE-NUMBER TO TEXTFILE-SEQ. WRITE TEXTFILE-RECORD. PERFORM U-WORKFIL2-READ-NEXT UNTIL WORKFIL2-RECORD NOT = WORKFIL2-HOLD OR WORKFIL2-END-OF-FILE. IF WORKFIL2-END-OF-FILE NEXT SENTENCE ELSE MOVE WORKFIL2-RECORD TO WORKFIL2-HOLD. / ****************************************************************** * Scratch work files ****************************************************************** * 4000-SCRATCH-WORK-FILES. CALL "SCRATCH" USING SCRATCH-TYPE SORTCALL-IN-FILE SORTCALL-IN-LIBRARY SORTCALL-IN-VOLUME SCRATCH-RETURN-CODE. CALL "SCRATCH" USING SCRATCH-TYPE SORTCALL-OUT-FILE SORTCALL-OUT-LIBRARY SORTCALL-OUT-VOLUME SCRATCH-RETURN-CODE. / ****************************************************************** * WORKFIL2 read next record ****************************************************************** * U-WORKFIL2-READ-NEXT. READ WORKFIL2 NEXT RECORD AT END MOVE WORKFIL2-FILE-STATUS TO WORKFIL2-FILE-STATUS.