SeanHoppe.com › EXTOL EDI Examples › EXTOL Exit Point RPG Programs › EXTOL RPG Program: EXTTOE
H/TITLE API: example pgm to be called by override type "E"
H Y
Z* CRTRPGPGM
Z* CVTOPT(*DATETIME)
*
W* Warning: This program does not set on the LR indicator
*
H* SYNOPSIS :
H* Perform user function
H* As defined by action diagram
*
H* Generated by : SYNON/2 Version: 1035
H* Function type : Execute external function
*
H* Company : EXTOL, Inc.
H* System : EXTOL Integrator
H* User name : JWB
H* Date : 11/28/99 Time : 14:50:29
H* Copyright : EXTOL, Inc.
*
*================================================================
M* Maintenance :
*================================================================
* Data structures:
IPGMDS ESDSEXPGSDS
* Program data structure
* Parameter declarations
IP1PARM DS
* FLD: Trading pnr msg class ovr
* I : Trading partner code
I 1 6 P1TPCD
* I : Group code
I 7 12 P1GPCD
* I : Message ID
I 13 18 P1MSID
* I : Message class
I 19 28 P1MSCL
* I : Direction code (override)
I 29 29 P1DRTO
* I : Override sequence (int)
I P 30 310P1OVSI
* I : Override sequence
I P 32 330P1OVSQ
* I : Application file name
I 34 43 P1GFIL
* I : Override command type
I 44 44 P1OVCM
* B : Override to library
I 45 54 P1OVLB
* B : Override to file
I 55 64 P1OVFL
* B : Override to member
I 65 74 P1OVMB
IP2PARM DS
* FLD: Incoming generic index
* I : Connection log number
I P 1 40P2CNLN
* I : Interchange log number
I P 5 90P2INLN
* I : Group log number
I P 10 140P2GPLN
* I : Message log number
I P 15 200P2MSLN
IP3PARM DS
* FLD: Translation job
* I : Translation job status
I 1 1 P3TJST
* I : Translation job name
I 2 11 P3TRJB
* I : Translation job user name
I 12 21 P3TRJU
* I : Translation job number
I 22 27 P3TRJN
* I : Msg queue - translation
I 28 37 P3MSQT
/EJECT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C P1TPCD PARM WP0001 6 Trading partner
C P1GPCD PARM WP0002 6 Group code
C P1MSID PARM WP0003 6 Message ID
C P1MSCL PARM WP0004 10 Message class
C P1DRTO PARM WP0005 1 Direction code
C P1OVSI PARM WP0006 30 Override sequen
C P1OVSQ PARM WP0007 30 Override sequen
C P1GFIL PARM WP0008 10 Application fil
C P1OVCM PARM WP0009 1 Override comman
C P1OVLB PARM P1OVLB WP0010 10 Override to lib
C P1OVFL PARM P1OVFL WP0011 10 Override to fil
C P1OVMB PARM P1OVMB WP0012 10 Override to mem
C P2CNLN PARM WP0013 70 Connection log
C P2INLN PARM WP0014 90 Interchange log
C P2GPLN PARM WP0015 90 Group log numbe
C P2MSLN PARM WP0016 110 Message log num
C P3TJST PARM WP0017 1 Translation job
C P3TRJB PARM WP0018 10 Translation job
C P3TRJU PARM WP0019 10 Translation job
C P3TRJN PARM WP0020 6 Translation job
C P3MSQT PARM WP0021 10 Msg queue - tra
*****************************************************************
* Initialize
C EXSR ZZINIT
*
* OVRDBF API pgm example
* User defined routine for specifying override parameters:
C EXSR UASUBR User defined ro
*----------------------------------------------------------------
* Exit program
C EXSR ZYEXPG
*================================================================
/EJECT
CSR UASUBR BEGSR
*================================================================
* User defined routine for specifying override parameters:
*================================================================
C MOVELP1OVMB WUWRK1 #Work field for
* If "?" in member name, form name; else, return blanks = default v
* CASE: WRK.#Work field for "?" test is Question mark
C WUWRK1 IFEQ '?' *IF
* Form new member name based on log of connection number:
* Create name = P1 *CAT P2 - *User defined functions *#"R" & Log o
C MOVEL'R' WUMBRN 1 char prefix
C Z-ADDP2CNLN UFN070 70 numeric 7.0
C MOVELUFN070 UFA09 9 char 9
C MOVE UFA09 WUMBRN object name
C ELSE
* CASE: *OTHERWISE
C MOVEL*BLANK WUMBRN Member name
C END *FI
* .
* Return value formed for member name
C MOVELWUMBRN P1OVMB Override to mem
* Return values for library and file; (blank) causes default values
* of *LIBL and (file name as mapped) to be used in OVRDBF command:
C MOVEL*BLANK P1OVLB Override to lib
C MOVEL*BLANK P1OVFL Override to fil
*================================================================
CSR UAEXIT ENDSR
/EJECT
CSR ZYEXPG BEGSR
*================================================================
* Exit program: Direct
*================================================================
* Copy any undisplayed messages back to caller
C CALL 'Y2CPMSC'
C PARM ##PGM
*
* Exit program
C RETRN
*
*================================================================
CSR ZYEXIT ENDSR
/EJECT
CSR ZZINIT BEGSR
*================================================================
* Initialisation
*================================================================
* Initialise indicators for re-entry
C MOVE '0' *IN
* Define work field #Work field for "?" test
C MOVEL*BLANK WUWRK1 1
* Define work field Member name
C MOVEL*BLANK WUMBRN 10
*================================================================
CSR ZZEXIT ENDSR