Shareware Overload/ShartewareOverload.cdr/database/dbcntact.zip/CONTACT.PRG

Text File | 1987-01-13 | 28KB | 1,049 lines

****************************************************************************
*                  CONTACT.PRG - CONTACT TRACKER PROGRAM                   *
****************************************************************************
*                           COPYRIGHT 1986                                 *
*                         VORTEX DATA SYSTEMS                              *
*                      2515 CAMINO DEL RIO SOUTH                           *
*                              SUITE 301                                   *
*                        SAN DIEGO, CA 92108                               *
*                                                                          *
****************************************************************************
*      VERSION 3.1     USES NOVELL FILE LOCKS            12/13/86          *
****************************************************************************
* This program is copyright by Vortex Data Systems, Inc. You are granted
* permission to use this program for your own use, and to modify the source
* code for your own custom use.  You may not sell, modify or provide this
* program as part of any commercial or non commercial venture.
*
* The program uses callable routines from the Ashton-Tate Programmers
* Utilities (CURSOR2,SPORT). If you modify this program you will need to
* have those .OBJ files available to the linker during linking.  The program
* incorporates Novell record and file locks, which will be ignored when
* run in a single user environment.
*
* Hope you find Contact Tracker helpful and productive.



parameters xname
if pcount() = 0
   xname = space(1)
else
   xname = upper(substr(xname,1,1))+trim(substr(xname,2,20))
