'CHCKMEAS - creates "Z" req'ns when a carpet is check-measured
'           Needs to be + or -.
' set to put a * in[ChckMeas] box if remaining length is < 10 - L252
external   messbox() fentrybox() dpath vloadif() sch scw workers chkstr()
external   vunloadif() scr userid increment() rollmask mess4() messboxwait()
external   popuplist() pagerec() PrintReport() exception() colpopup()
external   X_path _SWIP_Crystal() Xreppath remove()

public     ptstr ptval $rollnr dsa $faxees

global     EnterRolls() $unitcost #new_bal #old_bal ReturnToMenu() #new_BAR
global     prodcode #width desMRC prodMRC refcode x m4 Titles() $comp
global     CreateWriteOffReqn() $backing $meas a5 ReduceBalance() $diff
global     a1 a2 a3 a4 CancelResvns() #diff $mess cat #replen #old_BAR $wo
global     ShowResvns()	#unitcost $smlr $disc #reqncost cr #new_PHYS #old_PHYS
global     NewBalance() i $f p1 p2 p3 p4 p5 p6 Unable2Cut() locn Location()


MAIN
single-step off
' quiet 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

  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  error off
  #replen = 1
  $faxees = ""
  while true
    cr = 0                          ' flag to show whether Res'v'ns have been cancelled
    x = EnterRolls()                ' show unallocated REQUSN's to move and select REQUSN.
    if x = -1
      exit while
    end if
  end while

  ReturnToMenu()                        ' unload screens

END MAIN


