2001/07/20版

当バージョンでは 運賃データをPostgreSQLとしました。(PostgreSQL7.1.1使用)
PostgreSQLとのインターフェイスはTinycobolのtest.codeディレクトリのtdb02.cobの方法を そのまま利用しております。
(tdb02a.cというC言語のプログラムでインターフェイスを取っています。)
今回は見た目(GUIの部分)は変わりなしです。

開発環境 Red Hat 7.1 Tinycobol-0.54

GUIの部分は以前と変わり無しです。
Red Hat7.1になったので Tcl/Tkのバージョンが
変わりました。
tcl-8.3.1 tk-8.3.1です。




実行はPostgreSQLのユーザでXにログインし実行させます。
postmasterを起動させれば あとは今まで通り./unchin.tclで実行可能です。



データベース名  unchin

テーブル名     yamato

列名         サイズがsizeでinteger
            発地がhatでinteger
            着地がchkでinteger
            運賃がuncnでinteger


以下 作成方法を簡単に説明します。
1.unchinデータベース作成
$createdb unchin

2.yamatoテーブル作成
$psql unchin
unchin=> CREATE TABLE yamato (size integer,hat integer,chk integer,uncn integer);


左のログはPoatgreSQLにデータを登録するCOBOLプログラム(test01.cob)を実行させた時のログです。

前回までのyamato.cobのワーク部分オンコーディングテーブルを順番にINSERTする プログラムです。



実行方法は以下です。
postmasterを起動しpostgreSQLのユーザにてtest01を実行する。

上記で登録した後 SELECT分で内容を表示させてログです。
左からサイズ・発地・着地・運賃です。
初地と着地は以前までのyamato.cobの名残で地域を数字で表しています。

  以下にソースを紹介いたします。

まずはCOBOLでyamato.cobです。

赤字の部分がpostgreSQL関係で、紫の部分がCのプログラムをCALLしている個所です。

IDENTIFICATION DIVISION.
PROGRAM-ID. YAMATO.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.

WORKING-STORAGE SECTION.
01 WK-OUT PIC X(20).
01 CMDLINE-PARMS PIC X(64).
01 WK-PRONAME PIC X(10) VALUE '$$$$$$$$$$'.
01 WK-ACC01 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC02 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC03 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC04 PIC X(15) VALUE '$$$$$$$$$$$$$$$'.
01 WK-ACC05 PIC X(02) VALUE '$$'.
01 WK-ACC06 PIC X(02) VALUE '$$'.
01 A PIC X(15).
01 C PIC S9(12)V9(3).
01 JSW PIC 9.
01 WK-KWKKA.
03 WK-TATE PIC S9(06)V9(3).
03 WK-YOKO PIC S9(06)V9(3).
03 WK-TAKA PIC S9(06)V9(3).
03 WK-OMOS PIC S9(06)V9(3).
01 WK-SIZE1 PIC S9(06)V9(3).
01 WK-SIZE2 PIC S9(06)V9(3).
01 WK-SIZE PIC 9(03).
01 WK-3HEN PIC S9(06)V9(3).
01 WK-DKIN PIC ZZ,ZZZ,ZZ9.
01 WK-OUT PIC X(10).
01 I PIC 9(3).
01 J PIC 9(3).
01 WK-INDEXH PIC 9(3).
01 WK-INDEXC PIC 9(3).
77 DATABASE-NAME PIC X(80).
77 SQL-QUERY PIC X(200).
77 DB-HANDLE PIC 9(12) COMP.
77 QRY-HANDLE PIC 9(12) COMP.
77 NTUPLE PIC 9(12) COMP.
77 NFIELD PIC 9(12) COMP.
77 MAX-TUPLE PIC 9(12) COMP.
77 MAX-FIELD PIC 9(12) COMP.
77 COLUMN-VALUE PIC X(80) VALUE SPACES.
77 CMD PIC 9.
77 DB-STATUS PIC 9(12) COMP.
77 DB-MESSAGE Pic X(200).

