SQL組込みプログラミングを見たことがないという人のために
基本となるSQL組込みプログラミングの例を紹介する。
これはSQL組込みプログラミングとして注意点も含めて
いつでも参照して頂きたい。
ここでは担当者マスター(TANTOM) と部課マスター(BUKAM)を
結合して一覧表にして印刷出力する例を紹介する。
サンプル・ライブラリー: QTRFIL を導入しているユーザーであれば
担当者マスター(TANTOM) と部課マスター(BUKAM)はそのまま利用することが
できる。
またサンプル・ライブラリーは
ここからダウンロードすることができる。
担当者マスター(TANTOM)のDDSソースは
0001.00 A**********************************************
0002.00 A* TANTOM : 担当者マスターファイル *
0003.00 A**********************************************
0004.00 A UNIQUE
0005.00 A R @TANTOM
0006.00 A*
0007.00 A TACODE 4A COLHDG(' 担当者 ｺｰﾄﾞ')
0008.00 A TTNAM 8O COLHDG(' 担当者略名 ')
0009.00 A TTNAMJ 22O COLHDG(' 担当者名 ')
0010.00 A TEXT(' 給与 ﾏｽﾀｰ.DJAPKN より ')
0011.00 A TBCODE 2A COLHDG(' 部課 ｺｰﾄﾞ')
0012.00 A TEXT('99= 全社 ')
0013.00 A TASHCD 5A COLHDG(' 社員 ｺｰﾄﾞ')
0014.00 A TAKBN 1A COLHDG(' 作業区分 ')
0015.00 A TEXT(' 空白 = 直接 ;1= 間接 ')
0016.00 A TADELT 1A COLHDG(' 削除区分 ')
0017.00 A TADLDT 6S 0 COLHDG(' 削除日 ')
0018.00 A TAINCD 5A COLHDG(' 登録者 ')
0019.00 A TAINDT 6S 0 COLHDG(' 登録日 ')
0020.00 A*
0021.00 A K TACODE
担当者マスター(TANTOM)のデータは
担当者 ｺｰﾄﾞ 担当者略名 担当者名 部課 ｺｰﾄﾞ 社員 ｺｰﾄﾞ 作業区分
000001 1201 池田宏 池田 宏司 12 00524 1
000002 1202 内海 内海 政行 12 00258 1
000003 1203 安高 安高 徳秀 12 00547 1
000004 1205 宮島 宮島 拓也 12 00481 1
000005 1206 市川 市川 勝喜 12 00439 1
000006 1207 綿井 綿井 千鶴 12 00473 1
000007 1208 小谷 小谷 博美 12 00530 1
000008 1209 宗政 宗政 剛 12 00574 1
000009 1210 天井 天井 誠一 12 00254 1
000010 1211 永井 永井 一雄 12 00140 1
:
:
部課マスターのDDSソースは
0001.00 A**********************************************
0002.00 A* BUKAM : 部課マスターファイル *
0003.00 A**********************************************
0004.00 A UNIQUE
0005.00 A R @BUKAM
0006.00 A*
0007.00 A BKCODE 2A COLHDG(' 部課コード ')
0008.00 A BKNAME 10O COLHDG(' 部課名 ')
0009.00 A TEXT(' 漢字 ')
0010.00 A BKHOUR 3S 0 COLHDG(' 当月労働時間 ')
0011.00 A BKRATE 5S 0 COLHDG(' 時間当賃金 ')
0012.00 A*
0013.00 A K BKCODE
部課マスターのデータは
部課 ｺｰﾄﾞ 部課名 当月労働時間計 時間当賃金
000001 11 役員 0 0
000002 12 総務部 0 0
000003 21 国内営業 0 0
000004 22 貿易部 0 0
000005 23 大型映像 0 0
000006 30 技術部 0 0
000007 50 原価係 0 0
000008 51 調達課 0 0
000009 53 サービス 0 0
000010 54 精密研磨 0 0
000011 56 組立調整 0 0
000012 57 ソフト部 0 0
000013 58 ＥＧ部 0 0
000014 59 大型映像 0 0
000015 91 製造 0 0
000016 92 管理販売 0 0
000017 99 その他 0 0
:
:
SQLPRINT: SQL組込みプログラミングのRPGソース
ソース仕様タイプ : SQLRPGLE ( SEU でこのタイプを指定する )
ソースはこちらで
0001.00 H DEBUG DFTNAME(SQLPRINT) DATEDIT(*YMD/)
0002.00 F********** SQL 担当者マスター一覧表 *****************************
0003.00 FQPRINT O F 132 PRINTER OFLIND(*INOF)
0004.00 F FORMLEN(66)
0005.00 F FORMOFL(62)
0006.00 F*****************************************************************
0007.00 *[ COMPILE ]
0008.00 * CRTSQLRPGI QTEMP/SQLPRINT SRCFILE(QTRSRC/QRPGLESRC) COMMIT(*NONE)
0009.00 * OBJTYPE(*MODULE) OUTPUT(*PRINT)
0010.00 * CRTPGM QTROBJ/SQLPRINT MODULE(QTEMP/SQLPRINT) ACTGRP(*NEW) AUT(*ALL)
0011.00 *
0012.00 *[ 実行 ]
0013.00 * CALL QTROBJ/SQLPRINT
0014.00
0015.00 D HDR S 32 DIM(1) CTDATA PERRCD(1) 見出し
0016.00 D LIN S 1 DIM(132)
0017.00 D KENSU S 4S 0
0018.00 D TBCODE_B S 2A
0019.00 D*( データ・ベース外部データ構造 )
0020.00 D FMT001 E DS EXTNAME(TANTOM)
0021.00 D FMT002 E DS EXTNAME(BUKAM)
0022.00 D RCDDTA DS OCCURS(9999)
0023.00 D VAR1 1 1024
0024.00 D N S 4B 0
0025.00 C******************************************************
0026.00 C* SQL 文のカーソルの前準備
0027.00 C******************************************************
0028.00 C* SELECT 文によってカーソル C1 を用意
0029.00 C/EXEC SQL DECLARE C1 CURSOR FOR
0030.00 C+ SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME
0031.00 C+ FROM QTRFIL/TANTOM, QTRFIL/BUKAM
0032.00 C+ WHERE TBCODE = BKCODE
0033.00 C+ ORDER BY TBCODE, TACODE
0034.00 C/END-EXEC
0035.00 C* カーソルをオープン
0036.00 C/EXEC SQL OPEN C1
0037.00 C/END-EXEC
0038.00 C******************************************************
0039.00 C* 明 細 演 算
0040.00 C******************************************************
0041.00 C/EXEC SQL WHENEVER NOT FOUND GOTO EOF
0042.00 C/END-EXEC
0043.00 C 1 DO *HIVAL N
0044.00 C N OCCUR RCDDTA
0045.00 C/EXEC SQL
0046.00 C+ FETCH C1 INTO :TACODE, :TTNAMJ, :TBCODE, :TTNAM, :BKNAME
0047.00 C/END-EXEC
0048.00 C*( 明細印刷 )
0049.00 C* TACODE CAT(P) TTNAMJ:0 RCDDTA
0050.00 C MOVEL(P) TACODE RCDDTA
0051.00 C CAT TTNAMJ:0 RCDDTA
0052.00 C/EXEC SQL SET RESULT SETS ARRAY :RCDDTA FOR :N ROWS
0053.00 C/END-EXEC
0054.00 C*------------------------------------------------------------------
0055.00 C SETON 42
0056.00 C EXSR OUTPUT
0057.00 C*------------------------------------------------------------------
0058.00 C ADD 1 KENSU
0059.00 C ENDDO
0060.00 C EOF TAG
0061.00 C* カーソルをクローズ
0062.00 C/EXEC SQL CLOSE C1
0063.00 C/END-EXEC
0064.00 C END TAG
0065.00 C*------------------------------------------------------------------
0066.00 C SETON 49
0067.00 C EXSR OUTPUT
0068.00 C*------------------------------------------------------------------
0069.00 C SETON LR
0070.00 C******************************************************
0071.00 C *INZSR BEGSR
0072.00 C******************************************************
0073.00 C* 初期のみの実行
0074.00 C CLEAR FMT001
0075.00 C MOVEA *ALL'-' LIN
0076.00 C INZEND ENDSR
0077.00 C******************************************************
0078.00 C OUTPUT BEGSR
0079.00 C******************************************************
0080.00 C TBCODE IFNE TBCODE_B
0081.00 C SETOFF 40
0082.00 C ENDIF
0083.00 C N40 SETON 4041
0084.00 C EXCEPT
0085.00 C OF SETOFF 40OF
0086.00 C SETOFF 414243
0087.00 C SETOFF 444546
0088.00 C SETOFF 474849
0089.00 C MOVE TBCODE TBCODE_B
0090.00 C ENDSR
0091.00 OQPRINT E 41 2 06
0092.00 O UDATE Y 8
0093.00 O 14 ' 作成 '
0094.00 O HDR(1) 82
0095.00 O 128 'PAGE.'
0096.00 O PAGE Z 131
0097.00 O E 41 1
0098.00 O 12 ' 部課コード '
0099.00 O TBCODE 18
0100.00 O 24 ' 部課名 '
0101.00 O BKNAME 36
0102.00 O E 41 1
0103.00 O LIN 132
0104.00 O E 41 1
0105.00 O 14 ' 担当者コード '
0106.00 O 24 ' 担当者名 '
0107.00 O 44 ' 略名 '
0108.00 O E 41 1
0109.00 O LIN 132
0110.00 O E 42 2
0111.00 O TACODE 5
0112.00 O TTNAMJ 36
0113.00 O TTNAM 46
0114.00 O E 49 1
0115.00 O 40 ' 処理件数 '
0116.00 O 57 '. . . . . . . . .'
0117.00 O KENSU 2 65
0118.00 DR
0118.00 ** HDR
0119.00 担当者一覧表
[実行結果]
CALL QTROBJ/SQLPRINT
スプール・ファイルの表示
ファイル . . . : QPRINT ページ／行 1/6
制御 . . . . . . 桁 1 - 127
検索 . . . . . .
*...+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8....+....9....+....0....+....1....+....2....+..
20/02/27 作成 担当者一覧表 PAGE
部課コード 部課名 総務部
-------------------------------------------------------------------------------------------------------------------------------
担当者コード 担当者名 略名
-------------------------------------------------------------------------------------------------------------------------------
1201 池田 宏司 池田宏
1202 内海 政行 内海
1203 安高 徳秀 安高
1205 宮島 拓也 宮島
1206 市川 勝喜 市川
1207 綿井 千鶴 綿井
1208 小谷 博美 小谷
1209 宗政 剛 宗政
1210 天井 誠一 天井
1211 永井 一雄 永井
1212 沼能 喜之助 沼能
1213 増山 幸恵 増山
20/02/27 作成 担当者一覧表 PAGE
部課コード 部課名 国内営業
続く ...
F3= 終了 F12= 取消し F19= 左 F20= 右 F24= キーの続き
[解説]
ファイル仕様書にはデータ・ベースの記述がないことに注意。
0019.00 D*( データ・ベース外部データ構造 ) 0020.00 D FMT001 E DS EXTNAME(TANTOM) 0021.00 D FMT002 E DS EXTNAME(BUKAM)
としているのはフィールド名を利用する目的である。
0022.00 D RCDDTA DS OCCURS(9999) 0023.00 D VAR1 1 1024
は OCCURSによってデータ・ベースを保管するための構造体を定義している。
OCCURSは RPGではあまり使用されないが SQLではレコードを取り出して
記憶するために必要である。
OCCURS の詳細な説明はこちらで
0028.00 C* SELECT 文によってカーソル C1 を用意 0029.00 C/EXEC SQL DECLARE C1 CURSOR FOR 0030.00 C+ SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME 0031.00 C+ FROM QTRFIL/TANTOM, QTRFIL/BUKAM 0032.00 C+ WHERE TBCODE = BKCODE 0033.00 C+ ORDER BY TBCODE, TACODE 0034.00 C/END-EXEC
のように C+ の行で SQL文を記述しておくとコンパイル(CRTSQLRPGI)すると
この部分がAPIを呼び出すRPGソースに展開される。
展開の詳細については後でもう一度説明する。
0029.00 C/EXEC SQL DECLARE C1 CURSOR FOR
でカーソル C1 を次のように定義している。
0030.00 C+ SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME 0031.00 C+ FROM QTRFIL/TANTOM, QTRFIL/BUKAM 0032.00 C+ WHERE TBCODE = BKCODE 0033.00 C+ ORDER BY TBCODE, TACODE
は SQLのSELECT文で TACODE, TTNAMJ, … を担当者マスター(QTRFIL/TANTOM)と
部課マスター(QTRFIL/BUKAM)から部課コードが一致する( WHERE TBCODE = BKCODE )
ものだけを選択して部課コード(TBCODE)、担当者コード(TACODE)の順に(ORDER BY)
並べる。
なお SELECT での TACODE, TTNAMJ, …並びと後のFETCHのフィルードの記述は
一致していなければならない。
次に
0035.00 C* カーソルをオープン 0036.00 C/EXEC SQL OPEN C1 0037.00 C/END-EXEC
でカーソルをオープンする。
0041.00 C/EXEC SQL WHENEVER NOT FOUND GOTO EOF 0042.00 C/END-EXEC
で EOF(レコードの読取りの終わり)に達したら EOF にジャンプすることを
指示しておく。
0043.00 C 1 DO *HIVAL N
0044.00 C N OCCUR RCDDTA
0045.00 C/EXEC SQL
0046.00 C+ FETCH C1 INTO :TACODE, :TTNAMJ, :TBCODE, :TTNAM, :BKNAME
0047.00 C/END-EXEC
:
:
0052.00 C/EXEC SQL SET RESULT SETS ARRAY :RCDDTA FOR :N ROWS
0053.00 C/END-EXEC
:
0059.00 C ENDDO
0060.00 C EOF TAG
SQLのFETCH文はカーソルのデータを一行ずつ取り出すRPGのREAD命令のようなものである。
FETCH INTO で :TACODE, :TTNAMJ, … と SELECTで選択したのと同じフィールドの
順序で :TACODE, :TTNAMJ, …に書き込んでいく。
:TACODEのように :がフィールドの頭についているのはこれがデータ・ベースの
フィールドであることを表している。
つまり SQLのメモリ空間からデータ・ベースのフィールド値に値を入れている。
最後に
0061.00 C* カーソルをクローズ 0062.00 C/EXEC SQL CLOSE C1 0063.00 C/END-EXEC
でカーソルを閉じて終了する。
[コンパイル]
コンパイルは最初に
CRTSQLRPGI QTEMP/SQLPRINT SRCFILE(QTRSRC/QRPGLESRC) COMMIT(*NONE)
OBJTYPE(*MODULE) OUTPUT(*PRINT)
でモジュール(*MODULE)を作成しているがいきなり *PGM を作成するように
指示しても構わない。
ただし
COMMIT(*NONE)
COMMIT(*CHG)を指定するが多くのIBM iユーザーは
ジャーナルを使用しないケースが多いのでその場合は
COMMIT(*NONE)を指定する。
OUTPUT(*PRINT)
……… CRTSQLRPGIの省略値は OUTPUT(*NONE)であるが
コンパイル・リストが出力されないとSQL文の文法エラーが
あったときの原因を追究できないので必ず
OUTPUT(*PRINT) と指定しておくこと。
コンパイル・リストの一部を紹介しよう。
121 C*EXEC SQL DECLARE C1 CURSOR FOR 122 C* SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME 123 C* FROM QTRFIL/TANTOM, QTRFIL/BUKAM 124 C* WHERE TBCODE = BKCODE 125 C* ORDER BY TBCODE, TACODE 126 C*END-EXEC 127 C* カーソルをオープン 128 C*EXEC SQL OPEN C1 129 C*END-EXEC 130 C Z-ADD -4 SQLER6 131 C SQL_00002 IFEQ 0 132 C SQL_00003 ORNE *LOVAL 133 C CALL SQLROUTE 134 C PARM SQLCA 135 C PARM SQL_00000 136 C ELSE 137 C CALL SQLOPEN 138 C PARM SQLCA 139 C PARM SQL_00000 140 C END : :
SQLのRPGソースはいったん
QTEMP/QSQLTEMP1
というQTEMPのソース・ファイルに展開される。
そしてQTEMP/QSQLTEMP1からCRTRPGPGMコンパイラーが走るという仕組みになっている。
つまり本当は QTEMP/QSQLTEMP1にあるようなRPGソースをRPGプログラマーに書いて欲しいのだが
非常に複雑なためIBMが QTEMP/QSQLTEMP1 に展開してくれているのである。
121 C*EXEC SQL DECLARE C1 CURSOR FOR 122 C* SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME 123 C* FROM QTRFIL/TANTOM, QTRFIL/BUKAM 124 C* WHERE TBCODE = BKCODE 125 C* ORDER BY TBCODE, TACODE 126 C*END-EXEC
でわかるように C+ で記述したSQL文は完全にコメント・アウトされて
130 C Z-ADD -4 SQLER6 131 C SQL_00002 IFEQ 0 132 C SQL_00003 ORNE *LOVAL 133 C CALL SQLROUTE 134 C PARM SQLCA 135 C PARM SQL_00000 136 C ELSE 137 C CALL SQLOPEN 138 C PARM SQLCA 139 C PARM SQL_00000 140 C END
として展開されている。
ところでここでの注目は
133 C CALL SQLROUTE
である。
これらは
0067.00 D SQLROUTE C CONST('QSYS/QSQROUTE')
0068.00 D SQLOPEN C CONST('QSYS/QSQLOPEN')
0069.00 D SQLCLSE C CONST('QSYS/QSQLCLSE')
0070.00 D SQLCMIT C CONST('QSYS/QSQLCMIT')
として定義されているように QSYSにある SQLの実行APIである。
特に QSQROUTE という名前のAPIがSQL文を実行するAPIであり
QUERYもSQLも実行の中枢をなしているのはこの QSQROUTE というAPI(プログラム)
である。
このことからわかるように SQLやQUERYが導入されていない環境であっても
QSQROUTE は QSYSに存在しているので SQLやQUERYを実行することが
できることがわかる。
次は QTEMP/QSQLTEMP1に展開されたSQLPRINTのソースの全容である。
元のソースと比較してみて欲しい。
0001.00 H DEBUG DFTNAME(SQLPRINT) DATEDIT(*YMD/)
0002.00 F********** SQL 担当者マスター一覧表 *****************************
0003.00 FQPRINT O F 132 PRINTER OFLIND(*INOF)
0004.00 F FORMLEN(66)
0005.00 F FORMOFL(62)
0006.00 F*****************************************************************
0007.00 *[ COMPILE ]
0008.00 * CRTSQLRPGI QTEMP/SQLPRINT SRCFILE(QTRSRC/QRPGLESRC) COMMIT(*NONE)
0009.00 * OBJTYPE(*MODULE) OUTPUT(*PRINT)
0010.00 * CRTPGM QTROBJ/SQLPRINT MODULE(QTEMP/SQLPRINT) ACTGRP(*NEW) AUT(*ALL)
0011.00 *
0012.00 *[ 実行 ]
0013.00 * CALL QTROBJ/SQLPRINT
0014.00
0015.00 D HDR S 32 DIM(1) CTDATA PERRCD(1) 見出し
0016.00 D LIN S 1 DIM(132)
0017.00 D KENSU S 4S 0
0018.00 D TBCODE_B S 2A
0019.00 D*( データ・ベース外部データ構造 )
0020.00 D FMT001 E DS EXTNAME(TANTOM)
0021.00 D FMT002 E DS EXTNAME(BUKAM)
0022.00 D RCDDTA DS OCCURS(9999)
0023.00 D VAR1 1 1024
0024.00 D N S 4B 0
0025.00 C******************************************************
0026.00 C* SQL 文のカーソルの前準備
0027.00 C******************************************************
0028.00 C* SELECT 文によってカーソル C1 を用意
0029.00 D* SQL COMMUNICATION AREA
0030.00 D SQLCA DS
0031.00 D SQLCAID 8A INZ(X'0000000000000000')
0032.00 D SQLAID 8A OVERLAY(SQLCAID)
0033.00 D SQLCABC 10I 0
0034.00 D SQLABC 9B 0 OVERLAY(SQLCABC)
0035.00 D SQLCODE 10I 0
0036.00 D SQLCOD 9B 0 OVERLAY(SQLCODE)
0037.00 D SQLERRML 5I 0
0038.00 D SQLERL 4B 0 OVERLAY(SQLERRML)
0039.00 D SQLERRMC 70A
0040.00 D SQLERM 70A OVERLAY(SQLERRMC)
0041.00 D SQLERRP 8A
0042.00 D SQLERP 8A OVERLAY(SQLERRP)
0043.00 D SQLERR 24A
0044.00 D SQLER1 9B 0 OVERLAY(SQLERR:*NEXT)
0045.00 D SQLER2 9B 0 OVERLAY(SQLERR:*NEXT)
0046.00 D SQLER3 9B 0 OVERLAY(SQLERR:*NEXT)
0047.00 D SQLER4 9B 0 OVERLAY(SQLERR:*NEXT)
0048.00 D SQLER5 9B 0 OVERLAY(SQLERR:*NEXT)
0049.00 D SQLER6 9B 0 OVERLAY(SQLERR:*NEXT)
0050.00 D SQLERRD 10I 0 DIM(6) OVERLAY(SQLERR)
0051.00 D SQLWRN 11A
0052.00 D SQLWN0 1A OVERLAY(SQLWRN:*NEXT)
0053.00 D SQLWN1 1A OVERLAY(SQLWRN:*NEXT)
0054.00 D SQLWN2 1A OVERLAY(SQLWRN:*NEXT)
0055.00 D SQLWN3 1A OVERLAY(SQLWRN:*NEXT)
0056.00 D SQLWN4 1A OVERLAY(SQLWRN:*NEXT)
0057.00 D SQLWN5 1A OVERLAY(SQLWRN:*NEXT)
0058.00 D SQLWN6 1A OVERLAY(SQLWRN:*NEXT)
0059.00 D SQLWN7 1A OVERLAY(SQLWRN:*NEXT)
0060.00 D SQLWN8 1A OVERLAY(SQLWRN:*NEXT)
0061.00 D SQLWN9 1A OVERLAY(SQLWRN:*NEXT)
0062.00 D SQLWNA 1A OVERLAY(SQLWRN:*NEXT)
0063.00 D SQLWARN 1A DIM(11) OVERLAY(SQLWRN)
0064.00 D SQLSTATE 5A
0065.00 D SQLSTT 5A OVERLAY(SQLSTATE)
0066.00 D* END OF SQLCA
0067.00 D SQLROUTE C CONST('QSYS/QSQROUTE')
0068.00 D SQLOPEN C CONST('QSYS/QSQLOPEN')
0069.00 D SQLCLSE C CONST('QSYS/QSQLCLSE')
0070.00 D SQLCMIT C CONST('QSYS/QSQLCMIT')
0071.00 D SQFRD C CONST(2)
0072.00 D SQFCRT C CONST(8)
0073.00 D SQFOVR C CONST(16)
0074.00 D SQFAPP C CONST(32)
0075.00 D DS
0076.00 D SQL_00000 1 2B 0 INZ(128)
0077.00 D SQL_00001 3 4B 0 INZ(2)
0078.00 D SQL_00002 5 8B 0 INZ(0)
0079.00 D SQL_00003 9 9A INZ('0')
0080.00 D SQL_00004 10 127A
0081.00 D SQL_00005 128 128A
0082.00 D DS
0083.00 D SQL_00006 1 2B 0 INZ(128)
0084.00 D SQL_00007 3 4B 0 INZ(4)
0085.00 D SQL_00008 5 8B 0 INZ(0)
0086.00 D SQL_00009 9 9A INZ('0')
0087.00 D SQL_00010 10 127A
0088.00 D SQL_00011 129 132A
0089.00 D SQL_00012 133 154A
0090.00 D SQL_00013 155 156A
0091.00 D SQL_00014 157 164A
0092.00 D SQL_00015 165 174A
0093.00 D DS
0094.00 D SQL_00016 1 2B 0 INZ(128)
0095.00 D SQL_00017 3 4B 0 INZ(5)
0096.00 D SQL_00018 5 8B 0 INZ(0)
0097.00 D SQL_00019 9 9A INZ('0')
0098.00 D SQL_00020 10 127A
0099.00 D SQL_00021 128 128A
0100.00 D DS
0101.00 D SQL_00022 1 2B 0 INZ(128)
0102.00 D SQL_00023 3 4B 0 INZ(6)
0103.00 D SQL_00024 5 8B 0 INZ(0)
0104.00 D SQL_00025 9 9A INZ('0')
0105.00 D SQL_00026 10 127A
0106.00 D SQL_00027 128 128A
0107.00 C*EXEC SQL DECLARE C1 CURSOR FOR
0108.00 C* SELECT TACODE, TTNAMJ, TBCODE, TTNAM, BKNAME
0109.00 C* FROM QTRFIL/TANTOM, QTRFIL/BUKAM
0110.00 C* WHERE TBCODE = BKCODE
0111.00 C* ORDER BY TBCODE, TACODE
0112.00 C*END-EXEC
0113.00 C* カーソルをオープン
0114.00 C*EXEC SQL OPEN C1
0115.00 C*END-EXEC
0116.00 C Z-ADD -4 SQLER6
0117.00 C SQL_00002 IFEQ 0
0118.00 C SQL_00003 ORNE *LOVAL
0119.00 C CALL SQLROUTE
0120.00 C PARM SQLCA
0121.00 C PARM SQL_00000
0122.00 C ELSE
0123.00 C CALL SQLOPEN
0124.00 C PARM SQLCA
0125.00 C PARM SQL_00000
0126.00 C END
0127.00 C******************************************************
0128.00 C* 明 細 演 算
0129.00 C******************************************************
0130.00 C*EXEC SQL WHENEVER NOT FOUND GOTO EOF
0131.00 C*END-EXEC
0132.00 C 1 DO *HIVAL N
0133.00 C N OCCUR RCDDTA
0134.00 C*EXEC SQL
0135.00 C* FETCH C1 INTO :TACODE, :TTNAMJ, :TBCODE, :TTNAM, :BKNAME
0136.00 C*END-EXEC
0137.00 C Z-ADD -4 SQLER6
0138.00 C CALL SQLROUTE
0139.00 C PARM SQLCA
0140.00 C PARM SQL_00006
0141.00 C SQL_00009 IFEQ '1'
0142.00 C EVAL TACODE = SQL_00011
0143.00 C EVAL TTNAMJ = SQL_00012
0144.00 C EVAL TBCODE = SQL_00013
0145.00 C EVAL TTNAM = SQL_00014
0146.00 C EVAL BKNAME = SQL_00015
0147.00 C END
0148.00 C SQLCOD CABEQ 100 EOF
0149.00 C SQLSTT CABEQ '02000' EOF
0150.00 C*( 明細印刷 )
0151.00 C* TACODE CAT(P) TTNAMJ:0 RCDDTA
0152.00 C MOVEL(P) TACODE RCDDTA
0153.00 C CAT TTNAMJ:0 RCDDTA
0154.00 C*EXEC SQL SET RESULT SETS ARRAY :RCDDTA FOR :N ROWS
0155.00 C*END-EXEC
0156.00 C EVAL SQLER5 = N
0157.00 C 1 OCCUR RCDDTA
0158.00 C Z-ADD -4 SQLER6
0159.00 C CALL SQLROUTE
0160.00 C PARM SQLCA
0161.00 C PARM SQL_00016
0162.00 C PARM RCDDTA
0163.00 C SQLCOD CABEQ 100 EOF
0164.00 C SQLSTT CABEQ '02000' EOF
0165.00 C*------------------------------------------------------------------
0166.00 C SETON 42
0167.00 C EXSR OUTPUT
SEU==>
0168.00 C*------------------------------------------------------------------
0169.00 C ADD 1 KENSU
0170.00 C ENDDO
0171.00 C EOF TAG
0172.00 C* カーソルをクローズ
0173.00 C*EXEC SQL CLOSE C1
0174.00 C*END-EXEC
0175.00 C Z-ADD 6 SQLER6
0176.00 C SQL_00024 IFEQ 0
0177.00 C CALL SQLROUTE
0178.00 C PARM SQLCA
0179.00 C PARM SQL_00022
0180.00 C ELSE
0181.00 C CALL SQLCLSE
0182.00 C PARM SQLCA
0183.00 C PARM SQL_00022
0184.00 C END
0185.00 C SQLCOD CABEQ 100 EOF
0186.00 C SQLSTT CABEQ '02000' EOF
0187.00 C END TAG
0188.00 C*------------------------------------------------------------------
0189.00 C SETON 49
0190.00 C EXSR OUTPUT
0191.00 C*------------------------------------------------------------------
0192.00 C SETON LR
0193.00 C******************************************************
0194.00 C *INZSR BEGSR
0195.00 C******************************************************
0196.00 C* 初期のみの実行
0197.00 C CLEAR FMT001
0198.00 C MOVEA *ALL'-' LIN
0199.00 C INZEND ENDSR
0200.00 C******************************************************
0201.00 C OUTPUT BEGSR
0202.00 C******************************************************
0203.00 C TBCODE IFNE TBCODE_B
0204.00 C SETOFF 40
0205.00 C ENDIF
0206.00 C N40 SETON 4041
0207.00 C EXCEPT
0208.00 C OF SETOFF 40OF
0209.00 C SETOFF 414243
0210.00 C SETOFF 444546
0211.00 C SETOFF 474849
0212.00 C MOVE TBCODE TBCODE_B
0213.00 C ENDSR
0214.00 OQPRINT E 41 2 06
0215.00 O UDATE Y 8
0216.00 O 14 ' 作成 '
0217.00 O HDR(1) 82
0218.00 O 128 'PAGE.'
0219.00 O PAGE Z 131
0220.00 O E 41 1
0221.00 O 12 ' 部課コード '
0222.00 O TBCODE 18
0223.00 O 24 ' 部課名 '
0224.00 O BKNAME 36
0225.00 O E 41 1
0226.00 O LIN 132
0227.00 O E 41 1
0228.00 O 14 ' 担当者コード '
0229.00 O 24 ' 担当者名 '
0230.00 O 44 ' 略名 '
0231.00 O E 41 1
0232.00 O LIN 132
0233.00 O E 42 2
0234.00 O TACODE 5
0235.00 O TTNAMJ 36
0236.00 O TTNAM 46
0237.00 O E 49 1
0238.00 O 40 ' 処理件数 '
0239.00 O 57 '. . . . . . . . .'
0240.00 O KENSU 2 65
0241.00 DR
0241.00 ** HDR
0242.00 担当者一覧表