(*
 
	Component :	ACCUPDATE.PAS -- Update user and work order master files.
 
	Date:		January 9, 1980		-- Initial running
			June 13, 1980 		-- List of unused WKOs.
			August 28, 1980		-- Sorted users list.
			October 8, 1980		-- Biometrics version
			October 20, 1980	-- User re-entry error fix
			October 24, 1980	-- Headings on each page, reuse space
 
	Author:		Tom Mathieu
			Battelle-Northwest
			Box 999
			Richland, Washington 99352
			(509) 375-3711
 
	Source:		Swedish Pascal
 
	Calling Seq:	RUN [11,1]ACCUPDATE
 
	Inputs:		ACCMWO.DAT
			ACCUSERS.DAT
 
	Outputs:	ACCMWO.DAT
			ACCUSERS.DAT
 
	Comments:
*)

PROGRAM UPDATE (TTY);
%
FUNCTION:	UPDATE ACCOUNTING CONTROL FILE ACCUSERS.DAT AND ACCMWO.DAT WITH
		ADDITIONS/DELETIONS TO USER AND WORK ORDER LISTS.
 
TO RUN:		MCR>HEL [5,5]
		MCR>RUN [11,1]ACCUPDATE		\
 
 
CONST	LPPG=59;		(**  LINES PER PAGE  **)
 
