'PROJ_LIB - internally generated functions for project - v1.00
'           PrintReport() added 23/4/94

external   fentrybox() lpath dpath scw sch ptstr progress() bpopdb() vloadif() _GEMS_Input()
external   vunloadif() fgp bgp fge bge chkdate() messbox() shopmask bgs fgs
external   popuplist() redfentry() userid increment() wraptext() cpath
external   strcount() strtoary() arytostr() remove() jobs[6] $actport
external   chkfname() messboxwait() vatrate jobnr makeidx() areas

public     findcustcode(1) findjobnr(1) EnterWidth() FindSuppCode() ptary[1]
public     MakeAnyArray(4) newarray[1] tot_len_array EnterSuppCode() t
public     PrintReport(6) PrnWait() scr_wait Exception(5) UpdGdsOut()
public     LogError() QueryTrap() pmexe #linenr ptval AddToArray() prodcode
public     SetPRN_JNR() ResetPrinter() ChooseBranches() ChooseBranch()
public     Find_Del() Background()
public     AddVarn() InvoiceDistribution() ListAnclRcvd()
public     FindJob()              'finds all records in key field [Job_Nr]
public     Check_2000() EnterEmail() $email
PUBLIC     ChooseShop() $shop $shop_name


FUNCTION EnterEmail()
local j r i n x
	$email=""
	while true
  		$email=_GEMS_Input("EMAIL ADDRESS","Enter or update",$email,50,6,"") 'message "$email is:"&str($email)

' 		x = fentrybox(" Enter email address (max 50 characters) ",50,$email,"")
' 		if x = -1
' 			continue while
' 		end if
' 		$email = ptstr

		if left($email,1)="@"
			messboxwait(" Invalid email address - 1st char is @ ",0,0,1)
			continue while
		end if

		x=fentrybox(" Enter email address (max 50 characters) ",50,$email,"")
		if x = -1
			continue while
		end if
		$email = ptstr
		if left($email,1)="@"
			messboxwait(" Invalid email address - 1st char is @ ",0,0,1)
			continue while
		end if
		if right($email,1)="."
			messboxwait(" Invalid email address - last char is .  ",0,0,1)
			continue while
		end if

		if right($email,1)="@"
			messboxwait(" Invalid email address - last char is @  ",0,0,1)
			continue while
		end if

		for j=1 to len($email)
			r = mid($email,j,1)			' message "r is:"&str(r)
			if r=chr(64)
				exit while
			end if
		end for
		messboxwait(" Invalid email address format - no @ sign ",0,0,1)

	end while

END FUNCTION 'EnterEmail()


