H/TITLE Read multiple lines in PRODV/F47047 to calculate aggregiate
     H/TITLE freight total. Originally written for Bluelinx but can be applied
     H/TITLE to any trading partner.
     H DATEDIT(*YMD) OPTION(*DEBUGIO) DEBUG(*YES)
      **************************************************************************
      **
      * Warning: This program does not set on the LR.
      *
      **************************************************************************
      * SYNOPSIS :
      *  External call program which uses the "long
      *  parameter list" to sum all freight lines, for respective invoice, from
      *  F47047.
      *
      * Company       :
      * System        :
      * User name     :
      * Date generated:
      **************************************************************************
      * Maintenance   :
      **************************************************************************
      *   BMR    Date    Description
      *  ---- ---------- ----------------------------------------------------------------
      **************************************************************************
     FF47047_2  IF   E           K DISK    RENAME(F47047:F47047)
      *
      *
      * Data structures:
     d*Pgmds         EsDs                  Extname(EXPGSDS)
      * Program data structure
     d Jbdttm          Ds
      * Job date/time
     d  ##Jdt                  1      6  0
     d  ##Jyy                  1      2  0
     d  ##Jmm                  3      4  0
     d  ##Jdd                  5      6  0
     d  ##Jtm                  7     12  0	
     d  ##Jhh                  7      8  0
     d  ##Jnn                  9     10  0
     d  ##Jss                 11     12  0
      * Parameter declarations
        <--- EXTOL LONG PARM LIST HERE --->
     d Wp0053          DS          9900
     D FRAMT           S              9P 2
     D FRAMT2          S             15P 0
      *
      **************************************************************************
      * Mainline Program.
      **************************************************************************
     C                   EXSR      Srinit
      *
      * External Code process P1
     C                   MOVE      *BLANKS       W0RTN             7            *Return code
     C                   Eval      W0Rtn = *Blanks                              *Return code
      *
      * CASE: PAR.Code trans directions is Inward translation
     C     P1Cdtt        Caseq     'I'           Srstlc                         *CS
      *
      * CASE: PAR.Code trans directions is Outward translation
     C     P1Cdtt        Caseq     'O'           Srlcst                         *CS
     C                   Endcs                                                  *EC
      *
      * A "Return code" of non-blank will be logged as a translation error:
     C                   Eval      P0Rtn = W0Rtn                                *Return code
     C                   Return
      **************************************************************************
      * Srdefn - Definitions
      **************************************************************************
     C     Srdefn        Begsr
      *
      * Entry parameters
     C     *Entry        Plist
        <--- EXTOL LONG PARM ENTRY LIST HERE --->
      *
      *
      * Key to the Item Cross Reference File by 2nd Item/Xref Type/Address Number
     C     KeyF47047     KLIST
     C                   KFLD                    SZEDOC
     C                   KFLD                    SZEDCT
     C                   KFLD                    SZEKCO
     C                   KFLD                    SZLNTY
     C     Endefn        Endsr
      **************************************************************************
      * Srinit - Initialization.
      **************************************************************************
     C     Srinit        Begsr
      *
     C                   Eval      P0Rtn = *Blanks
     C                   Eval      W0Rtn = *Blanks
      *
      * Initialise indicators for re-entry
     C                   Move      '0'           *In
      *
      * Setup job date/time
     C                   Z-add     Udate         ##Jdt
     C                   Time                    ##Jtm
      *
     C     Eninit        Endsr
      **************************************************************************
      * SRLCST - Local to Standard Routine.
      **************************************************************************
     C     Srstlc        Begsr
     C*
      *
     C     Enstlc        Endsr
      **************************************************************************
      * Srlcst - Local to Standard Routine.
      **************************************************************************
     C     Srlcst        Begsr
      *
     C*
     C     P2Cdqd        IFEQ      'EDOC'                                       Initialize 2nd Item
     C                   MOVEL     *ZEROS        WK_EDOC           9 0
     C                   MOVEL     *ZEROS        WKUPRC           15 2
     C                   MOVEL     P2CDLC        WK_EDOC
     C                   END
     C*
     C     P2Cdqd        IFEQ      'EKCO'                                       Initialize 2nd Item
     C                   MOVEL     *BLANKS       WK_EKCO           5
     C                   MOVEL     P2CDLC        WK_EKCO
     C                   END
     C*
     C     P2Cdqd        IFEQ      'EDLN'                                       Initialize 2nd Item
     C                   MOVEL     *ZEROS        WK_EDLN           7 0
     C                   MOVEL     P2CDLC        WK_EDLN
     C                   END
     C*
     C     P2Cdqd        IFEQ      'EDCT'                                       Initialize 2nd Item
     C                   MOVEL     *BLANKS       WK_EDCT           2
     C                   MOVEL     P2CDLC        WK_EDCT
     C                   END
     C*
     C     P2Cdqd        IFEQ      'CONV'                                       Initialize 2nd Item
     C*
     C*
     C                   Z-ADD     WK_EDOC       SZEDOC
     C                   MOVEL     WK_EDCT       SZEDCT
     C                   MOVEL     WK_EKCO       SZEKCO
     C                   MOVEL     'F'           SZLNTY
     C*
     C*
     C
     C                   MOVE      *OFF          *IN91
     C     KEYF47047     SETLL     F47047
     C     KEYF47047     READE     F47047                                 91
     C     *IN91         DOWEQ     *OFF
     C                   ADD       SZAEXP        WKUPRC
     C     KEYF47047     READE     F47047                                 91
     C                   ENDDO
     C*
     C                   Clear                   P2Cdst
     C                   Z-ADD     WKUPRC        FRAMT
     C                   MOVE      FRAMT         P2Cdst
     C                   MOVE      *BLANKS       P2Cdst
     C                   Z-ADD     WKUPRC        FRAMT2
     C                   MOVE      FRAMT2        TEST2             4
     C     TEST2         IFEQ      '0000'
     C     FRAMT2        DIV       100           FRAMT2
     C                   END
     C                   MOVEL     FRAMT2        P2Cdst
     C                   ENDIF
      *
     C     Enlcst        Endsr