IDENTIFICATION DIVISION. PROGRAM-ID. DATEBOOK-PAGE-FROM-REMINDERS. DATE-WRITTEN. DECEMBER, 1984. *AUTHOR. JANE KIRKLEY. *REMARKS. ******************************************************************************* * This program takes your reminders file and puts it into datebook form for * * any period of time * ******************************************************************************* ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT OPTIONAL REMINDERS-FILE ASSIGN TO "sys$login:reminders." ORGANIZATION IS RELATIVE ACCESS IS SEQUENTIAL . SELECT DATEBOOK-PAGE-FILE ASSIGN TO "ci$output:reminders.lis" . DATA DIVISION. FILE SECTION. FD REMINDERS-FILE . 01 REMINDERS-RECORD. 05 REMINDER-DATE PIC X(11). 05 REMINDER-MESSAGE PIC X(69). FD DATEBOOK-PAGE-FILE RECORD IS VARYING IN SIZE FROM 1 TO 92 CHARACTERS DEPENDING ON RECORD-LENGTH . 01 PRINT-LINE PIC X(92). WORKING-STORAGE SECTION. 01 WHOLE-LINE-OF-PAGE. 05 LEFT-SIDE-OF-PAGE. 10 LEFT-SIDE-DATE-DAY-FIELD. 15 PAGE-REMINDER-DATE PIC X(11). 15 FILLER PIC X. 15 PAGE-REMINDER-DAY PIC X(9). 15 FILLER PIC X. 05 RIGHT-SIDE-OF-PAGE PIC X(69). 01 HEADER-RECORD. 05 REDISPLAY-DATE PIC X(11). 05 FILLER PIC X. 05 REDISPLAY-WORDED-DAY PIC X(9). 05 FILLER PIC X. 05 HEADER-CONTINUED PIC X(9). 01 FIRST-HEADER-RECORD. 05 FILLER PIC X(24) VALUE "REMINDERS CURRENT AS OF ". 05 CURRENT-DATE. 10 CURRENT-DATE-DAY PIC 99. 10 FILLER PIC X. 10 CURRENT-DATE-MONTH PIC X(3). 10 FILLER PIC X. 10 CURRENT-DATE-YEAR PIC 9(4). 10 CURRENT-DATE-TIME PIC X(6). 01 VARIABLES. 05 OPTION PIC 9. 05 RECORD-LENGTH PIC 9(9) COMP. 05 BINARY-BEGINNING-DATE PIC S9(18) COMP. 05 BINARY-ENDING-DATE PIC S9(18) COMP. 05 BINARY-CURRENT-SYSTEM-DATE PIC S9(18) COMP. 05 NUMBER-OF-DAYS-BETWEEN PIC 9(4) COMP. 05 NUMBER-OF-WEEKS PIC 9(9) COMP. 05 DAYS-DIFFERENT-FROM-TODAY PIC 9(9) COMP. 05 WORDED-DAY-SUB PIC 9(9) COMP. 05 CONVERT-DATE. 10 CONVERT-DATE-DATE. 15 CONVERT-DATE-DATE-DAY PIC 99. 15 CONVERT-DATE-DATE-DASH-1 PIC X. 15 CONVERT-DATE-DATE-MONTH PIC XXX. 15 CONVERT-DATE-DATE-DASH-2 PIC X. 15 CONVERT-DATE-DATE-YEAR PIC 9(4). 10 CONVERT-DATE-TIME PIC X(12). 05 BINARY-DATE PIC S9(18) COMP. 05 BINARY-REMINDER-DATE PIC S9(18) COMP. 05 LINE-COUNT PIC 9(9) COMP. 05 LAST-DATE-PROCESSED PIC S9(18) COMP. 05 REMINDER-COUNT PIC 9(9) COMP. 05 BINARY-PRINT-DATE PIC S9(18) COMP. 05 ASCII-DATE-FORMAT. 10 ASCII-DATE. 15 ASCII-DAY PIC 99. 15 FILLER PIC X. 15 ASCII-MONTH PIC X(3). 15 FILLER PIC X. 15 ASCII-YEAR PIC 9(4). 10 ASCII-TIME PIC X(12). 05 ASCII-DELTA-FORMAT REDEFINES ASCII-DATE-FORMAT. 10 ASCII-DELTA-DAY PIC Z(4). 05 BINARY-DATE-FORMAT PIC S9(18) COMP. 05 DISPATCH PIC 9(9) COMP. 01 CONSTANTS. 05 MAX-ON-PAGE PIC 9(9) COMP VALUE 60. 05 ASCII-ONE-DAY PIC X(16) VALUE "0001 00:00:00.00". * The value for BINARY-ONE-DAY is returned from a call to SYS$BINTIM in 10000-BOJ 05 BINARY-ONE-DAY PIC S9(18) COMP. 05 WS-TRUE PIC X VALUE "T". 05 WS-FALSE PIC X VALUE "F". 05 DASHES-CONSTANT PIC X VALUE "-". 05 CLEAR-SCREEN PIC X(08) VALUE "". 05 BOLD-VIDEO PIC X(04) VALUE "". 05 NORMAL-VIDEO PIC X(04) VALUE "". 05 DOUBLE-WIDE PIC X(03) VALUE "#6". 01 SWITCHES. 05 VALID-DATE-SW PIC X. 88 VALID-DATE VALUE "T". 05 VALID-OPTION-SW PIC X. 88 VALID-OPTION VALUE "T". 05 REMINDERS-ONLY-SW PIC X. 88 REMINDERS-ONLY VALUE "T". 05 END-OF-FILE-SW PIC X. 88 END-OF-FILE VALUE "T". 05 PROGRAM-TERMINATED-SW PIC X. 88 PROGRAM-TERMINATED VALUE "T". 01 DAY-OF-WEEK-VALUES. 05 FILLER PIC X(09) VALUE "MONDAY". 05 FILLER PIC X(09) VALUE "TUESDAY". 05 FILLER PIC X(09) VALUE "WEDNESDAY". 05 FILLER PIC X(09) VALUE "THURSDAY". 05 FILLER PIC X(09) VALUE "FRIDAY". 05 FILLER PIC X(09) VALUE "SATURDAY". 05 FILLER PIC X(09) VALUE "SUNDAY". 01 DAY-OF-WEEK-TABLE REDEFINES DAY-OF-WEEK-VALUES. 05 WORDED-DAY OCCURS 7 TIMES PIC X(9). PROCEDURE DIVISION. 00000-DATEBOOK-PAGE-FROM-REMIND. PERFORM 10000-BOJ IF NOT PROGRAM-TERMINATED * Prints a line indicating these reminders are current as of the time of this run CALL "STR$TRIM" USING BY DESCRIPTOR FIRST-HEADER-RECORD BY DESCRIPTOR FIRST-HEADER-RECORD BY REFERENCE RECORD-LENGTH WRITE PRINT-LINE FROM FIRST-HEADER-RECORD ADD 1 TO LINE-COUNT * Read the reminder file until we come upon a reminder within the desired range PERFORM 90000-READ-CONVERT-REMIND-REC WITH TEST AFTER UNTIL BINARY-REMINDER-DATE NOT < BINARY-BEGINNING-DATE OR END-OF-FILE PERFORM 20000-PROCESS-ONE-REMINDER-DATE UNTIL END-OF-FILE OR BINARY-REMINDER-DATE > BINARY-ENDING-DATE IF NOT REMINDERS-ONLY INITIALIZE REMINDER-COUNT PERFORM 30000-CATCH-UP-PRINTDATE UNTIL BINARY-PRINT-DATE > BINARY-ENDING-DATE END-IF PERFORM 40000-EOJ END-IF STOP RUN . 10000-BOJ. MOVE WS-FALSE TO PROGRAM-TERMINATED-SW REMINDERS-ONLY-SW CALL "SYS$BINTIM" USING BY DESCRIPTOR ASCII-ONE-DAY BY REFERENCE BINARY-ONE-DAY * The BINTIM routine returns a negative value, so for mathmatical accuracy, BINARY-ONE-DAY must be made positive * Systems Services Reference Manual page 8-3 COMPUTE BINARY-ONE-DAY = 0 - BINARY-ONE-DAY * Get the current date from the system in binary format CALL "SYS$GETTIM" USING BY REFERENCE BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII * It is necessary to run the binary current date from the system through a convertion * to set the time portion equal to zeros for accurate comparasons MOVE ASCII-DATE-FORMAT TO CONVERT-DATE PERFORM 80000-CONVERT-DATE-TO-BINARY MOVE BINARY-DATE TO BINARY-CURRENT-SYSTEM-DATE MOVE ASCII-DATE-FORMAT TO CURRENT-DATE MOVE WS-FALSE TO VALID-OPTION-SW PERFORM 11000-EVALUATE-USERS-OPTION UNTIL VALID-OPTION IF NOT PROGRAM-TERMINATED OPEN INPUT REMINDERS-FILE OUTPUT DATEBOOK-PAGE-FILE PERFORM 13000-SET-UP-LIMITS END-IF . 11000-EVALUATE-USERS-OPTION. PERFORM 11100-DISPLAY-OPTION-INSTRUCTS ACCEPT OPTION AT END MOVE 1 TO OPTION END-ACCEPT EVALUATE OPTION WHEN 1 MOVE WS-TRUE TO PROGRAM-TERMINATED-SW MOVE WS-TRUE TO VALID-OPTION-SW WHEN 2 MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE COMPUTE BINARY-ENDING-DATE = (BINARY-ONE-DAY * 6) + BINARY-BEGINNING-DATE MOVE WS-TRUE TO VALID-OPTION-SW WHEN 3 MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE COMPUTE BINARY-ENDING-DATE = (BINARY-ONE-DAY * 13) + BINARY-BEGINNING-DATE MOVE WS-TRUE TO VALID-OPTION-SW WHEN 4 MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE COMPUTE BINARY-ENDING-DATE = (BINARY-ONE-DAY * 30) + BINARY-BEGINNING-DATE MOVE BINARY-ENDING-DATE TO BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII IF ASCII-DAY(1:1) = SPACE INSPECT ASCII-DAY REPLACING ALL SPACES BY ZEROS END-IF * This if adjusts the ending-date that goes beyond the end of the current month by subtracting the number of days it g IF ASCII-MONTH NOT = CURRENT-DATE-MONTH COMPUTE BINARY-ENDING-DATE = BINARY-ENDING-DATE - (BINARY-ONE-DAY * ASCII-DAY) MOVE BINARY-ENDING-DATE TO BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII * This if catches the case where for example on Jan 31 we go for 31 days to March 3, then back to Feb 28, this if adju * ending date again to the end of Jan. IF ASCII-MONTH NOT = CURRENT-DATE-MONTH COMPUTE BINARY-ENDING-DATE = BINARY-ENDING-DATE - (BINARY-ONE-DAY * ASCII-DAY) END-IF END-IF MOVE WS-TRUE TO VALID-OPTION-SW WHEN 5 PERFORM 12100-USERS-OWN-DATES MOVE WS-TRUE TO VALID-OPTION-SW WHEN 6 MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE MOVE CURRENT-DATE TO CONVERT-DATE MOVE "2000" TO CONVERT-DATE-DATE-YEAR PERFORM 80000-CONVERT-DATE-TO-BINARY MOVE BINARY-DATE TO BINARY-ENDING-DATE MOVE WS-TRUE TO REMINDERS-ONLY-SW MOVE WS-TRUE TO VALID-OPTION-SW WHEN OTHER DISPLAY "" DISPLAY "Invalid option. Please press to continue: " ACCEPT OPTION END-EVALUATE . 11100-DISPLAY-OPTION-INSTRUCTS. DISPLAY CLEAR-SCREEN DOUBLE-WIDE BOLD-VIDEO "Print Reminders" NORMAL-VIDEO DISPLAY "" DISPLAY " 1. Exit" DISPLAY " 2. One week, beginning today for 7 days" DISPLAY " 3. Two weeks, beginning today for 14 days" DISPLAY " 4. The current month, beginning today to the end of the month" DISPLAY " 5. Two dates of your choosing" DISPLAY " 6. All of your reminders" DISPLAY "" DISPLAY " Your choice? " WITH NO ADVANCING . 12100-USERS-OWN-DATES. DISPLAY CLEAR-SCREEN "Please enter all dates in the format DD-MMM-YYYY, for example 04-JUL-1776" DISPLAY "To use today's date, you can simply press without typing a date." DISPLAY "" DISPLAY "Please enter the starting date: " WITH NO ADVANCING PERFORM WITH TEST AFTER UNTIL VALID-DATE OR PROGRAM-TERMINATED ACCEPT CONVERT-DATE-DATE AT END MOVE WS-TRUE TO PROGRAM-TERMINATED-SW END-ACCEPT IF CONVERT-DATE-DATE = SPACES MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE MOVE WS-TRUE TO VALID-DATE-SW DISPLAY "Starting with today's date." ELSE PERFORM 12110-EDIT-CONVERT-DATE-DATE IF VALID-DATE PERFORM 80000-CONVERT-DATE-TO-BINARY MOVE BINARY-DATE TO BINARY-BEGINNING-DATE END-IF END-IF END-PERFORM IF NOT PROGRAM-TERMINATED * If a date prior to the current date is entered as a starting date, the current date is used as the starting date IF BINARY-BEGINNING-DATE < BINARY-CURRENT-SYSTEM-DATE MOVE BINARY-CURRENT-SYSTEM-DATE TO BINARY-BEGINNING-DATE DISPLAY "" DISPLAY "You entered a past date. Since you have no reminders for dates" DISPLAY "in the past, printing will begin with today's date." DISPLAY "" END-IF DISPLAY "Please enter the ending date: " WITH NO ADVANCING PERFORM WITH TEST AFTER UNTIL VALID-DATE OR PROGRAM-TERMINATED ACCEPT CONVERT-DATE-DATE AT END MOVE WS-TRUE TO PROGRAM-TERMINATED-SW END-ACCEPT PERFORM 12110-EDIT-CONVERT-DATE-DATE END-PERFORM IF NOT PROGRAM-TERMINATED PERFORM 80000-CONVERT-DATE-TO-BINARY MOVE BINARY-DATE TO BINARY-ENDING-DATE * This next section limits the user to an ending date of one year from the run date IF BINARY-ENDING-DATE > ( BINARY-BEGINNING-DATE + (BINARY-ONE-DAY * 366) ) COMPUTE BINARY-ENDING-DATE = BINARY-BEGINNING-DATE + (BINARY-ONE-DAY * 366) MOVE BINARY-ENDING-DATE TO BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII DISPLAY "" DISPLAY "The maximum allowable printout length is one year." DISPLAY "The ending date has been adjusted to " ASCII-DATE END-IF END-IF END-IF . 12110-EDIT-CONVERT-DATE-DATE. * Edits the user's input to obtain a date in the valid format and within the natural boundries of a date MOVE WS-TRUE TO VALID-DATE-SW PERFORM VARYING DISPATCH FROM 1 BY 1 UNTIL NOT VALID-DATE OR DISPATCH > 5 OR PROGRAM-TERMINATED EVALUATE DISPATCH WHEN 1 IF CONVERT-DATE-DATE-DAY < 1 OR CONVERT-DATE-DATE-DAY > 31 MOVE WS-FALSE TO VALID-DATE-SW END-IF WHEN 2 IF CONVERT-DATE-DATE-DASH-1 NOT = DASHES-CONSTANT MOVE WS-FALSE TO VALID-DATE-SW END-IF WHEN 3 CALL "STR$UPCASE" USING BY DESCRIPTOR CONVERT-DATE-DATE-MONTH BY DESCRIPTOR CONVERT-DATE-DATE-MONTH IF CONVERT-DATE-DATE-MONTH NOT = "JAN", AND "FEB" AND "MAR" AND "APR" AND "MAY" AND "JUN" AND "JUL" AND "AUG" AND "SEP" AND "OCT" AND "NOV" AND "DEC" MOVE WS-FALSE TO VALID-DATE-SW END-IF WHEN 4 IF CONVERT-DATE-DATE-DASH-2 NOT = DASHES-CONSTANT MOVE WS-FALSE TO VALID-DATE-SW END-IF WHEN 5 IF CONVERT-DATE-DATE-YEAR < CURRENT-DATE-YEAR DISPLAY "The year you entered is past, and therefore invalid." MOVE WS-FALSE TO VALID-DATE-SW END-IF WHEN OTHER DISPLAY "ERROR IN INTERNAL DISPATCH, CONTACT M.I.S." MOVE WS-TRUE TO PROGRAM-TERMINATED-SW END-EVALUATE END-PERFORM IF NOT VALID-DATE DISPLAY "The date must be in the format DD-MMM-YYYY (for example 04-JUL-1776)." DISPLAY "Please re-enter the date in this format: " WITH NO ADVANCING END-IF . 13000-SET-UP-LIMITS. * If the user doesn't want to start with today, we need to find the number of days between today and their starting da * to assign a worded day to the beginning date IF BINARY-CURRENT-SYSTEM-DATE < BINARY-BEGINNING-DATE SUBTRACT BINARY-CURRENT-SYSTEM-DATE FROM BINARY-BEGINNING-DATE GIVING BINARY-DATE-FORMAT * In order to have a delta date returned, the binary date input into the BINTIM routine must be negative MULTIPLY -1 BY BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII MOVE ASCII-DELTA-DAY TO NUMBER-OF-DAYS-BETWEEN ELSE MOVE ZERO TO NUMBER-OF-DAYS-BETWEEN END-IF ACCEPT WORDED-DAY-SUB FROM DAY-OF-WEEK * This section subtracts out full weeks between the current date and the starting date to find the number of week days * current day and the starting day. This number is then added to the weekday number for the current date. If the start * is earlier in the week than the current weekday, this total will be greater than 7 DIVIDE NUMBER-OF-DAYS-BETWEEN BY 7 GIVING NUMBER-OF-WEEKS REMAINDER DAYS-DIFFERENT-FROM-TODAY ADD DAYS-DIFFERENT-FROM-TODAY TO WORDED-DAY-SUB IF WORDED-DAY-SUB > 7 SUBTRACT 7 FROM WORDED-DAY-SUB GIVING WORDED-DAY-SUB END-IF * Initialize values for last-date-processed and binary-print-date SUBTRACT BINARY-ONE-DAY FROM BINARY-BEGINNING-DATE GIVING LAST-DATE-PROCESSED MOVE BINARY-BEGINNING-DATE TO BINARY-PRINT-DATE . 20000-PROCESS-ONE-REMINDER-DATE. INITIALIZE REMINDER-COUNT PERFORM 30000-CATCH-UP-PRINTDATE UNTIL BINARY-PRINT-DATE NOT < BINARY-REMINDER-DATE PERFORM 22000-PROCESS-ONE-REMINDER UNTIL BINARY-REMINDER-DATE NOT = BINARY-PRINT-DATE OR END-OF-FILE ADD BINARY-ONE-DAY TO BINARY-PRINT-DATE . 22000-PROCESS-ONE-REMINDER. IF BINARY-REMINDER-DATE NOT = LAST-DATE-PROCESSED MOVE BINARY-REMINDER-DATE TO BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII MOVE ASCII-DATE-FORMAT TO PAGE-REMINDER-DATE MOVE WORDED-DAY(WORDED-DAY-SUB) TO PAGE-REMINDER-DAY ADD 1 TO WORDED-DAY-SUB IF WORDED-DAY-SUB > 7 SUBTRACT 7 FROM WORDED-DAY-SUB END-IF MOVE BINARY-PRINT-DATE TO LAST-DATE-PROCESSED END-IF MOVE REMINDER-MESSAGE TO RIGHT-SIDE-OF-PAGE ADD 1 TO REMINDER-COUNT PERFORM 94000-PRINT-WHOLE-LINE PERFORM 90000-READ-CONVERT-REMIND-REC . 30000-CATCH-UP-PRINTDATE. IF NOT REMINDERS-ONLY MOVE BINARY-PRINT-DATE TO BINARY-DATE-FORMAT PERFORM 82000-CONVERT-BINARY-TO-ASCII MOVE ASCII-DATE-FORMAT TO PAGE-REMINDER-DATE MOVE WORDED-DAY(WORDED-DAY-SUB) TO PAGE-REMINDER-DAY PERFORM 94000-PRINT-WHOLE-LINE END-IF ADD 1 TO WORDED-DAY-SUB IF WORDED-DAY-SUB > 7 SUBTRACT 7 FROM WORDED-DAY-SUB END-IF ADD BINARY-ONE-DAY TO BINARY-PRINT-DATE . 40000-EOJ. CLOSE REMINDERS-FILE DATEBOOK-PAGE-FILE DISPLAY "" DISPLAY "Reminders listing finished." . 80000-CONVERT-DATE-TO-BINARY. * This paragraph is executed form several places in the program and these variables are used each time with the result * being moved to the appropriate variables on the return to the paragraph of origin. It converts a date in ASCII forma * to a date in binary absolute or binary delta time depending on the form of the input to the routine MOVE " 00:00:00.00" TO CONVERT-DATE-TIME CALL "SYS$BINTIM" USING BY DESCRIPTOR CONVERT-DATE BY REFERENCE BINARY-DATE . 82000-CONVERT-BINARY-TO-ASCII. * This paragraph is executed from several places in the program and these variables are used each time with the result * being moved to the appropriate variables on the return to the paragraph of origin. It converts a date in binary form * to a date in ASCII absolute or ASCII delta time depending on the form of the input to the routine CALL "SYS$ASCTIM" USING BY VALUE ZERO BY DESCRIPTOR ASCII-DATE-FORMAT BY REFERENCE BINARY-DATE-FORMAT BY VALUE ZERO . 90000-READ-CONVERT-REMIND-REC. READ REMINDERS-FILE AT END MOVE WS-TRUE TO END-OF-FILE-SW END-READ * Convert the reminder date to binary IF NOT END-OF-FILE MOVE REMINDER-DATE TO CONVERT-DATE-DATE PERFORM 80000-CONVERT-DATE-TO-BINARY MOVE BINARY-DATE TO BINARY-REMINDER-DATE END-IF . 94000-PRINT-WHOLE-LINE. IF LINE-COUNT > MAX-ON-PAGE * Page advance and heading control MOVE 1 TO LINE-COUNT IF REMINDER-COUNT > 1 MOVE PAGE-REMINDER-DATE TO REDISPLAY-DATE MOVE PAGE-REMINDER-DAY TO REDISPLAY-WORDED-DAY MOVE "CONTINUED" TO HEADER-CONTINUED ELSE MOVE SPACES TO HEADER-RECORD END-IF CALL "STR$TRIM" USING BY DESCRIPTOR HEADER-RECORD BY DESCRIPTOR HEADER-RECORD BY REFERENCE RECORD-LENGTH WRITE PRINT-LINE FROM HEADER-RECORD AFTER ADVANCING PAGE ADD 1 TO LINE-COUNT END-IF CALL "STR$TRIM" USING BY DESCRIPTOR WHOLE-LINE-OF-PAGE BY DESCRIPTOR WHOLE-LINE-OF-PAGE BY REFERENCE RECORD-LENGTH WRITE PRINT-LINE FROM WHOLE-LINE-OF-PAGE ADD 1 TO LINE-COUNT MOVE SPACES TO WHOLE-LINE-OF-PAGE .