!============================================================================! 
 ! GSBNOT  - Created the week of October 16, 1989 by Gregory Scott Berthume.  !
 ! [1]  GSB  Appointment/Calendar File Maintenance program, can also be used  !
 !           as an alphabetical phone # directory.  All program functions are !
 !           done within this one program.  An almost infinite number of files!
 !           can be supported.  4 character file name (AlphaNumeric).         !
 !============================================================================!
 ! EDIT HISTORY:
 !
 ! Ver  When      Who  What
 ! ---- --------  ---  -------------------------------------------------------
 ! [1]  01/05/90  GSB  Added cursor movement around fields.
 ! [2]  01/26/90  GSB  Added INMEMO routines (additional comment box).
 ! [3]  02/21/90  GSB  Added Monthly Calendar display option to menu. 
 ! [4]  03/07/90  GSB  Added recurring appointment ability.
 !
 !========================================================================= [2]
 ! Program Notes:
 ! --------------
 ! This program can be utilized for learning to program in AlphaBasic.
 !
 ! This program requires the following XCALL .SBR's to function.  You should
 ! already have most of them on your system:
 ! 
 ! NOECHO JOBNAM BOX ODTIM STRIP INPUT (renamed from INFLD/MicroSabio)
 ! MESAG ANYCN INMEMO (MicroSabio) BASORT RENAME WAIT SPOOL RDATE
 ! 
 ! The only two .SBR's you may not have are INFLD and INMEMO.  INMEMO is
 ! utilized for extended comment windows.  INFLD is used for features not
 ! available in the standard INPUT.SBR  Simply remove these features if
 ! you don't have INFLD.
 ! 
 ! You are free to modify any way you desire.
 !
 ! Feel free to call me at Basic Systems, Inc. (803) 232-1826 
 !
 ! Greg Berthume -> creator of I/O Mail.
 !==========================================================================

 ! INMEMO.SBR support

 MAP1 MMO'OPCODES
	MAP2 MMO'DSP,B,2,0		! Display only
	MAP2 MMO'EDT,B,2,1		! Edit
	MAP2 MMO'BDR,B,2,2		! Use a window border
	MAP2 MMO'LID,B,2,4		! Smart line insert & delete
	MAP2 MMO'DEL,B,2,8		! Delete memo
	MAP2 MMO'LIN,B,2,16		! Return 1 logical line
	MAP2 MMO'OPN,B,2,32		! Open file - reserved
	MAP2 MMO'CLS,B,2,64		! Close file - reserved
	MAP2 MMO'NBR,B,2,128		! No border redisplay
	MAP2 MMO'NMR,B,2,256		! No memo or border redisplay
	MAP2 MMO'SCH,B,2,512		! Search
	MAP2 MMO'SIL,B,2,1024		! Silent mode (no terminal output)
	MAP2 MMO'DPG,B,2,2048		! Display only, with paging
	MAP2 MMO'MNU,B,2,4096		! Menu bar mode
	MAP2 MMO'TBL,B,2,8192		! Table lookup (only with MMO'SCH)
MAP1 MMO'ERRORS
	MAP2 MMO'LKE,B,4,-1		! Link error
	MAP2 MMO'FUL,B,4,1		! file full

MAP1 XFR'OPCODES
	MAP2 XFR'CPY,B,1,0		! XFRMMO copy mode
	MAP2 XFR'MOV,B,1,1		! XFRMMO move mode 
	
MAP1 XFR'ERRORS
	MAP2 XFR'SUC,B,1,0		! success
	MAP2 XFR'LKE,B,1,1		! Link error
	MAP2 XFR'FUL,B,1,2		! file full	
	MAP2 XFR'SYS,B,1,3		! system error

MAP1 XPOS,X,6						! INMEMO support
MAP1 POS,B,4,@XPOS					! INMEMO support
MAP1 PROMPT$,S,60,""                      		! INMEMO support
MAP1 MCH,B,1,98						! INMEMO file #
MAP1 VSPEC						! INMEMO support
	MAP2 VWIDTH,B,2,72 				! (max memo size is
	MAP2 VROWS,B,2,25 				!  72 cols, 16 rows)
MAP1 STRW,B,2,15   					! INMEMO: start row
MAP1 STCL,B,2,02    					! INMEMO: start col
MAP1 ENDRW,B,2,20    					! INMEMO: end row
MAP1 ENDCL,B,2,76    					! INMEMO: end col

!======================================================================== [2]
! Below maps are for code at end of program for initializing memo file.
!======================================================================== [2]

MAP1 PHDR
	MAP2 VMAJOR,B,1,1
	MAP2 VMINOR,B,1,2
	MAP2 VSUB,B,1
	MAP2 VEDIT,B,1,0
	MAP2 VPATCH,B,1,0

MAP1 CTL'REC2
	MAP2 MARKER2,S,6
	MAP2 NXT'FRE2,B,2
	MAP2 NXT'DEL2,B,2
	MAP2 FILL2,S,54
MAP1 CTL'REC4,@CTL'REC2
	MAP2 MARKER4,S,6
	MAP2 NXT'FRE4,B,4
	MAP2 NXT'DEL4,B,4
	MAP2 FLAG4,S,1
	MAP2 FILL4,S,49

MAP1 NBRACKS,S,64,"]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]"

MAP1 MEMO$,S,24

MAP1 BSWAP,B,4
MAP1 BSWPX,@BSWAP
	MAP2 BS1,B,2
	MAP2 BS2,B,2
MAP1 BX2,B,2
!======================================================================== [2]
  
! Appointment record format

