*DECK SRT4OR5 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TOPTION 
      PROC SRT4OR5; 
      BEGIN 
  
#     P R O C   S R T 4 O R 5                                          #
#                                                                      #
#     PURPOSE                                                          #
#                                                                      #
#     INTERFACE WITH SORT5 OR CALL INTERFACE TO SORT4 (QUSORT)         #
#                                                                      #
#                                                                      #
#     ENTRY CONDITIONS                                                 #
#     SORTLOC POINTS TO TABLES BUILT DURING SYNTAX CHECKING.           #
#                                                                      #
#     EXIT CONDITION                                                   #
#                                                                      #
#     RECORDS FROM FILE HAVE BEEN SORTED AND WRITTEN TO OUTPUT         #
#     FILE.                                                            #
#                                                                      #
#     DESCRIPTION                                                      #
#                                                                      #
#     PARAMETERS FOR EACH KEY ARE EXTRACTED FROM TABLE AND             #
#     PASSED TO SORT.                                                  #
#     OWNCODE ADDRESSES ARE PASSED TO SORT.                            #
#     IF USER DEFINED COLLATING SEQUENCE, THE NAME OF THE              #
#     SEQUENCE AND THE VALUES ARE PASSED TO SORT                       #
#                                                                      #
#     EXTERNAL REFERENCES                                              #
#                                                                      #
 CONTROL IFEQ SORT5,PRESENT;
      COMMON SORTBL;
        BEGIN 
        ITEM SORTLOC      I;       # LOCATION OF TABLE BUILT BY SYNTAX #
        END 
  
      XREF PROC CLOSEM;            # CLOSE FILES                       #
      XREF PROC DIAG;              # ERROR MESSAGE WRITER              #
      XREF PROC LOADX0;            # LOAD NEW OVERLAY                  #
      XREF PROC OPENM;             # OPEN FILES                        #
      XREF PROC GET;               # CRM READ OF RECORDS               #
      XREF PROC PUT;               # CRM WRITE OF RECORDS              #
      XREF PROC REWND;             # REWIND FILES                      #
      XREF PROC SM5END;            # FORTRAN ROUTINE FOR END OF PARMS  #
      XREF PROC SM5KEY;            # FORTRAN ROUTINE FOR SORT KEY      #
      XREF PROC SM5OMRL;           # FORTRAN ROUTINE FOR RECORD LENGTH #
      XREF PROC SM5OWN1;           # FORTRAN ROUTINE FOR READ OWNCODE  #
      XREF PROC SM5OWN3;           # FORTRAN ROUTINE FOR WRITE OWNCODE #
      XREF PROC SM5OWN5;           # FORTRAN ROUTINE FOR DUPLICATES    #
      XREF PROC SM5RETA;           # FORTRAN ROUTINE FOR RETAIN        #
      XREF PROC SM5SEQN;           # FORTRAN ROUTINE FOR SEQUENCE NAME #
      XREF PROC SM5SEQS;           # FORTRAN ROUTINE FOR SEQ VALUES    #
      XREF PROC SM5SORT;           # FORTRAN ROUTINE TO START PARMS    #
      XREF PROC SM5ST;             # FORTRAN ROUTINE FOR SORT STATUS   #
  
      XREF ITEM RA0;               # TERMINATOR FOR FORTRAN CALLS      #
      XREF ITEM SORTUNIQUE    B;   # FLAG - TRUE IF UNIQUE OPTION      #
  
      BASED ARRAY BKEY; 
        BEGIN 
        ITEM SORTCHAR  C(0,0,10);  # CHARACTER DESCRIPTION             #
        ITEM SORTCOM   I;          # THE FIRST TWO WORDS IN THIS ARRAY #
                                   # CONTAIN THE INPUT AND OUTPUT FILE #
                                   # FIT ADDRESSES. THESE ARE FOLLOWED #
                                   # BY 8 WORD SETS DESCRIBING THE SORT#
                                   # KEYS.  EACH SET HAS THE FOLLOWING #
                                   # INFORMATION -                     #
                                   #   (0) - STARTING BYTE NUMBER      #
                                   #   (1) - STARTING BIT  IN BYTE     #
                                   #   (2) - KEY LENGTH                #
                                   #   (3) - NUMBER OF BITS LEFT OVER  #
                                   #   (4) - TYPE                      #
                                   #   (5) - COLLATING SEQ PRESENCE    #
                                   #          (NOT SET)                #
                                   #   (6) - ORDER (0=ASCEND,1=DESCEND)#
                                   #   (7) - SIGN OVERPUNCH (1=TRUE)   #
                                   # AFTER ALL KEY SETS IS THE WORD    #
                                   #        *END KEY*                  #
                                   # AT WORD 203 IS THE COLLATING SEQ  #
                                   # NAME AND THE NEXT WORDS CONTAIN   #
                                   # THE COLLATING SEQUENCE VALUES     #
                                   # FOLLOWING THE VALUES IS THE       #
                                   # COUNT OF THE VALUES               #
        END 
  
