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 MLS403 ORGANIZATION IS LINE SEQUENTIAL. SELECT CONTROL-REPORT ASSIGN TO MLP404 ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD ML403 RECORD IS VARYING FROM 9 TO 43 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". 02 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. MOVE 0 TO RETURN-CODE. STOP RUN. *---------------------------------------------------------------- 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 NOT = 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 NOT = 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.