Created On:  11 February 2011

Problem:

The Micro Focus COBOL SORT provides a status indicator capable of returning detailed and meaningful error codes.  It is useful for catching situations like running out of disk space during a SORT operation.   This Knowledge Base article provides example code showing correct usage of the SORT STATUS.

Resolution:

The SORT STATUS data item operates in much the same way as the FILE STATUS for regular COBOL I/0.  It is a two-byte field where success is indicated if the first byte is zero, but a serious error is indicated if the first byte is 9.  Also, when the first byte is 9, the second byte should be interpreted as a usage COMP-X.

You specify the SORT STATUS in the SELECT statement for the sort file, and you can check its value after each SORT operation (such as RELEASE and RETURN).

The following sample programs show correct usage of the SORT STATUS, and can serve as a template for writing SORTs with input procedure and output procedure.

First is a C program useful for filling an input file full of random characters to serve as input to the SORT.  Build this C program on UNIX with the command "make rnd", and run it with "./rnd".  Specify 70 for the record length when running this C program, since the example COBOL program expects records of 70 bytes:

------------ C program "rnd.c" -----------------------------------
/*  Builds a hypothetical data file full of random characters, for use
    in testing COBOL.  Asks for record length and number of records.  */

#include

double drand48();

main()
{
        int rn, f, rec_len, num_rec;
        FILE *out_file;

        if ( ( out_file=fopen("data", "w") ) == NULL )
        {
                printf("file open error\n");
                return;
        }
        printf("Record length? "); scanf("%d",&rec_len);
        printf("Number of records? "); scanf("%d",&num_rec);
        f=0;
        while (f<>
        {
                rn=drand48()*43;
                rn=rn+48;
                if (rn>57 && rn<65) continue;
                fputc(rn, out_file);
                f++;
        }
}


---------- COBOL program "srt.cbl" --------------------------
000001  select r assign to "data".
000002  select s-r assign to "srdata"
000003      sort status is sort-status.
000004  select o assign to "data.out"
000005      organization line sequential.
000006  data division.
000007  file section.
000008  fd r.
000009  01 r-rec pic x(70).
000010  fd o.
000011  01 o-rec pic x(70).
000012  sd s-r.
000013  01 s-r-rec pic x(70).
000014  working-storage section.
000015  01 done-char pic x value "n".
000016      88 done value "y".
000017  01 sort-status.
000018      05 status-key-1 pic x.
000019      05 status-key-2 pic x.
000020      05 status-key-binary
000021          redefines status-key-2 pic 99 comp-x.
000022
000023  procedure division.
000024  sort s-r ascending s-r-rec
000025      input procedure sort-in
000026      output procedure sort-out
000027  stop run.
000028
000029  sort-in.
000030      open input r
000031      read r next at end
000032      display "initial read failed"
000033      stop run
000034      end-read
000035      perform until done
000036          release s-r-rec from r-rec
000037          if status-key-1 not equal 0
000038                 exhibit named status-key-1
000039                 if status-key-1 = 9
000040                     exhibit named status-key-binary
000041                 else
000042                     exhibit named status-key-2
000043                 end-if
000044                 stop run
000045          end-if
000046          read r next
000047              at end move "y" to done-char
000048          end-read.
000049      display "sort-in done".
000050
000051  sort-out.
000052      open output o.
000053      move "n" to done-char
000054      return s-r into o-rec at end
000055          move "y" to done-char
000056      end-return
000057      perform until done
000058          if status-key-1 not equal 0
000059              exhibit named status-key-1
000060              if status-key-1 = 9
000061                  exhibit named status-key-binary
000062              else
000063                  exhibit named status-key-2
000064              end-if
000065              stop run
000066          end-if
000067          write o-rec end-write
000068          return s-r into o-rec at end
000069             move "y" to done-char
000070          end-return.
Incident #2089891