Appendix B: Server source code |
 |
By Jim Mason, Search400.com expert
29 Apr 2003 | Search400.com |
|
|
You can copy this source to an iSeries source physical file and create the program used in this example.
The CL program EMPGC01C
/*-------------------------------------------------------------------*/
/* EMPGC01C: RUN EMPGC01 AS STORED PROC IN LIB CCBS */
/* PARMS */
/* 1 EMPNO */
/* 2 PAY */
/* 3 FLAG */
/* */
/* ROUTINES */
/* F10 RUN CMD INTERACTIVELY */
/* */
/* PC# DATE AUTHOR DESC */
/*-------------------------------------------------------------------*/
/* 0001 02/02/01 J MASON INITIAL CREATE */
/*-------------------------------------------------------------------*/
PGM PARM(&LIBNAME &EMPNO &PAY &FLAG)
DCL VAR(&EMPNO) TYPE(*CHAR) LEN(6) +
VALUE('000070')
DCL VAR(&PAY) TYPE(*DEC) LEN(9 2)
DCL VAR(&FLAG) TYPE(*CHAR) LEN(5)
DCL VAR(&PAYC) TYPE(*CHAR) LEN(9)
DCL VAR(&LIBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&CMD) TYPE(*CHAR) LEN(80)
DCL VAR(&CMDSIZE) TYPE(*DEC) LEN(15 5)
DCL VAR(&CMDLEN) TYPE(*DEC) LEN(5 0)
DCL VAR(&RESULT) TYPE(*CHAR) LEN(80) VALUE('no +
errors recorded')
/* Msg variables: */
DCL VAR(&MSG) TYPE(*CHAR) LEN(512) /* Message */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512) /* Message data */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* Message id */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* Message file */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /* Message file library */
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) /* Message key */
DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5) /* Message length */
DCL VAR(&MSGRPY) TYPE(*CHAR) LEN(1) /* Message reply */
DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(11) /* Message type */
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2) /* Return type */
/* Constants (alphabetically): */
DCL VAR(&FALSE) TYPE(*LGL) VALUE('0') /* 'FALSE' */
DCL VAR(&TRUE) TYPE(*LGL) VALUE('1') /* 'TRUE' */
/*-------------------------------------------------------------------*/
/* Begin procedure: */
/*-------------------------------------------------------------------*/
F00:
/* Establish program-level error trapping: */
MONMSG MSGID(CPF0000 RPG0000) EXEC(GOTO CMDLBL(ERROR))
/*-------------------------------------------------------------------*/
F10:
ADDLIBLE LIB(&LIBNAME)
MONMSG MSGID(CPF0000)
CALL PGM(EMPGC01) PARM(&EMPNO &PAY &FLAG)
CHGVAR VAR(&PAYC) VALUE(&PAY)
CHGVAR VAR(&MSGDTA) VALUE('EMPGC01 empno= ' *CAT +
&EMPNO *BCAT ' pay= ' *CAT &PAYC *BCAT +
' flag= ' *CAT &FLAG)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSGDTA)
GOTO CMDLBL(END)
/*-------------------------------------------------------------------*/
ERROR:
/* RCLRSC */
/* SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +*/
/* TOPGMQ(*PRV) */
/* RETURN */
END:
ENDPGM
The RPG program EMPGC01
You can copy this source to an iSeries source physical file and create the program used in this example.
Note this program requires the EMPLOYEE file above.>/p>
H/TITLE *EMPGC01 * GET TOTAL FOR AN EMPLOYEE
H DFTNAME(EMPGC01)
F*****************************************************************
F* *
FEMPLOYEE IF E K DISK
F RENAME(EMPLOYEE:EMPR)
D*
D* * NAMED CONSTANTS *
D CFound C CONST('YES')
D CNotFound C CONST('NO')
*
D OFF C CONST('0')
D ON C CONST('1')
D*
D NOHIT C CONST('*ERROR - REC NOT FOUND')
D NOAUTH C CONST('*ERROR - NOT AUTHORIZED')
D ERROR C CONST('*ERROR')
D*
D IEmpno S 6
DOutput DS
D IPay S 9 2
D IFirstName S 12
D ILastName S 15
D IFlag S 5
*
D eof s 1
C/eject
*************************************************************
C #MAIN TAG
C exsr $START
C clear Output
C exsr getemp
*
C #END TAG
*
C eval *inlr = *on
*
C** if ICALL = 'L'
C** eval *inlr = *on
C** else
C** return
C** endif
C/eject
*-------------------------------------------------------------
C getemp begsr
C*
C EMPKEY CHAIN EMPR 99
C*
C if *in99 = *off
C eval IPay = SALARY + BONUS + COMM
C movel CFound IFlag
C else
C eval IPay = 0
C movel CNotFound IFlag
C endif
C*
C endsr
*-------------------------------------------------------------
C $START begsr
C *ENTRY PLIST
C PARM IEmpno
C PARM IPay
C PARM IFlag
C*
C EMPKEY KLIST
C KFLD IEmpno
C*
C endsr
C*
C*-------------------------------------------------------------
*
|
|
|
|
