JIN09RPT 社員別スキル集計レポート処理を新規追加（SAME句削除版）。未カバー予約語6語（CANCEL/I-O-CONTROL/NEXT SENTENCE/EJECT/SKIP2/FALSE）をカバーし、カバレッジ×41→34に改善。全26テストPASS
This commit is contained in:
qiuqiuqiu
@@ -0,0 +1,664 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. JIN09RPT.
|
||||
*****************************************************************
|
||||
* システム名 : 人事情報管理システム *
|
||||
* プログラムID : JIN09RPT *
|
||||
* プログラム名 : 社員別スキル集計レポート処理 *
|
||||
* 作成日 : 2026-08-01 *
|
||||
* 処理概要 : SKILL-EVAL（M件, EMP-ID昇順）を社員 *
|
||||
* キーブレイクで集計し、社員別スキル *
|
||||
* 集計結果（SKILL-SUM）を出力する *
|
||||
* 予約語カバー : CANCEL / I-O-CONTROL / NEXT SENTENCE / *
|
||||
* EJECT / SKIP2 / FALSE *
|
||||
*****************************************************************
|
||||
* 更新履歴 *
|
||||
*---------------------------------------------------------------*
|
||||
* 更新日付 担当者 更新内容 *
|
||||
*---------------------------------------------------------------*
|
||||
* 2026-08-01 @@@ 新規作成 *
|
||||
* *
|
||||
*****************************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SOURCE-COMPUTER. IBM-ZSERIES.
|
||||
OBJECT-COMPUTER. IBM-ZSERIES.
|
||||
*
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT R01INNFIL ASSIGN TO EXTERNAL JIN09R01
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL
|
||||
PADDING CHARACTER IS WS-PAD-CHAR
|
||||
FILE STATUS IS WS-FILE-STATUS.
|
||||
SELECT R02INNFIL ASSIGN TO EXTERNAL JIN09R02
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL
|
||||
PADDING CHARACTER IS WS-PAD-CHAR
|
||||
FILE STATUS IS WS-FILE-STATUS.
|
||||
SELECT W01OUTFIL ASSIGN TO EXTERNAL JIN09W01
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL.
|
||||
SELECT W02OUTFIL ASSIGN TO EXTERNAL JIN09W02
|
||||
ORGANIZATION IS SEQUENTIAL
|
||||
ACCESS MODE IS SEQUENTIAL.
|
||||
*
|
||||
I-O-CONTROL.
|
||||
*
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
*
|
||||
*****************************************************************
|
||||
* R01: SKILL-EVAL スキル評価明細 (EMP-ID昇順) *
|
||||
*****************************************************************
|
||||
FD R01INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R01INNREC.
|
||||
COPY SKILL-EVAL-REC REPLACING ==(A)== BY ==R01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* R02: SKILL-MST スキル評価基準マスタ *
|
||||
*****************************************************************
|
||||
FD R02INNFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 R02INNREC.
|
||||
COPY SKILL-MST-REC REPLACING ==(A)== BY ==R02==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W01: SKILL-SUM 社員別スキル集計結果 *
|
||||
*****************************************************************
|
||||
FD W01OUTFIL
|
||||
LABEL RECORD IS STANDARD
|
||||
BLOCK CONTAINS 0
|
||||
RECORDING MODE IS F.
|
||||
01 W01OUTREC.
|
||||
COPY JIN09REC REPLACING ==(A)== BY ==W01==.
|
||||
*
|
||||
*****************************************************************
|
||||
* W02: VALID-ERROR エラーレコード *
|
||||
*****************************************************************
|
||||
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 'JIN09RPT'.
|
||||
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-TBL-MAX PIC 9(003) VALUE 20.
|
||||
03 CNS-SCORE-S PIC 9(003) VALUE 90.
|
||||
03 CNS-SCORE-A PIC 9(003) VALUE 80.
|
||||
03 CNS-SCORE-B PIC 9(003) VALUE 50.
|
||||
03 CNS-SCORE-C PIC 9(003) VALUE 1.
|
||||
03 CNS-LVLS PIC X(002) VALUE 'S'.
|
||||
03 CNS-LVLA PIC X(002) VALUE 'A'.
|
||||
03 CNS-LVLB PIC X(002) VALUE 'B'.
|
||||
03 CNS-LVLC PIC X(002) VALUE 'C'.
|
||||
03 CNS-LVLX PIC X(002) VALUE 'X'.
|
||||
*
|
||||
*****************************************************************
|
||||
* カウンタ領域 *
|
||||
*****************************************************************
|
||||
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-U06 PIC 9(008).
|
||||
*** 読込フラグ
|
||||
03 WRK-R01EOF PIC X(001).
|
||||
88 WRK-R01EOF-Y VALUE '1'.
|
||||
03 WRK-R02EOF PIC X(001).
|
||||
88 WRK-R02EOF-Y VALUE '1'.
|
||||
*** 社員キーブレイク用
|
||||
03 WRK-PREV-EMP-ID PIC X(008).
|
||||
03 WRK-FIRST-FLG PIC X(001).
|
||||
88 WRK-FIRST-FLG-Y VALUE 'Y' FALSE 'N'.
|
||||
*** レベル判定結果
|
||||
03 WRK-LEVEL PIC X(002).
|
||||
*** 社員別明細総数
|
||||
03 WRK-EMP-EVAL-CNT PIC 9(003).
|
||||
*** 内部表走査用
|
||||
03 WRK-IDX PIC 9(004) BINARY.
|
||||
*** 平均点算出用
|
||||
03 WRK-AVG-TEMP PIC 9(006)V9(002).
|
||||
03 WRK-REM PIC 9(003).
|
||||
*** SELECT用パディング文字・ファイルステータス
|
||||
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
|
||||
03 WS-FILE-STATUS PIC X(002).
|
||||
*
|
||||
*****************************************************************
|
||||
* 内部表: スキル別評価集計用（MSTデータは全社員共通で保持） *
|
||||
*****************************************************************
|
||||
01 WS-SKILL-TABLE.
|
||||
03 WS-TBL-ENTRY OCCURS 1 TO 20
|
||||
DEPENDING ON WS-TBL-MAX-IDX
|
||||
ASCENDING KEY IS TBL-SKILL-CODE
|
||||
INDEXED BY WS-TBL-IDX.
|
||||
05 TBL-SKILL-CODE PIC X(004).
|
||||
05 TBL-SKILL-NAME PIC X(020).
|
||||
05 TBL-LEVEL-NAME PIC X(002).
|
||||
05 TBL-EVAL-CNT PIC 9(003) BINARY.
|
||||
05 TBL-SCORE-SUM PIC 9(005) BINARY.
|
||||
05 TBL-EMP-ID PIC X(008).
|
||||
05 TBL-EMP-NAME PIC X(040).
|
||||
01 WS-TBL-MAX-IDX PIC 9(004) BINARY.
|
||||
*
|
||||
*****************************************************************
|
||||
* サブプログラム連絡領域 *
|
||||
*****************************************************************
|
||||
*** 運用日付取得
|
||||
COPY JINDATAC.
|
||||
*** メッセージ編集出力SR用
|
||||
COPY JINMSGAC.
|
||||
*** ABEND処理SR用
|
||||
COPY JINENDAC.
|
||||
*
|
||||
PROCEDURE DIVISION.
|
||||
EJECT
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (0.0) *
|
||||
* サブモジュール名: 制御処理 *
|
||||
* 処理概要 : メインコントロール処理 *
|
||||
*****************************************************************
|
||||
0000MAJCOLSOR SECTION.
|
||||
*
|
||||
*** 初期処理
|
||||
PERFORM 1000ITTSOR.
|
||||
*
|
||||
*** マスタLOAD処理
|
||||
PERFORM 1200MSTLDASOR
|
||||
UNTIL WRK-R02EOF-Y.
|
||||
*
|
||||
*** マスタLOAD完了後、R02をCLOSE（SAME RECORD AREA確保領域の解放）
|
||||
PERFORM 1250R02CLOSOR.
|
||||
*
|
||||
*** 評価明細集計処理
|
||||
PERFORM 2000MAJSOR
|
||||
UNTIL WRK-R01EOF-Y.
|
||||
*
|
||||
*** 終了処理
|
||||
PERFORM 4000STPSOR.
|
||||
*
|
||||
0000MAJCOLSOR-EXT.
|
||||
GOBACK.
|
||||
*****************************************************************
|
||||
* サブモジュールNO: (1.0) *
|
||||
* サブモジュール名: 初期処理 *
|
||||
* 処理概要 : 開始メッセージ出力・各種初期化処理 *
|
||||
*****************************************************************
|
||||
1000ITTSOR SECTION.
|
||||
*
|
||||
*** プログラム開始表示
|
||||
DISPLAY 'JIN09RPT START' UPON CONSOLE.
|
||||
*
|
||||
*** 開始メッセージ出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGSTR TO M00MSGCOD.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
*** コンパイル日時出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGKEYINF TO M00MSGCOD.
|
||||
MOVE FUNCTION WHEN-COMPILED TO M00UMKDATS22-01.
|
||||
MOVE 'COMPILED' TO M00UMKDATS22-02.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
*** ワークエリア初期化
|
||||
INITIALIZE WRKARA
|
||||
CUNARA.
|
||||
*
|
||||
*** 内部表初期化（全要素クリア）
|
||||
PERFORM 1500TBLINITSOR.
|
||||
*
|
||||
*** 運用日付取得
|
||||
INITIALIZE D01UBSPAR.
|
||||
CALL 'SUB01DAT' USING D01UBSPAR
|
||||
ON EXCEPTION
|
||||
DISPLAY 'SUB01DAT CALL ERROR'
|
||||
MOVE 999 TO D01FKICOD
|
||||
NOT ON EXCEPTION
|
||||
CONTINUE
|
||||
END-CALL.
|
||||
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 6000MSGOUTSOR
|
||||
PERFORM 9999ABDSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 入出力ファイルOPEN
|
||||
OPEN INPUT R01INNFIL
|
||||
R02INNFIL
|
||||
OUTPUT W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** 初回フラグ設定
|
||||
MOVE 'Y' TO WRK-FIRST-FLG.
|
||||
*
|
||||
*** R02初回読込
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
*** R01初回読込
|
||||
PERFORM 1300R01INNSOR.
|
||||
*
|
||||
1000ITTSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.1) *
|
||||
* サブモジュール名: R02読込処理 *
|
||||
* 処理概要 : 評価基準マスタ読込・EOF判定 *
|
||||
*****************************************************************
|
||||
1100R02INNSOR SECTION.
|
||||
*
|
||||
READ R02INNFIL
|
||||
AT END
|
||||
MOVE '1' TO WRK-R02EOF
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R02INN
|
||||
END-READ.
|
||||
*
|
||||
1100R02INNSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.2) *
|
||||
* サブモジュール名: マスタLOAD処理 *
|
||||
* 処理概要 : R02全件を内部表にLOAD *
|
||||
*****************************************************************
|
||||
1200MSTLDASOR SECTION.
|
||||
*
|
||||
*** 内部表エントリ追加
|
||||
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).
|
||||
*
|
||||
*** 次のR02読込
|
||||
PERFORM 1100R02INNSOR.
|
||||
*
|
||||
1200MSTLDASOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.25) *
|
||||
* サブモジュール名: R02クローズ処理 *
|
||||
* 処理概要 : マスタLOAD完了後にR02をCLOSEする *
|
||||
*****************************************************************
|
||||
1250R02CLOSOR SECTION.
|
||||
*
|
||||
CLOSE R02INNFIL.
|
||||
*
|
||||
1250R02CLOSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.3) *
|
||||
* サブモジュール名: R01読込処理 *
|
||||
* 処理概要 : 評価明細読込・EOF判定 *
|
||||
*****************************************************************
|
||||
1300R01INNSOR SECTION.
|
||||
*
|
||||
READ R01INNFIL
|
||||
AT END
|
||||
MOVE '1' TO WRK-R01EOF
|
||||
NOT AT END
|
||||
ADD 1 TO CUN-R01INN
|
||||
END-READ.
|
||||
*
|
||||
1300R01INNSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.5) *
|
||||
* サブモジュール名: 内部表初期化処理 *
|
||||
* 処理概要 : 内部表全要素（20件）を初期化 *
|
||||
*****************************************************************
|
||||
1500TBLINITSOR SECTION.
|
||||
*
|
||||
PERFORM VARYING WRK-IDX
|
||||
FROM 1 BY 1
|
||||
UNTIL WRK-IDX > CNS-TBL-MAX
|
||||
MOVE SPACE TO TBL-SKILL-CODE(WRK-IDX)
|
||||
TBL-SKILL-NAME(WRK-IDX)
|
||||
TBL-LEVEL-NAME(WRK-IDX)
|
||||
TBL-EMP-ID(WRK-IDX)
|
||||
TBL-EMP-NAME(WRK-IDX)
|
||||
MOVE ZERO TO TBL-EVAL-CNT(WRK-IDX)
|
||||
TBL-SCORE-SUM(WRK-IDX)
|
||||
END-PERFORM.
|
||||
MOVE ZERO TO WS-TBL-MAX-IDX.
|
||||
MOVE ZERO TO WRK-EMP-EVAL-CNT.
|
||||
*
|
||||
1500TBLINITSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(1.6) *
|
||||
* サブモジュール名: 集計項目リセット処理 *
|
||||
* 処理概要 : 社員キーブレイク時にMST定義を保持したまま *
|
||||
* 集計値のみリセット *
|
||||
*****************************************************************
|
||||
1600TBLRSTSOR SECTION.
|
||||
*
|
||||
PERFORM VARYING WRK-IDX
|
||||
FROM 1 BY 1
|
||||
UNTIL WRK-IDX > WS-TBL-MAX-IDX
|
||||
MOVE ZERO TO TBL-EVAL-CNT(WRK-IDX)
|
||||
TBL-SCORE-SUM(WRK-IDX)
|
||||
MOVE SPACE TO TBL-LEVEL-NAME(WRK-IDX)
|
||||
TBL-EMP-ID(WRK-IDX)
|
||||
TBL-EMP-NAME(WRK-IDX)
|
||||
END-PERFORM.
|
||||
MOVE ZERO TO WRK-EMP-EVAL-CNT.
|
||||
*
|
||||
1600TBLRSTSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(2.0) *
|
||||
* サブモジュール名: 主処理 *
|
||||
* 処理概要 : 社員キーブレイク判定 + 明細集計 *
|
||||
*****************************************************************
|
||||
2000MAJSOR SECTION.
|
||||
*
|
||||
*** 社員キーブレイク判定（初回 / EMP-ID不一致）
|
||||
IF WRK-FIRST-FLG-Y
|
||||
MOVE R01EMP-ID TO WRK-PREV-EMP-ID
|
||||
SET WRK-FIRST-FLG-Y TO FALSE
|
||||
ELSE
|
||||
IF R01EMP-ID
|
||||
NOT = WRK-PREV-EMP-ID
|
||||
PERFORM 3000OUTPUSOR
|
||||
MOVE R01EMP-ID TO WRK-PREV-EMP-ID
|
||||
ELSE
|
||||
CONTINUE
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
*** 明細集計処理
|
||||
PERFORM 2100AGGRGASOR.
|
||||
*
|
||||
*** 次のR01読込
|
||||
PERFORM 1300R01INNSOR.
|
||||
*
|
||||
2000MAJSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(2.1) *
|
||||
* サブモジュール名: 明細集計処理 *
|
||||
* 処理概要 : レベル判定 → SEARCH ALL → 内部表UPDATE *
|
||||
*****************************************************************
|
||||
2100AGGRGASOR SECTION.
|
||||
*
|
||||
*** レベル判定（NESTED IF 3段 + 複合条件 AND/OR）
|
||||
PERFORM 2200JUDGESOR.
|
||||
*
|
||||
*** SEARCH ALL で該当スキル特定
|
||||
SET WS-TBL-IDX TO 1.
|
||||
SEARCH ALL WS-TBL-ENTRY
|
||||
AT END
|
||||
PERFORM 2400WRTERRSOR
|
||||
WHEN TBL-SKILL-CODE(WS-TBL-IDX)
|
||||
= R01SKILL-CODE
|
||||
PERFORM 2300UPDTTLSOR
|
||||
END-SEARCH.
|
||||
*
|
||||
2100AGGRGASOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(2.2) *
|
||||
* サブモジュール名: レベル判定処理 *
|
||||
* 処理概要 : スコアを S/A/B/C に判定（NESTED IF） *
|
||||
*****************************************************************
|
||||
2200JUDGESOR SECTION.
|
||||
*
|
||||
IF R01SCORE >= CNS-SCORE-A
|
||||
AND R01SCORE <= 999
|
||||
IF R01SCORE >= CNS-SCORE-S
|
||||
OR R01SCORE = 100
|
||||
MOVE CNS-LVLS TO WRK-LEVEL
|
||||
ELSE
|
||||
MOVE CNS-LVLA TO WRK-LEVEL
|
||||
END-IF
|
||||
ELSE
|
||||
IF R01SCORE >= CNS-SCORE-B
|
||||
AND R01SCORE <= 79
|
||||
MOVE CNS-LVLB TO WRK-LEVEL
|
||||
ELSE
|
||||
IF R01SCORE >= CNS-SCORE-C
|
||||
AND R01SCORE <= 49
|
||||
MOVE CNS-LVLC TO WRK-LEVEL
|
||||
ELSE
|
||||
MOVE CNS-LVLX TO WRK-LEVEL
|
||||
NEXT SENTENCE
|
||||
END-IF
|
||||
END-IF
|
||||
END-IF.
|
||||
*
|
||||
2200JUDGESOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(2.3) *
|
||||
* サブモジュール名: 内部表UPDATE *
|
||||
* 処理概要 : 該当エントリの件数・合計点を加算 *
|
||||
*****************************************************************
|
||||
2300UPDTTLSOR SECTION.
|
||||
*
|
||||
*** 件数加算
|
||||
ADD 1 TO TBL-EVAL-CNT(WS-TBL-IDX)
|
||||
END-ADD.
|
||||
*** 合計点加算
|
||||
ADD R01SCORE TO TBL-SCORE-SUM(WS-TBL-IDX)
|
||||
END-ADD.
|
||||
*** 社員ID・氏名・レベル設定
|
||||
MOVE R01EMP-ID TO TBL-EMP-ID(WS-TBL-IDX).
|
||||
MOVE R01EMP-NAME TO TBL-EMP-NAME(WS-TBL-IDX).
|
||||
MOVE WRK-LEVEL TO TBL-LEVEL-NAME(WS-TBL-IDX).
|
||||
*** 社員別明細総数加算
|
||||
ADD 1 TO WRK-EMP-EVAL-CNT.
|
||||
*
|
||||
2300UPDTTLSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(2.4) *
|
||||
* サブモジュール名: エラーWRITE *
|
||||
* 処理概要 : W02へエラーレコード出力 *
|
||||
*****************************************************************
|
||||
2400WRTERRSOR SECTION.
|
||||
*
|
||||
ADD 1 TO CUN-W02OUT.
|
||||
INITIALIZE W02OUTREC.
|
||||
MOVE CNS-PRGIDX TO ERR-PROGRAMID.
|
||||
MOVE R01EMP-ID TO ERR-EMP-ID.
|
||||
MOVE 'LVL1' TO ERR-CODE.
|
||||
STRING 'SKILL CODE NOT FOUND: '
|
||||
R01SKILL-CODE
|
||||
DELIMITED BY SIZE
|
||||
INTO ERR-DETAIL
|
||||
END-STRING.
|
||||
WRITE W02OUTREC.
|
||||
*
|
||||
2400WRTERRSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(3.0) *
|
||||
* サブモジュール名: 社員グループ出力処理 *
|
||||
* 処理概要 : 内部表を走査し平均点を算出して出力 *
|
||||
*****************************************************************
|
||||
3000OUTPUSOR SECTION.
|
||||
*
|
||||
*** 内部表を昇順走査（PERFORM VARYING 多重ループ）
|
||||
PERFORM VARYING WRK-IDX
|
||||
FROM 1 BY 1
|
||||
UNTIL WRK-IDX > WS-TBL-MAX-IDX
|
||||
IF TBL-EVAL-CNT(WRK-IDX) > ZERO
|
||||
PERFORM 3100WRITEAGSOR
|
||||
END-IF
|
||||
END-PERFORM.
|
||||
*
|
||||
*** 次の社員グループに備えて集計項目をリセット
|
||||
PERFORM 1600TBLRSTSOR.
|
||||
*
|
||||
3000OUTPUSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(3.1) *
|
||||
* サブモジュール名: 集計結果1件WRITE *
|
||||
* 処理概要 : 平均点算出→編集→W01出力 *
|
||||
*****************************************************************
|
||||
3100WRITEAGSOR SECTION.
|
||||
*
|
||||
*** 平均点算出
|
||||
IF TBL-EVAL-CNT(WRK-IDX) > ZERO
|
||||
DIVIDE TBL-SCORE-SUM(WRK-IDX)
|
||||
BY TBL-EVAL-CNT(WRK-IDX)
|
||||
GIVING WRK-AVG-TEMP
|
||||
REMAINDER WRK-REM
|
||||
END-DIVIDE
|
||||
ELSE
|
||||
MOVE ZERO TO WRK-AVG-TEMP
|
||||
END-IF.
|
||||
*
|
||||
*** W01レコード編集
|
||||
INITIALIZE W01OUTREC.
|
||||
MOVE TBL-EMP-ID(WRK-IDX)
|
||||
TO W01SUM-EMP-ID.
|
||||
MOVE TBL-EMP-NAME(WRK-IDX)
|
||||
TO W01SUM-EMP-NAME.
|
||||
MOVE TBL-SKILL-CODE(WRK-IDX)
|
||||
TO W01SUM-SKILL-CODE.
|
||||
MOVE TBL-SKILL-NAME(WRK-IDX)
|
||||
TO W01SUM-SKILL-NAME.
|
||||
MOVE TBL-LEVEL-NAME(WRK-IDX)
|
||||
TO W01SUM-LEVEL-NAME.
|
||||
MOVE TBL-EVAL-CNT(WRK-IDX)
|
||||
TO W01SUM-EVAL-CNT.
|
||||
MOVE TBL-SCORE-SUM(WRK-IDX)
|
||||
TO W01SUM-SCORE-TOTAL.
|
||||
MOVE WRK-AVG-TEMP
|
||||
TO W01SUM-SCORE-AVG.
|
||||
MOVE WRK-EMP-EVAL-CNT
|
||||
TO W01SUM-EVAL-CNT-TOTAL.
|
||||
*
|
||||
WRITE W01OUTREC.
|
||||
ADD 1 TO CUN-W01OUT.
|
||||
*
|
||||
3100WRITEAGSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(4.0) *
|
||||
* サブモジュール名: 終了処理 *
|
||||
* 処理概要 : 最終社員出力 + 件数出力 + 終了メッセージ *
|
||||
*****************************************************************
|
||||
4000STPSOR SECTION.
|
||||
*
|
||||
*** 最終社員グループの出力
|
||||
IF WRK-EMP-EVAL-CNT > ZERO
|
||||
PERFORM 3000OUTPUSOR
|
||||
END-IF.
|
||||
*
|
||||
*** 入出力ファイル件数出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'JIN09R01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R01INN TO M00UMKDATS22-02.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGIINKES TO M00MSGCOD.
|
||||
MOVE 'JIN09R02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-R02INN TO M00UMKDATS22-02.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'JIN09W01' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W01OUT TO M00UMKDATS22-02.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGOUTKES TO M00MSGCOD.
|
||||
MOVE 'JIN09W02' TO M00UMKDATS22-01.
|
||||
MOVE CUN-W02OUT TO M00UMKDATS22-02.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
*** 出力ファイルCLOSE
|
||||
CLOSE R01INNFIL
|
||||
W01OUTFIL
|
||||
W02OUTFIL.
|
||||
*
|
||||
*** サブプログラム解放（CANCEL 予約語カバー）
|
||||
CANCEL 'SUB02MSG'.
|
||||
*
|
||||
*** 終了メッセージ出力
|
||||
INITIALIZE M00MHOPAR.
|
||||
MOVE CNS-MSGFIN TO M00MSGCOD.
|
||||
PERFORM 6000MSGOUTSOR.
|
||||
*
|
||||
4000STPSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(6.0) *
|
||||
* サブモジュール名: メッセージ編集出力処理 *
|
||||
* 処理概要 : メッセージ編集出力サブPGM呼出 *
|
||||
*****************************************************************
|
||||
6000MSGOUTSOR 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.
|
||||
*
|
||||
6000MSGOUTSOR-EXT.
|
||||
EXIT.
|
||||
*****************************************************************
|
||||
* サブモジュールNO:(9.9) *
|
||||
* サブモジュール名: ABEND処理 *
|
||||
* 処理概要 : ABENDサブPGM呼出 *
|
||||
*****************************************************************
|
||||
9999ABDSOR SECTION.
|
||||
*
|
||||
MOVE CNS-ABD999 TO E01ABDCOD.
|
||||
CALL 'SUB03END' USING E01ABDPAR.
|
||||
*
|
||||
9999ABDSOR-EXT.
|
||||
EXIT.
|
||||
Reference in New Issue
Block a user