!TRACYIN4.IPF - mod from 3nd functional version  which has been working
!at the tracy since 13/5 - this version modified to call tracoll3.ipf to
!get more data from the label - collector name, #, and date of collection
!discovered that data added to taesdata at 3 points - copied call to
!tracoll3.ipf to these 3-7/6/96-some problems with resets in county loop,
!but all seems to work ok-24/6/96-bit of a flap when old tracount.itb was
!shipped to tracy with resulting namarray bound error - Eddy now testing and
!approaching a full county screen with Bouteloua - so, need to reset county
!printing back to start row/col at some point - see '24/6/96' for new code-
!looks like will involve two arrays couprint[coords] and coulist [names] -
!have 14 counties/row and max of 6 rows - when counties get to 84 for a given
!taxon, will clear coulist and reset couprint to original position
!EDITING TRACOLL3 TO TRACOLL4 for two table collector name lookup-THIS
!REVISION EFFECTIVE 25/7/96
clear
!TABLES
finish all
use huhname1 with huhpluck;use collrefs !FOR TRACOLL4.IPF
use traname1 with tranamep !FOR TRACOLL4.IPF
use txcenzi3 with txcenpl
use taesdata !MAIN DATA TABLE
use trapoa1 !TRACKING TABLE FOR NON-BONAP NAMES
use tracount with county !TEXAS COUNTIES - MOD FROM HERCOUNT.ITB
use karpoa2 with genspe !POACEAE FROM BONAP94 WITH INDEX KEY [1ST3/1ST5]
default karpoa2
!ENVIRONMENT
e.supd=true;e.deci=0
!VARIABLES - THIS PROGRAM
doit=0;qpluck="";haveone=0;name#=0;keepon="";checkdup=0;qcombo2=""
goodname=0;havename=0;coupluck=" ";accessio=" ";qcounty="";county#=0
courow#=8;coucol#=2;clearrow=0;plapluck="";gotplace="";spesub=0
pchoice=0;havit=0;checkrec=0;recok="";checkit=0
!VARIABLES - TRACOLL3.IPF
colday="";qmonth="";colmonth="";colyear="";colnum=""
xdoit=0;xqpluck="";haveone=0;xkeepon=""
goodname=0;haveit=0;xqchoice=0;newref#=0;tranref#=""
clearrow=0;xqchoic1=0;xstaname="";xlabname="";checkok=0
xstanam1="";xlabnam1="";xstanam2="";xlabnam2="";checkout=""
coldate="";colref="";xrow#=0;xname#=0
!FORMS
perform colform1 !FOR TRACOLL3
perform traform1 !FINAL RECORD CHECK
!ARRAYS - THIS PROGRAM
dim couprint(1,2) !THIS ONE HOLDS COUROW# AND COUCOL# - STAYS UNSORTED
dim coulist(1) !THIS ONE HOLDS FULL COUNTY NAME-'REGISTERED' WITH ABOVE
dim coumenu(3) !THIS ONE HOLDS THE MENU STRINGS FOR COUNTY/PLACE NAME
coumenu(1)=" County Name on Label "
coumenu(2)="  Check Place Name    "
coumenu(3)=" Quit County Listing  "
qchoice=0;row#=0
dim plamenu(2) !THIS ONE FOR ADDING RECORD TO PLACES TABLE [TXCENZI3.ITB]
plamenu(1)=" RE-ENTER 1ST 3 OF PLACE NAME "
plamenu(2)=" ADD A PLACE TO THE DATABASE "
!ARRAYS - TRACOLL3.IPF
dim colmenu1(2) !THIS ONE FOR ADDING RECORD WHEN NO CORRESPONDING STRING
colmenu1(1)="           SEARCH STRING NOT CORRECT - TRY AGAIN              "
colmenu1(2)=" SEARCH STRING CORRECT, NO NAME IN LOOK-UP TABLE - ENTER NAME "
dim colmenu2(3) !THIS ONE FOR DETERMINING TYPE OF NAME FOR LABEL
colmenu2(1)="      One      "
colmenu2(2)="      Two      "
colmenu2(3)=" Three or more "
dim amonth(2)
amonth(1)="   April    "
amonth(2)="   August   "
dim jmonth(3)
jmonth(1)=" January "
jmonth(2)="  July   "
jmonth(3)="  June   "
dim mmonth(2)
mmonth(1)=" March  "
mmonth(2)="  May   "
!START
while doit=0 do
 e.forg="WWWWG";default karpoa2
 @1,10?"Texas A&M Bioinformatics Working Group - Phase I Data Entry";e.forg="WWWWO"
 !GET A NAME FOR THE PLANT
 @3,1 input qpluck using "rrrrrrrr" with "Enter Genus [1st 3]/Species [1st 5] (Enter to quit): "
 if qpluck ne " " then !HAVE AN ENTRY FROM THE USER
  pluck qpluck
  if #found=true then;haveone=1;name#=1;else;haveone=0;endif
  if haveone=1 then !HAVE A MATCH
   qcombo2=combo2;startrec=currec(karpoa2)
   while checkdup=0 do
    obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
    if karpoa2.pluckstr=qpluck then
     name#=name#+1 !COUNTING DUPLICATES
    else
     checkdup=1
    endif
    if checkdup ne 0 then;break;endif
   endwhile
   !@5,2?qcombo2+" dups=",name#,", starting at: ",startrec - TEST LINE
   !endif-moved this down
   !NOW HAVE #OF DUPS [NAME#] AND POSITION OF 1ST MATCH [STARTREC]
   !REUSE CHECKDUP TO BUILD ARRAY TO BE USED FOR THE DATA TRANSFER [namarray]
   checkdup=0 !RESET
   obtain startrec !GO BACK TO START
   !SET UP ARRAYS FOR BOTH DATA TRANSFER AND SELECTION MENU  - ELEMENTS=
   !COMBO2,AUTHOR,CONCODE,NAMEID,TAXONID - SET TO LOCAL AFTER TESTING
   dim namarray(name#,5) !DATA TRANSFER
   dim menarray(name#+1) ! FOR THE MENU
   !SET ROW TRACKER [ROW#] AND FILL ARRAY FOR 1ST RECORD
   row#=1
   namarray(row#,1)=trim(combo2)
   namarray(row#,2)=trim(author)
   namarray(row#,3)=trim(concode)
   namarray(row#,4)=trim(nameid)
   namarray(row#,5)=trim(taxonid)
   menarray(row#)=trim(combo2)+" "+concode
   !FILL REST OF THE ARRAY
   while checkdup=0 do
    obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
    if karpoa2.pluckstr=qpluck then
     row#=row#+1 !ADVANCING ROW COUNT
     !ADD DATA FROM RECORD TO DATA TRANSFER ARRAY
     namarray(row#,1)=trim(combo2);namarray(row#,2)=trim(author);namarray(row#,3)=trim(concode)
     namarray(row#,4)=trim(nameid);namarray(row#,5)=trim(taxonid)
     !ADD DATA FROM RECORD TO MENU ARRAY
     menarray(row#)=trim(combo2)+" "+concode
    else
     checkdup=1
    endif
    if checkdup ne 0 then;break;endif
   endwhile
   !DATA ARRAY FULL, NOW FOR THE MENU ARRAY
   select#=0
   !ADD POINTER FOR LABEL NAME NOT PRESENT
   menarray(row#+1)="Label name NOT present in BONAP listing"
   !GRAB FROM BONAP OPTIONS USING MENARRAY
   select#=menu(menarray,1,name#+1,6,12,0,58,1,name#+1,-1,1,"CAACUARA","FDCP","Select Name",)
   !CONVERT TO NORMAL VARS FROM NAMARRAY USING SELECT# OR GO BACK TO PLUCKSTR
   if select# ne row#+1 then !HAVE A SELECTION
    @10,2?"Data taken as a result of this selection:"
    @12,2?namarray(select#,1)
    @13,2?namarray(select#,2)
    @14,2?namarray(select#,3)
    @15,2?namarray(select#,4)
    @16,2?namarray(select#,5)
    !CONFIRM NAME FROM USER
    e.forg="WWWWR";@18,2 input keepon using "u" with "Is this the label name? [n/Y]:  "
    if keepon ne "n" then
     havename=1
     qname=namarray(select#,1)
     qauthor=namarray(select#,2)
     qstat=namarray(select#,3)
     qnameid=namarray(select#,4)
     qtaxonid=namarray(select#,5)
    else
     e.forg="WWWWW"
     havename=0
     @5,2?"                                                         "
     @10,2?"                                                   "
     @12,2?"                                                 "
     @13,2?"                                                  "
     @14,2?"                                                  "
     @15,2?"                                                  "
     @16,2?"                                                    "
     @18,2?"                                                                   "
    endif
   else
    newname="";newauth=""
    !ALLOW HAND-CREATE A NEW RECORD AND ADD TO trapoa1.ITB
    @10,2?"Enter full label name, including infraspecific if present, as"
    @11,2?"present on the label, hit 'enter' and input the authority if this"
    @12,2?"is available from the label:"                                                     
    @14,2 input newname using "rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr" with "Name:  "
    @15,2 input newauth using "rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr" with "Author:  "
    @5,2?"                                                            "
    !CONVERT ENTERED DATA INTO USABLE FIELDS FOR TAESDATA AND trapoa1
    !HAVE NO WAY TO RE-ACCESS NEW NAMES-SHOULD SET UP A 2ND PLUCK ON
    !TRAPOA1 IF #FOUND=FALSE FROM PLUCK ON karpoa2
    qname=trim(newname)
    qauthor=trim(newauth)
    qstat="TX"
    qnameid="NEW_ITEM"
    qtaxonid="NEW_ITEM"
    newname="";newauth=""
    !ADD TO trapoa1
    default trapoa1
    e.lmod=false
    attach 1 !ATTACHING TO TRAPOA1.ITB - NO NAME IN KARPOA2.ITB
    author=qauthor
    combo2=qname
    !GET PLUCK STRING
    spesub=0;spesub=match(qname," ")+1
    pluckstr=substr(qname,1,3)+substr(qname,spesub,5)
    concode=qstat
    nameid=qnameid
    taxonid=qtaxonid
    qtime=time()
    qdate=today()
    default karpoa2
    !SET TO HAVE NAME
    havename=1
    !CLEAR FOR COUNTY SEARCH
    @5,2?"                                                                   "
    @10,2?"                                                                 "
    @11,2?"                                                                   "
    @12,2?"                                                                    "
    @13,2?"                                                                    "
    @14,2?"                                                                   "
    @15,2?"                                                                  "
    @16,2?"                                                                  "
    @18,2?"                                                                    "
   endif
   !+++++++++++++++++END OF NAME GRABBING - LINE 167 - TO COUNTY
   !------HAVE A NAME, NOW FOR THE COUNTIES AND ACCESSIONS----
   !DATA TAKEN TO 'TAESDATA.ITB' IN THE WHILE LOOP THAT FOLLOWS
   if havename=1 then
    !CLEAR SCREEN
    @10,2?"                                          "
    @12,2?"                                                 "
    @13,2?"                                                  "
    @14,2?"                                                  "
    @15,2?"                                                  "
    @16,2?"                                                    "
    @18,2?"                                                                   "
    !GET COUNTY FOR EACH RECORD CARRYING CURRENT NAME
    @5,2?"                                                                     "
    @3,1?"                                                              "
    e.forg="WWWWG";@3,1?"Getting county sequence for: ";e.forg="WWWWC"
    @5,5?qname+" "+qauthor
    !WILL ADD ONE RECORD PER COUNTY IN THIS LOOP
    getcount=0;checkdup=0;qpluck="";name#=0;county#=0
    while getcount=0 do !TEMPTED TO BUILD ANOTHER PROGRAM, BUT...
     !e.forg="WWWWR";@2,17?"Hit 'Enter' when county listing is completed";e.forg="WWWWO"
     !INSERT COUNTY/PLACE SELECTION MENU - COUMENU - HERE
     e.forg="WWWOO";e.bacg="UUUAA";qchoice=0
     @7,1?"                                                                            "
     test menu (coumenu,1,3,7,5,0,25,3)
      CASE 1: qchoice=1;break
      CASE 2: qchoice=2;break     
      CASE 3: qchoice=3;break
      OTHERWISE:  clear;@10,2?"SOMETHING IS AMISS - CALL WILSON";break
     endtest
     e.forg="WWWWW";e.bacg="UUUUA"
     !THREE CHOICES CONTROL 3 IF STATEMENTS THAT FOLLOW
     !QCHOICE=1 - GRAB COUNTY WHICH IS ON LABEL
     IF QCHOICE=1 THEN !COUNTY LISTED ON THE LABEL - MOST COMMON-TO 357
      @7,1?"                                                                            "
      default tracount;e.forg="WWWWO"
      @7,2 input coupluck using "rr" with "Enter 1st 2 of County name: "
      !REPEATING NAME GRABBING ROUTINE FOR USE WITH COUNTIES
      if coupluck ne " " then !HAVE AN ENTRY FROM THE USER
       pluck coupluck
       if #found=true then;haveone=1;name#=1;else;haveone=0;endif
       if haveone=1 then !HAVE A MATCH
        qUTcode=tracount.code;startrec=currec(tracount)
        while checkdup=0 do
         obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
         if pastend(tracount)=true then;break;endif
         if tracount.check1=coupluck then
          name#=name#+1 !COUNTING DUPLICATES
         else
          checkdup=1
         endif
         if checkdup ne 0 then;break;endif
        endwhile
        !NOW HAVE #OF DUPS [NAME#] AND POSITION OF 1ST MATCH [STARTREC]
        !REUSE CHECKDUP TO BUILD ARRAY TO BE USED FOR THE DATA TRANSFER [namarray]
        checkdup=0 !RESET
        obtain startrec !GO BACK TO START
        !SET UP ARRAYS FOR BOTH DATA TRANSFER AND SELECTION MENU  - ELEMENTS=
        !FULLNAME,CODE - SET TO LOCAL AFTER TESTING
        release namarray;release menarray !CLEARING FROM PRIOR [NAME] USE
        dim namarray(name#,2) !DATA TRANSFER 
        dim menarray(name#+1) ! FOR THE MENU + 1 for inserted statement
        !SET ROW TRACKER [ROW#] AND FILL ARRAY FOR 1ST RECORD
        row#=1 !!!check
        namarray(row#,1)=trim(fullname)
        namarray(row#,2)=trim(code)
        menarray(row#)=trim(fullname)
        !FILL REST OF THE ARRAY
        while checkdup=0 do
         obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
         if pastend(tracount)=true then;break;endif
         if tracount.check1=coupluck then
          row#=row#+1 !ADVANCING ROW COUNT
          !ADD DATA FROM RECORD TO DATA TRANSFER ARRAY
          namarray(row#,1)=trim(fullname);namarray(row#,2)=trim(code)
          !ADD DATA FROM RECORD TO MENU ARRAY
          menarray(row#)=trim(fullname)
         else
          checkdup=1
         endif
         if checkdup ne 0 then;break;endif
        endwhile
        !DATA ARRAY FULL, NOW FOR THE MENU ARRAY
        select#=0
        !ADD POINTER FOR TO TRY AGAIN
        menarray(row#+1)="TRY AGAIN"
        !GRAB FROM COUNTY OPTIONS USING MENARRAY
        select#=menu(menarray,1,name#+1,8,65,0,15,1,name#+1,-1,1,"CAACUARA","FDCP","Select Name",)
        !CONVERT TO NORMAL VARS FROM NAMARRAY USING SELECT# OR GO BACK TO PLUCKSTR
        if select# ne row#+1 then !HAVE A SELECTION
         e.forg="WWWWO";@23 ,2?"County Name:  ",namarray(select#,1)
         !CONFIRM NAME FROM USER
         e.forg="WWWWR";@23,29 input keepon using "u" with "Is this ok? [n/Y]:  "
         e.forg="WWWWO"
         if keepon ne "n" then !READY TO ADD FULL RECORD TO TAESDATA
          havename=1
          qutcode=namarray(select#,2)
          qcounty=trim(menarray(select#))
          !@18,2?"Adding record:"
          !@19,2?qname+" "+qauthor+" ("+qstat+")"
          !@20,2?"Nameid: "+qnameid+"  Taxonid: "+qtaxonid
          !@21,2?"From: "+qutcode+" ("+qcounty+" County)"
          !GET ACCESSION NUMBER
          @24,2 input accessio using "rrrrrrrrrr" with "Enter accession number as indicated (leading 0s) on the sheet:"
          e.forg="WWWWW"
          @22,2?"                                                                       "
          @23,2?"                                                                       "
          @24,2?"                                                                          "
          !MOVE TO TRACOLL3.IPF TO GET COLLECTOR/DATE INFO
          perform tracoll4 !ADDED 5/6/96/REVISED 25/796 - ADDING NEW FIELDS TO
          !TAES DATA - COLNAME STR 80/COLREF STR12/COLNUM STR 12/COLDATE STR 11
          !DUMP NEW RECORD TO TAESDATA-COUNTY ON LABEL
          default taesdata;e.lmod=false
          attach 1;checkrec=currec(taesdata)
          combo2=qname
          author=qauthor
          concode=qstat
          nameid=qnameid
          taxonid=qtaxonid
          acnumber=accessio
          qdate=today()
          qtime=time()
          couname=qcounty
          coucode=qutcode
          taesdata.colname=colname
          taesdata.colnum=colnum
          taesdata.colref=colref
          taesdata.coldate=coldate
          !CHECK THE FULL RECORD-BUT FORM ONLY ALLOWS SOME EDITS
          while checkit=0 do
           clear;browse range checkrec,checkrec with traform1
           @24,2 input recok using "u" with "Is this record ok? [N/y]: "
           if recok ="y" then;checkit=1;endif
           if checkit=1 then;break;checkit=0;endif
          endwhile
          clear
          !RESET VARIABLES
          row#=0;havename=0;checkdup=0;default tracount;coupluck=" "
          !DUMP COUNTY NAME COULIST AND PRINT COORDINATES TO COUPRINT
          !ADVANCE COUNTERS
          county#=county#+1;courow#=courow#+1
          !24/6/96 - DO A FULL RESET WHEN COUNTY# GT 84
          if county# gt 84 then
           county#=1;courow#=8;coucol#=2
           arrsize(couprint,county#,2)
           arrsize(coulist,county#,1)
          endif
          !ADJUST PRINT ROW AND COLUMN BY COUNTY#
          if courow# gt 22 then;courow#=9;coucol#=coucol#+14;endif
          !SET ARRAY SIZE UPWARD AND SORT
          if county# gt 1 then
           arrsize(couprint,county#,2)
           arrsize(coulist,county#,1)
          endif
          !FILL TRACKING/PRINTING ARRAY
          coulist(county#,1)=qcounty
          couprint(county#,1)=courow#
          couprint(county#,2)=coucol#
          !SORT THE ARRAY BY COUNTY NAME
          if county# gt 1 then
           arrsort(coulist,1) !SORTING COUNTY NAME - PRINT ROW STAYS CONSTANT
          endif
          !CLEAR PORTION OF SCREEN OCCUPIED BY PRIOR COUNTY LISTING
          trackit=0;clearrow=1
          while trackit=0 do
             @couprint(clearrow,1)?"                                                                         "
             clearrow=clearrow+1
             if clearrow gt county# then;break;endif
          endwhile
          !PRINT ARRAY AS TRACKER PRIOR TO ASKING FOR ANOTHER COUNTY
          trackit=0;printrow=1;e.forg="WWWWC"
          while trackit=0 do
           @couprint(printrow,1),couprint(printrow,2)?coulist(printrow)
           printrow=printrow+1
           if printrow gt county# then;break;endif
          endwhile
          e.forg="WWWWW"
          !RESET FOR NEXT COUNTY GRAB
          accessio=" "
         else
          e.forg="WWWWW"
          havename=0;row#=0;checkdup=0
          @10,2?"                                                      "
          @12,2?"                                                         "
          @13,2?"                                                         "
          @15,2?"                                                            "
          @23,2?"                                                                        "
         endif
        else
         !NEED WORK HERE TO ALLOW A RE-TRY AND THEN ALLOW HAND-CREATE A NEW RECORD
         @22,2?"Will have give it another try - HIT ANY KEY";e.forg="WWWWW";wait
         @22,2?"                                                     "
         row#=0;havename=0;checkdup=0
        endif
        !END OF REPEAT FOR COUNTY
       else
        e.forg="WWWWR"
        @23,1?"No Texas County with a 1st 2 of: ",coupluck
        @24,1?"Hit any key to continue";wait
        @23,1?"                                                          "
        @24,1?"                                                          "
       endif !haveone=1
      ENDIF
      row#=0;havename=0;checkdup=0 !TRYING RESETS TO GET ARRAYS RIGHT 
     ENDIF !END OF COUNTY ON LABEL - QCHOICE=1
     IF QCHOICE=2 THEN !CHECKING LOCATION/COUNTY
      @7,1?"                                                                            "
      default txcenzi3;e.forg="WWWWO"
      @7,2 input plapluck using "rrr" with "Enter 1st 3 of Place name: "
      !REPEATING NAME GRABBING ROUTINE FOR USE WITH COUNTIES
      if plapluck ne " " then !HAVE AN ENTRY FROM THE USER
       pluck plapluck
       if #found=true then;haveone=1;name#=1;else;haveone=0;endif
       if haveone=1 then !HAVE A MATCH
        qplace=txcenzi3.place;startrec=currec(txcenzi3)
        while checkdup=0 do
         obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
         if pastend(txcenzi3)=true then;break;endif
         if txcenzi3.pluckstr=plapluck then
          name#=name#+1 !COUNTING DUPLICATES
         else
          checkdup=1
         endif
         if checkdup ne 0 then;break;endif
        endwhile
        !NOW HAVE #OF DUPS [NAME#] AND POSITION OF 1ST MATCH [STARTREC]
        !REUSE CHECKDUP TO BUILD ARRAY TO BE USED FOR THE DATA TRANSFER [namarray]
        checkdup=0 !RESET
        obtain startrec physical !GO BACK TO START-'physical' needed for indexed
        !SET UP ARRAYS FOR BOTH DATA TRANSFER AND SELECTION MENU  - ELEMENTS=
        !FULLNAME,CODE - SET TO LOCAL AFTER TESTING
        release namarray;release menarray
        dim namarray(name#,2) !DATA TRANSFER
        dim menarray(name#+1) ! FOR THE MENU
        !SET ROW TRACKER [ROW#] AND FILL ARRAY FOR 1ST RECORD
        row#=1
        namarray(row#,1)=trim(county)
        namarray(row#,2)=trim(utcode)
        menarray(row#)=trim(place)+": "+county
        !FILL REST OF THE ARRAY
        while checkdup=0 do
         obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
         if pastend(txcenzi3)=true then;break;endif
         if txcenzi3.pluckstr=plapluck then
          row#=row#+1 !ADVANCING ROW COUNT
          !ADD DATA FROM RECORD TO DATA TRANSFER ARRAY
          namarray(row#,1)=trim(county);namarray(row#,2)=trim(utcode)
          !ADD DATA FROM RECORD TO MENU ARRAY
          menarray(row#)=trim(place)+": "+county
         else
          checkdup=1
         endif
         if checkdup ne 0 then;break;endif
        endwhile
        !DATA ARRAY FULL, NOW FOR THE MENU ARRAY
        select#=0
        !ADD POINTER FOR TO TRY AGAIN
        menarray(row#+1)=" TRY AGAIN/ADD  "
        !GRAB FROM COUNTY OPTIONS USING MENARRAY
        select#=menu(menarray,1,name#+1,4,50,0,25,1,name#+1,-1,1,"CAACUARA","FDCP","Select Name",)
        !CONVERT TO NORMAL VARS FROM NAMARRAY USING SELECT# OR GO BACK TO PLUCKSTR
        if select# ne row#+1 then !HAVE A SELECTION
         e.forg="WWWWO";@23 ,2?"County Name:  ",namarray(select#,1)
         !CONFIRM NAME FROM USER
         e.forg="WWWWR";@23,29 input keepon using "u" with "Is this ok? [n/Y]:  "
         e.forg="WWWWO"
         if keepon ne "n" then !READY TO ADD FULL RECORD TO TAESDATA
          havename=1
          qutcode=namarray(select#,2)
          qcounty=trim(namarray(select#,1))
          !@18,2?"Adding record:"
          !@19,2?qname+" "+qauthor+" ("+qstat+")"
          !@20,2?"Nameid: "+qnameid+"  Taxonid: "+qtaxonid
          !@21,2?"From: "+qutcode+" ("+qcounty+" County)"
          !GET ACCESSION NUMBER
          @24,2 input accessio using "rrrrrrrrrr" with "Enter accession number as indicated (leading 0s) on the sheet:"
          e.forg="WWWWW"
          @22,2?"                                                                       "
          @23,2?"                                                                       "
          @24,2?"                                                                          "
          !MOVE TO TRACOLL3.IPF TO GET COLLECTOR/DATE INFO
          perform tracoll3 !ADDED 5/6/98 - ADDING NEW FIELDS TO
          !TAES DATA - COLNAME STR 80/COLREF STR12/COLNUM STR 12/COLDATE STR 11
          !DUMP NEW RECORD TO TAESDATA
          default taesdata;e.lmod=false
          attach 1;checkrec=currec(taesdata)
          combo2=qname
          author=qauthor
          concode=qstat
          nameid=qnameid
          taxonid=qtaxonid
          acnumber=accessio
          qdate=today()
          qtime=time()
          couname=qcounty
          coucode=qutcode
          taesdata.colname=colname
          taesdata.colnum=colnum
          taesdata.colref=colref
          taesdata.coldate=coldate
          !CHECK THE FULL RECORD-BUT FORM ONLY ALLOWS SOME EDITS
          while checkit=0 do
           clear;browse range checkrec,checkrec with traform1
           @24,2 input recok using "u" with "Is this record ok? [N/y]: "
           if recok ="y" then;checkit=1;endif
           if checkit=1 then;break;checkit=0;endif
          endwhile
          clear
          !RESET VARIABLES
          row#=0;havename=0;checkdup=0;default txcenzi3;plapluck=" "
          !DUMP COUNTY NAME COULIST AND PRINT COORDINATES TO COUPRINT
          !ADVANCE COUNTERS
          county#=county#+1;courow#=courow#+1
          if courow# gt 22 then;courow#=9;coucol#=coucol#+14;endif
          !SET ARRAY SIZE UPWARD AND SORT
          if county# gt 1 then
           arrsize(couprint,county#,2)
           arrsize(coulist,county#,1)
          endif
          !FILL TRACKING/PRINTING ARRAY
          coulist(county#,1)=qcounty
          couprint(county#,1)=courow#
          couprint(county#,2)=coucol#
          !HALT THINGS IF # OF COUNTIES FOR A TAXON EXCEEDS 100
          if county# gt 99 then;beep();clear;@10,2?"BIG PROBLEM - CALL WILSON!!";WAIT;endif
          !SORT THE ARRAY BY COUNTY NAME
          if county# gt 1 then
           arrsort(coulist,1) !SORTING COUNTY NAME - PRINT ROW STAYS CONSTANT
          endif
          !CLEAR PORTION OF SCREEN OCCUPIED BY PRIOR COUNTY LISTING
          trackit=0;clearrow=1
          while trackit=0 do
             @couprint(clearrow,1)?"                                                                         "
             clearrow=clearrow+1
             if clearrow gt county# then;break;endif
          endwhile
          !PRINT ARRAY AS TRACKER PRIOR TO ASKING FOR ANOTHER COUNTY
          trackit=0;printrow=1;e.forg="WWWWC"
          while trackit=0 do
           @couprint(printrow,1),couprint(printrow,2)?coulist(printrow)
           printrow=printrow+1
           if printrow gt county# then;break;endif
          endwhile
          e.forg="WWWWW"
          !RESET FOR NEXT COUNTY GRAB
          accessio=" "
         else
          e.forg="WWWWW"
          havename=0;row#=0;checkdup=0
          @10,2?"                                                      "
          @12,2?"                                                         "
          @13,2?"                                                         "
          @15,2?"                                                            "
          @23,2?"                                                                        "
         endif
        else
         !BRING IN PLAMENU FOR RECORD CREATION AND MAYBE BROWSING/EDITING LATER
         e.forg="WWWOO";e.bacg="UUUAA";qchoice=0
         test menu(plamenu,1,2,22,8,0,35,2)
          CASE 1: pchoice=1;break
          CASE 2: pchoice=2;break
         endtest
         @22,2?"                                                                         "
         if pchoice=1 then
          row#=0;havename=0;checkdup=0 !stop
         endif
         if pchoice=2 then
          newname="";newauth=""
          !ALLOW HAND-CREATE A NEW RECORD AND ADD TO TXCENZI3.ITB
          @21,2?"Enter place name from label data, hit 'enter' and add - after"
          @22,2?"checking a map - the home county of this place (town, feature, etc.)"
          havit=0;e.forg="WWWWC"
          while havit=0 do !stop
           @23,2 input newname using "rrrrrrrrrrrrrrrrrrrrrrr" with "Place:  "
           @24,2 input newauth using "rrrrrrrrrrrrr" with "County:  "
           e.forg="WWWWO"
           @21,2?"                                                                     "
           @22,2?"                                                                     "
           @23,2?"                                                                     "
           @24,2?"                                                                     "
           @23,2?"Have the new place name as: ",newname
           @24,2?"and the county name as: ",newauth
           e.forg="WWWWR";@24,42 input gotplace using "u" with "Is this ok [n/Y]?: "
           if gotplace ne "n" then
             default tracount
             obtain for fullname=newauth
             if #found=true then
              qcounty=trim(fullname)
              qutcode=code
              havit=1
             else
              @21,2?"                                                                   "
              @22,2?"                                                                   "
              @23,2?"                                                                   "
              @24,2?"                                                                   "
              @23,2?"Can't find this county : ",newauth
              @24,2?"in the database - hit any key to re-type";wait
              @23,2?"                                                                   "
              @24,2?"                                                                   "
             endif
           else
            @21,2?"                                                                    "
            @22,2?"                                                                    "
            @23,2?"                                                                    "
            @24,2?"                                                                    "
           endif
           if havit=1 then;break;endif
          endwhile
          !CONVERT ENTERED DATA INTO USABLE FIELDS FOR TAESDATA AND TXCENZI3
          if gotplace ne "n" then
           !TAKE CARE OF ADDING TO TXCENZI3
           qplace=trim(newname)
           newname="";newauth=""
           !ADD TO TXCENZI3
           default txcenzi3
           e.lmod=false
           attach 1
           !NOT SURE WHAT HAPPENS WITH ATTACH/INDEXING BUT A PLUCK ON THE
           !EMPTY RECORD MAKES IT CURRENT AND NEW FIELD VALUES WILL GO TO IT
           pluck "   "
           txcenzi3.place=qplace
           txcenzi3.county=qcounty
           txcenzi3.utcode=qutcode
           txcenzi3.pluckstr=substr(qplace,1,3)
           !NOW FOR INSERTING INTO TAESDATA AND TRACKING
           !===============
           @21,2?"                                                                     "
           @22,2?"                                                                     "
           @23,2?"                                                                     "
           @24,2?"                                                                     "
           e.forg="WWWWO"
           if keepon ne "n" then !READY TO ADD FULL RECORD TO TAESDATA
            havename=1
            !GET ACCESSION NUMBER
            @24,2 input accessio using "rrrrrrrrrr" with "Enter accession number as indicated (leading 0s) on the sheet:"
            e.forg="WWWWW"
            @22,2?"                                                                       "
            @23,2?"                                                                       "
            @24,2?"                                                                          "
            !DUMP NEW RECORD TO TAESDATA-COUNTY ON LABEL
            default taesdata;e.lmod=false
            attach 1;checkrec=currec(taesdata)
            combo2=qname
            author=qauthor
            concode=qstat
            nameid=qnameid
            taxonid=qtaxonid
            acnumber=accessio
            qdate=today()
            qtime=time()
            couname=qcounty
            coucode=qutcode
            taesdata.colname=colname
            taesdata.colnum=colnum
            taesdata.colref=colref
            taesdata.coldate=coldate
            !CHECK THE FULL RECORD-BUT FORM ONLY ALLOWS SOME EDITS  
            while checkit=0 do
             clear;browse range checkrec,checkrec with traform1
             @24,2 input recok using "u" with "Is this record ok? [N/y]: "
             if recok ="y" then;checkit=1;endif
             if checkit=1 then;break;checkit=0;endif
            endwhile
            clear
            !RESET VARIABLES
            row#=0;havename=0;checkdup=0;default txcenzi3;plapluck=" "
            !DUMP COUNTY NAME COULIST AND PRINT COORDINATES TO COUPRINT
            !ADVANCE COUNTERS
            county#=county#+1;courow#=courow#+1
            if courow# gt 22 then;courow#=9;coucol#=coucol#+14;endif
            !SET ARRAY SIZE UPWARD AND SORT
            if county# gt 1 then
             arrsize(couprint,county#,2)
             arrsize(coulist,county#,1)
            endif
            !FILL TRACKING/PRINTING ARRAY
            coulist(county#,1)=qcounty
            couprint(county#,1)=courow#
            couprint(county#,2)=coucol#
            !HALT THINGS IF # OF COUNTIES FOR A TAXON EXCEEDS 100
            if county# gt 99 then;beep();clear;@10,2?"BIG PROBLEM - CALL WILSON!!";WAIT;endif
            !SORT THE ARRAY BY COUNTY NAME
            if county# gt 1 then
             arrsort(coulist,1) !SORTING COUNTY NAME - PRINT ROW STAYS CONSTANT
            endif
            !CLEAR PORTION OF SCREEN OCCUPIED BY PRIOR COUNTY LISTING
            trackit=0;clearrow=1
            while trackit=0 do
             @couprint(clearrow,1)?"                                                                         "
             clearrow=clearrow+1
             if clearrow gt county# then;break;endif
            endwhile
            !PRINT ARRAY AS TRACKER PRIOR TO ASKING FOR ANOTHER COUNTY
            trackit=0;printrow=1;e.forg="WWWWC"
            while trackit=0 do
             @couprint(printrow,1),couprint(printrow,2)?coulist(printrow)
             printrow=printrow+1
             if printrow gt county# then;break;endif
            endwhile
            e.forg="WWWWW"
            !RESET FOR NEXT COUNTY GRAB
            accessio=" "
           else
            e.forg="WWWWW"
            havename=0;row#=0;checkdup=0
            @10,2?"                                                      "
            @12,2?"                                                         "
            @13,2?"                                                         "
            @15,2?"                                                            "
            @23,2?"                                                                        "
           endif
          !else
          !===============
          endif
         endif 
        endif
        !END OF REPEAT FOR COUNTY
       else
        e.forg="WWWWR"
        @23,1?"Nothing in 'place' database with with a 1st 3 of: ",plapluck
        e.forg="WWWWO"
        @24,1?"Hit any key to continue - can use 'try again/add' to add data";wait
        @23,1?"                                                               "
        @24,1?"                                                                "
       endif !haveone=1
      ENDIF
      row#=0;havename=0;checkdup=0 !TRYING RESETS TO GET ARRAYS RIGHT 
     ENDIF !END OF TXCENZI3.ITB CHECK - QCHOICE=2
     IF QCHOICE=3 THEN
      e.forg="WWWWR";@24,1 input keepcou using "u" with "Continue with County addition? [n/Y]: "
      @24,1?"                                                               "
      e.forg="WWWWW"
      if keepcou = "n" then
        getcount=1
      endif
      row#=0;havename=0;checkdup=0 !TRYING RESETS TO GET ARRAYS RIGHT 
     endif
     if getcount ne 0 then;courow#=8;coucol#=2;break;endif
     name#=0;row#=0;checkdup=0;startrec=0
    endwhile !getcount-END OF GET COUNTY LOOP - NEED TO DO SO RESETTING HERE
   endif
  endif
 endif !END OF PLANT NAME GOOD PLUCK
 if qpluck ne " " and haveone=0 then !NO MATCH - ERROR OR NEW NAME
  e.forg="WWWWC"
  @10,2?"No name in database with string combination of :",qpluck
  @12,2?"Hit any key to re-type";e.forg="WWWWW";wait
  @10,2?"                                                               "
  @12,2?"                                                               "
 endif
 if qpluck=" " then !NO ENTRY - ERROR OR READY TO LEAVE
  e.forg="WWWWR";@22,40 input keepon using "u" with "Continue with taxon entry [n/Y]?:  "
  e.forg="WWWWW"
  if keepon="n" then
   doit=1
  else
   clear
  endif
 endif
 !BREAK OUT OF MAIN LOOP
 if doit ne 0 then;break;endif
 !CLEAR INPUT LINE
 @10,2?"                                                                  "
 !RESET VARIABLES
 qpluck=" ";haveone=0;name#=0;checkdup=0;qcombo2="";startrec=0;goodname=0
 havename=0;keepon="";coupluck=" ";select#=0;accessio="";row#=0;checkit=0
endwhile
!OUT
clear
e.supd=false;e.forg="WWWWW";e.deci=1
!RELEASE - THIS PROGRAM
release doit,qpluck,haveone,checkdup,qcombo2,startrec,goodname,coupluck
release namarray,menarray,keepon,havename,name#,qcombo2,qnameid,qtaxonid
release select#,row#,accessio,qcounty,county#,courow#,coucol#,couprint,getcount
release keepcou,newauth,newname,printrow,qauthor,qname,qstat,qutcode,utcode,trackit
release coulist,clearrow,coumenu,qchoice,plapluck,plamenu,qplace,pchoice,havit
release gotplace,spesub,checkrec,recok,checkit,browsrec
!RELEASE - TRACOLL3.IPF
release xdoit,xqpluck,haveone,checkdup,qcombo2,beginrec,goodname
release usename,shoname,xkeepon,haveit,name#
release select#,row#,getcount,xqchoic1,colnum
release keepcou,newauth,newname,printrow,qauthor,qname,qstat,qutcode,utcode,trackit
release clearrow,xqchoice,colmenu1,newref#,tranref#,checkout
release xstanam1,xlabnam1,xstanam2,xlabnam2,xstaname,xlabname,checkok
release qlname1,qmiddle1,qfname1,qlname2,qmiddle2,qfname2,qsource,colref
release colday,qmonth,colmonth,colyear,colnum,colname,coldate
release amonth,jmonth,mmonth,colmenu2,xrow#,xname#
finish all;release form
clear;return