IDENTIFICATION DIVISION. PROGRAM-ID. ZAN04MAT. ***************************************************************** * システム名 : 残業統計管理システム * * プログラムID : ZAN04MAT * * プログラム名 : 取消マッチング処理 * * 作成日 : 2026-06-15 * * 処理概要 : OVT-SORTED（有効申請）とOVT-CSORT * * （取消申請）を申請番号で1:1マッチングし、 * * 結果を振り分ける。 * * * ***************************************************************** * 更新履歴 * *---------------------------------------------------------------* * 更新日付 担当者 更新内容 * *---------------------------------------------------------------* * 26-06-15 @@@ 新規作成 * * * ***************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-ZSERIES. OBJECT-COMPUTER. IBM-ZSERIES. * INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT R01INNFIL ASSIGN TO ZAN04R01. SELECT R02INNFIL ASSIGN TO ZAN04R02. SELECT W01OUTFIL ASSIGN TO ZAN04W01. SELECT W02OUTFIL ASSIGN TO ZAN04W02. SELECT W03OUTFIL ASSIGN TO ZAN04W03. * DATA DIVISION. FILE SECTION. * ***************************************************************** * R01 (OVT-SORTED) * ***************************************************************** FD R01INNFIL LABEL RECORD IS STANDARD BLOCK CONTAINS 0 RECORDING MODE IS F. 01 R01INNREC. COPY ZAN01REC REPLACING ==(A)== BY ==R01==. * ***************************************************************** * R02 (OVT-CSORT) * ***************************************************************** FD R02INNFIL LABEL RECORD IS STANDARD BLOCK CONTAINS 0 RECORDING MODE IS F. 01 R02INNREC. COPY ZAN01REC REPLACING ==(A)== BY ==R02==. * ***************************************************************** * W01 (OVT-MATCHED) * ***************************************************************** FD W01OUTFIL LABEL RECORD IS STANDARD BLOCK CONTAINS 0 RECORDING MODE IS F. 01 W01OUTREC. COPY ZAN02REC REPLACING ==(A)== BY ==W01==. * ***************************************************************** * W02 (OVT-DBCLEAN) * ***************************************************************** FD W02OUTFIL LABEL RECORD IS STANDARD BLOCK CONTAINS 0 RECORDING MODE IS F. 01 W02OUTREC. COPY ZAN04REC REPLACING ==(A)== BY ==W02==. * ***************************************************************** * W03 (ERROR-LOG) * ***************************************************************** FD W03OUTFIL LABEL RECORD IS STANDARD BLOCK CONTAINS 0 RECORDING MODE IS V. 01 W03OUTREC. COPY ZAN05REC REPLACING ==(A)== BY ==W03==. * WORKING-STORAGE SECTION. * ***************************************************************** * コンスタント領域 * ***************************************************************** 01 CNSARA. 03 CNS-PRGIDX PIC X(008) VALUE 'ZAN04MAT'. 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 CNS-ERR-CAT04 PIC 9(002) VALUE 04. 01 CNS-PROC-SEQ01 PIC 9(002) VALUE 01. * ***************************************************************** * カウンタ領域 * ***************************************************************** 01 CUNARA. 03 CUN-R01INN PIC S9(009) COMP-3 VALUE ZERO. 03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO. 03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO. 03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO. 03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO. * ***************************************************************** * 作業領域 * ***************************************************************** 01 WRKARA. *** マッチングキー 03 WRK-R01KEY PIC X(008). 03 WRK-R02KEY PIC X(008). * ***************************************************************** * サブプログラム連絡領域 * ***************************************************************** *** 運用日付取得 COPY ZANDATAC. *** メッセージ編集出力SR用 COPY ZANMSGAC. *** ABEND処理SR用 COPY ZANENDAC. * PROCEDURE DIVISION. ***************************************************************** * サブモジュールNO: (0.0) * * サブモジュール名: 制御処理 * * 処理概要 : メインコントロール処理 * ***************************************************************** 0000MAJCOLSOR SECTION. * *** 初期処理 PERFORM 1000ITTSOR. * *** メイン処理 PERFORM 2000MAJSOR UNTIL WRK-R01KEY = HIGH-VALUE AND WRK-R02KEY = HIGH-VALUE. * *** 終了処理 PERFORM 3000STPSOR. * 0000MAJCOLSOR-EXT. 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-01. MOVE 'COMPILED' TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * *** ワークエリア初期化 INITIALIZE WRKARA. * *** 運用日付取得 INITIALIZE D01UBSPAR. CALL 'SUB01DAT' USING D01UBSPAR. IF D01FKICOD NOT = ZERO INITIALIZE M00MHOPAR MOVE CNS-MSGSUBEEK TO M00MSGCOD MOVE 'SUB01DAT' TO M00UMKDATS22-01 MOVE D01FKICOD TO M00UMKDATS22-02 PERFORM 4000MSGOUTSOR PERFORM 9999ABDSOR END-IF. * *** 入出力ファイルOPEN OPEN INPUT R01INNFIL R02INNFIL OUTPUT W01OUTFIL W02OUTFIL W03OUTFIL. * *** R01を読み込み PERFORM 1100R01INNSOR. *** R02を読み込み PERFORM 1200R02INNSOR. * 1000ITTSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(1.1) * * サブモジュール名:R01読込処理 * * 処理概要 : レコード読込・キー設定 * ***************************************************************** 1100R01INNSOR SECTION. * READ R01INNFIL AT END MOVE HIGH-VALUE TO WRK-R01KEY NOT AT END ADD 1 TO CUN-R01INN MOVE R01APPL-ID TO WRK-R01KEY END-READ. * 1100R01INNSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(1.2) * * サブモジュール名:R02読込処理 * * 処理概要 : レコード読込・キー設定 * ***************************************************************** 1200R02INNSOR SECTION. * READ R02INNFIL AT END MOVE HIGH-VALUE TO WRK-R02KEY NOT AT END ADD 1 TO CUN-R02INN MOVE R02APPL-ID TO WRK-R02KEY END-READ. * 1200R02INNSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(2.0) * * サブモジュール名:主処理 * * 処理概要 : マッチング（1:1）を行う * ***************************************************************** 2000MAJSOR SECTION. * EVALUATE TRUE *** マッチ WHEN WRK-R01KEY = WRK-R02KEY PERFORM 2100MATCHSOR PERFORM 1100R01INNSOR PERFORM 1200R02INNSOR *** R01のみ WHEN WRK-R01KEY < WRK-R02KEY PERFORM 2200R01OUTSOR PERFORM 1100R01INNSOR *** R02のみ WHEN WRK-R01KEY > WRK-R02KEY PERFORM 2300R02OUTSOR PERFORM 1200R02INNSOR END-EVALUATE. * 2000MAJSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(2.1) * * サブモジュール名:マッチ時処理 * * 処理概要 : 取消済み申請をERROR-LOGに出力 * ***************************************************************** 2100MATCHSOR SECTION. * *** ERROR-LOG出力（監査証跡） INITIALIZE W03OUTREC. MOVE CNS-ERR-CAT04 TO W03ERR-CATEGORY. STRING 'CANCEL-MATCH: ' R01APPL-ID ' ' R01EMP-ID ' ' R01APPL-DATE ' ' R01START-TIME ' ' R01END-TIME DELIMITED BY SIZE INTO W03ERR-DETAIL. WRITE W03OUTREC. ADD 1 TO CUN-W03OUT. * 2100MATCHSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(2.2) * * サブモジュール名:R01のみ処理 * * 処理概要 : 有効申請をOVT-MATCHEDに出力 * ***************************************************************** 2200R01OUTSOR SECTION. * *** OVT-MATCHED出力（STRING編集） INITIALIZE W01OUTREC. STRING R01APPL-ID DELIMITED BY SIZE R01EMP-ID DELIMITED BY SIZE R01APPL-DATE DELIMITED BY SIZE R01START-TIME DELIMITED BY SIZE R01END-TIME DELIMITED BY SIZE R01STATUS DELIMITED BY SIZE R01OVT-TYPE DELIMITED BY SIZE CNS-PROC-SEQ01 DELIMITED BY SIZE INTO W01OUTREC. WRITE W01OUTREC. ADD 1 TO CUN-W01OUT. * 2200R01OUTSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(2.3) * * サブモジュール名:R02のみ処理 * * 処理概要 : 取消申請をOVT-DBCLEANに出力 * ***************************************************************** 2300R02OUTSOR SECTION. * *** OVT-DBCLEAN出力 INITIALIZE W02OUTREC. MOVE R02APPL-ID TO W02APPL-ID. WRITE W02OUTREC. ADD 1 TO CUN-W02OUT. * 2300R02OUTSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(3.0) * * サブモジュール名:終了処理 * * 処理概要 : ファイルクローズ・件数と終了メッセージ出力 * ***************************************************************** 3000STPSOR SECTION. * *** 入出力ファイルCLOSE CLOSE R01INNFIL R02INNFIL W01OUTFIL W02OUTFIL W03OUTFIL. * *** 入出力ファイル件数出力 INITIALIZE M00MHOPAR. MOVE CNS-MSGIINKES TO M00MSGCOD. MOVE 'ZAN04R01' TO M00UMKDATS22-01. MOVE CUN-R01INN TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * INITIALIZE M00MHOPAR. MOVE CNS-MSGIINKES TO M00MSGCOD. MOVE 'ZAN04R02' TO M00UMKDATS22-01. MOVE CUN-R02INN TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * INITIALIZE M00MHOPAR. MOVE CNS-MSGOUTKES TO M00MSGCOD. MOVE 'ZAN04W01' TO M00UMKDATS22-01. MOVE CUN-W01OUT TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * INITIALIZE M00MHOPAR. MOVE CNS-MSGOUTKES TO M00MSGCOD. MOVE 'ZAN04W02' TO M00UMKDATS22-01. MOVE CUN-W02OUT TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * INITIALIZE M00MHOPAR. MOVE CNS-MSGOUTKES TO M00MSGCOD. MOVE 'ZAN04W03' TO M00UMKDATS22-01. MOVE CUN-W03OUT TO M00UMKDATS22-02. PERFORM 4000MSGOUTSOR. * *** 終了メッセージ出力 INITIALIZE M00MHOPAR. MOVE CNS-MSGFIN TO M00MSGCOD. PERFORM 4000MSGOUTSOR. * 3000STPSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(4.0) * * サブモジュール名:メッセージ編集出力処理 * * 処理概要 : メッセージ編集出力サブPGM呼出 * ***************************************************************** 4000MSGOUTSOR SECTION. * MOVE CNS-KN0002 TO M00UMKDATS22-03(1:1). MOVE CNS-KN0002 TO M00UMKDATS22-04(1:1). MOVE CNS-PRGIDX TO M00UMKDATS22-05. CALL 'SUB02MSG' USING M00MHOPAR. * 4000MSGOUTSOR-EXT. EXIT. ***************************************************************** * サブモジュールNO:(9.9) * * サブモジュール名:ABEND処理 * * 処理概要 : ABENDサブPGM呼出 * ***************************************************************** 9999ABDSOR SECTION. * MOVE CNS-ABD999 TO E01ABDCOD. CALL 'SUB03END' USING E01ABDPAR. * 9999ABDSOR-EXT. EXIT.