UPD:PROC  OPTIONS(MAIN);
   DCL  1 RECORD BASED(RECORD_PTR), /* Record being updated */
           2 TEXT CHAR(72),  /* its text */
           2 NUMBER CHAR(8), /* and number */
         NUMBER CHAR(8), /* Record number  */
         COMMAND CHAR(120) VAR, /* Command text */
         COMMAND_KEY_WORD CHAR (4), /* and its keyword */
         LABEL_LIST (5) LABEL INIT(LIST,REPL,HELP,LEFT,RGHT),
         KEY_WORDS CHAR(24) INIT('LIST|REPL|HELP|LEFT|RGHT'),
         T1 BIN FIXED(15), /* work variable */
         PIC PIC'99',      /* work variable */
         WCHAR CHAR (72) VAR,  /* work character string */
         WORKFILE FILE RECORD UPDATE SEQL; /* work file */
    DCL REQUEST_NUMBER CHAR(13) INIT('RECORD NUMBER?'),
         REQUEST_COMMAND CHAR(19) INIT('COMMAND?(OR HELP)');
  /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
    ON ENDFILE(WORKFILE) BEGIN;
         DISPLAY('RECORD NOT FOUND');
         CLOSE FILE(WORKFILE);
         GO TO WORK_BEGIN;
    END;
    ON ERROR BEGIN;
         DISPLAY('ERROR WHEN EXECUTING THE COMMAND');
    END;
  /******************  SEARCH FOR NEEDED RECORD  *********************/
  WORK_BEGIN:
         DISPLAY(REQUEST_NUMBER) REPLY (NUMBER);
         IF NUMBER=(8)' ' THEN GO TO END_WORK; /* Empty string: 
                                                 -- end of job */
         OPEN FILE(WORKFILE) TITLE('IEFRDER');
         READ FILE(WORKFILE) SET(RECORD_PTR);
         DO WHILE(RECORD.NUMBER~=NUMBER);
               READ FILE(WORKFILE) SET (RECORD_PTR);
         END;
  /***********************  HANDLING THE RECORD  *********************/
  RECORD_BEGIN:
         DISPLAY(REQUEST_COMMAND) REPLY (COMMAND);
         IF COMMAND='' THEN GOTO END_RECORD;
         COMMAND_KEY_WORD = SUBSTR(COMMAND,1,4); /*Keyword --
                                        first 4 chars of the command */
         T1=INDEX(KEY_WORDS,COMMAND_KEY_WORD);
           IF T1=0 THEN GOTO ERROR1; /* Invalid keyword */
         GO TO LABEL_LIST( (T1+4)/5 );
  /***********  Command  LIST  **********/
  LIST:
         DISPLAY('0'!!(8)' '!!'10'!!(8)' '!!'20'!!(8)' '!!'30'!!(8)' '
                 !!'40'!!(8)' '!!'50'!!(8)' '!!'60'!!(8)' '!!'70'!!
                 (7)' '!!'80');
         DISPLAY((8)'1234567890');
         DISPLAY(TEXT);
         GO TO RECORD_BEGIN;
  /***********  Command  REPL ***********/
  REPL:
         IF SUBSTR(COMMAND,5,1)~=':' THEN GOTO ERROR2;
         COMMAND = SUBSTR(COMMAND,6);
         T1= INDEX(COMMAND,':');
         IF T1=0 THEN GOTO ERROR2;
         PIC=SUBSTR(COMMAND,1,T1-1); /* where to replace */
         COMMAND= SUBSTR(COMMAND,T1+1);
         T1= LENGTH(COMMAND);
         SUBSTR(TEXT,PIC,T1)= COMMAND; /* Doing replacement */
         GO TO RECORD_BEGIN;
  /***********  Command  LEFT  **********/
  LEFT:
         IF SUBSTR(COMMAND,5,1)~=':' THEN GOTO ERROR2;
         PIC = SUBSTR(COMMAND,6); /* shift amount */
         WCHAR = TEXT;
         WCHAR = SUBSTR(WCHAR,PIC+1); /* Shift left by PIC pos */
         TEXT = WCHAR;
         GO TO RECORD_BEGIN;
  /***********  Command  RGHT  **********/
  RGHT:
         IF SUBSTR(COMMAND,5,1)~=':' THEN GOTO ERROR2;
         PIC = SUBSTR(COMMAND,6); /* Shift amount */
         WCHAR= (72)' ';
         SUBSTR(WCHAR,PIC+1) = SUBSTR(TEXT,1,72-PIC); /* Shift right */
         TEXT = WCHAR;
         GO TO RECORD_BEGIN;
  /***********  Command  HELP  **********/
  HELP:
         DISPLAY('DISPLAY THE CURRENT RECORD:''LIST'' ');
         DISPLAY('REPLACE A PART OF RECORD: ''REPL:<POS. NUM.>'!!
                ':<REPLACEMENT>'' ');
         DISPLAY('SHIFT LEFT BY N  ''LEFT:N'' ');
         DISPLAY('SHIFT RIGHT BY N  ''RGHT:N'' ');
         DISPLAY('FINISH RECORD UPDATE:  EMPTY STRING');
         GO TO RECORD_BEGIN;
  /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
  END_RECORD:
         REWRITE FILE(WORKFILE) FROM(RECORD); /* Updating */
         CLOSE FILE(WORKFILE);
         GO TO WORK_BEGIN;
  ERROR1:
         DISPLAY('INVALID COMMAND KEYWORD');
         GO TO RECORD_BEGIN;
  ERROR2:
         DISPLAY('INVALID COMMAND FORMAT');
         GO TO RECORD_BEGIN;
  END_WORK:
  END UPD;