*DECK,HPA5
      OVCAP.
      SUBROUTINE HPA5 
* 
**           DEFINITION 
*            ------------ 
*           HPA5 - CONTROL PROGRAM TO CALL SUMMARY REPORT 
*                    ROUTINES.
* 
*             CALLED BY 
*             ----------
*           HPA MAIN CONTROL                                            000460
* 
*             SUBROUTINES CALLED
*             ------------------
*             SUMEQ5, HSREP5                                            000480
* 
*CALL,HPACOM1 
  
      DIMENSION KDEV (4,1000) 
  
*        CALL REQUIRED SUMMARY ROUTINES 
  
*        FLAGS(21) - SUMMARY REPORT 1 FLAG
*        FLAGS(22) - SUMMARY REPORT 2 FLAG
* 
*      TIME PRINT OUT CONTROLLED BY (X=T) PARAMETER                     001050
      IF (FROG(6) .NE. L"T") GO  TO 5 
      CP = SECOND ()
      PRINT 4,CP                                                        001080
    4 FORMAT ( ' ENTER HPA5 , SECOND = ',F10.3) 
    5 CONTINUE                                                          001100
  
      FLAGS(21) = FLAGS(22) = 3HOFF 
      IF (FILEP(RSEF) .EQ. 3HOFF) GO TO 900 
      IF (FROG(1) .EQ. 3HALL) FLAGS(21) = FLAGS(22) = 2HON
  
      DO 10 I = 6,12,6
      TEST = SHIFT(FROG(1),I) .AND. O"77" 
      IF (TEST .EQ. R"1") FLAGS(21) = 2HON
   10 IF (TEST .EQ. R"2") FLAGS(22) = 2HON
  
      CALL LOVCAP ('PRHEAD5') 
      CALL LOVCAP ('PRINT5')
      CALL XOVCAP ('SUMEQ5',KDEV,0) 
      CALL UOVCAP ('SUMEQ5')
      CALL XOVCAP ('SYSREP5',KDEV,0)
      CALL UOVCAP ('SYSREP5') 
      CALL UOVCAP ('PRHEAD5') 
      CALL UOVCAP ('PRINT5')
* 
  900 CONTINUE
  
  
      END 
      OVCAP.
      SUBROUTINE PRHEAD5
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE PRHEAD5 PRINTS SUB-HEADER(S) IN VARIOUS
*         REPORTS.
* 
*CALL,HPACOM1 
      LINE = LINE + 1 
  
      GO TO (900,900,900, 40,900, 60,900,900, 90,100) HCF(1)
  
* 
   40 PRINT 41, TYPORD
   41 FORMAT(1X,'DT ',A4,' UN',13X,'MESSAGE',14X,'DATE',5X, 
     .'TIME/FIRST--LAST  TOTAL')
      GO TO 900 
* 
   60 PRINT 61,HDATA(1),HDATA(2)
   61 FORMAT (1X,2A10,'    QTY' ) 
      GO TO 900 
* 
   90 PRINT 91
   91 FORMAT ('     DT    MESSAGE  TYPE',17X,'QTY') 
      GO TO 900 
  
  100 PRINT 101, HDATA(1),HDATA(2)
  101 FORMAT(1X,2A10,11X,'QTY   REV. NO.')
      GO TO 900 
  
  900 LINE = LINE + 1 
      PRINT 920 
  920 FORMAT (1H )
      LINE = LINE + 1 
      RETURN
      END 
      OVCAP.
      SUBROUTINE PRINT5 (LT,NW) 
