*DECK,HPA8
      OVCAP.
      SUBROUTINE HPA8 
* 
**           DESCRIPTION
*            ------------ 
*            HPA8 - CONTROL PROGRAM FOR REPORT ROUTINES 
*            IN OVERLAY  (  10,0 ) )
* 
*          CALLED BY
*          -----------
*           OVERLAY HPA8 IS CALLED BY HPA MAIN CONTROL
*         TO PERFORM OPERATIONS ON HISTORY FILES, 
*         AND GENERATE REPORT ON CONTENTS OF HISTORY. 
* 
* 
*CALL,HPACOM1 
* 
      IF (FROG(6) .NE. L"T") GO TO 10 
      CP = SECOND ()
      PRINT 9,CP                                                        000660
    9 FORMAT ( ' ENTER HPA8 , SECOND = ',F10.3) 
   10 CONTINUE                                                          000680
  
      IF (FILEP(NEW) .NE. 3HOFF) THEN 
            CALL XOVCAP ('WRHIST8',0,0) 
            CALL UOVCAP ('WRHIST8') 
      ENDIF 
* 
*       TEST FOR MEDIA EXTRACTION 
      IF (FROG(5) .NE. 3HOFF) THEN
            CALL XOVCAP ('EXTRAC8',0,0) 
            CALL UOVCAP ('EXTRAC8') 
      ENDIF 
  
       END
      OVCAP.
       SUBROUTINE EXTRAC8 
* 
**        EXTRACT MEDIA DATA FROM SEF, OR HISTORY 
*         FOR MEDIA REPORTS.
* 
*          FROP (1,1,8) = HW PARAMETER                                   R2FHWMO
*               (1,2,8) = FIRST DATE TO BE COPIED FOR MF                 R2FHWMO
*               (1,3,8) = LAST DATE TO BE COPIED FOR MF                  R2FHWMO
*                                                                        R2FHWMO
*         CALLED BY -- HPA8 
* 
*CALL,HPACOM1 
* 
      DIMENSION VS (6)
      SCR1CNT = 0                                                        R2FHWMO
                                                                         R2FHWMO
*          ASSIGN INPUT DATA FILE 
      IF (FROG(11) .EQ. 3HOFF) FROG(11) = SEF                            R2FHWMO
      MF = FROG(11)                                                      R2FHWMO
      IF (((MF.NE.OLD).AND.(MF.NE.NEW)).AND.(MF.NE.SEF)) GO TO 800       R2FHWMO
*     TEMPORARILY TURN ON OLDHF FOR MEDIA IF TURNED OFF BY HR PARAMETER 
      IF (FROP(1,1,6) .NE. 3HOFF) FILEP(OLD) = 2HON 
      CALL RMREWND (MF) 
  
  
*          MEDIA OUTPUT FILE
      CALL RMREWND (SCR1) 
      CALL RMFILEM (SCR1) 
      CALL RMREWND (SCR1) 
  
      IF (FROG(5).EQ.L"SS") GO TO 600 
  
*        PARSE THE VSN PARAMETER, IF ANY
      IF (FROG(10) .EQ. 3HOFF) GO TO 70                                  R2FHWMO
      HOLD = FROG(10) 
      DO 60 K = 1,6 
      HOLD = SHIFT (HOLD,6) 
      VS(K) = HOLD .AND. O"77"
   60 CONTINUE
  
   70 IF (MF .EQ. SEF) GO TO 100                                         R2FHWMO
   80 CALL XOVCAP ('RMSKIP',MF,0) 
      CALL UOVCAP ('RMSKIP')
  100 CALL RMREAD (MF,SEFREC,LENGTH)
      IF (FEOF(MF) .EQ. 3HYES) GO TO 700
      JOBNAME = SHIFT(SEFREC(3),48) .AND. O"7777 7777 7777 7777"
      IF (JOBNAME .EQ. R" CONTINU") GO TO 100 
  
*  DISCARD THE CARTRIDGE TAPE TYPE 61 ENTRIES 
  
      IF ((SEFREC(1) .AND. O"0007 7700 0000 0000 7777") .EQ.
     .  O"0000 4700 0000 0000 0061") GO TO 100
  
  
*        TEST (HW) HISTORY WINDOW FOR MEDIA FILE                         R2FHWMO
  200 CONTINUE                                                           R2FHWMO
      IF ((FROP(1,1,8) .NE. L"HW")) GO TO 210 
      IDATE = SHIFT(SEFREC(1),-12) .AND. O"77777" 
      IF(FROP(1,3,8) .GT. IDATE) GO TO 900                               R2FHWMO
      IF (FROP(1,2,8).LT.IDATE) GO TO 70
                                                                         R2FHWMO
