C
C         ADDRESS / PHONE NO. LIST        by Bruce W. Roeckel
C       *--------------------------*                         
C          OPTION #1 - 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 Master File'
      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
  100 CONTINUE
      CALL MAP
         IH=1
         IV=23
         CALL UPTOP(IH,IV)
         WRITE(*,150)
  150    FORMAT('    ( )dd  ( )elete  ( )dit  ( )elp  ( )uit       ',
     A          '       Option ==> [ ]       ',\)
      CALL BOLD
      IH=8
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'A'
      IH=15
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'D'
      IH=25
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'E'
      IH=33
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'H'
      IH=41
      CALL UPTOP(IH,IV)
         WRITE(*,'(A1)') 'Q'
      IH=75
      CALL UPTOP(IH,IV)
      CALL OFF
      ILEN=4
      CALL CURLT(ILEN)
         READ(*,'(A1)') SEL
            IF((SEL.EQ.'A') .OR. (SEL.EQ.'a')) THEN
               CALL ADDIT
            ELSEIF((SEL.EQ.'D') .OR. (SEL.EQ.'d')) THEN
               CALL DELIT
            ELSEIF((SEL.EQ.'E') .OR. (SEL.EQ.'e')) THEN
               CALL EDTIT
            ELSEIF((SEL.EQ.'Q') .OR. (SEL.EQ.'q')) THEN
               CALL SORTIT
               RETURN
            ELSEIF((SEL.EQ.'H') .OR. (SEL.EQ.'h')) THEN
               SEL='1'
               LU=15
               CALL HELP(SEL,LU)
               GOTO 50
            ENDIF
      GOTO 100
      END
C
C
C
      SUBROUTINE DELIT
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,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      CHARACTER*1 LNAME(12),SEL
      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('        (D)elete .... Please enter the first 3 ',
     A          'characters of last name        ')
      CALL OFF
C
C          READ LAST NAME, FIND A MATCH
C
      IV=9 
      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
      KEEP=I
      GOTO 400
  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
C
C          NOW, DISPLAY ALL DATA FOR MATCH
C
      IV=9 
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(12A1)') (LAST(J,KEEP),J=1,12)
      IV=9 
      IH=36
      CALL UPTOP(IH,IV)
         WRITE(*,'(A23)') FIRST(KEEP)
      IV=11
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A30)') ADD1(KEEP)
      IV=13
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A30)') ADD2(KEEP)
      IV=15
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A23)') CITY(KEEP)
      IV=15
      IH=53
      CALL UPTOP(IH,IV)
         WRITE(*,'(A2)') STATE(KEEP)
      IV=15
      IH=61
      CALL UPTOP(IH,IV)
         WRITE(*,'(A5)')  ZIP(KEEP)
      IV=17
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A14)')  PH1(KEEP)
      IV=17
      IH=46
      CALL UPTOP(IH,IV)
         WRITE(*,'(A14)')  PH2(KEEP)
C
C          ASK IF MATCH O.K.            
C
      IH=1
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
      CALL BLINK
         WRITE(*,500)
  500    FORMAT('                                               ',
     A          'Delete 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 600
            RETURN
  600 CONTINUE
C
C         DELETE THIS ENTRY              
C
      DO 800 J=1,12
  800 LAST(J,KEEP)=LAST(J,MNUM)
      FIRST(KEEP)=FIRST(MNUM)
      ADD1(KEEP)=ADD1(MNUM)
      ADD2(KEEP)=ADD2(MNUM)
      CITY(KEEP)=CITY(MNUM)
      STATE(KEEP)=STATE(MNUM)
      ZIP(KEEP)=ZIP(MNUM)
      PH1(KEEP)=PH1(MNUM)
      PH2(KEEP)=PH2(MNUM)
      SORT(KEEP)=SORT(MNUM)
      STRID(KEEP)=STRID(MNUM)
      MNUM=MNUM-1
      RETURN
      END
C
C
C
      SUBROUTINE EDTIT
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,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      CHARACTER*1 LNAME(12),SEL
      INTEGER*4 MULT
      INTEGER KEEP,RESHOW
C
      COMMON/LETT/ALPHA,ALPH2
      CHARACTER*1 ALPHA(26),ALPH2(26)
C
C          ISSUE INSTRUCTIONS           
C
      RESHOW=0
      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=9 
      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
      KEEP=I
      GOTO 400
  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
C
C          NOW, DISPLAY ALL DATA FOR MATCH
C
      IV=9 
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(12A1)') (LAST(J,KEEP),J=1,12)
      IV=9 
      IH=36
      CALL UPTOP(IH,IV)
         WRITE(*,'(A23)') FIRST(KEEP)
      IV=11
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A30)') ADD1(KEEP)
      IV=13
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A30)') ADD2(KEEP)
      IV=15
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A23)') CITY(KEEP)
      IV=15
      IH=53
      CALL UPTOP(IH,IV)
         WRITE(*,'(A2)') STATE(KEEP)
      IV=15
      IH=61
      CALL UPTOP(IH,IV)
         WRITE(*,'(A5)')  ZIP(KEEP)
      IV=17
      IH=22
      CALL UPTOP(IH,IV)
         WRITE(*,'(A14)')  PH1(KEEP)
      IV=17
      IH=46
      CALL UPTOP(IH,IV)
         WRITE(*,'(A14)')  PH2(KEEP)
