!  Demonstration program for Date Module
!  Copyrighted by T. Darrel Westbrook, 1993
!  Released to the Public Domain for non-profit,
!  non-commercial use
!
!---!----1----!----2----!----3----!----4----!----5----!----6
DO
   CLEAR
   CALL Center("Enter Command like;",4,3)
   CALL Center("Change Template, See Template, System Date, or Date",6,2)
   CALL KeyInput(10,c$)
   IF len(c$) = 0 then EXIT DO
   SELECT CASE Ucase$(c$)
   CASE "CHANGE TEMPLATE"
        DO
           CLEAR
           CALL Center("Enter new date template.",4,3)
           CALL KeyInput(8,c$)
           IF len(c$) = 0 then EXIT DO
           CALL Change_Date_Format(c$)
           IF extype = 0 then EXIT DO else CLEAR
           CALL Center("Error with date template!",6,2)
           CALL Center(Extext$,8,3)
           PAUSE 4
        LOOP
        CLEAR
        IF len(c$) <> 0 then
           CALL Get_Date_Format(string$)
           CALL Center("Date template changed to",4,2)
           CALL Center(c$,6,3)
           CALL Center("Press any key to continue",8,1)
           CALL buffer
           GET KEY a
           CLEAR
        END IF
   CASE "SEE TEMPLATE"
        CLEAR
        CALL Get_Date_Format(string$)
        CALL Center("Current date format is '" & string$ & "'.",4,3)
        CALL Center("Press any key to continue",6,1)
        CALL buffer
        GET KEY a
        CLEAR
   CASE "SYSTEM DATE"
        CLEAR
        CALL System_Date(rtn_date$,dow_name$,julian$)
        CALL Get_Date_Format(string$)
        CLEAR
        CALL Center("'" & rtn_date$ & "' is the system date, which is a '" & dow_name$ & "'.",6,2)
        CALL Center("I used a date format of " & string$ & ".",8,2)
        CALL Center("The julian date is " & julian$ & ".",10,3)
        CALL Center("Press any key to continue",12,1)
        CALL buffer
        GET KEY a
        CLEAR
   CASE "DATE"
        CALL Get_Date_Format(string$)
        DO
           CLEAR
           CALL Center("Enter date using the date template of " & string$,4,3)
           CALL KeyInput(8,c$)
           IF len(trim$(c$)) = 0 then EXIT DO
           CALL parse_date(c$,year,month,day)
           CLEAR
           IF extype = 0 then
              CALL Date_Data(year,month,day,julian$,month$,m_abrev$,dow_factor,dow_name$,rtn_date$,sort_date$)
              CALL Center("You entered a date of " & c$ & ", which is converted to",2,1)
              CALL Center(rtn_date$ & " by the module using the template '" & string$ & "'.",4,1)
              CALL Center("the data returned by the module for your use is;",6,2)
              CALL Center("Year, month, and day are " & str$(year) & ", " & str$(month) & ", and " & str$(day) & ".",8,3)
              CALL Center("A julian day (format YYYYDDD) of '" & julian$ & "'.",10,3)
              CALL Center("Month data of '" & month$ & "' and '" & m_abrev$ & "'.",12,3)
              CALL Center("Day of the week data with 1 to 7 representing Sunday to Saturday, and",14,3)
              CALL Center("the day of the week.  In this case they are '" & str$(dow_factor) & "' and '" & dow_name$ & "'.",16,3)
              CALL Center("A string date suitable for sorting is available.  It is '" & sort_date$ & "'.",18,3)
           ELSE
              CALL Center("An error has occurred",4,3)
              CALL Center("It is -> " & extext$,6,2)
           END IF
           CALL Center("Press any key for another",20,1)
           CALL buffer
           GET KEY a
           CLEAR
        LOOP
   CASE else
        CLEAR
        EXIT DO
   END SELECT
LOOP
END
EXTERNAL

MODULE Global
OPTION BASE 1
SUB error_reset
    WHEN error in
         CAUSE EXCEPTION 0        ! reset EXTYPE error flag
    USE
    END WHEN
END SUB                           ! end of 'error_reset'

SUB make_error(n,msg$)
    IF len(msg$) = 0 then
       WHEN error in
            CAUSE ERROR n
       USE
       END WHEN
    ELSE
       WHEN error in
            CAUSE ERROR n,msg$
       USE
       END WHEN
    END IF
