Examples: Create exit programs with CL commands
You can create IBM i exit programs using CL commands.
The following example illustrates how to set up a user exit program with control language (CL) commands.
Note: Read the Code example disclaimer for important legal information.
/******************************************************************/
/* */
/* IBM i - SAMPLE USER EXIT PROGRAM */
/* */
/* THE FOLLOWING CL PROGRAM UNCONDITIONALLY */
/* ACCEPTS ALL REQUESTS. IT CAN BE USED AS A SHELL FOR DEVELOPING */
/* EXIT PROGRAMS TAILORED FOR YOUR OPERATING ENVIRONMENT. */
/* */
/* */
/******************************************************************/
PGM PARM(&STATUS &REQUEST)
/* * * * * * * * * * * * * * * * * * * */
/* */
/* PROGRAM CALL PARAMETER DECLARATIONS */
/* */
/* * * * * * * * * * * * * * * * * * * */
DCL VAR(&STATUS) TYPE(*CHAR) LEN(1) /* Accept/Reject indicator */
DCL VAR(&REQUEST) TYPE(*CHAR) LEN(9999) /* Parameter structure. LEN(9999) is a CL limit.*/
/***********************************/
/* */
/* PARAMETER DECLARES */
/* */
/***********************************/
/* COMMON DECLARES */
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
/* User ID */
DCL VAR(&APPLIC) TYPE(*CHAR) LEN(10)
/* Server ID */
DCL VAR(&FUNCTN) TYPE(*CHAR) LEN(10) /* Function being performed */
/* VIRTUAL PRINT DECLARES */
DCL VAR(&VPOBJ) TYPE(*CHAR) LEN(10) /* Object name */
DCL VAR(&VPLIB) TYPE(*CHAR) LEN(10) /* Object library name */
DCL VAR(&VPLEN) TYPE(*DEC) LEN(5 0) /* Length of following fields*/
DCL VAR(&VPOUTQ) TYPE(*CHAR) LEN(10) /* Output queue name */
DCL VAR(&VPQLIB) TYPE(*CHAR) LEN(10) /* Output queue library name */
/* TRANSFER FUNCTION DECLARES */
DCL VAR(&TFOBJ) TYPE(*CHAR) LEN(10) /* Object name */
DCL VAR(&TFLIB) TYPE(*CHAR) LEN(10) /* Object library name */
DCL VAR(&TFMBR) TYPE(*CHAR) LEN(10) /* Member name */
DCL VAR(&TFFMT) TYPE(*CHAR) LEN(10) /* Record format name */
DCL VAR(&TFLEN) TYPE(*DEC) LEN(5 0) /* Length of request */
DCL VAR(&TFREQ) TYPE(*CHAR) LEN(1925) /*Transfer request
statement*/
/* FILE SERVER DECLARES */
DCL VAR(&FSFID) TYPE(*CHAR) LEN(4) /* Function identifier */
DCL VAR(&FSFMT) TYPE(*CHAR) LEN(8) /* Parameter format */
DCL VAR(&FSREAD) TYPE(*CHAR) LEN(1) /* Open for read */
DCL VAR(&FSWRITE) TYPE(*CHAR) LEN(1) /* Open for write */
DCL VAR(&FSRDWRT) TYPE(*CHAR) LEN(1) /* Open for read/write */
DCL VAR(&FSDLT) TYPE(*CHAR) LEN(1) /* Open for delete */
DCL VAR(&FSLEN) TYPE(*CHAR) LEN(4) /* fname length */
DCL VAR(&FSNAME) TYPE(*CHAR) LEN(2000) /* Qualified file name */
/* DATA QUEUE DECLARES */
DCL VAR(&DQQ) TYPE(*CHAR) LEN(10) /* Data queue name */
DCL VAR(&DQLIB) TYPE(*CHAR) LEN(10) /* Data queue library name */
DCL VAR(&DQLEN) TYPE(*DEC) LEN(5 0) /* Total request length */
DCL VAR(&DQROP) TYPE(*CHAR) LEN(2) /* Relational operator */
DCL VAR(&DQKLEN) TYPE(*DEC) LEN(5 0) /* Key length */
DCL VAR(&DQKEY) TYPE(*CHAR) LEN(256) /* Key value */
/* REMOTE SQL DECLARES */
DCL VAR(&RSOBJ) TYPE(*CHAR) LEN(10) /* Object name */
DCL VAR(&RSLIB) TYPE(*CHAR) LEN(10) /* Object library name */
DCL VAR(&RSCMT) TYPE(*CHAR) LEN(1) /* Commitment control level*/
DCL VAR(&RSMODE) TYPE(*CHAR) LEN(1) /* Block/Update mode indicator*/
DCL VAR(&RSCID) TYPE(*CHAR) LEN(1) /* Cursor ID */
DCL VAR(&RSSTN) TYPE(*CHAR) LEN(18) /* Statement name */
DCL VAR(&RSRSU) TYPE(*CHAR) LEN(4) /* Reserved */
DCL VAR(&RSREQ) TYPE(*CHAR) LEN(1925)/* SQL statement */
/* NETWORK PRINT SERVER DECLARES */
DCL VAR(&NPFMT) TYPE(*CHAR) LEN(8) /* Format name */
DCL VAR(&NPFID) TYPE(*CHAR) LEN(4) /* Function identifier*/
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT SPLF0l00 */
DCL VAR(&NPJOBN) TYPE(*CHAR) LEN(10)/* Job name */
DCL VAR(&NPUSRN) TYPE(*CHAR) LEN(10)/* User name */
DCL VAR(&NPJOB#) TYPE(*CHAR) LEN(6) /* Job number */
DCL VAR(&NPFILE) TYPE(*CHAR) LEN(10)/* File name */
DCL VAR(&NPFIL#) TYPE(*CHAR) LEN(4) /* File number */
DCL VAR(&NPLEN) TYPE(*CHAR) LEN(4) /* Data Length */
DCL VAR(&NPDATA) TYPE(*CHAR) LEN(2000) /* Data */
DCL VAR(&DBNUM) TYPE(*CHAR) LEN(4) /* Number of libraries */
DCL VAR(&DBLIB2) TYPE(*CHAR) LEN(10) /* Library name */
/* DATA QUEUE SERVER DECLARES */
DCL VAR(&DQFMT) TYPE(*CHAR) LEN(8) /* Format name */
DCL VAR(&DQFID) TYPE(*CHAR) LEN(4) /* Function IDENTIFIER */
DCL VAR(&DQOOBJ) TYPE(*CHAR) LEN(10) /* Object name */
DCL VAR(&DQOLIB) TYPE(*CHAR) LEN(10) /* Library name */
DCL VAR(&DQOROP) TYPE(*CHAR) LEN(2) /* Relational operator */
DCL VAR(&DQOLEN) TYPE(*CHAR) LEN(4) /* Key length */
DCL VAR(&DQOKEY) TYPE(*CHAR) LEN(256) /* Key */
/* CENTRAL SERVER DECLARES */
DCL VAR(&CSFMT) TYPE(*CHAR) LEN(8) /* Format name */
DCL VAR(&CSFID) TYPE(*CHAR) LEN(4) /* Function identifier */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCL0100 */
DCL VAR(&CSCNAM) TYPE(*CHAR) LEN(255) /* Unique client name */
DCL VAR(&CSLUSR) TYPE(*CHAR) LEN(8) /* License users handle */
DCL VAR(&CSPID) TYPE(*CHAR) LEN(7) /* Product identification */
DCL VAR(&CSFID) TYPE(*CHAR) LEN(4) /* Feature identification */
DCL VAR(&CSRID) TYPE(*CHAR) LEN(6) /* Release identification */
DCL VAR(&CSTYPE) TYPE(*CHAR) LEN(2) /* Type of information req */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCS0100 */
DCL VAR(&CSCNAM) TYPE(*CHAR) LEN(255) /* Unique client name */
DCL VAR(&CSCMTY) TYPE(*CHAR) LEN(255) /* Community name */
DCL VAR(&CSNODE) TYPE(*CHAR) LEN(1) /* Node type */
DCL VAR(&CSNNAM) TYPE(*CHAR) LEN(255) /* Node name */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCN0100 */
DCL VAR(&CSFROM) TYPE(*CHAR) LEN(4) /* From CCSID */
DCL VAR(&CSTO) TYPE(*CHAR) LEN(4) /* To CCSID */
DCL VAR(&CSCTYP) TYPE(*CHAR) LEN(2) /* Type of conversion */
/* DATABASE SERVER DECLARES */
DCL VAR(&DBFMT) TYPE(*CHAR) LEN(8) /* Format name */
DCL VAR(&DBFID) TYPE(*CHAR) LEN(4) /* Function identifier */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAD0100 */
DCL VAR(&DBFILE) TYPE(*CHAR) LEN(128) /* File name */
DCL VAR(&DBLIB) TYPE(*CHAR) LEN(10) /* Library name */
DCL VAR(&DBMBR) TYPE(*CHAR) LEN(10) /* Member name */
DCL VAR(&DBAUT) TYPE(*CHAR) LEN(10) /* Authority to file */
DCL VAR(&DBBFIL) TYPE(*CHAR) LEN(128) /* Based on file name */
DCL VAR(&DBBLIB) TYPE(*CHAR) LEN(10) /* Based on library name */
DCL VAR(&DBOFIL) TYPE(*CHAR) LEN(10) /* Override file name */
DCL VAR(&DBOLIB) TYPE(*CHAR) LEN(10) /* Override libraryname */
DCL VAR(&DBOMBR) TYPE(*CHAR) LEN(10) /* Override membername */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAD0200 */
DCL VAR(&DBNUM) TYPE(*CHAR) LEN(4) /* Number of libraries */
DCL VAR(&DBLIB2) TYPE(*CHAR) LEN(10) /* Library name */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAQ0100 */
DCL VAR(&DBSTMT) TYPE(*CHAR) LEN(18) /* Statement name */
DCL VAR(&DBCRSR) TYPE(*CHAR) LEN(18) /* Cursor name */
DCL VAR(&DBOPT) TYPE(*CHAR) LEN(2) /* Prepare option */
DCL VAR(&DBATTR) TYPE(*CHAR) LEN(2) /* Open attributes */
DCL VAR(&DBPKG) TYPE(*CHAR) LEN(10) /* Package name */
DCL VAR(&DBPLIB) TYPE(*CHAR) LEN(10) /* Package library name */
DCL VAR(&DBDRDA) TYPE(*CHAR) LEN(2) /* DRDA(R) indicator */
DCL VAR(&DBCMT) TYPE(*CHAR) LEN(1) /* Commit control level*/
DCL VAR(&DBTEXT) TYPE(*CHAR) LEN(512) /* First 512 bytes of stmt */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0100 */
DCL VAR(&DBLIBR) TYPE(*CHAR) LEN(20) /* Library name */
DCL VAR(&DBRDBN) TYPE(*CHAR) LEN(36) /* Relational Database name */
DCL VAR(&DBPKGR) TYPE(*CHAR) LEN(20) /* Package name */
DCL VAR(&DBFILR) TYPE(*CHAR) LEN(256) /* File name (SQL alias) */
DCL VAR(&DBMBRR) TYPE(*CHAR) LEN(20) /* Member name */
DCL VAR(&DBFFMT) TYPE(*CHAR) LEN(20) /* Format name */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0200 */
DCL VAR(&DBPLIB) TYPE(*CHAR) LEN(10) /* Primary key table lib */
DCL VAR(&DBPTBL) TYPE(*CHAR) LEN(128) /* Primary key table */
DCL VAR(&DBFLIB) TYPE(*CHAR) LEN(10) /* Foreign key table lib */
DCL VAR(&DBFTBL) TYPE(*CHAR) LEN(128) /* Foreign key table */
/* REMOTE COMMAND SERVER DECLARES */
DCL VAR(&RCFMT) TYPE(*CHAR) LEN(8) /* Format name */
DCL VAR(&RCFID) TYPE(*CHAR) LEN(4) /* Function identifier */
DCL VAR(&RCPGM) TYPE(*CHAR) LEN(10) /* Program name */
DCL VAR(&RCLIB) TYPE(*CHAR) LEN(10) /* Program library name */
DCL VAR(&RCNUM) TYPE(*CHAR) LEN(4) /* Number of parms or cmdlen*/
DCL VAR(&RCDATA) TYPE(*CHAR) LEN(9999)/* Command string nor
parms */
/* SIGNON SERVER DECLARES */
DCL VAR(&SOFMT) TYPE(*CHAR) LEN(8) /* Format name
*/
DCL VAR(&SOFID) TYPE(*CHAR) LEN(4) /* Function identifier
*/
/***********************************/
/* */
/* OTHER DECLARES */
/* */
/**********************************/
DCL VAR(&WRKLEN) TYPE(*CHAR) LEN(5)
DCL VAR(&DECLEN) TYPE(*DEC) LEN(8 0)
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*/ */
/* */
/* EXTRACT THE VARIOUS PARAMETERS FROM THE STRUCTURE */
/* */
/* * * * * * * * * * * * * * * * * * * * * * * * */
/* HEADER */
CHGVAR VAR(&USER) VALUE(%SST(&REQUEST 1 10))
CHGVAR VAR(&APPLIC) VALUE(%SST(&REQUEST 11 10))
CHGVAR VAR(&FUNCTN) VALUE(%SST(&REQUEST 21 10))
/* VIRTUAL PRINTER */
CHGVAR VAR(&VPOBJ) VALUE(%SST(&REQUEST 31 10))
CHGVAR VAR(&VPLIB) VALUE(%SST(&REQUEST 41 10))
CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5))
CHGVAR VAR(&VPLEN) VALUE(%BINARY(&WRKLEN 1 4))
CHGVAR VAR(&VPOUTQ) VALUE(%SST(&REQUEST 76 10))
CHGVAR VAR(&VPQLIB) VALUE(%SST(&REQUEST 86 10))
/* TRANSFER FUNCTION */
CHGVAR VAR(&TFOBJ) VALUE(%SST(&REQUEST 31 10))
CHGVAR VAR(&TFLIB) VALUE(%SST(&REQUEST 41 10))
CHGVAR VAR(&TFMBR) VALUE(%SST(&REQUEST 51 10))
CHGVAR VAR(&TFFMT) VALUE(%SST(&REQUEST 61 10))
CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5))
CHGVAR VAR(&TFLEN) VALUE(%BINARY(&WRKLEN 1 4))
CHGVAR VAR(&TFREQ) VALUE(%SST(&REQUEST 76 1925))
/* FILE SERVER */
CHGVAR VAR(&FSFID) VALUE(%SST(&REQUEST 21 4))
CHGVAR VAR(&FSFMT) VALUE(%SST(&REQUEST 25 8))
CHGVAR VAR(&FSREAD) VALUE(%SST(&REQUEST 33 1))
CHGVAR VAR(&FSWRITE) VALUE(%SST(&REQUEST 34 1))
CHGVAR VAR(&FSRDWRT) VALUE(%SST(&REQUEST 35 1))
CHGVAR VAR(&FSDLT) VALUE(%SST(&REQUEST 36 1))
CHGVAR VAR(&FSLEN) VALUE(%SST(&REQUEST 37 4))
CHGVAR VAR(&DECLEN) VALUE(%BINARY(&FSLEN 1 4))
CHGVAR VAR(&FSNAME) VALUE(%SST(&REQUEST 41
&DECLEN))
/* DATA QUEUES */
CHGVAR VAR(&DQQ) VALUE(%SST(&REQUEST 31 10))
CHGVAR VAR(&DQLIB) VALUE(%SST(&REQUEST 41 10))
CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5))
CHGVAR VAR(&DQLEN) VALUE(%BINARY(&WRKLEN 1 4))
CHGVAR VAR(&DQROP) VALUE(%SST(&REQUEST 76 2))
CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 78 5))
CHGVAR VAR(&DQKLEN) VALUE(&WRKLEN)
CHGVAR VAR(&DQKEY) VALUE(%SST(&REQUEST 83
&DQKLEN))
/* REMOTE SQL */
CHGVAR VAR(&RSOBJ) VALUE(%SST(&REQUEST 31 10))
CHGVAR VAR(&RSLIB) VALUE(%SST(&REQUEST 41 10))
CHGVAR VAR(&RSCMT) VALUE(%SST(&REQUEST 51 1))
CHGVAR VAR(&RSMODE) VALUE(%SST(&REQUEST 52 1))
CHGVAR VAR(&RSCID) VALUE(%SST(&REQUEST 53 1))
CHGVAR VAR(&RSSTN) VALUE(%SST(&REQUEST 54 18))
CHGVAR VAR(&RSRSU) VALUE(%SST(&REQUEST 72 4))
CHGVAR VAR(&RSREQ) VALUE(%SST(&REQUEST 76 1925))
/* NETWORK PRINT SERVER */
CHGVAR VAR(&NPFMT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&NPFID) VALUE(%SST(&REQUEST 29 4))
/* IF FORMAT IS SPLF0100 */
IF COND(&NPFMT *EQ 'SPLF0100') THEN(DO)
CHGVAR VAR(&NPJOBN) VALUE(%SST(&REQUEST 33 10))
CHGVAR VAR(&NPUSRN) VALUE(%SST(&REQUEST 43 10))
CHGVAR VAR(&NPJOB#) VALUE(%SST(&REQUEST 53 6))
CHGVAR VAR(&NPFILE) VALUE(%SST(&REQUEST 59 10))
CHGVAR VAR(&NPFIL#) VALUE(%SST(&REQUEST 69 4))
CHGVAR VAR(&NPLEN) VALUE(%SST(&REQUEST 73 4))
CHGVAR VAR(&DECLEN) VALUE(%BINARY(&NPLEN 1 4))
CHGVAR VAR(&NPDATA) VALUE(%SST(&REQUEST 77
&DECLEN))
ENDDO
/* DATA QUEUE SERVER */
CHGVAR VAR(&DQFMT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&DQFID) VALUE(%SST(&REQUEST 29 4))
CHGVAR VAR(&DQOOBJ) VALUE(%SST(&REQUEST 33 10))
CHGVAR VAR(&DQOLIB) VALUE(%SST(&REQUEST 43 10))
CHGVAR VAR(&DQOROP) VALUE(%SST(&REQUEST 53 2))
CHGVAR VAR(&DQOLEN) VALUE(%SST(&REQUEST 55 4))
CHGVAR VAR(&DQOKEY) VALUE(%SST(&REQUEST 59 256))
/* CENTRAL SERVER */
CHGVAR VAR(&CSFMT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&CSFID) VALUE(%SST(&REQUEST 29 4))
/* IF FORMAT IS ZSCL0100 */
IF COND(&CSFMT *EQ 'ZSCL0100') THEN(DO)
CHGVAR VAR(&CSCNAM) VALUE(%SST(&REQUEST 33 255))
CHGVAR VAR(&CSLUSR) VALUE(%SST(&REQUEST 288 8))
CHGVAR VAR(&CSPID) VALUE(%SST(&REQUEST 296 7))
CHGVAR VAR(&CSFID) VALUE(%SST(&REQUEST 303 4))
CHGVAR VAR(&CSRID) VALUE(%SST(&REQUEST 307 6))
CHGVAR VAR(&CSTYPE) VALUE(%SST(&REQUEST 313 2))
ENDDO
/* IF FORMAT IS ZSCS0100 */
IF COND(&CSFMT *EQ 'ZSCS0100') THEN(DO)
CHGVAR VAR(&CSCNAM) VALUE(%SST(&REQUEST 33 255))
CHGVAR VAR(&CSCMTY) VALUE(%SST(&REQUEST 288 255))
CHGVAR VAR(&CSNODE) VALUE(%SST(&REQUEST 543 1))
CHGVAR VAR(&CSNNAM) VALUE(%SST(&REQUEST 544 255))
ENDDO
/* IF FORMAT IS ZSCN0100 */
IF COND(&CSFMT *EQ 'ZSCN0100') THEN(DO)
CHGVAR VAR(&CSFROM) VALUE(%SST(&REQUEST 33 4))
CHGVAR VAR(&CSTO) VALUE(%SST(&REQUEST 37 4))
CHGVAR VAR(&CSCTYP) VALUE(%SST(&REQUEST 41 2))
ENDDO
/* DATABASE SERVER */
CHGVAR VAR(&DBFMT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&DBFID) VALUE(%SST(&REQUEST 29 4))
/* IF FORMAT IS ZDAD0100 */
IF COND(&CSFMT *EQ 'ZDAD0100') THEN(DO)
CHGVAR VAR(&DBFILE) VALUE(%SST(&REQUEST 33 128))
CHGVAR VAR(&DBLIB) VALUE(%SST(&REQUEST 161 10))
CHGVAR VAR(&DBMBR) VALUE(%SST(&REQUEST 171 10))
CHGVAR VAR(&DBAUT) VALUE(%SST(&REQUEST 181 10))
CHGVAR VAR(&DBBFIL) VALUE(%SST(&REQUEST 191 128))
CHGVAR VAR(&DBBLIB) VALUE(%SST(&REQUEST 319 10))
CHGVAR VAR(&DBOFIL) VALUE(%SST(&REQUEST 329 10))
CHGVAR VAR(&DBOLIB) VALUE(%SST(&REQUEST 339 10))
CHGVAR VAR(&DBOMBR) VALUE(%SST(&REQUEST 349 10))
ENDDO
/* IF FORMAT IS ZDAD0200 */
IF COND(&CSFMT *EQ 'ZDAD0200') THEN(DO)
CHGVAR VAR(&DBNUM) VALUE(%SST(&REQUEST 33 4))
CHGVAR VAR(&DBLIB2) VALUE(%SST(&REQUEST 37 10))
ENDDO
/* IF FORMAT IS ZDAQ0100 */
IF COND(&CSFMT *EQ 'ZDAQ0100') THEN DO
CHGVAR VAR(&DBSTMT) VALUE(%SST(&REQUEST 33 18))
CHGVAR VAR(&DBCRSR) VALUE(%SST(&REQUEST 51 18))
CHGVAR VAR(&DBSOPT) VALUE(%SST(&REQUEST 69 2))
CHGVAR VAR(&DBATTR) VALUE(%SST(&REQUEST 71 2))
CHGVAR VAR(&DBPKG) VALUE(%SST(&REQUEST 73 10))
CHGVAR VAR(&DBPLIB) VALUE(%SST(&REQUEST 83 10))
CHGVAR VAR(&DBDRDA) VALUE(%SST(&REQUEST 93 2))
CHGVAR VAR(&DBCMT) VALUE(%SST(&REQUEST 95 1))
CHGVAR VAR(&DBTEXT) VALUE(%SST(&REQUEST 96 512))
ENDDO
/* IF FORMAT IS ZDAR0100 */
IF COND(&CSFMT *EQ 'ZDAR0100') THEN DO
CHGVAR VAR(&DBLIBR) VALUE(%SST(&REQUEST 33 20))
CHGVAR VAR(&DBRDBN) VALUE(%SST(&REQUEST 53 36))
CHGVAR VAR(&DBPKGR) VALUE(%SST(&REQUEST 69 20))
CHGVAR VAR(&DBATTR) VALUE(%SST(&REQUEST 89 20))
CHGVAR VAR(&DBFULR) VALUE(%SST(&REQUEST 109 256))
CHGVAR VAR(&DBMBRR) VALUE(%SST(&REQUEST 365 20))
CHGVAR VAR(&DBFFMT) VALUE(%SST(&REQUEST 385 20))
ENDDO
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0200 */
/* IF FORMAT IS ZDAR0200 */
IF COND(&CSFMT *EQ 'ZDAR0200') THEN DO
CHGVAR VAR(&DBPLIB) VALUE(%SST(&REQUEST 33 10))
CHGVAR VAR(&DBPTBL) VALUE(%SST(&REQUEST 43 128))
CHGVAR VAR(&DBFLIB) VALUE(%SST(&REQUEST 171 10))
CHGVAR VAR(&DBFTBL) VALUE(%SST(&REQUEST 181 128))
ENDDO
/* REMOTE COMMAND SERVER */
CHGVAR VAR(&RCFMT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&RCFID) VALUE(%SST(&REQUEST 29 4))
CHGVAR VAR(&RCPGM) VALUE(%SST(&REQUEST 33 10))
CHGVAR VAR(&RCLIB) VALUE(%SST(&REQUEST 43 10))
CHGVAR VAR(&RCNUM) VALUE(%SST(&REQUEST 53 4))
CHGVAR VAR(&RCDATA) VALUE(%SST(&REQUEST 57 6000))
/* SIGNON SERVER DECLARES */
CHGVAR VAR(&SOFNT) VALUE(%SST(&REQUEST 21 8))
CHGVAR VAR(&SOFID) VALUE(%SST(&REQUEST 29 4))
/***********************************/
/* */
/* BEGIN MAIN PROGRAM */
/* */
CHGVAR VAR(&STATUS) VALUE('1') /* INITIALIZE RETURN +
VALUE TO ACCEPT THE REQUEST */
/* ADD LOGIC COMMON TO ALL SERVERS */
/* PROCESS BASED ON SERVER ID */
IF COND(&APPLIC *EQ '*VPRT') THEN(GOTO CMDLBL(VPRT)) /* IF VIRTUAL PRINTER */
IF COND(&APPLIC *EQ '*TFRFCL') THEN(GOTO CMDLBL(TFR)) /* IF TRANSFER FUNCTIO*/
IF COND(&APPLIC *EQ '*FILESRV') THEN(GOTO CMDLBL(FLR)) /* IF FILE SERVERS */
IF COND(&APPLIC *EQ '*MSGFCL') THEN(GOTO CMDLBL(MSG)) /* IF MESSAGING FUNCT */
IF COND(&APPLIC *EQ '*DQSRV') THEN(GOTO CMDLBL(DATAQ)) /* IF DATA QUEUES */
IF COND(&APPLIC *EQ '*RQSRV') THEN(GOTO CMDLBL(RSQL)) /* IF REMOTE SQL */
IF COND(&APPLIC *EQ '*SQL') THEN(GOTO CMDLBL(SQLINIT)) /* IF SQL */
IF COND(&APPLIC *EQ '*NDB') THEN(GOTO CMDLBL(NDB)) /* IF NATIVE DATABASE */
IF COND(&APPLIC *EQ '*SQLSRV') THEN(GOTO CMDLBL(SQLSRV)) /* IF SQL */
IF COND(&APPLIC *EQ '*RTVOBJINF') THEN(GOTO CMDLBL(RTVOBJ)) /* IF RETRIEVE OB*/
IF COND(&APPLIC *EQ '*DATAQSRV') THEN(GOTO CMDLBL(ODATAQ)) /* IF D*/
IF COND(&APPLIC *EQ 'QNPSERVR') THEN(GOTO CMDLBL(NETPRT)) /* IF NETWORK PRI*/
IF COND(&APPLIC *EQ '*CNTRLSRV') THEN(GOTO CMDLBL(CENTRAL)) /* IF CENTRAL SER*/
IF COND(&APPLIC *EQ '*RMTSRV') THEN(GOTO CMDLBL(RMTCMD)) /* IF RMTCMD/DPC */
IF COND(&APPLIC *EQ '*SIGNON') THEN(GOTO CMDLBL(SIGNON)) /* IF SIGNON */
GOTO EXIT
/* * * * * * * * * * * * * * * * * * * * * * */
/* SUBROUTINES */
/* */
/* * * * * * * * * * * * * * * * * * * * * * */
/* VIRTUAL PRlNTER */
VPRT:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* TRANSFER FUNCTION */
TFR:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* FILE SERVERS */
FLR:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* MESSAGING FUNCTION */
MSG:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* DATA QUEUES */
DATAQ:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* REMOTE SQL */
RSQL:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* DATABASE INIT */
SQLINIT:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* NATIVE DATABASE */
NDB:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* DATABASE SQL */
SQLSRV:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* RETRIEVE OBJECT INFORMATION */
RTVOBJ:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* DATA QUEUE SERVER */
ODATAQ:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* NETWORK PRINT SERVER */
NETPRT:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* CENTRAL SERVER */
CENTRAL:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* REMOTE COMMAND AND DISTRIBUTED PROGRAM CALL */
RMTCMD:
/* IN THIS CASE IF A USER ATTEMPTS TO DO A REMOTE COMMAND AND DISTRIBUTED */
/* PROGRAM CALL AND HAS A USERID OF userid THEY WILL NOT BE ALLOWED TO */
/* CONTINUE.
*/
IF COND(&USER *EQ 'userid') THEN(CHGVAR VAR(&STATUS) VALUE('0'))
GOTO EXIT
/* SIGNON SERVER */
SIGNON:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
EXIT:
ENDPGM