(*
 
	Component :	ACCMNTHLY -- Monthly Recovery Analysis
 
	Initial Date:	February 14, 1980
	Current Date:	April 1, 1980
			October 28, 1980	-- Biometrics version
 
	Author:		Tom Mathieu
			Battelle-Northwest
			Box 999
			Richland, Washington 99352
			(509) 375-3711
 
	Source:		Swedish Pascal
 
	Calling Seq:	RUN [11,1]ACCMNTHLY
 
	Inputs:		Expense and Income totals from GL100
			Expense and Income history from ACCGL100.DAT
			System usage from ACCHSTRY.DAT
			Current system expenses from GL335
			Previous system expenses from ACCGL335.DAT
 
	Outputs:	ACCGL100.DAT updated
			ACCGL335.DAT updated
			Expense/Income/Recovery Report
			Expense by system summary
			Income by system summary
			Plot of budget/expense/income
 
	Comments:
*)

PROGRAM MONTHLY (TTY);
 
CONST	MAXW = 40;	PROJ1831PC = 0.00;
 
TYPE	WRKORD = ARRAY[1..6]OF CHAR;
	SYSTEM = (BIO70,TOTAL);
	WTYPE  = (LABOR,OPSUP,MPNS,VENSVC,TELECOM,BNUPNL,MISC,SUBSYSTM,DELETED);
	ITYPE  = (U1830,U1831);
	WRKPTR = 0..MAXW;
 
	WRKORDER = RECORD
		WKO : WRKORD;			(**  WORK ORDER NUMBER  **)
		WID : ARRAY [1..30] OF CHAR;	(**  WORK ORDER IDENT  **)
		WTP : WTYPE;
		WBD : ARRAY [1..12] OF REAL;	(**  BUDGET FOR EACH MONTH  **)
		WMST: WRKORD;			(**  MASTER WKO FOR SUB WKOS**)
		WYTD: REAL			(**  YEAR-TO-DATE EXPENSES  **)
		END;
 
	WRKORDS = RECORD 
		W     : WRKORDER;
		WCURR : REAL;			(**  CURRENT MONTH EXP  **)
		WSUBS : ARRAY [BIO70..BIO70] OF WRKPTR;	(**  SUB WKOS TO THIS ONE   **)
		WNXT  : WRKPTR
		END;
 
 
VAR	F,F1	: TEXT;		ETOT,FTOT,YTOT,BTOT : REAL;
	FW,TW	: 0..MAXW;	W1 : WRKORD;
	S	: SYSTEM;	WT : WTYPE;
	CH	: CHAR;
	NF	: BOOLEAN;
	I,J,MON : INTEGER;
	C1,X	: REAL;
	WF,WFO	: FILE OF WRKORDER;
 
	FUIC    : ARRAY [BIO70..BIO70,1..6] OF CHAR;
	SYSNAME : ARRAY [BIO70..TOTAL,1..6] OF CHAR;
	SC1831  : ARRAY [BIO70..BIO70] OF REAL;
	BD,SYS  : ARRAY [BIO70..TOTAL] OF REAL;
	TBD,TSYS: ARRAY [BIO70..TOTAL] OF REAL;
	SBD,SSYS: ARRAY [BIO70..TOTAL] OF REAL;
	TODAY	: ARRAY [1..10] OF CHAR;
	ASOFDT	: ARRAY [1..10] OF CHAR;
	P1,P2   : ARRAY [1..12] OF REAL;
	MONMES  : ARRAY [1..12, 1..3 ] OF CHAR;
 
	INCOME	: ARRAY [1..13] OF RECORD
		SYSDOL : ARRAY [BIO70..TOTAL,U1830..U1831] OF REAL;
		GL100INC,GL100EXP,BUDGET : REAL
		END;
 
	EOMWK	: ARRAY [1..12] OF SET OF 1..53;
 
	WKOS	: ARRAY [WRKPTR] OF WRKORDS;