endif
set bell off
set confirm on
set deleted on
set function 2 to chr(2)
set function 3 to chr(3)
set function 4 to chr(4)
set function 5 to chr(5)
set function 6 to chr(6)
set function 7 to chr(7)
set function 8 to chr(8)
set function 9 to ";"
set function 10 to chr(10)
set exclusive off
more = .T.
string = " "
dstring = date()
store "CONTACT NAME" to d1
store "COMPANY NAME" to d2
store "PRODUCT NAME" to d3
store "DATE        " to d4
store "STATUS      " to d5
frame1 = "╔═╗║╝═╚║"
frame2 = "┌─┐│┘─└│"
repaint = .t.
duperec = .f.
hangup = 'WATH'+chr(13)+chr(10)
do while more
   sele 2
   if file("contact.dbf")
      if net_use("contact",.f.,5)
         set index to I1,I2,I3,I4,I5
      else
         ?? chr(7)
         ? "file not available"
      endif
   endif
   if iscolor()
      color = .t.
   else
      color = .f.
   endif
   if color
      set color to w+/b,r/w,b+
   endif
   set function 10 to chr(10)
   if len(trim(xname)) = 0
      if repaint
         clear
         @ 1,6 say  "╔═══════════════════════════════════════════════════════════════╗"
         @ 2,6 say  "║╔═════════════════════════════════════════════════════════════╗║"
         @ 3,6 say  "║║                     CONTACT TRACKER                         ║║"
         @ 4,6 say  "║╠═════════════════════════════════════════════════════════════╣║"
         @ 5,6 say  "║║                       SEARCH CRITERIA                       ║║"
         @ 6,6 say  "║║                                                             ║║"
         @ 7,6 say  "║║             F2   &D1                               ║║"
         @ 8,6 say  "║║             F3   &D2                               ║║"
         @ 9,6 say  "║║             F4   &D3                               ║║"
         @ 10,6 say "║║             F5   &D4                               ║║"
         @ 11,6 say "║║             F6   &D5                               ║║"
         @ 12,6 say "║╠═════════════════════════════════════════════════════════════╣║"
         @ 13,6 say "║║                       OTHER FUNCTIONS                       ║║"
         @ 14,6 say "║║                                                             ║║"
         @ 15,6 say "║║             F7   ADD A RECORD                               ║║"
         @ 16,6 say "║║             F8   REINDEX DATA FILES                         ║║"
         @ 17,6 say "║║             F9   RUN A DOS PROGRAM                          ║║"
         @ 18,6 say "║║             F10  QUIT                                       ║║"
         @ 19,6 say "║╠═════════════════════════════════════════════════════════════╣║"
         @ 20,6 say "║║                                                             ║║"
         @ 21,6 say "║╚═════════════════════════════════════════════════════════════╝║"
         @ 22,6 say "╚═══════════════════════════════════════════════════════════════╝"
      endif


      if file("contact.dbf")
      else
         ch = " "
         @ 20,12 say "DATA FILES NO FOUND... DO YOU WANT TO INSTALL Y/N " GET ch pict "!"
         ??  chr(7)
         read
         if ch = "Y"
         else
            @ 20,12 say "NO FILES CREATED                                    "
            do delay
            clear
            quit
         endif
         msg = "CREATING CONTACT TRACKER DATA FILE ... PLEASE WAIT   "
         @ 20,12 get msg
         clear gets
         do creatfil with "CONTACT"
         @ 20,12 say space(53)
         cnf = .T.
         if cnf
            do reindex
            repaint = .f.
            loop
         endif
      endif
      cnf = .F.
      repaint = .f.
      choice = "  "
      @ 20,8 say space(55)
      choice = 0
      @ 20,25 say "YOUR CHOICE ?"
      call CURSOR2 with 'Off'
      do while choice = 0
         time = time()
         @ 3,59 get time
         clear gets
         @ 20,40 say " "
         mtime = time()
         do while mtime = time() .and. choice = 0
            choice = inkey()
         enddo
         if choice > 0
            choice = 0
         endif
      enddo
      call CURSOR2 with 'Normal'
      set confirm on
      set function 9 to trim(string)
      store "                         " to string
      do case
      case choice = -1
         @ 3,53 say space(15)
         @ 20,8 say space(55)
         @ 20,15 say "NAME TO FIND " get string pict "!XXXXXXXXXXXXXXX"
         read
         set order TO 1
         if string # " "
            seek trim(string)
         else
            loop
         endif
      case choice = -2
         @ 3,53 say space(15)
         @ 20,8 say space(55)
         @ 20,13 say "FIRM NAME TO FIND " get string pict "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX "
         read
         set order to 2
         if string # " "
            seek trim(string)
         else
            loop
         endif
      case choice= -3
         @ 3,53 say space(15)
         @ 20,8 say space(55)
         @ 20,13 say "PRODUCT NAME TO FIND " get string  pict "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX "
         read
         set order to 3
         if string # " "
            seek trim(string)
         else
            loop
         endif
      case choice = -4
         @ 3,53 say space(15)
         @ 20,8 say space(55)
         @ 20,16 say "DATE TO FIND " get dstring
         read
         set order to 4
         seek dstring
         if eof()
            @ 20,15 say "           DATE NOT FOUND..."
            do delay
            loop
         endif
      case choice = -5
         @ 3,53 say space(15)
         @ 20,8 say space(55)
         @ 20,18 say "STATUS TO FIND " get string picture "!"
         read
         set order to 5
         if string # " "
            seek trim(string)
            if eof()
               @ 20,15 say "          STATUS NOT FOUND..."
               do delay
               loop
            endif
         else
            loop
         endif
      case choice = -6
         do addrec
      case choice = -7
         @ 3,53 say space(15)
         do reindex
         loop
      case choice = -8
         @ 3,53 say space(15)
         prog = space(25)
         @ 20,8 say space(55)
         @ 20,15 say "PROGRAM TO RUN " get prog
         read
         if len(trim(prog)) = 0
            loop
         else
            clear
            run &prog
            repaint = .t.
         endif
         loop
      case choice = -9
         set confirm off
         store 0 to choose
         @ 20,15 say "[F10] TO QUIT, OR <CR> RETURN TO PROGRAM "
         call CURSOR2 with 'Off'
         do while choose = 0
            time = time()
            @ 3,59 get time
            clear gets
            @ 20,56 say " "
            mtime = time()
            do while mtime = time() .and. choose = 0
               choose = inkey()
            enddo
         enddo
         call CURSOR2 with 'Normal'
         if choose = -9
            set console off
            clear
            quit
         else
            loop
         endif
      endcase
   else
      seek trim(xname)
      store "               " to string
      store " " to xname
      if eof()
         clear
         @ 10,20,14,40 box frame2
         @ 12,23 say "NAME NOT FOUND "
         loop
      endif
   endif
   if eof()
      @ 3,53 say space(15)
      set function 9 to trim(string)
      store " " to sele
      @ 20,8 say space(55)
      set confirm off
      @ 20,22 say "NOT FOUND, DO YOU WANT TO ADD? " get sele pict "!"
      read
      set confirm on
      if sele = "Y"
         do addrec
      else
         set function 9 to trim(string)
         loop
      endif
   else
      store .f. to label
      store .t. to editing
      store .f. to editmemo
      do frame
      do while editing .and. .not. (eof() .or. bof())
         set function 9 TO dtoc(date())
         set function 6 to chr(27)
         set function 7 TO chr(18)
         set function 8 TO chr(3)
         set function 10 to chr(23)
         if editmemo
            editmemo = .f.
         else
            do format1
            editmemo = .f.
         endif
         key = 0
         call CURSOR2 with 'Off'
         do while key = 0
            time = time()
            @ 2,34 get time
            clear gets
            mtime = time()
            do while mtime = time() .and. key = 0
               key = inkey()
            enddo
         enddo
         call CURSOR2 with 'Normal'
         if key = -9 .or. lastkey() = 27
            editing = .f.
            loop
         endif
         if key = -6
            choice = " "
            save screen
            if color
               set color to w+/r
            endif
            @ 10,15,12,65 box ""
            @ 10,15,12,65 box frame1
            set confirm off
            set scoreboard off
            @ 11,18 say "Do you want to duplicate this record? " get choice pict "!"
            read
            set scoreboard on
            set confirm on
            if color
               set color to w+/b,r/w,b+
            endif
            if choice <> "Y"
               restore screen
               loop
            endif
            duperec = .t.
            store dial1 to mdial1
            store dial2 to mdial2
            store dial3 to mdial3
            store dial4 to mdial4
            store name to mname
            store firm to mfirm
            store address1 to maddress1
            store address2 to maddress2
            store city to mcity2
            store state to mstate
            store zip to mzip
            store phone to mphone
            store product to mproduct
            store date_last to mdate_last
            store date_next to mdate_naxt
            store status to mstatus
            store category to mcategory
            store type to mtype
            do addrec
            do format1
            @ 21,0 say "╔══════════════════════════════════════════════════════════════════════════════╗"
            @ 22,0 say "║  [F5] DIAL [F6] MEMO  [PgUp] Previous Rec  [PgDn] Next Rec  [F10] Continue   ║"
            @ 23,0 say "║     [Alt-F10] Print Options  [Alt-F9] Edit Record    [Alt-F8]  Delete        ║"
            @ 24,0 say "╚══════════════════════════════════════════════════════════════════════════════╝"
            duperec = .f.
            loop
         endif
         if key = -34
            call SPORT with hangup
            loop
         endif
         if key = -4
            do dial
            loop
         endif
         if key = -5
            do memo
         endif
         if key = 18
            skip -1
            loop
         endif
         if key = 3
            skip
            loop
         endif
         if key = -39
            do print
         endif
         if key = -38
            do editrec
         endif
         if key = -37
            do delete
            loop
         endif
         set function 6 to chr(6)
         set function 7 to chr(7)
         set function 8 to chr(8)
         set function 9 to trim(string)
         set function 10 to chr(10)
      enddo
   endif
