SeanHoppe.com › EXTOL EDI Examples › EXTOL External Call RPG Programs › EXTOL RPG Program: QUOTESTR
H/TITLE Place Quotes around string; qual=qoute chars left,right
H Y
Z* CRTRPGPGM
Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
*
W* Warning: This program does not set on the LR indicator
*
* This program will put quotation marks around the non-blank
* portion of the input parameter, and pass the result to the output.
*
* It may be used in either incoming or outgoing translation.
*
* The input string is searched for the first and last
* non-blank characters. The output consists of a "left quote",
* followed by the non-blank portion of the input string, followed
* by a "right quote". The quote characters may be user-specified;
* they both default to ".
*
* Different left and right characters are allowed for.
* The default characters are specified in the constants
* LQD and RQD defined below.
*
* The qualifier input may be used to specify alternate quote
* characters. The first two positions are used as the left and
* right quotation characters if they are non-blank.
*
* If the input is completely blank, the output will by default be
* returned as blanks. By setting the third character of the
* qualifier input to "Y", a null quoted string will be returned
* for blank input.
*
* Since input and output are both 80-character parameters, a full
* 80 cannot be quoted. If the input has more than 78 non-blanks,
* only the first 78 are used in the output.
*
E DI 80 1 param string
E DO 80 1 param string
*
I DS
* Parameter strings as arrays
I 1 80 DI
I 1 80 DIF
I DS
I 1 80 DO
I 1 80 DOF
I 80 80 DOF80
I DS
I 1 1 DQ1CH
I 2 2 DQ2CH
I 3 3 DQ3CH
I 1 3 DQF
*
I DS
* Default quotation characters (left, right):
I I '"' 1 1 LQD
I I '"' 2 2 RQD
* 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
*****************************************************************
*
* Determine quotation characters:
C MOVELP4CDQD DQF
C DQ1CH IFNE ' '
* Non-blank qualifier position 1: use as left quote char
C MOVELDQ1CH LQ 1
C ELSE
C MOVELLQD LQ use default
C END
*
C DQ2CH IFNE ' '
* Non-blank qualifier position 2: use as right quote char
C MOVELDQ2CH RQ 1
C ELSE
C MOVELRQD RQ use default
C END
*
* CASE: PAR.Code trans directions is Inward translation
C P1CDTT IFEQ 'I'
*
C P3CDST IFNE *BLANKS
C DQ3CH OREQ 'Y'
* Use Code in standard form as input
* Find first non-blank character:
C ' ' CHECKP3CDST N 30 n=non' ' pos
C N IFGT 0
C N ANDLT81 if found, use
C SUBSTP3CDST:N DIF P from pos N
C ELSE otherwise, use
C MOVELP3CDST DIF P input as-is
C END
*
* Concatenate (left quote) + (input)
C LQ CAT DIF:0 DOF P
* Determine rightmost non-blank character
C ' ' CHEKRDOF N N=non' ' pos
C N IFGT 0
C N ANDLT80 if found, add
C ADD 1 N quote at N+1
C MOVELRQ DO,N
C ELSE otherwise, add
C MOVELRQ DOF80 quote at pos 80
C END
* Move to output parm:
C MOVELDOF P5CDLC
C ELSE
* Set output to blanks if input is blanks and DQ3CH is not Y
C MOVE *BLANKS P5CDLC
C END
*
* A "Return code" of blank means there is no error
C MOVEL*BLANK P0RTN *Return code
*
C ELSE
* CASE: PAR.Code trans directions is Outward translation
C P1CDTT IFEQ 'O'
*
C P5CDLC IFNE *BLANKS
C DQ3CH OREQ 'Y'
* Use Code in local form as input
* Find first non-blank character:
C ' ' CHECKP5CDLC N 30 n=non' ' pos
C N IFGT 0
C N ANDLT81 if found, use
C SUBSTP5CDLC:N DIF P from pos N
C ELSE otherwise, use
C MOVELP5CDLC DIF P input as-is
C END
*
* Concatenate (left quote) + (input)
C LQ CAT DIF:0 DOF P
* Determine rightmost non-blank character
C ' ' CHEKRDOF N N=non' ' pos
C N IFGT 0
C N ANDLT80 if found, add
C ADD 1 N quote at N+1
C MOVELRQ DO,N
C ELSE otherwise, add
C MOVELRQ DOF80 quote at pos 80
C END
* Move to output parm:
C MOVELDOF P3CDST
C ELSE
* Set output to blanks if input is blanks and DQ3CH is not Y
C MOVE *BLANKS P3CDST
C END
*
* A "Return code" of blank means there is no error
C MOVEL*BLANK P0RTN *Return code
C END
*
C END
*
* Exit program - leave active (*INLR is off)
C RETRN