EXTOL RPG Program: EXQUAL2R

EXTOL RPG - External Call EXQUAL2R - Return Qualifier Input is Not Blank

     H/TITLE If input non-b,rtn qual   Execute external functio
     H            Y
     Z* CRTRPGPGM
     Z* OPTION(*NOXREF)
      *
     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/2E  Version:  1286
     H* Function type : Execute external function
      *
     H* Company       : ExtoL, Inc.
     H* System        : ExtoL EDI Integrator
     H* User name     : EXTOLOWN
     H* Date generated: 07/31/94  Time  : 03:13:04
     H* (C) Copyright : ExtoL, Inc.  1988,1994
      *
      *================================================================
     M* Maintenance   :
      *================================================================
      /EJECT
      * 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
      /EJECT
      * Parameter declarations
     IP1PARM      DS
      * I :  Code trans directions
     I                                        1   1 P1CDTT
     IP2PARM      DS
      * I :  Code table reference
     I                                        1  10 P2TABL
     IP3PARM      DS
      * B :  Code in standard form
     I                                        1  20 P3CDST
     IP4PARM      DS
      * B :  Code qualifier data
     I                                        1  20 P4CDQD
     IP5PARM      DS
      * B :  Code in local form
     I                                        1  20 P5CDLC
      /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           P3CDST    PARM P3CDST    WP0003 20        Code in standar
     C           P4CDQD    PARM P4CDQD    WP0004 20        Code qualifier
     C           P5CDLC    PARM P5CDLC    WP0005 20        Code in local f
      *****************************************************************
      * Initialize
     C                     EXSR ZZINIT
      *
      * If input non-b,rtn qual
     C                     MOVEL*BLANK    W0RTN            *Return code
      * If input is blank, return blanks
      * Else, (If input is non-blank)  return qualifier
      * CASE: PAR.Code trans directions is Inward translation
     C           P1CDTT    IFEQ 'I'                        *IF
      * CASE: PAR.Code in standard form is Blank
     C           P3CDST    IFEQ *BLANK                     *IF
     C                     MOVEL*BLANK    P5CDLC           Code in local f
     C                     ELSE
      * CASE: *OTHERWISE
     C                     MOVELP4CDQD    P5CDLC           Code in local f
     C                     END                             *FI
     C                     ELSE
      * CASE: PAR.Code trans directions is Outward translation
     C           P1CDTT    IFEQ 'O'                        *IF
      * CASE: PAR.Code in local form is Blank
     C           P5CDLC    IFEQ *BLANK                     *IF
     C                     MOVEL*BLANK    P3CDST           Code in standar
     C                     ELSE
      * CASE: *OTHERWISE
     C                     MOVELP4CDQD    P3CDST           Code in standar
     C                     END                             *FI
     C                     END                             *FI
     C                     END                             *FI
      * A "Return code" of non-blank will be logged as a translation erro
     C                     MOVELW0RTN     P0RTN            *Return code
     C                     EXSR ZYEXPG
      *----------------------------------------------------------------
      * Exit program
     C           AAEXIT    TAG
     C                     MOVEL*BLANK    P0RTN
     C                     EXSR ZYEXPG
      *================================================================
      /EJECT
     CSR         ZXEXPG    BEGSR
      *================================================================
      * Exit program: Normal
      *================================================================
     C                     EXSR ZYEXPG
      *================================================================
     CSR         ZXEXIT    ENDSR
      /EJECT
     CSR         ZYEXPG    BEGSR
      *================================================================
      * Exit program: Direct
      *================================================================
      * Exit program
     C                     RETRN
      *
      *================================================================
     CSR         ZYEXIT    ENDSR
      /EJECT
     CSR         ZZINIT    BEGSR
      *================================================================
      * Initialisation
      *================================================================
     C           W0ICL     IFEQ *BLANK
     C                     MOVEL'Y'       W0ICL   1        *Initial call
     C                     ELSE
     C                     MOVEL'N'       W0ICL
     C                     END
     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
     C                     MOVEL'N'       W0PMT   1
      *================================================================
     CSR         ZZEXIT    ENDSR



By: on