SlideShare a Scribd company logo
COBOL DB2 Program RPR6520
Project: ACR Service Plans Revamp
DEVELOPED BY APPROVED BY
NAME Jon Fortman Tim Reagan
ROLE SME/Developer Asst. Dir.
******************************************************************
IDENTIFICATION DIVISION.
******************************************************************
PROGRAM-ID. RPR6520.
AUTHOR. J.FORTMAN.
DATE-WRITTEN. 05/01/1998.
DATE-COMPILED.
*INSTALLATION. TANDY INFORMATION SERVICES.
*COPYRIGHT (C) 1998,TANDY INFORMATION SERVICES
*SECURITY. RACF.
*REMARKS.
******************************************************************
* C O N T R A C T S E R V I C E S
*
* ACR/RSSP PRICE MAINTENANCE BATCH XMIT
*
* EXTRACT RSSP PRICE INFORMATION FROM DB2. PRICE-FILE-OUT IS
* AN EXACT PICTURE OF WHAT IS PULLED FROM DB2 WITH ONE
* EXCEPTION WHICH IS THE DOLLAR AMOUNTS WHICH ARE OUTPUT AS
* ZONED DECIMAL INSTEAD OF PACKED DECIMAL. OTHER THAN THIS NO
* DATA MANIPULATION IS DONE PRIOR TO OUTPUT.
*
* FOR EASE OF PROCESSING FLOW, WE ARE OPENING ESSENTIALLY THE
* SAME CURSOR 3 TIMES BUT SELECTING DIFFERENT FIELDS FOR EACH.
* THIS MAKES WRITING AND PROCESSING THE DIFFERENT REC TYPES
* EASIER.
*
* THE ABEND FAILSAFES IN THE 911- PARAGRAPHS AREA HANDLE EMPTY
* CURSORS ONLY FOR THE MAIN ATTRIBUTE CURSORS: SVP CATG ID,
* SVP SKU ID, SVP CATG ASOC. FOR SUBATTRIBUTE CURSORS SUCH AS
* COMPONENT SKUS AND SVP COST AMT, WE ONLY ISSUE AN INFORMATIONAL
* MESSAGE PER CURSOR OPEN.
******************************************************************
ENVIRONMENT DIVISION.
******************************************************************
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-OS390.
OBJECT-COMPUTER. IBM-OS390.
******************************************************************
INPUT-OUTPUT SECTION.
******************************************************************
FILE-CONTROL.
SELECT CONTROL-FILE-IN ASSIGN TO RPRCTRLI
FILE STATUS CTRL-STATUS
RECORD KEY CTRL-FILE-KEYS
ORGANIZATION INDEXED
ACCESS SEQUENTIAL.
SELECT PRICE-FILE-OUT ASSIGN TO RPRPRICO
FILE STATUS PRICE-STATUS.
******************************************************************
DATA DIVISION.
******************************************************************
FILE SECTION.
FD CONTROL-FILE-IN
RECORD CONTAINS 250 CHARACTERS.
01 SCCTRL-CONTROL-RECORD.
COPY SCCTRL REPLACING ==:CTRL:== BY ==CTRL==.
FD PRICE-FILE-OUT
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 300 CHARACTERS.
01 PRICE-FILE-OUT-REC.
COPY SCTSPPRC REPLACING ==:PRIC:== BY ==PRIC==.
****************************************************************
WORKING-STORAGE SECTION.
****************************************************************
COPY CNVDTWS.
01 SV-PRICE-FILE-OUT-REC.
COPY SCTSPPRC REPLACING ==:PRIC:== BY ==SV==.
01 COUNTER-VARIABLES.
05 CT-NBR-RETRIES PIC 9(2) VALUE ZERO.
05 CT-PRNT-LINES PIC 9(3) VALUE 54.
05 CT-PAGE-NUM PIC 9(3) VALUE ZERO.
05 CT-TOT-A-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-TOT-B-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-TOT-BA-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-TOT-BB-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-TOT-C-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-TOT-ALL-RECS-WRITTEN PIC 9(8) VALUE ZERO.
05 CT-SVP-CATG-CUR-FETCHED PIC 9(8) VALUE ZERO.
05 CT-SVP-SKU-ID-CUR-FETCHED PIC 9(8) VALUE ZERO.
05 CT-SVP-COMP-SKU-CUR-FETCHED PIC 9(8) VALUE ZERO.
05 CT-SVP-COST-AMT-CUR-FETCHED PIC 9(8) VALUE ZERO.
05 CT-SVP-CATG-ASOC-CUR-FETCHED PIC 9(8) VALUE ZERO.
01 WS-ERR-MSG.
05 WS-ERR-MSG1 PIC X(50) VALUE SPACES.
05 WS-ERR-MSG2 PIC X(50) VALUE SPACES.
05 WS-ERR-MSG3 PIC X(50) VALUE SPACES.
05 WS-ERR-MSG4 PIC X(50) VALUE SPACES.
01 WS-ERRORS.
05 WS-ERR-SKU PIC X(8) VALUE SPACES.
05 WS-ERR-CVRG-LGTH PIC X(4) VALUE SPACES.
05 WS-ERR-PRICE-TYP PIC X(7) VALUE SPACES.
05 WS-ERR-SKU-CATG PIC X(20) VALUE SPACES.
05 WS-ERR-XMIT-CD PIC X(5) VALUE SPACES.
05 WS-ERR-LOC-CD PIC X(7) VALUE SPACES.
05 WS-ERR-WTY-STUS PIC X(7) VALUE SPACES.
01 WS-VARIABLES.
05 WS-SVP-RTL-AMT PIC 9(7)V99.
05 WS-EDIT-COMP4 PIC ZZZ9.
05 WS-EDIT-REC-COUNT PIC ZZ,ZZZ,ZZ9.
05 WS-EDIT-SQLCODE PIC ZZZ,ZZZ,ZZ9-.
05 WS-EDIT-RETRY-PM PIC ZZZ9.
05 WS-XMIT-DEST-CD PIC X(6).
05 WS-DISPLAY PIC X(50) VALUE SPACES.
05 WS-SQL-SLS-CHNL-ID PIC X(20) VALUE SPACES.
05 WS-SPIFF-AMT PIC S9(7)V99 COMP-3.
05 WS-PRICE-AMT PIC S9(5)V99 COMP-3.
05 WS-SPIFF-PCT PIC S9(3)V99 COMP-3.
05 WS-9999 PIC 9(4).
05 CT-LEAD-ZEROS PIC 9(3).
05 WS-FIELD-LEN PIC 9(3).
05 WS-WRNTY-YRS PIC 9(2).
05 WS-WRNTY-MTHS PIC 9(2).
05 CTRL-STATUS PIC 9(2).
05 PRICE-STATUS PIC 9(2).
05 WS-CVRG-LGTH-DAYS PIC S9(4) COMP.
05 CTRL-XMIT-SUB PIC S9(4) COMP.
05 CTRL-WTY-TYP-SUB PIC S9(4) COMP.
05 WS-DEST-SUB PIC S9(4) COMP.
05 ABEND-CD PIC S9(9) BINARY.
05 TIMING PIC S9(9) BINARY.
01 WS-DATES.
05 WS-SYS-TIME.
10 WS-SYS-HH PIC 99.
10 WS-SYS-MIN PIC 99.
10 WS-SYS-SS PIC 99.
05 WS-CURR-YYYYSMMSDD.
10 WS-CURRENT-YYYY PIC X(4).
10 F PIC X(1) VALUE '/'.
10 WS-CURRENT-MM PIC X(2).
10 F PIC X(1) VALUE '/'.
10 WS-CURRENT-DD PIC X(2).
05 WS-CURRENT-YYYYMMDD.
10 WS-CURRENT-YYYY PIC X(4).
10 WS-CURRENT-MM PIC X(2).
10 WS-CURRENT-DD PIC X(2).
05 WS-CURRENT-MMDDYYYY.
10 WS-CURRENT-MM PIC X(2).
10 WS-CURRENT-DD PIC X(2).
10 WS-CURRENT-YYYY PIC X(4).
05 WS-DSCNTU-CUTOFF-DT PIC X(10).
05 F REDEFINES WS-DSCNTU-CUTOFF-DT.
10 WS-DSCNTU-MM PIC X(2).
10 WS-DSCNTU-SL1 PIC X(1).
10 WS-DSCNTU-DD PIC X(2).
10 WS-DSCNTU-SL2 PIC X(1).
10 WS-DSCNTU-YYYY PIC X(4).
01 WS-MISC-INDS.
05 WS-SPIFF-ERROR-IND PIC X.
88 SPIFF-ERROR VALUE 'Y'.
05 WS-FOUND-IND PIC X.
88 FOUND VALUE 'Y'.
88 NOT-FOUND VALUE 'N'.
05 WS-CONTROL-FILE-IND PIC X.
88 EOF-CONTROL-FILE-IN VALUE 'Y'.
05 WS-SVP-CATG-ID-CUR-IND PIC X.
88 END-OF-SVP-CATG-ID-CUR VALUE 'Y'.
05 WS-SVP-SKU-ID-CURSOR-IND PIC X.
88 END-OF-SVP-SKU-ID-CURSOR VALUE 'Y'.
05 WS-SVP-COMP-SKU-ID-CUR-IND PIC X.
88 END-OF-SVP-COMP-SKU-ID-CUR VALUE 'Y'.
05 WS-SVP-CATG-ASOC-CRSR-IND PIC X.
88 END-OF-SVP-CATG-ASOC-CRSR VALUE 'Y'.
05 WS-CURSOR-IND PIC X.
88 CURSOR-OPEN VALUE 'Y'.
05 WS-STR-TYP-ID-FOUND-IND PIC X(1) VALUE 'N'.
88 STR-TYP-ID-FOUND VALUE 'Y'.
05 WS-SVP-COST-AMT-CUR-IND PIC X.
88 END-OF-SVP-COST-AMT-CUR VALUE 'Y'.
*--TABLE INDICATES SPECIFIC PRICE ERRORS THAT HAVE OCCURRED
*
01 WS-PRICE-ERR-MSGS.
05 WS-XMIT-CD-ERR-IND PIC X.
88 XMIT-CD-ERR VALUE 'Y'.
05 WS-SKU-CATG-ERR-MSG PIC X(50)
VALUE 'INVALID TRANSMIT CODE/NOT FOUND ON CONTROL FILE'.
01 WS-PRICE-ERR-TABLE REDEFINES WS-PRICE-ERR-MSGS.
05 WS-PRICE-ERR-INDS OCCURS 5 TIMES
INDEXED BY PRICE-ERR-SUB.
10 WS-PRICE-ERR-IND PIC X.
10 WS-PRICE-ERR-MSG PIC X(50).
****************************************************************
* CONSTANT VARIABLES
****************************************************************
01 WS-CONSTANTS.
05 CN-DSCNTU-CUTOFF-DAYS PIC S9(4) VALUE 0.
05 CN-MAX-PRNT-LINES PIC 9(3) VALUE 53.
05 WS-PRICE-ERR-TBL-MAX PIC S9(4) COMP VALUE 5.
****************************************************************
* TABLES
****************************************************************
* TRANSMIT DESTINATION CODE TABLE
01 XMIT-DEST-CD-TBL.
05 T6-XMIT-CD-TBL-MAX PIC S9(9) COMP VALUE 10.
05 T6-XMIT-CD-TBL-END PIC S9(9) COMP.
05 T6-XMIT-CD OCCURS 1 TO 10 TIMES
DEPENDING ON T6-XMIT-CD-TBL-END
INDEXED BY T6-XMIT-SUB.
10 T6-DB2-XMIT-CD PIC X(5).
10 T6-DEST-CD OCCURS 5 TIMES
PIC X(5).
****************************************************************
* PARAMETER VARIABLES
****************************************************************
COPY PARMWORK REPLACING ==:PARM-:== BY ====
==:REPEAT:== BY 3.
01 PM-MAX-RETRIES PIC S9(4) VALUE 100.
01 PM-COMPANY PIC S9(4) COMP.
****************************************************************
* SQLCA
****************************************************************
EXEC SQL INCLUDE SQLCA END-EXEC.
****************************************************************
* DB2 TABLE & HOST VARIABLE DECLARATIONS
****************************************************************
EXEC SQL INCLUDE SPSMDSES END-EXEC.
EXEC SQL INCLUDE SPSCATEG END-EXEC.
EXEC SQL INCLUDE SPSCATGA END-EXEC.
EXEC SQL INCLUDE SPSDETAI END-EXEC.
EXEC SQL INCLUDE SPSPRICE END-EXEC.
EXEC SQL INCLUDE SPSCOMPA END-EXEC.
EXEC SQL INCLUDE SPSVPCOS END-EXEC.
EXEC SQL INCLUDE SPSLCHNM END-EXEC.
01 DB2-NULL-INDICATOR-VARIABLES.
05 SKU-SERIES-ID-NULL-IND PIC S9(4) BINARY.
********************************************************
* SVP CATEGORY CURSOR DECLARE
********************************************************
EXEC SQL
DECLARE SVP-CATG-ID-CUR CURSOR FOR
SELECT DISTINCT
SC.SVP_CATG_ID
,SC.SVP_CATG_DESC
,SC.SKU_MFG_SRCE_CD
,SC.MTH_WRNTY_MIN_NBR
,SC.MTH_WRNTY_MAX_NBR
,SC.SKU_SERIES_ID
,SVD.SVP_XMIT_DEST_CD
FROM SVP_DETAIL SVD
,SVP_PRICE_DTL SPD
,SVP_CATEGORY SC
,SVP_CATG_ASOC SCA
,MDSE_SVP_ASOC MSA
WHERE
MSA.MDSE_GRP_NBR = :PM-COMPANY
*THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID
*ASSOC
AND MSA.ASOC_EFF_DT =
(SELECT MAX(MSA2.ASOC_EFF_DT)
FROM MDSE_SVP_ASOC MSA2
WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND
(
MSA2.ASOC_EXP_DT IS NULL OR
MSA2.ASOC_EXP_DT > CURRENT DATE
)
AND
MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND
MSA2.SKU_ID = MSA.SKU_ID AND
MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID)
AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID
AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID
AND SPD.SVP_PRICE_EFF_DT =
(SELECT MAX(SPD2.SVP_PRICE_EFF_DT)
FROM SVP_PRICE_DTL SPD2
WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE
AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID)
AND (
(SVD.SVP_DSCNTU_DT IS NULL)
OR
(SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT)
)
END-EXEC.
********************************************************
* SVP SKU ID CURSOR DECLARE
********************************************************
EXEC SQL
DECLARE SVP-SKU-ID-CURSOR CURSOR FOR
SELECT DISTINCT
SVD.SVP_SKU_ID
,SVD.SVP_SPCL_OPTN_CD
,SVD.SVP_BEG_MTH_NBR
,SVD.SVP_COVER_MTH_QTY
,SVD.SVP_WRNTY_TYP_CD
,SVD.SVP_SRVC_LOC_CD
,SVD.SVP_SPIFF_PCT
,SVD.SVP_XMIT_DEST_CD
,SVD.SVP_DESC
,SVD.BILL_FREQ_MTH_QTY
,SVD.SVP_PREPAY_MTH_QTY
,SVD.SVP_SPIFF_AMT
,SPD.SVP_RTL_AMT
FROM SVP_DETAIL SVD
,SVP_PRICE_DTL SPD
,SVP_CATEGORY SC
,SVP_CATG_ASOC SCA
,MDSE_SVP_ASOC MSA
WHERE
MSA.MDSE_GRP_NBR = :PM-COMPANY
*THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID
*ASSOC
AND MSA.ASOC_EFF_DT =
(SELECT MAX(MSA2.ASOC_EFF_DT)
FROM MDSE_SVP_ASOC MSA2
WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND
(
MSA2.ASOC_EXP_DT IS NULL OR
MSA2.ASOC_EXP_DT > CURRENT DATE
)
AND
MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND
MSA2.SKU_ID = MSA.SKU_ID AND
MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID)
AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID
AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID
* THIS GETS THE MOST CURRENT PRICE
AND SPD.SVP_PRICE_EFF_DT =
(SELECT MAX(SPD2.SVP_PRICE_EFF_DT)
FROM SVP_PRICE_DTL SPD2
WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE
AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID)
AND (
(SVD.SVP_DSCNTU_DT IS NULL)
OR
(SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT)
)
END-EXEC.
********************************************************
* SVP COMPONENT SKU ID CURSOR DECLARE
********************************************************
* THIS GETS COMPONENT SKUS THAT ARE ASSOCIATED (I.E. TERMS AND
* CONDITIONS BROCHURES) TO SVP SKU IDS
EXEC SQL
DECLARE SVP-COMP-SKU-CUR CURSOR FOR
SELECT
COM.SVP_COMP_SKU_ID
,COM.SVP_COMP_TYP_CD
FROM
SVP_COMP_ASOC COM
WHERE
COM.SVP_COMP_EFF_DT =
(SELECT MAX(COM2.SVP_COMP_EFF_DT)
FROM SVP_COMP_ASOC COM2
WHERE COM2.SVP_COMP_EFF_DT <= CURRENT DATE AND
COM2.SVP_COMP_EXP_DT > CURRENT DATE AND
COM2.SVP_SKU_ID = :SVP-DETAIL.SVP-SKU-ID AND
COM2.SVP_SKU_ID = COM.SVP_SKU_ID AND
COM2.SVP_COMP_SKU_ID = COM.SVP_COMP_SKU_ID)
END-EXEC
********************************************************
* SVP COST AMT (DEALER NET) CURSOR DECLARE
********************************************************
* THIS GETS SVP COST AMOUNTS THAT ARE ASSOCIATED
* TO SVP SKU IDS. THERE CAN BE MANY SVP COST (DEALER NET)
* AMOUNTS PER * SVP SKU ID (UNIQUELY IDENTIFIED WITH SALES
* CHANNEL ID).
EXEC SQL
DECLARE SVP-COST-AMT-CUR CURSOR FOR
SELECT
SCD.SLS_CHNL_ID
,SCD.SVP_COST_AMT
FROM
SVP_COST_DTL SCD
WHERE
SCD.SVP_COST_EFF_DT =
(SELECT MAX(SCD2.SVP_COST_EFF_DT)
FROM SVP_COST_DTL SCD2
WHERE SCD2.SVP_COST_EFF_DT <= CURRENT DATE AND
(SCD2.SVP_COST_EXP_DT > CURRENT DATE OR
SCD2.SVP_COST_EXP_DT IS NULL) AND
SCD2.SVP_SKU_ID = :SVP-DETAIL.SVP-SKU-ID AND
SCD2.SVP_SKU_ID = SCD.SVP_SKU_ID AND
SCD2.SLS_CHNL_ID = SCD.SLS_CHNL_ID)
ORDER BY
SCD.SLS_CHNL_ID
END-EXEC
********************************************************
* SVP CATEGORY ASSOCIATION CURSOR DECLARE
********************************************************
EXEC SQL
DECLARE SVP-CATG-ASOC-CRSR CURSOR FOR
SELECT DISTINCT
SCA.SVP_CATG_ID
,SCA.SVP_SKU_ID
,SVD.SVP_XMIT_DEST_CD
FROM SVP_DETAIL SVD
,SVP_PRICE_DTL SPD
,SVP_CATEGORY SC
,SVP_CATG_ASOC SCA
,MDSE_SVP_ASOC MSA
WHERE
MSA.MDSE_GRP_NBR = :PM-COMPANY
*THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID
*ASSOC
AND MSA.ASOC_EFF_DT =
(SELECT MAX(MSA2.ASOC_EFF_DT)
FROM MDSE_SVP_ASOC MSA2
WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND
(
MSA2.ASOC_EXP_DT IS NULL OR
MSA2.ASOC_EXP_DT > CURRENT DATE
)
AND
MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND
MSA2.SKU_ID = MSA.SKU_ID AND
MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID)
AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID
AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID
AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID
AND SPD.SVP_PRICE_EFF_DT =
(SELECT MAX(SPD2.SVP_PRICE_EFF_DT)
FROM SVP_PRICE_DTL SPD2
WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE
AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID)
AND (
(SVD.SVP_DSCNTU_DT IS NULL)
OR
(SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT)
)
END-EXEC.
*****************************************************************
LINKAGE SECTION.
*****************************************************************
01 PARM-FIELDS.
05 QJ-PARM-L PIC 9(4) COMP-4.
05 QJ-PARM PIC X(100).
******************************************************************
PROCEDURE DIVISION USING PARM-FIELDS.
******************************************************************
PERFORM 100-INITIALIZE
PERFORM 820-OPEN-SVP-CATG-ID-CUR UNTIL CURSOR-OPEN
PERFORM 825-FETCH-SVP-CATG-ID-CUR
IF END-OF-SVP-CATG-ID-CUR
PERFORM 911-EMPTY-SVP-CATG-ID-CUR
END-IF
PERFORM 200-EXTRACT-SVP-CATG-IDS UNTIL END-OF-SVP-CATG-ID-CUR
EXEC SQL
CLOSE SVP-CATG-ID-CUR
END-EXEC
MOVE 'N' TO WS-CURSOR-IND
PERFORM 830-OPEN-SVP-SKU-ID-CURSOR UNTIL CURSOR-OPEN
PERFORM 835-FETCH-SVP-SKU-ID-CURSOR
IF END-OF-SVP-SKU-ID-CURSOR
PERFORM 911-EMPTY-SVP-SKU-ID-CURSOR
END-IF
PERFORM 220-EXTRACT-SVP-SKU-IDS UNTIL
END-OF-SVP-SKU-ID-CURSOR
EXEC SQL
CLOSE SVP-SKU-ID-CURSOR
END-EXEC
MOVE 'N' TO WS-CURSOR-IND
PERFORM 840-OPEN-SVP-CATG-ASOC-CURSOR UNTIL CURSOR-OPEN
PERFORM 845-FETCH-SVP-CATG-ASOC-CURSOR
IF END-OF-SVP-CATG-ASOC-CRSR
PERFORM 911-EMPTY-SVP-CATG-ASOC-CRSR
END-IF
PERFORM 230-EXTRACT-SVP-CATG-ASOC
UNTIL END-OF-SVP-CATG-ASOC-CRSR
EXEC SQL
CLOSE SVP-CATG-ASOC-CRSR
END-EXEC
PERFORM 9000-PROGRAM-END
STOP RUN
.
******************************************************************
100-INITIALIZE.
******************************************************************
DISPLAY ' '
DISPLAY '***********************************************'
DISPLAY '* R P R 6 5 2 0 *'
DISPLAY '***********************************************'
DISPLAY ' '
*
* PROCESS PARMS
*
MOVE SPACES TO WORK-AREA
MOVE QJ-PARM(1:QJ-PARM-L) TO JCL-AREA
MOVE 'RETRY' TO KEY-X(1)
MOVE 'COMPANY' TO KEY-X(2)
MOVE 'DSCDAYS' TO KEY-X(3)
CALL 'PARMKEY' USING WORK-AREA
IF ERROR-FLAG > 0
DISPLAY ERROR-MESSAGE
MOVE ' BAD PARMKEY RETURN CODE ' TO WS-ERR-MSG1
MOVE ' PLEASE CORRECT AND RE-SUBMIT ' TO WS-ERR-MSG2
MOVE 12 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
IF KEY-X(1) NOT = SPACES
MOVE KEY-P(1) TO PM-MAX-RETRIES
END-IF
MOVE PM-MAX-RETRIES TO WS-EDIT-RETRY-PM
DISPLAY ' '
DISPLAY 'MAXIMUM NUMBER OF RETRIES = ' WS-EDIT-RETRY-PM
IF KEY-X(2) NOT = SPACES
MOVE KEY-P(2) TO PM-COMPANY
ELSE
DISPLAY ERROR-MESSAGE
MOVE 'COMPANY PARM NOT PRESENT. MUST BE' TO WS-ERR-MSG1
MOVE '2 DIGITS WITH LEADING ZERO. ' TO WS-ERR-MSG2
MOVE 'CORRECT AND RE-SUBMIT. ' TO WS-ERR-MSG3
MOVE 12 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
DISPLAY ' '
DISPLAY 'RSSP PRICES EXTRACTED FOR COMPANY ID: ' PM-COMPANY
IF KEY-X(3) NOT = SPACES
IF KEY-X(3)(1:3) IS NUMERIC
MOVE KEY-X(3)(1:3) TO CN-DSCNTU-CUTOFF-DAYS
ELSE
MOVE 'PARM ERROR: DISCONTINUE DAYS SUBTRACT'
TO WS-ERR-MSG1
MOVE 'FORMAT: 3 DIGIT NUMBER'
TO WS-ERR-MSG2
MOVE 12 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
END-IF
*
* GET CURRENT DATE
*
MOVE FUNCTION CURRENT-DATE(1:8) TO WS-CURRENT-YYYYMMDD
MOVE CORRESPONDING WS-CURRENT-YYYYMMDD TO WS-CURRENT-MMDDYYYY
MOVE CORRESPONDING WS-CURRENT-YYYYMMDD TO WS-CURR-YYYYSMMSDD
*
* CALCULATE DISCONTINUE CUT OFF DATE
*
MOVE SPACES TO DTR-DATE-FIELDS
MOVE WS-CURRENT-MMDDYYYY TO DTR-CAL-DATE-N
MOVE CN-DSCNTU-CUTOFF-DAYS TO DTR-NBR-DAYS-N
SET SUBTRACT-DAYS TO TRUE
CALL 'CNVDATE' USING DTR-DATE-FIELDS
IF NOT VALID-DATE
MOVE 'INVALID CUT OFF DATE FOR DISCONTINUED ITEMS'
TO WS-ERR-MSG1
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
MOVE DTR-CAL-MM2 TO WS-DSCNTU-MM
MOVE '/' TO WS-DSCNTU-SL1
MOVE DTR-CAL-DD2 TO WS-DSCNTU-DD
MOVE '/' TO WS-DSCNTU-SL2
MOVE DTR-CAL-CC2 TO WS-DSCNTU-YYYY (1:2)
MOVE DTR-CAL-YY2 TO WS-DSCNTU-YYYY (3:2)
MOVE CN-DSCNTU-CUTOFF-DAYS TO WS-EDIT-COMP4
DISPLAY ' '
DISPLAY 'DISCONTINUE CUT OFF DATE IS CALCULATED AS'
DISPLAY 'CURRENT DATE MINUS ' WS-EDIT-COMP4
DISPLAY 'DAYS. CUT OFF DATE FOR THIS RUN: '
WS-DSCNTU-CUTOFF-DT
*
* OPEN FILES
*
OPEN INPUT CONTROL-FILE-IN
OUTPUT PRICE-FILE-OUT
EVALUATE TRUE
WHEN (CTRL-STATUS IS NOT = 97
AND CTRL-STATUS IS NOT = ZERO)
MOVE 'UNABLE TO OPEN RPRCTRLI FILE' TO
WS-ERR-MSG1
STRING 'FILE STATUS IS ' CTRL-STATUS
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
WHEN (PRICE-STATUS IS NOT = ZERO)
MOVE 'UNABLE TO OPEN RPRPRICO FILE' TO
WS-ERR-MSG1
STRING 'FILE STATUS IS ' PRICE-STATUS
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
MOVE 'N' TO WS-CURSOR-IND
*
* LOAD VALID DB2 XMIT CODES & DESTINATIONS FROM CTRLFILE
*
MOVE SPACES TO CTRL-FILE-KEYS
MOVE 'XMITDESTCD' TO CTRL-KEY1-REC-TYPE
PERFORM 800-START-CONTROL-FILE
PERFORM 810-READ-CONTROL-FILE
IF CTRL-KEY1-REC-TYPE NOT = 'XMITDESTCD'
MOVE '"XMITDESTCD" REC TYPE NOT FOUND ON CONTROL FILE.'
TO WS-ERR-MSG1
MOVE 'CONTACT CONTRACT SERVICES PROGRAMMING STAFF.'
TO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
MOVE ZERO TO T6-XMIT-CD-TBL-END
PERFORM 145-LOAD-XMIT-TBL VARYING T6-XMIT-SUB
FROM 1 BY 1
UNTIL EOF-CONTROL-FILE-IN
OR CTRL-KEY1-REC-TYPE IS NOT = 'XMITDESTCD'
* INITIALIZE ERROR INDS & MESSAGE FIELDS
MOVE 'N' TO WS-XMIT-CD-ERR-IND
.
******************************************************************
145-LOAD-XMIT-TBL.
******************************************************************
IF (T6-XMIT-CD-TBL-END + 1) > T6-XMIT-CD-TBL-MAX
MOVE 'TRANSMIT CODE TABLE OVERFLOW'
TO WS-ERR-MSG1
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
MOVE CTRL-KEY2
TO T6-DB2-XMIT-CD(T6-XMIT-SUB)
PERFORM 150-LOAD-XMIT-DEST-CD
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL WS-DEST-SUB IS > CTRL-MAX-XMIT-DEST-CD
ADD 1 TO T6-XMIT-CD-TBL-END
PERFORM 810-READ-CONTROL-FILE
END-IF
.
******************************************************************
150-LOAD-XMIT-DEST-CD.
******************************************************************
MOVE CTRL-XMIT-DEST-CD OF CTRL-XMIT-DEST-CD-REC
(WS-DEST-SUB)
TO T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
.
******************************************************************
200-EXTRACT-SVP-CATG-IDS.
******************************************************************
INITIALIZE PRIC-PRICE-REC-INITIAL
* FILE CREATE DATE
MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT
* RECORD TYPE INDICATOR
SET PRIC-MNT-CATG-REC TO TRUE
* CATEGORY ID
MOVE SVP-CATG-ID OF SVP-CATEGORY TO PRIC-SVP-CATG-ID
* CATEGORY DESC
MOVE SVP-CATG-DESC-TEXT OF SVP-CATEGORY (1:SVP-CATG-DESC-LEN)
TO PRIC-SVP-CATG-DESC
* MFG SOURCE CODE
MOVE SKU-MFG-SRCE-CD OF SVP-CATEGORY TO PRIC-SKU-MFG-SRCE-CD
* MERCHANDISE CLASS
IF SKU-SERIES-ID OF SVP-CATEGORY (1:2) = '25' OR '26'
SET PRIC-COMPUTER-CLASS TO TRUE
ELSE
SET PRIC-CONSUMER-CLASS TO TRUE
END-IF
* MFG WARRANTY RANGE MINIMUM
MOVE MTH-WRNTY-MIN-NBR OF SVP-CATEGORY
TO PRIC-MFG-WTY-MIN-NBR
* MFG WARRANTY RANGE MAXIMUM
MOVE MTH-WRNTY-MAX-NBR OF SVP-CATEGORY
TO PRIC-MFG-WTY-MAX-NBR
MOVE PRIC-PRICE-REC TO SV-PRICE-REC
* CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE
* XMITTED
PERFORM 340-FIND-CTRL-DB2-XMIT-CD
IF NOT XMIT-CD-ERR
PERFORM 290-WRITE-PRICE-REC
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
IS = SPACES)
END-IF
PERFORM 825-FETCH-SVP-CATG-ID-CUR
.
******************************************************************
220-EXTRACT-SVP-SKU-IDS.
******************************************************************
INITIALIZE PRIC-PRICE-REC-INITIAL
*------------------------------------------------------
* THIS LIST OF FIELDS IS TO LOAD THE SVP SKU ID TYPE REC WITH
* SVP SKU ID ATTRIBUTES THAT HAVE A ONE TO ONE RELATIONSHIP
* WITH SVP SKU ID.
*------------------------------------------------------
* FILE CREATE DATE
MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT
* RECORD TYPE INDICATOR
SET PRIC-MNT-SVP-REC TO TRUE
* SVP SKU ID
MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID
* SVP SKU DESC
MOVE SVP-DESC OF SVP-DETAIL TO PRIC-SVP-SKU-DESC
* SPECIAL OPTION CODE
MOVE SVP-SPCL-OPTN-CD OF SVP-DETAIL TO PRIC-SVP-SPCL-OPTN-CD
* WARRANTY TYPE CODE
MOVE SVP-WRNTY-TYP-CD OF SVP-DETAIL TO PRIC-SVP-WRNTY-TYP-CD
* SERVICE LOCATION CODE
MOVE SVP-SRVC-LOC-CD OF SVP-DETAIL TO PRIC-SVP-SRVC-LOC-CD
* XMIT DESTINATION CODE
MOVE SVP-XMIT-DEST-CD OF SVP-DETAIL
TO PRIC-SVP-XMIT-DEST-CD-SVP
* SVP RETAIL AMOUNT
MOVE SVP-RTL-AMT OF SVP-PRICE-DTL TO PRIC-SVP-RTL-AMT
**** MSAHA1-12/14/2010-RB ISSUE 31 *******
**** IF SVP-PREPAY-MTH-QTY OF SVP-DETAIL > 0
**** MULTIPLY SVP-RTL-AMT OF SVP-PRICE-DTL BY
**** SVP-PREPAY-MTH-QTY OF SVP-DETAIL
**** GIVING WS-SVP-RTL-AMT
**** MOVE WS-SVP-RTL-AMT TO PRIC-SVP-RTL-AMT
**** ELSE
**** MOVE SVP-RTL-AMT OF SVP-PRICE-DTL TO PRIC-SVP-RTL-AMT
**** END-IF
* SVP SPIFF AMOUNT
COMPUTE WS-SPIFF-AMT ROUNDED = SVP-RTL-AMT OF SVP-PRICE-DTL *
( SVP-SPIFF-PCT OF SVP-DETAIL / 100 )
* THE NEXT MULTIPLY IS BECAUSE THE IBM COMPUTE STATEMENT HAS
* KNOWN BUG THAT ROUNDS INTERMITTENTLY INSTEAD OF AT THE END
MULTIPLY WS-SPIFF-AMT BY 1 GIVING PRIC-SPIFF-AMT ROUNDED
* SVP BEGIN MONTH NUMBER
MOVE SVP-BEG-MTH-NBR OF SVP-DETAIL TO PRIC-SVP-BEG-MTH-NBR
* SVP COVERAGE QUANTITY
MOVE SVP-COVER-MTH-QTY OF SVP-DETAIL
TO PRIC-SVP-COVER-MTH-QTY
* BILL-FREQ-MTH-QTY
MOVE BILL-FREQ-MTH-QTY OF SVP-DETAIL
TO PRIC-BILL-FREQ-MTH-QTY
* SVP-SPIFF-AMT
MOVE SVP-SPIFF-AMT OF SVP-DETAIL
TO PRIC-SVP-SPIFF-AMT
* SVP-PREPAY-MTH-QTY
MOVE SVP-PREPAY-MTH-QTY OF SVP-DETAIL
TO PRIC-SVP-PREPAY-MTH-QTY
MOVE PRIC-PRICE-REC TO SV-PRICE-REC
* CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE
* XMITTED
PERFORM 340-FIND-CTRL-DB2-XMIT-CD
IF NOT XMIT-CD-ERR
* WRITE OUT THE SVP SKU ID ('B') TYPE REC FIRST
PERFORM 290-WRITE-PRICE-REC
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
IS = SPACES)
* THEN WRITE OUT THE COMPONENT RECS OF THE SVP SKU ID
PERFORM 225-EXTRACT-SVP-COMP-SKU-IDS
* THEN WRITE OUT THE SVP COST AMT (DEALER NET) RECS OF THE SVP
* SKU ID
PERFORM 227-EXTRACT-SVP-COST-AMTS
END-IF
* FETCH NEXT SVP SKU ID ('B') TYPE REC
PERFORM 835-FETCH-SVP-SKU-ID-CURSOR
.
******************************************************************
225-EXTRACT-SVP-COMP-SKU-IDS.
******************************************************************
MOVE 'N' TO WS-CURSOR-IND
PERFORM 837-OPEN-SVP-COMP-SKU-CUR UNTIL CURSOR-OPEN
* PRIMING FETCH
PERFORM 839-FETCH-SVP-COMP-SKU-ID-CUR
IF END-OF-SVP-COMP-SKU-ID-CUR
DISPLAY '------------------------------------------------'
DISPLAY '*********** INFORMATIONAL MESSAGE **************'
STRING 'SVP SKU ID ' SVP-SKU-ID OF SVP-DETAIL
DELIMITED BY SIZE
INTO WS-DISPLAY
DISPLAY WS-DISPLAY
MOVE SPACES TO WS-DISPLAY
DISPLAY 'FOUND WITH NO COMPONENT SKUS ASSOCIATED IN VIEW'
DISPLAY 'SVP_COMP_ASOC.'
END-IF
* --------- LOOP THROUGH COMPONENT SKU CURSOR ----------------
PERFORM UNTIL END-OF-SVP-COMP-SKU-ID-CUR
INITIALIZE PRIC-PRICE-REC-INITIAL
* FILE CREATE DATE
MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT
* RECORD TYPE INDICATOR
SET PRIC-MNT-SVP-COMP-REC TO TRUE
* SVP SKU ID
* THIS IS THE SAME SVP-SKU-ID AS ON THE 'B' REC BUT IT HAS
* TO BE REPEATED FOR COMPONENT SKU ASSOCIATION ON 'BA' RECS
MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID-BA
EVALUATE TRUE
WHEN BROCHURE-COMP-TYP OF SVP-COMP-ASOC
MOVE SVP-COMP-SKU-ID OF SVP-COMP-ASOC
TO PRIC-SVP-COMP-SKU-ID
MOVE SVP-COMP-TYP-CD OF SVP-COMP-ASOC
TO PRIC-SVP-COMP-TYP-CD
WHEN OTHER
STRING 'UNDEFINED VALUE: '
SVP-COMP-TYP-CD OF SVP-COMP-ASOC
DELIMITED BY SIZE
INTO WS-ERR-MSG1
MOVE 'DETECTED IN SVP-COMP-TYP-CD OF TABLE'
TO WS-ERR-MSG2
MOVE 'SVP_COMP_ASOC. PROGRAMMER ATTENTION REQUIRED'
TO WS-ERR-MSG3
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
MOVE PRIC-PRICE-REC TO SV-PRICE-REC
* WE SKIP DOING 340-FIND-CTRL-DB2-XMIT-CD AT THIS LEVEL SINCE XMIT
* DEST CODE IS AT THE SVP SKU ID LEVEL.
* WRITE OUT THE SVP COMPONENT SKU ID ('BA') TYPE RECS
PERFORM 290-WRITE-PRICE-REC
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
IS = SPACES)
PERFORM 839-FETCH-SVP-COMP-SKU-ID-CUR
* END OF LOOP THROUGH COMPONENT SKU CURSOR ----------------
END-PERFORM
EXEC SQL
CLOSE SVP-COMP-SKU-CUR
END-EXEC
.
******************************************************************
227-EXTRACT-SVP-COST-AMTS.
******************************************************************
MOVE 'N' TO WS-CURSOR-IND
PERFORM 839A-OPEN-SVP-COST-AMT-CUR UNTIL CURSOR-OPEN
* PRIMING FETCH
PERFORM 839A-FETCH-SVP-COST-AMT-CUR
* IF NO SVP COST AMT (DEALER NET) ASSOCIATED TO A GIVEN SVP SKU ID
* DISPLAY MESSAGE
IF END-OF-SVP-COST-AMT-CUR
DISPLAY '------------------------------------------------'
DISPLAY '*********** INFORMATIONAL MESSAGE **************'
STRING 'SVP SKU ID ' SVP-SKU-ID OF SVP-DETAIL
DELIMITED BY SIZE
INTO WS-DISPLAY
DISPLAY WS-DISPLAY
MOVE SPACES TO WS-DISPLAY
DISPLAY 'FOUND WITH NO SVP COST (DEALER NET) AMOUNT'
DISPLAY 'ASSOCIATED IN TABLE/VIEW SVP_COST_DTL.'
END-IF
* ------- LOOP THROUGH SVP COST (DEALER NET) AMOUNT CURSOR -------
PERFORM UNTIL END-OF-SVP-COST-AMT-CUR
INITIALIZE PRIC-PRICE-REC-INITIAL
* FILE CREATE DATE
MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT
* RECORD TYPE INDICATOR
SET PRIC-MNT-SVP-COST-AMT-REC TO TRUE
* SVP SKU ID
* THIS IS THE SAME SVP-SKU-ID AS ON THE 'B' REC BUT IT HAS
* TO BE REPEATED FOR SVP COST AMT (DEALER NET) ASSOCIATION ON 'BB'
* RECS
MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID-BB
* SALES CHANNEL ID
MOVE SLS-CHNL-ID OF SVP-COST-DTL TO PRIC-SLS-CHNL-ID
* SALES CHANNEL NAME
MOVE SLS-CHNL-ID OF SVP-COST-DTL TO WS-SQL-SLS-CHNL-ID
PERFORM 350-FIND-SLS-CHNL-NM
* SVP COST AMT (DEALER NET)
MOVE SVP-COST-AMT OF SVP-COST-DTL TO PRIC-SVP-COST-AMT
MOVE PRIC-PRICE-REC TO SV-PRICE-REC
* WE SKIP DOING 340-FIND-CTRL-DB2-XMIT-CD AT THIS LEVEL SINCE XMIT
* DEST CODE IS AT THE SVP SKU ID LEVEL.
* WRITE OUT THE SVP COST AMT (DEALER NET) ('BB') TYPE RECS. WE
* REPEAT THE WRITE FOR EVERY XMIT DEST CODE THAT WE FIND PER
* SALES CHANNEL
PERFORM 290-WRITE-PRICE-REC
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
IS = SPACES)
PERFORM 839A-FETCH-SVP-COST-AMT-CUR
* END OF LOOP THROUGH SVP COST (DEALER NET) AMOUNT CURSOR
END-PERFORM
EXEC SQL
CLOSE SVP-COST-AMT-CUR
END-EXEC
.
******************************************************************
230-EXTRACT-SVP-CATG-ASOC.
******************************************************************
INITIALIZE PRIC-PRICE-REC-INITIAL
* FILE CREATE DATE
MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT
* RECORD TYPE INDICATOR
SET PRIC-MNT-ASOC-REC TO TRUE
* CATEGORY ID
MOVE SVP-CATG-ID OF SVP-CATG-ASOC TO PRIC-SVP-CATG-ID-ASOC
* SVP SKU ID
MOVE SVP-SKU-ID OF SVP-CATG-ASOC TO PRIC-SVP-SKU-ID-ASOC
MOVE PRIC-PRICE-REC TO SV-PRICE-REC
* CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE
* XMITTED
PERFORM 340-FIND-CTRL-DB2-XMIT-CD
IF NOT XMIT-CD-ERR
PERFORM 290-WRITE-PRICE-REC
VARYING WS-DEST-SUB FROM 1 BY 1
UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
IS = SPACES)
END-IF
PERFORM 845-FETCH-SVP-CATG-ASOC-CURSOR
.
******************************************************************
290-WRITE-PRICE-REC.
******************************************************************
* LOAD XMIT CODES ACCORDING WHAT REC TYPE WE'RE PROCESSING
* THEN WRITE THE PRICE REC
*-----------------------------------------------------------------
EVALUATE TRUE
* CATEGORY 'A' TYPE REC
WHEN PRIC-MNT-CATG-REC
MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
TO PRIC-SVP-XMIT-DEST-CD-CATG
ADD 1 TO CT-TOT-A-RECS-WRITTEN
* SVP SKU ID 'B' TYPE REC
WHEN PRIC-MNT-SVP-REC
MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
TO PRIC-SVP-XMIT-DEST-CD-SVP
ADD 1 TO CT-TOT-B-RECS-WRITTEN
* SVP COMPONENT SKU ID 'BA' TYPE REC
WHEN PRIC-MNT-SVP-COMP-REC
MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
TO PRIC-SVP-XMIT-DEST-CD-SVP-COMP
ADD 1 TO CT-TOT-BA-RECS-WRITTEN
* SVP COST AMT (DEALER NET) 'BB' TYPE REC
WHEN PRIC-MNT-SVP-COST-AMT-REC
MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
TO PRIC-SVP-XMIT-DEST-CD-SVP-COST
ADD 1 TO CT-TOT-BB-RECS-WRITTEN
* CATEGORY / SVP SKU ID ASSOCIATION 'C' TYPE REC
WHEN PRIC-MNT-ASOC-REC
MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB)
TO PRIC-SVP-XMIT-DEST-CD-ASOC
ADD 1 TO CT-TOT-C-RECS-WRITTEN
END-EVALUATE
PERFORM 850-WRITE-PRIC-REC
MOVE SV-PRICE-REC TO PRIC-PRICE-REC
ADD 1 TO CT-TOT-ALL-RECS-WRITTEN
.
******************************************************************
340-FIND-CTRL-DB2-XMIT-CD.
******************************************************************
SET T6-XMIT-SUB TO 1
SEARCH T6-XMIT-CD VARYING T6-XMIT-SUB
AT END
SET XMIT-CD-ERR TO TRUE
WHEN T6-DB2-XMIT-CD(T6-XMIT-SUB) =
SVP-XMIT-DEST-CD OF SVP-DETAIL
CONTINUE
END-SEARCH
.
******************************************************************
350-FIND-SLS-CHNL-NM.
******************************************************************
EXEC SQL
SELECT
SLS_CHNL_NM
INTO
:SLS-CHNL.SLS-CHNL-NM
FROM SLS_CHNL CHNL
WHERE
CHNL.SLS_CHNL_ID = :WS-SQL-SLS-CHNL-ID
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
MOVE SLS-CHNL-NM-TEXT OF SLS-CHNL (1:SLS-CHNL-NM-LEN)
TO PRIC-SLS-CHNL-NM (1:LENGTH OF PRIC-SLS-CHNL-NM)
WHEN 100
MOVE 'CHNL ID NOT IN SLS_CHNL '
TO PRIC-SLS-CHNL-NM
WHEN OTHER
MOVE 'SLS_CHNL TBL NOT AVAIL '
TO PRIC-SLS-CHNL-NM
END-EVALUATE
.
******************************************************************
800-START-CONTROL-FILE.
******************************************************************
START CONTROL-FILE-IN
KEY IS GREATER THAN OR EQUAL TO CTRL-FILE-KEYS
INVALID KEY
STRING 'INVALID CONTROL FILE KEY: '
CTRL-KEY1-REC-TYPE DELIMITED BY SIZE
INTO WS-ERR-MSG1
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-START
.
******************************************************************
810-READ-CONTROL-FILE.
******************************************************************
READ CONTROL-FILE-IN NEXT RECORD
AT END
SET EOF-CONTROL-FILE-IN TO TRUE
END-READ
IF (CTRL-STATUS IS NOT = 97) AND
(CTRL-STATUS IS NOT = ZERO) AND
NOT EOF-CONTROL-FILE-IN
STRING 'INVALID CONTROL FILE READ FOR KEY: '
CTRL-KEY1-REC-TYPE DELIMITED BY SIZE
INTO WS-ERR-MSG1
STRING 'FILE STATUS CODE: ' CTRL-STATUS
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
.
******************************************************************
820-OPEN-SVP-CATG-ID-CUR.
******************************************************************
EXEC SQL
OPEN SVP-CATG-ID-CUR
END-EXEC
IF SQLCODE IS NOT = ZERO
IF CT-NBR-RETRIES > PM-MAX-RETRIES
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-CATG-ID-CUR OPEN FAILED' TO WS-ERR-MSG1
STRING 'SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
ADD 1 TO CT-NBR-RETRIES
END-IF
ELSE
SET CURSOR-OPEN TO TRUE
MOVE 'N' TO WS-SVP-CATG-ID-CUR-IND
MOVE ZERO TO CT-NBR-RETRIES
END-IF
.
******************************************************************
825-FETCH-SVP-CATG-ID-CUR.
******************************************************************
MOVE ZERO TO SQLCODE
EXEC SQL FETCH SVP-CATG-ID-CUR
INTO
:SVP-CATEGORY.SVP-CATG-ID
,:SVP-CATEGORY.SVP-CATG-DESC
,:SVP-CATEGORY.SKU-MFG-SRCE-CD
,:SVP-CATEGORY.MTH-WRNTY-MIN-NBR
,:SVP-CATEGORY.MTH-WRNTY-MAX-NBR
,:SVP-CATEGORY.SKU-SERIES-ID:SKU-SERIES-ID-NULL-IND
,:SVP-DETAIL.SVP-XMIT-DEST-CD
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
ADD 1 TO CT-SVP-CATG-CUR-FETCHED
WHEN 100
SET END-OF-SVP-CATG-ID-CUR TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-CATG-ID-CUR FETCH FAILED' TO WS-ERR-MSG1
STRING ' SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
.
******************************************************************
830-OPEN-SVP-SKU-ID-CURSOR.
******************************************************************
EXEC SQL
OPEN SVP-SKU-ID-CURSOR
END-EXEC
IF SQLCODE IS NOT = ZERO
IF CT-NBR-RETRIES > PM-MAX-RETRIES
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-SKU-ID-CURSOR OPEN FAILED' TO WS-ERR-MSG1
STRING 'SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
ADD 1 TO CT-NBR-RETRIES
END-IF
ELSE
SET CURSOR-OPEN TO TRUE
MOVE 'N' TO WS-SVP-SKU-ID-CURSOR-IND
MOVE ZERO TO CT-NBR-RETRIES
END-IF
.
******************************************************************
835-FETCH-SVP-SKU-ID-CURSOR.
******************************************************************
MOVE ZERO TO SQLCODE
EXEC SQL FETCH SVP-SKU-ID-CURSOR
INTO
:SVP-DETAIL.SVP-SKU-ID
,:SVP-DETAIL.SVP-SPCL-OPTN-CD
,:SVP-DETAIL.SVP-BEG-MTH-NBR
,:SVP-DETAIL.SVP-COVER-MTH-QTY
,:SVP-DETAIL.SVP-WRNTY-TYP-CD
,:SVP-DETAIL.SVP-SRVC-LOC-CD
,:SVP-DETAIL.SVP-SPIFF-PCT
,:SVP-DETAIL.SVP-XMIT-DEST-CD
,:SVP-DETAIL.SVP-DESC
,:SVP-DETAIL.BILL-FREQ-MTH-QTY
,:SVP-DETAIL.SVP-PREPAY-MTH-QTY
,:SVP-DETAIL.SVP-SPIFF-AMT
,:SVP-PRICE-DTL.SVP-RTL-AMT
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
ADD 1 TO CT-SVP-SKU-ID-CUR-FETCHED
WHEN 100
SET END-OF-SVP-SKU-ID-CURSOR TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-SKU-ID-CURSOR FETCH FAILED' TO WS-ERR-MSG1
STRING ' SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
.
******************************************************************
837-OPEN-SVP-COMP-SKU-CUR.
******************************************************************
EXEC SQL
OPEN SVP-COMP-SKU-CUR
END-EXEC
IF SQLCODE IS NOT = ZERO
IF CT-NBR-RETRIES > PM-MAX-RETRIES
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-COMP-SKUS-CUR OPEN FAILED' TO WS-ERR-MSG1
STRING 'SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
ADD 1 TO CT-NBR-RETRIES
END-IF
ELSE
SET CURSOR-OPEN TO TRUE
MOVE 'N' TO WS-SVP-COMP-SKU-ID-CUR-IND
MOVE ZERO TO CT-NBR-RETRIES
END-IF
.
******************************************************************
839-FETCH-SVP-COMP-SKU-ID-CUR.
******************************************************************
MOVE ZERO TO SQLCODE
EXEC SQL FETCH SVP-COMP-SKU-CUR
INTO
:SVP-COMP-ASOC.SVP-COMP-SKU-ID
,:SVP-COMP-ASOC.SVP-COMP-TYP-CD
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
ADD 1 TO CT-SVP-COMP-SKU-CUR-FETCHED
WHEN 100
SET END-OF-SVP-COMP-SKU-ID-CUR TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-COMP-SKU-ID-CURSOR FETCH FAILED' TO WS-ERR-MSG1
STRING ' SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
.
******************************************************************
839A-OPEN-SVP-COST-AMT-CUR.
******************************************************************
EXEC SQL
OPEN SVP-COST-AMT-CUR
END-EXEC
IF SQLCODE IS NOT = ZERO
IF CT-NBR-RETRIES > PM-MAX-RETRIES
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-COST-AMT-CUR OPEN FAILED' TO WS-ERR-MSG1
STRING 'SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
ADD 1 TO CT-NBR-RETRIES
END-IF
ELSE
SET CURSOR-OPEN TO TRUE
MOVE 'N' TO WS-SVP-COST-AMT-CUR-IND
MOVE ZERO TO CT-NBR-RETRIES
END-IF
.
******************************************************************
839A-FETCH-SVP-COST-AMT-CUR.
******************************************************************
MOVE ZERO TO SQLCODE
EXEC SQL FETCH SVP-COST-AMT-CUR
INTO
:SVP-COST-DTL.SLS-CHNL-ID
,:SVP-COST-DTL.SVP-COST-AMT
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
ADD 1 TO CT-SVP-COST-AMT-CUR-FETCHED
WHEN 100
SET END-OF-SVP-COST-AMT-CUR TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-COST-AMT-CUR FETCH FAILED' TO WS-ERR-MSG1
STRING ' SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
.
******************************************************************
840-OPEN-SVP-CATG-ASOC-CURSOR.
******************************************************************
EXEC SQL
OPEN SVP-CATG-ASOC-CRSR
END-EXEC
IF SQLCODE IS NOT = ZERO
IF CT-NBR-RETRIES > PM-MAX-RETRIES
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-CATG-ASOC-CRSR OPEN FAILED' TO WS-ERR-MSG1
STRING 'SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
ELSE
ADD 1 TO CT-NBR-RETRIES
END-IF
ELSE
SET CURSOR-OPEN TO TRUE
MOVE 'N' TO WS-SVP-CATG-ASOC-CRSR-IND
MOVE ZERO TO CT-NBR-RETRIES
END-IF
.
******************************************************************
845-FETCH-SVP-CATG-ASOC-CURSOR.
******************************************************************
MOVE ZERO TO SQLCODE
EXEC SQL FETCH SVP-CATG-ASOC-CRSR
INTO
:SVP-CATG-ASOC.SVP-CATG-ID
,:SVP-CATG-ASOC.SVP-SKU-ID
,:SVP-DETAIL.SVP-XMIT-DEST-CD
END-EXEC
EVALUATE SQLCODE
WHEN ZERO
ADD 1 TO CT-SVP-CATG-ASOC-CUR-FETCHED
WHEN 100
SET END-OF-SVP-CATG-ASOC-CRSR TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-EDIT-SQLCODE
MOVE 'SVP-CATG-ASOC-CRSR FETCH FAILED' TO WS-ERR-MSG1
STRING ' SQLCODE = ' WS-EDIT-SQLCODE
DELIMITED BY SIZE
INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-EVALUATE
.
******************************************************************
850-WRITE-PRIC-REC.
******************************************************************
WRITE PRICE-FILE-OUT-REC
IF PRICE-STATUS IS NOT = '00'
MOVE 'WRITE TO CATALOG PRICE FILE RPRPRICO UNSUCCESSFUL.'
TO WS-ERR-MSG1
STRING 'THE STATUS CODE WAS ' PRICE-STATUS
DELIMITED BY SIZE INTO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
.
******************************************************************
911-EMPTY-SVP-CATG-ID-CUR.
******************************************************************
MOVE 'SVP-CATG-ID-CUR OPEN RESULTED IN NO DATA BEING'
TO WS-ERR-MSG1
MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.'
TO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
.
******************************************************************
911-EMPTY-SVP-SKU-ID-CURSOR.
******************************************************************
MOVE 'SVP-SKU-ID-CURSOR OPEN RESULTED IN NO DATA BEING'
TO WS-ERR-MSG1
MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.'
TO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
.
******************************************************************
911-EMPTY-SVP-CATG-ASOC-CRSR.
******************************************************************
MOVE 'SVP-CATG-ASOC-CRSR OPEN RESULTED IN NO DATA BEING'
TO WS-ERR-MSG1
MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.'
TO WS-ERR-MSG2
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
.
******************************************************************
9000-PROGRAM-END.
******************************************************************
CLOSE CONTROL-FILE-IN
PRICE-FILE-OUT
DISPLAY '================================================'
DISPLAY '> FINAL TOTALS SUMMARY - RPR6520 '
DISPLAY '================================================'
IF CT-TOT-ALL-RECS-WRITTEN = ZERO
MOVE 'PROGRAM DID NOT OUTPUT ANY RSSP PRICING RECORDS.'
TO WS-ERR-MSG1
MOVE 'THIS IS HIGHLY UNUSUAL AND LIKELY INDICATIVE OF'
TO WS-ERR-MSG2
MOVE 'A MAJOR PROBLEM. PROGRAMMER ATTENTION REQUIRED.'
TO WS-ERR-MSG3
MOVE 16 TO ABEND-CD
PERFORM 9999-ABEND
END-IF
* TOTAL SVP CATEGORY ('A') RECS FETCHED
MOVE CT-SVP-CATG-CUR-FETCHED TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP CATEGORY RECS ("A") FETCHED'
* TOTAL SVP CATEGORY ('A') RECS WRITTEN
MOVE CT-TOT-A-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP CATEGORY RECS ("A") WRITTEN'
* TOTAL SVP SKU ID ('B') RECS FETCHED
MOVE CT-SVP-SKU-ID-CUR-FETCHED TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP SKU ID ("B") RECS FETCHED'
* TOTAL SVP SKU ID ('B') RECS WRITTEN
MOVE CT-TOT-B-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP SKU ID ("B") RECS WRITTEN'
* TOTAL SVP COMPONENT SKU ('BA') RECS FETCHED
MOVE CT-SVP-COMP-SKU-CUR-FETCHED TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP COMPONENT SKU ("BA") RECS FETCHED'
* TOTAL SVP COMPONENT SKU ('BA') RECS WRITTEN
MOVE CT-TOT-BA-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP COMPONENT SKU ("BA") RECS WRITTEN'
* TOTAL SVP COST AMT (DEALER NET) ('BB') RECS FETCHED
MOVE CT-SVP-COST-AMT-CUR-FETCHED TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP COST AMT (DEALER NET) ("BB") RECS FETCHED'
* TOTAL SVP COST AMT (DEALER NET) ('BB') RECS WRITTEN
MOVE CT-TOT-BB-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP COST AMT (DEALER NET) ("BB") RECS WRITTEN'
* TOTAL SVP CATEGORY ('C') RECS FETCHED
MOVE CT-SVP-CATG-ASOC-CUR-FETCHED TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP CATEGORY ASOC ("C") RECS FETCHED'
* TOTAL SVP CATEGORY ('C') RECS WRITTEN
MOVE CT-TOT-C-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY WS-EDIT-REC-COUNT
' TOTAL SVP CATEGORY ASOC ("C") RECS WRITTEN'
* TOTAL RECS (ALL TYPES) WRITTEN
MOVE CT-TOT-ALL-RECS-WRITTEN TO WS-EDIT-REC-COUNT
DISPLAY ' '
DISPLAY WS-EDIT-REC-COUNT ' TOTAL PRICE RECS WRITTEN'
.
******************************************************************
9999-ABEND.
******************************************************************
DISPLAY '***********************************************'
UPON CONSOLE
DISPLAY '** ABEND TAKEN BY COBOL' UPON CONSOLE
DISPLAY '** PROGRAM RPR6520' UPON CONSOLE
DISPLAY '**' UPON CONSOLE
DISPLAY '** ' WS-ERR-MSG1 UPON CONSOLE
DISPLAY '** ' WS-ERR-MSG2 UPON CONSOLE
DISPLAY '** ' WS-ERR-MSG3 UPON CONSOLE
DISPLAY '** ' WS-ERR-MSG4 UPON CONSOLE
DISPLAY '** ' UPON CONSOLE
DISPLAY '***********************************************'
UPON CONSOLE
MOVE 0 TO TIMING
CALL "CEE3ABD" USING ABEND-CD , TIMING
.

