Okay, this has to take the cake for a rare combination…a PL/1 program that walks down an assembly chain for a finished good product and explodes out the complete list of raw materials that make up the product. I had to build a “shadow” bill of materials for each finished good item that consisted of the raw materials so I could then simulate chemical reactions and determine the remaining ingredients that where left. If these ingredients were then above certain thresholds they have to be declared on a Material Safety Data Sheet. Wonder how it might look in C# in an OO style using today’s patterns?
/* MSD710P - Load a Product Structure into MSDS from PDM */
MSD710P: PROCEDURE (BR_ITEM_IN) RETURNS(CHAR(2));
/********************************************************************/
/* NAME: MSD710P */
/* PURPOSE: Load the Mapics/38 Product Structure into MSDS System */
/* WRITTEN: 01/30/90 */
/* AUTHOR: John Watson */
/* SYSTEM: IBM System/38 */
/* LANGUAGE: PL/I */
/* SECURITY: None */
/* DESCR: This pgm extracts the product structure of an item */
/* from the Mapics/38 Product Structure file (PSTRUC) */
/* and builds the MSDS Finished Good/Component file */
/* (COMPNT). Only final raw materials are output to the */
/* MSDS system. That is, phantoms and sub-assemblies are */
/* exploded down to their raw materials as well. The raw */
/* material quantities are converted to pounds or gallons */
/* in a batch size of 100 (100 lbs / 100 gals) for the */
/* 100 Unit Formula used by the MSDS system. */
/* NOTE: This is designed as a function to */
/* FACILITATe returning to the caller */
/* with return codes. */
/* */
/* RETURN: 00 = Successful completion */
/* 1x = Problem w/ finished good item */
/* 0 = Item A record not found */
/* 1 = Deleted Item A */
/* 2 = Assembly chain not found */
/* 2x = Problem w/ a component */
/* 0 = PSTRUC not found, assy chain broken/bad */
/* 1 = component Item A record not found */
/* 2 = RRNs don't match */
/* 3 = component Item A deleted */
/* 4 = compare portions don't match */
/* 5 = bad low level code (exceeds 99) */
/* 6 = MSFILM record not found - cannot convert qty */
/* */
/********************************************************************/
/* DECLARE FILES */
DCL
ITEMAKEY FILE RECORD INPUT DIRECT KEYED INTERNAL
ENV(BUFSIZE(256) INDEXED KEYDISP(1) KEYLENGTH(16)),
ITEMARRN FILE RECORD INPUT DIRECT ENV(BUFSIZE(256)) INTERNAL,
ITEMAC FILE RECORD INPUT DIRECT KEYED ENV(DESCRIBED INDEXED),
PSTRUC FILE RECORD INPUT DIRECT ENV(BUFSIZE(96)) INTERNAL,
MSFILMPF FILE RECORD INPUT DIRECT KEYED ENV(DESCRIBED INDEXED),
MSBSRMPF FILE RECORD SEQUENTIAL KEYED ENV(DESCRIBED INDEXED);
/* DECLARE RECORDS FOR INPUT FROM FILES */
DCL 1 COMPNT,
%INCLUDE MSBSRMPF(COMPNT,RECORD);
DCL 1 CFMT,
%INCLUDE ITEMAC(CFMT,RECORD);
DCL 1 RMFILM,
%INCLUDE MSFILMPF(RMFILM,RECORD);
/**************************************************/
/* ITEMAS is internally described because we need */
/* std batch qty of parent from pos. 244-249. */
/**************************************************/
DCL 1 ITEMA_P,
2 PR_ACREC CHAR(1), /* active record code */
2 PR_ITNBR CHAR(15), /* item number */
2 PR_FILL1 CHAR(1), /* filler 1 */
2 PR_IIREC DEC(7,0), /* RRN for this item */
2 PR_LOLEV PIC '9R', /* low level code */
2 PR_IIFAC DEC(7,0), /* RRN of first assembly component */
2 PR_FILL2 CHAR(105), /* filler 2 */
2 PR_UNMSR CHAR(2), /* unit of measure */
2 PR_ITTYP CHAR(1), /* item type */
2 PR_FILL3 CHAR(108), /* filler 3 */
2 PR_SBQTY DEC(11,3), /* standard batch quantity */
2 PR_FILL4 CHAR(7); /* filler 4 */
DCL 1 ITEMA_C,
2 PC_ACREC CHAR(1), /* active record code */
2 PC_ITNBR CHAR(15), /* item number */
2 PC_FILL1 CHAR(1), /* filler 1 */
2 PC_IIREC DEC(7,0), /* RRN for this item */
2 PC_LOLEV PIC '9R', /* low level code */
2 PC_IIFAC DEC(7,0), /* RRN of first assembly component */
2 PC_FILL2 CHAR(105), /* filler 2 */
2 PC_UNMSR CHAR(2), /* unit of measure */
2 PC_ITTYP CHAR(1), /* item type */
2 PC_FILL3 CHAR(108), /* filler 3 */
2 PC_SBQTY DEC(11,3), /* standard batch quantity */
2 PC_FILL4 CHAR(7); /* filler 4 */
DCL 1 PSTRUCT,
2 PPCIM DEC(7,0), /* component item A RRN */
2 PPPIM DEC(7,0), /* parent item "A" RRN */
2 PPNAC DEC(7,0), /* next assembly component RRN */
2 PPFIL1 CHAR(8), /* filler 1 */
2 CCMPI CHAR(1), /* compare portion of item number */
2 PCOMP CHAR(1), /* compare portion of parent item */
2 PPFIL2 CHAR(16), /* filler 2 */
2 EDATM DEC(6,0), /* effective from date */
2 EDATO DEC(6,0), /* effective to date */
2 PPFIL3 CHAR(44), /* filler 3 */
2 QTYPR DEC(11,3); /* quantity per unit */
/* DECLARE VARIABLES */
DCL BATCH_SZ DEC(7,3), /* batch size */
CMP(100) CHAR(1), /* compare characters */
CMP_CHAR CHAR(1), /* compare character */
CNTRL_ID CHAR(3), /* used to redefine PPCIM */
BR_ITEM_IN CHAR(6),
LVL DEC(3,0), /* array subscript */
STD_BAT_QTY DEC(11,3),
RRN(100) DEC(7,0), /* RRNs to chase down assy chains */
REC_NO DEC(7,0), /* RRN workfield */
SBQ(100) DEC(11,3), /* Std batch qty for a given level */
WRK_QTY FLOAT(7);
/* SYSTEM DATE */
DCL CHR_DATE CHAR(6),
TST_DATE DEC(6,0); /* YYMMDD */
DCL 1 PROGRAM_FLAGS STATIC,
2 NO BIT(1) ALIGNED INIT('0'B),
2 YES BIT(1) ALIGNED INIT('1'B),
2 VALID_ITEM_A BIT(1) ALIGNED,
2 VALID_ITEM_C BIT(1) ALIGNED,
2 VALID_PSTRUC BIT(1) ALIGNED,
2 VALID_RMFILM BIT(1) ALIGNED,
2 MORE_COMPNT_RECS BIT(1) ALIGNED;
/* OPEN FILES */
OPEN FILE(ITEMAKEY);
OPEN FILE(ITEMARRN);
OPEN FILE(ITEMAC);
OPEN FILE(MSFILMPF);
OPEN FILE(PSTRUC);
/* ERROR HANDLING */
ON KEY(ITEMAKEY) VALID_ITEM_A=NO;
ON KEY(ITEMARRN) VALID_ITEM_A=NO;
ON KEY(ITEMAC) VALID_ITEM_C=NO;
ON KEY(PSTRUC) VALID_PSTRUC=NO;
ON KEY(MSFILMPF) VALID_RMFILM=NO;
ON KEY(MSBSRMPF) MORE_COMPNT_RECS=NO;
ON ENDFILE(MSBSRMPF) MORE_COMPNT_RECS=NO;
%PAGE;
/* M A I N L I N E */
CHR_DATE=DATE();
TST_DATE=DECIMAL(CHR_DATE,6,0);
BATCH_SZ=100;
LVL=1;
RRN=0;
SBQ=0;
CMP=' ';
/* Get parent Item A */
VALID_ITEM_A=YES;
READ FILE(ITEMAKEY) INTO(ITEMA_P) KEY(BR_ITEM_IN);
SELECT;
WHEN (VALID_ITEM_A=NO) RETURN('10'); /* record not found */
WHEN (PR_ACREC='D') RETURN('11'); /* deleted record */
WHEN (PR_IIFAC=9999999) RETURN('12'); /* no assembly chain */
OTHERWISE;
END;
REC_NO=PR_IIFAC;
STD_BAT_QTY=PR_SBQTY;
CMP_CHAR=SUBSTR(PR_ITNBR,1,1);
/* Clear out old COMPNT records */
OPEN FILE(MSBSRMPF) UPDATE;
MORE_COMPNT_RECS=YES;
READ FILE(MSBSRMPF) INTO (COMPNT) KEY(BR_ITEM_IN);
DO WHILE (MORE_COMPNT_RECS);
DELETE FILE(MSBSRMPF);
READ FILE(MSBSRMPF) INTO (COMPNT);
IF BR_PARENTª=BR_ITEM_IN THEN MORE_COMPNT_RECS=NO;
END;
CLOSE FILE(MSBSRMPF);
OPEN FILE(MSBSRMPF) OUTPUT;
/* begin down an assembly chain */
TOP:;
RRN(LVL)=REC_NO; /* point to first component */
SBQ(LVL)=BATCH_SZ; /* set batch size */
CMP(LVL)=CMP_CHAR; /* set compare values */
/* start of loop for next component */
CHAIN: DO UNTIL(REC_NO=9999999);
/* get next component */
VALID_PSTRUC=YES;
READ FILE(PSTRUC) INTO(PSTRUCT) KEY(REC_NO);
IF VALID_PSTRUC=NO THEN RETURN('20');
/* check for control record */
CNTRL_ID=CHAR(PPCIM,3);
IF CNTRL_ID='.PS' THEN RETURN('20');
/* check dates */
IF (EDATM>=TST_DATE) ³ (EDATOª=0 & EDATO<=TST_DATE) THEN DO;
REC_NO=PPNAC; /* outside dates - get next component */
ITERATE CHAIN;
END;
/* get component Item A */
VALID_ITEM_A=YES;
READ FILE(ITEMARRN) INTO(ITEMA_C) KEY(PPCIM);
SELECT;
WHEN(VALID_ITEM_A=NO) RETURN('21'); /* no comp. Item A */
WHEN(PC_IIRECª=PPCIM) RETURN('22'); /* RRNs don't match */
WHEN(PC_ACREC='D') RETURN('23'); /* Item A deleted */
WHEN(SUBSTR(PC_ITNBR,1,1)ª=CCMPI) RETURN('24'); /* compare char */
WHEN(PC_LOLEV>99) RETURN('25'); /* bad low level */
OTHERWISE;
END;
/* Check if this component is an intermediate. */
/* If so, push current parent's values into */
/* arrays, set up work fields with new parent */
/* information and goto top to start down */
/* the chain of the new parent. */
IF (PC_ITTYP='1') ³ (PC_IIFACª=9999999) THEN DO;
/* save current parent values */
RRN(LVL)=PPNAC;
SBQ(LVL)=STD_BAT_QTY;
CMP(LVL)=CMP_CHAR;
/* set up work fields with new parent values */
REC_NO=PPNAC;
STD_BAT_QTY=PR_SBQTY;
CMP_CHAR=SUBSTR(PC_ITNBR,1,1);
/* increase current level */
LVL=LVL+1;
GOTO TOP;
END;
/* get component Item C */
READ FILE(ITEMAC) INTO (CFMT) KEY(PC_ITNBR);
/* extend component qty & convert to lbs */
WRK_QTY=BATCH_SZ/STD_BAT_QTY*QTYPR;
SELECT;
WHEN(PC_UNMSR='LB');
WHEN(PC_UNMSR='GA') WRK_QTY=WRK_QTY*MC#GAL;
WHEN(PC_UNMSR='GM') WRK_QTY=WRK_QTY/453.59;
WHEN(PC_UNMSR='FL') WRK_QTY=(WRK_QTY*MC#GAL)/128;
WHEN(PC_UNMSR='OZ') WRK_QTY=WRK_QTY/16;
WHEN(PC_UNMSR='LY') DO;
READ FILE(MSFILMPF) INTO(RMFILM) KEY(PC_ITNBR);
IF VALID_RMFILM THEN DO;
WRK_QTY=WRK_QTY*RF_WIDTH*RF_THICKNESS*.155844*MC#GAL;
END;
ELSE RETURN('26'); /* no MSFILMPF record */
END;
OTHERWISE;
END;
/* write out COMPNT */
BR_COMP_QTY=WRK_QTY;
BR_PARENT=BR_ITEM_IN;
BR_COMPONENT=SUBSTR(PC_ITNBR,1,6);
WRITE FILE(MSBSRMPF) FROM (COMPNT) KEYFROM(*);
REC_NO=PPNAC;
END; /* DO group */
/* At this point, we have reached the end of an */
/* assembly chain (PPNAC=9999999). Check to see */
/* if we encountered any intermediates along the */
/* way. If we did, pull back up one level and */
/* continue down the previous parent's chain. */
DO WHILE(LVL>1);
LVL=LVL-1;
IF RRN(LVL)ª=9999999 THEN DO;
REC_NO=RRN(LVL);
STD_BAT_QTY=SBQ(LVL);
CMP_CHAR=CMP(LVL);
GOTO CHAIN;
END;
END;
RETURN('00'); /* DONE! */
END MSD710P;
No comments:
Post a Comment
Note: Only a member of this blog may post a comment.