188 lines
6.8 KiB
Plaintext
188 lines
6.8 KiB
Plaintext
* Sample Skeleton SQL RPG program. This is a linear main program
|
|
* so there is no RPG cycle logic included. There is no RPG file
|
|
* IO. Data is read with SQL. It uses an SQL Cursor, but this is
|
|
* just one way to retrieve data with SQL.
|
|
*
|
|
* After *executable* SQL statements I check for the SQL States
|
|
* that I expect. Any unexpected state causes the program to dump
|
|
* and crash, because this requires investigation.
|
|
* Common states are defined below in SQL State Constants.
|
|
*
|
|
* Your shop error handling standards may be different and you
|
|
* may want to rewrite the SQLProblem procedure.
|
|
|
|
* Program reads table QIWS/QCUSTCDT which is on all(?) machines.
|
|
* Pass a two character State parameter, e.g. PARM('NY').
|
|
|
|
h Option(*NODEBUGIO:*SRCSTMT)
|
|
h DftActGrp(*no) ActGrp(*caller)
|
|
h main(SQL_SKEL)
|
|
|
|
*=== Prototypes ======================================
|
|
d SQL_SKEL pr extpgm('SQL_SKELM')
|
|
d 2a
|
|
|
|
d SQLProblem pr
|
|
d piSQLDebug 1024 varying value
|
|
|
|
D SndEscMsg pr
|
|
D piMsg 1024a Const Varying
|
|
|
|
D QMHSNDPM pr ExtPgm('QMHSNDPM')
|
|
D piMsgId 7a Const
|
|
D piMsgFile 20a Const
|
|
D piMsgData 1024a Const OPTIONS(*varsize)
|
|
D piMsgDataLgth 10i 0 Const
|
|
D piMsgType 10a Const
|
|
D piCallStk 10a Const
|
|
D piRelCallStk 10i 0 Const
|
|
D piRtnMsgKey 4a
|
|
D apiErrorDS 17a
|
|
|
|
*=== SQL State Constants =============================
|
|
d SQLSuccess c '00000'
|
|
d SQLNoData c '02000'
|
|
d SQLNoMoreData c '02000'
|
|
d SQLDupRecd c '23505'
|
|
d SQLRowLocked c '57033'
|
|
/free
|
|
|
|
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
|
* Main Program =
|
|
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
|
p SQL_SKEL B
|
|
d PI
|
|
d piState 2a
|
|
|
|
*=== Program (Global) Variables ======================
|
|
d InTbl e ds EXTNAME('QIWS/QCUSTCDT') template
|
|
|
|
d MyCusnum s like(cusnum)
|
|
d MyLstNam s like(lstnam)
|
|
d MyInit s like(init)
|
|
d MyState s like(state)
|
|
d MyBalDue s like(baldue)
|
|
d RecordsRead s 7p 0 Inz(0)
|
|
|
|
*=== Set SQL Options ===============================
|
|
* Note: Compile time only. Not executable.
|
|
exec sql set option datfmt=*iso,
|
|
closqlcsr=*endmod,
|
|
commit=*none;
|
|
*=== Cursor ========================================
|
|
exec sql declare DemoCursor cursor for
|
|
select
|
|
CUSNUM,
|
|
LSTNAM,
|
|
INIT,
|
|
STATE,
|
|
BALDUE
|
|
from QIWS/QCUSTCDT
|
|
where STATE = :piState
|
|
order by BALDUE desc
|
|
;
|
|
*=== Initialization ================================
|
|
exec sql open DemoCursor;
|
|
if SQLSTT <> SQLSuccess;
|
|
SQLProblem('open DemoCursor');
|
|
endif;
|
|
*=== Main Logic ====================================
|
|
exsr FetchCur;
|
|
dow SQLSTT = SQLSuccess;
|
|
RecordsRead += 1;
|
|
// Real program logic goes here <<<<<<<<<<
|
|
exsr FetchCur;
|
|
enddo;
|
|
*=== Termination ===================================
|
|
dsply ('Records read: ' + %char(RecordsRead) );
|
|
exec sql close DemoCursor;
|
|
if SQLSTT <> SQLSuccess;
|
|
SQLProblem('close DemoCursor');
|
|
endif;
|
|
*inlr = *on;
|
|
|
|
*=== Subroutines ===================================
|
|
|
|
*--- FetchCur --------------------------------------
|
|
* Get the next row from the cursor
|
|
* Returns: SQLSUCCESS, with data
|
|
* SQLNoMoreData, no data returned
|
|
begsr FetchCur;
|
|
exec sql fetch DemoCursor into
|
|
:MyCusNum,
|
|
:MyLstNam,
|
|
:MyInit,
|
|
:MyState,
|
|
:MyBalDue
|
|
;
|
|
if SQLSTT <> SQLSuccess
|
|
and SQLSTT <> SQLNoMoreData;
|
|
SQLProblem('fetch DemoCursor');
|
|
endif;
|
|
endsr;
|
|
|
|
/end-free
|
|
p SQL_SKEL e
|
|
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
|
* End of Main Program =
|
|
*=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
|
|
|
*=== Procedures ======================================
|
|
|
|
*=== SQLProblem ======================================
|
|
* For those "Never should happen" SQL errors.
|
|
* Issues DUMP(A) to dump memory, then ends program by
|
|
* sending an *ESCAPE message of the supplied debugging text.
|
|
p SQLProblem B
|
|
d SQLProblem PI
|
|
d piSQLDebug 1024 varying value
|
|
|
|
*--- Local Variables ---------------------------------
|
|
d wkSQLDebug s 1024 varying
|
|
|
|
/free
|
|
wkSQLDebug = 'Unexpected SQL error in: ' + piSQLDebug;
|
|
dump(a);
|
|
SndEscMsg(wkSqlDebug);
|
|
return;
|
|
/end-free
|
|
p SQLProblem E
|
|
|
|
*=== SndEscMsg =======================================
|
|
* Sends CPF9898 Escape message of the provided text.
|
|
P SndEscMsg B Export
|
|
|
|
D SndEscMsg PI
|
|
D piMsg 1024a Const Varying
|
|
|
|
*--- Parameters for QMHSNDPM -------------------------
|
|
D MsgId c const('CPF9898')
|
|
d MsgF c const('QCPFMSG *LIBL ')
|
|
d MsgType c const('*ESCAPE ')
|
|
d PgmQue c const('* ')
|
|
d InvCount c const(2)
|
|
d ApiError s 17a inz(X'00')
|
|
d RetMsgKey s 4a
|
|
D DataLen s 10i 0
|
|
|
|
*--- Local Variables ---------------------------------
|
|
D MsgData s 1024a
|
|
|
|
/FREE
|
|
DataLen = %len(PiMSG);
|
|
MsgData = piMsg;
|
|
QMHSNDPM(
|
|
MsgId :
|
|
MsgF :
|
|
MsgData :
|
|
DataLen :
|
|
MsgType :
|
|
PgmQue :
|
|
InvCount :
|
|
RetMsgKey :
|
|
APIError);
|
|
return ;
|
|
/end-free
|
|
P SndEscMsg E
|
|
|