C
C         IMPORTANT NAMES & DATES         by Bruce W. Roeckel
C       *--------------------------*                         
C          OPTION #2 - UPDATE                                
C
C
$STORAGE:2
C
C
      SUBROUTINE UPDATE
C
C          CONTROLS UPDATING OF MASTER RECORDS
C
      CHARACTER*1 SEL
      CHARACTER*25 OPTION
C
C          CALL HEADER WITH OPTION PARAMETER
C
   50 CONTINUE
      OPTION='Update Names & Dates'
      CALL HEADER(OPTION)
C
C          PRINT OPTIONS MENU          
C
      IH=1
      IV=20
      CALL UPTOP(IH,IV)
         WRITE(*,'(X)')
      CALL ULINE
         WRITE(*,'(80X)')
      CALL OFF
C
C          PRINT MAP , THEN PROCESS DATA
C
      CALL MAP
  100 CONTINUE
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
         WRITE(*,150)
  150    FORMAT('    ( )dit    ( )elp    ( )uit                    ',
     A          '       Option ==> [ ]       ',\)
      CALL BOLD
      CALL UPTOP(IH+7 ,IV)
         WRITE(*,'(A1)') 'E'
      CALL UPTOP(IH+17,IV)
         WRITE(*,'(A1)') 'H'
      CALL UPTOP(IH+27,IV)
         WRITE(*,'(A1)') 'Q'
      CALL OFF
      CALL UPTOP(IH+71,IV)
         READ(*,'(A1)') SEL
            IF((SEL.EQ.'E') .OR. (SEL.EQ.'e')) THEN
               CALL FINDIT
               CALL MAP
            ELSEIF((SEL.EQ.'Q') .OR. (SEL.EQ.'q')) THEN
               CALL FILLUP
               CALL WRDATE
               RETURN
            ELSEIF((SEL.EQ.'H') .OR. (SEL.EQ.'h')) THEN
               SEL='2'
               LU=15
               CALL HELP(SEL,LU)
               GOTO 50
            ENDIF
      GOTO 100
      END
C
C
C
      SUBROUTINE FINDIT
C
C            THIS ROUTINE FINDS SELECTION TO EDIT
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 LNAME(12)*1,SEL*1
      INTEGER KEEP
C
      COMMON/LETT/ALPHA,ALPH2
      CHARACTER*1 ALPHA(26),ALPH2(26)
C
C          ISSUE INSTRUCTIONS           
C
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
         WRITE(*,50)
   50    FORMAT('        (E)dit ...... Please enter the first 3 ',
     A          'characters of last name        ')
      CALL OFF
C
C          READ LAST NAME, FIND A MATCH
C
      IV=7 
      IH=22 
      CALL UPTOP(IH,IV)
         READ(*,'(12A1)') (LNAME(K),K=1,12)
C
C          SEARCH THROUGH ALL RECORDS FOR ENTRY
C
      KEEP=0
  100 CONTINUE
      DO 300 I=KEEP+1,MNUM
      DO 200 K=1,3
      IC=0
      IM=0
         DO 150 J=1,26
         IF((LNAME(K).EQ.ALPHA(J)) .OR. (LNAME(K).EQ.ALPH2(J)))IC=J
         IF((LAST(K,I).EQ.ALPHA(J)) .OR. (LAST(K,I).EQ.ALPH2(J)))IM=J
  150    CONTINUE
      IF(IC.NE.IM) GOTO 300
  200 CONTINUE
C
C          ASK IF MATCH O.K.            
C
      KEEP=I
      CALL SHOWIT(KEEP)
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
      CALL BLINK
         WRITE(*,500)
  500    FORMAT('                                               ',
     A          '  Edit entry ? (Y,N,Q)  [ ]    ',\)
      CALL OFF
         IV=6
         CALL CURLT(IV)
         READ(*,'(A1)') SEL
            IF((SEL.EQ.'N') .OR. (SEL.EQ.'n')) GOTO 100
            IF((SEL.EQ.'Y') .OR. (SEL.EQ.'y')) GOTO 400
            RETURN
  300 CONTINUE
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
      CALL BLINK
      CALL BELL
         WRITE(*,350)
  350    FORMAT('                                                  ',
     A          '  No Match ... Press <RET>  ',\)
         READ(*,'(A1)') IDUM
         RETURN  
  400 CONTINUE
      CALL EDITIT(KEEP)
      RETURN
      END
C
C
C
      SUBROUTINE SHOWIT(KEEP)
