Add Subsystem C (KYU01-09): all 9 programs, design docs, resource lists, DDL, COPY, coverage stats
KYU programs for payroll calculation: KYU01CVT - CSV conversion KYU02REG - attendance registration KYU03AGG - aggregation KYU04CAL - salary calculation KYU05DED - deduction calculation KYU06UPD - DB update KYU07DIV - division/pay-slip KYU08PRI - print output KYU09MRG - merge output Includes: - Source programs (9 .cbl) - Compiled executables (9 .exe) - Detailed design docs (9 + sign-off) - Basic design doc (subsystem C overview) - Resource lists (9) - DDL schema (schema_kyu.sql) - COPY book (KYU99REC.cpy) - Coverage statistics update - DB definition update (STATUS values) - Overall system design document
This commit is contained in:
qiuqiuqiu
@@ -0,0 +1,473 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU01CVT.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU01CVT *
|
||||
* プログラム名 : 社員マスタCSV→FB変換処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : CSV形式の社員マスタを固定長80Bに変換する *
|
||||
* 引用符内改行をINSPECT CONVERTINGで処理 *
|
||||
* 項目チェックはSUB04CHKで実施 *
|
||||
* プログラム分類: No.21 CSV→FB変換（改行あり） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL KYU01R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL KYU01W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL KYU01W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: CSV入力（可変長） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 R01INNREC PIC X(500).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: EMP-RECORD出力（80B固定長） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY KYU01REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG出力（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU01CVT'.
|
||||
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.
|
||||
03 CNS-FLD-COUNT PIC 9(002) VALUE 9.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
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.
|
||||
*** CSVワーク
|
||||
03 WRK-CSV-LINE PIC X(500).
|
||||
03 WRK-CSV-ACCUM PIC X(500).
|
||||
03 WRK-ACCUM-LEN PIC 9(004).
|
||||
*** 引用符状態フラグ
|
||||
03 WRK-IN-QUOTE PIC X(001).
|
||||
88 WRK-QUOTE-ACTIVE VALUE '1'.
|
||||
88 WRK-QUOTE-INACTIVE VALUE '0'.
|
||||
03 WRK-QUOTE-COUNT PIC 9(002).
|
||||
*** CSV分解フィールド
|
||||
03 WRK-CSV-EMP-ID PIC X(008).
|
||||
03 WRK-CSV-EMP-NAME PIC X(040).
|
||||
03 WRK-CSV-DEPT-CODE PIC X(002).
|
||||
03 WRK-CSV-REGION-CODE PIC X(002).
|
||||
03 WRK-CSV-CATEGORY-CODE PIC X(003).
|
||||
03 WRK-CSV-BASE-SALARY PIC X(009).
|
||||
03 WRK-CSV-HOURLY-RATE PIC X(007).
|
||||
03 WRK-CSV-DEPENDENT-COUNT PIC X(002).
|
||||
03 WRK-CSV-STATUS PIC X(001).
|
||||
*** UNSTRING集計
|
||||
03 WRK-FIELD-COUNT PIC 9(002).
|
||||
*** EOF
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
*** サブプログラム戻り値
|
||||
03 WRK-SUB04-RC PIC 9(004).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
*** メッセージ出力
|
||||
COPY ZANMSGAC.
|
||||
*** ABEND処理
|
||||
COPY ZANENDAC.
|
||||
*** 項目チェック
|
||||
COPY ZANCHKAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* DECLARATIVES *
|
||||
*****************************************************************
|
||||
DECLARATIVES.
|
||||
*
|
||||
KYU01CVT-ERR SECTION.
|
||||
USE AFTER ERROR PROCEDURE ON R01INNFIL.
|
||||
KYU01CVT-ERR-PROC.
|
||||
PERFORM 9999ABDSOR.
|
||||
*
|
||||
KYU01W01-ERR SECTION.
|
||||
USE AFTER ERROR PROCEDURE ON W01OUTFIL.
|
||||
KYU01W01-ERR-PROC.
|
||||
PERFORM 9999ABDSOR.
|
||||
*
|
||||
KYU01W02-ERR SECTION.
|
||||
USE AFTER ERROR PROCEDURE ON W02OUTFIL.
|
||||
KYU01W02-ERR-PROC.
|
||||
PERFORM 9999ABDSOR.
|
||||
*
|
||||
END DECLARATIVES.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
* 処理概要 : メインコントロール処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
*** 初期処理
|
||||
PERFORM 1000ITTSOR.
|
||||
*
|
||||
*** 主処理
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
*
|
||||
*** 終了処理
|
||||
PERFORM 3000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.0) *
|
||||
* サブモジュール名: 初期処理 *
|
||||
* 処理概要 : 開始メッセージ・OPEN・初回READ *
|
||||
*****************************************************************
|
||||
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.
|
||||
MOVE SPACE TO WRK-CSV-ACCUM.
|
||||
MOVE ZERO TO WRK-ACCUM-LEN.
|
||||
*
|
||||
*** 入出力ファイルOPEN
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** 初回READ
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
* 処理概要 : CSV行読込 *
|
||||
*****************************************************************
|
||||
1100R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
MOVE R01INNREC TO WRK-CSV-LINE
|
||||
END-READ.
|
||||
*
|
||||
1100R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
* 処理概要 : CSVライン解析・変換・出力 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** コメント行はスキップ
|
||||
IF WRK-CSV-LINE(1:1) = '#'
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 引用符状態チェック（奇数個の"で状態反転）
|
||||
MOVE ZERO TO WRK-QUOTE-COUNT.
|
||||
INSPECT WRK-CSV-LINE
|
||||
TALLYING WRK-QUOTE-COUNT FOR ALL '"'
|
||||
*
|
||||
IF WRK-QUOTE-ACTIVE
|
||||
IF FUNCTION MOD(WRK-QUOTE-COUNT 2) = 1
|
||||
*** 引用符内終了
|
||||
MOVE '0' TO WRK-IN-QUOTE
|
||||
END-IF
|
||||
*** 蓄積
|
||||
STRING WRK-CSV-ACCUM(1:WRK-ACCUM-LEN)
|
||||
WRK-CSV-LINE
|
||||
DELIMITED BY SIZE
|
||||
INTO WRK-CSV-ACCUM
|
||||
WITH POINTER WRK-ACCUM-LEN
|
||||
END-STRING
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
IF FUNCTION MOD(WRK-QUOTE-COUNT 2) = 1
|
||||
*** 引用符内開始
|
||||
MOVE '1' TO WRK-IN-QUOTE
|
||||
MOVE SPACE TO WRK-CSV-ACCUM
|
||||
MOVE 1 TO WRK-ACCUM-LEN
|
||||
STRING WRK-CSV-LINE
|
||||
DELIMITED BY SIZE
|
||||
INTO WRK-CSV-ACCUM
|
||||
WITH POINTER WRK-ACCUM-LEN
|
||||
END-STRING
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 通常行（引用符なし）→ 直接CSV-LINEを使用
|
||||
MOVE WRK-CSV-LINE TO WRK-CSV-ACCUM.
|
||||
*
|
||||
*** 引用符内改行をスペース変換
|
||||
INSPECT WRK-CSV-ACCUM
|
||||
CONVERTING X"0D" TO X"20"
|
||||
INSPECT WRK-CSV-ACCUM
|
||||
CONVERTING X"0A" TO X"20"
|
||||
*
|
||||
*** CSV分解
|
||||
PERFORM 2100CSVUNSOR.
|
||||
*
|
||||
*** 項目数チェック
|
||||
IF WRK-FIELD-COUNT NOT = CNS-FLD-COUNT
|
||||
PERFORM 2200ERROUTSOR
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 社員番号空チェック
|
||||
INSPECT WRK-CSV-EMP-ID
|
||||
TALLYING WRK-FIELD-COUNT FOR LEADING SPACES
|
||||
IF WRK-FIELD-COUNT = 8
|
||||
MOVE 'EMP- ' TO W02ERR-CATEGORY
|
||||
MOVE CUN-R01INN TO WRK-FIELD-COUNT
|
||||
STRING 'EMPTY EMP-ID AT LINE '
|
||||
WRK-FIELD-COUNT
|
||||
DELIMITED BY SIZE
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** SUB04CHK: EMP-ID数値チェック
|
||||
MOVE 'EMPID' TO C01CHKTYP.
|
||||
MOVE WRK-CSV-EMP-ID TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
MOVE C01CHKRRC TO WRK-SUB04-RC.
|
||||
IF WRK-SUB04-RC NOT = 0
|
||||
PERFORM 2200ERROUTSOR
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** SUB04CHK: HOURLY-RATE数値チェック
|
||||
MOVE 'NUM ' TO C01CHKTYP.
|
||||
MOVE WRK-CSV-HOURLY-RATE TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
MOVE C01CHKRRC TO WRK-SUB04-RC.
|
||||
IF WRK-SUB04-RC NOT = 0
|
||||
PERFORM 2200ERROUTSOR
|
||||
PERFORM 1100R01INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** EMP-NAME英字チェック
|
||||
IF WRK-CSV-EMP-NAME NOT ALPHABETIC
|
||||
CONTINUE
|
||||
END-IF.
|
||||
*
|
||||
*** W01OUTREC編集
|
||||
MOVE WRK-CSV-EMP-ID TO W01EMP-ID.
|
||||
MOVE WRK-CSV-EMP-NAME TO W01EMP-NAME.
|
||||
MOVE WRK-CSV-DEPT-CODE TO W01DEPT-CODE.
|
||||
MOVE WRK-CSV-REGION-CODE TO W01REGION-CODE.
|
||||
MOVE WRK-CSV-CATEGORY-CODE TO W01CATEGORY-CODE.
|
||||
MOVE WRK-CSV-BASE-SALARY TO W01BASE-SALARY.
|
||||
MOVE WRK-CSV-HOURLY-RATE TO W01HOURLY-RATE.
|
||||
MOVE WRK-CSV-DEPENDENT-COUNT TO W01DEPENDENT-COUNT.
|
||||
MOVE WRK-CSV-STATUS TO W01STATUS.
|
||||
*
|
||||
*** WRITE EMP-RECORD
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
*** 次行READ
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: CSV分解処理 *
|
||||
* 処理概要 : UNSTRINGでCSVをフィールド分解 *
|
||||
*****************************************************************
|
||||
2100CSVUNSOR SECTION.
|
||||
*
|
||||
INITIALIZE WRK-CSV-EMP-ID
|
||||
WRK-CSV-EMP-NAME
|
||||
WRK-CSV-DEPT-CODE
|
||||
WRK-CSV-REGION-CODE
|
||||
WRK-CSV-CATEGORY-CODE
|
||||
WRK-CSV-BASE-SALARY
|
||||
WRK-CSV-HOURLY-RATE
|
||||
WRK-CSV-DEPENDENT-COUNT
|
||||
WRK-CSV-STATUS.
|
||||
*
|
||||
UNSTRING WRK-CSV-ACCUM
|
||||
DELIMITED BY ','
|
||||
INTO WRK-CSV-EMP-ID
|
||||
WRK-CSV-EMP-NAME
|
||||
WRK-CSV-DEPT-CODE
|
||||
WRK-CSV-REGION-CODE
|
||||
WRK-CSV-CATEGORY-CODE
|
||||
WRK-CSV-BASE-SALARY
|
||||
WRK-CSV-HOURLY-RATE
|
||||
WRK-CSV-DEPENDENT-COUNT
|
||||
WRK-CSV-STATUS
|
||||
TALLYING IN WRK-FIELD-COUNT
|
||||
END-UNSTRING.
|
||||
*
|
||||
2100CSVUNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: エラー出力処理 *
|
||||
* 処理概要 : ERROR-LOG書出し *
|
||||
*****************************************************************
|
||||
2200ERROUTSOR SECTION.
|
||||
*
|
||||
MOVE 'CSV-ERR' TO W02ERR-CATEGORY.
|
||||
MOVE WRK-CSV-ACCUM(1:80) TO W02ERR-DETAIL.
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
2200ERROUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
* 処理概要 : CLOSE・件数出力・終了MSG *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** CLOSE
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** 入力件数出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU01R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 出力件数（W01）
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU01W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 出力件数（W02）
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU01W02' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
* 処理概要 : SUB02MSG呼出 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
* 処理概要 : SUB03END呼出 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,319 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU02REG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU02REG *
|
||||
* プログラム名 : 社員マスタDB2登録処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : EMP-RECORDをDB2 EMP-MASTERにINSERT/UPSERT *
|
||||
* 重複時（-803）はUPDATEに切替 *
|
||||
* プログラム分類: No.09 DB更新 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL KYU02R02.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL KYU02W03.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: EMP-RECORD（80B FB） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
COPY KYU01REC REPLACING ==(A)== BY ==R02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W03: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W03OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W03==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU02REG'.
|
||||
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 CUNARA.
|
||||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DB-INS PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DB-UPD PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-EMP-NAME PIC X(040).
|
||||
03 DBV-DEPT-CODE PIC X(002).
|
||||
03 DBV-REGION-CODE PIC X(002).
|
||||
03 DBV-CATEGORY-CODE PIC X(003).
|
||||
03 DBV-BASE-SALARY PIC 9(009).
|
||||
03 DBV-HOURLY-RATE PIC 9(007).
|
||||
03 DBV-DEPENDENT-COUNT PIC 9(002).
|
||||
03 DBV-STATUS PIC X(001).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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.
|
||||
*
|
||||
OPEN INPUT R02INNFIL.
|
||||
OPEN OUTPUT W03OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/SALARY.db'
|
||||
END-EXEC.
|
||||
*
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R02読込処理 *
|
||||
*****************************************************************
|
||||
1100R02INNSOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
END-READ.
|
||||
*
|
||||
1100R02INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** DB2ホスト変数にMOVE
|
||||
MOVE R02EMP-ID TO DBV-EMP-ID.
|
||||
MOVE R02EMP-NAME TO DBV-EMP-NAME.
|
||||
MOVE R02DEPT-CODE TO DBV-DEPT-CODE.
|
||||
MOVE R02REGION-CODE TO DBV-REGION-CODE.
|
||||
MOVE R02CATEGORY-CODE TO DBV-CATEGORY-CODE.
|
||||
MOVE R02BASE-SALARY TO DBV-BASE-SALARY.
|
||||
MOVE R02HOURLY-RATE TO DBV-HOURLY-RATE.
|
||||
MOVE R02DEPENDENT-COUNT TO DBV-DEPENDENT-COUNT.
|
||||
MOVE R02STATUS TO DBV-STATUS.
|
||||
*
|
||||
*** INSERT試行
|
||||
EXEC SQL
|
||||
INSERT INTO EMP-MASTER
|
||||
(EMP-ID, EMP-NAME, DEPT-CODE,
|
||||
REGION-CODE, CATEGORY-CODE,
|
||||
BASE-SALARY, HOURLY-RATE,
|
||||
DEPENDENT-COUNT, STATUS,
|
||||
UPDATED-AT)
|
||||
VALUES
|
||||
(:DBV-EMP-ID, :DBV-EMP-NAME, :DBV-DEPT-CODE,
|
||||
:DBV-REGION-CODE, :DBV-CATEGORY-CODE,
|
||||
:DBV-BASE-SALARY, :DBV-HOURLY-RATE,
|
||||
:DBV-DEPENDENT-COUNT, :DBV-STATUS,
|
||||
CURRENT TIMESTAMP)
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-INS
|
||||
PERFORM 1100R02INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** -803 = 重複 → UPDATE
|
||||
IF SQLCODE = -803
|
||||
EXEC SQL
|
||||
UPDATE EMP-MASTER SET
|
||||
EMP-NAME = :DBV-EMP-NAME
|
||||
,DEPT-CODE = :DBV-DEPT-CODE
|
||||
,REGION-CODE = :DBV-REGION-CODE
|
||||
,CATEGORY-CODE = :DBV-CATEGORY-CODE
|
||||
,BASE-SALARY = :DBV-BASE-SALARY
|
||||
,HOURLY-RATE = :DBV-HOURLY-RATE
|
||||
,DEPENDENT-COUNT = :DBV-DEPENDENT-COUNT
|
||||
,STATUS = :DBV-STATUS
|
||||
,UPDATED-AT = CURRENT TIMESTAMP
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-UPD
|
||||
ELSE
|
||||
PERFORM 2100ERROUTSOR
|
||||
END-IF
|
||||
PERFORM 1100R02INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** その他SQLエラー
|
||||
PERFORM 2100ERROUTSOR.
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: エラー出力処理 *
|
||||
*****************************************************************
|
||||
2100ERROUTSOR SECTION.
|
||||
*
|
||||
MOVE 'DB-ERR' TO W03ERR-CATEGORY.
|
||||
MOVE DBV-EMP-ID TO W03ERR-DETAIL.
|
||||
WRITE W03OUTREC.
|
||||
ADD 1 TO CUN-W03OUT.
|
||||
*
|
||||
2100ERROUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R02INNFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU02R02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R02INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'DB-INSERT' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-INS TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'DB-UPDATE' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-UPD TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU02W03' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,289 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU03AGG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU03AGG *
|
||||
* プログラム名 : 欠勤集約処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : JCL SORT済み欠勤データを社員単位に集約 *
|
||||
* 同一社員内の欠勤時間・回数を集計 *
|
||||
* プログラム分類: No.08 キーブレイク（集約） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL KYU03R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL KYU03W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL KYU03W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: ABSENCE-SUMMARY（80B JCL SORT済み） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC PIC X(080).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: ABSENCE-AGGREGATE（80B 社員単位） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY KYU02REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU03AGG'.
|
||||
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.
|
||||
03 CNS-ONE PIC 9(002) VALUE 1.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
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-ABSENCE-REC.
|
||||
05 WRK-EMP-ID PIC X(008).
|
||||
05 WRK-YEAR-MONTH PIC X(006).
|
||||
05 WRK-ABSENT-HOURS PIC 9(004)V9(001).
|
||||
05 FILLER PIC X(062).
|
||||
*** キーブレイク
|
||||
03 WRK-PREV-EMP-ID PIC X(008).
|
||||
03 WRK-PREV-KEY-SET PIC X(001).
|
||||
88 WRK-PREV-Y VALUE '1'.
|
||||
*** 集約
|
||||
03 WRK-TOTAL-HOURS PIC 9(004)V9(001).
|
||||
03 WRK-ABSENT-COUNT PIC 9(002).
|
||||
*** EOF
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
*****************************************************************
|
||||
1100R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
INTO WRK-ABSENCE-REC
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1100R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
* 処理概要 : キーブレイク集約処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
IF WRK-PREV-Y
|
||||
IF WRK-PREV-EMP-ID = WRK-EMP-ID
|
||||
*** 同一社員 → 集約加算
|
||||
ADD 1 TO WRK-ABSENT-COUNT
|
||||
ADD WRK-ABSENT-HOURS TO WRK-TOTAL-HOURS
|
||||
ELSE
|
||||
*** 異社員 → 前社員の集約出力
|
||||
PERFORM 2100WRITOUTSOR
|
||||
MOVE WRK-EMP-ID TO WRK-PREV-EMP-ID
|
||||
INITIALIZE WRK-TOTAL-HOURS
|
||||
WRK-ABSENT-COUNT
|
||||
REPLACING NUMERIC DATA BY ZERO
|
||||
MOVE 1 TO WRK-ABSENT-COUNT
|
||||
MOVE WRK-ABSENT-HOURS TO WRK-TOTAL-HOURS
|
||||
END-IF
|
||||
ELSE
|
||||
*** 初回
|
||||
MOVE WRK-EMP-ID TO WRK-PREV-EMP-ID
|
||||
SET WRK-PREV-Y TO TRUE
|
||||
MOVE CNS-ONE TO WRK-ABSENT-COUNT
|
||||
MOVE WRK-ABSENT-HOURS TO WRK-TOTAL-HOURS
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 集約レコード出力処理 *
|
||||
*****************************************************************
|
||||
2100WRITOUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
MOVE WRK-PREV-EMP-ID TO W01EMP-ID.
|
||||
MOVE WRK-YEAR-MONTH TO W01YEAR-MONTH.
|
||||
MOVE WRK-TOTAL-HOURS TO W01TOTAL-HOURS.
|
||||
MOVE WRK-ABSENT-COUNT TO W01ABSENT-COUNT.
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2100WRITOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 最終社員の集約出力
|
||||
IF WRK-PREV-Y
|
||||
PERFORM 2100WRITOUTSOR
|
||||
END-IF.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU03R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU03W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU03W02' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,457 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU04CAL.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU04CAL *
|
||||
* プログラム名 : 給与計算処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : 欠勤集約 + EMP-MASTER + OVT-MONTHLY を *
|
||||
* 参照し給与計算を実行 *
|
||||
* 勤怠区分×手当種別の複合分岐はEVALUATE ALSO *
|
||||
* プログラム分類: No.32 1:N＋キーブレイク（同キー） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL KYU04R02.
|
||||
SELECT R03INNFIL ASSIGN TO EXTERNAL KYU04R03.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL KYU04W03.
|
||||
SELECT W04OUTFIL ASSIGN TO EXTERNAL KYU04W04.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: ABSENCE-AGGREGATE（80B 社員単位） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
COPY KYU02REC REPLACING ==(A)== BY ==R02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* R03: PAY-PARAM（80B FB） *
|
||||
*****************************************************************
|
||||
FD R03INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R03INNREC PIC X(080).
|
||||
*
|
||||
*****************************************************************
|
||||
* W03: SALARY-DETAIL（240B FB） *
|
||||
*****************************************************************
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W03OUTREC.
|
||||
COPY KYU03REC REPLACING ==(A)== BY ==W03==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W04: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W04OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W04OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W04==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU04CAL'.
|
||||
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.
|
||||
03 CNS-OVERTIME-RATE PIC 9(002)V9(002)
|
||||
VALUE 01.25.
|
||||
03 CNS-HOLIDAY-RATE PIC 9(001)V9(02)
|
||||
VALUE 1.35.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W04OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
*** パラメータ
|
||||
03 WRK-PARAM.
|
||||
05 WRK-PARAM-BASE PIC X(080).
|
||||
05 WRK-PARAM-FILLER PIC X(080).
|
||||
*** 給与計算
|
||||
03 WRK-YEAR-MONTH PIC X(006).
|
||||
03 WRK-EMP-ID PIC X(008).
|
||||
03 WRK-EMP-NAME PIC X(040).
|
||||
03 WRK-DEPT-CODE PIC X(002).
|
||||
03 WRK-REGION-CODE PIC X(002).
|
||||
03 WRK-CATEGORY-CODE PIC X(003).
|
||||
03 WRK-BASE-SALARY PIC 9(009).
|
||||
03 WRK-HOURLY-RATE PIC 9(007).
|
||||
03 WRK-DEPENDENT-COUNT PIC 9(002).
|
||||
03 WRK-ABSENT-HOURS PIC 9(004)V9(001).
|
||||
03 WRK-OVT-HOURS PIC 9(004)V9(001).
|
||||
03 WRK-ABSENT-DEDUCT PIC 9(009).
|
||||
03 WRK-OVT-AMOUNT PIC 9(009).
|
||||
03 WRK-GROSS-PAYMENT PIC 9(009).
|
||||
03 WRK-ALLOWANCE-TYPE PIC X(003).
|
||||
03 WRK-ATTEND-TYPE PIC X(001).
|
||||
03 WRK-AMOUNT PIC 9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-BASE-SALARY PIC 9(009).
|
||||
03 DBV-HOURLY-RATE PIC 9(007).
|
||||
03 DBV-DEPENDENT-COUNT PIC 9(002).
|
||||
03 DBV-EMPLOYEE-NAME PIC X(040).
|
||||
03 DBV-DEPT-CODE PIC X(002).
|
||||
03 DBV-OVT-HOURS PIC 9(004)V9(001).
|
||||
03 DBV-STATUS PIC X(001).
|
||||
*
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANDATAC.
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** PAY-PARAM読込
|
||||
OPEN INPUT R03INNFIL.
|
||||
READ R03INNFIL
|
||||
INTO WRK-PARAM-BASE
|
||||
END-READ.
|
||||
CLOSE R03INNFIL.
|
||||
*
|
||||
*** パラメータ解析
|
||||
UNSTRING WRK-PARAM-BASE
|
||||
DELIMITED BY ','
|
||||
INTO WRK-YEAR-MONTH
|
||||
END-UNSTRING.
|
||||
*
|
||||
OPEN INPUT R02INNFIL.
|
||||
OPEN OUTPUT W03OUTFIL
|
||||
W04OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/SALARY.db'
|
||||
END-EXEC.
|
||||
*
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R02読込処理 *
|
||||
*****************************************************************
|
||||
1100R02INNSOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
END-READ.
|
||||
*
|
||||
1100R02INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** ホスト変数セット
|
||||
MOVE R02EMP-ID TO DBV-EMP-ID.
|
||||
*
|
||||
*** DB2 EMP-MASTER参照
|
||||
EXEC SQL
|
||||
SELECT EMP-NAME, DEPT-CODE, REGION-CODE,
|
||||
CATEGORY-CODE, BASE-SALARY, HOURLY-RATE,
|
||||
DEPENDENT-COUNT, STATUS
|
||||
INTO :DBV-EMPLOYEE-NAME,
|
||||
:DBV-DEPT-CODE,
|
||||
:WRK-REGION-CODE,
|
||||
:WRK-CATEGORY-CODE,
|
||||
:DBV-BASE-SALARY,
|
||||
:DBV-HOURLY-RATE,
|
||||
:DBV-DEPENDENT-COUNT,
|
||||
:DBV-STATUS
|
||||
FROM EMP-MASTER
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE NOT = 0
|
||||
PERFORM 2200ERROUTSOR
|
||||
PERFORM 1100R02INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
MOVE DBV-EMPLOYEE-NAME TO WRK-EMP-NAME.
|
||||
MOVE DBV-BASE-SALARY TO WRK-BASE-SALARY.
|
||||
MOVE DBV-HOURLY-RATE TO WRK-HOURLY-RATE.
|
||||
MOVE DBV-DEPT-CODE TO WRK-DEPT-CODE.
|
||||
MOVE R02YEAR-MONTH TO WRK-YEAR-MONTH.
|
||||
MOVE R02TOTAL-HOURS TO WRK-ABSENT-HOURS.
|
||||
*
|
||||
*** OVT-MONTHLY参照（残業時間）
|
||||
EXEC SQL
|
||||
SELECT SUM(OVT-HOURS)
|
||||
INTO :DBV-OVT-HOURS
|
||||
FROM OVT-MONTHLY
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
AND YEAR-MONTH = :WRK-YEAR-MONTH
|
||||
END-EXEC.
|
||||
IF SQLCODE = 0
|
||||
CONTINUE
|
||||
ELSE
|
||||
MOVE ZERO TO DBV-OVT-HOURS
|
||||
END-IF.
|
||||
*
|
||||
*** 給与計算
|
||||
PERFORM 2100CALCSOR.
|
||||
*
|
||||
*** SALARY-DETAIL出力
|
||||
PERFORM 2110WRITOUTSOR.
|
||||
*
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 給与計算処理 *
|
||||
*****************************************************************
|
||||
2100CALCSOR SECTION.
|
||||
*
|
||||
*** 欠勤控除額
|
||||
COMPUTE WRK-ABSENT-DEDUCT ROUNDED =
|
||||
DBV-HOURLY-RATE * WRK-ABSENT-HOURS
|
||||
ON SIZE ERROR
|
||||
MOVE ZERO TO WRK-ABSENT-DEDUCT
|
||||
END-COMPUTE.
|
||||
*
|
||||
*** 残業手当
|
||||
COMPUTE WRK-OVT-AMOUNT ROUNDED =
|
||||
DBV-HOURLY-RATE * DBV-OVT-HOURS * CNS-OVERTIME-RATE
|
||||
ON SIZE ERROR
|
||||
MOVE ZERO TO WRK-OVT-AMOUNT
|
||||
END-COMPUTE.
|
||||
*
|
||||
*** EVALUATE ALSO（勤怠区分×手当種別）
|
||||
MOVE 'OVT' TO WRK-ALLOWANCE-TYPE.
|
||||
MOVE 'W' TO WRK-ATTEND-TYPE.
|
||||
*
|
||||
EVALUATE WRK-ALLOWANCE-TYPE
|
||||
ALSO WRK-ATTEND-TYPE
|
||||
WHEN 'OVT' ALSO 'W'
|
||||
COMPUTE WRK-AMOUNT ROUNDED =
|
||||
DBV-HOURLY-RATE * DBV-OVT-HOURS * 1.25
|
||||
END-COMPUTE
|
||||
WHEN 'OVT' ALSO 'H'
|
||||
COMPUTE WRK-AMOUNT ROUNDED =
|
||||
DBV-HOURLY-RATE * DBV-OVT-HOURS * 1.35
|
||||
END-COMPUTE
|
||||
WHEN 'LATE' ALSO ANY
|
||||
COMPUTE WRK-AMOUNT ROUNDED =
|
||||
DBV-HOURLY-RATE * DBV-OVT-HOURS * 0.50
|
||||
END-COMPUTE
|
||||
WHEN OTHER
|
||||
MOVE ZERO TO WRK-AMOUNT
|
||||
END-EVALUATE.
|
||||
*
|
||||
*** 支給総額
|
||||
COMPUTE WRK-GROSS-PAYMENT =
|
||||
DBV-BASE-SALARY + WRK-OVT-AMOUNT
|
||||
- WRK-ABSENT-DEDUCT
|
||||
END-COMPUTE.
|
||||
*
|
||||
2100CALCSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: SALARY-DETAIL出力処理 *
|
||||
*****************************************************************
|
||||
2110WRITOUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W03OUTREC.
|
||||
MOVE R02EMP-ID TO W03EMP-ID.
|
||||
MOVE WRK-EMP-NAME TO W03EMP-NAME.
|
||||
MOVE WRK-DEPT-CODE TO W03DEPT-CODE.
|
||||
MOVE DBV-BASE-SALARY TO W03BASE-SALARY.
|
||||
MOVE WRK-OVT-AMOUNT TO W03OVT-AMOUNT.
|
||||
MOVE ZERO TO W03HOLIDAY-AMOUNT.
|
||||
MOVE WRK-ABSENT-DEDUCT TO W03ABSENT-DEDUCT.
|
||||
MOVE WRK-GROSS-PAYMENT TO W03GROSS-PAYMENT.
|
||||
MOVE DBV-OVT-HOURS TO W03OVT-HOURS.
|
||||
MOVE WRK-ABSENT-HOURS TO W03ABSENT-HOURS.
|
||||
MOVE WRK-ATTEND-TYPE TO W03ATTEND-TYPE.
|
||||
MOVE WRK-ALLOWANCE-TYPE TO W03ALLOWANCE-TYPE.
|
||||
WRITE W03OUTREC.
|
||||
ADD 1 TO CUN-W03OUT.
|
||||
*
|
||||
2110WRITOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: エラー出力処理 *
|
||||
*****************************************************************
|
||||
2200ERROUTSOR SECTION.
|
||||
*
|
||||
MOVE 'DB-ERR' TO W04ERR-CATEGORY.
|
||||
MOVE R02EMP-ID TO W04ERR-DETAIL.
|
||||
WRITE W04OUTREC.
|
||||
ADD 1 TO CUN-W04OUT.
|
||||
*
|
||||
2200ERROUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R02INNFIL
|
||||
W03OUTFIL
|
||||
W04OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU04R02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R02INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU04W03' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W03OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU04W04' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W04OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
3000STPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (4.0) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,426 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU05DED.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU05DED *
|
||||
* プログラム名 : 控除計算処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : SALARY-DETAILを入力に、源泉所得税・ *
|
||||
* 社会保険料・住民税を計算しSALARY-NET出力 *
|
||||
* TAX-TABLE（DB2 SELECT ... BETWEEN） *
|
||||
* INSURANCE-TABLE（SEARCH ALL）を参照 *
|
||||
* プログラム分類: No.23 SELECT条件 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL KYU05R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL KYU05W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL KYU05W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: SALARY-DETAIL（240B FB） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY KYU03REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: SALARY-NET（200B FB） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU05DED'.
|
||||
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.
|
||||
03 CNS-TAX-BASIC-DEDUCTION PIC 9(006) VALUE 050000.
|
||||
03 CNS-RESIDENT-TAX-RATE PIC 9(001)V9(02)
|
||||
VALUE 0.10.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
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-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
*** 控除計算
|
||||
03 WRK-GROSS-PAYMENT PIC 9(009).
|
||||
03 WRK-TAXABLE-INCOME PIC 9(009).
|
||||
03 WRK-INCOME-TAX PIC 9(009).
|
||||
03 WRK-INSURANCE PIC 9(009).
|
||||
03 WRK-RESIDENT-TAX PIC 9(009).
|
||||
03 WRK-NET-PAYMENT PIC 9(009).
|
||||
*
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-TAX-RATE PIC 9(001)V9(04).
|
||||
03 DBV-TAX-DEDUCTION PIC 9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* 保険料率WORKING-STORAGE（SEARCH ALL） *
|
||||
*****************************************************************
|
||||
01 INSURANCE-WORK.
|
||||
03 IW-COUNT PIC 9(004).
|
||||
03 IW-ENTRY OCCURS 1 TO 200 TIMES
|
||||
DEPENDING ON IW-COUNT
|
||||
ASCENDING KEY IS IW-INCOME-FROM
|
||||
INDEXED BY IW-IDX.
|
||||
05 IW-INCOME-FROM PIC 9(009).
|
||||
05 IW-INCOME-TO PIC 9(009).
|
||||
05 IW-HEALTH-RATE PIC V9(006).
|
||||
05 IW-PENSION-RATE PIC V9(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数（保険料率FETCH用） *
|
||||
*****************************************************************
|
||||
01 DBV-INS.
|
||||
03 DBV-INS-INCOME-FROM PIC 9(009).
|
||||
03 DBV-INS-INCOME-TO PIC 9(009).
|
||||
03 DBV-INS-HEALTH-RATE PIC 9(001)V9(06).
|
||||
03 DBV-INS-PENSION-RATE PIC 9(001)V9(06).
|
||||
*
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/SALARY.db'
|
||||
END-EXEC.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** INSURANCE-TABLE全件LOAD
|
||||
PERFORM 1100INSLOADSOR.
|
||||
*
|
||||
PERFORM 1200R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: 保険料率テーブルLOAD処理 *
|
||||
*****************************************************************
|
||||
1100INSLOADSOR SECTION.
|
||||
*
|
||||
MOVE ZERO TO IW-COUNT.
|
||||
*
|
||||
EXEC SQL
|
||||
DECLARE INS-CURSOR CURSOR FOR
|
||||
SELECT INS-INCOME-FROM, INS-INCOME-TO,
|
||||
INS-HEALTH-RATE, INS-PENSION-RATE
|
||||
FROM INSURANCE-TABLE
|
||||
ORDER BY INS-INCOME-FROM
|
||||
END-EXEC.
|
||||
*
|
||||
EXEC SQL
|
||||
OPEN INS-CURSOR
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
MOVE 'INS-CURSOR OPEN ERR'
|
||||
TO W02ERR-DETAIL
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
PERFORM UNTIL SQLCODE NOT = 0
|
||||
EXEC SQL
|
||||
FETCH INS-CURSOR
|
||||
INTO :DBV-INS-INCOME-FROM,
|
||||
:DBV-INS-INCOME-TO,
|
||||
:DBV-INS-HEALTH-RATE,
|
||||
:DBV-INS-PENSION-RATE
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO IW-COUNT
|
||||
MOVE DBV-INS-INCOME-FROM
|
||||
TO IW-INCOME-FROM(IW-COUNT)
|
||||
MOVE DBV-INS-INCOME-TO
|
||||
TO IW-INCOME-TO(IW-COUNT)
|
||||
MOVE DBV-INS-HEALTH-RATE
|
||||
TO IW-HEALTH-RATE(IW-COUNT)
|
||||
MOVE DBV-INS-PENSION-RATE
|
||||
TO IW-PENSION-RATE(IW-COUNT)
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
EXEC SQL
|
||||
CLOSE INS-CURSOR
|
||||
END-EXEC.
|
||||
*
|
||||
1100INSLOADSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.2) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
*****************************************************************
|
||||
1200R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1200R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
MOVE R01GROSS-PAYMENT TO WRK-GROSS-PAYMENT.
|
||||
MOVE R01EMP-ID TO DBV-EMP-ID.
|
||||
*
|
||||
* 課税所得計算
|
||||
IF WRK-GROSS-PAYMENT < CNS-TAX-BASIC-DEDUCTION
|
||||
MOVE ZERO TO WRK-TAXABLE-INCOME
|
||||
ELSE
|
||||
COMPUTE WRK-TAXABLE-INCOME =
|
||||
WRK-GROSS-PAYMENT - CNS-TAX-BASIC-DEDUCTION
|
||||
END-COMPUTE
|
||||
END-IF.
|
||||
*
|
||||
*** TAX-TABLE参照（BETWEEN）
|
||||
EXEC SQL
|
||||
SELECT TAX-RATE, DEDUCTION
|
||||
INTO :DBV-TAX-RATE, :DBV-TAX-DEDUCTION
|
||||
FROM TAX-TABLE
|
||||
WHERE :WRK-TAXABLE-INCOME
|
||||
BETWEEN TAX-FROM AND TAX-TO
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
COMPUTE WRK-INCOME-TAX ROUNDED =
|
||||
WRK-TAXABLE-INCOME * DBV-TAX-RATE
|
||||
- DBV-TAX-DEDUCTION
|
||||
END-COMPUTE
|
||||
IF WRK-INCOME-TAX < ZERO
|
||||
MOVE ZERO TO WRK-INCOME-TAX
|
||||
END-IF
|
||||
ELSE
|
||||
MOVE ZERO TO WRK-INCOME-TAX
|
||||
END-IF.
|
||||
*
|
||||
*** 社会保険料計算（SEARCH順次）
|
||||
SET IW-IDX TO 1.
|
||||
SEARCH IW-ENTRY
|
||||
AT END
|
||||
MOVE ZERO TO WRK-INSURANCE
|
||||
WHEN IW-INCOME-FROM(IW-IDX)
|
||||
<= WRK-TAXABLE-INCOME
|
||||
AND WRK-TAXABLE-INCOME
|
||||
<= IW-INCOME-TO(IW-IDX)
|
||||
COMPUTE WRK-INSURANCE ROUNDED =
|
||||
WRK-TAXABLE-INCOME *
|
||||
(IW-HEALTH-RATE(IW-IDX)
|
||||
+ IW-PENSION-RATE(IW-IDX))
|
||||
END-COMPUTE
|
||||
END-SEARCH.
|
||||
*
|
||||
*** 住民税計算
|
||||
COMPUTE WRK-RESIDENT-TAX ROUNDED =
|
||||
WRK-TAXABLE-INCOME * CNS-RESIDENT-TAX-RATE
|
||||
END-COMPUTE.
|
||||
*
|
||||
*** 差引支給額
|
||||
COMPUTE WRK-NET-PAYMENT =
|
||||
WRK-GROSS-PAYMENT - WRK-INCOME-TAX
|
||||
- WRK-INSURANCE - WRK-RESIDENT-TAX
|
||||
END-COMPUTE.
|
||||
*
|
||||
*** W01出力
|
||||
PERFORM 2100WRITOUTSOR.
|
||||
*
|
||||
PERFORM 1200R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: SALARY-NET出力処理 *
|
||||
*****************************************************************
|
||||
2100WRITOUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
MOVE R01EMP-ID TO W01EMP-ID.
|
||||
MOVE 'S' TO W01REC-TYPE.
|
||||
MOVE R01EMP-NAME TO W01EMP-NAME.
|
||||
MOVE R01DEPT-CODE TO W01DEPT-CODE.
|
||||
MOVE R01BASE-SALARY TO W01GROSS-PAYMENT.
|
||||
MOVE WRK-INCOME-TAX TO W01INCOME-TAX.
|
||||
MOVE WRK-INSURANCE TO W01INSURANCE.
|
||||
MOVE WRK-RESIDENT-TAX TO W01RESIDENT-TAX.
|
||||
MOVE WRK-NET-PAYMENT TO W01NET-PAYMENT.
|
||||
MOVE WRK-TAXABLE-INCOME TO W01TAXABLE-INCOME.
|
||||
MOVE WRK-NET-PAYMENT TO W01PAY-AMOUNT.
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2100WRITOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU05R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU05W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU05W02' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,317 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU06UPD.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU06UPD *
|
||||
* プログラム名 : 給与計算結果DB2更新処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : SALARY-NETをDB2 SALARY-RESULTSに登録 *
|
||||
* 重複時（-803）はUPDATEに切替 *
|
||||
* プログラム分類: No.09 DB更新 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL KYU06R02.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL KYU06W03.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: SALARY-NET（200B FB） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==R02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W03: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W03OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W03==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU06UPD'.
|
||||
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.
|
||||
03 CNS-YEAR-MONTH-PARM PIC X(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DB-INS PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DB-UPD PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-YEAR-MONTH PIC X(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-YEAR-MONTH PIC X(006).
|
||||
03 DBV-GROSS-PAYMENT PIC 9(009).
|
||||
03 DBV-INCOME-TAX PIC 9(009).
|
||||
03 DBV-INSURANCE PIC 9(009).
|
||||
03 DBV-RESIDENT-TAX PIC 9(009).
|
||||
03 DBV-NET-PAYMENT PIC 9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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.
|
||||
*
|
||||
*** PARM取得
|
||||
ACCEPT WRK-YEAR-MONTH
|
||||
FROM COMMAND-LINE.
|
||||
IF WRK-YEAR-MONTH = SPACES
|
||||
MOVE '202605' TO WRK-YEAR-MONTH
|
||||
END-IF.
|
||||
MOVE WRK-YEAR-MONTH TO CNS-YEAR-MONTH-PARM.
|
||||
*
|
||||
OPEN INPUT R02INNFIL.
|
||||
OPEN OUTPUT W03OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/SALARY.db'
|
||||
END-EXEC.
|
||||
*
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R02読込処理 *
|
||||
*****************************************************************
|
||||
1100R02INNSOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
END-READ.
|
||||
*
|
||||
1100R02INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
MOVE R02EMP-ID TO DBV-EMP-ID.
|
||||
MOVE CNS-YEAR-MONTH-PARM TO DBV-YEAR-MONTH.
|
||||
MOVE R02GROSS-PAYMENT TO DBV-GROSS-PAYMENT.
|
||||
MOVE R02INCOME-TAX TO DBV-INCOME-TAX.
|
||||
MOVE R02INSURANCE TO DBV-INSURANCE.
|
||||
MOVE R02RESIDENT-TAX TO DBV-RESIDENT-TAX.
|
||||
MOVE R02NET-PAYMENT TO DBV-NET-PAYMENT.
|
||||
*
|
||||
EXEC SQL
|
||||
INSERT INTO SALARY-RESULTS
|
||||
(EMP-ID, YEAR-MONTH,
|
||||
GROSS-PAYMENT, INCOME-TAX,
|
||||
INSURANCE, RESIDENT-TAX,
|
||||
NET-PAYMENT, UPDATED-AT)
|
||||
VALUES
|
||||
(:DBV-EMP-ID, :DBV-YEAR-MONTH,
|
||||
:DBV-GROSS-PAYMENT, :DBV-INCOME-TAX,
|
||||
:DBV-INSURANCE, :DBV-RESIDENT-TAX,
|
||||
:DBV-NET-PAYMENT, CURRENT TIMESTAMP)
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-INS
|
||||
PERFORM 1100R02INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
IF SQLCODE = -803
|
||||
EXEC SQL
|
||||
UPDATE SALARY-RESULTS SET
|
||||
GROSS-PAYMENT = :DBV-GROSS-PAYMENT
|
||||
,INCOME-TAX = :DBV-INCOME-TAX
|
||||
,INSURANCE = :DBV-INSURANCE
|
||||
,RESIDENT-TAX = :DBV-RESIDENT-TAX
|
||||
,NET-PAYMENT = :DBV-NET-PAYMENT
|
||||
,UPDATED-AT = CURRENT TIMESTAMP
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
AND YEAR-MONTH = :DBV-YEAR-MONTH
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-UPD
|
||||
ELSE
|
||||
PERFORM 2100ERROUTSOR
|
||||
END-IF
|
||||
PERFORM 1100R02INNSOR
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 2100ERROUTSOR.
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: エラー出力処理 *
|
||||
*****************************************************************
|
||||
2100ERROUTSOR SECTION.
|
||||
*
|
||||
MOVE 'DB-ERR' TO W03ERR-CATEGORY.
|
||||
MOVE DBV-EMP-ID TO W03ERR-DETAIL.
|
||||
WRITE W03OUTREC.
|
||||
ADD 1 TO CUN-W03OUT.
|
||||
*
|
||||
2100ERROUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R02INNFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU06R02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R02INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'DB-INSERT' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-INS TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'DB-UPDATE' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-UPD TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU06W03' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,836 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU07DIV.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU07DIV *
|
||||
* プログラム名 : 部門別分割出力処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : JCL SORT済SALARY-NETを部署コードに応じて *
|
||||
* 50ファイルに分割出力 *
|
||||
* 常に1ファイルのみOPEN *
|
||||
* プログラム分類: No.10 50分割 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL KYU07R01.
|
||||
SELECT SYSIN-FILE ASSIGN TO EXTERNAL KYU07SYS.
|
||||
SELECT W99OUTFIL ASSIGN TO EXTERNAL KYU07W99.
|
||||
SELECT DEPT01-FILE ASSIGN TO EXTERNAL KYU07D01.
|
||||
SELECT DEPT02-FILE ASSIGN TO EXTERNAL KYU07D02.
|
||||
SELECT DEPT03-FILE ASSIGN TO EXTERNAL KYU07D03.
|
||||
SELECT DEPT04-FILE ASSIGN TO EXTERNAL KYU07D04.
|
||||
SELECT DEPT05-FILE ASSIGN TO EXTERNAL KYU07D05.
|
||||
SELECT DEPT06-FILE ASSIGN TO EXTERNAL KYU07D06.
|
||||
SELECT DEPT07-FILE ASSIGN TO EXTERNAL KYU07D07.
|
||||
SELECT DEPT08-FILE ASSIGN TO EXTERNAL KYU07D08.
|
||||
SELECT DEPT09-FILE ASSIGN TO EXTERNAL KYU07D09.
|
||||
SELECT DEPT10-FILE ASSIGN TO EXTERNAL KYU07D10.
|
||||
SELECT DEPT11-FILE ASSIGN TO EXTERNAL KYU07D11.
|
||||
SELECT DEPT12-FILE ASSIGN TO EXTERNAL KYU07D12.
|
||||
SELECT DEPT13-FILE ASSIGN TO EXTERNAL KYU07D13.
|
||||
SELECT DEPT14-FILE ASSIGN TO EXTERNAL KYU07D14.
|
||||
SELECT DEPT15-FILE ASSIGN TO EXTERNAL KYU07D15.
|
||||
SELECT DEPT16-FILE ASSIGN TO EXTERNAL KYU07D16.
|
||||
SELECT DEPT17-FILE ASSIGN TO EXTERNAL KYU07D17.
|
||||
SELECT DEPT18-FILE ASSIGN TO EXTERNAL KYU07D18.
|
||||
SELECT DEPT19-FILE ASSIGN TO EXTERNAL KYU07D19.
|
||||
SELECT DEPT20-FILE ASSIGN TO EXTERNAL KYU07D20.
|
||||
SELECT DEPT21-FILE ASSIGN TO EXTERNAL KYU07D21.
|
||||
SELECT DEPT22-FILE ASSIGN TO EXTERNAL KYU07D22.
|
||||
SELECT DEPT23-FILE ASSIGN TO EXTERNAL KYU07D23.
|
||||
SELECT DEPT24-FILE ASSIGN TO EXTERNAL KYU07D24.
|
||||
SELECT DEPT25-FILE ASSIGN TO EXTERNAL KYU07D25.
|
||||
SELECT DEPT26-FILE ASSIGN TO EXTERNAL KYU07D26.
|
||||
SELECT DEPT27-FILE ASSIGN TO EXTERNAL KYU07D27.
|
||||
SELECT DEPT28-FILE ASSIGN TO EXTERNAL KYU07D28.
|
||||
SELECT DEPT29-FILE ASSIGN TO EXTERNAL KYU07D29.
|
||||
SELECT DEPT30-FILE ASSIGN TO EXTERNAL KYU07D30.
|
||||
SELECT DEPT31-FILE ASSIGN TO EXTERNAL KYU07D31.
|
||||
SELECT DEPT32-FILE ASSIGN TO EXTERNAL KYU07D32.
|
||||
SELECT DEPT33-FILE ASSIGN TO EXTERNAL KYU07D33.
|
||||
SELECT DEPT34-FILE ASSIGN TO EXTERNAL KYU07D34.
|
||||
SELECT DEPT35-FILE ASSIGN TO EXTERNAL KYU07D35.
|
||||
SELECT DEPT36-FILE ASSIGN TO EXTERNAL KYU07D36.
|
||||
SELECT DEPT37-FILE ASSIGN TO EXTERNAL KYU07D37.
|
||||
SELECT DEPT38-FILE ASSIGN TO EXTERNAL KYU07D38.
|
||||
SELECT DEPT39-FILE ASSIGN TO EXTERNAL KYU07D39.
|
||||
SELECT DEPT40-FILE ASSIGN TO EXTERNAL KYU07D40.
|
||||
SELECT DEPT41-FILE ASSIGN TO EXTERNAL KYU07D41.
|
||||
SELECT DEPT42-FILE ASSIGN TO EXTERNAL KYU07D42.
|
||||
SELECT DEPT43-FILE ASSIGN TO EXTERNAL KYU07D43.
|
||||
SELECT DEPT44-FILE ASSIGN TO EXTERNAL KYU07D44.
|
||||
SELECT DEPT45-FILE ASSIGN TO EXTERNAL KYU07D45.
|
||||
SELECT DEPT46-FILE ASSIGN TO EXTERNAL KYU07D46.
|
||||
SELECT DEPT47-FILE ASSIGN TO EXTERNAL KYU07D47.
|
||||
SELECT DEPT48-FILE ASSIGN TO EXTERNAL KYU07D48.
|
||||
SELECT DEPT49-FILE ASSIGN TO EXTERNAL KYU07D49.
|
||||
SELECT DEPT50-FILE ASSIGN TO EXTERNAL KYU07D50.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: SALARY-NET（200B FB JCL SORT済み） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* SYSIN: 制御カード *
|
||||
*****************************************************************
|
||||
FD SYSIN-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
RECORDING MODE IS F.
|
||||
01 SYSIN-REC PIC X(080).
|
||||
*
|
||||
*****************************************************************
|
||||
* W99: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W99OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W99OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W99==.
|
||||
*
|
||||
*****************************************************************
|
||||
* DEPT01〜50（各200B FB） *
|
||||
*****************************************************************
|
||||
FD DEPT01-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT01-REC PIC X(200).
|
||||
FD DEPT02-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT02-REC PIC X(200).
|
||||
FD DEPT03-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT03-REC PIC X(200).
|
||||
FD DEPT04-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT04-REC PIC X(200).
|
||||
FD DEPT05-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT05-REC PIC X(200).
|
||||
FD DEPT06-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT06-REC PIC X(200).
|
||||
FD DEPT07-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT07-REC PIC X(200).
|
||||
FD DEPT08-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT08-REC PIC X(200).
|
||||
FD DEPT09-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT09-REC PIC X(200).
|
||||
FD DEPT10-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT10-REC PIC X(200).
|
||||
FD DEPT11-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT11-REC PIC X(200).
|
||||
FD DEPT12-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT12-REC PIC X(200).
|
||||
FD DEPT13-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT13-REC PIC X(200).
|
||||
FD DEPT14-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT14-REC PIC X(200).
|
||||
FD DEPT15-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT15-REC PIC X(200).
|
||||
FD DEPT16-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT16-REC PIC X(200).
|
||||
FD DEPT17-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT17-REC PIC X(200).
|
||||
FD DEPT18-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT18-REC PIC X(200).
|
||||
FD DEPT19-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT19-REC PIC X(200).
|
||||
FD DEPT20-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT20-REC PIC X(200).
|
||||
FD DEPT21-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT21-REC PIC X(200).
|
||||
FD DEPT22-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT22-REC PIC X(200).
|
||||
FD DEPT23-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT23-REC PIC X(200).
|
||||
FD DEPT24-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT24-REC PIC X(200).
|
||||
FD DEPT25-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT25-REC PIC X(200).
|
||||
FD DEPT26-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT26-REC PIC X(200).
|
||||
FD DEPT27-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT27-REC PIC X(200).
|
||||
FD DEPT28-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT28-REC PIC X(200).
|
||||
FD DEPT29-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT29-REC PIC X(200).
|
||||
FD DEPT30-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT30-REC PIC X(200).
|
||||
FD DEPT31-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT31-REC PIC X(200).
|
||||
FD DEPT32-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT32-REC PIC X(200).
|
||||
FD DEPT33-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT33-REC PIC X(200).
|
||||
FD DEPT34-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT34-REC PIC X(200).
|
||||
FD DEPT35-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT35-REC PIC X(200).
|
||||
FD DEPT36-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT36-REC PIC X(200).
|
||||
FD DEPT37-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT37-REC PIC X(200).
|
||||
FD DEPT38-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT38-REC PIC X(200).
|
||||
FD DEPT39-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT39-REC PIC X(200).
|
||||
FD DEPT40-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT40-REC PIC X(200).
|
||||
FD DEPT41-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT41-REC PIC X(200).
|
||||
FD DEPT42-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT42-REC PIC X(200).
|
||||
FD DEPT43-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT43-REC PIC X(200).
|
||||
FD DEPT44-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT44-REC PIC X(200).
|
||||
FD DEPT45-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT45-REC PIC X(200).
|
||||
FD DEPT46-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT46-REC PIC X(200).
|
||||
FD DEPT47-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT47-REC PIC X(200).
|
||||
FD DEPT48-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT48-REC PIC X(200).
|
||||
FD DEPT49-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT49-REC PIC X(200).
|
||||
FD DEPT50-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 DEPT50-REC PIC X(200).
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU07DIV'.
|
||||
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 CUNARA.
|
||||
03 CUN-R01INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W99OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DEPT-OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-DEPT-CODE PIC X(002).
|
||||
03 WRK-PREV-DEPT PIC X(002).
|
||||
03 WRK-FIRST PIC X(001) VALUE '1'.
|
||||
88 WRK-FIRST-Y VALUE '1'.
|
||||
88 WRK-FIRST-N VALUE '0'.
|
||||
*** SYSIN対象部署テーブル
|
||||
03 WRK-TARGET-DEPT.
|
||||
05 WRK-TARGET OCCURS 50 TIMES
|
||||
INDEXED BY TD-IDX.
|
||||
07 WRK-TARGET-CODE PIC X(002).
|
||||
03 WRK-TARGET-COUNT PIC 9(002) VALUE 50.
|
||||
03 WRK-HAS-TARGET PIC X(001).
|
||||
88 WRK-ALL-DEPTS VALUE 'A'.
|
||||
88 WRK-FILTER-DEPTS VALUE 'F'.
|
||||
*** パース用
|
||||
03 WRK-SYSIN-LINE PIC X(080).
|
||||
03 WRK-I PIC 9(002).
|
||||
03 WRK-J PIC 9(002).
|
||||
03 WRK-TOKEN PIC X(080).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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.
|
||||
MOVE '1' TO WRK-FIRST.
|
||||
*
|
||||
*** SYSIN読込（対象部署指定）
|
||||
PERFORM 1100SYSINSOR.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W99OUTFIL.
|
||||
*
|
||||
PERFORM 1200R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: SYSIN読込処理 *
|
||||
*****************************************************************
|
||||
1100SYSINSOR SECTION.
|
||||
*
|
||||
OPEN INPUT SYSIN-FILE.
|
||||
READ SYSIN-FILE
|
||||
INTO WRK-SYSIN-LINE
|
||||
AT END
|
||||
SET WRK-ALL-DEPTS TO TRUE
|
||||
END-READ.
|
||||
CLOSE SYSIN-FILE.
|
||||
*
|
||||
IF WRK-ALL-DEPTS
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** "DEPT=01,02,05,10" 形式パース
|
||||
MOVE WRK-SYSIN-LINE TO WRK-TOKEN.
|
||||
MOVE ZERO TO WRK-TARGET-COUNT.
|
||||
MOVE 1 TO WRK-J.
|
||||
*
|
||||
PERFORM VARYING WRK-I FROM 1 BY 1
|
||||
UNTIL WRK-I > 80
|
||||
OR WRK-SYSIN-LINE(WRK-I:1) = SPACE
|
||||
OR WRK-SYSIN-LINE(WRK-I:1) = '='
|
||||
CONTINUE
|
||||
END-PERFORM.
|
||||
*
|
||||
ADD 1 TO WRK-I.
|
||||
PERFORM VARYING WRK-J FROM 1 BY 1
|
||||
UNTIL WRK-I > 80
|
||||
OR WRK-SYSIN-LINE(WRK-I:1) = SPACE
|
||||
IF WRK-SYSIN-LINE(WRK-I:1) = ','
|
||||
ADD 1 TO WRK-I
|
||||
CONTINUE
|
||||
END-IF
|
||||
ADD 1 TO WRK-TARGET-COUNT
|
||||
MOVE WRK-SYSIN-LINE(WRK-I:2)
|
||||
TO
|
||||
WRK-TARGET-CODE(WRK-TARGET-COUNT)
|
||||
ADD 2 TO WRK-I
|
||||
END-PERFORM.
|
||||
*
|
||||
IF WRK-TARGET-COUNT > 0
|
||||
SET WRK-FILTER-DEPTS TO TRUE
|
||||
ELSE
|
||||
SET WRK-ALL-DEPTS TO TRUE
|
||||
END-IF.
|
||||
*
|
||||
1100SYSINSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.2) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
*****************************************************************
|
||||
1200R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1200R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
MOVE R01DEPT-CODE TO WRK-DEPT-CODE.
|
||||
*
|
||||
*** SYSIN対象部署フィルタ
|
||||
IF WRK-FILTER-DEPTS
|
||||
SET TD-IDX TO 1
|
||||
SEARCH WRK-TARGET
|
||||
AT END
|
||||
PERFORM 1200R01INNSOR
|
||||
EXIT SECTION
|
||||
WHEN WRK-TARGET-CODE(TD-IDX) = WRK-DEPT-CODE
|
||||
CONTINUE
|
||||
END-SEARCH
|
||||
END-IF.
|
||||
*
|
||||
*** 部署切替
|
||||
IF WRK-FIRST-Y
|
||||
MOVE '0' TO WRK-FIRST
|
||||
PERFORM 2100OPENSOR
|
||||
ELSE
|
||||
IF WRK-PREV-DEPT NOT = WRK-DEPT-CODE
|
||||
PERFORM 2200CLOSESOR
|
||||
PERFORM 2100OPENSOR
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
MOVE WRK-DEPT-CODE TO WRK-PREV-DEPT.
|
||||
*
|
||||
*** 該当ファイルにWRITE
|
||||
PERFORM 2300WRITESOR.
|
||||
*
|
||||
PERFORM 1200R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 部署ファイルOPEN処理 *
|
||||
*****************************************************************
|
||||
2100OPENSOR SECTION.
|
||||
*
|
||||
EVALUATE WRK-DEPT-CODE
|
||||
WHEN '01' OPEN OUTPUT DEPT01-FILE
|
||||
WHEN '02' OPEN OUTPUT DEPT02-FILE
|
||||
WHEN '03' OPEN OUTPUT DEPT03-FILE
|
||||
WHEN '04' OPEN OUTPUT DEPT04-FILE
|
||||
WHEN '05' OPEN OUTPUT DEPT05-FILE
|
||||
WHEN '06' OPEN OUTPUT DEPT06-FILE
|
||||
WHEN '07' OPEN OUTPUT DEPT07-FILE
|
||||
WHEN '08' OPEN OUTPUT DEPT08-FILE
|
||||
WHEN '09' OPEN OUTPUT DEPT09-FILE
|
||||
WHEN '10' OPEN OUTPUT DEPT10-FILE
|
||||
WHEN '11' OPEN OUTPUT DEPT11-FILE
|
||||
WHEN '12' OPEN OUTPUT DEPT12-FILE
|
||||
WHEN '13' OPEN OUTPUT DEPT13-FILE
|
||||
WHEN '14' OPEN OUTPUT DEPT14-FILE
|
||||
WHEN '15' OPEN OUTPUT DEPT15-FILE
|
||||
WHEN '16' OPEN OUTPUT DEPT16-FILE
|
||||
WHEN '17' OPEN OUTPUT DEPT17-FILE
|
||||
WHEN '18' OPEN OUTPUT DEPT18-FILE
|
||||
WHEN '19' OPEN OUTPUT DEPT19-FILE
|
||||
WHEN '20' OPEN OUTPUT DEPT20-FILE
|
||||
WHEN '21' OPEN OUTPUT DEPT21-FILE
|
||||
WHEN '22' OPEN OUTPUT DEPT22-FILE
|
||||
WHEN '23' OPEN OUTPUT DEPT23-FILE
|
||||
WHEN '24' OPEN OUTPUT DEPT24-FILE
|
||||
WHEN '25' OPEN OUTPUT DEPT25-FILE
|
||||
WHEN '26' OPEN OUTPUT DEPT26-FILE
|
||||
WHEN '27' OPEN OUTPUT DEPT27-FILE
|
||||
WHEN '28' OPEN OUTPUT DEPT28-FILE
|
||||
WHEN '29' OPEN OUTPUT DEPT29-FILE
|
||||
WHEN '30' OPEN OUTPUT DEPT30-FILE
|
||||
WHEN '31' OPEN OUTPUT DEPT31-FILE
|
||||
WHEN '32' OPEN OUTPUT DEPT32-FILE
|
||||
WHEN '33' OPEN OUTPUT DEPT33-FILE
|
||||
WHEN '34' OPEN OUTPUT DEPT34-FILE
|
||||
WHEN '35' OPEN OUTPUT DEPT35-FILE
|
||||
WHEN '36' OPEN OUTPUT DEPT36-FILE
|
||||
WHEN '37' OPEN OUTPUT DEPT37-FILE
|
||||
WHEN '38' OPEN OUTPUT DEPT38-FILE
|
||||
WHEN '39' OPEN OUTPUT DEPT39-FILE
|
||||
WHEN '40' OPEN OUTPUT DEPT40-FILE
|
||||
WHEN '41' OPEN OUTPUT DEPT41-FILE
|
||||
WHEN '42' OPEN OUTPUT DEPT42-FILE
|
||||
WHEN '43' OPEN OUTPUT DEPT43-FILE
|
||||
WHEN '44' OPEN OUTPUT DEPT44-FILE
|
||||
WHEN '45' OPEN OUTPUT DEPT45-FILE
|
||||
WHEN '46' OPEN OUTPUT DEPT46-FILE
|
||||
WHEN '47' OPEN OUTPUT DEPT47-FILE
|
||||
WHEN '48' OPEN OUTPUT DEPT48-FILE
|
||||
WHEN '49' OPEN OUTPUT DEPT49-FILE
|
||||
WHEN '50' OPEN OUTPUT DEPT50-FILE
|
||||
WHEN OTHER
|
||||
MOVE 'INVALID DEPT' TO W99ERR-DETAIL
|
||||
WRITE W99OUTREC
|
||||
ADD 1 TO CUN-W99OUT
|
||||
END-EVALUATE.
|
||||
*
|
||||
2100OPENSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 部署ファイルCLOSE+LOCK処理 *
|
||||
*****************************************************************
|
||||
2200CLOSESOR SECTION.
|
||||
*
|
||||
EVALUATE WRK-PREV-DEPT
|
||||
WHEN '01' CLOSE DEPT01-FILE WITH LOCK
|
||||
WHEN '02' CLOSE DEPT02-FILE WITH LOCK
|
||||
WHEN '03' CLOSE DEPT03-FILE WITH LOCK
|
||||
WHEN '04' CLOSE DEPT04-FILE WITH LOCK
|
||||
WHEN '05' CLOSE DEPT05-FILE WITH LOCK
|
||||
WHEN '06' CLOSE DEPT06-FILE WITH LOCK
|
||||
WHEN '07' CLOSE DEPT07-FILE WITH LOCK
|
||||
WHEN '08' CLOSE DEPT08-FILE WITH LOCK
|
||||
WHEN '09' CLOSE DEPT09-FILE WITH LOCK
|
||||
WHEN '10' CLOSE DEPT10-FILE WITH LOCK
|
||||
WHEN '11' CLOSE DEPT11-FILE WITH LOCK
|
||||
WHEN '12' CLOSE DEPT12-FILE WITH LOCK
|
||||
WHEN '13' CLOSE DEPT13-FILE WITH LOCK
|
||||
WHEN '14' CLOSE DEPT14-FILE WITH LOCK
|
||||
WHEN '15' CLOSE DEPT15-FILE WITH LOCK
|
||||
WHEN '16' CLOSE DEPT16-FILE WITH LOCK
|
||||
WHEN '17' CLOSE DEPT17-FILE WITH LOCK
|
||||
WHEN '18' CLOSE DEPT18-FILE WITH LOCK
|
||||
WHEN '19' CLOSE DEPT19-FILE WITH LOCK
|
||||
WHEN '20' CLOSE DEPT20-FILE WITH LOCK
|
||||
WHEN '21' CLOSE DEPT21-FILE WITH LOCK
|
||||
WHEN '22' CLOSE DEPT22-FILE WITH LOCK
|
||||
WHEN '23' CLOSE DEPT23-FILE WITH LOCK
|
||||
WHEN '24' CLOSE DEPT24-FILE WITH LOCK
|
||||
WHEN '25' CLOSE DEPT25-FILE WITH LOCK
|
||||
WHEN '26' CLOSE DEPT26-FILE WITH LOCK
|
||||
WHEN '27' CLOSE DEPT27-FILE WITH LOCK
|
||||
WHEN '28' CLOSE DEPT28-FILE WITH LOCK
|
||||
WHEN '29' CLOSE DEPT29-FILE WITH LOCK
|
||||
WHEN '30' CLOSE DEPT30-FILE WITH LOCK
|
||||
WHEN '31' CLOSE DEPT31-FILE WITH LOCK
|
||||
WHEN '32' CLOSE DEPT32-FILE WITH LOCK
|
||||
WHEN '33' CLOSE DEPT33-FILE WITH LOCK
|
||||
WHEN '34' CLOSE DEPT34-FILE WITH LOCK
|
||||
WHEN '35' CLOSE DEPT35-FILE WITH LOCK
|
||||
WHEN '36' CLOSE DEPT36-FILE WITH LOCK
|
||||
WHEN '37' CLOSE DEPT37-FILE WITH LOCK
|
||||
WHEN '38' CLOSE DEPT38-FILE WITH LOCK
|
||||
WHEN '39' CLOSE DEPT39-FILE WITH LOCK
|
||||
WHEN '40' CLOSE DEPT40-FILE WITH LOCK
|
||||
WHEN '41' CLOSE DEPT41-FILE WITH LOCK
|
||||
WHEN '42' CLOSE DEPT42-FILE WITH LOCK
|
||||
WHEN '43' CLOSE DEPT43-FILE WITH LOCK
|
||||
WHEN '44' CLOSE DEPT44-FILE WITH LOCK
|
||||
WHEN '45' CLOSE DEPT45-FILE WITH LOCK
|
||||
WHEN '46' CLOSE DEPT46-FILE WITH LOCK
|
||||
WHEN '47' CLOSE DEPT47-FILE WITH LOCK
|
||||
WHEN '48' CLOSE DEPT48-FILE WITH LOCK
|
||||
WHEN '49' CLOSE DEPT49-FILE WITH LOCK
|
||||
WHEN '50' CLOSE DEPT50-FILE WITH LOCK
|
||||
WHEN OTHER
|
||||
CONTINUE
|
||||
END-EVALUATE.
|
||||
*
|
||||
2200CLOSESOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: 部署WRITE処理 *
|
||||
*****************************************************************
|
||||
2300WRITESOR SECTION.
|
||||
*
|
||||
EVALUATE WRK-DEPT-CODE
|
||||
WHEN '01' WRITE DEPT01-REC FROM R01INNREC
|
||||
WHEN '02' WRITE DEPT02-REC FROM R01INNREC
|
||||
WHEN '03' WRITE DEPT03-REC FROM R01INNREC
|
||||
WHEN '04' WRITE DEPT04-REC FROM R01INNREC
|
||||
WHEN '05' WRITE DEPT05-REC FROM R01INNREC
|
||||
WHEN '06' WRITE DEPT06-REC FROM R01INNREC
|
||||
WHEN '07' WRITE DEPT07-REC FROM R01INNREC
|
||||
WHEN '08' WRITE DEPT08-REC FROM R01INNREC
|
||||
WHEN '09' WRITE DEPT09-REC FROM R01INNREC
|
||||
WHEN '10' WRITE DEPT10-REC FROM R01INNREC
|
||||
WHEN '11' WRITE DEPT11-REC FROM R01INNREC
|
||||
WHEN '12' WRITE DEPT12-REC FROM R01INNREC
|
||||
WHEN '13' WRITE DEPT13-REC FROM R01INNREC
|
||||
WHEN '14' WRITE DEPT14-REC FROM R01INNREC
|
||||
WHEN '15' WRITE DEPT15-REC FROM R01INNREC
|
||||
WHEN '16' WRITE DEPT16-REC FROM R01INNREC
|
||||
WHEN '17' WRITE DEPT17-REC FROM R01INNREC
|
||||
WHEN '18' WRITE DEPT18-REC FROM R01INNREC
|
||||
WHEN '19' WRITE DEPT19-REC FROM R01INNREC
|
||||
WHEN '20' WRITE DEPT20-REC FROM R01INNREC
|
||||
WHEN '21' WRITE DEPT21-REC FROM R01INNREC
|
||||
WHEN '22' WRITE DEPT22-REC FROM R01INNREC
|
||||
WHEN '23' WRITE DEPT23-REC FROM R01INNREC
|
||||
WHEN '24' WRITE DEPT24-REC FROM R01INNREC
|
||||
WHEN '25' WRITE DEPT25-REC FROM R01INNREC
|
||||
WHEN '26' WRITE DEPT26-REC FROM R01INNREC
|
||||
WHEN '27' WRITE DEPT27-REC FROM R01INNREC
|
||||
WHEN '28' WRITE DEPT28-REC FROM R01INNREC
|
||||
WHEN '29' WRITE DEPT29-REC FROM R01INNREC
|
||||
WHEN '30' WRITE DEPT30-REC FROM R01INNREC
|
||||
WHEN '31' WRITE DEPT31-REC FROM R01INNREC
|
||||
WHEN '32' WRITE DEPT32-REC FROM R01INNREC
|
||||
WHEN '33' WRITE DEPT33-REC FROM R01INNREC
|
||||
WHEN '34' WRITE DEPT34-REC FROM R01INNREC
|
||||
WHEN '35' WRITE DEPT35-REC FROM R01INNREC
|
||||
WHEN '36' WRITE DEPT36-REC FROM R01INNREC
|
||||
WHEN '37' WRITE DEPT37-REC FROM R01INNREC
|
||||
WHEN '38' WRITE DEPT38-REC FROM R01INNREC
|
||||
WHEN '39' WRITE DEPT39-REC FROM R01INNREC
|
||||
WHEN '40' WRITE DEPT40-REC FROM R01INNREC
|
||||
WHEN '41' WRITE DEPT41-REC FROM R01INNREC
|
||||
WHEN '42' WRITE DEPT42-REC FROM R01INNREC
|
||||
WHEN '43' WRITE DEPT43-REC FROM R01INNREC
|
||||
WHEN '44' WRITE DEPT44-REC FROM R01INNREC
|
||||
WHEN '45' WRITE DEPT45-REC FROM R01INNREC
|
||||
WHEN '46' WRITE DEPT46-REC FROM R01INNREC
|
||||
WHEN '47' WRITE DEPT47-REC FROM R01INNREC
|
||||
WHEN '48' WRITE DEPT48-REC FROM R01INNREC
|
||||
WHEN '49' WRITE DEPT49-REC FROM R01INNREC
|
||||
WHEN '50' WRITE DEPT50-REC FROM R01INNREC
|
||||
WHEN OTHER
|
||||
CONTINUE
|
||||
END-EVALUATE.
|
||||
ADD 1 TO CUN-DEPT-OUT.
|
||||
*
|
||||
2300WRITESOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 最終部署CLOSE
|
||||
IF WRK-PREV-DEPT > SPACES
|
||||
PERFORM 2200CLOSESOR
|
||||
END-IF.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W99OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU07R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'DEPT-OUT' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DEPT-OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU07W99' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W99OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
3000STPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (4.0) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,304 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU08PRI.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU08PRI *
|
||||
* プログラム名 : 給与明細印刷処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : JCL SORT済みSALARY-NETを給与明細（LINAGE） *
|
||||
* として印刷出力。1社員1ページ。 *
|
||||
* プログラム分類: No.04 レイアウト編集のみ（GETPUT）+ LINAGE *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL KYU08R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL KYU08W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL KYU08W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: SALARY-NET（200B FB JCL SORT済み） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: PAYSLIP印刷（LINAGE 66行/ページ） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
LINAGE IS 66 LINES
|
||||
WITH FOOTING AT 60
|
||||
LINES AT TOP 6
|
||||
LINES AT BOTTOM 6.
|
||||
01 W01OUTREC.
|
||||
COPY KYU05REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU08PRI'.
|
||||
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.
|
||||
03 CNS-HEADER-LINES PIC 9(002) VALUE 6.
|
||||
03 CNS-DETAIL-LINES PIC 9(002) VALUE 54.
|
||||
03 CNS-FOOTER-LINES PIC 9(002) VALUE 6.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
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-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-LINE-NO PIC 9(002).
|
||||
03 WRK-PAGE-COUNTER PIC 9(004) VALUE 0.
|
||||
*
|
||||
*****************************************************************
|
||||
* 印刷行定義 *
|
||||
*****************************************************************
|
||||
01 HEADER-LINE.
|
||||
05 HL-TITLE PIC X(040)
|
||||
VALUE '========== 給与明細書 =========='.
|
||||
05 FILLER PIC X(010) VALUE SPACES.
|
||||
05 HL-PAGE-NO PIC Z(03)9 VALUE ZERO.
|
||||
05 FILLER PIC X(002) VALUE 'PG'.
|
||||
05 FILLER PIC X(144) VALUE SPACES.
|
||||
*
|
||||
01 DETAIL-LINE.
|
||||
05 DL-EMP-ID PIC X(008).
|
||||
05 FILLER PIC X(002) VALUE SPACES.
|
||||
05 DL-EMP-NAME PIC X(020)
|
||||
JUSTIFIED RIGHT.
|
||||
05 FILLER PIC X(002) VALUE SPACES.
|
||||
05 DL-BASIC-SALARY PIC Z(08)9
|
||||
BLANK WHEN ZERO.
|
||||
05 FILLER PIC X(002) VALUE SPACES.
|
||||
05 DL-NET-PAYMENT PIC Z(08)9
|
||||
BLANK WHEN ZERO.
|
||||
05 FILLER PIC X(146) VALUE SPACES.
|
||||
*
|
||||
01 FOOTER-LINE.
|
||||
05 FL-MSG PIC X(040)
|
||||
VALUE '--- 明細終了 ---'.
|
||||
05 FILLER PIC X(160) VALUE SPACES.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANDATAC.
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
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
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
*****************************************************************
|
||||
1100R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1100R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** ヘッダ出力（改ページ + ページ番号）
|
||||
ADD 1 TO WRK-PAGE-COUNTER.
|
||||
MOVE WRK-PAGE-COUNTER TO HL-PAGE-NO.
|
||||
WRITE W01OUTREC
|
||||
FROM HEADER-LINE
|
||||
BEFORE ADVANCING PAGE.
|
||||
*
|
||||
*** 明細行編集
|
||||
MOVE R01EMP-ID TO DL-EMP-ID.
|
||||
MOVE R01EMP-NAME TO DL-EMP-NAME.
|
||||
MOVE R01GROSS-PAYMENT TO DL-BASIC-SALARY.
|
||||
MOVE R01NET-PAYMENT TO DL-NET-PAYMENT.
|
||||
*
|
||||
WRITE W01OUTREC
|
||||
FROM DETAIL-LINE
|
||||
BEFORE ADVANCING 1 LINE
|
||||
AT END-OF-PAGE
|
||||
WRITE W01OUTREC
|
||||
FROM FOOTER-LINE
|
||||
BEFORE ADVANCING PAGE
|
||||
END-WRITE.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
*** フッタ出力（改ページ）
|
||||
WRITE W01OUTREC
|
||||
FROM FOOTER-LINE
|
||||
BEFORE ADVANCING PAGE.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'KYU08R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU08W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU08W02' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
@@ -0,0 +1,349 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU09MRG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
* プログラムID : KYU09MRG *
|
||||
* プログラム名 : 支給データ結合処理 *
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : SALARY-NETとBONUS-DATAをMERGE文で *
|
||||
* 社員番号昇順に結合し、同一社員内の *
|
||||
* 給与（TYPE=S）と賞与（TYPE=B）を統合 *
|
||||
* プログラム分類: No.35 MERGE（複数ファイル結合） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT MERGE-FILE ASSIGN TO EXTERNAL KYU09M99.
|
||||
SELECT SALARY-FILE ASSIGN TO EXTERNAL KYU09M01.
|
||||
SELECT BONUS-FILE ASSIGN TO EXTERNAL KYU09M02.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL KYU09W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL KYU09W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* MERGE: 作業ファイル *
|
||||
*****************************************************************
|
||||
SD MERGE-FILE.
|
||||
01 MERGE-REC.
|
||||
05 MERGE-EMP-ID PIC X(008).
|
||||
05 MERGE-REC-TYPE PIC X(001).
|
||||
05 MERGE-EMP-NAME PIC X(040).
|
||||
05 MERGE-DEPT-CODE PIC X(002).
|
||||
05 MERGE-REGION-CODE PIC X(002).
|
||||
05 MERGE-CATEGORY-CODE PIC X(003).
|
||||
05 MERGE-GROSS-PAYMENT PIC 9(009).
|
||||
05 MERGE-INCOME-TAX PIC 9(009).
|
||||
05 MERGE-INSURANCE PIC 9(009).
|
||||
05 MERGE-RESIDENT-TAX PIC 9(009).
|
||||
05 MERGE-NET-PAYMENT PIC 9(009).
|
||||
05 MERGE-TAXABLE-INCOME PIC 9(009).
|
||||
05 MERGE-PAY-AMOUNT PIC 9(009).
|
||||
05 FILLER PIC X(081).
|
||||
*
|
||||
*****************************************************************
|
||||
* M01: SALARY-NET（200B FB S=給与レコード） *
|
||||
*****************************************************************
|
||||
FD SALARY-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 SALARY-REC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==SA==.
|
||||
*
|
||||
*****************************************************************
|
||||
* M02: BONUS-DATA（200B FB B=賞与レコード） *
|
||||
*****************************************************************
|
||||
FD BONUS-FILE
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 BONUS-REC.
|
||||
COPY KYU04REC REPLACING ==(A)== BY ==BO==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: PAYMENT-DATA（200B FB） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY KYU06REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY KYU99REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU09MRG'.
|
||||
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.
|
||||
03 CNS-PAY-TYPE-SALARY PIC X(001) VALUE 'S'.
|
||||
03 CNS-PAY-TYPE-BONUS PIC X(001) VALUE 'B'.
|
||||
03 CNS-PAY-TYPE-TOTAL PIC X(001) VALUE 'T'.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-MERGE-EOF PIC X(001).
|
||||
88 WRK-MERGE-EOF-Y VALUE '1'.
|
||||
03 WRK-CURRENT-EMP PIC X(008).
|
||||
03 WRK-SALARY-AMOUNT PIC 9(009).
|
||||
03 WRK-BONUS-AMOUNT PIC 9(009).
|
||||
03 WRK-TOTAL-PAYMENT PIC 9(009).
|
||||
03 WRK-BANK-CODE PIC X(004).
|
||||
03 WRK-ACCOUNT-NO PIC 9(008).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY ZANDATAC.
|
||||
COPY ZANMSGAC.
|
||||
COPY ZANENDAC.
|
||||
*
|
||||
LINKAGE SECTION.
|
||||
*
|
||||
01 ENTRYPAR.
|
||||
03 ENTRY-EMP-ID PIC X(008).
|
||||
03 ENTRY-YEAR-MONTH PIC X(006).
|
||||
03 ENTRY-MODE PIC X(001).
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
*
|
||||
*** MERGE実行
|
||||
MERGE MERGE-FILE
|
||||
ON ASCENDING KEY MERGE-EMP-ID
|
||||
USING SALARY-FILE
|
||||
BONUS-FILE
|
||||
OUTPUT PROCEDURE 2000MRGOUTSOR.
|
||||
*
|
||||
PERFORM 3000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*
|
||||
*****************************************************************
|
||||
* ENTRY代替エントリポイント（直接結合モード） *
|
||||
*****************************************************************
|
||||
ENTRY 'KYU09ENT' USING ENTRYPAR.
|
||||
*
|
||||
0010DIRECTSOR SECTION.
|
||||
*
|
||||
MOVE 'DIRECT ENTRY' TO W02ERR-DETAIL.
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
0010DIRECTSOR-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
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: MERGE出力処理 *
|
||||
*****************************************************************
|
||||
2000MRGOUTSOR SECTION.
|
||||
*
|
||||
*** MERGE結果受取 → 同一社員統合
|
||||
PERFORM WITH TEST AFTER
|
||||
UNTIL WRK-MERGE-EOF-Y
|
||||
RETURN MERGE-FILE
|
||||
INTO MERGE-REC
|
||||
AT END
|
||||
SET WRK-MERGE-EOF-Y TO TRUE
|
||||
END-RETURN
|
||||
IF NOT WRK-MERGE-EOF-Y
|
||||
MOVE MERGE-EMP-ID
|
||||
TO WRK-CURRENT-EMP
|
||||
MOVE ZERO TO WRK-SALARY-AMOUNT
|
||||
MOVE ZERO TO WRK-BONUS-AMOUNT
|
||||
MOVE ZERO TO WRK-TOTAL-PAYMENT
|
||||
PERFORM UNTIL
|
||||
WRK-CURRENT-EMP NOT =
|
||||
MERGE-EMP-ID OF MERGE-REC
|
||||
IF MERGE-REC-TYPE
|
||||
= CNS-PAY-TYPE-SALARY
|
||||
MOVE MERGE-PAY-AMOUNT
|
||||
TO WRK-SALARY-AMOUNT
|
||||
MOVE MERGE-GROSS-PAYMENT
|
||||
TO WRK-BANK-CODE
|
||||
MOVE MERGE-EMP-ID(1:4)
|
||||
TO WRK-ACCOUNT-NO
|
||||
ELSE
|
||||
MOVE MERGE-PAY-AMOUNT
|
||||
TO WRK-BONUS-AMOUNT
|
||||
END-IF
|
||||
RETURN MERGE-FILE
|
||||
INTO MERGE-REC
|
||||
AT END
|
||||
MOVE HIGH-VALUES
|
||||
TO MERGE-EMP-ID
|
||||
EXIT PERFORM
|
||||
END-RETURN
|
||||
END-PERFORM
|
||||
*** 一社員分の統合データ書出
|
||||
ADD WRK-SALARY-AMOUNT
|
||||
TO WRK-BONUS-AMOUNT
|
||||
GIVING WRK-TOTAL-PAYMENT
|
||||
PERFORM 2100PAYOUTSOR
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
2000MRGOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: PAYMENT-DATA出力処理 *
|
||||
*****************************************************************
|
||||
2100PAYOUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
MOVE WRK-CURRENT-EMP TO W01EMP-ID.
|
||||
MOVE CNS-PAY-TYPE-TOTAL TO W01PAY-TYPE.
|
||||
MOVE WRK-TOTAL-PAYMENT TO W01AMOUNT.
|
||||
MOVE WRK-BANK-CODE TO W01BANK-CODE.
|
||||
MOVE WRK-ACCOUNT-NO TO W01ACCOUNT-NO.
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2100PAYOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'MERGE-FILE' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU09W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'KYU09W02' 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) *
|
||||
* サブモジュール名: メッセージ出力処理 *
|
||||
*****************************************************************
|
||||
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処理 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
Reference in New Issue
Block a user