IDENTIFICATION DIVISION. * $Revision: 3.6 $ * $Date: Feb 06 2006 13:37:34 $ * PROGRAM-ID. ML404P. AUTHOR. JONATHAN MILLS. * ********************************************************** *LAST UPDATED BY - Nirav Shah *DATE LAST UPDATED - 31012006 * *All the hard coding around business unit number have been *removed (except bu number 8). *Modified to cater for up to 99 business unit numbers, and *gaps in the business unit numbers if any. * ********************************************************** *LAST UPDATED BY - Donna Mayes *DATE LAST UPDATED - 25042000 ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ML403 ASSIGN TO EXTERNAL MLS403 ORGANIZATION IS LINE SEQUENTIAL. SELECT CONTROL-REPORT ASSIGN TO EXTERNAL MLP404 ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD ML403 RECORD IS VARYING FROM 9 TO 41 CHARACTERS. 01 ML403-HEADER. 03 ML403-RECTYPE-HEADER PIC 9. 88 ML403-RECTYPE-HEADER-VALID VALUE ZERO. 03 ML403-FILE-NAME PIC X(6). 88 ML403-FILE-NAME-VALID VALUE "MLI402". 03 FILLER PIC X(24). 01 ML403-BODY. 03 ML403-RECTYPE PIC 9. 88 ML403-RECTYPE-VALID VALUES 1 2 3. 03 ML403-BU-NO PIC 9(2). 03 ML403-CTRL-AGENT PIC X. 03 ML403-LARGE-BAL-IND PIC X. 03 ML403-WEEK-PICKED PIC 9(2). 03 ML403-CONTRACT-NUMBER PIC X(12). 03 ML403-WEEK-NO PIC 9(2). 03 ML403-OUTPUT-AMT PIC 9(9)V99. 03 ML403-RTN-CAT-NO PIC X(5). 03 ML403-DATE-NOT-LARGE-BAL. 05 ML403-DATE-NOT-LARGE-BAL-DD PIC 9(2). 05 ML403-DATE-NOT-LARGE-BAL-MM PIC 9(2). 05 ML403-DATE-NOT-LARGE-BAL-YY PIC 9(2). 01 ML403-TRAILER. 03 ML403-RECTYPE-TRAILER PIC 9. 88 ML403-RECTYPE-TRAILER-VALID VALUE 9. 03 ML403-RECORD-COUNT PIC 9(8). FD CONTROL-REPORT REPORT IS CONTROL-STATS. WORKING-STORAGE SECTION. 01 CWA000-ACCUMULATORS. 03 CWA010-WEEKS-LATE PIC S9(2). 03 CWA020-SELECT PIC X(3). 03 CWA030-RECORD-COUNT PIC 9(8). 03 CWA040-REPORT-COUNT PIC 9(8) OCCURS 3 TIMES. 03 CWA050-THIS-TIME PIC 9(8). COPY WSSQLGLM.CPY. 01 CWW000-MISCELLANEOUS. 03 CWW010-HEADER. 05 FILLER PIC X(7). 05 CWW010-DATE-TODAY. 07 CWW010-DD PIC 9(2). 07 CWW010-MM PIC 9(2). 07 CWW010-YYYY. 09 FILLER PIC X(2). 09 CWW010-YY PIC 9(2). 05 CWW010-AMNESTY-START-DATE. 07 CWW010-AMNESTY-ST-DD PIC 9(2). 07 CWW010-AMNESTY-ST-MM PIC 9(2). 07 CWW010-AMNESTY-ST-YYYY. 09 FILLER PIC X(2). 09 CWW010-AMNESTY-ST-YY PIC 9(2). 05 CWW010-AMNESTY-END-DATE. 07 CWW010-AMNESTY-END-DD PIC 9(2). 07 CWW010-AMNESTY-END-MM PIC 9(2). 07 CWW010-AMNESTY-END-YYYY. 09 FILLER PIC X(2). 09 CWW010-AMNESTY-END-YY PIC 9(2). 03 CWW020-HEADING. 05 FILLER PIC X(18) VALUE "FIRST LATE RETURN". 05 FILLER PIC X(18) VALUE "SECOND LATE RETURN". 05 FILLER PIC X(18) VALUE "THIRD LATE RETURN". 03 CWW020-HEADING-2 REDEFINES CWW020-HEADING PIC X(18) OCCURS 3 TIMES. 03 CWW030-HEADING. 05 FILLER PIC X(21) VALUE "Y- CONTROL GROUP ONLY". 05 FILLER PIC X(21) VALUE "N- TO BE ACTIONED". 03 FILLER REDEFINES CWW030-HEADING OCCURS 2 TIMES. 05 CWW030-CTRL PIC X. 05 CWW030-HEADING-3 PIC X(20). 03 CWW030-CONTROL. 05 CWW030-RECTYPE PIC 9. 05 CWW030-BU-NO PIC 99. 05 CWW030-CTRL-AGENT PIC 9. 05 CWW030-PAGE-CHANGE PIC 99 VALUE ZERO. 03 CWW040-PREVIOUS-YEARS-WEEKS. 05 CWW040-WEEKS-PREV PIC 99. 05 CWW040-WEEKS-PAST-PREV PIC 99. 05 CWW050-BU-NAME PIC X(30) OCCURS 99 TIMES. ************ Host variable declarations EXEC SQL BEGIN DECLARE SECTION END-EXEC. * * all variables that are to be used by procedure calls * must be in this section. * * all numeric fields have to be defined as a * computational field. For 9(4) or less then must * use comp. For 9(5) and above, must use comp-3. * * oracle varchar2 fields are defined as varying * 01 DWB-USERNAME PIC X(10) VARYING. 01 DWB-PASSWORD PIC X(10) VARYING. 01 DWB-DBNAME PIC X(10) VARYING. 01 DWB010-ARGUMENTS. 03 DWB010-YEAR-NUMBER PIC S9(4) COMP. 03 DWB010-MAX-WEEK-NUMBER PIC S9(2) COMP. 03 DWB010-MAX-WEEK-NUMBER-IND PIC S9(4) COMP. 01 DWB020-SEL-BU-ARGS. 03 DWB020-BU-NO PIC S9(2) COMP. 03 DWB020-BU-NAME PIC X(30). 01 DWB030-MAX-VALID-BU-N0 PIC S9(2). 01 DWB030-MIN-VALID-BU-N0 PIC S9(2). EXEC SQL INCLUDE WSFCTRL END-EXEC. * * File Control Variables * * These arrays of copies of the file control variables * are allocated as follows..... * * Array Pos Filename * ========= ======== * 1 MLS403 * 2 MLP404 * 01 DWB800-FILE-CONTROL-COPIES. 03 DWB800-FILE-CONTROL OCCURS 2 TIMES. 05 DWB800-O-FC-ROWID PIC X(18) VARYING. 05 DWB800-O-PROJECT-ID PIC X(30) VARYING. 05 DWB800-O-FILE-CTL-PROCESS-CODE PIC X. 05 DWB800-O-YEAR-WEEK-DAY. 07 DWB800-O-CAL-YEAR PIC S9(4) COMP-5. 07 DWB800-O-CAL-WEEK-NUMBER PIC S9(2) COMP-5. 07 DWB800-O-CAL-DAY-NUMBER PIC S9 COMP-5. 05 DWB800-O-JOB-RESTART-IND PIC S9 COMP-5. 05 DWB800-O-RECON-ERRORS-IND PIC S9 COMP-5. 05 DWB800-O-RECORDS-COMMITTED PIC S9(8) COMP-3. 05 DWB800-O-REC-CNT-LST-COMM PIC S9(8) COMP-3. 05 DWB800-O-END-OF-DAY-IND PIC S9 COMP-5. 05 DWB800-O-CAL-DDMMYY PIC X(6). 05 DWB800-O-CAL-DDMMYYYY PIC X(8). 05 DWB800-O-CAL-YYDDD PIC X(5). 05 DWB800-O-CAL-YYMMDD PIC X(6). 03 DWB820-FILE-CONTROL-PARAMS OCCURS 2 TIMES. 05 DWB820-PROGRAM-NAME PIC X(8) VARYING. 05 DWB820-FILE-NAME PIC X(16) VARYING. 05 DWB820-RUN-NUMBER PIC S9(3) COMP-5. 05 DWB820-QTY1 PIC S9(8) COMP-3. 05 DWB820-QTY2 PIC S9(8) COMP-3. 05 DWB820-QTY3 PIC S9(8) COMP-3. 03 DWS800-FC-MOD-FLAG PIC S9 COMP OCCURS 2 TIMES. EXEC SQL END DECLARE SECTION END-EXEC. EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE ORACA END-EXEC. REPORT SECTION. RD CONTROL-STATS CONTROL IS CWW030-CONTROL PAGE LIMIT IS 59 HEADING 2 FIRST DETAIL 3 LAST DETAIL 59. 01 REPORT-HEADING TYPE IS PAGE HEADING. 02 LINE 2. 03 COLUMN 1 PIC X(5) VALUE "ML404". 03 COLUMN 6 PIC 99 SOURCE CWW030-RECTYPE. 03 COLUMN 24 PIC X(30) VALUE "PICADOR LATE RETURNS REPORT -". 03 COLUMN 55 PIC 9(2) SOURCE CWW010-DD. 03 COLUMN 57 PIC X VALUE "/". 03 COLUMN 58 PIC 9(2) SOURCE CWW010-MM. 03 COLUMN 60 PIC X VALUE "/". 03 COLUMN 61 PIC 9(2) SOURCE CWW010-YY. 03 COLUMN 69 PIC X(4) VALUE "PAGE". 03 COLUMN 74 PIC ZZ9 SOURCE PAGE-COUNTER. 01 CONTROL-HEADING TYPE IS CONTROL HEADING CWW030-CONTROL. 02 LINE 3. 03 COLUMN 3 PIC X(18) SOURCE CWW020-HEADING-2(CWW030-RECTYPE). 03 COLUMN 24 PIC X(30) SOURCE CWW050-BU-NAME(CWW030-BU-NO). 03 COLUMN 55 PIC X(20) SOURCE CWW030-HEADING-3(CWW030-CTRL-AGENT). 02 LINE 4. 03 COLUMN 11 PIC X(20) VALUE "AMNESTY PERIOD SET -". 03 COLUMN 33 PIC 9(2) SOURCE CWW010-AMNESTY-ST-DD. 03 COLUMN 35 PIC X VALUE "/". 03 COLUMN 36 PIC 9(2) SOURCE CWW010-AMNESTY-ST-MM. 03 COLUMN 38 PIC X VALUE "/". 03 COLUMN 39 PIC 9(2) SOURCE CWW010-AMNESTY-ST-YY. 03 COLUMN 42 PIC X(5) VALUE "UNTIL". 03 COLUMN 48 PIC 9(2) SOURCE CWW010-AMNESTY-END-DD. 03 COLUMN 50 PIC X VALUE "/". 03 COLUMN 51 PIC 9(2) SOURCE CWW010-AMNESTY-END-MM. 03 COLUMN 53 PIC X VALUE "/". 03 COLUMN 54 PIC 9(2) SOURCE CWW010-AMNESTY-END-YY. 02 LINE 6. 03 COLUMN 16 PIC X(5) VALUE "DESP.". 03 COLUMN 25 PIC X(4) VALUE "RET.". 03 COLUMN 34 PIC X(3) VALUE "WKS". 03 LINE 7. 03 COLUMN 1 PIC X(7) VALUE "ACCOUNT". 03 COLUMN 16 PIC X(6) VALUE "WK.NO.". 03 COLUMN 25 PIC X(6) VALUE "WK.NO.". 03 COLUMN 34 PIC X(4) VALUE "LATE". 03 COLUMN 42 PIC X(6) VALUE "CAT.NO". 03 COLUMN 54 PIC X(5) VALUE "VALUE". 03 COLUMN 65 PIC X(6) VALUE "SELECT". 01 DETAIL-LINE TYPE IS DETAIL. 02 LINE PLUS 3. 03 COLUMN 1 PIC X(12) SOURCE ML403-CONTRACT-NUMBER. 03 COLUMN 16 PIC 9(2) SOURCE ML403-WEEK-PICKED. 03 COLUMN 25 PIC 9(2) SOURCE ML403-WEEK-NO. 03 COLUMN 34 PIC 9(2) SOURCE CWA010-WEEKS-LATE. 03 COLUMN 42 PIC X(5) SOURCE ML403-RTN-CAT-NO. 03 COLUMN 52 PIC ZZ,ZZ9.99 SOURCE ML403-OUTPUT-AMT. 03 COLUMN 66 PIC X(3) SOURCE CWA020-SELECT. 01 NO-DETAIL TYPE IS DETAIL. 02 LINE PLUS 3. 03 COLUMN 32 PIC X(15) VALUE "NO LATE RETURNS". *---------------------------------------------------------------- PROCEDURE DIVISION. AA-CONTROL SECTION. AA-010. PERFORM BA-INIT. PERFORM BB-MAIN. PERFORM BC-CLOSEDOWN. AA-999. STOP RUN RETURNING 0. *---------------------------------------------------------------- BA-INIT SECTION. BA-010. DISPLAY "ML404P V$Revision: 3.6 $ STARTS OK". INITIALIZE DWB900-FILE-CONTROL DWB910-INSERT-EXTRACT-FC DWB920-FILE-CONTROL-PARAMS DWW900-JOB-STATUS DWS900-FC-MOD-FLAG DWB800-FILE-CONTROL-COPIES. MOVE ZEROES TO CWA000-ACCUMULATORS. * read header OPEN INPUT ML403. READ ML403 AT END DISPLAY "****** ML404P ABORT CODE ZC ******" DISPLAY "****** NO RECORDS IN FILE *****" PERFORM ZC-COBOL-ABORT END-READ. IF NOT ML403-RECTYPE-HEADER-VALID DISPLAY "****** ML404P ABORT CODE ZC ******" DISPLAY "****** NO HEADER RECORD******" PERFORM ZC-COBOL-ABORT END-IF. IF NOT ML403-FILE-NAME-VALID DISPLAY "**** ML404P ABORT CODE ZC ****" DISPLAY "**** INCORRECT FILE RECEIVED" DISPLAY "**** EXPECTED FILENAME = MLS403" DISPLAY "**** ACTUAL FILENAME = " ML403-FILE-NAME PERFORM ZC-COBOL-ABORT END-IF. MOVE ML403-HEADER TO CWW010-HEADER. * Logon to SQL & perform week no checks EXEC SQL WHENEVER SQLERROR DO PERFORM ZB-SQL-ERROR END-EXEC. MOVE 3 TO ORASTXTF. MOVE "ML404P" TO DWB920-PROGRAM-NAME-ARR. MOVE 6 TO DWB920-PROGRAM-NAME-LEN. PERFORM ZA-LOGON. MOVE "MLS403" TO DWB920-FILE-NAME-ARR. MOVE 6 TO DWB920-FILE-NAME-LEN. MOVE 1 TO DWB920-RUN-NUMBER. PERFORM WA000-ADM-FC. MOVE DWB900-FILE-CONTROL TO DWB800-FILE-CONTROL(1). MOVE DWB920-FILE-CONTROL-PARAMS TO DWB820-FILE-CONTROL-PARAMS(1). MOVE DWS900-FC-MOD-FLAG TO DWS800-FC-MOD-FLAG(1). MOVE "MLP404" TO DWB920-FILE-NAME-ARR. MOVE 6 TO DWB920-FILE-NAME-LEN. MOVE 1 TO DWB920-RUN-NUMBER. PERFORM WA000-ADM-FC. MOVE DWB900-FILE-CONTROL TO DWB800-FILE-CONTROL(2). MOVE DWB920-FILE-CONTROL-PARAMS TO DWB820-FILE-CONTROL-PARAMS(2). MOVE DWS900-FC-MOD-FLAG TO DWS800-FC-MOD-FLAG(2). * Check that all Year, Week, Day returned from 7 calls to File * Control are the same IF DWB800-O-YEAR-WEEK-DAY(1) = DWB800-O-YEAR-WEEK-DAY(2) NEXT SENTENCE ELSE DISPLAY "*** ML404P ABORT CODE ZA ***" DISPLAY "*** ALL FILE CONTROL ENTRIES ARE NOT ***" DISPLAY "*** FOR THE SAME ACCOUNTING DATE ***" DISPLAY "*** FILENAME YEAR WEEK DAY ***" DISPLAY "*** -------- ---- ---- --- ***" DISPLAY "*** MLS403 " DWB800-O-CAL-YEAR(1) " " DWB800-O-CAL-WEEK-NUMBER(1) " " DWB800-O-CAL-DAY-NUMBER(1) " ***" DISPLAY "*** MLP404 " DWB800-O-CAL-YEAR(2) " " DWB800-O-CAL-WEEK-NUMBER(2) " " DWB800-O-CAL-DAY-NUMBER(2) " ***" PERFORM ZC-COBOL-ABORT END-IF. IF DWB900-O-CAL-DDMMYYYY <> CWW010-DATE-TODAY DISPLAY "*** ML404P ABORT CODE ZA ***" DISPLAY "*** FILE DATE DOES NOT MATCH FILE_CONTROL" " RUN DATE ***" DISPLAY "*** FILE DATE : " CWW010-DATE-TODAY " ***" DISPLAY "*** FILE CONTROL DATE : " DWB900-O-CAL-DDMMYYYY " ***" PERFORM ZC-COBOL-ABORT END-IF. * Selects the number of weeks in a year for each of the last 2 * years and moves them to working storage variables MOVE DWB900-O-CAL-YEAR TO DWB010-YEAR-NUMBER. PERFORM CA000-SEL-MAX-WEEK. MOVE DWB010-MAX-WEEK-NUMBER TO CWW040-WEEKS-PREV. PERFORM CA000-SEL-MAX-WEEK. MOVE DWB010-MAX-WEEK-NUMBER TO CWW040-WEEKS-PAST-PREV. PERFORM CB000-GET-BU-NAME. BA-999. EXIT. *---------------------------------------------------------------- BB-MAIN SECTION. OPEN OUTPUT CONTROL-REPORT. INITIATE CONTROL-STATS. READ ML403 AT END GO TO BB900-UNEXPECTED-EOF END-READ. MOVE 1 TO CWW030-RECTYPE CWW030-CTRL-AGENT. MOVE DWB030-MIN-VALID-BU-N0 TO CWW030-BU-NO. BB090-RECTYPE-CHECK. IF NOT ML403-RECTYPE-VALID AND NOT ML403-RECTYPE-TRAILER-VALID DISPLAY "*** ML404P ABORT CODE ZH ***" DISPLAY "*** INVALID RECORD TYPE " ML403-RECTYPE " FOUND ON MLS403 ***" PERFORM ZC-COBOL-ABORT END-IF. IF ML403-BU-NO <> 0 IF CWW050-BU-NAME(ML403-BU-NO) = SPACES AND NOT ML403-RECTYPE-TRAILER-VALID DISPLAY "*** ML404P ABORT CODE ZH ***" DISPLAY "*** INVALID BUSINESS UNIT NUMBER " ML403-BU-NO " FOUND ON MLS403 ***" PERFORM ZC-COBOL-ABORT END-IF END-IF. BB100-LOOP. IF CWW030-RECTYPE > 3 GO TO BB999-EXIT END-IF. IF (ML403-RECTYPE NOT = CWW030-RECTYPE OR ML403-BU-NO NOT = CWW030-BU-NO OR ML403-CTRL-AGENT NOT = CWW030-CTRL(CWW030-CTRL-AGENT)) OR ML403-RECTYPE-TRAILER-VALID PERFORM CC000-NOT-MATCH GO TO BB100-LOOP END-IF. * This IF below is to check to see if the page is full therefore * a new page will be automatically thrown, but it needs to be thrown * by a change of CONTROL HEADER in order for the full headers to be * printed out. The CONTROL HEADER needs to be defined seperately * from the PAGE HEADER so that a page can be thrown on change of * report, control agent and company. IF LINE-COUNTER > 51 ADD 1 TO CWW030-PAGE-CHANGE END-IF. IF ML403-LARGE-BAL-IND = "Y" AND ML403-DATE-NOT-LARGE-BAL = SPACES MOVE "YES" TO CWA020-SELECT ELSE MOVE SPACES TO CWA020-SELECT END-IF. * Calculate difference between WEEK PICKED and WEEK RETURNED SUBTRACT ML403-WEEK-PICKED FROM ML403-WEEK-NO GIVING CWA010-WEEKS-LATE. * If the week picked is greater than the week returned and * the week returned is less than or equal to the current week * number and the item was picked two years previously and * returned one year previously to the report being run. IF ML403-WEEK-PICKED > ML403-WEEK-NO AND ML403-WEEK-NO > DWB900-O-CAL-WEEK-NUMBER ADD CWW040-WEEKS-PAST-PREV TO CWA010-WEEKS-LATE END-IF. * If the week picked is greater than the week returned and * the week returned is greater than the current week number * then it was picked and returned in the year previous to the * report being run IF ML403-WEEK-PICKED > ML403-WEEK-NO AND ML403-WEEK-NO NOT > DWB900-O-CAL-WEEK-NUMBER ADD CWW040-WEEKS-PREV TO CWA010-WEEKS-LATE END-IF. ADD 1 TO CWA030-RECORD-COUNT CWA040-REPORT-COUNT(ML403-RECTYPE) CWA050-THIS-TIME DWB820-QTY1(2) DWB800-O-RECORDS-COMMITTED(2) DWB800-O-REC-CNT-LST-COMM(1) DWB800-O-REC-CNT-LST-COMM(2). GENERATE DETAIL-LINE. READ ML403 NOT AT END GO TO BB090-RECTYPE-CHECK END-READ. BB900-UNEXPECTED-EOF. DISPLAY "*** ML700U ABORT CODE ZD ***". DISPLAY "*** NO TRAILER RECORD EXISTS ***". PERFORM ZC-COBOL-ABORT. BB999-EXIT. EXIT. *---------------------------------------------------------------- BC-CLOSEDOWN SECTION. READ ML403 NOT AT END DISPLAY "****** ML404P ABORT CODE ZH****" DISPLAY "****** RECORDS PRESENT AFTER TRAILER**" PERFORM ZC-COBOL-ABORT END-READ. IF CWA030-RECORD-COUNT NOT = ML403-RECORD-COUNT DISPLAY "*** ML404P ABORT CODE ZD*****" DISPLAY "*** INVALID TRAILER FOUND ON MLS403 ***" DISPLAY "MLS403 COUNT = " ML403-RECORD-COUNT DISPLAY "CALCULATED COUNT = " CWA030-RECORD-COUNT PERFORM ZC-COBOL-ABORT END-IF. DISPLAY CWW020-HEADING-2(1) " TOTAL " CWA040-REPORT-COUNT(1). DISPLAY CWW020-HEADING-2(2) " TOTAL " CWA040-REPORT-COUNT(2). DISPLAY CWW020-HEADING-2(3) " TOTAL " CWA040-REPORT-COUNT(3). TERMINATE CONTROL-STATS. CLOSE CONTROL-REPORT ML403. MOVE 3 TO DWW900-JOB-STATUS. MOVE DWB800-FILE-CONTROL(1) TO DWB900-FILE-CONTROL. MOVE DWB820-FILE-CONTROL-PARAMS(1) TO DWB920-FILE-CONTROL-PARAMS. PERFORM XB-UPDATE-FC-COUNTS. MOVE DWS800-FC-MOD-FLAG(1) TO DWS900-FC-MOD-FLAG. PERFORM XA-UPDATE-FC-JOB-STATUS. MOVE DWB800-FILE-CONTROL(2) TO DWB900-FILE-CONTROL. MOVE DWB820-FILE-CONTROL-PARAMS(2) TO DWB920-FILE-CONTROL-PARAMS. PERFORM XB-UPDATE-FC-COUNTS. PERFORM XC-INSERT-EXT-FC. MOVE DWS800-FC-MOD-FLAG(2) TO DWS900-FC-MOD-FLAG. PERFORM XA-UPDATE-FC-JOB-STATUS. DISPLAY "ML404P V$Revision: 3.6 $ ENDS OK". BC-999. EXIT. *---------------------------------------------------------------- CA000-SEL-MAX-WEEK SECTION. SUBTRACT 1 FROM DWB010-YEAR-NUMBER. MOVE -1 TO DWB010-MAX-WEEK-NUMBER-IND. EXEC SQL EXECUTE BEGIN PACK_ACCOUNTING_DATE.PC_SEL_MAX_ACC_WEEK_BY_YEAR (:DWB010-YEAR-NUMBER, :DWB010-MAX-WEEK-NUMBER:DWB010-MAX-WEEK-NUMBER-IND); END; END-EXEC. IF DWB010-MAX-WEEK-NUMBER-IND = -1 DISPLAY "*** ML404P ABORT CODE ZT ***" DISPLAY "*** NO RECORD SELECTED FROM ***" DISPLAY "*** ACCOUNTING DATE ENTITY ***" DISPLAY "*** FOR YEAR " DWB010-YEAR-NUMBER " ***" PERFORM ZC-COBOL-ABORT END-IF. CA999-EXIT. EXIT. *---------------------------------------------------------------- CB000-GET-BU-NAME SECTION. MOVE "Company 8" TO CWW050-BU-NAME(8). MOVE ZERO TO DWB020-BU-NO. MOVE 99 TO DWB030-MIN-VALID-BU-N0. MOVE ZERO TO DWB030-MAX-VALID-BU-N0. CB010-LOOP. ADD 1 TO DWB020-BU-NO. IF DWB020-BU-NO = 8 IF DWB020-BU-NO > DWB030-MAX-VALID-BU-N0 MOVE DWB020-BU-NO TO DWB030-MAX-VALID-BU-N0 END-IF IF DWB020-BU-NO < DWB030-MIN-VALID-BU-N0 MOVE DWB020-BU-NO TO DWB030-MIN-VALID-BU-N0 END-IF ADD 1 TO DWB020-BU-NO END-IF. EXEC SQL EXECUTE DECLARE VL_BU_REF BUSINESS_UNIT.BUSINESS_UNIT_REFERENCE%TYPE; VL_BU_NAME BUSINESS_UNIT.BUSINESS_UNIT_NAME%TYPE; BEGIN :DWB020-BU-NAME := RPAD(' ',30,' '); PACK_MOD_SUSP_ACC.PC_SEL_BU_BY_BU_NUM (:DWB020-BU-NO ,Null ,NULL ,VL_BU_REF ,VL_BU_NAME ); IF VL_BU_NAME IS NOT NULL THEN :DWB020-BU-NAME := VL_BU_NAME; IF :DWB020-BU-NO > :DWB030-MAX-VALID-BU-N0 THEN :DWB030-MAX-VALID-BU-N0 := :DWB020-BU-NO; END IF; IF :DWB020-BU-NO < :DWB030-MIN-VALID-BU-N0 THEN :DWB030-MIN-VALID-BU-N0 := :DWB020-BU-NO; END IF; END IF; END; END-EXEC. MOVE DWB020-BU-NAME TO CWW050-BU-NAME(DWB020-BU-NO). IF DWB020-BU-NO < 99 GO TO CB010-LOOP END-IF. CB999-EXIT. EXIT. *---------------------------------------------------------------- CC000-NOT-MATCH SECTION. IF CWA050-THIS-TIME = ZERO GENERATE NO-DETAIL ADD 1 TO DWB800-O-RECORDS-COMMITTED(2) DWB820-QTY1(2) END-IF. IF CWW030-CTRL-AGENT = 1 MOVE 2 TO CWW030-CTRL-AGENT GO TO CC950-MOVE END-IF. MOVE 1 TO CWW030-CTRL-AGENT. *IF CWW030-BU-NO = 1 * MOVE 3 TO CWW030-BU-NO * GO TO CC950-MOVE *END-IF. IF CWW030-BU-NO NOT = DWB030-MAX-VALID-BU-N0 ADD 1 TO CWW030-BU-NO PERFORM UNTIL CWW050-BU-NAME(CWW030-BU-NO) NOT = SPACES ADD 1 TO CWW030-BU-NO END-PERFORM GO TO CC950-MOVE END-IF. MOVE DWB030-MIN-VALID-BU-N0 TO CWW030-BU-NO. ADD 1 TO CWW030-RECTYPE. MOVE ZERO TO PAGE-COUNTER. CC950-MOVE. MOVE ZERO TO CWA050-THIS-TIME. CC999-EXIT. EXIT. *---------------------------------------------------------------- CC100-GET-NEXT-VALID-BU-NO SECTION. CC100-ITR. IF CWW050-BU-NAME(CWW030-BU-NO) NOT = SPACES GO TO CC100-EXIT END-IF. ADD 1 TO CWW030-BU-NO. GO TO CC100-ITR. CC100-EXIT. EXIT. *---------------------------------------------------------------- WA000-ADM-FC SECTION. EXEC SQL INCLUDE PCADMFC END-EXEC. WA999-EXIT. EXIT. *---------------------------------------------------------------- * INCLUDE FILE CONTROL SECTIONS * AND Z SECTIONS. EXEC SQL INCLUDE PDFCTRL END-EXEC. EXEC SQL INCLUDE ZSECTION END-EXEC. *---------------------------------------------------------------- WA-000-DUMMY SECTION. WA-010-DUMMY. WA-999-EXIT. EXIT.