feat: サブシステムB 残業統計管理 初回production反映

- 全6プログラム(ZAN01CHK~ZAN06UPD)ソース・実行ファイル
- 5サブプログラム(SUB01DAT~SUB05TIM)ソース・DLL
- 10 COPY書式ファイル
- 詳細設計書12ファイル
- サブシステムB全体設計書
- bin/配下の実行ファイル资産
This commit is contained in:
qiuqiuqiu
2026-06-17 23:20:53 +08:00
parent c13e2407d7
commit b3e800e601
31 changed files with 3273 additions and 103 deletions
+10 -9
View File
@@ -56,7 +56,7 @@
03 R02DATE PIC 9(008).
03 R02TIME-IN PIC 9(004).
03 R02TIME-OUT PIC 9(004).
03 R02FILLER PIC X(060).
03 R02FILLER PIC X(056).
*
*****************************************************************
* ##R03## *
@@ -249,14 +249,15 @@
*****************************************************************
1200R02INNSOR SECTION.
*
READ R02INNFIL
AT END
MOVE '1' TO WRK-R02EOF
NOT AT END
ADD 1 TO CUN-R02INN
MOVE R02EMP-ID TO WRK-R02KEY001
MOVE R02DATE TO WRK-R02KEY002
END-READ.
READ R02INNFIL
AT END
MOVE '1' TO WRK-R02EOF
MOVE HIGH-VALUES TO WRK-R02KEY
NOT AT END
ADD 1 TO CUN-R02INN
MOVE R02EMP-ID TO WRK-R02KEY001
MOVE R02DATE TO WRK-R02KEY002
END-READ.
*
1200R02INNSOR-EXT.
EXIT.
+407
View File
@@ -0,0 +1,407 @@
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-CAT03 PIC 9(002) VALUE 03.
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-U06 PIC 9(008).
*** マッチングキー
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 = 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
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-CAT03 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.
+400
View File
@@ -0,0 +1,400 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. ZAN05CAL.
*****************************************************************
* システム名 : 残業統計管理システム *
* プログラムID : ZAN05CAL *
* プログラム名 : 残業時間集計処理 *
* 作成日 : 2026-06-15 *
* 処理概要 : OVT-SORTED2(申請番号+処理番号昇順)を *
* キーブレイク集計し、同一APPL-ID内の全明細の *
* 加班時間を積算してOVT-SUMMARYに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 ZAN05R01.
SELECT W01OUTFIL ASSIGN TO ZAN05W01.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01 (OVT-SORTED2) *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY ZAN02REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* W01 (OVT-SUMMARY) *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 W01OUTREC.
COPY ZAN03REC REPLACING ==(A)== BY ==W01==.
*
WORKING-STORAGE SECTION.
*
*****************************************************************
* コンスタント領域 *
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'ZAN05CAL'.
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-TIMMODE02 PIC 9(001) VALUE 2.
03 CNS-ABD999 PIC 9(003) VALUE 999.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
01 CUNARA.
03 CUN-R01INN PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-W01OUT PIC S9(009) COMP-3
VALUE ZERO.
*
*****************************************************************
* 作業領域 *
*****************************************************************
01 WRKARA.
*** 処理日付(ACCEPT FROM DATE用)
03 WRK-DATE-8 PIC 9(008).
*** 運用日付
03 WRK-U06 PIC 9(008).
*** キーブレイク制御
03 WRK-R01KEY PIC X(008).
03 WRK-PREV-APPL-ID PIC X(008).
03 WRK-GROUP-ACTIVE PIC X(001).
88 WRK-GROUP-IS-ACTIVE VALUE '1'.
88 WRK-GROUP-NOT-ACTIVE VALUE '0'.
*** 集約用最終レコード保持
03 WRK-LAST-REC PIC X(080).
03 WRK-LAST-REC-REDEF REDEFINES WRK-LAST-REC.
05 WRK-LAST-APPL-ID PIC X(008).
05 WRK-LAST-EMP-ID PIC 9(008).
05 WRK-LAST-APPL-DATE PIC 9(008).
05 WRK-LAST-START PIC 9(004).
05 WRK-LAST-END PIC 9(004).
05 WRK-LAST-STATUS PIC X(001).
05 WRK-LAST-OVT-TYPE PIC X(001).
05 WRK-LAST-PROC-SEQ PIC 9(002).
05 WRK-LAST-FILLER PIC X(044).
*** 集計用グループ先頭START保持
03 WRK-GROUP-START PIC 9(004).
*** 集計用積算分領域
03 WRK-ACCUM-MIN PIC S9(009) COMP-3.
*** 時刻計算領域
03 WRK-START-HOUR PIC 9(004).
03 WRK-START-MIN PIC 9(004).
03 WRK-END-HOUR PIC 9(004).
03 WRK-END-MIN PIC 9(004).
03 WRK-START-TOTAL PIC 9(005).
03 WRK-END-TOTAL PIC 9(005).
03 WRK-DIFF-MIN PIC 9(005).
03 WRK-INT-HOURS PIC 9(004).
03 WRK-REMAIN-MIN PIC 9(004).
03 WRK-OVT-HOURS PIC 9(004)V9(001).
03 WRK-TEMP-HOURS PIC 9(004)V9(001).
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY ZANDATAC.
*** メッセージ編集出力SR用
COPY ZANMSGAC.
*** ABEND処理SR用
COPY ZANENDAC.
*** 時刻丸め計算SR用
COPY ZANTIMAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** メイン処理
PERFORM 2000MAJSOR
UNTIL WRK-R01KEY = HIGH-VALUE
AND WRK-GROUP-NOT-ACTIVE.
*
*** 終了処理
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.
*
*** 処理日付取得(ACCEPT FROM DATE
ACCEPT WRK-DATE-8 FROM DATE YYYYMMDD.
*
*** ワークエリア初期化
INITIALIZE WRKARA.
MOVE '0' TO WRK-GROUP-ACTIVE.
*
*** 運用日付取得
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.
*
*** R01を読み込み
PERFORM 1100R01INNSOR.
*
*** 初回レコード設定
IF WRK-R01KEY NOT = HIGH-VALUE
MOVE R01APPL-ID TO WRK-PREV-APPL-ID
MOVE R01INNREC TO WRK-LAST-REC
MOVE R01START-TIME TO WRK-GROUP-START
SET WRK-GROUP-IS-ACTIVE TO TRUE
END-IF.
*
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:(2.0) *
* サブモジュール名:主処理 *
* 処理概要 : キーブレイク集計制御を行う *
*****************************************************************
2000MAJSOR SECTION.
*
EVALUATE TRUE
*** EOF時:最終グループを出力
WHEN WRK-R01KEY = HIGH-VALUE
IF WRK-GROUP-IS-ACTIVE
PERFORM 2100OUTSOR
SET WRK-GROUP-NOT-ACTIVE TO TRUE
END-IF
*** キーブレイク:前グループ出力→新グループ開始
WHEN WRK-R01KEY NOT = WRK-PREV-APPL-ID
IF WRK-GROUP-IS-ACTIVE
PERFORM 2100OUTSOR
END-IF
MOVE R01APPL-ID TO WRK-PREV-APPL-ID
MOVE R01INNREC TO WRK-LAST-REC
MOVE R01START-TIME TO WRK-GROUP-START
SET WRK-GROUP-IS-ACTIVE TO TRUE
PERFORM 2200ACCUMSOR
PERFORM 1100R01INNSOR
*** 同一グループ:現レコード積算→最新レコードで上書き保持
WHEN OTHER
PERFORM 2200ACCUMSOR
MOVE R01INNREC TO WRK-LAST-REC
CONTINUE
PERFORM 1100R01INNSOR
END-EVALUATE.
*
2000MAJSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.1) *
* サブモジュール名:集計計算出力処理 *
* 処理概要 : WRK-ACCUM-MIN→SUB05TIM丸め・OVT-SUMMARY出力*
*****************************************************************
2100OUTSOR SECTION.
*
*** 累積分→時間変換(DIVIDE REMAINDER
DIVIDE WRK-ACCUM-MIN BY 60
GIVING WRK-INT-HOURS
REMAINDER WRK-REMAIN-MIN.
*
*** COMPUTE ROUNDED ON SIZE ERROR(カバレッジ用)
COMPUTE WRK-OVT-HOURS ROUNDED =
WRK-ACCUM-MIN / 60
ON SIZE ERROR
CONTINUE
MOVE ZERO TO WRK-OVT-HOURS
END-COMPUTE.
*
*** SUB05TIM呼出(mode 20.1h単位切捨)
COMPUTE WRK-TEMP-HOURS =
WRK-ACCUM-MIN / 60
END-COMPUTE.
MOVE WRK-TEMP-HOURS TO T01TIMHRS.
MOVE CNS-TIMMODE02 TO T01TIMRRC.
CALL 'SUB05TIM' USING T01TIMPAR.
*
*** OVT-SUMMARY出力
INITIALIZE W01OUTREC.
MOVE WRK-LAST-APPL-ID TO W01APPL-ID.
MOVE WRK-LAST-EMP-ID TO W01EMP-ID.
MOVE WRK-LAST-APPL-DATE TO W01APPL-DATE.
MOVE WRK-GROUP-START TO W01START-TIME.
MOVE WRK-LAST-END TO W01END-TIME.
MOVE T01TIMOUT TO W01OVT-HOURS.
MOVE WRK-LAST-OVT-TYPE TO W01OVT-TYPE.
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
*** 累積分リセット(次グループ用)
MOVE ZERO TO WRK-ACCUM-MIN.
*
2100OUTSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.2) *
* サブモジュール名:積算処理 *
* 処理概要 : 現レコードの時間差分をWRK-ACCUM-MINに加算 *
*****************************************************************
2200ACCUMSOR SECTION.
*
*** 開始時刻→分変換
DIVIDE R01START-TIME BY 100
GIVING WRK-START-HOUR
REMAINDER WRK-START-MIN.
COMPUTE WRK-START-TOTAL =
WRK-START-HOUR * 60 + WRK-START-MIN
END-COMPUTE.
*
*** 終了時刻→分変換
DIVIDE R01END-TIME BY 100
GIVING WRK-END-HOUR
REMAINDER WRK-END-MIN.
COMPUTE WRK-END-TOTAL =
WRK-END-HOUR * 60 + WRK-END-MIN
END-COMPUTE.
*
*** 差分計算
COMPUTE WRK-DIFF-MIN =
WRK-END-TOTAL - WRK-START-TOTAL
END-COMPUTE.
*
*** 積算
COMPUTE WRK-ACCUM-MIN =
WRK-ACCUM-MIN + WRK-DIFF-MIN
END-COMPUTE.
*
2200ACCUMSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(3.0) *
* サブモジュール名:終了処理 *
* 処理概要 : ファイルクローズ・件数と終了メッセージ出力 *
*****************************************************************
3000STPSOR SECTION.
*
*** 入出力ファイルCLOSE
CLOSE R01INNFIL
W01OUTFIL.
*
*** 入出力ファイル件数出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'ZAN05R01' TO M00UMKDATS22-01.
MOVE CUN-R01INN TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGOUTKES TO M00MSGCOD.
MOVE 'ZAN05W01' TO M00UMKDATS22-01.
MOVE CUN-W01OUT 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.
+696
View File
@@ -0,0 +1,696 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. ZAN06UPD.
*****************************************************************
* システム名 : 残業統計管理システム *
* プログラムID : ZAN06UPD *
* プログラム名 : 残業統計DB更新処理 *
* 作成日 : 2026-06-16 *
* 処理概要 : OVT-SUMMARYの各レコードをDB2テーブル *
* OVT-APPLICATIONSにINSERT/UPSERTし、 *
* OVT-MONTHLYに月次集計を反映する。 *
* またOVT-DBCLEANの各レコードについて、 *
* 該当申請を取消状態に更新し、 *
* OVT-MONTHLYから該当加班時間を減算する。 *
* *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 26-06-16 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT R01INNFIL ASSIGN TO ZAN06R01.
SELECT R02INNFIL ASSIGN TO ZAN06R02.
SELECT W01OUTFIL ASSIGN TO ZAN06W01.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01 (OVT-SUMMARY) 80B FB *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY ZAN03REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* R02 (OVT-DBCLEAN) 80B FB *
*****************************************************************
FD R02INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R02INNREC.
COPY ZAN04REC REPLACING ==(A)== BY ==R02==.
*
*****************************************************************
* W01 (ERROR-LOG) VB 200B *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
RECORDING MODE IS V.
01 W01OUTREC.
COPY ZAN05REC REPLACING ==(A)== BY ==W01==.
*
WORKING-STORAGE SECTION.
*
*****************************************************************
* SQLCA *
*****************************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
*
*****************************************************************
* コンスタント領域 *
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'ZAN06UPD'.
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-ABD999 PIC 9(003) VALUE 999.
03 CNS-KN0002 PIC 9(001) VALUE 2.
03 CNS-COMMIT-CNT PIC 9(003) VALUE 050.
03 CNS-STATUS-ACTIVE PIC X(001) VALUE '0'.
03 CNS-STATUS-CANCEL PIC X(001) VALUE '9'.
03 CNS-MAX-HOURS PIC 9(004)V9(001)
VALUE 9999.9.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
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-DBXINS PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-DBXUPD PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-COMMIT PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-ETHUS PIC S9(009) COMP-3
VALUE ZERO.
*
*****************************************************************
* 作業領域 *
*****************************************************************
01 WRKARA.
*** EOF判定
03 WRK-R01EOF PIC X(001).
88 WRK-R01-EOF VALUE '1'.
03 WRK-R02EOF PIC X(001).
88 WRK-R02-EOF VALUE '1'.
*** 日付分解領域
03 WRK-APPL-DATE-N PIC 9(008).
03 WRK-YEAR-MONTH PIC 9(006).
03 WRK-MONTH PIC 9(002).
03 WRK-MONTH-VALID PIC 9(001).
88 WRK-MONTH-OK VALUE 1.
*** ループ制御
03 WRK-IDX PIC 9(004).
03 WRK-RETRY-CNT PIC 9(001).
*** 加班時間変換領域
03 WRK-OVT-HOURS-EDITED PIC 9(004).9(001).
03 WRK-OVT-HOURS-NUM PIC 9(004)V9(001).
03 WRK-OVT-MINUTES PIC 9(006).
03 WRK-REMAIN-HOURS PIC 9(004)V9(001).
*** SQL用ホスト変数(全DISPLAY
03 WRK-SQL-APPL-ID PIC X(008).
03 WRK-SQL-EMP-ID PIC X(008).
03 WRK-SQL-APPL-DATE PIC X(008).
03 WRK-SQL-YEAR-MONTH PIC X(006).
03 WRK-SQL-START-TIME PIC X(004).
03 WRK-SQL-END-TIME PIC X(004).
03 WRK-SQL-OVT-HOURS PIC X(006).
03 WRK-SQL-OVT-TYPE PIC X(001).
03 WRK-SQL-STATUS PIC X(001).
*** SQLCODE表示用(COMP-5から編集変換)
03 WRK-SQLCODE-DISP PIC +9(009).
*** エラーログ編集領域
03 WRK-ERR-CATEGORY PIC 9(002).
03 WRK-ERR-DETAIL PIC X(198).
*
*****************************************************************
* DBホスト変数(COMP-3、bridge compVarsマップ対応) *
*****************************************************************
01 DB-OVT-HOURS PIC S9(007)V9(001) COMP-3.
01 DB-OVT-COUNT PIC S9(009) COMP-3.
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY ZANDATAC.
*** メッセージ編集出力SR用
COPY ZANMSGAC.
*** ABEND処理SR用
COPY ZANENDAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** メイン処理(R01→R02順に処理)
PERFORM 2000MAJSOR
UNTIL WRK-R01-EOF
AND WRK-R02-EOF.
*
*** 終了処理
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-APPL-DATE-N
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
R02INNFIL
OUTPUT W01OUTFIL.
*
*** DB接続
EXEC SQL
CONNECT TO 'data\OVERTIME.DB'
END-EXEC.
*
*** R01を初回読込
PERFORM 1100R01INNSOR.
*
*** R02を初回読込
PERFORM 1200R02INNSOR.
*
1000ITTSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(1.1) *
* サブモジュール名:R01読込処理 *
* 処理概要 : OVT-SUMMARY読込 *
*****************************************************************
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:(1.2) *
* サブモジュール名:R02読込処理 *
* 処理概要 : OVT-DBCLEAN読込 *
*****************************************************************
1200R02INNSOR SECTION.
*
READ R02INNFIL
AT END
MOVE '1' TO WRK-R02EOF
NOT AT END
ADD 1 TO CUN-R02INN
END-READ.
*
1200R02INNSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.0) *
* サブモジュール名:主処理 *
* 処理概要 : R01OVT-SUMMARY)→R02OVT-DBCLEAN)処理 *
*****************************************************************
2000MAJSOR SECTION.
*
EVALUATE TRUE
*** フェーズ1OVT-SUMMARY処理
WHEN NOT WRK-R01-EOF
PERFORM 2100SUMMARYSOR
PERFORM 1100R01INNSOR
*** フェーズ2OVT-DBCLEAN処理
WHEN NOT WRK-R02-EOF
PERFORM 2200DBCLEANSOR
PERFORM 1200R02INNSOR
WHEN OTHER
CONTINUE
END-EVALUATE.
*
2000MAJSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.1) *
* サブモジュール名:OVT-SUMMARY→DB登録処理 *
* 処理概要 : OVT-APPLICATIONS INSERT/UPSERT *
*****************************************************************
2100SUMMARYSOR SECTION.
*
*** SQLホスト変数設定
MOVE R01APPL-ID TO WRK-SQL-APPL-ID.
MOVE R01EMP-ID TO WRK-SQL-EMP-ID.
MOVE R01APPL-DATE TO WRK-SQL-APPL-DATE.
MOVE R01APPL-DATE TO WRK-APPL-DATE-N.
MOVE WRK-APPL-DATE-N(5:2) TO WRK-MONTH.
*
*** 月バリデーション(PERFORM VARYING カバレッジ用)
MOVE ZERO TO WRK-MONTH-VALID.
PERFORM VARYING WRK-IDX
FROM 1 BY 1
UNTIL WRK-IDX > 12
OR WRK-MONTH-VALID = 1
IF WRK-MONTH = WRK-IDX
MOVE 1 TO WRK-MONTH-VALID
END-IF
END-PERFORM.
*
*** 月異常時はエラー
IF WRK-MONTH-VALID = ZERO
MOVE 10 TO WRK-ERR-CATEGORY
STRING 'INVALID MONTH APPL-ID='
WRK-SQL-APPL-ID DELIMITED BY SIZE
INTO WRK-ERR-DETAIL
END-STRING
MOVE WRK-ERR-CATEGORY TO W01ERR-CATEGORY
MOVE WRK-ERR-DETAIL TO W01ERR-DETAIL
WRITE W01OUTREC
ADD 1 TO CUN-W01OUT
PERFORM 9999ABDSOR
END-IF.
*
*** 年月抽出
MOVE WRK-APPL-DATE-N(1:6) TO WRK-YEAR-MONTH.
MOVE WRK-YEAR-MONTH TO WRK-SQL-YEAR-MONTH.
*
*** 開始/終了時刻設定
MOVE R01START-TIME TO WRK-SQL-START-TIME.
MOVE R01END-TIME TO WRK-SQL-END-TIME.
*
*** 加班時間 → SQL形式変換(小数点付加)
MOVE R01OVT-HOURS TO WRK-OVT-HOURS-NUM.
MOVE R01OVT-HOURS TO WRK-OVT-HOURS-EDITED.
MOVE WRK-OVT-HOURS-EDITED TO WRK-SQL-OVT-HOURS.
*
*** MULTIPLY カバレッジ:時間→分変換
MULTIPLY WRK-OVT-HOURS-NUM
BY 60 GIVING WRK-OVT-MINUTES.
*
*** 種別・ステータス設定
MOVE R01OVT-TYPE TO WRK-SQL-OVT-TYPE.
MOVE CNS-STATUS-ACTIVE TO WRK-SQL-STATUS.
*
*** OVT-APPLICATIONSにINSERT
EXEC SQL
INSERT INTO OVT_APPLICATIONS
(APPL_ID, EMP_ID, APPL_DATE, OVT_TYPE,
START_TIME, END_TIME, OVT_HOURS, STATUS,
UPDATED_AT)
VALUES
(:WRK-SQL-APPL-ID, :WRK-SQL-EMP-ID,
:WRK-SQL-APPL-DATE, :WRK-SQL-OVT-TYPE,
:WRK-SQL-START-TIME, :WRK-SQL-END-TIME,
:WRK-SQL-OVT-HOURS, :WRK-SQL-STATUS,
CURRENT_TIMESTAMP)
END-EXEC.
*
IF SQLCODE NOT = 0
*** 重複 → UPDATE
EXEC SQL
UPDATE OVT_APPLICATIONS SET
STATUS = :WRK-SQL-STATUS,
UPDATED_AT = CURRENT_TIMESTAMP
WHERE APPL_ID = :WRK-SQL-APPL-ID
END-EXEC
IF SQLCODE NOT = 0
PERFORM 9100DBERRSOR
END-IF
ADD 1 TO CUN-DBXUPD
ELSE
ADD 1 TO CUN-DBXINS
END-IF.
*
ADD 1 TO CUN-COMMIT.
*
*** OVT-MONTHLY UPSERT
PERFORM 2110MONTHLYUPSOR.
*
*** COMMIT判定
IF CUN-COMMIT >= CNS-COMMIT-CNT
PERFORM 2300COMMITDBX
END-IF.
*
2100SUMMARYSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.1.1) *
* サブモジュール名:OVT-MONTHLY UPSERT処理 *
* 処理概要 : 月次集計テーブルへの追加/更新 *
*****************************************************************
2110MONTHLYUPSOR SECTION.
*
*** OVT-MONTHLY存在確認
EXEC SQL
SELECT OVT_HOURS, OVT_COUNT
INTO :DB-OVT-HOURS, :DB-OVT-COUNT
FROM OVT_MONTHLY
WHERE EMP_ID = :WRK-SQL-EMP-ID
AND YEAR_MONTH = :WRK-SQL-YEAR-MONTH
AND OVT_TYPE = :WRK-SQL-OVT-TYPE
END-EXEC.
*
IF SQLCODE = 0
*** 既存レコードあり → 加算UPDATE
EXEC SQL
UPDATE OVT_MONTHLY SET
OVT_HOURS = OVT_HOURS + :WRK-SQL-OVT-HOURS,
OVT_COUNT = OVT_COUNT + 1,
UPDATED_AT = CURRENT_TIMESTAMP
WHERE EMP_ID = :WRK-SQL-EMP-ID
AND YEAR_MONTH = :WRK-SQL-YEAR-MONTH
AND OVT_TYPE = :WRK-SQL-OVT-TYPE
END-EXEC
IF SQLCODE NOT = 0
PERFORM 9100DBERRSOR
END-IF
ELSE
*** 新規 → INSERT
EXEC SQL
INSERT INTO OVT_MONTHLY
(EMP_ID, YEAR_MONTH, OVT_TYPE,
OVT_HOURS, OVT_COUNT, UPDATED_AT)
VALUES
(:WRK-SQL-EMP-ID, :WRK-SQL-YEAR-MONTH,
:WRK-SQL-OVT-TYPE, :WRK-SQL-OVT-HOURS,
1, CURRENT_TIMESTAMP)
END-EXEC
IF SQLCODE NOT = 0
PERFORM 9100DBERRSOR
END-IF
END-IF.
*
2110MONTHLYUPSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.2) *
* サブモジュール名:OVT-DBCLEAN→取消処理 *
* 処理概要 : OVT-APPLICATIONS取消+OVT-MONTHLY減算 *
*****************************************************************
2200DBCLEANSOR SECTION.
*
*** SQLホスト変数設定
MOVE R02APPL-ID TO WRK-SQL-APPL-ID.
*
*** OVT-APPLICATIONSから既存データ取得
EXEC SQL
SELECT EMP_ID, APPL_DATE, OVT_TYPE, OVT_HOURS
INTO :WRK-SQL-EMP-ID, :WRK-SQL-APPL-DATE,
:WRK-SQL-OVT-TYPE, :WRK-SQL-OVT-HOURS
FROM OVT_APPLICATIONS
WHERE APPL_ID = :WRK-SQL-APPL-ID
END-EXEC.
*
IF SQLCODE NOT = 0
*** 該当なし(孤立取消)→ ERROR-LOG + ABEND
MOVE 20 TO WRK-ERR-CATEGORY
STRING 'ORPHAN CANCEL APPL-ID='
WRK-SQL-APPL-ID DELIMITED BY SIZE
INTO WRK-ERR-DETAIL
END-STRING
MOVE WRK-ERR-CATEGORY TO W01ERR-CATEGORY
MOVE WRK-ERR-DETAIL TO W01ERR-DETAIL
WRITE W01OUTREC
ADD 1 TO CUN-W01OUT
PERFORM 9999ABDSOR
END-IF.
*
*** 年月抽出
MOVE WRK-SQL-APPL-DATE TO WRK-APPL-DATE-N.
MOVE WRK-APPL-DATE-N(1:6) TO WRK-YEAR-MONTH.
MOVE WRK-YEAR-MONTH TO WRK-SQL-YEAR-MONTH.
*
*** SUBTRACT カバレッジ:残容量検証
MOVE WRK-SQL-OVT-HOURS TO WRK-OVT-HOURS-NUM.
SUBTRACT WRK-OVT-HOURS-NUM
FROM CNS-MAX-HOURS
GIVING WRK-REMAIN-HOURS.
*
*** OVT-APPLICATIONSステータス更新(取消)
EXEC SQL
UPDATE OVT_APPLICATIONS SET
STATUS = :CNS-STATUS-CANCEL,
UPDATED_AT = CURRENT_TIMESTAMP
WHERE APPL_ID = :WRK-SQL-APPL-ID
END-EXEC.
*
IF SQLCODE NOT = 0
PERFORM 9100DBERRSOR
END-IF.
*
ADD 1 TO CUN-DBXUPD.
ADD 1 TO CUN-COMMIT.
*
*** OVT-MONTHLY減算
PERFORM 2210MONTHLYSUBSOR.
*
2200DBCLEANSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.2.1) *
* サブモジュール名:OVT-MONTHLY減算処理 *
* 処理概要 : 月次集計テーブルからの減算 *
*****************************************************************
2210MONTHLYSUBSOR SECTION.
*
*** リトライカウンタ設定
MOVE 3 TO WRK-RETRY-CNT.
*
*** PERFORM TEST AFTER カバレッジ
PERFORM TEST AFTER
VARYING WRK-IDX
FROM 1 BY 1
UNTIL WRK-IDX > WRK-RETRY-CNT
OR SQLCODE = 0
EXEC SQL
UPDATE OVT_MONTHLY SET
OVT_HOURS = OVT_HOURS
- :WRK-SQL-OVT-HOURS,
OVT_COUNT = OVT_COUNT - 1,
UPDATED_AT = CURRENT_TIMESTAMP
WHERE EMP_ID = :WRK-SQL-EMP-ID
AND YEAR_MONTH = :WRK-SQL-YEAR-MONTH
AND OVT_TYPE = :WRK-SQL-OVT-TYPE
END-EXEC
IF SQLCODE NOT = 0
EXEC SQL
ROLLBACK WORK
END-EXEC
END-IF
END-PERFORM.
*
IF SQLCODE NOT = 0
*** 減算失敗 → データ不整合
MOVE 21 TO WRK-ERR-CATEGORY
STRING 'MONTHLY SUBTRACT FAIL APPL-ID='
WRK-SQL-APPL-ID DELIMITED BY SIZE
INTO WRK-ERR-DETAIL
END-STRING
MOVE WRK-ERR-CATEGORY TO W01ERR-CATEGORY
MOVE WRK-ERR-DETAIL TO W01ERR-DETAIL
WRITE W01OUTREC
ADD 1 TO CUN-W01OUT
PERFORM 9999ABDSOR
END-IF.
*
ADD 1 TO CUN-DBXUPD.
ADD 1 TO CUN-COMMIT.
*
*** COMMIT判定
IF CUN-COMMIT >= CNS-COMMIT-CNT
PERFORM 2300COMMITDBX
END-IF.
*
2210MONTHLYSUBSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.3) *
* サブモジュール名:COMMIT処理 *
* 処理概要 : DB COMMIT発行 *
*****************************************************************
2300COMMITDBX SECTION.
*
*** COMMIT
EXEC SQL
COMMIT WORK
END-EXEC.
*
MOVE ZERO TO CUN-COMMIT.
ADD 1 TO CUN-ETHUS.
*
2300COMMITDBX-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(3.0) *
* サブモジュール名:終了処理 *
* 処理概要 : 最終COMMIT・ファイルクローズ・件数出力 *
*****************************************************************
3000STPSOR SECTION.
*
*** 最終COMMIT
IF CUN-COMMIT > ZERO
PERFORM 2300COMMITDBX
END-IF.
*
*** 入出力ファイルCLOSE
CLOSE R01INNFIL
R02INNFIL
W01OUTFIL.
*
*** 件数メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'ZAN06R01' TO M00UMKDATS22-01.
MOVE CUN-R01INN TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'ZAN06R02' TO M00UMKDATS22-01.
MOVE CUN-R02INN TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'INS' TO M00UMKDATS22-01.
MOVE CUN-DBXINS TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'UPD' TO M00UMKDATS22-01.
MOVE CUN-DBXUPD TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGOUTKES TO M00MSGCOD.
MOVE 'ZAN06W01' TO M00UMKDATS22-01.
MOVE CUN-W01OUT 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.1) *
* サブモジュール名:DBエラー処理 *
* 処理概要 : DBエラー→ERROR-LOG出力+ROLLBACKABEND *
*****************************************************************
9100DBERRSOR SECTION.
*
*** ERROR-LOG出力
MOVE 30 TO WRK-ERR-CATEGORY.
MOVE SQLCODE TO WRK-SQLCODE-DISP.
STRING 'DB ERROR SQLCODE='
WRK-SQLCODE-DISP DELIMITED BY SIZE
' APPL-ID='
WRK-SQL-APPL-ID DELIMITED BY SIZE
INTO WRK-ERR-DETAIL
END-STRING.
MOVE WRK-ERR-CATEGORY TO W01ERR-CATEGORY.
MOVE WRK-ERR-DETAIL TO W01ERR-DETAIL.
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
*** ROLLBACK
EXEC SQL
ROLLBACK WORK
END-EXEC.
*
MOVE ZERO TO CUN-COMMIT.
*
PERFORM 9999ABDSOR.
*
9100DBERRSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(9.9) *
* サブモジュール名:ABEND処理 *
* 処理概要 : ABENDサブPGM呼出 *
*****************************************************************
9999ABDSOR SECTION.
*
MOVE CNS-ABD999 TO E01ABDCOD.
CALL 'SUB03END' USING E01ABDPAR.
*
9999ABDSOR-EXT.
EXIT.