MAP1 APOINT
	MAP2 IDNUM,S,4		! Person's Id #.
	MAP2 ADATE,S,6		! Appointment date "YYMMDD" format
	MAP2 ATIME,S,6		! Appointment time "10:30A"
	MAP2 ANAME,S,25		! Name (person, company, etc.)
	MAP2 APHONE,S,12	! Phone #
	MAP2 ACOMNT,S,50	! Comment
	MAP2 CNTDWN,F		! # of days within date to be notified
	MAP2 ALINK,B,4		! link to appointment memo file
	MAP2 ARECUR,S,1		! 'R' for recurring appointment.
	MAP2 ADURAT,F		! Appointment duration (in minutes)
	MAP2 UNUSED,X,8 	! leftover bytes 
 MAP1 AP'CTL
      	MAP2 FILL'0,X,2		! 2 byte filler
      	MAP2 ORGAP,F,6		! Organized count
      	MAP2 RECAP,F,6		! Record count
      	MAP2 MAXAP,F,6		! Maximum number of Records
      	MAP2 DELAP,F,6		! Delete count
	MAP2 PASSAP,S,4		! Password
     	MAP2 FIL'AP'CTL,X,98    ! leftover bytes
 MAP1 RECSIZ1,F,6,128	! Record size of Appointment file (128 bytes)
 MAP1 FILE1,F		! Record specification variable
 
 MAP1 NUMBERS
	MAP2 DEFLT,F,6,0
	MAP2 MENU'FLAG,B,1
	MAP2 SWITCHES,F
	MAP2 CNGCTL,F
	MAP2 INXCTL,F	  
	MAP2 NUMREC,F
	MAP2 SIZE,F
	MAP2 CHAR,F
	MAP2 FND,F
	MAP2 P,F,6,0
	MAP2 FLTDAT,F
	MAP2 DAYS,F,6,0
	MAP2 EXITCODE,F
	MAP2 WHATNO,F
	MAP2 N,F
	MAP2 FILE2,F
	MAP2 FOUND,F
	MAP2 DLINK,B,4
	MAP2 FILE98,F
	MAP2 COPIES,F,6,1
	MAP2 AUTO'APP(7),F,6
	MAP2 AUTO'CNT,F,6,0
	MAP2 OP'FLG,F,6,0
	MAP2 PRT'FLG,F,6,0
 MAP1 STRINGS
	MAP2 WHO,S,6			! who logged in
	MAP2 USER,S,4
	MAP2 ENTRY,S,50
	MAP2 FILNAM,S,10
	MAP2 MMONAM,S,10
	MAP2 PRTFIL,S,10
	MAP2 CALFIL,S,10
 	MAP2 SDATE,S,6
	MAP2 BRACK,S,8,"]]]]]]]]"
	MAP2 BRACKS,S,128
	MAP2 TODAY,S,6
	MAP2 TODAY'S'DATE,S,45
	MAP2 CENTER,F
	MAP2 IT,S,6
	MAP2 PRINTER,S,6,""
	MAP2 PR'DEL,S,1
 MAP1 APP(3),S,14
	APP(1) = "Add" : APP(2) = "Change/Inquire" : APP(3) = "Delete"
 
 MAP1 PRINTOUT'VARIABLES
	MAP2 STRTDTE,S,6
	MAP2 ENDDTE,S,6
	MAP2 PLINE,S,80
	MAP2 DSP,S,1
	MAP2 COR,F,6,0
	MAP2 PFLG,S,1
 
	XCALL NOECHO : FILEBASE 1 : ON ERROR GOTO TRAP 
 
	FOR SIZE = 1 TO 16 : BRACKS = BRACKS + BRACK : NEXT SIZE

!================================!
 CHECK'FOR'RETURN'FROM'CALENDAR: !	
!================================!
	XCALL JOBNAM,WHO : WHO=WHO[2,5] : XCALL STRIP,WHO
	CALFIL=WHO+".DAT"
	LOOKUP CALFIL,FND
	IF FND<>0 THEN GOTO GET'USER
!===============!
 ACCESS'SCREEN:	!
!===============!
1000	PRINT TAB(-1,36);TAB(-1,0);
	CALL NOTIFIER
	?TAB(-1,11);
 	PRINT TAB(10,29);TAB(-1,32);" NOTIFIER Version 2.0 ";TAB(-1,33);
	?TAB(-1,12);
	XCALL BOX,12,24,18,58
	XCALL ODTIM,TODAY'S'DATE,0,0,-1
	XCALL STRIP,TODAY'S'DATE
	CENTER=(79-LEN(TODAY'S'DATE))/2
	? TAB(20,1);TAB(20,CENTER+2);TODAY'S'DATE;
	PRINT TAB(14,27);TAB(-1,11);"Please enter your Id #:";TAB(-1,12);TAB(-1,37);
	PRINT TAB(16,27);TAB(-1,11);"Please enter password:"
	XCALL INPUT,14,51,04,01,"A^1S;",ENTRY,INXCTL,1,0,EXITCODE,0,1
	ON EXITCODE GOTO END
	USER = ENTRY[1,4]
!==========!  
 GOT'USER: !
!==========!
	IDNUM = USER
	FILNAM = USER : XCALL STRIP,FILNAM
	MMONAM = USER : XCALL STRIP,MMONAM
	PRTFIL = USER : XCALL STRIP,PRTFIL
	FILNAM = "A"+FILNAM+".DAT"
	MMONAM = MMONAM+"MO.MMO"
	PRTFIL = PRTFIL+".LST"
!===========!
 OPEN'FILE: !
!===========!
1020	LOOKUP FILNAM,FND
	IF FND = 0 THEN CALL CREATE'FILE
	LOOKUP MMONAM,FND
	IF FND = 0 THEN GOTO CREATE'MEMO'FILE
!===============!
 FILES'CREATED: !
!===============!
	OPEN #1,FILNAM,RANDOM,RECSIZ1,FILE1
	OPEN #MCH, MMONAM, RANDOM, 64, FILE98	
	FILE1 = 1 : READ #1,AP'CTL
	IF FOUND=9 THEN GOTO DISPLAY'OPTIONS
	IF MENU'FLG=1 THEN GOTO DISPLAY'OPTIONS
!==============!
 GET'PASSWORD: !
!==============!
	XCALL INPUT,16,51,04,00,"A^1]S;",ENTRY,INXCTL,1,0,EXITCODE,0,1
	IF EXITCODE=1 THEN CLOSE #1 : CLOSE #MCH : GOTO ACCESS'SCREEN
	IF ENTRY<>PASSAP THEN ? CHR(7) : GOTO GET'PASSWORD
!=================!
 DISPLAY'OPTIONS: !
!=================!
1060	FOUND=0
	? TAB(-1,36);TAB(-1,0);TAB(-1,29);
 	XCALL BOX,4,9,20,73
	XCALL ODTIM,TODAY'S'DATE,0,0,-1
	? TAB(2,57);TAB(-1,33);
	? TAB(2,21);TAB(-1,32);" G B  S O F T W A R E  C O N C E P T S ";TAB(-1,33);
	? TAB(-1,11);TAB(4,52);TAB(-1,33);
	? TAB(4,27);TAB(-1,32);"  T H E  N O T I F I E R  "; &
		TAB(-1,33);TAB(-1,12)
	XCALL STRIP,TODAY'S'DATE
	CENTER=(79-LEN(TODAY'S'DATE))/2
	? TAB(6,1);TAB(6,CENTER+2);TODAY'S'DATE;
 	XCALL BOX,7,21,17,60
  	XCALL BOX,17,26,19,55
	? TAB(-1,12);
 	? TAB(08,23);"1";TAB(-1,11);" - Add Appointment(s)";TAB(-1,12);
	? TAB(09,23);"2";TAB(-1,11);" - Change/Inquire Appointment(s)";TAB(-1,12);
	? TAB(10,23);"3";TAB(-1,11);" - Delete Appointments(s)";TAB(-1,12);
	? TAB(11,23);"4";TAB(-1,11);" - Display/Print by Date";TAB(-1,12);
	? TAB(12,23);"5";TAB(-1,11);" - Display Monthly Calendar";TAB(-1,12);
	? TAB(13,23);"6";TAB(-1,11);" - Delete Past Appointments";TAB(-1,12);
	? TAB(14,23);"7";TAB(-1,11);" - Auto Appointment Notification";TAB(-1,12);
	? TAB(15,23);"8";TAB(-1,11);" - Change Password";TAB(-1,12);
	? TAB(16,23);"9";TAB(-1,11);" - File Maintenance Functions";TAB(-1,12);TAB(-1,28);
        ? TAB(-1,37);
!===============!
 GET'SELECTION: !