#     LOCAL ITEMS                                                      #
      ITEM WHERE            I;     # WHERE WE*VE BEEN 1=RETURN FROM    #
                                   # SORT,  2 = CALL CLOSE             #
                                   # 3 = RETURN FROM CLOSE             #
                                   # 4 = CALL CLEANUP                  #
      ITEM TCHAR        C(1);      # SEQUENCING CHARACTER              #
      ITEM CLASSCODE        I;     # TYPE FROM SORTCOM TABLE           #
      ITEM COUNT           I;      # COUNTER FOR COLLATING SEQUENCE    #
      ITEM DTYPE       C(10);      # TYPE PARAMETER FOR SM5KEY CALL    #
      ITEM FINIS           B;      # FINISH FLAG                       #
      ITEM HAVESEQ         B;      # TRUE IF USER COLLATING SEQUENCE   #
      ITEM I               I;      # SCRATCH                           #
      ITEM J               I;      # SCRATCH                           #
      ITEM LOOPER          I;      # SCRATCH                           #
      ITEM NSTAT           I;      # STATUS RETURNED BY SORT           #
      ITEM SORDER      C(01);      # SORT ORDER - ASCEND OR DESCEND    #
      ITEM STYPE       C(10);      # COLLATING SEQUENCE NAME           #
      ITEM TOTAL           I;      # NO. OF CHARS IN COLLATING SEQ     #
      ITEM LKEYPOS         I;      # LAST SORT KEY STARTING POSITION   #
      ITEM MINRECLEN       I;      # MINIMUM SORT RECORD LENGTH        #
  
#     DEFINED ITEMS - LOCAL                                            #
  
      DEF COBOL   #O"00000000000317021714"#;
      DEF INPUT      #0#;          # LOCATION OF INPUT FIT             #
      DEF OUTPUT     #INPUT+1#;    # LOCATION OF OUTPUT FIT            #
      DEF KEY        #OUTPUT+1#;   # START OF KEY INFORMATION          #
      DEF SEQ        #KEY+201#;    # SEQUENCE NAME                     #
      DEF SEQCNT     #SEQ+8#;      # COUNT OF SEQ VALUES               #
  
CONTROL EJECT;
  
      PROC CLEANUP; 
      BEGIN 
  
#     -----------------------------------------------------------------#
#     P R O C   C L E A N U P                                          #
#                                                                      #
#     A SMALL PROCEDURE TO USE TO EXIT FROM SORTING                    #
#     -----------------------------------------------------------------#
  
      PRIMARY = 1;
      SECONDARY = 0;
      LOADX0; 
  
      END                          # END PROC CLEANUP                  #
CONTROL EJECT;
  
      PROC OWNCOD1(RC, RECARRAY, LEN);
      BEGIN 
  
#     -----------------------------------------------------------------#
#     P R O C    O W N C O D 1                                         #
#                                                                      #
#     PURPOSE                                                          #
#                                                                      #
#     OWNCODE ROUTINE TO PROVIDE A RECORD TO SORT5                     #
#                                                                      #
#     PARAMETER                                                        #
#                                                                      #
#       RC - RETURN CODE = 0 FROM SORT5                                #
#       RECARRAY - ARRAY WHERE RECORD IS STORED                        #
#       LEN - LENGTH OF RECORD                                         #
#                                                                      #
#     ENTRY CONDITIONS                                                 #
#                                                                      #
#     PARAMETERS HAVE BEEN PASSED TO SORT5                             #
#     ADDRESS OF FIT OF INPUT FILE STORED IN TABLE BUILT               #
#     DURING SYNTAX CHECKING.                                          #
#     RECARRAY ESTABLISHED BY SORT5 AS SPACE LARGE ENOUGH              #
#     FOR LONGEST RECORD.                                              #
#                                                                      #
#     EXIT CONDITIONS                                                  #
#                                                                      #
#     RECORD READ INTO RECARRAY AND PASSED TO SORT5 BY                 #
#     SETTING RC TO 0 UNLESS END OF FILE RECOGNIZED IN WHICH           #
#     CASE RC IS SET TO 3 TO SAY TO TERMINATE SORT.                    #
#     LEN IS SET TO LENGTH OF CURRENT RECORD.                          #
#                                                                      #
#                                                                      #
#     DESCRIPTION                                                      #
#     POINTER TO FIT IS SET.                                           #
#     A CALL IS MADE TO *GET* TO READ A RECORD.                        #
#     IF CRM ERROR, DIAG IS CALLED TO WRITE MESSAGE, RC                #
#     IS SET TO 3 TO TERMINATE SORT.                                   #
#     WHEN END OF FILE IS FOUND, RC IS SET TO 3 TO TERMINATE           #
#     SORT.                                                            #
#     IF NEITHER OF THESE CONDITIONS OCCUR, RC IS SET TO 0 TO          #
#     INFORM SORT THAT THIS RECORD IS TO BE SORTED.                    #
#                                                                      #
  
