'SRVRPROG - maintenance procedures to be done when server does daily reboot
'           use BE.EXE to confirm in AUTOEXEC.BAT

external   fentrybox() messbox() vloadif() chkdate() sch scw popuplist()
external   dpath remove() makeidx() addidxrec() progress() PrintReport()
external   chkstr() posnpopup() pmexe filedatime() zippath getidxrecs()
external   ipath progtag() fgp bgp fgi bgi cpath spath vunloadif() strcount()
external   $drive $a_drive tone() areas

public     ptstr $itemtype psa $ccwcode ptval ftgdate jobnr $b $branch $key
public     ftgperiod #int choice

global     ReturnToMenu() #prec Carpets() CCW_Code() $ccwidx DeleteResvns()
global     x #days $dd $mm $newname $filename $files zipage $chkfile $out
global     List_CPL_Jobs() CheckInStock() i Imminent() $procnow idx4name
global     PrintProvisional() PopFtgDate() $type REN_ZIPS_ACC() AllIndex()
global     dfname idxname i1 i2 idx2name repdef p2 p3 p4 p5 p6 PrintAnclReqd()
global     idx3name i3 $jobnr Jobs2PRC() prodcode #needed prodstr #stocked
global     PurgeFiles() CheckProcess() Shop_Gds() Customers() $branches
global     #branches Arc_Custs() SelectDrs() Collections() Suppliers()
global     REN_ZIPS_DB() UnInv() NewIndex() Noise() AmendFtgDate() maxdate
global     WriteTask() ImmtFittingDate() ImmtOrders()


MAIN
single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  file unload all
  $branches = "F P R S T W"
  #days = 32
  x = strcount($branches)
  #branches = ptval
  fopen "C:\errorlst.txt" as 1
  fwrite 1 from "Error in overnight rebuild"
  fclose 1
' message "STOP"
' remove("C:\errorlst.txt")
' message "$drive is"&$drive

  $out = "C:\overnite.txt"
  remove($out)

  remove(dpath|"CPL_ref.dat")
  remove(dpath|"rollnr.dat")
'   remove(ipath|"*.idx")
  x=remove(ipath|"*"|"_immt.idx")     'message "makeidx is:"&str(x)
  x=remove(ipath|"ordovr30.idx")     'message "makeidx is:"&str(x)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting Keys Update - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running KEYS_UPD ")
