(*
 
	Component :	ACCANAL -- Accounting Analysis Program
 
	Date:		February 4, 1980
			September 4, 1980	-- Larger Batch Format
			September 25, 1980	-- BIOMETRICS version
 
	Author:		Tom Mathieu
			Battelle-Northwest
			Box 999
			Richland, Washington 99352
			(509) 375-3711
 
	Source:		Swedish Pascal
 
	Calling Seq:	RUN [11,1]ACCANAL
 
	Inputs:		ACCOUNTS.DAT
			ACCMWO.DAT
			USERS.DAT
			ACCTSSUM.DAT
			ACCHSTRY.DAT
 
	Outputs:	ACCANAL.LST
			ACCCLEAN.CMD
			ACCHSTRY.DAT
			ACCSTxxx.DAT
 
	Comments:
*)

PROGRAM ANALYSIS(TTY);		(***   GENERATE ACCOUNTING REPORTS   ***)
 
CONST	LINESPERPAGE=60;
 
TYPE	USAGE = (MUMINS,MUMCTS,BAMINS,BAMCTS,DISKB,SPPLS);
	WOTYP = (CHG,NCH);
	A30   = ARRAY [1..30] OF CHAR;
	A3    = ARRAY [1..3 ] OF CHAR;
	WKO   = ARRAY [1..6 ] OF ASCII;
	UIC   = RECORD U1,U2 : INTEGER END;
	SYS   = ARRAY [MUMINS .. SPPLS] OF REAL;
	WRKPTR= ^WORKORD;
	USEPTR= ^USAGEREC;
	CCPTR = ^CCTR;
 
	WRKORDS = RECORD		(***  WORK ORDER DESCRIPTOR   ***)
		WRK : WKO;
		CHGBL,MKDEL : BOOLEAN;
		RESP  : A3;
		ORG   : ARRAY [1..5] OF CHAR;
		DTLSTU: ARRAY [1..6] OF CHAR;
		CMMTS : ARRAY [1..20] OF ASCII
		END;
 
	WORKORD = RECORD		(***   WORK ORDER FILE   ***)
		WW : WKO;
		WTP: WOTYP;
		WCC: CCPTR;
		(**WC : ARRAY [1..20] OF ASCII;**)
		NXU: USEPTR;
		TOTH,TOTC : REAL;
		NCW : WRKPTR;
		NW : WRKPTR
		END;
 
	USAGEREC = RECORD		(***   SYSTEM USAGE SUMMARY   ***)
		UNM  : ARRAY [1..9] OF CHAR;
		U    : UIC;
		UW   : WRKPTR;
		PUSE : SYS;
		DUSE : SYS;
		CHGS : SYS;
		NXW  : USEPTR;
		NU   : USEPTR
		END;
 
	CCTR = RECORD
		CCNM : ARRAY [1..5] OF CHAR;
		CCN : CCPTR;
		CCF : WRKPTR;
		CCT : BOOLEAN
		END;

VAR	F,F1 : TEXT;		PR,DSC,TOSCST,TOSDVP,TOSDVD,TOSCSTD : SYS;
	UW,EW,FW,TW,LW: WRKPTR;	FU,TU,LU,UICU : USEPTR;
	V : USAGE;		HDR,HPR,HNC,HCH,TOTCST,DREG,DPREM,SUPL,ADJST : REAL;	
	W,DTS,DTE : WKO;	C,C1 : CHAR;
	TUIC : UIC;		CNC : WOTYP;
	CTOT,GTOT,PTOT:USAGEREC;WKY,UIC1,UIC2 : A3;
	LINES,I,NJ:INTEGER;	NOTFND,DONE : BOOLEAN;
	FWK,TWK : INTEGER;	T1831,SC1831,WBUDG,PCBUDG : REAL;
	EC,FC,TC,LC : CCPTR;	NUSERS : INTEGER;
 
	WEEK  : ARRAY [1..2] OF CHAR;
	TOSNM : ARRAY [MUMINS..SPPLS] OF INTEGER;
	TOSNMD: ARRAY [MUMINS..SPPLS] OF INTEGER;
	FN,SYSNAME : ARRAY [1..14] OF CHAR;
	COSTCTR : ARRAY [1..5 ] OF CHAR;
	TODAY   : ARRAY [1..10] OF CHAR;
	HST : ARRAY [1..2] OF SYS;
	ANM : ARRAY [1..9] OF CHAR;
	USR : ARRAY [1..4] OF CHAR;
	URST: ARRAY [1..69] OF CHAR;
	UCC : ARRAY [1..5] OF CHAR;
	TOSNAMES : ARRAY [MUMINS..SPPLS,1..6] OF ASCII;