C
C          ASK IF MATCH O.K. IF THIS IS THE 1ST TIME THROUGH
C
      IF(RESHOW.EQ.1) GOTO 600
      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 600
            RETURN
  600 CONTINUE
C
C         ISSUE INSTRUCTIONS 
C
      RESHOW=0
      IH=48
      IV=23
      CALL UPTOP(IH,IV)
      CALL BOLD
         WRITE(*,'(A30)') '   <RET> = tab w/o change     '
      CALL OFF
C
C          NOW, STEP THROUGH DATA PROMPTS
C
      ICNT=MNUM+1
      IV=9 
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(12A1)') (LAST(J,ICNT),J=1,12)
            IF(LAST(1,ICNT).NE.' ') THEN
               RESHOW=1
               DO 800 I=1,12
  800          LAST(I,KEEP)=LAST(I,ICNT)
C
C          CREATE SORT PARAMETERS BASED ON LAST NAME
C
               MULT=10000
               SORT(KEEP)=0
               DO 900 I=1,3
               DO 850 J=1,26
               IF((LAST(I,KEEP).EQ.ALPHA(J)) .OR. 
     A            (LAST(I,KEEP).EQ.ALPH2(J))) THEN
                   SORT(KEEP)=SORT(KEEP) + J*MULT
                   MULT=MULT/100
                   GOTO 900
               ENDIF
  850          CONTINUE
               MULT=MULT/100
  900          CONTINUE
            ENDIF
C
C         NOW GET THE REST OF THE CHANGES
C
      IV=9 
      IH=36
      CALL UPTOP(IH,IV)
            READ(*,'(A23)') FIRST(ICNT)
            IF(FIRST(ICNT).NE.' ') THEN
               RESHOW=1
               FIRST(KEEP)=FIRST(ICNT)
            ENDIF
      IV=11
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A30)') ADD1(ICNT)
            IF(ADD1(ICNT).NE.' ') THEN
               RESHOW=1
               ADD1(KEEP)=ADD1(ICNT)
            ENDIF
      IV=13
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A30)') ADD2(ICNT)
            IF(ADD2(ICNT).NE.' ') THEN
               RESHOW=1
               ADD2(KEEP)=ADD2(ICNT)
            ENDIF
      IV=15
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A23)') CITY(ICNT)
            IF(CITY(ICNT).NE.' ') THEN
               RESHOW=1
               CITY(KEEP)=CITY(ICNT)
            ENDIF
      IV=15
      IH=53
      CALL UPTOP(IH,IV)
            READ(*,'(A2)') STATE(ICNT)
            IF(STATE(ICNT).NE.' ') THEN
               RESHOW=1
               STATE(KEEP)=STATE(ICNT)
            ENDIF
      IV=15
      IH=61
      CALL UPTOP(IH,IV)
            READ(*,'(A5)')  ZIP(ICNT)
            IF( ZIP(ICNT).NE.' ') THEN
               RESHOW=1
               ZIP(KEEP)= ZIP(ICNT)
            ENDIF
      IV=17
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A14)')  PH1(ICNT)
            IF( PH1(ICNT).NE.' ')  THEN
               RESHOW=1
               PH1(KEEP)= PH1(ICNT)
            ENDIF
      IV=17
      IH=46
      CALL UPTOP(IH,IV)
            READ(*,'(A14)')  PH2(ICNT)
            IF( PH2(ICNT).NE.' ')  THEN
               RESHOW=1
               PH2(KEEP)= PH2(ICNT)
            ENDIF
      IF(RESHOW.EQ.1) GOTO 400
      RETURN
      END
