/****************************************************************************/
/*                                                                          */
/*                            Tafel.rexx                                    */
/*                                                                          */
/* Written by: Peter Billing, RMB 1240, Yinnar 3869, Australia              */
/*                                                                          */
/* Last saved: Wednesday 29-Sep-93                                          */
/*                                                                          */
/* This program should show the Ancestors of a person in the SCION database.*/
/* The database must be running for this AREXX script to work.              */
/*                                                                          */
/****************************************************************************/

/* Return the Database Name */

options results
/*test = show('P','SCIONGEN')
if test = 0  then
say
say "I am sorry to say that the SCION Genealogist database is not available."
say "Please start the SCION program BEFORE using this script."
say
exit */

myport = "SCIONGEN"
address value myport
getdbname
database = upper(result)
heading = "Tafel listing of a person in the" database "database on" date()
output = "STDOUT"
code1 = "" /* Bold */
code2 = "" /* Normal */
writeln(output, "")
writeln(output,center("This script will give you a",80))
writeln(output,center(heading,80))

writech(output, "Type in the IRN of the person you want ")
pull IRN
say
call MakeName(irn)
person = name

writech(output, "You have asked about "code1 person code2"is this correct? Yes/No ")
pull answer
say
answer = left(answer,1)
 if upper(answer) = "N"
 then exit

writech(output, "How many Generations do you want displayed? 1-12 ")
pull generations
say
if generations > 12 then
exit

say center("The output to screen may have some place names cut short",80)
say center("but the file output will contain the full names.",80)
writech(output,"Output to Screen or File. No formfeeds are in file. S/F ")
pull out
if out = "" then out = "S"
say
output = "STDOUT"

if out = "F" then do
   code1 = ""  /* Bold on */
   code2 = "" /* Bold off */
   filename = "RAM:Tafel_"word(person,1)"_"word(person,words(person))".Scion"
   open(w_file,filename,"w")
   output = w_file
   writeln(stdout,"")
   writeln(stdout,"Writing file to" filename)
   end


generations = generations-1
personnumber=1

writeln(output, center("Parents of" person,80))
writeln(output, center("--------------------------------------------------------",80))
j=1
Parents(irn)
irn.j = irn.a
j = j + 1
irn.j = irn.b
if generations = 0
  then exit
x = 1
Great = 2
do c = 1 to generations
/* personnumber=0 */
j = x*2+1 /* This increases j */
writeln(output, center(Great "generation of Ancestors of" person,80))
writeln(output, center("--------------------------------------------------------",80))
do i = x to x*2
Parents(irn.i)
irn.j = irn.a
j = j + 1
irn.j = irn.b
j = j + 1
end
x = i
Great = Great + 1
end
exit

MakeName:
parse arg irn
getfirstname irn
name = result
getlastname irn
name = name result
return name

AddCodes:
parse arg irn
getfirstname irn
name = left(result,16)
getlastname irn
name = name code1 left(result,12)code2
return name



Parents:
parse arg irn

getparents irn
fgrn = result

getprincipal fgrn
irn.a = result
MakeName(result)
personnumber= personnumber+1
if out = "S" then do
  len = 25
  end
  else
  len = 40

birth = ""
death = ""
marrydate = ""
birthplace = ""
deathplace = ""
marryplace = ""
if length(name) > 1 then do
AddCodes(irn.a)
father = name
getbirthdate irn.a
birth = result
getbirthplace irn.a
birthplace = substr(result,1,len)
getdeathdate irn.a
death = result
getdeathplace irn.a
deathplace = substr(result,1,len)
getmarrydate fgrn
marrydate = result
getmarryplace fgrn
marryplace = substr(result,1,len)
writeln(output, right(personnumber,4)"  "name "Born: "left(birth,14) birthplace)
if length(death) > 1 then do
writeln(output, right("   Died:",42) left(death,14) deathplace)
end
if length(marrydate) > 1 then do
writeln(output, right("Married:",42) left(marrydate,14) marryplace)
end
end

getspouse fgrn
irn.b = result
MakeName(result)
personnumber= personnumber+1
birth = ""
death = ""
marrydate = ""
birthplace = ""
deathplace = ""

if length(name) > 1 then do
AddCodes(irn.b)
mother = name
getbirthdate irn.b
birth = result
getbirthplace irn.b
birthplace = substr(result,1,len)
getdeathdate irn.b
death = result
getdeathplace irn.b
deathplace = substr(result,1,len)
writeln(output, right(personnumber,4)"  "name "Born: "left(birth,14) birthplace)
if length(death) > 1 then do
writeln(output, right("   Died:",42) left(death,14) deathplace)
end
writeln(output,"")
end
return irn.a irn.b