LOP: PROCEDURE (TEXT_STRING, DELIMITER_LIST, DELIMITER_FOUND)
         RETURNS (CHAR (*) VARYING);

 /* LOP (TEXT_STRING, DELIMITER_LIST, DELIMITER_FOUND) RETURNS THE
    FIRST TOKEN FOUND IN TEXT_STRING, PLACES THE DELIMITING CHARACTER
    IN DELIMITER_FOUND, AND MODIFIES TEXT_STRING BY LOPPING OFF BOTH
    THE TOKEN AND THE DELIMITER. 
    AUTHOR:  MIKE RHOADS
    DATE:    2/9/82           */

   DCL (TEXT_STRING, DELIMITER_LIST, DELIMITER_FOUND) CHAR(*) VARYING;
   DCL (I, POSITION, TEMP_POS) FIXED BIN(31);
   DCL FIRST_CHARACTER CHAR(1);
   DCL TOKEN_POINTER PTR;
   DCL TOKEN CHAR (LENGTH(TEXT_STRING)) VARYING BASED (TOKEN_POINTER);

   ALLOCATE TOKEN;

   /*** DELETE LEADING BLANKS IF BLANK IS DELIMITER ***/
   IF INDEX (DELIMITER_LIST, ' ') > 0 
      THEN TEXT_STRING = LTRIM (TEXT_STRING);

   /*** LOCATE LEFTMOST DELIMITER CHARACTER IN TEXT_STRING ***/
   POSITION = 0;
   DO I = 1 TO LENGTH (DELIMITER_LIST);
      TEMP_POS = INDEX (TEXT_STRING, SUBSTR(DELIMITER_LIST, I, 1));
      IF POSITION > 0 & TEMP_POS > 0 
         THEN POSITION = MIN (POSITION, TEMP_POS);
      ELSE
         POSITION = MAX (POSITION, TEMP_POS);
   END;

   /*** ASSIGN PROPER VALUES TO DELIMITER_FOUND AND TOKEN, THEN CHOP OFF
         TEXT_STRING ***/
   IF POSITION = 0 THEN DO;   /*** NO DELIMITERS FOUND ***/
      TOKEN = TEXT_STRING;
      DELIMITER_FOUND = '';
      TEXT_STRING = '';
      END;
   ELSE DO;
      TOKEN = SUBSTR (TEXT_STRING, 1, POSITION - 1);
      DELIMITER_FOUND = SUBSTR (TEXT_STRING, POSITION, 1);
      IF POSITION = LENGTH (TEXT_STRING) THEN TEXT_STRING = '';
      ELSE TEXT_STRING = SUBSTR (TEXT_STRING, POSITION + 1);

      /*** SPECIAL TREATMENT IF BLANK IS AN ALLOWABLE DELIMITER ***/
      IF INDEX (DELIMITER_LIST, ' ') > 0 THEN DO;
         TEXT_STRING = LTRIM (TEXT_STRING);
         IF TEXT_STRING ^= '' THEN DO;
            FIRST_CHARACTER = SUBSTR (TEXT_STRING, 1, 1);
            
            IF DELIMITER_FOUND = ' ' 
            & INDEX (DELIMITER_LIST, FIRST_CHARACTER) > 0 THEN DO;
               DELIMITER_FOUND = FIRST_CHARACTER;
               IF LENGTH (TEXT_STRING) = 1 THEN TEXT_STRING = '';
               ELSE TEXT_STRING = SUBSTR (TEXT_STRING, 2);
               TEXT_STRING = LTRIM (TEXT_STRING);
               END;
            END;
         END;
      END;
   RETURN (TOKEN);


 LTRIM:  PROCEDURE (OLD_STRING) RETURNS (CHAR (*) VARYING);
   DCL OLD_STRING CHAR (*) VARYING;
   DCL NEWPTR PTR;
   DCL NEW_STRING CHAR (LENGTH (OLD_STRING)) VARYING BASED (NEWPTR);
   ALLOCATE NEW_STRING;
   DCL FIRST_NONBLANK FIXED BIN(31);
   FIRST_NONBLANK = VERIFY (OLD_STRING, ' ');
   IF FIRST_NONBLANK = 0 THEN NEW_STRING = '';
   ELSE NEW_STRING = SUBSTR(OLD_STRING, FIRST_NONBLANK);
   RETURN (NEW_STRING);
 END LTRIM;

 END LOP;