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