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

'    be ask "Run data maintenance programs? (y/n)" yn default=y timeout=5
'    if errorlevel 2 goto end1
'    if errorlevel 1 goto server
'    :server
'    srvr_mgt.bat (C:\angoss\bin\angossx d -oi server.pf3)
'    :end1

external   fentrybox() messbox() vloadif() chkdate() sch scw popuplist()
external   dpath remove() makeidx() addidxrec() progress() PrintReport()
external   chkstr() posnpopup() pmexe filedatime() apath getidxrecs()
external   ipath progtag() fgp bgp fgi bgi cpath spath

public     ptstr $itemtype psa $ccwcode ptval ftgdate jobnr

global     ReturnToMenu() #prec Carpets() CCW_Code() $ccwidx DeleteResvns()
global     x #days $dd $mm $newname $filename $files zipage $chkfile
global     List_CPL_Jobs() CheckInStock() i Imminent() $procnow idx4name
global     PrintProvisional() PopFtgDate() $type REN_ZIPS() CCW_INDX()
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()


MAIN
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Starting REN_ZIPS ",0,1,1)
'   REN_ZIPS()  'copies current "DATA_OLD.ZIP" to archive directory and removes
              'any ZIPS over 7(?) days

  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Starting CCW_INDX ",0,1,1)
'   CCW_INDX()  'rebuild indices for STK_CARP CCW's
'				 each unique colour in STK_CARP.db
'				 PRODUCTS file by ItemType
'				 REQUSN's for each active job
'19/12/94 - add index to track O/S purchases ?
'19/12/94 - add index of CUST_ORD's held up by PURCHORD items not rec'd
'   add to this index when goods are ordered and remove when PURCHORD is
'   rec'd in FULL

' purge files of deleted records - ????
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Starting PURGEFILES ",0,1,1)
'  PurgeFiles()

' process Reservations over 7 days to deleted status
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Starting DELETERESVNS ",0,1,1)
'  DeleteResvns()

' 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)
  Shop_Gds()

  ReturnToMenu()
  screen clear box 1 1 sch scw 0 0 no-border
  messbox(" Finished Server maintenance programs ",0,1,1)
  quit quit
END MAIN


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 REN_ZIPS()
single-step off
  #days = 7
  $filename = dpath|"data_old.zip"
  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)
  $newname = apath|"data"|$dd|$mm|".zip" 'message "$newname is:"&str($newname)
  x = "copy"&$filename&$newname
  tools os x

  $files = GETFNAMES(apath|"*.ZIP",0)
  x = 1
  while GROUP($files,x)<>null          'message "GROUP($files,x) is:"&str(GROUP($files,x))
    $chkfile = apath|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)
'     else
' message "not old enough"
    end if
    x = x + 1
  end while
END FUNCTION 'REN_ZIPS()


FUNCTION CCW_INDX()
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   messbox(" Rebuild indices for all STK_CARP records? (y/n) ",1,1,1)
'   if ptstr == "n"
'     ReturnToMenu()
'   end if

  CCW_Code()

  Carpets()

END FUNCTION ' CCW_INDX()


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|"stk_carp.vws")
  data goto record first

  while precord <= precords
    $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,$ccwidx)
    #prec = precord
    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

    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)
  remove(spath|"*.idx")
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ create new index for each group                                    ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  progress(fgp,bgp," Building new index files ",1)
' message "STOP"

  vloadif(dpath|"products.vws")
  remove(ipath|"stckcarp.idx")
  progtag(fgi,bgi," Stock Carpet ")
  $itemtype = "C"            ' F2 - Stock Carpet           C
  order change key "[Product_Code]"
  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
  remove(ipath|"bespcarp.idx")
  progtag(fgi,bgi," Bespoke Carpet ")
  order change key "[Product_Code]"
  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
  remove(ipath|"stckancl.idx")
  progtag(fgi,bgi," Stock Ancillaries ")
  order change key "[Product_Code]"
  data query execute "itemtyp1.dfq" index "x.idx"
  order sort now dictionary ipath|"stckancl.idx" fields "[Product_MRC]" ascending

  $itemtype = "J"            ' F5 - Bespoke Ancillaries    J
  remove(ipath|"bespancl.idx")
  progtag(fgi,bgi," Bespoke Ancillaries ")
  order change key "[Product_Code]"
  data query execute "itemtyp1.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 "[Product_Code]"
  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 "[Product_Code]"
  data query execute "itemtyp2.dfq" index "x.idx"
  order sort now dictionary ipath|"vinyl.idx" fields "[Product_MRC]" ascending

'   $itemtype = "S" or "T"     ' F7 - Tiles                  S & T
  remove(ipath|"tiles.idx")
  progtag(fgi,bgi," Tiles ")
  order change key "[Product_Code]"
  data query execute "itemtyp3.dfq" index "x.idx"
  order sort now dictionary ipath|"tiles.idx" fields "[Product_MRC]" ascending
END FUNCTION 'Carpets()


FUNCTION CheckProcess()
  vloadif(dpath|"immint_2.vw")
'   order change physical
  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
'     messbox(" No Requisitions for"&jobnr|". Check Fitting Date & reprocess ",0,0,1)
    $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()