* ***************************  DNADD COMMAND FILE  ***************************
*
*                                  dNAMES 1.1
*                   (c) Copyright 1982 Data Based Solutions
*                             All Rights Reserved
* ****************************************************************************
IF eop#'CALL'
 STORE "@ 13,0 SAY "+eop TO era
ELSE
 STORE 'CALL' TO era 
 POKE 42000,12
ENDIF
RELEASE abort,blank,checkthis,d1,d2,datafile,date1,date2,dotline,howmany,;
ia1,ia2,ia3,ib1,ib2,ib3,ic1,ic2,ic3,iz1,iz2,iz3,l1,l2,lno,locstring
RELEASE mname,mphone,newpage,nnn,noloca,number,page,pgbreak,point,;
pr96,preset,proff,pron,quest,recno,shouldi,showcl,showit,specs,srt,stop
RELEASE str1,str2,str3,str4,tempfile,thismany,tophead,typ,wanted,;
where,which,yes,z1,z2,batch,right,prn
DO dnscreen
@ 1,6 SAY " LAST ENTRY-" 
@ 1,60 SAY 'DATE-' 
SET inte OFF
@ 1,19 SAY $(headname+ '                                        ' ,1,40)
@ 1,66 SAY $(headdate+ '        ' ,1,8)
SET inte ON
DO WHILE t
 RELEASE a1,a2,b1,b2,c1,c2,mem,mname,msal,madd,mcity,mstate,mzip,marea,;
 mphone,mcom,answer,open,ml1a,ml1b,ml1c,ml2a,ml2b,ml2c,ml3a,ml3b,ml3c,mcode,;
 choice
 CLEAR GETS
 SELECT PRIMARY
 SET inte ON
 @ 3,13 SAY '                                   ' 
 @ 3,55 SAY '                      ' 
 @ 4,13 SAY '                              ' 
 @ 4,60 SAY '                 ' 
 @ 5,13 SAY '                    ' 
 @ 5,41 SAY '  ' 
 @ 5,49 SAY '      ' 
 @ 5,69 SAY '        ' 
 @ 6,13 SAY '   ' 
 @ 6,24 SAY '        ' 
 @ 6,40 SAY '                 ' 
 @ 6,69 SAY '        ' 
 @ 7,03 SAY '                                                      ' +;
 '                     ||' 
 @ 8,13 SAY '                                                      ' +;
 '          ' 
 @ 9,3 SAY '                                                      ' +;
 '                    ' 
 @ 10,3 SAY '                                                      ' +;
 '                    ' 
 @ 11,3 SAY '                                                      ' +;
 '                    ' 
 STORE '                                                                ' ;
 TO mcom
 STORE '                                                                ' +;
 '          ' TO mline1
 STORE '                                                                ' +;
 '          ' TO mline2
 STORE '                                                                ' +;
 '          ' TO mline3
 STORE '                                   ' TO mname
 STORE '                      ' TO msal
 STORE '                              ' TO madd
 STORE '                    ' TO mcity
 STORE '                 ' TO mmcl
 STORE '        ' TO mphone
 STORE '      ' TO mzip
 STORE '      ' TO mcode
 STORE '   ' TO marea
 STORE '  ' TO mstate
 STORE t TO correct
 DO WHILE correct
  RELEASE correct,answer
  &era
  @ 14,3 SAY 'Enter record name as "LastName*FirstName MiddleInitial" ' +;
  'or "Company Name"' 
  @ 15,18 SAY 'To return to main menu type <RET> in name.' 
  @ 17,18 SAY 'This Is Entry Number:       Dated:' 
  @ 23,0 SAY '  ctl-X down | ctl-E up | ctl-D -> | ctl-S <- ' +;
  '| ctl-G del char | ctl-V insert' 
  SET inte OFF
  @ 17,40 SAY str(mno+1,4)
  @ 17,53 SAY DATE()
  SET intensity ON
  STORE t TO checking
  DO WHILE checking
   @ 3,13 GET mname
   &con
   READ
   &coff
   CLEAR GETS
   IF @( '* ' ,mname)#0
    SET inte OFF
    @ 13,5 SAY 'LastName and FirstName must be separated with ' +;
    'an asterisk and no spaces' 
    SET inte ON
   ELSE
    STORE f TO checking
   ENDIF 
  ENDDO WHILE checking 
  RELEASE checking
  IF mname= ' ' 
   &era
   SET inte OFF
   @ 16,8 SAY 'ARE YOU SURE YOU WANT TO RETURN TO MAIN MENU ?  Y or <RET>' 
   SET inte ON
   SET cons OFF
   WAIT TO sure
   SET cons ON
   IF !(sure)= 'Y' 
    ERASE
    SET inte OFF
    @ 13,23 SAY '*** ONE MOMENT PLEASE ***' 
    SET inte ON
    RELEASE mname,msal,mcity,madd,mstate,mzip,mmcl,mphone,nnn,sure,;
    decision,correct,checking,l,nam,marea,mcom,ml1a,ml1b,ml1c,ml2a,ml2b,;
    ml2c,ml3a,ml3b,ml3c,mcode,mline1,mline2,mline3
    RELEASE noloca,nam,mdate,l,choice,sure,right
    STORE f TO open
    STORE $(dsk,2,1)+ ':dnn' TO a1
    STORE $(dsk,2,1)+ ':dnxn' TO a2
    STORE $(dsk,2,1)+ ':dnc' TO b1
    STORE $(dsk,2,1)+ ':dnxc' TO b2
    STORE $(dsk,2,1)+ ':dnmc' TO c1
    STORE $(dsk,2,1)+ ':dnxmc' TO c2
    STORE $(dsk,2,1)+ ':dnmem' TO mem
    RETURN
   ELSE
    STORE t TO correct
    RELEASE sure
    LOOP
   ENDIF 
  ELSE
   &era
   SET inte OFF
   @ 14,23 SAY "* * * ONE MOMENT PLEASE * * *" 
   @ 15,13 SAY " I'm checking first to see if this name is " +;
   "on file. " 
   SET inte ON
   STORE len(trim($(mname,1,20))) TO l
   STORE $(mname,1,l) TO nam
   FIND &nam
   IF $(name,1,l)=nam
    RELEASE nam,l
    STORE # TO recno
    STORE t TO noloca
    STORE '1' TO answer
    STORE ' ' TO choice
    SELECT seco
    GO recno
    SELECT PRIMARY
    DO dnfound
    IF !(choice)= 'A' 
     STORE 'A' TO decision
     STORE f TO correct
     LOOP
    ENDIF 
    RELEASE l,nam,nnn,noloca,recno,answer
   ENDIF 
   &era
   @ 15,23 SAY 'Enter Salutation or "@" to abort.' 
   @ 23,0 SAY '  ctl-X down | ctl-E up | ctl-D -> | ctl-S <- ' +;
   '| ctl-G del char | ctl-V insert' 
  ENDIF 
  @ 3,55 GET msal
  &con
  READ
  &coff
  IF msal= '@' 
   STORE 'A' TO decision
   STORE f TO correct
   LOOP
  ENDIF 
  &era
  @ 15,24 SAY 'Please fill in all information.' 
  @ 23,0 SAY '  ctl-X down | ctl-E up | ctl-D -> | ctl-S <- ' +;
  '| ctl-G del char | ctl-V insert' 
  @ 4,13 GET madd
  @ 5,13 GET mcity
  @ 5,41 GET mstate PICTURE '!!' 
  @ 5,49 GET mzip PICTURE '!!!!!!' 
  &con
  READ
  &coff
  CLEAR GETS
  @ 6,13 GET marea PICTURE '999' 
  @ 6,24 GET mphone PICTURE '999-9999' 
  SET confirm OFF
  &con
  READ
  &coff
  CLEAR GETS
  SET confirm ON
  STORE marea+$(mphone,1,3)+$(mphone,5,4) TO findphone
  IF findphone# '     ' 
   SELECT seco
   FIND &findphone
   IF ##0
    RELEASE findphone
    STORE # TO recno
    STORE t TO noloca
    STORE '1' TO answer
    STORE ' ' TO choice
    SELECT PRIMARY
    GO recno
    DO dnfound
    IF !(choice)= 'A' 
     STORE 'A' TO decision
     STORE f TO correct
     LOOP
    ENDIF 
   ELSE
    SELECT PRIMARY
   ENDIF 
  ENDIF 
  RELEASE l,nam,findphone,nnn,noloca,recno,answer
  SET inte ON
  &era
  @ 14,9 SAY mcl1
  @ 15,9 SAY mcl2
  @ 16,9 SAY mcl3
  @ 17,9 SAY mcl4
  @ 18,9 SAY mcl5
  @ 19,9 SAY mcl6
  @ 20,9 SAY mcl7
  @ 21,9 SAY mcl8
  @ 22,9 SAY mcl9
  @ 23,9 SAY mcl10
  STORE t TO checking
  DO WHILE checking
   @ 13,03 SAY 'Enter classification or "00" to ' +;
   'add or edit.' 
   @ 6,40 GET mmcl PICTURE '99-99-99-99-99-99' 
   &con
   READ
   &coff
   IF val($(mmcl,1,2))>endcl.OR.val($(mmcl,4,2))>endcl.OR.;
    val($(mmcl,7,2))>endcl.OR.val($(mmcl,10,2))>endcl.OR.;
    val($(mmcl,13,2))>endcl.OR.val($(mmcl,16,2))>endcl
    SET inte OFF
    @ 13,61 SAY 'INVALID ENTRY' 
    SET inte ON
   ELSE
    @ 13,60 SAY '               ' 
    STORE f TO checking
   ENDIF
   IF @( '00' ,mmcl)#0.AND.mmcl# '  ' 
    DO dnrecl
    IF which# ' ' 
     USE &a1 INDEX &a2
     SELECT seco
     USE &b1 INDEX &b2
     SELECT PRIMARY
     RELEASE which
    ENDIF 
    @ 13,03
    STORE t TO checking
   ENDIF 
  ENDDO WHILE 
  RELEASE checking
  STORE f TO showcl
  SET inte OFF
  DO dnshow
  SET inte ON
  RELEASE showcl
  &era
  @ 15,22 SAY 'Enter an additional code if needed.' 
  @ 23,0 SAY '  ctl-X down | ctl-E up | ctl-D -> | ctl-S <- ' +;
  '| ctl-G del char | ctl-V insert' 
  @ 6,71 GET mcode
  &con
  READ
  &coff
  CLEAR GETS
  @ 15,22 SAY '   Enter any comments as needed.   ' 
  @ 17,2 SAY 'If you need to have an additional line below the Name ' +;
  'which can be used for' 
  @ 18,2 SAY '"ATTENTION: John Smith", "Federal Building", an Address ' +;
  '1, etc., enter that' 
  @ 19,2 SAY 'line in the Comments followed by "@". Then start ' +;
  'your comments.' 
  @ 8,13 GET mcom
  &con
  READ
  &coff
  CLEAR GETS
  IF mcom# ' ' 
   @ 17,2
   @ 18,2
   @ 19,2
   @ 9,3 GET mline1
   SET confirm OFF
   &con
   READ
   &coff
   IF mline1# '   ' 
    @ 10,3 GET mline2
    &con
    READ
    &coff
    IF mline2# '   ' 
     @ 11,3 GET mline3
     &con
     READ
     &coff
    ENDIF 
   ENDIF 
  ENDIF 
  CLEAR GETS
  SET conf ON
  &era
  SET colon ON
  STORE ' ' TO decision
  @ 15,3 SAY 'Is everything correct?' 
  @ 16,3 SAY 'Type "A" to abort entry, "C" to correct, or <RET> to ' +;
  'add this record. ' GET decision PICTURE '!' 
  &con
  READ
  &coff
  SET colon OFF
  IF decision# 'C' 
   STORE f TO correct
  ELSE
   STORE t TO correct
   @ 7,03 SAY '                                                      ' +;
   '                     ||' 
  ENDIF 
 ENDDO WHILE 
 IF !(decision)# 'A' 
  STORE $(dsk,2,1)+ ':dnn' TO a1
  STORE $(dsk,2,1)+ ':dnxn' TO a2
  STORE $(dsk,2,1)+ ':dnc' TO b1
  STORE $(dsk,2,1)+ ':dnxc' TO b2
  STORE $(dsk,2,1)+ ':dnmc' TO c1
  STORE $(dsk,2,1)+ ':dnxmc' TO c2
  STORE $(dsk,2,1)+ ':dnmem' TO mem
  &era
  SET inte OFF
  @ 14,28 SAY " ONE MOMENT PLEASE. " 
  @ 15,19 SAY " I'm putting this record into the file. " 
  SELECT PRIMARY
  APPEND BLANK
  SELECT seco
  APPEND BLANK
  STORE # TO mno
  SELECT PRIMARY
  REPLACE name WITH mname,cl WITH mmcl,zip WITH mzip,;
  UPDATE WITH $(DATE(),1,2)+$(DATE(),4,2)+$(DATE(),7,2),no WITH mno
  REPLACE DATE WITH $(DATE(),1,2)+$(DATE(),4,2)+$(DATE(),7,2),;
  code WITH $(code,1,2)+mcode
  SELECT seco
  REPLACE nno WITH mno,state WITH mstate,sal WITH msal,ADD WITH madd,;
  phone WITH marea+$(mphone,1,3)+$(mphone,5,4),city WITH mcity,;
  com WITH mcom
  IF mline1# '   ' .OR.mline2# '   ' .OR.mline3# '   ' 
   USE &c1 INDEX &c2
   APPEND BLANK
   REPLACE cno WITH mno,line1 WITH mline1,line2 WITH ;
   mline2,line3 WITH mline3
   USE &b1 INDEX &b2
   SELECT PRIMARY
   REPLACE code WITH '*' +$(code,2,7)
  ENDIF 
  STORE trim(name) TO headname
  STORE DATE() TO headdate
  @ 1,19 SAY $(headname+ '                                        ' ,1,40)
  @ 1,66 SAY $(headdate+ '        ' ,1,8)
  SET inte ON
 ENDIF 
 RELEASE decision
ENDDO WHILE t 
RETURN