(*
 
	Component :	NEWUSER.PAS -- Add new account to IAS system.
 
	Date:		January 9, 1980
			June 5, 1980
			October 20, 1980	- Biometrics version (rewritten)
			October 24, 1980	- Maintain date and account count
 
	Author:		Tom Mathieu
			Battelle-Northwest
			Box 999
			Richland, Washington 99352
			(509) 375-3711
 
	Source:		Swedish Pascal
 
	Calling Seq:	RUN [11,1]NEWUSER
 
	Inputs:		UIC, Work order number, User id data
			USERS.DAT
 
	Outputs:	Command files to add new logon account.
			USERS.NEW
 
	Comments:	Executed from command file which also
			executes the created command files.
*)

PROGRAM NEWUSER(TTY);		(***   CREATE ACCOUNT FOR NEW USER ON IAS SYSTEM   ***)
 
CONST	ULEN = 78;	(*** NUM CHARS IN USERS.CMD USER REC 
				FORMAT -- 1-4 	'USER'
					  13-21 ACCOUNT NAME (IIIAAAAAA)
					  22-22 SUFFIX (SP,'B','N')
					  40-42 UIC GROUP CODE (300-377)
					  44-46 UIC USER  CODE (001-377)
					  74-78 COST CENTER CODE		**)
 
	ACCUIC = '[1,5]';
 
TYPE	USERID	= ARRAY [1..3] OF CHAR;
	WRKORD	= ARRAY [1..6] OF CHAR;
	DATETP	= ARRAY [1..6] OF CHAR;
 
	WRKORDS = RECORD
	     WKO   	 : WRKORD;
	     CHBL,MKDEL  : BOOLEAN;
	     RESP  	 : USERID; 
	     ORG   	 : ARRAY [1.. 5] OF CHAR;
	     DTLSTUSED   : DATETP	(** ;
             CMMTS 	 : ARRAY [1..20] OF CHAR **)
	     END;
 
	USERS = RECORD
	   UID  : USERID;
	   UNM  : ARRAY [1..16] OF CHAR;
	   UADR : ARRAY [1..16] OF CHAR;
	   UPHN : ARRAY [1.. 8] OF CHAR
	   END;
 
VAR	WKIN,WKOUT : FILE OF WRKORDS;	UIN,UOUT : FILE OF USERS;
	FI,FO,FT : TEXT;		I,J,LEN,UP : INTEGER;
	CMD,CH : CHAR;			NF : BOOLEAN;
	U : USERS;			W : WRKORDS;
	UIC,TUID,PUID : USERID;		TW,PW : WRKORD;
	TODAY     : DATETP;		DR0,DR1: INTEGER;
	HASN,HASB : BOOLEAN;		T : ARRAY [1..10] OF CHAR;
	UBUF,NUBUF : ARRAY [1..ULEN] OF CHAR;
	UU	   : ARRAY [1..4] OF CHAR;
	NAC,TAC,UAC: ARRAY [1..9] OF CHAR;
	UFD	   : ARRAY [1..7] OF CHAR;

PROCEDURE PARSE;	(***  BREAK UP INPUT RECORD  ***)
  VAR I : INTEGER;
  BEGIN
  LEN := ULEN;
  WHILE (LEN>1) AND (UBUF[LEN]=' ') DO LEN := PRED(LEN);
  IF (LEN > 3) AND (UBUF[1]<>'!') THEN
    BEGIN
    FOR I := 1 TO 4 DO UU [I] := UBUF[I];
    FOR I := 1 TO 9 DO UAC[I] := UBUF[I+12];
    FOR I := 1 TO 3 DO UIC[I] := UBUF[I+39];
    END
  ELSE
    BEGIN
    UU := '....';  UIC := '...';  UAC := '.........';
    END
  END;
 
 
FUNCTION UIC2 : INTEGER;	(*** RETURN INT VALUE OF UIC USER CODE  ***)
  VAR I,J : INTEGER;
  BEGIN
  I := 0;
  FOR J := 44 TO 46 DO I := I*8 + ORD(UBUF[J]) - ORD('0');
  UIC2 := I
  END;
 
 