PROCEDURE CHANGEW(WNO:WRKPTR);
  VAR C : CHAR;  I : INTEGER;  X : REAL;
  BEGIN
  WITH WKOS[WNO].W DO
    REPEAT
      WRITE('Change what ? [W,I,T,B,Y,X]    >');  BREAK;  READLN;  READ(C);
      CASE C OF
	'W' : BEGIN
	      WRITE('Change ',WKO,' to >':19);  BREAK;  READLN;  READ(WKO);
	      END;
	'I' : BEGIN
	      WRITE('Change ',WID,' to >');  BREAK;  READLN;  READ(WID);
	      END;
	'T' : BEGIN
	      WRITE('Enter WO type [L,O,M,V,T,B,G,S]>');  BREAK;  READLN;  READ(C);
	      CASE C OF
		'L' : WTP := LABOR;
		'O' : WTP := OPSUP;
		'M' : WTP := MPNS;
		'V' : WTP := VENSVC;
		'T' : WTP := TELECOM;
		'B' : WTP := BNUPNL;
		'G' : WTP := MISC;
		'S' : BEGIN
		      WTP := SUBSYSTM;  WRITE('Enter master work order','> ':10);
		      BREAK;  READLN;  READ(WMST);
		      END
		END
	      END;
	'Y' : BEGIN
	      WRITE('Change',WYTD:21:2,' to >'); BREAK;  READLN;  READ(WYTD);
	      END;
	'B':  BEGIN
	      WRITE('Change which month (0=all same)>'); 
	      BREAK;  READLN;  READ(I);
	      IF (I<0) OR (I>12) THEN WRITELN('*** WRONG ***')
	      ELSE 
		BEGIN
		WRITE('Change');
		IF I = 0 THEN WRITE(WBD[1]:21:2) ELSE WRITE(WBD[I]:21:2);
		WRITE(' to >');  BREAK;  READLN;  READ(X);
		IF I = 0 THEN FOR I := 1 TO 12 DO WBD[I] := X
		ELSE WBD[I] := X;
		END;
	      END;
	'X' : BEGIN END;
	OTHERS: WRITELN('*** WRONG ***')
	END;
      UNTIL C = 'X';
  END;
 
 

PROCEDURE  GET335(WNO : WRKPTR);
  BEGIN
  WITH WKOS[WNO] DO
    BEGIN
    WRITE ( 'Enter GL335 expense for ',W.WKO,' >');  BREAK;  READLN;  READ(WCURR);
    END;
  END;
 
PROCEDURE GETWKO(VAR N:WRKPTR);
  VAR WIN : WRKORD;  NOTFND : BOOLEAN;  
  BEGIN
  NOTFND := TRUE;
  REPEAT
    WRITE('Enter work order number > ');  BREAK;  READLN;  READ(WIN);
    N := 0;
    WHILE (N<TW) AND NOTFND DO
      BEGIN
      N := SUCC(N);
      NOTFND := WKOS[N].W.WKO <> WIN
      END;
    IF NOTFND THEN WRITELN(WIN,' not found.');
    UNTIL NOT NOTFND;
  END;
 
PROCEDURE SWAPW(VAR N:WRKPTR);
  VAR T : WRKORDS;
  BEGIN
  T := WKOS[N];		WKOS[N] := WKOS[N-1];
  WKOS[N-1] := T;	N := N-1;
  END;
 
PROCEDURE CHECKW(N:WRKPTR);
  BEGIN
  IF N > 1 THEN
  REPEAT 
    IF (WKOS[N].W.WKO<WKOS[N-1].W.WKO) THEN SWAPW(N)
    UNTIL (N=1) OR (WKOS[N].W.WKO>=WKOS[N-1].W.WKO);
  END;
 
