'STARTAPP - checks passwords, initiates all libraries etc.
'12/07/94 - exception message checking module for DAVIDG

'121200A JUL - v1.2

external   setenv() vloadif() vunloadif() messbox() chkfname() tone()
external   nrtries navrecs() wraptext() strtoary() keybox() messboxwait()
external   arytostr() strcount() posnpopup() remove() PrintReport() $drive
external   messboxNOSH() _GEMS_SetSWTitle() _GEMS_GetName()


public     entry userid getrec menuchoice getday getftr greeting areas $i_source
public     fgp bgp scw sch psa cpath lpath fgi bgi $menu $title ptstr dpath
public     ptval $findcat base ptary[1] dsa jobs[6] $enternow $actport $owner
public     $nameareas #SWIP_CDialog logintime


global     loadlibs() options() setup() ReadExceptions() ViewUnread() i
global     enterpassword() passwrd1() scr x Titles() CatPopup()
global     tgt lmsg mbox r1 r2 c1 c2 c3 c4 $cat1 $cat2 $cat3 $cat4 $cat5
global     login() DelRead() y1 y2 y3 $popcat $cat_abbrv $jobstr
global     $allcats PrintCategory() #recs #listcount namelist[1,1]
global     S_poplist poplist[1] $str_list y4 $fullname GetCustNames() $ggn


MAIN
local $name
'   $cat1 = "Purchase’price"
'   $cat2 = "Gross’Margin"
'   $cat3 = "Sundry"
'   $cat4 = "Fittings"
'   $cat5 = "Cash sales"
  $i_source = "M"
'   $cat_abbrv = "P_PRICE MARGIN FITTINGS SUNDRY PUR_INVC CASHSALE STOCK"
  $cat_abbrv = "P_PRICE MARGIN FITTINGS SUNDRY PUR_INVC CASHSALE STOCK CHCKMEAS"

' message "L482 - czbreak on"
  file unload all
  load "SETENV.rf3" in-memory
  setenv()
  unload "SETENV.rf3"

  setup()

  loadlibs()

  if entry == "NEW"
    unlock system userid
    clear userid
    clear $title
    $ggn=_GEMS_GetName(2)              'message "$ggn) is:"&str($ggn)
'     if len($ggn)=0
      enterpassword(" Enter password ",6,"","")
'     else
'       userid=UPPER($ggn)
'     end if
    lock module entry
    lock system getrec
    lock system getday
    lock system getftr
    lock system greeting
    lock system userid
    lock system menuchoice
    lock system $enternow
    lock system $i_source
    lock system $title
    lock system $menu
    lock module jobs[]
    lock module areas
    lock system logintime
    lock system base
  end if
' message "userid) is:"&str(userid)
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  $title=userid&"logged in at"&logintime&"(using drive"&$drive|")"
' message "$title) is:"&str($title)
  _GEMS_SetSWTitle($title)

  $enternow = 0
  GetCustNames()             ' message "$jobstr) is:"&str($jobstr)

  options()

END MAIN