!===============!
1080	? TAB(18,47);"   "
	? TAB(18,33);"SELECTION --> ";
	XCALL INPUT,18,47,01,01,"#1FI;",ENTRY,INXCTL,1,0,EXITCODE,0,1
 	IF EXITCODE=1 THEN CALL SORT'FILE : CLOSE #1 : CLOSE #MCH : GOTO ACCESS'SCREEN
	CHAR = VAL(ENTRY)
	ON CHAR GOTO DISP1,DISP1,DISP1,PRINT'DATES,CALENDAR,DELETE'PAST,AUTO,CHANGE'PASS,HELP
	GOTO GET'SELECTION
!=======!
 ABORT: !
!=======!
1100	XCALL MESAG,"Sorry, not installed at this time",1
	GOTO GET'SELECTION
!=============!
 CREATE'FILE: !
!=============!
1120	PRINT TAB(-1,0);
	PRINT TAB(06,01);"File does not exist.";TAB(-1,11); &
		"  Do you wish to initialize? ";TAB(-1,12);
	PRINT TAB(-1,12);
	XCALL INPUT,06,50,01,00,"YNF;",ENTRY,INXCTL,1
	IF ENTRY="N" THEN GOTO ACCESS'SCREEN 
	PRINT TAB(08,01);"The ";TAB(-1,11);"# of appointments";TAB(-1,12); &
		" that will be in your file at any one time."
	PRINT TAB(10,01);"Enter the maximum # of records you want your file to be: ";
!=========!
 RECORDS: !
!=========!
	ENTRY=NUMREC
	XCALL INPUT,10,58,3,01,"#15;",ENTRY,INXCTL,1,1,EXITCODE
	ON EXITCODE GOTO ACCESS'SCREEN
	IF VAL(ENTRY) < 2 THEN ?CHR(7); : GOTO RECORDS
	NUMREC = VAL(ENTRY)
!==========!
 PASSWORD: !
!==========!
	PRINT TAB(12,01);TAB(-1,11);"Enter password: ";TAB(-1,12);
	ENTRY=PASSAP
	XCALL INPUT,12,17,4,00,"A^13];",ENTRY,INXCTL,1,1,EXITCODE
	ON EXITCODE GOTO RECORDS
	PASSAP=ENTRY
	IF EXITCODE=3 THEN GOTO RECORDS
	SIZE = (NUMREC/(INT(512/RECSIZ1))) + 1
	ALLOCATE FILNAM,SIZE
	OPEN #1,FILNAM,RANDOM,RECSIZ1,FILE1
	FILE1 = 1 
	FILL'0 = "" : ORGAP = 1 : RECAP = 1 : MAXAP = NUMREC : DELAP = 0
	WRITE #1,AP'CTL		
	CLOSE #1
	FOUND=9
	RETURN
!=======!
 DISP1: !
!=======!
1140	IF (RECAP=1) AND (CHAR<>1) THEN GOTO NONE
    	CNGCTL=0 : ALINK=0 : DLINK=0
	PRINT TAB(-1,0);APP(CHAR);" Appointments"
	PRINT TAB(-1,12);
	XCALL ODTIM,TODAY'S'DATE,0,0,-1
	PRINT TAB(04,1);TAB(-1,11);"Today's Date: ";TAB(-1,12);TODAY'S'DATE
	PRINT TAB(06,1);"1";TAB(-1,11);"  Enter Date <MMDDYY>   : ";TAB(-1,12);
	PRINT TAB(07,1);"2";TAB(-1,11);"        Time            : ";TAB(-1,12);
	PRINT TAB(07,44);"3";TAB(-1,11);"  Duration :      minutes";TAB(-1,12);
	PRINT TAB(08,1);"4";TAB(-1,11);"        Name            : ";TAB(-1,12);
	PRINT TAB(09,1);"5";TAB(-1,11);"        Phone           : ";TAB(-1,12);
	PRINT TAB(10,1);"6";TAB(-1,11);"        Comment         : ";TAB(-1,12);
	PRINT TAB(11,1);"7";TAB(-1,11);"  # days advance warning: ";TAB(-1,12);
	PRINT TAB(12,1);"8";TAB(-1,11);"  Additional Comments   : ";TAB(-1,12);
	IF OP'FLG=1 THEN RETURN
	ON CHAR GOTO DATE,CHANGE,DELETE
!======!
 DATE: !
!======!
1160	IF RECAP = MAXAP THEN GOTO EXPAND'FILE
	IF CNGCTL=1 THEN ENTRY=ADATE ELSE ENTRY=""
	XCALL INPUT,06,28,06,00,"bD>134569T;",ENTRY,INXCTL,1,1,EXITCODE
	IF EXITCODE=1 THEN ENTRY="SORT" : CALL SORT'FILE : GOTO DISPLAY'OPTIONS
	IF ENTRY="" THEN CALL GET'DATE : ADATE=TODAY : ENTRY=ADATE : &
		PRINT TAB(06,28);ADATE[3,4];"/";ADATE[5,6];"/";ADATE[1,2]
	IF EXITCODE=7 THEN GOTO RECURRING
	ON EXITCODE-2 GOTO COUNTDOWN,DATE,TIME,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	ADATE = ENTRY
	ON CNGCTL GOTO ANYCNG
!======!
 TIME: !
!======!
1180	IF CNGCTL=1 THEN ENTRY=ATIME ELSE ENTRY=""
	XCALL INPUT,07,28,06,00,"ALT34569;",ENTRY,INXCTL,1,1,EXITCODE
	ATIME = ENTRY[1,6]
	IF EXITCODE=12 THEN GOTO DURATION
	ON EXITCODE-2 GOTO DATE,DATE,NAME,COUNTDOWN,DURATION
	IF EXITCODE=9 THEN GOTO DATE
	ON CNGCTL GOTO ANYCNG
!==========!
 DURATION: !
!==========!
1190 	IF CNGCTL=1 THEN ENTRY=ADURAT ELSE ENTRY=""
	XCALL INPUT,07,58,04,00,"a#R]234569;",ENTRY,INXCTL,1,1,EXITCODE
!	IF ENTRY[4,4]="H" THEN ENTRY=VAL(ENTRY[1,3])*60
	ADURAT = VAL(ENTRY)
	ON EXITCODE-1 GOTO TIME,TIME,DATE,NAME,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	ON CNGCTL GOTO ANYCNG
!======!
 NAME: ! 
!======!
1200	IF CNGCTL=1 ENTRY=ANAME ELSE ENTRY=""
	XCALL INPUT,08,28,25,00,"Ac34569;",ENTRY,INXCTL,1,1,EXITCODE
	ANAME = ENTRY[1,25]
	ON EXITCODE-2 GOTO TIME,DATE,PHONE,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	ON CNGCTL GOTO ANYCNG
!=======!
 PHONE:	!	
!=======!
1220	IF CNGCTL=1 THEN ENTRY=APHONE ELSE ENTRY=""
	XCALL INPUT,09,28,12,00,"A34569;",ENTRY,INXCTL,1,1,EXITCODE
	APHONE = ENTRY[1,12]
	ON EXITCODE-2 GOTO NAME,DATE,COMMENT,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	ON CNGCTL GOTO ANYCNG
!=========!
 COMMENT: !
