1	!	UPDATE V13	1977.08.26/RSL	UPDATE LEADS DATA BASES
2	!
	!			U P D A T E
	!
	! V13: 1977.08.26/RSL: GET HEADER INFORMATION FROM FILE.
	! V12: 1977.06.13/RSL: CHANGE FOR LOGICAL DIRECTORY NAMES
	!
3	!	GENERAL UPDATER FOR LEADS DATA BASES.  THIS PROGRAM IS
	!	THE CONTROL PROGRAM.  IT CHECKS VALIDITY OF INPUT DATA
	!	AND THEN INVOKES A MANAGER-SELECTED PROGRAM.
10	!
	!	REQUIRES LEADS FUNCTION PACKAGE 'FNA'.
	!
	!	DELETE: FNB%, FND1$, FNT1$, FNY%, FNZ%
	!
100	PRINT 'UPDATE V13  ' DATE$ (0%) '  ' TIME$ (0%)
9999	!
	!	BEGINNING FOR 'RUN' ENTRY
	!	CREATE TEMPORARY FILE (FNT9$), AND OPEN
	!	PER-DATA-BASE INFORMATION FILE.
	!
	!	FOR A DESCRIPTION OF THIS FILE, SEE THE
	!	DOCUMENTATION FOR THE 'UPDCVT' PROGRAM.
	!
10000	OPEN FNT9$ AS FILE 12% :
	OPEN '#UPDATE.VCA' FOR INPUT AS FILE 1% :
	IF T0% (0%, 1%) <> 5%
	THEN PRINT 'WRONG FORMAT OF UPDATE.VCA --' :
	     PRINT 'CONSULT DATA BASE MANAGER.' :
	     GO TO 13000
10999	!
	!	MAIN PROGRAM LOOP.  GET RECORD TYPE.
	!
11000	T0$ = FNI$ (0%, 'RECORD TYPE') :
	GO TO 13000 IF T0$ = '' :
	GO TO 13050 IF T0$ = '??'
11005	GO TO 11090 IF T0$ = '?' :
	GO TO 11100 IF T0$ = T0$ (T0%) FOR T0% = 1% TO T0% (0%, 0%) :
	PRINT 'THIS PROGRAM CURRENTLY DOES NOT UPDATE '; T0$;
			' RECORDS.' :
	GO TO 11000
11009	!
	!	BLANK INPUT IMPLIES PROGRAM TERMINATION.
	!	'?'   REQUESTS LIST OF RECORD TYPES.
	!	EVERYTHING ELSE MUST BE A RECORD TYPE.
	!
11085	!
	!	PRINT LIST OF RECORD TYPES.
	!
11090	PRINT 'TYPE JUST CARRIAGE RETURN TO LEAVE THIS PROGRAM.' :
	PRINT 'RECORD TYPES CURRENTLY DEFINED:' :
	PRINT T0$ (T0%) FOR T0% = 1% TO T0% (0%, 0%) :
	PRINT :
	GO TO 11000
11095	!
	!	SET UP FOR THIS RECORD TYPE -- OPEN 
	!	IDENTIFICATION FIELD, NAME FIELD, AND
	!	AN INTERNAL FIELD USED BY THIS PROGRAM.
	!
11100	H0% = FNO2% (0%, 'FLD FIELD NAME', 6%) :
	H1% = FNO2% (0%, 'FLD FIELD FORMAT', 4%) :
	H2% = FNO2% (0%, 'FLD FIELD LENGTH', 4%)
11110	F0% = FNO2% (0%, 'FIL FILE IDENTIFICATION', 4%) :
	F1% = FNO2% (0%, T1$ (T0%, 0%), 6%) : F7% = B8%(3%,F1%) :
	F2% = FNO2% (0%, T1$ (T0%, 1%), 4%)
11495	!
	!	REQUEST IDENTIFICATION OF RECORD.
	!	CHECK ISAM INDEX TO SEE IF IT ALREADY EXISTS.
	!	IF NOT, ASK THE USER IF A NEW ONE IS TO BE CREATED.
	!
11500	N0%=0% : I0$, C$ = FNI$ (1%, T0$+' IDENTIFICATION') :
	GO TO 11900 IF I0$ = '' :
	GO TO 11590 IF LEN (I0$) <> T0% (T0%, 2%) OR
		       FNK% (I0$, T3$ (T0%)) :
	GO TO 12100 IF I0$ = FNS1$ (F1%, I0$)
