'CUST_CR  - alter credit/delivery status & limits for customers
' Account types:
'	A - Retail Account  - collection without prior payment - RETAIL prices
'	N - Trade  Account  - collection without prior payment - TRADE prices
'	D - Delayed Invoice - collection without prior payment - RETAIL prices
'	C - Retail Cash     - collection ONLY after payment    - RETAIL prices
'	T - Trade Cash      - collection ONLY after payment    - TRADE prices

external   fentrybox() dpath cpath vloadif() vunloadif() ipath progress()
external   fgp bgp sch scw scr navrecs() popuplist() entryline() Background()
external   bpopdb() messbox() messboxwait() WC() messline()

public     custname ptstr ptval dsa

global     oldlimit newlimit x abbrv_name ChangeLimit() $chg $profile idxname
global     BrowseCustomers() SelectProfile() NewProfile() SetupScreens() po1 po2 po3
global     po4 po5 PermitCollections() Collections() ChkDeleted()


MAIN
single-step off
  $chg = "N"
  while true
    Background()
    error off
    file unload all
    while true
      window close
      if cerror
        exit while
      end if
    end while

    SetupScreens()

    po1 = "Enter˙name"
    po2 = "Trade˙only"
    po3 = "Browse"
    x = popuplist(10,33,13,po1&po2&po3," Credit limits",1,0) 'message "x is:"&str(x)
' message "ptstr is:"&str(ptstr)
    if x = -1
      exit while
    end if
' repaint on
' repaint
' single-step on
    if ptstr=po3
      progress(15,10," Please wait .... loading files ",0)
      vloadif(dpath|"cust_cr1.vw")
      order change key "[Abbrv_Name]"
'       idxname = "all_cust.idx"
'       data query execute "not_del.dfq" index idxname
' ' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' '   not (deleted)
' ' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
      x = BrowseCustomers(0)
      if x = -1
        continue while
      end if

    elseif ptstr = po2
' repaint on
' repaint
' single-step on
'       progress(15,10," Please wait .... loading files ",0)
      vloadif(dpath|"cust_cr1.vw")
      order change key "[Branch]"
      idxname = "tradecst.idx"
      progress(15,10," Please wait ... searching for records ",0)
      data query execute "cust_cr1.dfq" index "temp.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
'    [Branch]="T"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
      order sort now dictionary idxname fields "[Customer_Name]" ascending
      x = BrowseCustomers(0)
      if x = -1
        continue while
      elseif x=1
        exit while
      end if

    elseif ptstr=po1
      progress(15,10," Please wait .... loading files ",0)
      x = BrowseCustomers(1)
      if x = -1
        continue while
      end if
    end if

  end while

  if $chg = "Y"
    screen clear box 1 1 sch scw 0 0 no-border
    repaint off
    progress(fgp,bgp," Creating Account Customer index ",0)
' message "ipath is:"&str(ipath)
' repaint on
' repaint
' single-step on
    data query execute "cust_cr.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is: [Credit_Status] = "A"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    order sort now dictionary ipath|"acc_cust.idx" fields "[Customer_Name]" ascending
    order change physical
    data query execute "NI_colln.dfq" index "x.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ QUERY is: [UnInvoiced] = "Y"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
    order sort now dictionary ipath|"NI_colln.idx" fields "[Customer_Name]" ascending

    Collections()

  end if

  file unload all
  error off
  while true
    window close
    if cerror
      exit while
    end if
  end while
  screen clear box 1 1 sch scw 0 0 no-border
  transfer cpath|"pm_menu.psl" in-memory
END MAIN


FUNCTION SelectProfile()
local y1 y2
  while true
    vloadif(dpath|"profile1.vw")
    order change physical
    order sort now dictionary "mu" fields "[MU_Stock;MU_Bespoke;MU_Tiles;MU_Ancl]" descending
    y1 = format("˙˙{Esc} to new profile or exit˙˙˙","M33")
    y2 = format("˙˙˙˙˙˙Stock Bespoke Tiles ˙˙Ancl˙","L33")
    screen print 4 47 fgp bgp y1
    screen print 5 47 fgp bgp y2
    x = bpopdb("profile1",6,"","[Profiles]","L30","[ProfCode]","L0","[ProfCode]",6,47,20,79,"",1)
    if ptstr = blank
      repaint off
      data goto record next
      continue while
    end if
    screen shortrestore dsa
    if x = -1
      messbox(" Do you wish to create a new profile? (y/n) ",1,1,1)
      if ptstr == "n"
        vunloadif("profile1.vw")
        return (-1)
      end if
      repaint off
      NewProfile()
      continue while
    else
      $profile = ptstr
      messbox(" Confirm Markup profile should be"&$profile|"? (y/n) ",1,1,1)
      if ptstr == "n"
        continue while
      end if
      exit while
    end if
  end while
  vunloadif("profile1.vw")
  vloadif(dpath|"cust_cr1.vw")
  lock-record
    [Profile] = $profile
  write-record
  return (0)
