*DECK SM5SEQN 
          PROC SM5SEQN(NAME); 
#**       SM5SEQN - SPECIFY USER-SUPPLIED COLLATING SEQUENCE NAME      #
#                                                                      #
#      CALLING SEQUENCE -                                              #
#         CALL SM5SEQN('NAME')                                         #
#                                                                      #
#      GIVEN -                                                         #
#         NAME = THE NAME OF A USER-SUPPLIED COLLATING SEQUENCE        #
#                                                                      #
#      DOES -                                                          #
#            CHECK TO MAKE SURE THAT 'NAME' IS NOT ONE OF THE PRE-     #
#            DEFINED KEYTYPE NAMES(SUCH AS 'DISPLAY', 'ASCII6',ETC)    #
#            IF SO THEN ISSUE DIAGNOSTIC AND RETURN                    #
#         CALL S$SEQX TO SET THE FLAG SIGNIFYING THAT SEQN HAS         #
#            BEEN CALLED                                               #
#         IF NO ERRORS ARE FOUND THEN SET RP$TYPE = SEQNAM AND         #
#            RP$VALUE = 'NAME'                                         #
#                                                                      #
  
          BEGIN 
  
*CALL A 
  
*CALL E$
  
*CALL RP$ 
  
*CALL STATUS$ 
  
*CALL CSTYP 
  
*CALL SQ$ 
  
#            ITEMS USED IN THE ROUTINE                                 #
  
          ITEM NAME   C(10);          # PARAM. PASSED TO THIS ROUTINE  #
          ITEM NMBLNK C(10);          # BLANK-FILLED COPY OF 'NAME'    #
#??#      ITEM MES    C(60);           # FOR DEBUG ONLY                #
          ITEM J      I;
          ITEM GROUP  I;              # RP$GROUP NUMBER SET IN S$SEQX  #
          ITEM CALLTYP S:CSTYP;       # SET TO CSTYP"SEQN" FOR S$SEQX # 
          ITEM SEQNM   C(10);         # CONTAINS CURRENT SEQNAM        #
          ITEM  ZEROCHAR     C(1);     # SIX ZERO BITS                 #
  
          XREF
              BEGIN 
              PROC S$ERROR; 
              PROC S$SVREL;           # SAVES RAW PARAMETERS           #
              PROC S$SEQX;            # KEEPS TRACK OF SM5SEQX CALLS   #
#??#          PROC S$PRTCD;           # PRINTS LINES TO FILE 'CODE'    #
              FUNC S$INSEQ   B;        # TRUE IFF SEQ. OF SM5_CALLS OK #
              END 
          $BEGIN
          MES = NAME; 
#??#      S$PRTCD(MES); 
#??#      S$PRTCD(0); 
          $END
  
CONTROL EJECT;
  
          IF NOT S$INSEQ(SQ$"SM5SEQ")   THEN
              BEGIN 
              S$ERROR(E$110);       # CALL OUT OF SEQUENCE             #
#***#         RETURN; 
              END 
  
          B<0,6>ZEROCHAR = 0; 
  
#           TEST THAT THE 'NAME' GIVEN IS SYNTACTICALLY CORRECT        #
          FOR J = 0  STEP 1 UNTIL 9  DO 
              BEGIN 
              IF C<J,1>NAME EQ " "   THEN 
#***#             GOTO BLNK;
              IF C<J,1>NAME EQ ZEROCHAR THEN
                  BEGIN 
                  C<J,1>NAME = " "; 
#***#             GOTO BLNK;
                  END 
  
              IF #IT'S#  NOT  #TRUE THAT# 
                  ( (C<J,1>NAME GQ "A" AND C<J,1>NAME LQ "Z")  OR 
                    (C<J,1>NAME GQ "0" AND C<J,1>NAME LQ "9")  OR 
                     C<J,1>NAME EQ "_" OR  C<J,1>NAME EQ "#"   OR 
                     C<J,1>NAME EQ "$" OR  C<J,1>NAME EQ "@" )  THEN
                  BEGIN 
                  $BEGIN
                  MES =  " SM5SEQN -   C<J,1>NAME =      "; 
                  C<25,1>MES = C<J,1>NAME;
                  S$PRTCD(MES); 