FUNCTION Login()  ' - login to Server/Printers - uses "userid.bat" file on servers
local x y
' message "$drive) is:"&str($drive)
  if $drive = "M"
    y1 = format("Reading data from directory"&upper($drive)|":\data\","M40")
    x = "C:\login MILK"&userid&left($title,6)
    tools os x
  elseif $drive = "Y"
    dpath = "C:\YE95\"
    y1 = format("Reading data from directory"&dpath,"M40")
  else
'     y1 = format("Reading data from directory"&upper($drive)|":\data\","M40")
'     x = "C:\login BRANDY"&userid&left($title,6)
' message "x) is:"&str(x)
'     tools os x
  end if
' message "dpath) is:"&str(dpath)
  y = chkfname(dpath|"test.txt")
' message "y) is:"&str(y)
  if y = -6
    messbox(" DATA not found on Drive"&upper(dpath)|" - re-enter Drive? (y/n) ",1,0,1)
    if ptstr == "y"
      if nrtries = 3
        messbox(" Stop winding me up - 3 tries and you're out!! ",0,0,1)
'         x = "C:\reboot"
        tools os "C:\reboot.com"
      end if
'       tools os "C:\aw\awlogoff /w"
      messboxNOSH(" #!EXIT!# ",0,1,1)
'       messbox(" FINISHED ",0,1,1)
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
'       execute "logout.rf3" in-memory
'       wait 3
      window border
      execute "entappl.rf3" in-memory
    end if
    transfer "entappl" in-memory
  end if
END FUNCTION 'LOGIN()


FUNCTION passwrd1()
local   i l x y passlet[6] counter $user
  counter = 0
  while true
    screen clear box r1+2 c4 r1+2 c4+5 fgp bgp

    for i = 1 to 6
      y = c4 - 1 + i
      l = oldkey(INCHar)
      passlet[i] = CHR(l)
      screen print r1+2 y fgp bgp "*"
      $title = $title|passlet[i]
    end for

    if $title = "exeunt"
      stop
    elseif $title = "metsys"
      quit quit
    end if

    vloadif("oldpurch.vws")
    data find "title" equal $title options "gw"
    if cerror
      tone("wrong")
      messbox(" Invalid Password - try again & ensure CAPS LOCK is off! ",0,0,1)
      $title = ""
      counter = counter + 1
      if counter = 3
        messbox(" Stop winding me up - 3 tries and you're out!! ",0,0,1)
        tone("attention")
        wait 1
        tone("attention")
        wait 1
        tone("attention")
        tools os "C:\reboot.com"
'         quit quit
      end if
      continue while
    else
      exit while
    end if
  end while

  userid   = [author]
  greeting = [Greeting]
  areas    = [areas]
  $menu    = [Menu]
  $owner   = [Ownership]
  base     = [Base]
  logintime=left(time,5)&"on"&date3(today)
' message "logintime) is:"&str(logintime)
  'messbox( " Hello "|greeting&"- your userid is "|userid|" ",0,1,1)
  vunloadif("oldpurch.vws")

  if areas="RS"
    $nameareas="Raynes Sheen"
  elseif areas="FPT"
    $nameareas="Fulham Putney Trade"
  elseif areas="F"
    $nameareas="Fulham"
  elseif areas="W"
    $nameareas="Warehouse"
  elseif areas="ACFPSTWRHO"
    $nameareas="Fulham Raynes Putney Sheen Trade Warehouse"
  else
'     messboxwait(" Area not recognised - contact Head Office ",0,0,1)
    return (-1)
  end if
END FUNCTION ' passwrd1()


FUNCTION GetCustNames()
'   if len($jobstr) = 0
    if file(dpath|userid|".jnr") = 1
      fopen dpath|userid|".jnr" as 1
      fread 1 into $jobstr
      fclose 1
      x = strcount($jobstr)
      if ptval < 6
        for i = 1 to (6-ptval)
          $jobstr = $jobstr&"’"
        end for
      end if
    else
      return (0)
    end if
'   end if

  x = strtoary($jobstr)
  for i = 1 to 6
    jobs[i] = ptary[i]
  end for
  return (1)
END FUNCTION 'GetCustNames()


FUNCTION loadlibs()
' load other libraries
  load lpath|"bpopdb.psl" in-memory
  load lpath|"bpoptabl.psl" in-memory
  screen clear box 1 1 sch scw 0 0 no-border
  load lpath|"datelib.rf3" in-memory
  load lpath|"indexlib.rf3" in-memory
  load lpath|"envlib.rf3" in-memory
  load lpath|"strlib.rf3" in-memory
  load lpath|"dfilelib.rf3" in-memory
  load lpath|"filelib.rf3" in-memory
  load lpath|"uintlib.rf3" in-memory
  load lpath|"doslib.rf3" in-memory
  load lpath|"gems.rf3" in-memory
  load lpath|"swip.rf3" in-memory
  load lpath|"wraptext.rf3" in-memory
  load lpath|"soundlib.rf3" in-memory
  load lpath|"proj_lib.rf3" in-memory
  #SWIP_CDialog=0

END FUNCTION


FUNCTION setup()
  screen clear box 1 1 sch scw 0 0 no-border
  load lpath|"displib.rf3"
  window border
  smartpoke $_ins 0                      ' switch off INSERT mode
END FUNCTION


FUNCTION enterpassword(msg,elen,msk,dfalt)
  scr = 12
  fgp        = fgpleasing
  bgp        = bgpleasing
  fgi        = fginvpleasing
  bgi        = bginvpleasing
  tgt = BLANK
  lmsg=len(msg)
  mbox = scrwidth
  if (lmsg+4) > scrwidth
    return (-2)
  end if
  r1 = scr-2
  r2 = scr+1
  if lmsg >= elen
    c3 = int((mbox-lmsg)/2)+1
    c4 = int((mbox-elen)/2)+1
    c2 = c3 + lmsg + 1
    c1 = c3-2
  else
    c3 = int((mbox-lmsg)/2)+1
    c4 = int((mbox-elen)/2)+1
    if c4 < 3
      c4 = 3
    end if
    c2 = c4 + elen + 1
    if c2 > scrwidth
      c2 = scrwidth
    end if
    c1 = c4-2
  end if
  if c1 <= 0
    c1 = 1
  end if
  if (c1-1) < 12
    while (c1-1) < (scrwidth-c2)
      c2=c2+1
    end while
  end if
  if c2 > scrwidth
    return (-2)
  end if
  screen clear box r1 c1 r2 c2 fgp bgp
  screen print r1+1 c3 fgp bgp msg
  passwrd1()
  login()
END FUNCTION 'enterpassword()


FUNCTION ReadExceptions()
'   $deld = "N"
  vloadif("oldpurch.vws")
  load lpath|"wraptext.rf3" in-memory
  vloadif(dpath|"unread1.vw")
  while true
    x = CatPopup()
    if x = -1
      return (0)
    end if
    screen shortrestore dsa
    Titles()
    ptval=0
    while ptval <> {Esc}
      ptval = navrecs()
      if ptval = {Enter}
        ViewUnread()
        screen shortrestore psa
        continue while
      elseif ptval = {D} or ptval = {d}
        DelRead()
        Titles()
        continue while
'       elseif ptval = {A} or ptval = {a}
'         DelAll()
'         Titles()
'         continue while
      elseif ptval = {P} or ptval = {p}
        x = PrintCategory()
        Titles()
        continue while
      end if
    end while
    repaint off
  end while
END FUNCTION ' ReadExceptions()


FUNCTION ViewUnread()
local x
'   load "wraptext.rf3" in-memory
  x = left(format([Time_Created],"T2"),5)&":"&[message]
  wraptext(8,20,15,60,15,12,x,"L",1,0,1)
'   unload "wraptext.rf3"
END FUNCTION ' ViewUnread()


FUNCTION DelRead()
  if not(deleted)
    data delete record
    lock-record
      [Del] = "D"
    write-record
  '   $deld = "Y"
  else
    data delete record
    lock-record
      [Del] = ""
    write-record
  end if
END FUNCTION ' DelRead()


FUNCTION Titles()
  y1 = format(" Outstanding Exception messages","M33")
  y2 = format("{Enter} to view - {D}elete ","M36")
  y3 = format("{P}rint category - {Esc} to exit","M36")
  y4 = format(" Category:"&$findcat,"M36")
  repaint on
  repaint
  screen shortrestore S_poplist
  screen clear box 4 33 6 68 15 12
  screen print 5 35 15 12 y1
  screen print 7 33 15 1  y4
  screen print 22 33 15 1  y2
  screen print 23 33 15 1  y3
END FUNCTION ' Titles


FUNCTION PrintCategory()
local repdef p2 p3 p4 p5 p6
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  repdef = "exceptn1.dfr"
  p2 = "Messages"
  p3 = 1
  p4 = 1
  p5 = 3
  p6 = 1
  PrintReport(repdef,p2,p3,p4,p5,p6)
' p1 = report definition ("ord_stck.dfr")
' p2 = title at top of choice popup ("LABEL")
' p3 = printer to be used (1=HPIII_QC; 2=GEN_EPSN etc)
' p4 = printer port to use (1,2 etc - network set to use 2=LASER; 3=LABEL)
' p5 = choose VIEW/PRINT 1=PRINT; 2=VIEW; 3=CHOOSE
' p6 = nr of copies

  messbox(" Delete printed messages? (y/n) ",1,0,1)
  if ptstr == "y"
    for i = 1 to records
      if not(deleted)
        data delete record
        lock-record
          [Del] = "D"
        write-record
      else
        lock-record
          [Del] = "D"
        write-record
      end if
      data goto record next
    end for
  end if
END FUNCTION ' PrintCategory()


FUNCTION  CatPopup()
local $cats n $allcats
  $popcat = ""
  x = strcount($cat_abbrv)    ' message "x is:"&str(x) ' message ptstr
  #listcount = ptval                   'message "#listcount is:"&str(#listcount)
  redimension namelist[#listcount,4]

  for n = 1 to #listcount
    $findcat = GROUP($cat_abbrv,n)
    remove($findcat|".idx")
    order change key "[category]"
    data query execute "category.dfq" index $findcat|".idx"
    if cerror
      #recs = 0          '       $popcat = $popcat|trim(format(left($findcat|"’’’’’’’’’’",10),"L10"))|format("’’0","R3")|" "
    else
      #recs = records
    end if                             ' message "#recs is:"&str(#recs)
    $fullname = case $findcat ("P_PRICE","Purchase’Prices")("MARGIN","Sales’Margins")\
("FITTINGS","Fittings")("SUNDRY","Sundry")("PUR_INVC","Supplier's’Invoices")\
("CASHSALE","Cash’sales/collections")("CHCKMEAS","CheckMeasure")("STOCK","Stock") else "No title"
' ("CASHSALE","Cash’sales/collections")("STOCK","Stock") else "No title"

    namelist[n,1] = $findcat
    namelist[n,2] = #recs
    namelist[n,3] = trim(format(left($fullname|"’’’’’’’’’’’’’’’’’’’’",22),"L22"))|format(right("’’’"|str(#recs),4),"R4")|" "
    namelist[n,4] = n
  end for

  redimension ptary[#listcount]
  for n = 1 to #listcount
    ptary[n]   = namelist[n,3]
  end for
  x = arytostr(#listcount)    ' message "x is:"&str(x) ' message ptstr
  $str_list = ptstr

  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  while true
    x = posnpopup(7,2,9+#listcount,$str_list,"’Categories",1,0,0)
    if x = -1
      return (-1)
    elseif namelist[ptval,2] = 0
      continue while
    else
      screen shortrestore dsa
      screen save 7 5 9+#listcount 32 S_poplist
      $findcat = namelist[ptval,1]
      exit while
    end if
  end while
  order change index $findcat|".idx"
  $findcat = case $findcat ("P_PRICE","Purchase Prices")("MARGIN","Sales Margins")\
("FITTINGS","Fittings")("SUNDRY","Sundry")("PUR_INVC","Supplier's’Invoices")\
("CASHSALE","Cash’sales/collections")("CHCKMEAS","CheckMeasure")("STOCK","Stock") else "No title"
' ("CASHSALE","Cash’sales/collections")("STOCK","Stock") else "No title"
END FUNCTION ' CatPopup()


FUNCTION options()
  while true
    if userid = "DAVIDG"
      x = messbox(" Read Exception messages? (y/n) ",1,1,1)
      if ptstr == "y"
        screen shortrestore dsa
        vloadif(dpath|"unread1.vw")
        data query execute "not_del.dfq" index "unread.idx"
        if cerror
          exit while
        end if
        x = ReadExceptions()
        exit while
      end if
    end if
    if $menu == "BOSS"
'       x=keybox("1Local 1Network","Printer")
      x=keybox("1Local 1Network","Printer")
      x=keybox("1JBI 1MRC","Database")
      if ptstr == "j"
'         if apinfo(ap_border) = 1
        window border
'         end if
        tools directory new-directory "C:\jbi_prog"
        execute "j_entapl" in-memory
'         $actport = 1
      else
'         $actport = 2
        $actport = 1
      end if
    else
      $actport = 2
    end if
    exit while
  end while

  if $menu == "boss"
    czbreak on
  else
'     czbreak on
    czbreak off
  end if
  file unload all
  menuchoice = $menu|"menu.pop"      'message "menuchoice is:"&str(menuchoice)
  execute menuchoice in-memory
  transfer cpath|"pm_menu.psl" in-memory
END FUNCTION