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 / address.for < prev    next >
Text File  |  1995-05-28  |  8KB  |  309 lines
  1. C
  2. C         ADDRESS / PHONE NO. LIST        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C
  5. C
  6. $STORAGE:2
  7. C
  8. C
  9.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  10.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  11.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  12.       CHARACTER PH1(200)*14,PH2(200)*14
  13. C
  14.       COMMON/MAIN2/ STRID,SORT,MNUM
  15.       INTEGER*4 STRID(200),SORT(200),MNUM
  16. C
  17.       COMMON /REVNO/ PGM,AUTHOR,YEAR,DATE,REV
  18.       CHARACTER PGM*21,AUTHOR*21,YEAR*4,DATE*8,REV*2
  19. C
  20.       COMMON/LETT/ALPHA,ALPH2
  21.       CHARACTER*1 ALPHA(26),ALPH2(26)
  22. C
  23.       CHARACTER OPTION*25,KEY*1,SEL*1
  24.       LOGICAL*2 CHECK
  25. C
  26. C           SET UP COMMON BLOCK OF ALPHABET
  27. C
  28.       ALPHA(1)='A'
  29.       ALPHA(2)='B'
  30.       ALPHA(3)='C'
  31.       ALPHA(4)='D'
  32.       ALPHA(5)='E'
  33.       ALPHA(6)='F'
  34.       ALPHA(7)='G'
  35.       ALPHA(8)='H'
  36.       ALPHA(9)='I'
  37.       ALPHA(10)='J'
  38.       ALPHA(11)='K'
  39.       ALPHA(12)='L'
  40.       ALPHA(13)='M'
  41.       ALPHA(14)='N'
  42.       ALPHA(15)='O'
  43.       ALPHA(16)='P'
  44.       ALPHA(17)='Q'
  45.       ALPHA(18)='R'
  46.       ALPHA(19)='S'
  47.       ALPHA(20)='T'
  48.       ALPHA(21)='U'
  49.       ALPHA(22)='V'
  50.       ALPHA(23)='W'
  51.       ALPHA(24)='X'
  52.       ALPHA(25)='Y'
  53.       ALPHA(26)='Z'
  54.       ALPH2(1)='a'
  55.       ALPH2(2)='b'
  56.       ALPH2(3)='c'
  57.       ALPH2(4)='d'
  58.       ALPH2(5)='e'
  59.       ALPH2(6)='f'
  60.       ALPH2(7)='g'
  61.       ALPH2(8)='h'
  62.       ALPH2(9)='i'
  63.       ALPH2(10)='j'
  64.       ALPH2(11)='k'
  65.       ALPH2(12)='l'
  66.       ALPH2(13)='m'
  67.       ALPH2(14)='n'
  68.       ALPH2(15)='o'
  69.       ALPH2(16)='p'
  70.       ALPH2(17)='q'
  71.       ALPH2(18)='r'
  72.       ALPH2(19)='s'
  73.       ALPH2(20)='t'
  74.       ALPH2(21)='u'
  75.       ALPH2(22)='v'
  76.       ALPH2(23)='w'
  77.       ALPH2(24)='x'
  78.       ALPH2(25)='y'
  79.       ALPH2(26)='z'
  80. C
  81. C           DISPLAY ROCKSOFT HEADER
  82. C
  83.       PGM='Address Book         '
  84.       AUTHOR='Bruce W. Roeckel     '
  85.       YEAR='1986'
  86.       REV='07'
  87.       CALL MHEAD(PGM,AUTHOR,YEAR,REV,DATE)
  88.       CALL TOP(PGM,DATE)
  89. C
  90. C           READ THE DATABASE INTO CORE
  91. C
  92.       CALL RDMAST
  93.       CALL SORTIT
  94. C
  95. C           CHECK FOR HELP DOCUMENT FILE
  96. C
  97.       IHLP=0
  98.       INQUIRE(FILE='ADDRESS.HLP',EXIST=CHECK)
  99.       IF(CHECK .EQV. .TRUE.) THEN
  100.          IHLP=1
  101.          OPEN(15,FILE='ADDRESS.HLP')
  102.       ENDIF
  103. C
  104. C           NOW DISPLAY MAIN MENU
  105. C
  106.   100 CONTINUE
  107.       OPTION='Main Menu'
  108.       CALL HEADER(OPTION)
  109.          WRITE(*,150)
  110.   150    FORMAT(/,3X,'Total Entries in',
  111.      A          /,3X,'Master File: ',\)
  112.          CALL BOLD
  113.          WRITE(*,'(I3)') MNUM
  114.          CALL OFF
  115.       WRITE(*,200) 
  116.   200 FORMAT(/,
  117.      A      //,20X,' 1. Add / Delete / Edit Master File Entries  ',
  118.      B       /,20X,' 2. Browse Entire Master File                ',
  119.      C       /,20X,' 3. Print Master Address & Phone No. List    ',
  120.      D       /,20X,' 4. Print Wallet Size Address Booklet        ',
  121.      E       /,20X,' 5. Print Phone Number Only Summary          ')
  122. C
  123. C            ASK FOR SELECTION, THEN BRANCH BASED ON INPUT
  124. C
  125.   300 CONTINUE
  126.       IV=21
  127.       IH=1
  128.       CALL MOVEIT(IH,IV)
  129.       WRITE(*,'(/,5X,A37,\)') 'Enter Menu Choice (H=Help, Q=Quit) : '
  130.          READ(*,'(A1)',ERR=100) SEL 
  131.          CALL OFF
  132.          IF (SEL.EQ.' ') THEN
  133.             GOTO 300
  134.          ELSEIF((SEL.EQ.'H') .OR. (SEL.EQ.'h')) THEN
  135.             KEY=' '
  136.             LU=15
  137.             CALL HELP(KEY,LU)
  138.          ELSEIF(SEL.EQ.'1') THEN
  139.             CALL UPDATE
  140.          ELSEIF(SEL.EQ.'2') THEN
  141.             CALL LOOK
  142.          ELSEIF(SEL.EQ.'3') THEN
  143.             CALL MLIST
  144.          ELSEIF(SEL.EQ.'4') THEN
  145.             CALL BKLT
  146.          ELSEIF(SEL.EQ.'5') THEN
  147.             CALL PHONE
  148.          ELSEIF((SEL.EQ.'Q') .OR. (SEL.EQ.'q')) THEN
  149.             IF(IHLP.EQ.1) CLOSE(15)
  150.             CALL WRMAST
  151.             CALL CLS
  152.             STOP
  153.          ENDIF
  154.       GOTO 100
  155.       END
  156. C
  157. C
  158. C
  159.       SUBROUTINE RDMAST
  160. C
  161.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  162.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  163.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  164.       CHARACTER PH1(200)*14,PH2(200)*14
  165. C
  166.       COMMON/MAIN2/ STRID,SORT,MNUM
  167.       INTEGER*4 STRID(200),SORT(200),MNUM
  168. C
  169.       CHARACTER*25 OPTION
  170. C
  171. C            OPEN FILE FOR INPUT
  172. C
  173.       OPTION='Loading Master File .....'
  174.       CALL HEADER(OPTION)
  175.       CALL KEYOFF
  176.       OPEN(20,FILE='ADDRESS.DAT')
  177. C
  178. C            READ ALL DATA FROM MASTER FILE
  179. C
  180.       I=0
  181.   100 CONTINUE
  182.       I=I+1
  183.       IF(I.GT.200) THEN
  184.          WRITE(*,'(A33)') 'Program Aborted Reading Master   '
  185.          STOP
  186.       ENDIF
  187.       READ(20,200,END=300) (LAST(K,I),K=1,12),
  188.      A                     FIRST(I),ADD1(I),ADD2(I),CITY(I),
  189.      A                     STATE(I),ZIP(I),PH1(I),PH2(I),SORT(I),
  190.      A                     STRID(I)
  191.   200 FORMAT(12A1,A23,A30,A30,A23,A2,A5,A14,A14,I8,I3)
  192.       GOTO 100
  193.   300 CONTINUE
  194.       MNUM=I-1
  195.       CLOSE(20)
  196.       CALL KEYON
  197.       RETURN
  198.       END
  199. C
  200. C
  201. C
  202.       SUBROUTINE WRMAST
  203. C
  204.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  205.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  206.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  207.       CHARACTER PH1(200)*14,PH2(200)*14
  208. C
  209.       COMMON/MAIN2/ STRID,SORT,MNUM
  210.       INTEGER*4 STRID(200),SORT(200),MNUM
  211. C
  212.       CHARACTER*25 OPTION
  213. C
  214. C            OPEN FILE FOR OUTPUT
  215. C
  216.       OPTION='Storing Master File .....'
  217.       CALL HEADER(OPTION)
  218.       CALL KEYOFF
  219.       OPEN(20,FILE='ADDRESS.DAT')
  220. C
  221. C            WRITE ALL DATA TO MASTER LOOKUP FILE
  222. C
  223.       DO 300 I=1,MNUM
  224.       WRITE(20,200) (LAST(K,I),K=1,12),
  225.      A              FIRST(I),ADD1(I),ADD2(I),CITY(I),
  226.      A              STATE(I),ZIP(I),PH1(I),PH2(I),SORT(I),
  227.      A              STRID(I)
  228.   200 FORMAT(12A1,A23,A30,A30,A23,A2,A5,A14,A14,I8,I3)
  229.   300 CONTINUE
  230.       ENDFILE 20
  231.       CLOSE(20)
  232.       CALL KEYON
  233.       RETURN
  234.       END
  235. C
  236. C
  237. C
  238.       SUBROUTINE SORTIT
  239. C
  240.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  241.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  242.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  243.       CHARACTER PH1(200)*14,PH2(200)*14
  244. C
  245.       COMMON/MAIN2/ STRID,SORT,MNUM
  246.       INTEGER*4 STRID(200),SORT(200),MNUM
  247. C
  248.       CHARACTER LLAST(12)*1,LFIRST*23,LADD1*30,LADD2*30,LCITY*23
  249.       CHARACTER LSTATE*2,LZIP*5,LPH1*14,LPH2*14,OPTION*25
  250.       INTEGER*4 LSORT,LSTID,KEEP,MIN
  251. C
  252. C         CALL OPTION HEADER
  253. C
  254.       OPTION='Sorting Master File .....'
  255.       CALL HEADER(OPTION)
  256. C
  257. C         NOW SORT THE DATA
  258. C
  259.       K=0
  260.   400 MIN=999999
  261.       K=K+1
  262.       IF(K.GE.MNUM) GOTO 500
  263.       DO 450 I=K,MNUM
  264.       IF(SORT(I).LT.MIN) THEN
  265.          MIN=SORT(I)
  266.          KEEP=I
  267.       ENDIF
  268.   450 CONTINUE
  269.       DO 460 J=1,12
  270.   460 LLAST(J)=LAST(J,K)
  271.       LFIRST=FIRST(K)
  272.       LADD1 =ADD1(K)
  273.       LADD2 =ADD2(K)
  274.       LCITY =CITY(K)
  275.       LSTATE=STATE(K)
  276.       LZIP  =ZIP(K)
  277.       LPH1  =PH1(K)
  278.       LPH2  =PH2(K)
  279.       LSORT =SORT(K)
  280.       LSTID =STRID(K)
  281.          DO 470 J=1,12
  282.   470    LAST(J,K)=LAST(J,KEEP)
  283.          FIRST(K)=FIRST(KEEP)
  284.          ADD1(K) =ADD1(KEEP)
  285.          ADD2(K) =ADD2(KEEP)
  286.          CITY(K) =CITY(KEEP)
  287.          STATE(K)=STATE(KEEP)
  288.          ZIP(K)  =ZIP(KEEP)
  289.          PH1(K)  =PH1(KEEP)
  290.          PH2(K)  =PH2(KEEP)
  291.          SORT(K) =SORT(KEEP)
  292.          STRID(K)=STRID(KEEP)
  293.       DO 480 J=1,12
  294.   480 LAST(J,KEEP)=LLAST(J)
  295.       FIRST(KEEP)=LFIRST
  296.       ADD1(KEEP) =LADD1
  297.       ADD2(KEEP) =LADD2
  298.       CITY(KEEP) =LCITY
  299.       STATE(KEEP)=LSTATE
  300.       ZIP(KEEP)  =LZIP
  301.       PH1(KEEP)  =LPH1
  302.       PH2(KEEP)  =LPH2
  303.       SORT(KEEP) =LSORT
  304.       STRID(KEEP)=LSTID
  305.       GOTO 400
  306.   500 CONTINUE
  307.       RETURN
  308.       END
  309.