C
C	This is the main routine for the make account section of
C	code.  This will read in the data file and parse it and 
C	create the com files.
C

	Subroutine Make

	Parameter	(screen=1,semIn=2,semOut=3,extension=7)

	Integer*2	ptrInStack
	Character*12	Type
	Character*12	Class
	Character*30	NameStorage(1000)
	Character*30	Name
	Character*30	pwd
	Integer*2	group
	Integer*2	ProfUic(2)
	Logical*1	CheckProf
	Character*12	disk
	Integer*2	loginQ
	Integer*2	logoutQ
	Integer*2	rate
	Integer*2	NumOfAcc
	Real*4		money
	Integer*4	Uic(1000)
	Integer*4	UicHolder
	Integer*2	intermed(2)
	Integer*2	Last_UIC
	Character*12	Username(1000)
	Character*35	Dir(1000)
	Character*68	Idents(50)
	Integer*2	NumOfIds
	Character*7	ext
	Logical*1	In_Progress
	Integer*2	length
	Integer*2	length2
	Character*1	answer
	Integer*2	Find_error

	equivalence (UicHolder,intermed)

C	Check to see if a MAKALL is in Progress
	inquire (file='MAKACT_WORK:MAKE_IN_PROGRESS.TEMP',
     +	exist=In_Progress)
	if (In_Progress) then
		write (screen,1)
1		format (1x,'%%%%% MAKALL Currently in the',
     +		' Batch Queue.',/,1x,'%%%%% MAKE NOT permitted')
		goto 12000
	end if

C	Intialize the program
	ptrInStack=0
	Open(unit=extension,
     +	file='MAKACT_FILES:directory.sav',status='old',
     +	carriagecontrol='list',err=10100)
	read (extension,fmt='(1A7)') ext
	close (extension)

C	Open up the different COM files for the creation of accounts
	call OpenFiles

5	write (screen,10)
10	format (1x,'Type of Account      > ',$)
	read (screen,15,err=10200) length,Type
15	format (Q,A)
	if (length .eq. 0) goto 5

17	write (screen,20)
20	format (1x,'Sub-Type of Account  > ',$)
	read (screen,15,err=5) length2,Class
	if (length2 .eq. 0) goto 17

23	write (screen,25)
25	format (1x,'Money per Account    > ',$)
	read (screen,*,err=23,end=17) money
	if (money .le. 0) goto 10200

	call str$upcase(type,type)
	call str$upcase(class,class)

	if ((type .eq. 'THSS ').OR.(type .eq. 'PROF ')) then
		if (index(class,'_') .eq. 0) then
			class(length2+1:length2+1 )='_'
			length2=length2+1
		end if
	end if

	NumOfAcc=0

	Find_error=0
	call OpenSemBud(Type,Class,group,disk,loginQ,logoutQ,
     +			rate,Find_error)
	if (Find_error .eq. -1) goto 5

C	For the Class Accounts Check for the Correct Prof Account
	if (index(type,'CLASS') .eq. 1) then
		if (.NOT. CheckProf(Class,ProfUic,group)) goto 50
	end if

C	Get the Identifiers to Customize the Accounts
	call Customize(Type,Idents,NumOfIds)

C	Create the upper directories
	call WriteDir(disk,Type,length,Class,length2)

C	Reset the Last uic member number to 1
	Last_UIC=1

C	Start the loop to get all the names for the one class
30	write (screen,35)
35	format (1x,'Name  > ',$)
	read (screen,15,err=50) length,NameStorage(NumOfAcc+1)
	Name=NameStorage(NumOfAcc+1)
	pwd='                              '
	if ((length .eq. 0).OR.(Name(1:1) .eq. ' '))  then
		write (screen,36)
36		format (1x,'Did you intend to input a Null string > ',$)
		read (screen,15) length,answer
		call str$upcase (answer,answer)
		if ((length .eq. 0).OR.(answer(1:1) .ne. 'Y')) goto 30
39		write (screen,40)
40		format (1x,'Enter a Password for this Account     > ',$)
		read (screen,15) length,pwd
		if (length .eq. 0) goto 39
	end if

	call Str$Upcase(Name,Name)

	if ((Name .eq. '-LIST').OR.(Name .eq. '- LIST')) then
		if (NumOfAcc .gt. 0) then
			write (screen,42)
42			format (/,1x,'Name',27x,'Username',5x,'Directory',
     +				/,1x,'----',27x,'--------',5x,'---------')
			do x=1,NumOfAcc
				write (screen,45) NameStorage(x),
     +				Username(ptrInStack-NumOfAcc+x),
     +				Dir(ptrInStack-NumOfAcc+x)
			end do
			write (screen,43)
43			format (1x)
45			format (1x,1A30,1x,1A12,1x,1A35)
		end if

		else
		call getuser(ptrInStack,Username,Class,Name)
		call getuic (ptrInStack,Uic,group,Last_UIC)
		call getdir (ptrInStack,Dir,disk,type,class,ext)

		NumOfAcc=NumOfAcc+1
		ptrInStack=ptrInStack+1
		UicHolder=Uic(ptrInStack)

		call WriteFiles(Dir(ptrInStack),disk,intermed,
     +			      Username(ptrInStack),class,name,pwd,
     +			      loginQ,logoutQ,type,ProfUic,ext)
		call WriteIds(Username(ptrInStack),Idents,NumOfIds)
	end if

	goto 30

