Google
 

Trailing-Edge - PDP-10 Archives - BB-H548C-BM - iql-source/iqa.cbl
There are 2 other files named iqa.cbl in the archive. Click here to see a list.
000100 IDENTIFICATION DIVISION.
000120 PROGRAM-ID. IQA.
000140 DATE-WRITTEN. 1978.
000160 DATE-COMPILED.
000180 SECURITY. COPYRIGHT 1981 AZREX INC.
000200 REMARKS.  IQA CRACKS THE QUERY STATEMENTS; IT PREPARES
000220           EXECUTION TABLES WHICH ARE PASSED ON TO THE
000240           EXECUTION PHASE (IQE);
000260           THIS VERSION CONTAINS THE SUMMARY TRIPLE (PRIOR
000280           BREAK VALUE) LOGIC; IT PASSES INFORMATION ASSUMING
000300           IQE IS GOING TO PROCESS INTO/FROM A COMPOSITE
000320           WORKING STORAGE BUFFER ONLY FOR HOLD,SET ALPHA-VAR,
000340           AND PRIOR-SUMMARY VALUES--OTHERWISE, IQE IS GOING
000360           TO PROCESS INTO/FROM INDIVIDUAL I/O BUFFERS.
000380
000400 ENVIRONMENT DIVISION.
000420 CONFIGURATION SECTION.
000440 SOURCE-COMPUTER. DECSYSTEM-20.
000460 OBJECT-COMPUTER. DECSYSTEM-20.
000480 SPECIAL-NAMES. CHANNEL (1) IS TOP-OF-PAGE
000500                CONSOLE IS TTY.
000520
000540 INPUT-OUTPUT SECTION.
000560 FILE-CONTROL.
000580     SELECT QCSTMT ASSIGN TO DSK.
000600     SELECT QPDICT ASSIGN TO DSK.
000620     SELECT QTANLZ ASSIGN TO DSK.
000640 I-O-CONTROL.
000660*     SAME AREA FOR QCSTMT QPDICT QTANLZ.
000680
000700 DATA DIVISION.
000720 FILE SECTION.
000740 FD  QCSTMT
000760     VALUE OF IDENTIFICATION IS QCSTMTTMP
000780     LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
000800     DATA RECORD IS QCSTMT-REC.
000820 01  QCSTMT-REC USAGE IS DISPLAY-7.
000840     02  FILLER              PICTURE X(80).
000860 FD  QPDICT
000880     VALUE OF IDENTIFICATION IS 'QPDICTSEQ'
000900     LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
000920     DATA RECORD IS QPDICT-REC.
000940 01  QPDICT-REC USAGE IS DISPLAY-7.
000960     05  FILLER              PICTURE X(150).
000980 FD  QTANLZ
001000     VALUE OF IDENTIFICATION IS QTANLZTMP
001020     LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
001040     DATA RECORD IS QTANLZ-REC.
001060 01  QTANLZ-REC              PICTURE X(90).
001080 WORKING-STORAGE SECTION.
000000*
000000 01  COPYRIGHT-NOTICE     PIC X(50)     VALUE
000000     "COPYRIGHT 1981 - AZREX, INC. - ALL RIGHTS RESERVED".
000000*
001090
001094 01  UNIVERSAL-PASSWORD      PICTURE X(6)  VALUE 'DRAGON'.
001098
001100 01  ALPHA-VAR-SPELLING      PICTURE X(01) VALUE 'A'.
001120 01  CHAR                    PICTURE X(01) VALUE SPACE.
001140 01  CURR-BUCKETDX           PICTURE S9(05) COMP VALUE ZERO.
001160 01  CURR-OPERAND            PICTURE S9(05) COMP VALUE ZERO.
001180 01  CURR-OPERATOR           PICTURE S9(05) COMP VALUE ZERO.
001200 01  CURR-PRECEDENCE         PICTURE S9(05) COMP VALUE ZERO.
001220 01  DELTA                   PICTURE S9(05) COMP.
001240 01  DEVICER                 PICTURE X(06) VALUE SPACE.
001260 01  DX-IFLEFTSIDE           PICTURE S9(05) COMP VALUE ZEROS.
001280 01  DX-LOWEST               PICTURE S9(05) COMP VALUE ZEROS.
001300 01  DX-MAX                  PICTURE S9(05) COMP VALUE 200.
001320 01  DX-SAVE                 PICTURE S9(05) COMP.
001340 01  ECHAR                   PICTURE S9(05) COMP VALUE ZEROS.
001360 01  ECODE                   PICTURE S9(03) COMP VALUE ZEROS.
001362     88  WARNING-CODE        VALUES ARE 54 55.
001380 01  EFF-PASSWORD            PICTURE X(06) VALUE SPACE.
001400 01  ELSE-X                  PICTURE S9(05) COMP VALUE ZERO.
001420 01  EOQ                     PICTURE S9(01) COMP VALUE ZERO.
001440 01  FCHAR                   PICTURE S9(05) COMP VALUE ZEROS.
001450 01  FD-BLKSIZE-L            PICTURE S9(05).
001460 01  FILENO                  PICTURE S9(05) COMP.
001480 01  FILETYPE                PICTURE S9(05) COMP VALUE ZEROS.
001500 01  FIRST-PASSWORD          PICTURE X(06) VALUE SPACES.
001520 01  FLAG-ACCUM              PICTURE S9(01) COMP VALUE ZERO.
001530 01  flag-all-blank-line     picture s9(01) comp value 1.
001540 01  FLAG-ALPHA              PICTURE S9(01) COMP VALUE ZERO.
001560 01  FLAG-BAD-CHAR           PICTURE S9(01) COMP VALUE ZERO.
001580 01  FLAG-BY                 PICTURE S9(01) COMP VALUE ZERO.
001590 01  FLAG-COMMENT            PICTURE S9(01) COMP VALUE ZERO.
001600 01  FLAG-COMPUTE            PICTURE S9(01) COMP VALUE ZERO.
001620 01  FLAG-CONTINUE           PICTURE S9(01) COMP VALUE ZERO.
001640 01  FLAG-COPY               PICTURE S9(01) COMP VALUE ZERO.
001660 01  FLAG-CREATE             PICTURE S9(01) COMP VALUE ZERO.
001680 01  FLAG-CREATE-LOOP        PICTURE S9(01) COMP VALUE ZERO.
001700 01  FLAG-DECIMAL            PICTURE S9(01) COMP VALUE ZERO.
001720 01  FLAG-DEV-LBL-PPN        PICTURE S9(01) COMP VALUE ZERO.
001740 01  FLAG-EOS                PICTURE S9(01) COMP VALUE ZERO.
001760 01  FLAG-EOS2               PICTURE S9(01) COMP VALUE ZERO.
001780 01  FLAG-ERROR              PICTURE S9(01) COMP VALUE ZERO.
001800 01  FLAG-EXIT               PICTURE S9(01) COMP VALUE ZERO.
001820 01  FLAG-FIRST-PD           PICTURE S9(01) COMP VALUE ZERO.
001840 01  FLAG-FD-FOUND           PICTURE S9(01) COMP VALUE ZERO.
001850 01  FLAG-FIND               PICTURE S9(01) COMP VALUE ZERO.
001855 01  FLAG-FINDFINI           PICTURE S9(01) COMP VALUE ZERO.
001860 01  FLAG-DD-FOUND           PICTURE S9(01) COMP VALUE ZERO.
001880 01  FLAG-IF                 PICTURE S9(01) COMP VALUE ZERO.
001890 01  flag-if-statement       picture s9(01) comp value zero.
001900 01  FLAG-IFFIRST            PICTURE S9(01) COMP VALUE ZERO.
001920 01  FLAG-GOTO               PICTURE S9(01) COMP VALUE ZERO.
001940 01  FLAG-LBL-ERROR          PICTURE S9(01) COMP VALUE ZERO.
001960 01  FLAG-LEFTLIT            PICTURE S9(01) COMP VALUE ZERO.
001970 01  FLAG-LITERAL            PICTURE S9(01) COMP VALUE ZERO.
001980 01  FLAG-LOCKED             PICTURE S9(01) COMP VALUE ZERO.
001990 01  FLAG-NON-VERB           PICTURE S9(01) COMP VALUE ZERO.
002000 01  FLAG-NOT                PICTURE S9(01) COMP VALUE ZERO.
002020 01  FLAG-OPENARGS           PICTURE S9(01) COMP VALUE ZERO.
002040 01  FLAG-PASS               PICTURE S9(01) COMP VALUE 1.
002060 01  FLAG-PEEKED             PICTURE S9(01) COMP VALUE 0.
002062 01  FLAG-PW-ITEM            PICTURE S9(01) COMP VALUE 0.
002064 01  FLAG-PW-OPEN            PICTURE S9(01) COMP VALUE 0.
002080 01  FLAG-QUERY              PICTURE S9(01) COMP VALUE ZERO.
002100 01  FLAG-QUOTE              PICTURE S9(01) COMP VALUE ZERO.
002120 01  FLAG-RANDOM-READ1       PICTURE S9(01) COMP VALUE ZERO.
002140 01  FLAG-RANDOM-READ2       PICTURE S9(01) COMP VALUE ZERO.
002160 01  FLAG-RANDOM-READ3       PICTURE S9(01) COMP VALUE ZERO.
002170 01  FLAG-SET-TO-COME        PICTURE S9(01) COMP VALUE ZERO.
002180 01  FLAG-SIGN               PICTURE S9(01) COMP VALUE ZERO.
002200 01  FLAG-SLASHES            PICTURE S9(01) COMP VALUE ZERO.
002220 01  FLAG-SORT               PICTURE S9(01) COMP VALUE ZERO.
002240 01  FLAG-STATEMENT-NO       PICTURE S9(01) COMP VALUE ZERO.
002260 01  FLAG-SUMMARY-DEF-TIME   PICTURE S9(01) COMP VALUE ZERO.
002280 01  FLAG-VERB               PICTURE S9(01) COMP VALUE ZERO.
002300 01  HX                      PICTURE S9(05) COMP VALUE ZEROS.
002320 01  I                       PICTURE S9(05) COMP VALUE ZEROS.
002340 01  LI-MAX                  PICTURE S9(05) COMP VALUE 15.
002360 01  J                       PICTURE S9(05) COMP VALUE ZEROS.
002380 01  JOB-NO                  PICTURE S9(03) COMP VALUE 001.
002400 01  K                       PICTURE S9(05) COMP VALUE ZEROS.
002420 01  L-MAX                   PICTURE S9(05) COMP VALUE 90.
002424 01  LATEST-RECTYPE          PICTURE S9(5)  COMP VALUE 0.
002440 01  LAST-PW-ENTRY           PICTURE S9(03) COMP VALUE 1.
002460 01  LAST-RD-ORIGIN          PICTURE S9(04) COMP VALUE ZEROS.
002480 01  LCHAR                   PICTURE X(01) VALUE SPACE.
002482 01  LEFT-DX                 PICTURE S9(05) COMP.
002484 01  LEFT-LEN                PICTURE S9(05) COMP.
002486 01  LEFT-TYPE               PICTURE S9(05) COMP.
002500 01  MAX-ALLOWABLE-FILES     PICTURE S9(05) COMP VALUE 001.
002520 01  MAX-FALSEGO             PICTURE S9(05) COMP VALUE 9.
002540 01  MAX-HSPACE              PICTURE S9(05) COMP VALUE 130.
002560 01  MAX-KEY-LENGTH          PICTURE S9(05) COMP VALUE 60.
002580 01  MAX-LMARGIN             PICTURE S9(05) COMP VALUE 130.
002600 01  MAX-NREPORTS            PICTURE S9(05) COMP VALUE 9.
002620 01  MAX-PROTECTS            PICTURE S9(05) COMP VALUE 10.
002640 01  MAX-TRUEGO              PICTURE S9(05) COMP VALUE 9.
002660 01  MAX-REPORTNO            PICTURE S9(05) COMP VALUE 9.
002680 01  MAX-VSPACE              PICTURE S9(05) COMP VALUE 50.
002700 01  MAXCREATEBSZ            PICTURE S9(05) COMP VALUE 640.
002720 01  MINUS-ONE               PICTURE S9(01) COMP VALUE -1.
002740 01  MINUS-ONE-DX            PICTURE S9(05) COMP VALUE 200.
002760 01  NCHAR                   PICTURE S9(05) COMP VALUE ZEROS.
002780 01  NUM-VAR-SPELLING        PICTURE X(01) VALUE 'X'.
002800 01  NUMWORD                 PICTURE S9(09)V999 VALUE ZEROS.
002820 01  NUMWORDX REDEFINES NUMWORD PICTURE X(12).
002840 01  NFILES                  PICTURE S9(05) COMP VALUE ZEROS.
002860 01  N-INPUTFILES            PICTURE S9(05) COMP VALUE ZEROS.
002880 01  N-OPENLPS               PICTURE S9(05) COMP VALUE 00.
002900 01  N-PASSWORDS             PICTURE S9(05) COMP VALUE 0.
002902 01  N-PW                    PICTURE S9(05) COMP VALUE 0.
002904 01  N-PROMPTS               PICTURE S9(05) COMP.
002920 01  N-PD                    PICTURE S9(05) COMP VALUE 0.
002940 01  N-RSE                   PICTURE S9(05) COMP VALUE ZEROS.
002942 01  N-SKEYS                 PICTURE S9(05) COMP VALUE ZEROS.
002960 01  OPERANDS-CNT            PICTURE S9(05) COMP VALUE ZEROS.
002980 01  ORIGIN                  PICTURE S9(05) COMP VALUE ZEROS.
003000 01  PARENCNT                PICTURE S9(05) COMP VALUE ZEROS.
003020 01  PD-POINTER              PICTURE S9(05) COMP.
003040 01  POPPED-X                PICTURE S9(05) COMP VALUE ZEROS.
003060 01  PPN                     PICTURE S9(10) COMP VALUE ZEROS.
003080 01  PPN-HALF                PICTURE S9(07) COMP VALUE ZEROS.
003100 01  PREV-BUCKETDX           PICTURE S9(05) COMP VALUE ZERO.
003120 01  PROJ10                  PICTURE S9(08) COMP VALUE ZEROS.
003140 01  PROJ8                   PICTURE S9(08) COMP VALUE ZEROS.
003142 01  PW-LIST                 PICTURE S9(05) COMP VALUE 0.
003144 01  PROMPT-PW-POINTER       PICTURE S9(05) COMP VALUE 0.
003160 01  PW-POINTER              PICTURE S9(05) COMP.
003180 01  Q-MAX                   PICTURE S9(05) COMP VALUE 72.
003200 01  QUATERNARY-ORIGIN       PICTURE S9(05) COMP VALUE ZEROS.
003202 01  RIGHT-LEN               PICTURE S9(05) COMP.
003204 01  RIGHT-TYPE              PICTURE S9(05) COMP.
003220 01  SAVE30                  PICTURE X(30).
003240 01  SAVE-X                  PICTURE S9(05) COMP VALUE 01.
003260 01  SAVE-XX                 PICTURE S9(05) COMP VALUE 01.
003280 01  SCALE                   PICTURE S9(05) COMP VALUE ZEROS.
003282 01  SORT-GOTO-X             PICTURE S9(05) COMP VALUE ZEROS.
003300 01  TALLI                   PICTURE S9(05) COMP VALUE ZEROS.
003320 01  T-INSTR                 PICTURE S9(05) COMP VALUE ZEROS.
003340 01  T-NUMBN                 PICTURE S9(10) COMP VALUE ZEROS.
003360 01  TCHAR                   PICTURE S9(05) COMP VALUE ZEROS.
003380 01  TEST-PROTEXCL           PICTURE S9(01) COMP VALUE ZERO.
003400 01  TEST-QUOTE              PICTURE S9(01) COMP VALUE ZERO.
003420 01  TEST-REF-NO             PICTURE S9(05) COMP VALUE ZEROS.
003440 01  TMAX                    PICTURE S9(05) COMP VALUE 20.
003460 01  TLPARENCAP              PICTURE S9(05) COMP VALUE 10.
003480 01  TRUTH                   PICTURE S9(05) COMP VALUE ZEROS.
003500 01  TYPEV                   PICTURE S9(05) COMP VALUE ZEROS.
003520 01  TYPE-ALPHA              PICTURE S9(05) COMP VALUE 1.
003540 01  TYPE-AUTHORITY          PICTURE S9(05) COMP VALUE 30.
003560 01  TYPE-AVERAGE            PICTURE S9(05) COMP VALUE 8.
003580 01  TYPE-BINARY             PICTURE S9(05) COMP VALUE 6.
003600 01  TYPE-CONSTANT           PICTURE S9(05) COMP VALUE 9.
003620 01  TYPE-DBMS               PICTURE S9(05) COMP VALUE 8.
003640 01  TYPE-DBMS-KEY           PICTURE S9(05) COMP VALUE 18.
003660 01  TYPE-FILE               PICTURE S9(05) COMP VALUE 41.
003680 01  TYPE-FILE-ASCII         PICTURE S9(05) COMP VALUE 27.
003700 01  TYPE-FILE-SIXBIT        PICTURE S9(05) COMP VALUE 26.
003720 01  TYPE-FILE-DBMS          PICTURE S9(05) COMP VALUE 28.
003740 01  TYPE-GOTO               PICTURE S9(05) COMP VALUE 20.
003760 01  TYPE-LITERAL            PICTURE S9(05) COMP VALUE 10.
003780 01  TYPE-NUMERIC            PICTURE S9(05) COMP VALUE 2.
003800 01  TYPE-NUMERIC-VARIABLE   PICTURE S9(05) COMP VALUE 7.
003820 01  TYPE-PARTIAL-KEY        PICTURE S9(05) COMP VALUE 16.
003840 01  TYPE-PD                 PICTURE S9(05) COMP VALUE 31.
003860 01  TYPE-PRIOR-SUMMARY      PICTURE S9(05) COMP VALUE 23.
003880 01  TYPE-RECORD             PICTURE S9(05) COMP VALUE 22.
003900 01  TYPE-SINGLE-KEY         PICTURE S9(05) COMP VALUE 13.
003920 01  TYPE-THRU-KEY           PICTURE S9(05) COMP VALUE 14.
003940 01  TYPE-TO-KEY             PICTURE S9(05) COMP VALUE 15.
003960 01  TYPE-SUMMARY            PICTURE S9(05) COMP VALUE 17.
003980 01  TYPE-VARIABLE           PICTURE S9(05) COMP VALUE 12.
004020 01  USER10                  PICTURE S9(08) COMP VALUE ZEROS.
004040 01  USER8                   PICTURE S9(08) COMP VALUE ZEROS.
004060 01  V                       PICTURE S9(05) COMP VALUE ZEROS.
004080 01  VA                      PICTURE S9(05) COMP VALUE ZEROS.
004090        88 SUPPRESS-CONDITION VALUES ARE -117 -118 -119 -120.
004100 01  VAA                     PICTURE S9(05) COMP VALUE ZEROS.
004120 01  VP                      PICTURE S9(05) COMP VALUE ZEROS.
004140 01  VP-NOT                  PICTURE S9(05) COMP VALUE ZERO.
004160 01  V-ACCEPT                PICTURE S9(05) COMP VALUE 14.
004180 01  V-ACROSS                PICTURE S9(05) COMP VALUE 22.
004200 01  V-ADD                   PICTURE S9(05) COMP VALUE 01.
004220 01  V-AND                   PICTURE S9(05) COMP VALUE 83.
004240 01  V-ASCENDING             PICTURE S9(05) COMP VALUE +1.
004260 01  V-AT-END                PICTURE S9(05) COMP VALUE 13.
004280 01  V-AUTHORITY             PICTURE S9(05) COMP VALUE 77.
004300 01  V-AVERAGE               PICTURE S9(05) COMP VALUE 49.
004320 01  V-BEGINNING             PICTURE S9(05) COMP VALUE 10.
004340 01  V-BOF1                  PICTURE S9(05) COMP VALUE 55.
004360 01  V-BOF2                  PICTURE S9(05) COMP VALUE 74.
004380 01  V-BOF3                  PICTURE S9(05) COMP VALUE 75.
004400 01  V-BY                    PICTURE S9(05) COMP VALUE 00.
004420 01  V-CALL                  PICTURE S9(05) COMP VALUE 54.
004440 01  V-CLOSE                 PICTURE S9(05) COMP VALUE 2.
004460 01  V-CREATE                PICTURE S9(05) COMP VALUE 09.
004480 01  V-COMPUTE               PICTURE S9(05) COMP VALUE 43.
004500 01  V-CONCAT                PICTURE S9(05) COMP VALUE 90989.
004520 01  V-COPY                  PICTURE S9(05) COMP VALUE 08.
004522 01  V-CURRENT               PICTURE S9(05) COMP VALUE -50.
004540 01  V-DATE                  PICTURE S9(05) COMP VALUE 70.
004560 01  V-DESCENDING            PICTURE S9(05) COMP VALUE -1.
004580 01  V-DISPLAY               PICTURE S9(05) COMP VALUE 15.
004600 01  V-DISPLAYON             PICTURE S9(05) COMP VALUE 34.
004620 01  V-DISPLAYOFF            PICTURE S9(05) COMP VALUE 35.
004640 01  V-DIVIDE                PICTURE S9(05) COMP VALUE 04.
004660 01  V-ELSE                  PICTURE S9(05) COMP VALUE 59.
004680 01  V-EOF                   PICTURE S9(05) COMP VALUE 09.
004700 01  V-EOF1                  PICTURE S9(05) COMP VALUE 56.
004720 01  V-EOF2                  PICTURE S9(05) COMP VALUE 71.
004740 01  V-EOF3                  PICTURE S9(05) COMP VALUE 72.
004760 01  V-EOS                   PICTURE S9(05) COMP VALUE 90909.
004780 01  V-EQUAL                 PICTURE S9(05) COMP VALUE 01.
004840 01  V-FILLER                PICTURE S9(05) COMP VALUE 58.
004860 01  V-FIND                  PICTURE S9(05) COMP VALUE 11.
004880 01  V-FIND-DBMS             PICTURE S9(05) COMP VALUE 07.
004890 01  V-FINDUPLICATE          PICTURE S9(05) COMP VALUE -16.
004900 01  V-FINDAREA              PICTURE S9(05) COMP VALUE -18.
004920 01  V-FINDFROM              PICTURE S9(05) COMP VALUE 10.
004940 01  V-FINDFIRST             PICTURE S9(05) COMP VALUE -12.
004960 01  V-FINDKEY               PICTURE S9(05) COMP VALUE 06.
004980 01  V-FINDKEY1              PICTURE S9(05) COMP VALUE 01.
005000 01  V-FINDKEY2              PICTURE S9(05) COMP VALUE 02.
005020 01  V-FINDKEY3              PICTURE S9(05) COMP VALUE 03.
005040 01  V-FINDLAST              PICTURE S9(05) COMP VALUE -13.
005060 01  V-FINDNEXT              PICTURE S9(05) COMP VALUE -15.
005080 01  V-FINDPRIOR             PICTURE S9(05) COMP VALUE -14.
005100 01  V-FINDOWNER             PICTURE S9(05) COMP VALUE -11.
005102 01  V-FINDOWNER-RECORD      PICTURE S9(05) COMP VALUE -51.
005120 01  V-FINDRECORD            PICTURE S9(05) COMP VALUE -19.
005140 01  V-FINDSET               PICTURE S9(05) COMP VALUE -20.
005160 01  V-FINDSUPPRESS          PICTURE S9(05) COMP VALUE -117.
005180 01  V-FORM-LINES            PICTURE S9(05) COMP VALUE 45.
005200 01  V-FROM                  PICTURE S9(05) COMP VALUE 11.
005220 01  V-GOTO                  PICTURE S9(05) COMP VALUE 53.
005240 01  V-GOTONR                PICTURE S9(05) COMP VALUE 52.
005260 01  V-GOTOQT                PICTURE S9(05) COMP VALUE 50.
005280 01  V-GOTOXT                PICTURE S9(05) COMP VALUE 51.
005300 01  V-GREATER               PICTURE S9(05) COMP VALUE 04.
005320 01  V-GREATEREQUAL          PICTURE S9(05) COMP VALUE 06.
005340 01  V-GROUP                 PICTURE S9(05) COMP VALUE 58.
005360 01  V-HEADING               PICTURE S9(05) COMP VALUE 24.
005380 01  V-HEADINGON             PICTURE S9(05) COMP VALUE 28.
005400 01  V-HEADINGOFF            PICTURE S9(05) COMP VALUE 29.
005420 01  V-HOLD                  PICTURE S9(05) COMP VALUE 40.
005440 01  V-HSPACE                PICTURE S9(05) COMP VALUE 18.
005460 01  V-IF                    PICTURE S9(05) COMP VALUE 61.
005480 01  V-IFANY                 PICTURE S9(05) COMP VALUE 64.
005500 01  V-IFFIRST               PICTURE S9(05) COMP VALUE 62.
005520 01  V-IFFIRSTIME            PICTURE S9(05) COMP VALUE 55.
005540 01  V-IFLAST                PICTURE S9(05) COMP VALUE 63.
005560 01  V-IFLASTIME             PICTURE S9(05) COMP VALUE 56.
005580 01  V-IFNEWGROUP            PICTURE S9(05) COMP VALUE 58.
005600 01  V-IFNEWPAGE             PICTURE S9(05) COMP VALUE 57.
005620 01  V-IFNEXT                PICTURE S9(05) COMP VALUE 65.
005640 01  V-IFSAME                PICTURE S9(05) COMP VALUE 66.
005660 01  V-ILLEGAL               PICTURE S9(05) COMP VALUE 99.
005680 01  V-INVALID-KEY           PICTURE S9(05) COMP VALUE 17.
005700 01  V-INVOKE                PICTURE S9(05) COMP VALUE 02.
005720 01  V-LEFT                  PICTURE S9(05) COMP VALUE -3.
005740 01  V-LESS                  PICTURE S9(05) COMP VALUE 03.
005760 01  V-LESSEQUAL             PICTURE S9(05) COMP VALUE 05.
005780 01  V-LINE                  PICTURE S9(05) COMP VALUE 00.
005800 01  V-LMARGIN               PICTURE S9(05) COMP VALUE 20.
005820 01  V-LPAREN                PICTURE S9(05) COMP VALUE 07.
005840 01  V-MARGIN                PICTURE S9(05) COMP VALUE 20.
005860 01  V-MAXIMUM               PICTURE S9(05) COMP VALUE 80.
005880 01  V-MINIMUM               PICTURE S9(05) COMP VALUE 81.
005900 01  V-MULTIPLY              PICTURE S9(05) COMP VALUE 03.
005920 01  V-NARROW                PICTURE S9(05) COMP VALUE 00.
005940 01  V-NEW                   PICTURE S9(05) COMP VALUE -5.
005960 01  V-NEWPAGE               PICTURE S9(05) COMP VALUE 25.
005980 01  V-NO                    PICTURE S9(05) COMP VALUE 00.
006000 01  V-NOT                   PICTURE S9(05) COMP VALUE 00.
006020 01  V-NOTEQUAL              PICTURE S9(05) COMP VALUE 02.
006040 01  V-OF                    PICTURE S9(05) COMP VALUE 00.
006060 01  V-OFF                   PICTURE S9(05) COMP VALUE 00.
006080 01  V-ON                    PICTURE S9(05) COMP VALUE 00.
006100 01  V-OPEN                  PICTURE S9(05) COMP VALUE 02.
006120 01  V-OR                    PICTURE S9(05) COMP VALUE 84.
006140 01  V-POP                   PICTURE S9(10) COMP VALUE -1.
006160 01  V-POP2                  PICTURE S9(05) COMP VALUE -2.
006180 01  V-NEXT                  PICTURE S9(05) COMP VALUE 12.
006200 01  V-NOP                   PICTURE S9(05) COMP VALUE 00.
006220 01  V-PAGE                  PICTURE S9(05) COMP VALUE 46.
006240 01  V-PAGE-LINE             PICTURE S9(05) COMP VALUE 44.
006260 01  V-PAGE-WIDTH            PICTURE S9(05) COMP VALUE 21.
006280 01  V-PAGING                PICTURE S9(05) COMP VALUE 26.
006300 01  V-PAGINGON              PICTURE S9(05) COMP VALUE 26.
006320 01  V-PAGINGOFF             PICTURE S9(05) COMP VALUE 27.
006340 01  V-PICTURE               PICTURE S9(05) COMP VALUE 78.
006360 01  V-PRINT                 PICTURE S9(05) COMP VALUE 16.
006380 01  V-PRINTON               PICTURE S9(05) COMP VALUE 36.
006400 01  V-PRINTOFF              PICTURE S9(05) COMP VALUE 37.
006420 01  V-PRIVACY-KEY           PICTURE S9(05) COMP VALUE 00.
006440 01  V-PRIVACY-LOCK          PICTURE S9(05) COMP VALUE 00.
006460 01  V-READ                  PICTURE S9(05) COMP VALUE 5.
006470 01  V-REOPEN                PICTURE S9(05) COMP VALUE 86.
006480 01  V-REPORT                PICTURE S9(05) COMP VALUE 23.
006500 01  V-RESET                 PICTURE S9(05) COMP VALUE 41.
006520 01  V-RESULT                PICTURE S9(05) COMP VALUE 09.
006540 01  V-REWRITE               PICTURE S9(05) COMP VALUE 87.
006560 01  V-RIGHT                 PICTURE S9(05) COMP VALUE -2.
006580 01  V-RMARGIN               PICTURE S9(05) COMP VALUE 21.
006600 01  V-RPAREN                PICTURE S9(05) COMP VALUE 85.
006620 01  V-RPTDATE               PICTURE S9(05) COMP VALUE 70.
006640 01  V-RPTDATEON             PICTURE S9(05) COMP VALUE 38.
006660 01  V-RPTDATEOFF            PICTURE S9(05) COMP VALUE 39.
006680 01  V-RPTHEAD               PICTURE S9(05) COMP VALUE 24.
006700 01  V-RPTHEADON             PICTURE S9(05) COMP VALUE 28.
006720 01  V-RPTHEADOFF            PICTURE S9(05) COMP VALUE 29.
006722 01  V-RUN-UNIT              PICTURE S9(05) COMP VALUE -23.
006740 01  V-SCHEMA                PICTURE S9(05) COMP VALUE 00.
006760 01  V-SET                   PICTURE S9(05) COMP VALUE 42.
006780 01  V-SLASHES               PICTURE S9(05) COMP VALUE 90902.
006800 01  V-SORT                  PICTURE S9(05) COMP VALUE 12.
006820 01  V-STACK                 PICTURE S9(05) COMP VALUE 05.
006840 01  V-STATEMENT-NO          PICTURE S9(05) COMP VALUE 03.
006860 01  V-STITLES               PICTURE S9(05) COMP VALUE 00.
006880 01  V-STOP                  PICTURE S9(05) COMP VALUE 1.
006900 01  V-SUB-SCHEMA            PICTURE S9(05) COMP VALUE 00.
006920 01  V-SUBTRACT              PICTURE S9(05) COMP VALUE 02.
006940 01  V-SUMMARY               PICTURE S9(05) COMP VALUE 32.
006960 01  V-SUMMARYON             PICTURE S9(05) COMP VALUE 32.
006980 01  V-SUMMARYOFF            PICTURE S9(05) COMP VALUE 33.
007000 01  V-SUPPRESSALL           PICTURE S9(05) COMP VALUE -117.
007020 01  V-SUPPRESSAREA          PICTURE S9(05) COMP VALUE -118.
007040 01  V-SUPPRESSRECORD        PICTURE S9(05) COMP VALUE -119.
007060 01  V-SUPPRESSSET           PICTURE S9(05) COMP VALUE -120.
007080 01  V-TALLY                 PICTURE S9(05) COMP VALUE 47.
007100 01  V-THAN                  PICTURE S9(05) COMP VALUE 00.
007120 01  V-THEN                  PICTURE S9(05) COMP VALUE 60.
007140 01  V-THRU                  PICTURE S9(05) COMP VALUE 06.
007160 01  V-TITLES                PICTURE S9(05) COMP VALUE 79.
007180 01  V-TITLESON              PICTURE S9(05) COMP VALUE 30.
007200 01  V-TITLESOFF             PICTURE S9(05) COMP VALUE 31.
007220 01  V-TO                    PICTURE S9(05) COMP VALUE 42.
007240 01  V-TOTAL                 PICTURE S9(05) COMP VALUE 48.
007260 01  V-VERB-CONTROL          PICTURE S9(05) COMP VALUE 04.
007280 01  V-VSPACE                PICTURE S9(05) COMP VALUE 19.
007300 01  V-WIDTH                 PICTURE S9(05) COMP VALUE 21.
007320 01  WARNING-ERROR           PICTURE S9(05) COMP VALUE 170.
007340 01  X-MAX                   PICTURE S9(05) COMP VALUE 3000.
007360 01  X-START                 PICTURE S9(05) COMP VALUE 24.
007380 01  XX                      PICTURE S9(05) COMP.
007400 01  ZERO-DX                 PICTURE S9(05) COMP VALUE 00.
007420 01  CALLED-NAME             PICTURE X(06) VALUE 'IQE   '.
007440 01  QCSTMTTMP.
007460     05  QCSTMT-PREFIX       PICTURE X(02) VALUE 'QC'.
007480     05  QC-STMT-NO          PICTURE 999 VALUE 001.
007500     05  FILLER              PICTURE X(04) VALUE 'STMP'.
007520 01  QTANLZTMP.
007540     05  FILLER              PICTURE X(02) VALUE 'QT'.
007560     05  QT-ANAL-NO          PICTURE 999 VALUE 001.
007580     05  QT-ANLZ-EXT         PICTURE X(04) VALUE 'ATMP'.
007600 01  QTNNNITMP.
007620     05  QRY-NAME            PICTURE X(09) VALUE SPACE.
007640     05  FLAG-DUMP           PICTURE S9(01) VALUE 0.
007660     05  FLAG-EXECUTE        PICTURE S9(01) VALUE 1.
007680     05  FLAG-SAVE           PICTURE S9(01) VALUE 0.
007700     05  FLAG-LIST           PICTURE S9(01) VALUE 1.
007720     05  FILLER              PICTURE X(69) VALUE SPACE.
007722     05  FILLER              PICTURE X     VALUE SPACE.
007724     05  FLAG-TMP-INPUT      PICTURE S9(01) VALUE 0.
007740 01  FD-AREA.
007760     02  FD-IDNT             PICTURE XX.
007780     02  FD-NAME             PICTURE X(30).
007800     02  FD-NDICTS           PICTURE 9(03).
007820     02  FD-DBMS-INFO.
007840         04  FD-DBMS-LABEL   PICTURE X(30).
007860         04  FILLER          PICTURE X(06).
007880     02  FILLER REDEFINES FD-DBMS-INFO.
007900         04  FD-INLABEL      PICTURE X(09).
007920         04  FD-LABEL REDEFINES FD-INLABEL.
007940             06  FD-INFILE   PICTURE X(06).
007960             06  FD-INEXT    PICTURE X(03).
007980         04  FILLER          PICTURE X(08).
008000         04  FD-PPN          PICTURE X(19).
008020     02  FD-FILETYPE         PICTURE 9.
008040     02  FD-RECSIZE          PICTURE 9(04).
008060     02  FD-BLKSIZE          PICTURE S9(04).
008080     02  FD-KEYPOS           PICTURE 9(4).
008100     02  FD-KEYLEN           PICTURE 9(3).
008120     02  FD-KEYTYPE          PICTURE 9.
008140     02  FD-KEYSIGN          PICTURE 9.
008160     02  FD-PROTECT          PICTURE X(01).
008180     02  FD-READ-PROTECT     PICTURE XX.
008200     02  FD-COPY-PROTECT     PICTURE XX.
008220     02  FD-REWRITE-PROTECT  PICTURE XX.
008240     02  FILLER              PICTURE X(48).
008260     02  FD-LAST-UPDATE      PICTURE X(06).
008280 01  FE-AREA.
008300     02  FE-IDNT             PICTURE X(02).
008320     02  FE-NAME             PICTURE X(30).
008340     02  FE-FILESPEC         PICTURE X(68).
008360     02  FE-FILETYPE         PICTURE X(01).
008380     02  FE-RECSIZE          PICTURE 9(04).
008400     02  FE-BLKSIZE          PICTURE S9(04).
008420     02  FE-KEYPOS           PICTURE 9(04).
008440     02  FE-KEYLEN           PICTURE 9(03).
008460     02  FE-KEYTYPE          PICTURE 9(01).
008480     02  FE-KEYSIGN          PICTURE 9(01).
008500     02  FE-PROTECT          PICTURE X(01).
008520     02  FE-PROTECT-READ     PICTURE X(02).
008540     02  FE-PROTECT-COPY     PICTURE X(02).
008560     02  FE-PROTECT-REWRITE  PICTURE X(02).
008580     02  FILLER              PICTURE X(19).
008600     02  FE-LAST-UPDATE      PICTURE X(06).
008620 01  DD-AREA.
008640     02  DD-IDNT             PICTURE XX.
008660     02  DD-NAME.
008680         04  DD-NAMEX PICTURE X(01) OCCURS 30 INDEXED BY DD.
008700     02  DD-TITLE1           PICTURE X(10).
008720     02  DD-TITLE2             PICTURE X(10).
008740     02  DD-TCHAR            PICTURE 99.
008760     02  DD-ECHAR             PICTURE 9(4).
008780     02  DD-FCHAR              PICTURE 9(4).
008800     02  DD-NCHAR              PICTURE 9(4).
008820     02  DD-TYPEV              PICTURE 9.
008840     02  DD-SCALE              PICTURE 9.
008860     02  DD-OFFSET             PICTURE 9.
008880     02  DD-EDITX              PICTURE 99.
008900     02  DD-PICT               PICTURE X(19).
008920     02  DD-GRPLEN           PICTURE 999.
008940     02  DD-GRPNAME          PICTURE X.
008960     02  DD-NREPEATS           PICTURE S99.
008980     02  DD-STOPV            PICTURE X.
009000     02  DD-REF-NO             PICTURE 99.
009020     02  DD-PROTEXCL           PICTURE 9.
009040     02  DD-RECTYPE            PICTURE XXX.
009060     02  FILLER              PICTURE X(47).
009080 01  HOLD-FD-NAME            PICTURE X(30) VALUE SPACE.
009100 01  PD-AREA.
009120     02  PD-IDNT             PICTURE XX.
009140     02  PD-REF-NO           PICTURE 99.
009160     02  PD-DATE-FLAG        PICTURE X.
009180     02  PD-LINE             PICTURE X.
009200     02  PD-TEXT.
009220         04  PD-CHAR         PICTURE X OCCURS 12 TIMES.
009240     02  FILLER              PICTURE X(132).
009260 01  RD-AREA.
009280     02  RD-IDNT             PICTURE XX.
009300     02  RD-NAME             PICTURE X(30).
009320     02  RD-ORIGIN           PICTURE 9(4).
009340     02  RD-LENGTH           PICTURE 9(4).
009360     02  RD-RECNO               PICTURE 9(3).
009380     02  FILLER              PICTURE X(107).
009400 01  AD-AREA REDEFINES RD-AREA.
009420     02  AD-IDNT             PICTURE XX.
009440     02  AD-NAME             PICTURE X(30).
009460     02  AD-ORIGIN           PICTURE 9(4).
009480     02  AD-LENGTH           PICTURE 9(4).
009500     02  AD-AREA-NO          PICTURE 9(3).
009520     02  FILLER              PICTURE X(107).
009540 01  SD-AREA REDEFINES AD-AREA.
009560     02  SD-IDNT             PICTURE XX.
009580     02  SD-NAME             PICTURE X(30).
009600     02  SD-ORIGIN           PICTURE 9(4).
009620     02  SD-LENGTH           PICTURE 9(4).
009640     02  SD-OWNER-REC-NO     PICTURE 9(3).
009660     02  FILLER              PICTURE X(107).
009680 01  FX-AREAS.
009700     02  FX-PRIMARY          PICTURE S9(05) COMP VALUE 1.
009720     02  PRIMARY-ORIGIN      PICTURE S9(05) COMP VALUE -1.
009740     02  PRIMARY-LENGTH      PICTURE S9(05) COMP VALUE 0.
009760     02  FX-SECONDARY        PICTURE S9(05) COMP VALUE 1.
009780     02  SECONDARY-ORIGIN     PICTURE S9(05) COMP VALUE -1.
009800     02  SECONDARY-LENGTH    PICTURE S9(05) COMP VALUE 0.
009820     02  FX-TERTIARY         PICTURE S9(05) COMP VALUE 1.
009840     02  TERTIARY-ORIGIN     PICTURE S9(05) COMP VALUE -1.
009860     02  TERTIARY-LENGTH      PICTURE S9(05) COMP VALUE 0.
009880     02  COPY-FX             PICTURE S9(05) COMP VALUE 1.
009900     02  COPY-ORIGIN         PICTURE S9(05) COMP VALUE -1.
009920     02  COPY-LENGTH         PICTURE S9(05) COMP VALUE 0.
009940     02  CREATE-FX           PICTURE S9(05) COMP VALUE 1.
009960     02  CREATE-ORIGIN       PICTURE S9(05) COMP VALUE -1.
009980     02  CREATE-LENGTH       PICTURE S9(05) COMP VALUE 0.
010000 01  REPORT-R-AREA.
010020     02  TYPE-REPORT         PICTURE S9(10) COMP VALUE 19.
010040     02  R-RPT-NO            PICTURE S9(10) COMP VALUE 1.
010060     02  R-PAGE-NO           PICTURE S9(10) COMP VALUE 0.
010080     02  R-LINE-NO           PICTURE S9(10) COMP VALUE 0.
010100     02  R-ACROSS-NO         PICTURE S9(10) COMP VALUE 1.
010120     02  R-RPTDATE           PICTURE S9(10) COMP VALUE -1.
010140     02  R-LAST-PRINTX       PICTURE S9(10) COMP VALUE 0.
010160     02  R-RPTHEADX          PICTURE S9(10) COMP VALUE 3.
010180     02  R-LAST-PRINTYPE     PICTURE S9(10) COMP VALUE 0.
010200     02  FILLER              PICTURE X(36) VALUE SPACE.
010220 01  TODAY-AREA.
010240     02  TYPE-TODAY          PICTURE S9(05) COMP VALUE 16.
010260     02  TO-NCHAR            PICTURE S9(05) COMP VALUE 06.
010280     02  TO-SCALE            PICTURE S9(05) COMP VALUE 00.
010300     02  TO-ECHAR            PICTURE S9(05) COMP VALUE 08.
010320     02  TO-TCHAR            PICTURE S9(05) COMP VALUE 05.
010340     02  TO-FCHAR            PICTURE S9(05) COMP VALUE 01.
010360     02  TO-NREPEATS         PICTURE S9(05) COMP VALUE 01.
010380     02  TO-GRPLEN           PICTURE S9(10) COMP.
010400     02  TO-TITLE1           PICTURE X(10) VALUE SPACE.
010420     02  TO-TITLE2           PICTURE X(10) VALUE 'TODAY'.
010440     02  TO-PICT             PICTURE X(20) VALUE '99/99/99'.
010460     02  TO-GRPNAME          PICTURE X(01) VALUE SPACE.
010480     02  TO-STOPV            PICTURE X(01) VALUE '1'.
010482 01  ERROR-STATUS-AREA.
010484     02  TYPE-ERROR-STATUS     PIC S9(10) COMP VALUE 24.
010486     02  ER-NCHAR			PIC S9(10) COMP VALUE 10.
010488     02  ER-SCALE     PIC S9(10) COMP VALUE 0.
010490     02  ER-ECHAR			PIC S9(10) COMP VALUE 10.
010492     02  ER-TCHAR			PIC S9(10) COMP VALUE 6.
010494     02  ER-FCHAR			PIC S9(10) COMP VALUE 1.
010496     02  ER-NREPEATS		PIC S9(10) COMP VALUE 1.
010498     02  ER-GRPLEN		PIC S9(10) COMP VALUE 0.
010500     02  ER-TITLE1		PIC X(10) VALUE 'ERROR'.
010502     02  ER-TITLE2		PIC X(10) VALUE 'STATUS'.
010504     02  ER-PICT  PIC X(20) VALUE "ZZZZZZZZZ9".
010506     02  ER-GRPNAME		PIC X(1) VALUE SPACE.
010508     02  ER-STOPV			PIC X(1) VALUE SPACE.
010500 01  XRANDOM-AREA.
010520     02  TYPE-XRANDOM         PICTURE S9(05) COMP VALUE 11.
010540     02  XR-NCHAR            PICTURE S9(05) COMP VALUE 10.
010560     02  XR-SCALE            PICTURE S9(05) COMP VALUE 00.
010580     02  XR-ECHAR            PICTURE S9(05) COMP VALUE 10.
010600     02  XR-TCHAR            PICTURE S9(06) COMP VALUE 06.
010620     02  XR-FCHAR            PICTURE S9(05) COMP VALUE 01.
010640     02  XR-NREPEATS         PICTURE S9(05) COMP VALUE 01.
010660     02  XR-GRPLEN           PICTURE S9(05) COMP.
010680     02  XR-TITLE1           PICTURE X(10) VALUE 'RANDOM'.
010700     02  XR-TITLE2           PICTURE X(10) VALUE 'NUMBER'.
010720     02  XR-PICT             PICTURE X(20) VALUE '9999999999'.
010740     02  XR-GRPNAME          PICTURE X(01) VALUE SPACE.
010741     02  XR-STOPV            PICTURE X(01) VALUE '1'.
010742 01  AREA-IDENT-AREA.
010743     02  TYPE-AREA-IDENT      PICTURE S9(10) COMP VALUE 36.
010744     02  AI-NCHAR            PICTURE S9(10) COMP VALUE 30.
010745     02  AI-SCALE            PICTURE S9(10) COMP VALUE 0.
010746     02  AI-ECHAR            PICTURE S9(10) COMP VALUE 30.
010747     02  AI-TCHAR            PICTURE S9(10) COMP VALUE 10.
010748     02  AI-FCHAR            PICTURE S9(10) COMP VALUE 0.
010749     02  AI-REPEATS          PICTURE S9(10) COMP VALUE 1.
010750     02  AI-GRPLEN           PICTURE S9(10) COMP VALUE 0.
010751     02  AI-TITLE1           PICTURE X(10) VALUE 'AREA'.
010752     02  AI-TITLE2           PICTURE X(10) VALUE 'IDENTIFIER'.
010753     02  AI-PICT             PICTURE X(20) VALUE SPACES.
010754     02  AI-FILLER1          PICTURE X(2).
010762 01  AREA-NAME-AREA.
010763     02  TYPE-AREA-NAME      PICTURE S9(10) COMP VALUE 34.
010764     02  AN-NCHAR            PICTURE S9(10) COMP VALUE 30.
010765     02  AN-SCALE            PICTURE S9(10) COMP VALUE 0.
010766     02  AN-ECHAR            PICTURE S9(10) COMP VALUE 30.
010767     02  AN-TCHAR            PICTURE S9(10) COMP VALUE 4.
010768     02  AN-FCHAR            PICTURE S9(10) COMP VALUE 0.
010769     02  AN-REPEATS          PICTURE S9(10) COMP VALUE 1.
010770     02  AN-GRPLEN           PICTURE S9(10) COMP VALUE 0.
010771     02  AN-TITLE1           PICTURE X(10) VALUE 'AREA'.
010772     02  AN-TITLE2           PICTURE X(10) VALUE 'NAME'.
010773     02  AN-PICT             PICTURE X(20) VALUE SPACES.
010774     02  AN-FILLER1          PICTURE X(2).
010775 01  CURRENT-RECORD-KEY-AREA.
010776     02  TYPE-CURR-REC-KEY   PICTURE S9(10) COMP VALUE 32.
010777     02  CK-NCHAR            PICTURE S9(10) COMP VALUE 10.
010778     02  CK-SCALE            PICTURE S9(10) COMP VALUE 0.
010779     02  CK-ECHAR            PICTURE S9(10) COMP VALUE 10.
010780     02  CK-TCHAR            PICTURE S9(10) COMP VALUE 10.
010781     02  CK-FCHAR            PICTURE S9(10) COMP VALUE 0.
010782     02  CK-REPEATS          PICTURE S9(10) COMP VALUE 1.
010783     02  CK-GRPLEN           PICTURE S9(10) COMP VALUE 0.
010784     02  CK-TITLE1           PICTURE X(10) VALUE 'CURRENT'.
010785     02  CK-TITLE2           PICTURE X(10) VALUE 'RECORD KEY'.
010786     02  CK-PICT             PICTURE X(20) VALUE 'ZZZZZZZZZ9'.
010787     02  CK-FILLER1          PICTURE XX.
010790 01  RECORD-NAME-AREA.
010791     02  TYPE-RECORD-NAME    PICTURE S9(10) COMP VALUE 33.
010792     02  RN-NCHAR            PICTURE S9(10) COMP VALUE 30.
010793     02  RN-SCALE            PICTURE S9(10) COMP VALUE 0.
010794     02  RN-ECHAR            PICTURE S9(10) COMP VALUE 30.
010795     02  RN-TCHAR            PICTURE S9(10) COMP VALUE 6.
010796     02  RN-FCHAR            PICTURE S9(10) COMP VALUE 0.
010797     02  RN-REPEATS          PICTURE S9(10) COMP VALUE 1.
010798     02  RN-FILLER           PICTURE S9(10) COMP VALUE 0.
010799     02  RN-TITLE1           PICTURE X(10) VALUE 'RECORD'.
010800     02  RN-TITLE2           PICTURE X(10) VALUE 'NAME'.
010801     02  RN-PICT             PICTURE X(20) VALUE SPACES.
010802     02  RN-FILLER1          PICTURE XX.
010803 01  ERROR-COUNT-AREA.
010804        02  TYPE-ERROR-COUNT PIC S9(10) COMP  VALUE 35.
010805        02  EC-NCHAR         PIC S9(10) COMP  VALUE 10.
010806        02  EC-SCALE         PIC S9(10) COMP  VALUE 0.
010807        02  EC-ECHAR         PIC S9(10) COMP  VALUE 10.
010808        02  EC-TCHAR         PIC S9(10) COMP  VALUE 5.
010809        02  EC-FCHAR         PIC S9(10) COMP  VALUE 0.
010810        02  EC-REPEATS       PIC S9(10) COMP  VALUE 1.
010811        02  EC-GRPLEN        PIC S9(10) COMP  VALUE 0.
010812        02  EC-TITLE1        PIC X(10) VALUE "ERROR".
010813        02  EC-TITLE2        PIC X(10) VALUE "COUNT".
010814        02  EC-PICT          PIC X(20) VALUE "ZZZZZZZZZ9".
010815        02  EC-FILLER1       PIC X(02).
010816 01  PPN-TABLE.
010817     05  PPN-WORK            PICTURE X(19) VALUE SPACE.
010820     05  FILLER REDEFINES PPN-WORK.
010840       10  PPN-ID            PICTURE S9(10) COMP.
010860       10  FILLER            PICTURE X(13).
010880     05  PPN-CHAR REDEFINES PPN-WORK PICTURE X OCCURS 19
010900         INDEXED BY PX.
010920     05  PPN-NUM REDEFINES PPN-CHAR PICTURE 9 OCCURS 19
010940         INDEXED BY PN.
010960     05  PPN-NUMBER          PICTURE 9(6) VALUE ZEROS.
010980     05  PPN-DIGIT REDEFINES PPN-NUMBER PICTURE 9 OCCURS 6
011000         INDEXED BY PI.
011002 01  HIDDEN-ASCII       PIC S9(10) COMP VALUE 29691190.
011004 01  FILLER REDEFINES HIDDEN-ASCII DISPLAY-7.
011006     02  ASCII-NULL        PIC X.
011008     02  ASCII-BELL        PIC X.
011010     02  ASCII-LF          PIC X.
011012     02  ASCII-CR          PIC X.
011014     02  ASCII-ESC         PIC X.
011016 01  MASK1-7 DISPLAY-7.
011018     02  MASK1-6.
011020         04  MASK1         PIC X.
011022         04  FILLER        PIC XXXXX.
011024     02  MASK7             PIC X.
011026 01  RETURNED-PASSWORD       PIC XXXXXX.
011028
011030 01  PW-WORKER USAGE IS DISPLAY-6.
011040     02  PW-CHAR             PICTURE X OCCURS 12 TIMES.
011060 01  PW-WORK REDEFINES PW-WORKER.
011080     02  PW-WORK1            PICTURE S9(10) COMP.
011100     02  PW-WORK2            PICTURE S9(10) COMP.
011120 01  PW-MASK1                PICTURE S9(10) COMP VALUE 14729163.
011140 01  PW-MASK2                PICTURE S9(10) COMP VALUE -24815212.
011160 01  PW-WORKER7.
011180     02  PW7-CHAR            PICTURE X OCCURS 6 TIMES.
011200 01  FILE-PROTECT-TABLE.
011220     02 FD-PROT              PICTURE X  OCCURS 3 TIMES.
011240     02 FD-RPROT             PICTURE XX OCCURS 3 TIMES.
011260     02 FD-CPROT             PICTURE XX OCCURS 3 TIMES.
011280     02 FD-REWPROT           PICTURE XX OCCURS 3 TIMES.
011300     02 FD-NAMEPROT          PICTURE X(30) OCCURS 3 TIMES.
011320 01  LINE-TABLE.
011340     05  LINEX PICTURE X OCCURS 90 TIMES INDEXED BY L.
011360     05  LINE-WORD REDEFINES LINEX PICTURE S9(10) COMP
011380                         OCCURS 15 TIMES INDEXED BY LI.
011400 01  PARSING-STACK.
011420     02 PARSING-TABLE OCCURS 10 TIMES INDEXED BY OPX.
011440        04 OPERATOR             PICTURE S9(10) COMP.
011460        04 OPERAND              PICTURE S9(10) COMP.
011480        04 PRECEDENCE           PICTURE S9(10) COMP.
011482 01  PROMPTER-MESSAGE.
011484     02 FILLER                  PICTURE X(35)
011486        VALUE '*ADDITIONAL PASSWORD(S) NEEDED FOR '.
011488     02 ITEM-OR-FILE            PICTURE X(11).
011490     02 FILLER                  PICTURE X(26)
011492        VALUE '. ENTER SPACE TO END LIST.'.
011500 01  HELD-WORD30.
011520     02  FILLER              PICTURE X(05) VALUE 'HELD-'.
011540     02  HWORD30             PICTURE X(25) VALUE SPACE.
011560 01  WORD-TABLE.
011580     02  WORDX PICTURE X OCCURS 30 TIMES INDEXED BY W.
011600     02  WORD30 REDEFINES WORDX.
011620       04  WORD18.
011640         06  WORD12.
011660           08  WORD06.
011680             10  WORD04.
011700               12  WORD02.
011720                 14  WORD01  PICTURE X(01).
011740                 14  FILLER  PICTURE X(01).
011760               12  FILLER    PICTURE X(02).
011780             10  FILLER      PICTURE X(02).
011800           08  FILLER        PICTURE X(06).
011820         06  FILLER          PICTURE X(06).
011840       04  WORD30-STNUMB     PICTURE 99.
011860       04  FILLER            PICTURE X(10).
011861 01  FILLER REDEFINES WORD-TABLE.
011862     02  WORD05              PICTURE X(05).
011863     02  FILLER              PICTURE X(25).
011864 01  filler  redefines word-table.
011866     02  filler              picture x(9).
011868     02  word30-fatal-part   picture x(21).
011880 01                          PICTURE-TABLE REDEFINES WORD-TABLE.
011900     05  PICTX PICTURE X OCCURS 30 TIMES INDEXED BY P.
011920 01  NUMBER-TABLE.
011940     05  NUMBX PICTURE X OCCURS 18 TIMES INDEXED BY N.
011960     05  NUMBN REDEFINES NUMBX PICTURE S9(18).
011980     05  NUMBREDEF REDEFINES NUMBN.
012000         10  FILLER          PICTURE X(08).
012020         10  NUMBN10         PICTURE S9(10).
012040 01  QUOTE-TABLE.
012060     05  QUOTEX PICTURE X OCCURS 72 TIMES INDEXED BY Q.
012080     05  QUOTERS REDEFINES QUOTEX.
012100         10  QUOTEN          PICTURE S9(10) COMP OCCURS 12 TIMES.
012120 01  REMAINER                PICTURE S9(04)V99 VALUE ZEROS.
012140 01  R4VR1R2 REDEFINES REMAINER.
012160     02  R4                  PICTURE 9(04).
012180     02  R1                  PICTURE 9.
012200     02  R2                  PICTURE 9.
012220 01  TITLE-TABLE.
012240     05  TITLEX PICTURE X OCCURS 24 TIMES INDEXED BY T.
012260     05  TITLES REDEFINES TITLEX.
012280         10  TITLE1X         PICTURE X(10).
012300         10  TITLE2X         PICTURE X(10).
012320         10  FILLER          PICTURE X(04).
012322 01  HINT-WORD DISPLAY-7.
012322     02 FILLER                PICTURE XX VALUE '% '.
012324     02 HINT-WORD30           PICTURE X(30).
012330 01  WARNING-MESSAGE-HINT DISPLAY-7.
012332     02  FILLER              PICTURE X(09) VALUE '*WARNING-'.
012334     02  WARNING-DATANAME1   PICTURE X(11).
012336     02  WARNING-DATANAME2   PICTURE X(10).
012340 01  IQANLZ-ERROR DISPLAY-7.
012360*    02 E1                   PICTURE X(04) VALUE '%IQA'.
012380*    02 FATAL-WARNING        PICTURE X(08) VALUE 'Deadly  '.
012400*    02 DCODE                PICTURE 999 VALUE 000.
012420     02 FILLER               PICTURE X(01) VALUE SPACE.
012440     02 E-MSG                PICTURE X(30) VALUE SPACE.
012460*    02 E2                   PICTURE X(03) VALUE '%  '.
012480 01  ERR-MSGS DISPLAY-7.
012500     05  FILLER1  PICTURE X(30) VALUE 'not defined'.
012520     05  FILLER2  PICTURE X(30) VALUE 'not numeric'.
012540     05  FILLER3  PICTURE X(30) VALUE 'not alphabetic'.
012560     05  FILLER4  PICTURE X(30) VALUE 'statement expected'.
012580     05  FILLER5  PICTURE X(30) 
012582                  VALUE 'encountered when verb expected'.
012600     05  FILLER6  PICTURE X(30) 
012602                  VALUE 'found when non-verb expected'.
012620     05  FILLER7  PICTURE X(30) VALUE 'invalid character'.
012640     05  FILLER8  PICTURE X(30) VALUE 'value beyond range'.
012660     05  FILLER9  PICTURE X(30) VALUE 'file not found'.
012680     05  FILLER10 PICTURE X(30) VALUE 'too many right paren'.
012700     05  FILLER11 PICTURE X(30) VALUE 'no ending quote'.
012720     05  FILLER12 PICTURE X(30) VALUE 'query size exceeded'.
012740     05  FILLER13 PICTURE X(30) VALUE 'invalid item type'.
012760     05  FILLER14 PICTURE X(30)
012780                  VALUE 'invalid/missing password for'.
012800     05  FILLER15 PICTURE X(30) VALUE 'literal expected'.
012820     05  FILLER16 PICTURE X(30) VALUE 'literal max exceeded'.
012840     05  FILLER17 PICTURE X(30) VALUE 'no ending paren'.
012860     05  FILLER18 PICTURE X(30) VALUE 'ISAM file required'.
012880     05  FILLER19 PICTURE X(30) VALUE 'hold buffer full'.
012900     05  FILLER20 PICTURE X(30) VALUE 'invalid operation'.
012920     05  FILLER21 PICTURE X(30) VALUE 'invalid picture'.
012940     05  FILLER22 PICTURE X(30) 
012942                  VALUE 'CORRECT ANY ERRORS AND RE-TRY'.
012960     05  FILLER23 PICTURE X(30) VALUE 'variable used once'.
012980     05  FILLER24 PICTURE X(30) VALUE 'query not terminated'.
013000     05  FILLER25 PICTURE X(30) VALUE 'operator expected'.
013020     05  FILLER26 PICTURE X(30) VALUE 'operand expected'.
013040     05  FILLER27 PICTURE X(30) VALUE '= incorrectly used'.
013060     05  FILLER28 PICTURE X(30) VALUE '= must be first operator '.
013080     05  FILLER29 PICTURE X(30)
013100                  VALUE 'invalid relational operator'.
013120     05  FILLER30 PICTURE X(30) VALUE 'verb use limit is 1'.
013140     05  FILLER31 PICTURE X(30) VALUE 'word max 30 chars'.
013160     05  FILLER32 PICTURE X(30) VALUE 'invalid DEV:FILE.EXT'.
013180     05  FILLER33 PICTURE X(30) VALUE 'invalid ( = ZZITEM )'.
013200     05  FILLER34 PICTURE X(30)
013220                  VALUE 'num var names begin with X'.
013240     05  FILLER35 PICTURE X(30)
013260                  VALUE 'undefined data name or else an'.
013280     05  FILLER36 PICTURE X(30)
013300                  VALUE 'alpha var spelled incorrectly'.
013320     05  FILLER37 PICTURE X(30)
013340                 VALUE 'dictionary not found for file'.
013360     05  FILLER38 PICTURE X(30)
013380                  VALUE 'OPEN statement duplicate names'.
013400     05  FILLER39 PICTURE X(30)
013420                  VALUE 'IF statemnt has no verb phrase'.
013440     05  FILLER40 PICTURE X(30)
013460                  VALUE 'file name incorrectly used'.
013480     05  FILLER41 PICTURE X(30)
013500                  VALUE 'no CREATE items designated or'.
013520     05  FILLER42 PICTURE X(30)
013540                  VALUE 'possibly filename not quoted.'.
013542     05  FILLER43 PICTURE X(30)
013544                  VALUE 'incorrectly used vocab word'.
013546     05  FILLER44 PICTURE X(30)
013548                  VALUE 'can take no qualification'.
013550     05  FILLER45 PICTURE X(30) VALUE 'lack detail info dm item'.
013552     05  FILLER46 PICTURE X(30)
013554                  VALUE 'NO DATA ITEM DESIGNATED'.
013555     05  FILLER47 PICTURE X(30)
013556                  VALUE 'DBMS queries need a FIND verb'.
013558     05  filler48 picture x(30) value 'incorrectly specified'.
013560     05  filler49 picture x(30) 
013562                  value 'FIND statement incomplete'.
013564     05  filler50 picture x(30)
013566                  value 'are possible missing word(s)'.
013567     05  FILLER51 PICTURE X(30) 
013568                  VALUE 'no file opened for sort'.
013570     05  FILLER52 PICTURE X(30)
013572                  VALUE '"FIND" verb on a primary file'.
013573     05  FILLER53 PICTURE X(30)
013574                  VALUE 'Nested "IF"s not allowed'.
013575     05  FILLER54 PICTURE X(30)
013576                  VALUE '-NOT A NUMERIC COMPUTE OPERAND'.
013577     05  FILLER55 PICTURE X(30) VALUE 'NOT NUMERIC OPERAND'.
013578     05  filler56 picture x(30)
013579                  value '"else" should not follow "."'.
013580     05  filler57 picture x(30) 
013581                  value 'preceed literal with space'.
013582 01  ERR-MSGR REDEFINES ERR-MSGS DISPLAY-7.
013583     05  ERR-MSG             PICTURE X(30) OCCURS 57 TIMES.
013584 01  MAX-ERR-MSG             PICTURE S9(10) COMP VALUE 57.
013600 01  TRUE-STACK.
013620     02  N-TRUEGO            PICTURE S9(05) COMP VALUE 0.
013640     02  X-TRUEGO            PICTURE S9(05) COMP
013660                             OCCURS 9 INDEXED BY TSX.
013680 01  FALSE-STACK.
013700     02  N-FALSEGO           PICTURE S9(05) COMP VALUE 0.
013720     02  X-FALSEGO           PICTURE S9(05) COMP
013740                             OCCURS 9 INDEXED BY FSX.
013760 01  NESTED-PAREN-TABLE.
013780     02 LPARENCNTR           PICTURE S9(05) COMP VALUE 00.
013800     02 RPARENCNTR           PICTURE S9(05) COMP VALUE 00.
013820     02 TLPX                 PICTURE S9(05) COMP VALUE 0.
013840     02 FLPX                 PICTURE S9(05) COMP VALUE 0.
013860     02 LPAREN-STACK.
013880        03 TRUE-LPAREN       PICTURE S9(05) COMP OCCURS 9.
013900        03 FALSE-LPAREN      PICTURE S9(05) COMP OCCURS 9.
013920 01  NOTT                    PICTURE S9 COMP OCCURS 9.
013940*****TABLES PASSED TO EXECUTION MODULE FOLLOW************
013960
013980 01  CONTROL-TABLE.
014000*   *VALUES BELOW ARE DEFAULTS WHICH SHOULD BE PASSED IF
014020*    QUERY DOES NOT AFFECT THAT QUANTITY*.
014040*   *1ST ENTRY WILL STOP RUN IF EVER GET THERE*.
014060*   *2ND & 3RD ENTRIES ARE DEFAULT RPTHEAD DX LIST.
014080     02  CONST1              PICTURE S9(10) COMP VALUE 1.
014100     02  FILLER              PICTURE S9(10) COMP VALUE 1.
014120     02  CONST0              PICTURE S9(10) COMP VALUE 0.
014140     02  DYN-JOBNO           PICTURE S9(10) COMP VALUE 1.
014160     02  EXEC-STARTX         PICTURE S9(10) COMP VALUE 24.
014180     02  EOF1-X              PICTURE S9(10) COMP VALUE 1.
014200     02  ACROSS-CONTROL      PICTURE S9(10) COMP VALUE 1.
014220     02  DISPLAY-FLAG        PICTURE S9(10) COMP VALUE 1.
014240     02  HEADING-FLAG        PICTURE S9(10) COMP VALUE 1.
014260     02  PAGING-FLAG         PICTURE S9(10) COMP VALUE 1.
014280     02  PRINT-FLAG          PICTURE S9(10) COMP VALUE 1.
014300     02  SUMPRINT-FLAG       PICTURE S9(10) COMP VALUE 1.
014320     02  TITLES-FLAG         PICTURE S9(10) COMP VALUE 1.
014340     02  PAGE-LINES          PICTURE S9(10) COMP VALUE 66.
014360     02  PRINT-LINES         PICTURE S9(10) COMP VALUE 57.
014380     02  REPORT-DX           PICTURE S9(10) COMP VALUE 1.
014400     02  NUMB-REPORTS        PICTURE S9(10) COMP VALUE 1.
014420     02  HSPACE              PICTURE S9(10) COMP VALUE 3.
014440     02  VSPACE              PICTURE S9(10) COMP VALUE 1.
014460     02  LMARGIN             PICTURE S9(10) COMP VALUE 1.
014480     02  RMARGIN             PICTURE S9(10) COMP VALUE 72.
014500     02  SUMBREAK-FLAG       PICTURE S9(10) COMP VALUE 0.
014520     02  FILLER              PICTURE S9(10) COMP OCCURS 2978.
014540
014560 01  INSTR-TABLE REDEFINES CONTROL-TABLE.
014580     02  INSTR               PICTURE S9(10) COMP
014600                             OCCURS 3000 INDEXED BY X.
014620
014640 01  FILE-TABLE REDEFINES INSTR-TABLE.
014660     02  F-ENTRY OCCURS 200 INDEXED BY FX.
014680         04  F-TYPEV         PICTURE S9(10) COMP.
014700         04  F-RECLEN        PICTURE S9(10) COMP.
014720         04  F-BLKLEN        PICTURE S9(10) COMP.
014740         04  F-ORIGIN        PICTURE S9(10) COMP.
014760         04  F-KEYLOC        PICTURE S9(10) COMP.
014780         04  F-KEYLEN        PICTURE S9(10) COMP.
014800         04  F-KEYTYPE       PICTURE S9(10) COMP.
014820         04  F-KEYSIGN       PICTURE S9(10) COMP.
014840         04  F-PPN           PICTURE S9(10) COMP.
014860         04  F-ID            PICTURE X(29).
014870         04  F-OPENIO        PICTURE X.
014880         04  F-DEVICE        PICTURE X(6).
014900 01  DATA-BASE-TABLE REDEFINES FILE-TABLE.
014920     02  DB-ENTRY OCCURS 200 TIMES INDEXED BY BX.
014940         04  B-TYPEV         PICTURE S9(10) COMP.
014960         04  FILLER          PICTURE X(18).
014980         04  B-SUBSCHEMA     PICTURE X(30).
015000         04  B-SCHEMA        PICTURE X(30).
015020         04  B-PASSWORD      PICTURE X(06).
015040 01  RD-AD-SD-TABLE REDEFINES DATA-BASE-TABLE.
015060     02  R-ENTRY OCCURS 200 TIMES INDEXED BY RX.
015080         04  R-TYPEV         PICTURE S9(10) COMP.
015100         04  R-NCHAR         PICTURE S9(10) COMP.
015120         04  R-SCALE         PICTURE S9(10) COMP.
015140         04  FILLER          PICTURE X(12).
015160         04  R-FCHAR         PICTURE S9(10) COMP.
015180         04  FILLER          PICTURE X(6).
015200         04  R-ENDKEY        PICTURE X(30).
015220         04  R-AREA-SET      PICTURE S9(10) COMP.
015240         04  R-REC-NO        PICTURE S9(10) COMP.
015260         04  FILLER          PICTURE X(6).
015280 01  DICTIONARY-TABLE REDEFINES RD-AD-SD-TABLE.
015300     02  D-ENTRY OCCURS 200 INDEXED BY DX.
015320         04  D-TYPEV         PICTURE S9(10) COMP.
015340         04  D-NCHAR         PICTURE S9(10) COMP.
015360         04  D-SCALE         PICTURE S9(10) COMP.
015380         04  D-ECHAR         PICTURE S9(10) COMP.
015400         04  D-TCHAR         PICTURE S9(10) COMP.
015420         04  D-FCHAR         PICTURE S9(10) COMP.
015440         04  D-NREPEATS      PICTURE S9(10) COMP.
015460         04  D-GRPLEN        PICTURE S9(10) COMP.
015480         04  D-TITLE1        PICTURE X(10).
015500         04  D-TITLE2        PICTURE X(10).
015520         04  D-PICT          PICTURE X(20).
015540         04  D-GRPNAME       PICTURE X.
015560         04  D-STOPV         PICTURE X.
015580
015600 01  VARIABLE-TABLE REDEFINES DICTIONARY-TABLE.
015620     02  V-ENTRY OCCURS 200 INDEXED BY VX.
015640         04  V-TYPEV         PICTURE S9(10) COMP.
015660         04  V-NCHAR         PICTURE S9(10) COMP.
015680         04  V-SCALE         PICTURE S9(10) COMP.
015700         04  V-ECHAR         PICTURE S9(10) COMP.
015720         04  V-TCHAR         PICTURE S9(10) COMP.
015740         04  V-BINARY        PICTURE S9(18) COMP.
015760         04  V-WORK          PICTURE S9(10) COMP.
015780         04  V-TITLE1        PICTURE X(10).
015800         04  V-TITLE2        PICTURE X(10).
015820         04  V-PICT          PICTURE X(20).
015840         04  FILLER          PICTURE XX.
015860
015880 01  CONSTANT-TABLE REDEFINES VARIABLE-TABLE.
015900     02  C-ENTRY OCCURS 200 INDEXED BY CX.
015920         04  C-TYPEV         PICTURE S9(10) COMP.
015940         04  C-NCHAR         PICTURE S9(10) COMP.
015960         04  C-SCALE         PICTURE S9(10) COMP.
015980         04  FILLER          PICTURE X(12).
016000         04  C-BINARY        PICTURE S9(18) COMP.
016020         04  C-NUMERIC       PICTURE S9(18).
016040         04  FILLER          PICTURE X(30).
016060
016080 01  LITERAL-TABLE REDEFINES CONSTANT-TABLE.
016100     02  L-ENTRY OCCURS 200 INDEXED BY LX.
016120         04  L-TYPEV         PICTURE S9(10) COMP.
016140         04  L-NCHAR         PICTURE S9(10) COMP.
016160         04  L-VALUE         PICTURE X(72).
016180         04 FILLER           PICTURE X(06).
016200 01  KEY-TABLE REDEFINES LITERAL-TABLE.
016220     02  K-ENTRY OCCURS 200 TIMES INDEXED BY KX.
016240         04  K-TYPEV         PICTURE S9(10) COMP.
016260         04  K-NCHAR         PICTURE S9(10) COMP.
016280         04  K-STARTKEY      PICTURE X(30).
016300         04  K-ENDKEY        PICTURE X(30).
016320         04  FILLER          PICTURE X(18).
016340 01  PROTECTION-PD-TABLE REDEFINES KEY-TABLE.
016360     02  P-ENTRY OCCURS 200 TIMES INDEXED BY FPX.
016380         04  P-TYPEV         PICTURE S9(10) COMP.
016400         04  P-DYNREFNO      PICTURE 99.
016420         04  P-DYNDATEFLAG   PICTURE X.
016440         04  P-DYNPROTLINE   PICTURE X.
016460         04  P-DYNPASSWORD   PICTURE X(06).
016480         04  FILLER          PICTURE X(74).
016500 01  AUTHORITY-TABLE REDEFINES PROTECTION-PD-TABLE.
016520     02  A-ENTRY OCCURS 200 TIMES INDEXED BY AX.
016540         04  A-TYPEV         PICTURE S9(10) COMP.
016560         04  FILLER          PICTURE X(36).
016580         04  AUTH-PASSWORD   PICTURE X(06).
016600         04  FILLER          PICTURE X(42).
016620
016622* 01  INTERRUPT-FLAG  INDEX.
016624* 01  INTERRUPT-ERROR  INDEX.
016640*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016660*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016680
016700*   *==WHEN READY, CAN SIMPLY REPLACE ALL
016720*   *==MOVE INSTR (X) TO INSTRX      WITH
016740*   *==ENTER MACRO IQGETX==
016760
016780*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016800*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016820
016840*    SOME CONVENTIONS:
016860*      FLAG-VERB: A COUNT OR INDICATOR WITHIN A 1ST PASS
016880*                 SYNTAX PROCESSOR TO INDICATE TO THAT
016900*                 PROCESSOR WHETHER THIS IS 1ST TIME HERE.
016920*      FLAG-PASS=9: SERIOUS ERROR-QUIT NOW
016940*      V=1:       END OF QUERY STATEMENTS HAS BEEN REACHED
016960*      THE FOLLOWING 4 FLAGS ARE PASSED TO IQA VIA IQL IN THE
016980*      QTNNNI.TMP INFO FILE-VALUES SHOWN ARE THE DEFAULTS
017000*      FLAG-DUMP=0:   IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017020*                     FILE AS IQDUMP.TMP
017040*      FLAG-EXECUTE=1:IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017060*                     FILES AS QTNNNA.TMP AND PASS CONTROL
017080*                     CONTROL TO IQE WHEN IQA IS DONE
017100*                     IF = 0,IQA SHOULD NOT WRITE A QTNNNA.TMP FILE
017120*                     AND SHOULD RETURN CONTROL TO IQL WHEN DONE.
017140*      FLAG-SAVE=0:   IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017160*                     BY A NAME INDICATED BY QRY-NAME
017180*      FLAG-LIST=1:   IF = 1,IQA SHOULD LIST QUERY AS ITS ANALYZED.
017182*      FLAG-TMP-INPUT:IF = 0, IQA READS QUERY INPUT FROM "QCnnnS.TMP" FILE
017184*                     IF = 1, IQA READS QUERY INPUT FROM "QTnnnS.TMP" FILE
017200 PROCEDURE DIVISION.
017220 START-OF-QANAL.
017222*     SET INTERRUPT-FLAG TO 0.
017224*     CALL SETINT USING 5,INTERRUPT-FLAG,INTERRUPT-ERROR.
017226*     IF INTERRUPT-ERROR NOT = 0 
017228*         DISPLAY '? ERROR IN SETINT' STOP RUN.
017240     ENTER MACRO CLRTTY.
017260*    GET JOB # TO BE USED AS PART OF TEMP FILE NAMES
017280     ENTER MACRO IQGJOB USING JOB-NO.
017300     MOVE JOB-NO TO QC-STMT-NO QT-ANAL-NO DYN-JOBNO.
017320*    INITIALIZE X AND DX FOR LATER USE BY IQGETX
017340*     ENTER MACRO IQSETX USING
017360*           INSTR-TABLE X DICTIONARY-TABLE DX T-INSTR DD-AREA.
017380     SET DX TO DX-MAX.
017400     MOVE DX-MAX TO DX-LOWEST. ADD 1 TO DX-LOWEST.
017420     SET L TO L-MAX.
017440     SET X TO EXEC-STARTX. SET X DOWN BY 2.
017460     MOVE ZEROS TO PROJ8 USER8.
017480     MOVE 'ITMP' TO QT-ANLZ-EXT.
017500     MOVE QTANLZTMP TO FD-INLABEL.
017520*    PEEK TO SEE IF QTANLZ FILE IS AVAILABLE.
017540     ENTER MACRO IQLOOK USING
017560           DEVICER,FD-INLABEL,PROJ8,USER8,I.
017580     IF I NOT EQUAL TO -1 GO TO BYPASS-CONTINUE.
017600     OPEN INPUT QTANLZ.
017620*    READ FIRST(INFORMATION) RECORD PASSED FROM IQL
017640     READ QTANLZ AT END GO TO CONTINUE-START.
017660     MOVE QTANLZ-REC TO QTNNNITMP.
017662*   * SEE IF INPUT SHOULD COME FROM QTnnnT.TMP, WHICH CONTAINS
017664*   * A MACRO-EXPANDED QUERY.
017666     IF FLAG-TMP-INPUT = 1 MOVE 'QT' TO QCSTMT-PREFIX.
017680 CONTINUE-START.
017700     CLOSE QTANLZ.
017720 BYPASS-CONTINUE.
017740     MOVE 'ATMP' TO QT-ANLZ-EXT.
017760     MOVE QCSTMTTMP TO FD-INLABEL WORD30.
017780     ENTER MACRO IQLOOK USING
017800           DEVICER,FD-INLABEL,PROJ8,USER8,I.
017820     IF I NOT EQUAL TO -1 GO TO E009.
017840     OPEN INPUT QCSTMT.
017860     IF FLAG-LIST = 1
017880*       DISPLAY '  IQA 3.0 USING ' QCSTMTTMP ' ' QTANLZTMP
017900*       UPON CONSOLE.
017920        DISPLAY ' ' UPON CONSOLE.
017940 VERB-CONTROL.
017942*    *CHECK FOR AN INTERRUPT REQUEST..IF SO, SIMULATE AN ERROR EXIT
017944*     IF INTERRUPT-FLAG NOT = 0 
017946*         DISPLAY '[^E Panic interrupt detected]'
017948*         MOVE 0 TO FLAG-EXECUTE GO TO QTANLZ-DAS-ENDE.
017960     IF X > X-MAX GO TO E012.
017980     IF DX < X-START  IF N-RSE NOT = 3 GO TO E012.
018000     PERFORM GET-VERB THRU GET-VERB-EXIT.
018010     MOVE 0 TO FLAG-NON-VERB.
018020     IF FLAG-PASS = 2 AND V < 1 GO TO E022.
018040     IF V < 1  GO TO E005.
018060     GO TO QUERY1       OPEN1      STATEMENT1    VERB-CONTROL
018080           READ1        FINDKEY1   FINDDBMS1     COPY1
018100           CREATE1      FIND-FROM1 FIND1         SORT1
018120           AT-END1      ACCEPT1    DISPLAY1      PRINT1
018140           INVALID-KEY1 HSPACE1    VSPACE1       LMARGIN1
018160           RMARGIN1     ACROSS1    REPORT1       RPTHEAD1
018180           NEWPAGE1     PAGINGON1  PAGINGOFF1    HEADINGON1
018200           HEADINGOFF1  TITLESON1  TITLESOFF1    SUMMARYON1
018220           SUMMARYOFF1  DISPLAYON1 DISPLAYOFF1   PRINTON1
018240           PRINTOFF1    RPTDATEON1 RPTDATEOFF1   HOLD1
018260           RESET1       SET1       COMPUTE1      PAGE-LINES1
018280           FORM-LINES1  PAGE1      TALLY1        TOTAL1
018300           AVERAGE1     GOTOQT1    GOTOXT1       GOTONR1
018320           GOTO1        CALL1      IFFIRSTIME1   IFLASTIME1
018340           IFNEWPAGE1   IFNEWGROUP1 IFELSE1      IFTHEN1
018360           IF1          IFFIRST1   IFLAST1       IFANY1
018380           IFNEXT1      IFSAME1    E000          E000
018400           E000         RPTDATE1   IFEOF2        IFEOF3
018420           E000         IFBOF2     IFBOF3      E000
018440           AUTHORITY1   PICTURE1   TITLES1       MAXIMUM1
018460           MINIMUM1     E000       E000          E000
018465           E000         reopen1    rewrite1    
018480           DEPENDING ON V.
018500     IF FLAG-PASS = 2 GO TO E022.
018520     GO TO E005.
018540 E000.
018541     GO TO E005.
018556 e057. add 1 to ecode.
018557 e056. add 1 to ecode.
018558 E055. ADD 1 TO ECODE.
018559 E054. ADD 1 TO ECODE.
018560 E053. ADD 1 TO ECODE.
018561 E052. ADD 1 TO ECODE.
018562 E051. ADD 1 TO ECODE.
018564 e050. add 1 to ecode.
018566 e049. add 1 to ecode.
018568 e048. add 1 to ecode.
018570 E047. ADD 1 TO ECODE.
018572 E046. ADD 1 TO ECODE.
018574 E045. ADD 1 TO ECODE.
018576 E044. ADD 1 TO ECODE.
018578 EO43. ADD 1 TO ECODE.
018580 E042. ADD 1 TO ECODE.
018600 E041. ADD 1 TO ECODE.
018620 E040. ADD 1 TO ECODE.
018640 E039. ADD 1 TO ECODE.
018660 E038. ADD 1 TO ECODE.
018680 E037. ADD 1 TO ECODE.
018700 E036. ADD 1 TO ECODE.
018720 E035. ADD 1 TO ECODE.
018740 E034. ADD 1 TO ECODE.
018760 E033. ADD 1 TO ECODE.
018780 E032. ADD 1 TO ECODE.
018800 E031. ADD 1 TO ECODE.
018820 E030. ADD 1 TO ECODE.
018840 E029. ADD 1 TO ECODE.
018860 E028. ADD 1 TO ECODE.
018880 E027. ADD 1 TO ECODE.
018900 E026. ADD 1 TO ECODE.
018920 E025. ADD 1 TO ECODE.
018940 E024. ADD 1 TO ECODE.
018960 E023. ADD 1 TO ECODE.
018980 E022. ADD 1 TO ECODE.  
019000 E021. ADD 1 TO ECODE.
019020 E020. ADD 1 TO ECODE.
019040 E019. ADD 1 TO ECODE.
019060 E018. ADD 1 TO ECODE.
019080 E017. ADD 1 TO ECODE.
019100 E016. ADD 1 TO ECODE.
019120 E015. ADD 1 TO ECODE.
019140 E014. ADD 1 TO ECODE.
019160 E013. ADD 1 TO ECODE.
019180 E012. ADD 1 TO ECODE.
019200 E011. ADD 1 TO ECODE.
019220 E010. ADD 1 TO ECODE.
019240 E009. ADD 1 TO ECODE.
019260 E008. ADD 1 TO ECODE.
019280 E007. ADD 1 TO ECODE.
019300 E006. ADD 1 TO ECODE.
019320 E005. ADD 1 TO ECODE.
019340 E004. ADD 1 TO ECODE.
019360 E003. ADD 1 TO ECODE.
019380 E002. ADD 1 TO ECODE.
019400 E001. ADD 1 TO ECODE.
019420     PERFORM E-RROR THRU E-XIT.
019440     MOVE SPACES TO WORD30.
019459     IF FLAG-PASS = 9 GO TO QTANLZ-DAS-ENDE.
019460     IF FLAG-PASS = 2 GO TO VERB-RESET.
019461     move 0 to flag-if-statement.
019462     IF FLAG-EOS2 NOT = 0 GO TO VERB-RESET.
019463*    NOW READ OVER REST OF STATEMENT UNTIL HIT EOS.
019464     MOVE 99 TO ECODE.
019465 READ-OVER.
019466     PERFORM GET-WORD THRU GET-WORDX.
019467     IF V = 1 GO TO QUERY1.
019468     IF FLAG-QUOTE NOT = 0 GO TO READ-OVER-LIT.
019469     IF FLAG-EOS2 NOT = 2 GO TO READ-OVER.
019470     MOVE 1 TO FLAG-EOS.
019480     GO TO VERB-RESET.
019482 READ-OVER-LIT.
019484     MOVE FLAG-QUOTE TO TEST-QUOTE. MOVE 0 TO FLAG-QUOTE.
019485 READ-OVER-LIT-LOOP.
019486     PERFORM GET-WORD THRU GET-WORDX.
019487     IF V = 1 GO TO QUERY1.
019488     IF FLAG-QUOTE NOT = TEST-QUOTE GO TO READ-OVER-LIT-LOOP.
019490     MOVE 0 TO TEST-QUOTE, FLAG-QUOTE.
019492     GO TO READ-OVER.
019500 E-RROR.
019510     MOVE 0 TO FLAG-NON-VERB.
019520*    MOVE ECODE TO DCODE.
019540     IF ECODE = 022 OR ECODE = 037 OR ECODE = 009 OR
019560        ECODE = 038 OR ECODE = 012 MOVE 9 TO FLAG-PASS.
019580     IF NOT WARNING-CODE MOVE 1 TO FLAG-ERROR.
019600     IF FLAG-LIST = 0 AND FLAG-PASS = 1
019620        MOVE 2 TO FLAG-LIST
019640        DISPLAY LINE-TABLE UPON CONSOLE.
019660     IF ECODE < 001 OR ECODE > MAX-ERR-MSG
019680        MOVE 005 TO ECODE.
019700     IF ECODE = 36 OR ECODE = 42 MOVE SPACES TO IQANLZ-ERROR.
019720     MOVE ERR-MSG (ECODE) TO E-MSG.
019730     MOVE WORD30 TO HINT-WORD30.
019732     IF ECODE = 022
019734        MOVE '*PLS SUBMIT AN SPR-BUT FIRST, ' TO HINT-WORD30.
019740     DISPLAY HINT-WORD IQANLZ-ERROR UPON CONSOLE.
019760     IF ECODE = 36 MOVE '%IQA' TO IQANLZ-ERROR.
019780     MOVE ZEROS TO ECODE.
019800 E-XIT.    EXIT.
019802 compute-warning.
019804     move d-title1 (dx) to warning-dataname1.
019805     move d-title2 (dx) to warning-dataname2.
019806     move warning-message-hint to word30.
019808     move 054 to ecode.
019810     perform e-rror thru e-xit.
019812 compute-warningx.  exit.
019820
019840 GET-VERB.
019860     MOVE V TO VP. MOVE ZEROS TO TYPEV.
019880     IF FLAG-PASS = 2 GO TO GET-KNOWN-VERB.
019900*    DONT GET NEXT WORD IF WE ALREADY HAVE IT.
019920     IF FLAG-PEEKED = 0 PERFORM GET-WORD THRU GET-WORDX.
019940     MOVE 0 TO FLAG-PEEKED.
019960*    BUG OUT IF HIT END OF QUERY
019980     IF V = 1 GO TO GET-VERB-EXIT.
020000     MOVE 1 TO FLAG-QUERY.
020020     IF FLAG-QUOTE NOT EQUAL TO ZERO GO TO GET-LITERAL.
020040     IF FLAG-STATEMENT-NO = 1 MOVE V-STATEMENT-NO TO V
020060        GO TO GET-ONE-VERB.
020080     IF FLAG-ALPHA = ZEROS
020100*       IF (V = V-COMPUTE OR V = V-GOTO) GO TO GOT-NON-VERB1
020120        GO TO GOT-NON-VERB.
020140     IF WORD12 = 'ACCEPT ' MOVE V-ACCEPT TO V
020160        GO TO GET-NON-VERB.
020180     IF WORD12 = 'ACROSS ' MOVE V-ACROSS TO V
020200        GO TO GET-NON-VERB.
020220     IF WORD04 = 'ALL ' AND V = V-FIND-DBMS
020240        AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSALL TO VA
020250        MOVE 0 TO FLAG-SET-TO-COME
020260        GO TO GET-VERB-EXIT.
020280     IF WORD06 = 'AND ' GO TO LEGAL-AND-OR-RPAREN.
020300     IF WORD06 = 'AREA ' AND V = V-FIND-DBMS
020320        AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSAREA TO VA
020330        MOVE 0 TO FLAG-SET-TO-COME
020340        GO TO GET-VERB-EXIT.
020360     IF WORD06 = 'AREA ' AND V = V-FIND-DBMS
020380        MOVE V-FINDAREA TO VA MOVE 0 TO FLAG-SET-TO-COME
020382        GO TO GET-VERB-EXIT.
020400     IF WORD06 = 'AREA  ' AND V = V-INVOKE
020420        MOVE V-FINDAREA TO VA  GO TO GET-NON-VERB.
020421     IF WORD12 = 'AREA-ID ' MOVE TYPE-AREA-IDENT TO TYPEV.
020422     IF WORD12 = 'AREA-NAME ' MOVE TYPE-AREA-NAME TO TYPEV.
020440     IF WORD12 = 'ASCENDING ' MOVE V-ASCENDING TO VA
020460        GO TO GET-VERB.
020480     IF WORD06 = 'AT ' AND V = V-FINDKEY
020500        MOVE V-AT-END TO VA GO TO GET-VERB.
020520     IF WORD12 = 'AUTHORITY ' MOVE V-AUTHORITY TO V
020540        GO TO GET-NON-VERB.
020560     IF WORD12 = 'AVERAGE ' MOVE V-AVERAGE TO V
020580        GO TO GET-NON-VERB.
020600     IF WORD12 = 'BEGINNING ' AND V = V-FIND
020620        MOVE V-BEGINNING TO VA GO TO GET-VERB-EXIT.
020640     IF WORD04 = 'BY ' GO TO LEGAL-BY.
020660     IF WORD06 = 'CALL ' MOVE V-CALL TO V  MOVE 0 TO VA
020680        GO TO GET-NON-VERB.
020700     IF WORD12 = 'COMPUTE ' MOVE V-COMPUTE TO V
020720        GO TO GET-NON-VERB.
020740     IF WORD06 = 'COPY ' MOVE V-COPY TO V
020760        GO TO GET-ONE-VERB.
020780     IF WORD12 = 'CREATE ' MOVE V-CREATE TO V
020800        GO TO GET-NON-VERB.
020820     IF WORD12 = 'CURRENCY '
020840        AND V = V-FIND-DBMS GO TO GET-VERB.
020842     IF WORD12 = 'CURRENT ' AND V = V-FIND-DBMS
020844        MOVE 2 TO N-RSE MOVE 1 TO FLAG-SET-TO-COME
020846        GO TO GET-VERB.
020860     IF WORD30 = 'CURRENT-RECORD-KEY '
020880        MOVE TYPE-CURR-REC-KEY TO TYPEV.
020900     IF WORD12 = 'DESCENDING ' MOVE V-DESCENDING TO VA
020920        GO TO GET-VERB.
020940     IF WORD12 = 'DISPLAY ' MOVE V-DISPLAY TO V
020960        GO TO GET-NON-VERB.
020980     IF WORD12 = 'DISPLAYALL ' MOVE V-DISPLAYON TO V
021000        GO TO GET-ONE-VERB.
021020     IF WORD12 = 'DISPLAYON ' MOVE V-DISPLAYON TO V
021040        GO TO GET-ONE-VERB.
021060     IF WORD12 = 'DISPLAYOFF ' MOVE V-DISPLAYOFF TO V
021080        GO TO GET-ONE-VERB.
021090     IF WORD06 = 'ELSE ' AND FLAG-EOS = 1
021092        MOVE '"ELSE" IS PART OF AN "IF" AND' TO WORD30
021094        GO TO E056.
021100     IF WORD06 = 'ELSE ' MOVE V-ELSE TO V
021120        GO TO GET-ONE-VERB.
021140     IF WORD06 = 'END ' AND VA = V-AT-END
021160        MOVE V-AT-END TO VP GO TO GET-ONE-VERB.
021180     IF WORD06 = 'EOF ' AND V = V-FINDKEY
021200        MOVE V-EOF TO VP GO TO GET-VERB-EXIT.
021201     IF WORD12 = 'ERROR-COUNT ' MOVE TYPE-ERROR-COUNT TO TYPEV.
021202     IF WORD18 = 'ERROR-STATUS ' MOVE TYPE-ERROR-STATUS TO TYPEV.
021210*     IF WORD06 = 'EXIT ' MOVE V-CALL TO V  MOVE 0 TO VA
012121*        GO TO GET-NON-VERB.
021220     IF WORD06 = 'FILLER' AND V = V-CREATE
021240        MOVE V-FILLER TO VAA  GO TO GET-VERB.
021260     IF WORD06 = 'FIND ' MOVE V-FIND TO V
021280        MOVE ZEROS TO N-RSE VA VAA GO TO FIND-LIST.
021300     IF WORD12 = 'FORM-LINES ' MOVE V-FORM-LINES TO V
021320        GO TO GET-NON-VERB.
021340     IF WORD06 = 'FROM ' AND V = V-FIND
021360        MOVE V-FROM TO VA GO TO GET-VERB-EXIT.
021380     IF WORD06 = 'HOLD ' MOVE V-HOLD TO V
021400        GO TO GET-NON-VERB.
021420     IF WORD06 = 'GO ' MOVE V-GOTO TO V
021440        GO TO GET-VERB.
021460     IF WORD06 = 'GROUP ' MOVE V-GROUP TO V
021480        GO TO GET-ONE-VERB.
021500     IF WORD12 = 'HEADING ' MOVE V-HEADING TO V
021520        GO TO GET-NON-VERB.
021540     IF WORD12 = 'HEADINGOFF ' MOVE V-HEADINGOFF TO V
021560        GO TO GET-ONE-VERB.
021580     IF WORD12 = 'HEADINGON ' MOVE V-HEADINGON TO V
021600        GO TO GET-ONE-VERB.
021620     IF WORD12 = 'HSPACE ' MOVE V-HSPACE TO V
021640        GO TO GET-NON-VERB.
021642     IF WORD06 = 'IF '
021644        AND FLAG-IF-STATEMENT = 1 AND FLAG-EOS = 0
021646            MOVE 'change "if" to "and" ' to word30  go to E053.
021650     IF WORD06 = 'IF ' MOVE 1 to flag-if-statement.
021654     IF WORD06 = 'IF '
021656        IF V = V-FIND-DBMS  IF FLAG-FINDFINI = 0
021658        GO TO GET-VERB.
021660     IF WORD06 = 'IF '  MOVE V-IF TO V
021680        GO TO IF-LIST.
021700     IF WORD12 = 'INVALID ' AND V = V-FINDKEY
021720        MOVE V-INVALID-KEY TO VA GO TO GET-VERB.
021740     IF WORD30 = 'INVOKE '
021760        MOVE V-INVOKE TO V GO TO GET-VERB.
021780     IF WORD06 = 'KEY ' AND VA = V-INVALID-KEY
021800        MOVE V-INVALID-KEY TO VP GO TO GET-ONE-VERB.
021820     IF WORD06 = 'LEFT ' MOVE V-LEFT TO V
021840        GO TO GET-VERB.
021860*    IF WORD06 = 'LINE ' MOVE V-LINE TO V
021880*       GO TO GET-NON-VERB.
021900     IF WORD12 = 'LMARGIN ' MOVE V-LMARGIN TO V
021920        GO TO GET-NON-VERB.
021940     IF WORD12 = 'MARGIN ' AND V = V-LEFT
021960        MOVE V-LMARGIN TO V GO TO GET-NON-VERB.
021980     IF WORD12 = 'MARGIN ' AND V = V-RIGHT
022000        MOVE V-RMARGIN TO V GO TO GET-NON-VERB.
022020     IF WORD12 = 'MAXIMUM ' MOVE V-MAXIMUM TO V
022040        GO TO GET-NON-VERB.
022060     IF WORD12 = 'MINIMUM ' MOVE V-MINIMUM TO V
022080        GO TO GET-NON-VERB.
022100     IF WORD12 = 'NARROW ' MOVE V-NARROW TO V
022120        GO TO GET-NON-VERB.
022140     IF WORD18 = 'NARROW.WIDTH ' MOVE V-NARROW TO V
022160        GO TO GET-NON-VERB.
022180     IF WORD12 = 'NEW ' MOVE V-NEW TO V
022200        GO TO GET-VERB.
022220     IF WORD12 = 'NEWPAGE ' MOVE V-NEWPAGE TO V
022240        GO TO GET-ONE-VERB.
022260     IF WORD06 = 'NEXT ' AND V = V-FIND
022280        MOVE V-NEXT TO VP GO TO GET-VERB-EXIT.
022300*    IF WORD06 = 'NO ' MOVE V-NO TO V
022320*       GO TO GET-VERB.
022340     IF WORD12 = 'NODISPLAY ' MOVE V-DISPLAYOFF TO V
022360        GO TO GET-ONE-VERB.
022380     IF WORD12 = 'NOHEADING ' MOVE V-HEADINGOFF TO V
022400        GO TO GET-ONE-VERB.
022420     IF WORD12 = 'NOPAGING ' MOVE V-PAGINGOFF TO V
022440        GO TO GET-ONE-VERB.
022460     IF WORD12 = 'NOPRINT ' MOVE V-PRINTOFF TO V
022480        GO TO GET-ONE-VERB.
022500     IF WORD12 = 'NOSUMMARY ' MOVE V-SUMMARYOFF TO V
022520        GO TO GET-ONE-VERB.
022540     IF WORD12 = 'NOSUMPRINT ' MOVE V-SUMMARYOFF TO V
022560        GO TO GET-ONE-VERB.
022580     IF WORD12 = 'NOTITLES ' MOVE V-TITLESOFF TO V
022600        GO TO GET-ONE-VERB.
022620     IF WORD06 = 'NR ' AND V = V-GOTO
022640        MOVE V-GOTONR TO V GO TO GET-ONE-VERB.
022660     IF WORD06 = 'OPEN ' MOVE V-OPEN TO V
022680        GO TO GET-NON-VERB.
022700     IF WORD06 = 'OF' AND V = V-IFNEWGROUP
022701         GO TO GET-VERB.
022702     IF WORD06 = 'OF ' AND V = V-FIND-DBMS
022704        GO TO GET-VERB.
022706*    VAA ABOVE SET TO V-FINDSET INDICATES TO IQA THAT WHEN WE
022708*    SUBSEQUENTLY READ 'SET', THAT IT SHOULD BE TREATED AS THE
022710*    DBMS SET FIELD AS OPPOSED TO THE SET VERB.
022740     IF WORD06 = 'OFF ' GO TO LEGAL-OFF.
022760     IF WORD06 = 'ON ' GO TO LEGAL-ON.
022780     IF WORD06 = 'OR ' GO TO LEGAL-AND-OR-RPAREN.
022800     IF WORD06 = 'PAGE ' AND V = V-NEW
022820        MOVE V-NEWPAGE TO V GO TO GET-ONE-VERB.
022840     IF WORD06 = 'PAGE  ' MOVE V-PAGE TO V
022860        GO TO GET-NON-VERB.
022880     IF WORD12 = 'PAGING ' MOVE V-PAGING TO V
022900        GO TO GET-NON-VERB.
022920     IF WORD12 = 'PAGINGOFF ' MOVE V-PAGINGOFF TO V
022940        GO TO GET-ONE-VERB.
022960     IF WORD12 = 'PAGINGON ' MOVE V-PAGINGON TO V
022980        GO TO GET-ONE-VERB.
023000     IF WORD12 = 'PAGE-LINE ' MOVE V-PAGE-LINE TO V
023020        GO TO GET-NON-VERB.
023040     IF WORD12 = 'PAGE-LINES ' MOVE V-PAGE-LINE TO V
023060        GO TO GET-NON-VERB.
023080     IF WORD12 = 'PAGE-WIDTH ' MOVE V-PAGE-WIDTH TO V
023100        GO TO GET-NON-VERB.
023120     IF WORD12 = 'PICTURE ' MOVE V-PICTURE TO V
023140        GO TO GET-NON-VERB.
023160     IF WORD12 = 'PRINT ' MOVE V-PRINT TO V
023180        GO TO GET-NON-VERB.
023200     IF WORD30 = 'PRIVACY ' AND V = V-INVOKE
023220        MOVE V-PRIVACY-KEY TO VA GO TO GET-NON-VERB.
023240     IF WORD30 = 'PRIVACY-KEY ' AND V = V-INVOKE
023260        MOVE V-PRIVACY-KEY TO VA GO TO GET-NON-VERB.
023280     IF WORD06 = 'QT ' AND V = V-GOTO
023300        MOVE V-GOTOQT TO V GO TO GET-ONE-VERB.
023320     IF WORD12 = 'RECORD ' AND (V = V-COPY OR V = V-CREATE)
023340        MOVE 'RECORD1 ' TO WORD12.
023360     IF WORD12 = 'RECORD ' GO TO LEGAL-RECORD.
023380     IF WORD12 = 'RECORD1 ' AND (V = V-COPY OR V = V-CREATE)
023400        MOVE 1 TO VA.
023420     IF WORD12 = 'RECORD2 ' AND (V = V-COPY OR V = V-CREATE)
023440        MOVE 2 TO VA.
023460     IF WORD12 = 'RECORD3 ' AND (V = V-COPY OR V = V-CREATE)
023480        MOVE 3 TO VA.
023482     IF WORD12 = 'RECORD-NAME ' MOVE TYPE-RECORD-NAME TO TYPEV.
023485     IF WORD12 = 'REOPEN '
023486        MOVE V-REOPEN TO V  GO TO GET-ONE-VERB.
023500     IF WORD12 = 'REPORT ' MOVE V-REPORT TO V
023520        GO TO GET-NON-VERB.
023540     IF WORD12 = 'RESET ' MOVE V-RESET TO V
023560        GO TO GET-NON-VERB.
023580     IF WORD18 = 'RESUMEDISPLAY ' MOVE V-DISPLAYON TO V
023600        GO TO GET-ONE-VERB.
023620     IF WORD18 = 'RESUMEHEADING ' MOVE V-HEADINGON TO V
023640        GO TO GET-ONE-VERB.
023660     IF WORD18 = 'RESUMEPAGING ' MOVE V-PAGINGON TO V
023680        GO TO GET-ONE-VERB.
023700     IF WORD18 = 'RESUMEPRINT ' MOVE V-PRINTON TO V
023720        GO TO GET-ONE-VERB.
023740     IF WORD18 = 'RESUMESUMMARY ' MOVE V-SUMMARYON TO V
023760        GO TO GET-ONE-VERB.
023780     IF WORD18 = 'RESUMESUMPRINT ' MOVE V-SUMMARYON TO V
023800        GO TO GET-ONE-VERB.
023820     IF WORD18 = 'RESUMETITLES ' MOVE V-TITLESON TO V
023840        GO TO GET-ONE-VERB.
023860     IF WORD12 = 'REWRITE ' MOVE V-REWRITE TO V
023880        GO TO get-one-verb.
023900     IF WORD12 = 'RIGHT ' MOVE V-RIGHT TO V
023920        GO TO GET-VERB.
023940     IF WORD12 = 'RMARGIN ' MOVE V-RMARGIN TO V
023960        GO TO GET-NON-VERB.
023980     IF WORD12 = 'RPTDATE ' OR 'DATE ' MOVE V-RPTDATE TO V
024000        GO TO GET-NON-VERB.
024020     IF WORD12 = 'RPTHEAD ' MOVE V-RPTHEAD TO V
024040        GO TO GET-NON-VERB.
024042     IF WORD12 = 'RUN-UNIT' AND V = V-FIND-DBMS
024044        MOVE V-RUN-UNIT TO VAA  MOVE 0 TO FLAG-SET-TO-COME
024045        SET X UP BY 1  GO TO GET-VERB-EXIT.
024050     IF WORD30 = 'SCHEMA ' AND V = V-INVOKE
024052        MOVE V-SCHEMA TO VA GO TO GET-NON-VERB.
024060     if WORD06 = 'SET ' AND FLAG-SET-TO-COME = 0
024062        move V-SET TO V  GO TO GET-NON-VERB.
024064     if WORD06 = 'SET ' MOVE 0 TO FLAG-SET-TO-COME.
024081*    if WORD06 = 'SET ' AND V = V-FIND-DBMS
024082*       and (VA = V-FINDSET OR VA = V-SUPPRESSSET)
024088*           MOVE V-SET TO V GO TO GET-NON-VERB.
024090*    ABOVE WILL INTERPRET 'SET' AS THE NON-DBMS VERB 'SET'
024092*    SINCE THE WORDS SUPPRESS OR SET HAVE ALREADY APPEARED(AS INDICATED
024094*    BY VA) THEREFORE THIS USE OF 'SET' MUST BE THE VERB.
024100     IF WORD06 = 'SET ' AND V = V-FIND-DBMS
024120        AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSSET TO VA
024122         GO TO GET-VERB-EXIT.
024122*    VAA = V-FINDSET BELOW WOULD INDICATE THAT A DBMS 'SET' SHOULD
024124*    BE EXPECTED.
024126     IF WORD06 = 'SET ' IF V = V-FIND-DBMS 
024128        MOVE V-FINDSET TO VA GO TO GET-VERB-EXIT.
024145*    EOS OR FINDFINI TEST BELOW WOULD MEAN THAT JUST PREVIOUS
024146*    TO READING 'SET' WE HIT EOS ON OUR FIND CLAUSE.
024147*    THEREFORE, WE HAVE AN INDEPENDENT 'SET' VERB, NOT A
024148*    PART OF FIND.
024150*    IF (WORD06 = 'SET ' AND V = V-FIND-DBMS AND
024151*      (FLAG-EOS = 1 OR FLAG-FINDFINI = 1))
024152*      MOVE V-SET TO V  GO TO GET-NON-VERB.
024160*     IF WORD06 = 'SET ' AND V = V-FIND-DBMS
024180*       MOVE V-FINDSET TO VA GO TO GET-VERB-EXIT.
024200*     IF WORD06 = 'SET ' MOVE V-SET TO V
024220*       GO TO GET-NON-VERB.
024240      IF WORD06 = 'SORT ' MOVE V-SORT TO V
024260        GO TO GET-NON-VERB.
024280     IF WORD12 = 'STITLES ' MOVE V-STITLES TO V
024300        GO TO GET-NON-VERB.
024320     IF WORD30 = 'SUB-SCHEMA ' AND V = V-INVOKE
024340        MOVE V-SUB-SCHEMA TO VA GO TO GET-NON-VERB.
024360     IF WORD12 = 'SUMMARY ' MOVE V-SUMMARY TO V
024380        GO TO GET-NON-VERB.
024400     IF WORD18 = 'SUMMARYPRINT ' MOVE V-SUMMARY TO V
024420        GO TO GET-NON-VERB.
024440     IF WORD12 = 'SUMMARYOFF ' MOVE V-SUMMARYOFF TO V
024460        GO TO GET-ONE-VERB.
024480     IF WORD12 = 'SUMMARYON ' MOVE V-SUMMARYON TO V
024500        GO TO GET-ONE-VERB.
024520     IF WORD12 = 'SUMPRINT ' MOVE V-SUMMARY TO V
024540        GO TO GET-NON-VERB.
024560     IF WORD12 = 'SUPPRESS ' AND V = V-FIND-DBMS
024580        MOVE V-FINDSUPPRESS TO VA MOVE 1 TO FLAG-SET-TO-COME
024582        GO TO GET-VERB.
024600     IF WORD12 = 'SUPPRESS ' MOVE V-SUMMARYOFF TO V
024620        GO TO GET-ONE-VERB.
024640     IF WORD12 = 'SUPPRESSED ' MOVE V-SUMMARYOFF TO V
024660        GO TO GET-ONE-VERB.
024680     IF WORD06 = 'TALLY ' MOVE V-TALLY TO V
024700        GO TO GET-NON-VERB.
024720     IF WORD06 = 'THAN ' MOVE V-THAN TO V
024740        GO TO GET-VERB.
024760     IF WORD06 = 'THEN ' GO TO GET-VERB.
024780     IF WORD06 = 'THRU ' AND V = V-FINDKEY
024800        MOVE V-THRU TO VA GO TO GET-VERB.
024820     IF WORD12 = 'TITLES ' MOVE V-TITLES TO V
024840        GO TO GET-NON-VERB.
024860     IF WORD12 = 'TITLESOFF ' MOVE V-TITLESOFF TO V
024880        GO TO GET-ONE-VERB.
024900     IF WORD12 = 'TITLESON ' MOVE V-TITLESON TO V
024920        GO TO GET-ONE-VERB.
024940     IF WORD06 = 'TO ' GO TO LEGAL-TO.
024960     IF WORD06 = 'TODAY ' MOVE TYPE-TODAY TO TYPEV.
024980     IF WORD06 = 'TOTAL ' MOVE V-TOTAL TO V
025000        GO TO GET-NON-VERB.
025020     IF WORD12 = 'UNSUPPRESS ' MOVE V-SUMMARYON TO V
025040        GO TO GET-ONE-VERB.
025060     IF WORD18 = 'UNSUPPRESSED ' MOVE V-SUMMARYON TO V
025080        GO TO GET-ONE-VERB.
025100     IF WORD12 = 'UPDATES ' AND V = V-FIND-DBMS
025120        GO TO GET-VERB.
025140     IF WORD12 = 'USING ' AND V = V-FIND
025160        MOVE V-FIND-DBMS TO V MOVE 1 TO N-RSE
025180        GO TO GET-VERB.
025200     IF WORD12 = 'VSPACE ' MOVE V-VSPACE TO V
025220        GO TO GET-NON-VERB.
025240     IF WORD12 = 'WIDTH ' MOVE V-WIDTH TO V
025260        GO TO GET-NON-VERB.
025280     IF WORD12 = 'XRANDOM ' MOVE TYPE-XRANDOM TO TYPEV.
025300     IF WORD04 = 'XT ' AND V = V-GOTO
025320        MOVE V-GOTOXT TO V GO TO GET-ONE-VERB.
025340     IF WORD02 = '= ' GO TO LEGAL-EQUALS.
025360     IF WORD02 = '( ' GO TO LEGAL-LPAREN.
025380     IF WORD02 = '+ ' AND V = V-COMPUTE
025400        MOVE V-ADD TO VA GO TO GET-VERB-EXIT.
025420     IF WORD02 = '- ' AND V = V-COMPUTE
025440        MOVE V-SUBTRACT TO VA GO TO GET-VERB-EXIT.
025460     IF WORD02 = '* ' AND V = V-COMPUTE
025480        MOVE V-MULTIPLY TO VA GO TO GET-VERB-EXIT.
025500     IF WORD02 = '/ ' AND V = V-COMPUTE
025520        MOVE V-DIVIDE TO VA GO TO GET-VERB-EXIT.
025540     IF WORD02 = ') ' AND V = V-COMPUTE
025560        MOVE V-RPAREN TO VA GO TO GET-VERB-EXIT.
025580     IF WORD02 = ') ' AND VA = V-LPAREN
025600        MOVE V-RPAREN TO VA GO TO GET-VERB-EXIT.
025620     IF WORD02 = ') ' GO TO LEGAL-AND-OR-RPAREN.
025640     IF V = ZERO GO TO GET-VERB-EXIT.
025660*    BUG OUT FOR --GO TO NR/XT/QT--
025680     IF V = V-GOTO GO TO GET-VERB-EXIT.
025700     IF FLAG-EOS = 1 AND FLAG-EOS2 NOT EQUAL TO 1
025720        GO TO E005.
025740 GOT-NON-VERB.
025760*    HERE TO STORE THE 1ST OBJECT OF A VERB INTO INSTR
025780*    IF VERB CAN TAKE MORE THAN 1 OBJECT(IE LIST), THEY
025800*    MOST LIKELY WILL BE READ UNDER CONTROL OF VERB ITSELFS
025820     IF V = 0 GO TO GET-VERB-EXIT.
025840     PERFORM DROP-IN-DX THRU DIDX.
025860     IF V = V-GOTO GO TO GET-ONE-VERB.
025880     SET X UP BY 1. SET INSTR (X) TO DX.
025900     GO TO GET-VERB-EXIT.
025920 EQ-LIST.
025940     PERFORM GET-WORD THRU GET-WORDX.
025960     IF WORD04 = 'NOT ' NEXT SENTENCE
025980        ELSE GO TO EQ-LIST1.
026000*    FLIP NOT FLAG FROM ITS PREVIOUS CONDITION ENABLING NOT/NOT NOT
026020     IF FLAG-NOT = 0 MOVE 1 TO FLAG-NOT ELSE MOVE 0 TO FLAG-NOT.
026040     MOVE 1 TO VP-NOT.
026060     GO TO EQ-LIST.
026080 EQ-LIST1.
026100     IF WORD06 = 'EQ ' MOVE V-EQUAL TO VA
026120        GO TO GET-VERB.
026140     IF WORD06 = '= ' MOVE V-EQUAL TO VA
026160        GO TO GET-VERB.
026180     IF WORD06 = 'EQUAL ' MOVE V-EQUAL TO VA
026200        GO TO GET-VERB.
026220     IF WORD12 = 'EQUALS ' MOVE V-EQUAL TO VA
026240        GO TO GET-VERB.
026260     IF WORD06 = 'IS ' MOVE V-EQUAL TO VA
026280         GO TO GET-VERB.
026300     IF WORD06 = 'NQ ' MOVE V-NOTEQUAL TO VA
026320        GO TO GET-VERB.
026340     IF WORD06 = '<> ' MOVE V-NOTEQUAL TO VA
026360        GO TO GET-VERB.
026380     IF WORD06 = '# ' MOVE V-NOTEQUAL TO VA
026400        GO TO GET-VERB.
026420     IF WORD06 = 'NE ' MOVE V-NOTEQUAL TO VA
026440        GO TO GET-VERB.
026460     IF WORD06 = 'NEQ ' MOVE V-NOTEQUAL TO VA
026480        GO TO GET-VERB.
026500     IF WORD06 = 'LS ' MOVE V-LESS TO VA
026520        GO TO GET-VERB.
026540     IF WORD06 = '< ' MOVE V-LESS TO VA
026560        GO TO GET-VERB.
026580     IF WORD06 = 'LT ' MOVE V-LESS TO VA
026600        GO TO GET-VERB.
026620     IF WORD06 = 'LESS ' MOVE V-LESS TO VA
026640        GO TO GET-VERB.
026660     IF WORD06 = 'GR ' MOVE V-GREATER TO VA
026680        GO TO GET-VERB.
026700     IF WORD06 = '> ' MOVE V-GREATER TO VA
026720        GO TO GET-VERB.
026740     IF WORD06 = 'GT ' MOVE V-GREATER TO VA
026760        GO TO GET-VERB.
026780     IF WORD12 = 'GREATER ' MOVE V-GREATER TO VA
026800        GO TO GET-VERB.
026820     IF WORD06 = 'GEQ ' MOVE V-GREATEREQUAL TO VA
026840        GO TO GET-VERB.
026860     IF WORD06 = '>= ' MOVE V-GREATEREQUAL TO VA
026880        GO TO GET-VERB.
026900     IF WORD06 = 'GE ' MOVE V-GREATEREQUAL TO VA
026920        GO TO GET-VERB.
026940     IF WORD06 = 'GQ ' MOVE V-GREATEREQUAL TO VA
026960        GO TO GET-VERB.
026980     IF WORD06 = 'LEQ ' MOVE V-LESSEQUAL TO VA
027000        GO TO GET-VERB.
027020     IF WORD06 = '<= ' MOVE V-LESSEQUAL TO VA
027040        GO TO GET-VERB.
027060     IF WORD06 = 'LE ' MOVE V-LESSEQUAL TO VA
027080        GO TO GET-VERB.
027100     IF WORD06 = 'LQ ' MOVE V-LESSEQUAL TO VA
027120        GO TO GET-VERB.
027140     MOVE 029 TO ECODE.
027160     PERFORM E-RROR THRU E-XIT.
027180     MOVE V-ILLEGAL TO VA.  GO TO GET-VERB.
027182 FIND-LIST0.
027184     MOVE 1 TO FLAG-SET-TO-COME.
027200 FIND-LIST.
027205     IF FLAG-NON-VERB = 1 GO TO E006.
027210     MOVE 0 TO FLAG-FINDFINI.
027220     PERFORM GET-WORD THRU GET-WORDX.
027222     IF WORD06 = 'IN ' GO TO FIND-LIST.
027224     IF WORD06 = 'OF ' GO TO FIND-LIST.
027240     IF WORD06 = 'KEY ' MOVE V-FINDKEY TO V
027260        MOVE V-FINDKEY1 TO VA GO TO GET-NON-VERB.
027280     IF WORD06 = 'KEY1 ' MOVE V-FINDKEY TO V
027300        MOVE V-FINDKEY1 TO VA GO TO GET-NON-VERB.
027320     IF WORD06 = 'KEY2 ' MOVE V-FINDKEY TO V
027340        MOVE V-FINDKEY2 TO VA GO TO GET-NON-VERB.
027360     IF WORD06 = 'KEY3 ' MOVE V-FINDKEY TO V
027380        MOVE V-FINDKEY3 TO VA GO TO GET-NON-VERB.
027382     IF WORD12 = 'CURRENT '  MOVE V-FIND-DBMS TO V
027384        MOVE 2 TO N-RSE   GO TO FIND-LIST0.
027386     IF WORD12 = 'RUN-UNIT ' MOVE V-FIND-DBMS TO V
027388        MOVE V-RUN-UNIT TO VAA PERFORM DROP-IN-VERB THRU DIVX
027390        SET X UP BY 1  GO TO GET-VERB-EXIT.
027392     IF WORD12 = 'DUPLICATE ' MOVE V-FIND-DBMS TO V
027394        MOVE V-FINDUPLICATE TO VA  MOVE 5 TO N-RSE
027396        MOVE 0 TO FLAG-SET-TO-COME  GO TO FIND-LIST.
027398     IF WORD12 = 'WITHIN ' GO TO FIND-LIST.
027400     IF WORD06 = 'FIRST ' MOVE V-FINDFIRST TO VA
027420        MOVE V-FIND-DBMS TO V
027440        MOVE 3 TO N-RSE GO TO FIND-LIST0.
027460     IF WORD06 = 'LAST ' MOVE V-FINDLAST TO VA
027480        MOVE V-FIND-DBMS TO V
027500        MOVE 3 TO N-RSE GO TO FIND-LIST0.
027520     IF WORD06 = 'NEXT ' MOVE V-FINDNEXT TO VA
027540        MOVE V-FIND-DBMS TO V
027560        MOVE 3 TO N-RSE GO TO FIND-LIST0.
027620     IF WORD06 = 'PRIOR ' MOVE V-FINDPRIOR TO VA
027640        MOVE V-FIND-DBMS TO V
027660        MOVE 3 TO N-RSE GO TO FIND-LIST0.
027680     IF WORD06 = 'OWNER ' MOVE V-FINDOWNER TO VA
027700        MOVE V-FIND-DBMS TO V
027720        MOVE 4 TO N-RSE GO TO FIND-LIST0.
027740     IF WORD12 = 'PARTIAL ' AND V = V-FIND
027760        MOVE TYPE-PARTIAL-KEY TO VA GO TO FIND-LIST.
027780     IF WORD12 = 'RECORD ' AND VA = V-FINDOWNER
027800        MOVE V-FIND-DBMS TO V MOVE V-FINDOWNER-RECORD TO VAA
027802        GO TO FIND-LIST.
027810     IF VA = V-FINDOWNER AND VAA NOT = V-FINDOWNER-RECORD
027812        MOVE 2 TO N-RSE.
027820     PERFORM DROP-IN-VERB THRU DIVX.
027830     IF N-RSE = 3 IF WORD12 = 'RECORD '
027832        MOVE 1 TO FLAG-PEEKED  SET DX TO ZERO  GO TO FIND-LIST1.
027840     PERFORM DROP-IN-DX THRU DIDX.
027842 FIND-LIST1.
027860     SET X UP BY 1. SET INSTR (X) TO DX.
027880     GO TO GET-VERB-EXIT.
027900 IF-LIST.
027910     IF FLAG-NON-VERB = 1 GO TO E006.
027920     MOVE 0 TO FLAG-IF.
027940     PERFORM GET-WORD THRU GET-WORDX.
027960     MOVE ZEROS TO VA.
027980     IF FLAG-QUOTE NOT EQUAL TO ZERO
028000        MOVE 1 TO FLAG-LEFTLIT  GO TO GET-LITERAL.
028020     IF WORD06 = 'ANY ' MOVE V-IFANY TO V
028040        GO TO IF-LIST.
028060     IF WORD06 = 'BOF1 ' MOVE V-BOF1 TO V
028080        GO TO GET-ONE-VERB.
028100     IF WORD06 = 'BOF2 ' MOVE V-BOF2 TO V
028120        GO TO GET-ONE-VERB.
028140     IF WORD06 = 'BOF3 ' MOVE V-BOF3 TO V
028160        GO TO GET-ONE-VERB.
028180     IF WORD06 = 'EOF1 ' MOVE V-EOF1 TO V
028200        GO TO GET-ONE-VERB.
028220     IF WORD06 = 'EOF2 ' MOVE V-EOF2 TO V
028240        GO TO GET-ONE-VERB.
028260     IF WORD06 = 'EOF3 ' MOVE V-EOF3 TO V
028280        GO TO GET-ONE-VERB.
028300     IF WORD06 = 'FIRST ' MOVE V-IFFIRST TO V
028320        GO TO IF-LIST.
028340     IF WORD06 = 'LAST ' MOVE V-IFLAST TO V
028360        GO TO IF-LIST.
028380     IF WORD06 = 'NEXT ' MOVE V-IFNEXT TO V
028400        GO TO IF-LIST.
028420     IF WORD06 = 'SAME ' MOVE V-IFSAME TO V
028440        GO TO IF-LIST.
028460     IF WORD06 = 'TIME ' AND V = V-IFFIRST
028480        MOVE V-IFFIRSTIME TO V GO TO GET-ONE-VERB.
028500     IF WORD06 = 'TIME ' AND V = V-IFLAST
028520        MOVE V-IFLASTIME TO V GO TO GET-ONE-VERB.
028540     IF (WORD12 = 'FIRSTIME ' OR
028550         WORD12 = 'FIRSTTIME ' OR WORD12 = 'FIRSTME ')
028560         MOVE V-IFFIRSTIME TO V  GO TO GET-ONE-VERB.
028580     IF (WORD12 = 'LASTIME ' OR
028590         WORD12 = 'LASTTIME ' OR WORD12 = 'LASTME ')
028600         MOVE V-IFLASTIME TO V  GO TO GET-ONE-VERB.
028620     IF WORD12 = 'PAGE-LINES ' MOVE V-LINE TO V
028640        GO TO EQ-LIST.
028660     IF WORD06 = 'NEW ' MOVE V-NEW TO V
028680        GO TO IF-LIST.
028700     IF WORD12 = 'NEWGROUP ' MOVE V-IFNEWGROUP TO V
028720        GO TO GET-ONE-VERB.
028740     IF WORD12 = 'NEWGRPV ' MOVE V-IFNEWGROUP TO V
028760        GO TO GET-ONE-VERB.
028780     IF WORD12 = 'NEWPAGE ' MOVE V-IFNEWPAGE TO V
028800        GO TO GET-ONE-VERB.
028820     IF WORD18 = 'PAGE ' AND V = V-NEW
028840        GO TO GET-ONE-VERB.
028980     IF WORD04 NOT = 'NOT ' GO TO IF-LIST1.
029000     IF FLAG-NOT = 0 MOVE 1 TO FLAG-NOT
029020        ELSE MOVE 0 TO FLAG-NOT.
029040     MOVE 1 TO VP-NOT.
029060     GO TO IF-LIST.
029080 IF-LIST1.
029100     IF WORD02 = '( '
029120        ADD 1 TO LPARENCNTR
029140        ADD 1 TO N-OPENLPS
029160        MOVE FLAG-NOT TO NOTT (N-OPENLPS)
029180        MOVE 0 TO VP-NOT
029200        GO TO IF-LIST.
029220*    SEE IF WE JUST READ 'IF' AFTER HAVING PREVIOUSLY
029240*    READ AND/OR--IF SO, RESET V AND READ OBJECT FOLLOWING
029260*    'IF'.
029280     IF V NOT = V-AND AND V NOT = V-OR GO TO IF-LIST2.
029300     MOVE 0 TO FLAG-IF. MOVE V-IF TO V.
029320     IF WORD04 = 'IF ' 
029322        move 'change "and/or if" to "and/or" ' to word30
029324        go to e053.
029340*    HERE WHEN HAVE AND/OR NOT FOLLOWED BY 'IF'
029360 IF-LIST2.
029380     PERFORM DROP-IN-VERB THRU DIVX.
029400*    IF LEFT OF RELATIONAL WAS A LITERAL, WE ALREADY HAVE ITS DX.
029420     IF FLAG-LEFTLIT = 1
029440        MOVE 0 TO FLAG-LEFTLIT
029460        ELSE PERFORM DROP-IN-DX THRU DIDX.
029480     SET DX-IFLEFTSIDE TO DX.
029500     GO TO EQ-LIST.
029520 LEGAL-BY.
029540*    MOST OF THESE LEAGAL ROUTINES INITIALIZE V = 0 SO THAT
029560*    IF FALL THRU ALL TESTS, WHEN CONTROL IS GIVEN TO THE
029580*    DISPATCHER IN VERB-CONTROL, IT WILL CAUSE ROUTING TO
029600*    E005 BECAUSE V = 0.
029620     MOVE ZEROS TO V.
029640     MOVE 1 TO FLAG-BY.
029660     IF VP = V-AVERAGE MOVE V-AVERAGE TO V
029680        GO TO GET-VERB.
029700     IF VP = V-MAXIMUM MOVE V-MAXIMUM TO V
029720        GO TO GET-VERB.
029740     IF VP = V-MINIMUM MOVE V-MINIMUM TO V
029760        GO TO GET-VERB.
029780     IF VP = V-SORT MOVE V-SORT TO V  MOVE V-ASCENDING TO VA
029800        GO TO GET-VERB.
029820     IF VP = V-TALLY MOVE V-TALLY TO V
029840        GO TO GET-VERB.
029860     IF VP = V-TOTAL MOVE V-TOTAL TO V
029880        GO TO GET-VERB.
029900     GO TO GET-VERB-EXIT.
029920 LEGAL-EQUALS.
029940     IF VP = V-COMPUTE MOVE V-COMPUTE TO V
029960        MOVE V-RESULT TO VA GO TO GET-VERB-EXIT.
029980     IF (VP = V-TALLY OR VP = V-TOTAL OR VP = V-AVERAGE OR
030000         VP = V-MAXIMUM OR VP = V-MINIMUM)
030020        AND VA = V-LPAREN
030040        MOVE 1 TO FLAG-SUMMARY-DEF-TIME GO TO GET-VERB.
030060     IF VP = V-CREATE  IF VAA = V-FILLER
030080        MOVE V-CREATE TO V  GO TO GET-VERB.
030100     IF VP = V-CREATE MOVE V-CREATE TO V
030120        MOVE V-EQUAL TO VA GO TO GET-VERB.
030140     IF VP = V-FIND MOVE V-FIND TO V
030160        MOVE V-EQUAL TO VA GO TO GET-VERB.
030180     IF VP = V-FINDKEY MOVE V-FINDKEY TO V
030200        MOVE V-EQUAL TO VP GO TO GET-VERB-EXIT.
030220     IF VP = V-PICTURE MOVE V-PICTURE TO V
030240        MOVE V-EQUAL TO VA GO TO GET-VERB.
030260     IF VP = V-TITLES MOVE V-TITLES TO V
030280        MOVE V-EQUAL TO VA GO TO GET-VERB.
030300     IF VP = V-SET MOVE V-SET TO V MOVE V-TO TO VA
030320        GO TO GET-VERB.
030330     IF VP = V-CALL
030332        MOVE 1 TO VA  GO TO GET-VERB.
030340     MOVE ZEROS TO V.
030360     GO TO GET-VERB-EXIT.
030380 LEGAL-LPAREN.
030400     IF V = V-COMPUTE
030420        MOVE V-LPAREN TO VA GO TO GET-VERB-EXIT.
030440     IF V = V-TALLY OR V = V-TOTAL OR V = V-AVERAGE OR
030460        V = V-MAXIMUM OR V = V-MINIMUM
030480        MOVE V-LPAREN TO VA  GO TO GET-VERB-EXIT.
030500     MOVE ZEROS TO V.
030520     GO TO GET-VERB-EXIT.
030540 LEGAL-OFF.
030560     MOVE ZEROS TO V.
030580     IF VP = V-DISPLAY MOVE V-DISPLAYOFF TO V.
030600     IF VP = V-HEADING MOVE V-HEADINGOFF TO V.
030620     IF VP = V-PAGING MOVE V-PAGINGOFF TO V.
030640     IF VP = V-PRINT MOVE V-PRINTOFF TO V.
030660     IF VP = V-RPTDATE MOVE V-RPTDATEOFF TO V.
030680     IF VP = V-RPTHEAD MOVE V-RPTHEADOFF TO V.
030700     IF VP = V-SUMMARY MOVE V-SUMMARYOFF TO V.
030720     IF VP = V-TITLES MOVE V-TITLESOFF TO V.
030740     SET INSTR (X) TO V.
030760     GO TO GET-VERB-EXIT.
030780 LEGAL-ON.
030800     MOVE ZEROS TO V.
030820     IF VP = V-DISPLAY MOVE V-DISPLAYON TO V.
030840     IF VP = V-HEADING MOVE V-HEADINGON TO V.
030860     IF VP = V-PAGING MOVE V-PAGINGON TO V.
030880     IF VP = V-PRINT MOVE V-PRINTON TO V.
030900     IF VP = V-RPTDATE MOVE V-RPTDATEON TO V.
030920     IF VP = V-RPTHEAD MOVE V-RPTHEADON TO V.
030940     IF VP = V-SUMMARY MOVE V-SUMMARYON TO V.
030960     IF VP = V-TITLES MOVE V-TITLESON TO V.
030980     SET INSTR (X) TO V.
031000     GO TO GET-VERB-EXIT.
031020 LEGAL-RECORD.
031040     IF V = V-FIND
031060        MOVE V-FIND-DBMS TO V  MOVE V-FINDRECORD TO VA
031080        GO TO GET-VERB-EXIT.
031100     IF V NOT = V-FIND-DBMS GO TO E013.
031120     IF VA = V-FINDSUPPRESS MOVE V-SUPPRESSRECORD TO VA
031140        MOVE 0 TO FLAG-SET-TO-COME  GO TO GET-VERB-EXIT.
031160     MOVE V-FINDRECORD TO VA.
031180     IF N-RSE = 4 GO TO GET-VERB.
031182     IF N-RSE = 2 MOVE 0 TO FLAG-SET-TO-COME.
031190     MOVE 4 TO FLAG-VERB.
031192     GO TO GET-VERB-EXIT.
031220 LEGAL-TO.
031240     MOVE ZEROS TO V.
031260     IF VP = V-COPY MOVE V-COPY TO V
031280        MOVE V-TO TO VA GO TO GET-VERB.
031300     IF VP = V-FINDKEY MOVE V-FINDKEY TO V
031320        MOVE V-TO TO VA GO TO GET-VERB.
031340     IF VP = V-GOTO MOVE V-GOTO TO V
031360        GO TO GET-VERB.
031380     IF VP = V-SET MOVE V-SET TO V
031400        MOVE V-TO TO VA GO TO GET-VERB.
031420     GO TO GET-VERB-EXIT.
031440 LEGAL-AND-OR-RPAREN.
031460     IF VP = V-IF         OR
031480        VP = V-RPAREN     OR
031500        VP = V-IFFIRSTIME OR
031520        VP = V-IFLASTIME  OR
031540        VP = V-BOF1 OR VP = V-BOF2 OR VP = V-BOF3 OR
031560        VP = V-EOF1 OR VP = V-EOF2 OR VP = V-EOF3 OR
031580        VP = V-IFFIRST OR VP = V-IFLAST OR VP = V-IFANY OR
031600        VP = V-IFNEXT OR VP = V-IFSAME OR
031640        VP = V-IFNEWGROUP
031660        NEXT SENTENCE
031680        ELSE MOVE ZEROES TO V  GO TO GET-VERB-EXIT.
031700     IF WORD18 NOT = ') ' GO TO LEGAL-AOP2.
031720     MOVE V-RPAREN TO V.
031740*    NOW SET FLAG-NOT TO NEXT LOWER PAREN LEVEL
031760     SUBTRACT 1 FROM N-OPENLPS.
031780     IF N-OPENLPS NOT = 0
031800        MOVE NOTT (N-OPENLPS) TO FLAG-NOT
031820        ELSE
031840        MOVE 0 TO FLAG-NOT.
031860     GO TO GET-NON-VERB.
031880 LEGAL-AOP2.
031900     IF WORD18 = 'AND ' MOVE V-AND TO V
031920        ELSE MOVE V-OR TO V.
031940     PERFORM DROP-IN-VERB THRU DIVX.
031960     GO TO IF-LIST.
031980 GET-ONE-VERB.
031990     IF FLAG-NON-VERB = 1 GO TO E006.
032000     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
032020     IF FLAG-EOS = 1 AND FLAG-EOS2 NOT EQUAL TO 1
032040        MOVE ZERO TO FLAG-eos flag-if flag-if-statement
032060        SET X UP BY 1 MOVE V-EOS TO INSTR (X).
032080     SET X UP BY 1. MOVE V TO INSTR (X).
032100     IF FLAG-EOS = 2 MOVE 1 TO FLAG-EOS.
032120     MOVE ZERO TO FLAG-EOS2 FLAG-BY.
032140     MOVE 1 TO FLAG-VERB.
032160     GO TO GET-VERB-EXIT.
032180 GET-NON-VERB.
032200*    HERE FOR VERBS THAT CAN BE FOLLOWED BY NON-VERBS
032220*    (IE OBJECTS)--NOW, WRAPUP(NOP) PREVIOUS VERB IN INSTR
032240*    TABLE AND INSERT CURR VERB, SET VERB-FLAG, AND GET
032260*    NEXT VERB( OR NON-VERB).
032265     IF FLAG-NON-VERB = 1 GO TO E006.
032270*    MOVE 1 TO FLAG-NON-VERB.
032280     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
032300     IF FLAG-EOS = 1 MOVE ZERO TO FLAG-EOS
032320        MOVE ZERO TO FLAG-IF  MOVE ZERO TO FLAG-if-statement
032340        SET X UP BY 1 MOVE V-EOS TO INSTR (X).
032360     SET X UP BY 1. MOVE V TO INSTR (X).
032380     MOVE 1 TO FLAG-VERB.
032382     MOVE ZERO TO FLAG-BY.
032400     GO TO GET-VERB.
032420 GET-LITERAL.
032422     if word-table not = spaces  go to e057.
032440     MOVE FLAG-QUOTE TO TEST-QUOTE.
032460     MOVE ZERO TO FLAG-QUOTE.
032480     IF V = V-FINDKEY MOVE SPACE TO LCHAR.
032500*    IF LCHAR = '"' OR LCHAR = "'" GO TO GET-LITERAL2.
032520     MOVE ZERO TO FLAG-SLASHES.
032540     SET DX TO DX-LOWEST. SET LX TO DX.
032560     IF V = V-COPY OR V = V-CREATE OR V = V-OPEN
032580        GO TO GET-LITERAL1.
032590     IF V = V-CALL GO TO GET-LITERAL1.
032600     IF V = V-DISPLAY GO TO GET-LITERAL1.
032620     IF V = V-FINDKEY GO TO GET-LITERAL1.
032630     IF V = V-FIND    GO TO GET-LITERAL1.
032640     IF V = V-IF      GO TO GET-LITERAL1.
032660     IF V = V-IFFIRST GO TO GET-LITERAL1.
032680     IF V = V-IFLAST  GO TO GET-LITERAL1.
032700     IF V = V-IFANY   GO TO GET-LITERAL1.
032720     IF V = V-IFNEXT  GO TO GET-LITERAL1.
032740     IF V = V-IFSAME  GO TO GET-LITERAL1.
032800     IF V = V-PRINT   GO TO GET-LITERAL1.
032820     IF V = V-PICTURE GO TO GET-LITERAL1.
032840     IF V = V-RPTDATE GO TO GET-LITERAL1.
032860     IF V = V-RPTHEAD GO TO GET-LITERAL1.
032880     IF V = V-SET     GO TO GET-LITERAL1.
032900     IF V = V-TITLES  GO TO GET-LITERAL1.
032920     MOVE CHAR TO WORD30. MOVE 007 TO ECODE.
032940     PERFORM E-RROR THRU E-XIT.
032960     MOVE ZEROS TO TEST-QUOTE.
032980     GO TO GET-VERB.
033000 GET-LITERAL1.
033020     SET DX DOWN BY 1.
033040     SET X UP BY 1. SET INSTR (X) TO DX.
033060     SET LX DOWN BY 1. SET DX-LOWEST TO LX.
033080     MOVE TYPE-LITERAL TO L-TYPEV (LX).
033100     MOVE TYPE-LITERAL TO TYPEV.
033120     SET Q TO 1.
033140     MOVE SPACE TO QUOTE-TABLE.
033160     MOVE SPACE TO CHAR.
033180 GET-LITERAL2.
033200     MOVE CHAR TO LCHAR.
033220*    TEST-QUOTE NOT 0 CAUSES GET-WORD TO GET ONLY 1 CHAR
033240*    AT A TIME
033260     PERFORM GET-WORD THRU GET-WORDX.
033280     IF V = 1 GO TO GET-LITERALX.
033300     IF FLAG-QUOTE = TEST-QUOTE MOVE ZERO TO TEST-QUOTE
033320        SET Q DOWN BY 1
033340        GO TO GET-LITERAL3.
033360     IF CHAR = '/' AND LCHAR = '/' AND V = V-RPTHEAD
033380        GO TO GET-LITERAL4.
033400     IF CHAR = '/' AND LCHAR = '/' AND V = V-TITLES
033420        GO TO GET-LITERAL4.
033440     MOVE CHAR TO QUOTEX (Q). MOVE Q TO L-NCHAR (LX).
033460     SET Q UP BY 1.
033480     IF Q > Q-MAX    SET Q TO Q-MAX  GO TO GET-LITERAL3.
033500     GO TO GET-LITERAL2.
033520 GET-LITERAL3.
033540     MOVE CHAR TO LCHAR.
033560     MOVE QUOTE-TABLE TO L-VALUE (LX).
033580     MOVE Q TO L-NCHAR (LX).
033600     MOVE 1 TO FLAG-ALPHA.
033620     IF TEST-QUOTE = ZERO MOVE ZERO TO FLAG-QUOTE
033640        ELSE GO TO GET-LITERAL3A.
033660     IF FLAG-LEFTLIT = 1 SET X DOWN BY 1 GO TO IF-LIST2.
033680     GO TO GET-VERB-EXIT.
033700 GET-LITERAL3A.
033720     IF V = V-TITLES AND FLAG-SLASHES = 1
033740        SET Q TO 11 GO TO GET-LITERAL2.
033760     IF V NOT EQUAL TO V-RPTHEAD GO TO GET-LITERALX.
033780     SET X UP BY 1. SET INSTR (X) TO V-SLASHES.
033800     GO TO GET-LITERAL1.
033820 GET-LITERAL4.
033840     ADD 1 TO FLAG-SLASHES. SET Q DOWN BY 1.
033860     MOVE SPACE TO QUOTEX (Q).
033880     SET Q DOWN BY 1.
033900     GO TO GET-LITERAL3.
033920 GET-LITERALX.
033940     MOVE QUOTE-TABLE TO WORD30.
033960     MOVE 011 TO ECODE.
033980     PERFORM E-RROR THRU E-XIT.
034000     MOVE ZERO TO FLAG-QUOTE TEST-QUOTE FLAG-SLASHES.
034020     GO TO GET-VERB-EXIT.
034040 GET-FILLER.
034060     MOVE SPACE TO WORD06. MOVE SPACE TO WORDX (7).
034080     MOVE ZERO TO FLAG-ALPHA.
034100     PERFORM GET-WORDN THRU GET-WORDX.
034120     GO TO VERB-CONTROL.
034140 GET-KNOWN-VERB.
034160     PERFORM GET-INSTR THRU GET-INSTRX.
034180     GO TO GET-VERB-EXIT.
034200 GET-VERB-EXIT.    EXIT.
034220 DROP-IN-DX.
034240     SET DX TO DX-MAX.
034260     IF FLAG-ALPHA = 1 GO TO DID1.
034280     IF V = V-COMPUTE OR V = V-IF OR V = V-GOTO
034320        OR V = V-RPTDATE OR V = V-OR OR V = V-AND
034340        OR V = V-SET OR V = V-PAGE OR V = V-FIND
034342        OR V = V-IFANY OR V = V-IFFIRST OR V = V-IFLAST
034344        OR V = V-IFNEXT OR V = V-IFSAME OR V = V-CALL
034360        GO TO DID1.
034380     GO TO DIDX.
034400 DID1.
034420     IF DX < DX-LOWEST GO TO DID2.
034440     SET KX TO DX.
034460     IF WORD30 NOT EQUAL TO K-ENDKEY (KX)
034480        SET DX DOWN BY 1 GO TO DID1.
034500*    IF THIS PREVIOUSLY REFERENCED SUMMARY ITEM (ZZ) IS JUST
034520*    NOW BEING DEFINED BY '( = ZZ)' SYNTAX, THEN MODIFY
034540*    THE PREVIOUS ENTRY TO BE TYPE-SUMMARY AND CHANGE THE
034560*    DUPLICATE VX ENTRY POINTER THAT IS IN THE INSTR TABLE
034580*    TO BE A POINTER TO THIS OLDER ENTRY.
034600     IF FLAG-SUMMARY-DEF-TIME = 0 GO TO DID1A.
034620     IF WORD02 NOT = 'ZZ' AND WORD01 NOT = 'X'
034640        MOVE 33 TO ECODE  PERFORM E-RROR THRU E-XIT.
034642     IF D-TYPEV (DX) = TYPE-SUMMARY OR
034644        D-TYPEV (DX) = TYPE-AVERAGE
034646        MOVE 33 TO ECODE
034648        MOVE 'ZZITEM HAS BEEN DEFINED TWICE' TO WORD30
034650        PERFORM E-RROR THRU E-XIT.
034660     MOVE TYPE-SUMMARY TO D-TYPEV (DX).
034680     ADD 1 TO D-NREPEATS (DX).
034700*    CALC HOW FAR BACK IN THE INSTR TABLE WE MUST GO TO
034720*    FIND THE DUPLICATE VX POINTER=F(BY)
034740     IF FLAG-BY = 1 MOVE 4 TO DELTA ELSE MOVE 1 TO DELTA.
034760     SET X DOWN BY DELTA.
034780     SET INSTR (X) TO DX.
034800     SET X UP BY DELTA.
034820     GO TO DID3.
034840 DID1A.
034860*    IF THE ITEM FOUND IS A PRIOR-SUMMARY TYPE, CONSIDER THE
034880*    SPELLING NOT FOUND, SINCE IT IS AN INTERNAL UNIQUE ITEM
034900*    WHOSE SPELLING IS KEPT THE SAME AS ITS MATE SO THAT RDICT
034920*    CAN COPY THE CHARACTERISTICS FROM ITS MATE.
034940     IF D-TYPEV (DX) = TYPE-PRIOR-SUMMARY
034960        SET DX DOWN BY 1  GO TO DID1.
034980*    IF THE FOUND DICT ITEM IS A STATEMENT NUMBER, MAKE SURE
035000*    THAT WE ARE PROCESSING A GO TO, OTHERWISE WE HAVE NOT
035020*    FOUND WHAT WE ARE LOOKING FOR.
035040*    SIMILIARLY, IF THE FOUND DICT ITEM IS ANOTHER TYPE OF
035060*    NUMERIC VALUE, MAKE SURE WE ARE NOT HUNTING FOR A
035080*    GO TO STATEMENT NUMBER.
035100     IF V = V-GOTO AND D-TYPEV (DX) NOT EQUAL TO TYPE-GOTO
035120        SET DX DOWN BY 1  GO TO DID1.
035140     IF D-TYPEV (DX) EQUAL TYPE-GOTO
035160        AND V NOT EQUAL V-GOTO
035180        SET DX DOWN BY 1  GO TO DID1.
035200*    THE 'RECORD' ENTRY DOES NOT NEED TO BE UNIQUE-IT IS
035220*    A TEMPORARY DUMMY NAME
035240     IF WORD06 = 'RECORD' AND
035250        D-TYPEV (DX) NOT = TYPE-RECORD-NAME
035260        SET DX DOWN BY 1   GO TO DID1.
035280     IF D-TYPEV (DX) = TYPE-CONSTANT GO TO DID1B.
035282     ADD 1 TO D-NREPEATS (DX).
035284     IF D-TYPEV (DX) = TYPE-TODAY OR 
035286        D-TYPEV (DX) = TYPE-XRANDOM OR
035288        D-TYPEV (DX) = TYPE-ERROR-STATUS OR
035289        D-TYPEV (DX) = TYPE-ERROR-COUNT OR
035290        D-TYPEV (DX) = TYPE-AREA-NAME OR
035291        D-TYPEV (DX) = TYPE-AREA-IDENT OR
035292        D-TYPEV (DX) = TYPE-RECORD-NAME OR
035294        D-TYPEV (DX) = TYPE-CURR-REC-KEY
035296        GO TO DID3.
035300     IF V = V-COMPUTE
035320        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035322*    ALLOW SET TO REDEFINE  TYPE IF SPELLING STARTS WITH 
035324*    X OR ZZ--THIS CASE ARISES WHEN VARIABLE IS FIRST INTRO
035326*    DUCED BY OTHER THAN SET OR COMPUTE
035328     IF V = V-SET IF (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
035330        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035340     IF (V = V-ACCEPT OR V = V-DISPLAY)
035360        AND WORD01 = NUM-VAR-SPELLING
035380        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035400*    FOR ACCEPTED AND DISPLAY ALPHA VAR, SET NCHAR NON-ZERO
035420*    SO WONT GET ERROR IN DUP5 PARAGRAPH CHECK.
035440*    IF (V = V-ACCEPT OR V = V-DISPLAY)
035460*       AND WORD01 = ALPHA-VAR-SPELLING
035480*       MOVE 1 TO D-NCHAR (DX).
035520     IF D-TYPEV (DX) NOT EQUAL TO TYPE-FILE GO TO DID3.
035540     IF V = V-OPEN OR V = V-CREATE OR V = V-SORT OR
035560        V = V-COPY GO TO DID3.
035580*    CAN'T REFERENCE A FILE NAME EXCEPT FOR OPEN, SORT ETC
035600     GO TO E040.
035602 DID1B.
035604     SET CX TO DX.
035606     IF NUMBN NOT = C-BINARY (CX) OR
035608        SCALE NOT = C-SCALE (CX)
035610        SET DX DOWN BY 1  GO TO DID1.
035612     GO TO DID3.
035620 DID2.
035640     SET KX TO DX.
035660*    IF THIS NEW ITEM IS A SUMMARY ITEM THAT IS BEING
035680*    DEFINED NOW IE ( = ZZ) THEN RATHER THAN INSERTING
035700*    AN ENTIRE NEW ITEM, JUST STORE THE ZZ SPELLING
035720*    INTO THE VX BUCKET THAT HAS ALREADY BEEN RESERVED
035740*    FOR IT AND IS POINTED TO BY EITHER
035760*    PREV OR CURR-BUCKETDX
035780     IF FLAG-SUMMARY-DEF-TIME = 0 GO TO DID2A.
035800     IF WORD02 NOT = 'ZZ' AND WORD01 NOT = 'X'
035820        MOVE 33 TO ECODE  PERFORM E-RROR THRU E-XIT.
035840     IF PREV-BUCKETDX = 0 SET DX TO CURR-BUCKETDX
035860        ELSE SET DX TO PREV-BUCKETDX.
035880     SET KX TO DX.
035900     MOVE WORD30 TO K-ENDKEY (KX).
035920     GO TO DID3.
035940 DID2A.
035960     MOVE WORD30 TO K-ENDKEY (KX).
035980*    D-NREPEATS BELOW USED TO SEE HOW MANY TIMES VARIABLES
036000*    ARE REFERENCED-ONCE MEANS ERROR-MOST LIKELY A
036020*    MIS-SPELLED DATA ITEM.
036040     ADD 1 TO D-NREPEATS (DX).
036060     MOVE TYPE-VARIABLE TO D-TYPEV (DX).
036070     SET DX-LOWEST TO DX.
036072     IF V = V-COMPUTE
036074        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036080     IF TYPEV = TYPE-TODAY MOVE TYPEV TO D-TYPEV (DX)
036090        GO TO DID3.
036100     IF TYPEV = TYPE-XRANDOM MOVE TYPEV TO D-TYPEV (DX)
036101        GO TO DID3.
036122     IF WORD30 = 'AREA-NAME '
036123        MOVE TYPE-AREA-NAME TO D-TYPEV (DX).
036124     IF WORD30 = 'AREA-ID '
036125        MOVE TYPE-AREA-IDENT TO D-TYPEV (DX).
036126     IF WORD30 = 'RECORD-NAME '
036128        MOVE TYPE-RECORD-NAME TO D-TYPEV (DX).
036130     IF WORD30 = 'CURRENT-RECORD-KEY'
036132        MOVE TYPE-CURR-REC-KEY TO D-TYPEV (DX).
036134     IF WORD30 = 'ERROR-COUNT ' 
036136        MOVE TYPE-ERROR-COUNT TO D-TYPEV (DX).
036137     IF WORD30 = 'ERROR-STATUS '
036138        MOVE TYPE-ERROR-STATUS TO D-TYPEV (DX).
036180*    ALLOW SET TO DEFINE NUM-VAR IF SPELLING STARTS WITH 'X'/'ZZ'.
036200     IF V = V-SET  IF (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
036220        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036240     IF (V = V-ACCEPT OR V = V-DISPLAY)
036260        AND (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
036280        MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036300*    FOR ACCEPT OR DISPLAY DEFINED ALPHA VAR, SET
036320*    NCHAR NON-ZERO SO WONT GET ERROR IN DUP5 PARAGRAPH TEST.
036340*    IF (V = V-ACCEPT OR V = V-DISPLAY)
036360*       AND WORD01 = ALPHA-VAR-SPELLING
036380*       MOVE 1 TO D-NCHAR (DX).
036400     IF FLAG-ALPHA = 1 GO TO DID3.
036420*    HERE FOR NUMERICS, SET NC,SCALE VALUES AS SET BY GET-WORD
036440     IF V = V-GOTO MOVE TYPE-GOTO TO D-TYPEV (DX)
036460        GO TO DID3.
036480     SET CX TO DX.
036500     MOVE TYPE-CONSTANT TO D-TYPEV (DX).
036520*    VALUES BELOW GOTTEN BY GET-WORD.
036540     MOVE NCHAR TO C-NCHAR (CX).
036560     MOVE SCALE TO C-SCALE (CX).
036580     MOVE NUMBN TO C-BINARY (CX).
036600 DID3.
036620     MOVE D-TYPEV (DX) TO TYPEV.
036640 DIDX.    EXIT.
036660 DROP-IN-VERB.
036680     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
036700     IF FLAG-EOS = 1 MOVE ZERO TO FLAG-EOS
036720        MOVE ZERO TO FLAG-IF  
036740        SET X UP BY 1 MOVE V-EOS TO INSTR (X).
036760     SET X UP BY 1. MOVE V TO INSTR (X).
036780     MOVE 1 TO FLAG-VERB.
036800 DIVX.    EXIT.
036820 GET-WORD.
036840     MOVE ZERO TO FLAG-ALPHA FLAG-SIGN FLAG-STATEMENT-NO.
036860     MOVE ZEROS TO FLAG-EOS2. MOVE ZERO TO FLAG-DECIMAL.
036880     MOVE ZEROS TO FLAG-BAD-CHAR.
036900     MOVE ZEROS TO NUMBN. MOVE ZEROS TO SCALE.
036920     SET W TO ZEROS. MOVE SPACE TO WORD-TABLE.
036940     SET L UP BY 1. IF L > 80 GO TO GET-QUERY.
036960     MOVE LINEX (L) TO CHAR.
036980     IF CHAR = "'" MOVE 1 TO FLAG-QUOTE 
036990        move 0 to flag-all-blank-line  go to get-wordx.
037000     IF CHAR = '"' MOVE 2 TO FLAG-QUOTE 
037010        move 0 to flag-all-blank-line  go to get-wordx.
037020     IF TEST-QUOTE NOT EQUAL TO ZERO GO TO GET-WORDX.
037040     IF CHAR = SPACE GO TO GET-WORD.
037042*    are we introducing a comment? if so, get next query line.
037044     if char ='*' and flag-all-blank-line = 1 go to get-query.
037046     move 0 to flag-all-blank-line.
037060     MOVE SPACE TO LCHAR.
037080     IF CHAR = ',' GO TO GET-WORD.
037100     IF CHAR = ';' MOVE V-CONCAT TO NUMBN GO TO GET-WORDX.
037120 GET-WORD1.
037140     MOVE W TO NCHAR.
037160     MOVE LINEX (L) TO CHAR.
037180     IF CHAR = "'" MOVE 1 TO FLAG-QUOTE GO TO GET-WORDX.
037200     IF CHAR = '"' MOVE 2 TO FLAG-QUOTE GO TO GET-WORDX.
037220     IF TEST-QUOTE NOT EQUAL TO ZERO GO TO GET-WORDX.
037240     IF CHAR = SPACE GO TO GET-WORDN.
037260     IF LCHAR = '*' SET L TO L-MAX GO TO GET-WORDN.
037280     IF CHAR = ',' GO TO GET-WORDN.
037300     IF CHAR = ';' SET L DOWN BY 1 GO TO GET-WORDN.
037302     IF CHAR = '$' IF ECODE NOT = 0 GO TO GET-RDOVRX.
037304     IF CHAR = '.' IF ECODE NOT = 0 GO TO GET-WORD3.
037306 GET-WORD1A.
037320     IF CHAR = '.' AND FLAG-DECIMAL = ZERO AND FLAG-ALPHA = ZERO
037340        MOVE 1 TO FLAG-DECIMAL GO TO GET-WORD2.
037360     IF CHAR = '.' AND W > ZEROS
037380        MOVE 1 TO FLAG-EOS2 GO TO GET-WORDN.
037400     IF CHAR = '$' AND W > ZEROS
037420        MOVE 1 TO FLAG-EOS2 GO TO GET-WORDN.
037440     IF CHAR = '.' MOVE 1 TO FLAG-EOS GO TO GET-WORDN.
037460     IF CHAR = '$' MOVE 1 TO FLAG-EOS GO TO GET-WORDN.
037520     IF CHAR < '0' OR CHAR > '9' MOVE 1 TO FLAG-ALPHA.
037540*    IF CHAR < '0' OR CHAR > 'Z' MOVE 1 TO FLAG-BAD-CHAR.
037560*    IF CHAR > '9' AND CHAR < 'A' MOVE 1 TO FLAG-BAD-CHAR.
037580     IF FLAG-DECIMAL = 1 AND FLAG-ALPHA = ZERO
037600        ADD 1 TO SCALE.
037620     IF L > 3 AND W = 1 AND LCHAR = '-' AND CHAR IS NUMERIC
037640        SET W TO ZEROS
037660        MOVE ZERO TO FLAG-ALPHA MOVE 1 TO FLAG-SIGN.
037680     IF L > 3 AND W = 1 AND LCHAR = '+' AND CHAR IS NUMERIC
037700        SET W TO ZERO MOVE ZERO TO FLAG-ALPHA.
037720     SET W UP BY 1. IF W > 30 MOVE 031 TO ECODE
037740                    PERFORM E-RROR THRU E-XIT SET W TO 1.
037760     MOVE CHAR TO WORDX (W).
037780     MOVE CHAR TO LCHAR.
037800     IF L = 2 AND FLAG-ALPHA = ZERO
037820        MOVE 1 TO FLAG-STATEMENT-NO GO TO GET-WORDN.
037840 GET-WORD2.
037860     SET L UP BY 1. IF L > 80 GO TO GET-WORDN.
037880     GO TO GET-WORD1.
037882 GET-WORD3.
037883*    HERE WHEN FOUND DEC/PERIOD DURING ERROR CONDITION--EXIT NOW
037884*    IF THIS IS A PERIOD(EOS), NOT WITHIN A LITERAL.
037886     IF FLAG-ALPHA = 1 GO TO GET-RDOVRX.
037887*    IF ONLY HAVE HIT NUMERICS SO FAR, BUT HAVE ALSO HIT A .
037888*    PREVIOUSLY, THEN THIS 2ND . MUST BE A PERIOD(EOS).
037890     IF FLAG-DECIMAL = 1 GO TO GET-RDOVRX.
037891     GO TO GET-PEEK.
037918 GET-QUERY.
037920     IF V = 1 GO TO GET-WORDX.
037940     READ QCSTMT AT END MOVE 1 TO V GO TO GET-WORDX.
037960     MOVE QCSTMT-REC TO LINE-TABLE.
037980     IF FLAG-LIST = 1 DISPLAY QCSTMT-REC UPON CONSOLE.
038000     IF FLAG-LIST NOT EQUAL TO 1 MOVE ZERO TO FLAG-LIST.
038020     SET L TO ZEROS.
038030     move 1 to flag-all-blank-line.
038040     GO TO GET-WORD.
038042 GET-PEEK.
038044     IF L = 80 GO TO GET-RDOVRX.
038046     SET L UP BY 1.
038048     IF LINEX (L) = SPACE SET L DOWN BY 1 GO TO GET-RDOVRX.
038050     SET L DOWN BY 1.
038052     GO TO GET-WORD1A.
038051 GET-RDOVRX.
038052     MOVE 2 TO FLAG-EOS2.
038054     GO TO GET-WORDX.
038060************************************
038080*                FLAG-EOS FLAG-EOS2
038100*    $VERB          1        0
038120*    $ VERB         1        0
038140*    VERB$          1        1
038160*    VERB $         0        0
038180*    $ VERB $       1        0
038200*    $ VERB$        1        2
038220*    $VERB$         1        2
038240************************************
038260 GET-WORDN.
038280     IF V = V-GOTO AND FLAG-IF = 1
038300        AND FLAG-DECIMAL = 1 AND SCALE = 0
038320        MOVE 1 TO FLAG-EOS  MOVE 1 TO FLAG-EOS2
038340        MOVE ZERO TO FLAG-IF
038360        GO TO GET-WORDN1.
038380*    ABOVE BUGGED OUT FOR GO TO NN. WITHIN AN IF STATEMENT
038400     IF FLAG-DECIMAL = 1 AND SCALE = ZEROS
038420        AND V NOT EQUAL TO V-IF
038440           MOVE 1 TO FLAG-EOS MOVE 1 TO FLAG-EOS2.
038460     IF FLAG-EOS = 1 AND FLAG-EOS2 = 1
038480        MOVE 2 TO FLAG-EOS2.
038500     IF FLAG-EOS2 = 1 MOVE 1 TO FLAG-EOS.
038510     IF FLAG-EOS > 0 IF V = V-FIND-DBMS MOVE 1 TO FLAG-FINDFINI.
038520 GET-WORDN1.
038540     IF FLAG-EOS2 NOT EQUAL TO ZERO MOVE ZERO TO FLAG-IF.
038560     IF WORD30 = SPACE GO TO GET-WORD.
038580     if word06 = 'HELD '
038600        move '"hold" or "held-name" ' to word30  go to e048.
038660     IF FLAG-BAD-CHAR = 1 MOVE 007 TO ECODE
038680        PERFORM E-RROR THRU E-XIT GO TO GET-WORD.
038700     IF FLAG-ALPHA = 1 GO TO GET-WORDX.
038720     SET W TO 30. SET N TO 18.
038740     MOVE ZEROS TO NUMBN.
038760 GET-SHIFT.
038780*    IF HAVE NUMERIC, COME HERE AND TRANSFER LEFT JUSTIFIED
038800*    WORD30 TO RIGHT JUSTIFIED NUMBN.
038820     IF WORDX (W) NOT EQUAL TO SPACE GO TO GET-SHIFT1.
038840     SET W DOWN BY 1.
038860     IF W < 1 GO TO GET-WORDX.
038880     GO TO GET-SHIFT.
038900 GET-SHIFT1.
038920     MOVE WORDX (W) TO NUMBX (N).
038940     SET W DOWN BY 1. IF W < 1 GO TO GET-SHIFT2.
038960     SET N DOWN BY 1. IF N < 1 GO TO GET-SHIFT2.
038980     GO TO GET-SHIFT1.
039000 GET-SHIFT2.
039020     IF FLAG-STATEMENT-NO = 1 OR V = V-GOTO GO TO GET-WORDX.
039040     IF FLAG-SIGN = 1 MULTIPLY NUMBN BY -1 GIVING NUMBN.
039060*    MOVE NUMBER-TABLE TO WORD-TABLE.
039080 GET-WORDX.   EXIT.
039100 GET-TITLE.
039120*    GET TITLE FOR SUMMARIES AND VARIABLES=DATA NAME
039140*    SPELLING DURING SECOND PASS.
039160     EXAMINE WORD30 TALLYING ALL '-'.
039180     SET W TO 1. SET T TO ZEROS. MOVE ZEROS TO TCHAR.
039200     MOVE 10 TO TMAX. MOVE SPACE TO TITLE-TABLE.
039220 GET-TITLES.
039240     IF TALLY = ZEROS GO TO GET-TITLE2.
039260     IF TALLY = 1 GO TO GET-TITLE1.
039280     SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039300     IF WORDX (W) = '-' SET W UP BY 1 SUBTRACT 1 FROM TALLY.
039320     GO TO GET-TITLES.
039340 GET-TITLE1.
039360     SET T UP BY 1. IF T > TMAX GO TO GET-TITLE2.
039380     MOVE WORDX (W) TO TITLEX (T).
039400     SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039420     IF WORDX (W) = SPACE GO TO GET-TITLE2.
039440     IF WORDX (W) NOT EQUAL TO '-' GO TO GET-TITLE1.
039460     SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039480 GET-TITLE2.
039500     IF T > 10 SUBTRACT 10 FROM T.
039520     IF T > 10 MOVE 10 TO T.
039540     IF T > TCHAR MOVE T TO TCHAR.
039560     IF TMAX = 10 MOVE 20 TO TMAX SET T TO 10
039580        GO TO GET-TITLE1.
039600     IF TITLEX (2) = SPACE MOVE SPACE TO TITLEX (1).
039620 GET-TITLEX.    EXIT.
039640 CHECK-NUMERIC.
039660*    THIS ROUTINE CHECKS TO SEE IF TYPE IS NUMERIC
039680*    THIS ROUTINE IS INCOMPLETE
039700     IF D-TYPEV (DX) = TYPE-ALPHA MOVE 002 TO ECODE.  
039720 CHECK-NUMERICX.  EXIT.
039740 READ-DICT.
039760     ADD 1 TO NFILES.
039780     IF NFILES > N-INPUTFILES GO TO RDICT-XD1.
039800*    FX-PRIMARY FX-SECONDARY FX-TERTIARY SET BY OPEN1 TO
039820*    POINT TO APPROPRIATE DICT ENTRY FOR FD INFO
039840     IF NFILES = 1 SET FX TO FX-PRIMARY.
039860     IF NFILES = 2 SET FX TO FX-SECONDARY.
039880     IF NFILES = 3 SET FX TO FX-TERTIARY.
039900     IF FX = 1 GO TO RDICTX.
039920*    FX = 1 IFF NO OPEN STATEMENT
039940     MOVE ZEROS TO FLAG-FD-FOUND FLAG-DEV-LBL-PPN.
039960     SET LX TO FX. SET LX DOWN BY 1.
039980*    NCHAR(LX) POINTS TO FX WHEN LX ENTRY CONTAINS DEV LIT
040000     IF L-NCHAR (LX) = FX MOVE 1 TO FLAG-DEV-LBL-PPN.
040020     OPEN INPUT QPDICT.
040040 RDICT.
040060     READ QPDICT AT END GO TO RDICT-XD.
040080     MOVE QPDICT-REC TO FD-AREA.
040100     IF FD-IDNT = 'FD' GO TO RDICT-FD.
040120     IF FD-IDNT = 'FE' GO TO RDICT-FD.
040140     IF FLAG-FD-FOUND = ZERO GO TO RDICT.
040160     IF FD-IDNT = 'KD' GO TO RDICT-DD.
040180     IF FD-IDNT = 'DD' GO TO RDICT-DD.
040200     IF FD-IDNT = 'AD' GO TO RDICT-AD.
040220     IF FD-IDNT = 'RD' GO TO RDICT-RD.
040240     IF FD-IDNT = 'SD' GO TO RDICT-SD.
040260     IF FD-IDNT NOT = 'PD' GO TO RDICT.
040280*    NOW STORE ALL PD INFO INTO PD TABLE AND MARK WHERE
040300*    THIS BEGINS WITHIN THE INSTR TABLE.
040320     MOVE FD-AREA TO PD-AREA.
040340     SUBTRACT 1 FROM DX-LOWEST.
040360     SET FPX TO DX-LOWEST.
040380     IF FLAG-FIRST-PD = 0
040400        MOVE 1 TO FLAG-FIRST-PD  SET PD-POINTER TO FPX.
040420     PERFORM PW-UNSCRAMBLE THRU PW-UNSCRAMBLE-EXIT.
040440     MOVE PW-WORKER7 TO P-DYNPASSWORD (FPX).
040460     MOVE PD-REF-NO TO P-DYNREFNO (FPX).
040480     MOVE TYPE-PD TO P-TYPEV (FPX).
040500     ADD 1 TO N-PD.
040520     GO TO RDICT.
040540 RDICT-FD.
040560     IF FLAG-FD-FOUND = 1 GO TO RDICT-XD.
040580     MOVE FD-NAME TO WORD30 HOLD-FD-NAME.
040600     SET KX TO FX.
040620*    IS THE DICT FD THAT WE JUST READ = TO THE DICT WE ARE
040640*    LOOKING FOR, IE THE PRIMARY, SECONDARY, OR TERTIARY AS
040660*    DETERMINED BY PARA READ-DICT?
040680     IF WORD30 NOT EQUAL TO K-ENDKEY (KX) GO TO RDICT.
040700     MOVE 1 TO FLAG-FD-FOUND.
040720*    SEE IF HAVE SPECIAL FILE SPECIFICATION FORMAT.
040740     IF FD-IDNT = 'FE' GO TO RDICT-FE.
040760     IF FD-FILETYPE = TYPE-DBMS GO TO RDICT-FD2.
040780*    F-ID GETS INITIALIZED TO INFILE.EXT
040800     MOVE FD-INLABEL TO F-ID (FX).
040820*    MOVE FD-PPN     TO PPN-WORK.
040840*    PERFORM PPN-RTN THRU PPN-EXIT.
040860*    MOVE PPN        TO F-PPN (FX).
040880     MOVE ZEROES     TO F-PPN (FX).
040890     MOVE 'I' TO F-OPENIO (FX).
040900 RDICT-FD1.
040920     IF F-DEVICE (FX) = SPACE MOVE 'DSK' TO F-DEVICE (FX).
040940 RDICT-FD2.
040960*    ADD 20 TO FILE TYPE TO DISTINGUISH FROM DATA TYPE
040980     MOVE FD-FILETYPE TO TYPEV. ADD 20 TO TYPEV.
041000     MOVE TYPEV TO F-TYPEV (FX).
041020     MOVE TYPEV TO FILETYPE.
041040*    SET PRIMARY-LENGTH     = RECSIZE OF MASTER FILE
041060*        SECONDARY-LENGTH   = RECSIZE OF SECONDARY FILE
041080*        TERTIARY-LENGTH    = RECSIZE OF TERTIARY FILE.
041100*    SET PRIMARY-ORIGIN     = 1
041120*        SECONDARY-ORIGIN   = PRIMARY-LENGTH
041140*        TERTIARY-ORIGIN    = SECONDARY ORIG + SECOND LEN
041160*    SET FCHAR = MAX(PRIM,SEC,TERT ORIGIN) - 1
041180*    ADJUST RECSIZE TO BE MULTIPLE OF 6 OR 7
041200     IF FILETYPE = TYPE-FILE-SIXBIT AND FD-BLKSIZE = ZEROS
041220        PERFORM ADJUST-SIXBIT THRU ADJUST-SIXT.
041240     IF FILETYPE = TYPE-FILE-ASCII AND FD-BLKSIZE = ZEROS
041260        PERFORM ADJUST-ASCII THRU ADJUST-ASCIXT.
041280     MOVE FD-RECSIZE TO F-RECLEN (FX).
041300     IF NFILES = 1 MOVE FD-RECSIZE TO PRIMARY-LENGTH
041320        MOVE CONST1 TO PRIMARY-ORIGIN
041340        MOVE PRIMARY-ORIGIN TO FCHAR.
041360     IF NFILES = 2 MOVE FD-RECSIZE TO SECONDARY-LENGTH
041380        ADD PRIMARY-ORIGIN PRIMARY-LENGTH
041400            GIVING SECONDARY-ORIGIN
041420        MOVE SECONDARY-ORIGIN TO FCHAR.
041440     IF NFILES = 3 MOVE FD-RECSIZE TO TERTIARY-LENGTH
041460        ADD SECONDARY-ORIGIN SECONDARY-LENGTH
041480            GIVING TERTIARY-ORIGIN
041500        MOVE TERTIARY-ORIGIN TO FCHAR.
041520*    MOVE FCHAR TO F-ORIGIN (FX).
041540     MOVE 1 TO F-ORIGIN (FX).
041560     SUBTRACT 1 FROM FCHAR.
041580*    FCHAR IS NOW ALL SET FOR THE DD'S WHICH IMMEDIATELY FOLLOW
041600*    THIS FD--ONLY A SPELLING MATCH BETWEEN THE DD'S IN DICT(UP
041620*    TO THE NEXT FD IN THE DICT) AND THE DD'S IN THE DYNAMIC DICT
041640*    WILL BE ASSUMED TO BE IN THE FD(AND THEREFORE THE FCHAR) FOR
041660*    WHICH WE JUST PROCESSED.
041680     IF FD-BLKSIZE < ZEROS
041700        MULTIPLY FD-BLKSIZE BY MINUS-ONE GIVING FD-BLKSIZE
041720        MULTIPLY FD-BLKSIZE BY FD-RECSIZE GIVING FD-BLKSIZE-L
041722        DIVIDE FD-RECSIZE INTO FD-BLKSIZE-L GIVING FD-BLKSIZE
041724        ELSE
041740     IF FD-BLKSIZE NOT EQUAL TO ZEROS
041760        AND FD-BLKSIZE NOT LESS THAN FD-RECSIZE
041780        DIVIDE FD-RECSIZE INTO FD-BLKSIZE GIVING FD-BLKSIZE.
041800     MOVE FD-BLKSIZE TO F-BLKLEN (FX).
041820     IF FILETYPE = TYPE-FILE-DBMS
041840        SET BX TO FX
041860        MOVE FD-NAME TO B-SUBSCHEMA (BX)
041880        MOVE FD-DBMS-LABEL TO B-SCHEMA (BX)
041900        MOVE FIRST-PASSWORD TO B-PASSWORD (BX)
041920        GO TO RDICT-FD3.
041940     IF FLAG-DEV-LBL-PPN = 1
041960        MOVE L-VALUE (LX) TO QUOTE-TABLE
041980        PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
042000     MOVE FD-KEYPOS  TO F-KEYLOC (FX).
042020     MOVE FD-KEYLEN  TO F-KEYLEN (FX).
042040     MOVE FD-KEYTYPE TO F-KEYTYPE (FX).
042060     MOVE FD-KEYSIGN TO F-KEYSIGN (FX).
042080 RDICT-FD3.
042100*    SAVE FILE PROTECTION INFO FOR LATER TESTS WHEN PD
042120*    IS AVAILABLE.
042140     MOVE FD-PROTECT TO FD-PROT (NFILES).
042160     MOVE FD-READ-PROTECT TO FD-RPROT (NFILES).
042180     MOVE FD-COPY-PROTECT TO FD-CPROT (NFILES).
042200     MOVE FD-REWRITE-PROTECT TO FD-REWPROT (NFILES).
042220     MOVE HOLD-FD-NAME TO FD-NAMEPROT (NFILES).
042240*    NOW CONVERT PROG # AND USER # TO OCTAL
042260     ENTER MACRO IQDCOC USING PROJ10,PROJ8.
042280     ENTER MACRO IQDCOC USING USER10,USER8.
042282     IF FILETYPE = TYPE-FILE-DBMS  IF FLAG-FIND = 0
042284        MOVE 047 TO ECODE  PERFORM E-RROR THRU E-XIT.
042300     IF FILETYPE = TYPE-FILE-DBMS AND NFILES = 1
042320        MOVE 1 TO FLAG-RANDOM-READ1  GO TO RDICT.
042340     MOVE F-DEVICE (FX) TO DEVICER.
042360*    ENTER MACRO IQLOOK USING
042380*       DEVICER,FD-INLABEL,PROJ8,USER8,I.
042400*    IF I = -1 GO TO RDICT.
042420*    MOVE ZEROS TO PROJ8,USER8.
042440*    ENTER MACRO IQLOOK USING
042460*       DEVICER,FD-INLABEL,PROJ8,USER8,I.
042480*    IF I = -1 GO TO RDICT.
042500*    MOVE 009 TO ECODE.
042520*    PERFORM E-RROR THRU E-XIT.
042540*    NOW READ DD'S ASSOCIATED WITH THE FD WE JUST PROCESSED
042560*    AND SET FCHAR FOR.
042580     GO TO RDICT.
042600 RDICT-FE.
042620*    HERE FOR SPECIAL FILE-DEVICE SPECIFICATIONS
042640*    IF DEC-20: FE-FILESPEC=DEVICE:<DIR>FILE.EXT
042660*    IF DEC-10: FE-FILESPEC=DEVICE:FILE.EXT[PROJ,USER]
042680     MOVE FE-NAME            TO FD-NAME.
042700     MOVE FE-FILESPEC        TO QUOTE-TABLE.
042720     PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
042740     MOVE FE-FILETYPE        TO FD-FILETYPE.
042760     MOVE FE-RECSIZE         TO FD-RECSIZE.
042780     MOVE FE-BLKSIZE         TO FD-BLKSIZE.
042800     MOVE FE-KEYPOS          TO FD-KEYPOS.
042820     MOVE FE-KEYLEN          TO FD-KEYLEN.
042840     MOVE FE-KEYTYPE         TO FD-KEYTYPE.
042860     MOVE FE-KEYSIGN         TO FD-KEYSIGN.
042880     MOVE FE-PROTECT         TO FD-PROTECT.
042900     MOVE FE-PROTECT-READ    TO FD-READ-PROTECT.
042920     MOVE FE-PROTECT-COPY    TO FD-COPY-PROTECT.
042940     MOVE FE-PROTECT-REWRITE TO FD-REWRITE-PROTECT.
042960     GO TO RDICT-FD1.
042980 ADJUST-SIXBIT.
043000     DIVIDE FD-RECSIZE BY 6 GIVING REMAINER.
043020     IF R1 = 1 ADD 5 TO FD-RECSIZE.
043040     IF R1 = 3 ADD 4 TO FD-RECSIZE.
043060     IF R1 = 5 ADD 3 TO FD-RECSIZE.
043080     IF R1 = 6 ADD 2 TO FD-RECSIZE.
043100     IF R1 = 8 ADD 1 TO FD-RECSIZE.
043120 ADJUST-SIXT.    EXIT.
043140 ADJUST-ASCII.
043160     DIVIDE FD-RECSIZE BY 7 GIVING REMAINER.
043180     IF R1 = 1 ADD 6 TO FD-RECSIZE.
043200     IF R1 = 2 ADD 5 TO FD-RECSIZE.
043220     IF R1 = 4 ADD 4 TO FD-RECSIZE.
043240     IF R1 = 5 ADD 3 TO FD-RECSIZE.
043260     IF R1 = 7 ADD 2 TO FD-RECSIZE.
043280     IF R1 = 8 ADD 1 TO FD-RECSIZE.
043300 ADJUST-ASCIXT.    EXIT.
043320 RDICT-DD.
043340     MOVE QPDICT-REC TO DD-AREA.
043360     MOVE ZERO TO FLAG-DD-FOUND.
043380     MOVE DD-NAME TO WORD30.
043400*    SEE IF DICT ITEM IS REFERENCED BY QUERY, RATHER THAN
043420*    SEEING IF REFERENCED ITEM IS IN DICTIONARY
043440     PERFORM LOOK-IN-DX THRU LIDX.
043460     IF DX < DX-LOWEST GO TO RDICT-DD1.
043480*    HERE IF FOUND ITEM.
043500     GO TO RDICT-DD5.
043520 RDICT-DD1.
043540     MOVE 1 TO FLAG-DD-FOUND.
043560     MOVE HOLD-FD-NAME TO WORD30.
043580     SET DD TO ZEROS. SET W TO ZEROS.
043600 RDICT-DD2.
043620*    APPEND A DASH(-) AT END OF FILE NAME
043640     SET W UP BY 1. IF W > 30 GO TO RDICT.
043660     MOVE WORDX (W) TO CHAR.
043680     IF CHAR = SPACE MOVE '-' TO WORDX (W)
043700        GO TO RDICT-DD3.
043720     GO TO RDICT-DD2.
043740 RDICT-DD3.
043760*    APPEND DATA NAME TO FILENAME-(IE FILENAME-DATANAME)
043780     SET DD UP BY 1. IF DD > 30 GO TO RDICT-DD4.
043800     MOVE DD-NAMEX (DD) TO CHAR.
043820     IF CHAR = SPACE GO TO RDICT-DD4.
043840     SET W UP BY 1. IF W > 30 GO TO RDICT-DD4.
043860     MOVE CHAR TO WORDX (W).
043880     GO TO RDICT-DD3.
043900 RDICT-DD4.
043920*    SEE IF ITEM IS IN DICT AS FILENAME-DATANAME
043940     PERFORM LOOK-IN-DX THRU LIDX.
043960     IF DX < DX-LOWEST GO TO RDICT.
043980 RDICT-DD5.
044000*    CHECK TO SEE IF ITEM IS PROTECTED BY PASSWORDS
044020     MOVE DD-REF-NO TO TEST-REF-NO.
044040     MOVE DD-PROTEXCL TO TEST-PROTEXCL.
044044     MOVE PW-POINTER TO PW-LIST.
044046     MOVE N-PASSWORDS TO N-PW.
044060     PERFORM UNLOCKER THRU UNLOCKER-EXIT.
044080     IF FLAG-LOCKED NOT = 1 GO TO RDICT-DD7.
044106*    HERE IF USER DID NOT FURNISH PROPER PASSWORDS VIA AUTHORITY
044107*    GET ADDITIONAL ONES VIA PROMPTING
044108     MOVE 'DATA ITEMS' TO ITEM-OR-FILE.
044109     IF FLAG-PW-ITEM = 0
044110        MOVE 1 TO FLAG-PW-ITEM
044111        PERFORM PASSWORD-PROMPTER THRU PROMPTX.
044112     IF N-PROMPTS = 0   GO TO RDICT-DD6.
044113     MOVE PROMPT-PW-POINTER TO PW-LIST.
044114     MOVE N-PROMPTS TO N-PW.
044115     PERFORM UNLOCKER THRU UNLOCKER-EXIT.
044116     IF FLAG-LOCKED NOT = 1 GO TO RDICT-DD7.
044117 RDICT-DD6.
044118     MOVE 14 TO ECODE. PERFORM E-RROR THRU E-XIT.
044119 RDICT-DD7.
044120     MOVE DD-TITLE1  TO D-TITLE1 (DX).
044140     MOVE DD-TITLE2  TO D-TITLE2 (DX).
044160     MOVE DD-PICT    TO D-PICT (DX).
044180     MOVE DD-GRPLEN  TO D-GRPLEN (DX).
044200     MOVE DD-GRPNAME TO D-GRPNAME (DX).
044220     MOVE DD-STOPV   TO D-STOPV (DX).
044240*    IF HAVE PRIOR-SUMMARY ITEM, PRESERVE BOTH THE FACT THAT
044260*    WE HAVE A PRIOR-SUMMARY ITEM AND THE TYPE OF ITS FATHER.
044280     IF D-TYPEV (DX) = TYPE-PRIOR-SUMMARY
044300        ADD DD-TYPEV  50  GIVING D-TYPEV (DX)
044320        ELSE
044340        MOVE DD-TYPEV   TO D-TYPEV (DX).
044360     MOVE DD-NCHAR   TO D-NCHAR (DX).
044380     MOVE DD-SCALE   TO D-SCALE (DX).
044400     MOVE DD-ECHAR   TO D-ECHAR (DX).
044420     MOVE DD-TCHAR   TO D-TCHAR (DX).
044440*    FCHAR = F(PRIMARY,SECONDARY,TERTIARY)
044460*    MODIFY FCHAR DEPENDING ON WHICH FILE ITEM IS IN
044480     ADD FCHAR       TO DD-FCHAR.
044500     MOVE DD-FCHAR   TO D-FCHAR (DX).
044502     IF FILETYPE NOT = 28 GO TO RDICT-DD8.
044504*    *HERE IF PROCESSING DBMS; USE NREPEATS TO MARK
044506*    * TYPE OF LATEST RECORD
044508     IF LATEST-RECTYPE = 7 GO TO RDICT-DD8.
044510*    *USE NREPEATS < 0 TO FLAG ITEM IN SIXBIT RECORD
044512     IF DD-NREPEATS > 0
044514         SUBTRACT DD-NREPEATS FROM 0 GIVING DD-NREPEATS
044516             ELSE MOVE -1 TO DD-NREPEATS.
044518 RDICT-DD8.
044520     MOVE DD-NREPEATS TO D-NREPEATS (DX).
044540*    NOW SEE IF SAME ITEM IS THERE AGAIN-POSSIBLE FOR PRIOR
044560*    SUMMARY TYPES.
044580     MOVE 1 TO FLAG-CONTINUE.
044600     PERFORM LOOK-IN-DX THRU LIDX.
044620     IF DX < DX-LOWEST
044640        MOVE 0 TO FLAG-CONTINUE ELSE GO TO RDICT-DD5.
044660     IF FLAG-DD-FOUND = ZERO GO TO RDICT-DD1.
044680     GO TO RDICT.
044700 RDICT-AD.
044720     MOVE QPDICT-REC TO AD-AREA.
044740     MOVE AD-NAME TO WORD30.
044760     PERFORM LOOK-IN-DX THRU LIDX.
044780     IF DX < DX-LOWEST GO TO RDICT.
044800     SET RX TO DX.
044820     IF R-AREA-SET (RX) NOT EQUAL TO V-FINDAREA
044840        MOVE R-ENDKEY (RX) TO WORD30
044850        MOVE 013 TO ECODE  PERFORM E-RROR THRU E-XIT.
044860     MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
044880     MOVE AD-ORIGIN TO R-FCHAR (RX).
044900     MOVE AD-AREA-NO   TO R-SCALE (RX).
044920     MOVE AD-LENGTH TO R-NCHAR (RX).
044940     GO TO RDICT.
044960 RDICT-RD.
044980     MOVE QPDICT-REC TO RD-AREA.
045000     MOVE RD-NAME TO WORD30.
045010     MOVE RD-ORIGIN TO FCHAR. SUBTRACT 1 FROM FCHAR.
045011     MOVE RD-RECNO TO LATEST-RECTYPE.
045012     IF LATEST-RECTYPE NOT = 6 AND LATEST-RECTYPE NOT = 7
045013         DISPLAY " %RECORD TYPE IS NOT 6 OR 7; ASSUMING 7"
045014         DISPLAY "  PLEASE CORRECT REC TYPES IN DICTIONARY"
045015         MOVE 7 TO LATEST-RECTYPE.
045020     PERFORM LOOK-IN-DX THRU LIDX.
045040     IF DX < DX-LOWEST GO TO RDICT. 
045060     SET RX TO DX.
045080     MOVE RD-ORIGIN   TO FCHAR. SUBTRACT 1 FROM FCHAR.
045100     MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
045120     MOVE RD-ORIGIN TO R-FCHAR (RX).
045140     MOVE RD-RECNO   TO R-SCALE (RX).
045160     MOVE RD-RECNO TO R-REC-NO (RX).
045180     MOVE RD-LENGTH TO R-NCHAR (RX).
045200     GO TO RDICT.
045220 RDICT-SD.
045240     MOVE QPDICT-REC TO SD-AREA.
045260     MOVE SD-NAME TO WORD30.
045280     PERFORM LOOK-IN-DX THRU LIDX.
045300     IF DX < DX-LOWEST GO TO RDICT.
045320     SET RX TO DX.
045340     IF R-AREA-SET (RX) NOT EQUAL TO V-FINDSET
045360        MOVE R-ENDKEY (RX) TO WORD30
045370        MOVE 013 TO ECODE  PERFORM E-RROR THRU E-XIT.
045380     MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
045400     MOVE SD-ORIGIN TO R-FCHAR (RX).
045420     MOVE SD-OWNER-REC-NO TO R-SCALE (RX).
045440     MOVE SD-OWNER-REC-NO TO R-REC-NO (RX).
045460     MOVE SD-LENGTH TO R-NCHAR (RX).
045480     GO TO RDICT.
045500 RDICT-XD.
045520     CLOSE QPDICT.
045540*    DID WE SEARCH ENTIRE DICTIONARY WITHOUT A HIT?
045560     IF FLAG-FD-FOUND = 0
045580        MOVE K-ENDKEY (KX) TO WORD30
045600        GO TO E037.
045620     GO TO READ-DICT.
045640 RDICT-XD1.
045660*    SET FCHAR BEYOND ALL INPUT BUFFERS.
045680     ADD PRIMARY-LENGTH SECONDARY-LENGTH TERTIARY-LENGTH 1
045700         GIVING FCHAR.
045720 RDICTX.    EXIT.
045740 GET-DEV-LBL-PPN.
045760*    CALLED FROM RDICT-FE,CREATE2,OPEN2A TO PROCESS FILE-SPECS
045780     IF FX < 2 MOVE 1 TO FLAG-LBL-ERROR GO TO GET-DLP-ERR.
045800     SET Q TO ZEROS. MOVE ZERO TO FLAG-LBL-ERROR.
045820*    INITIALIZE DEVICE IN CASE IT IS NOT SPECIFIED
045840*    F-PPN(FX) AND FD-LABEL ALREADY INITIALIZED BY CALLER
045860     MOVE "DSK" TO F-DEVICE (FX).
045880 GET-DLP.
045900     SET W TO 1. MOVE SPACE TO WORD30.
045920 GET-DEV.
045940     SET Q UP BY 1.
045960     MOVE QUOTEX (Q) TO CHAR.
045980     IF CHAR = SPACE GO TO GET-DLP-EXIT.
046000     IF CHAR = ':' GO TO GET-DEV1.
046020     IF CHAR = '.' GO TO GET-LBL.
046040     IF CHAR = '>' GO TO GET-DIR.
046060     IF CHAR = '[' GO TO GET-EXT.
046080     IF CHAR = ',' MOVE 1 TO FLAG-LBL-ERROR.
046100     IF CHAR = ']' MOVE 1 TO FLAG-LBL-ERROR.
046120     IF CHAR = '*' MOVE 1 TO FLAG-LBL-ERROR.
046140     MOVE CHAR TO WORDX (W).
046160     SET W UP BY 1. IF W > 30 MOVE 1 TO FLAG-LBL-ERROR.
046180     IF FLAG-LBL-ERROR = 1 GO TO GET-DLP-ERR.
046200     GO TO GET-DEV.
046220 GET-DEV1.
046240*    GET HERE WHEN HIT :  ASSUME WE JUST READ DEVICE
046260     MOVE WORD06 TO F-DEVICE (FX).
046280     GO TO GET-DLP.
046300 GET-DIR.
046320     MOVE WORD30 TO F-ID (FX).
046340     GO TO GET-DLP.
046360 GET-LBL.
046380     MOVE WORD06 TO FD-INFILE.
046400*    NOW GET EXTENSION, IF SPECIFIED
046420     SET W TO 7.
046440 GET-LBL1.
046460     SET Q UP BY 1.
046480     MOVE QUOTEX (Q) TO CHAR.
046500     IF CHAR = SPACE
046520        MOVE WORD12 TO FD-LABEL  GO TO GET-DLP-EXIT.
046540     IF CHAR = "["
046560        MOVE WORD12 TO FD-LABEL  GO TO GET-EXT1.
046580     MOVE CHAR TO WORDX (W).
046600     IF W < 10
046620        SET W UP BY 1  GO TO GET-LBL1.
046640     GO TO GET-DLP-ERR.
046660 GET-EXT.
046680     MOVE WORD06 TO FD-INEXT.
046700     MOVE FD-LABEL TO F-ID (FX).
046720 GET-EXT1.
046740     SET PX TO 1. MOVE SPACE TO PPN-WORK.
046760 GET-PPN.
046780     MOVE QUOTEX (Q) TO CHAR.
046800     IF CHAR = SPACE GO TO GET-PPN2.
046820     MOVE CHAR TO PPN-CHAR (PX).
046840     SET Q UP BY 1. IF Q > 72 MOVE 1 TO FLAG-LBL-ERROR
046860                       GO TO GET-DLP-ERR.
046880     SET PX UP BY 1. IF PX > 19 MOVE 1 TO FLAG-LBL-ERROR
046900                       GO TO GET-DLP-ERR.
046920     GO TO GET-PPN.
046940 GET-PPN2.
046960     PERFORM PPN-RTN THRU PPN-EXIT.
046980*    MOVE PPN TO F-PPN (FX).
047000     MOVE ZERO TO F-PPN (FX).
047020     GO TO GET-DLP-EXIT.
047040 GET-DLP-ERR.
047060     MOVE CHAR TO WORDX (W).
047080     MOVE 032 TO ECODE. PERFORM E-RROR THRU E-XIT.
047100 GET-DLP-EXIT.    EXIT.
047120 PPN-RTN.
047140     IF PPN-WORK = SPACE GO TO PPN-ERR.
047160     EXAMINE PPN-WORK TALLYING ALL ','.
047180     IF TALLY NOT EQUAL TO 1 GO TO PPN-ERR.
047200     MOVE 000 TO ECODE.
047220     SET PX TO ZEROS.
047240 PPN0.
047260     MOVE ZEROS TO PPN-NUMBER PPN-HALF.
047280     SET PI TO 7.
047300 PPN1.
047320     SET PX UP BY 1. IF PX > 19 GO TO PPN-ERR.
047340     SET HX TO PX.
047360     IF PPN-CHAR (PX) = ',' GO TO PPN2.
047380     IF PPN-CHAR (PX) = ']' GO TO PPN4.
047400     IF PPN-CHAR (PX) = SPACE GO TO PPN4.
047420     GO TO PPN1.
047440 PPN2.
047460     SET PI DOWN BY 1. IF PI < 1 GO TO PPN3.
047480     SET PX DOWN BY 1. IF PX < 1 GO TO PPN3.
047500     SET PN TO PX.
047520     IF PPN-CHAR (PX) IS NUMERIC
047540        MOVE PPN-NUM (PN) TO PPN-DIGIT (PI).
047560     GO TO PPN2.
047580 PPN3.
047600     MOVE PPN-NUMBER TO PROJ10.
047620     PERFORM DEC-TO-BIN VARYING PI FROM 1 BY 1 UNTIL PI > 6.
047640     IF PPN-HALF > 32767 MOVE 001 TO ECODE.
047660     COMPUTE PPN = PPN-HALF * 262144.
047680     SET PX TO HX. GO TO PPN0.
047700 PPN4.
047720     SET PI DOWN BY 1. IF PI < 1 GO TO PPN5.
047740     SET PX DOWN BY 1. IF PX < 1 GO TO PPN5.
047760     SET PN TO PX.
047780     IF PPN-CHAR (PX) = ',' GO TO PPN5.
047800     IF PPN-CHAR (PX) IS NUMERIC
047820        MOVE PPN-NUM (PN) TO PPN-DIGIT (PI).
047840     GO TO PPN4.
047860 PPN5.
047880     MOVE PPN-NUMBER TO USER10.
047900     PERFORM DEC-TO-BIN VARYING PI FROM 1 BY 1 UNTIL PI > 6.
047920     COMPUTE PPN = PPN + PPN-HALF.
047940     IF ECODE NOT EQUAL TO 000 GO TO PPN-ERR.
047960     GO TO PPN-EXIT.
047980 DEC-TO-BIN.
048000     IF PPN-DIGIT (PI) = 8 OR 9 MOVE 001 TO ECODE.
048020     COMPUTE PPN-HALF = 8 * PPN-HALF + PPN-DIGIT (PI).
048040 PPN-ERR.
048060     MOVE 000 TO ECODE.
048080     MOVE ZEROS TO PPN PROJ10 USER10.
048100 PPN-EXIT.    EXIT.
048120
048140*****************************
048160* SUBROUTINE BELOW CHECKS ANY PROTECTED ITEMS TO SEE IF
048180* THEIR PASSWORD WAS FURNISHED IN AN AUTHORITY STATEMENT.
048200*****************************
048220 UNLOCKER.
048240     IF FLAG-LOCKED = 2 GO TO UNLOCKER-EXIT.
048260*     ABOVE BYPASSES PW CHECK IF UNIVERSAL PASSWORD
048280*          WAS FURNISHED**.
048300     MOVE ZERO TO FLAG-LOCKED.
048320     IF TEST-REF-NO = ZERO GO TO UNLOCKER-EXIT.
048340*    IF PW-LIST = 0, THEN NO PASSWORDS WERE FURNISHED.
048360     IF PW-LIST = 0
048380        MOVE 1 TO FLAG-LOCKED  GO TO UNLOCKER-EXIT.
048400*    SET INDEX FOR DYNAMIC PD INFO
048420     MOVE 1 TO J.  SET FPX TO PD-POINTER.
048440     IF TEST-PROTEXCL = '0' GO TO UNLOCKER1.
048460     GO TO UNLOCKER-EXCL.
048480 UNLOCKER1.
048500     IF P-DYNREFNO (FPX) NOT LESS THAN TEST-REF-NO
048520        MOVE 1 TO K  SET AX TO PW-LIST
048540        GO TO  UNLOCKER3.
048560 UNLOCKER2.
048580     ADD 1 TO J.  SET FPX DOWN BY 1.
048600     IF J IS NOT GREATER THAN N-PD GO TO UNLOCKER1.
048620     MOVE 1 TO FLAG-LOCKED.  GO TO UNLOCKER-EXIT.
048640 UNLOCKER3.
048660     IF AUTH-PASSWORD (AX) = P-DYNPASSWORD (FPX)
048680        GO TO UNLOCKER-EXIT.
048700     ADD 1 TO K. SET AX DOWN BY 1.
048720     IF K IS NOT GREATER THAN N-PW GO TO UNLOCKER3.
048740     GO TO UNLOCKER2.
048760 UNLOCKER-EXCL.
048780     IF P-DYNREFNO (FPX) = TEST-REF-NO
048800         MOVE P-DYNPASSWORD (FPX) TO EFF-PASSWORD
048820         MOVE 1 TO J   SET AX TO PW-LIST
048840         GO TO UNLOCKER-EXCL1.
048860     ADD 1 TO J.  SET FPX DOWN BY 1.
048880     IF J IS NOT GREATER THAN N-PD GO TO UNLOCKER-EXCL.
048900     MOVE 1 TO FLAG-LOCKED.
048920     GO TO UNLOCKER-EXIT.
048940 UNLOCKER-EXCL1.
048960     IF EFF-PASSWORD = AUTH-PASSWORD (AX) GO TO UNLOCKER-EXIT.
048980     ADD 1 TO J.  SET AX DOWN BY 1.
049000     IF J IS NOT GREATER THAN N-PW GO TO UNLOCKER-EXCL1.
049020     MOVE 1 TO FLAG-LOCKED.
049040 UNLOCKER-EXIT.
049060     EXIT.
049062 PASSWORD-PROMPTER.
049063     DISPLAY PROMPTER-MESSAGE UPON CONSOLE.
049064     MOVE 0 TO N-PROMPTS.
049066 PROMPT1.
049068     PERFORM CONFIDENTIAL-ASK.
049070     IF RETURNED-PASSWORD = SPACES GO TO PROMPTX.
049072     SUBTRACT 1 FROM DX-LOWEST.
049074     SET AX TO DX-LOWEST.
049076*    SET PROMPT-PW-POINTER TO FIRST PASSWORD IN THIS LIST.
049078     IF N-PROMPTS = 0   SET PROMPT-PW-POINTER TO AX.
049080     ADD 1 TO N-PROMPTS.
049082     MOVE RETURNED-PASSWORD TO AUTH-PASSWORD (AX).
049084     MOVE TYPE-AUTHORITY TO A-TYPEV (AX).
049086     IF RETURNED-PASSWORD = UNIVERSAL-PASSWORD
049088        MOVE 2 TO FLAG-LOCKED.
049090     GO TO PROMPT1.
049092 PROMPTX.
049094     EXIT.
049096************************
049100* SUBROUTINE BELOW UNSCRAMBLES PASSWORDS.
049120************************
049140 PW-UNSCRAMBLE.
049160     MOVE 1 TO K.
049180 PW-UNSCRAMBLE1.
049200     MOVE PD-CHAR (K) TO PW-CHAR (K).
049220     ADD 1 TO K.
049240     IF K IS NOT GREATER THAN 12 GO TO PW-UNSCRAMBLE1.
049260     SUBTRACT PW-MASK1 FROM PW-WORK1.
049280     SUBTRACT PW-MASK2 FROM PW-WORK2.
049300     MOVE PW-CHAR (10) TO PW7-CHAR (1).
049320     MOVE PW-CHAR (9) TO PW7-CHAR (2).
049340     MOVE PW-CHAR (6) TO PW7-CHAR (3).
049360     MOVE PW-CHAR (12) TO PW7-CHAR (4).
049380     MOVE PW-CHAR (3) TO PW7-CHAR (5).
049400     MOVE PW-CHAR (2) TO PW7-CHAR (6).
049420 PW-UNSCRAMBLE-EXIT.
049440     EXIT.
049460************************
049480 DX-CLEANUP.
049500*    SETS ALL NUMERIC AND SUMMARY-VAR TO S9(13)V9(5)
049520*    CLEARS ECHAR TCHAR SCALE FCHAR FOR ANY OTHER VAR
049540*    (IE ANYTHING ELSE EXCEPT SPECIALS LIKE XRANDOM)
049560     SET DX TO DX-MAX. SET DX UP BY 1.
049580 DUP1.
049600     SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO DUP6.
049620     MOVE D-TYPEV (DX) TO TYPEV.
049640     IF TYPEV = TYPE-VARIABLE GO TO DUP2.
049660     IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO DUP2.
049680     IF TYPEV = TYPE-SUMMARY GO TO DUP2.
049700     IF TYPEV = TYPE-AVERAGE GO TO DUP2.
049702     IF TYPEV = TYPE-PRIOR-SUMMARY GO TO DUP2.
049720     IF FLAG-PASS = 2 GO TO DUP1.
049740     IF TYPEV = TYPE-TODAY
049760        MOVE TODAY-AREA TO D-ENTRY (DX) GO TO DUP1.
049780     IF TYPEV = TYPE-XRANDOM
049800        MOVE XRANDOM-AREA TO D-ENTRY (DX) GO TO DUP1.
049802     IF TYPEV = TYPE-ERROR-STATUS
049804         MOVE ERROR-STATUS-AREA TO D-ENTRY(DX)
049806         GO TO DUP1.
049807     IF TYPEV = TYPE-AREA-IDENT
049808        MOVE AREA-IDENT-AREA TO D-ENTRY (DX)  GO TO DUP1.
049810     IF TYPEV = TYPE-RECORD-NAME
049812        MOVE RECORD-NAME-AREA TO D-ENTRY (DX)  GO TO DUP1.
049814     IF TYPEV = TYPE-AREA-NAME
049816        MOVE AREA-NAME-AREA TO D-ENTRY (DX)  GO TO DUP1.
049817     IF TYPEV = TYPE-CURR-REC-KEY
049818        MOVE CURRENT-RECORD-KEY-AREA TO D-ENTRY (DX) GO TO DUP1.
049819     IF TYPEV = TYPE-ERROR-COUNT
              MOVE ERROR-COUNT-AREA TO D-ENTRY (DX) GO TO DUP1.
049820     IF TYPEV = TYPE-CONSTANT
049840        SET CX TO DX
049860        MOVE C-BINARY (CX) TO C-NUMERIC (CX).
049880     GO TO DUP1.
049900 DUP2.
049920     SET KX TO DX. SET VX TO DX.
049940     MOVE K-ENDKEY (KX) TO WORD30.
049960     IF FLAG-PASS = 2 GO TO DUP4.
049980     IF TYPEV = TYPE-AVERAGE GO TO DUP1.
050000     MOVE ZEROS TO V-ECHAR (VX).
050020     MOVE TCHAR TO V-TCHAR (VX).
050040     MOVE ZEROS TO V-SCALE (VX).
050060     MOVE ZEROS TO D-FCHAR (DX).
050080     IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO DUP3.
050082     IF TYPEV = TYPE-PRIOR-SUMMARY GO TO DUP3A.
050100     IF TYPEV NOT EQUAL TO TYPE-SUMMARY GO TO DUP1.
050120     MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
050140 DUP3.
050160     MOVE 18 TO V-NCHAR (VX). MOVE 5 TO V-SCALE (VX).
050180     MOVE 13 TO V-ECHAR (VX).
050200     GO TO DUP1.
050201 DUP3A.
050202*    HERE FOR TYPE-PRIOR-SUMMARY WHICH CAN STILL BE
050204*    IF THE BY-ITEM IS A VARIABLE
050206     IF WORD01 = ALPHA-VAR-SPELLING
050208        MOVE TYPE-VARIABLE TO DELTA
050210        ELSE
050212        MOVE TYPE-NUMERIC-VARIABLE TO DELTA.
050214     ADD 50 DELTA GIVING D-TYPEV (DX).
050216     GO TO DUP3.
050220 DUP4.
050240*    HERE FOR VAR,NUM-VAR, AND SUMMARY AFTER 2ND PASS
050260     IF TYPEV = TYPE-AVERAGE GO TO DUP5.
050280     IF TYPEV = TYPE-SUMMARY GO TO DUP5.
050300*    ZZ ITEMS WILL BE DEFINED AS NUM-VAR AND NOT TYPE-SUMMARY
050320*    IF ZZ ITEM IS NEVER DEFINED IN SUMMARY CONTEXT IE ONLY
050340*    IN A -SET ZZ- OR -COMPUTE ZZ- CONTEXT.
050360     IF TYPEV = TYPE-NUMERIC-VARIABLE AND
050380        (WORD01 NOT = NUM-VAR-SPELLING AND WORD02 NOT = 'ZZ' AND
050382         WORD05 NOT = 'HELD-')
050400        MOVE 034 TO ECODE
050420        PERFORM E-RROR THRU E-XIT GO TO DUP1.
050440     IF TYPEV = TYPE-VARIABLE AND
050460        (WORD01 NOT = ALPHA-VAR-SPELLING AND WORD05 NOT = 'HELD-')
050480        MOVE 035 TO ECODE
050500        PERFORM E-RROR THRU E-XIT
050520        MOVE SPACES TO WORD30  MOVE 036 TO ECODE
050540        PERFORM E-RROR THRU E-XIT  GO TO DUP1.
050560     IF WORD01 = ALPHA-VAR-SPELLING OR WORD02 = 'ZZ' OR
050580        WORD01 = NUM-VAR-SPELLING OR WORD05 = 'HELD-'
050582        GO TO DUP5.
050600     MOVE 001 TO ECODE.
050620     PERFORM E-RROR THRU E-XIT.  GO TO DUP1.
050640 DUP5.
050660     PERFORM GET-TITLE THRU GET-TITLEX.
050680     MOVE TITLE1X TO V-TITLE1 (VX).
050700     MOVE TITLE2X TO V-TITLE2 (VX).
050720     MOVE TCHAR TO V-TCHAR (VX).
050740     MOVE ZEROS TO V-WORK (VX).
050760*    NOW MAKE TYPE SUMMARY SAME AS NUM-VER
050780     IF TYPEV = TYPE-SUMMARY MOVE 7 TO D-TYPEV (DX)
050800        MOVE ZEROS TO D-NREPEATS (DX)
050820        GO TO DUP1.
050840     IF TYPEV = TYPE-AVERAGE
050860        MOVE ZEROES TO D-NREPEATS (DX) GO TO DUP1.
050880*    IS ITEM UNDEFINED? THIS CAN ONLY BE FOR VAR(ALPH VAR)
050900*    SINCE NUM-VAR(VIA COMPUTE) ALWAYS HAS NCHAR = 18
050920     IF D-FCHAR (DX) = ZEROS AND D-NCHAR (DX) = ZEROS
050940        NEXT SENTENCE ELSE GO TO DUP5A.
050960*    SINCE NEVER SET THIS VARIABLE(COULD HAPPEN FOR ACCEPT AND
050962*    NO USAGE OF 'SET'), THEN ALLOCATE NOW.
050964     MOVE 12 TO D-NCHAR (DX)  D-ECHAR (DX).
050966     IF FCHAR = 0 MOVE 1 TO FCHAR.
050968     MOVE FCHAR TO D-FCHAR (DX).
050970     ADD 12 TO FCHAR.
050972 DUP5A.
050980*    IF VARIABLE HAS ONLY BEEN USED ONCE, IT IS INVALID,
051000*    SINCE IT MUST BE BOTH SET AND GOT(2 REFERENCES)
051020     IF D-NREPEATS (DX) < 2
051040        MOVE 023 TO ECODE
051060        PERFORM E-RROR THRU E-XIT.
051080     IF TYPEV = TYPE-NUMERIC-VARIABLE
051100        MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
051120     IF TYPEV = TYPE-VARIABLE
051140        MOVE SPACE TO V-PICT (VX)
051160        MOVE TYPE-ALPHA TO D-TYPEV (DX).
051180     MOVE ZEROS TO D-NREPEATS (DX).
051200     GO TO DUP1.
051220 DUP6.
051240     IF FLAG-PASS = 1 GO TO DUPX.
051260*    NOW MODIFY DATA ITEM TYPES TO ALSO INCORPORATE FILE AND
051280*    RECORDING MODE INFO--MODIFY FCHAR TO ALWAYS BE REL 1, RATHER
051300*    THAN A FUNCTION OF WHICH BUFFER(PRIM,SEC, OR TERT) THE ITEM
051320*    IS IN.--FOR DYNAMICALLY ALLOCATED DATA, EG HOLD, SET ALPHA,
051340*    AND PREV SUMMARY VALUES, FCHAR REL 1 RELATIVE TO THE
051360*    DYNAMIC IQE BUFFER--ALSO FOR THE DYNAMICALLY ALLOCATED ITEMS
051380*    THE ITEM TYPE VALUE WILL NOT BE MODIFIED.
051400*
051420*    D-TYPE VALUES PASSED TO IQE WILL BE AS SHOWN BELOW
051440*    ANY TYPES NOT SHOWN PERTAIN TO ITEMS WHOSE
051460*    VALUES ARE CONTAINED WITHIN THE DICT ENTRY ITSELF AS
051480*    OPPOSED TO A BUFFER.
051500*
051520*    DATA TYPE   MEANING
051540*    ---- ----   -------
051560*
051580*       1        ALPHANUMERIC HOLD,SET, OR PRIOR SUMMARY VALUE.
051600*       2        NUMERIC      HOLD,SET, OR PRIOR SUMMARY VALUE.
051620*       6        BINARY       HOLD,SET, OR PRIOR SUMMARY VALUE.
051640*     101        ALPHANUMERIC ITEM IN A 6 BIT PRIMARY SEQ FILE.
051660*     102        NUMERIC      ITEM ...
051680*     106        BINARY       ITEM ...
051700*     201        ALPHANUMERIC ITEM IN A 7 BIT PRIMARY SEQ FILE.
051720*     202        NUMERIC      ITEM ...
051740*     206        BINARY       ITEM ...
051760*     301        ALPHANUMERIC ITEM IN A 6 BIT PRIMARY ISAM FILE.
051780*     302        NUMERIC      ITEM ...
051800*     306        BINARY       ITEM ...
051820*     401        ALPHANUMERIC ITEM IN A 7 BIT PRIMARY ISAM FILE
051840*     402        NUMERIC      ITEM ...
051860*     406        BINARY       ITEM ...
051880*     501        ALPHANUMERIC ITEM IN A PRIMARY DBMS FILE.
051900*     502        NUMERIC      ITEM ...
051920*     506        BINARY       ITEM ...
051940*     701        ALPHANUMERIC ITEM IN A 6 BIT SECONDARY SEQ FILE
051960*     702        NUMERIC      ITEM ...
051980*     706        BINARY       ITEM ...
052000*     801        ALPHANUMERIC ITEM IN A 7 BIT SECONDARY SEQ FILE
052020*     802        NUMERIC      ITEM ...
052040*     806        BINARY       ITEM ...
052060*     901        ALPHANUMERIC ITEM IN A 6 BIT SECONDARY ISAM FILE
052080*     902        NUMERIC      ITEM ...
052100*     906        BINARY       ITEM ...
052120*    1001        ALPHANUMERIC ITEM IN A 7 BIT SECONDARY ISAM FILE
052140*    1002        NUMERIC      ITEM ...
052160*    1006        BINARY       ITEM ...
052180*    1101        ALPHANUMERIC ITEM IN A SECONDARY DBMS FILE
052200*    1102        NUMERIC      ITEM ...
052220*    1106        BINARY       ITEM ...
052240*    1301        ALPHANUMERIC ITEM IN A 6 BIT TERTIARY SEQ FILE
052260*    1302        NUMERIC      ITEM ...
052280*    1306        BINARY       ITEM ...
052300*    1401        ALPHANUMERIC ITEM IN A 7 BIT TERTIARY SEQ FILE.
052320*    1402        NUMERIC      ITEM ...
052340*    1406        BINARY       ITEM ...
052360*    1501        ALPHANUMERIC ITEM IN A 6 BIT TERTIARY ISAM FILE
052380*    1502        NUMERIC      ITEM ...
052400*    1506        BINARY       ITEM ...
052420*    1601        ALPHANUMERIC ITEM IN A 7 BIT TERTIARY ISAM FILE.
052440*    1602        NUMERIC      ITEM ...
052460*    1606        BINARY       ITEM ...
052480*    1701        ALPHANUMERIC ITEM IN A TERTIARY DBMS FILE
052500*    1702        NUMERIC      ITEM ...
052520*    1706        BINARY       ITEM ...
052540*
052560*    FIRST SET UPPER BOUND ORIGIN SINCE NOT SET BY RDICT.
052580     IF N-INPUTFILES = 1     COMPUTE SECONDARY-ORIGIN
052600                           = PRIMARY-ORIGIN + PRIMARY-LENGTH.
052620     IF N-INPUTFILES = 2     COMPUTE TERTIARY-ORIGIN
052640                           = SECONDARY-ORIGIN + SECONDARY-LENGTH.
052660     IF N-INPUTFILES = 3     COMPUTE QUATERNARY-ORIGIN
052680                           = TERTIARY-ORIGIN + TERTIARY-LENGTH.
052700*    NOW CYCLE THRU DICT, MODIFYING TYPES 1,2, 6 PERTAINING TO
052720*    TYPE AND FCHAR.
052740     SET DX TO DX-MAX.
052760 DUP7.
052780     IF D-TYPEV (DX) = 1 OR D-TYPEV (DX) = 2 OR D-TYPEV (DX) = 6
052800        NEXT SENTENCE ELSE GO TO DUP10.
052820     IF D-FCHAR (DX) NOT LESS THAN SECONDARY-ORIGIN GO TO DUP11.
052840*    HERE FOR PRIMARY FILE ITEM--MODIFY ITS TYPE
052860     MOVE 1 TO DELTA.
052880     SET FX TO FX-PRIMARY.
052900 DUP8.
052920     IF F-TYPEV (FX) = 27 ADD 1 TO DELTA.
052940     IF F-TYPEV (FX) NOT = 28 GO TO DUP9.  
052942*    *LOOK AT NREPEATS TO SEE WHAT KIND OF DBMS REC WE HAVE*
052944     IF D-NREPEATS (DX) NOT < 0 MOVE 2 TO DELTA ELSE
052946         SUBTRACT D-NREPEATS (DX) FROM 0 GIVING D-NREPEATS (DX)
052948         MOVE 1 TO DELTA.
052950     GO TO DUP9A.
052960 DUP9.
052980     IF F-KEYLEN (FX) NOT = 0 ADD 2 TO DELTA.
052982 DUP9A.
053000     COMPUTE D-TYPEV (DX) = D-TYPEV (DX) + DELTA * 100.
053020 DUP10.
053040     SET DX DOWN BY 1.
053060     IF DX LESS THAN DX-LOWEST GO TO DUPX.
053080     GO TO DUP7.
053100 DUP11.
053120     IF N-INPUTFILES = 1
053140        MOVE SECONDARY-ORIGIN TO ORIGIN  GO TO DUP14.
053160     IF D-FCHAR (DX) NOT LESS THAN TERTIARY-ORIGIN GO TO DUP12.
053180*    HERE FOR SECONDARY FILE ITEM.
053200     MOVE 7 TO DELTA.
053220     SET FX TO FX-SECONDARY.
053240*    ADJUST FCHAR TO BE REL 1.
053260     COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - SECONDARY-ORIGIN + 1.
053280     GO TO DUP8.
053300 DUP12.
053320     IF N-INPUTFILES = 2
053340        MOVE TERTIARY-ORIGIN TO ORIGIN  GO TO DUP14.
053360     IF D-FCHAR (DX) NOT LESS THAN QUATERNARY-ORIGIN
053380        MOVE QUATERNARY-ORIGIN TO ORIGIN  GO TO DUP14.
053400*    HERE FOR A TERTIARY FILE ITEM.
053420     SET FX TO FX-TERTIARY.
053440     MOVE 13 TO DELTA.
053460     COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - TERTIARY-ORIGIN + 1.
053480     GO TO DUP8.
053500 DUP14.
053520*    HERE TO ADJUST FCHAR ONLY(IE NOT D-TYPE) FOR A HOLD OR
053540*    DYNAMIC STORAGE TYPE ITEM.
053560     COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - ORIGIN + 1.
053580     GO TO DUP10.
053600 DUPX.    EXIT.
053620 LOOK-IN-DX.
053640     IF FLAG-CONTINUE = 1 GO TO LID1.
053660     SET DX TO DX-MAX. SET DX UP BY 1.
053680 LID1.
053700     SET DX DOWN BY 1. SET KX TO DX.
053720     IF DX < DX-LOWEST GO TO LIDX.
053740     MOVE K-TYPEV (KX) TO TYPEV.
053760     IF TYPEV = TYPE-AVERAGE GO TO LID1.
053780     IF TYPEV = TYPE-CONSTANT GO TO LID1.
053800     IF TYPEV = TYPE-FILE GO TO LID1.
053820     IF TYPEV = TYPE-GOTO GO TO LID1.
053840     IF TYPEV = TYPE-LITERAL GO TO LID1.
053860     IF TYPEV = TYPE-REPORT GO TO LID1.
053880     IF TYPEV = TYPE-SUMMARY GO TO LID1.
053900     IF WORD30 = K-ENDKEY (KX) GO TO LIDX.
053902     IF TYPEV NOT = TYPE-PRIOR-SUMMARY GO TO LID1.
053904     MOVE WORD30 TO HWORD30.
053906     IF HELD-WORD30 = K-ENDKEY (KX) GO TO LIDX.
053920     GO TO LID1.
053940 LIDX.    EXIT.
053960 LOOK-IN-FX.
053980     SET FX TO DX-MAX. SET FX UP BY 1.
054000 LIF1.
054020     SET FX DOWN BY 1. SET KX TO FX.
054040     IF FX < DX-LOWEST GO TO LIFX.
054060     IF F-TYPEV (FX) NOT EQUAL TO TYPE-FILE GO TO LIF1.
054080     IF WORD30 = K-ENDKEY (KX) GO TO LIFX.
054100     GO TO LIF1.
054120 LIFX.    EXIT.
054140 DROP-IN-FALSEGO.
054160*    STACK CURRENT VALUE OF X ONTO FALSE STACK.
054180     IF N-FALSEGO = MAX-FALSEGO
054200        MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
054220        GO TO DIFGOX.
054240     ADD 1 TO N-FALSEGO.
054260     SET FSX TO N-FALSEGO.
054280     SET X-FALSEGO (FSX) TO X.
054300 DIFGOX.    EXIT.
054320 DROP-IN-TRUEGO.
054340*    STACK CURRENT VALUE OF X ONTO TRUE STACK.
054360     IF N-TRUEGO = MAX-TRUEGO
054380        MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
054400        GO TO DITGOX.
054420     ADD 1 TO N-TRUEGO.
054440     SET TSX TO N-TRUEGO.
054460     SET X-TRUEGO (TSX) TO X.
054480 DITGOX.    EXIT.
054500 POP-TRUE.
054520*    POP THE TOP ENTRY IN TRUE STACK AND SET THE
054540*    INSTR ENTRY POINTED TO BY THIS POPPED ADDRESS
054560*    TO POINT TO THE CURRENT X.
054580     IF N-TRUEGO = 0 GO TO POPTX.
054600     SET TSX TO N-TRUEGO.
054620     SET SAVE-X TO X.
054640     SET X TO X-TRUEGO (TSX).
054660*    SAVE FOR OTHER USES*
054680     SET POPPED-X TO X.
054700     MOVE SAVE-X TO INSTR (X).
054720*    IF WE ARE POPPING TRUEGO FOR AN IF NEWGROUP STATEMENT
054740*    THEN SET THE TRUEGO ADDRESS TO A NEGATIVE VALUE FOR PURPOSES
054760*    OF IQE INITIALIZING.
054780     SET X DOWN BY 1.
054800     IF INSTR (X) = V-IFNEWGROUP
054820        SET X UP BY 1
054840        MULTIPLY SAVE-X BY MINUS-ONE GIVING INSTR (X).
054860     SET X TO SAVE-X.
054880     SUBTRACT 1 FROM N-TRUEGO.
054900 POPTX. EXIT.
054920 POPALL-TRUE.
054940*    POP ALL TRUE ENTRIES MAKING THEM ALL POINT TO X
054960     IF N-TRUEGO = 0 GO TO POPALLTX.
054980     PERFORM POP-TRUE THRU POPTX.
055000     GO TO POPALL-TRUE.
055020 POPALLTX.  EXIT.
055040 POP-FALSE.
055060*    POP THE TOP ENTRY IN FALSE-STACK AND SET THE INSTR
055080*    ENTRY POINTED TO BY THIS ADDRESS TO POINT TO X
055100     IF N-FALSEGO = 0
055120        MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
055140        GO TO POPFX.
055160     SET FSX TO N-FALSEGO.
055180     SET SAVE-X TO X.
055200     SET X TO X-FALSEGO (FSX).
055220*    SAVE FOR USE ELSEWHERE
055240     SET POPPED-X TO X.
055260     MOVE SAVE-X TO INSTR (X).
055280     SET X TO SAVE-X.
055300     SUBTRACT 1 FROM N-FALSEGO.
055320 POPFX.  EXIT.
055340 POPALL-FALSE.
055360*    POP ALL FALSE ENTRIES MAKING THEM POINT TO CURRENT X
055380     IF N-FALSEGO = 0 GO TO POPALLF1.
055400     PERFORM POP-FALSE THRU POPFX.
055420     GO TO POPALL-FALSE.
055440*    IF ELSE-X IS SET, THEN A GOTO MUST BE COMPLETED NOW
055460*    TO WRAPUP IF-THEN-ELSE
055480 POPALLF1.
055500     IF ELSE-X = 0 GO TO POPALLF2.
055520     SET SAVE-X TO X. SET X TO ELSE-X.
055540     MOVE SAVE-X TO INSTR (X).
055560*    INDICATE TO GOTO3 THAT THIS IS NOT A GOTO STATEMENT NUMBER.
055580*    BUT MUST HAVE NON-ZERO VALUE HERE OR ELSE GOTO2 WILL
055600*    THINK THIS GOTO HAS BEEN UNASSIGNED AND FLAG IT AS SUCH.
055620     ADD DX-MAX TO INSTR (X).
055640     MOVE 1 TO FLAG-GOTO.
055660     SET X TO SAVE-X. MOVE 0 TO ELSE-X.
055680 POPALLF2.
055700     MOVE 0 TO LPARENCNTR. MOVE 0 TO RPARENCNTR.
055720     MOVE 0 TO TLPX.  MOVE 0 TO FLPX.
055740 POPALLFX.  EXIT.
055760************************
055780 GET-INSTR.
055800*    GET-INSTR WILL READ THE VERB AND STORE IT INTO
055820*    INSTR (X) AND SET V TO IT; NEXT, BY EXECUTING
055840*    GET-ONE-INSTR, IT WILL READ THE FOLLOWING WORD OR
055860*    OBJECT INTO INSTR (X) AND SET T-INSTR TO IT
055880*    ALSO, IT WILL POP ALL FALSE STACK IF IT FINDS $
055900     SET LI UP BY 1. IF LI > LI-MAX PERFORM GET-QT THRU GET-QTX.
055920     SET X UP BY 1. IF X > X-MAX MOVE 1 TO EOQ.
055940     IF EOQ = 1 MOVE EOQ TO V MOVE ZEROS TO T-INSTR
055960        GO TO GET-INSTRX.
055980     MOVE LINE-WORD (LI) TO INSTR (X).
056000     IF X < EXEC-STARTX GO TO GET-INSTR.
056020     MOVE INSTR (X) TO V.
056040     IF V = V-EOS
056060        PERFORM POPALL-FALSE THRU POPALLFX
056080        SET X DOWN BY 1
056100        GO TO GET-INSTR.
056120     IF V = ZEROS GO TO GET-INSTR.
056140 GET-ONE-INSTR.
056160     SET LI UP BY 1. IF LI > LI-MAX PERFORM GET-QT THRU GET-QTX.
056180     SET X UP BY 1. IF X > X-MAX MOVE 1 TO EOQ.
056200     IF EOQ = 1 MOVE EOQ TO V MOVE ZEROS TO T-INSTR
056220        GO TO GET-INSTRX.
056240     MOVE LINE-WORD (LI) TO INSTR (X).
056260     MOVE INSTR (X) TO T-INSTR.
056280     GO TO GET-INSTRX.
056300 GET-QT.
056320     READ QTANLZ AT END MOVE 1 TO EOQ GO TO GET-QTX.
056340     MOVE QTANLZ-REC TO LINE-TABLE.
056360     SET LI TO 1.
056380 GET-QTX.    EXIT.
056400 GET-INSTRX.     EXIT.
056420*********************
056440 ACCEPT1.
056460     IF FLAG-PASS = 2 GO TO ACCEPT2.
056480     IF FLAG-ALPHA = ZERO GO TO E003.
056500     SET INSTR (X) TO DX.
056520     GO TO VERB-CONTROL.
056540 ACCEPT2.
056560*    FOR CASE OF ALPHA VAR, INTRODUCED BY ACCEPT, ALLOCATE
056580*    STORAGE FOR IT NOW IN CASE THERE IS NO SET  VERB TO
056600*    ALLOCATE IT LATER.
056620*    SET DX TO T-INSTR.
056640*    IF D-TYPEV (DX) = TYPE-VARIABLE  IF D-FCHAR (DX) = 0
056660*       GO TO ACCEPT2A.
056680*    GO TO ACCEPT2B.
056700*ACCEPT2A.
056720*    IF FCHAR = 0 MOVE 1 TO FCHAR.
056740*    MOVE FCHAR TO D-FCHAR (DX). ADD D-NCHAR (DX) TO FCHAR.
056760*    MOVE D-NCHAR (DX) TO D-ECHAR (DX).
056770     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
056780 ACCEPT2B.
056800     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
056820     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
056840     GO TO ACCEPT2B.
056860 ACROSS1.
056880     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
056900     IF FLAG-ALPHA = 1 GO TO E002.
056920     IF NUMBN < 1 GO TO E008.
056940     SET INSTR (X) TO NUMBN.
056960     GO TO VERB-RESET.
056980 AT-END1.
057000     GO TO VERB-CONTROL.
057020 AUTHORITY1.
057040     IF FLAG-PASS = 2 GO TO AUTHORITY2.
057060     IF FLAG-ALPHA = ZERO GO TO E003.
057080     SET AX TO DX.
057100     IF FLAG-VERB = 1
057120        MOVE 2 TO FLAG-VERB   SET PW-POINTER TO AX.
057140     ADD 1 TO N-PASSWORDS.
057160     IF N-PASSWORDS = 1
057180        MOVE AUTH-PASSWORD (AX) TO FIRST-PASSWORD.
057200     IF AUTH-PASSWORD (AX) = UNIVERSAL-PASSWORD
057220        MOVE 2 TO FLAG-LOCKED.
057240     SET INSTR (X) TO DX.
057260     MOVE TYPE-AUTHORITY TO D-TYPEV (DX).
057280     GO TO VERB-CONTROL.
057300 AUTHORITY2.
057320     SET X DOWN BY 2.
057340 AUTHORITY2A.
057360     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
057380     SET X DOWN BY 1.
057400     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
057420     GO TO AUTHORITY2A.
057440 AVERAGE1.
057460     IF FLAG-PASS = 2
057480        MOVE '*WARNING-AVERAGE STATEMENT' TO WORD30
057500        GO TO TALLY2.
057520     GO TO TALLY1.
057540 CALL1.
057560     IF FLAG-PASS = 2 GO TO CALL2.
057580     IF FLAG-VERB = 2 GO TO CALL1A.
057600     IF FLAG-ALPHA = 1 GO TO E002.
057620     MOVE 2 TO FLAG-VERB.
057640 CALL1A.
057650*    IF VA # 0,THEN NEGATE STORED DX INDICATING A STORE ARGUMENT.
057652     IF VA NOT = 0
057654        SUBTRACT INSTR (X) FROM 0 GIVING INSTR (X)
057655        MOVE 0 TO VA
057656        ELSE
057660        SET INSTR (X) TO DX.
057680     GO TO VERB-CONTROL.
057700 CALL2.
057720     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
057740     IF T-INSTR = ZEROS GO TO VERB-RESET.
057760     GO TO CALL2.
057780 COMPUTE1.
057800     IF FLAG-PASS = 2 GO TO COMPUTE2.
057820     IF FLAG-VERB = 2 GO TO COMPUTE1A.
057840*    HERE FOR FIRST TIME FOR THIS COMPUTE--SET FLAG-VERB
057860*    TO INDICATE THAT THIS IS NOT FIRST TIME HERE
057880     MOVE 2 TO FLAG-VERB.
057900     IF FLAG-ALPHA = ZERO GO TO E003.
057920     MOVE 0 TO FLAG-COMPUTE.
057922*    TYPEV = 0 ONLY IF DID NOT  READ A DATA ITEM RIGHT AFTER COMPUTE
057924     IF TYPEV = 0
057926        MOVE 'MISSING ITEM AFTER "COMPUTE"' TO WORD30
057928        GO TO E026.
057940*    AT THIS POINT, COMPUTE VERB CODE HAS BEEN SET INTO THE
057960*    INSTR TABLE BY CONTROL AND X IS POINTING TO THE NEXT
057980*    ENTRY OF INSTR TABLE--SET THE DX VALUE INTO THIS ENTRY
058000*    THAT REPRESENTS THE LEFT SIDE OF =
058020     SET INSTR (X) TO DX.
058040*    SET CONSTANT -1 INTO DICTIONARY AND SAVE POINTER TO IT.
058060     SUBTRACT 1 FROM 0 GIVING NUMBN.
058080     PERFORM INSERT-CONSTANT THRU INSERTCX.
058100     SET MINUS-ONE-DX TO DX.
058120*    SET CONSTANT 0 INTO DICTIONARY AND SAVE POINTER
058140     MOVE 0 TO NUMBN.
058160     PERFORM INSERT-CONSTANT THRU INSERTCX.
058180     SET ZERO-DX TO DX.
058200     GO TO VERB-CONTROL.
058220 COMPUTE1A.
058240*    WILL KEEP RETURNING TO COMPUTE1 FROM VERB-CONTROL
058260*    FOR EACH OPERATOR AND OPERAND UNTIL HIT EOS-THIS
058280*    FIRST PASS SECTION WILL BASICALLY CHECK FOR CURRENT
058300*    SYNTAX AND STORE SYNTAX INTO INSTR TABLE--THE 2ND
058320*    PASS SECTION WILL PARSE THE COMPUTE SYNTAX AND DO
058340*    SOME FURTHUR ERROR CHECKING.
058360     IF VA = V-RESULT GO TO COMPUTE1F.
058370     IF FLAG-COMPUTE = 0
058372        MOVE SPACES TO WORD30
058374        GO TO E028.
058380     IF VA = V-ADD   GO TO COMPUTE1B.
058400     IF VA = V-SUBTRACT GO TO COMPUTE1G.
058420     IF VA = V-MULTIPLY GO TO COMPUTE1B.
058440     IF VA = V-DIVIDE   GO TO COMPUTE1B.
058460     IF VA = V-LPAREN   GO TO COMPUTE1E.
058480     IF VA = V-RPAREN   GO TO COMPUTE1H.
058500*    IF VA NOT = 0*GO TO E000.
058520*    HERE WHEN HAVE DX--THIS HAS ALREADY BEEN STORED
058540*    INTO THE INSTR TABLE-THIS DX MUST HAVE BEEN PRECEEDED
058560*    BY AN OPERATOR.
058580*    NOW TEST FOR OPERAND-OPERATOR SEQUENCE OUT-OF-WHACK.
058600*    WHERE FLAG-COMPUTE VALUES ARE AS FOLLOWS:
058620*    0=INITIAL VALUE; 1=OPERATOR FOUND; 2=OPERAND FOUND
058640     IF FLAG-COMPUTE NOT = 1 GO TO E025.
058660     MOVE 2 TO FLAG-COMPUTE.
058680     GO TO VERB-CONTROL.
058700 COMPUTE1B.
058720*    HERE WHEN FOUND ARITHMETIC OPERATOR-CHECK ALLOWABILITY
058740*    AND ALSO BUMPX AND DROP OPERATOR INTO INSTR TABLE.
058760     IF FLAG-COMPUTE NOT = 2 GO TO E026.
058780 COMPUTE1C.
058800     MOVE 1 TO FLAG-COMPUTE.
058820 COMPUTE1D.
058840     SET X UP BY 1.
058860     MOVE VA TO INSTR (X).
058880     MOVE ZERO TO VA.
058900*    CLEAR EOS FLAG IN CASE IT GOT SET BY '.' SINCE '.'
058920*    SHOULD NOT BE TREATED AS EOS WITHIN COMPUTE.
058940     MOVE 0 TO FLAG-EOS.
058960     GO TO VERB-CONTROL.
058980 COMPUTE1E.
059000*    HERE FOR LEFT PAREN-CAN ONLY FOLLOW ANOTHER OPERATOR
059020     IF FLAG-COMPUTE NOT = 1 GO TO E025.
059040     GO TO COMPUTE1D.
059060 COMPUTE1F.
059080*    HERE FOR = AND MUST BE THE FIRST OPERATOR
059100     IF FLAG-COMPUTE NOT = 0 GO TO E027.
059120     GO TO COMPUTE1C.
059140 COMPUTE1G.
059160*    HERE FOR - MUST FOLLOW AN OPERAND OR POSSIBLY UNARY -
059180     IF FLAG-COMPUTE = 2 GO TO COMPUTE1C.
059200     GO TO COMPUTE1C.
059220 COMPUTE1H.
059240*    HERE FOR RIGHT PAREN--CAN ONLY FOLLOW ANOTHER RIGHT
059260*    PAREN OR AN OPERAND--ALSO ) MUST BE FOLLOWED BY RIGHT
059280*    PAREN OR OPERATOR THEREFORE KEEP FLAG-COMPUTE = 2
059300     IF FLAG-COMPUTE = 2 GO TO COMPUTE1D.
059320     GO TO E026.
059340 COMPUTE2.
059360*    COMPUTE2 ENTERED DURING 2ND PASS AND WILL PARSE THE
059380*    INPUT STRING THAT RESIDES IN INSTR TABLE
059400*    'COMPUTE W' HAS ALREADY BEEN READ BY CONTROL-CHECK
059420*    THAT 'W' IS NUMERIC.
059425*    IF FIRST ARG IS 0, THEN HAVE ERROR PREVIOUSLY REPORTED
059530     IF T-INSTR = 0 GO TO VERB-CONTROL.
059440     SET DX TO T-INSTR.
059460     PERFORM CHECK-NUMERIC THRU CHECK-NUMERICX.
059480     if ecode not = 0
059482        perform compute-warning thru compute-warningx.
059500*    NEXT, READ '=' AND GET RID OF IT FOR NOW AND INITIALZE
059520     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
059530*    IF MISSING = OPERATOR, DONT REPORT IT AGAIN IN PASS2.
059540     IF T-INSTR NOT = V-RESULT GO TO VERB-RESET.
059560     SET SAVE-XX TO X.
059580     SET X DOWN BY 1.
059600*    SET FIRST ENTRY IN PARSING TABLE TO LNIL WHERE THE
059620*    OPERATOR CODE AND PRECEDENCE = 0.
059640     SET OPX TO 1.
059660     MOVE 0 TO OPERATOR (OPX) OPERAND (OPX) PRECEDENCE (OPX).
059680     MOVE 1 TO CURR-PRECEDENCE.
059700     MOVE V-RESULT TO CURR-OPERATOR.
059720     SET SAVE-X TO X.
059740*    NOW READ A SINGLE OPERATOR OR OPERAND.
059760 COMPUTE2A.
059780     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
059800     IF T-INSTR = 0           GO TO COMPUTE2AA.
059820     IF T-INSTR = V-ADD       GO TO COMPUTE2B.
059840     IF T-INSTR = V-SUBTRACT  GO TO COMPUTE2E.
059860     IF T-INSTR = V-MULTIPLY  GO TO COMPUTE2C.
059880     IF T-INSTR = V-DIVIDE    GO TO COMPUTE2C.
059900     IF T-INSTR = V-LPAREN
059920        ADD 10 TO PARENCNT    GO TO COMPUTE2A.
059940     IF T-INSTR NOT = V-RPAREN GO TO COMPUTE2F.
059960     IF PARENCNT LESS THAN 10 
059962        MOVE 010 TO ECODE  PERFORM E-RROR THRU E-XIT
059964        GO TO COMPUTE2A.
059980     SUBTRACT 10 FROM PARENCNT.
060000     GO TO COMPUTE2A.
060020 COMPUTE2AA.
060040*    SET PRECEDENCE FOR EOS SUCH THAT REST OF PARSING
060060*    STACK WILL BE POPPED.
060080     MOVE 0 TO CURR-PRECEDENCE.
060100     GO TO COMPUTE2G.
060120 COMPUTE2B.
060140*    SET PRECEDENCE FOR + -
060160     MOVE 2 TO CURR-PRECEDENCE.
060180     GO TO COMPUTE2D.
060200 COMPUTE2C.
060220*    SET PRECEDENCE FOR * /
060240     MOVE 3 TO CURR-PRECEDENCE.
060260 COMPUTE2D.
060280*    SET CURR OPERATOR AND ADJUST PRECEDENCE =F(PARENS)
060300     MOVE T-INSTR TO CURR-OPERATOR.
060320     ADD PARENCNT TO CURR-PRECEDENCE.
060340     GO TO COMPUTE2A.
060360 COMPUTE2E.
060380*    -   SEE IF UNARY -
060400     IF OPX NOT = 1 GO TO COMPUTE2B.
060420*    FOR UNARY (-), INSERT ZERO(DX) OPERAND.
060440     SET X UP BY 1.
060460     MOVE ZERO-DX TO INSTR (X) T-INSTR.
060480*    SET LI TO READ (-) OPERATOR AGAIN
060500     SET LI DOWN BY 1.
060520 COMPUTE2F.
060540*    HERE FOR ARITMETIC OPERAND
060560     MOVE T-INSTR TO CURR-OPERAND.
060562     set dx to t-instr.
060564     perform check-numeric thru check-numericx.
060566     if ecode not = 0
060568        perform compute-warning thru compute-warningx.
060580 COMPUTE2G.
060600*    COMPARE PRECEDENCE OF LAST OPERATOR STACKED WITH THE
060620*    LAST OPERATOR READ
060640     IF PRECEDENCE (OPX) NOT LESS THAN CURR-PRECEDENCE
060660        GO TO COMPUTE2H.
060680*    STACK CURRENT OPERATOR(LAST READ) SINCE GEQ STACK TOP
060700     SET OPX UP BY 1.
060720     MOVE CURR-OPERATOR TO OPERATOR (OPX).
060740     MOVE CURR-OPERAND  TO OPERAND (OPX).
060760     MOVE CURR-PRECEDENCE TO PRECEDENCE (OPX).
060780     ADD 1 TO OPERANDS-CNT.
060800     GO TO COMPUTE2A.
060820 COMPUTE2H.
060840*    HERE TO GENERATE CODE FOR TOP OF PARSING STACK
060860     SET X TO SAVE-X.
060880     SET X UP BY 1.
060900*    SAVE CURRENT ACCUMULATOR IF WE HAVE USED IT AND HAVE
060920*    STACKED MORE THAN ONE OPERAND INTO PARSING-STACK SINCE
060940*    THE ACCUM WAS LAST USED.
060960     IF OPERANDS-CNT GREATER THAN 1
060980        IF FLAG-ACCUM = 1
061000           MOVE V-STACK TO INSTR (X)
061020           SET X UP BY 1
061040           MOVE 0 TO FLAG-ACCUM.
061060     IF OPERATOR (OPX) = V-RESULT GO TO COMPUTE2T.
061080     IF OPERATOR (OPX) = V-DIVIDE GO TO COMPUTE2R.
061100     IF OPERATOR (OPX) = V-MULTIPLY GO TO COMPUTE2L.
061120     IF OPERATOR (OPX) = V-SUBTRACT GO TO COMPUTE2S.
061140     IF OPERATOR (OPX) NOT = V-ADD 
061142        MOVE 020 TO ECODE  PERFORM E-RROR THRU E-XIT.
061160*    +
061180*    IS CURRENT OPERAND IN ACCUMULATOR?
061200 COMPUTE2I.
061220     IF OPERAND (OPX) NOT = LOW-VALUES GO TO COMPUTE2K.
061240 COMPUTE2J.
061260     MOVE OPERATOR (OPX) TO INSTR (X).
061280     SET X UP BY 1.
061300     SET OPX DOWN BY 1.
061320     IF OPERAND (OPX) = LOW-VALUES
061340        MOVE V-POP TO INSTR (X)
061360        ELSE
061380        MOVE OPERAND (OPX) TO INSTR (X).
061400     GO TO COMPUTE2Q.
061420 COMPUTE2K.
061440*    SEE IF PREVIOUS OPERAND WAS ACCUMULATOR
061460     SET OPX DOWN BY 1.
061480     IF OPERAND (OPX) = LOW-VALUES GO TO COMPUTE2P.
061500     SET OPX UP BY 1.
061520     MOVE OPERAND (OPX) TO INSTR (X).
061540     SET X UP BY 1.
061560     GO TO COMPUTE2J.
061580 COMPUTE2L.
061600*    *
061620*    IF TOP OPERAND(RIGHT SIDE) IS IN ACCUM ALREADY THEN
061640*    CAN OPERATE AGAINST LEFT SIDE NOW
061660     IF OPERAND (OPX) NOT = LOW-VALUES GO TO COMPUTE2M.
061680     MOVE OPERATOR (OPX) TO INSTR (X).
061700     SET X UP BY 1.
061720     SET OPX DOWN BY 1.
061740*    IF LEFT SIDE IS ACCUM ALSO, IT HAS BEEN STACKED AND
061760*    MUST BE POPPED
061780     IF OPERAND (OPX) = LOW-VALUES
061800        MOVE V-POP TO INSTR (X)
061820        ELSE
061840        MOVE OPERAND (OPX) TO INSTR (X).
061860     GO TO COMPUTE2Q.
061880 COMPUTE2M.
061900*    SEE IF LEFT OPERAND IS IN ACCUM--IF SO, THEN ALL SET
061920*    ON LEFT OPERAND
061940     SET OPX DOWN BY 1.
061960     IF OPERAND (OPX) = LOW-VALUES GO TO COMPUTE2P.
061980 COMPUTE2N.
062000     MOVE OPERAND (OPX) TO INSTR (X).
062020 COMPUTE2NN.
062040     SET X UP BY 1.
062060 COMPUTE2P.
062080     SET OPX UP BY 1.
062100     MOVE OPERATOR (OPX) TO INSTR (X).
062120     SET X UP BY 1.
062140     MOVE OPERAND (OPX) TO INSTR (X).
062160     SET OPX DOWN BY 1.
062180 COMPUTE2Q.
062200*    CLEAR TOP OF PARSING STACK AND SET NEW TOP OPERAND
062220*    TO BE ACCUMULATOR
062240     MOVE LOW-VALUES TO OPERAND (OPX).
062260     MOVE 1 TO FLAG-ACCUM.
062280     MOVE 0 TO OPERANDS-CNT.
062300     SET SAVE-X TO X.
062320     GO TO COMPUTE2G.
062340 COMPUTE2R.
062360*    /
062380*    ARE BOTH LEFT AND RIGHT OPERANDS ACCUMULATORS?
062400     IF OPERAND (OPX) NOT EQUAL TO LOW-VALUES
062420        GO TO COMPUTE2M.
062440     SET OPX DOWN BY 1.
062500*    STACK CURRENT ACCUM
062520     MOVE V-STACK TO INSTR (X).
062540     SET X UP BY 1.
062560*    NOW, GENERATE OPERATOR TO GET 2ND ITEM FROM STACK IF LEFT
062561*    OPERATOR IS ACCUM ALSO ELSE GENERATE STACKED OPERATOR
062570     IF OPERAND (OPX)  EQUAL TO LOW-VALUES
062580        MOVE V-POP2 TO INSTR (X)
062582        ELSE
062584        MOVE OPERAND (OPX) TO INSTR (X).
062600     SET X UP BY 1.
062620     MOVE V-DIVIDE TO INSTR (X).
062640     SET X UP BY 1.
062660     MOVE V-POP TO INSTR (X).
062680     GO TO COMPUTE2Q.
062700 COMPUTE2S.
062720*    -
062740*    IF RIGHT OPERAND IS ACCUM, THEN MUST MULTIPLY IT BY -1
062760*    AND CHANGE OPERATOR IN STACK TO +
062780     IF OPERAND (OPX) NOT = LOW-VALUES
062800        GO TO COMPUTE2M.
062820     MOVE V-MULTIPLY TO INSTR (X).
062840     SET X UP BY 1.
062860     MOVE MINUS-ONE-DX TO INSTR (X).
062880     MOVE V-ADD TO OPERATOR (OPX).
062900     SET X UP BY 1.
062920     GO TO COMPUTE2I.
062940 COMPUTE2T.
062960*    HERE WHEN COMPUTE STRING IS FINISHED- STORE = INTO
062980*    FINAL COMPUTE INSTR ENTRY.
063000*    ALSO, IF HAVE NOT GENERATED ANY CODE YET THEN MUST
063020*    HAVE SINGLE OPERAND TO RIGHT OF = AND MUST GEN CODE NOW.
063040     IF X = SAVE-XX
063060        MOVE OPERAND (OPX) TO INSTR (X)
063080        SET X UP BY 1.
063100     MOVE V-NOP TO INSTR (X).
063120     MOVE 0 TO OPERANDS-CNT FLAG-ACCUM.
063140     GO TO VERB-CONTROL.
063160 INSERT-CONSTANT.
063180     MOVE NUMBER-TABLE TO WORD-TABLE.
063200     MOVE 0 TO FLAG-ALPHA  SCALE.
063220     MOVE 1 TO NCHAR.
063240     PERFORM DROP-IN-DX THRU DIDX.
063260 INSERTCX.  EXIT.
063280 COPY1.
063300     IF FLAG-PASS = 2 GO TO COPY2.
063320     IF FLAG-VERB = 2 GO TO COPY1B.
063340     IF FLAG-VERB = 3 GO TO COPY1C.
063360     MOVE 2 TO FLAG-VERB.
063380     IF FLAG-EOS = 1 GO TO COPY1A.
063400     PERFORM GET-WORD THRU GET-WORDX.
063420     IF WORD06 = "RECORD"
063440        MOVE 1 TO FLAG-PEEKED  GO TO VERB-CONTROL.
063460     MOVE 1 TO FLAG-PEEKED.
063480     MOVE WORD30 TO SAVE30.
063500*    HERE FOR COPY ANOTHER-VOCAB--TREAT AS COPY$ VOCAB
063520 COPY1A.
063540*    COPY$   SET UP FOR DEFAULT
063560     MOVE 1 TO VA.
063580     MOVE "RECORD1" TO WORD30.
063600     PERFORM DROP-IN-DX THRU DIDX.
063620     IF FLAG-PEEKED = 1 MOVE SAVE30 TO WORD30.
063640     SET X UP BY 1.
063660     SET INSTR (X) TO DX.
063680 COPY1B.
063700     MOVE 3 TO FLAG-VERB.
063720     IF VA < 1 OR VA > 3 GO TO E004.
063740     SET INSTR (X) TO DX. SET FX TO DX.
063760     MOVE TYPE-FILE TO F-TYPEV (FX).
063780     SET X UP BY 1. SET INSTR (X) TO VA.
063800     MOVE 1 TO FLAG-COPY.
063820     IF WORD04 = "TO "
063840        MOVE 0 TO FLAG-PEEKED  MOVE V-TO TO VA
063860        ELSE MOVE ZEROS TO VA.
063880     GO TO VERB-CONTROL.
063900 COPY1C.
063920     IF VA NOT EQUAL TO V-TO GO TO E004.
063940     IF TYPEV NOT EQUAL TO TYPE-LITERAL GO TO E015.
063960     SET L-NCHAR (LX) TO FX.
063980     SET INSTR (X) TO LX.
064000     GO TO VERB-RESET.
064020 COPY2.
064040     SET HX TO T-INSTR.
064060     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
064080     SET VA TO T-INSTR.
064100     SET FX TO 1.
064120     IF VA = 1 SET FX TO FX-PRIMARY.
064140     IF VA = 2 SET FX TO FX-SECONDARY.
064160     IF VA = 3 SET FX TO FX-TERTIARY.
064180*    SEE IF FILE PROTECTED AGAINST COPY
064200     MOVE FD-CPROT (VA) TO TEST-REF-NO.
064220     PERFORM UNLOCKER THRU UNLOCKER-EXIT.
064240     IF FLAG-LOCKED = 1
064260        MOVE 14 TO ECODE
064280        MOVE FD-NAMEPROT (VA) TO WORD30
064300        PERFORM E-RROR THRU E-XIT.
064320     IF FX = 1 GO TO E009.
064340     MOVE F-TYPEV (FX) TO TYPEV.
064360     IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
064380     MOVE ZEROS TO T-INSTR.
064400     IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
064420     IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
064440     IF VA = 2 AND TYPEV = 26 MOVE 4 TO T-INSTR.
064460     IF VA = 2 AND TYPEV = 27 MOVE 5 TO T-INSTR.
064480     IF VA = 3 AND TYPEV = 26 MOVE 7 TO T-INSTR.
064500     IF VA = 3 AND TYPEV = 27 MOVE 8 TO T-INSTR.
064520     IF T-INSTR = ZEROS GO TO E009.
064540     SET INSTR (X) TO T-INSTR.
064560*    INITIALIZE FD-INLABEL TO INPUT FILE ID
064580     MOVE F-ID (FX) TO FD-INLABEL.
064600     MOVE F-BLKLEN (FX) TO FD-BLKSIZE.
064620     MOVE F-RECLEN (FX) TO FD-RECSIZE.
064640     MOVE F-ORIGIN (FX) TO COPY-ORIGIN.
064660*    NOW SET COPY FILE SPECS, WHOSE ENTRY PNTD TO BY HX
064680     SET FX TO HX.
064700     MOVE TYPEV TO F-TYPEV (FX).
064720     MOVE 'OUT' TO FD-INEXT. MOVE FD-INLABEL TO F-ID (FX).
064740     MOVE FD-BLKSIZE TO F-BLKLEN (FX).
064760     MOVE FD-RECSIZE TO F-RECLEN (FX).
064780     MOVE COPY-ORIGIN TO F-ORIGIN (FX).
064800     MOVE FD-RECSIZE TO COPY-LENGTH.
064820     MOVE "DSK" TO F-DEVICE (FX).
064840     MOVE ZEROS TO F-PPN (FX).
064860 COPY2A.
064880     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
064900     IF T-INSTR = ZEROS GO TO VERB-RESET.
064920*    SINCE T-INSTR NOT = 0, WE HAVE OPTIONAL COPY FILE SPECS
064940*    NOW PROCESS THESE COPY FILE SPECS
064960*    FIRST, DELETE INSTR ENTRY USED TO POINT TO LITERAL SPECS
064980     SET X DOWN BY 1.
065000     SET LX TO T-INSTR. MOVE L-VALUE (LX) TO QUOTE-TABLE.
065020     PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
065040      MOVE FD-LABEL TO F-ID (FX).
065060     GO TO VERB-RESET.
065080 CREATE1.
065100     IF FLAG-PASS = 2 GO TO CREATE2.
065120     IF FLAG-VERB = 2 GO TO CREATE1A.
065140     MOVE 2 TO FLAG-VERB.
065160     IF FLAG-EOS2 = 1
065180        MOVE 041 TO ECODE
065200        PERFORM E-RROR THRU E-XIT
065220        MOVE SPACES TO WORD30
065240        GO TO E042.
065260*    FLAG-CREATE (CLEARED BY SORT1) ALLOWS ONLY 1 CREATE/STAGE
065280*    IF FLAG-CREATE = 1 GO TO E030.
065300     IF FLAG-ALPHA = ZERO GO TO E003.
065320     SET FX TO DX. SET LX TO FX.
065340*    IF FIRST ARG AFTER VOCAB WORD -CREATE- WAS NOT
065360*    QUOTED, THEN INSERT DEFAULT FILE SPECS NOW.
065380     IF TYPEV NOT = TYPE-LITERAL
065400        SET DX TO DX-LOWEST  SET DX DOWN BY 1
065420        SET FX TO DX         SET LX TO FX
065440        MOVE TYPE-LITERAL TO L-TYPEV (LX)
065460        MOVE 'CREATE.OUT' TO L-VALUE (LX)  QUOTE-TABLE
065480        MOVE INSTR (X) TO T-INSTR.
065500     SET FX DOWN BY 1.  SET L-NCHAR (LX) TO FX.
065520     IF FX LESS THAN DX-LOWEST  SET DX-LOWEST TO FX.
065540     MOVE TYPE-FILE TO F-TYPEV (FX).
065560     MOVE QUOTE-TABLE TO F-ID (FX).
065580     SET INSTR (X) TO FX.
065600*    IF WE JUST INSERTED FILE SPECS(FOR CASE OF 1ST ARG
065620*    NOT A LITERAL), RE-INSERT THE CLOBBERED USER ARG.
065640     IF TYPEV NOT = TYPE-LITERAL
065660        SET X UP BY 1  MOVE T-INSTR TO INSTR (X).
065680     MOVE 1 TO FLAG-CREATE.
065700     GO TO VERB-CONTROL.
065720 CREATE1A.
065740     IF VAA = V-FILLER
065760        MOVE ZEROES TO VAA  GO TO CREATE1B.
065780     SET INSTR (X) TO DX.
065800     GO TO VERB-CONTROL.
065820 CREATE1B.
065840     IF FLAG-ALPHA NOT EQUAL ZEROS
065860        MOVE QUOTE-TABLE TO WORD30  GO TO E002.
065880     MULTIPLY NUMBN10 BY MINUS-ONE GIVING INSTR (X).
065900     GO TO VERB-CONTROL.
065920 CREATE2.
065940     SET FX TO FX-PRIMARY. MOVE F-TYPEV (FX) TO TYPEV.
065960     IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
065962*    IF THIS IS NOT THE FIRST CREATE IN THIS STAGE, MAKE THE
065964*    FD POINTER POINT TO THE SAME CFREATE FD AS THE FIRST CREATE.
065966     IF FLAG-CREATE = 0
065968        MOVE 1 TO FLAG-CREATE
065970        ELSE
065972        MOVE CREATE-FX TO T-INSTR  INSTR (X).
065980     SET FX TO T-INSTR. SET CREATE-FX TO FX.
066000     SET LX TO FX. SET LX UP BY 1.
066020*    LX ENTRY POINTS TO OPTIONAL USER SPECS IF NCHAR (LX)
066040*    POINTS TO FX ENTRY.
066060     IF L-TYPEV (LX) = TYPE-LITERAL AND L-NCHAR (LX) = FX
066080        MOVE L-VALUE (LX) TO QUOTE-TABLE
066100        MOVE "CREATEOUT" TO FD-LABEL
066120        MOVE ZEROES TO F-PPN (FX)
066140        PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT
066160*    FD-LABEL BELOW WILL HAVE GOTTEN RESET BY GET-DEV-LBL-PPN
066180*    IF USER SPECIFIED A PROPER FILENAME(IE WITH PERIOD)
066200        MOVE FD-LABEL TO F-ID (FX).
066220*    TYPE OF CREATE FILE IS SAME AS INPUT(IE 6 OR 7 BIT)
066240     MOVE TYPEV TO F-TYPEV (FX).
066260     IF FLAG-DEV-LBL-PPN = 0 MOVE ZEROS TO F-PPN (FX).
066280     MOVE 1 TO T-INSTR.
066300     IF TYPEV = 27 MOVE 2 TO T-INSTR.
066320     SET X UP BY 1. SET INSTR (X) TO T-INSTR.
066340     MOVE ZEROS TO NCHAR.
066360*    FLAG-CREATE-LOOP SET BY OPEN1, GOTOQT1, GOTOXT1
066380*    IF FLAG-CREATE-LOOP = ZERO MOVE 2 TO FLAG-CREATE-LOOP
066400*       MOVE 024 TO ECODE PERFORM E-RROR THRU E-XIT.
066420 CREATE2A.
066440     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
066460     IF T-INSTR = ZEROS GO TO CREATE2B.
066480     IF T-INSTR LESS THAN 0
066500        MULTIPLY T-INSTR BY MINUS-ONE GIVING T-NUMBN
066520        ADD T-NUMBN TO NCHAR
066540        GO TO CREATE2A.
066560     SET DX TO T-INSTR.
066580*    SUM TOTAL LENGTH OF CREATE ITEMS FOR LATER BUFF ALLOCATION
066600     ADD D-NCHAR (DX) TO NCHAR.
066620     GO TO CREATE2A.
066640 CREATE2B.
066660*    FCHAR IS THE TOTAL STORAGE NEEDED FOR ALL BUFFERS
066680*
066700*    DISABLE CREATE FROM AFFECTING ANY PART OF DYNAMIC STORAGE
066720*    AS IT WILL NOW STORE DIRECTLY INTO ITS PRIVATE FD BUFFER.
066740*
066760*    IF FCHAR < PRIMARY-LENGTH ADD PRIMARY-LENGTH TO FCHAR.
066780*    IF FCHAR < SECONDARY-LENGTH ADD SECONDARY-LENGTH TO FCHAR.
066800*    IF FCHAR < TERTIARY-LENGTH ADD TERTIARY-LENGTH TO FCHAR.
066820*    MOVE FCHAR TO CREATE-ORIGIN.
066840     MOVE 1 TO CREATE-ORIGIN.
066860*    MOVE FCHAR TO F-ORIGIN (FX).
066880     MOVE 1 TO F-ORIGIN (FX).
066882*    USE THE LARGEST OF ANY MULTIPLE CREATE LIST(PER STAGE)
066884*    AS THE CREATE LENGTH.
066886     IF NCHAR > F-RECLEN (FX)
066900        MOVE NCHAR TO F-RECLEN (FX).
066920     MOVE ZEROS TO F-BLKLEN (FX).
066940     MOVE ZEROS TO F-KEYLOC (FX).
066960     MOVE ZEROS TO F-KEYLEN (FX).
066980     MOVE F-RECLEN (FX) TO CREATE-LENGTH.
067000*    ADD CREATE-LENGTH TO FCHAR.
067020     GO TO VERB-CONTROL.
067040 DISPLAY1.
067060     GO TO PRINT1.
067080 DISPLAYOFF1.
067100*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
067120     GO TO VERB-RESET.
067140 DISPLAYON1.
067160*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
067180     GO TO VERB-RESET.
067200 FIND1.
067220*    HERE FOR MULTIPLE INPUT FILE FIND
067240     IF FLAG-PASS = 2 GO TO FIND2.
067260     IF FLAG-VERB = 2 GO TO FIND1A.
067280     IF FLAG-VERB = 3 GO TO FIND1B.
067300 FIND10.
067320     IF FLAG-ALPHA = ZERO GO TO E003.
067340     IF TYPEV NOT EQUAL TO TYPE-VARIABLE GO TO E003.
067360     IF VA = V-FROM GO TO E004.
067380     SET INSTR (X) TO FX. SET HX TO X. SET HX DOWN BY 1.
067400     SET X UP BY 1. SET INSTR (X) TO 5.
067420     SET X UP BY 1. SET INSTR (X) TO DX.
067440     SET PI TO DX.
067460     MOVE 2 TO FLAG-VERB.
067480     GO TO VERB-CONTROL.
067500 FIND1A.
067520     IF VA NOT EQUAL TO V-EQUAL GO TO E004.
067540     MOVE 3 TO FLAG-VERB.
067560     IF VP = V-NEXT
067570        SET X UP BY 1 MOVE VP TO INSTR (X) 
067572        else
067580     SET INSTR (X) TO DX.
067600     GO TO VERB-CONTROL.
067620 FIND1B.
067640     IF VA = V-FROM GO TO VERB-CONTROL.
067660     IF VA NOT EQUAL TO V-BEGINNING GO TO FIND10.
067680     SET PX TO X. SET X TO HX.
067700     SET INSTR (X) TO V-FINDFROM.
067720     SET X TO PX.
067740     GO TO VERB-RESET.
067760 FIND2.
067780     IF T-INSTR = V-EOS GO TO VERB-CONTROL.
067800     IF T-INSTR NOT = 0 GO TO FIND2B.
067820*    HERE ONLY FOR BAD FIND SYNTAX THAT HAS ALREADY BEEN
067840*    REPORTED ON IN PASS 1--READ OVER TILL HIT EOS.
067860 FIND2A.
067880     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
067900     IF T-INSTR NOT = V-EOS GO TO FIND2A.
067920     GO TO VERB-CONTROL.
067940 FIND2B.
067960     SET PN TO X.
067980     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068000     SET HX TO X.
068020     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068040     SET DX TO T-INSTR.
068060     MOVE D-FCHAR (DX) TO NCHAR.
068080     IF NCHAR = ZEROS 
068082        SET KX TO DX  MOVE K-ENDKEY (KX) TO WORD30
068084        MOVE 1 TO ECODE
068086        PERFORM E-RROR THRU E-XIT
068088        GO TO FIND2A.
068100     MOVE 3 TO VA.
068120     IF NCHAR < TERTIARY-ORIGIN MOVE 2 TO VA.
068140     IF NCHAR < SECONDARY-ORIGIN MOVE 1 TO VA.
068160     IF VA = 3  IF TERTIARY-ORIGIN = -1
068180        MOVE 2 TO VA.
068200     IF N-INPUTFILES = 1 MOVE 1 TO VA.
068220     IF VA = 1
068240        MOVE 'legal only for DBMS/ISAM--' TO WORD30
068260        MOVE 52 TO ECODE  PERFORM E-RROR THRU E-XIT
068270        GO TO FIND2A.
068280     IF VA = 2
068300        MOVE 'SECONDARY ' TO WORD18
068320        SET FX TO FX-SECONDARY.
068340     IF VA = 3
068360        MOVE 'TERTIARY ' TO WORD18
068380        SET FX TO FX-TERTIARY.
068400     IF FX = 1 GO TO E009.
068420     MOVE F-TYPEV (FX) TO TYPEV.
068440     IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
068460     MOVE ZEROS TO T-INSTR.
068480     IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
068500     IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
068520     IF VA = 2 AND TYPEV = 26 MOVE 7 TO T-INSTR.
068540     IF VA = 2 AND TYPEV = 27 MOVE 8 TO T-INSTR.
068560     IF VA = 3 AND TYPEV = 26 MOVE 13 TO T-INSTR.
068580     IF VA = 3 AND TYPEV = 27 MOVE 14 TO T-INSTR.
068600     IF T-INSTR = ZEROS GO TO E009.
068620     IF F-KEYLOC (FX) NOT EQUAL TO ZERO ADD 2 TO T-INSTR.
068640     SET PX TO X.
068660     SET X TO PN. SET INSTR (X) TO FX.
068680     SET X TO HX. SET INSTR (X) TO T-INSTR.
068700     SET X TO PX.
068702     perform get-one-instr thru get-instrx.
068704*    if do not have a 4th arg, then user has error.
068706     if t-instr = 0
068707        move 49 to ecode move spaces to word30
068708        perform e-rror thru e-xit
068710        move 50 to ecode
068712        move 'record-next-dataname-value' to word30
068714        perform e-rror thru e-xit    go to verb-control.
068716     if t-instr = v-next  set x down by 1.
068720 FIND2C.
068740     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068760     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
068780     GO TO FIND2C.
068800 FINDDBMS1.
068820     IF FLAG-PASS = 2 GO TO FINDDBMS2.
068840     IF FLAG-ALPHA = ZERO GO TO E003.
068850     MOVE 1 TO FLAG-FIND.
068860     IF FLAG-VERB = 2 GO TO FINDDBMS1A.
068880     IF FLAG-VERB = 3 GO TO FINDDBMS1B.
068900     IF FLAG-VERB = 4 GO TO FINDDBMS1C.
068920     IF FLAG-VERB = 5 GO TO FINDDBMS1D.
068940     SET INSTR (X) TO FX.
068960     SET X UP BY 1. SET INSTR (X) TO N-RSE.
068980     SET HX TO X.
069000     SET X UP BY 1. SET INSTR (X) TO VA.
069020     SET X UP BY 1. SET INSTR (X) TO DX.
069040     IF N-RSE = 4
069060        SET X UP BY 1 SET INSTR (X) TO DX
069070        MOVE 4 TO FLAG-VERB
069080        ELSE MOVE 3 TO FLAG-VERB.
069082     IF N-RSE = 5 MOVE 4 TO FLAG-VERB.
069084     IF N-RSE NOT = 2 GO TO VERB-CONTROL.
069086*    SET ITEM AS A SET NAME AS PER PARA FINDDBMS1C.
069088     IF VA NOT = 0
069090        SET RX TO DX    MOVE -20 TO R-AREA-SET (RX) 
069092        GO TO VERB-CONTROL.
069094     MOVE 0 TO INSTR (X).
069096     SET X UP BY 1.  SET INSTR (X) TO DX.
069098     IF VAA = V-RUN-UNIT 
069100        MOVE VAA TO INSTR (X)  GO TO VERB-CONTROL.
069102     MOVE 4 TO FLAG-VERB.
069104     GO TO VERB-CONTROL.
069120 FINDDBMS1A.
069140     MOVE 3 TO FLAG-VERB.
069160     IF N-RSE = 2 OR N-RSE = 3 OR N-RSE = 4
069180        GO TO VERB-CONTROL.
069200     IF VA = V-FINDRECORD AND N-RSE = ZEROS
069220        MOVE 5 TO N-RSE.
069240     SET X TO HX. SET INSTR (X) TO V.
069260     SET X UP BY 1. SET INSTR (X) TO FX.
069280     SET X UP BY 1. SET INSTR (X) TO N-RSE.
069300     SET X UP BY 1. SET INSTR (X) TO N-RSE.
069310     IF N-RSE = 5  MOVE 0 TO INSTR (X).
069320     SET X UP BY 1. SET INSTR (X) TO DX.
069330     IF N-RSE = 5   GO TO FINDDBMS1C.
069340     IF N-RSE = 1 SET INSTR (X) TO PI.
069360     SET X UP BY 1. SET INSTR (X) TO DX.
069380     MOVE 5 TO FLAG-VERB.
069400     GO TO VERB-CONTROL.
069420 FINDDBMS1B.
069440     SET INSTR (X) TO DX.
069442     IF N-RSE = 3
069444        SET RX TO DX  MOVE VA TO R-AREA-SET (RX).
069460     MOVE 4 TO FLAG-VERB.
069480     GO TO VERB-CONTROL.
069500 FINDDBMS1C.
069510     IF VAA = V-RUN-UNIT GO TO FINDDBMS1D.
069520     IF VA < -20 OR VA > -18 GO TO E004.
069540     SET RX TO DX.
069560     MOVE VA TO R-AREA-SET (RX).
069562     IF N-RSE = 5
069564        SET X UP BY 1  MOVE 0 TO INSTR (X).
069580     MOVE 5 TO FLAG-VERB.
069600     GO TO VERB-CONTROL.
069620 FINDDBMS1D.
069622     IF VAA = V-RUN-UNIT
069624        MOVE VAA TO INSTR (X)  MOVE 0 TO VAA  GO TO VERB-CONTROL.
069640     IF NOT SUPPRESS-CONDITION GO TO FINDDBMS1C.
069660     SET X UP BY 1. ADD 100  VA GIVING INSTR (X).
069680     GO TO VERB-CONTROL.
069700 FINDDBMS2.
069720     IF FX-PRIMARY = 1 MOVE 'DBMS ' TO WORD18 GO TO E009.
069740     SET INSTR (X) TO FX-PRIMARY.
069742     MOVE 0 TO I.
069760 FINDDBMS2A.
069780     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
069800     ADD 1 TO I.
069820     IF I < 5 GO TO FINDDBMS2A.
069822     IF T-INSTR = 0 GO TO VERB-RESET.
069824     GO TO FINDDBMS2A.
069840 FINDFIRST1.
069860     GO TO VERB-CONTROL.
069880 FIND-FROM1.
069900     IF FLAG-PASS = 2 GO TO FIND2.
069920     GO TO E005.
069940 FINDKEY1.
069960     IF FLAG-PASS = 2 GO TO FINDKEY2.
069980     IF VP = V-EOF GO TO FINDKEY1C.
070000     IF FLAG-VERB = 2 GO TO FINDKEY1A.
070020     IF FLAG-VERB = 3 GO TO FINDKEY1B.
070040     MOVE 2 TO FLAG-VERB.
070060     IF VP NOT EQUAL TO V-EQUAL GO TO E004.
070080     SET X UP BY 1. SET INSTR (X) TO FX.
070100     SET X UP BY 1. SET INSTR (X) TO X.
070120     IF VA < 1 OR VA > 3 GO TO E008.
070140     IF VA = 1 MOVE 1 TO FLAG-RANDOM-READ1.
070160     IF VA = 2 MOVE 1 TO FLAG-RANDOM-READ2.
070180     IF VA = 3 MOVE 1 TO FLAG-RANDOM-READ3.
070200     SET X UP BY 1. SET INSTR (X) TO VA.
070220     MOVE ZEROS TO VA.
070240     GO TO VERB-CONTROL.
070260 FINDKEY1A.
070280     IF VA = V-THRU OR VA = V-TO GO TO E006.
070300     SET KX TO DX. SET HX TO KX.
070320     IF TYPEV = TYPE-LITERAL
070340        MOVE TYPE-SINGLE-KEY TO K-TYPEV (KX).
070360     SET INSTR (X) TO KX.
070380     MOVE ZEROS TO VA.
070400     MOVE 3 TO FLAG-VERB.
070420     GO TO VERB-CONTROL.
070440 FINDKEY1B.
070460     IF TYPEV NOT EQUAL TO TYPE-LITERAL GO TO E005.
070480     IF VA = V-THRU OR VA = V-TO GO TO FINDKEY1B1.
070500     GO TO FINDKEY1A.
070520 FINDKEY1B1.
070540     SET KX TO LX.
070560     MOVE K-STARTKEY (KX) TO WORD30.
070580     SET KX TO HX.
070600     MOVE TYPE-THRU-KEY TO K-TYPEV (KX).
070620     IF VA = V-TO MOVE TYPE-TO-KEY TO K-TYPEV (KX).
070640     MOVE WORD30 TO K-ENDKEY (KX).
070660     SET DX-LOWEST UP BY 1. SET X DOWN BY 1.
070680     MOVE ZEROS TO VA.
070700     MOVE 2 TO FLAG-VERB.
070720     GO TO VERB-CONTROL.
070740 FINDKEY1C.
070760     IF VA NOT EQUAL TO V-THRU GO TO E004.
070780     SET KX TO HX.
070800     MOVE TYPE-THRU-KEY TO K-TYPEV (KX).
070820     MOVE HIGH-VALUES TO K-ENDKEY (KX).
070840     GO TO VERB-RESET.
070860 FINDKEY2.
070880     SET PN TO X.
070900     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
070920     SET HX TO X.
070940     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
070960     SET VA TO T-INSTR.
070980     IF VA = 1 SET FX TO FX-PRIMARY.
071000     IF VA = 2 SET FX TO FX-SECONDARY.
071020     IF VA = 3 SET FX TO FX-TERTIARY.
071040     MOVE F-TYPEV (FX) TO TYPEV.
071060     IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
071080     IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
071100     IF VA = 2 AND TYPEV = 26 MOVE 5 TO T-INSTR.
071120     IF VA = 2 AND TYPEV = 27 MOVE 6 TO T-INSTR.
071140     IF VA = 3 AND TYPEV = 26 MOVE 9 TO T-INSTR.
071160     IF VA = 3 AND TYPEV = 27 MOVE 10 TO T-INSTR.
071180     SET INSTR (X) TO T-INSTR.
071200 FINDKEY2A.
071220     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
071240     IF FX = 1 GO TO E018.
071260     IF F-KEYLOC (FX) = ZEROS GO TO E018.
071280     IF T-INSTR NOT EQUAL TO ZEROS GO TO FINDKEY2A.
071300     SET PX TO X.
071320     SET X TO PN. SET INSTR (X) TO FX.
071340     SET X TO HX.
071360     SET PX UP BY 1. SET INSTR (X) TO PX.
071380     SET PX DOWN BY 1. SET X TO PX.
071400     GO TO VERB-CONTROL.
071420 FINDLAST1.
071440     GO TO VERB-CONTROL.
071460 FINDNEXT1.
071480     GO TO VERB-CONTROL.
071500 FINDOWNER1.
071520     GO TO VERB-CONTROL.
071540 FINDPRIOR1.
071560     GO TO VERB-CONTROL.
071580 FORM-LINES1.
071600     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
071620     IF FLAG-ALPHA = 1 GO TO E002.
071640     IF NUMBN < 1 GO TO E008.
071660     SET INSTR (X) TO NUMBN.
071680     GO TO VERB-RESET.
071700 GOTO1.
071720     IF FLAG-PASS = 2 GO TO GOTO2.
071740     IF FLAG-ALPHA = 1 GO TO E002.
071760     IF NUMBN < 00 OR NUMBN > 99 GO TO E008.
071780     SET X UP BY 1. SET INSTR (X) TO DX.
071800     MOVE TYPE-GOTO TO D-TYPEV (DX).
071820     MOVE NUMBN TO D-NCHAR (DX).
071840     MOVE 1 TO FLAG-GOTO.
071860     GO TO VERB-RESET.
071880 GOTO2.
071900     SET DX TO T-INSTR.
071920*    FOR STATEMENT #S, D-SCALE IS THE ASSIGNED ADDRESS WITHIN
071940*    THE INSTR TABLE OF THE STATEMENT NUMBER.
071960     IF D-SCALE (DX) = ZEROS
071980        MOVE 'STATEMENT NUMBER' TO WORD30
072000        MOVE D-NCHAR (DX) TO WORD30-STNUMB
072020        GO TO E001.
072022     IF X = SORT-GOTO-X + 9 MOVE V-GOTO TO INSTR(SORT-GOTO-X)
072024         MOVE T-INSTR TO INSTR(SORT-GOTO-X + 1).
072040     GO TO VERB-CONTROL.
072060 GOTO3.
072080*    GET HERE VIA PERFORM AFTER 2ND PASS IS COMPLETED.
072100     IF FLAG-GOTO = ZERO GO TO GOTO3X.
072120     SET HX TO X. SET X TO X-START. SET X DOWN BY 1.
072140 GOTO3A.
072160     IF X > HX GO TO GOTO3X.
072180     SET X UP BY 1. IF INSTR (X) = ZEROS GO TO GOTO3A.
072200     SET V TO INSTR (X).
072220     IF V NOT EQUAL TO V-GOTO GO TO GOTO3B.
072240     SET X UP BY 1.
072260*    IF GOTO PARAMETER IS > DX-MAX, THEN WE HAVE AN INTERNALLY
072280*    GENERATED GOTO(VIA ELSE2) AND WE MERELY SUBTRACT
072300*    DX-MAX FROM GOTO PARAMETER AND GET CORRECT GOTO ADDRESS
072320     IF INSTR (X) > DX-MAX
072340         SUBTRACT DX-MAX FROM INSTR (X)  GO TO GOTO3A.
072360     SET DX TO INSTR (X).
072380     SET INSTR (X) TO D-SCALE (DX).
072400     GO TO GOTO3A.
072420 GOTO3B.
072440     IF X > HX GO TO GOTO3X.
072460     SET X UP BY 1. IF INSTR (X) = ZEROS GO TO GOTO3A.
072480     GO TO GOTO3B.
072500 GOTO3X.    EXIT.
072520 GOTONR1.
072540     GO TO VERB-RESET.
072560 GOTOQT1.
072580     MOVE 1 TO FLAG-CREATE-LOOP.
072600     GO TO VERB-RESET.
072620 GOTOXT1.
072640     MOVE 1 TO FLAG-CREATE-LOOP.
072660     GO TO VERB-RESET.
072680 HEADINGOFF1.
072700*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
072720     GO TO VERB-RESET.
072740 HEADINGON1.
072760*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
072780     GO TO VERB-RESET.
072800 HOLD1.
072820     IF FLAG-PASS = 2 GO TO HOLD2.
072840     IF FLAG-ALPHA = ZERO GO TO E003.
072860     IF TYPEV = TYPE-TODAY GO TO E003.
072880     IF TYPEV = TYPE-XRANDOM GO TO E003.
072900     SET INSTR (X) TO DX.
072920     MOVE WORD30 TO HWORD30. MOVE HELD-WORD30 TO WORD30.
072940     PERFORM DROP-IN-DX THRU DIDX.
072960     SET X UP BY 1. SET INSTR (X) TO DX.
072980     GO TO VERB-CONTROL.
073000 HOLD2.
073020     SET DX TO T-INSTR.
073040     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
073060     SET VX TO T-INSTR.
073080*    MAKE THE HELD. ENTRY (VX) LOOK BASICALLY LIKE
073100*    SOURCE OR HOLD ENTRY (DX) INCLDG TYPE,NC,SCALE
073120     MOVE D-ENTRY (DX) TO V-ENTRY (VX).
073140     SET DX TO VX.
073142     MOVE D-TYPEV (DX) TO TYPEV.
073144*    FOR HELD SPECIAL ITEMS, CHANGE TYPE TO ALPHA OR NUM (BINARY?)
073146     IF TYPEV = 24 OR TYPEV = 32 OR TYPEV = 35
073148        MOVE 2 TO D-TYPEV (DX).
073150     IF TYPEV = 33 OR  34 OR  36  MOVE 1 TO D-TYPEV (DX).
073160     MOVE FCHAR TO D-FCHAR (DX).
073180     IF TYPEV = TYPE-BINARY
073200        IF D-NCHAR (DX) < 11 ADD 6 TO FCHAR ELSE ADD 12 TO FCHAR
073220           ELSE ADD D-NCHAR (DX) TO FCHAR.
073240     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
073260     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
073280     GO TO HOLD2.
073300 HSPACE1.
073320     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
073340     IF FLAG-ALPHA = 1 GO TO E002.
073360     IF NUMBN < 0 GO TO E008.
073380     MOVE NUMBN10 TO T-NUMBN.
073400     ADD 1 TO T-NUMBN.
073420     MULTIPLY T-NUMBN BY MINUS-ONE GIVING T-NUMBN.
073440     SET INSTR (X) TO T-NUMBN.
073460     GO TO VERB-RESET.
073480 IF1.
073500     IF FLAG-PASS = 2 GO TO IF2.
073520*    BUG OUT IF NOT THE FIRST TIME AS ARGS ARE BEING
073540*    INSERTED BY VERB-CONTROL.
073560     IF FLAG-IF = 1 GO TO VERB-CONTROL.
073580     MOVE 1 TO FLAG-IF.
073600*    IF JUST READ 'NOT' (INDICATED BY VP-NOT = 1), THEN
073620*    FLAG-NOT IS ALREADY SET, OTHERWISE SET FLAG-NOT TO
073640*    SAVED FLAG-NOT PERTINENT THE CURRENT PAREN LEVEL.
073660     IF VP-NOT = 1 OR N-OPENLPS = 0 NEXT SENTENCE
073680        ELSE MOVE NOTT (N-OPENLPS) TO FLAG-NOT.
073700     SET INSTR (X) TO X.
073720     SET X UP BY 1. SET INSTR (X) TO X.
073740*    SET ( INTO INSTR TABLE FOR EACH CONSECUTIVE ( FOUND.
073760 IF1A.
073780     IF LPARENCNTR = 0 GO TO IF1B.
073800     SUBTRACT 1 FROM LPARENCNTR.
073820     SET X UP BY 1.
073840     MOVE V-LPAREN TO INSTR (X).
073860     GO TO IF1A.
073880 IF1B.
073940     SET X UP BY 1 MOVE DX-IFLEFTSIDE TO INSTR (X).
073960     IF FLAG-NOT = 0 GO TO IF1C.
073980*    FOR RELATIONALS THAT ARE PRECEEDED BY NOT, REVERSE THE RELATIO
074000     IF VA = V-EQUAL        MOVE V-NOTEQUAL TO VA GO TO IF1C.
074020     IF VA = V-NOTEQUAL     MOVE V-EQUAL TO VA GO TO IF1C.
074040     IF VA = V-LESS         MOVE V-GREATEREQUAL TO VA GO TO IF1C.
074060     IF VA = V-GREATER      MOVE V-LESSEQUAL TO VA GO TO IF1C.
074080     IF VA = V-LESSEQUAL    MOVE V-GREATER TO VA GO TO IF1C.
074100     IF VA = V-GREATEREQUAL MOVE V-LESS TO VA GO TO IF1C.
074120     GO TO E029.
074140 IF1C.
074160     SET X UP BY 1. SET INSTR (X) TO VA.
074180     SET X UP BY 1. SET INSTR (X) TO DX.
074200*    IF JUST READ 'NOT', FLIP IT BACK TO GLOBAL PAREN STATE.
074220     IF VP-NOT = 0 GO TO VERB-CONTROL.
074240     MOVE 0 TO VP-NOT.
074260     IF FLAG-NOT = 1 MOVE 0 TO FLAG-NOT
074280        ELSE MOVE 1 TO FLAG-NOT.
074300     GO TO VERB-CONTROL.
074320 IF2.
074340*    IF VERB HAS BEEN READ AND STORED AND X IS POINTING
074360*    TO THE NEXT INSTR ENTRY (TRUEGO).
074380*    IF2 WILL STACK THE TRUE AND FALSE ADDRESS AND THEN
074400*    READ THE ENTIRE IF LIST ENDED BY 0
074420     PERFORM DROP-IN-TRUEGO THRU DITGOX.
074440     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074460     PERFORM DROP-IN-FALSEGO THRU DIFGOX.
074461*    read/save left of relational.
074462 IF2-1.
074463     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074464     IF T-INSTR = V-LPAREN
074466        PERFORM LPAREN2 THRU LPAREN2X  GO TO IF2-1.
074467     SET DX TO T-INSTR. SET LEFT-DX TO DX.
074468     MOVE D-TYPEV (DX) TO LEFT-TYPE.
074470     MOVE D-NCHAR (DX) TO LEFT-LEN.
074472     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074474*    NOW READ RIGHT SIDE OF RELATIONAL
074480 IF2A.
074500     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074520     IF T-INSTR = V-LPAREN
074540        PERFORM LPAREN2 THRU LPAREN2X  GO TO IF2A.
074542     IF T-INSTR = 0 GO TO IF2B.
074544     SET DX TO T-INSTR.
074546     MOVE D-TYPEV (DX) TO RIGHT-TYPE.
074548     MOVE D-NCHAR (DX) TO RIGHT-LEN.
074550     IF LEFT-TYPE = TYPE-VARIABLE GO TO IF2A-3.
074552     IF RIGHT-TYPE NOT = TYPE-VARIABLE GO TO IF2A.
074554*    HERE FOR DN:VAR
074556     IF LEFT-LEN < RIGHT-LEN GO TO IF2A.
074558 IF2A-1.
074560     MOVE LEFT-LEN TO D-NCHAR (DX)  D-ECHAR (DX).
074562 IF2A-2.
074564     IF FCHAR = 0 MOVE 1 TO FCHAR.
074565     MOVE FCHAR TO D-FCHAR (DX).
074566     ADD D-NCHAR (DX) TO FCHAR.
074567     GO TO IF2A.
074568 IF2A-3.
074569*    HERE FOR VAR:VAR AND VAR:DN
074570     IF RIGHT-TYPE = TYPE-VARIABLE GO TO IF2A-5.
074571*    HERE FOR VAR:DN
074572     IF LEFT-LEN > RIGHT-LEN GO TO IF2A.
074573 IF2A-4.
074574     SET DX TO LEFT-DX.
074575     MOVE RIGHT-LEN TO D-NCHAR (DX)  D-ECHAR (DX).
074576     GO TO IF2A-2.
074577 IF2A-5.
074578*    HERE FOR VAR:VAR
074579     IF RIGHT-LEN = 0 AND LEFT-LEN = 0 GO TO IF2A.
074580     IF LEFT-LEN > RIGHT-LEN GO TO IF2A-1.
074581     GO TO IF2A-4.
074584*    HAVE HIT END OF IF LIST--SEE IF THIS IS FOLLOWED BY
074600*    ANOTHER IF OR A VERB LIST
074620 IF2B.
074640     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074660     IF T-INSTR = V-THEN GO TO IFTHEN2.
074680     IF T-INSTR = V-AND  GO TO IFAND2.
074700     IF T-INSTR = V-OR   GO TO IFOR2.
074720     IF T-INSTR = V-RPAREN
074740        PERFORM RPAREN2 THRU RPAREN2X  GO TO IF2B.
074760     IF T-INSTR = V-EOS  
074762        MOVE 'PERHAPS DUE TO OTHER ERRORS,AN' TO WORD30
074764        GO TO E039.
074780     IF T-INSTR = 0      GO TO E022.
074800*    HERE FOR VERB WITHOUT THEN OR IF WITHOUT AND/OR
074820*    ACT AS THOUGH 'THEN' WERE READ AND THEN BACK UP READ
074840     PERFORM POPALL-TRUE THRU POPALLTX.
074860     SET LI DOWN BY 1.
074880     SET X DOWN BY 1.
074900     GO TO VERB-CONTROL.
074920 IFTHEN1.
074940     GO TO VERB-CONTROL.
074960 IFTHEN2.
074980*    POP ALL TRUE STACK AND DELETE 'THEN' FROM INSTR
075000*    TABLE BY DECREMENTING X
075020     PERFORM POPALL-TRUE THRU POPALLTX.
075040 IFTHEN2A.
075060*    READ OVER THE NOP FOLLOWING -THEN- AND ILLIMINATE
075080*    -THEN-NOP- FROM INSTR
075100     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
075120     IF T-INSTR = 0 SET X DOWN BY 2
075140        ELSE GO TO E022.
075160     GO TO VERB-CONTROL.
075180 IFAND2.
075200*    POP TOP (IE LAST) TRUE AND DELETE 'AND' AND ITS
075220*    TRAILING V-NOP FROM INSTR TABLE BY DECREMENTING X
075240     PERFORM POP-TRUE THRU POPTX.
075260     IF RPARENCNTR = 0 GO TO IFAND3.
075280     IF N-TRUEGO = 0
075300        MOVE 0 TO RPARENCNTR  SUBTRACT 1 FROM LPARENCNTR
075320        GO TO IFAND3.
075340*    POP TRUE STACK TILL FIND SAME X-TRUEGO AS INDICATED
075360*    BY TOP OF TRUE-LPAREN STACK.
075380*    REPEAT THIS SEARCHING-POPPING RPARENCNTR TIMES.
075400     IF TRUE-LPAREN (TLPX) < POPPED-X GO TO IFAND2.
075420     IF TRUE-LPAREN (TLPX) > POPPED-X GO TO IFAND2A.
075440     SUBTRACT 1 FROM TLPX.
075460 IFAND2A.
075480     SUBTRACT 1 FROM RPARENCNTR.
075500     SUBTRACT 1 FROM LPARENCNTR.
075520     IF RPARENCNTR GREATER THAN 0 GO TO IFAND2.
075540 IFAND3.
075560     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
075580     IF T-INSTR NOT = 0 GO TO E022.
075600     SET X DOWN BY 2.
075620     GO TO VERB-CONTROL.
075640 IFOR2.
075660*    POP TOP (IE LAST) FALSE AND DELETE 'OR' FROM INSTR TABLE
075680*    BY DECREMENTING X.
075700     PERFORM POP-FALSE THRU POPFX.
075720     IF RPARENCNTR = 0 GO TO IFAND3.
075740     IF N-FALSEGO = 0
075760        MOVE 0 TO RPARENCNTR  SUBTRACT 1 FROM LPARENCNTR
075780        GO TO IFAND3.
075800*    POP FALSE STACK SIMILIAR TO 'AND' ABOVE.
075820     IF FALSE-LPAREN (FLPX) < POPPED-X GO TO IFOR2.
075840     IF FALSE-LPAREN (FLPX) > POPPED-X GO TO IFOR2A.
075860     SUBTRACT 1 FROM FLPX.
075880 IFOR2A.
075900     SUBTRACT 1 FROM RPARENCNTR.
075920     SUBTRACT 1 FROM LPARENCNTR.
075940     IF RPARENCNTR GREATER THAN 0 GO TO IFOR2.
075960     GO TO IFAND3.
075980 IFELSE1.
076000     IF FLAG-PASS = 2 GO TO IFELSE2.
076020     GO TO VERB-CONTROL.
076040 IFELSE2.
076060*    REPLACE ELSE AND V-NOP INSTR ENTRIES WITH GOTO N, WHERE
076080*    N WILL BE ASSIGNED LATER.
076100*    NEXT, POP FALSE STACK TO POINT TO NEXT INSTR ENTRY
076120*    (START OF ELSE LIST).
076140     SET X DOWN BY 1.
076160     MOVE V-GOTO TO INSTR (X).
076180*    TEMPORALLY, SET X UP 1 BEYOND GOTO/N ENTRIES TO ENABLE
076200*    POP FALSE TO SET TO POINT TO ENTRY FOLLOWING CURRENT ENTRY.
076220     SET X UP BY 2.
076240     PERFORM POPALL-FALSE THRU POPALLFX.
076260     SET X DOWN BY 1.
076280     SET ELSE-X TO X.
076300     GO TO VERB-CONTROL.
076320 IFANY1.
076340     GO TO IF1.
076360 IFFIRST1.
076380     GO TO IF1.
076400 IFLAST1.
076420     GO TO IF1.
076440 IFNEXT1.
076460     GO TO IF1.
076480 IFSAME1.
076500     GO TO IF1.
076520 IFBOF1.
076540     GO TO IFFIRSTIME1.
076560 IFBOF2.
076580     GO TO IFFIRSTIME1.
076600 IFBOF3.
076620     GO TO IFFIRSTIME1.
076720 IFEOF1.
076740     GO TO IFFIRSTIME1.
076760 IFEOF2.
076780     GO TO IFFIRSTIME1.
076800 IFEOF3.
076820     GO TO IFFIRSTIME1.
076840 IFLASTIME1.
076860     GO TO IFFIRSTIME1.
076880 IFFIRSTIME1.
076900     IF FLAG-PASS = 2 GO TO IFFIRSTIME2.
076913*    should only come here once for each use--otherwise
076914*     a verb is missing and got here because v was not
076916*    reset by a new verb
076917     if flag-verb = 2  go to e005.
076918     move 2 to flag-verb.
076919     MOVE 1 TO FLAG-IF.
076920     SET X UP BY 1.
076940     IF VP-NOT = 1 OR N-OPENLPS = 0 NEXT SENTENCE
076960        ELSE MOVE NOTT (N-OPENLPS) TO FLAG-NOT.
076980     MOVE FLAG-NOT TO INSTR (X).
077000     SET X UP BY 1.  SET INSTR (X) TO X.
077020     SET X UP BY 1.  SET INSTR (X) TO X.
077040*    SET ( INTO INSTR TABLE FOR EACH CONSECUTIVE ( FOUND.
077060 IFFIRSTIME1A.
077080     IF LPARENCNTR = 0 GO TO IFFIRSTIME1B.
077100     SUBTRACT 1 FROM LPARENCNTR.
077120     SET X UP BY 1.
077140     MOVE V-LPAREN TO INSTR (X).
077160     GO TO IFFIRSTIME1A.
077180 IFFIRSTIME1B.
077200     IF VP-NOT = 0 GO TO VERB-CONTROL.
077220     MOVE 0 TO VP-NOT.
077240     IF FLAG-NOT = 1 MOVE 0 TO FLAG-NOT
077260        ELSE MOVE 1 TO FLAG-NOT.
077280     GO TO VERB-CONTROL.
077300 IFFIRSTIME2.
077320     MOVE INSTR (X) TO FLAG-NOT.
077340     SET X DOWN BY 1.
077360     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077380*    IF NOT CONDITION IS SET, THEN REVERSE TRUE/FALSE
077400     IF FLAG-NOT = 1
077420        PERFORM DROP-IN-FALSEGO THRU DIFGOX
077440        PERFORM GET-ONE-INSTR THRU GET-INSTRX
077460        PERFORM DROP-IN-TRUEGO THRU DITGOX
077480        GO TO IFFIRSTIME2A.
077500     PERFORM DROP-IN-TRUEGO THRU DITGOX.
077520     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077540     PERFORM DROP-IN-FALSEGO THRU DIFGOX.
077560 IFFIRSTIME2A.
077580     IF FLAG-IFFIRST = 0 GO TO IF2A ELSE MOVE 0 TO FLAG-IFFIRST.
077600*    GET GROUP ITEM entry for if newgroup(if there is one)
077620 IFFIRSTIME2B.
077640     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077660     IF T-INSTR = 0 GO TO IF2B.
077670     if t-instr = v-lparen
077672        perform lparen2 thru lparen2x  go to iffirstime2b.
077680*    NEXT GET PRIOR VALUE ENTRY AND MODIFY ITS ORIGIN
077700     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077720     PERFORM ASSIGN-PRIOR-ORIGIN THRU ASSIGN-PRIORX.
077740     GO TO IFFIRSTIME2B.
077760 IFNEWGROUP1.
077780     IF FLAG-PASS = 2  MOVE 1 TO FLAG-IFFIRST GO TO IFFIRSTIME2.
077800*    INDICATE TO IQE THAT PREV RECORD MUST BE SAVED
077820     MOVE 1 TO SUMBREAK-FLAG.
077840     IF FLAG-ALPHA = ZERO GO TO E003.
077860*    BUG OUT IF NOT FIRST TIME HERE AS ARGS ARE BEING
077880*    STORED BY VERB-CONTROL.
077900     IF FLAG-IF = 1
077920        MOVE 1 TO FLAG-IFFIRST
077940        PERFORM ALLOCATE-ACCUM-BUCKETS THRU ALLOC-ACCX
077960        MOVE 0 TO FLAG-IFFIRST
077980        GO TO VERB-CONTROL.
078000     MOVE 1 TO FLAG-IF.  
078020     GO TO IFFIRSTIME1.
078040 IFNEWPAGE1.
078060     GO TO IFFIRSTIME1.
078080 INVALID-KEY1.
078100     GO TO VERB-CONTROL.
078120 INVOKE1.
078140     IF FLAG-PASS = 2 GO TO INVOKE2.
078160     IF FLAG-VERB = 2 GO TO INVOKE1A.
078180     GO TO VERB-CONTROL.
078200 INVOKE1A.
078220     GO TO VERB-RESET.
078240 INVOKE2.
078260     GO TO VERB-CONTROL.
078280 LMARGIN1.
078300     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
078320     IF FLAG-ALPHA = 1 GO TO E002.
078340     IF NUMBN < 1 GO TO E008.
078360     SET INSTR (X) TO NUMBN.
078380     GO TO VERB-RESET.
078400 LPAREN2.
078420     ADD 1 TO LPARENCNTR.
078440     ADD 1 TO TLPX.
078460*    STORE CURRENT VALUE OF TOP OF TRUE STACK
078480     MOVE X-TRUEGO (TSX) TO TRUE-LPAREN (TLPX).
078500*    DO SAME FOR FALSE PARENS
078520     ADD 1 TO FLPX.
078540     MOVE X-FALSEGO (FSX) TO FALSE-LPAREN (FLPX).
078560     SET X DOWN BY 1.
078580 LPAREN2X.  EXIT.
078600 RPAREN2.
078620     ADD 1 TO RPARENCNTR.
078640     IF RPARENCNTR GREATER THAN LPARENCNTR 
078642        MOVE 010 TO ECODE  PERFORM E-RROR THRU E-XIT.
078660*    ILLIMINATE ) AND FOLLOWING V-NOP FROM INSTR TABLE
078680     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
078700     SET X DOWN BY 2.
078720 RPAREN2X.  EXIT.
078740 MAXIMUM1.
078760     IF FLAG-PASS = 2
078780        MOVE '*WARNING-MAXIMUM STATEMENT' TO WORD30
078800        GO TO TALLY2.
078820     GO TO TALLY1.
078840 MINIMUM1.
078860     IF FLAG-PASS = 2
078862        MOVE '*WARNING-MINIMUM STATEMENT' TO WORD30  GO TO TALLY2.
078864     GO TO TALLY1.
078880 NEWPAGE1.
078900*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
078920     GO TO VERB-RESET.
078940 OPEN1.
078960     IF FLAG-PASS = 2 GO TO OPEN2.
078980     IF FLAG-ALPHA = ZERO GO TO E003.
079000     IF TYPEV = TYPE-LITERAL AND FLAG-VERB = 0
079020        GO TO E001.
079040     IF TYPEV = TYPE-LITERAL AND FLAG-VERB = 1
079060        SET L-NCHAR (LX) TO FX
079080        MOVE 0 TO FLAG-VERB GO TO VERB-CONTROL.
079100     SET X DOWN BY 1.
079120     MOVE 1 TO FLAG-VERB.
079140     SET FX TO DX. MOVE TYPE-FILE TO F-TYPEV (FX).
079160     ADD 1 TO N-INPUTFILES. IF N-INPUTFILES > 3 GO TO E005.
079180*    OPEN1 SETS FX-PRIMARY,FX-SEC,FX-TERT DEPENDING ON
079200*    WHICH ENTRY WE ARE COMING INTO OPEN1 WITH
079220     IF N-INPUTFILES = 1 SET FX-PRIMARY TO FX GO TO OPEN1A.
079240     IF N-INPUTFILES = 2 SET FX-SECONDARY TO FX.
079260     IF FX-SECONDARY = FX-PRIMARY GO TO E038.
079280     IF N-INPUTFILES = 2 GO TO OPEN1A.
079300     SET FX-TERTIARY TO FX.
079320     IF FX-TERTIARY = FX-PRIMARY GO TO E038.
079340     IF FX-TERTIARY = FX-SECONDARY GO TO E038.
079360 OPEN1A.
079380     MOVE 1 TO FLAG-CREATE-LOOP.
079400     GO TO VERB-CONTROL.
079420 OPEN2.
079440*    FIRST CHECK FOR FILE READ PROTECT
079460     MOVE 0 TO FILENO.
079480 OPEN2A.
079500     ADD 1 TO FILENO.
079520     IF FILENO = 1 SET FX TO FX-PRIMARY.
079540     IF FILENO = 2 SET FX TO FX-SECONDARY.
079560     IF FILENO = 3 SET FX TO FX-TERTIARY.
079580     MOVE FD-RPROT (FILENO) TO TEST-REF-NO.
079600     PERFORM UNLOCKER THRU UNLOCKER-EXIT.
079620     IF FLAG-LOCKED NOT = 1 GO TO OPEN2A2.
079622*    HERE IF USER HAS NOT FURNISHED PROPER PASSWORDS FOR FILE
079624*    ACCESS EITHER THRU AUTHORITY OR A PREVIOUS PROMPTING
079626*    POSSIBILITY IN RDICT-DD6
079627     MOVE 'FILE ACCESS' TO ITEM-OR-FILE.
079628     IF FLAG-PW-OPEN = 0
079629        MOVE 1 TO FLAG-PW-OPEN
079630        PERFORM PASSWORD-PROMPTER THRU PROMPTX.
079631     IF N-PROMPTS = 0 GO TO OPEN2A1.
079632     MOVE PROMPT-PW-POINTER TO PW-LIST.
079634     MOVE N-PROMPTS TO N-PW.
079636     PERFORM UNLOCKER THRU UNLOCKER-EXIT.
079638     IF FLAG-LOCKED NOT = 1 GO TO OPEN2A2.
079640 OPEN2A1.
079650     MOVE FD-NAMEPROT (FILENO) TO WORD30. MOVE 14 TO ECODE.
079660     PERFORM E-RROR THRU E-XIT.
079670 OPEN2A2.
079680     IF FILENO LESS THAN N-INPUTFILES GO TO OPEN2A.
079700*    SEE IF FILE SPECS ARE TO BE MODIFIED
079720     MOVE 1 TO FLAG-OPENARGS.
079740     IF T-INSTR = 0   MOVE 0 TO FLAG-OPENARGS GO TO OPEN2B.
079760     PERFORM PROCESS-OPEN-ARGS THRU PROCESS-OPEN-ARGSX.
079780     MOVE ZERO TO INSTR (X).
079800 OPEN2B.
079820     IF FLAG-RANDOM-READ1 = 1 GO TO OPEN2C.
079840     SET X UP BY 1. SET INSTR (X) TO V-READ.
079860     MOVE V-ASCENDING TO T-INSTR.
079880     SET FX TO FX-PRIMARY.
079900     SET X UP BY 1. SET INSTR (X) TO FX.
079920     IF F-TYPEV (FX) = 27 ADD 1 TO T-INSTR.
079940*    IS THIS INDEXED SEQUENTIAL?
079960     IF F-KEYLOC (FX) NOT = 0 ADD 2 TO T-INSTR.
079980     SET X UP BY 1. SET INSTR (X) TO T-INSTR.
080000     SET X UP BY 1. SET INSTR (X) TO ZEROS.
080020 OPEN2C.
080040     IF FLAG-OPENARGS = 0  GO TO VERB-CONTROL.
080060 OPEN2D.
080080     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
080100     IF T-INSTR = 0 GO TO VERB-CONTROL.
080120     PERFORM PROCESS-OPEN-ARGS THRU PROCESS-OPEN-ARGSX.
080140     MOVE V-OPEN TO INSTR (X).
080160     IF N-INPUTFILES = 3  IF FX = FX-SECONDARY
080180        SET X UP BY 1  MOVE 0 TO INSTR (X).
080200     GO TO OPEN2D.
080220 PROCESS-OPEN-ARGS.
080240*    PROCESS THE OPEN ARGUMENT (WHICH IS A FILENAME SPECIFICATION
080260*    LITERAL--PROCESS BY MODIFYING THE F-ID ACCDG TO LITERAL.
080280     SET LX TO T-INSTR.
080300     MOVE L-VALUE (LX) TO QUOTE-TABLE.
080320     SET FX TO LX.  SET FX UP BY 1.
080340     PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
080360     MOVE FD-LABEL TO F-ID (FX).
080380 PROCESS-OPEN-ARGSX.  EXIT.
080400 PAGE1.
080420     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
080440     IF FLAG-ALPHA = 0
080460        IF NUMBN < 0 GO TO E008.
080480     SET INSTR (X) TO DX.
080500     GO TO VERB-RESET.
080520 PAGINGOFF1.
080540*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
080560     GO TO VERB-RESET.
080580 PAGINGON1.
080600*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
080620     GO TO VERB-RESET.
080640 PAGE-LINES1.
080660     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
080680     IF FLAG-ALPHA = 1 GO TO E002.
080700     IF NUMBN < 1 GO TO E008.
080720     SET INSTR (X) TO NUMBN.
080740     GO TO VERB-RESET.
080760 PICTURE1.
080780     IF FLAG-PASS = 2 GO TO PICTURE2.
080800     IF FLAG-VERB = 2 GO TO PICTURE1A.
080820*    FOR FLAG-VERB = 3, WE ARE ENTERING PICTURE1 VIA A MULTI
080840*    LIST DESIGNATION(IE PICTURE DN=LIT,DN1=LIT1,... AND SINCE
080860*    THERE IS ONLY 1 PICTURE VERB, AND WE ARE ON THE 2ND OR
080880*    BEYOND DN, WE MISSED PUTTING IN THE ACTUAL 2ND ETC OCCURENCE
080900*    OF PICTURE--BACK UP AND DO IT NOW.
080920     IF FLAG-VERB = 3 SET X DOWN BY 1
080940        PERFORM DROP-IN-VERB THRU DIVX SET X UP BY 1.
080960     MOVE 2 TO FLAG-VERB.
080980     IF FLAG-ALPHA = ZERO GO TO E003.
081000     SET INSTR (X) TO DX.
081020     GO TO VERB-CONTROL.
081040 PICTURE1A.
081060     MOVE 1 TO FLAG-VERB.
081080     IF VA NOT EQUAL TO V-EQUAL GO TO E004.
081100     IF TYPEV NOT EQUAL TO TYPE-LITERAL
081120        GO TO E015.
081140     IF Q > 20 GO TO E016.
081150     MOVE SPACES TO L-ENTRY (LX).
081160     SET DX-LOWEST UP BY 1.
081180     EXAMINE QUOTE-TABLE TALLYING ALL '.'.
081200     IF TALLY > 1 GO TO E021.
081220     EXAMINE QUOTE-TABLE TALLYING ALL 'S'.
081240     IF TALLY > 1 GO TO E021.
081260     SET INSTR (X) TO QUOTEN (1).
081280     SET X UP BY 1. SET INSTR (X) TO QUOTEN (2).
081300     SET X UP BY 1. SET INSTR (X) TO QUOTEN (3).
081320     SET X UP BY 1. SET INSTR (X) TO QUOTEN (4).
081340     MOVE 3 TO FLAG-VERB.
081360     GO TO VERB-CONTROL.
081380 PICTURE2.
081400     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081420*    MAKE SURE THE DATANAME IS FOLLOWED BY A PICTURE.
081440*    IF T-INSTR = 0
081460*       MOVE 'CHECK SYNTAX FOR DN = LITERAL' TO WORD30
081480*       GO TO E021.
081500     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081520     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081540     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081560     GO TO VERB-CONTROL.
081580 PRINT1.
081600     IF FLAG-PASS = 2 GO TO PRINT2.
081620     IF FLAG-VERB = 1 AND V = V-PRINT GO TO PRINT1A.
081640     IF FLAG-ALPHA = 1 SET INSTR (X) TO DX
081660        GO TO VERB-CONTROL.
081680     MOVE NUMBN10 TO T-NUMBN.
081700     IF T-NUMBN = V-CONCAT MOVE MINUS-ONE TO T-NUMBN.
081720     IF T-NUMBN < 0 MOVE ZEROS TO T-NUMBN.
081740     ADD 1 TO T-NUMBN.
081760     MULTIPLY T-NUMBN BY MINUS-ONE GIVING T-NUMBN.
081780     SET INSTR (X) TO T-NUMBN.
081800     GO TO VERB-CONTROL.
081820 PRINT1A.
081840     SET INSTR (X) TO CONST1. SET X UP BY 1.
081860     SET INSTR (X) TO CONST1. SET X UP BY 1.
081880     SET INSTR (X) TO CONST1. SET X UP BY 1.
081900     MOVE 2 TO FLAG-VERB.
081920     GO TO PRINT1.
081940 PRINT2.
081942     IF T-INSTR = 0 MOVE 'Print statement' TO WORD30 GO TO E046.
081944 PRINT2A.
081960     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081980     IF T-INSTR = ZERO GO TO VERB-CONTROL.
082000     GO TO PRINT2A.
082020 PRINTOFF1.
082040*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
082060     GO TO VERB-RESET.
082080 PRINTON1.
082100*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
082120     GO TO VERB-RESET.
082140 DISPLAY-DICT.
082160     SET DX TO DX-MAX. SET DX UP BY 1.
082180 DISP-DICT-LOOP.
082200     SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO DISPLAY-DICTX.
082220     DISPLAY '*DICT*DX=' DX ' ' D-TITLE1 (DX) ' ' D-TITLE2 (DX)
082240             ' ' D-TYPEV (DX) ' ' D-FCHAR (DX) ' '
082260             D-NCHAR (DX) UPON CONSOLE.
082280     GO TO DISP-DICT-LOOP.
082300 DISPLAY-DICTX.  EXIT.
082320 QUERY1.
082340*    HERE FROM VERB-CONTROL DISPATCH WHEN V=1=ALL
082360*    STATEMENTS READ
082380*    SET UP  -GO TO NR- AND STOP
082400     IF FLAG-QUERY = ZERO MOVE 'EMPTY QUERY' TO WORD30
082420        MOVE 9 TO FLAG-PASS GO TO E005.
082440     IF FLAG-PASS = 2 GO TO QUERY2.
082460     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
082480     MOVE ZERO TO FLAG-EOS.
082500     SET X UP BY 1.  MOVE V-EOS TO INSTR (X).
082520     SET X UP BY 1. MOVE V-GOTONR TO INSTR (X).
082540     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
082560     SET X UP BY 1. MOVE V-STOP TO INSTR (X).
082580*    DISPLAY 'END OF FIRST PASS' UPON CONSOLE.
082600     CLOSE QCSTMT.
082620*    IF N-INPUTFILES = 0 THEN HAVE NO OPEN STATEMENT
082640     IF N-INPUTFILES = ZERO 
082642        IF FLAG-SORT = 0  MOVE 1 TO FCHAR  GO TO QUERY1A
082644           ELSE
082646           MOVE 51 TO ECODE  PERFORM E-RROR THRU E-XIT
082648           GO TO QUERY1A.
082660     MOVE ZEROS TO PROJ8,USER8.
082680     MOVE 'QPDICTSEQ' TO FD-INLABEL WORD30.
082700*    SEE IF DICTIONARY IS AROUND
082720     ENTER MACRO IQLOOK USING
082740        DEVICER,FD-INLABEL,PROJ8,USER8,I.
082760     IF I NOT EQUAL TO -1 GO TO E009.
082780*    COMPLETE DICT SPECS FOR ALL DICT ITEMS IN DICTIONARY
082800*    COMPLETE DYN DICT WITH SUCH INFO AS:
082820*    FD--PPN,ID,DEVICE,TYPE,BUFFER,ORIGINS,LENGTHS,RL,BL
082840*    DD--ALL DICT INFO INCLDG SCALE,NC,FC,REPEATS,ETC.
082860     PERFORM READ-DICT THRU RDICTX.
082880 QUERY1A.
082900     IF REPORT-DX = 1 MOVE 1 TO NUMBN
082920        PERFORM REPORT1A THRU REPORT1X.
082940*    NOW INITIALIZE CERTAIN DICT SPECS FOR VARIABLES ETC
082960*    FOR ALPHA VAR: ECHAR=SCALE=FCHAR=0
082980*    FOR NUM VAR  : FCHAR=0; ECHAR=13,NCHAR=18,SCALE=0
083000     PERFORM DX-CLEANUP THRU DUPX.
083020     PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT.
083040     MOVE QTANLZTMP TO QCSTMTTMP.
083060*    GET DUMP FILE WHEN DUMP FLAG IS ON
083080     IF FLAG-DUMP = 1 MOVE 'IQDUMPTMP' TO QTANLZTMP
083100        PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083120        MOVE QCSTMTTMP TO QTANLZTMP.
083140     MULTIPLY DX BY LI-MAX GIVING DX.
083160     IF DX < X GO TO E012.
083180     MOVE 2 TO FLAG-PASS.  MOVE 0 TO FLAG-CREATE.
083200     SET LI TO LI-MAX.
083220     SET X TO ZEROS.
083240*    IF FLAG-ERROR NOT EQUAL TO ZEROS GO TO QTANLZ-DAS-ENDE.
083260     MOVE SPACE TO WORD30.
083280     OPEN INPUT QTANLZ.
083300     GO TO VERB-CONTROL.
083320 QUERY2.
083340     SET EOF1-X TO X. SET EOF1-X DOWN BY 1.
083360     CLOSE QTANLZ.
083380     SET HX TO 1.
083400 QUERY2A.
083420*    CLEAN OUT OLD JUNK IN INSTR TABLE LEFT OVER FROM WHEN
083440*    INSTR TABLE SHRUNK DURING PASS2.
083460     SET X UP BY 1. IF INSTR (X) NOT EQUAL TO ZEROS
083480        MOVE V-NOP TO INSTR (X) SET HX TO 1 GO TO QUERY2A.
083500     IF HX < 6 SET HX UP BY 1 GO TO QUERY2A.
083520     PERFORM DX-CLEANUP THRU DUPX.
083540     PERFORM GOTO3 THRU GOTO3X.
083560     PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT.
083600*    FOR FINAL VERSION, ONLY PUT OUT A DUMP FILE
083620*    IF DUMP FLAG IS ON IE =1
083640     IF FLAG-DUMP = 1
083642        MOVE 'IQDUMPTMP' TO QTANLZTMP
083660        PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083662        MOVE QCSTMTTMP TO QTANLZTMP.
083700     IF FLAG-SAVE = 1 AND QRY-NAME NOT EQUAL TO SPACE
083702        MOVE QRY-NAME TO QTANLZTMP
083720        PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083722        MOVE QCSTMTTMP TO QTANLZTMP.
083740     MULTIPLY DX BY LI-MAX GIVING DX.
083760     IF DX < X GO TO E012.
083780     IF FLAG-CREATE-LOOP = 0
083800        MOVE 'NEED OPEN OR GO TO XT/QT' TO WORD30
083820        MOVE 24 TO ECODE
083840        PERFORM E-RROR THRU E-XIT.
083860     GO TO QTANLZ-DAS-ENDE.
083880 READ1.
083900     GO TO VERB-CONTROL.
083920 RESET1.
083940     IF FLAG-PASS = 2 GO TO RESET2.
083960     IF FLAG-ALPHA = ZERO GO TO E003.
083980     IF TYPEV = TYPE-TODAY GO TO E003.
084000     IF TYPEV = TYPE-XRANDOM GO TO E003.
084020     SET INSTR (X) TO DX.
084040     GO TO VERB-CONTROL.
084060 RESET2.
084080     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
084100     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
084120     GO TO RESET2.
084122 REOPEN1.
084124     IF FLAG-PASS = 1 GO TO VERB-CONTROL.
084126*    NOW CHANGE INSTR TO BE V-OPEN FOLLOWED BY NOP
084128     SET X DOWN BY 1.
084130     MOVE V-OPEN TO INSTR (X).
084132     SET X UP BY 1.
084134     GO TO VERB-CONTROL.
084140 REPORT1.
084160     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084180     IF FLAG-ALPHA = 1 GO TO E002.
084200     IF NUMBN < 1 OR NUMBN > 99 GO TO E008.
084220     PERFORM REPORT1A THRU REPORT1X.
084240     SET INSTR (X) TO DX.
084260*    SET INSTR (X) TO NUMBN.
084280*    IF NUMBN > NUMB-REPORTS MOVE NUMBN TO NUMB-REPORTS.
084300     GO TO VERB-RESET.
084320 REPORT1A.
084340     SET DX-LOWEST DOWN BY 1. SET DX TO DX-LOWEST.
084360     SET REPORT-DX TO DX.
084380     MOVE REPORT-R-AREA TO D-ENTRY (DX).
084400     MOVE NUMBN       TO D-NCHAR (DX).
084420     IF NUMBN > NUMB-REPORTS MOVE NUMBN TO NUMB-REPORTS.
084440 REPORT1X.    EXIT.
084460 REWRITE1.
084480     IF FLAG-PASS = 2 GO TO rewrite2.
084482     move 1 to va.
084484     if flag-eos = 1 go to rewrite1a.
084486     perform get-word thru get-wordx.
084488     if word06 not = 'RECORD' move 1 to flag-peeked.
084490     if word12 = 'RECORD2' MOVE 4 to va.
084492     if word12 = 'RECORD3' MOVE 7 to va.
084494 rewrite1a.
084496     set x up by 1.
084498     move va to instr (x).
084500     go to verb-control.
084502 rewrite2.
084504     if T-INSTR = 1 set fx to fx-primary else if
084506        T-INSTR = 4 set fx to fx-secondary else if
084508        T-INSTR = 7 set fx to fx-tertiary.
084510     IF F-KEYLEN (FX) = 0
084512        move 018 to ecode
084514        MOVE 'FOR A REWRITE VERB' TO WORD30
084516        perform e-rror thru e-xit
084518        GO TO VERB-RESET.
084520*    NOW SAVE FIRST ARG(1,4,OR 7 INDICATING PRIMARY,2ND,TERT), MODIFY IT
084521*    TO INCLUDE 6-BIT OR 7-BIT, AND  INSERT IT AS THE SECOND ARG.
084522*    MAKE THE FIRST ARG BE  AN FX POINTER.
084523*    ALSO, SET I/O FLAG IN F-ENTRY TO INDICATE OPEN I-O
084524     MOVE 'O' TO F-OPENIO (FX).
084526     SET INSTR (X) TO FX.
084528     SET X UP BY 1.
084530     IF F-TYPEV (FX) = 27 ADD 1 TO T-INSTR.
084532     MOVE T-INSTR TO INSTR (X).
084534     GO TO VERB-RESET.
084540 RMARGIN1.
084560     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084580     IF FLAG-ALPHA = 1 GO TO E002.
084600     IF NUMBN < 1 GO TO E008.
084620     SET INSTR (X) TO NUMBN.
084640     GO TO VERB-RESET.
084660 RPTDATE1.
084680     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084700     SET INSTR (X) TO DX.
084720     GO TO VERB-RESET.
084740 RPTDATEON1.
084760*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
084780     GO TO VERB-RESET.
084800 RPTDATEOFF1.
084820*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
084840     GO TO VERB-RESET.
084860 RPTHEAD1.
084880     IF FLAG-PASS = 2 GO TO RPTHEAD2.
084900     GO TO PRINT1.
084920 RPTHEAD2.
084922     if t-instr = 0
084924        move 'heading syntax error:' to word30
084925        MOVE 15 TO ECODE
084926        perform e-rror thru e-xit
084928        go to verb-control.
084940     SET HX TO X.
084960     SET X UP BY 1. SET INSTR (X) TO T-INSTR.
084980 RPTHEAD2A.
085000     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
085020     IF T-INSTR NOT EQUAL TO ZEROS GO TO RPTHEAD2A.
085040     SET PX TO X. SET X TO HX.
085060     SET PX UP BY 1. SET INSTR (X) TO PX.
085080     SET PX DOWN BY 1. SET X TO PX.
085100     GO TO VERB-CONTROL.
085120 RPTHEADON1.
085140*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
085160     GO TO VERB-RESET.
085180 RPTHEADOFF1.
085200*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
085220     GO TO VERB-RESET.
085240 SET1.
085260     IF FLAG-PASS = 2 GO TO SET2.
085280     IF FLAG-VERB = 2 GO TO SET1A.
085300     MOVE 2 TO FLAG-VERB.
085320     IF FLAG-ALPHA = ZERO GO TO E003.
085340*    TYPEV: SET BY DROP-IN-DX AND IS TYPE OF OBJECT
085360*           CLEARED BY GET-VERB
085380*    NOW CHECK TO SEE IF TRYING TO ILLEGALLY SET VALUE OF
085400*    LITERAL-TODAY-XRANDOM--THEN SAVE SAVE LEFT SIDE
085420*    OF 'TO' TO BE SET LATER
085440     IF TYPEV = TYPE-LITERAL GO TO E007.
085500     SET T-INSTR TO DX.
085520     SET X DOWN BY 1.
085540     GO TO VERB-CONTROL.
085560 SET1A.
085580*    HERE FOR SETTING LEFT AND RIGHT SIDE OF 'TO'
085600     IF VA NOT EQUAL TO V-TO GO TO E004.
085620     SET INSTR (X) TO DX.
085640*    T-INSTR CONTAINS LEFT OF 'TO'
085660     SET X UP BY 1. SET INSTR (X) TO T-INSTR.
085680     MOVE ZEROS TO VA.
085700*    FLAG-VERB=1 ALLOWS MULTIPLE LIST FOR SET AND CAUSES
085720*    US TO DO SET1 STUFF NEXT TIME WE HIT SET
085740     MOVE 1 TO FLAG-VERB.
085760     GO TO VERB-CONTROL.
085780 SET2.
085800*   HERE DURING 2ND PASS-V-SET HAS BEEN READ INTO INSTR(X)
085820*   AS HAS ITS FIRST ARG, THE RIGHT SIDE OF 'TO' (SOURCE)
085840*   WHICH HAS ALSO BEEN STORED INTO T-INSTR
085860*   X POINTS TO 1ST ARG ENTRY OF INSTR TABLE
085880     SET VX TO T-INSTR.
085890     IF T-INSTR = 0 GO TO SET2D.
085900     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
085920     IF T-INSTR = ZEROS GO TO SET2D.
085940     SET DX TO T-INSTR.
085960     MOVE D-TYPEV (DX) TO TYPEV.
085980     IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO SET2A.
086000     IF TYPEV = TYPE-VARIABLE GO TO SET2A.
086020     GO TO SET2C.
086040 SET2A.
086060*    GET HERE WHEN LEFT SIDE IS A VAR OR NUM VAR
086080*    COMPARE LENGTHS OF LEFT SIDE(DX) WITH RIGHT SIDE(VX)
086100*    NUM VAR (TYPE 7) WOULD HAVE BEEN INITIALIZED TO 18
086120*    ALP VAR (TYPE12) WOULD HAVE BEEN INITIALIZED TO 0
086140     IF D-NCHAR (DX) > V-NCHAR (VX) GO TO SET2C.
086160*    IF THE NCHAR OF THE VARIABLE ON THE LEFT HAS BEEN SET
086180*    BY A PREVIOUS SET STATEMENT AND NOW MUST BE RESET TO
086200*    A LARGER NCHAR, THEN THE FCHAR WILL ALSO BE RESET TO
086220*    BE A NEW ALLOCATION, OTHERWISE WE MIGHT OVERLAP SOME
086240*    INTERMEDIATE ALLOCATIONS.
086260     MOVE V-NCHAR (VX) TO NCHAR.
086280     MOVE NCHAR TO D-NCHAR (DX).
086300     MOVE NCHAR TO D-ECHAR (DX).
086320     IF V-TYPEV (VX) = TYPE-LITERAL GO TO SET2B.
086340*    MOVE V-TYPEV (VX) TO D-TYPEV (DX).
086360     MOVE V-SCALE (VX) TO D-SCALE (DX).
086380     MOVE V-PICT (VX) TO D-PICT (DX).
086400     MOVE V-ECHAR (VX) TO D-ECHAR (DX).
086420 SET2B.
086440     MOVE FCHAR TO D-FCHAR (DX). ADD NCHAR TO FCHAR.
086460 SET2C.
086480*    FOR VARIABLES, FCHAR = 0 IF THEY HAVENT BEEN SET YET
086500*    SET FCHAR NOW
086520     IF D-FCHAR (DX) = ZEROS
086540        MOVE D-NCHAR (DX) TO NCHAR GO TO SET2B.
086560     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
086580     IF T-INSTR = ZEROS GO TO VERB-CONTROL.
086600     GO TO SET2.
086602 SET2D.
086604     MOVE 'SET VERB' TO WORD30. MOVE 043 TO ECODE.
086606     PERFORM E-RROR THRU E-XIT.
086608     GO TO VERB-CONTROL.
086620 SORT1.
086640     IF FLAG-PASS = 2 GO TO SORT2.
086660     IF FLAG-ALPHA = ZERO GO TO E003.
086680     IF FLAG-VERB = 2 GO TO SORT1A.
086700     MOVE 2 TO FLAG-VERB.
086720*    ALLOW CREATE TO BE USED AGAIN FOR THIS NEW STAGE
086740     MOVE 0 TO FLAG-CREATE.
086760     MOVE ZEROS TO T-INSTR.
086780     IF DX = FX-PRIMARY MOVE 1 TO T-INSTR.
086800     IF DX = FX-SECONDARY MOVE 2 TO T-INSTR.
086820     IF DX = FX-TERTIARY MOVE 3 TO T-INSTR.
086840     SET INSTR (X) TO T-INSTR.
086860     IF VA NOT EQUAL TO V-DESCENDING
086880        MOVE V-ASCENDING TO VA.
086900     MOVE 1 TO FLAG-SORT.
086920     IF T-INSTR NOT EQUAL TO ZEROS GO TO VERB-CONTROL.
086940     SET INSTR (X) TO 1. SET X UP BY 1.
086960 SORT1A.
086980     MULTIPLY DX BY VA GIVING T-INSTR.
087000     SET INSTR (X) TO T-INSTR.
087020     GO TO VERB-CONTROL.
087040 SORT2.
087042     IF T-INSTR = V-NOP GO TO SORT2C.
087060     MOVE ZEROS TO NCHAR FLAG-CREATE N-SKEYS.
087080 SORT2A.
087100     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
087120*    ARE WE AT END OF SORT KEY LIST?
087140     IF T-INSTR NOT = ZEROS GO TO SORT2AA.
087142     IF N-SKEYS = 0 GO TO SORT2C.
087144     GO TO SORT2B.
087146 SORT2AA.
087148     ADD 1 TO N-SKEYS.
087150     IF T-INSTR = V-EOS GO TO SORT2C.
087160*       MOVE NCHAR TO F-RECLEN (FX) GO TO SORT2B.
087180     SET DX TO T-INSTR.
087200     IF DX < 1 MULTIPLY DX BY V-DESCENDING GIVING DX.
087220     ADD D-NCHAR (DX) TO NCHAR.
087240     GO TO SORT2A.
087260 SORT2B.
087262     SET X UP BY 1.
087264*		SAVE X FOR THE IMPLICIT GO TO NR *
087266*		SO THAT IF WE GET A GO TO NN *
087268*		FOLLOWING IT, WE CAN NOP THE GO TO NR *
087270     SET SORT-GOTO-X TO X.
087272     MOVE V-GOTONR TO INSTR (X).
087300     PERFORM POPALL-FALSE THRU POPALLFX.
087302    SET X UP BY 1. MOVE V-NOP TO INSTR(X).
087304     SET X UP BY 1. MOVE V-NOP TO INSTR(X).
087320     SET X UP BY 1. MOVE V-STOP TO INSTR (X).
087340     SET X UP BY 1. MOVE V-READ TO INSTR (X).
087360     SET X UP BY 1. MOVE FX-PRIMARY TO INSTR (X).
087380     SET X UP BY 1. MOVE V-ASCENDING TO INSTR (X).
087400     SET X UP BY 1. MOVE V-NOP TO INSTR (X).
087420     GO TO VERB-RESET.
087422 SORT2C.
087424*    HERE WHEN SORT STATEMENT HAS NO DESIGNATED SORT KEYS
087426     MOVE 'SORT STATEMENT HAS' TO WORD30.
087428     GO TO E046.
087440 STATEMENT1.
087460     IF FLAG-PASS = 2 GO TO STATEMENT2.
087480     SET V TO V-GOTO.
087500     PERFORM DROP-IN-DX THRU DIDX.
087520     MOVE TYPE-GOTO TO D-TYPEV (DX).
087540     MOVE NUMBN TO D-NCHAR (DX).
087560*    SCALE CONTAINS LOCATION OF STATEMENT NUMBER IN INSTR TABLE
087580     SET D-SCALE (DX) TO X.
087600     SET X UP BY 1. SET INSTR (X) TO DX.
087620     GO TO VERB-RESET.
087640 STATEMENT2.
087660     SET DX TO T-INSTR.
087680     SET X DOWN BY 1.
087700     MOVE X TO D-SCALE (DX).
087720     SET X DOWN BY 1.
087740     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
087760*    IF T-INSTR NOT EQUAL TO ZEROS GO TO E000.
087780     SET X DOWN BY 1.
087800     GO TO VERB-CONTROL.
087820 SUMMARYOFF1.
087840*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
087860     GO TO VERB-RESET.
087880 SUMMARYON1.
087900*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
087920     GO TO VERB-RESET.
087940 ASSIGN-PRIOR-ORIGIN.
087960*    MODIFY ORIGIN OF PRIOR SUMMARY BUCKET+RESTORE TYPE
087980     SET DX TO T-INSTR.
088000     MOVE FCHAR TO D-FCHAR (DX).
088020     ADD D-NCHAR (DX) TO FCHAR.
088040     SUBTRACT 50 FROM D-TYPEV (DX).
088060 ASSIGN-PRIORX.  EXIT.
088080 ALLOCATE-ACCUM-BUCKETS.
088100     IF FLAG-VERB = 2 MOVE 1 TO SUMBREAK-FLAG
088120        SUBTRACT 1 FROM DX-LOWEST  SET DX TO DX-LOWEST
088140        SET KX TO DX  MOVE WORD30 TO K-ENDKEY (KX)
088160        MOVE TYPE-PRIOR-SUMMARY TO D-TYPEV (DX)
088180        MOVE 2 TO D-NREPEATS (DX)
088200        SET X UP BY 1  SET INSTR (X) TO DX
088220        ELSE
088240        MOVE 0 TO PREV-BUCKETDX  MOVE 0 TO CURR-BUCKETDX
088260        MOVE 0 TO FLAG-BY.
088280     IF FLAG-IFFIRST = 1 GO TO ALLOC-ACCX.
088300     MOVE 2 TO FLAG-VERB.
088320     SUBTRACT 1 FROM DX-LOWEST.  SET DX TO DX-LOWEST.
088340     SET X UP BY 1.  SET INSTR (X) TO DX.
088360 ALLOC-ACCX.  EXIT.
088380 TALLY1.
088400     IF FLAG-PASS = 2
088420        MOVE '*WARNING-TALLY STATEMENT' TO WORD30   GO TO TALLY2.
088440     IF FLAG-ALPHA = ZERO GO TO E003.
088442*    CATCH CASE OF 'TALLY BY ITEM' NOW.
088443*    CASE OF 'TALLY.' CAUGHT IN 2ND PASS.
088444     IF (FLAG-VERB = 1  AND  FLAG-BY = 1)
088445        MOVE 'FOR SUMMARY VERB' TO WORD30
088446        MOVE 046 TO ECODE  PERFORM E-RROR THRU E-XIT.
088460     IF VA = V-LPAREN  IF FLAG-SUMMARY-DEF-TIME = 0
088480        SET X UP BY 1  MOVE VA TO INSTR (X)
088500        GO TO VERB-CONTROL.
088520     IF VA = V-LPAREN IF FLAG-SUMMARY-DEF-TIME = 1
088540        MOVE 0 TO FLAG-SUMMARY-DEF-TIME
088560        GO TO VERB-CONTROL.
088580     IF VA = V-RPAREN
088600        SET X UP BY 1  MOVE VA TO INSTR (X)
088620        MOVE 0 TO VA   GO TO VERB-CONTROL.
088640     PERFORM ALLOCATE-ACCUM-BUCKETS THRU ALLOC-ACCX.
088660*    SAVE BUCKET POINTERS FOR POSSIBLE SUMMARY ITEM DEF USE
088680     IF CURR-BUCKETDX NOT = 0
088700        MOVE CURR-BUCKETDX TO PREV-BUCKETDX.
088720     MOVE INSTR (X) TO CURR-BUCKETDX.
088740     IF V = V-AVERAGE
088760        MOVE TYPE-AVERAGE TO D-TYPEV (DX)
088780        ELSE
088800        MOVE TYPE-SUMMARY TO D-TYPEV (DX).
088820     MOVE 2 TO D-NREPEATS (DX).
088840     GO TO VERB-CONTROL.
088860 TALLY2.
088862******FORMAT OF SUMMARY AND MAX-MIN VERBS:
088864*     (X)   = INSTR VALUE = 47,48,49,80,81
088866*     (X+1) = DX OF SUMMARIZED ITEM
088868*     (X+2) = START OF SUB-GROUP TRIPLETS AS FOLLOWS:
088870*             VX OF SUMMARY BUCKET
088872*     (X+3) = DX OF BREAK ITEM
088874*     (X+4) = HX OF PRIOR VALUE
088880     IF T-INSTR = 0  
088882        move word30-fatal-part to word30  go to e046.
088900*    ABOVE IS ERROR IF NO DATA NAME FOLLOWING TALLY
088920     SUBTRACT T-INSTR FROM 0 GIVING INSTR (X).
088940     SET DX TO T-INSTR.
088941     IF V = V-TALLY GO TO TALLY2AA.
088942     perform check-numeric thru check-numericx.
088944     if ecode not = 0 
088946        MOVE 055 TO ECODE  PERFORM E-RROR THRU E-XIT.
088948 TALLY2AA.
088960     SET DX-SAVE TO DX.
088980     SET XX TO X.  ADD 2 TO XX.
089000 TALLY2A.
089020     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089040     IF T-INSTR = ZEROS GO TO TALLY2C.
089060     IF T-INSTR = V-LPAREN GO TO TALLY2B.
089080     SET VX TO T-INSTR.
089100     SET KX TO VX.
089120     MOVE K-ENDKEY (KX) TO SAVE30.
089140     MOVE D-ENTRY (DX) TO V-ENTRY (VX).
089160     MOVE SAVE30 TO K-ENDKEY (KX).
089180     MOVE TYPE-SUMMARY TO V-TYPEV (VX).
089200     MOVE ZEROS TO V-BINARY (VX).
089220     IF V = V-TALLY GO TO TALLY2A1.
089240     MOVE D-PICT (DX) TO V-PICT (VX).
089260     IF D-TYPEV (DX) = TYPE-NUMERIC-VARIABLE
089280        MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
089300     IF V = V-MINIMUM OR V = V-MAXIMUM GO TO TALLY2A2.
089320     IF V = V-AVERAGE MOVE TYPE-AVERAGE TO V-TYPEV (VX).
089340     MOVE V-PICT (VX) TO TITLE-TABLE.
089360     PERFORM TOTAL-SHIFT THRU TOTAL-SHIFTX.
089380     MOVE PPN-WORK TO V-PICT (VX).
089400     GO TO TALLY2A2.
089420 TALLY2A1.
089440     MOVE ZEROS        TO V-SCALE (VX).
089460     MOVE 8            TO V-NCHAR (VX).
089480     MOVE 8            TO V-ECHAR (VX).
089500     MOVE 8            TO V-TCHAR (VX).
089520     MOVE 'ZZZZZZZ9'   TO V-PICT (VX).
089540 TALLY2A2.
089560     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089580     IF T-INSTR = ZEROS GO TO TALLY2C.
089600     IF T-INSTR = V-LPAREN GO TO TALLY2B.
089620     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089640     IF T-INSTR = ZEROS GO TO TALLY2C.
089660     IF T-INSTR = V-LPAREN GO TO TALLY2B.
089680*    HERE FOR TYPE-PRIOR-SUMMARY--MODIFY ITS ORIGIN
089700     PERFORM ASSIGN-PRIOR-ORIGIN THRU ASSIGN-PRIORX.
089720     SET DX TO DX-SAVE.
089740     GO TO TALLY2A.
089760 TALLY2B.
089780*    DELETE V-LPAREN,VX,V-RPAREN SEQUENCE FROM INSTR TABLE
089800     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089820     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089840     IF T-INSTR NOT = V-RPAREN
089860        MOVE "MISSING RIGHT PARENTHESIS" TO WORD30  GO TO E033.
089880     SET X DOWN BY 3.
089900     GO TO TALLY2A.
089920 TALLY2C.
089940*    GET RID OF EXTRANEOUS TRAILING BUCKET IF SUB-GRP
089960     IF XX = X GO TO VERB-CONTROL.
089980     SET X DOWN BY 1.
090000     MOVE V-NOP TO INSTR (X).
090020     GO TO VERB-CONTROL.
090040 TITLES1.
090060     IF FLAG-PASS = 2 GO TO TITLES2.
090080     IF FLAG-VERB = 2 GO TO TITLES1A.
090100     IF FLAG-VERB = 3 SET X DOWN BY 1
090120        PERFORM DROP-IN-VERB THRU DIVX SET X UP BY 1.
090140     MOVE 2 TO FLAG-VERB.
090160     IF FLAG-ALPHA = ZERO GO TO E003.
090180     SET INSTR (X) TO DX.
090200     GO TO VERB-CONTROL.
090220 TITLES1A.
090240     MOVE 1 TO FLAG-VERB.
090260     IF VA NOT EQUAL TO V-EQUAL GO TO E004.
090280     IF TYPEV NOT EQUAL TO TYPE-LITERAL
090300        GO TO E015.
090320     IF Q > 22 GO TO E016.
090330     MOVE SPACES TO L-ENTRY (LX).
090340     SET DX-LOWEST UP BY 1.
090360     SET INSTR (X) TO QUOTEN (1).
090380     SET X UP BY 1. SET INSTR (X) TO QUOTEN (2).
090400     SET X UP BY 1. SET INSTR (X) TO QUOTEN (3).
090420     SET X UP BY 1. SET INSTR (X) TO QUOTEN (4).
090440     MOVE 3 TO FLAG-VERB.
090460     GO TO VERB-CONTROL.
090480 TITLES2.
090500     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090520     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090540     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090560     PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090580     GO TO VERB-CONTROL.
090600 TOTAL1.
090620     IF FLAG-PASS = 2
090640        MOVE '*WARNING-TOTAL STATEMENT' TO WORD30
090660        GO TO TALLY2.
090680     GO TO TALLY1.
090700 TOTAL-SHIFT.
090720     MOVE V-ECHAR (VX) TO ECHAR.
090740     MOVE ZEROS TO NCHAR.
090760     IF ECHAR < 19 MOVE 1 TO NCHAR.
090780     IF ECHAR < 18 MOVE 2 TO NCHAR.
090800     IF ECHAR < 17 MOVE 3 TO NCHAR.
090820     SUBTRACT V-NCHAR (VX) FROM 18 GIVING DELTA.
090840*    DELTA IS THE NUMBER OF DIGITS LESS THAN 18
090860*    NCHAR IS THE NUMBER OF DIGITS WE WISH TO EXPAND
090880*    CAN NOT EXCEED DELTA IE GO PAST 18 TOTAL DIGITS
090900     IF DELTA < NCHAR MOVE DELTA TO NCHAR.
090920     ADD NCHAR TO V-NCHAR (VX).
090940     ADD NCHAR TO V-ECHAR (VX).
090960     IF V-ECHAR (VX) > V-TCHAR (VX)
090980        MOVE V-ECHAR (VX) TO V-TCHAR (VX).
091000     SET T TO 1. SET PX TO 1.
091020     MOVE SPACES TO PPN-TABLE.
091040 TOTAL-SHIFT1.
091060*    COPY THE LEADING EDIT CHAR(EXCEPT FOR $) NCHAR TIMES
091080     MOVE TITLEX (T) TO PPN-CHAR (PX).
091100     SET PX UP BY 1. IF PX > 19 GO TO TOTAL-SHIFTX.
091120     IF TITLEX (T) = 'S' GO TO TOTAL-SHIFT2.
091140     IF NCHAR > ZEROS
091160        SUBTRACT 1 FROM NCHAR GO TO TOTAL-SHIFT1.
091180 TOTAL-SHIFT2.
091200     SET T UP BY 1. IF T > 19 GO TO TOTAL-SHIFTX.
091220     GO TO TOTAL-SHIFT1.
091240 TOTAL-SHIFTX.    EXIT.
091260 TITLESOFF1.
091280*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
091300     GO TO VERB-RESET.
091320 TITLESON1.
091340*    IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
091360     GO TO VERB-RESET.
091380 VSPACE1.
091400     IF FLAG-PASS = 2 GO TO VERB-CONTROL.
091420     IF FLAG-ALPHA = 1 GO TO E002.
091440     IF NUMBN < 1 GO TO E008.
091460     SET INSTR (X) TO NUMBN.
091480     GO TO VERB-RESET.
091500 VERB-RESET.
091520     MOVE ZEROS TO ECODE.
091540     MOVE ZEROS TO V VA VP.
091560     GO TO VERB-CONTROL.
091580 QTANLZ-WRITE.
091600     OPEN OUTPUT QTANLZ.
091620     SET DX TO 1.
091640 QTANLZ-X.
091660     MOVE D-ENTRY (DX) TO QTANLZ-REC.
091680     WRITE QTANLZ-REC.
091700*    WRITE FROM BEGINNING OF INSTR TABLE TILL FIND END OF
091720*    INSTRUCTIONS INDICATED BY ALL ZEROES--AFTER FIRST ALL
091740*    ZERO RECORD IS WRITTEN AS A MARKER FOR IQE, START
091760*    WRITING OUT FROM BOTTOM IE DICTIONARY PORTION AND
091780*    THEN COMING BACK TO MIDDLE(DX-LOWEST). IQE WILL THEN
091800*    PUT BACK IN CORRECT ORDER AS IT READS THE TABLE.
091820     IF D-TYPEV (DX) = ZEROS AND D-NCHAR (DX) = ZEROS
091840        AND D-SCALE (DX) = ZEROS AND D-ECHAR (DX) = ZEROS
091860        AND D-TCHAR (DX) = ZEROS AND D-FCHAR (DX) = ZEROS
091880        AND D-NREPEATS (DX) = ZEROS
091900        SET DX TO DX-MAX GO TO QTANLZ-DX.
091920     SET DX UP BY 1. IF DX > DX-MAX GO TO QTANLZ-CLOSE.
091940     GO TO QTANLZ-X.
091960 QTANLZ-DX.
091980     IF FLAG-PASS = 1 GO TO QTANLZ-CLOSE.
092000     MOVE D-ENTRY (DX) TO QTANLZ-REC.
092020     WRITE QTANLZ-REC.
092040     SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO QTANLZ-CLOSE.
092060     GO TO QTANLZ-DX.
092080 QTANLZ-CLOSE.
092100     CLOSE QTANLZ.
092120 QTANLZ-EXIT.    EXIT.
092140 QTANLZ-DAS-ENDE.
092180     IF FLAG-EXECUTE NOT = 1
092182        MOVE 'IQL   ' TO CALLED-NAME.
092200     IF FLAG-ERROR = 1
092220        OPEN OUTPUT QTANLZ CLOSE QTANLZ WITH DELETE
092240        MOVE 'IQL   ' TO CALLED-NAME.
092260     ENTER MACRO IQNEXT USING CALLED-NAME.
092280     STOP RUN.
092300
092320*********************************************************
092340* SUBROUTINE 'CONFIDENTIAL-ASK' TO ASK FOR A PASSWORD AND
092360* DELIVER IT IN WORKING STORAGE ITEM 'RETURNED-PASSWORD'.
092380*********************************************************
092400 CONFIDENTIAL-ASK.
092420     DISPLAY '*PASSWORD: ' UPON CONSOLE.
092440     MOVE ASCII-CR TO MASK7.
092460     MOVE '######' TO MASK1-6.
092480     DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092500     MOVE 'HHHHHH' TO MASK1-6.
092520     DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092540     MOVE 'IIIIII' TO MASK1-6.
092560     DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092580     MOVE ASCII-CR TO MASK1.
092600     DISPLAY MASK1 UPON CONSOLE WITH NO ADVANCING.
092620     ACCEPT RETURNED-PASSWORD FROM TTY.