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.