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
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU01CVT.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -8,7 +8,6 @@
|
||||
* 処理概要 : CSV形式の社員マスタを固定長80Bに変換する *
|
||||
* 引用符内改行をINSPECT CONVERTINGで処理 *
|
||||
* 項目チェックはSUB04CHKで実施 *
|
||||
* プログラム分類: No.21 CSV→FB変換（改行あり） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU02REG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -7,7 +7,6 @@
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : EMP-RECORDをDB2 EMP-MASTERにINSERT/UPSERT *
|
||||
* 重複時（-803）はUPDATEに切替 *
|
||||
* プログラム分類: No.09 DB更新 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU03AGG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -7,7 +7,6 @@
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : JCL SORT済み欠勤データを社員単位に集約 *
|
||||
* 同一社員内の欠勤時間・回数を集計 *
|
||||
* プログラム分類: No.08 キーブレイク（集約） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU04CAL.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -8,7 +8,6 @@
|
||||
* 処理概要 : 欠勤集約 + EMP-MASTER + OVT-MONTHLY を *
|
||||
* 参照し給与計算を実行 *
|
||||
* 勤怠区分×手当種別の複合分岐はEVALUATE ALSO *
|
||||
* プログラム分類: No.32 1:N＋キーブレイク（同キー） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU05DED.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -9,7 +9,6 @@
|
||||
* 社会保険料・住民税を計算しSALARY-NET出力 *
|
||||
* TAX-TABLE（DB2 SELECT ... BETWEEN） *
|
||||
* INSURANCE-TABLE（SEARCH ALL）を参照 *
|
||||
* プログラム分類: No.23 SELECT条件 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU06UPD.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -7,7 +7,6 @@
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : SALARY-NETをDB2 SALARY-RESULTSに登録 *
|
||||
* 重複時（-803）はUPDATEに切替 *
|
||||
* プログラム分類: No.09 DB更新 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU07DIV.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -8,7 +8,6 @@
|
||||
* 処理概要 : JCL SORT済SALARY-NETを部署コードに応じて *
|
||||
* 50ファイルに分割出力 *
|
||||
* 常に1ファイルのみOPEN *
|
||||
* プログラム分類: No.10 50分割 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU08PRI.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -7,7 +7,6 @@
|
||||
* 作成日 : 2026-07-01 *
|
||||
* 処理概要 : JCL SORT済みSALARY-NETを給与明細（LINAGE） *
|
||||
* として印刷出力。1社員1ページ。 *
|
||||
* プログラム分類: No.04 レイアウト編集のみ（GETPUT）+ LINAGE *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
+1
-2
@@ -1,4 +1,4 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. KYU09MRG.
|
||||
*****************************************************************
|
||||
* システム名 : 給与計算システム *
|
||||
@@ -8,7 +8,6 @@
|
||||
* 処理概要 : SALARY-NETとBONUS-DATAをMERGE文で *
|
||||
* 社員番号昇順に結合し、同一社員内の *
|
||||
* 給与（TYPE=S）と賞与（TYPE=B）を統合 *
|
||||
* プログラム分類: No.35 MERGE（複数ファイル結合） *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
|
||||
@@ -0,0 +1,482 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA01CVT.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA01CVT *
|
||||
* プログラム名 : 被保険者資格データ変換処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : ASCII CSVの被保険者資格データをINSPECT *
|
||||
* CONVERTINGでEBCDIC固定長に変換する *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA01R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA01W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA01W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: INS-CSV-ASCII（可変長CSV） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
03 R01-CSV-DATA PIC X(500).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: INSURED-DATA（200B FB via SHA01REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA01REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA01CVT'.
|
||||
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-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-YEAR-MONTH PIC X(006).
|
||||
03 WRK-IDX PIC 9(004).
|
||||
03 WRK-CSV-FIELDS.
|
||||
05 WRK-C-EMP-ID PIC X(008).
|
||||
05 WRK-C-INSURED-NO PIC X(015).
|
||||
05 WRK-C-OFFICE-NO PIC X(006).
|
||||
05 WRK-C-INSURER-CODE PIC X(004).
|
||||
05 WRK-C-EMP-NAME PIC X(040).
|
||||
05 WRK-C-EMP-KANA PIC X(040).
|
||||
05 WRK-C-BIRTH-DATE PIC X(008).
|
||||
05 WRK-C-SEX PIC X(001).
|
||||
05 WRK-C-ENT-DATE PIC X(008).
|
||||
05 WRK-C-HEALTH-INS-TYPE
|
||||
PIC X(001).
|
||||
05 WRK-C-PENSION-TYPE PIC X(001).
|
||||
05 WRK-C-STATUS PIC X(001).
|
||||
03 WRK-CONV-BEFORE PIC X(256).
|
||||
03 WRK-CONV-AFTER PIC X(256).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHADATAC.
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
COPY SHACHKAC.
|
||||
*
|
||||
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.
|
||||
* PARM NUM検証
|
||||
MOVE 'NUM' TO C01CHKTYP.
|
||||
MOVE WRK-YEAR-MONTH TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
IF C01CHKRRC NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'PARM(YEARMONTH)' TO M00UMKDATS22-01
|
||||
MOVE WRK-YEAR-MONTH TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
MOVE WRK-YEAR-MONTH TO CNS-YEAR-MONTH-PARM.
|
||||
*
|
||||
*** 運用日付取得
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD NOT = ZERO
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 変換テーブル初期化（同一マップ 開発用）
|
||||
MOVE SPACES TO WRK-CONV-BEFORE.
|
||||
MOVE SPACES TO WRK-CONV-AFTER.
|
||||
PERFORM VARYING WRK-IDX
|
||||
FROM 1 BY 1
|
||||
UNTIL WRK-IDX > 256
|
||||
MOVE FUNCTION CHAR
|
||||
(WRK-IDX - 1)
|
||||
TO WRK-CONV-BEFORE(WRK-IDX:1)
|
||||
MOVE FUNCTION CHAR
|
||||
(WRK-IDX - 1)
|
||||
TO WRK-CONV-AFTER(WRK-IDX:1)
|
||||
END-PERFORM.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL.
|
||||
OPEN OUTPUT 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.
|
||||
*
|
||||
PERFORM 2010CSVSOR.
|
||||
IF WRK-EOF-Y
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 2020HALFSOR.
|
||||
IF WRK-EOF-Y
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 2030CNVSOR.
|
||||
PERFORM 2040WRTSOR.
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: CSV分解処理 *
|
||||
*****************************************************************
|
||||
2010CSVSOR SECTION.
|
||||
*
|
||||
INITIALIZE WRK-CSV-FIELDS.
|
||||
*
|
||||
UNSTRING R01-CSV-DATA
|
||||
DELIMITED BY ','
|
||||
INTO WRK-C-EMP-ID
|
||||
WRK-C-INSURED-NO
|
||||
WRK-C-OFFICE-NO
|
||||
WRK-C-INSURER-CODE
|
||||
WRK-C-EMP-NAME
|
||||
WRK-C-EMP-KANA
|
||||
WRK-C-BIRTH-DATE
|
||||
WRK-C-SEX
|
||||
WRK-C-ENT-DATE
|
||||
WRK-C-HEALTH-INS-TYPE
|
||||
WRK-C-PENSION-TYPE
|
||||
WRK-C-STATUS
|
||||
END-UNSTRING.
|
||||
*
|
||||
2010CSVSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 半角桁数チェック *
|
||||
*****************************************************************
|
||||
2020HALFSOR SECTION.
|
||||
*
|
||||
*** 氏名カナ半角20桁以内チェック
|
||||
IF WRK-C-EMP-KANA(21:) NOT = SPACES
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'KANA OVER 20: '
|
||||
WRK-C-EMP-KANA
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 被保険者番号半角10桁以内チェック
|
||||
IF WRK-C-INSURED-NO(11:) NOT = SPACES
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'INSURED-NO OVER 10: '
|
||||
WRK-C-INSURED-NO
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 事業所番号半角4桁以内チェック
|
||||
IF WRK-C-OFFICE-NO(5:) NOT = SPACES
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'OFFICE-NO OVER 4: '
|
||||
WRK-C-OFFICE-NO
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 日付チェック（生年月日）
|
||||
MOVE 'DATE' TO C01CHKTYP.
|
||||
MOVE WRK-C-BIRTH-DATE TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
IF C01CHKRRC NOT = 0
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'BIRTH-DATE ERR: '
|
||||
WRK-C-BIRTH-DATE
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 日付チェック（資格取得日）
|
||||
MOVE 'DATE' TO C01CHKTYP.
|
||||
MOVE WRK-C-ENT-DATE TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
IF C01CHKRRC NOT = 0
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'ENT-DATE ERR: '
|
||||
WRK-C-ENT-DATE
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 数値チェック（社員番号）
|
||||
MOVE 'NUMERIC' TO C01CHKTYP.
|
||||
MOVE WRK-C-EMP-ID TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
IF C01CHKRRC NOT = 0
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'EMP-ID NUM ERR: '
|
||||
WRK-C-EMP-ID
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
2020HALFSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: ASCII→EBCDIC変換処理 *
|
||||
*****************************************************************
|
||||
2030CNVSOR SECTION.
|
||||
*
|
||||
INSPECT WRK-C-EMP-ID
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-INSURED-NO
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-OFFICE-NO
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-INSURER-CODE
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-EMP-NAME
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-EMP-KANA
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-BIRTH-DATE
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-SEX
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-ENT-DATE
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-HEALTH-INS-TYPE
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-PENSION-TYPE
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
INSPECT WRK-C-STATUS
|
||||
CONVERTING WRK-CONV-BEFORE TO WRK-CONV-AFTER.
|
||||
*
|
||||
2030CNVSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.4) *
|
||||
* サブモジュール名: W01出力処理 *
|
||||
*****************************************************************
|
||||
2040WRTSOR SECTION.
|
||||
*
|
||||
MOVE WRK-C-EMP-ID TO W01EMP-ID.
|
||||
MOVE WRK-C-INSURED-NO TO W01INSURED-NO.
|
||||
MOVE WRK-C-OFFICE-NO TO W01OFFICE-NO.
|
||||
MOVE WRK-C-INSURER-CODE TO W01INSURER-CODE.
|
||||
MOVE WRK-C-EMP-NAME TO W01EMP-NAME.
|
||||
MOVE WRK-C-EMP-KANA TO W01EMP-KANA.
|
||||
MOVE WRK-C-BIRTH-DATE TO W01BIRTH-DATE.
|
||||
MOVE WRK-C-SEX TO W01SEX.
|
||||
MOVE WRK-C-ENT-DATE TO W01ENT-DATE.
|
||||
MOVE WRK-C-HEALTH-INS-TYPE TO W01HEALTH-INS-TYPE.
|
||||
MOVE WRK-C-PENSION-TYPE TO W01PENSION-TYPE.
|
||||
MOVE WRK-C-STATUS TO W01STATUS.
|
||||
MOVE LOW-VALUES TO W01FILLER.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2040WRTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA01R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA01W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA01W02' 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,447 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA02MNC.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA02MNC *
|
||||
* プログラム名 : 従業員保険情報統合処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : DB2 EMP-MASTER従業員情報とINSURANCE-RATES *
|
||||
* をマッチングし従業員単位に統合出力する *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 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 SHA02W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA02W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: EMP-INSURANCE（200B FB via SHA02REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA02REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA02MNC'.
|
||||
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-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-DB-EMP 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).
|
||||
03 WRK-IDX PIC 9(004).
|
||||
03 WRK-RATE-COUNT PIC 9(003) VALUE ZERO.
|
||||
03 WRK-RATE-TBL.
|
||||
05 WRK-RATE-ENTRY OCCURS 100
|
||||
INDEXED BY WRK-RATE-IDX.
|
||||
07 WRK-GRADE-CODE PIC X(002).
|
||||
07 WRK-MONTHLY-FROM PIC 9(009).
|
||||
07 WRK-MONTHLY-TO PIC 9(009).
|
||||
07 WRK-HEALTH-RATE PIC 9(001)V9(006).
|
||||
07 WRK-PENSION-RATE PIC 9(001)V9(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* 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-BASE-SALARY PIC 9(009).
|
||||
03 DBV-GRADE-CODE PIC X(002).
|
||||
03 DBV-MONTHLY-FROM PIC 9(009).
|
||||
03 DBV-MONTHLY-TO PIC 9(009).
|
||||
03 DBV-HEALTH-RATE PIC 9(001)V9(006).
|
||||
03 DBV-PENSION-RATE PIC 9(001)V9(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHADATAC.
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
COPY SHACHKAC.
|
||||
*
|
||||
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 CUNARA.
|
||||
*
|
||||
*** PARM取得
|
||||
ACCEPT WRK-YEAR-MONTH
|
||||
FROM COMMAND-LINE.
|
||||
IF WRK-YEAR-MONTH = SPACES
|
||||
MOVE '202605' TO WRK-YEAR-MONTH
|
||||
END-IF.
|
||||
* PARM NUM検証
|
||||
MOVE 'NUM' TO C01CHKTYP.
|
||||
MOVE WRK-YEAR-MONTH TO C01CHKDAT.
|
||||
CALL 'SUB04CHK' USING C01CHKPAR.
|
||||
IF C01CHKRRC NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'PARM(YEARMONTH)' TO M00UMKDATS22-01
|
||||
MOVE WRK-YEAR-MONTH TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
MOVE WRK-YEAR-MONTH TO CNS-YEAR-MONTH-PARM.
|
||||
*
|
||||
*** 運用日付取得
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD NOT = ZERO
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/INSURANCEDB.db'
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'DB-CONNECT' TO M00UMKDATS22-01
|
||||
MOVE SQLCODE TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** INSURANCE-RATES内部表LOAD
|
||||
PERFORM 1200RATELDASOR.
|
||||
*
|
||||
*** EMP-MASTERカーソル宣言
|
||||
EXEC SQL
|
||||
DECLARE C2 CURSOR FOR
|
||||
SELECT EMP-ID, EMP-NAME, DEPT-CODE,
|
||||
BASE-SALARY
|
||||
FROM SALARYDB.EMP-MASTER
|
||||
ORDER BY EMP-ID
|
||||
END-EXEC.
|
||||
*
|
||||
*** EMP-MASTERカーソルOPEN
|
||||
EXEC SQL
|
||||
OPEN C2
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'EMP-OPEN' TO M00UMKDATS22-01
|
||||
MOVE SQLCODE TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN OUTPUT W01OUTFIL.
|
||||
OPEN OUTPUT W02OUTFIL.
|
||||
*
|
||||
*** 初回FETCH
|
||||
PERFORM 1300EMPFETCSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: RATES内部表LOAD *
|
||||
*****************************************************************
|
||||
1200RATELDASOR SECTION.
|
||||
*
|
||||
MOVE 1 TO WRK-IDX.
|
||||
MOVE ZERO TO WRK-RATE-COUNT.
|
||||
*
|
||||
EXEC SQL
|
||||
DECLARE C1 CURSOR FOR
|
||||
SELECT GRADE-CODE, MONTHLY-FROM, MONTHLY-TO,
|
||||
HEALTH-RATE, PENSION-RATE
|
||||
FROM INSURANCE-RATES
|
||||
WHERE EFFECTIVE-FROM <= :WRK-YEAR-MONTH
|
||||
AND EFFECTIVE-TO >= :WRK-YEAR-MONTH
|
||||
ORDER BY GRADE-CODE
|
||||
END-EXEC.
|
||||
*
|
||||
EXEC SQL
|
||||
OPEN C1
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'RATES-OPEN' TO M00UMKDATS22-01
|
||||
MOVE SQLCODE TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
PERFORM UNTIL SQLCODE NOT = 0
|
||||
EXEC SQL
|
||||
FETCH C1
|
||||
INTO :DBV-GRADE-CODE,
|
||||
:DBV-MONTHLY-FROM,
|
||||
:DBV-MONTHLY-TO,
|
||||
:DBV-HEALTH-RATE,
|
||||
:DBV-PENSION-RATE
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
MOVE DBV-GRADE-CODE
|
||||
TO WRK-GRADE-CODE(WRK-IDX)
|
||||
MOVE DBV-MONTHLY-FROM
|
||||
TO WRK-MONTHLY-FROM(WRK-IDX)
|
||||
MOVE DBV-MONTHLY-TO
|
||||
TO WRK-MONTHLY-TO(WRK-IDX)
|
||||
MOVE DBV-HEALTH-RATE
|
||||
TO WRK-HEALTH-RATE(WRK-IDX)
|
||||
MOVE DBV-PENSION-RATE
|
||||
TO WRK-PENSION-RATE(WRK-IDX)
|
||||
ADD 1 TO WRK-IDX
|
||||
ADD 1 TO WRK-RATE-COUNT
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
EXEC SQL
|
||||
CLOSE C1
|
||||
END-EXEC.
|
||||
*
|
||||
1200RATELDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.2) *
|
||||
* サブモジュール名: EMP-MASTER FETCH処理 *
|
||||
*****************************************************************
|
||||
1300EMPFETCSOR SECTION.
|
||||
*
|
||||
EXEC SQL
|
||||
FETCH C2
|
||||
INTO :DBV-EMP-ID,
|
||||
:DBV-EMP-NAME,
|
||||
:DBV-DEPT-CODE,
|
||||
:DBV-BASE-SALARY
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
ADD 1 TO CUN-DB-EMP
|
||||
ELSE
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
END-IF.
|
||||
*
|
||||
1300EMPFETCSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** SEARCHで該当GRADE-CODEを特定
|
||||
SET WRK-RATE-IDX TO 1.
|
||||
SEARCH WRK-RATE-ENTRY
|
||||
AT END
|
||||
MOVE '01' TO W02ERR-CATEGORY
|
||||
STRING 'NO MATCH GRADE: '
|
||||
DBV-EMP-ID
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
PERFORM 1300EMPFETCSOR
|
||||
EXIT SECTION
|
||||
WHEN WRK-MONTHLY-FROM(WRK-RATE-IDX)
|
||||
<= DBV-BASE-SALARY
|
||||
AND WRK-MONTHLY-TO(WRK-RATE-IDX)
|
||||
>= DBV-BASE-SALARY
|
||||
CONTINUE
|
||||
END-SEARCH.
|
||||
*
|
||||
*** 種別判定（DEPT-CODE）
|
||||
EVALUATE DBV-DEPT-CODE
|
||||
WHEN 1 THRU 10
|
||||
MOVE '1' TO W01HEALTH-INS-TYPE
|
||||
MOVE '1' TO W01PENSION-TYPE
|
||||
MOVE '0001' TO W01INSURER-CODE
|
||||
WHEN 11 THRU 20
|
||||
MOVE '2' TO W01HEALTH-INS-TYPE
|
||||
MOVE '1' TO W01PENSION-TYPE
|
||||
MOVE '0002' TO W01INSURER-CODE
|
||||
WHEN 21 THRU 30
|
||||
MOVE '1' TO W01HEALTH-INS-TYPE
|
||||
MOVE '2' TO W01PENSION-TYPE
|
||||
MOVE '0003' TO W01INSURER-CODE
|
||||
WHEN OTHER
|
||||
MOVE '9' TO W01HEALTH-INS-TYPE
|
||||
MOVE '9' TO W01PENSION-TYPE
|
||||
MOVE '0009' TO W01INSURER-CODE
|
||||
END-EVALUATE.
|
||||
*
|
||||
*** 出力レコード編集
|
||||
MOVE DBV-EMP-ID TO W01EMP-ID.
|
||||
MOVE DBV-EMP-NAME TO W01EMP-NAME.
|
||||
MOVE DBV-DEPT-CODE TO W01DEPT-CODE.
|
||||
MOVE DBV-BASE-SALARY TO W01BASE-SALARY.
|
||||
MOVE WRK-MONTHLY-FROM(
|
||||
WRK-RATE-IDX) TO W01MONTHLY-AMOUNT.
|
||||
MOVE WRK-GRADE-CODE(
|
||||
WRK-RATE-IDX) TO W01GRADE-CODE.
|
||||
MOVE LOW-VALUES TO W01FILLER.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
*** 次従業員FETCH
|
||||
PERFORM 1300EMPFETCSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
EXEC SQL
|
||||
CLOSE C2
|
||||
END-EXEC.
|
||||
*
|
||||
CLOSE W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'EMP-MASTER' TO M00UMKDATS22-01.
|
||||
MOVE CUN-DB-EMP TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA02W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA02W02' 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,409 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA03MNP.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA03MNP *
|
||||
* プログラム名 : 保険料計算明細出力処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : EMP-INSURANCE × INSURANCE-RATESの直積組合せ *
|
||||
* により保険料計算明細を出力する *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA03R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA03W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA03W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: EMP-INSURANCE（200B FB via SHA02REC） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA02REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: INS-DETAIL（300B FB via SHA03REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA03REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA03MNP'.
|
||||
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-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-YEAR-MONTH PIC X(006).
|
||||
03 WRK-IDX PIC 9(004).
|
||||
03 WRK-RATE-COUNT PIC 9(003) VALUE ZERO.
|
||||
03 WRK-INS-TYPE-IDX PIC 9(001) VALUE ZERO.
|
||||
03 WRK-RATE-TBL.
|
||||
05 WRK-RATE-ENTRY OCCURS 100
|
||||
INDEXED BY WRK-RATE-IDX.
|
||||
07 WRK-GRADE-CODE PIC X(002).
|
||||
07 WRK-MONTHLY-FROM PIC 9(009).
|
||||
07 WRK-MONTHLY-TO PIC 9(009).
|
||||
07 WRK-HEALTH-RATE PIC 9(001)V9(006).
|
||||
07 WRK-PENSION-RATE PIC 9(001)V9(006).
|
||||
03 WRK-HEALTH-PREMIUM PIC 9(009).
|
||||
03 WRK-PENSION-PREMIUM PIC 9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-GRADE-CODE PIC X(002).
|
||||
03 DBV-MONTHLY-FROM PIC 9(009).
|
||||
03 DBV-MONTHLY-TO PIC 9(009).
|
||||
03 DBV-HEALTH-RATE PIC 9(001)V9(006).
|
||||
03 DBV-PENSION-RATE PIC 9(001)V9(006).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHADATAC.
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
*
|
||||
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 CUNARA.
|
||||
*
|
||||
*** 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.
|
||||
*
|
||||
*** 運用日付取得
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD NOT = ZERO
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/INSURANCEDB.db'
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'DB-CONNECT' TO M00UMKDATS22-01
|
||||
MOVE SQLCODE TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** INSURANCE-RATES内部表LOAD
|
||||
PERFORM 1200RATELDASOR.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL.
|
||||
OPEN OUTPUT W02OUTFIL.
|
||||
*
|
||||
PERFORM 1300R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: RATES内部表LOAD *
|
||||
*****************************************************************
|
||||
1200RATELDASOR SECTION.
|
||||
*
|
||||
MOVE 1 TO WRK-IDX.
|
||||
MOVE ZERO TO WRK-RATE-COUNT.
|
||||
*
|
||||
EXEC SQL
|
||||
DECLARE C1 CURSOR FOR
|
||||
SELECT GRADE-CODE, MONTHLY-FROM, MONTHLY-TO,
|
||||
HEALTH-RATE, PENSION-RATE
|
||||
FROM INSURANCE-RATES
|
||||
WHERE EFFECTIVE-FROM <= :WRK-YEAR-MONTH
|
||||
AND EFFECTIVE-TO >= :WRK-YEAR-MONTH
|
||||
ORDER BY GRADE-CODE
|
||||
END-EXEC.
|
||||
*
|
||||
EXEC SQL
|
||||
OPEN C1
|
||||
END-EXEC.
|
||||
IF SQLCODE NOT = 0
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'RATES-OPEN' TO M00UMKDATS22-01
|
||||
MOVE SQLCODE TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
PERFORM UNTIL SQLCODE NOT = 0
|
||||
EXEC SQL
|
||||
FETCH C1
|
||||
INTO :DBV-GRADE-CODE,
|
||||
:DBV-MONTHLY-FROM,
|
||||
:DBV-MONTHLY-TO,
|
||||
:DBV-HEALTH-RATE,
|
||||
:DBV-PENSION-RATE
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
MOVE DBV-GRADE-CODE
|
||||
TO WRK-GRADE-CODE(WRK-IDX)
|
||||
MOVE DBV-MONTHLY-FROM
|
||||
TO WRK-MONTHLY-FROM(WRK-IDX)
|
||||
MOVE DBV-MONTHLY-TO
|
||||
TO WRK-MONTHLY-TO(WRK-IDX)
|
||||
MOVE DBV-HEALTH-RATE
|
||||
TO WRK-HEALTH-RATE(WRK-IDX)
|
||||
MOVE DBV-PENSION-RATE
|
||||
TO WRK-PENSION-RATE(WRK-IDX)
|
||||
ADD 1 TO WRK-IDX
|
||||
ADD 1 TO WRK-RATE-COUNT
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
EXEC SQL
|
||||
CLOSE C1
|
||||
END-EXEC.
|
||||
*
|
||||
1200RATELDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.2) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
*****************************************************************
|
||||
1300R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
SET WRK-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1300R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
MOVE 1 TO WRK-IDX.
|
||||
PERFORM UNTIL WRK-IDX > WRK-RATE-COUNT
|
||||
MOVE R01EMP-ID TO W01EMP-ID
|
||||
MOVE R01EMP-NAME TO W01EMP-NAME
|
||||
MOVE '1' TO W01INSURANCE-TYPE
|
||||
MOVE WRK-GRADE-CODE(WRK-IDX)
|
||||
TO W01GRADE-CODE
|
||||
MOVE R01MONTHLY-AMOUNT TO W01MONTHLY-AMOUNT
|
||||
MOVE WRK-HEALTH-RATE(WRK-IDX)
|
||||
TO W01HEALTH-RATE
|
||||
MOVE WRK-PENSION-RATE(WRK-IDX)
|
||||
TO W01PENSION-RATE
|
||||
MULTIPLY R01MONTHLY-AMOUNT
|
||||
BY WRK-HEALTH-RATE(WRK-IDX)
|
||||
GIVING WRK-HEALTH-PREMIUM ROUNDED
|
||||
MOVE ZERO TO WRK-PENSION-PREMIUM
|
||||
MOVE WRK-HEALTH-PREMIUM TO W01HEALTH-PREMIUM
|
||||
MOVE WRK-PENSION-PREMIUM TO W01PENSION-PREMIUM
|
||||
MOVE LOW-VALUES TO W01FILLER
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
MOVE R01EMP-ID TO W01EMP-ID
|
||||
MOVE R01EMP-NAME TO W01EMP-NAME
|
||||
MOVE '2' TO W01INSURANCE-TYPE
|
||||
MOVE WRK-GRADE-CODE(WRK-IDX)
|
||||
TO W01GRADE-CODE
|
||||
MOVE R01MONTHLY-AMOUNT TO W01MONTHLY-AMOUNT
|
||||
MOVE WRK-HEALTH-RATE(WRK-IDX)
|
||||
TO W01HEALTH-RATE
|
||||
MOVE WRK-PENSION-RATE(WRK-IDX)
|
||||
TO W01PENSION-RATE
|
||||
MOVE ZERO TO WRK-HEALTH-PREMIUM
|
||||
MULTIPLY R01MONTHLY-AMOUNT
|
||||
BY WRK-PENSION-RATE(WRK-IDX)
|
||||
GIVING WRK-PENSION-PREMIUM ROUNDED
|
||||
MOVE WRK-HEALTH-PREMIUM TO W01HEALTH-PREMIUM
|
||||
MOVE WRK-PENSION-PREMIUM TO W01PENSION-PREMIUM
|
||||
MOVE LOW-VALUES TO W01FILLER
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
ADD 1 TO WRK-IDX
|
||||
END-PERFORM.
|
||||
PERFORM 1300R01INNSOR.
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.9) *
|
||||
* サブモジュール名: エラー出力処理 *
|
||||
*****************************************************************
|
||||
2100ERROUTSOR SECTION.
|
||||
*
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
2100ERROUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA03R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA03W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA03W02' 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,543 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA04TWO IS INITIAL.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA04TWO *
|
||||
* プログラム名 : 事業所保険者マッチング処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : INSURED-DATAをOFFICE-MST/INSURER-MSTの *
|
||||
* 2段階で1:1マッチングし、GRADED-LIST/ *
|
||||
* UNMATCHED-LISTを出力する *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA04R01.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL SHA04R02.
|
||||
SELECT R03INNFIL ASSIGN TO EXTERNAL SHA04R03.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA04W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA04W02.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL SHA04W03.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: INSURED-DATA（200B FB SHA01CVT出力） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA01REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: OFFICE-MST（80B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
03 R02OFFICE-NO PIC X(004).
|
||||
03 R02OFFICE-NAME PIC X(040).
|
||||
03 R02PREF-CODE PIC 9(002).
|
||||
03 R02FILLER PIC X(034).
|
||||
*
|
||||
*****************************************************************
|
||||
* R03: INSURER-MST（80B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD R03INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R03INNREC.
|
||||
03 R03INSURER-CODE PIC X(004).
|
||||
03 R03INSURER-NAME PIC X(060).
|
||||
03 R03FILLER PIC X(016).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: GRADED-LIST（200B FB SHA04REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA04REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: UNMATCHED-LIST（200B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W02OUTREC.
|
||||
03 W02EMP-ID PIC 9(008).
|
||||
03 W02EMP-NAME PIC X(040).
|
||||
03 W02OFFICE-NO PIC X(004).
|
||||
03 W02OFFICE-NAME PIC X(040).
|
||||
03 W02PREF-CODE PIC 9(002).
|
||||
03 W02INSURER-CODE PIC X(004).
|
||||
03 W02INSURER-NAME PIC X(060).
|
||||
03 W02STATUS PIC X(001).
|
||||
03 W02FILLER PIC X(041).
|
||||
*
|
||||
*****************************************************************
|
||||
* 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 'SHA04TWO'.
|
||||
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-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-R03INN 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-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-SQLCODE PIC S9(009) COMP.
|
||||
03 WRK-STAGE1-FLG PIC X(001).
|
||||
88 WRK-STAGE1-FOUND VALUE 'Y'.
|
||||
03 WRK-STAGE2-FLG PIC X(001).
|
||||
88 WRK-STAGE2-FOUND VALUE 'Y'.
|
||||
03 WRK-I PIC 9(004) COMP.
|
||||
03 WRK-J PIC 9(004) COMP.
|
||||
03 WRK-R02-EOF PIC X(001).
|
||||
88 R02-EOF-Y VALUE '1'.
|
||||
03 WRK-R03-EOF PIC X(001).
|
||||
88 R03-EOF-Y VALUE '1'.
|
||||
03 WS-DISP-INT PIC S9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-INSURED-NO PIC X(010).
|
||||
03 DBV-STATUS PIC X(001).
|
||||
*
|
||||
*****************************************************************
|
||||
* 事業所マスタ内部テーブル *
|
||||
*****************************************************************
|
||||
01 OFFICE-TBL.
|
||||
03 OFFICE-ENTRY OCCURS 100.
|
||||
05 TBL-OFFICE-NO PIC X(004).
|
||||
05 TBL-OFFICE-NAME PIC X(040).
|
||||
05 TBL-PREF-CODE PIC 9(002).
|
||||
05 TBL-FILLER PIC X(034).
|
||||
01 OFFICE-COUNT PIC 9(004) VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 保険者マスタ内部テーブル *
|
||||
*****************************************************************
|
||||
01 INSURER-TBL.
|
||||
03 INSURER-ENTRY OCCURS 100.
|
||||
05 TBL-INSURER-CODE PIC X(004).
|
||||
05 TBL-INSURER-NAME PIC X(060).
|
||||
05 TBL-FILLER PIC X(016).
|
||||
01 INSURER-COUNT PIC 9(004) VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
COPY SHADATAC.
|
||||
*
|
||||
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
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN INPUT R01INNFIL
|
||||
R02INNFIL
|
||||
R03INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/INSURANCEDB.db'
|
||||
END-EXEC.
|
||||
*
|
||||
MOVE 0 TO WS-DISP-INT.
|
||||
*
|
||||
*** 事業所マスタ全件読込
|
||||
PERFORM 1110R02LDASOR
|
||||
UNTIL R02-EOF-Y.
|
||||
*
|
||||
*** 保険者マスタ全件読込
|
||||
PERFORM 1120R03LDASOR
|
||||
UNTIL R03-EOF-Y.
|
||||
*
|
||||
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: (1.2) *
|
||||
* サブモジュール名: R02読込処理（全件→内部テーブル） *
|
||||
*****************************************************************
|
||||
1110R02LDASOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET R02-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
ADD 1 TO OFFICE-COUNT
|
||||
MOVE R02OFFICE-NO TO
|
||||
TBL-OFFICE-NO (OFFICE-COUNT)
|
||||
MOVE R02OFFICE-NAME TO
|
||||
TBL-OFFICE-NAME (OFFICE-COUNT)
|
||||
MOVE R02PREF-CODE TO
|
||||
TBL-PREF-CODE (OFFICE-COUNT)
|
||||
END-READ.
|
||||
*
|
||||
1110R02LDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.3) *
|
||||
* サブモジュール名: R03読込処理（全件→内部テーブル） *
|
||||
*****************************************************************
|
||||
1120R03LDASOR SECTION.
|
||||
*
|
||||
READ R03INNFIL
|
||||
AT END
|
||||
SET R03-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R03INN
|
||||
ADD 1 TO INSURER-COUNT
|
||||
MOVE R03INSURER-CODE TO
|
||||
TBL-INSURER-CODE (INSURER-COUNT)
|
||||
MOVE R03INSURER-NAME TO
|
||||
TBL-INSURER-NAME (INSURER-COUNT)
|
||||
END-READ.
|
||||
*
|
||||
1120R03LDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
MOVE 'N' TO WRK-STAGE1-FLG.
|
||||
MOVE 'N' TO WRK-STAGE2-FLG.
|
||||
*
|
||||
PERFORM 2010STG1SOR.
|
||||
*
|
||||
IF WRK-STAGE1-FOUND
|
||||
PERFORM 2020STG2SOR
|
||||
END-IF.
|
||||
*
|
||||
IF WRK-STAGE1-FOUND
|
||||
AND WRK-STAGE2-FOUND
|
||||
PERFORM 2030W01OUTSOR
|
||||
ELSE
|
||||
PERFORM 2040W02OUTSOR
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 第1段階マッチング（OFFICE-NO） *
|
||||
*****************************************************************
|
||||
2010STG1SOR SECTION.
|
||||
*
|
||||
PERFORM VARYING WRK-I FROM 1 BY 1
|
||||
UNTIL WRK-I > OFFICE-COUNT
|
||||
OR WRK-STAGE1-FOUND
|
||||
IF R01OFFICE-NO =
|
||||
TBL-OFFICE-NO (WRK-I)
|
||||
SET WRK-STAGE1-FOUND TO TRUE
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
2010STG1SOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 第2段階マッチング（INSURER-CODE） *
|
||||
*****************************************************************
|
||||
2020STG2SOR SECTION.
|
||||
*
|
||||
PERFORM VARYING WRK-J FROM 1 BY 1
|
||||
UNTIL WRK-J > INSURER-COUNT
|
||||
OR WRK-STAGE2-FOUND
|
||||
IF R01INSURER-CODE =
|
||||
TBL-INSURER-CODE (WRK-J)
|
||||
SET WRK-STAGE2-FOUND TO TRUE
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
2020STG2SOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: GRADED-LIST出力 *
|
||||
*****************************************************************
|
||||
2030W01OUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
*
|
||||
MOVE R01EMP-ID TO W01EMP-ID.
|
||||
MOVE R01EMP-NAME TO W01EMP-NAME.
|
||||
MOVE R01OFFICE-NO TO W01OFFICE-NO.
|
||||
MOVE TBL-OFFICE-NAME (WRK-I) TO W01OFFICE-NAME.
|
||||
MOVE TBL-PREF-CODE (WRK-I) TO W01PREF-CODE.
|
||||
MOVE R01INSURER-CODE TO W01INSURER-CODE.
|
||||
MOVE TBL-INSURER-NAME (WRK-J)
|
||||
TO W01INSURER-NAME.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
*** DB2整合性検証
|
||||
MOVE R01EMP-ID TO DBV-EMP-ID.
|
||||
MOVE R01INSURED-NO TO DBV-INSURED-NO.
|
||||
*
|
||||
EXEC SQL
|
||||
SELECT STATUS
|
||||
INTO :DBV-STATUS
|
||||
FROM INSURED-MASTER
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
AND INSURED-NO = :DBV-INSURED-NO
|
||||
END-EXEC.
|
||||
*
|
||||
IF SQLCODE NOT = 0
|
||||
MOVE 01 TO W03ERR-CATEGORY
|
||||
MOVE SQLCODE TO WS-DISP-INT
|
||||
STRING
|
||||
DBV-EMP-ID
|
||||
' SQLCODE='
|
||||
WS-DISP-INT
|
||||
INTO W03ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W03OUTREC
|
||||
ADD 1 TO CUN-W03OUT
|
||||
END-IF.
|
||||
*
|
||||
2030W01OUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.4) *
|
||||
* サブモジュール名: UNMATCHED-LIST出力 *
|
||||
*****************************************************************
|
||||
2040W02OUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W02OUTREC.
|
||||
*
|
||||
MOVE R01EMP-ID TO W02EMP-ID.
|
||||
MOVE R01EMP-NAME TO W02EMP-NAME.
|
||||
MOVE R01OFFICE-NO TO W02OFFICE-NO.
|
||||
MOVE R01INSURER-CODE TO W02INSURER-CODE.
|
||||
*
|
||||
IF WRK-STAGE1-FOUND
|
||||
MOVE TBL-OFFICE-NAME (WRK-I)
|
||||
TO W02OFFICE-NAME
|
||||
MOVE TBL-PREF-CODE (WRK-I)
|
||||
TO W02PREF-CODE
|
||||
END-IF.
|
||||
*
|
||||
IF WRK-STAGE2-FOUND
|
||||
MOVE TBL-INSURER-NAME (WRK-J)
|
||||
TO W02INSURER-NAME
|
||||
END-IF.
|
||||
*
|
||||
IF NOT WRK-STAGE1-FOUND
|
||||
MOVE '1' TO W02STATUS
|
||||
ELSE
|
||||
MOVE '2' TO W02STATUS
|
||||
END-IF.
|
||||
*
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
2040W02OUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
R02INNFIL
|
||||
R03INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA04R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA04W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA04W02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W02OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA04W03' 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,459 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA05TWN.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA05TWN *
|
||||
* プログラム名 : 標準報酬月額等級判定処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : SALARY-MONTHLYをEMP-IDでN:1キーブレイク *
|
||||
* 集約し、平均標準報酬月額とGRADE-TBLを *
|
||||
* N:1マッチングして等級改定を判定する *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA05R01.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL SHA05R02.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA05W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA05W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: SALARY-MONTHLY（200B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
03 R01EMP-ID PIC 9(008).
|
||||
03 R01EMP-NAME PIC X(040).
|
||||
03 R01YEAR-MONTH PIC 9(006).
|
||||
03 R01MONTHLY-AMOUNT PIC 9(009).
|
||||
03 R01FILLER PIC X(137).
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: GRADE-TBL（80B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
03 R02GRADE-CODE PIC 9(002).
|
||||
03 R02MONTHLY-FROM PIC 9(009).
|
||||
03 R02MONTHLY-TO PIC 9(009).
|
||||
03 R02FILLER PIC X(060).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: REVISED-GRADE（200B FB SHA05REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA05REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA05TWN'.
|
||||
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-DEFAULT-YM PIC X(006) VALUE '202607'.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-R01INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-R02-EOF PIC X(001).
|
||||
88 WRK-R02-EOF-Y VALUE '1'.
|
||||
03 WRK-FIRST-FLG PIC X(001).
|
||||
88 WRK-FIRST-REC VALUE '1'.
|
||||
03 WRK-PREV-EMP-ID PIC 9(008).
|
||||
03 WRK-EMP-NAME PIC X(040).
|
||||
03 WRK-YEAR-MONTH PIC X(006).
|
||||
03 WRK-TOTAL PIC 9(018) COMP-3.
|
||||
03 WRK-COUNT PIC 9(004) COMP-3.
|
||||
03 WRK-AVG PIC 9(009).
|
||||
03 WRK-REM PIC 9(009).
|
||||
03 WRK-REVISED-TYPE PIC X(001).
|
||||
03 WRK-I PIC 9(004) COMP.
|
||||
03 WRK-GRADE-FOUND PIC X(001).
|
||||
88 WRK-GRADE-FOUND-Y VALUE 'Y'.
|
||||
03 WRK-NEW-GRADE PIC 9(002).
|
||||
03 WRK-OLD-GRADE PIC 9(002).
|
||||
03 WS-DISP-INT PIC S9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* 等級テーブル（内部テーブル） *
|
||||
*****************************************************************
|
||||
01 GRADE-TBL.
|
||||
03 GRADE-ENTRY OCCURS 50.
|
||||
05 TBL-GRADE-CODE PIC 9(002).
|
||||
05 TBL-MONTHLY-FROM PIC 9(009).
|
||||
05 TBL-MONTHLY-TO PIC 9(009).
|
||||
05 TBL-FILLER PIC X(060).
|
||||
01 GRADE-COUNT PIC 9(004) VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
COPY SHADATAC.
|
||||
*
|
||||
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-FLG.
|
||||
*
|
||||
*** PARM取得
|
||||
ACCEPT WRK-YEAR-MONTH
|
||||
FROM COMMAND-LINE.
|
||||
IF WRK-YEAR-MONTH = SPACES
|
||||
MOVE CNS-DEFAULT-YM TO WRK-YEAR-MONTH
|
||||
END-IF.
|
||||
*
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD NOT = ZERO
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN INPUT R01INNFIL
|
||||
R02INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** 等級テーブル全件読込
|
||||
PERFORM 1110R02LDASOR
|
||||
UNTIL WRK-R02-EOF-Y.
|
||||
*
|
||||
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: (1.2) *
|
||||
* サブモジュール名: R02全件読込（等級テーブル格納） *
|
||||
*****************************************************************
|
||||
1110R02LDASOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET WRK-R02-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
ADD 1 TO GRADE-COUNT
|
||||
MOVE R02GRADE-CODE TO
|
||||
TBL-GRADE-CODE (GRADE-COUNT)
|
||||
MOVE R02MONTHLY-FROM TO
|
||||
TBL-MONTHLY-FROM (GRADE-COUNT)
|
||||
MOVE R02MONTHLY-TO TO
|
||||
TBL-MONTHLY-TO (GRADE-COUNT)
|
||||
END-READ.
|
||||
*
|
||||
1110R02LDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
IF WRK-FIRST-REC
|
||||
MOVE R01EMP-ID TO WRK-PREV-EMP-ID
|
||||
MOVE R01EMP-NAME TO WRK-EMP-NAME
|
||||
MOVE '0' TO WRK-FIRST-FLG
|
||||
MOVE ZERO TO WRK-TOTAL
|
||||
MOVE ZERO TO WRK-COUNT
|
||||
END-IF.
|
||||
*
|
||||
IF R01EMP-ID = WRK-PREV-EMP-ID
|
||||
ADD R01MONTHLY-AMOUNT TO WRK-TOTAL
|
||||
ADD 1 TO WRK-COUNT
|
||||
ELSE
|
||||
PERFORM 2010KEYBRSOR
|
||||
MOVE R01EMP-ID TO WRK-PREV-EMP-ID
|
||||
MOVE R01EMP-NAME TO WRK-EMP-NAME
|
||||
MOVE ZERO TO WRK-TOTAL
|
||||
MOVE ZERO TO WRK-COUNT
|
||||
ADD R01MONTHLY-AMOUNT TO WRK-TOTAL
|
||||
ADD 1 TO WRK-COUNT
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: キーブレイク集約処理 *
|
||||
*****************************************************************
|
||||
2010KEYBRSOR SECTION.
|
||||
*
|
||||
IF WRK-COUNT = 0
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
DIVIDE WRK-TOTAL BY WRK-COUNT
|
||||
GIVING WRK-AVG
|
||||
REMAINDER WRK-REM
|
||||
END-DIVIDE.
|
||||
*
|
||||
IF WRK-COUNT >= 4
|
||||
MOVE 'A' TO WRK-REVISED-TYPE
|
||||
ELSE
|
||||
IF WRK-COUNT = 3
|
||||
MOVE 'B' TO WRK-REVISED-TYPE
|
||||
ELSE
|
||||
MOVE 01 TO W02ERR-CATEGORY
|
||||
MOVE WRK-COUNT TO WS-DISP-INT
|
||||
STRING
|
||||
WRK-PREV-EMP-ID
|
||||
' COUNT='
|
||||
WS-DISP-INT
|
||||
' INVALID'
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 2020GRADSOR.
|
||||
*
|
||||
2010KEYBRSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 等級テーブルマッチング *
|
||||
*****************************************************************
|
||||
2020GRADSOR SECTION.
|
||||
*
|
||||
MOVE 'N' TO WRK-GRADE-FOUND.
|
||||
*
|
||||
PERFORM VARYING WRK-I FROM 1 BY 1
|
||||
UNTIL WRK-I > GRADE-COUNT
|
||||
OR WRK-GRADE-FOUND-Y
|
||||
IF WRK-AVG >=
|
||||
TBL-MONTHLY-FROM (WRK-I)
|
||||
AND WRK-AVG <=
|
||||
TBL-MONTHLY-TO (WRK-I)
|
||||
MOVE TBL-GRADE-CODE (WRK-I)
|
||||
TO WRK-NEW-GRADE
|
||||
SET WRK-GRADE-FOUND-Y TO TRUE
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
IF NOT WRK-GRADE-FOUND-Y
|
||||
MOVE 01 TO W02ERR-CATEGORY
|
||||
STRING
|
||||
WRK-PREV-EMP-ID
|
||||
' AVG='
|
||||
WRK-AVG
|
||||
' NO-GRADE'
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
*** 現在等級をDBから取得（本設計ではDB非接続のためテーブルで代用）
|
||||
*** 本来はGRADE-HISTORYをSELECTする
|
||||
MOVE 0 TO WRK-OLD-GRADE.
|
||||
*
|
||||
IF WRK-OLD-GRADE NOT = WRK-NEW-GRADE
|
||||
PERFORM 2030W01OUTSOR
|
||||
END-IF.
|
||||
*
|
||||
2020GRADSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: REVISED-GRADE出力 *
|
||||
*****************************************************************
|
||||
2030W01OUTSOR SECTION.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
*
|
||||
MOVE WRK-PREV-EMP-ID TO W01EMP-ID.
|
||||
MOVE WRK-EMP-NAME TO W01EMP-NAME.
|
||||
MOVE WRK-YEAR-MONTH TO W01REVISED-YM.
|
||||
MOVE WRK-OLD-GRADE TO W01OLD-GRADE.
|
||||
MOVE WRK-NEW-GRADE TO W01NEW-GRADE.
|
||||
MOVE WRK-AVG TO W01AVG-STD-MONTHLY.
|
||||
MOVE WRK-REVISED-TYPE TO W01REVISED-TYPE.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2030W01OUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 最終キーグループ処理
|
||||
PERFORM 2010KEYBRSOR.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
R02INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA05R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA05W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA05W02' 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,561 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA06TWM.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA06TWM *
|
||||
* プログラム名 : 保険料率適用・控除計算処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : EMP-INSURANCEをDB2 INSURANCE-RATES(M×N) *
|
||||
* とAPPLICABLE-RULES(M:N)の2段階マッチング *
|
||||
* により保険料を算出しDEDUCTED-RESULTを出力 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA06R01.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL SHA06R02.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA06W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA06W02.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: EMP-INSURANCE（200B FB SHA02REC） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA02REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: APPLICABLE-RULES（80B FB 自前レイアウト） *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
03 R02RULE-CODE PIC X(002).
|
||||
03 R02AGE-FROM PIC 9(002).
|
||||
03 R02AGE-TO PIC 9(002).
|
||||
03 R02DEPENDENTS-FROM PIC 9(002).
|
||||
03 R02DEPENDENTS-TO PIC 9(002).
|
||||
03 R02REGION-CODE PIC X(002).
|
||||
03 R02HEALTH-RATE-ADJ PIC 9(007).
|
||||
03 R02PENSION-RATE-ADJ PIC 9(007).
|
||||
03 R02FILLER PIC X(054).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: DEDUCTED-RESULT（300B FB SHA06REC） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA06REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* SQLCA *
|
||||
*****************************************************************
|
||||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA06TWM'.
|
||||
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-RATE-DIV PIC 9(007) VALUE 1000000.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-R01INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-EOF PIC X(001).
|
||||
88 WRK-EOF-Y VALUE '1'.
|
||||
03 WRK-R02-EOF PIC X(001).
|
||||
88 WRK-R02-EOF-Y VALUE '1'.
|
||||
03 WRK-SQLCODE PIC S9(009) COMP.
|
||||
03 WRK-I PIC 9(004) COMP.
|
||||
03 WRK-RULE-FOUND PIC X(001).
|
||||
88 WRK-RULE-FOUND-Y VALUE 'Y'.
|
||||
03 WRK-AGE PIC 9(003).
|
||||
03 WRK-DEPENDENTS PIC 9(002).
|
||||
03 WRK-REGION-CODE PIC X(002).
|
||||
03 WRK-HEALTH-RATE PIC 9(007).
|
||||
03 WRK-PENSION-RATE PIC 9(007).
|
||||
03 WRK-HEALTH-PREMIUM PIC 9(009).
|
||||
03 WRK-PENSION-PREMIUM PIC 9(009).
|
||||
03 WRK-TOTAL-PREMIUM PIC 9(009).
|
||||
03 WRK-BIRTH-DATE PIC 9(008).
|
||||
03 WRK-CALC-ERR PIC X(001).
|
||||
88 WRK-CALC-ERR-Y VALUE 'Y'.
|
||||
03 WS-DISP-INT PIC S9(009).
|
||||
*
|
||||
*****************************************************************
|
||||
* DB2ホスト変数 *
|
||||
*****************************************************************
|
||||
01 DBVARA.
|
||||
03 DBV-EMP-ID PIC X(008).
|
||||
03 DBV-GRADE-CODE PIC 9(002).
|
||||
03 DBV-HEALTH-RATE PIC 9(007).
|
||||
03 DBV-PENSION-RATE PIC 9(007).
|
||||
03 DBV-BIRTH-DATE PIC 9(008).
|
||||
03 DBV-DEPENDENT-COUNT PIC 9(002).
|
||||
03 DBV-REGION-CODE PIC X(002).
|
||||
*
|
||||
*****************************************************************
|
||||
* 適用ルール内部テーブル *
|
||||
*****************************************************************
|
||||
01 RULE-TBL.
|
||||
03 RULE-ENTRY OCCURS 50.
|
||||
05 TBL-RULE-CODE PIC X(002).
|
||||
05 TBL-AGE-FROM PIC 9(002).
|
||||
05 TBL-AGE-TO PIC 9(002).
|
||||
05 TBL-DEPENDENTS-FROM PIC 9(002).
|
||||
05 TBL-DEPENDENTS-TO PIC 9(002).
|
||||
05 TBL-REGION-CODE PIC X(002).
|
||||
05 TBL-HEALTH-RATE-ADJ PIC 9(007).
|
||||
05 TBL-PENSION-RATE-ADJ PIC 9(007).
|
||||
05 TBL-FILLER PIC X(054).
|
||||
01 RULE-COUNT PIC 9(004) VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
COPY SHADATAC.
|
||||
*
|
||||
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
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
OPEN INPUT R01INNFIL
|
||||
R02INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** DB接続
|
||||
EXEC SQL
|
||||
CONNECT TO 'data/INSURANCEDB.db'
|
||||
END-EXEC.
|
||||
*
|
||||
*** 適用ルールテーブル全件読込
|
||||
PERFORM 1110R02LDASOR
|
||||
UNTIL WRK-R02-EOF-Y.
|
||||
*
|
||||
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: (1.2) *
|
||||
* サブモジュール名: R02全件読込（ルールテーブル格納） *
|
||||
*****************************************************************
|
||||
1110R02LDASOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
SET WRK-R02-EOF-Y TO TRUE
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
ADD 1 TO RULE-COUNT
|
||||
MOVE R02RULE-CODE TO
|
||||
TBL-RULE-CODE (RULE-COUNT)
|
||||
MOVE R02AGE-FROM TO
|
||||
TBL-AGE-FROM (RULE-COUNT)
|
||||
MOVE R02AGE-TO TO
|
||||
TBL-AGE-TO (RULE-COUNT)
|
||||
MOVE R02DEPENDENTS-FROM TO
|
||||
TBL-DEPENDENTS-FROM (RULE-COUNT)
|
||||
MOVE R02DEPENDENTS-TO TO
|
||||
TBL-DEPENDENTS-TO (RULE-COUNT)
|
||||
MOVE R02REGION-CODE TO
|
||||
TBL-REGION-CODE (RULE-COUNT)
|
||||
MOVE R02HEALTH-RATE-ADJ TO
|
||||
TBL-HEALTH-RATE-ADJ (RULE-COUNT)
|
||||
MOVE R02PENSION-RATE-ADJ TO
|
||||
TBL-PENSION-RATE-ADJ (RULE-COUNT)
|
||||
END-READ.
|
||||
*
|
||||
1110R02LDASOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
PERFORM 2010RATESOR.
|
||||
*
|
||||
IF WRK-SQLCODE = 0
|
||||
PERFORM 2020RULESCOL
|
||||
PERFORM 2030CALCSOR
|
||||
PERFORM 2040W01OUTSOR
|
||||
ELSE
|
||||
PERFORM 2050W02OUTSOR
|
||||
END-IF.
|
||||
*
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: 第1段階料率取得（DB2 M×Nマッチング） *
|
||||
*****************************************************************
|
||||
2010RATESOR SECTION.
|
||||
*
|
||||
MOVE R01EMP-ID TO DBV-EMP-ID.
|
||||
MOVE R01GRADE-CODE TO DBV-GRADE-CODE.
|
||||
*
|
||||
EXEC SQL
|
||||
SELECT HEALTH-RATE, PENSION-RATE
|
||||
INTO :DBV-HEALTH-RATE,
|
||||
:DBV-PENSION-RATE
|
||||
FROM INSURANCE-RATES
|
||||
WHERE GRADE-CODE = :DBV-GRADE-CODE
|
||||
END-EXEC.
|
||||
*
|
||||
MOVE SQLCODE TO WRK-SQLCODE.
|
||||
*
|
||||
IF SQLCODE = 0
|
||||
MOVE DBV-HEALTH-RATE TO WRK-HEALTH-RATE
|
||||
MOVE DBV-PENSION-RATE TO WRK-PENSION-RATE
|
||||
ELSE
|
||||
IF SQLCODE NOT = 100
|
||||
MOVE 01 TO W02ERR-CATEGORY
|
||||
MOVE SQLCODE TO WS-DISP-INT
|
||||
STRING
|
||||
DBV-EMP-ID
|
||||
' SQLCODE='
|
||||
WS-DISP-INT
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
*** 年齢・扶養人数・地域コードをDBより取得
|
||||
IF SQLCODE = 0
|
||||
EXEC SQL
|
||||
SELECT BIRTH-DATE,
|
||||
DEPENDENT-COUNT,
|
||||
REGION-CODE
|
||||
INTO :DBV-BIRTH-DATE,
|
||||
:DBV-DEPENDENT-COUNT,
|
||||
:DBV-REGION-CODE
|
||||
FROM EMP-MASTER
|
||||
WHERE EMP-ID = :DBV-EMP-ID
|
||||
END-EXEC
|
||||
IF SQLCODE = 0
|
||||
MOVE DBV-BIRTH-DATE TO WRK-BIRTH-DATE
|
||||
MOVE DBV-DEPENDENT-COUNT
|
||||
TO WRK-DEPENDENTS
|
||||
MOVE DBV-REGION-CODE TO WRK-REGION-CODE
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
2010RATESOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: 第2段階ルールマッチング（M:N） *
|
||||
*****************************************************************
|
||||
2020RULESCOL SECTION.
|
||||
*
|
||||
*** 満年齢計算
|
||||
COMPUTE WRK-AGE =
|
||||
(FUNCTION INTEGER-OF-DATE (D01UBSUDATE)
|
||||
- FUNCTION INTEGER-OF-DATE (WRK-BIRTH-DATE))
|
||||
/ 365
|
||||
END-COMPUTE.
|
||||
*
|
||||
MOVE 'N' TO WRK-RULE-FOUND.
|
||||
*
|
||||
PERFORM VARYING WRK-I FROM 1 BY 1
|
||||
UNTIL WRK-I > RULE-COUNT
|
||||
OR WRK-RULE-FOUND-Y
|
||||
IF WRK-AGE >= TBL-AGE-FROM (WRK-I)
|
||||
AND WRK-AGE <= TBL-AGE-TO (WRK-I)
|
||||
AND WRK-DEPENDENTS >=
|
||||
TBL-DEPENDENTS-FROM (WRK-I)
|
||||
AND WRK-DEPENDENTS <=
|
||||
TBL-DEPENDENTS-TO (WRK-I)
|
||||
AND WRK-REGION-CODE =
|
||||
TBL-REGION-CODE (WRK-I)
|
||||
IF TBL-HEALTH-RATE-ADJ (WRK-I) > 0
|
||||
ADD TBL-HEALTH-RATE-ADJ (WRK-I)
|
||||
TO WRK-HEALTH-RATE
|
||||
END-IF
|
||||
IF TBL-PENSION-RATE-ADJ (WRK-I) > 0
|
||||
ADD TBL-PENSION-RATE-ADJ (WRK-I)
|
||||
TO WRK-PENSION-RATE
|
||||
END-IF
|
||||
SET WRK-RULE-FOUND-Y TO TRUE
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
2020RULESCOL-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.3) *
|
||||
* サブモジュール名: 保険料計算 *
|
||||
*****************************************************************
|
||||
2030CALCSOR SECTION.
|
||||
*
|
||||
MOVE 'N' TO WRK-CALC-ERR.
|
||||
*
|
||||
COMPUTE WRK-HEALTH-PREMIUM =
|
||||
R01MONTHLY-AMOUNT
|
||||
* WRK-HEALTH-RATE
|
||||
/ CNS-RATE-DIV
|
||||
ON SIZE ERROR
|
||||
MOVE 'Y' TO WRK-CALC-ERR
|
||||
END-COMPUTE.
|
||||
*
|
||||
COMPUTE WRK-PENSION-PREMIUM =
|
||||
R01MONTHLY-AMOUNT
|
||||
* WRK-PENSION-RATE
|
||||
/ CNS-RATE-DIV
|
||||
ON SIZE ERROR
|
||||
MOVE 'Y' TO WRK-CALC-ERR
|
||||
END-COMPUTE.
|
||||
*
|
||||
IF NOT WRK-CALC-ERR-Y
|
||||
COMPUTE WRK-TOTAL-PREMIUM =
|
||||
WRK-HEALTH-PREMIUM
|
||||
+ WRK-PENSION-PREMIUM
|
||||
END-COMPUTE
|
||||
END-IF.
|
||||
*
|
||||
IF WRK-CALC-ERR-Y
|
||||
MOVE 01 TO W02ERR-CATEGORY
|
||||
STRING
|
||||
R01EMP-ID
|
||||
' CALC-SIZE-ERROR'
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
END-IF.
|
||||
*
|
||||
2030CALCSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.4) *
|
||||
* サブモジュール名: DEDUCTED-RESULT出力 *
|
||||
*****************************************************************
|
||||
2040W01OUTSOR SECTION.
|
||||
*
|
||||
IF WRK-CALC-ERR-Y
|
||||
EXIT SECTION
|
||||
END-IF.
|
||||
*
|
||||
INITIALIZE W01OUTREC.
|
||||
*
|
||||
MOVE R01EMP-ID TO W01EMP-ID.
|
||||
MOVE R01EMP-NAME TO W01EMP-NAME.
|
||||
MOVE R01HEALTH-INS-TYPE TO W01INSURANCE-TYPE.
|
||||
MOVE R01GRADE-CODE TO W01GRADE-CODE.
|
||||
MOVE R01MONTHLY-AMOUNT TO W01MONTHLY-AMOUNT.
|
||||
MOVE WRK-HEALTH-RATE TO W01HEALTH-RATE.
|
||||
MOVE WRK-PENSION-RATE TO W01PENSION-RATE.
|
||||
MOVE WRK-HEALTH-PREMIUM TO W01HEALTH-PREMIUM.
|
||||
MOVE WRK-PENSION-PREMIUM TO W01PENSION-PREMIUM.
|
||||
MOVE WRK-TOTAL-PREMIUM TO W01TOTAL-PREMIUM.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
2040W01OUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.5) *
|
||||
* サブモジュール名: エラー出力（DBエラー時） *
|
||||
*****************************************************************
|
||||
2050W02OUTSOR SECTION.
|
||||
*
|
||||
MOVE 01 TO W02ERR-CATEGORY.
|
||||
MOVE WRK-SQLCODE TO WS-DISP-INT.
|
||||
STRING
|
||||
R01EMP-ID
|
||||
' DB-ERR SQLCODE='
|
||||
WS-DISP-INT
|
||||
INTO W02ERR-DETAIL
|
||||
END-STRING.
|
||||
WRITE W02OUTREC.
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
*
|
||||
2050W02OUTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
CLOSE R01INNFIL
|
||||
R02INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA06R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA06W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA06W02' 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,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.
|
||||
@@ -0,0 +1,359 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA08SRT.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA08SRT *
|
||||
* プログラム名 : 届出書データSORT編集処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : GRADED-LISTをINPUT PROCEDUREで全件RELEASEし、*
|
||||
* MONTHLY-AMOUNT/GRADE-CODEを保持したまま *
|
||||
* PREF-CODE・OFFICE-NO・EMP-ID昇順SORT後、 *
|
||||
* OUTPUT PROCEDUREでRETURNしてRPT-DATA出力。 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA08R01.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA08W01.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA08W02.
|
||||
SELECT SORTWORK ASSIGN TO EXTERNAL SORTWK01.
|
||||
*
|
||||
I-O-CONTROL.
|
||||
SAME SORT AREA FOR SORTWORK.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: GRADED-LIST（200B FB） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA04REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* SD: SORTWORK（200B SORT内部レコード） *
|
||||
*****************************************************************
|
||||
SD SORTWORK
|
||||
RECORD CONTAINS 200.
|
||||
01 SORTREC.
|
||||
03 SR-EMP-ID PIC 9(008).
|
||||
03 SR-EMP-NAME PIC X(040).
|
||||
03 SR-OFFICE-NO PIC X(004).
|
||||
03 SR-OFFICE-NAME PIC X(040).
|
||||
03 SR-PREF-CODE PIC 9(002).
|
||||
03 SR-INSURER-CODE PIC X(004).
|
||||
03 SR-INSURER-NAME PIC X(060).
|
||||
03 SR-MONTHLY-AMOUNT PIC 9(009).
|
||||
03 SR-GRADE-CODE PIC 9(002).
|
||||
03 SR-STATUS PIC X(001).
|
||||
03 SR-FILLER PIC X(030).
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: RPT-DATA（300B FB） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA08REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W02OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA08SRT'.
|
||||
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-ABD100 PIC 9(003) VALUE 100.
|
||||
01 CNS-STATUS-0 PIC X(001) VALUE '0'.
|
||||
01 CNS-RPT-TYPE PIC X(002) VALUE '01'.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
01 CUNARA.
|
||||
03 CUN-R01INN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-SORT-IN PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W01OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W02OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-U06 PIC 9(008).
|
||||
03 WRK-R01EOF PIC X(001).
|
||||
03 WRK-SORT-STAT PIC 9(002).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
*** 運用日付取得
|
||||
COPY SHADATAC.
|
||||
*** メッセージ編集出力SR用
|
||||
COPY SHAMSGAC.
|
||||
*** ABEND処理SR用
|
||||
COPY SHAENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
* 処理概要 : メインコントロール処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR.
|
||||
PERFORM 3000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.0) *
|
||||
* サブモジュール名: 初期処理 *
|
||||
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
|
||||
*****************************************************************
|
||||
1000ITTSOR SECTION.
|
||||
*
|
||||
*** 開始メッセージ出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGSTR TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** コンパイル日時出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||||
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22-01.
|
||||
MOVE 'COMPILED' TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** ワークエリア初期化
|
||||
INITIALIZE WRKARA.
|
||||
*
|
||||
*** 運用日付取得
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD = ZERO
|
||||
MOVE D01UBSUDATE TO WRK-U06
|
||||
ELSE
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 出力ファイルOPEN
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理（SORT実行） *
|
||||
* 処理概要 : SORT文を実行する *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
SORT SORTWORK
|
||||
ON ASCENDING KEY SR-PREF-CODE
|
||||
SR-OFFICE-NO
|
||||
SR-EMP-ID
|
||||
INPUT PROCEDURE 2110INPPSOR
|
||||
OUTPUT PROCEDURE 2120OUTPSOR.
|
||||
*
|
||||
MOVE RETURN-CODE TO WRK-SORT-STAT.
|
||||
IF WRK-SORT-STAT NOT = ZERO
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SORT FAILED' TO M00UMKDATS22-01
|
||||
MOVE WRK-SORT-STAT TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
MOVE CNS-ABD100 TO E01ABDCOD
|
||||
CALL 'SUB03END' USING E01ABDPAR
|
||||
END-IF.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: INPUT PROCEDURE *
|
||||
* 処理概要 : R01読込→全件RELEASE *
|
||||
*****************************************************************
|
||||
2110INPPSOR SECTION.
|
||||
*
|
||||
OPEN INPUT R01INNFIL.
|
||||
*
|
||||
PERFORM UNTIL 1 = 2
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
EXIT PERFORM
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ
|
||||
MOVE R01EMP-ID TO SR-EMP-ID
|
||||
MOVE R01EMP-NAME TO SR-EMP-NAME
|
||||
MOVE R01OFFICE-NO TO SR-OFFICE-NO
|
||||
MOVE R01OFFICE-NAME TO SR-OFFICE-NAME
|
||||
MOVE R01PREF-CODE TO SR-PREF-CODE
|
||||
MOVE R01INSURER-CODE
|
||||
TO SR-INSURER-CODE
|
||||
MOVE R01INSURER-NAME
|
||||
TO SR-INSURER-NAME
|
||||
MOVE R01MONTHLY-AMOUNT TO SR-MONTHLY-AMOUNT
|
||||
MOVE R01GRADE-CODE TO SR-GRADE-CODE
|
||||
MOVE CNS-STATUS-0 TO SR-STATUS
|
||||
MOVE R01FILLER TO SR-FILLER
|
||||
RELEASE SORTREC
|
||||
ADD 1 TO CUN-SORT-IN
|
||||
END-PERFORM.
|
||||
*
|
||||
CLOSE R01INNFIL.
|
||||
*
|
||||
2110INPPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.2) *
|
||||
* サブモジュール名: OUTPUT PROCEDURE *
|
||||
* 処理概要 : RETURN→レイアウト編集→WRITE *
|
||||
*****************************************************************
|
||||
2120OUTPSOR SECTION.
|
||||
*
|
||||
PERFORM UNTIL 1 = 2
|
||||
RETURN SORTWORK RECORD
|
||||
AT END
|
||||
EXIT PERFORM
|
||||
NOT AT END
|
||||
INITIALIZE W01OUTREC
|
||||
MOVE SR-EMP-ID TO W01EMP-ID
|
||||
MOVE SR-EMP-NAME TO W01EMP-NAME
|
||||
MOVE SR-OFFICE-NO TO W01OFFICE-NO
|
||||
MOVE SR-OFFICE-NAME TO W01OFFICE-NAME
|
||||
MOVE SR-INSURER-CODE TO W01INSURER-CODE
|
||||
MOVE SR-INSURER-NAME TO W01INSURER-NAME
|
||||
MOVE SR-PREF-CODE TO W01PREF-CODE
|
||||
MOVE CNS-RPT-TYPE TO W01REPORT-TYPE
|
||||
MOVE WRK-U06 TO W01REPORT-DATE
|
||||
MOVE SR-MONTHLY-AMOUNT
|
||||
TO W01MONTHLY-AMOUNT
|
||||
MOVE SR-GRADE-CODE TO W01GRADE-CODE
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
END-RETURN
|
||||
END-PERFORM.
|
||||
*
|
||||
2120OUTPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
* 処理概要 : ファイルクローズ・件数出力 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 出力ファイルCLOSE
|
||||
CLOSE W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** 入出力件数出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA08R01(GRADED)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA08W01(RPT-DATA)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA08W02(ERROR)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W02OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||||
MOVE 'SORT-INPUT' TO M00UMKDATS22-01.
|
||||
MOVE CUN-SORT-IN 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.
|
||||
@@ -0,0 +1,997 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA09S25.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA09S25 *
|
||||
* プログラム名 : 都道府県支部別分割出力処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : RPT-DATAをPREF-CODE（01〜25）で判定し、 *
|
||||
* 25個の出力ファイルに振り分けて出力する。 *
|
||||
* CLOSE WITH LOCKで各ファイルを確定する。 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA09R01
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA09W01
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA09W02
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL SHA09W03
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W04OUTFIL ASSIGN TO EXTERNAL SHA09W04
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W05OUTFIL ASSIGN TO EXTERNAL SHA09W05
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W06OUTFIL ASSIGN TO EXTERNAL SHA09W06
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W07OUTFIL ASSIGN TO EXTERNAL SHA09W07
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W08OUTFIL ASSIGN TO EXTERNAL SHA09W08
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W09OUTFIL ASSIGN TO EXTERNAL SHA09W09
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W10OUTFIL ASSIGN TO EXTERNAL SHA09W10
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W11OUTFIL ASSIGN TO EXTERNAL SHA09W11
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W12OUTFIL ASSIGN TO EXTERNAL SHA09W12
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W13OUTFIL ASSIGN TO EXTERNAL SHA09W13
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W14OUTFIL ASSIGN TO EXTERNAL SHA09W14
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W15OUTFIL ASSIGN TO EXTERNAL SHA09W15
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W16OUTFIL ASSIGN TO EXTERNAL SHA09W16
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W17OUTFIL ASSIGN TO EXTERNAL SHA09W17
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W18OUTFIL ASSIGN TO EXTERNAL SHA09W18
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W19OUTFIL ASSIGN TO EXTERNAL SHA09W19
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W20OUTFIL ASSIGN TO EXTERNAL SHA09W20
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W21OUTFIL ASSIGN TO EXTERNAL SHA09W21
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W22OUTFIL ASSIGN TO EXTERNAL SHA09W22
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W23OUTFIL ASSIGN TO EXTERNAL SHA09W23
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W24OUTFIL ASSIGN TO EXTERNAL SHA09W24
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W25OUTFIL ASSIGN TO EXTERNAL SHA09W25
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W98OUTFIL ASSIGN TO EXTERNAL SHA09W98
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: RPT-DATA（300B FB） *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA08REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: PREF-OUT-01（300B FB）（PREF-CODE=01） *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: PREF-OUT-02（300B FB）（PREF-CODE=02） *
|
||||
*****************************************************************
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W02OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W03: PREF-OUT-03（300B FB）（PREF-CODE=03） *
|
||||
*****************************************************************
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W03OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W03==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W04: PREF-OUT-04（300B FB）（PREF-CODE=04） *
|
||||
*****************************************************************
|
||||
FD W04OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W04OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W04==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W05: PREF-OUT-05（300B FB）（PREF-CODE=05） *
|
||||
*****************************************************************
|
||||
FD W05OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W05OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W05==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W06: PREF-OUT-06（300B FB）（PREF-CODE=06） *
|
||||
*****************************************************************
|
||||
FD W06OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W06OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W06==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W07: PREF-OUT-07（300B FB）（PREF-CODE=07） *
|
||||
*****************************************************************
|
||||
FD W07OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W07OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W07==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W08: PREF-OUT-08（300B FB）（PREF-CODE=08） *
|
||||
*****************************************************************
|
||||
FD W08OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W08OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W08==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W09: PREF-OUT-09（300B FB）（PREF-CODE=09） *
|
||||
*****************************************************************
|
||||
FD W09OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W09OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W09==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W10: PREF-OUT-10（300B FB）（PREF-CODE=10） *
|
||||
*****************************************************************
|
||||
FD W10OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W10OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W10==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W11: PREF-OUT-11（300B FB）（PREF-CODE=11） *
|
||||
*****************************************************************
|
||||
FD W11OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W11OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W11==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W12: PREF-OUT-12（300B FB）（PREF-CODE=12） *
|
||||
*****************************************************************
|
||||
FD W12OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W12OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W12==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W13: PREF-OUT-13（300B FB）（PREF-CODE=13） *
|
||||
*****************************************************************
|
||||
FD W13OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W13OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W13==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W14: PREF-OUT-14（300B FB）（PREF-CODE=14） *
|
||||
*****************************************************************
|
||||
FD W14OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W14OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W14==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W15: PREF-OUT-15（300B FB）（PREF-CODE=15） *
|
||||
*****************************************************************
|
||||
FD W15OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W15OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W15==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W16: PREF-OUT-16（300B FB）（PREF-CODE=16） *
|
||||
*****************************************************************
|
||||
FD W16OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W16OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W16==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W17: PREF-OUT-17（300B FB）（PREF-CODE=17） *
|
||||
*****************************************************************
|
||||
FD W17OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W17OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W17==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W18: PREF-OUT-18（300B FB）（PREF-CODE=18） *
|
||||
*****************************************************************
|
||||
FD W18OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W18OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W18==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W19: PREF-OUT-19（300B FB）（PREF-CODE=19） *
|
||||
*****************************************************************
|
||||
FD W19OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W19OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W19==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W20: PREF-OUT-20（300B FB）（PREF-CODE=20） *
|
||||
*****************************************************************
|
||||
FD W20OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W20OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W20==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W21: PREF-OUT-21（300B FB）（PREF-CODE=21） *
|
||||
*****************************************************************
|
||||
FD W21OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W21OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W21==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W22: PREF-OUT-22（300B FB）（PREF-CODE=22） *
|
||||
*****************************************************************
|
||||
FD W22OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W22OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W22==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W23: PREF-OUT-23（300B FB）（PREF-CODE=23） *
|
||||
*****************************************************************
|
||||
FD W23OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W23OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W23==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W24: PREF-OUT-24（300B FB）（PREF-CODE=24） *
|
||||
*****************************************************************
|
||||
FD W24OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W24OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W24==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W25: PREF-OUT-25（300B FB）（PREF-CODE=25） *
|
||||
*****************************************************************
|
||||
FD W25OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W25OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W25==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W98: ERROR-LOG（VB） *
|
||||
*****************************************************************
|
||||
FD W98OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W98OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W98==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* コンスタント領域 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA09S25'.
|
||||
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-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.
|
||||
03 CUN-W04OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W05OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W06OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W07OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W08OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W09OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W10OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W11OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W12OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W13OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W14OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W15OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W16OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W17OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W18OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W19OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W20OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W21OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W22OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W23OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W24OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W25OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W98OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 作業領域 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-U06 PIC 9(008).
|
||||
03 WRK-R01EOF PIC X(001).
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
*** 運用日付取得
|
||||
COPY SHADATAC.
|
||||
*** メッセージ編集出力SR用
|
||||
COPY SHAMSGAC.
|
||||
*** ABEND処理SR用
|
||||
COPY SHAENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
* 処理概要 : メインコントロール処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-R01EOF = '1'.
|
||||
PERFORM 3000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.0) *
|
||||
* サブモジュール名: 初期処理 *
|
||||
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
|
||||
*****************************************************************
|
||||
1000ITTSOR SECTION.
|
||||
*
|
||||
*** 開始メッセージ出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGSTR TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** コンパイル日時出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||||
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22-01.
|
||||
MOVE 'COMPILED' TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** ワークエリア初期化
|
||||
INITIALIZE WRKARA.
|
||||
*
|
||||
*** 運用日付取得
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD = ZERO
|
||||
MOVE D01UBSUDATE TO WRK-U06
|
||||
ELSE
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 入出力ファイルOPEN
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL
|
||||
W04OUTFIL
|
||||
W05OUTFIL
|
||||
W06OUTFIL
|
||||
W07OUTFIL
|
||||
W08OUTFIL
|
||||
W09OUTFIL
|
||||
W10OUTFIL
|
||||
W11OUTFIL
|
||||
W12OUTFIL
|
||||
W13OUTFIL
|
||||
W14OUTFIL
|
||||
W15OUTFIL
|
||||
W16OUTFIL
|
||||
W17OUTFIL
|
||||
W18OUTFIL
|
||||
W19OUTFIL
|
||||
W20OUTFIL
|
||||
W21OUTFIL
|
||||
W22OUTFIL
|
||||
W23OUTFIL
|
||||
W24OUTFIL
|
||||
W25OUTFIL
|
||||
W98OUTFIL.
|
||||
*
|
||||
*** R01を読み込み
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.1) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
* 処理概要 : レコード読込・EOF判定処理 *
|
||||
*****************************************************************
|
||||
1100R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
MOVE '1' TO WRK-R01EOF
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1100R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
* 処理概要 : PREF-CODE判定→該当ファイル出力 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
PERFORM 2100SPLITSOR.
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (2.1) *
|
||||
* サブモジュール名: PREF-CODE判定分割出力 *
|
||||
* 処理概要 : EVALUATEでPREF-CODEに応じたファイル出力 *
|
||||
*****************************************************************
|
||||
2100SPLITSOR SECTION.
|
||||
*
|
||||
EVALUATE R01PREF-CODE
|
||||
WHEN 01
|
||||
INITIALIZE W01OUTREC
|
||||
MOVE R01PREF-CODE TO W01PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W01INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W01RPT-BODY
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
WHEN 02
|
||||
INITIALIZE W02OUTREC
|
||||
MOVE R01PREF-CODE TO W02PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W02INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W02RPT-BODY
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
WHEN 03
|
||||
INITIALIZE W03OUTREC
|
||||
MOVE R01PREF-CODE TO W03PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W03INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W03RPT-BODY
|
||||
WRITE W03OUTREC
|
||||
ADD 1 TO CUN-W03OUT
|
||||
WHEN 04
|
||||
INITIALIZE W04OUTREC
|
||||
MOVE R01PREF-CODE TO W04PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W04INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W04RPT-BODY
|
||||
WRITE W04OUTREC
|
||||
ADD 1 TO CUN-W04OUT
|
||||
WHEN 05
|
||||
INITIALIZE W05OUTREC
|
||||
MOVE R01PREF-CODE TO W05PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W05INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W05RPT-BODY
|
||||
WRITE W05OUTREC
|
||||
ADD 1 TO CUN-W05OUT
|
||||
WHEN 06
|
||||
INITIALIZE W06OUTREC
|
||||
MOVE R01PREF-CODE TO W06PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W06INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W06RPT-BODY
|
||||
WRITE W06OUTREC
|
||||
ADD 1 TO CUN-W06OUT
|
||||
WHEN 07
|
||||
INITIALIZE W07OUTREC
|
||||
MOVE R01PREF-CODE TO W07PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W07INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W07RPT-BODY
|
||||
WRITE W07OUTREC
|
||||
ADD 1 TO CUN-W07OUT
|
||||
WHEN 08
|
||||
INITIALIZE W08OUTREC
|
||||
MOVE R01PREF-CODE TO W08PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W08INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W08RPT-BODY
|
||||
WRITE W08OUTREC
|
||||
ADD 1 TO CUN-W08OUT
|
||||
WHEN 09
|
||||
INITIALIZE W09OUTREC
|
||||
MOVE R01PREF-CODE TO W09PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W09INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W09RPT-BODY
|
||||
WRITE W09OUTREC
|
||||
ADD 1 TO CUN-W09OUT
|
||||
WHEN 10
|
||||
INITIALIZE W10OUTREC
|
||||
MOVE R01PREF-CODE TO W10PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W10INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W10RPT-BODY
|
||||
WRITE W10OUTREC
|
||||
ADD 1 TO CUN-W10OUT
|
||||
WHEN 11
|
||||
INITIALIZE W11OUTREC
|
||||
MOVE R01PREF-CODE TO W11PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W11INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W11RPT-BODY
|
||||
WRITE W11OUTREC
|
||||
ADD 1 TO CUN-W11OUT
|
||||
WHEN 12
|
||||
INITIALIZE W12OUTREC
|
||||
MOVE R01PREF-CODE TO W12PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W12INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W12RPT-BODY
|
||||
WRITE W12OUTREC
|
||||
ADD 1 TO CUN-W12OUT
|
||||
WHEN 13
|
||||
INITIALIZE W13OUTREC
|
||||
MOVE R01PREF-CODE TO W13PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W13INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W13RPT-BODY
|
||||
WRITE W13OUTREC
|
||||
ADD 1 TO CUN-W13OUT
|
||||
WHEN 14
|
||||
INITIALIZE W14OUTREC
|
||||
MOVE R01PREF-CODE TO W14PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W14INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W14RPT-BODY
|
||||
WRITE W14OUTREC
|
||||
ADD 1 TO CUN-W14OUT
|
||||
WHEN 15
|
||||
INITIALIZE W15OUTREC
|
||||
MOVE R01PREF-CODE TO W15PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W15INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W15RPT-BODY
|
||||
WRITE W15OUTREC
|
||||
ADD 1 TO CUN-W15OUT
|
||||
WHEN 16
|
||||
INITIALIZE W16OUTREC
|
||||
MOVE R01PREF-CODE TO W16PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W16INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W16RPT-BODY
|
||||
WRITE W16OUTREC
|
||||
ADD 1 TO CUN-W16OUT
|
||||
WHEN 17
|
||||
INITIALIZE W17OUTREC
|
||||
MOVE R01PREF-CODE TO W17PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W17INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W17RPT-BODY
|
||||
WRITE W17OUTREC
|
||||
ADD 1 TO CUN-W17OUT
|
||||
WHEN 18
|
||||
INITIALIZE W18OUTREC
|
||||
MOVE R01PREF-CODE TO W18PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W18INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W18RPT-BODY
|
||||
WRITE W18OUTREC
|
||||
ADD 1 TO CUN-W18OUT
|
||||
WHEN 19
|
||||
INITIALIZE W19OUTREC
|
||||
MOVE R01PREF-CODE TO W19PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W19INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W19RPT-BODY
|
||||
WRITE W19OUTREC
|
||||
ADD 1 TO CUN-W19OUT
|
||||
WHEN 20
|
||||
INITIALIZE W20OUTREC
|
||||
MOVE R01PREF-CODE TO W20PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W20INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W20RPT-BODY
|
||||
WRITE W20OUTREC
|
||||
ADD 1 TO CUN-W20OUT
|
||||
WHEN 21
|
||||
INITIALIZE W21OUTREC
|
||||
MOVE R01PREF-CODE TO W21PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W21INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W21RPT-BODY
|
||||
WRITE W21OUTREC
|
||||
ADD 1 TO CUN-W21OUT
|
||||
WHEN 22
|
||||
INITIALIZE W22OUTREC
|
||||
MOVE R01PREF-CODE TO W22PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W22INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W22RPT-BODY
|
||||
WRITE W22OUTREC
|
||||
ADD 1 TO CUN-W22OUT
|
||||
WHEN 23
|
||||
INITIALIZE W23OUTREC
|
||||
MOVE R01PREF-CODE TO W23PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W23INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W23RPT-BODY
|
||||
WRITE W23OUTREC
|
||||
ADD 1 TO CUN-W23OUT
|
||||
WHEN 24
|
||||
INITIALIZE W24OUTREC
|
||||
MOVE R01PREF-CODE TO W24PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W24INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W24RPT-BODY
|
||||
WRITE W24OUTREC
|
||||
ADD 1 TO CUN-W24OUT
|
||||
WHEN 25
|
||||
INITIALIZE W25OUTREC
|
||||
MOVE R01PREF-CODE TO W25PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W25INSURER-CODE
|
||||
STRING R01EMP-ID
|
||||
R01EMP-NAME
|
||||
R01OFFICE-NO
|
||||
R01OFFICE-NAME
|
||||
R01INSURER-CODE
|
||||
R01INSURER-NAME
|
||||
DELIMITED BY SIZE
|
||||
INTO W25RPT-BODY
|
||||
WRITE W25OUTREC
|
||||
ADD 1 TO CUN-W25OUT
|
||||
WHEN OTHER
|
||||
INITIALIZE W98OUTREC
|
||||
MOVE '01' TO W98ERR-CATEGORY
|
||||
STRING 'INVALID PREF-CODE:'
|
||||
R01PREF-CODE
|
||||
DELIMITED BY SIZE
|
||||
INTO W98ERR-DETAIL
|
||||
WRITE W98OUTREC
|
||||
ADD 1 TO CUN-W98OUT
|
||||
END-EVALUATE.
|
||||
*
|
||||
2100SPLITSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (3.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
* 処理概要 : CLOSE WITH LOCK・件数出力 *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 出力ファイルCLOSE WITH LOCK
|
||||
CLOSE R01INNFIL.
|
||||
CLOSE W01OUTFIL WITH LOCK
|
||||
W02OUTFIL WITH LOCK
|
||||
W03OUTFIL WITH LOCK
|
||||
W04OUTFIL WITH LOCK
|
||||
W05OUTFIL WITH LOCK
|
||||
W06OUTFIL WITH LOCK
|
||||
W07OUTFIL WITH LOCK
|
||||
W08OUTFIL WITH LOCK
|
||||
W09OUTFIL WITH LOCK
|
||||
W10OUTFIL WITH LOCK
|
||||
W11OUTFIL WITH LOCK
|
||||
W12OUTFIL WITH LOCK
|
||||
W13OUTFIL WITH LOCK
|
||||
W14OUTFIL WITH LOCK
|
||||
W15OUTFIL WITH LOCK
|
||||
W16OUTFIL WITH LOCK
|
||||
W17OUTFIL WITH LOCK
|
||||
W18OUTFIL WITH LOCK
|
||||
W19OUTFIL WITH LOCK
|
||||
W20OUTFIL WITH LOCK
|
||||
W21OUTFIL WITH LOCK
|
||||
W22OUTFIL WITH LOCK
|
||||
W23OUTFIL WITH LOCK
|
||||
W24OUTFIL WITH LOCK
|
||||
W25OUTFIL WITH LOCK
|
||||
W98OUTFIL.
|
||||
*
|
||||
*** 入出力件数出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA09R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA09W01-25 TOTAL' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA09W98(ERROR)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W98OUT 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.
|
||||
@@ -0,0 +1,479 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SHA10S10.
|
||||
*****************************************************************
|
||||
* システム名 : 社会保険管理システム *
|
||||
* プログラムID : SHA10S10 *
|
||||
* プログラム名 : 保険者別分割出力処理 *
|
||||
* 作成日 : 2026-07-11 *
|
||||
* 処理概要 : RPT-DATAをINSURER-CODE（01～99）で判定 *
|
||||
* し、99個の出力ファイルに振り分けて出力。 *
|
||||
* CLOSE WITH LOCKで各ファイルを確定する。 *
|
||||
* *
|
||||
* *
|
||||
* 備考: 99ファイルの全SELECTは膨大となるため、本実装では *
|
||||
* 001-010の10ファイルを代表定義。全99ファイルへの展開は *
|
||||
* 本番IBM COBOLビルド時にジェネ生成で行う。 *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-07-11 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL SHA10R01
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL SHA10W01
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL SHA10W02
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W03OUTFIL ASSIGN TO EXTERNAL SHA10W03
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W04OUTFIL ASSIGN TO EXTERNAL SHA10W04
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W05OUTFIL ASSIGN TO EXTERNAL SHA10W05
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W06OUTFIL ASSIGN TO EXTERNAL SHA10W06
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W07OUTFIL ASSIGN TO EXTERNAL SHA10W07
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W08OUTFIL ASSIGN TO EXTERNAL SHA10W08
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W09OUTFIL ASSIGN TO EXTERNAL SHA10W09
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
SELECT W10OUTFIL ASSIGN TO EXTERNAL SHA10W10
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
*** 銈ㄣ儵銉煎嚭鍔涚敤
|
||||
SELECT W99OUTFIL ASSIGN TO EXTERNAL SHA10W98
|
||||
ORGANIZATION IS SEQUENTIAL.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: RPT-DATA锛?00B FB锛? *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SHA08REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01-W10: INSURER-OUT-01銆?0锛?00B FB锛? *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W01==.
|
||||
FD W02OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W02OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W02==.
|
||||
FD W03OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W03OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W03==.
|
||||
FD W04OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W04OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W04==.
|
||||
FD W05OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W05OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W05==.
|
||||
FD W06OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W06OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W06==.
|
||||
FD W07OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W07OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W07==.
|
||||
FD W08OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W08OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W08==.
|
||||
FD W09OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W09OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W09==.
|
||||
FD W10OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W10OUTREC.
|
||||
COPY SHA09REC REPLACING ==(A)== BY ==W10==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W99: ERROR-LOG锛圴B锛? *
|
||||
*****************************************************************
|
||||
FD W99OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS V.
|
||||
01 W99OUTREC.
|
||||
COPY ZAN05REC REPLACING ==(A)== BY ==W99==.
|
||||
*
|
||||
WORKING-STORAGE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈炽兂銈广偪銉炽儓闋樺煙 *
|
||||
*****************************************************************
|
||||
01 CNSARA.
|
||||
03 CNS-PRGIDX PIC X(008) VALUE 'SHA10S10'.
|
||||
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-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.
|
||||
03 CUN-W04OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W05OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W06OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W07OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W08OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W09OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W10OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
03 CUN-W99OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||||
*
|
||||
*****************************************************************
|
||||
* 浣滄キ闋樺煙 *
|
||||
*****************************************************************
|
||||
01 WRKARA.
|
||||
03 WRK-U06 PIC 9(008).
|
||||
03 WRK-R01EOF PIC X(001).
|
||||
01 WRK-RPT-BODY-BUFFER.
|
||||
03 WRK-BUF-EMP-ID PIC 9(008).
|
||||
03 WRK-BUF-EMP-NAME PIC X(040).
|
||||
03 WRK-BUF-OFFICE-NO PIC X(004).
|
||||
03 WRK-BUF-OFFICE-NAME PIC X(040).
|
||||
03 WRK-BUF-INSURER-NAME PIC X(060).
|
||||
03 WRK-BUF-MONTHLY-AMOUNT PIC 9(009).
|
||||
03 WRK-BUF-GRADE-CODE PIC 9(002).
|
||||
03 WRK-BUF-REPORT-TYPE PIC X(002).
|
||||
03 WRK-BUF-REPORT-DATE PIC 9(008).
|
||||
03 WRK-BUF-FILLER PIC X(121).
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉椼儹銈般儵銉犻€ｇ怠闋樺煙 *
|
||||
*****************************************************************
|
||||
*** 閬嬬敤鏃ヤ粯鍙栧緱
|
||||
COPY SHADATAC.
|
||||
COPY SHAMSGAC.
|
||||
COPY SHAENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (0.0) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: 鍒跺尽鍑︾悊 *
|
||||
* 鍑︾悊姒傝 : 銉°偆銉炽偝銉炽儓銉兗銉嚘鐞? *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
PERFORM 1000ITTSOR.
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-R01EOF = '1'.
|
||||
PERFORM 3000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (1.0) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: 鍒濇湡鍑︾悊 *
|
||||
* 鍑︾悊姒傝 : 闁嬪銉°儍銈汇兗銈稿嚭鍔涖兓鍚勭ó鍒濇湡鍖栧嚘鐞? *
|
||||
*****************************************************************
|
||||
1000ITTSOR SECTION.
|
||||
*
|
||||
*** 闁嬪銉°儍銈汇兗銈稿嚭鍔? INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGSTR TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 銈炽兂銉戙偆銉棩鏅傚嚭鍔? INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||||
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22-01.
|
||||
MOVE 'COMPILED' TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 銉兗銈偍銉偄鍒濇湡鍖? INITIALIZE WRKARA.
|
||||
*
|
||||
*** 閬嬬敤鏃ヤ粯鍙栧緱
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR.
|
||||
IF D01FKICOD = ZERO
|
||||
MOVE D01UBSUDATE TO WRK-U06
|
||||
ELSE
|
||||
INITIALIZE M00MHOPAR
|
||||
MOVE CNS-MSGSUBEEK TO M00MSGCOD
|
||||
MOVE 'SUB01DAT' TO M00UMKDATS22-01
|
||||
MOVE D01FKICOD TO M00UMKDATS22-02
|
||||
PERFORM 4000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 鍏ュ嚭鍔涖儠銈°偆銉玂PEN
|
||||
OPEN INPUT R01INNFIL.
|
||||
OPEN OUTPUT W01OUTFIL
|
||||
W02OUTFIL
|
||||
W03OUTFIL
|
||||
W04OUTFIL
|
||||
W05OUTFIL
|
||||
W06OUTFIL
|
||||
W07OUTFIL
|
||||
W08OUTFIL
|
||||
W09OUTFIL
|
||||
W10OUTFIL
|
||||
W99OUTFIL.
|
||||
*
|
||||
*** R01銈掕銇胯炯銇? PERFORM 1100R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (1.1) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: R01瑾炯鍑︾悊 *
|
||||
* 鍑︾悊姒傝 : 銉偝銉笺儔瑾炯銉籈OF鍒ゅ畾鍑︾悊 *
|
||||
*****************************************************************
|
||||
1100R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
MOVE '1' TO WRK-R01EOF
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1100R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (2.0) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: 涓诲嚘鐞? *
|
||||
* 鍑︾悊姒傝 : INSURER-CODE鍒ゅ畾鈫掕┎褰撱儠銈°偆銉嚭鍔? *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
PERFORM 2100SPLITSOR.
|
||||
PERFORM 1100R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (2.1) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: INSURER-CODE鍒ゅ畾鍒嗗壊鍑哄姏 *
|
||||
* 鍑︾悊姒傝 : EVALUATE銇NSURER-CODE銇繙銇樸仸銉曘偂銈ゃ儷鍑哄姏 *
|
||||
* 001-099銇俱仹99銉曘偂銈ゃ儷銆傚叏99WHEN灞曢枊銇? *
|
||||
* 銈炽兗銉夌敓鎴愩儎銉笺儷銇ц銇嗐€傛湰瀹熻銇唬琛?0浠躲€? *
|
||||
*****************************************************************
|
||||
2100SPLITSOR SECTION.
|
||||
*
|
||||
* RPT-BODY妲嬬瘔
|
||||
MOVE R01EMP-ID TO WRK-BUF-EMP-ID.
|
||||
MOVE R01EMP-NAME TO WRK-BUF-EMP-NAME.
|
||||
MOVE R01OFFICE-NO TO WRK-BUF-OFFICE-NO.
|
||||
MOVE R01OFFICE-NAME TO WRK-BUF-OFFICE-NAME.
|
||||
MOVE R01INSURER-NAME TO WRK-BUF-INSURER-NAME.
|
||||
MOVE R01MONTHLY-AMOUNT TO WRK-BUF-MONTHLY-AMOUNT.
|
||||
MOVE R01GRADE-CODE TO WRK-BUF-GRADE-CODE.
|
||||
MOVE R01REPORT-TYPE TO WRK-BUF-REPORT-TYPE.
|
||||
MOVE R01REPORT-DATE TO WRK-BUF-REPORT-DATE.
|
||||
MOVE R01FILLER TO WRK-BUF-FILLER.
|
||||
*
|
||||
EVALUATE R01INSURER-CODE
|
||||
WHEN '001'
|
||||
INITIALIZE W01OUTREC
|
||||
MOVE R01PREF-CODE TO W01PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W01INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W01RPT-BODY
|
||||
WRITE W01OUTREC
|
||||
ADD 1 TO CUN-W01OUT
|
||||
WHEN '002'
|
||||
INITIALIZE W02OUTREC
|
||||
MOVE R01PREF-CODE TO W02PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W02INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W02RPT-BODY
|
||||
WRITE W02OUTREC
|
||||
ADD 1 TO CUN-W02OUT
|
||||
WHEN '003'
|
||||
INITIALIZE W03OUTREC
|
||||
MOVE R01PREF-CODE TO W03PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W03INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W03RPT-BODY
|
||||
WRITE W03OUTREC
|
||||
ADD 1 TO CUN-W03OUT
|
||||
WHEN '004'
|
||||
INITIALIZE W04OUTREC
|
||||
MOVE R01PREF-CODE TO W04PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W04INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W04RPT-BODY
|
||||
WRITE W04OUTREC
|
||||
ADD 1 TO CUN-W04OUT
|
||||
WHEN '005'
|
||||
INITIALIZE W05OUTREC
|
||||
MOVE R01PREF-CODE TO W05PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W05INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W05RPT-BODY
|
||||
WRITE W05OUTREC
|
||||
ADD 1 TO CUN-W05OUT
|
||||
WHEN '006'
|
||||
INITIALIZE W06OUTREC
|
||||
MOVE R01PREF-CODE TO W06PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W06INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W06RPT-BODY
|
||||
WRITE W06OUTREC
|
||||
ADD 1 TO CUN-W06OUT
|
||||
WHEN '007'
|
||||
INITIALIZE W07OUTREC
|
||||
MOVE R01PREF-CODE TO W07PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W07INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W07RPT-BODY
|
||||
WRITE W07OUTREC
|
||||
ADD 1 TO CUN-W07OUT
|
||||
WHEN '008'
|
||||
INITIALIZE W08OUTREC
|
||||
MOVE R01PREF-CODE TO W08PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W08INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W08RPT-BODY
|
||||
WRITE W08OUTREC
|
||||
ADD 1 TO CUN-W08OUT
|
||||
WHEN '009'
|
||||
INITIALIZE W09OUTREC
|
||||
MOVE R01PREF-CODE TO W09PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W09INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W09RPT-BODY
|
||||
WRITE W09OUTREC
|
||||
ADD 1 TO CUN-W09OUT
|
||||
WHEN '010'
|
||||
INITIALIZE W10OUTREC
|
||||
MOVE R01PREF-CODE TO W10PREF-CODE
|
||||
MOVE R01INSURER-CODE TO W10INSURER-CODE
|
||||
MOVE WRK-RPT-BODY-BUFFER TO W10RPT-BODY
|
||||
WRITE W10OUTREC
|
||||
ADD 1 TO CUN-W10OUT
|
||||
WHEN OTHER
|
||||
INITIALIZE W99OUTREC
|
||||
MOVE '01' TO W99ERR-CATEGORY
|
||||
STRING 'INVALID INSURER:'
|
||||
R01INSURER-CODE
|
||||
DELIMITED BY SIZE
|
||||
INTO W99ERR-DETAIL
|
||||
WRITE W99OUTREC
|
||||
ADD 1 TO CUN-W99OUT
|
||||
END-EVALUATE.
|
||||
*
|
||||
2100SPLITSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (3.0) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: 绲備簡鍑︾悊 *
|
||||
* 鍑︾悊姒傝 : CLOSE WITH LOCK銉讳欢鏁板嚭鍔? *
|
||||
*****************************************************************
|
||||
3000STPSOR SECTION.
|
||||
*
|
||||
*** 鍏ュ嚭鍔涖儠銈°偆銉獵LOSE
|
||||
CLOSE R01INNFIL.
|
||||
CLOSE W01OUTFIL WITH LOCK
|
||||
W02OUTFIL WITH LOCK
|
||||
W03OUTFIL WITH LOCK
|
||||
W04OUTFIL WITH LOCK
|
||||
W05OUTFIL WITH LOCK
|
||||
W06OUTFIL WITH LOCK
|
||||
W07OUTFIL WITH LOCK
|
||||
W08OUTFIL WITH LOCK
|
||||
W09OUTFIL WITH LOCK
|
||||
W10OUTFIL WITH LOCK
|
||||
W99OUTFIL.
|
||||
*
|
||||
*** 鍏ュ嚭鍔涗欢鏁板嚭鍔? INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'SHA10R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA10W01-10 TOTAL' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'SHA10W98(ERROR)' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W99OUT TO M00UMKDATS22-02.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
*** 绲備簡銉°儍銈汇兗銈稿嚭鍔? INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||||
PERFORM 4000MSGOUTSOR.
|
||||
*
|
||||
3000STPSOR-EXT.
|
||||
EXIT.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (4.0) *
|
||||
* 銈点儢銉偢銉ャ兗銉悕: 銉°儍銈汇兗銈哥法闆嗗嚭鍔涘嚘鐞? *
|
||||
* 鍑︾悊姒傝 : 銉°儍銈汇兗銈哥法闆嗗嚭鍔涖偟銉朠GM鍛煎嚭 *
|
||||
*****************************************************************
|
||||
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.
|
||||
*
|
||||
*****************************************************************
|
||||
* 銈点儢銉偢銉ャ兗銉玁O: (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