*        TEST FOR TAPE DEVICE RECORD TYPE                                R2FHWMO
  210 TEST = SHIFT(SEFREC(1),18) .AND. O"77"
      IF (((TEST .LT. O"30") .OR. (TEST .GT. O"37")) .AND.
     .     (TEST .NE. O"47") .AND. (TEST .NE. O"55")) GO TO 100 
  
*        PREVENT EXTRACTION OF LATE DATA TAPE MESSAGES
      IF ((SEFREC(1) .AND. O"7777") .EQ. O"2452") GO TO 100 
  
  
*       TEST FOR VSN EXTRACT
      IF (FROG(10) .EQ. 3HOFF) GO TO 300
      HOLD = SEFREC(5)
      DO 250 K = 1,6
      TEST = SHIFT (HOLD,6) .AND. O"77" 
      IF (VS(K) .EQ. 0) GO TO 300 
      IF (TEST .NE. VS(K) ) GO TO 100 
      HOLD = SHIFT (HOLD,6) 
  250 CONTINUE
  
  
  300 CALL RMWRITE (SCR1,SEFREC,8)
      SCR1CNT = SCR1CNT + 1                                              R2FHWMO
      GO TO 100 
  
  600 CONTINUE
      IF (MF.EQ.SEF) GO TO 620
      CALL XOVCAP ('RMSKIP',MF,0) 
      CALL UOVCAP ('RMSKIP')
  620 CALL RMREAD(MF,SEFREC,LENGTH) 
      IF (FEOF(MF).EQ.3HYES) GO TO 700
      TEST = SHIFT(SEFREC(1),18).AND.O"77"
      IF (TEST.NE.O"66") GO TO 620
      IEC = SEFREC(1).AND.O"7777" 
      IF (IEC.NE.O"60") GO TO 620 
      JOBNAME = SHIFT(SEFREC(3),48).AND.O"7777 7777 7777 7777"
      IF (JOBNAME.EQ.R" CONTINU") GO TO 620 
  
      CALL RMWRITE(SCR1,SEFREC,8) 
      SCR1CNT = SCR1CNT + 1 
      GO TO 620 
  
*      IF SEF FILE, EXIT - ELSE READ TO EOI.
  700 IF (MF .EQ. SEF) GO TO 900
      CALL RMREAD (MF,SEFREC,LENGTH)
      IF (FEOF(MF) .EQ. 3HYES) GO TO 900
      IF (FROG(5).EQ.L"SS") GO TO 620 
  
      IF ((FROP(1,1,8).NE.L"HW").OR.(FROP(1,3,8).LT.IDATE)) GO TO 200 
      GO TO 900                                                          R2FHWMO
  
  800 PRINT 810 
  810 FORMAT (/,'   MEDIA FILE (MF) MUST BE ',
     .'  SEF,  OR H,  OR NH ',/)
      GO TO 908                                                          R2FHWMO
                                                                         R2FHWMO
  900 IF (SCR1CNT .NE. 0) GO TO 910                                      R2FHWMO
      PRINT 905                                                          R2FHWMO
  905 FORMAT (/,' INPUT FILE DID NOT CONTAIN ENTRIES TO EXTRACT FOR ',
     .'(MF) MEDIA FILE')
  908 CALL RMREWND (SCR1) 
      FROG(5) = 3HOFF                                                    HPA0319
  910 CALL RMFILEM (SCR1) 
      CALL RMREWND (SCR1) 
*     TURN OFF OLDHF IF TURNED ON TEMPORARILY FOR MEDIA, DUE TO HR PARAM
      IF (FROP(1,1,6) .NE. 3HOFF) FILEP(OLD) = 3HOFF
      RETURN
      END 
      OVCAP.
      SUBROUTINE WRHIST8
