IDENTIFICATION DIVISION. PROGRAM-ID. UIF320. AUTHOR. B. Wallis. INSTALLATION. Fleetwood Enterprises, Inc. DATE-WRITTEN. 29-Feb-84. ****************************************************************************** * * PROGRAM FUNCTIONS: * This subprogram will take a transaction record, use SCOPE, spawn a * subprocess or do a straight process. These actions will build * the symbol table. Then read the transaction command file, * build a VMS command file, and execute or submit the command file. It * will then return to the calling program with a return status which is * the return status of the job which was spawned (or the return status * of the subprocess which did the submit) and the return status of any * function which might have failed during the running of this program * (or success). * * PROGRAM OPTIONS: * This subprogram assumes that any transaction which it gets is legal to * run and consequently does no security checking. * * PROGRAM MODIFICATIONS: * * AUTHOR T. Moore * DATE 29-May-86 * VERSION 2-D * * PROGRAM CHANGES: * There was a problem with a GOLD M not closing transaction-file. * Transaction-file was being closed by a segment of the program * which would not get executed if the user typed a GOLD M. * Modified program to close transaction-file just before exit. * ****************************************************************************** / ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT OPTIONAL TRANSACTION-FILE ASSIGN TO "UIF_TRANSACTION_DEFAULTS:". SELECT COMMAND-FILE ASSIGN TO "UIF_COMMAND_DEFAULTS:". SELECT OPTIONAL SCOPE-RECORD-FILE ASSIGN TO "UIF_SCOPE_RECORD_DEFAULTS:". SELECT OPTIONAL SYMBOL-TABLE-FILE ASSIGN TO DISK. / DATA DIVISION. FILE SECTION. * * Please note that in the input file (TRANSACTION-FILE) the DEPENDING * item is automatically set by the system each time a record is read. * In the output file (COMMAND-FILE) the DEPENDING item is used to * actually determine the number of characters output. * FD TRANSACTION-FILE RECORD VARYING FROM 1 TO 255 DEPENDING ON CNT-TRANSACTION-LINE-LENGTH VALUE OF ID IS WS-TRANSACTION-NAME. 01 TRANSACTION-LINE PIC X(255). FD COMMAND-FILE RECORD VARYING FROM 1 TO 255 DEPENDING ON CNT-COMMAND-LINE-LENGTH VALUE OF ID IS WS-TRANSACTION-NAME. 01 COMMAND-LINE PIC X(255). FD SCOPE-RECORD-FILE VALUE OF ID IS WS-SCOPE-FILE-NAME. 01 SCOPE-FORM-RECORD. 05 PIC X(13). 88 VALID-SCOPE-NAME VALUE " 05 SCR-". 05 SCOPE-SYMBOL-NAME PIC X(27). 05 PIC X(5). 05 SCOPE-PICTURE PIC X(35). FD SYMBOL-TABLE-FILE VALUE OF ID IS "UIF320:". 01 SYMBOL-TABLE-FILE-RECORD PIC X(6702). / WORKING-STORAGE SECTION. 01 PROG-ID PIC X(9) VALUE "UIF320-2B". 01 CLEAR-SCREEN COMP PIC S9(9) VALUE 1. 01 COUNTERS COMP. 05 CNT-CHARACTERS-MOVED PIC S9(9). 05 CNT-CHARACTERS PIC S9(9). 05 CNT-COMMAND-LINE-LENGTH PIC 9(9). 05 CNT-FIRST-CHARACTER-POSITION PIC S9(9). 05 CNT-NEXT-COMMAND-CHARACTER PIC S9(9). 05 CNT-NEXT-TRANSACTION-CHARACTER PIC S9(9). 05 CNT-NUMBER-OF-FIELDS-MOVED PIC S9(9). 05 CNT-NUMBER-LENGTH PIC S9(9). 05 CNT-PARAMETER-LENGTH PIC S9(9). 05 CNT-SCOPE-RECORD PIC S9(5). 05 CNT-TABLE-ENTRIES PIC S9(9). 05 CNT-TRANSACTION-LINE-LENGTH PIC 9(9). 01 CURRENT-SYMBOLS. 05 CURRENT-SYMBOL-ALPHA-VALUE PIC X(31). 05 CURRENT-SYMBOL-NUMERIC-VALUE PIC -(10).9(9). 01 ERROR-CODES COMP. * * Make sure all error codes are even numbers * 05 ERROR-UNDEFINED-SYMBOL PIC S9(9) VALUE 2. 05 ERROR-UNDEFINED-SYMBOL-TYPE PIC S9(9) VALUE 4. 05 ERROR-NO-TRANSACTION-FILE PIC S9(9) VALUE 6. 05 ERROR-NO-SCOPE-FILE PIC S9(9) VALUE 8. 05 ERROR-SCOPE-ERROR PIC S9(9) VALUE 10. 05 ERROR-SCOPE-VALIDITY-CHECK PIC S9(9) VALUE 12. 05 ERROR-NO-SYMBOLS PIC S9(9) VALUE 14. 05 ERROR-NO-PROCESSING PIC S9(9) VALUE 16. 05 ERROR-NO-SYMBOL-FILE PIC S9(9) VALUE 18. 05 ERROR-IN-SPECIAL-PROCESS PIC S9(9) VALUE 20. 05 ERROR-MENU PIC S9(9) VALUE 22. 01 EXECUTE-LINE PIC X(127). 01 GENERIC-FORM PIC X(3168). 01 HOLD-COMMAND-LINE PIC X(255). / 01 MAXIMUM-VALUES COMP. * * If the size of the corresponding data items (i.e. their PIC clause) * changes you must change these items. * 05 MAX-ALPHA-LENGTH PIC S9(9) VALUE 31. 05 MAX-INTEGER-SIZE PIC S9(9) VALUE 9. 05 MAX-NUMERIC-LENGTH PIC S9(9) VALUE 20. 05 MAX-NUMERIC-SIZE PIC S9(9) VALUE 18. 05 MAX-TRANSACTION-NAME-LENGTH PIC S9(9) VALUE 9. 01 MESSAGES. 05 MSG-INVALID-ESCAPE PIC X(14) VALUE "Invalid choice". 05 MSG-ABORT PIC X(28) VALUE "Transaction has been aborted". 01 PARAMETER PIC X(31). 01 PARAMETER-DELIMITER PIC X(1) VALUE "~". 01 RETURN-SWITCHES COMP. 05 SS-NORMAL PIC S9(9) VALUE EXTERNAL SS$-NORMAL. * * If the prefix to the forms ever change, then this is the place to * change it. Also it will have to be changed in the FD. * 01 SCOPE-PREFIX PIC X(4) VALUE "SCR-". / COPY "SCOPE-STATUS-RECORD" OF "LIB:SCPLIB.TLB". / 01 SWITCHES. 05 SW-ABORT PIC X(1). 88 ABORT VALUE "T". 88 NOT-ABORT VALUE "F". 05 SW-MENU PIC X(1). 88 MENU VALUE "T". 88 NOT-MENU VALUE "F". 05 SW-END-OF-FILE PIC X(1). 88 END-OF-FILE VALUE "T". 88 NOT-END-OF-FILE VALUE "F". 05 SW-PROCESS PIC X(1). 88 DO-PROCESS VALUE "T". 88 DO-NOT-PROCESS VALUE "F". 05 SW-NEG-AMOUNT PIC X(1). 88 NEG-AMOUNT VALUE "T". 88 NOT-NEG-AMOUNT VALUE "F". 05 SW-REC-END-OF-FILE PIC X(1). 88 REC-END-OF-FILE VALUE "T". 88 REC-NOT-END-OF-FILE VALUE "F". 05 SW-SCOPE-RECORD-FILE PIC X(1). 88 SCOPE-RECORD-FILE-PRESENT VALUE "T". 88 SCOPE-RECORD-FILE-NOT-PRESENT VALUE "F". 05 SW-SCREEN-FINISHED PIC X(1). 88 SCREEN-FINISHED VALUE "T". 88 SCREEN-NOT-FINISHED VALUE "F". 05 SW-TRANSACTION-FILE-PRESENT PIC X(1). 88 TRANSACTION-FILE-PRESENT VALUE "T". 88 TRANSACTION-FILE-NOT-PRESENT VALUE "F". 01 SUBROUTINE-RETURN-STATUS COMP PIC S9(9). / COPY "SYMBOL-TABLE-RECORD" OF "LIB:UIFLIB.TLB". / 01 WS-SCOPE-FILE-NAME PIC X(31). 01 WS-SCOPE-WORK-FIELDS. 05 ALPHA-PIC COMP PIC S9(5). 05 DONT-WANT-1 PIC X(31). 05 ERROR-MESSAGE PIC X(80). 05 F-POSITION COMP PIC S9(9). 05 IMPLIED-DEC COMP PIC S9(5). 05 PIC-1-2-3 PIC X(3) JUST RIGHT. 05 PIC-NUMERIC-1-2-3 REDEFINES PIC-1-2-3 PIC 9(3). 05 PIC-4-5-6 PIC X(3) JUST RIGHT. 05 PIC-NUMERIC-4-5-6 REDEFINES PIC-4-5-6 PIC 9(3). 05 PICK-CNTR COMP PIC S9(5). 05 S-BEGIN COMP PIC S9(5). 05 S-POSITION COMP PIC S9(9). 05 TEMP-AREA-1 PIC X(31). 05 TEMP-AREA-2 PIC X(31). 05 WRK-DECIMAL PIC S9(9). 05 WRK-INTEGER PIC S9(9). 05 WRK-TABLE-CNT COMP PIC S9(5). 05 WS-ALPHA-FIELD PIC X(18) JUST RIGHT. 05 WS-NUM-FIELD REDEFINES WS-ALPHA-FIELD PIC S9(18). 05 WS-NUM-FIELD-STRIPPED PIC 9(18). 01 WS-TRANSACTION-FORM PIC X(31). 01 WS-TRANS-FORM REDEFINES WS-TRANSACTION-FORM. 05 PIC X(1). 88 STRAIGHT-PROCESS VALUE " ". 88 SPECIAL-PROCESS VALUE "@". 88 USE-TRANS-NAME VALUE "*". 88 USE-TRANS-FORM VALUES "A" THRU "Z". 05 PIC X(30). 01 WS-TRANSACTION-NAME PIC X(9). / LINKAGE SECTION. 01 SUBPROCESS-RETURN-STATUS COMP PIC S9(9). 01 TRANSACTION-NAME PIC X(9). 01 TRANSACTION-TYPE PIC X(1). 88 INTER-PROG VALUE "I". 88 BATCH-PROG VALUE "B". 01 TRANSACTION-FORM PIC X(31). 01 TRANSACTION-SCOPE-ERROR-NO COMP PIC S9(5). 01 TRANSACTION-SWITCH PIC X(31). / PROCEDURE DIVISION USING TRANSACTION-NAME, TRANSACTION-TYPE, TRANSACTION-FORM, TRANSACTION-SWITCH, TRANSACTION-SCOPE-ERROR-NO, SUBPROCESS-RETURN-STATUS GIVING SUBROUTINE-RETURN-STATUS. ****************************************************************************** INITIALIZATION SECTION. ****************************************************************************** 001-INITIALIZE. * * Set up initial parameters and defaults * MOVE SS-NORMAL TO SUBROUTINE-RETURN-STATUS. MOVE SS-NORMAL TO SUBPROCESS-RETURN-STATUS. MOVE TRANSACTION-FORM TO WS-TRANSACTION-FORM. MOVE TRANSACTION-NAME TO WS-TRANSACTION-NAME. SET TRANSACTION-FILE-NOT-PRESENT TO TRUE. SET SCOPE-RECORD-FILE-NOT-PRESENT TO TRUE. MOVE ZEROS TO SYMBOL-TABLE-CNT. SET NOT-MENU TO TRUE. GO TO 050-MAIN. / ****************************************************************************** MAIN SECTION. ****************************************************************************** 050-MAIN. * * This is the high level logic * INITIALIZE WS-SCOPE-FILE-NAME. INITIALIZE CNT-SCOPE-RECORD. * * First determine if the .JOB file is present. If not, * the calling program will output the message "Job not * implemented yet". We check for the .job existing here * so the user does not get a confusing "SCOPE (.REC) FILE * NOT FOUND" error message. * OPEN INPUT TRANSACTION-FILE. PERFORM 310-READ-TRANSACTION-FILE THRU 310-EXIT. IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 100-BUILD-SYMBOL-TABLE THRU 100-EXIT. IF SUBROUTINE-RETURN-STATUS IS SUCCESS IF NOT-MENU PERFORM 300-BUILD-COMMAND-FILE THRU 300-EXIT IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 400-DO-TRANSACTION THRU 400-EXIT END-IF ELSE MOVE ERROR-MENU TO SUBROUTINE-RETURN-STATUS END-IF END-IF. CLOSE TRANSACTION-FILE. EXIT PROGRAM. / ******************** SUBROUTINE SECTION. ******************** 100-BUILD-SYMBOL-TABLE. * * Determine what type of processing is to be done. * EVALUATE TRUE TRUE WHEN STRAIGHT-PROCESS INTER-PROG PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT SET INTERACTIVE-MODE (SYMBOL-TABLE-CNT) TO TRUE WHEN STRAIGHT-PROCESS BATCH-PROG PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT MOVE TRANSACTION-SWITCH TO SYMBOL-ALPHA-VALUE (SYMBOL-TABLE-CNT) WHEN USE-TRANS-NAME INTER-PROG MOVE TRANSACTION-NAME TO TRANSACTION-FORM MOVE TRANSACTION-FORM TO WS-TRANSACTION-FORM PERFORM 120-PROCESS-FORMS THRU 120-EXIT IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT SET INTERACTIVE-MODE (SYMBOL-TABLE-CNT) TO TRUE END-IF WHEN USE-TRANS-NAME BATCH-PROG MOVE TRANSACTION-NAME TO TRANSACTION-FORM MOVE TRANSACTION-FORM TO WS-TRANSACTION-FORM PERFORM 120-PROCESS-FORMS THRU 120-EXIT IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT MOVE TRANSACTION-SWITCH TO SYMBOL-ALPHA-VALUE (SYMBOL-TABLE-CNT) END-IF WHEN USE-TRANS-FORM INTER-PROG PERFORM 120-PROCESS-FORMS THRU 120-EXIT IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT SET INTERACTIVE-MODE (SYMBOL-TABLE-CNT) TO TRUE END-IF / WHEN USE-TRANS-FORM BATCH-PROG PERFORM 120-PROCESS-FORMS THRU 120-EXIT IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 110-STRAIGHT-PROCESSING THRU 110-EXIT MOVE TRANSACTION-SWITCH TO SYMBOL-ALPHA-VALUE (SYMBOL-TABLE-CNT) END-IF WHEN SPECIAL-PROCESS ANY PERFORM 200-PROCESS-SPECIAL-EXE THRU 200-EXIT WHEN OTHER MOVE ERROR-NO-PROCESSING TO SUBROUTINE-RETURN-STATUS END-EVALUATE. 100-EXIT. EXIT. / 110-STRAIGHT-PROCESSING. * * Straight processing means that it is an interactive screen or a batch * request with no required screens. So load the symbol table with this * common information. * ADD 1 TO SYMBOL-TABLE-CNT. SET TRANSACTION-MODE (SYMBOL-TABLE-CNT) TO TRUE. SET ALPHA-TYPE (SYMBOL-TABLE-CNT) TO TRUE. 110-EXIT. EXIT. 120-PROCESS-FORMS. * * Read the SCOPE record to build the symbol table for those processes * that require forms to get the symbol values. Then process the form to * retrieve the information and put it in the symbol table. * STRING TRANSACTION-FORM DELIMITED BY SPACE INTO WS-SCOPE-FILE-NAME. OPEN INPUT SCOPE-RECORD-FILE. PERFORM WITH TEST AFTER UNTIL SUBROUTINE-RETURN-STATUS IS FAILURE OR REC-END-OF-FILE PERFORM 130-READ-SCOPE-RECORD THRU 130-EXIT IF REC-NOT-END-OF-FILE AND VALID-SCOPE-NAME PERFORM 140-CREATE-SYMBOLS THRU 140-EXIT END-IF END-PERFORM. IF SUBROUTINE-RETURN-STATUS IS SUCCESS AND SCOPE-RECORD-FILE-PRESENT CLOSE SCOPE-RECORD-FILE IF SYMBOL-TABLE-CNT > ZEROS PERFORM 630-SCOPE-SCPIN THRU 630-EXIT ELSE MOVE ERROR-NO-SYMBOLS TO SUBROUTINE-RETURN-STATUS END-IF END-IF. IF SUBROUTINE-RETURN-STATUS IS SUCCESS SET SCREEN-NOT-FINISHED TO TRUE PERFORM 150-UTILIZE-THE-FORM THRU 150-EXIT UNTIL SUBROUTINE-RETURN-STATUS IS FAILURE OR MENU OR SCREEN-FINISHED PERFORM 650-SCOPE-SCPRT THRU 650-EXIT END-IF. 120-EXIT. EXIT. / 130-READ-SCOPE-RECORD. * * Read the SCOPE record. * SET REC-NOT-END-OF-FILE TO TRUE. INITIALIZE SCOPE-FORM-RECORD. READ SCOPE-RECORD-FILE AT END SET REC-END-OF-FILE TO TRUE IF SCOPE-RECORD-FILE-NOT-PRESENT MOVE ERROR-NO-SCOPE-FILE TO SUBROUTINE-RETURN-STATUS END-IF END-READ. IF REC-NOT-END-OF-FILE SET SCOPE-RECORD-FILE-PRESENT TO TRUE END-IF. 130-EXIT. EXIT. 140-CREATE-SYMBOLS. * * Determine all of the SCOPE field names, extracting only the portions * after "SCR-". Calculate the size of the SCOPE record and the size of * each field. * INITIALIZE WS-SCOPE-WORK-FIELDS. ADD 1 TO SYMBOL-TABLE-CNT. MOVE SCOPE-SYMBOL-NAME TO SYMBOL-NAME (SYMBOL-TABLE-CNT). INSPECT SCOPE-PICTURE TALLYING ALPHA-PIC FOR ALL "X". IF ALPHA-PIC > ZEROS SET ALPHA-TYPE (SYMBOL-TABLE-CNT) TO TRUE ELSE SET NUMERIC-TYPE (SYMBOL-TABLE-CNT) TO TRUE END-IF. UNSTRING SCOPE-PICTURE DELIMITED BY "(" INTO DONT-WANT-1 TEMP-AREA-1 TEMP-AREA-2. INSPECT DONT-WANT-1 TALLYING IMPLIED-DEC FOR ALL "V". IF IMPLIED-DEC > ZEROS MOVE TEMP-AREA-1 TO TEMP-AREA-2 MOVE SPACES TO TEMP-AREA-1 END-IF. UNSTRING TEMP-AREA-1 DELIMITED BY ")" INTO PIC-1-2-3. UNSTRING TEMP-AREA-2 DELIMITED BY ")" INTO PIC-4-5-6. INSPECT PIC-1-2-3 REPLACING ALL SPACES BY ZEROS. INSPECT PIC-4-5-6 REPLACING ALL SPACES BY ZEROS. MOVE PIC-NUMERIC-1-2-3 TO SYMBOL-INTEGER-SIZE (SYMBOL-TABLE-CNT). MOVE PIC-NUMERIC-4-5-6 TO SYMBOL-DECIMAL-SIZE (SYMBOL-TABLE-CNT). ADD PIC-NUMERIC-1-2-3, PIC-NUMERIC-4-5-6 TO CNT-SCOPE-RECORD. 140-EXIT. EXIT. / 150-UTILIZE-THE-FORM. * * Now call the SCOPE form and gather the necessary data to process. * IF ABORT PERFORM 610-SCOPE-SCPEN THRU 610-EXIT SET NOT-ABORT TO TRUE END-IF. SET SCREEN-FINISHED TO TRUE. IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 160-INIT-SCOPE-FIELDS THRU 160-EXIT PERFORM 640-SCOPE-SCPWR THRU 640-EXIT END-IF. IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 170-GATHER-SCOPE-DATA THRU 170-EXIT END-IF. IF SCOPE-VALID-ESCAPE MOVE SPACES TO SCOPE-ESCAPE-WORD END-IF. 150-EXIT. EXIT. 160-INIT-SCOPE-FIELDS. * * Set up the SCOPE record for processing. * INITIALIZE GENERIC-FORM. MOVE SPACES TO SCOPE-FORM-NAME. STRING WS-TRANSACTION-FORM DELIMITED BY " " INTO SCOPE-FORM-NAME. MOVE ZEROS TO SCOPE-BACKTAB-LIMIT. MOVE "*" TO SCOPE-BUFFER-NAME. MOVE 1 TO WRK-TABLE-CNT. MOVE 1 TO S-BEGIN. MOVE WS-TRANSACTION-FORM TO GENERIC-FORM (S-BEGIN:SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT)). MOVE 1 TO SCOPE-NEXT-FIELD. MOVE ZEROS TO SCOPE-END-FIELD. 160-EXIT. EXIT. / 170-GATHER-SCOPE-DATA. * * This program uses the names of the fields to process the form. * ADD S-BEGIN, SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT), SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT) GIVING S-BEGIN. ADD 1 TO WRK-TABLE-CNT. PERFORM 180-GET-SCOPE-DATA THRU 180-EXIT WITH TEST BEFORE VARYING WRK-TABLE-CNT FROM WRK-TABLE-CNT BY 1 UNTIL WRK-TABLE-CNT > SYMBOL-TABLE-CNT OR SCOPE-VALID-ESCAPE OR SUBROUTINE-RETURN-STATUS IS FAILURE OR SCOPE-NEXT-FIELD = ZEROS. 170-EXIT. EXIT. 180-GET-SCOPE-DATA. * * Finally process the SCOPE form moving the approriate data to the * symbol table. * SET DO-NOT-PROCESS TO TRUE. MOVE SPACES TO SCOPE-NEXT-NAME. STRING SCOPE-PREFIX, SYMBOL-NAME (WRK-TABLE-CNT) DELIMITED BY SIZE INTO SCOPE-NEXT-NAME. MOVE ZEROS TO SCOPE-NEXT-FIELD. PERFORM 660-SCOPE-SCPRF THRU 660-EXIT UNTIL DO-PROCESS. IF SUBROUTINE-RETURN-STATUS IS SUCCESS AND NOT SCOPE-VALID-ESCAPE IF ALPHA-TYPE (WRK-TABLE-CNT) MOVE GENERIC-FORM (S-BEGIN:SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT)) TO SYMBOL-ALPHA-VALUE (WRK-TABLE-CNT) ELSE PERFORM 190-TRANSLATE-NUMERIC-DATA THRU 190-EXIT END-IF ADD S-BEGIN, SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT), SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT) GIVING S-BEGIN END-IF. 180-EXIT. EXIT. / 190-TRANSLATE-NUMERIC-DATA. * * The alphanumeric data being passed from the generic form has to be * translated into the appropriate numeric data. The compute statements * in the performs are there to make it easier to understand the * reference modification. The main reason for these this code is to * trap the negative values. * MOVE ZEROS TO SYMBOL-INTEGER (WRK-TABLE-CNT). MOVE ZEROS TO SYMBOL-DECIMAL (WRK-TABLE-CNT). MOVE ZEROS TO WRK-INTEGER. MOVE ZEROS TO WRK-DECIMAL. MOVE SPACES TO WS-ALPHA-FIELD. MOVE GENERIC-FORM (S-BEGIN:SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT) + SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT)) TO WS-ALPHA-FIELD. INSPECT WS-ALPHA-FIELD REPLACING LEADING SPACES BY ZEROS. IF WS-NUM-FIELD IS NEGATIVE SET NEG-AMOUNT TO TRUE ELSE SET NOT-NEG-AMOUNT TO TRUE END-IF. MOVE WS-NUM-FIELD TO WS-NUM-FIELD-STRIPPED. PERFORM VARYING PICK-CNTR FROM 1 BY 1 UNTIL PICK-CNTR > SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT) COMPUTE S-POSITION = (MAX-NUMERIC-SIZE - PICK-CNTR + 1) COMPUTE F-POSITION = (SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT) - PICK-CNTR + 1) MOVE WS-NUM-FIELD-STRIPPED (S-POSITION:1) TO WRK-DECIMAL (F-POSITION:1) END-PERFORM. PERFORM VARYING PICK-CNTR FROM 1 BY 1 UNTIL PICK-CNTR > SYMBOL-INTEGER-SIZE (WRK-TABLE-CNT) COMPUTE S-POSITION = (MAX-NUMERIC-SIZE - SYMBOL-DECIMAL-SIZE (WRK-TABLE-CNT) - PICK-CNTR + 1) COMPUTE F-POSITION = (MAX-INTEGER-SIZE - PICK-CNTR + 1) MOVE WS-NUM-FIELD-STRIPPED (S-POSITION:1) TO WRK-INTEGER (F-POSITION:1) END-PERFORM. MOVE WRK-INTEGER TO SYMBOL-INTEGER (WRK-TABLE-CNT). MOVE WRK-DECIMAL TO SYMBOL-DECIMAL (WRK-TABLE-CNT). IF NEG-AMOUNT MULTIPLY -1 BY SYMBOL-NUMERIC-VALUE (WRK-TABLE-CNT) END-IF. 190-EXIT. EXIT. / 200-PROCESS-SPECIAL-EXE. * * This section controls the running (thru a spawn) of a stand alone .EXE * that is required to run before another process can be accomplished. * The reason for this requirement is the input screen is too involved * to be run through the normal processing. It takes a separate screen * program to process the screen. * PERFORM 210-SPAWN-EXE THRU 210-EXIT. IF SUBROUTINE-RETURN-STATUS IS SUCCESS AND SUBPROCESS-RETURN-STATUS IS SUCCESS PERFORM 220-PROCESS-SYMBOL-FILE THRU 220-EXIT ELSE MOVE ERROR-IN-SPECIAL-PROCESS TO SUBROUTINE-RETURN-STATUS END-IF. IF SUBROUTINE-RETURN-STATUS IS SUCCESS PERFORM 230-CHECK-FOR-TRANSACTION-MENU THRU 230-EXIT END-IF. 200-EXIT. EXIT. 210-SPAWN-EXE. * * Create the EXECUTE-LINE for the spawn utility. The name of the .EXE * is the same as the TRANSACTION-NAME. Also the program will reside in * the directory that is defined in the logical EXE:. * MOVE SPACES TO EXECUTE-LINE. STRING "$ RUN EXE:" DELIMITED BY SIZE, TRANSACTION-NAME DELIMITED BY SPACE INTO EXECUTE-LINE. PERFORM 410-SPAWN-TRANSACTION THRU 410-EXIT. 210-EXIT. EXIT. / 220-PROCESS-SYMBOL-FILE. * * Open the Symbol File, read the record into the symbol table record. * OPEN INPUT SYMBOL-TABLE-FILE. READ SYMBOL-TABLE-FILE INTO SYMBOL-TABLE-RECORD AT END MOVE ERROR-NO-SYMBOL-FILE TO SUBROUTINE-RETURN-STATUS END-READ. CLOSE SYMBOL-TABLE-FILE. 220-EXIT. EXIT. 230-CHECK-FOR-TRANSACTION-MENU. * * Check to see if the special process has a TRANSACTION-MENU. * SET NOT-MENU TO TRUE. PERFORM WITH TEST BEFORE VARYING CNT-TABLE-ENTRIES FROM 1 BY 1 UNTIL CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT OR TRANSACTION-MENU (CNT-TABLE-ENTRIES) CONTINUE END-PERFORM. IF CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT CONTINUE ELSE SET MENU TO TRUE END-IF. 230-EXIT. EXIT. / 300-BUILD-COMMAND-FILE. * * Set things up to read the transaction input file and produce the * transaction output file, do it, and clean up when we are done. * OPEN OUTPUT COMMAND-FILE. PERFORM WITH TEST BEFORE UNTIL END-OF-FILE PERFORM 320-PARSE-LINE THRU 320-EXIT PERFORM 330-WRITE-COMMAND-FILE THRU 330-EXIT PERFORM 310-READ-TRANSACTION-FILE THRU 310-EXIT END-PERFORM. CLOSE COMMAND-FILE. 300-EXIT. EXIT. 310-READ-TRANSACTION-FILE. * * We assume we are not at end of file if we are trying to read a record. * If there are no records in the transaction file, we assume it is not * present. * SET NOT-END-OF-FILE TO TRUE. INITIALIZE TRANSACTION-LINE. READ TRANSACTION-FILE AT END SET END-OF-FILE TO TRUE IF TRANSACTION-FILE-NOT-PRESENT MOVE ERROR-NO-TRANSACTION-FILE TO SUBROUTINE-RETURN-STATUS END-IF END-READ. SET TRANSACTION-FILE-PRESENT TO TRUE. 310-EXIT. EXIT. / 320-PARSE-LINE. * * Look for any parameters in the input transaction line and process * them. The routine allows for multiple parameters on the same line. * MOVE 1 TO CNT-NEXT-TRANSACTION-CHARACTER. MOVE 1 TO CNT-NEXT-COMMAND-CHARACTER. PERFORM WITH TEST AFTER UNTIL CNT-NUMBER-OF-FIELDS-MOVED < 2 OR SUBROUTINE-RETURN-STATUS IS FAILURE MOVE 0 TO CNT-NUMBER-OF-FIELDS-MOVED UNSTRING TRANSACTION-LINE DELIMITED BY PARAMETER-DELIMITER INTO HOLD-COMMAND-LINE COUNT IN CNT-CHARACTERS-MOVED PARAMETER COUNT IN CNT-PARAMETER-LENGTH WITH POINTER CNT-NEXT-TRANSACTION-CHARACTER TALLYING IN CNT-NUMBER-OF-FIELDS-MOVED IF CNT-CHARACTERS-MOVED > ZERO STRING HOLD-COMMAND-LINE (1:CNT-CHARACTERS-MOVED) DELIMITED BY SIZE INTO COMMAND-LINE WITH POINTER CNT-NEXT-COMMAND-CHARACTER END-IF IF CNT-NUMBER-OF-FIELDS-MOVED NOT < 2 PERFORM 340-SUBSTITUTE-PARAMETER THRU 340-EXIT END-IF END-PERFORM. SUBTRACT 1 FROM CNT-NEXT-COMMAND-CHARACTER. PERFORM WITH TEST BEFORE VARYING CNT-COMMAND-LINE-LENGTH FROM CNT-NEXT-COMMAND-CHARACTER BY -1 UNTIL CNT-COMMAND-LINE-LENGTH NOT > 1 OR COMMAND-LINE (CNT-COMMAND-LINE-LENGTH:1) NOT = SPACE CONTINUE END-PERFORM. 320-EXIT. EXIT. 330-WRITE-COMMAND-FILE. * Don't forget, we are writing variable length records and * CNT-COMMAND-LINE-LENGTH contains the number of characters that the * system will write. * WRITE COMMAND-LINE. 330-EXIT. EXIT. / 340-SUBSTITUTE-PARAMETER. * * Take out the parameter (everything within the delimiters) and replace * it with the value from the symbol table. If the parameter is not * found in the symbol table we return an error to the calling program. * NOTE: After executing this routine the output line we are formatting * may be a different size than the input line. * PERFORM WITH TEST BEFORE VARYING CNT-TABLE-ENTRIES FROM 1 BY 1 UNTIL CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT OR SYMBOL-NAME (CNT-TABLE-ENTRIES) = PARAMETER (1:CNT-PARAMETER-LENGTH) CONTINUE END-PERFORM. IF CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT MOVE ERROR-UNDEFINED-SYMBOL TO SUBROUTINE-RETURN-STATUS ELSE EVALUATE TRUE WHEN ALPHA-TYPE (CNT-TABLE-ENTRIES) PERFORM 350-SUBSTITUTE-ALPHA-PARAMETER THRU 350-EXIT WHEN NUMERIC-TYPE (CNT-TABLE-ENTRIES) PERFORM 360-SUBSTITUTE-NUMBER-PARAMETER THRU 360-EXIT WHEN OTHER MOVE ERROR-UNDEFINED-SYMBOL-TYPE TO SUBROUTINE-RETURN-STATUS END-EVALUATE END-IF. 340-EXIT. EXIT. 350-SUBSTITUTE-ALPHA-PARAMETER. * * To substitute an alphanumeric parameter all we do is take out the * parameter and insert the value. * MOVE SYMBOL-ALPHA-VALUE (CNT-TABLE-ENTRIES) TO CURRENT-SYMBOL-ALPHA-VALUE. PERFORM WITH TEST BEFORE VARYING CNT-CHARACTERS FROM MAX-ALPHA-LENGTH BY -1 UNTIL CURRENT-SYMBOL-ALPHA-VALUE (CNT-CHARACTERS:1) NOT = SPACE OR CNT-CHARACTERS = 1 CONTINUE END-PERFORM. STRING CURRENT-SYMBOL-ALPHA-VALUE (1:CNT-CHARACTERS) DELIMITED BY SIZE INTO COMMAND-LINE WITH POINTER CNT-NEXT-COMMAND-CHARACTER. 350-EXIT. EXIT. / 360-SUBSTITUTE-NUMBER-PARAMETER. * * To substitute a numeric parameter we must eliminate leading and * trailing spaces and then do the substition. * MOVE SYMBOL-NUMERIC-VALUE (CNT-TABLE-ENTRIES) TO CURRENT-SYMBOL-NUMERIC-VALUE. MOVE 1 TO CNT-FIRST-CHARACTER-POSITION. INSPECT CURRENT-SYMBOL-NUMERIC-VALUE TALLYING CNT-FIRST-CHARACTER-POSITION FOR LEADING SPACES. PERFORM WITH TEST BEFORE VARYING CNT-NUMBER-LENGTH FROM 1 BY 1 UNTIL CNT-NUMBER-LENGTH > MAX-NUMERIC-LENGTH - CNT-FIRST-CHARACTER-POSITION + 1 OR CURRENT-SYMBOL-NUMERIC-VALUE (CNT-FIRST-CHARACTER-POSITION + CNT-NUMBER-LENGTH:) = ALL ZEROS CONTINUE END-PERFORM. IF CNT-NUMBER-LENGTH = 1 STRING "0" DELIMITED BY SIZE INTO COMMAND-LINE WITH POINTER CNT-NEXT-COMMAND-CHARACTER ELSE STRING CURRENT-SYMBOL-NUMERIC-VALUE (CNT-FIRST-CHARACTER-POSITION:CNT-NUMBER-LENGTH) DELIMITED BY SIZE INTO COMMAND-LINE WITH POINTER CNT-NEXT-COMMAND-CHARACTER END-IF. 360-EXIT. EXIT. / 400-DO-TRANSACTION. * * Decide whether to execute the transaction interactively or to submit * it to the batch processor, assemble the appropriate line, and call the * utility subprogram to execute the line in a spawned subprocess. * PERFORM WITH TEST BEFORE VARYING CNT-TABLE-ENTRIES FROM 1 BY 1 UNTIL CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT OR TRANSACTION-MODE (CNT-TABLE-ENTRIES) CONTINUE END-PERFORM. IF CNT-TABLE-ENTRIES > SYMBOL-TABLE-CNT SET INTER-PROG TO TRUE MOVE SPACES TO EXECUTE-LINE STRING "$ @" DELIMITED BY SIZE, RMS-FILENAME OF COMMAND-FILE DELIMITED BY SPACE INTO EXECUTE-LINE PERFORM 410-SPAWN-TRANSACTION THRU 410-EXIT ELSE IF INTERACTIVE-MODE (CNT-TABLE-ENTRIES) SET INTER-PROG TO TRUE MOVE SPACES TO EXECUTE-LINE STRING "$ @" DELIMITED BY SIZE, RMS-FILENAME OF COMMAND-FILE DELIMITED BY SPACE INTO EXECUTE-LINE PERFORM 410-SPAWN-TRANSACTION THRU 410-EXIT ELSE SET BATCH-PROG TO TRUE MOVE SYMBOL-ALPHA-VALUE (CNT-TABLE-ENTRIES) TO TRANSACTION-SWITCH MOVE SPACES TO EXECUTE-LINE STRING "$ SUBMIT/NOIDENTIFY" DELIMITED BY SIZE, SYMBOL-ALPHA-VALUE (CNT-TABLE-ENTRIES) DELIMITED BY SIZE, " " DELIMITED BY SIZE, RMS-FILENAME OF COMMAND-FILE DELIMITED BY SPACE INTO EXECUTE-LINE PERFORM 410-SPAWN-TRANSACTION THRU 410-EXIT END-IF END-IF. 400-EXIT. EXIT. 410-SPAWN-TRANSACTION. * * Spawn the requested transaction. EXECUTE-LINE is set at the current * limit for a SPAWN. Whenever (if) it can be increased, UTL565 will * also have to be modified. * CALL "UTL565" USING EXECUTE-LINE, SUBPROCESS-RETURN-STATUS GIVING SUBROUTINE-RETURN-STATUS. 410-EXIT. EXIT. / 600-CHECK-SCOPE-STATUS. * * Check the SCOPE return status. * EVALUATE TRUE WHEN SCOPE-ERROR MOVE SCOPE-ERROR-NO TO TRANSACTION-SCOPE-ERROR-NO MOVE ERROR-SCOPE-ERROR TO SUBROUTINE-RETURN-STATUS WHEN SCOPE-NO-ERROR SET DO-PROCESS TO TRUE WHEN SCOPE-VALIDITY-CHECK MOVE SCOPE-ERROR-NO TO TRANSACTION-SCOPE-ERROR-NO MOVE ERROR-SCOPE-VALIDITY-CHECK TO SUBROUTINE-RETURN-STATUS WHEN SCOPE-USER-ESCAPE IF SCOPE-VALID-ESCAPE SET DO-PROCESS TO TRUE IF SCOPE-ABORT SET SCREEN-NOT-FINISHED TO TRUE MOVE MSG-ABORT TO ERROR-MESSAGE SET ABORT TO TRUE ELSE SET MENU TO TRUE END-IF ELSE MOVE MSG-INVALID-ESCAPE TO ERROR-MESSAGE END-IF END-EVALUATE. 600-EXIT. EXIT. / 610-SCOPE-SCPEN. * * SCOPE error message no bell. * CALL "SCPEN" USING BY DESCRIPTOR ERROR-MESSAGE. PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. MOVE SPACES TO ERROR-MESSAGE. 610-EXIT. EXIT. 620-SCOPE-SCPER. * * SCOPE error message with a bell. * CALL "SCPER" USING BY DESCRIPTOR ERROR-MESSAGE. PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. MOVE SPACES TO ERROR-MESSAGE. 620-EXIT. EXIT. 630-SCOPE-SCPIN. * * Intialize the SCOPE record. * CALL "SCPIN" USING BY DESCRIPTOR SCOPE-STATUS-RECORD. PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. 630-EXIT. EXIT. 640-SCOPE-SCPWR. * * Display all of the SCOPE form. * CALL "SCPWR" USING BY DESCRIPTOR GENERIC-FORM (1:CNT-SCOPE-RECORD). PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. 640-EXIT. EXIT. 650-SCOPE-SCPRT. * * Clear the screen. * CALL "SCPRT" USING BY DESCRIPTOR CLEAR-SCREEN. PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. 650-EXIT. EXIT. / 660-SCOPE-SCPRF. * * Read the SCOPE form field by field. * CALL "SCPRF" USING BY DESCRIPTOR GENERIC-FORM (1:CNT-SCOPE-RECORD). PERFORM 600-CHECK-SCOPE-STATUS THRU 600-EXIT. IF SUBROUTINE-RETURN-STATUS IS SUCCESS AND DO-NOT-PROCESS PERFORM 620-SCOPE-SCPER THRU 620-EXIT IF SCOPE-NO-ERROR SET DO-NOT-PROCESS TO TRUE END-IF END-IF. 660-EXIT. EXIT.