* QPROC
* Query processor for LIST, SELECT, COUNT, etc
* Copyright (c) 2007 Ladybridge Systems, All Rights Reserved
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
* 
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
* 
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software Foundation,
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
* 
* Ladybridge Systems can be contacted via the www.openqm.com web site.
* 
* START-HISTORY:
* 27 Aug 07  2.6-0 Revised behaviour of $QUERY.DEFAULTS record.
* 21 Jun 07  2.5-7 Moved handling of 'R' and 'X' heading elements to before the
*                  point where we work out the heading width.
* 26 Apr 07  2.5-3 Sort in uppercase if QUERY.NO.CASE option set.
* 05 Mar 07  2.5-1 0544 BETWEEN was not handled in indexed queries.
* 15 Feb 07  2.4-20 Allow style record to be via R-type record.
* 18 Dec 06  2.4-17 Revised exploded lists to allow determination of associated
*                   fields when using previously generated list.
* 06 Nov 06  2.4-15 0525 OP.NOT.NULL tests failed with case insensitivity
*                   because they did not allow for additives.
* 03 Nov 06  2.4-15 Added use of QUERY.PRIORITY.AND option.
* 02 Nov 06  2.4-15 VOC/dictionary record types now case insensitive.
* 30 Oct 06  2.4-15 Added Pick implied EQ handling.
* 20 Sep 06  2.4-14 Further compatibility modifications.
* 06 Sep 06  2.4-13 Modified behaviour of REPEATING.
* 31 Aug 06  2.4-12 Overlays should apply to all prints, not just PCL.
* 29 Aug 06  2.4-12 Breakpoint compatibility improvements.
* 21 Aug 06  2.4-11 Added APPENDING mode to delimited reports.
* 19 Jul 06  2.4-10 Added support for soundex in WHEN clause.
* 19 Jul 06  2.4-10 Box indentation is now all handled in QDISP.
* 18 Jul 06  2.4-10 Added BT.DATA flag to SORTINIT modes.
* 04 Jul 06  2.4-6 Allow STYLE NONE to inhibit use of style.
* 26 Jun 06  2.4-5 0497 WHEN failed with an indexed field.
* 20 Jun 06  2.4-5 0496 Index optimisation failed with WITH X shortform.
* 31 May 06  2.4-5 Overlong V token substitution into breakpoint should
*                  truncate at column width, not run on into next.
* 15 May 06  2.4-4 Do not use the display handler for delimited reports.
* 15 May 06  2.4-4 Added REPEATING.
* 14 Apr 06  2.4-1 Force completion of source select list.
* 10 Apr 06  2.4-1 Added NO.QUERY qualifier to TO in CSV mode.
* 07 Apr 06  2.4-1 Extended use of NO.CASE to all selection operators. Also
*                  added OPTION QUERY.NO.CASE.
* 20 Mar 06  2.3-8 Use of DET.SEP should cause subtotal lines to be displayed
*                  using the detail line style.
* 16 Mar 06  2.3-8 0466 LIST file 'A' 'B' showed record A twice.
* 01 Mar 06  2.3-8 0463 AVG field NO.NULLS was not ignoring null values.
* 01 Mar 06  2.3-8 0462 USING clause did not handle multifiles.
* 21 Feb 06  2.3-6 Allow ONLY before filename for Pick compatibility.
* 09 Feb 06  2.3-6 Added OPTION(PICK.EXPLODE) handling.
* 09 Feb 06  2.3-6 Added WHEN clause pattern matching.
* 09 Feb 06  2.3-6 Added report styles.
* 30 Jan 06  2.3-5 Query optimiser should not attempt to merge A > B AND A < C
*                  if A is multivalued indexed item.
* 16 Jan 06  2.3-4 Added CSV 2 format.
* 13 Jan 06  2.3-4 0447 Recognise SAVING of a field also used in BY.EXP as a
*                  special case.
* 11 Jan 06  2.3-4 Added SREFORMAT.
* 22 Nov 05  2.2-17 Added option to direct delimited report to a file.
* 20 Oct 05  2.2-15 Added R and X column heading control codes.
* 19 Oct 05  2.2-15 Added PCL boxed reports.
* 18 Oct 05  2.2-15 Added OVERLAY option.
* 11 Oct 05  2.2-14 Added LOCKING option.
* 01 Oct 05  2.2-14 0419 Heading P option should take width qualifier and
*                   default to four characters. Also extended S to take a
*                   width qualifer (default 1) for left justification.
* 28 Sep 05  2.2-13 Don't abort if compiling I-type in read-only dictionary.
* 23 Sep 05  2.2-12 Added CSV option.
* 21 Sep 05  2.2-12 0412 Reworked implementation on COL.HDG.ID so that it
*                   affects all fields, not just those appearing after this
*                   keyword.
* 19 Sep 05  2.2-11 Added COL.HDG.ID option.
* 02 Sep 05  2.2-9 0405 Use of NO.CASE in LIKE/UNLIKE should disable use of an
*                  index.
* 30 Aug 05  2.2-9 Only honour first HEADING or FOOTING in command. Also,
*                  HDR.SUP should suppress default heading only.
* 26 Aug 05  2.2-8 0399 AK usability checks did not handle A/S type indices.
* 24 Aug 05  2.2-8 Use default date conversion in headings/footings.
* 18 Aug 05  2.2-8 0394 Must map both items being compared to uppercase when
*                  comparing case insensitive id.
* 15 Jul 05  2.2-4 Allow column headings in delimited report.
* 31 May 05  2.2-1 0364 A simple "SELECT filename" was setting deferred.select
*                  which caused unnecessary reads.
* 19 May 05  2.2-0 0357 'L' in COL.HDG not honoured correctly.
* 28 Mar 05  2.1-11 Use PARSER$MFILE.
* 17 Mar 05  2.1-10 0328 Honour special processing of \ as display name in
*                   link target definitions.
* 16 Mar 05  2.1-10 0327 Completion of A/S index support.
* 14 Mar 05  2.1-10 0324 Set item variables correctly for link to D-type item.
* 15 Feb 05  2.1-7 0316 Must choose appropriate file variable when compiling
*                  A/S/I-type as it may come from the VOC.
* 07 Feb 05  2.1-6 0314 The PICK.GRAND.TOTAL option was disabling use of the P
*                  option of the GRAND.TOTAL clause.
* 12 Jan 05  2.1-0 0298 Save old key bindings before adding our own.
* 24 Dec 04  2.1-0 Added support for A and S type items.
*                   Added special cases for field 9998 and 9999.
* 14 Dec 04  2.1-0 Added NO.CASE qualifier to LIKE clause.
* 07 Dec 04  2.1-0 Added support for C-types.
* 13 Oct 04  2.0-5 Use message handler.
* 09 Oct 04  2.0-5 COUNT was showing the wrong number of records if there was a
*                  select list active.
* 24 Sep 04  2.0-2 Added support for case insensitive record ids.
* 16 Sep 04  2.0-2 0251 SCROLL in $QUERY.DEFAULTS was not working without
*                  page count
* 16 Sep 04  2.0-1 OpenQM launch. Earlier history details suppressed.
* END-HISTORY
*
*
* Futures:
* VLIST must show associated items side by side
* Maintain @NV, @NS
*
*
* START-DESCRIPTION:
*
*    @OPTION = 1    SELECT
*              2    LIST
*              3    SSELECT
*              4    SORT
*              5    COUNT
*              6    SEARCH
*              7    LIST.LABEL
*              8    SORT.LABEL
*              9    SUM
*             10    LIST.ITEM
*             11    SORT.ITEM
*             12    SHOW
*             13    REFORMAT
*             14    SREFORMAT
*
*
*    @SYSTEM.RETURN.CODE = record count, -ve if error
*
* END-DESCRIPTION
*
* START-CODE

$internal
program qproc
$catalog $qproc

$include parser.h
$include dictdict.h
$include header.h
$include int$keys.h
$include keyin.h
$include syscom.h
$include keys.h
$include err.h
$include bcomp.h
$include pcl.h
$include qdisp.h

$define VLIST.NAME.FMT "12.L"
equ NUL to char(0)

*=============================================================================

$define MAX.STRINGS     20          ;* For SEARCH command

   prompt ""

   @system.return.code = -ER$ARGS ;* Preset for command format errors
   @selected = 0

   debugging = @false
   is.windows = system(91)
   capturing = system(1000)

   * Item tables.  One entry for each item referenced in command

   max.items = 20                    ;* Initial maximum item count
   no.items = 0                      ;* Actual number of items

   dim item.name(max.items)          ;* Token
   dim item.type(max.items)
      equ ID.ITEM      to 1          ;* Values are significant to ON GOTOs
      equ FIELD.ITEM   to 2
      equ ITYPE.ITEM   to 3
      equ LITERAL.ITEM to 4
      equ NI.ITEM      to 5          ;* Field 9998 => @NI
      equ BYTES.ITEM   to 6          ;* Field 9999 => bytes in record

   dim item.detail(max.items)        ;* Item details
                                      * ID.ITEM      : Zero
                                      * FIELD.ITEM   : Field number
                                      * ITYPE.ITEM   : Object code
                                      * LITERAL.ITEM : Literal value
                                      * NI.ITEM      : 9998 (unused)
                                      * BYTES.ITEM   : 9999 (unused)

   dim item.expression(max.items)    ;* Expression for I-type item
   dim item.fmt(max.items)           ;* Item format code...
   dim item.display.width(max.items) ;* ...Item width
   dim item.justification(max.items) ;* ...Item justification (L,R,T,U)
   dim item.left.justified(max.items) ;* ...Is it not R?
   dim item.conv(max.items)          ;* Item conversion code
   dim item.display.name(max.items)  ;* Item display name
   dim item.assoc(max.items)         ;* Association table index, 0 = unassociated
   dim item.multivalued(max.items)   ;* Item multivalued?
   dim item.breakpoint(max.items)    ;* Index to breakpoint tables, else zero
   dim item.totals(max.items)        ;* Number of TOTAL() functions in I-type
   dim item.flags(max.items)         ;* Various flags (additive values below)
      $define IFLG.COL.HDG          1     ;*   COL.HDG used
      $define IFLG.RIGHT.COL.HDG    2     ;*   Right aligned column heading
      $define IFLG.DOTLESS.COL.HDG  4     ;*   No ... fillers in headings

   synonyms = ""                     ;* Names of AS clause synonyms and...
   synonym.refs = ""                 ;* ...their item index values

   * Display tables. One entry for each item to be displayed. Includes items
   * for BREAK.SUP action.

   equ ITEM.NO          to  1        ;* Corresponding entry in item.xxx tables
   equ ITEM.HEADING     to  2        ;* Heading (for horizontal listing)
   equ ITEM.WIDTH       to  3        ;* Width
   equ ITEM.ACCUM.VALUE to  4        ;* Total value etc for accumulation
   equ ITEM.LOCAL.VALUE to  5        ;* Total value etc since breakpoint for accumulation
   equ ITEM.COUNT       to  6        ;* Total count of items, including multi-values
   equ ITEM.LOCAL.COUNT to  7        ;* Total count of items since breakpoint (mv)
   equ ITEM.MODE        to  8        ;* Reporting mode (see below)
      * Reporting modes (order known to ON GOSUB statements):
      equ REPORT.ITEMS      to  0    ;* Normal item display only (Must be zero)
      equ REPORT.TOTAL      to  1    ;* Accumulate total
      equ REPORT.MAX        to  2    ;* Maximum value
      equ REPORT.MIN        to  3    ;* Minimum value
      equ REPORT.AVERAGE    to  4    ;* Average value
      equ REPORT.NUMBER     to  5    ;* Enumerate values (includes multi-values)
      equ REPORT.PERCENT    to  6    ;* Percentages
      equ REPORT.CALC       to  7    ;* CALC keyword
      equ REPORT.BREAK.SUP  to  8    ;* BREAK.SUP keyword
      equ REPORT.CUMULATIVE to  9    ;* CUMULATIVE keyword

      equ REPORT.MODE.MASK  to 15
      equ REPORT.NO.NULLS   to 16    ;* Additive for NO.NULLS option
   equ ITEM.TOTAL       to 9         ;* Total of all items (for PERCENT)
   equ ITEM.INCLUDED    to 10        ;* Used to suppress with O breakpoint
   equ ITEM.WORK        to 11
   equ NO.OF.LIST.ITEM.ELEMENTS to 11
   no.of.list.items = 0              ;* Number of items in report
   max.list.items = 10               ;* Initial size of list tables
   dim list.item(max.list.items, NO.OF.LIST.ITEM.ELEMENTS)

   association.names = ''            ;* Associations of displayed fields
   num.associations = 0
   associated.list.items = ''        ;* Field per assoc, list of item table
                                      * index values for each association
   dim when.op(1)
   dim when.mask(1)

   no.of.pct.items = 0               ;* Number of percentage items and...
   pct.list = ""                     ;* ...their positions in list.item

   accumulating = @false             ;* Doing any accumulations?

   * Query processor @ variables

   qproc.record = ""
   qproc.id = ""
   qproc.ni = 0                  ;* Normally records; values if exploding
   qproc.nd = 0
   qproc.nv = 0
   qproc.ns = 0
   qproc.lpv = 0
   qproc.break.level = 0

   * Record selection

   trusted.list = @false         ;* Don't need to check if record exists?
   source.records = ""           ;* List of record ids from command line
   source.list = -1              ;* FROM n
   sample = @false               ;* Process only the first few records...
   sample.count = 0              ;* ...Number of records to process
   
   sampling = @false             ;* Process every n'th record...
   sample.interval = 1           ;* ...for this value of n
   not.found.list = ''           ;* Record not found

   absent.null = @false          ;* ABSENT.NULL keyword
   locking = @false              ;* LOCKING keyword
   no.index = @false             ;* NO.INDEX keyword
   require.index = @false        ;* REQUIRE.INDEX keyword
   csv.no.query = @false         ;* NO.QUERY keyword in TO clause

   min.list = 0
   max.list = 0
   repeating = @false

   * Field test selections

   first.selection = @true       ;* Tracks multiple WITH clauses
   field.sel = @false
   ak.usable = @false
   ak.hi.value = ''
   when.used = @false
   emitting.when.clause = @false ;* Current clause is WHEN
!!   when.assoc = '__UNSET__'      ;* Association name for WHEN items
   selection.field = 0           ;* Tracks last referenced field

   max.selection = 20            ;* Each test and logical operator counts
   equ SEL.OP        to  1       ;* Opcode
   equ SEL.ARG1      to  2       ;* First item index. Jump point for AND/OR
   equ SEL.ARG2      to  3       ;* Second item index. () level, -1 if fixed up
   equ SEL.ARG3      to  4       ;* Third item index for BETWEEN
   equ SEL.COLS      to  4       ;* Columns in table
   dim selection(max.selection, SEL.COLS) ; mat selection = 0
   hi.sel = 0                    ;* Last used entry
   non.ak.selection.index = 1    ;* Start here for selection elements that
                                 ;* cannot be handled via an AK
!!OPCODES!!
   * The EQ/NE, LIKE/UNLIKE and PEQ/PNE operator pairs must always be
   * adjacent number ranges as the translation between these relies on this.
   * OP.FIRST.MV must be a multiple of 4.
   equ OP.WITH        to  1     ;* Clause is WITH (default for first clause)
   equ OP.WHEN        to  2     ;* Next clause is WHEN
   equ OP.NO          to  3     ;* NO - inverts test
   equ OP.FIRST.MV    to  4
   equ OP.FIRST.RELOP to  4
   equ OP.EQ          to  4     ;* EQ        } EQ and NE must be adjacent
   equ OP.NE          to  8     ;* NE        }
   equ OP.LT          to 12     ;* LT        } Add one to opcode
   equ OP.LE          to 16     ;* LE        } to apply test to
   equ OP.GE          to 20     ;* GE        } every value in
   equ OP.GT          to 24     ;* GT        } multi-valued
   equ OP.LIKE        to 28     ;* LIKE      } field.
   equ OP.UNLIKE      to 32     ;* UNLIKE    } (EVERY keyword)
   equ OP.SAID        to 36     ;* SAID      }
   equ OP.LAST.RELOP  to 39
   equ OP.NOT.NULL    to 40     ;* not null  }
   equ OP.BETWEEN     to 44     ;* BETWEEN   }
   equ OP.LAST.MV     to 47
   equ OP.OR          to 48     ;* OR
   equ OP.AND         to 49     ;* AND
   equ OP.GELE        to 50     ;* } Special operators for AKs only. The
   equ OP.GELT        to 51     ;* } actual value does not matter as these are
   equ OP.GTLE        to 52     ;* } not used in ON GOTO statements.
   equ OP.GTLT        to 53     ;* }

* Pseudo operators for Pick style wildcards, substituted during parsing.
* These use the same EVERY and NO.CASE additives as the main operator set.
   equ OP.PEQ         to 54     ;* 
   equ OP.PNE         to 58     ;* 

   equ opcode.names to 'WITH,WHEN,NO,EQ,E.EQ,EQNC,E.EQNE,NE,E.NE,NENC,E.NENC,LT,E.LT,LTNC,E.LTNC,LE,E.LE,LENC,E.LENC,GE,E.GE,GENC,E.GENC,GT,E.GT,GTNC,E.GTNC,LIKE,E.LIKE,LIKENC,E.LIKENC,UNLIKE,E.UNLIKE,UNLIKENC,E.UNLIKENC,SAID,E.SAID,SAIDNC,E.SAIDNC,NNULL,E.NNULL,NNULLNC,E.NNULLNC,BETWEEN,E.BETWEEN,BETWEENNC,E.BETWEENNC,OR,AND,GELE,GELT,GTLE,GTLT,PEQ,E.PEQ,PEQNC,E.PEQNC,PNE,E.PNE,PNENC,E.PNE.NC'

   * Sort control

   no.of.sort.items = 0          ;* Number of sort fields...
   sort.item.list = ""           ;* ...list of item indicies...
   sort.mode = ""                ;* ...sort modes = BY
      equ SORT.BY          to 1
      equ SORT.BY.DSND     to 2
      equ SORT.BY.EXP      to 3
      equ SORT.BY.EXP.DSND to 4
   exploded.sort = 0             ;* Sort table index for BY.EXP or BY.EXP.DSND
   explode = @false              ;* Read record is not to strip values
   exploded.assoc = 0            ;* Exploded association name index
   explosion.associated.in.dictionary = @true
   exploded.item.count = 0       ;* Number of records exploded

   * Breakpoint control

   equ MAX.BREAKPOINTS to 10
   dim breakpoint.items(MAX.BREAKPOINTS)   ;* Item index for breakpoints
   dim breakpoint.list.index(MAX.BREAKPOINTS)   ;* list.item index for breakpoints
   dim breakpoint.string(MAX.BREAKPOINTS)  ;* Text with control codes removed
   mat breakpoint.string = ''
   dim breakpoint.control(MAX.BREAKPOINTS) ;* Control codes
   mat breakpoint.control = ''
   dim breakpoint.detail.count(MAX.BREAKPOINTS)  ;* Detail line count
   mat breakpoint.detail.count = 0
   detail.lines = 0
   no.of.breakpoints = 0
   mat qproc.breakpoint.value = '' ;* Data from B option

   dim breakpoint.b.list.index(9)   ;* Position of list item using B control
   mat breakpoint.b.list.index = 0
   breakpoint.b.list.index(0) = 0


   * Report output control

   lptr = -1                     ;* Printer channel
   style.rec = ''
   class = 'D'
   pageseq.id = ''               ;* PAGESEQ record id

   boxed = @false

   overlay = ''                  ;* Overlay subroutine for this report and...
   old.overlay = ''              ;* ...original setting on entry

   margin = 0                    ;* Left margin width

   page.heading = NUL            ;* Mark as unset
   page.footing= NUL
   col.spacing = 3               ;* Default inter-column gap size
   is.grand.total = @false
   grand.total.text = ''         ;* GRAND.TOTAL text and...
   grand.total.control = ''      ;* ...control codes
   delimited.report = @false     ;* DELIMITER
   csv = 0                       ;* CSV mode level
                                  * 0 = off
                                  * 1 = as per CSV standard
                                  * 2 = quote everything except numeric with no embedded comma
   reformat.filename = ''        ;* Target file for REFORMAT
   overwrite.count = 0           ;* Records overwritten by REFORMAT
   csv.pathname = ''             ;* Pathname for DELIMITER/CSV output and...
   csv.append = @false            ;* ...append flag

   * Pan/scroll control data

   lno = 0                       ;* Line number. Zero => emit header.
   pgno = 0                      ;* Page number
   pan.scroll = @false           ;* PAN or SCROLL active?
   pan = 0                       ;* List.item index for first panned item
   scroll.depth = 0              ;* Scroll page memory count
   non.panned = ''

   * Selection results

   target.list = 0               ;* Default select list for result list
   saved.item = 0                ;* Index to item for SAVING clause...
   saving.unique = @false        ;* ...UNIQUE keyword used
   saving.multivalued = @false   ;* ...MULTIVALUED keyword used
   saving.nulls = @true          ;* ...NO.NULLS keyword used
   saving.exploded.field = @false ;* SAVING field is also in BY.EXP

   * Option keywords

   all.match= @false             ;* ALL.MATCH
   col.hdg.id = @false           ;* COL.HDG.ID
   col.sup = @false              ;* COL.SUP
   count.sup = @false            ;* COUNT.SUP
   det.sup = @false              ;* DET.SUP
   double.space = @false         ;* DBL.SPC
   force = @false                ;* FORCE
   hdr.sup = @false              ;* HDR.SUP
   id.only = @false              ;* ID.ONLY
   id.sup = @false               ;* ID.SUP
   new.page = @false             ;* NEW.PAGE
   no.case = @false              ;* NO.CASE
   no.match= @false              ;* NO.MATCH
   no.page = @false              ;* NO.PAGE
   no.split = @false             ;* NO.SPLIT
   require.select = @false       ;* REQUIRE.SELECT
   vertical = @false             ;* VERT

   * What are we doing?

   list.command = @false      ;* Generates report (LIST, SORT, LIST.LABEL)
   report.command = @false    ;* Generates report (LIST, SORT)
   select.command = @false    ;* Generates list (SELECT, SSELECT, SEARCH)
   count.command = @false     ;* Simple count (COUNT)
   search.command = @false    ;* Need search phase (SEARCH)
   implicit.id.sort = @false  ;* SORT, SSELECT, SREFORMAT?
   label.command = @false     ;* Label print (LIST.LABEL, SORT.LABEL)
   raw.command = @false       ;* LIST.ITEM, SORT.ITEM
   sum.command = @false       ;* SUM?
   show.command = @false      ;* SHOW?
   reformat.command = @false  ;* REFORMAT, SREFORMAT?

   begin case
      case @option = 1        ;* SELECT
         select.command = @true

      case @option = 2        ;* LIST
         list.command = @true
         report.command = @true

      case @option = 3        ;* SSELECT
         select.command = @true
         implicit.id.sort = @true

      case @option = 4        ;* SORT
         list.command = @true
         report.command = @true
         implicit.id.sort = @true

      case @option = 5        ;* COUNT
         count.command = @true

      case @option = 6        ;* SEARCH
         select.command = @true
         search.command = @true

      case @option = 7        ;* LIST.LABEL
         list.command = @true
         label.command = @true
         vertical = @true
         col.sup = @true
         label.template = ''
         label.no.default = @false

      case @option = 8        ;* SORT.LABEL
         list.command = @true
         label.command = @true
         vertical = @true
         col.sup = @true
         label.template = ''
         label.no.default = @false
         implicit.id.sort = @true

      case @option = 9        ;* SUM
         list.command = @true
         vertical = @true
         det.sup = @true
         id.sup = @true
         sum.command = @true

      case @option = 10       ;* LIST.ITEM
         raw.command = @true
         col.sup = @true

      case @option = 11       ;* SORT.ITEM
         raw.command = @true
         col.sup = @true
         implicit.id.sort = @true

      case @option = 12       ;* SHOW
         show.command = @true

      case @option = 13       ;* REFORMAT
         reformat.command = @true

      case @option = 14       ;* SREFORMAT
         reformat.command = @true
         implicit.id.sort = @true

      case 1
         display "Internal error: Invalid dispatch information"
         goto exit.qproc
   end case


