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 / addr1.for next >
Text File  |  1995-05-28  |  15KB  |  615 lines
  1. C
  2. C         ADDRESS / PHONE NO. LIST        by Bruce W. Roeckel
  3. C       *--------------------------*                         
  4. C          OPTION #1 - UPDATE                                
  5. C
  6. C
  7. $STORAGE:2
  8. C
  9. C
  10.       SUBROUTINE UPDATE
  11. C
  12. C          CONTROLS UPDATING OF MASTER RECORDS
  13. C
  14.       CHARACTER*1 SEL
  15.       CHARACTER*25 OPTION
  16. C
  17. C          CALL HEADER WITH OPTION PARAMETER
  18. C
  19.    50 CONTINUE
  20.       OPTION='Update Master File'
  21.       CALL HEADER(OPTION)
  22. C
  23. C          PRINT OPTIONS MENU          
  24. C
  25.       IH=1
  26.       IV=20
  27.       CALL UPTOP(IH,IV)
  28.          WRITE(*,'(X)')
  29.       CALL ULINE
  30.          WRITE(*,'(80X)')
  31.       CALL OFF
  32. C
  33. C          PRINT MAP , THEN PROCESS DATA
  34. C
  35.   100 CONTINUE
  36.       CALL MAP
  37.          IH=1
  38.          IV=23
  39.          CALL UPTOP(IH,IV)
  40.          WRITE(*,150)
  41.   150    FORMAT('    ( )dd  ( )elete  ( )dit  ( )elp  ( )uit       ',
  42.      A          '       Option ==> [ ]       ',\)
  43.       CALL BOLD
  44.       IH=8
  45.       CALL UPTOP(IH,IV)
  46.          WRITE(*,'(A1)') 'A'
  47.       IH=15
  48.       CALL UPTOP(IH,IV)
  49.          WRITE(*,'(A1)') 'D'
  50.       IH=25
  51.       CALL UPTOP(IH,IV)
  52.          WRITE(*,'(A1)') 'E'
  53.       IH=33
  54.       CALL UPTOP(IH,IV)
  55.          WRITE(*,'(A1)') 'H'
  56.       IH=41
  57.       CALL UPTOP(IH,IV)
  58.          WRITE(*,'(A1)') 'Q'
  59.       IH=75
  60.       CALL UPTOP(IH,IV)
  61.       CALL OFF
  62.       ILEN=4
  63.       CALL CURLT(ILEN)
  64.          READ(*,'(A1)') SEL
  65.             IF((SEL.EQ.'A') .OR. (SEL.EQ.'a')) THEN
  66.                CALL ADDIT
  67.             ELSEIF((SEL.EQ.'D') .OR. (SEL.EQ.'d')) THEN
  68.                CALL DELIT
  69.             ELSEIF((SEL.EQ.'E') .OR. (SEL.EQ.'e')) THEN
  70.                CALL EDTIT
  71.             ELSEIF((SEL.EQ.'Q') .OR. (SEL.EQ.'q')) THEN
  72.                CALL SORTIT
  73.                RETURN
  74.             ELSEIF((SEL.EQ.'H') .OR. (SEL.EQ.'h')) THEN
  75.                SEL='1'
  76.                LU=15
  77.                CALL HELP(SEL,LU)
  78.                GOTO 50
  79.             ENDIF
  80.       GOTO 100
  81.       END
  82. C
  83. C
  84. C
  85.       SUBROUTINE DELIT
  86. C
  87.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  88.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  89.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  90.       CHARACTER PH1(200)*14,PH2(200)*14
  91. C
  92.       COMMON/MAIN2/ STRID,SORT,MNUM
  93.       INTEGER*4 STRID(200),SORT(200),MNUM
  94. C
  95.       CHARACTER*1 LNAME(12),SEL
  96.       INTEGER KEEP
  97. C
  98.       COMMON/LETT/ALPHA,ALPH2
  99.       CHARACTER*1 ALPHA(26),ALPH2(26)
  100. C
  101. C          ISSUE INSTRUCTIONS           
  102. C
  103.       IH=1
  104.       IV=23
  105.       CALL UPTOP(IH,IV)
  106.       CALL BOLD
  107.          WRITE(*,50)
  108.    50    FORMAT('        (D)elete .... Please enter the first 3 ',
  109.      A          'characters of last name        ')
  110.       CALL OFF
  111. C
  112. C          READ LAST NAME, FIND A MATCH
  113. C
  114.       IV=9 
  115.       IH=22
  116.       CALL UPTOP(IH,IV)
  117.          READ(*,'(12A1)') (LNAME(K),K=1,12)
  118. C
  119. C          SEARCH THROUGH ALL RECORDS FOR ENTRY
  120. C
  121.       KEEP=0
  122.   100 CONTINUE
  123.       DO 300 I=KEEP+1,MNUM
  124.       DO 200 K=1,3
  125.       IC=0
  126.       IM=0
  127.          DO 150 J=1,26
  128.          IF((LNAME(K).EQ.ALPHA(J)) .OR. (LNAME(K).EQ.ALPH2(J)))IC=J
  129.          IF((LAST(K,I).EQ.ALPHA(J)) .OR. (LAST(K,I).EQ.ALPH2(J)))IM=J
  130.   150    CONTINUE
  131.       IF(IC.NE.IM) GOTO 300
  132.   200 CONTINUE
  133.       KEEP=I
  134.       GOTO 400
  135.   300 CONTINUE
  136.       IH=1
  137.       IV=23
  138.       CALL UPTOP(IH,IV)
  139.       CALL BOLD
  140.       CALL BLINK
  141.       CALL BELL
  142.          WRITE(*,350)
  143.   350    FORMAT('                                                  ',
  144.      A          '  No Match ... Press <RET>  ',\)
  145.          READ(*,'(A1)') IDUM
  146.       RETURN  
  147.   400 CONTINUE
  148. C
  149. C          NOW, DISPLAY ALL DATA FOR MATCH
  150. C
  151.       IV=9 
  152.       IH=22
  153.       CALL UPTOP(IH,IV)
  154.          WRITE(*,'(12A1)') (LAST(J,KEEP),J=1,12)
  155.       IV=9 
  156.       IH=36
  157.       CALL UPTOP(IH,IV)
  158.          WRITE(*,'(A23)') FIRST(KEEP)
  159.       IV=11
  160.       IH=22
  161.       CALL UPTOP(IH,IV)
  162.          WRITE(*,'(A30)') ADD1(KEEP)
  163.       IV=13
  164.       IH=22
  165.       CALL UPTOP(IH,IV)
  166.          WRITE(*,'(A30)') ADD2(KEEP)
  167.       IV=15
  168.       IH=22
  169.       CALL UPTOP(IH,IV)
  170.          WRITE(*,'(A23)') CITY(KEEP)
  171.       IV=15
  172.       IH=53
  173.       CALL UPTOP(IH,IV)
  174.          WRITE(*,'(A2)') STATE(KEEP)
  175.       IV=15
  176.       IH=61
  177.       CALL UPTOP(IH,IV)
  178.          WRITE(*,'(A5)')  ZIP(KEEP)
  179.       IV=17
  180.       IH=22
  181.       CALL UPTOP(IH,IV)
  182.          WRITE(*,'(A14)')  PH1(KEEP)
  183.       IV=17
  184.       IH=46
  185.       CALL UPTOP(IH,IV)
  186.          WRITE(*,'(A14)')  PH2(KEEP)
  187. C
  188. C          ASK IF MATCH O.K.            
  189. C
  190.       IH=1
  191.       IV=23
  192.       CALL UPTOP(IH,IV)
  193.       CALL BOLD
  194.       CALL BLINK
  195.          WRITE(*,500)
  196.   500    FORMAT('                                               ',
  197.      A          'Delete entry ? (Y,N,Q)  [ ]    ',\)
  198.       CALL OFF
  199.          IV=6
  200.          CALL CURLT(IV)
  201.          READ(*,'(A1)') SEL
  202.             IF((SEL.EQ.'N') .OR. (SEL.EQ.'n')) GOTO 100
  203.             IF((SEL.EQ.'Y') .OR. (SEL.EQ.'y')) GOTO 600
  204.             RETURN
  205.   600 CONTINUE
  206. C
  207. C         DELETE THIS ENTRY              
  208. C
  209.       DO 800 J=1,12
  210.   800 LAST(J,KEEP)=LAST(J,MNUM)
  211.       FIRST(KEEP)=FIRST(MNUM)
  212.       ADD1(KEEP)=ADD1(MNUM)
  213.       ADD2(KEEP)=ADD2(MNUM)
  214.       CITY(KEEP)=CITY(MNUM)
  215.       STATE(KEEP)=STATE(MNUM)
  216.       ZIP(KEEP)=ZIP(MNUM)
  217.       PH1(KEEP)=PH1(MNUM)
  218.       PH2(KEEP)=PH2(MNUM)
  219.       SORT(KEEP)=SORT(MNUM)
  220.       STRID(KEEP)=STRID(MNUM)
  221.       MNUM=MNUM-1
  222.       RETURN
  223.       END
  224. C
  225. C
  226. C
  227.       SUBROUTINE EDTIT
  228. C
  229.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  230.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  231.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  232.       CHARACTER PH1(200)*14,PH2(200)*14
  233. C
  234.       COMMON/MAIN2/ STRID,SORT,MNUM
  235.       INTEGER*4 STRID(200),SORT(200),MNUM
  236. C
  237.       CHARACTER*1 LNAME(12),SEL
  238.       INTEGER*4 MULT
  239.       INTEGER KEEP,RESHOW
  240. C
  241.       COMMON/LETT/ALPHA,ALPH2
  242.       CHARACTER*1 ALPHA(26),ALPH2(26)
  243. C
  244. C          ISSUE INSTRUCTIONS           
  245. C
  246.       RESHOW=0
  247.       IH=1
  248.       IV=23
  249.       CALL UPTOP(IH,IV)
  250.       CALL BOLD
  251.          WRITE(*,50)
  252.    50    FORMAT('        (E)dit ...... Please enter the first 3 ',
  253.      A          'characters of last name        ')
  254.       CALL OFF
  255. C
  256. C          READ LAST NAME, FIND A MATCH
  257. C
  258.       IV=9 
  259.       IH=22 
  260.       CALL UPTOP(IH,IV)
  261.          READ(*,'(12A1)') (LNAME(K),K=1,12)
  262. C
  263. C          SEARCH THROUGH ALL RECORDS FOR ENTRY
  264. C
  265.       KEEP=0
  266.   100 CONTINUE
  267.       DO 300 I=KEEP+1,MNUM
  268.       DO 200 K=1,3
  269.       IC=0
  270.       IM=0
  271.          DO 150 J=1,26
  272.          IF((LNAME(K).EQ.ALPHA(J)) .OR. (LNAME(K).EQ.ALPH2(J)))IC=J
  273.          IF((LAST(K,I).EQ.ALPHA(J)) .OR. (LAST(K,I).EQ.ALPH2(J)))IM=J
  274.   150    CONTINUE
  275.       IF(IC.NE.IM) GOTO 300
  276.   200 CONTINUE
  277.       KEEP=I
  278.       GOTO 400
  279.   300 CONTINUE
  280.       IH=1
  281.       IV=23
  282.       CALL UPTOP(IH,IV)
  283.       CALL BOLD
  284.       CALL BLINK
  285.       CALL BELL
  286.          WRITE(*,350)
  287.   350    FORMAT('                                                  ',
  288.      A          '  No Match ... Press <RET>  ',\)
  289.          READ(*,'(A1)') IDUM
  290.          RETURN  
  291.   400 CONTINUE
  292. C
  293. C          NOW, DISPLAY ALL DATA FOR MATCH
  294. C
  295.       IV=9 
  296.       IH=22
  297.       CALL UPTOP(IH,IV)
  298.          WRITE(*,'(12A1)') (LAST(J,KEEP),J=1,12)
  299.       IV=9 
  300.       IH=36
  301.       CALL UPTOP(IH,IV)
  302.          WRITE(*,'(A23)') FIRST(KEEP)
  303.       IV=11
  304.       IH=22
  305.       CALL UPTOP(IH,IV)
  306.          WRITE(*,'(A30)') ADD1(KEEP)
  307.       IV=13
  308.       IH=22
  309.       CALL UPTOP(IH,IV)
  310.          WRITE(*,'(A30)') ADD2(KEEP)
  311.       IV=15
  312.       IH=22
  313.       CALL UPTOP(IH,IV)
  314.          WRITE(*,'(A23)') CITY(KEEP)
  315.       IV=15
  316.       IH=53
  317.       CALL UPTOP(IH,IV)
  318.          WRITE(*,'(A2)') STATE(KEEP)
  319.       IV=15
  320.       IH=61
  321.       CALL UPTOP(IH,IV)
  322.          WRITE(*,'(A5)')  ZIP(KEEP)
  323.       IV=17
  324.       IH=22
  325.       CALL UPTOP(IH,IV)
  326.          WRITE(*,'(A14)')  PH1(KEEP)
  327.       IV=17
  328.       IH=46
  329.       CALL UPTOP(IH,IV)
  330.          WRITE(*,'(A14)')  PH2(KEEP)
  331. C
  332. C          ASK IF MATCH O.K. IF THIS IS THE 1ST TIME THROUGH
  333. C
  334.       IF(RESHOW.EQ.1) GOTO 600
  335.       IH=1
  336.       IV=23
  337.       CALL UPTOP(IH,IV)
  338.       CALL BOLD
  339.       CALL BLINK
  340.          WRITE(*,500)
  341.   500    FORMAT('                                               ',
  342.      A          '  Edit entry ? (Y,N,Q)  [ ]    ',\)
  343.       CALL OFF
  344.          IV=6
  345.          CALL CURLT(IV)
  346.          READ(*,'(A1)') SEL
  347.             IF((SEL.EQ.'N') .OR. (SEL.EQ.'n')) GOTO 100
  348.             IF((SEL.EQ.'Y') .OR. (SEL.EQ.'y')) GOTO 600
  349.             RETURN
  350.   600 CONTINUE
  351. C
  352. C         ISSUE INSTRUCTIONS 
  353. C
  354.       RESHOW=0
  355.       IH=48
  356.       IV=23
  357.       CALL UPTOP(IH,IV)
  358.       CALL BOLD
  359.          WRITE(*,'(A30)') '   <RET> = tab w/o change     '
  360.       CALL OFF
  361. C
  362. C          NOW, STEP THROUGH DATA PROMPTS
  363. C
  364.       ICNT=MNUM+1
  365.       IV=9 
  366.       IH=22
  367.       CALL UPTOP(IH,IV)
  368.             READ(*,'(12A1)') (LAST(J,ICNT),J=1,12)
  369.             IF(LAST(1,ICNT).NE.' ') THEN
  370.                RESHOW=1
  371.                DO 800 I=1,12
  372.   800          LAST(I,KEEP)=LAST(I,ICNT)
  373. C
  374. C          CREATE SORT PARAMETERS BASED ON LAST NAME
  375. C
  376.                MULT=10000
  377.                SORT(KEEP)=0
  378.                DO 900 I=1,3
  379.                DO 850 J=1,26
  380.                IF((LAST(I,KEEP).EQ.ALPHA(J)) .OR. 
  381.      A            (LAST(I,KEEP).EQ.ALPH2(J))) THEN
  382.                    SORT(KEEP)=SORT(KEEP) + J*MULT
  383.                    MULT=MULT/100
  384.                    GOTO 900
  385.                ENDIF
  386.   850          CONTINUE
  387.                MULT=MULT/100
  388.   900          CONTINUE
  389.             ENDIF
  390. C
  391. C         NOW GET THE REST OF THE CHANGES
  392. C
  393.       IV=9 
  394.       IH=36
  395.       CALL UPTOP(IH,IV)
  396.             READ(*,'(A23)') FIRST(ICNT)
  397.             IF(FIRST(ICNT).NE.' ') THEN
  398.                RESHOW=1
  399.                FIRST(KEEP)=FIRST(ICNT)
  400.             ENDIF
  401.       IV=11
  402.       IH=22
  403.       CALL UPTOP(IH,IV)
  404.             READ(*,'(A30)') ADD1(ICNT)
  405.             IF(ADD1(ICNT).NE.' ') THEN
  406.                RESHOW=1
  407.                ADD1(KEEP)=ADD1(ICNT)
  408.             ENDIF
  409.       IV=13
  410.       IH=22
  411.       CALL UPTOP(IH,IV)
  412.             READ(*,'(A30)') ADD2(ICNT)
  413.             IF(ADD2(ICNT).NE.' ') THEN
  414.                RESHOW=1
  415.                ADD2(KEEP)=ADD2(ICNT)
  416.             ENDIF
  417.       IV=15
  418.       IH=22
  419.       CALL UPTOP(IH,IV)
  420.             READ(*,'(A23)') CITY(ICNT)
  421.             IF(CITY(ICNT).NE.' ') THEN
  422.                RESHOW=1
  423.                CITY(KEEP)=CITY(ICNT)
  424.             ENDIF
  425.       IV=15
  426.       IH=53
  427.       CALL UPTOP(IH,IV)
  428.             READ(*,'(A2)') STATE(ICNT)
  429.             IF(STATE(ICNT).NE.' ') THEN
  430.                RESHOW=1
  431.                STATE(KEEP)=STATE(ICNT)
  432.             ENDIF
  433.       IV=15
  434.       IH=61
  435.       CALL UPTOP(IH,IV)
  436.             READ(*,'(A5)')  ZIP(ICNT)
  437.             IF( ZIP(ICNT).NE.' ') THEN
  438.                RESHOW=1
  439.                ZIP(KEEP)= ZIP(ICNT)
  440.             ENDIF
  441.       IV=17
  442.       IH=22
  443.       CALL UPTOP(IH,IV)
  444.             READ(*,'(A14)')  PH1(ICNT)
  445.             IF( PH1(ICNT).NE.' ')  THEN
  446.                RESHOW=1
  447.                PH1(KEEP)= PH1(ICNT)
  448.             ENDIF
  449.       IV=17
  450.       IH=46
  451.       CALL UPTOP(IH,IV)
  452.             READ(*,'(A14)')  PH2(ICNT)
  453.             IF( PH2(ICNT).NE.' ')  THEN
  454.                RESHOW=1
  455.                PH2(KEEP)= PH2(ICNT)
  456.             ENDIF
  457.       IF(RESHOW.EQ.1) GOTO 400
  458.       RETURN
  459.       END
  460. C
  461. C
  462. C
  463.       SUBROUTINE ADDIT
  464. C
  465.       COMMON/MAIN1/ LAST,FIRST,ADD1,ADD2,CITY,STATE,ZIP,PH1,PH2
  466.       CHARACTER LAST(12,200)*1,FIRST(200)*23,ADD1(200)*30,ADD2(200)*30
  467.       CHARACTER CITY(200)*23,STATE(200)*2,ZIP(200)*5
  468.       CHARACTER PH1(200)*14,PH2(200)*14
  469. C
  470.       COMMON/MAIN2/ STRID,SORT,MNUM
  471.       INTEGER*4 STRID(200),SORT(200),MNUM
  472. C
  473.       INTEGER*4 KEEP
  474. C
  475.       COMMON/LETT/ALPHA,ALPH2
  476.       CHARACTER*1 ALPHA(26),ALPH2(26)
  477. C
  478. C          ISSUE INSTRUCTIONS           
  479. C
  480.       IH=1
  481.       IV=23
  482.       CALL UPTOP(IH,IV)
  483.       CALL BOLD
  484.          WRITE(*,50)
  485.    50    FORMAT('        (A)dd ....... Please hit <RET> to tab f',
  486.      A          'rom item-to-item               ')
  487.       CALL OFF
  488. C
  489. C          NOW, STEP THROUGH DATA PROMPTS
  490. C
  491.       MNUM=MNUM+1
  492.       IF(MNUM.GT.200) THEN
  493.          CALL CLS
  494.          WRITE(*,'(2X,A30)') 'MASTER FILE RECORD OVERFLOW'
  495.          STOP
  496.       ENDIF
  497.       IV=9 
  498.       IH=22
  499.       CALL UPTOP(IH,IV)
  500.             READ(*,'(12A1)') (LAST(J,MNUM),J=1,12)
  501.             IF(LAST(1,MNUM).EQ.' ') THEN
  502.                MNUM=MNUM-1
  503.                RETURN
  504.             ENDIF
  505. C
  506. C          CREATE SORT PARAMETERS BASED ON LAST NAME
  507. C
  508.             KEEP=10000
  509.             SORT(MNUM)=0
  510.             DO 400 I=1,3
  511.             DO 300 J=1,26
  512.             IF((LAST(I,MNUM).EQ.ALPHA(J)) .OR. 
  513.      A         (LAST(I,MNUM).EQ.ALPH2(J))) THEN
  514.                 SORT(MNUM)=SORT(MNUM) + J*KEEP
  515.                 KEEP=KEEP/100
  516.                 GOTO 400
  517.             ENDIF
  518.   300       CONTINUE
  519.             KEEP=KEEP/100
  520.   400       CONTINUE
  521. C
  522. C          FIND NEXT HIGHEST STRUCTURE ID
  523. C
  524.       IBIG=0
  525.       DO 500 J=1,MNUM-1
  526.       IF(STRID(J).GT.IBIG) IBIG=STRID(J)
  527.   500 CONTINUE
  528.       STRID(MNUM)=IBIG+1
  529.       IF(STRID(MNUM).GT.999) THEN
  530.          CALL CLS
  531.          WRITE(*,'(2X,A21)') 'STRUCTURE ID OVERFLOW'
  532.          STOP
  533.       ENDIF
  534. C
  535. C          NOW, GET THE REST OF THE DATA
  536. C
  537.       IV=9 
  538.       IH=36
  539.       CALL UPTOP(IH,IV)
  540.             READ(*,'(A23)') FIRST(MNUM)
  541.       IV=11
  542.       IH=22
  543.       CALL UPTOP(IH,IV)
  544.             READ(*,'(A30)') ADD1(MNUM)
  545.       IV=13
  546.       IH=22
  547.       CALL UPTOP(IH,IV)
  548.             READ(*,'(A30)') ADD2(MNUM)
  549.       IV=15
  550.       IH=22
  551.       CALL UPTOP(IH,IV)
  552.             READ(*,'(A23)') CITY(MNUM)
  553.       IV=15
  554.       IH=53
  555.       CALL UPTOP(IH,IV)
  556.             READ(*,'(A2)') STATE(MNUM)
  557.       IV=15
  558.       IH=61
  559.       CALL UPTOP(IH,IV)
  560.             READ(*,'(A5)')  ZIP(MNUM)
  561.       IV=17
  562.       IH=22
  563.       CALL UPTOP(IH,IV)
  564.             READ(*,'(A14)')  PH1(MNUM)
  565.       IV=17
  566.       IH=46
  567.       CALL UPTOP(IH,IV)
  568.             READ(*,'(A14)')  PH2(MNUM)
  569.       RETURN
  570.       END
  571. C
  572. C
  573. C
  574.       SUBROUTINE MAP
  575. C
  576. C          PRINT MAP FOR FULL-SCREEN EDITING FEATURE   
  577. C
  578.       IV=8
  579.       IH=1
  580.       CALL UPTOP(IH,IV)
  581. C
  582.       CALL OFF
  583.       CALL BOLD
  584.          WRITE(*,'(/,10X,A10,\)') 'Last Name '
  585.       CALL OFF
  586.       WRITE(*,'(A37)') '____________  _______________________'
  587.       CALL BOLD
  588.          WRITE(*,'(/,10X,A10,\)') '  Address '
  589.       CALL OFF
  590.       WRITE(*,'(A30)') '______________________________'
  591.       WRITE(*,'(/,20X,A30)') '______________________________'
  592.       CALL BOLD
  593.          WRITE(*,'(/,10X,A10,\)') '     City '
  594.       CALL OFF
  595.       WRITE(*,'(A23,\)') '_______________________'
  596.       CALL BOLD
  597.          WRITE(*,'(A8,\)') '  State '
  598.       CALL OFF
  599.       WRITE(*,'(A2,\)') '__'
  600.       CALL BOLD
  601.          WRITE(*,'(A6,\)') '  Zip '
  602.       CALL OFF
  603.       WRITE(*,'(A5)') '_____'
  604.       CALL BOLD
  605.         WRITE(*,'(/,10X,A10,\)') '  Home PH '
  606.       CALL OFF
  607.       WRITE(*,'(A14,\)') '(___) ___-____'
  608.       CALL BOLD
  609.         WRITE(*,'(A10,\)') '  Work PH '
  610.       CALL OFF
  611.       WRITE(*,'(A14)') '(___) ___-____'
  612. C
  613.       RETURN
  614.       END
  615.