SeanHoppe.com › Cleo CodeSamples › TPMC Exit Point Long Parm List -- Copy Records After Outbound Enveloping
For additional EXTOL EDI Integrator RPGLE Examples: Sean Hoppe Consulting Group Coding Samples
h Debug(*Yes) Datedit(*Ymd)
H DEBUG DATEDIT(*YMD)
F* CRTRPGPGM
F* OPTION(*NOXREF)
*
F* Warning: This program does not set on the LR indicator
*
H* SYNOPSIS :
H* PGM will be called each time a Nordstrom (4420) 856 is enveloped/wrapped sent. Given that this
H* PGM is only called for Nordstroms (4420) we do not have to test for the partner ID.
H* The pgm will read LMREF3 to get E1SCTL. With E1SCTL we will read the Nodstrom VEDXSHS record
H* to determine the carrier (E1VIA). We will get the 1st 3 characters of E1VIA to see if value
H* is 'UPS. If 'UPS' we will run 5 SQL insert statements to copy the data from
H* VEDXSHx tables to VEFXSHx tables.
H*
H* After exit point program is called a separate CL will be called to run
H* CRTAPPDTA(B). CRTAPPDTA(B) will envelope the data and wait for the next successful S2K
H* job to wrap and send the data. CRTAPPDTA(B) will also updated the process flag in VEFXSHS.
H* CRTAPPDTA FSET(VAI856S4) TEXT('NORDSTROM/UPS outbound ASN')
H* ERROPT(*NO) CRTENV(*YES) TRDPNR(4420) GROUP(SH) MSGID(856)
H* MSGCLS(O856_4420U) RSLTMETHOD(*RUNTIME) PARCHLDREL(*YES)
*
H* User name : SHOPPE
H* Date generated: 09/02/14
*
*================================================================
F* Maintenance :
*================================================================
* EXTOL Message Logs
FEXLLMRL1 IF E K DISK
FVEDXSHSL1 IF E K DISK
* Temporary variables
DSCTL S 7A
D@SCTL s Like(E1SCTL)
D@E1VIA s Like(E1VIA)
D@CMP s Like(E1CMP)
D*
*
* Parameter declarations
D P1PARM DS
* O : MAP Function status
D P1FSTS 1 1
D P2PARM DS
* O : MAP In process status
D P2ISTS 1 1
D P3PARM DS
* FLD: Trading pnr msg cls exit
* I : MAP Message level event code
D P3MLEV 1 2
* I : MAP Processing option
D P3PROP 3 3
* I : MAP Scheduling priority
D P3SCPR 4 4
* I : MAP Submit with job name
D P3SBJN 5 14
* I : MAP Submit with job desc
D P3SBJD 15 24
* I : MAP Submit with job desc libr
D P3SJDL 25 34
* I : MAP Submit to job queue
D P3SBJQ 35 44
* I : MAP Submit job queue priority
D P3SBJP 45 45
* I : MAP Submit with user name
D P3SBJU 46 55
* I : MAP Submit with routing data
D P3SRTG 56 95
* I : MAP Days to retain data
D P3DRDT 96 98P 0
* I : MAP Days to retain logs
D P3DRLG 99 101P 0
* I : MAP Hours before ack is late
D P3HRAL 102 104P 2
* I : MAP Exit point status
D P3EXST 105 105
* I : MAP Exit point operation
D P3EXOP 106 106
* I : MAP Exit action on return
D P3EACT 107 107
* I : MAP Return value pass
D P3PRTN 108 114
* I : MAP Function status - pass
D P3FSPA 115 115
* I : MAP In process status - pass
D P3ISPA 116 116
* I : MAP Return value fail
D P3FRTN 117 123
* I : MAP Function status - fail
D P3FSFA 124 124
* I : MAP In process status - fail
D P3ISFA 125 125
* I : MAP External pgm parm type
D P3EXPT 126 126
* I : MAP External program name
D P3EXPG 127 136
* I : MAP External program library
D P3EXLB 137 146
* I : MAP Exit command string
D P3ECMD 147 402
D P4PARM DS
* FLD: Log of message
* I : MAP Message log number
D P4MSLN 1 6P 0
* I : MAP Connection log number
D P4CNLN 7 10P 0
* I : MAP Interchange log number
D P4INLN 11 15P 0
* I : MAP Group log number
D P4GPLN 16 20P 0
* I : MAP Application data log #
D P4APLN 21 25P 0
* I : MAP Trading partner codeRef 1
D P4TPC1 26 31
* I : MAP Group code Ref 1
D P4GPC1 32 37
* I : MAP Message ID
D P4MSID 38 43
* I : MAP Message class
D P4MSCL 44 53
* I : MAP Message ID Ref 1
D P4MSI1 54 59
* I : MAP Message class Ref 1
D P4MSC1 60 69
* I : MAP Message direction
D P4MSDI 70 70
* I : MAP Function status - message
D P4FSTM 71 71
* I : MAP In process status - msg
D P4ISTM 72 72
* I : MAP Ack status - message
D P4ASTM 73 73
* I : MAP Reference # 1
D P4REF1 74 103
* I : MAP Reference # 2
D P4REF2 104 133
* I : MAP Reference # 3
D P4REF3 134 163
* I : MAP Reference date 1
D P4RFD1 164 169P 0
* I : MAP Reference date 2
D P4RFD2 170 175P 0
* I : MAP Message control reference
D P4MSCR 176 189
* I : MAP Controlling agncy log msg
D P4CTAM 190 191
* I : MAP Standard class log of msg
D P4SCLM 192 192
* I : MAP Industry group log of msg
D P4IGLM 193 193
* I : MAP V-R Log of message
D P4VRLM 194 199
* I : MAP Industry group ID log msg
D P4IGIM 200 205
* I : MAP Common access reference
D P4CARF 206 240
* I : MAP Transfer status
D P4STTF 241 241
* I : MAP Transfer sequence
D P4SQTF 242 243P 0
* I : MAP Start wrapped record
D P4WRRS 244 248P 0
* I : MAP Start wrap char position
D P4WRCS 249 251P 0
* I : MAP Application file name
D P4GFIL 252 261
* I : MAP Record format name
D P4RCFM 262 271
* I : MAP Relative record number
D P4RRNM 272 276P 0
* I : MAP Start nonwrapped record
D P4NWRS 277 281P 0
* I : MAP End nonwrapped record
D P4NWRE 282 286P 0
* I : MAP Start nonwrap record(app)
D P4NWAS 287 291P 0
* I : MAP End nonwrap record (app)
D P4NWAE 292 296P 0
* I : MAP Sequence# of assoc. ack.
D P4AREF 297 302P 0
* I : MAP Translation job control
D P4TJOB 303 308P 0
/EJECT
*****************************************************************
* Entry parameters
C *ENTRY PLIST
C PARM P0RTN 7
C P1FSTS PARM P1FSTS WP0001 1 Function status
C P2ISTS PARM P2ISTS WP0002 1 In process stat
C P3MLEV PARM WP0003 2 Message level e
C P3PROP PARM WP0004 1 Processing opti
C P3SCPR PARM WP0005 1 Scheduling prio
C P3SBJN PARM WP0006 10 Submit with job
C P3SBJD PARM WP0007 10 Submit with job
C P3SJDL PARM WP0008 10 Submit with job
C P3SBJQ PARM WP0009 10 Submit to job q
C P3SBJP PARM WP0010 1 Submit job queu
C P3SBJU PARM WP0011 10 Submit with use
C P3SRTG PARM WP0012 40 Submit with rou
C P3DRDT PARM WP0013 5 0 Days to retain
C P3DRLG PARM WP0014 5 0 Days to retain
C P3HRAL PARM WP0015 5 2 Hours before ac
C P3EXST PARM WP0016 1 Exit point stat
C P3EXOP PARM WP0017 1 Exit point oper
C P3EACT PARM WP0018 1 Exit action on
C P3PRTN PARM WP0019 7 Return value pa
C P3FSPA PARM WP0020 1 Function status
C P3ISPA PARM WP0021 1 In process stat
C P3FRTN PARM WP0022 7 Return value fa
C P3FSFA PARM WP0023 1 Function status
C P3ISFA PARM WP0024 1 In process stat
C P3EXPT PARM WP0025 1 External pgm pa
C P3EXPG PARM WP0026 10 External progra
C P3EXLB PARM WP0027 10 External progra
C P3ECMD PARM WP0028 256 Exit command st
C P4MSLN PARM WP0029 11 0 Message log num
C P4CNLN PARM WP0030 7 0 Connection log
C P4INLN PARM WP0031 9 0 Interchange log
C P4GPLN PARM WP0032 9 0 Group log numbe
C P4APLN PARM WP0033 9 0 Application dat
C P4TPC1 PARM WP0034 6 Trading partner
C P4GPC1 PARM WP0035 6 Group code
C P4MSID PARM WP0036 6 Message ID
C P4MSCL PARM WP0037 10 Message class
C P4MSI1 PARM WP0038 6 Message ID
C P4MSC1 PARM WP0039 10 Message class
C P4MSDI PARM WP0040 1 Message directi
C P4FSTM PARM WP0041 1 Function status
C P4ISTM PARM WP0042 1 In process stat
C P4ASTM PARM WP0043 1 Ack status - me
C P4REF1 PARM WP0044 30 Reference # 1
C P4REF2 PARM WP0045 30 Reference # 2
C P4REF3 PARM WP0046 30 Reference # 3
C P4RFD1 PARM WP0047 11 0 Reference date
C P4RFD2 PARM WP0048 11 0 Reference date
C P4MSCR PARM WP0049 14 Message control
C P4CTAM PARM WP0050 2 Controlling agn
C P4SCLM PARM WP0051 1 Standard class
C P4IGLM PARM WP0052 1 Industry group
C P4VRLM PARM WP0053 6 V-R Log of mess
C P4IGIM PARM WP0054 6 Industry group
C P4CARF PARM WP0055 35 Common access r
C P4STTF PARM WP0056 1 Transfer status
C P4SQTF PARM WP0057 2 0 Transfer sequen
C P4WRRS PARM WP0058 9 0 Start wrapped r
C P4WRCS PARM WP0059 5 0 Start wrap char
C P4GFIL PARM WP0060 10 Application fil
C P4RCFM PARM WP0061 10 Record format n
C P4RRNM PARM WP0062 9 0 Relative record
C P4NWRS PARM WP0063 9 0 Start nonwrappe
C P4NWRE PARM WP0064 9 0 End nonwrapped
C P4NWAS PARM WP0065 9 0 Start nonwrap r
C P4NWAE PARM WP0066 9 0 End nonwrap rec
C P4AREF PARM WP0067 11 0 Sequence# of as
C P4TJOB PARM WP0068 11 0 Translation job
*****************************************************************
*
* Key to the Item Cross Reference File by 2nd Item/Xref Type/Address Number
C KeyEFXSHSR KLIST
C KFLD @CMP
C KFLD @SCTL
*
* Query message log number LF to retrieve S2K control number.
* place control number into variable SCTL
C P4MSLN CHAIN EXLLMRL1 98
*
C MOVEL LMREF3 SCTL
C MOVEL LMREF3 @SCTL
C
C* Select Shipment record to determine carrier code.
C* We will copy data if data if 1st 3 characters are 'UPS'
C MOVE 1 @CMP
C KeyEFXSHSR CHAIN EDXSHSR 97
C EVAL @E1VIA =%SUBST(E1VIA:1:3)
C*
C @E1VIA IFEQ 'UPS'
C
C* Move data from VEDXSHH->VEFXSHH
C/EXEC SQL
C+ INSERT INTO VEFXSHH SELECT * FROM VEDXSHH
C+ WHERE VEDXSHH.E0SCTL = :SCTL
C/END-EXEC
C
C* Move data from VEDXSHS->VEFXSHS
C/EXEC SQL
C+ INSERT INTO VEFXSHS SELECT * FROM VEDXSHS
C+ WHERE VEDXSHS.E1SCTL = :SCTL
C/END-EXEC
C
C* Move data from VEDXSHO->VEFXSHO
C/EXEC SQL
C+ INSERT INTO VEFXSHO SELECT * FROM VEDXSHO
C+ WHERE VEDXSHO.E2SCTL = :SCTL
C/END-EXEC
C
C* Move data from VEDXSHB->VEFXSHB
C/EXEC SQL
C+ INSERT INTO VEFXSHB SELECT * FROM VEDXSHB
C+ WHERE VEDXSHB.E3SCTL = :SCTL
C/END-EXEC
C
C* Move data from VEDXSHD->VEFXSHD
C/EXEC SQL
C+ INSERT INTO VEFXSHD SELECT * FROM VEDXSHD
C+ WHERE VEDXSHD.E4SCTL = :SCTL
C/END-EXEC
C ENDIF
*
* User code should set PGM.*Return code to non-blank on fail;
* the suggested usage is message ID of an appropriate error message
* (the return code field is 7 character alpha)
* .
C MOVE *BLANK P0RTN
* .
*================================================================
* Exit program: Direct
*================================================================
C RETURN
*================================================================