#     -----------------------------------------------------------------#
  
      ITEM RC         I;           # RETURN CODE                       #
      ARRAY RECARRAY;;             # ARRAY FOR RECORD                  #
      ITEM LEN        I;           # LENGTH OF RECORD                  #
  
      ITEM IE         I;           # SCRATCH VARIABLE                  #
  
  
      P<FIT> = SORTCOM[INPUT];     # SET POINTER TO INPUT FIT          #
      FITWSA = LOC(RECARRAY);      # ADDRESS FOR RECORD STORAGE        #
  
      FOR IE = IE 
        WHILE TRUE
      DO
        BEGIN 
  
        GET(FIT, RA0);             # CALL CRM TO READ RECORD           #
  
        IF FITES NQ 0              # IF ERROR                          #
        THEN
          BEGIN 
          RC = 3;                  # TELL SORT TO TERMINATE            #
          DIAG(903,FITES,FITLFNC); # WRITE I/O ERROR MESSAGE           #
          RETURN; 
          END 
        IF FITFP EQ O"10"          # IF END OF SECTION                 #
        THEN
          BEGIN 
          TEST IE;             # JUST GO READ AGAIN                #
          END 
        IF FITFP EQ O"100"         # IF END OF FILE                    #
          OR FITFP EQ O"40"        # OR END OF PARTITION               #
        THEN
          BEGIN 
          RC = 3;                  # NO MORE RECORDS SO TERMINATE      #
          CLOSEM(FIT, $DET$, RA0); # CLOSE INPUT FILE                  #
          IF SORTCOM[INPUT] EQ SORTCOM[OUTPUT]
          THEN
            BEGIN 
            OPENM(FIT, $OUTPUT$, $R$, RA0);  # REOPEN FOR OUTPUT       #
            IF FITES NQ 0 
            THEN
              BEGIN 
              DIAG(903, FITES, FITLFNC);
              CLEANUP;
              END 
            END 
          END 
        ELSE
          BEGIN                    # GOT A RECORD                      #
          RC = 0;                  # TELL SORT TO USE IT               #
          IF FITRL LS MINRECLEN    # IF FITRL IS SHORTER THAN THE      #
          THEN                     # MINIMUM SORT RECORD LENGTH,       #
            BEGIN 
            LEN = MINRECLEN;       # SEND SORT5 THE MINIMUM REC LENGTH.#
            END 
          ELSE
            BEGIN 
            LEN = FITRL;
            END 
          END 
  
        RETURN;                    # ALL THROUGH                       #
        END 
  
      END                          # END PROC O W N C O D 1            #
CONTROL EJECT;
  
      PROC OWNCOD3(RC,RECARRAY,LEN);
      BEGIN 
  
