* 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