'ADDVARNX - same as ADD_VARN but no ReturnToMenu
' amended 28/06/02 to remove Trade order exclusion

external   fentrybox() messbox() vloadif() dpath shopmask scr findpopup()
external   sch scw progress() increment() ptval fgp bgp keybox() arytostr()
external   makeidx() userid cpath vatrate vunloadif() strcount()
external   chkdate() navrecs() entryline() messline() $menu base
external   popuplist() remove() PrintReport() exception() strtoary() fge bge
external   messboxwait() colpopup() nr8 mess4() colmessbox()
external   X_path _SWIP_Crystal() Xreppath

public     varnr invtot ptstr custcode dsa $newcust $place jobnr
public     ptary[6] jobs[6] $dayftr psa $enternow varndate

global     $newstat rcvd m4 ReturnToMenu() #refnr $complete AddVarn()
global     y lastbal $status custaddr1 y1 y2 y3 GetAuthCode() ' PrintVariation()
global     CheckJobNr() newrec deladdr1 $authcode ordstat1 EnterVar_n()
global     shop locn H_tel O_tel $type custname $method x datereceipt
global     orderdate recnr tel_locn telnr fentline $ordstat $jobstr
global     rcvdnr balancedue initbalance p1 p2 p3 p4 p5 p6 $test $msg fj
global     $branch ChangeAppts() #slotsrem nrslots #var vardesc custref notif
global     addslots


MAIN
single-step off
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off

  case base              ' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
    when "O"
      p4 = 2
    when "W"
      p4 = 2
    otherwise
      p4 = 1
  end case

  $authcode = ""
  p2 = ""   ' p2 = title at top of choice popup ("LABEL")
  p3 = 1    ' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
  p5 = 1    ' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
  p6 = 1    ' p6 = nr of copies

  while true
    x = CheckJobNr()                   ' check Job Nr exists in CUST_ORD
    if x = -1
      exit while
    elseif x = 1
      continue while
    end if
    x = EnterVar_n()                   ' enter details of Var'n
    if x = -1
      continue while
    end if
    $enternow = 1
    execute "ent_reqn.rf3" in-memory
  end while

  ReturnToMenu()

END MAIN


FUNCTION ReturnToMenu()
  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 ' ReturnToMenu()


FUNCTION EnterVar_n()
local $mask a1 a2 a3 a4 m4 $hdr
  while true
    vloadif(dpath|"addvarn1.vw")      'check if already used
    order change key "[Job_Nr]"
    data query execute "job_reqn.dfq" index "job_reqn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'   [Job_Nr] = jobnr