(*$R-*)

FUNCTION INOCT(C:A3):INTEGER;
  FUNCTION OCT(C:CHAR) : INTEGER;
    BEGIN
    IF C IN ['0'..'7'] THEN OCT := ORD(C) - ORD('0')
		       ELSE OCT := 0
    END;
  BEGIN
  INOCT := OCT(C[1])*64 + OCT(C[2])*8 + OCT(C[3]);
  END;
 
PROCEDURE SETUIC;	(**  CONVERT INPUT UIC TO APPR TYPE  **)
  BEGIN
  TUIC.U1 := INOCT(UIC1);  TUIC.U2 := INOCT(UIC2);
  END;
 
PROCEDURE HEADING(T:A30);
  BEGIN
  WRITELN(F,SYSNAME:40,'SYSTEM UTILIZATION REPORT':67);
  WRITELN(F);
  WRITELN(F,'FROM ',DTS,' TO ',DTE,'WEEK :':12,WEEK:3,T:43,'PREPARED : ':34,TODAY);
  WRITELN(F);
  END;
 
PROCEDURE DASHIT;
  BEGIN
  WRITELN(F,'----  ------  -----  -----',
	  '  ----  -----  -----  -----',
	    '  ------  -----  ------  -----  -------');
  END;
 
PROCEDURE HEAD1(N:INTEGER);
  BEGIN
  IF N = 1 THEN WRITE(F,' ':25) ELSE WRITE(F,'Cost':13,' ':22);
  WRITELN(F,'  Time-Share    Time-Share    ',
	    '  Batch         Batch          Disk                      Total');
  IF N = 1 THEN WRITE(F,'  UIC     WKO    User    ')
	   ELSE WRITE(F,'  WKO    Code        Comments      ');
  WRITELN(F,' Mins   Cost    MCTS   Cost ',
	    ' Mins   Cost   MCTS   Cost    Blks   Cost Supplies  CPH     Cost');
  END;
 
PROCEDURE FINDC(C:CCPTR; W:WRKPTR);	(*** ADD WORK ORDER TO COST CENTER LIST ***)
  VAR EW,PW,TW : WRKPTR; NOTFND : BOOLEAN;
  BEGIN
  TW := C^.CCF;  NOTFND := TRUE; PW := NIL;
  WHILE NOTFND AND (TW<>NIL) DO
    BEGIN
    NOTFND := TW^.WW < W^.WW;
    IF NOTFND THEN BEGIN PW := TW;  TW := TW^.NCW END;
    END;
  W^.NCW := TW;
  IF PW = NIL THEN C^.CCF := W
	      ELSE PW^.NCW := W;
  END;

PROCEDURE SYSWR(VAR S:USAGEREC);
  VAR 	V:USAGE;  CPH : REAL;
  BEGIN
  WITH S DO
    BEGIN
    WRITE(F,ROUND(PUSE[MUMINS]+DUSE[MUMINS]):6,CHGS[MUMINS]:8:1);
    WRITE(F,PUSE[MUMCTS]+DUSE[MUMCTS]:7:0,CHGS[MUMCTS]:7:1,
	    ROUND(PUSE[BAMINS]+DUSE[BAMINS]):6,CHGS[BAMINS]:7:1,
	    PUSE[BAMCTS]+DUSE[BAMCTS]:7:0,CHGS[BAMCTS]:7:1,
	    PUSE[DISKB ]+DUSE[DISKB ]:8:0,CHGS[DISKB ]:7:1,CHGS[SPPLS]:8:1);
    TOTCST := 0.0;
    FOR V := MUMINS TO SPPLS DO TOTCST := TOTCST + CHGS[V];
    CPH := (DUSE[MUMINS]+PUSE[MUMINS]+DUSE[BAMINS]+PUSE[BAMINS])/60.0;
    IF CPH <> 0.0 THEN CPH := (TOTCST-CHGS[SPPLS]-CHGS[DISKB])/CPH;
    WRITELN(F,CPH:7:1,TOTCST:9:2)
    END;
  END;
 
 
