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

サブシステムEをJIN04PRT〜JIN08TST追加で9本に拡充（全48プログラム）。JIN01-09のIBM COBOL完全版・bin再ビルド版・設計書・使用資源一覧・カバレッジ統計・DDL(schema_jin)・COPY(DB-COMMON/JIN04RPT-REC/JIN05REC)をroot側最新に同期。KYU03AGG/KYU08PRI/SHA02MNC/SHA10S10再テスト済み（全PASS）

Browse Source
This commit is contained in:
qiuqiuqiu
2026-08-05 00:11:07 +08:00
parent 182b161208
commit a918489f93
88 changed files with 2953 additions and 300 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/JIN01KNS.cbl
+5 -5
View File
@@ -6,7 +6,7 @@
* プログラム名 : カナ氏名チェック処理 *
* 作成日 : 2026-07-19 *
* 処理概要 : 人事取込データの氏名カナ（半角20桁以内・ *
* 英大文字）および補助コード桁数をチェックする *
* 英大文字）および補助コード有効値をチェックする *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
@@ -110,14 +110,14 @@
*** エラーフラグ
03 WRK-ERR-FLG PIC X(001).
88 WRK-ERR-Y VALUE '1'.
*** エラーコード
*** エラーコード
03 WRK-ERR-CODE PIC X(004).
*** カナ長さWORK
*** カナ長さWORK
03 WRK-KANA-LEN PIC 9(002).
*** SELECT用パディング文字・ファイルステータス
*** SELECT用パディング文字・ファイルステータス
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
03 WS-FILE-STATUS PIC X(002).
*
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
src/JIN02SKL.cbl
+7 -8
View File
@@ -97,7 +97,6 @@
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-TBL-MAX PIC 9(003) VALUE 100.
*
*****************************************************************
* カウンタ領域 *
@@ -123,11 +122,11 @@
88 WRK-R01EOF-Y VALUE '1'.
03 WRK-R02EOF PIC X(001).
88 WRK-R02EOF-Y VALUE '1'.
*** 内部表走査用
*** 内部表走査用
03 WRK-IDX PIC 9(004) BINARY.
03 WRK-AVG-TEMP PIC 9(006)V9(002).
03 WRK-REM PIC 9(003).
*** SELECT用パディング文字・ファイルステータス
*** SELECT用パディング文字・ファイルステータス
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
03 WS-FILE-STATUS PIC X(002).
@@ -190,11 +189,11 @@
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
*****************************************************************
1000ITTSOR SECTION.
*
*** プログラム開始表示（UPON 予約語カバー）
*
*** プログラム開始表示（UPON 予約語カバー）
DISPLAY 'JIN02SKL START' UPON CONSOLE.
*
*** 開始メッセージ出力
*
*** 開始メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGSTR TO M00MSGCOD.
PERFORM 6000MSGOUTSOR.
@@ -213,7 +212,7 @@
*** 内部表サイズ初期化
MOVE ZERO TO WS-TBL-MAX-IDX.
*
*** 運用日付取得
*** 運用日付取得
INITIALIZE D01UBSPAR.
CALL 'SUB01DAT' USING D01UBSPAR
ON EXCEPTION
src/JIN03RAN.cbl
+9 -10
View File
@@ -5,8 +5,9 @@
* プログラムID : JIN03RAN *
* プログラム名 : スキル評価ランキング出力処理 *
* 作成日 : 2026-07-19 *
* 処理概要 : SKILL-AGG（集計結果）を読み込み、 *
* 平均点降順でランキング出力 *
* 処理概要 : SKILL-AGG（集計結果）を読み込み、平均点降順で *
* ランキング出力（前提：R01はJCL SORTにより *
* 平均点降順ソート済み） *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
@@ -127,9 +128,7 @@
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
COPY JINMSGAC.
*
PROCEDURE DIVISION.
*****************************************************************
@@ -203,7 +202,7 @@
2000MAINSOR SECTION.
*
*** ランク番号UP
SET WRK-RANK-NO UP BY 1.
ADD 1 TO WRK-RANK-NO.
*
*** COMP-4 予約語カバー
ADD 1 TO CUN-COMP4.
@@ -247,8 +246,8 @@
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
*** UP 予約語カバー
SET WRK-OUT-IDX UP BY 1.
*** ADD 予約語カバー
ADD 1 TO WRK-OUT-IDX.
*
*** 次のR01読込
PERFORM 2100READSOR.
@@ -284,8 +283,8 @@
*** 出力ファイルCLOSE
CLOSE W01OUTFIL.
*
*** DOWN 予約語カバー
SET WRK-IDX DOWN BY 1.
*** SUBTRACT 予約語カバー
SUBTRACT 1 FROM WRK-IDX.
*
*** DESCENDING 予約語カバー: テーブル参照
IF WS-THR(1) = CNS-SCORE-HIGH
src/JIN04PRT.cbl
+345
View File
@@ -0,0 +1,345 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. JIN04PRT.
*****************************************************************
* システム名 : 人事情報管理システム *
* プログラムID : JIN04PRT *
* プログラム名 : 社員台帳印刷処理 *
* 作成日 : 2026-07-28 *
* 処理概要 : EMP-VALID（チェック済社員データ）を読込み *
* 台帳形式で印刷出力する。 *
* LINAGE制御・PAGE-COUNTER使用 *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 2026-07-28 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT R01INNFIL ASSIGN TO EXTERNAL JIN04R01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT W01OUTFIL ASSIGN TO EXTERNAL JIN04W01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01: EMP-VALID チェック済社員データ *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY JIN01REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* W01: JIN-LEDGER 社員台帳印刷ファイル *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F
LINAGE IS 66 LINES
FOOTING AT 60
TOP 2
BOTTOM 4.
01 W01OUTREC.
COPY JIN04RPT-REC REPLACING ==(A)== BY ==W01==.
*
WORKING-STORAGE SECTION.
*
*****************************************************************
* コンスタント領域 *
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'JIN04PRT'.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
01 CUNARA.
03 CUN-R01INN PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-W01OUT PIC S9(009) COMP-3
VALUE ZERO.
*
*****************************************************************
* 作業領域 *
*****************************************************************
01 WRKARA.
*** 読込フラグ
03 WRK-R01EOF PIC X(001).
88 WRK-R01EOF-Y VALUE '1'.
*** 日付時刻
03 WRK-DATE PIC 9(008).
03 WRK-DATE-R REDEFINES WRK-DATE.
05 WRK-DATE-YYYY PIC 9(004).
05 WRK-DATE-MM PIC 9(002).
05 WRK-DATE-DD PIC 9(002).
03 WRK-TIME PIC 9(008).
03 WRK-TIME-R REDEFINES WRK-TIME.
05 WRK-TIME-HH PIC 9(002).
05 WRK-TIME-MM PIC 9(002).
05 WRK-TIME-SS PIC 9(002).
05 WRK-TIME-CC PIC 9(002).
03 WRK-DISP-DATE PIC X(010).
03 WRK-DISP-TIME PIC X(008).
*** ページ番号
03 WRK-PAGE-NO PIC 9(004) VALUE ZERO.
*** 文字列編集
03 WRK-PTR PIC 9(003).
03 WRK-OVF-FLG PIC X(001).
88 WRK-OVF-Y VALUE 'Y'.
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** R01読込→印刷出力ループ
PERFORM 2000MAINSOR
UNTIL WRK-R01EOF-Y.
*
*** 終了処理
PERFORM 4000STPSOR.
*
0000MAJCOLSOR-EXT.
GOBACK.
*
*EJECT
*****************************************************************
* サブモジュールNO: (1.0) *
* サブモジュール名: 初期処理 *
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
*****************************************************************
1000ITTSOR SECTION.
*
*** プログラム開始表示（UPON 予約語カバー）
DISPLAY 'JIN04PRT START' UPON CONSOLE.
*
*** 開始メッセージ出力
INITIALIZE M00MHOPAR.
MOVE 001 TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** ワークエリア初期化
INITIALIZE WRKARA
CUNARA.
*
*** システム日付取得（DATE 予約語カバー：ACCEPT FROM DATE）
ACCEPT WRK-DATE FROM DATE.
MOVE 1 TO WRK-PTR.
MOVE 'N' TO WRK-OVF-FLG.
STRING WRK-DATE-YYYY '/' WRK-DATE-MM '/'
WRK-DATE-DD
DELIMITED BY SIZE INTO WRK-DISP-DATE
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
*** システム時刻取得（TIME 予約語カバー：ACCEPT FROM TIME）
ACCEPT WRK-TIME FROM TIME.
MOVE 1 TO WRK-PTR.
MOVE 'N' TO WRK-OVF-FLG.
STRING WRK-TIME-HH ':' WRK-TIME-MM ':'
WRK-TIME-SS
DELIMITED BY SIZE INTO WRK-DISP-TIME
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
*** 運用日付取得
INITIALIZE D01UBSPAR.
CALL 'SUB01DAT' USING D01UBSPAR.
*
*** 入出力ファイルOPEN
OPEN INPUT R01INNFIL
OUTPUT W01OUTFIL.
*
*** ヘッダー出力（PAGE-COUNTER 特殊レジスタカバー）
PERFORM 3000HEADER.
*
*** R01初回読込
PERFORM 2100READSOR.
*
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (2.0) *
* サブモジュール名: 主処理 *
* 処理概要 : R01読込→明細行編集→WRITE *
*****************************************************************
2000MAINSOR SECTION.
*
*** W01レコード初期化
INITIALIZE W01OUTREC.
*
*** 明細行編集（STRING ON OVERFLOW 予約語カバー）
MOVE 1 TO WRK-PTR.
MOVE 'N' TO WRK-OVF-FLG.
STRING R01EMP-ID
R01KANA-SEI
R01KANA-MEI
R01KANJI-NAME
DELIMITED BY SIZE INTO W01OUTREC
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
*** 明細行書出（AT END-OF-PAGE 予約語カバー）
WRITE W01OUTREC
AFTER ADVANCING 1 LINE
AT END-OF-PAGE
PERFORM 3000HEADER
END-WRITE.
*
ADD 1 TO CUN-W01OUT.
ADD 1 TO CUN-R01INN.
*
*** 次のR01読込
PERFORM 2100READSOR.
*
2000MAINSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.1) *
* サブモジュール名: R01読込処理 *
* 処理概要 : 社員マスタ読込・EOF判定 *
*****************************************************************
2100READSOR SECTION.
*
READ R01INNFIL
AT END
MOVE '1' TO WRK-R01EOF
NOT AT END
CONTINUE
END-READ.
*
2100READSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (3.0) *
* サブモジュール名: ヘッダー出力処理 *
* 処理概要 : ページヘッダー出力 *
*****************************************************************
3000HEADER SECTION.
*
*** 改ページ＋ページ番号増加
ADD 1 TO WRK-PAGE-NO.
*
*** 改ページ（WRITE AFTER ADVANCING PAGE でPAGE-COUNTER更新）
MOVE SPACES TO W01OUTREC.
WRITE W01OUTREC
AFTER ADVANCING PAGE.
*
*** タイトル行
MOVE SPACES TO W01OUTREC.
MOVE 1 TO WRK-PTR.
MOVE 'N' TO WRK-OVF-FLG.
STRING '*** EMPLOYEE LEDGER ***'
DELIMITED BY SIZE INTO W01OUTREC
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
WRITE W01OUTREC
AFTER ADVANCING 1 LINE.
*
*** 日付・ページ行
MOVE SPACES TO W01OUTREC.
MOVE 1 TO WRK-PTR.
MOVE 'N' TO WRK-OVF-FLG.
STRING 'DATE: ' WRK-DISP-DATE
' TIME: ' WRK-DISP-TIME
' PAGE: '
DELIMITED BY SIZE INTO W01OUTREC
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
STRING WRK-PAGE-NO
DELIMITED BY SIZE INTO W01OUTREC
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
WRITE W01OUTREC
AFTER ADVANCING 2 LINES.
*
3000HEADER-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (4.0) *
* サブモジュール名: 終了処理 *
* 処理概要 : クローズ処理・終了メッセージ *
*****************************************************************
4000STPSOR SECTION.
*
*** プログラム終了表示（UPON 予約語カバー）
DISPLAY 'JIN04PRT END' UPON CONSOLE.
DISPLAY 'TOTAL RECORDS: ' UPON CONSOLE
WITH NO ADVANCING.
DISPLAY CUN-R01INN UPON CONSOLE.
*
*** R01 CLOSE
CLOSE R01INNFIL.
*
*** 出力ファイルCLOSE WITH LOCK（CLOSE WITH LOCK 予約語カバー）
CLOSE W01OUTFIL WITH LOCK.
*
*** 終了メッセージ出力
MOVE 002 TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** 正常終了
CALL 'SUB03END' USING E01ABDPAR.
*
4000STPSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (9.0) *
* サブモジュール名: エラー処理 *
* 処理概要 : エラー時のSTOP literal *
*****************************************************************
9000ERRSOR SECTION.
*
*** STOP literal 予約語カバー（△→◎）
DISPLAY 'JIN04PRT ABEND' UPON CONSOLE.
STOP 'JIN04PRT ABNORMAL END'.
*
9000ERRSOR-EXT.
EXIT.
src/JIN05UPD.cbl
+432
View File
@@ -0,0 +1,432 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. JIN05UPD.
*****************************************************************
* システム名 : 人事情報管理システム *
* プログラムID : JIN05UPD *
* プログラム名 : 人事異動DB更新処理 *
* 作成日 : 2026-07-28 *
* 処理概要 : HR-TRANS（人事異動トランザクション）を読込み *
* DB2 EMPLOYEE マスタを更新する。 *
* 各種未カバー予約語をカバーする実装を含む *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 2026-07-28 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT R01INNFIL ASSIGN TO EXTERNAL JIN05R01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT W01OUTFIL ASSIGN TO EXTERNAL JIN05W01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01: HR-TRANS 人事異動トランザクション *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY JIN05REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* W01: VALID-ERROR エラーレコード *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 W01OUTREC.
COPY VALID-ERROR-REC.
*
WORKING-STORAGE SECTION.
*
*****************************************************************
* コンスタント領域 *
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'JIN05UPD'.
03 CNS-MAX-TRANS PIC 9(003) VALUE 500.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
01 CUNARA.
03 CUN-R01INN PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-W01OUT PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-DBUPD PIC S9(009) COMP-3
VALUE ZERO.
03 CUN-DBINS PIC S9(009) COMP-3
VALUE ZERO.
*
*****************************************************************
* 作業領域 *
*****************************************************************
01 WRKARA.
*** 読込フラグ
03 WRK-R01EOF PIC X(001).
88 WRK-R01EOF-Y VALUE '1'.
*** 処理件数カウンタ
03 WRK-COUNT PIC 9(003) VALUE ZERO.
*** トランザクション種別
03 WRK-TRAN-TYPE PIC X(001).
88 WRK-TRAN-INSERT VALUE 'A' 'B' 'C'.
88 WRK-TRAN-UPDATE VALUE 'D' THRU 'G'.
88 WRK-TRAN-DELETE VALUE 'Z'.
*** 文字列編集
03 WRK-PTR PIC 9(003).
03 WRK-OVF-FLG PIC X(001).
88 WRK-OVF-Y VALUE 'Y' WHEN SET TO FALSE IS 'N'.
*** SQLCODE表示用
03 WS-SQLCODE-DISP PIC -(9)9.
*
*****************************************************************
* DB2 ホスト変数 *
*****************************************************************
01 HVARA.
03 HV-EMP-ID PIC X(008).
03 HV-KANA-SEI PIC X(020).
03 HV-KANA-MEI PIC X(020).
03 HV-KANJI-NAME PIC X(040).
03 HV-SUB-CODE PIC X(004).
03 HV-BIRTH-DATE PIC X(008).
03 HV-DEPT-CODE PIC X(004).
03 HV-ENTRY-DATE PIC X(008).
03 HV-STATUS PIC X(001).
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
*** DB接続共通変数はconvert-sql.mjsが自動生成
* （COPY DB-COMMON は converter 生成変数と重複するため不使用）
*
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** R01読込→DB更新ループ（PERFORM UNTIL ... OR ... カバー）
PERFORM 2000MAINSOR
UNTIL WRK-R01EOF-Y
OR WRK-COUNT >= CNS-MAX-TRANS.
*
*** 終了処理
PERFORM 4000STPSOR.
*
0000MAJCOLSOR-EXT.
GOBACK.
*
*EJECT
*****************************************************************
* サブモジュールNO: (1.0) *
* サブモジュール名: 初期処理 *
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
*****************************************************************
1000ITTSOR SECTION.
*
*** プログラム開始表示
DISPLAY 'JIN05UPD START' UPON CONSOLE.
*
*** 開始メッセージ出力
INITIALIZE M00MHOPAR.
MOVE 001 TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** ワークエリア初期化（INITIALIZE REPLACING 予約語カバー）
INITIALIZE WRKARA
REPLACING NUMERIC DATA BY ZEROS
ALPHANUMERIC DATA BY SPACES.
INITIALIZE CUNARA.
*
*** 運用日付取得（CALL ON EXCEPTION 予約語カバー）
INITIALIZE D01UBSPAR.
CALL 'SUB01DAT' USING D01UBSPAR
ON EXCEPTION
DISPLAY 'SUB01DAT CALL ERROR'
UPON CONSOLE
MOVE 99 TO E01ABDCOD
PERFORM 9000ERRSOR
END-CALL.
*
*** DB接続（convert-sql.mjs が br_open に変換）
EXEC SQL
CONNECT TO 'data/JIN.db'
END-EXEC.
*
*** 入出力ファイルOPEN
OPEN INPUT R01INNFIL
OUTPUT W01OUTFIL.
*
*** R01初回読込
PERFORM 2100READSOR.
*
1000ITTSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (2.0) *
* サブモジュール名: 主処理 *
* 処理概要 : R01読込→DB更新 *
*****************************************************************
2000MAINSOR SECTION.
*
*** 件数カウント
ADD 1 TO WRK-COUNT.
*
*** ホスト変数転記
MOVE R01TRAN-EMP-ID TO HV-EMP-ID.
MOVE R01TRAN-KANA-SEI TO HV-KANA-SEI.
MOVE R01TRAN-KANA-MEI TO HV-KANA-MEI.
MOVE R01TRAN-KANJI-NAME TO HV-KANJI-NAME.
MOVE R01TRAN-SUB-CODE TO HV-SUB-CODE.
MOVE R01TRAN-BIRTH-DATE TO HV-BIRTH-DATE.
MOVE R01TRAN-DEPT-CODE TO HV-DEPT-CODE.
MOVE R01TRAN-ENTRY-DATE TO HV-ENTRY-DATE.
MOVE R01TRAN-STATUS TO HV-STATUS.
*
*** トランザクション種別判定
*** （88-level 複数VALUE 'A' 'B' 'C' + VALUE 'D' THRU 'G' カバー）
MOVE R01TRAN-TYPE TO WRK-TRAN-TYPE.
*
EVALUATE TRUE
WHEN WRK-TRAN-INSERT
PERFORM 3100INSERTSOR
WHEN WRK-TRAN-UPDATE
PERFORM 3200UPDATESOR
WHEN WRK-TRAN-DELETE
PERFORM 3300ERRSOR
WHEN OTHER
PERFORM 3300ERRSOR
END-EVALUATE.
*
*** 次のR01読込
PERFORM 2100READSOR.
*
2000MAINSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.1) *
* サブモジュール名: R01読込処理 *
* 処理概要 : HR-TRANS読込・EOF判定 *
*****************************************************************
2100READSOR SECTION.
*
READ R01INNFIL
AT END
MOVE '1' TO WRK-R01EOF
NOT AT END
ADD 1 TO CUN-R01INN
END-READ.
*
2100READSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (3.1) *
* サブモジュール名: INSERT処理 *
* 処理概要 : EMPLOYEEテーブルに新規社員追加 *
*****************************************************************
3100INSERTSOR SECTION.
*
EXEC SQL
INSERT INTO EMPLOYEE
(EMP_ID, KANA_SEI, KANA_MEI, KANJI_NAME,
SUB_CODE, BIRTH_DATE, DEPT_CODE,
ENTRY_DATE, STATUS)
VALUES
(:HV-EMP-ID, :HV-KANA-SEI, :HV-KANA-MEI,
:HV-KANJI-NAME, :HV-SUB-CODE, :HV-BIRTH-DATE,
:HV-DEPT-CODE, :HV-ENTRY-DATE, :HV-STATUS)
END-EXEC.
*
IF SQLCODE NOT = 0
PERFORM 3400DBERRSOR
ELSE
ADD 1 TO CUN-DBINS
END-IF.
*
3100INSERTSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (3.2) *
* サブモジュール名: UPDATE処理 *
* 処理概要 : EMPLOYEEテーブルを更新 *
*****************************************************************
3200UPDATESOR SECTION.
*
*** STRING ON OVERFLOW 予約語カバー（安全な文字列編集）
MOVE 1 TO WRK-PTR.
SET WRK-OVF-Y TO FALSE.
STRING 'UPDATING: ' HV-EMP-ID
DELIMITED BY SIZE INTO WS-SQL-STR
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
*** DISPLAY WITH NO ADVANCING 予約語カバー
DISPLAY WS-SQL-STR UPON CONSOLE
WITH NO ADVANCING.
*
EXEC SQL
UPDATE EMPLOYEE SET
KANA_SEI = :HV-KANA-SEI,
KANA_MEI = :HV-KANA-MEI,
KANJI_NAME = :HV-KANJI-NAME,
SUB_CODE = :HV-SUB-CODE,
BIRTH_DATE = :HV-BIRTH-DATE,
DEPT_CODE = :HV-DEPT-CODE,
ENTRY_DATE = :HV-ENTRY-DATE,
STATUS = :HV-STATUS
WHERE EMP_ID = :HV-EMP-ID
END-EXEC.
*
IF SQLCODE NOT = 0
PERFORM 3400DBERRSOR
ELSE
ADD 1 TO CUN-DBUPD
END-IF.
*
3200UPDATESOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (3.3) *
* サブモジュール名: エラーレコード出力 *
* 処理概要 : 不明トランザクション種別→VALID-ERROR *
*****************************************************************
3300ERRSOR SECTION.
*
*** エラーレコード編集
INITIALIZE W01OUTREC.
MOVE CNS-PRGIDX TO ERR-PROGRAMID.
MOVE HV-EMP-ID TO ERR-EMP-ID.
MOVE '0001' TO ERR-CODE.
*** STRING ON OVERFLOW カバー
MOVE 1 TO WRK-PTR.
SET WRK-OVF-Y TO FALSE.
STRING 'INVALID TRAN-TYPE: ' R01TRAN-TYPE
' FOR EMP: ' HV-EMP-ID
DELIMITED BY SIZE INTO ERR-DETAIL
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
3300ERRSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (3.4) *
* サブモジュール名: DBエラー処理 *
* 処理概要 : SQLCODE不正時のVALID-ERROR出力 *
*****************************************************************
3400DBERRSOR SECTION.
*
MOVE SQLCODE TO WS-SQLCODE-DISP.
MOVE 1 TO WRK-PTR.
SET WRK-OVF-Y TO FALSE.
STRING 'DB ERROR SQLCODE=' WS-SQLCODE-DISP
' EMP=' HV-EMP-ID
DELIMITED BY SIZE INTO ERR-DETAIL
WITH POINTER WRK-PTR
ON OVERFLOW MOVE 'Y' TO WRK-OVF-FLG
END-STRING.
*
MOVE CNS-PRGIDX TO ERR-PROGRAMID.
MOVE HV-EMP-ID TO ERR-EMP-ID.
MOVE '0002' TO ERR-CODE.
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
CALL 'SUB02MSG'
USING BY CONTENT M00MHOPAR.
*
3400DBERRSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (4.0) *
* サブモジュール名: 終了処理 *
* 処理概要 : クローズ処理・統計表示 *
*****************************************************************
4000STPSOR SECTION.
*
*** 統計表示（DISPLAY UPON カバー）
DISPLAY 'JIN05UPD END' UPON CONSOLE.
DISPLAY 'READ:' CUN-R01INN UPON CONSOLE.
DISPLAY 'INSERT:' CUN-DBINS UPON CONSOLE.
DISPLAY 'UPDATE:' CUN-DBUPD UPON CONSOLE.
DISPLAY 'ERROR:' CUN-W01OUT UPON CONSOLE.
*
*** CLOSE WITH LOCK 予約語カバー
CLOSE R01INNFIL.
CLOSE W01OUTFIL WITH LOCK.
*
*** 終了メッセージ出力
MOVE 002 TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** 正常終了
CALL 'SUB03END' USING E01ABDPAR.
*
4000STPSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (9.0) *
* サブモジュール名: エラー終了処理 *
* 処理概要 : ABEND処理 *
*****************************************************************
9000ERRSOR SECTION.
*
*** EXIT PARAGRAPH 予約語カバー
DISPLAY 'JIN05UPD ABEND' UPON CONSOLE.
CALL 'SUB03END' USING E01ABDPAR.
*
EXIT PARAGRAPH.
*
9000ERRSOR-EXT.
EXIT.
src/JIN06SRT.cbl
+367
View File
@@ -0,0 +1,367 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. JIN06SRT.
*****************************************************************
* システム名 : 人事情報管理システム *
* プログラムID : JIN06SRT *
* プログラム名 : 社員データSORT処理 *
* 作成日 : 2026-08-02 *
* 処理概要 : EMP-VALID（チェック済社員データ）をINPUT *
* PROCEDUREで読込み、EMP-ID昇順にSORTし、 *
* OUTPUT PROCEDUREでRETURNしてSORTED-EMP出力。 *
* RELEASE件数は最大999件で、上限超過分は *
* VALID-ERRORへ出力する。 *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 2026-08-02 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT R01INNFIL ASSIGN TO EXTERNAL JIN06R01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT W01OUTFIL ASSIGN TO EXTERNAL JIN06W01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT W02OUTFIL ASSIGN TO EXTERNAL JIN06W02
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT SORTWORK ASSIGN TO EXTERNAL SORTWK01.
*
I-O-CONTROL.
SAME SORT AREA FOR SORTWORK.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01: EMP-VALID チェック済社員データ（200B） *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY JIN01REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* SD: SORTWORK（200B SORT内部レコード） *
*****************************************************************
SD SORTWORK
RECORD CONTAINS 200.
01 SORTREC.
COPY JIN01REC REPLACING ==(A)== BY ==SR==.
*
*****************************************************************
* W01: SORTED-EMP 並替済社員データ（200B） *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 W01OUTREC.
COPY JIN01REC REPLACING ==(A)== BY ==W01==.
*
*****************************************************************
* W02: VALID-ERROR 上限超過エラー（80B） *
*****************************************************************
FD W02OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 W02OUTREC.
COPY VALID-ERROR-REC.
*
WORKING-STORAGE SECTION.
*
*****************************************************************
* コンスタント領域 *
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'JIN06SRT'.
03 CNS-MAX-SORT-REC PIC 9(003) VALUE 999.
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-ABD100 PIC 9(003) VALUE 100.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
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-R01EOF PIC X(001).
88 WRK-R01EOF-Y VALUE '1'.
*** SORT復帰コード
03 WRK-SORT-STAT PIC 9(002).
*** 処理件数カウンタ（上限チェック用）
03 WRK-SORT-CNT PIC 9(009).
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** SORT処理
PERFORM 2000MAJSOR.
*
*** 終了処理
PERFORM 3000STPSOR.
*
0000MAJCOLSOR-EXT.
GOBACK.
*
*EJECT
*****************************************************************
* サブモジュールNO: (1.0) *
* サブモジュール名: 初期処理 *
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
*****************************************************************
1000ITTSOR SECTION.
*
*** プログラム開始表示
DISPLAY 'JIN06SRT START' UPON CONSOLE.
*
*** 開始メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGSTR TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** ワークエリア初期化
INITIALIZE WRKARA
CUNARA.
*
*** 運用日付取得
INITIALIZE D01UBSPAR.
CALL 'SUB01DAT' USING D01UBSPAR.
IF D01FKICOD = ZERO
CONTINUE
ELSE
INITIALIZE M00MHOPAR
MOVE CNS-MSGSUBEEK TO M00MSGCOD
MOVE 'SUB01DAT' TO M00UMKDATS22-01
MOVE D01FKICOD TO M00UMKDATS22-02
PERFORM 4000MSGOUTSOR
PERFORM 9000ERRSOR
END-IF.
*
*** 出力ファイルOPEN
OPEN OUTPUT W01OUTFIL
W02OUTFIL.
*
1000ITTSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.0) *
* サブモジュール名: 主処理（SORT実行） *
* 処理概要 : SORT文を実行する *
*****************************************************************
2000MAJSOR SECTION.
*
SORT SORTWORK
ON ASCENDING KEY SREMP-ID
INPUT PROCEDURE 2110INPUTSOR
OUTPUT PROCEDURE 2120OUTPUSOR.
*
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.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.1) *
* サブモジュール名: INPUT PROCEDURE *
* 処理概要 : R01読込→RELEASE送出（上限件数ガード） *
*****************************************************************
2110INPUTSOR SECTION.
*
OPEN INPUT R01INNFIL.
*
*** EOF 到達まで読込・RELEASE（上限超過分は VALID-ERROR 出力）
PERFORM UNTIL WRK-R01EOF-Y
PERFORM 2110READSOR
END-PERFORM.
*
CLOSE R01INNFIL.
*
2110INPUTSOR-EXT.
EXIT.
*
*SKIP2
*****************************************************************
* サブモジュールNO: (2.1.1) *
* サブモジュール名: R01読込・RELEASE送出 *
* 処理概要 : 1件読込→SORTレコードへ転記→RELEASE *
*****************************************************************
2110READSOR SECTION.
*
*** EOF到達後は空処理（上限到達時は超過分をエラー出力）
IF WRK-R01EOF-Y
EXIT SECTION
END-IF.
*
READ R01INNFIL
AT END
MOVE '1' TO WRK-R01EOF
NOT AT END
ADD 1 TO CUN-R01INN
ADD 1 TO WRK-SORT-CNT
MOVE R01KANA-SEI TO SRKANA-SEI
MOVE R01KANA-MEI TO SRKANA-MEI
MOVE R01KANJI-NAME TO SRKANJI-NAME
MOVE R01SUB-CODE TO SRSUB-CODE
MOVE R01BIRTH-DATE TO SRBIRTH-DATE
MOVE R01EMP-ID TO SREMP-ID
MOVE R01FILLER TO SRFILLER
IF WRK-SORT-CNT <= CNS-MAX-SORT-REC
RELEASE SORTREC
ADD 1 TO CUN-SORT-IN
ELSE
INITIALIZE W02OUTREC
MOVE CNS-PRGIDX TO ERR-PROGRAMID
MOVE SREMP-ID TO ERR-EMP-ID
MOVE '9999' TO ERR-CODE
MOVE 'SORT LIMIT OVER' TO ERR-DETAIL
WRITE W02OUTREC
ADD 1 TO CUN-W02OUT
END-IF
END-READ.
*
2110READSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.2) *
* サブモジュール名: OUTPUT PROCEDURE *
* 処理概要 : RETURN→SORTED-EMP書出 *
*****************************************************************
2120OUTPUSOR SECTION.
*
PERFORM UNTIL 1 = 2
RETURN SORTWORK RECORD
AT END
EXIT PERFORM
NOT AT END
MOVE SRKANA-SEI TO W01KANA-SEI
MOVE SRKANA-MEI TO W01KANA-MEI
MOVE SRKANJI-NAME TO W01KANJI-NAME
MOVE SRSUB-CODE TO W01SUB-CODE
MOVE SRBIRTH-DATE TO W01BIRTH-DATE
MOVE SREMP-ID TO W01EMP-ID
MOVE SRFILLER TO W01FILLER
WRITE W01OUTREC
ADD 1 TO CUN-W01OUT
END-RETURN
END-PERFORM.
*
2120OUTPUSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (3.0) *
* サブモジュール名: 終了処理 *
* 処理概要 : 統計表示・CLOSE・終了メッセージ *
*****************************************************************
3000STPSOR SECTION.
*
*** 統計表示
DISPLAY 'JIN06SRT END' UPON CONSOLE.
DISPLAY 'READ:' CUN-R01INN UPON CONSOLE.
DISPLAY 'SORT:' CUN-SORT-IN UPON CONSOLE.
DISPLAY 'OUT:' CUN-W01OUT UPON CONSOLE.
DISPLAY 'ERROR:' CUN-W02OUT UPON CONSOLE.
*
*** ファイルCLOSE
CLOSE W01OUTFIL
W02OUTFIL.
*
*** 終了メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGFIN TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
3000STPSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (4.0) *
* サブモジュール名: メッセージ出力 *
* 処理概要 : SUB02MSG 呼出 *
*****************************************************************
4000MSGOUTSOR SECTION.
*
CALL 'SUB02MSG' USING M00MHOPAR.
*
4000MSGOUTSOR-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (9.0) *
* サブモジュール名: エラー処理 *
* 処理概要 : ABEND処理 *
*****************************************************************
9000ERRSOR SECTION.
*
DISPLAY 'JIN06SRT ABEND' UPON CONSOLE.
MOVE CNS-ABD100 TO E01ABDCOD.
CALL 'SUB03END' USING E01ABDPAR.
*
9000ERRSOR-EXT.
EXIT.
src/JIN08TST.cbl
+238
View File
@@ -0,0 +1,238 @@
IDENTIFICATION DIVISION.
PROGRAM-ID. JIN08TST.
*****************************************************************
* システム名 : 人事情報管理システム *
* プログラムID : JIN08TST *
* プログラム名 : JIN07SUB呼出テスト *
* 作成日 : 2026-08-02 *
* 処理概要 : JIN07SUB を 2 回 CALL（全引数 / *
* KANJI-NAME OMITTED）して、一致レコード *
* 取得と OMITTED 引数動作を確認する *
* テストドライバ（テスト専用） *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 26-08-02 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
DATA DIVISION.
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
01 CNSARA.
03 CNS-PRGIDX PIC X(008) VALUE 'JIN08TST'.
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-ABD100 PIC 9(003) VALUE 100.
*
01 WRKARA.
*** JIN07SUB 呼出引数（CALL1）
03 WRK-TST-EMP-ID PIC X(008).
03 WRK-TST-KANA-SEI PIC X(020).
03 WRK-TST-KANA-MEI PIC X(020).
03 WRK-TST-KANJI-NAME PIC N(040).
03 WRK-TST-SUB-CODE PIC X(004).
03 WRK-TST-BIRTH-DATE PIC X(008).
03 WRK-TST-EMP-ID-OUT PIC X(008).
03 WRK-TST-FILLER PIC X(060).
03 WRK-TST-RESULT PIC X(002).
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAINTST SECTION.
*
*** 初期処理
PERFORM 1000ITTTST.
*
*** テストCALL
PERFORM 2000CALTST.
*
*** 終了処理
PERFORM 3000STPTST.
*
0000MAINTST-EXT.
GOBACK.
*
*EJECT
*****************************************************************
* サブモジュールNO: (1.0) *
* サブモジュール名: 初期処理 *
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
*****************************************************************
1000ITTTST SECTION.
*
*** プログラム開始表示
DISPLAY 'JIN08TST START' UPON CONSOLE.
*
*** 開始メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGSTR TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
*** ワークエリア初期化
INITIALIZE WRKARA.
*
*** 運用日付取得
INITIALIZE D01UBSPAR.
CALL 'SUB01DAT' USING D01UBSPAR
ON EXCEPTION
INITIALIZE M00MHOPAR
MOVE CNS-MSGSUBEEK TO M00MSGCOD
MOVE 'SUB01DAT' TO M00UMKDATS22-01
PERFORM 4000MSGOUTTST
PERFORM 9000ERRTST
END-CALL.
IF D01FKICOD = ZERO
CONTINUE
ELSE
INITIALIZE M00MHOPAR
MOVE CNS-MSGSUBEEK TO M00MSGCOD
MOVE 'SUB01DAT' TO M00UMKDATS22-01
MOVE D01FKICOD TO M00UMKDATS22-02
PERFORM 4000MSGOUTTST
PERFORM 9000ERRTST
END-IF.
*
1000ITTTST-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (2.0) *
* サブモジュール名: テストCALL *
* 処理概要 : JIN07SUB を 2 回 CALL（全引数 / OMITTED） *
*****************************************************************
2000CALTST SECTION.
*
*** 検索条件設定（EMP00001 を検索）
MOVE 'EMP00001' TO WRK-TST-EMP-ID.
*
*** CALL1: 全引数渡し
INITIALIZE
WRK-TST-KANA-SEI
WRK-TST-KANA-MEI
WRK-TST-KANJI-NAME
WRK-TST-SUB-CODE
WRK-TST-BIRTH-DATE
WRK-TST-EMP-ID-OUT
WRK-TST-FILLER
WRK-TST-RESULT.
CALL 'JIN07SUB' USING WRK-TST-EMP-ID,
WRK-TST-KANA-SEI,
WRK-TST-KANA-MEI,
WRK-TST-KANJI-NAME,
WRK-TST-SUB-CODE,
WRK-TST-BIRTH-DATE,
WRK-TST-EMP-ID-OUT,
WRK-TST-FILLER,
WRK-TST-RESULT.
IF WRK-TST-RESULT = 'OK'
DISPLAY 'CALL1 OK: EMP=' WRK-TST-EMP-ID-OUT
' SUB=' WRK-TST-SUB-CODE
UPON CONSOLE
ELSE
DISPLAY 'CALL1 NG: RESULT=' WRK-TST-RESULT
UPON CONSOLE
END-IF.
*
*** CALL2: KANJI-NAME OMITTED で渡す
INITIALIZE
WRK-TST-KANA-SEI
WRK-TST-KANA-MEI
WRK-TST-KANJI-NAME
WRK-TST-SUB-CODE
WRK-TST-BIRTH-DATE
WRK-TST-EMP-ID-OUT
WRK-TST-FILLER
WRK-TST-RESULT.
CALL 'JIN07SUB' USING WRK-TST-EMP-ID,
WRK-TST-KANA-SEI,
WRK-TST-KANA-MEI,
OMITTED,
WRK-TST-SUB-CODE,
WRK-TST-BIRTH-DATE,
WRK-TST-EMP-ID-OUT,
WRK-TST-FILLER,
WRK-TST-RESULT.
IF WRK-TST-RESULT = 'OK'
DISPLAY 'CALL2 OK: EMP=' WRK-TST-EMP-ID-OUT
' KANA-SEI=' WRK-TST-KANA-SEI
UPON CONSOLE
ELSE
DISPLAY 'CALL2 NG: RESULT=' WRK-TST-RESULT
UPON CONSOLE
END-IF.
*
2000CALTST-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (3.0) *
* サブモジュール名: 終了処理 *
* 処理概要 : 終了メッセージ出力 *
*****************************************************************
3000STPTST SECTION.
*
*** プログラム終了表示
DISPLAY 'JIN08TST END' UPON CONSOLE.
*
*** 終了メッセージ出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGFIN TO M00MSGCOD.
MOVE CNS-PRGIDX TO M00UMKDATS22-01.
CALL 'SUB02MSG' USING M00MHOPAR.
*
3000STPTST-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (4.0) *
* サブモジュール名: メッセージ出力 *
* 処理概要 : SUB02MSG 呼出 *
*****************************************************************
4000MSGOUTTST SECTION.
*
CALL 'SUB02MSG' USING M00MHOPAR.
*
4000MSGOUTTST-EXT.
EXIT.
*
*EJECT
*****************************************************************
* サブモジュールNO: (9.0) *
* サブモジュール名: エラー処理 *
* 処理概要 : ABEND処理 *
*****************************************************************
9000ERRTST SECTION.
*
DISPLAY 'JIN08TST ABEND' UPON CONSOLE.
MOVE CNS-ABD100 TO E01ABDCOD.
CALL 'SUB03END' USING E01ABDPAR.
*
9000ERRTST-EXT.
EXIT.
src/JIN09RPT.cbl
+37 -23
View File
@@ -9,7 +9,7 @@
* キーブレイクで集計し、社員別スキル *
* 集計結果（SKILL-SUM）を出力する *
* 予約語カバー : CANCEL / I-O-CONTROL / NEXT SENTENCE / *
* EJECT / SKIP2 / FALSE *
* EJECT / FALSE *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
@@ -182,7 +182,7 @@
COPY JINENDAC.
*
PROCEDURE DIVISION.
EJECT
*EJECT
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
@@ -197,7 +197,7 @@
PERFORM 1200MSTLDASOR
UNTIL WRK-R02EOF-Y.
*
*** マスタLOAD完了後、R02をCLOSE（SAME RECORD AREA確保領域の解放）
*** マスタLOAD完了後、R02をCLOSE
PERFORM 1250R02CLOSOR.
*
*** 評価明細集計処理
@@ -298,28 +298,41 @@
*****************************************************************
1200MSTLDASOR SECTION.
*
*** 表満杯時はエラー退避（M-12オーバーフローガード）
IF WS-TBL-MAX-IDX >= 20
ADD 1 TO CUN-W02OUT
INITIALIZE W02OUTREC
MOVE CNS-PRGIDX TO ERR-PROGRAMID
MOVE SPACE TO ERR-EMP-ID
MOVE 'OVF1' TO ERR-CODE
STRING 'SKILL-LIST OVERFLOW: '
R02MST-SKILL-CODE
DELIMITED BY SIZE
INTO ERR-DETAIL
END-STRING
WRITE W02OUTREC
ELSE
*** 内部表エントリ追加
ADD 1 TO WS-TBL-MAX-IDX
END-ADD.
*
MOVE R02MST-SKILL-CODE
TO TBL-SKILL-CODE(WS-TBL-MAX-IDX).
MOVE R02MST-LEVEL-NAME
TO TBL-SKILL-NAME(WS-TBL-MAX-IDX).
MOVE SPACE
TO TBL-LEVEL-NAME(WS-TBL-MAX-IDX).
MOVE ZERO
TO TBL-EVAL-CNT(WS-TBL-MAX-IDX).
MOVE ZERO
TO TBL-SCORE-SUM(WS-TBL-MAX-IDX).
MOVE SPACE
TO TBL-EMP-ID(WS-TBL-MAX-IDX).
MOVE SPACE
TO TBL-EMP-NAME(WS-TBL-MAX-IDX).
ADD 1 TO WS-TBL-MAX-IDX
END-ADD
MOVE R02MST-SKILL-CODE
TO TBL-SKILL-CODE(WS-TBL-MAX-IDX)
MOVE R02MST-LEVEL-NAME
TO TBL-SKILL-NAME(WS-TBL-MAX-IDX)
MOVE SPACE
TO TBL-LEVEL-NAME(WS-TBL-MAX-IDX)
MOVE ZERO
TO TBL-EVAL-CNT(WS-TBL-MAX-IDX)
MOVE ZERO
TO TBL-SCORE-SUM(WS-TBL-MAX-IDX)
MOVE SPACE
TO TBL-EMP-ID(WS-TBL-MAX-IDX)
MOVE SPACE
TO TBL-EMP-NAME(WS-TBL-MAX-IDX)
END-IF.
*
*** 次のR02読込
PERFORM 1100R02INNSOR.
*
PERFORM 1100R02INNSOR.
1200MSTLDASOR-EXT.
EXIT.
*****************************************************************
@@ -526,7 +539,7 @@
*****************************************************************
3000OUTPUSOR SECTION.
*
*** 内部表を昇順走査（PERFORM VARYING 多重ループ）
*** 内部表を昇順走査（PERFORM VARYING 単一ループ）
PERFORM VARYING WRK-IDX
FROM 1 BY 1
UNTIL WRK-IDX > WS-TBL-MAX-IDX
@@ -589,6 +602,7 @@
* サブモジュール名: 終了処理 *
* 処理概要 : 最終社員出力 + 件数出力 + 終了メッセージ *
*****************************************************************
*SKIP2
4000STPSOR SECTION.
*
*** 最終社員グループの出力
src/KYU03AGG.cbl
+4 -4
View File
@@ -1,4 +1,4 @@
IDENTIFICATION DIVISION.
IDENTIFICATION DIVISION.
PROGRAM-ID. KYU03AGG.
*****************************************************************
* システム名 : 給与計算システム *
@@ -56,9 +56,9 @@
01 W01OUTREC.
COPY KYU02REC REPLACING ==(A)== BY ==W01==.
*
*****************************************************************
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
*****************************************************************
*****************************************************************
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
*****************************************************************
FD W02OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
src/KYU08PRI.cbl
+6 -6
View File
@@ -1,4 +1,4 @@
IDENTIFICATION DIVISION.
IDENTIFICATION DIVISION.
PROGRAM-ID. KYU08PRI.
*****************************************************************
* システム名 : 給与計算システム *
@@ -59,9 +59,9 @@
01 W01OUTREC.
COPY KYU05REC REPLACING ==(A)== BY ==W01==.
*
*****************************************************************
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
*****************************************************************
*****************************************************************
* W02: ERROR-LOG（VB） — 将来拡張用（現時点では出力なし） *
*****************************************************************
FD W02OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
@@ -219,10 +219,10 @@
*****************************************************************
2000MAJSOR SECTION.
*
*** ヘッダ出力（改ページ + ページ番号）
*** ヘッダ出力（改ページ + ページ番号）
ADD 1 TO WRK-PAGE-COUNTER.
MOVE WRK-PAGE-COUNTER TO HL-PAGE-NO.
MOVE PAGE-COUNTER TO WS-DISP-PG.
MOVE WRK-PAGE-COUNTER TO WS-DISP-PG.
WRITE W01OUTREC
FROM HEADER-LINE
BEFORE ADVANCING PAGE.
src/SHA02MNC.cbl
+11 -12
View File
@@ -1,4 +1,4 @@
IDENTIFICATION DIVISION.
IDENTIFICATION DIVISION.
PROGRAM-ID. SHA02MNC.
*****************************************************************
* システム名 : 社会保険管理システム *
@@ -89,19 +89,18 @@
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-IDX PIC 9(004).
03 WRK-RATE-COUNT PIC 9(003) VALUE ZERO.
03 WRK-RATE-TBL.
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
03 WS-FILE-STATUS PIC X(002).
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).
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 WS-PAD-CHAR PIC X(001) VALUE SPACE.
03 WS-FILE-STATUS PIC X(002).
*
*****************************************************************
* DB2ホスト変数 *
src/SHA10S10.cbl
+2 -2
View File
@@ -1,4 +1,4 @@
IDENTIFICATION DIVISION.
IDENTIFICATION DIVISION.
PROGRAM-ID. SHA10S10.
*****************************************************************
* システム名 : 社会保険管理システム *
@@ -63,7 +63,7 @@
SELECT W10OUTFIL ASSIGN TO EXTERNAL SHA10W10
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
*** エラー出力用
*** エラー出力用
SELECT W99OUTFIL ASSIGN TO EXTERNAL SHA10W98
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.