END SUB                           ! end of 'make_error'
END MODULE                        ! end of 'Global'
!
! support subroutines
!
SUB KeyInput(row,c$)
    SET CURSOR "OFF"
    CALL buffer
    LET col = 40                  ! start at the center of the screen
    SET CURSOR row,34
    PRINT repeat$(" ",32)         ! clear the input box
    LET c$ = ""                   ! initialize return string
    DO                            ! forever loop
       SET COLOR 3                ! set cursor color
       SET CURSOR row,int((80-len(c$))/2) + len(c$)
       PRINT "|"
       DO
          GET KEY keycode
          SELECT CASE keycode
          CASE 8,13,32 to 127
               IF keycode >= 32 and keycode =< 126 then
                  LET t$ = chr$(keycode)    ! printable characters 
               ELSE
                  LET t$ = ""     ! null character
               END IF
               EXIT DO
          CASE else
               ! try again
          END SELECT
       LOOP
       SELECT CASE keycode
       CASE 8, 127                ! BS and DEL keycode
            IF col = 40 then
               SOUND 150,.15      ! sound bell tone if backspace too far
            ELSE
               LET c$ = c$[1:len(c$)-1]     ! take off last input to string
               SET COLOR 1        ! change color for text input
               SET CURSOR row,col
               PRINT repeat$(" ",len(c$) + 1)
               SET CURSOR row,int((80-len(trim$(c$)))/2)   ! center the current string
               PRINT c$ & "  "
               LET col = col + 1  ! increment column
            END IF
       CASE 13                    ! CR
            WHEN error in
                 IF ord(t$) = -1 and len(c$) = 0 then LET c$ = ""
            USE
                 ! don't exit
            END WHEN
            EXIT DO               ! Exit if character is CR
       CASE 32 to 126             ! printable characters
            SET COLOR 1
            SET CURSOR row,col - 1
            LET c$ = c$ & t$      ! add new character to string
            SET CURSOR row,int((80-len(trim$(c$)))/2)
            PRINT c$
            IF len(c$) = 30 then EXIT DO    ! c$ is equal to max string length
            LET col = col - 1     ! increment col counter
       CASE else
            !  item selected which is not allowed by program
       END SELECT
    LOOP                          ! End of forever loop
    SET COLOR Pen_Color
    SET CURSOR row,int( (80-len(c$))/2 )
    PRINT c$ & "  "
    LET c$ = trim$(c$)
END SUB
! end of 'KeyInput'
SUB Center(txt$,row,Pen_Color)
    SET COLOR Pen_Color           ! change text color
    SET CURSOR row,int((80-len(trim$(txt$)))/2)
    PRINT txt$
END SUB                           ! end of 'Center'

SUB Buffer
    DO                            ! clear keyboard buffer
       IF key input then
          GET KEY b               ! get any keyboard input
          GET MOUSE j,k,l         ! get mouse input too
       ELSE
          GET MOUSE j,k,l         ! get mouse input too
       END IF
       IF l <> 3 and NOT key input then EXIT SUB
    LOOP
END SUB                           ! end of 'Buffer'

MODULE Date
!  Date Module for True BASIC, Amiga Version 2.0
!  Copyrighted by T. Darrel Westbrook, 1993
!
SHARE month1$                     ! like January, February, etc.
SHARE dow$                        ! day of the week
SHARE max_day$                    ! variable
SHARE max_day1$                   ! non leap year max days in a month
SHARE max_day2$                   ! leap year max days in a month
SHARE m_factor$                   ! month factor used in calculation of the day of the week
SHARE leap_flag                   ! when = to 1, leap year, -1 for nonleap year
SHARE lengthy                     ! number of Y's in the user_date_format$
SHARE lengthm                     ! number of M's in the user_date_format$
SHARE lengthd                     ! number of D's in the user_date_format$
SHARE user_date_format$           ! date format, DDMMYY, DDMMMYYY, MMMMDDYYYY, etc.
SHARE order_date_string$          ! sets the order of D M Y, for the returned date
SHARE delimit_flag                ! 1 if delimiters is used in a date
SHARE delimiter$                  ! single character used to separate date items
PRIVATE Max_Day
PRIVATE cdate$

! initialize variables

