PROGRAM UIC_SET
C
C	COPYRIGHT (C) 1979
C		MANAGEMENT SCIENCE ASSOCIATES, INC.
C		5100 CENTRE AVENUE
C		PITTSBURGH, PENNSYLVANIA  15232
C
C	THIS SOFTWARE IS DISTRIBUTED WITHOUT COST, AND MAY BE
C	REPRODUCED ONLY WITH THE INCLUSION OF THIS COPYRIGHT
C	STATEMENT.  MANAGEMENT SCIENCE ASSOCIATES ASSUMES NO
C	RESPONSIBILITY FOR THE PERFORMANCE OF THIS SOFTWARE.
C
C	AUTHOR:	MARK PILANT
C
C	NOTE:	THIS PROGRAM MUST BE INSTALLED WITH CMKRNL PRIVILEGE
C
	PARAMETER NUIC=5	!NUMBER OF UIC ENTRIES
	PARAMETER NAUTH=16	!NUMBER OF ALLOWED USERS
	CHARACTER*3 GROUP,MEMBER
	CHARACTER*7 UICTAB (NUIC,NAUTH)
	CHARACTER*15 UIC,XTRACT,NAMTAB(NAUTH)
	CHARACTER*64 USERNAME
	INTEGER*4 IUIC(4)
	INTEGER*4 LIST(3), LENGTH
	INTEGER*2 GNUM,MNUM,IUICVEC(2)
	EQUIVALENCE (IUICVEC(1),MNUM),(IUICVEC(2),GNUM)
	EQUIVALENCE (IUIC,UIC)
	DATA NAMTAB(1)/'SCHMIDT'/
	DATA UICTAB(1,1)/'377,377'/
	DATA NAMTAB(2)/'DANIELS'/
	DATA UICTAB(1,2)/'011,002'/, UICTAB(2,2)/'046,002'/
	DATA UICTAB(3,2)/'014,376'/
	DATA NAMTAB(3)/'MISHLER'/
	DATA UICTAB(1,3)/'043,377'/, UICTAB(2,3)/'015,002'/
	DATA NAMTAB(4)/'BOJARSKI'/
	DATA UICTAB(1,4)/'043,376'/, UICTAB(2,4)/'020,002'/
	DATA NAMTAB(5)/'SCHETLEY'/
	DATA UICTAB(1,5)/'011,015'/, UICTAB(4,5)/'014,376'/
	DATA UICTAB(2,5)/'042,002'/, UICTAB(3,5)/'015,376'/
	DATA NAMTAB(6)/'THEN'/
	DATA UICTAB(1,6)/'011,004'/,UICTAB(2,6)/'043,004'/
	DATA UICTAB(3,6)/'014,376'/
	DATA NAMTAB(7)/'HARPER'/
	DATA UICTAB(1,7)/'045,377'/, UICTAB(2,7)/'011,003'/
	DATA NAMTAB(8)/'PILANT'/
	DATA UICTAB(1,8)/'377,377'/
	DATA NAMTAB(9)/'YANKES'/
	DATA UICTAB(1,9)/'011,006'/, UICTAB(2,9)/'014,376'/
	DATA UICTAB(3,9)/'042,376'/, UICTAB(4,9)/'043,376'/
	DATA NAMTAB(10)/'LAWRENCE'/
	DATA UICTAB(1,10)/'377,377'/
	DATA NAMTAB(11)/'OPERATOR'/
	DATA UICTAB(1,11)/'377,377'/
	DATA NAMTAB(12)/'BUTTYAN'/
	DATA UICTAB(1,12)/'377,377'/
	DATA NAMTAB(13)/'BORNEMAN'/
	DATA UICTAB(1,13)/'377,377'/
	DATA NAMTAB(14)/'MICKELSEN'/
	DATA UICTAB(1,14)/'377,377'/
	DATA NAMTAB(15)/'SYSTEM'/
	DATA UICTAB(1,15)/'377,377'/
	DATA NAMTAB(16)/'MARCHEWKA'/
	DATA UICTAB(1,16)/'020,005'/, UICTAB(2,16)/'043,376'/
	UIC='               '
	LEN=IGETCMD(IUIC,15)
	IF (LEN.LT.1) CALL EXIT ('14'X)
