|
midrange.com
Here's the fun stuff. The program produces a file that resembles the
printed indented BOM. I have put the file in Browser and it is highly
utilized in our facility to look at costing, determine spare parts lists,
produce manuals, look at availability, etc. Hope you find it as enjoyable
as I did.
Also here's a challenge. When I wrote this a couple of years ago, I was
forced to use native access (non-SQL) inside the sub procedure in order to
maintain the database pointer at each level. SQL wanted to delete and
recreate the cursor. If someone could tell me how this could be done in SQL
I would be very interested as this is the only thing I have not been able to
get SQL to do.
Lisa
First the file: EGR0111P
A UNIQUE
* 07/03/2003 LAT Indented Bill of Material
A R R0111
A SITE 3 TEXT('Site')
A ITEM 15 TEXT('Item')
A REV 6 TEXT('Revision')
A SEQ 7S 0 TEXT('Sequence')
A LEVEL 10 TEXT('Relative Level')
A PINBR 15 TEXT('Parent Item')
A PITR 6 TEXT('Parent Item Revision')
A CINBR 15 TEXT('Component Item')
A CITR 6 TEXT('Component Item Revision')
A QTYPR 11S 3 TEXT('Quantity per')
A SPARECODE 5 TEXT('Spare Code')
A SPAREQTY 3S 0 TEXT('Spare Quantity')
A K SITE
A K PINBR
A K PITR
A K SEQ
A K CINBR
A K CITR
Program: EGR0111R
NOTE: It can be compiled without the binding directory. Just remove the
H-spec.
H BNDDIR('CMALIB/CMABNDDIR') DFTACTGRP(*NO) ACTGRP(*CALLER)
* Program: EGR0111R - Indented Bill of Material
* Programmer: Lisa Thomas Date: 07/03/2003
*-------------------------------------------------------------------------*
* Bill of Material Component File
FPSTDTLL0 IF E K DISK
D EGR0111R PR EXTPGM('EGR0111R')
D Site 3 CONST
D Parent 15 CONST
D ParentRev 6 CONST
D AltID 10 CONST
D EGR0111R PI
D Site 3 CONST
D Parent 15 CONST
D ParentRev 6 CONST
D AltID 10 CONST
D NextComponent PR
D LevelNumber 3S 0 VALUE
D Site 3 VALUE
D Item 15 VALUE
D Rev 6 VALUE
D AltId 10 VALUE
D Seq S 7S 0
C/EXEC SQL
C+ DELETE from EGR0111P
C/END-EXEC
C eval Seq = 0
C callp NextComponent(1:Site:Parent:ParentRev:AltId)
C eval *inLR = *on
* Recursive NextComponent subprocedure. Drills down through the Bill of
* Materials populating the work file as it goes.
P NextComponent B
D PI
D LevelNumber 3S 0 VALUE
D Site 3 VALUE
D Item 15 VALUE
D Rev 6 VALUE
D AltId 10 VALUE
* Local variables - visible only within this subprocedure.
D Level S 10
D SaveUserSeq S 4
D SaveItem S 15
D SaveRev S 6
C CompKey KList
C KFld Site
C KFld Item
C KFld Rev
C KFld AltId
C CompKey2 KList
C KFld Site
C KFld Item
C KFld Rev
C KFld AltId
C KFld SaveUserSeq
C KFld SaveItem
C KFld SaveRev
C CompKey setll PstDtlL0
C CompKey ReadE PstDtlL0
C dow not %eof
* Update the global Seq and write new record
C eval Seq = Seq + 1
C exsr WriteRec
* Save the Component in the local variable and recursively call
* NextComponent, updating the level number and passing the current
* component as the parent.
C eval SaveUserSeq = USR1CU
C eval SaveItem = CITMCU
C eval SaveRev = CITRCU
C callp NextComponent(LevelNumber + 1:Site:
C CITMCU:CITRCU:AltId)
C CompKey2 setgt PstDtlL0
C CompKey ReadE PstDtlL0
C enddo
C WriteRec begsr
C select
C when LevelNumber = 1
C eval Level = '1 '
C when LevelNumber = 2
C eval Level = '.2 '
C when LevelNumber = 3
C eval Level = '..3 '
C when LevelNumber = 4
C eval Level = '...4 '
C when LevelNumber = 5
C eval Level = '....5 '
C when LevelNumber = 6
C eval Level = '.....6 '
C when LevelNumber = 7
C eval Level = '......7 '
C when LevelNumber = 8
C eval Level = '.......8 '
C when LevelNumber = 9
C eval Level = '........9 '
C when LevelNumber = 10
C eval Level = '........10'
C endsl
C/EXEC SQL
C+ INSERT INTO EGR0111P
C+ (SITE,
C+ ITEM,
C+ REV,
C+ SEQ,
C+ LEVEL,
C+ PINBR,
C+ PITR,
C+ CINBR,
C+ CITR,
C+ QTYPR,
C+ SPARECODE,
C+ SPAREQTY)
C+ VALUES(:Site,
C+ :Parent,
C+ :ParentRev,
C+ :Seq,
C+ :Level,
C+ :Item,
C+ :Rev,
C+ :CITMCU,
C+ :CITRCU,
C+ :QPERCU,
C+ :UUGACU,
C+ :UUT1CU)
C/END-EXEC
C endsr
P NextComponent E
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.
