!TRACOLL4.IPF - mod of TRACOLL3.IPF to use TWO lookup tables - 1st for
!local names and huhname1 if not found - also will not ADD to huhname1 - will
!only function as lookup and all new records will go to TRANAME1.ITB which
!was established 24/7/96 by converting all substr(huhref#,1,4)='taes' and
!then deleting these from huhname1 - working version done 25/7/96
clear
!TABLES [BROUGHT IN TRACYIN4.IPF
default traname1
/* - BLOCKED 25/7/96 - THIS PROGRAM NOW REFERENCED BY TRACYIN4
!FOR USE IN TESTING - ==================== BLOCK FOR USE
finish all
use huhname1 with huhpluck;use collrefs !FOR TRACOLL4.IPF
use traname1 with tranamep !FOR TRACOLL4.IPF
!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
!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   "

!END OF INSERTION FROM TRACYIN4================TRIM OUT FOR FINAL
*/
!FORMS - COLFORM1.IPF LOADED IN TRACYIN4.IPF
!ENVIRONMENT
e.supd=true;e.deci=0;e.lmod=false
!RESET VARIABLES FOR SURE [THESE DEFINED IN TRACYIN4
xdoit=0;xqpluck="";haveone=0;xkeepon="";checkdup=0
goodname=0;haveit=0;xqchoice=0;newref#=0;tranref#="";colref=""
clearrow=0;xqchoic1=0;xstaname="";xlabname="";checkok=0
xstanam1="";xlabnam1="";xstanam2="";xlabnam2="";checkout=""
colday="";qmonth="";colmonth="";colyear="";colnum="";coldate=""
!SAVING VARS THAT MIGHT BE FUNCTIONAL IN TRACYIN4 -RESET ON OUT 
xrow#=row#;xname#=name#;name#=0
row#=0
!START
while xdoit=0 do
 e.forg="WWWWG";clear;default traname1
 @1,1 input xqpluck using "rrrr" with "Enter 1st 4 letters of collector's last name (Enter to quit): "
 if xqpluck ne " " then !HAVE AN ENTRY FROM THE USER
  pluck xqpluck
  if #found=true then;haveone=1;name#=1;else;haveone=0;endif
  if haveone=1 then !HAVE A MATCH
   beginrec=currec(traname1)
   while checkdup=0 do
    obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
    if pastend(traname1)=true then;checkdup=1;endif !26/6/96 ENDLESS LOOP FIX
    if checkdup ne 0 then;break;endif
    if traname1.plucker=xqpluck then
     name#=name#+1 !COUNTING DUPLICATES
    else
     checkdup=1
    endif
    if checkdup ne 0 then;break;endif
   endwhile
   checkdup=0 !RESET
   !obtain beginrec block for now, using pluck again GO BACK TO START
   pluck xqpluck
   !SET UP ARRAYS FOR BOTH DATA TRANSFER AND SELECTION MENU  - ELEMENTS=
   !COMBO2,AUTHOR,CONCODE,NAMEID,TAXONID - SET TO LOCAL AFTER TESTING
   dim usename(name#,4) !DATA TRANSFER CAN EXPAND LATER FOR MORE FIELDS
   !NOW TAKING STANAME AND HUHREF# BUT KEEPING LABNAME/dates ON HAND - THUS 4
   dim shoname(name#+1) ! FOR THE MENU
   !SET ROW TRACKER [ROW#] AND FILL ARRAY FOR 1ST RECORD
   row#=1
   usename(row#,1)=trim(staname)
   usename(row#,2)=trim(labname)
   usename(row#,3)=trim(huhref#)
   usename(row#,4)=trim(dates)
   shoname(row#,1)=trim(STANAME)+" ("+trim(labname)+") - "+trim(dates)
   !shoname(row#,2)=trim(LABNAME)
   !FILL REST OF THE ARRAY
   while checkdup=0 do
    obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
    if pastend(traname1)=true then;checkdup=1;endif !26/6/96 ENDLESS LOOP FIX
    if checkdup ne 0 then;break;endif
    if traname1.plucker=xqpluck then
     row#=row#+1 !ADVANCING ROW COUNT
     !ADD DATA FROM RECORD TO DATA TRANSFER ARRAY
     usename(row#,1)=trim(STANAME)
     usename(row#,2)=trim(labname)
     usename(row#,3)=trim(huhref#)
     usename(row#,4)=trim(dates)
     !ADD DATA FROM RECORD TO MENU ARRAY
     shoname(row#,1)=trim(STANAME)+" ("+trim(labname)+") - "+trim(dates)
    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
   shoname(row#+1)="END OF LOCAL LIST - SELECT HERE IF LABEL COLLECTOR NAME NOT LISTED ABOVE"
   !GRAB FROM BONAP OPTIONS USING shoname
   select#=menu(shoname,1,name#+1,3,3,0,75,1,22,-1,1,"CAACUARA","FDCP","Select Name - (mouse/arrow) add..........name (LAST LINE) if not present",)
   !CONVERT TO NORMAL VARS FROM usename 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:";e.forg="WWWWO"
    @12,2?"Standard Name:  ",usename(select#,1)
    @13,2?"Label Name:  ",usename(select#,2)
    @14,2?"HUH reference#:  ",usename(select#,3)
    @15,2?"Relevant dates:  ",usename(select#,4)
    !CONFIRM NAME FROM USER
    e.forg="WWWWR";@18,2 input xkeepon using "u" with "Is this the label name? [n/Y]:  "
    if xkeepon ne "n" then
     haveit=1
     !VARIABLES TAKEN TO TRACYIN4
     colname=trim(usename(select#,1))
     colref=trim(usename(select#,3))
    else
     e.forg="WWWWW"
     haveit=0
     @5,2?"                                                         "
     @10,2?"                                                   "
     @12,2?"                                                 "
     @13,2?"                                                  "
     @14,2?"                                                  "
     @15,2?"                                                  "
     @16,2?"                                                    "
     @18,2?"                                                                   "
    endif
   else
    haveone=0;xqchoice=2 !25/7/96 - DELETE XQPLUCK MOD
   endif
  endif
 endif
 !END OF LOCAL COLLECTOR NAME CHECK - TO HUHNAME1 IF NOT FOUND
 if xqpluck  ne " " and haveone=0 and haveit=0 then !NO MATCH - ERROR OR NEW NAME
  clear;@10,2?"Checking national collector name listing for:  ",xqpluck
  default huhname1;sleep(2)
  @10,2?"                                                                "
  xrow#=row#;xname#=name#;name#=0;row#=0;checkdup=0
  !PAD SHORT INPUT STRINGS TO HELP MATCH HUHNAME1.ITB PLUCKER
  if len(xqpluck)=2 then;xqpluck=xqpluck+", ";endif
  if len(xqpluck)=3 then;xqpluck=xqpluck+",";endif
  !ADJUSTMENTS BASED ON CHECKS
  if xqpluck="san," then;xqpluck="san ";endif
  if xqpluck="van," then;xqpluck="van ";endif
  if xqpluck="st.," then;xqpluck="st. ";endif
  if xqpluck ne " " then !HAVE AN ENTRY FROM THE USER
   pluck xqpluck
   if #found=true then;haveone=1;name#=1;else;haveone=0;endif
   if haveone=1 then !HAVE A MATCH
    beginrec=currec(huhname1)
    while checkdup=0 do
     obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
     if pastend(huhname1)=true then;checkdup=1;endif !26/6/96 ENDLESS LOOP FIX
     if checkdup ne 0 then;break;endif
     if huhname1.plucker=xqpluck then
      name#=name#+1 !COUNTING DUPLICATES
     else
      checkdup=1
     endif
     if checkdup ne 0 then;break;endif
    endwhile
    checkdup=0 !RESET
    !obtain beginrec block for now, using pluck again GO BACK TO START
    pluck xqpluck
    !SET UP ARRAYS FOR BOTH DATA TRANSFER AND SELECTION MENU  - ELEMENTS=
    !COMBO2,AUTHOR,CONCODE,NAMEID,TAXONID - SET TO LOCAL AFTER TESTING
    RELEASE USENAME;dim usename(name#,4) !DATA TRANSFER CAN EXPAND LATER FOR MORE FIELDS
    !NOW TAKING STANAME AND HUHREF# BUT KEEPING LABNAME/dates ON HAND - THUS 4
    dim shoname(name#+1) ! FOR THE MENU
    !SET ROW TRACKER [ROW#] AND FILL ARRAY FOR 1ST RECORD
    row#=1
    usename(row#,1)=trim(staname)
    usename(row#,2)=trim(labname)
    usename(row#,3)=trim(huhref#)
    usename(row#,4)=trim(dates)
    shoname(row#,1)=trim(STANAME)+" ("+trim(labname)+") - "+trim(dates)
    !shoname(row#,2)=trim(LABNAME)
    !FILL REST OF THE ARRAY
    while checkdup=0 do
     obtain next !CHECKING FOR DUPLICATES OF PLUCK STRING
     if pastend(huhname1)=true then;checkdup=1;endif !26/6/96 ENDLESS LOOP FIX
     if checkdup ne 0 then;break;endif
     if huhname1.plucker=xqpluck then
      row#=row#+1 !ADVANCING ROW COUNT
      !ADD DATA FROM RECORD TO DATA TRANSFER ARRAY
      usename(row#,1)=trim(STANAME)
      usename(row#,2)=trim(labname)
      usename(row#,3)=trim(huhref#)
      usename(row#,4)=trim(dates)
      !ADD DATA FROM RECORD TO MENU ARRAY
      shoname(row#,1)=trim(STANAME)+" ("+trim(labname)+") - "+trim(dates)
     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
    shoname(row#+1)="END OF LIST - SELECT HERE IF LABEL COLLECTOR NAME NOT LISTED ABOVE"
    !GRAB FROM BONAP OPTIONS USING shoname
    select#=menu(shoname,1,name#+1,3,3,0,75,1,22,-1,1,"CAACUARA","FDCP","Select Name - (mouse/arrow) add..........name (LAST LINE) if not present",)
    !CONVERT TO NORMAL VARS FROM usename 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:";e.forg="WWWWO"
     @12,2?"Standard Name:  ",usename(select#,1)
     @13,2?"Label Name:  ",usename(select#,2)
     @14,2?"HUH reference#:  ",usename(select#,3)
     @15,2?"Relevant dates:  ",usename(select#,4)
     !CONFIRM NAME FROM USER
     e.forg="WWWWR";@18,2 input xkeepon using "u" with "Is this the label name? [n/Y]:  "
     if xkeepon ne "n" then
      haveit=1
      !VARIABLES TAKEN TO TRACYIN4
      colname=trim(usename(select#,1))
      colref=trim(usename(select#,3))
     else
      e.forg="WWWWW"
      haveit=0
      @5,2?"                                                         "
      @10,2?"                                                   "
      @12,2?"                                                 "
      @13,2?"                                                  "
      @14,2?"                                                  "
      @15,2?"                                                  "
      @16,2?"                                                    "
      @18,2?"                                                                   "
     endif
    else
     xqpluck="no data";haveone=0;xqchoice=2
    endif
   endif
  endif
 endif
 !END OF HUHNAME1 CHECK
 !LABEL NAME NOT IN EITHER LOOKUP TABLE - ADD TO TRANAME1
 if xqpluck ne " " and haveone=0 and haveit=0 then !NO MATCH - ERROR OR NEW NAME
  if xqpluck ne "no data" then
   e.forg="WWWWC";xqchoice=0
   @5,2?"Our collector name look-up tables carry no names that start with: "
   e.forg="WWWWO";@5,69?xqpluck
   e.forg="WWWWc";@6,2?"If this is an input error, please take the default option from the "
   @7,2?"menu below and try again.  If, on the other hand, the collector name on this"
   @8,2?"label starts with";e.forg="WWWWO"
   @8,20?xqpluck;e.forg="WWWWCg"
   @8,24?", then take the 2nd option to enter this name from the."
   @9,2?"keyboard." 
   test menu (colmenu1,1,2,12,5,0,70,1,,,,"gAAocARA","FDCP","Please Select")
    CASE 1: xqchoice=1;break
    CASE 2: xqchoice=2;break     
    OTHERWISE:  clear;@10,2?"SOMETHING IS AMISS - CALL WILSON";break
   endtest
  endif
  !CATCH 'CASE 2' - ADD RECORD TO TRANAME1.ITB
  if xqchoice=2 then
   !GET LOCAL EQUIVALENT OF HUHREF# FROM COLLREFS.ITB
   default collrefs;obtain last
   if collrefs.lastdate=#date then
    collrefs.ref#=collrefs.ref#+1;colref="TAES"+ltrim(tostr(collrefs.ref#,8,0))
   else !NEW DAY - NEW SERIES BY DATE, BUT MAINTAIN SEQUENCE OF REF#S
    newref#=collrefs.ref#+1;attach 1;collrefs.ref#=newref#
    collrefs.lastdate=#date;colref="TAES"+ltrim(tostr(collrefs.ref#,8,0))
   endif
   !GET STRINGS NEEDED FOR CURRENT LABEL AND 'PRIMARY' INFO FOR LOCAL RECORD
   !IN TRANAME1
   clear;e.forg="WWWWg"
   clear;@3,7?"Tracy Herbarium data input system - collector name entry"
   e.forg="WWWWO"
   @5,2?"Please select one of the three options below:"
   test menu (colmenu2,1,3,9,10,0,20,3,,,,"gAAocARA","FDCP","# of Collectors listed on Specimen Label")
    CASE 1: xqchoic1=1;break
    CASE 2: xqchoic1=2;break     
    CASE 3: xqchoic1=3;break     
    OTHERWISE:  clear;@10,2?"SOMETHING IS AMISS - CALL WILSON";break
   endtest
   qlname1="";qmiddle1="";qfname1=""
   qlname2="";qmiddle2="";qfname2=""
   if xqchoic1=1 then !ONE NAME ON THE LABEL - GET DATA
    e.forg="WWWWC"
    clear;@3,7?"Tracy Herbarium data input system - collector name entry"
    e.forg="WWWWM"
    @5,2?"Please enter the following information:";e.forg="WWWWO"
    @7,4 input qlname1 using "urrrrrrrrrrrrrrrrrrrrrrr" with "Last name of collector: "
    @9,4 input qmiddle1 using "u" with "Middle initial of collector: "
    @11,4 input qfname1 using "urrrrrrrrrrrrrrrrrrrrrr" with "First name/initial (with'.') of collector: "
   endif
   if xqchoic1=2 then !TWO NAMES ON LABEL - GET DATA
    e.forg="WWWWC"
    clear;@3,7?"Tracy Herbarium data input system - collector name entry"
    e.forg="WWWWM"
    @5,2?"Please enter the following information:";e.forg="WWWWO"
    @7,4 input qlname1 using "urrrrrrrrrrrrrrrrrrrrrrr" with "Last name of 1st collector: "
    @9,4 input qmiddle1 using "u" with "Middle initial of 1st collector: "
    @11,4 input qfname1 using "urrrrrrrrrrrrrrrrrrrrrr" with "First name/initial (with '.') 1st collector: "
    e.forg="WWWWG"
    @13,4 input qlname2 using "urrrrrrrrrrrrrrrrrrrrrrr" with "Last name of 2nd collector: "
    @15,4 input qmiddle2 using "u" with "Middle initial of 2nd collector: "
    @17,4 input qfname2 using "urrrrrrrrrrrrrrrrrrrrrr" with "First name/initial (with '.') of 2nd  collector: "
   endif
   if xqchoic1=3 then !THREE NAMES ON LABEL - GET DATA
    e.forg="WWWWC"
    clear;@3,7?"Tracy Herbarium data input system - collector name entry"
    e.forg="WWWWM"
    @5,2?"Please enter the following information:";e.forg="WWWWO"
    @7,4 input qlname1 using "urrrrrrrrrrrrrrrrrrrrrrr" with "Last name of 1st collector: "
    @9,4 input qmiddle1 using "u" with "Middle initial of 1st collector: "
    @11,4 input qfname1 using "urrrrrrrrrrrrrrrrrrrrrr" with "First name/initial (with '.') of 1st collector: "
   endif
   !SET DATA STRINGS AND ATTACH TO HUHNAME1
   qsource="S. M.Tracy Herbarium (TAES) databasing"
   if xqchoic1=1 then !SINGLE NAME ON LABEL
    if qmiddle1 ne " " then;qmiddle1=qmiddle1+".";else;qmiddle1="";endif
    xstaname=trim(qlname1)+", "+qfname1+" "+qmiddle1
    if qmiddle1 ne "" then
     xlabname=substr(qfname1,1,1)+". "+qmiddle1+" "+qlname1
    else
     xlabname=substr(qfname1,1,1)+". "+qlname1
    endif
   endif
   if xqchoic1=2 then !TWO NAMES ON LABEL
    !DEAL WITH 1ST NAME AS ABOVE
    if qmiddle1 ne " " then;qmiddle1=qmiddle1+".";else;qmiddle1="";endif
    xstanam1=trim(qlname1)+", "+qfname1+" "+qmiddle1
    if qmiddle1 ne "" then
     xlabnam1=substr(qfname1,1,1)+". "+qmiddle1+" "+qlname1
    else
     xlabnam1=substr(qfname1,1,1)+". "+qlname1
    endif
    !DEAL WITH 2ND NAME
    if qmiddle2 ne " " then;qmiddle2=qmiddle2+".";else;qmiddle2="";endif
    xstanam2=trim(qlname2)+", "+qfname2+" "+qmiddle2
    if qmiddle2 ne "" then
     xlabnam2=substr(qfname2,1,1)+". "+qmiddle2+" "+qlname2
    else
     xlabnam2=substr(qfname2,1,1)+". "+qlname2
    endif
    !COMBINE TWO NAMES FOR NAME STRINGS
    xstaname=xstanam1+" & "+xstanam2
    xlabname=xlabnam1+" & "+xlabnam2
   endif
   if xqchoic1=3 then !MORE THAN TWO NAMES ON LABEL - TO 'ET AL.' TAG
    if qmiddle1 ne " " then;qmiddle1=qmiddle1+".";else;qmiddle1="";endif
    if qmiddle1 ne "" then
     xstaname=trim(qlname1)+", "+qfname1+" "+qmiddle1+", et al."
    else
     xstaname=trim(qlname1)+", "+qfname1+", et al."
    endif
    if qmiddle1 ne "" then
     xlabname=substr(qfname1,1,1)+". "+qmiddle1+" "+trim(qlname1)+", et al."
    else
     xlabname=substr(qfname1,1,1)+". "+trim(qlname1)+", et al."
    endif
   endif
   !ATTACH TO TRANAME1 AND SET VARS FOR TRANSFER TO TRACYIN3.IPF
   default traname1;attach 1;browsrec=currec(traname1)
   traname1.staname=xstaname;traname1.labname=xlabname
   traname1.huhref#=colref;traname1.source=trim(qsource)
   traname1.lastedit=#date;traname1.plucker=substr(xstaname,1,4)
   !CHECK RECORD
   checkok=0
   while checkok=0 do
    clear;browse range browsrec,browsrec with colform1;e.forg="WWWWR"
    @24,2 input checkout using "u" with "Are these names ok? [N/y]: "
    if checkout="y" then
     !VARIABLES TAKEN TO TRACYIN4
     colname=trim(traname1.staname)
     colref=trim(huhref#)
     checkok=1;haveit=1
    endif
    if checkok ne 0 then;break;endif
   endwhile
   !NEW NAME ADDED TO TRANAME1 AND CORRECTED - NOW SET UP TRANSFER VARS AND 
   !AND RETURN TO TRACYIN3 WITH THESE
  endif
 endif
 if xqpluck=" " and haveit=0 then !NO ENTRY - ERROR OR READY TO LEAVE
  e.forg="WWWWR";@22,40 input xkeepon using "u" with "Continue with taxon entry [n/Y]?:  "
  e.forg="WWWWW"
  if xkeepon="n" then
   xdoit=1
  else
   clear
  endif
 endif
 !BREAK OUT OF MAIN LOOP
 if haveit ne 0 then;xdoit=1;endif
 if xdoit ne 0 then;break;endif
 !CLEAR INPUT LINE
 @10,2?"                                                                  "
 !RESET VARIABLES
 xqpluck=" ";haveone=0;name#=0;checkdup=0;beginrec=0;goodname=0
 xkeepon="Y";select#=0;row#=0
endwhile
!HAVE NAME [COLNAME] AND REFCODE [COLREF], NOW GET DATE AND COL#
clear;xdoit=0;xkeepon="Y";e.forg="WWWWO"
while xdoit=0 do
 @10,2 input colnum using "rrrrrrrrrrrr" with "Please enter the collection number ('s.n.' if none): "
 @10,2?"                                                                                    "
 @10,2 input xkeepon using "u" with "You have entered ["+trim(colnum)+"].  Is this ok? [N/y]: "
 if xkeepon="y" then
  xdoit=1
 else
  xkeepon=""
  @10,2?"                                                                                     "
  @10,2?"Will give it another try";sleep(1)
  @10,2?"                        "
 endif
endwhile
xdoit=0;xkeepon="Y";colday=""
while xdoit=0 do
 @10,2 input colday using "dd" with "Please enter the day of collection (blank if none): "
 @10,2?"                                                                                    "
 @10,2 input xkeepon using "u" with "You have entered ["+colday+"].  Is this ok? [N/y]: "
 if xkeepon="y" then
  xdoit=1
 else
  xkeepon=""
  @10,2?"                                                                                     "
  @10,2?"Will give it another try";sleep(1)
  @10,2?"                        "
 endif
endwhile
clear
xdoit=0;xkeepon="Y";qmonth=""
!ENTER 1ST MONTH CHAR - FORGET THE CHECK, HAVE ONE IN NEXT WHILE LOOP
@10,2 input qmonth using "u" with "Please enter the 1st letter of the collection month (blank if none): "
clear
xdoit=0;xkeepon="Y";colmonth=""
while xdoit=0 do
 if qmonth="a" then
 e.forg="WWWWO"
 @5,2?"Please select the collection month from options below:"
  test menu (amonth,1,2,10,15,0,20,2,,,,"gAAocARA","CDP","The 'A' months - select one",)
   CASE 1: colmonth="April";break
   CASE 2: colmonth="August";break     
  endtest
 endif
 if qmonth="d" then;colmonth="December";endif
 if qmonth="f" then;colmonth="February";endif
 if qmonth="j" then
 e.forg="WWWWO"
 @5,2?"Please select the collection month from options below:"
  test menu (jmonth,1,3,10,15,0,20,3,,,,"gAAocARA","DCP","The 'J' months - select one",)
   CASE 1: colmonth="January";break
   CASE 2: colmonth="July";break     
   CASE 3: colmonth="June";break     
  endtest
 endif
 if qmonth="m" then
 e.forg="WWWWO"
 @5,2?"Please select the collection month from options below:"
  test menu (mmonth,1,2,10,15,0,20,2,,,,"gAAocARA","DCP","The 'M' months - select one",)
   CASE 1: colmonth="March";break
   CASE 2: colmonth="May";break     
  endtest
 endif
 if qmonth="n" then;colmonth="November";endif
 if qmonth="o" then;colmonth="October";endif
 if qmonth="s" then;colmonth="September";endif
 clear
 @10,2 input xkeepon using "u" with "You have entered ["+trim(colmonth)+"].  Is this ok? [N/y]: "
 if xkeepon="y" then
  xdoit=1
 else
  xkeepon=""
  @10,2?"                                                                                     "
  @10,2?"Will give it another try";sleep(1)
  @10,2 input qmonth using "u" with "Please enter the 1st letter of the collection month again: "
  clear
 endif
endwhile
if colmonth="april" then;colmonth="Apr";endif
if colmonth="august" then;colmonth="Aug";endif
if colmonth="december" then;colmonth="Dec";endif
if colmonth="february" then;colmonth="Feb";endif
if colmonth="january" then;colmonth="Jan";endif
if colmonth="july" then;colmonth="Jul";endif
if colmonth="june" then;colmonth="Jun";endif
if colmonth="march" then;colmonth="Mar";endif
if colmonth="may" then;colmonth="May";endif
if colmonth="april" then;colmonth="Apr";endif
if colmonth="november" then;colmonth="Nov";endif
if colmonth="october" then;colmonth="Oct";endif
if colmonth="september" then;colmonth="Sep";endif
clear
xdoit=0;xkeepon="Y";colyear=""
while xdoit=0 do
 @10,2 input colyear using "dddd" with "Please enter the collection year (4 digits): "
 @10,2?"                                                                                    "
 @10,2 input xkeepon using "u" with "You have entered ["+colyear+"].  Is this ok? [N/y]: "
 if xkeepon="y" then
  xdoit=1
 else
  xkeepon=""
  @10,2?"                                                                                     "
  @10,2?"Will give it another try";sleep(1)
  @10,2?"                        "
 endif
endwhile
clear
!DATE TAKEN TO TRACYIN4:
coldate=colday+" "+colmonth+" "+colyear
sleep(1)
!OUT
!RESET FOR TRACYIN4:
colday="";qmonth="";colmonth="";colyear=""
xdoit=0;xqpluck="";haveone=0;name#=0;xkeepon="";checkdup=0
goodname=0;haveit=0;xqchoice=0;newref#=0;tranref#="";
clearrow=0;xqchoic1=0;xstaname="";xlabname="";checkok=0;checkit=0
xstanam1="";xlabnam1="";xstanam2="";xlabnam2="";checkout=""
!RESET TRACYIN4 VARS
row#=xrow#;name#=xname#
clear
!@10,2?"This name going to tracyin3 :",colname
!@12,2?"This refcode going to tracyin3 :",colref
!wait
!e.supd=false;e.forg="WWWWW";e.deci=1
clear;return