(*
 
	Component :	ACCCOMBO.PAS -- Accounting combined systems summary.
 
	Date:		February 22, 1980
	Current:	July 29, 1980		(10000 as 1830 work order)
			September 18, 1980	Minerva version
			October 7, 1980   	Biometrics version
 
	Author:		Tom Mathieu
			Battelle-Northwest
			Box 999
			Richland, Washington 99352
			(509) 375-3711
 
	Source:		Swedish Pascal
 
	Calling Seq:	RUN [11,1]ACCOMBO
 
	Inputs:		ACCSTxxx.nnn
			ACCQUART.DAT
			ACCYTD.DAT
			ACCMWO.DAT
 
	Outputs:	ACCQUART.DAT
			ACCYTD.DAT
			ACCMWO.DAT
			ACCCOMBO.nnn
			ACCTAPE.nnn
 
*)

PROGRAM COMBO(TTY);
 
CONST	LPPG = 60;		(** LINES PER PAGE  **)
 
TYPE	WRKORD = ARRAY[1..6]OF CHAR;
	DEPTID = ARRAY[1..4]OF CHAR;
	ORGID  = ARRAY[1..5]OF CHAR;
	SYSTEM = (MINERV,TOTAL);
	TOS    = (MINS,MCTS,DISKB);
 
	SUSE   = RECORD
		HRS,YHRS,CHG,YCHG : REAL
		END;
 
	USAGE   = ARRAY [MINERV..MINERV] OF SUSE;
	ACCTPTR = ^ACCT;
	DEPTR   = ^DEPT;
	PRJPTR  = DEPTR;
 
	DEPT = RECORD
		DID : DEPTID;
		D1830,D1831 : USAGE;
		WP : ACCTPTR;
		HASD : BOOLEAN;
		ND  : DEPTR
		END;
 
	WRKORDS = RECORD
		WKO : WRKORD;
		CHBL,MKDEL : BOOLEAN;
		RESP : ARRAY [1..3] OF CHAR;
		ORG  : ORGID;
		DTLSTUSED : WRKORD
		END;
 
	ACCT = RECORD
		W:WRKORDS;
		USES : USAGE;
		PROJ : PRJPTR;
		NPJ  : ACCTPTR;
		HASDATA : BOOLEAN;
		NDP  : DEPTR;
		NA : ACCTPTR
		END;
 
	PROJECT = RECORD
		PTL : ARRAY[1..16] OF CHAR;
		WP  : ACCTPTR;
		NP  : PRJPTR
		END;
 

VAR	FA,TA,PA : ACCTPTR;	F,F1:TEXT;
	W1       : WRKORD;	X,Y,H1,C1 : REAL;
	PF,P : PRJPTR;		S:SYSTEM;
	T : TOS;		CH : CHAR;
	NF,CHARGE : BOOLEAN;	U1830,U1831,PTOT,GTOT : USAGE;
	TOT : SUSE;		FWK,WEEK,I,TPRECS,LINES : INTEGER;
	TOTP : PRJPTR;		TOTA : ACCTPTR;
	TD,FD : DEPTR;		WF,WFO : FILE OF WRKORDS;
 
	TP	: ARRAY [1.. 3] OF CHAR;
	FNM	: ARRAY [MINERV..MINERV,1..14] OF CHAR;
	FUIC    : ARRAY [MINERV..MINERV,1.. 5] OF CHAR;
	SYSNAME : ARRAY [MINERV..TOTAL ,1.. 6] OF CHAR;
	SC1831  : ARRAY [MINERV..MINERV] OF REAL;
	J1	: ARRAY [1..16] OF CHAR;
	TPREC	: ARRAY [1..45] OF CHAR;
	TODAY	: ARRAY [1..10] OF CHAR;
	YR	: ARRAY [1.. 2] OF CHAR;
	TDY     : ARRAY [1.. 6] OF CHAR;
	USR	: ARRAY [1.. 4] OF CHAR;
	URST	: ARRAY [1..69] OF CHAR;
	FNM1	: ARRAY [1..14] OF CHAR;
	UCC	: ORGID;
 
	T30,T31,TT,Q30,Q31,QT : ARRAY [MINERV..TOTAL] OF REAL;
	D1831,WBUDGET,T1831 : REAL;
 
	MSTS : ARRAY [MINERV..TOTAL] OF RECORD
		MHRS,MDOL : ARRAY [1..13] OF REAL
		END;
	EOMWK: ARRAY [1..12] OF SET OF 1..53;
	MON  : INTEGER;

