Rational Developer for System z
PL/I for Windows, Version 7.6, Programming Guide

Example

Updating a REGIONAL(1) data set is illustrated in Figure 17. This program updates the data set and lists its contents. Before each new or updated record is written, the existing record in the region is tested to ensure that it is a dummy. This is necessary because a WRITE statement can overwrite an existing record in a REGIONAL(1) data set even if it is not a dummy. Similarly, during the sequential reading and printing of the contents of the data set, each record is tested and dummy records are not printed.

Figure 17. Updating a REGIONAL(1) data set
 /********************************************************************/
 /*                                                                  */
 /*  DESCRIPTION                                                     */
 /*    Update a REGIONAL(1) data set.                                */
 /*                                                                  */
 /*  USAGE                                                           */
 /*    The following commands are required to establish              */
 /*    the environment variables to run this program:                */
 /*                                                                  */
 /*      SET DD:SYSIN=ACR.INP,RECSIZE(30)                            */
 /*      SET DD:NOS=NOS.DAT,APPEND(Y)                                */
 /*                                                                  */
 /*    Note: This sample program is using the regional data set,     */
 /*          NOS.DAT, created by the previous sample program CRR1.   */
 /*                                                                  */
 /********************************************************************/

  ACR1: proc options(main);

    dcl Nos file record  keyed env(regional(1));
    dcl  Sysin file input record;
    dcl Sysin_Eof bit (1) init('0'b);
    dcl   Nos_Eof bit (1) init('0'b);
    dcl 1   In_Area,
          2   Name   char(20),
          2   (CNewNo,COldNo)  char( 2),
          2   In_Area_1 char( 1),
          2   Code   char( 1);
    dcl IoField char(20);
    dcl Byte    char(1) def IoField;
    dcl NewNo fixed(15);
    dcl OldNo fixed(15);

    on endfile (Sysin) Sysin_Eof = '1'b;
    open file (Nos) direct update;
    read file(Sysin) into(In_Area);
    do while(¬Sysin_Eof);
       if CNewNo ¬='  ' then
          NewNo = CNewNo;
       else
          NewNo = 0;
       if COldNo ¬='  ' then
          OldNo = COldNo;
       else
          OldNo = 0;
       select(Code);
          when('A','C')
          do;
            if Code = 'C' then
               delete file(Nos) key(OldNo);
            read file(Nos) key(NewNo) into(IoField);
              /*  we must test to see if the record exists  */
              /* if it doesn't exist we create a record there  */
            if unspec(Byte) = (8)'1'b then
               write file(Nos) keyfrom(NewNo) from(Name);
            else put file(sysprint) skip list ('duplicate:',Name);
          end;
          when('D') delete file(Nos) key(OldNo);
          otherwise put file(sysprint) skip list ('invalid code:',Name);
       end;
       read file(Sysin) into(In_Area);
    close file(Sysin),file(Nos);
    put file(sysprint) page;
    open file(Nos) sequential input;
    on endfile (Nos) nos_Eof = '1'b;
    read file(Nos) into(IoField) keyto(CNewNo);
    do while(¬Nos_Eof);
       if unspec(Byte) ¬= (8)'1'b then
           put file(sysprint) skip
               edit (CNewNo,' ',IoField)(a(2),a(1),a);
       read file(Nos) into(IoField) keyto(CNewNo);
    end;
   close file(Nos);
   end ACR1;

    end;
At execution time, the input file, ACR.INP, could look like this:

NEWMAN,M.W.         5640 C
GOODFELLOW,D.T.     89   A
MILES,R.              23 D
HARVEY,C.D.W.       29   A
BARTLETT,S.G.       13   A
CORY,G.               36 D
READ,K.M.           01   A
PITT,W.H.             55 X
ROLF,D.F.             14 D
ELLIOTT,D.          4285 C
HASTINGS,G.M.         31 D
BRAMLEY,O.H.        4928 C

Terms of use | Feedback

This information center is powered by Eclipse technology. (http://www.eclipse.org)