|
midrange.com
I am sorry Michael. I do not know what happened when pasting it came thru
that way. Here it is again..
**********************************************************************************************************
H NOMAIN
/COPY QPROTOSRC,EDITOOLTST
PCTSTJSTTST B export
DCTSTJSTTST PI 118 opdesc
D CSTZIP 70 OPTIONS(*VARSIZE)
D CITY 35
D STE 2
D ZIP 9
D Pass 1
D ERR 1
*----------------------------------------------------------------
D X S 2 0
D Y S 2 0
D LEN S 5I 0 INZ
D FLDLEN S +1 LIKE(CSTZIP)
*----------------------------------------------------------------
C* ........................
C IF CSTZIP = *BLANKS
C EVAL ERR = *ON
C ELSE
C*
C EVAL ERR = *OFF
C clear FLDLEN
C MOVEL CSTZIP FLDLEN
C X'00' CHECKR FLDLEN LEN
C ' ' CHECKR FLDLEN:len LEN 25
C* ........................
C* *load city/state/zip
C* ........................
C* *if city is not blanks....
C clear city
C clear ste
C clear zip
C* look for city/state delimited by ","..
C ',' scan fldlen x 27
C if *in27 = *on
C eval %subst(city:1:x-1) = %subst(fldlen:1:x-1)
C else
C ' ' scan fldlen x 27
C if *in27 = *on
C eval %subst(city:1:x-1) = %subst(fldlen:1:x-1)
C endif
C endif
C eval x = x+1
C* look for non-blank..for state
C if x + 2 < LEN
C eval Y = 2
C else
C eval y = len - x + 1
C endif
C*
C dow x < LEN
C if %subst(fldlen:x:1) <> ' '
C eval %subst(ste:1:2) = %subst(fldlen:x:2)
C eval x = x+2
C leave
C endif
C*
C eval x = x+1
C if x + 2 < LEN
C eval Y = 2
C else
C eval y = len - x + 1
C endif
C*
C enddo
C*
C* look for non-blank..zip code
C if x + 9 < LEN
C eval Y = 9
C else
C eval y = len - x + 1
C endif
C*
C if y > 9
C eval y = 9
C endif
C*
C dow x < len
C*
C if %subst(fldlen:x:1) <> ' ' AND
C %subst(fldlen:x:1) <> '.'
C eval %subst(zip:1:y) = %subst(fldlen:x:y)
C*
C '-' SCAN ZIP POS 2 0 20
C IF *IN20 = *ON
C EVAL Y = Y - POS + 1
C EVAL X = X + POS
C if y > 9
C EVAL y = 9
C endif
C EVAL %SUBST(ZIP:POS:Y) = %SUBST(FLDlen:X:Y)
C ENDIF
C*
C leave
C endif
C*
C eval x = x+1
C if x + 9 <= LEN
C eval Y = 9
C else
C eval y = len - x + 1
C endif
C*
C enddo
C ENDIF
C select
C when pass = '2'
C return ste
C when pass = '3'
C return zip
C other
C return CITY
C endsl
C*
PCTSTJSTTST E
*********************************************************************************************************
On 4/6/06, Michael_Schutte@xxxxxxxxxxxx <Michael_Schutte@xxxxxxxxxxxx>
wrote:
>
> What in the world is the "3D"? Is that something new?
>
> Michael Schutte
> Work 614-492-7419
> email michael_schutte@xxxxxxxxxxxx
>
>
>
> "Jake M"
> <jakeroc@xxxxxxxx
> m> To
> Sent by: rpg400-l@xxxxxxxxxxxx
> rpg400-l-bounces@ cc
> midrange.com
> Subject
> Calling RPGLE module.
> 04/06/2006 10:41
> AM
>
>
> Please respond to
> RPG programming
> on the AS400 /
> iSeries
> <rpg400-l@midrang
> e.com>
>
>
>
>
>
>
> Hello Pro's,
> I am trying to call a module which was coded by somebody else. I think I
> am
> calling it wrongly. Would y'all mind taking a look at this please and
> guide
> me in the right direction? I am learning RPG so I am not be understanding
> the module correctly.
>
> module:
> H NOMAIN
> /COPY QPROTOSRC,EDITOOLTST
> PCTSTJSTTST B export
>
> DCTSTJSTTST PI 118 opdesc
> D CSTZIP 70 OPTIONS(*VARSIZE)
> D CITY 35
> D STE 2
> D ZIP 9
> D Pass 1
> D ERR 1
> *-----------------------------
> -----------------------------------
> D X S 2 0
> D Y S 2 0
> D LEN S 5I 0 INZ
> D FLDLEN S +1 LIKE(CSTZIP)
> *----------------------------------------------------------------
> C* ........................
> C IF CSTZIP =3D *BLANKS
> C EVAL ERR =3D *ON
> C ELSE
> C*
> C EVAL ERR =3D *OFF
> C clear FLDLEN
> C MOVEL CSTZIP FLDLEN
> C X'00' CHECKR FLDLEN LEN
> C ' ' CHECKR FLDLEN:len LEN
> 25
> C* ........................
> C* *load city/state/zip
> C* ........................
> C* *if city is not blanks....
> C clear city
> C clear ste
> C clear zip
> C* look for city/state delimited by ","..
> C ',' scan fldlen x
> 2= 7
> C if *in27 =3D *on
> C eval %subst(city:1:x-1) =3D
> %subst(fldlen:1:x= -1)
> C else
> C ' ' scan fldlen x
> 2= 7
> C if *in27 =3D *on
> C eval %subst(city:1:x-1) =3D
> %subst(fldlen:1:x= -1)
> C endif
> C endif
> C eval x =3D x+1
> C* look for non-blank..for state
> C if x + 2 < LEN
> C eval Y =3D 2
> C else
> C eval y =3D len - x + 1
> C endif
> C*
> C dow x < LEN
> C if %subst(fldlen:x:1) <> ' '
> C eval %subst(ste:1:2) =3D
> %subst(fldlen:x:2)
> C eval x =3D x+2
> C leave
> C endif
> C*
> C eval x =3D x+1
> C if x + 2 < LEN
> C eval Y =3D 2
> C else
> C eval y =3D len - x + 1
> C endif
> C*
> C enddo
> C*
> C* look for non-blank..zip code
> C if x + 9 < LEN
> C eval Y =3D 9
> C else
> C eval y =3D len - x + 1
> C endif
> C*
> C if y > 9
> C eval y =3D 9
> C endif
> C*
> C dow x < len
> C*
> C if %subst(fldlen:x:1) <> ' ' AND
> C %subst(fldlen:x:1) <> '.'
> C eval %subst(zip:1:y) =3D
> %subst(fldlen:x:y)
> C*
> C '-' SCAN ZIP POS 2 0
> 2=0
> C IF *IN20 =3D *ON
> C EVAL Y =3D Y - POS + 1
> C EVAL X =3D X + POS
> C if y > 9
> C EVAL y =3D 9
> C endif
> C EVAL %SUBST(ZIP:POS:Y) =3D
> %SUBST(FLDlen:X:Y)
> C ENDIF
> C*
> C leave
> C endif
> C*
> C eval x =3D x+1
> C if x + 9 <=3D LEN
> C eval Y =3D 9
> C else
> C eval y =3D len - x + 1
> C endif
> C*
> C enddo
> C ENDIF
> C select
> C when pass =3D '2'
> C return ste
> C when pass =3D '3'
> C return zip
> C other
> C return CITY
> C endsl
> C*
> PCTSTJSTTST E
>
> mycode:
>
> /COPY QPROTOSRC,EDITOOLTST
> *
> D CSTZIP S 70
> D CITY S 35
> D STE S 2
> D ZIP S 9
> D ERR S 1
> D pass S 1
> D RESULT S 118
>
> *
> *
> *
> /FREE
> //CITY =3D 'TYLER';
> //STE =3D 'TX';
> //ZIP =3D '75501';
> CSTZIP =3D 'SCHULENBURG, TX';
>
> RESULT =3D CTSTJSTTST(CSTZIP:CITY:STE:ZIP:pass:err);
>
> *inlr =3D *on;
> /END-FREE
>
> prototype in EDITOOLTST file:
>
> D* ............................................
> D ctstjsttst PR 118 opdesc
> D ctyzip 70 options(*varsize)
> D city 35
> D ste 2
> D zip 9
> D pass 1
> D err 1
>
> Thanks a bunch in advance.
>
> Jake.
> --
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
> To post a message email: RPG400-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
>
>
>
> --
> This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
> To post a message email: RPG400-L@xxxxxxxxxxxx
> To subscribe, unsubscribe, or change list options,
> visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
> or email: RPG400-L-request@xxxxxxxxxxxx
> Before posting, please take a moment to review the archives
> at http://archive.midrange.com/rpg400-l.
>
>
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