FUNCTION AddVarn(varnr,#gross,$reas,$ref,$notif,$varndate)
local balancedue lastbal newtotal oldtotal newnet oldnet p1 p2 p3 p4 p5 p6 #prec x
  p2 = ""               ' p2 = title at top of choice popup ("LABEL")
  p3 = 1                ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p4 = 1                ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
  p5 = 1                ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE

' message "varnr is:"&str(varnr)
  vloadif(dpath|"variat_n.vws")
  data enter lock
    [Var_Nr]        = varnr
    [Job_Nr]        = left(varnr,6)
    [Amount_Gross]  = #gross
    [Reason]        = $reas
    [Customers_Ref] = $ref
    [Notif_Method]  = $notif
    [Date]          = $varndate
    [Entered_By]    = userid
  write-record
  #prec = precord
  remove("varnnote.idx")
  makeidx("variat_n","varnnote.idx",#prec,5)
  order change index "varnnote.idx"
'   screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Print Variation Order? (y/n) ",1,1,1)
  if ptstr == "y"
'     screen clear box 1 1 sch scw 0 0 no-border
'     repaint off
    x = popuplist(8,53,13,"1ÿcopy 2ÿcopies","",1,0)
    if ptstr = "1ÿcopy"
      p6 = 1
    else
      p6 = 2
    end if
    progress(15,10," Printing Variation .... please wait ",0)
    p1 = "varnnote.dfr"
    PrintReport(p1,p2,p3,p4,p5,p6)
  end if

' update values in CUST_ORD
  vloadif(dpath|"cust_ord.vws")
  order change key "[Job_Nr]"
  data find "[Job_Nr]" equal jobnr options ""
  if cerror                               '   if none - then return
    messboxwait(" Record "|jobnr|" not written to file - inform Head Office ",1,0,0)
    return (1)
  end if
  lastbal = round([Balance_Due],2)
  balancedue = lastbal + #gross
  oldtotal = round([Invoice_Total],2)
  newtotal = oldtotal + #gross
  oldnet   = round([Net_Invoice],2)
  newnet   = oldnet + round(#gross*100/(100+vatrate),2)
  lock-record
    [Balance_Due]   = balancedue
    [Invoice_Total] = newtotal
    [Net_Invoice]   = newnet
    [Order_Status]  = "U"
  write-record
END FUNCTION 'AddVarn()


FUNCTION Background()
local x ri
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
' x=len("I:\data\")
' message "x is:"&str(x)
  ri=scw-15
  if dpath = "I:\data\"
    screen print 1 ri 12 0 "Using MRCDB"
  else
    screen print 1 ri 10 0 "Using"&dpath
  end if
END FUNCTION ' Background()


FUNCTION SetPRN_JNR()
local i x
  remove("*.idx")
  remove(dpath|userid|".jnr")
  fopen dpath|userid|".jnr" as 1
  redimension ptary[6]
  for i = 1 to 6
    ptary[i] = jobs[i]
  end for
  x = arytostr(6)                      'message "ptstr) is:"&str(ptstr)
  fwrite 1 from ptstr
  fclose 1

' reset printer to LJIII on lpt2
  ResetPrinter($actport)

END FUNCTION ' SetPRN_JNR()


FUNCTION ResetPrinter(p4) '
local $p $s k1 k2 $printer $prn $port vu_prn x $prt y i ss
smartpeek $_step ss                    ' message "ss is:"&str(ss)
repaint off
  $printer = "HPIII_QC"
  $prt = p4

  error off
  progress(15,10," Please wait ... resetting printer ",0)
  for i = 1 to 10            ' message "i is:"&str(i)
    smartpeek $_pdv $prn    ' message "$prn is:"&str($prn)
    if $prn == $printer	     ' when correct, change port
      smartpoke $_prport $prt
      smartpoke $_pto 5          ' change timeout value
      smartpeek $_pto y          ' message "y is:"&str(y)
      error off
      open-printer raw
      if cerror
        x = redfentry(" Port"&str($prt)&"not working - enter Port Nr or {Esc} ",1,"#","")
        if x = -1
          close-printer
          smartpoke $_pto 20     ' reset timeout value
          if ss=1
'             single-step on
          end if
          return (-1)
        end if
        $prt = value(ptstr)
        i = 1                    ' reset counter
        continue for
      else
        close-printer
        smartpoke $_pto 20   ' reset timeout value
      end if
      exit for
    end if
    tools preferences hardware
    keys Home,F6,Up,Enter,F10
    repaint off
  end for                          ' message "Unable to find Specified printer"
  repaint off
  if ss=1
'     single-step on
  end if
  return (0)
END FUNCTION 'ResetPrinter()


FUNCTION AddToArray(jn,cn)
local $new i
  $new = jn|"ÿ"|cn
  for i = 1 to 6
    if left(jobs[i],6) = jn         ' jobnr already held
      return (0)
    end if
  end for
  for i = 5 to 1 step -1
    if len(jobs[i]) = 0
      jobs[i+1] = "ÿ"
    else
      jobs[i+1] = jobs[i]
    end if
  end for
  jobs[1] = $new
END FUNCTION ' AddToArray()


FUNCTION QueryTrap()
local $cerror #errnr $errtext x prev_view $file
  $cerror = CERROR                       ' message "userid is:"&str(userid)&str(today)&str(time24)&str(pmexe)
' smartpeek $_pfll #linenr               ' message "#linenr is:"&str(#linenr)
  #errnr = str($cerror)                  ' message "#errnr is:"&str(#errnr)
  $errtext = left(errortext($cerror),50) ' message "$errtext is:"&str($errtext)
'   $file = apinfo(ap_filep)
'   prev_view = right($file,len($file)-8)   ' message "prev_view is:"&str(prev_view)
  x = LogError(userid,today,time24,pmexe,#linenr,#errnr,$errtext)
'   vloadif(dpath|prev_view)
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' QueryTrap()


FUNCTION LogError(a1,a2,a3,a4,a5,a6,a7)
local   $errornr $errmess
' x = LogError(userid,today,time24,pmexe,#linenr,#errnr,$errtext)
  vloadif(dpath|"errors.vws")
  increment(dpath|"errors.dat",1)
  $errornr = right("00000"|str(ptval),5)
  data enter lock
    [User_ID]    = a1
    [Date]       = a2
    [Time]       = a3
    [Project]    = a4
    [LineNr]     = a5
    [Error_Nr]   = a6
    [Error_Text] = a7
    [Err_Ref]    = $errornr
  write-record
  vunloadif("errors.vws")
$errmess = "An error has occurred ("|a7|") - inform the Warehouse of its cause (ref:"&str($errornr)|"). The program will return to the menu - check whether any changes/entries were entered correctly"
  wraptext(7,20,15,60,15,12,$errmess,"M",1,0,0)
  message "Press any key to continue ..."
'r1       ' upper left row
'r2       ' lower right row
'c1       ' upper left column
'c2       ' lower right column
'fg       ' foreground color
'bg       ' background color
'ts       ' text string
'jst      ' justification  ("l"=left) or ("m"= middle) or ("r" = right)
'sprn     ' screen print (1 = yes) or (0 = no )
'sml      ' shrink rows to fit end of text ( 1 = yes ) or ( 0 = no )
'pg       ' page up / down option ( 1 = paging ) ( 0 = no paging )
END FUNCTION ' LogError(a1,a2,a3,a4,a5,a6,a7)


FUNCTION PrintReport(repdef,p2,p3,p4,p5,p6) ' newprt
'(str,str,str,int,int,int)
' p1 = report definition ("ord_stck.dfr")
' p2 = title at top of choice popup ("LABEL")
' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN; 3=Epson LQ850)
' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
' p5 = choose VIEW/PRINT/FILE 1=PRINT; 2=VIEW; 3=CHOOSE
' p6 = nr of copies
local $p $s k1 k2 k3 $printer $prn $port vu_prn x $prt y i ss $fname $pt $pp
  smartpeek $_step ss                    ' message "ss is:"&str(ss)
  repaint off
  $pt = case p3 (1,"Laserjet")(3,"Epson LQ") else "Unknown printer"
  $pp = case p4 (1,"locally")(2,"on network") else "somewhere"
  progress(15,10," Printing to"&$pt&$pp|" ",0)

'check for DFR file
  if file(repdef) = 0
    messboxwait(" Print Definition"&upper(repdef)&"is not available - contact Head Office ",0,0,1)
    return (-1)
  end if

'   if p3 = 1

  $printer = "HPIII_QC"

'   elseif p3 = 2
'     messboxwait(" Printer driver for Epson General not available ",0,0,1)
'     return (-1)
'     $printer = "GEN_EPSN"
'   elseif p3 = 3
'     $printer = "EP_Q850Q"
'   end if

  $p   = "printer detail start 1 end 0 copies"&str(p6)
  $s   = "text-screen detail start 1 end 0"
  $prt = p4
'   if p5 = 3
'     k1 = "ÿÿÿÿÿÿÿÿÿPrintÿÿÿÿÿÿÿÿÿ"   ' MUST be HARD spaces - Alt-255
'     k2 = "ÿÿÿÿÿÿÿÿÿViewÿÿÿÿÿÿÿÿÿÿ"   ' MUST be HARD spaces - Alt-255
'     k3 = "ÿÿÿÿÿÿÿÿÿFileÿÿÿÿÿÿÿÿÿÿ"   ' MUST be HARD spaces - Alt-255
'     screen print 9 28 bgs fgs (format(p2,"M27"))
'     x = popuplist(10,28,13,k2&k1&k3,"ÿ{Esc} to exitÿ",1,0)
'     if x = 0
'       if ptstr = k1

vu_prn = $p

'       elseif ptstr = k2
'         vu_prn = $s
'       elseif ptstr = k3
'         while true                     ' enter filename
'           x = fentrybox(" Enter path & filename (.txt extension added!) ",20,"","")
'           if x = -1
'             continue while
'           end if
'           $fname = ptstr|".txt"
'           x = chkfname($fname)         ' check for filename
' ' message "x) is:"&str(x)
'           if x <> 0
'             messbox(" Invalid filename - re-enter ",0,0,1)
'             continue while
'           end if
'           if file($fname) = 1
'             messbox(" Filename already exists - re-enter ",0,0,1)
'             continue while
'           end if
'           exit while
'         end while
'         progress(15,10," Please wait ... writing report to disk ",0)
'         vu_prn = "detail start 1 end 0 copies 1"
'         evaluate("print report execute "|chr(34)|repdef|chr(34)&"disk"&chr(34)|$fname|chr(34)&vu_prn)
'         return (0)
'       end if
'     end if
'   elseif p5 = 2
'     vu_prn = $s
'   else
'     vu_prn = $p
'   end if

  error off
'   if vu_prn = $p		' check for correct printer
'     for i = 1 to 10            ' message "i is:"&str(i)

' smartpeek $_pdv $prn    '
' message "314\ $prn is:"&str($prn)
' repaint on
' repaint
' single-step on

'       if $prn == $printer	     ' when correct, change port
'         smartpoke $_prport $prt
'         smartpoke $_pto 5          ' change timeout value
'         smartpeek $_pto y          'message "y is:"&str(y)
'         error off
'         open-printer raw
'         if cerror
'           x = redfentry(" Port"&str($prt)&"not working - enter Port Nr or {Esc} ",1,"#","")
'           if x = -1
'             close-printer
'             smartpoke $_pto 20     ' reset timeout value
'             if ss=1
' '               single-step on
'             end if
'             return (-1)
'           end if
'           $prt = value(ptstr)
'           i = 1                    ' reset counter
'           continue for
'         else
'           close-printer
'           smartpoke $_pto 20   ' reset timeout value
'         end if
'         exit for
'       end if
'       tools preferences hardware
'       keys Home,F6,Up,Enter,F10
'       repaint off
'     end for                          ' message "Unable to find Specified printer"
'   elseif vu_prn = $s
'     repaint on
'   end if

' message "repdef) is:"&str(repdef)
' message "vu_prn) is:"&str(vu_prn)
  evaluate("print report execute "|chr(34)|repdef|chr(34)&vu_prn)
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  if cerror
    while true
      if vu_prn = $p
        messbox(" Printer not available - retry? (y/n) ",1,0,1)
        if ptstr == "y"
          evaluate("print report execute "|chr(34)|repdef|chr(34)&vu_prn)
          screen clear box 1 1 sch scw 0 0 no-border
          repaint off
          if cerror
            continue while
          end if
        else
'           screen clear box 1 1 sch scw 0 0 no-border
          messbox(" View on Screen? (y/n) ",1,1,1)
          if ptstr == "y"
            vu_prn = $s
            screen clear box 1 1 sch scw 0 0 no-border
            repaint on
            evaluate("print report execute "|chr(34)|repdef|chr(34)&vu_prn)
            screen clear box 1 1 sch scw 0 0 no-border
            repaint off
            exit while
          else
            exit while
          end if
        end if
        exit while
      end if
      exit while
    end while
  end if
'   screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  if ss=1
'     single-step on
  end if
  return (0)
END FUNCTION 'PrintReport()


FUNCTION MakeAnyArray(a,b,c,d)
' parameters to pass:
'     file name
'     initial query .DFQ file, if any, containing value(s) to make array for
'     [Field] to produce array from
'     1 = sort; 0 = no sort

local    j m x y z l k

'  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º A - Query by subset (if any) & create temp d'base                  º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

  vloadif(dpath|a)

  order change physical

  vunloadif("$_array.vws")
  if file("$_array.db") = 1
    tools file erase "$_array.db"
  end if
  if file("$_array.vws") = 1
    tools file erase "$_array.vws"
  end if
  if file("$_array.key") = 1
    tools file erase "$_array.key"
  end if

  if b <> ""
    k = b|".dfq"
    data query execute k data-file "$_array" fields c
  else
    data query execute "not_del" data-file "$_array" fields c
  end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Create new key field & order by key                                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

  order key delete c
  order key add c
  keys F10                       ' ************************************

'  order change key c

' ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
' º B - write FETCHFIELD file & execute                                º
' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ

  if file("makearry.dfq") = 1
    tools file erase "makearry.dfq"    ' delete existing file
  end if
  fopen "makearry.dfq" as 1
  fseek 1 0
  m = c|" = fetchfield("|c|")"
  fwrite 1 from m
  fwrite 1 from "replace delete"
  fclose 1

  data query execute "makearry.dfq"

  if cerror
    messbox(" No records meet the criteria - array not created ",0,0,1)
    exit function
  end if

  vunloadif("$_array.vws")

  data utilities purge "$_array.vws"

END FUNCTION  ' MakeAnyArray()


FUNCTION findcustcode(findcode)

' this will search "cust_sel.vw" (which includes a calculated field to show
' CODE/NAME/ADDRESS as one field) and returns the Customer Code.
' called by the line:
'      custcode=findcustcode(custcode)

' !!!!!!!!!!!!!!!!!!!!
'  PROBLEM! the search mask is suspect as the Customer Code can be either the
'           JOb Nr or a real code (AAA###). The answer is to rationalize the
'           definition of CUSTCODE.
' !!!!!!!!!!!!!!!!!!!!

fentrybox(" Enter Customer's code ... press ESC if not known ",6,"AU{X{X{X{X{X}}}}}","") = 0
if ptstr = ""
    progress(fgp,bgp," Sorting file ... please wait and then enter Name to find ",1)
    vloadif(dpath|"cust_sel.vw")
'    order change key "Name"
    order sort execute dictionary dpath|"custname.dfs" index "custname"
    bpopdb("cust_sel",8,"fp~{AU{a{a{a{a{a{a}}}}}}}~","[nam_addr]","L77","[Name]","R0","[Cust code]",8,1,25,80,"",1)
    findcode=ptstr
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    vunloadif("cust_sel.vw")
else
    findcode=ptstr
end if
return (findcode)
END FUNCTION

' ==========================================================================

FUNCTION findjobnr(findjob)
' single-step on
screen clear box 1 1 sch scw 0 0 no-border
repaint off
fentrybox(" Enter Job Number ... press ESC if not known ",6,shopmask,"") = 0
if ptstr = ""
    progress(fgp,bgp," Sorting file ... please wait and then enter Name to find ",0)
    vloadif(dpath|"job_sel.vw")
'    order change key "Job Nr"
    order sort execute dictionary dpath|"custname.dfs" index "custname"
'    order change key [Job Nr]
    bpopdb("job_sel",8,"fp~{AU{a{a{a{a{a{a}}}}}}}~","[JobNamDel]","L77","[Name]","R0","[Job Nr]",8,1,25,80,"",1)
    findjob=ptstr
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    vunloadif("job_sel.vw")
else
    findjob=ptstr
end if
return (findjob)

' this will search "job_sel.vws" (which includes a calculated field to show
' CODE/NAME/ADDRESS as one field) and returns the Customer Code.
' called by the line:
'      jobnr=findjobnr(jobnr)

END FUNCTION

' ==========================================================================

FUNCTION FindSuppCode()
local suppcode
  bpopdb("supplier",6,"","[Supplier_Code]","L10","[Name]","L35","[Supplier_Code]",5,20,15,61,"",1)
  suppcode=ptstr
  return suppcode
END FUNCTION


FUNCTION EnterWidth()
local width
'  smartpoke $_ins 0
  fentrybox(" Enter width sold ",5,"",4.00)
  width = val(ptstr)
'  smartpoke $_ins 1
  return width
END FUNCTION


FUNCTION PrnWait()
screen save 1 1 3 12 scr_wait
screen print 1 1 15 12 "ÚÄÄÄÄÄÄÄÄÄÄ¿"
screen print 2 1 15 12 "³ Wait ... ³"
screen print 3 1 15 12 "ÀÄÄÄÄÄÄÄÄÄÄÙ"
END FUNCTION ' Wait()


FUNCTION EnterSuppCode()
local suppcode
  vloadif(dpath|"supplier.vws")
  bpopdb("supplier",6,"","[Name]","l40","[Supplier_Code]","L0","[Supplier_Code]",10,25,15,55,"",1)
  suppcode = ptstr
  return suppcode
END FUNCTION


FUNCTION Exception(a1,a2,a3,a4,a5)
' x = exception(userid,today,time24,cat,mess)
vloadif(dpath|"unread1.vw")
data enter lock
  [user]         = a1
  [Date_Created] = a2
  [Time_Created] = a3
  [category]     = a4
  [message]      = a5
write-record
END FUNCTION '


FUNCTION Find_Del(jn,v)
  progress(15,10," Please wait ... checking for deleted records ",0)
  vloadif(dpath|"requsn.vws")
  order change physical
  data query execute "find_del" index "fd1"
  if cerror
'     messboxwait(" No deleted records found ",0,0,1)
    return (0)
  end if
  if v = 1
'   order sort now dictionary "find_del" fields "[Job_Nr]" ascending
    data find "[Job_Nr]" equal jn options ""
    if cerror
      return (0)
    end if
    return (precord)
  end if
END FUNCTION ' Find_Del()

' global x UpdGdsOut() $rollnr ordref
FUNCTION UpdGdsOut(roll,reqnnr)
local origview
  origview=apinfo(ap_filex)
  vloadif(dpath|"goodsout.vws")
  order change key "[Requsn_Nr]"
  data find "[Requsn_Nr]" equal reqnnr options ""
  if cerror                               '   if none - then return
    return (0)
  else
    if [RollNr] == "BESPOK" or [RollNr] == "00000/00"
      lock-record
        [RollNr] = roll
      write-record
    else
      messboxwait("Already allocated as"&[RollNr]|"ÿ- inform Office ",0,0,1)
      vloadif(dpath|origview)
      return (1)
    end if
  end if
  vloadif(dpath|origview)
END FUNCTION 'UpdGdsOut()


FUNCTION InvoiceDistribution()
  if [Credit_Status]="A"
    return ("Post now")
  elseif [Credit_Status]="N"
    return ("Post now")
  elseif [Credit_Status]="D"
    return ("Post on"&date2(days(today)+2))
  elseif [Credit_Status]="C"
    if [Balance_Due]<1
      return ("Post now")
    elseif days([Fitting_Date])>days(today)
      return ("With Fitter")
    else
      return ("Post now")
    end if
  end if
END FUNCTION ' InvoiceDistribution()


FUNCTION FindJob(jobnr)
  repaint off
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "job_reqn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'     [Job_Nr] = jobnr
'     and
'     not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    return (-1)
  end if
  return (0)
END FUNCTION ' FindJob()


FUNCTION ListAnclRcvd()
  prodcode = [Product_Code]
  vloadif(dpath|"ancllst1.vw")
  order change key "[Product_Code]"
  data query execute "ancllst1.dfq" index "ancllst1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Product_Code] = prodcode                                          ³
' ³ and                                                                ³
' ³ not (deleted)                                                      ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  t = filesum([Length_Received])
  vloadif(dpath|"products.vws")
message "t is:"&str(t)
  return (t)
END FUNCTION ' ListAnclRcvd()


FUNCTION check_2000(date_check)
'example calls:
'check_2000("01.01.00")   returns   01.01.2000
'check(36612)             returns   28.03.2000   ' if sent as number
'check("36612")           returns   28.03.2000   ' if sent as text

' THIS WORKS WELL FOR ME, BUT I AM SURE IT CAN BE CLEANED UP A BIT - IF YOU
' DO, I WOULD WELCOME A COPY ON CJCS@COMPUSERVE.COM - thanks


local return_data day month year x this_char so_far no_dots dot1 dot2
local start_pos month_len its_a_date

if isnumber(date_check)  ' if number passed convert to date
date_check = date2(date_check)
end if

' if number passed as text ie "35789" ' convert
if isstring(date_check)
for x = 1 to len(date_check)


if mid(date_check,x,1) == "." or\
   mid(date_check,x,1) == "/" or\
   mid(date_check,x,1) == "\"
its_a_date = true
exit for
end if

end for
end if

if its_a_date = true
' leave alone
else
date_check = date2(value(date_check))
end if

'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
'² WORKS UP TO YEAR 2079 !!!  after that im not bothered !!!   ²²²²²²²²²²²²²²²²
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
so_far = 0
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
for x = 1 to len(date_check)
this_char = mid(date_check,x,1)
so_far = so_far + 1

if this_char = "." or this_char = "/" or this_char = "\"
exit for
end if

end for
dot1 = so_far
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
so_far = 0
no_dots = 0

for x = 1 to len(date_check)
so_far = so_far + 1

this_char = mid(date_check,x,1)

if this_char = "." or this_char = "/" or this_char = "\"
no_dots = no_dots + 1
end if

if no_dots = 2
exit for
end if

end for
dot2 = so_far
'²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²
day = str(left(date_check,dot1-1))

start_pos = dot1+1
month_len = dot2-dot1-1   '  ie 2 for 01.01.97

month = str(mid (date_check,start_pos,month_len))

year = str(right(date_check,(len(date_check)-dot2)))

if value(year) <  80  ' CHANGE THIS IF YOU WANT DIFFERENT DATES SUPPORTED
year = str  (  2000   +   value(year)  )
end if

return_data = day|"/"|month|"/"|year
return return_data
END FUNCTION


FUNCTION ChooseBranch(cy,cx,n)
local dy #b_nr popstr i x
  vloadif(dpath|"branches.vws")
  if n=0 ' use all branches
    order change key "[Br_Init]"
    popstr = "All"
  elseif n=1  ' use Profit Centres only
    data query execute "profitcn.dfq" index "pc-1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Profit_Centre]="Y"                                                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    order sort now dictionary "pc-2.idx" fields "[SalesAnalysis]" ascending
    popstr = blank
  end if
  #b_nr = records                      'message "#b_nr is:"&str(#b_nr)
  for i = 1 to #b_nr
    popstr = popstr&[Br_KA]            'message "popstr is:"&str(popstr)
    data goto record next
  end for
  vunloadif("branches.vws")
  dy = @if((cy+#b_nr+2)>22,22,cy+#b_nr+2)  'message "dy) is:"&str(dy)
  x = popuplist(cy,cx,dy,popstr,"",1,0)    '  x = popuplist(cy,cx,23,popstr,"",1,0)
  if x = -1
    return (-1)
  else
    return (ptstr)
  end if
END FUNCTION ' ChooseBranch(cy,cx)


FUNCTION ChooseShop($b)
  case $b
    when "C"
      return "Clapham"
    when "F"
      return "Fulham"
    when "P"
      return "Putney"
    when "R"
      return "Raynes"
    when "S"
      return "Sheen"
    when "T"
      return "Trade"
    when "W"
      return "Warehouse"
    otherwise
    $shop_name = ChooseBranch(8,33,1)   'message "$shop_name is:"&str($shop_name)
    $shop=upper(left($shop_name,1))     'message "$shop is:"&str($shop)
  end case
END FUNCTION 'ChooseShop()


FUNCTION ChooseBranches(cy,cx,n)
local dy popstr i x j #b_nr
  vloadif(dpath|"branches.vws")
  data query execute "profitcn.dfq" index "pc-1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [Profit_Centre]="Y"                                                ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  order sort now dictionary "pc-2.idx" fields "[SalesAnalysis]" ascending
  popstr = blank
'   #b_nr = records                      'message "#b_nr is:"&str(#b_nr)

' message "areas is:"&str(areas)
  #b_nr=len(areas)
  for j=1 to len(areas)
    data goto record first
    while record<=records
      if [Br_Init] ! mid(areas,j,1)
        popstr = popstr&[Br_KA]        'message "popstr is:"&str(popstr)
        exit while
      else
        data goto record next
      end if
    end while
  end for
  vunloadif("branches.vws")

' message "popstr is:"&str(popstr)
  dy = @if((cy+#b_nr+2)>22,22,cy+#b_nr+2)  'message "dy) is:"&str(dy)
  x = popuplist(cy,cx,dy,popstr,"",1,0)    '  x = popuplist(cy,cx,23,popstr,"",1,0)
  if x = -1
    return (-1)
  else
    $shop_name = ptstr
    $shop = upper(left($shop_name,1))  '
  end if
END FUNCTION ' ChooseBranches(cy,cx)