PROCEDURE ZEROUSE(VAR S:USAGEREC);
  VAR	V : USAGE;
  BEGIN
  WITH S DO
    BEGIN
    FOR V := MUMINS TO SPPLS DO 
      BEGIN
      CHGS[V] := 0.0;  PUSE[V] := 0.0;  DUSE[V] := 0.0;
      END
    END
  END;
 
PROCEDURE ADDUSE(VAR S,T : USAGEREC);
  VAR V : USAGE;
  BEGIN
  WITH S DO
    BEGIN
    FOR V := MUMINS TO SPPLS DO
      BEGIN
      CHGS[V] := CHGS[V] + T.CHGS[V];
      PUSE[V] := PUSE[V] + T.PUSE[V];
      DUSE[V] := DUSE[V] + T.DUSE[V];
      END;
    END
  END;

(****************   PRODUCE SMALL JOB TICKET   ***********************)
 
PROCEDURE SMJBT(V:INTEGER;  VAL:REAL;  T:WRKPTR);
 
  VAR	HI,LO : INTEGER;  SIGN : CHAR;
	HIC,LOC : ARRAY [1..3] OF CHAR;
 
  BEGIN
  IF VAL <> 0.0 THEN
    BEGIN
    SIGN := ' ';
    IF VAL < 0.0 THEN BEGIN SIGN := '-';  VAL := -VAL;  END;
    HI := TRUNC(VAL/1000.0);
    LO := ROUND(VAL - HI*1000.0);
    FOR I := 3 DOWNTO 1 DO
      BEGIN
      LOC[I] := CHR( (LO MOD 10) + ORD('0') );  LO := LO DIV 10;
      HIC[I] := CHR( (HI MOD 10) + ORD('0') );  HI := HI DIV 10;
      END;
    IF T^.WTP = CHG THEN
      WRITELN(F1,'30',T^.WCC^.CCNM:7,' 00000',T^.WW:7,COSTCTR,WKY:4,
	        V:3,V:4,SIGN,HIC,LOC);
    END;
  END;
 
 
PROCEDURE DASH2;
  BEGIN
  WRITE(F,'----  ');
  FOR I := 1 TO 2 DO WRITE(F,'------ ------ ----- -----  ');
  WRITELN(F,'------ ------  ------  ------  -----  ----  -----  ------  -----  -----');
  END;
 
 
FUNCTION MCTPERMIN (S1,S2 : SYS) : REAL;
  VAR D : REAL;
  BEGIN
  D := S1[MUMINS] + S1[BAMINS] + S2[MUMINS] + S2[BAMINS];
  IF D = 0 THEN MCTPERMIN := 0
  ELSE
    MCTPERMIN := ((S1[MUMCTS]+S1[BAMCTS]+S2[MUMCTS]+S2[BAMCTS])*1000.0)/(D*60.0)
  END;
 
FUNCTION VALIDWKO (W:WKO) : BOOLEAN;
  BEGIN
  VALIDWKO := (W[1] IN ['A'..'Z']) AND
	      (W[2] IN ['0'..'9','A'..'Z']) AND
	      (W[3] IN ['0'..'9']) AND
	      (W[4] IN ['0'..'9']) AND
	      (W[5] IN ['0'..'9']) AND
	      (W[6] IN ['0'..'9']);
  END;

(****************   MAIN LINE    *********************************)
 