C	Done with a class close up the Sembud
50	call CloseSemBud(Type,Class,NumOfAcc,money)
	goto 5

10100	ext='A001'
	goto 5

10200	Open(unit=extension,
     +	file='MAKACT_FILES:directory.sav',status='new',
     +	carriagecontrol='list')
	write (extension,10201) ext
10201	format (1A7)
	close (extension)
C	Close all the COM files that were Opened
	call CloseFiles

C	Print Out the Roster.List file
	if (ptrInStack .gt. 0) then
		call Lib$Spawn
     +		('Print/delete/notify MAKACT_WORK:Roster.List')
		call Lib$Do_Command('@ MAKACT_WORK:MAKALL.COM')
	end if

12000	end

C This is a routine to close all the open files used by remove
C it also writes out the closing statements for the .COM files.

	Subroutine CloseFiles

	Parameter ( RosLis=12,MakD=10,MakQ=11,MakA=9 )

C	Close the files
	write (MakA,10)
10	format ('LIST')
	write (MakQ,11)
	write (MakA,11)
11	format ('EXIT')
	write (MakD,12)
	write (MakQ,12)
	write (MakA,12)
12	format ('$ SET DEFAULT ''SAVE_DEFAULT''',/,'$ EXIT')
	close (MakA)
	close (MakQ)
	close (MakD)
	close (RosLis)

	Return
	end

C This routine opens all the files and initializes them
C for their mission in life.

	Subroutine OpenFiles

	Character*9 TheDate
	Character*8 TheTime
	Character*80 line

	Parameter ( RosLis=12,MakD=10,MakQ=11,MakA=9,def=8 )

	Open (unit=MakA,file='MAKACT_WORK:MAKACT.COM',
     +	status='new',form='formatted',carriagecontrol='list')
	Open (unit=MakQ,file='MAKACT_WORK:MAKQUO.COM',
     +	status='new',form='formatted',carriagecontrol='list')
	Open (unit=MakD,file='MAKACT_WORK:MAKDIR.COM',
     +	status='new',form='formatted',carriagecontrol='list')
	Open (unit=RosLis,file='MAKACT_WORK:ROSTER.LIST',
     +	status='new',form='formatted',carriagecontrol='list')

	Call Date(TheDate)
	Call Time(TheTime)

C	Init the Files
	write (MakD,21) TheDate,TheTime
	write (MakA,21) TheDate,TheTime
	write (MakQ,21) TheDate,TheTime
