1000	REM Utility to read the user list from DP and generate the accounts.
1010	REM Note that for subsequent years, we will need to check for adds
1020	REM and deletes before globally slurping the file
1030	REM V1.00 - tmk - 03/02/89 - Original version
1040	REM V1.01 - tmk - 06/14/90 - DP has added a new year of "M" (arrggghh!)
1041	REM V1.02 - tmk - 09/12/90 - They're untrainable - 19SP _and_ 199E!!!
1042	REM V1.03 - tmk - 03/22/91 - One more time - 19C0!
1043	REM V1.04 - tmk - 08/06/92 - Only emit MODIFY's if purging
1044	REM V1.05 - tmk - 05/07/93 - Default directory protection changed
1045	REM V1.06 - tmk - 06/23/93 - Grant FAX_USER to faculty and admin
1046	REM V1.07 - tmk - 05/03/95 - Add alumni support
1047	REM V1.07 - tmk - 03/19/97 - "19xx" are now "  xx" (half-assed Y2K)
1048	REM V1.08 - tmk - 09/08/98 - Store 4-digit years in adds.index
1049	REM V1.09 - tmk - 07/07/00 - Modify for new disk layout on Alpha system
1050	REM V1.10 - tmk - 08/14/00 - Add "/nodisuser" to UAF flags
1051	REM
1060	REM Initial attempts for usernames are:
1070	REM Student: Year of grad+lastname+"_"+firstinitial
1080	REM Faculty: Lastname+"_"+firstinitial
1090	REM Lastname is truncated to 10 if longer
1100	REM Subsequent attempts will add middle initial if present,
1110	REM then will add more of first name
1120	REM
1130	REM Ask about input filename, starting member numbers
1140	input "Enter name of ACCOUNTS file";data_file$
1150	fac_uic$="1000"
1160	std_uic$="2000"
1170	adm_uic$="3000"
1180	cha_uic$="4000"
1181	alu_uic$="5000"
1190	declare long fac_mem%, std_mem%, adm_mem%, cha_mem%
1191	input "Enter 1 if you want to update expirations, else 0";purging%
1200	input "Enter first member number for Faculty UIC group";fac_mem%
1210	input "Enter first member number for Student UIC group";std_mem%
1220	input "Enter first member number for Administrator UIC group";adm_mem%
1230	input "Enter first member number for Challenge UIC group";cha_mem%
1231	input "Enter first member number for Alumni UIC group";alu_mem%
1240	REM
1250	REM System linkages
1260	external long function sys$fao(string,optional word,string,long by value)
1270	fac_mem$=string$(6%,32%)
1280	std_mem$=string$(6%,32%)
1290	adm_mem$=string$(6%,32%)
1300	cha_mem$=string$(6%,32%)
1301	alu_mem$=string$(6%,32%)
1310	REM
1320	REM Open files
1330	open data_file$ for input as file #1%, &
	recordtype any
1340	open "ADD_TO_UAF.COM" for output as file #2%, &
	organization sequential variable
1350	open "ADD_TO_QUOTA.COM" for output as file #3%, &
	organization sequential variable
1360	open "CREATE_DIRECTORY.COM" for output as file #4%, &
	organization sequential variable
1370	map (indexfile) string uname$=12%, ussn$=9%, adate$=11%, fill$=48%
1380	open "ADDS.INDEX" as file #5%, &
	organization indexed, &
	recordsize 80%, &
	map indexfile, &
	primary key uname$, &
	alternate key ussn$
