'=========================================================================
	' Personal Calendar (PC) Program
	'  Copyright (c) 1985-1990, Paul Munoz-Colman.  All Rights Reserved.
	'    Version 14.10
	'     31 Oct 1990
	'	Shareware $25
	'=========================================================================
	'              DOS File CAL3.BAS
	'  Independently Compiled Subprograms Which Are Linked With CAL1.BAS
	'=========================================================================
	'  Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
	'   Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
	'=========================================================================
	'  Note -- Tabs in the source file are in positions 6,11,16,21,26,...
	'=========================================================================
	' $INCLUDE: 'cal1.bi'
	'=========================================================================
	'  Subprogram List in the Order of Appearance in this File
	'   (compiled WITHOUT error handling--no /E or /X)
	'-------------------------------------------------------------------------
	'    Name                          Purpose
	'    ---------------------------   ---------------------------------------
	'	ApptToMenu (EntryPoint)		Raw Appt Rec to Menu and Vice Versa
	' Fn ASCIIN$ (ASCIIZString$)       Strip Chr$(0) From ASCIIZ String
	' Fn ASCIIZ$ (ASCIIString$)        Add Chr$(0) to ASCII String
	'    AutoStart                     Automatic Startup Setting Menu
	'	BigChars (CharsLin%, CharsColumn%, ChLin$)  Interface with MhChars
	'    BlankError                    Clear Error Message
	'    BlankFatal                    Clear Fatal Error (2 lines)
	' Fn BlankFill$ (ToBlankFill$)     Leading Zeroes to Blanks in String
	'	BoxDraw (Type, Top, Bottom, Left, Right)   Draw Box with MhBox
	'    BuildMenuLine                 Construct Menu Event Line    
	'    CheckDate (DatetoValidate$)   See If Date Is Really a Date
	'    ClearLast3                    Blank Last 3 Screen Lines
	'    ClearLast4                    Blank Last 4    "
	'    ClearOverdueTable             Clear Events Overdue Listing 
	'    ClearScreenNormal (TimerDesired)
	'                                  Clear Screen with Cl1f,Cl1b colors
	'    CloseFiles                    Close All Data Files
	'    ColorDecode (ColorAttribute)  Get Colors from Attribute
	'    CombineDateTime               Merge Date/Time Fields
	'    CompressApptFile (ShrinkNumber)
	'                                  Compress Appt File ShrinkNumber Recs
	'    ComputePendingValue (AlarmValue#,PendingValue#)
	'                                  Calculate Warning Date/Time
	'    ControlledInput (BoxRow,BoxColumn,MessageRow,MessageColumn,Length,_
	'         MessageText$,InputResponse$,NumlockRequest,FilenameShow,_
	'         ScreenBottomsShow,HoldAtEnd)  General Input Routine
	'	Credits (WhichLine)			Address, phone number, regi info
	'    DayDate (DatetoIndex$)        Get Day of Week and count for a Date
	' Fn	DirectoryExist(DirectoryName$) Interface with MhDirExist
	'    DirectReturnCheck             Whether Returning To Clock Screen
	'    DisplayApptFilename           Show Appointment File Name on Menus
	'	DOSBIOSServices			Interface to MhDOS2
	'    DoShell (ShellCommand$)       Run a Shell Command
	'    DOSShell                      Run DOS Session and Return
	'    EndItAll                      Return to DOS
	'    ErrorHandler                  Error Condition Message Generator
	'    EscapeLine                    Esc to Return Instruction
	'    EscapeLineDelete              Esc to Return Instruction Blankout
	'    EventErrorMessage             Display Error On Editing Instructions
	' Fn FileExist(ExistFilename$)	Interface with MhFileExist
	'    FileFormat                    Change Number of Notes/Events in File
	'    FileList                      Display List of Appointment Files
	'    GenerateGreeting              Display Main Menu Greeting
	'	GenGreetingScreen1			Startup Screen
	'    GetFilenameLength             Get Length of Appointment File Name
	'    GetOptions                    Read Options from Appointment File
	'    Help                          Help Function
	'    IncrementDate (DatetoIncrement$)
	'                                  Change a Date to the Next Date
	'    InitPrinter                   Initialize Printer w/Control Codes
	'=========================================================================
	SUB ApptToMenu (EntryPoint) STATIC
	'=========================================================================
	'  Convert Raw Appt Record to Menu Item (Entry Point 1)
	'  Convert Menu Item to Raw Appt Recrd  (Entry Point 2) -- future use
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 133
	CALL GetApptRecord(N1+WhichEvent)	'Fills CurrentEventRecord$
	CALL UnpackApptRecord			'Gets Individual Event Elements
	CALL CombineDateTime			'Gets Day of Week
	CALL BuildMenuLine				'Fills CurrentEventLine$
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	FUNCTION ASCIIN$ (ASCIIZString$) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 2
	' Take the Chr$(0) off an ASCIIZ String for Mh Routines
	ZeroPosition = InString(ASCIIZString$, CHR$(N0))
	IF ZeroPosition THEN
		ASCIIN$ = LEFT$(ASCIIZString$, ZeroPosition - N1)
	  ELSE
		ASCIIN$ = ASCIIZString$
	END IF
		Subnum = SubnumSave
	END FUNCTION
	'=========================================================================
	FUNCTION ASCIIZ$ (ASCIIString$) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 3
	' Add the Chr$(0) to an ASCII String for Mh Mach2 Routines
	IF RIGHT$(ASCIIString$, N1) <> CHR$(N0) THEN 
		ASCIIZ$ = ASCIIString$ + CHR$(N0)
	  ELSE
		ASCIIZ$ = ASCIIString$
	END IF
		Subnum = SubnumSave
	END FUNCTION
	'=========================================================================
	SUB AutoStart STATIC
	'=========================================================================
	'   Automatic Startup and TSR Mode (if DOS 3 or later) options
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 4
BeginAuto:
	CALL ClearScreenNormal(N1)
	'------------------------------------------------------------------------
	IF NOT DOS2x THEN
		ScreenTitles$(N1) = "Memory-Resident Options and Automatic Startup"
		CALL Titles(Nm1)
		MenuSize = N2
		MenuLines(N1) = "Memory-Resident (TSR Mode) Options"
		MenuLines(N2) = "Automatic Startup Options"
		CALL MenuDriver(MenuSize, MenuAutoTSR, N7, Nm1, _
			No, N0, N1, N1)
		IF MenuExit = MenuCancelled THEN
			CALL DirectReturnCheck
			CALL ClearScreenNormal(N1)
			GOTO ExitPoint
		END IF
		SELECT CASE MenuAutoTSR
			CASE 1                   ' TSR Options Menu
				CALL StayResOptions(No)
			CASE 2                   ' Autostart Options Menu
				ActionNote = N0
				GOTO BuildAutoMenu
		END SELECT
		GOTO BeginAuto
	END IF
	'------------------------------------------------------------------------
BuildAutoMenu:
	CALL ClearScreenNormal(N1)
	ScreenTitles$(N1) = "Automatic Startup"
	CALL Titles(Nm1)
	SELECT CASE ActionNote
		CASE 0		' No Message
		CASE 1		' Auto/Appointment
			ActionMessage$ = "Automatic Startup Set With Appointment File"
		CASE 2		' Auto/No Appointment
			ActionMessage$ = "Automatic Startup Set Without Appointment File"
		CASE 3		' Manual
			ActionMessage$ = "Manual Startup Set"
		CASE 4
			IF ForceDate THEN
				ActionMessage$ = "Set to Ask For Input of Date/Time"
			  ELSE
				ActionMessage$ = "Will Not Ask For Input of Date/Time"
			END IF
	END SELECT
	IF ActionNote THEN
		CALL PrepareforMessage
		CALL ShowIt(N0,N0,N0,ActionMessage$)
		ActionNote = N0
	END IF
	MenuSize = 4
	MenuRow = N7
	MenuLines(N1) = "Automatic Startup With Appointment File"
	MenuLines(N2) = "Automatic Startup With Clock and Calendar Only"
	MenuLines(N3) = "Manual Startup"
	MenuLines(4) = _
		"Ask For Date and Time When Program Starts, Currently "
	CALL MhNotBackwardInstr(Pointer%, N1%, (MenuLines(N4)), N32%)
	IF ForceDate THEN
		ScreenTag$ = Yess$
	  ELSE
		ScreenTag$ = "No "
	END IF
	CALL Myd2(MenuLines(N4), Pointer + N2, N3, ScreenTag$)
	CALL MenuDriver(MenuSize, MenuAuto, MenuRow, Nm1, No, N0, N1, N1)
	CALL BlankError
	IF MenuExit = MenuCancelled THEN
		CALL DirectReturnCheck
		CALL ClearScreenNormal(N1)
		IF NOT DOS2x THEN GOTO BeginAuto ELSE GOTO ExitPoint
	END IF
	ActionNote = MenuAuto
	'------------------------------------------------------------------------
	SELECT CASE MenuAuto
		CASE 1    ' Autostart with Appt File
			AutostartMode = Yes
			BoxRow = MenuRow + MenuSize + 4
			MessageRow = BoxRow
			InputResponse$ = ApptFilename$
			CALL ControlledInput(BoxRow, N40, MessageRow, N1, N8, _
				"Enter Appointment File Name", InputResponse$, _
				N0, N1, N1, N1)
			IF Keystroke$ = CHR$(Esc) THEN GOTO BuildAutoMenu
			IF InputResponse$ <> ApptFilename$ THEN EventTableStable = No
			ApptFilename$ = InputResponse$
			'   File Password
			BoxRow = MenuRow + MenuSize + 5
			MessageRow = BoxRow
