Add Subsystem D (SHA01-10): social insurance subsystem + design-resource consistency fixes
- Add SHA01CVT-SHA10S10: all 10 programs, COPY books (13), binaries, design docs, resource usage lists, DDL schema_sha.sql - Add KYU01REC-KYU06REC COPY books (previously missing from git) - Fix design-code inconsistencies detected in audit: - SHA07KBR: remove dead SHACHKAC COPY (SUB04CHK never called) - SHA02MNC: 2020TYPSOR paragraph -> inline EVALUATE; SUB04CHK = PARM val - SHA05TWN: REVISED-TYPE values 'C'/'N' -> 'A'(定期決定)/'B'(月変) - SHA03MNP: 2010CALCSOR/2020WRTSOR -> inline implementation - SHA04TWO: remove GRADE-HISTORY from DB table list (not accessed) - SHA06TWM: add SALARYDB.EMP-MASTER to DB table list - SHA10S10: fix error file W99OUTFIL, 10+1 file count - Fix comment column alignment (Area A col 7) in SHA07KBR, SHA08SRT - Update KYU source/design docs: BOM removal, classification comment cleanup - Update README: Subsystem D added, program count 39
This commit is contained in:
qiuqiuqiu
@@ -0,0 +1,480 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA07KBR.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA07KBR *
|
||||
* プログラム名 : 資格異動キーブレイク処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : DB2 QUALIFICATION-CHANGESから資格異動 *
|
||||
* データをFETCHし、従業員ごと（1:N）かつ *
|
||||
* 保険者コード変更時（異キー）にキーブレイク *
|
||||
* してサマリ・明細を出力する。 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA07W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA07W02.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL SHA07W03.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: CHG-SUMMARY（200B FB） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA07REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: CHG-DETAIL（200B FB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W02OUTREC.
|
||||
COPY SHA07REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W03: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W03OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W03==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA07KBR'.
|
||||
03 CNS-MSGSTR PIC 9(003) VALUE 001.
|
||||
03 CNS-MSGFIN PIC 9(003) VALUE 002.
|
||||
03 CNS-MSGSUBEEK PIC 9(003) VALUE 005.
|
||||
03 CNS-MSGIINKES PIC 9(003) VALUE 006.
|
||||
03 CNS-MSGOUTKES PIC 9(003) VALUE 007.
|
||||
03 CNS-MSGKEYINF PIC 9(003) VALUE 033.
|
||||
03 CNS-KN0002 PIC 9(001) VALUE 2.
|
||||
03 CNS-ABD999 PIC 9(003) VALUE 999.
|
||||
01 CNS-RECTYP-S PIC X(001) VALUE 'S'.
|
||||
01 CNS-RECTYP-D PIC X(001) VALUE 'D'.
|
||||
01 CNS-REASON-CHG PIC X(040)
|
||||
VALUE 'INSURER CHANGED'.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-DB-FETCH PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-U06 PIC 9(008).
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-FIRST PIC X(001).
|
||||
88 WRK-FIRST-Y VALUE '1'.
|
||||
03 WRK-PREV-EMP-ID PIC X(008).
|
||||
03 WRK-PREV-INSURER PIC X(004).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-CHG-ID PIC 9(009).
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-EMP-NAME PIC X(040).
|
||||
03 DBV-CHG-DATE PIC X(008).
|
||||
03 DBV-CHG-TYPE PIC X(002).
|
||||
03 DBV-INSURER-CODE PIC X(004).
|
||||
03 DBV-PREV-INSURER PIC X(004).
|
||||
03 DBV-REASON PIC X(100).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
*** 運用日付取得
|
||||
COPY SHADATAC.
|
||||
*** メッセージ編集出力SR用
|
||||
COPY SHAMSGAC.
|
||||
*** ABEND処理SR用
|
||||
COPY SHAENDAC.
|
||||
*** 項目チェックSR用
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
* 処理概要 : メインコントロール処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-EOF-Y.
|
||||
PERFORM 2500LSTKBRSOR.
|
||||
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 ZERO TO WRK-PREV-EMP-ID.
|
||||
MOVE SPACES TO WRK-PREV-INSURER.
|
||||
*
|
||||
*** 運用日付取得
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD = ZERO
|
||||
MOVE D01UBSUDATE TO WRK-U06
|
||||
ELSE
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 出力ファイルOPEN
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/INSURANCEDB.db'
|
||||
END-EXEC.
|
||||
*
|
||||
*** CURSOR DECLARE
|
||||
EXEC SQL
|
||||
DECLARE CQCHG CURSOR FOR
|
||||
SELECT
|
||||
QC.CHG-ID,
|
||||
QC.EMP-ID,
|
||||
EM.EMP-NAME,
|
||||
QC.CHG-DATE,
|
||||
QC.CHG-TYPE,
|
||||
QC.INSURER-CODE,
|
||||
QC.PREV-INSURER,
|
||||
QC.REASON
|
||||
FROM
|
||||
QUALIFICATION-CHANGES QC
|
||||
LEFT JOIN SALARYDB.EMP-MASTER EM
|
||||
ON QC.EMP-ID = EM.EMP-ID
|
||||
ORDER BY
|
||||
QC.EMP-ID,
|
||||
QC.CHG-DATE
|
||||
END-EXEC.
|
||||
*
|
||||
*** CURSOR OPEN
|
||||
EXEC SQL
|
||||
OPEN CQCHG
|
||||
END-EXEC.
|
||||
*
|
||||
*** 1件目FETCH
|
||||
PERFORM 1100FETCSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: FETCH処理 *
|
||||
* 処理概要 : CURSOR FETCH + EOF判定 *
|
||||
*****************************************************************
|
||||
1100FETCSOR SECTION.
|
||||
*
|
||||
EXEC SQL
|
||||
FETCH CQCHG
|
||||
INTO
|
||||
:DBV-CHG-ID,
|
||||
:DBV-EMP-ID,
|
||||
:DBV-EMP-NAME,
|
||||
:DBV-CHG-DATE,
|
||||
:DBV-CHG-TYPE,
|
||||
:DBV-INSURER-CODE,
|
||||
:DBV-PREV-INSURER,
|
||||
:DBV-REASON
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-FETCH
|
||||
ELSE
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
END-IF.
|
||||
*
|
||||
1100FETCSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
* 処理概要 : キーブレイク判定・出力 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** EMP-ID 主キーブレイク判定
|
||||
IF WRK-FIRST-Y
|
||||
MOVE SPACE TO WRK-FIRST
|
||||
MOVE DBV-EMP-ID TO WRK-PREV-EMP-ID
|
||||
MOVE DBV-INSURER-CODE TO WRK-PREV-INSURER
|
||||
ELSE
|
||||
IF DBV-EMP-ID NOT = WRK-PREV-EMP-ID
|
||||
PERFORM 2100KEYBRSOR
|
||||
END-IF
|
||||
*
|
||||
*** INSURER-CODE 異キーブレイク判定
|
||||
IF DBV-INSURER-CODE
|
||||
NOT = WRK-PREV-INSURER
|
||||
PERFORM 2200DIFKBSOR
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
*** 明細出力
|
||||
PERFORM 2300DETAILSOR.
|
||||
*
|
||||
*** 前回値更新
|
||||
MOVE DBV-EMP-ID TO WRK-PREV-EMP-ID.
|
||||
MOVE DBV-INSURER-CODE TO WRK-PREV-INSURER.
|
||||
*
|
||||
*** 次FETCH
|
||||
PERFORM 1100FETCSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 主キーブレイク処理 *
|
||||
* 処理概要 : EMP-ID変更時のサマリ出力（前従業員最終状 *
|
||||
* 態をサマリに記録） *
|
||||
*****************************************************************
|
||||
2100KEYBRSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
*
|
||||
MOVE WRK-PREV-EMP-ID TO W01EMP-ID.
|
||||
MOVE SPACES TO W01EMP-NAME
|
||||
MOVE ZERO TO W01CHG-ID
|
||||
W01CHG-DATE.
|
||||
MOVE '99' TO W01CHG-TYPE.
|
||||
MOVE SPACES TO W01INSURER-CODE.
|
||||
MOVE WRK-PREV-INSURER TO W01PREV-INSURER.
|
||||
MOVE SPACES TO W01REASON.
|
||||
MOVE CNS-RECTYP-S TO W01REC-TYPE.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2100KEYBRSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 異キーブレイク処理 *
|
||||
* 処理概要 : 同一従業員内で保険者コード変更時の *
|
||||
* サマリ出力 *
|
||||
*****************************************************************
|
||||
2200DIFKBSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
*
|
||||
MOVE DBV-CHG-ID TO W01CHG-ID.
|
||||
MOVE DBV-EMP-ID TO W01EMP-ID.
|
||||
MOVE DBV-EMP-NAME TO W01EMP-NAME.
|
||||
MOVE DBV-CHG-DATE TO W01CHG-DATE.
|
||||
MOVE '99' TO W01CHG-TYPE.
|
||||
MOVE DBV-INSURER-CODE TO W01INSURER-CODE.
|
||||
MOVE WRK-PREV-INSURER TO W01PREV-INSURER.
|
||||
MOVE CNS-REASON-CHG TO W01REASON.
|
||||
MOVE CNS-RECTYP-S TO W01REC-TYPE.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2200DIFKBSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: 明細出力処理 *
|
||||
* 処理概要 : 全FETCHレコードを明細出力 *
|
||||
*****************************************************************
|
||||
2300DETAILSOR SECTION.
|
||||
*
|
||||
INITIALIZE W02OUTREC.
|
||||
*
|
||||
MOVE DBV-CHG-ID TO W02CHG-ID.
|
||||
MOVE DBV-EMP-ID TO W02EMP-ID.
|
||||
MOVE DBV-EMP-NAME TO W02EMP-NAME.
|
||||
MOVE DBV-CHG-DATE TO W02CHG-DATE.
|
||||
MOVE DBV-CHG-TYPE TO W02CHG-TYPE.
|
||||
MOVE DBV-INSURER-CODE TO W02INSURER-CODE.
|
||||
MOVE DBV-PREV-INSURER TO W02PREV-INSURER.
|
||||
MOVE DBV-REASON TO W02REASON.
|
||||
MOVE CNS-RECTYP-D TO W02REC-TYPE.
|
||||
*
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
2300DETAILSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.5) *
|
||||
* サブモジュール名: 最終グループ処理 *
|
||||
* 処理概要 : 最終EMP-IDグループのサマリ出力 *
|
||||
*****************************************************************
|
||||
2500LSTKBRSOR SECTION.
|
||||
*
|
||||
IF CUN-DB-FETCH > ZERO
|
||||
INITIALIZE W01OUTREC
|
||||
MOVE WRK-PREV-EMP-ID TO W01EMP-ID
|
||||
MOVE SPACES TO W01EMP-NAME
|
||||
MOVE ZERO TO W01CHG-ID
|
||||
W01CHG-DATE
|
||||
MOVE '99' TO W01CHG-TYPE
|
||||
MOVE SPACES TO W01INSURER-CODE
|
||||
MOVE WRK-PREV-INSURER TO W01PREV-INSURER
|
||||
MOVE SPACES TO W01REASON
|
||||
MOVE CNS-RECTYP-S TO W01REC-TYPE
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
END-IF.
|
||||
*
|
||||
2500LSTKBRSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
* 処理概要 : CURSOR CLOSE・ファイルクローズ・件数出力 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** CURSOR CLOSE
|
||||
EXEC SQL
|
||||
CLOSE CQCHG
|
||||
END-EXEC.
|
||||
*
|
||||
*** DB切断
|
||||
EXEC SQL
|
||||
DISCONNECT CURRENT
|
||||
END-EXEC.
|
||||
*
|
||||
*** 出力ファイルCLOSE
|
||||
CLOSE W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
*** 入出力件数出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'DB2-QUAL-CHANGES' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-FETCH TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA07W01(CHG-SUM)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA07W02(CHG-DTL)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W02OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA07W03(ERROR)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W03OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 終了メッセージ出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
3000STPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (4.0) *
|
||||
* サブモジュール名: メッセージ編集出力処理 *
|
||||
* 処理概要 : メッセージ編集出力サブPGM呼出 *
|
||||
*****************************************************************
|
||||
4000MSGOUTSOR SECTION.
|
||||
*
|
||||
MOVE CNS-KN0002 TO M00UMKDATS22-03(1:1).
|
||||
MOVE CNS-KN0002 TO M00UMKDATS22-04(1:1).
|
||||
MOVE CNS-PRGIDX TO M00UMKDATS22-05.
|
||||
CALL 'SUB02MSG' USING M00MHOPAR.
|
||||
*
|
||||
4000MSGOUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (9.9) *
|
||||
* サブモジュール名: ABEND処理 *
|
||||
* 処理概要 : ABENDサブPGM呼出 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
Reference in New Issue
Block a user