#***#             S$PRTCD(0); 
                  $END
                  S$ERROR(E$111);  # INVALID NAME GIVEN FOR SM5SEQN    #
                  STATUS$NORML = FALSE; 
#***#             RETURN; 
                  END 
              IF J EQ 0  THEN  # THIS CHARACTER IS THE FIRST OF NAME   #
#                   AND SHOULD ONLY BE A LETTER                        #
                  BEGIN 
                  IF #IT IS#  NOT  #TRUE THAT#
                        (C<0,1>NAME GQ "A" AND  C<0,1>NAME LQ "Z") THEN 
                      BEGIN 
                      $BEGIN
#***#                 MES =  " SM5SEQN WHEN J = 0 , C<0,1>NAME =  ";
                      C<234,1>MES = C<0,1>NAME; 
#***#                 S$PRTCD(MES); 
#***#                 S$PRTCD(0); 
                      $END
                      S$ERROR(E$111);  # INVALID NAME GIVEN FOR SM5SEQN#
                      STATUS$NORML = FALSE; 
#***#                 RETURN; 
                      END 
                  END 
              END 
  
#               [IF NEITHER A BLANK NOR A COLON WAS FOUND THEN,        #
#            THE 'NAME' IS 10 CHARACTERS LONG WHICH IS LEGAL OR        #
#            IT IS MORE THAN 10 CHARACTERS LONG - IF MORE, THEN        #
#            AN ERROR SHOULD BE DIAGNOSED . . . BUT WITH CURRENT       #
#            IMPLEMENTATION, CHARACTER LENGTH GREATER THAN 10          #
#            CAN NOT BE DETECTED]                                      #
  
BLNK: 
  
#            PUT 'NAME' INTO A 'NMBLNK' WHICH WILL BE A BLANK-FILLED   #
#            VERSION OF 'NAME'.                                        #
#               [NO TESTING IS DONE TO FIND OUT IF THE GIVEN NAME      #
#            HAS IMBEDDED BLANKS.  THE PARAMETER IS NOT SCANNED        #
#            PAST THE BLANK.  EXAMPLE: THE PARAMETER 'NAME ONE'        #
#            WILL BE READ AS 'NAME' AND NO WARNING IS GIVEN.]          #
  
          NMBLNK = "    ";
          C<0,J>NMBLNK = C<0,J>NAME;
  
#            TEST THAT 'NAME' IS NOT A STANDARD COL-SEQUENCE NAME      #
  
          IF NMBLNK EQ "BINARY"     OR
             NMBLNK EQ "BINARY_BIT" OR
             NMBLNK EQ "REAL"       OR
             NMBLNK EQ "INTEGER"    OR
             NMBLNK EQ "INTEGER_BI" OR
             NMBLNK EQ "NUMERIC_LO" OR
             NMBLNK EQ "NUMERIC_LS" OR
             NMBLNK EQ "NUMERIC_TO" OR
             NMBLNK EQ "NUMERIC_TS" OR
             NMBLNK EQ "NUMERIC_NS" OR
             NMBLNK EQ "NUMERIC_FS" OR
             NMBLNK EQ "PACKED"     OR
             NMBLNK EQ "PACKED_NS"  OR
             NMBLNK EQ "DISPLAY"    OR
             NMBLNK EQ "ASCII6"     OR
             NMBLNK EQ "COBOL6"     OR
             NMBLNK EQ "EBCDIC6"     THEN 
              BEGIN 
              S$ERROR(E$89);  # SEQNAME MUST NOT BE ONE OF THE         #
#                PREDEFINED KEY-TYPES                                  #
              STATUS$NORML = FALSE; 
#***#         RETURN; 
              END 
          ELSE  # SINCE SEQ NAME IS LEGAL                              #
              BEGIN 
  
              CALLTYP = CSTYP"SEQN";
              SEQNM = NMBLNK; 
              S$SEQX(CALLTYP,GROUP,0,SEQNM);  # SET FLAG WITHIN S$SEQX #
  
              RP$GROUP = GROUP;               # GROUP IS SET IN S$SEQX #
              RP$TYPE = RP$T"SEQNAM"; 
              RP$VALUEC = NMBLNK; 
              S$SVREL(RP$); 
              END 
  
          RETURN; 
          END    # OF SM5SEQN # 
          TERM
