|
midrange.com
Several years ago George Shannon helped me with a similar problem. This program
will build a workfile XCOMPWKI with an indented bill of materials. Make sure
you open it with user control on in the calling programs.
Hope this helps.
Patrick
XCOMPWKI.pf
A UNIQUE
A R FXCOMPWKI
A WKSEQ 3 0 COLHDG('SEQUENCE')
A WKLEVL 3 0 COLHDG('LEVEL')
A WKPITM 15 COLHDG('PARENT ITEM')
A WKCITM 15 COLHDG('COMPONENT ITEM')
A WKQPER 11 3 COLHDG('QTY PER')
A K WKPITM
A K WKCITM
XCOMPI.clp:
PGM PARM(&ITEM)
DCL VAR(&ITEM) TYPE(*CHAR) LEN(15)
CLRPFM FILE(XCOMPWKI)
CALL PGM(XCOMPI#A) PARM(&ITEM)
ENDPGM
XCOMPI.rpgle:
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* XCOMPI#A Populate the file XCOMPWK with components
*
* Shows the indent level and the subcomponent parent
*
* This program was liberally copied from source provided to
* me from Shannon, George [GShannon@xxxxxxxxxx]
*
* ITEMASA Get item types
* PSTRUC Item Structure
* XCOMPWK Component work file
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
H/copy wkeplib/pgmsrc,#option
FITEMASA IF E K DISK
FPSTRUC IF E K DISK
FXCOMPWKI UF A E K DISK usropn
*-------------------------------------------------------------------
*?Arrays for holding parent items and components
D PP S 15 DIM(99)
D PU S 4 DIM(99)
D CP S 15 DIM(99)
D CU S 4 DIM(99)
D QT S DIM(99) like(QTYPR)
D qtyneeded s like(QTYPR)
D sequence s like(WKSEQ) inz(0)
*----------------------------------------------------------------
*?Parameter Lists
C *ENTRY PLIST
C PARM InItem
*-------------------------------------------------------------------
*?Product Structure key (full)
C PSKEY KLIST
C KFLD @PINBR
C KFLD @USRS1
C KFLD @CINBR
C KFLD @USRS2
*?Product Structure key (partial)
C PSKEYP KLIST
C KFLD @PINBR
C KFLD @USRS1
* xcomp#a key
C xkey klist
C kfld pinbr
C kfld cinbr
C *LIKE DEFINE ITNBR InItem
C *LIKE DEFINE PINBR @PINBR
C *LIKE DEFINE USRS1 @USRS1
C *LIKE DEFINE CINBR @CINBR
C *LIKE DEFINE USRS2 @USRS2
*-------------------------------------------------------------------
C open XCOMPWKI
C InItem Chain ITEMASA 90
C If (*in90 <> *off)
C Goto EndProgram
C EndIf
C CLEAR PP
C CLEAR PU
C CLEAR CP
C CLEAR CU
C Z-ADD 1 X 2 0
C eval qtyneeded = 1
*?Process product structure
C MOVEL InItem @PINBR
C MOVE *BLANKS @USRS1
C MOVE *BLANKS @CINBR
C MOVE *BLANKS @USRS2
C @PINBR SETLL PSTRUCE1
*?
C X DOUEQ 0
C @PINBR READE PSTRUCE1 95
*?
*? Check if no more components for parent item.
C If *IN95
*? Position to prior level and read next parent.
C SUB 1 X
" *? If no more levels, then end.
C X IFEQ 0
C LEAVE
C ENDIF
*?
C MOVEL PP(X) @PINBR
C MOVEL PU(X) @USRS1
C MOVEL CP(X) @CINBR
C MOVEL CU(X) @USRS2
C PSKEY SETGT PSTRUCE1
C ITER
C ENDIF
*?
*? Check effectivity dates.
C @TODAY IFLT EDATM
C EDATO ORNE 000000
C @TODAY ANDGT EDATO
" *? If not effective, then read next component."
C ITER
C ENDIF
*?
C MOVEL PINBR PP(X)
C MOVEL USRS1 PU(X)
C MOVEL CINBR CP(X)
C MOVEL USRS2 CU(X)
C eval qt(x) = QTYPR
*?
C CINBR SETLL PSTRUCE1 90
C *IN90 IFEQ *ON
* new line
C EXSR WrtCompon
*
C MOVEL CINBR @PINBR
C ADD 1 X
C ELSE
C EXSR WrtCompon
C MOVEL PP(X) @PINBR
C MOVEL PU(X) @USRS1
C MOVEL CP(X) @CINBR
C MOVEL CU(X) @USRS2
C PSKEY SETGT PSTRUCE1
C ENDIF
C ENDDO
C close XCOMPWKI
C EndProgram Tag
C eval *inlr = *on
C return
*****************************************************************
*? S U B R O U T I N E S
*****************************************************************
*****************************************************************
*?WrtCompon- Write component record
*****************************************************************
C WrtCompon BEGSR
* need to determine how many of this component is needed for it's
* immediate component
C if (x > 1)
C eval qtyneeded = qt(x-1)
C else
C eval qtyneeded = 1
C endif
C** CINBR CHAIN FXCOMPWK 88
C xkey CHAIN FXCOMPWKI 88
C If (*in88 <> *off)
C Clear FXCOMPWKI
C MOVEL CINBR WKCITM
C MOVEL ITNBR WKPITM
C MOVEL pinbr WKPITM
C eval WKQPER = QTYPR * qtyneeded
*
C eval WKLEVL = x
*
C eval sequence = sequence + 1
C eval WKSEQ = sequence
*
C WRITE FXCOMPWKI
C EndIf
C ENDSR
*?
*****************************************************************
*?*INZSR- Initialization subroutine
*****************************************************************
C *INZSR BEGSR
*?Calculate TODAY in MAPICS date format (CYYMMDD)
C *DATE MULT 10000.0001 TODAY 8 0
C TODAY SUB 19000000 @TODAY 7 0
C ENDSR
*?
-----Original Message-----
From: mapics-l-bounces@xxxxxxxxxxxx [mailto:mapics-l-bounces@xxxxxxxxxxxx] On
Behalf Of Tim.Bertnick@xxxxxxxxxxxxxxxx
Sent: Tuesday, December 19, 2006 10:53 AM
To: mapics-l@xxxxxxxxxxxx
Subject: [MAPICS-L] indented bill of materials
Good morning - I am looking for some RPG code that I can use to populate a file
that resembles the indented BOM for all manufactured parts - I found some on
the site that uses the EPDM file PSTDTLL0, but we are currently using PDM+ at
XA release 5 so that file is empty. Any help would be appreciated - Thanks ,
Tim Bertnick
Programmer/Analyst
Pentair Filtration, Inc.
502 Indiana Ave.
Sheboygan, WI 53081
Phone: 920 453-9850
tim.bertnick@xxxxxxxxxxxxxxxx
Confidentiality Note: This e-mail message and all attachments to it are
intended only for the named recipients and may contain confidential
information. If you are not one of the intended recipients, please do not
duplicate or forward this e-mail message and immediately delete it from your
computer
______________________________________________________________________
This email has been scanned by the MessageLabs Email Security System.
For more information please visit http://www.messagelabs.com/email
______________________________________________________________________
_______________________________________________
This is the MAPICS ERP System Discussion (MAPICS-L) mailing list To post a
message email: MAPICS-L@xxxxxxxxxxxx To subscribe, unsubscribe, or change list
options,
visit: http://lists.midrange.com/mailman/listinfo/mapics-l
or email: MAPICS-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives at
http://archive.midrange.com/mapics-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.
