SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: EXQUAL2R
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