New Topic/Question
Reply
I have been working at this program quite some time now and just can't get it to work. This program has to display 4 reports.
The validation screen consist of ZIP CODE, CUSTOMER NUMBER, PURCHASE PRICE, AUTO PURCHASED, PURCHASE DATE, AUTO YEAR, AND SATISFACTION RATING.
criteria:
ZIP CODE= Spaces or a fice charactor numeric entry greater than 10000 but lest than 96000 and to list all records with a zip code equal to the one entered.
CUSTOMER NUMBER= Spaces or a four charactor numeric entry. list all records with customer numbers greater than or equal to the number entered.
PURCHASE DATE= Spaces or an eight charactor numeric date in the form of MMDDYYYY the month MM should be a value in the range of 1 to 12. the DD should be a value in the range of 1 to 31, the year YYYY should be greater than 1998. Process all records with a purchase date greater than or equal to the entered date.
AUTO PURCHASE= No validation.
PURCHASE PRICE= Spaces or a seven charactor numeric entry in the form of PIC 9(5)v99. List records with purchase prices greater than or equal to the amount entered.
AUTO YEAR= Spaces or a four digit entry in the rang of 1900 to current year. List records with auto years greater than or equal to the entered year.
SATISFACTION RATING= spaces or a 0, 1, 2. List records having the entered satisfaction rating.
REPORTS:
Report1 test for:
zip code-46410
Purchase price-3000.00
Satisfaction rating-2
Report2 test for:
Auto Make- FORD
Auto Year of-1990
Report3 test for:
Customer number-3050
Purchase date-09012000
Satisfaction rating-1
Report4 test for:
Purchase date-08292000
Auto make of-Chevrolet
Purchase price-2000.00
Satisfaction rating-0
INPUT-OUTPUT SECTION. 00033000
********************** 00034000
00035000
FILE-CONTROL. 00036000
00037000
SELECT CUSTOMER-SALES-FILE 00038000
ASSIGN TO "C:\COBOLDATA\CUSTSALE.DAT" 00039000
ORGANIZATION IS LINE SEQUENTIAL. 00040000
00041000
SELECT REPORT-FILE 00042000
ASSIGN TO "C:\COBOLDATA\EX6-3.RPT". 00043000
00044000
SELECT SORT-FILE 00045000
ASSIGN TO "SORTWORK". 00046000
00047000
/ 00048000
DATA DIVISION. 00049000
*************** 00050000
00051000
FILE SECTION. 00052000
************** 00053000
00054000
******************************************************************00055000
* *00056000
* INPUT-FILE - CUSTOMER SALES *00057000
* *00058000
******************************************************************00059000
00060000
FD CUSTOMER-SALES-FILE. 00061000
00062000
01 INPUT-RECORD PIC X(130). 00063000
00064000
******************************************************************00065000
* *00066000
* REPORT-FILE *00067000
* *00068000
******************************************************************00069000
00070000
FD REPORT-FILE. 00071000
00072000
01 REPORT-LINE-OUT PIC X(90). 00073000
00074000
******************************************************************00075000
* *00076000
* SORT-FILE - SORT KEY IS PURCHASE PRICE *00077000
* *00078000
******************************************************************00079000
00080000
SD SORT-FILE. 00081000
00082000
01 SORT-RECORD. 00083000
02 PIC X(61). 00084000
02 SR-PURCHASE-PRICE PIC X(7). 00085000
02 PIC X(8). 00086000
00087000
/ 00088000
00089000
WORKING-STORAGE SECTION. 00090000
************************ 00091000
00092000
00093000
******************************************************************00094000
* *00095000
* SWITCHES *00096000
* *00097000
******************************************************************00098000
00099000
01 SWITCHES. 00100000
00101000
02 SW-VALID-ENTRY PIC X. 00102000
88 VALID-ENTRY VALUE "Y". 00103000
00104000
02 SW-END-OF-FILE PIC X. 00105000
88 END-OF-FILE VALUE "Y". 00106000
00107000
02 SW-RELEASE-RECORD PIC X. 00108000
88 RELEASE-RECORD VALUE "Y". 00109000
00110000
******************************************************************00111000
* *00112000
* ACCUMULATORS *00113000
* *00114000
******************************************************************00115000
00116000
01 ACCUMULATORS. 00117000
00118000
02 AC-LINE-COUNT PIC 999. 00119000
02 AC-PAGE-COUNT PIC 999. 00120000
02 AC-RECORD-COUNT PIC 9(5). 00121000
02 AC-XLINE-COUNT PIC 999. 00122000
02 AC-XPAGE-COUNT PIC 999. 00123000
00124000
/ 00125000
******************************************************************00126000
* *00127000
* WORK AREA FIELDS *00128000
* *00129000
******************************************************************00130000
00131000
01 WORK-AREA. 00132000
00133000
02 WA-TODAYS-DATE-TIME. 00134000
03 WA-TODAYS-DATE. 00135000
04 WA-TODAYS-YEAR PIC 9(4). 00136000
04 WA-TODAYS-MONTH PIC 99. 00137000
04 WA-TODAYS-DAY PIC 99. 00138000
03 WA-TODAYS-TIME. 00139000
04 WA-TODAYS-HOUR PIC 99. 00140000
04 WA-TODAYS-MINUTES PIC 99. 00141000
03 PIC X(9). 00142000
00143000
02 WA-DATE. 00144000
03 WA-MONTH PIC 99. 00145000
03 WA-DAY PIC 99. 00146000
03 WA-YEAR PIC 9(4). 00147000
00148000
02 WA-RUN-DATE REDEFINES 00149000
WA-DATE PIC 9(8). 00150000
02 WA-AM-PM PIC XX. 00151000
02 WA-SCREEN-HOLD PIC X. 00152000
00153000
02 WA-CRITERIA-DATA. 00154000
03 WA-SATISFACTION-RATING PIC X. 00155000
03 WA-ZIP-CODE-ALPHA PIC X(5). 00156000
03 WA-ZIP-CODE REDEFINES 00157000
WA-ZIP-CODE-ALPHA PIC 9(5). 00158000
03 WA-CUSTOMER-NUMBER PIC X(4). 00159000
03 WA-PURCHASE-DATE PIC X(8). 00160000
03 WA-AUTO-PURCHASED PIC X(20). 00161000
03 WA-PURCHASE-PRICE-ALPHA PIC X(5). 00162000
03 WA-PURCHASE-PRICE REDEFINES 00163000
WA-PURCHASE-PRICE-ALPHA PIC 9(5). 00164000
03 WA-AUTO-YEAR PIC X(4). 00165000
00166000
02 WA-CRITERIA PIC X(12). 00167000
02 WA-CRIT-TYPE PIC X(20). 00168000
02 WA-CRIT-MESSAGE PIC X(19). 00169000
02 WA-MESSAGE-1 PIC X(60). 00170000
02 WA-MESSAGE-2 PIC X(60). 00171000
02 WA-HYPHENS PIC X(20) VALUE ALL "-". 00172000
00173000
******************************************************************00174000
* CUSTOMER SALES LAYOUT FOR THE INPUT CUSTOMER FILE *00175000
* *00176000
* CHARACTERISTICS: LAYOUT FOR FILE INVEN.DAT *00177000
* FILE ORGANIZATION - SEQUENTIAL *00178000
* RECORD LENGTH - 130 BYTES *00179000
* *00180000
* DATE FORMAT - YYYYMMDD *00181000
******************************************************************00182000
00183000
01 CUSTOMER-RECORD. 00184000
00185000
02 CR-ZIP-CODE PIC X(5). 00186000
02 PIC X(4). 00187000
02 CR-CUSTOMER-NUMBER PIC X(4). 00188000
02 CR-CUSTOMER-NAME PIC X(20). 00189000
02 CR-PURCHASE-DATE PIC 99/99/9999. 00190000
02 CR-PURCHASE-DATE-ALPHA REDEFINES 00191000
CR-PURCHASE-DATE PIC X(8). 00192000
02 CR-AUTO-MAKE PIC X(20). 00193000
02 CR-PURCHASE-PRICE PIC 9(5)V99. 00194000
02 CR-PURCHASE-PRICE-ALPHA REDEFINES 00195000
CR-PURCHASE-PRICE PIC X(7). 00196000
02 CR-AUTO-YEAR PIC 9(4). 00197000
02 CR-AUTO-YEAR-ALPHA REDEFINES 00198000
CR-AUTO-YEAR PIC X(4). 00199000
02 PIC X(3). 00200000
02 CR-SATISFACTION-RATING PIC X. 00201000
88 DISSATISFIED VALUE "0". 00202000
88 UNDECIDED VALUE "1". 00203000
88 SATISFIED VALUE "2". 00204000
00205000
******************************************************************00206000
* *00207000
* EX 6-3 REPORT HEADING LINES *00208000
* *00209000
******************************************************************00210000
00211000
01 REPORT-HEADINGS. 00212000
00213000
02 RH-LINE-1. 00214000
03 PIC X(6) VALUE "DATE: ". 00215000
03 RH-DATE PIC Z9/99/9999. 00216000
03 PIC X(21) VALUE SPACES. 00217000
03 PIC X(13) VALUE 00218000
"EZ AUTO SALES". 00219000
03 PIC X(22) VALUE SPACES. 00220000
03 PIC X(5) VALUE "PAGE ". 00221000
03 RH-PAGE PIC ZZ9. 00222000
00223000
02 RH-LINE-2. 00224000
03 PIC X(6) VALUE "TIME: ". 00225000
03 RH-HOUR PIC Z9. 00226000
03 PIC X VALUE ":". 00227000
03 RH-MINUTES PIC 99. 00228000
03 RH-AM-PM PIC XX. 00229000
03 PIC X(15) VALUE SPACES. 00230000
03 PIC X(31) VALUE 00231000
"CUSTOMER SALES SELECTION REPORT". 00232000
00233000
02 RH-LINE-2A. 00234000
03 PIC X(12) VALUE 00235000
"name". 00236000
00237000
02 RH-LINE-3. 00238000
03 RH-CRITERIA-MSG PIC X(19). 00239000
03 PIC X(3) VALUE SPACES. 00240000
03 RH-CRITERIA-TYPE PIC X(19). 00241000
03 PIC X. 00242000
03 RH-CRITERIA PIC X(12). 00243000
00244000
02 RH-LINE-4. 00245000
03 PIC X(27) VALUE SPACES. 00246000
03 PIC X(3) VALUE "ZIP". 00247000
03 PIC X(3) VALUE SPACES. 00248000
03 PIC X(8) VALUE 00249000
"PURCHASE". 00250000
03 PIC X(24) VALUE SPACES. 00251000
03 PIC X(8) VALUE 00252000
"PURCHASE". 00253000
00254000
02 RH-LINE-5. 00255000
03 PIC X(3) VALUE "NUM". 00256000
03 PIC X(3) VALUE SPACES. 00257000
03 PIC X(4) VALUE "NAME". 00258000
03 PIC X(17) VALUE SPACES. 00259000
03 PIC X(4) VALUE "CODE". 00260000
03 PIC XX VALUE SPACES. 00261000
03 PIC X(4) VALUE "DATE". 00262000
03 PIC X(8) VALUE SPACES. 00263000
03 PIC X(9) VALUE 00264000
"AUTO MAKE". 00265000
03 PIC X(11) VALUE SPACES. 00266000
03 PIC X(5) VALUE "PRICE". 00267000
03 PIC X(6) VALUE SPACES. 00268000
03 PIC X(4) VALUE "SAT.". 00269000
00270000
02 RH-LINE-6. 00271000
03 PIC X(4) VALUE ALL "-". 00272000
03 PIC X(2) VALUE SPACES. 00273000
03 PIC X(20) VALUE ALL "-". 00274000
03 PIC X VALUE SPACES. 00275000
03 PIC X(5) VALUE ALL "-". 00276000
03 PIC X VALUE SPACES. 00277000
03 PIC X(10) VALUE ALL "-". 00278000
03 PIC X VALUE SPACES. 00279000
03 PIC X(20) VALUE ALL "-". 00280000
03 PIC X VALUE SPACES. 00281000
03 PIC X(10) VALUE ALL "-". 00282000
03 PIC X VALUE SPACES. 00283000
03 PIC X(4) VALUE ALL "-". 00284000
00285000
******************************************************************00286000
* *00287000
* EX 6-1 DETAIL LINES *00288000
* *00289000
******************************************************************00290000
01 REPORT-DETAIL-LINE.
02 RDL-CUSTOMER-NUMBER PIC X(4).
02 PIC X(2) VALUE SPACES.
02 RDL-CUSTOMER-NAME PIC X(20).
02 PIC X VALUE SPACES.
02 RDL-ZIP-CODE PIC 9(5).
02 PIC X VALUE SPACES.
02 RDL-PURCHASE-DATE PIC Z9/99/9999.
02 PIC X VALUE SPACES.
02 RDL-AUTO-MAKE PIC X(20).
02 PIC X VALUE SPACES.
02 RDL-PURCHASE-PRICE PIC $$$,$$$.99.
02 PIC XX VALUE SPACES.
02 RDL-SATISFACTION-RATING PIC X.
00307000
******************************************************************00308000
* *00309000
* EX 6-1 SUMMARY LINES *00310000
* *00311000
******************************************************************00312000
00313000
01 REPORT-SUMMARY-LINES. 00314000
00315000
02 RSL-LINE-1. 00316000
03 PIC X(27) VALUE SPACES. 00317000
03 PIC X(24) VALUE 00318000
"TOTAL CUSTOMERS LISTED =". 00319000
03 PIC X(8) VALUE SPACES. 00320000
03 RSL-TOT-CUST-LISTED PIC ZZ9. 00321000
00322000
02 RSL-LINE-2. 00323000
03 PIC X(27) VALUE SPACES. 00324000
03 PIC X(25) VALUE 00325000
"TOTAL PURCHASES = ". 00326000
03 RSL-TOTAL-PURCHASES PIC ZZZ,ZZ9.99. 00327000
00328000
02 RSL-LINE-3. 00329000
03 PIC X(39) VALUE SPACES. 00330000
03 PIC X(13) VALUE 00331000
"END OF REPORT". 00332000
00333000
SCREEN SECTION. 00334000
*************** 00335000
******************************************************************00336000
* *00337000
* INITIAL SCREEN FOR THE INVENTORY SELECTION CRITERIA *00338000
* *00339000
******************************************************************00340000
00341000
01 SELECTION-CRITERIA-SCREEN. 00342000
02 BLANK SCREEN. 00343000
02 LINE 1 COLUMN 30 VALUE 00344000
"CUSTOMER RECORD SELECTION". 00345000
02 LINE 2 COLUMN 32 VALUE "CRITERIA INPUT SCREEN". 00346000
02 LINE 4 COLUMN 6 VALUE "ZIP CODE:". 00347000
02 COLUMN 27 VALUE "00000". 00348000
02 LINE 6 COLUMN 6 VALUE "CUSTOMER NUMBER:". 00349000
02 COLUMN 27 VALUE "0000". 00350000
02 LINE 8 COLUMN 6 VALUE "PURCHASE DATE:". 00351000
02 COLUMN 27 VALUE "00000000". 00352000
02 LINE 10 COLUMN 6 VALUE "AUTO PURCHASED:". 00353000
02 COLUMN 27 VALUE "_". 00354000
02 LINE 12 COLUMN 6 VALUE "PURCHASE PRICE:". 00355000
02 COLUMN 27 VALUE "00000". 00356000
02 LINE 14 COLUMN 6 VALUE "AUTO YEAR:". 00357000
02 COLUMN 27 VALUE "0000". 00358000
02 LINE 16 COLUMN 6 VALUE "SATISFACTION RATING:". 00359000
02 COLUMN 27 VALUE "_". 00360000
00361000
01 SELECTION-MESSAGE. 00362000
00363000
02 LINE 17 COLUMN 10 PIC X(60) FROM WA-MESSAGE-1. 00364000
02 LINE 18 COLUMN 10 PIC X(60) FROM WA-MESSAGE-2. 00365000
00366000
******************************************************************00367000
* *00368000
* REPORT HEADINGS FOR THE INVENTORY SELECTION REPORTS *00369000
* *00370000
******************************************************************00371000
00372000
01 HEADING-LINE. 00373000
00374000
02 BLANK SCREEN. 00375000
02 LINE 1 COLUMN 1 VALUE "DATE". 00376000
02 COLUMN 6 PIC Z9/99/9999 FROM 00377000
WA-RUN-DATE. 00378000
02 COLUMN 38 VALUE 00379000
"EZ AUTO SALES". 00380000
02 COLUMN 73 VALUE "PAGE ". 00381000
02 COLUMN 78 PIC ZZ9 FROM AC-PAGE-COUNT. 00382000
02 LINE 2 COLUMN 1 VALUE "TIME: ". 00383000
02 COLUMN 7 PIC Z9 FROM WA-TODAYS-HOUR. 00384000
02 COLUMN 9 VALUE ":". 00385000
02 COLUMN 10 PIC XX FROM WA-TODAYS-MINUTES. 00386000
02 COLUMN 13 PIC XX FROM WA-AM-PM. 00387000
02 LINE 3 COLUMN 1 VALUE "name". 00388000
00389000
01 CRITERIA-LINE. 00390000
02 LINE AC-LINE-COUNT. 00391000
02 COLUMN 1 PIC X(19) FROM WA-CRIT-MESSAGE. 00392000
02 COLUMN 23 PIC X(19) FROM WA-CRIT-TYPE. 00393000
02 COLUMN 43 PIC X(12) FROM WA-CRITERIA. 00394000
00395000
01 COLUMN-HEADING-1. 00396000
02 LINE AC-LINE-COUNT. 00397000
02 COLUMN 26 VALUE "ZIP". 00398000
02 COLUMN 32 VALUE "PURCHASE". 00399000
02 COLUMN 64 VALUE "PURCHASE". 00400000
00401000
01 COLUMN-HEADING-2. 00402000
02 LINE AC-LINE-COUNT. 00403000
02 COLUMN 1 VALUE "NUM". 00404000
02 COLUMN 6 VALUE "NAME". 00405000
02 COLUMN 26 VALUE "CODE". 00406000
02 COLUMN 32 VALUE "DATE". 00407000
02 COLUMN 44 VALUE "AUTO MAKE". 00408000
02 COLUMN 64 VALUE "PRICE". 00409000
02 COLUMN 75 VALUE "SAT.". 00410000
00411000
01 COLUMN-HEADING-3. 00412000
02 LINE AC-LINE-COUNT. 00413000
02 COLUMN 1 PIC X(4) FROM WA-HYPHENS. 00414000
02 COLUMN 6 PIC X(17) FROM WA-HYPHENS. 00415000
02 COLUMN 26 PIC X(4) FROM WA-HYPHENS. 00416000
02 COLUMN 32 PIC X(10) FROM WA-HYPHENS. 00417000
02 COLUMN 43 PIC X(20) FROM WA-HYPHENS. 00418000
02 COLUMN 64 PIC X(10) FROM WA-HYPHENS. 00419000
02 COLUMN 75 PIC X(4) FROM WA-HYPHENS. 00420000
00421000
/ 00422000
******************************************************************00423000
* *00424000
* DETAIL LINE FOR THE CUSTOMER SELECTION REPORT *00425000
* *00426000
******************************************************************00427000
00428000
01 DETAIL-LINE.
02 LINE AC-LINE-COUNT.
02 COLUMN 1 PIC X(4) FROM CR-CUSTOMER-NUMBER.
02 COLUMN 7 PIC X(20) FROM CR-CUSTOMER-NAME.
02 COLUMN 28 PIC 9(5) FROM CR-ZIP-CODE.
02 COLUMN 34 PIC Z9/99/9999 FROM CR-PURCHASE-DATE.
02 COLUMN 45 PIC X(20) FROM CR-AUTO-MAKE.
02 COLUMN 66 PIC $$$,$$$.99 FROM CR-PURCHASE-PRICE.
02 COLUMN 78 PIC X FROM CR-SATISFACTION-RATING.
/ 00439000
******************************************************************00440000
* *00441000
* SUMMARY LINES FOR THE CUSTOMER SELECTION REPORT *00442000
* *00443000
******************************************************************00444000
00445000
01 SUMMARY-LINES. 00446000
00447000
02 SL-LINE-1. 00448000
03 LINE AC-LINE-COUNT. 00449000
03 COLUMN 28 VALUE "TOTAL CUSTOMERS LISTED = ". 00450000
03 COLUMN 59 PIC ZZ9 FROM RSL-TOT-CUST-LISTED. 00451000
00452000
02 SL-LINE-2. 00453000
03 LINE AC-LINE-COUNT. 00454000
03 COLUMN 28 VALUE "TOTAL PURCHASES = ". 00455000
03 COLUMN 59 PIC ZZZ,ZZ9.99 FROM 00456000
RSL-TOTAL-PURCHASES. 00457000
00458000
02 SL-LINE-3. 00459000
03 LINE AC-LINE-COUNT. 00460000
03 COLUMN 30 VALUE "END OF REPORT". 00461000
00462000
PROCEDURE DIVISION. 00463000
******************* 00464000
******************************************************************00465000
* *00466000
* MAIN-PROGRAM. THIS IS THE MAIN PARAGRAPH OF PROGRAM *00467000
* *00468000
******************************************************************00469000
00470000
MAIN-PROGRAM. 00471000
00472000
PERFORM A-100-INITIALIZATION. 00473000
PERFORM B-100-SELECTION-REPORT. 00474000
PERFORM C-100-WRAP-UP. 00475000
STOP RUN. 00476000
00477000
******************************************************************00478000
* *00479000
* HOUSEKEEPING PARAGRAPH FOLLOWS *00480000
* *00481000
******************************************************************00482000
00483000
A-100-INITIALIZATION. 00484000
00485000
INITIALIZE ACCUMULATORS. 00486000
MOVE FUNCTION CURRENT-DATE TO WA-TODAYS-DATE-TIME. 00487000
/ 00488000
******************************************************************00489000
* *00490000
* ACCEPT CRITERIA, SELECT RECORDS, SORT AND DISPLAY REPORT*00491000
* *00492000
******************************************************************00493000
00494000
B-100-SELECTION-REPORT. 00495000
00496000
PERFORM B-200-CRITERIA-CONTROL. 00497000
00498000
SORT SORT-FILE 00499000
ON DESCENDING KEY SR-PURCHASE-PRICE 00500000
INPUT PROCEDURE B-210-SELECT-RECORDS 00501000
OUTPUT PROCEDURE B-220-DISPLAY-REPORT. 00502000
00503000
/ 00504000
******************************************************************00505000
* *00506000
* CRITERIA CONTROL PARAGRAPH *00507000
* *00508000
******************************************************************00509000
00510000
B-200-CRITERIA-CONTROL. 00511000
00512000
DISPLAY SELECTION-CRITERIA-SCREEN. 00513000
MOVE "N" TO SW-VALID-ENTRY. 00514000
MOVE "Please Enter Zip Code. Five Numbers Only!" 00515000
TO WA-MESSAGE-1. 00516000
MOVE "Just press enter to skip!" TO WA-MESSAGE-2. 00517000
PERFORM B-300-ZIP-CODE-CRITERIA 00518000
UNTIL VALID-ENTRY. 00519000
00520000
MOVE "N" TO SW-VALID-ENTRY. 00521000
MOVE "Enter Customer Number! 4 Digits with Leading Zeros!" 00522000
TO WA-MESSAGE-1. 00523000
PERFORM B-305-CUSTOMER-NUMBER-CRITERIA UNTIL VALID-ENTRY. 00524000
00525000
MOVE "N" TO SW-VALID-ENTRY. 00526000
MOVE "Please enter Purchase Date. Form: MMDDYYYY!" 00527000
TO WA-MESSAGE-1. 00528000
PERFORM B-310-PURCHASE-DATE-CRITERIA UNTIL VALID-ENTRY. 00529000
00530000
MOVE "N" TO SW-VALID-ENTRY. 00531000
MOVE "Enter Make of Auto Purchased!" 00532000
TO WA-MESSAGE-1. 00533000
PERFORM B-315-AUTO-PURCHASED-CRITERIA UNTIL VALID-ENTRY. 00534000
00535000
MOVE "N" TO SW-VALID-ENTRY. 00536000
MOVE "Enter Purch Price! 5 digits w/leading zeros, 2 decimal"00537000
TO WA-MESSAGE-1. 00538000
PERFORM B-320-PURCHASE-PRICE-CRITERIA UNTIL VALID-ENTRY. 00539000
00540000
MOVE "N" TO SW-VALID-ENTRY. 00541000
MOVE "Enter Auto Year - 4 digits!" 00542000
TO WA-MESSAGE-1. 00543000
PERFORM B-322-AUTO-YEAR-CRITERIA UNTIL VALID-ENTRY. 00544000
00545000
MOVE "N" TO SW-VALID-ENTRY. 00546000
MOVE "Enter Satisfaction Rating. 0, 1, or 2" 00547000
TO WA-MESSAGE-1. 00548000
PERFORM B-324-SATIS-RATING-CRITERIA UNTIL VALID-ENTRY. 00549000
00550000
/ 00551000
******************************************************************00552000
* *00553000
* RECORD SELECTION CONTROL PARAGRAPH *00554000
* *00555000
******************************************************************00556000
00557000
B-210-SELECT-RECORDS. 00558000
00559000
OPEN INPUT CUSTOMER-SALES-FILE. 00560000
00561000
MOVE "N" TO SW-END-OF-FILE. 00562000
00563000
READ CUSTOMER-SALES-FILE INTO CUSTOMER-RECORD 00564000
AT END MOVE "Y" TO SW-END-OF-FILE. 00565000
00566000
PERFORM B-325-RELEASE-RECORDS UNTIL END-OF-FILE. 00567000
00568000
CLOSE CUSTOMER-SALES-FILE. 00569000
00570000
******************************************************************00571000
* *00572000
* RETURN RECORDS AND DISPLAY SELECTION REPORT *00573000
* *00574000
******************************************************************00575000
00576000
B-220-DISPLAY-REPORT. 00577000
00578000
OPEN OUTPUT REPORT-FILE. 00579000
MOVE FUNCTION CURRENT-DATE TO WA-TODAYS-DATE-TIME. 00580000
MOVE WA-TODAYS-MONTH TO WA-MONTH. 00581000
MOVE WA-TODAYS-DAY TO WA-DAY. 00582000
MOVE WA-TODAYS-YEAR TO WA-YEAR. 00583000
00584000
EVALUATE TRUE 00585000
WHEN WA-TODAYS-HOUR = 00 00586000
MOVE "AM" TO WA-AM-PM 00587000
MOVE 12 TO WA-TODAYS-HOUR 00588000
WHEN WA-TODAYS-HOUR < 12 00589000
MOVE "AM" TO WA-AM-PM 00590000
WHEN WA-TODAYS-HOUR = 12 00591000
MOVE "PM" TO WA-AM-PM 00592000
WHEN WA-TODAYS-HOUR > 12 00593000
MOVE "PM" TO WA-AM-PM 00594000
SUBTRACT 12 FROM WA-TODAYS-HOUR. 00595000
00596000
MOVE "N" TO SW-END-OF-FILE. 00597000
RETURN SORT-FILE INTO CUSTOMER-RECORD 00598000
AT END MOVE "Y" TO SW-END-OF-FILE. 00599000
00600000
MOVE ZERO TO AC-LINE-COUNT AC-XLINE-COUNT. 00601000
00602000
PERFORM B-330-RETURN-RECORDS UNTIL END-OF-FILE. 00603000
00604000
IF AC-RECORD-COUNT = 0 00605000
DISPLAY "NO RECORDS MATCH YOUR SELECTION CRITERIA!!" 00606000
LINE 20 COLUMN 20 00607000
MOVE 21 TO AC-LINE-COUNT. 00608000
00609000
ADD 1 TO AC-LINE-COUNT. 00610000
DISPLAY SL-LINE-1. 00611000
WRITE REPORT-LINE-OUT FROM RSL-LINE-1 00612000
AFTER ADVANCING 2 LINES. 00613000
ADD 1 TO AC-LINE-COUNT. 00614000
DISPLAY SL-LINE-2. 00615000
WRITE REPORT-LINE-OUT FROM RSL-LINE-2 00616000
AFTER ADVANCING 1 LINE. 00617000
00618000
CLOSE REPORT-FILE. 00619000
/ 00620000
******************************************************************00621000
* *00622000
* ACCEPT ZIP CODE *00623000
* *00624000
******************************************************************00625000
00626000
B-300-ZIP-CODE-CRITERIA. 00627000
00628000
DISPLAY SELECTION-MESSAGE. 00629000
00630000
ACCEPT WA-ZIP-CODE-ALPHA LINE 4 COLUMN 27. 00631000
00632000
IF WA-ZIP-CODE-ALPHA = SPACES 00633000
MOVE "Y" TO SW-VALID-ENTRY 00634000
00635000
IF WA-ZIP-CODE-ALPHA >10000 OR <96000
MOVE "Y" TO SW-VALID-ENTRY
ELSE
MOVE "ERROR! PLEASE RE-ENTER" TO WA-MESSAGE-1
ELSE
MOVE "Y" TO SW-VALID-ENTRY.
00638000
******************************************************************00639000
* *00640000
* ACCEPT CUSTOMER NUMBER *00641000
* *00642000
******************************************************************00643000
00644000
B-305-CUSTOMER-NUMBER-CRITERIA. 00645000
00646000
DISPLAY SELECTION-MESSAGE. 00647000
00648000
ACCEPT WA-CUSTOMER-NUMBER LINE 6 COLUMN 27. 00649000
00650000
IF WA-CUSTOMER-NUMBER = SPACES 00651000
MOVE "Y" TO SW-VALID-ENTRY 00652000
ELSE 00653000
IF WA-CUSTOMER-NUMBER NOT NUMERIC 00654000
MOVE "ERROR - CUSTOMER NUMBER NOT NUMERIC !" 00655000
TO WA-MESSAGE-1 00656000
ELSE 00657000
MOVE "Y" TO SW-VALID-ENTRY. 00658000
00659000
******************************************************************00660000
* *00661000
* ACCEPT PURCHASE DATE *00662000
* *00663000
******************************************************************00664000
00665000
B-310-PURCHASE-DATE-CRITERIA. 00666000
00667000
DISPLAY SELECTION-MESSAGE. 00668000
00669000
ACCEPT WA-PURCHASE-DATE LINE 8 COLUMN 27. 00670000
00671000
IF WA-PURCHASE-DATE = SPACES 00672000
MOVE "Y" TO SW-VALID-ENTRY 00673000
ELSE 00674000
IF WA-PURCHASE-DATE (1:2) < "01" OR > "12" 00675000
MOVE "MONTH MUST BE BETWEEN 1 AND 12 - RE-ENTER!" 00676000
TO WA-MESSAGE-1 00677000
ELSE 00678000
IF WA-PURCHASE-DATE (3:4) < "01" OR > "31" 00679000
MOVE "DAYS MUST BE BETWEEN 1 AND 31 - RE-ENTER" TO 00680000
WA-MESSAGE-1 00681000
ELSE IF WA-PURCHASE-DATE (5:6) > WA-YEAR 00682000
MOVE "PLEASE - RE-ENTER" TO 00683000
WA-MESSAGE-1 00684000
ELSE 00685000
MOVE "Y" TO SW-VALID-ENTRY. 00686000
/ 00687000
******************************************************************00688000
* *00689000
* ACCEPT AUTO PURCHASED CRITERIA *00690000
* *00691000
******************************************************************00692000
00693000
B-315-AUTO-PURCHASED-CRITERIA. 00694000
00695000
DISPLAY SELECTION-MESSAGE. 00696000
00697000
ACCEPT WA-AUTO-PURCHASED LINE 10 COLUMN 27. 00698000
IF WA-AUTO-PURCHASED = SPACES 00699000
MOVE "Y" TO SW-VALID-ENTRY 00700000
ELSE 00701000
IF WA-AUTO-PURCHASED NOT ALPHABETIC 00702000
MOVE "AUTO-PURCHASED MUST BE ALPHABETIC! RE-ENTER!" 00703000
TO WA-MESSAGE-1 00704000
ELSE 00705000
MOVE "Y" TO SW-VALID-ENTRY. 00706000
/ 00707000
******************************************************************00708000
* *00709000
* ACCEPT PURCHASE PRICE *00710000
* *00711000
******************************************************************00712000
00713000
B-320-PURCHASE-PRICE-CRITERIA. 00714000
00715000
DISPLAY SELECTION-MESSAGE. 00716000
00717000
ACCEPT WA-PURCHASE-PRICE LINE 12 COLUMN 27. 00718000
00719000
IF WA-PURCHASE-PRICE-ALPHA = SPACES 00720000
MOVE "Y" TO SW-VALID-ENTRY 00721000
ELSE 00722000
IF CR-PURCHASE-PRICE NOT NUMERIC 00723000
MOVE "PRICE MUST BE NUMERIC - PLEASE RE-ENTER" 00724000
TO WA-MESSAGE-1 00725000
ELSE 00726000
MOVE "Y" TO SW-VALID-ENTRY. 00727000
00728000
******************************************************************00729000
* *00730000
* ACCEPT AUTO YEAR CRITERIA *00731000
* *00732000
******************************************************************00733000
00734000
B-322-AUTO-YEAR-CRITERIA. 00735000
00736000
DISPLAY SELECTION-MESSAGE. 00737000
00738000
ACCEPT WA-AUTO-YEAR LINE 14 COLUMN 27. 00739000
00740000
IF WA-AUTO-YEAR = SPACES 00741000
MOVE "Y" TO SW-VALID-ENTRY 00742000
ELSE 00743000
IF WA-AUTO-YEAR < "1900" OR > WA-TODAYS-YEAR 00744000
MOVE "MODEL YEAR IS OUT OF RANGE!" TO WA-MESSAGE-1 00745000
ELSE 00746000
MOVE "Y" TO SW-VALID-ENTRY. 00747000
00748000
/ 00749000
******************************************************************00750000
* *00751000
* ACCEPT SATISFACTION RATING *00752000
* *00753000
******************************************************************00754000
00755000
B-324-SATIS-RATING-CRITERIA. 00756000
00757000
DISPLAY SELECTION-MESSAGE. 00758000
00759000
ACCEPT WA-SATISFACTION-RATING LINE 16 COLUMN 27. 00760000
00761000
IF WA-SATISFACTION-RATING = "0" OR "1" OR "2" OR " " 00762000
MOVE "Y" TO SW-VALID-ENTRY 00763000
MOVE "ERROR! PLEASE RE-ENTER 0, 1 OR 2 "
TO WA-MESSAGE-1.
/ 00768000
00769000
******************************************************************00770000
* *00771000
* COMPARE RECORD TO CRITERIA AND RELEASE *00772000
* *00773000
******************************************************************00774000
00775000
B-325-RELEASE-RECORDS. 00776000
00777000
MOVE "Y" TO SW-RELEASE-RECORD. 00778000
00779000
IF WA-ZIP-CODE-ALPHA NOT = SPACES 00780000
IF WA-ZIP-CODE-ALPHA NOT = CR-ZIP-CODE 00781000
MOVE "N" TO SW-RELEASE-RECORD. 00782000
00783000
IF WA-CUSTOMER-NUMBER NOT = SPACES 00784000
IF CR-CUSTOMER-NUMBER < WA-CUSTOMER-NUMBER 00785000
MOVE "N" TO SW-RELEASE-RECORD. 00786000
00787000
IF WA-PURCHASE-DATE NOT = SPACES 00788000
IF WA-PURCHASE-DATE <= CR-PURCHASE-DATE 00789000
MOVE "N" TO SW-RELEASE-RECORD. 00790000
00791000
IF WA-AUTO-PURCHASED NOT = SPACES 00792000
IF WA-AUTO-PURCHASED NOT = CR-AUTO-MAKE 00793000
MOVE "N" TO SW-RELEASE-RECORD. 00794000
00795000
IF WA-PURCHASE-PRICE-ALPHA NOT = SPACES 00796000
IF WA-PURCHASE-PRICE <= CR-PURCHASE-PRICE 00797000
MOVE "N" TO SW-RELEASE-RECORD. 00798000
00799000
IF WA-AUTO-YEAR NOT = SPACES 00800000
IF WA-AUTO-YEAR <= CR-AUTO-YEAR 00801000
MOVE "N" TO SW-RELEASE-RECORD. 00802000
00803000
IF WA-SATISFACTION-RATING NOT = SPACES 00804000
IF WA-SATISFACTION-RATING IS NOT = CR-SATISFACTION-RATING00805000
MOVE "N" TO SW-RELEASE-RECORD. 00806000
00807000
IF RELEASE-RECORD 00808000
RELEASE SORT-RECORD FROM CUSTOMER-RECORD. 00809000
00810000
READ CUSTOMER-SALES-FILE INTO CUSTOMER-RECORD 00811000
AT END MOVE "Y" TO SW-END-OF-FILE. 00812000
/ 00813000
******************************************************************00814000
* *00815000
* RETURN RECORDS AND DISPLAY SELECTION REPORT *00816000
* *00817000
******************************************************************00818000
00819000
B-330-RETURN-RECORDS. 00820000
00821000
IF AC-LINE-COUNT = 0 00822000
PERFORM B-400-DISPLAY-HEADINGS. 00823000
IF AC-XLINE-COUNT = 0 00824000
PERFORM B-405-DISPLAY-HEADINGS. 00825000
00826000
MOVE CR-ZIP-CODE TO RDL-ZIP-CODE. 00827000
MOVE CR-CUSTOMER-NUMBER TO RDL-CUSTOMER-NUMBER. 00828000
MOVE CR-PURCHASE-DATE TO RDL-PURCHASE-DATE. 00829000
MOVE CR-AUTO-MAKE TO RDL-AUTO-MAKE. 00830000
MOVE CR-PURCHASE-PRICE TO RDL-PURCHASE-PRICE. 00831000
MOVE CR-SATISFACTION-RATING TO RDL-SATISFACTION-RATING. 00832000
DISPLAY DETAIL-LINE. 00833000
WRITE REPORT-LINE-OUT FROM REPORT-DETAIL-LINE 00834000
AFTER ADVANCING 1 LINE. 00835000
00836000
ADD 1 TO AC-XLINE-COUNT. 00837000
ADD 1 TO AC-LINE-COUNT. 00838000
ADD 1 TO AC-RECORD-COUNT. 00839000
00840000
IF AC-LINE-COUNT > 20 00841000
MOVE ZERO TO AC-LINE-COUNT 00842000
DISPLAY "PRESS ENTER TO CONTINUE" LINE 24 COLUMN 1 00843000
ACCEPT WA-SCREEN-HOLD LINE 24 COLUMN 25. 00844000
00845000
IF AC-XLINE-COUNT > 55 00846000
MOVE ZERO TO AC-XLINE-COUNT. 00847000
00848000
RETURN SORT-FILE INTO CUSTOMER-RECORD 00849000
AT END MOVE "Y" TO SW-END-OF-FILE. 00850000
/ 00851000
******************************************************************00852000
* *00853000
* PAGE HEADING PARAGRAPH *00854000
* *00855000
******************************************************************00856000
00857000
B-400-DISPLAY-HEADINGS. 00858000
00859000
ADD 1 TO AC-PAGE-COUNT. 00860000
DISPLAY HEADING-LINE. 00861000
MOVE 4 TO AC-LINE-COUNT. 00862000
PERFORM B-500-DISPLAY-CRITERIA. 00863000
DISPLAY COLUMN-HEADING-1. 00864000
ADD 1 TO AC-LINE-COUNT. 00865000
DISPLAY COLUMN-HEADING-2. 00866000
ADD 1 TO AC-LINE-COUNT. 00867000
DISPLAY COLUMN-HEADING-3. 00868000
ADD 1 TO AC-LINE-COUNT. 00869000
00870000
******************************************************************00871000
* *00872000
* PAGE HEADING FOR EX 6-1 *00873000
* *00874000
******************************************************************00875000
00876000
B-405-DISPLAY-HEADINGS. 00877000
00878000
ADD 1 TO AC-XPAGE-COUNT. 00879000
MOVE WA-RUN-DATE TO RH-DATE. 00880000
MOVE AC-XPAGE-COUNT TO RH-PAGE. 00881000
WRITE REPORT-LINE-OUT FROM RH-LINE-1 00882000
AFTER ADVANCING 2 LINES. 00883000
MOVE WA-TODAYS-HOUR TO RH-HOUR. 00884000
MOVE WA-TODAYS-MINUTES TO RH-MINUTES. 00885000
MOVE WA-AM-PM TO RH-AM-PM. 00886000
WRITE REPORT-LINE-OUT FROM RH-LINE-2 00887000
AFTER ADVANCING 1 LINE. 00888000
WRITE REPORT-LINE-OUT FROM RH-LINE-2A 00889000
MOVE 5 TO AC-XLINE-COUNT. 00890000
PERFORM B-505-DISPLAY-CRITERIA. 00891000
WRITE REPORT-LINE-OUT FROM RH-LINE-4 00892000
AFTER ADVANCING 2 LINES. 00893000
ADD 2 TO AC-XLINE-COUNT. 00894000
WRITE REPORT-LINE-OUT FROM RH-LINE-5 00895000
AFTER ADVANCING 1 LINE. 00896000
WRITE REPORT-LINE-OUT FROM RH-LINE-6 00897000
AFTER ADVANCING 1 LINE. 00898000
ADD 3 TO AC-XLINE-COUNT. 00899000
00900000
******************************************************************00901000
* *00902000
* DISPLAY SELECTION REPORT CRITERIA *00903000
* *00904000
******************************************************************00905000
00906000
B-500-DISPLAY-CRITERIA. 00907000
00908000
MOVE "SELECTION CRITERIA:" TO WA-CRIT-MESSAGE. 00909000
00910000
IF WA-ZIP-CODE-ALPHA NOT = SPACES 00911000
MOVE "ZIP-CODE" TO WA-CRIT-TYPE 00912000
MOVE WA-ZIP-CODE TO WA-CRITERIA 00913000
DISPLAY CRITERIA-LINE 00914000
MOVE SPACES TO WA-CRIT-MESSAGE 00915000
ADD 1 TO AC-LINE-COUNT. 00916000
00917000
IF WA-CUSTOMER-NUMBER NOT = SPACES 00918000
MOVE "CUSTOMER-NUMBER" TO WA-CRIT-TYPE 00919000
MOVE WA-CUSTOMER-NUMBER TO WA-CRITERIA 00920000
DISPLAY CRITERIA-LINE 00921000
MOVE SPACES TO WA-CRIT-MESSAGE 00922000
ADD 1 TO AC-LINE-COUNT. 00923000
00924000
IF WA-PURCHASE-DATE NOT = SPACES 00925000
MOVE "PURCHASE DATE" TO WA-CRIT-TYPE 00926000
MOVE WA-PURCHASE-DATE TO WA-CRITERIA 00927000
DISPLAY CRITERIA-LINE 00928000
MOVE SPACES TO WA-CRIT-MESSAGE 00929000
ADD 1 TO AC-LINE-COUNT. 00930000
00931000
IF WA-AUTO-PURCHASED NOT = SPACES 00932000
MOVE "AUTO PURCHASED" TO WA-CRIT-TYPE 00933000
MOVE WA-AUTO-PURCHASED TO WA-CRITERIA 00934000
DISPLAY CRITERIA-LINE 00935000
MOVE SPACES TO WA-CRIT-MESSAGE 00936000
ADD 1 TO AC-LINE-COUNT. 00937000
00938000
IF WA-PURCHASE-PRICE-ALPHA NOT = SPACES 00939000
MOVE "PURCHASE PRICE" TO WA-CRIT-TYPE 00940000
MOVE WA-PURCHASE-PRICE TO WA-CRITERIA 00941000
DISPLAY CRITERIA-LINE 00942000
MOVE SPACES TO WA-CRIT-MESSAGE 00943000
ADD 1 TO AC-LINE-COUNT. 00944000
00945000
IF WA-AUTO-YEAR NOT = SPACES 00946000
MOVE "AUTO YEAR" TO WA-CRIT-TYPE 00947000
MOVE WA-AUTO-YEAR TO WA-CRITERIA 00948000
DISPLAY CRITERIA-LINE 00949000
MOVE SPACES TO WA-CRIT-MESSAGE 00950000
ADD 1 TO AC-LINE-COUNT. 00951000
00952000
IF WA-SATISFACTION-RATING NOT = SPACES 00953000
MOVE "SATISFACTION RATING" TO WA-CRIT-TYPE 00954000
MOVE WA-SATISFACTION-RATING TO WA-CRITERIA 00955000
DISPLAY CRITERIA-LINE 00956000
MOVE SPACES TO WA-CRIT-MESSAGE 00957000
ADD 1 TO AC-LINE-COUNT. 00958000
ADD 1 TO AC-LINE-COUNT. 00959000
00960000
******************************************************************00961000
* *00962000
* DISPLAY SELECTION REPORT CRITERIA FOR EX 6-1 *00963000
* *00964000
******************************************************************00965000
00966000
B-505-DISPLAY-CRITERIA. 00967000
00968000
MOVE SPACES TO REPORT-LINE-OUT. 00969000
WRITE REPORT-LINE-OUT AFTER ADVANCING 1 LINE. 00970000
00971000
MOVE "SELECTION CRITERIA:" TO RH-CRITERIA-MSG. 00972000
00973000
IF WA-ZIP-CODE-ALPHA NOT = SPACES 00974000
MOVE "ZIP CODE" TO RH-CRITERIA-TYPE 00975000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 00976000
AFTER ADVANCING 1 LINE 00977000
MOVE SPACES TO RH-CRITERIA-MSG 00978000
ADD 1 TO AC-XLINE-COUNT. 00979000
00980000
IF WA-CUSTOMER-NUMBER NOT = SPACES 00981000
MOVE "CUSTOMER NUMBER" TO RH-CRITERIA-TYPE 00982000
MOVE WA-CUSTOMER-NUMBER TO RH-CRITERIA 00983000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 00984000
AFTER ADVANCING 1 LINE 00985000
MOVE SPACES TO RH-CRITERIA-MSG 00986000
ADD 1 TO AC-XLINE-COUNT. 00987000
00988000
IF WA-PURCHASE-DATE NOT = SPACES 00989000
MOVE "PURCHAE DATE" TO RH-CRITERIA-TYPE 00990000
MOVE WA-PURCHASE-DATE TO RH-CRITERIA 00991000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 00992000
AFTER ADVANCING 1 LINE 00993000
MOVE SPACES TO RH-CRITERIA-MSG 00994000
ADD 1 TO AC-XLINE-COUNT. 00995000
00996000
IF WA-AUTO-PURCHASED NOT = SPACES 00997000
MOVE "AUTO PURCHASED" TO RH-CRITERIA-TYPE 00998000
MOVE WA-AUTO-PURCHASED TO RH-CRITERIA 00999000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 01000000
AFTER ADVANCING 1 LINE 01001000
MOVE SPACES TO RH-CRITERIA-MSG 01002000
ADD 1 TO AC-XLINE-COUNT. 01003000
01004000
IF WA-PURCHASE-PRICE-ALPHA NOT = SPACES 01005000
MOVE "PURCHASE PRICE" TO RH-CRITERIA-TYPE 01006000
MOVE WA-PURCHASE-PRICE TO RH-CRITERIA 01007000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 01008000
AFTER ADVANCING 1 LINE 01009000
MOVE SPACES TO RH-CRITERIA-MSG 01010000
ADD 1 TO AC-XLINE-COUNT. 01011000
01012000
IF WA-AUTO-YEAR NOT = SPACES 01013000
MOVE "AUTO YEAR" TO RH-CRITERIA-TYPE 01014000
MOVE WA-AUTO-YEAR TO RH-CRITERIA 01015000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 01016000
AFTER ADVANCING 1 LINE 01017000
MOVE SPACES TO RH-CRITERIA-MSG 01018000
ADD 1 TO AC-XLINE-COUNT. 01019000
01020000
IF WA-SATISFACTION-RATING NOT = SPACES 01021000
MOVE "SATISFACTION RATING" TO RH-CRITERIA-TYPE 01022000
MOVE WA-SATISFACTION-RATING TO RH-CRITERIA 01023000
WRITE REPORT-LINE-OUT FROM RH-LINE-3 01024000
AFTER ADVANCING 1 LINE 01025000
MOVE SPACES TO RH-CRITERIA-MSG 01026000
ADD 1 TO AC-XLINE-COUNT. 01027000
01028000
******************************************************************01029000
* *01030000
* END OF JOB PARAGRAPH *01031000
* *01032000
******************************************************************01033000
01034000
C-100-WRAP-UP. 01035000
01036000
DISPLAY "INVENTORY SELECTION REPORT PROGRAM HAS TERMINATED" 01037000
LINE 24 COLUMN 10. 01038000
01039000
******************************************************************01040000
* *01041000
* END OF PROGRAM *01042000
* *01043000
******************************************************************01044000
/ 01045000
MultiQuote
| 