macro crm_istemporal (x)
local tm
tm=now()
= (x>0.9*tm and x < 1.1*tm)
endmacro

macro crm_monthgap(a,b)
local x,y
x=a
y=1
while y < 12
  x = monthadd(x)
  if x = b then =y
  y=y+1
endwhile
=0
endmacro


macro crm_yeargap(a,b)
local x,y
x=a
y=1
while y < 12
  x = yearadd(x)
  if x = b then =y
  y=y+1
endwhile
=0
endmacro


macro crm_setup(value,name())
local z, p, n,w
local days1,days2,months1,months2 
z=0             
days2 = "SUNDAY,MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY"
days1 = "SUN,MON,TUE,WED,THU,FRI,SAT"
months2 = "JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER"
months1 = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
if (find(days2,value) > 0) then z = days2: name(0) = 0
if (find(days1,value) > 0) then z = days1: name(0) = 1
if (find(months2,value) > 0) then z = months2:name(0)=2
if (find(months1,value) > 0) then z = months1:name(0)=3
if z=0 then =0
p=1
n=3
loop:
   w=find(z,",")
   if w > 0 then
     name(n) = left(z, w-1)
     z = right(z, len(z)-w)
     n=n+1
     goto loop
   endif
name(n) = z
n=n+1
name(1) = n-3
for w = 0 to n-1
  if value = name(w+3) then name(2) = w
next w
=1
endmacro

macro crm_copystyle(a,b)
local w
w = left(a,1)
if left(b,1) >= "A" and left(b,1) <= "Z" then w = upper(w) else w = lower(w)
if mid(b,2,2) >= "A" and mid(b,2,2) <= "Z" then
   w=w cat upper(right(a,len(a)-1))
   else
   w = w cat lower(right(a,len(a)-1))
endif
=w
endmacro

macro FILLIN(a())
local namearray1(15)
local namearray2(15)
local tt, qq,orient,size,dump,start,uca,ucb,res,z,gap,dumpa
on_error_exit
tt=1
if first(a) > 1 and second(a) > 1 then =0
orient = (first(a) = 1) :  rem orient is 1 for a row
size = if orient then second(a) else first(a) endif
if size = 1 then =0
if (orient) then
        dumpa = a(0,1)
        res = copyvals(a(0,0)..a(0,0), a(0,1)..a(0,1),size-1,1)
        a(0,1)=dumpa
     else
        dumpa=a(1,0)
        res = copyvals(a(0,0)..a(0,0), a(1,0)..a(1,0),1,size-1)
        a(1,0)=dumpa
endif
dump = a(0,0)
if type(dump) = 3 then
               REM first element is a string
   uca = upper(dump)
   res = crm_setup(uca,namearray1)
   if res = 0 then =0
   z = if orient then a(0,1) else a(1,0) endif 
   if type(z) = 3 and len(z) > 0 then
               REM both elements are strings
      ucb = upper(z)
      res = crm_setup(ucb,namearray2)
      if res = 0 then =0
      if namearray1(0) <> namearray2(0) then =0
      gap = namearray2(2) - namearray1(2)
      if (gap < 0 )then gap = gap + namearray1(1)
   else
      if (type(z)  <=2 and z = 0) or (type(z)=3 and len(z)=0) then 
              REM elements are string, blank
          gap = 1
      else
              REM elements are string, something else
          =0
      endif
   endif
   uca = 0
   start = namearray1(2)
   while uca < size
      ucb = crm_copystyle(namearray1(start+3),dump)
      if orient then a(0,uca) = ucb else a(uca,0) = ucb
      uca = uca+1
      start = start + gap
      if start >= namearray1(1) start = start - namearray1(1)
   endwhile
