以下のCOBOLの例は、リリース テープの<dbcpfx>.SAMPLIB (CHKTRANB)にあります。
このプロシージャはCOBUCL execを実行します。COBUCL execは入力ソースをプログラム製品IKFCBL00を使用してコンパイルし、オブジェクト モジュールをメンバーChktranとしてUSER loadlibに連係編集します。
//USERJOBUSER JOB (20750000),'USERNAME',MSGCLASS=A,NOTIFY=USER,
// CLASS=B,MSGLEVEL=(1,1),REGION=5120K
//COBCOMPL EXEC COBUCL
//COB.SYSIN DD *
IDENTIFICATION DIVISION.
PROGRAM-ID. CHKTRAN.
AUTHOR. USER.
INSTALLATION. TERADATA.
DATE-WRITTEN. 12 AUGUST 1992
DATE_COMPLIED.
SECURITY. OPEN.
REMARKS.
THIS PROCEDURE IS INVOKED BY THE TERADATA FASTEXPORT
UTILITY TO PROCESS THE RESPONSE DATA RETURNED FROM
THE SAMPLE SELECT. THE PROCEDURE EXAMINES EACH
RESPONSE RECORD TO DETERMINE IF THE RECORD SHOULD BE
WRITTEN TO AN ERROR DATA SET AND THEN EITHER DROPPED
OR WRITTEN TO THE STANDARD DATA SET. ONE ERROR DATA
SET CONTAINS RECORDS WITH A NULL REGION CODE. THE
OTHER ERROR DATA SET CONTAINS RECORDS WITH A TOTAL
SALES VALUE OF LESS THAN $100. THESE LATTER RECORDS
ARE NOT WRITTEN TO THE STANDARD DATA SET.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-370.
OBJECT-COMPUTER. IBM-370.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SALES-DROPPED-FILE ASSIGN TO FILE1OUT.
SELECT BAD-REGN-SALES-FILE ASSIGN TO FILE2OUT.
DATA DIVISION.
FILE SECTION.
FD SALES-DROPPED-FILE
BLOCK CONTAINS 160 RECORDS
LABEL RECORDS STANDARD.
01 DROPPED-TRANLOG.
02 INDICATORS PIC 9.
02 REGN PIC XXX.
02 PRODUCT PIC X(8).
02 QTY PIC S9(8) COMP.
02 PRICE PIC S9(8) COMP.
FD BAD-REGN-SALES-FILE
BLOCK CONTAINS 160 RECORDS
LABEL RECORDS STANDARD.
01 BAD-REGN-TRANLOG.
02 INDICATORS PIC 9.
02 REGN PIC XXX.
02 PRODUCT PIC X(8).
02 QTY PIC S9(8) COMP.
02 PRICE PIC S9(8) COMP.
LINKAGE SECTION.
01 ENTRY-TYPE PIC S9(5) COMP.
01 STATEMENT-NOPIC S9(5) COMP.
01 RECORD-SIZE PIC S9(5) COMP.
01 TRANLOG.
05 INDICATORS PIC 9.
05 REGN PIC XXX.
05 PRODUCT PIC X(8).
05 QTY PIC S9(8) COMP.
05 PRICE PIC S9(8) COMP.
01 OUTPUT-LENGTHPIC S9(5) COMP.
01 OUTPUT-AREA PIC XXXX.
PROCEDURE DIVISION USING
ENTRY-TYPE, STATEMENT-NO, RECORD-SIZE, TRANLOG,
OUTPUT-LENGTH, OUTPUT-AREA.
BEGIN.
MAIN.
IF ENTRY-TYPE = 1 THEN
OPEN OUTPUT SALES-DROPPED-FILE
OPEN OUTPUT BAD-REGN-SALES-FILE
GOBACK.
IF ENTRY-TYPE = 2 THEN
CLOSE SALES-DROPPED-FILE
CLOSE BAD-REGN-SALES-FILE
GOBACK.
IF ENTRY-TYPE = 3 THEN
PERFORM TYPE-3
GOBACK.
IF ENTRY-TYPE = 4 THEN
GOBACK.
IF ENTRY-TYPE = 5 THEN
CLOSE SALES-DROPPED-FILE
OPEN OUTPUT SALES-DROPPED-FILE
CLOSE BAD-REGN-SALES-FILE
OPEN OUTPUT BAD-REGN-SALES-FILE
GOBACK.
IF ENTRY-TYPE = 6 THEN
OPEN OUTPUT SALES-DROPPED-FILE
OPEN OUTPUT BAD-REGN-SALES-FILE
GOBACK.
DISPLAY “Invalid entry code = ” ENTRY-TYPE.
GOBACK.
TYPE-3.
IF QTY IN TRANLOG * PRICE IN TRANLOG < 100 THEN
MOVE 0 TO RECORD-SIZE
WRITE DROPPED-TRANLOG FROM TRANLOG
ELSE
PERFORM TEST-NULL-REGN.
TEST-NULL-REGN.
IF REGN IN TRANLOG = SPACES
MOVE 999 TO REGN IN TRANLOG
WRITE BAD-REGN-TRANLOG FROM TRANLOG.
/*
//LKED.SYSLMOD DD DSN=USERLOADLIB(CHKTRAN),DISP=MOD
//LKED.SYSIN DD *
MODE AMODE(24) RMODE(24)
ENTRY CHKTRAN
NAME CHKTRAN(R)
/*