LIMIT Utility
SUBROUTINE LIMIT(PARMS)
* Produces and "exploded" select list for the given selection criteria.
*
* This program is designed to be executed from TCL or called from an R/BASIC
* program. If it is called from TCL, the syntax is:
*
* LIMIT filename WITH field_name EQ values
* [ [AND] WITH field_name EQ values ]
*
* where:
*
* filename is the name of the file on which to perform the select
* field_name is a field residing in filename's dictionary
* values is one or more values (if more than one value, they must be
* separated by spaces -- quotes are optional)
* AND is an optional keyword that will force both conditions to be
* true in order for a hit to result.
*
* This program automatically uses the conversion stored in the dictionary.
* Therefore, values MUST be entered in external format.
!*****************************************************************
* If the program is called from an R/BASIC program, the syntax is as follows:
*
* DECLARE SUBROUTINE LIMIT
* LIMIT(PARMS)
* where PARMS is a @VM delimited dynamic array with the same structure as
* above except that spaces are replaced with @VMs and the first word is the
* filename.
!*****************************************************************
* The program will prompt for a key to use for the resulting list. The
* default is LIMIT*username. You may use this in subsequent GETLIST
* statements.
*
* The status line will be updated with a string with this structure:
* X/Y/Z
* where X is the number of hits actually matching the selection criteria,
* Y is the number of records read so far,
* Z is the number of records on file or in @REC.COUNT if a list is active
* when the program is called.
!*****************************************************************
* This program refines an active select list if there is one.
DECLARE SUBROUTINE PROGRESS, RTP29
DECLARE FUNCTION UNASSIGNED
STANDARD_OPERATORS = 'BETWEEN.EQ.LT.GT.LE.GE.NOT.].[.[].MATCH.FROM.TO.SUN.MON.TUE.WED.THU.FRI.SAT.TODAY.YST.TOM.NEXT.LAST'
OPEN '','LISTS' TO LISTS_FILE ELSE STOP
LISTS_ID = 'LIMIT*':@USERNAME
CALL MSG('Please enter LISTS name','R',LISTS_ID)
IF UNASSIGNED(PARMS) THEN
PARMS = ''
GOSUB PARSE_SENTENCE
END ELSE
PARMS = 'LIMIT':@VM:PARMS
GOSUB PARSE_SENTENCE
END
EXT = ''
LISTS_REC = ''
IF LEN(LISTS_ID) ELSE STOP
FINISHED = ''
IF @LIST.ACTIVE ELSE
PERFORM 'COUNT ':FILENAME:' LATENT (S)'
SELECT FILE_HANDLE
END
COUNTER = 0
ADDED = 0
PROGRESS(0,'LIMIT',HOLD)
LOOP
READNEXT @ID ELSE FINISHED = 1
UNTIL FINISHED
READ @RECORD FROM FILE_HANDLE,@ID THEN
COUNTER += 1
IF MOD(COUNTER,10) ELSE
PROGRESS(1,COUNTER:@FM:@REC.COUNT,ADDED:'/':COUNTER:'/':@REC.COUNT)
END
MASTER_VALUE = CALCULATE(FIELD_LIST<1>)
NUM_VALS = COUNT(MASTER_VALUE,@VM) + (MASTER_VALUE NE '')
FOR VALUE_NO = 1 TO NUM_VALS
ADDED_FLAG = ''
IF AND_FLAG THEN ADDED_FLAG = 1
FOR F_NO = 1 TO FIELD_NO
HIT_LIST = VALUE_LIST
THIS_FIELD = FIELD_LIST
VALUE = CALCULATE(THIS_FIELD)
THIS_VAL = VALUE<1,VALUE_NO>
IF LEN(THIS_VAL) THEN
LOCATE THIS_VAL IN HIT_LIST SETTING LOCATION THEN
*GOSUB UPDATE_LISTS
IF AND_FLAG THEN
ADDED_FLAG = ADDED_FLAG AND 1
END ELSE
ADDED_FLAG = 1
END
END ELSE
IF AND_FLAG THEN ADDED_FLAG = ''
END
END ELSE
IF AND_FLAG THEN ADDED_FLAG = ''
END
NEXT
IF ADDED_FLAG THEN GOSUB UPDATE_LISTS
NEXT
END
REPEAT
PROGRESS(3,'',HOLD)
GOSUB WRITE_LISTS
STOP
UPDATE_LISTS:
LISTS_REC := @ID:@VM:VALUE_NO:@FM
ADDED += 1
IF LEN(LISTS_REC) GT 30000 THEN
GOSUB WRITE_LISTS
END
RETURN
WRITE_LISTS:
IF EXT THEN
WRITE LISTS_REC ON LISTS_FILE,LISTS_ID:'*':EXT
EXT += 1
END ELSE
WRITE LISTS_REC ON LISTS_FILE,LISTS_ID
EXT = 2
END
LISTS_REC = ''
RETURN
PARSE_SENTENCE:
AND_FLAG = ''
FIELD_LIST = ''
CONV_LIST = ''
VALUE_LIST = ''
IF LEN(PARMS) ELSE
COMMAND = @SENTENCE
GOSUB ADD_SPACES_AROUND_OPERATORS
RTP29(COMMAND,PARMS,0)
* Replace command stack entry with parsed command.
STACK_LINE = PARMS
CONVERT @RM TO ' ' IN STACK_LINE
IF @SENTENCE = @TCL.STACK<1> THEN @TCL.STACK<1> = STACK_LINE
CONVERT @RM TO @VM IN PARMS
END
FILENAME = PARMS<1,2>
OPEN FILENAME TO FILE_HANDLE ELSE
CALL FSMSG()
STOP
END
OPEN 'DICT',FILENAME TO @DICT ELSE
CALL FSMSG()
STOP
END
FIELD_NO = 0
FINISHED = ''
PARMS = FIELD(PARMS,@VM,3,999)
POSITION = 0
EQU KEYWORD$ TO 1
EQU FIELD_NAME$ TO 2
EQU OPERATOR$ TO 3
EQU VALUE$ TO 4
EXPECTED = KEYWORD$
LOOP
REMOVE ELEMENT FROM PARMS AT POSITION SETTING DELIM
IF LEN(ELEMENT) THEN
BEGIN CASE
CASE EXPECTED = KEYWORD$
GOSUB KEYWORD
CASE EXPECTED = FIELD_NAME$
IF ELEMENT = 'OR' ELSE
READ DICT_REC FROM @DICT,ELEMENT THEN
FIELD_NO += 1
FIELD_LIST = ELEMENT
CONV_LIST = DICT_REC<7>
END ELSE
CALL FSMSG()
STOP
END
EXPECTED = OPERATOR$
END
CASE EXPECTED = OPERATOR$
EXPECTED = VALUE$
IF ELEMENT = 'EQ' ELSE
CALL MSG('ONLY "EQ" OPERATOR SUPPORTED SO FAR|':ELEMENT:' USED')
END
CASE EXPECTED = VALUE$
BEGIN CASE
CASE ELEMENT = 'AND'
AND_FLAG = 1
CASE ELEMENT = 'WITH'
EXPECTED = KEYWORD$
GOSUB KEYWORD
CASE 1
IF ELEMENT[1,1] = '"' OR ELEMENT[1,1] = "'" THEN
ELEMENT = ELEMENT[2,ELEMENT[1,1]]
END
THIS_CONVERSION = CONV_LIST
IF THIS_CONVERSION THEN ELEMENT = ICONV(ELEMENT,THIS_CONVERSION)
VALUE_LIST = ELEMENT
END CASE
END CASE
END
UNTIL NOT(DELIM)
REPEAT
RETURN
ADD_SPACES_AROUND_OPERATORS:
OPERATOR_LIST = '=':@vm:'<':@vm:'>':@vm:'<=':@vm:'=<':@vm:'>=':@vm:'=>':@vm:'#'
REPLACE_LIST = ' EQ ':@vm:' GT ':@vm:' LE ':@vm:' LE ':@vm:' GE ':@vm:' GE ':@vm:' NOT '
NUM_OPERATORS = COUNT(OPERATOR_LIST,@VM) + 1
FOR OPERATOR_NO = 1 TO NUM_OPERATORS
SWAP OPERATOR_LIST<1,OPERATOR_NO> WITH REPLACE_LIST<1,OPERATOR_NO> IN COMMAND
NEXT
RETURN
KEYWORD:
EXPECTED = FIELD_NAME$
RETURN