Files
cobol-tna-system/src/JIN01KNS.cbl
T

418 lines
19 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. JIN01KNS IS INITIAL.
*****************************************************************
* システム名 : 人事情報管理システム *
* プログラムID : JIN01KNS *
* プログラム名 : カナ氏名チェック処理 *
* 作成日 : 2026-07-19 *
* 処理概要 : 人事取込データの氏名カナ(半角20桁以内・ *
* 英大文字)および補助コード有効値をチェックする *
*****************************************************************
* 更新履歴 *
*---------------------------------------------------------------*
* 更新日付 担当者 更新内容 *
*---------------------------------------------------------------*
* 2026-07-19 @@@ 新規作成 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-ZSERIES.
OBJECT-COMPUTER. IBM-ZSERIES.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT R01INNFIL ASSIGN TO EXTERNAL JIN01R01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
PADDING CHARACTER IS WS-PAD-CHAR
FILE STATUS IS WS-FILE-STATUS.
SELECT W01OUTFIL ASSIGN TO EXTERNAL JIN01W01
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
SELECT W02OUTFIL ASSIGN TO EXTERNAL JIN01W02
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL.
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
* R01: EMP-IMPORT 人事取込データ *
*****************************************************************
FD R01INNFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 R01INNREC.
COPY JIN01REC REPLACING ==(A)== BY ==R01==.
*
*****************************************************************
* W01: EMP-VALID 正常通過データ *
*****************************************************************
FD W01OUTFIL
LABEL RECORD IS STANDARD
BLOCK CONTAINS 0
RECORDING MODE IS F.
01 W01OUTREC.
COPY JIN01REC 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 'JIN01KNS'.
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-KANA-MAX PIC 9(002) VALUE 20.
03 CNS-SUB-VALID-1 PIC X(004) VALUE '0001'.
03 CNS-SUB-VALID-2 PIC X(004) VALUE '0002'.
03 CNS-SUB-VALID-3 PIC X(004) VALUE '0003'.
*
*****************************************************************
* カウンタ領域 *
*****************************************************************
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-U06 PIC 9(008).
*** 読込フラグ
03 WRK-R01EOF PIC X(001).
88 WRK-R01EOF-Y VALUE '1'.
*** エラーフラグ
03 WRK-ERR-FLG PIC X(001).
88 WRK-ERR-Y VALUE '1'.
*** エラーコード
03 WRK-ERR-CODE PIC X(004).
*** カナ長さWORK
03 WRK-KANA-LEN PIC 9(002).
*** SELECT用パディング文字・ファイルステータス
03 WS-PAD-CHAR PIC X(001) VALUE SPACE.
03 WS-FILE-STATUS PIC X(002).
*
*****************************************************************
* サブプログラム連絡領域 *
*****************************************************************
*** 運用日付取得
COPY JINDATAC.
*** メッセージ編集出力SR用
COPY JINMSGAC.
*** ABEND処理SR用
COPY JINENDAC.
*
PROCEDURE DIVISION.
*****************************************************************
* サブモジュールNO: (0.0) *
* サブモジュール名: 制御処理 *
* 処理概要 : メインコントロール処理 *
*****************************************************************
0000MAJCOLSOR SECTION.
*
*** 初期処理
PERFORM 1000ITTSOR.
*
*** メイン処理
PERFORM 2000MAJSOR
UNTIL WRK-R01EOF-Y.
*
*** 終了処理
PERFORM 3000STPSOR.
*
*** RETURN-CODE設定(GOBACK直前)
IF CUN-W02OUT > ZERO
MOVE 4 TO RETURN-CODE
END-IF.
*
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
CUNARA.
*
*** 運用日付取得
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
OUTPUT W01OUTFIL
W02OUTFIL.
*
*** 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) *
* サブモジュール名: 主処理 *
* 処理概要 : カナチェック・振分処理 *
*****************************************************************
2000MAJSOR SECTION.
*
*** エラーフラグ初期化
MOVE '0' TO WRK-ERR-FLG.
*
*** カナ文字チェック
PERFORM 2010CHKANASOR.
*
*** 桁数チェック(エラー未設定時のみ)
IF NOT WRK-ERR-Y
PERFORM 2020CHKSIZSOR
END-IF.
*
*** 補助コードチェック(エラー未設定時のみ)
IF NOT WRK-ERR-Y
PERFORM 2030CHKSUBSOR
END-IF.
*
*** 振分処理
IF WRK-ERR-Y
PERFORM 2200WRTERRSOR
ELSE
PERFORM 2100WRTOKSOR
END-IF.
*
*** 次のレコード読込
PERFORM 1100R01INNSOR.
*
2000MAJSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.1) *
* サブモジュール名: カナ文字チェック *
* 処理概要 : IS ALPHABETIC-UPPER で英大文字判定 *
*****************************************************************
2010CHKANASOR SECTION.
*
IF R01KANA-SEI IS NOT ALPHABETIC-UPPER
MOVE '1' TO WRK-ERR-FLG
MOVE 'K002' TO WRK-ERR-CODE
END-IF.
IF R01KANA-MEI IS NOT ALPHABETIC-UPPER
MOVE '1' TO WRK-ERR-FLG
MOVE 'K002' TO WRK-ERR-CODE
END-IF.
*
2010CHKANASOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.2) *
* サブモジュール名: 桁数チェック *
* 処理概要 : 半角20桁超過チェック *
*****************************************************************
2020CHKSIZSOR SECTION.
*
*** TRAILING SPACES除去後の実効長が20超過かチェック
MOVE FUNCTION LENGTH(
FUNCTION TRIM(R01KANA-SEI TRAILING))
TO WRK-KANA-LEN.
IF WRK-KANA-LEN > CNS-KANA-MAX
MOVE '1' TO WRK-ERR-FLG
MOVE 'K001' TO WRK-ERR-CODE
END-IF.
MOVE FUNCTION LENGTH(
FUNCTION TRIM(R01KANA-MEI TRAILING))
TO WRK-KANA-LEN.
IF WRK-KANA-LEN > CNS-KANA-MAX
MOVE '1' TO WRK-ERR-FLG
MOVE 'K001' TO WRK-ERR-CODE
END-IF.
*
2020CHKSIZSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.3) *
* サブモジュール名: 補助コードチェック *
* 処理概要 : SUB-CODEの有効値チェック *
*****************************************************************
2030CHKSUBSOR SECTION.
*
IF R01SUB-CODE NOT = CNS-SUB-VALID-1
AND R01SUB-CODE NOT = CNS-SUB-VALID-2
AND R01SUB-CODE NOT = CNS-SUB-VALID-3
MOVE '1' TO WRK-ERR-FLG
MOVE 'K003' TO WRK-ERR-CODE
END-IF.
*
2030CHKSUBSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.4) *
* サブモジュール名: 正常WRITE処理 *
* 処理概要 : W01へ正常データ出力 *
*****************************************************************
2100WRTOKSOR SECTION.
*
*** W01レコード編集
INITIALIZE W01OUTREC.
MOVE R01KANA-SEI TO W01KANA-SEI.
MOVE R01KANA-MEI TO W01KANA-MEI.
MOVE R01KANJI-NAME TO W01KANJI-NAME.
MOVE R01SUB-CODE TO W01SUB-CODE.
MOVE R01BIRTH-DATE TO W01BIRTH-DATE.
MOVE R01EMP-ID TO W01EMP-ID.
WRITE W01OUTREC.
ADD 1 TO CUN-W01OUT.
*
2100WRTOKSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(2.5) *
* サブモジュール名: エラーWRITE処理 *
* 処理概要 : W02へエラーレコード出力 *
*****************************************************************
2200WRTERRSOR SECTION.
*
ADD 1 TO CUN-W02OUT
END-ADD.
INITIALIZE W02OUTREC.
MOVE CNS-PRGIDX TO ERR-PROGRAMID.
MOVE R01EMP-ID TO ERR-EMP-ID.
MOVE WRK-ERR-CODE TO ERR-CODE.
STRING 'ERR:' WRK-ERR-CODE
DELIMITED BY SIZE
INTO ERR-DETAIL
END-STRING.
WRITE W02OUTREC.
*
2200WRTERRSOR-EXT.
EXIT.
*****************************************************************
* サブモジュールNO:(3.0) *
* サブモジュール名: 終了処理 *
* 処理概要 : ファイルクローズ・件数と終了メッセージ出力 *
*****************************************************************
3000STPSOR SECTION.
*
*** 入出力ファイルCLOSE
CLOSE R01INNFIL
W01OUTFIL
W02OUTFIL.
*
*** 入出力ファイル件数出力
INITIALIZE M00MHOPAR.
MOVE CNS-MSGIINKES TO M00MSGCOD.
MOVE 'JIN01R01' TO M00UMKDATS22-01.
MOVE CUN-R01INN TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGOUTKES TO M00MSGCOD.
MOVE 'JIN01W01' TO M00UMKDATS22-01.
MOVE CUN-W01OUT TO M00UMKDATS22-02.
PERFORM 4000MSGOUTSOR.
*
INITIALIZE M00MHOPAR.
MOVE CNS-MSGOUTKES TO M00MSGCOD.
MOVE 'JIN01W02' 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) *
* サブモジュール名: メッセージ編集出力処理 *
* 処理概要 : メッセージ編集出力サブ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.