01 MYTBL-RECORD PIC X(15).
01 WK-TBL.
03 WK-TBLVALUE.
05 FILLER PIC X(48) VALUE
"010202020303030404040404040404050506060607070707".
05 FILLER PIC X(46) VALUE
"0606060606060909090909101010101111111111111112".
03 WK-CHIKITBL REDEFINES WK-TBLVALUE.
05 WK-CHIKI PIC 9(02) OCCURS 47.
*
PROCEDURE DIVISION.
A-000.
ACCEPT CMDLINE-PARMS FROM COMMAND-LINE.
UNSTRING CMDLINE-PARMS DELIMITED BY ' ' INTO
WK-PRONAME WK-ACC01 WK-ACC02 WK-ACC03 WK-ACC04 WK-ACC05 WK-ACC06.
** 縦 **
MOVE WK-ACC01 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-TATE.
** 横 **
MOVE WK-ACC02 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-YOKO.
** 高さ **
MOVE WK-ACC03 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-TAKA.
** 重量 **
MOVE WK-ACC04 TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-OMOS.
** 発地 **
MOVE WK-ACC05 TO WK-INDEXH.
** 着地 **
MOVE WK-ACC06 TO WK-INDEXC.
*
** サイズチェック **
COMPUTE WK-3HEN = WK-TATE + WK-YOKO + WK-TAKA.
IF WK-3HEN NOT > 60
MOVE 60 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 80
MOVE 80 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 100
MOVE 100 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 120
MOVE 120 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 140
MOVE 140 TO WK-SIZE1
ELSE
IF WK-3HEN NOT > 160
MOVE 160 TO WK-SIZE1
ELSE
MOVE "サイズ オーバー" TO WK-OUT
GO TO A-999.
*
IF WK-OMOS NOT > 2000
MOVE 60 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 5000
MOVE 80 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 10000
MOVE 100 TO WK-SIZE
ELSE
IF WK-OMOS NOT > 15000
MOVE 120 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 20000
MOVE 140 TO WK-SIZE2
ELSE
IF WK-OMOS NOT > 25000
MOVE 160 TO WK-SIZE2
ELSE
MOVE "重量 オーバー" TO WK-OUT
GO TO A-999.
*
IF WK-SIZE1 > WK-SIZE2
MOVE WK-SIZE1 TO WK-SIZE
ELSE
MOVE WK-SIZE2 TO WK-SIZE.
*
*---- FROM INDEX SET ----*
COMPUTE WK-INDEXH = WK-INDEXH + 1.
MOVE WK-CHIKI(WK-INDEXH) TO I.
*---- TO INDEX SET ----*
COMPUTE WK-INDEXC = WK-INDEXC + 1.
MOVE WK-CHIKI(WK-INDEXC) TO J.
*
*
*---- DB CONNECT ----*
MOVE "unchin" TO DATABASE-NAME.
CALL "
sql_connect_db" USING DATABASE-NAME
DB-HANDLE
DB-STATUS.
IF DB-STATUS NOT = ZEROS
DISPLAY "Error in database connection!"
STOP RUN.

*
*---- DB SELECT ----*
STRING "select uncn from yamato where size = " WK-SIZE
" and hat = " I
" and chk = " J
" ;;" INTO SQL-QUERY.

*
CALL "sql_exec_query" USING DB-HANDLE
SQL-QUERY
QRY-HANDLE
DB-STATUS.
IF (DB-STATUS NOT = 1 AND
DB-STATUS NOT = 2)
MOVE SPACES TO DB-MESSAGE
CALL "
sql_status_message" USING DB-HANDLE
DB-MESSAGE
DISPLAY DB-MESSAGE.

*
CALL "sql_max_tuple" USING QRY-HANDLE
MAX-TUPLE.
CALL "
sql_max_field" USING QRY-HANDLE
MAX-FIELD.
MOVE ZERO TO NTUPLE
PERFORM UNTIL NTUPLE = MAX-TUPLE
CALL "
sql_get_tuple" USING QRY-HANDLE
NTUPLE
MYTBL-RECORD
ADD 1 TO NTUPLE
END-PERFORM.