* 
**        PRINT5 -- PRINT A  LINE OF DATA AS CALLED BY
*                   ROUTINES IN OVERLAY (5,0) 
* 
*       ENTRY CONDITIONS -
*       ------------------
*          LT = FORMAT STATEMENT TO BE USED 
*          NW = NUMBER OF WORDS TO BE PRINTED 
* 
*CALL,HPACOM1 
  
      DIMENSION IFORM(5,6),  FMT(5) 
  
      DATA (IFORM(I,1), I=1,5,1) /
     .10H(1X,R2,1X,,10HA4,1X,A2,3,10HX,2A10,A8,,10H1X,A10,A8,,
     .10HA10,I6)   /
  
  
      DATA (IFORM(I,2), I=1,2,1) / 10H(2A10,I8) ,10H          / 
  
      DATA (IFORM(I,3), I=1,3,1) /
     .10H(5X,R2,3X,,10H2A10,A8,1X,10H,I5)      /
  
      DATA (IFORM(I,4), I=1,3,1) /
     .10H(1X,A10,R2,10H,1X,A4,4X,,10HI6)       /
  
      DATA (IFORM(I,5), I=1,2,1) / 10H(2A10,A2,I,10H6)        / 
  
      DATA (IFORM(I,6), I=1,2,1) / 10H(6X,R1,5X,,10HO2,9X,I5) / 
  
*        ************************************ 
  
      LINE = LINE + 1 
      IF (LINE .LE. PLF) GO TO 5
      CALL HEADER 
      CALL PRHEAD5
  
    5 DO 8 J = 1,5
      FMT(J) = IFORM(J,LT)
    8 CONTINUE
      PRINT FMT,(PL(J),J=1,NW)
  
      DO 50 K = 1,NW
   50 PL(K) = 1H
      RETURN
      END 
      OVCAP.
      SUBROUTINE SUMEQ5 (KDEV)
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE SUMEQ5 COLLECTS AND ACCUMULATES ALL OF THE 
*         DATA FOR SUMMARY REPORTS (S = 1) OF THE ERROR LOG.
* 
*         CALLED BY 
*         --------- 
*           HPA5
* 
*CALL,HPACOM1 
*CALL HPACOM2 
*CALL HPACOM3 
* 
      DIMENSION  KDEV(4,1000) 
      DIMENSION    KTCHAN(63), KVDAY(366) 
      EQUIVALENCE (KTCHAN(1),  ITCHAN(1)) 
      EQUIVALENCE (KVDAY(1),   STOR(1,1)) 
* 
  
*         CLEAR    ARRAYS 
  
      DO 10 K = 1,4 
      DO 10 K2 = 1,MTYMAX 
   10 KDEV (K,K2) = 0 
  
      DO 12 K=1,366 
   12 KVDAY (K) = 0 
  
      DO 13 K = 1,63
   13 KTCHAN(K)=0 
* 
      KOV = 0 
      KTOT = 0
      SEBUF(30) = 0 
      KDATE = 0 
      PL(1) = 1H
  
*         INITIALIZE
  
      IHDR=2
      HCF(1) = 4
      CALL HEADER 
* 
*         OMIT HEADERS IF SUMMARY REPORT 1 NOT SELECTED 
      IF(FLAGS(21).EQ.3HOFF) GO TO 50 
      CALL PRHEAD5
   50 CONTINUE
* 
  
      CALL RMREAD (NEW,SEBUF,LENGTH)
      FDATE = SEBUF(21) 
      GO TO 210 
* 
  200 CALL RMREAD (NEW,SEBUF,LENGTH)
  210 IF (FEOF(NEW) .EQ. 3HYES) GO TO 900 
  
      IF (SEBUF(1) .EQ. 9HCHANTABLE) GO TO 860
*      COLLECT SUMS 
*         **** MESSAGE COUNT
      KTOT = KTOT + SEBUF(30)                                            HPA0199
*         **** ERROR COUNT
      MQTY = SEBUF(25)
*         **** JULIAN DAY 
      IDAT = SEBUF (FUN+2)
      KVDAY(IDAT) = KVDAY(IDAT) + SEBUF(30)                             000260
*         PET = ERROR TYPE
*         PDT = DEVICE TYPE 
*         PST = EST ORDINAL 
*         PST = HUID (IF MMF) 
  
      PDT = SEBUF(FDT)
      PET = SEBUF(FMTY) 
      IF (FLAGS(25) .EQ. 0) PST = SEBUF(FEST) 
      IF (FLAGS(25) .NE. 0) PST = SEBUF(FHUID)
  