21	format ('$! Procedure generated to create users for the system.'
     +	,/,'$! Generated on ',1A9,' at ',1A8,/,
     +	'$ SAVE_DEFAULT:=''F$LOGICAL("SYS$DISK")''''F$DIRECTORY()'' ',/,
     +	'$ SET UIC [1,4]')

	write (MakQ,22)
22	format ('$ SET DEFAULT SYS$SYSTEM',/,'$ RUN DISKQUOTA')
	write (MakA,23)
23	format ('$ SET DEFAULT SYS$SYSTEM',/,'$ ON WARNING THEN CONTINUE',
     +  /,'$ RUN AUTHORIZE')

C	Write out the defaults to the MakAct.com file
	Open (unit=def,file='MAKACT_FILES:default.sav',
     +	status='old',readonly,carriagecontrol='list',err=999)
30	read (def,50,err=100)line
	write (MakA,50) line
	goto 30
50	format (1A80)

100	close (def)

C	Init the print out file ROSTER.LIST
	write (RosLis,300) TheTime,TheDate
300	format ('Time Generated  :: ',1A8,/,
     +		'Date Generated  :: ',1A9,/,/,
     +		40x,'********* MAKACT REPORT *********',/,/,
     +		'Username      ',5x,'Password',23x,'Directory Path',22x,
     +		'Box  ',10x,'User Id Code',/,
     +		'--------      ',5x,'--------',23x,'--------------',22x,
     +		'---  ',10x,'------------')

	Return

999	write(screen,1000)
1000	format (1x,'%%%%% Error in opening the Default file')
	stop
	end

C This routine writes out all the information to the individual files
C such as the disk name to the MakQuo file.
	Subroutine WriteFiles(Directory,disk,Uic,Username,class,name,
     +			    pwd,login,logout,type,ProfUic,ext)

	Character*35	Directory
	Character*12	disk
	Character*12	Username
	Character*12	type
	Integer*2	Uic(2)
	Integer*2	ProfUic(2)
	Character*12	class
	Character*30	name
	Character*30	pwd
	Character*4	ext
	Integer*2	login
	Integer*2	logout
	Character*5	g,m,profG,profM
	Character*12	diskCopy
	Character*35	dirCopy
	Character*35	dirtemp
	Integer*2	j

	Parameter ( MakA=9,MakD=10,MakQ=11,RosLis=12 )

C	convert the uic to printable characters and left justify
C	them for the /uic= statement
	write (unit=g,fmt='(1O5)') uic(2)
	write (unit=m,fmt='(1O5)') uic(1)
	j=1
	Do while (g(j:j) .eq. ' ')
		g(j:j)='0'
		j=j+1
	end do

	j=1
	Do while (m(j:j) .eq. ' ')
		m(j:j)='0'
		j=j+1
	end do

C	Justify all the variables
	dirtemp='                                   '
	dirtemp=Directory(index(Directory,'['):len(Directory))
	diskCopy=disk
	j=1
	Do while ((diskCopy(j:j) .ne. ' ').AND.(j .le. len(diskCopy)))
		j=j+1
	end do
	diskCopy(j:j)=':'

	if (index(type,'CLASS') .eq. 1) then
C		set up the dir copy for the class acl's
		dirCopy='                                   '
		dirCopy=Directory
		j=index(Directory,']')
		Do while (dirCopy(j:j) .ne. '.')
			j=j-1
		end do
		dirCopy(j:j)=']'
		j=j+1
		Do while (dirCopy(j:j) .ne. ']')
			j=j+1
		end do
		dirCopy(j:j+3)='.DIR'

C		convert the ProfUic to printable characters and left justify
C		them for the Set Acl's on the class directories
		write (unit=profG,fmt='(1O5)') ProfUic(2)
		write (unit=profM,fmt='(1O5)') ProfUic(1)
		j=1
		Do while (profG(j:j) .eq. ' ')
			profG(j:j)='0'
			j=j+1
		end do

		j=1
		Do while (profM(j:j) .eq. ' ')
			profM(j:j)='0'
			j=j+1
		end do
	end if

C	Set the password if not already set
	if (pwd(1:1) .eq. ' ') 	pwd=name

	if (index(type,'CLASS') .eq. 1) then
		write (MakD,11) Directory,ProfG,profM,g,m,
     +		dirCopy,Directory,g,m
11		format ('$ create/dir ',1A35,'-',/,
     +			'/prot=(sys:rwed,own:rwed,g,w) -',/,
     +			'/version_limit=3 -',/,
     +			'/owner=[',1A5,',',1A5,']',/,
     +			'$ set file/acl=(id=[',1A5,',',1A5,'],',
     +			'access=read+write+execute) -',/,1A35,/,
     +			'$ set default ',1A35,/,
     +			'$ copy MAKACT_FILES:Userlogin.com login.com',/,
     +			'$ set file/owner=[',1A5,',',1A5,']/prot=(g)',
     +			' login.com',/,
     +			'$ set uic [1,4]')
		else
		write (MakD,1) Directory,g,m,Directory,g,m
1		format ('$ create/dir ',1A35,'-',/,
     +			'/prot=(sys:rwed,own:rwed,g,w) -',/,
     +			'/version_limit=3 -',/,
     +			'/owner=[',1A5,',',1A5,']',/,
     +			'$ set default ',1A35,/,
     +			'$ copy MAKACT_FILES:Userlogin.com login.com',/,
     +			'$ set file/owner=[',1A5,',',1A5,']/prot=(g)',
     +			' login.com',/,
     +			'$ set uic [1,4]')
	end if

	write (MakQ,2) diskCopy,g,m,login,logout
2	format ('USE ',1A12,/,'add [',1A5,',',1A5,
     +		'] /permquota=',1I8,'/overdraft=',1I8)

	write (MakA,3) Username,class,disk,dirtemp,
     +	       	       class,pwd,g,m
3	format ('add ',1A12,'-',/,
     +		'/account=',1A8,'-',/,
     +		'/device=',1A12,'-',/,
     +		'/directory=',1A30,'-',/,
     +		'/owner=',1A12,'-',/,
     +		'/password=',1A30,'-',/,
     +		'/uic=[',1A5,',',1A5,'] -',/,
     +		'/nopwdexpired')

C	Write to the Roster List File for the Printed output
	write (RosLis,300) Username,pwd,Directory,ext,g,m
300	format (1A12,7x,1A30,1x,1A35,1x,1A4,11x,'[',1A5,',',1A5,']')

	Return
	end

C
C	This is a routine to create the upper level directories
C	for the accounts.  This is done after each class is completed
C

	Subroutine WriteDir(disk,type,len1,class,len2)

	Character*12	disk
	Character*35	dir
	Character*12	type
	Character*12	class
	Integer*2	len1
	Integer*2	len2
	Integer*2	j

	Parameter	(MakD=10)

	dir=disk
	j=1
	Do while (dir(j:j) .ne. ' ')
		j=j+1
	end do
	dir(j:j+1)=':['
	j=j+2
	dir(j:j+len1-1)=type(1:len1)
	j=j+len1
	dir(j:j)='.'
	j=j+1
	dir(j:j+len2-1)=class(1:len2)
	j=j+len2
	dir(j:j)=']'

	write (MakD,10) dir
10	format ('$ create/dir ',1A35,' -',/,'/owner=[1,4]')

	end