PROCEDURE CHECKSUBS;
  VAR I,J : WRKPTR;
  BEGIN
  FOR I := 1 TO TW DO WITH WKOS[I] DO 
    FOR S := BIO70 TO BIO70 DO WSUBS[S] := 0;
  FOR I := 1 TO TW DO
    IF WKOS[I].W.WTP = SUBSYSTM THEN
      BEGIN
      J := 0;
      REPEAT J := J+1 UNTIL (J>TW) OR (WKOS[I].W.WMST=WKOS[J].W.WKO);
      IF J>TW THEN WRITELN('ERROR -- ILLEGAL SUB WKO -- ',WKOS[I].W.WKO,WKOS[I].W.WMST)
      ELSE WITH WKOS[J] DO IF WSUBS[BIO70]=0 THEN WSUBS[BIO70] := I
      ELSE IF WSUBS[BIO70]=0 THEN WSUBS[BIO70] := I ELSE WSUBS[BIO70] := I
      END;
  END;

 
(*****************************************************************)
 
		(****    MAIN LINE    ****)
 
BEGIN
SYSNAME[BIO70] := 'BIO70 ';
SYSNAME[TOTAL] := 'TOTAL ';
 
FUIC[BIO70] := '(1,5)';
 
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];
 
MONMES[ 1] := 'Oct';		MONMES[ 2] := 'Nov';
MONMES[ 3] := 'Dec';		MONMES[ 4] := 'Jan';
MONMES[ 5] := 'Feb';		MONMES[ 6] := 'Mar';
MONMES[ 7] := 'Apr';		MONMES[ 8] := 'May';
MONMES[ 9] := 'Jun';		MONMES[10] := 'Jul';
MONMES[11] := 'Aug';		MONMES[12] := 'Sep';
 
(******************  GET GL100 DATA  ******************************)
 
WRITE('Enter ending date from GL100 list  > ');  BREAK; READLN; READ(ASOFDT);
WRITE('Enter current month GL100 expenses > ');  BREAK; READLN; READ(X);
WRITE('Enter current month GL100 income   > ');  BREAK; READLN; READ(C1);
REWRITE(F,'ACCGL100.DAT',,,[APPEND]);
WRITELN(F,X:10:2,C1:10:2);
RESET(F,'ACCGL100.DAT');
MON := 1;
WHILE NOT EOF(F) DO
  BEGIN
  WITH INCOME[MON] DO  READ(F,GL100EXP,GL100INC);
  MON := SUCC(MON);
  END;

(*******************  GET EXPENSES FROM GL335  ************************)
 
RESET(WF,'ACCGL335.DAT');	TW := 0;
WHILE NOT EOF(WF) AND (TW < MAXW) DO	(***  GET PREVIOUS BALANCES  ***)
  BEGIN
  TW := SUCC(TW);  WKOS[TW].W := WF^;  GET(WF);  CHECKW(TW);
  END;
 
REPEAT					(***  CHECK FOR UPDATES  ***)
  WRITE('Any updates to work order list [A,C,D,L,Z,N] > ');   BREAK;  READLN;  READ(CH);
  CASE CH OF
    'N' : BEGIN END;
    'Z' : FOR I := 1 TO TW DO WKOS[I].W.WYTD := 0;
    'L' : FOR I := 1 TO TW DO WITH WKOS[I].W DO WRITELN(WKO,WID:24,ORD(WTP):3,WYTD:9:1,WBD[1]:9:0);
    'C' : BEGIN
	  GETWKO(I);  CHANGEW(I);
	  END;
    'D' : BEGIN
	  GETWKO(I);
	  WRITE('Delete ',WKOS[I].W.WKO,' ? [Y/N] >');  BREAK;  READLN;  READ(CH);
	  IF CH = 'Y' THEN WKOS[I].W.WTP := DELETED;
	  CH := 'D';
	  END;
    'A' : BEGIN
	  TW := SUCC(TW);
	  WITH WKOS[TW].W DO
	    BEGIN
	    WKO := '......';	WID := '..............................';
	    WTP := LABOR;	WYTD := 0.0;	WMST := WKO;
	    FOR I := 1 TO 12 DO WBD[I] := 0.0;
	    END;
	  CHANGEW(TW);	CHECKW(TW);
	  END;
    OTHERS: WRITELN('*** WRONG ***')
    END;
  UNTIL CH = 'N';
 