#     -----------------------------------------------------------------#
#     P R O C   O W N C O D 3                                          #
#                                                                      #
#     PURPOSE                                                          #
#                                                                      #
#     OWNCODE ROUTINE TO ACCEPT A SORTED RECORD FROM SORT              #
#     AND WRITE IT TO OUTPUT FILE                                      #
#                                                                      #
#     ENTRY CONDITION                                                  #
#                                                                      #
#     RECARRAY IS RECORD ARRAY CONTAINING SORTED RECORD.               #
#     FIT ADDRESS IS STORED IN TABLE BUILT DURING SYNTAX               #
#     CHECKING.                                                        #
#     LEN = LENGTH OF RECORD IN CHARS.                                 #
#                                                                      #
#     EXIT CONDITIONS                                                  #
#                                                                      #
#     RC = RETURN CODE                                                 #
#           1 = SORT WILL DELETE RECORD                                #
#           3 = TERMINATE SORT                                         #
#                                                                      #
#     DESCRIPTION                                                      #
#                                                                      #
#     IF OWNCOD1 ECOUNTERED CRM ERROR, TERMINATE SORT.                 #
#     OTHERWISE, CALL CRM TO WRITE RECORD TO OUTPUT FILE.              #
#                                                                      #
#     -----------------------------------------------------------------#
  
      ITEM RC        I;            # RETURN CODE                       #
      ARRAY RECARRAY;;             # ARRAY FOR RECORD                  #
      ITEM LEN       I;            # LENGTH OF RECORD IN CHARS         #
  
      P<FIT> = SORTCOM[INPUT];
      IF FITES NQ 0                # IF OWNCOD1 ENCOUNTERED CRM ERROR  #
      THEN
        BEGIN 
        RC = 3;                    # TERMINATE SORT                    #
        END 
      ELSE
        BEGIN 
        P<FIT> = SORTCOM[OUTPUT]; 
        FITWSA = LOC(RECARRAY);    # POSITION TO SORTED RECORD         #
        FITRL = LEN;               # LENGTH OF RECORD IN CHARS         #
        PUT(FIT, RA0);             # TELL CRM TO WRITE RECORD          #
        RC = 1;                    # TELL SORT TO DELETE RECORD        #
        END 
  
      RETURN; 
      END                          # END PROC  O W N C O D 3           #
  
CONTROL EJECT;
  
      PROC OWNCOD5(RC, RECA, LENA, RECB, LENB); 
      BEGIN 
  
#     -----------------------------------------------------------------#
#     P R O C   O W N C O D 5                                          #
#                                                                      #
#     PURPOSE                                                          #
#                                                                      #
#     PROCESS RECORDS HAVING DUPLICATE KEYS WHEN THE UNIQUE            #
#     OPTION WAS CHOSEN AS PART OF QU DIRECTIVE.                       #
#                                                                      #
#     PARAMETERS                                                       #
#                                                                      #
#     RC = RETURN CODE                                                 #
#     RECA = FIRST RECORD                                              #
#     LENA = LENGTH OF FIRST RECORD                                    #
#     RECB = SECOND RECORD                                             #
#     LENB = LENGTH OF SECOND RECORD                                   #
#                                                                      #
#     ENTRY CONDITIONS                                                 #
#                                                                      #
#     RECORDS WITH EQUAL KEYS ARE STORED IN ARRAYS RECA                #
#     AND RECB.   RC = 0.                                              #
#                                                                      #
#     EXIT CONDITION                                                   #
#                                                                      #
#     RC = 0 SAYING USE BOTH RECORDS                                   #
#     RC = 1 SAYING USE FIRST RECORD ONLY.                             #
#                                                                      #
#     DESCRIPTION                                                      #
#                                                                      #
#     CHECK EQUALITY OF RECORDS TO DETERMINE WHETHER TO USE            #
#     ONLY ONE OR BOTH                                                 #
#     -----------------------------------------------------------------#
  
      ITEM RC         I;           # RETURN CODE                       #
      ARRAY RECA;                  # FIRST RECORD                      #
        BEGIN 
        ITEM WRDA    U(0,0,60); 
        END 
      ITEM LENA       I;           # LENGTH OF FIRST RECORD            #
      ARRAY RECB;                  # SECOND RECORD                     #
        BEGIN 
        ITEM WRDB  U(0,0,60); 
        END 
      ITEM LENB       I;           # LENGTH OF SECOND RECORD           #
  
                                   # LOCAL VARIABLES                   #
      ITEM INDEX    I;             # LOOP VARIABLE                     #
      ITEM LIMIT    I;             # LOOP LIMIT                        #
  
                                   # KEYS ARE DUPLICATES BUT MUST      #
                                   # SEE IF ENTIRE RECORD IS SAME      #
                                   # IF LENGTHS ARE UNEQUAL THEN       #
                                   # OBVIOUSLY THE RECORDS ARE UNEQUAL #
                                   # BUT IF LENGTHS ARE EQUAL THEN     #
                                   # EACH WORD IN THE RECORDS MUST     #
                                   # BE COMPARED.  IF ALL EQUAL THEN   #
                                   # ONLY THE FIRST RECORD WILL BE     #
                                   # RETURNED TO SORT.  IF UNEQUAL     #
                                   # BOTH RECORDS WILL BE RETURNED     #
      IF LENA NQ LENB              # TEST LENGTHS                      #
      THEN
        BEGIN 
        FINIS = TRUE; 
        END 
      ELSE                         # UNEQUAL LENGTHS                   #
        BEGIN 
        FINIS = FALSE;
        LIMIT = ((LENA + 9) / 10) - 1;  # NUMBER OF WORDS              #
  
        FOR INDEX = 0 STEP 1
          WHILE INDEX LQ LIMIT
          AND NOT FINIS 
        DO
          BEGIN 
          IF WRDA[INDEX] NQ WRDB[INDEX] 
          THEN
            BEGIN 
            FINIS = TRUE; 
            END 
          END                      # END LOOP                          #
        END                        # END LENGTHS EQUAL                 #
  
      IF FINIS                     # IF TRUE, INEQUALITY FOUND         #
      THEN
        BEGIN 
        RC = 0;                    # TELL SORT USE BOTH RECORDS        #
        END 
      ELSE                         # IF FALSE, RECORDS ARE DUPLICATES  #
        BEGIN 
        RC = 1;                    # TELL SORT TO USE FIRST RECORD     #
        END 
  
      RETURN; 
      END                          # END PROC O W N C O D 5            #
