433 lines
20 KiB
COBOL
433 lines
20 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. SAN01MAT.
|
|
*****************************************************************
|
|
* システム名 : サンプルシステム *
|
|
* プログラムID : SAN01MAT *
|
|
* プログラム名 : ＸＸＸＸＸＸ処理 *
|
|
* 作成日 : YYYY-MM-DD *
|
|
* 処理概要 : マッチング（1:1）を行う。 *
|
|
* マッチの場合、ファイルW01を出力する。 *
|
|
* ファイルR01のみの場合ファイルW02を出力する。*
|
|
* ファイルR02のみの場合ファイルW03を出力する。*
|
|
* *
|
|
*****************************************************************
|
|
* 更新履歴 *
|
|
*---------------------------------------------------------------*
|
|
* 更新日付 担当者 更新内容 *
|
|
*---------------------------------------------------------------*
|
|
* YY-MM-DD @@@ 新規作成 *
|
|
* *
|
|
*****************************************************************
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
SOURCE-COMPUTER. IBM-ZSERIES.
|
|
OBJECT-COMPUTER. IBM-ZSERIES.
|
|
*
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT R01INNFIL ASSIGN TO SAN01R01.
|
|
SELECT R02INNFIL ASSIGN TO SAN01R02.
|
|
SELECT W010UTFIL ASSIGN TO SAN01W01.
|
|
SELECT W020UTFIL ASSIGN TO SAN01W02.
|
|
SELECT W030UTFIL ASSIGN TO SAN01W03.
|
|
*
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
*
|
|
*****************************************************************
|
|
* ##RO1## *
|
|
*****************************************************************
|
|
FD R01INNFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 RO1INNREC.
|
|
COPY BBBBBFC REPLACING ==(A)== BY ==R01==.
|
|
*
|
|
*****************************************************************
|
|
* ##RO2## *
|
|
*****************************************************************
|
|
FD R02INNFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 RO2INNREC.
|
|
COPY BBBBBFC REPLACING ==(A)== BY ==R02==.
|
|
*
|
|
*****************************************************************
|
|
* ##WO1## *
|
|
*****************************************************************
|
|
FD W010UTFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 WO10UTREC.
|
|
COPY BBBBBFC REPLACING ==(A)== BY ==WO1==.
|
|
*
|
|
*****************************************************************
|
|
* ##WO2## *
|
|
*****************************************************************
|
|
FD W020UTFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 WO20UTREC.
|
|
COPY BBBBBFC REPLACING ==(A)== BY ==WO2==.
|
|
*
|
|
*****************************************************************
|
|
* ##W03## *
|
|
*****************************************************************
|
|
FD W030UTFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 WO30UTREC.
|
|
COPY BBBBBFC REPLACING ==(A)== BY ==WO3==.
|
|
*
|
|
WORKING-STORAGE SECTION.
|
|
*
|
|
*****************************************************************
|
|
* SYSIN領域 *
|
|
*****************************************************************
|
|
*01 SYSARA.
|
|
*
|
|
*****************************************************************
|
|
* コンスタント領域 *
|
|
*****************************************************************
|
|
01 CNSARA.
|
|
03 CNS-PRGIDX PIC X(008) VALUE 'SAN01MAT'.
|
|
03 CNS-UNYSUTKES-1 PIC X(001) VALUE '1'.
|
|
03 CNS-CFKFCA PIC X(001) VALUE 'N'.
|
|
03 CNS-MSGSTR PIC 9(003) VALUE 001.
|
|
03 CNS-MSGFIN PIC 9(003) VALUE 002.
|
|
03 CNS-MSGSUBEEK PIC 9(003) VALUE 005.
|
|
03 CNS-MSGIINKES PIC 9(003) VALUE 006.
|
|
03 CNS-MSGOUTKES PIC 9(003) VALUE 007.
|
|
03 CNS-MSGKEYINF PIC 9(003) VALUE 033.
|
|
03 CNS-KN0002 PIC 9(001) VALUE 2.
|
|
03 CNS-ABD999 PIC 9(003) VALUE 999.
|
|
*
|
|
*****************************************************************
|
|
* フラグ領域 *
|
|
*****************************************************************
|
|
*01 FLGARA.
|
|
*
|
|
*****************************************************************
|
|
* カウンタ領域 *
|
|
*****************************************************************
|
|
01 CUNARA.
|
|
03 CUN-RO1INN PIC S9(009) COMP-3 VALUE ZERO.
|
|
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
|
03 CUN-WO1OUT PIC S9(009) COMP-3 VALUE ZERO.
|
|
03 CUN-WO2OUT PIC S9(009) COMP-3 VALUE ZERO.
|
|
03 CUN-WO3OUT PIC S9(009) COMP-3 VALUE ZERO.
|
|
*
|
|
*****************************************************************
|
|
* 作業領域 *
|
|
*****************************************************************
|
|
01 WRKARA.
|
|
*** 運用日付
|
|
03 WRK-U06 PIC 9(008).
|
|
03 WRK-U06ARA REDEFINES WRK-U06.
|
|
05 WRK-UYOYMX PIC 9(006).
|
|
05 WRK-UYOHII PIC 9(002).
|
|
*** マッチングキー
|
|
03 WRK-R01KEY.
|
|
05 WRK-R01KEY001 PIC X(010).
|
|
05 WRK-R01KEY002 PIC X(010).
|
|
05 WRK-R01KEY003 PIC X(010).
|
|
03 WRK-R02KEY.
|
|
05 WRK-R02KEY001 PIC X(010).
|
|
05 WRK-R02KEY002 PIC X(010).
|
|
05 WRK-R02KEY003 PIC X(010).
|
|
*
|
|
*****************************************************************
|
|
* サブプログラム連絡領域 *
|
|
*****************************************************************
|
|
*** 運用日付取得
|
|
COPY D01010AC.
|
|
*** 入力件数表示／入力レコードシーケンスチェックSR用
|
|
COPY S01MSGAC.
|
|
*** メッセージ編集出力SR用
|
|
COPY MSG000AC.
|
|
*
|
|
PROCEDURE DIVISION.
|
|
*****************************************************************
|
|
* サブモジュールNO: (0.0) *
|
|
* サブモジュール名: 制御処理 *
|
|
* 処理概要 : メインコントロール処理 *
|
|
*****************************************************************
|
|
0000MAJCOLSOR SECTION.
|
|
*
|
|
*** 初期処理
|
|
PERFORM 1000ITTSOR.
|
|
*
|
|
*** メイン処理
|
|
PERFORM 2000MAJSOR
|
|
UNTIL WRK-R01KEY = HIGH-VALUE
|
|
AND WRK-R02KEY = HIGH-VALUE.
|
|
*
|
|
*** 終了処理
|
|
PERFORM 3000STPSOR.
|
|
*
|
|
0000MAJCOLSOREXT.
|
|
GOBACK.
|
|
*****************************************************************
|
|
* サブモジュールNO: (1.0) *
|
|
* サブモジュール名: 初期処理 *
|
|
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
|
|
*****************************************************************
|
|
1000ITTSOR SECTION.
|
|
*
|
|
*** 開始メッセージ出力
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGSTR TO M00MSGCOD.
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
*** コンバイル日時出力
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
|
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22(1).
|
|
MOVE 'COMPILED' TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
*** ワークエリア初期化
|
|
INITIALIZE WRKARA.
|
|
*
|
|
*** 運用日付取得
|
|
INITIALIZE D01UBSPAR.
|
|
CALL 'DAT01S0' USING D01UBSPAR.
|
|
IF D01FKICOD = ZERO
|
|
MOVE D01U06 TO WRK-U06
|
|
ELSE
|
|
INITIALIZE M00MHOPAR
|
|
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
|
MOVE 'DAT01SO' TO M00UMKDATS22(1)
|
|
MOVE D01FKICOD TO M00UMKDATS22(2)
|
|
PERFORM 4000MSGOUTSOR
|
|
PERFORM 9999ABDSOR
|
|
END-IF.
|
|
*
|
|
*** 入出力ファイルOPEN
|
|
OPEN INPUT R01INNFIL
|
|
R02INNFIL
|
|
OUTPUT W010UTFIL
|
|
W020UTFIL
|
|
W030UTFIL.
|
|
*
|
|
*** #R01#を読み込み
|
|
PERFORM 1100R01INNSOR.
|
|
*** #R02#を読み込み
|
|
PERFORM 1200R02INNSOR.
|
|
*
|
|
1000ITTSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(1.1) *
|
|
* サブモジュール名:##RO1#＃読込処理 *
|
|
* 処理概要 :レコード読込・キー設定・SEQチェック処理 *
|
|
*****************************************************************
|
|
1100R01INNSOR SECTION.
|
|
*
|
|
READ R01INNFIL
|
|
AT END
|
|
MOVE HIGH-VALUE TO WRK-R01KEY
|
|
NOT AT END
|
|
ADD 1 TO CUN-RO1INN
|
|
MOVE R01A001 TO WRK-R01KEY001
|
|
MOVE R01A002 TO WRK-R01KEY002
|
|
MOVE R01A003 TO WRK-R01KEY003
|
|
*** 入力件数表示／シーケンスチェック処理
|
|
MOVE 'SAN01R01' TO S01DDM.
|
|
MOVE CNS-UNYSUTKES-1 TO SO1HYOKESKJCKUB
|
|
MOVE CNS-CFKFCA TO S01JKDKIYFLG
|
|
MOVE WRK-R01KEY TO SO1SEQCECKOM
|
|
COPY CHK01SRP REPLACING ==(A)==BY ==S01==.
|
|
END-READ.
|
|
*
|
|
1100R01INNSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(1.2) *
|
|
* サブモジュール名:##RO2#＃読込処理 *
|
|
* 処理概要 :レコード読込・キー設定・SEQチェック処理 *
|
|
*****************************************************************
|
|
1200R02INNSOR SECTION.
|
|
*
|
|
READ R02INNFIL
|
|
AT END
|
|
MOVE HIGH-VALUE TO WRK-R02KEY
|
|
NOT AT END
|
|
ADD 1 TO CUN-R02INN
|
|
MOVE R02A001 TO WRK-R02KEY001
|
|
MOVE R02A002 TO WRK-R02KEY002
|
|
MOVE R02A003 TO WRK-R02KEY003
|
|
*** 入力件数表示／シーケンスチェック処理
|
|
MOVE 'SAN01R02' TO S01DDM.
|
|
MOVE CNS-UNYSUTKES-1 TO SO1HYOKESKJCKUB
|
|
MOVE CNS-CFKFCA TO S01JKDKIYFLG
|
|
MOVE WRK-R02KEY TO SO1SEQCECKOM
|
|
COPY CHK01SRP REPLACING ==(A)== BY ==S01==.
|
|
END-READ.
|
|
*
|
|
1200R02INNSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブプログラムNO:(2.0) *
|
|
* サブプログラム名:主処理 *
|
|
* 処理概要 :マッチング（1:1）を行う *
|
|
*****************************************************************
|
|
2000MAJSOR SECTION.
|
|
*
|
|
EVALUATE TRUE
|
|
*** マッチ
|
|
WHEN WRK-R01KEY = WRK-R02KEY
|
|
*** #WO1#を編集出力処理
|
|
PERFORM 2100W010UTSOR
|
|
*
|
|
*** #RO1#を読み込み
|
|
PERFORM 1100R01INNSOR
|
|
*** #RO2#を読み込み
|
|
PERFORM 1200R02INNSOR
|
|
*
|
|
*** アンマッチ(##R01##のみ)
|
|
WHEN WRK-R01KEY < WRK-R02KEY
|
|
*** #WO2#を編集出力処理
|
|
PERFORM 2200W020UTSOR
|
|
*
|
|
*** #RO1#を読み込み
|
|
PERFORM 1100R01INNSOR
|
|
*
|
|
*** アンマッチ(##R02##のみ)
|
|
WHEN WRK-R01KEY > WRK-R02KEY
|
|
*** #WO3#を編集出力処理
|
|
PERFORM 2300W030UTSOR
|
|
*
|
|
*** #R02#を読み込み
|
|
PERFORM 1200R02INNSOR
|
|
END-EVALUATE.
|
|
*
|
|
2000MAJSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.1) *
|
|
* サブモジュール名:##WO1#＃編集出力処理 *
|
|
* 処理概要 :レコード編集・出力処理 *
|
|
*****************************************************************
|
|
2100W010UTSOR SECTION.
|
|
*
|
|
MOVE RO1INNREC TO W010UTREC.
|
|
MOVE R02INNREC TO W010UTREC.
|
|
*
|
|
WRITE WO1OUTREC.
|
|
ADD 1 TO CUN-WO1OUT.
|
|
|
|
2100W010UTSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブプログラムNO:(2.2) *
|
|
* サブプログラム名:##WO2#を編集出力処理 *
|
|
* 処理概要 :レコード編集・出力処理 *
|
|
*****************************************************************
|
|
2200W020UTSOR SECTION.
|
|
*
|
|
MOVE RO1INNREC TO W020UTREC.
|
|
*
|
|
WRITE WO2OUTREC.
|
|
ADD 1 TO CUN-WO2OUT.
|
|
*
|
|
2200W020UTSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブプログラムNO:(2.3) *
|
|
* サブプログラム名:##WO3#を編集出力処理 *
|
|
* 処理概要 :レコード編集・出力処理 *
|
|
*****************************************************************
|
|
2300W030UTSOR SECTION.
|
|
*
|
|
MOVE R02INNREC TO W03OUTREC.
|
|
*
|
|
WRITE WO3OUTREC.
|
|
ADD 1 TO CUN-WO3OUT.
|
|
*
|
|
2300W030UTSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(3.0) *
|
|
* サブモジュール名:終了処理 *
|
|
* 処理概要 :ファイルクローズ・件数と終了メッセージ出力 *
|
|
*****************************************************************
|
|
3000STPSOR SECTION.
|
|
*
|
|
*** 入出力ファイルCLOSE
|
|
CLOSE R01INNFIL
|
|
R02INNFIL
|
|
W010UTFIL
|
|
W020UTFIL
|
|
W030UTFIL.
|
|
*
|
|
*** 入出力ファイル件数出力
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'SAN01R01' TO M00UMKDATS22(1).
|
|
MOVE CUN-RO1INN TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'SAN01R02' TO M00UMKDATS22(1).
|
|
MOVE CUN-R02INN TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'SAN01W01' TO M00UMKDATS22(1).
|
|
MOVE CUN-WO1OUT TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'SAN01W02' TO M00UMKDATS22(1).
|
|
MOVE CUN-WO2OUT TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'SAN01W03' TO M00UMKDATS22(1).
|
|
MOVE CUN-WO3OUT TO M00UMKDATS22(2).
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
*** 終了メッセージ出力
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGFIN TO M00MSGCOD.
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
3000STPSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブプログラムNO:(4.0) *
|
|
* サブプログラム名:メッセージ編集出力処理 *
|
|
* 処理概要 :メッセージ編集出力サブPGM呼出 *
|
|
*****************************************************************
|
|
4000MSGOUTSOR SECTION.
|
|
*
|
|
MOVE CNS-KN0002 TO M00KNOCOD
|
|
MOVE CNS-KN0002 TO M00SYUCOD.
|
|
MOVE CNS-PRGIDX TO M00PRGIDX.
|
|
CALL 'MSG0SRP' USING M00MSGPAR.
|
|
*
|
|
4000MSGOUTSOREXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブプログラムNO:(9.9) *
|
|
* サブプログラム名:ABEND処理 *
|
|
* 処理概要 :ABENDサブPGM呼出 *
|
|
*****************************************************************
|
|
9999ABDSOR SECTION.
|
|
*
|
|
MOVE CNS-ABD999 TO M00ABDCOD.
|
|
CALL 'END01TO' USING M00MSGPAR.
|
|
*
|
|
9999ABDSOREXT.
|
|
EXIT.
|