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
By: Sean Hoppe on