!=========!
1240	IF CNGCTL=1 ENTRY=ACOMNT ELSE ENTRY=""
	XCALL INPUT,10,28,50,00,"Ac34569;",ENTRY,INXCTL,1,1,EXITCODE
	ACOMNT = ENTRY[1,50]
	ON EXITCODE-2 GOTO PHONE,DATE,COUNTDOWN,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	ON CNGCTL GOTO ANYCNG
!===========!
 COUNTDOWN: !	
!===========!
1260	IF CNGCTL=1 THEN ENTRY=CNTDWN ELSE ENTRY=""
	XCALL INPUT,11,28,4,00,"#34569;",ENTRY,INXCTL,1,1,EXITCODE
	IF ENTRY="" THEN ENTRY=1 : PRINT TAB(11,28);TAB(-1,9);ENTRY
	IF ENTRY=0 THEN ?CHR(7); : GOTO COUNTDOWN
	CNTDWN = VAL(ENTRY)
	ON EXITCODE-2 GOTO COMMENT,DATE,DATE,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	GOTO ANYCNG
!===========!
 RECURRING: !
!===========!
	ENTRY="R"
	XCALL INPUT,06,38,1,00,"a^34569];",ENTRY,INXCTL,1,1,EXITCODE
	IF ENTRY<>"R" AND ENTRY<>"" THEN ?CHR(7); : GOTO RECURRING
	ARECUR = ENTRY
	ON EXITCODE-2 GOTO DATE,DATE,TIME,COUNTDOWN
	IF EXITCODE=9 THEN GOTO DATE
	IF ARECUR="R" THEN ?TAB(06,38);TAB(-1,11); &
				"Recurring Appointment";TAB(-1,12);
	IF ARECUR="" THEN ?TAB(06,38);TAB(-1,9);
	ON CNGCTL GOTO ANYCNG
	GOTO DATE
!========!
 ANYCNG: !
!========!
1280	XCALL ANYCN,CNGCTL,WHATNO
	IF CNGCTL = 0 THEN GOTO PROCES1
	ON WHATNO GOTO DATE,TIME,DURATION,NAME,PHONE,COMMENT,COUNTDOWN,MEMO'EDITING
!=========!
 PROCES1: ! 
!=========!
1300	ON CHAR GOTO PROCES2,PROCES3,PROCES4
!=========!
 PROCES2: !
!=========!
1320	FILE1 = RECAP + 1
	WRITE #1,APOINT
	RECAP = RECAP + 1
	FILE1 = 1 : WRITE #1,AP'CTL
	APOINT=SPACE(128)
	GOTO DISP1
!=========!
 PROCES3: !
!=========!
1340	WRITE #1,APOINT
	APOINT=SPACE(128)
	GOTO DISP1
!=========!
 PROCES4: !
!=========!
	DLINK = ALINK
1360	APOINT = BRACKS	
	WRITE #1,APOINT
	DELAP = DELAP +1
	FILE1 = 1 : WRITE #1,AP'CTL	
 	IF DLINK=0 THEN CALL SORT'FILE : GOTO DISP1     ! [2]
	OPCODE=MMO'DEL
 	XCALL INMEMO,OPCODE,"",MCH,0,0,0,0,DLINK,XPOS	! Delete memo pad [2]
 	if POS<>0 call SHOW'POS				! [2]
	XCALL MESAG,"Appointment Deleted!",2
	CALL SORT'FILE
	GOTO DISP1
!========!
 CHANGE: !
!========!
1380	XCALL INPUT,06,28,06,00,"bD>1;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE = 1 THEN GOTO DISPLAY'OPTIONS
	IF ENTRY="" THEN CALL GET'DATE : ENTRY=TODAY : &
		PRINT TAB(06,28);ENTRY[3,4];"/";ENTRY[5,6];"/";ENTRY[1,2]
	SDATE = ENTRY
!=============!
 SEARCH'LOOP: !
!=============!
1400	IF RECAP = 1 THEN GOTO NO'APPOINT
	FOR FILE1 = 2 TO RECAP 
	READ #1,APOINT
	IF ADATE = SDATE THEN CALL DISPLAY'APPOINTMENT  : &
		IF ENTRY[1,1] = "Y" THEN GOTO ANYCNG  
	IF EXITCODE=1 THEN GOTO DISP1
	NEXT FILE1
	XCALL MESAG,"Appointment not found!",2
	GOTO DISP1
!=====================!
 DISPLAY'APPOINTMENT: !
!=====================!
1420 	AUTO'CNT=0
 	IF ARECUR="R" THEN ?TAB(06,38);TAB(-1,11); &
				"Recurring Appointment";TAB(-1,12);
	IF ARECUR<>"R" THEN ?TAB(06,38);TAB(-1,9);
	PRINT TAB(06,28);ADATE[3,4];"/";ADATE[5,6];"/";ADATE[1,2];
	PRINT TAB(07,28);ATIME;TAB(07,58);ADURAT USING "####"
	PRINT TAB(08,28);ANAME
	PRINT TAB(09,28);APHONE
	PRINT TAB(10,28);ACOMNT
	PRINT TAB(11,28);CNTDWN
	PRINT TAB(12,28);
  	IF ALINK<>0 THEN PRINT "YES"; ELSE PRINT "NO ";
	OPCODE=MMO'DSP+MMO'BDR
	IF ALINK=0 THEN CALL REMOVE'BOX
	IF ALINK<>0 THEN &
		XCALL INMEMO,OPCODE,PROMPT$,MCH,STRW,STCL,ENDRW,ENDCL,ALINK,XPOS,VSPEC
	IF POS<>0 THEN CALL SHOW'POS
	IF OP'FLG=1 THEN RETURN	
 	PRINT TAB(24,1); "Right Appointment ?";
 	XCALL INPUT,24,22,01,00,"YN1F;",ENTRY,INXCTL,1,0,EXITCODE
	RETURN
!========!
 DELETE: !
!========!
1440	XCALL INPUT,06,28,06,00,"D>1;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE = 1 THEN GOTO DISPLAY'OPTIONS
	IF ENTRY="" THEN CALL GET'DATE : ENTRY=TODAY : &
		PRINT TAB(06,28);ENTRY[3,4];"/";ENTRY[5,6];"/";ENTRY[1,2]
	SDATE = ENTRY
!==============!
 SEARCH'LOOP2: !	 
!==============!
1460	IF RECAP = 1 THEN GOTO NO'APPOINT
	FOR FILE1 = 2 TO RECAP 
	READ #1,APOINT
	IF ADATE = SDATE THEN CALL DISPLAY'APPOINTMENT  : &
		IF ENTRY[1,1] = "Y" THEN GOTO PROCES4 
	IF EXITCODE=1 THEN GOTO DISP1
	NEXT FILE1
	XCALL MESAG,"Appointment not found!",2
	GOTO DISP1
!============!
 NO'APPOINT: !
!============!
1500	XCALL MESAG,"There are no APPOINTMENTS on file!",2 
	GOTO DISP1
!===========!
 SORT'FILE: !
!===========!
1520	IF (RECAP = ORGAP) AND (DELAP = 0) AND ENTRY<>"SORT" &
		THEN GOTO ALREADY'SORTED
	PRINT TAB(2,1); TAB(-1,9); "Sorting Appointment File"
	XCALL BASORT,1,RECAP,RECSIZ1,6,5,0,6,11,0,0,0,0,0,0,0
	RECAP = (RECAP-DELAP)
	ORGAP = RECAP
	DELAP = 0
	FILE1 = 1 : WRITE #1, AP'CTL
	PRINT TAB(2,1);TAB(-1,9)
	RETURN