LET max_day1$  = "312931303130313130313031"
LET max_day2$  = "312831303130313130313031"
LET month1$ = "  January February    March    April      May     June     July   AugustSeptember  October November December"
LET dow$    = "   Sunday   Monday  TuesdayWednesday Thursday   Friday Saturday"
LET user_date_format$ = "DDMMMYY"
LET order_date_string$ = " DMY"
CALL Change_Date_Format(user_date_format$)  ! initialize variables

! module subroutines and functions

SUB Get_Date_Format(string$)
    LET string$ = user_date_format$
END SUB

SUB System_Date(rtn_date$,dow_name$,julian$)
    LET x$    = cdate$
    LET year  = val(x$[1:4])
    LET month = val(x$[5:6])
    LET day   = val(x$[7:8])
    CALL Date_Data(year,month,day,julian$,month$,m_abrev$,dow_factor,dow_name$,rtn_date$,sort_date$)
END SUB

DEF cdate$
    !  EXCEPTIONS: 123, Computer system date is not set.
    IF val(date$) = 0 then
       CALL make_error(123,"Computer system date is not set.")
       EXIT DEF
    END IF
    CALL error_reset              ! reset True BASIC global error number
    !
    ! error trap for True BASIC date$ function bug
    !
    IF date$[5:8]="0100" then     ! during leap year, TB date$ function 
       LET day  = 31              ! 31 Dec of leap year is returned as YYYY0100
       LET month= 12              ! with YYYY being the entry year + 1
       LET year = val(date$[1:4])-1
       CALL Max_Day(year)
    ELSE                          ! date is not 31 Dec of a leap year
       LET day   = val(date$[7:8])
       LET month = val(date$[5:6])
       LET year  = val(date$[1:4])
       CALL Max_Day(year)
       IF leap_flag = 1 then      ! this is a leap year
          SELECT CASE month
          CASE 1
               ! error does not occur until 29 Feb YY,
               ! True BASIC believes that 29 Feb of a 
               ! leap year is 1 Mar of that year.
          CASE 2
               IF day > 28 then CALL move_dates
          CASE 3 to 12
               CALL move_dates
          END SELECT              ! end of CASE month
       END IF                     ! end of 'IF leap_flag = 1 ...
    END IF                        ! end of 'IF date$[5:8]="0100" .....
    !
    !  end of Amiga True BASIC Version 2.0
    !  error trap for known date$ function bug.
    !
    LET cdate$ = using$("%%%%",year) & using$("%%",month) & using$("%%",day)
    SUB move_dates
        LET day = day - 1
        IF day = 0 then
           LET month = month - 1  ! change month first, so the day will be correct
           LET day = val(max_day$[month*2-1:month*2])
        END IF
    END SUB
END DEF                           ! end definition 'cdate$'

SUB Change_Date_Format(string$)
    !   EXCEPTIONS:  124, "Date format string (" & string$ & ") is unacceptable."
    LET string$, t$ = trim$(ucase$(string$))
    IF len(string$) = 0 then CAUSE EXCEPTION 124, "Date format string (" & string$ & ") is unacceptable."
    LET d$ = " "                  ! initialize string with leading blank
    LET delimiter$ = ""           ! initialize delimiter holder
    LET n = 1
    FOR i=2 to 4
        SELECT CASE t$[n:n]       ! get each character of the string
        CASE "Y"
             LET a$ = "Y"
             CALL Find_Position
             LET d$ = d$ & "Y"
             LET lengthy = counter     ! determine type of year to return
        CASE "M"
             LET a$ = "M"
             CALL Find_Position
             LET d$ = d$ & "M"
             LET lengthm = counter     ! determine type of year to return
        CASE "D"
             LET a$ = "D"
             CALL Find_Position
             LET d$ = d$ & "D"
             LET lengthd = counter     ! determine type of year to return
        CASE else                 ! assume its a delimited character
             LET delimiter$ = t$[n:n]  ! use only the last delimiter found
             LET i = i - 1        ! back up one order_date_string$ character
             LET n = n + 1        ! character to allow for delimiter
        END SELECT
    NEXT i
    IF len(delimiter$) = 0 then LET delimit_flag = 0 else LET delimit_flag = 1
    IF lengthy = 2 or lengthy = 4 then      ! length year OK
       IF lengthm >= 2 then       ! length month OK
          IF lengthd >= 1 and lengthd =< 2 then  ! length day OK
             LET user_date_format$ = string$
             LET order_date_string$ = d$
             EXIT SUB
          END IF
       END IF
    END IF
    CAUSE EXCEPTION 124,"Date format string ("  & string$ & ") is unacceptable."
    SUB Find_Position
        LET counter = 1           ! to count the number of times Y, M, or D occurs
        FOR k=n+1 to len(t$)      ! find a$ in t$
            IF t$[k:k] = a$ then LET counter = counter + 1 ELSE EXIT FOR
        NEXT k
        LET n = k                 ! reset n within the user_date_format$ string
    END SUB                       ! end of 'Find_Position'
