TPMC Exit Point Long Parm List -- Copy Records After Outbound Enveloping

EXTOL RPGLE - 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
     [email protected]            s                   Like(E1SCTL)
     [email protected]           s                   Like(E1VIA)
     [email protected]             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
      *================================================================
 



By: on