SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: EXZSP1R
H/TITLE Return input zero-suppressed & left-justified
H Y
Z* CRTRPGPGM
Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
*
W* Warning: This program does not set on the LR indicator
*
* Parameter declarations
I DS
* I : Code trans directions 1
I 1 1 P1CDTT
* I : Code table reference 10
I 2 11 P2TABL
* B : Code in standard form 80
I 12 91 P3CDST
* B : Code qualifier data 80
I 92 171 P4CDQD
* B : Code in local form 80
I 172 251 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 80 Code in standar
C P4CDQD PARM P4CDQD WP0004 80 Code qualifier
C P5CDLC PARM P5CDLC WP0005 80 Code in local f
*****************************************************************
*
C MOVE *BLANKS OUT80 80
* CASE: PAR.Code trans directions is Inward translation
C P1CDTT IFEQ 'I'
* Use Standard if non-blank; else use qualifier:
C P3CDST IFNE *BLANKS
C MOVELP3CDST OUT80
C ELSE
C MOVELP4CDQD OUT80
C END
* Find first non-blank, non-zero character:
C ' 0' CHECKOUT80 N 30 n=non' ',non'0'
C N IFGT 0 if found, use
C SUBSTOUT80:N P5CDLC P from pos N
C ELSE otherwise, use
C MOVELOUT80 P5CDLC input as-is
C END
*
*
C ELSE
* CASE: PAR.Code trans directions is Outward translation
C P1CDTT IFEQ 'O'
* Use Local if non-blank; else use qualifier:
C P5CDLC IFNE *BLANKS
C MOVELP5CDLC OUT80
C ELSE
C MOVELP4CDQD OUT80
C END
* Find first non-blank, non-zero character:
C ' 0' CHECKOUT80 N 30 n=non' ',non'0'
C N IFGT 0 if found, use
C SUBSTOUT80:N P3CDST P from pos N
C ELSE otherwise, use
C MOVELOUT80 P3CDST input as-is
C END
*
*
C END
*
C END
*
* A "Return code" of non-blank will be logged as a translation error:
C MOVEL*BLANK P0RTN *Return code
* Exit program
C RETRN