home *** CD-ROM | disk | FTP | other *** search
/ The AGA Experience 2 / agavol2.iso / rexx / scion2guide.rexx < prev    next >
OS/2 REXX Batch file  |  1995-07-01  |  34KB  |  1,105 lines
  1. /*****************************************************************************
  2.  
  3.  Scion2Guide.rexx
  4.  
  5.  $VER: Scion2Guide 1.00 (24 June 1995)
  6.  
  7.  An ARexx script to make ".guide" hypertexts from ScionGenealogist data bases
  8.  
  9.    Derived from "Scion2html.rexx" by Harold H. Ipolyi, P.O.Box 891206,
  10.    Houston, Tx 77289-1206. (ipolyi@pat.mdc.com'). Also with assistance
  11.    from Freddy Ariës.
  12.  
  13.    Thanks for doing all the HARD work, guys!
  14.  
  15.    NOTE: This is version 1 and requires a lot more work. Especially
  16.          support for the new fields available with Scion version 4.
  17.  
  18. *****************************************************************************/
  19. options RESULTS
  20. arg outval
  21.  
  22. usereq = 1; /* change this to 0 if you don't want to use reqtools */
  23. versionstr = "1.00"
  24. outp = 1; output = stdout
  25. prgrs = 1; pgopen = 0; /* use RexxArp progress indicator */
  26.                        /* change prgrs to 0 for not using it */
  27. NL = '0A'x
  28.  
  29. signal on IOERR
  30.  
  31. /* Parse command line to (maybe) turn off rexxreqtools and rexxarplib requesters */
  32.  
  33. do while outval = '?'
  34.   writeln(stdout, "NOREQ/S ")
  35.   pull outval
  36. end
  37.  
  38. if outval = "NOREQ" then do
  39.   usereq = 0; prgrs = 0
  40. end
  41.  
  42. /* add libraries */
  43.         libs = 'rexxsupport.library rexxarplib.library'
  44.         DO i = 1 TO Words(libs)
  45.                 lib = Word(libs,i)
  46.                 IF ~Show('Lib',lib) THEN DO
  47.                         IF EXISTS('LIBS:'lib) then call addlib lib, 0, -30
  48.                         ELSE DO
  49.                                 Tell('Cannot find' lib 'in LIBS:')
  50.                                 EXIT 10
  51.                         END
  52.                 END
  53.         END i
  54.  
  55. if usereq & ~show('l','rexxreqtools.library') then do
  56.   if exists('libs:rexxreqtools.library') then
  57.     call addlib('rexxreqtools.library',0,-30,0)
  58.   else do
  59.     usereq = 0;
  60.     Tell("Unable to open rexxreqtools.library - using text output")
  61.   end
  62. end
  63.  
  64. if ~usereq then prgrs = 0
  65.  
  66. if prgrs & ~show('l','rexxarplib.library') then do
  67.   if exists('libs:rexxarplib.library') then
  68.     call addlib('rexxarplib.library',0,-30,0)
  69.   else
  70.     prgrs = 0
  71. end
  72.  
  73. /* Check if Scion is running */
  74. if ~show('P','SCIONGEN') then do
  75.     Tell("Please start the SCION program BEFORE using this script!")
  76.     EXIT
  77. end
  78.  
  79. Address "SCIONGEN"    /* Point at Scion Genealogist port */
  80. 'GETDBNAME'        /* Issue GET DB NAME command to Scion Genealogist */
  81. DBNAME = RESULT
  82. 'GETPROGVERSION'
  83. VERSION = RESULT
  84. IF VERSION < 4.07 THEN DO
  85.     if  usereq then do
  86.         rtezrequest('Requires Scion Version 4.07'||NL||'(or greater)','Cancel','Scion2Guide Message:','rt_pubscrname = SCIONGEN')
  87.         EXIT
  88.         end
  89.     else do
  90.         Tell('Requires Scion Version 4.07 (or greater)')
  91.         EXIT
  92.         end
  93. END
  94. 'GETTOTALIRN'        /* Issue command to Scion Genealogist */
  95.     TOTALIRN = RESULT
  96.  
  97. if usereq = 1 then outp = 0  /* Essentially turns off stdout output */
  98.  
  99. /* Do we want to build a complete system, or just a single person? */
  100. outoption = 1 /* Default is "all" */
  101. if  usereq then do
  102.     outoption = rtezrequest('Current Scion database: '||DBNAME||,
  103.          NL||'Which guide files do you want to create?'||,
  104.          NL,' _All People |_Specific Person | _Cancel','Scion2Guide v'||versionstr||' by Robbie Akins','rt_pubscrname = SCIONGEN')
  105.       select
  106.         when outoption = 2 then do /* Specific Person */
  107.     end
  108.     when outoption = 1 then do /* All */
  109.     end
  110.     otherwise
  111.         EXIT
  112.       end
  113.     end
  114. else do
  115.       TellNN("Produce guides for (A)ll people or a (S)pecific person (A/S)? ")
  116.       pull choice
  117.       choice = UPPER(choice)
  118.       if left(choice,1) = 'A' then outoption = 1
  119.       if left(choice,1) = 'S' then outoption = 2
  120. end
  121.  
  122. if outoption = 1 then target = 'NORMAL'
  123. else do
  124.     /* If user asked for a specific person, get that person */
  125.     if  usereq then do
  126.         target = rtgetlong(,'Enter specific IRN','Scion2Guide v'||versionstr,,'rtgl_min = 1  rtgl_max = 'TOTALIRN' rt_pubscrname = SCIONGEN',numresult)
  127.         if numresult = 0 then EXIT
  128.         if target = '' then EXIT
  129.         end
  130.     else do
  131.           TellNN("Enter IRN of person to create guide for: ")
  132.           pull target
  133.           TellNN("Continue (y/n)? ")
  134.           pull conf
  135.           conf = upper(conf)
  136.           /* Note that left works on empty strings ("") too! */
  137.           if left(conf,1) ~= "Y" then do
  138.             Tell("Goodbye...")
  139.             EXIT
  140.           end
  141.           Tell("")
  142.     end
  143. end
  144.  
  145. /* We need a volume/directory requester to select output location */
  146. outlocn = "RAM:" /* Default location */
  147. if  usereq then do
  148.     outlocn = rtfilerequest(,,'Select Location for Guides',,'rtfi_flags = freqf_nofiles  rtfi_buffer = true   rt_pubscrname = SCIONGEN   rtfi_initialpath = RAM:',)
  149.     if outlocn = '' then EXIT
  150.     end
  151. else do
  152.       TellNN("Enter location to store guide files in: ")
  153.       pull outlocn
  154.       lastchar = right(outlocn,1)
  155.       if lastchar ~= ":" then do
  156.           if lastchar ~= '/' then outlocn = outlocn'/'
  157.       end
  158.       TellNN("Continue (y/n)? ")
  159.       pull conf
  160.       conf = upper(conf)
  161.       /* Note that left works on empty strings ("") too! */
  162.       if left(conf,1) ~= "Y" then do
  163.         Tell("Goodbye...")
  164.         EXIT
  165.       end
  166.       Tell("")
  167. end
  168.  
  169. /* Get path to database so can locate any note files in same location */
  170. 'GETDBPATH'
  171. DBPATH = RESULT
  172. /* Check if path ends with a ":". If not, append a "/" */
  173. lastchar = right(DBPATH,1)
  174. if lastchar ~= ":" then DBPATH = DBPATH'/'
  175.  
  176. Gdir = outlocn
  177.  
  178. Tell("Number of people in database "DBNAME" = "TOTALIRN)
  179. Tell(' ')
  180.  
  181. IF IsNumeric(target) THEN
  182.     DO
  183.     Tell('Processing person 'target' of 'TOTALIRN' in database 'DBNAME)
  184.  
  185.     IF target <= TOTALIRN THEN DO
  186.         CALL MakeOne(target,0)
  187.         END
  188.     END
  189. ELSE
  190.     DO
  191.     Tell("Processing all "TOTALIRN" people in database "DBNAME)
  192.  
  193. /* FAMILYTREE.guide is a Scion data base IRN order list of all people in 
  194.    amigaguide format:
  195.  
  196.    person b:birthdate d:deathdate (()) father //\ mother    */
  197.  
  198. Tell('File name: 'Gdir'FAMILYTREE.guide for: List of People.')
  199.  
  200.         Open('GenealogyFile',Gdir'FAMILYTREE.guide','w')
  201.         WriteCh('GenealogyFile','@NODE Main ')
  202.         WriteLn('GenealogyFile','"List of People"')
  203.         WriteLn('GenealogyFile','List of People in data base "'DBNAME'". 'Time()' - 'Date()'')
  204.         WriteLn('GenealogyFile','')
  205.  
  206.         DO i = 1 TO TOTALIRN
  207.             CALL MakeOne(i,1)
  208.             END
  209.         WriteLn('GenealogyFile','')
  210.         WriteLn('GenealogyFile','')
  211.         'GETPROGVERSION'
  212.         VERSION = RESULT
  213.         WriteCh('GenealogyFile','ScionGenealogist')
  214.         IF VERSION > 0 THEN WriteCh('GenealogyFile',' V 'VERSION)
  215.         WriteLn('GenealogyFile',' © Robbie J Akins; ')
  216.         WriteLn('GenealogyFile','Scion2guide.rexx by Robbie Akins (plus the help of H.Ipolyi and F.Ariës)')
  217.         WriteLn('GenealogyFile','@ENDNODE')
  218.         END
  219.  
  220. if pgopen then do
  221.   Postmsg()
  222.   pgopen = 0
  223. end
  224. if  usereq then do
  225.     rtezrequest('Scion2guide.rexx'||NL||'completed normally','Okay','Scion2Guide Message:','rt_pubscrname = SCIONGEN')
  226. end
  227. else do
  228.     Tell(' ')
  229.     Tell('Scion2guide.rexx completed normally')
  230. end
  231. EXIT
  232. END
  233.  
  234. /*****************************************************************************
  235. *                                                                            *
  236. *  Makeone is the procedure that does all the work!                          *
  237. *                                                                            *
  238. *****************************************************************************/
  239. MakeOne: PROCEDURE EXPOSE target DBNAME Gdir FAMLABEL1 FAMLABEL2 PERSLABEL1 PERSLABEL2 PERSLABEL3 DBPATH prgrs pgopen outp
  240.     PARSE ARG ScionIRN, EndOfFile
  241. 'EXISTPERSON' ScionIRN
  242. if RESULT = 'YES' THEN DO
  243.  
  244.     HasFileFATHER = 0
  245.     HasFileMOTHER = 0
  246.     HasMOTHER = 0
  247.     HasFATHER = 0
  248.     HasPARENTS = 0
  249.     HasCHILDREN = 0
  250.     'GETPARENTS' ScionIRN
  251.     PARENTS = RESULT
  252.         tPARENTSt = 't'PARENTS't'
  253.     IF tPARENTSt ~= 'tt' THEN HasPARENTS = 1
  254.     'GETMARRIAGE' ScionIRN 0    /*      ??? GETTOTMARRIAGES IRN ???     */
  255.     MARRIAGE = RESULT
  256.     tMARRIAGESt = 't'MARRIAGE't'
  257.     IF tMARRIAGESt ~= 'tMARRIAGEt' THEN DO
  258.         mFGRN = MARRIAGE
  259.         'GETCHILD' mFGRN 0    /*    ??? GETTOTCHILDREN FGRN ???    */
  260.         'EXISTPERSON' RESULT
  261.         if RESULT = 'YES' then HasCHILDREN = 1        
  262.     END
  263.     'GETLASTNAME' ScionIRN
  264.     LASTNAME = GetLastName(RESULT)
  265.     'GETFIRSTNAME' ScionIRN
  266.     FIRSTNAME = RESULT
  267.     'GETSEX' ScionIRN
  268.     GENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  269.     thelastname = LASTNAME
  270.     thegender = GENDER
  271.     FULLNAME = GetFullName(FIRSTNAME)
  272.     MFULLNAME = MGetFullName(FIRSTNAME)
  273.     PFULLNAME = PGetFullName(FIRSTNAME)
  274.     'GETBIRTHDATE' ScionIRN
  275.     BIRTHDATE = RESULT
  276.     'GETBIRTHPLACE' ScionIRN
  277.     BIRTHPLACE = RESULT
  278.     'GETDEATHDATE' ScionIRN
  279.     DEATHDATE = RESULT
  280.     'GETDEATHPLACE' ScionIRN
  281.     DEATHPLACE = RESULT
  282.     'GETBURIALPLACE' ScionIRN
  283.     BURIALPLACE = RESULT
  284.     'GETOCCUPATION' ScionIRN
  285.     PERSOCCUPATION = CheckForReplacement(RESULT)
  286.     'GETPERSCOMMENT' ScionIRN
  287.     PERSCOMMENT = CheckForReplacement(RESULT)
  288.     'GETPERSREFS' ScionIRN
  289.     PERSREFS = CheckForReplacement(RESULT)
  290.  
  291.     IF LASTNAME = "" THEN DO
  292.     Tell("Person " ScionIRN"'s last name is not defined")
  293.     Tell("No new guide file being created!")
  294.         RETURN
  295.         END
  296.     PfilN = 'P'ScionIRN
  297.  
  298.     dPfilN = Gdir''PfilN
  299. if prgrs then do
  300.   Postmsg(10, 10, "Scion2Guide (by Robbie Akins)\Database: "||DBNAME||"\Processing person: " ScionIRN, "SCIONGEN")
  301.   pgopen = 1
  302. end
  303. else do
  304.     Tell('')
  305.     Tell('Processing: 'dPfilN'.guide for: 'FULLNAME' {'ScionIRN'}')
  306. end
  307.     Open('PERSONFILE',dPfilN'.guide','w')
  308.     WriteCh('PERSONFILE','@NODE Main ')
  309.     WriteLn('PERSONFILE','"'FULLNAME' Data Sheet"')
  310.     WriteCh('PERSONFILE',''MFULLNAME)
  311.  
  312.     IF Exists(DBPATH'PN'ScionIRN'.'DBNAME) THEN DO
  313.         Tell('Writing info file 'dPfilN'I.guide')
  314.         Open('PNDBNAME',DBPATH'PN'ScionIRN'.'DBNAME,'r')
  315.         Open('PERSONI',dPfilN'I.guide','w')
  316.         WriteCh('PERSONI','@NODE Main ')
  317.         WriteLn('PERSONI','"'FULLNAME' Information"')
  318.         WriteCh('PERSONI','@{" 'MFULLNAME' " LINK 'PfilN'.guide/Main}')
  319.         WriteLn('PERSONI','  @{" List of people " LINK "FAMILYTREE.guide/Main"}')
  320.         DO While ~EOF('PNDBNAME')
  321.             line = ReadLn('PNDBNAME')
  322.             WriteLn('PERSONI',CheckForReplacement(line))
  323.             END
  324.         Close('PNDBNAME')
  325.         WriteLn('PERSONI','@ENDNODE')
  326.         Close('PERSONI')
  327.         WriteCh('PERSONFILE',' @{" More Info " LINK "'PfilN'I.guide/Main"}')
  328.         END
  329.  
  330.     IF Exists(DBPATH'PP'ScionIRN'.'DBNAME) THEN DO
  331.         WriteCh('PERSONFILE',' @{" Picture " RXS "address command '"'display ")
  332.         WriteCh('PERSONFILE', DBPATH'PP'ScionIRN'.'DBNAME"'"'"')
  333.         WriteCh('PERSONFILE','}')
  334.         END
  335.  
  336.     WriteLn('PERSONFILE',' @{" List of People " LINK "FAMILYTREE.guide/Main"}')
  337.     /* Underline name to make a bit more obvious! */
  338.     WriteLn('PERSONFILE',COPIES("=", LENGTH(MFULLNAME)))
  339.  
  340.     IF BIRTHDATE || BIRTHPLACE ~= "" THEN DO
  341.         WriteCh('PERSONFILE','Born: ')
  342.         IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',BIRTHDATE)
  343.         IF BIRTHPLACE ~= "" THEN WriteCh('PERSONFILE',' Place:'BIRTHPLACE)
  344.         WriteLn('PERSONFILE','')
  345.         END
  346.     IF DEATHDATE ~= "" THEN WriteLn('PERSONFILE','Died:'DEATHDATE' Place:'DEATHPLACE)
  347.     IF BURIALPLACE ~= "" THEN WriteLn('PERSONFILE','Buried:'BURIALPLACE)
  348.  
  349.     IF PERSOCCUPATION ~= "" THEN DO
  350.         WriteLn('PERSONFILE',"Occupation: "PERSOCCUPATION)
  351.         END
  352.     IF PERSCOMMENT ~= "" THEN DO
  353.         WriteLn('PERSONFILE',"Comments: "PERSCOMMENT)
  354.         END
  355.     IF PERSREFS ~= "" THEN DO
  356.         WriteLn('PERSONFILE',"References: "PERSREFS)
  357.         END
  358.  
  359. /* end of personal data; start family tree segment */
  360.     WriteLn('PERSONFILE','')
  361.     WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
  362.     WriteLn('PERSONFILE','Immediate Family of 'MFULLNAME)
  363.     WriteLn('PERSONFILE','')
  364.  
  365.     IF HasPARENTS THEN DO
  366.         'GETPRINCIPAL' PARENTS
  367.         PRINCIPAL = RESULT
  368.         'GETSPOUSE' PARENTS
  369.         SPOUSE = RESULT
  370.         'GETMARRYDATE' PARENTS
  371.         PARENTSMARRIAGEDATE = RESULT
  372.         'GETMARRYPLACE' PARENTS
  373.         PARENTSmFGRNPLACE = RESULT
  374.         'GETCELEBRANT' PARENTS
  375.         PARENTSmFGRNCELEBRANT = CheckForReplacement(RESULT)
  376.         'GETFAMCOMMENT' PARENTS
  377.         PARENTSmFGRNCOMMENT = CheckForReplacement(RESULT)
  378.         'GETSEX' PRINCIPAL
  379.         IF RESULT = 'M' THEN
  380.             DO
  381.             FATHERScionIRN = PRINCIPAL
  382.             MOTHERScionIRN = SPOUSE
  383.             END
  384.         ELSE
  385.             DO
  386.             FATHERScionIRN = SPOUSE
  387.             MOTHERScionIRN = PRINCIPAL
  388.             END
  389.         'GETLASTNAME' FATHERScionIRN
  390.         FATHERLASTNAME = GetLastName(RESULT)
  391.         'GETFIRSTNAME' FATHERScionIRN
  392.         FATHERFIRSTNAME = RESULT
  393.         IF FATHERFIRSTNAME ~= "" | FATHERLASTNAME ~= "" THEN HasFATHER = 1
  394.         thelastname = FATHERLASTNAME
  395.         thegender = "m"
  396.         FATHERFULLNAME = GetFullName(FATHERFIRSTNAME)
  397.         MFATHERFULLNAME = MGetFullName(FATHERFIRSTNAME)
  398.         PFATHERFULLNAME = PGetFullName(FATHERFIRSTNAME)
  399.         'GETBIRTHDATE' FATHERScionIRN
  400.         FATHERBIRTHDATE = RESULT
  401.         'GETLASTNAME' MOTHERScionIRN
  402.         MOTHERLASTNAME = GetLastName(RESULT)
  403.         'GETFIRSTNAME' MOTHERScionIRN
  404.         MOTHERFIRSTNAME = RESULT
  405.         IF MOTHERFIRSTNAME ~= "" | MOTHERLASTNAME ~= "" THEN HasMOTHER = 1
  406.         thelastname = MOTHERLASTNAME
  407.         thegender = "f"
  408.         MOTHERFULLNAME = GetFullName(MOTHERFIRSTNAME)
  409.         MMOTHERFULLNAME = MGetFullName(MOTHERFIRSTNAME)
  410.         PMOTHERFULLNAME = PGetFullName(MOTHERFIRSTNAME)
  411.         'GETBIRTHDATE' MOTHERScionIRN
  412.         MOTHERBIRTHDATE = RESULT
  413.  
  414.         IF FATHERLASTNAME ~= "" THEN DO
  415.             HasFileFATHER = 1
  416.             FATHERFILENAME = 'P'FATHERScionIRN
  417.             END        
  418.  
  419.         IF MOTHERLASTNAME ~= "" THEN DO
  420.             HasFileMOTHER = 1
  421.             MOTHERFILENAME = 'P'MOTHERScionIRN
  422.             END        
  423.  
  424.         WriteCh('PERSONFILE','  ')
  425.         IF HasFileFATHER THEN WriteCh('PERSONFILE','@{" 'MFATHERFULLNAME' " LINK "'FATHERFILENAME'.guide/Main"}')
  426.         IF HasFileFATHER THEN WriteCh('PERSONFILE',' //\ ')
  427.         IF HasFileMOTHER THEN WriteCh('PERSONFILE','@{" 'MMOTHERFULLNAME' " LINK "'MOTHERFILENAME'.guide/Main"}')
  428.         WriteLn('PERSONFILE','')
  429.  
  430.         spcs = '  |       '
  431.  
  432.         WriteCh('PERSONFILE',spcs)
  433.         IF PARENTSMARRIAGEDATE ~= "" THEN
  434.             WriteCh('PERSONFILE','Married: 'PARENTSMARRIAGEDATE)
  435.         IF PARENTSmFGRNPLACE ~= "" THEN
  436.             WriteCh('PERSONFILE',' @ 'PARENTSmFGRNPLACE)
  437.         WriteLn('PERSONFILE','')
  438.  
  439.     FfilN = Gdir'F'PARENTS
  440.     IF Exists(FfilN'I.guide') THEN DO
  441.         IF Exists(DBPATH'FN'PARENTS'.'DBNAME) THEN DO
  442.             Parse value StateF(FfilN'I.guide') with type size blk bits PFday PFmin PFtick com
  443.             Parse value StateF(DBPATH'FN'PARENTS'.'DBNAME) with type size blk bits PNday PNmin PNtick com
  444.             IF ( PNday > PFday ) | ( PNday = PFday & PNmin > PFmin ) THEN DO
  445.                 Delete(FfilN'I.guide')
  446.                 Tell('Scion file 'DBPATH'FN'PARENTS'.'DBNAME 'newer; replacing 'FfilN'I.guide')
  447.                 END
  448.             END
  449.         END
  450.  
  451.         Minfo = 0
  452.     IF Exists(FfilN'I.guide') THEN
  453.         Minfo = 1
  454.     ELSE DO
  455.         IF Exists(DBPATH'FN'PARENTS'.'DBNAME) THEN DO
  456.             Minfo = 1
  457.             Tell('Writing info file 'FfilN'I.guide')
  458.             Open('FNDBNAME',DBPATH'FN'PARENTS'.'DBNAME,'r')
  459.             Open('FAMILYI',FfilN'I.guide','w')
  460.             WriteCh('FAMILYI','@NODE Main ')
  461.             WriteLn('FAMILYI','"'FATHERFULLNAME' Family Info<rmation"')
  462.             WriteLn('FAMILYI',' @{" List of People " LINK "FAMILYTREE.guide/Main"}')
  463.             DO While ~EOF('FNDBNAME')
  464.                 line = ReadLn('FNDBNAME')
  465.                 WriteLn('FAMILYI',line)
  466.             END
  467.             Close('FNDBNAME')
  468.             WriteLn('FAMILYI','@ENDNODE')
  469.             Close('FAMILYI')
  470.             END
  471.         END
  472.  
  473.     IF PARENTSmFGRNCELEBRANT ~= '' | Minfo THEN DO
  474.         WriteCh('PERSONFILE',spcs)
  475.         IF Minfo THEN
  476.             WriteCh('PERSONFILE','@{ " Family Info " LINK "F'PARENTS'I.guide/Main"} ')
  477.  
  478.  
  479.     IF Exists(DBPATH'FP'PARENTS'.'DBNAME) THEN DO
  480.         WriteCh('PERSONFILE','@{" Family Picture " RXS "address command '"'display ")
  481.         WriteCh('PERSONFILE', DBPATH'FP'PARENTS'.'DBNAME"'"'"')
  482.         WriteLn('PERSONFILE','}')
  483.         END
  484.     ELSE WriteLn('PERSONFILE','')
  485.  
  486.         IF PARENTSmFGRNCELEBRANT ~= '' THEN DO
  487.             WriteLn('PERSONFILE',spcs''"Celebrant: "PARENTSmFGRNCELEBRANT)
  488.             END
  489.         END
  490. IF PARENTSmFGRNCOMMENT ~= '' THEN DO
  491.     WriteLn('PERSONFILE',spcs''"Comments: "PARENTSmFGRNCOMMENT)
  492.         END
  493.         DO i = 0 TO 39            /*    ??? GETTOTCHILDREN FGRN ???    */
  494.             'GETCHILD' PARENTS i
  495.             PARENTSc = RESULT
  496.             'GETFIRSTNAME' PARENTSc
  497.             PARENTScFIRSTNAME = RESULT
  498.  
  499.             IF PARENTScFIRSTNAME ~= "" THEN DO
  500.                 IF PARENTSc ~= ScionIRN THEN DO
  501.                     'GETLASTNAME' PARENTSc
  502.                     PARENTScLASTNAME = GetLastName(RESULT)
  503.                     'GETFIRSTNAME' PARENTSc
  504.                     PARENTScFIRSTNAME = RESULT
  505.                     'GETSEX' PARENTSc
  506.                     PARENTScGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  507.                     thelastname = PARENTScLASTNAME
  508.                     thegender = PARENTScGENDER
  509.                     PARENTScFULLNAME = GetFullName(PARENTScFIRSTNAME)
  510.                     MPARENTScFULLNAME = MGetFullName(PARENTScFIRSTNAME)
  511.                     PPARENTScFULLNAME = PGetFullName(PARENTScFIRSTNAME)
  512.                     'GETBIRTHDATE' PARENTSc
  513.                     PARENTScBIRTHDATE = RESULT
  514.                     'GETDEATHDATE' PARENTSc
  515.                     PARENTScDEATHDATE = RESULT
  516.  
  517.                     PARENTScFILENAME = 'P'PARENTSc
  518.  
  519.  
  520.                     WriteCh('PERSONFILE','  |_____ @{" ')
  521.  
  522.                     IF PARENTScLASTNAME ~= FATHERLASTNAME THEN
  523.                         WriteCh('PERSONFILE',MPARENTScFULLNAME)
  524.                     ELSE DO
  525.                         IF PARENTScGENDER = "m" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
  526.                         IF PARENTScGENDER = "f" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
  527.                         END
  528.  
  529.                     WriteCh('PERSONFILE',' " LINK "'PARENTScFILENAME'.guide/Main"}')
  530.  
  531.                     IF PARENTScBIRTHDATE ~= "" THEN
  532.                         WriteCh('PERSONFILE',' b:'PARENTScBIRTHDATE)
  533.                     IF PARENTScDEATHDATE ~= "" THEN
  534.                         WriteCh('PERSONFILE',' d:'PARENTScDEATHDATE)
  535.                     WriteLn('PERSONFILE','')
  536.                     END
  537.                 END
  538.             END
  539.         END
  540.     END
  541.  
  542. /* end of parents, siblings segment; start marriages segment */
  543.  
  544.         vert.0 = ''
  545.         vert.1 = ' |'
  546.         DO i = 0 TO 39                  /*      ??? GETTOTMARRIAGES IRN ???     */
  547.                 'GETMARRIAGE' ScionIRN i
  548.                 MARRIAGE = RESULT               /* use: 'EXISTFAMILY'   */
  549.                 IF MARRIAGE > -1 THEN DO
  550.                         MARRIAGES = i
  551.                         j = i + 1
  552.                         vert.j = vert.i vert.1
  553.                         END
  554.         END
  555.         tMARRIAGESt = 't'MARRIAGES't'
  556.  
  557.     IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
  558.         WriteLn('PERSONFILE','  |')
  559.         DO i = 0 TO MARRIAGES
  560.             'GETMARRIAGE' ScionIRN i
  561.             mFGRN = RESULT
  562.             IF mFGRN ~= "" THEN DO
  563.                 ki = MARRIAGES - i + 1
  564.                 IF ki ~= MARRIAGES + 1 THEN DO
  565.                     WriteLn('PERSONFILE',vert.ki)
  566.                     END
  567.                 j = MARRIAGES + 1 - i
  568.                 'GETSPOUSE' mFGRN
  569.                 SPOUSE = RESULT
  570.                 IF SPOUSE = ScionIRN THEN
  571.                     DO
  572.                     'GETPRINCIPAL' mFGRN
  573.                     SPOUSE = RESULT
  574.                     END
  575.                 'GETLASTNAME' SPOUSE
  576.                 SPOUSELASTNAME = GetLastName(RESULT)
  577.                 'GETFIRSTNAME' SPOUSE
  578.                 SPOUSEFIRSTNAME = RESULT
  579.                 thelastname = SPOUSELASTNAME
  580.                 'GETSEX' SPOUSE
  581.                 thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  582.                 SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
  583.                 MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
  584.                 PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
  585.                 'GETBIRTHDATE' SPOUSE
  586.                 SPOUSEBIRTHDATE = RESULT
  587.                 'GETMARRYDATE' mFGRN
  588.                 MARRIAGEDATE = RESULT
  589.                 'GETMARRYPLACE' mFGRN
  590.                 mFGRNPLACE = RESULT
  591.                 'GETCELEBRANT' mFGRN
  592.                 MARRIAGECELEBRANT = CheckForReplacement(RESULT)
  593.                 'GETFAMCOMMENT' mFGRN
  594.                 MARRIAGECOMMENT = CheckForReplacement(RESULT)
  595.  
  596.                 SPOUSEFILENAME = 'P'SPOUSE
  597.  
  598.                 IF i = 0 THEN DO
  599.                     WriteCh('PERSONFILE','# 'MFULLNAME' //\ ')
  600.                     IF SPOUSELASTNAME ~= "" THEN
  601.                         WriteCh('PERSONFILE','@{" ')
  602.                     WriteCh('PERSONFILE',MSPOUSEFULLNAME)
  603.                     IF SPOUSELASTNAME ~= "" THEN
  604.                         WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
  605.                     END
  606.                 ELSE DO
  607.                     WriteCh('PERSONFILE',vert.j'_ //\ ')
  608.  
  609.                     IF SPOUSELASTNAME ~= "" THEN
  610.                         WriteCh('PERSONFILE','@{" ')
  611.                     WriteCh('PERSONFILE',MSPOUSEFULLNAME)
  612.                     IF SPOUSELASTNAME ~= "" THEN
  613.                         WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
  614.                     END
  615.                 WriteLn('PERSONFILE','')
  616.  
  617.                 jk = MARRIAGES - i
  618.                 spcs = vert.jk'      |     '
  619.  
  620.                 WriteCh('PERSONFILE',spcs)
  621.                 IF MARRIAGEDATE ~= "" THEN
  622.                     WriteCh('PERSONFILE',' m: 'MARRIAGEDATE)
  623.                 IF mFGRNPLACE ~= "" THEN
  624.                     WriteCh('PERSONFILE',' @ 'mFGRNPLACE)
  625.  
  626.                 WriteLn('PERSONFILE','')
  627.  
  628.                 FfilN = Gdir'F'mFGRN
  629.                 Minfo = 0
  630.                 IF Exists(DBPATH'FN'mFGRN'.'DBNAME) THEN DO
  631.                     Minfo = 1
  632.                     Tell('Writing info file 'FfilN'I.guide')
  633.                     Open('FNDBNAME',DBPATH'FN'mFGRN'.'DBNAME,'r')
  634.                     Open('FAMILYI',FfilN'I.guide','w')
  635.                     WriteCh('FAMILYI','@NODE Main ')
  636.                     WriteCh('FAMILYI','"'MFULLNAME' //\ ')
  637.                     WriteLn('FAMILYI',MSPOUSEFULLNAME' Family Information"')
  638.  
  639.                     WriteCh('FAMILYI','Family of 'MFULLNAME' //\ ')
  640.                     WriteCh('FAMILYI',MSPOUSEFULLNAME)
  641.  
  642.                     WriteLn('FAMILYI',' @{" List of people " LINK "FAMILYTREE.guide/Main"}')
  643.                     DO While ~EOF('FNDBNAME')
  644.                         line = ReadLn('FNDBNAME')
  645.                         WriteLn('FAMILYI',CheckForReplacement(line))
  646.                     END
  647.                     Close('FNDBNAME')
  648.                     WriteLn('FAMILYI','@ENDNODE')
  649.                     Close('FAMILYI')
  650.                     END
  651.  
  652.                 IF MARRIAGECELEBRANT ~= '' | Minfo THEN DO
  653.                     WriteCh('PERSONFILE',spcs)
  654.                     IF Minfo THEN
  655.                         WriteCh('PERSONFILE',' @{" Family Info " LINK "F'mFGRN'I.guide/Main"}')
  656.  
  657.  
  658.                 IF Exists(DBPATH'FP'mFGRN'.'DBNAME) THEN DO
  659.                     WriteCh('PERSONFILE',' @{" Family Picture " RXS "address command '"'display ")
  660.                     WriteCh('PERSONFILE', DBPATH'FP'mFGRN'.'DBNAME"'"'"')
  661.                     WriteLn('PERSONFILE','}')
  662.                     END
  663.                 ELSE WriteLn('PERSONFILE','')
  664.  
  665.  
  666.                     IF MARRIAGECELEBRANT ~= '' THEN DO
  667.                         WriteLn('PERSONFILE',spcs' '"Celebrant: "MARRIAGECELEBRANT)
  668.                         END
  669.                     END
  670.                 IF MARRIAGECOMMENT ~= '' THEN DO
  671.                     WriteLn('PERSONFILE',spcs' '"Comments: "MARRIAGECOMMENT)
  672.                     END
  673. /*********************************************************************************/
  674.  
  675.     DO k = 0 TO 39            /*    ??? GETTOTCHILDREN FGRN ???    */
  676.         'GETCHILD' mFGRN k
  677.         mFGRNc = RESULT
  678.         'GETFIRSTNAME' mFGRNc
  679.         mFGRNcFIRSTNAME = RESULT
  680.  
  681.         IF mFGRNcFIRSTNAME ~= "" THEN DO
  682.             HasCHILDREN = 1
  683.             'GETLASTNAME' mFGRNc
  684.             mFGRNcLASTNAME = GetLastName(RESULT)
  685.             'GETFIRSTNAME' mFGRNc
  686.             mFGRNcFIRSTNAME = RESULT
  687.             'GETSEX' mFGRNc
  688.             mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  689.             thelastname = mFGRNcLASTNAME
  690.             thegender = mFGRNcGENDER
  691.             mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
  692.             MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
  693.             PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
  694.             'GETBIRTHDATE' mFGRNc
  695.             mFGRNcBIRTHDATE = RESULT
  696.             'GETDEATHDATE' mFGRNc
  697.             mFGRNcDEATHDATE = RESULT
  698.  
  699.             mFGRNcFILENAME = 'P'mFGRNc
  700.  
  701.             jk = MARRIAGES - i
  702.             WriteCh('PERSONFILE',vert.jk'      |_____ @{" ')
  703.  
  704.             IF mFGRNcLASTNAME ~= LASTNAME THEN
  705.                 WriteCh('PERSONFILE',MmFGRNcFULLNAME)
  706.             ELSE DO
  707.                 IF mFGRNcGENDER = "m" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
  708.                 IF mFGRNcGENDER = "f" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
  709.                 END
  710.             WriteCh('PERSONFILE',' " LINK "'mFGRNcFILENAME'.guide/Main"}')
  711.  
  712.             IF mFGRNcBIRTHDATE ~= "" THEN
  713.                 WriteCh('PERSONFILE',' b:'mFGRNcBIRTHDATE)
  714.             IF mFGRNcDEATHDATE ~= "" THEN
  715.                 WriteCh('PERSONFILE',' d:'mFGRNcDEATHDATE)
  716.             Writeln('PERSONFILE','')
  717.             END
  718.         END
  719.     END
  720. /*********************************************************************************/
  721.                 END
  722.         END
  723.     ELSE DO
  724.         WriteLn('PERSONFILE','  |')
  725.         WriteLn('PERSONFILE','  'MFULLNAME)
  726.     END
  727.     IF HasPARENTS THEN DO
  728.         WriteLn('PERSONFILE','')
  729.         WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
  730.         WriteLn('PERSONFILE','Ancestors of 'MFULLNAME)
  731.         WriteLn('PERSONFILE','')
  732.         Paternal(ScionIRN,'  ')
  733.         WriteCh('PERSONFILE',MFULLNAME)
  734.         IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'BIRTHDATE)
  735.         IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'DEATHDATE)
  736.         WriteLn('PERSONFILE','')
  737.         Maternal(ScionIRN,'  ')
  738.         END
  739.     IF HasCHILDREN THEN DO
  740.         WriteLn('PERSONFILE','')
  741.         WriteLn('PERSONFILE',COPIES("=", 75)) /* Mark off "top" section */
  742.         WriteLn('PERSONFILE','Descendants of 'MFULLNAME)
  743.         WriteLn('PERSONFILE','')
  744.         indent = "  "
  745.         WriteCh('PERSONFILE',indent||MFULLNAME)
  746.         IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'BIRTHDATE)
  747.         IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'DEATHDATE)
  748.         WriteLn('PERSONFILE','')
  749.         marriagesANDchildren(ScionIRN,indent)
  750.         END
  751.     WriteLn('PERSONFILE','')
  752.     WriteLn('PERSONFILE','@ENDNODE')
  753.     Close('PERSONFILE')
  754.  
  755.     IF target = "NORMAL" & LASTNAME ~= "" THEN DO
  756.         WriteCh('GenealogyFile','@{" ')
  757.         WriteCh('GenealogyFile',MFULLNAME)
  758.         WriteCh('GenealogyFile',' " LINK "'PfilN'.guide/Main"}')
  759.         IF BIRTHDATE ~= "" THEN WriteCh('GenealogyFile',' b:'BIRTHDATE)
  760.         IF DEATHDATE ~= "" THEN WriteCh('GenealogyFile',' d:'DEATHDATE)
  761. /*********************************************************************************/
  762. IF HasFATHER THEN DO
  763.     WriteCh('GenealogyFile',' (()) ')
  764.     IF HasFileFATHER THEN WriteCh('GenealogyFile','@{" ')
  765.     WriteCh('GenealogyFile',' 'MFATHERFULLNAME)
  766.     IF HasFileFATHER THEN WriteCh('GenealogyFile',' " LINK "'FATHERFILENAME'.guide/Main"}')
  767.     IF HasMOTHER THEN DO
  768.         IF HasFATHER THEN WriteCh('GenealogyFile',' //\ ')
  769.         IF HasFileMOTHER THEN WriteCh('GenealogyFile','@{" ')
  770.         WriteCh('GenealogyFile',MMOTHERFULLNAME)
  771.         IF HasFileMOTHER THEN WriteCh('GenealogyFile',' " LINK "'MOTHERFILENAME'.guide/Main"}')
  772.         END
  773.     END
  774. /*********************************************************************************/
  775.     WriteLn('GenealogyFile','')    /* do not close, we have many more to go. */
  776. END
  777.  
  778.     RETURN
  779.  
  780.  
  781.  
  782.  
  783.  
  784. IsNumeric: PROCEDURE
  785.     PARSE ARG str
  786.     RETURN DataType(str, 'W')
  787.  
  788.  
  789.     /* create a file name short but unique */
  790.  
  791. FilName: PROCEDURE
  792.     PARSE ARG finm lanm bdate
  793.     RETURN Space(substr(finm,1,2) substr(lanm,1,4) bdate)
  794.  
  795. CheckForReplacement: PROCEDURE
  796.     PARSE ARG line "<" last
  797.     IF last = "" THEN RETURN CheckReplacement(line)
  798.     RIRN = GetRIRN(last || ".")
  799.     IF RIRN = 0 THEN RETURN line || "<" || last
  800.     last = CheckForReplacement(last)        /* recursion */
  801.     lastend = GetEnd(last || ".")
  802.     'GETLASTNAME' RIRN
  803.     RIRNLASTNAME = GetLastName(RESULT)
  804.     'GETFIRSTNAME' RIRN
  805.     RIRNFIRSTNAME = RESULT
  806.     thelastname = RIRNLASTNAME
  807.     'GETBIRTHDATE' RIRN
  808.     RIRNBIRTHDATE = RESULT
  809.     'GETSEX' RIRN
  810.     IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
  811.         RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
  812.     ELSE
  813.         RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
  814.     IF RIRNLASTNAME = "" THEN
  815.         RETURN line || RIRNFULLNAME || lastend
  816.     RIRNFILENAME = 'P'RIRN
  817.     RETURN line || '@{" 'RIRNFULLNAME' " LINK "'RIRNFILENAME'.guide/Main"}' || lastend
  818.  
  819. CheckReplacement: PROCEDURE
  820.     PARSE ARG line "[" last
  821.     IF last = "" THEN RETURN line
  822.     RIRN = GetaRIRN(last || ".")
  823.     IF RIRN = 0 THEN RETURN line || "[" || last
  824.     last = CheckForReplacement(last)        /* recursion */
  825.     lastend = GetaEnd(last || ".")
  826.     'GETLASTNAME' RIRN
  827.     RIRNLASTNAME = GetLastName(RESULT)
  828.     'GETFIRSTNAME' RIRN
  829.     RIRNFIRSTNAME = RESULT
  830.     thelastname = RIRNLASTNAME
  831.     'GETBIRTHDATE' RIRN
  832.     RIRNBIRTHDATE = RESULT
  833.     'GETSEX' RIRN
  834.     IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
  835.         RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
  836.     ELSE
  837.         RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
  838.     IF RIRNLASTNAME = "" THEN
  839.         RETURN line || RIRNFULLNAME || lastend
  840.     RIRNFILENAME = 'P'RIRN
  841.     RETURN line || '@{" 'RIRNFULLNAME' " LINK "'RIRNFILENAME'.guide/Main"}' || lastend
  842.  
  843. Paternal: PROCEDURE
  844.     PARSE ARG irn, indent
  845.     'GETPARENTS' irn
  846.     PARENTS = RESULT
  847.     'GETPRINCIPAL' PARENTS
  848.     PRINCIPAL = RESULT
  849.     'GETSPOUSE' PARENTS
  850.     SPOUSE = RESULT
  851.     'GETSEX' PRINCIPAL
  852.     IF RESULT = 'M' THEN DO
  853.         FIRN = PRINCIPAL
  854.         MIRN = SPOUSE
  855.         END
  856.     ELSE DO
  857.         FIRN = SPOUSE
  858.         MIRN = PRINCIPAL
  859.         END
  860.     pirn = FIRN
  861.     IF 't'pirn't' ~= 'tt' THEN DO
  862.         Paternal(pirn,'     'indent)
  863.         'GETLASTNAME' pirn
  864.         pirnLASTNAME = GetLastName(RESULT)
  865.         thelastname = pirnLASTNAME
  866.         'GETFIRSTNAME' pirn
  867.         pirnFIRSTNAME = RESULT
  868.         pirnFULLNAME = GetFullName(pirnFIRSTNAME)
  869.         'GETBIRTHDATE' pirn
  870.         pirnBIRTHDATE = RESULT
  871.         IF pirnLASTNAME ~= "" THEN
  872.             pirnPfilN = 'P'pirn
  873.         WriteCh('PERSONFILE',indent'- ')
  874.         IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','@{" ')  
  875.         WriteCh('PERSONFILE',''pirnFULLNAME'')
  876.         IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE',' " LINK "'pirnPfilN'.guide/Main"}')
  877.         IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'pirnBIRTHDATE)
  878.         'GETDEATHDATE' pirn
  879.         pirnDEATHDATE = RESULT
  880.         IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'pirnDEATHDATE)
  881.         WriteLn('PERSONFILE','')
  882.         Maternal(pirn,'     'indent)
  883.         END
  884.     RETURN 0
  885.  
  886. Maternal: PROCEDURE
  887.     PARSE ARG irn, indent
  888.     'GETPARENTS' irn
  889.     PARENTS = RESULT
  890.     'GETPRINCIPAL' PARENTS
  891.     PRINCIPAL = RESULT
  892.     'GETSPOUSE' PARENTS
  893.     SPOUSE = RESULT
  894.     'GETSEX' PRINCIPAL
  895.     IF RESULT = 'M' THEN DO
  896.         FIRN = PRINCIPAL
  897.         MIRN = SPOUSE
  898.         END
  899.     ELSE DO
  900.         FIRN = SPOUSE
  901.         MIRN = PRINCIPAL
  902.         END
  903.     pirn = MIRN
  904.     IF 't'pirn't' ~= 'tt' THEN DO
  905.         Paternal(pirn,'     'indent)
  906.         'GETLASTNAME' pirn
  907.         pirnLASTNAME = GetLastName(RESULT)
  908.         thelastname = pirnLASTNAME
  909.         'GETFIRSTNAME' pirn
  910.         pirnFIRSTNAME = RESULT
  911.         pirnFULLNAME = GetFullName(pirnFIRSTNAME)
  912.         'GETBIRTHDATE' pirn
  913.         pirnBIRTHDATE = RESULT
  914.         IF pirnLASTNAME ~= "" THEN
  915.             pirnPfilN = 'P'pirn
  916.         WriteCh('PERSONFILE',indent'- ')
  917.         IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','@{" ')
  918.         WriteCh('PERSONFILE',''pirnFULLNAME'')
  919.         IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE',' " LINK "'pirnPfilN'.guide/Main"}')
  920.         IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' b:'pirnBIRTHDATE)
  921.         'GETDEATHDATE' pirn
  922.         pirnDEATHDATE = RESULT
  923.         IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' d:'pirnDEATHDATE)
  924.         WriteLn('PERSONFILE','')
  925.         Maternal(pirn,'     'indent)
  926.         END
  927.     RETURN 0
  928.  
  929. marriagesANDchildren: PROCEDURE
  930.         PARSE ARG ScionIRN,indent
  931.     DO i = 0 TO 39            /*    ??? GETTOTMARRIAGES IRN ???    */
  932.         'GETMARRIAGE' ScionIRN i
  933.         MARRIAGE = RESULT
  934.         IF MARRIAGE > -1 THEN DO
  935.             MARRIAGES = i
  936.             END
  937.     END
  938.     tMARRIAGESt = 't'MARRIAGES't'
  939.  
  940.     IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
  941.         DO i = 0 TO MARRIAGES
  942.             'GETMARRIAGE' ScionIRN i
  943.             mFGRN = RESULT
  944.             IF mFGRN ~= "" THEN DO
  945.                 'GETSPOUSE' mFGRN
  946.                 SPOUSE = RESULT
  947.                 IF SPOUSE = ScionIRN THEN
  948.                     DO
  949.                     'GETPRINCIPAL' mFGRN
  950.                     SPOUSE = RESULT
  951.                     END
  952.                 'GETLASTNAME' SPOUSE
  953.                 SPOUSELASTNAME = GetLastName(RESULT)
  954.                 'GETFIRSTNAME' SPOUSE
  955.                 SPOUSEFIRSTNAME = RESULT
  956.                 thelastname = SPOUSELASTNAME
  957.                 'GETSEX' SPOUSE
  958.                 thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  959.                 SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
  960.                 MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
  961.                 PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
  962.                 'GETBIRTHDATE' SPOUSE
  963.                 SPOUSEBIRTHDATE = RESULT
  964.                 'GETDEATHDATE' SPOUSE
  965.                 SPOUSEDEATHDATE = RESULT
  966.                 SPOUSEFILENAME = 'P'SPOUSE
  967.                 WriteCH('PERSONFILE',indent'spouse: ')
  968.                 IF SPOUSELASTNAME ~= "" THEN
  969.                     WriteCh('PERSONFILE','@{" ')
  970.                 WriteCh('PERSONFILE',MSPOUSEFULLNAME)
  971.                 IF SPOUSELASTNAME ~= "" THEN
  972.                     WriteCh('PERSONFILE',' " LINK "'SPOUSEFILENAME'.guide/Main"}')
  973.                 IF SPOUSEBIRTHDATE ~= "" THEN
  974.                     WriteCh('PERSONFILE',' b:'SPOUSEBIRTHDATE)
  975.                 IF SPOUSEDEATHDATE ~= "" THEN
  976.                     WriteCh('PERSONFILE',' d:'SPOUSEDEATHDATE)
  977.                 WriteLn('PERSONFILE','')
  978.     indent2 = indent || " | "
  979.     DO k = 0 TO 39            /*    ??? GETTOTCHILDREN FGRN ???    */            
  980.         'GETCHILD' mFGRN k
  981.         mFGRNc = RESULT
  982.         'GETFIRSTNAME' mFGRNc
  983.         mFGRNcFIRSTNAME = RESULT
  984.  
  985.         IF mFGRNcFIRSTNAME ~= "" THEN DO
  986.             'GETLASTNAME' mFGRNc
  987.             mFGRNcLASTNAME = GetLastName(RESULT)
  988.             'GETFIRSTNAME' mFGRNc
  989.             mFGRNcFIRSTNAME = RESULT
  990.             'GETSEX' mFGRNc
  991.             mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
  992.             thelastname = mFGRNcLASTNAME
  993.             thegender = mFGRNcGENDER
  994.             mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
  995.             MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
  996.             PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
  997.             'GETBIRTHDATE' mFGRNc
  998.             mFGRNcBIRTHDATE = RESULT
  999.             'GETDEATHDATE' mFGRNc
  1000.             mFGRNcDEATHDATE = RESULT
  1001.  
  1002.             mFGRNcFILENAME = 'P'mFGRNc
  1003.  
  1004.             WriteCh('PERSONFILE',indent2||'@{" 'MmFGRNcFULLNAME' " LINK "'mFGRNcFILENAME'.guide/Main"} ')
  1005.  
  1006.             IF mFGRNcBIRTHDATE ~= "" THEN
  1007.                 WriteCh('PERSONFILE',' b:'mFGRNcBIRTHDATE)
  1008.             IF mFGRNcDEATHDATE ~= "" THEN
  1009.                 WriteCh('PERSONFILE',' d:'mFGRNcDEATHDATE)
  1010.             Writeln('PERSONFILE','')
  1011.             marriagesANDchildren(mFGRNc,indent2)
  1012.             END
  1013.     END
  1014.                 END
  1015.             END
  1016.         END
  1017.     RETURN 0
  1018.  
  1019. GetRIRN: PROCEDURE
  1020.     PARSE ARG numb ">" last
  1021.     IF last = "" THEN RETURN 0
  1022.     IF IsNumeric(numb) THEN RETURN numb
  1023.     RETURN 0
  1024.  
  1025. GetaRIRN: PROCEDURE
  1026.     PARSE ARG numb "]" last
  1027.     IF last = "" THEN RETURN 0
  1028.     IF IsNumeric(numb) THEN RETURN numb
  1029.     RETURN 0
  1030.  
  1031. GetEnd: PROCEDURE
  1032.     PARSE ARG line ">" last
  1033.     IF last = "" THEN RETURN substr(line,1,length(line)-1)
  1034.     RETURN substr(last,1,length(last)-1)
  1035.  
  1036. GetaEnd: PROCEDURE
  1037.     PARSE ARG line "]" last
  1038.     IF last = "" THEN RETURN substr(line,1,length(line)-1)
  1039.     RETURN substr(last,1,length(last)-1)
  1040.  
  1041. GetLength: PROCEDURE
  1042.     PARSE UPPER ARG names
  1043.     nonletters = length(compress(names, xrange('A','Z')))
  1044.     RETURN Length(names) - nonletters * 4 / 10
  1045.  
  1046.     /* create a full name from first, last, and honorifics parts */
  1047.  
  1048. GetFullName: PROCEDURE EXPOSE thelastname
  1049.     PARSE ARG firstnames "," hon
  1050.     IF hon = "" THEN DO
  1051.         IF length(firstnames) > 2 THEN
  1052.             IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
  1053.                 firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
  1054.         RETURN firstnames thelastname
  1055.         END
  1056.     RETURN firstnames Space(thelastname) || ","hon
  1057.     
  1058. MGetFullName: PROCEDURE EXPOSE thelastname thegender
  1059.     PARSE ARG firstnames "," hon
  1060.     IF hon = "" THEN DO
  1061.         IF length(firstnames) > 2 THEN
  1062.             IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
  1063.                 firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
  1064.         RETURN firstnames thelastname
  1065.         END
  1066.     RETURN firstnames Space(thelastname) || ","hon
  1067.     
  1068. PGetFullName: PROCEDURE EXPOSE thelastname thegender
  1069.     PARSE ARG firstnames "," hon
  1070.     schar = "1"
  1071.     uchar = "2"
  1072.     IF thegender = "f" THEN DO
  1073.         schar = "3"
  1074.         uchar = "3"
  1075.         END
  1076.     IF hon = "" THEN DO
  1077.         IF length(firstnames) > 2 THEN
  1078.             IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
  1079.                 firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
  1080.         RETURN ""schar"m"firstnames thelastname""uchar"m"
  1081.         END
  1082.     RETURN ""schar"m"firstnames Space(thelastname) || ","hon""uchar"m"
  1083.  
  1084. GetLastName: PROCEDURE
  1085.     PARSE ARG str
  1086.     /* With "name exceptions", this routine is no longer required */
  1087.     RETURN str
  1088.  
  1089. Tell: PROCEDURE EXPOSE outp
  1090. parse arg str
  1091. if outp then writeln(stdout, str)
  1092. return 0
  1093.  
  1094. TellNN: PROCEDURE EXPOSE outp
  1095. parse arg str
  1096. if outp then writech(stdout, str)
  1097. return 0
  1098.  
  1099. IOERR:
  1100.   bline = SIGL
  1101.   say "I/O error #"||RC||" detected in line "||bline||":"
  1102.   say sourceline(bline)
  1103.   if pgopen then Postmsg()
  1104.   EXIT
  1105.