!================!
 ALREADY'SORTED: !
!================!
1540	RETURN
!=============!
 EXPAND'FILE: !
!=============!
1560	PRINT TAB(-1,0);
	?TAB(08,01);"Your appointment file has been MAXed OUT and needs to be expanded to"
	?TAB(09,01);"allow room for more appointments.  Either expand here or back out "
	?TAB(10,01);"using ESC and delete some old appointments";
	?TAB(12,01);"Appointments currently on file: ";RECAP-1
	PRINT TAB(14,01);"Enter new maximum # of records you want your file to be: ";
	XCALL INPUT,14,58,3,01,"#1;",ENTRY,INXCTL,1,0,EXITCODE
	ON EXITCODE GOTO DISPLAY'OPTIONS	
	NUMREC = ENTRY
	SIZE = (NUMREC/(INT(512/RECSIZ1))) + 1 
	LOOKUP "APOINT.DAT",FND
	IF FND <> 0 THEN KILL "APOINT.DAT"
	ALLOCATE "APOINT.DAT",SIZE
	OPEN #2,"APOINT.DAT",RANDOM,RECSIZ1,FILE2
	FILE1 = 1 : READ #1,AP'CTL 
	FILE2 = 1 : MAXAP = NUMREC : WRITE #2,AP'CTL 
!=======!
 LOOPS: !
!=======!
1580		FOR FILE1 = 2 TO RECAP
			FILE2 = FILE1
				READ #1,APOINT
			WRITE #2,APOINT	
		NEXT FILE1
 
		FOR FILE2 = (RECAP+1) TO MAXAP
			APOINT = BRACKS
			WRITE #2,APOINT
		NEXT FILE2
 
	CLOSE #1 : CLOSE #2
	KILL FILNAM
	XCALL RENAME,"APOINT.DAT",FILNAM,N
	IF N <> 0 THEN XCALL MESAG,"Error in Rename routine!",1
	OPEN #1,FILNAM,RANDOM,RECSIZ1,FILE1
	FILE1 = 1 : READ #1,AP'CTL
	GOTO DISP1
!=============!
 PRINT'DATES: !
!=============!
1600	IF RECAP = 1 THEN GOTO NONE
	PRINT TAB(1,1); TAB(-1,10); "Print Appointment Listing"
	PRINT TAB(3,1); TAB(-1,10);TAB(-1,11);
	PRINT TAB(10,20); "Please enter Starting Date";
	PRINT TAB(12,20); "Please enter Ending date";
	PRINT TAB(14,20); "Display to screen Y/N?";TAB(-1,12);
!=========!
 STRTDTE: !
!=========!
1620	XCALL INPUT,10,50,06,00,"D1T;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE = 1 THEN GOTO DISPLAY'OPTIONS
	IF EXITCODE = 7 THEN GOTO ALL'DATES
	IF ENTRY = " " THEN GOTO ALL'DATES
	STRTDTE = ENTRY[5,6]+ENTRY[1,4] USING "#ZZZZZ"
!========!
 ENDDTE: !
!========!
1640	XCALL INPUT,12,50,06,00,"D;",ENTRY,INXCTL,1,0,EXITCODE
	IF ENTRY="" THEN ENDDTE=STRTDTE : &
	? TAB(12,50);ENDDTE[3,4]+"/"+ENDDTE[5,6]+"/"+ENDDTE[1,2] : &
	GOTO PRINT'DISPLAY
	ENDDTE = ENTRY[5,6]+ENTRY[1,4] USING "#ZZZZZ"
	GOTO PRINT'DISPLAY
!===========!
 ALL'DATES: !
!===========!
1660	STRTDTE = ""
	PRINT TAB(10,50); "All";
	IF EXITCODE=7 THEN DSP="Y" : PFLG="N" : GOTO PRINTING
!===============!
 PRINT'DISPLAY: !
!===============!
1680	XCALL INPUT,14,50,01,00,"YYF;",ENTRY,INXCTL,1,0,EXITCODE
	DSP = ENTRY[1,1]
	IF DSP="N" THEN PFLG="Y" : GOTO CHANGES
!==============!
 PRINT'OPTION: !
!==============!
1700	PRINT TAB(16,20);TAB(-1,11);"Print it out also? Y/N";TAB(-1,12);
	XCALL INPUT,16,50,01,00,"YNF;",ENTRY,INXCTL,1,0,EXITCODE		
	PFLG = ENTRY[1,1]
!=========!
 CHANGES: !
!=========!
1720	CNGCTL = 2 : XCALL ANYCN,CNGCTL,WHATNO
	ON CNGCTL GOTO PRINT'DATES
!==========!
 PRINTING: !
!==========!
1740	CALL GET'DATE
	P=0 : COR=0
	IF DSP="N" THEN	XCALL WAIT,2
	CALL SORT'FILE
	IF PFLG="Y" THEN OPEN #3,PRTFIL,OUTPUT : PRT'FLG=1
	PLINE[01,37] = "Appointment Schedule Printout from :"
	IF STRTDTE = "" THEN GOTO ALL'AP
	PLINE[39,46] = STRTDTE[3,4]+"/"+STRTDTE[5,6]+"/"+STRTDTE[1,2]
	PLINE[48,49] = "to"
	PLINE[51,58] = STRTDTE[3,4]+"/"+STRTDTE[5,6]+"/"+STRTDTE[1,2]
	CALL PRINT
	CALL PRINT
	CALL HEADER
	GOTO PRINT'LOOP
!========!
 ALL'AP: !
!========!
1760	PLINE[31,50] = "for all appointments"
	CALL PRINT  
	CALL PRINT  
        CALL HEADER
!============!
 PRINT'LOOP: !
!============!
1780	FOR FILE1 = 2 TO RECAP
	READ #1,APOINT
	IF STRTDTE = "" THEN GOTO PRINT'AP 
	IF ADATE => STRTDTE AND ADATE <= ENDDTE THEN GOTO PRINT'AP
!==========!
 NEXT'REC: !
!==========!
1800	NEXT FILE1
!==============!
 PRINT'PROMPT: !
!==============!
	IF PFLG="Y" THEN CLOSE #3 : PRT'FLG=0
        IF P>0 AND PFLG="Y" THEN CALL PRINTER : &
    		   IF PR'DEL ="N" SWITCHES=264 ELSE SWITCHES=260 : &
		 	XCALL SPOOL,PRTFIL,PRINTER,SWITCHES,COPIES
	IF P<>0 AND PFLG="N" THEN GOTO DO'IT'AGAIN
	IF P=0 THEN XCALL MESAG,"No appointments for that time period",2
	GOTO DISPLAY'OPTIONS
!==========!
 PRINT'AP: !