C
C          THIS ROUTINE WILL DISPLAY SELECTION ON SCREEN
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
C             DISPLAY SELECTED RECORD OF INFORMATION
C
      IV=7 
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(12A1)') (LAST(J,KEEP),J=1,12)
      IV=7 
      IH=36
      CALL UPTOP(IH,IV)
         WRITE(*,'(A23)') FIRST(KEEP)
      IKEY = STRID(KEEP)
      IV=9 
      IH=32
      CALL UPTOP(IH,IV)
         IF(ANIV(IKEY).NE.' ') THEN
            WRITE(*,'(A8)') ANIV(IKEY)
         ELSE
            WRITE(*,'(A8)') '__/__/__'
         ENDIF
      IV=11
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(1,IKEY).NE.' ' .OR. BDAY(1,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(1,IKEY),BDAY(1,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=12
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(2,IKEY).NE.' ' .OR. BDAY(2,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(2,IKEY),BDAY(2,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=13
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(3,IKEY).NE.' ' .OR. BDAY(3,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(3,IKEY),BDAY(3,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=14
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(4,IKEY).NE.' ' .OR. BDAY(4,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(4,IKEY),BDAY(4,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=15
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(5,IKEY).NE.' ' .OR. BDAY(5,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(5,IKEY),BDAY(5,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=16 
      IH=32
      CALL UPTOP(IH,IV)
         IF(NAME(6,IKEY).NE.' ' .OR. BDAY(6,IKEY).NE.' ') THEN
            WRITE(*,'(A12,2X,A8)') NAME(6,IKEY),BDAY(6,IKEY)
         ELSE
            WRITE(*,'(A23)') '____________  __/__/__ '
         ENDIF
      IV=18
      IH=40
      CALL UPTOP(IH,IV)
         IF(XMAS(1,IKEY).NE.' ' ) THEN
            WRITE(*,'(6(A2,1X))') (XMAS(K,IKEY),K=1,6)
         ELSE
            WRITE(*,'(A17)') '__ __ __ __ __ __'
         ENDIF
      IV=19 
      IH=40
      CALL UPTOP(IH,IV)
         IF(XMAS(7,IKEY).NE.' ' ) THEN
            WRITE(*,'(6(A2,1X))') (XMAS(K,IKEY),K=7,12)
         ELSE
            WRITE(*,'(A17)') '__ __ __ __ __ __'
         ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE EDITIT(KEEP)
C
C         THIS ROUTINE EXECUTES THE FULL SCREEN EDITOR
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
      CHARACTER TDATE*8,TNAME*12
      INTEGER KEEP,RESHOW
C
C         ISSUE INSTRUCTIONS 
C
      IKEY=STRID(KEEP)
  100 CONTINUE
      RESHOW=0
      IH=48
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
         WRITE(*,'(A30)') '   <RET> = tab w/o change     '
      CALL OFF
C
C          NOW, EDIT ANNIVERSARY DATE
C
      IV=9 
      IH=32
      CALL UPTOP(IH,IV)
            READ(*,'(A8)') TDATE
            IF(TDATE.EQ.'*') THEN
               RESHOW=1
               ANIV(IKEY) = ' '
            ELSEIF(TDATE.NE.' ') THEN
               RESHOW=1
               ANIV(IKEY) = TDATE
            ENDIF
C
C          DO ALL BIRTHDAYS NEXT
C
      IV=10
      DO 200 K=1,6
      IV=IV+1
      IH=32
      CALL UPTOP(IH,IV)
            READ(*,'(A12)') TNAME
            IF(TNAME.EQ.'*') THEN
               RESHOW=1
               NAME(K,IKEY) = ' '
            ELSEIF(TNAME.NE.' ') THEN
               RESHOW=1
               NAME(K,IKEY) = TNAME 
            ENDIF
      IH=46
      CALL UPTOP(IH,IV)
            READ(*,'(A8)') TDATE
            IF(TDATE.EQ.'*') THEN
               RESHOW=1
               BDAY(K,IKEY) = ' '
            ELSEIF(TDATE.NE.' ') THEN
               RESHOW=1
               BDAY(K,IKEY) = TDATE
            ENDIF
  200 CONTINUE
C
C             BLAST THROUGH THE XMAS CARD STUFF
C
      IH=37
      IV=18
      DO 700 K=1,12
      IF(K.EQ.7) THEN 
         IV=19
         IH=37
      ENDIF
      IH=IH+3
      CALL UPTOP(IH,IV)
         READ(*,'(A2)') TNAME
         IF(TNAME.EQ.'*') THEN
            RESHOW=1
            XMAS(K,IKEY) = ' '
         ELSEIF(TNAME.NE.' ') THEN
            RESHOW=1
            XMAS(K,IKEY) = TNAME
         ENDIF
  700 CONTINUE
C
C            SEE IF WE SHOULD REDISPLAY IF CHANGES MADE
C
      IF(RESHOW.EQ.1) THEN
         CALL SHOWIT(KEEP)
         GOTO 100
      ENDIF
      RETURN
      END
C
C
C
      SUBROUTINE MAP
C
C          PRINT MAP FOR FULL-SCREEN EDITING FEATURE   
C
      IV=7
      IH=1
      CALL UPTOP(IH,IV)
C
      CALL OFF
      CALL BOLD
         WRITE(*,'(   9X,A10,\)') 'Last Name '
      CALL OFF
      WRITE(*,'(A37)') '____________  _______________________'
      CALL BOLD
         WRITE(*,'(/,18X,A12,\)') 'Anniversary '
      CALL OFF
      WRITE(*,'(A8)') '__/__/__'
      CALL BOLD
         WRITE(*,'(/,20X,A10,\)') 'Names and '
      CALL OFF
      WRITE(*,'(A23)') '____________  __/__/__ '
      CALL BOLD
         WRITE(*,'(  19X,A10,\)') 'Birthdays '
      CALL OFF
      WRITE(*,'(A23)') '____________  __/__/__ '
      WRITE(*,'(30X,A23)') '____________  __/__/__ '
      WRITE(*,'(30X,A23)') '____________  __/__/__ '
      WRITE(*,'(30X,A23)') '____________  __/__/__ '
      WRITE(*,'(30X,A23)') '____________  __/__/__ '
      CALL BOLD
         WRITE(*,'(/,10X,A28,\)') 'Xmas Cards Sent      Years: '
      CALL OFF
      WRITE(*,'(A17)') '__ __ __ __ __ __'
      CALL BOLD
         WRITE(*,'(   9X,A28,\)') 'Xmas Cards Received  Years: '
      CALL OFF
      WRITE(*,'(A17)') '__ __ __ __ __ __'
C
      RETURN
      END