BEGIN
FU := NIL;  FW := NIL;  LU := NIL; LW := NIL;  UICU := NIL;
GTOT.UW := NIL;  PTOT.UW := NIL;  HDR := 0.0;  HPR := 0.0;
FOR I := 1 TO 2 DO FOR V := MUMINS TO SPPLS DO HST[I,V] := 0.0;
RESET (F,'ACCOUNTS.DAT');
READLN(F,SYSNAME,SC1831,WBUDG,COSTCTR);
FOR V := MUMINS TO SPPLS DO READ(F,TOSNM[V],TOSCST[V],TOSDVP[V]);
FOR V := MUMINS TO SPPLS DO READ(F,TOSNMD[V],TOSCSTD[V],TOSDVD[V]);
 
TOSNAMES[MUMINS] := 'Mins  ';	TOSNAMES[MUMCTS] := 'MCTS  ';
TOSNAMES[BAMINS] := 'BaMins';	TOSNAMES[BAMCTS] := 'BaMCTS';
TOSNAMES[DISKB ] := 'Blocks';	TOSNAMES[SPPLS ] := ' $    ';
 
NEW(FC);
WITH FC^ DO 
  BEGIN
  CCNM := COSTCTR;  CCF := NIL;  CCN := NIL;  CCT := TRUE;
  END;
 
WHILE NOT EOF(F) DO		(*** READ SYSTEM WORK ORDERS **)
  BEGIN
  READLN(F,W,URST);
  NEW(TW);
  WITH TW^ DO
    BEGIN
    WW := W;  WTP := NCH;  TOTH := 0.0;  WCC := FC;  FINDC(FC,TW);
    (**FOR I := 1 TO 20 DO WC[I] := URST[I];**)
    IF FW = NIL THEN FW := TW ELSE LW^.NW := TW;
    LW := TW;
    IF W='U00000' THEN UW := TW;
    END;
  END;
 

RESET (F,'USERS.CMD','(1,1)');
WHILE NOT EOF(F) DO			(***  READ USER WORK ORDERS ***)
  BEGIN
  READLN(F,USR,URST,UCC);
  IF USR = 'USER' THEN
    BEGIN
    FOR I := 1 TO 6 DO W[I] := URST[I+11];
    IF VALIDWKO(W) THEN 
      BEGIN
      TW := FW;  NOTFND := TRUE; LW := NIL;
      WHILE NOTFND AND (TW<>NIL) DO
	BEGIN
	NOTFND := TW^.WW < W;
        IF NOTFND THEN BEGIN LW := TW;  TW := TW^.NW END
	END;
      IF TW^.WW <> W THEN
        BEGIN
	NEW (EW);
	WITH EW^ DO
	  BEGIN
	  NXU  := NIL;	NW   := TW;
	  WW := W;	TOTH := 0.0;  WTP := CHG;      NW := TW;
	  (**WC := '                    ';**)  NXU := NIL;
	  TC := FC; LC := NIL; NOTFND := TRUE;
	  WHILE NOTFND AND (TC<>NIL) DO
	    BEGIN
	    NOTFND := UCC > TC^.CCNM;
	    IF NOTFND THEN BEGIN LC := TC;  TC := TC^.CCN;  END
	    END;
	  NOTFND := TC=NIL;
	  IF NOT NOTFND THEN NOTFND := TC^.CCNM <> UCC;
	  IF NOT NOTFND THEN BEGIN FINDC(TC,EW); WCC := TC END
	  ELSE
	    BEGIN
	    NEW(EC);  WCC := EC;
	    WITH EC^ DO 
	      BEGIN
	      CCNM := UCC;  CCF := EW;  CCN := TC;  EW^.NCW := NIL;  CCT := FALSE;
	      END;
	    IF LC = NIL THEN FC := EC
			ELSE LC^.CCN := EC;
	    END;
	  END;
        IF LW=NIL THEN FW := EW ELSE LW^.NW := EW;
	END
      END
    END
  END;
 
(***   READ SUMMARY FILE  ***)
 
