- IBM主机技术一本通
- 吕新民编著
- 10265字
- 2020-08-26 22:17:26
7.2 表处理
表处理具有特别的重要性。我们将讨论与表有关的几个论题，特别是：索引、SEARCH和SET动词，变长度表和多维表。这些内容是奉献给希望完全理解，但一直没有机会完全理解表处理的专业人员的。
7.2.1 表的定义
表的建立，即空间的分配，要在数据部（Data Division）使用OCCURS短语，它的语法格式为：
如上述语法所示，OCCURS短语内有几个可选项。DEPENDING ON短语用于变长度表而且会经常使用。如果表处理时用索引或SEARCH动词，INDEXED BY短语就是必需的。如果要用折半查找，ASCENDING（或DESCENDING）KEY短语就是必需的。
下面显示的是一个银行SWIFT付款代码表定义的例子。
000052 01 PAY-CODE-TABLE-G.
000053 03 PAY-CODE-TABLE OCCURS 30 TIMES
000054 ASCENDING KEY IS PAY-CODE
000055 INDEXED BY WS-INDEX.
000056 05 PAY-CODE PIC X(02).
000057 05 FILLER PIC X(01).
000058 05 PAY-DESC PIC X(20).
000059 05 FILLER PIC X(01).
000060 05 PAY-PRIORITY PIC 9(01).
000061 *
OCCURS用来定义表或数组，这样它们的表元素就可以使用索引或下标来访问。表也可以用来代替需要重复使用的分离数据项。表或数组可以是定长表也可以是变长表，对应的OCCURS短语的格式也不相同。
OCCURS可以定义定长表。表一共可以有7层，所以上面的OCCURS短语可以有嵌套6层。integer-2指定精确的重复次数，它必须大于零。
INDEXED BY短语指定表使用的索引，如果使用索引访问表，就要使用INDEXED BY短语。使用ASCENDING或DESCENDING短语时，你的数据（关键字，DATA-NAME-1）就必须按照升序或降序排列。KEY后面的数据名（DATA-NAME-2等）是按照它们排序的顺序出现的。在上面的例子中，表必须按照PAY-CODE的升序排列。
顺序是使用操作数的比较规则决定的。在OCCURS短语中的ASCENDING和DESCENDING KEY数据项使用，用来对表元素在SEARCH ALL语句中做折半（Binary Search）查找时使用。
变长表必须使用OCCURS DEPENDING ON短语。其中：
● INTEGER-1：指定表重复的最小次数。INTEGER-1必须大于或等于零，且必须小于INTEGER-2。COBOL允许INTEGER-1为零，即表格可以不包含任何表项。
● INTEGER-2：指定表重复的最大次数。INTEGER-2必须大于INTEGER-1。
● 表项的长度是固定的，变化的只是表项重复的次数。
OCCURS短语是与数据名相关的，而该数据名中定义的数据描述也适用于其相关的所有数据项。当访问OCCURS短语的相关数据项时，必须使用索引或下标。但在下列情况下，不用使用下标或索引访问。
● 当OCCURS的数据项作为SEARCH语句的操作对象时。
● 当它们作为ASCENDING/DESCENDING KEY短语的对象时，如上例中的PAY-CODE。
● 当表的附属数据项是REDEFINES短语的操作对象时。
当对表项使用索引或下标访问时，所访问的是表中的某个元素。当没有使用下标或索引时，代表的是整个表。注意，OCCURS短语不能在下列数据项中：
● 级别号为01、66、77或88。
● 描述重定义数据项，但重定义数据项可以作为带有OCCURS短语数据项的下属。
7.2.2 下标、索引和SET索引语句
下标和索引都是用于表处理的。由于索引能生成更有效的程序代码，因此许多程序员更喜欢用它。此外，索引是SEARCH语句所必需的。SEARCH语句是表处理强有力的手段，我们将在随后的章节中加以解释。
索引（Index）是与特定的表相关的变量标识符，索引的值存放的是表中的数据项，相对于表的开始位置的位移（Displacement）。索引名可以出现在OCCURS短语中，就像我们上面的SWIFT付款代码表PAY-CODE-TABLE中定义的那样。
索引是由COBOL编译器建立的，因此你不用在程序中定义它们。索引的内容不可以使用MOVE或INITIALIZE语句赋值，如果你想给它赋值，必须使用SET语句。
索引使你可以对特定的表项目检索和操作。为了使用索引，你必须将索引与包含有OCCURS短语的数据项联系起来。索引是使用INDEXED BY短语与表项对应的，是OCCURS短语的可选项。运行时，索引的内容对应于与其相关的表的重复次数。
存放在表中的数据经常需要检索，COBOL的SEARCH语句提供了顺序检索（Serial Search）和折半检索（Binray Search）。索引用来检索满足条件的表项并调整索引的值以说明其所指向的表项。
为了运行时不违例，索引的值不能小于1，也不能大于表的最大重复次数。索引的实际值是使用下面的公式计算的：I=L×(S-1)，其中：I是索引的值，L是表项的长度，而S指定表中的第几个表项。比如，在上面的PAY-CODE-TABLE中，第5个表项对应的索引值为I=25×(5-1)即100，表明PAY-CODE-TABLE(5)相对于表的开始位置的位移是100。
下标（Subscript）是另一种访问表的方法。它是正整数，表明表项在表中出现的位置。下标最多有7层，对应于COBOL表的7层嵌套结构，即表的维数。访问表项时，下标必须用括号括起来。下标的个数必须与其要访问的表的维数一致。
用括号括起来的下标必须紧跟在要访问的表元素名字的后面。当有多个下标时，它们必须按数据组织的维数由外向内的顺序编写。如果将多维表想象成一序列的嵌套表，则最外层（包含最多）的嵌套表是主表，而最里层（包含最少）的嵌套表是辅表。嵌套中所有的下标都是从左往右按主表、中间表和辅表的顺序编写的。
下标和索引在概念上是一样的，它们都是用于访问表中的元素。但是，下标代表出现的次数，而索引代表表内的位移。考虑我们上面的SWIFT付款代码对照表PAY-CODE-TABLE，OCCURS短语建立有30个项目的表，占据总共750=（30×25）字节。对PAY-CODE-TABLE合法的下标是1、2、3、…、30，即PAY-CODE-TABLE出现30次。对PPAY-CODE-TABLE合法的位移是0、25、50、…、725。
表中的第1个元素是通过下标1或位移0访问的；第2个元素由下标2或位移25来访问的；以此类推，第30个元素是通过下标30或位移725来访问的。
实际上，COBOL程序员是不关心索引的实际值的，而是将索引当成下标，并相信编译生成的指令会计算适当的位移。这件事是由SET动词完成的，它的唯一目的就是对索引进行操作。
SET动词的语法有两种格式。
格式1：
执行第1 种格式的SET语句时，接收字段（INDEX-NAME-1 等）的当前值就会被发送字段（INDEX-NAME-3等）的值所置换。比如，对于我们的PAY-CODE-TABLE，如果使用下面的SET语句：SET WS-INDEX TO 2，表示WS-INDEX的值就指向PAY-CODE-TABLE的第2 个表项，即指向PAY-CODE-TABLE(2)。
当使用第2种格式的SET语句执行时，接收字段（INDEX-NAME-1）的值就会增加（UP BY）或减少（DOWN BY）发送字段（IDENTIFIER-1或LITERAL-1）对应的值。SET语句执行前，接收字段的值必须对应于表的出现次数。如果WS-INDEX的值现在为3，则下面的SET语句SET WS-INDEX UP BY 1执行后，WS-INDEX的值就会变成4。
接收字段是由INDEX-NAME-1指定的，它的值无论是SET语句执行前和执行后，都对应于与其相关的表的出现次数。在上面的例子中，WS-INDEX的值在SET语句执行前后分别是3 和4，即指向PAY-CODE-TABLE(3)和PAY-CODE-TABLE(4)。
发送字段是由IDENTIFIER-1指定的，它必须定义为正整数的基本数据项，而LITERAL-1必须为非零的整数。
当指定多个接收字段时，接收字段是按照它们在SET语句中出现的顺序从左到右操作的。SET语句的增加或减少值（IDENTIFIER-1或LITERAL-1）会逐个增加或减少到各个接收字段中。
7.2.3 SEARCH动词
数据一定是以编码而不是扩展的方式存储的，明显的优点是可以节省存储空间。但是，因为打印的报表必须包含扩展格式的数据，用户才能看得懂，因此数据格式的转换就是必需的。这项工作可以通过使用下标或索引直接访问转换表来实现。例如，如果输入付款代码是11，则可以检索到对应的付款代码描述。为了满足上面的要求，我们就可以使用前面的付款代码表来实现。这时候，使用表查找或检索模块就可以满足这种转换要求。
线性检索顺序地检查表中的项目，二分检索从表的中间开始，然后每次后继的检索都会去掉剩下的一半元素。线性检索不管表元素是怎样排列的，而二分检索要求表元素的排列是有序的，无论是上升还是下降的顺序。
为了说明它们的区别，假定有人猜从1～1000的某一个数字，比如327。线性检索从1开始，并顺序往前猜。下一个猜的是2，然后是3、4、5、…最后是327，一共猜327次。二分检索从500开始，然后是250，因为要猜的数字小于500，然后是375、313 等，直到找到327。对于二分检索，不管要找哪一个数字，最多要查找10次。（210=1024，意味着，任何不超过1023的数字能在10次内找到）。线性（顺序）检索最多要猜1000 次（如果要猜的数字是1000 的话）。因此，对于大表来说，二分检索比起线性检索更有效；确实，表越大，二分检索的优势越大。
COBOL SEARCH动词的语法如下。
格式1：SEARCH语句——线性检索。
格式2：SEARCH ALL语句——二分检索。
SEARCH本身指定线性检索，SEARCH ALL表示二分检索。在这两种格式中，IDENTIFIER-1指的是在数据部定义的包含OCCURS和INDEXED BY短语的表。如果指定二分支检索，即SEARCH ALL，IDENTIFIER-1必须要包含一个ASCENDING（DESCENDING）KEY短语。
在第2种格式中，AT END短语是可选项，但是谨慎的程序员常常使用。WHEN短语指定一个条件和一条强制语句。注意，在线性检索中，可以有几条WHEN语句，比如，检索一个有两个键值的表，一个键值做检索的条件，而另一个键值是否匹配决定所要做的处理。线性检索也可以带有VARYING选项，但是不在这里讨论。
下面的代码摘要说明了SEARCH动词。对于SEARCH或SEARCH ALL短语定义表时，都要指定INDEXED BY短语。但是，ASCENDING KEY短语只是在二分检索时才有用。SET语句必须出现在线性检索前，用来初始化从表的什么地方开始检索，换句话说，检索不一定要求总是从第1项开始。SET语句不能与二分检索一起使用，因为SEARCH ALL动词总会自动计算它的起始点。
下面的程序也说明了直接存取表项目的方法。在这个表中，如果付款代码直接指向对应的付款描述，我们就可以使用这种方法。这种方法由于没有任何比较，因此比二分检索还要快。但是，这种方法的使用只能局限于代码是数字型和大小有限的表。
下面的程序也说明了初始化PAY-CODE-TABLE的REDEFINES语句。COBOL不容许同一数据项既有OCCURS短语又有VALUE短语。OCCURS定义有多个数据项目的表；VALUE指定一个初值，即单个数值给数据名；这两个短语不能同时使用，因为我们不能指定单个值到多个数据项中。
REDEFINES短语是跳出这种困境的方法，因为它指定一个新数据名给原来分配的空间。因此，在下面，多个FILLER项将初始值分配给01项目PAY-CODE-TABLE-VALUES。后者通过REDEFINES短语给出一个新的名字，使得PAY-CODE-TABLE访问与PAY-CODE-TABLE-VALUES相同的物理地址。因此，PAY-CODE(1)的值为01，PAY-DESC(1)的值为CUSTOMER TRANSERS，其他类推。在后面我们提供了一个完整的程序（TABLE3）来说明用重定义的方法初始化表格及使用SEARCH和SEARCH ALL对付款代码表做线性检索和二分检索的例子。
*付款代码表的定义
000018 *------------------------------------------------------*
000019 * SWIFT PAYMENT CODE TABLE *
000020 *------------------------------------------------------*
000021 01 PAY-CODE-TABLE-VALUES.
000022 03 FILLER PIC X(25) VALUE '01/CUSTOMER TRANSFERS /2'.
000023 03 FILLER PIC X(25) VALUE '02/INTER-BANK TRANSFERS/3'.
000024 03 FILLER PIC X(25) VALUE '03/LOANS TO BANKS /3'.
000025 03 FILLER PIC X(25) VALUE '04/REPAYMENT TO BANKS /3'.
000026 03 FILLER PIC X(25) VALUE '05/EXCH. FUND PAYMENT /2'.
000027 03 FILLER PIC X(25) VALUE '06/CMU INSTRUMENT PYT /2'.
000028 03 FILLER PIC X(25) VALUE '07/FX TRANSACTIONS /2'.
000029 03 FILLER PIC X(25) VALUE '08/PAYMENT VS PAYMENT /2'.
000030 03 FILLER PIC X(25) VALUE '09/LAF DEPOSIT /3'.
000031 03 FILLER PIC X(25) VALUE '11/SI SETTLEMENT /1'.
000032 03 FILLER PIC X(25) VALUE '12/RESERVED FOR CCASS /1'.
000033 03 FILLER PIC X(25) VALUE '13/RESERVED FOR CCASS /1'.
000034 03 FILLER PIC X(25) VALUE '14/RESERVED FOR CCASS /1'.
000035 03 FILLER PIC X(25) VALUE '15/RESERVED FOR CCASS /1'.
000036 03 FILLER PIC X(25) VALUE '16/RELEASE A.S. PRE-PYT/1'.
000037 03 FILLER PIC X(25) VALUE '17/RELEASE STOCK COLLAT/1'.
000038 03 FILLER PIC X(25) VALUE '18/INTRA-DAY MARKS /1'.
000039 03 FILLER PIC X(25) VALUE '19/OTHER CASH COLLATERA/1'.
000040 03 FILLER PIC X(25) VALUE '20/RESERVED FOR CCASS /1'.
000041 03 FILLER PIC X(25) VALUE '21/RESERVED FOR CCASS /1'.
000042 03 FILLER PIC X(25) VALUE '22/RESERVED FOR CCASS /1'.
000043 03 FILLER PIC X(25) VALUE '23/RESERVED FOR CCASS /1'.
000044 03 FILLER PIC X(25) VALUE '24/RESERVED FOR CCASS /1'.
000045 03 FILLER PIC X(25) VALUE '25/RESERVED FOR CCASS /1'.
000046 03 FILLER PIC X(25) VALUE '33/MAINLAND CUSTOMER TR/2'.
000047 03 FILLER PIC X(25) VALUE '34/SAFE TRANSFER /2'.
000048 03 FILLER PIC X(25) VALUE '35/MAINLAND RETURN PYMT/2'.
000049 03 FILLER PIC X(25) VALUE '50/MAINLAND FX PAYMENT /2'.
000050 03 FILLER PIC X(25) VALUE '51/REGIONAL CHATS PYMT /2'.
000051 03 FILLER PIC X(25) VALUE '52/RTN OF REGIONAL CHAT/2'.
000052 01 PAY-CODE-TABLE-G REDEFINES PAY-CODE-TABLE-VALUES.
000053 03 PAY-CODE-TABLE OCCURS 30 TIMES
000054 ASCENDING KEY IS PAY-CODE
000055 INDEXED BY WS-INDEX.
000056 05 PAY-CODE PIC X(02).
000057 05 FILLER PIC X(01).
000058 05 PAY-DESC PIC X(20).
000059 05 FILLER PIC X(01).
000060 05 PAY-PRIORITY PIC 9(01).
*线性检索 ↙SET与线性检索一齐用，但不能与二分检索一齐用
000074 SET WS-INDEX TO 1
000075 SEARCH PAY-CODE-TABLE
000076 VARYING WS-INDEX
000077 AT END DISPLAY 'ATTENTION: PAY CODE NOT IN THE TABLE!!!'
000078 WHEN
000079 WS-PAY-CODE = PAY-CODE(WS-INDEX)
000080 MOVE PAY-DESC(WS-INDEX) TO WS-PAY-DESC
000081 DISPLAY 'CODE:' WS-PAY-CODE ',DESC IS:' WS-PAY-DESC
000082 WHEN WS-INDEX > WS-MAX-ENTRY
000083 DISPLAY ' PAY CODE NOT FOUND!!!'
000084 .
*二分检索
000090 SEARCH ALL PAY-CODE-TABLE
000091 AT END
000092 DISPLAY 'ATTENTION: PAY CODE NOT IN THE TABLE!!!'
000093 WHEN PAY-CODE(WS-INDEX) = WS-PAY-CODE
000094 MOVE PAY-DESC(WS-INDEX) TO WS-PAY-DESC
000095 DISPLAY 'CODE:' WS-PAY-CODE ',DESC IS:' WS-PAY-DESC
000096 END-SEARCH
000097 .
*直接存取表项
000094 MOVE PAY-DESC(WS-INDEX) TO WS-PAY-DESC
7.2.4 表的初始化
初始化表通常有两种方法。一种是如上面那样，用REDEFINES短语来做；另一种方法是如下面代码所示的那样，从文件中读取数据值来做。作者认为后一种技术更好一些，因为修改表的值可以不用重新编译程序。此外，如果几个程序使用相同的表，只需要修改一个地方，即输入文件即可。
下面的代码的几个特点值得说一下。变长度表是用DEPENDING ON短语定义的，它带有INDEXED BY短语，可以假定在随后的SEARCH语句中会用到它。也请注意，尽管表是用索引定义的，但还是可以用下标，如WS-SUBCRIPT来访问。但是，用WS-INDEX置换WS-SUBCRIPT并完全去掉WS-SUBSCRIPT同样是正确的。还要注意，PERFORM语句可以对索引直接操作，用不着求助SET语句。
在下面的代码中，WS-SUBSCRIPT是用USAGE IS COMPUTATIONAL（COMP）短语定义为二进制数值的。USAGE短语影响生成的目标码，因而影响机器的效率，但不影响过程部的逻辑。换句话说，程序无论有无USAGE COMP短语，都产生同样的输出，仅仅是编译生成的指令不一样。因此，为了实际分辨USAGE短语的影响，人们必须知道某些汇编语言知识。
下面的代码的程序逻辑也检查了两种潜在的错误。开始的读语句，确保输入（付款代码）文件不是空的，而第64行的IF语句证实文件中项目的个数不超过分配的存储空间。后一种检查对于防止下标（索引）错误是特别重要的，下标（越界）错误是令人困惑的，会浪费程序员大量的查错时间。
表的初始化的完整程序描述在后面的样板程序TABLE8中，我们会对其做更详细的说明。
000019 WORKING-STORAGE SECTION.
000020 01 WS-ITEMS.
000021 05 WS-ENTRY-COUNT PIC S9(03) COMP VALUE ZEROS.
000022 05 TABLE-EOF-SW PIC X(01) VALUE "N".
000023 88 TABLE-EOF VALUE "Y".
000024 05 WS-SUBCRIPT PIC S9(03) COMP. → USAGE COMP短语影响生成的目标码
…
000026 01 PAY-CODE-TABLE-G.
000027 03 PAY-CODE-TABLE OCCURS 0 TO 100 TIMES
000028 DEPENDING ON WS-ENTRY-COUNT
000029 ASCENDING KEY IS PAY-CODE
000030 INDEXED BY WS-INDEX.→ 付款代码表可以用索引访问
000031 05 PAY-CODE PIC X(02).
000032 05 FILLER PIC X(01).
000033 05 PAY-DESC PIC X(20).
000034 05 FILLER PIC X(01).
000035 05 PAY-PRIORITY PIC 9(01).
…
PROCEDURE DIVISION.
000039 READ TBLFILE
000040 AT END
000041 DISPLAY 'PAY CODE FILE IS EMPYT'
000042 MOVE 'Y' TO TABLE-EOF-SW
000043 .
000044 PERFORM 100-LOAD-RATE-TABLE
000045 VARYING WS-SUBCRIPT↘ FROM 1 BY 1
000046 UNTIL TABLE-EOF 付款代码表也可以用下标访问
…
000063 120-STORE-TABLE-ENTRY.
000064 IF WS-SUBCRIPT > 100 → 检查有没有超过表的大小
000065 DISPLAY 'PAY CODE TABLE IS TOO SMALL'
000066 MOVE 'Y' TO TABLE-EOF-SW
000067 ELSE
000068 ADD 1 TO WS-ENTRY-COUNT
000069 MOVE TABLE-DATA-AREA TO PAY-CODE-TABLE(WS-SUBCRIPT)
000070 DISPLAY TABLE-DATA-AREA
000071 .
7.2.5 二维表
表7.1是某银行外汇牌价的二维表。牌价的决定因素由货币代码和牌价类型决定，不同的货币其牌价是不同的，同一个货币不同的牌价类型，其牌价也是不同的。比如货币ATS的市场买价（MARKET BUY）是1.123456，而其电汇买价（TT BUY）则为1.121456。AUD的低值现钞买价（LOW CASH BUY）为1.113456，而ZAR的低值现钞买价（HIGH CASE SELL）则为1.123156。
表7.1 银行外汇牌价的二维表
下面是银行外汇牌价表在COBOL数据部的描述。
000034 01 EXCH-RATE-TABLE-G.
000035 03 EXCH-RATE-TABLE OCCURS 0 TO 100 TIMES
000036 DEPENDING ON WS-ENTRY-COUNT
000037 ASCENDING KEY IS EXCH-CCY
000038 INDEXED BY WS-INDEX.
000039 05 EXCH-CCY PIC X(03).
000040 05 EXCH-DESC PIC X(20).
000041 05 EXCH-POINT PIC 9(01).
000042 05 EXCH-RATE OCCURS 11 TIMES PIC 9(03)V9(06).
000043 * RATE 1---> MARKET BUY
000044 * RATE 2---> MARKET SELL
000045 * RATE 3---> HIGH CASH BUY
000046 * RATE 4---> HIGH CASH SELL
000047 * RATE 5---> LOW CASH BUY
000048 * RATE 6---> LOW CASH SELL
000049 * RATE 7---> TT BUY
000050 * RATE 8---> TT SELL
000051 * RATE 9---> OD BUY
000052 * RATE 10---->BILLS BUY
000053 * RATE 11---->BILLS SELL
000054 *
COBOL程序可以灵活地访问在不同的层次级别的数据，二维表的定义也自动容许访问相关的一维表。但是，下标的顺序和访问的级别是绝对苛刻的。下面是几个例子。
EXCH-RATE-TABLE-G：访问整个表，表的元素个数为11×WS-ENTRY（从0～100），每个元素占据123字节。不可以用任何下标访问。
EXCH-RATE-TABLE(1)：集中访问货币为ATS的外汇牌价信息，包括货币代码EXCH-CCY(1)、货币描述EXCH-DESC(1)、小数点标志EXCH-POINT（1）及11 个不同类型的外汇牌价EXCH-RATE(1,1)、EXCH-RATE(1,2)、EXCH-RATE(1,3)、…、EXCH-RATE(1,11)。请注意，货币代码、货币描述和小数点标志只需要一个下标就可以访问，但外汇牌价EXCH-RATE则必须使用两个下标访问，因为它们才是真正的二维表，必须由两个下标访问，只有货币和牌价类型才能决定牌价的值。
二维表常常是用PERFORM VARYING语句处理的，PERFORM VARYING语句同时处理两个下标，（索引），比如，在我们的初始化二维表的程序TABLE6中，就使用了下面的两层PERFORM语句，分别使用下标WS-SUB1和WS-SUB2。第62行到第64行的高层PERFORM语句使用的是下标WS-SUB1，对应的是货币代码，它的循环次数取决于输入文件的记录（货币）个数，而在第90行到第94行的PERFORM中，使用的下标是WS-SUB2，对应的是牌价类型，它的循环次数是固定的，总是11，因为牌价类型只有11种。二维表的完整程序（TABLE6）代码出现在本单元的后面，我们同时也给出了初始化的输入文件、运行程序的作业流和运行后的结果。
这里还有一点需要强调的是，由于我们的表使用了ASCENDING KEY IS EXCH-CCY短语，因此要求输入文件必须是按照货币代码EXCH-CCY的升序排列的，否则程序运行时会出错。如果你仔细检查我们的输入文件，你就会发现，它是排列好了的。
000062 PERFORM 100-LOAD-RATE-TABLE
000063 VARYING WS-SUB1 FROM 1 BY 1
000064 UNTIL TABLE-EOF
。。。
000087 MOVE TABLE-EXCH-CCY TO EXCH-CCY(WS-SUB1)
000088 MOVE TABLE-EXCH-DESC TO EXCH-DESC(WS-SUB1)
000089 MOVE TABLE-EXCH-POINT TO EXCH-POINT(WS-SUB1)
000090 PERFORM VARYING WS-SUB2 FROM 1 BY 1
000091 UNTIL WS-SUB2 > 11
000092 MOVE TABLE-EXCH-RATE(WS-SUB2)
000093 TO EXCH-RATE(WS-SUB1,WS-SUB2)
000094 END-PERFORM
000095 DISPLAY TABLE-EXCH-CCY ',' TABLE-EXCH-DESC 'LOADED...'
000096 .
7.2.6 表初始化程序例子（TABLE8）
下面是表的初始化COBOL程序的完整版本，初始化是通过读文件来实现的。表的定义出现在第26行到第36 行。PAY-CODE-TABLE-G定义了所有的表项目，对应的长度为表的实际项目个数×表项的长度（25），它不可以使用下标访问。
PAY-CODE-TABEL定义每个表项，长度为25，必须使用下标访问，PAY-CODE-TABLE(1)是表的第1项，包含PAY-CODE(1)、PAY-DESC(1)和PAY-PRIORITY(1)和两个FILLER字段。
第39 行的预先读是处理顺序文件的常见方法，同时可以预先检查输入文件是否为空，如果为空，就可以不用进行余下的处理。
第44行到第46行的PERFORM…VARYING…UNTIL语句，用来从输入文件中读取每条记录，并将它们装载到表中。这类PERFORM语句通常都是与表处理联系在一起的。
第64行的IF语句检查是否超过表的容量，如果超过，就报错，这是预防性编码的例子，程序员不能假定一切都是对的，一旦有一天你收到计算中心的电话，说你的表初始化程序ABEND了，你就必须立即放下手头的工作，检查出错的原因，但是如果你有预防性地编码，你的程序就会只是出警告信息给操作员，说表溢出了，当你收到电话时，你的心情会好很多。
第69 行的MOVE语句将文件的记录传送到表中，对每条文件记录，程序都会这样做。注意，代码PAY-CODE-TABLE（WS-SUBCRIPT）说明存取表项的方法是下标，结合我们表定义中的INDEXED BY WS-INDEX短语，就知道，我们既可以使用下标，也可以使用索引访问表。
第59行的READ语句，读下一条记录，与程序一开始的预先读语句一起构成顺序文件处理的标准结构。该语句同时检查文件的结尾，这是表初始化程序结束的条件。
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. TABLE8.
000003 AUTHOR. NEWMAN LV.
000004 *
000005 ENVIRONMENT DIVISION.
000006 INPUT-OUTPUT SECTION.
000007 FILE-CONTROL.
000008 SELECT TBLFILE ASSIGN TO UT-S-TBLFILE.
000009 *
000010 DATA DIVISION.
000011 FILE SECTION.
000012 FD TBLFILE
000013 LABEL RECORDS ARE STANDARD
000014 RECORDING MODE IS F
000015 RECORD CONTAINS 25 CHARACTERS
000016 BLOCK CONTAINS 0 RECORDS.
000017 01 TABLE-DATA-AREA PIC X(25).
000018 *
000019 WORKING-STORAGE SECTION.
000020 01 WS-ITEMS.
000021 05 WS-ENTRY-COUNT PIC S9(03) COMP VALUE ZEROS.
000022 05 TABLE-EOF-SW PIC X(01) VALUE "N".
000023 88 TABLE-EOF VALUE "Y".
000024 05 WS-SUBCRIPT PIC S9(03) COMP.
000025 *
000026 01 PAY-CODE-TABLE-G.
000027 03 PAY-CODE-TABLE OCCURS 0 TO 100 TIMES
000028 DEPENDING ON WS-ENTRY-COUNT
000029 ASCENDING KEY IS PAY-CODE
000030 INDEXED BY WS-INDEX.
000031 05 PAY-CODE PIC X(02).
000032 05 FILLER PIC X(01).
000033 05 PAY-DESC PIC X(20).
000034 05 FILLER PIC X(01).
000035 05 PAY-PRIORITY PIC 9(01).
000036 *
000037 PROCEDURE DIVISION.
000038 OPEN INPUT TBLFILE
000039 READ TBLFILE → 预先读，避免输入文件为空
000040 AT END
000041 DISPLAY 'PAY CODE FILE IS EMPYT'
000042 MOVE 'Y' TO TABLE-EOF-SW
000043 .
000044 PERFORM 100-LOAD-RATE-TABLE
000045 VARYING WS-SUBCRIPT FROM 1 BY 1
000046 UNTIL TABLE-EOF
000047 DISPLAY 'TABLE ENTRY COUNT:' WS-ENTRY-COUNT
000048 CLOSE TBLFILE
000049 STOP RUN.
000050 *
000051 100-LOAD-RATE-TABLE.
000052 IF NOT TABLE-EOF
000053 PERFORM 120-STORE-TABLE-ENTRY
000054 .
000055 PERFORM 110-READ-TABLE-RECORD
000056 .
000057 *
000058 110-READ-TABLE-RECORD.
000059 READ TBLFILE 读下一条记录，并检查是否文件结束
000060 AT END→
000061 MOVE 'Y' TO TABLE-EOF-SW.
000062 *
000063 120-STORE-TABLE-ENTRY.
000064 IF WS-SUBCRIPT > 100
000065 DISPLAY 'PAY CODE TABLE IS TOO SMALL'
000066 MOVE 'Y' TO TABLE-EOF-SW
000067 ELSE
000068 ADD 1 TO WS-ENTRY-COUNT
000069 MOVE TABLE-DATA-AREA TO PAY-CODE-TABLE(WS-SUBCRIPT)
000070 DISPLAY TABLE-DATA-AREA
000071 .
7.2.7 表初始化作业流
下面是运行表的初始化程序TABLE8的作业流。它指定了初始化表的输入文件是IBMUSER.TEST.PAYCODE，它的具体内容出现在接下来的一段中。
000001 //IBMUSERA JOB CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1),NOTIFY=&SYSUID
000002 //GOTABLE EXEC PGM=TABLE8
000003 //STEPLIB DD DSN=IBMUSER.TEST.LOAD,DISP=SHR
000004 //SYSOUT DD SYSOUT=*
000005 //SYSPRINT DD SYSOUT=*
000006 //SORTOUT DD SYSOUT=*
000007 //SYSUDUMP DD SYSOUT=*
000008 //TBLFILE DD DSN=IBMUSER.TEST.PAYCODE,DISP=SHR
7.2.8 表初始输入数据
下面是表初始化程序TABLE8的输入文件，它的格式跟我们的文件定义必须是一致的。
000001 01/CUSTOMER TRANSFERS /2
000002 02/INTER-BANK TRANSFERS/3
000003 03/LOANS TO BANKS /3
000004 04/REPAYMENT TO BANKS /3
000005 05/EXCH. FUND PAYMENT /2
000006 06/CMU INSTRUMENT PYT /2
000007 07/FX TRANSACTIONS /2
000008 08/PAYMENT VS PAYMENT /2
000009 09/LAF DEPOSIT /3
000010 11/SI SETTLEMENT /1
000011 12/RESERVED FOR CCASS /1
000012 13/RESERVED FOR CCASS /1
000013 14/RESERVED FOR CCASS /1
000014 15/RESERVED FOR CCASS /1
000015 16/RELEASE A.S. PRE-PYT/1
000016 17/RELEASE STOCK COLLAT/1
000017 18/INTRA-DAY MARKS /1
000018 19/OTHER CASH COLLATERA/1
000019 20/RESERVED FOR CCASS /1
000020 21/RESERVED FOR CCASS /1
000021 22/RESERVED FOR CCASS /1
000022 23/RESERVED FOR CCASS /1
000023 24/RESERVED FOR CCASS /1
000024 25/RESERVED FOR CCASS /1
000025 33/MAINLAND CUSTOMER TR/2
000026 34/SAFE TRANSFER /2
000027 35/MAINLAND RETURN PYMT/2
000028 50/MAINLAND FX PAYMENT /2
000029 51/REGIONAL CHATS PYMT /2
000030 52/RTN OF REGIONAL CHAT/2
000031 54/CUSTOMER TRANSFERS /2
000032 55/INTER-BANK TRANSFERS/3
000033 63/LOANS TO BANKS /3
000034 64/REPAYMENT TO BANKS /3
000035 65/EXCH. FUND PAYMENT /2
000036 66/CMU INSTRUMENT PYT /2
000037 67/FX TRANSACTIONS /2
000038 68/PAYMENT VS PAYMENT /2
000039 69/LAF DEPOSIT /3
000040 71/SI SETTLEMENT /1
000041 72/RESERVED FOR CCASS /1
000042 73/RESERVED FOR CCASS /1
000043 74/RESERVED FOR CCASS /1
000044 75/RESERVED FOR CCASS /1
000045 76/RELEASE A.S. PRE-PYT/1
000046 77/RELEASE STOCK COLLAT/1
000047 78/INTRA-DAY MARKS /1
000048 79/OTHER CASH COLLATERA/1
000049 80/RESERVED FOR CCASS /1
000050 81/RESERVED FOR CCASS /1
000051 82/RESERVED FOR CCASS /1
000052 83/RESERVED FOR CCASS /1
000053 84/RESERVED FOR CCASS /1
000054 85/RESERVED FOR CCASS /1
000055 86/MAINLAND CUSTOMER TR/2
000056 87/SAFE TRANSFER /2
000057 88/MAINLAND RETURN PYMT/2
000058 90/MAINLAND FX PAYMENT /2
000059 91/REGIONAL CHATS PYMT /2
000060 92/RTN OF REGIONAL CHAT/2
7.2.9 表初始化运行结果
下面是表初始化程序TABLE8的运行结果，我们看到，所有的输入文件记录都成功装载到表中了，第61行的显示表明，一共有60条记录装载成功了，与文件的记录个数是一致的。
000001 01/CUSTOMER TRANSFERS /2
000002 02/INTER-BANK TRANSFERS/3
000003 03/LOANS TO BANKS /3
000004 04/REPAYMENT TO BANKS /3
000005 05/EXCH. FUND PAYMENT /2
000006 06/CMU INSTRUMENT PYT /2
000007 07/FX TRANSACTIONS /2
000008 08/PAYMENT VS PAYMENT /2
000009 09/LAF DEPOSIT /3
000010 11/SI SETTLEMENT /1
000011 12/RESERVED FOR CCASS /1
000012 13/RESERVED FOR CCASS /1
000013 14/RESERVED FOR CCASS /1
000014 15/RESERVED FOR CCASS /1
000015 16/RELEASE A.S. PRE-PYT/1
000016 17/RELEASE STOCK COLLAT/1
000017 18/INTRA-DAY MARKS /1
000018 19/OTHER CASH COLLATERA/1
000019 20/RESERVED FOR CCASS /1
000020 21/RESERVED FOR CCASS /1
000021 22/RESERVED FOR CCASS /1
000022 23/RESERVED FOR CCASS /1
000023 24/RESERVED FOR CCASS /1
000024 25/RESERVED FOR CCASS /1
000025 33/MAINLAND CUSTOMER TR/2
000026 34/SAFE TRANSFER /2
000027 35/MAINLAND RETURN PYMT/2
000028 50/MAINLAND FX PAYMENT /2
000029 51/REGIONAL CHATS PYMT /2
000030 52/RTN OF REGIONAL CHAT/2
000031 54/CUSTOMER TRANSFERS /2
000032 55/INTER-BANK TRANSFERS/3
000033 63/LOANS TO BANKS /3
000034 64/REPAYMENT TO BANKS /3
000035 65/EXCH. FUND PAYMENT /2
000036 66/CMU INSTRUMENT PYT /2
000037 67/FX TRANSACTIONS /2
000038 68/PAYMENT VS PAYMENT /2
000039 69/LAF DEPOSIT /3
000040 71/SI SETTLEMENT /1
000041 72/RESERVED FOR CCASS /1
000042 73/RESERVED FOR CCASS /1
000043 74/RESERVED FOR CCASS /1
000044 75/RESERVED FOR CCASS /1
000045 76/RELEASE A.S. PRE-PYT/1
000046 77/RELEASE STOCK COLLAT/1
000047 78/INTRA-DAY MARKS /1
000048 79/OTHER CASH COLLATERA/1
000049 80/RESERVED FOR CCASS /1
000050 81/RESERVED FOR CCASS /1
000051 82/RESERVED FOR CCASS /1
000052 83/RESERVED FOR CCASS /1
000053 84/RESERVED FOR CCASS /1
000054 85/RESERVED FOR CCASS /1
000055 86/MAINLAND CUSTOMER TR/2
000056 87/SAFE TRANSFER /2
000057 88/MAINLAND RETURN PYMT/2
000058 90/MAINLAND FX PAYMENT /2
000059 91/REGIONAL CHATS PYMT /2
000060 92/RTN OF REGIONAL CHAT/2
000061 TABLE ENTRY COUNT:060
7.2.10 二维表初始化程序例子（TABLE6）
下面是二维表初始化COBOL程序的完整版本，初始化也是通过读文件来实现的。表的定义出现在第34行到第53行。由于在第35行到第42行都出现了OCCURS语句，因此我们知道它是一个二维表。
程序的逻辑跟前面的一维表的逻辑是非常相似的，我们就不再做详细的介绍了。这里不同的是，第90行到第94 行的内置（Inline）PERFORM语句，完成了对二维表外汇牌价的赋值，代码EXCH-RATE（WS-SUB1，WS-SUB2）演示了二维表的的赋值方法，必须使用两个下标，第1个下标对应于货币代码，而第2个下标对应于每个货币的牌价类型。下标出现的顺序是严格的，不可以颠倒。
000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. TABLE6.
000003 AUTHOR. NEWMAN LV.
000004 *
000005 ENVIRONMENT DIVISION.
000006 INPUT-OUTPUT SECTION.
000007 FILE-CONTROL.
000008 SELECT TBLFILE ASSIGN TO UT-S-TBLFILE.
000009 *
000010 DATA DIVISION.
000011 FILE SECTION.
000012 FD TBLFILE
000013 LABEL RECORDS ARE STANDARD
000014 RECORDING MODE IS F
000015 RECORD CONTAINS 126 CHARACTERS
000016 BLOCK CONTAINS 0 RECORDS.
000017 01 TABLE-DATA-AREA.
000018 05 TABLE-EXCH-CCY PIC X(03).
000019 05 FILLER PIC X(01).
000020 05 TABLE-EXCH-DESC PIC X(20).
000021 05 FILLER PIC X(01).
000022 05 TABLE-EXCH-POINT PIC 9(01).
000023 05 FILLER PIC X(01).
000024 05 TABLE-EXCH-RATE OCCURS 11 TIMES PIC 9(03)V9(06).
000025 *
000026 WORKING-STORAGE SECTION.
000027 01 WS-ITEMS.
000028 05 WS-ENTRY-COUNT PIC S9(03) COMP VALUE ZEROS.
000029 05 TABLE-EOF-SW PIC X(01) VALUE "N".
000030 88 TABLE-EOF VALUE "Y".
000031 05 WS-SUB1 PIC S9(03) COMP.
000032 05 WS-SUB2 PIC S9(03) COMP.
000033 *
000034 01 EXCH-RATE-TABLE-G.
000035 03 EXCH-RATE-TABLE OCCURS 0 TO 100 TIMES
000036 DEPENDING ON WS-ENTRY-COUNT
000037 ASCENDING KEY IS EXCH-CCY
000038 INDEXED BY WS-INDEX.
000039 05 EXCH-CCY PIC X(03).
000040 05 EXCH-DESC PIC X(20).
000041 05 EXCH-POINT PIC 9(01).
000042 05 EXCH-RATE OCCURS 11 TIMES PIC 9(03)V9(06).
000043 * RATE 1---> MARKET BUY
000044 * RATE 2---> MARKET SELL
000045 * RATE 3---> HIGH CASH BUY
000046 * RATE 4---> HIGH CASH SELL
000047 * RATE 5---> LOW CASH BUY
000048 * RATE 6---> LOW CASH SELL
000049 * RATE 7---> TT BUY
000050 * RATE 8---> TT SELL
000051 * RATE 9---> OD BUY
000052 * RATE 10---->BILLS BUY
000053 * RATE 11---->BILLS SELL
000054 *
000055 PROCEDURE DIVISION.
000056 OPEN INPUT TBLFILE
000057 READ TBLFILE
000058 AT END
000059 DISPLAY 'EXCH RATE FILE IS EMPYT'
000060 MOVE 'Y' TO TABLE-EOF-SW
000061 .
000062 PERFORM 100-LOAD-RATE-TABLE
000063 VARYING WS-SUB1 FROM 1 BY 1
000064 UNTIL TABLE-EOF
000065 DISPLAY 'TABLE ENTRY COUNT:' WS-ENTRY-COUNT
000066 CLOSE TBLFILE
000067 STOP RUN.
000068 *
000069 100-LOAD-RATE-TABLE.
000070 IF NOT TABLE-EOF
000071 PERFORM 120-STORE-TABLE-ENTRY
000072 .
000073 PERFORM 110-READ-TABLE-RECORD
000074 .
000075 *
000076 110-READ-TABLE-RECORD.
000077 READ TBLFILE
000078 AT END
000079 MOVE 'Y' TO TABLE-EOF-SW.
000080 *
000081 120-STORE-TABLE-ENTRY.
000082 IF WS-SUB1 > 100
000083 DISPLAY 'PAY CODE TABLE IS TOO SMALL'
000084 MOVE 'Y' TO TABLE-EOF-SW
000085 ELSE
000086 ADD 1 TO WS-ENTRY-COUNT
000087 MOVE TABLE-EXCH-CCY TO EXCH-CCY(WS-SUB1)
000088 MOVE TABLE-EXCH-DESC TO EXCH-DESC(WS-SUB1)
000089 MOVE TABLE-EXCH-POINT TO EXCH-POINT(WS-SUB1)
000090 PERFORM VARYING WS-SUB2 FROM 1 BY 1
000091 UNTIL WS-SUB2 > 11
000092 MOVE TABLE-EXCH-RATE(WS-SUB2)
000093二维表的赋值使用了两个下标 → TO EXCH-RATE(WS-SUB1,WS-SUB2)
000094 END-PERFORM
000095 DISPLAY TABLE-EXCH-CCY ',' TABLE-EXCH-DESC 'LOADED...'
000096 .
7.2.11 二维表初始化作业流
下面是运行二维表初始化程序TABLE6的作业流。它指定了初始化表的输入文件是IBMUSER.TEST.EXCHRATE，它的具体内容出现在接下来的一段中。
000001 //IBMUSERA JOB CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1),NOTIFY=&SYSUID
000002 //GOTABLE EXEC PGM=TABLE6
000003 //STEPLIB DD DSN=IBMUSER.TEST.LOAD,DISP=SHR
000004 //SYSOUT DD SYSOUT=*
000005 //SYSPRINT DD SYSOUT=*
000006 //SORTOUT DD SYSOUT=*
000007 //SYSUDUMP DD SYSOUT=*
000008 //TBLFILE DD DSN=IBMUSER.TEST.EXCHRATE,DISP=SHR
7.2.12 二维表初始输入数据
下面是二维表初始化程序TABLE6的输入文件，它的格式跟我们的文件定义必须是一致的。由于记录较长，所以每条文件记录我们用3行表示。
ATS ATS DOLLARS.........
0011234560011234670011234560011234670011234560011234670011214560011214670011134560011
2346700112345611
AUD AUD DOLLARS.........
0011234560011234670011234560011234670011134560011234670011231560011231670011214560011
2346700112345611
BEF BEF DOLLARS.........
0011234560011234670011234560011234670011214560011234670011234160011234170011231560011
2346700112345611
BRL BRL DOLLARS.........
0011234560011234670011234560011234670011231560011234670011234510011234610011234160011
2346700112345611
CAD CAD DOLLARS.........
0011234560011234670011234560011234670011234160011234670011234561011234671011234510011
2346700112345611
CHF CHF DOLLARS.........
0011234560011234670011234560011234670011234510011234670011234560111234670011234561011
2346700112345611
CNY CNY YUAN............
0011234560011234670011234560011234670011234561011134670011234560011234670011234560111
2346700112345611
DEM DEM DOLLARS.........
0011234560011234670011234560011234670011234560111214670011234560011134670011234560011
2346700112345611
DKK DKK DOLLARS.........
0011234560011234670011234560011234670011234560011231670011234560011214670011234560011
2346700112345611
ESP ESP DOLLARS.........
0011234560011234670011234560011234670011134560011234170011234560011231670011234560011
2346700112345611
EUR EUR DOLLARS.........
0011234560011234670011234560011234670011214560011234670011234560011234170011234560011
2346700112345611
FIM FIM DOLLARS.........
0011234560011234670011234560011234670011211560011234670011234560011234610011234560011
2346700112345611
FRF FRF DOLLARS.........
0011234560011234670011234560011234670011231160011234670011234560011234670011234560011
2346700112345611
GBP GBP DOLLARS.........
0011234560011234670011234560011234670011234110011234610011234560011214670011234560011
2346700112345611
HKD HKD DOLLARS.........
0010000000010000000010000000010000000010000000011234670011234560011231670011234560011
2346700112345611
IDR IDR DOLLARS.........
0011234560011234670011234560011234670011234510111234670011234560011234170011234560011
2346700112345611
INR INR DOLLARS.........
0011234560011234670011234560011234670011234561011234670011234560011234610011234560011
2346700112345611
ITL ITL DOLLARS.........
0011234560011234670011234560011214670011234560011134670011214560011234670011134560011
2146700112345611
JPY JPY YUAN............
0011234560011234670011234560011231670011214560011214670011231560011234670011214560011
2316700112345611
KRW KRW DOLLARS.........
0011234560011234670011234560011234170011231560011231670011234160011234670011231560011
2341700112345611
MOP MOP DOLLARS.........
0011234560011234670011234560011234610011234160011234170011234510011234670011234160011
2346100112345611
MYR MYR DOLLARS.........
0011234560011234670011234560011234671011234510011234610011234561011234670011234510011
2346710112345611
NLG NLG DOLLARS.........
0011234560011234670011234560011234670111234561011234671011234560111231670011234561011
2346701112345611
NOK NOK DOLLARS.........
0011234560011234670011234560011214670011234560111234670111234560011234170011234560111
2346700112345611
NZD NZD DOLLARS.........
0011234560011234670011234560011231670011234560011234670011234560011234610011234560011
2346700112345611
PHP PHP DOLLARS.........
0011234560011234670011234560011234170011134560011234670011234560011134671011234560011
2346700111345611
SEK SEK DOLLARS.........
0011234560011234670011234560011234610011214560011134670011134560011214670111234560011
1346700112145611
SGD SGD DOLLARS.........
0011234560011234670011234560011234671011231560011214670011214560011231670011234560011
2146700112315611
THB THB DOLLARS.........
0011234560011234670011234560011234670111234160011231670011231560011234170011234560011
2316700112341611
TWD TWD YUAN............
0011234560011234670011234560011234670011234510011234170011234160011234610011134560011
2341700112345111
USD USD DOLLARS.........
0011234560011234670011234560011234670011234561011234610011234510011234671011214560011
2346100112345611
XAU XAU DOLLARS.........
0011234560011234670011234560011234670011134560111234671011234561011234670111231560011
2346710112345611
XEU XEU DOLLARS.........
0011234560011234670011234560011234670011214560011234670111234560111234670011234160011
2346701112345611
ZAR ZAR DOLLARS.........
0011234560011234670011234560011234670011231560011234670011234560011234670011234510011
2346700112345611
7.2.13 二维表初始化运行结果
下面是表初始化程序TABLE6的运行结果，我们看到，所有的输入文件记录都成功装载到表中了，第35行的显示表明，一共有34条记录装载成功了，与文件的记录个数是一致的。
000001 ATS,ATS DOLLARS.........LOADED...
000002 AUD,AUD DOLLARS.........LOADED...
000003 BEF,BEF DOLLARS.........LOADED...
000004 BRL,BRL DOLLARS.........LOADED...
000005 CAD,CAD DOLLARS.........LOADED...
000006 CHF,CHF DOLLARS.........LOADED...
000007 CNY,CNY YUAN............LOADED...
000008 DEM,DEM DOLLARS.........LOADED...
000009 DKK,DKK DOLLARS.........LOADED...
000010 ESP,ESP DOLLARS.........LOADED...
000011 EUR,EUR DOLLARS.........LOADED...
000012 FIM,FIM DOLLARS.........LOADED...
000013 FRF,FRF DOLLARS.........LOADED...
000014 GBP,GBP DOLLARS.........LOADED...
000015 HKD,HKD DOLLARS.........LOADED...
000016 IDR,IDR DOLLARS.........LOADED...
000017 INR,INR DOLLARS.........LOADED...
000018 ITL,ITL DOLLARS.........LOADED...
000019 JPY,JPY YUAN............LOADED...
000020 KRW,KRW DOLLARS.........LOADED...
000021 MOP,MOP DOLLARS.........LOADED...
000022 MYR,MYR DOLLARS.........LOADED...
000023 NLG,NLG DOLLARS.........LOADED...
000024 NOK,NOK DOLLARS.........LOADED...
000025 NZD,NZD DOLLARS.........LOADED...
000026 PHP,PHP DOLLARS.........LOADED...
000027 SEK,SEK DOLLARS.........LOADED...
000028 SGD,SGD DOLLARS.........LOADED...
000029 THB,THB DOLLARS.........LOADED...
000030 TWD,TWD YUAN............LOADED...
000031 USD,USD DOLLARS.........LOADED...
000032 XAU,XAU DOLLARS.........LOADED...
000033 XEU,XEU DOLLARS.........LOADED...
000034 ZAR,ZAR DOLLARS.........LOADED...
000035 TABLE ENTRY COUNT:034
7.2.14 顺序和折半检索程序例子（TABLE3）
下面的完整程序代码演示了使用重定义（REDEFINES）短语初始化表的方法。COBOL程序不容许同一数据项既有OCCURS短语，又有VALUE短语。OCCURS短语定义有多个数据项目的表；VALUE短语指定一个初值，即单个数值给数据名；这两个短语不能同时使用，因为我们不能指定单个值到多个数据项中。
REDEFINES短语是跳出这种困境的方法，因为它指定一个新数据名给原来分配的空间。因此，在下面的程序代码中，第22行到第51行的多个FILLER项将初始值分配给01项目PAY-CODE-TABLE-VALUES。而第52行的REDEFINES短语将01项PAY-CODE-TABLE-G与PAY-CODE-TABLE-VALUES联系起来，它们指向同一片内存区域。因此，PAY-CODE(1)的值为01，PAY-DESC(1)的值为CUSTOMER TRANSFERS，其他类推。
由于我们在表的定义中使用了ASCENDING KEY IS PAY-CODE短语，因此要求表中PAY-CODE必须是按照升序排列的，从第22行到第51行的代码我们可以看到，它们确实是排好序的。
第75行的SEARCH语句没有使用ALL短语，说明是顺序查找，即从表的第1项开始顺序查找，直到找到满足条件的表项为止。如果查完整个表都没有找到满足条件的项目，AT END条件就会出现，对应的出错信息（ATTENTION: PAY CODE NOT IN THE TABLE!!!）就会显示出来；如果满足条件，即第1个WHEN语句中的条件满足，程序就会将所匹配的PAY-CODE对应的描述（PAY-DESC）显示出来，整个SEARCH语句也就结束了，程序会转去执行紧跟在SEARCH语句后面的语句。
第90行到第96行的SEARCH ALL语句使用折半查找来检索表，这要求表必须是按照关键字的升序或降序排列的，显然，我们的付款代码表是满足条件的，因为付款代码表是按照PAY-CODE的升序排好了的。当满足条件的记录没有在表中找到时，AT END后的语句就会执行。当找到满足条件的记录时，就会显示相关的信息。
对于程序员来说，顺序和折半查找可能结果是一样的，但如果表项足够多，折半查找的效率就会好很多。
下面是程序的完整代码，值得你好好读一读。
000001 IDENTIFICATION DIVISION.
000002 *
000003 PROGRAM-ID. TABLE3.
000004 AUTHOR. NEWMAN LV.
000005 *
000006 ENVIRONMENT DIVISION.
000007 *
000008 INPUT-OUTPUT SECTION.
000009 *
000010 FILE-CONTROL.
000011 *
000012 DATA DIVISION.
000013 *
000014 FILE SECTION.
000015 *
000016 WORKING-STORAGE SECTION.
000017 *
000018 *------------------------------------------------------*
000019 * SWIFT PAYMENT CODE TABLE *
000020 *------------------------------------------------------*
000021 01 PAY-CODE-TABLE-VALUES.
000022 03 FILLER PIC X(25) VALUE '01/CUSTOMER TRANSFERS /2'.
000023 03 FILLER PIC X(25) VALUE '02/INTER-BANK TRANSFERS /3'.
000024 03 FILLER PIC X(25) VALUE '03/LOANS TO BANKS /3'.
000025 03 FILLER PIC X(25) VALUE '04/REPAYMENT TO BANKS /3'.
000026 03 FILLER PIC X(25) VALUE '05/EXCH. FUND PAYMENT /2'.
000027 03 FILLER PIC X(25) VALUE '06/CMU INSTRUMENT PYT /2'.
000028 03 FILLER PIC X(25) VALUE '07/FX TRANSACTIONS /2'.
000029 03 FILLER PIC X(25) VALUE '08/PAYMENT VS PAYMENT /2'.
000030 03 FILLER PIC X(25) VALUE '09/LAF DEPOSIT /3'.
000031 03 FILLER PIC X(25) VALUE '11/SI SETTLEMENT /1'.
000032 03 FILLER PIC X(25) VALUE '12/RESERVED FOR CCASS /1'.
000033 03 FILLER PIC X(25) VALUE '13/RESERVED FOR CCASS /1'.
000034 03 FILLER PIC X(25) VALUE '14/RESERVED FOR CCASS /1'.
000035 03 FILLER PIC X(25) VALUE '15/RESERVED FOR CCASS /1'.
000036 03 FILLER PIC X(25) VALUE '16/RELEASE A.S. PRE-PYT /1'.
000037 03 FILLER PIC X(25) VALUE '17/RELEASE STOCK COLLAT /1'.
000038 03 FILLER PIC X(25) VALUE '18/INTRA-DAY MARKS /1'.
000039 03 FILLER PIC X(25) VALUE '19/OTHER CASH COLLATERA /1'.
000040 03 FILLER PIC X(25) VALUE '20/RESERVED FOR CCASS /1'.
000041 03 FILLER PIC X(25) VALUE '21/RESERVED FOR CCASS /1'.
000042 03 FILLER PIC X(25) VALUE '22/RESERVED FOR CCASS /1'.
000043 03 FILLER PIC X(25) VALUE '23/RESERVED FOR CCASS /1'.
000044 03 FILLER PIC X(25) VALUE '24/RESERVED FOR CCASS /1'.
000045 03 FILLER PIC X(25) VALUE '25/RESERVED FOR CCASS /1'.
000046 03 FILLER PIC X(25) VALUE '33/MAINLAND CUSTOMER TR /2'.
000047 03 FILLER PIC X(25) VALUE '34/SAFE TRANSFER /2'.
000048 03 FILLER PIC X(25) VALUE '35/MAINLAND RETURN PYMT /2'.
000049 03 FILLER PIC X(25) VALUE '50/MAINLAND FX PAYMENT /2'.
000050 03 FILLER PIC X(25) VALUE '51/REGIONAL CHATS PYMT /2'.
000051 03 FILLER PIC X(25) VALUE '52/RTN OF REGIONAL CHAT /2'.
000052 01 PAY-CODE-TABLE-G REDEFINES PAY-CODE-TABLE-VALUES.
000053 03 PAY-CODE-TABLE OCCURS 30 TIMES
000054 ASCENDING KEY IS PAY-CODE
000055 INDEXED BY WS-INDEX.
000056 05 PAY-CODE PIC X(02).
000057 05 FILLER PIC X(01).
000058 05 PAY-DESC PIC X(20).
000059 05 FILLER PIC X(01).
000060 05 PAY-PRIORITY PIC 9(01).
000061 *
000062 01 WS-INPUT.
000063 05 WS-PAY-CODE PIC X(02).
000064 05 FILLER PIC X(78).
000065 *
000066 77 WS-PAY-DESC PIC X(20).
000067 77 WS-MAX-ENTRY PIC 9(02) VALUE 30.
000068 *
000069 PROCEDURE DIVISION.
000070 * SEARCH - SERIAL
000071 ACCEPT WS-INPUT
000072 DISPLAY 'START SEARCH:' WS-PAY-CODE
000073 DISPLAY 'INPUT PAY CODE IS:' WS-PAY-CODE
000074 .
000075 SEARCH PAY-CODE-TABLE
000076 VARYING WS-INDEX
000077 AT END DISPLAY ‘ATTENTION: PAY CODE NOT IN THE TABLE!!!'
000078 WHEN
000079 WS-PAY-CODE = PAY-CODE(WS-INDEX)
000080 MOVE PAY-DESC(WS-INDEX) TO WS-PAY-DESC
000081 DISPLAY 'CODE:' WS-PAY-CODE ',DESC IS:' WS-PAY-DESC
000082 WHEN WS-INDEX > WS-MAX-ENTRY
000083 DISPLAY ' PAY CODE NOT FOUND!!!'
000084 .
000085 * SEARCH - BINARY
000086 ACCEPT WS-INPUT
000087 DISPLAY 'START BINARY SEARCH:' WS-PAY-CODE
000088 DISPLAY 'INPUT PAY CODE IS:' WS-PAY-CODE
000089 .
000090 SEARCH ALL PAY-CODE-TABLE
000091 AT END
000092 DISPLAY 'ATTENTION: PAY CODE NOT IN THE TABLE!!!'
000093 WHEN PAY-CODE(WS-INDEX) = WS-PAY-CODE
000094 MOVE PAY-DESC(WS-INDEX) TO WS-PAY-DESC
000095 DISPLAY 'CODE:' WS-PAY-CODE ',DESC IS:' WS-PAY-DESC
000096 END-SEARCH
000097 .
000098 *
000099 STOP RUN.
000100 *
7.2.15 运行作业流（TABLE3）
下面显示的是运行TABLE3程序的作业流，第5行到第7行的SYSIN告诉我们，付款代码11是用顺序查找来检索的，而付款代码18则是使用折半查找方法检索的。
000001 //IBMUSERG JOB ACCT#,IBMUSER,NOTIFY=IBMUSER,MSGLEVEL=(1,1)
000002 //STEP1 EXEC PGM=TABLE3
000003 //STEPLIB DD DSN=IBMUSER.TEST.LOAD,DISP=SHR
000004 //SYSPRINT DD SYSOUT=(*)
000005 //SYSIN DD *
000006 11
000007 18
000008 /
7.2.16 运行结果（TABLE3）
下面显示的是TABLE3程序运行的结果，我们看到，无论是顺序检索和折半检索，都能成功查找到付款代码11和18的付款描述（PAY-DESC）。
000001 START SEARCH:11
000002 INPUT PAY CODE IS:11
000003 CODE:11,DESC IS:SI SETTLEMENT
000004 START BINARY SEARCH:18
000005 INPUT PAY CODE IS:18
000006 CODE:18,DESC IS:INTRA-DAY MARKS