enddo
clear



procedure label
set console off
set print on
if choice = "C"
   ?
   ?
   ?  "                       CONTACT TRACKER "
   ?
   ?
endif
if choice = "1" .or. choice = "7" .or. choice = "4"
   ?
   ?
   ?
   ?
   ?
   ?
   ?
   ?
endif
if len(trim(name)) > 0 .and. cont
   ? space(lm)+trim(substr(name,at(',',name)+2,len(name))) + " " +  substr(name,1,at(',',name)-1)
endif
if len(trim(firm)) > 0 .and. comp
   ? space(lm)+firm
endif
? space(lm)+address1
if len(trim(address2)) > 0
   ? space(lm)+address2
endif
? space(lm)+trim(city)+", "+state+" "+zip
?
if choice = "3" .or. choice = "6" .or. choice = "9" .or. choice = "C"
   ? space(lm+5) + phone
   ?
   ? product
   ?
   ? "Category  " + category
   ? "Status    " + status
   ? "Type      " + type
   ?
endif
if choice = "C"
   ?
   ? "========================NOTES================================================"
   ?

   ? memo
endif
set console on
set print off
store .f. to label




procedure delay
zz=1
do while zz < 250
   zz= zz+1
enddo
return



procedure frame
repaint = .t.
clear
@ 1,0 say  "╔══════════════════════════════════════════╦═══════════════════════════════════╗"
@ 2,0 say  "║   CONTACT TRACKER DATA BASE              ║                                   ║"
@ 3,0 say  "╠══════════════════════════════════════════╩═══════════════════════════════════╣"
@ 4,0 say  "║"
@ 4,79 say "║"
@ 5,0 say  "║"
@ 5,79 say "║"
@ 6,0 say  "║"
@ 6,79 say "║"
@ 7,0 say  "║"
@ 7,79 say "║"
@ 8,0 say  "║"
@ 8,79 say "║"
@ 9,0 say  "║"
@ 9,79 say "║"
@ 10,0 say "║"
@ 10,79 say "║"
@ 11,0 say  "║"
@ 11,79 say "║"
@ 12,0 say  "║"
@ 12,79 say "║"
@ 13,0 say  "║"
@ 13,79 say "║"
@ 14,0 say  "╠"
@ 14,1 say  "══════════════════════════════════════════════════════════════════════════════"
@ 14,79 say "╣"
@ 15,0 say  "║"
@ 15,79 say "║"
@ 16,0 say  "║"
@ 16,79 say "║"
@ 17,0 say  "║"
@ 17,79 say "║"
@ 18,0 say  "║"
@ 18,79 say "║"
@ 19,0 say  "║"
@ 19,79 say "║"
@ 20,0 say  "║"
@ 20,79 say "║"
@ 21,0 say "╔══════════════════════════════════════════════════════════════════════════════╗"
@ 22,0 say "║  [F5] DIAL [F6] MEMO  [PgUp] Previous Rec  [PgDn] Next Rec  [F10] Continue   ║"
@ 23,0 say "║     [Alt-F10] Print Options  [Alt-F9] Edit Record    [Alt-F8]  Delete        ║"
@ 24,0 say "╚══════════════════════════════════════════════════════════════════════════════╝"
@ 4,1 say   "                                                                             "
@ 5,1 say "    NAME                                                                     "
@ 6,1 say "                                                                             "
@ 7,1 say "    COMPANY                                                                  "
@ 8,1 say "    ADDRESS                                                                  "
@ 9,1 say "                                                                             "
@ 10,1 say "                                                                             "
@ 11,1 say "    PHONE                                                                    "
@ 12,1 say "    PRODUCT                                                                  "
@ 13,1 say "                                                                             "
@ 15,1 say "    LAST CONTACT               DIAL NOS                                      "
@ 16,1 say "    NEXT CALL                                                                "
@ 17,1 say "    STATUS CODE                                                              "
@ 18,1 say "    CATEGORY                                                                 "
@ 19,1 say "    TYPE                                                                     "
@ 20,1 say "                                                                             "