RESET (F,'ACCTSSUM.DAT');  READLN(F);  DTS := '      ';  NUSERS := 0;
FOR I := 1 TO 91 DO READ(F,C);  READ(F,DTE);
FOR I := 1 TO 21 DO READ(F,C);  READLN(F,WEEK);
FOR I := 1 TO  6 DO READLN(F);
IF WEEK[1] = ' ' THEN WKY[1] := '0' ELSE WKY[1] := WEEK[1];
WKY[2] := WEEK[2];   WKY[3] := DTE[2];
IF DTE[3] = '1' THEN WKY[3] := SUCC(WKY[3]);

(***********    READ IN SUMMARY RECORDS   *******************)
 
WHILE NOT EOF(F) DO
  BEGIN
  READ(F,ANM,C,C,C,UIC1,C,UIC2,C);
  FOR I := 1 TO 6 DO W[I] := ANM[I+3];
  FOR V := MUMINS TO DISKB DO READ(F,PR[V]);
  FOR V := MUMINS TO DISKB DO READ(F,DSC[V]);
  READ(F,SUPL,ADJST);  SETUIC;  NUSERS := NUSERS + 1;
  IF NOT VALIDWKO(W) THEN
    BEGIN
    IF (TUIC.U1=1) AND (TUIC.U2=6) THEN W := 'S81002' ELSE
    IF (TUIC.U1=220B) AND (TUIC.U2=0) THEN W := 'S81002' ELSE
    IF TUIC.U1 =   1  THEN W := 'S81000' ELSE
    IF TUIC.U1 =   6  THEN W := 'S81003' ELSE
    IF TUIC.U1 =   7  THEN W := 'S81005' ELSE
    IF TUIC.U1 =  11B THEN W := 'S81000' ELSE
    IF TUIC.U1 = 111B THEN W := 'S81001' ELSE
    IF TUIC.U1 = 211B THEN W := 'S81001' ELSE
    IF TUIC.U1 = 200B THEN W := 'S81000' ELSE
    IF TUIC.U1 = 311B THEN W := 'S81001' ELSE
    IF TUIC.U1 = 210B THEN W := 'T81000' ELSE
    IF TUIC.U1 = 220B THEN W := 'S81004' ELSE
    W := 'U00000'
    END;
  TW := FW; NOTFND := TRUE;
  WHILE NOTFND & (TW<>NIL) DO
    BEGIN
    NOTFND := TW^.WW <> W;
    IF NOTFND THEN TW := TW^.NW;
    END;
  IF NOTFND THEN TW := UW;   
  TW^.TOTH := TW^.TOTH + (PR[MUMINS]+DSC[MUMINS]+PR[BAMINS]+DSC[BAMINS]) / 60.0;
  NEW (TU);
  WITH TU^ DO
    BEGIN
    IF FU = NIL THEN FU := TU;
    IF LU <> NIL THEN LU ^.NU := TU;
    UW := TW;  LU := TU;  NU := NIL;  U := TUIC;  UNM := ANM;
    UICU := TU;
    NXW := TW^.NXU;
    TW^.NXU := TU;
    CHGS[SPPLS] := SUPL+ADJST;  PUSE[SPPLS] := SUPL*100.0;
    DUSE[SPPLS] := ADJST*100.0;
    FOR V := MUMINS TO DISKB DO 
      BEGIN
      PUSE[V] := ROUND(PR[V]/TOSDVP[V]+0.49);  DUSE[V] := ROUND(DSC[V]/TOSDVD[V]+0.49);
      HST [1,V] := HST[1,V] + PR[V];
      HST [2,V] := HST[2,V] + DSC[V];
      END;
    HST[1,SPPLS] := HST[1,SPPLS] + CHGS[SPPLS];
    FOR V := MUMINS TO DISKB DO
      CHGS[V] := PUSE[V]*TOSCST[V] + DUSE[V]*TOSCSTD[V];
    END;
  END;
WRITELN(NUSERS,' User Accounts with charges.');

(*****     PRODUCE NCH/CHG USAGE SUMMARIES    ***)
 