CONTROL EJECT;
  
#     -----------------------------------------------------------------#
#                                                                      #
#     S T A R T  O F   E X E C U T A B L E   C O D E   S R T 4 O R 5   #
#                                                                      #
#     -----------------------------------------------------------------#
  
                                   # THE FOLLOWING CODE IS USED ONLY   #
                                   # WHEN SORT5 WAS DEFINED AT BUILD   #
      P<BKEY> = SORTLOC;           # SET PTR TO TABLE BUILT BY SYNTAX  #
      FINIS = FALSE;               # SET LOOP CONTROL FLAG             #
      SM5SORT(0, RA0);             # START SORT SPECIFICATION          #
      HAVESEQ = FALSE;
      MINRECLEN = 0;
      LKEYPOS = 0;
      STYPE = SORTCHAR[SEQ];       # GET NAME OF COLLATING SEQ         #
      IF STYPE EQ COBOL            # ADD *6* TO FORTRAN AND COBOL      #
      THEN
        BEGIN 
        STYPE = "COBOL6"; 
        END 
      ELSE
        BEGIN 
        IF STYPE EQ "FORTRAN" 
        THEN
          BEGIN 
          STYPE = "DISPLAY";
          END 
        ELSE
          BEGIN 
          HAVESEQ = TRUE;          # FLAG USER NAMED SEQ               #
          END 
        END 
  
      FOR LOOPER = KEY STEP 8      # GET KEYS FROM TABLE AND PASS      #
        WHILE NOT FINIS            # TO SORT                           #
      DO
        BEGIN 
        IF SORTCHAR[LOOPER] EQ " END KEY  "  # IS TABLE FINISHED       #
        THEN
          BEGIN 
          FINIS = TRUE;            # STOP LOOPING                      #
          TEST LOOPER;
          END 
  
        CLASSCODE = SORTCOM[LOOPER + 4];  # SET DATA TYPE              #
        IF CLASSCODE EQ 0 
        THEN
          BEGIN 
          DTYPE = "BINARY";        # UNSIGNED BINARY SORT              #
          END 
        ELSE                       # NOT LOGICAL                       #
          BEGIN 
          IF CLASSCODE EQ 1        # INTEGER VALUE                     #
          THEN
            BEGIN 
            DTYPE = "INTEGER";
            END 
          ELSE
            BEGIN 
            IF CLASSCODE EQ 2      # FLOAT, DOUBLE,COMPLEX             #
            THEN
              BEGIN 
              DTYPE = "REAL"; 
              END 
            ELSE
              BEGIN 
              IF CLASSCODE EQ 5    # DISPLAY                           #
              THEN
                BEGIN 
                IF SORTCOM[LOOPER + 7] EQ 1  # IF OVERPUNCH            #
                THEN
                  BEGIN 
                  DTYPE = "NUMERIC_TO"; 
                  END 
                ELSE
                  BEGIN 
                  DTYPE = STYPE;  # COLLATING SEQUENCE                 #
                  END 
                END 
              END 
            END 
          END 
  
        IF SORTCOM[LOOPER + 6] EQ 0  # SET EITHER ASCEND OR DESCEND  #
        THEN
          BEGIN 
          SORDER = "A"; 
          END 
        ELSE
          BEGIN 
          SORDER = "D"; 
          END 
                                   # FIND THE KEY WHOSE POSITION IN THE#
                                   # RECORD IS THE LAST OF ALL THE SORT#
                                   # KEYS USED. THE MINIMUM SORT RECORD#
                                   # LENGTH IS THE STARTING POSITION OF#
                                   # THE LAST KEY PLUS ITS LENGTH.     #
        IF LKEYPOS LS SORTCOM[LOOPER] 
        THEN
          BEGIN 
          LKEYPOS = SORTCOM[LOOPER];
          MINRECLEN = SORTCOM[LOOPER] + SORTCOM[LOOPER + 2] - 1;
          END 
  
                                   # ALL SET UP, PASS TO SORT          #
        SM5KEY(SORTCOM[LOOPER],SORTCOM[LOOPER + 2],DTYPE,SORDER,RA0); 
        END                      # END OF KEY LOOP                   #
  
                                   # NOW TELL SORT TO RETAIN ORIGINAL  #
                                   # ORDER OF RECORDS                  #
      SM5RETA("Y"); 
  
      SM5OWN1(OWNCOD1, RA0);       # PASS OWNCODE ADDRESS FOR INPUT    #
      SM5OWN3(OWNCOD3, RA0);       # PASS OWNCODE ADDRESS FOR OUTPUT   #
  
      IF SORTUNIQUE                # IF UNIQUE OPTION CHOSEN           #
      THEN
        BEGIN 
        SM5OWN5(OWNCOD5, RA0);     # PASS OWNCODE FOR DUPLICATES       #
        END 
  
  COLSEQ: 
      IF HAVESEQ                   # IF USER DEFINED COLLATING SEQ     #
      THEN
        BEGIN 
        SM5SEQN(STYPE, RA0);       # PASS THE NAME                     #
        TOTAL = SORTCOM[SEQCNT];   # GET COUNT OF VALUES               #
        I = SEQ + 1;               # GET START OF COLLATING SEQ        #
        J = 0;
        FOR COUNT = 0 STEP 1
          WHILE COUNT LS TOTAL
        DO
          BEGIN 
          TCHAR = C<J,1>SORTCOM[I];  # UNPACK CHARACTER                #
          SM5SEQS(TCHAR, RA0);     # AND PASS IT TO SORT               #
          IF J EQ 9 
          THEN
            BEGIN 
            J = 0;
            I = I + 1;             # GET NEXT WORD IN COLLATING SEQ    #
            END 
          ELSE
            BEGIN 
            J = J + 1;
            END 
          END 
        END 
  
 ENDSEQ:  
      P<FIT> = SORTCOM[INPUT];
      SM5OMRL(FITMRL, RA0);        # SEND OVER MAX RECORD LENGTH       #
  
      OPENM(FIT, $INPUT$, $R$, RA0);  # OPEN INPUT FILE                #
      IF FITES NQ 0 
      THEN
        BEGIN 
        DIAG(903,FITES,FITLFNC);
        CLEANUP;
        END 
  
  
      IF SORTCOM[INPUT] NQ SORTCOM[OUTPUT]
      THEN
        BEGIN 
        P<FIT> = SORTCOM[OUTPUT]; 
        OPENM(FIT, $OUTPUT$, $R$, RA0);  # OPEN OUTPUT FILE            #
        IF FITES NQ 0 
        THEN
          BEGIN 
          DIAG(903,FITES,FITLFNC);
          CLEANUP;
          END 
        END 
  
      SM5ST(NSTAT, RA0);           # GET SORT STATUS                   #
      SM5END;                      # START SORT                        #
      WHERE = 1;
  
      P<FIT> = SORTCOM[OUTPUT]; 
      WHERE = 2;
      CLOSEM(FIT, $DET$, RA0);     # CLOSE OUTPUT FILE                 #
      WHERE = 3;
      IF NSTAT GR 2                # IF FATAL OR CATASTROPHIC          #
      THEN
        BEGIN 
        DIAG(422);                 # TELL USER SORT BOMBED             #
        END 
  
  
      WHERE = 4;
      CLEANUP;
  
CONTROL ENDIF;
  
CONTROL IFEQ SORT5,ABSENT;
      XREF PROC QUSORT; 
      QUSORT; 
      RETURN; 
CONTROL ENDIF;
      END                          # END PROC S R T 4 O R 5            #
  
  
TERM
  
