50197	'	Program Control Routines
50198	'	------------------------
50199	'	Revisied  06/07/82 Jcz
50224	'	Convert Date to Integer
	'	-----------------------

50225 TEMP$=DATE$
50226 YR=VAL(RIGHT$(DD$,2)): MO=VAL(LEFT$(DD$,2)): DA=VAL(MID$(DD$,4,2))
	TEMP%=INT(YR*365.25+.75)+MO(MO)+DA-18263
	IF (YR MOD 4)<>0 AND MO>2 THEN TEMP%=TEMP%-1
	RETURN
50249	'	Convert Integer to Date
	'	-----------------------

50250 T=TEMP%+18263: YR=INT(T/365.25): DA=INT(T-YR*365.25): MO=12
	IF (YR MOD 4)<>0 AND DA>58 THEN DA=DA+1
50260 IF DA<=MO(MO) THEN MO=MO-1: GOTO 50260 ELSE DA=DA-MO(MO)
50261 DA=DA+100:MO=MO+100
	TEMP$=RIGHT$(STR$(MO),2)+"/"+RIGHT$(STR$(DA),2)+"/"+RIGHT$(STR$(YR),2)
	RETURN

	'Keyboard Scanner for Exiting the Program

50300	keyboard$=inkey$
	if keyboard$=esc$ then 50310
	return

50310	xtemp=x:ytemp=y:ztemp=z:ztemp$=z$
	x=22:y=10:z=1:Z$="Do you want to Quit":gosub 51800
	if Yes then 19900
	x=xtemp:y=ytemp:z=ztemp:z$=ztemp$:return


50999	'	Input Routine
	'	-------------

51000 R$="" : RL%=0
51002 PRINT FNPC$(X,Y,Z,Z$);
51005	RB$=INKEY$
	IF RB$="" THEN 51005
	IF RB$=ESC$ THEN R$=ESC$:RETURN
	IF RB$=CHR$(8) AND RL%>0 THEN 51025
	IF RB$=CHR$(127) AND RL%>0 THEN 51025
	IF ASC(RB$)>95 THEN RB$=CHR$(ASC(RB$)-32)
	IF ASC(RB$)=3 THEN 51005
	IF RB$=CHR$(24) THEN 51030
	IF RB$=CHR$(13) THEN 51020
	IF RL%=>Z THEN PRINT BELL$;:GOTO 51005
	IF ASC(RB$)>31 AND ASC(RB$)<95 THEN 51016 ELSE PRINT BELL$;:GOTO 51005
51016 R$=R$+RB$ : RL%=LEN(R$)
	IF PRTCH%=0 THEN PRINT RB$;:GOTO 51005
	IF PRTCH%=1 THEN 51005
51020 RL$=LEFT$(R$,1) : PRINT :RETURN
51025	PRINT CHR$(8)+"_"+CHR$(8);:R$=LEFT$(R$,RL%-1):RL%=RL%-1:GOTO 51005
51030	PRINT STRING$(RL%,CHR$(8));STRING$(RL%,"_");STRING$(RL%,CHR$(8));
	GOTO 51000

51199	'	Query Number
	'	------------

51200 GOSUB 51000
	IF R$=E$ THEN RETURN
	IF R$=ESC$ THEN RETURN

	N!=0:DP=0:DG=0
51220 IF LEFT$(R$,1)=" " THEN R$=MID$(R$,2):GOTO 51220
	IF LEN(R$)=0 GOTO 51290
	FOR JJ%=1 TO RL%:CH=ASC(MID$(R$,JJ%,1))
	IF CH>47 AND CH<58 THEN DG=1:GOTO 51280
	IF CH=46 THEN DP=DP+1:IF DP>1 THEN 51298 ELSE 51280
	IF (CH<>45 AND CH<>43)OR JJ%<>1 THEN 51298
51280 NEXT JJ%:IF DG=0 THEN 51298
51290 N!=VAL(R$):IF(N!>=LB! AND  N!<=UB!) OR LB!=UB! THEN RETURN
	ERROR.CODE=2:PRINT:GOSUB 54000:GOTO 51200
51298 ERROR.CODE=1:PRINT:GOSUB 54000:GOTO 51200

51300 '		QUERY TIME
51301 '        ------------
51310 GOSUB 51000
	IF R$=ESC$ THEN RETURN
	IF LEN(R$)<6 OR LEN(R$)>8 GOTO 51450
	HOU=INSTR(R$,":"):IF HOU=2 THEN R$="0"+R$
	MIN=INSTR(4,R$,":")
	IF MIN=5 THEN RL$=LEFT$(R$,3):R$="0"+RIGHT$(R$,4):R$=RL$+R$
	HOU=VAL(LEFT$(R$,2)):MIN=VAL(MID$(R$,4,2)):SEC=VAL(RIGHT$(R$,2))
	IF(HOU=>0) AND (HOU<24) AND (MIN=>0) AND (MIN<61) THEN TIME$=R$ :RETURN