else
      if type(dump) <= 2 then
              REM first element is a number
          z = if orient then a(0,1) else a(1,0) endif 
          if type(z) <= 2 and z=0 or type(z)=3 and len(z) = 0 then
                     REM second cell blank. Set increment
             gap = if crm_istemporal(a(0,0)) then 3600*24 else 1 endif
          else
                     REM second cell is also a number
            gap = z-a(0,0)
            res = crm_monthgap(a(0,0),z) 
            if res > 0 then tt=2: gap = res
            res = crm_yeargap(a(0,0),z)
            if res > 0 then tt=3: gap = res
          endif
          ucb = a(0,0)
          for uca = 1 to size -1
            if tt = 1 then 
                 ucb = ucb+gap
            endif
            if tt = 2 then
                for qq = 1 to gap
                  ucb=monthadd(ucb)
                 next qq
            endif
            if tt = 3 then
                for qq = 1 to gap
                   ucb = yearadd(ucb)
                next qq
            endif
            if orient then 
                a(0,uca) = ucb 
            else 
                a(uca,0) = ucb
            endif
         next uca
      else
           =0
      endif 
endif  
=0
endmacro

rem **********************************************************
rem   code for quasi-standard function match
rem **********************************************************

macro match (n,a(),b())
local af,as,bf,bs,aiscol,biscol,elements,k
if iserror(a) or iserror (b) or iserror (n) then
     = "A parameter is an error"
endif
af = type(n)
  if af > 3 then ="Search value of wrong type"
af = type(a)
   if af <>5 and af <> 7 then ="Parameter is not array"
af = type(b)
   if af <>5 and af <> 7 then ="Parameter is not array"
as = first(a)
af = second(a)
bf = first(b)
bs = second(b)
                  rem check parameters
                  rem a must be one-dimensional
if af > 1 and as > 1 then
      = "Second parameter is not a vector"
endif

if af=1 then
   aiscol = 0
   elements = as
endif
if as=1 then
    aiscol = 1
    elements = af
endif
for k=0 to elements-1
    if n = (if aiscol then a(0,k) else a(k,0) endif) then goto found
next k
= "Value not found"
found:
   if bf=1 and bs=1 then =k
   if bf > 1 and bs > 1 then
        ="Third parameter is not a vector"
   endif
   if bf = 1 then
      if bs <> elements then ="Parameter sizes do not match"
      = b(0,k)
   endif
   if bs = 1 then
       if bf <> elements then ="Parameter sizes do not match"
       = b(k,0)
   endif
="Value not found"
endmacro
 
rem  *******************************************************
rem  code for quasi-function search.
rem  The function uses a binary chop, and the result really
rem  is undefined if the values are not in order.
rem  *******************************************************
macro search(n,a(),b(),flag)
local af,as,bf,bs
local aiscol,biscol,elements
local bottom,top,mid
if iserror(a) or iserror (b) or iserror (n) then
     = "A parameter is an error"
endif
af = type(n)
  if af > 3 then ="Search value of wrong type"
af = type(a)
   if af <>5 and af <> 7 then ="Parameter is not array"
af = type(b)
   if af <>5 and af <> 7 then ="Parameter is not array"
as = first(a)
af = second(a)
bf = first(b)
bs = second(b)
                  rem check parameters
                  rem a must be one-dimensional
if af > 1 and as > 1 then
      = "Second parameter is not a vector"
endif

if af=1 then
   aiscol = 0
   elements = as
endif
if as=1 then
    aiscol = 1
    elements = af
endif
bottom = 0
top = elements-1
while top >= bottom
    mid = int((top+bottom)/2)
    if (if aiscol then a(0,mid) else a(mid,0) endif)= n then goto target
    if (if aiscol then a(0,mid) else a(mid,0) endif)>= n then
       top=mid-1
    else
        bottom=mid+1
    endif
endwhile
if flag > 0 then mid=bottom else mid = bottom-1
target:
if mid<0 or mid >= elements then
   = "Value not found"
endif

   if bf=1 and bs=1 then =mid
   if bf > 1 and bs > 1 then
        ="Third parameter is not a vector"
   endif
   if bf = 1 then
      if bs <> elements then ="Parameter sizes do not match"
      = b(0,mid)
   endif
   if bs = 1 then
       if bf <> elements then ="Parameter sizes do not match"
       = b(mid,0)
   endif
="Value not found"
endmacro
 
