|
midrange.com
Well I spent some time and tried the DS with the Overlay of the file field
into array, but got this:
*RNF4138 30 48 Externally-Described Field used as array name.
Definition specification is ignored.
*RNF7303 30 35 Subfield defined with keyword OVERLAY is too
big;specification ignored.
D DS
D FXQS 70A Dim(36)
D FXQS01 Overlay(FXQS:1)
D FXQS02 Overlay(FXQS:*next)
D FXQS03 Overlay(FXQS:*next)
D FXQS04 Overlay(FXQS:*next)
D FXQS05 Overlay(FXQS:*next)
D FXQS06 Overlay(FXQS:*next)
D FXQS07 Overlay(FXQS:*next)
D FXQS08 Overlay(FXQS:*next)
D FXQS09 Overlay(FXQS:*next)
D FXQS10 Overlay(FXQS:*next)
D FXQS11 Overlay(FXQS:*next)
D FXQS12 Overlay(FXQS:*next)
D FXQS13 Overlay(FXQS:*next)
Etc. Up to 36
D DS
D SSQS 15S 0 Dim(12)
D SSQS01 Overlay(SSQS:1)
D SSQS02 Overlay(SSQS:*next)
D SSQS03 Overlay(SSQS:*next)
D SSQS04 Overlay(SSQS:*next)
D SSQS05 Overlay(SSQS:*next)
D SSQS06 Overlay(SSQS:*next)
D SSQS07 Overlay(SSQS:*next)
D SSQS08 Overlay(SSQS:*next)
D SSQS09 Overlay(SSQS:*next)
D SSQS10 Overlay(SSQS:*next)
D SSQS11 Overlay(SSQS:*next)
D SSQS12 Overlay(SSQS:*next)
Looks like Duane's example below history?? Like it better than my
CalBuckets subroutine with multi exsr for each field.
Tried to keep changing to fix but no success..probably right in front of
me...but did not see....
Got Brave and remembered reading about creating a pointer pointing to
memory and then basing my array
on that pointer.
Soooo this is what I did to fix.
Anyone see any problems with fix????
Or have I learned something this evening :)
*
*
D E DS EXTNAME(FXFCAST) Inz
D @FXQS S * Inz(%addr(FXQS01))
D FXQS S like(FXQS01) based(@FXQS)
D dim(36)
D E DS EXTNAME(F4229L99)
D @SSQS S * Inz(%addr(SSQS01))
D SSQS S like(SSQS01) based(@SSQS)
D Dim(12)
* Down in Code
C Select
*
C When SSCTRY = CC and
C SSFY = YY
C Eval Z = 1
*
C When SSCTRY = CC and
C SSFY = YY + 1
C Eval Z = 13
*
C When SSCTRY = CC and
C SSFY = YY + 2
C Eval Z = 25
*
C Endsl
*
*
*
C Eval X = 1
*
C DoW X <= 12
*
C Clear WQTY
C EvalR WQTY = %trimr(FXQS(Z))
C ' ':'0' Xlate WQTY WQTY
C Eval WQTYN = WQTYN + SSQS(X)
C Eval FXQS(Z) = %triml(%editc(WQTYN:'4'))
C Eval X = X + 1
C Eval Z = Z + 1
*
C EndDo
*
*
Thanks All Help today I'm going home.
Bill Hopkins
"Bill Hopkins" <BHopkins@xxxxxxxxxxxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
08/14/2003 04:22 PM
Please respond to RPG programming on the AS400 / iSeries
To: RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
cc:
Subject: RE: Character to Numeric can it be cleaned up
Thanks again
Char 70A file is 36 fields of FXSQ01,FXSQ02,etc.
Num File with 12 Qtys for a year. exp. SSFile
Start Year 2 years back.
So would I then use what you have but add.
D DS
D FXQS 70A Dim(36)
D FXQS01 Overlay(FXQS:1)
D FXQS02 Overlay(FXQS:*next)
.
.
.
D FXQS36 Overlay(FXQS:*next)
D DS
D SSQS 15S 0Dim(12)
D SSQS01 Overlay(SSQS:1)
D SSQS02 Overlay(SSQS:*next)
.
.
.
D SSQS36 Overlay(SSQS:*next)
D DS
D WQTY 1 15A
D WQTYN 1 15S 0
D y S 5U 0
D x S 5U 0
Eval StartYear = %subdt(%date() -
%years(3):*Y)
*loval Setll CHAR 70A
Read CHAR 70A
Dow Not %Eof
Eval x = 1
Select
When SSFile Year = StartYear
Eval y = 1
When SSFile Year = StartYear + 1
Eval y = 13
When SSFile Year = StartYear + 2
Eval y = 25
Endsl
DoW x <= 12
Clear WQTY
EvalR WQTY = %trimr(FXQS(y))
' ':'0' Xlate WQTY WQTY
Eval WQTYN = WQTYN + SSQS(X)
Eval FXQS(y) = %triml(%editc(WQTYN:'4'))
Eval x = x + 1
Eval y = y + 1
EndDo
Update Char 70A file record
Read CHAR 70A
Enddo
Thanks
Bill Hopkins
"Johnson, Duane" <djohnson@xxxxxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
08/14/2003 03:36 PM
Please respond to RPG programming on the AS400 / iSeries
To: "'RPG programming on the AS400 / iSeries'"
<rpg400-l@xxxxxxxxxxxx>
cc:
Subject: RE: Character to Numeric can it be cleaned up
In that case, how about something like this?
D DS
D FXQS 70A Dim(36)
D FXQS01 Overlay(FXQS:1)
D FXQS02 Overlay(FXQS:*next)
.
.
.
D FXQS36 Overlay(FXQS:*next)
D DS
D SSQS 15S 0Dim(12)
D SSQS01 Overlay(SSQS:1)
D SSQS02 Overlay(SSQS:*next)
.
.
.
D SSQS36 Overlay(SSQS:*next)
D DS
D WQTY 1 15A
D WQTYN 1 15S 0
D x S 5U 0
Eval x = 0
DoW x < 12
Eval x = x + 1
Clear WQTY
EvalR WQTY = %trimr(FXQS(x))
' ':'0' Xlate WQTY WQTY
Eval WQTYN = WQTYN + SSQS(X)
Eval FXQS(x) = %triml(%editc(WQTYN:'4'))
EndDo
or something along those lines. I don't remember if you can now do a For
-
EndFor in normal RPG. If so, that would probably be more appropriate than
the DoW that I have here.
Duane
> -----Original Message-----
> From: Bill Hopkins [SMTP:BHopkins@xxxxxxxxxxxxxxxxxxx]
> Sent: Thursday, August 14, 2003 1:06 PM
> To: RPG programming on the AS400 / iSeries
> Subject: Re: Character to Numeric can it be cleaned up
>
> Thanks Duane and Buck,
>
> I have Char FXQS?? 70 A buckets 1 thru 36 the SSQS?? 1 thru 12 is 15s
0
>
> Char field starts left justified and has to end left justified
>
> So I build "sorry to say" subroutine not procedure to
>
> exsr and do this:
>
> Eval WQTY = FXQS01
> Eval NQTY2 = SSQS01
> Exsr CalBucket
> Eval FXQS01 = WQTY
>
> Eval WQTY = FXQS02
> Eval NQTY2 = SSQS02
> Exsr CalBucket
> Eval FXQS02 = WQTY
>
> etc.
>
> CalBucket Begsr
>
> Evalr WQTY = %trimr(WQTY)
> MOVE WQTY NQTY1
> Eval WQTY = %triml(%editc((NQTY1 + NQTY2):'4'))
>
> Endsr
>
> Thanks
>
> Bill Hopkins
> _______________________________________________
> 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.
_______________________________________________
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-2024 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.