* 
**        SUBROUTINE WRHIST8 IS CALLED TO UPDATE THE HISTORY FILES
*         ITS FUNCTION IS TO COPY THE OLD HISTORY TO THE NEW HISTORY
*         MERGING IN THE SEF FILE 
* 
*         ENTRY 
*         ----- 
*         SCR1 CONTAINS A FILE OF CONFIGURATION DATA WRITTEN BY O.L. 4
*         OLDHF AND SCR3 CONTAIN ERROR RECORDS TO BE MERGED.
* 
*         EXIT
*         ----
*         NEWHF CONTAINS A FILE OF CONFIGURATION DATA, FOLLWED BY MERGED
*         SEF RECORDS, A FILE PER DAY, WITH THE FIRST DAY BEING THE LATE
*         ERROR DATA AND THE LAST BEING THE OLDEST. 
* 
*         CALLS 
*         ----- 
*         UNJUL - DECODE JULIAN DATE FOR PRINT
* 
* 
* 
*CALL,HPACOM1 
  
      DIMENSION OLDREC (8)
      DATA ICYBEDT /0/                                                   HPA0319
  
      NOFIL   = 1 
      NOREC   = 0 
      STOP = 2HNO 
      OLDSEF = 0
  
*     COPY SCR1 CONFIGURATION DATA TO NEWHF AND POSITION NEWHF
      CALL RMREWND (SCR1) 
      CALL RMREWND (NEW)
    6 CALL RMREAD (SCR1,NFLD,LENGTH)
      IF (FEOF(SCR1) .EQ. 3HYES) GO TO 8
      CALL RMWRITE (NEW,NFLD,64)
      GO TO 6 
    8 CALL RMFILEM (NEW)
  
*         REWIND NEW AND SKIP FILE NEW
  
      CALL RMREWND (NEW)
      CALL XOVCAP ('RMSKIP',NEW,0)
      CALL UOVCAP ('RMSKIP')
  
*         REWIND OLD AND SKIP FILE OLD
  
      CALL RMREWND (OLD)
      CALL XOVCAP ('RMSKIP',OLD,0)
      CALL UOVCAP ('RMSKIP')
  
      IF (FILEP(SEF) .NE. 3HOFF) GO TO 15 
      IF (FILEP(OLD) .EQ. 3HOFF) GO TO 1100 
*         REWIND SEF, READ RECORD, GET DATE FROM RECORD 
      YDSEF = 0 
      FEOF(SCR3) = 3HYES
  
*                                                                       000740
*      *****************************************************************000750
*           SET SEF POINTER TO SCR3 FOR THIS ROUTINE                    000760
*       **************************************************************  000770
   15 CALL RMREWND (SCR3) 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
  
      YDSEF = SEFREC(1) .AND. O"7 7777 0000"
      IF (FROG(6) .EQ. L"BF") GO TO 65
  
*         PRINT PAGE HEADER FOR HISTORY UPDATE  REPORT
  
       IHDR = 13
       CALL HEADER
  
*         PRINT SUBHEADER 
  
      PRINT 50
   50 FORMAT (50H  REC    DESCRIPTION   DATE       NO. ENTRIES      ,/) 
  
      IBL = 10HSTATISTICS 
  
*         PRINT FIRST FILE ON HISTORY TAPE USAGE/TRIG 
  
      PRINT 60,NOFIL,IBL
   60 FORMAT(1X,I3,5X,A10,2X,A10,4X,I6) 
      IBL = 10HHISTORY
  
  
*       IF OLD HISTORY PRESENT, READ A RECORD 
  
   65 CONTINUE
      IF (FILEP(OLD) .EQ. 3HOFF) GO TO 100
      IF (FEOF(SCR3) .NE. 3HYES) GO TO 80 
  
*       INITIAL READ OF OLDHF SEF , IF ANY
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .NE. 3HYES) GO TO 150 
  
*      IF NO CURRENT SEF, AND NO OLDHF SEF , ENDFILE NEW AND EXIT.
      IF (FEOF(SCR3) .EQ. 3HYES) GO TO 1100 
   80 CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .NE. 3HYES) GO TO 150 
  
  100 YDOLD = 0 
      GO TO 450 
  
  
  150 YDOLD = OLDREC(1) .AND. O"7 7777 0000"
      TEMP = YDOLD
  
  
*        COMPARE DATE AND TIME OF SEF WITH OLD
  
  200 IF (FEOF(OLD) .EQ. 3HYES) GO TO 450 
      IF (FEOF(SCR3) .EQ. 3HYES) GO TO 650
      YTOLD = SHIFT (OLDREC(2),18)
      YTOLD = YTOLD .AND. O"77 7777"
  
  210 YTSEF = SHIFT (SEFREC(2),18)
      YTSEF = YTSEF .AND. O"777777" 
  
  