*-----------------------------------------------------------------------------
* Process command line.  First item must be file details

   call @parser(PARSER$RESET, 0, @sentence, 0)
   call @parser(PARSER$GET.TOKEN, token.type, token, keyword) ;* Verb

   * Open the file

   dict.flag = ''
   loop    ;* 0198
      call @parser(PARSER$MFILE, token.type, qproc.file.name, keyword)
   while keyword = KW$FILLER
   repeat

   * Allow for ONLY keyword before the file name for Pick compatibility

   if keyword = KW$ID.ONLY and (list.command or show.command) then
      id.only = @true
      loop
         call @parser(PARSER$MFILE, token.type, qproc.file.name, keyword)
      while keyword = KW$FILLER
      repeat
   end

   if keyword = KW$DICT then      ;* DICT keyword
      dict.flag = "DICT"
      loop    ;* 0198
         call @parser(PARSER$MFILE, token.type, qproc.file.name, keyword)
      while keyword = KW$FILLER
      repeat
   end

   if token.type = PARSER$END then
      display sysmsg(2102) ;* File name required
      goto exit.qproc
   end

   open dict.flag, qproc.file.name to data.f else
      open dict.flag, upcase(qproc.file.name) to data.f else
         display sysmsg(2019) ;* File not found
         goto exit.qproc
      end

      qproc.file.name = upcase(qproc.file.name)
   end

   is.dir = (fileinfo(data.f, FL$TYPE) = FL$TYPE.DIR)
   is.case.insensitive = (bitand(fileinfo(data.f, FL$FLAGS), FL$FLAGS.NOCASE) # 0)
   if is.windows and is.dir then is.case.insensitive = @true

   * Open the dictionary, if it exists

   dict.open = @false
   if len(dict.flag) then
      open "DICT.DICT" to dict.file then dict.open = @true
   end else
      open "DICT", qproc.file.name to dict.file then dict.open = @true
   end

   if not(dict.open) then
      if status() # ER$NPN then
         display sysmsg(2012) ;* Cannot open dictionary
         goto exit.qproc
      end
   end


   * Process defaults from VOC $QUERY.DEFAULTS record, if present

   if list.command and not(sum.command) then
      if dict.open then
         read dict.rec from dict.file, '$QUERY.DEFAULTS' then goto defaults.found
      end
      read dict.rec from @voc, '$QUERY.DEFAULTS' else null
defaults.found:
      if upcase(dict.rec[1,1]) = 'X' then
         * Merge continuation lines

         s = dict.rec<2>
         loop
            del dict.rec<2>
         while s[1] = '_'
            s = s[1, len(s)-1]:' ':dict.rec<2>
         repeat
         call @parser(PARSER$GET.REST, token.type, n, keyword)
         call @parser(PARSER$RESET, 0, s:n, 0)
      end
   end

   * Process remaining command line items

   gosub parse.command.options

   * If we are doing a report command and have found no fields to list, look
   * for a suitable default listing phrase. The ID.ONLY keyword suppresses
   * inclusion of this phrase.

   if (list.command or show.command) and not(sum.command) and no.of.list.items = 0 and not(id.only) then
      if dict.open then
         if lptr >= 0 then
            id = "@LPTR"
            read dict.rec from dict.file, id then
               if dict.rec[1,2] = 'PH' then goto parse.default.phrase
            end
         end

         if show.command then
            id = "@SHOW"
            read dict.rec from dict.file, id then
               if dict.rec[1,2] = 'PH' then goto parse.default.phrase
            end
         end

         id = "@"
         read dict.rec from dict.file, id then
            if upcase(dict.rec[1,2]) = "PH" then
parse.default.phrase:
               * Merge continuation lines

               s = dict.rec<2>
               loop
                  del dict.rec<2>
               while s[1] = '_'
                  s = s[1, len(s)-1]:' ':dict.rec<2>
               repeat
               call @parser(PARSER$RESET, 0, s, 0)

               gosub parse.command.options
            end
         end
      end
   end

   * Suppress heading, footing and styles in delimited reports

   if delimited.report and csv.pathname = '' then
       hdr.sup = @true
       page.footing = NUL
       style.rec = ''
   end

   * Check for inconsistent options

   if no.index and require.index then
      stop sysmsg(7200) ;* NO.INDEX cannot be used with REQUIRE.INDEX
   end

   if lptr >= 0 or capturing then
      scroll.depth = 0            ;* Ignore SCROLL
      pan = 0                     ;* Ignore PAN
   end

   if vertical or delimited.report then
      pan = 0   ;* Ignore PAN
   end

   if require.select then
      if source.list < 0 then
         if not(selectinfo(0, SL$ACTIVE)) then
            display sysmsg(7201) ;* Select list required - Processing terminated
            goto exit.qproc
         end
      end else
         if not(selectinfo(source.list, SL$ACTIVE)) then
            display sysmsg(7201) ;* Select list required - Processing terminated
            goto exit.qproc
         end
      end
   end

   if csv.pathname then
      if not(delimited.report) then
         display sysmsg(7299)  ;* Output filename can only be specified in a delimited report
         goto exit.qproc
      end

      if lptr >= 0 then
         display sysmsg(7300) ;* Output filename cannot be used with LPTR
         goto exit.qproc
      end

      openseq csv.pathname to csv.f then
         if not(csv.append) and not(csv.no.query) then
            loop
               display sysmsg(7305, csv.pathname) : ;* %1 already exists. Overwrite(Y/N)?
               input yn upcase
               if yn = 'N' then goto exit.qproc
            until yn = 'Y'
               display sysmsg(7279) ;* Y or N required
            repeat
         end
      end else
         if status() then
            display sysmsg(1427, csv.pathname)  ;* Cannot open %1
            goto exit.qproc
         end
      end

      if csv.append then
         seek csv.f, 0, 2 else null
      end else
         weofseq csv.f
      end
   end

   * If we have not encountered a FROM clause and there is an active select
   * list 0, use it by default.

   if source.list <= 0 then
      if selectinfo(0, SL$ACTIVE) then source.list = 0
   end

   * Because the query processor accesses the select.list array directly,
   * we need to ensure that any partially build DH file select list is
   * completed. The easiest way to do this is to retrieve its item count.

   if source.list >= 0 then void selectinfo(source.list, SL$COUNT)

   * If the LOCKING keyword was used, lock the source file

   if locking then filelock data.f

   * Initialise the display handler

   if qdisp(QD$INIT) then goto qdisp.error
   if boxed then void qdisp(QD$BOX)

   * Establish width of output device

   if list.command or raw.command then
      device.width = qdisp(QD$LPTR, lptr)
      if margin > device.width - 20 then margin = device.width - 20

      * Activate scroll mode, if required

      if scroll.depth then void qdisp(QD$SCRL)
   end

   if lptr >= 0 then
      if pageseq.id # '' then void qdisp(QD$SETP,pageseq)

      if overlay then
         old.overlay = getpu(PU$OVERLAY, lptr)
         setpu PU$OVERLAY, lptr, overlay
      end
   end

*-----------------------------------------------------------------------------
* Insert @ID as first displayed field unless ID.SUP used

   if list.command or show.command then
      * Insert @ID as the first display item unless we have seen ID.SUP

      if id.sup then
         if id.only then
            display sysmsg(7202) ;* Cannot use ID.SUP and ID.ONLY together
            goto exit.qproc
         end
      end else
         dict.rec = "D" : @FM : "0" : @fm : @fm : qproc.file.name : @fm : "12L" : @fm : "S"
         if dict.open then
            read s from dict.file, "@ID" then
               if (upcase(s[1,1]) = "D") and (s<dict.loc> = 0) then
                  dict.rec = s
               end
            end
         end

         if no.items = max.items then gosub extend.item.tables  ;* 0109
         no.items += 1
         item.index = no.items
         item.name(item.index) = "@ID"
         s = dict.rec<dict.display.name> ; gosub set.col.hdg
         item.detail(item.index) = 0
         item.fmt(item.index) = dict.rec<dict.format>
         gosub get.width.and.justification
         item.conv(item.index) = dict.rec<dict.conv>
         item.type(item.index) = ID.ITEM
         item.assoc(item.index) = 0
         item.multivalued(item.index) = @false
         item.totals(item.index) = 0
         item.breakpoint(item.index) = 0
         item.flags(item.index) = 0

         if no.of.list.items = max.list.items then
            gosub extend.list.item.tables
         end

         no.of.list.items += 1
         for i = no.of.list.items to 2 step -1
            list.item(i, ITEM.NO) = list.item(i - 1, ITEM.NO)
            list.item(i, ITEM.MODE) = list.item(i - 1, ITEM.MODE)
         next i
         list.item(1, ITEM.NO) = item.index
         list.item(1, ITEM.MODE) = report.items

         * There is no need to copy the count and value entries as they are
         * all zero at this time. Simply set the newly used entries at the
         * end of the list.item matrix to zero.

         list.item(no.of.list.items, ITEM.COUNT) = 0
         list.item(no.of.list.items, ITEM.ACCUM.VALUE) = 0
         list.item(no.of.list.items, ITEM.LOCAL.COUNT) = 0
         list.item(no.of.list.items, ITEM.LOCAL.VALUE) = 0
         list.item(no.of.list.items, ITEM.TOTAL) = 0

         * Adjust values in PCT.LIST if PERCENT clause used

         if pct.list # '' then pct.list += reuse(1)

         * Adjust breakpoint list index

         for i = 1 to no.of.breakpoints
            if breakpoint.list.index(i) then breakpoint.list.index(i) += 1
         next i

         for i = 0 to 9
            if breakpoint.b.list.index(i) then breakpoint.b.list.index(i) += 1
         next i

         * Adjust pan position

         if pan then pan += 1
      end

      if no.of.list.items = 0 then
         display sysmsg(7203) ;* No fields specified for report
         goto exit.qproc
      end

      * If the PAN keyword has been used and it was after all the display
      * clauses, we need to adjust it to pan everything.

      if pan > no.of.list.items then pan = 1
   end

*-----------------------------------------------------------------------------
* Adjust column heading texts for COL.HDG.ID option

   if col.hdg.id then
      for i = 1 to no.items
         if not(bitand(item.flags(i), IFLG.COL.HDG)) then
            item.display.name(i) = item.name(i)
         end
      next i
   end

*-----------------------------------------------------------------------------
* Find label template for LIST.LABEL and SORT.LABEL

   if label.command then
      if label.template = '' and not(label.no.default) then
         if dict.open then
            read label.template from dict.file, '@LABEL' then
               goto template.found
            end
         end

         read label.template from @voc, '@LABEL' else null
template.found:
      end

      if label.template = '' then
         * Prompt for details, creating a label template record

         label.template = 'X'

         txt = sysmsg(7204) ;* Labels per line
         gosub get.label.data
         label.template<2> = n

         txt = sysmsg(7205) ;* Labels per column
         gosub get.label.data
         label.template<3> = n

         txt = sysmsg(7206) ;* Label width (chars)
         gosub get.label.data
         label.template<4> = n

         txt = sysmsg(7207) ;* Label height (lines)
         gosub get.label.data
         label.template<5>= n

         txt = sysmsg(7208) ;* Indentation for first column (chars)
         gosub get.label.data
         label.template<6> = n

         txt = sysmsg(7209) ;* Horizontal space between labels (chars)
         gosub get.label.data
         label.template<7> = n

         txt = sysmsg(7210) ;* Vertical space between labels (lines)
         gosub get.label.data
         label.template<8> = n

         txt = sysmsg(7211) ;* Omit blank data lines (Y/N)
         gosub get.label.yn
         label.template<9> = n
      end else
         if upcase(label.template[1,1]) # 'X' then
            display sysmsg(7212) ;* Label template is not an X-type record
            goto exit.qproc
         end

         for i = 2 to 9
            if not(label.template<i> matches '1N0N0X') then
               display sysmsg(7213, i) ;* Invalid data on line xx of label template
               goto exit.qproc
            end
         next i
      end

      * Initialise the display handler label procecssing

     void qdisp(QD$LBL, label.template)

      * Set all display fields to be no wider than label. Items with
      * simple format codes of nL and nT are set to the width of the label.

      w = matchfield(label.template<4>, '0N0X', 1) + 0
      for i = 1 to no.of.list.items
         item.to.list = list.item(i, ITEM.NO)
         if item.display.width(item.to.list) > w then 
            item.display.width(item.to.list) = w
         end else
            x = item.fmt(item.to.list)
            if x matches '1N0NL1N0NT' then
               item.display.width(item.to.list) = w
               item.fmt(item.to.list) = w:x[1]
            end
         end
      next i
   end

*----------------------------------------------------------------------
* Find display width of each item.

   if report.command then
      * Look for special control codes in column headings

      for i = 1 to no.of.list.items
         item.to.list = list.item(i, ITEM.NO)

         s = item.display.name(item.to.list)
         c = s[1,1]
         if c = '"' or c = "'" then
            if count(s, c) >= 2 then
               x = field(s, c, 2)
               if len(x) and convert('RX', '', x) = '' then
                  * Looks hopeful. We have a leading non-null quoted string
                  * that contains no characters other than our recognised
                  * control codes.

                  item.display.name(item.to.list) = field(s, c, 3, 99999)

                  if index(s, 'R', 1) then  ;* Right aligned column heading
                     item.flags(item.to.list) = bitor(item.flags(item.to.list), IFLG.RIGHT.COL.HDG)
                  end

                  if index(s, 'X', 1) then  ;* Suppress ... fillers
                     item.flags(item.to.list) = bitor(item.flags(item.to.list), IFLG.DOTLESS.COL.HDG)
                  end
               end
            end
         end
      next i

      begin case
         case delimited.report
            for hlist.index = 1 to no.of.list.items
               i = list.item(hlist.index, ITEM.NO)
               list.item(hlist.index, ITEM.WIDTH) = item.display.width(i)
            next hlist.index

         case not(label.command)          ;* Standard report
            * Calculate width by scanning all items to be listed

            pan.data = ''   ; * Column and widths for panned items

            loop
               width = 0
               pan.width = 99999
               for i = 1 to no.of.list.items
                  if list.item(i, ITEM.MODE) = REPORT.BREAK.SUP then continue

                  * If this field is the first one for panning, note the
                  * width available for panned data.

                  if i = pan then pan.width = device.width - width

                  * Process each item to work out the required display
                  * width, allowing for the case where the heading is
                  * wider than the field's format code definition.

                  item.to.list = list.item(i, ITEM.NO)
                  w = item.display.width(item.to.list)
                  if not(vertical) then
                     n = maximum(lens(item.display.name(item.to.list)))
                     if n > w then   ;* Widen field to fit heading
                        w = n
                        item.display.width(item.to.list) = w
                        item.fmt(item.to.list) = w : matchfield(item.fmt(item.to.list), '0N0X', 2)
                     end
                  end

                  * If we are panning, make sure this field does not require
                  * more space than the width of the panend area.

                  if pan then
                     if w > pan.width then
                        display sysmsg(7214) ;* Pan position does not allow proper display
                        goto exit.qproc
                     end
                  end

                  * Note the start column and width for this item

                  if i >= pan then
                     pan.data<1,-1> = width + 1
                     pan.data<2,-1> = w
                  end

                  width += w

                  * Also add an inter-column gap unless this is the final
                  * column or it is of zero width.

                  if i # no.of.list.items and w # 0 then width += col.spacing
               next i

            while width > device.width and not(pan)
            while col.spacing > 1
               col.spacing -= 1
            repeat

            * If the width of the report is greater than the display area
            * in a non-panned report, switch to line by line (vertical) mode.

            if width > device.width and not(pan) then vertical = @true
            if vertical then double.space = @true

            if not(vertical) then
               col.gap = space(col.spacing)

               * Find display width of each item.

               for hlist.index = 1 to no.of.list.items
                  i = list.item(hlist.index, ITEM.NO)
                  list.item(hlist.index, ITEM.WIDTH) = item.display.width(i)
               next hlist.index
            end

            if pan then void qdisp(QD$PAN, pan.data)
      end case
   end    

   if debugging then gosub diagnostic

*-----------------------------------------------------------------------------
* Set up page heading, column headings and page footing

   if report.command or sum.command or raw.command then
      heading on lptr ''     ;* Let qdisp() do its own heading structures
      footing on lptr ''

      * ========================================
      * Set up page heading
      * ========================================

      if page.heading = NUL then
         page.heading = change((space(margin):@sentence)[1,device.width - 10], "'", "''") : "'G'Page 'S'"
         if sum.command then page.heading := "'L'"
      end

      if hdr.sup then page.heading = ''

      if page.heading # '' then
         if csv.pathname # '' then
            if trim(page.heading, ' ', 'B') # '' then
               writeseq page.heading to csv.f else null
            end
         end else
            void qdisp(QD$PHDR, page.heading)
         end
      end

      * ========================================
      * Set up column headings
      * ========================================
#ifdef NEVER
      * Look for special control codes in column headings

      for i = 1 to no.of.list.items
         item.to.list = list.item(i, ITEM.NO)

         s = item.display.name(item.to.list)
         c = s[1,1]
         if c = '"' or c = "'" then
            if count(s, c) >= 2 then
               x = field(s, c, 2)
               if len(x) and convert('RX', '', x) = '' then
                  * Looks hopeful. We have a leading non-null quoted string
                  * that contains no characters other than our recognised
                  * control codes.

                  item.display.name(item.to.list) = field(s, c, 3, 99999)

                  if index(s, 'R', 1) then  ;* Right aligned column heading
                     item.flags(item.to.list) = bitor(item.flags(item.to.list), IFLG.RIGHT.COL.HDG)
                  end

                  if index(s, 'X', 1) then  ;* Suppress ... fillers
                     item.flags(item.to.list) = bitor(item.flags(item.to.list), IFLG.DOTLESS.COL.HDG)
                  end
               end
            end
         end
      next i
#endif
      if not(vertical) and not(col.sup) then
         column.headings = ''

         * Form headings

         for head.index = 1 to no.of.list.items
            head.item.index = list.item(head.index, ITEM.NO)
            if delimited.report then  ;* 2.2-4
               list.item(head.index, ITEM.HEADING) = item.display.name(head.item.index)
            end else
               if bitand(item.flags(head.item.index), IFLG.RIGHT.COL.HDG) then
                  x = 'R'
               end else
                  x = 'L'
               end

               if not(bitand(item.flags(head.item.index), IFLG.DOTLESS.COL.HDG)) then
                  x = '.':x
               end

               list.item(head.index, ITEM.HEADING) = fmts(item.display.name(head.item.index), item.display.width(head.item.index) : x)
            end
         next head.index

         * Append headings to heading string

         loop
            if column.headings # '' then column.headings := "'L'"
            if margin then column.headings := space(margin)

            more.heading = @false
            for head.index = 1 to no.of.list.items
               if list.item(head.index, ITEM.MODE) = REPORT.BREAK.SUP then continue

               
               if delimited.report then
                  column.headings := change(list.item(head.index, ITEM.HEADING), @vm, ' ')
                  if head.index < no.of.list.items then column.headings := delimiter
               end else
                  heading.fragment = field(list.item(head.index, ITEM.HEADING), @vm, 1)
                  list.item(head.index, ITEM.HEADING) = list.item(head.index, ITEM.HEADING)[col2() + 1, 99999]
                  if len(list.item(head.index, ITEM.HEADING)) then more.heading = @true
                  w = list.item(head.index, ITEM.WIDTH)
                  if w then
                     column.headings := change(fmt(heading.fragment, w : "L"), "'", "''")
                     if head.index < no.of.list.items then column.headings := col.gap
                  end
               end
            next head.index

         while more.heading
         repeat

         begin case
            case csv.pathname # ''
               if trim(column.headings, ' ', 'B') # '' then
                  writeseq column.headings to csv.f else null
               end
            case delimited.report
               * A delimited report does not use the display handler so we
               * must emit the column headings using a simple PRINT.

               print on lptr column.headings
            case 1
               void qdisp(QD$CHDR, column.headings)
         end case
      end

      * ========================================
      * Set up page footing
      * ========================================

      if page.footing # NUL then
         void qdisp(QD$PFTR, page.footing)
      end

      if no.page then void qdisp(QD$NPAG)

      * ========================================
      * Set up style record
      * ========================================

      if style.rec = '' then            ;* Not set on command line...
         if lptr >= 0 then
            s = getpu(PU$STYLE, lptr)
            if s # '' then
               call !vocrec(style.rec, s)
               if status() = 0 then
                  if upcase(style.rec[1,1]) # 'X' then style.rec = ''
               end
            end
         end
      end

      if style.rec = '' then            ;* ...or in print unit
         style.rec = default.style.rec
      end

      * The test below allows for "style.rec = @false" as a result of
      * using STYLE "" on the command line to prevent use of a style.

      if style.rec then void qdisp(QD$STYL, field(style.rec, @fm, 2, 99))
   end

*-----------------------------------------------------------------------------
* Get strings for SEARCH command

   if search.command then
      no.of.strings = 0
      dim strings(MAX.STRINGS)
      loop
         display sysmsg(7215) :  ;* String:
         input s
      while len(s)
         no.of.strings += 1
         if no.case then s = upcase(s)
         strings(no.of.strings) = s
      while no.of.strings < MAX.STRINGS
      repeat

      if no.of.strings = 0 then
         display sysmsg(7216) ;* No search strings
         goto exit.qproc
      end
   end


*-----------------------------------------------------------------------------
* Get target file for REFORMAT

   if reformat.command and reformat.filename = '' then
      loop
         display sysmsg(7288) :  ;* Output file:
         input reformat.filename
         if reformat.filename = '' then stop
         open reformat.filename to reformat.f then exit
         open upcase(reformat.filename) to reformat.f then exit
         display sysmsg(1427, reformat.filename)  ;* Cannot open %1
      repeat
   end

*-----------------------------------------------------------------------------
* Set up structures needed for handling the TOTAL() function in I-types

   * Count the number of TOTAL() functions used
   * Create the item.tbase matrix with one element per item. This contains
   * the base index for the qproc.totals matrix entries for each I-type.
   * Entries for which there is no TOTAL() function are set to zero.

   dim item.tbase(no.items) ; mat item.tbase = 0
   num.totals = 0
   for i = 1 to no.of.list.items
      item.to.list = list.item(i, ITEM.NO)
      n = item.totals(item.to.list)
      if n then
         item.tbase(item.to.list) = num.totals + 1
         num.totals += n
      end
   next i

   * Create the qproc.totals matrix with one element for each TOTAL() function

   if num.totals then
      dim qproc.totals(num.totals)
      dim saved.totals(num.totals)
      mat qproc.totals = 0
   end


*-----------------------------------------------------------------------------
* If doing PCT accumulation, set up necessary data

   if len(pct.list) then
      no.of.pct.items = dcount(pct.list,@fm)
      dim pct.items(no.of.pct.items)
      matparse pct.items from pct.list,@fm
      pct.list = ""
   end

*-----------------------------------------------------------------------------
* If doing any sorting, set up sort tree(s)

   if show.command and no.of.sort.items = 0 then implicit.id.sort = @true

* 0080 Moved the following code from inside the if len(sort.item.list)
* block just below. Previously, SORT with an active select list did not
* end up doing the id sort.

   if implicit.id.sort then
      * Doing a SORT or SSELECT verb. Add the record id to the end of the
      * sort list.

      token = "@ID"
      gosub add.field.by.name
      sort.item.list<-1> = item.index
      sort.mode<-1> = SORT.BY

      implicit.id.sort = @false  ;* Don't do SSELECT of file later
   end

   if len(sort.item.list) then
      no.of.sort.items = dcount(sort.item.list, @fm)
      dim sort.items(no.of.sort.items)
      dim sort.modes(no.of.sort.items) ; mat sort.modes = BT.DATA
      dim sort.data(no.of.sort.items)
      dim by.item(no.of.sort.items)
      dim by.item.exploded(no.of.sort.items)
      dim exploded.sort.item(no.of.sort.items)

      for i = 1 to no.of.sort.items
         * Get field referenced by BY clause
         sort.item = sort.item.list<i> + 0
         j = sort.mode<i>
         if j = SORT.BY.DSND or j = SORT.BY.EXP.DSND then
            sort.modes(i) += BT.DESCENDING
         end

         if not(item.left.justified(sort.item)) then
            sort.modes(i) += BT.RIGHT.ALIGNED
         end
         sort.items(i) = sort.item
      next i

      if saving.unique then sort.modes(no.of.sort.items) += BT.UNIQUE
      sortinit no.of.sort.items, sort.modes

      * If we are doing an exploded sort, check that the exploded item is a
      * member of an association.  If not, we must make a pseudo-association
      * for this item so that we can track what to explode.  This is not
      * simply a matter of changing one item table entry as the same field
      * may be referenced by many item entries, indeed the one addressed by
      * the exploded.sort variable is the item for the sort and not the
      * displayed copy of this field.

      if exploded.sort then
         i = sort.items(exploded.sort)

         * Save field number of exploded sort item
         exploded.fno = if item.type(i) = ITYPE.ITEM then -1 else item.detail(i)

         if not(item.assoc(i)) then
            explosion.associated.in.dictionary = @false
            num.associations += 1
            dim when.op(num.associations)
            dim when.mask(num.associations)

            association.names<num.associations> = '__QM.EXP__'
            for j = 1 to no.items
               if item.name(j) = item.name(i) then
                  item.assoc(j) = num.associations
                  associated.list.items<num.associations,-1> = j
               end
            next j
         end
         exploded.assoc = item.assoc(sort.items(exploded.sort))

         * 0447 Check if we have a SAVING clause for a field with an exploded sort

         if saved.item then
            i = sort.items(exploded.sort)
            * Simply comparing item names is not good enough. There could be two
            * item table entries for different dictionary items that actually
            * equate to the same item.

            if item.type(saved.item) = item.type(i) then
               if item.detail(saved.item) = item.detail(i) then
                  if item.multivalued(saved.item) = item.multivalued(i) then
                     saving.exploded.field = @true
                  end
               end
            end
         end
      end
   end


*-----------------------------------------------------------------------------
* Optimise use of leading "WITH @ID = value" to become an id list

   if source.records = '' then
      s = ''
      i = 1
      op = OP.OR
      loop
      while i <= hi.sel
      while op = OP.OR
      while selection(i,SEL.OP) = OP.EQ
         item.index = selection(i,SEL.ARG1)
      while item.type(item.index) = ID.ITEM
         item.index = selection(i,SEL.ARG2)
      while item.type(item.index) = LITERAL.ITEM
         * This one is a candidate for optimisation
         * Add this item to the record id list...

         s<-1> = item.detail(item.index)
         i += 1
         op = if i < hi.sel then selection(i,SEL.OP) else OP.AND
         i += 1
      repeat

      if op = OP.AND then
         source.records = s
         selection(0) = field(selection(0), @fm, i, 999999)

         * Must remove early entries from selection table
         j = 0
         loop
         while i <= hi.sel
            j += 1
            op = selection(i, SEL.OP)
            selection(j, SEL.OP) = op
            if op = OP.AND or op = OP.OR then  ;* Adjust exit point
               selection(j, SEL.ARG1) = selection(i, SEL.ARG1) + j - i
            end else
               selection(j, SEL.ARG1) = selection(i, SEL.ARG1)
            end
            selection(j, SEL.ARG2) = selection(i, SEL.ARG2)
            selection(j, SEL.ARG3) = selection(i, SEL.ARG3)
            i += 1
         repeat
         hi.sel = j
      end
   end

*-----------------------------------------------------------------------------
* Work out how to handle selection phase

   * Determine what style of record selection we are using and build a list
   * of records to process in select list 12.

   begin case
      case source.list >= 0 and source.records # ''
         * We have both a list of ids on the command line and a select list.
         * Edit the record list to remove any records not also in the
         * select list.

         n = dcount(source.records, @fm)
         i = 1
         loop
         while i <= n
            locate source.records<i> in select.list(source.list)<1> setting j else
               del source.records<i>
               n -= 1
               continue
            end
            i += 1
         repeat

         clearselect source.list
         formlist source.records to 12
         source.records = ""

      case source.list >= 0
         * Select list in use but no ids on command line
         * Copy the list to list 12

         select.list(12) = select.list(source.list)
         select.count(12) = select.count(source.list)
         clearselect source.list

      case source.records # ''
         * Record ids provided on command line

         if hi.sel = 0 and no.of.sort.items = 0 then
            * We are not going to read the records for anything else so
            * We need to check that they actually exist.

            s.list = source.records   ;* 0466
            source.records = ''
            loop
               id = remove(s.list, more)
               gosub check.record
               if record.found then source.records<-1> = id
            while more
            repeat
         end

         * Transfer these to select list 12

         formlist source.records to 12

      case 1
         * Check if we have a selection clause that could usefully employ
         * an alternate key index.

         if hi.sel and not(no.index) then
            gosub check.ak.usability

            * 0497 Check whether the AK based criteria include use of the
            * WHEN operator. If so, simply rewind non.ak.selecttion.index
            * so that we repeat the filtering on the indexed records.

            for i = 1 to non.ak.selection.index - 1
               if selection(i,SEL.OP) = OP.WHEN then
                  non.ak.selection.index = 1
                  exit
               end
            next i
         end

         if ak.usable then
            begin case
               case ak.operator = OP.EQ
                  selectindex index.name, ak.value from data.f to 12

               case ak.operator = OP.LE
                  select.list(12) = ''
                  select.count(12) = 0
                  setleft index.name from data.f
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  until ak.key > ak.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.LT
                  select.list(12) = ''
                  select.count(12) = 0
                  setleft index.name from data.f
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  until ak.key >= ak.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.GE or ak.operator = OP.GT
                  selectindex index.name, ak.value from data.f to 12
                  if ak.operator = OP.GT then selectright index.name from data.f to 12
                  loop
                     selectright index.name from data.f to 11
                  until status()
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.GELT or ak.operator = OP.GTLT
                  selectindex index.name, ak.value from data.f to 12
                  if ak.operator = OP.GTLT then
                     selectright index.name from data.f setting ak.key to 12
                     if ak.key >= ak.hi.value then
                        clearselect 12
                        goto no.records
                     end
                  end
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  until ak.key >= ak.hi.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.GELE or ak.operator = OP.GTLE
                  selectindex index.name, ak.value from data.f to 12
                  if ak.operator = OP.GTLE then
                     selectright index.name from data.f setting ak.key to 12
                     if ak.key > ak.hi.value then
                        clearselect 12
                        goto no.records
                     end
                  end
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  until ak.key > ak.hi.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.LIKE
                  selectindex index.name, ak.prefix from data.f to 12
                  if not(ak.prefix matches ak.value) then
                     select.list(12) = ''
                     select.count(12) = 0
                  end
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  while ak.key matches ak.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case ak.operator = OP.BETWEEN    ;* 0544
                  selectindex index.name, ak.value from data.f to 12
                  loop
                     selectright index.name from data.f setting ak.key to 11
                  until status()
                  until ak.key > ak.hi.value
                     select.list(12)<-1> = select.list(11)
                     select.count(12) += select.count(11)
                  repeat

               case 1
                  stop 'Internal error: Invalid AK operator ' : ak.operator
            end case

            trusted.list = @true
         end else    ;* Cannot use an AK to resolve this query
            if require.index then
               stop sysmsg(7217) ;* Processing terminated: This query cannot be resolved with an index
            end

            non.ak.selection.index = 1
            * We have neither a select list nor specified ids
            if implicit.id.sort and no.of.sort.items = 0 then
                sselect data.f to 12
                trusted.list = @true
            end else
               select data.f to 12
               trusted.list = @true
            end
         end
   end case

   * Check if all non-AK record selection is based on ids and literals thus
   * not requiring us to read the records.

   field.sel = @false
   sel.idx = non.ak.selection.index
   loop
   while sel.idx <= hi.sel
      op = selection(sel.idx,SEL.OP)
!!OPCODES!!
      begin case
         case op >= OP.FIRST.RELOP and op <= OP.LAST.RELOP   ;* 2 operands
            item.index = selection(sel.idx, SEL.ARG1)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true

            item.index = selection(sel.idx, SEL.ARG2)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true

         case op >= OP.NOT.NULL and op <= OP.NOT.NULL + 3       ;* 1 operand
            item.index = selection(sel.idx, SEL.ARG1)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true

         case op >= OP.BETWEEN and op <= OP.BETWEEN + 3         ;* 3 operands
            item.index = selection(sel.idx, SEL.ARG1)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true

            item.index = selection(sel.idx, SEL.ARG2)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true

            item.index = selection(sel.idx, SEL.ARG3)
            if item.type(item.index) # ID.ITEM and item.type(item.index) # LITERAL.ITEM then field.sel = @true
      end case      
   until field.sel
      sel.idx += 1
   repeat

no.records:
   if debugging then gosub debug.selection

*-----------------------------------------------------------------------------
* Handle actions that require us to pre-read the records

   if select.command or show.command then clearselect target.list

   * We must pre-read the records if we have a sort clause or a PCT
   * accumulation.  In either case, we can reject records that do not meet
   * our selection criteria during this processing.  We end up building a
   * new select list 12 which is suitably sorted and restricted to the
   * records of interest.
   * We also handle the SAVING clause of a SELECT here so that we do not
   * have to consider this is the second pass processing.
   * SAMPLE and SAMPLED are also handled here.

   deferred.select = @false

   if no.of.sort.items or no.of.pct.items or saved.item or sample or sampling then
      num.exploded.sort.items = 0
      for i = 1 to no.of.sort.items
         sort.item = sort.items(i)
         if item.assoc(sort.item) = exploded.assoc and i # exploded.sort then
            num.exploded.sort.items += 1
            exploded.sort.item(num.exploded.sort.items) = i
         end
      next i

      preselect = hi.sel or search.command

      s.list = ''
      id.count = -1
      loop
         readnext id from 12 else exit
         new.record = @true

         id.count += 1
         if rem(id.count, sample.interval) then continue

         * Check if we want this record

         if preselect then
            gosub check.selection
            if not(record.wanted) then continue
         end

         * Perform percentage accumulation if required

         if no.of.pct.items then
            * There is at least one PERCENT clause in the command.
            * Form a total for each affected field.

            for i = 1 to no.of.pct.items
               pct.list.item = pct.items(i)
               pct.item = list.item(pct.list.item, ITEM.NO)
               on item.type(pct.item) goto pct.id,
                                           pct.field,
                                           pct.itype,
                                           pct.literal,
                                           pct.ni,
                                           pct.bytes

pct.id:
* 0079 Removed   if new.record then gosub read.record
               if new.record then gosub check.record
               if not(record.found) then goto skip.record
               s = id
               goto pct.sum

pct.field:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               s = qproc.record<item.detail(pct.item)>
               goto pct.sum

pct.itype:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               s = itype(item.detail(pct.item))
               goto pct.sum

pct.literal:
               s = item.detail(pct.item)  ;* Stupid but you never know!
               goto pct.sum
         
pct.ni:
               s = qproc.ni
               goto pct.sum

pct.bytes:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               s = len(qproc.record)
               goto pct.sum

pct.sum:
               if num(s) then list.item(pct.list.item, ITEM.TOTAL) += s
            next i
         end

         * If we are doing a sorted select, add this record to the sort tree.
         * Otherwise add it to s.list

         if no.of.sort.items then
            for i = 1 to no.of.sort.items
               * Get field referenced by BY clause
               sort.item = sort.items(i)
               on item.type(sort.item) goto by.id,
                                            by.field,
                                            by.itype, 
                                            by.literal,
                                            by.ni,
                                            by.bytes

by.id:
* 0079 Removed   if new.record then gosub read.record
               if new.record then gosub check.record
               if not(record.found) then goto skip.record
               by.item(i) = id
               continue

by.field:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               by.item(i) = qproc.record<item.detail(sort.item)>
               continue

by.itype:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               by.item(i) = itype(item.detail(sort.item))
               continue

by.literal:
               by.item(i) = item.detail(sort.item)  ;* Stupid!
               continue

by.ni:
               by.item(i) = qproc.ni
               continue

by.bytes:
               if new.record then gosub read.record
               if not(record.found) then goto skip.record
               by.item(i) = len(qproc.record)
            next i

            * If the QUERY.NO.CASE option is set, translate all sort keys
            * to uppercase

            if option(OPT.QUERY.NO.CASE) then
               for i = 1 to no.of.sort.items
                  by.item(i) = upcase(by.item(i))
               next i
            end

            * If there is a SAVING clause, extract the data to be saved

            if saved.item then   ;* SAVING clause
               item.index = saved.item
               gosub get.item
               if saving.multivalued then
                  s = convert(@vm:@sm, @fm:@fm, item)
                  n = dcount(s, @fm)
                  item = ''
                  for i = 1 to n
                     x = s<i>
                     if x = '' then
                        if not(saving.nulls) then continue
                     end
                     if saving.unique then
                        locate x in s.list<1> setting pos then continue
                     end
                     item<-1> = x
                  next i
                  if item = '' and not(saving.nulls) then goto skip.record
               end else
                  if len(item) = 0 then
                     if not(saving.nulls) then goto skip.record
                  end
                  if saving.unique then
                     locate item in s.list<1> setting i then goto skip.record
                  end
               end
            end else             ;* Building id list, not SAVING
               item = id
            end

            if exploded.sort then
               if when.used then
                  xitem = item
                  gosub apply.when.filter
                  item = xitem
               end

               exploded.item.count += 1

               * Take exploded field apart and make a sort tree entry
               * for each value and subvalue.

               mat by.item.exploded = mat by.item

               exp.item = by.item(exploded.sort)<1>

               nv = count(exp.item, @vm) + 1     ;* Null -> 1
               for v = 1 to nv
                  exp.val = exp.item<1,v>
                  nsv = count(exp.val, @sm) + 1  ;* Null -> 1
                  if nsv = 1 then       ;* No subvalues, sv element to be 0
                     if when.used then
                        if not(truth<1,v>) then continue
                     end

                     by.item(exploded.sort) = exp.val

                     for i.exp.assoc = 1 to num.exploded.sort.items
                        i.sort.assoc = exploded.sort.item(i.exp.assoc)
                        by.item(i.sort.assoc) = by.item.exploded(i.sort.assoc)<1, v>
                     next i.exp.assoc

                     if saving.exploded.field then
                        exp.key = item<1,v> : @vm : v : @vm : 0 : @vm : exploded.fno
                     end else
                        exp.key = item : @vm : v : @vm : 0 : @vm : exploded.fno
                     end
                     sortadd by.item, exp.key
                  end else              ;* Has subvalues, record sv position
                     for sv = 1 to nsv
                        if when.used then
                           if not(truth<1,v,sv>) then continue
                        end

                        by.item(exploded.sort) = exp.item<1,v,sv>

                        for i.exp.assoc = 1 to num.exploded.sort.items
                           i.sort.assoc = exploded.sort.item(i.exp.assoc)
                           by.item(i.sort.assoc) = by.item.exploded(i.sort.assoc)<1, v, sv>
                        next i.exp.assoc

                        if saving.exploded.field then
                           exp.key = item<1,v,sv> : @vm : v : @vm : sv : @vm : exploded.fno
                        end else
                           exp.key = item : @vm : v : @vm : sv : @vm : exploded.fno
                        end
                        sortadd by.item, exp.key
                     next sv
                  end
               next v
            end else    ;* Not an exploded sort
               sortadd by.item, item
            end
         end else     ;* Generating unsorted list, hence never exploded
            if saved.item then
               item.index = saved.item
               gosub get.item
               if saving.multivalued then
                  s = convert(@vm:@sm, @fm:@fm, item)
                  n = dcount(s, @fm)
                  for i = 1 to n
                     x = s<i>
                     if x = '' then
                        if not(saving.nulls) then continue
                     end
                     if saving.unique then
                        locate x in s.list<1> setting i then continue
                     end
                     s.list<-1> = x
                  next i
               end else
                  if len(item) = 0 then
                     if not(saving.nulls) then goto skip.record
                  end
                  if saving.unique then
                     locate item in s.list<1> setting i then goto skip.record
                  end
                  s.list<-1> = item
               end
            end else
               s.list<-1> = id
            end
         end

         if sample then
            sample.count -= 1
            if sample.count = 0 then exit
         end

skip.record:
      repeat


      * Now rebuild select list 12 if we have no sort item. If we are
      * sorting, we will use SORTNEXT/SORTDATA to get the items.

      if no.of.sort.items = 0 then formlist s.list to 12
   end else
      * 0364 Improved logic to avoid unnecessary reads.
      if hi.sel or search.command or show.command then
         deferred.select = @true
      end else if (count.command or select.command) and not(trusted.list) then
         deferred.select = @true
      end
   end

*-----------------------------------------------------------------------------
* Do the job

   if list.command or label.command or sum.command or raw.command then
      if lptr < 0 and not(no.page) then display @(-1) :
   end

   begin case
      case select.command or show.command
         if deferred.select then
            s.list = ''
            records.selected = 0
            loop
               if no.of.sort.items then
                  id = sortnext(sort.data)
                  if status() then exit
               end else
                  readnext id from 12 else exit
               end

               new.record = @true
               gosub check.selection

               if record.wanted then
                  s.list<-1> = id
                  records.selected += 1
               end
            repeat

         end else
            if no.of.sort.items then
               s.list = sortdata()
               records.selected = status()
            end else
               i = selectinfo(12, sl$count)  ;* Force completion of select
               s.list = select.list(12)
               records.selected = select.count(12)
               clearselect 12
            end
         end

         if show.command then gosub show.selection  ;* Refine list

         * Transfer to target list (this is an inline FORMLIST)

         select.list(target.list) = s.list
         select.count(target.list) = records.selected
         if target.list <= high.user.select then selected = records.selected

         qproc.ni = selectinfo(target.list, sl$count)
         if not(count.sup) then
            printline = ''
!!Has SHOW initialised the display handler?

            if sampling or sample then printline := sysmsg(7218) ;* Sample of
            printline := sysmsg(7219, qproc.ni, target.list) ;* xx record(s) selected to list xx
            if qdisp(QD$EMIT, printline, 'X') then goto qdisp.error
         end

      case count.command
         if deferred.select then
            qproc.ni = 0
            loop
               readnext id from 12 else exit
               new.record = @true
               gosub check.selection
               if record.wanted then qproc.ni += 1
            repeat
         end else
            qproc.ni = selectinfo(12, sl$count)
            clearselect 12
         end

         printline = ''
         if sampling or sample then printline := sysmsg(7218) ;* Sample of
         printline := sysmsg(7220, qproc.ni) ;* xx record(s) counted
         if qdisp(QD$EMIT, printline, 'X') then goto qdisp.error


      case list.command or reformat.command
         * We now have the correctly sequenced list of records to process.
         * If there was no sort clause this is in select list 12 and may
         * still contain ids of records to be rejected by assessment of
         * selection clauses.
         * If these was a sort clause, the list is in the sort system and
         * all record selection has already been done.

         for i = 1 to no.of.list.items
            list.item(i, ITEM.INCLUDED) = @true
         next i

         qproc.ni = 0
         loop
            if no.of.sort.items then
               id = sortnext(sort.data)
               if status() then exit
               exp.v = id<1,2>
               if exp.v # 0 then
                  exp.sv = id<1,3>
                  id = id<1,1>
                  explode = @true
               end else
                  explode = @false
               end
            end else
               readnext id, exp.v, exp.sv, int.data from 12 else exit
               explode = exp.v # 0
               if explode then
                  if exploded.assoc = 0 then
                     * Find the explosion association
                     for i = 1 to no.items
                        if item.type(i) = FIELD.ITEM then
                           if item.detail(i) = int.data then
                              exploded.assoc = item.assoc(i)
                              if exploded.assoc = 0 then ;* Item is not associated
                                 * Create a new association with just this
                                 * one item
                                 explosion.associated.in.dictionary = @false
                                 num.associations += 1
                                 dim when.op(num.associations)
                                 dim when.mask(num.associations)

                                 association.names<num.associations> = '__QM.EXPL__'
                                 for j = 1 to no.items
                                    if item.name(j) = item.name(i) then
                                       item.assoc(j) = num.associations
                                       associated.list.items<num.associations,-1> = j
                                   end
                                next j
                                exploded.assoc = num.associations
                              end
                              exit
                           end
                        end
                     next i
                  end
               end
            end
            new.record = @true

            if deferred.select then
               gosub check.selection
               if not(record.wanted) then continue
            end

            gosub show.record
         repeat


         if qproc.ni then
            * Do breakpoint after final record

            if no.of.breakpoints then
               last.breakpoint = @false
               for breakpoint.index = no.of.breakpoints to 1 step -1  ;* 0212
                  bp.ctrl = breakpoint.control(breakpoint.index)
                  list.index = breakpoint.list.index(breakpoint.index)
                  if (index(bp.ctrl, 'D', 1) = 0 or detail.lines > breakpoint.detail.count(breakpoint.index) + 1) and index(bp.ctrl, 'L', 1) = 0 then
!!                     last.breakpoint = (breakpoint.index = breakpoint.scan.index)
                     last.breakpoint = (breakpoint.index = 1)
                     gosub show.breakpoint
                  end else
                     gosub reset.breakpoint.counters
                     if not(det.sup) then
                        if qdisp(QD$EMIT, '', 'X') then goto qdisp.error
                     end
                  end
               next breakpoint.index
            end

            * Output final totals

            qproc.break.level = 255
            gosub show.accumulations
         end else
            * No items found to list
            if force then
               if qdisp(QD$EMIT, '', 'D') then goto qdisp.error
            end
         end

         if label.command then   ;* Emit last page
            if qdisp(QD$PAGE) then goto qdisp.error
         end

         if not(count.sup) then
            if qproc.ni = 0 then
               if qdisp(QD$NOHF) then goto qdisp.error
            end else
               if qdisp(QD$EMIT, '', 'X') then goto qdisp.error
            end
            printline = non.panned
            if margin then printline := space(margin)
            if sampling or sample then printline := sysmsg(7218) ;* Sample of
            begin case
               case reformat.command
                  printline := sysmsg(7289, qproc.ni, overwrite.count)
                     * %1 record(s) reformated, %2 record(s) overwritten
               case exploded.sort
                  printline := sysmsg(7221, exploded.item.count, qproc.ni)
               case sum.command
                  printline := sysmsg(7222, qproc.ni) ;* %1 record(s) summed
               case 1
                  printline := sysmsg(7223, qproc.ni) ;* %1 record(s) listed
            end case
            if qdisp(QD$EMIT, printline, 'X') then goto qdisp.error
         end

      case raw.command
         * We now have the correctly sequenced list of records to process.
         * If there was no sort clause this is in select list 12 and may
         * still contain ids of records to be rejected by assessment of
         * selection clauses.
         * If these was a sort clause, the list is in the sort system and
         * all record selection has already been done.

         qproc.ni = 0
         loop
            if no.of.sort.items then
               id = sortnext(sort.data)
               if status() then exit
            end else
               readnext id from 12 else exit
            end

            new.record = @true

            if deferred.select then
               gosub check.selection
               if not(record.wanted) then continue
            end

            read qproc.record from data.f, id then
               num.fields = dcount(qproc.record, @fm)

               if no.split then
                  * If there is insufficient space for this record on the
                  * current page, start a new page.

                  lines.required = num.fields + 2  ;* Blank, id, data
                  if qdisp(QD$NEED, lines.required) then goto qdisp.error
               end

               if qdisp(QD$EMIT, '', 'D') then goto qdisp.error
               if qdisp(QD$EMIT, id, 'D') then goto qdisp.error

               for fno = 1 to num.fields
                  printline = fmt(fno, '3"0"R') : ': ' : qproc.record<fno>
                  if qdisp(QD$EMIT, printline, 'D') then goto qdisp.error
               next fno
            end else
               gosub record.not.found
            end

            qproc.ni += 1
         repeat
   end case

*-----------------------------------------------------------------------------
* Report results

done:
   clearselect 12

   if (list.command or count.command or reformat.command) and len(not.found.list) then
      loop
         printline =  "'" : remove(not.found.list, not.found.delim) : "' not found"
         if qdisp(QD$EMIT, printline, 'X') then goto qdisp.error
      while not.found.delim
      repeat
   end

   if lptr >= 0 and pageseq.id # '' then
      write qdisp(QD$GETP) to pageseq.f, pageseq.id
   end

   qproc.record = ""           ;* Release memory in SYSCOM
   void qdisp(QD$END)

   @system.return.code = qproc.ni
   @selected = qproc.ni

exit.qproc:
   @sys0 = 0

qdisp.error:
   begin case
      case @sys0 = 0     ;* Normal exit
         null
      case @sys0 = 1     ;* Failed to initialise display handler
         null
      case @sys0 = 2     ;* User typed Q at pagination prompt
         @system.return.code = -ER$TERMINATED
      case @sys0 = 3     ;* User typed A at pagination prompt
         @system.return.code = -ER$TERMINATED
         abort
   end case

   void qdisp(QD$TERM)
   if overlay # '' then setpu PU$OVERLAY, lptr, old.overlay

   sortclear


final.exit:
   return to final.exit


* **********************************************************************
* ============================ Subroutines =============================
* **********************************************************************

* ======================================================================
* PARSE.COMMAND.OPTIONS  -  Process option keywords, fields, etc

parse.command.options:
   gosub get.token

   loop
   until token.type = PARSER$END
      begin case
         case keyword < 0   ;* Record id or field name
            if sum.command then item.report.mode = REPORT.TOTAL
            else item.report.mode = 0

            begin case
               case type # ''
                  gosub add.display.item
                  gosub check.field.modifiers
                  continue          ;* Already got next token

               case upcase(token) matches "F1N0N"
                  token = upcase(token)
                  token.type = PARSER$TOKEN
                  gosub add.display.item
                  gosub check.field.modifiers
                  continue          ;* Already got next token

               case 1    ;* Record id
                  source.records<-1> = token
            end case

* --- Filler keyword
         case keyword = KW$FILLER    ;* 0198
            null

* --- ABSENT.NULL
         case keyword = KW$ABSENT.NULL
            absent.null = @true

* --- ALL.MATCH
         case keyword = KW$ALL.MATCH and search.command
            all.match = @true

* --- AVERAGE
         case keyword = KW$AVERAGE and (report.command or reformat.command)
            item.report.mode = REPORT.AVERAGE
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- BETWEEN
         case keyword = KW$BETWEEN
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- BOXED
         case keyword = KW$BOXED
            boxed = @true

* --- BREAK.ON, BREAK.SUP
         case (keyword = KW$BREAK.ON or keyword = KW$BREAK.SUP) and (report.command or reformat.command)
            break.on = (keyword = KW$BREAK.ON)
            if no.of.breakpoints = MAX.BREAKPOINTS then
               display sysmsg(7224) ;* Too many breakpoints
               goto exit.qproc
            end
            no.of.breakpoints += 1

            gosub get.token
            if not(option(OPT.PICK.BREAKPOINT)) then gosub get.break.qualifier

            item.report.mode = if break.on then 0 else REPORT.BREAK.SUP
            gosub add.display.item

            breakpoint.list.index(no.of.breakpoints) = no.of.list.items
            breakpoint.items(no.of.breakpoints) = no.items
            item.breakpoint(no.items) = no.of.breakpoints

            if option(OPT.PICK.BREAKPOINT) then gosub get.break.qualifier

            i = index(breakpoint.control(no.of.breakpoints), 'B', 1)
            if i then
               if count(breakpoint.control(no.of.breakpoints), 'B') > 1 then
                  display sysmsg(7293) ;* Multiple B control codes on a single breakpoint
                  goto exit.qproc
               end

               i = breakpoint.control(no.of.breakpoints)[i+1,1]
               if not(i matches '1N') then i = 0
               if breakpoint.b.list.index(i) # 0 then
                  display sysmsg(7292) ;* Conflicting use of breakpoint B control option
                  goto exit.qproc
               end
               breakpoint.b.list.index(i) = no.of.list.items
            end

            gosub check.field.modifiers
            continue   ;* Already got next token

* --- BY
         case keyword = KW$BY
            gosub get.token
            literal.allowed = @true  ;* Allows better error message
            gosub add.field
            if item.type(item.index) = LITERAL.ITEM then
               display sysmsg(7225) ;* Sort item cannot be a literal value
               goto exit.qproc
            end
            sort.item.list<-1> = item.index
            sort.mode<-1> = SORT.BY
            gosub check.for.synonym   ;* Is there an AS following this item?
            continue    ;* Already read next token

* --- BY.DSND
         case keyword = KW$BY.DSND
            gosub get.token
            literal.allowed = @true  ;* Allows better error message
            gosub add.field
            if item.type(item.index) = LITERAL.ITEM then
               display sysmsg(7225) ;* Sort item cannot be a literal value
               goto exit.qproc
            end
            sort.item.list<-1> = item.index
            sort.mode<-1> = SORT.BY.DSND
            gosub check.for.synonym   ;* Is there an AS following this item?
            continue    ;* Already read next token

* --- BY.EXP
         case keyword = KW$BY.EXP and not(raw.command)
            if exploded.sort then
               display sysmsg(7226) ;* Only one exploded sort item is allowed
               goto exit.qproc
            end
            gosub get.token
            literal.allowed = @true  ;* Allows better error message
            gosub add.field
            if item.type(item.index) = LITERAL.ITEM then
               display sysmsg(7225) ;* Sort item cannot be a literal value
               goto exit.qproc
            end
            sort.item.list<-1> = item.index
            sort.mode<-1> = SORT.BY.EXP
            exploded.sort = dcount(sort.item.list, @fm)
            gosub check.for.synonym   ;* Is there an AS following this item?
            continue    ;* Already read next token

* --- BY.EXP.DSND
         case keyword = KW$BY.EXP.DSND and not(raw.command)
            if exploded.sort then
               display sysmsg(7226) ;* Only one exploded sort item is allowed
               goto exit.qproc
            end
            gosub get.token
            literal.allowed = @true  ;* Allows better error message
            gosub add.field
            if item.type(item.index) = LITERAL.ITEM then
               display sysmsg(7225) ;* Sort item cannot be a literal value
               goto exit.qproc
            end
            sort.item.list<-1> = item.index
            sort.mode<-1> = SORT.BY.EXP.DSND
            exploded.sort = dcount(sort.item.list, @fm)
            gosub check.for.synonym   ;* Is there an AS following this item?
            continue    ;* Already read next token

* --- CALC
         case keyword = KW$CALC and (report.command or reformat.command)
            item.report.mode = REPORT.CALC
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- COL.HDG.ID
         case keyword = KW$COL.HDG.ID and (report.command or show.command)
            col.hdg.id = @true

* --- COL.HDR.SUPP
         case keyword = KW$COL.HDR.SUPP and (report.command or show.command)
            col.sup = @true
            if page.heading = NUL then hdr.sup = @true

* --- COL.SPACES
         case keyword = KW$COL.SPACES and (report.command or show.command)
            gosub get.token
            if token matches "1N0N" then
               col.spacing = token + 0
            end else
               col.spacing = 1
               continue            ;* Do not fetch a new token
            end

* --- COL.SUP
         case keyword = KW$COL.SUP and (report.command or show.command)
            col.sup = @true

* --- COUNT.SUP
         case keyword = KW$COUNT.SUP and not(raw.command)
            count.sup = @true

* --- CSV
         case keyword = KW$CSV and report.command
            if delimited.report then
               display sysmsg(7290) ;* Multiple use of DELIMITER or CSV options
               goto exit.qproc
            end

            delimiter = ','
            delimited.report = @true
            csv = 1

            gosub get.token
            if token matches '1N' and token >= 1 and token <= 2 then ;* CSV level
               csv = token + 0
               gosub get.token
            end

            if token.type = PARSER$STRING then ;* Alternative delimiter
               gosub parse.delimiter
               if delimiter = '"' or len(delimiter) # 1 then
                  display sysmsg(7291) ;* CSV delimiter must be a single character other than a double quote
                  goto exit.qproc
               end
            end else
               continue    ;* Already read next token
            end

* --- CUMULATIVE
         case keyword = KW$CUMULATIVE and (report.command or reformat.command)
            item.report.mode = REPORT.CUMULATIVE
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- DBL.SPC
         case keyword = KW$DBL.SPC and report.command
            double.space = @true

* --- DEBUGGING
         case keyword = KW$DEBUGGING and option(OPT.QUERY.DEBUG)
            debugging = @true

* --- DELIMITER
         case keyword = KW$DELIMITER and report.command
            if delimited.report then
               display sysmsg(7290) ;* Multiple use of DELIMITER or CSV options
               goto exit.qproc
            end

            gosub get.token
            if token.type # PARSER$STRING then
               display sysmsg(7227) ;* Literal delimiter text not found where expected
               goto exit.qproc
            end

            gosub parse.delimiter
            delimited.report = @true
*2.2-4      col.sup = @true

* --- DET.SUP
         case keyword = KW$DET.SUP and (report.command or reformat.command)
            det.sup = @true
            id.sup = @true

* --- ENUMERATE
         case keyword = KW$ENUMERATE and (report.command or reformat.command)
            item.report.mode = REPORT.NUMBER
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- EQ
         case keyword = KW$EQ
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- EVAL
         case keyword = KW$EVAL
            if sum.command then item.report.mode = REPORT.TOTAL
            else item.report.mode = 0
            gosub add.display.item
            gosub check.field.modifiers
            continue          ;* Already got next token

* --- FOOTING
         case keyword = KW$FOOTING and (report.command or sum.command)
            gosub get.token
            if token.type # PARSER$STRING then
               display sysmsg(7229) ;* Literal footing text not found where expected
               goto exit.qproc
            end
            if page.footing = NUL then page.footing = token

* --- FORCE
         case keyword = KW$FORCE and list.command
            force = @true

* --- FROM
         case keyword = KW$FROM
            if source.list >= 0 then
               display sysmsg(7230) ;* More than one source select list specification
               goto exit.qproc
            end

            gosub get.token
            if not(token matches "1N0N") or token > HIGH.USER.SELECT then
               display sysmsg(7231) ;* Source select list number missing or invalidSource select list number missing or invalid
               goto exit.qproc
            end
            source.list = token + 0

* --- GE
         case keyword = KW$GE
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- GT
         case keyword = KW$GT
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- GRAND.TOTAL
         case keyword = KW$GRAND.TOTAL and report.command
            gosub get.token
            if token.type # PARSER$STRING then
               display sysmsg(7232) ;* Literal grand total text not found where expected
               goto exit.qproc
            end

            * Separate control codes from text

            grand.total.control = ''
            loop
            while token matches \0X"'"0X"'"0X\
               grand.total.control := upcase(matchfield(token, \0X"'"0X"'"0X\, 3))
               token = matchfield(token, \0X"'"0X"'"0X\, 1) : matchfield(token, \0X"'"0X"'"0X\, 5)
            repeat
            grand.total.text = token

* --- HDR.SUP
         case keyword = KW$HDR.SUP and (report.command or sum.command or raw.command or show.command)
            if page.heading = NUL then hdr.sup = @true

* --- HEADING
         case keyword = KW$HEADING and (report.command or sum.command or raw.command or show.command)
            gosub get.token
            if token.type # PARSER$STRING then
               display sysmsg(7233) ;* Literal heading text not found where expected
               goto exit.qproc
            end
            if page.heading = NUL then page.heading = token
            hdr.sup = @false

* --- ID.ONLY
         case keyword = KW$ID.ONLY and (list.command or show.command)
            id.only = @true

* --- ID.SUP
         case keyword = KW$ID.SUP and (list.command or show.command)
            id.sup = @true

* --- LABEL
         case keyword = KW$LABEL
            if label.template # '' then
               display sysmsg(7234) ;* Multiple label templates specified
               goto exit.qproc
            end

            gosub get.token        ;* Get template name
            if token.type = PARSER$END then
               display sysmsg(7235) ;* Label template name required
               goto exit.qproc
            end

            if keyword = kw$no.default then
               label.no.default = @true
            end else
               if dict.open then
                  read label.template from dict.file, token then
                     goto label.template.found
                  end
                  read label.template from dict.file, upcase(token) then
                     goto label.template.found
                  end
               end

               read label.template from @voc, token else
                  read label.template from @voc, upcase(token) else
                     display sysmsg(7236) ;* Label template record not found
                     goto exit.qproc
                  end
               end
label.template.found:
            end

* --- LE
         case keyword = KW$LE
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- LIKE
         case keyword = KW$LIKE
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- LOCKING
         case keyword = KW$LOCKING
            locking = @true

* --- LPTR
         case keyword = KW$LPTR and (list.command or raw.command)
            gosub get.token
            if token matches "1N0N" then
               lptr = token + 0
               if lptr > LPTR$HIGH.PRINT.UNIT then
                  display sysmsg(2053) ;* Invalid print unit number
                  goto exit.qproc
               end
            end else
               lptr = 0
               continue     ;* Already fetched next token
            end

* --- LT
         case keyword = KW$LT
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- MARGIN
         case keyword= KW$LEFT.MARGIN and list.command
            gosub get.token
            if token matches "1N0N" then
               margin = token + 0
            end else
               display sysmsg(7237) ;* Margin width required
               goto exit.qproc
            end

* --- MAX
         case keyword = KW$MAX and (report.command or reformat.command)
            item.report.mode = REPORT.MAX
            gosub add.qualified.display.item
            continue    ;* Already read next token

         case keyword = KW$MAX and show.command
            gosub get.token
            if token matches "1N0N" then
               max.list = token + 0
            end else
               display sysmsg(7238) ;* Item limit required in MAX
               goto exit.qproc
            end

* --- MIN
         case keyword = KW$MIN and (report.command or reformat.command)
            item.report.mode = REPORT.MIN
            gosub add.qualified.display.item
            continue    ;* Already read next token

         case keyword = KW$MIN and show.command
            gosub get.token
            if token matches "1N0N" then
               min.list = token + 0
            end else
               display sysmsg(7239) ;* Item limit required in MIN
               goto exit.qproc
            end

* --- NE
         case keyword = KW$NE
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- NEW.PAGE
         case keyword = KW$NEW.PAGE and list.command
            new.page = @true

* --- NO.CASE
         case keyword = KW$NO.CASE and search.command
            no.case = @true

* --- NO.INDEX
         case keyword = KW$NO.INDEX
            no.index = @true

* --- NO.MATCH
         case keyword = KW$NO.MATCH and search.command
            no.match = @true

* --- NO.PAGE
         case keyword = KW$NO.PAGE and list.command
            no.page = @true

* --- NO.SPLIT
         case keyword = KW$NO.SPLIT and (list.command or raw.command)
            no.split = @true

* --- OVERLAY
         case keyword = KW$OVERLAY and list.command
            gosub get.token
            if token = '' then
               display sysmsg(7296) ;* Overlay subroutine name required
               goto exit.qproc
            end

            overlay = token
            if not(catalogued(overlay)) then
               display sysmsg(7297) ;* Overlay subroutine is not catalogued
               goto exit.qproc
            end

* --- PAGESEQ
         case keyword = KW$PAGESEQ and list.command
            if pageseq.id # '' then
               display sysmsg(7308) ;* Multiple specification of page sequence
               goto exit.qproc
            end

            * Page sequence control file name
            gosub get.token
            if token = '' then
               display sysmsg(7309) ;* Page sequence control file name required
               goto exit.qproc
            end
            open token to pageseq.f else
               open upcase(token) to pageseq.f else
                  display sysmsg(7310) ;* Page sequence control file not found
                  goto exit.qproc
               end
            end

            * Page sequence control record name
            gosub get.token
            if token = '' then
               display sysmsg(7311) ;* Page sequence control record id required
               goto exit.qproc
            end
            pageseq.id = token
            readvu pageseq from pageseq.f, pageseq.id, 1 else pageseq = 1

            if not(pageseq matches '1N0N') then
               display sysmsg(7312) ;* Page sequence control record data is non numeric
               goto exit.qproc
            end

* --- PAN
         case keyword = KW$PAN and report.command
            if pan then
               display sysmsg(7240) ;* Multiple instances of PAN keyword
               goto exit.qproc
            end
            pan = no.of.list.items + 1

* --- PERCENT
         case keyword = KW$PERCENTAGE and (report.command or reformat.command)
            item.report.mode = REPORT.PERCENT
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- REPEATING
         case keyword = KW$REPEATING
            repeating = @true

* --- REQUIRE.INDEX
         case keyword = KW$REQUIRE.INDEX
            require.index = @true

* --- REQUIRE.SELECT
         case keyword = KW$REQUIRE.SELECT
            require.select = @true

* --- SAID
         case keyword = KW$SAID
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- SAMPLE
         case keyword = KW$SAMPLE
            gosub get.token
            if token matches "1N0N" then
               sample.count = token + 0
               if sample.count = 0 then
                  display sysmsg(7241) ;* Invalid sample record count
                  goto exit.qproc
               end
               gosub get.token
            end else
               sample.count = 10
            end
            sample = @true
            continue                 ;* Next token already read

* --- SAMPLED
         case keyword = KW$SAMPLED
            gosub get.token
            if token matches "1N0N" then
               sample.interval = token + 0
               if sample.interval = 0 then
                  display sysmsg(7242) ;* Invalid sample interval
                  goto exit.qproc
               end
               gosub get.token
            end else
               sample.interval = 10
            end
            sampling = @true
            continue                 ;* Next token already read

* --- SAVING
         case keyword = KW$SAVING and select.command
            gosub get.token

            if keyword = KW$UNIQUE then
               saving.unique = @true
               gosub get.token
            end

            if keyword = KW$MULTI.VALUE then
               saving.multivalued = @true
               gosub get.token
            end

            literal.allowed = @false
            gosub add.field
            if not(item.ok) then
!! 1.2-8 Why?  if item.report.mode # report.items then
                  display sysmsg(7243) ;* Field name required in SAVING clause
                  goto exit.qproc
!! 1.2-8       end
            end else
               saved.item  = item.index
            end

            gosub get.token

            * Look for NO.NULLS
            if keyword = KW$NO.NULLS then
               saving.nulls = @false
               gosub get.token
            end
            continue   ;* 0116

* --- SCROLL
         case keyword = KW$SCROLL and (list.command or raw.command)
            if scroll.depth then
               display sysmsg(7244) ;* Multiple instances of SCROLL keyword
               goto exit.qproc
            end
            gosub get.token
            if token matches "1N0N" then
               scroll.depth = token + 0
            end else
               scroll.depth = 9999999
               continue     ;* Already fetched next token
            end

* --- STYLE
         case keyword = KW$STYLE and (list.command)
            gosub get.token
            if token = '' then
               display sysmsg(7301) ;* Style name required
               goto exit.qproc
            end

            if keyword = KW$NONE then
               style.rec = @false
            end else
               call !vocrec(style.rec, token)
               if status() then
                  display sysmsg(7302) ;* Style record not in VOC
                  goto exit.qproc
               end

               if upcase(style.rec[1,1]) # 'X' then
                  display sysmsg(7303) ;* Style record is not an X-type VOC entry
                  goto exit.qproc
               end
            end

* --- TO
         case keyword = KW$TO and (select.command or show.command)
            gosub get.token
            if not(token matches "1N0N") or token > HIGH.USER.SELECT then
               display sysmsg(7245) ;* Target select list number missing or invalidSource select list number missing or invalid
               goto exit.qproc
            end
            target.list = token + 0

         case keyword = KW$TO and (report.command)
            if csv.pathname # '' then
               display sysmsg(7294) ;* Multiple specification of output filename
               goto exit.qproc
            end
            gosub get.token
            if token = '' then
               display sysmsg(7295) ;* Output filename required
               goto exit.qproc
            end
            if not(ospath(token, OS$PATHNAME)) then
               display sysmsg(7298) ;* Output filename is not a valid pathname
               goto exit.qproc
            end
            csv.pathname = token
            hdr.sup = @true  ;* Cannot include as we don't use _HF to format
            no.page = @true
            gosub get.token

            begin case
               case keyword = KW$APPENDING ; csv.append = @true
               case keyword = KW$NO.QUERY  ; csv.no.query = @true
               case 1                      ; continue
            end case

         case keyword = KW$TO and reformat.command
            if reformat.filename # '' then
               display sysmsg(7294) ;* Multiple specification of output filename
               goto exit.qproc
            end

            gosub get.token
            if token = '' then
               display sysmsg(7295) ;* Output filename required
               goto exit.qproc
            end

            reformat.filename = token
            open reformat.filename to reformat.f else
               open upcase(reformat.filename) to reformat.f else
                  display sysmsg(1427, reformat.filename)  ;* Cannot open %1
                  goto exit.qproc
               end
               reformat.filename = upcase(reformat.filename)
            end

* --- TOTAL
         case keyword = KW$TOTAL and (report.command or reformat.command)
            item.report.mode = REPORT.TOTAL
            gosub add.qualified.display.item
            continue    ;* Already read next token

* --- UNLIKE
         case keyword = KW$UNLIKE
            gosub implicit.selection.clause
            continue           ;* Already read next token

* --- USING
         case keyword = KW$USING
            call @parser(PARSER$MFILE, token.type, token, keyword) ;* 0462
            if keyword = KW$DICT then
               using.dict = 'DICT'
               call @parser(PARSER$MFILE, token.type, token, keyword) ;* 0462
            end else
               using.dict = ''
            end

            if token.type = PARSER$END then
               display sysmsg(7246) ;* File name required in USING clause
               goto exit.qproc
            end

            open using.dict, token to dict.file else
               open using.dict, upcase(token) to dict.file else
                  display sysmsg(1427, trimf(using.dict : ' ' : token)) ;* Cannot open xx
                  goto exit.qproc
               end
            end

            dict.open = @true

* --- VERTICALLY
         case keyword = KW$VERTICALLY and report.command
            vertical = @true

* --- WHEN
         case keyword = KW$WHEN
            when.clause = @true
            when.used = @true
            gosub process.selection.clause
            continue           ;* Already read next token

* --- WITH
         case keyword = KW$WITH
            when.clause = @false
            gosub process.selection.clause
            continue           ;* Already read next token

* --- Unrcognised keyword
         case 1    ;* Treat unrecognised keywords as record ids
            source.records<-1> = token
      end case

      gosub get.token
   repeat

   return

* ======================================================================
* GET.BREAK.QUALIFIER  -  Process BREAK.ON / BREAK.SUP control codes

get.break.qualifier:
   breakpoint.string(no.of.breakpoints) = '**'

   if token.type = PARSER$STRING then
      * Separate control codes from text
      s = ''
      loop
      while token matches \0X"'"0X"'"0X\
         i = upcase(matchfield(token, \0X"'"0X"'"0X\, 3))
         * We need to mark the position of the V control code so that the text
         * is inserted at the right point. Drop in an item mark to do the job.
         j = if index(i, 'V', 1) then @im else ''
         s := i
         token = matchfield(token, \0X"'"0X"'"0X\, 1) : j : matchfield(token, \0X"'"0X"'"0X\, 5)
      repeat

      breakpoint.control(no.of.breakpoints) = s

      * The D option suppress the ** default marker (1.4-11)
      if not(option(OPT.PICK.BREAKPOINT)) then
         if index(s, 'D', 1) then breakpoint.string(no.of.breakpoints) = ''
      end

      * Anything that is left replaces the default ** marker
      if token # '' then breakpoint.string(no.of.breakpoints) = token

      gosub get.token
   end
   return

* ======================================================================
* Parse delimiter for DELIMITER or CSV options

parse.delimiter:
   * Replace ^nnn tokens

   n = count(token, "^")
   loop
   while n
      i = index(token, "^", n)
      c = upcase(token[i + 1, 1])
      begin case
         case c = "^"           ;* Literal up arrow
            token = token[1, i] : token[i + 2, 99999]
            n -= 1

         case token[i + 1, 3] matches '3N'
            j = token[i + 1, 3] + 0
            if j > 255 then stop sysmsg(7228) ;* Invalid ^nnn character reference
            token = token[1, i - 1] : char(j) : token[i + 4, 99999]
      end case

      n -= 1
   repeat

   * Replace <TAB> tokens

   token = change(token , '<TAB>', char(9))
   delimiter = change(token , '<tab>', char(9))

   return

* ======================================================================
* PROCESS.SELECTION.CLAUSE  -  WITH / WHEN processing
*
* On entry:
*    when.clause = Doing WHEN (rather than WITH)

implicit.selection.clause:
   is.qualified.display.clause = @false
   * This is a query such as
   *   LIST VOC LIKE "A..."
   * where there is no WITH keyword before the conditional element.
   * Assume @ID as the default field.

   implicit.keyword = keyword
   token = "@ID"
   literal.allowed = @false
   gosub add.field.by.name
   keyword = implicit.keyword

qualified.display.clause:       ;* Enter here for Pick style qualified display
   when.clause = @false
   gosub start.selection.clause

   hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
   selection(hi.sel,SEL.ARG1) = item.index
   selection.field = item.index

   every = @false
   goto process.operator   

process.selection.clause:
   is.qualified.display.clause = @false
   gosub start.selection.clause

   gosub get.token
   default.field1.allowed = @false

   loop
      hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
      every = @false
      loop
      while token.type = PARSER$LBR
         parenthesis.level += 1
         gosub get.token
      repeat

      begin case
* --- NO
         case keyword = KW$NO   ;* 0.3-6 and not(default.field1.allowed)
            if when.clause then
               display sysmsg(7248, token) ;* xx not valid in WHEN clause
               goto exit.qproc
            end
            selection(hi.sel,SEL.OP) = OP.NO
            hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
            gosub get.token

* --- EVERY
         case keyword = KW$EVERY
            if when.clause then
               display sysmsg(7248, token) ;* xx not valid in WHEN clause
               goto exit.qproc
            end
            every = @true
            gosub get.token
      end case


      if default.field1.allowed then 
         * Check for an operator without a field name.  This defaults to the
         * last field used in a selection clause or the record id if this is
         * the first.

         begin case
            case keyword = KW$EQ
            case keyword = KW$NE
            case keyword = KW$LT
            case keyword = KW$LE
            case keyword = KW$GT
            case keyword = KW$GE
            case keyword = KW$LIKE
            case keyword = KW$UNLIKE
            case keyword = KW$SAID
            case keyword = KW$BETWEEN
            case token.type = PARSER$STRING

            case 1
               goto get.first.field
         end case

         * Use same field as last time

         item.index = selection.field
         selection(hi.sel,SEL.ARG1) = item.index

         if token.type = PARSER$STRING then
            op = last.op
            selection(hi.sel,SEL.OP) = op
            goto using.last.op
         end

         goto process.operator
      end

get.first.field:
      * Process first field name

      if token.type = parser$end then
         display sysmsg(7249) ;* Field name missing in selection clause
         goto exit.qproc
      end

      literal.allowed = @true  ;* Not really but allows better error message
      gosub add.field
      if item.type(item.index) = LITERAL.ITEM then
         display sysmsg(7250, token) ;* xx is not a field name or expression
         goto exit.qproc
      end

      selection.field = item.index
      gosub get.token
      selection(hi.sel,SEL.ARG1) = item.index

      * Check for implied EQ in Pick style WITH FLD "value"

      if token.type = PARSER$STRING and quote.char = '"' then
         if option(OPT.PICK.IMPLIED.EQ) then
            op = OP.EQ
            if every then op += 1
            if option(OPT.QUERY.NO.CASE) then op += 2
            selection(hi.sel,SEL.OP) = op
            last.op = op
            between = 0
            goto implied.equals
         end
      end

!!      if emitting.when.clause then
!!         if when.assoc = '__UNSET__' then
!!            when.assoc = item.assoc(item.index)
!!         end else if when.assoc # item.assoc(item.index) then
!!            display sysmsg(7251) ;* All WHEN clause items must be in the same association
!!            goto exit.qproc
!!         end
!!      end

      * Process operator (if present; defaults to NE '')

process.operator:
      between = 0
      begin case
         case keyword = KW$EQ     ; op = OP.EQ
         case keyword = KW$NE     ; op = OP.NE
         case keyword = KW$LT     ; op = OP.LT
         case keyword = KW$LE     ; op = OP.LE
         case keyword = KW$GT     ; op = OP.GT
         case keyword = KW$GE     ; op = OP.GE
         case keyword = KW$LIKE   ; op = OP.LIKE
         case keyword = KW$UNLIKE ; op = OP.UNLIKE
         case keyword = KW$SAID   ; op = OP.SAID
         case keyword = KW$BETWEEN; op = OP.BETWEEN   ; between = 1
         case 1                   ; op = OP.NOT.NULL
      end case

      if every then op += 1
      if option(OPT.QUERY.NO.CASE) then op += 2
      selection(hi.sel,SEL.OP) = op
      last.op = op

      if bitand(op, 0xFC) # OP.NOT.NULL then   ;* 0525
         * Process second field or literal value

         gosub get.token
         if token.type = parser$end then
            display sysmsg(7249) ;* Field name missing in selection clause
            goto exit.qproc
         end

         if keyword = KW$NO.CASE then
            op = bitor(op - OP.FIRST.MV, 2) + OP.FIRST.MV
            selection(hi.sel,SEL.OP) = op
            last.op = op
            gosub get.token
         end

implied.equals:
between.op2:
using.last.op:
         literal.allowed = @true
         gosub add.field

         selection(hi.sel,SEL.ARG2) = item.index

         * Comparison with literal values requires special actions...

         if item.type(item.index) = LITERAL.ITEM then
            begin case
               case op >= OP.SAID and op <= OP.SAID + 3
                  * The SAID operator requires that the literal value is
                  * converted to its soundex code.
                  item.detail(item.index) = soundex(item.detail(item.index))

               case op >= OP.LIKE and op <= OP.UNLIKE + 3
                   * The comparison uses external form data.
                  null

               case 1
                  if option(OPT.PICK.WILDCARD) then
                     * 0106 Allow for Pick wildcard in implicit OR. The
                     * operator will have been changed to OP.PEQ or OP.PNE.
                     * These need to be preserved into the later conditions
                     * synonyms for OP.LIKE and OP.UNLIKE

                     if (op >= OP.EQ and op <= op.NE + 3) or (op >= OP.PEQ and op <= OP.PNE + 3) then 
                        s = item.detail(item.index)
                        if s[1,1] = '[' or index(s, '^', 1) or s[1] = ']' then
                           * It's a Pick wildcard. Convert to a LIKE/UNLIKE.
                           begin case
                              case index(s, '"', 1) = 0 ; c = '"'
                              case index(s, "'", 1) = 0 ; c = "'"
                              case 1
                                 display 'Pick wildcard cannot be converted to LIKE/UNLIKE'
                                 goto exit.qproc
                           end case

                           if s[1,1] = '[' then
                              x = '...' : c
                              s = s[2,9999]
                           end else
                              x = c
                           end

                           if s[1] = ']' then
                              x := s[1,len(s)-1] : c : '...'
                           end else
                              x := s : c
                           end

                           item.detail(item.index) = change(x, '^', c:'1X':c)

                           if op < OP.PEQ then   ;* Must be EQ or NE variants
                              op += OP.PEQ - OP.EQ
                           end
                           selection(hi.sel,SEL.OP) = op
                           last.op = op
                        end
                     end
                  end

                  * A conversion code on the selection field requires that we
                  * convert the literal value to the internal form of the data.

                  s = item.conv(selection.field)
                  if s # '' then
                     item.detail(item.index) = iconv(item.detail(item.index), s)
                  end
            end case
         end else      ;* Comparing with another field
            null
         end

         gosub get.token
      end

      if between = 1 then      ;* Processed first BETWEEN argument
         * Move "low" value to arg3 so that standard code can be used
         * to put "high" value into arg2.
         selection(hi.sel,SEL.ARG3) = selection(hi.sel,SEL.ARG2)
         between = 2
         goto between.op2
      end

check.and.or:
      default.field1.allowed = @true

      closed.parenthesis = @false      ;* 1.3-4
      loop
      while token.type = PARSER$RBR
         if parenthesis.level = 1 then
            display sysmsg(7252) ;* Unexpected close bracket
            goto exit.qproc
         end
         gosub fix.up.jumps
         parenthesis.level -= 1
         gosub get.token
         closed.parenthesis = @true    ;* 1.3-4
      repeat

      begin case
         case is.qualified.display.clause
            exit

         case keyword = KW$OR
            gosub fix.up.jumps
            if option(OPT.QUERY.PRIORITY.AND) then parenthesis.level -= 1

            hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
            selection(hi.sel,SEL.OP) = OP.OR
            selection(hi.sel,SEL.ARG2) = parenthesis.level
            gosub get.token
            if keyword = KW$WITH then gosub get.token

            if option(OPT.QUERY.PRIORITY.AND) then parenthesis.level += 1

            if token.type = PARSER$LBR then
               parenthesis.level += 1
               gosub get.token
            end

         case keyword = KW$AND
            gosub fix.up.jumps
            hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
            selection(hi.sel,SEL.OP) = OP.AND
            selection(hi.sel,SEL.ARG2) = parenthesis.level
            gosub get.token
            if keyword = KW$WITH then
               when.clause = @false
               gosub get.token
            end else if keyword = KW$WHEN then
               hi.sel += 1
               if hi.sel > max.selection then gosub extend.selection.table
               else selection(hi.sel,SEL.OP) = OP.WHEN
               selection(hi.sel,SEL.ARG2) = 0
               when.used = @true
               when.clause = @true
               gosub get.token
            end

            if token.type = PARSER$LBR then
               parenthesis.level += 1
               gosub get.token
            end

         case bitand(last.op, 0xFC) # OP.NOT.NULL and token.type = PARSER$STRING and not(between) and not(closed.parenthesis)   ;* 0525
* 1.3-4 Added test of closed.parenthesis to stop query such as
*          with (a = b) c
*       being treated as implicit or:
*          with a = b c

            * Implicit OR
            hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
            selection(hi.sel,SEL.OP) = OP.OR
            selection(hi.sel,SEL.ARG2) = parenthesis.level

         case 1
            exit
      end case
   repeat

   first.selection = @false

   gosub fix.up.jumps
   parenthesis.level -= 1

   if parenthesis.level then
      display sysmsg(7253) ;* Unclosed brackets in selection expression
      goto exit.qproc
   end

   gosub fix.up.jumps

   * 0106 Change any condition using OP.PEQ/OP.PNE to OP.LIKE/OP.UNLIKE

   for i = 1 to hi.sel
      op = selection(i,SEL.OP)
      if op >= OP.PEQ and op <= OP.PNE + 3 then
         selection(i,SEL.OP) -= OP.PEQ - OP.LIKE
      end
   next i

   return

* --------------------------------------------------

start.selection.clause:
   if not(first.selection) then
      hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
      if option(OPT.WITH.IMPLIES.OR) then selection(hi.sel,SEL.OP) = OP.OR
      else selection(hi.sel,SEL.OP) = OP.AND
      selection(hi.sel,SEL.ARG2) = 0
   end
   if when.clause # emitting.when.clause then
      hi.sel += 1 ; if hi.sel > max.selection then gosub extend.selection.table
      selection(hi.sel,SEL.OP) = if when.clause then OP.WHEN else OP.WITH
      selection(hi.sel,SEL.ARG2) = 0
   end

   emitting.when.clause = when.clause
   parenthesis.level = 1

   return

* --------------------------------------------------

fix.up.jumps:
   for i = 1 to hi.sel
      op = selection(i,SEL.OP)
      if op = OP.OR or op = OP.AND then
         if selection(i,SEL.ARG2) = parenthesis.level then
            selection(i,SEL.ARG1) = hi.sel + 1
            selection(i,SEL.ARG2) = -1    ;* Mark as fixed up
         end
      end
   next i
   return

* ======================================================================
* ADD.DISPLAY.ITEM  -  Add a field to the displayed item list
*
* On entry:
*   item.report.mode = 0                  Nothing special
*                      REPORT.AVERAGE     AVG fld [NO.NULLS]
*                      REPORT.NUMBER      ENUM fld
*                      REPORT.MAX         MAX fld
*                      REPORT.MIN         MIN fld [NO.NULLS]
*                      REPORT.PERCENT     PCT [n] fld
*                      REPORT.TOTAL       TOTAL fld
*                      REPORT.BREAK.SUP   BREAK.SUP fld
*                      REPORT.CUMULATIVE  CUMULATIVE keyword

add.display.item:
   if item.report.mode and item.report.mode # REPORT.BREAK.SUP then
      accumulating = @true
   end

   literal.allowed = @false
   gosub add.field    ;* Add this field to item tables
   if not(item.ok) then    ;* 0232
      display sysmsg(7254, token) ;* Invalid field name 'xx'
      goto exit.qproc
   end

   * Now add a reference to the field to the display tables

   if no.of.list.items = max.list.items then gosub extend.list.item.tables

   no.of.list.items += 1
   list.item(no.of.list.items, ITEM.NO) = item.index
   list.item(no.of.list.items, ITEM.MODE) = item.report.mode
   list.item(no.of.list.items, ITEM.COUNT) = 0
   list.item(no.of.list.items, ITEM.ACCUM.VALUE) = 0
   list.item(no.of.list.items, ITEM.LOCAL.COUNT) = 0
   list.item(no.of.list.items, ITEM.LOCAL.VALUE) = 0
   list.item(no.of.list.items, ITEM.TOTAL) = 0

   if num.associations then
      dim when.op(num.associations)
      dim when.mask(num.associations)
   end

!!   * Build list of displayed items by association
!!
!!   if item.multivalued(item.index) then
!!      s = item.assoc(item.index) ; if s = '' then s = '~'
!!      locate s in association.names<1> setting i else
!!         num.associations += 1
!!         association.names<i> = s
!!      end
!!      associated.list.items<i,-1> = item.index
!!   end
   
   if item.report.mode = REPORT.PERCENT then
      pct.list<-1> = no.of.list.items
      item.fmt(item.index) = (3 + pct.dp + (pct.dp # 0)) : 'R'
      item.conv(item.index) = "MD" : pct.dp : "0"
      gosub get.width.and.justification
   end

   gosub get.token

   if option(OPT.QUAL.DISPLAY) then
      * Check for qualified display clause
      begin case
         case keyword < 0         ; goto not.qualified
         case keyword = KW$EQ
         case keyword = KW$NE
         case keyword = KW$LT
         case keyword = KW$LE
         case keyword = KW$GT
         case keyword = KW$GE
         case keyword = KW$LIKE
         case keyword = KW$UNLIKE
         case keyword = KW$SAID
         case 1                   ; goto not.qualified
      end case

      * Looks like a qualified display clause

      qual.item.index = item.index
      is.qualified.display.clause = @true
      gosub qualified.display.clause
      item.index = qual.item.index
   end
not.qualified:

   return

* ======================================================================
* Check for modifying keywords

check.field.modifiers:
   if item.report.mode # REPORT.BREAK.SUP then
      loop
         begin case
            case keyword < 0
               exit

            case keyword = KW$AS
               gosub get.token   ;* synonym
               if token.type = PARSER$END then
                  display sysmsg(7255, item.name(item.index)) ;* Synonym required for xx
                  goto exit.qproc
               end

               locate token in synonyms<1> setting i then
                  display sysmsg(7256, item.name(item.index)) ;* Duplicated synonym in xx
                  goto exit.qproc
               end

               ins token before synonyms<i>
               ins item.index before synonym.refs<i>

            case keyword = KW$ASSOC
               gosub get.raw.token
               if token.type = PARSER$END then
                  display sysmsg(7257) ;* Association name required after ASSOC
                  goto exit.qproc
               end

               s = token ; gosub add.item.association

            case keyword = KW$ASSOC.WITH
               gosub get.token
               if token.type # PARSER$TOKEN then
                  display sysmsg(7258) ;* Associated field name required after ASSOC.WITH
                  goto exit.qproc
               end

               read s from dict.file, token else
                  read s from dict.file, upcase(token) else
                     display sysmsg(7259, token) ;* Associated field xx not found in dictionary
                     goto exit.qproc
                  end
               end

               if listindex('D,I,C', ',', s[1,1]) = 0 then
                  display sysmsg(7260, token) ;* Associated item xx is not of suitable type
                  goto exit.qproc
               end

               s = s<7> ; gosub add.item.association

            case keyword = KW$COL.HDG
               gosub get.token
               if token.type # PARSER$STRING then
                  display sysmsg(7261) ;* Literal column heading text not found where expected
                  goto exit.qproc
               end

               * Replace 'L' control token with value mark allowing either
               * single or double quotes.
               token = change(token, "'L'", @vm)  ;* 0357
               token = change(token, '"L"', @vm)  ;* 0357
               item.display.name(item.index) = token
               item.flags(item.index) = bitor(item.flags(item.index), IFLG.COL.HDG)

            case keyword = KW$CONV
               gosub get.token
               if token.type # PARSER$STRING then
                  display sysmsg(7262) ;* Conversion specification not found where expected
                  goto exit.qproc
               end

               item.to.list = list.item(no.of.list.items, ITEM.NO)
               item.conv(item.to.list) = token

            case keyword = KW$DISPLAY.LIKE
               gosub get.token
               if token.type # PARSER$TOKEN then
                  display sysmsg(7263) ;* Field name or synonym required after DISPLAY.LIKE
                  goto exit.qproc
               end

               locate token in synonyms<1> setting i then
                  i = synonym.refs<i>
                  item.display.name(item.index) = item.display.name(i)
                  item.fmt(item.index) = item.fmt(i)
                  gosub get.width.and.justification
                  item.conv(item.index) = item.conv(i)
                  item.assoc(item.index) = item.assoc(i)
                  item.multivalued(item.index) = item.multivalued(i)
                  item.totals(item.index) = item.totals(i)
                  item.breakpoint(item.index) = item.breakpoint(i)
                  item.flags(item.index) = item.flags(i)
               end else
                  begin case
                     case listindex('D,I,C', ',', type)
                        s = dict.rec<dict.display.name> ; gosub set.col.hdg
                        item.fmt(item.index) = dict.rec<dict.format>
                        gosub get.width.and.justification
                        item.conv(item.index) = dict.rec<dict.conv>
                        s = dict.rec<dict.assoc> ; gosub add.item.association
                        item.multivalued(item.index) = dict.rec<dict.s.m>[1,1] = "M"
                        item.totals(item.index) = 0
                        item.breakpoint(item.index) = 0
                        item.flags(item.index) = 0

                        if option(OPT.ASSOC.UNASSOC.MV) then
                           if item.multivalued(item.index) and item.assoc(item.index) = 0 then
                              s = '__QPROC.ASSOC__' ; gosub add.item.association
                           end
                        end

                     case dict.rec # ''
                        display sysmsg(7264, token) ;* xx is not a D or I-type dictionary item
                        goto exit.qproc

                     case 1
                        display sysmsg(7263) ;* Field name or synonym required after DISPLAY.LIKE
                        goto exit.qproc
                  end case
               end

            case keyword = KW$FMT
               gosub get.token
               if token.type # PARSER$STRING then
                  display sysmsg(7265) ;* Format specification not found where expected
                  goto exit.qproc
               end

               item.index = list.item(no.of.list.items, ITEM.NO)
               item.fmt(item.index) = token

               gosub get.width.and.justification

            case keyword = KW$MULTI.VALUE
               item.to.list = list.item(no.of.list.items, ITEM.NO)
               item.multivalued(item.to.list) = @true

            case keyword = KW$NO.NULLS and (item.report.mode = REPORT.AVERAGE or item.report.mode = REPORT.MIN)
               list.item(no.of.list.items, ITEM.MODE) = bitor(list.item(no.of.list.items, ITEM.MODE), REPORT.NO.NULLS)

            case keyword = KW$SINGLE.VALUE
               item.to.list = list.item(no.of.list.items, ITEM.NO)
               item.multivalued(item.to.list) = @false

            case 1
               exit
         end case

         gosub get.token
      repeat
   end

   return

* ======================================================================
* ADD.ITEM.ASSOCIATION
* s = association name
* item.index = item table reference

add.item.association:
   if s = '' then
      item.assoc(item.index) = 0
   end else
      locate s in association.names<1> setting pos else
         num.associations += 1
         dim when.op(num.associations)
         dim when.mask(num.associations)
         association.names<pos> = s
      end

      item.assoc(item.index) = pos

      locate item.index in associated.list.items<pos,1> setting i else
         associated.list.items<pos,-1> = item.index
      end
   end

   return

* ======================================================================
* GET.TOKEN  -  Get a command token, expanding phrases
*
* Returns:
*    token           Actual token processed
*    token.type      Token type from parser
*    keyword         Keyword value if VOC K type record, else -1
*    dict.rec        Dictionary/VOC record   (null if not found)
*    type            Dictionary/VOC record type (D or I; phrases expanded)
*    from.voc        Token came from the VOC?

get.token:
!0198   loop
      call @parser(PARSER$GET.TOKEN, token.type, token, keyword, parser.voc.rec, quote.char)
!0198   while keyword = KW$FILLER
!0198   repeat

   type = ''
   dict.rec = ''
   from.voc = @false    ;* 0316

   if token.type # PARSER$TOKEN then return    ;* 0092  Moved

   locate token in synonyms<1> setting i then
      type = 'I'
      keyword = -1
      return
   end

   if dict.open then
      read dict.rec from dict.file, token then
         type = upcase(dict.rec[1,1])
         if listindex('A,C,D,I,S', ',', type) then
            keyword = -1
            return
         end
         if type = 'K' then return
         if dict.rec[1,2] = "PH" then goto is.phrase
      end
   end

   read dict.rec from @voc, token then
      from.voc = @true    ;* 0316
      type = upcase(dict.rec[1,1])
      if listindex('A,C,D,I,S', ',', type) then return

      if type = 'K' then
         if dict.rec<2> = 0 then goto get.token   ;* Throw away token
         return
      end
      if dict.rec[1,2] = "PH" then goto is.phrase
   end

   if dict.open then
      read dict.rec from dict.file, upcase(token) then
         from.voc = @false    ;* 0316
         type = upcase(dict.rec[1,1])
         if listindex('A,C,D,I,S', ',', type) then
            keyword = -1
            token = upcase(token)
            return
         end
         if type = 'K' then return
         if dict.rec[1,2] = "PH" then goto is.phrase
      end
   end

   read dict.rec from @voc, upcase(token) then
      from.voc = @true    ;* 0316
      type = upcase(dict.rec[1,1])
      if listindex('A,C,D,I,S', ',', type) then
         token = upcase(token)
         return
      end
      if type = 'K' then
         if dict.rec<2> = 0 then goto get.token
         return
      end
      if dict.rec[1,2] = "PH" then goto is.phrase
   end

   from.voc = @false    ;* 0316

   * Is it a link?

   if index(token, '%', 1) then
      link.name = field(token, '%', 1)
      read dict.rec from dict.file, link.name else
         read dict.rec from dict.file, upcase(link.name) else null
      end
      type = upcase(dict.rec[1,1])
      if type = 'L' then
         keyword = -1
         return
      end
   end

   * Try special cases of @ID and Fn, making pseudo dictionary records

   if upcase(token) = '@ID' then
      type = 'D'
      dict.rec = 'D'
      dict.rec<DICT.LOC> = 0
      dict.rec<DICT.DISPLAY.NAME> = '@ID'
      dict.rec<DICT.FORMAT> = '12L'
      dict.rec<DICT.S.M> = 'S'
      return
   end

   if upcase(token) matches 'F1N0N' then
      type = 'D'
      dict.rec = 'D'
      dict.rec<DICT.LOC> = token[2,999]
      dict.rec<DICT.DISPLAY.NAME> = token
      dict.rec<DICT.FORMAT> = '15T'
      dict.rec<DICT.S.M> = 'S'
      return
   end

   * Not a field name

   type = ''
   dict.rec = ''
   token.type = PARSER$STRING
   return

is.phrase:
   * Merge continuation lines

   s = dict.rec<2>
   loop
      del dict.rec<2>
   while s[1] = '_'
      s = s[1, len(s)-1]:' ':dict.rec<2>
   repeat
   call @parser(PARSER$EXPAND, 0, s, 0)
   goto get.token


* ======================================================================
* GET.RAW.TOKEN  -  Fetch command token with no processing

get.raw.token:
   call @parser(PARSER$GET.TOKEN, token.type, token, keyword)
   return

* ======================================================================
* READ.RECORD  -  Read new data record
*
* On entry:
*   id = record id to read
* On return:
*   qproc.record holds data
*   qproc.id = id
*   record.found indicates if found in file
*   new.record flag will be cleared

read.record:
   record.found = @true
   read qproc.record from data.f, id else
      if not(absent.null) then
         gosub record.not.found
         record.found = @false
      end
   end
   qproc.id = id
   new.record = @false

   return

* ======================================================================
* CHECK.RECORD  -  Check record exists
*
* On entry:
*   id = record id to read
* On return:
*   record.found indicates if found in file
*   new.record is unchanged

check.record:
   record.found = @true
   readv s from data.f, id, 0 else
      if not(absent.null) then
         gosub record.not.found
         record.found = @false
      end
   end

   return

* ======================================================================
* CHECK.SELECTION  -  Check selection clause for current record
*
* Returns:
*   record.wanted flag

check.selection:
   * Check record exists

   begin case
      case field.sel or search.command    ;* Need to read the record
         gosub read.record
      case hi.sel                         ;* Id or literal based selection
         gosub check.record
      case trusted.list                   ;* Want everything
         record.wanted = @true
         return
      case 1
         gosub check.record
   end case

   if not(record.found) then
      record.wanted = @false
      return
   end

   truth = @true
   if hi.sel = 0 then goto want.record  ;* May still have a SEARCH to check

   sel.idx = non.ak.selection.index
   loop
   while sel.idx <= hi.sel
      inverse = @false

      loop
         op = selection(sel.idx,SEL.OP)
         begin case
            case op = OP.NO     ; inverse = @true
            case op = OP.WHEN   ; null                 ;* Ignore at this stage
            case 1 ; exit
         end case

         sel.idx += 1
      repeat

      * Fetch record / value for item 1

      item.index = selection(sel.idx,SEL.ARG1)
      item1.conv = item.conv(item.index)
      item1.type = item.type(item.index)
      item1.mv = item.multivalued(item.index)
      gosub get.item
      item1 = item

      op  = selection(sel.idx,SEL.OP)

      if bitand(op, 0xFC) # OP.NOT.NULL then   ;* 0525
         * Fetch record / value for item 2
         item.index = selection(sel.idx,SEL.ARG2)
         ! item2.conv = item.conv(item.index)
         gosub get.item
         item2 = item

         * If we are processing a file with case insensitive ids and item 1
         * is the record id, map both items to upper case.

         if is.case.insensitive then  ;* 0394
            if item1.type = ID.ITEM then
               item1 = upcase(item1)
               item2 = upcase(item2)
            end
         end
      end

      * Perform comparison

!!OPCODES!!
      on op goto op.error,      ;* OP.WITH
                 op.error,      ;* OP.WHEN
                 op.error,      ;* OP.NO
                 test.eq,       ;* OP.EQ
                 every.eq,      ;* OP.EQ with EVERY
                 test.eq.nc,    ;* OP.EQ with NO.CASE
                 every.eq.nc,   ;* OP.EQ with EVERY and NO.CASE
                 test.ne,       ;* OP.NE
                 every.ne,      ;* OP.NE with EVERY
                 test.ne.nc,    ;* OP.NE with NO.CASE
                 every.ne.nc,   ;* OP.NE with EVERY and NO.CASE
                 test.lt,       ;* OP.LT
                 every.lt,      ;* OP.LT with EVERY
                 test.lt.nc,    ;* OP.LT with NO.CASE
                 every.lt.nc,   ;* OP.LT with EVERY and NO.CASE
                 test.le,       ;* OP.LE
                 every.le,      ;* OP.LE with EVERY
                 test.le.nc,    ;* OP.LE with NO.CASE
                 every.le.nc,   ;* OP.LE with EVERY and NO.CASE
                 test.ge,       ;* OP.GE
                 every.ge,      ;* OP.GE with EVERY
                 test.ge.nc,    ;* OP.GE with NO.CASE
                 every.ge.nc,   ;* OP.GE with EVERY and NO.CASE
                 test.gt,       ;* OP.GT
                 every.gt,      ;* OP.GT with EVERY
                 test.gt.nc,    ;* OP.GT with NO.CASE
                 every.gt.nc,   ;* OP.GT with EVERY and NO.CASE
                 test.like,     ;* OP.LIKE
                 every.like,    ;* OP.LIKE with EVERY
                 test.like.nc,  ;* OP.LIKE with NO.CASE
                 every.like.nc, ;* OP.LIKE with EVERY and NO.CASE
                 test.unlike,   ;* OP.UNLIKE
                 every.unlike,  ;* OP.UNLIKE with EVERY
                 test.unlike.nc,;* OP.UNLIKE with NO.CASE
                 every.unlike.nc, ;* OP.UNLIKE with EVERY and NO.CASE
                 test.said,     ;* OP.SAID
                 every.said,    ;* OP.SAID with EVERY
                 test.said.nc,  ;* OP.SAID with NO.CASE
                 every.said.nc, ;* OP.SAID with EVERY and NO.CASE
                 test.not.null, ;* OP.NOT.NULL
                 every.not.null,;* OP.NOT.NULL with EVERY
                 test.not.null, ;* OP.NOT.NULL with NO.CASE
                 every.not.null,;* OP.NOT.NULL with EVERY and NO.CASE
                 test.between,  ;* OP.BETWEEN
                 every.between, ;* OP.BETWEEN with EVERY
                 test.between.nc,  ;* OP.BETWEEN with NO.CASE
                 every.between.nc,;* OP.BETWEEN with EVERY and NO.CASE
                 op.error,      ;* OP.OR
                 op.error       ;* OP.AND


test.eq.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.eq:
      if item1.mv then
         find item2 in item1 setting z then truth = @true
         else truth = (item1 = '' and item2 = '')
         * 0110 Above treats FIND '' IN '' as special case
      end else truth = (item1 = item2)
      goto next.clause

every.eq.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.eq:
      loop
         truth = remove(item1, value.delimiter) = item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.ne.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.ne:
      if item1.mv then   ;* 0111
         loop
            truth = remove(item1, value.delimiter) # item2
         until truth
         while value.delimiter
         repeat
      end else truth = (item1 # item2)
      goto next.clause

every.ne.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.ne:
      loop
         truth = remove(item1, value.delimiter) # item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.lt.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.lt:
      if item1.mv then
         loop
            truth = remove(item1, value.delimiter) < item2
         until truth
         while value.delimiter
         repeat
      end else truth = item1 < item2
      goto next.clause

every.lt.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.lt:
      loop
         truth = remove(item1, value.delimiter) < item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.le.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.le:
      if item1.mv then
         loop
            truth = remove(item1, value.delimiter) <= item2
         until truth
         while value.delimiter
         repeat
      end else truth = item1 <= item2
      goto next.clause

every.le.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.le:
      loop
         truth = remove(item1, value.delimiter) <= item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.ge.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.ge:
      if item1.mv then
         loop
            truth = remove(item1, value.delimiter) >= item2
         until truth
         while value.delimiter
         repeat
      end else truth = item1 >= item2
      goto next.clause

every.ge.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.ge:
      loop
         truth = remove(item1, value.delimiter) >= item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.gt.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.gt:
      if item1.mv then
         loop
            truth = remove(item1, value.delimiter) > item2
         until truth
         while value.delimiter
         repeat
      end else truth = item1 > item2
      goto next.clause

every.gt.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.gt:
      loop
         truth = remove(item1, value.delimiter) > item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.like.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.like:
      if item1.mv then
         s = if item1.conv # '' then oconvs(item1,item1.conv) else item1
         loop
            truth = remove(s, value.delimiter) matches item2
         until truth
         while value.delimiter
         repeat
      end else
         if item1.conv # '' then truth = oconv(item1,item1.conv) matches item2
         else truth = item1 matches item2
      end
      goto next.clause

every.like.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.like:
      s = if item1.conv # '' then oconvs(item1,item1.conv) else item1
      loop
         truth = remove(s, value.delimiter) matches item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.unlike.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
test.unlike:
      if item1.mv then
         s = if item1.conv # '' then oconvs(item1,item1.conv) else item1
         loop
            truth = not(remove(s, value.delimiter) matches item2)
         until truth
         while value.delimiter
         repeat
      end else
         if item1.conv # '' then truth = not(oconv(item1,item1.conv) matches item2)
         else truth = not(item1 matches item2)
      end
      goto next.clause

every.unlike.nc:
      item1 = upcase(item1)
      item2 = upcase(item2)
every.unlike:
      s = if item1.conv # '' then oconvs(item1,item1.conv) else item1
      loop
         truth = not(remove(s, value.delimiter) matches item2)
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.said.nc:
test.said:
      if item1.mv then
         loop
            truth = soundex(remove(item1, value.delimiter)) = item2
         until truth
         while value.delimiter
         repeat
      end else truth = soundex(item1) = item2
      goto next.clause

every.said.nc:
every.said:
      s = soundex(item2)
      loop
         truth = soundex(remove(item1, value.delimiter)) = s
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.not.null:
      if item1.mv then
         loop
            truth = remove(item1, value.delimiter) # ''
         until truth
         while value.delimiter
         repeat
      end else truth = (item1 # '')
      goto next.clause

every.not.null:
      loop
         truth = remove(item1, value.delimiter) # ''
      while truth
      while value.delimiter
      repeat
      goto next.clause

test.between.nc:
      gosub get.item3
      item1 = upcase(item1)
      item2 = upcase(item2)
      item3 = upcase(item3)
      goto test.between.continue
test.between:
      gosub get.item3
test.between.continue:
      if item1.mv then
         loop
            s = remove(item1, value.delimiter)
            truth = s >= item3 and s <= item2
         until truth
         while value.delimiter
         repeat
      end else truth = item1 >= item3 and item1 <= item2
      goto next.clause

every.between.nc:
      gosub get.item3
      item1 = upcase(item1)
      item2 = upcase(item2)
      item3 = upcase(item3)
      goto every.between.continue
every.between:
      gosub get.item3
every.between.continue:
      loop
         s = remove(item1, value.delimiter)
         truth = s >= item3 and s <= item2
      while truth
      while value.delimiter
      repeat
      goto next.clause

next.clause:

      if inverse then truth = not(truth)

      * Look at next selection element
      * If we are at the end, that's it
      * If it is AND, skip to end point if false
      * If it is OR, skip to end point if true

      sel.idx += 1

      loop
      until sel.idx > hi.sel
         op = selection(sel.idx, SEL.OP)
         begin case
            case op = OP.AND
               if truth then sel.idx += 1
               else sel.idx = selection(sel.idx,SEL.ARG1)
            case op = OP.OR
               if truth then sel.idx = selection(sel.idx,SEL.ARG1)
               else sel.idx += 1
            case 1
               exit
         end case
      repeat
   until sel.idx > hi.sel
   repeat         

   if truth then
want.record:
      record.wanted = @true

      if search.command then
         if new.record then gosub read.record
         if record.found then
            s = if no.case then upcase(qproc.record) else qproc.record
            begin case
               case all.match
                  for i = 1 to no.of.strings
                     record.wanted = index(s, strings(i), 1)
                  while record.wanted
                  next i

               case no.match
                  for i = 1 to no.of.strings
                     record.wanted = (index(s, strings(i), 1) = 0)
                  while record.wanted
                  next i

               case 1
                  for i = 1 to no.of.strings
                     record.wanted = index(s, strings(i), 1)
                  until record.wanted
                  next i
            end case
         end
      end
   end else
      record.wanted = @false
   end

   return

* ======================================================================
* Get item 3 for BETWEEN

get.item3:
   item.index = selection(sel.idx,SEL.ARG3)
   ! item3.conv = item.conv(item.index)
   gosub get.item
   item3 = item

   * If we are processing a file with case insensitive ids, item 1 is
   * the record id, and item 3 is a literal string, map the string to
   * upper case.

   if is.case.insensitive then
      if item1.type = ID.ITEM and item.type(item.index) = LITERAL.ITEM then
         item3 = upcase(item3)
      end
   end

   return

* ======================================================================

check.for.synonym:
   gosub get.token
   if keyword = KW$AS then
      gosub get.token   ;* synonym
      if token.type = PARSER$END then
         display sysmsg(7255, item.name(item.index)) ;* Synonym required for xx
         goto exit.qproc
      end

      locate token in synonyms<1> setting i then
         display sysmsg(7256, item.name(item.index)) ;* Duplicated synonym in xx
         goto exit.qproc
      end

      ins token before synonyms<i>
      ins item.index before synonym.refs<i>

      gosub get.token
   end
   return

* ======================================================================

check.ak.usability:
   * Determine if we can use an AK for this query

   ak.usable = @false

   * Step 1 - Does the first field in the query have an AK?

   * First, find the item index for this field

   sel.idx = 1
   inverse = @false
   loop
      op = selection(sel.idx,SEL.OP) 
      begin case
         case op = OP.NO  ; inverse = @true
case op = OP.WHEN ; null
         case 1           ; exit
      end case
      sel.idx += 1
   repeat

   ak.field = selection(sel.idx,SEL.ARG1)

   * Now look for this field as an AK.  This is not simply a check for
   * the same name as we have to allow for equivalent indices.

   index.names = indices(data.f)
   n = dcount(index.names, @fm)
   for i = 1 to n
      index.name = index.names<i>
      index.data = indices(data.f, index.name)
      if index.data<1,2> then continue  ;* Needs rebuild

      ak.type = index.data[1,1]
      ak.justification = if item.justification(ak.field) = 'R' then 'R' else 'L'

      begin case
         case ak.type = 'D' ;* D-type index
            if item.type(ak.field) # ID.ITEM and item.type(ak.field) # FIELD.ITEM then continue
            if item.detail(ak.field) # index.data<2> then continue  ;* Wrong field
            if item.multivalued(ak.field) # (index.data<6> = 'M') then continue  ;* Wrong S/M
            if ak.justification # index.data<5> then continue  ;* Wrong justification

         case ak.type = 'I' or ak.type = 'C'
            if item.type(ak.field) # ITYPE.ITEM then continue
            if item.expression(ak.field) # index.data<dict.itype.source> then continue  ;* Wrong expression
            if item.multivalued(ak.field) # (index.data<6> = 'M') then continue  ;* Wrong S/M
            if ak.justification # index.data<5> then continue  ;* Wrong justification

         case (ak.type = 'A' or ak.type = 'S') and index.data<DICT.A.CORRELATIVE> # ''
            if item.type(ak.field) # ITYPE.ITEM then continue
            if item.expression(ak.field) # index.data<dict.a.correlative> then continue  ;* Wrong expression
            if ak.justification # index.data<DICT.A.JUSTIFY> then continue  ;* Wrong justification

         case 1   ;* Non-correlative A/S type
            if item.type(ak.field) # ID.ITEM and item.type(ak.field) # FIELD.ITEM then continue
            if item.detail(ak.field) # index.data<2> then continue  ;* Wrong field
            if ak.justification # index.data<DICT.A.JUSTIFY> then continue  ;* Wrong justification
      end case


      * This index is suitable

      ak.usable = @true
      exit
   next i

   if not(ak.usable) then return

   * Step 2 - Is the second argument a literal value?

   ak.operator = selection(sel.idx,SEL.OP)
   if bitand(ak.operator, 0xFC) = OP.NOT.NULL then   ;* 0525
      ak.operator += OP.NE - OP.NOT.NULL
      ak.value = ''
   end else
      j = selection(sel.idx,SEL.ARG2) 
      if item.type(j) # LITERAL.ITEM then ak.usable = @false
      else ak.value = item.detail(j)
   end

   if not(ak.usable) then return

   * Step 3 - Does the operator preclude the use of an AK?

   if inverse then
      begin case
         case ak.operator = OP.EQ     ; ak.operator = OP.NE
         case ak.operator = OP.NE     ; ak.operator = OP.EQ
         case ak.operator = OP.LE     ; ak.operator = OP.GT
         case ak.operator = OP.LT     ; ak.operator = OP.GE
         case ak.operator = OP.GE     ; ak.operator = OP.LT
         case ak.operator = OP.GT     ; ak.operator = OP.LE
         case ak.operator = OP.LIKE   ; ak.operator = OP.UNLIKE
         case ak.operator = OP.UNLIKE ; ak.operator = OP.LIKE
      end case
   end

   begin case
      case ak.operator >= OP.FIRST.MV and ak.operator <= OP.LAST.MV and bitand(ak.operator,1) # bitand(OP.EQ,1)
         ak.usable = @false

      case ak.operator = OP.NE or ak.operator = OP.UNLIKE
         ak.usable = @false

      case ak.operator = OP.BETWEEN    ;* 0544
         j = selection(sel.idx,SEL.ARG3) 
         if item.type(j) # LITERAL.ITEM then ak.usable = @false
         else
            ak.hi.value = ak.value
            ak.value = item.detail(j)
         end

      case ak.operator = OP.LIKE
         * The LIKE operator can only use an AK if the field has no
         * conversion and is left justified.

         if item.conv(ak.field) # '' then ak.usable = @false
         if not(item.left.justified(ak.field)) then ak.usable = @false

         * We can only do a LIKE with an AK if the pattern has all its
         * variable components at the end.

         ak.prefix = ak.value

         * Strip off all trailing variable components (..., 4A, 3-7N, etc)

         loop
            begin case
                case ak.prefix[3] = '...'
                   ak.prefix = ak.prefix[1,len(ak.prefix)-3]
                case ak.prefix matches '...1N0N"A"...1N0N"N"...1N0N"X"'
                   ak.prefix = matchfield(ak.prefix, '...1N0N1A', 1)
                case ak.prefix matches '...1N0N"-"1N0N"A"...1N0N"-"1N0N"N"...1N0N"-"1N0N"X"'
                   ak.prefix = matchfield(ak.prefix, '...1N0N"-"1N0N1A', 1)
                case 1
                   exit
            end case
         repeat

         * Now scan what's left. If we find a variable component this cannot
         * use an index.

         i = 1
         loop
         while i <= len(ak.prefix)
            c = ak.prefix[i,1] 
            begin case
               case c = '"' or c = "'"
                  j = index(ak.prefix, c, 2)
                  if j = 0 then ak.usable = @false   ;* Unpaired quote
                  else  ;* Remove quotes from ak.prefix
                     ak.prefix = ak.prefix[1,i-1]:ak.prefix[i+1,j - i - 1]:ak.prefix[j+1, 9999]
                     i = j - 1
                  end

               case ak.prefix[1,3] = '...'
                  ak.usable = @false
               
               case ak.prefix matches '...1N0N"A"...1N0N"N"...1N0N"X"'
                  ak.usable = @false

               case ak.prefix matches '...1N0N"-"1N0N"A"...1N0N"-"1N0N"N"...1N0N"-"1N0N"X"'
                  ak.usable = @false

               case 1
                  i += 1
            end case
         while ak.usable
         repeat

         * What is left in ak.prefix will be used as the starting
         * point for the index search.

      case bitand(ak.operator - OP.FIRST.MV, 2)
         * Case insensitivity renders the index useless
         ak.usable = @false
   end case

   if not(ak.usable) then return

   * Step 4 - Do the subsequent operators include an OR relationship?
   * Look through the selection table, following the links from AND
   * operators.  If we encounter an OR, this query cannot be resolved
   * using the AK.

   i = sel.idx + 1
   loop
   while ak.usable and i <= hi.sel
      op = selection(i,SEL.OP)
      begin case
         case op = OP.AND  ; i = selection(i,SEL.ARG1)
         case op = OP.OR   ; ak.usable = @false
         case 1            ; i += 1
      end case
   repeat

   if not(ak.usable) then return

   * Step 5 - Does the use of NO.NULLS prevent us from using this index?

   ak.no.nulls = index.data<1,3>   ;* NO.NULLS used?

   begin case
      case ak.operator = OP.EQ
         if ak.no.nulls and ak.value = '' then ak.usable = @false

      case ak.operator = OP.LE
         if ak.no.nulls then ak.usable = @false

      case ak.operator = OP.LT
         if ak.no.nulls then ak.usable = @false

      case ak.operator = OP.GE
         if ak.no.nulls and ak.value = '' then ak.usable = @false

      case ak.operator = OP.LIKE
         if ak.no.nulls and '' matches ak.value then ak.usable = @false
   end case

   if not(ak.usable) then return

   non.ak.selection.index = sel.idx + 2

   * Step 6 - Can we further improve on this by combining a pair of tests
   * that form a closed range of values (A > B AND A < C)?

   if item.multivalued(ak.field) then return        ;* Cannot merge

   if non.ak.selection.index > hi.sel then return   ;* No more conditions

   if selection(non.ak.selection.index-1,SEL.ARG1) # non.ak.selection.index + 1 then return

   * It is a simple condition. Not, for example, A > B AND (A < C OR A = E)

   i = selection(non.ak.selection.index, SEL.OP)
   begin case
      case ak.operator = OP.LE or ak.operator = OP.LT
         if i # OP.GE and i # OP.GT then return
      case ak.operator = OP.GE or ak.operator = OP.GT
         if i # OP.LE and i # OP.LT then return
   end case

   * Operators are "opposites"

   i = selection(non.ak.selection.index,SEL.ARG2)
   if i = 0 then return  ;* 0496  Must be WITH X or WITH NO X
   if item.type(i) # LITERAL.ITEM then return

   * It is a test against a literal

   if ak.operator = OP.LE or ak.operator = OP.LT then
      if item.detail(i) > ak.value then return
   end else
      if item.detail(i) < ak.value then return
   end

   * It is a closed range

   k = selection(non.ak.selection.index,SEL.ARG1)
   index.type = index.data[1,1]
   begin case  ;* 0399 Reworked
      case index.type = 'D'
         if item.detail(k) # index.data<2> then return  ;* Wrong field
      case index.type = 'C' or index.type = 'I'
         if item.expression(k) # index.data<dict.itype.source> then return  ;* Wrong expression
      case (index.type = 'A' or index.type = 'S') and index.data<dict.a.correlative> = ''
         if item.detail(k) # index.data<2> then return  ;* Wrong field
      case index.type = 'A' or index.type = 'S'
         if item.expression(k) # index.data<dict.a.correlative> then return  ;* Wrong expression
   end case

   if item.multivalued(k) # (index.data<6> = 'M') then return  ;* Wrong S/M
   if item.justification(ak.field) # index.data<5> then return  ;* Wrong justification

   * It can be handled with the same index

   * Merge the two conditions. We do this by replacing the ak.operator by
   * a special operator only ever used in AK searches and moving the
   * non.ak.selection.index past the merged condition. We need ak.value to
   * hold the low end of the range and ak.hi.value to hold the high end.

   i = selection(non.ak.selection.index, SEL.OP)
   j = selection(non.ak.selection.index, SEL.ARG2)
   begin case
      case ak.operator = OP.LE
         ak.operator = if i = OP.GT then OP.GTLE else OP.GELE
         ak.hi.value = ak.value
         ak.value = item.detail(j)
      case ak.operator = OP.LT
         ak.operator = if i = OP.GT then OP.GTLT else OP.GELT
         ak.hi.value = ak.value
         ak.value = item.detail(j)
      case ak.operator = OP.GE
         ak.operator = if i = OP.LE then OP.GELE else OP.GELT
         ak.hi.value = item.detail(j)
      case ak.operator = OP.GT
         ak.operator = if i = OP.LE then OP.GTLE else OP.GTLT
         ak.hi.value = item.detail(j)
   end case

   non.ak.selection.index += 2

   return

* ======================================================================
* ADD.QUALIFIED.DISPLAY.ITEM  -  Add a qualified field to the display list
*
* On entry:
*   item.report.mode = 0                  Nothing special
*                      REPORT.AVERAGE     AVG fld [NO.NULLS]
*                      REPORT.CALC        CALC fld
*                      REPORT.NUMBER      ENUM fld
*                      REPORT.MAX         MAX fld
*                      REPORT.MIN         MIN fld [NO.NULLS]
*                      REPORT.PERCENT     PCT [n] fld
*                      REPORT.TOTAL       TOTAL fld
*                      REPORT.BREAK.SUP   break.sup fld
*                      REPORT.CUMULATIVE  CUMULATIVE keyword

add.qualified.display.item:
   qd.token = token
   gosub get.token

   begin case
      case item.report.mode = REPORT.PERCENT   ;* Check for precision value
         if num(token) then
            pct.dp = token + 0
            gosub get.token
         end else
            pct.dp = 2
         end
   end case

   if token.type = PARSER$END or type = '' then 
      display sysmsg(7266, qd.token) ;* Expected field name after xx
      goto exit.qproc
   end

   gosub add.display.item
   gosub check.field.modifiers

   return

*=============================================================================
* ADD.FIELD  -  Add field definition to field table
*
* On return
*     ITEM.INDEX addresses item array entries

add.field.by.name:
   token.type = PARSER$TOKEN
   keyword = -1
   if dict.open then
      read dict.rec from dict.file, token then
         type = dict.rec[1,1]
      end
   end else
      dict.rec = ''
   end

add.field:
   item.ok = @false

   * Is this a synonym?

   if token # '' then    ;* 0092
      locate token in synonyms<1> setting i then
         item.ok = @true
         item.index = synonym.refs<i>
         return
      end
   end

   if token.type = PARSER$STRING then
      if literal.allowed then
         if no.items = max.items then gosub extend.item.tables
         no.items += 1
         item.index = no.items
         item.name(item.index) = ""
         item.display.name(item.index) = ""
         item.type(item.index) = LITERAL.ITEM
         item.detail(item.index) = token
         item.fmt(item.index) = len(token) : "L"
         gosub get.width.and.justification
         item.conv(item.index) = ""
         item.assoc(item.index) = 0
         item.multivalued(item.index) = @false
         item.totals(item.index) = 0
         item.breakpoint(item.index) = 0
         item.flags(item.index) = 0
         item.ok = @true
      end
      return
   end

   * Make a new item

   if no.items = max.items then gosub extend.item.tables

   * Is it an EVAL expression?

   if keyword = KW$EVAL then
      gosub get.token
      if token.type # PARSER$STRING then
         display sysmsg(7267) ;* EVAL expression not found where expected
         goto exit.qproc
      end

      no.items += 1
      item.index = no.items
      item.name(item.index) = token
      item.type(item.index) = ITYPE.ITEM
      item.expression(item.index) = token
      item.display.name(item.index) = token
      item.fmt(item.index) = "10L"
      gosub get.width.and.justification
      item.conv(item.index) = ""
      item.assoc(item.index) = 0
      sm.flag = @false

      call $icomp(dict.file, token, item.detail(item.index),
                  item.fmt(item.index), item.conv(item.index),
                  sm.flag,
                  s,                    ;* Returned association name
                  constant, 1)
      if @system.return.code then
         @system.return.code = -ER$ICOMP
         display sysmsg(7268, token) ;* Compilation error in EVAL expression xx
         goto exit.qproc
      end

      if s # '' then gosub add.item.association
         
      item.multivalued(item.index) = (sm.flag[1,1] = "M")
      gosub get.width.and.justification

      item.totals(item.index) = seq(item.detail(item.index)[HDR.TOTALS,1])
      item.breakpoint(item.index) = 0
      item.flags(item.index) = 0

      if constant then
         * The evaluated item is a constant. Execute the I-type and change
         * the item to be a literal to save repeated execution later.

         item.detail(item.index) = itype(item.detail(item.index))
         item.type(item.index) = LITERAL.ITEM
      end else
         if option(OPT.ASSOC.UNASSOC.MV) then
            if item.multivalued(item.index) and item.assoc(item.index) = 0 then
               s = '__QPROC.ASSOC__' ; gosub add.item.association
            end
         end
      end

      item.ok = @true

      return
   end


   if dict.rec # '' then
      begin case
         case (type = "A" or type = "S") and dict.rec<DICT.A.CORRELATIVE> = ''
            if not(dict.rec<dict.a.loc> matches '1N0N') then
               display sysmsg(7269, token) ;* Dictionary entry for xx has non-numeric field location
               goto exit.qproc
            end

            no.items += 1
            item.index = no.items
            item.name(item.index) = token

            s = dict.rec<dict.a.display.name> ; gosub set.col.hdg
            item.detail(item.index) = dict.rec<dict.a.loc> + 0
            item.fmt(item.index) = dict.rec<dict.a.width>:dict.rec<dict.a.justify>
            item.display.width(item.index) = dict.rec<dict.a.width>
            item.justification(item.index) = dict.rec<dict.a.justify>
            item.left.justified(item.index) = (dict.rec<dict.a.justify> # 'R')
            item.conv(item.index) = dict.rec<dict.a.conv>

            * Invent a pseudo association name for associated fields
            s = dict.rec<dict.a.assoc>
            begin case
               case s matches '"D;"1N0X'
                  s = '__' : matchfield(s, '"D;"0N0X', 2)
               case s matches '"C;"1N0X'
                  s = '__' : dict.rec<dict.a.loc>
            end case
            gosub add.item.association

            item.multivalued(item.index) = @true
            item.totals(item.index) = 0
            item.breakpoint(item.index) = 0
            item.flags(item.index) = 0
            if option(OPT.ASSOC.UNASSOC.MV) then
               if item.multivalued(item.index) and not(item.assoc(item.index)) then
 explosion.associated.in.dictionary = @false
                  s = '__QPROC.ASSOC__' ; gosub add.item.association
               end
            end

            i = item.detail(item.index)
            begin case
               case i = 0
                  item.type(item.index) = ID.ITEM   ;* Field location 0 is @id
               case i = 9998
                  item.type(item.index) = NI.ITEM
               case i = 9999
                  item.type(item.index) = BYTES.ITEM
               case 1
                  item.type(item.index) = FIELD.ITEM
            end case

         case type = "D"
            if not(num(dict.rec<dict.loc>)) then
               display sysmsg(7269, token) ;* Dictionary entry for xx has non-numeric field location
               goto exit.qproc
            end

            no.items += 1
            item.index = no.items
            item.name(item.index) = token

            s = dict.rec<dict.display.name> ; gosub set.col.hdg
            item.detail(item.index) = dict.rec<DICT.LOC> + 0
            item.fmt(item.index) = dict.rec<dict.format>
            gosub get.width.and.justification
            item.conv(item.index) = dict.rec<dict.conv>
            s = dict.rec<dict.assoc> ; gosub add.item.association
            item.multivalued(item.index) = dict.rec<dict.s.m>[1,1] = "M"
            item.totals(item.index) = 0
            item.breakpoint(item.index) = 0
            item.flags(item.index) = 0
            if option(OPT.ASSOC.UNASSOC.MV) then
               if item.multivalued(item.index) and not(item.assoc(item.index)) then
                  s = '__QPROC.ASSOC__' ; gosub add.item.association
               end
            end

            i = item.detail(item.index)
            begin case
               case i = 0
                  item.type(item.index) = ID.ITEM   ;* Field location 0 is @id
               case i = 9998
                  item.type(item.index) = NI.ITEM
               case i = 9999
                  item.type(item.index) = BYTES.ITEM
               case 1
                  item.type(item.index) = FIELD.ITEM
            end case

         case type = 'I' or type = 'C' or type = 'A' or type = 'S'
            no.items += 1
            item.index = no.items
            item.name(item.index) = token

            item.type(item.index) = ITYPE.ITEM
            if type = 'I' or type = 'C' then
               item.expression(item.index) = trim(dict.rec<dict.itype.source>,' ', 'B')
               s = dict.rec<dict.display.name> ; gosub set.col.hdg
               item.fmt(item.index) = dict.rec<dict.format>
               gosub get.width.and.justification
               item.conv(item.index) = dict.rec<dict.conv>
               s = dict.rec<dict.assoc> ; gosub add.item.association
               item.multivalued(item.index) = dict.rec<dict.s.m>[1,1] = "M"
            end else    ;* A/S type
               item.expression(item.index) = dict.rec<dict.a.correlative>
               s = dict.rec<dict.a.display.name> ; gosub set.col.hdg
               item.fmt(item.index) = dict.rec<dict.a.width>:dict.rec<dict.a.justify>
               item.display.width(item.index) = dict.rec<dict.a.width>
               item.justification(item.index) = dict.rec<dict.a.justify>
               item.left.justified(item.index) = (dict.rec<dict.a.justify> # 'R')
               item.conv(item.index) = dict.rec<dict.a.conv>

               * Invent a pseudo association name for associated fields
               s = dict.rec<dict.a.assoc>
               begin case
                  case s matches '"D;"1N0X'
                     s = '__' : matchfield(s, '"D;"0N0X', 2)
                  case s matches '"C;"1N0X'
                     s = '__' : dict.rec<dict.a.loc>
               end case
               gosub add.item.association

               item.multivalued(item.index) = @true
            end

            if option(OPT.ASSOC.UNASSOC.MV) then
               if item.multivalued(item.index) and not(item.assoc(item.index)) then
                  s = '__QPROC.ASSOC__' ; gosub add.item.association
               end
            end

            * Check if item needs compiling

            if len(dict.rec<dict.itype.object>) = 0 ~
            or checksum(replace(dict.rec, DICT.SYS.INFO, 1;'')) # dict.rec<DICT.SYS.INFO,1> then
               comp.f = if from.voc then @voc else dict.file   ;* 0316
               call $dcomp(comp.f,       ;* Dictionary file
                           token,        ;* Dictionary item id
                           dict.rec,     ;* Dictionary record
                           z,            ;* Format
                           z,            ;* Conversion
                           z,            ;* S/M flag
                           z,            ;* Association
                           z,            ;* Constant
                           1)            ;* Recursion depth
               
               if dict.rec<DICT.ITYPE.OBJECT> = '' then
                  @system.return.code = -ER$ICOMP
                  display sysmsg(7270, token) ;* Compilation error in compiled dictionary item %1
                  goto exit.qproc
               end

               if not(fileinfo(comp.f, FL$READONLY)) then
                  recordlocku comp.f, token
                  write dict.rec to comp.f, token
               end
            end

            item.detail(item.index) = field(dict.rec, @fm, DICT.ITYPE.OBJECT, 9999999)
            item.totals(item.index) = seq(item.detail(item.index)[HDR.TOTALS,1])
            item.breakpoint(item.index) = 0
            item.flags(item.index) = 0

         case type = 'L'
            link.name = field(token, '%', 1)
            link.item = field(token, '%', 2, 999)

            open 'DICT', dict.rec<3> to link.dict.f else
               display sysmsg(7271, dict.rec<3>, link.name) ;* Cannot open xx dictionary for link xx
               goto exit.qproc
            end

            read link.dict.rec from link.dict.f, link.item else
               read link.dict.rec from link.dict.f, upcase(link.item) else
                  display sysmsg(7272, link.name) ;* Link item xx not found
                  goto exit.qproc
               end
            end

            link.type = upcase(link.dict.rec[1,1])
            begin case
               case link.type = 'D' or link.type = 'I' or link.type = 'C'
                  no.items += 1
                  item.index = no.items
                  item.name(item.index) = token
                  item.type(item.index) = ITYPE.ITEM
                  item.expression(item.index) = 'TRANS(':dict.rec<3>:',':dict.rec<2>:',':link.item:',"X")'
                  s = link.dict.rec<DICT.DISPLAY.NAME> ; gosub set.col.hdg
                  item.fmt(item.index) = link.dict.rec<DICT.FORMAT>
!                  gosub get.width.and.justification
                  item.conv(item.index) = link.dict.rec<DICT.CONV>
                  s = link.dict.rec<DICT.ASSOC> ; gosub add.item.association
                  sm.flag = 'M'

                  call $icomp(dict.file,
                              item.expression(item.index),
                              item.detail(item.index),
                              z, z, z, z, constant, 1)
                  if @system.return.code then
                     @system.return.code = -ER$ICOMP
                     display sysmsg(7273, token) ;* Compilation error in link expression xx
                     goto exit.qproc
                  end

                  item.multivalued(item.index) = (sm.flag[1,1] = "M")
                  gosub get.width.and.justification

                  item.totals(item.index) = seq(item.detail(item.index)[HDR.TOTALS,1])
                  item.breakpoint(item.index) = 0
                  item.flags(item.index) = 0

                  if option(OPT.ASSOC.UNASSOC.MV) then
                     if item.multivalued(item.index) and not(item.assoc(item.index)) then
                        s = '__QPROC.ASSOC__' ; gosub add.item.association
                     end
                  end

                  item.ok = @true

                  return

               case 1
                  display sysmsg(7274, link.name) ;* Link item xx is not of a suitable type
                  goto exit.qproc
            end case

         case 1
            display sysmsg(7275, type, token) ;* Unexpected %1 type item (%2) in query sentence.
            goto exit.qproc
      end case

      item.ok = @true
      return
   end

   * Is it @ID (with no dictionary)?

   if upcase(token) = '@ID' then
      no.items += 1
      item.index = no.items
      item.name(item.index) = '@ID'
      item.display.name(item.index) = '@ID'
      item.detail(item.index) = 0
      item.fmt(item.index) = '12L'
      gosub get.width.and.justification
      item.conv(item.index) = ''
      item.assoc(item.index) = 0
      item.multivalued(item.index) = @false
      item.totals(item.index) = 0
      item.breakpoint(item.index) = 0
      item.flags(item.index) = 0
      item.type(item.index) = ID.ITEM
* 0082  Inserted the next two lines.
      item.ok = @true
      return
   end

   * Treat as a literal

   if literal.allowed then
      no.items += 1
      item.index = no.items
      item.name(item.index) = token

      item.display.name(item.index) = ""
      item.type(item.index) = LITERAL.ITEM
      item.detail(item.index) = token
      item.fmt(item.index) = len(token) : "L"
      gosub get.width.and.justification
      item.conv(item.index) = ""
      item.assoc(item.index) = 0
      item.multivalued(item.index) = @false
      item.totals(item.index) = 0
      item.breakpoint(item.index) = 0
      item.flags(item.index) = 0
      item.ok = @true
   end

   return

*=============================================================================
* GET.WIDTH.AND.JUSTIFICATION
*
* Set ITEM.WIDTH and ITEM.JUSTIFICATION for item ITEM.INDEX

get.width.and.justification:
   * We find the field width by formatting a default string ("1") using
   * the item's format specification.  This is the easiest way to handle
   * decimals, masks, etc.

   item.display.width(item.index) = len(fmt("1", item.fmt(item.index)))

   s = matchfield(item.fmt(item.index), "0N0X", 2)
   n = s[1,1]
   item.justification(item.index) = n
   begin case
      case n = "L" or n = "R" ; null
      case n = "T"            ; n = "L"
      case n = "U"            ; n = "L"
      case n = "'"            ; n = s[4,1]
      case 1                  ; n = s[2,1]
   end case
   item.left.justified(item.index) = (n # 'R')

   return

* =============================================================================
* EXTEND.SELECTION.TABLE

extend.selection.table:
   dim selection(max.selection + 20, SEL.COLS)
   for i = 1 to 20
       for j = 1 to SEL.COLS
          selection(max.selection + i, j) = 0
       next j
   next i
   max.selection += 20
   return

*=============================================================================
* EXTEND.ITEM.TABLES  -  Add further elements to item table arrays

extend.item.tables:
   max.items += 20
   dim item.name(MAX.ITEMS)
   dim item.type(MAX.ITEMS)
   dim item.detail(max.items)
   dim item.expression(max.items)
   dim item.fmt(max.items)
   dim item.display.width(max.items)
   dim item.justification(max.items)
   dim item.left.justified(max.items)
   dim item.conv(max.items)
   dim item.display.name(max.items)
   dim item.assoc(max.items)
   dim item.multivalued(max.items)
   dim item.totals(max.items)
   dim item.breakpoint(max.items)
   dim item.flags(max.items)
   return

* ======================================================================

extend.list.item.tables:
   max.list.items += 10
   dim list.item(max.list.items, NO.OF.LIST.ITEM.ELEMENTS)
   return

* ======================================================================
* GET.ITEM  -  Fetch record / value for item ITEM.INDEX to ITEM (no conversion)
*

get.item:
   on item.type(item.index) goto get.id,
                                 get.field,
                                 get.itype,
                                 get.literal,
                                 get.ni,
                                 get.bytes

get.id:
* 0079 Removed   if new.record then gosub read.record
   if new.record then gosub check.record
**   item = qproc.record<item.detail(item.index)>
   item = id
   return

get.field:
   if new.record then gosub read.record
   item = qproc.record<item.detail(item.index)>
   return

get.itype:
   if new.record then gosub read.record
   item = itype(item.detail(item.index))
   return

get.literal:
   item = item.detail(item.index)
   return

get.ni:
   item = qproc.ni
   return

get.bytes:
   if new.record then gosub read.record
   item = len(qproc.record)
   return

* =============================================================================
* SHOW.RECORD  -  Show a record for the LIST command

show.record:
   qproc.ni += 1
   qproc.nv = 1

   * Construct a pseudo-record (DATA.REC) containing all items to list and
   * all items used in breakpoint definitions.

   data.rec = ''

   for list.index = 1 to no.of.list.items
      item.to.list = list.item(list.index, ITEM.NO)
      on item.type(item.to.list) goto list.id,
                                      list.field,
                                      list.itype,
                                      list.literal,
                                      list.ni,
                                      list.bytes

list.id:
* 0079 Removed   if new.record then gosub read.record
      if new.record then gosub check.record
      if not(record.found) then goto record.to.list.not.found
      data.rec<list.index> = id
      record.found = @true
      continue

list.field:
      if new.record then gosub read.record
      if not(record.found) then goto record.to.list.not.found
      s = qproc.record<item.detail(item.to.list)>
      if explode then
         if (item.assoc(item.to.list) = exploded.assoc and exploded.assoc) ~
         or (not(exploded.assoc) ~
             and (item.assoc(item.to.list) or option(OPT.PICK.EXPLODE))) then
            if option(OPT.PICK.EXPLODE) then
               if ismv(s) or explosion.associated.in.dictionary then
                  s = s<1, exp.v, exp.sv>
               end
            end else
               s = s<1, exp.v, exp.sv>
            end
         end
      end
      data.rec<list.index> = s
      continue

list.itype:
      if new.record then gosub read.record
      if not(record.found) then goto record.to.list.not.found
      s = itype(item.detail(item.to.list), item.tbase(item.to.list))
      if explode then
         if (item.assoc(item.to.list) = exploded.assoc and exploded.assoc) ~
         or (not(exploded.assoc) ~
             and (item.assoc(item.to.list) or option(OPT.PICK.EXPLODE))) then
            if option(OPT.PICK.EXPLODE) then
               if ismv(s) or explosion.associated.in.dictionary then
                  s = s<1, exp.v, exp.sv>
               end
            end else
               s = s<1, exp.v, exp.sv>
            end
         end
      end
      data.rec<list.index> = s
      continue

list.literal:
      data.rec<list.index> = item.detail(item.to.list)
      record.found = @true
      continue

list.ni:
      data.rec<list.index> = qproc.ni
      record.found = @true
      continue

list.bytes:
      if new.record then gosub read.record
      if not(record.found) then goto record.to.list.not.found
      data.rec<list.index> = len(qproc.record)
      record.found = @true
   next list.index


   * ------------------------------------------------------------
   * Apply WHEN clause filtering

   if when.used then
      gosub apply.when.filter

      * Now apply the filter(s) to the data

      for i = 1 to num.associations
         if when.op(i) then       ;* This association has been filtered
            truth = when.mask(i)

            if sum(truth) = 0 then
               qproc.ni -= 1
               return
            end

            for list.index = 1 to no.of.list.items
               item.to.list = list.item(list.index, ITEM.NO)
               if item.assoc(item.to.list) = i then
                  for j = count(truth, '0') to 1 step -1
                     find '0' in truth, j setting f,v,sv then
                        if index(truth<f,v>, @sm, 1) then
                           del data.rec<list.index,v, sv>
                        end else
                           del data.rec<list.index,v>
                        end
                     end
                  next j
               end
            next list.index             
         end
      next i
   end

   * ------------------------------------------------------------
   * Do special actions for first record

   if qproc.ni = 1 then       ;* First record
      for i = 0 to 9
         if breakpoint.b.list.index(i) then        ;* Get data for heading insert
            qproc.breakpoint.value(i) = data.rec<breakpoint.b.list.index(i)>
         end
      next i
   end else

      * ------------------------------------------------------------
      * Check for breakpoints

      if no.of.breakpoints then
         breakpoint.b.index = -1
         breakpoint.p.action= @false

         for breakpoint.scan.index = 1 to no.of.breakpoints
            list.index = breakpoint.list.index(breakpoint.scan.index)
            if compare(data.rec<list.index>, bp.rec<list.index>) then
               * Data in this field has changed
               * Trip all breakpoints from lowest level to this one,
               * regardless of whether the data has changed.

               if num.totals then mat saved.totals = mat qproc.totals

               for breakpoint.index = no.of.breakpoints to breakpoint.scan.index step -1
                  list.index = breakpoint.list.index(breakpoint.index)
                  bp.ctrl = breakpoint.control(breakpoint.index)
                  if (index(bp.ctrl, 'D', 1) = 0 or detail.lines > breakpoint.detail.count(breakpoint.index) + 1) and index(bp.ctrl, 'L', 1) = 0 then
                     last.breakpoint = (breakpoint.index = breakpoint.scan.index)
                     gosub show.breakpoint
                  end else
                     gosub reset.breakpoint.counters
                     if not(det.sup) then
                        if qdisp(QD$EMIT, '', 'S') then goto qdisp.error
                     end
                  end

                  * Check if we need to action a B or P control code

                  bp.ctrl = breakpoint.control(breakpoint.index)
                  i = index(bp.ctrl, 'B', 1)
                  if i then
                     breakpoint.b.index = bp.ctrl[i+1,1]
                     if not(breakpoint.b.index matches '1N') then breakpoint.b.index = 0
                     qproc.breakpoint.value(breakpoint.b.index) = data.rec<breakpoint.b.list.index(breakpoint.b.index)>
                  end

               if index(bp.ctrl, 'P', 1) then breakpoint.p.action = @true

                  list.index = breakpoint.list.index(breakpoint.index)
                  list.item(list.index, ITEM.INCLUDED) = @true
               next breakpoint.index

               * Do special page actions

               begin case
                  case breakpoint.b.index >= 0 ;* Get data for heading insert
                     if qdisp(QD$PAGE) then goto qdisp.error

                  case breakpoint.p.action
                     if qdisp(QD$PAGE) then goto qdisp.error
               end case

               qproc.nd = 0            ;* Reset detail line count (@ND)

               if num.totals then mat qproc.totals = mat saved.totals

               exit                    ;* Look no further
            end else
               * No change of this breakpoint field

               list.index = breakpoint.list.index(breakpoint.scan.index)
               bp.ctrl = breakpoint.control(breakpoint.scan.index)
               if index(bp.ctrl, 'O', 1) then
                  list.item(list.index, ITEM.INCLUDED) = @false
               end
            end
         next breakpoint.scan.index
      end
   end

   bp.rec = data.rec   ;* Save this record for next time around

   * ------------------------------------------------------------
   * Do accumulations

   if accumulating then
* 0231 Restructured what follows to always accumulate counts.

      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         s = data.rec<list.index>
         i = list.item(list.index, ITEM.MODE)
         item.report.mode = bitand(i, report.mode.mask)
         no.nulls = bitand(i, REPORT.NO.NULLS)
         cumulative.data = ''
         loop
            if item.multivalued(item.to.list) then
               z = remove(s, accumulate.delim)
            end else
               z = s
               accumulate.delim = 0
            end

            if item.report.mode = 0 then goto accumulate.continue

            if no.nulls and len(z) = 0 then goto accumulate.null.item ;* 0463

            on item.report.mode goto accumulate.total,
                                     accumulate.max,
                                     accumulate.min,
                                     accumulate.average,
                                     accumulate.number,
                                     accumulate.percent,
                                     accumulate.calc,
                                     accumulate.continue,   ;* BREAK.SUP
                                     accumulate.cumulative

accumulate.total:
accumulate.average:
            if num(z) then
               list.item(list.index, ITEM.ACCUM.VALUE) += z
               for bp = 1 to no.of.breakpoints
                  list.item(list.index, ITEM.LOCAL.VALUE)<bp> += z
               next bp
            end
            goto accumulate.continue

accumulate.max:
            if z > list.item(list.index, ITEM.ACCUM.VALUE) then
               list.item(list.index, ITEM.ACCUM.VALUE) = z
            end

            for bp = 1 to no.of.breakpoints
               if z > list.item(list.index, ITEM.LOCAL.VALUE)<bp> then
                  list.item(list.index, ITEM.LOCAL.VALUE)<bp> = z
               end
            next bp
            goto accumulate.continue

accumulate.min:
            if list.item(list.index, ITEM.COUNT) then
               if z < list.item(list.index, ITEM.ACCUM.VALUE) then
                  list.item(list.index, ITEM.ACCUM.VALUE) = z
               end
            end else
               list.item(list.index, ITEM.ACCUM.VALUE) = z
            end

            for bp = 1 to no.of.breakpoints
               if list.item(list.index, ITEM.LOCAL.COUNT)<bp> then
                  if z < list.item(list.index, ITEM.LOCAL.VALUE)<bp> then
                     list.item(list.index, ITEM.LOCAL.VALUE)<bp> = z
                  end
               end else
                  list.item(list.index, ITEM.LOCAL.VALUE)<bp> = z
               end
            next bp
            goto accumulate.continue

accumulate.percent:
            * Modify the saved item value to be a percentage of the total
            list.item(list.index, ITEM.ACCUM.VALUE) += z
            for bp = 1 to no.of.breakpoints
               list.item(list.index, ITEM.LOCAL.VALUE)<bp> += z
            next bp

            n = list.item(list.index, ITEM.TOTAL)
            if n then s = z * 100 / list.item(list.index, ITEM.TOTAL)
            else s = 0
            data.rec<list.index> = s
            goto accumulate.continue

accumulate.calc:
            item.to.list = list.item(list.index, ITEM.NO)
            n = item.totals(item.to.list)
            if n then    ;* Item includes TOTAL() function
               j = item.tbase(item.to.list)
               for i = 1 to n   ;* For each TOTAL() function
                  z = qproc.totals(j)   ;* Pick up total accumulated in I-type

                  * Accumulate master total for whole report
                  list.item(list.index, ITEM.ACCUM.VALUE)<i> += z

                  * Accumulate at each breakpoint
                  for bp = 1 to no.of.breakpoints
                     list.item(list.index, ITEM.LOCAL.VALUE)<bp,i> += z
                  next bp

                  j += 1   ;* Step to next total
               next i
            end
            goto accumulate.continue

accumulate.cumulative:
            if num(z) then
               list.item(list.index, ITEM.ACCUM.VALUE) += z
               for bp = 1 to no.of.breakpoints
                  list.item(list.index, ITEM.LOCAL.VALUE)<bp> += z
               next bp
            end
            if no.of.breakpoints then z = list.item(list.index, ITEM.LOCAL.VALUE)<no.of.breakpoints>
            else z = list.item(list.index, ITEM.ACCUM.VALUE)
            if accumulate.delim then cumulative.data := z : char(256 - accumulate.delim)
            else cumulative.data := z
            goto accumulate.continue

accumulate.number:
accumulate.continue:
         list.item(list.index, ITEM.COUNT) += 1
         for bp = 1 to no.of.breakpoints
            list.item(list.index, ITEM.LOCAL.COUNT)<bp> += 1
         next bp

accumulate.null.item:
         while accumulate.delim
         repeat

         if item.report.mode = REPORT.CUMULATIVE then
            data.rec<list.index> = cumulative.data
         end
      next list.index
   end

   * ------------------------------------------------------------
   * Perform conversion and formatting, constructing DISP.REC as
   * the display data.
   
   disp.rec = ''

   for list.index = 1 to no.of.list.items
      item.report.mode = list.item(list.index, ITEM.MODE)
      if item.report.mode = REPORT.BREAK.SUP then continue

      item.to.list = list.item(list.index, ITEM.NO)
      s = data.rec<list.index>

      if list.item(list.index, ITEM.INCLUDED) then
         if not(det.sup) then
            conversion = item.conv(item.to.list)
            if item.multivalued(item.to.list) then
               if len(conversion) then s = oconvs(s, conversion)
               if delimited.report or reformat.command then
                  disp.rec<list.index> = s
               end else
                  disp.rec<list.index> = fmts(s, item.fmt(item.to.list))
               end
            end else
               if len(conversion) then s = oconv(s, conversion)
               if delimited.report or reformat.command then
                  disp.rec<list.index> = s
               end else
                  disp.rec<list.index> = fmt(s, item.fmt(item.to.list))
               end
            end
         end
      end
   next list.index

   if det.sup then return

   * ------------------------------------------------------------
   * Display the record

   class = 'D'

report.record: ;* Enter here from SHOW.ACCUMULATIONS
   if reformat.command then
      id = disp.rec<1,1,1>    ;* Ensure no mark characters
      if id # '' then
         readvu s from reformat.f, id, 0 then
            overwrite.count += 1
         end
         write field(disp.rec,@fm,2,999999) to reformat.f, id
      end
      return
   end

   if new.page then
      if qdisp(QD$PAGE) then goto qdisp.error
   end

   * Build a map of the maximum number of subvalues in each value
   map = ''

   max.v = 0
   for list.index = 1 to no.of.list.items
      if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
      s = disp.rec<list.index>
      v = dcount(s, @vm)

      max.v = max(max.v, v)

      for i = 1 to v
         n = dcount(s<1,i>, @sm)     ;* 0146
         if n > map<i> then map<i> = n
      next i
   next list.index
   nd = summation(map)   ;* Total number of detail "lines" (ignoring wrapping)

   * If we are using REPEATING, duplicate signle valued items

   if repeating then
      if max.v > 1 then
         for list.index = 1 to no.of.list.items
            if list.item(list.index, ITEM.MODE) # REPORT.BREAK.SUP then
               item.to.list = list.item(list.index, ITEM.NO)
               if not(item.multivalued(item.to.list)) then
                  disp.rec<list.index> := str(@vm:disp.rec<list.index>, max.v - 1)
               end
            end
         next list.index
      end
   end

   begin case
      case delimited.report                  ;* ===== Delimited report
         gosub show.delimited
      case vertical                          ;* ===== Vertical listing
         gosub show.vertical
      case 1                                 ;* ===== Tabular report
         gosub show.tabular
   end case

   detail.lines += nd
   return


record.to.list.not.found:
   * Back out of this item
   qproc.ni -= 1
   qproc.nd -= 1
   return

* ======================================================================
* show.delimited  -  Emit record for delimited report

show.delimited:
   printline = ''
   for list.index = 1 to no.of.list.items
      if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
      if list.index > 1 then printline := delimiter
      s = disp.rec<list.index>
      if csv then  ;* Apply CSV rules
         begin case
            case csv = 1 ;* Standard rules (ftp://ftp.isi.edu/in-notes/rfc4180.txt)
               if index(s, '"', 1) or index(s, delimiter, 1) then
                  s = '"' : change(s, '"', '""') : '"'
               end
            case csv = 2 ;* Quote everything except numerics with no embedded commas
               if convert('0123456789.-', '', s) # '' then
                  s = '"' : change(s, '"', '""') : '"'
               end
         end case
      end
      printline := s
   next list.index

   if csv.pathname # '' then
      writeseq printline to csv.f else
         display sysmsg(1421, status()) ;* Error %d writing line to sequential file
         goto exit.qproc
      end
   end else
      * Do not use the display handler for delimited reports
      print on lptr printline
   end

   return

* ======================================================================
* show.vertical  -  Emit record for vertical format report

show.vertical:
   if no.split then
      if not(pan.scroll) then lno = printer.setting(lptr, LPTR$LINE.NO, -2)
      if lno > 1 then
         * Count the lines required for this record

         lines.required = 0
         for list.index = 1 to no.of.list.items
            if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
            item.to.list = list.item(list.index, ITEM.NO)
            vlist.item = disp.rec<list.index>
            loop
               more = @false

               remove s from vlist.item setting vlist.delimiter
               if item.multivalued(item.to.list) then
                  qproc.nd += vlist.delimiter < 5 and vlist.delimiter
               end else   ;* Merge multivalues to single valued string
                  loop
                  while vlist.delimiter and vlist.delimiter # 5
                     remove s2 from vlist.item setting vlist.delimiter
                  repeat
               end

               lines.required += 1

               if vlist.delimiter then more = @true
            while more
            repeat
         next list.index

         * If there is insufficient space for this record on the current
         * page, start a new page.

         if qdisp(QD$NEED, lines.required) then goto qdisp.error
      end
   end

   for list.index = 1 to no.of.list.items
      if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
      item.to.list = list.item(list.index, ITEM.NO)
      vlist.name = convert(@vm, ' ', fmt(item.display.name(item.to.list)[1,12], vlist.name.fmt))
      vlist.item = disp.rec<list.index>
      separator = " : "

      loop
         more = @false

         printline = ''

         if not(col.sup) then
            * Display item name chunk

            if margin then printline := space(margin)
            printline := vlist.name
            vlist.name = space(12)

            * Display separator

            printline := separator
            separator = "   "
         end

         * Display item value chunk

         remove s from vlist.item setting vlist.delimiter
         if not(item.multivalued(item.to.list)) then
            loop
            while vlist.delimiter and vlist.delimiter # 5
               s := char(256 - vlist.delimiter)
               remove s2 from vlist.item setting vlist.delimiter
               s := s2
            repeat
         end

         printline := s
         if qdisp(QD$EMIT, printline, class) then goto qdisp.error

         if vlist.delimiter then more = @true
      while more
      repeat
   next list.index

   if label.command then
      if qdisp(QD$NLBL) then goto qdisp.error
   end

   if double.space then
      if qdisp(QD$EMIT, '', 'D') then goto qdisp.error
   end

   return

* ======================================================================
* show.tabular -  Emit record for tabular report

show.tabular:
   * If using NO.SPLIT, check if this will fit on the current page

   if no.split then
      if not(pan.scroll) then lno = printer.setting(lptr, LPTR$LINE.NO, -2)
      if lno > 1 then
         * Count the lines required for this record

         lines.required = 0
         hi.v = dcount(map, @fm)
         for v = 1 to hi.v
            hi.sv = map<v>
            for sv = 1 to hi.sv
               for list.index = 1 to no.of.list.items
                  if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
                  list.item(list.index,ITEM.WORK) = disp.rec<list.index,v,sv>
               next list.index

               loop
                  more = @false
                  for list.index = 1 to no.of.list.items
                     if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
                     remove s from list.item(list.index, ITEM.WORK) setting i
                     if i then more = @true
                  next list.index
                  lines.required += 1
               while more
               repeat
            next sv
         next v

         * If there is insufficient space for this record on the current
         * page, start a new page.

         if qdisp(QD$NEED, lines.required) then goto qdisp.error
      end
   end

   * Now emit the item

   hi.v = dcount(map, @fm)
   for v = 1 to hi.v
      hi.sv = map<v>
      for sv = 1 to hi.sv
         for list.index = 1 to no.of.list.items
            if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
            list.item(list.index,ITEM.WORK) = disp.rec<list.index,v,sv>
         next list.index

         loop
            printline = space(if pan then width else device.width) ;* 0159
            c = margin + 1

            more = @false
            for list.index = 1 to no.of.list.items
               if list.item(list.index, ITEM.MODE) = REPORT.BREAK.SUP then continue
               remove s from list.item(list.index, ITEM.WORK) setting i
               if i then
                  more = @true
                  qproc.nd += (i < 5)
               end
               w = list.item(list.index, ITEM.WIDTH)

               if item.justification(list.item(list.index, ITEM.NO)) = 'U' then
                  printline[c,99999] = s
               end else
                  printline[c,len(s)] = s
               end
               c += w
               if w then c += col.spacing
            next list.index

            if is.grand.total then
               if index(grand.total.control, 'P', 1) then
                  if qdisp(QD$PAGE) then goto qdisp.error
               end
               printline[1, len(grand.total.text)] = grand.total.text
               is.grand.total= @false
            end

            if qdisp(QD$EMIT, printline, class) then goto qdisp.error
         while more
         repeat

         qproc.nd += 1
      next sv
   next v

   if double.space then
      if qdisp(QD$EMIT, '', 'D') then goto qdisp.error
   end

   return

* ======================================================================
* SHOW.ACCUMULATIONS  -  Show totals, averages, etc at end of report

show.accumulations:
   if accumulating and index(grand.total.control, 'L', 1) = 0 then
      class = 'T'

      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         item.report.mode = bitand(list.item(list.index, ITEM.MODE), report.mode.mask)
         if item.report.mode then
            on item.report.mode goto show.total,
                                     show.max,
                                     show.min,
                                     show.average,
                                     show.number,
                                     show.percent,
                                     show.calc,
                                     show.continue,  ;* BREAK.SUP
                                     show.cumulative
show.total:
show.max:
show.min:
show.cumulative:
            s = list.item(list.index, ITEM.ACCUM.VALUE)
            goto show.continue

show.average:
            n = list.item(list.index, ITEM.COUNT)
            if n then s = list.item(list.index, ITEM.ACCUM.VALUE) / n
            goto show.continue

show.number:
            s = list.item(list.index, ITEM.COUNT)
            goto show.continue.no.conversion

show.percent:
            s = list.item(list.index, ITEM.ACCUM.VALUE)
            n = list.item(list.index, ITEM.TOTAL)
            if n then s = s * 100 / n
            else s = 0
            goto show.continue.no.conversion

show.calc:
            * Recover master totals
            n = item.totals(item.to.list)
            if n then    ;* Item includes TOTAL() function
               j = item.tbase(item.to.list)
               for i = 1 to n   ;* For each TOTAL() function
                  qproc.totals(j) = list.item(list.index, ITEM.ACCUM.VALUE)<i> + 0
                  j += 1   ;* Step to next total
               next i
            end

            s = itype(item.detail(item.to.list), item.tbase(item.to.list))

show.continue:
            s = oconv(s, item.conv(item.to.list))
show.continue.no.conversion:
            s = fmt(s, item.fmt(item.to.list))
            if vertical then
               disp.rec<list.index> = s
            end else
               disp.rec<list.index> = str("=", item.display.width(item.to.list)) : @tm : s
            end
         end else
            if option(OPT.PICK.GRAND.TOTAL) and list.index = 1 then
               disp.rec<list.index> = @tm : grand.total.text
            end else
               disp.rec<list.index> = ""
            end
         end
      next list.index

      if not(option(OPT.PICK.GRAND.TOTAL)) then is.grand.total = @true
      else if index(grand.total.control, 'P', 1) then
          if qdisp(QD$PAGE) then goto qdisp.error
      end
      gosub report.record
   end

   return
   
* ======================================================================
* SHOW.BREAKPOINT  -  Show totals, averages, etc at breakpoint
*
* On entry:
*   breakpoint.index = index to current breakpoint item
*
* This routine prints the breakpoint line and the subtotal line (subject to
* the setting of the PICK.BREAKPOINT.U option).

show.breakpoint:
   class = if det.sup then 'D' else 'S'
   saved.data.rec = data.rec
   saved.disp.rec = disp.rec

   bp.ctrl = breakpoint.control(breakpoint.index) ;* Breakpoint codes
   suppress.subtotal.underline = (index(bp.ctrl, 'U', 1) = 0) = option(OPT.PICK.BREAKPOINT.U)
   subtotal.blankline = suppress.subtotal.underline and not(vertical) and not(det.sup) and option(OPT.PICK.BREAKPOINT) and index(bp.ctrl, 'L', 1)

   qproc.break.level = no.of.breakpoints - breakpoint.index + 1

   for list.index = 1 to no.of.list.items
      disp.rec<list.index> = ""

      item.to.list = list.item(list.index, ITEM.NO)
      bpi = item.breakpoint(item.to.list)

      item.report.mode = bitand(list.item(list.index, ITEM.MODE), report.mode.mask)
      if item.report.mode then
         on item.report.mode goto break.total,
                                  break.max,
                                  break.min,
                                  break.average,
                                  break.number,
                                  break.percent,
                                  break.calc,
                                  break.continue,     ;* BREAK.SUP
                                  break.cumulative
break.total:
break.max:
break.min:
break.cumulative:
         s = list.item(list.index, ITEM.LOCAL.VALUE)<breakpoint.index>
         goto break.continue

break.average:
         n = list.item(list.index, ITEM.LOCAL.COUNT)<breakpoint.index>
         if n then s = list.item(list.index, ITEM.LOCAL.VALUE)<breakpoint.index> / n
         goto break.continue

break.number:
         s = list.item(list.index, ITEM.LOCAL.COUNT)<breakpoint.index>
         goto break.continue.no.conversion

break.percent:
         s = list.item(list.index, ITEM.LOCAL.VALUE)<breakpoint.index>
         n = list.item(list.index, ITEM.TOTAL)
         if n then s = s * 100 / n
         else s = 0
         goto break.continue

break.calc:
         n = item.totals(item.to.list)
         if n then    ;* Item includes TOTAL() function
            * Recover totals for this breakpoint level

            j = item.tbase(item.to.list)
            for i = 1 to n   ;* For each TOTAL() function
               qproc.totals(j) = list.item(list.index, ITEM.LOCAL.VALUE)<breakpoint.index,i> + 0
               j += 1   ;* Step to next total
            next i
         end

         * Execute I-type with the recovered totals

         s = itype(item.detail(item.to.list), item.tbase(item.to.list))

break.continue:
         s = oconv(s, item.conv(item.to.list))
break.continue.no.conversion:
         if reformat.command then
            disp.rec<list.index> = s
         end else
            s = fmt(s, item.fmt(item.to.list))
            if subtotal.blankline then
               disp.rec<list.index> = @tm : s
            end else if vertical or det.sup or suppress.subtotal.underline then
               disp.rec<list.index> = s
            end else
               disp.rec<list.index> = str("-", item.display.width(item.to.list)) : @tm : s
            end
         end
      end else if bpi then
         * This field has a breakpoint

         if bpi = breakpoint.index or (bpi < breakpoint.index and not(option(OPT.PICK.BREAKPOINT))) then
            * Include breakpoint value in report column

            bp.data = bp.rec<list.index>   ;* Data for field

            conversion = item.conv(item.to.list)
            if item.multivalued(item.to.list) then
               if len(conversion) then bp.data = oconvs(bp.data, conversion)
               bp.data.conv = bp.data
               if item.justification(item.to.list) # 'U' then
                  bp.data = fmts(bp.data, item.fmt(item.to.list))
               end
            end else
               if len(conversion) then bp.data = oconv(bp.data, conversion)
               bp.data.conv = bp.data
               if item.justification(item.to.list) # 'U' then
                  bp.data = fmt(bp.data, item.fmt(item.to.list))
               end
            end

            if subtotal.blankline then
               disp.rec<list.index> = @tm : bp.data
            end else if det.sup or suppress.subtotal.underline then
               disp.rec<list.index> = bp.data
            end else
               disp.rec<list.index> = @tm : bp.data
            end
         end

         if item.to.list = breakpoint.items(breakpoint.index) then
            * This is the breakpoint field

            bp.text = breakpoint.string(breakpoint.index)  ;* Breakpoint text
            bp.ctrl = breakpoint.control(breakpoint.index) ;* Breakpoint codes

            if suppress.subtotal.underline then
               disp.rec<list.index> = bp.text
            end else
               disp.rec<list.index> = bp.text : @tm : bp.data
            end

            begin case
               case det.sup or reformat.command
                  * Suppressing detail lines. Print the subtotal only
                  disp.rec<list.index> = bp.data

               case option(OPT.PICK.BREAKPOINT)
                  if index(bp.ctrl, 'D', 1) and detail.lines <= breakpoint.detail.count(breakpoint.index) + 1 then
                     goto omit.breakpoint.line
                  end
                  if index(bp.ctrl, 'V', 1) then
                     bp.text = change(bp.text, @im, trimf(bp.data.conv))[1, item.display.width(item.to.list)]
                  end
                  if item.justification(item.to.list) # "U" and item.display.width(item.to.list) then
                     bp.text = fmt(bp.text, item.fmt(item.to.list))
                  end
                  if subtotal.blankline or (accumulating and not(suppress.subtotal.underline)) then
                     bp.text = @tm : bp.text
                  end
                  disp.rec<list.index> = bp.text

               case index(bp.ctrl, 'D', 1)
                  if detail.lines <= breakpoint.detail.count(breakpoint.index) + 1 then goto omit.breakpoint.line

               case index(bp.ctrl, 'L', 1)
                  goto omit.breakpoint.line

               case index(bp.ctrl, 'V', 1)
                  s = change(bp.text, @im, trimf(bp.data))[1, item.display.width(item.to.list)]
                  disp.rec<list.index> = fieldstore(disp.rec<list.index>, @tm, 1, 1, s)

               case accumulating
                  if suppress.subtotal.underline then
                     disp.rec<list.index> = bp.text
                  end else
                     disp.rec<list.index> = bp.text : @tm : bp.data
                  end

               case 1
                  disp.rec<list.index> = bp.text
            end case
         end
      end
   next list.index

   gosub report.record

omit.breakpoint.line:
   if not(det.sup or reformat.command) and last.breakpoint then
      if qdisp(QD$EMIT, '', class) then goto qdisp.error
   end

   gosub reset.breakpoint.counters

   qproc.break.level = 0

   data.rec = saved.data.rec
   disp.rec = saved.disp.rec

   return

* ======================================================================
* Reset counters

reset.breakpoint.counters:
   if accumulating then
      for list.index = 1 to no.of.list.items
         for bp = breakpoint.index to no.of.breakpoints
            list.item(list.index, ITEM.LOCAL.VALUE)<bp> = 0
            list.item(list.index, ITEM.LOCAL.COUNT)<bp> = 0
         next bp
      next list.index
   end

   for bp = breakpoint.index to no.of.breakpoints
      breakpoint.detail.count(bp) = detail.lines
   next bp

   return

* =============================================================================

record.not.found:
   if status() # ER$RNF and id # '' then
      display sysmsg(7276, status(), id) ;* Error xx reading xx
      goto exit.qproc
   end

   locate id in not.found.list<1> setting i else
      not.found.list<-1> = id
   end

   return

* ======================================================================
* Extended table diagnostics

diagnostic:
   crt 'Number of items = ' : no.items
   crt '   Name...... Ty Conv Fmt.. Wid J SM DispName.. Assoc Detail'
   for i = 1 to no.items
      crt fmt(i, '2R') : ' ' :
      crt (item.name(i)[1,10]) '11L' :
      crt 'IdD I X '[((item.type(i) - 1) * 2) + 1, 2] : ' ' :
      crt (item.conv(i)[1,4]) '5L' :
      crt (item.fmt(i)[1,5]) '6L' :
      crt (item.display.width(i)[1,3]) '4L' :
      crt (item.justification(i)[1,1]) '2L' :
      crt (item.multivalued(i)[1,1]) '3L' :
      crt (item.display.name(i)[1,10]) '11L' :
      crt (item.assoc(i)) '5R' : ' ' :
      begin case
         case item.type(i) = ID.ITEM      ; crt 0
         case item.type(i) = FIELD.ITEM   ; crt item.detail(i)[1,20]
         case item.type(i) = ITYPE.ITEM   ; crt
         case item.type(i) = LITERAL.ITEM ; crt item.detail(i)[1,20]
         case item.type(i) = NI.ITEM      ; crt 9998
         case item.type(i) = BYTES.ITEM   ; crt 9999
      end case
   next i
   crt

   if synonyms # '' then
      crt 'Synonyms'
      n = dcount(synonyms, @fm)
      for i = 1 to n
         crt fmt(synonym.refs<i>, '3R') : ': ' : synonyms<i>
      next i
      crt
   end

   if num.associations then
      display 'Associations:'
      for i = 1 to num.associations
         display fmt(i, '2R') : ': ' : association.names<i>
      next i
      display
   end

   crt 'Display items'
   crt'   Itm Wdth Mode Heading.......................'
   for i = 1 to no.of.list.items      
      crt fmt(i, '2R') : ' ' :
      crt fmt(list.item(i,ITEM.NO), '3R') : ' ' :
      crt fmt('', '4R') : ' ' :
**crt fmt(list.item(i,ITEM.WIDTH), '4R') : ' ' :
      crt '    TOTLMAX MIN AVG ENUMPCT '[(bitand(list.item(i,ITEM.MODE),REPORT.MODE.MASK) * 4) + 1,4] : ' ' :
**      crt list.item(i,ITEM.HEADING)[1,30]
      crt
   next i
   crt

!!   if hi.sel then gosub debug.selection

   return

* ======================================================================
* get.label.data  -  Get numeric parameters for LIST.LABEL
*
* txt = prompt text, returns value in n

get.label.data:
   loop   
      display txt : ':  ' :
      input n
   until n matches '1-3N'
      display sysmsg(7278) ;* Numeric value required
   repeat
   n += 0

   return

* ======================================================================
* get.label.yn  -  Get Y/N parameters for LIST.LABEL
*
* txt = prompt text, returns value in n as boolean

get.label.yn:
   loop   
      display txt : ':  ' :
      input n
      n = upcase(n)
   until n = 'Y' or n = 'N'
      display sysmsg(7279) ;* Y or N required
   repeat
   n = ( n = 'Y')

   return

* ======================================================================
* Refine selection for SHOW command

show.selection:
* Identify all associations with more than one member in display

   show.association.names = ''
   show.association.items = ''
   show.assoc.usage = ''
   for list.idx = 1 to no.of.list.items
      item.idx = list.item(list.idx, ITEM.NO)
      if item.multivalued(item.idx) then
         assoc = item.assoc(item.idx)
         if assoc then
            locate assoc in show.assoc.usage<1,1> setting i then    ;* Seen before
               locate assoc in show.association.names<1> setting j then
                  show.association.items<j,-1> = list.idx
               end else
                  show.association.names<j> = assoc
                  show.association.items<j> = show.assoc.usage<2,i> : @vm : list.idx
               end
            end else                                           ;* First reference
               show.assoc.usage<1,i> = assoc
               show.assoc.usage<2,i> = list.idx
            end
         end
      end
   next list.idx
   num.show.associations = dcount(show.association.names, @fm)


   width = @crtwide
   data.lines = @crthigh - 3  ;* Status, input and error lines
   status.line = data.lines
   input.line = data.lines + 1
   error.line = data.lines + 2

   ln = 0
   if not(hdr.sup) then
      if page.heading = NUL then page.heading = @sentence[1, @crtwide-1]
      ln += 1
   end

   * Set up column headings

   if not(col.sup) then
      col.hdr.line = ln

      * Find number of lines required for heading

      hdg.lines = 1
      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         hdg = item.display.name(item.to.list)
         n = dcount(hdg, @vm)
         if n > hdg.lines then hdg.lines += 1
      next list.index

      * Build column heading

      col.heading = ""
      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         n = item.display.width(item.to.list)
         hdg = item.display.name(item.to.list)
         ln = dcount(hdg, @vm)
         for j = 1 to hdg.lines
            if j <= ln then hdg.fmt = n:".L"   ;* In body of heading
            else hdg.fmt = n:"L"               ;* Trailing blank line
            col.heading<j> = col.heading<j> : fmt(hdg<1,j>[1,n], hdg.fmt) : space(col.spacing)
         next j
      next list.index

      hdg.lines = dcount(col.heading, @fm)
      data.lines -= hdg.lines
   end

   selection.map = space(records.selected)
   dim item.map(data.lines)   ;* Maps list item numbers to screen lines

   pgno = 1
   pg.offset = 0
   offset = 0
   sel.count = 0

repaint:
   gosub show.page

   loop
      action = ''
      display @(0, input.line) : '>' : @(-4) :
      input @(1, input.line) : action, (width - 1)_:
      action = upcase(action)

      begin case
         case len(action) = 0 or action = 'N'
            n = pg.offset<pgno + 1>
            if len(n) then  ;* Already been to this page
               pgno += 1
               offset = n
               gosub show.page
            end else        ;* Creating new page
               if offset + items.on.page < records.selected then  ;* Not end
                  pgno += 1
                  offset += items.on.page
                  pg.offset<pgno> = offset
                  gosub show.page
               end
            end

         case action[1,1] = 'C'
            sel.mode = ' '
            sel.string = trim(action[2,9999])
            gosub make.selection

         case action = 'P'
            if offset then
               pgno -= 1
               offset = pg.offset<pgno>
               gosub show.page
            end

         case action = 'QC'
            exit

         case action = 'Q'
            num.selections = count(selection.map, '*')
            begin case
               case num.selections = 0           ;* Nothing selected
                  exit

               case num.selections < min.list    ;* Insufficient items
                  if min.list = max.list then
                     err = sysmsg(7280, min.list) ;* Must select exactly xx item(s)
                  end else
                     err = sysmsg(7281, min.list) ;* Must select at least xx item(s)
                  end
                  inputerr err

               case max.list and num.selections > max.list ;* Too many items
                  if min.list = max.list then
                     err = sysmsg(7280, max.list) ;* Must select exactly xx item(s)
                  end else
                     err = sysmsg(7282, max.list) ;* Must select no more than xx item(s)
                  end
                  inputerr err

               case 1
                  exit
            end case

         case action = 'R' or action = '^^'
            gosub show.page

         case action[1,1] = 'S'
            sel.mode = '*'
            sel.string = trim(action[2,99999])
            gosub make.selection

         case action = 'T'
            pgno = 1
            offset = 0
            gosub show.page

         case action = '?' or action[1,1] = "H"
            gosub display.help
            goto repaint

         case 1
            sel.mode = '*'
            sel.string = action
            gosub make.selection
      end case
   repeat

   for i = records.selected to 1 step -1
      if selection.map[i,1] # '*' then
         del s.list<i>
         records.selected -= 1
      end
   next i

   display
   display

   return

* ======================================================================
* Show a page
*
* In:  pgno          = page number
*      offset        = offset of first record on page
* Out: items.on.page = number of displayed items

show.page:
   display @(-1) :
   rec.idx = offset + 1
   items.on.page = 0
   ln = 0

   * Display page and column headings

   if not(hdr.sup) then
      display @(0, ln) : page.heading :
      ln += 1
   end

   if not(col.sup) then
      ln = col.hdr.line
      for i = 1 to hdg.lines
         display @(0, ln) : fmt('     ' : col.heading<i>[1,width], width:'L') :
         ln += 1
      next i
   end

   loop
   while ln < status.line and rec.idx <= records.selected
      num.lines = 1   ;* Number of lines required to display this item
      id = s.list<rec.idx>
      record.found = @false

      * Extract and format data to be displayed

      disp.rec = ''
      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         type = item.type(item.to.list)
         begin case
            case type = ID.ITEM
               data = id

            case type = FIELD.ITEM
               if not(record.found) then
                  gosub read.record.to.show
                  if not(record.found) then continue
               end
               data = rec<item.detail(item.to.list)>

            case type = ITYPE.ITEM
               if not(record.found) then
                  gosub read.record.to.show
                  if not(record.found) then continue
               end
               @record = rec
               @id = id
               data = itype(item.detail(item.to.list))

            case type = LITERAL.ITEM
               data = item.detail(item.to.list)

            case type = NI.ITEM
               data = qproc.ni

            case type = BYTES.ITEM
               data = len(rec)
         end case

         conv = item.conv(item.to.list)
         format = item.fmt(item.to.list)
         if item.multivalued(item.to.list) then
            if len(conv) then data = oconvs(data, conv)
            if len(format) then data = fmts(data, format)
         end else
            if len(conv) then data = oconv(data, conv)
            if len(format) then data = fmt(data, format)
         end
         disp.rec<list.index> = data

         n = dcount(data, @fm)
         if n > num.lines then num.lines = n
      next list.index

      * For associated fields, pair up values and subvalues, replacing all
      * marks by value marks when we are done.

      for assoc.idx = 1 to num.show.associations
         sv.count = ''  ;* One field per value holding number of subvalues
         tm.count = ''  ;* Text mark count per value and subvalue
         assoc.list = show.association.items<assoc.idx>
         num.assoc.items = dcount(assoc.list, @vm)

         * Establish max values and subvalues in each associated item

         for assoc.item.idx = 1 to num.assoc.items
            list.idx = assoc.list<1,assoc.item.idx> + 0
            s = disp.rec<list.index>
            num.values = dcount(s, @vm)
            for v = 1 to num.values
               num.subvalues = dcount(s<1,v>, @sm)
               if num.subvalues = 0 then num.subvalues = 1
               if num.subvalues > sv.count<v> then sv.count<v> = num.subvalues

               * Count text marks
               for sv = 1 to num.subvalues
                  n = count(s<1,v,sv>, @tm)
                  if n > tm.count<v,sv> then tm.count<v,sv> = n
               next sv
            next v
         next assoc.item.idx

         * Now pair up the items

         num.values = dcount(sv.count, @fm)
         for assoc.item.idx = 1 to num.assoc.items
            item.idx = assoc.list<1,assoc.item.idx> + 0
            for v = 1 to num.values
               num.subvalues = sv.count<v> + 0
               for sv = 1 to num.subvalues
                  * Force mark insertion
                  n = tm.count<v,sv>
                  s = disp.rec<list.idx,v,sv>
                  t = count(s, @tm)
                  if t < n then s := str(@tm, n - t)
                  disp.rec<list.idx,v,sv> = s
               next sv
            next v
         next assoc.item.idx
      next assoc.idx

      for list.index = 1 to no.of.list.items
         item.to.list = list.item(list.index, ITEM.NO)
         if item.multivalued(item.to.list) then
            disp.rec<list.index> = convert(@tm:@sm, @vm:@fm, disp.rec<list.index>)
         end else
            disp.rec<list.index> = convert(@tm, @vm, disp.rec<list.index>)
         end
         n = dcount(disp.rec<list.index>, @vm)
         if n > num.lines then num.lines = n
      next list.index

      * If this is not the first item on this page, check whether it will fit

      if items.on.page > 1 then  ;* Not first item, will it fit on page?
         if ln + num.lines > status.line then exit  ;* Defer for next page
      end

      * Display the item

      items.on.page += 1
      s = fmt(items.on.page, '2R') : selection.map[rec.idx,1] : '  '
      item.map(items.on.page) = ln  ;* Remember screen line position
      for item.line = 1 to num.lines
         for list.index = 1 to no.of.list.items
            item.to.list = list.item(list.index, ITEM.NO)
            w = item.display.width(item.to.list)
            s := fmt(disp.rec<list.index,item.line>[1,w], w:'L') : space(col.spacing)
         next list.index
         if len(trim(s)) then ;* Omit intermediate null lines
            display @(0, ln) : s[1,width] : @(-4) :
            ln += 1
         end
      while ln < status.line
         s = space(5)
      next item.line

      rec.idx += 1
   repeat

   loop
   while ln < status.line
      display @(0, ln) : @(-4) :
      ln += 1
   repeat

   display @(0,error.line) : 'Select, Clear, Top, Previous, Next, Quit, ?' :

   gosub display.status

   return

read.record.to.show:
   read rec from data.f, id then record.found = @true
   else  ;* Error reading record - remove from list
      del s.list<rec.idx>
      selection.map = selection.map[1, rec.idx-1] : selection.map[rec.idx+1, 999999]
      records.selected -= 1
   end
   return

* ======================================================================
* make.selection  -  Select or deselect items
*
* sel.mode   = Display code (asterisk or space)
* sel.string = Items to select/deselect

make.selection:
   sel.string = convert(' ,', '', trim(sel.string))

   if len(sel.string) then
      loop
         sel.item = remove(sel.string, sel.delim)
         begin case
            case sel.item matches '1N0N'
               sel.item += 0
               if sel.item < 1 or sel.item > items.on.page then
                  inputerr sysmsg(7283) ;* Invalid item number
               end else
                  selection.map[offset + sel.item, 1] = sel.mode
                  display @(2, item.map(sel.item)) : sel.mode :
               end

            case sel.item matches "1N0N'-'1N0N"
               lo = field(sel.item, '-', 1) + 0
               hi = field(sel.item, '-', 2) + 0
               if lo < 1 or hi > items.on.page or hi < lo then
                  inputerr sysmsg(7284) ;* Invalid selection range
               end else
                  for n = lo to hi
                     selection.map[offset + n, 1] = sel.mode
                     display @(2, item.map(n)) : sel.mode :
                  next n
               end

            case sel.item = 'VISIBLE'[1,len(sel.item)]
               for n = 1 to items.on.page
                  selection.map[offset + n, 1] = sel.mode
                  display @(2, item.map(n)) : sel.mode :
               next n

            case sel.item = 'ALL'[1,len(sel.item)]
               selection.map = str(sel.mode, records.selected)
               for n = 1 to items.on.page
                  display @(2, item.map(n)) : sel.mode :
               next n

            case 1
               inputerr sysmsg(7285) ;* Invalid selection
         end case
      while sel.delim
      repeat
   end

   sel.count = count(selection.map, '*')
   gosub display.status

   return

* ======================================================================

display.help:
   display @(10,  3) : '                                                  ' :
   display @(10,  4) : '  ==============================================  ' :
   display @(10,  5) : '  | S ss   Select items defined by ss          |  ' :
   display @(10,  6) : '  | C ss   Clear items defined by ss           |  ' :
   display @(10,  7) : '  |   ss is  number, range, VISIBLE or ALL     |  ' :
   display @(10,  8) : '  | T      Display top page                    |  ' :
   display @(10,  9) : '  | P      Display previous page               |  ' :
   display @(10, 10) : '  | N      Display next page (default command) |  ' :
   display @(10, 11) : '  | Q      Quit, setting target list           |  ' :
   display @(10, 12) : '  | QC     Quit, clearing any selection        |  ' :
   display @(10, 13) : '  | QC     Quit, clearing any selection        |  ' :
   display @(10, 14) : '  ==============================================  ' :
   display @(10, 15) : '                                                  ' :

   c = keyin()
   return

* ======================================================================

display.status:
   s = 'Page ' : pgno
   if offset + items.on.page < records.selected then
      s := ' ' : sysmsg(7286) ;* (more)
   end

   s := ', ' : sysmsg(7287, sel.count) ;* xx items selected
   display @(0, status.line) : s : @(-4) :

   return

* ======================================================================

op.error:
   abort 'Internal error: Selection opcode ' : op

* ======================================================================
* Index   Opcode   Arg1   Arg2   Arg3   Expansion
* ..123.....12.....1234...1234...1234...F1 EQ F2

debug.selection:
   display 'Index   Opcode   Arg1   Arg2   Arg3   Expansion'
   for sel.idx = 1 to hi.sel
      display (sel.idx '5R') :

      display (selection(sel.idx,SEL.OP) '7R') :

      * Arg 1
      arg1 = selection(sel.idx,SEL.ARG1)
      if arg1 then display arg1 '9R' :
      else display space(9) :

      * Arg 2
      arg2 = selection(sel.idx,SEL.ARG2)
      if arg2 then display arg2 '7R' :
      else display space(7) :

      * Arg 3
      arg3 = selection(sel.idx,SEL.ARG3)
      if arg3 then display arg3 '7R' :
      else display space(7) :

      * Build expansion
      display '   ' :
      op = selection(sel.idx,SEL.OP)
      begin case
         case op = OP.WITH
            display 'WITH' :
         case op = OP.WHEN
            display 'WHEN' :
         case op = OP.AND
            display 'AND' :
         case op = OP.OR
            display 'OR' :
         case op = OP.NO
            display 'NO' :
         case op = OP.BETWEEN
            j = arg1 ; gosub debug.selection.item            
            display field(opcode.names,',',op) : ' ' :
            j = arg2 ; gosub debug.selection.item            
            j = arg3 ; gosub debug.selection.item            
         case op = OP.NOT.NULL or op = (OP.NOT.NULL + 1)
            j = arg1 ; gosub debug.selection.item            
            display field(opcode.names,',',op) : ' ' :
         case 1
            j = arg1 ; gosub debug.selection.item            
            display field(opcode.names,',',op) : ' ' :
            j = arg2 ; gosub debug.selection.item            
      end case

      display
   next sel.idx

   display 'non.ak.selection.index = ' : non.ak.selection.index
   if non.ak.selection.index > 1 then
      display 'ak.operator = ' : ak.operator : ' (' : field(opcode.names, ',', ak.operator) : ')'
      display 'ak.value = "' : ak.value : '"'
      display 'ak.hi.value = "' : ak.hi.value : '"'
   end

   display 'Field based selection = ' : field.sel

   input x

   return

debug.selection.item:
   begin case
      case item.type(j) = ID.ITEM
         crt '@ID ' :
      case item.type(j) = FIELD.ITEM
         crt 'F' : item.detail(j) : ' ' :
      case item.type(j) = ITYPE.ITEM
         crt 'I-type ' :
      case item.type(j) = LITERAL.ITEM
         crt 'Literal "' : item.detail(j) : '"' :
      case item.type(j) = NI.ITEM
         crt 'F9998 ' :
      case item.type(j) = BYTES.ITEM
         crt 'F9999 ' :
   end case
   return

* ======================================================================
* set.col.hdg  -  Set column heading
* s = dictionary heading definition
* item.index = item table entry to set
  
set.col.hdg:
   if s = '' then s = item.name(item.index)
   else if s = '\' then s = ''
   item.display.name(item.index) = s
   return

   * Avoid compiler warnings
   s = sort.data(1)

* ======================================================================

apply.when.filter:
   truth = @true

   sel.idx = non.ak.selection.index
   in.when = @false
   mat when.op = 0  ;* First pass

   loop
   while sel.idx <= hi.sel
      inverse = @false

      loop
         op = selection(sel.idx,SEL.OP)
         begin case
            case op = OP.NO     ; inverse = @true
            case op = OP.WHEN   ; in.when = @true
            case op = OP.WITH   ; in.when = @false
            case 1 ; exit
         end case
         sel.idx += 1
      repeat

      if in.when then
         * Fetch record / value for item 1

         item.index = selection(sel.idx,SEL.ARG1)
         item1.assoc = item.assoc(item.index)
         item1.conv = item.conv(item.index)
         item1.type = item.type(item.index)
         item1.mv = item.multivalued(item.index)
         gosub get.item
         item1 = item

         if explode then
            if not(option(OPT.PICK.EXPLODE)) or ismv(item1) then
               item1 = item1<1, exp.v, exp.sv>
            end
         end

         op  = selection(sel.idx,SEL.OP)

         if bitand(op, 0xFC) # OP.NOT.NULL then   ;* 0525
            * Fetch record / value for item 2

            item.index = selection(sel.idx,SEL.ARG2)
            ! item2.conv = item.conv(item.index)
            gosub get.item
            item2 = item

            * If we are processing a file with case insensitive ids and
            * item 1 is the record id, map both items to upper case.

            if is.case.insensitive then  ;* 0394
               if item1.type = ID.ITEM then
                  item1 = upcase(item1)
                  item2 = upcase(item2)
               end
            end
         end

         * Perform comparison

         on op goto op.error,      ;* OP.WITH
                    op.error,      ;* OP.WHEN
                    op.error,      ;* OP.NO
                    when.eq,       ;* OP.EQ
                    op.error,      ;* OP.EQ with EVERY
                    when.eq.nc,    ;* OP.EQ with NO.CASE
                    op.error,      ;* OP.EQ with EVERY and NO.CASE
                    when.ne,       ;* OP.NE
                    op.error,      ;* OP.NE with EVERY
                    when.ne.nc,    ;* OP.NE with NO.CASE
                    op.error,      ;* OP.NE with EVERY and NO.CASE
                    when.lt,       ;* OP.LT
                    op.error,      ;* OP.LT with EVERY
                    when.lt.nc,    ;* OP.LT with NO.CASE
                    op.error,      ;* OP.LT with EVERY and NO.CASE
                    when.le,       ;* OP.LE
                    op.error,      ;* OP.LE with EVERY
                    when.le.nc,    ;* OP.LE with NO.CASE
                    op.error,      ;* OP.LE with EVERY and NO.CASE
                    when.ge,       ;* OP.GE
                    op.error,      ;* OP.GE with EVERY
                    when.ge.nc,    ;* OP.GE with NO.CASE
                    op.error,      ;* OP.GE with EVERY and NO.CASE
                    when.gt,       ;* OP.GT
                    op.error,      ;* OP.GT with EVERY
                    when.gt.nc,    ;* OP.GT with NO.CASE
                    op.error,      ;* OP.GT with EVERY and NO.CASE
                    when.like,     ;* OP.LIKE
                    op.error,      ;* OP.LIKE with EVERY
                    when.like.nc,  ;* OP.LIKE with NO.CASE
                    op.error,      ;* OP.LIKE with EVERY and NO.CASE
                    when.unlike,   ;* OP.UNLIKE
                    op.error,      ;* OP.UNLIKE with EVERY
                    when.unlike,   ;* OP.UNLIKE with NO.CASE
                    op.error,      ;* OP.UNLIKE with EVERY and NO.CASE
                    when.said,     ;* OP.SAID
                    op.error,      ;* OP.SAID with EVERY
                    when.said.nc,  ;* OP.SAID with NO.CASE
                    op.error,      ;* OP.SAID with EVERY and NO.CASE
                    when.not.null, ;* OP.NOT.NULL
                    op.error,      ;* OP.NOT.NULL with EVERY
                    when.not.null, ;* OP.NOT.NULL with NO.CASE
                    op.error,      ;* OP.NOT.NULL with EVERY and NO.CASE
                    when.between.nc, ;* OP.BETWEEN with NO.CASE
                    op.error,      ;* OP.BETWEEN with EVERY and NO.CASE
                    op.error,      ;* OP.OR
                    op.error       ;* OP.AND

!!OPCODES!!

when.eq.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.eq:
         truth = eqs(item1, reuse(item2))
         goto next.filter

when.ne.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.ne:
         truth = nes(item1, reuse(item2))
         goto next.filter

when.lt.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.lt:
         truth = lts(item1, reuse(item2))
         goto next.filter

when.le.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.le:
         truth = les(item1, reuse(item2))
         goto next.filter

when.ge.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.ge:
         truth = ges(item1, reuse(item2))
         goto next.filter

when.gt.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.gt:
         truth = gts(item1, reuse(item2))
         goto next.filter

when.like.nc:
when.unlike.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.like:
when.unlike:
         truth = ''
         if item1 # '' then
            loop
               truth := remove(item1, match.delim) matches item2
            while match.delim
               truth := char(256 - match.delim)
            repeat
         end
         if op >= OP.UNLIKE and op <= OP.UNLIKE + 3 then truth = nots(truth)
         goto next.filter

when.said.nc:
         item1 = upcase(item1)
         item2 = upcase(item2)
when.said:
         truth = eqs(soundexs(item1), reuse(item2))
         goto next.filter

when.not.null:
         truth = eqs(item1, reuse(''))
         goto next.filter

when.between.nc:
         gosub get.item3
         item1 = upcase(item1)
         item2 = upcase(item2)
         item3 = upcase(item3)
         goto when.between.continue
when.between:
         gosub get.item3
when.between.continue:
         if is.case.insensitive then ;* 0394
            if item1.type = ID.ITEM then item3 = upcase(item3)
         end
         truth = ands(ges(item1, item3), les(item1, item2))
         goto next.filter

next.filter:
         if inverse then truth = nots(truth)

         * Merge with any previous result

         n = when.op(item1.assoc)
         begin case
            case n = 2           ;* AND
               when.mask(item1.assoc) = ands(truth, when.mask(item1.assoc))
            case n = 3           ;* OR
               when.mask(item1.assoc) = ors(truth, when.mask(item1.assoc))
            case 1           ;* First item
               when.op(item1.assoc) = 1          ;* For single clause path
               when.mask(item1.assoc) = truth
         end case

         * Look at next selection element

         sel.idx += 1

         op = selection(sel.idx, SEL.OP)
         begin case
            case op = OP.AND
               when.op(item1.assoc) = 2
            case op = OP.OR
               when.op(item1.assoc) = 3
            case 1
               exit
         end case
      end
      sel.idx += 1
   repeat

   return
end

* END-CODE

