SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: EXQLOVZR
H/TITLE Return input if not blank/zero; else return qualifier
H Y
Z* CRTRPGPGM
Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
*
W* Warning: This program does not set on the LR indicator
*
H* SYNOPSIS :
H* Example of external call code translation using the "long"
H* parameter list.
*
H* Returns the "qualifier" input to the output if the "primary"
H* input is blank (if alpha) or zero (if numeric).
H* The "primary" input is "local" for outgoing, "standard" for
H* incoming.
*
H* Function type : Execute external function
*
H* Company : ExtoL, Inc.
H* System : ExtoL EDI Integrator
H* User name : EXTOLOWN
H* Date : 11/16/94
H* (C) Copyright : ExtoL, Inc. 1988,1994
*
*================================================================
M* Maintenance : Manually modified Synon program for demonstration.
*================================================================
*
E EL 99100 99 elements x 100
E ELN 99 3 0 99 el.lengths 3.0
E SG 2006 1 segment buffer
E SC 10 15 0 Segment counters
* Data structures:
IPGMDS ESDSEXPGSDS
* Program data structure
IJBDTTM DS
* Job date/time
I 1 60##JDT
I 1 20##JYY
I 3 40##JMM
I 5 60##JDD
I 7 120##JTM
I 7 80##JHH
I 9 100##JNN
I 11 120##JSS
* Named constants
* Values in a numeric field:
I '0123456789' C DIGITS
*
/EJECT
* Parameter declarations
IP1PARM DS
* I : Code trans directions
I 1 1 P1CDTT
IP2PARM DS
* FLD: #Code table test 2
* I : Code table reference
I 1 10 P2TABL
* B : Code in standard form
I 11 90 P2CDST
* B : Code qualifier data
I 91 170 P2CDQD
* B : Code in local form
I 171 250 P2CDLC
IP3PARM DS
* FLD: XLT msg parm structure
* I : Connection log number
I P 1 40P3CNLN
* I : Network ID
I 5 19 P3NWID
* I : Date/time start of call
I P 20 270P3DTM1
* I : Interchange log number
I P 28 320P3INLN
* I : Trading partner code
I 33 38 P3TPCD
* I : Interchange date
I 39 44 P3INDT
* I : Interchange time
I 45 48 P3INTM
* I : Test indicator
I 49 49 P3TSTI
* I : Group log number
I P 50 540P3GPLN
* I : Message log number
I P 55 600P3MSLN
* I : Message ID
I 61 66 P3MSID
* I : Message class
I 67 76 P3MSCL
* I : Message direction
I 77 77 P3MSDI
* I : Application file name
I 78 87 P3GFIL
* I : Record format name
I 88 97 P3RCFM
* I : V-R Log of message
I 98 103 P3VRLM
* I : Industry group ID log msg
I 104 109 P3IGIM
* I : Application data log #
I P 110 1140P3APLN
* I : Application file set
I 115 124 P3GFSN
* I : Msg queue - translation
I 125 134 P3MSQT
* I : Trans job master control
I P 135 1400P3TJMC
* I : Segment position in msg
I P 141 1440P3SGPS
* I : Segment ID
I 145 147 P3SGID
* I : Element pos in segment
I P 148 1490P3ELPS
* I : Component position
I P 150 1510P3CPOS
* I : Element ID
I 152 155 P3ELID
* I : Field name
I 156 165 P3FLNM
* I : Field length
I P 166 1680P3FLLN
* I : Field number of digits
I P 169 1700P3FLDD
* I : Field decimal positions
I P 171 1720P3FLDC
* I : Field type
I 173 173 P3FLTY
* I : Field null value type
I 174 174 P3NULT
* I : Field null value length
I P 175 1770P3NULL
* I : Field null value
I 178 187 P3NULV
* I : Message area
I 188 188 P3SGAR
* I : Segment sequence
I 189 192 P3SGSQ
* I : Segment instance number
I P 193 1940P3SGNM
* I : Element mapping sequence
I P 195 1960P3MPSQ
* I : Nonwrapped record number
I P 197 2010P3NWRC
IP4PARM DS
* FLD: XLT misc field parm str
* I : Field mapping sequence
I P 1 20P4FMSQ
* I : #XLT Line counter 1 7.0P
I P 3 60P4N1
* I : #XLT Line counter 2 7.0P
I P 7 100P4N2
* I : #XLT Segment length 5.0P
I P 11 130P4GDLP
* I : #XLT Last element 3.0P
I P 14 150P4MAX
* I : Sub-element delimiter
I 16 16 P4SEDM
* I : Element delimiter
I 17 17 P4ELDM
* I : Decimal notation
I 18 18 P4DCNT
* I : Release indicator char
I 19 19 P4RLIN
* I : Reserved space in UNA
I 20 20 P4RSSP
* I : Segment delimiter
I 21 21 P4SGDM
IP4SCF DS
* FLD: XLT misc field parm str
* I : #XLT Sg counters 10x15.0P
I P 1 80 SC
IP4ELNF DS
* FLD: XLT misc field parm str
* I : #XLT Elem lengths 99x3.0P
I P 1 198 ELN
IP4SGF DS
* FLD: XLT misc field parm str
* I : #XLT Segment buffer 2006A
I 12006 SG
IWP0052 DS 2006
IP4ELF DS
* FLD: XLT misc field parm str
* I : #XLT Elem data 99x100
I 19900 EL
IWP0053 DS 9900
/EJECT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C PARM P0RTN 7
C P1CDTT PARM WP0001 1 Code trans dire
C P2TABL PARM WP0002 10 Code table refe
C P2CDST PARM P2CDST WP0003 80 Code in standar
C P2CDQD PARM P2CDQD WP0004 80 Code qualifier
C P2CDLC PARM P2CDLC WP0005 80 Code in local f
C P3CNLN PARM WP0006 70 Connection log
C P3NWID PARM WP0007 15 Network ID
C P3DTM1 PARM WP0008 150 Date/time start
C P3INLN PARM WP0009 90 Interchange log
C P3TPCD PARM WP0010 6 Trading partner
C P3INDT PARM WP0011 6 Interchange dat
C P3INTM PARM WP0012 4 Interchange tim
C P3TSTI PARM WP0013 1 Test indicator
C P3GPLN PARM WP0014 90 Group log numbe
C P3MSLN PARM WP0015 110 Message log num
C P3MSID PARM WP0016 6 Message ID
C P3MSCL PARM WP0017 10 Message class
C P3MSDI PARM WP0018 1 Message directi
C P3GFIL PARM WP0019 10 Application fil
C P3RCFM PARM WP0020 10 Record format n
C P3VRLM PARM WP0021 6 V-R Log of mess
C P3IGIM PARM WP0022 6 Industry group
C P3APLN PARM WP0023 90 Application dat
C P3GFSN PARM WP0024 10 Application fil
C P3MSQT PARM WP0025 10 Msg queue - tra
C P3TJMC PARM WP0026 110 Trans job maste
C P3SGPS PARM WP0027 70 Segment positio
C P3SGID PARM WP0028 3 Segment ID
C P3ELPS PARM WP0029 30 Element pos in
C P3CPOS PARM WP0030 30 Component posit
C P3ELID PARM WP0031 4 Element ID
C P3FLNM PARM WP0032 10 Field name
C P3FLLN PARM WP0033 50 Field length
C P3FLDD PARM WP0034 20 Field number of
C P3FLDC PARM WP0035 20 Field decimal p
C P3FLTY PARM WP0036 1 Field type
C P3NULT PARM WP0037 1 Field null valu
C P3NULL PARM WP0038 50 Field null valu
C P3NULV PARM WP0039 10 Field null valu
C P3SGAR PARM WP0040 1 Message area
C P3SGSQ PARM WP0041 4 Segment sequenc
C P3SGNM PARM WP0042 30 Segment instanc
C P3MPSQ PARM WP0043 30 Element mapping
C P3NWRC PARM WP0044 90 Nonwrapped reco
C P4FMSQ PARM WP0045 30 Field mapping s
C P4N1 PARM P4N1 WP0046 70 #XLT Line count
C P4N2 PARM P4N2 WP0047 70 #XLT Line count
C P4SCF PARM WP0048 80 #XLT Sg counter
C P4GDLP PARM WP0049 50 #XLT Segment le
C P4MAX PARM WP0050 30 #XLT Last eleme
C P4ELNF PARM WP0051198 #XLT Elem lengt
C P4SGF PARM WP0052 #XLT Segment bu
C P4ELF PARM WP0053 #XLT Elem data
C P4SEDM PARM WP0054 1 Sub-element del
C P4ELDM PARM WP0055 1 Element delimit
C P4DCNT PARM WP0056 1 Decimal notatio
C P4RLIN PARM WP0057 1 Release indicat
C P4RSSP PARM WP0058 1 Reserved space
C P4SGDM PARM WP0059 1 Segment delimit
*****************************************************************
* Initialise
C EXSR ZZINIT
*
* External code process P2
C MOVEL*BLANK W0RTN *Return code
* CASE: PAR.Code trans directions is Inward translation
C P1CDTT IFEQ 'I' *IF
* Incoming function:
C EXSR SARVGN
C ELSE
* CASE: PAR.Code trans directions is Outward translation
C P1CDTT IFEQ 'O' *IF
* Outgoing function:
C EXSR SBRVGN
C END *FI
C END *FI
* A "Return code" of non-blank will be logged as a translation error:
C MOVELW0RTN P0RTN *Return code
C EXSR ZYEXPG
*================================================================
/EJECT
CSR SARVGN BEGSR
*================================================================
* Incoming ("I") - Standard -> Application translation.
*
C MOVEL*BLANK W0RTN 7
C MOVEL*BLANK OUT80 80
* Use Standard if non-blank; else use qualifier:
C P2CDST IFNE *BLANKS
C MOVELP2CDST P2CDLC Code in local f
C ELSE
C MOVELP2CDQD P2CDLC
C END
*
*================================================================
CSR SAEXIT ENDSR
/EJECT
CSR SBRVGN BEGSR
*================================================================
* Outgoing ("O") - Application -> Standard translation.
*
C MOVEL*BLANK W0RTN 7
*
* Use Local if non-blank/non-zero; else use qualifier:
*
* If character, check for blanks:
C P3FLTY IFEQ 'A'
C P3FLTY OREQ 'H'
*
C P2CDLC IFNE *BLANKS
C MOVELP2CDLC P2CDST
C ELSE
C MOVELP2CDQD P2CDST
C END
*
C ELSE
* If numeric, check for any non-blank, non-zero character:
C ' 0' CHECKP2CDLC N 30 n=non' ',non'0'
C N IFGT 0 if found,
C MOVELP2CDLC P2CDST
C ELSE
C MOVELP2CDQD P2CDST
C END
*
C END
*
*================================================================
CSR SBEXIT ENDSR
/EJECT
CSR ZYEXPG BEGSR
*================================================================
* Exit program: Direct
*================================================================
* Exit program
C RETRN
*
*================================================================
CSR ZYEXIT ENDSR
/EJECT
CSR ZZINIT BEGSR
*================================================================
* Initialisation
*================================================================
C MOVE *BLANK P0RTN
C MOVE *BLANK W0RTN 7
C MOVEL*BLANK W0RSL 1
C MOVEL*BLANK W0RSF 1
* Initialise indicators for re-entry
C MOVE '0' *IN
* Setup job date/time
*
C Z-ADDUDATE ##JDT
C TIME ##JTM
* Update screen time
C TIME ##TME 60
*================================================================
CSR ZZEXIT ENDSR