PROCEDURE ZEROUSE(VAR U : USAGE);
  VAR S : SYSTEM;
  BEGIN
  FOR S := MINERV TO MINERV DO WITH U[S] DO
    BEGIN
    CHG := 0.0;  HRS := 0.0;  YHRS := 0.0;  YCHG := 0.0;
    END;
  END;
 

PROCEDURE ADDUSE(VAR U,U1 : USAGE);
  VAR S : SYSTEM;
  BEGIN
  FOR S := MINERV TO MINERV DO WITH U[S] DO
    BEGIN
    CHG := CHG + U1[S].CHG;
    HRS := HRS + U1[S].HRS;
    YCHG := YCHG + U1[S].YCHG;
    YHRS := YHRS + U1[S].YHRS
    END;
  END;
 
 
PROCEDURE NEWACCT;
  VAR TD,LD,D : DEPTR;  NF : BOOLEAN;  WD : DEPTID;  I : INTEGER;
  BEGIN
  NEW(TA);
  WITH TA^ DO
    BEGIN
    PROJ := NIL;  W := WF^;  NPJ := NIL;  ZEROUSE(USES);  HASDATA := FALSE;
    FOR I := 1 TO 4 DO WD[I] := W.ORG[I];
    TD := FD;  NF := TRUE;  LD := NIL;
    WHILE NF AND (TD<>NIL) DO
      BEGIN
      NF := TD^.DID < WD;
      IF NF THEN BEGIN LD := TD; TD := TD^.ND;  END;
      END;
    NF := TD=NIL;
    IF NOT NF THEN NF := TD^.DID <> WD;
    IF NF THEN 
      BEGIN
      NEW (D);
      WITH D^ DO
	BEGIN
	ZEROUSE(D1830);  ZEROUSE(D1831);
	DID := WD;  ND := TD;  TD := D;  WP := NIL;  HASD := FALSE;
	IF LD = NIL THEN FD := D ELSE LD^.ND := D;
	END;
      END;
    TA^.NDP := TD;
    END;
  END;
 
 

PROCEDURE FINDW;
  VAR	PA,P1 : ACCTPTR;  NOTFND : BOOLEAN;
  BEGIN
  TA := FA;  NOTFND := TRUE;  PA := NIL; P1 := NIL;
  WHILE NOTFND & (TA<>NIL) DO
    BEGIN
    NOTFND := TA^.W.WKO <> W1;
    IF NOTFND THEN
    IF TA^.W.WKO > W1 THEN BEGIN P1 := TA;  TA := NIL END ELSE
      BEGIN
      PA := TA;  TA := TA^.NA;
      END;
    END;
  IF NOTFND THEN (** CREATE A NEW ONE  **)
    BEGIN
    WITH WF^ DO 
      BEGIN
      WKO := W1;  CHBL := CHARGE;  ORG := UCC;
      END;
    NEWACCT;
    IF PA = NIL THEN FA := TA ELSE PA^.NA := TA;
    TA^.NA := P1;
    END;
  END;
 
 
PROCEDURE WRITEUSE(VAR U : SUSE);
  VAR I1,I2 : INTEGER;
  BEGIN
  I1 := ROUND(U.CHG);  I2 := ROUND(U.YHRS);
  WITH U DO WRITE(F,HRS:7:1,I1:6,I2:5,YCHG:9:2);
  WITH TOT DO
    BEGIN
    HRS := HRS + U.HRS;		CHG := CHG + U.CHG;
    YHRS := YHRS + U.YHRS;	YCHG := YCHG + U.YCHG;
    END;
  END;
 
 
FUNCTION VALIDWKO (W:WRKORD) : 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;

PROCEDURE DETAILLN(D:DEPTID; VAR U:USAGE;  G1831:BOOLEAN);
  VAR S : SYSTEM;
  BEGIN
  WITH TOT DO
    BEGIN
    HRS := 0.0;  YHRS := 0.0;	D1831 := 0;
    CHG := 0.0;  YCHG := 0.0;	T1831 := 0;
    END;
  WRITE(F,D:5,' ');
  FOR S := MINERV TO MINERV DO  WITH U[S] DO
    BEGIN
    WRITEUSE(U[S]);
    IF G1831 THEN
      BEGIN
      D1831 := D1831 + CHG*SC1831[S];  T1831 := T1831 + YCHG*SC1831[S]
      END;
    END;
  WRITEUSE(TOT);  WRITELN(F,D1831:7:0,T1831:7:0);
  END;
 
 