*       IF THE SEF IS LATER DATE, COPY THE SEF TILL 
*          CHANGE OF DATE, OR EOF.
      IF (YDSEF .GT. YDOLD) GO TO 450 
      IF (YDOLD .GT. YDSEF) GO TO 300 
      IF(YTOLD.GT.YTSEF)GO TO 400                                        HPA402J
      IF(YTSEF.GT.YTOLD)GO TO 510                                        HPA402J
  
*     KEEP SAME TIMESTAMP SEF DATA IF DIFFERENT MAINFRAME OR CH-EQ-UN 
      MFSEF = SHIFT (SEFREC(1),9) .AND. O"77" 
      MFOLD = SHIFT (OLDREC(1),9) .AND. O"77" 
      IF (MFSEF .NE. MFOLD) GO TO 400 
      ESTSEF = SHIFT (SEFREC(1),33) .AND. O"77777"
      ESTOLD = SHIFT (OLDREC(1),33) .AND. O"77777"
      IF (ESTSEF .NE. ESTOLD) GO TO 400 
* 
*       RECORD ALREADY IN HISTORY, DISCARD AND GET NEXT.
      ICYBEDT=0                                                          HPA402J
*     SAVE ALL SPA PREVIOUS CHANGES 
      IF(AND(OLDREC(1),O"7777") .GE. O"550"  .AND.
     .        AND(SHIFT(OLDREC(2),-30),O"77") .EQ. O"77") GO TO 510 
      IF(AND(SEFREC(1),O"7777").GE.O"550".AND.
     .       AND(SHIFT(SEFREC(2),-30),O"77").EQ.O"77")ICYBEDT=1 
      GO TO 500 
  
  300 OLDSEF = OLDSEF + 1 
      IF (OLDSEF .GT. 1) GO TO 320
      NDAY = SHIFT(YDSEF, -12) .AND. O"777" 
      NYEAR = SHIFT (YDSEF, -21) .AND. O"77"
      CALL UNJUL (NYEAR,NDAY) 
      PRINT 310,IYEAR 
  310 FORMAT (/,8X,'  --- WARNING --- HISTORY UPDATE NOT CURRENT ', 
     ./,'   SEF DATA BEING ADDED TO HISTORY HAS', 
     .' DATE OF -- ',A10,/) 
  
  320 TEMP = YDOLD
      GO TO 600 
  
*                *****************************
*             COPY SEF REC TO NEW 
*                *****************************        *** 
  400 IF (FEOF(SCR3) .EQ. 3HYES) GO TO 650
  
      CALL RMWRITE (NEW,SEFREC,8) 
      NOREC = NOREC + 1 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      YD = SEFREC(1) .AND. O"7 7777 0000" 
      YDSEF = YD
      IF (FEOF(SCR3) .NE. 3HYES) GO TO 210
      IF (FEOF(OLD) .EQ. 3HYES) STOP = 3HYES
  
  425 TEMP = YDSEF
      YDSEF = YD
      IF(STOP.EQ.3HYES) GO TO 700 
      IF (TEMP .EQ. YDOLD) GO TO 200
      GO TO 700 
  
  440 YD = SEFREC(1) .AND. O"7 7777 0000" 
      IF (YD .NE. YDSEF) GO TO 425
  
  450 CALL RMWRITE (NEW,SEFREC,8) 
      NOREC = NOREC + 1 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      IF (FEOF(SCR3) .NE. 3HYES) GO TO 440
      IF (FEOF(OLD) .EQ. 3HYES) STOP = 3HYES
      TEMP = YD 
      GO TO 425 
* 
*                 **************************
  
  500 IF (ICYBEDT .NE. 0) CALL RMWRITE (NEW,SEFREC,8) 
      CALL RMREAD (SCR3,SEFREC,LENGTH)
      YDSEF = SEFREC(1) .AND. O"7 7777 0000"
      IF (FEOF(SCR3) .EQ. 3HYES) GO TO 650
  510 IF (ICYBEDT .EQ. 0) CALL RMWRITE (NEW,OLDREC,8) 
      ICYBEDT=0                                                          HPA402J
      NOREC = NOREC + 1 
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 620 
      GO TO 200 
  
  
