|
Hey Rich,
Isn't the header (EDPOH1L1) read commented out?
Rob
On 8/8/2016 12:14 PM, Richard Reeve wrote:
All,
I'm confused and ashamed to say that I'm having trouble seeing the
problem in this simple program. All I'm doing is reading a header file
(primary) then if not %eof reading all the associated detail recs
determining/updating the weight of each line and writing the total weight
to the header.
The issue is that while I'm not getting an eof condition on the
header, when I look at any of the header fields on the first read they are
blank.
What am I not seeing? Thanks for any advise/help.
Rich
Here is the pgm
FEDPOH1L1 IP E K DISK PREFIX(H)
FDDMF4101_2IF E K DISK
F**EDPOH1L1 UF E K DISK PREFIX(H)
FEDPOD1L1 UF E K DISK
FDDMF41002 IF E K DISK
DKMMCU S LIKE(UMMCU)
DKMITM S LIKE(UMITM)
DKUMUM S LIKE(UMUM)
DKUMRUM S LIKE(UMRUM)
DTOTALWGT S 10 4 INZ(*ZEROS)
DWGTACCUM S 10 4 INZ(*ZEROS)
DITEMNBR S LIKE(IMLITM)
**FOR REGULAR GRAINGER ONLY
D GRAINGERID C CONST('005103494')
C** READ EDPOH1L1
C** DOW NOT %EOF(EDPOH1L1)
C IF HPARTID = GRAINGERID
C CLEAR WGTACCUM
C POD1KEY SETLL EDPOD1L1
C POD1KEY READE EDPOD1L1
C DOW NOT %EOF(EDPOD1L1)
c eval itemnbr = *blanks
C MOVEl(p) PO109 ITEMNBR
C ITEMNBR CHAIN DDMF4101_2
C IF %FOUND(DDMF4101_2)
C EVAL KMMCU = *BLANKS
C EVAL KMITM = IMITM
C EVAL KUMUM = 'EA'
C EVAL KUMRUM = 'LB'
C K41002 CHAIN DDMF41002
C IF %FOUND(DDMF41002)
C EVAL CUR03B = PO102 * (UMCONV * .00000
C EVAL WGTACCUM = WGTACCUM + CUR03B
C UPDATE F850D1
C END
C END
C POD1KEY READE EDPOD1L1
C ENDDO
C EVAL HCUR03 = WGTACCUM
C** UPDATE F850H1
C CLEAR WGTACCUM
C ENDIF
C** READ EDPOH1L1
C** ENDDO
C** EVAL *INLR = *ON
C* FIRST TIME PROCESSING
C *INZSR BEGSR
C POD1KEY KLIST
C KFLD HPARTID
C KFLD HPONUM
C KFLD HST02
C KFLD HMAILID
C K41002 KLIST
C KFLD KMMCU
C KFLD KMITM
C KFLD KUMUM
C KFLD KUMRUM
C ENDSR
--
This is the RPG programming on the IBM i (AS/400 and 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.
Please contact support@xxxxxxxxxxxx for any subscription related
questions.
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.