!==========!
1840	P=P+1
	AUTO'CNT = AUTO'CNT + 1
	AUTO'APP(AUTO'CNT)=FILE1
	PLINE[02,02] = AUTO'CNT USING "#"
	PLINE[05,05] = ARECUR
	PLINE[07,14] = ADATE[3,4]+"/"+ADATE[5,6]+"/"+ADATE[1,2]
	PLINE[17,22] = ATIME
	PLINE[27,51] = ANAME
	PLINE[54,65] = APHONE
	PLINE[68,72] = CNTDWN USING "####"
	IF ADATE<TODAY THEN PLINE[68,73] = "PAST!"
	IF DSP = "Y" THEN CALL SCREEN'DSP
	CALL PRINT
	PLINE[07,15] = "Comment: "
	PLINE[16;50] = ACOMNT
	IF ALINK<>0 THEN PLINE[68;12] = "(Add'l Comm)"
	IF DSP = "Y" THEN CALL SCREEN'DSP
	CALL PRINT
	IF DSP = "Y" THEN CALL SCREEN'DSP
	CALL PRINT
	GOTO NEXT'REC
!=======!
 PRINT: !
!=======!
	IF VAL(PLINE[2,3]) > 0 THEN PLINE[2,3]="  "
	IF PFLG="N" THEN PLINE="" : RETURN
1860	PRINT #3,PLINE
	PLINE = ""
	RETURN
!========!
 HEADER: !          
!========!
1880	PLINE[1,72] = "      Date      Time      Name                       Phone Number  Timer"
	IF DSP = "Y" THEN CALL SCREEN'DSP
	CALL PRINT
	PLINE[1,72] = "      --------  ------    -------------------------  ------------  -----"
	IF DSP = "Y" THEN CALL SCREEN'DSP
	CALL PRINT
	RETURN
!============!
 SCREEN'DSP: !
!============!
1900	IF COR = 0 THEN PRINT TAB(-1,0);
	COR = COR + 1
	IF COR<>2 THEN PRINT TAB(COR,1);PLINE
	IF COR<>1 AND COR<>2 AND PLINE[7,9]="Com" THEN PRINT TAB(COR,7); &
		TAB(-1,11);PLINE[7,15];	TAB(-1,12);
	IF COR=2 THEN PRINT TAB(COR,1);TAB(-1,11);PLINE;TAB(-1,12);
	IF COR = 23 THEN GOTO DIVIDE'SCREEN
	RETURN
!===============!
 DIVIDE'SCREEN: !
!===============!
1920	CALL OPTION1
	COR = 0
	PLINE[1,72] = "      DATE      TIME      NAME                       PHONE NUMBER  TIMER"
	CALL SCREEN'DSP
	PLINE[1,72] = "      --------  ------    -------------------------  ------------  -----"
	CALL SCREEN'DSP
	RETURN
!======!
 HELP: !
!======!
1940	XCALL MESAG,"See System Operator",2
	GOTO GET'SELECTION
!======!
 AUTO: !
!======!
1960	IF RECAP = 1 THEN GOTO NONE
	COR=0 : P=0 
	XCALL RDATE,FLTDAT
	TODAY = FLTDAT USING "#ZZZZZ"
		FOR FILE1 = 2 TO RECAP
		READ #1,APOINT
		   ADATE=ADATE[3,6]+ADATE[1,2]
                   DAYS = (TODAY[5,6]-ADATE[5,6])*360+(TODAY[1,2]-ADATE[1,2])*30+(TODAY[3,4]-ADATE[3,4])
   	           IF ABS(DAYS) <= CNTDWN THEN CALL NOTIFY
		NEXT FILE1
 
		IF P=0 THEN XCALL MESAG,"No appointments",2 : GOTO GET'SELECTION
		IF P>0 THEN CALL OPTION1
		GOTO DISPLAY'OPTIONS
!========!
 NOTIFY: !
!========!
	IF P=0 THEN CALL DIVIDE
	P=P+1
	AUTO'CNT = AUTO'CNT + 1
	AUTO'APP(AUTO'CNT)=FILE1
	PLINE[02,02] = AUTO'CNT USING "#"
	PLINE[05,05] = ARECUR
	PLINE[07,14] = ADATE[1,2]+"/"+ADATE[3,4]+"/"+ADATE[5,6]
	PLINE[17,22] = ATIME
	PLINE[27,51] = ANAME
	PLINE[54,65] = APHONE
	PLINE[68,72] = ABS(DAYS) USING "####"
	IF (ADATE[5,6]+ADATE[1,4]) < (TODAY[5,6]+TODAY[1,4]) THEN &
		PLINE[69,73] = "PAST!"
	IF (DAYS=0) THEN PLINE[68,73] = "TODAY!"
	CALL CORD
	PLINE[07,15] = "Comment: "
	PLINE[16;50] = ACOMNT
	IF ALINK<>0 THEN PLINE[68;12] = "(Add'l Comm)"
	CALL CORD 
!======!
 CORD: !
!======!
2000	COR = COR + 1
	IF COR<>2 THEN PRINT TAB(COR,1);PLINE
	IF COR<>1 AND COR<>2 AND PLINE[7,9]="Com" THEN PRINT TAB(COR,7); &
		TAB(-1,11);PLINE[7,15];	TAB(-1,12);
	IF COR=2 THEN PRINT TAB(COR,1);TAB(-1,11);PLINE;TAB(-1,12);
	IF PLINE[68,73]="TODAY!" THEN PRINT TAB(COR,68);TAB(-1,21);PLINE[68,73];TAB(-1,22)
	PLINE=""
	IF COR = 23 THEN CALL DIVIDE
	RETURN
!========!
 DIVIDE: !
!========!
2020	IF P>1 THEN CALL OPTION1
	PRINT TAB(-1,0);
	COR=0 : AUTO'CNT=0
	PLINE[1,78] = "      Date      Time      Name                       Phone Number  Days To Go"
	CALL CORD 
	PLINE[1,78] = "      --------  ------    -------------------------  ------------  -----------"
	CALL CORD 
	RETURN
!=============!
 DELETE'PAST: !
!=============!
2040	IF RECAP = 1 THEN GOTO NONE
	PRINT TAB(-1,0);TAB(-1,11);
	PRINT TAB(10,1);"This will remove all past appointments from your file"
	PRINT TAB(12,1);"Are you sure you want to do this ";TAB(-1,12);"Y/N ?";
	XCALL INPUT,12,40,01,00,"YN1F;",ENTRY,INXCTL,1,0,EXITCODE
	ON EXITCODE GOTO DISPLAY'OPTIONS
	IF ENTRY[1,1] = "N" THEN GOTO DISPLAY'OPTIONS	
	PRINT TAB(1,1);TAB(-1,9);"Purge Past Appointments"
	XCALL WAIT,4
!=================!
 GET'RID'OF'THEM: !
!=================!
2060	CALL GET'DATE
	FOR FILE1 = 2 TO RECAP
	READ #1,APOINT
	IF ADATE < TODAY AND ARECUR = "R" THEN CALL INCREMENT'RECUR'MONTH : &
							GOTO NEXT'REC2
	IF ADATE < TODAY THEN GOTO BRACK
!===========!
 NEXT'REC2: !
!===========!
2080	NEXT FILE1
	CALL SORT'FILE
	GOTO DISPLAY'OPTIONS
!=======================!
 INCREMENT'RECUR'MONTH: !