PROCEDURE DETAILLINE(W : WRKORD;  O : ORGID; VAR U :USAGE);
  VAR S : SYSTEM;
  BEGIN
  WITH TOT DO
    BEGIN
    HRS := 0.0;  YHRS := 0.0;	D1831 := 0.0;
    CHG := 0.0;  YCHG := 0.0;	T1831 := 0.0;
    END;
  WRITE(F,W,O:7);
  FOR S := MINERV TO MINERV DO WITH U[S] DO 
    BEGIN
    WRITEUSE(U[S]);
    IF W[1]='Y' THEN  
      BEGIN
      D1831 := D1831 + CHG*SC1831[S];
      T1831 := T1831 + YCHG*SC1831[S];
      END;
    END;
  WRITEUSE(TOT);  WRITELN(F,D1831:7:0,T1831:7:0);
  END;
 

PROCEDURE DASHIT(FL:BOOLEAN);
  VAR I:INTEGER; S:SYSTEM;
  BEGIN
  WRITE(F,'------');  IF FL THEN WRITE(F,'  -----');
  FOR S := MINERV TO TOTAL DO WRITE(F,'  ----- ----- ---- --------');
  WRITELN(F,'  -----  -----')
  END;
 
PROCEDURE HEADING(FL:BOOLEAN);
  VAR S:SYSTEM;
  BEGIN
  WRITE(F,'      ');  IF FL THEN WRITE(F,'       ');
  FOR S := MINERV TO TOTAL DO WRITE(F,SYSNAME[S]:17,' ':10);
  WRITELN(F,'  1831 Surchrg');
  WRITE(F,'      ');  IF FL THEN WRITE(F,'       ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'  -------------------------');
  WRITELN(F,'  ------------');  WRITE(F,'      ');  IF FL THEN WRITE(F,'       ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'    Current   Qrtr-to-Date ');
  WRITELN(F,'   Curr  Q-t-D');
  IF FL THEN WRITE(F,'  WKO    ORG ') ELSE WRITE(F,' DEPT ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'   Hrs   Chgs  Hrs   Chgs  ');
  WRITELN(F,'   Chrg   Chrg');
  DASHIT(FL);
  END;
 
PROCEDURE DEPTSUM(FL:BOOLEAN;  VAR TOT:USAGE);
  VAR TYP : ARRAY [BOOLEAN] OF DEPTID;
  BEGIN
  IF FL THEN PAGE(F) ELSE BEGIN WRITELN(F); WRITELN(F); WRITELN(F) END;
  TYP[TRUE] := '1830';  TYP [FALSE] := '1831';  ZEROUSE(TOT);
  WRITELN(F,TYP[FL]:10,' COMPUTER USAGE BY DEPARTMENT FROM WEEK',FWK:3,' TO WEEK',
  	    WEEK:3,TODAY:16);
  WRITELN(F);  WRITELN(F);  HEADING(FALSE);  TD := FD;
  WHILE TD <> NIL DO
    BEGIN
    IF TD^.DID <> 'D7HB' THEN
    IF FL THEN BEGIN DETAILLN(TD^.DID,TD^.D1830,FALSE);  ADDUSE(TOT,TD^.D1830) END
	  ELSE BEGIN DETAILLN(TD^.DID,TD^.D1831,TRUE );  ADDUSE(TOT,TD^.D1831) END;
    TD := TD^.ND;
    END;
  DASHIT(FALSE);  DETAILLN(TYP[FL],TOT,FALSE);
  END;

(*****************************************************************)
 
		(****    MAIN LINE    ****)
 
BEGIN
FA := NIL;   FD := NIL;
SYSNAME[MINERV] := 'BIO 70';
SYSNAME[TOTAL]  := 'TOTAL ';
 
FUIC[MINERV] := '(1,5)';  FNM[MINERV] := 'ACCSTB70.DAT  ';
 
RESET(WF,'ACCMWO.DAT');
WHILE NOT EOF(WF) DO
  BEGIN
  NEWACCT;  GET(WF);
  IF PA = NIL THEN FA := TA ELSE PA^.NA := TA;
  PA := TA;
  END;
 
RESET(F,'USERS.CMD','(1,1)');  CHARGE := TRUE;
WHILE NOT EOF(F) DO
  BEGIN
  READLN(F,USR,URST,UCC);
  IF USR='USER' THEN
    BEGIN
    FOR I := 1 TO 6 DO W1[I] := URST[I+11];
    IF VALIDWKO(W1) THEN FINDW
    END
  END;
 
RESET(F,'ACCYTD.DAT');
WHILE NOT EOF(F) DO
  BEGIN
  READ(F,W1);
  FINDW;
  WITH TA^ DO 
    FOR S := MINERV TO MINERV DO READ(F,USES[S].YHRS,USES[S].YCHG);
  TA^.HASDATA := TRUE;
  END;
 
TP := 'DAT';
% WRITE('Enter suffix for this accounting period (WWY) > ');  BREAK;   READLN;  READ(TP);  \
FOR S := MINERV TO MINERV DO  FOR I := 1 TO 3 DO FNM[S,I+9] := TP[I]; 
FNM1 := 'ACCTAPE.DAT   ';
FOR I := 1 TO 3 DO FNM1[I+8] := TP[I];
REWRITE(F1,FNM1);
TPRECS := 0;
WEEK   := 0;
WBUDGET:= 0;
EOMWK[1] := [1,2,3,4];		EOMWK[2] := [5,6,7,8,9];
EOMWK[3] := [10,11,12,13];	EOMWK[4] := [14,15,16,17,18];
EOMWK[5] := [19,20,21,22];	EOMWK[6] := [23,24,25,26];
EOMWK[7] := [27,28,29,30];	EOMWK[8] := [31,32,33,34,35];
EOMWK[9] := [36,37,38,39];	EOMWK[10] := [40,41,42,43];
EOMWK[11] := [44,45,46,47,48];	EOMWK[12] := [49,50,51,52,53];

(*************   PROCESS THIS PERIOD'S DATA   *************************)
DATE (TODAY);
FOR I := 1 TO 2 DO TDY[I] := TODAY[I+2];
FOR I := 3 TO 4 DO TDY[I] := TODAY[I+3];
FOR I := 5 TO 6 DO TDY[I] := TODAY[I+4];
WITH MSTS[TOTAL] DO 
   FOR I := 1 TO 13 DO BEGIN MHRS[I] := 0.0;  MDOL[I] := 0.0 END;
FOR S := MINERV TO MINERV DO
  BEGIN
  RESET(F,FNM[S],FUIC[S]);  CHARGE := FALSE;
  IF IORESULT(F) = 1 THEN BEGIN
    LOOP	(***   READ IN TAPE RECORDS   ***)
      READLN(F,TPREC);
      EXIT IF TPREC[1] = '-';
      WRITELN(F1,TPREC);
      TPRECS := SUCC(TPRECS);
      I := (ORD(TPREC[29])-ORD('0'))*10 + ORD(TPREC[30]) - ORD('0');
      IF I > WEEK THEN WEEK := I;
      END;
    WHILE NOT EOF(F) DO	(***  READ IN WORK ORDER USAGE   ***)
      BEGIN
      READ(F,W1,H1,C1);  
      IF W1[1] IN ['S','T','U'] THEN UCC := 'D7H8A' ELSE UCC := 'UNKN ';
      FINDW;
      WITH TA^ DO
	BEGIN
	USES[S].YHRS := USES[S].YHRS + H1;
	USES[S].YCHG := USES[S].YCHG + C1;
	USES[S].CHG := C1;
	USES[S].HRS := H1;
	HASDATA := TRUE;  W.DTLSTUSED := TDY;
	END;
      END;
    END ELSE WRITELN('No data for system ',SYSNAME[S],'  ',FUIC[S],FNM[S],IORESULT(F));
  WITH MSTS[S] DO
    BEGIN
    FOR I := 1 TO 13 DO BEGIN MHRS[I] := 0.0;  MDOL[I] := 0.0 END;
    RESET(F,'ACCOUNTS.DAT',FUIC[S]);
    FOR I := 1 TO 14 DO READ(F,CH);  READ(F,SC1831[S],X);
    SC1831[S] := SC1831[S] - 1.0;  WBUDGET := WBUDGET + X;
    RESET(F,'ACCHSTRY.DAT',FUIC[S]);
    WHILE NOT EOF (F) DO
      BEGIN
      READ(F,FWK,X,X,X,X,X,X,X,X,X,X,X,H1,X,C1);	MON := 1;
      WHILE NOT (FWK IN EOMWK[MON]) DO MON := SUCC(MON);
      MHRS[MON] := MHRS[MON] + H1;   MDOL[MON] := MDOL[MON] + C1;
      MHRS[13]  := MHRS[13]  + H1;   MDOL[13]  := MDOL[13]  + C1;
      WITH MSTS[TOTAL] DO
	BEGIN
        MHRS[MON] := MHRS[MON] + H1;   MDOL[MON] := MDOL[MON] + C1;  
        MHRS[13]  := MHRS[13]  + H1;   MDOL[13]  := MDOL[13]  + C1;
	END;
      END;
    END;
  END;

(************  PROCESS PROJECTS FILE  *****************************)
 
%RESET(F,'PROJECTS.DAT');
PF := NIL;
WHILE NOT EOF(F) DO
  BEGIN
  READLN(F,J1);
  NEW(P);  P^.NP := PF;  PF := P; P^.WP := NIL;  P^.PTL := J1;  PA := NIL;
  LOOP
    READLN(F,W1);
    EXIT IF W1[1]='-'; 	\
 
TD := FD;
WHILE TD <> NIL DO
    BEGIN
    PA := NIL;
    TA := FA;  NF := TRUE;	(*** SEE IF WE HAVE ANY  ***)
    WHILE (TA <> NIL) DO
      BEGIN
      IF TA^.NDP = TD THEN
        BEGIN
        TA^.PROJ := TD;
        IF PA = NIL THEN TD^.WP := TA  ELSE PA^.NPJ := TA;
	TD^.HASD := TD^.HASD OR TA^.HASDATA;
        PA := TA;
        END;
      TA := TA^.NA;
      END;
    TD := TD^.ND;
    END;
 
(**********   LINK IN ALL OTHER WKOS   **************)
 
PF := FD;
P := PF;
WHILE P^.ND <> NIL DO P := P^.ND;
NEW (P^.ND);
WITH P^.ND^ DO
  BEGIN
  % PTL := 'ALL OTHER WKOS  ';  NP := NIL;  WP := NIL; \
  DID := 'OTHR';  WP := NIL;  ND := NIL;
  END;
TA := FA;  PA := NIL;
WHILE TA <> NIL DO
  BEGIN
  IF TA^.W.WKO[1] = 'Y' 	        THEN ADDUSE(TA^.NDP^.D1831,TA^.USES) ELSE
  IF NOT(TA^.W.WKO[1] IN ['S','T','U']) THEN ADDUSE(TA^.NDP^.D1830,TA^.USES);
  IF (TA^.PROJ = NIL) AND TA^.HASDATA THEN
    BEGIN
    IF PA = NIL THEN P^.ND^.WP := TA ELSE PA^.NPJ := TA;
    PA := TA;
    END;
  TA := TA^.NA
  END;
IF PA = NIL THEN P^.ND := NIL;	(*** NONE FOUND ***)
 
(*******   SET UP ONE FOR TOTALS   *********)
 
NEW(TOTP);
(***  P^.ND^.ND := TOTP  ***)
WITH TOTP^ DO
  BEGIN
  %  PTL := 'TOTALS FOR PROJS';  NP := NIL;  WP := NIL;	\
  DID := 'TOT ';  WP := NIL;  ND := NIL;
  END;
(***   GENERATE OUTPUT   ***)
 
FNM1 := 'ACCCOMBO.LST  ';
FOR I := 1 TO 3 DO FNM1[I+9] := TP[I];
REWRITE(F,FNM1);
FWK := ((WEEK-1) DIV 13)*13 + 1;
P := PF;
WHILE P <> NIL DO
  BEGIN
  IF P^.HASD THEN BEGIN
  ZEROUSE(PTOT);	LINES := LPPG;
  IF P <> TOTP THEN  (***  CREATE A TOTAL LINE   ***)
    BEGIN
    NEWACCT;
    IF TOTP^.WP = NIL THEN TOTP^.WP  := TA
		      ELSE TOTA^.NPJ := TA;
    TOTA := TA;
    % FOR I := 1 TO 6 DO TOTA^.W.WKO[I] := P^.PTL[I];	\
    TOTA^.W.WKO := '      ';
    TOTA^.W.ORG := '     ';
    END;
  TA := P^.WP;
  WHILE TA <> NIL DO	
    BEGIN
    IF LINES+4 > LPPG THEN
      BEGIN
      IF P <> PF THEN PAGE(F);
      WRITELN(F,P^.DID:6,'DEPARTMENT COMPUTER USAGE SUMMARY FROM WEEK':46,FWK:3,' THROUGH WEEK',WEEK:3,
      TODAY:14);  WRITELN(F);  HEADING(TRUE);  LINES := 5;
      END;
    WITH TA^ DO DETAILLINE(W.WKO,W.ORG,USES);
    ADDUSE(PTOT,TA^.USES);	LINES := LINES + 1;
    TA := TA^.NPJ;
    END;
  
  DASHIT(TRUE);
  DETAILLINE('TOTAL ','     ',PTOT);
  IF P <> TOTP THEN
    WITH TOTA^ DO
      FOR S := MINERV TO MINERV DO  WITH USES[S] DO
	BEGIN
	HRS := PTOT[S].HRS;	YHRS := PTOT[S].YHRS;
	CHG := PTOT[S].CHG;	YCHG := PTOT[S].YCHG;
	END;
  END;  (*** HAS DATA ***)
  P := P^.ND;
  END;
 

(**********    1830/1831 USAGE TOTALS     ******************)
 
DEPTSUM(TRUE,U1830);		(**  FIRST 1830  **)
(** DEPTSUM(FALSE,U1831);		(**   THEN 1831  **)
WRITELN(F);  WRITELN(F);  WRITELN(F);
WRITELN(F,'1830/1814 COMPUTER USAGE FROM WEEK':40,FWK:3,' THROUGH WEEK',WEEK:3,TODAY:14);
WRITELN(F);  WRITELN(F);
HEADING(FALSE);
DETAILLN('1830',U1830,FALSE);
DETAILLN('1831',U1831,TRUE);
DASHIT(FALSE);
ADDUSE(U1830,U1831);
DETAILLN('TOTL',U1830,FALSE);
WRITELN(F);  WRITELN(F);  WRITELN(F,'     Per cent of quarter to date budget -- ',
   (TOT.YCHG*50.0)/(WBUDGET*(WEEK-FWK+1)):7:2);
 
(*************   MONTHLY SUMMARY   ******************************)
 
PAGE(F);
WRITELN(F,'MONTHLY USAGE/RECOVERY SUMMARY':34,TODAY:14);
WRITELN(F);
WRITE(F,'     ');  FOR S := MINERV TO TOTAL DO WRITE(F,SYSNAME[S]:14,' ':6);  WRITELN(F);
WRITE(F,'     ');  FOR S := MINERV TO TOTAL DO WRITE(F,'   -----------------');  WRITELN(F,'%':6);
WRITE(F,'Month');  FOR S := MINERV TO TOTAL DO WRITE(F,'    Hours    Recov  ');  WRITELN(F,'   Budget');
WRITE(F,'-----');  FOR S := MINERV TO TOTAL DO WRITE(F,'   ------  ---------');  WRITELN(F,'   ------');
FOR I := 1 TO MON DO
  BEGIN
  WRITE(F,(I+8) MOD 12 + 1:4,' ');
  FOR S := MINERV TO TOTAL DO
    WITH MSTS[S] DO
      WRITE(F,MHRS[I]:9:1,MDOL[I]:11:2);
  WRITELN(F,(MSTS[TOTAL].MDOL[I]*100.0)/(4.33333*WBUDGET):9:2);
  END;
WRITE(F,'-----');  FOR S := MINERV TO TOTAL DO WRITE(F,'   ------  ---------');  WRITELN(F,'   ------');
WRITE(F,'Total');
FOR S := MINERV TO TOTAL DO
  WITH MSTS[S] DO
      WRITE(F,MHRS[13]:9:1,MDOL[13]:11:2);
WRITELN(F,(MSTS[TOTAL].MDOL[13]*100.0)/(WBUDGET*WEEK):9:2);
WRITE(F,'Averg');
FOR S := MINERV TO TOTAL DO
  WITH MSTS[S] DO
      WRITE(F,MHRS[13]/MON:9:1,MDOL[13]/MON:11:2);
WRITELN(F);
WRITELN(F);  WRITELN(F);  WRITELN(F);
WRITELN(F,(MSTS[TOTAL].MDOL[13]*100.0)/(WBUDGET*52.0):7:2,
          '% of fiscal year budget recovered in',
	  (100.0*WEEK)/53.0:6:1,
	  '% of the fiscal year.');

(*********     QUARTERLY USAGE     ************)
 
IF WEEK IN [13,26,39,53] THEN
  BEGIN
  REWRITE(F1,'ACCQUART.DAT',,,[APPEND]);
  WRITE(F1,TODAY[3],TODAY[4],WEEK DIV 13:2);
  FOR S := MINERV TO MINERV DO WRITE(F1,U1830[S].YCHG:8:0,U1831[S].YCHG:8:0);
  WRITELN(F1);   RESET (F1,'ACCQUART.DAT');   PAGE(F);
  WRITELN(F,'Quarterly Recovery History':32,TODAY:16);
  WRITELN(F);     WRITE(F,'     ');
  FOR S := MINERV TO TOTAL DO WRITE(F,SYSNAME[S]:15,' ':10);
  WRITELN(F);   WRITE(F,'     ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'  -----------------------');
  WRITELN(F);   WRITE(F,'YR Q ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'1830    1831   Total ':25);
  WRITELN(F);   WRITE(F,'-- - ');
  FOR S := MINERV TO TOTAL DO WRITE(F,'  ------- ------- -------');
  WRITELN(F);
  FOR S := MINERV TO TOTAL DO
    BEGIN
    T30[S] := 0;  T31[S] := 0; TT[S] := 0;
    END;
  I := 0;
  WHILE NOT EOF(F1) DO
    BEGIN
    READ(F1,YR,CH,CH);  Q30[TOTAL] := 0;
    Q31[TOTAL] := 0;    QT [TOTAL] := 0;
    I := SUCC(I);
    FOR S := MINERV TO MINERV DO
      BEGIN
      READ(F1,QT[S],Q31[S]);  Q30[S] := QT[S] - Q31[S];
      Q30[TOTAL] := Q30[TOTAL] + Q30[S];
      Q31[TOTAL] := Q31[TOTAL] + Q31[S];
      QT [TOTAL] := QT [TOTAL] + QT [S];
      END;
    FOR S := MINERV TO TOTAL DO
      BEGIN
      T30[S] := T30[S] + Q30[S];
      T31[S] := T31[S] + Q31[S];
      TT [S] := TT [S] + QT [S];
      END;
    WRITE(F,YR,CH:2,' ');
    FOR S := MINERV TO TOTAL DO WRITE(F,Q30[S]:9:0,Q31[S]:8:0,QT[S]:8:0);
    WRITELN(F);
    END;
  WRITE(F,'-----');
  FOR S := MINERV TO TOTAL DO WRITE(F,'  -----------------------');
  WRITELN(F);  WRITE(F,'TOTAL');
  FOR S := MINERV TO TOTAL DO WRITE(F,T30[S]:9:0,T31[S]:8:0,TT[S]:8:0);
  WRITELN(F);  WRITE(F,'AVERG');
  FOR S := MINERV TO TOTAL DO WRITE(F,T30[S]/I:9:0,T31[S]/I:8:0,TT[S]/I:8:0);
  WRITELN(F);
  END;

 
(*****  OUTPUT NEW YEAR-TO-DATE FILE   ********)
 
TA := FA;  REWRITE(F,'ACCYTD.DAT');  REWRITE(WFO,'ACCMWO.DAT');
WHILE TA<>NIL DO WITH TA^ DO
  BEGIN
  IF WEEK IN [13,26,39,53] THEN
    BEGIN
    IF NOT W.MKDEL THEN BEGIN WFO^ := W;  PUT(WFO);  END;
    END
  ELSE
    BEGIN
    IF HASDATA THEN
      BEGIN
      WRITE(F,W.WKO);
      FOR S := MINERV TO MINERV DO WRITE(F,USES[S].YHRS:9:2,USES[S].YCHG:9:2);
      WRITELN(F);
      END;
    IF W.ORG <> 'UNKN ' THEN BEGIN WFO^ := W;  PUT(WFO);  END;
    END;
  TA := NA;
  END;
 
WRITELN(TPRECS,' RECORDS IN ACCTAPE.DAT');
WRITELN('ACCCOMBO -- ALL DONE');
END.