FUNCTION FLEN (X:REAL) : INTEGER;
  BEGIN
  IF X > 99999.0 THEN FLEN := 6 ELSE
  IF X >  9999.0 THEN FLEN := 5 ELSE
  IF X >   999.0 THEN FLEN := 4 ELSE
  IF X >    99.0 THEN FLEN := 3 ELSE
  IF X >     9.0 THEN FLEN := 2 ELSE
  FLEN := 1
  END;

BEGIN	(****   MAIN LINE    ****)
REWRITE(FT,'U.TMP');
DATE(T);
FOR I := 1 TO 2 DO TODAY[I] := T[I+2];
FOR I := 3 TO 4 DO TODAY[I] := T[I+3];
FOR I := 5 TO 6 DO TODAY[I] := T[I+4];
WRITE('Enter option (Add,New,Replace,Delete) [A,D,N,R] : ');  BREAK;  READLN;   READ(CMD);
IF (CMD>='a') AND (CMD<='Z') THEN CMD := CHR(ORD('A') + ORD(CMD) - ORD('a'));
IF NOT (CMD IN ['A','D','N','R']) THEN WRITELN('Sorry -- try again ...')
ELSE
  BEGIN
  IF CMD IN ['A','R','D'] THEN
    BEGIN
    WRITE('Enter account name to be ');
    CASE CMD OF
      'A' : WRITE('added to	> ');
      'D' : WRITE('deleted	> ');
      'R' : WRITE('replaced	> ')
       END;
    BREAK;  READLN;  READ(TAC);
    END;
  IF CMD IN ['N','R'] THEN
    BEGIN
    WRITE('Enter new account initials 		        > ');  BREAK;  READLN;  READ(TUID);
    RESET(UIN,'ACCUSERS.DAT',ACCUIC);
    NF := TRUE;  PUID := '   ';
    WHILE NF AND NOT EOF(UIN) DO
      BEGIN
      NF := UIN^.UID < TUID;
      IF NF THEN BEGIN PUID := UIN^.UID;  GET(UIN)  END
      END;
    IF UIN^.UID<>TUID THEN	(***  WE NEED TO ADD HIM  ***)
      BEGIN
      WITH U DO
        BEGIN
	UID := TUID;
        WRITE('Enter user name                      > ');  BREAK;  READLN;  READ(UNM);
        WRITE('Enter user address                   > ');  BREAK;  READLN;  READ(UADR);
        WRITE('Enter user phone number              > ');  BREAK;  READLN;  READ(UPHN);
	END;
      RESET  (UIN ,'ACCUSERS.DAT',ACCUIC);
      REWRITE(UOUT,'ACCUSERS.TMP',ACCUIC);
      WRITELN(FT,'REN ',ACCUIC,'ACCUSERS.TMP ',ACCUIC,'ACCUSERS.DAT');
      IF PUID='   ' THEN BEGIN UOUT^ := U;  PUT(UOUT)  END;
      WHILE NOT EOF(UIN) DO
	BEGIN
	UOUT^ := UIN^;  PUT(UOUT);
	IF UIN^.UID = PUID THEN BEGIN UOUT^ := U;  PUT(UOUT)  END;
	GET(UIN);
	END;
      END;
 

(******	 GET WORK ORDER STUFF   *******)
 
    WRITE('Enter work order number              > ');  BREAK;  READLN;  READ(TW);
    RESET(WKIN,'ACCMWO.DAT',ACCUIC);
    NF := TRUE;  PW := '      ';
    WHILE NF AND NOT EOF(WKIN) DO
      BEGIN
      NF := WKIN^.WKO < TW;
      IF NF THEN BEGIN PW := WKIN^.WKO;  GET(WKIN)  END
      END;
    IF WKIN^.WKO = TW THEN
      BEGIN
      W := WKIN^;
      IF CMD IN ['N','R'] THEN WRITELN('Work order already in master list')
      END
    ELSE 
      BEGIN
      WITH W DO
	BEGIN
	WKO := TW;
        WRITE('Enter cost center                    > ');  BREAK;  READLN;  READ(ORG);
	CHBL := TRUE;  MKDEL := FALSE;  RESP := TUID;  DTLSTUSED := TODAY
	END;
      RESET  (WKIN, 'ACCMWO.DAT', ACCUIC);
      REWRITE(WKOUT,'ACCMWO.TMP', ACCUIC);
      WRITELN(FT,'REN ',ACCUIC,'ACCMWO.TMP ',ACCUIC,'ACCMWO.DAT');
      IF PW = '      ' THEN BEGIN WKOUT^ := W;  PUT(WKOUT)  END;
      WHILE NOT EOF(WKIN) DO
	BEGIN
	WKOUT^ := WKIN^;  PUT(WKOUT);
	IF WKIN^.WKO=PW THEN BEGIN WKOUT^ := W; PUT(WKOUT)  END;
	GET(WKIN);
	END;
      END;
 
    FOR I := 1 TO 3 DO NAC[I] := TUID[I];
    FOR I := 4 TO 9 DO NAC[I] := TW[I-3];
    END;
 
 
