C
$STORAGE:2
C
C
C        *******************************************************
C        *                                                     *
C        *   The following Subroutines are used for the        *
C        *   Standard Headers for all ROCKSOFT programs        *
C        *                                                     *
C        *******************************************************
C
C
      SUBROUTINE MHEAD(PGM,AUTHOR,YEAR,REV,DATE)
C
C          This routine prints the copyright header
C
      IMPLICIT INTEGER (A-Z)
      CHARACTER PGM*21,AUTHOR*21,TITLE*40,RELOC*11
      CHARACTER RAMDSK*80,TYPE*6,ONE*1,TWO*1,DATE*8,REV*2,YEAR*4
      LOGICAL*2 CHECK
C
C          DRAW TWO BOXES ON SCREEN         
C
      HEIGHT=5
      WIDTH=80
      HORZ=1
      VERT=2
      TITLE=' '
      TLEN=0
      TATTR=0
      BATTR=0
         CALL CLS
         CALL BOLD
         CALL BOX(HEIGHT,WIDTH,HORZ,VERT,TITLE,TLEN,TATTR,BATTR)
      VERT=16 
      HEIGHT=8
         CALL BOLD
         CALL BOX(HEIGHT,WIDTH,HORZ,VERT,TITLE,TLEN,TATTR,BATTR)
C
C          NOW, START OUT WITH THE MAJOR HEADING
C
      CALL UPTOP(4,4)
      WRITE(*,'(23X,A28,\)') 'DEC Rainbow 100 Software by:'
C
C          SECOND, DRAW THE ROCKSOFT LOGO
C
      CALL UPTOP(4,10)
      CALL BOLD
      CALL DHTOP
         WRITE(*,100)
  100    FORMAT(12X,'* ROCKSOFT *',\)
      CALL UPTOP(4,11)
      CALL BOLD
      CALL DHBOT
         WRITE(*,100)
      CALL OFF
C
C           NOW PRINT OTHER ASSORTED GOODIES
C
      CALL UPTOP(4,13)
         WRITE(*,'(28X,A13,A4,\)') 'Copyright (c)',YEAR
C
      WRITE(RAMDSK,'(A21,A7,A2)') PGM,', Ver. ',REV  
      CALL SQUISH(RAMDSK,30)
      TYPE='LEFT  '
      CALL JUSTIF(TYPE,RAMDSK,30)
      CALL UPTOP(4,18)
      CALL BOLD
         WRITE(*,'(9X,A9,\)') 'Program: '
      CALL OFF
         WRITE(*,'(A30,\)') RAMDSK
C
      CALL UPTOP(4,19)
      CALL BOLD
         WRITE(*,'(9X,A9,\)') 'Author : '
      CALL OFF
         WRITE(*,'(A21,\)') AUTHOR   
C
C           CHECK FOR DATE FILE IN THE MEMORY DRIVE  
C
      CALL BLINK
      CALL BOLD
      INQUIRE(FILE='F:TODAY.DAT',EXIST=CHECK)
      IF(CHECK.EQV..TRUE.) THEN     

         OPEN(UNIT=5,FILE='F:TODAY.DAT')
         READ(5,'(A8)') DATE
         CLOSE(5)
         CALL UPTOP(4,21)
         WRITE(*,200)
  200    FORMAT(9X,'Please Press <RETURN> to Begin Execution ',\)
         READ(*,'(A1)') ONE

      ELSE

  300    CONTINUE
         CALL UPTOP(4,21)
         WRITE(*,350)
  350    FORMAT(9X,'Please Enter TODAY"S Date (MM/DD/YY): [  /  /  ]',\)
         CALL CURLT(10)
         READ(*,'(A8,\)',ERR=300) DATE
         WRITE(RAMDSK,'(A8)') DATE
         READ(RAMDSK,375,ERR=300) IMON,ONE,IDAY,TWO,IYEAR
  375    FORMAT(I2,A1,I2,A1,I2)
