home *** CD-ROM | disk | FTP | other *** search
/ The AGA Experience 2 / agavol2.iso / rexx / familygroup.rexx < prev    next >
OS/2 REXX Batch file  |  1993-10-25  |  12KB  |  438 lines
  1. /****************************************************************************/
  2. /*                                                                          */
  3. /*                            FamilyGroup.rexx                              */
  4. /*                                                                          */
  5. /* Written by: Peter Billing, RMB 1240, Yinnar 3869, Australia              */
  6. /*                                                                          */
  7. /* Last saved: Wednesday 29-Sep-93                                          */
  8. /*                                                                          */
  9. /* This program should make a Family Group from the Families in the SCION   */
  10. /* database. The database must be running  for this AREXX script to work.   */
  11. /*                                                                          */
  12. /****************************************************************************/
  13.  
  14. /* Return the Database Name */
  15.  
  16. options results
  17. /*test = show('P','SCIONGEN')
  18. if test = 0  then
  19. say
  20. say "I am sorry to say that the SCION Genealogist database is not available."
  21. say "Please start the SCION program BEFORE using this script."
  22. say
  23. exit */
  24.  
  25. myport = "SCIONGEN"
  26. address value myport
  27. getdbname
  28. dbname = upper(result)
  29. output = "STDOUT"
  30. writeln(output, " ")
  31. writeln(output,center("This script will give you a",80))
  32. heading = "Listing of a Family Group in the" dbname "database on" date()
  33. writeln(output,center(heading,80))
  34. writech(output,"Type in the FGRN of the Family Group you require or ALL for all. " )
  35. pull FGRN
  36. gettotalfgrn
  37. total = result
  38. if fgrn = "ALL" then do
  39.   start = 1
  40.   finish = total
  41.   end
  42. if fgrn ~= "ALL" then do
  43.   start = fgrn
  44.   finish = fgrn
  45.   end
  46. if fgrn ~= "ALL" & FGRN > total then do
  47.   say "I am sorry to say that there are only" total "Family Groups available. "
  48.   exit
  49. end
  50. writech(output, "Output to Screen or File S/F ")
  51. pull out
  52. if out = "" then out = "S"
  53.  
  54. writech(stdout,"Do you want a sorted list Y/N ")
  55. pull sorted
  56. if sorted = "" then sorted = "N"
  57.  
  58. if sorted = "Y" then do
  59.   file_name = "ram:sort"
  60.   open(sort_File,file_Name,"w")
  61.   do x = 1 to total
  62.     getprincipal x
  63.     a = result
  64.     getsex a
  65.     sex = result
  66.     if sex = "F" then do
  67.       getspouse x
  68.       a = result
  69.     end
  70.     getlastname a
  71.     person = upper(result)
  72.     getfirstname a
  73.     person = person result x
  74.     writeln(sort_File,person)
  75.   end
  76.   close(sort_file)
  77.   address command "c:sort ram:sort ram:sort2"
  78.   file_name = "ram:sort2"
  79.   open(sort_File,file_Name,"r")
  80. end
  81.  
  82. output = "STDOUT"
  83. code1 = "" /* Bold */
  84. code2 = "" /* Normal */
  85.  
  86. if out = "F" then do
  87.    code1 = ""  /* Bold on */
  88.    code2 = "" /* Bold off */
  89.    filename = "RAM:FamilyGroup_"dbname"_"fgrn".Scion"
  90.    open(w_file,filename,"w")
  91.    output = w_file
  92.    writeln(stdout,"")
  93.    writeln(stdout,"Writing file to" filename)
  94.    end
  95.  
  96.  
  97. do j = start to finish
  98. if sorted = "Y" then do
  99.   person = readln(sort_file)
  100.   fgrn = word(person,words(person))
  101. end
  102. else do
  103.   fgrn = j
  104. end
  105. if out = "F" then writech(stdout,".")
  106. writeln(output," ")
  107. heading = "Family Group" fgrn "in the" database "database on" date()
  108. writeln(output,center(heading" Page: 1",80))
  109. writeln(output,"")
  110. getprincipal fgrn
  111. p = result
  112. MakeName(p)
  113. principal = name
  114. getspouse fgrn
  115. s = result
  116. MakeName(s)
  117. spouse = name
  118. getsex s
  119. if result = "M" then do /* do a swap if the Spouse is MALE */
  120.   temp = spouse
  121.   spouse = principal   /* swap Principal and Spouse */
  122.   principal = temp
  123.   t = s
  124.   s = p               /* swap their irn's */
  125.   p = t
  126. end
  127. sp = 3
  128. getage(p)
  129. writeln(output,"--------------------------------------------------------------------------------")
  130. writeln(output,code1"PRINCIPAL:"code2 principal "  ["p"]     Age:" age  Life)
  131. writeln(output,"--------------------------------------------------------------------------------")
  132. getbirthdate p
  133. birthdate = result
  134. getbirthplace p
  135. birthplace = result
  136. writeln(output,right(" ",sp)left("Born:",12) right(birthdate,14) right("Place:",8) birthplace)
  137. getdeathdate p
  138. deathdate = result
  139. getdeathplace p
  140. deathplace = result
  141. writeln(output,right(" ",sp)left("Died:",12) right(deathdate,14) right("Place:",8) deathplace)
  142. getburialdate p
  143. burialdate = result
  144. getburialplace p
  145. burialplace = result
  146. writeln(output,right(" ",sp)left("Buried:",12) right(burialdate,14) right("Place:",8) burialplace)
  147. getpersuser1 p
  148. user1 = result
  149. writeln(output,right(" ",sp)left("Occupation:",12) user1)
  150. getpersuser2 p
  151. user2 = result
  152. writeln(output,right(" ",sp)left("Comments:",12) user2)
  153. getpersuser3 p
  154. user3 = result
  155. writeln(output,right(" ",sp)left("References:",12) user3)
  156. getparents p
  157. parents = result
  158. getprincipal parents
  159. p1 = result
  160. MakeName(p1)
  161. principalParent = name
  162. getspouse parents
  163. s1 = result
  164. MakeName(s1)
  165. spouseParent = name
  166. getsex s1
  167. if result = "M" then do
  168.   temp = spouseParent
  169.   spouseParent = principalParent
  170.   principalParent = temp
  171.   t = s1
  172.   s1 = p1
  173.   p1 = t1
  174. end
  175. writeln(output,right(" ",sp)left("Parents:",12) PrincipalParent "["p1"]")
  176. writeln(output,right(" ",sp)right(" ",12) SpouseParent "["s1"]")
  177.  
  178. getmarrydate fgrn
  179. marrydate = result
  180. getmarryplace fgrn
  181. marryplace = result
  182. writeln(output,right(" ",sp)left("Married:",12) right(marrydate,14) right("Place:",8) marryplace)
  183.  
  184. getfamuser1 fgrn
  185. user1 = result
  186. writeln(output,right(" ",sp)left("Celebrant:",12) user1)
  187. getfamuser2 fgrn
  188. user2 = result
  189. writeln(output,right(" ",sp)left("Comments:",12) user2)
  190. writeln(output,"--------------------------------------------------------------------------------")
  191. writech(output,right(" ",sp)"Other Marriages: ")
  192. fix = 0
  193. do m = 0 to 9
  194.   getmarriage p m
  195.     if result ~= "" & result ~= fgrn then do /* only display marriages apart */
  196.                                              /* from the present */
  197.       writech(output," ["result"]")
  198.       fix = 1
  199.     end
  200.   end
  201. if fix = 1 then writeln(output,"")
  202. else
  203. writeln(output,"None recorded.")
  204. getage(s)
  205. writeln(output,"================================================================================")
  206. writeln(output,code1"SPOUSE:   "code2 spouse "  ["s"]     Age:" age  Life)
  207. writeln(output,"--------------------------------------------------------------------------------")
  208. getbirthdate s
  209. birthdate = result
  210. getbirthplace s
  211. birthplace = result
  212. writeln(output,right(" ",sp)left("Born:",12) right(birthdate,12) right("Place:",8) birthplace)
  213. getdeathdate s
  214. deathdate = result
  215. getdeathplace s
  216. deathplace = result
  217. writeln(output,right(" ",sp)left("Died:",12) right(deathdate,12) right("Place:",8) deathplace)
  218. getburialdate s
  219. burialdate = result
  220. getburialplace s
  221. burialplace = result
  222. writeln(output,right(" ",sp)left("Buried:",12) right(burialdate,12) right("Place:",8) burialplace)
  223. getpersuser1 s
  224. user1 = result
  225. writeln(output,right(" ",sp)left("Occupation:",12) user1)
  226. getpersuser2 s
  227. user2 = result
  228. writeln(output,right(" ",sp)left("Comments:",12) user2)
  229. getpersuser3 s
  230. user3 = result
  231. writeln(output,right(" ",sp)left("References:",12) user3)
  232. getparents s
  233. parents = result
  234. getprincipal parents
  235. p1 = result
  236. MakeName(p1)
  237. principalParent = name
  238. getspouse parents
  239. s1 = result
  240. MakeName(s1)
  241. spouseParent = name
  242. getsex s1
  243. if result = "M" then do
  244.   temp = spouseParent
  245.   spouseParent = principalParent
  246.   principalParent = temp
  247.   t = s1
  248.   s1 = p1
  249.   p1 = t1
  250. end
  251. writeln(output,right(" ",sp)left("Parents:",12) PrincipalParent "["p1"]")
  252. writeln(output,right(" ",sp)right(" ",12) SpouseParent "["s1"]")
  253. writeln(output,"--------------------------------------------------------------------------------")
  254. fix = 0
  255. writech(output,right(" ",sp)"Other Marriages: ")
  256. do m = 0 to 9
  257.   getmarriage s m
  258.     if result ~= "" & result ~= fgrn then do
  259.       writech(output," ["result"]")
  260.       fix = 1
  261.     end
  262.   end
  263. if fix = 1 then writeln(output,"")
  264. else
  265. writeln(output,"None recorded.")
  266. writeln(output,"================================================================================")
  267. writeln(output,center("Details of Children",80))
  268. writeln(output,"================================================================================")
  269. sp = 6
  270. page = 2
  271. do child = 0 to 39
  272. getchild fgrn child
  273.  /* say (child-4)/9  (child-4)%9 */
  274. if result > 0 then do
  275.   c = result
  276.   if out = "F" & (child-4)/8 = (child-4)%8 then do
  277.     writeln(output," ")
  278.     writeln(output,center(heading" cont.  Page: "page,80))
  279.     writeln(output,"")
  280.     writeln(output,"--------------------------------------------------------------------------------")
  281.     page = page + 1
  282.   end
  283.   MakeName(c)
  284.   getsex c
  285.   sex = result
  286.   getage(c)
  287.   writeln(output,right(" ",sp)left("Name:",7) name "["c"]  Sex:" sex " Age:" age life)
  288.   getbirthdate c
  289.   birthdate = result
  290.   getbirthplace c
  291.   birthplace = result
  292.   writeln(output,right(" ",sp)left("Born:",7) right(birthdate,12) right("Place:",8) birthplace)
  293.   getdeathdate c
  294.   deathdate = result
  295.   getdeathplace c
  296.   deathplace = result
  297.   writeln(output,right(" ",sp)left("Died:",7) right(deathdate,12) right("Place:",8) deathplace)
  298.   marrydate = ""
  299.   marryplace = ""
  300.   spouse = ""
  301.   name = ""
  302.   getmarriage c
  303.   if result > 0 then do
  304.     fg = result
  305.     getmarrydate fg
  306.     marrydate = result
  307.     getmarryplace fg
  308.     marryplace = result
  309.     getspouse fg
  310.     spouse = result
  311.     getsex spouse
  312.     if sex = result then do
  313.       getprincipal fg
  314.       spouse = result
  315.     end
  316.     MakeName(spouse)
  317.   end
  318.   writeln(output,right(" ",sp)left("Marr:",7) right(marrydate,12) right("Place:",8) marryplace)
  319.   writech(output,right(" ",sp)left("Spse:",7) )
  320.   if spouse > 0 then do
  321.     writeln(output," "name "["spouse"]")
  322.     end
  323.     else
  324.     writeln(output,"")
  325.   fix = 0
  326.   do f = 0 to 9
  327.     getmarriage c f
  328.     marriage = result
  329.     if marriage ~= "" & marriage ~= fg then do
  330.       if fix = 0 then do
  331.          writech(output,right(" ",sp)"Other Marriages: ")
  332.          fix = 1
  333.       end
  334.       writech(output," ["marriage"]")
  335.     end
  336.   end
  337.   if fix = 1 then writeln(output,"")
  338.   writeln(output,"--------------------------------------------------------------------------------")
  339. end
  340. end
  341. end
  342.  
  343. if out = "F" then do
  344.   writeln(output," ")
  345.   close(w_file)
  346.   writeln(stdout,"")
  347.   writeln(stdout,"All Finished")
  348.   end
  349. exit
  350.  
  351. MakeName:
  352. parse arg irn
  353. getfirstname irn
  354. name = left(result,25)
  355. getlastname irn
  356. name = name code1 left(result,13)code2
  357. return name
  358.  
  359. GetAge:
  360. parse arg irn
  361. age = ""
  362. life = ""
  363. day1   = substr(date(),1,2)
  364. Month1 = substr(date(),4,3)
  365. Year1  = substr(date(),8,4)
  366. CheckMonth(upper(Month1))  /* turn the month into a number */
  367. m1 = x
  368.  
  369. birth = ""
  370. getbirthdate irn
  371. birth = result
  372. if birth ~= "" then do
  373. if length(birth) > 3 then do                  /* check if there is a date */
  374.   day2   = word(birth,1)                      /* if there is then continue */
  375.   Month2 = substr(word(birth,2),1,3)
  376.   Year2  = substr(birth,length(birth)-3,4)
  377.   CheckMonth(upper(Month2))
  378.   m2 = x
  379. end
  380. else do                                      /* no date */
  381.   break                                      /* no need going any futher */
  382. end
  383.  
  384. death = ""
  385. getdeathdate irn
  386. death = result
  387. if length(death) > 3 then do               /* is if the person has a death date */
  388.   day3   = word(death,1)                   /* if there is a date then work out */
  389.   Month3 = word(death,2)                   /* age at death */
  390.   Year3  = substr(death,length(death)-3,4)
  391.   CheckMonth(upper(Month3))
  392.   m3 = x
  393.   age = year3 - year2
  394.   if m3 < m2 then age = age -1
  395.   if m3 = m2 then do
  396.     if day3 < day2 then age = age -1
  397.    end
  398.    Life = "D"
  399. end
  400.  
  401. /* Person is still alive */
  402.  
  403. if length(death) < 3 & length(birth) > 3 then do /* check there is a bith date */
  404. age = year1 - year2                              /* work out the age using the year */
  405. Life = "L"
  406. if m1 < m2 then                                  /* if birth month is less than today */
  407.          age = age -1                            /* then person is a year younger */
  408.     if m1 = m2 then do                           /* if the months are the same then */
  409.                                                  /*  check the days */
  410.    if day1 < day2 then do                        /* if birth day is less than today */
  411.      age = age -1                                /* then person is a year younger */
  412.      end
  413.      end
  414.      end
  415.      if age > 105 then do
  416.        age = ""
  417.        Life = ""
  418.      end
  419. end
  420. return age
  421.  
  422. CheckMonth:
  423. parse arg m
  424. if m = "JAN" then x = 1
  425. if m = "FEB" then x = 2
  426. if m = "MAR" then x = 3
  427. if m = "APR" then x = 4
  428. if m = "MAY" then x = 5
  429. if m = "JUN" then x = 6
  430. if m = "JUL" then x = 7
  431. if m = "AUG" then x = 8
  432. if m = "SEP" then x = 9
  433. if m = "OCT" then x = 10
  434. if m = "NOV" then x = 11
  435. if m = "DEC" then x = 12
  436. return x
  437.  
  438.