REWRITE(F,'ACCANAL.LST');
DATE(TODAY);
NOTFND := TRUE;
FOR CNC := CHG TO NCH DO
  BEGIN
  ZEROUSE(GTOT);   LINES := LINESPERPAGE;
  TU := FU;
  WHILE TU <> NIL DO
    IF TU^.UW^.WTP <> CNC THEN
      REPEAT
	TU := TU^.NU;
	DONE := TU=NIL;
	IF NOT DONE THEN DONE := TU^.UW^.WTP = CNC;
	UNTIL DONE
    ELSE
      BEGIN
      ZEROUSE(PTOT);
      IF LINES + 2 > LINESPERPAGE THEN
	BEGIN
	IF NOTFND THEN NOTFND := FALSE
		  ELSE PAGE(F);
	IF CNC=CHG THEN HEADING('  CHARGEABLE USAGE / CHARGES  ')
	     	   ELSE HEADING('NON-CHARGEABLE USAGE / CHARGES');
	HEAD1(1);  WRITE(F,'------- ------ ---------  ');  DASHIT;  LINES := 9;
	END;
      TW := TU^.UW;
      TW^.WCC^.CCT := TRUE;
      NJ := TU^.U.U1;
      REPEAT 
	WITH TU^ DO WRITE(F,U.U1:3:O,',',U.U2:3:O,UW^.WW:7,' ',UNM:9);
        SYSWR(TU^);  ADDUSE(GTOT,TU^);  ADDUSE(PTOT,TU^);  UICU := TU;  LINES := SUCC(LINES);
	TU := TU^.NU;
	DONE := TU=NIL;
	IF NOT DONE THEN DONE := (TU^.UW <> TW) ! (TU^.U.U1<>NJ);
	UNTIL DONE;
      END;
  WRITE(F,'-------------- ---------  ');  DASHIT;
  WRITE(F,'Total Usage/Charges All ');  SYSWR(GTOT);
  IF CNC=CHG THEN WITH GTOT DO
    BEGIN	(*** REPORT FINAL FINDINGS ***)
    WRITELN('     TOS   Units      Descr     Dollars');
    WRITELN('     ---  ------  ------------  -------');
    FOR V := MUMINS TO SPPLS DO
      BEGIN
      WRITE(TOSNM[V],PUSE[V]:8:0,'  ');
      IF V = DISKB THEN WRITE('DR0:  ') ELSE
      IF V = SPPLS THEN WRITE('Suppls') ELSE WRITE('Prime ');
      WRITELN(TOSNAMES[V],PUSE[V]*TOSCST[V]:9:2);
      END;
    FOR V := MUMINS TO SPPLS DO
      BEGIN
      WRITE(TOSNMD[V],DUSE[V]:8:0,'  ');
      IF V = DISKB THEN WRITE('DR1:  ') ELSE
      IF V = SPPLS THEN WRITE('Adjust') ELSE WRITE('Disc  ');
      WRITELN(TOSNAMES[V],DUSE[V]*TOSCSTD[V]:9:2);
      END;
    WRITELN('     ---  ------  ------------  -------');
    WRITELN('                   Total',TOTCST:15:2);
    END;
  IF CNC = CHG THEN HCH := TOTCST
	       ELSE HNC := TOTCST;
  END;   (**  FOR  **)

(**************   GENERATE WORK ORDER SUMMARY   *********************)
 
TC := FC;	ZEROUSE(GTOT);
FOR V := MUMINS TO DISKB DO BEGIN PR[V] := 0.0;  DSC[V] := 0.0 END;
FN := 'ACCSTUFF.DAT  ';
FN[6] := SYSNAME[1];  FN[7] := SYSNAME[12];  FN[8] := SYSNAME[13];
REWRITE(F1,FN);  LINES := LINESPERPAGE;
TW := FW;  ZEROUSE(CTOT);
WHILE TW <> NIL DO
  BEGIN
  TU := TW^.NXU;  ZEROUSE(PTOT);
  IF TU <> NIL THEN
    BEGIN
    IF LINES + 4 > LINESPERPAGE THEN
      BEGIN
      PAGE(F);
      HEADING('   WORK ORDER USAGE/CHARGES   ');
      HEAD1(2);
      WRITE(F,'------  -----  -------------------  ');  DASHIT;
      LINES := 7;
      END;
    ANM := TU^.UNM;
    WHILE TU <> NIL DO
      BEGIN
      ADDUSE(PTOT,TU^);
      TU := TU^.NXW;
      END;
    PTOT.UW := TW;
    WITH TW^ DO WRITE(F,WW,WCC^.CCNM:7,'  ',ANM,' ':10);  SYSWR(PTOT);
    LINES := LINES + 1;
    TW^.TOTC := TOTCST;
    WITH PTOT DO
      BEGIN
      FOR V := MUMINS TO SPPLS DO SMJBT(TOSNM [V],PUSE[V],TW);
      FOR V := MUMINS TO SPPLS DO SMJBT(TOSNMD[V],DUSE[V],TW);
      END;
    ADDUSE(GTOT,PTOT);
    END;
  TW := TW^.NW;
  END;