11510	IF FNI% (1%, 'IS THIS A NEW ' + T0$ + ' RECORD')
	THEN	GO TO 11500
	ELSE	F1$ = T2$ (T0%) :
		N0% = -1% : B9%(11%,F7%) = -B9%(11%,F7%) :
		GO TO 20100
11590	PRINT "BAD "; T0$; " IDENTIFICATION." :
	GO TO 11500
11895	!
	!	NO IDENTIFICATION INPUT -- TRY ANOTHER RECORD TYPE.
	!
11900	I0% = FNC2% (0%) :
	GO TO 11000
11995	!
	!	PRINT NAME FIELD FROM RECORD,
	!	GET NEXT FIELD TO INPUT IF NEW RECORD.
	!	INPUT FIELD NAME IF NOT NEW RECORD
	!
12000	IF N0% = 0% THEN GOTO 12100 ELSE
	IF N0% < 0% THEN N0%, F% = T0% (T0%, 1%)
		    ELSE N0%, F% = F0% (N0%, 3%)
12010	IF N0% = 0% THEN PRINT 'NEW ';T0$;' ENTRY COMPLETE ' :
	   B9%(11%,F7%) = ABS(B9%(11%,F7%)) : GOTO 12100
12020	PRINT : PRINT F0$ (N0%) : F$ = F0$ (N0%) :
	GOTO 12110
12100	N$ = CVT$$ (FNG$ (F2%), 4%+8%+16%+128%) :
	PRINT : PRINT 'RECORD OF : '; N$ :
	F$ = FNI$ (2%, 'FIELD NAME') :
	GO TO 11500 IF F$ = '' :
	GO TO 12900 IF F$ = '?' :
	GO TO 13060 IF F$ = '??'
12105	F% = T0% (T0%, 0%) :
	F% = F0% (F%, 2%) UNTIL F% = 0% OR F0$ (F%) = F$ :
	GO TO 12990 IF F% = 0%
12110	GOTO 20100   IF F0% (F%, 0%) > 10000% :
	C$ = FNI$ (2%, 'NEW CONTENTS') :
	GOTO 12200   IF C$ <> '' AND C$ <> '**' :
	GOTO 12180   IF C$ = '**' AND F0% (F%, 1%) = 0%
12115	IF C$ = '' THEN
	   IF N0% = 0% OR F0% (F%, 1%) <> 0% THEN GOTO 12000
					     ELSE GOTO 12190
12120	B% = -1% :
	GO TO 20100
12180	PRINT 'FIELD '; F$; ' CANNOT BE BLANKED.' :
	IF N0% = 0% THEN GO TO 12100 ELSE GO TO 12020
12190	PRINT 'ENTRY MUST BE MADE ' : GOTO 12020
12200	IF FNC% THEN GO TO 20100
	ELSE PRINT 'INVALID CONTENTS FOR FIELD '; F$ :
	IF N0% = 0% THEN GO TO 12100 ELSE GO TO 12020
12895	!
	!	PRINT LIST OF FIELDS AVAILABLE FOR THIS RECORD TYPE.
	!
12900	PRINT 'TYPE JUST CARRIAGE RETURN TO GET BACK TO ID QUESTION.' :
	PRINT 'FIELDS DEFINED FOR '; T0$; ' RECORDS: ' :
	F% = T0% (T0%, 0%) :
	GOSUB 12910 WHILE F% :
	PRINT :
	GO TO 12100
12910	PRINT F0$ (F%) :
	F% = F0% (F%, 2%) :
	RETURN
12985	!
	!	ERROR MESSAGE:
	!
12990	PRINT 'FIELD ';F$;' IS NOT DEFINED FOR ';T0$;' RECORDS.' :
	GO TO 12100
12999	!
	!	FINISHED USING UPDATE.  CLOSE ALL FILES, 
	!	DELETE TEMPORARY FILE, AND CHAIN TO "OPTION"
	!
13000	I8% = FNC2% (0%) :
	KILL FNT9$ :
	CHAIN 'LEADS:OPTION.BAC' 10410%
13045	!
	!	DEBUGGING STUFF.  CAN GO AWAY AT ANY TIME.
	!	INVOKED FROM 11000 AND 12100, RESPECTIVELY.
	!
13050	STOP : GO TO 11000
13060	STOP : GO TO 12100
18995	!
	!	FUNCTIONS TO BE USED:
	!
	!	FNI$ -- INPUT WITH PROMPT
	!	FNI% -- INPUT YES OR NO
	!	FNG$ -- GET AND DECODE A FIELD
	!	FNT9$ - TEMPORARY FILE NAME
	!
