PROGRAM HEDARC
***********************************************************************      
***********************************************************************      
***********************************************************************      
****                                                               ****      
**** P R O G R A M   H E D A R C                                   ****
****                                                               ****      
****                                                               ****   
**** W R I T T E N   B Y   B O B   M U L L E N                     ****
**** ILLINOIS CENTRAL GULF RAILROAD                                ****
****                                                               ****      
**** THIS ROUTINE PRINTS THE HEADER FOR THE ARCHIVE PROGRAM        ****
****                                                               ****
***********************************************************************      
***********************************************************************      
***********************************************************************      
     MODIFIED PROGRAM HEADER 6/80 TO READ DATA STRUCTURE NUMBER
     AND RENAMED TO PROGRAM HEDARC - SGC

     BYTE DDATE(9),TTIME(8),YES,II,NO
     INTEGER ARC(2),IOP(4),IDSN
     DATA YES,NO /'Y','N'/
     DATA ARC /3RDAY,3RARC/
     DATA IOP/0,0,110,0/

     GET CURRENT DATE AND TIME

     CALL DATE(DDATE)
     CALL TIME(TTIME)

     PRINT HEADER AND PROMPT FOR ARCHIVE OR NOT

0    FORMAT(1X,72('*'))
     WRITE(6,10)
     WRITE(6,10)
     WRITE(6,10)
     WRITE(6,20)
  20 FORMAT (1X,'****',64X,'****')
     WRITE(6,20)
     WRITE(6,20)
     WRITE(6,30) DDATE,TTIME
30   FORMAT (1X,'****  S T A R T   O F   A R C H I V E ',9A1,
    1 1X,8A1,T70,'****')
     WRITE(6,20)
     WRITE(6,20)
5    WRITE(6,40)
0    FORMAT ('$','**** SHOULD AN ARCHIVE BE MADE TODAY (ENTER YES',
    1 ' OR NO) ?' )
     READ(5,45) II
45   FORMAT (A1)
     WRITE(6,47)
47   FORMAT ('+',T70,'****')
     WRITE(6,50)
50   FORMAT (' ','****',T70,'****')
     IF (II .NE. YES .AND. II .NE. NO) GO TO 35
     IF (II .EQ. NO) GO TO 70

     ARCHIVE WANTED, GET LOCATION OF CATALOG AND USER FILE TO BE USED

  52 WRITE(6,55)
  55 FORMAT('$**** DATA STRUCTURE TO BE ACCESSED (I.E. 1,2,3...) ?>')
     READ(5,60)IDSN,II
  60 FORMAT(I1,A1)
     IF(II.NE.' '.AND.II.NE.',') GO TO 52
     WRITE(6,50)

     SEND DATA STRUCTURE NO. TO ARCHIVE AND START ARCHIVE

     CALL VSEND(ARC,IDSN,1,1,110,,IDS)
     IF(IDS.GE.1) GO TO 62
     WRITE(6,65) IDS
  65 FORMAT(' HEADER-ERROR SENDING ACCOUNT INFO TO ARCHIVE, IDS=',I5)
     GO TO 70
  62 CALL START(ARC,5,2,IDS)
     IF(IDS.EQ.1) GO TO 70
     WRITE(6,68)
  68 FORMAT(' HEADER-REQUEST TO START ARCHIVE NOT ACCEPTED')

  70 CONTINUE
     WRITE(6,20)
     WRITE(6,20)
     WRITE(6,10)
     WRITE(6,10)
     WRITE(6,10)
     CALL EXIT
     END