FUNCTION EnterRolls()
  while true
    x = fentrybox(" Enter Roll Nr to adjust - {Esc} to finish ",8,rollmask,"")
    if x = 0
      $rollnr = ptstr
      vloadif(dpath|"products.vws")
      vloadif(dpath|"STK_CARP.vws")
      order change key "[RollNr]"
      data find "[RollNr]" equal $rollnr options "gw"
      if cerror
        messbox(" Roll Nr not found - re-enter ",0,0,1)
        return (0)
      else
        if [Active]="N"
          messboxwait(" Marked as INACTIVE - inform office before proceeding ",0,0,1)
          return (0)
        end if
        #old_BAR = [BAR]               'message "#old_BAR is:"&str(#old_BAR)
        #old_PHYS= [PhysicalBalance]   'message "#old_PHYS is:"&str(#old_PHYS)
        #old_bal = [Balance]           'message "#old_bal is:"&str(#old_bal)
        prodcode = [Product_Code]
        desMRC   = [Description_MRC]
        #width   = [Width]

        $backing = filelookup([products.Product_Code],[products.Backing],prodcode)
        prodMRC  = filelookup([products.Product_Code],[products.Product_MRC],prodcode)
        $smlr = filelookup([products.Product_Code],[products.SM_List_Rolls],prodcode)
        $disc = filelookup([products.Product_Code],[products.Discount_%],prodcode)

        a1 = format("Code:"&prodcode&left(prodMRC,30),"M46") 'message "len(a1)) is:"&str(len(a1))
        a2 = format(desMRC&"("|$backing|")","M46")
        a3 = format("Balance shown in stock:"&fixed(#old_PHYS,2)|"m","M46")
        a4 = format("(after resvn's:"&fixed(#old_BAR,2)|"m)","M46")
        m4 = " Correct Roll? (y/n) "
        x = mess4(a1,a2,a3,a4,m4,"")
        if x = 0
          if ptstr == "y"
            vunloadif("PRODUCTS.vws")
            x=NewBalance()
            if x = -1
              return (1)
            end if
            Location()
          else
            continue while
          end if
        else
          message "MESS4 failed in SHRTMEAS - inform David Guyan"
          return (-1)                        ' unload screens
        end if
      end if
    elseif x = -1
      return (-1)
    else
      message "FENTRY Error:"&str(x)
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      return (-1)
    end if
  end while
END FUNCTION ' EnterRolls()


FUNCTION ReduceBalance()
  vloadif(dpath|"STK_CARP.vws")
  order change key "[RollNr]"
  data find "[RollNr]" equal $rollnr options "gw"
  if cerror
    messbox(" Roll Nr not found - re-enter ",0,0,1)
    ReturnToMenu()
  else
    vloadif(dpath|"STK_CARP.vws")     ' message "#new_PHYS is:"&str(#new_PHYS)
    lock-record
      [PhysicalBalance] = value(#new_PHYS)
      [Balance] = value(#new_bal)
      [BAR]     = value(#new_BAR)
    write-record
  end if
END FUNCTION


FUNCTION ShowResvns()	
local $puar
  repaint off
  vloadif(dpath|"vu_resvn.vw")
  order change key "[RollNr]"
  data query execute "vu_rsvn1.dfq" index  "x.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'      [RollNr] = $rollnr
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messboxwait(" NO reservations found for this roll ",0,0,1)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    return (1)
  end if
  data query execute "vu_rsvn2.dfq" index  "showrsvn.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'      [Reserved] ! "R"
'        and
'      not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
    messboxwait(" NO reservations found for this roll ",0,0,1)
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    return (1)
  end if
  repaint on
  repaint
  Titles()
  pagerec(1,0)
  if records > 9
    screen print 20 27 15 1 (format(" "|chr(24)&chr(25)&" more stock to view ","M27"))
  end if
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  return (0)
END FUNCTION '  ShowResvns()	


FUNCTION CreateWriteOffReqn()
local a1 a2 a3 a4
  while true
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Generate reference nr                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    increment(dpath|"dog_ends.dat",1)
    refcode = "Z"|right("00000"|str(ptval),5)|"-CM"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Confirm entry of check measure                                     ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    a1 = format(left($rollnr&"-"&prodMRC,30),"M30")
    a2 = format("Length measured:- "|format(str(#new_PHYS),"2R")|"m","M30")
    a3 = format("On:"&date2(today)&"by"&$meas,"M30")
    a4 = @if(#diff=0,"No change",format(a5&fixed(abs(#diff),2),"M30"))
    m4 = " Correct? (y/n) "
    scr = scr + 1
    x = mess4(a1,a2,a3,a4,m4,"")
    scr = scr - 1
    if x = 0
      if ptstr == "n"
        return (-1)
      end if
    else
      message "MESS4 failed in SHRTMEAS - inform David Guyan"
      ReturnToMenu()                        ' unload screens
    end if

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³  Calculate req'n cost                                              ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    #unitcost = $smlr*(1-($disc/100))
    #reqncost = value(#diff)*value(#width)*value(#unitcost)
    while true
      if #diff>1
        x = popuplist(8,33,13,"damaged wronglyÿcut other","",1,0)
        if ptstr = "other"
          x = fentrybox(" Enter reason ",13,"","")
          if x = -1
            continue while
          end if
          $meas = $meas&"-"&ptstr
          exit while
        end if
      else
        x = popuplist(8,33,13,"CORRECT! damaged wronglyÿcut minorÿdiff","",1,0)
        $meas = $meas&"-"&ptstr
        exit while
      end if
    end while

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Create req'n                                                       ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    vloadif(dpath|"requsn.vws")
    data enter lock
      [Reference_Nr]       = refcode 	' assign [Reference_Nr] to record
      [Job_Nr]             = left(refcode,6)
      [Product_Code]       = prodcode
      [Description_MRC]    = desMRC
      [Product_MRC]        = prodMRC
      [Width]              = #width
      [Length_Quantity]    = #diff
      [Quant_OS]           = 0
      [Cost]               = fixed(#reqncost,2)
      [Cost_OS]            = 0
      [Comment]            = "CM"&$meas
      [Date_Requisitioned] = today
      [Created/Changed_By] = userid
      [Status]             = "F"
      [RollNr]             = $rollnr
      [Item_Type]          = "C"
      [Branch]             = "Z"
    write-record

    if abs(#diff) > #replen
      $mess = "Diff on CHCKMEAS of"&$rollnr&"was"&fixed(abs(#diff),2)|"m"&$comp&"("|$meas|"/"|userid|")"
'       cat = "STOCK"
      cat = "CHCKMEAS"
      x = exception(userid,today,time24,cat,$mess)
      vunloadif(dpath|"unread1.vw")
    end if
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Mark RollNr with "*" to show it has been check measured
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    vloadif(dpath|"STK_CARP.vws")
    if #new_PHYS<10
      lock-record
        [ChckMeas] = "*"
      write-record
    end if
    return (0)
  end while
END FUNCTION ' CreateReqn()


FUNCTION ReturnToMenu()
   screen clear box 1 1 sch scw 0 0 no-border
   repaint off
   file unload all
   transfer "pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION Titles()
  a2 = format($rollnr|"-"|left(prodMRC,28),"M35")
  a3 = format(left(desMRC,26)&"("|$backing|")","M35")
  screen print 6 24 15 1 a2
  screen print 7 24 15 1 a3
  screen print 8 24 15 1 (format("Reservations to be deleted","M35"))
  screen print 17 24 15 1 (format(" Press {Esc} to continue ","M35"))
END FUNCTION 'Titles()


FUNCTION CancelResvns()	
' p1 = "canc_rsv.dfr"   ' p1 = report definition ("ord_stck.dfr")
	$f = ""
  	vloadif(dpath|"vu_resvn.vw")
  	order change index "showrsvn.idx"
  	for i = 1 to records
    		$f = left([Comment],6)             ' message "$f) is:"&str($f)
    		if chkstr($f,$faxees) = 0
      		data goto record next
    		else
      		$faxees = $faxees&$f
      		data goto record next
    		end if
  	end for
' message "$faxees is:"&str($faxees)
' repaint on
' repaint
' single-step on

  	vunloadif("Xchkmeas.vws")
  	remove(X_path|"Xchkmeas.*")
  	data query execute "not_del.dfq" Smart4 X_path|"Xchkmeas" fields\
"[Job_Nr;Comment;Date_Reserved;Length_Quantity;Roll_Nr;Product_Code;Product_MRC;Description_MRC]"
'   "[Var_Nr;Date;CustOrd_Name;Amount_Gross;shop;Date_To;Nr_Orders;Avg_Order;Tot_Order_Net;Tot_Order_Gross]"
  _SWIP_Crystal(Xreppath|"Xchkmes1","S",0,1,"")

'   PrintReport(p1,p2,p3,p4,p5,p6)
  data goto record first
  for i = 1 to records
    lock-record
      [Reserved]            = "D"
      [Date_Status_Changed] = date2(today)
      [Comment]             = "Del'd short ChckMeas"
      [Length_Quantity]     = 0
      [Status]              = "D"
      [RollReserve]         = "NA"
    write-record
    data goto record next
  end for
END FUNCTION 'CancelResvns()


FUNCTION NewBalance()
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Enter check length recorded  & confirm length                      ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  while true
    x = fentrybox(" Enter length measured or {Esc} to exit ",5,"","")
    if x = 0
      #new_PHYS = value(ptstr)
      if #new_PHYS > [Stock_Delivered]
        messboxwait(" Measurement is greater than delivered length - contact Office ",0,0,1)
        continue while
      end if
      x = messbox(" Confirm measured length of"&fixed(#new_PHYS,2)|"m ? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
    else
      return (0)
    end if

    #diff = #old_PHYS - #new_PHYS
    if #diff < 0
      $comp = "LONGER"
      x = messbox(" Confirm check measure was"&$comp|"? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
      a5 = "Balance INCREASED by"
    elseif #diff > 0   ' check showed shorter
      $comp = "SHORTER"
      x = messbox("  Confirm check measure was"&$comp|"? (y/n)",1,1,1)
      if ptstr == "n"
        continue while
      end if
      a5 = "Balance REDUCED by"
    elseif #diff = 0
      a5 = "No change"
    end if

    #new_BAR = #old_BAR - #diff    'message "#new_BAR is:"&str(#new_BAR)
    #new_bal = #old_bal - #diff    'message "#new_bal is:"&str(#new_bal)
' message "#new_PHYS is:"&str(#new_PHYS)
    if #new_bal < 0
      messboxwait(" Uncut allocations - print list ",0,0,1)
      Unable2Cut()
      return (-1)
    end if

' check if #diff greater than BAR
    if #new_BAR < 0
repaint on
repaint
single-step on
      x = ShowResvns()	
      if x = 0
        messbox(" Write-off is more than BAR, deleting reservations - continue? (y/n)",1,1,1)
        if ptstr == "n"
          continue while
        else
          #new_BAR = #new_bal
          CancelResvns()	
        end if
      end if
    end if

    exit while
  end while

' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ Enter name of person who measured carpet                           ³
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
'   screen shortrestore dsa

're-instate
  while true
    x = popuplist(8,33,14,workers,"Measurer",1,0)
    if x = 0
      $meas = ptstr
      exit while
    elseif x = -1
      x = fentrybox(" Enter name of measurer ",6,"","")
      if x = 0
        $meas = ptstr
        exit while
      elseif x = -1
        continue while
      end if
    end if
  end while

  x = CreateWriteOffReqn()
  if x = 0
    ReduceBalance()
    return (1)
  end if
END FUNCTION ' NewBalance()


FUNCTION Unable2Cut()
'list resvns which have not yet been cut - [Quant_OS]>0
  vloadif(dpath|"requsn.vws")
'   order change key "[RollNr]"
  data query execute "uncut1.dfq" index "uncut1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [RollNr] = $rollnr
'   and not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
' messboxwait(" Printing SAT note for ",0,0,1)
  end if
  vloadif(dpath|"uncut.vw")
  order change index "uncut1.idx"
  data query execute "uncut2.dfq" index "uncut2.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' ³ [RollNr] = $rollnr
'   and [Quant_OS]>0
'   and not (deleted)
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
  if cerror
' messboxwait(" Printing SAT note for ",0,0,1)
  end if
END FUNCTION ' Unable2Cut()


FUNCTION Location()
  while true
    messbox(" Is the carpet being returned to the same location? (y/n) ",1,1,1)
    if ptstr == "y"
      exit while
    end if

    repaint off
    x = colpopup(4,1,19,"Whse Shop Site","",1,0,14,11,0,15)
    locn      = str(ptstr)
'|
    if locn="Whse"
      while true
        x = colpopup(4,10,19,"Unitÿ19 Unitÿ32 Showroom","",1,0,14,11,0,15)
        locn      = str(ptstr)
        if locn="Unitÿ19"
          x = colpopup(4,21,19,"A B C D E F G H J K","",1,0,14,11,0,15)
          locn="19"|str(ptstr)
          x = colpopup(4,26,19,"1 2 3 4","Level",1,0,14,11,0,15)
          locn=locn|str(ptstr)
          messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
          if ptstr=="y"
            lock-record
              [Location]=locn
            write-record
            return (0)
          else
            continue while
          end if
        elseif locn="Unitÿ32"
          x = colpopup(4,21,19,"L M N P Q R S T U V W X Y Z ANCL SMPL","",1,0,14,11,0,15)
          if ptstr="ANCL" or ptstr="SMPL"
            locn=ptstr
            x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
            if ptstr=="y"
              lock-record
                [Location]=locn
              write-record
              return (0)
            else
              continue while
            end if
          end if
          locn="32"|str(ptstr)
          x = colpopup(4,26,19,"1 2 3 4","Level",1,0,14,11,0,15)
          locn=locn|str(ptstr)
          x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
          if ptstr=="y"
            lock-record
              [Location]=locn
            write-record
            return (0)
          end if
        elseif locn="Showroom"
          x=messbox(" Is location -"&locn&"- correct? (y/n) ",1,1,1)
          if ptstr=="y"
            lock-record
              [Location]="SHOW"
            write-record
            return (0)
          else
            continue while
          end if
        end if
      end while
    end if
  end while
END FUNCTION 'Location()