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.