TYPE	WRKORD = ARRAY [1..6] OF CHAR;
	DTE   = ARRAY [1..6] OF CHAR;
	USERID = ARRAY [1..3] OF CHAR;
	WKOPTR = ^WKLIST;
	USRPTR = ^USERLIST;
	LETTERS = 'A' .. 'Z';
	LETTERSET = SET OF LETTERS;
 
	WRKORDS = RECORD
	     WKO   	 : WRKORD;
	     CHBL,MKDEL   : BOOLEAN;
	     RESP  	 : USERID; 
	     ORG   	 : ARRAY [1.. 5] OF CHAR;
	     DTLSTUSED   : DTE	(** ;
             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;
 
	USERLIST = RECORD
	      U    : USERS;
	      UNXT,ANXT : USRPTR
	      END;
 
	WKLIST = RECORD
	    W    : WRKORDS;
	    WNXT : WKOPTR
	    END;
VAR
   CH  : CHAR;			F  : TEXT;
   US,U1  : FILE OF USERS;	WK,W1 : FILE OF WRKORDS;
   FIRSTW,NEXTW : WKOPTR;	FIRSTU,FIRSTA,NEXTU : USRPTR;
   TITLE:ARRAY[1..25] OF CHAR;	TODAY : DTE;
   CNC:ARRAY[BOOLEAN,1..14] OF CHAR;	I : INTEGER;
   LPOPEN : BOOLEAN;		DT : ARRAY [1..10] OF CHAR;
   CMMTS : ARRAY [1..20] OF CHAR;

PROCEDURE ERASESCREEN;
  BEGIN
  WRITE(CHR(33B),'H',CHR(33B),'J');  BREAK;
  END;
 
 
PROCEDURE GOTOXY(COL,ROW:INTEGER);
  BEGIN
  WRITE(CHR(33B),'Y',CHR(40B+ROW),CHR(40B+COL));  
  END;
 
 
PROCEDURE MENUSELECT(LINE:INTEGER; CHOICES : LETTERSET; VAR CHOICE:CHAR);
  VAR C : CHAR;
  BEGIN
  REPEAT 
    GOTOXY(0,LINE);  WRITELN(' ':40);
    GOTOXY(0,LINE);  WRITE('Enter selection ([');
    FOR C := 'A' TO 'Z' DO IF C IN CHOICES THEN WRITE(C,',');
    WRITE(CHR(33B),'D]) > ');  BREAK;  READLN;  READ(CHOICE);  WRITELN;
    IF (CHOICE>='a') AND (CHOICE<='z') THEN CHOICE := CHR(ORD(CHOICE)-ORD('a')+ORD('A'));
    IF NOT (CHOICE IN CHOICES) THEN WRITELN('>>> Invalid selection -- ',CHOICE,CHR(7))
			       ELSE WRITELN(' ':40);
    UNTIL CHOICE IN CHOICES;
  GOTOXY(0,LINE+1);
  END;
 
 
PROCEDURE GETINT(X,Y : INTEGER;  VAR INT : INTEGER);
  BEGIN
  GOTOXY(X,Y);  WRITE('<':6);  BREAK;
  GOTOXY(X,Y);  BREAK;  READLN;  READ(INT);
  GOTOXY(X,Y);  WRITE(INT:5,' ');  BREAK;
  END;
 
 
PROCEDURE GETSTRING (X,Y,LEN:INTEGER;  VAR S : ARRAY [INTEGER] OF CHAR);
  VAR I : INTEGER;
  BEGIN
  GOTOXY(X,Y);  WRITE('<':LEN+1);  BREAK;
  GOTOXY(X,Y);  BREAK;  READLN;  I := 1;
  WHILE NOT EOLN(TTY) AND (I<=LEN) DO
    BEGIN
    READ(S[I]);  I := SUCC(I);
    END;
  FOR I := I TO LEN DO S[I] := ' ';
  END;
 

PROCEDURE INSERTALPH(TU:USRPTR);   (*** LINK USER IN ALPHA ORDER ***)
  VAR  LU,NU:USRPTR;  OK:BOOLEAN;
  BEGIN
  NU := FIRSTA;  LU := NIL;  OK := TRUE;
  WHILE (NU <> NIL) AND OK DO
    BEGIN
    OK := NU^.U.UNM < TU^.U.UNM;
    IF OK THEN BEGIN LU := NU;  NU := NU^.ANXT  END;
    END;
  IF LU = NIL THEN
    BEGIN
    TU^.ANXT := FIRSTA;  FIRSTA := TU;
    END
  ELSE
    BEGIN
    LU^.ANXT := TU;  TU^.ANXT := NU;
    END;
  END;

 
PROCEDURE READEMIN (K : INTEGER);
 
   VAR OK : BOOLEAN;   I : INTEGER;
       LASTU : USRPTR; LASTW : WKOPTR;
 
   BEGIN
   IF K = 1 THEN BEGIN
 
   (*  CREATE LINKED LIST OF WKORDS  *)
 
   RESET(WK,'ACCMWO.DAT');
   FIRSTW := NIL;
   WHILE NOT EOF(WK) DO
      BEGIN
      NEW (NEXTW);
      NEXTW^.W := WK^;   NEXTW^.WNXT := NIL;
      IF FIRSTW = NIL THEN  (*  THIS IS FIRST ONE  *)
	 BEGIN
	 FIRSTW := NEXTW; LASTW := NEXTW;
	 END
      ELSE   (* ADD NEW ONE ON TO END OF LIST *)
	 BEGIN
	 LASTW^.WNXT := NEXTW;
	 LASTW := NEXTW;
	 END;
      GET(WK);
      END;        (* OF READING WORK ORDERS *)
      END
   ELSE
 
   (*   CREATE LINKED LIST OF USERS   *)
 
   BEGIN
   FIRSTU := NIL;   FIRSTA := NIL;
   RESET(US,'ACCUSERS.DAT');
   WHILE NOT EOF(US) DO
      BEGIN
      NEW (NEXTU);
      NEXTU^.U := US^;  NEXTU^.ANXT := NIL;  NEXTU^.UNXT := NIL;
      IF FIRSTU = NIL THEN    (*  IT IS FIRST ONE *)
	 BEGIN
	 FIRSTU := NEXTU;  LASTU := NEXTU;  
	 END
      ELSE      (*   ADD THIS ONE TO THE END   *)
	 BEGIN
	 LASTU^.UNXT := NEXTU;
	 LASTU := NEXTU;
	 END;
      IF FIRSTA = NIL THEN FIRSTA := LASTU ELSE INSERTALPH(LASTU);
      GET(US);
      END;   (*  OF USERS   -  END OF FILE  *)
   END;
   END;      (*  OF READEMIN  *)

PROCEDURE WRITEMOUT (K:INTEGER);
   VAR I : INTEGER;
   BEGIN
   IF K = 1 THEN BEGIN
   REWRITE (W1,'ACCMWO.DAT');
   NEXTW := FIRSTW;
   REPEAT
      W1^ := NEXTW^.W;
      PUT(W1);
      NEXTW := NEXTW^.WNXT;
      UNTIL NEXTW = NIL;
   END ELSE BEGIN
   REWRITE(U1,'ACCUSERS.DAT');
   NEXTU := FIRSTU;
   REPEAT
      U1^ := NEXTU^.U;
      PUT (U1);
      NEXTU := NEXTU^.UNXT;
      UNTIL NEXTU = NIL;
   END;
   END;    (*  OF WRITEM OUT  *)
 
PROCEDURE OPENLP;
   BEGIN
   IF LPOPEN THEN PAGE(F) ELSE REWRITE(F,'  ',,'LP:');  LPOPEN := TRUE
   END;
  
PROCEDURE UPD1 (VAR CH : CHAR);
   BEGIN
   ERASESCREEN;  WRITELN(TITLE:30);  WRITELN;
   WRITELN('Options available are');
   WRITELN('  A = Add a new one');
   WRITELN('  D = Delete one');
   WRITELN('  C = Change one');
   WRITELN('  L = List them');
   WRITELN('  X = Stop');
   MENUSELECT (10,['A','C','D','L','X'],CH);
   END;
 
PROCEDURE GETUID(X,Y:INTEGER; VAR U : USERID);
  VAR I : INTEGER;
  BEGIN
  GETSTRING(X,Y,3,U);
  % FOR I := 1 TO 3 DO
    IF U[3] = ' ' THEN BEGIN U[3] := U[2];  U[2] := U[1];  U[1] := '0';  END;
  FOR I := 1 TO 3 DO IF NOT (U[I] IN ['0'..'7']) THEN U := '000';	\
  GOTOXY(X,Y);  WRITELN(U);
  END;
 
PROCEDURE PAUSE;
  VAR I,J : INTEGER;
  BEGIN
  FOR I := 1 TO 24000 DO J := I+101
  END;

PROCEDURE UPDTWORK;    (*  UPDATE WORK ORDERS  *)
   VAR	C,CMD:CHAR;   TW,FREEW,PREVW:WKOPTR;  I,J:INTEGER;  INP,OLDATE:WRKORD;  CHGD,OLDONLY:BOOLEAN;
  
   FUNCTION FINDW (SEEKEE : WRKORD) : BOOLEAN;
      VAR BEFORE : BOOLEAN;
      BEGIN
      NEXTW := FIRSTW;  PREVW := NIL;
      LOOP
	 BEFORE := NEXTW = NIL;
	 IF NOT BEFORE THEN BEFORE := NEXTW^.W.WKO >= SEEKEE;
	 EXIT IF BEFORE OR (NEXTW^.WNXT = NIL);
	 PREVW := NEXTW;  NEXTW := NEXTW^.WNXT;
	 END;
      FINDW := BEFORE;
      END;
 
   PROCEDURE GETTW;
      BEGIN
      IF FREEW=NIL THEN NEW(TW) ELSE BEGIN TW := FREEW;  FREEW := NIL;  END
      END;
 
   PROCEDURE PUTUPW;
      BEGIN
      ERASESCREEN;  WRITELN(TITLE:30);  WRITE('Selected function : ');
      CASE CMD OF
	'A' : WRITELN('Adding');
	'D' : WRITELN('Deleting');
        'C' : WRITELN('Changing')
	END;
      WRITELN;
      WITH TW^.W  DO  BEGIN
	WRITELN('Available field modification options :');
	WRITELN('  W = Work order number   >',WKO);
	WRITELN('  N = Non chgbl / chgbl   >',CNC[CHBL]);
	WRITELN('  R = Resp. person UID    >',RESP);
	WRITELN('  O = Organization code   >',ORG);
	WRITELN('  C = Comments            >',CMMTS);
	WRITELN('  P = Post changes');
	WRITELN('  X = Exit -- no update');
	END;
      END;
 

   PROCEDURE LISTW(VAR F:TEXT);
      VAR L : INTEGER;
      BEGIN
      NEXTW := FIRSTW;   L := LPPG+1;
      WHILE (NEXTW <> NIL) DO BEGIN
       IF L > LPPG THEN BEGIN  L := 5;
	 PAGE(F);
         WRITELN(F,'Biometrics Computer Center Work Order List',DT:23);  WRITELN(F);
         WRITELN(F,'  WKO        CHG/NC     WHOSE  ORG  Last Use    COMMENTS');
         WRITELN(F,'-------  --------------  ---  -----  ------  --------------------');
         END;
       IF NEXTW^.W.MKDEL THEN C := '*' ELSE C := ' ';
       WITH NEXTW^.W DO IF (NOT OLDONLY) ! (DTLSTUSED<OLDATE) & (NOT MKDEL) THEN BEGIN
	WRITELN(F,WKO,C,CNC[CHBL]:16,RESP:5,ORG:7,DTLSTUSED:8,CMMTS:22); L := L+1 END;
       NEXTW := NEXTW^.WNXT
       END;
      END;
 
 
   BEGIN	(****   UPDATE WORK ORDERS   ****)
   OLDATE := TODAY;  I := 4;  J := 3;
   REPEAT
     OLDATE[I] := CHR(ORD(OLDATE[I]) - J);
     IF OLDATE[I] < '0' THEN BEGIN OLDATE[I] := CHR(ORD(OLDATE[I])+10); J:=1 END
			ELSE J := 0;
      I := I-1;
     UNTIL (I=1) OR (J=0);
   CHGD := FALSE;  READEMIN(1);  TITLE := 'UPDATE MASTER WORK ORDERS';
   FREEW := NIL;
   LOOP
   UPD1(CMD);
   EXIT IF CMD = 'X';
   IF CMD = 'L' THEN
     BEGIN
     WRITE('Output to printer or terminal [P/T] ? ');  BREAK;  READLN;  READ(C);
     WRITE('Unused work orders only       [Y/N] ? ');  BREAK;  READLN;  READ(CMD);
     OLDONLY := (CMD='Y') OR (CMD='y');  CMD := 'L';
     IF C <> 'P' THEN 
       BEGIN
       LISTW(TTY);  WRITELN;  WRITE('Hit <return> to continue >>');  BREAK;  READLN;
       END
     ELSE
       BEGIN
       OPENLP;  LISTW(F)
       END;
     END ELSE
   IF CMD IN ['C','D'] THEN
      BEGIN
      WRITE (TTY,'Enter work order number > ');  BREAK;
      READLN(TTY);   READ(INP);
      IF NOT (FINDW(INP) AND (NEXTW^.W.WKO=INP)) THEN
	 BEGIN  (***  ERROR   ***)
	 WRITELN('>>>> Work order not found >>> ',INP,CHR(7));
	 CMD := 'X';
	 END
      ELSE
	 IF CMD = 'C' THEN
	    BEGIN
	    GETTW;  TW^.W := NEXTW^.W;
	    END
	 ELSE
	    TW := NEXTW;
      END
   ELSE IF CMD = 'A' THEN
      BEGIN
      GETTW;
      WITH TW^ DO WITH W DO
	 BEGIN
	 WKO := '......';	CHBL := TRUE;	ORG := 'D7...';
	 RESP := '...';		WNXT := NIL;	MKDEL := FALSE;
	 CMMTS := '                    ';	DTLSTUSED := TODAY;
	 END;
      END;
 
   IF NOT (CMD IN ['X','L']) THEN
      BEGIN
      PUTUPW;
      IF CMD = 'D' THEN
	 BEGIN	(** DELETE WORK ORDER **)
	 REPEAT
 	   GOTOXY(0,20);  WRITE('Delete this work order ? [Y/N] >');  BREAK;
	   READLN;  READ(C); 
	   IF C IN ['Y','N','U'] THEN WRITELN(' ':40)
		ELSE WRITELN('>>> Invalid selection >>> ',C,CHR(7));
	   UNTIL C IN ['Y','N','U'];
	 IF C <> 'N' THEN
	   BEGIN
	   NEXTW^.W.MKDEL := C='Y';  CHGD := TRUE;
	   END
	 END
      ELSE		(***   ADD / CHANGE   ***)
	 BEGIN
	 REPEAT
	   MENUSELECT(13,['C','N','P','X','W','R','O'],C);
	   CASE C OF 
	     'C' : GETSTRING(27,9,20, (* TW^.W.  **) CMMTS);
	     'O' : GETSTRING(27,8, 5,TW^.W.ORG  );
	     'N' : BEGIN
		   TW^.W.CHBL := NOT TW^.W.CHBL;
		   GOTOXY(27,6);  WRITELN(CNC[TW^.W.CHBL]);
		   END;
	     'R' : GETUID(27,7,TW^.W.RESP);
	     'W' : IF CMD = 'C' THEN WRITELN('Can''t change work order number',CHR(7))
		   ELSE GETSTRING(27,5,6,TW^.W.WKO);
	     'X' : FREEW := TW;
	     'P' : IF CMD='C' THEN BEGIN NEXTW^.W := TW^.W;  FREEW := TW;  CHGD := TRUE END
		   ELSE
		   IF FIRSTW = NIL THEN BEGIN FIRSTW := TW;  CHGD := TRUE END
		   ELSE
	           IF FINDW(TW^.W.WKO) THEN
		     BEGIN
		     IF NEXTW^.W.WKO = TW^.W.WKO THEN
		       BEGIN
	    	       WRITELN(TTY,'Work order already in file');
		       C := 'A';  PAUSE
		       END
		     ELSE IF PREVW = NIL THEN
		       BEGIN  (**  ADD AT FRONT  **)
		       TW^.WNXT := FIRSTW;  FIRSTW := TW;  CHGD := TRUE;
		       END
	    	     ELSE
			BEGIN	(**  ADD IN MIDDLE  **)
			TW^.WNXT := NEXTW;  PREVW^.WNXT:=TW;  CHGD := TRUE;
			END
		     END
		   ELSE
	 		BEGIN     (*  ADD AT END OF LIST  *)
	 		TW^.WNXT := NIL;  CHGD := TRUE;  NEXTW^.WNXT := TW;
	 		END
 
      		END;    (*  OF CASES  *)
	    UNTIL C IN ['X','P'];
	  END;
         END;        	(*  OF OK COMMAND  *)
      END;        	(*  OF LOOP  *)
   IF CHGD THEN WRITEMOUT(1);
   END;        		(*  OF UPDATE WORK ORDER *)

PROCEDURE UPDTUSER;    (*  UPDATE USERS  *)
   VAR	C,CMD:CHAR;  TU,FREEU,PREVU:USRPTR; I:INTEGER;  INP:USERID; CHGD,OK:BOOLEAN;
  
   FUNCTION FINDU (SEEKEE : USERID) : BOOLEAN;
      VAR BEFORE : BOOLEAN;
      BEGIN
      NEXTU := FIRSTU;   PREVU := NIL;
      LOOP
	 BEFORE := NEXTU = NIL;
	 IF NOT BEFORE THEN BEFORE := NEXTU^.U.UID >= SEEKEE;
	 EXIT IF BEFORE OR (NEXTU^.UNXT = NIL);
	 PREVU := NEXTU;  NEXTU := NEXTU^.UNXT;
	 END;
      FINDU := BEFORE;
      END;
 
   PROCEDURE GETTU;
      BEGIN
      IF FREEU = NIL THEN NEW(TU)
      ELSE BEGIN  TU := FREEU;  FREEU := NIL;  END
      END;
 
   PROCEDURE PUTUPU;
      BEGIN
      ERASESCREEN;  WRITELN(TITLE:30);  WRITE('Selected function : ');
      CASE CMD OF
	'A' : WRITELN('Adding');
	'D' : WRITELN('Deleting');
        'C' : WRITELN('Changing')
	END;
      WRITELN;
      WITH TU^.U  DO   BEGIN
	WRITELN('Available field modification options :');
	WRITELN('  I = User identification >',UID);
	WRITELN('  N = User name           >',UNM);
        WRITELN('  A = User address        >',UADR);
	WRITELN('  B = User phone number   >',UPHN);
	WRITELN('  P = Post changes');
	WRITELN('  X = Exit -- no update');
	END;
      END;
 

   PROCEDURE LISTU(VAR F:TEXT; BYALPH:BOOLEAN);
     VAR L : INTEGER;
     BEGIN
     IF BYALPH THEN NEXTU := FIRSTA ELSE NEXTU := FIRSTU;
     L := LPPG+1;
     WHILE NEXTU <> NIL DO BEGIN
	IF L > LPPG THEN
	  BEGIN
	  PAGE(F);
	  WRITELN(F,'Biometrics Computing Center Users List',DT:11);  WRITELN(F);
	  WRITELN(F,'UID        NAME            ADDRESS         PHONE');
	  WRITELN(F,'---  ----------------  ----------------  --------');
	  L := 5
	  END;
	WITH NEXTU^.U DO WRITELN(F,UID,UNM:18,UADR:18,UPHN:10);  L := L+1;
	IF BYALPH THEN NEXTU := NEXTU^.ANXT ELSE NEXTU := NEXTU^.UNXT;
	END;
     END;
 

   BEGIN	(****   UPDATE USER LIST   ****)
   CHGD := FALSE;  READEMIN(2);  TITLE := 'Update master users list  ';
   FREEU := NIL;
   LOOP
   UPD1(CMD);
   EXIT IF CMD = 'X';
   IF CMD = 'L' THEN 
     BEGIN
     WRITE('Output to terminal or printer [T/P] ? ');  BREAK;  READLN;  READ(C);
     WRITE('Alpha order or User id # order [A/U]? ');  BREAK;  READLN;  READ(CH);
     IF C <> 'P' THEN 
	BEGIN
	LISTU(TTY,(CH='A')OR(CH='a'));  WRITELN;  WRITE('Hit <return> to continue >>');  BREAK;  READLN;
	END
     ELSE BEGIN OPENLP;  LISTU(F,(CH='A') OR (CH='a'));  END
     END
   ELSE
   IF CMD IN ['C','D'] THEN
      BEGIN
      WRITE (TTY,'Enter user id > ');  GETUID(15,11,INP);
      NEXTU := FIRSTU;   PREVU := NIL;
      IF NOT (FINDU(INP) AND (NEXTU^.U.UID=INP)) THEN
	 BEGIN  (***  ERROR   ***)
	 WRITELN('>>>> User id not found >>> ',INP,CHR(7));  CMD := 'X';  PAUSE;
	 END
      ELSE
	 IF CMD = 'C' THEN
	    BEGIN
	    GETTU;  TU^.U := NEXTU^.U;
	    END
	 ELSE
	    TU := NEXTU;
      END
   ELSE IF CMD = 'A' THEN
      BEGIN
      GETTU;
      WITH TU^.U DO
	 BEGIN
	 UID := '...';  UPHN := '...-....';
	 UADR := '................';
	 UNM  := 'Last, initials  ';
	 END;
      END;
 
   IF NOT (CMD IN ['X','L']) THEN
      BEGIN
      PUTUPU;
      IF CMD = 'D' THEN		(***  DELETE USER FROM FILE   ***)
	 BEGIN
	 REPEAT
 	   GOTOXY(0,20);  WRITE('Delete this user id ? [Y/N] >');  BREAK;
	   READLN;  READ(C); 
	   IF C IN ['Y','N'] THEN WRITELN(' ':40)
		ELSE WRITELN('>>> Invalid selection >>> ',C,CHR(7));
	   UNTIL C IN ['Y','N'];
	 IF C = 'Y' THEN
	   BEGIN
	   PREVU^.UNXT := NEXTU^.UNXT;  FREEU := NEXTU;  CHGD := TRUE;
	   PREVU := NIL;  TU := FIRSTA;
	   WHILE (TU <> NIL) AND (TU^.U.UID<> INP) DO
	      BEGIN PREVU := TU;  TU := TU^.ANXT  END;
	   IF PREVU = NIL THEN FIRSTA := FIRSTA^.ANXT
	   ELSE IF TU = NIL THEN PREVU^.ANXT := NIL ELSE PREVU^.ANXT := TU^.ANXT;
	   END
	 END
      ELSE		(***   ADD / CHANGE   ***)
	 BEGIN
	 REPEAT
	   MENUSELECT(12,['I','N','P','X','A','B'],C);
	   CASE C OF 
	     'I' : IF C = 'C' THEN WRITELN('Can''t change user id') ELSE
		   GETUID(27,5,TU^.U.UID);
	     'N' : GETSTRING(27,6,16,TU^.U.UNM);
	     'A' : GETSTRING(27,7,16,TU^.U.UADR);
	     'B' : GETSTRING(27,8,8, TU^.U.UPHN);
	     'X' : FREEU := TU;
	     'P' : IF CMD='C' THEN BEGIN NEXTU^.U := TU^.U; FREEU := TU; CHGD := TRUE END
		   ELSE
		   IF FIRSTU = NIL THEN BEGIN FIRSTU := TU;  FIRSTA := TU; CHGD := TRUE END
		   ELSE
		   BEGIN
		   OK := TRUE;
	           IF FINDU(TU^.U.UID) THEN
		     BEGIN
		     IF NEXTU^.U.UID = TU^.U.UID THEN
		       BEGIN
	    	       WRITELN(TTY,'User id already in file');  PAUSE;  C := 'A';  OK := FALSE;
		       END
		     ELSE IF PREVU = NIL THEN
		       BEGIN   (**  ADD AT FRONT  **)
		       TU^.UNXT := FIRSTU;  FIRSTU := TU;  CHGD := TRUE;
		       END
	    	     ELSE
			BEGIN	(**  ADD IN MIDDLE  **)
			TU^.UNXT := NEXTU;  PREVU^.UNXT:=TU;  CHGD := TRUE;
			END
		     END
		   ELSE
	 		BEGIN     (*  ADD AT END OF LIST  *)
	 		TU^.UNXT := NIL;  CHGD := TRUE;  NEXTU^.UNXT := TU;
	 		END;
		   IF OK THEN INSERTALPH(TU);
		   END
      		END;    (*  OF CASES  *)
	    UNTIL C IN ['X','P'];
	  END		(*  OF ADD/CHG  *)
         END;        	(*  OF OK COMMAND  *)
      END;        	(*  OF LOOP  *)
   IF CHGD THEN WRITEMOUT(2);
   END;        		(*  OF UPDATE WORK ORDER *)

 
 
 
 
BEGIN    (*   MAIN LINE   *)
CNC[TRUE]  := 'Chargeable    ';
CNC[FALSE] := 'Non-chargeable';
DATE(DT);
FOR I := 1 TO 2 DO TODAY[I] := DT[I+2];
FOR I := 3 TO 4 DO TODAY[I] := DT[I+3];
FOR I := 5 TO 6 DO TODAY[I] := DT[I+4];
LPOPEN := FALSE;
WRITE (TTY,'Update user file ? (Y or N) : '); BREAK;
READLN(TTY); READ(TTY,CH);
MARK;
IF (CH = 'Y') OR (CH='y') THEN UPDTUSER;
WRITE (TTY,'Update work order file ? (Y or N) : '); BREAK;
READLN(TTY); READ(TTY,CH);
RELEASE;
IF (CH = 'Y') OR (CH = 'y') THEN UPDTWORK;
END.