----------------------------------------------------------------------

000010 IDENTIFICATION　　DIVISION.
000020 PROGRAM-ID.　　 　SELTST.
000030 ENVIRONMENT　　 　DIVISION.
000040 CONFIGURATION　　 SECTION.
000050 SOURCE-COMPUTER.　EXPRESS5800.
000060 OBJECT-COMPUTER.　EXPRESS5800.
000070 INPUT-OUTPUT　　SECTION.
000080 FILE-CONTROL.
000090　 SELECT　RDBFILE　ASSIGN　TO　RDBFILE-RDB.
000100 DATA　　　　DIVISION.
000110 FILE　　　　SECTION.
000120 FD　RDBFILE
000130　 LABEL　　RECORD　　　IS　 STANDARD
000160　 VALUE　　OF　IDENTIFICATION "RDBFILE".
000170　 COPY RDBFILE-R OF DDF.
000180 WORKING-STORAGE　　　　　　SECTION.
000210 01　WRK-REC.
000230 　　02　WRK-CCNT　　　　　　PIC　9(02).
000240 　　02　WRK-SELECT　　　　　PIC　X(05).
000250 　　02　WRK-SELECTR1 REDEFINES WRK-SELECT.
000260 　　　03　WRK-SELECT1　　　 PIC　X(01).
000270 　　　03　FILLER　　　　　　PIC　X(04).
000280 　　02　WRK-SELECTR2 REDEFINES WRK-SELECT.
000290 　　　03　WRK-SELECT2　　　 PIC　X(02).
000300 　　　03　FILLER　　　　　　PIC　X(03).
000310 　　02　WRK-SELECTR3 REDEFINES WRK-SELECT.
000320 　　　03　WRK-SELECT3　　　 PIC　X(03).
000330 　　　03　FILLER　　　　　　PIC　X(02).
000340 　　02　WRK-SELECTR4 REDEFINES WRK-SELECT.
000350 　　　03　WRK-SELECT4　　　 PIC　X(04).
000360 　　　03　FILLER　　　　　　PIC　X(01).
000670 PROCEDURE　 DIVISION.
000680 INIT-RTN.
000690　　 ACCEPT　　WRK-SELECT.
000700　　 MOVE ZERO TO WRK-CCNT.
000710　　 INSPECT WRK-SELECT TALLYING WRK-CCNT FOR CHARACTERS
000720　　　　　　　　　　　　　　　　　　　　　BEFORE " ".
000730　　 OPEN　　I-O　　　　RDBFILE.
000740　　 EVALUATE WRK-CCNT
000750　　　　 WHEN 1
000760　　　　　　　SELECT RDBFILE WHERE BPW-BUBN CHARACTERS WRK-SELECT1
000770　　　　 WHEN 2
000780　　　　　　　SELECT RDBFILE WHERE BPW-BUBN CHARACTERS WRK-SELECT2
000790　　　　 WHEN 3
000800　　　　　　　SELECT RDBFILE WHERE BPW-BUBN CHARACTERS WRK-SELECT3
000810　　　　 WHEN 4
000820　　　　　　　SELECT RDBFILE WHERE BPW-BUBN CHARACTERS WRK-SELECT4
000830　　　　 WHEN 5
001040　　　　　　　SELECT RDBFILE WHERE BPW-BUBN CHARACTERS WRK-SELECT
001050　　 END-EVALUATE.
以下略～