|
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.