procedure format1
if color
   set color to GR+/B
endif
*@ 2,45 say dial1
@ 5,19 say space(59)
if at(",",name) = 0
   @ 5,19 say name
else
   @ 5,19 say trim(substr(name,at(',',name)+2,len(name))) + " " +  substr(name,1,at(',',name)-1)
endif
@ 7,19 say firm
@ 8,19 say address1
if len(trim(address2)) = 0
   @ 9,19 say space(40)
   if len(trim(city)) = 0
      @ 10,19 say space(40)
   else
      @ 09,19 say trim(city) + ", " + state + " " + zip
      @ 10,19 say space(40)
   endif
else
   @ 9,19 say space(40)
   @ 9,19 say address2
   @ 10,19 say space(40)
   if len(trim(city)) = 0
   else
      @ 10,19 say trim(city) + ", " + state + " " + zip
   endif
endif
@ 11,19 say phone
@ 12,19 say product
if date_last <> "  /  /  "
   @ 15,19 say date_last
else
   @ 15,19 say space(8)
endif
if date_next <> "  /  /  "
   @ 16,19 say date_next
else
   @ 16,19 say space(8)
endif
@ 17,19 say status pict "!!!"
@ 18,19 say category pict "!!!"
@ 19,19 say type pict "!!!"
@ 15,45 say dial1
@ 16,45 say dial2
@ 17,45 say dial3
@ 18,45 say dial4
@ 23,76 say " "
if color
   set color to w+/b,r/w,b+
endif




procedure format2
@ 20,40 say space(38)
@ 2,34 say space(8)
*@ 2,45 get dial1
@ 5,19 get name pict "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 5,58 say "Last, First M."
@ 7,19 get firm pict "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 8,19 get address1
@ 9,19 get address2
@ 10,19 get city pict "!XXXXXXXXXXXXXXXXXXXX"
@ 10,41 get state pict "!!"
@ 10,44 get zip pict "99999x9999"
@ 11,19 get phone
@ 12,19 get product pict "!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
@ 15,19 get date_last pict "99/99/99"
@ 16,19 get date_next pict "99/99/99"
@ 17,19 get status pict "!!!"
@ 18,19 get category pict "!!!"
@ 19,19 get type pict "!!!"
@ 15,45 get dial1
@ 16,45 get dial2
@ 17,45 get dial3
@ 18,45 get dial4
@ 22,1 say space(60)
@ 23,1 say space(72)




procedure reindex
if net_use("contact",.t.,5)
   msg = "REINDEXING DATA FILES ... PLEASE WAIT"
   @ 20,15 get msg
   clear gets
   index on name to I1
   index on firm to I2
   index on product to I3
   index on ctod(date_next) to I4
   index on status to I5
   unlock
   set index to I1,I2,I3,I4,I5
   @ 20,15 say space(50)
else
   msg = "UNABLE TO REINDEX DATA FILES, FILE IS ALREADY IN USE "
   @ 20,12 get msg
   ?? chr(7)
   clear gets
   do delay
   @ 20,12 say space(54)
endif





procedure addrec
clear
set order to 1
set function 7 to chr(18)
set function 8 TO chr(3)
set function 10 TO chr(23)
set function 9 TO dtoc(date())
if add_rec(5)
else
   msg = "CANNOT ADD A RECORD NOW, FILE IS LOCKED"
   @ 20,22 get msg
   ?? CHR(7)
   do delay
   @ 20,22 say space(45)
   return
endif
clear
do frame
if duperec
   replace dial1 with mdial1
   replace dial2 with mdial2
   replace dial3 with mdial3
   replace dial4 with mdial4
   replace name with mname
   replace firm with mfirm
   replace address1 with maddress1
   replace address2 with maddress2
   replace city with mcity2
   replace state with mstate
   replace zip with mzip
   replace phone with mphone
   replace product with mproduct
   replace date_last with mdate_last
   replace date_next with mdate_naxt
   replace status with mstatus
   replace category with mcategory
   replace type with mtype
endif
do format2
read
unlock
set function 10 to chr(10)
set function 9 to trim(string)
set function 8 to chr(8)
set function 7 to chr(7)


procedure creatfil
create contact
F1 =  "DATE_LAST   C 8 "
F2 =  "DATE_NEXT   C 8 "
F3 =  "NAME        C 35"
F4 =  "FIRM        C 35"
F5 =  "ADDRESS1    C 35"
F6 =  "ADDRESS2    C 35"
F7 =  "CITY        C 21"
F8 =  "STATE       C 2 "
F9 =  "ZIP         C 10"
F10 = "PRODUCT     C 35"
F11 = "PHONE       C 17"
F12 = "DIAL1       C 30"
F13 = "DIAL2       C 30"
F14 = "DIAL3       C 30"
F15 = "DIAL4       C 30"
F16 = "STATUS      C 1 "
F17 = "CATEGORY    C 3 "
F18 = "TYPE        C 3 "
F19 = "EDIT        L 1 "
F20 = "MEMO        M 10"
count = 1
do while count <= 20
   store if(count <= 9, str(count,1) , str(count,2) ) to cnt
   append blank
   x="F"+cnt
   replace field_name with substr(&X,1,10),field_type with substr(&X,13,1)
   replace field_len with val(substr(&X,15,2))
   count = count + 1