*
CALL "sql_clear_query" USING QRY-HANDLE.
*
*---- DB DISCONNECT ----*
CALL "sql_disconnect_db" USING DB-HANDLE.
*
** 縦 **
MOVE MYTBL-RECORD TO A.
MOVE ZERO TO C.
CALL "SUBX" USING A C JSW.
MOVE C TO WK-DKIN.
MOVE WK-DKIN TO WK-OUT.
A-999.
DISPLAY WK-OUT.
EXIT-PROGRAM.
データ作成用のCOBOLプログラム test01.cobです。
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST01.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
FILE SECTION.

WORKING-STORAGE SECTION.
01 I PIC 9(2).
01 J PIC 9(2).
01 WT-TBL.
03 WT-60DAT.
05 WT-60DAT1 PIC X(48) VALUE
"074009501050116011601260126014701580168017901890".
05 WT-60DAT2 PIC X(48) VALUE
"095007400740084008400950095010501160126013701580".
05 WT-60DAT3 PIC X(48) VALUE
"105007400740074007400840084009501160126013701470".
05 WT-60DAT4 PIC X(48) VALUE
"116008400740074007400740074008400950105011601260".
05 WT-60DAT5 PIC X(48) VALUE
"116008400740074007400740074008400950105011601370".
05 WT-60DAT6 PIC X(48) VALUE
"126009500840074007400740074007400840095009501260".
05 WT-60DAT7 PIC X(48) VALUE
"126009500840074007400740074007400840095009501370".
05 WT-60DAT8 PIC X(48) VALUE
"126009500840074007400740074007400840095009501370".
05 WT-60DAT9 PIC X(48) VALUE
"158011601160095009500840084007400740084007401260".
05 WT-60DAT10 PIC X(48) VALUE
"168012601260105010500950095008400840074008401260".
05 WT-60DAT11 PIC X(48) VALUE
"179013701370116011600950095008400740084007401160".
05 WT-60DAT12 PIC X(48) VALUE
"189015801470126013701260137012601260126011600740".
03 WT-60TBL.
05 WT-60TBLX OCCURS 12.
07 WT-60KIN PIC 9(04) OCCURS 12.
01 WT-80.
03 WT-80DAT.
05 WT-80DAT1 PIC X(48) VALUE
"095011601260137013701470147016801790189020002420".
05 WT-80DAT2 PIC X(48) VALUE
"116009500950105010501160116012601370147015802100".
05 WT-80DAT3 PIC X(48) VALUE
"126009500950095009501050105011601370147015802000".
05 WT-80DAT4 PIC X(48) VALUE
"137010500950095009500950095010501160126013701790".
05 WT-80DAT5 PIC X(48) VALUE
"137010500950095009500950095010501160126013701890".
05 WT-80DAT6 PIC X(48) VALUE
"147011601050095009500950095009501050116011601790".
05 WT-80DAT7 PIC X(48) VALUE
"147011601050095009500950095009501050116011601890".
05 WT-80DAT8 PIC X(48) VALUE
"168012601160105010500950095009500950105010501790".
05 WT-80DAT9 PIC X(48) VALUE
"179013701370116011601050105009500950105009501790".
05 WT-80DAT10 PIC X(48) VALUE
"189014701470126012601160116010501050095010501790".
05 WT-80DAT11 PIC X(48) VALUE
"200015801580137013701160116010500950105009501680".
05 WT-80DAT12 PIC X(48) VALUE
"242021002000179018901790189017901790179016800950".
03 WT-80TBL.
05 WT-80TBLX OCCURS 12.
07 WT-80KIN PIC 9(04) OCCURS 12.
01 WT-100.
03 WT-100DAT.
05 WT-100DAT1 PIC X(48) VALUE
"116013701470158015801680168018902000210022102940".
05 WT-100DAT2 PIC X(48) VALUE
"137011601160126012601370137014701580168017902630".
05 WT-100DAT3 PIC X(48) VALUE
"147011601160116011601260126013701580168017902520".
05 WT-100DAT4 PIC X(48) VALUE
"158012601160116011601160116012601370147015802310".
05 WT-100DAT5 PIC X(48) VALUE
"158012601160116011601160116012601370147015802420".
05 WT-100DAT6 PIC X(48) VALUE
"168013701260116011601160116011601260137013702310".
05 WT-100DAT7 PIC X(48) VALUE
"168013701260116011601160116011601260137013702420".
05 WT-100DAT8 PIC X(48) VALUE
"189014701370126012601160116011601160126012602310".
05 WT-100DAT9 PIC X(48) VALUE
"200015801580137013701260126011601160126011602310".
05 WT-100DAT10 PIC X(48) VALUE
"210016801680147014701370137012601260116012602310".
05 WT-100DAT11 PIC X(48) VALUE
"221017901790158015801370137012601160126011602210".
05 WT-100DAT12 PIC X(48) VALUE
"294026302520231024202310242023102310231022101160".
03 WT-100TBL.
05 WT-100TBL1 PIC 9(04) OCCURS 12.
07 WT-100KIN PIC 9(04) OCCURS 12.
01 WT-120.
03 WT-120DAT.
05 WT-120DAT1 PIC X(48) VALUE
"137015801680179017901890189021002210231024203470".
05 WT-120DAT2 PIC X(48) VALUE
"158013701370147014701580158016801790189020003150".
05 WT-120DAT3 PIC X(48) VALUE
"168013701370137013701470147015801790189020003050".
05 WT-120DAT4 PIC X(48) VALUE
"179014701370137013701370137014701580168017902840".
05 WT-120DAT5 PIC X(48) VALUE
"179014701370137013701370137014701580168017902940".
05 WT-120DAT6 PIC X(48) VALUE
"189015801470137013701370137013701470158015802840".
05 WT-120DAT7 PIC X(48) VALUE
"189015801470137013701370137013701470158015802940".
05 WT-120DAT8 PIC X(48) VALUE
"210016801580147014701370137013701370147014702840".
05 WT-120DAT9 PIC X(48) VALUE
"221017901790158015801470147013701370147013702840".
05 WT-120DAT10 PIC X(48) VALUE
"231018901890168016801580158014701470137014702840".
05 WT-120DAT11 PIC X(48) VALUE
"242020002000179017901580158014701370147013702730".
05 WT-120DAT12 PIC X(48) VALUE
"347031503050284029402840294028402840284027301370".
03 WT-120TBL.
05 WT-120TBL1 PIC 9(04) OCCURS 12.
07 WT-120KIN PIC 9(04) OCCURS 12.
01 WT-140.
03 WT-140DAT.
05 WT-140DAT1 PIC X(48) VALUE
"158017901890200020002100210023102420252026303990".
05 WT-140DAT2 PIC X(48) VALUE
"179015801580168016801790179018902000210022103680".
05 WT-140DAT3 PIC X(48) VALUE
"189015801580158015801680168017902000210022103570".
05 WT-140DAT4 PIC X(48) VALUE
"200016801580158015801580158016801790189020003360".
05 WT-140DAT5 PIC X(48) VALUE
"200016801580158015801580158016801790189020003470".
05 WT-140DAT6 PIC X(48) VALUE
"210017901680158015801580158015801680179017903360".
05 WT-140DAT7 PIC X(48) VALUE
"210017901680158015801580158015801680179017903470".
05 WT-140DAT8 PIC X(48) VALUE
"231018901790168016801580158015801580168016803360".
05 WT-140DAT9 PIC X(48) VALUE
"242020002000179017901680168015801580168015803360".
05 WT-140DAT10 PIC X(48) VALUE
"252021002100189018901790179016801680158016803360".
05 WT-140DAT11 PIC X(48) VALUE
"263022102210200020001790179016801580168015803260".
05 WT-140DAT12 PIC X(48) VALUE
"399036803570336034703360347033603360336032601580".
03 WT-140TBL.
05 WT-140TBL1 PIC 9(04) OCCURS 12.
07 WT-140KIN PIC 9(04) OCCURS 12.
01 WT-160.
03 WT-160DAT.
05 WT-160DAT1 PIC X(48) VALUE
"179020002100221022102310231025202630273028404520".
05 WT-160DAT2 PIC X(48) VALUE
"200017901790189018902000200021002210231024204200".
05 WT-160DAT3 PIC X(48) VALUE
"210017901790179017901890189020002210231024204100".
05 WT-160DAT4 PIC X(48) VALUE
"221018901790179017901790179018902000210022103890".
05 WT-160DAT5 PIC X(48) VALUE
"221018901790179017901790179018902000210022103990".
05 WT-160DAT6 PIC X(48) VALUE
"231020001890179017901790179017901890200020003890".
05 WT-160DAT7 PIC X(48) VALUE
"231020001890179017901790179017901890200020003990".
05 WT-160DAT8 PIC X(48) VALUE
"252021002000189018901790179017901790189018903890".
05 WT-160DAT9 PIC X(48) VALUE
"263022102210200020001890189017901790189017903890".
05 WT-160DAT10 PIC X(48) VALUE
"273023102310210021002000200018901890179018903890".
05 WT-160DAT11 PIC X(48) VALUE
"284024202420221022102000200018901790189017903780".
05 WT-160DAT12 PIC X(48) VALUE
"452042004100389039903890399038903890389037801790".
03 WT-160TBL.
05 WT-160TBL1 PIC 9(04) OCCURS 12.
07 WT-160KIN PIC 9(04) OCCURS 12.
77 DATABASE-NAME PIC X(80).
77 SQL-QUERY PIC X(200).
77 DB-HANDLE PIC 9(12) COMP.
77 DB-STATUS PIC 9(12) COMP.
77 DB-MESSAGE PIC X(80) COMP.
77 QRY-HANDLE PIC 9(12) COMP.
01 WK-INSERT.
03 WK-INS01 PIC X(28) VALUE
"INSERT INTO yamato VALUES (".
03 WK-INS02 PIC 9(03).
03 WK-INS03 PIC X(01) VALUE
",".
03 WK-INS04 PIC 9(02).
03 WK-INS05 PIC X(01) VALUE
",".
03 WK-INS06 PIC 9(02).
03 WK-INS07 PIC X(01) VALUE
",".
03 WK-INS08 PIC 9(04).
03 WK-INS09 PIC X(03) VALUE
");;".
PROCEDURE DIVISION.
A-000.
MOVE "unchin" to DATABASE-NAME.
CALL "sql_connect_db" USING DATABASE-NAME DB-HANDLE DB-STATUS.
IF DB-STATUS not = zeros
display "Error in database connection!"
stop run.
MOVE WT-60DAT TO WT-60TBL.
MOVE WT-80DAT TO WT-80TBL.
MOVE WT-100DAT TO WT-100TBL.
MOVE WT-120DAT TO WT-120TBL.
MOVE WT-140DAT TO WT-140TBL.
MOVE WT-160DAT TO WT-160TBL.
MOVE 0 TO I.
MOVE 1 TO J.
A-010.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-020.
MOVE 60 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-60KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-010.
A-020.
MOVE 0 TO I.
MOVE 1 TO J.
A-030.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-040.
MOVE 80 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-80KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-030.
A-040.
MOVE 0 TO I.
MOVE 1 TO J.
A-050.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-060.
MOVE 100 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-100KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-050.
A-060.
MOVE 0 TO I.
MOVE 1 TO J.
A-070.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-080.
MOVE 120 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-120KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-070.
A-080.
MOVE 0 TO I.
MOVE 1 TO J.
A-090.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-100.
MOVE 140 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-140KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-090.
A-100.
MOVE 0 TO I.
MOVE 1 TO J.
A-110.
ADD 1 TO I.
IF I > 12
MOVE 1 TO I
ADD 1 TO J.
IF J > 12
GO TO A-999.
MOVE 160 TO WK-INS02.
MOVE J TO WK-INS04.
MOVE I TO WK-INS06.
MOVE WT-160KIN(J I) TO WK-INS08.
MOVE WK-INSERT TO SQL-QUERY.
DISPLAY SQL-QUERY.
call "sql_exec_query" using
DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
* display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE.
GO TO A-110.
A-999.
call "sql_disconnect_db" using DB-HANDLE.
stop run.


Tcl/Tkは今回変わり無しですので省略致します。