1390	open "EXCEPTION.LOG" for output as file #6%
1400	REM
1410	REM Write headers and stuff to the files
1420	print #2%,"$ ! ADD_TO_UAF.COM created on ";date$(0%);" at ";time$(0%);"."
1430	print #2%,"$ DEFINE SYSUAF SYS$SYSTEM:SYSUAF.DAT"
1440	print #2%,"$ MCR AUTHORIZE"
1450	print #3%,"$ ! ADD_TO_QUOTA.COM created on ";date$(0%);" at ";time$(0%);"."
1460	print #3%,"$ MCR DISKQUOTA"
1470	print #3%,"USE USER1:"
1480	print #4%,"$ ! CREATE_DIRECTORY.COM created on ";date$(0%);" at ";time$(0%);"."
1490	print #6%,"  ** Exception log for names requiring manual cleanup **"
1500	print #6%," "
1510	REM
1520	REM Process an input record
1530	on error goto 3140
1540	input line #1%,raw_record$
1550	on error goto 0
1552	code$=left(raw_record$,1%)		! F(aculty) or S(tudent)
1554	if code$="2" then goto 1570		! If expanded format
1555	if code$="S" then goto 1562
1556	if code$="F" then goto 1562
1557	if code$="A" then goto 1562
1558	if code$="C" then goto 1562
1559	print "Invalid record, skipped: ";raw_record$
1560	goto 1530
1562	last_name$=mid(raw_record$,2%,15%)	! Last name
1563	first_name$=mid(raw_record$,17%,8%)	! First name
1564	middle_name$=mid(raw_record$,25%,1%)	! Middle initial
1565	ssn$=mid(raw_record$,26%,9%)		! Social Security Number
1566	class$=mid(raw_record$,35%,4%)		! Expected year of graduation
1567	goto 1620
1570	last_name$=mid(raw_record$,2%,20%)	! Last name
1572	first_name$=mid(raw_record$,22%,16%)	! First name
1574	middle_name$=mid(raw_record$,38%,1%)	! Middle initial
1576	ssn$=mid(raw_record$,39%,9%)		! Social Security Number
1578	class$=mid(raw_record$,48%,4%)		! Expected year of graduation
1620	REM
1630	REM Now fix up the data - aren't names wonderful?
1640	REM First strip off things like JR, SJ, MD, FMS
1650	restore
1660	last_name$=fnfix$(last_name$)
1670	real_last_name$=last_name$
1680	read ending$, fixup$
1690	goto 1760 if ending$="**"
1700	ending%=len(ending$)
1710	goto 1680 if mid(last_name$,len(last_name$)-ending%+1%,ending%)<>ending$
1720	last_name$=left(last_name$,len(last_name$)-ending%)
1730	real_last_name$=last_name$+fixup$
1740	REM Now check for things needing manual checking, but defer output
1750	REM until we know if it's a new user (keeps the insanity down)
1760	restore
1770	logwarn%=0%
1780	read ending$,fixup$
1790	goto 1780 unless ending$="**"
1800	read ending$,fixup$
1810	goto 1860 if ending$="--"
1820	ending%=len(ending$)
1830	goto 1850 if left(last_name$,ending%)=ending$
1840	goto 1800
1850	logwarn%=1%
1860	first_name$=fnfix$(first_name$)
1870	middle_name$=fnfix$(middle_name$)
1880	class$="0000" if mid(class$,4%,1%)=" "
1890	class$="0000" if mid(class$,4%,1%)="O"
1898	REM See if DP bogused the year in a new and exciting manner
1899	class$="19"+mid(class$,3%,2%) if left(class$,2%)="  "
1900	class$=left(class$,2%)+"9"+mid(class$,4%,1%) if mid(class$,3%,1%)="N"
1902	class$=left(class$,2%)+"9"+mid(class$,4%,1%) if mid(class$,3%,1%)="C"
1910	class$=left(class$,2%)+"00" if mid(class$,4%,1%)="M"
1911	class$=left(class$,2%)+"00" if mid(class$,3%,2%)="SP"
1912	class$=left(class$,3%)+"0" if mid(class$,4%,1%)="E"
1913	class$=left(class$,3%)+"0" if mid(class$,4%,1%)="-"
1920	for dp%=1% to 4%
1930	if instr(1%,"0123456789",mid(class$,dp%,1%)) <> 0% goto 1960
1940	print "Data Processing has added a bogus year code (";class$;") again!"
1950	input dp$
1960	next dp%
1970	REM
1980	REM Build real-world name string
1990	user_name$=first_name$
2000	goto 2020 if middle_name$=""
2010	user_name$=user_name$+" "+middle_name$+"."
2020	user_name$=user_name$+" "+real_last_name$
2030	REM
2040	REM Build username string
2050	attempt%=1%
2060	uaf_name$=""
2070	uaf_name$=mid(class$,4%,1%) if code$="S"
2080	uaf_name$=uaf_name$+last_name$
2090	uaf_name$=left(uaf_name$,10%) if len(uaf_name$)>10%
2100	uaf_name$=uaf_name$+"_"+left(first_name$,1%)
2110	uaf_name$=edit$(uaf_name$,32%)
2120	print "Now processing: ";user_name$
2130	print " Trying ";uaf_name$
2140	test_name$=uaf_name$+string$(12%-len(uaf_name$),32%)
2150	REM See if we have such a user already
2160	on error goto 3110
2170	goto 2240 if code$="C"
2180	find #5%, key #1% eq ssn$
2190	on error goto 0
2200	print " Already in UAF";
2202	if purging%=1% then print ", updating expiration date..." else print ""
2210	get #5%, key #1% eq ssn$
2220	uaf_name$=uname$
2230	goto 2860
2240	on error goto 3080
2250	find #5%, key #0% eq test_name$
2260	on error goto 0
2270	REM If we are here, we have a duplicate username
2280	print " Duplicate, retrying..."
2290	goto 2320 if len(uaf_name$)<12%
2300	uaf_break%=instr(1%,uaf_name$,"_")
2310	uaf_name$=left(uaf_name$,uaf_break%-2%)+mid(uaf_name$,uaf_break%, &
	len(uaf_name$))