C         FIND SLOT, OR MATCH, IN ARRAY 
  
      DO 250 K = 1,MTYMAX 
  
C         IF EMPTY SLOT 
      IF (KDEV(1,K) .EQ. 0) GO TO 220 
  
*         IF EST UNEQUAL
  
      IF ((SHIFT(KDEV(1,K),12) .AND. O"7777") .NE. PST) GO TO 250 
  
C         IF ERROR CODE UNEQUAL 
      IF ((SHIFT(KDEV(1,K),36) .AND. O"7777") .NE. PET) GO TO 250 
  
C         IF DEVICE TYPE UNEQUAL
      IF ((SHIFT(KDEV(1,K),24) .AND. O"7777") .NE. PDT) GO TO 250 
  
      MQTYX = ((KDEV(1,K) .AND. O"7777 7777") + MQTY) .AND. O"7777 7777"
      KDEV(1,K) = (KDEV(1,K).AND.O"7777 7777 7777 0000 0000") .OR. MQTYX
      GO TO 300 
  
  220 KDEV(1,K) = (SHIFT(PST,48) .AND. O"7777 0000 0000 0000 0000") .OR.
     .            (SHIFT(PDT,36) .AND. O"7777 0000 0000 0000")      .OR.
     .            (SHIFT(PET,24) .AND. O"7777 0000 0000")           .OR.
     .            (MQTY .AND. O"7777 7777") 
      KDEV(2,K) = SEBUF(27) 
      KDEV(3,K) = SEBUF(28) 
      KDEV(4,K) = SEBUF(29) 
              GO TO 300 
  250 CONTINUE
  
C         ARRAY OVERFLOW
  
      IF(KOV.GT.2) GO TO 300
      PRINT 260 
  260 FORMAT ('  ... KDEV OVERFLOW ...  ( SUMEQ5 ) --- ') 
      KOV = KOV + 1 
  
  300 PSTX = PST
      IF (FLAGS(25) .EQ. 0) ENCODE (10, 1000, PST) PSTX 
      IF (FLAGS(25) .NE. 0) ENCODE (10, 1005, PST) PSTX 
      IF (PDT .EQ. R"NC")   ENCODE (10, 1006, PST) PSTX 
      IF ((PDT .EQ. R"NP") .OR. (PDT .EQ. R"NM") .OR. 
     .    (PDT .EQ. R"ND")) ENCODE (10, 1008, PST) PSTX 
      UNIT = SEBUF(FUN) 
      ENCODE (10,1007,SEBUF(FUN)) UNIT
      IF (PDT .EQ. R"MR") PST = SEBUF(FUN) = 10H
      IF ((PDT .EQ. R"SY") .AND. (SEBUF(1) .GE. 0)) 
     .                    PST = SEBUF(FUN) = 10H
      IF (PDT .EQ. R"RP")  SEBUF(FUN) = 10H 
* 
*        OMIT PRINTING SUMMARY REPORT 1 DATA IF NOT SELECTED
      IF(FLAGS(21).EQ.3HOFF) GO TO 200
      IF (FROG(18).NE.3HYES) GO TO 315
*        FOR EACH DEVICE, CONSOLIDATE LIKE MESSAGES FOR DIFFERENT 
*        DAYS ON THE SAME PRINT LINE. 
      IF(PL(1).EQ.1H ) GO TO 315
*        CHECK IF MESSAGE IS SAME AS PREVIOUS MESSAGE 
      IF(PL(4).NE.SEBUF(27)) GO TO 310
      IF(PL(5).NE.SEBUF(28)) GO TO 310
      IF(PL(6).NE.SEBUF(29)) GO TO 310
*        CHECK IF SAME UNIT 
      IF(PL(3).NE.SEBUF(FUN)) GO TO 310 
*        CHECK IF SAME EST (OR HUID IF MMF) 
      IF(PL(2).NE.PST) GO TO 310
