| サンプル・プログラム |
ＣＯＢＯＬによる明細のある画面の処理プログラムの例
画面（Ｆ５３０Ｓ）のレイアウト
以下のような画面レイアウトを想定しています。
OOOOOOOOOO OOOOOO 受 注 入 力 DD/DD/DD TT:TT:TT 受注№ 999999 得意先 BBBB OOOOOOOOOOOOOOOOOOOOOO 受注日 99/99/99 NO 品目№ 受注数 受注単価 受注金額 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- 66 BBBB 9,999,999- 9,999,999.99- 66,666,666,666- F3= 終了 F6= 処理選択 OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
ＤＤＳは次のようになります。
注：このＤＤＳはＣＯＢＯＬ環境でコンパイルチェックをしていないので、正確でないかもしれません。
A*----------------------------------------------------------- A* ID : RF530S A* NAME :受注入力画面 A*画面１= FMT99 + FMT01 A*画面２= FMT99 + FMT01 + FMT02 A*画面３= FMT99 + FMT02 + CTL01(SFL01) A*----------------------------------------------------------- A PRINT A INDARA A R FMT01 OVERLAY PROTECT A CF03 CF06 A* A S1PGID 10A O 1 2 TEXT('PGM-ID') A S1MOD 6O +1 TEXT('処理モード') A 1 31 ' 受 注 入 力 ' A DSPATR(RI) A 1 61 DATE EDTCDE(Y) A 1 71 TIME A* A 3 2 '受注№' A S1JUNO 6Y 0B +1 TEXT('受注№') A 31 DSPATR(PC RI) A*----------------------------------------------------------- A R FMT02 TEXT('第二画面') A OVERLAY PROTECT A CF03 CF12 A* A 4 2 '得意先' A S2TKNO 6A B +1TEXT('得意先№') A 32 DSPATR(PC RI) A 28 DSPATR(PR) A S2NMKJ 30O O +1TEXT('得意先名') A 5 2 '受注日' A S2JUDT 6Y 0B +1TEXT('受注日') A EDTCDE(Y) A 33 DSPATR(PC RI) A 28 DSPATR(PR) A*隠しフィールド A S2NODT 8Y 0H TEXT('納品日') A S2SEDT 8Y 0H TEXT('請求日') A* A*----------------------------------------------------------- A R SFL01 A SFL A 27 SFLNXTCHG A* A S4GYNO 2Y 0O 8 2TEXT('行№') A S4HNNO 6A B +2TEXT('品目№') A 41 DSPATR(PC RI) A 28 DSPATR(PR) A S4SURY 6Y 0B +2TEXT('受注数') A EDTCDE(K) A 42 DSPATR(PC RI) A 28 DSPATR(PR) A S4TANK 8Y 2B +2TEXT('受注＠') A EDTCDE(K) A 43 DSPATR(PC RI) A 28 DSPATR(PR) A S4JUGK 9Y 0O +2TEXT('受注額') A EDTCDE(K) A*----------------------------------------------------------- A R CTL01 A OVERLAY PROTECT A CF12 A* ROLLUP(19) A* ROLLDOWN(20) A SFLCTL(SFL01) A SFLSIZ(100) SFLPAG(10) A 24 SFLDSPCTL A 23 SFLDSP A 22 SFLCLR A 21 SFLINZ A CSRLOC(S1LIN S1COL) A S1LIN 3S 0H TEXT('カーソル制御（行') A S1COL 3S 0H TEXT('カーソル制御（桁') A RCDNBR 4S 0H SFLRCDNBR A 7 02'NO' A 7 05'品目№' A 7 14'受注数' A 7 25'受注単価' A 7 39'受注金額' A*----------------------------------------------------------- A R FMT99 A 01 23 2 'F3=終了 F6=処理選択' A 02 23 2 'F12=取消' A 03 23 2 'F12=取消' A S9MSG 78A O 24 1TEXT('ＭＳＧ ')
ファイル（Ｆ５３０）
以下のような様式を持ったファイルを想定しています。
01 F530R. 06 JDJUNO PIC S9(6) 受注№ 06 JDMENO PIC S9(2) 明細№ 06 JDTKNO PIC X(4) 得意先コード 06 JDHNNO PIC X(4) 品目コード 06 JDJUSU PIC S9(7) 受注数 06 JDJUTK PIC S9(7).9(2) 受注単価 06 JDJUDT PIC S9(8) 受注日 06 JDSEDT PIC S9(8) 請求日
ＣＯＢＯＬソースのサンプル
PROCESS GRAPHIC CVTPICGGRAPHIC APOST IDENTIFICATION DIVISION. PROGRAM-ID. RF530. * NAME : 受注入力処理 AUTHOR. KAJIROU. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. HAL-5000. OBJECT-COMPUTER. HAL-5000. INPUT-OUTPUT SECTION. FILE-CONTROL. * 画面ファイル INDARA 使用の時↓ SELECT FILE1 ASSIGN WORKSTATION-RF530S-SI ORGANIZATION TRANSACTION ACCESS MODE DYNAMIC RELATIVE KEY RRN CONTROL-AREA CTL-AREA. * 更新対象ファイル SELECT FILE2 ASSIGN DATABASE-F530 ACCESS MODE DYNAMIC RECORD KEY EXTERNALLY-DESCRIBED-KEY ORGANIZATION INDEXED. * 得意先マスターファイル SELECT FILE3 ASSIGN DATABASE-M420 ACCESS MODE RANDOM RECORD KEY EXTERNALLY-DESCRIBED-KEY ORGANIZATION INDEXED. * DATA DIVISION. FILE SECTION. * 画面ファイル FD FILE1. 01 FILE1R PIC X(100). * 更新対象ファイル FD FILE2. 01 FILE2R. COPY DDS-ALL-FORMATS OF F530. * 得意先マスター FD FILE3. 01 FILE3R. COPY DDS-ALL-FORMATS OF M420. * WORKING-STORAGE SECTION. * 画面ファイルの様式ごとに入力、出力のエリアを定義します。 01 FMT01A. COPY DDS-FMT01-I OF RF530S. 01 FMT01B. COPY DDS-FMT01-O OF RF530S. 01 FMT02A. COPY DDS-FMT02-I OF RF530S. 01 FMT02B. COPY DDS-FMT02-O OF RF530S. 01 SFL01A. COPY DDS-SFL01-I OF RF530S. 01 SFL01B. COPY DDS-SFL01-O OF RF530S. 01 CTL01A. COPY DDS-CTL01-I OF RF530S. 01 CTL01B. COPY DDS-CTL01-O OF RF530S. 01 FMT99B. COPY DDS-FMT99-O OF RF530S. * INDARA を定義したので、ワークに標識エリアを定義します。 01 FILE1-INDICS. COPY DDS-ALL-FORMATS-INDIC OF RF530S. * SELECT で指定したコントロールエリアを定義します。 01 CTL-AREA. 03 FKEY PIC X(2). 03 DEV-NAME PIC X(10). 03 REC-FMT PIC X(10). 01 SFL-X. 03 RRN PIC 9999. * 処理モード表示用の定義をします。 01 MOD-X. 05 FILLER PIC X(6) VALUE ' '. 05 FILLER PIC X(6) VALUE ' 編集 '. 05 FILLER PIC X(6) VALUE ' 編集 '. 05 FILLER PIC X(6) VALUE ' '. 05 FILLER PIC X(6) VALUE ' 削除 '. 01 MOD-R REDEFINES MOD-X. 03 MOD OCCURS 4 PIC XXXXXX. * エラーメッセージ定数の定義をします。 01 MSG-X. 03 FILLER PIC X(30) VALUE ' 該当得意先№重複 '. 03 FILLER PIC X(30) VALUE ' 該当得意先№なし '. 03 FILLER PIC X(30) VALUE ' 入力が必要です。 '. 03 FILLER PIC X(30) VALUE ' 更新確認 '. 03 FILLER PIC X(30) VALUE SPACE. 01 MSG-R REDEFINES MSG-X. 03 MSG OCCURS 5 PIC X(30). * プログラム制御用のフィールド定義 01 CTL. 03 W-FMT PIC 9(02) VALUE 1. 03 W-MOD PIC 9(02) VALUE 4. 03 W-KEN PIC 9(02) VALUE 0. 03 W-UPD PIC X VALUE SPACE. * 変更フラグ 01 CTL-A. 03 CHG OCCURS 99 PIC X. * プログラムで使用する標識（及び定数）を定義します。 01 CONST. 03 Z-ON PIC 1 VALUE B'1'. 03 Z-OFF PIC 1 VALUE B'0'. 03 IN29 PIC 1 VALUE B'0'. 03 IN30 PIC 1 VALUE B'0'. 03 IN98 PIC 1 VALUE B'0'. 03 IN99 PIC 1 VALUE B'0'. 03 F03 PIC XX VALUE '03'. 03 F06 PIC XX VALUE '06'. 03 F12 PIC XX VALUE '12'. *------------------------------------------------------ PROCEDURE DIVISION. 01. * 初期処理 PERFORM SB-INZ. 02. * 主処理（Ｆ３キーが押されるまで） PERFORM SB-MAIN UNTIL FKEY = F03. 03. * 終了処理 PERFORM SB-END. STOP RUN. *---------------------------------------------- SB-INZ. OPEN I-O FILE1. OPEN I-O FILE2. OPEN INPUT FILE3. MOVE SPACE TO FKEY. MOVE 'RF530' TO S1PGID. PERFORM SB-1220. *---------------------------------------------- SB-MAIN. EVALUATE W-FMT WHEN 01 PERFORM SB-1000 WHEN 02 PERFORM SB-2000 WHEN 03 PERFORM SB-3000 END-EVALUATE. IF W-UPD = 'U' PERFORM SB-0000 END-IF. *---------------------------------------------------- SB-1000. MOVE Z-ON TO IN01. MOVE Z-OFF TO IN02. MOVE SPACE TO W-UPD. PERFORM SB-1000A UNTIL W-FMT NOT = 01. *---------------------------------------------------- SB-1000A. * 第一画面表示 WRITE FILE1R FROM FMT99-O FORMAT 'FMT99' INDICATORS FMT99-O-INDIC. WRITE FILE1R FROM FMT01-O FORMAT 'FMT01' INDICATORS FMT01-O-INDIC. READ FILE1 INTO FMT01-I FORMAT 'FMT01'. MOVE SPACE TO S9MSG. EVALUATE FKEY EVALUATE FKEY WHEN F03 MOVE ZERO TO W-FMT WHEN F06 PERFORM SB-1220 WHEN OTHER PERFORM SB-1230 IF IN30 = Z-OFF PERFORM SB-1250 END-IF END-EVALUATE. *------------------------------------------------- SB-1220. EVALUATE W-MOD WHEN 02 MOVE 04 TO W-MOD WHEN 04 MOVE 02 TO W-MOD END-EVALUATE. * 処理モードを設定 MOVE MOD(W-MOD) TO S1MOD. *------------------------------------------------- * 実行キーがおされたときの処理 SB-1230. MOVE CORR FMT01-I TO FMT01-O. MOVE Z-OFF TO IN30 IN31. MOVE Z-OFF TO IN30 IN31. INITIALIZE FILE2R. * レコード存在チェック MOVE S1JUNO OF FMT01-I TO JDJUNO. MOVE 00 TO JDMENO. MOVE SPACE TO JDTKCD. MOVE ZERO TO JDJUDT. MOVE Z-OFF TO IN99. START FILE2 KEY NOT LESS THAN EXTERNALLY-DESCRIBED-KEY INVALID KEY MOVE Z-ON TO IN99. PERFORM SB-READ-EQ. MOVE JDTKCD TO S2TKCD OF FMT02-O. MOVE JDJUDT TO S2JUDT OF FMT02-O. * 削除モードで該当レコードなしはエラー IF W-MOD = 04 AND IN99 = Z-ON MOVE MSG(2) TO S9MSG MOVE Z-ON TO IN30 IN31 END-IF. * ＮＯ－ＥＲＲＯＲなら第二画面へ IF IN30 = Z-OFF MOVE 02 TO W-FMT END-IF. *--------------------------------------------------------------- * サブファイルへ明細データをセット SB-1250. * サブファイルを初期化 PERFORM SB-INZ-SFL. IF W-MOD = 04 MOVE Z-ON TO IN28 OF SFL01-O-INDIC ELSE MOVE Z-OFF TO IN28 OF SFL01-O-INDIC END-IF. MOVE 0000 TO RRN W-KEN. MOVE 0001 TO RCDNBR OF CTL01-O. MOVE 0000 TO S4GYNO OF SFL01-O. * MOVE Z-OFF TO IN99. START FILE2 KEY NOT LESS THAN EXTERNALLY-DESCRIBED-KEY INVALID KEY MOVE Z-ON TO IN99. PERFORM SB-READ-EQ. PERFORM UNTIL IN99 = Z-ON ADD 01 TO RRN W-KEN READ SUBFILE FILE1 FORMAT 'SFL01' MOVE RRN TO S4GYNO OF SFL01-O MOVE JDHNCD TO S4HNCD OF SFL01-O MOVE JDJUSU TO S4JUSU OF SFL01-O MOVE JDJUTK TO S4JUTK OF SFL01-O COMPUTE S4JUGK OF SFL01-O = JDJUSU * JDJUTK MOVE JDSEDT TO S4NODT OF SFL01-O REWRITE SUBFILE FILE1R FROM SFL01-O FORMAT 'SFL01' INDICATORS SFL01-O-INDIC PERFORM SB-READ-EQ END-PERFORM. *--------------------------------------------------------------- SB-2000. MOVE Z-OFF TO IN01. MOVE Z-ON TO IN02. MOVE SPACE TO W-UPD. IF W-MOD = 04 MOVE Z-ON TO IN28 OF FMT02-O-INDIC ELSE MOVE Z-OFF TO IN28 OF FMT02-O-INDIC END-IF. * * 第二画面繰返し PERFORM UNTIL W-FMT NOT = 02 WRITE FILE1R FROM FMT99-O FORMAT 'FMT99' INDICATORS FMT99-O-INDIC WRITE FILE1R FROM FMT01-O FORMAT 'FMT01' INDICATORS FMT01-O-INDIC WRITE FILE1R FROM FMT02-O FORMAT 'FMT02' INDICATORS FMT02-O-INDIC READ FILE1 INTO FMT02-I FORMAT 'FMT02' * INDICATORS FMT02-I-INDIC MOVE SPACE TO S9MSG EVALUATE FKEY WHEN F12 MOVE 01 TO W-FMT WHEN OTHER PERFORM SB-2230 END-EVALUATE END-PERFORM. *------------------------------------------------------- * 第二画面のチェック SB-2230. MOVE CORR FMT02-I TO FMT02-O. MOVE SPACE TO W-UPD. * 属性の取得 * *--------------------* * | （名前などの取得） | * *--------------------* * エラーチェック MOVE Z-OFF TO IN30 IN32 IN33. * 得意先チェック MOVE S2TKCD OF FMT02-I TO TKCDNO. READ FILE3 RECORD INVALID KEY MOVE Z-ON TO IN98. IF IN98 = Z-ON MOVE MSG(2) TO S9MSG MOVE Z-ON TO IN30 IN32 END-IF. * 日付チェック * 日付チェック IF S2JUDT OF FMT02-I = 0 MOVE MSG(3) TO S9MSG MOVE Z-ON TO IN30 IN33 END-IF. * ＯＫなら第３画面へ IF IN30 = Z-OFF MOVE 03 TO W-FMT END-IF. *----------------------------------------------------- * 第３画面処理 SB-3000. * 第３画面準備 MOVE Z-OFF TO IN01 IN02. MOVE Z-ON TO IN03. MOVE SPACE TO W-UPD. MOVE SPACE TO S9MSG. MOVE SPACE TO CTL-A. IF W-MOD = 04 MOVE Z-ON TO IN28 OF FMT02-O-INDIC IN28 OF SFL01-O-INDIC MOVE MSG(4) TO S9MSG ELSE MOVE Z-OFF TO IN28 OF FMT02-O-INDIC IN28 OF SFL01-O-INDIC END-IF. * 第３画面繰返し PERFORM UNTIL W-FMT NOT = 03 WRITE FILE1R FROM FMT99-O FORMAT 'FMT99' INDICATORS FMT99-O-INDIC WRITE FILE1R FROM FMT01-O FORMAT 'FMT01' INDICATORS FMT01-O-INDIC WRITE FILE1R FROM FMT02-O FORMAT 'FMT02' INDICATORS FMT02-O-INDIC MOVE Z-ON TO IN23 IN24 WRITE FILE1R FROM CTL01-O FORMAT 'CTL01' INDICATORS CTL01-O-INDIC MOVE Z-OFF TO IN23 IN24 READ FILE1 INTO CTL01-I FORMAT 'CTL01' MOVE SPACE TO S9MSG EVALUATE FKEY WHEN F12 MOVE 02 TO W-FMT WHEN OTHER PERFORM SB-3260 END-EVALUATE END-PERFORM. *--------------------------------------------------------------- * 第三画面実行キーが押されたときの処理 SB-3260. MOVE ' ' TO W-UPD. * エラーチェック MOVE Z-OFF TO IN29 IN30. * 入力（変更）あったサブファイルについて PERFORM SB-READ-CHG PERFORM UNTIL IN27 = Z-ON MOVE '1' TO CHG (RRN) MOVE Z-ON TO IN29 PERFORM SB-CHECK-SCR3 REWRITE SUBFILE FILE1R FROM SFL01-O FORMAT 'SFL01' INDICATORS SFL01-O-INDIC PERFORM SB-READ-CHG END-PERFORM. * IF IN30 = Z-OFF IF IN29 = Z-OFF MOVE 'U' TO W-UPD MOVE 01 TO W-FMT ELSE MOVE MSG(4) TO S9MSG END-IF END-IF. *--------------------------------------------------------- * 第三画面の明細チェック SB-CHECK-SCR3. * 属性の取得（必要あれば名前などの取得） MOVE RRN TO S4GYNO OF SFL01-O. COMPUTE S4JUGK OF SFL01-O = S4JUSU OF SFL01-I * S4JUTK OF SFL01-I. * チェック MOVE Z-OFF TO IN41 IN42 IN43. * 品目№ IF S4HNCD OF SFL01-I = SPACE MOVE Z-ON TO IN30 IN41 MOVE MSG(3) TO S9MSG END-IF. * 受注数 IF S4JUSU OF SFL01-I = ZERO MOVE Z-ON TO IN30 IN42 MOVE MSG(3) TO S9MSG END-IF. * 受注＠ IF S4JUTK OF SFL01-I = ZERO MOVE Z-ON TO IN30 IN43 MOVE MSG(3) TO S9MSG END-IF. *------------------------------------------------- SB-0000. * EVALUATE W-MOD WHEN 02 PERFORM VARYING RRN FROM 01 BY 01 UNTIL RRN >99 IF CHG (RRN) = '1' PERFORM SB-CHAIN-SFL MOVE S1JUNO OF FMT01-I TO JDJUNO MOVE RRN TO JDMENO MOVE Z-OFF TO IN99 READ FILE2 RECORD INVALID KEY MOVE Z-ON TO IN99 END-READ PERFORM SB-EDIT IF IN99 = Z-OFF REWRITE FILE2R ELSE WRITE FILE2R END-IF END-IF END-PERFORM WHEN 04 MOVE S1JUNO OF FMT01-I TO JDJUNO MOVE 00 TO JDMENO MOVE Z-OFF TO IN99 START FILE2 KEY NOT LESS THAN EXTERNALLY-DESCRIBED-KEY PERFORM SB-READ-EQ PERFORM UNTIL IN99 NOT = Z-OFF DELETE FILE2 PERFORM SB-READ-EQ END-PERFORM END-EVALUATE. * MOVE SPACE TO CTL-A. MOVE 000000 TO S1JUNO OF FMT01-I MOVE 01 TO W-FMT. *------------------------------------------------------ SB-EDIT. * 編集処理 MOVE S2TKCD OF FMT02-I TO JDTKCD. MOVE S4HNCD OF SFL01-I TO JDHNCD. MOVE S4JUSU OF SFL01-I TO JDJUSU. MOVE S4JUTK OF SFL01-I TO JDJUTK. MOVE S2JUDT OF FMT02-I TO JDJUDT. MOVE S4NODT OF SFL01-I TO JDSEDT. *--------------------------------------------------------------- SB-READ-CHG. MOVE Z-OFF TO IN27. READ SUBFILE FILE1 NEXT MODIFIED RECORD INTO SFL01-I FORMAT 'SFL01' AT END MOVE Z-ON TO IN27. IF IN27 = Z-OFF MOVE CORR SFL01-I TO SFL01-O END-IF. *--------------------------------------------------------------- * サブファイルを初期化 SB-INZ-SFL. MOVE Z-ON TO IN21. WRITE FILE1R FROM CTL01-O FORMAT 'CTL01' INDICATORS CTL01-O-INDIC. MOVE Z-OFF TO IN21. *----------------------------------------------------------- * サブファイルをＲＲＮで読み取り SB-CHAIN-SFL. MOVE Z-OFF TO IN27. READ SUBFILE FILE1 RECORD INTO SFL01-I FORMAT 'SFL01' INVALID KEY MOVE Z-ON TO IN27. IF IN27 = Z-OFF MOVE CORR SFL01-I TO SFL01-O END-IF. *----------------------------------------------------------- SB-READ-EQ. IF IN99 = Z-OFF READ FILE2 NEXT RECORD AT END MOVE Z-ON TO IN99 END-READ IF JDJUNO NOT = S1JUNO OF FMT01-I MOVE Z-ON TO IN99 END-IF END-IF. *---------------------------------- SB-END. CLOSE FILE1 FILE2 FILE3. STOP RUN.
ブラウザの戻るボタンで戻って下さい。
（Ｃ）ＣＯＰＹＲＩＧＨＴ ＩＳＨＩＯＫＡ ＫＡＴＳＵＨＩＤＥ ２００８