Article

Appendix B: Server source code

Jim Mason

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*-------------------------------------------------------------
      *

There are Comments. Add yours.

 
TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to: