C C IMPORTANT NAMES & DATES by Bruce W. Roeckel C *--------------------------* C OPTION #1 BROWSE MASTER FILE C C $STORAGE:2 C C SUBROUTINE LOOK C C LISTS MASTER FILE TO SCREEN FOR BROWSING 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 EXIST(5)*1,OPTION*25,RAMDSK*80,ANS*1 INTEGER KEEP C C CALL HEADER WITH OPTION PARAMETER C OPTION='Browse Master File' CALL HEADER(OPTION) C C SET UP PARAMS IN GROUPS OF 5 C DO 500 I=1,MNUM,5 IH=1 IV=6 CALL UPTOP(IH,IV) CALL KEYOFF WRITE(*,'(X)') C C LIST DATABASE, ONE SCREEN AT A TIME C 50 CONTINUE IKEY=0 DO 200 K=I,I+4 IKEY=IKEY+1 EXIST(IKEY)=' ' IF(K.LE.MNUM) THEN C C SEE IF NAMES & DATES DATA EXISTS C IF(NAME(1,STRID(K)).NE.' ' .OR. A ANIV(STRID(K)).NE.' ' .OR. B XMAS(1,STRID(K)).NE.' ' .OR. C XMAS(7,STRID(K)).NE.' ') THEN EXIST(IKEY)='Y' ELSE EXIST(IKEY)='N' ENDIF C C LIST ALL DATA FROM THE ADDRESS BOOK DATABASE C WRITE(*,'(2X,I1,A1,\)') IKEY,'-' CALL BOLD IF(EXIST(IKEY).EQ.'Y') CALL BLINK WRITE(*,100) FIRST(K) 100 FORMAT(A23,\) CALL OFF WRITE(*,110) CITY(K),STATE(K),ZIP(K),PH1(K) 110 FORMAT(2X,A23,1X,A2,1X,A5,2X,A14) CALL BOLD IF(EXIST(IKEY).EQ.'Y') CALL BLINK WRITE(*,115) (LAST(M,K),M=1,12) 115 FORMAT(3X,12A1,\) CALL OFF WRITE(*,120) ADD1(K),PH2(K) 120 FORMAT(13X,A30,4X,A14) IF(ADD2(K).NE.' ') THEN WRITE(*,'(29X,A30)') ADD2(K) ELSE WRITE(*,125) 125 FORMAT(79(' ')) ENDIF ELSE WRITE(*,150) 150 FORMAT(79(' '),/,79(' '),/,79(' ')) ENDIF 200 CONTINUE C C NOW ASK OPERATOR, BRANCH ON REQUEST C 250 CONTINUE IH=1 IV=23 CALL UPTOP(IH,IV) CALL KEYON IF(K.LE.MNUM) THEN WRITE(*,'(A20,\)') ' More ... Q=Quit ' ELSE WRITE(*,'(A20,\)') ' End of file ... ' ENDIF ILEN=3 CALL CURLT(ILEN) READ(*,'(A1)') ANS IF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) RETURN IF(ANS.EQ.' ') GOTO 500 C C CHECK IF REQUEST TO SHOW IN DETAIL C WRITE(RAMDSK,'(A1)') ANS READ(RAMDSK,'(I1)',ERR=500) KEEP IF(KEEP.GE.1 .AND. KEEP.LE.5) THEN IF(EXIST(KEEP).EQ.'N') THEN CALL BELL GOTO 250 ELSEIF(EXIST(KEEP).EQ.'Y') THEN KEEP=KEEP+K-6 IV=6 IH=1 CALL MOVEIT(IH,IV) CALL MAP CALL SHOWIT(KEEP) WRITE(*,'(///,A29,\)') ' Press to Continue ' READ(*,'(A1)') ANS CALL MOVEIT(IH,IV) WRITE(*,'(X)') GOTO 50 ENDIF ENDIF 500 CONTINUE RETURN END