*        CHECK DEVICE TYPE
      IF(PL(1).NE.SEBUF(FDT)) GO TO 310 
*        SAME DEVICE AND MESSAGE --- ADD IN THE ERROR COUNT, PLUG 
*        THE LAST TIME, AND GO GET THE NEXT RECORD. 
      PL(10) = PL(10) + SEBUF(30) 
      ENCODE (10,800,PL(9)) SEBUF(24) 
      GO TO 200 
*        PRINT RECORD AND RELOAD PRINT BUFFER 
  310 CONTINUE
      CALL PRINT5 (1,10)
  315 CONTINUE
      CALL LOAPR(1,SEBUF(FDT),PST,SEBUF(FUN),SEBUF(27), 
     .SEBUF(28),SEBUF(29),SEBUF(21),SEBUF(22))
      ENCODE(10,800,PL(9)) SEBUF(24)
  800 FORMAT (2H--,A8)
      PL(10)=SEBUF(30)
      IF (FROG(18).NE.3HYES) CALL PRINT5 (1,10) 
      IF (SEBUF(FUN+1) .GT. KDATE) KDATE = SEBUF(FUN+1) 
* 
*      GET NEXT RECORD
      GO TO 200 
* 
  860 DO 870  K = 1,63                                                   HPA0199
      KTCHAN(K) = SEBUF (K + 1)                                          HPA0199
  870 CONTINUE                                                           HPA0199
      GO TO 200                                                          HPA0199
*                                                                        HPA0199
  900 CONTINUE
      IF(PL(1).NE.1H .AND.FROG(18).EQ.3HYES) CALL PRINT5 (1,10) 
      SEBUF(21) = FDATE 
      SEBUF(30) = KTOT
      SEBUF(FUN+1) = KDATE
      CALL RMREWND (NEW)
      CALL RMFILEM (NEW)
      CALL RMREWND (NEW)
      RETURN
  
 1000 FORMAT(O3,7X) 
1005  FORMAT(I4,6X) 
 1006 FORMAT(1X,Z2,7X)
 1007 FORMAT (O2,8X)
 1008 FORMAT (I3,7X)
      END 
      OVCAP.
      SUBROUTINE SYSREP5 (KDEV) 
* 
**        DESCRIPTION 
*         ----------- 
*         SUBROUTINE SYSREP5 DEVELOPS SUMMARY REPORT OF SYTEM REPORT
*         PAGE SHOWING ERROR INFORMATION SUB-TOTALS IN DIFFERENT
*         CATEGORIES FROM THE DATA ACCUMULATED BY SUBROUTINE SUMEQ5.
* 
*         CALLED BY 
*         --------- 
*          SUMEQ5 
* 
*CALL,HPACOM1 
*CALL HPACOM2 
*CALL HPACOM3 
* 
      DIMENSION  KDEV(4,1000) 
  
      DIMENSION    KTCHAN(63), KVDAY(366) 
      EQUIVALENCE (KTCHAN(1),  ITCHAN(1)) 
      EQUIVALENCE (KVDAY(1),   STOR(1,1)) 
* 
*          CHECK SUMMARY REPORT CONTROL FLAGS 
      IF (FLAGS(21) .EQ. 3HOFF) GO TO 100 
*        PRINT DATE OCCURED TOTALS
  
      HCF(1) = 6
      CALL PLSEC(1) 
      KDATE = SEBUF(FUN+1)
      HDATA(1) = 10H      DATE
      HDATA(2) = 10H OCCURRED 
      IF ((LINE + 6) .GT. PLF) CALL HEADER
      CALL PRHEAD5
  
      NY = 1
      DO 30 K=1,31
   30 IF (KVDAY(K).NE.0) GO TO 40 
      GO TO 50
   40 CONTINUE
      NY = 150
      KDATE = KDATE - 1 
  
   50 DO 55 K = NY,366
  
      IF (KVDAY(K) .EQ. 0) GO TO 55 
      KD = K
      CALL JDATE5 (KD,KDATE)
      PL(2) = IYEAR 
      PL(3) = KVDAY(K)
      CALL PRINT5 (2,3) 
      KVDAY(K) = 0
   55 CONTINUE
  
      IF (NY .EQ. 1) GO TO 100
      KDATE = KDATE + 1 
      NY = 1
      GO TO 50
  