*                *****************************
*                MOVE OLD REC TO OUTPUT BUFFER        600 OLD TO NEW
*                *****************************        *** 
  
  600 IF (FEOF(OLD) .EQ. 3HYES) GO TO 625 
  
      CALL RMWRITE (NEW,OLDREC,8) 
      NOREC = NOREC + 1 
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 620 
      YD = OLDREC(1) .AND. O"7 7777 0000" 
      GO TO 650 
  620 OLDREC(1) = 7HENDFILE                                             000540
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .NE. 3HYES) GO TO 627 
  622 FEOF(OLD) = 3HYES 
      TEMP = YDOLD
  625 IF (FEOF(SCR3) .EQ. 3HYES) STOP = 3HYES 
        IF(FEOF(OLD) .EQ. 3HYES) STOP = 3HYES 
      IF (YDOLD .GT. YDSEF) GO TO 700 
      GO TO 450 
                                                                        001300
  627 IF (OLDREC(1) .EQ. 7HENDFILE) GO TO 622                           001310
      YD = OLDREC(1) .AND. O"7 7777 0000" 
      IF (YD .EQ. YDOLD) GO TO 650
      TEMP = YDOLD
      YDOLD = YD
      IF (TEMP .GT. YDSEF) GO TO 700
      GO TO 450 
* 
  650 IF (ICYBEDT .EQ. 0) CALL RMWRITE (NEW,OLDREC,8) 
      ICYBEDT=0                                                          HPA402J
      NOREC = NOREC + 1 
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .NE. 3HYES) GO TO 650 
      OLDREC(1)=7HENDFILE 
      CALL RMREAD (OLD,OLDREC,LENGTH) 
      IF (FEOF(OLD) .EQ. 3HYES) GO TO 680 
***    SINGLE EOF DETECTED THE DATE ADVANCED  *** 
      YD=OLDREC(1) .AND. O"777770000" 
      TEMP=YDOLD
      YDOLD=YD
      GO TO 700 
680   CONTINUE
***    DOUBLE EOF DETECTED  END OF INFORMATION   ***
      STOP=3HYES
      GO TO 700 
  
*        ******************************** 
*        COMPARE DATES AND OUTPUT RECORDS             800 OUTPUT RECORD 
  
  
  700 CALL RMFILEM (NEW)
      NOFIL = NOFIL + 1 
      NDAY = SHIFT (TEMP, -12) .AND. O"777" 
      NYEAR = SHIFT (TEMP, -21) .AND. O"77" 
           CALL UNJUL (NYEAR,NDAY)
      IF (FROG(6) .EQ. L"BF") GO TO 910 
  
*          PRINT FILE NUMBER OUT AND DATE OF FILE 
  
      PRINT 60, NOFIL,IBL,IYEAR,NOREC 
  910 CONTINUE
      IF (FEOF(SCR3) .EQ. 3HYES) TEMP = YD
      IF (FEOF(OLD) .EQ. 3HYES) TEMP = YD 
      NOREC = 0 
  
*         LIMIT HISTORY PARAMETER 
      IF (NOFIL .GT. FROG(9) ) GO TO 950
      IF (STOP .EQ. 3HYES) GO TO 1100 
      GO TO 200 
*          *******************************
  
*      *********************************
*      END OF JOB FLUSH BUFFER WRITE EOF             1000  END
*      *********************************             ****  ***
  
  950 PRINT 955,FROG(9) 
  955 FORMAT (/,'  HISTORY LIMITED AT ',I3,' DAYS') 
  
  
 1100 CALL RMFILEM (NEW)
      CALL RMREWND (NEW)
*                                                                       000800
       RETURN 
       END
      SUBROUTINE UNJUL ( NYEAR,NDAY ) 
* 
**        UNJUL - CONVERTS JULIAN DATE INTO CALENDER DATE,
* 
*         DATA AREAS
*         --------------------- 
*         IMON   - (12)/LOCAL TO SUBROUTINE/TABLE OF DAYS OF
*                  EACH MONTH IN THE YEAR.
*         IT     - (1)/LOCAL TO SUBROUTINE/TEMPORARY USAGE. 
*         NYEAR  - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  YEAR IN BINARY FORM BIASED BY 1970 AT ENTRY, 
*                  AND THE CALENDER DATE IN CODED FORM AT EXIT. 
*         NDAY   - (1)/LOCAL TO SUBROUTINE/FORMAL PARAMETER OF
*                  JULIAN DAY IN BINARY FORM. 
*         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. 
* 
*        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 INVALID YEAR INPUT
      IF ( IT .LT. 100) GO TO 10
      PRINT 5,NYEAR 
    5 FORMAT ( ' UNJUL -- INVALID YEAR PARAMETER = ',I10) 
      GO TO 900 
  
*        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 
* 
  900 RETURN
      END 
