COBOLのOUTMODルーチンの生成 - FastExport

Teradata® FastExportリファレンス

Product
FastExport
Release Number
17.10
Published
2021年6月
Language
日本語
Last Update
2021-09-23
dita:mapPath
ja-JP/qja1608578437326.ditamap
dita:ditavalPath
ja-JP/qja1608578437326.ditaval
dita:id
B035-2410
Product Category
Teradata Tools and Utilities

以下の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)
/*