*DECK S$KEY 
PROC S$KEY(NPARMS, BYTEPOS, BITPOS, NBYTES, NBITS,TTYPE, COLSEQ, ORDER);
#**       S$KEY -  COLLECT SPECIFICATIONS OF A KEY FIELD               #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#         CALL SKMEY(BYTEPOS,BITPOS,NBYTES,NBITS,TYPE,COLSEQ,ORDER)    #
#           (THIS CALLS THE MACHINE-DEPENDENT ROUTINE *SMKEY* WHICH    #
#            COUNTS PARAMETERS AND CALLS S$KEY.)                       #
#                                                                      #
#     GIVEN-                                                           #
#         NPARMS = NUMBER OF PARAMETERS ORIGINALLY SUPPLIED.           #
#         BYTEPOS = NUMBER OF THE LEFT-MOST BYTE IN THE KEY FIELD.     #
#           (THE LEFT-MOST BYTE IS BYTE 1.)                            #
#         BITPOS = NUMBER OF THE LEFT-MOST BIT IN THE BYTE SPECIFIED   #
#          BY *BYTEPOS*.  (THE LEFT-MOST BIT OF A BYTE IS NUMBER 1.)   #
#         NBYTES = NUMBER OF BYTES IN THE FIELD, NOT COUNTING BITS     #
#          SPECIFIED BY *NBITS*.                                       #
#         NBITS = NUMBER OF BITS IN THE FIELD, NOT COUNTING BYTES      #
#          SPECIFIED BY *NBYTES*.                                      #
#         TYPE = HOW TO EXTRACT A SORT ORDER FROM THE FIELD.           #
#             "DISPLAY"      CHARACTERS WITH *DISPLAY* SEQUENCE        #
#             "FLOAT"        FLOATING POINT NUMBERS                    #
#             "INTEGER"      SIGNED BINARY INTEGERS                    #
#             "LOGICAL"      UNSIGNED BINARY INTEGERS (DEFAULT)        #
#             "LEADING"      CHARACTERS AS NUMBER WITH LEADING SIGN    #
#             "TRAILING"     CHARACTERS AS NUMBER WITH TRAILING SIGN   #
#             "SEPARATE"     CHARACTERS AS A NUMBER WITH THE SIGN      #
#                             SPECIFIED AS A SEPARATE + OR -           #
#             (PARAMETER MAY BE FILLED WITH BLANKS OR ZEROS)           #
#         COLSEQ = NAME OF COLLATING SEQUENCE FOR NONNUMERIC CHARACTERS#
#             "ASCII6"       6-BIT ASCII COLLATING SEQUENCE            #
#             "COBOL6"       6-BIT COBOL COLLATING SEQUENCE            #
#             "DISPLAY"      INTERNAL DISPLAY COLLATING SEQUENCE       #
#             "INTBCD"       INTERNAL BCD COLLATING SEQUENCE           #
#         <NAME>             NAME SPECIFIED IN CALL TO *SMSEQ*         #
#         ORDER = SEQUENCING ORDER FOR SORT PROCESSING.                #
#             "A"            ASCENDING  (DEFAULT)                      #
#             "D"            DESCENDING                                #
#                                                                      #
#     DOES-                                                            #
#         IF SMKEY WAS NOT CALLED IN THE PROPER ORDER,                 #
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#         IF LESS THAN 4 OR MORE THAN 7 ORIGINAL PARAMETERS WERE GIVEN,#
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
#         IF SPECIFIED KEYWORDS ARE ILLEGAL,                           #
#             ISSUE A DIAGNOSTIC, AND                                  #
#             ASSUME A REASONABLE DEFAULT.                             #
#         IF THE *TYPE* PARAMETER WAS OMITTED,                         #
#             ASSUME "LOGICAL".                                        #
#         IF THE *COLSEQ* PARAMETER WAS OMITTED,                       #
#             ASSUME "ASCII6" OR "COBOL6" DEPENDING ON WHETHER THE     #
#              INSTALLATION DEFAULT IS "ASCII".                        #
#         IF THE *ORDER* PARAMETER WAS OMITTED,                        #
#             ASSUME "A".                                              #
  
  
          BEGIN 
