View source for LSELECT

It is easy to select data from a file when a field equals a known value.  e.g.

>LIST CUSTOMER WITH CUSTNO = "12345"

It is also easy to select data from a file when a field equals one of a number of known value.  e.g.

>LIST CUSTOMER WITH CUSTNO = "12345""12346""12347""12348"

The query processor is very powerful and offers many ways to easily accommodate queries. Using selects before processing a query is a standard method to filter data.  e.g.

>SELECT CUSTOMER WITH CUSTTYPE = "1"

14 items selected.

>>SELECT CUSTOMER WITH CUSTNO = "12345"

3 items selected.

>>LIST CUSTOMER

On occasion, we have a list of data we'd like to compare a select to to see if any data exists in the list.  We might have a list of non-primary key values of colors and we want to select the items in a product file whose color matches one of the colors in this list.

It would be a very nice feature if we could do something like:

>LSELECT PRODUCTS WITH COLOR IN MYLIST

Somewhere we created MYLIST based on various colors with certain properties.  e.g.

>SELECT COLORS WITH COLORTYPE = "POPULAR"

20 items selected.

>SAVE.LIST MYLIST
Overwriting existing saved list.
20 key(s) saved to 1 record(s).

Now we want to use our fantasized query to select all our products that have this popular color.

>LSELECT PRODUCTS WITH COLOR IN MYLIST
750 items selected.

>>SORT PRODUCTS ....

Rocket Software, and IBM before this, had a tech tip that allowed us to create this new verb (LSELECT).

     https://u2devzone.rocketsoftware.com/accelerate/articles/u2-select/u2-select

The following is a basic program I created to use on [[UniData]].<pre>

!
** Select file items using keys in select list
** (C) Copyright 1985-2012, Pacific Mgmt Software, Inc.  All Rights Reserved.
!
** Last Modified: 07 Aug 2012, wph
** First Created: 01 Oct 2009, wph
** Program Type-: Utility
!
** Notes:
**
** This process selects the items in [[FileName]] whose keys are in the
** defined select (saved) list.
**
**----------------------------------------------------------------------**
**                                                                      **
**                      I N I T I A L I Z A T I O N                     **
**                                                                      **
**----------------------------------------------------------------------**
*
** Initialization
NULL$ = ''
SP1   = ' '
*
* Initialize command variables
FILE.NAME   = NULL$
DICT.NAME   = NULL$
OPER        = NULL$
SOURCE.LIST = NULL$
TO.OP       = NULL$
DEST.LIST   = NULL$
*
** Initialize other variables
SOURCE.LIST.NAMED = 1
DEST.LIST.NAMED   = 1
DISPLAY.HELP      = 0
VERBOSE           = 0
*
**----------------------------------------------------------------------**
**                                                                      **
**               S T A R T   P R O C E S S I N G   D A T A              **
**                                                                      **
**----------------------------------------------------------------------**
*
** Run the command program
GOSUB GET.COMMAND
GOSUB GET.SOURCE.SELECT.LIST
GOSUB CREATE.TEMP.FILE
GOSUB LOAD.TEMP.FILE
GOSUB BUILD.LIST2
GOSUB FINISH.UP
GOTO END.OF.PROGRAM
*
**----------------------------------------------------------------------**
**                                                                      **
**                       S U B R O U T I N E ( S )                      **
**                                                                      **
**----------------------------------------------------------------------**
*
** Get the command and process
***************
GET.COMMAND:
***************
*
** Gather and parse input from command line
INPUT.PARAMS = TRIM(FIELD(@SENTENCE, " ", 2, 999))
SWAP ' ' WITH ';' IN INPUT.PARAMS
POS = 1
FILE.NAME = TRIM(FIELD(INPUT.PARAMS, ";", POS))
POS += 1
WITH.OP = UPCASE(TRIM(FIELD(INPUT.PARAMS, ";", POS)))
IF WITH.OP = "WITH" THEN POS += 1
DICT.NAME = TRIM(FIELD(INPUT.PARAMS, ";", POS))
POS += 1
OPER = UPCASE(TRIM(FIELD(INPUT.PARAMS, ";", POS)))
IF OPER = "IN" THEN
   POS += 1
   SOURCE.LIST= TRIM(FIELD(INPUT.PARAMS, ";", POS))
   POS += 1
   TO.OP = UPCASE(TRIM(FIELD(INPUT.PARAMS, ";", POS)))
   IF TO.OP = "TO" THEN POS += 1
   DEST.LIST = TRIM(FIELD(INPUT.PARAMS, ";", POS))
   IF DEST.LIST = "VERBOSE" OR DEST.LIST = "-V" THEN
      VERBOSE = 1
      DEST.LIST = NULL$
   END