'   and
'   not(deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      x = messboxwait(" Invalid Order Nr"&jobnr,0,0,1)
      return (1)
    end if
    if records > 10
      x = messboxwait(" Max nr of Var'ns already entered ",0,0,1)
      return (-1)
    end if
    #refnr = filemax([#varnr])         'message "#refnr) is:"&str(#refnr)
    if cerror
      #refnr = 0
    end if
    varnr = jobnr|"-"|str(right("00"|str(#refnr+1),2)) 'message "varnr is:"&str(varnr)
    while true
      x = entryline(" Variation description - the Customer reads this! ",50,"","",21,5,72)
      if x = -1
        return (-1)
      elseif x = 0
        if ptstr = ""
          continue while
        end if
        vardesc = ptstr
        exit while
      end if
    end while

    while true
      while true
        x = entryline(" Gross Amount (inc VAT if any) of Variation Order ",8,"*8{[1234567890.\-]}","",21,5,72)
        if x = -1
          return (-1)
        elseif x = 0
          if ptstr = ""
            continue while
          end if
          #var = value(ptstr)
          exit while
        end if
      end while

      if #var < 0
        x = messline(" Confirm REDUCTION of invoice value of"&currency(#var)|"? (y/n) ",1,0,1,21,5,72)
        if ptstr == "y"
          exit while
        else
          continue while
        end if
      else
        x = messline(" Confirm ADDITION to invoice value of"&currency(#var)|"? (y/n) ",1,1,1,21,5,72)
        if ptstr == "y"
          exit while
        else
          continue while
        end if
      end if
    end while

    while true
      x = entryline(" Date of variation ",10,"##\/##\/####",today,21,5,72)
      if x = -1
        continue while
      elseif x = 0
        exit while
      end if
    end while
    varndate = ptstr

    while true
      x = entryline(" Customer's reference ",10,"","",21,5,72)
      if x = -1
        continue while
      elseif x = 0
        exit while
      end if
    end while
    custref = ptstr

    x = popuplist(16,53,22,"Phone Fax Letter OnÿSite AtÿShop","",1,0)
    notif = ptstr

    a1 = format(vardesc,"L50")
    a2 = format("Gross value:ÿÿÿÿÿÿÿÿÿÿ"&currency(#var),"L50")
'     a3 = format("Customer's reference:ÿ"&custref,"L50")
    a3 = format("Date & reference:ÿ"&date2(varndate)&custref,"L50")
    a4 = format("Notification method:ÿÿ"&notif,"L50")
    m4 = " Correct? (y/n) "
    $hdr = "Variation Nr"&varnr&"for Job Nr"&jobnr
    x = mess4(a1,a2,a3,a4,m4,$hdr)
    if ptstr == "y"
      exit while
    else
      continue while
    end if
  end while

  x = AddVarn(varnr,#var,vardesc,custref,notif,varndate)

END FUNCTION ' EnterVar_n()


FUNCTION Un_Sanct(newstat)
local $col $offset y
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
'   newstat = "S"
  vloadif(dpath|"apptdate.vws")
  order change physical
  for y = 1 to 7
    data goto record first
    for x = 1 to precords
      $col = "[A"|str(y)|"]"
      data find $col equal jobnr options ""
      if cerror
        data goto record next
        continue for
      else
        lock-record
          case (y)
            when 1
              [B1] = newstat
            when 2
              [B2] = newstat
            when 3
              [B3] = newstat
            when 4
              [B4] = newstat
            when 5
              [B5] = newstat
            when 6
              [B6] = newstat
            when 7
              [B7] = newstat
          end case
        write-record
        data goto record next
      end if
    end for
  end for
  vunloadif("apptdate.vws")
END FUNCTION 'Un_Sanct()


FUNCTION CheckJobNr()                     ' checks for JobNr - if not found
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  newrec = 0
  orderdate = today
  custname = ""
  invtot = 0
  orderdate = today
  screen clear box 1 1 sch scw 0 0 no-border
  while true
    x = fentrybox(" Job Nr for Variation Order - {Esc} to exit ",6,shopmask,"")
'     x = fentrybox(" Enter Job Nr or {Esc} to exit ",6,shopmask,"")
    if x = -1
      return (-1)
    elseif x = 0
      exit while
    end if
  end while
  jobnr = ptstr

  if $menu<>"boss"
'     if left(jobnr,1)="T"
'       messboxwait(" NO Variations permitted for Trade orders ",0,0,1)
'       return (-1)
'     end if
  end if
  vloadif(dpath|"addvarn2.vw")
  order change key "[Job_Nr]"
  progress(fgp,bgp," Checking for original order ",0)
  data find "[Job_Nr]" equal jobnr options ""
  if cerror                            '   if none - then return
    messbox(" Job not found ",0,0,1)
    return (1)
  else
    repaint on
    repaint
    messline(" Is this the original Order Nr? (y/n) ",1,1,1,21,5,72)
    if ptstr == "n"
      return (1)
    end if
    repaint off
    $complete = [Completed]
    ordstat1  = [Order_Status]
    nrslots   = [Appt_Slots]
    #slotsrem = [Slots_Rem]
  end if
'   if $complete = "Y"
  if [Invoice Nr] <> blank
    messboxwait(" Variation Order cannot be added - job already invoiced ",0,0,1)
    return (1)
  end if

  case (ordstat1)
    when "A"
      messboxwait(" Initial Order details must be entered first ",0,0,1)
      return (1)
    when "U"
      return (0)
    when "R"
      return (0)
    when "P"
      return (0)
    when "H"
      return (0)
    otherwise
      messboxwait(" Variation Order cannot be added because Order Status is"&ordstat1|"ÿ",0,0,1)
      return (1)
  end case
END FUNCTION ' CheckJobNr()


FUNCTION GetAuthCode()
  while true
    x = entryline(" Enter Reasons/comments etc ",20,"",$authcode,21,5,72)
    if ptstr = ""
      continue while
    end if
    if x = 0
      $authcode = ptstr
      if len($authcode) = 0
        messboxwait(" MUST enter reason/comments ",0,0,1)
        continue while
      end if
      exit while
    end if
  end while
END FUNCTION 'GetAuthCode()


FUNCTION ChangeAppts()
  messbox(" Current nr of App't slots is"&fixed(nrslots,0)&"("|fixed((nrslots-#slotsrem),0)&"booked) - alter? (y/n) ",1,0,1)
  if ptstr == "y"
    while true
      x = entryline(" Enter TOTAL nr of App't slots req'd ",2,"*2{[1234567890.]}","",21,5,72)
      if x = -1
        continue while
      end if
      addslots = value(ptstr) - nrslots
      return (0)
    end while
  else
    return (0)
  end if
END FUNCTION 'ChangeAppts()


FUNCTION AddVarn(varnr,#gross,$reas,$ref,$notif,$varndate)
local balancedue lastbal newtotal oldtotal newnet oldnet #prec x #as #sr
  x = ChangeAppts()                  ' change Appt_Slots if necessary
  vloadif(dpath|"addvarn3.vw")
  data enter lock
    [Var_Nr]        = varnr
    [VarnJobNr]     = left(varnr,6)
    [Amount_Gross]  = #gross
    [Reason]        = $reas
    [Customers_Ref] = $ref
    [Notif_Method]  = $notif
    [Date]          = $varndate
    [Entered_By]    = userid
  write-record

  lastbal = round([Balance_Due],2)
  balancedue = lastbal + #gross
  oldtotal = round([Invoice_Total],2)
  newtotal = oldtotal + #gross
  oldnet   = round([Net_Invoice],2)
  if [VAT]="S"
    newnet=oldnet + round(#gross*100/(100+vatrate),2)
  else
    newnet=oldnet + round(#gross,2)
  end if
  #as = nrslots + addslots
  #sr = #slotsrem + addslots
  lock-record
    [Appt_Slots]    = #as
    [Slots_Rem]     = #sr
    [Balance_Due]   = balancedue
    [Invoice_Total] = newtotal
    [Net_Invoice]   = newnet
    [Order_Status]  = "U"
  write-record

  #prec = precord
  remove("varnnote.idx")
  makeidx("variat_n","varnnote.idx",#prec,5)
  order change index "varnnote.idx"
  messline(" Print Variation Order? (y/n) ",1,1,1,21,5,72)
  if ptstr == "y"
    x = popuplist(18,53,23,"1ÿcopy 2ÿcopies","",1,0)
    if ptstr = "1ÿcopy"
      vunloadif("Xaddvarn.vws")
      remove(X_path|"Xaddvarn.*")
      data query execute "not_del.dfq" Smart4 X_path|"Xaddvarn" fields\
      "[Job_Nr|Bremail]"
      _SWIP_Crystal(Xreppath|"addvarn1","P",0,1,"")
      vloadif(dpath|"addvarn3.vw")
    else
      vunloadif("Xaddvarn.vws")
      remove(X_path|"Xaddvarn.*")
      data query execute "not_del.dfq" Smart4 X_path|"Xaddvarn" fields\
      "[Job_Nr|Bremail]"
      _SWIP_Crystal(Xreppath|"addvarn1","P",0,2,"")
      vloadif(dpath|"addvarn3.vw")
    end if
  end if
END FUNCTION 'AddVarn()

'   remove(X_path|"Xaddvarn.*")
'     vunloadif("Xaddvarn.vws")
'     ClearHardSpaces()
'   data query execute "not_del.dfq" data-file X_path|"X_mth_o" fields\
'   "[Var_Nr;Date;CustOrd_Name;Amount_Gross;shop;Date_To;Nr_Orders;Avg_Order;Tot_Order_Net;Tot_Order_Gross]"
'   vunloadif("X_mth_o.vws")