!=======================!
	ENTRY = "SORT"
	IF ADATE[3,4] = "12" THEN ADATE[3,4] = "01" : &
		ADATE[1,2] = STR(VAL(ADATE[1,2])+1) USING "#Z" : &
		WRITE #1,APOINT : RETURN
	ADATE[3,4] = STR(VAL(ADATE[3,4])+1) USING "#Z"
	WRITE #1,APOINT
	RETURN
!=======!
 BRACK: !
!=======!
2100	DLINK=ALINK
     	APOINT = BRACKS	
	WRITE #1,APOINT
	DELAP = DELAP +1
	FILE1 = 1 : WRITE #1,AP'CTL	
	IF DLINK=0 THEN GOTO NEXT'REC2			! [2]
	OPCODE=MMO'DEL					! [2]
 	XCALL INMEMO,OPCODE,"",MCH,0,0,0,0,DLINK,XPOS	! Delete memo pad [2]
 	if POS<>0 call SHOW'POS				! [2]
	GOTO NEXT'REC2
!==========!
 GET'DATE: !
!==========!
2120	XCALL RDATE,FLTDAT
	TODAY = FLTDAT USING "#ZZZZZ"
	TODAY = TODAY[5,6]+TODAY[1,4]
	RETURN
!======!
 NONE: !
!======!
2140	XCALL MESAG,"You have no appointments on file!",2  
	GOTO DISPLAY'OPTIONS
!=============!
 DO'IT'AGAIN: !
!=============!
2160	PRINT TAB(24,1);"A ";TAB(-1,11);"to Display Again, "; &
		TAB(-1,12);"# ";TAB(-1,11);"to Display Full Detail, or "; &
		TAB(-1,12);"ESC ";TAB(-1,11);"to Exit: ";TAB(-1,12);TAB(-1,9);
	XCALL INPUT,24,63,1,0,"a#^1IF;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE=1 THEN AUTO'CNT=0 : GOTO DISPLAY'OPTIONS
	IF ENTRY="A" THEN AUTO'CNT=0 : GOTO PRINTING
	IF VAL(ENTRY)<>0 THEN GOTO OPTION2
	?CHR(7); : GOTO DO'IT'AGAIN
!=============!
 CHANGE'PASS: !
!=============!
2180	FILE1=1 : READ #1,AP'CTL
	XCALL BOX,21,17,23,66
	PRINT TAB(22,19);TAB(-1,11);"Old password = ";TAB(-1,12);PASSAP 
	PRINT TAB(22,41);TAB(-1,11);"Enter new password: ";TAB(-1,12);
	ENTRY=PASSAP
	XCALL INPUT,22,61,4,00,"A^1];",ENTRY,INXCTL,1,1,EXITCODE
	IF EXITCODE=1 THEN ? TAB(22,1);TAB(-1,9);
	PASSAP=ENTRY
	FILE1=1 : WRITE #1,AP'CTL
	? TAB(21,1);TAB(-1,9);TAB(22,1);TAB(-1,9);TAB(23,1);TAB(-1,9);
	GOTO GET'SELECTION
!=====!
 END: !
!=====!
2200	PRINT TAB(-1,0);"Exit Notifier...";TAB(-1,28); : PRINT 
 	END
!====================================================================== [2]
!==================!
 CREATE'MEMO'FILE: !
!==================!
!220	PRINT TAB(14,01);TAB(-1,11);"Name of Memo file = ";TAB(-1,12);MMONAM
!	PRINT TAB(15,01);TAB(-1,11);"Link size = ";TAB(-1,12);"4 bytes";TAB(-1,11);
!	PRINT TAB(16,01);"The number of records should be about the number"
!	PRINT TAB(17,01);"of appointments that will be on file at a time X 3"
!	PRINT TAB(18,01);"Press RET 3 times to let program automatically "
!	PRINT TAB(19,01);"create Memo File for you..."
!	XCALL MESAG,"",2
 	GOTO INITIALIZE'MEMO'FILE
	END
!==============!
 MEMO'EDITING: !
!==============!
2240	PRINT TAB(18,1);TAB(-1,10);
	OPCODE=MMO'EDT+MMO'BDR+MMO'LID
	XCALL INMEMO,OPCODE,PROMPT$,MCH,STRW,STCL,ENDRW,ENDCL,ALINK,XPOS,VSPEC
	IF POS<>0 THEN CALL SHOW'POS
	PRINT TAB(12,28);
  	IF ALINK<>0 THEN PRINT "YES"; ELSE PRINT "NO ";
	GOTO ANYCNG
!==========!
 SHOW'POS: !							
!==========!
2260	if POS=MMO'FUL then &
		XCALL MESAG, "Use '.EXPMMO' to expand memo file!",1 : &
		RETURN	
	if POS=MMO'LKE then &
		XCALL MESAG, "INMEMO Link Error!",1 : &
		return
	XCALL MESAG, "(POS="+str(POS)+") Illegal return value of POS!"
	CLOSE #1 : CLOSE #98
	END
REMOVE'BOX:
 	FOR COR=14 TO 21 : ?TAB(COR,01);TAB(-1,9); : NEXT COR : RETURN
!====================================================================== [2]
INITIALIZE'MEMO'FILE:
!====================================================================== [2]
	on error goto TRAP
F1:	
 	MEMO$=MMONAM
	lookup MEMO$,EXISTS
	if EXISTS=0 goto FORMAT

	? tab(8,5);MEMO$;" already exists!  Do you wish to delete?"
	xcall INPUT,8,70,1,1,"YN",DEL$,INXCTL,1,0,EXITCODE
	if EXITCODE=1 or DEL$="N" ? tab(8,5);tab(-1,9) : goto F1

	? tab(-1,11);tab(8,72);"Sure? ";
	xcall INPUT,8,78,1,1,"YN",DEL$,INXCTL,1,0,EXITCODE
	if EXITCODE=1 or DEL$="N" ? tab(8,5);tab(-1,9) : goto F1

DELETE'MEMO:
	? tab(22,1);"Deleting ";MEMO$;"..."
	kill MEMO$
	for I = 1 to 2000 : next I
	? tab(22,1);tab(-1,9);
FORMAT:
	if LFMT$="" then LFMT$="4"
SIZE:
	SIZE$=(NUMREC*3)
	if LFMT$="2" and val(SIZE$)>65535 then &
		? tab(24,1);tab(-1,11); &
		"Maximum size with 2-byte link format is 65535"; : goto SIZE
CREATE:
	SIZE = int(val(SIZE$) / 8)+1
	? tab(22,1);"Allocating ";MEMO$;" (";SIZE;"blocks)..."
	allocate MEMO$,SIZE
	for I = 1 to 2000 : next I
	? tab(22,1);tab(-1,9);	
INIT:
	? tab(22,1);"Initializing ";MEMO$;
	open #MCH, MEMO$, random, 64, FILE98	
	RECCNT = SIZE * 8
	DOTCNT = int(RECCNT/40)
	for FILE98 = 2 to RECCNT
		DC=DC+1	
		if DC>=DOTCNT then DC=0 : ? ".";
		write #MCH, NBRACKS
	next FILE98

	FILE98 = 1
	MARKER2="]]]DEL"	
	if LFMT$="2" then &
		NXT'FRE2=2 : &
		NXT'DEL2=0 : &
		FILL2=NBRACKS : &
		write #MCH, CTL'REC2 &
	else &
		NXT'FRE4=2 : &
		BSWAP=NXT'FRE4 : &
		call BSWAP : &
		NXT'FRE4=BSWAP : &
		NXT'DEL4=0 : &
		FILL4=NBRACKS : &
		FLAG4="4" : &
		write #MCH, CTL'REC4
	close #MCH
	? tab(22,1);tab(-1,9);
	goto FILES'CREATED