WRITE(F,'------  -----  -------------------  '); DASHIT;
WRITE(F,'  *********   Total   *********   '); SYSWR(GTOT);
 
WRITELN(F1,'--');
TW := FW;  SUPL := 0.0;
WHILE TW <> NIL DO  (**  OUTPUT WORK USAGE SUMMARY  **)
  BEGIN
  WITH TW^ DO IF ABS(TOTC) > 0.01 THEN WRITELN(F1,WW,TOTH:10:1,TOTC:10:2);
  IF TW^.WTP = CHG THEN SUPL := SUPL + TW^.TOTH;
  TW := TW^.NW
  END;
 

 
(*********     UPDATE AND PRODUCE HISTORY LIST/REPORT      **************)
 
REWRITE(F1,'ACCHSTRY.DAT',,,[APPEND]);
WRITE(F1,WEEK);
NOTFND := TRUE;
FOR I := 1 TO 2 DO
  BEGIN
  HST[I,MUMINS] := HST[I,MUMINS]/60.0;
  HST[I,BAMINS] := HST[I,BAMINS]/60.0;
  HST[I,MUMCTS] := HST[I,MUMCTS]/1000.0;
  HST[I,BAMCTS] := HST[I,BAMCTS]/1000.0;
  HST[I,DISKB ] := HST[I,DISKB ]/1000.0;
  END;
FOR I := 1 TO 2 DO
  BEGIN
  FOR V := MUMINS TO DISKB DO WRITE(F1,HST[I,V]:8:3);
  END;
WRITELN(F1,HST[1,SPPLS]:8:2,SUPL:8:1,HNC:8:1,HCH:9:2);
 
RESET (F1,'ACCHSTRY.DAT');
PAGE(F);
FOR I := 1 TO 2 DO FOR V := MUMINS TO SPPLS DO HST[I,V] := 0.0;  
DREG := 0.0;  DPREM := 0.0;  SUPL := 0.0;  HPR := 0.0;
HEADING('           HISTORY            ');
WRITELN(F,'PRIME':20,'DISCOUNT':28,'DISK':21,'CHARGES':52);
WRITELN(F,' ':6,'-------------------------',
	  '  -------------------------',
	  '  -------------',
	  '  ---------------------------':58);