PasswordCheck:
			FOR I = N1 TO N2
				IF I = N1 THEN
					MessageText$ = "Enter Appointment File Password     "
				  ELSE
					MessageText$ = "Re-Enter Password To Confirm, Please"
				END IF
				InputResponse$ = SPACE$(8)
				EchoSuppression = Yes
				CALL ControlledInput(BoxRow, N40, MessageRow, N1, N8, _
					MessageText$, InputResponse$, N0, N1, N1, N1)
				EchoSuppression = No
				IF Keystroke$ = CHR$(Esc) THEN GOTO BuildAutoMenu
				CALL BlankFatal
				IF I = N1 THEN PasswordHold$ = InputResponse$
			NEXT
			IF PasswordHold$ <> InputResponse$ THEN
				CALL MajorBeeper
				CALL Kolors(N14)
				CALL BlankError
				CALL ShowIt(N0, N0, N0, _
					"Password Confirmation Doesn't Match -- Try Again")
				GOTO PasswordCheck
			END IF
			ApptPassword$ = InputResponse$
			EnteredPassword$ = InputResponse$
		CASE 2    ' Autostart without Appt File
			EventTableStable = No
			ApptFilename$ = Blank8$
			ApptPassword$ = Blank8$
			AutostartMode = Yes
		CASE 3    ' Manual start (later without appointment file)
			AutostartMode = No
		CASE 4
			IF ForceDate THEN		'  Force DOS Date/Time Set
				ForceDate = No		'   on Program Start
			  ELSE
				ForceDate = Yes
			END IF
	END SELECT
	CALL WriteCalauto                  '  Rewrite CALAUTO.DAT File
	GOTO BuildAutoMenu
ExitPoint:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB BigChars (CharRow%, CharColumn%, CharLin$)  STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 136
	' Interface with MhChars
	SPage% = ScreenPage%			' Error in MhChars changes the value
	CAttribute% = ColorAttribute%		' of CColumn on return from the 
	CRow% = CharRow%				' routine
	CColumn% = CharColumn%
	CLin$ = CharLin$
	CALL MhChars (SPage%, CRow%, CColumn%, CAttribute%, CLin$)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB BlankError STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 5
	CALL ShowErase(N0, ErrMsgPlacement, N1, N80, Blank0$)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB BlankFatal STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 6
	FOR I = N1 TO N2
		CALL ShowErase(N0, (ErrMsgPlacement + I - N1), N1, N80, Blank0$)
	NEXT
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	FUNCTION BlankFill$ (ToBlankFill$) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 7
	'  Fill leading Zeroes with Blanks
	BlankDummy$ = ToBlankFill$			' Save String
	IF LEN(BlankDummy$) THEN				' If non-null, find first non-zero
		CALL MhNotInstr(FirstNonZero%, Start%, BlankDummy$, N48%)
		IF FirstNonZero > N1 THEN		'if one in pos 2 or more => zeroes
			ToFill = FirstNonZero - N1	'  Fill them all with blanks
			CALL Myd2(BlankDummy$, N1, ToFill, Strng$(ToFill, N32))
		END IF
	END IF
	BlankFill$ = BlankDummy$			' and save the result
		Subnum = SubnumSave
	END FUNCTION
	'=========================================================================
	SUB BoxDraw (BoxType, BoxTop, BoxBottom, BoxLeft, BoxRight)  STATIC
	'=========================================================================
	'   Draw a Box with MhBox, Simplifying Calling Parameters
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 32
	CALL MhBox(ColorAttribute%, BoxType%, ColorAttribute%, ScreenPage%, _
			BoxTop%, BoxLeft%, BoxBottom%, BoxRight%)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB BuildMenuLine  STATIC
	'=========================================================================
	'   Construct Individual Event Menu Line--Compute Day Of Week
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 103
	IF CurrentEventRecord$ = Blank80$ THEN
		CALL MhLset(CurrentEventLine$, NullEvent$)
		GOTO ExitPoint0
	END IF
	ScreenTag$ = Blank3$
	IF EventDate$ <> Blank8$ THEN ' First Try To Get It From The
		J = N0         ' Weekly or Monthly "N" Day Indicator Digit
		ErrorSwitch = No
		IF InString("BbWwNn123456789", MID$(EventRepeat$, N1, N1)) THEN
			J = VAL(MID$(EventRepeat$, N2, N1))
		END IF
		IF J <= N0 OR J >= 8 THEN      'If Not There or No Good
			'  Compute It From The Date
			CALL BuildMenuDate(EventDate$)	' does error handling
			J = IndexedDay
		END IF
		IF NOT ErrorSwitch THEN
			'-----------------------------------------------------
			' Get The Alphabetic Day Of The Week For The Display
			CALL Myd2(ScreenTag$, N1, N3, DayNames$(J))
		END IF
		ErrorSwitch = No
	END IF
	'-------------------------------------------------------------------------
	'     Place Each Data Field Where It Belongs In The Menu Line
	IF EventLimRepeat$ = Blank2$ THEN
		CALL Myd2(LimSep$, N1, N1, Blank1$)
	  ELSE 
		CALL Myd2(LimSep$, N1, N1, Hyphen$)
	END IF
	CALL Myd2(CurrentEventLine$, N1, N2, EventLimRepeat$)
	CALL Myd2(CurrentEventLine$, N3, N1, LimSep$)
	CALL Myd2(CurrentEventLine$, N4, N3, EventRepeat$)
	CALL Myd2(CurrentEventLine$, N7, N1, Blank1$)
	CALL Myd2(CurrentEventLine$, N8, N2, EventMonth$)
	CALL Myd2(CurrentEventLine$, N10, N1, Hyphen$)
	CALL Myd2(CurrentEventLine$, N11, N2, EventDay$)
	CALL Myd2(CurrentEventLine$, N13, N1, Hyphen$)
	CALL Myd2(CurrentEventLine$, N14, N2, EventYear$)
	CALL Myd2(CurrentEventLine$, N16, N1, Blank1$)
	CALL Myd2(CurrentEventLine$, N17, N3, ScreenTag$)
	CALL Myd2(CurrentEventLine$, N20, N1, Blank1$)
	CALL Myd2(CurrentEventLine$, N21, N2, EventHour$)
	CALL Myd2(CurrentEventLine$, N23, N1, ":")
	CALL Myd2(CurrentEventLine$, N24, N2, EventMinute$)
	CALL Myd2(CurrentEventLine$, N26, N2, Blank2$)
	CALL Myd2(CurrentEventLine$, N28, TextSize, EventText$)
ExitPoint0:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB CheckDate (DateToValidate$) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 8
	'  Check Date For Validity
	'  Input  DateToValidate$ (YYYYMMDDHHMM)
	'  Output DateValidation   0 or 1 (Error)
	DateValidation = N0
	ReturnMessage$ = Blank0$
	'           Check Date/Time
	IF MID$(DateToValidate$, N1, 8) = Blank8$ THEN 
		CALL Myd2(DateToValidate$, N1, N8, TodaysDate$)
	END IF
	'           Date
	IF MID$(DateToValidate$, 9, 4) = SPACE$(4) THEN 
		CALL Myd2(DateToValidate$, N9, N4, CurrentTime$)
	END IF
	'           Time
	IF NumberError(DateToValidate$) = N1 THEN
		ReturnMessage$ = "Non-Numeric Date"
		GOTO DateBad
	END IF
	'           Numerics
	ValidateYear = VAL(MID$(DateToValidate$, N1, 4))
	FOR I = N1 TO 4
		'           Y,M,D,H,M
		DateEdit(I) = VAL(MID$(DateToValidate$, I * N2 + N3, N2))
		'           Numeric
		IF I < N3 AND DateEdit(I) <= N0 THEN
			ReturnMessage$ = "Non-Positive Date"
			GOTO DateBad
		END IF
		IF I > N2 AND DateEdit(I) <= Nm1 THEN
			ReturnMessage$ = "Negative Date"
			GOTO DateBad
		END IF
		IF I <> N2 THEN
			' Days In Month
			IF DateEdit(I) > DateEditLimits(I) THEN
				ReturnMessage$ = "Date Too Large"
				GOTO DateBad
			  ELSE
				GOTO NextDatePart
			END IF
		END IF
		IF DateEdit(N1) <> N2 OR DateEdit(N2) <> 29 THEN
			' February 29th
			IF DateEdit(N2) > MonthLength(DateEdit(N1)) THEN
				ReturnMessage$ = "Date Too Large"
				GOTO DateBad
			  ELSE
				GOTO NextDatePart
			END IF
		END IF
		'           Days In Month
		IF NOT Leap(ValidateYear) THEN
			ReturnMessage$ = "Not Leap Year"
			GOTO DateBad
		END IF
		'           Leap Year
NextDatePart:
	NEXT
	GOTO ExitPoint2
	'           Ok
DateBad:
	DateValidation = N1
	'           Error