C
C
C
      SUBROUTINE ADDIT
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,SORT,MNUM
      INTEGER*4 STRID(200),SORT(200),MNUM
C
      INTEGER*4 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('        (A)dd ....... Please hit <RET> to tab f',
     A          'rom item-to-item               ')
      CALL OFF
C
C          NOW, STEP THROUGH DATA PROMPTS
C
      MNUM=MNUM+1
      IF(MNUM.GT.200) THEN
         CALL CLS
         WRITE(*,'(2X,A30)') 'MASTER FILE RECORD OVERFLOW'
         STOP
      ENDIF
      IV=9 
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(12A1)') (LAST(J,MNUM),J=1,12)
            IF(LAST(1,MNUM).EQ.' ') THEN
               MNUM=MNUM-1
               RETURN
            ENDIF
C
C          CREATE SORT PARAMETERS BASED ON LAST NAME
C
            KEEP=10000
            SORT(MNUM)=0
            DO 400 I=1,3
            DO 300 J=1,26
            IF((LAST(I,MNUM).EQ.ALPHA(J)) .OR. 
     A         (LAST(I,MNUM).EQ.ALPH2(J))) THEN
                SORT(MNUM)=SORT(MNUM) + J*KEEP
                KEEP=KEEP/100
                GOTO 400
            ENDIF
  300       CONTINUE
            KEEP=KEEP/100
  400       CONTINUE
C
C          FIND NEXT HIGHEST STRUCTURE ID
C
      IBIG=0
      DO 500 J=1,MNUM-1
      IF(STRID(J).GT.IBIG) IBIG=STRID(J)
  500 CONTINUE
      STRID(MNUM)=IBIG+1
      IF(STRID(MNUM).GT.999) THEN
         CALL CLS
         WRITE(*,'(2X,A21)') 'STRUCTURE ID OVERFLOW'
         STOP
      ENDIF
C
C          NOW, GET THE REST OF THE DATA
C
      IV=9 
      IH=36
      CALL UPTOP(IH,IV)
            READ(*,'(A23)') FIRST(MNUM)
      IV=11
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A30)') ADD1(MNUM)
      IV=13
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A30)') ADD2(MNUM)
      IV=15
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A23)') CITY(MNUM)
      IV=15
      IH=53
      CALL UPTOP(IH,IV)
            READ(*,'(A2)') STATE(MNUM)
      IV=15
      IH=61
      CALL UPTOP(IH,IV)
            READ(*,'(A5)')  ZIP(MNUM)
      IV=17
      IH=22
      CALL UPTOP(IH,IV)
            READ(*,'(A14)')  PH1(MNUM)
      IV=17
      IH=46
      CALL UPTOP(IH,IV)
            READ(*,'(A14)')  PH2(MNUM)
      RETURN
      END
C
C
C
      SUBROUTINE MAP
C
C          PRINT MAP FOR FULL-SCREEN EDITING FEATURE   
C
      IV=8
      IH=1
      CALL UPTOP(IH,IV)
C
      CALL OFF
      CALL BOLD
         WRITE(*,'(/,10X,A10,\)') 'Last Name '
      CALL OFF
      WRITE(*,'(A37)') '____________  _______________________'
      CALL BOLD
         WRITE(*,'(/,10X,A10,\)') '  Address '
      CALL OFF
      WRITE(*,'(A30)') '______________________________'
      WRITE(*,'(/,20X,A30)') '______________________________'
      CALL BOLD
         WRITE(*,'(/,10X,A10,\)') '     City '
      CALL OFF
      WRITE(*,'(A23,\)') '_______________________'
      CALL BOLD
         WRITE(*,'(A8,\)') '  State '
      CALL OFF
      WRITE(*,'(A2,\)') '__'
      CALL BOLD
         WRITE(*,'(A6,\)') '  Zip '
      CALL OFF
      WRITE(*,'(A5)') '_____'
      CALL BOLD
        WRITE(*,'(/,10X,A10,\)') '  Home PH '
      CALL OFF
      WRITE(*,'(A14,\)') '(___) ___-____'
      CALL BOLD
        WRITE(*,'(A10,\)') '  Work PH '
      CALL OFF
      WRITE(*,'(A14)') '(___) ___-____'
C
      RETURN
      END
