Copyright (c) Digital Equipment Corporation 1988. All rights reserved
LAYERED PRODUCT or COMPONENT: PLI V3.1     OP/SYS: VMS V5.0

SOURCE:     Digital Customer Support Center



OVERVIEW:

This program demonstrates how to do a record SORT from PLI.


CAUTION:  This sample program has been tested using:
          PRODUCT: PLI V3.1 on OPERATING SYSTEM: VMS V5.0

However, we cannot guarantee its effectiveness because of the
possibility of errors in transmitting or implementing it.  It is meant
to be used as a template for writing your own program, and it may
require modification for use on your system.


PROGRAM SAMPLE:

SRTR:    PROCEDURE OPTIONS (MAIN);
/* This program demonstrates how to do a record SORT in PLI.  It
   sorts a file of variable length records called SRT_TST.DAT in
   ascending sequence on the first 6 bytes (text string) of a 40 byte
   (maximum length) record.  No output file is created.  The sorted
   records are displayed to the terminal. */

/* SOR$BEGIN_SORT specifies the key data types, record sizes,
                  collating sequence
   SOR$RELEASE_REC passes each record to SORT
   SOR$SORT_MERGE requests SORT to perform the sort on the records it
                  receives
   SOR$RETURN_REC requests SORT to pass a single record back.  SORT
                  returns the records in sorted order
   SOR$END_SORT   finishes the SORT */

%INCLUDE SOR$BEGIN_SORT;
%INCLUDE SOR$RELEASE_REC;
%INCLUDE SOR$SORT_MERGE;
%INCLUDE SOR$RETURN_REC;
%INCLUDE SOR$END_SORT;
%INCLUDE SOR$STAT;
%INCLUDE $STSDEF;

DECLARE SS$_ENDOFFILE GLOBALREF FIXED BINARY (31) VALUE,
        EOF BIT (1);
        EOF = '0'B;


declare DSC$K_DTYPE_T GLOBALREF fixed binary (31) value;
DECLARE DSC$K_CLASS_S GLOBALREF FIXED BINARY (31) VALUE;
DECLARE SOR$GK_RECORD GLOBALREF FIXED BINARY (7) VALUE;

DECLARE 1  KEY_BUFFER STATIC,
            2  NUMBER_OF_KEYS   FIXED BINARY (15) INIT (1),
            2  KEY_TYPE         FIXED BINARY (15) INIT (0),
            2  KEY_ORDER        FIXED BINARY (15) INIT (0),
                                /* ASCENDING */
            2  START_POS        FIXED BINARY (15) INIT (0),
            2  KEY_LENGTH       FIXED BINARY (15) INIT (6);

dcl     LONGEST_RECORD          FIXED BINARY (15) INIT (40);
dcl     KEYFIELD                FIXED BINARY (7);
dcl     RET_LEN                 FIXED BINARY (15);

DECLARE 1  RECIN,   /* REC LEN = 40 */
            3  BADGE        CHAR (06),      /* KEY TO SORT ON */
            3  FILL1        CHAR (05),
            3  NAME         CHAR (16),
            3  FILL2        CHAR (06),
            3  TEAM         CHAR (07);

DECLARE
   1  REC_BLK UNION,
        2  RD_BLK,
            3  LEN              FIXED BINARY (15),
            3  TYPE             FIXED BINARY (7) INIT (DSC$K_DTYPE_T),
            3  CLASS            FIXED BINARY (7) INIT (DSC$K_CLASS_S),
            3  ADRS             POINTER,
        2  REC_DESC             CHAR(8);

DCL FILIN FILE INPUT RECORD SEQUENTIAL;
DCL CNTR  FIXED BINARY (31) INIT(0);

KEY_TYPE = DSC$K_DTYPE_T;
STS$VALUE = SOR$BEGIN_SORT (KEY_BUFFER, LONGEST_RECORD);
IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);

OPEN FILE (FILIN) TITLE ('SRT_TST.DAT');
REC_BLK.LEN = 40;
REC_BLK.ADRS = ADDR(RECIN);

ON ENDFILE (FILIN) EOF = '1'B;

READ FILE (FILIN) INTO (RECIN);
HELP: DO WHILE (^EOF);
        CNTR = CNTR + 1;
        PUT SKIP LIST('RELEASED-->',CHAR(CNTR),RECIN.BADGE,
        '<>',RECIN.NAME);
        STS$VALUE = SOR$RELEASE_REC(ref(REC_DESC));
        IF ^STS$SUCCESS
              then do;
                 put file(sysprint) list('did not return ok');
                 SIGNAL VAXCONDITION(STS$VALUE);
              end;
        READ FILE (FILIN) INTO (RECIN);
END help;

CLOSE FILE (FILIN);
PUT SKIP LIST ('**** ALL RECORDS RELEASED **** REC CNTR = ',CNTR);
CNTR = 0;

STS$VALUE = SOR$SORT_MERGE();
IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);

STS$VALUE = SOR$RETURN_REC (ref(REC_DESC),RET_LEN);
DO WHILE (STS$VALUE ^= SS$_ENDOFFILE);
    IF STS$SUCCESS
       then do;
           cntr = cntr + 1;
           PUT SKIP LIST('RETURNED-->',CHAR(CNTR),RECIN.BADGE,
           '<>',RECIN.NAME);
       end;
       else SIGNAL VAXCONDITION(STS$VALUE);
    STS$VALUE = SOR$RETURN_REC (ref(REC_DESC),RET_LEN);
END;

STS$VALUE = SOR$END_SORT();
IF ^STS$SUCCESS THEN SIGNAL VAXCONDITION(STS$VALUE);

PUT SKIP LIST ('**** ALL RECORDS RETURNED **** REC CNTR = ',CNTR);
END;

buy online or call 1.800.AT.COMPAQ