19000	DEF FNI$ (P%, P$) :
	PRINT IF P% < 2% :
	PRINT P$; :
	INPUT LINE P$ :
	FNI$ = CVT$$ (P$, 4%+8%+16%+128%) :
	FNEND
19010	DEF FNI% (P%, P$)
19020	P$ = FNI$ (P%, P$) :
	IF LEFT (P$, 1%) = 'Y' THEN FNI% =  0%
   ELSE IF LEFT (P$, 1%) = 'N' THEN FNI% = -1%
   ELSE P$ = 'PLEASE ANSWER "YES" OR "NO".' :
	GO TO 19020
19030	FNEND
19040	DEF FNG$ (F%) = FNK1$ (FNG2$ (F%), F%)
19050	DEF FNT9$ = 'UPDA' +
	MID (NUM$ (100%+ASCII(SYS(CHR$(6%)+CHR$(-3%)))/2%), 3%, 2%) + 
		    '.TMP'
19060	DEF FNF% (F$) :
	FNF% = -1% :
	GO TO 19070 IF F$ <> FNS1$ (H0%, F$) :
	FNF% = (INSTR (1%, 
    "$SP    $BYTE  $INTEGR$FLOAT $TIME  $POINTR$FLAG  $DATE  ",
		FNG$ (H1%)) + 6%) / 7%
19070	FNEND
19080	DEF FNK% (C$, Q$) :
	FNK% = -1% :
	GO TO 19090 IF INSTR (1%, Q$, MID (C$, I8%, 1%)) = 0%
		FOR I8% = 1% TO LEN (C$) :
	FNK% = 0%
19090	FNEND
19099	!	
	!		F N C %
	!	
	!	THIS ROUTINE CHECKS FOR LEGALITY OF INPUT VALUES,
	!	AND CONVERTS THEM TO INTERNAL FORMAT FOR THE
	!	UPDATE ROUTINES.
	!
19100	DEF FNC% :
	FNC% = 0% :
	GO TO 19900 IF F0% (F%, 0%) >= 1000% OR F0% (F%, 0%) < 0% :
	GO TO 19200 IF F0% (F%, 0%) = 0% :
	GO TO 19150 IF F0% (F%, 0%) = 1% 
19102	GO TO 19990 IF LEN(C$) > F0% (F%, 0%) :
	C% = -1% : C$ = LEFT (C$+SPACE$(F0%(F%,0%)), F0%(F%,0%))
19105	!
	!	CHECK TO SEE IF THIS STRING IS ONE OF THOSE WHICH IS
	!	PERMITTED.  IT MUST BE IN THE CORRECT POSITION
	!	WITHIN THE SEARCH STRING.
	!
19110	C% = INSTR (C%+2%, F2$ (F%), C$) - 1% :
	GO TO 19990 IF C% < 0% :
	GO TO 19110 IF C% <> C%/F0%(F%,0%) * F0%(F%,0%) :
	GO TO 19200
19145	!
	!	EACH CHARACTER MUST BE SOMEWHERE IN THE SEARCH STRING.
	!
19150	GO TO 19990 IF FNK% (C$, F2$ (F%))
19185	!
	!	GET TYPE OF FIELD FROM FLDDEF.SDB
	!
19200	ON FNF% (F$) + 2% GO TO 19900,
		19800,	19800,	19220,	19230,	19240,
		19250,	19990,	19270,	19280
!		(ANY)	$SP	$BYTE	$INTEGR	$FLOAT
!		$TIME	$POINTR	$FLAG	$DATE
19215	!
	!	$BYTE:  0<= VALUE <= 255
	!
19220	GOSUB 19300 : GO TO 19990 IF E0% :
	GO TO 19990 IF V < 0. OR V > 255. :
	C0$ = CHR$ (V) :
	GO TO 19900
19225	!
	!	$INTEGR:  -32767 <= VALUE <= 32767
	!
19230	GOSUB 19300 : GO TO 19990 IF E0% :
	GO TO 19900 IF V < -32767. OR V > 32767. :
	C0$ = CVT%$ (V) :
	GO TO 19900
19235	!
	!	$FLOAT
	!
19240	GOSUB 19300 : GO TO 19990 IF E0% :
	C0$ = CVTF$ (V) :
	GO TO 19900