*CALL NPARMS
          ITEM  BYTEPOS      I; 
          ITEM  BITPOS       I; 
          ITEM  NBYTES       I; 
          ITEM  NBITS        I; 
          ITEM  TTYPE        C(10); 
          ITEM  COLSEQ       C(10); 
          ITEM  ORDER        C(1);
  
          XREF
              BEGIN 
              PROC  S$BFILL;           # BLANK FILL PARAMETER          #
              PROC  S$ERROR;           # HANDLE A USER ERROR           #
              FUNC  S$INSEQ  B;        # TRUE IFF CALLED IN ORDER      #
              FUNC  S$NEWGR  I;        # NEW GROUP NUMBER              #
              PROC  S$SVREL;           # SAVE PARAM FROM RELOCATABLE   #
              END 
  
*CALL A 
  
*CALL E$
  
*CALL KT$ 
  
*CALL RP$ 
  
*CALL STRING$ 
*CALL SQ$ 
  
          ITEM  GROUP        I; 
          ITEM  I            I; 
          ITEM  TYPE         C(10); 
          DEF  NTYPES  #10#;
          ARRAY  [1:NTYPES] P(2); 
              BEGIN 
              ITEM  TYPEVAL      C(0, 0,10) = 
                                       [ "DISPLAY   " 
                                       , "FLOAT     " 
                                       , "INTEGER   " 
                                       , "LOGICAL   " 
                                       , "NUMERIC_FS" 
                                       , "NUMERIC_NS" 
                                       , "NUMERIC_LO" 
                                       , "NUMERIC_LS" 
                                       , "NUMERIC_TO" 
                                       , "NUMERIC_TS" 
                                       ]; 
              ITEM  TYPEOPT       I(1,56, 4) =
                                       [  KT$T"DISPLAY" 
                                       ,  KT$T"FLOAT" 
                                       ,  KT$T"INTEGER" 
                                       ,  KT$T"LOGICAL" 
                                       ,  KT$T"NUMERICFS" 
                                       ,  KT$T"NUMERICNS" 
                                       ,  KT$T"NUMERICLO" 
                                       ,  KT$T"NUMERICLS" 
                                       ,  KT$T"NUMERICTO" 
                                       ,  KT$T"NUMERICTS" 
                                       ]; 
              END 
  
CONTROL DISJOINT; 
  
CONTROL INERT;
  
CONTROL EJECT;
  
#     IF CALLED IN THE WRONG ORDER,                                    #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NOT S$INSEQ(SQ$"SMKEY")  THEN
              BEGIN 
              S$ERROR(E$110);          # CALL OUT OF SEQUENCE          #
#***#         RETURN; 
              END 
  
#     IF EXACTLY 4 TO 7 PARAMETERS WERE NOT ORIGINALLY SUPPLIED,       #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF NPARMS LS 4
           OR NPARMS GR 7  THEN 
              BEGIN 
              S$ERROR(E$108);          # TOO FEW/MANY PARAMETERS       #
#***#         RETURN; 
              END 
  
#         IF BYTEPOS IS LESS THAN OR EQUAL TO 0,                       #
#             ISSUE A DIAGNOSTIC, AND                                  #
#             RETURN.                                                  #
  
          IF BYTEPOS LQ 0  THEN 
              BEGIN 
              S$ERROR(E$107);          # ILLEGAL PARAMETER VALUE       #
#***#         RETURN; 
              END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYBYTEPOS",                                     #
#         GROUP = <NEW-GROUP>,                                         #
#         VALUE = BYTEPOS.                                             #
  
          RP$TYPE = RP$T"KEYBYTEPOS"; 
          GROUP = S$NEWGR;             # GET NEW GROUP NUMBER          #
          RP$GROUP = GROUP; 
          RP$VALUE = BYTEPOS; 
          S$SVREL(RP$); 
  