2320	goto 2350 if middle_name$=""
2330	uaf_name$=uaf_name$+middle_name$
2340	goto 2130
2350	uaf_name$=edit$(uaf_name$+mid(first_name$,attempt%+1%,1%),32%)
2360	attempt%=attempt%+1
2370	goto 2130
2380	REM We have a unique name, register it in the file
2390	on error goto 0
2400	uname$=test_name$
2410	ussn$=ssn$
2420	a$=date$(0%)
2425	adate$=left(a$,7%)+"19"+right(a$,8%)
2430	put #5%
2440	REM
2450	REM Add record to UAF
2460	print " New user, adding to UAF..."
2470	goto 2490 if logwarn%=0
2480	print #6%,uaf_name$," - ";user_name$
2490	print #2%,'ADD ';uaf_name$;
2500	if code$="S" then print #2%,'/ACCOUNT=STUDENT/DIRECTORY=[STUDENT.';
2510	if code$="F" then print #2%,'/ACCOUNT=FACULTY/DIRECTORY=[FACULTY.';
2520	if code$="A" then print #2%,'/ACCOUNT=ADMIN/DIRECTORY=[ADMIN.';
2530	if code$="C" then print #2%,'/ACCOUNT=GRANTS/DIRECTORY=[GRANTS.CHALLENGE.';
2531	if code$="2" then print #2%,'/ACCOUNT=ALUM/DIRECTORY=[ALUM.';
2540	print #2%,uaf_name$;"] -"
2550	print #2%,'/PASS=';ssn$;'/OWNER="';user_name$;
2560	if code$="C" then print #2%,' - Chal.';
2570	print #2%,'" -'
2580	print #2%,"/FLAG=(DEFCLI,DISCTLY,NODISUSER)/DEVICE=USER1:/UIC=[";
2590	dummy=sys$fao("!OW",,std_mem$,std_mem%)
2600	dummy=sys$fao("!OW",,fac_mem$,fac_mem%)
2610	dummy=sys$fao("!OW",,adm_mem$,adm_mem%)
2620	dummy=sys$fao("!OW",,cha_mem$,cha_mem%)
2621	dummy=sys$fao("!OW",,alu_mem$,alu_mem%)
2630	if code$="S" then print #2%,std_uic$;",";std_mem$;"]"
2640	if code$="S" then std_mem%=std_mem%+1%
2650	if code$="F" then print #2%,fac_uic$;",";fac_mem$;"]"
2660	if code$="F" then fac_mem%=fac_mem%+1%
2661	if code$="F" then print #2%,"GRANT/ID FAX_USER ";uaf_name$
2670	if code$="A" then print #2%,adm_uic$;",";adm_mem$;"]"
2680    if code$="A" then adm_mem%=adm_mem%+1%
2681	if code$="A" then print #2%,"GRANT/ID FAX_USER ";uaf_name$
2690	if code$="C" then print #2%,cha_uic$;",";cha_mem$;"]"
2700	if code$="C" then cha_mem%=cha_mem%+1%
2702	if code$="C" then print #2%,"GRANT/ID ACTIVE ";uaf_name$
2703	if code$="2" then print #2%,alu_uic$;",";alu_mem$;"]"
2704	if code$="2" then alu_mem%=alu_mem%+1%
2705	if code$="2" then print #2%,"GRANT/ID NOINTERNET ";uaf_name$
2706	if code$="2" then print #2%,"GRANT/ID ACTIVE ";uaf_name$
2710	REM print #2%,"GRANT/ID NOTES_USER ";uaf_name$
2720	REM
2730	REM Now write the quota entry
2740	if code$="S" then print #3%,"ADD ";uaf_name$;"/PERM=50000/OVER=0"
2750	if code$="F" then print #3%,"ADD ";uaf_name$;"/PERM=50000/OVER=0"
2760	if code$="A" then print #3%,"ADD ";uaf_name$;"/PERM=50000/OVER=0"
2770	if code$="C" then print #3%,"ADD ";uaf_name$;"/PERM=50000/OVER=0"
2771	if code$="2" then print #3%,"ADD ";uaf_name$;"/PERM=50000/OVER=0"
2780	REM
2790	REM Now write the directory entry
2800	if code$="S" then print #4%,"$ CRE/DIR USER1:[STUDENT.";uaf_name$;"]";
2810	if code$="F" then print #4%,"$ CRE/DIR USER1:[FACULTY.";uaf_name$;"]";
2820	if code$="A" then print #4%,"$ CRE/DIR USER1:[ADMIN.";uaf_name$;"]";
2830	if code$="C" then print #4%,"$ CRE/DIR USER1:[GRANTS.CHALLENGE.";uaf_name$;"]";
2831	if code$="2" then print #4%,"$ CRE/DIR USER1:[ALUM.";uaf_name$;"]";
2840	print #4%,"/OWN=";uaf_name$;"/PROT=(S:RWE,O:RWE,G:E,W:E)"
2850	goto 1530
2860	REM
2870	REM Update expiration for our user
2875	if purging%<>1% then goto 1530
2880	print #2%,"MODIFY ";uaf_name$;"/FLAGS=(NODISUSER,NODISMAIL)/NOEXPIRE"
2890	goto 1530
2900	REM
2910	REM Fixups for endings of last names (thanks, DP...)
2920	data "sj",", SJ"
2930	data "jr",", Jr."
2940	data "md",""
2950	data "fms",", FMS"
2960	data "iii",", III"
2970	data "ii",", II"
2980	data "**",""
2990	data "Mac",""
3000	data "Mc",""
3010	data "O",""
3020	data "Van",""
3030	data "St",""
3040	data "Ap",""
3050	REM Who am I kidding?
3060	data "Di",""
3070	data "--",""
3080	REM
3090	REM Error handler for duplicate username
3100	resume 2380
3110	REM
3120	REM Error handler for duplicate ssn
3130	resume 2240
3140	REM
3150	REM Error handler for end of input
3160	close #1%
3170	close #2%
3180	close #3%
3190	close #4%
3200	close #5%
3210	close #6%
3220	resume 3350
3230	REM
3240	REM Function to fix up fields
3250	DEF* fnfix$(value$)
3260	value$=edit$(value$,1%+2%+32%)		! First, eat spaces and upcase
3270	temp$=left(value$,1%)
3280	for i%=2% to len(value$)
3290	goto 3320 if ascii(mid(value$,i%,1%)) < 65%
3300	goto 3320 if ascii(mid(value$,i%,1%)) > 90%
3310	temp$=temp$+chr$(ascii(mid(value$,i%,1%))+32%)
3320	next i%
3330	fnfix$=temp$
3340	fnend
3350	end