*              PRINT  *  TOTAL  ENTRIES, IN SEF  *
  
  100 PL(1) = 10H0 TOTAL
      PL(2) = 10HENTRIES =
      PL(4) = SEBUF(30) 
      CALL PRINT5 (5,4) 
  
      IF(FLAGS(22).EQ.3HOFF) GO TO 900
*         PROCESS DEV. TYPE, ERROR TYPE TOTALS
  
      CALL HEADER 
      HCF(1) = 9
       CALL PRHEAD5 
  
C         GET DEVICE TYPE 
  
      DO 185 K = 1,MTYMAX 
      IF ((KDEV(1,K).AND.O"7777 0000 0000") .EQ. 0) GO TO 185 
      SDEV = SHIFT(KDEV(1,K),24) .AND. O"7777"
      PL(1) = SDEV
      PL(5) = 0 
  
C         GET ERROR CODE
  
      P = SHIFT(KDEV(1,K),36) .AND. O"7777" 
      PL(2) = KDEV(2,K) 
      PL(3) = KDEV(3,K) 
      PL(4) = KDEV(4,K) 
  
C         TOTAL SAME DEVICE TYPES 
  
      DO 180 I = 1,MTYMAX 
      IF (SDEV .NE. (SHIFT(KDEV(1,I),24).AND.O"7777")) GO TO 180
      IF (P    .NE. (SHIFT(KDEV(1,I),36).AND.O"7777")) GO TO 180
  
C         CLEAR THE ENTRY 
  
      KDEV(1,I) = KDEV(1,I) .AND. O"7777 7777 0000 7777 7777" 
  
C         QUANTITY
  
      PL(5) = PL(5) + (KDEV(1,I) .AND. O"7777 7777")
  180 CONTINUE
  
      CALL PRINT5 (3,5) 
  185 CONTINUE
  
*         DEVICE TYPE EST SUMMARY 
  
      CALL PLSEC (1)
      HCF(1) = 6
      ENCODE(10,1000,HDATA(2))TYPORD
      HDATA(1) = 1H 
  
      CALL PRHEAD5
  
*         PRINT EST TOTALS
  
*  *****************************************************
  
  200 PL(4) = 0 
  
C         GET EST, AND DEVICE TYPE
  
      DO 205 K = 1,MTYMAX 
      IF ((KDEV(1,K) .AND. O"7777 7777") .EQ. 0) GO TO 205
  
C              EST
  
      PSTX = SHIFT(KDEV(1,K),12) .AND. O"7777"
      IF (FLAGS(25) .EQ. 0) ENCODE (10, 1004, PL(3)) PSTX 
      IF (FLAGS(25) .NE. 0) ENCODE (10, 1005, PL(3)) PSTX 
  
C             DEVICE TYPE 
  
      PL(2) = SHIFT(KDEV(1,K),24) .AND. O"7777" 
      IF (PL(2) .EQ. R"NC")   ENCODE (10, 1006, PL(3)) PSTX 
      IF ((PL(2) .EQ. R"NP") .OR. (PL(2) .EQ. R"NM") .OR. 
     .    (PL(2) .EQ. R"ND")) ENCODE (10, 1007, PL(3)) PSTX 
      IF (PL(2) .EQ. R"MR")   PL(3) = 10H 
           GO TO 210
  205 CONTINUE
  
C         END OF LIST 
  
      GO TO 225 
*  *************************************************
  
C           ADD ERROR TYPES 
  
  210 DO 215 I2 = 1,MTYMAX
  
C               IF DIFFERENT EST
  
      IF ((SHIFT(KDEV(1,I2),12).AND.O"7777") .NE. PSTX) 
     .     GO TO 215
  