#     IF BITPOS IS LESS THAN OR EQUAL TO 0,                            #
#         ISSUE A DIAGNOSTIC, AND                                      #
#         RETURN.                                                      #
  
          IF BITPOS LQ 0  THEN
              BEGIN 
              S$ERROR(E$107);          # ILLEGAL PARAMETER VALUE       #
#***#         RETURN; 
              END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYBITPOS",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = BITPOS.                                              #
  
          RP$TYPE = RP$T"KEYBITPOS";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = BITPOS;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYNBYTES",                                      #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBYTES.                                              #
  
          RP$TYPE = RP$T"KEYNBYTES";
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBYTES;
          S$SVREL(RP$); 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYNBITS",                                       #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = NBITS.                                               #
  
          RP$TYPE = RP$T"KEYNBITS"; 
          RP$GROUP = GROUP;            # SAME GROUP                    #
          RP$VALUE = NBITS; 
          S$SVREL(RP$); 
  
#     IF THE *TYPE* PARAMETER WAS OMITTED,                             #
#         ASSUME RP$VALUE = KT$T"LOGICAL".                             #
  
          IF NPARMS LS 5  THEN
              RP$VALUE = KT$T"LOGICAL"; 
          ELSE
              BEGIN 
              TYPE = TTYPE; 
              S$BFILL(TYPE);
              IF TYPE EQ "TRAILING  " THEN
                  BEGIN 
                  IF NPARMS EQ 5 THEN 
                      RP$VALUE = KT$T"NUMERICTO"; 
                  ELSE
                      BEGIN 
                      IF COLSEQ EQ "SIGN      " THEN
                          RP$VALUE = KT$T"NUMERICTO"; 
                      ELSE
                      IF COLSEQ EQ "SEPARATE  " THEN
                          RP$VALUE = KT$T"NUMERICTS"; 
                      ELSE
                          BEGIN 
                          S$ERROR(E$107);   # ILLEGAL PARAMETER VALUE # 
#***#                     RETURN; 
                          END 
                      END 
                  END 
              ELSE
              IF TYPE EQ "LEADING   " THEN
                  BEGIN 
                  IF NPARMS EQ 5 THEN 
                      RP$VALUE = KT$T"NUMERICLO"; 
                  ELSE
                      BEGIN 
                      IF COLSEQ EQ "SIGN      " THEN
                          RP$VALUE = KT$T"NUMERICLO"; 
                      ELSE
                      IF COLSEQ EQ "SEPARATE  " THEN
                          RP$VALUE = KT$T"NUMERICLS"; 
                      ELSE
                          BEGIN 
                          S$ERROR(E$107);   # ILLEGAL PARAMETER VALUE # 
#***#                     RETURN; 
                          END 
                      END 
                  END 
              ELSE
              IF TYPE EQ "SEPARATE  " THEN
                  BEGIN 
                  IF NPARMS EQ 5 THEN 
                      RP$VALUE = KT$T"NUMERICLS"; 
                  ELSE
                      BEGIN 
                      IF COLSEQ EQ "LEADING   " THEN
                          RP$VALUE = KT$T"NUMERICLS"; 
                      ELSE
                      IF COLSEQ EQ "TRAILING  " THEN
                          RP$VALUE = KT$T"NUMERICTS"; 
                      ELSE
                          BEGIN 
                          S$ERROR(E$107);  # ILLEGAL PARAMETER VALUE #
#***#                     RETURN; 
                          END 
                      END 
                  END 
              ELSE
              IF TYPE EQ "SIGN      " THEN
                  BEGIN 
                  IF NPARMS EQ 5 THEN 
                      RP$VALUE = KT$T"NUMERICLO"; 
                  ELSE
                      BEGIN 
                      IF COLSEQ EQ "LEADING   " THEN
                          RP$VALUE = KT$T"NUMERICLO"; 
                      ELSE
                      IF COLSEQ EQ "TRAILING  " THEN
                          RP$VALUE = KT$T"NUMERICTO"; 
                      ELSE
                          BEGIN 
                          S$ERROR(E$107);  # ILLEGAL PARAMETER VALUE #