END ELSE
   IF OPER = "TO" THEN
      POS += 1
      DEST.LIST = OCONV(TRIM(FIELD(INPUT.PARAMS, ";", POS)), 'MCU')
      IF DEST.LIST = "VERBOSE" OR DEST.LIST = "-V" THEN
         VERBOSE = 1
         DEST.LIST = NULL$
      END
   END ELSE
      IF OPER # NULL$ THEN
         ERROR.MSG =  'Expecting "IN" or "TO" clause. Found ':OPER
         GOSUB SHOW.MESSAGE
         DISPLAY.HELP = 1
      END
   END
END
*
LAST.COMMAND = UPCASE(FIELD(INPUT.PARAMS, ";", DCOUNT(INPUT.PARAMS, ";")))
IF (LAST.COMMAND = "VERBOSE") OR (LAST.COMMAND = "-V") THEN VERBOSE = 1
*
** Display Usage if parameters not supplied or help is requested
IF FILE.NAME = NULL$ OR FILE.NAME = "?" OR FILE.NAME = "HELP" OR DICT.NAME = NULL$ THEN DISPLAY.HELP = 1
IF DISPLAY.HELP THEN
   PRINT
   PRINT 'This will create a list of {[[FileName]]} keys for records whose'
   PRINT 'field definition value appears in a defined list.'
   PRINT
   PRINT 'Syntax:'
   PRINT '  LSELECT [[File_Name]] WITH [[Dict_Name]] IN LIST1 TO LIST2 [VERBOSE| -V]'
   PRINT
   PRINT 'Example: SELECT CUSTOMERS SAMPLE 500'
   PRINT ' SAVE.LIST MY.LIST'
   PRINT ' LSELECT SALES.ORDERS WITH CUST.NBR IN MY.LIST TO MY.LIST.2'
   PRINT
   PRINT 'Notes:'
   PRINT 'If a destination list is not supplied then keys will be left as the active'
   PRINT 'select list.  If a source list is not supplied then the current active select'
   PRINT 'list will be used.  Lists may be specified as select buffers (0-8) or as named'
   PRINT 'lists from SAVEDLISTS.'
   PRINT
   STOP
END
*
** Validate Dictionary
DR.REC = XLATE("DICT ":FILE.NAME, DICT.NAME, -1, "X")
IF DR.REC = NULL$ THEN
   ERROR.MSG = "Unable to read dictionary ":DICT.NAME:"  for file ":FILE.NAME
   GOSUB SHOW.MESSAGE
   STOP
END ELSE
   IF DR.REC<6> # "S" THEN
      ERROR.MSG = "Warning, ":DICT.NAME:" is not a single valued field. Results may be unexpected."
      GOSUB SHOW.MESSAGE
   END
END
*
** Complete defaulting behavior
IF SOURCE.LIST = NULL$ THEN
   SOURCE.LIST = 0
