ILE-RPG 可変長フィールドを含むテーブルのCRUDアプリ 
画面表示装置
EX0050D.dspg
A*****************************************************************
A*****************************************************************
A REF(EMPLOYEE)
A CHGINPDFT(CS)
A PRINT(QSYSPRT)
A INDARA
A DSPSIZ(24 80 *DS3)
A R HEAD01 OVERLAY
A CA03(03 '終了')
A CF05(05 '追加')
A CF06(06 '変更')
A CF07(07 '削除')
A CF08(08 '照会')
A MODE 6O O 1 4DSPATR(RI) COLOR(WHT)
A 1 13'MODE'
A DSPATR(RI) COLOR(WHT)
A 2 4TIME
A 2 28'EMPLOYEE メンテナンス'
A DSPATR(HI RI)
A 2 70DATE
A EDTCDE(Y)
A 4 10'EMPNO'
A EMPNO R D B 4 28DSPATR(CS)
A 50 DSPATR(PC RI)
A*
A R DTL01 OVERLAY
A PROTECT
A CA12(12 '前画面へ')
A 6 10'FIRSTNME'
A NAME1 14O B 6 28
A 7 10'MIDINIT'
A MIDINIT R B 7 28
A 8 10'LASTNAME'
A NAME2 17O B 8 28
A 9 10'WORKDEPT'
A WORKDEPT R B 9 28
A 10 10'PHONENO'
A PHONENO R B 10 28
A 11 10'HIREDATE'
A HIREDATE R L B 11 28
A 12 10'JOB'
A JOB R B 12 28
A 13 10'EDLEVEL'
A EDLEVEL R B 13 28
A 14 10'SEX'
A SEX R B 14 28
A 15 10'BIRTHDATE'
A BIRTHDATE R L B 15 28
A 16 10'SALARY'
A SALARY R B 16 28
A 17 10'BONUS'
A BONUS R B 17 28
A 18 10'COMM'
A COMM R B 18 28
A*
A* 22 2'F12 CANCEL'
A*
A R ANS01 OVERLAY
A PROTECT
A CA12(12)
A N40 45 21 52'追加しますか？(Y/N)'
A N40 46 21 52'更新しますか？(Y/N)'
A N40 47 21 52'削除しますか？(Y/N)'
A ANS 1A B 21 75
A R PF01
A 22 4'F3=終了'
A 22 20'F5=追加'
A 22 32'F6=変更'
A 22 44'F7=削除'
A 22 56'F8=照会'
A 51 23 3'該当の明細は既に存在します'
A DSPATR(RI HI) COLOR(RED)
A 52 23 3'該当の明細は存在しません'
A DSPATR(RI HI) COLOR(RED)
A R PF02
A 22 2'F12=CANCEL'
A 40 45 98 23 3'追加処理は失敗しました'
A DSPATR(RI HI) COLOR(RED)
A 40 46 98 23 3'更新処理は失敗しました'
A DSPATR(RI HI) COLOR(RED)
A 40 47 98 23 3'削除処理は失敗しました'
A DSPATR(RI HI) COLOR(RED)
A 40 45N98 23 3'追加処理は成功しました'
A DSPATR(RI HI) COLOR(WHT)
A 40 46N98 23 3'更新処理は成功しました'
A DSPATR(RI HI) COLOR(WHT)
A 40 47N98 23 3'削除処理は成功しました'
A DSPATR(RI HI) COLOR(WHT)
DOCFILの結果
sﾟｰﾆﾞ: /
作成者印 承認印
画 面 設 計 書
10/03/17 / / ファイル： PRIMULA/EX0050D SAMPLE
1 2 3 4 5 6 7 8
12345678901234567890123456789012345678901234567890123456789012345678901234567890
1 OOOOOO MODE 1
2 TT:TT:TT EMPLOYEE メンテナンス DD/DD/DD 2
3 3
4 EMPNO BBBBBB 4
5 5
6 FIRSTNME BBBBBBBBBBBBBB 6
7 MIDINIT B 7
8 LASTNAME BBBBBBBBBBBBBBBBB 8
9 WORKDEPT BBB 9
10 PHONENO BBBB 10
11 HIREDATE 9999999999 11
12 JOB BBBBBBBB 12
13 EDLEVEL 9999 13
14 SEX B 14
15 BIRTHDATE 9999999999 15
16 SALARY 9999999999 16
17 BONUS 9999999999 17
18 COMM 9999999999 18
19 19
20 20
21 削除しますか？(Y/N) B 21
22 F12=CANCEL 22
23 削除処理は成功しました 23
24 24
12345678901234567890123456789012345678901234567890123456789012345678901234567890
1 2 3 4 5 6 7 8
プログラム(ILE-RPG)
EX0050R.rpgle
H DFTACTGRP(*NO) ACTGRP(*CALLER)
H ALWNULL(*USRCTL)
FEX0050D CF E WORKSTN
FEMPLOYEE UF A E K DISK RENAME(EMPLOYEE:EMPR)
D****************************************************************
D EMPDS E DS EXTNAME(EMPLOYEE)
D EMPDIM S 1 DIM(%LEN(EMPDS))
C****************************************************************
C*初期化
C MOVEL '照会' MODE
C*ヘッダ
C LOOP1 TAG
C WRITE PF01
C EXFMT HEAD01
C*終了チェック
C 03 SETON LR
C LR RETURN
C*処理区分
C EXSR MODEINZ
C EXSR FLGINZ1
C*マスタ読み込み
C EMPNO CHAIN(N) EMPR 98
C*追加時に該当レコードがある場合はエラー
C SETOFF 505152
C 05*IN98 IFEQ *OFF 追加
C SETON 5051
C ENDIF
C*更新・削除・照会時に該当レコードがない場合はエラー
C 06
COR 07
COR 08*IN98 IFEQ *ON
C SETON 5052
C ENDIF
C 51
COR 52 GOTO LOOP1
C*可変長⇒固定長
C N05 EVAL NAME1 = FIRSTNME
C N05 EVAL NAME2 = LASTNAME
C 05 EXSR ADDSUB1 追加時の前処理
C 07 削除と照会は
COR 08 GOTO LOOP3 スキップ
C*明細部
C LOOP2 TAG
C EXSR NLSUB1
C WRITE PF02
C WRITE HEAD01
C EXFMT DTL01
C 12 GOTO LOOP1
C EXSR NLSUB2
C EVAL FIRSTNME = %TRIM(NAME1)
C EVAL LASTNAME = %TRIM(NAME2)
C 08 GOTO LOOP3
C*確認部
C LOOP3 TAG
C MOVE *BLANK ANS
C SETOFF 454647
C 05 SETON 45 追加
C 06 SETON 46 更新
C 07 SETON 47 削除
C WRITE PF02
C WRITE HEAD01
C WRITE DTL01
C EXFMT ANS01
C 08 GOTO LOOP1 照会の場合
C 12 GOTO LOOP2 PF12
C ANS CABNE 'Y' LOOP2 Y以外は戻る
C 05 WRITE EMPR 98 追加
C IF *IN05 = *OFF 追加以外
C MOVEA EMPDS EMPDIM 現在の値をストア
C EMPNO CHAIN EMPR 9898 ロック
C 98 GOTO LOOP4 ロック失敗はエラー
C MOVEA EMPDIM EMPDS 値を戻す
C EXSR NLSUB2
C 06 UPDATE EMPR 98 更新
C 07 DELETE EMPR 98 削除
C ENDIF
C*結果
C LOOP4 TAG
C MOVE *BLANK ANS
C SETON 40
C WRITE PF02
C WRITE HEAD01
C WRITE DTL01
C EXFMT ANS01
C SETOFF 40
C EXSR WKCLR
C GOTO LOOP1
C*
C****************************************************************
C WKCLR BEGSR
C EVAL NAME1 = *BLANK
C EVAL NAME2 = *BLANK
C CLEAR EMPR
C ENDSR
C****************************************************************
C MODEINZ BEGSR
C 05 MOVEL '追加' MODE
C 06 MOVEL '更新' MODE
C 07 MOVEL '削除' MODE
C 08 MOVEL '照会' MODE
C ENDSR
C****************************************************************
C FLGINZ1 BEGSR
C SELECT
C WHEN MODE='追加'
C SETON 05
C SETOFF 060708
C WHEN MODE='更新'
C SETON 06
C SETOFF 050708
C WHEN MODE='削除'
C SETON 07
C SETOFF 050608
C WHEN MODE='照会'
C SETON 08
C SETOFF 050607
C ENDSL
C ENDSR
C****************************************************************
C ADDSUB1 BEGSR
C *LIKE DEFINE EMPNO WKNO
C EVAL WKNO = EMPNO 主キーを退避
C CLEAR EMPR レコードクリア
C EVAL EMPNO = WKNO 主キーを復元
C ENDSR
C****************************************************************
C NLSUB1 BEGSR
C IF %NULLIND(SALARY)
C EVAL %NULLIND(SALARY) = *OFF
C EVAL SALARY = *ZERO
C ENDIF
C IF %NULLIND(BONUS)
C EVAL %NULLIND(BONUS) = *OFF
C EVAL BONUS = *ZERO
C ENDIF
C IF %NULLIND(COMM)
C EVAL %NULLIND(COMM) = *OFF
C EVAL COMM = *ZERO
C ENDIF
C ENDSR
C****************************************************************
C NLSUB2 BEGSR
C SALARY IFEQ *ZERO
C EVAL %NULLIND(SALARY) = *ON
C ELSE
C EVAL %NULLIND(SALARY) = *OFF
C ENDIF
C BONUS IFEQ *ZERO
C EVAL %NULLIND(BONUS) = *ON
C ELSE
C EVAL %NULLIND(BONUS) = *OFF
C ENDIF
C COMM IFEQ *ZERO
C EVAL %NULLIND(COMM) = *ON
C ELSE
C EVAL %NULLIND(COMM) = *OFF
C ENDIF
C ENDSR
実効結果
照会 MODE
15:15:15 EMPLOYEE メンテナンス 10/04/01
EMPNO 000020
FIRSTNME MICHAEL
MIDINIT L
LASTNAME THOMPSON
WORKDEPT B01
PHONENO 3476
HIREDATE 1973-10-10
JOB MANAGER
EDLEVEL 18
SEX M
BIRTHDATE 1948-02-02
SALARY 4125000
BONUS 80000
COMM 330000
F12=CANCEL
このページへのコメント
iFV5FK Thanks-a-mundo for the blog post.Thanks Again. Want more.