C
C         IMPORTANT NAMES & DATES         by Bruce W. Roeckel
C       *--------------------------*                         
C
$STORAGE:2
C
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,JULIAN,MNUM
      INTEGER STRID(200),JULIAN(366,5),MNUM
C
      COMMON/MAIN3/ NAME,ANIV,BDAY,XMAS
      CHARACTER NAME(6,200)*12,ANIV(200)*8,BDAY(6,200)*8,XMAS(12,200)*2
C
      COMMON /REVNO/ PGM,AUTHOR,YEAR,DATE,REV
      CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
C
      COMMON/LETT/ALPHA,ALPH2
      CHARACTER*1 ALPHA(26),ALPH2(26)
C
      CHARACTER OPTION*25,TEST*8,KEY*1,SEL*2
      LOGICAL*2 CHECK
C
C           SET UP COMMON BLOCK OF ALPHABET
C
      ALPHA(1)='A'
      ALPHA(2)='B'
      ALPHA(3)='C'
      ALPHA(4)='D'
      ALPHA(5)='E'
      ALPHA(6)='F'
      ALPHA(7)='G'
      ALPHA(8)='H'
      ALPHA(9)='I'
      ALPHA(10)='J'
      ALPHA(11)='K'
      ALPHA(12)='L'
      ALPHA(13)='M'
      ALPHA(14)='N'
      ALPHA(15)='O'
      ALPHA(16)='P'
      ALPHA(17)='Q'
      ALPHA(18)='R'
      ALPHA(19)='S'
      ALPHA(20)='T'
      ALPHA(21)='U'
      ALPHA(22)='V'
      ALPHA(23)='W'
      ALPHA(24)='X'
      ALPHA(25)='Y'
      ALPHA(26)='Z'
      ALPH2(1)='a'
      ALPH2(2)='b'
      ALPH2(3)='c'
      ALPH2(4)='d'
      ALPH2(5)='e'
      ALPH2(6)='f'
      ALPH2(7)='g'
      ALPH2(8)='h'
      ALPH2(9)='i'
      ALPH2(10)='j'
      ALPH2(11)='k'
      ALPH2(12)='l'
      ALPH2(13)='m'
      ALPH2(14)='n'
      ALPH2(15)='o'
      ALPH2(16)='p'
      ALPH2(17)='q'
      ALPH2(18)='r'
      ALPH2(19)='s'
      ALPH2(20)='t'
      ALPH2(21)='u'
      ALPH2(22)='v'
      ALPH2(23)='w'
      ALPH2(24)='x'
      ALPH2(25)='y'
      ALPH2(26)='z'
C
C           DISPLAY ROCKSOFT HEADER
C
      PGM='Names & Dates        '
      AUTHOR='Bruce W. Roeckel     '
      YEAR='1986'
      REV='05'
      CALL MHEAD(PGM,AUTHOR,YEAR,REV,DATE)
      CALL TOP(PGM,DATE)
C
C           READ THE DATABASE INTO CORE
C
      CALL RDMAST
      CALL RDDATE
      CALL FILLUP
C
C           CHECK FOR HELP DOCUMENT FILE
C
      IHLP=0
      INQUIRE(FILE='NAMES.HLP',EXIST=CHECK)
      IF(CHECK .EQV. .TRUE.) THEN
         IHLP=1
         OPEN(15,FILE='NAMES.HLP')
      ENDIF
C
C           NOW DISPLAY MAIN MENU
C
  100 CONTINUE
      OPTION='Main Menu'
      CALL HEADER(OPTION)
         WRITE(*,150)
  150    FORMAT(/,3X,'Total Entries in',
     A          /,3X,'Master File: ',\)
         CALL BOLD
         WRITE(*,'(I3)') MNUM
         CALL OFF
      WRITE(*,200) 
  200 FORMAT(  
     A    ////,20X,' 1. Browse Entire Master File   ',
     B       /,20X,' 2. Edit Names & Dates Info     ',
     C       /,20X,' 3. Display Monthly Calendar    ',
     D       /,20X,' 4. Print Names & Dates Data    ')