C
C	CHECK FOR JOKERS FROM DEMO AND GAMES
	LIST (1) = '02020040'X
	LIST (2) = %LOC(USERNAME)
	LIST (3) = %LOC(LENGTH)
	CALL SYS$GETJPI (,,,LIST,,,)
	IF (USERNAME(1:LENGTH) .EQ. 'DEMO') CALL EXIT ('24'X)
	IF (USERNAME(1:LENGTH) .EQ. 'GAMES') CALL EXIT ('24'X)
C
C	CHECK FOR VALID STRING CONTEXT
	DO 10 I=1,LEN
		IF (UIC(I:I).EQ.' ') CALL EXIT ('14'X)
10	CONTINUE
C
C	STRIP TRAILING NULLS FROM USERNAME
	DO 11 I=1,15
		IF (ICHAR(USERNAME(I:I)).EQ.0)USERNAME(I:I)=' '
11	CONTINUE
C
C	CHECK FOR A [
	IF (LIB$LOCC('[',UIC).NE.0) GO TO 20
C
C	NO [ MUST NOT HAVE A ]
	IF (LIB$LOCC(']',UIC).NE.0) CALL EXIT ('14'X)
	GO TO 40
C
C	HAD A [ MUST HAVE A ]
20	IF (LIB$LOCC(']',UIC).EQ.0) CALL EXIT ('14'X)
C
C	STRIP OFF [ ]
	L=0
	XTRACT(1:7)='       '
	DO 30 J=2,LEN-1
		L=L+1
		XTRACT(L:L)=UIC(J:J)
30	CONTINUE
	UIC(1:7)=XTRACT(1:7)
	LEN=L
C
C	BREAK APART INTO MEMBER AND GROUP
40	K=LIB$LOCC(',',UIC)
	IF (K.EQ.0) CALL EXIT('14'X)
42	GROUP(1:K-1)=UIC(1:K-1)
	IF (K.EQ.2) GROUP='00'//GROUP
	IF (K.EQ.3) GROUP='0'//GROUP
	L=LEN-K
	MEMBER(1:L)=UIC(K+1:LEN)
	IF (L.EQ.1) MEMBER='00'//MEMBER
	IF (L.EQ.2) MEMBER='0'//MEMBER
C
C	PUT UIC BACK TOGETHER IN FULL 7 DIGIT FORM
	UIC=GROUP//','//MEMBER
	LEN=7
C
C	NOW CHECK IF THIS USER IS ALLOWED THIS UIC
	DO 70 I=1,NAUTH
		IF (NAMTAB(I)(1:15).NE.USERNAME(1:15)) GO TO 70
C
C		USER IS AUTHORIZED A UIC CHANGE, CHECK IF LEGAL REQ
		DO 60 J=1,NUIC
			IF(ICHAR(UICTAB(J,I)(1:1)).EQ.0) CALL EXIT ('24'X)
C			CHECK IF GROUP IS WILD CARD OR OK
			XTRACT=UICTAB(J,I)(1:7)
			IF (XTRACT(1:3).EQ.'377') GO TO 50
			IF (XTRACT(1:3).NE.UIC(1:3)) GO TO 60
C			GROUP ACCESS IS ALLOWED CHECK FOR MEMBER
C			IS THIS A WILD CARD MATCH
50			IF (XTRACT(5:7).EQ.'377') GO TO 80
			IF(XTRACT(5:7).EQ.UIC(5:7)) GO TO 80
C
C		THIS USER NOT AUTHORIZED REQ UIC
60		CONTINUE
		CALL EXIT ('24'X)
C
C	THIS USER NOT AUTHORIZED ANY UIC CHANGE
70	CONTINUE
	CALL EXIT ('24'X)
C
C	THIS REQ OK SO DO UIC DELTA
C
C	CONVERT UIC TO NUMERIC ENTRY
80	GNUM=0
	MNUM=0
	DO 90 I=1,3
		IF (GROUP(I:I).LT.'0'.OR.GROUP(I:I).GT.'7')CALL EXIT ('14'X)
		IF (MEMBER(I:I).LT.'0'.OR.MEMBER(I:I).GT.'7')CALL EXIT ('14'X)
		GNUM=GNUM*8+(ICHAR(GROUP(I:I))-'30'X)
		MNUM=MNUM*8+(ICHAR(MEMBER(I:I))-'30'X)
90	CONTINUE
	CALL UICSET (IUICVEC)
	CALL EXIT (1)
	END