END SUB                           ! of 'Change_Date_Format'

SUB parse_date(dat$,year,month,day)
    ! EXCEPTIONS: 125, "Date delimiter should be " & delimiter$ & "."
    !             126, "Improper date string."
    LET year, month, day = 0
    LET d$ = trim$(dat$)
    SELECT CASE delimit_flag
    CASE 0                        ! no template delimiters used
         WHEN error in
              IF val(trim$(d$)) <> 0 then LET flag = -1    ! month is numeric
         USE
              LET flag = 1
              CALL error_reset    ! reset error number
         END WHEN
         IF flag = -1 then        ! month is numeric, we think
            FOR t = 2 to 4        ! step through the order of the template 
                SELECT CASE order_date_string$[t:t]
                CASE "Y"
                     WHEN error in
                          IF t <> 4 then LET year = val(trim$(d$[1:lengthy])) else LET year = val(trim$(d$))
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                     LET d$ = trim$(d$[lengthy+1:len(d$)])      ! trim off year
                CASE "M"
                     WHEN error in
                          IF t <> 4 then LET month = val(trim$(d$[1:lengthm])) else LET month = val(trim$(d$))
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                     LET d$ = trim$(d$[lengthm+1:len(d$)])      ! trim off month
                CASE "D"
                     WHEN error in
                          IF t <> 4 then LET day = val(trim$(d$[1:lengthd])) else LET day = val(trim$(d$))
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                     LET d$ = trim$(d$[lengthd+1:len(d$)])      ! trim off day
                END SELECT        ! of CASE order_date_string$[t:t]
            NEXT t
         ELSE                     ! alphanumerics used for the month
            FOR t = 2 to 4        ! step through the order of the template 
                SELECT CASE order_date_string$[t:t]
                CASE "Y"
                     WHEN error in
                          IF t <> 4 then LET year = val(trim$(d$[1:lengthy])) else LET year = val(trim$(d$))
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                     LET d$ = trim$(d$[lengthy+1:len(d$)])      ! trim off year
                CASE "M"
                     IF d$[1:1] < "0" or d$[1:1] > "9" then     ! assumes month numeric
                        FOR n=1 to len(d$)  ! look for numbers
                            IF d$[n:n] >= "0" and d$[n:n] =< "9" then     ! only numbers     ! number found
                               LET month$ = trim$(d$[1:n-1])
                               LET d$ = trim$(d$[n:len(d$)])    ! trim off month
                               CALL parse_month  ! get month
                               EXIT FOR
                            END IF
                        NEXT n
                     ELSE         ! month assumed numeric
                        IF d$[lengthd:lengthd] >= "0" and d$[lengthd:lengthd] =< "9" then     ! numeric month
                           LET month = val(trim$(d$[1:lengthd]))
                           LET d$ = trim$(d$[lengthd+1:len(d$)])     ! trim off month
                        ELSE
                           LET month = val(trim$(d$[1:lengthd-1]))
                           LET d$ = trim$(d$[lengthd:len(d$)])  ! trim off month
                        END IF
                     END IF       ! end of 'if d$[1:1] < "0" or ...
                CASE "D"
                     WHEN error in
                          SELECT CASE ucase$(d$[lengthd:lengthd])
                          CASE "0" to "9"   ! only numbers
                               LET day = val(trim$(d$[1:lengthd]))
                               LET d$ = trim$(d$[lengthd+1:len(d$)])      ! trim off day
                          CASE else    ! everything else
                               LET day = val(trim$(d$[1:lengthd-1]))
                               LET d$ = trim$(d$[lengthd:len(d$)])   ! trim off day
                          END SELECT
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                END SELECT        ! of CASE order_date_string$[t:t]
            NEXT t
         END IF                   ! end of 'IF flag = -1 ...
    CASE else                     ! delimiters used
         LET x = pos(d$,delimiter$)
         LET y = pos(d$,delimiter$,x+1)
         IF x = 0 or y = 0 then   ! delimiter in string is not the same as set by Change_Date_Format
            CALL make_error(125,"Date delimiter should be '" & delimiter$ & "'.")
            LET year, month, day = 0
            EXIT SUB
         ELSE                     ! valid delimiters
            FOR t = 2 to 4        ! step through the order of the template 
                LET x = pos(d$,delimiter$)
                SELECT CASE order_date_string$[t:t]
                CASE "Y"
                     WHEN error in
                          IF x = 0 then     ! last item in string
                             LET year = val(trim$(d$))
                          ELSE    ! still more to do 
                             LET year = val(trim$(d$[1:x-1]))
                             LET d$ = trim$(d$[x+1:len(d$)])    ! trim off year and step past the delimiter
                          END IF
                          IF len(str$(year)) = 2 and len(str$(year)) <> lengthy then     ! catches disagreements between template and user entry
                             LET year = val(date$[1:4]) - val(date$[3:4]) + year
                          END IF
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                CASE "M"
                     IF x = 0 then     ! last item in string
                        LET month$ = trim$(d$)
                     ELSE         ! still more to do 
                        LET month$ = trim$(d$[1:x-1])
                        LET d$ = trim$(d$[x+1:len(d$)])    ! trim off month and step past the delimiter
                     END IF
                     IF month$[1:1] >= "A" then  ! assume alphanumeric month
                        CALL parse_month    ! get alphanumeric month
                     ELSE         ! get numeric month
                        WHEN error in
                             LET month = val(trim$(month$))
                        USE
                             CALL parse_date_error
                             EXIT SUB
                        END WHEN
                     END IF       ! end of 'IF month$[1:1] ...
                CASE "D"
                     WHEN error in
                          IF x = 0 then     ! last item in string
                             LET day = val(trim$(d$))
                          ELSE    ! still more to do 
                             LET day = val(trim$(d$[1:x-1]))
                             LET d$ = trim$(d$[x+1:len(d$)])    ! trim off day and step past the delimiter
                          END IF
                     USE
                          CALL parse_date_error
                          EXIT SUB
                     END WHEN
                END SELECT        ! of CASE order_date_string$[t:t]
            NEXT t
         END IF                   ! end of 'IF x = 0 ....
    END SELECT                    ! end of 'CASE len(delimiter$) ...
    SELECT CASE year
    CASE 0 to 99, 1700 to 2199
         SELECT CASE month
         CASE 1 to 12
              CALL Max_day(year)  ! get constants provided by subroutine
              IF day > 0 and day =< val(max_day$[month*2-1:month*2]) then EXIT SUB
         CASE else                !  cause error
         END SELECT
    CASE else                     !  cause error
    END SELECT
    CALL parse_date_error
    SUB parse_month               ! get month parameters
        FOR k=9 to len(month1$) step 9
            IF pos(trim$(ucase$(month1$[k-8:k]))[1:len(month$)],ucase$(month$)) <> 0 then
               IF lengthm = 3 then     ! take only first three letters of month
                  LET month$ = trim$(month1$[k-8:k])[1:3]
               ELSE               ! use full month name
                  LET month$ = trim$(month1$[k-8:k])
               END IF
               LET month = int(k/9)    ! assign month number
               EXIT FOR
            END IF
        NEXT k
    END SUB                       ! end of 'parse_month
    SUB parse_date_error          ! cause error for program checking
        CALL make_error(126,"Improper date string.")
        LET year, month, day = 0
    END SUB
