Here is the code:
Code: Select all
**************************************************************
WORKING-STORAGE SECTION.
**************************************************************
*
********************
* INPUT STRUCTURES *
********************
01 INPUT-RECORD.
03 I-NAME PIC X(30).
03 I-PHONE PIC X(20).
03 FILLER PIC X(30).
*********************
* OUTPUT STRUCTURES *
*********************
01 OUTPUT-RECORD.
03 O-TEXT PIC X(80).
*
*********************
* CONSTANTS *
*********************
01 SEARCH-NAME PIC X(30) VALUE 'SEARCHNAME'.
*
*********************
* CONDITIONS *
*********************
01 EOF-Q01R6001-CONDITION PIC S9(4) COMP VALUE ZERO.
88 EOF-Q01R6001 VALUE 1.
*
*********************
* ARAYS *
*********************
01 PERS-TAB.
03 PERS-ELEM OCCURS 1000.
05 PERS-NAME PIC X(30).
05 PERS-PHONE PIC X(20).
01 IND-PERS PIC S9(4) COMP VALUE ZERO.
01 MAX-PERS PIC S9(4) COMP VALUE ZERO.
01 ANZ-PERS PIC S9(4) COMP VALUE ZERO.
*
******************************************************************
1-A-HAUPTVERARB SECTION.
******************************************************************
1-A-HAUPTVERARB-ANF. .
*
*--> BUBBLE SORT OF PERS-TAB <-----------------------------------*
*
PERFORM VARYING IND-PERS FROM 1 BY 1 UNTIL
IND-PERS = ANZ-PERS
PERFORM VARYING ANZ-PERS FROM IND-PERS BY 1 UNTIL
ANZ-PERS > MAX-PERS
IF PERS-NAME (ANZ-PERS) < PERS-NAME (IND-PERS) THEN
MOVE PERS-ELEM (ANZ-PERS) TO INPUT-RECORD
MOVE PERS-ELEM (IND-PERS) TO PERS-ELEM (ANZ-PERS)
MOVE INPUT-RECORD TO PERS-ELEM (IND-PERS)
END-IF
END-PERFORM
END-PERFORM
CONTINUE.
*
1-A-HAUPTVERARB-EX.
EXIT.
/
****************************************************************
2-A-VORLAUF SECTION.
****************************************************************
2-A-VORLAUF-ANF.
*
MOVE 'P01B6000' TO SYS-HPTPROG.
MOVE 'B' TO SYS-HPTPROGART.
MOVE SPACE TO SYSERROR-BER.
MOVE ZERO TO SYS-PROTNR.
SET NO-SYSERROR TO TRUE.
*
COMPUTE MAX-PERS = LENGTH OF PERS-TAB /
LENGTH OF PERS-ELEM.
*
OPEN INPUT Q01R6001.
PERFORM UNTIL EOF-Q01R6001
READ Q01R6001 INTO INPUT-RECORD
AT END SET EOF-Q01R6001 TO TRUE
END-READ
IF NOT EOF-Q01R6001
IF ANZ-PERS LESS MAX-PERS
ADD 1 TO ANZ-PERS
MOVE INPUT-RECORD TO PERS-ELEM (ANZ-PERS)
ELSE
SET SYSERROR TO TRUE
MOVE 'A001' TO SYS-PROTPKT
MOVE 'OVERFL.INT.ARAY' TO SYS-KURZMLDG
PERFORM P86U0002
END-IF
END-IF
END-PERFORM.
CLOSE Q01R6001.
*
2-A-VORLAUF-EX.
EXIT.