Add SQL RPG Skeleton
This commit is contained in:
SJLennon
@@ -0,0 +1,175 @@
|
|||||||
|
**free
|
||||||
|
// 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').
|
||||||
|
|
||||||
|
ctl-opt option(*nodebugio:*srcstmt) dftactgrp(*no) actgrp(*caller)
|
||||||
|
main(sql_skel);
|
||||||
|
|
||||||
|
//=== Prototypes ======================================
|
||||||
|
dcl-pr QMHSNDPM extpgm('QMHSNDPM');
|
||||||
|
*n char(7) const; // MsgId
|
||||||
|
*n char(20) const; // MsgFile
|
||||||
|
*n char(1024) const options(*varsize); // MsgData
|
||||||
|
*n int(10) const; // MsgDataLgth
|
||||||
|
*n char(10) const; // MsgType
|
||||||
|
*n char(10) const; // CallStk
|
||||||
|
*n int(10) const; // RelCallStk
|
||||||
|
*n char(4); //RtnMsgKey
|
||||||
|
*n char(17); // apiErrorDS
|
||||||
|
end-pr;
|
||||||
|
|
||||||
|
//=== SQL State Constants =============================
|
||||||
|
dcl-c SQLSuccess '00000';
|
||||||
|
dcl-c SQLNoData '02000';
|
||||||
|
dcl-c SQLNoMoreData '02000';
|
||||||
|
dcl-c SQLDupRecd '23505';
|
||||||
|
dcl-c SQLRowLocked '57033';
|
||||||
|
|
||||||
|
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||||
|
// Main Program =
|
||||||
|
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||||
|
dcl-proc SQL_SKEL;
|
||||||
|
dcl-pi *n;
|
||||||
|
piState char(2);
|
||||||
|
end-pi;
|
||||||
|
|
||||||
|
//=== Program (Global) Variables ======================
|
||||||
|
dcl-ds InTbl extname('QIWS/QCUSTCDT') template end-ds;
|
||||||
|
|
||||||
|
dcl-s MyCusnum like(cusnum);
|
||||||
|
dcl-s MyLstNam like(lstnam);
|
||||||
|
dcl-s MyInit like(init);
|
||||||
|
dcl-s MyState like(state);
|
||||||
|
dcl-s MyBalDue like(baldue);
|
||||||
|
dcl-s RecordsRead packed(7) 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-proc;
|
||||||
|
//=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
|
||||||
|
// 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.
|
||||||
|
dcl-proc SQLProblem;
|
||||||
|
dcl-pi SQLProblem;
|
||||||
|
piSQLDebug varchar(1024) value;
|
||||||
|
end-pi;
|
||||||
|
|
||||||
|
//--- Local Variables ---------------------------------
|
||||||
|
dcl-s wkSQLDebug varchar(1024);
|
||||||
|
|
||||||
|
wkSQLDebug = 'Unexpected SQL error in: ' + piSQLDebug;
|
||||||
|
dump(a);
|
||||||
|
SndEscMsg(wkSqlDebug);
|
||||||
|
return;
|
||||||
|
end-proc;
|
||||||
|
|
||||||
|
//=== SndEscMsg =======================================
|
||||||
|
// Sends CPF9898 Escape message of the provided text.
|
||||||
|
dcl-proc SndEscMsg export ;
|
||||||
|
|
||||||
|
dcl-pi SndEscMsg extProc(*dclcase) ;
|
||||||
|
piMsg varchar(1024) const;
|
||||||
|
end-pi;
|
||||||
|
|
||||||
|
//--- Parameters for QMHSNDPM -------------------------
|
||||||
|
dcl-c MsgId const('CPF9898');
|
||||||
|
dcl-c MsgF const('QCPFMSG *LIBL ');
|
||||||
|
dcl-c MsgType const('*ESCAPE ');
|
||||||
|
dcl-c PgmQue const('* ');
|
||||||
|
dcl-c InvCount const(2);
|
||||||
|
dcl-s ApiError char(17) inz(x'00');
|
||||||
|
dcl-s RetMsgKey char(4);
|
||||||
|
dcl-s DataLen int(10);
|
||||||
|
|
||||||
|
//--- Local Variables ---------------------------------
|
||||||
|
dcl-s MsgData char(1024);
|
||||||
|
|
||||||
|
DataLen = %len(PiMSG);
|
||||||
|
MsgData = piMsg;
|
||||||
|
QMHSNDPM(
|
||||||
|
MsgId :
|
||||||
|
MsgF :
|
||||||
|
MsgData :
|
||||||
|
DataLen :
|
||||||
|
MsgType :
|
||||||
|
PgmQue :
|
||||||
|
InvCount :
|
||||||
|
RetMsgKey :
|
||||||
|
APIError);
|
||||||
|
return ;
|
||||||
|
end-proc;
|
||||||
@@ -0,0 +1,187 @@
|
|||||||
|
* 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
|
||||||
|
|
||||||
Reference in New Issue
Block a user