C
C            CHECK IF DATE ENTERED MAKES SENSE
C
         IF((ONE.NE.'/') .OR. (TWO.NE.'/')  .OR.    
     A      (IMON.LE.0) .OR. (IMON.GT.12)   .OR.   
     B      (IDAY.LE.0) .OR. (IDAY.GT.32)   .OR.   
     C      (IYEAR.LE.80) .OR. (IYEAR.GT.99)) THEN    
            CALL UPTOP (4,22)
            WRITE(*,'(9X,A32,\)') 'Invalid DATE Entered - Try Again'
            CALL BELL
            GOTO 300
         ENDIF

      ENDIF
C
C            THATS ALL FOR NOW FOLKS
C
  900 CONTINUE
      CALL OFF
      CALL CLS
      RETURN
      END
C
C
C
      SUBROUTINE TOP(PGM,DATE)
C
C          This Routine displays the STANDARD Screen Header
C
      CHARACTER PGM*21,DATE*8,TODAY*28,RELOC*11
C
C          CONVERT DATE, THEN PRINT HEADER
C
      CALL CLS
      CALL DATETD(DATE,TODAY)
      CALL BOLD
      CALL DHTOP
      CALL LOCATE(1,1,RELOC)
         WRITE(*,'(A11,A21)') RELOC,PGM
      CALL DHBOT
      CALL LOCATE(1,2,RELOC)
         WRITE(*,'(A11,A21)') RELOC,PGM
      CALL OFF
C
C        PRINT TODAYS DATE
C
      CALL LOCATE(53,3,RELOC)
      WRITE(*,'(A11,A28)') RELOC,TODAY
C
C        DRAW A SOLID LINE
C
      CALL BOLD
      CALL ULINE
      CALL LOCATE(1,4,RELOC)
         WRITE(*,'(A11,80X)') RELOC
      CALL OFF
      RETURN
      END
C
C
C
      SUBROUTINE HEADER(OPTION)
C
C         This Routine Displays the OPTION under the Header (TOP)
C
      CHARACTER OPTION*25,RELOC*11
C
      CALL LOCATE(1,3,RELOC)
         WRITE(*,'(A11,A9,\)') RELOC,'Option : '
      CALL BOLD
      CALL BLINK
         WRITE(*,'(A25,\)') OPTION
      CALL OFF
      CALL MOVEIT(1,5)
      RETURN
      END
C
C
C
      SUBROUTINE PHEAD(PAGE,UNIT,PGM,DATE,YEAR,REV)
C
C          This Rouitne prints the STANDARD Printer Header
C
      INTEGER PAGE,UNIT
      CHARACTER PGM*21,DATE*8,YEAR*4,REV*2
      CHARACTER TYPE*6,STRING*80,TODAY*28
C
C          CONVERT DATE TO ALPHA, CENTER PROGRAM NAME
C
      CALL DATETD(DATE,TODAY)
      TYPE='CENTER'
      STRING=PGM
      CALL JUSTIF(TYPE,STRING,21)
C
C          INCREMENT PAGE COUNTER, START DRAWING HEADER
C
      PAGE=PAGE+1
      WRITE(UNIT,100) PAGE
  100 FORMAT(1H1,/,2X,'DEC Rainbow 100 Software',45X,'Page ',I2)
      WRITE(UNIT,200) REV,YEAR,TODAY
  200 FORMAT(2X,'Ver. ',A2,', (c) ',A4,' by Rocksoft',19X,A28)
C
C          PRINT THE PROGRAM NAME FOR REFERENCE
C
      WRITE(UNIT,300)
  300 FORMAT(1X,'*',76('-'),'*')
      WRITE(UNIT,'(29X,A21)') STRING
      WRITE(UNIT,300)
C
C          THAT ALL FOR NOW FOLKS
C
      RETURN
      END