19245	!
	!	$TIME:   0<= HOURS <= 23,  0<=MINUTES<=59
	!
19250	C% = INSTR (1%, C$, ":") :
	GO TO 19900 UNLESS C% :
	H% = VAL (LEFT (C$, C%-1%)) :
	H% = 0% IF H% = 12% :
	C0$ = RIGHT (C$, LEN(C$)-1%) :
	IF C0$ = 'PM' THEN H% = H% + 12%
   ELSE IF C0$ <> 'AM' THEN C$ = C$ + '  '
19255	M% = VAL (MID (C$, C%+1%, LEN (C$)-C%-2%)) :
	GO TO 19990 UNLESS H% >= 0% AND H% <= 23% AND
			   M% >= 0% AND M% <= 59% :
	C0$ = FNT2$ (C$) :
	GO TO 19900
19265	!
	!	$FLAG:  VALUE = TRUE  OR VALUE = FALSE
	!
19270	GO TO 19990 UNLESS C$ = 'TRUE' OR C$ = 'FALSE' :
	C0$ = CHR$ (C$ > 'OOPS') :
	GO TO 19900
19275	!
	!	$DATE:  MUST BE LEGAL, BETWEEN 1901 AND 2099
	!
19280	C% = INSTR (1%, C$, '-') :
	C0% = INSTR (C%+1%, C$, '-') :
	GOTO 19990   IF C% = 0% OR C0% = 0%
19282	D% = VAL (LEFT (C$, C%-1%)) :
	GO TO 19990 IF D% <= 0% :
	Y% = VAL (RIGHT (C$, C0%+1%)) :
	Y% = Y%+1900% IF Y% < 100% :
	GO TO 19990 IF Y% < 1901% OR Y% > 2099%
19284	C0$ = MID (C$, C%+1%, C0%-C%-1%) : C0$ = LEFT (C0$, 3%) :
	C% = INSTR (1%, 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',
			C0$) + 2% :
	GO TO 19990 IF C%/3% * 3% <> C% :
	C% = C% / 3%
19285	!	
	!	CHECK THAT DATE IS IN BOUNDS.
	!	
19286	ON C% GO TO
		19291,	19288,	19291,	19290,	19291,	19290,
		19291,	19291,	19290,	19291,	19290,	19291
!		 JAN	 FEB	 MAR	 APR	 MAY	 JUN
!		 JUL	 AUG	 SEP	 OCT	 NOV	 DEC
19288	GO TO 19990 IF D% > 29% :
	GO TO 19990 IF D% = 29% AND Y%/4% * 4% <> Y% :
	GO TO 19295
19290	GO TO 19990 IF D% > 30% :
	GO TO 19295
19291	GO TO 19990 IF D% > 31% :
	GO TO 19295
19295	C0$ = FND2$ (C$) :
	GO TO 19900
19300	E0% = 0% :
	V = VAL (C$) :
	RETURN
19310	E0% = -1% :
	RETURN
19800	C0$ = C$ :
	IF LEN (C$) > CVT$% (FNG$ (H2%))
	THEN	PRINT "CONTENTS TOO LONG FOR FIELD." :
		GO TO 19990
19900	FNC% = -1%
19990	FNEND
19995	!
	!	RE-ENTRY POINT FROM CHAINED-TO PROGRAM.
	!	DO EVERYTHING THE FUNCTIONS MIGHT DO FOR
	!	US, AND THEN COPY SAVED INFORMATION BACK
	!	FROM TEMPORARY FILE.
	!
20000	ON ERROR GO TO 29000 : I0% = FNU1%  :
	OPEN FNT9$ FOR INPUT AS FILE 12% :
	OPEN '#UPDATE.VCA' FOR INPUT AS FILE 1% :
	MAT B9% = B7% :
	B8% (I0%, J0%) = B6% (I0%, J0%) FOR J0% = 0% TO B6% (0%, 0%)
					FOR I0% = 0% TO 7%
20010	C8% (I0%, J0%) = C6% (I0%, J0%) FOR J0% = 1% TO ABS(B9%(11%,I0%))
	FOR I0% = 2% TO 12% :
	C8$ (I0%, J0%) = CVT$$ (C6$ (I0%, J0%), 128%)
					FOR J0% = 1% TO ABS(B9%(11%,I0%))
					FOR I0% = 2% TO 12%
