000100 //STUD035 JOB TSO-STUD,'NELSON' 000200 //STEP1 EXEC IGYWCG 000300 //COBOL.SYSIN DD * 000400 ID DIVISION. 000500 PROGRAM-ID. WMMCPGM1. 000600 AUTHOR. DAVID NELSON. 000601 DATE-WRITTEN. 02/20/2001. 000602 DATE-COMPILED. 000603 * 000610 ******************************************************* 000620 ** THIS PROGRAM SELECTS RECORDS FROM A RAW DATA FILE ** 000630 ** AND SELECTS ONLY THOSE RECORDS THAT CONTAIN A ** 000640 ** MORTGAGE AMOUNT OF $1,000,000 OR MORE. AN INPUT ** 000650 ** PROCEDURE /GIVING OPTION IS USED TO SORT THOSE ** 000660 ** RECORDS THAT ARE SELECTED IN ASCENDING ORDER. ** 000670 ******************************************************* 000680 * 000700 ENVIRONMENT DIVISION. 000800 INPUT-OUTPUT SECTION. 000900 FILE-CONTROL. 001000 SELECT IN-FILE ASSIGN TO INFILE. 001100 SELECT SORT-FILE ASSIGN TO SORTWK01. 001200 SELECT TEMP-FILE ASSIGN TO DISK. 001300 SELECT PRINT-FILE ASSIGN TO PRINTER. 001400 DATA DIVISION. 001500 FILE SECTION. 001600 FD IN-FILE BLOCK CONTAINS 0 RECORDS 001700 RECORD CONTAINS 80 CHARACTERS 001800 RECORDING MODE IS F. 001900 01 IN-REC. 002000 05 IN-LAST-NAME PIC X(20). 002100 05 IN-FIRST-NAME PIC X(10). 002200 05 IN-MORTGAGE-NUMBER PIC X(11). 002300 05 IN-MORTGAGE-AMOUNT PIC 9(08). 002400 05 IN-EMPL0YER PIC X(20). 002500 05 IN-SALARY PIC 9(07). 002600 05 IN-CREDIT-RATING PIC X(03). 002700 05 IN-USED PIC X(01). 002800 SD SORT-FILE RECORD CONTAINS 80 CHARACTERS. 002900 01 SORT-REC. 003000 05 FILLER PIC X(20). 003100 05 FILLER PIC X(10). 003200 05 SORT-MORTGAGE-NUMBER PIC X(11). 003300 05 FILLER PIC 9(08). 003400 05 FILLER PIC X(20). 003500 05 FILLER PIC 9(07). 003600 05 FILLER PIC X(03). 003700 05 FILLER PIC X(01). 003800 FD TEMP-FILE BLOCK CONTAINS 0 RECORDS 003900 RECORD CONTAINS 80 CHARACTERS 004000 RECORDING MODE IS F. 004100 01 TEMP-REC. 004200 05 TEMP-LAST-NAME PIC X(20). 004300 05 TEMP-FIRST-NAME PIC X(10). 004400 05 TEMP-MORTGAGE-NUMBER PIC X(11). 004500 05 TEMP-MORTGAGE-AMOUNT PIC 9(08). 004600 05 TEMP-EMPLOYER PIC X(20). 004700 05 TEMP-SALARY PIC 9(07). 004800 05 TEMP-CREDIT-RATING PIC X(03). 004900 05 TEMP-UNUSED PIC X(01). 005000 FD PRINT-FILE LABEL RECORDS ARE OMITTED 005200 RECORDING MODE IS F. 005210 01 PRINT-LINE PIC X(133). 006200 WORKING-STORAGE SECTION. 006300 01 SWITCHES. 006400 05 SW-IN-FILE-EOF PIC X(03) VALUE SPACES. 006500 01 COUNTERS. 006600 05 CTR-PAGE PIC S9 VALUE ZEROES. 006700 05 CTR-REC-READ PIC S9(08) VALUE ZEROES. 006800 05 CTR-REC-SELECT PIC S9(07) VALUE ZEROES. 006900 05 CTR-REC-NOT-SELECT PIC S9(07) VALUE ZEROES. 007000 05 CTR-REC-WRITTEN PIC S9(07) VALUE ZEROES. 007100 01 HEADING-0. 007200 05 FILLER PIC X(14) VALUE SPACES. 007300 05 FILLER PIC X(12) VALUE 'DAVID NELSON'. 007400 01 HEADING-1. 007500 05 FILLER PIC X(05) VALUE SPACES. 007600 05 FILLER PIC X(14) VALUE 'WEST MICHIGAN '. 007700 05 FILLER PIC X(17) VALUE 'MORTGAGE COMPANY '. 007710 05 FILLER PIC X(05) VALUE 'PAGE '. 007800 05 PAGE-NO PIC Z9. 007900 01 HEADING-2. 008000 05 FILLER PIC X(05) VALUE SPACES. 008100 05 FILLER PIC X(14) VALUE 'CONTROL REPORT'. 008200 05 FILLER PIC X(17) VALUE SPACES. 008300 05 FILLER PIC X(08) VALUE 'RUN DATE'. 008400 05 DATE-OUT. 008401 10 MONTH-OUT PIC Z9. 008402 10 FILLER PIC X VALUE '/'. 008403 10 DAY-OUT PIC Z9. 008404 10 FILLER PIC X VALUE '/'. 008410 10 YEAR-OUT PIC 9999. 009000 01 DETAIL-LINE-1. 009100 05 FILLER PIC X(18) VALUE 'NUMBER OF RECORDS '. 009110 05 FILLER PIC X(04) VALUE 'READ'. 009200 05 FILLER PIC X(13) VALUE SPACES. 009300 05 REC-READ-OUT PIC ZZ,ZZZ,ZZ9. 009400 01 DETAIL-LINE-2. 009500 05 FILLER PIC X(18) VALUE 'NUMBER OF RECORDS '. 009510 05 FILLER PIC X(08) VALUE 'SELECTED'. 009600 05 FILLER PIC X(10) VALUE SPACES. 009700 05 REC-SELECT-OUT PIC Z,ZZZ,ZZ9. 009800 01 DETAIL-LINE-3. 009900 05 FILLER PIC X(18) VALUE 'NUMBER OF RECORDS '. 009910 05 FILLER PIC X(12) VALUE 'NOT SELECTED'. 010000 05 FILLER PIC X(06) VALUE SPACES. 010100 05 REC-NOT-SELECT-OUT PIC Z,ZZZ,ZZ9. 010200 01 DETAIL-LINE-4. 010300 05 FILLER PIC X(18) VALUE 'NUMBER OF RECORDS '. 010400 05 FILLER PIC X(15) VALUE 'WRITTEN TO DISK'. 010500 05 FILLER PIC X(03) VALUE SPACES. 010600 05 REC-WRIT-DISK-OUT PIC Z,ZZZ,ZZ9. 010610 01 ERROR-LINE. 010620 05 FILLER PIC X(19) VALUE 'WARNING: NUMBER OF '. 010630 05 FILLER PIC X(15) VALUE 'RECORDS OUT OF '. 010640 05 FILLER PIC X(08) VALUE 'BALANCE!'. 010700 01 DATE-IN. 010701 05 YEAR-IN PIC 9999. 010710 05 MONTH-IN PIC Z9. 010800 05 DAY-IN PIC Z9. 010900 01 WORK-AREA. 011000 05 CHECK-SUM PIC S9(08). 011100 PROCEDURE DIVISION. 011110 ******************************************************* 011120 * THIS MODULE PERFORMS THE SORT INPUT PROCEDURE/GIVNG * 011130 * AND DRIVES THE PROGRAM. * 011150 ******************************************************* 011200 000-MAIN-DRIVER. 011300 DISPLAY "000-MAIN-DRIVER". 011400 SORT SORT-FILE 011500 ASCENDING KEY SORT-MORTGAGE-NUMBER 011600 INPUT PROCEDURE 100-IN-DRIVER 011700 GIVING TEMP-FILE. 011710 PERFORM 050-DATE-ROUTINE. 011900 PERFORM 999-EOJ. 011901 ******************************************************* 011902 * THIS MODULE HANDLES THE DATE FUNCTION * 011905 ******************************************************* 011910 050-DATE-ROUTINE. 011920 DISPLAY "050-DATE-ROUTINE". 011930 MOVE FUNCTION CURRENT-DATE TO DATE-IN. 011940 MOVE YEAR-IN TO YEAR-OUT. 011950 MOVE MONTH-IN TO MONTH-OUT. 011951 MOVE DAY-IN TO DAY-OUT. 011952 ******************************************************* 011953 * THIS MODULE DRIVES THE 100 SUB LEVEL MODULES. * 011956 ******************************************************* 012000 100-IN-DRIVER. 012100 DISPLAY "100-IN-DRIVER". 012200 PERFORM 110-IN-HOUSEKEEPER. 012300 PERFORM 120-IN-READ. 012400 PERFORM 130-IN-EDIT 012500 UNTIL SW-IN-FILE-EOF = "EOF". 012600 ******************************************************* 012610 * THIS MODULE OPENS THE INPUT AND OUTPUT FILES. * 012620 ******************************************************* 012700 110-IN-HOUSEKEEPER. 012800 DISPLAY "110-IN-HOUSEKEEPER". 012900 OPEN INPUT IN-FILE 012910 OUTPUT PRINT-FILE. 012920 ******************************************************* 012930 * THIS MODULE READS THE INPUT FILE AND INCREMENTS THE * 012931 * COUNTER FOR RECORDS READ. * 012940 ******************************************************* 013000 120-IN-READ. 013100 DISPLAY "120-IN-READ". 013200 READ IN-FILE 013300 AT END MOVE "EOF" TO SW-IN-FILE-EOF 013400 NOT AT END DISPLAY "IN-REC = " IN-REC 013410 ADD 1 TO CTR-REC-READ. 013420 ******************************************************* 013430 * THIS MODULE CHECKS TO SEE IF THE MORTAGAGE AMOUNT * 013440 * THE INPURT FILE IS GREATER THAN OR EQUAL TO 1 MILL * 013441 * AND IF IT IS THE COUNTER FOR RECORDS SELECTED IS * 013442 * INCREMENTED, BUT IF IT IS NOT THEN THE COUNTER FOR * 013443 * RECORDS NOT SELECTED IS INCREMENTED. * 013450 ******************************************************* 013500 130-IN-EDIT. 013600 DISPLAY "130-IN-EDIT". 013610 IF IN-MORTGAGE-AMOUNT >= 1000000 013620 ADD 1 TO CTR-REC-SELECT 013630 PERFORM 135-IN-RELEASE-TO-SORT 013640 ELSE ADD 1 TO CTR-REC-NOT-SELECT. 013650 PERFORM 120-IN-READ. 013660 ******************************************************* 013670 * THIS MODULE RELEASES THE SORT-REC AND INCREMENTS * 013700 * THE RECOREDS WRITTEN TO DISK. * 013900 ******************************************************* 014200 135-IN-RELEASE-TO-SORT. 014300 DISPLAY "135-IN-RELEASE-TO-SORT". 014400 DISPLAY "SORT-REC = " SORT-REC. 014410 MOVE IN-REC TO SORT-REC. 014500 RELEASE SORT-REC. 014510 ADD 1 TO CTR-REC-WRITTEN. 014520 ******************************************************* 014530 * THIS MODULE DRIVES THE MODULES TO PRODUCE THE REPORT* 014550 ******************************************************* 014900 200-PRODUCE-REPORT. 015000 DISPLAY "200-PRODUCE-REPORT". 015001 PERFORM 300-PRINT-HEADINGS. 015002 PERFORM 400-PRINT-DETAILS. 015003 PERFORM 500-PRINT-ERRORS. 015004 ******************************************************* 015005 * THIS MODULE PRINTS THE HEADINS ON THE REPORT * 015006 ******************************************************* 015050 300-PRINT-HEADINGS. 015060 DISPLAY "300-PRINT-HEADINGS". 015061 ADD 1 TO CTR-PAGE. 015062 MOVE CTR-PAGE TO PAGE-NO. 015070 MOVE HEADING-0 TO PRINT-LINE. 015080 WRITE PRINT-LINE AFTER ADVANCING PAGE. 015090 MOVE HEADING-1 TO PRINT-LINE. 015091 WRITE PRINT-LINE AFTER ADVANCING 2 LINES. 015092 MOVE HEADING-2 TO PRINT-LINE. 015093 WRITE PRINT-LINE AFTER ADVANCING 2 LINES. 015094 ******************************************************* 015095 * THIS MODULE PRINTS THE DETAILS ON THE REPORT * 015096 ******************************************************* 015097 400-PRINT-DETAILS. 015098 DISPLAY "400-PRINT-DETAILS". 015099 MOVE CTR-REC-READ TO REC-READ-OUT. 015100 MOVE CTR-REC-SELECT TO REC-SELECT-OUT. 015101 MOVE CTR-REC-NOT-SELECT TO REC-NOT-SELECT-OUT. 015102 MOVE CTR-REC-WRITTEN TO REC-WRIT-DISK-OUT. 015103 MOVE DETAIL-LINE-1 TO PRINT-LINE. 015104 WRITE PRINT-LINE AFTER ADVANCING 15 LINES. 015105 MOVE DETAIL-LINE-2 TO PRINT-LINE. 015106 WRITE PRINT-LINE AFTER ADVANCING 2 LINES. 015107 MOVE DETAIL-LINE-3 TO PRINT-LINE. 015108 WRITE PRINT-LINE AFTER ADVANCING 2 LINES. 015109 MOVE DETAIL-LINE-4 TO PRINT-LINE. 015110 WRITE PRINT-LINE AFTER ADVANCING 2 LINES. 015111 ******************************************************* 015112 * THIS MODULE PRINTS THE ERROR LINE ON THE REPORT * 015113 ******************************************************* 015114 500-PRINT-ERRORS. 015115 DISPLAY "500-PRINT-ERRORS". 015116 COMPUTE CHECK-SUM = CTR-REC-SELECT + CTR-REC-NOT-SELECT. 015117 IF CTR-REC-SELECT IS NOT EQUAL TO CTR-REC-WRITTEN 015118 MOVE ERROR-LINE TO PRINT-LINE 015119 WRITE PRINT-LINE AFTER ADVANCING 5 LINES. 015120 IF CHECK-SUM IS NOT EQUAL TO CTR-REC-READ 015121 MOVE ERROR-LINE TO PRINT-LINE 015122 WRITE PRINT-LINE AFTER ADVANCING 5 LINES. 015123 ******************************************************* 015124 * THIS MODULE PERFORMS THE END OF JOB ROUTINE WHICH * 015125 * CLOSES THE FILES. * 015126 ******************************************************* 015130 999-EOJ. 015200 DISPLAY "999-EOJ". 015210 PERFORM 200-PRODUCE-REPORT. 015220 CLOSE IN-FILE. 015230 CLOSE PRINT-FILE. 015300 GOBACK. 015400 //GO.SYSOUT DD SYSOUT=* 015500 //GO.INFILE DD DSN=FACL.ABAAMS1.ISYS340.WINT2001.RAW.DATA,DISP=SHR 015510 //GO.SORTWK01 DD UNIT=STUDENT,SPACE=(TRK,1) 015600 //GO.DISK DD DSN=&&DXN, 015700 // DISP=(NEW,PASS), 015800 // UNIT=STUDENT, 015900 // SPACE=(TRK,(1,1),RLSE), 016000 // DCB=(RECFM=FB,LRECL=80,BLKSIZE=800) 016100 //GO.PRINTER DD SYSOUT=* 016200 //STEP2 EXEC PGM=SELECT 016300 //SYSPRINT DD SYSOUT=* 016400 //SYSUT1 DD DSN=&&DXN,DISP=(OLD,PASS) 016500 //SYSUT2 DD SYSOUT=* 016510 //STEP3 EXEC PGM=IDCAMS 016520 //SYSPRINT DD SYSOUT=* 016530 //ABC DD DSN=STUD035.VSAM.FILE, 016540 // DISP=OLD, 016550 // UNIT=STUDENT, 016560 // VOL=SER=ACAD20 016570 //SYSIN DD * 016590 DELETE STUD035.VSAM.FILE- 016591 FILE(ABC)- 016592 CLUSTER 016593 /* 016594 //STEP4 EXEC PGM=IDCAMS 016595 //SYSPRINT DD SYSOUT=* 016596 //DD1 DD DSN=STUD035.VSAM.FILE, 016597 // DISP=OLD, 016598 // UNIT=STUDENT, 016599 // VOL=SER=ACAD20 016600 //SYSIN DD * 016601 016602 DEFINE CLUSTER (NAME(STUD035.VSAM.FILE)- 016603 VOLUME (ACAD20)- 016604 RECORDS (50,10)- 016605 RECORDSIZE (80,80)- 016606 FREESPACE (10,10)- 016607 INDEXED- 016608 KEYS(11,30)- 016609 FILE (DD1)) 016620 //STEP5 EXEC IGYWCG 016700 //COBOL.SYSIN DD * 016800 ID DIVISION. 016900 PROGRAM-ID. WMMCPGM2 017000 AUTHOR. DAVID NELSON. 017100 DATE-WRITTEN. 03/13/01. 017200 DATE-COMPILED. 017300 * 017400 ******************************************************* 017500 ** THIS PROGRAM SEARCHES A HARD CODED TABLE TO SEE ** 017600 ** IF AN APPLICANT IS QUALIFIED BASED ON THE CREDIT ** 017700 ** RATING RECEIVED FROM THE CREDIT BUREAU. ** 017800 ** MARCH 27, 2001 - MODIFIED TO INSERT DATA INTO THE ** 017810 ** EMPTY VSAM CLUSTER. ** 017900 ******************************************************* 018000 * 018100 ENVIRONMENT DIVISION. 018200 INPUT-OUTPUT SECTION. 018300 FILE-CONTROL. 018400 SELECT IN-TEMP ASSIGN TO INFILE. 018510 SELECT VSAM-MASTER-FILE ASSIGN TO VSAMOUT 018520 ORGANIZATION IS INDEXED 018530 ACCESS IS SEQUENTIAL 018540 RECORD KEY IS VSAM-REC-KEY 018550 FILE STATUS IS VSAM-FILE-STATUS. 018600 SELECT PRINT-REPORT ASSIGN TO PREPORT. 018700 SELECT PRINT-CONTROL ASSIGN TO PCONTROL. 018800 DATA DIVISION. 018900 FILE SECTION. 019000 FD IN-TEMP BLOCK CONTAINS 0 RECORDS 019100 RECORD CONTAINS 80 CHARACTERS 019200 RECORDING MODE IS F. 019300 01 IN-RECORD PIC X(80). 020210 FD VSAM-MASTER-FILE 020300 RECORD CONTAINS 80 CHARACTERS. 020400 01 VSAM-MASTER-RECORD. 020401 05 FILLER PIC X(30). 020410 05 VSAM-REC-KEY PIC X(11). 020420 05 FILLER PIC X(39). 021400 FD PRINT-REPORT LABEL RECORDS ARE OMITTED 021500 RECORDING MODE IS F. 021600 01 PRINT-LINE-1 PIC X(133). 021700 FD PRINT-CONTROL LABEL RECORDS ARE OMITTED 021800 RECORDING MODE IS F. 021900 01 PRINT-LINE-2 PIC X(133). 022000 WORKING-STORAGE SECTION. 022019 01 IN-REC. 022020 05 IN-LNAME PIC X(20). 022021 05 IN-FNAME PIC X(10). 022022 05 IN-MOR-NUM PIC X(11). 022023 05 IN-MOR-AMT PIC 9(08). 022024 05 IN-EMPLOY PIC X(20). 022025 05 IN-SAL PIC 9(07). 022026 05 IN-CRATING PIC X(03). 022040 05 IN-USE PIC X(01). 022095 01 FAKE-TABLE. 022096 05 FILLER PIC X(03) VALUE "888". 022097 05 FILLER PIC X(03) VALUE "999". 022098 05 FILLER PIC X(03) VALUE "AAA". 022099 01 CREDIT-RATING-TABLE REDEFINES FAKE-TABLE. 022100 05 CR-RATING OCCURS 3 TIMES 022101 INDEXED BY IND-RATE PIC X(03). 022110 01 HEADING-REPORT-0. 022200 05 FILLER PIC X(49) VALUE SPACES. 022300 05 FILLER PIC X(12) VALUE 'DAVID NELSON'. 022400 01 HEADING-REPORT-1. 022500 05 FILLER PIC X(40) VALUE SPACES. 022600 05 FILLER PIC X(14) VALUE 'WEST MICHIGAN '. 022700 05 FILLER PIC X(20) VALUE 'MORTGAGE CORPORATION'. 022800 05 FILLER PIC X(31) VALUE SPACES. 022900 05 FILLER PIC X(05) VALUE 'PAGE '. 023000 05 PAGE-NO PIC Z,ZZ9. 023100 01 HEADING-REPORT-2. 023200 05 FILLER PIC X(45) VALUE SPACES. 023300 05 FILLER PIC X(14) VALUE 'VSAM CREATION'. 023400 05 FILLER PIC X(06) VALUE 'REPORT'. 023500 05 FILLER PIC X(30) VALUE SPACES. 023600 05 FILLER PIC X(09) VALUE 'RUN DATE '. 023700 05 DATE-OUT. 023800 10 MONTH-OUT PIC Z9. 023900 10 FILLER PIC X VALUE '/'. 024000 10 DAY-OUT PIC Z9. 024100 10 FILLER PIC X VALUE '/'. 024200 10 YEAR-OUT PIC 9999. 024300 01 HEADING-REPORT-3. 024400 05 FILLER PIC X(04) VALUE 'LAST'. 024500 05 FILLER PIC X(18) VALUE SPACES. 024600 05 FILLER PIC X(05) VALUE 'FIRST'. 024610 05 FILLER PIC X(07) VALUE SPACES. 024700 05 FILLER PIC X(08) VALUE 'MORTGAGE'. 024710 05 FILLER PIC X(05) VALUE SPACES. 024720 05 FILLER PIC X(08) VALUE 'MORTGAGE'. 024730 05 FILLER PIC X(04) VALUE SPACES. 024800 05 FILLER PIC X(08) VALUE 'EMPLOYER'. 024810 05 FILLER PIC X(13) VALUE SPACES. 024900 05 FILLER PIC X(06) VALUE 'SALARY'. 024910 05 FILLER PIC X(06) VALUE SPACES. 025000 05 FILLER PIC X(06) VALUE 'CREDIT'. 025010 05 FILLER PIC X(02) VALUE SPACES. 025100 05 FILLER PIC X(07) VALUE 'MESSAGE'. 025200 01 HEADING-REPORT-4. 025300 05 FILLER PIC X(04) VALUE 'NAME'. 025400 05 FILLER PIC X(18) VALUE SPACES. 025500 05 FILLER PIC X(04) VALUE 'NAME'. 025600 05 FILLER PIC X(08) VALUE SPACES. 025700 05 FILLER PIC X(06) VALUE 'NUMBER'. 025800 05 FILLER PIC X(07) VALUE SPACES. 025900 05 FILLER PIC X(06) VALUE 'AMOUNT'. 026000 05 FILLER PIC X(39) VALUE SPACES. 026100 05 FILLER PIC X(06) VALUE 'RATING'. 026200 01 DETAIL-LINE-REPORT. 026300 05 DET-LNAME PIC X(20) VALUE SPACES. 026400 05 FILLER PIC X(02) VALUE SPACES. 026500 05 DET-FNAME PIC X(10) VALUE SPACES. 026600 05 FILLER PIC X(02) VALUE SPACES. 026700 05 DET-MOR-NUM PIC X(11) VALUE SPACES. 026800 05 FILLER PIC X(01) VALUE SPACE. 026900 05 DET-MOR-AMT PIC $ZZ,ZZZ,ZZ9. 027000 05 FILLER PIC X(02) VALUE SPACES. 027100 05 DET-EMPLOYER PIC X(20) VALUE SPACES. 027200 05 FILLER PIC X(01) VALUE SPACE. 027400 05 DET-SALARY PIC $Z,ZZZ,ZZZ. 027500 05 FILLER PIC X(02) VALUE SPACES. 027600 05 DET-CRATING PIC X(03) VALUE SPACES. 027700 05 FILLER PIC X(05) VALUE SPACES. 027800 05 DET-MESSAGE PIC X(26) VALUE SPACES. 027900 01 HEADING-CONTROL-0. 028000 05 FILLER PIC X(25) VALUE SPACES. 028100 05 FILLER PIC X(12) VALUE 'DAVID NELSON'. 028200 01 HEADING-CONTROL-1. 028300 05 FILLER PIC X(17) VALUE SPACES. 028400 05 FILLER PIC X(14) VALUE 'WEST MICHIGAN '. 028500 05 FILLER PIC X(20) VALUE 'MORTGAGE CORPORATION'. 028600 05 FILLER PIC X(20) VALUE SPACES. 028700 05 FILLER PIC X(05) VALUE 'PAGE '. 028800 05 PAGE-NO2 PIC Z,ZZ9. 028900 01 HEADING-CONTROL-2. 029000 05 FILLER PIC X(18) VALUE SPACES. 029100 05 FILLER PIC X(19) VALUE 'VSAM FILE CREATION '. 029200 05 FILLER PIC X(14) VALUE 'CONTROL REPORT'. 029300 05 FILLER PIC X(10) VALUE SPACES. 029400 05 FILLER PIC X(09) VALUE 'RUN DATE '. 029500 05 DATE-OUT-2. 029600 10 MONTH-OUT-2 PIC Z9. 029700 10 FILLER PIC X VALUE '/'. 029800 10 DAY-OUT-2 PIC Z9. 029900 10 FILLER PIC X VALUE '/'. 030000 10 YEAR-OUT-2 PIC 9999. 030100 01 DETAIL-LINE-CONTROL-1. 030200 05 FILLER PIC X(21) VALUE 'NUMBER OF SEQUENTIAL '. 030300 05 FILLER PIC X(12) VALUE 'RECORDS READ'. 030400 05 FILLER PIC X(02) VALUE SPACES. 030500 05 NUM-SQ-REC-READ-OUT PIC Z,ZZZ,ZZ9. 030600 01 DETAIL-LINE-CONTROL-2. 030700 05 FILLER PIC X(15) VALUE 'NUMBER OF VSAM '. 030800 05 FILLER PIC X(16) VALUE 'RECORDS WRITTEN '. 030900 05 FILLER PIC X(04) VALUE SPACES. 031000 05 NUM-VSAM-REC-WRIT-OUT PIC Z,ZZZ,ZZ9. 031100 01 ERROR-LINE-1. 031200 05 FILLER PIC X(17) VALUE '*** RECORDS READ '. 031300 05 FILLER PIC X(15) VALUE 'COUNT DOES NOT '. 031400 05 FILLER PIC X(17) VALUE 'EQUAL VALID PLUS '. 031500 05 FILLER PIC X(15) VALUE 'INVALID RECORD '. 031600 05 FILLER PIC X(10) VALUE 'COUNTS ***'. 031700 01 ERROR-LINE-2. 031800 05 FILLER PIC X(19) VALUE '*** RECORDS WRITTEN'. 031900 05 FILLER PIC X(19) VALUE ' TO DISK NOT EQUAL '. 032000 05 FILLER PIC X(16) VALUE 'TO VALID RECORD '. 032100 05 FILLER PIC X(09) VALUE 'COUNT ***'. 032900 01 COUNTERS. 033000 05 CTR-PAGE-NO PIC S9(04) VALUE ZEROES. 033100 05 CTR-PAGE-NO2 PIC S9(04) VALUE ZEROES. 033110 05 CTR-LINE PIC 9(03) VALUE ZEROES. 033200 05 CTR-NUM-READ PIC S9(07) VALUE ZEROES. 033300 05 CTR-NUM-VALID PIC S9(07) VALUE ZEROES. 033400 05 CTR-NUM-INVALID PIC S9(07) VALUE ZEROES. 033500 05 CTR-NUM-WRIT PIC S9(07) VALUE ZEROES. 033600 01 SWITCHES. 033700 05 SW-IN-FILE-EOF PIC X(03) VALUE SPACES. 033800 01 DATE-IN. 033900 05 YEAR-IN PIC 9999. 034000 05 MONTH-IN PIC Z9. 034100 05 DAY-IN PIC Z9. 034200 01 WORK-AREA. 034300 05 CHECK-SUM PIC S9(07) VALUE ZEROES. 034310 01 VSAM-FILE-STATUS PIC X(02) VALUE SPACES. 034400 PROCEDURE DIVISION. 034500 ******************************************************* 034600 * THIS MODULE DRIVES THE PROGRAM. * 034800 ******************************************************* 034900 000-MAIN-DRIVER. 035000 DISPLAY "000-MAIN-DRIVER". 035100 PERFORM 100-HOUSEKEEPER. 035101 PERFORM 150-DATE-ROUTINE. 035110 PERFORM 200-READ. 035120 PERFORM 300-SEARCH-TABLE 035130 UNTIL SW-IN-FILE-EOF = "EOF". 035300 PERFORM 999-EOJ. 035310 ******************************************************* 035320 * THIS MODULE OPENS THE INPUT AND OUTPUT FILES. * 035330 ******************************************************* 035400 100-HOUSEKEEPER. 035500 DISPLAY "100-HOUSEKEEPER". 036500 OPEN INPUT IN-TEMP. 036510 OPEN OUTPUT VSAM-MASTER-FILE. 036520 IF VSAM-FILE-STATUS IS EQUAL TO "00" 036530 THEN NEXT SENTENCE 036540 ELSE DISPLAY "BAD OPEN ON VSAM FILE" 036550 DISPLAY "FILE STATUS IS " VSAM-FILE-STATUS 036560 DISPLAY "PROGRAM TERMINATED" 036570 PERFORM 999-EOJ. 036600 OPEN OUTPUT PRINT-REPORT. 036700 OPEN OUTPUT PRINT-CONTROL. 036710 ******************************************************* 036720 * THIS MODULE HANDLES THE DATE FUNCTION AND MOVES THE * 036730 * CURRENT DATE IN. * 036740 ******************************************************* 036750 150-DATE-ROUTINE. 036760 DISPLAY "150-DATE-ROUTINE". 036770 MOVE FUNCTION CURRENT-DATE TO DATE-IN. 036780 MOVE YEAR-IN TO YEAR-OUT 036790 YEAR-OUT-2. 036791 MOVE MONTH-IN TO MONTH-OUT 036792 MONTH-OUT-2. 036793 MOVE DAY-IN TO DAY-OUT 036794 DAY-OUT-2. 036800 ******************************************************* 036900 * THIS MODULE READS THE INPUT FILE INTO ITS PLACE IN * 037000 * WORKING STORAGE AND ADDS 1 TO THE CTR-NUM-READ. * 037100 ******************************************************* 037200 200-READ. 037300 DISPLAY "200-READ". 037400 READ IN-TEMP 037500 INTO IN-REC 037600 AT END MOVE "EOF" TO SW-IN-FILE-EOF 037700 NOT AT END DISPLAY "IN-REC= " IN-REC. 037800 ******************************************************* 037900 * THIS MODULE SEARCHES THE TABLE AND REDIRECTS THE * 038000 * FLOW ACCORDING TO A HIT OR A NON HIT. * 038100 ******************************************************* 038200 300-SEARCH-TABLE. 038300 DISPLAY "300-SEARCH-TABLE". 038400 SET IND-RATE TO 1. 038500 SEARCH CR-RATING 038600 AT END PERFORM 400-NO-HIT 038700 WHEN CR-RATING (IND-RATE) 038800 IS EQUAL TO IN-CRATING 038900 PERFORM 450-HIT. 038901 PERFORM 525-PRINT-REPORT. 038920 ADD 1 TO CTR-NUM-READ. 039000 PERFORM 200-READ. 040400 ******************************************************* 040500 * THIS MODULE HANDLES A NO-HIT WHEN THE TABLE IS * 040600 * SEARCHED AND INCREMENTS THE COUNTER FOR INVALIDS. * 040700 ******************************************************* 040800 400-NO-HIT. 040900 DISPLAY "400-NO-HIT". 041000 ADD 1 TO CTR-NUM-INVALID. 041100 MOVE "CREDIT RATING NOT IN TABLE" TO DET-MESSAGE. 041300 ******************************************************* 041400 * THIS MODULE HANDLES A HIT WHEN THE TABLE IS SEARCHED* 041500 * AND INCREMENTS THE COUNTER FOR VALIDS. * 041600 ******************************************************* 041700 450-HIT. 041800 DISPLAY "450-HIT". 041900 ADD 1 TO CTR-NUM-VALID. 041910 MOVE " " TO DET-MESSAGE. 042000 PERFORM 700-WRITE-TO-DISK. 042800 ******************************************************* 042900 * THIS MODULE PRODUCES THE HIGH CREDIT RATING REPORT. * 043000 ******************************************************* 043100 500-PRODUCE-RATING-REPORT. 043200 DISPLAY "500-PRODUCE-RATING-REPORT". 043210 MOVE IN-LNAME TO DET-LNAME. 043220 MOVE IN-FNAME TO DET-FNAME. 043230 MOVE IN-MOR-NUM TO DET-MOR-NUM. 043240 MOVE IN-MOR-AMT TO DET-MOR-AMT. 043250 MOVE IN-EMPLOY TO DET-EMPLOYER. 043260 MOVE IN-SAL TO DET-SALARY. 043270 MOVE IN-CRATING TO DET-CRATING. 043410 ******************************************************* 043420 * THIS MODULE DETERMINES IF THE HEADINGS AND DETAIL * 043430 * LINE ONE SHOULD BE PRINTED OR JUST MORE DETAILS. * 043440 ******************************************************* 043450 525-PRINT-REPORT. 043460 DISPLAY "525-PRINT-REPORT". 043470 IF CTR-PAGE-NO IS EQUAL TO ZERO 043480 OR CTR-LINE IS GREATER THAN 50 043481 THEN PERFORM 500-PRODUCE-RATING-REPORT 043490 PERFORM 550-PRINT-REPORT-HEADINGS 043491 PERFORM 575-PRINT-REPORT-DETAILS 043492 ELSE PERFORM 500-PRODUCE-RATING-REPORT 043493 PERFORM 575-PRINT-REPORT-DETAILS. 043500 ******************************************************* 043600 * THIS MODULE PRINTS THE HEADINGS ON THE HIGH CREDIT * 043700 * RATING REPORT. * 043800 ******************************************************* 043900 550-PRINT-REPORT-HEADINGS. 044000 DISPLAY "550-PRINT-REPORT-HEADINGS". 044100 ADD 1 TO CTR-PAGE-NO. 044200 MOVE CTR-PAGE-NO TO PAGE-NO. 044210 MOVE ZEROES TO CTR-LINE. 044300 MOVE HEADING-REPORT-0 TO PRINT-LINE-1. 044400 WRITE PRINT-LINE-1 AFTER ADVANCING PAGE. 044410 ADD 1 TO CTR-LINE. 044500 MOVE HEADING-REPORT-1 TO PRINT-LINE-1. 044600 WRITE PRINT-LINE-1 AFTER ADVANCING 2 LINES. 044700 MOVE HEADING-REPORT-2 TO PRINT-LINE-1. 044800 WRITE PRINT-LINE-1 AFTER ADVANCING 2 LINES. 044900 MOVE HEADING-REPORT-3 TO PRINT-LINE-1. 045000 WRITE PRINT-LINE-1 AFTER ADVANCING 5 LINES. 045100 MOVE HEADING-REPORT-4 TO PRINT-LINE-1. 045200 WRITE PRINT-LINE-1 AFTER ADVANCING 1 LINE. 045300 ******************************************************* 045400 * THIS MODULE PRINTS THE DETAIL LINES FOR THE HIGH * 045500 * CREDIT RATING REPORT. * 045600 ******************************************************* 045700 575-PRINT-REPORT-DETAILS. 045800 DISPLAY "575-PRINT-REPORT-DETAILS". 045900 MOVE DETAIL-LINE-REPORT TO PRINT-LINE-1. 046000 WRITE PRINT-LINE-1 AFTER ADVANCING 2 LINES. 046100 ******************************************************* 046200 * THIS MODULE PRODUCES THE CONTROL REPORT. * 046300 ******************************************************* 046400 600-PRODUCE-CONTROL-REPORT. 046500 DISPLAY "600-PRODUCE-CONTROL-REPORT". 046600 PERFORM 625-PRINT-CONTROL-HEADINGS. 046700 PERFORM 650-PRINT-CONTROL-DETAILS. 046710 PERFORM 675-PRINT-CONTROL-ERRORS. 046800 ******************************************************* 046900 * THIS MODULE PRINTS THE HEADINGS FOR THE CONTROL * 047000 * REPORT. * 047100 ******************************************************* 047200 625-PRINT-CONTROL-HEADINGS. 047300 DISPLAY "625-PRINT-CONTROL-HEADINGS". 047400 ADD 1 TO CTR-PAGE-NO2. 047500 MOVE CTR-PAGE-NO2 TO PAGE-NO2. 047600 MOVE HEADING-CONTROL-0 TO PRINT-LINE-2. 047700 WRITE PRINT-LINE-2 AFTER ADVANCING PAGE. 047800 MOVE HEADING-CONTROL-1 TO PRINT-LINE-2. 047900 WRITE PRINT-LINE-2 AFTER ADVANCING 2 LINES. 048000 MOVE HEADING-CONTROL-2 TO PRINT-LINE-2. 048100 WRITE PRINT-LINE-2 AFTER ADVANCING 2 LINES. 048200 ******************************************************* 048300 * THIS MODULE PRINTS THE DETAIL LINES FOR THE CONTROL * 048400 * REPORT. * 048500 ******************************************************* 048600 650-PRINT-CONTROL-DETAILS. 048700 DISPLAY "650-PRINT-CONTROL-DETAILS". 048800 MOVE CTR-NUM-READ TO NUM-SQ-REC-READ-OUT. 048900 MOVE CTR-NUM-WRIT TO NUM-VSAM-REC-WRIT-OUT. 049000 MOVE DETAIL-LINE-CONTROL-1 TO PRINT-LINE-2. 049100 WRITE PRINT-LINE-2 AFTER ADVANCING 15 LINES. 049200 MOVE DETAIL-LINE-CONTROL-2 TO PRINT-LINE-2. 049300 WRITE PRINT-LINE-2 AFTER ADVANCING 2 LINES. 049400 ******************************************************* 049500 * THIS MODULE PRINTS THE ERROR MESSAGES ON THE CONTROL* 049600 * REPORT IF IN FACT THERE ARE ANY. * 049700 ******************************************************* 049800 675-PRINT-CONTROL-ERRORS. 049900 DISPLAY "675-PRINT-CONTROL-ERRORS". 050000 COMPUTE CHECK-SUM = CTR-NUM-VALID + CTR-NUM-INVALID. 050100 IF CHECK-SUM IS NOT EQUAL TO CTR-NUM-READ 050200 MOVE ERROR-LINE-1 TO PRINT-LINE-2 050300 WRITE PRINT-LINE-2 AFTER ADVANCING 5 LINES. 050400 IF CTR-NUM-VALID IS NOT EQUAL TO CTR-NUM-WRIT 050500 MOVE ERROR-LINE-2 TO PRINT-LINE-2 050600 WRITE PRINT-LINE-2 AFTER ADVANCING 5 LINES. 050610 ******************************************************* 050620 * THIS MODULE WRITES THE VALID RECORDS TO DISK. * 050630 ******************************************************* 050640 700-WRITE-TO-DISK. 050650 DISPLAY "700-WRITE-TO-DISK". 050660 ADD 1 TO CTR-NUM-WRIT. 050661 MOVE IN-REC TO VSAM-MASTER-RECORD. 050670 WRITE VSAM-MASTER-RECORD. 050691 IF VSAM-FILE-STATUS IS EQUAL TO "00" 050692 THEN NEXT SENTENCE 050693 ELSE DISPLAY "BAD WRITE TO VSAM FILE" 050694 DISPLAY "FILE STATUS IS " VSAM-FILE-STATUS 050695 DISPLAY "PROGRAM TERMINATED" 050696 PERFORM 999-EOJ. 050700 ******************************************************* 050800 * THIS IS THE END OF JOB MODULE AND HANDLES ALL OF THE* 050900 * END OF JOB ROUTINES SUCH AS PRINTING THE REPORTS AND* 051000 * CLOSING THE FILES. * 051100 ******************************************************* 051200 999-EOJ. 051300 DISPLAY "999-EOJ". 051400 PERFORM 600-PRODUCE-CONTROL-REPORT. 051500 CLOSE IN-TEMP. 051510 CLOSE VSAM-MASTER-FILE. 051520 IF VSAM-FILE-STATUS = "00" 051530 THEN NEXT SENTENCE 051540 ELSE DISPLAY "BAD CLOSE ON VSAM FILE" 051550 DISPLAY "FILE STATUS IS " VSAM-FILE-STATUS. 051600 CLOSE PRINT-REPORT. 051700 CLOSE PRINT-CONTROL. 051800 GOBACK. 051900 //GO.SYSOUT DD SYSOUT=* 052000 //GO.INFILE DD DSN=&&DXN,DISP=(OLD,DELETE) 052110 //GO.VSAMOUT DD DSN=STUD035.VSAM.FILE,DISP=OLD 052600 //GO.PREPORT DD SYSOUT=* 052700 //GO.PCONTROL DD SYSOUT=* 052800 //STEP6 EXEC PGM=IDCAMS 052900 //SYSPRINT DD SYSOUT=* 053000 //ABC DD DSN=STUD035.VSAM.FILE,DISP=OLD