Wednesday, May 2, 2012

Extracting MSDS Finished Goods from MAPICS/38 using PL/1

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.