enddo
create C_455 from contact
use
delete file contact.dbf
delete file contact.dbt
rename  C_455.DBF to CONTACT.DBF
rename  C_455.DBT to CONTACT.DBT




procedure print
save screen
@ 12,15,23,65 box ""
if color
   set color to r/w
endif
@ 12,15,23,65 box ""
@ 12,15,23,65 box frame2
@ 12,28 say " PRINT CHOICES "
choice = " "
do while choice = " "
   @ 14,18 say "         Standard Envelope   Label    Rolodex"
   @ 16,18 say "Company only   [1]            [2]        [3] "
   @ 17,18 say "Contact only   [4]            [5]        [6] "
   @ 18,18 say "Both           [7]            [8]        [9] "
   @ 19,16 say replicate(chr(196),49)
   @ 20,18 say "Complete record  [C]   Exit w/o printing [0] "
   set console off
   wait " " to choice
   if color
      set color to w+/b,r/w,b+
   endif
   if len(trim(choice)) = 0
      choice = "0"
      loop
   endif
   choice = upper(choice)
   set console on
   comp = .t.
   cont = .t.
   do case
   case choice = '0'
      loop
   case choice = "1"
      lm = 30
      cont = .f.
   case choice = '2'.or. choice = '3'
      cont = .f.
      lm = 0
   case choice = '4'
      lm = 30
      comp = .f.
   case choice = '5'
      lm = 0
      comp = .f.
   case choice = '6'
      lm = 0
      comp = .f.
   case choice = '7'
      lm = 30
   case choice = '8' .or. choice = '9' .or. choice = 'C'
      lm = 0
   otherwise
      choice = " "
      loop
   endcase
   if choice <> "0"
      do label
   endif
   restore screen
   loop
enddo
restore screen
return



procedure delete
sure = " "
set confirm off
@ 19,45 say "Delete? Y/N " get sure pict "!"
read
set confirm on
if sure = "Y"
   if rec_lock(5)
      delete
      unlock
      @ 19,45 say "Record is deleted "
      ?? chr(7)
      do delay
      @ 19,45 say space(20)
   else
      msg = "Cannot delete  "
      @ 19,45 get msg
      clear gets
      ?? chr(7)
      do delay
      @ 19,45 say space(15)
   endif
else
   @ 19,45 say space(20)
endif



procedure memo
lock = .t.
do while lock
   if rec_lock(5)
      save screen
      clear
      @ 2,1,23,78 box frame2
      @ 2,36 say "NOTES"
      store trim(substr(name,at(',',name)+2,len(name))) + " " +  substr(name,1,at(',',name)-1) to mname
      @ 1,10 get mname
      clear gets
      replace memo with memoedit(memo,3,3,22,77,.t.)
      unlock
      restore screen
      lock = .f.
      editmemo = .t.
      loop
   else
      store " Record is locked. (R)etry or (E)xit "  to msg
      @ 20,40 get msg
      ?? chr(7)
      clear gets
      set console off
      wait to x
      set console on
      if upper(x) = "R"
         loop
      else
         @ 20,40 say space(38)
         exit
      endif
   endif
   editmemo = .f.
enddo



procedure dial

save screen
tst = space(30)
if dial1 = tst .and. dial2 = tst .and. dial3 = tst .and. dial4 = tst
   @ 12,40 say "NO NUMBERS TO DIAL"
   ?? chr(7)
   do delay
   @ 12,40 say "                  "
   return
endif
if dial2 = tst .and. dial3 = tst .and. dial4 = tst
  opt = 1