ExitPoint2:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ClearLast3 STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 9
	CALL ShowMult(N0, N23, N1, N80, N3)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ClearLast4 STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 10
	CALL ShowMult(N0, N22, N1, N80, N4)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ClearOverdueTable STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 11
	'     Clear Overdue Event Table
	CLOSE FilenumOverdue
	CALL KillAFile(ApptFilenameOverdue$)
	OverdueCount = N0
	RedisplayCalendars = Yes
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ClearScreenNormal (ClearTimerDesired) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 12
	CALL Kolors(N6)
	CLS
	TimerDesired = ClearTimerDesired
	IF TimerDesired THEN
		TimerDisplaySuppress = No
		CALL KeyStuff(KeyTimerInit)        ' Show Timer & State Flags
		CALL DisplayApptFilename           '  & appt file name if one
	  ELSE
		TimerDisplaySuppress = Yes
	END IF
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB CloseFiles STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 13
	CLOSE
	ApptFile = No
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ColorDecode (CDColorAttribute)  STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 14
	'  Given a color attribute, find the foreground and background colors
	ColorBackground = (CDColorAttribute - (CDColorAttribute AND 128)) \ 16
	ColorForeground = (CDColorAttribute - _
				    (CDColorAttribute AND 128)) MOD 16 + _
					(CDColorAttribute AND 128) \ 8
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB CombineDateTime STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 15
	CALL Myd2(EventDate$, N1, N2, EventYear1st2$)
	CALL Myd2(EventDate$, N3, N2, EventYear$)
	CALL Myd2(EventDate$, N5, N2, EventMonth$)
	CALL Myd2(EventDate$, N7, N2, EventDay$)
	CALL Myd2(EventTime$, N1, N2, EventHour$)
	CALL Myd2(EventTime$, N3, N2, EventMinute$)
	CALL Myd2(EventDateTime$, N1, N8, EventDate$)
	CALL Myd2(EventDateTime$, N9, N4, EventTime$)
	CombinedDateTime# = VAL(EventDateTime$)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB CompressApptFile (ShrinkNumber) STATIC
	'=========================================================================
	'  Compress Appointment File By ShrinkNumber Records From the End
	'  Delete Blank or Duplicate History Records in the Process
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 104
	CALL ShowErase(N14, N25, N1, N80, _
		"       Please Wait--Compressing Appointment File")
	InputEOF = LOF(FilenumAppt) \ N80
	'     By Opening A New Appointment File ApptFilename$.cln
	'     And Copying The Old File To The New One
	CALL KillAFile(ApptFilename$ + ".cln")
	OutputIndex = N1
	CLOSE FilenumNewAppt
	OPEN "R", FilenumNewAppt, ApptFilename$ + ".cln", N80
	FIELD FilenumNewAppt, N80 AS NewApptBuffer$
	'  Loop through File to Move Records
	FOR InputIndex = N1 TO InputEOF - ShrinkNumber
	  CALL KeyStuff(KeyStatus)
	  CALL ShowIt(N14, N25, N49, (STR$(InputEOF - ShrinkNumber - _
		InputIndex + N1) + SPACE$(N4))) ' Count
	  CALL GetApptRecord(InputIndex)             ' Next Record
	  IF (InputIndex < StartingHistory) OR (ApptBuffer$ <> Blank80$ AND _
		 ApptBufferHold$ <> ApptBuffer$ AND _
		 ApptBuffer$ <> NullEvent$ AND _
		 ApptBuffer$ <> NullEventOld$)		THEN
		   '   Move Record To Output
		   CALL MhLset(NewApptBuffer$, ApptBuffer$)
		   PUT FilenumNewAppt, OutputIndex           ' Write to New File
		   ' Save for Next Comparison
		   ApptBufferHold$ = ApptBuffer$
		   OutputIndex = OutputIndex + N1        ' Bump Record Counter
	  END IF
	  IF (InputIndex - StartingHistory + N1) = (CurrentNoteHist) THEN
	  '  Set New History Pointer
	    CurrentNoteHist = OutputIndex - StartingHistory + N1
	  END IF
	NEXT
	'  Then Deleting The Old One,
	'    Renaming The New One ApptFilename$.cld
	'       And Reopening It As The Appointment File--Magic!
	CALL CloseFiles
	CALL KillAFile(ApptFilename$ + ".cld")
	CALL MhRename ((ASCIIZ$(ApptFilename$ + ".cln")), _
			(ASCIIZ$(ApptFilename$ + ".cld")), Ecode%)
		IF Ecode THEN ERROR 255
	CALL OpenAppts
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ComputePendingValue (AlarmValue#, PendingValue#) STATIC
	'=========================================================================
	'   Get Date/Time Subtracting Minutes Value (For Pending Function)
	'   Input is AlarmValue# (YYYYMMDDTTTT), Return is PendingValue# (Same)
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 16
	'   Break Down AlarmValue Into Parts
	PendingString$ = RIGHT$(STR$(AlarmValue#), 12)
	PendingYear = VAL(MID$(PendingString$, N1, 4))
	PendingMonth = VAL(MID$(PendingString$, 5, N2))
	PendingDay = VAL(MID$(PendingString$, N7, N2))
	PendingHours = VAL(MID$(PendingString$, 9, N2))
	PendingMinutes = VAL(MID$(PendingString$, 11, N2))
	'  Test if enough minutes left to subtract Pending
TestMinutes:
	IF PendingMinutes >= Pending THEN
		PendingMinutes = PendingMinutes - Pending
		GOTO RebuildDate
	END IF
	'  Not enough minutes, try hours
TestHours:
	IF PendingHours > N0 THEN
		PendingHours = PendingHours - N1
		PendingMinutes = PendingMinutes + 60
		GOTO TestMinutes
	END IF
	'  Not enough hours, try days
TestDays:
	IF PendingDay > N1 THEN
		PendingDay = PendingDay - N1
		PendingHours = PendingHours + 24
		GOTO TestHours
	END IF
	'  Not enough days, try months, (check for leap year if feb)
TestMonths:
	IF PendingMonth > N1 THEN
		PendingMonth = PendingMonth - N1
		PendingDay = PendingDay + MonthLength(PendingMonth)
		IF PendingMonth <> N2 THEN GOTO TestDays
		  PendingDay = PendingDay + Leap(PendingYear)
		  GOTO TestDays
	END IF
	'  Not enough years, subtract one
	PendingYear = PendingYear - N1
	PendingMonth = PendingMonth + 12
	GOTO TestMonths
	'  Put the value back together - no blanks
RebuildDate:
	CALL YearAdjust(PendingYear, AdjustedYear$)
	PendingString$ = ZeroFill$(AdjustedYear$ + RIGHT$(STR$(PendingMonth), _
		N2) + RIGHT$(STR$(PendingDay), N2) + RIGHT$(STR$(PendingHours), _
		N2) + RIGHT$(STR$(PendingMinutes), N2))
	PendingValue# = VAL(PendingString$)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB ControlledInput (CBoxRow, CBoxColumn, CMessageRow, _
		CMessageColumn, CLength, CMessageText$, CInputResponse$, _
		NumlockRequest, CFilenameShow, CScreenBottomsShow, CHoldAtEnd) STATIC
	'=========================================================================
	'   Accept Input, Given Location, Length, Prompt Message
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 17
	'-------------------------------------------------------------------------
	'         Input/Output Call Parameters
	'  BoxRow,BoxColumn             Placement Of Editing Field
	'  MessageRow,MessageColumn     Placement Of Prompt Message
	'  MessageText$                 Prompt Message
	'  Length                       Length Of Prompt Message
	'  InputResponse$               Returned Response (in Common)
	'  HoldAtEnd                    Hold Cursor at End Input
	'  NumlockRequest               Change Value of Numlock (1=on, 0=off)
	'  FilenameShow                 Display Appointment Filename
	'  ScreenBottomsShow            Display Screen Bottom Prompts
	BoxRow = CBoxRow
	BoxColumn = CBoxColumn
	MessageRow = CMessageRow
	MessageColumn = CMessageColumn
	Length = CLength
	MessageText$ = CMessageText$
	FilenameShow = CFilenameShow
	ScreenBottomsShow = CScreenBottomsShow
	HoldAtEnd = CHoldAtEnd
	InputResponse$ = CInputResponse$
	'-------------------------------------------------------------------------
	'     Display Box For Input Value To Be Placed In
	IF NumlockRequest THEN                  ' This will automatically
		CALL KeyStuff(KeyNumOn)            '  turn Insert off until
	  ELSE                                  '  allowed
		CALL KeyStuff(KeyNumOff)
	END IF
	AllowInsertMode = Yes
	IF FilenameShow THEN CALL DisplayApptFilename
	IF ScreenBottomsShow THEN CALL ScreenBottoms
	InLength = LEN(InputResponse$)
	IF InLength < Length THEN               ' Pad out if too short
		InputResponse$ = InputResponse$ + SPACE$(Length - InLength)
	END IF
	IF InLength > Length THEN               '   or chop off if too long
		InputResponse$ = LEFT$(InputResponse$, Length)
	END IF
	'  Establish the Box
	CALL ShowIt(N14, BoxRow, BoxColumn, (SPACE$(Length)))
	'-------------------------------------------------------------------------
	'     Display The Initial Value Of Input And Prompt Message
	IF NOT EchoSuppression THEN
		CALL ShowIt(N0, N0, N0, InputResponse$)
	  ELSE
		' Blanks
		CALL ShowIt(N0, N0, N0, (Strng$(LEN(InputResponse$), N32))) 
	END IF
	CALL ShowIt(N6, MessageRow, MessageColumn, MessageText$)
	'-------------------------------------------------------------------------
	'     Place The Cursor, Set Character Position (J)
	CALL Kolors(N14)
	CursorRow = BoxRow
	CursorColumn = BoxColumn
	CALL KeyStuff(KeyCursor)           ' Turn the cursor on
	J = N1
	'-------------------------------------------------------------------------
	' Special Editing Keys
	'    Shift-Tab     Goes To Left End Of Editing Field
	'    Shift-Return  Goes To Right End Of Editing Field
	'    Shift-Delete  Deletes Rest Of Editing Field From Cursor To End
	'=========================================================================
	'  Next Keystroke Comes Back to Here
	'=========================================================================
WordStart:
	DisplayWholeWord$ = False$         'Whole Word Instead of 1 Character
	CursorIncremented = N0              'Cursor Moved After Character
	IncrementCursor$ = False$          'Request to Move Cursor Right
	NormalKeystroke$ = False$          'Character Entered Flag
	'=========================================================================
KeyGet:
	KeyTrapEnabled = Yes          'Enable Editing Key Trap
	CALL KeyStuff(KeySingle)      'Move the Cursor/Get a Keystroke
	KeyTrapEnabled = No           'Disable Editing Key Trap
	'=========================================================================
	SELECT CASE KeyShiftTrap           ' Special Key Traps From Main Level
		CASE 0                             'None (0)
			CALL Kolors(N14)
			SELECT CASE LEN(Keystroke$) + N1'Regular Keystrokes
				CASE 1                             'No Keystroke
					GOTO KeyGet
				CASE 2                             'Length One Keys
					GOTO OneKeys
				CASE 3                             'Length Two Keys
					GOTO TwoKeys
			END SELECT
		CASE 2                             'Shift Tab (2)
			'---------------------------------------------------------------
			'     Shift-Tab Goes To Left End Of Editing Field (also home)
			KeyShiftTrap = N0
LeftEndOfField:
			J = N1
			CursorRow = BoxRow
			CursorColumn = BoxColumn + J - N1
			GOTO WordStart
		CASE 3                             'Shift Return (3)
			'---------------------------------------------------------------
			'     Shift-Return  Goes To Right End Of Editing Field (also end)
			KeyShiftTrap = N0
RightEndOfField:
			J = Length
			CursorRow = BoxRow
			CursorColumn = BoxColumn + J - N1
			GOTO WordStart
		CASE 4                             'Shift Delete (4)
			'---------------------------------------------------------------
			' Shift-Delete  Deletes Rest Of Editing Field From Cursor To End
			KeyShiftTrap = N0
			CALL Myd2(InputResponse$, J, Length - J + N1, _
				(Strng$(Length - J + N1, N32)))
			DisplayWholeWord$ = True$
			IncrementCursor$ = False$
			GOTO NewCharWholeWord
		CASE 5                             'Ctrl-Right-Arrow (5)
			'---------------------------------------------------------------
			'     Ctrl-Right-Arrow Goes to Next Word
			KeyShiftTrap = N0
			IF MID$(InputResponse$, J, N1) = Blank1$ THEN  'Next Non-Blank
				CALL MhNotInstr(Pointer%, J%, InputResponse$, N32)
				IF Pointer THEN J = Pointer			 'If Was Blank
			  ELSE
				CALL MhInstr(Pointer%, J%, InputResponse$, Blank1$)
				IF Pointer <> N0 AND Pointer <> Length THEN 'Next Blank
					CALL MhNotInstr(Pointer%, (Pointer% + N1%), _
						InputResponse$, 32)				'Then Next
					IF Pointer THEN J = Pointer			'Non-Blank
				END IF
			END IF
			CursorRow = BoxRow
			CursorColumn = BoxColumn + J - N1
			GOTO WordStart
		CASE 6                             'Ctrl-Left-Arrow (6)
			'---------------------------------------------------------------
			'     Ctrl-Left-Arrow Goes to Previous Word
			FirstNonBlankChar = No
			KeyShiftTrap = N0
			FromRightEnd = Length - J + N1 	' From Right End, Not Left
										' Find Last non blk
			IF MID$(InputResponse$, J, N1) = Blank1$ THEN  
NowDoBlank:
				CALL MhNotBackwardInstr(Pointer%, FromRightEnd%, _
					InputResponse$, N32)
				IF Pointer < N2 OR FirstNonBlankChar = Yes THEN
					IF Pointer <> N0 THEN 
						J = Pointer 
					  ELSE 
						J = N1
					END IF
					GOTO PrevWordDone
				END IF
				FromRightEnd = Length - Pointer + N1
			END IF
			CALL MhBackwardInstr(Pointer%, FromRightEnd%, _
					InputResponse$, Blank1$) 		' to next blank
			SELECT CASE Pointer
				CASE 0
					J = N1
				CASE IS = (J - N1)
					IF FirstNonBlankChar THEN GOTO CaseElse
						FirstNonBlankChar = Yes
						FromRightEnd = FromRightEnd + N1
						GOTO NowDoBlank
				CASE ELSE
CaseElse:
					J = Pointer + N1
			END SELECT
PrevWordDone:
			CursorRow = BoxRow
			CursorColumn = BoxColumn + J - N1
			GOTO WordStart
	END SELECT
	'=========================================================================
	'     Length One Keys--Take Action
	'=========================================================================
OneKeys:
	SELECT CASE InString(CHR$(Enter) + CHR$(Tabb) + CHR$(Bsp) + CHR$(Esc), _
				RIGHT$(Keystroke$, N1))
		CASE 1, 2, 4                  'Enter, Tab, Esc Keys (Exits)
			GOTO WordOut
		CASE 3                        'Back Space Key (Deletes Prev Char)
			'---------------------------------------------------------------
			'Backspace, If Beginning, Sound Bell, Otherwise Delete Char Left
			IF J = N1 THEN
				CALL MinorBeeper
				GOTO WordStart
			END IF
			J = J - N1
			CALL Myd2(InputResponse$, J, N1, Blank1$)
			IncrementCursor$ = False$
			IF Insrt% = N1 THEN      ' If Insert Mode
				GOSUB ShiftLeft          ' Move String After Character
			  ELSE
				DisplayWholeWord$ = False$' Else Delete Only Character
			END IF
			GOTO NewCharWholeWord
		CASE ELSE                     'Other Length One Keys (Normal Input)
			'---------------------------------------------------------------
			' Other Input Keys, Save Keystroke In Current Character Position
			'  If Insert Mode is On, Move String Right As Character Types
			IF Insrt% = N1 THEN
				GOSUB ShiftRight
				DisplayWholeWord$ = True$
			  ELSE
				DisplayWholeWord$ = False$
			END IF
			CALL Myd2(InputResponse$, J, N1, Keystroke$)
			IncrementCursor$ = True$
			NormalKeystroke$ = True$
			GOTO NewCharWholeWord
	END SELECT
	'=========================================================================
	'     Length Two Keys--Take Action
	'=========================================================================
TwoKeys:
	SELECT CASE InString(CHR$(F1) + CHR$(West) + CHR$(East) + CHR$(Del) + _
		                CHR$(HomeKey) + CHR$(EndKey), RIGHT$(Keystroke$, N1))
		CASE 1                        'F1 (Exits)
			GOTO WordOut
		CASE 2                        'West (Cursor Left)
			'---------------------------------------------------------------
			'     West Moves Cursor Left One
			IF J = N1 THEN
				CALL MinorBeeper
			  ELSE
				J = J - N1
				CursorRow = BoxRow
				CursorColumn = BoxColumn + J - N1
			END IF
			GOTO WordStart
		CASE 3                        'East (Cursor Right)
			'---------------------------------------------------------------
			'     East Moves Cursor Right One
			IF J = Length THEN
				CALL MinorBeeper
			  ELSE
				J = J + N1
				CursorRow = BoxRow
				CursorColumn = BoxColumn + J - N1
			END IF
			GOTO WordStart
		CASE 4                        'Delete (String Left)
			'---------------------------------------------------------------
			'     Delete Moves Whole String Left One, Trailing A Space
			GOSUB ShiftLeft
			GOTO NewCharWholeWord
		CASE 5					'Home (same as shift-tab)
			'---------------------------------------------------------------
			GOTO LeftEndOfField
		CASE 6					'End  (same as shift-return)
			'---------------------------------------------------------------
			GOTO RightEndOfField
		CASE ELSE                     'Error -- get another keystroke
			'---------------------------------------------------------------
			CALL MinorBeeper
			GOTO WordStart
	END SELECT
	'=========================================================================
	'  New Character or Whole Word Display Comes Here
	'=========================================================================
NewCharWholeWord:
	IF DisplayWholeWord$ = True$ THEN
		GOSUB WordShow                              'Display Whole Word
		DisplayWholeWord$ = False$
	  ELSE                                            'or
		IF NOT EchoSuppression THEN
			CALL ShowIt(N0, BoxRow, (BoxColumn + J - N1), _
				(MID$(InputResponse$, J, N1)))   'Just One Character
		  ELSE                                       'or
			CALL ShowIt(N0, BoxRow, (BoxColumn + J - N1), Blank1$)
	'                                             Blank if Suppressed
		END IF
	END IF
	'-------------------------------------------------------------------------
	IF IncrementCursor$ = True$ THEN
		IF J < Length THEN                 'Move Cursor, Don't Overrun Field
			CursorIncremented = N1
			J = J + N1
		  ELSE
			CursorIncremented = N0
		END IF
	END IF
	'-------------------------------------------------------------------------
	'  Place The Cursor In Its New Position
	CursorRow = BoxRow
	CursorColumn = BoxColumn + J - N1
	'-------------------------------------------------------------------------
	'  Get Next Keystroke If Any Of The Following ---
	IF HoldAtEnd OR J < Length OR NormalKeystroke$ = False$ OR _
		(NormalKeystroke$ = True$ AND CursorIncremented = N1) 		THEN
		GOTO WordStart
	END IF					'  Character at end of field gets out
	'=========================================================================
	'  Get Out Here -- We're Finished
	'=========================================================================
	'     No hold, F1, Enter, Tab, And Escape End It All
WordOut:
	CALL Kolors(N7)
	GOSUB WordShow                         '  At End, Display Whole Word
	CALL Kolors(N6)
	GOTO Finished
	'-------------------------------------------------------------------------
	'     Reprint Entire Input Word And Reposition Cursor Where It Was
WordShow:
	IF NOT EchoSuppression THEN
		CALL ShowIt(N0, BoxRow, BoxColumn, InputResponse$)
	  ELSE
		CALL ShowIt(N0, BoxRow, BoxColumn, _
			(Strng$(LEN(InputResponse$), N32)))
	END IF
	RETURN
	'---------------------------------------------------------------
	'Insert Mode Moves Whole String Right One, Truncating, Inserts Space
ShiftRight:
	IF J <> Length THEN 
		MID$(InputResponse$, J + N1, Length - J) = _  'MhMidString made all
			MID$(InputResponse$, J, Length - J)	  ' the characters the
	END IF									  ' same as the 1st
	CALL Myd2(InputResponse$, J, N1, Blank1$)
	RETURN
	'---------------------------------------------------------------
	'Delete Moves Whole String Left One, Trails with Space
ShiftLeft:
	IF J <> Length THEN 
		CALL MhMidString(InputResponse$, J%, Length% - J%, _
			InputResponse$, J% + N1%)
	END IF
	CALL Myd2(InputResponse$, Length, N1, Blank1$)
	DisplayWholeWord$ = True$
	IncrementCursor$ = False$
	RETURN
	'-------------------------------------------------------------------------
Finished:
	CInputResponse$ = InputResponse$
	AllowInsertMode = No
	CALL KeyStuff(KeyCursorOff)        '  Turn Cursor Off
	CALL KeyStuff(KeyNumOff)           '  Turn Numlock Off
	IF ScreenBottomsShow THEN CALL ScreenBottomsDelete
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB Credits (WhichLine)  STATIC
	'=========================================================================
	'   Phone Number, Address, Registration Fee or Owner
	'	Used by GenGreeting1 and EndItAll
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 139
	AddressLine = WhichLine + N1
	BoxEnd = WhichLine + N4
	CopyLine = WhichLine + N5
	IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
	CALL BoxDraw(N1, WhichLine, BoxEnd, N8, N38)
	CALL BoxDraw(N1, WhichLine, BoxEnd, N48, N72)
	CALL ShowMult(N6, AddressLine, N9, N29, N3)
	CALL ShowMult(N6, AddressLine, N49, N23, N3)
	CALL ShowIt(N6, AddressLine, N10, "11645 Charter Oak Ct., #201")
	CALL ShowIt(N0, Nm1, N13, "Reston, VA  22090-4526")
	CALL ShowIt(N0, Nm1, N16, "(703)  435-1110")
	CALL ValidateUser (WhichLine)
	IF ColorCRT THEN CALL Kolors(N4) ELSE CALL Kolors(N7)
	CALL ShowIt(N0, CopyLine, Nm2, _
   " Copyright (c) 1985-1990 by Paul Mu¤oz-Colman.  All rights reserved. ")
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB DayDate (DateToIndex$)  STATIC
	'=========================================================================
	'   Find The Day Of The Week For A Date (DayDate)
	'     (DateToIndex$ in gives IndexedDay out)
	'    Good from Years 0001 to 9999
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 18
	'-------------------------------------------------------------------------
	'  Appreciation to Herb Goertzel for his simple and brilliant piece of
	'  mathematics.  Day of week is number of years (residues; 365 Mod 7 = One)
	'  plus leap year days plus current year days, modulo 7, plus 1.
	'-------------------------------------------------------------------------
	Year = VAL(MID$(DateToIndex$, N1, 4))                 'The Year
	Month = VAL(MID$(DateToIndex$, 5, N2))                'The Month
	Day = VAL(MID$(DateToIndex$, N7, N2))                  'The Day
	'-------------------------------------------------------------------------
	'  For The Current Year, Count Leap Year Day If Necessary
	'  If This Isn't A Leap Year or Before March, Don't Count Leap Year Day
	'  If Before March Don't Count Feb 29th Because It's Included in "Day"
	IF Month < N3 THEN
		    LeapYearDay = N0    'Then don't count leap year
	    ELSE
		    LeapYearDay = Leap(Year)   'Else count it
	END IF
	'-------------------------------------------------------------------------
	'  Now Count The Number of Year Residues and Add In Past Leap Year Days
	Prioryears = Year - N1
	PriorYearsWLeaps = Prioryears + INT(Prioryears / 4) + _
		INT(Prioryears / 400) - INT(Prioryears / 100)  '  - Every 100th Year
	PriorYearsLeaps = PriorYearsWLeaps - Prioryears     '   except 400th
	PriorYearsDays& = Prioryears * 365&
	'-------------------------------------------------------------------------
	'  Now Add the Days This Year Into The Total (Also Do The Julian Date)
	'  Total   = Residue  +  Prior Months + This Month + Leap Year
	AllWLeaps = PriorYearsWLeaps + JulianDays(Month) + Day + LeapYearDay
	JulianDate& = AllWLeaps - PriorYearsWLeaps + 1000& * (Year MOD 100)
	'-------------------------------------------------------------------------
	'   Take The Whole Thing Modulo 7 and Make Non-Zero
	'  (If the calendar had started in the year 0000, Jan 1, 0000 would
	'   arithmetically have been a Saturday!)
	IndexedDay = N1 + AllWLeaps MOD N7
	CountedDay& = AllWLeaps - Prioryears + 365 + PriorYearsDays&
	'-------------------------------------------------------------------------
	IF Year = N0 AND Month = N1 AND Day = N1 THEN
		IndexedDay = N7
		JulianDate& = N1
		CountedDay& = N0
	END IF
	'-------------------------------------------------------------------------
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	FUNCTION DirectoryExist(DirectoryName$)  STATIC
	'=========================================================================
	'  To See if a Directory Exists -- Using MhDir & MhDirExist
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 142
	IF LEN(DirectoryName$) = N3 AND MID$(DirectoryName$,N2) = ":\" THEN
	   	Drive = ASC(DirectoryName$) - N64			'If root, then
	   	Temp$ = SPACE$(66)						'can't use 
	   	CALL MhDir(N1%, Drive%, Temp$, NoSuchDir%) 	'MhDirExist
	   	Temp$ = Blank0$
	  ELSE
		CALL MhDirExist((ASCIIZ$(DirectoryName$)), NoSuchDir%)
	END IF
	IF NoSuchDir THEN
		DirectoryExist = No
	  ELSE
		DirectoryExist = Yes
	END IF
		Subnum = SubnumSave
	END FUNCTION
	'=========================================================================
	SUB DirectReturnCheck STATIC
	'=========================================================================
	'  To See If Event Table Is Stable When Returning To Main Menu
	'    So Prompt for Returning To Clock Screen Can Be Pressent
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 19
	IF EventTableStable THEN
		DirectReturn = Yes
		Menu1 = MainMenuLastEntry
		IF NOT ApptFile THEN CALL OpenAppts
	  ELSE
		DirectReturn = No
	END IF
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB DisplayApptFilename STATIC
	'=========================================================================
	'  Show the name of the Appointment File on the Menus
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 20
	IF ApptFilename$ <> Blank8$ THEN
		CALL ShowIt(N13, N1, N64, " File ")
		CALL ShowIt(N6, N0, Nm1, (SPACE$(N10)))
		CALL ShowIt(N14, N0, N0, Blank1$)
		CALL GetFilenameLength
		CALL ShowIt(N0, N0, Nm1, _
			(MID$(ApptFilename$, N1, FilenameLength)))
		CALL ShowIt(N0, N0, Nm1, Blank1$)
	END IF
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB DOSBIOSServices  STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 138
	'  All DOS ROM BIOS Services come here
	'  All variables are in COMMON SHARED
	CALL MhDos2(DosEcode%, InterruptNumber%, _
		ES%, SI%, DI%, AH%, AL%, BH%, BL%, CH%, CL%, DH%, DL%)
	IF DosEcode% THEN
		ERROR 255
	END IF
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB DoShell (ShellCommand$) STATIC
	'=========================================================================
	'  All DOS Shells are Done From Here / Pass the Parameter /
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 21
	CALL Kolors(N99)
	'  Ditch Trailing Blanks in Command
	ShellCommand$ = RTRIM$(ShellCommand$)
	IF MemoryResident THEN
		SrShellCommand$ = ShellCommand$
		ToShellCommand$ = ShellCommand$ + CHR$(N13%)
		CALL SrResidentShell(ToShellCommand$, ShellEcode%)
		IF ShellEcode THEN
			CALL SrCancelShell                 'Cancel Shell if Error
			Ecode = ShellEcode
			ERROR 254
		  ELSE
			MemoryResidentShell = Yes
		END IF
		CALL StayResPopDown
		CALL SrCancelShell
		MemoryResidentShell = No
	  ELSE
		CALL SetVideoMode(N1)
		CALL SetVideoPage(N1)
		CALL RestoreDOSKeyState            'Set DOS Ins,Caps,Num,Scroll
		LOCATE N3, N1, N1, InsertCursorStart, CursorStop' Set Cursor At Top
		CALL SetCurrentDirectory(N0)        ' Set User Directory
		IF ShellCommand$ <> Blank0$ THEN             ' Since Shell Won't
			SHELL (ShellCommand$)                   ' Turn it Off
		  ELSE
			SHELL
		END IF
		CALL SaveCurrentDirectory(N0)       ' Save User Directory
		CALL SetCurrentDirectory(N1)        ' Set Calendar Directory
		CALL SaveDOSKeyState               'Save DOS Ins,Caps,Num,Scroll
		CALL SetVideoMode(N0)
		CALL SetVideoPage(N0)
		CALL RestoreCalKeyState            'Restore CAL Ins,Caps,Num,Scroll
	END IF
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB DOSShell (DOSEntry) STATIC
	'=========================================================================
	'  Run a Temporary DOS Session
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 22
	CommandError$ = False$
	SELECT CASE DOSEntry
		CASE 0                        '  From Menu
BuildMenu:
			MenuLines(N1) = "Execute DOS Session and Return"
			MenuLines(N2) = "Execute Stored DOS Command and Return"
			MenuLines(N3) = "Change Stored DOS Command"
			ClockScreen = No
			OnEditPage = No
			CALL ClearScreenNormal(N1)
			ScreenTitles$(N1) = "Select Type of DOS Session to Execute"
			CALL Titles(N1)
			CALL ShowIt(N6, N12, N1, "Stored DOS Command Is --")
			IF DOSCommand$ = Blank80$ THEN
				CALL ShowIt(N7, N13, N1, "(No Command Stored)")
			  ELSE
				CALL ShowIt(N7, N13, N1, DOSCommand$)
			END IF
			IF CommandError$ = True$ THEN
				CALL PrepareforMessage
				CALL ShowIt(N0, N0, N0, _
					"DOS Command Is Blank -- Change If Desired")
				CommandError$ = False$
				DOSType = N3
			END IF
			CALL MenuDriver(N3, DOSType, N6, Nm1, No, N0, N1, N1)
			CALL BlankError
			IF MenuExit = MenuCancelled THEN
				CALL ClearScreenNormal(N1)
				CALL DirectReturnCheck
				GOTO ExitPoint3
			END IF
PopCheckTime:
			IF DOSType <> N3 THEN
				TimerDisplaySuppress = Yes
				IF MemoryResident AND PoppedUpOverProgram THEN
					ErrorLine1$ = _
	"Can't Execute DOS Session/Command If Loaded Before Another Program"
					ERROR 253
				END IF
				CALL Kolors(N99)
				CLS
			END IF
			SELECT CASE DOSType
				CASE 1                        ' DOS Shell
					IF NOT MemoryResident THEN
						ScreenRow = N1
						GOSUB ReturnPrep       ' Return Instructions
						GOSUB Return2          ' Type Exit Instructions
					END IF
					CALL DoShell(Blank0$)    ' Go Do The DOS Session
				CASE 2                        ' DOS Command
					IF DOSCommand$ = Blank80$ THEN
						CommandError$ = True$
						GOTO BuildMenu
					END IF
					CALL DoShell(DOSCommand$)
					IF NOT MemoryResident THEN
						ScreenRow = N1
						GOSUB ReturnPrep           ' Return Instructions
						GOSUB ReturnPause          ' Pause Instructions
					END IF
				CASE 3                        ' Change DOS Command
					CALL ControlledInput(N13, N1, N12, N1, N80, _
	"Enter DOS Command to Store Below --", DOSCommand$, N0, N1, N1, N1)
					CALL WriteCalDOS
					GOTO BuildMenu
			END SELECT
		CASE 1                        '  F6 For DOS Shell
			DOSType = N1
			GOTO PopCheckTime
		CASE 2                        '  F7 For DOS Command
			DOSType = N2
			GOTO PopCheckTime
	END SELECT
	CALL DirectReturnCheck
	CALL ClearScreenNormal(N1)
	GOTO ExitPoint3
ReturnPrep:
	' Show Band for Instructions	
	CALL ShowErase(N13, N1, N1, N80, Blank0$)
	RETURN
ReturnPause:
	' Issue Returning Instructions
	CALL ShowIt(N7, N1, Nm2, _
		" Press a Key to Return to Personal Calendar ... ")
	CALL KeyStuff(KeyWait)
	RETURN
Return2:
	' Issue Pause Instructions and Wait
	CALL ShowIt(N7, N1, Nm2, _
	   " To Return to Personal Calendar, Type EXIT Then Press Return ")
	RETURN
ExitPoint3:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB EndItAll STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 105
	'  (From Ctl-Esc or Ctl-Break or Esc from main menu)
	CALL SetCurrentDirectory(N1)             ' Return to calendar's directory
	IF MemoryResident THEN
		IF PoppedUpOverProgram THEN
			ErrorLine1$ = _
	  "Can't Quit Unless Last In Memory and Over DOS; Pop Down (F10) Instead"
			ERROR 253			          ' Return to Main Menu
		END IF
	END IF
	CALL CloseFiles
	CALL ClearOverdueTable
	CALL ClearScreenNormal(N0)
	CALL BoxDraw(N2%, N1%, N24%, N1%, N80%)
	CALL BigChars(N3%, N6%, "Thank you for using")
	CALL Kolors(N7)
	CALL BigChars(N8%, N6%, "Personal Calendar--")
	CALL Kolors(N6%)
	CALL Credits(N18)
	DO                                 ' Clear keystroke buffer
	LOOP WHILE LEN(INKEY$)
	IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
	IF MemoryResident THEN
		' Do a TSR Unload 
		'  (remove program from memory).
		CALL BigChars(N13%, N6%, "Removed from memory")
		IF SrDiskSwapped THEN
			CALL ShowIt(N6, N17, Nm2, "(And Deleted Disk Swap Files)")
		END IF
		CALL Kolors(N99)
		CALL Snooze(1.7!)		           ' Pause before screen restore
		CALL SetVideoMode(N1)			' and mode
		CALL SetVideoPage(N1)			' Set User Page
		GOSUB RestoreKeys                   ' Restore Keys and Cursor
			Subnum = SubnumSave
		'====================================================================
		CALL SrReleaseMem(RelEcode%)  ' Resident Program Exit
		'====================================================================
		'  ONLY COMES HERE IF MEMORY RELEASE IS NOT SUCCESSFUL
		'--------------------------------------------------------------------
		Ecode = RelEcode
		IF Ecode = N7 THEN
			FatalError = No
			IF ApptFile THEN
				DirectReturn = Yes
				Menu1 = MainMenuLastEntry
				CALL OpenAppts ' Reopen Appts
			END IF
		  ELSEIF Ecode THEN
			FatalError = Yes
		END IF
		ERROR 254                          ' Return to main menu
	  ELSE
		' Non Memory-Resident Exit comes here.
		IF UserMode <> CalMode OR _			' If not going back to
		   DOSCursorPage <> ScreenPage THEN
			HardSnooze = Yes				' same page or mode, pause
			CALL Snooze(1.7!)				' so user can read farewell
		  ELSE
			CALL Kolors(N99)
		END IF
		CALL SetVideoMode(N1)			' and mode
		CALL SetVideoPage(N1)			' Set User Page
		GOSUB RestoreKeys                    ' Restore Keys and Cursor
		'====================================================================
		SYSTEM                        ' Non-Resident Program Exit
		'====================================================================
	END IF
	'  Program Never Terminates Here
RestoreKeys:
	CALL RestoreDOSKeyState
	LOCATE 24, N1, N1, InsertCursorStart, CursorStop' Normal DOS Cursor
	RETURN
RestoreState:
	RETURN
	END SUB
	'=========================================================================
	SUB ErrorHandler  STATIC
	'=========================================================================
	DEFINT A-Z
	Suberror = Subnum			' Save SUB that was in error
		Subnum = 23
	DO							' Hard clear of keystroke buffer
	LOOP WHILE LEN(INKEY$)
	ErrorNumber = ERR				' Save error number
	ToShow = ErrorNumber
	MhEcode = Ecode
	LastErrorMessage = 269			' Set last stored error message limit
	IF ErrorNumber = 253 THEN		' Remove attempts
		FatalError = No			' Or pop attempts when
		ClockScreen = No			' locked into memory
		InHelp = No
		OnEditPage = No
		CALL ClearScreenNormal(N1)	' Write Error Message
		CALL DirectReturnCheck			' and return to main menu
		CALL PrepareforMessage
		CALL ShowIt(N0, N0, N0, ErrorLine1$)
		ErrorMessageToWrite = No
		GOTO ExitPoint4
	END IF
	IF ErrorNumber = N0 THEN GOTO ExitPoint4	' If no error, get out
	'           Error Handling
	ScreenRow = ErrMsgPlacement
	IF ErrorNumber = 254 OR ErrorNumber = 255 THEN
		ToShow = MhEcode			' Stay-Res or Mach 2
		FatalError = No
	END IF
	IF FatalError THEN				' Event safety
		CALL CloseFiles
		EventTableStable = No
	END IF
	IF FileExist("calerror.dat") THEN				' Get SUB Name
		OPEN "R", FilenumError, "calerror.dat", N80	
		FIELD FilenumError, N80 AS HelpErrorBuffer$	
		' Starting at rec 270 in CALERROR.DAT are module numbers &
		'  procedure names for trace (270 is main program)
		GET #FilenumError, LastErrorMessage + 1 + Suberror			
		JJ = LastErrorMessage           ' Get Number of Last Record
	  ELSE
		JJ = N0
	END IF
	IF JJ THEN					' Construct Message
		ErrorLine1Base$ = " Error" + STR$(ToShow) + _
			" Detected In Procedure '" + RTRIM$(MID$(HelpErrorBuffer$, _
			N2, LEN(HelpErrorBuffer$) - N1)) + "' of module CAL" + _
			LEFT$(HelpErrorBuffer$, N1) + ":"
	  ELSE
		ErrorLine1Base$ = " Error" + STR$(ToShow) + _
			" Detected, But Error Message File CALERROR.DAT Does Not Exist"
	END IF
	IF ErrorNumber > 253 THEN
		' MicroHelp Errors
		SELECT CASE ErrorNumber
			CASE 255                 'Mach 2 Errors
				SELECT CASE MhEcode      ' Computer Error Message Loc
					CASE 1 TO 254       ' In File
						ErrorNumber = MhEcode + 250' Crits Start at 251
					CASE 255
						ErrorNumber = 250        ' Except 255 which at 250
					CASE IS > 256
						ErrorNumber = MhEcode - 156' Non Crits start 101
					CASE ELSE
						ErrorNumber = 500        ' Beyond End Of File
				END SELECT
			CASE 254                 'Stay-Res Plus Errors
				IF StartupScreenHold THEN EarlyPopDownFailed = Yes
				ErrorNumber = MhEcode + 200        ' Stay-Res is 200 to 215
		END SELECT
		ErrorLine1$ = "MicroHelp" + ErrorLine1Base$
	  ELSE
		' Microsoft Errors
		ErrorLine1$ = "BASIC" + ErrorLine1Base$
	END IF
	IF ErrorNumber <= JJ OR JJ = N0 THEN
		GET FilenumError, ErrorNumber
		IF HelpErrorBuffer$ = SPACE$(N80) OR JJ = N0 THEN
			ErrorLine2$ = "(No Error Text Available)"
		  ELSE
			ErrorLine2$ = HelpErrorBuffer$
		END IF
	END IF
	ErrorMessageToWrite = Yes
	IF FatalError THEN
		CALL CloseFiles
	  ELSE
		CLOSE FilenumError
	END IF
	IF PrimitiveState THEN			' here, we're preparing for a 
		PRINT
		PRINT ErrorLine1$			' about 50-60 bytes to the stack
		PRINT ErrorLine2$
		PRINT
		PRINT "Program initialization is incomplete.  Cannot proceed."
		SYSTEM
	END IF
	ErrorNumber = N0
ExitPoint4:
	CALL SetCurrentDirectory(N1)        ' Set Program Directory
	' Check video lines and reset
	CALL SetVideoMode(N0)			' set calendar mode
	CALL SetVideoPage(N0)			'  and page
	AllowInsertMode = No			' Turn off insert mode
	AutoStarted = No				' Turn off autostart
	SrAutoPopDown = No
	SrAutoPopDownReady = No
	SrAutoPopDownHappened = No
	ClockScreen = No				' Set in menu, not anything else
	OnEditPage = No
	InHelp = No
	OnOverduePage = No
	EditingEvents = No				' Turn off event edit
	EditingNotes = No
	InPopDown = No					' Turn off popping down
	LoopCounterShow = Yes			' Set debug counter on
	MenuChoice = N1				' Set main menu to top
	MenuSingleLine = No				' Reset menu driver
	WhichColor = N0
	CursorState = N0
	IF FatalError THEN DirectReturn = No
	LOCATE CursorRow, CursorColumn, CursorState	' Turn off cursor
		Subnum = Suberror
	END SUB
	'=========================================================================
	SUB EscapeLine STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 24
	CALL EscapeLineDelete
	CALL ShowIt(N7, N25, N43, " Esc ")
	CALL ShowIt(N6, N0, Nm1, "Return")
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB EscapeLineDelete STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 25
	CALL ShowErase(N6, N25, N43, N19, Blank0$)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB EventErrorMessage STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 26
	IF ReturnMessage$ <> Blank0$ THEN                 ' Limit Message Length
		WindowLength = LEN(EditInstructions(N1, N1))
		IF LEN(ReturnMessage$) > WindowLength THEN
			ReturnMessage$ = LEFT$(ReturnMessage$, WindowLength)
		END IF
		StartColumn = (WindowLength - LEN(ReturnMessage$)) \ N2
		' Compute and Locate Position
		CALL ShowIt(N16, N22, StartColumn, ReturnMessage$)
		ReturnMessage$ = Blank0$           ' Blank Message After Display
	END IF                                  '  to Prevent Repeated Display
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	FUNCTION FileExist(ExistFilename$) STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 120
	CALL MhFileExist((ASCIIZ$(ExistFilename$)), ExistEcode%)
	IF ExistEcode THEN
		FileExist = No
	  ELSE
		FileExist = Yes
	END IF
		Subnum = SubnumSave
	END FUNCTION
	'=========================================================================
	SUB FileFormat STATIC
	'=========================================================================
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 27
	'
	'   EXIT FROM PROGRAM IS STOPPED FROM FILE CHANGE TO OPTIONS RESET!
	'
	'   Change File Based On Size -- Called From Options Menu Now
	'    NumberofEvents and Notes Is Already Updated to New Value
	'    OldNumberEvents and Notes Has Previous Values
	ExitKeys = No
	SELECT CASE WhichExpansion$
		CASE "e"
			OldNumber = OldNumberEvents        '  Expand Events
			NewNumber = NumberofEvents
			PrintLabel$ = "Events"
		CASE False$
			OldNumber = OldNumberNotes    '  Expand Notes         
			NewNumber = NumberofNotes
			PrintLabel$ = "Notes"
		CASE ELSE
			ExitKeys = Yes
			GOTO ExitPoint5
	END SELECT
	'  Display Warning Notice
	CALL MinorBeeper
	CALL Kolors(N6)
	CALL ClearLast4                    ' Changing ... on line 23
								' Compressing ... on line 24
								' Moving ... on line 25
	CALL ShowMult(N14, N23, N1, N80, N3)
	Lin$ = "Please Wait--Changing Appointment File Size From" + _
		STR$(OldNumber) + " To" + STR$(NewNumber)
	IF WhichExpansion$ = "e" THEN
		Lin$ = Lin$ + " Events"
	  ELSE
		Lin$ = Lin$ + " Notes"
	END IF
	CALL ShowIt(N0, N23, N8, Lin$)
	Excess = ABS(NewNumber - OldNumber)
	IF (NewNumber - OldNumber) < N0 THEN
		'  Shrink File
		CompressFile = N1    '  Compress Excess
		' Move Excess to History unless Events and Arrays Null From Prior Move
		IF WhichExpansion$ = False$ OR EventTableStable THEN
			IF WhichExpansion$ = "e" THEN
				'  Shrink Events
				'    Copy Excess Events to History
				EventtoHistory = Yes
			  ELSE
				EventtoHistory = No
			END IF
			Lin$ = "Moving Last" + STR$(Excess) + Blank1$ + PrintLabel$ + _
				" to History"
			FOR I = Excess TO N1 STEP Nm1
				CALL KeyStuff(KeyStatus)
				IF WhichExpansion$ = "e" THEN
					WhichEvent = OldNumberEvents - I + N1
					CALL ApptToMenu(N1)
					HistoryBuffer$ = CurrentEventLine$
				  ELSE
					Pointer = StartingNote + OldNumberNotes - I
					CALL GetApptRecord(Pointer)
					HistoryBuffer$ = ApptBuffer$
				END IF
				CALL WritetoHistory
				Lin1$ = Lin$ + STR$(I - N1) + SPACE$(4)
				CALL ShowIt(N14, N24, N8, Lin1$)
			NEXT
		END IF
		'    Move Notes and History Back In File
		Lin$ = "       Moving "
		IF WhichExpansion$ = "e" THEN Lin$ = Lin$ + "Notes/"
		Lin$ = Lin$ + "History Backward In File"
		CALL ShowErase(N0, N24, N1, N80, Lin$)
		EOFRecord = LOF(FilenumAppt) \ N80
		IF WhichExpansion$ = "e" THEN
			MoveStart = StartingNote
		  ELSE
			MoveStart = StartingHistory
		END IF
		CALL MoveApptRecords(N1, MoveStart, EOFRecord, N1, _
			N0, -Excess, N1, N0, N0)
	  ELSE
		'  Expand File
		CompressFile = N0    '  Don't Compress
		EOFRecord = LOF(FilenumAppt) \ N80
		CALL ShowErase(N0, N24, N1, N80, Blank0$)
		IF WhichExpansion$ = "e" OR StartingHistory < EOFRecord THEN
			Lin$ = "Moving "
			IF WhichExpansion$ = "e" THEN
				Lin$ = Lin$ + "Notes/"
				MoveEnd = StartingNote
			  ELSE
				MoveEnd = StartingHistory
			END IF
			Lin$ = Lin$ + "History Forward" + STR$(Excess) + " In File"
			CALL ShowIt(N0, N24, N8, Lin$)
			' Move the Records
			CALL MoveApptRecords(N1, EOFRecord, MoveEnd, Nm1, N0, _
				Excess, N1, N0, N0)
			' Blank the New Area
			'  This is done separately, because there could be far fewer
			'   records to move then to clear in the new area
			CALL ShowErase(N0, N24, N1, N80, _
				"       Clearing Area For New Records")
			CALL MoveApptRecords(N1, MoveEnd, MoveEnd + _
				Excess - N1, N1, N0, N0, N0, N1, N0)
			CALL ShowErase(N0, N24, N1, N80, Blank0$)
		END IF
	END IF
	IF CompressFile = N1 THEN CALL CompressApptFile(Excess)
	IF WhichExpansion$ = "e" THEN
		EventSizeCode$ = MID$(ValidSizes$, (NewNumber \ 20), N1)
	  ELSE
		NoteSizeCode$ = MID$(ValidSizes$, (NewNumber \ 20), N1)
	END IF
	CALL SetArrays
	CALL SetOptions
	ExitKeys = Yes
	'           Set Options To Expanded
ExitPoint5:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB FileList STATIC
	'=========================================================================
	'  Display a List of Saved Appointment Files
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 106
	CALL ClearScreenNormal(N1)
	ScreenTitles$(N1) = "Saved Appointment Files"
	CALL Titles(Nm1)
	CALL Kolors(N6)
	CursorRow = N6
	CursorColumn = N1
	CALL KeyStuff(KeyCursorOff)             ' Position Cursor for FILES
	ErrorSwitch = No
	CALL FileListGet				' for error handling in CAL1
	IF ErrorSwitch THEN
		ErrorSwitch = No
		CALL ShowIt(N7, N15, Nm2, " There Are No Saved Appointment Files ")
		Menu1 = MainMenuCreate
	END IF
	'  Clear DOS prompt and give one of our own
	CALL ClearLast3
	CALL ScreenBottoms
	CALL ReturnLineDelete
	CALL KeyStuff(KeyWait)             ' Wait for a keystroke
	CALL ClearScreenNormal(N1)
	CALL DirectReturnCheck
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB GenerateGreeting (GrLines) STATIC
	'=========================================================================
	'    Generate Main Menu Greeting Lines
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 28
	ScreenTitles$(N1) = "Personal Calendar (PC) for DOS"
	ScreenTitles$(N2) = "Version " + ProgramVersion$
	ScreenTitles$(N3) = "Main Menu"     ' Shown Optionally
	CALL Titles(GrLines)
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB GenGreetingScreen1  STATIC
	'=========================================================================
	'    Generate Startup Screen
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 119
	CALL Kolors(N6)
	CALL BoxDraw(N2, N1, N25, N1, N80)
	IF RIGHT$(ProgramVersion$, N1) = "á" THEN		'Beta Warning
		CALL MinorBeeper
		CALL ShowIt(N9, N2, Nm2, _
	   " Beta Release -- You may not distribute without my permission !! ")
	END IF
	CALL Kolors(N7)
	CALL BigChars(N3%, N10%, "Personal Calendar")
	CALL Kolors(N6)
	CALL BigChars(N8%, N22%, "PC for DOS")
	IF ColorCRT THEN CALL Kolors(N3) ELSE CALL Kolors(N7)
	CALL BigChars(N13%, N18%, "Version " + ProgramVersion$)
	CALL Credits(N18)
	CALL ShowIt(N7, N24, Nm2, "Press a Key to Continue ...")
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB GetFilenameLength STATIC
	'=========================================================================
	'  Get the Length of the Appointment File Name
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 29
	FilenameLength = InString(ApptFilename$, Blank1$) - N1
	IF FilenameLength <= N0 THEN FilenameLength = 8
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB GetOptions STATIC
	'=========================================================================
	'   Get Option Variables From Option Record
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 30
	CALL GetApptRecord(N1)
	ApptMasterRec$ = ApptBuffer$
	'  Pos 1-8 Password
	ApptPassword$ = MID$(ApptMasterRec$, N1, 8)
	'  Pos 9 Footer Size
	FooterSize = VAL(MID$(ApptMasterRec$, 9, N1))
	IF FooterSize < N3 OR FooterSize > 9 THEN FooterSize = 5
	'  Pos 10 Alarm Initial Condition
	InitialSound$ = MID$(ApptMasterRec$, 10, N1)
	IF VAL(InitialSound$) THEN
		SoundLevel = VAL(InitialSound$)
	  ELSE
		'  Old Sound Levels
		IF InitialSound$ = True$ THEN SoundLevel = 4
		IF InitialSound$ = False$ THEN SoundLevel = N1
	END IF
	'  Pos 11 Size Of Note Area
	NoteSize = VAL(MID$(ApptMasterRec$, 11, N1))
	IF NoteSize < N0 OR NoteSize > (FooterSize - N1) THEN NoteSize = N2
	'  Pos 13 Print,Copy History
	IncludeHistory$ = MID$(ApptMasterRec$, 13, N1)
	IF IncludeHistory$ = True$ THEN InclHistory = Yes ELSE InclHistory = No
	'  Pos 14 Print,Copy Notes
	IncludeNotes$ = MID$(ApptMasterRec$, 14, N1)
	IF IncludeNotes$ = True$ THEN InclNotes = Yes ELSE InclNotes = No
	'  Pos 15 Allow Weekends On Daily
	WeekendScheduling$ = MID$(ApptMasterRec$, 15, N1)
	'  Pos 16 Number of Events
	EventSizeCode$ = MID$(ApptMasterRec$, 16, N1)
	IF EventSizeCode$ = Blank1$ THEN EventSizeCode$ = LEFT$(ValidSizes$, N1)
	'  Pos 17-18  Event Look-Ahead (Defaults to 5 if blank)
	Pending = VAL(MID$(ApptMasterRec$, 17, N2))
	IF MID$(ApptMasterRec$, 17, N2) = SPACE$(N2) THEN Pending = 5
	'  Pos 19  Selected IBM "I" or Epson "E" Printer or "P" HPIIP or "N"one
	SelectedPrinter$ = MID$(ApptMasterRec$, 19, N1)
	IF SelectedPrinter$ = Blank1$ THEN SelectedPrinter$ = "-"
	'  Pos 20  Week Break on ASCII File or Print
	WeekBreak$ = MID$(ApptMasterRec$, 20, N1)
	IF WeekBreak$ = Blank1$ THEN WeekBreak$ = True$
	'  Pos 21  60 Notes "e"
	NoteSizeCode$ = MID$(ApptMasterRec$, 21, N1)
	IF NoteSizeCode$ = Blank1$ THEN
		NoteSizeCode$ = MID$(ValidSizes$, (NumberofNotes \ 20), N1)
	END IF
	'  Pos 22-23  Printer page line limit
	PrinterLineLimit = VAL(MID$(ApptMasterRec$, 22, N2))
	'  Pos 24  Printer pause indicator
	PrinterPause$ = MID$(ApptMasterRec$, 24, N1)
	IF PrinterPause$ = Blank1$ THEN PrinterPause$ = False$
	'-------------------------------------------------------------------------
	'  Set Printer Array
	FOR I = N1 TO 50
		CALL KeyStuff(KeyStatus)
		SELECT CASE SelectedPrinter$
			CASE "I"
				PrinterCodes(I) = IBMCodes(I)
			CASE "E"
				PrinterCodes(I) = EpsonCodes(I)
			CASE "P"
				PrinterCodes(I) = HPIIPCodes(I)
			CASE "4"
				PrinterCodes(I) = I4019Codes(I)
			CASE ELSE
				EXIT FOR
		END SELECT
	NEXT
	'-------------------------------------------------------------------------
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB Help STATIC
	'=========================================================================
	'   HELP!!!
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 108
	ErrorSwitch = No
	ScreenSize = 20
	InHelp = Yes
	IF NOT FileExist("calhelp.dat") THEN
		InHelp = No
		CALL PrepareforError
		CALL ShowIt(N0, N0, N0, _
	"The Help Information File CALHELP.DAT Was Not Found Or Is Defective")
		GOTO HelpExit
	END IF
	OPEN "R", FilenumHelp, "calhelp.dat", N80
	FIELD FilenumHelp, N80 AS HelpErrorBuffer$
	LastRecord = LOF(FilenumHelp) \ N80           'Last Record Number
	LastPage = N1 + ((LastRecord - N1) \ ScreenSize)'Last Page
	CurrentRecord = N1
	CurrentPage = N1
	'  Start New Page
NewHelpPage:
	CALL ClearScreenNormal(N0)
	CALL ScreenBottoms
	CALL ReturnLineDelete
	CALL KeyStuff(KeyStatusAbs)
	CurrentRecord = N1 + (CurrentPage - N1) * ScreenSize
	CALL ShowIt(N6, N21, N1, (Strng$(N80, 196))) ' horizontal solid line
	CALL ShowIt(N7, N23, N1, "*,Print")
	CALL ShowIt(N6, N0, Nm1, " Print Help Text")
	IF CurrentRecord > ScreenSize THEN
		CALL ShowIt(N7, N24, N1, "PgUp")
		CALL ShowIt(N6, N0, Nm1, " Previous Page")
		CALL ShowIt(N7, N0, N27, "Home")
		CALL ShowIt(N6, N0, Nm1, " 1st Page")
	END IF
	IF CurrentPage < LastPage THEN
		CALL ShowIt(N7, N25, N1, "PgDn")
		CALL ShowIt(N6, N0, Nm1, " Next Page")
		CALL ShowIt(N7, N0, N27, "End")
		CALL ShowIt(N6, N0, Nm1, " Last Page")
	END IF
	CALL ShowIt(N6, N22, N63, "Page")
	CALL ShowIt(N0, N0, Nm1, _
		(STR$(CurrentPage) + " of" + STR$(LastPage)))
	CALL ShowIt(N7, Nm2, N63, "Ins")
	CALL ShowIt(N6, N0, Nm1, " Specific Page")
	'  Get Next Record
GetHelpRecord:
	GET FilenumHelp, CurrentRecord
	'  Set Screen Position
	ScreenPosition = (CurrentRecord - N1) MOD ScreenSize
	CALL ShowIt(N0, (ScreenPosition + N1), N1, HelpErrorBuffer$)
	'  End File  or  End Page
	IF CurrentRecord < LastRecord AND _
	  (CurrentRecord MOD ScreenSize) <> N0 	THEN
		CurrentRecord = CurrentRecord + N1
		GOTO GetHelpRecord
	END IF
NextHelpKey:
	CALL KeyStuff(KeyWait)             ' Wait for a keystroke
	SELECT CASE LEN(Keystroke$)
		CASE 1                        '  Length 1 Keys (Esc,Prnt)
			SELECT CASE InString(CHR$(Esc) + CHR$(Prnt), _
							 RIGHT$(Keystroke$, N1))
				CASE 1                   ' Esc Key
					CLOSE FilenumHelp
					InHelp = No
					CALL ClearScreenNormal(N1)
					CALL ScreenBottoms
					CALL DirectReturnCheck
					GOTO HelpExit
				CASE 2                   ' Prnt Key
					'  Print Help Text
					LprintTerminate = No
					CALL InitPrinter    'Initialize Printer
					FOR JJ = N1 TO LastRecord
						IF LprintTerminate THEN EXIT FOR
						'  On Page Break
						IF ((JJ - N1) MOD ScreenSize) = N0 THEN
							PageNumber = N1 + ((JJ - N1) \ ScreenSize)
							CALL ClearScreenNormal(N0)
							CALL ScreenBottoms
							CALL ShowIt(N7, N24, N1, _
							    "Printing Help File Text -- Please Wait")
							CALL ShowIt(N0, Nm1, N1, ("Page" + _
								STR$(PageNumber) + " of" + _
								STR$(LastPage)))
							IF PageNumber MOD N2 = N1 THEN 
								IF JJ <> N1 THEN
									CALL PageEject
								END IF
							  ELSE
								CALL LprintString(Blank1$, N0)
							END IF
							CALL LprintString(Blank1$, N0)
							'  hyphens
							CALL LprintString(Strng$(N80, N45), N0)
							PrintString$ = "Personal Calendar (PC) " + _
							  "for DOS, version " + ProgramVersion$ + _
							  ", Help File Text, Page" + _
								STR$(PageNumber)
							CALL LprintString(PrintString$, N0)
							CALL LprintString(Strng$(N80, N45), N0)
							CALL LprintString(Blank1$, N0)
						END IF
						GET FilenumHelp, JJ
						Buffer80$ = HelpErrorBuffer$
						CALL KeyStuff(KeySingle)
						IF Keystroke$ = CHR$(Esc) THEN EXIT FOR
							CALL LprintString(Buffer80$, N0)
							ScreenPosition = (JJ - N1) MOD ScreenSize
							CALL ShowIt(N6, (ScreenPosition + N1), N1, _
								Buffer80$)
					NEXT
					IF NOT LprintTerminate THEN
						CALL PageEject
						LprintJobOver = Yes
						CALL LprintString(Blank0$, N0)
					  ELSE
						LprintTerminate = No
					END IF
					GOTO NewHelpPage
				CASE ELSE                ' Other Length 1 Key
					GOTO BadHelpKey
			END SELECT
		CASE 2                        '  Length 2 Keys
		'  Length 2 keys -- Next,Prev,First,Last,SpecificPage
		SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(HomeKey) + _
					   CHR$(EndKey) + CHR$(Ins), RIGHT$(Keystroke$, N1))
			CASE 1, 3                '  PgUp or Home
				IF CurrentPage <= N1 THEN GOTO BadHelpKey
				'  Pg Up or Home
				IF RIGHT$(Keystroke$, N1) = CHR$(PgUp) THEN
					CurrentPage = CurrentPage - N1      'PgUp
				  ELSE
					CurrentPage = N1                    'Home
				END IF
				GOTO NewHelpPage
			CASE 2, 4                '  PgDn or End
				IF CurrentPage >= LastPage THEN GOTO BadHelpKey
				IF RIGHT$(Keystroke$, N1) = CHR$(PgDn) THEN
					CurrentPage = CurrentPage + N1      'PgDn
				  ELSE
					CurrentPage = LastPage             'End
				END IF
				GOTO NewHelpPage
			CASE 5                   '  Ins (Specific Page)
				CALL ShowErase(N6, N22, N1, N26, Blank0$)'clear instructions
				CALL ShowMult(N6, N23, N1, N42, N3)     '  & for Ins Prompt
				InputResponse$ = MID$(STR$(CurrentPage), N2, N2)
				CALL ControlledInput(N22, N2, N22, N6, N3, _
					"Enter Page Number", InputResponse$, _
					N1, N0, N1, N1)
				CurrentPage = VAL(InputResponse$)
				IF CurrentPage < N1 THEN CurrentPage = N1
				IF CurrentPage > LastPage THEN CurrentPage = LastPage
				GOTO NewHelpPage
			CASE ELSE
BadHelpKey:
				CALL MinorBeeper
				GOTO NextHelpKey
		END SELECT
	END SELECT
HelpExit:
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB IncrementDate (DateToIncrement$) STATIC
	'=========================================================================
	'   Given A Date, Find The Next One
	'           Increment Date
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 31
	IncrementYear = VAL(MID$(DateToIncrement$, N1, 4))
	IncrementMonth = VAL(MID$(DateToIncrement$, 5, N2))
	IncrementDay = VAL(MID$(DateToIncrement$, N7, N2))
	IF IncrementMonth <> N2 OR IncrementDay <> 28 THEN ' Not Leap Year
		IF IncrementDay < MonthLength(IncrementMonth) THEN
			IncrementDay = IncrementDay + N1
			GOTO DoLeap
		END IF
		IncrementDay = N1
		' Last Day
		IF IncrementMonth = 12 THEN        '  Last Month
			IncrementMonth = N1
			IncrementYear = IncrementYear + N1
			GOTO DoLeap
		END IF
		IncrementMonth = IncrementMonth + N1
		GOTO DoLeap
	END IF
	' Leap Year Test
	IF Leap(IncrementYear) THEN
		IncrementMonth = N2
		IncrementDay = 29
	  ELSE
		IncrementMonth = N3
		IncrementDay = N1
	END IF
	'           Leap Year
DoLeap:
	CALL YearAdjust(IncrementYear, AdjustedYear$)
	DateToIncrement$ = ZeroFill$(AdjustedYear$ + RIGHT$(STR$(IncrementMonth), _
		N2) + RIGHT$(STR$(IncrementDay), N2))
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	SUB InitPrinter  STATIC
	'=========================================================================
	'   Printer Initialization
	DEFINT A-Z
		SubnumSave = Subnum
		Subnum = 33
	WIDTH LPRINT 84
	IF SelectedPrinter$ <> Hyphen$ THEN
		'  Init Printer
		FOR I = N1 TO 50
			CALL KeyStuff(KeyStatus)
			IF PrinterCodes(I) = -99 THEN
				EXIT FOR
			  ELSE
				CALL LprintString((CHR$(PrinterCodes(I))), N1)
				IF LprintTerminate THEN
					EXIT FOR
				END IF
			END IF
		NEXT
	END IF
	PrinterLineCount = 1
		Subnum = SubnumSave
	END SUB
	'=========================================================================
	'========================  END OF CAL3.BAS  =============================
	'========================================================================