51350 ERROR.CODE=4:PRINT:GOSUB 54000:GOTO 51400
51399	'	Query Date
	'	----------

51400 GOSUB 51000
	IF R$=ESC$ THEN RETURN
	IF LEN(R$)<6 OR LEN(R$)>8 GOTO 51450
	MO=INSTR(R$,"/"):IF MO=2 THEN R$="0"+R$
	DA=INSTR(4,R$,"/")
	IF DA=5 THEN RL$=LEFT$(R$,3):R$="0"+RIGHT$(R$,4):R$=RL$+R$
	MO=VAL(LEFT$(R$,2)):DA=VAL(MID$(R$,4,2)):YR=VAL(RIGHT$(R$,2))
	IF(MO=>0) AND (MO<13) AND (DA=>0) AND (DA<32) THEN DATE$=R$ :RETURN
51450 ERROR.CODE=3:PRINT :GOSUB 54000:GOTO 51400

51499	'	Indicate Date Used
	'	------------------

51500 IF RL=0 THEN PRINT "USING DATE ";DATE$
	RETURN

51599	'	Query Dollar
	'	------------

51600 GOSUB 51000
	IF R$=ESC$ THEN RETURN

	DP=0:DG=0
51620 IF LEFT$(R$,1)=" " THEN R$=MID$(R$,2):GOTO 51620
51640 	JJ=INSTR(R$,",")
	IF JJ<>0 THEN R$=MID$(R$,1,JJ-1)+MID$(R$,JJ+1):GOTO 51640
	IF LEFT$(R$,1)="$" THEN R$=MID$(R$,2)
	IF LEN(R$)=0 THEN D#=0:RETURN
	FOR JJ=1 TO LEN(R$):CH=ASC(MID$(R$,JJ,1))
	IF CH>47 AND CH<58 THEN DG=1:GOTO 51700
	IF CH=46 THEN DP=DP+1:IF DP>1 THEN 51720 ELSE 51700
	IF(CH<>45) AND (CH<>43)OR JJ<>1 THEN 51720
51700 NEXT JJ:IF DG=0 THEN 51720
	D#=VAL(R$+"D"):RETURN
51720 ERROR.CODE=1:PRINT:GOSUB 54000:GOTO 51600

51799	'	Query Yes/No
	'	------------

51800 YES=0:GOSUB 51000:IF RL$="Y" OR RL$="y" THEN YES=-1:RETURN
	IF LEN(R$)=0 THEN 51800
	IF RL$<>"N" AND RL$<>"n" THEN ERROR.CODE=1:PRINT:GOSUB 54000:_
	GOTO 51800 ELSE RETURN

51899	'	Query Top of Page
	'	-----------------

51900 ERROR.CODE=14:GOSUB 54000
	GOSUB 51800:IF LEN(R$)=0 THEN 51900
	IF NOT YES THEN RETURN ELSE GOTO 51900

51999	'	Convert Upper To Lower Case
	'	---------------------------

52000	BG=1:LEG=LEN(R$)
52003	C=INSTR(BG,R$," "):B=BG+1
	IF C=0 THEN C=LEG+1 :B=BG+1
	FOR J=B TO C-1
	IF ASC(MID$(R$,J,1))<65 OR ASC(MID$(R$,J,1))>97 THEN 52008
	MID$(R$,J,1)=CHR$(ASC(MID$(R$,J,1))+32)
52008	NEXT
	IF LEG>BG THEN BG=C+1:GOTO 52003 ELSE RETURN


52899	'	Convert Time to Common Value
	'	----------------------------

52900 COM.TIME!=HOU*3600
	COM.TIME!=COM.TIME!+(MIN*60)
	COM.TIME!=COM.TIME!+SEC
	RETURN

52949	'	Convert Common Value to Time
	'	----------------------------

52950 HOU=0:MIN=0:SEC=0
	IF COM.TIME!>3600 THEN HOU=INT(COM.TIME!/3600):_
	COM.TIME!=COM.TIME!-(HOU*3600)
	IF COM.TIME!>60 THEN MIN=INT(COM.TIME!/60) :COM.TIME!=COM.TIME!-(MIN*60)
	SEC=COM.TIME!
	RETURN

52999	'	Set Page to Top Of Form
	'	-----------------------

53000	LPRINT STRING$(65-LC,10):LC=1
	RETURN