END FUNCTION ' SelectProfile()


FUNCTION BrowseCustomers(b)
local existcustname y2 y3 y1 #rec ppl1 ppl2 ppl3 ppl4 ppl5
' repaint on
' repaint
' single-step on
  custname = ""
  while true
'     order change index idxname
    if b = 1
      while true
        x = fentrybox(" Enter Customer's Name ",35,"AU*34{X}",custname)
        if x = 0
          custname = proper(ptstr)
          abbrv_name = left(custname,5)
          order change key "[Abbrv_Name]"
          data find "[Abbrv_Name]" equal abbrv_name options "f"
          if cerror
            messboxwait(" Name not found ",0,0,1)
            continue while
          end if
          exit while
        else
          return (-1)
        end if
      end while
    end if

    ptval=0
    y3 = format(" List of Customers, Addresses & Credit Limit ","M80")
'     y2 = format(" Change {L}imit   -   Change {M}arkup   -   Change {S}tatus ","M80")
    y2 = format(" {C}ollections   -   {L}imits   -   {M}arkups   -   {S}tatus ","M80")
    y1 = format(" "|chr(24)&chr(25)&"to find - {Esc} to exit ","M80")
    repaint on
    repaint
    screen print 1 1 fgp bgp y3
    screen print 18 1 fgp bgp y2
    screen print 19 1 fgp bgp y1
    while true
      ptval = 0
      ptval = navrecs()                '
message "ptval is:"&str(ptval)
      if ptval = {L} or ptval = {l}
        x = ChkDeleted()
        if x = 1
          continue while
        end if
        $chg = "Y"
        repaint off
        if [Credit_Status] = "A" or [Credit_Status] = "N"
          ChangeLimit()
        else
          messbox(" Change Status first! ",0,0,1)
          continue while
        end
        repaint on
        repaint
        screen print 1 1 fgp bgp y3
        screen print 18 1 fgp bgp y2
        screen print 19 1 fgp bgp y1

      elseif ptval = {C} or ptval = {c}
'         ChkDeleted()
        x = ChkDeleted()
        if x = 1
          continue while
        end if
        $chg = "Y"
        repaint off
        PermitCollections()
        repaint on
        repaint
        screen print 1 1 fgp bgp y3
        screen print 18 1 fgp bgp y2
        screen print 19 1 fgp bgp y1

      elseif ptval = {M} or ptval = {m}
        x = ChkDeleted()
        if x = 1
          continue while
        end if
'         ChkDeleted()
        $chg = "N"
        repaint off
        if [Credit_Status] = "C"
          messbox(" Retail profile only allowed - change Status first! ",0,0,1)
          repaint on
          repaint
          screen print 1 1 fgp bgp y3
          screen print 18 1 fgp bgp y2
          screen print 19 1 fgp bgp y1
          continue while
        else
          #rec = record
          SelectProfile()
          vloadif(dpath|"cust_cr1.vw")
'           order change index idxname
          data goto record record-number #rec
        end
        repaint on
        repaint
        screen print 1 1 fgp bgp y3
        screen print 18 1 fgp bgp y2
        screen print 19 1 fgp bgp y1

      elseif ptval = {S} or ptval = {s}
        x = ChkDeleted()
        if x = 1
          continue while
        end if
'         ChkDeleted()
        $chg = "Y"
        repaint off
        ppl1 = "Retail˙ACC˙"            ' A
        ppl2 = "Retail˙CASH"            ' C
        ppl3 = "˙˙Delayed˙˙"            ' D
        ppl4 = "Trade˙CASH˙"            ' T
        ppl5 = "˙Trade˙ACC˙"            ' N
        x = popuplist(8,35,22,ppl1&ppl2&ppl3&ppl4&ppl5,"",1,0)
        if ptstr = ppl1
          lock-record
            [Credit_Status] = "A"
          write-record
          ChangeLimit()

        elseif ptstr = ppl2
          lock-record
            [Credit_Limit]  = blank
            [Credit_Status] = "C"
          write-record

        elseif ptstr = ppl3
          lock-record
            [Credit_Limit]  = blank
            [Credit_Status] = "D"
          write-record

        elseif ptstr = ppl4
          lock-record
            [Credit_Limit]  = blank
            [Credit_Status] = "T"
          write-record

        elseif ptstr = ppl5
          lock-record
            [Credit_Status] = "N"
          write-record
          ChangeLimit()
        end if
        repaint on
        repaint
        screen print 1 1 fgp bgp y3
        screen print 18 1 fgp bgp y2
        screen print 19 1 fgp bgp y1

      elseif ptval = {Esc}
