home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB113 / name1.for < prev    next >
Text File  |  1995-05-28  |  4KB  |  134 lines
  1. C
  2. C         IMPORTANT NAMES & DATES         by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C          OPTION #1 BROWSE MASTER FILE            
  5. C
  6. C
  7. $STORAGE:2
  8. C
  9. C
  10.       SUBROUTINE LOOK
  11. C
  12. C          LISTS MASTER FILE TO SCREEN FOR BROWSING
  13. C
  14.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  15.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  16.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  17.       CHARACTER PH1(200)*14,PH2(200)*14
  18. C
  19.       COMMON/MAIN2/ STRID,JULIAN,MNUM
  20.       INTEGER STRID(200),JULIAN(366,5),MNUM
  21. C
  22.       COMMON/MAIN3/ NAME,ANIV,BDAY,XMAS
  23.       CHARACTER NAME(6,200)*12,ANIV(200)*8,BDAY(6,200)*8,XMAS(12,200)*2
  24. C
  25.       CHARACTER EXIST(5)*1,OPTION*25,RAMDSK*80,ANS*1
  26.       INTEGER KEEP
  27. C
  28. C          CALL HEADER WITH OPTION PARAMETER
  29. C
  30.       OPTION='Browse Master File'
  31.       CALL HEADER(OPTION)
  32. C
  33. C          SET UP PARAMS IN GROUPS OF 5 
  34. C
  35.       DO 500 I=1,MNUM,5 
  36.       IH=1
  37.       IV=6
  38.       CALL UPTOP(IH,IV)
  39.       CALL KEYOFF
  40.       WRITE(*,'(X)')
  41. C
  42. C          LIST DATABASE, ONE SCREEN AT A TIME
  43. C
  44.    50 CONTINUE
  45.       IKEY=0
  46.       DO 200 K=I,I+4 
  47.       IKEY=IKEY+1
  48.       EXIST(IKEY)=' '
  49.       IF(K.LE.MNUM) THEN
  50. C
  51. C                SEE IF NAMES & DATES DATA EXISTS
  52. C
  53.          IF(NAME(1,STRID(K)).NE.' ' .OR.
  54.      A      ANIV(STRID(K)).NE.' ' .OR.
  55.      B      XMAS(1,STRID(K)).NE.' ' .OR.
  56.      C      XMAS(7,STRID(K)).NE.' ') THEN
  57.             EXIST(IKEY)='Y'
  58.          ELSE
  59.             EXIST(IKEY)='N'
  60.          ENDIF
  61. C
  62. C                LIST ALL DATA FROM THE ADDRESS BOOK DATABASE
  63. C
  64.          WRITE(*,'(2X,I1,A1,\)') IKEY,'-'
  65.          CALL BOLD
  66.          IF(EXIST(IKEY).EQ.'Y') CALL BLINK
  67.             WRITE(*,100) FIRST(K)
  68.   100       FORMAT(A23,\)
  69.          CALL OFF
  70.          WRITE(*,110) CITY(K),STATE(K),ZIP(K),PH1(K)
  71.   110    FORMAT(2X,A23,1X,A2,1X,A5,2X,A14)
  72.          CALL BOLD
  73.          IF(EXIST(IKEY).EQ.'Y') CALL BLINK
  74.             WRITE(*,115) (LAST(M,K),M=1,12)
  75.   115       FORMAT(3X,12A1,\)
  76.          CALL OFF
  77.          WRITE(*,120) ADD1(K),PH2(K)
  78.   120    FORMAT(13X,A30,4X,A14)
  79.          IF(ADD2(K).NE.' ') THEN
  80.             WRITE(*,'(29X,A30)') ADD2(K)
  81.          ELSE
  82.             WRITE(*,125)
  83.   125       FORMAT(79(' '))
  84.          ENDIF
  85.       ELSE
  86.          WRITE(*,150)
  87.   150    FORMAT(79(' '),/,79(' '),/,79(' '))
  88.       ENDIF
  89.   200 CONTINUE
  90. C
  91. C                NOW ASK OPERATOR, BRANCH ON REQUEST
  92. C
  93.   250 CONTINUE
  94.       IH=1
  95.       IV=23
  96.       CALL UPTOP(IH,IV)
  97.       CALL KEYON
  98.          IF(K.LE.MNUM) THEN
  99.             WRITE(*,'(A20,\)') ' More ... Q=Quit    '
  100.          ELSE
  101.             WRITE(*,'(A20,\)') ' End of file ...    '
  102.          ENDIF
  103.          ILEN=3
  104.          CALL CURLT(ILEN)
  105.          READ(*,'(A1)') ANS
  106.          IF((ANS.EQ.'Q') .OR. (ANS.EQ.'q')) RETURN
  107.          IF(ANS.EQ.' ') GOTO 500
  108. C
  109. C                CHECK IF REQUEST TO SHOW IN DETAIL
  110. C
  111.          WRITE(RAMDSK,'(A1)') ANS
  112.          READ(RAMDSK,'(I1)',ERR=500) KEEP
  113.          IF(KEEP.GE.1 .AND. KEEP.LE.5) THEN
  114.             IF(EXIST(KEEP).EQ.'N') THEN
  115.                CALL BELL
  116.                GOTO 250
  117.             ELSEIF(EXIST(KEEP).EQ.'Y') THEN
  118.                KEEP=KEEP+K-6
  119.                IV=6
  120.                IH=1
  121.                CALL MOVEIT(IH,IV)
  122.                CALL MAP
  123.                CALL SHOWIT(KEEP)
  124.                WRITE(*,'(///,A29,\)') ' Press <Return> to Continue  '
  125.                READ(*,'(A1)') ANS
  126.                CALL MOVEIT(IH,IV)
  127.                WRITE(*,'(X)')
  128.                GOTO 50
  129.             ENDIF
  130.          ENDIF
  131.   500 CONTINUE
  132.       RETURN
  133.       END
  134.