'    execute "keys_upd.rf3" in-memory
    WriteTask("Keys_Upd")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  messbox(" Starting AmendFtgDate - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
'     AmendFtgDate()
'     WriteTask("AmendFtgDate")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  Noise()
  messbox(" Starting UnInv - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    UnInv()
    WriteTask("UnInv")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting REN_ZIPS - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progtag(fgi,bgi," Copying DATA_OLD.ZIP & removing old zips ")
    REN_ZIPS_DB()  'copies current "DATA_OLD.ZIP" to archive directory and removes
    WriteTask("RenZips")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting ALLINDEX - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Rebuilding indices ")
    AllIndex()                           'rebuild indices for STK_CARP CCW's
    WriteTask("AllIndex")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

' purge files of deleted records - ????
'   messbox(" Starting PURGEFILES ",0,1,1)
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   progtag(fgi,bgi," Copying DATA_OLD.ZIP & removing old zips ")
'   PurgeFiles()
'   WriteTask("AllIndex")
'   messbox(" Starting IMMT Orders ",0,1,1)
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   progtag(fgi,bgi," Immt Orders ")
  messbox(" Starting IMMT orders - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running IMMT orders ")
    ImmtOrders()
    WriteTask("AllIndex")
  end if

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting PREPAPTF - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running PREPAPTF ")
    execute "prepaptf.rf3" in-memory
    WriteTask("PrepAptF")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting PREPAPTE - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running PREPAPTE ")
    execute "prepapte.rf3" in-memory
    WriteTask("PrepAptE")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

'   messbox(" Starting PURCHIDX ",0,1,1)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting PURCHIDX - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running PURCHIDX ")
    execute "purchidx.rf3" in-memory
    WriteTask("PurchIDX")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting AUTO_PRC - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running AUTO_PRC ")
    execute "auto_prc.rf3" in-memory
    WriteTask("Auto_PRC")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

'   messbox(" Starting REQN_IDX ",0,1,1)
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   execute "reqn_idx.rf3" in-memory
'   WriteTask("AllIndex")

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting SUPPRNGE - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running SUPPRNGE ")
    execute "supprnge.rf3" in-memory
    WriteTask("SuppRnge")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting PISUPINV - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running PISUPINV ")
    execute "PIsupinv.rf3" in-memory
    WriteTask("PISupInv")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

' process Reservations over 7 days to deleted status
'   screen clear box 1 1 sch scw 0 0 no-border
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   progtag(fgi,bgi," Running PREPAPPT ")
'   messbox(" Starting DELETERESVNS ",0,1,1)
'   DeleteResvns()
'   WriteTask("AllIndex")

' IMMINENT.PF3 to run with fixed span of 3 days inc. today
'   screen clear box 1 1 sch scw 0 0 no-border
'   messbox(" Starting IMMINENT ",0,1,1)
'   Imminent()

' Jobs to process; ALL bespoke items rec'd and ALL allocations made.
'   screen clear box 1 1 sch scw 0 0 no-border
'   messbox(" Starting JOBS2PRC ",0,1,1)
'   Jobs2PRC()

' create any messages re GDS_RCVD to print at shops
'   screen clear box 1 1 sch scw 0 0 no-border
'   messbox(" Starting SHOP_GDS ",0,1,1)
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   progtag(fgi,bgi," Running DP_MIN ")
'   Shop_Gds()

'   messbox(" Running LISTJOBS ",0,1,1)
'   progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
'   progtag(fgi,bgi," Running LISTJOBS ")
'   execute "listjobs.rf3" in-memory

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting LISTJOBS - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running LISTJOBS ")
    execute "listjobs.rf3" in-memory
    WriteTask("ListJobs")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  screen clear box 1 1 sch scw 0 0 no-border
  Noise()
  messbox(" Starting WKLYCASH - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running WKLYCASH ")
    execute "wklycash.rf3" in-memory
    WriteTask("WklyCash")
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

'   fclose 2
  ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Finished Server maintenance programs ",0,1,1)
  remove("C:\errorlst.txt")
  quit quit
END MAIN


FUNCTION SelectDrs()
  progress(15,10," Please wait ... finding balances ",1)
  progtag(fgi,bgi,"Creating index of Aged Drs ")
  vloadif(dpath|"cust_ord.vws")
  data query execute "drs_full.dfq" INDEX "first.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³  [Balance_Due]>.01 or [Balance_Due]<.01                            ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messbox(" No outstanding debtors to list ",0,0,1)
    return (1)
  end if

  data query execute "ageddrs1.dfq" index "third.idx"   ' choose o/s balances
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Branch] <> "C"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messbox(" No outstanding debtors at all!! ",0,0,1)
    return (1)
  end if
  progress(15,10," Please wait ... sorting balances ",0)
  order sort now dictionary ipath|"aged_drs.idx" fields "[Branch;Job_Nr]" ascending
END FUNCTION ' SelectDrs()


FUNCTION AllIndex()
'   screen clear box 1 1 sch scw 0 0 no-border
'   repaint off
'   vloadif(dpath|"stk_carp.vws")
'   data query execute "stcksize.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'    [BAR]>1
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'   if cerror
'     messbox(" No archived orders for branch"&$b&"˙",0,0,1)
'     return (0)
'   end if
'
' repaint on
' repaint
' single-step on
'   order sort now dictionary $drive|":\data\stcksiz2.idx" fields "[BAR]" ascending

  messbox(" Starting CUSTOMER indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running CUSTOMER indices ")
    Customers()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

'   Arc_Custs()

  messbox(" Starting DEBTOR indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running DEBTOR indices ")
    SelectDrs()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  messbox(" Starting CCW_CODES indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running CCW_CODES indices ")
    CCW_Code()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  messbox(" Starting CARPETS indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running CARPETS indices ")
    Carpets()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  messbox(" Starting COLLECTION indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running COLLECTION indices ")
    Collections()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

  messbox(" Starting SUPPLIER indices - press {n} to bypass ",0,1,1)
  smartpeek $_lastkey $key        'message "$key is:"&str($key)
  if $key = 110                   'message "NOT running PIsupinv"
  else                            'message "Starting PIsupinv"
    progress(15,10,"   ˙˙˙˙˙˙Running Server maintenance programs˙˙˙˙˙˙  ",1)
    progtag(fgi,bgi," Running SUPPLIER indices ")
    Suppliers()
  end if
  smartpoke $_lastkey 121         'message "$key is:"&str($key)

END FUNCTION ' AllIndex()


FUNCTION Suppliers()
  vloadif(dpath|"supplier.vws")
  order sort now dictionary ipath|"suppname.idx" fields "[Name]" ascending
  vunloadif("supplier.vws")
END FUNCTION ' Suppliers()


FUNCTION Collections()
  progress(15,10," Please wait ... finding A/c's for Collections ",0)
'   progtag(fgi,bgi,"Creating index of Aged Drs ")
  vloadif(dpath|"customer.vws")
  data query execute "collectn.dfq" INDEX "collect1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³  [Credit_Status]="N"
'    and
'    not (deleted)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    messbox(" No accounts for Collection status ",0,0,1)
    return (1)
  end if
  order sort now dictionary ipath|"collectn.idx" fields "[Customer_Name]" ascending
  file unload all
END FUNCTION ' Collections()


FUNCTION Arc_Custs()
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ create new index for Customer names in A_CSTORD & A_CSTMER files   ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  progress(fgp,bgp," Deleting old Arcived Customer indices on"&spath|"˙",0)
  file unload all
  screen shortrestore psa
  vloadif(dpath|"a_cstord.vws")
  order sort now dictionary ipath|"a_cstord.idx" fields "[Abbrv_Name]" ascending
  for i = 1 to #branches
    $b = group($branches,i)
    progtag(fgi,bgi,"Creating index of archives for branch"&$b)
    order change key "[Branch]"
    data query execute "branches.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Branch] = $b                                           ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
      messbox(" No archived orders for branch"&$b&"˙",0,0,1)
      continue for
    end if
    order sort now dictionary ipath|$b|"_arcord.idx" fields "[Abbrv_Name]" ascending
    order change physical
  end for
  vunloadif("a_cstord.vws")
END FUNCTION 'Arc_Custs()


FUNCTION Customers()
local    branchname
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ create new index for Customer names in CUST_ORD & CUSTOMER files   ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  	progress(fgp,bgp," Deleting old Customer indices on"&spath|"˙",0)
  	file unload all
  	for i = 1 to #branches
    		$b = group($branches,i)
  	end for
  	for i = 1 to #branches
    		$b = group($branches,i)
  	end for
  	screen shortrestore psa
  	progress(fgp,bgp," Building new index files for Customers ",1)
  	vloadif(dpath|"customer.vws")
'   order sort now dictionary ipath|"customer.idx" fields "[Abbrv_Name]" ascending
  	for i = 1 to #branches
    		$b = group($branches,i)   'message "$b is:"&$b
    		branchname=case $b ("F","Fulham") ("P","Putney") ("R","Raynes") ("S","Sheen") ("T","Trade") ("W","Warehouse")
    		progtag(fgi,bgi,branchname)
    		order change key "[Branch]"
    		data query execute "branches.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Branch] = $b                                           ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    		order sort now dictionary ipath|$b|"_custs.idx" fields "[Abbrv_Name]" ascending
    		order change physical
  	end for
  	vunloadif("customer.vws")

  	vloadif(dpath|"cust_ord.vws")
'   order sort now dictionary ipath|"cust_ord.idx" fields "[Abbrv_Name]" ascending
  	for i = 1 to #branches
    		branchname=case $b ("F","Fulham") ("P","Putney") ("R","Raynes") ("S","Sheen") ("T","Trade") ("W","Warehouse")
    		$b = group($branches,i)
    		progtag(fgi,bgi,branchname)
    		order change key "[Branch]"
    		data query execute "branches.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Branch] = $b                                           ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    		order sort now dictionary ipath|$b|"_orders.idx" fields "[Abbrv_Name]" ascending
    		order change physical
  	end for
    	order change physical
	data query execute "ordovr_1.dfq" index ipath|"ordovr30.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' days([Date_Of_Order])<(days(today)-30)
' and
' not (deleted)
' and
' abs([Balance_Due])>0.009
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
	vunloadif("cust_ord.vws")
END FUNCTION 'Customers()


FUNCTION CCW_Code()
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ create new indices for CCW codes                                   ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  progress(fgp,bgp," Deleting old indices on"&spath|"˙",0)
  file unload all
  remove(spath|"*.idx")                'delete old indices
  screen shortrestore psa
  progress(fgp,bgp," Building new index files ",1)
  vloadif(dpath|"colours.vws")
  data goto record first
  while precord <= precords
' if precord=950
' repaint on
' repaint
' single-step on
' end if
    $ccwcode = [CCW_Code]
    $ccwidx = $ccwcode|".idx"
    if file(spath|$ccwidx) = 1
      data goto record next
      continue while         ' if index for this Colours.Code exists - goto next record
    end if
    progtag(fgi,bgi,spath|$ccwidx)
    #prec = precord
    vloadif(dpath|"stk_carp.vws")
    order change key "[CCW_Code]"
    data query execute "ccw_indx.dfq" index spath|$ccwidx
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ [CCW_Code] = $ccwcode and [Active] = "Y"                           ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
' message "ERROR!!"
    end if
    vloadif(dpath|"colours.vws")
    order change physical
    data goto record record-number #prec
    if #prec = precords
      exit while
    end if
    data goto record next
  end while
END FUNCTION 'CCW_Code()


FUNCTION Carpets()
'delete old indices
  file unload all
  progress(fgp,bgp," Removing old index files ",0)
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ create new index for each group                                    ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  progress(fgp,bgp," Building new index files ",1)
  vloadif(dpath|"products.vws")
  progtag(fgi,bgi," Stock Carpet ")
  $itemtype = "C"            ' F2 - Stock Carpet           C
  order change key "[Item_Type]"
  data query execute "itemtyp1.dfq" index "x.idx"
  order sort now dictionary ipath|"stckcarp.idx" fields "[Product_MRC]" ascending

  $itemtype = "B"            ' F3 - Bespoke Carpet         B
  progtag(fgi,bgi," Bespoke Carpet ")
  order change key "[Item_Type]"
  data query execute "itemtyp1.dfq" index "x.idx"
  order sort now dictionary ipath|"bespcarp.idx" fields "[Product_MRC]" ascending

  $itemtype = "A"            ' F4 - Stock Ancillaries      A
  progtag(fgi,bgi," Stock Ancillaries ")
  order change key "[Item_Type]"
  data query execute "itemtyp1.dfq" index "x.idx"
  order sort now dictionary ipath|"stckancl.idx" fields "[Product_MRC]" ascending

  $itemtype = "J" or "O"     ' F5 - Bespoke Ancillaries    J
'   remove(ipath|"bespancl.idx")
  progtag(fgi,bgi," Bespoke Ancillaries ")
  order change key "[Item_Type]"
  data query execute "itemtyp4.dfq" index "x.idx"
  order sort now dictionary ipath|"bespancl.idx" fields "[Product_MRC]" ascending

  $itemtype = "F"            ' F8 - Labour                 F
'   remove(ipath|"labour.idx")
  progtag(fgi,bgi," Labour ")
  order change key "[Item_Type]"
  data query execute "itemtyp1.dfq" index "x.idx"
  order sort now dictionary ipath|"labour.idx" fields "[Product_MRC]" ascending

'   $itemtype = "V" or "W"     ' F6 - Vinyls                 V & W
'   remove(ipath|"vinyl.idx")
  progtag(fgi,bgi," Vinyls ")
  order change key "[Item_Type]"
  data query execute "itemtyp2.dfq" index "x.idx"
  order sort now dictionary ipath|"vinyl.idx" fields "[Product_MRC]" ascending

  progtag(fgi,bgi," Stock Tiles ")
  order change key "[Item_Type]"
  data query execute "itemtyp3.dfq" index "x.idx"
  order sort now dictionary ipath|"Stk_tile.idx" fields "[Product_MRC]" ascending

  progtag(fgi,bgi," Bespoke Tiles ")
  order change key "[Item_Type]"
  data query execute "itemtyp5.dfq" index "x.idx"
  order sort now dictionary ipath|"Bsp_tile.idx" fields "[Product_MRC]" ascending
END FUNCTION 'Carpets()


FUNCTION Jobs2PRC()
' index of all CUST_ORD records which are [Order_Status]="P"
  repaint off
  progress(15,10," Finding jobs to book fittings for ",0)
  vloadif(dpath|"immint_1.vw")
  order change key "[Order_Status]"
  data query execute "jobs2prc.dfq" index "jobs2prc.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Order_Status] = "P" and days([Fitting_Date])=0
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror                               '   if none - then return
    messbox(" No Jobs passed but without fitting date ",0,0,1)
    return (0)
  end if

  data goto record first
  for i1 = 1 to records                   ' check each job
    jobnr = [Job_Nr]                      ' message "This job to be checked"&jobnr
    $procnow = "Y"
'     progress(15,10," Finding jobs to book fittings for ",0)
    CheckProcess()
    vloadif(dpath|"immint_1.vw")
    if $procnow = "Y"
      addidxrec(idx4name,precord,6)   ' add to list of unrec'd req'ns
    end if
    $jobnr = [Job_Nr]
    data goto record next
  end for
  if records > 0
    PrintReport("jobs2prc.dfr","",1,1,3,1)
  end if
END FUNCTION ' Jobs2PRC()


FUNCTION Shop_Gds()
' print report for each shop of all bespoke goods rec'd for that Branch
' on previous day
END FUNCTION ' Shop_Gds()


FUNCTION DeleteResvns()
END FUNCTION ' DeleteResvns()

FUNCTION PurgeFiles()
END FUNCTION ' PurgeFiles()


FUNCTION Imminent()
  single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  file unload all
  repaint off
  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
  p6 = 1     ' p6 = nr of copies

  dfname   = "requsn"

  idxname  = "not_rcvd.idx"
  remove(idxname)
  makeidx(dfname,idxname,"0",3)

  idx2name = "ancl_ndd.idx"
  remove(idx2name)
  makeidx(dfname,idx2name,"0",8)

  idx3name = "prodistk.idx"
  remove(idx3name)
  makeidx("stk_ancl",idx3name,"0",9)

  idx4name = "procnow.idx"
  remove(idx4name)
  makeidx("cust_ord",idx4name,"0",10)

  PopFtgDate()                         ' message "date2(ftgdate) is:"&str(date2(ftgdate))

  x = List_CPL_Jobs()                      ' list all jobs due out on fitting date
  if x = 0
    exit function
  end if

  PrintProvisional()

END FUNCTION 'Imminent()


FUNCTION PrintAnclReqd()
' create list of each item req'd during period (in total) & amount held in stock
  order change index idx2name
  prodstr = ""
  data goto record first
  for i = 1 to records
    prodcode = [Product_Code]
    if chkstr(prodcode,prodstr)=0
      lock-record
        [Needed] = 0
      write-record
      if i = records
        data delete record
        exit for
      end if
      data delete record
      data goto record next
      continue for
    end if
    #needed = filesum([Length_Quantity],prodcode=[Product_Code])
    lock-record
      [Needed] = #needed
    write-record
    prodstr = prodstr&prodcode
    data goto record next
  end for
  if records > 0
    order sort execute dictionary "immint_3" index "ancl.idx" ' sort list by Date & Job Nr
    PrintReport("immint_3.dfr","",1,1,3,1)
    data query execute "activate.dfq"
  end if
END FUNCTION ' PrintAnclReqd()


FUNCTION PrintProvisional()
  vloadif(dpath|"immint_2.vw")
  progress(15,10," Please wait ... searching for imminent jobs ",0)

  order change index idxname
  if records > 0
    order sort execute dictionary "immint_2" index "notinstk.idx" ' sort list by Date & Job Nr
    PrintReport("immint_2.dfr",p2,p3,p4,3,p6)
  end if
'   progress(15,10," Please wait ... searching for imminent jobs ",0)
  PrintAnclReqd()

END FUNCTION 'PrintProvisional()


FUNCTION List_CPL_Jobs()               ' list all jobs for ftgdate
  progress(15,10," Please wait ... searching for imminent jobs ",0)
  vloadif(dpath|"immint_1.vw")
  order change key "[Fitting_Date]"
  data query execute "immtjobs.dfq" index "int.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'     [Fitting_Date] > date2(today)
'     and
'     [Fitting_Date] <= date2(ftgdate)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror                               '   if none - then return
    messbox(" No Jobs to be fitted upto & inc."&date2(ftgdate)|" ",0,0,1)
    return (0)
  end if

  if records > 0
    order sort execute dictionary "immint_1" index "cpl.idx" ' sort list by date & Branch
    PrintReport("immint_1.dfr",p2,p3,p4,3,p6)
  end if
  progress(15,10," Please wait ... searching for imminent jobs ",0)

  data goto record first
  for i1 = 1 to records                   ' check each job
    jobnr = [Job_Nr]                      ' message "This job to be checked"&jobnr
    $procnow = "Y"
    CheckInStock()
    vloadif(dpath|"immint_1.vw")
    if $procnow = "Y"
      addidxrec(idx4name,precord,6)   ' add to list of unrec'd req'ns
    end if
    $jobnr = [Job_Nr]
    data goto record next
  end for
END FUNCTION ' List_CPL_Jobs()


FUNCTION CheckInStock()
' search each job for req'ns then check each req'n to check that BESPOKE &
' STOCK are in stock - all Requsn's must have Roll_Nr
  vloadif(dpath|"immint_2.vw")
  order change physical
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "chk_reqn.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror                               '   if none - then return
    messbox(" No Requisitions for"&jobnr|". Check Fitting Date & reprocess ",0,0,1)
    return (0)
  end if

  data goto record first
  for i2 = 1 to records  ' check in stock ie. for types BJTW Roll_Nr <> BESPOK & types CSV <> 000/00
    $type = [Item_Type]
    if $type = "B" or $type = "J" or $type = "T" or $type = "W"
      if [Roll_Nr] = "BESPOK"
        $procnow = "N"
        addidxrec(idxname,precord,4)   ' add to list of unrec'd req'ns
      end if
    elseif $type = "C" or $type = "S" or $type = "V"
      if [Roll_Nr] = "000/00"
        $procnow = "N"
        addidxrec(idxname,precord,4)   ' add to list of unrec'd req'ns
      end if
    elseif $type = "A"
      addidxrec(idx2name,precord,6)   ' add to list of unrec'd req'ns
    end if
    data goto record next
  end for
  return (0)
END FUNCTION ' CheckInStock()


FUNCTION PopFtgDate()
local  x f1 f2 f3 f4 f5 f6 e1 e2 e3 e4 e5 e6 $date
while true
  if dayname(date2(today)) == "Monday"
    f3 = days(today)+2
  elseif dayname(date2(today)) == "Tuesday"
    f3 = days(today)+2
  elseif dayname(date2(today)) == "Wednesday"
    f3 = days(today)+2
  elseif dayname(date2(today)) == "Thursday"
    f3 = days(today)+2
  elseif dayname(date2(today)) == "Friday"
    f3 = days(today)+3
  elseif dayname(date2(today)) == "Saturday"
    f3 = days(today)+3
  else
    f3 = days(today)+3
  end if
  ftgdate = date2(f3)
  return (1)
end while
END FUNCTION ' PopFtgDate()


FUNCTION ReturnToMenu()
' close files and return
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  file unload all
END FUNCTION


FUNCTION CheckProcess()
  vloadif(dpath|"immint_2.vw")
  progtag(fgi,bgi," Job Nr:"&jobnr)
  order change key "[Job_Nr]"
  data query execute "job_reqn.dfq" index "chk_reqn.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr                                        ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror                               '   if none - then return
    $procnow = "N"
    return (0)
  end if

  data goto record first
  for i2 = 1 to records  ' check in stock ie. for types BJTW Roll_Nr <> BESPOK & types CSV <> 000/00
    $type = [Item_Type]
    if $type = "B" or $type = "J" or $type = "T" or $type = "W"
      if [Roll_Nr] = "BESPOK"
        $procnow = "N"
      end if
    elseif $type = "C" or $type = "S" or $type = "V"
      if [Roll_Nr] = "000/00"
        $procnow = "N"
      end if
    end if
    data goto record next
  end for
  return (0)
END FUNCTION ' CheckProcess()


FUNCTION REN_ZIPS_DB()
local zip_age d
  $filename = dpath|"data_old.zip"     'message "$filename is:"& $filename
  ptstr=date2(fileinfo($filename,f_datetime)) 'message "ptstr is:"&str(ptstr)
  $dd = left(ptstr,2)         'message "$dd is:"&str($dd)
  $mm = mid(ptstr,4,2)        'message "$mm is:"&str($mm)
  $newname = zippath|"data"|$dd|$mm|".zip" 'message "$newname is:"&str($newname)
  x = "copy"&$filename&$newname 'message "x is:"&str(x)
  tools os x
  $files = GETFNAMES(zippath|"*.ZIP",0) 'message "$files is:"&str($files)
  d = 1
  while GROUP($files,d)<>null          'message "GROUP($files,d) is:"&str(GROUP($files,d))
    $chkfile = zippath|group($files,d)|".ZIP" 'message "$chkfile is:"&str($chkfile)
    zip_age=int(fileinfo($chkfile,f_datetime)) 'message "zip_age is:"&str(zip_age)
' x=days(today)
' message "x is:"&str(x)
' x=#days     '
' message "x is:"&str(x)
    if days(today)-zip_age >= #days     'message "removing:"&str($chkfile)
      remove($chkfile)
    end if
    d = d + 1
  end while
END FUNCTION 'REN_ZIPS()


FUNCTION REN_ZIPS_ACC()
' message "$drive is :"&$drive
  $filename = $drive|":\bu_data\bu_accs.zip" 'message "$filename is:"& $filename
  filedatime($filename)                  'message "Date is"&group(ptstr,1)
  $dd = left(group(ptstr,1),2)           'message "$dd is:"&str($dd)
  $mm = mid(group(ptstr,1),4,2)          'message "$mm is:"&str($mm)
' message "zippath is :"&zippath
  $newname = zippath|"accs"|$dd|$mm|".zip" 'message "$newname is:"&str($newname)
  x = "copy"&$filename&$newname
  tools os x
  $files = GETFNAMES(zippath|"*.ZIP",0)
  x = 1
  while GROUP($files,x)<>null          'message "GROUP($files,x) is:"&str(GROUP($files,x))
    $chkfile = zippath|group($files,x)|".ZIP" 'message "$chkfile is:"&str($chkfile)
    filedatime($chkfile)               'message "group(ptstr,1) is:"&str(group(ptstr,1))
    zipage = days(group(ptstr,1))      'message "zipage is:"&str(zipage)
    if days(today)-zipage >= #days     'message "removing:"&str($chkfile)
      remove($chkfile)
    end if
    x = x + 1
  end while
END FUNCTION 'REN_ZIPS_ACC()


FUNCTION UnInv()
  screen clear box 1 1 sch scw 0 0 no-border
  progress(fgp,bgp," Deleting old Uninvoiced indices on"&ipath|"˙",0)
  file unload all
  vloadif(dpath|"cust_ord.vws")
  for i = 1 to #branches
    order change physical
    $branch = group($branches,i)
    remove(ipath|$branch|"_uninv.idx")
    NewIndex()
  end for
  vunloadif("cust_ord.vws")
END FUNCTION ' UnInv()


FUNCTION NewIndex()
  progress(fgp,bgp," Creating new Uninvoiced indices on"&ipath|"˙",0)
  progtag(fgi,bgi," Creating index for"&$branch)
  data query execute "cofsales.dfq" index "despat_1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [SalesAnalysis]=$branch
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
'     messboxwait(" No uninvoiced orders ",0,0,1)
    return (-1)
  end if
  data query execute "despat_2.dfq" index ipath|$branch|"_uninv.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Inv_Nr]=blank
'   and
'   not (deleted)
'   and
'   [SalesAnalysis]<>"X"
'   and
'   [SalesAnalysis]<>"P"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
'     messboxwait(" No uninvoiced orders ",0,0,1)
    return (-1)
  end if
  error on
END FUNCTION ' NewIndex()


FUNCTION Noise()
'   for i = 1 to 5
  for i = 1 to 1
    tone("error")
'     wait 1
  end for
END FUNCTION ' Noise()


FUNCTION AmendFtgDate()
  vloadif(dpath|"cust_ord.vws")
  repaint off
  data query execute "despat_2.dfq" index "uninv.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [Inv_Nr]=blank
'   and
'   not (deleted)
'   and
'   [SalesAnalysis]<>"X"
'   and
'   [SalesAnalysis]<>"P"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
  if cerror
    return (0)
  end if

  while record<=records
    jobnr = [Job_Nr]                   'message "jobnr is:"&str(jobnr)
    vloadif(dpath|"appntmnt.vws")
    order change physical
    data query execute "job_reqn.dfq" index "job_reqn.idx"
      progress(15,10," Revising Fitting Date  ",1)
      progtag(fgi,bgi," Job Nr"&jobnr)
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is:  [Job_Nr] = jobnr and not (deleted)                      ³
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
      vloadif(dpath|"cust_ord.vws")
      data goto record next
      continue while
    end if
    maxdate=filemax([Date])            'message "Max Date:"&date2(maxdate)
    vloadif(dpath|"cust_ord.vws")
    if days(maxdate)>days([Fitting_Date]) 'message "Changing Ftg Date to"&date2(maxdate)
      lock-record
        [Fitting_Date]=maxdate
      write-record
    end if
    data goto record next
  end while
  vunloadif("appntmnt.vws")
  vunloadif("cust_ord.vws")
END FUNCTION ' AmendFtgDate()


FUNCTION WriteTask(text1)
  fopen $out as 2
  fseek 2 EOF
  fwrite 2 from ""
  fwrite 2 from text1&"completed at"&time24
  fclose 2
END FUNCTION ' WriteTask()


FUNCTION ImmtFittingDate()
local  f3
  if dayname(today)="Monday"
    f3=days(today)+#int
  elseif dayname(today)="Tuesday"
    f3=days(today)+#int
  elseif dayname(today)="Wednesday"
    f3=days(today)+#int+2
  elseif dayname(today)="Thursday"
    f3=days(today)+#int+2
  elseif dayname(today)="Friday"
    f3=days(today)+#int+2
  elseif dayname(today)="Saturday"
    f3=days(today)+#int+1
  elseif dayname(today)="Sunday"
    f3=days(today)+#int+1
  end if
  ftgperiod = date2(f3)
' message "ftgperiod is:"&str(ftgperiod)
END FUNCTION ' ImmtFittingDate()


' FUNCTION ImmtOrders()
'   ImmtFittingDate()
'   file unload all
' ' message "#branches is:"&str(#branches)
' ' message "$branches is:"&str($branches)
'   progress(15,10," Searching for Goods not recv'd for imminent jobs ",0)
'
'   vloadif(dpath|"notrecvd.vw")
'   for i = 1 to #branches
'     $b = group($branches,i)   'message "$b is:"&$b
' '     branchname=case $b ("F","Fulham") ("R","Raynes") ("S","Sheen") ("T","Trade") ("W","Warehouse")
' '     progtag(fgi,bgi,branchname)
'     choice=$b
'     order change key "[Job_Nr]"
'     data query execute "shopimmt.dfq" index "int1.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '   left([Job_Nr],1) = choice
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'     if cerror
'       messbox(" NO outstanding goods for imminent jobs ",0,0,1)
'       x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
'       continue for
'     else
'       data query execute "immtjobs.dfq" index "int.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '     days([Date_Out]) > days(today)
' '     and
' '     days([Date_Out]) <= days(ftgperiod)
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'       if cerror
'         messbox(" NO outstanding goods for imminent jobs ",0,0,1)
'         x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
'         continue for
'       else
'         data query execute "cplprep2.dfq" index "int2.idx"
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '   [RollNr] = "00000/00"
' '   or
' '   [RollNr] = "BESPOK"
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
'         if cerror
'           messbox(" NO outstanding goods for imminent jobs ",0,0,1)
'           x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
'           continue for
'         end if
'       end if
'     end if
'     order sort now dictionary ipath|$b|"_immt.idx" fields "[Date_Out]" ascending
'   end for
'   vunloadif("notrecvd.vw")
' END FUNCTION 'ImmtOrders()


FUNCTION ImmtOrders()
  ImmtFittingDate()
  file unload all
' message "#branches is:"&str(#branches)
' message "$branches is:"&str($branches)
  progress(15,10," Searching for Goods not recv'd for imminent jobs ",0)

  vloadif(dpath|"notrecvd.vw")


'   for i = 1 to #branches
'     $b = group($branches,i)   'message "$b is:"&$b
' '     branchname=case $b ("F","Fulham") ("R","Raynes") ("S","Sheen") ("T","Trade") ("W","Warehouse")
' '     progtag(fgi,bgi,branchname)
'     choice=$b
'     order change key "[Job_Nr]"

  for i = 1 to #branches
    $b = group($branches,i)   'message "$b is:"&$b
'     branchname=case $b ("F","Fulham") ("R","Raynes") ("S","Sheen") ("T","Trade") ("W","Warehouse") ("P","Putney")
'     progtag(fgi,bgi,branchname)
    choice=$b                          'message "choice is:"&str(choice)
    order change key "[Job_Nr]"
    data query execute "shopimmt.dfq" index "int1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   left([Job_Nr],1) = choice
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    if cerror
      messbox(" NO outstanding goods for imminent jobs ",0,0,1)
' message "makeidx"
      x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
      continue for
    else
' message "ftgperiod is:"&str(ftgperiod)
      data query execute "immtjobs.dfq" index "int.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'     days([Date_Out]) > days(today)
'     and
'     days([Date_Out]) <= days(ftgperiod)
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
      if cerror
        messbox(" NO imminent jobs ",0,0,1)
' message "makeidx"
      x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
        continue for
      else
        data query execute "cplprep2.dfq" index "int2.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'   [RollNr] = "00000/00"
'   or
'   [RollNr] = "BESPOK"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
        if cerror
          messbox(" NO outstanding goods for imminent jobs ",0,0,1)
          x = makeidx("goodsout",ipath|$b|"_immt.idx","0",3)     'message "makeidx is:"&str(x)
' message "makeidx"
          continue for
        end if
      end if
    end if
'     order sort now dictionary "imm2.idx" fields "[Date_Out]" ascending
    order sort now dictionary ipath|$b|"_immt.idx" fields "[Date_Out]" ascending
'   end if
'     exit while
'   end while
  end for
  vunloadif("notrecvd.vw")
END FUNCTION 'ImmtOrders()