TRAP:
	if ERR(0)=1 then goto END
	? tab(23,1);tab(-1,10);"----------------------------------------------------------------------------"
	? tab(24,1);
	if ERR(0)=12 then ? "INPUT.SBR not found"; : goto ENDIT
	if ERR(0)=16 or ERR(0)=32 then &
		? "File specification error"; : resume F1
	if ERR(0)=18 then ? "Device not ready"; : resume F1
	if ERR(0)=19 then &
		? "Cannot allocate - not enough room on device!"; : resume SIZE
	if ERR(0)=22 then ? "Illegal user code - PPN not found!"; : resume F1
	if ERR(0)=23 then ? "Protection violation!"; : resume F1
	if ERR(0)=24 then ? "Cannot write - disk write protected!"; : resume F1
	if ERR(0)=26 then ? "Device does not exist!"; : resume F1
	if ERR(0)=27 then ? "Bitmap kaput - see system operator!" : goto ENDIT
	if ERR(0)=28 then ? "Disk not mounted!"; : goto F1
	if ERR(0)=36 then ? "Improper version of INPUT.SBR" : goto ENDIT
	on error goto 
	END
EXIT'MAKE:
	? tab(-1,0);"Program end"
ENDIT:
	GOTO FILES'CREATED
	END
TIME'OUT:
	? tab(-1,0);"Program timed out."
	goto ENDIT
BSWAP:
	BX2 = BS1
	BS1 = BS2
	BS2 = BX2
	return
NOTIFIER:
XCALL JOBNAM,IT : IF IT[1,4]="%TSK" THEN CALL MULTI'RUNNING : RETURN
?TAB(-1,23);TAB(-1,11);
?TAB(2,1);"  ;;    ;;  ;;;;;;;  ;;;;;;;;  ;;;;;;;;  ;;;;;;;;  ;;;;;;;;  ;;;;;;;;  ;;;;;;;;";
?TAB(3,1);"  ;;;   ;;  ;;   ;;     ;;        ;;     ;;           ;;     ;;        ;;    ;;";
?TAB(4,1);"  ;;;;  ;;  ;;   ;;     ;;        ;;     ;;           ;;     ;;        ;;    ;;";
?TAB(5,1);"  ;; ;; ;;  ;;   ;;     ;;        ;;     ;;;;;;       ;;     ;;;;;;    ;;;;;;;;";
?TAB(6,1);"  ;;  ;;;;  ;;   ;;     ;;        ;;     ;;           ;;     ;;        ;;  ;;";
?TAB(7,1);"  ;;   ;;;  ;;   ;;     ;;        ;;     ;;           ;;     ;;        ;;   ;;";
?TAB(8,1);"  ;;    ;;  ;;;;;;;     ;;     ;;;;;;;;  ;;        ;;;;;;;;  ;;;;;;;;  ;;    ;;";
?TAB(-1,24);TAB(-1,12); : RETURN
MULTI'RUNNING:	! graphics mode in MULTI uses different alternate characters.
?TAB(-1,23);
?TAB(2,1);"  --    --  -------  --------  --------  --------  --------  --------  --------";
?TAB(3,1);"  ---   --  --   --     --        --     --           --     --        --    --";
?TAB(4,1);"  ----  --  --   --     --        --     --           --     --        --    --";
?TAB(5,1);"  -- -- --  --   --     --        --     ------       --     ------    --------";
?TAB(6,1);"  --  ----  --   --     --        --     --           --     --        --  --";
?TAB(7,1);"  --   ---  --   --     --        --     --           --     --        --   --";
?TAB(8,1);"  --    --  -------     --     --------  --        --------  --------  --    --";
?TAB(-1,24); : RETURN

 PRINTER:
	PRINT TAB(23,1);TAB(-1,9);TAB(-1,11);"Enter Printer Name: ";TAB(-1,11); &
		TAB(23,29);"Enter ";TAB(-1,12);"#"; &
		TAB(-1,11);" of Copies:";TAB(-1,11); &
 		TAB(23,53);"Delete after Printing? ";TAB(-1,12);
 OTHER'NAME:
	ENTRY=PRINTER
	XCALL INPUT,23,21,06,01,"A]W1;",ENTRY,INXCTL,1,1,EXITCODE
	IF EXITCODE=1 THEN GOTO DISPLAY'OPTIONS
	PRINTER=ENTRY
 OTHER'COPIES:
	ENTRY=COPIES
	XCALL INPUT,23,48,03,00,"#]W1;",ENTRY,INXCTL,1,1,EXITCODE
	IF EXITCODE=1 THEN GOTO OTHER'NAME
	COPIES=VAL(ENTRY)
 OTHER'DEL:
	XCALL INPUT,23,76,01,00,"YN]W1;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE=1 THEN GOTO OTHER'COPIES
	PR'DEL=ENTRY
	DEFLT=0
	RETURN
 CALENDAR:
	OPEN #66,CALFIL,OUTPUT : PRINT #66,USER : CLOSE #66
	OPEN #77,"APPCAL.CMD",OUTPUT
	?#77,":R"
	?#77,"CALEN"
	?#77,"RUN NOTIFY"
	CLOSE #77
	CHAIN "APPCAL.CMD"
 GET'USER:
	OPEN #66,CALFIL,INPUT : INPUT LINE #66,USER :CLOSE #66
	KILL CALFIL
	MENU'FLG=1
	GOTO GOT'USER
 OPTION1:
	PRINT TAB(24,1);"RET ";TAB(-1,11);"to Continue, "; &
		TAB(-1,12);"# ";TAB(-1,11);"to Display Full Detail, or "; &
		TAB(-1,12);"ESC ";TAB(-1,11);"to Exit: ";TAB(-1,12);TAB(-1,9);
	XCALL INPUT,24,60,01,00,"#1FI;",ENTRY,INXCTL,1,0,EXITCODE
	IF EXITCODE=1 AND PRT'FLG=1 THEN CLOSE #3 : PRT'FLG=0
	IF EXITCODE=1 THEN AUTO'CNT=0 : GOTO DISPLAY'OPTIONS
	IF VAL(ENTRY)=0 AND EXITCODE=0 THEN AUTO'CNT=0 : RETURN
 OPTION2:
	IF VAL(ENTRY)>AUTO'CNT OR VAL(ENTRY)<1 THEN GOTO OPTION1
	IF PRT'FLG=1 THEN CLOSE #3 : PRT'FLG=0
	AUTO'CNT=VAL(ENTRY)
	OP'FLG=1 : CHAR=2
	CALL DISP1
	FILE1=AUTO'APP(AUTO'CNT) : READ #1,APOINT
	CALL DISPLAY'APPOINTMENT
	OP'FLG=0
	GOTO ANYCNG