'STRTAPPW - 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()	_GEMS_Input()

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 $ownemail

global     loadlibs() options() setup() ReadExceptions() ViewUnread() i counter
global     enterpassword() 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
global	 $p_code $url $text $options #mode #sepchar


MAIN
local $name
  $i_source = "M"
  $cat_abbrv = "P_PRICE MARGIN FITTINGS SUNDRY PUR_INVC CASHSALE STOCK CHCKMEAS"

  file unload all
  load "SETENV.rf3" in-memory
  setenv()
  unload "SETENV.rf3"

  setup()

  loadlibs()
' message "entry) is:"&str(entry)message "entry is:"&str(entry)
  if entry == "NEW"
    unlock system userid
    clear userid
    clear $title
    $ggn=_GEMS_GetName(2)              'message "$ggn) is:"&str($ggn)

    enterpassword()

    lock module entry
    lock system getrec
    lock system getday
    lock system getftr
    lock system greeting
    lock system userid
    lock system $ownemail
    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
  screen clear box 1 1 sch scw 0 0 no-border
  repaint off
  $title=userid&"logged in at"&logintime&"(using drive"&$drive|")"
  _GEMS_SetSWTitle($title)

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

  options()

END MAIN


FUNCTION enterpassword()
' message "L78/$ggn is:"&str($ggn)
' repaint on
' repaint
' single-step on
	vloadif("oldpurch.vws")
	data goto record first
    	while true
	     if len($ggn)>6		' MRCHOST is 7 chars and other passwords are 6 so it should
  					' distinguish between HO & WHSE logins which are hard-wired
					' and hosts which need to identify the user
			$title=_GEMS_Input("Enter Password","","",6,2,"")
			if len($title)=0
				continue while
			end if
' message "$title is:"&str($title)
			data find "title" equal $title options "f"	' search for password
			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
				userid   = [author]
				exit while
			end if
		else
			userid=UPPER($ggn)		'message "userid is:"&str(userid)
			data find "author" equal userid options "gw"	' search for password
			if cerror
				tone("wrong")
				messbox(" Login name not accepted for Database access ",0,0,1)
'     	   			tools os "C:\reboot.com"
    			     quit quit
			end if
			userid   = [author]
			exit while
		end if
	end while
' message "userid is:"&str(userid)

	greeting = [Greeting]
  	areas    = [areas]
  	$menu    = [Menu]
  	$owner   = [Ownership]
  	base     = [Base]
	$ownemail= [OwnEmail]
  	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

  	login()

END FUNCTION 'enterpassword()


FUNCTION Login()  ' - login to Server/Printers - uses "userid.bat" file on servers
local x y

' message "$drive) is:"&str($drive)

	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)
        			tools os "C:\reboot.com"
      		end if

      messboxNOSH(" #!EXIT!# ",0,1,1)
      screen clear box 1 1 sch scw 0 0 no-border
      repaint off
      window border
      execute "entappl.rf3" in-memory
    end if
    transfer "entappl" in-memory
  end if
END FUNCTION 'LOGIN()


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 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"
      $actport = 1
    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