'CUST_CR - controls customer credit ratings and prints letters to confirm status

external   fentrybox() messbox() vloadif() dpath shopmask scr findpopup() ipath bbd bpopdb()
external   sch scw progress() increment() ptval fgp bgp keybox() arytostr() fdp lpath
external   makeidx() userid cpath vatrate vunloadif() strcount() nr6
external   chkdate() navrecs() entryline() messline() $menu base findcolpop() vkeybox()
external   popuplist() remove() PrintReport() exception() strtoary() fge bge chkstr()
external   messboxwait() colpopup() Background() wraptext()
external   X_path _SWIP_Crystal() Xreppath

public    invtot ptstr custcode dsa abbrv_name $newcust $place psa s_shwreq jobnr custname custaddr1
public    ptary[6] jobs[6] $dayftr #netinv #total_entered invnr #prodrec clf clb

global	custpostcode $key rcvd m4 $est city #refnr refcode $nophone $line x      NewProfile()
global    y lastbal $status EnterCustName() y1 y2 y3
global    newrec deladdr1 $authcode f1 f2 f3 f4 $color $text1 $text2 $text3
global    shop locn H_tel O_tel $type $method datereceipt M_tel #area $mess3 $update $pref
global    recnr tel_locn telnr fentline $ordstat $jobstr #nritems strtcol
global    $reas5 $free $reas1 $reas2 $reas3 $reas4 $reas $popstr ReplaceSoftSpace()
global    s1 s2 s3 s4 s5 s6 s7 $locn currentorder custdet[1,1]
global    lastjob r1 c1 r2 c2 cl1 cl2 PrintCrLetter() ClearHardSpaces()
global    $poplist $parent cust_title custcontact hometel offtel mobile offax
global	prodcode lastsuppcode suppcode prodMRC #unitcost $seltype $itemtype #ordwidth
global	$keypress $prodend ReplaceHardSpace() $all x1 x2 BrowseCustomers()
global     oldlimit newlimit ChangeLimit() $chg $profile idxname
global     SelectProfile() po1 po2 po3
global     po4 po5 PermitCollections() Collections() ChkDeleted() ReturnToMenu()


MAIN
  	single-step off
	file unload all

	clf=10
	clb=15
' fgp=10
' bgp=15

	Background()
  	telnr = ""
  	deladdr1 = ""

  	fentline = " Enter Customer's Name (or 1st SEVEN letters if existing customer)"

 	x1="Account˙customers"
 	x2="˙˙All˙customers"

   	while true
		x=colpopup(11,42,15,x1&x2,"Select",1,0,clf,clb,0,7)		'message "ptstr) is:"&str(ptstr)
    		if x = -1                          'ESC
'      		messbox(" Are you sure you want to exit? (y/n)",1,0,1)
'      		if ptstr == "y"
         			exit while
'      		end if
'       		continue while
    		end if
    		if ptstr=x1								'Existing˙customer
			$all="N"
		else		
			$all="Y"
		end if

		x=EnterCustName()						'find customer and get Custcode

'     		elseif ptstr=x4							'Management
' 			execute "managmnt.rf3" in-memory
'     			continue while
'     		end if

   	end while

	file unload all

  	ReturnToMenu()

END MAIN


FUNCTION EnterCustName()
	while true
		if $all="Y"
			while true
				x = fentrybox(fentline,35,"","")
				if x = 0
					if ptstr = ""
						continue while
					end if
     		   		exit while
    	 			elseif x = -1
    					return (-1)
		      	end if
			end while
	    		custname = ptstr
			vloadif(dpath|"custsel5.vw")
		    	order change key [Abbrv_Name]
			abbrv_name = proper(left(custname,7))
		    	data find "[Abbrv_Name]" equal abbrv_name options ""
'     			if cerror
'      			messbox(" Name not on file, is"&chr(34)|custname|chr(34)|" a new customer? (y/n)",1,0,1)
' 	      		if ptstr == "y"
' 	     	   		$newcust = "Y"
'      	   			return (0)
' 	     	 	end if
' 	    		end if
		else								' $all="N"
			vloadif(dpath|"custsel5.vw")
    			data query execute "cust_cr.dfq" index "cust1.idx"
' ŚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄæ
' ³ [Credit_Status]="A"
' ĄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄŁ
	  		order sort now dictionary "cust2.idx" fields "[Customer_Name]" ascending
		end if

		while true
			repaint off
			vloadif(dpath|"custsel5.vw")
    			repaint on
    			repaint
		    	ptval=0
    			y1 = format(" CUSTOMERS ALREADY HELD ON FILE ","M108")
			y2 = format(" {P}rint Status letter  -  {C}hange Credit Status  -  {Esc} exits ","M108")
' 			y2 = format(" {P}rint Status letter  -  {Esc} exits ","M108")
	    		screen print 4 2 fgp bgp y1
    			screen print 28 2 fgp bgp y2

    			while true
	    			y1 = format(" CUSTOMERS ALREADY HELD ON FILE ","M108")
 				y2 = format(" {P}rint Status letter  -  {C}hange Credit Status  -  {Esc} exits ","M108")
' 				y2 = format(" {P}rint Status letter  -  {Esc} exits ","M108")
				screen print 4 2 fgp bgp y1
	    			screen print 28 2 fgp bgp y2
      			ptval = navrecs()
		     	if ptval = {P} or ptval = {p} 		' print Credit Status check letter
     	     		custcode  = [Customer_Code]
					if [Credit_Status]<>"A"
		     	  		messbox(" Not an Account customer - are you sure you want to print the letter? (y/n)",1,0,1)
	    					if ptstr == "n"
							continue while
			       		end if
		     		end if
			    		repaint off
					x=PrintCrLetter()
					vloadif(dpath|"custsel5.vw")
			    		repaint on
    					repaint
			    		ptval=0

	     		elseif ptval = {C} or ptval = {c} 		' retry
