326 lines
14 KiB
COBOL
326 lines
14 KiB
COBOL
IDENTIFICATION DIVISION.
|
||
PROGRAM-ID. KYU02REG.
|
||
*****************************************************************
|
||
* システム名 : 給与計算システム *
|
||
* プログラムID : KYU02REG *
|
||
* プログラム名 : 社員マスタDB2登録処理 *
|
||
* 作成日 : 2026-07-01 *
|
||
* 処理概要 : EMP-RECORDをDB2 EMP-MASTERにINSERT/UPSERT *
|
||
* 重複時（-803）はUPDATEに切替 *
|
||
*****************************************************************
|
||
* 更新履歴 *
|
||
*---------------------------------------------------------------*
|
||
* 更新日付 担当者 更新内容 *
|
||
*---------------------------------------------------------------*
|
||
* 2026-07-01 @@@ 新規作成 *
|
||
* *
|
||
*****************************************************************
|
||
ENVIRONMENT DIVISION.
|
||
CONFIGURATION SECTION.
|
||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||
*
|
||
INPUT-OUTPUT SECTION.
|
||
FILE-CONTROL.
|
||
SELECT R02INNFIL ASSIGN TO EXTERNAL KYU02R02
|
||
ORGANIZATION IS SEQUENTIAL
|
||
ACCESS MODE IS SEQUENTIAL.
|
||
SELECT W03OUTFIL ASSIGN TO EXTERNAL KYU02W03
|
||
ORGANIZATION IS SEQUENTIAL
|
||
ACCESS MODE IS SEQUENTIAL.
|
||
*
|
||
DATA DIVISION.
|
||
FILE SECTION.
|
||
*
|
||
*****************************************************************
|
||
* R02: EMP-RECORD（80B FB） *
|
||
*****************************************************************
|
||
FD R02INNFIL
|
||
LABEL RECORD IS STANDARD
|
||
BLOCK CONTAINS 0
|
||
RECORDING MODE IS F.
|
||
01 R02INNREC.
|
||
COPY KYU01REC REPLACING ==(A)== BY ==R02==.
|
||
*
|
||
*****************************************************************
|
||
* W03: ERROR-LOG（VB） *
|
||
*****************************************************************
|
||
FD W03OUTFIL
|
||
LABEL RECORD IS STANDARD
|
||
BLOCK CONTAINS 0
|
||
RECORDING MODE IS V.
|
||
01 W03OUTREC.
|
||
COPY KYU99REC REPLACING ==(A)== BY ==W03==.
|
||
*
|
||
WORKING-STORAGE SECTION.
|
||
*
|
||
*****************************************************************
|
||
* SQLCA *
|
||
*****************************************************************
|
||
EXEC SQL INCLUDE SQLCA END-EXEC.
|
||
*
|
||
*****************************************************************
|
||
* コンスタント領域 *
|
||
*****************************************************************
|
||
01 CNSARA.
|
||
03 CNS-PRGIDX PIC X(008) VALUE 'KYU02REG'.
|
||
03 CNS-MSGSTR PIC 9(003) VALUE 001.
|
||
03 CNS-MSGFIN PIC 9(003) VALUE 002.
|
||
03 CNS-MSGSUBEEK PIC 9(003) VALUE 005.
|
||
03 CNS-MSGIINKES PIC 9(003) VALUE 006.
|
||
03 CNS-MSGOUTKES PIC 9(003) VALUE 007.
|
||
03 CNS-MSGKEYINF PIC 9(003) VALUE 033.
|
||
03 CNS-KN0002 PIC 9(001) VALUE 2.
|
||
03 CNS-ABD999 PIC 9(003) VALUE 999.
|
||
*
|
||
*****************************************************************
|
||
* カウンタ領域 *
|
||
*****************************************************************
|
||
01 CUNARA.
|
||
03 CUN-R02INN PIC S9(009) COMP-3 VALUE ZERO.
|
||
03 CUN-W03OUT PIC S9(009) COMP-3 VALUE ZERO.
|
||
03 CUN-DB-INS PIC S9(009) COMP-3 VALUE ZERO.
|
||
03 CUN-DB-UPD PIC S9(009) COMP-3 VALUE ZERO.
|
||
*
|
||
*****************************************************************
|
||
* 作業領域 *
|
||
*****************************************************************
|
||
01 WRKARA.
|
||
03 WRK-EOF PIC X(001).
|
||
|
||
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
|
||
03 WS-FILE-STATUS PIC X(002).
|
||
88 WRK-EOF-Y VALUE '1'.
|
||
*
|
||
*****************************************************************
|
||
* DB2ホスト変数 *
|
||
*****************************************************************
|
||
01 DBVARA.
|
||
03 DBV-EMP-ID PIC X(008).
|
||
03 DBV-EMP-NAME PIC X(040).
|
||
03 DBV-DEPT-CODE PIC X(002).
|
||
03 DBV-REGION-CODE PIC X(002).
|
||
03 DBV-CATEGORY-CODE PIC X(003).
|
||
03 DBV-BASE-SALARY PIC 9(009).
|
||
03 DBV-HOURLY-RATE PIC 9(007).
|
||
03 DBV-DEPENDENT-COUNT PIC 9(002).
|
||
03 DBV-STATUS PIC X(001).
|
||
*
|
||
*****************************************************************
|
||
* サブプログラム連絡領域 *
|
||
*****************************************************************
|
||
COPY ZANMSGAC.
|
||
COPY ZANENDAC.
|
||
*
|
||
PROCEDURE DIVISION.
|
||
*****************************************************************
|
||
* サブモジュールNO: (0.0) *
|
||
* サブモジュール名: 制御処理 *
|
||
*****************************************************************
|
||
0000MAJCOLSOR SECTION.
|
||
*
|
||
PERFORM 1000ITTSOR.
|
||
PERFORM 2000MAJSOR
|
||
UNTIL WRK-EOF-Y.
|
||
PERFORM 3000STPSOR.
|
||
*
|
||
0000MAJCOLSOR-EXT.
|
||
GOBACK.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (1.0) *
|
||
* サブモジュール名: 初期処理 *
|
||
*****************************************************************
|
||
1000ITTSOR SECTION.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGSTR TO M00MSGCOD.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22-01.
|
||
MOVE 'COMPILED' TO M00UMKDATS22-02.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE WRKARA.
|
||
*
|
||
OPEN INPUT R02INNFIL.
|
||
OPEN OUTPUT W03OUTFIL.
|
||
*
|
||
*** DB接続
|
||
EXEC SQL
|
||
CONNECT TO 'data/SALARY.db'
|
||
END-EXEC.
|
||
*
|
||
PERFORM 1100R02INNSOR.
|
||
*
|
||
1000ITTSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (1.1) *
|
||
* サブモジュール名: R02読込処理 *
|
||
*****************************************************************
|
||
1100R02INNSOR SECTION.
|
||
*
|
||
READ R02INNFIL
|
||
AT END
|
||
SET WRK-EOF-Y TO TRUE
|
||
NOT AT END
|
||
ADD 1 TO CUN-R02INN
|
||
END-READ.
|
||
*
|
||
1100R02INNSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (2.0) *
|
||
* サブモジュール名: 主処理 *
|
||
*****************************************************************
|
||
2000MAJSOR SECTION.
|
||
*
|
||
*** DB2ホスト変数にMOVE
|
||
MOVE R02EMP-ID TO DBV-EMP-ID.
|
||
MOVE R02EMP-NAME TO DBV-EMP-NAME.
|
||
MOVE R02DEPT-CODE TO DBV-DEPT-CODE.
|
||
MOVE R02REGION-CODE TO DBV-REGION-CODE.
|
||
MOVE R02CATEGORY-CODE TO DBV-CATEGORY-CODE.
|
||
MOVE R02BASE-SALARY TO DBV-BASE-SALARY.
|
||
MOVE R02HOURLY-RATE TO DBV-HOURLY-RATE.
|
||
MOVE R02DEPENDENT-COUNT TO DBV-DEPENDENT-COUNT.
|
||
MOVE R02STATUS TO DBV-STATUS.
|
||
*
|
||
*** INSERT試行
|
||
EXEC SQL
|
||
INSERT INTO EMP-MASTER
|
||
(EMP-ID, EMP-NAME, DEPT-CODE,
|
||
REGION-CODE, CATEGORY-CODE,
|
||
BASE-SALARY, HOURLY-RATE,
|
||
DEPENDENT-COUNT, STATUS,
|
||
UPDATED-AT)
|
||
VALUES
|
||
(:DBV-EMP-ID, :DBV-EMP-NAME, :DBV-DEPT-CODE,
|
||
:DBV-REGION-CODE, :DBV-CATEGORY-CODE,
|
||
:DBV-BASE-SALARY, :DBV-HOURLY-RATE,
|
||
:DBV-DEPENDENT-COUNT, :DBV-STATUS,
|
||
CURRENT TIMESTAMP)
|
||
END-EXEC.
|
||
*
|
||
IF SQLCODE = 0
|
||
ADD 1 TO CUN-DB-INS
|
||
PERFORM 1100R02INNSOR
|
||
EXIT SECTION
|
||
END-IF.
|
||
*
|
||
*** -803 = 重複 → UPDATE
|
||
IF SQLCODE = -803
|
||
EXEC SQL
|
||
UPDATE EMP-MASTER SET
|
||
EMP-NAME = :DBV-EMP-NAME
|
||
,DEPT-CODE = :DBV-DEPT-CODE
|
||
,REGION-CODE = :DBV-REGION-CODE
|
||
,CATEGORY-CODE = :DBV-CATEGORY-CODE
|
||
,BASE-SALARY = :DBV-BASE-SALARY
|
||
,HOURLY-RATE = :DBV-HOURLY-RATE
|
||
,DEPENDENT-COUNT = :DBV-DEPENDENT-COUNT
|
||
,STATUS = :DBV-STATUS
|
||
,UPDATED-AT = CURRENT TIMESTAMP
|
||
WHERE EMP-ID = :DBV-EMP-ID
|
||
END-EXEC
|
||
IF SQLCODE = 0
|
||
ADD 1 TO CUN-DB-UPD
|
||
ELSE
|
||
PERFORM 2100ERROUTSOR
|
||
END-IF
|
||
PERFORM 1100R02INNSOR
|
||
EXIT SECTION
|
||
END-IF.
|
||
*
|
||
*** その他SQLエラー
|
||
PERFORM 2100ERROUTSOR.
|
||
PERFORM 1100R02INNSOR.
|
||
*
|
||
2000MAJSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (2.1) *
|
||
* サブモジュール名: エラー出力処理 *
|
||
*****************************************************************
|
||
2100ERROUTSOR SECTION.
|
||
*
|
||
MOVE 'DB-ERR' TO W03ERR-CATEGORY.
|
||
MOVE DBV-EMP-ID TO W03ERR-DETAIL.
|
||
WRITE W03OUTREC.
|
||
ADD 1 TO CUN-W03OUT.
|
||
*
|
||
2100ERROUTSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (3.0) *
|
||
* サブモジュール名: 終了処理 *
|
||
*****************************************************************
|
||
3000STPSOR SECTION.
|
||
*
|
||
CLOSE R02INNFIL
|
||
W03OUTFIL.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||
MOVE 'KYU02R02' TO M00UMKDATS22-01.
|
||
MOVE CUN-R02INN TO M00UMKDATS22-02.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||
MOVE 'DB-INSERT' TO M00UMKDATS22-01.
|
||
MOVE CUN-DB-INS TO M00UMKDATS22-02.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||
MOVE 'DB-UPDATE' TO M00UMKDATS22-01.
|
||
MOVE CUN-DB-UPD TO M00UMKDATS22-02.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||
MOVE 'KYU02W03' TO M00UMKDATS22-01.
|
||
MOVE CUN-W03OUT TO M00UMKDATS22-02.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
INITIALIZE M00MHOPAR.
|
||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||
PERFORM 4000MSGOUTSOR.
|
||
*
|
||
3000STPSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (4.0) *
|
||
* サブモジュール名: メッセージ出力処理 *
|
||
*****************************************************************
|
||
4000MSGOUTSOR SECTION.
|
||
*
|
||
MOVE CNS-KN0002 TO M00UMKDATS22-03(1:1).
|
||
MOVE CNS-KN0002 TO M00UMKDATS22-04(1:1).
|
||
MOVE CNS-PRGIDX TO M00UMKDATS22-05.
|
||
CALL 'SUB02MSG' USING M00MHOPAR.
|
||
*
|
||
4000MSGOUTSOR-EXT.
|
||
EXIT.
|
||
*
|
||
*****************************************************************
|
||
* サブモジュールNO: (9.9) *
|
||
* サブモジュール名: ABEND処理 *
|
||
*****************************************************************
|
||
9999ABDSOR SECTION.
|
||
*
|
||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||
CALL 'SUB03END' USING E01ABDPAR.
|
||
*
|
||
9999ABDSOR-EXT.
|
||
EXIT.
|