Data entry frequently is more complicated than the maintenance program examples that you have explored so far. Validations might be more complicated, data fields such as dates frequently cause problems, and some maintenance modules don't use all of the modes (add, change, inquire, and delete). Today, you explore the following topics:
In any large system, there are basic values that have to be tracked in various programs within the system:
This type of information usually is stored in a file called a control file. A control file frequently contains a single record. This single record contains fields that hold all the information required for the system. Listing 19.1 is an example of an FD for a payroll system control file containing some of the fields described in the preceding paragraph.
001000 FD PAYROLL-CONTROL-FILE 001100 LABEL RECORDS ARE STANDARD. 001200 01 PAYROLL-CONTROL-RECORD. 001300 05 PAYROLL-CONTROL-KEY PIC 9. 001400 05 PAYROLL-CONTROL-LAST-EMPLOYEE PIC 9(5). 001500 05 PAYROLL-CONTROL-OVERTIME-HOURS PIC 99V99. 001600 05 PAYROLL-CONTROL-LAST-CHECK PIC 9(6). 001700 05 PAYROLL-CONTROL-CHECK-ACCOUNT PIC X(15).
ANALYSIS: The payroll control file is an indexed file containing only one record. The key to the record always is 1. Any program that needs information from the control file would open the file, move 1 to the key, and read the record. The record could be updated by rewriting it.
It might seem odd to use an indexed file to store a single record, but there are reasons that an indexed file is used. Indexed files are easier to REWRITE. Because control files frequently contain information that is updated, such as last check number, they are updated in one or more programs. Indexed files also are easier to share. In a large system, one user might be adding an employee, two others entering data for hours worked, and yet another printing checks. All these programs need to share the control file, even though each is using only one part of it.
The control file that is used in the bill payment system also is an indexed file. It contains a key that always is 1 and a single field, CONTROL-LAST-VOUCHER.
New Term: In a bills paying system, each new invoice that is received for payment is assigned a tracking number. This tracking number is the key to the voucher file, or bills file, and the number usually is called a voucher number.
This control file is used to assign voucher numbers automatically whenever a new invoice is added to the system. Listings 19.2 is the COPY file slcontrl.cbl and contains the SELECT for this control file.
000100*-------------------------------- 000200* SLCONTRL.CBL 000300*-------------------------------- 000400 SELECT CONTROL-FILE 000500 ASSIGN TO "CONTROL" 000600 ORGANIZATION IS INDEXED 000700 RECORD KEY IS CONTROL-KEY 000800 ACCESS MODE IS DYNAMIC. 000900
Listing 19.3 is the COPY file fdcontrl.cbl and contains the FD for this control file.
000100*-------------------------------- 000200* FDCONTRL.CBL 000300* Primary Key - CONTROL-KEY 000400* LAST-VOUCHER is used 000500* to track the last 000600* used voucher number. 000700* This is a single record file 000800* CONTROL-KEY always = 1. 000900*-------------------------------- 001000 FD CONTROL-FILE 001100 LABEL RECORDS ARE STANDARD. 001200 01 CONTROL-RECORD. 001300 05 CONTROL-KEY PIC 9. 001400 05 CONTROL-LAST-VOUCHER PIC 9(5). 001500
Creating a new control file for a system is slightly different from creating another file in the system. A control file of the type that is used for the bills payment system is always expected to have that single record in it.
Listing 19.4 is similar to other build programs, but at lines 002400 through 002600, it loads and writes a single record to the file. This record contains a last voucher number of zeroes.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. CTLBLD01. 000300*-------------------------------- 000400* Create a Control file for the 000500* bills payment system and write 000600* the initial record. 000700*-------------------------------- 000800 ENVIRONMENT DIVISION. 000900 INPUT-OUTPUT SECTION. 001000 FILE-CONTROL. 001100 001200 COPY "SLCONTRL.CBL". 001300 001400 DATA DIVISION. 001500 FILE SECTION. 001600 001700 COPY "FDCONTRL.CBL". 001800 001900 WORKING-STORAGE SECTION. 002000 002100 PROCEDURE DIVISION. 002200 PROGRAM-BEGIN. 002300 OPEN OUTPUT CONTROL-FILE. 002400 MOVE 1 TO CONTROL-KEY. 002500 MOVE ZEROES TO CONTROL-LAST-VOUCHER. 002600 WRITE CONTROL-RECORD. 002700 CLOSE CONTROL-FILE. 002800 002900 PROGRAM-EXIT. 003000 EXIT PROGRAM. 003100 003200 PROGRAM-DONE. 003300 STOP RUN. 003400
Code Listing 19.2 and Listing 19.3 to create the SELECT and FD for the control file. Then code, compile, and run ctlbld01.cbl to create the new control file with its single record.
Basically, maintaining a control file requires only the change and inquire modes from a standard maintenance module. You never want to add records, and you certainly never want to delete the record, so only the change and inquire options are left.
DO/DON'T:
DO allow a user, or more likely a system administrator, to look up information in the control file, and make it possible to change the information.DON'T allow anyone to delete the control record from the control file. Don't provide delete mode in the maintenance program.
Listing 19.5 is a maintenance program for the control file. It uses only change and inquire mode, which gives a user the ability of looking up the control information or changing the control information. The control record cannot be deleted, nor can a new record be added.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. CTLMNT01. 000300*-------------------------------- 000400* Change and Inquire only 000500* for the bills system control 000600* file. 000700*-------------------------------- 000800 ENVIRONMENT DIVISION. 000900 INPUT-OUTPUT SECTION. 001000 FILE-CONTROL. 001100 001200 COPY "SLCONTRL.CBL". 001300 001400 DATA DIVISION. 001500 FILE SECTION. 001600 001700 COPY "FDCONTRL.CBL". 001800 001900 WORKING-STORAGE SECTION. 002000 002100 77 MENU-PICK PIC 9. 002200 88 MENU-PICK-IS-VALID VALUES 0 THRU 2. 002300 002400 77 THE-MODE PIC X(7). 002500 77 RECORD-FOUND PIC X. 002600 77 WHICH-FIELD PIC 9. 002700 77 A-DUMMY PIC X. 002800 002900 PROCEDURE DIVISION. 003000 PROGRAM-BEGIN. 003100 PERFORM OPENING-PROCEDURE. 003200 PERFORM MAIN-PROCESS. 003300 PERFORM CLOSING-PROCEDURE. 003400 003500 PROGRAM-EXIT. 003600 EXIT PROGRAM. 003700 003800 PROGRAM-DONE. 003900 STOP RUN. 004000 004100 OPENING-PROCEDURE. 004200 OPEN I-O CONTROL-FILE. 004300 004400 CLOSING-PROCEDURE. 004500 CLOSE CONTROL-FILE. 004600 004700 004800 MAIN-PROCESS. 004900 PERFORM GET-MENU-PICK. 005000 PERFORM MAINTAIN-THE-FILE 005100 UNTIL MENU-PICK = 0. 005200 005300*-------------------------------- 005400* MENU 005500*-------------------------------- 005600 GET-MENU-PICK. 005700 PERFORM DISPLAY-THE-MENU. 005800 PERFORM ACCEPT-MENU-PICK. 005900 PERFORM RE-ACCEPT-MENU-PICK 006000 UNTIL MENU-PICK-IS-VALID. 006100 006200 DISPLAY-THE-MENU. 006300 PERFORM CLEAR-SCREEN. 006400 DISPLAY " PLEASE SELECT:". 006500 DISPLAY " ". 006600 DISPLAY " 1. CHANGE CONTROL INFORMATION". 006700 DISPLAY " 2. DISPLAY CONTROL INFORMATION". 006800 DISPLAY " ". 006900 DISPLAY " 0. EXIT". 007000 PERFORM SCROLL-LINE 8 TIMES. 007100 007200 ACCEPT-MENU-PICK. 007300 DISPLAY "YOUR CHOICE (0-2)?". 007400 ACCEPT MENU-PICK. 007500 007600 RE-ACCEPT-MENU-PICK. 007700 DISPLAY "INVALID SELECTION - PLEASE RE-TRY.". 007800 PERFORM ACCEPT-MENU-PICK. 007900 008000 CLEAR-SCREEN. 008100 PERFORM SCROLL-LINE 25 TIMES. 008200 008300 SCROLL-LINE. 008400 DISPLAY " ". 008500 008600 MAINTAIN-THE-FILE. 008700 PERFORM DO-THE-PICK. 008800 PERFORM GET-MENU-PICK. 008900 009000 DO-THE-PICK. 009100 IF MENU-PICK = 1 009200 PERFORM CHANGE-MODE 009300 ELSE 009400 IF MENU-PICK = 2 009500 PERFORM INQUIRE-MODE. 009600 009700*-------------------------------- 009800* CHANGE 009900*-------------------------------- 010000 CHANGE-MODE. 010100 MOVE "CHANGE" TO THE-MODE. 010200 PERFORM GET-CONTROL-RECORD. 010300 IF RECORD-FOUND = "Y" 010400 PERFORM CHANGE-RECORDS. 010500 010600 CHANGE-RECORDS. 010700 PERFORM GET-FIELD-TO-CHANGE. 010800 PERFORM CHANGE-ONE-FIELD. 010900 011000 PERFORM GET-CONTROL-RECORD. 011100 011200 GET-FIELD-TO-CHANGE. 011300 PERFORM DISPLAY-ALL-FIELDS. 011400 PERFORM ASK-WHICH-FIELD. 011500 011600 ASK-WHICH-FIELD. 011700 MOVE 1 TO WHICH-FIELD. 011800 011900 CHANGE-ONE-FIELD. 012000 PERFORM CHANGE-THIS-FIELD. 012100 012200 CHANGE-THIS-FIELD. 012300 IF WHICH-FIELD = 1 012400 PERFORM ENTER-CONTROL-LAST-VOUCHER. 012500 012600 PERFORM REWRITE-CONTROL-RECORD. 012700 012800*-------------------------------- 012900* INQUIRE 013000*-------------------------------- 013100 INQUIRE-MODE. 013200 MOVE "DISPLAY" TO THE-MODE. 013300 PERFORM GET-CONTROL-RECORD. 013400 IF RECORD-FOUND = "Y" 013500 PERFORM INQUIRE-RECORDS. 013600 013700 INQUIRE-RECORDS. 013800 PERFORM DISPLAY-ALL-FIELDS. 013900 PERFORM PRESS-ENTER. 014000 014100 PRESS-ENTER. 014200 DISPLAY " ". 014300 DISPLAY "PRESS ENTER TO CONTINUE". 014400 ACCEPT A-DUMMY. 014500 014600*-------------------------------- 014700* Routines for Change 014800*-------------------------------- 014900 ENTER-CONTROL-LAST-VOUCHER. 015000 PERFORM ACCEPT-CONTROL-LAST-VOUCHER. 015100 015200 ACCEPT-CONTROL-LAST-VOUCHER. 015300 DISPLAY "ENTER LAST VOUCHER NUMBER". 015400 ACCEPT CONTROL-LAST-VOUCHER. 015500 015600*-------------------------------- 015700* Routines shared by Change and Inquire 015800*-------------------------------- 015900 INIT-CONTROL-RECORD. 016000 MOVE ZEROES TO CONTROL-RECORD. 016100 016200 ENTER-CONTROL-KEY. 016300 MOVE 1 TO CONTROL-KEY. 016400 016500 GET-CONTROL-RECORD. 016600 PERFORM INIT-CONTROL-RECORD. 016700 PERFORM ENTER-CONTROL-KEY. 016800 MOVE "N" TO RECORD-FOUND. 016900 PERFORM FIND-CONTROL-RECORD. 017000 017100 FIND-CONTROL-RECORD. 017200 PERFORM READ-CONTROL-RECORD. 017300 IF RECORD-FOUND = "N" 017400 DISPLAY "RECORD NOT FOUND" 017500 DISPLAY "YOU MUST RUN CTLBLD01" 017600 DISPLAY "TO CREATE THIS FILE". 017700 017800 DISPLAY-ALL-FIELDS. 017900 DISPLAY " ". 018000 PERFORM DISPLAY-CONTROL-LAST-VOUCHER. 018100 DISPLAY " ". 018200 018300 DISPLAY-CONTROL-LAST-VOUCHER. 018400 DISPLAY "1. LAST VOUCHER NUMBER: " 018500 CONTROL-LAST-VOUCHER. 018600 018700*-------------------------------- 018800* File I-O Routines 018900*-------------------------------- 019000 READ-CONTROL-RECORD. 019100 MOVE "Y" TO RECORD-FOUND. 019200 READ CONTROL-FILE RECORD 019300 INVALID KEY 019400 MOVE "N" TO RECORD-FOUND. 019500 019600*or READ CONTROL-FILE RECORD WITH LOCK 019700* INVALID KEY 019800* MOVE "N" TO RECORD-FOUND. 019900 020000*or READ CONTROL-FILE RECORD WITH HOLD 020100* INVALID KEY 020200* MOVE "N" TO RECORD-FOUND. 020300 020400 REWRITE-CONTROL-RECORD. 020500 REWRITE CONTROL-RECORD 020600 INVALID KEY 020700 DISPLAY "ERROR REWRITING CONTROL RECORD". 020800
ANALYSIS: There are two other features in the control maintenance program, the use of a permanent key value of 1, and the absence of the key value on the display. The key to the record always is a value of 1. Rather than asking the user to enter a value, at line 016200, the ENTER-CONTROL-KEY routine moves 1 to CONTROL-KEY.
If 1 is not a valid key for the record, something has gone wrong and the control record has been deleted somehow. The FIND-CONTROL-RECORD routine at line 017100 expands on the standard "RECORD NOT FOUND" message by adding some additional messages at lines 017500 and 017600.
The control key itself is not a number that the user ever needs to enter or even see, so the DISPLAY-ALL-FIELDS routine at line 017800 is reduced to displaying the single field in the control file, CONTROL-LAST-VOUCHER.
In other maintenance modules, the user is put into a loop to change or look up a record, the record is displayed and modified, and then the user is asked for the key of another record to display or change. With this control file, that loop would be pointless because there is only one record in the file, which causes a problem in inquire mode. The fields (in this case, a single field) are displayed and the user is not asked for another key, but is returned immediately to the menu. In inquire mode, the information flashes briefly on the screen and then the menu is displayed.
To slow down the display so that the user has a chance to read the information, INQUIRE-RECORDS at line 013700 includes a request to perform a PRESS-ENTER routine at line 013900. This enables the user to see the record and then press Enter before being returned to the menu.
There is an exercise at the end of today's lesson to compare a simple maintenance module such as stcmnt04.cbl with ctlmnt01.cbl. You might want to try this exercise right away.
Code, compile, and run ctlmnt01.cbl and ensure that you can change and display the last voucher number. Use ctlmnt01.cbl to reset this number to zeroes.
The bills payment system will use more than one program to maintain the voucher file, which is shown in Listing 19.6 and which is a COPY file for the voucher FD.
000100*-------------------------------- 000200* FDVOUCH.CBL 000300* Primary Key - VOUCHER-NUMBER 000400*Dates are in CCYYMMDD format 000500 FD VOUCHER-FILE 000600 LABEL RECORDS ARE STANDARD. 000700 01 VOUCHER-RECORD. 000800 05 VOUCHER-NUMBER PIC 9(5). 000900 05 VOUCHER-VENDOR PIC 9(5). 001000 05 VOUCHER-INVOICE PIC X(15). 001100 05 VOUCHER-FOR PIC X(30). 001200 05 VOUCHER-AMOUNT PIC S9(6)V99. 001300 05 VOUCHER-DATE PIC 9(8). 001400 05 VOUCHER-DUE PIC 9(8). 001500 05 VOUCHER-DEDUCTIBLE PIC X. 001600 05 VOUCHER-SELECTED PIC X. 001700 05 VOUCHER-PAID-AMOUNT PIC S9(6)V99. 001800 05 VOUCHER-PAID-DATE PIC 9(8). 001900 05 VOUCHER-CHECK-NO PIC 9(6). 002000
ANALYSIS: Whenever a new bill comes in, the user will use a standard maintenance module to add the information to the file. The voucher number will be assigned automatically in add mode. The user will be required to enter the vendor, vendor's invoice number, a comment on what the invoice is for, the amount of the invoice, the invoice date and due date, and a yes/no flag as to whether this is tax deductible. Basically, this encompasses all the fields from line 000900 through line 001500.
The remaining fields, from line 001600 through 001800, are filled in by the computer in add mode. VOUCHER-SELECTED is set to "N"; VOUCHER-PAID-AMOUNT, VOUCHER-PAID-DATE, and VOUCHER-CHECK-NO are set to zero.
All the date fields in the voucher file use an eight digit date in the form CCYYMMDD. CCYY represents a full four digit year, such as 1997. Until recently it has been a tradition, based on the original very expensive costs of memory and disk space, to store dates as YYMMDD. This practice is causing a major problem in the computer industry as the year 2000 approaches. This issue is covered extensively in Bonus Day 6, "Dates and the Year 2000."
A separate program enables the user to select which vouchers should be paid, and yet another program enables the user to enter the paid amount, paid date, and check number. Here is an example of more than one program maintaining a single file.
The voucher file has a single key--the voucher number--and Listing 19.7 is the COPY file slvouch.cbl containing the SELECT statement for the file.
000100*-------------------------------- 000200* SLVOUCH.CBL 000300*-------------------------------- 000400 SELECT VOUCHER-FILE 000500 ASSIGN TO "VOUCHER" 000600 ORGANIZATION IS INDEXED 000700 RECORD KEY IS VOUCHER-NUMBER 000800 ACCESS MODE IS DYNAMIC. 000900
First, look at the basic design of the bills paying system, and then start putting together the programs you need to implement the system.
New Term: A flowchart is a graphic representation of how a program or activity moves through various processes or program routines. It uses symbols to represent the activities and arrows to represent the direction of activity through the processes.
You can use flowcharts to define the behavior of a single program or a system (a combination of programs).
Figure 19.1 shows a flowchart representing how the bills system operates. At step 1 in the diagram, the arrival of a new bill is represented by a shape used to stand for a document.
Figure 19.1.
Flowchart of the bills payment system.
At step 2, the bill is keyed into the computer as a voucher. Step 2 is a voucher entry program very much like a standard maintenance module, as described in the analysis of Listing 19.6.
At step 3, a decision is made whether to start bills payment. This decision is made by a person and usually is based on a regular bills payment schedule, which could be weekly or biweekly. If it is not time to start paying the bills, the flow of the system loops back up to await the arrival of any more bills. Steps 1, 2, and 3 are repeated while bills continue to come in.
When the decision is made to start the bill payment cycle, the bills report is printed at step 4. Step 4 is a program that prints all the outstanding vouchers (bills) in the voucher file.
This system is designed to pay by dateline, so step 5 defines a manual process of deciding through which date to pay bills. The decision involves someone sitting down with the bills report and making a decision about what cutoff date to use.
Step 6 is a program that enables the user to enter the selected cutoff date, and it flags all bills due within the cutoff date as ready to be paid by writing a "Y" to the VOUCHER-SELECTED flag.
Step 7 is a program that allows for the VOUCHER-SELECTED flag to be adjusted. This program can be used to set the flag to "Y" or "N" for any voucher (bill) that is as yet unpaid. This program enables the user to fine-tune the selections made in step 6 by including or excluding vouchers to pay.
Step 8 is a program that prints the cash requirements report. This report provides a total of all the cash needed to pay the bills selected in steps 6 and 7.
Step 9 is another human decision. Someone sits down with the cash requirements report and the bank balance and decides whether there is enough cash to fulfill the cash requirements.
If there is not enough cash, the user proceeds to step 10 where another decision is made: How bad is the shortfall? If the cash requirements grossly exceeds the available cash, the process returns to the beginning of the loop at step 5 where the user once again selects a cutoff date that will encompass fewer bills. If the shortfall is not large, the user returns to step 6 and uses the VOUCHER-SELECTED adjustment program to trim off some bills that won't be paid.
This process is continued until the answer to step 9 is yes and there is enough cash. Then the process continues to step 11, where the user manually writes the checks for each voucher in the final version of the cash requirements report.
At step 12, a data entry program enables the user to pull up the selected vouchers and mark them as paid. The system also includes some programs that enable you to report on paid bills.
Listing 19.8 is a familiar program used to create a new voucher file.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. VCHBLD01. 000300*-------------------------------- 000400* Create a Voucher file for the 000500* bills payment system 000600*-------------------------------- 000700 ENVIRONMENT DIVISION. 000800 INPUT-OUTPUT SECTION. 000900 FILE-CONTROL. 001000 001100 COPY "SLVOUCH.CBL". 001200 001300 DATA DIVISION. 001400 FILE SECTION. 001500 001600 COPY "FDVOUCH.CBL". 001700 001800 WORKING-STORAGE SECTION. 001900 002000 PROCEDURE DIVISION. 002100 PROGRAM-BEGIN. 002200 OPEN OUTPUT VOUCHER-FILE. 002300 CLOSE VOUCHER-FILE. 002400 002500 PROGRAM-EXIT. 002600 EXIT PROGRAM. 002700 002800 PROGRAM-DONE. 002900 STOP RUN. 003000
Edit, compile, and run this program to create the new voucher file.
Before launching into the actual maintenance module, you need to take a look at date handling.
The first problem with dates is storing them. Dates traditionally have been stored as a six-digit number in COBOL data files, either in YYMMDD format or MMDDYY format (in Europe, this is DDMMYY). January 7th, 1994 is stored as 940107 (YYMMDD), 010794 (MMDDYY), or 070194 (DDMMYY).
Storing a date in either MMDDYY or DDMMYY format presents some problems. In Table 19.1, several dates are listed in MMDDYY format and YYMMDD format. Each list contains the same dates. The first list, in MMDDYY format, is sorted correctly in numeric order, but is an incorrect sort for date order. The second list, in YYMMDD format, is sorted correctly as numbers and also is a correct sort for dates.
| Sorted Dates in MMDDYY Format | Sorted Dates in YYMMDD Format |
| 011592 | 870814 |
| 011593 | 870919 |
| 021291 | 880711 |
| 031492 | 890523 |
| 041893 | 900630 |
| 052389 | 910212 |
| 063090 | 911011 |
| 071188 | 920115 |
| 081487 | 920314 |
| 091987 | 921128 |
| 101191 | 930115 |
| 112892 | 930418 |
| 121693 | 931216 |
When the date format is changed to an eight-digit equivalent, MMDDCCYY, the sorting problem remains. Therefore, for the exercises in this book, you should store all dates in CCYYMMDD format so that date order and numeric order are the same.
The second problem is just an extension of the first problem. The approach of the year 2000 has caused a lot of consternation in COBOL circles. There are millions of lines of code currently in use that still use a six-digit date. The continued use of a six-digit date will cause big sorting problems even if the date is stored in YYMMDD format. When the user is looking for records dated between December 1, 1999, and February 28, 2000, the program will be looking at values that are stored as 991201 and 000228, because trying to store a four-digit year of 2000 in a two digit field only allows room for last two digits, 00.
One immediate solution is to start storing dates as eight digits by extending the year to the left and using a CCYYMMDD format where CCYY is a full four-digit year with CC representing the hundreds portion of the year. The voucher file provides for an eight-digit date. This isn't going to handle the millions of lines of code that aren't using four-digit years, but at least it won't compound the problem.
NOTE: When discussing dates in CCYYMMDD or similar formats with anyone, be sure that you understand the date format that he or she is discussing. Some people use CC or C to designate a "century indicator" that might not be an actual two-digit 19 or 20. In one system a zero represents 18, a 1 represents 19, a 2 represents 20, and so on. There are already a confusing number of date standards being propounded by various people. I use CC to indicate the two digits that represent the hundreds of years--18, 19, 20, and so on. Thus, CCYY format is the same as YYYY format.
The date problem for existing programs is covered in Bonus Day 6.
The third problem is formatting dates for display. If the date is stored in CCYYMMDD format, it has to be converted to MM/DD/CCYY format for displaying and printing. The CCYYMMDD format works well for the programmer who can use this format for correct sorting of dates, but users are accustomed to seeing dates as MM/DD/CCYY or MM-DD-CCYY.
You already have used editing characters to modify the way a number displays. Some of the editing characters, such as the comma (,), are inserted into a numeric field to change the way the field appears when it is displayed. Moving a value such as 09456.01 to a PIC ZZ,ZZZ.ZZ results in a display of 9,456.01. The leading zero is suppressed and the comma is inserted.
There is an editing character that was designed specifically for date handling. It is the slant or slash (/). A slash placed in a numeric field causes the field to become an edited field, and the slashes are inserted into any number moved into the field. Listing 19.9 is a code fragment showing the use of an edited numeric field used to display slashes within a date. The display at line 032100 would be 05/15/1997.
011200 77 FORMATTED-DATE PIC 99/99/9999. 032000 MOVE 05151997 TO FORMATTED-DATE. 032100 DISPLAY FORMATTED-DATE.
Zero suppression can be used in an edited date field, as shown in Listing 19.10. The output of this example would be 5/15/1997, with the leading zero suppressed.
011200 77 FORMATTED-DATE PIC Z9/99/9999. 032000 MOVE 05151997 TO FORMATTED-DATE. 032100 DISPLAY FORMATTED-DATE.
The use of a simple edited field will add in the slashes, but both of the dates used in Listings 19.9 and 19.10 are in MMDDCCYY format. Listing 19.11 converts a date in CCYYMMDD format to MMDDCCYY, and then moves it to an edited field.
011200 77 FORMATTED-DATE PIC Z9/99/9999. 011300 77 DATE-CCYYMMDD PIC 9(8). 011400 77 DATE-MMDDCCYY PIC 9(8). 031900 MOVE 19970515 TO DATE-CCYYMMDD. 032000 COMPUTE DATE-MMDDCCYY = 032100 DATE-CCYYMMDD * 10000.0001 032200 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 032300 DISPLAY FORMATTED-DATE.
ANALYSIS: The formatted (edited) date field is defined at line 011200. Two separate PIC 9(8) variables are defined to hold the date in CCYYMMDD and MMDDCCYY at lines 011300 and 011400, respectively.
The code fragment at line 031900 starts by moving May 15, 1997, in CCYYMMDD format, to the appropriate variable.
The COMPUTE command is used to multiply DATE-CCYYMMDD by 10000.0001 and store the result in DATE-MMDDCCYY. This trick is used to convert the date.
The date starts out as 19970515. Multiplying it by 10000.0001 results in 199705151997, a 12-digit number. The COMPUTE command stores the result in DATE-MMDDCCYY, which is only eight digits long. Numeric variables are truncated on the left, so the initial 1997 is lost, leaving 05151997, which is the correct value for an MMDDCCYY format.
The fourth problem with dates concerns the data entry format versus the storage format, which is partly the reverse of the date display. Users still are accustomed to entering dates as MM/DD/YY, and as the new century approaches, they may have to get used to entering values as MM/DD/CCYY. This format includes characters that are not stored in the file (the slashes), and the parts of the date are not arranged correctly for CCYYMMDD storage. An entry of MM/DD/CCYY has to be converted to CCYYMMDD to be stored correctly.
The easiest solution is to use a formatted date field as the data entry field, an example of which appears in Listing 19.12.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. DATE01. 000300*-------------------------------- 000400* Demo of Date Entry 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 DATE-ENTRY-FIELD PIC Z9/99/9999. 001600 77 DATE-MMDDCCYY PIC 9(8). 001700 77 DATE-CCYYMMDD PIC 9(8). 001800 001900 PROCEDURE DIVISION. 002000 PROGRAM-BEGIN. 002100 PERFORM OPENING-PROCEDURE. 002200 PERFORM MAIN-PROCESS. 002300 PERFORM CLOSING-PROCEDURE. 002400 002500 PROGRAM-EXIT. 002600 EXIT PROGRAM. 002700 002800 PROGRAM-DONE. 002900 STOP RUN. 003000 003100 OPENING-PROCEDURE. 003200 003300 CLOSING-PROCEDURE. 003400 003500 MAIN-PROCESS. 003600 PERFORM GET-A-DATE. 003700 PERFORM DISPLAY-AND-GET-DATE 003800 UNTIL DATE-MMDDCCYY = ZEROES. 003900 004000 GET-A-DATE. 004100 DISPLAY "ENTER A DATE (MM/DD/CCYY)". 004200 ACCEPT DATE-ENTRY-FIELD. 004300 MOVE DATE-ENTRY-FIELD TO DATE-MMDDCCYY. 004400 COMPUTE DATE-CCYYMMDD = 004500 DATE-MMDDCCYY * 10000.0001. 004600 004700 DISPLAY-AND-GET-DATE. 004800 PERFORM DISPLAY-A-DATE. 004900 PERFORM GET-A-DATE. 005000 005100 DISPLAY-A-DATE. 005200 MOVE DATE-MMDDCCYY TO DATE-ENTRY-FIELD. 000300 DISPLAY "FORMATTED DATE IS " DATE-ENTRY-FIELD. 005400 DISPLAY "DATE-MMDDCCYY IS " DATE-MMDDCCYY. 005500 DISPLAY "DATE-CCYYMMDD IS " DATE-CCYYMMDD. 005600
ANALYSIS: Using the formatted date field defined at line 001500 for data entry allows the user to enter any eight digits, including optional slashes at line 004200 in the ACCEPT command.
The user can enter 01/22/1996 or 01221996, and either version is stored in DATE-MMDDCCYY as 01221996. That takes care of enabling the user to enter a date including slashes.
Some COBOL compilers will require that line 004300 read: MOVE WITH CONVERSION DATA-ENTRY-FIELD TO DATE-MMDDCCYY.
At lines 004400 and 004500, the same conversion trick is used to convert DATE-MMDDCCYY to DATE-CCYYMMDD. Try it out with a pencil and paper, and you will see that multiplying an eight-digit number by 10,000.0001, and then truncating the twelve-digit answer from the left to eight digits has the effect of swapping the left and right four digits of the eight-digit number.
At line 005100, the DISPLAY-A-DATE routine displays the various date formats.
Code, compile, and run date01.cbl and enter various valid eight-digit dates, with and without slashes. You will see the effect of using an edited field for the data entry.
Run date01.cbl and enter some invalid dates, such as 12345 (not eight digits), or 31/64/2219 (month and day are both invalid). The date01.cbl program accepts these without question, because as far as date01.cbl is concerned it is accepting numbers that happen to have slashes in them. In order to ensure that the date is valid, you are going to have to do some work in the program.
In order to validate a date, you need to be able to take the date (either DATE-CCYYMMDD or DATE-MMDDCCYY) and break it into month, day, and year, and then validate each part of the date.
It seems at first glance that Listing 19.13 does the job, but there is a problem with this method of defining a date field. In Listing 19.13, DATE-CC represents the hundreds of years.
001100 01 DATE-CCYYMMDD. 001200 05 DATE-CC PIC 99. 001300 05 DATE-YY PIC 99. 001400 05 DATE-MM PIC 99. 001500 05 DATE-DD PIC 99.
In order to understand this problem, it is necessary to take another look at structure variables. Recall that when variables are going to be used as a group, they can be combined into a single variable called a structure or a record. A structure or record is a variable containing one or more COBOL variables. In Listing 19.14, the variable named ALL-THE-VARIABLES contains the three variables 1ST-NUMBER, 2ND-NUMBER, and 3RD-NUMBER. ALL-THE-VARIABLES is a structure.
000900 01 ALL-THE-VARIABLES. 001000 05 1ST-NUMBER PIC 99. 001100 05 2ND-NUMBER PIC 99. 001200 05 3RD-NUMBER PIC 99.
ANALYSIS: Listing 19.14 actually defines six bytes of memory that contain four variables: 1ST-NUMBER, 2ND-NUMBER, 3RD-NUMBER, and ALL-THE-VARIABLES.
1ST-NUMBER is two bytes long and is designed to hold a PIC 99. 2ND-NUMBER and 3RD-NUMBER also are designed to hold two-byte numbers. This is a total of six bytes.
The structure variable itself, ALL-THE-VARIABLES, is six bytes long and occupies the same six bytes as 1ST-NUMBER, 2ND-NUMBER, and 3RD-NUMBER.
When a structure variable is created, it doesn't matter what the pictures of the subordinate variables are. COBOL forces the structure variable to have an alphanumeric data type.
Because of the way COBOL treats structure variables, ALL-THE-VARIABLES has an implied alphanumeric data type, so its picture becomes PIC X(6).
In effect, line 000900 defines a six-byte variable with a PICTURE of X(6), and lines 001000 through 001200 redefine those six bytes as three variables each with a PICTURE of 99.
In COBOL, this redefinition occurs in any structure variable. The structure variable has an implied picture of PIC X(some number), and the subordinate variables can have numeric pictures.
At this point you might want to review Day 8, "Structured Data," which presents the organization of a structure variable in some detail.
In Listing 19.15, which is a repeat of the problem posed in Listing 19.13 (a date broken into separate elements), DATE-CCYYMMDD is an alphanumeric variable with a picture of PIC X(8), even though the individual parts are all PIC 99 fields. You need each of the individual parts of DATE-CCYYMMDD to have a PIC 99, but you also need DATE-CCYYMMDD to be numeric with a picture of PIC 9(8).
001100 01 DATE-CCYYMMDD. 001200 05 DATE-CC PIC 99. 001300 05 DATE-YY PIC 99. 001400 05 DATE-MM PIC 99. 001500 05 DATE-DD PIC 99.
In COBOL, it is possible to create a variable that specifically redefines another variable. Listing 19.16 is an example of how this is done.
001100 01 AN-X-FIELD PIC X(6). 001200 01 A-9-FIELD REDEFINES 001300 AN-X-FIELD PIC 9(6).
ANALYSIS: In Listing 19.16, the variable defined at lines 001200 and 001300 is a redefinition of the variable defined at line 001100. The variable at line 001100 defines a six-byte variable that is used for alphanumeric data. The variable at lines 001200 and 001300 redefines the same six bytes as a variable to be used for numeric data.
In Listing 19.15, you end up with DATE-CCYYMMDD as a PIC X(8), but you really want it to be a PIC 9(8). You can use a REDEFINES to create that situation. A REDEFINES can be used to redefine any variable, even a structure variable, as shown in Listing 19.17.
001100 01 A-DATE. 001200 05 DATE-CC PIC 99. 001300 05 DATE-YY PIC 99. 001400 05 DATE-MM PIC 99. 001500 05 DATE-DD PIC 99. 001600 01 DATE-CCYYMMDD REDEFINES 001700 A-DATE PIC 9(8).
ANALYSIS: Lines 001100 through 001500 define a structure variable named A-DATE containing four variables that are each a PIC 99. A-DATE will become a PIC X(8). A-DATE is of little use, so the name used for the variable is unimportant.
At lines 001600 and 001700, the eight-byte variable A-DATE is redefined as a PIC 9(8) variable with the name DATE-CCYYMMDD. This redefinition creates the effect that you want. DATE-CCYYMMDD is a numeric variable with a picture of PIC 9(8). Each of the parts of the date is also numeric, having pictures of PIC 99.
If you move the value 19970315 to DATE-CCYYMMDD, the eight bytes of memory will contain the values for the number 19970315.
A-DATE will contain those eight bytes as "19970315", which are the same bytes but interpreted as characters. DATE-CC will contain two bytes: the number 19. DATE-YY will contain two bytes: the number 97. DATE-MM will contain two bytes: the number 03. DATE-DD will contain two bytes: the number 15.
In the preceding example, a structure variable A-DATE is redefined as an elementary (nonstructured) variable called DATE-CCYYMMDD. A-DATE is the redefined variable and DATE-CCYYMMDD is the redefining variable.
In a redefinition, either or both of the redefined and redefining variables can be structure variables.
In Listing 19.18, the positions of the two variables are reversed. DATE-CCYYMMDD becomes the redefined variable, and it is redefined with the structure variable, A-DATE. A-DATE is then broken into its elementary variables.
001600 01 DATE-CCYYMMDD PIC 9(8). 001700 01 A-DATE REDEFINES DATE-CCYYMMDD. 001800 05 DATE-CC PIC 99. 001900 05 DATE-YY PIC 99. 002000 05 DATE-MM PIC 99. 002100 05 DATE-DD PIC 99.
A variable can be redefined by using the COBOL REDEFINES command. The redefined variable and the redefining variable must have the same level number.
The redefining variable must not have a length longer than the redefined variable. The compiler would complain about the example in Listing 19.19 because DATE-CCYYMMDD on line 001600 is only six bytes long, but A-DATE is 8 bytes long.
001600 01 DATE-CCYYMMDD PIC 9(6). 001700 01 A-DATE REDEFINES DATE-CCYYMMDD. 001800 05 DATE-CC PIC 99. 001900 05 DATE-YY PIC 99. 002000 05 DATE-MM PIC 99. 002100 05 DATE-DD PIC 99.
There is one more step you need to take to complete the redefinition of the date fields. A-DATE will never be used. All you want is the numeric versions of DATE-CCYYMMDD, DATE-CC, DATE-YY, and so on. Therefore, A-DATE can be converted to a FILLER as in Listing 19.20.
001600 01 DATE-CCYYMMDD PIC 9(8). 001700 01 FILLER REDEFINES DATE-CCYYMMDD. 001800 05 DATE-CC PIC 99. 001900 05 DATE-YY PIC 99. 002000 05 DATE-MM PIC 99. 002100 05 DATE-DD PIC 99.
Date validation is the process of taking a date apart and checking that the parts are valid. Listing 19.21, date02.cbl, includes a date validation routine.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. DATE02. 000300*--------------------------------- 000400* Demo of Date Entry and validation 000500*--------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 DATE-ENTRY-FIELD PIC Z9/99/9999. 001600 77 DATE-MMDDCCYY PIC 9(8). 001700 77 DATE-QUOTIENT PIC 9999. 001800 77 DATE-REMAINDER PIC 9999. 001900 002000 77 VALID-DATE-FLAG PIC X. 002100 88 DATE-IS-INVALID VALUE "N". 002200 88 DATE-IS-ZERO VALUE "0". 002300 88 DATE-IS-VALID VALUE "Y". 002400 88 DATE-IS-OK VALUES "Y" "0". 002500 002600 01 DATE-CCYYMMDD PIC 9(8). 002700 01 FILLER REDEFINES DATE-CCYYMMDD. 002800 05 DATE-CCYY PIC 9999. 002900 05 DATE-MM PIC 99. 003000 05 DATE-DD PIC 99. 003100 003200 003300 PROCEDURE DIVISION. 003400 PROGRAM-BEGIN. 003500 PERFORM OPENING-PROCEDURE. 003600 PERFORM MAIN-PROCESS. 003700 PERFORM CLOSING-PROCEDURE. 003800 003900 PROGRAM-EXIT. 004000 EXIT PROGRAM. 004100 004200 PROGRAM-DONE. 004300 STOP RUN. 004400 004500 OPENING-PROCEDURE. 004600 004700 CLOSING-PROCEDURE. 004800 004900 MAIN-PROCESS. 005000 PERFORM GET-A-DATE. 005100 PERFORM DISPLAY-AND-GET-DATE 005200 UNTIL DATE-MMDDCCYY = ZEROES. 005300 005400 GET-A-DATE. 005500 PERFORM ACCEPT-A-DATE. 005600 PERFORM RE-ACCEPT-A-DATE 005700 UNTIL DATE-IS-OK. 005800 005900 ACCEPT-A-DATE. 006000 DISPLAY "ENTER A DATE (MM/DD/CCYY)". 006100 ACCEPT DATE-ENTRY-FIELD. 006200 006300 PERFORM EDIT-CHECK-DATE. 006400 006500 RE-ACCEPT-A-DATE. 006600 DISPLAY "INVALID DATE". 006700 PERFORM ACCEPT-A-DATE. 006800 006900 EDIT-CHECK-DATE. 007000 PERFORM EDIT-DATE. 007100 PERFORM CHECK-DATE. 007200 007300 EDIT-DATE. 007400 MOVE DATE-ENTRY-FIELD TO DATE-MMDDCCYY. 007500 COMPUTE DATE-CCYYMMDD = 007600 DATE-MMDDCCYY * 10000.0001. 007700 007800*--------------------------------- 007900* Assume that the date is good, then 008000* test the date in the following 008100* steps. The routine stops if any 008200* of these conditions is true, 008300* and sets the valid date flag. 008400* Condition 1 returns the valid date 008500* flag set to "0". 008600* If any other condition is true, 008700* the valid date flag is set to "N". 008800* 1. Is the date zeroes 008900* 2. Month > 12 or < 1 009000* 3. Day < 1 or > 31 009100* 4. Day > 30 and 009200* Month = 2 (February) or 009300* 4 (April) or 009400* 6 (June) or 009500* 9 (September) or 009600* 11 (November) 009700* Day > 29 and 009800* Month = 2 (February) 009900* 5. Day = 29 and Month = 2 and 010000* Not a leap year 010100* ( A leap year is any year evenly 010200* divisible by 4, but does not 010300* end in 00 and that is 010400* not evenly divisible by 400). 010500*--------------------------------- 010600 CHECK-DATE. 010700 MOVE "Y" TO VALID-DATE-FLAG. 010800 PERFORM CHECK-IF-DATE-ZEROES. 010900 IF DATE-IS-VALID 011000 PERFORM CHECK-MM. 011100 IF DATE-IS-VALID 011200 PERFORM CHECK-DD. 011300 IF DATE-IS-VALID 011400 PERFORM CHECK-MMDD. 011500 IF DATE-IS-VALID 011600 PERFORM CHECK-LEAP-YEAR. 011700 011800 CHECK-IF-DATE-ZEROES. 011900 IF DATE-CCYYMMDD = ZEROES 012000 MOVE "0" TO VALID-DATE-FLAG. 012100 012200 CHECK-MM. 012300 IF DATE-MM < 1 OR DATE-MM > 12 012400 MOVE "N" TO VALID-DATE-FLAG. 012500 012600 CHECK-DD. 012700 IF DATE-DD < 1 OR DATE-DD > 31 012800 MOVE "N" TO VALID-DATE-FLAG. 012900 013000 CHECK-MMDD. 013100 IF (DATE-DD > 30) AND 013200 (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11) 013300 MOVE "N" TO VALID-DATE-FLAG 013400 ELSE 013500 IF DATE-DD > 29 AND DATE-MM = 2 013600 MOVE "N" TO VALID-DATE-FLAG. 013700 013800 CHECK-LEAP-YEAR. 013900 IF DATE-DD = 29 AND DATE-MM = 2 014000 DIVIDE DATE-CCYY BY 400 GIVING DATE-QUOTIENT 014100 REMAINDER DATE-REMAINDER 014200 IF DATE-REMAINDER = 0 014300 MOVE "Y" TO VALID-DATE-FLAG 014400 ELSE 014500 DIVIDE DATE-CCYY BY 100 GIVING DATE-QUOTIENT 014600 REMAINDER DATE-REMAINDER 014700 IF DATE-REMAINDER = 0 014800 MOVE "N" TO VALID-DATE-FLAG 014900 ELSE 015000 DIVIDE DATE-CCYY BY 4 GIVING DATE-QUOTIENT 015100 REMAINDER DATE-REMAINDER 015200 IF DATE-REMAINDER = 0 015300 MOVE "Y" TO VALID-DATE-FLAG 015400 ELSE 015500 MOVE "N" TO VALID-DATE-FLAG. 015600 015700 DISPLAY-AND-GET-DATE. 015800 PERFORM DISPLAY-A-DATE. 015900 PERFORM GET-A-DATE. 016000 016100 DISPLAY-A-DATE. 016200 MOVE DATE-MMDDCCYY TO DATE-ENTRY-FIELD. 016300 DISPLAY "FORMATTED DATE IS " DATE-ENTRY-FIELD. 016400 DISPLAY "DATE-MMDDCCYY IS " DATE-MMDDCCYY. 016500 DISPLAY "DATE-CCYYMMDD IS " DATE-CCYYMMDD. 016600
ANALYSIS: The date-validation routine in Listing 19.21 has been created to be reasonably flexible. In working storage at lines 001700 and 001800, DATE-QUOTIENT and DATE-REMAINDER have been defined. These will be used in the date validation as part of the logic to check for a leap year.
At line 002000, the VALID-DATE-FLAG is defined. This flag is used to hold the result of the validation. It has three possible result values, which are defined with level 88 entries at lines 002100 through 002300. If the date is in error, the flag is set to "N". If the date is valid, the flag is set to "Y". If the date is zero, the flag is set to "0", which allows for a general-purpose date validation that will allow a zero date entry. In some fields, it might be okay to enter a date with a value of zero, so the two entries that are possibly okay, "0" and "Y", are defined with a level 88 at line 002400.
At line 002600, the DATE-CCYYMMDD variable is defined as a PIC 9(8). These eight bytes are redefined at lines 002700 through 003100 into four two-byte numeric fields.
The GET-A-DATE routine begins at line 005400 and is a standard field-entry routine that performs ACCEPT-A-DATE and then performs RE-ACCEPT-A-DATE until DATE-IS-OK.
ACCEPT-A-DATE at line 005900 displays a prompt, accepts the entry field, and then performs the edit check EDIT-CHECK-DATE. The editing logic at line 007300, EDIT-DATE, moves the entered field to DATE-MMDDCCYY and then converts this to DATE-CCYYMMDD.
It is the date validation logic that is extensive. It begins at line 007800 with a long comment explaining how the routine works.
The routine CHECK-DATE starts at line 010600. The routine assumes that DATE-CCYYMMDD has been filled in with the date to test (this was taken care of at lines 007500 and 007600) and that the date is valid. The routine moves "Y" to the VALID-DATE-FLAG.
The routine is a series of tests on the date. If any tested condition is true, there is something wrong with the date. The VALID-DATE-FLAG flag is set accordingly and the PERFORM commands in the rest of the paragraph are skipped.
There are three possible conditions for the date: valid, invalid, or zero. Zero is checked first at line 011900, and if the date is zero, the VALID-DATE-FLAG is set to "0" and the remainder of the paragraph is ignored.
If the date passes the zero test, a series of possible invalid conditions are tested.
At line 012200, CHECK-MM checks for an invalid month. At line 012600, CHECK-DD checks for an invalid day.
At line 013000, CHECK-MMDD begins checking for an invalid month and day combination, which is a day greater than 30 with a month that does not contain 31 days, or a day greater than 29 for the month of February.
The CHECK-LEAP-YEAR routine at line 013800 tests for a leap year when the date is February 29. A leap year is any year that is evenly divisible by 4, but not evenly divisible by 100, unless it is divisible by 400. The divisibility tests begin at lines 014000 and 014100, which perform the tests in what seems an upside down manner. The routine tests for a leap year by performing a series of divisions, and saving the results in DATE-QUOTIENT, and the remainder in DATE-REMAINDER. You don't care about the value in DATE-REMAINDER. First the routine tests if the year is evenly divisible by 400. If it is, then it is definitely a leap year. If the year is not evenly divisible by 400, then it is tested to see if it is evenly divisible by 100. If it is, then the year is definitely not a leap year. The final check tests by dividing the year by 4. Trying to come up with different ways to test for a leap year is a good exercise that you should try.
As long as DATE-CCYYMMDD passes each test, the VALID-DATE-FLAG remains "Y"; any other condition changes the flag.
As is the case with any programming problem, there usually is more than one way to skin a cat. Listing 19.22 is extracted from date02.cbl, and some changes are made to the CHECK-DATE logic.
005100*--------------------------- 005200* PLDATE.CBL 005300*--------------------------- 005400 GET-A-DATE. 005500 PERFORM ACCEPT-A-DATE. 005600 PERFORM RE-ACCEPT-A-DATE 005700 UNTIL DATE-IS-OK. 005800 005900 ACCEPT-A-DATE. 006000 DISPLAY "ENTER A DATE (MM/DD/CCYY)". 006100 ACCEPT DATE-ENTRY-FIELD. 006200 006300 PERFORM EDIT-CHECK-DATE. 006400 006500 RE-ACCEPT-A-DATE. 006600 DISPLAY "INVALID DATE". 006700 PERFORM ACCEPT-A-DATE. 006800 006900 EDIT-CHECK-DATE. 007000 PERFORM EDIT-DATE. 007100 PERFORM CHECK-DATE. 007200 007300 EDIT-DATE. 007400 MOVE DATE-ENTRY-FIELD TO DATE-MMDDCCYY. 007500 COMPUTE DATE-CCYYMMDD = 007600 DATE-MMDDCCYY * 10000.0001. 007700 007800*--------------------------------- 007900* Assume that the date is good, then 008000* test the date in the following 008100* steps. The routine stops if any 008200* of these conditions is true, 008300* and sets the valid date flag. 008400* Condition 1 returns the valid date 008500* flag set to "0". 008600* If any other condition is true, 008700* the valid date flag is set to "N". 008800* 1. Is the date zeroes 008900* 2. Month > 12 or < 1 009000* 3. Day < 1 or > 31 009100* 4. Day > 30 and 009200* Month = 2 (February) or 009300* 4 (April) or 009400* 6 (June) or 009500* 9 (September) or 009600* 11 (November) 009700* Day > 29 and 009800* Month = 2 (February) 009900* 5. Day = 29 and 010000* Month = 2 and 010100* Not a leap year 010200* ( A leap year is any year evenly 010300* divisible by 400 or by 4 010400* but not by 100 ). 010500*--------------------------------- 010600 CHECK-DATE. 010700 MOVE "Y" TO VALID-DATE-FLAG. 010800 IF DATE-CCYYMMDD = ZEROES 010900 MOVE "0" TO VALID-DATE-FLAG 011000 ELSE 011100 IF DATE-MM < 1 OR DATE-MM > 12 011200 MOVE "N" TO VALID-DATE-FLAG 011300 ELSE 011400 IF DATE-DD < 1 OR DATE-DD > 31 011500 MOVE "N" TO VALID-DATE-FLAG 011600 ELSE 011700 IF (DATE-DD > 30) AND 011800 (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11) 011900 MOVE "N" TO VALID-DATE-FLAG 012000 ELSE 012100 IF DATE-DD > 29 AND DATE-MM = 2 012200 MOVE "N" TO VALID-DATE-FLAG 012300 ELSE 012400 IF DATE-DD = 29 AND DATE-MM = 2 012500 DIVIDE DATE-CCYY BY 400 GIVING DATE-QUOTIENT 012600 REMAINDER DATE-REMAINDER 012700 IF DATE-REMAINDER = 0 012800 MOVE "Y" TO VALID-DATE-FLAG 012900 ELSE 013000 DIVIDE DATE-CCYY BY 100 GIVING DATE-QUOTIENT 013100 REMAINDER DATE-REMAINDER 013200 IF DATE-REMAINDER = 0 013300 MOVE "N" TO VALID-DATE-FLAG 013400 ELSE 013500 DIVIDE DATE-CCYY BY 4 GIVING DATE-QUOTIENT 013600 REMAINDER DATE-REMAINDER 013700 IF DATE-REMAINDER = 0 013800 MOVE "Y" TO VALID-DATE-FLAG 013900 ELSE 014000 MOVE "N" TO VALID-DATE-FLAG. 014100
ANALYSIS: The logic that appears at lines 010600 through 015600 in date02.cbl has been reduced to a single paragraph in Listing 19.22. The routine is a long series of IF ELSE tests. If any tested condition is true, there is something wrong with the date. The VALID-DATE-FLAG flag is set accordingly and the rest of the paragraph is skipped.
Date validation involves a great deal of code. It would be a lot of work to have to rewrite all of this code every time a date popped up in a program, so it seems that date handling could or should be put into a COPY file.
So far you have put values for a file definition or WORKING-STORAGE only into a COPY file, but it also is possible to put PROCEDURE DIVISION paragraphs and logic into COPY files.
The whole of Listing 19.22 can be copied into a file called pldate.cbl (the pl stands for program logic), and this creates the program logic needed to validate dates. Then copy lines 001500 through 003100 of Listing 19.21, date02.cbl, into a file called wsdate.cbl. This creates the needed WORKING-STORAGE. Listing 19.23, date04.cbl, is now all you need to create the same date-entry and validation programs date01.cbl. This gives you a routine that can be used for entering a date in any program.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. DATE04. 000300*-------------------------------- 000400* Demo of Date Entry and validation 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 COPY "WSDATE.CBL". 001600 001700 PROCEDURE DIVISION. 001800 PROGRAM-BEGIN. 001900 PERFORM OPENING-PROCEDURE. 002000 PERFORM MAIN-PROCESS. 002100 PERFORM CLOSING-PROCEDURE. 002200 002300 PROGRAM-EXIT. 002400 EXIT PROGRAM. 002500 002600 PROGRAM-DONE. 002700 STOP RUN. 002800 002900 OPENING-PROCEDURE. 003000 003100 CLOSING-PROCEDURE. 003200 003300 MAIN-PROCESS. 003400 PERFORM GET-A-DATE. 003500 PERFORM DISPLAY-AND-GET-DATE 003600 UNTIL DATE-MMDDCCYY = ZEROES. 003700 003800 COPY "PLDATE.CBL". 003900 004000 DISPLAY-AND-GET-DATE. 004100 PERFORM DISPLAY-A-DATE. 004200 PERFORM GET-A-DATE. 004300 004400 DISPLAY-A-DATE. 004500 MOVE DATE-MMDDCCYY TO DATE-ENTRY-FIELD. 004600 DISPLAY "FORMATTED DATE IS " DATE-ENTRY-FIELD. 004700 DISPLAY "DATE-MMDDCCYY IS " DATE-MMDDCCYY. 004800 DISPLAY "DATE-CCYYMMDD IS " DATE-CCYYMMDD. 004900
This code is almost, but not quite, adequate. The GET-A-DATE routine, which would end up being included within pldate.cbl, has a problem that makes it unsuitable as a general-purpose, date-entry routine: It isn't flexible enough. At line 006000 in Listing 19.22, the prompt for a date is forced to be "ENTER A DATE (MM/DD/CCYY)". You might want the user to see a different prompt, such as "ENTER THE INVOICE DATE (MM/DD/CCYY)".
At line 005700, the reaccept logic is performed until DATE-IS-OK. This allows an entry of zeroes, but you might have date fields that are required entries and cannot allow the user to enter zeroes.
Both of these "inflexible" situations are fine for date04.cbl, but this will not be the case for all date entry.
The way to handle these problems is to build the flexibility into the WORKING-STORAGE and program logic for date handling, and then create the COPY files containing the routines.
Listing 19.24, date05.cbl, has isolated a date-entry routine as well as other different types of date handling routines. The date05.cbl is written as a test program only to test these date routines. After they are tested, the WORKING-STORAGE and program logic can be extracted into COPY files.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. DATE05. 000300*--------------------------------- 000400* Testing Date Entry and handling 000500*--------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 ANY-DATE PIC 9(8) VALUE ZEROES. 001600 77 REQUIRED-DATE PIC 9(8) VALUE ZEROES. 001700 001800*--------------------------------- 001900* Fields for date routines. 002000*--------------------------------- 002100 77 FORMATTED-DATE PIC Z9/99/9999. 002200 77 DATE-MMDDCCYY PIC 9(8). 002300 77 DATE-QUOTIENT PIC 9999. 002400 77 DATE-REMAINDER PIC 9999. 002500 002600 77 VALID-DATE-FLAG PIC X. 002700 88 DATE-IS-INVALID VALUE "N". 002800 88 DATE-IS-ZERO VALUE "0". 002900 88 DATE-IS-VALID VALUE "Y". 003000 88 DATE-IS-OK VALUES "Y" "0". 003100 003200 01 DATE-CCYYMMDD PIC 9(8). 003300 01 FILLER REDEFINES DATE-CCYYMMDD. 003400 05 DATE-CCYY PIC 9999. 003500 003600 05 DATE-MM PIC 99. 003700 05 DATE-DD PIC 99. 003800 003900*--------------------------------- 004000* User can set these values before 004100* performing GET-A-DATE. 004200*--------------------------------- 004300 77 DATE-PROMPT PIC X(50) VALUE SPACE. 004400 77 DATE-ERROR-MESSAGE PIC X(50) VALUE SPACE. 004500*--------------------------------- 004600* User can set this value before 004700* performing GET-A-DATE or CHECK-DATE. 004800*--------------------------------- 004900 77 ZERO-DATE-IS-OK PIC X VALUE "N". 005000 005100 PROCEDURE DIVISION. 005200 PROGRAM-BEGIN. 005300 PERFORM OPENING-PROCEDURE. 005400 PERFORM MAIN-PROCESS. 005500 PERFORM CLOSING-PROCEDURE. 005600 005700 PROGRAM-EXIT. 005800 EXIT PROGRAM. 005900 006000 PROGRAM-DONE. 006100 STOP RUN. 006200 006300 OPENING-PROCEDURE. 006400 006500 CLOSING-PROCEDURE. 006600 006700 MAIN-PROCESS. 006800 PERFORM GET-TWO-DATES. 006900 PERFORM DISPLAY-AND-GET-DATES 007000 UNTIL REQUIRED-DATE = 00010101. 007100 007200 GET-TWO-DATES. 007300 PERFORM GET-ANY-DATE. 007400 PERFORM GET-REQUIRED-DATE. 007500 007600 GET-ANY-DATE. 007700 MOVE "Y" TO ZERO-DATE-IS-OK. 007800 MOVE "ENTER AN OPTIONAL MM/DD/CCYY?" TO DATE-PROMPT. 007900 MOVE "MUST BE ANY VALID DATE" TO DATE-ERROR-MESSAGE. 008000 PERFORM GET-A-DATE. 008100 MOVE DATE-CCYYMMDD TO ANY-DATE. 008200 008300 GET-REQUIRED-DATE. 008400 MOVE "N" TO ZERO-DATE-IS-OK. 008500 MOVE SPACE TO DATE-PROMPT. 008600 MOVE "MUST ENTER A VALID DATE" TO DATE-ERROR-MESSAGE. 008700 PERFORM GET-A-DATE. 008800 MOVE DATE-CCYYMMDD TO REQUIRED-DATE. 008900 009000 DISPLAY-AND-GET-DATES. 009100 PERFORM DISPLAY-THE-DATES. 009200 PERFORM GET-TWO-DATES. 009300 009400 DISPLAY-THE-DATES. 009500 MOVE ANY-DATE TO DATE-CCYYMMDD. 009600 PERFORM FORMAT-THE-DATE. 009700 DISPLAY "ANY DATE IS " FORMATTED-DATE. 009800 MOVE REQUIRED-DATE TO DATE-CCYYMMDD. 009900 PERFORM FORMAT-THE-DATE. 010000 DISPLAY "REQUIRED DATE IS " FORMATTED-DATE. 010100 010200*--------------------------------- 010300* USAGE: 010400* MOVE "Y" (OR "N") TO ZERO-DATE-IS-OK. (optional) 010500* MOVE prompt TO DATE-PROMPT. (optional) 010600* MOVE message TO DATE-ERROR-MESSAGE (optional) 010700* PERFORM GET-A-DATE 010800* RETURNS: 010900* DATE-IS-OK (ZERO OR VALID) 011000* DATE-IS-VALID (VALID) 011100* DATE-IS-INVALID (BAD DATE ) 011200* 011300* IF DATE IS VALID IT IS IN 011400* DATE-CCYYMMDD AND 011500* DATE-MMDDCCYY AND 011600* FORMATTED-DATE (formatted) 011700*--------------------------------- 011800 GET-A-DATE. 011900 PERFORM ACCEPT-A-DATE. 012000 PERFORM RE-ACCEPT-A-DATE 012100 UNTIL DATE-IS-OK. 012200 012300 ACCEPT-A-DATE. 012400 IF DATE-PROMPT = SPACE 012500 DISPLAY "ENTER A DATE (MM/DD/CCYY)" 012600 ELSE 012700 DISPLAY DATE-PROMPT. 012800 012900 ACCEPT FORMATTED-DATE. 013000 013100 PERFORM EDIT-CHECK-DATE. 013200 013300 RE-ACCEPT-A-DATE. 013400 IF DATE-ERROR-MESSAGE = SPACE 013500 DISPLAY "INVALID DATE" 013600 ELSE 013700 DISPLAY DATE-ERROR-MESSAGE. 013800 013900 PERFORM ACCEPT-A-DATE. 014000 014100 EDIT-CHECK-DATE. 014200 PERFORM EDIT-DATE. 014300 PERFORM CHECK-DATE. 014400 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 014500 014600 EDIT-DATE. 014700 MOVE FORMATTED-DATE TO DATE-MMDDCCYY. 014800 PERFORM CONVERT-TO-CCYYMMDD. 014900 015000*--------------------------------- 015100* USAGE: 015200* MOVE date(CCYYMMDD) TO DATE-CCYYMMDD. 015300* PERFORM CONVERT-TO-MMDDCCYY. 015400* 015500* RETURNS: 015600* DATE-MMDDCCYY. 015700*--------------------------------- 015800 CONVERT-TO-MMDDCCYY. 015900 COMPUTE DATE-MMDDCCYY = 016000 DATE-CCYYMMDD * 10000.0001. 016100 016200*--------------------------------- 016300* USAGE: 016400* MOVE date(MMDDCCYY) TO DATE-MMDDCCYY. 016500* PERFORM CONVERT-TO-CCYYMMDD. 016600* 016700* RETURNS: 016800* DATE-CCYYMMDD. 016900*--------------------------------- 017000 CONVERT-TO-CCYYMMDD. 017100 COMPUTE DATE-CCYYMMDD = 017200 DATE-MMDDCCYY * 10000.0001. 017300 017400*--------------------------------- 017500* USAGE: 017600* MOVE date(CCYYMMDD) TO DATE-CCYYMMDD. 017700* MOVE "Y" (OR "N") TO ZERO-DATE-IS-OK. 017800* PERFORM CHECK-DATE. 017900* 018000* RETURNS: 018100* DATE-IS-OK (ZERO OR VALID) 018200* DATE-IS-VALID (VALID) 018300* DATE-IS-INVALID (BAD DATE ) 018400* 018500* Assume that the date is good, then 018600* test the date in the following 018700* steps. The routine stops if any 018800* of these conditions is true, 018900* and sets the valid date flag. 019000* Condition 1 returns the valid date 019100* flag set to "0" if ZERO-DATE-IS-OK 019200* is "Y", otherwise it sets the 019300* valid date flag to "N". 019400* If any other condition is true, 019500* the valid date flag is set to "N". 019600* 1. Is the date zeroes 019700* 2. Month > 12 or < 1 019800* 3. Day < 1 or > 31 019900* 4. Day > 30 and 020000* Month = 2 (February) or 020100* 4 (April) or 020200* 6 (June) or 020300* 9 (September) or 020400* 11 (November) 020500* Day > 29 and 020600* Month = 2 (February) 020700* 5. Day = 29 and 020800* Month = 2 and 020900* Not a leap year 021000* ( A leap year is any year evenly 021100* divisible by 400 or by 4 021200* but not by 100 ). 021300*--------------------------------- 021400 CHECK-DATE. 021500 MOVE "Y" TO VALID-DATE-FLAG. 021600 IF DATE-CCYYMMDD = ZEROES 021700 IF ZERO-DATE-IS-OK = "Y" 021800 MOVE "0" TO VALID-DATE-FLAG 021900 ELSE 022000 MOVE "N" TO VALID-DATE-FLAG 022100 ELSE 022200 IF DATE-MM < 1 OR DATE-MM > 12 022300 MOVE "N" TO VALID-DATE-FLAG 022400 ELSE 022500 IF DATE-DD < 1 OR DATE-DD > 31 022600 MOVE "N" TO VALID-DATE-FLAG 022700 ELSE 022800 IF (DATE-DD > 30) AND 022900 (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11) 023000 MOVE "N" TO VALID-DATE-FLAG 023100 ELSE 023200 IF DATE-DD > 29 AND DATE-MM = 2 023300 MOVE "N" TO VALID-DATE-FLAG 023400 ELSE 023500 IF DATE-DD = 29 AND DATE-MM = 2 023600 DIVIDE DATE-CCYY BY 400 GIVING DATE-QUOTIENT 023700 REMAINDER DATE-REMAINDER 023800 IF DATE-REMAINDER = 0 023900 MOVE "Y" TO VALID-DATE-FLAG 024000 ELSE 024100 DIVIDE DATE-CCYY BY 100 GIVING DATE-QUOTIENT 024200 REMAINDER DATE-REMAINDER 024300 IF DATE-REMAINDER = 0 024400 MOVE "N" TO VALID-DATE-FLAG 024500 ELSE 024600 DIVIDE DATE-CCYY BY 4 GIVING DATE-QUOTIENT 024700 REMAINDER DATE-REMAINDER 024800 IF DATE-REMAINDER = 0 024900 MOVE "Y" TO VALID-DATE-FLAG 025000 ELSE 025100 MOVE "N" TO VALID-DATE-FLAG. 025200*--------------------------------- 025300* USAGE: 025400* MOVE date(CCYYMMDD) TO DATE-CCYYMMDD. 025500* PERFORM FORMAT-THE-DATE. 025600* 025700* RETURNS: 025800* FORMATTED-DATE 025900* DATE-MMDDCCYY. 026000*--------------------------------- 026100 FORMAT-THE-DATE. 026200 PERFORM CONVERT-TO-MMDDCCYY. 026300 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 026400
The output of date05.cbl displays errors when dates are incorrect depending on whether zero entry is allowed. The prompt and error messages for the fields change. The following is an example of the output for date05.cbl:
OUTPUT:
ENTER AN OPTIONAL DATE(MM/DD/CCYY)? ENTER A DATE (MM/DD/CCYY) MUST ENTER A VALID DATE ENTER A DATE (MM/DD/CCYY) 12171993 ANY DATE IS 0/00/0000 REQUIRED DATE IS 12/17/1993 ENTER AN OPTIONAL DATE(MM/DD/CCYY)? 454519922 MUST BE ANY VALID DATE ENTER AN OPTIONAL DATE(MM/DD/CCYY)? 02291968 ENTER A DATE (MM/DD/CCYY) 03041997 ANY DATE IS 2/29/1968 REQUIRED DATE IS 3/04/1997 ENTER AN OPTIONAL DATE(MM/DD/CCYY)? ENTER A DATE (MM/DD/CCYY) 01/01/0001 c>
ANALYSIS: The program accepts and displays two date fields. One can be entered as zeroes or a valid date (ANY-DATE); the other will accept only a valid date (REQUIRED-DATE). The program is set up to test whether the validation for these two types of entry is handled correctly.
Working storage for two dates is defined at lines 001500 and 001600. These are used for the testing program and will not be a part of the date logic directly.
The WORKING-STORAGE for the date routines is defined at lines 001800 through 004900. The DATE-ENTRY-FIELD is renamed FORMATTED-DATE at line 002100, but aside from this change, the fields will be familiar down through line 003700.
Starting at line 003900, three new fields are defined that are designed to make the date routines more flexible. DATE-PROMPT at line 004300 can be filled in by the user to provide a prompt for the date entry. DATE-ERROR-MESSAGE at line 004400 can be filled in to provide a specific error message if the date is invalid. ZERO-DATE-IS-OK at line 004900 is a flag that can be set to yes or no and controls the way the DATE-CHECK logic behaves. If ZERO-DATE-IS-OK is set to "N", a date entry of zero is invalid and the user will be forced to enter a valid date. If ZERO-DATE-IS-OK is set to "Y", the routine will accept zero as a valid entry.
Date handling routines begin at line 010200, and five separate routines have been created. At line 011800, GET-A-DATE can be used to perform date entry. At lines 015800 and 017000, the routines CONVERT-TO-MMDDCCYY and CONVERT-TO-CCYYMMDD have been created to convert back and forth between DATE-MMDDCCYY and DATE-CCYYMMDD.
At line 021400, CHECK-DATE can be used to validate a date that has been moved to DATE-CCYYMMDD.
Finally, at line 026100, the routine FORMAT-THE-DATE can be used to create a display or print a version of a date by moving it to DATE-CCYYMMDD and then performing FORMAT-THE-DATE.
The DATE-PROMPT variable is used in ACCEPT-A-DATE at line 012300. If DATE-PROMPT has been filled in, it is used; otherwise, a general-purpose prompt, "ENTER A DATE (MM/DD/CCYY)", is displayed.
The DATE-ERROR-MESSAGE field is used in a similar manner to DATE-PROMT--in RE-ACCEPT-A-DATE at line 013300. If DATE-ERROR-MESSAGE has been filled in, then DATE-ERROR-MESSAGE is displayed in the event of an error. If DATE-ERROR-MESSAGE is spaces, a general-purpose error message, "INVALID DATE",is displayed.
The ZERO-DATE-IS-OK flag is used in the routine that begins at line 021400. The result of the original test for a zero date has been changed slightly. If the date is a zero and if ZERO-DATE-IS-OK = "Y", "0" is moved to VALID-DATE-FLAG; otherwise, a zero date is considered to be an error and "N" is moved to VALID-DATE-FLAG.
The remaining date routines are fairly easy to follow.
The main logic of the program is to loop and repetitively accept two date fields. GET-ANY-DATE at 007600 allows zeroes to be entered, and DATE-PROMPT and DATE-ERROR-MESSAGE are modified before the data entry is done.
GET-REQUIRED-DATE at line 008300 does not allow zeroes, and clears the DATE-PROMPT so that the default prompt will be used, but does load a special error message into DATE-ERROR-MESSAGE.
The GET-ANY-DATE routine returns the entered date in DATE-CCYYMMDD, so at line 008100, immediately after performing GET-A-DATE, DATE-CCYYMMDD is moved to ANY-DATE. The same is done for REQUIRED-DATE at line 008800.
The date05.cbl program ends when the user enters a date of 01/01/0001 for the required date field.
Code, compile, and run date05.cbl. Test various date entries until you are satisfied that the routines are working correctly. Copy date05.cbl to wsdate01.cbl and delete everything except lines 001800 through 004900. This creates the WORKING-STORAGE for date handling. Copy date05.cbl to pldate01.cbl and delete everything except lines 010200 through 026400. This creates the program logic for date handling.
Finally, code and compile Listing 19.25, date06.cbl. Run it, testing that it behaves the same as date05.cbl. You now have a general-purpose date-entry and validation routine and date- handling routines.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. DATE06. 000300*-------------------------------- 000400* Testing Date Entry and handling 000500*------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 ANY-DATE PIC 9(8) VALUE ZEROES. 001600 77 REQUIRED-DATE PIC 9(8) VALUE ZEROES. 001700 001800 COPY "WSDATE01.CBL". 001900 002000 PROCEDURE DIVISION. 002100 PROGRAM-BEGIN. 002200 PERFORM OPENING-PROCEDURE. 002300 PERFORM MAIN-PROCESS. 002400 PERFORM CLOSING-PROCEDURE. 002500 002600 PROGRAM-EXIT. 002700 EXIT PROGRAM. 002800 002900 PROGRAM-DONE. 003000 STOP RUN. 003100 003200 OPENING-PROCEDURE. 003300 003400 CLOSING-PROCEDURE. 003500 003600 MAIN-PROCESS. 003700 PERFORM GET-TWO-DATES. 003800 PERFORM DISPLAY-AND-GET-DATES 003900 UNTIL REQUIRED-DATE = 00010101. 004000 004100 GET-TWO-DATES. 004200 PERFORM GET-ANY-DATE. 004300 PERFORM GET-REQUIRED-DATE. 004400 004500 GET-ANY-DATE. 004600 MOVE "Y" TO ZERO-DATE-IS-OK. 004700 MOVE "ENTER AN OPTIONAL MM/DD/CCYY?" TO DATE-PROMPT. 004800 MOVE "MUST BE ANY VALID DATE" TO DATE-ERROR-MESSAGE. 004900 PERFORM GET-A-DATE. 005000 MOVE DATE-CCYYMMDD TO ANY-DATE. 005100 005200 GET-REQUIRED-DATE. 005300 MOVE "N" TO ZERO-DATE-IS-OK. 005400 MOVE SPACE TO DATE-PROMPT. 005500 MOVE "MUST ENTER A VALID DATE" TO DATE-ERROR-MESSAGE. 005600 PERFORM GET-A-DATE. 005700 MOVE DATE-CCYYMMDD TO REQUIRED-DATE. 005800 005900 DISPLAY-AND-GET-DATES. 006000 PERFORM DISPLAY-THE-DATES. 006100 PERFORM GET-TWO-DATES. 006200 006300 DISPLAY-THE-DATES. 006400 MOVE ANY-DATE TO DATE-CCYYMMDD. 006500 PERFORM FORMAT-THE-DATE. 006600 DISPLAY "ANY DATE IS " FORMATTED-DATE. 006700 MOVE REQUIRED-DATE TO DATE-CCYYMMDD. 006800 PERFORM FORMAT-THE-DATE. 006900 DISPLAY "REQUIRED DATE IS " FORMATTED-DATE. 007000 007100 COPY "PLDATE01.CBL". 007200
With the logic for date entry under control, you are ready to start work on entering data into the voucher file.
Data entry can be complicated. Validations and dates frequently cause problems and some maintenance modules don't use all the modes (add, change, inquire, and delete). Today, you learned the following basics:
021500 MOVE "Y" TO VALID-DATE-FLAG.
021600 IF DATE-CCYYMMDD = ZEROES
021700 IF ZERO-DATE-IS-OK = "Y"
021800 MOVE "0" TO VALID-DATE-FLAG
021900 ELSE
022000 MOVE "N" TO VALID-DATE-FLAG
022100 ELSE
IF DATE-CC < 19
MOVE "N" TO VALID-DATE-FLAG
ELSE
022200 IF DATE-MM < 1 OR DATE-MM > 12
022300 MOVE "N" TO VALID-DATE-FLAG
022400 ELSE
022500 IF DATE-DD < 1 OR DATE-DD > 31
022600 MOVE "N" TO VALID-DATE-FLAG
022700 ELSE
022800 IF (DATE-DD > 30) AND
022900 (DATE-MM = 2 OR 4 OR 6 OR 9 OR 11)
023000 MOVE "N" TO VALID-DATE-FLAG
023100 ELSE
023200 IF DATE-DD > 29 AND DATE-MM = 2
023300 MOVE "N" TO VALID-DATE-FLAG
023400 ELSE
023500 IF DATE-DD = 29 AND DATE-MM = 2
023600 DIVIDE DATE-CCYY BY 400 GIVING DATE-QUOTIENT
023700 REMAINDER DATE-REMAINDER
023800 IF DATE-REMAINDER = 0
023900 MOVE "Y" TO VALID-DATE-FLAG
024000 ELSE
024100 DIVIDE DATE-CCYY BY 100 GIVING DATE-QUOTIENT
024200 REMAINDER DATE-REMAINDER
024300 IF DATE-REMAINDER = 0
024400 MOVE "N" TO VALID-DATE-FLAG
024500 ELSE
024600 DIVIDE DATE-CCYY BY 4 GIVING DATE-QUOTIENT
024700 REMAINDER DATE-REMAINDER
024800 IF DATE-REMAINDER = 0
024900 MOVE "Y" TO VALID-DATE-FLAG
025000 ELSE
025100 MOVE "N" TO VALID-DATE-FLAG.
025200
A Yes. In fact, if you need to test the full four-digit year, you might use a variable definition that looks something like the next listing. This defines eight bytes that contain six variables. DATE-CCYYMMDD is a numeric eight-byte field. DATE-CCYY is a numeric four-byte field in the first four bytes. DATE-CC is a numeric two-byte field in the first two bytes. DATE-YY is a numeric two-byte field in positions 3 and 4. DATE-MM is a numeric two-byte field in positions 5 and 6, and DATE-DD is a numeric two-byte field in positions 7 and 8.
003200 01 DATE-CCYYMMDD PIC 9(8). 003300 01 FILLER REDEFINES DATE-CCYYMMDD. 003400 05 DATE-CCYY PIC 9999. 003500 05 FILLER REDEFINES DATE-CCYY. 003600 10 DATE-CC PIC 99. 003700 10 DATE-YY PIC 99. 003800 05 DATE-MM PIC 99. 003900 05 DATE-DD PIC 99.
000100 01 TIME-HHMMSS PIC 9(6). 000200 01 FILLER REDEFINES TIME-HHMMSS. 000300 05 TIME-HH PIC 99. 000400 05 TIME-MM PIC 99. 000500 05 TIME-SS PIC 99.
© Copyright, Macmillan Computer Publishing. All rights reserved.