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 ',\) 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 ',\) 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)') ' = 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 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