'PCSHENTX - same as PCSH_ENT but no ReturnToMenu

'090806 - use separate .dat file for each shop

external   vkeybox() sch scw progress() messbox() vloadif() base $menu userid
external   vunloadif() dpath fentrybox() chkdate() areas greeting cpath
external   popuplist() fgp bgp remove() Background() vatrate ChooseBranches()
external   _SWIP_Crystal() Xreppath X_path bpopdb() increment() messboxwait()

public     ptstr indate monthend fullmonth briefmonth enddate ptval
public     choice $shop_name $shop sum_date $shop_init

global     x ReturnToMenu() Report() nr Correct_YN() i Category() #vat $refnr
global     Description() EnterPrice() VAT_YN() $suncode #unitcost $nr_dat
global     s1 s2 s3 s4 s5 s6 s7 $place leftjob $cat $desc


MAIN
  single-step off
  Background()
  file unload all
  enddate=today

while true
' message "base is:"&str(base)
' message "areas is:"&str(areas)

  if base="O"
    x = popuplist(8,33,13,"HeadÿOffice Fulham Sheen Raynes Putney","",1,0)
    if x = -1
      ReturnToMenu()
    end if
  else
    x = ChooseBranches(8,33,areas)
    if x = -1
      ReturnToMenu()
    end if
  end if

  $shop_init = upper(left(ptstr,1))		'message "$shop_init is:"&str($shop_init)
  $shop_name = ptstr				'message "$shop_name is:"&str($shop_name)

  while true
    x = Category()			' choose category from database
    if x = -1
      exit while
    end if

    x = Description()			' additional narrative
    if x = -1
      continue while
    end if

    x = EnterPrice()
    if x = -1
      continue while
    end if

    x = VAT_YN()			' if yes; calculate VAT
    if x = -1
      continue while
    end if

    x = Correct_YN()			' if correct; enter new record and show REF NR for Shop to write down
    if x=1
      continue while
    end if
'     exit while
  end while

  x = Report()			' listing of P/cash NOT re-imbursed
end while

  ReturnToMenu()

END MAIN


FUNCTION ReturnToMenu()
  Background()
  file unload all
'   transfer cpath|"pm_menu.psl" in-memory
END FUNCTION ' ReturnToMenu()


FUNCTION Report()
  messbox(" Print list of unre-imbursed petty cash items? (y/n) ",1,1,1)
' yn - 1 allow Yes/No;o=disallow
' col- 1 for pleasing; 0 for error
' esc- 1 do NOT allow Esc;0=allow Esc
  if ptstr == "n"
    return (0)
  else
    vloadif(dpath|"pcsh_ent.vws")
    order change physical
    data query execute "pcshrep1.dfq" index "pcash1.idx"
' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
' [Shop]=$shop_init
' and
' not (deleted)
' and
' [ProcessDate]=blank
' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
    if cerror
      messboxwait(" No unpaid Petty Cash items for"&$shop_name,0,0,1)
    else
      remove(X_path|"Xpcshlst.*")
      data query execute "not_del.dfq" data-file X_path|"Xpcshlst" fields "[Date;ShopName;Shop;Ref_Nr;Category;SunCode;Narrative;VAT;Gross Amount]"
      vunloadif("Xpcshlst.vws")
      _SWIP_Crystal(Xreppath|"pcsh_lst","P",0,1,"")
    end if
  end if
END FUNCTION 'Report()


FUNCTION Description()
' enter add'n narrative
  while true
    x = fentrybox(" Enter description of item ",20,"","")
    if x = -1
      continue while
    end if
    $desc = ptstr
    exit while
  end while
END FUNCTION 'Description()


