********************************************************************;
* modifications to NONMOD12 in response to MPA/USPS-T16-17;
* PROGRAM NMD12MPA;
* DISTRIBUTE SINGLE ITEMS AND PIECES/ITEMS IN IDENTIFIED CONTAINERS
  EXCEPT FOR THOSE IN ALLIED COST POOL;

********************************************************************;

 OPTIONS ERRORS=1 NODATE;

  DATA MIX;
    SET OUT2.ITEMPC;

   PROC SORT;
    BY POOL HANDLING TYPE;
    PROC MEANS NOPRINT  ;
    ID F9214 F9219;
    BY POOL HANDLING TYPE;
    VAR WGT;
    OUTPUT OUT=ITEMMIX
    SUM=;

  DATA ITEMPLF ITEM1;
    SET ITEMMIX;

     * separate items in containers in 'allied' from other items;
     * they will be distributed based on items from all pools,
       excluding REGISTRY & MISC;

    IF POOL='ALLIED'                     THEN OUTPUT ITEMPLF;
    ELSE OUTPUT ITEM1;

   *---------------------------------------------------------------;

    %MACRO ITEM(TYPE);

  * count number of different activity codes for a specified item type;

    DATA KEY (DROP=HANDLING);
    SET OUT2.NMODKEY ;
    IF 'A'<=F9219<='J' THEN DELETE; * EXCL. CONT WITH IDENTICAL MAIL ;
    IF TYPE = "&TYPE";
    PROC SORT;
    BY POOL;

   DATA KEYSUB(KEEP=POOL SUBTOT)
        KEYALL(DROP=SUBTOT);
    SET KEY;
    BY POOL;
    IF FIRST.POOL THEN COUNTER=0;
      RETAIN COUNTER;
      COUNTER = COUNTER + 1;
      SUBTOT  = COUNTER ;
    IF LAST.POOL THEN OUTPUT KEYSUB;
                      OUTPUT KEYALL;

   PROC SORT DATA=KEYALL;
    BY ACTV ;
    PROC MEANS NOPRINT;
     BY ACTV ;
     ID TYPE;
     VAR KEY;
     OUTPUT OUT=LEVEL1
     SUM=KEY1;
    PROC MEANS NOPRINT DATA=KEYALL;
     ID TYPE;
    VAR KEY;
    OUTPUT OUT=LEVEL1A
    SUM=KEYTOT1;
   PROC SORT DATA=KEYALL;
   BY POOL COUNTER;

   DATA ALLTYPE ;
    MERGE LEVEL1 LEVEL1A;
    BY TYPE;
   DATA ALLTYPE ;
    SET ALLTYPE END=EOF;
    PTUPLE= _N_;
    IF EOF THEN DO;
       CALL SYMPUT('REC', PTUPLE);
               END;

   DATA FILL ;
    SET ITEM1;
    IF TYPE = "&TYPE ";
     PROC SORT;
     BY POOL;

 * extract records for which a key exists and identifies those without;

   DATA MATCH NO&TYPE NONEED;
    MERGE KEYSUB(IN=PP1) FILL(IN=PP2);
    BY POOL;
    IF PP1 AND PP2 THEN OUTPUT MATCH;
    IF PP1=0 AND PP2=1 THEN OUTPUT NO&TYPE;
    IF PP1=1 AND PP2=0 THEN OUTPUT NONEED ;

  * create a record with counter for each actv code in the key;

   DATA KEYFILL;
    SET MATCH;
    DO COUNTERN = 1 TO SUBTOT;
       COUNTER = COUNTERN;
       OUTPUT;
     END;
    PROC SORT;
     BY POOL COUNTER;

  * fill in items for each record created in preceding step;

   DATA FILLIN MISSED NONEED;
    MERGE KEYALL(IN=AA) KEYFILL(IN=BB);
    BY POOL COUNTER;

  * subdivide/readjust weight for created records;

    DOLLAR = WGT*KEY/KEYTOT;
    IF AA AND BB THEN DO; STAGE='1'; OUTPUT FILLIN; END;
    IF AA=0 AND BB=1 THEN OUTPUT MISSED;
    IF AA=1 AND BB=0 THEN OUTPUT NONEED ;

   DATA NOMATCH;
    SET NO&TYPE ;
    COUNTER=SYMGET('REC');
    DO PREC=1 TO COUNTER;
       PTUPLE=PREC;
       OUTPUT;
                 END;
    PROC SORT; BY PTUPLE;

   DATA FILLIN1 MISSED1 NONEED;
    MERGE NOMATCH(IN=A1) ALLTYPE(IN=B1);
    BY PTUPLE;
    DOLLAR = WGT*KEY1/KEYTOT1;
    IF A1 AND B1 THEN DO; STAGE='2'; OUTPUT FILLIN1 ; END;
    IF A1=0 AND B1=1 THEN OUTPUT NONEED  ;
    IF A1=1 AND B1=0 THEN OUTPUT MISSED1;

   DATA I&TYPE;
    SET FILLIN(DROP=COUNTER) FILLIN1(DROP=COUNTER);

   %MEND;
   %ITEM(BUNDLE);
   %ITEM(CONCON);
   %ITEM(TRAY_F);
   %ITEM(TRAY_L);
   %ITEM(TRAY_P);
   %ITEM(PALLET);
   %ITEM(OTHR_I);
   %ITEM(SCKB_O);
   %ITEM(SCKGRN);
   %ITEM(SCKO_Y);
   %ITEM(SCKBWN);
   %ITEM(SCKWH1);
   %ITEM(SCKWH2);
   %ITEM(SCKWH3);
   %ITEM(SCKOTH);
 * %ITEM(SCKINT);
   %ITEM(PC_CRD);
   %ITEM(PC_LTR);
   %ITEM(PC_FLT);
   %ITEM(PC_IPP);
   %ITEM(PC_PCL);

  DATA ITEMITEM;
    SET IBUNDLE
        ICONCON
        ITRAY_F
        ITRAY_L
        IPALLET
        IOTHR_I
        ISCKB_O
        ISCKGRN
        ISCKO_Y
        ISCKBWN
        ISCKWH1
        ISCKWH2
        ISCKWH3
        ISCKOTH
        IPC_CRD
        IPC_LTR
        IPC_FLT
        IPC_IPP
        IPC_PCL
        ITRAY_P ;
      * ISCKINT ;

   DATA OUT2.ITEMFILL;
     SET ITEMITEM;