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.
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