else
   msg1 =  " PICK NUMBER TO DIAL AND HIT RETURN   "
   msg2 = "   (ESCAPE TO ABORT)                  "
   @ 12,40 get msg1
   @ 13,40 get msg2
   clear gets
   @ 15,45 prompt dial1
   if dial2 <> "     "
      @ 16,45 prompt dial2
   endif
   if dial3 <> "     "
      @ 17,45 prompt dial3
   endif
   if dial4 <> "     "
      @ 18,45 prompt dial4
   endif
   menu to opt
   if opt = 0
      restore screen
      return
   endif
endif
dialno = "DIAL"+str(opt,1)
dial = 'WATDT' + &DIALNO + chr(13) + chr(10)  && for smartmodem
if color
   set color to w+/r
endif
@ 09,10,15,62 box ""
@ 09,10,15,62 box frame1
@ 11,12 say "Now dialing  " + trim(substr(name,at(',',name)+2,len(name))) + " " +  substr(name,1,at(',',name)-1)
@ 12,12 say "Phone #      " + &dialno
call SPORT with 'P1'
call SPORT with 'V 1200, N, 8, 1'
call SPORT with DIAL
msg = "  Press ESC when your party answers or to HANG UP  "
@ 14,11 get msg
clear gets
if color
   set color to w+/b,r/w,b+
endif
choice = 0
call CURSOR2 with 'Off'
do while choice <> 27
   time = time()
   @ 2,34 get time
   clear gets
   @ 23,57 say " "
   mtime = time()
   do while mtime = time() .and. choice = 0
      choice = inkey()
   enddo
enddo
call SPORT with HANGUP
restore screen
call CURSOR2 with 'Normal'




procedure editrec
do while .t.
   if rec_lock(5)
      do format2
      read
      unlock
      @ 21,0 say "╔══════════════════════════════════════════════════════════════════════════════╗"
      @ 22,0 say "║  [F5] DIAL [F6] MEMO  [PgUp] Previous Rec  [PgDn] Next Rec  [F10] Continue   ║"
      @ 23,0 say "║     [Alt-F10] Print Options  [Alt-F9] Edit Record    [Alt-F8]  Delete        ║"
      @ 24,0 say "╚══════════════════════════════════════════════════════════════════════════════╝"
      exit
   else
      store " Record is locked. (R)etry or (E)xit "  to msg
      @ 20,40 get msg
      ?? chr(7)
      clear gets
      set console off
      wait to x
      set console on
      if upper(x) = "R"
         loop
      else
         @ 20,40 say space(38)
         exit
      endif
   endif
enddo



** USER DEFINED FUNCTIONS

FUNCTION NET_USE
PARAMETERS file, ex_use, wait
PRIVATE forever
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)
   IF ex_use
      USE &file EXCLUSIVE
   ELSE
      USE &file
   ENDIF
   IF .NOT. NETERR()
      RETURN (.T.)
   ENDIF
   INKEY(1)
   wait = wait - 1
ENDDO
RETURN (.F.)



FUNCTION FIL_LOCK
PARAMETERS wait
PRIVATE forever
IF FLOCK()
   RETURN (.T.)
ENDIF
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)
   INKEY(.5)
   wait = wait - .5
   IF FLOCK()
      RETURN (.T.)
   ENDIF
ENDDO
RETURN (.F.)


FUNCTION REC_LOCK
PARAMETERS wait
PRIVATE forever
IF RLOCK()
   RETURN (.T.)
ENDIF
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)
   IF RLOCK()
      RETURN (.T.)
   ENDIF
   INKEY(.5)
   wait = wait - .5
ENDDO
RETURN (.F.)


FUNCTION ADD_REC
PARAMETERS wait
PRIVATE forever
APPEND BLANK
IF .NOT. NETERR()
   RETURN (.T.)
ENDIF
forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)
   APPEND BLANK
   IF .NOT. NETERR()
      RETURN .T.
   ENDIF
   INKEY(.5)
   wait = wait - .5
ENDDO
RETURN (.F.)