repaint on
repaint
single-step on
message "$chg is:"&str($chg)
        if $chg = "Y"
          return (1)
        else
          return (-1)
        end if
      end if
    end while
    exit while
  end while
END FUNCTION 'BrowseCustomers()


FUNCTION ChangeLimit()
  oldlimit = [Credit_Limit]
  x = entryline(" Existing limit is"&currency(oldlimit)&"- enter new Credit Limit",5,"{#{#{#{#{#}}}}}","",18,5,70)
  newlimit = val(ptstr)
  lock-record
    [Credit_Limit] = newlimit
  write-record
END FUNCTION ' ChangeLimit()


FUNCTION NewProfile()
local #stck_MU #besp_MU #ancl_MU $letter #tile_MU
  while true                 ' prompt for markups for stock & bespoke & ancl
    x = fentrybox(" Enter STOCK carpet markup required ",5,"",25)
    if ptstr = ""
      continue while
    end if
    #stck_MU = value(ptstr)
    x = fentrybox(" Enter BESPOKE markup required ",5,"",15)
    if ptstr = ""
      continue while
    end if
    #besp_MU = value(ptstr)
    x = fentrybox(" Enter STOCK tiles markup required ",5,"",25)
    if ptstr = ""
      continue while
    end if
    #tile_MU = value(ptstr)
    x = fentrybox(" Enter ANCILLARY markup required ",5,"",25)
    if ptstr = ""
      continue while
    end if
    #ancl_MU = value(ptstr)
    messbox(" CARPET: "|fixed(#stck_MU,2)|"%˙˙BESPOKE: "|fixed(#besp_MU,2)|"%˙˙TILES: "|fixed(#tile_MU,2)|"%˙˙ANCL'Y: "|fixed(#ancl_MU,2)|"% ? (y/n) ",1,1,1)
    if ptstr == "y"
      exit while
    else
      return (1)
    end if
  end while

  data goto record last
  if [ProfCode] = "Y"
    messboxwait(" Cannot create any more profiles! See Head Office",0,0,1)
    return (1)
  end if

  $letter = "A"
  while true
    data goto record first
    data find "[ProfCode]" equal $letter options ""
    if not (cerror)
      $letter = CHR(ASC([ProfCode])+1)             ' message "$letter is:"&str($letter)
      continue while
    end if
    exit while
  end while
  window zoom

  data enter lock
    [ProfCode]   = $letter
    [MU_Stock]   = #stck_MU
    [MU_Bespoke] = #besp_MU
    [MU_Ancl]    = #ancl_MU
    [MU_Tiles]   = #tile_MU
  write-record
  window zoom
  data goto record record-number 2
  return (0)
END FUNCTION ' NewProfile()


FUNCTION SetupScreens()
  vloadif(dpath|"Cust_cr1.vw")
  window split horizontal 20
  data goto window 2
  vloadif(dpath|"profile2.vw")
  data goto window 1
  window link "[Profile]" "profile2.vw" "[ProfCode]"
END FUNCTION ' SetupScreens()


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|"aged_drs.idx" fields "[Date_Of_Order;Job_Nr]" ascending
  order sort now dictionary ipath|"collectn.idx" fields "[Customer_Name]" ascending
  file unload all
END FUNCTION ' Collections()


FUNCTION PermitCollections()
local $collect
  $collect = [UnInvoiced]
  if $collect = "N"
    x = messline(" Permit collections for this customer? (y/n) ",1,1,1,21,5,70)
    if ptstr == "y"
      lock-record
        [UnInvoiced] = "Y"
      write-record
    else
      return (1)
    end if
  elseif $collect = "Y"
    x = messline(" Stop ALL collections for this customer? (y/n) ",1,1,1,21,5,70)
    if ptstr == "y"
'     $collect = "N"
      lock-record
        [UnInvoiced] = "N"
      write-record
    else
      return (1)
    end if
  end if
END FUNCTION ' PermitCollections()


FUNCTION ChkDeleted()
  if (deleted)
    messboxwait(" No longer in use - record deleted ",0,0,1)
    return (1)
  else
    return (0)
  end if