C             IF DIFFERENT DEVICE TYPE
  
      IF ((SHIFT(KDEV(1,I2),24).AND.O"7777") .NE. PL(2))
     .     GO TO 215
  
C             ADD THE QUANTITY
  
      PL(4) = PL(4) + (KDEV(1,I2) .AND. O"7777 7777") 
  
C             CLEAR THE ENTRY IN TABLE
  
      KDEV(1,I2) = KDEV(1,I2) .AND. O"7777 7777 7777 0000 0000" 
  215 CONTINUE
  
*  ***********************************************
  
      CALL PRINT5 (4,4) 
      GO TO 200 
  
C           END OF EST PRINT
  
  225 CALL PLSEC(1) 
  
  
*         PRINT CHANNEL EROR  TOTALS
  
      HDATA(1) = 8H    MFID 
      HDATA(2) = 10HCHANNEL 
      CALL PRHEAD5
      DO 355 K = 1,O"77"
         IF (KTCHAN(K) .EQ. 0) GO TO 355
         PL(1) = SHIFT(KTCHAN(K),6) .AND. O"77" 
         PL(2) = SHIFT(KTCHAN(K),12) .AND. O"77"
         PL(3) = KTCHAN(K) .AND. .NOT. MASK(12) 
      CALL PRINT5 (6,3) 
  355 CONTINUE
      CALL PLSEC(1) 
* 
  
  900 CONTINUE
      RETURN
  
 1000 FORMAT ('DT-',A4,3X)
 1004 FORMAT (O3,7X)
 1005 FORMAT (I4,6X)
 1006 FORMAT (1X,Z2,7X) 
 1007 FORMAT (I3,7X)
      END 
      SUBROUTINE JDATE5 (NDAY,NYEAR)
* 
**       JDATE5 GETS JULIAN DATE FROM CURRENT MESSAGE RECORD AND
*        CONVERTS IT INTO A CALENDER DATE.
* 
*        ENTRY CONDITIONS 
*        -----------------
*             NDAY - JULIAN DATE, IN BINARY, TO BE CONVERTED. 
*             NYEAR - YEAR TO BE CODED, BIASED BY 1970. 
* 
*        DATA AREAS 
*        ---------------------
*         IMON   - (12)/LOCAL TO SUBROUTINE/TABLE OF DAYS OF
*                  EACH MONTH IN THE YEAR.
*         IT     - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE. 
*         JYEAR  - (1)/LOCAL TO SUBROUTINE/YEAR IN BINARY FORM
*                  BIASED BY 1900.
*         KM     - (1)/LOCAL TO SUBROUTINE/COUNTER TO SET THE MONTH 
*                  OF THE YEAR. 
*         MONK   - (1)/COMMON BLOCK/MONTH OF THE YEAR CONVERTED FROM
*                  JULIAN DAY.
* 
*        EXIT CONDITION 
*        -------------- 
*        CALENDER DAY ENCODED IN COMMON WORD ( IYEAR ). 
* 
*CALL HPACOM1 
  
      DIMENSION IMON(12)
      DATA (IMON(I),I=1,12) /31,28,31,30,31,30,31,31,30,31,30,31/ 
*       *********************************************************** 
  
      IMON(2) = 28
      IT = NYEAR - 2
      JDAY = NDAY 
*        TEST FOR LEAP YEAR 
   10 IT = IT - 4 
      IF (IT .EQ. 0) IMON(2) = 29 
      IF (IT .GT. 0) GO TO 10 
* 
      DO 20 KM = 1,12 
      IF (JDAY .LE. IMON(KM)) GO TO 50
   20 JDAY = JDAY - IMON(KM)
  
   50 JYEAR = NYEAR + 70
      IF (JYEAR .GT. 99) JYEAR = JYEAR - 100
      ENCODE (8,100,IYEAR) JYEAR,KM,JDAY
  100 FORMAT (I2.2,2('/',I2.2)) 
  
*           CURRENT MONTH    *******
      FLAGS(6) = KM 
*           CURRENT DAY      *******
      FLAGS(5) = JDAY 
* 
      RETURN
      END 