(***	GET REST OF INFO   ***)
 
  IF CMD='N' THEN
    BEGIN
    WRITE('Enter blocks on DR0:                 > ');  BREAK;  READLN;  READ(DR0);
    WRITE('Enter blocks on DR1:                 > ');  BREAK;  READLN;  READ(DR1);
    WRITE('Enter UIC group code [300..377]      > ');  BREAK;  READLN;  READ(PUID);
    END;
  IF CMD IN ['N','A'] THEN
    BEGIN
    WRITE('Night Processing ? [Y/N]             > ');  BREAK;  READLN;  READ(CH);
    HASN := (CH='Y') OR (CH='y');
    WRITE('Batch Processing ? [Y/N]             > ');  BREAK;  READLN;  READ(CH);
    HASB := (CH='Y') OR (CH='y');
    END;

(*****   UPDATE USERS.CMD   *****)
 
  RESET(FI,'USERS.CMD');  REWRITE(FO,'USERS.NEW');  NF := TRUE;
  FOR I := 1 TO 2 DO BEGIN READLN(FI,UBUF);  PARSE;  WRITELN(FO,UBUF:LEN) END;
  READLN(FI);  WRITELN(FO,'!           Modified   ',T);
  READLN(FI);  WRITELN(FO,'!');
  READLN(FI,T,T,T,CH,I);
  IF CMD='N' THEN I := SUCC(I);
  IF CMD='D' THEN I := PRED(I);
  WRITELN(FO,'!        ( Number of accounts =',I:5,' )');
  WHILE NOT EOF(FI) AND NF DO
    BEGIN
    READLN(FI,UBUF);
    PARSE;
    IF UU = 'USER' THEN
      BEGIN
      IF CMD <> 'N' THEN NF := UAC<>TAC
      ELSE
	BEGIN
	NF := PUID<>UIC;
	IF NOT NF THEN		(*** WE FOUND THE PAGE -- LOOK FOR HOLE  **)
	  BEGIN
	  UP := 0;  NF := TRUE;
	  WHILE NF DO
	    BEGIN
	    IF UP<>UIC2 THEN UP := SUCC(UP);  NF := UP=UIC2;
	    IF NF THEN  (** NO HOLE HERE **)
	      BEGIN
	      WRITELN(FO,UBUF:LEN);  READLN(FI,UBUF);  PARSE;
	      NF := UBUF[1] <> '!';
	      IF NOT NF THEN BEGIN LEN:=ULEN;  UP := UP+1  END
	      END;
	    END;
	  END
	END
      END;
    IF NF THEN WRITELN(FO,UBUF:LEN);
    END;
  IF NF THEN WRITELN('ERROR -- I READ THE WHOLE FILE ????')
  ELSE
    BEGIN
    IF CMD='N' THEN
      BEGIN		(*** CREATE NEW USER COMMANDS ***)
      NUBUF := 
	'USER NEW    XXXXXXXXX    (DEV:DR1,UIC:[GGG,UUU],PRI:077777,BPR:077777) ! CCCCC';
      FOR I := 1 TO 9 DO NUBUF[I+12] := NAC[I];
      FOR I := 1 TO 3 DO NUBUF[I+39] := PUID[I];
      FOR I := 1 TO 3 DO
	BEGIN
	NUBUF[47-I] := CHR(ORD('0') + UP MOD 8);  UP := UP DIV 8  
	END;
      FOR I := 1 TO 5 DO NUBUF[I+73] := W.ORG[I];
      FOR I := 1 TO 7 DO UFD[I] := NUBUF[I+39];
      WRITELN('UFD assigned to ',NAC,' is [',UFD,'].');
      WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
      IF HASB THEN 
	BEGIN
	FOR I := 54 TO 58 DO NUBUF[I] := '0';
	NUBUF[22] := 'B';  WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
	FOR I := 54 TO 58 DO NUBUF[I] := '7';
	END;
      IF HASN THEN 
	BEGIN
	NUBUF[22] := 'N';  WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
	END
      END
    ELSE IF CMD ='D' THEN
      BEGIN
      FOR I := 1 TO 7 DO UFD[I] := UBUF[I+39];
      REPEAT
	UBUF[6] := 'R';  UBUF[7] := 'E'; UBUF[8] := 'M';
	WRITELN(FT,UBUF:22);
	READLN(FI,UBUF);
	PARSE;
	UNTIL UAC <> TAC
      END
    ELSE IF CMD = 'A' THEN
      BEGIN
      WRITELN(FO,UBUF:LEN);  NUBUF := UBUF;
      READLN (FI,UBUF);
      PARSE;
      IF HASB THEN
      IF (UAC=TAC) AND (UBUF[22]='B') THEN
	BEGIN
	WRITELN(FO,UBUF:LEN);  READLN(FI,UBUF);
	WRITELN(TAC,' already has batch account');
	END
      ELSE
	BEGIN
	FOR I := 54 TO 58 DO NUBUF[I] := '0';
	NUBUF[22] := 'B';  WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
	FOR I := 54 TO 58 DO NUBUF[I] := '7';
	END;
      IF HASN THEN
      IF (UAC=TAC) AND (UBUF[22]='N') THEN
	BEGIN
	WRITELN(FO,UBUF:LEN);  READLN(FI,UBUF);
	WRITELN(TAC,' already has night account');
	END
      ELSE
	BEGIN
	NUBUF[22] := 'N';  WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
	END;
      END
    ELSE IF CMD = 'R' THEN
      BEGIN	(** DELETE OLD AND ADD NEW **)
      NUBUF := UBUF;
      FOR I := 1 TO 9 DO NUBUF[I+12] := NAC[I];
      FOR I := 1 TO 5 DO NUBUF[I+73] := W.ORG[I];
      REPEAT
	UBUF[6] := 'R';  UBUF[7] := 'E'; UBUF[8] := 'M';
	NUBUF[22] := UBUF[22];
	WRITELN(FT,UBUF:22);  WRITELN(FO,NUBUF:LEN);  WRITELN(FT,NUBUF:LEN);
	READLN(FI,UBUF);
	PARSE;
	UNTIL UAC <> TAC
      END;

 
 
    WRITELN(FO,UBUF:LEN);	(***    COPY REST OF USERS.CMD   ***)
    WHILE NOT EOF(FI) DO
      BEGIN
      READLN(FI,UBUF);  PARSE;  WRITELN(FO,UBUF:LEN);
      END;
 
  (***   TAKE CARE OF DISK STUFF, TOO.   ***)
 
    IF CMD = 'D' THEN
      BEGIN
      WRITELN(FT,'ON ERROR CONTINUE');
      WRITELN(FT,'DEL     DR0:[',UFD,']*.*;*');
      WRITELN(FT,'DEL     DR1:[',UFD,']*.*;*');
      WRITELN(FT,'DAL REM DR0:[',UFD,']');
      WRITELN(FT,'DAL REM DR1:[',UFD,']');
      END;
    IF CMD='N' THEN
      BEGIN
      WRITELN(FT,'DAL NEW DR0:[',UFD,']/DAL:',DR0:FLEN(DR0));
      WRITELN(FT,'DAL NEW DR1:[',UFD,']/DAL:',DR1:FLEN(DR1));
      END;
    WRITELN(FT,'RUN [11,1]UPXINI');
    WRITELN(FT,'REN USERS.NEW USERS.CMD');
    END
 
  END			(*** OF CMD ERROR SKIP ***)
END.