FUNCTION EnterPrice()
' enter price
  while true
    x = fentrybox(" Enter cost of item ",8,"*8{[1234567890.]}",#unitcost)
    if x = 0
      #unitcost = val(ptstr)
    else
      continue while
    end if
    exit while

  end while
END FUNCTION 'EnterPrice()


FUNCTION VAT_YN()		' is there VAT included in price
  messbox(" Does this price include VAT? (y/n) ",1,1,1)
  if ptstr == "n"
    return (0)
  else
    #vat=#unitcost-(#unitcost/(1+(vatrate/100)))
  end if
END FUNCTION 'VAT_YN()


FUNCTION Category()			' select Category from dbase
  vloadif(dpath|"pcsh_cat.vws")
  while true
    if $shop_init="H"
      x = bpopdb("pcsh_cat",5,"","[Category]","L20","[sun_hof]","L0","[sun_hof]",3,29,22,51,"",0)
      if x = -1
        repaint off
        vunloadif("pcsh_cat.vws")
        return(-1)
      else
        $suncode    = ptstr                'message "suncode is:"&str($suncode)
        $cat        = [Category]	   'message "$cat) is:"&str($cat)
        Background()
      end if
      repaint off
      return (0)

    elseif $shop_init="F"		'message "FULHAM selected"
      x = bpopdb("pcsh_cat",5,"","[Category]","L20","[sun_ful]","L0","[sun_ful]",3,29,22,51,"",0)
      if x = -1
        repaint off
        vunloadif("pcsh_cat.vws")
        return(-1)
      else
        $suncode    = ptstr                'message "suncode is:"&str($suncode)
        $cat        = [Category]	   'message "$cat) is:"&str($cat)
        Background()
      end if
      repaint off
      return (0)

    elseif $shop_init="P"		'message "PUTNEY selected"
      x = bpopdb("pcsh_cat",5,"","[Category]","L20","[sun_put]","L0","[sun_put]",3,29,22,51,"",0)
      if x = -1
        repaint off
        vunloadif("pcsh_cat.vws")
        return(-1)
      else
        $suncode    = ptstr                'message "suncode is:"&str($suncode)
        $cat        = [Category]	'message "$cat) is:"&str($cat)
        Background()
      end if
      repaint off
      return (0)

    elseif $shop_init="R"		'message "RAYNES selected"
      x = bpopdb("pcsh_cat",5,"","[Category]","L20","[sun_ray]","L0","[sun_ray]",3,29,22,51,"",0)
      if x = -1
        repaint off
        vunloadif("pcsh_cat.vws")
        return(-1)
      else
        $suncode    = ptstr                'message "suncode is:"&str($suncode)
        $cat        = [Category]	'message "$cat) is:"&str($cat)
        Background()
      end if
      repaint off
      return (0)

    elseif $shop_init="S"
      x = bpopdb("pcsh_cat",5,"","[Category]","L20","[sun_shn]","L0","[sun_shn]",3,29,22,51,"",0)
      if x = -1
        repaint off
        vunloadif("pcsh_cat.vws")
        return(-1)
      else
        $suncode    = ptstr                'message "suncode is:"&str($suncode)
        $cat        = [Category]	'message "$cat) is:"&str($cat)
        Background()
      end if
      repaint off
      return (0)

    else
message "No Shop selected"
    end if
  end while
END FUNCTION 'Category()


FUNCTION Correct_YN()
local $correct
  if #vat>0
    $correct=$cat&"-"&$desc&"costing"&fixed(#unitcost,2)&"(inc VAT)"
  else
    $correct=$cat&"-"&$desc&"costing"&fixed(#unitcost,2)&"(no VAT)"
  end if
  messbox($correct&"? (y/n) ",1,1,1)
  if ptstr == "n"		' if no - retain variables and loop
    return (0)
  elseif ptstr == "y"		' if yes - data enter new etc., clear variables and restart
    $nr_dat=dpath|$shop_init|"pcshref.dat"	'message "$nr_dat is:"&str($nr_dat)
    fopen $nr_dat as 1       ' get next ref nr
    fread 1 into ptval		'message "ptval) is:"&str(ptval)
    fclose 1
    $refnr = right("000000"|str(ptval),6)
    increment($nr_dat,1)   ' increase counter
    clear ptval                          'message "$refnr is:"&str($refnr)

    vloadif(dpath|"pcsh_ent.vws")
    data enter lock
      [Date]		=today
      [Shop]		=$shop_init
      [ShopName]	=$shop_name
      [Ref_Nr]		=$refnr
      [Category]	=$cat
      [SunCode]		=$suncode
      [Narrative]	=$desc
      [VAT]		=#vat
      [Gross Amount]	=#unitcost
    write-record
    messboxwait(" Reference number for that payment is"&$refnr,0,0,1)
    clear $refnr $cat $desc #vat #unitcost
    vloadif(dpath|"pcsh_cat.vws")
  end if
END FUNCTION 'Correct_YN()