20012	F0% = C6% (0%, 20%) : N0% = C6% (0%, 1%) : F1% = C6% (0%, 5%) :
	F7% = B8%(3%,F1%) : T0% = C6% (0%, 19%) : F2% = C6% (0%, 4%) :
	C8% = C6% (0%, 15%) : C9% = C6% (0%, 14%)
20015	H0% = C6% (0%, 18%) :
	H1% = C6% (0%, 17%) :
	H2% = C6% (0%, 16%)
20020	T0$ = T0$ (T0%) : P0$ = C6$ (0%, 4%) :
	GOSUB 20080 IF B9% (9%, I0%) FOR I0% = 2% TO 12% :
	GOTO 11500  IF CVT$%(P0$) = 0% AND ASCII(RIGHT(P0$,3%)) = 0% :
	I0% = FNG1% (-F1%, CVT$% (P0$), ASCII (RIGHT (P0$, 3%))) :
	GO TO 12000
20080	OPEN B7$ (I0%) FOR INPUT AS FILE I0%, MODE 5% :
	GET #I0%, RECORD 1% :
	UNLOCK #I0% :
	FIELD #I0%, 2% AS I8$, 2% AS I9$ :
	B9%(1%,I0%) = CVT$%(I8$) : B9%(2%,I%) = CVT$%(I9$) :
	GET #I0%, RECORD B9% (4%, I0%) IF B9% (9%, I0%) :
	UNLOCK #I0% UNLESS B9% (12%, I0%) :
	RETURN
20095	!
	!	EXIT FROM THIS ROUTINE INTO A SUBROUTINE.
	!
20100	MAT B7% = B9% :
	B6% (I0%, J0%) = B8% (I0%, J0%) FOR J0% = 0% TO B8% (0%, 0%)
					FOR I0% = 0% TO 7% :
	C6% (I0%, J0%) = C8% (I0%, J0%) FOR J0% = 1% TO ABS(B9%(11%,I0%))
					FOR I0% = 2% TO 12% :
	GOSUB 20190 FOR I0% = 2% TO 12%
20110	C6% (0%, 0%) = 20000% : C6$ (0%, 0%) = 'LEADS:UPDATE.BAC' :
	C6% (0%, 1%) = N0% : C6% (0%, 2%) = B% :
	C6% (0%, 3%) = F0% (F%, 0%) : C6% (0%, 4%) = F2% :
	C6% (0%, 5%) = F1% : C6% (0%, 19%) = T0% : C6% (0%, 20%) = F0%
20115	C6% (0%, 18%) = H0% :
	C6% (0%, 17%) = H1% :
	C6% (0%, 16%) = H2% :
	C6% (0%, 15%) = C8% : C6% (0%, 14%) = C9%
20120	IF N0% >= 0%
	THEN	C6$ (0%, 1%) = F0$ (F%) :
		C6$ (0%, 4%) = FNP$ (-F2%) + ' ' :
		F1$ = F1$ (F%) :
		C0$ (0%) = F2$ (F%) :
		C0$ (1%) = C0$ + ' ' UNLESS B%
20130	C0$ (2%) = C$ :
	I8% = FNC2% (0%) :
	CLOSE 1%, 12% :
	CHAIN F1$ 1000%
20190	RETURN UNLESS B9% (9%, I0%) > 0% :
	J0% = FNG1% (-F0%, 0%, B9% (9%, I0%)) :
	B7$ (I0%) = FNG$ (F0%) + '#' :
	C6$ (I0%, J0%) = C8$ (I0%, J0%)  + ' '
	FOR J0% = 1% TO ABS(B9%(11%,I0%)) :
	RETURN
27000	DIM #12%, B6% (7%, 50%), B7% (12%, 12%), C6% (12%, 20%),
		  C6$ (12%, 20%)=46%, C0$ (3%) = 512%, B7$ (12%) = 18%
28000	DIM #1%, T0% (15%, 3%), T0$ (15%) = 16%, T1$ (15%, 1%) = 36%,
		 T2$ (15%) = 19%, T3$ (15%) = 128%,
		 F0% (255%, 3%), F0$ (255%) = 36%, F1$ (255%) = 19%,
		 F2$ (255%) = 256%
29100	IF ERL = 19300% THEN RESUME 19310 ELSE
	IF ERL >= 19100% AND ERL <= 19999% THEN RESUME 19990
29960	E8% = 0% :
	IF E8$ = 'RSTS'
	THEN RESUME 11000
	ELSE GO  TO 11000
32767	I0% = FNC2% (0%) : END