qiuqiuqiu/cobol-tna-system
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add Subsystem C (KYU01-09): all 9 programs, design docs, resource lists, DDL, COPY, coverage stats

Browse Source 
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
2026-07-09 08:09:59 +08:00
parent 02dd36e094
commit 75475b3fa1
43 changed files with 7212 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/KYU04CAL.cbl
+457
View File
@@ -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.