********************************************************************************
*
*	Support of subroutine '!SUBSTRINGSH'
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	10/14/98 23801 SAP Change copyrights. 
*	05/15/97 20626 RJE Integrate subroutine into universe
*******************************************************************************

SUBROUTINE SUBSTRINGSH(RSLT,STG,FRM,LGTH) 
************************************************************************* 
* Given DynArr of Strings, FromPos, Length, return DynArr of substrings
*   for use by UniVerse Retrieve Processor
* Copyright (c) 1996 by DataWorks Corporation, "ALL RIGHTS RESERVED" 
* REV: 09/19/96 MDB
*
RSLT=''
* Get 1st token from each of: string, from and length 
GOSUB FIRSTS
GOSUB FIRSTF
GOSUB FIRSTL
EXIT.FLAG=0
LOOP UNTIL EXIT.FLAG DO
  IF NOT(NUM(FRM.SEG)) THEN FRM.SEG=0
  IF NOT(NUM(LGTH.SEG)) THEN LGTH.SEG=0 
  RSLT=RSLT:STG.SEG[FRM.SEG,LGTH.SEG]
!IF INDEX(@LOGNAME,'mikeb',1) THEN  PRINT "+++":STG.SEG:"[":FRM.SEG:",":LGTH.SEG:"]=":STG.SEG[FRM.SEG,LGTH.SEG]:"<"
  IF STG.DLM < 3 THEN EXIT.FLAG=1 ELSE
    RSLT=RSLT:CHAR(256 - STG.DLM)
    GOSUB NEXTS
    GOSUB NEXTF
    GOSUB NEXTL
  END
REPEAT
RETURN
     
FIRSTS:
   REMOVE STG.SEG FROM STG SETTING STG.DLM 
   PR.STG.DLM=0; * Prior delim is EOS
   RETURN
     
FIRSTF:
   REMOVE FRM.SEG FROM FRM SETTING FRM.DLM
   IF FRM.DLM < 3 THEN PR.FRM.DLM=0 ELSE PR.FRM.DLM=STG.DLM 
   RETURN
     
FIRSTL:
   REMOVE LGTH.SEG FROM LGTH SETTING LGTH.DLM
   IF LGTH.DLM < 3 THEN PR.LGTH.DLM=0 ELSE PR.LGTH.DLM=STG.DLM 
   RETURN
     
NEXTS:
   PR.STG.DLM=STG.DLM
   REMOVE STG.SEG FROM STG SETTING STG.DLM 
   RETURN
     
NEXTF:
   IF FRM.DLM < PR.STG.DLM THEN RETURN
   LOOP
     PR.FRM.DLM=FRM.DLM
     REMOVE FRM.SEG FROM FRM SETTING FRM.DLM
   UNTIL PR.FRM.DLM <= PR.STG.DLM DO REPEAT 
   RETURN
     
NEXTL:
   IF LGTH.DLM < PR.STG.DLM THEN RETURN 
   LOOP
     PR.LGTH.DLM=LGTH.DLM
     REMOVE LGTH.SEG FROM LGTH SETTING LGTH.DLM
   UNTIL PR.LGTH.DLM <= PR.STG.DLM DO REPEAT 
   RETURN
     
END