#***#                     RETURN; 
                          END 
                      END 
                  END 
              ELSE
            BEGIN 
              RP$VALUE = 0; 
              FOR I=1 STEP 1 UNTIL NTYPES DO
                  BEGIN 
                  IF TYPE EQ TYPEVAL[I]  THEN 
                      BEGIN 
                      RP$VALUE = TYPEOPT[I];
                      END 
                  END 
              IF RP$VALUE EQ 0 THEN 
                  BEGIN 
              STRING$LEN = 10;
              STRING$C = TYPE;
              S$ERROR(E$6,STRING$,1);  # INVALID KEYWORD DETECTED      #
#***#             RETURN; 
                  END 
              END 
            END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYTYPE",                                        #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = RP$VALUE DETERMINED ABOVE                            #
  
          RP$TYPE = RP$T"KEYTYPE";
          RP$GROUP = GROUP; 
          S$SVREL(RP$); 
  
#     IF THE *COLSEQ* PARAMETER WAS OMITTED,                           #
#         ASSUME RP$VALUEC = "ASCII6"                                  #
  
          IF NPARMS LQ 5  THEN
              RP$VALUEC = "ASCII6"; 
          ELSE
              BEGIN 
              RP$VALUEC = COLSEQ; 
              FOR I = 0 STEP 1 UNTIL 9 DO 
                  BEGIN 
                  IF C<I,1>RP$VALUEC EQ 0 THEN
                      C<I,1>RP$VALUEC = " ";
                  END 
  
              # NOW WE NEED TO ENSURE THAT THE CALL WITH ONLY 6        #
              # PARAMETERS WILL WORK PROPERLY - I.E.                   #
              #     CALL SMKEY(N,N,N,N,'LOGICAL','D')                  #
              # IN THIS CASE THE SIXTH PARAMETER IS NOT COLSEQ         #
              # BUT THE KEY ORDER      #
              IF COLSEQ EQ "A" OR COLSEQ EQ "D" THEN
                  BEGIN 
                  IF COLSEQ EQ "D" THEN 
                      # ONLY SAVE KEYORDER IF IT IS DESCENDING         #
                      BEGIN 
                      RP$VALUE = 0; 
                      RP$TYPE = RP$T"KEYORDER"; 
                      RP$GROUP = GROUP; 
                      S$SVREL(RP$); 
                      END 
#***#             RETURN;  # INHIBIT FURTHER PROCESSING                #
                  END;  # IF COLSEQ IS REALLY KEYORDER                 #
              END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYCOLSEQ",                                      #
#         VALUE = RP$VALUE  DETERMINE ABOVE                            #
  
          RP$TYPE = RP$T"KEYCOLSEQ";
          RP$GROUP = GROUP; 
          S$SVREL(RP$); 
  
#     IF THE *ORDER* PARAMETER WAS OMITTED,                            #
#         ASSUME RP$VALUE = 1,                                         #
  
          IF NPARMS LS 7  THEN
              RP$VALUE = 1;            # ASCENDING                     #
          ELSE
              BEGIN 
              IF C<0,1>ORDER EQ "A" THEN
                  RP$VALUE = 1; 
              ELSE
                  RP$VALUE = 0; 
              END 
  
#     SAVE RAW PARAMETER OF-                                           #
#         TYPE = RP$T"KEYORDER",                                       #
#         GROUP = <SAME-GROUP>,                                        #
#         VALUE = RP$VALUE  DETERMINED ABOVE                           #
  
          RP$TYPE = RP$T"KEYORDER"; 
          RP$GROUP = GROUP; 
          IF RP$VALUE EQ 0 THEN S$SVREL(RP$); 
  
          END  # S$KEY #
          TERM