C
C            ASK FOR SELECTION, THEN BRANCH BASED ON INPUT
C
  300 CONTINUE
      IV=21
      IH=1
      CALL MOVEIT(IH,IV)
      WRITE(*,'(/,5X,A37,\)') 'Enter Menu Choice (H=Help, Q=Quit) : '
         READ(*,'(A2)',ERR=100) SEL 
         CALL OFF
         IF (SEL.EQ.' ') THEN
            GOTO 300
         ELSEIF((SEL.EQ.'H') .OR. (SEL.EQ.'h')) THEN
            KEY=' '
            LU=15
            CALL HELP(KEY,LU)
         ELSEIF(SEL.EQ.'1') THEN
            CALL LOOK
         ELSEIF(SEL.EQ.'2') THEN
            CALL UPDATE
         ELSEIF(SEL.EQ.'3') THEN
            CALL CALEND
         ELSEIF(SEL.EQ.'4') THEN
            CALL SUMMAR
         ELSEIF((SEL.EQ.'Q') .OR. (SEL.EQ.'q')) THEN
            IF(IHLP.EQ.1) CLOSE(15)
            CALL CLS
            STOP
         ENDIF
      GOTO 100
      END
C
C
C
      SUBROUTINE RDMAST
C
      COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
      CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
      CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
      CHARACTER PH1(200)*14,PH2(200)*14
C
      COMMON/MAIN2/ STRID,JULIAN,MNUM
      INTEGER STRID(200),JULIAN(366,5),MNUM
C
      CHARACTER*25 OPTION
C
C            OPEN FILE FOR INPUT
C
      OPTION='Loading Master File .....'
      CALL HEADER(OPTION)
      CALL KEYOFF
      OPEN(20,FILE='ADDRESS.DAT')
C
C            READ ALL DATA FROM MASTER FILE
C
      I=0
  100 CONTINUE
      I=I+1
      IF(I.GT.200) THEN
         WRITE(*,'(A33)') 'Program Aborted Reading Master   '
         STOP
      ENDIF
      READ(20,200,END=300) (LAST(K,I),K=1,12),
     A                     FIRST(I),ADD1(I),ADD2(I),CITY(I),
     A                     STATE(I),ZIP(I),PH1(I),PH2(I),
     A                     STRID(I)
  200 FORMAT(12A1,A23,A30,A30,A23,A2,A5,A14,A14,8X,I3)
      GOTO 100
  300 CONTINUE
      MNUM=I-1
      CLOSE(20)
      CALL KEYON
      RETURN
      END
C
C
C
      SUBROUTINE RDDATE
C
C               THIS ROUTINE READS IN THE NAMES&DATES DATABASE
C
      COMMON/MAIN3/ NAME,ANIV,BDAY,XMAS
      CHARACTER NAME(6,200)*12,ANIV(200)*8,BDAY(6,200)*8,XMAS(12,200)*2
C
      CHARACTER OPTION*25
C
C            OPEN FILE FOR INPUT
C
      OPTION='Loading Names & Dates ...'
      CALL HEADER(OPTION)
      CALL KEYOFF
C
C            CLEAR ARRAYS FIRST
C
      DO 20 K=1,200
      ANIV(K)=' '
      DO 20 J=1,6
      NAME(J,K)=' '
      BDAY(J,K)=' '
      XMAS(J,K)=' '
      XMAS(J+6,K)=' '
   20 CONTINUE
      OPEN(20,FILE='NAMES.DAT')
C
C            READ ALL DATA FROM FILE
C
  100 CONTINUE
      READ(20,200,END=300) I,(NAME(K,I),K=1,6),
     A                       (BDAY(K,I),K=1,6),
     B                       (XMAS(K,I),K=1,12),ANIV(I)
  200 FORMAT(I3,6A12,6A8,12A2,A8)
      GOTO 100
  300 CONTINUE
      CLOSE(20)
      CALL KEYON
      RETURN
      END
C
C
C
      SUBROUTINE FILLUP