53300 	'    Time Routine For Business Programs
	'    Created 12/20/81 By J.C. Zingalis
	'
	'    Location          Function
	'   ----------       ------------
	'     0F7C6H           Seconds
	'     0F7C7H           Minutes
	'     0F7C8H           Hours
	'     0F7C9H           Year
	'     0F7CAH           Day
	'     0F7CBH           Month
	'
	'
	'
	'
	TIME.BASE=ROMADDR+&HC6:TIME.COUNT=1
	FOR TIME.LOOP =TIME.BASE TO TIME.BASE+6
	TIME(TIME.COUNT)=PEEK(TIME.LOOP)
	TIME.COUNT=TIME.COUNT+1
	NEXT

	SEC=TIME(1):MIN=TIME(2):HOU=TIME(3)
	MO=TIME(6):DA=TIME(5):YR=TIME(4)

53349	'	Put Time and Date String Together
	'	---------------------------------

53350	Q.TIME$=RIGHT$(STR$(HOU+100),2)+":"+RIGHT$(STR$(MIN+100),2)+":"+_
	RIGHT$(STR$(SEC+100),2)
	Q.DATE$=RIGHT$(STR$(MO+100),2)+"/"+RIGHT$(STR$(DA+100),2)+"/"+_
	RIGHT$(STR$(YR+100),2)
	RETURN

53400	'	set time in system
	'	------------------

53405 GOSUB 53440
53415 TIME.BASE=ROMADDR+&HC6:TIME.COUNT=1
53420 FOR TIME.LOOP =TIME.BASE TO TIME.BASE+6
53425  POKE(TIME.LOOP),TIME(TIME.COUNT)
53430 TIME.COUNT = TIME.COUNT + 1
53435 NEXT : RETURN
53440 TIME(1)=SEC:TIME(2)=MIN:TIME(3)=HOU
53445 TIME(6)=MO:TIME(5)=DA:TIME(4)=YR
53450 RETURN

	'Shell-Meztner Sorting Routine
	'N% = Number of Elements
	'DESC$() = Elements to short on
	'LIN.REF$() = Element Positions
53500
	M%=N%
53505	M%=M%\2
	IF M%=0 THEN RETURN
	J%=1 : K%=N%-M%
53510	I%=J%
53515	L%=I%+M%
	IF DESC$(I%) < DESC$(L%) THEN 53520
	SWAP DESC$(I%),DESC$(L%)
	SWAP LIN.REF$(I%),LIN.REF$(L%)
	I%=I%-M%
	IF I% < 1 THEN 53520
	GOTO 53515
53520	J%=J%+1
	IF J%>K% THEN 53505
	GOTO 53510


53999	'	Error Messages
	'	--------------

54000 PRINT FNPC$(X.ER,Y.ER,0,"");REV$;
54010 ON ERROR.CODE GOTO 54100,54150,54200,54210,54250,54300,54350,54400,_
			 54450,54500,54550,54600,54650,54700,54705

54100 PRINT"*** Invalid Entry.  Please Reenter  ***";BELL$;: GOTO 54940
54150 PRINT"*** Number is out of range. ***";BELL$;: GOTO 54940
54200 PRINT"*** Incorrect Date. Must be MM/DD/YY.  ***";BELL$;:GOTO 54940
54210 PRINT"*** Incorrect Time. Must be form HOU:MIM:SEC ***";BELL$;:GOTO 54940
54250 PRINT"*** Basic Error ";ERR;" in Line ";ERL;" ***";BELL$;:GOTO 54940
54300 PRINT"*** Isam System Error Code ";ER%;" ***";BELL$;:GOTO 54940
54350 PRINT"*** ";KEY$;" Record not found in Data Base ***";BELL$;: GOTO 54940
54400 PRINT"** Record ";KE$;" exsist already in Data Base **";BELL$;:GOTO 54940
54450 PRINT"*** Out of Record Block on Disk ***";BELL$;: GOTO 54940
54500 PRINT"*** Data File on Disk not found ***";BELL$;: GOTO 54940
54550 PRINT"*** Invalid Password.  Please Retry ***";BELL$;: GOTO 54940
54600 PRINT"*** Wrong Password.  Unable to Run ***";BELL$;: GOTO 54940
54650 PRINT"** Disk Error. Check System & goto Back-up **";BELL$;:GOTO 54940
54700 PRINT"*** Record Deleted From Data Base ***";BELL$;:GOTO 54940
54705 PRINT"*** Position Paper to top of page ***":RETURN
54940 FOR WT.LP!=1 TO 2500:NEXT:PRINT NOR$; FNPC$(X.ER,Y.ER,0,"");LI.ER$:RETURN