WRITE  (F,' ':5);
FOR I := 1 TO 2 DO WRITE(F,'   TS     TS    Ba    Ba   ');
WRITELN(F,'   DR0    DR1    Adjs    Chgbl MCT Per');
WRITE(F,'Week ');
FOR I := 1 TO 2 DO WRITE(F,'   Hrs   KMCT   Hrs  KMCT  ');
WRITELN(F,'  Kblks  Kblks   Supp    Hours   Min   CPH   Nonch   Recov  Total  %Budg');
DASH2; TWK := 0;
WHILE NOT EOF(F1) DO 
  BEGIN
  READ(F1,FWK);
  FOR V := MUMINS TO DISKB DO
    BEGIN
    READ(F1,PR[V]);
    HST[1,V] := HST[1,V] + PR[V];
    END;
  FOR V := MUMINS TO SPPLS DO
    BEGIN 
    READ(F1,DSC[V]);
    HST[2,V] := HST[2,V] + DSC[V]
    END;
  READ(F1,HDR,HNC,HCH);
  DREG  := DREG + HNC;
  DPREM := DPREM + HCH;
  HPR   := HPR   + HDR;
  WRITE(F,FWK:3,' ');
  WRITE(F,PR [MUMINS]:8:1,PR [MUMCTS]:7:1,PR [BAMINS]:6:1,PR [BAMCTS]:6:1);
  WRITE(F,DSC[MUMINS]:8:1,DSC[MUMCTS]:7:1,DSC[BAMINS]:6:1,DSC[BAMCTS]:6:1);
  WRITE(F,PR[DISKB]:8:1,DSC[DISKB]:7:1,DSC[SPPLS]:8:1);
  IF FWK=TWK THEN TWK := FWK-1;
  WRITELN(F,HDR:8:1,MCTPERMIN(PR,DSC):7:2,
  	   (HCH-DSC[SPPLS])/HDR:6:1,
  	   HNC:7:0,HCH:8:0,HNC+HCH:8:0,100.0*(HCH-DSC[SPPLS])/((FWK-TWK)*WBUDG):6:1);
  TWK := FWK;
  END;
DASH2;
 
WRITE(F,'Tot',' ');
FOR I := 1 TO 2 DO
  BEGIN
  WRITE(F,HST[I,MUMINS]:8:0,HST[I,MUMCTS]:7:0,HST[I,BAMINS]:6:0,HST[I,BAMCTS]:6:0);
  FOR V := MUMINS TO BAMCTS DO HST[I,V] := HST[I,V]/FWK;
  END;
WRITE(F,HST[1,DISKB]:8:0,HST[2,DISKB]:7:0,HST[2,SPPLS]:8:1);
WRITELN(F,HPR:8:1,MCTPERMIN(HST[1],HST[2]):7:2,
	  (DPREM-HST[2,SPPLS])/HPR:6:1,
	  DREG:7:0,DPREM:8:0,DREG+DPREM:8:0,100.0*(DPREM-HST[2,SPPLS])/(TWK*WBUDG):6:1);
 
WRITE(F,'Avg',' ');
FOR I := 1 TO 2 DO
  WRITE(F,HST[I,MUMINS]:8:1,HST[I,MUMCTS]:7:1,HST[I,BAMINS]:6:1,HST[I,BAMCTS]:6:1);
WRITE(F,HST[1,DISKB]/FWK:8:1,HST[2,DISKB]/FWK:7:1,HST[2,SPPLS]/FWK:8:1);
WRITELN(F,HPR/FWK:8:1,DREG/FWK:20:0,DPREM/FWK:8:0,(DREG+DPREM)/FWK:8:0);

(******   GENERATE CLEAN-UP COMMAND FILE   ********)
 
REWRITE(F1,'ACCCLEAN.CMD');
WRITELN(F1,'[1,200]ACCTSSUM.', WKY,'=ACCTSSUM.DAT/RE');
WRITELN(F1,'[1,200]ACCTSSES.', WKY,'=ACCTSSES.DAT/RE');
WRITELN(F1,'[1,200]ACCDISKA.', WKY,'=ACCDISKA.DAT/RE');
WRITELN(F1,'[1,201]SALLOG.',   WKY,'=[1,1]SAL.LOG/RE');
WRITELN(F1,'[1,200]MONEY.',    WKY,'=MONEY.LOG/RE');
WRITELN(F1,'[1,200]PDSUPF.',   WKY,'=[1,200]PDSUPF.DAT/RE');
WRITELN(F1,'[1,200]USERS.',    WKY,'=[1,200]USERS.CMD/RE');
WRITELN(F1,'[1,200]ACCANAL.' , WKY,'=ACCANAL.LST/RE');
WRITELN(F1,'[1,200]ACCCOMBO.' ,WKY,'=ACCCOMBO.DAT/RE');
WRITELN(F1,'[1,200]ACCTAPE.' , WKY,'=ACCTAPE.DAT/RE');
WRITELN(F1,'[1,200]',FN:9,     WKY,'=',FN:12,'/RE');
 
WRITELN('ACCANAL -- ALL DONE');
END.