IMPLICIT INTEGER (A-Z)
      REAL SUT,RET,FET,EKPSD,KILTIM,TOTIME,USRLSR(500)
      DIMENSION NAME(2),ANAME(3),DTCT(24),REASON(16),USRLST(500,6)
      DIMENSION SYSNAM(5)
      DATA REASON/'CS','OT','OE','OC','VI','DX','CX','^C',
     16*'  ','SG','RG'/
      DATA USRMAX/500/
      DO 50 I=1,5
      SYSNAM(I)='     '
50    CALL GETTAB(SYSNAM(I),(I-1)*"1000000+9)
      OPEN(UNIT=5,DEVICE='NUL',FILE='PIRETS',ACCESS='SEQIN',
     1MODE='IMAGE')
      NGAM=0
      TOTIME=0.0
      TOTEMY=0
      USRCNT=0
      DO 100 I=1,USRMAX
100   USRLST(I,1)=0
C
C  BEGIN NEXT PAGE OF THE GAMES LISTING
      DO 120 PAGE=1,999
1     FORMAT('1',5A5,25X,'PIRETS SCORE LISTING',25X,'PAGE',I3/
     1/5X,'CREATION',9X,'TERMINATION',10X,
     2'PPN',11X,'NAME     I-K&R R-K&R T-K&R GS RS I-TIM R-TIM T-TIM',
     3' PRTG TNRTG EK/SD VERSN RC'/2(1X,17('-')),1X,15('-'),1X,
     412('-'),3(' -----'),2(' --'),3(' -----'),' ----',3(' -----'),
     5' --'/)
      DO 120 L=1,53
C
C  READ AND UNGARBAGE A GAME SCORE RECORD
      READ(5,END=77776)DATIC,DATIT,PPN,NAME,JUNK,TIMLIM,JUNK2
      IF(L.EQ.1) PRINT 1,(SYSNAM(I),I=1,5),PAGE
      CALL UGDT(DATIC,DTCT)
      CALL UGDT(DATIT,DTCT(13))
      DO 103 CC=1,23,2
      T1=DTCT(CC)
      T2=T1/10
      DTCT(CC)=T2
103   DTCT(CC+1)=T1-T2*10
      PP1=GFIELD(PPN,18,18)
      PP2=GFIELD(PPN,18,0)
      N1=0
      A1=0
      N2=0
      A2=0
      DO 108 CC=1,12
      N1=N1-6
      IF (N1.GE.0) GOTO 106
      N1=30
      N2=N2+1
106   A1=A1-7
      IF (A1.GE.0) GOTO 107
      A1=29
      A2=A2+1
107   T=GFIELD(NAME(N2),6,N1)+32
108   CALL SFIELD(ANAME(A2),7,A1,T)
      IK=GFIELD(JUNK2,7,29)
      IR=GFIELD(JUNK2,7,22)
      RK=GFIELD(JUNK,7,29)
      RR=GFIELD(JUNK,7,22)
      FK=GFIELD(JUNK,7,15)
      FR=GFIELD(JUNK,7,8)
      GS=GFIELD(JUNK,4,4)
      R=REASON(GFIELD(JUNK,4,0)+1)
      SUT=GFIELD(TIMLIM,12,24)/100.0
      RET=GFIELD(TIMLIM,12,12)/100.0
      FET=GFIELD(TIMLIM,12,0)/100.0
      RC=GFIELD(JUNK2,7,15)
      VER=GFIELD(JUNK2,5,10)
      EDITNO=GFIELD(JUNK2,10,0)
      INEMY=IK+IR
      REEMY=RK+RR
      FNEMY=FK+FR
      KILLED=REEMY-FNEMY
      KILTIM=RET-FET
      IF(KILTIM.EQ.0.0)KILTIM=5.0E-3
      PRTG=(INEMY-FNEMY)*1000/INEMY+0.5
      TNRTG=KILLED*1000*RET/(KILTIM*REEMY)+0.5
      EKPSD=KILLED/KILTIM
      NGAM=NGAM+1
      TOTEMY=TOTEMY+REEMY-FNEMY
      TOTIME=TOTIME+RET-FET
110   PRINT 2,DTCT,PP1,PP2,ANAME,IK,IR,RK,RR,FK,FR,GS,R,SUT,RET,
     1FET,PRTG,TNRTG,EKPSD,VER,EDITNO,RC
2     FORMAT(2(I2,I1,2('/',2I1),I2,I1,2(':',2I1)),' [',O6,',',O6,'] ',
     12A5,A2,7I3,1X,A2,3F6.2,I5,I6,F6.1,I2,'-',O3,I3)
C
C  LOOKUP AND RECORD THIS GAME IN THE USER LIST
      IL=1
      IH=USRCNT+1
200   IB=(IL+IH)/2
      IF(IH.LE.IL) GOTO 230
      IF(PPN-USRLST(IB,1)) 210,270,220
210   IH=IB
      GOTO 200
220   IL=IB+1
      GOTO 200
230   IF(PPN.EQ.USRLST(IB,1)) GOTO 270
      IF(USRCNT.GE.USRMAX)GOTO 77775
      USRCNT=USRCNT+1
      IF(IB.EQ.USRCNT)GOTO 255
      DO 250 IH=USRCNT,IB+1,-1
      DO 240 IL=1,6
240   USRLST(IH,IL)=USRLST(IH-1,IL)
250   USRLSR(IH)=USRLSR(IH-1)
255   USRLST(IB,1)=PPN
      DO 260 I=1,3
260   USRLST(IB,I+1)=ANAME(I)
      USRLST(IB,5)=0
      USRLST(IB,6)=0
      USRLSR(IB)=0.0
270   USRLST(IB,5)=USRLST(IB,5)+1
      USRLST(IB,6)=USRLST(IB,6)+KILLED
      USRLSR(IB)=USRLSR(IB)+KILTIM
120   CONTINUE
77775 TYPE 4
4     FORMAT(' %USER LIST OVERFLOW -- INCREASE USRMAX')
      GOTO 120
C
C   PRINT THE USER LIST AND OVERALL TOTALS
77776 IB=0
      DO 350 PAGE=PAGE+1,99
6     FORMAT('1',5A5,25X,'PIRETS SCORE LISTING',25X,
     1'PAGE',I3//14X,'PPN',11X,'NAME',5X,
     2'#GAMES KILLED STARDATES  EK/SD'/9X,13('-'),2X,12('-'),
     33(1X,'------'),'--- -------'/)
      DO 350 L=1,53
      IF(IB.GE.USRCNT) GOTO 77777
      IF(L.EQ.1) PRINT 6,(SYSNAM(I),I=1,5),PAGE
      IB=IB+1
      EKPSD=USRLST(IB,6)/USRLSR(IB)
      PPN=USRLST(IB,1)
      PP1=GFIELD(PPN,18,18)
      PP2=GFIELD(PPN,18,0)
      PRINT 7,IB,PP1,PP2,(USRLST(IB,IL),IL=2,6),USRLSR(IB),EKPSD
7     FORMAT(I4,5X,O6,',',O6,2X,2A5,A2,I5,I8,F9.2,F8.1)
350   CONTINUE
77777 PRINT 5,NGAM,TOTEMY,TOTIME
5     FORMAT(//'/TOTAL GAMES =',I5/' TOTAL ENEMIES KILLED =',I6/
     1' TOTAL STARDATES USED =',F9.2)
      STOP
      END

      SUBROUTINE UGDT(DAYTIM,DATIA)
      IMPLICIT INTEGER (A-Z)
      DIMENSION DATIA(12)
      T1=GFIELD(DAYTIM,16,20)
      T2=T1/31
      DATIA(3)=T1-T2*31+1
      T1=T2/12
      DATIA(1)=T2-T1*12+1
      DATIA(5)=T1+64
      T1=GFIELD(DAYTIM,20,0)/10
      T2=T1/60
      DATIA(11)=T1-T2*60
      DATIA(7)=T2/60
      DATIA(9)=T2-DATIA(7)*60
      RETURN
      END

      BLOCK DATA MACSUB
      COMMON /GFIELD/GFIELD(7)
      COMMON /SFIELD/SFIELD(8)
      COMMON /GETTAB/GETTAB(5)
C     FUNCTION GFIELD(LOCATION,SIZE,SHIFT)
      DATA GFIELD/"200076000002,"242040000006,"434076000001,
     1		  "242040000030,"541076000000,"135000000001,
     2		  "263740000000/
C	MOVE	1,@2(16)
C	LSH	1,6
C	OR	1,@1(16)
C	LSH	1,^D24
C	HRRI	1,@0(16)
C	LDB	0,1
C	POPJ	17,
C     SUBROUTINE SFIELD(LOCATION,SIZE,SHIFT,VALUE)
      DATA SFIELD/"200076000002,"242040000006,"434076000001,
     1		  "242040000030,"541076000000,"200036000003,
     2		  "137000000001,"263740000000/
C	MOVE	1,@2(16)
C	LSH	1,6
C	OR	1,@1(16)
C	LSH	1,^D24
C	HRRI	1,@0(16)
C	MOVE	0,@3(16)
C	DPB	0,1
C	POPJ	17,
C     SUBROUTINE GETTAB(VALUE,CODE)
      DATA GETTAB/"200036000001,"047000000041,"604000000000,
     1		  "202036000000,"263740000000/
C	MOVE	0,@1(16)
C	GETTAB	0,
C	TRNA
C	MOVEM	0,@0(16)
C	POPJ	17,
      END