FOR I := 1 TO TW DO GET335(I);		(***  GET THIS MONTH'S EXPENSES   ***)
 
CH := '?';				(***  CHECK THE INPUT  ***)
REPEAT
  IF CH = '?' THEN
     FOR I := 1 TO TW DO WITH WKOS[I] DO WRITELN(I:3,W.WKO:7,WCURR:10:2)
  ELSE
    IF CH = 'Y' THEN
      BEGIN
      WRITE('Enter index [1..',TW:3,'] > ');  BREAK; READLN;  READ(I);
      IF (I<1) OR (I>TW) THEN WRITELN('*** WRONG ***')
      ELSE GET335(I)
      END
    ELSE IF CH <> 'N' THEN WRITELN('*** WRONG ***');
  WRITE('Any errors (?=list em again) [Y,N,?] > ');  BREAK;  READLN;  READ(CH);
  UNTIL CH='N';
 
FOR I := 1 TO TW DO WITH WKOS[I] DO W.WYTD := W.WYTD + WCURR;  CHECKSUBS;

(************************   GET SYSTEM USAGES   *************************)
 
DATE (TODAY);
FOR I := 1 TO 13 DO  WITH INCOME[I] DO 
    BEGIN
    FOR S := BIO70 TO BIO70 DO
      BEGIN
      SYSDOL[S,U1830] := 0.0;
      SYSDOL[S,U1831] := 0.0;
      END;
    BUDGET := 0.0;
    END;
 
FOR S := BIO70 TO BIO70 DO
  BEGIN
  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;
  INCOME[1].BUDGET := INCOME[1].BUDGET + X;
  RESET(F,'ACCHSTRY.DAT',FUIC[S]);
  WHILE NOT EOF (F) DO
    BEGIN
    READ(F,J,X,X,X,X,X,X,X,X,X,X,X,X,X,C1);	MON := 1;   X := 0.0;
    WHILE NOT (J IN EOMWK[MON]) DO MON := SUCC(MON);
    WITH INCOME[MON] DO
      BEGIN
      X := X/SC1831[S];
      SYSDOL[S,U1831] := SYSDOL[S,U1831] + X;
      SYSDOL[S,U1830] := SYSDOL[S,U1830] + C1 - X;
      SYSDOL[TOTAL,U1830] := SYSDOL[TOTAL,U1830] + C1 - X;
      SYSDOL[TOTAL,U1831] := SYSDOL[TOTAL,U1831] + X;
      END;
    END;
  END;
 
INCOME[1].BUDGET := (INCOME[1].BUDGET*52.0)/12.0;
FOR I := 2 TO 12 DO INCOME[I].BUDGET := INCOME[1].BUDGET*I;
FOR J := 1 TO MON DO WITH INCOME[13] DO
  BEGIN
  FOR S := BIO70 TO TOTAL DO
    BEGIN
    SYSDOL[S,U1830] := SYSDOL[S,U1830] + INCOME[J].SYSDOL[S,U1830];
    SYSDOL[S,U1831] := SYSDOL[S,U1831] + INCOME[J].SYSDOL[S,U1831];
    END;
  GL100EXP := GL100EXP + INCOME[J].GL100EXP;
  GL100INC := GL100INC + INCOME[J].GL100INC;
  BUDGET   := BUDGET   + INCOME[J].BUDGET;
  END;

(*****************   MONTHLY INCOME SUMMARY   ***************************)
 
REWRITE(F,'ACCMONTH.LST');
WRITELN(F,'MONTHLY INCOME SUMMARY':48,TODAY:36);
WRITELN(F);
WRITE(F,'     ');  FOR S := BIO70 TO TOTAL DO WRITE(F,SYSNAME[S]:13,' ':5);  WRITELN(F);
WRITE(F,'     ');  FOR S := BIO70 TO TOTAL DO WRITE(F,'   ---------------');  
WRITELN(F,'     Total      GL100      GL100      GL100       %');
WRITE(F,'Month');  FOR S := BIO70 TO TOTAL DO WRITE(F,'    1830     1831 ');  
WRITELN(F,'    Income     Income    Expenses   Recovery   Budget');
WRITE(F,'-----');  FOR S := BIO70 TO TOTAL DO WRITE(F,'   -------  ------');  
WRITELN(F,'   --------   --------   --------   --------   ------');
FOR I := 1 TO MON DO WITH INCOME[I] DO
  BEGIN
  WRITE(F,MONMES[I]:4,' ');
  FOR S := BIO70 TO TOTAL DO
    WRITE(F,SYSDOL[S,U1830]:10:1,SYSDOL[S,U1831]:8:1);
  X := (SYSDOL[TOTAL,U1830] + SYSDOL[TOTAL,U1831]);
  C1 := GL100INC - GL100EXP;
  WRITELN(F,X:11:2,GL100INC:11:2,GL100EXP:11:2,C1:11:2,
  	   (X*100.0)/(BUDGET/I):9:2);
  END;
WRITE(F,'-----');  FOR S := BIO70 TO TOTAL DO WRITE(F,'  -------- -------');  
WRITELN(F,'   --------   --------   --------   --------   ------');
WRITE(F,'Total');
FOR S := BIO70 TO TOTAL DO WITH INCOME[13] DO
    WRITE(F,SYSDOL[S,U1830]:10:1,SYSDOL[S,U1831]:8:1);
X := (INCOME[13].SYSDOL[TOTAL,U1830] + INCOME[13].SYSDOL[TOTAL,U1831]);
C1 := INCOME[13].GL100INC - INCOME[13].GL100EXP;
WRITELN(F,X:11:2,INCOME[13].GL100INC:11:2,INCOME[13].GL100EXP:11:2,C1:11:2,
  	   (X*100.0)/(INCOME[MON].BUDGET):9:2);
WRITE(F,'Averg');
FOR S := BIO70 TO TOTAL DO WITH INCOME[13] DO
    WRITE(F,SYSDOL[S,U1830]/MON:10:1,SYSDOL[S,U1831]/MON:8:1);
WRITELN(F,X/MON:11:2,INCOME[13].GL100INC/MON:11:2,INCOME[13].GL100EXP/MON:11:2,
          C1/MON:11:2);

(*************  SET UP FOR NEXT MONTH   ************************)
 
 
REWRITE(WFO,'ACCGL335.DAT');
FOR I := 1 TO TW DO
  IF WKOS[I].W.WTP <> DELETED THEN
    BEGIN
    WFO^ := WKOS[I].W;
    PUT(WFO);
    END;
 

(*****************   SYSTEM EXPENSES SUMMARY   ******************************)
 
PAGE(F);
FOR S := BIO70 TO TOTAL DO BEGIN TBD[S] := 0;  TSYS[S] := 0 END;
WRITELN(F,'Biometrics Computer Facility Expenses by system':72);
WRITELN(F,'Month ending -- ':52,ASOFDT);
WRITELN(F);
WRITE(F,' ':40);  FOR S := BIO70 TO TOTAL DO WRITE(F,SYSNAME[S]:17,' ':7);  WRITELN(F);
WRITE(F,' ':2,'Wk Ord  ','           Description        ');
FOR S := BIO70 TO TOTAL DO WRITE(F,'    Y-T-D Exp  Y-T-D Bdg');  WRITELN(F);
WRITE(F,' ':2,'------  ------------------------------');
FOR S := BIO70 TO TOTAL DO WRITE(F,'    ---------  ---------');  WRITELN(F);
FOR WT := LABOR TO PRED(MISC) DO
  BEGIN
  IF WT <> LABOR THEN WRITELN(F);
  FOR S := BIO70 TO TOTAL DO BEGIN SBD[S] := 0;  SSYS[S] := 0 END;
  CASE WT OF
    LABOR  : WRITELN(F,' ':10,'LABOR');
    OPSUP  : WRITELN(F,' ':10,'OPERATING SUPPLIES');
    MPNS   : WRITELN(F,' ':10,'MAINTENANCE PARTS/SUPPLIES');
    VENSVC : WRITELN(F,' ':10,'VENDER SERVICE');
    TELECOM: WRITELN(F,' ':10,'TELECOMMUNICATIONS');
    BNUPNL : WRITELN(F,' ':10,'B&U AND PNL');
    MISC   : WRITELN(F,' ':10,'MISCELLANEOUS')
    END;
  FOR I := 1 TO TW DO WITH WKOS[I] DO
    IF W.WTP = WT THEN 
      BEGIN
      IF WSUBS[BIO70] <> 0 THEN
	FOR S := BIO70 TO BIO70 DO
	  BEGIN
	  BD[S] := 0;  FOR J := 1 TO MON DO BD[S] := BD[S] + WKOS[WSUBS[S]].W.WBD[J];
	  SYS[S] := WKOS[WSUBS[S]].W.WYTD;
	  END
      ELSE
	FOR S := BIO70 TO BIO70 DO
	  BEGIN
	  BD[S] := 0;  FOR J := 1 TO MON DO BD[S] := BD[S] + W.WBD[J]/3.0;
	  SYS[S] := W.WYTD/3.0;
	  END;
      BD [TOTAL] := BD [BIO70];
      SYS[TOTAL] := SYS[BIO70];
      FOR S := BIO70 TO TOTAL DO 
	BEGIN
	TBD[S] := TBD[S] + BD[S];  TSYS[S] := TSYS[S] + SYS[S];
	SBD[S] := SBD[S] + BD[S];  SSYS[S] := SSYS[S] + SYS[S];
	END;
      WRITE(F,W.WKO:8,'  ',W.WID:30);
      FOR S := BIO70 TO TOTAL DO WRITE(F,SYS[S]:13:1,BD[S]:11:1);  WRITELN(F);
      END;
  WRITE(F,' ':2,'------  ------------------------------');
  FOR S := BIO70 TO TOTAL DO WRITE(F,'    ---------  ---------');  WRITELN(F);
  WRITE(F,' ':2,'        *********   Total   **********');
  FOR S := BIO70 TO TOTAL DO WRITE(F,SSYS[S]:13:1,SBD[S]:11:1);  WRITELN(F);
  END;
WRITELN(F);
WRITE(F,' ':2,'------  ------------------------------');
FOR S := BIO70 TO TOTAL DO WRITE(F,'    ---------  ---------');  WRITELN(F);
WRITE(F,' ':2,'        *******  Grand Total   *******');
FOR S := BIO70 TO TOTAL DO WRITE(F,TSYS[S]:13:1,TBD[S]:11:1);  WRITELN(F);

(*******************   SYSTEM RECOVERY   *************************)
 
ETOT := 0;	YTOT := 0;	FOR I := 1 TO 12 DO P1[I] := 0;
%	FOR I := 1 TO TW DO WITH WKOS[I] DO  	(**  APPORTION LABOR OVERHEADS TO LABOR  **)
  IF W.WTP = LABOR THEN
    BEGIN
    ETOT := ETOT + WCURR;  YTOT := YTOT + W.WYTD;
    FOR J := 1 TO 12 DO P1[J] := P1[J] + W.WBD[J];
    END
  ELSE IF W.WTP = BNUPNL THEN
    BEGIN
    FTOT := WCURR;	BTOT := W.WYTD;
    FOR J := 1 TO 12 DO P2[J] := W.WBD[J];
    END;
FOR I := 1 TO TW DO WITH WKOS[I] DO
  IF W.WTP = LABOR THEN
    BEGIN
    WCURR  := WCURR  + (WCURR /ETOT)*FTOT;
    W.WYTD := W.WYTD + (W.WYTD/YTOT)*BTOT;
    FOR J := 1 TO 12 DO W.WBD[J] := W.WBD[J] + (W.WBD[J]/P1[J])*P2[J];
    END;		\
 
PAGE(F);  ETOT := 0;  YTOT := 0;  BTOT := 0;  FTOT := 0;
WRITELN(F);  WRITELN(F);  WRITELN(F);
WRITELN(F,'Biometrics Computer Center  Facility Recovery':61);
WRITELN(F,'Month ending -- ':42,ASOFDT);	WRITELN(F);
WRITELN(F,' ':0,'                               Current   Y-T-D    FY-T-D    %      Annual    %');
WRITELN(F,' ':0,'     Expense Description         Cost     Cost    Budget  Budget   Budget  Annual');
WRITELN(F,' ':0,'------------------------------  ------  -------  -------  ------  -------  ------');
FOR WT := LABOR TO PRED(MISC) DO 
  BEGIN
  IF WT <> LABOR THEN WRITELN(F);
  CASE WT OF
    LABOR  : WRITELN(F,' ':0,'LABOR');
    OPSUP  : WRITELN(F,' ':0,'OPERATING SUPPLIES');
    MPNS   : WRITELN(F,' ':0,'MAINTENANCE PARTS/SUPPLIES');
    VENSVC : WRITELN(F,' ':0,'VENDER SERVICE');
    TELECOM: WRITELN(F,' ':0,'TELECOMMUNICATIONS');
    BNUPNL : WRITELN(F,' ':0,'B&U and PNL');
    MISC   : WRITELN(F,' ':0,'MISCELLANEOUS')
    END;
  FOR I := 1 TO TW DO WITH WKOS[I] DO
    IF W.WTP = WT THEN 
      BEGIN
      C1 := 0;   FOR J := 1 TO MON DO C1 := C1+W.WBD[J];
      ETOT := ETOT + WCURR;  YTOT := YTOT + W.WYTD;  BTOT := BTOT + C1;
      WRITE(F,'  ',W.WID:28,WCURR:8:0,W.WYTD:9:0,C1:9:0,(W.WYTD*100.0)/C1:8:2);
      FOR J := MON+1 TO 12 DO C1 := C1 + W.WBD[J];
      WRITELN(F,C1:9:0,(W.WYTD*100.0)/C1:8:2);
      FTOT := FTOT + C1;
      END;
  END;
WRITELN(F,' ':0,'------------------------------  ------  -------  -------  ------  -------  ------');
WRITELN(F,' ':0,'*********   Total   **********',ETOT:8:0,YTOT:9:0,BTOT:9:0,(100.0*YTOT)/BTOT:8:2,
        FTOT:9:0,(100.0*YTOT)/FTOT:8:2);

(*****************  INCOME  SUMMARY   *****************)
 
WRITELN(F);  WRITELN(F);  WRITELN(F);
WRITELN(F,' ':0,'                               Current   Y-T-D  Projected    %     Annual    %');
WRITELN(F,' ':0,'           Income               Income   Income   Income   Proj    Income  Annual');
WRITELN(F,' ':0,'------------------------------  ------  -------  -------  ------  -------  ------');
C1 := (1.0-PROJ1831PC)*INCOME[MON].BUDGET;
WRITE(F,'1830':14,INCOME[MON].SYSDOL[TOTAL,U1830]:24:0,
	INCOME[13].SYSDOL[TOTAL,U1830]:9:0,
	C1:9:0,100.0*(INCOME[13].SYSDOL[TOTAL,U1830])/C1:8:2);
C1 := (1.0-PROJ1831PC)*INCOME[12].BUDGET;
WRITELN(F,C1:9:0,100.0*(INCOME[13].SYSDOL[TOTAL,U1830])/C1:8:2);
C1 := (PROJ1831PC)*INCOME[MON].BUDGET;
WRITE(F,'1831':14,INCOME[MON].SYSDOL[TOTAL,U1831]:24:0,
	INCOME[13].SYSDOL[TOTAL,U1831]:9:0,
	C1:9:0,100.0*(INCOME[13].SYSDOL[TOTAL,U1831])/C1:8:2);
C1 := (PROJ1831PC)*INCOME[12].BUDGET;
WRITELN(F,C1:9:0,100.0*(INCOME[13].SYSDOL[TOTAL,U1831])/C1:8:2);
WRITELN(F,' ':0,'------------------------------  ------  -------  -------  ------  -------  ------');
WITH INCOME[MON] DO
  BEGIN
  C1 := SYSDOL[TOTAL,U1830]+SYSDOL[TOTAL,U1831];
  WRITELN(F,' ':0,'*********   Total   **********',C1:8:0,X:9:0,BUDGET:9:0,(100.0*X)/BUDGET:8:2,
         INCOME[12].BUDGET:9:0,(100.0*X)/INCOME[12].BUDGET:8:2);
  END;
 
 
(****   RECOVERY TOTAL   ****)
 
WRITELN(F);  WRITELN(F);  WRITELN(F);
WRITELN(F,' ':58,'% Curr','%  YTD':17);
WRITELN(F,' ':0,'           Recovery            Current     YTD              Exp              Exp ');
WRITELN(F,' ':0,'------------------------------  ------  -------           ------           ------');
WRITELN(F,' ':0,'*********   Total   **********',C1-ETOT:8:0,X-YTOT:9:0,
     100.0*(C1-ETOT)/ETOT:17:2,100.0*(X-YTOT)/YTOT:17:2);
PAGE(F);
 
 

(*************    SET UP FOR PLOTS    ************************)
 
REWRITE(F,'PLOT.PLT');
WRITELN(F,'Biometrics Computer Center Accounting Summary');
WRITELN(F,'Month (1=October 1, 1980)');
WRITELN(F,'Income/Costs/Recovery ($1000)');
WRITELN(F,'    0,    -10,    12,  230,    0,    0,    1,   20, 3.0, 4.0');
WRITELN(F,'-12344.0,    -32.000');
WRITELN(F,'     0.0,      0.0');
WRITELN(F,'    12.0,    208.0');	(*** OR INCOME[I].BUDGET:10:3 ***)
WRITELN(F,'-12340.0,      0.75');
WRITELN(F,'    10.0,    200.0,Budget');
WRITELN(F,'PEN3');
WRITELN(F,'-12344.0,    -32.0');
WRITELN(F,'     0.0,      0.0');
FOR I := 1 TO MON DO WRITELN(F,I:6,'.0,',INCOME[I].GL100INC/1000.0:10:3);
WRITELN(F,'-12340.0,      0.75');
WRITELN(F,'     1.0,    200.0,Income');
WRITELN(F,'PEN2');
WRITELN(F,'-12344.0,    -32.0');
WRITELN(F,'     0.0,      0.0');
FOR I := 1 TO MON DO WRITELN(F,I:6,'.0,',INCOME[I].GL100EXP/1000.0:10:3);
WRITELN(F,'-12340.0,      0.75');
WRITELN(F,'     1.0,    190.0,Expenses');
WRITELN(F,'PEN4');
WRITELN(F,'-12344.0,    -32.0');
WRITELN(F,'     0.0,      0.0');
FOR I := 1 TO MON DO
  WRITELN(F,I:6,'.0,', (INCOME[I].GL100INC-INCOME[I].GL100EXP)/1000.0:10:3);
WRITELN(F,'-12340.0,      1.0');
WRITELN(F,'     1.0,    180.0,Recovery');
WRITELN(F,'PEN1');
WRITELN(F,'-12345.0');
 
 
END.
 
END.
