RE: The Dark Side of the Do Loop

Here this should help....
 
Should I include a nominal fee LOL...


Thanks,
Tommy Holden


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of steema@xxxxxxxxxxxxx
Sent: Tuesday, January 31, 2006 2:37 PM
To: RPG programming on the AS400 / iSeries
Subject: RE: The Dark Side of the Do Loop

Sorry about that a bit of a false positive. I was calling a the
subroutine
again from the other sub.

So I have to make a few of the same subs.

There should be a better way.

IOW, I am checking for my first invoice in the Comment field. I find
one,
now I scan back till the first blank, this is my start of the inv '#'
(can
be mix alpha and num.). Then in a sub. I move the inv. into output.

now I have to look for a second, third, etc...
> With DOU the check on the criteria is performed at the end of the do
> loop.  Perchance you have an iter prior to your enddo that is causing
> this?  If so then best bet is to immediately after *iin30 is on
execute
> the leave opcode OR....change to a DOWne *ON which will check at the
> start of the do loop.
>
>
> Thanks,
> Tommy Holden
>
>
> -----Original Message-----
> From: rpg400-l-bounces@xxxxxxxxxxxx
> [mailto:rpg400-l-bounces@xxxxxxxxxxxx] On Behalf Of
steema@xxxxxxxxxxxxx
> Sent: Tuesday, January 31, 2006 2:23 PM
> To: RPG programming on the AS400 / iSeries
> Subject: The Dark Side of the Do Loop
>
> I have a subroutine that is predicated on a Doueq.
>
> This cond. is met, yet the program keeps going back into there at the
> first ELSE point, then it goes back to the prev. ENDSR. *in30 has been
> set
> on. All of this, shows up in my debugging.
>
> IOW, it is stuck. I cannot understand how to unravel this.
>
>
>  c                   endsr
>  c     rest          begsr
>  c     *in30         doueq     *on
>  c                   eval      a = j + 10
>  c     er(V)         scan      alphc:a       fl1               2 0
>  c                   if        %found
>  c                   exsr      movar
>  c                   leave
>  c                   else
> --
> 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.
>
>

     d alphas          c                   Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ+
     d                                     abcdefghijklmnopqrstuvwxyz ')
     d alphameric      c                   Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ+
     d                                     abcdefghijklmnopqrstuvwxyz0123456+
     d                                     789')
     d numbers         c                   Const('0123456789')
     d Found_It        s             10i 0
     d Start           s             10i 0
     d End             s             10i 0
     d Invoice1        s             11a
     d Invoice2        s             11a
     d Invoice3        s             11a
     d Comment         s             40a
     DSpecChars        c                   Const(',.#@!$%¢&*()-_=+";:/?><`~\|+
     D                                     ''')
     DBlanks           c                   Const('                            ')
     d Done            s               n   Inz(*Off)

     c                   eval      comment =
     c                             'INVOICES XTC05F008L AND XTC05F012L'
     c*                            'INVOICE #''S XSC04H008L & XTC04H021L'
     c*                            'INVOICE#''S 2107071, 2107073 & 2107079'
     c                   eval      comment=%Xlate(specchars:blanks:comment)

     c                   Eval      Start=1
     c                   DoU       Done
     c                   Eval      Found_It=%Check(Alphas:Comment:Start)
     c                   If        Found_It>0
     c                   Eval      Start=%CheckR(Alphameric:Comment:Found_It)
     c                   Eval      End=%Check(Alphameric:Comment:Found_It)
     c                   If        (End-Start)<=11
     c                   Select
     c                   When      Invoice1=*Blanks
     c                   Eval      Invoice1=%Subst(Comment:Start+1:End-Start)
     c                   When      Invoice2=*Blanks
     c                   Eval      Invoice2=%Subst(Comment:Start+1:End-Start)
     c                   When      Invoice3=*Blanks
     c                   Eval      Invoice3=%Subst(Comment:Start+1:End-Start)
     c                   Leave
     c                   EndSl
     c                   Eval      Start=Start+(End-Start)
     c                   Else
     c                   Eval      Start=Start+1
     c                   EndIf
     c                   If        Start>33
     c                   Eval      Done=*On
     c                   EndIf
     c                   EndIf
     c                   EndDo
     c                   eval      *inlr=*on
     c                   return