360 lines
16 KiB
COBOL
360 lines
16 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. ZAN02CHK.
|
|
*****************************************************************
|
|
* システム名 : 残業統計管理システム *
|
|
* プログラムID : ZAN02CHK *
|
|
* プログラム名 : 時間帯重複チェック処理 *
|
|
* 作成日 : 2026-06-14 *
|
|
* 処理概要 : OVT-VSORTファイルの同一社員・同一日付内の *
|
|
* 開始時刻と終了時刻の重複をチェックする。 *
|
|
* *
|
|
*****************************************************************
|
|
* 更新履歴 *
|
|
*---------------------------------------------------------------*
|
|
* 更新日付 担当者 更新内容 *
|
|
*---------------------------------------------------------------*
|
|
* 26-06-14 @@@ 新規作成 *
|
|
* *
|
|
*****************************************************************
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
SOURCE-COMPUTER. IBM-ZSERIES.
|
|
OBJECT-COMPUTER. IBM-ZSERIES.
|
|
*
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT R01INNFIL ASSIGN TO ZAN02R01.
|
|
SELECT W01OUTFIL ASSIGN TO ZAN02W01.
|
|
SELECT W02OUTFIL ASSIGN TO ZAN02W02.
|
|
*
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
*
|
|
*****************************************************************
|
|
* ##R01## *
|
|
*****************************************************************
|
|
FD R01INNFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 R01INNREC.
|
|
COPY ZAN01REC REPLACING ==(A)== BY ==R01==.
|
|
*
|
|
*****************************************************************
|
|
* ##W01## *
|
|
*****************************************************************
|
|
FD W01OUTFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS F.
|
|
01 W01OUTREC.
|
|
COPY ZAN01REC REPLACING ==(A)== BY ==W01==.
|
|
*
|
|
*****************************************************************
|
|
* ##W02## *
|
|
*****************************************************************
|
|
FD W02OUTFIL
|
|
LABEL RECORD IS STANDARD
|
|
BLOCK CONTAINS 0
|
|
RECORDING MODE IS V.
|
|
01 W02OUTREC.
|
|
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
|
*
|
|
WORKING-STORAGE SECTION.
|
|
*
|
|
*****************************************************************
|
|
* コンスタント領域 *
|
|
*****************************************************************
|
|
01 CNSARA.
|
|
03 CNS-PRGIDX PIC X(008) VALUE 'ZAN02CHK'.
|
|
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-CAT02 PIC 9(002) VALUE 02.
|
|
*
|
|
*****************************************************************
|
|
* カウンタ領域 *
|
|
*****************************************************************
|
|
01 CUNARA.
|
|
03 CUN-R01INN 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.
|
|
*
|
|
*****************************************************************
|
|
* 作業領域 *
|
|
*****************************************************************
|
|
01 WRKARA.
|
|
*** 運用日付
|
|
03 WRK-U06 PIC 9(008).
|
|
*** 読込フラグ
|
|
03 WRK-R01EOF PIC X(001).
|
|
*** 前レコード保持
|
|
03 WRK-PREV-REC.
|
|
05 WRK-PREV-APPL-ID PIC X(008).
|
|
05 WRK-PREV-EMP-ID PIC 9(008).
|
|
05 WRK-PREV-APPL-DATE PIC 9(008).
|
|
05 WRK-PREV-START-TIME PIC 9(004).
|
|
05 WRK-PREV-END-TIME PIC 9(004).
|
|
05 WRK-PREV-STATUS PIC X(001).
|
|
05 WRK-PREV-OVT-TYPE PIC X(001).
|
|
05 WRK-PREV-FILLER PIC X(046).
|
|
*
|
|
*****************************************************************
|
|
* サブプログラム連絡領域 *
|
|
*****************************************************************
|
|
*** 運用日付取得
|
|
COPY ZANDATAC.
|
|
*** メッセージ編集出力SR用
|
|
COPY ZANMSGAC.
|
|
*** ABEND処理SR用
|
|
COPY ZANENDAC.
|
|
*
|
|
PROCEDURE DIVISION.
|
|
*****************************************************************
|
|
* サブモジュールNO: (0.0) *
|
|
* サブモジュール名: 制御処理 *
|
|
* 処理概要 : メインコントロール処理 *
|
|
*****************************************************************
|
|
0000MAJCOLSOR SECTION.
|
|
*
|
|
*** 初期処理
|
|
PERFORM 1000ITTSOR.
|
|
*
|
|
*** メイン処理
|
|
PERFORM 2000MAJSOR
|
|
UNTIL WRK-R01EOF = '1'.
|
|
*
|
|
*** 終了処理
|
|
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 = ZERO
|
|
MOVE D01UBSUDATE TO WRK-U06
|
|
ELSE
|
|
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
|
|
OUTPUT W01OUTFIL
|
|
W02OUTFIL.
|
|
*
|
|
*** #R01#を読み込み
|
|
PERFORM 1100R01INNSOR.
|
|
*
|
|
*** 1件目W01出力(前レコード初期化)
|
|
IF WRK-R01EOF NOT = '1'
|
|
MOVE R01INNREC TO WRK-PREV-REC
|
|
MOVE R01INNREC TO W01OUTREC
|
|
WRITE W01OUTREC
|
|
ADD 1 TO CUN-W01OUT
|
|
PERFORM 1100R01INNSOR
|
|
END-IF.
|
|
*
|
|
1000ITTSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(1.1) *
|
|
* サブモジュール名:##R01##読込処理 *
|
|
* 処理概要 : レコード読込・EOF判定処理 *
|
|
*****************************************************************
|
|
1100R01INNSOR SECTION.
|
|
*
|
|
READ R01INNFIL
|
|
AT END
|
|
MOVE '1' TO WRK-R01EOF
|
|
NOT AT END
|
|
ADD 1 TO CUN-R01INN
|
|
END-READ.
|
|
*
|
|
1100R01INNSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.0) *
|
|
* サブモジュール名: 主処理 *
|
|
* 処理概要 : 時間帯重複チェック処理 *
|
|
*****************************************************************
|
|
2000MAJSOR SECTION.
|
|
*
|
|
IF WRK-R01EOF NOT = '1'
|
|
*** 重複チェック
|
|
PERFORM 2010CHECKDUPSOR
|
|
*** 次のレコード読込
|
|
PERFORM 1100R01INNSOR
|
|
END-IF.
|
|
*
|
|
2000MAJSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.1) *
|
|
* サブモジュール名: 重複チェック処理 *
|
|
* 処理概要 : 前レコードとの重複判定 *
|
|
*****************************************************************
|
|
2010CHECKDUPSOR SECTION.
|
|
*
|
|
*** 同一社員番号かつ同一日付の判定
|
|
IF WRK-PREV-EMP-ID = R01EMP-ID
|
|
AND WRK-PREV-APPL-DATE = R01APPL-DATE
|
|
*** 前終了時刻 > 現開始時刻 → 重複
|
|
IF WRK-PREV-END-TIME > R01START-TIME
|
|
PERFORM 2011OVERLAPERRSOR
|
|
ELSE
|
|
PERFORM 2012NORMALOUTSOR
|
|
END-IF
|
|
ELSE
|
|
*** キーブレイク
|
|
PERFORM 2013KEYBRSOR
|
|
END-IF.
|
|
*
|
|
2010CHECKDUPSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.1-1) *
|
|
* サブモジュール名: 重複エラー処理 *
|
|
* 処理概要 : エラーログW02出力 *
|
|
*****************************************************************
|
|
2011OVERLAPERRSOR SECTION.
|
|
*
|
|
INITIALIZE W02OUTREC.
|
|
MOVE CNS-ERR-CAT02 TO W02ERR-CATEGORY.
|
|
STRING 'OVERLAP: '
|
|
WRK-PREV-EMP-ID ','
|
|
WRK-PREV-APPL-DATE
|
|
DELIMITED BY SIZE
|
|
INTO W02ERR-DETAIL.
|
|
WRITE W02OUTREC.
|
|
ADD 1 TO CUN-W02OUT.
|
|
*
|
|
2011OVERLAPERRSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.1-2) *
|
|
* サブモジュール名: 通常出力処理 *
|
|
* 処理概要 : W01ファイル出力 *
|
|
*****************************************************************
|
|
2012NORMALOUTSOR SECTION.
|
|
*
|
|
MOVE R01INNREC TO W01OUTREC.
|
|
WRITE W01OUTREC.
|
|
ADD 1 TO CUN-W01OUT.
|
|
*
|
|
*** 前レコード更新
|
|
MOVE R01INNREC TO WRK-PREV-REC.
|
|
*
|
|
2012NORMALOUTSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(2.1-3) *
|
|
* サブモジュール名: キーブレイク処理 *
|
|
* 処理概要 : 前レコード更新 *
|
|
*****************************************************************
|
|
2013KEYBRSOR SECTION.
|
|
*
|
|
MOVE R01INNREC TO WRK-PREV-REC.
|
|
PERFORM 2012NORMALOUTSOR.
|
|
*
|
|
2013KEYBRSOR-EXT.
|
|
EXIT.
|
|
*****************************************************************
|
|
* サブモジュールNO:(3.0) *
|
|
* サブモジュール名: 終了処理 *
|
|
* 処理概要 : ファイルクローズ・件数と終了メッセージ出力 *
|
|
*****************************************************************
|
|
3000STPSOR SECTION.
|
|
*
|
|
*** 入出力ファイルCLOSE
|
|
CLOSE R01INNFIL
|
|
W01OUTFIL
|
|
W02OUTFIL.
|
|
*
|
|
*** 入出力ファイル件数出力
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
|
MOVE 'ZAN02R01' TO M00UMKDATS22-01.
|
|
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
|
MOVE 'ZAN02W01' TO M00UMKDATS22-01.
|
|
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
|
PERFORM 4000MSGOUTSOR.
|
|
*
|
|
INITIALIZE M00MHOPAR.
|
|
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
|
MOVE 'ZAN02W02' TO M00UMKDATS22-01.
|
|
MOVE CUN-W02OUT 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. |