More Related Content

DOCX
COBOL BATCH EXAMPLE-RPR6621F
DOCX
COBOL CICS EXAMPLE-SC52P52
PDF
qmx_reeher_transaction_dl_sql_ex.sql
TXT
Casnewb
DOCX
Data Mapping - SCSALE COPYBOOK MAPPING PRELIM GUIDE
PDF
OOW19 - Flashback, not just for DBAs
COBOL BATCH EXAMPLE-RPR6621F
COBOL CICS EXAMPLE-SC52P52
qmx_reeher_transaction_dl_sql_ex.sql
Casnewb
Data Mapping - SCSALE COPYBOOK MAPPING PRELIM GUIDE
OOW19 - Flashback, not just for DBAs

Similar to COBOL DB2 BATCH EXAMPLE-RPR6520 (20)

PDF
Z390 Designare REV1.0.pdf
PDF
ZFINDALLZPROGAM
DOCX
as400 built in function- %MSSECONDS
PDF
k8s from kube-proxy and iptables-by Martynas.pdf
PDF
Flashback ITOUG
PDF
a_COMX_CANX_VEH_rxx020_A(8-0)Systèmes embarqués.pdf
PDF
Barometric Digital pressure Sensor BMP085
PPTX
OpenWorld Sep14 12c for_developers
DOC
Sql queries
PDF
qmx_acknowledgement_dl_sql_ex.sql
DOC
Nguyen thi tuyet
DOCX
Lab08Lab08.cppLab08Lab08.cpp.docx
PDF
OOW19 - Ten Amazing SQL features
DOC
Zmalv output type_v1.1
DOCX
As400 session or device error
PDF
KLIMA Software - Some DEMO Results Outputs in ENGLISH Language
PDF
re:Invent 2019 BPF Performance Analysis at Netflix
DOCX
Near-field Gaussian Dispersion Analysis in AERMOD: A demonstration project (I...
PDF
Sangam 2019 - The Latest Features
PDF
[嵌入式系統] MCS-51 實驗 - 使用 IAR (2)
Z390 Designare REV1.0.pdf
ZFINDALLZPROGAM
as400 built in function- %MSSECONDS
k8s from kube-proxy and iptables-by Martynas.pdf
Flashback ITOUG
a_COMX_CANX_VEH_rxx020_A(8-0)Systèmes embarqués.pdf
Barometric Digital pressure Sensor BMP085
OpenWorld Sep14 12c for_developers
Sql queries
qmx_acknowledgement_dl_sql_ex.sql
Nguyen thi tuyet
Lab08Lab08.cppLab08Lab08.cpp.docx
OOW19 - Ten Amazing SQL features
Zmalv output type_v1.1
As400 session or device error
KLIMA Software - Some DEMO Results Outputs in ENGLISH Language
re:Invent 2019 BPF Performance Analysis at Netflix
Near-field Gaussian Dispersion Analysis in AERMOD: A demonstration project (I...
Sangam 2019 - The Latest Features
[嵌入式系統] MCS-51 實驗 - 使用 IAR (2)
Ad

More from Jon Fortman (6)

DOCX
Technical Specification - RPR6620F cobol
DOCX
System Architecture v3.0
DOCX
Impact Analysis FRAN PCT DATA DEFINITION CHANGE
DOCX
Technical Specification - CSVRD02 proc
DOCX
Test Proofing Protocol - RPR6320 Assurant Xmit-a
PPTX
RSSP Franchise Service Plan Automation
Technical Specification - RPR6620F cobol
System Architecture v3.0
Impact Analysis FRAN PCT DATA DEFINITION CHANGE
Technical Specification - CSVRD02 proc
Test Proofing Protocol - RPR6320 Assurant Xmit-a
RSSP Franchise Service Plan Automation
Ad

COBOL DB2 BATCH EXAMPLE-RPR6520

  • 1. COBOL DB2 Program RPR6520 Project: ACR Service Plans Revamp DEVELOPED BY APPROVED BY NAME Jon Fortman Tim Reagan ROLE SME/Developer Asst. Dir.
  • 2. ****************************************************************** IDENTIFICATION DIVISION. ****************************************************************** PROGRAM-ID. RPR6520. AUTHOR. J.FORTMAN. DATE-WRITTEN. 05/01/1998. DATE-COMPILED. *INSTALLATION. TANDY INFORMATION SERVICES. *COPYRIGHT (C) 1998,TANDY INFORMATION SERVICES *SECURITY. RACF. *REMARKS. ****************************************************************** * C O N T R A C T S E R V I C E S * * ACR/RSSP PRICE MAINTENANCE BATCH XMIT * * EXTRACT RSSP PRICE INFORMATION FROM DB2. PRICE-FILE-OUT IS * AN EXACT PICTURE OF WHAT IS PULLED FROM DB2 WITH ONE * EXCEPTION WHICH IS THE DOLLAR AMOUNTS WHICH ARE OUTPUT AS * ZONED DECIMAL INSTEAD OF PACKED DECIMAL. OTHER THAN THIS NO * DATA MANIPULATION IS DONE PRIOR TO OUTPUT. * * FOR EASE OF PROCESSING FLOW, WE ARE OPENING ESSENTIALLY THE * SAME CURSOR 3 TIMES BUT SELECTING DIFFERENT FIELDS FOR EACH. * THIS MAKES WRITING AND PROCESSING THE DIFFERENT REC TYPES * EASIER. * * THE ABEND FAILSAFES IN THE 911- PARAGRAPHS AREA HANDLE EMPTY * CURSORS ONLY FOR THE MAIN ATTRIBUTE CURSORS: SVP CATG ID, * SVP SKU ID, SVP CATG ASOC. FOR SUBATTRIBUTE CURSORS SUCH AS * COMPONENT SKUS AND SVP COST AMT, WE ONLY ISSUE AN INFORMATIONAL * MESSAGE PER CURSOR OPEN. ****************************************************************** ENVIRONMENT DIVISION. ****************************************************************** CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-OS390. OBJECT-COMPUTER. IBM-OS390. ****************************************************************** INPUT-OUTPUT SECTION. ****************************************************************** FILE-CONTROL. SELECT CONTROL-FILE-IN ASSIGN TO RPRCTRLI FILE STATUS CTRL-STATUS RECORD KEY CTRL-FILE-KEYS ORGANIZATION INDEXED ACCESS SEQUENTIAL. SELECT PRICE-FILE-OUT ASSIGN TO RPRPRICO FILE STATUS PRICE-STATUS. ****************************************************************** DATA DIVISION. ****************************************************************** FILE SECTION. FD CONTROL-FILE-IN RECORD CONTAINS 250 CHARACTERS. 01 SCCTRL-CONTROL-RECORD. COPY SCCTRL REPLACING ==:CTRL:== BY ==CTRL==. FD PRICE-FILE-OUT RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS
  • 3. RECORD CONTAINS 300 CHARACTERS. 01 PRICE-FILE-OUT-REC. COPY SCTSPPRC REPLACING ==:PRIC:== BY ==PRIC==. **************************************************************** WORKING-STORAGE SECTION. **************************************************************** COPY CNVDTWS. 01 SV-PRICE-FILE-OUT-REC. COPY SCTSPPRC REPLACING ==:PRIC:== BY ==SV==. 01 COUNTER-VARIABLES. 05 CT-NBR-RETRIES PIC 9(2) VALUE ZERO. 05 CT-PRNT-LINES PIC 9(3) VALUE 54. 05 CT-PAGE-NUM PIC 9(3) VALUE ZERO. 05 CT-TOT-A-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-TOT-B-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-TOT-BA-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-TOT-BB-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-TOT-C-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-TOT-ALL-RECS-WRITTEN PIC 9(8) VALUE ZERO. 05 CT-SVP-CATG-CUR-FETCHED PIC 9(8) VALUE ZERO. 05 CT-SVP-SKU-ID-CUR-FETCHED PIC 9(8) VALUE ZERO. 05 CT-SVP-COMP-SKU-CUR-FETCHED PIC 9(8) VALUE ZERO. 05 CT-SVP-COST-AMT-CUR-FETCHED PIC 9(8) VALUE ZERO. 05 CT-SVP-CATG-ASOC-CUR-FETCHED PIC 9(8) VALUE ZERO. 01 WS-ERR-MSG. 05 WS-ERR-MSG1 PIC X(50) VALUE SPACES. 05 WS-ERR-MSG2 PIC X(50) VALUE SPACES. 05 WS-ERR-MSG3 PIC X(50) VALUE SPACES. 05 WS-ERR-MSG4 PIC X(50) VALUE SPACES. 01 WS-ERRORS. 05 WS-ERR-SKU PIC X(8) VALUE SPACES. 05 WS-ERR-CVRG-LGTH PIC X(4) VALUE SPACES. 05 WS-ERR-PRICE-TYP PIC X(7) VALUE SPACES. 05 WS-ERR-SKU-CATG PIC X(20) VALUE SPACES. 05 WS-ERR-XMIT-CD PIC X(5) VALUE SPACES. 05 WS-ERR-LOC-CD PIC X(7) VALUE SPACES. 05 WS-ERR-WTY-STUS PIC X(7) VALUE SPACES. 01 WS-VARIABLES. 05 WS-SVP-RTL-AMT PIC 9(7)V99. 05 WS-EDIT-COMP4 PIC ZZZ9. 05 WS-EDIT-REC-COUNT PIC ZZ,ZZZ,ZZ9. 05 WS-EDIT-SQLCODE PIC ZZZ,ZZZ,ZZ9-. 05 WS-EDIT-RETRY-PM PIC ZZZ9. 05 WS-XMIT-DEST-CD PIC X(6). 05 WS-DISPLAY PIC X(50) VALUE SPACES. 05 WS-SQL-SLS-CHNL-ID PIC X(20) VALUE SPACES. 05 WS-SPIFF-AMT PIC S9(7)V99 COMP-3. 05 WS-PRICE-AMT PIC S9(5)V99 COMP-3. 05 WS-SPIFF-PCT PIC S9(3)V99 COMP-3. 05 WS-9999 PIC 9(4). 05 CT-LEAD-ZEROS PIC 9(3). 05 WS-FIELD-LEN PIC 9(3). 05 WS-WRNTY-YRS PIC 9(2). 05 WS-WRNTY-MTHS PIC 9(2). 05 CTRL-STATUS PIC 9(2).
  • 4. 05 PRICE-STATUS PIC 9(2). 05 WS-CVRG-LGTH-DAYS PIC S9(4) COMP. 05 CTRL-XMIT-SUB PIC S9(4) COMP. 05 CTRL-WTY-TYP-SUB PIC S9(4) COMP. 05 WS-DEST-SUB PIC S9(4) COMP. 05 ABEND-CD PIC S9(9) BINARY. 05 TIMING PIC S9(9) BINARY. 01 WS-DATES. 05 WS-SYS-TIME. 10 WS-SYS-HH PIC 99. 10 WS-SYS-MIN PIC 99. 10 WS-SYS-SS PIC 99. 05 WS-CURR-YYYYSMMSDD. 10 WS-CURRENT-YYYY PIC X(4). 10 F PIC X(1) VALUE '/'. 10 WS-CURRENT-MM PIC X(2). 10 F PIC X(1) VALUE '/'. 10 WS-CURRENT-DD PIC X(2). 05 WS-CURRENT-YYYYMMDD. 10 WS-CURRENT-YYYY PIC X(4). 10 WS-CURRENT-MM PIC X(2). 10 WS-CURRENT-DD PIC X(2). 05 WS-CURRENT-MMDDYYYY. 10 WS-CURRENT-MM PIC X(2). 10 WS-CURRENT-DD PIC X(2). 10 WS-CURRENT-YYYY PIC X(4). 05 WS-DSCNTU-CUTOFF-DT PIC X(10). 05 F REDEFINES WS-DSCNTU-CUTOFF-DT. 10 WS-DSCNTU-MM PIC X(2). 10 WS-DSCNTU-SL1 PIC X(1). 10 WS-DSCNTU-DD PIC X(2). 10 WS-DSCNTU-SL2 PIC X(1). 10 WS-DSCNTU-YYYY PIC X(4). 01 WS-MISC-INDS. 05 WS-SPIFF-ERROR-IND PIC X. 88 SPIFF-ERROR VALUE 'Y'. 05 WS-FOUND-IND PIC X. 88 FOUND VALUE 'Y'. 88 NOT-FOUND VALUE 'N'. 05 WS-CONTROL-FILE-IND PIC X. 88 EOF-CONTROL-FILE-IN VALUE 'Y'. 05 WS-SVP-CATG-ID-CUR-IND PIC X. 88 END-OF-SVP-CATG-ID-CUR VALUE 'Y'. 05 WS-SVP-SKU-ID-CURSOR-IND PIC X. 88 END-OF-SVP-SKU-ID-CURSOR VALUE 'Y'. 05 WS-SVP-COMP-SKU-ID-CUR-IND PIC X. 88 END-OF-SVP-COMP-SKU-ID-CUR VALUE 'Y'. 05 WS-SVP-CATG-ASOC-CRSR-IND PIC X. 88 END-OF-SVP-CATG-ASOC-CRSR VALUE 'Y'. 05 WS-CURSOR-IND PIC X. 88 CURSOR-OPEN VALUE 'Y'. 05 WS-STR-TYP-ID-FOUND-IND PIC X(1) VALUE 'N'. 88 STR-TYP-ID-FOUND VALUE 'Y'. 05 WS-SVP-COST-AMT-CUR-IND PIC X. 88 END-OF-SVP-COST-AMT-CUR VALUE 'Y'.
  • 5. *--TABLE INDICATES SPECIFIC PRICE ERRORS THAT HAVE OCCURRED * 01 WS-PRICE-ERR-MSGS. 05 WS-XMIT-CD-ERR-IND PIC X. 88 XMIT-CD-ERR VALUE 'Y'. 05 WS-SKU-CATG-ERR-MSG PIC X(50) VALUE 'INVALID TRANSMIT CODE/NOT FOUND ON CONTROL FILE'. 01 WS-PRICE-ERR-TABLE REDEFINES WS-PRICE-ERR-MSGS. 05 WS-PRICE-ERR-INDS OCCURS 5 TIMES INDEXED BY PRICE-ERR-SUB. 10 WS-PRICE-ERR-IND PIC X. 10 WS-PRICE-ERR-MSG PIC X(50). **************************************************************** * CONSTANT VARIABLES **************************************************************** 01 WS-CONSTANTS. 05 CN-DSCNTU-CUTOFF-DAYS PIC S9(4) VALUE 0. 05 CN-MAX-PRNT-LINES PIC 9(3) VALUE 53. 05 WS-PRICE-ERR-TBL-MAX PIC S9(4) COMP VALUE 5. **************************************************************** * TABLES **************************************************************** * TRANSMIT DESTINATION CODE TABLE 01 XMIT-DEST-CD-TBL. 05 T6-XMIT-CD-TBL-MAX PIC S9(9) COMP VALUE 10. 05 T6-XMIT-CD-TBL-END PIC S9(9) COMP. 05 T6-XMIT-CD OCCURS 1 TO 10 TIMES DEPENDING ON T6-XMIT-CD-TBL-END INDEXED BY T6-XMIT-SUB. 10 T6-DB2-XMIT-CD PIC X(5). 10 T6-DEST-CD OCCURS 5 TIMES PIC X(5). **************************************************************** * PARAMETER VARIABLES **************************************************************** COPY PARMWORK REPLACING ==:PARM-:== BY ==== ==:REPEAT:== BY 3. 01 PM-MAX-RETRIES PIC S9(4) VALUE 100. 01 PM-COMPANY PIC S9(4) COMP. **************************************************************** * SQLCA **************************************************************** EXEC SQL INCLUDE SQLCA END-EXEC. **************************************************************** * DB2 TABLE & HOST VARIABLE DECLARATIONS **************************************************************** EXEC SQL INCLUDE SPSMDSES END-EXEC. EXEC SQL INCLUDE SPSCATEG END-EXEC. EXEC SQL INCLUDE SPSCATGA END-EXEC. EXEC SQL INCLUDE SPSDETAI END-EXEC. EXEC SQL INCLUDE SPSPRICE END-EXEC. EXEC SQL INCLUDE SPSCOMPA END-EXEC. EXEC SQL INCLUDE SPSVPCOS END-EXEC. EXEC SQL INCLUDE SPSLCHNM END-EXEC. 01 DB2-NULL-INDICATOR-VARIABLES. 05 SKU-SERIES-ID-NULL-IND PIC S9(4) BINARY. ********************************************************
  • 6. * SVP CATEGORY CURSOR DECLARE ******************************************************** EXEC SQL DECLARE SVP-CATG-ID-CUR CURSOR FOR SELECT DISTINCT SC.SVP_CATG_ID ,SC.SVP_CATG_DESC ,SC.SKU_MFG_SRCE_CD ,SC.MTH_WRNTY_MIN_NBR ,SC.MTH_WRNTY_MAX_NBR ,SC.SKU_SERIES_ID ,SVD.SVP_XMIT_DEST_CD FROM SVP_DETAIL SVD ,SVP_PRICE_DTL SPD ,SVP_CATEGORY SC ,SVP_CATG_ASOC SCA ,MDSE_SVP_ASOC MSA WHERE MSA.MDSE_GRP_NBR = :PM-COMPANY *THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID *ASSOC AND MSA.ASOC_EFF_DT = (SELECT MAX(MSA2.ASOC_EFF_DT) FROM MDSE_SVP_ASOC MSA2 WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND ( MSA2.ASOC_EXP_DT IS NULL OR MSA2.ASOC_EXP_DT > CURRENT DATE ) AND MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND MSA2.SKU_ID = MSA.SKU_ID AND MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID) AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID AND SPD.SVP_PRICE_EFF_DT = (SELECT MAX(SPD2.SVP_PRICE_EFF_DT) FROM SVP_PRICE_DTL SPD2 WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID) AND ( (SVD.SVP_DSCNTU_DT IS NULL) OR (SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT) ) END-EXEC. ******************************************************** * SVP SKU ID CURSOR DECLARE ******************************************************** EXEC SQL DECLARE SVP-SKU-ID-CURSOR CURSOR FOR SELECT DISTINCT SVD.SVP_SKU_ID ,SVD.SVP_SPCL_OPTN_CD
  • 7. ,SVD.SVP_BEG_MTH_NBR ,SVD.SVP_COVER_MTH_QTY ,SVD.SVP_WRNTY_TYP_CD ,SVD.SVP_SRVC_LOC_CD ,SVD.SVP_SPIFF_PCT ,SVD.SVP_XMIT_DEST_CD ,SVD.SVP_DESC ,SVD.BILL_FREQ_MTH_QTY ,SVD.SVP_PREPAY_MTH_QTY ,SVD.SVP_SPIFF_AMT ,SPD.SVP_RTL_AMT FROM SVP_DETAIL SVD ,SVP_PRICE_DTL SPD ,SVP_CATEGORY SC ,SVP_CATG_ASOC SCA ,MDSE_SVP_ASOC MSA WHERE MSA.MDSE_GRP_NBR = :PM-COMPANY *THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID *ASSOC AND MSA.ASOC_EFF_DT = (SELECT MAX(MSA2.ASOC_EFF_DT) FROM MDSE_SVP_ASOC MSA2 WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND ( MSA2.ASOC_EXP_DT IS NULL OR MSA2.ASOC_EXP_DT > CURRENT DATE ) AND MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND MSA2.SKU_ID = MSA.SKU_ID AND MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID) AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID * THIS GETS THE MOST CURRENT PRICE AND SPD.SVP_PRICE_EFF_DT = (SELECT MAX(SPD2.SVP_PRICE_EFF_DT) FROM SVP_PRICE_DTL SPD2 WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID) AND ( (SVD.SVP_DSCNTU_DT IS NULL) OR (SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT) ) END-EXEC. ******************************************************** * SVP COMPONENT SKU ID CURSOR DECLARE ******************************************************** * THIS GETS COMPONENT SKUS THAT ARE ASSOCIATED (I.E. TERMS AND * CONDITIONS BROCHURES) TO SVP SKU IDS EXEC SQL
  • 8. DECLARE SVP-COMP-SKU-CUR CURSOR FOR SELECT COM.SVP_COMP_SKU_ID ,COM.SVP_COMP_TYP_CD FROM SVP_COMP_ASOC COM WHERE COM.SVP_COMP_EFF_DT = (SELECT MAX(COM2.SVP_COMP_EFF_DT) FROM SVP_COMP_ASOC COM2 WHERE COM2.SVP_COMP_EFF_DT <= CURRENT DATE AND COM2.SVP_COMP_EXP_DT > CURRENT DATE AND COM2.SVP_SKU_ID = :SVP-DETAIL.SVP-SKU-ID AND COM2.SVP_SKU_ID = COM.SVP_SKU_ID AND COM2.SVP_COMP_SKU_ID = COM.SVP_COMP_SKU_ID) END-EXEC ******************************************************** * SVP COST AMT (DEALER NET) CURSOR DECLARE ******************************************************** * THIS GETS SVP COST AMOUNTS THAT ARE ASSOCIATED * TO SVP SKU IDS. THERE CAN BE MANY SVP COST (DEALER NET) * AMOUNTS PER * SVP SKU ID (UNIQUELY IDENTIFIED WITH SALES * CHANNEL ID). EXEC SQL DECLARE SVP-COST-AMT-CUR CURSOR FOR SELECT SCD.SLS_CHNL_ID ,SCD.SVP_COST_AMT FROM SVP_COST_DTL SCD WHERE SCD.SVP_COST_EFF_DT = (SELECT MAX(SCD2.SVP_COST_EFF_DT) FROM SVP_COST_DTL SCD2 WHERE SCD2.SVP_COST_EFF_DT <= CURRENT DATE AND (SCD2.SVP_COST_EXP_DT > CURRENT DATE OR SCD2.SVP_COST_EXP_DT IS NULL) AND SCD2.SVP_SKU_ID = :SVP-DETAIL.SVP-SKU-ID AND SCD2.SVP_SKU_ID = SCD.SVP_SKU_ID AND SCD2.SLS_CHNL_ID = SCD.SLS_CHNL_ID) ORDER BY SCD.SLS_CHNL_ID END-EXEC ******************************************************** * SVP CATEGORY ASSOCIATION CURSOR DECLARE ******************************************************** EXEC SQL DECLARE SVP-CATG-ASOC-CRSR CURSOR FOR SELECT DISTINCT SCA.SVP_CATG_ID ,SCA.SVP_SKU_ID ,SVD.SVP_XMIT_DEST_CD FROM SVP_DETAIL SVD ,SVP_PRICE_DTL SPD ,SVP_CATEGORY SC ,SVP_CATG_ASOC SCA ,MDSE_SVP_ASOC MSA WHERE
  • 9. MSA.MDSE_GRP_NBR = :PM-COMPANY *THIS SUBSELECT GETS THE MOST CURRENT MERCH-SKU-TO-SVP-CATG-ID *ASSOC AND MSA.ASOC_EFF_DT = (SELECT MAX(MSA2.ASOC_EFF_DT) FROM MDSE_SVP_ASOC MSA2 WHERE MSA2.ASOC_EFF_DT <= CURRENT DATE AND ( MSA2.ASOC_EXP_DT IS NULL OR MSA2.ASOC_EXP_DT > CURRENT DATE ) AND MSA2.MDSE_GRP_NBR = MSA.MDSE_GRP_NBR AND MSA2.SKU_ID = MSA.SKU_ID AND MSA2.SLS_CHNL_ID = MSA.SLS_CHNL_ID) AND MSA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_CATG_ID = SC.SVP_CATG_ID AND SCA.SVP_SKU_ID = SVD.SVP_SKU_ID AND SVD.SVP_SKU_ID = SPD.SVP_SKU_ID AND SPD.SVP_PRICE_EFF_DT = (SELECT MAX(SPD2.SVP_PRICE_EFF_DT) FROM SVP_PRICE_DTL SPD2 WHERE SPD2.SVP_PRICE_EFF_DT <= CURRENT DATE AND SPD.SVP_SKU_ID = SPD2.SVP_SKU_ID) AND ( (SVD.SVP_DSCNTU_DT IS NULL) OR (SVD.SVP_DSCNTU_DT > :WS-DSCNTU-CUTOFF-DT) ) END-EXEC. ***************************************************************** LINKAGE SECTION. ***************************************************************** 01 PARM-FIELDS. 05 QJ-PARM-L PIC 9(4) COMP-4. 05 QJ-PARM PIC X(100). ****************************************************************** PROCEDURE DIVISION USING PARM-FIELDS. ****************************************************************** PERFORM 100-INITIALIZE PERFORM 820-OPEN-SVP-CATG-ID-CUR UNTIL CURSOR-OPEN PERFORM 825-FETCH-SVP-CATG-ID-CUR IF END-OF-SVP-CATG-ID-CUR PERFORM 911-EMPTY-SVP-CATG-ID-CUR END-IF PERFORM 200-EXTRACT-SVP-CATG-IDS UNTIL END-OF-SVP-CATG-ID-CUR EXEC SQL CLOSE SVP-CATG-ID-CUR END-EXEC MOVE 'N' TO WS-CURSOR-IND PERFORM 830-OPEN-SVP-SKU-ID-CURSOR UNTIL CURSOR-OPEN PERFORM 835-FETCH-SVP-SKU-ID-CURSOR IF END-OF-SVP-SKU-ID-CURSOR PERFORM 911-EMPTY-SVP-SKU-ID-CURSOR END-IF PERFORM 220-EXTRACT-SVP-SKU-IDS UNTIL END-OF-SVP-SKU-ID-CURSOR
  • 10. EXEC SQL CLOSE SVP-SKU-ID-CURSOR END-EXEC MOVE 'N' TO WS-CURSOR-IND PERFORM 840-OPEN-SVP-CATG-ASOC-CURSOR UNTIL CURSOR-OPEN PERFORM 845-FETCH-SVP-CATG-ASOC-CURSOR IF END-OF-SVP-CATG-ASOC-CRSR PERFORM 911-EMPTY-SVP-CATG-ASOC-CRSR END-IF PERFORM 230-EXTRACT-SVP-CATG-ASOC UNTIL END-OF-SVP-CATG-ASOC-CRSR EXEC SQL CLOSE SVP-CATG-ASOC-CRSR END-EXEC PERFORM 9000-PROGRAM-END STOP RUN . ****************************************************************** 100-INITIALIZE. ****************************************************************** DISPLAY ' ' DISPLAY '***********************************************' DISPLAY '* R P R 6 5 2 0 *' DISPLAY '***********************************************' DISPLAY ' ' * * PROCESS PARMS * MOVE SPACES TO WORK-AREA MOVE QJ-PARM(1:QJ-PARM-L) TO JCL-AREA MOVE 'RETRY' TO KEY-X(1) MOVE 'COMPANY' TO KEY-X(2) MOVE 'DSCDAYS' TO KEY-X(3) CALL 'PARMKEY' USING WORK-AREA IF ERROR-FLAG > 0 DISPLAY ERROR-MESSAGE MOVE ' BAD PARMKEY RETURN CODE ' TO WS-ERR-MSG1 MOVE ' PLEASE CORRECT AND RE-SUBMIT ' TO WS-ERR-MSG2 MOVE 12 TO ABEND-CD PERFORM 9999-ABEND END-IF IF KEY-X(1) NOT = SPACES MOVE KEY-P(1) TO PM-MAX-RETRIES END-IF MOVE PM-MAX-RETRIES TO WS-EDIT-RETRY-PM DISPLAY ' ' DISPLAY 'MAXIMUM NUMBER OF RETRIES = ' WS-EDIT-RETRY-PM IF KEY-X(2) NOT = SPACES MOVE KEY-P(2) TO PM-COMPANY ELSE DISPLAY ERROR-MESSAGE MOVE 'COMPANY PARM NOT PRESENT. MUST BE' TO WS-ERR-MSG1 MOVE '2 DIGITS WITH LEADING ZERO. ' TO WS-ERR-MSG2 MOVE 'CORRECT AND RE-SUBMIT. ' TO WS-ERR-MSG3 MOVE 12 TO ABEND-CD PERFORM 9999-ABEND END-IF
  • 11. DISPLAY ' ' DISPLAY 'RSSP PRICES EXTRACTED FOR COMPANY ID: ' PM-COMPANY IF KEY-X(3) NOT = SPACES IF KEY-X(3)(1:3) IS NUMERIC MOVE KEY-X(3)(1:3) TO CN-DSCNTU-CUTOFF-DAYS ELSE MOVE 'PARM ERROR: DISCONTINUE DAYS SUBTRACT' TO WS-ERR-MSG1 MOVE 'FORMAT: 3 DIGIT NUMBER' TO WS-ERR-MSG2 MOVE 12 TO ABEND-CD PERFORM 9999-ABEND END-IF END-IF * * GET CURRENT DATE * MOVE FUNCTION CURRENT-DATE(1:8) TO WS-CURRENT-YYYYMMDD MOVE CORRESPONDING WS-CURRENT-YYYYMMDD TO WS-CURRENT-MMDDYYYY MOVE CORRESPONDING WS-CURRENT-YYYYMMDD TO WS-CURR-YYYYSMMSDD * * CALCULATE DISCONTINUE CUT OFF DATE * MOVE SPACES TO DTR-DATE-FIELDS MOVE WS-CURRENT-MMDDYYYY TO DTR-CAL-DATE-N MOVE CN-DSCNTU-CUTOFF-DAYS TO DTR-NBR-DAYS-N SET SUBTRACT-DAYS TO TRUE CALL 'CNVDATE' USING DTR-DATE-FIELDS IF NOT VALID-DATE MOVE 'INVALID CUT OFF DATE FOR DISCONTINUED ITEMS' TO WS-ERR-MSG1 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-IF MOVE DTR-CAL-MM2 TO WS-DSCNTU-MM MOVE '/' TO WS-DSCNTU-SL1 MOVE DTR-CAL-DD2 TO WS-DSCNTU-DD MOVE '/' TO WS-DSCNTU-SL2 MOVE DTR-CAL-CC2 TO WS-DSCNTU-YYYY (1:2) MOVE DTR-CAL-YY2 TO WS-DSCNTU-YYYY (3:2) MOVE CN-DSCNTU-CUTOFF-DAYS TO WS-EDIT-COMP4 DISPLAY ' ' DISPLAY 'DISCONTINUE CUT OFF DATE IS CALCULATED AS' DISPLAY 'CURRENT DATE MINUS ' WS-EDIT-COMP4 DISPLAY 'DAYS. CUT OFF DATE FOR THIS RUN: ' WS-DSCNTU-CUTOFF-DT * * OPEN FILES * OPEN INPUT CONTROL-FILE-IN OUTPUT PRICE-FILE-OUT EVALUATE TRUE WHEN (CTRL-STATUS IS NOT = 97 AND CTRL-STATUS IS NOT = ZERO) MOVE 'UNABLE TO OPEN RPRCTRLI FILE' TO WS-ERR-MSG1 STRING 'FILE STATUS IS ' CTRL-STATUS
  • 12. DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND WHEN (PRICE-STATUS IS NOT = ZERO) MOVE 'UNABLE TO OPEN RPRPRICO FILE' TO WS-ERR-MSG1 STRING 'FILE STATUS IS ' PRICE-STATUS DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE MOVE 'N' TO WS-CURSOR-IND * * LOAD VALID DB2 XMIT CODES & DESTINATIONS FROM CTRLFILE * MOVE SPACES TO CTRL-FILE-KEYS MOVE 'XMITDESTCD' TO CTRL-KEY1-REC-TYPE PERFORM 800-START-CONTROL-FILE PERFORM 810-READ-CONTROL-FILE IF CTRL-KEY1-REC-TYPE NOT = 'XMITDESTCD' MOVE '"XMITDESTCD" REC TYPE NOT FOUND ON CONTROL FILE.' TO WS-ERR-MSG1 MOVE 'CONTACT CONTRACT SERVICES PROGRAMMING STAFF.' TO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-IF MOVE ZERO TO T6-XMIT-CD-TBL-END PERFORM 145-LOAD-XMIT-TBL VARYING T6-XMIT-SUB FROM 1 BY 1 UNTIL EOF-CONTROL-FILE-IN OR CTRL-KEY1-REC-TYPE IS NOT = 'XMITDESTCD' * INITIALIZE ERROR INDS & MESSAGE FIELDS MOVE 'N' TO WS-XMIT-CD-ERR-IND . ****************************************************************** 145-LOAD-XMIT-TBL. ****************************************************************** IF (T6-XMIT-CD-TBL-END + 1) > T6-XMIT-CD-TBL-MAX MOVE 'TRANSMIT CODE TABLE OVERFLOW' TO WS-ERR-MSG1 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE MOVE CTRL-KEY2 TO T6-DB2-XMIT-CD(T6-XMIT-SUB) PERFORM 150-LOAD-XMIT-DEST-CD VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL WS-DEST-SUB IS > CTRL-MAX-XMIT-DEST-CD ADD 1 TO T6-XMIT-CD-TBL-END PERFORM 810-READ-CONTROL-FILE END-IF . ****************************************************************** 150-LOAD-XMIT-DEST-CD.
  • 13. ****************************************************************** MOVE CTRL-XMIT-DEST-CD OF CTRL-XMIT-DEST-CD-REC (WS-DEST-SUB) TO T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) . ****************************************************************** 200-EXTRACT-SVP-CATG-IDS. ****************************************************************** INITIALIZE PRIC-PRICE-REC-INITIAL * FILE CREATE DATE MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT * RECORD TYPE INDICATOR SET PRIC-MNT-CATG-REC TO TRUE * CATEGORY ID MOVE SVP-CATG-ID OF SVP-CATEGORY TO PRIC-SVP-CATG-ID * CATEGORY DESC MOVE SVP-CATG-DESC-TEXT OF SVP-CATEGORY (1:SVP-CATG-DESC-LEN) TO PRIC-SVP-CATG-DESC * MFG SOURCE CODE MOVE SKU-MFG-SRCE-CD OF SVP-CATEGORY TO PRIC-SKU-MFG-SRCE-CD * MERCHANDISE CLASS IF SKU-SERIES-ID OF SVP-CATEGORY (1:2) = '25' OR '26' SET PRIC-COMPUTER-CLASS TO TRUE ELSE SET PRIC-CONSUMER-CLASS TO TRUE END-IF * MFG WARRANTY RANGE MINIMUM MOVE MTH-WRNTY-MIN-NBR OF SVP-CATEGORY TO PRIC-MFG-WTY-MIN-NBR * MFG WARRANTY RANGE MAXIMUM MOVE MTH-WRNTY-MAX-NBR OF SVP-CATEGORY TO PRIC-MFG-WTY-MAX-NBR MOVE PRIC-PRICE-REC TO SV-PRICE-REC * CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE * XMITTED PERFORM 340-FIND-CTRL-DB2-XMIT-CD IF NOT XMIT-CD-ERR PERFORM 290-WRITE-PRICE-REC VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) IS = SPACES) END-IF
  • 14. PERFORM 825-FETCH-SVP-CATG-ID-CUR . ****************************************************************** 220-EXTRACT-SVP-SKU-IDS. ****************************************************************** INITIALIZE PRIC-PRICE-REC-INITIAL *------------------------------------------------------ * THIS LIST OF FIELDS IS TO LOAD THE SVP SKU ID TYPE REC WITH * SVP SKU ID ATTRIBUTES THAT HAVE A ONE TO ONE RELATIONSHIP * WITH SVP SKU ID. *------------------------------------------------------ * FILE CREATE DATE MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT * RECORD TYPE INDICATOR SET PRIC-MNT-SVP-REC TO TRUE * SVP SKU ID MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID * SVP SKU DESC MOVE SVP-DESC OF SVP-DETAIL TO PRIC-SVP-SKU-DESC * SPECIAL OPTION CODE MOVE SVP-SPCL-OPTN-CD OF SVP-DETAIL TO PRIC-SVP-SPCL-OPTN-CD * WARRANTY TYPE CODE MOVE SVP-WRNTY-TYP-CD OF SVP-DETAIL TO PRIC-SVP-WRNTY-TYP-CD * SERVICE LOCATION CODE MOVE SVP-SRVC-LOC-CD OF SVP-DETAIL TO PRIC-SVP-SRVC-LOC-CD * XMIT DESTINATION CODE MOVE SVP-XMIT-DEST-CD OF SVP-DETAIL TO PRIC-SVP-XMIT-DEST-CD-SVP * SVP RETAIL AMOUNT MOVE SVP-RTL-AMT OF SVP-PRICE-DTL TO PRIC-SVP-RTL-AMT **** MSAHA1-12/14/2010-RB ISSUE 31 ******* **** IF SVP-PREPAY-MTH-QTY OF SVP-DETAIL > 0 **** MULTIPLY SVP-RTL-AMT OF SVP-PRICE-DTL BY **** SVP-PREPAY-MTH-QTY OF SVP-DETAIL **** GIVING WS-SVP-RTL-AMT **** MOVE WS-SVP-RTL-AMT TO PRIC-SVP-RTL-AMT **** ELSE **** MOVE SVP-RTL-AMT OF SVP-PRICE-DTL TO PRIC-SVP-RTL-AMT **** END-IF * SVP SPIFF AMOUNT COMPUTE WS-SPIFF-AMT ROUNDED = SVP-RTL-AMT OF SVP-PRICE-DTL * ( SVP-SPIFF-PCT OF SVP-DETAIL / 100 )
  • 15. * THE NEXT MULTIPLY IS BECAUSE THE IBM COMPUTE STATEMENT HAS * KNOWN BUG THAT ROUNDS INTERMITTENTLY INSTEAD OF AT THE END MULTIPLY WS-SPIFF-AMT BY 1 GIVING PRIC-SPIFF-AMT ROUNDED * SVP BEGIN MONTH NUMBER MOVE SVP-BEG-MTH-NBR OF SVP-DETAIL TO PRIC-SVP-BEG-MTH-NBR * SVP COVERAGE QUANTITY MOVE SVP-COVER-MTH-QTY OF SVP-DETAIL TO PRIC-SVP-COVER-MTH-QTY * BILL-FREQ-MTH-QTY MOVE BILL-FREQ-MTH-QTY OF SVP-DETAIL TO PRIC-BILL-FREQ-MTH-QTY * SVP-SPIFF-AMT MOVE SVP-SPIFF-AMT OF SVP-DETAIL TO PRIC-SVP-SPIFF-AMT * SVP-PREPAY-MTH-QTY MOVE SVP-PREPAY-MTH-QTY OF SVP-DETAIL TO PRIC-SVP-PREPAY-MTH-QTY MOVE PRIC-PRICE-REC TO SV-PRICE-REC * CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE * XMITTED PERFORM 340-FIND-CTRL-DB2-XMIT-CD IF NOT XMIT-CD-ERR * WRITE OUT THE SVP SKU ID ('B') TYPE REC FIRST PERFORM 290-WRITE-PRICE-REC VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) IS = SPACES) * THEN WRITE OUT THE COMPONENT RECS OF THE SVP SKU ID PERFORM 225-EXTRACT-SVP-COMP-SKU-IDS * THEN WRITE OUT THE SVP COST AMT (DEALER NET) RECS OF THE SVP * SKU ID PERFORM 227-EXTRACT-SVP-COST-AMTS END-IF * FETCH NEXT SVP SKU ID ('B') TYPE REC PERFORM 835-FETCH-SVP-SKU-ID-CURSOR . ****************************************************************** 225-EXTRACT-SVP-COMP-SKU-IDS. ****************************************************************** MOVE 'N' TO WS-CURSOR-IND PERFORM 837-OPEN-SVP-COMP-SKU-CUR UNTIL CURSOR-OPEN
  • 16. * PRIMING FETCH PERFORM 839-FETCH-SVP-COMP-SKU-ID-CUR IF END-OF-SVP-COMP-SKU-ID-CUR DISPLAY '------------------------------------------------' DISPLAY '*********** INFORMATIONAL MESSAGE **************' STRING 'SVP SKU ID ' SVP-SKU-ID OF SVP-DETAIL DELIMITED BY SIZE INTO WS-DISPLAY DISPLAY WS-DISPLAY MOVE SPACES TO WS-DISPLAY DISPLAY 'FOUND WITH NO COMPONENT SKUS ASSOCIATED IN VIEW' DISPLAY 'SVP_COMP_ASOC.' END-IF * --------- LOOP THROUGH COMPONENT SKU CURSOR ---------------- PERFORM UNTIL END-OF-SVP-COMP-SKU-ID-CUR INITIALIZE PRIC-PRICE-REC-INITIAL * FILE CREATE DATE MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT * RECORD TYPE INDICATOR SET PRIC-MNT-SVP-COMP-REC TO TRUE * SVP SKU ID * THIS IS THE SAME SVP-SKU-ID AS ON THE 'B' REC BUT IT HAS * TO BE REPEATED FOR COMPONENT SKU ASSOCIATION ON 'BA' RECS MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID-BA EVALUATE TRUE WHEN BROCHURE-COMP-TYP OF SVP-COMP-ASOC MOVE SVP-COMP-SKU-ID OF SVP-COMP-ASOC TO PRIC-SVP-COMP-SKU-ID MOVE SVP-COMP-TYP-CD OF SVP-COMP-ASOC TO PRIC-SVP-COMP-TYP-CD WHEN OTHER STRING 'UNDEFINED VALUE: ' SVP-COMP-TYP-CD OF SVP-COMP-ASOC DELIMITED BY SIZE INTO WS-ERR-MSG1 MOVE 'DETECTED IN SVP-COMP-TYP-CD OF TABLE' TO WS-ERR-MSG2 MOVE 'SVP_COMP_ASOC. PROGRAMMER ATTENTION REQUIRED' TO WS-ERR-MSG3 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE MOVE PRIC-PRICE-REC TO SV-PRICE-REC * WE SKIP DOING 340-FIND-CTRL-DB2-XMIT-CD AT THIS LEVEL SINCE XMIT * DEST CODE IS AT THE SVP SKU ID LEVEL. * WRITE OUT THE SVP COMPONENT SKU ID ('BA') TYPE RECS PERFORM 290-WRITE-PRICE-REC
  • 17. VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) IS = SPACES) PERFORM 839-FETCH-SVP-COMP-SKU-ID-CUR * END OF LOOP THROUGH COMPONENT SKU CURSOR ---------------- END-PERFORM EXEC SQL CLOSE SVP-COMP-SKU-CUR END-EXEC . ****************************************************************** 227-EXTRACT-SVP-COST-AMTS. ****************************************************************** MOVE 'N' TO WS-CURSOR-IND PERFORM 839A-OPEN-SVP-COST-AMT-CUR UNTIL CURSOR-OPEN * PRIMING FETCH PERFORM 839A-FETCH-SVP-COST-AMT-CUR * IF NO SVP COST AMT (DEALER NET) ASSOCIATED TO A GIVEN SVP SKU ID * DISPLAY MESSAGE IF END-OF-SVP-COST-AMT-CUR DISPLAY '------------------------------------------------' DISPLAY '*********** INFORMATIONAL MESSAGE **************' STRING 'SVP SKU ID ' SVP-SKU-ID OF SVP-DETAIL DELIMITED BY SIZE INTO WS-DISPLAY DISPLAY WS-DISPLAY MOVE SPACES TO WS-DISPLAY DISPLAY 'FOUND WITH NO SVP COST (DEALER NET) AMOUNT' DISPLAY 'ASSOCIATED IN TABLE/VIEW SVP_COST_DTL.' END-IF * ------- LOOP THROUGH SVP COST (DEALER NET) AMOUNT CURSOR ------- PERFORM UNTIL END-OF-SVP-COST-AMT-CUR INITIALIZE PRIC-PRICE-REC-INITIAL * FILE CREATE DATE MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT * RECORD TYPE INDICATOR SET PRIC-MNT-SVP-COST-AMT-REC TO TRUE * SVP SKU ID * THIS IS THE SAME SVP-SKU-ID AS ON THE 'B' REC BUT IT HAS * TO BE REPEATED FOR SVP COST AMT (DEALER NET) ASSOCIATION ON 'BB' * RECS MOVE SVP-SKU-ID OF SVP-DETAIL TO PRIC-SVP-SKU-ID-BB * SALES CHANNEL ID MOVE SLS-CHNL-ID OF SVP-COST-DTL TO PRIC-SLS-CHNL-ID * SALES CHANNEL NAME MOVE SLS-CHNL-ID OF SVP-COST-DTL TO WS-SQL-SLS-CHNL-ID
  • 18. PERFORM 350-FIND-SLS-CHNL-NM * SVP COST AMT (DEALER NET) MOVE SVP-COST-AMT OF SVP-COST-DTL TO PRIC-SVP-COST-AMT MOVE PRIC-PRICE-REC TO SV-PRICE-REC * WE SKIP DOING 340-FIND-CTRL-DB2-XMIT-CD AT THIS LEVEL SINCE XMIT * DEST CODE IS AT THE SVP SKU ID LEVEL. * WRITE OUT THE SVP COST AMT (DEALER NET) ('BB') TYPE RECS. WE * REPEAT THE WRITE FOR EVERY XMIT DEST CODE THAT WE FIND PER * SALES CHANNEL PERFORM 290-WRITE-PRICE-REC VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) IS = SPACES) PERFORM 839A-FETCH-SVP-COST-AMT-CUR * END OF LOOP THROUGH SVP COST (DEALER NET) AMOUNT CURSOR END-PERFORM EXEC SQL CLOSE SVP-COST-AMT-CUR END-EXEC . ****************************************************************** 230-EXTRACT-SVP-CATG-ASOC. ****************************************************************** INITIALIZE PRIC-PRICE-REC-INITIAL * FILE CREATE DATE MOVE WS-CURR-YYYYSMMSDD TO PRIC-FILE-CREATE-DT * RECORD TYPE INDICATOR SET PRIC-MNT-ASOC-REC TO TRUE * CATEGORY ID MOVE SVP-CATG-ID OF SVP-CATG-ASOC TO PRIC-SVP-CATG-ID-ASOC * SVP SKU ID MOVE SVP-SKU-ID OF SVP-CATG-ASOC TO PRIC-SVP-SKU-ID-ASOC MOVE PRIC-PRICE-REC TO SV-PRICE-REC * CHECK XMIT DESTINATION CODE TO SEE IF THIS INFO SHOULD BE * XMITTED PERFORM 340-FIND-CTRL-DB2-XMIT-CD IF NOT XMIT-CD-ERR PERFORM 290-WRITE-PRICE-REC VARYING WS-DEST-SUB FROM 1 BY 1 UNTIL (T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) IS = SPACES) END-IF
  • 19. PERFORM 845-FETCH-SVP-CATG-ASOC-CURSOR . ****************************************************************** 290-WRITE-PRICE-REC. ****************************************************************** * LOAD XMIT CODES ACCORDING WHAT REC TYPE WE'RE PROCESSING * THEN WRITE THE PRICE REC *----------------------------------------------------------------- EVALUATE TRUE * CATEGORY 'A' TYPE REC WHEN PRIC-MNT-CATG-REC MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) TO PRIC-SVP-XMIT-DEST-CD-CATG ADD 1 TO CT-TOT-A-RECS-WRITTEN * SVP SKU ID 'B' TYPE REC WHEN PRIC-MNT-SVP-REC MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) TO PRIC-SVP-XMIT-DEST-CD-SVP ADD 1 TO CT-TOT-B-RECS-WRITTEN * SVP COMPONENT SKU ID 'BA' TYPE REC WHEN PRIC-MNT-SVP-COMP-REC MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) TO PRIC-SVP-XMIT-DEST-CD-SVP-COMP ADD 1 TO CT-TOT-BA-RECS-WRITTEN * SVP COST AMT (DEALER NET) 'BB' TYPE REC WHEN PRIC-MNT-SVP-COST-AMT-REC MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) TO PRIC-SVP-XMIT-DEST-CD-SVP-COST ADD 1 TO CT-TOT-BB-RECS-WRITTEN * CATEGORY / SVP SKU ID ASSOCIATION 'C' TYPE REC WHEN PRIC-MNT-ASOC-REC MOVE T6-DEST-CD(T6-XMIT-SUB, WS-DEST-SUB) TO PRIC-SVP-XMIT-DEST-CD-ASOC ADD 1 TO CT-TOT-C-RECS-WRITTEN END-EVALUATE PERFORM 850-WRITE-PRIC-REC MOVE SV-PRICE-REC TO PRIC-PRICE-REC ADD 1 TO CT-TOT-ALL-RECS-WRITTEN . ****************************************************************** 340-FIND-CTRL-DB2-XMIT-CD. ****************************************************************** SET T6-XMIT-SUB TO 1 SEARCH T6-XMIT-CD VARYING T6-XMIT-SUB AT END SET XMIT-CD-ERR TO TRUE WHEN T6-DB2-XMIT-CD(T6-XMIT-SUB) = SVP-XMIT-DEST-CD OF SVP-DETAIL CONTINUE END-SEARCH .
  • 20. ****************************************************************** 350-FIND-SLS-CHNL-NM. ****************************************************************** EXEC SQL SELECT SLS_CHNL_NM INTO :SLS-CHNL.SLS-CHNL-NM FROM SLS_CHNL CHNL WHERE CHNL.SLS_CHNL_ID = :WS-SQL-SLS-CHNL-ID END-EXEC EVALUATE SQLCODE WHEN ZERO MOVE SLS-CHNL-NM-TEXT OF SLS-CHNL (1:SLS-CHNL-NM-LEN) TO PRIC-SLS-CHNL-NM (1:LENGTH OF PRIC-SLS-CHNL-NM) WHEN 100 MOVE 'CHNL ID NOT IN SLS_CHNL ' TO PRIC-SLS-CHNL-NM WHEN OTHER MOVE 'SLS_CHNL TBL NOT AVAIL ' TO PRIC-SLS-CHNL-NM END-EVALUATE . ****************************************************************** 800-START-CONTROL-FILE. ****************************************************************** START CONTROL-FILE-IN KEY IS GREATER THAN OR EQUAL TO CTRL-FILE-KEYS INVALID KEY STRING 'INVALID CONTROL FILE KEY: ' CTRL-KEY1-REC-TYPE DELIMITED BY SIZE INTO WS-ERR-MSG1 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-START . ****************************************************************** 810-READ-CONTROL-FILE. ****************************************************************** READ CONTROL-FILE-IN NEXT RECORD AT END SET EOF-CONTROL-FILE-IN TO TRUE END-READ IF (CTRL-STATUS IS NOT = 97) AND (CTRL-STATUS IS NOT = ZERO) AND NOT EOF-CONTROL-FILE-IN STRING 'INVALID CONTROL FILE READ FOR KEY: ' CTRL-KEY1-REC-TYPE DELIMITED BY SIZE INTO WS-ERR-MSG1 STRING 'FILE STATUS CODE: ' CTRL-STATUS DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-IF . ******************************************************************
  • 21. 820-OPEN-SVP-CATG-ID-CUR. ****************************************************************** EXEC SQL OPEN SVP-CATG-ID-CUR END-EXEC IF SQLCODE IS NOT = ZERO IF CT-NBR-RETRIES > PM-MAX-RETRIES MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-CATG-ID-CUR OPEN FAILED' TO WS-ERR-MSG1 STRING 'SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE ADD 1 TO CT-NBR-RETRIES END-IF ELSE SET CURSOR-OPEN TO TRUE MOVE 'N' TO WS-SVP-CATG-ID-CUR-IND MOVE ZERO TO CT-NBR-RETRIES END-IF . ****************************************************************** 825-FETCH-SVP-CATG-ID-CUR. ****************************************************************** MOVE ZERO TO SQLCODE EXEC SQL FETCH SVP-CATG-ID-CUR INTO :SVP-CATEGORY.SVP-CATG-ID ,:SVP-CATEGORY.SVP-CATG-DESC ,:SVP-CATEGORY.SKU-MFG-SRCE-CD ,:SVP-CATEGORY.MTH-WRNTY-MIN-NBR ,:SVP-CATEGORY.MTH-WRNTY-MAX-NBR ,:SVP-CATEGORY.SKU-SERIES-ID:SKU-SERIES-ID-NULL-IND ,:SVP-DETAIL.SVP-XMIT-DEST-CD END-EXEC EVALUATE SQLCODE WHEN ZERO ADD 1 TO CT-SVP-CATG-CUR-FETCHED WHEN 100 SET END-OF-SVP-CATG-ID-CUR TO TRUE WHEN OTHER MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-CATG-ID-CUR FETCH FAILED' TO WS-ERR-MSG1 STRING ' SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE . ****************************************************************** 830-OPEN-SVP-SKU-ID-CURSOR. ****************************************************************** EXEC SQL OPEN SVP-SKU-ID-CURSOR END-EXEC IF SQLCODE IS NOT = ZERO IF CT-NBR-RETRIES > PM-MAX-RETRIES MOVE SQLCODE TO WS-EDIT-SQLCODE
  • 22. MOVE 'SVP-SKU-ID-CURSOR OPEN FAILED' TO WS-ERR-MSG1 STRING 'SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE ADD 1 TO CT-NBR-RETRIES END-IF ELSE SET CURSOR-OPEN TO TRUE MOVE 'N' TO WS-SVP-SKU-ID-CURSOR-IND MOVE ZERO TO CT-NBR-RETRIES END-IF . ****************************************************************** 835-FETCH-SVP-SKU-ID-CURSOR. ****************************************************************** MOVE ZERO TO SQLCODE EXEC SQL FETCH SVP-SKU-ID-CURSOR INTO :SVP-DETAIL.SVP-SKU-ID ,:SVP-DETAIL.SVP-SPCL-OPTN-CD ,:SVP-DETAIL.SVP-BEG-MTH-NBR ,:SVP-DETAIL.SVP-COVER-MTH-QTY ,:SVP-DETAIL.SVP-WRNTY-TYP-CD ,:SVP-DETAIL.SVP-SRVC-LOC-CD ,:SVP-DETAIL.SVP-SPIFF-PCT ,:SVP-DETAIL.SVP-XMIT-DEST-CD ,:SVP-DETAIL.SVP-DESC ,:SVP-DETAIL.BILL-FREQ-MTH-QTY ,:SVP-DETAIL.SVP-PREPAY-MTH-QTY ,:SVP-DETAIL.SVP-SPIFF-AMT ,:SVP-PRICE-DTL.SVP-RTL-AMT END-EXEC EVALUATE SQLCODE WHEN ZERO ADD 1 TO CT-SVP-SKU-ID-CUR-FETCHED WHEN 100 SET END-OF-SVP-SKU-ID-CURSOR TO TRUE WHEN OTHER MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-SKU-ID-CURSOR FETCH FAILED' TO WS-ERR-MSG1 STRING ' SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE . ****************************************************************** 837-OPEN-SVP-COMP-SKU-CUR. ****************************************************************** EXEC SQL OPEN SVP-COMP-SKU-CUR END-EXEC IF SQLCODE IS NOT = ZERO IF CT-NBR-RETRIES > PM-MAX-RETRIES MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-COMP-SKUS-CUR OPEN FAILED' TO WS-ERR-MSG1 STRING 'SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2
  • 23. MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE ADD 1 TO CT-NBR-RETRIES END-IF ELSE SET CURSOR-OPEN TO TRUE MOVE 'N' TO WS-SVP-COMP-SKU-ID-CUR-IND MOVE ZERO TO CT-NBR-RETRIES END-IF . ****************************************************************** 839-FETCH-SVP-COMP-SKU-ID-CUR. ****************************************************************** MOVE ZERO TO SQLCODE EXEC SQL FETCH SVP-COMP-SKU-CUR INTO :SVP-COMP-ASOC.SVP-COMP-SKU-ID ,:SVP-COMP-ASOC.SVP-COMP-TYP-CD END-EXEC EVALUATE SQLCODE WHEN ZERO ADD 1 TO CT-SVP-COMP-SKU-CUR-FETCHED WHEN 100 SET END-OF-SVP-COMP-SKU-ID-CUR TO TRUE WHEN OTHER MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-COMP-SKU-ID-CURSOR FETCH FAILED' TO WS-ERR-MSG1 STRING ' SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE . ****************************************************************** 839A-OPEN-SVP-COST-AMT-CUR. ****************************************************************** EXEC SQL OPEN SVP-COST-AMT-CUR END-EXEC IF SQLCODE IS NOT = ZERO IF CT-NBR-RETRIES > PM-MAX-RETRIES MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-COST-AMT-CUR OPEN FAILED' TO WS-ERR-MSG1 STRING 'SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE ADD 1 TO CT-NBR-RETRIES END-IF ELSE SET CURSOR-OPEN TO TRUE MOVE 'N' TO WS-SVP-COST-AMT-CUR-IND MOVE ZERO TO CT-NBR-RETRIES END-IF . ****************************************************************** 839A-FETCH-SVP-COST-AMT-CUR. ******************************************************************
  • 24. MOVE ZERO TO SQLCODE EXEC SQL FETCH SVP-COST-AMT-CUR INTO :SVP-COST-DTL.SLS-CHNL-ID ,:SVP-COST-DTL.SVP-COST-AMT END-EXEC EVALUATE SQLCODE WHEN ZERO ADD 1 TO CT-SVP-COST-AMT-CUR-FETCHED WHEN 100 SET END-OF-SVP-COST-AMT-CUR TO TRUE WHEN OTHER MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-COST-AMT-CUR FETCH FAILED' TO WS-ERR-MSG1 STRING ' SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE . ****************************************************************** 840-OPEN-SVP-CATG-ASOC-CURSOR. ****************************************************************** EXEC SQL OPEN SVP-CATG-ASOC-CRSR END-EXEC IF SQLCODE IS NOT = ZERO IF CT-NBR-RETRIES > PM-MAX-RETRIES MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-CATG-ASOC-CRSR OPEN FAILED' TO WS-ERR-MSG1 STRING 'SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND ELSE ADD 1 TO CT-NBR-RETRIES END-IF ELSE SET CURSOR-OPEN TO TRUE MOVE 'N' TO WS-SVP-CATG-ASOC-CRSR-IND MOVE ZERO TO CT-NBR-RETRIES END-IF . ****************************************************************** 845-FETCH-SVP-CATG-ASOC-CURSOR. ****************************************************************** MOVE ZERO TO SQLCODE EXEC SQL FETCH SVP-CATG-ASOC-CRSR INTO :SVP-CATG-ASOC.SVP-CATG-ID ,:SVP-CATG-ASOC.SVP-SKU-ID ,:SVP-DETAIL.SVP-XMIT-DEST-CD END-EXEC EVALUATE SQLCODE WHEN ZERO ADD 1 TO CT-SVP-CATG-ASOC-CUR-FETCHED WHEN 100 SET END-OF-SVP-CATG-ASOC-CRSR TO TRUE WHEN OTHER
  • 25. MOVE SQLCODE TO WS-EDIT-SQLCODE MOVE 'SVP-CATG-ASOC-CRSR FETCH FAILED' TO WS-ERR-MSG1 STRING ' SQLCODE = ' WS-EDIT-SQLCODE DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-EVALUATE . ****************************************************************** 850-WRITE-PRIC-REC. ****************************************************************** WRITE PRICE-FILE-OUT-REC IF PRICE-STATUS IS NOT = '00' MOVE 'WRITE TO CATALOG PRICE FILE RPRPRICO UNSUCCESSFUL.' TO WS-ERR-MSG1 STRING 'THE STATUS CODE WAS ' PRICE-STATUS DELIMITED BY SIZE INTO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-IF . ****************************************************************** 911-EMPTY-SVP-CATG-ID-CUR. ****************************************************************** MOVE 'SVP-CATG-ID-CUR OPEN RESULTED IN NO DATA BEING' TO WS-ERR-MSG1 MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.' TO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND . ****************************************************************** 911-EMPTY-SVP-SKU-ID-CURSOR. ****************************************************************** MOVE 'SVP-SKU-ID-CURSOR OPEN RESULTED IN NO DATA BEING' TO WS-ERR-MSG1 MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.' TO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND . ****************************************************************** 911-EMPTY-SVP-CATG-ASOC-CRSR. ****************************************************************** MOVE 'SVP-CATG-ASOC-CRSR OPEN RESULTED IN NO DATA BEING' TO WS-ERR-MSG1 MOVE 'RETURNED. FATAL ERROR. CONTACT RSSP PROGRAMMER.' TO WS-ERR-MSG2 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND . ****************************************************************** 9000-PROGRAM-END. ****************************************************************** CLOSE CONTROL-FILE-IN PRICE-FILE-OUT DISPLAY '================================================' DISPLAY '> FINAL TOTALS SUMMARY - RPR6520 ' DISPLAY '================================================'
  • 26. IF CT-TOT-ALL-RECS-WRITTEN = ZERO MOVE 'PROGRAM DID NOT OUTPUT ANY RSSP PRICING RECORDS.' TO WS-ERR-MSG1 MOVE 'THIS IS HIGHLY UNUSUAL AND LIKELY INDICATIVE OF' TO WS-ERR-MSG2 MOVE 'A MAJOR PROBLEM. PROGRAMMER ATTENTION REQUIRED.' TO WS-ERR-MSG3 MOVE 16 TO ABEND-CD PERFORM 9999-ABEND END-IF * TOTAL SVP CATEGORY ('A') RECS FETCHED MOVE CT-SVP-CATG-CUR-FETCHED TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP CATEGORY RECS ("A") FETCHED' * TOTAL SVP CATEGORY ('A') RECS WRITTEN MOVE CT-TOT-A-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP CATEGORY RECS ("A") WRITTEN' * TOTAL SVP SKU ID ('B') RECS FETCHED MOVE CT-SVP-SKU-ID-CUR-FETCHED TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP SKU ID ("B") RECS FETCHED' * TOTAL SVP SKU ID ('B') RECS WRITTEN MOVE CT-TOT-B-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP SKU ID ("B") RECS WRITTEN' * TOTAL SVP COMPONENT SKU ('BA') RECS FETCHED MOVE CT-SVP-COMP-SKU-CUR-FETCHED TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP COMPONENT SKU ("BA") RECS FETCHED' * TOTAL SVP COMPONENT SKU ('BA') RECS WRITTEN MOVE CT-TOT-BA-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP COMPONENT SKU ("BA") RECS WRITTEN' * TOTAL SVP COST AMT (DEALER NET) ('BB') RECS FETCHED MOVE CT-SVP-COST-AMT-CUR-FETCHED TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP COST AMT (DEALER NET) ("BB") RECS FETCHED' * TOTAL SVP COST AMT (DEALER NET) ('BB') RECS WRITTEN MOVE CT-TOT-BB-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP COST AMT (DEALER NET) ("BB") RECS WRITTEN'
  • 27. * TOTAL SVP CATEGORY ('C') RECS FETCHED MOVE CT-SVP-CATG-ASOC-CUR-FETCHED TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP CATEGORY ASOC ("C") RECS FETCHED' * TOTAL SVP CATEGORY ('C') RECS WRITTEN MOVE CT-TOT-C-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY WS-EDIT-REC-COUNT ' TOTAL SVP CATEGORY ASOC ("C") RECS WRITTEN' * TOTAL RECS (ALL TYPES) WRITTEN MOVE CT-TOT-ALL-RECS-WRITTEN TO WS-EDIT-REC-COUNT DISPLAY ' ' DISPLAY WS-EDIT-REC-COUNT ' TOTAL PRICE RECS WRITTEN' . ****************************************************************** 9999-ABEND. ****************************************************************** DISPLAY '***********************************************' UPON CONSOLE DISPLAY '** ABEND TAKEN BY COBOL' UPON CONSOLE DISPLAY '** PROGRAM RPR6520' UPON CONSOLE DISPLAY '**' UPON CONSOLE DISPLAY '** ' WS-ERR-MSG1 UPON CONSOLE DISPLAY '** ' WS-ERR-MSG2 UPON CONSOLE DISPLAY '** ' WS-ERR-MSG3 UPON CONSOLE DISPLAY '** ' WS-ERR-MSG4 UPON CONSOLE DISPLAY '** ' UPON CONSOLE DISPLAY '***********************************************' UPON CONSOLE MOVE 0 TO TIMING CALL "CEE3ABD" USING ABEND-CD , TIMING .