'confirm change cr status or show popup to choose and then confirm
		  	        x = BrowseCustomers(0)
			        if x = -1
				     	continue while
			        	end if
					vloadif(dpath|"custsel5.vw")
' 			    		repaint on
'     					repaint
' 			    		ptval=0


     			elseif ptval = {Esc}
	     			return (-1)
	        		else
					continue while
        			end if
   				custcode      = [Customer_Code]
			end while
		end while
	end while
END FUNCTION 'EnterCustName()


FUNCTION PrintCrLetter()
local $index $file
' message "custcode) is:"&str(custcode)

  	vloadif(dpath|"inv_1.vw")
  	order change key "[Customer_Code]"
     data find "[Customer_Code]" equal custcode options ""
  	$index = "onlyone.idx"
  	$file = "cust_ord"
  	remove($index)
  	x = makeidx($file,$index,str(precord),3)    '   message "x is:"&str(x)
  	order change index $index
	
    	remove(X_path|"X_inv_a.*")
    	data query execute "not_del.dfq" Smart4 X_path|"X_inv_a" fields "[1|"|str(dbinfo(db_fields))|"]"
    	vunloadif("X_inv_a.vws")

    	ClearHardSpaces()
	_SWIP_Crystal(Xreppath|"Xcrdst1","S",0,1,"")

END FUNCTION ' PrintInvoice()


FUNCTION ReplaceHardSpace(str1)
local j r m bw l_last #addn
  bw = 39                              ' boxwidth
  m = ""
  for j = 1 to len(str1)
    r = mid(str1,j,1)
    if r = " "
      r = "˙"                          ' replace hard space
    end if
    m = m|r
  end for

  if len(m) < bw
    #addn = bw-len(m)
  else
    #addn = mod(len(m),bw)
  end if
  m = m|repeat("˙",#addn)
  return (m)
END FUNCTION ' ReplaceHardSpace()


FUNCTION ClearHardSpaces()		'message "ClearHardSpaces()"
local t1 i
  vloadif(X_path|"X_inv_a.vws")
  t1=dbget("[Title]")                'message "t1 is:"&str(t1)
  t1=ReplaceSoftSpace(t1)            'message "t1 is:"&str(t1)
lock-record
  x=dbput("[Title]",t1)
write-record
  vunloadif("X_inv_a.vws")

  vloadif(X_path|"X_inv_b.vws")
  for i = 1 to records
    t1=dbget("[Reason]")             'message "t1 is:"&str(t1)
    t1=ReplaceSoftSpace(t1)          'message "t1 is:"&str(t1)
lock-record
    x=dbput("[Reason]",t1)
write-record
  end for
  order change physical
  vunloadif("X_inv_b.vws")
END FUNCTION ' ClearHardSpaces()


FUNCTION ReplaceSoftSpace(str1)
local j r m l_last #addn
  m = ""
  for j = 1 to len(str1)
    r = mid(str1,j,1)
    if r = "˙"
      r = " "                          ' replace with soft space
    end if
    m = m|r
  end for
  return (m)
END FUNCTION ' ReplaceSoftSpace()


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


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 u1 u2 u3 u4

	clf=10
	clb=15
' 	Background()
' 	redimension custdet[11,2]
  	telnr = ""
  	deladdr1 = ""

     u1="Collections"
	u2="Limits"
	u3="Markups"
	u4="Status"

	y1 = format(" CUSTOMERS ALREADY HELD ON FILE ","M108")
 	y2 = format(" {P}rint Status letter  -  {C}hange Credit Status  -  {Esc} exits ","M108")
' 				y2 = format(" {P}rint Status letter  -  {Esc} exits ","M108")
	screen print 4 2 fgp bgp y1
	screen print 28 2 fgp bgp y2

	while true
		y1 = format(" CUSTOMERS ALREADY HELD ON FILE ","M108")
 		y2 = format(" {P}rint Status letter  -  {C}hange Credit Status  -  {Esc} exits ","M108")
' 				y2 = format(" {P}rint Status letter  -  {Esc} exits ","M108")
		screen print 4 2 fgp bgp y1
		screen print 28 2 fgp bgp y2
'     		x=colpopup(11,42,15,u1&u2&u3&u4,"",1,0,clf,clb,0,7)
    		x=colpopup(11,42,15,u1&u2&u4,"",1,0,clf,clb,0,7)
    		if x = -1                          'ESC
' message "Allow Esc to shut down NEWMENUS??"
       		return (-1)
    		end if

    		if ptstr=u1
	     	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 ptstr=u2
        		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 ptstr=u3
        		x = ChkDeleted()
		     if x = 1
          		continue while
        		end if
        		$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 ptstr=u4
        		x = ChkDeleted()
        		if x = 1
          		continue while
        		end if
        		$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}							' message "$chg is:"&str($chg)
        		if $chg = "Y"
          		return (1)
	     	else
     	    		return (-1)
        		end if
	     end if
	end while
END FUNCTION 'BrowseCustomers()


FUNCTION ChangeLimit()
  oldlimit = [Credit_Limit]
  x = fentrybox(" Existing limit is"&currency(oldlimit)&"- enter new Credit Limit",5,"{#{#{#{#{#}}}}}","")
'   while true
'     x = fentrybox(" Enter Reservation reference ",6,"*2AU*4#","")
'     if x = -1
'       continue while
'     end if
'     $resref = ptstr
'     messbox(" Confirm Reservation reference"&$resref|"? (y/n) ",1,1,1)
'     if ptstr == "Y"
'       exit while
'     else
'       continue while
'     end if
'   end while

  	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 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
END FUNCTION ' ChkDeleted()