C
C               THIS ROUTINE CALCULATES THE JULIAN DATES      
C
      COMMON/MAIN2/ STRID,JULIAN,MNUM
      INTEGER STRID(200),JULIAN(366,5),MNUM
C
      COMMON/MAIN3/ NAME,ANIV,BDAY,XMAS
      CHARACTER NAME(6,200)*12,ANIV(200)*8,BDAY(6,200)*8,XMAS(12,200)*2
C
      COMMON /REVNO/ PGM,AUTHOR,YEAR,DATE,REV
      CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
C
      CHARACTER OPTION*25,TDATE*8
C
C            DISPLAY MESSAGE TO SCREEN
C
      OPTION='Calculating Julian Dates '
      CALL HEADER(OPTION)
      CALL KEYOFF
C
C            EXTRACT THE YEAR FROM TODAYS DATE
C
      WRITE(OPTION,'(A8)') DATE
      READ(OPTION,'(6X,I2)') IYY
C
C            CLEAR JULIAN DATE ARRAY FIRST
C
      DO 10 K=1,366
      DO 10 L=1,5
      JULIAN(K,L)=0
   10 CONTINUE
C
C            BUZZ THROUGH ENTIRE DATABASE, STORE STRUCTURE ID IN ARRAY
C
      DO 300 I=1,200
      DO 250 L=1,7
      IF(L.LE.6) THEN
         IF(BDAY(L,I).EQ.' ') GOTO 250
         WRITE(OPTION,'(A8)') BDAY(L,I)
      ELSE
         IF(ANIV(I).EQ.' ') GOTO 250
         WRITE(OPTION,'(A8)') ANIV(I)
      ENDIF
      READ(OPTION,'(I2,1X,I2)',ERR=250) IMM,IDD
      WRITE(OPTION,'(I2,A1,I2,A1,I2)') IMM,'/',IDD,'/',IYY
      READ(OPTION,'(A8)') TDATE
C
C           GO GET THE JULIAN EQUIVILANT DATE
C
      CALL DATEJL(TDATE,IDAY)
      IF(IDAY.LE.0) THEN    
         WRITE(*,'(///,10X,A26)') 'JULIAN DATE MISCALCULATION'
         WRITE(*,'(4I4,A10)') I,L,IYY,IDAY,TDATE
         STOP
      ENDIF
C
C           FIND NEXT AVAILABLE SLOT IN ARRAY FOR STORAGE
C
      DO 230 M=1,5
      IF(JULIAN(IDAY,M).EQ.0) THEN
         JULIAN(IDAY,M) = I
         GOTO 250
      ENDIF
  230 CONTINUE
      WRITE(*,'(///,10X,A27)') 'OUT OF ARRAY SPACE - JULIAN'
      STOP
  250 CONTINUE
  300 CONTINUE
      CALL KEYON
      RETURN
      END
C
C
C
      SUBROUTINE WRDATE
C
      COMMON/MAIN3/ NAME,ANIV,BDAY,XMAS
      CHARACTER NAME(6,200)*12,ANIV(200)*8,BDAY(6,200)*8,XMAS(12,200)*2
C
      CHARACTER*25 OPTION
C
C            OPEN FILE FOR OUTPUT
C
      OPTION='Storing Names & Dates ...'
      CALL HEADER(OPTION)
      CALL KEYOFF
      OPEN(20,FILE='NAMES.DAT')
C
C            STORE ALL DATA IN FILE
C
      DO 200 I=1,200
      IF(NAME(1,I).NE.' '.OR.XMAS(1,I).NE.' '.OR.XMAS(7,I).NE.' '.OR.  
     A   BDAY(1,I).NE.' '.OR.ANIV(I).NE.' ') THEN
         WRITE(20,100) I,(NAME(K,I),K=1,6),
     A                   (BDAY(K,I),K=1,6),
     B                   (XMAS(K,I),K=1,12),ANIV(I)
  100    FORMAT(I3,6A12,6A8,12A2,A8)
      ENDIF   
  200 CONTINUE
      CLOSE(20)
      CALL KEYON
      RETURN
      END