END
*
** Make sure the destination list has a value
IF DEST.LIST = NULL$ THEN DEST.LIST = 0
*
** Make sure source list name has a value (under misc circumstances)
IF NUM(SOURCE.LIST) AND LEN(SOURCE.LIST) = 1 AND (SOURCE.LIST NE 9) THEN SOURCE.LIST.NAMED = 0
*
** Make sure destination list name has a value (under misc circumstances)
IF NUM(DEST.LIST) AND LEN(DEST.LIST)=1 AND (DEST.LIST # 9) THEN DEST.LIST.NAMED = 0
*
** Display verbose information
IF VERBOSE THEN
   PRINT '(Parsed Command)'
   PRINT 'LSELECT ':FILE.NAME:' WITH ':DICT.NAME:' IN ':SOURCE.LIST:' TO ':DEST.LIST
   PRINT
END
RETURN
!
** Get the list of values to match
***************
GET.SOURCE.SELECT.LIST:
***************
*
SOURCE.ID.LIST = NULL$
*
** Process a named list
IF SOURCE.LIST.NAMED THEN
   EXECUTE \GET-LIST \ : SOURCE.LIST CAPTURING OUTPUT
   [[NoOfItems]] = SYSTEM(11)
   IF NOT([[NoOfItems]]) THEN
      ERROR.MSG = "Error reading saved list ":SOURCE.LIST : SP1 : OUTPUT
      GOSUB SHOW.MESSAGE
      STOP
   END
   READSELECT SOURCE.ID.LIST ELSE SOURCE.ID.LIST = NULL$
END ELSE
   READSELECT SOURCE.ID.LIST FROM SOURCE.LIST ELSE SOURCE.ID.LIST = NULL$
END
*
** Display verbose information
IF VERBOSE THEN
   PRINT '(Selected List)'
   PRINT 'List Source ':SOURCE.LIST:' found ':DCOUNT(SOURCE.ID.LIST, @AM):' items.'
   PRINT
END
RETURN
!
** Create temporary file to support TRANS selection
***************
CREATE.TEMP.FILE:
***************
*
** determine appropriate file size based on size of list of values to match
TBYTES   = SUM(LENS(SOURCE.ID.LIST))
TEMP.MOD = INT(TBYTES/1024)
IF TEMP.MOD < 1 THEN
   TEMP.MOD = 5
END
PROCESS.NBR = @UDTNO + 0
PROCESS.ID  = ('0000' : PROCESS.NBR : @LEVEL) "R#4"
TEMP.NAME   = 'LSELECT' : PROCESS.ID
UDT.COMMAND = 'CREATE.FILE ' : TEMP.NAME : SP1 : TEMP.MOD
PERFORM UDT.COMMAND CAPTURING UDT.RESPONSE
*
** Now open the temporary file
OPEN '', TEMP.NAME TO TEMP.HANDLE ELSE
   ERROR.MSG = "Error opening ":TEMP.NAME:" file"
   GOSUB SHOW.MESSAGE
   STOP
END
OPEN 'DICT', TEMP.NAME TO TEMP.DICT ELSE
   ERROR.MSG = "Error opening DICT ":TEMP.NAME:" file"
   GOSUB SHOW.MESSAGE
   STOP
END
*
** Display verbose information
IF VERBOSE THEN
   PRINT "(Create Temp File)"
   PRINT TEMP.NAME:' file created with MOD = ' : TEMP.MOD
   PRINT
END
RETURN
!
** Put selection values into temp file
***************
LOAD.TEMP.FILE:
***************
*
EMPTY.STRING = ''
MORE.IDS     = 1
[[LoadCnt]]      = 0
LOOP
   REMOVE ID FROM SOURCE.ID.LIST SETTING MORE.IDS
   WRITEVU EMPTY.STRING ON TEMP.HANDLE, ID, 0
   [[LoadCnt]] += 1
WHILE MORE.IDS DO
REPEAT
*
** Reset internal udt REMOVE pointer
SOURCE.ID.LIST = SOURCE.ID.LIST
*
** Display verbose information
IF VERBOSE THEN
   PRINT "(Loaded List to Temp File) - " : [[LoadCnt]] : " items."
   PRINT
END
RETURN
*
** Create the resulting list
***************
BUILD.LIST2:
***************
*
TRANS.STMT = "TRANS('" : TEMP.NAME : "'," : DICT.NAME : ",'@ID','X')"
IF DEST.LIST.NAMED THEN
   UDT.COMMAND = 'select ':FILE.NAME:' WITH EVAL "':TRANS.STMT:'" GT "" '
   PERFORM UDT.COMMAND CAPTURING UDT.RESPONSE
   PERFORM 'SAVE.LIST ':DEST.LIST
END ELSE
   UDT.COMMAND = 'select ':FILE.NAME:' WITH EVAL "':TRANS.STMT:'" GT "" TO ':DEST.LIST
   PERFORM UDT.COMMAND CAPTURING UDT.RESPONSE
   IF NOT(VERBOSE) THEN HUSH ON
   PERFORM 'SAVE.LIST ':TEMP.NAME
   IF NOT(VERBOSE) THEN HUSH OFF
END
*
** Display verbose information
IF VERBOSE THEN
   PRINT "(Selected Result List)"
   PRINT "UDT.COMMAND = ":UDT.COMMAND
   PRINT "UDT.RESPONSE = ":UDT.RESPONSE
   PRINT "Destination ":DEST.LIST
   PRINT "Named List ":DEST.LIST.NAMED
   PRINT
END
RETURN
!
** Remove temporary key list file
***************
FINISH.UP:
***************
*
** Close and delete the temporary file
CLOSE TEMP.HANDLE
CLOSE TEMP.DICT
UDT.COMMAND = 'DELETE.FILE ':TEMP.NAME
DATA 'Y'
PERFORM UDT.COMMAND CAPTURING UDT.RESPONSE
*
** Display verbose information
IF VERBOSE THEN
   PRINT "(Delete Temp File)"
   PRINT TEMP.NAME:' file deleted...'
   PRINT
END
*
** Create a currently active select list (if no to-list defined)
IF NOT(DEST.LIST.NAMED) THEN
   PERFORM 'GET.LIST ':TEMP.NAME CAPTURING UDT.RESPONSE
   READSELECT SOURCE.ID.LIST ELSE SOURCE.ID.LIST = NULL$
   PERFORM 'DELETE.LIST ':TEMP.NAME CAPTURING UDT.RESPONSE
   FORMLIST SOURCE.ID.LIST
END
RETURN
!
** Display error messages
***************
SHOW.MESSAGE:
***************
*
PRINT ERROR.MSG
PRINT "Press <cr> To Continue":
INPUT DUMMY
RETURN
*
**----------------------------------------------------------------------**
**                                                                      **
**                      E N D   O F   P R O G R A M                     **
**                                                                      **
**----------------------------------------------------------------------**
*
***************
END.OF.PROGRAM:
***************
*
END
</pre>

A use of the program would look like:

2 Dev (0)-> SELECT MASTER WITH YREND NE "12"

4 records selected to list 0.

2 Dev (0)-> SAVE-LIST MY.LIST
Overwriting existing saved list.
4 key(s) saved to 1 record(s).
2 Dev (0)-> LSELECT ARTMASTER WITH CLIENTNO IN MY.LIST VERBOSE
(Parsed Command)
LSELECT ARTMASTER WITH CLIENTNO IN MY.LIST TO 0

(Selected List)
List Source MY.LIST found 4 items.

(Create Temp File)
LSELECT0021 file created with MOD = 5

(Loaded List to Temp File) - 4 items.

235 key(s) saved to 1 record(s).
(Selected Result List)
UDT.COMMAND = select ARTMASTER WITH EVAL "TRANS('LSELECT0021',CLIENTNO,'@ID','X')
" GT "" TO 0
UDT.RESPONSE = ■235 records selected to list 0.■■
Destination 0
Named List 0

(Delete Temp File)
LSELECT0021 file deleted...

2 Dev (0)-> SSCROLL ARTMASTER <pre>

Command => SORT  ARTMASTER                                09:11:36 Oct 18 2012
ARTMASTER... CUSTOMER NAME (LFM)............ BT MOVE-IN. PRICHG$... BAL DUE...

120*1        ROBINSON, JAMES                    05-17-07     210.00       0.00
120*2        ROBINSON, KATHRYN J                06-18-08     210.00     210.00
120*3        GARCIA, SAMANTHA L                 08-13-09     210.00    -210.00
120*4        ROBINSON, CAROL A                  03-15-95     210.00     210.00
120*5        ROBINSON, AARON L                  09-19-06     210.00     210.00
  .
  .
</pre>

I hope this is of some help.