END SUB                           ! of 'parse_date'

SUB Date_Data(year,month,day,julian$,month$,m_abrev$,dow_factor,dow_name$,rtn_date$,sort_date$)
    ! *** must enter with a four digit year ***
    CALL Max_Day(year)
    CALL error_reset              ! reset True BASIC's EXTYPE, EXTEXT$, and EXLINE$
    IF year < 1700 or year > 2199 then
       CALL make_error(120,"Input date out of 1700 to 2199 range.")
       EXIT SUB
    END IF
    !
    ! the numeric order of the days (for calulation purposes) is
    ! 0 through 6 (i.e., Saturday through Friday)
    ! but the program converts Saturday (day 0) to day 7 so the days 
    ! returned by the program is Sunday through Saturday numbered
    ! 1 through 7.
    !
    ! subroutine to determine day of the week based on an article
    ! by Michael C. Ahn, Computer Language, Jan 1988
    !
    SELECT CASE year              ! for dow calculations
    CASE 1700 to 1799,2100 to 2199
         LET year_factor = 4
    CASE 1800 to 1899
         LET year_factor = 2
    CASE 1900 to 1999
         LET year_factor = 0
    CASE 2000 to 2099
         LET year_factor = 6
    CASE else                     ! cause error date out of range
         CALL make_error(120,"Input date out of 1700 to 2199 range.")
         EXIT SUB
    END SELECT
    LET month$   = trim$(month1$[(month*9)-8:month*9])
    LET m_factor = val(m_factor$[month:month])
    LET m_abrev$ = month$[1:3]    ! first three letters of month
    LET year$ = str$(year)
    LET dow_factor = mod((val(year$[3:4]) + int(val(year$[3:4])/4) + m_factor + day + year_factor),7)
    IF  dow_factor = 0 then LET dow_factor = 7   ! change Saturday to day seven
    LET dow_name$  = trim$(dow$[9*dow_factor-8:9*dow_factor])
    LET rtn_date$ = ""
    FOR t=2 to 4
        SELECT CASE order_date_string$[t:t]
        CASE "Y"
             IF lengthy = 2 then  ! use only last two digits of year
                LET rtn_date$ = rtn_date$ & using$("%%",val(year$[3:4]))
             ELSE                 ! length is 4
                LET rtn_date$ = rtn_date$ & using$("%%%%",year)      ! leading pad of zero
             END IF
        CASE "M"
             SELECT CASE lengthm
             CASE 2               ! return numeric month
                  LET rtn_date$ = rtn_date$ & using$("%%",month)
             CASE 3               ! return first three letters of month
                  LET rtn_date$ = rtn_date$ & m_abrev$
             CASE else            ! return full month name
                  LET rtn_date$ = rtn_date$ & month$
             END SELECT
        CASE "D"
             IF lengthd = 1 then
                LET rtn_date$ = rtn_date$ & trim$(using$("##",day))  ! no preceding pads used
             ELSE
                LET rtn_date$ = rtn_date$ & using$("%%",day)    ! pad single digit days with zero
             END IF
        END SELECT                ! of CASE order_date_string$[t:t]
        CALL Check_Delimit
    NEXT t
    LET rtn_date$ = trim$(rtn_date$)   ! get rid of leading/trailing blanks
    LET sort_date$ = year$ & using$("%%",month) & using$("%%",day)
    FOR n=1 to month-1            ! sum up the days in the year for julian date
        LET total = total + val(max_day$[2*n-1:2*n])
    NEXT n
    LET julian$ = year$ & using$("%%%",total + day)
    SUB Check_Delimit
        IF delimit_flag = 0 then  ! no delimiter used
           LET rtn_date$ = rtn_date$ & " "
        ELSE                      ! delimiter used
           IF t <> 4 then         ! don't use delimiter if D, M, or Y is the last character
              LET rtn_date$ = rtn_date$ & delimiter$
           END IF
        END IF                    ! end of 'IF delimit_flag ....
    END SUB                       ! of sub 'Check_Delimit'
END SUB                           ! end of sub 'Date_Data'

SUB Max_Day(year)
    IF len(str$(year)) = 2 then   ! use current century from system
       LET x$ = cdate$
       IF extype = 0 then
          LET year = val(x$[1:4]) - val(x$[3:4]) + year
       ELSE
          CALL make_error(123,"System date not set.")
          EXIT SUB
       END IF
    END IF
    IF mod(year,4) = 0 and mod(year,100) <> 0 or mod(year,400) = 0 then   ! leap year
       LET max_day$  = max_day1$
       LET m_factor$ = "034025036146"
       LET leap_flag = 1
    ELSE                          ! not a leap year
       LET max_day$  = max_day2$
       LET m_factor$ = "144025036146"
       LET leap_flag = -1
    END IF
END SUB                           ! end of 'Max_Day'
END MODULE                        ! end of 'Date'