home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / purpt / dczy2kr.cbl next >
Text File  |  1998-03-01  |  136KB  |  3,108 lines
  1.        Identification Division.
  2.        Program-ID. dczy2kr.
  3.        Author. TH
  4.  
  5.       ******************************************************************
  6.       *                                                                *
  7.       *    Licensed Material - Property of IBM                         *
  8.       *                                                                *
  9.       *    5622-793 (C) Copyright IBM Corp., 1997                      *
  10.       *    All rights reserved                                         *
  11.       *                                                                *
  12.       *    US Government Users Restricted Rights - Use,                *
  13.       *    duplication or disclosure restricted by GSA ADP             *
  14.       *    Schedule Contract with IBM Corp.                            *
  15.       *                                                                *
  16.       *    2/27/97 - OS/2 version                                      *
  17.       *    8/25/97 - Updated for 9/97 NT Release                       *
  18.       *      1/27/98 - <MLE> tag with multiple (offset:length)         *
  19.       *                multiple result entries with one offset         *
  20.       *      2/10/98 - fix handling of <NAME> within <RESULT> block    *
  21.       *                and skip <INCLUDE> ... </INCLUDE> block         *
  22.       *                                                                *
  23.       ******************************************************************
  24.       *                                                                *
  25.       *  This program takes the Y2000 analysis tool output, which is   *
  26.       *  intended to be handled primarily by another tool, and         *
  27.       *  generates reports which can be used by analysts as well       *
  28.       *  as by other tools.                                            *
  29.       *                                                                *
  30.       *  This program uses the following seven files:                  *
  31.       *                                                                *
  32.       *    1) Input: generated with tagged entries from the            *
  33.       *       Year 2000 tool. This file is primarily intended for      *
  34.       *       processing by tools                                      *
  35.       *                                                                *
  36.       *    2) Input: seed file                                         *
  37.       *       Input seed file for the Year 2000 tool.                  *
  38.       *                                                                *
  39.       *    3) Output/Input: work file                                  *
  40.       *                                                                *
  41.       *    4) Output: Main report appropriate for review               *
  42.       *       by analysts (vs tools). Based on the output file 2)      *
  43.       *       above with added report headings added and the report    *
  44.       *       entries are ordered by the data names and the            *
  45.       *       data name declaration positions.                         *
  46.       *       Report entries for this file may be optionally loaded    *
  47.       *       into into a relational database for use with the tables  *
  48.       *       created from the entries from 4) and 6) below.           *
  49.       *                                                                *
  50.       *    5) Output: File ID report showing the map of file-ID's      *
  51.       *       included in files in 3) above to actual file names.      *
  52.       *       This file is intended to be used with the file 3) above. *
  53.       *       Report entries for this file may be optionally loaded    *
  54.       *       into into a relational database for use with the table   *
  55.       *       created from the entries from 3) above.                  *
  56.       *                                                                *
  57.       *    6) Output: Seed File report                                 *
  58.       *       This report is a copy of the input file 5) with the      *
  59.       *       following modifications:                                 *
  60.       *       a) The seed line number is added in the report.          *
  61.       *       b) Seeds not referenced in the report are excluded.      *
  62.       *                                                                *
  63.       *    7) Output: Cross Reference report                           *
  64.       *       This report includes cross reference for items           *
  65.       *       reported in the main report.                             *
  66.       *                                                                *
  67.       *  The following files will be created                           *
  68.       *  for the reports described above.                              *
  69.       *                                                                *
  70.       *     1) DCZWORK for the temporary work file                     *
  71.       *                                                                *
  72.       *     2) Main report file (.XRT):                                *
  73.       *        The reports described above as "Main report",           *
  74.       *        "File ID report" and "Seed File report" are             *
  75.       *        concatenated and produced on a single physical file.    *
  76.       *        The file name is based on the name of the .XRL file     *
  77.       *        with the last four characters replaced with ".XRT".     *
  78.       *        For example, it the .xrl file name is "mypgm.XRL",      *
  79.       *        the file name for this report would be "mypgm.XRT".     *
  80.       *        If the file name of the .xrl file is shorter than       *
  81.       *        five characters long, the report file name would be     *
  82.       *        programname.XRT in the current directory, where         *
  83.       *        "programname" is the name of the program being          *
  84.       *        analyzed.                                               *
  85.       *                                                                *
  86.       *        This file contains the four reports described           *
  87.       *        above.                                                  *
  88.       *          i.e. Main report, File ID report, and Seed file       *
  89.       *               report in that order.                            *
  90.       *                                                                *
  91.       *     3) Cross reference report file (.XRF):                     *
  92.       *        The report described as "Cross Reference report" above  *
  93.       *        is produced on a separate file.                         *
  94.       *        The file name is based on the name of the .XRL file     *
  95.       *        with the last four characters replaced with ".XRF".     *
  96.       *        For example, it the .xrl file name is "mypgm.XRF",      *
  97.       *        the file name for this report would be "mypgm.XRF".     *
  98.       *        If the file name of the .XRL file is shorter than       *
  99.       *        five characters long, the report file name would be     *
  100.       *        programname.XRF in the current directory, where         *
  101.       *        "programname" is the name of the program being          *
  102.       *        analyzed.                                               *
  103.       *                                                                *
  104.       *  DCZWORK will be allocated on the current directory unless     *
  105.       *  the environment variable DCZWORK is set. If DCZWORK is        *
  106.       *  set, the work file is allocated using the value of the        *
  107.       *  DCZWORK environment variable.                                 *
  108.       *----------------------------------------------------------------*
  109.       *  Invocation                                                    *
  110.       *                                                                *
  111.       *    This program is invoked from the Year 2000 tool             *
  112.       *    automatically if you specify  "DCZMKPU /r  ...".            *
  113.       *                                                                *
  114.       *    You can also invoke this program independently as follows:  *
  115.       *                                                                *
  116.       *      dczy2kr   aaa bbb                                         *
  117.       *                                                                *
  118.       *    where aaa and bbb are the names of the  .xrl  and  the .xsd *
  119.       *    with directory/path as appropriate.                         *
  120.       *                                                                *
  121.       *----------------------------------------------------------------*
  122.       *                                                                *
  123.       * The following are the current capacity limits for this         *
  124.       * program:                                                       *
  125.       *                                                                *
  126.       *   Maximum size of a single input report line:  800             *
  127.       *   Maximum number of source files:             9999             *
  128.       *   Maximum size of a single seed input line:    800             *
  129.       *   Maximum number of lines for seed file:       800             *
  130.       *                                                                *
  131.       * The above can be adjusted by changing the declarations for     *
  132.       * (and in some cases references to):                             *
  133.       *                                                                *
  134.       *   Rpt-In-Record, File-ID-Table-Entry, Seed-In-Record and       *
  135.       *   Seed-Line-Char, and Seed-Line-Referenced respectively        *
  136.       *                                                                *
  137.       *----------------------------------------------------------------*
  138.  
  139.       *================================================================*
  140.        Environment Division.
  141.       *================================================================*
  142.  
  143.        Configuration Section.
  144.        Input-Output Section.
  145.  
  146.        File-Control.
  147.  
  148.       *-File 1 (input)-------------------------------------------------*
  149.       *    Rpt-In: .xrl file                                           *
  150.       *----------------------------------------------------------------*
  151.            Select Rpt-In
  152.              Assign Using Rpt-In-Name
  153.              Organization is LINE SEQUENTIAL
  154.              File Status Is Rpt-In-FS.
  155.  
  156.       *-File 2 (input - Seed input)------------------------------------*
  157.       *    Rpt-Seed: .xsd file                                         *
  158.       *----------------------------------------------------------------*
  159.            Select Seed-In
  160.              Assign Using Seed-In-Name
  161.              Organization is LINE SEQUENTIAL
  162.              File Status is Seed-In-FS.
  163.  
  164.       *-File 3 (output/input - report work file)-----------------------*
  165.       *    Rpt-Work: unordered analysys report work file               *
  166.       *----------------------------------------------------------------*
  167.            Select Rpt-Work
  168.              Assign to DCZWORK
  169.              Organization is LINE SEQUENTIAL
  170.              File Status is Rpt-Work-FS.
  171.  
  172.       *-File 4 (output - main report)----------------------------------*
  173.       *    Rpt-Main: Ordered and formatted main report                 *
  174.       *----------------------------------------------------------------*
  175.            Select Rpt-Main
  176.              Assign Using Main-Report-File-Name
  177.              Organization is LINE SEQUENTIAL
  178.              File Status is Rpt-Main-FS.
  179.  
  180.  
  181.       *-File 5 (output - fileID report)--------------------------------*
  182.       *    Rpt-FileID: ordered and formatted File ID/File Name report  *
  183.       *----------------------------------------------------------------*
  184.            Select Optional Rpt-FileID
  185.              Assign Using Main-Report-File-Name
  186.              Organization is LINE SEQUENTIAL
  187.              File Status is Rpt-FileID-FS.
  188.  
  189.  
  190.       *-File 6 (output - Seed report)----------------------------------*
  191.       *    Rpt-Seed: referenced seed lines with line numbers           *
  192.       *----------------------------------------------------------------*
  193.            Select Optional Rpt-Seed-File
  194.              Assign Using Main-Report-File-Name
  195.              Organization is LINE SEQUENTIAL
  196.              File Status is Rpt-Seed-FS.
  197.  
  198.       *-File 7 (output - cross reference report)-----------------------*
  199.       *    Xref-File: referenced seed lines with line numbers          *
  200.       *----------------------------------------------------------------*
  201.            Select Xref-File
  202.              Assign Using Xref-Report-File-Name
  203.              Organization is LINE SEQUENTIAL
  204.              File Status is Rpt-Xref-FS.
  205.  
  206.       *-Sort file 1----------------------------------------------------*
  207.       *    Sort-Rpt: used to sort Rpt-Work and create                  *
  208.       *               Rpt-Main file                                    *
  209.       *----------------------------------------------------------------*
  210.            Select Sort-Rpt Assign to Sorti1.
  211.  
  212.        I-O-Control.
  213.  
  214.       *================================================================*
  215.        Data Division.
  216.       *================================================================*
  217.  
  218.       *================================================================*
  219.        File Section.
  220.       *================================================================*
  221.  
  222.       *------------------------------------------------------------*
  223.       *    Input report file for this program                      *
  224.       *------------------------------------------------------------*
  225.        FD  Rpt-In
  226.              Record is varying in size from 1 to 800 characters
  227.              depending on In-Rec-Length.
  228.  
  229.        01  Rpt-In-Record       Pic X(800).
  230.  
  231.       *------------------------------------------------------------*
  232.       *    Input seed file for this analysis                       *
  233.       *------------------------------------------------------------*
  234.        FD  Seed-In
  235.              Record is varying in size from 1 to 800 characters
  236.              depending on Seed-Rec-Length.
  237.  
  238.        01  Seed-In-Record       Pic X(800).
  239.  
  240.       *------------------------------------------------------------*
  241.       *    Report workfile (unordered)                             *
  242.       *------------------------------------------------------------*
  243.        FD  Rpt-Work.
  244.  
  245.        01  Rpt-Work-Xref-Record Pic X(130).
  246.  
  247.        01  Rpt-Work-Record      Pic X(300).
  248.  
  249.       *------------------------------------------------------------*
  250.       *    Main report output file (ordered and with headings)     *
  251.       *------------------------------------------------------------*
  252.        FD  Rpt-Main.
  253.  
  254.        01  Rpt-Main-Record             Pic X(78).
  255.  
  256.       *    ...this record is used to write > 78 character records
  257.       *       Note: trailing spaces are stripped for Line Sequential
  258.        01  Rpt-Main-Big-Record         Pic X(300).
  259.  
  260.       *------------------------------------------------------------*
  261.       *    File ID/File-Name table file (ordered by fileID)        *
  262.       *------------------------------------------------------------*
  263.        FD  Rpt-FileID.
  264.  
  265.        01  Rpt-FileID-Header-Record     Pic X(78).
  266.  
  267.        01  Rpt-FileID-Record.
  268.            02 File-ID-in-File           Pic 9999.
  269.            02 filler                    Pic X(5).
  270.            02 File-Name-in-File.
  271.               03 File-Name-Char-in-File Pic X
  272.                               Occurs 1 to 256 Times
  273.                                 Depending on Name-Length.
  274.  
  275.       *------------------------------------------------------------*
  276.       *    Seed report output file                                 *
  277.       *------------------------------------------------------------*
  278.        FD  Rpt-Seed-File.
  279.  
  280.        01  Rpt-Seed-Header-Record  Pic X(78).
  281.  
  282.        01  Rpt-Seed-Record.
  283.            02 filler-seed-no       Pic X(5).
  284.            02 Seed-Record-Char     Pic X
  285.                Occurs 1 to 800 Times
  286.                                 Depending on Seed-Rec-Length.
  287.  
  288.       *------------------------------------------------------------*
  289.       *    Xref report output file                                 *
  290.       *------------------------------------------------------------*
  291.        FD  Xref-File.
  292.  
  293.        01  Xref-Record              Pic X(78).
  294.  
  295.        01  Xref-Big-Record          Pic X(300).
  296.  
  297.       *------------------------------------------------------------*
  298.       *    Used to sort report the work file to write to the main  *
  299.       *    report file and the Xref reprt file                     *
  300.       *------------------------------------------------------------*
  301.        SD  Sort-Rpt.
  302.  
  303.       *    ...report entry record...
  304.        01  Rpt-Entry-S1.
  305.  
  306.       *       ...kind or xref record #.................(key 5)
  307.            02 Xref-Rec-No-S1.
  308.               03 Rpt-Kind-S1              Pic X(3).
  309.               03 filler                   Pic X.
  310.  
  311.       *       ...data-name.............................(Key 1)
  312.            02 Rpt-Name-S1                 Pic X(31).
  313.            02 filler                      Pic X.
  314.  
  315.       *       ...qualified or not, or Xref record......(Key 3)
  316.            02 Rpt-Qual-S1                 Pic X.
  317.               88  Record-is-for-Xref      Value 'X'.
  318.               88  Record-is-for-DN        Values 'Y', 'N'.
  319.            02 filler                      Pic X.
  320.  
  321.       *       ...Definition position...................(Key 2)
  322.            02 Rep-Def-Pos-S1.
  323.       *          ...Def line from <DEF-POS>...
  324.               03 Def-Line-S1              Pic ZZZZZ9.
  325.               03 filler                   Pic X.
  326.       *          ...Def file ID from <FILE>...
  327.               03 Def-File-S1              Pic ZZZ9.
  328.            02 filler                      Pic X.
  329.  
  330.       *       ...Year-Reason or Non-Year-Reason indicator
  331.            02 Year-Reason-or-Not-S1 Pic X.
  332.            02 filler                Pic X.
  333.  
  334.       *       ...Following depends on if it is a DN or Xref record
  335.            02 DN-Xref-Dependent-Part.
  336.  
  337.               03 DN-Only-Report-Grp.
  338.       *            ...cause from <REASON> entry........(Key 4)
  339.                  04 Rpt-Cause-S1.
  340.                     05 filler             Pic X.
  341.       *             ...Xref File ID if Xref work record
  342.                     05 Xref-File-ID-S1    Pic X(3).
  343.                     05 filler             Pic X(4).
  344.                  04 filler                Pic X.
  345.  
  346.       *             ...inference source...
  347.                  04 Inference-Source-S1   Pic X(239).
  348.  
  349.       *             ...seed line number...
  350.                  04 Rpt-Seed-Line-S1 Redefines Inference-Source-S1
  351.                                           Pic 9(4).
  352.  
  353.               03 Xref-Only-Report-Grp Redefines DN-Only-Report-Grp.
  354.  
  355.                  04 filler                Pic X.
  356.                  04 Xref-File-ID-Grp-S2.
  357.                     05 Xref-File-ID-S2    Pic XXX.
  358.                     05 filler             Pic XX.
  359.                  04 filler                Pic X(72).
  360.  
  361.  
  362.  
  363.       *================================================================*
  364.        Working-Storage Section.
  365.       *================================================================*
  366.        COPY dczy2kmc.
  367.  
  368.       *--------------------------------------------------------------*
  369.       *   Switches and data values used to trigger call to an exit   *
  370.       *--------------------------------------------------------------*
  371.  
  372.       *    ...switch to indicate if the exit is to be called or not...
  373.        01  Y2K-Exit-Flag                 Pic X
  374.                                          Value 'N'.
  375.            88 Y2K-Exit-On                Value 'Y'.
  376.            88 Y2K-Exit-Off               Value 'N'.
  377.  
  378.       *    ...name of the exit program...
  379.        01  Y2K-Exit-Program              Pic X(8)
  380.                                          Value 'Y2KEXIT'.
  381.  
  382.       *--------------------------------------------------------------*
  383.       *   Y2K-Exit initialization status & call function values      *
  384.       *--------------------------------------------------------------*
  385.  
  386.       *    ...initialization status...
  387.        01  Y2K-Exit-Program-Init         Pic X
  388.                                          Value '0'.
  389.             88 Y2K-Exit-Initialized      Value '1'.
  390.  
  391.  
  392.       *    ...Y2K-Exit function codes...
  393.        01  Y2k-Exit-Func                 Pic 9(4)
  394.                                          Value 9999.
  395.  
  396.            88 Y2K-Exit-Func-Init         Value 0.
  397.            88 Y2K-Exit-Func-Pgm-Name     Value 1.
  398.            88 Y2K-Exit-Func-DataItem-Def Value 2.
  399.            88 Y2K-Exit-Func-DataItem-Rsn Value 3.
  400.            88 Y2K-Exit-Func-Source       Value 4.
  401.            88 Y2K-Exit-Func-Term         Value 9000.
  402.            88 Y2K-Exit-Func-Term-Error   Value 9001.
  403.  
  404.       *------------------------------------*
  405.       *   File Status                      *
  406.       *------------------------------------*
  407.        01  Rpt-In-FS          Pic XX.
  408.            88 Rpt-In-EOF      Value '10'.
  409.  
  410.        01  Seed-In-FS         Pic XX.
  411.            88 Seed-In-EOF     Value '10'.
  412.  
  413.        01  Rpt-Work-FS        Pic XX.
  414.            88 Rpt-Work-EOF    Value '10'.
  415.  
  416.        01  Rpt-Main-FS        Pic XX.
  417.  
  418.        01  Rpt-FileID-FS      Pic XX.
  419.  
  420.        01  Rpt-Seed-FS        Pic XX.
  421.  
  422.        01  Rpt-Xref-FS        Pic XX.
  423.  
  424.       *----------------------------------------------------------------*
  425.       *  Output Record Setup Areas: Rpt-Work and Rpt-Main              *
  426.       *    Records are 78 or 300 characters long                       *
  427.       *----------------------------------------------------------------*
  428.  
  429.       *    ...Header Separator line...
  430.        01  Rpt-Separator Pic X(78)
  431.                       Value ALL '-'.
  432.  
  433.       *    ...Header Record 1 (title)...
  434.        01  Rpt-Hdr1.
  435.            02 Rpt-Hdr1-1 Pic X(31)
  436.                       Value 'Year 2000 Analysis Report for: '.
  437.            02 Rpt-Pgm-name   Pic X(30).
  438.  
  439.       *                          123456789A123456789B123456789D1234567
  440.       *    ...Column description(1)...
  441.        01  Rpt-Hdr2.
  442.            02 filler   Pic X(36)
  443.                       Value     'Year-usage                          '.
  444.            02 filler   Pic X(25)
  445.                       Value     'Name-qualification       '.
  446.            02 filler   Pic X(17)
  447.                       Value     'Seed-line-No or  '.
  448.  
  449.       *    ...Column description (2)...
  450.        01  Rpt-Hdr3.
  451.            02 filler   Pic X(36)
  452.                       Value     '| Y: Year  AY: Always-Year          '.
  453.            02 filler   Pic X(25)
  454.                       Value     '| Definition  Year or    '.
  455.            02 filler   Pic X(17)
  456.                       Value     'Inferred-from    '.
  457.  
  458.       *    ...Column header to column connection line...
  459.        01  Rpt-Hdr4.
  460.            02 filler   Pic X(36)
  461.                       Value     '| YNY: Year-and-Non-Year            '.
  462.            02 filler   Pic X(25)
  463.                       Value     '| |---------> Non-Year   '.
  464.            02 filler   Pic X(17)
  465.                       Value     '| expression     '.
  466.  
  467.       *    ...Column header to column connection line...
  468.        01  Rpt-Hdr5.
  469.            02 filler   Pic X(36)
  470.                       Value     '| NY: Non-Year ANY: Always-Non-Year '.
  471.            02 filler   Pic X(25)
  472.                       Value     '| Line   File |          '.
  473.            02 filler   Pic X(17)
  474.                       Value     '|                '.
  475.  
  476.       *    ...Column header to column connection line...
  477.        01  Rpt-Hdr6.
  478.            02 filler   Pic X(36)
  479.                       Value     '|   Data-Name                       '.
  480.            02 filler   Pic X(25)
  481.                       Value     '| -No    -ID  | Reason   '.
  482.            02 filler   Pic X(17)
  483.                       Value     '|                '.
  484.  
  485.  
  486.       *    ...Column header to column connection line...
  487.        01  Rpt-Hdr7.
  488.            02 filler   Pic X(36)
  489.                       Value     '|-> |-----------------------------> '.
  490.            02 filler   Pic X(25)
  491.                       Value     '| |----> |--> | |------> '.
  492.            02 filler   Pic X(17)
  493.                       Value     '|--------------->'.
  494.  
  495.  
  496.       *---------------------------------------------------------*
  497.       *    File name header records                             *
  498.       *---------------------------------------------------------*
  499.        01  Source-File-Name-Header.
  500.               03 filler        Pic X(22)
  501.                                Value ' Source program file: '.
  502.            02 Source-File-Name-in-Header.
  503.                04 filler       Pic X
  504.                       Occurs 1 to 256 Times
  505.                         Depending on Source-File-Name-Length.
  506.  
  507.        01  Seed-File-Name-Header.
  508.            02 filler           Pic X(22)
  509.                                Value ' Seed File: '.
  510.            02 Seed-File-Name-in-Header.
  511.                04 filler       Pic X
  512.                       Occurs 1 to 256 Times
  513.                         Depending On Seed-In-Name-Length.
  514.  
  515.  
  516.        01  Xrl-File-Name-Header.
  517.            02 filler           Pic X(22)
  518.                                Value ' Xrl file: '.
  519.            02 Xrl-File-Name-in-Header.
  520.               03 filler        Pic X
  521.                       Occurs 1 to 256 Times
  522.                         Depending On Rpt-In-Name-Length.
  523.  
  524.       *.........................................................*
  525.       *    Time stamp header record                             *
  526.       *.........................................................*
  527.        01  Time-Stamp-Header.
  528.            02 filler            Pic X(29)
  529.                                 Value ' Report process started at: '.
  530.            02 Current-Month     Pic X(4).
  531.            02 Current-Day       Pic 99.
  532.            02 filler            Pic XX
  533.                                 Value    ', '.
  534.            02 Current-Year.
  535.               03 Current-Cent   Pic 99.
  536.               03 Current-Yr     Pic 99.
  537.            02 filler            Pic X(8)
  538.                                 Value    '  Time: '.
  539.            02 Current-Time.
  540.               03 Current-Hour   Pic 99.
  541.               03 filler         Pic X
  542.                                 Value   ':'.
  543.               03 Current-Minute Pic 99.
  544.               03 filler         Pic X
  545.                                 Value   ':'.
  546.               03 Current-Second Pic 99.
  547.               03 filler         Pic X
  548.                                 Value   ':'.
  549.               03 Current-CentiS Pic 99.
  550.            02 filler          Pic X(16)
  551.                               value    spaces.
  552.  
  553.       *    ...used with current-date...
  554.        01  Current-YYYYMMDD.
  555.            02 Current-YYYY    Pic 9999.
  556.            02 Current-MM      Pic 99.
  557.            02 Current-DD      Pic 99.
  558.  
  559.       *    ...used with Accept from Time...
  560.        01  Current-HHMMSSCC.
  561.            02 Current-HH      Pic 99.
  562.            02 Current-MI      Pic 99.
  563.            02 Current-SS      Pic 99.
  564.            02 Current-CC      Pic 99.
  565.  
  566.       *    ...Month conversion table...
  567.        01  Names-of-Months    Pic X(48)
  568.              Value 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec '.
  569.  
  570.        01  Current-Month-Table Redefines Names-of-Months.
  571.            02 Which-Month
  572.                 Occurs 12 times
  573.                               Pic x(4).
  574.  
  575.       *---------------------------------------------------------*
  576.       *    Main report entry record:                            *
  577.       *     It is 300 characters long. The trailing spaces will *
  578.       *     removed as part of Line Sequential file output      *
  579.       *     processing.                                         *
  580.       *---------------------------------------------------------*
  581.        01  Rpt-Entry-Table.
  582.  
  583.            02  Rpt-Entry-No   Pic   999 Value 0.
  584.  
  585.            02  Rpt-Entry     OCCURS 100 Times.
  586.       *       ...kind info from <REASON> entry...
  587.              03 Rpt-Kind        Pic X(3)
  588.                                 Value spaces.
  589.                88 Kind-Y        Value 'Y'.
  590.                88 Kind-NY       Value 'NY'.
  591.                88 Kind-YNY      Value 'YNY'.
  592.                88 Kind-AY       Value 'AY'.
  593.                88 Kind-ANY      Value 'ANY'.
  594.                88 Kind-Unknown  Value '***'.
  595.                88 Kind-spaces   Value spaces.
  596.              03 filler          Pic X
  597.                                 Value space.
  598.  
  599.       *       ...unqualified data-name from <NAME> entry...
  600.              03 Rpt-Name        Pic X(31).
  601.              03 filler          Pic X
  602.                                 Value space.
  603.  
  604.       *       ...if nameis qualified or not, or Xref info record...
  605.              03 Rpt-Qual        Pic X.
  606.                88 Qual-Y        Value 'Y'.
  607.                88 Qual-N        Value 'N'.
  608.                88 Qual-X        Value 'X'.
  609.              03 filler          Pic X
  610.                                 Value space.
  611.  
  612.       *       ...Definition position...
  613.              03 Rpt-Def-Pos.
  614.       *          ...Def line from <DEF-POS>...
  615.                 04 Def-Line     Pic ZZZZZ9.
  616.                 04 filler       Pic X
  617.                                 Value space.
  618.  
  619.       *          ...Def file ID from <FILE>...
  620.                 04 Def-File     Pic ZZZ9.
  621.              03 filler          Pic X
  622.                                 Value space.
  623.  
  624.       *       ...indicate YEAR-REASON or NON-YEAR-REASON...
  625.              03 Year-Reason-or-Not Pic X.
  626.                 88 Year-Reason-Y Value 'Y'.
  627.                 88 Year-Reason-N Value 'N'.
  628.              03 filler          Pic X
  629.                                 Value space.
  630.  
  631.       *       ...Reason type...
  632.              03 Rpt-Cause       Pic X(8).
  633.              03 filler          Pic X
  634.                                 Value space.
  635.  
  636.       *       ...inference source...
  637.              03 Inference-Source Pic X(239).
  638.  
  639.       *       ...seed line number...
  640.              03 Rpt-Seed Redefines Inference-Source
  641.                                 Pic 9(4).
  642.       *---------------------------------------------------------*
  643.       *    End of base report entry set-up area                 *
  644.       *    Used to modify 'MLE' reason with (offset:size)       *
  645.       *---------------------------------------------------------*
  646.            02 Offset-Size-Info   OCCURS 100 Times.
  647.               03 Offset          Pic 9(10).
  648.               03 filler redefines Offset.
  649.                  04 filler       Pic 9(9).
  650.                  04 Short-Offset Pic 9.
  651.               03 Size-Value    Pic 9(10).
  652.               03 filler redefines Size-Value.
  653.                  04 filler       Pic 9(9).
  654.                  04 Short-Size   Pic 9.
  655.       *---------------------------------------------------------*
  656.       *    End of Rpt-Entry-Table                               *
  657.       *---------------------------------------------------------*
  658.  
  659.       *---------------------------------------------------------*
  660.       *    Switch for processing multiple result entries for    *
  661.       *    a name. Yes for MLE or for the same Offset           *                                     *
  662.       *---------------------------------------------------------*
  663.        01  Process-Result-Sw            Pic 9.
  664.            88 Process-Result-Entry      Value 0.
  665.            88 Dont-Process-Result-Entry Value 1.
  666.  
  667.       *---------------------------------------------------------*
  668.       *    Cross Reference Info Work Record (as written to      *
  669.       *    Rpt-Work file). It is 78 characters long.            *
  670.       *---------------------------------------------------------*
  671.        01  Xref-Work-Record.
  672.  
  673.       *    ...portion used only for sorting
  674.            02 Xref-for-Sort-Only-Grp.
  675.       *       ...Kind + sp. used as XREF record # for XREF.(SORT Key 5)
  676.               03 XREF-Rec-No          Pic 9(4).
  677.  
  678.  
  679.               03 Xref-Name-ID-X.
  680.       *            ...unqualified data-name................(SORT Key 1)
  681.                 04 Xref-Name-X        Pic X(31).
  682.                 04 filler             Pic X.
  683.  
  684.       *            ...name qualified or not or Xref info...(SORT Key 3)
  685.                 04 Xref-Qual-X        Pic X     Value 'X'.
  686.                 04 filler             Pic X.
  687.  
  688.       *          ...Definition position....................(SORT Key 2)
  689.                 04 Xref-Def-Pos-X.
  690.                   05 filler           Pic X.
  691.                   05 Xref-Def-Line-X  Pic X(6).
  692.                   05 filler           Pic X.
  693.                   05 Xref-Def-File-ID-X Pic XXX.
  694.  
  695.                 04 filler             Pic X.
  696.  
  697.               03 Xref-Reason-or-Not   Pic X.
  698.               03 filler               Pic X.
  699.  
  700.       *    ...portin used in Xref report
  701.            02 Xref-Only-Grp.
  702.               03 filler               Pic X     Value space.
  703.       *          ...Xref File ID...........................(SORT Key 4)
  704.               03 Xref-File-ID         Pic XXX   Value spaces.
  705.               03 Xref-File-ID-Del     Pic XX    Value ': '.
  706.  
  707.       *          ...Xref line #'s...
  708.               03 Xref-Line-Numbers    Pic X(72) Value spaces.
  709.       *---------------------------------------------------------*
  710.       *    End of Xref work record set-up area                  *
  711.       *---------------------------------------------------------*
  712.  
  713.       *----------------------------------------------------------------*
  714.       *  End of record setup areas for Rpt-Work & Rpt-Main             *
  715.       *----------------------------------------------------------------*
  716.  
  717.       *----------------------------------------------------------------*
  718.       *  FileID report record set-up areas                             *
  719.       *----------------------------------------------------------------*
  720.  
  721.       *    ...Header record 1 (Report tiltle)...
  722.        01  File-ID-Hdr1.
  723.            02 filler          Pic X(19)
  724.                               Value 'File ID Table for: '.
  725.            02 File-ID-Hdr1-2  Pic X(30).
  726.  
  727.       *    ...Report column description...
  728.        01  File-Id-Hdr2       Pic X(18)
  729.                               Value 'File-ID  File-Name'.
  730.  
  731.       *    ...Column header to column connection line...
  732.        01  File-ID-Hdr3       Pic X(10)
  733.                               Value '|-->     |'.
  734.  
  735.       *    ...main FileID report record...
  736.        01  File-ID-Entry.
  737.            02 File-ID           Pic 9999.
  738.            02 filler            Pic X(5)
  739.                                 Value spaces.
  740.            02 File-Name-Length  Pic 9(3) Value 0.
  741.            02 File-Name         Pic X(256).
  742.       *...End of record setup areas for Rpt-FileID file...
  743.  
  744.  
  745.       *-------------------------------------------------*
  746.       *  End of setup areas for Rpt-FileID file         *
  747.       *-------------------------------------------------*
  748.  
  749.       *----------------------------------------------------------------*
  750.       *   FileID table for FileID/File Name mapping                    *
  751.       *----------------------------------------------------------------*
  752.        01  File-Id-Table.
  753.            02 File-ID-Table-Entry
  754.                 Occurs 0 to 1000 Times
  755.                   Depending on Number-of-Files
  756.                   Indexed by FileID-IX.
  757.       *         ...will handle upto 1000 source files...
  758.               03 File-ID-in-Table.
  759.                  04 File-ID-No      Pic ZZZ9.
  760.               03 File-Name-Size     Pic 9(3).
  761.               03 File-Name-in-Table Pic X(256).
  762.  
  763.       *...Use for subscripting File-ID-Table or CauseID-Table...
  764.        01  IX                       Pic 9(4).
  765.  
  766.       *...Number of source files reported in the input
  767.        01  Number-of-Files          Pic 9(4) Value 0.
  768.  
  769.       *----------------------------------------------------------------*
  770.       *   Rpt-Seed file record set-up areas                            *
  771.       *----------------------------------------------------------------*
  772.        01  Rpt-Seed-Title-Record.
  773.            02 filler               Pic X(28) Value
  774.               'Seed Input File Report for: '.
  775.            02 Seed-Title-Pgm       Pic X(30).
  776.  
  777.        01  Rpt-Seed-Column-Header-1 Pic X(78) Value
  778.            'Seed-line-number      '.
  779.  
  780.        01  Rpt-Seed-Column-Header-2 Pic X(78) Value
  781.            '|    Seed-specification  '.
  782.  
  783.        01  Rpt-Seed-Column-Header-3 Pic X(78) Value
  784.            '|--> |                       '.
  785.  
  786.        01  Rpt-Seed-Record-Ws.
  787.            02 Seed-Line-No          Pic X(4).
  788.            02 filler                Pic X
  789.                                     Value space.
  790.            02 Seed-Line.
  791.               03 Seed-Line-Char     Pic X
  792.                    Occurs 1 to 800 times
  793.                      Depending on Seed-Rec-Length.
  794.  
  795.  
  796.       *--------------------------------------------------------------*
  797.       *    Xref report record set-up areas                           *
  798.       *--------------------------------------------------------------*
  799.  
  800.       *    ...Xref report header file (used with base report headers)
  801.        01  Xref-Rpt-Hdr1.
  802.            02 filler                Pic X(47)
  803.                 Value 'Year 2000 Analysis Cross Reference Report for: '.
  804.            02 Xref-Rpt-Pgm-name     Pic X(31).
  805.  
  806.       *    ...Xref report layout info header 1...
  807.        01  Xref-Rpt-Layout-Hdr1.
  808.            02 filler                Pic X(32)
  809.                 Value 'Data name                       '.
  810.            02 filler                Pic X(22)
  811.                 Value '(Def Line-No/File-ID) '.
  812.            02 filler                Pic X(24)
  813.       *         Value 'Total No of references '.
  814.                 Value '                       '.
  815.  
  816.       *    ...Xref report layout info header 2...
  817.        01  Xref-Rpt-Layout-Hdr2.
  818.            02 filler                Pic X(33)
  819.                 Value ' FileID: Referencing line numbers'.
  820.            02 filler                Pic X(45)
  821.                 Value spaces.
  822.  
  823.       *    ...Xref report Layout info header 2A...
  824.        01  Xref-Rpt-Layout-Hdr2A.
  825.            02  filler               Pic X(45)
  826.                  Value '          r: referenced '.
  827.            02  filler               Pic X(33)
  828.                  Value spaces.
  829.  
  830.       *    ...Xref report Layout info header 2A...
  831.        01  Xref-Rpt-Layout-Hdr2B.
  832.            02  filler               Pic X(45)
  833.                  Value '          m: modified '.
  834.            02  filler               Pic X(33)
  835.                  Value spaces.
  836.  
  837.       *    ...Xref report Layout info header 2A...
  838.        01  Xref-Rpt-Layout-Hdr2C.
  839.            02  filler               Pic X(45)
  840.                  Value '          e: external '.
  841.            02  filler               Pic X(33)
  842.                  Value spaces.
  843.  
  844.       *    ...Xref report record for DN, (Def-Line/FileID) & Ref Count..
  845.        01  Xref-DN-Record.
  846.            02 Xref-DN               Pic X(31).
  847.            02 filler                Pic X    Value space.
  848.            02 Xref-Def.
  849.               03 filler             Pic X    Value '('.
  850.               03 Xref-Def-Line      Pic X(6).
  851.               03 filler             Pic X    Value '/'.
  852.               03 Xref-Def-File-ID   Pic XXX.
  853.               03 filler             Pic XX   Value ') '.
  854.       *       03 Xref-Ref-Count     Pic 9(6) Value 0.
  855.               03 Xref-Ref-Count     Pic X(6) Value spaces.
  856.  
  857.       *    ...Xref report record for Ref-File-ID: Ref lines
  858.        01  Xref-Ref-Record.
  859.            02 filler              Pic X    Value space.
  860.            02 Xref-Ref-File-ID-Grp.
  861.               03 Xref-Ref-File-ID   Pic XXX.
  862.               03 filler             Pic XX   Value ': '.
  863.            02 Xref-Refs             Pic X(72).
  864.  
  865.        01  Xref-Refs-Pos            Pic 99   Value 1.
  866.       *--------------------------------------------------------------*
  867.       *    End of Xref report record set-up areas                    *
  868.       *--------------------------------------------------------------*
  869.  
  870.  
  871.       *.....................................................*
  872.       *   Current tag found and being processed             *
  873.       *.....................................................*
  874.        01  Current-Tag        Pic X(28).
  875.  
  876.       *    ...top level tag values...
  877.       *         Note: end-tags (i.e. </...>) may not be present
  878.            88 HeaderTag                 Value '<HEADER>'.
  879.             88 HeaderProgramTag       Value '<PROGRAM>'.
  880.              88 AnalizedAtTag       Value '<ANALIZED AT>'.
  881.             88 InputSeedFileTag       Value '<INPUT-SEED-FILE>'.
  882.              88 SavedATTag          Value '<SAVED AT>'.
  883.             88 OutputOptionTag        Value '<OUTPUT-OPTIONS>'.
  884.             88 OutputOptionEndTag     Value '</OUTPUT-OPTIONS>'.
  885.            88 HeaderEndTag              Value '</HEADER>'.
  886.  
  887.            88 ProgramTag                Value '<PROGRAM>'.
  888.  
  889.             88 ProgramInfoTag         Value '<PROGRAM-INFO>'.
  890.             88 ProgramInfoEndTag      Value '<PROGRAM-INFO>'.
  891.  
  892.             88 DDNameTag              Value '<DDNAME>'.
  893.             88 DDNameEndTag           Value '</DDNAME>'.
  894.  
  895.             88 NameTag                 Value '<NAME>'.
  896.             88 ExternalNameTag         Value '<EXTERNAL-NAME>'.
  897.              88 SizeTag             Value '<SIZE>'.
  898.              88 DimensionsTag       Value '<DIMENSIONS>'.
  899.  
  900.              88 ResultTag           Value '<RESULT>'.
  901.               88 YearTag          Value '<USED-AS-YEAR>'.
  902.               88 NYearTag         Value '<USED-AS-NON-YEAR>'.
  903.               88 YearNYearTag     Value '<USED-AS-YEAR-AND-NON-YEAR>'.
  904.               88 AYearTag         Value '<ALWAYS-YEAR>'.
  905.               88 ANonYearTag      Value '<ALWAYS-NON-YEAR>'.
  906.  
  907.                88 IndexTag      Value '<INDEX>'.
  908.                88 LengthTag     Value '<LENGTH>'.
  909.                88 YearReasonTag Value '<YEAR-REASON>'.
  910.                88 NonYearReasonTag Value '<NON-YEAR-REASON>'.
  911.       *           ...'reason' tag values within <YEAR-REASON> entry...
  912.                 88 BuiltInC              Value '<BUILTIN-YEAR>'.
  913.                 88 CallC       Value '<CALL>'.
  914.                 88 CicsFileNmC Value '<CICS-FILE-NAME>'.
  915.                 88 CicsFileVarC
  916.                                Value '<CICS-FILE-VARIABLE>'.
  917.                 88 DatabaseC   Value '<DATABASE>'.
  918.                 88 DDNameC     Value '<DDNAME>'.
  919.                 88 IncludeC    Value '<INCLUDE>'.
  920.                 88 InferenceC  Value '<INFERENCE>'.
  921.                 88 MLEC        Value '<MLE>'.
  922.                 88 NameC       Value '<NAME>'.
  923.                 88 PatternC    Value '<PATTERN>'.
  924.  
  925.                88 YearReasonEndTag
  926.                                  Value '</YEAR-REASON>'.
  927.                88 NonYearReasonEndTag
  928.                                  Value '</NON-YEAR-REASON>'.
  929.               88 YearEndTag        Value '</USED-AS-YEAR>'.
  930.               88 NYearEndTag       Value '</USED-AS-NON-YEAR>'.
  931.               88 YearNYearEndTag   Value '</USED-AS-YEAR-AND-NON-YEAR>'.
  932.               88 AYearEndTag       Value '</ALWAYS-YEAR>'.
  933.               88 ANYearEndTag      Value '</ALWAYS-NON-YEAR>'.
  934.              88 ResultEndTag         Value '</RESULT>'.
  935.  
  936.              88 FileTag              Value '<FILE>'.
  937.               88 Def-PosTag        Value '<DEF-POS>'.
  938.               88 Def-PosEndTag     Value '</DEF-POS>'.
  939.               88 PosTag            Value '<POS>'.
  940.               88 PosEndTag         Value '</POS>'.
  941.              88 FileEndTag           Value '</FILE>'.
  942.  
  943.             88 NameEndTag              Value '</NAME>'.
  944.             88 ExternalNameEndTag      Value '</EXTERNAL-NAME>'.
  945.  
  946.             88 IncludeTag              Value '<INCLUDE>'.
  947.             88 IncludeEndTag           Value '</INCLUDE>'.
  948.  
  949.             88 AnnotateTag             Value '<ANNOTATE>'.
  950.             88 AnnotateEndTag          Value '</ANNOTATE>'.
  951.  
  952.            88 ProgramEndTag              Value '</PROGRAM>'.
  953.  
  954.       *............................................*
  955.       *    Tag processing state switches           *
  956.       *............................................*
  957.        01  Level1-Tag-Block          Pic 9 Value 0.
  958.            88  Header-Block                Value 1.
  959.            88  Program-Block               Value 2.
  960.            88  Level1-Tag-Block-Off        Value 0.
  961.  
  962.       *    ...tag blocks within <PROGRAM>-</PROGRAM> block
  963.        01  Level2-Tag-Block          Pic 9 Value 0.
  964.            88  Program-Info-Block          Value 1.
  965.            88  DDname-Block                Value 2.
  966.            88  Name-Block                  Value 3.
  967.            88  Field-Name-Block            Value 4.
  968.            88  Include-Block               Value 5.
  969.  
  970.            88  Level2-Tag-Block-Off        Value 0.
  971.            88  Include-Block-Off           Value 0.
  972.            88  DDName-Block-Off            value 0.
  973.  
  974.       *    ...tag blocks within <NAME>-</NAME> block for a field
  975.        01  Level3-Tag-Block          Pic 9 Value 0.
  976.            88  Result-Block                Value 1.
  977.            88  File-Block                  Value 2.
  978.            88  Level3-Tag-Block-Off        Value 0.
  979.  
  980.       *................................................*
  981.       *       indicator set by Get-Next-Token routine  *
  982.       *       if '<' is found before next token...     *
  983.       *................................................*
  984.        01  Tag-Beg            Pic 9     value 0.
  985.            88 Tag-Beg-Found             Value 1.
  986.            88 Tag-Beg-Not-Found         Value 0.
  987.  
  988.       *...Current kind...
  989.        01  Current-Kind       Pic X(3).
  990.  
  991.       *...Current cause (shown in .XRT report)...
  992.        01  Current-Cause      Pic X(8).
  993.            88 Built-In        Value 'BuiltIn'.
  994.            88 CallCause       Value 'Call'.
  995.            88 CicsFileNm      Value 'CICSFNm'.
  996.            88 CicsFileVar     Value 'CICSFVar'.
  997.            88 DataBase        Value 'DataBase'.
  998.            88 DDName          Value 'DDName'.
  999.            88 Include         Value 'Include'.
  1000.            88 Inference       Value 'Inferred'.
  1001.            88 MLE             Value 'MLE( : )'.
  1002.            88 NameCause       Value 'Name'.
  1003.            88 Pattern         Value 'Pattern'.
  1004.  
  1005.            88 Cause-Unknown   Value '********'.
  1006.  
  1007.       *...Current Ref count...
  1008.        01  Current-Ref-Count  Pic 999999.
  1009.  
  1010.  
  1011.       *...Tag constants used to scan input file
  1012.        01  OpenTag            Pic X     Value '<'.
  1013.        01  CloseTag           Pic X     Value '>'.
  1014.  
  1015.       *...<PROGRAM> tag status
  1016.        01  Program-Tag-Status Pic X       Value '0'.
  1017.            88 Program-Tag-Not-In-Progress Value '0'.
  1018.            88 Program-Tag-In-Progress     Value '1'.
  1019.  
  1020.       *...<NAME> tag status
  1021.        01  Name-Tag-Status    Pic X       Value '0'.
  1022.            88 Name-Tag-Not-In-Progress    Value '0'.
  1023.            88 Name-Tag-In-Progress        Value '1'.
  1024.  
  1025.       *...<RESULT> tag status
  1026.        01  Result-Tag-Status  Pic X       Value '0'.
  1027.            88 Result-Tag-Not-In-Progress  Value '0'.
  1028.            88 Result-Tag-In-Progress      Value '1'.
  1029.  
  1030.       *...Current file I/O operation
  1031.        01  File-IO-Req        Pic X(5)  Value spaces.
  1032.            88 OpenFile        Value 'Open'.
  1033.            88 CloseFile       Value 'Close'.
  1034.            88 ReadFile        Value 'Read'.
  1035.            88 WriteFile       Value 'Write'.
  1036.            88 SortFile        Value 'Sort'.
  1037.  
  1038.       *----------------------------------------------------*
  1039.       *   Input file names for .XRL and XSD files          *
  1040.       *----------------------------------------------------*
  1041.        01  Rpt-In-Name            Pic X(256)
  1042.                                   Value spaces.
  1043.         01  Rpt-In-Name-Length     Pic 999 Value 1.
  1044.  
  1045.        01  Seed-In-Name           Pic X(256)
  1046.                                   Value spaces.
  1047.         01  Seed-In-Name-Length    Pic 999 Value 1.
  1048.  
  1049.       *----------------------------------------------------*
  1050.       *   Source file name                                 *
  1051.       *----------------------------------------------------*
  1052.        01  Source-File-Name       Pic X(256)
  1053.                                   Value spaces.
  1054.         01  Source-File-Name-Length Pic 999 Value 1.
  1055.  
  1056.       *----------------------------------------------------*
  1057.       *   System file names for the report output files    *
  1058.       *----------------------------------------------------*
  1059.        01  Main-Report-File-name  Pic X(256)
  1060.                                   Value spaces.
  1061.         01  Main-Report-File-Name-Length Pic 999 Value 1.
  1062.  
  1063.        01  Xref-Report-File-name  Pic X(256)
  1064.                                   Value spaces.
  1065.         01  Xref-Report-File-Name-Length Pic 999 Value 1.
  1066.  
  1067.       *-----------------------------------------------------------*
  1068.       *   Current analysis entry item information                 *
  1069.       *   Some are used (possibly) for multiple report entries    *
  1070.       *-----------------------------------------------------------*
  1071.  
  1072.       *------------------------*
  1073.       *   Program name Info    *
  1074.       *------------------------*
  1075.       *    ...current program name
  1076.        01  Current-Program-Name  Pic X(256) value spaces.
  1077.  
  1078.       *    ...current program name length
  1079.        01  Program-Name-Length   Pic 999    Value 0.
  1080.  
  1081.       *--------------------------------------------*
  1082.       *   Current Data-Name (variable name) Info   *
  1083.       *--------------------------------------------*
  1084.       *    ...current (unqualified) data name
  1085.        01  Current-Name          Pic X(31)  value spaces.
  1086.  
  1087.        01  Name-Length           Pic 999.
  1088.  
  1089.       *    ... numbers of <name> tags without </name> yet
  1090.        01  No-of-NameTags-Pending Pic 99 Value 0.
  1091.  
  1092.       *    ...number of names in the current name structure
  1093.        01  No-of-Names-with-Qual  Pic 99 Value 0.
  1094.  
  1095.       *    ...Names in the current name structure
  1096.       *    ...the top level structure first and the field last
  1097.        01  Name-with-Qualifiers.
  1098.            02 Data-Name
  1099.                    Occurs 1 to 49 Times
  1100.                      Depending on No-of-Names-with-Qual
  1101.                                       Pic X(31).
  1102.  
  1103.        01  Current-Name-Qual     Pic X.
  1104.            88 Qualified          Value 'Y'.
  1105.            88 Not-Qualified      Value 'N'.
  1106.  
  1107.       *----------------------------------------------*
  1108.       *   Declaration postion for the current item   *
  1109.       *----------------------------------------------*
  1110.        01  Current-Def-Pos.
  1111.            02 Current-Def-Line   Pic 9(6).
  1112.            02 filler             Pic X      value space.
  1113.            02 Current-Def-FileID Pic 9999.
  1114.  
  1115.       *----------------------------*
  1116.       *   Current File Name Info   *
  1117.       *----------------------------*
  1118.        01  Current-File-Name     Pic X(256) value spaces.
  1119.        01  Current-FileID        Pic 9999.
  1120.  
  1121.       *---------------------------*
  1122.       *   Current "reason" Info   *
  1123.       *---------------------------*
  1124.        01  Current-Cause-String  Pic X(256) value spaces.
  1125.        01  Current-CauseID       Pic 9999.
  1126.  
  1127.       *--------------------------------*
  1128.       *   Seed line reference Info     *
  1129.       *--------------------------------*
  1130.        01  Current-Seed-Line     Pic XXXX.
  1131.  
  1132.       *    ...Current-Seed-Line set from the last 4 character
  1133.       *       positions of Line-No which is padded with spaces
  1134.       *       to the left...
  1135.  
  1136.       *...In memory table for Seed line numbers referenced in report...
  1137.        01  Referenced-Seed-Line-Table.
  1138.            02 Seed-Line-Referenced       Pic X
  1139.                 Occurs 8000 Times.
  1140.  
  1141.        01  Max-Seed-Line                 Pic 9(4)
  1142.                                          Value zero.
  1143.  
  1144.       *    ...Seed file record number just read...
  1145.        01  Seed-In-Rec-No                Pic 9(4)
  1146.                                          Value zero.
  1147.  
  1148.       *-----------------------------------*
  1149.       *   Current referencing File-ID     *
  1150.       *    It is used in Sort Output Proc *
  1151.       *-----------------------------------*
  1152.        01  Current-Xref-File-ID   Pic 999
  1153.                                   Value 0.
  1154.  
  1155.       *----------------------*
  1156.       *   Line number Info   *
  1157.       *----------------------*
  1158.       *...stating line number set by Get-Starting-Line-Number
  1159.       *   aligned on right padded with spaces (if any) to the left...
  1160.        01  Line-No                      Pic X(6).
  1161.            88 Line-No-NA          Value '   n/a'.
  1162.            88 Line-No-not-there   Value '******'.
  1163.            88 Line-No-Space       Value spaces.
  1164.  
  1165.       *    ...same as Line-No but is numeric....
  1166.        01  Line-No-9s                   Pic 9(6).
  1167.  
  1168.  
  1169.       *    ...number of digits in Line-No...
  1170.        01  Line-No-Size           Pic 999  Value 0.
  1171.  
  1172.  
  1173.       *    ...Line-No concatenated with Ref type info
  1174.        01  Line-No-W-Ref-Type-Info      Pic X(9) Value spaces.
  1175.        01  Line-No-W-Ref-Type-Info-Size Pic 99.
  1176.  
  1177.  
  1178.       *    ...indicator for if valid Line-No is found.
  1179.       *       It is set by Get-Start-Line-Number routine...
  1180.        01  Line-No-Found-Status         Pic 9
  1181.                                  Value 0.
  1182.            88 Line-No-Not-Found  Value 0.
  1183.            88 Line-No-Found      Value 1.
  1184.  
  1185.        01  Seed-Rec-Length              Pic 999.
  1186.  
  1187.       *.................................................*
  1188.       *  Processing status for In-Rec                   *
  1189.       *.................................................*
  1190.        01  In-Rec-Status.
  1191.  
  1192.       *    ...Record length for the input record...
  1193.            02 In-Rec-Length      Pic 9(4).
  1194.  
  1195.       *    ...Starting char position in record buffer to be analyzed...
  1196.            02 In-Rec-Pos         Pic 9(4).
  1197.  
  1198.       *    ...Number of char positions left in the buffer to be analyzed
  1199.            02 In-Rec-Left        Pic S9(4).
  1200.  
  1201.       *    ...Ending char position in record buffer analyzed...
  1202.            02 In-Rec-Last-Processed-Pos  Pic 9(4).
  1203.       *    ...Current input record being processed...
  1204.  
  1205.            02 Rpt-In-Record-No   Pic 9(9) value 0.
  1206.  
  1207.       *    ...status on whether a "previous" input record exists.
  1208.       *       It is used by Get-Rpt-In-Record routine...
  1209.            02 In-Rec-Read-Status Pic X value 'N'.
  1210.               88 In-Rec-Read           value 'Y'.
  1211.  
  1212.  
  1213.       *    ...first <FILE> tag in <PROGRAM-INFO> tag block
  1214.        01  File-Tag-in-PROGRAM-INFO         Pic 9  value 0.
  1215.            88 First-File-in-Program-Info           Value 0.
  1216.            88 Not-First-File-in-Program-Info       value 1.
  1217.  
  1218.  
  1219.       *...Tag found switch...
  1220.        01  Tag-Found-Sw          Pic 9.
  1221.            88 tag-found          Value 1.
  1222.            88 tag-not-found      Value 0.
  1223.  
  1224.       *...Number of chars from current-pos before the searched char
  1225.        01 Count-Before-Found     Pic 9(4).
  1226.  
  1227.       *...Indication to prematually terminate the processing
  1228.        01 Quit-SW                Pic 9 Value 0.
  1229.           88 Quit-this                 Value 1.
  1230.  
  1231.       *    ...uptp 100 chars of previous Rpt-In record used for
  1232.       *       error messages...
  1233.        01  Prev-In-Rec                   Pic X(200).
  1234.        01  Prev-In-Rec-Length            Pic 9999.
  1235.  
  1236.       *------------------------*
  1237.       *   Current token Info   *
  1238.       *------------------------*
  1239.       *...Area to store a token. This is set by Get-Next-Token,
  1240.       *   which is used for all tag entries except for
  1241.       *   <COMMENT>, </COMMENT> and <ANNOTATE>...
  1242.        01  Token.
  1243.            02 Token-Char
  1244.                 Occurs 1 to 256 Times
  1245.                   Depending on Token-Length
  1246.                                   Pic X.
  1247.  
  1248.       *    ...Length of the current token...
  1249.        01  Token-Length           Pic 999.
  1250.  
  1251.        01  Previous-Token.
  1252.            02 Previous-Token-Char
  1253.                 Occurs 1 to 256 Times
  1254.                   Depending on Previous-Token-Length
  1255.                                   Pic X.
  1256.       *    ...Length of the previous token...
  1257.        01  Previous-Token-Length  Pic 999.
  1258.  
  1259.       *    ...Status from Get-Next-Token...
  1260.        01  Token-Beg-Found-Status Pic 9  Value 0.
  1261.            88 Token-Beg-Found            Value 1.
  1262.            88 Token-Beg-Not-Found        Value 0.
  1263.  
  1264.        01  Token-Found-Status     Pic 9  Value 0.
  1265.            88 Token-Found                Value 1.
  1266.            88 Token-Not-Found            Value 0.
  1267.  
  1268.       *---------------*
  1269.       *   Misc Info   *
  1270.       *---------------*
  1271.       *    ...Sort Return status...
  1272.        01  Sort-Return-Status     Pic 9    Value 0.
  1273.            88 Sort-At-End                  Value 1.
  1274.            88 Sort-Not-At-End              Value 0.
  1275.  
  1276.  
  1277.        01  Last-DN-ID-for-Xref.
  1278.            02 Last-DN-for-Xref       Pic X(31).
  1279.            02 filler                 Pic X.
  1280.            02 Last-Qual-for-Xref     Pic X.
  1281.            02 filler                 Pic X.
  1282.            02 Last-Def-ID            Pic X(11).
  1283.            02 filler                 Pic X.
  1284.  
  1285.  
  1286.       *    ...Inference-Source Position and length
  1287.        01  Inference-Source-Pos   Pic 999  Value 0.
  1288.        01  Inference-Source-Size  Pic 999  Value 0.
  1289.  
  1290.       *    ...Reference type informat position and length within Token
  1291.        01  Ref-Type-Info-Pos      Pic 99.
  1292.        01  Ref-Type-Info-Size     Pic 99.
  1293.  
  1294.       *    ...Temporary use in various places...
  1295.        01  Temp                   Pic 9(5).
  1296.        01  I                      Pic 9(5).
  1297.        01  Temp2                  Pic 9(5).
  1298.  
  1299.       *================================================================*
  1300.        Linkage Section.
  1301.       *================================================================*
  1302.  
  1303.       *...Arguments received
  1304.        01 Arguments.
  1305.       *   ...length of Arguments-String...
  1306.           02 Arguments-length     Comp-5 Pic 9(4).
  1307.       *   ....xrl and .xsd file names separated with a space...
  1308.           02 Arguments-string      Pic X(513).
  1309.  
  1310.       *================================================================*
  1311.        Procedure Division Using Arguments.
  1312.       *================================================================*
  1313.  
  1314.        Declaratives.
  1315.       *==============================================================*
  1316.       *   Declaratives to handle file I/O exceptions                 *
  1317.       *==============================================================*
  1318.  
  1319.       *---------------------------------------------------------*
  1320.       *     Declarative for Rpt-In file                         *
  1321.       *---------------------------------------------------------*
  1322.        Rpt-In-Error Section.
  1323.            Use After Error Procedure on Rpt-In.
  1324.        Rpt-In-Error-1.
  1325.            If Not Rpt-In-EOF
  1326.              Then
  1327.                Display MSG-INPUT-REPORT-ERROR
  1328.                Display MSG-FAILED-OPERATION File-IO-Req '.'
  1329.                Display MSG-FILE-STATUS Rpt-In-Fs '.'
  1330.                Display MSG-EXECUTION-TERMINATED
  1331.                Perform Y2K-Exit-Term-Error-D
  1332.                Stop Run
  1333.       *    ...should change to GOBACK once the restriction is removed..
  1334.              Else
  1335.                 Next Sentence
  1336.            End-If.
  1337.  
  1338.       *---------------------------------------------------------*
  1339.       *     Declarative for Seed-In file                        *
  1340.       *---------------------------------------------------------*
  1341.        SeedIn-Error Section.
  1342.            Use After Error Procedure on Seed-In.
  1343.        SeedIn-Error-1.
  1344.            If Not Seed-In-EOF
  1345.              Then
  1346.                Display MSG-INPUT-SEED-ERROR
  1347.                Display MSG-FAILED-OPERATION File-IO-Req '.'
  1348.                Display MSG-FILE-STATUS Seed-In-FS '.'
  1349.                Display MSG-EXECUTION-TERMINATED
  1350.                Perform Y2K-Exit-Term-Error-D
  1351.                Stop Run
  1352.       *    ...should change to GOBACK once the restriction is removed..
  1353.              Else
  1354.                Next Sentence
  1355.            End-If.
  1356.  
  1357.       *---------------------------------------------------------*
  1358.       *     Declarative for Rpt-Work  file                      *
  1359.       *---------------------------------------------------------*
  1360.        Rpt-Work-Error Section.
  1361.            Use After Error Procedure on Rpt-Work.
  1362.        Rpt-Work-Error-1.
  1363.            Display MSG-REPORT-WORK-ERROR
  1364.            Display MSG-FAILED-OPERATION File-IO-Req '.'
  1365.            Display MSG-FILE-STATUS Rpt-Work-FS '.'
  1366.            Display MSG-EXECUTION-TERMINATED
  1367.            Perform Y2K-Exit-Term-Error-D
  1368.            Stop Run.
  1369.       *    ...should change to GOBACK once the restriction is removed..
  1370.  
  1371.       *---------------------------------------------------------*
  1372.       *     Declarative for Rpt-Main  file                      *
  1373.       *---------------------------------------------------------*
  1374.        Rpt-Main-Error Section.
  1375.            Use After Error Procedure on Rpt-Main.
  1376.        Rpt-Main-Error-1.
  1377.            Display MSG-REPORT-MAIN-ERROR
  1378.            Display MSG-FAILED-OPERATION File-IO-Req '.'
  1379.            Display MSG-FILE-STATUS Rpt-Main-FS '.'
  1380.            Display MSG-EXECUTION-TERMINATED
  1381.            Perform Y2K-Exit-Term-Error-D
  1382.            Stop Run.
  1383.       *    ...should change to GOBACK once the restriction is removed..
  1384.  
  1385.       *---------------------------------------------------------*
  1386.       *     Declarative for Rpt-FileID file                     *
  1387.       *---------------------------------------------------------*
  1388.        Rpt-FileID-Error Section.
  1389.            Use After Error Procedure on Rpt-FileID.
  1390.        Rpt-FileID-Error-1.
  1391.            Display MSG-REPORT-FILE-ERROR
  1392.            Display MSG-FAILED-OPERATION File-IO-Req '.'
  1393.            Display MSG-FILE-STATUS Rpt-FileID-FS '.'
  1394.            Display MSG-EXECUTION-TERMINATED
  1395.            Perform Y2K-Exit-Term-Error-D
  1396.            Stop Run.
  1397.       *    ...should change to GOBACK once the restriction is removed..
  1398.  
  1399.       *---------------------------------------------------------*
  1400.       *     Declarative for Rpt-Seed file                       *
  1401.       *---------------------------------------------------------*
  1402.        Rpt-Seed-Error Section.
  1403.            Use After Error Procedure on Rpt-Seed-File.
  1404.        Rpt-Seed-Error-1.
  1405.                Display MSG-REPORT-SEED-FILE-ERROR
  1406.                Display MSG-FAILED-OPERATION File-IO-Req '.'
  1407.                Display MSG-FILE-STATUS Rpt-Seed-FS '.'
  1408.                Display MSG-EXECUTION-TERMINATED
  1409.                Perform Y2K-Exit-Term-Error-D
  1410.                Stop Run.
  1411.       *    ...should change to GOBACK once the restriction is removed..
  1412.  
  1413.       *---------------------------------------------------------*
  1414.       *     Declarative for Rpt-Xref file                       *
  1415.       *---------------------------------------------------------*
  1416.        Rpt-Seed-Error Section.
  1417.            Use After Error Procedure on Xref-File.
  1418.        Rpt-Seed-Error-1.
  1419.                Display MSG-REPORT-XREF-FILE-ERROR
  1420.                Display MSG-FAILED-OPERATION File-IO-Req '.'
  1421.                Display MSG-FILE-STATUS Rpt-Xref-FS '.'
  1422.                Display MSG-EXECUTION-TERMINATED
  1423.                Perform Y2K-Exit-Term-Error-D
  1424.                Stop Run.
  1425.       *    ...should change to GOBACK once the restriction is removed..
  1426.  
  1427.       *------------------------------------------------------*
  1428.       *    Notify Y2K-Exit we are terminating with an error  *
  1429.       *       This routine is performed from declaratives.   *
  1430.       *------------------------------------------------------*
  1431.        Y2K-Exit-Term-Error-D.
  1432.            If Y2K-Exit-On and Y2K-Exit-Initialized
  1433.              Set Y2K-Exit-Func-Term-Error to true
  1434.              Call Y2K-Exit-Program
  1435.                Using Y2K-Exit-Func
  1436.            End-If.
  1437.  
  1438.        End Declaratives.
  1439.       *==============================================================*
  1440.       *   End of File I/O Error Declaratives                         *
  1441.       *==============================================================*
  1442.  
  1443.       *==============================================================*
  1444.       *   Main processing section starts                             *
  1445.       *==============================================================*
  1446.        Main-processing Section.
  1447.        Start-it.
  1448.            Display MSG-REPORT-STARTED
  1449.  
  1450.            Move all '0' to Referenced-Seed-Line-Table.
  1451.       *..............................................................*
  1452.       *    Get current time and set-up time stamp header record      *
  1453.       *..............................................................*
  1454.        Get-Current-Time.
  1455.  
  1456.       *    ...get YYYYMMDD...
  1457.            move function current-date(1:8) to Current-YYYYMMDD
  1458.  
  1459.              Move Current-YYYY to Current-Year
  1460.              Move Which-Month (Current-MM) to Current-Month
  1461.              Move Current-DD to Current-Day.
  1462.  
  1463.       *    ...get HHMMSSCC...
  1464.            Accept Current-HHMMSSCC from Time
  1465.              Move Current-HH to Current-Hour
  1466.              Move Current-MI to Current-Minute
  1467.              Move Current-SS to Current-Second
  1468.              Move Current-CC to Current-CentiS
  1469.  
  1470.       *...............................................................*
  1471.       *    Get and initialize the input file names passed as arg's    *
  1472.       *...............................................................*
  1473.            Move 0 to Rpt-In-Name-Length, Seed-In-Name-Length
  1474.            Move spaces to Rpt-In-Name, Seed-In-Name
  1475.  
  1476.            Inspect Arguments-String ( 1: Arguments-Length )
  1477.                                  Tallying Rpt-In-Name-Length
  1478.                                  For Characters
  1479.                                  Before space
  1480.  
  1481.            Move Arguments-String ( 1: Rpt-In-Name-Length )
  1482.                   to
  1483.                 Rpt-In-Name
  1484.                 Xrl-File-Name-in-Header
  1485.  
  1486.            Compute Seed-In-Name-Length =
  1487.              Arguments-Length - Rpt-In-Name-Length - 1
  1488.            Move Arguments-String
  1489.                   ( Rpt-In-Name-Length + 2: Seed-In-Name-Length )
  1490.              to Seed-In-Name, Seed-File-Name-in-Header.
  1491.  
  1492.       *...............................................................*
  1493.       *    Done with argument processing and time stamp header init   *
  1494.       *    Now ready to do real work                                  *
  1495.       *...............................................................*
  1496.  
  1497.       *..Open input and work files...                 .
  1498.        Open-Some-Files.
  1499.            Set OpenFile to true
  1500.            Open Input Rpt-In
  1501.            Open Output Rpt-Work.
  1502.  
  1503.       *    ...Y2K-Exit initialization code...
  1504.            If Y2K-Exit-On
  1505.  
  1506.              Set Y2K-Exit-Func-Init to true
  1507.              Call Y2K-Exit-Program
  1508.                Using Y2K-Exit-Func
  1509.  
  1510.              If Return-code not = 0
  1511.                Then
  1512.                  Perform Y2K-Exit-Error
  1513.                Else
  1514.                  Set Y2K-Exit-Initialized to true
  1515.              End-If
  1516.            End-If
  1517.       *      ...Y2K-Exit initialization code end...
  1518.  
  1519.            Perform Get-Rpt-In-Record.
  1520.  
  1521.       *---------------------------------------------------------------*
  1522.       *   Main processing loop starts                                 *
  1523.       *     Process each tag entry (skip over, gether info,           *
  1524.       *     and write out Rpt-Work  records) until EOF                *
  1525.       *     is reached on Rpt-In file.                                *
  1526.       *---------------------------------------------------------------*
  1527.        Create-Rpt-Work-from-Input.
  1528.  
  1529.       *    ...Go through input till EOF and handle each tag entry.....
  1530.            Perform with test before until Rpt-In-EOF or Quit-this
  1531.  
  1532.       *      ...Get next tag entry...
  1533.              Perform Get-Next-Tag-Entry
  1534.  
  1535.       *---------------------------------------------------------------*
  1536.       *      Evaluate and process various tag structures and entries  *
  1537.       *---------------------------------------------------------------*
  1538.              Evaluate True
  1539.  
  1540.       *...............................................................*
  1541.       *        Process <Header> tag block                             *
  1542.       *...............................................................*
  1543.                When HeaderTag
  1544.  
  1545.                  Set Header-Block to true
  1546.                  Move 0 to Rpt-Entry-No
  1547.  
  1548.       *          ...get the program name
  1549.                  Perform Get-Next-Tag-Entry
  1550.                  If ProgramTag
  1551.                    Then
  1552.                      Perform Get-Next-Token
  1553.                      If Token-Not-Found
  1554.                        Then
  1555.                          Display MSG-PROGRAM-TOKEN-ERROR
  1556.                          Perform Quit-It
  1557.                        Else
  1558.                          Move Token to
  1559.                                 Rpt-Pgm-name, Current-Program-name,
  1560.                                 File-ID-Hdr1-2, Seed-Title-Pgm,
  1561.                                 Xref-Rpt-Pgm-Name
  1562.                      End-If
  1563.                    Else
  1564.                      Display MSG-HEADER-TAG-ERROR
  1565.                      Perform Quit-It
  1566.                   End-If
  1567.  
  1568.       *..............................................................*
  1569.       *        Process </HEADER> tag                                 *
  1570.       *..............................................................*
  1571.                When HeaderEndTag
  1572.  
  1573.                  If Header-Block
  1574.                    Then
  1575.                      Set Level1-Tag-Block-Off to true
  1576.                    Else
  1577.                      Display MSG-END-HEADER-TAG-ERROR
  1578.                      Perform Quit-It
  1579.                  End-If
  1580.  
  1581.       *..............................................................*
  1582.       *        Process <PROGRAM> tag (outside header tag block).     *
  1583.       *..............................................................*
  1584.                When ProgramTag and Not Header-Block
  1585.  
  1586.                  Set Program-Block to true
  1587.  
  1588.       *..............................................................*
  1589.       *        Process <PROGRAM-INFO> tag                            *
  1590.       *..............................................................*
  1591.                When ProgramInfoTag
  1592.  
  1593.                  Set Program-Info-Block to true
  1594.  
  1595.       *..............................................................*
  1596.       *        Process <INCLUDE> tag                                 *
  1597.       *..............................................................*
  1598.                When IncludeTag and     Program-Block
  1599.                                and not Name-Block
  1600.                                and not Field-Name-Block
  1601.  
  1602.                  Set Include-Block to true
  1603.  
  1604.       *..............................................................*
  1605.       *        Process </INCLUDE> tag                                *
  1606.       *..............................................................*
  1607.                When IncludeEndTag and Include-Block
  1608.  
  1609.                  Set Include-Block-Off to true
  1610.  
  1611.       *..............................................................*
  1612.       *        Process <DDNAME>                                      *
  1613.       *..............................................................*
  1614.                When DDNameTag and     Program-Block
  1615.                               and not Name-Block
  1616.                               and not Field-Name-Block
  1617.  
  1618.                  Set DDName-Block to true
  1619.  
  1620.       *..............................................................*
  1621.       *        Process </DDNAME> tag                                 *
  1622.       *..............................................................*
  1623.                When DDNameEndTag and DDName-Block
  1624.  
  1625.                  Set DDName-Block-Off to true
  1626.  
  1627.       *..............................................................*
  1628.       *        Process <File> tag within <PROGRAM-INFO> tag block    *
  1629.       *..............................................................*
  1630.                When FileTag and Program-Info-Block
  1631.                             and First-File-in-Program-Info
  1632.  
  1633.                  Set Not-First-File-in-Program-Info to true
  1634.  
  1635.                  Perform Get-Next-Token
  1636.  
  1637.                  If Token-Not-Found
  1638.                    Then
  1639.                      Display MSG-FILE-TOKEN-ERROR
  1640.                      Perform Quit-It
  1641.                    Else
  1642.                      Move Token-Length to Source-File-Name-Length
  1643.                      Move Token to Source-File-Name-in-Header
  1644.                   End-IF
  1645.  
  1646.       *..............................................................*
  1647.       *        Process </PROGRAM-INFO> tag                           *
  1648.       *..............................................................*
  1649.                When ProgramInfoEndTag and Program-Info-Block
  1650.  
  1651.                  Set Level2-Tag-Block-Off to true
  1652.  
  1653.       *..............................................................*
  1654.       *        Process <NAME> tag within <PROGRAM> tag block         *
  1655.       *        (currently handling <EXTERNAL-NAME> as <NAME> also)   *
  1656.       *..............................................................*
  1657.                When         (NameTag or ExternalNameTag)
  1658.                     and     Program-Block
  1659.                     and not Include-Block
  1660.                     and not DDName-Block
  1661.                     and not Result-Block
  1662.  
  1663.                  Set Name-Block to true
  1664.  
  1665.       *          ....................................................*
  1666.       *          . Go through <NAME> tags until one with <SIZE> tag  *
  1667.       *          . (i.e. field level <NAME>) is found                *
  1668.       *          ....................................................*
  1669.                  Perform with test after until SizeTag
  1670.                                          or No-Of-Names-with-Qual > 49
  1671.                                          or No-of-Names-with-Qual = 0
  1672.  
  1673.                    Add 1 to No-of-Names-with-Qual
  1674.                    Add 1 to No-of-NameTags-Pending
  1675.  
  1676.                    Perform Get-Next-Token
  1677.  
  1678.                    If Token-Not-Found
  1679.                      Then
  1680.                        Display MSG-NAME-TOKEN-ERROR
  1681.                        Perform Quit-It
  1682.                      Else
  1683.                        Move Token to Data-Name (No-of-Names-with-Qual),
  1684.                                      Current-Name
  1685.                                      Xref-DN
  1686.                        Move Token-Length to Name-Length
  1687.                    End-IF
  1688.  
  1689.  
  1690.                    Perform Get-Next-Tag-Entry
  1691.  
  1692.                    If Tag-Not-Found
  1693.                      Display MSG-NAME-TAG-ERROR
  1694.                      Perform Quit-It
  1695.                    End-If
  1696.  
  1697.                    If DimensionsTag
  1698.                      Perform Get-Next-Tag-Entry
  1699.                      If Tag-Not-Found
  1700.                        Display MSG-DIMENSIONS-TAG-ERROR
  1701.                        Perform Quit-It
  1702.                      End-If
  1703.                    End-If
  1704.  
  1705.                    If not (NameTag or ExternalNameTag or SizeTag)
  1706.                      Then
  1707.       *                ...This shouldn't happen. But just in case :-)
  1708.       *                ...it was <NAME> for <...reason> in non-<NAME>
  1709.       *                   block. Its not a <NAME> we are looking for
  1710.                        Move 0 to No-of-NameTags-Pending
  1711.                        Move 0 to No-of-Names-with-Qual
  1712.       *                ...note: this would cause it it to get out of
  1713.       *                   the big get-next-tag-entry loop.
  1714.                        Set Level2-Tag-Block-Off to true
  1715.                    End-If
  1716.  
  1717.                  End-Perform
  1718.  
  1719.                  If No-of-Names-with-Qual > 49
  1720.                    Display MSG-NAME-QUAL-MAX-ERROR
  1721.                    Perform Quit-It
  1722.                  End-If
  1723.  
  1724.                  If No-of-Names-with-Qual > 0
  1725.       *            ....................................................*
  1726.       *            . Unless it was a bogus <NAME> tag for non-name     *
  1727.       *            . (in which case No-of-Names-with-Qual = 0),        *
  1728.       *            . at this point we just found <NAME> tag for field  *
  1729.       *            ....................................................*
  1730.  
  1731.  
  1732.                    Set Field-Name-Block to true
  1733.  
  1734.       *            ...indicate if the field is within a structure or not
  1735.                    If No-of-Names-with-Qual = 1
  1736.                      Then
  1737.                        Set Not-Qualified to true
  1738.                      Else
  1739.                        Set Qualified to true
  1740.                    End-If
  1741.  
  1742.                  End-If
  1743.       *          ...Do some house keeping for the report record Info
  1744.       *          Move spaces to Rpt-Ref-No-Grp
  1745.       *          Move 0 to Current-Ref-Count, Rpt-Ref-No
  1746.  
  1747.       *..............................................................*
  1748.       *        Process <RESULT> tag within field level <NAME> tag    *
  1749.       *..............................................................*
  1750.                When ResultTag and Field-Name-Block
  1751.  
  1752.                  Set Result-Block to true
  1753.  
  1754.                  Move 0 to Rpt-Entry-No
  1755.                  Set Process-Result-Entry to true
  1756.  
  1757.       *--------------------------------------------------------------*
  1758.       *        Process <USED-AS-YEAR>, <USED-AS-NON-YEAR>,           *
  1759.       *                <USED-AS-YEAR-AND-NON-YEAR>, <ALWAYS-YEAR>,   *
  1760.       *                and <ALWAYS-NON-YEAR> tags,                   *
  1761.       *                and set the Rpt-Kind report entry             *
  1762.       *..............................................................*
  1763.       *            ...Set the Year Usage column information
  1764.  
  1765.                When YearTag and Field-Name-Block
  1766.                  Add 1 to Rpt-Entry-No
  1767.                  If Rpt-Entry-No > 100,
  1768.                    Perform Quit-It
  1769.                  End-If
  1770.                  Set Kind-Y (Rpt-Entry-No) to true
  1771.                  Set Process-Result-Entry to true
  1772.  
  1773.                When NYearTag and Field-Name-Block
  1774.                  Add 1 to Rpt-Entry-No
  1775.                  If Rpt-Entry-No > 100,
  1776.                    Perform Quit-It
  1777.                  End-If
  1778.                  Set Kind-NY (Rpt-Entry-No) to true
  1779.                  Set Process-Result-Entry to true
  1780.  
  1781.                When YearNYearTag and Field-Name-Block
  1782.                  Add 1 to Rpt-Entry-No
  1783.                  If Rpt-Entry-No > 100,
  1784.                    Perform Quit-It
  1785.                  End-If
  1786.                  Set Kind-YNY (Rpt-Entry-No) to true
  1787.                  Set Process-Result-Entry to true
  1788.  
  1789.                When AYearTag and Field-Name-Block
  1790.                  Add 1 to Rpt-Entry-No
  1791.                  If Rpt-Entry-No > 100,
  1792.                    Perform Quit-It
  1793.                  End-If
  1794.                  Set Kind-AY (Rpt-Entry-No) to true
  1795.                  Set Process-Result-Entry to true
  1796.  
  1797.                When ANonYearTag and Field-Name-Block
  1798.                  Add 1 to Rpt-Entry-No
  1799.                  If Rpt-Entry-No > 100,
  1800.                    Perform Quit-It
  1801.                  End-If
  1802.                  Set Kind-ANY (Rpt-Entry-No) to true
  1803.                  Set Process-Result-Entry to true
  1804.  
  1805.       *..............................................................*
  1806.       *       Process <OFFSET> and <LENGTH> tags to be used with     *
  1807.       *         <MLE> reason. Expected to be 1 digit values for MLE. *
  1808.       *..............................................................*
  1809.                When IndexTag and
  1810.                     (Rpt-Entry-No not = 0) and
  1811.                     Field-Name-Block
  1812.  
  1813.                   Perform Get-Next-Token
  1814.                   If Token-Length > 10
  1815.                     Move 10 to Token-Length
  1816.                   End-If
  1817.                   Move 0 to Offset (Rpt-Entry-No)
  1818.                   Move Token to
  1819.                        Offset (Rpt-Entry-No)
  1820.                           (10 - Token-Length + 1:Token-Length)
  1821.  
  1822.                   If (Rpt-Entry-No > 1)            and
  1823.                      (Offset (Rpt-Entry-No) not =
  1824.                      Offset (Rpt-Entry-No - 1))    and
  1825.                      not MLE
  1826.                     Then
  1827.                       Subtract 1 from Rpt-Entry-No
  1828.                       Set Dont-Process-Result-Entry to true
  1829.                     End-If
  1830.  
  1831.                When LengthTag and
  1832.                     (Rpt-Entry-No not = 0) and
  1833.                     Process-Result-Entry and
  1834.                     Field-Name-Block
  1835.  
  1836.                   Perform Get-Next-Token
  1837.                   Move 0 to Size-Value (Rpt-Entry-No)
  1838.                   Move Token to
  1839.                        Size-Value (Rpt-Entry-No)
  1840.                           (10 - Token-Length + 1:Token-Length)
  1841.  
  1842.       *..............................................................*
  1843.       *        Process </RESULT> tag within field level <NAME> tag   *
  1844.       *..............................................................*
  1845.                When ResultEndTag and Field-Name-Block and Result-Block
  1846.                    Set Level3-Tag-Block-Off to true
  1847.  
  1848.       *..............................................................*
  1849.       *        Process <(NON-)YEAR-REASON> tag within <RESULT> block *
  1850.       *..............................................................*
  1851.                When Field-Name-Block                      and
  1852.                     (YearReasonTag or NonYearReasonTag)   and
  1853.                     Process-Result-Entry
  1854.  
  1855.       *          ...set YEAR-REASON or NON-YEAR-REASON indicator..
  1856.                  If YearReasonTag
  1857.                    Then
  1858.                      Set Year-Reason-Y (Rpt-Entry-No) to true
  1859.                    Else
  1860.                      Set Year-Reason-N (Rpt-Entry-No) to true
  1861.                  End-If
  1862.  
  1863.       *          ...get and set REASON...
  1864.                  Perform Get-Next-Tag-Entry
  1865.  
  1866.                  Evaluate True
  1867.                    When BuiltInC
  1868.                      Set Built-In to true
  1869.                    When CallC
  1870.                      Set CallCause to true
  1871.                    When CICSFileNMC
  1872.                      Set CICSFileNM to true
  1873.                    When CICSFileVarC
  1874.                      Set CICSFileVar to true
  1875.                    When DataBaseC
  1876.                      Set DataBase to true
  1877.                    When DDNameC
  1878.                      Set DDName to true
  1879.                    When InferenceC
  1880.                      Set Inference to true
  1881.                    When IncludeC
  1882.                      Set Include to true
  1883.                    When MLEC
  1884.                      Set MLE to true
  1885.                    When NameC
  1886.                      Set NameCause to true
  1887.                    When PatternC
  1888.                      Set Pattern to true
  1889.                    When other
  1890.                      Display MSG-UNKNOWN-REASON-ERROR Current-Tag
  1891.                      Set Cause-Unknown to true
  1892.                      Perform Quit-It
  1893.                  End-Evaluate
  1894.  
  1895.                  Move Current-Cause to Rpt-Cause (Rpt-Entry-No)
  1896.  
  1897.       *          *....................................................*
  1898.       *          .  Get the Seed line number for all reasons except   .
  1899.       *          .  for Inference reason. For Inference, get the      .
  1900.       *          .  expression used for the inference.                .
  1901.       *          *....................................................*
  1902.  
  1903.                  Move spaces to Inference-Source (Rpt-Entry-No)
  1904.                  Move 1 to Inference-Source-Pos
  1905.  
  1906.                  If InferenceC
  1907.                    Then
  1908.       *              *................................................*
  1909.       *              .  Get the inference source information          .
  1910.       *              *................................................*
  1911.                      Perform Get-Next-Token
  1912.  
  1913.                      Perform test before until
  1914.                                  Token-Not-Found or
  1915.                                  Rpt-In-EOF
  1916.  
  1917.       *                ...check if we have enough space left for the
  1918.       *                ...token in Inference-Source area............
  1919.                        If Inference-Source-Pos + Token-Length >
  1920.                             Length of Inference-Source - 8
  1921.                          Then
  1922.                            Move ' ..etc..'
  1923.                              to
  1924.                                 Inference-Source (Rpt-Entry-No)
  1925.                                      (Inference-Source-Pos:)
  1926.                          Else
  1927.                            Move Token
  1928.                                   to
  1929.                                 Inference-Source (Rpt-Entry-No)
  1930.                                      (Inference-Source-Pos:)
  1931.                            Compute Inference-Source-Pos =
  1932.                                 Inference-Source-Pos + Token-Length + 1
  1933.                        End-If
  1934.  
  1935.                        Perform Get-Next-Token
  1936.                      End-Perform
  1937.  
  1938.                    Else
  1939.       *              *................................................*
  1940.       *              .  Get the seed line number                      .
  1941.       *              *................................................*
  1942.                      Perform test before
  1943.                        Until Rpt-In-Record ( In-Rec-Pos: 2 ) = '</'
  1944.                         or Rpt-In-EOF
  1945.  
  1946.                        Perform Get-Next-Token
  1947.                        If Rpt-In-Record ( In-Rec-Pos: 2 ) = '</'
  1948.       *                ...if In-Rec-Pos -> '</...>, the token just
  1949.       *                   before </...> is in Token...
  1950.  
  1951.       *                   get the line number...
  1952.                          Perform Get-Start-Line-Number
  1953.  
  1954.                          Move Line-No ( 3: 4 )
  1955.                                 to
  1956.                               Current-Seed-Line
  1957.                               Rpt-Seed (Rpt-Entry-No)
  1958.       *                  ...note Line-No may be 'n/a'...
  1959.  
  1960.                           If Line-No-Found
  1961.                            Then
  1962.       *                      ...indicate this seed line referenced...
  1963.                              Move '1' to
  1964.                                   Seed-Line-Referenced (Line-No-9s)
  1965.  
  1966.       *                     ...see if it is the highest seed line# yet
  1967.                             If Line-No-9s > Max-Seed-Line
  1968.                              Move Line-No-9s to Max-Seed-Line
  1969.                             End-If
  1970.                           End-If
  1971.                         End-If
  1972.                      End-Perform
  1973.  
  1974.                   End-If
  1975.       *           *..................................................*
  1976.       *           .  Done with Seed Line # or Inference source Info  .
  1977.       *           *..................................................*
  1978.  
  1979.       *..............................................................*
  1980.       *        Process <FILE> tag entry within Field-Name-Block      *
  1981.       *..............................................................*
  1982.                When FileTag and Field-Name-Block
  1983.  
  1984.                  Set File-Block to true
  1985.  
  1986.       *          ...initialize for Xref info processing
  1987.                  Move 1 to Xref-Refs-Pos
  1988.                  Move 1 to Xref-Rec-No
  1989.  
  1990.       *          ...initialize the last char position in File-Name to 0
  1991.                  Move 0 to File-Name-Length
  1992.  
  1993.       *          ...get file name tokens until EOF or next tag
  1994.       *             as Token-Not-Found...
  1995.                  Perform test after until Rpt-In-EOF or Token-Not-Found
  1996.  
  1997.                    Perform Get-Next-Token
  1998.  
  1999.                    If Not Rpt-In-EOF and Not Token-Not-Found
  2000.       *              ...if not the 1st token, insert a space ...
  2001.                      If File-Name-Length Not = 0
  2002.                        Move space
  2003.                          to File-Name (File-Name-Length + 1: 1)
  2004.                        Compute File-Name-Length = File-Name-Length + 1
  2005.                      End-If
  2006.  
  2007.       *              ... move the next (or first) token to File-Name...
  2008.                      Move Token
  2009.                        to File-Name (File-Name-Length + 1: Token-Length)
  2010.                      Compute File-Name-Length
  2011.                            = File-Name-Length + Token-Length
  2012.                     End-If
  2013.  
  2014.                   End-Perform
  2015.  
  2016.       *           ...check to see if 0<name<256...
  2017.                   If File-Name-Length = 0
  2018.                     Then
  2019.                       Display MSG-MISSING-FILE-NAME-ERROR
  2020.                       Perform Quit-It
  2021.                     Else
  2022.                      If File-Name-Length > 256
  2023.                        Display MSG-FILE-NAME-TRUNCATED
  2024.                        Move 256 to File-Name-Length
  2025.                      End-If
  2026.                  End-If
  2027.  
  2028.       *          ...find or create an entry for the file name
  2029.                  Perform Process-FileID-Table
  2030.  
  2031.       *          ...the file ID is set in Current-FileID at this point..
  2032.                  Move Current-FileID to Def-File (Rpt-Entry-No)
  2033.                                         Xref-File-ID
  2034.                                         Current-Xref-File-Id
  2035.  
  2036.       *..............................................................*
  2037.       *        Process <DEF-POS> tag entry within File-Block         *
  2038.       *..............................................................*
  2039.                When Def-PosTag and File-Block
  2040.  
  2041.                  Perform Get-Next-Token
  2042.                   If Token-Not-Found
  2043.                    Then
  2044.                      Display MSG-MISSING-LINE-COL-ERROR
  2045.                      Perform Quit-It
  2046.                    Else
  2047.       *              ...get the stating line number...
  2048.                      Perform Get-Start-Line-Number
  2049.  
  2050.       *              ...store starting line number in Current-Def-Line
  2051.                      Move Line-No to Current-Def-Line
  2052.  
  2053.       *              ...put FileID in Current-Def-FileID
  2054.                      Move Current-FileID to Current-Def-FileID
  2055.                                             Xref-File-ID
  2056.                  End-If
  2057.  
  2058.       *          *...................................................*
  2059.       *          * Write out the main analysis report records to     *
  2060.       *          * the work file                                     *
  2061.       *          *...................................................*
  2062.       *          ...prepare and write report entry records for the
  2063.       *             name (one for each result entry)...
  2064.  
  2065.                  Perform Test After Varying I From 1 By 1
  2066.                                     Until I = Rpt-Entry-No
  2067.  
  2068.                    Move Current-Name to Rpt-Name (I)
  2069.                    Move Current-Name-Qual to Rpt-Qual (I)
  2070.                    Move Current-Def-Pos to Rpt-Def-Pos (I)
  2071.                    If Rpt-Cause (I) (1:3) = 'MLE'
  2072.                      Move Short-Offset(I) to Rpt-Cause (I) (5:1)
  2073.                      Move Short-Size(I) to Rpt-Cause (I) (7:1)
  2074.                    End-If
  2075.       *            ...Write the record to Rpt-Work ...
  2076.                    Set WriteFile to true
  2077.       *
  2078.                    Write Rpt-Work-Record from Rpt-Entry (I)
  2079.                  End-Perform
  2080.       *          *...................................................*
  2081.       *          * Processing for main analysis report for this      *
  2082.       *          * data-name complete. Xref report work records      *
  2083.       *          * for this data-name are generated during <POS>     *
  2084.       *          * tag entry processing.                             *
  2085.       *          *...................................................*
  2086.  
  2087.  
  2088.       *              ...Tell Y2K-Exit about a data item definition...
  2089.       *              If Y2K-Exit-On
  2090.       *
  2091.       *                Set Y2K-Exit-Func-DataItem-Def to true
  2092.       *                Call Y2K-Exit-Program
  2093.       *                   Using Y2K-Exit-Func
  2094.       *                        Current-Program-Name
  2095.       *                        File-Name-in-Table (Current-Def-FileID)
  2096.       *                        File-Name-Size     (Current-Def-FileID)
  2097.       *                        Current-Name
  2098.       *                        Current-Name-Qual
  2099.       *                        Qualified-Name-Struct
  2100.       *                        Current-Def-Line
  2101.       *
  2102.       *                 If Return-code not = 0
  2103.       *                  Perform Y2K-Exit-Error
  2104.       *                End-If
  2105.       *               End-If
  2106.       *             ...Y2K-Exit code end...
  2107.  
  2108.       *..............................................................*
  2109.       *        Process <POS> tag within a FILE-BLOCK                 *
  2110.       *..............................................................*
  2111.                When PosTag and File-Block
  2112.  
  2113.       *          ...prepare report entry record...
  2114.                  Move spaces to Xref-for-Sort-Only-Grp
  2115.                  Move Current-FileID to Xref-File-ID
  2116.                  Move ': ' to Xref-File-ID-Del
  2117.                  Move Current-Name to Xref-Name-X
  2118.                  Move 'X' to Xref-Qual-X
  2119.                  Move Current-Def-Pos to Xref-Def-Pos-X
  2120.                  Move 1 to Xref-Rec-No
  2121.  
  2122.                  Perform Get-Next-Token
  2123.  
  2124.                  If Token-Not-Found
  2125.                    Display MSG-MISSING-POS-TOKEN
  2126.                    Perform Quit-It
  2127.                  End-If
  2128.  
  2129.       *          ...at least one reference found. process all Ref's...
  2130.                  Perform with test After Until Token-Not-Found
  2131.  
  2132.       *            ...get and move starting line number
  2133.                    Perform Get-Start-Line-Number
  2134.                    Move
  2135.                      Line-No-9s (7 - Line-No-Size: Line-No-Size)
  2136.                       to
  2137.                      Line-No-W-Ref-Type-Info
  2138.  
  2139.       *            ...get and move reference type information
  2140.                    Perform Get-Ref-Type-Info
  2141.                    If Ref-Type-Info-Size > 0
  2142.                      Move
  2143.                        Token (Ref-Type-Info-Pos: Ref-type-Info-Size)
  2144.                          to
  2145.                        Line-No-W-Ref-Type-Info (Line-No-Size + 1: )
  2146.                    End-If
  2147.  
  2148.       *            ...calculate the size of the Ref entry
  2149.                    Compute
  2150.                      Line-No-W-Ref-Type-Info-Size
  2151.                        =
  2152.                      Line-No-Size + Ref-Type-Info-Size
  2153.  
  2154.       *            ...Does it fit in the current ref record?
  2155.                    If Length of Xref-Line-Numbers - Xref-Refs-Pos + 1
  2156.                       > Line-No-W-Ref-Type-Info-Size
  2157.  
  2158.       *              ...yes, it does. Lets move the info in...
  2159.                      Then
  2160.                        Move
  2161.                          Line-No-W-Ref-Type-Info
  2162.                           (1: Line-No-W-Ref-Type-Info-Size)
  2163.                            to
  2164.                          Xref-Line-Numbers ( Xref-Refs-Pos: )
  2165.                        Compute
  2166.                          Xref-Refs-Pos
  2167.                            =
  2168.                          Xref-Refs-Pos + Line-No-W-Ref-Type-Info-Size
  2169.                            + 1
  2170.  
  2171.       *              ...no, it does not fit. Write the current record
  2172.                      Else
  2173.  
  2174.                        Move Current-Xref-File-ID to Xref-File-Id
  2175.                        Set WriteFile to true
  2176.                        Write Rpt-Work-Xref-Record from
  2177.                              Xref-Work-Record
  2178.  
  2179.                        Move 1 to Xref-Refs-Pos
  2180.                        Move Spaces to Xref-Line-Numbers
  2181.                        Add 1 to Xref-Rec-No
  2182.                    End-If
  2183.  
  2184.       *            ...go get the next reference entry within <POS> tag
  2185.                    Perform Get-Next-Token
  2186.  
  2187.                  End-Perform
  2188.  
  2189.       *..............................................................*
  2190.       *        Process </POS> tag entry within Field-Name-Block      *
  2191.       *..............................................................*
  2192.       *        When PosEndTag and Field-Name-Block
  2193.  
  2194.       *..............................................................*
  2195.       *        Process </FILE> tag entry within Field-Name-Block     *
  2196.       *..............................................................*
  2197.                When FileEndTag and Field-Name-Block
  2198.  
  2199.                  Set Level3-Tag-Block-Off to true
  2200.  
  2201.       *          ...if any Xref information not written, write it now..
  2202.                  If Xref-Refs-Pos > 1
  2203.                    Then
  2204.  
  2205.                      Move Current-Xref-File-ID to Xref-File-Id
  2206.  
  2207.                      Set WriteFile to true
  2208.                      Write Rpt-Work-Xref-Record from
  2209.                            Xref-Work-Record
  2210.  
  2211.                      Move 1 to Xref-Refs-Pos
  2212.                      Move Spaces to Xref-Line-Numbers
  2213.                      Move 1 to Xref-Rec-No
  2214.                    Else
  2215.                      Exit
  2216.                  End-If
  2217.  
  2218.       *..............................................................*
  2219.       *        Process </NAME> tag within a NAME-BLOCK               *
  2220.       *        (currently handling </EXTERNAL-NAME> as </NAME> also) *
  2221.       *..............................................................*
  2222.                When (NameEndTag or ExternalNameEndTag) and
  2223.                     (Name-Block or Field-Name-Block)
  2224.  
  2225.                    Subtract 1 from No-of-NameTags-Pending
  2226.                                    No-of-Names-with-Qual
  2227.  
  2228.                    If No-of-NameTags-Pending = 0
  2229.                      Then
  2230.                        Set Level2-Tag-Block-Off to true
  2231.                      Else
  2232.                        Set Name-Block to true
  2233.                    End-If
  2234.  
  2235.       *..............................................................*
  2236.       *        For any other tag/conditions just skip them over      *
  2237.       *..............................................................*
  2238.                When Other
  2239.  
  2240.                        Exit
  2241.  
  2242.              End-Evaluate
  2243.  
  2244.            End-Perform
  2245.  
  2246.       *    ...Close Rpt-Work file and Rpt-In file (.XSd)...
  2247.            Set CloseFile to true
  2248.            Close Rpt-Work
  2249.            Close Rpt-In
  2250.            Display MSG-WORK-FILE-CREATED.
  2251.  
  2252.       *--------------------------------------------------------------*
  2253.       *   End of main processing loop: Rpt-Work file completed       *
  2254.       *--------------------------------------------------------------*
  2255.  
  2256.       *--------------------------------------------------------------*
  2257.       * Now that we know the program name, decide the                *
  2258.       * names for the .XRT and .XRF output files                     *
  2259.       *--------------------------------------------------------------*
  2260.        Set-Output-Report-File-Names.
  2261.            If Rpt-In-Name-Length > 4
  2262.              Then
  2263.       *        ...replace the last 4 characters of the .XRL file
  2264.       *        with '.XRT' and '.XRF'...
  2265.  
  2266.                Move Rpt-In-Name-Length
  2267.                       to
  2268.                     Main-Report-File-Name-Length
  2269.                     Xref-Report-File-Name-Length
  2270.  
  2271.                Move Rpt-In-Name (1:Rpt-In-Name-Length - 4)
  2272.                       to
  2273.                     Main-Report-File-Name
  2274.  
  2275.                Move '.XRT'
  2276.                       to
  2277.                     Main-Report-File-Name (Rpt-In-Name-Length - 3:4)
  2278.  
  2279.                Move Rpt-In-Name (1:Rpt-In-Name-Length - 4)
  2280.                       to
  2281.                     Xref-Report-File-Name
  2282.  
  2283.                Move '.XRF'
  2284.                       to
  2285.                     Xref-Report-File-Name (Rpt-In-Name-Length - 3:4)
  2286.  
  2287.              Else
  2288.       *        ... use program name followed by '.XRT' & '.XRF'
  2289.  
  2290.                Compute Main-Report-File-Name-Length
  2291.                        Xref-Report-File-Name-Length
  2292.                          =
  2293.                        Program-Name-Length + 4
  2294.  
  2295.                Move Current-Program-Name
  2296.                       to
  2297.                     Main-Report-File-Name
  2298.  
  2299.                Move '.XRT'
  2300.                       to
  2301.                     Main-Report-File-Name (Program-Name-Length + 1:4)
  2302.  
  2303.                Move Current-Program-Name
  2304.                       to
  2305.                     Xref-Report-File-Name
  2306.  
  2307.                Move '.XRF'
  2308.                       to
  2309.                     Xref-Report-File-Name (Program-Name-Length + 1:4)
  2310.            End-If.
  2311.  
  2312.       *--------------------------------------------------------------*
  2313.       *    Open main report output files                             *
  2314.       *      File-ID and Seed-File report files are concatenated     *
  2315.       *      to the Main report fil.                                 *
  2316.       *--------------------------------------------------------------*
  2317.        Open-Reort-Output-Files.
  2318.  
  2319.            Set OpenFile to True
  2320.            Open output Rpt-Main
  2321.            Open Output Xref-File.
  2322.  
  2323.       *--------------------------------------------------------------*
  2324.       *   Create Rpt-Main file from Rpt-Work  File                   *
  2325.       *--------------------------------------------------------------*
  2326.       *--------------------------------------------------------------*
  2327.       * Create-Report-File1 section sorts records from Rpt-Work      *
  2328.       * file based on the data item name and the data item           *
  2329.       * definition position (line# and file ID) and writes to        *
  2330.       * Rpt-Main  file. Rpt-Main  file also gets                     *
  2331.       * report header records.                                       *
  2332.       *--------------------------------------------------------------*
  2333.        Create-Main-and-Xref-Report Section.
  2334.  
  2335.       *..............................................................*
  2336.       *   Write header records for the main report                   *
  2337.       *..............................................................*
  2338.        Write-Main-Report-Headers.
  2339.            Set WriteFile to true
  2340.  
  2341.       *    ...write report title
  2342.            Write Rpt-Main-Record From Rpt-Separator
  2343.            Write Rpt-Main-Record From Rpt-Hdr1
  2344.            Write Rpt-Main-Record From Time-Stamp-Header
  2345.  
  2346.       *    ...write cbl, xsd and xrl file names in the report header
  2347.            Write Rpt-Main-Record     From Rpt-Separator
  2348.            Write Rpt-Main-Big-Record From Source-File-Name-Header
  2349.            Write Rpt-Main-Big-Record From Seed-File-Name-Header
  2350.            Write Rpt-Main-Big-Record From Xrl-File-Name-Header
  2351.  
  2352.       *    ...write column description headers
  2353.            Write Rpt-Main-Record     From Rpt-Separator
  2354.            Write Rpt-Main-Record     From Rpt-Hdr2
  2355.            Write Rpt-Main-Record     From Rpt-Hdr3
  2356.            Write Rpt-Main-Record     From Rpt-Hdr4
  2357.            Write Rpt-Main-Record     From Rpt-Hdr5
  2358.            Write Rpt-Main-Record     From Rpt-Hdr6
  2359.            Write Rpt-Main-Record     From Rpt-Hdr7.
  2360.  
  2361.       *..............................................................*
  2362.       *   Write header records for the Xref report                   *
  2363.       *..............................................................*
  2364.        Write-Xref-Report-Headers.
  2365.            Set WriteFile to true
  2366.  
  2367.       *    ...write report title
  2368.            Write Xref-Record         From Rpt-Separator
  2369.            Write Xref-Record         From Xref-Rpt-Hdr1
  2370.            Write Xref-Record         From Time-Stamp-Header
  2371.  
  2372.       *    ...write cbl, xsd and xrl file names in the report header
  2373.            Write Xref-Big-Record     From Rpt-Separator
  2374.            Write Xref-Big-Record     From Source-File-Name-Header
  2375.            Write Xref-Big-Record     From Seed-File-Name-Header
  2376.            Write Xref-Big-Record     From Xrl-File-Name-Header
  2377.  
  2378.       *    ...write column description headers
  2379.            Write Xref-Record         From Rpt-Separator
  2380.            Write Xref-Record         From Xref-Rpt-Layout-Hdr1
  2381.            Write Xref-Record         From Xref-Rpt-Layout-Hdr2
  2382.            Write Xref-Record         From Xref-Rpt-Layout-Hdr2A
  2383.            Write Xref-Record         From Xref-Rpt-Layout-Hdr2B
  2384.            Write Xref-Record         From Xref-Rpt-Layout-Hdr2C
  2385.            Write Xref-Record         From Rpt-Separator.
  2386.  
  2387.       *--------------------------------------------------------------*
  2388.       *    Sort Rep-Out-Work and write to Rpt-Main and Xref-File     *
  2389.       *--------------------------------------------------------------*
  2390.        Sort-the-Report.
  2391.  
  2392.            Move spaces to Last-DN-ID-for-Xref
  2393.            Set SortFile to true
  2394.            Sort Sort-Rpt
  2395.                 on ascending key Rpt-Name-S1
  2396.                 on ascending key Rep-Def-Pos-S1
  2397.                 on ascending key Rpt-Qual-S1
  2398.                 on ascending key Xref-File-ID-S1
  2399.                 on ascending key Xref-Rec-No-S1
  2400.                   with duplicates in order
  2401.              using Rpt-Work
  2402.              output procedure is Write-to-Report-Output-Files.
  2403.  
  2404.       *--------------------------------------------------------------*
  2405.       *    Finish up the main report and Xref files                  *
  2406.       *--------------------------------------------------------------*
  2407.        Finish-up-Report-Files.
  2408.       *    ...write a separator line at the end of the file...
  2409.            Set WriteFile to true
  2410.            Write Rpt-Main-Record from Rpt-Separator
  2411.            Write Xref-Record from Rpt-Separator
  2412.  
  2413.       *    ...close Rpt-Main  file...
  2414.            Set CloseFile to true
  2415.            Close Rpt-Main
  2416.            Close Xref-File
  2417.  
  2418.            Display MSG-REPORTS-CREATED.
  2419.       *--------------------------------------------------------------*
  2420.       *   End of Create-Main-and Xref-Report Section                 *
  2421.       *--------------------------------------------------------------*
  2422.  
  2423.       *--------------------------------------------------------------*
  2424.       *    Create-Rpt-FileID creates the Rpt-FileID file             *
  2425.       *    using the File-ID-Table created earlier.                  *
  2426.       *    This FileID report is appended to the Main report if      *
  2427.       *    both RptOut and FileID environment variables are set to   *
  2428.       *    the same value.                                           *
  2429.       *--------------------------------------------------------------*
  2430.        Create-Rpt-FileID Section.
  2431.        Create-FileID-Report.
  2432.  
  2433.       *    Open Extend Rpt-FileID
  2434.            Set OpenFile to true
  2435.            Open Extend Rpt-FileID.
  2436.  
  2437.       *---------------------------------------------------------*
  2438.       *   Write Rpt-FileID header records                       *
  2439.       *---------------------------------------------------------*
  2440.        Write-Rpt-FileID-Headers.
  2441.            Set WriteFile to true
  2442.            Move spaces to Rpt-FileID-Header-Record
  2443.            Write Rpt-FileID-Header-Record
  2444.            Write Rpt-FileID-Header-Record from Rpt-Separator
  2445.            Write Rpt-FileID-Header-Record from File-ID-Hdr1
  2446.  
  2447.       *    ...write column description headers
  2448.            Write Rpt-FileID-Header-Record from Rpt-Separator
  2449.            Write Rpt-FileID-Header-Record from File-ID-Hdr2
  2450.            Write Rpt-FileID-Header-Record from File-ID-Hdr3.
  2451.  
  2452.       *---------------------------------------------------------*
  2453.       *   Writw records from the File-ID-Table                  *
  2454.       *---------------------------------------------------------*
  2455.        Write-File-ID-Report-Records.
  2456.            Move 1 to IX
  2457.            Perform test before until IX > Number-of-Files
  2458.              Move spaces to Rpt-FileID-Record
  2459.              Move File-ID-in-Table (IX) to File-ID-in-File
  2460.              Move File-Name-Size (IX) to Name-Length
  2461.              Move File-Name-in-Table (IX) ( 1: Name-Length )
  2462.                to File-Name-in-File ( 1: Name-Length )
  2463.              Set WriteFile to true
  2464.              Write Rpt-FileID-Record
  2465.              Add 1 to IX
  2466.            End-Perform.
  2467.  
  2468.       *    ...write a separator record....
  2469.              Set WriteFile to true
  2470.              Write Rpt-FileID-Header-Record from Rpt-Separator
  2471.  
  2472.       *    ...close Rpt-FileID file (opened output).
  2473.            Set CloseFile to true
  2474.            Close Rpt-FileID.
  2475.  
  2476.            Display MSG-FILE-ID-FILE-CREATED.
  2477.  
  2478.       *--------------------------------------------------------------*
  2479.       *    Create Seed file report                                   *
  2480.       *--------------------------------------------------------------*
  2481.        Create-Seed-File-Report.
  2482.            Set OpenFile to true
  2483.            Open Input Seed-In
  2484.            Open Extend Rpt-Seed-File
  2485.  
  2486.       *-----------------------------------------------------------*
  2487.       *    Write header records for Rpt-Seed file                 *
  2488.       *-----------------------------------------------------------*
  2489.            Set WriteFile to true
  2490.            Move spaces to Rpt-Seed-Header-Record
  2491.            Write Rpt-Seed-Header-Record
  2492.            Write Rpt-Seed-Header-Record from Rpt-Separator
  2493.            Write Rpt-Seed-Header-Record from Rpt-Seed-Title-Record
  2494.            Write Rpt-Seed-Header-Record from Rpt-Separator
  2495.            Write Rpt-Seed-Header-Record from Rpt-Seed-Column-Header-1
  2496.            Write Rpt-Seed-Header-Record from Rpt-Seed-Column-Header-2
  2497.            Write Rpt-Seed-Header-Record from Rpt-Seed-Column-Header-3
  2498.  
  2499.            Set ReadFile to true
  2500.            Read Seed-In
  2501.  
  2502.       *-----------------------------------------------------------*
  2503.       *    Loop to read seed file record and write a report entry *
  2504.       *    if the seed was referenced in the main report.         *
  2505.       *-----------------------------------------------------------*
  2506.            Perform Test Before Until Seed-In-EOF
  2507.                                   or Max-Seed-Line < Seed-In-Rec-No
  2508.  
  2509.              Add 1 to Seed-In-Rec-No
  2510.  
  2511.       *      ...if this seed was referenced, write a Rpt-Seed entry...
  2512.              If Seed-Line-Referenced (Seed-In-Rec-No) = 1
  2513.                Move Seed-In-Rec-No to Seed-Line-No
  2514.                Move Seed-In-Record to Seed-Line
  2515.  
  2516.                Set WriteFile to true
  2517.                Write Rpt-Seed-Record from Rpt-Seed-Record-Ws
  2518.              End-If
  2519.  
  2520.              Set ReadFile to true
  2521.              Read Seed-In
  2522.  
  2523.            End-Perform
  2524.  
  2525.       *-----------------------------------------------------------*
  2526.       *    Finish up the Seed report file                         *
  2527.       *-----------------------------------------------------------*
  2528.       *    ...write end of report separator...
  2529.            Set WriteFile to true
  2530.            Write Rpt-Seed-Header-Record from Rpt-Separator
  2531.            Display MSG-RPT-SEED-FILE-CREATED
  2532.  
  2533.       *    ...close seed input and seed report files...
  2534.            Set CloseFile to true
  2535.            Close Seed-In, Rpt-Seed-File.
  2536.       *--------------------------------------------------------------*
  2537.       *    End of Rpt-Seed generation                                *
  2538.       *--------------------------------------------------------------*
  2539.  
  2540.       *--------------------------------------------------------------*
  2541.       *    The report generation completed                           *
  2542.       *--------------------------------------------------------------*
  2543.        We-are-done.
  2544.            Display MSG-REPORT-GEN-END.
  2545.  
  2546.       *    ...Y2K-Exit termination code...
  2547.            If Y2K-Exit-On
  2548.  
  2549.              Set Y2K-Exit-Func-Term to true
  2550.              Call Y2K-Exit-Program
  2551.                Using Y2K-Exit-Func
  2552.  
  2553.              If Return-code not = 0
  2554.                Perform Y2K-Exit-Error
  2555.              End-If
  2556.            End-If
  2557.       *      ...Y2K-Exit termination code end...
  2558.  
  2559.            Goback.
  2560.       *==============================================================*
  2561.       *   End of main processing section.                            *
  2562.       *==============================================================*
  2563.  
  2564.       *==============================================================*
  2565.       *   Beginning of sections with performed procedures            *
  2566.       *==============================================================*
  2567.        All-Performed-Functions Section.
  2568.  
  2569.       *--------------------------------------------------------------*
  2570.       * Sort Output Procedure
  2571.       *--------------------------------------------------------------*
  2572.       *   Write-to-Analysis-File is used as the output               *
  2573.       *   procedure for the sort with Rpt-Work  used as the          *
  2574.       *   input file.                                                *
  2575.       *   Main report records for Rpt-Main and Xref-File are         *
  2576.       *   written from this SORT OUTPUT PROCEDURE.                   *
  2577.       *--------------------------------------------------------------*
  2578.        Write-to-Report-Output-Files.
  2579.       *    ...Sort-Output-Procedure.
  2580.            Move 0 to Current-Xref-File-ID
  2581.  
  2582.            Perform with test after until Sort-At-End
  2583.  
  2584.              Return Sort-Rpt
  2585.                At End
  2586.                  Set Sort-At-End to true
  2587.  
  2588.                Not At END
  2589.  
  2590.       *          ...decide if it is a main analysis (i.e. DN)
  2591.                  If Record-is-for-DN
  2592.                    Then
  2593.       *              ...it is an analysis record for DN.
  2594.       *                 Write the record to the main report file...
  2595.                      Set WriteFile to true
  2596.                      Write Rpt-Main-Big-Record from Rpt-Entry-S1
  2597.  
  2598.                    Else
  2599.       *              ...no, it is a Xref record...
  2600.                      Move space to Rpt-Qual-S1
  2601.                      Move Rpt-Entry-S1 to Xref-Work-Record
  2602.                      Move Xref-Only-Grp to Xref-Ref-Record
  2603.  
  2604.       *              ...check if same as the last DN for Xref...
  2605.                      If Xref-Name-ID-X Not = Last-DN-ID-for-Xref
  2606.                        Move Xref-Name-X to Xref-DN
  2607.                        Move Xref-Def-Line-X to Xref-Def-Line
  2608.                        Move Xref-Def-File-ID-X to Xref-Def-File-ID
  2609.                        Set WriteFile to true
  2610.                        Write Xref-Record from Xref-DN-Record
  2611.                      End-If
  2612.  
  2613.                      If (Xref-Ref-File-ID = Current-Xref-File-ID)
  2614.                            and
  2615.                         (Xref-Name-ID-X = Last-DN-ID-for-Xref)
  2616.                        Then
  2617.                          Move spaces to Xref-Ref-File-ID-Grp
  2618.                         Else
  2619.                          Move Xref-File-ID to
  2620.                               Current-Xref-File-ID
  2621.                               Xref-Ref-File-ID
  2622.                      End-If
  2623.       *              ...write Xref analysis record...
  2624.                      Set WriteFile to true
  2625.                      Write Xref-Record from Xref-Ref-Record
  2626.  
  2627.                      Move Xref-Name-ID-X to Last-DN-ID-for-Xref
  2628.                    End-If
  2629.  
  2630.              End-Return
  2631.  
  2632.            End-Perform.
  2633.  
  2634.       *-------------------------------------------------*
  2635.       *   Read input record                             *
  2636.       *-------------------------------------------------*
  2637.        Get-Rpt-In-Record.
  2638.            If In-Rec-Read
  2639.              Move Rpt-In-Record ( 1: In-Rec-Length ) to Prev-In-Rec
  2640.              Move In-Rec-Length to Prev-In-Rec-Length
  2641.            End-If
  2642.  
  2643.       *    ...skip over 0 length record(s) till non 0 length recor
  2644.       *       read or EOF reached...
  2645.            Perform test after until Rpt-In-EOF
  2646.                                     or
  2647.                               In-Rec-Length not = 0
  2648.       *      ...get next record & set In-Rec-Pos to 1...
  2649.              Set ReadFile to true
  2650.              Read Rpt-In
  2651.       *
  2652.       *          display 'in-rec-length = ' in-rec-length
  2653.       *          display 'rpt-in-fs = ' rpt-in-fs
  2654.  
  2655.       *
  2656.              If Not Rpt-In-EOF
  2657.                Set In-Rec-Read to true
  2658.                Move 1 to In-Rec-Pos
  2659.                Move In-Rec-Length to In-Rec-Left
  2660.                Add 1 to Rpt-In-Record-No
  2661.              End-If
  2662.  
  2663.            End-Perform.
  2664.  
  2665.       *--------------------------------------------------------------*
  2666.       *   Get-Next-Tag-Entry routine                                 *
  2667.       *--------------------------------------------------------------*
  2668.       *     This routine gets next tag entry (i.e. <...>) and put    *
  2669.       *     it into Current-Tag. The Input is scanned in             *
  2670.       *     Rpt-In-Record starting at In-Rec-Pos. In-Rec-Pos will be *
  2671.       *     set to the character next to '>' (or 1st character of    *
  2672.       *     the next record in Rpt-In-Record) at the end of this     *
  2673.       *     processing.                                              *
  2674.       *     This routine will get additional input records           *
  2675.       *     until next tag is found or until EOF is reached          *
  2676.       *     on Rpt-In file. If EOF is reached without getting        *
  2677.       *     another tag, Tag-Not-Found and Rpt-In-EOF are set        *
  2678.       *     to True.                                                 *
  2679.       *--------------------------------------------------------------*
  2680.        Get-Next-Tag-Entry.
  2681.  
  2682.       *    ---------------------------------------------------------
  2683.       *       Get to next "<". Read addtional records if necessary
  2684.       *    ---------------------------------------------------------
  2685.            Set Tag-not-found to true
  2686.            Perform Test Before Until Tag-found or
  2687.                                      Rpt-In-EOF or
  2688.                                      Quit-this
  2689.  
  2690.       *      ...look for "<"...
  2691.              Move 0 to Count-before-found
  2692.              Inspect Rpt-In-Record ( In-Rec-Pos: In-Rec-Left )
  2693.                Tallying Count-before-found
  2694.                For Characters Before Initial OpenTag
  2695.  
  2696.              If Count-Before-Found < In-Rec-Left
  2697.                Then
  2698.                  Set tag-found to true
  2699.                Else
  2700.                  Set tag-not-found to true
  2701.              End-If
  2702.  
  2703.       *      ...if '<' not found in this record, get another...
  2704.              If tag-not-found and Not Rpt-In-EOF
  2705.                Then
  2706.       *          ...if '<' not found in this record, get another...
  2707.                  Perform Get-Rpt-In-Record
  2708.              End-IF
  2709.            End-Perform
  2710.       *    --------------------------------------------------------
  2711.       *       Either "<" was found or reached EOF w/o "<"*
  2712.       *    --------------------------------------------------------
  2713.  
  2714.       *    --------------------------------------------------------
  2715.       *       If '<' found, look for '>', which must be within
  2716.       *       the current record.
  2717.       *    --------------------------------------------------------
  2718.       *    ...Did we find '<'?...
  2719.            If tag-found
  2720.              Then
  2721.       *        ...set In-Rec-Pos to point to '<'...
  2722.                Compute In-Rec-Pos = In-Rec-Pos + Count-Before-Found
  2723.       *        ...Set In-Rec-Left (include '<' position)...
  2724.                Compute In-Rec-Left = In-Rec-Length - In-Rec-Pos + 1
  2725.  
  2726.       *        ...Anything left after '<'?...
  2727.                If In-Rec-Left > 1
  2728.                  Then
  2729.                    Move 0 to Count-before-found
  2730.                    Inspect
  2731.                      Rpt-In-Record ( In-Rec-Pos + 1: In-Rec-Left - 1)
  2732.                      Tallying Count-Before-Found
  2733.                      For Characters Before Initial CloseTag
  2734.  
  2735.                    If Count-Before-Found < In-Rec-Left
  2736.                      Then Set tag-found to true
  2737.                      Else set tag-not-found to true
  2738.                    End-If
  2739.                  Else
  2740.                    Set tag-not-found to true
  2741.                End-If
  2742.  
  2743.       *        ...Did we find '>'?...
  2744.                If tag-found
  2745.                  Then
  2746.       *          ...matching ">" found...
  2747.       *            ...set the position where ">" was found...
  2748.                    Compute In-Rec-Last-Processed-Pos =
  2749.                            In-Rec-Pos + Count-Before-Found + 1
  2750.       *            ...move '<...>' found to Current-Tag...
  2751.                    Move
  2752.                     Rpt-In-Record ( In-Rec-Pos: Count-Before-Found + 2 )
  2753.                      to
  2754.                     Current-Tag
  2755.       *            ...set In-Rec-Pos to the next char beyond ">"...
  2756.                    Compute In-Rec-Pos = In-Rec-Last-Processed-Pos + 1
  2757.                    Compute In-Rec-Left = In-Rec-Length - In-Rec-Pos + 1
  2758.       *            ...if nothing left to process, get a new record...
  2759.                    If In-Rec-Left not > 0,
  2760.                      Perform Get-Rpt-In-Record
  2761.                    End-If
  2762.                  Else
  2763.       *
  2764.       *            ...">" not found in this record. It is an error.
  2765.       *              Put out a message and skip to the next "<"....
  2766.                    Display MSG-TAG-DELIMITER-ERROR
  2767.                    Display MSG-SKIPPING-TAG
  2768.       *            ...Get next record to look for a new tag entry...
  2769.                    If tag-not-found and Not Rpt-In-EOF
  2770.                       Perform Get-Rpt-In-Record
  2771.                    End-If
  2772.                End-If
  2773.       *     Else
  2774.       *      ...or we must have reached EOF before finding next '<'.
  2775.       *         Rpt-In-EOF and tag-not-found are already set.
  2776.       *         Nothing more. Exit Get-Next-Tag-Entry...
  2777.  
  2778.            End-If.
  2779.       *--------------------------------------------------------------*
  2780.       *   End of Get-Next-Tag-Entry processing                       *
  2781.       *--------------------------------------------------------------*
  2782.  
  2783.       *--------------------------------------------------------------*
  2784.       *   Get-Next-Token Routine                                     *
  2785.       *--------------------------------------------------------------*
  2786.       *     This routine looks for the next token starting           *
  2787.       *     at In-Rec-Pos in Rpt-In-Record (delimited by             *
  2788.       *     one or more spaces or a line delimitor or a '<'.         *
  2789.       *     The token is put into Token. The length of Token         *
  2790.       *     is set in Token-Length.                                  *
  2791.       *     The In-Rec-Pos is adjusted to point to the character     *
  2792.       *     next to the last character for the token.                *
  2793.       *     If the token is at the end of the record,                *
  2794.       *     a new record is read and In-Rec-Pos is set to 1.         *
  2795.       *     If no token is found before next tag or reaching EOF,    *
  2796.       *     Token-Not-Found and/or Rpt-In-EOF are set to True.       *
  2797.       *--------------------------------------------------------------*
  2798.        Get-Next-Token.
  2799.  
  2800.       *    ...find the first non space character...
  2801.  
  2802.            Set Token-Beg-Not-Found to true
  2803.            Set Token-Not-Found to true
  2804.            Set Tag-Beg-Not-Found to true
  2805.            Set Tag-Not-Found to true
  2806.  
  2807.       *    ...loop until non-space character found...
  2808.            Perform With Test Before
  2809.              Until Token-Beg-Found or Rpt-In-EOF
  2810.                 or In-Rec-Left = 0 or Tag-Beg-Found
  2811.  
  2812.              If Rpt-In-Record ( In-Rec-Pos: 1 ) Not = Space
  2813.                Then
  2814.                  If Rpt-In-Record ( In-Rec-Pos: 1 ) = '<'
  2815.                    Then
  2816.                      Set Tag-Beg-Found to true
  2817.                    Else
  2818.                      Set Token-Beg-Found to true
  2819.                  End-If
  2820.                Else
  2821.       *         ...In-Rec-Pos points to a space...
  2822.                 Add 1 to In-Rec-Pos
  2823.                 Subtract 1 from In-Rec-Left
  2824.                 If In-Rec-Left not > 0 and Not Rpt-In-EOF
  2825.                   Perform Get-Rpt-In-Record
  2826.                 End-If
  2827.               End-If
  2828.  
  2829.             End-Perform
  2830.  
  2831.       *     ...Check to see if a token was found...
  2832.             If Token-Beg-Found
  2833.               Then
  2834.       *         ...look for the end of the token...
  2835.                 Move 0 to Count-Before-Found
  2836.                 Inspect Rpt-In-Record (In-Rec-Pos: In-Rec-Left )
  2837.                   Tallying Count-Before-Found for characters
  2838.                   Before Initial Space
  2839.  
  2840.                 Move 0 to Temp
  2841.                 Inspect Rpt-In-Record (In-Rec-Pos: In-Rec-Left )
  2842.                   Tallying Temp for characters
  2843.                   Before Initial '<'
  2844.  
  2845.                 If Temp < Count-Before-Found
  2846.                   Move Temp to Count-Before-Found
  2847.                 End-If
  2848.  
  2849.                 Move Count-Before-Found to Token-Length
  2850.                 Move Rpt-In-Record ( In-Rec-Pos: Token-Length )
  2851.                   to Token
  2852.                 Set Token-Found to true
  2853.               Else
  2854.                 Set Token-Not-Found to true
  2855.             End-If
  2856.  
  2857.       *     ...set-up for next analysis...
  2858.             If Tag-Beg-Not-Found
  2859.               Add Count-Before-Found to In-Rec-Pos
  2860.       *       ...note: if Tag-Beg-Found, the next non-space
  2861.       *                char was '<'. Leave In-Rec-Pos alone...
  2862.             End-If
  2863.  
  2864.             Subtract 1 from In-Rec-Left
  2865.             If In-Rec-Left not > 0 and Not Rpt-In-EOF
  2866.               Perform Get-Rpt-In-Record
  2867.             End-If.
  2868.  
  2869.       *--------------------------------------------------------------*
  2870.       *   End-of-Next-Token routin                                   *
  2871.       *     Either the token is in Token or Token-Not-Found is set.  *
  2872.       *--------------------------------------------------------------*
  2873.  
  2874.       *--------------------------------------------------------------*
  2875.       *   Get-Start-Line-Number Routine                              *
  2876.       *--------------------------------------------------------------*
  2877.       *     Given a StartLine.Col.EndLine.Col token in Token from    *
  2878.       *     <DEF-POS>, <REASON> or <POS> entry, this routine         *
  2879.       *     returns the startingline number in Line-No               *
  2880.       *     right adjusted (padded with spaces on the left)          *
  2881.       *     if necessary.                                            *
  2882.       *--------------------------------------------------------------*
  2883.        Get-Start-Line-Number.
  2884.       *    ...Locate '.' as the line number terminator...
  2885.            Move 0 to Count-Before-Found
  2886.            Inspect Token
  2887.              Tallying Count-Before-Found for characters
  2888.              Before Initial '.'
  2889.  
  2890.            Move Count-Before-Found to Line-No-Size
  2891.            If Line-No-Size > 6 or
  2892.               Token ( 1: Line-No-Size ) Not Numeric
  2893.  
  2894.       *      ...if > 6 digits or not-numeric, it is not a line #...
  2895.              Then
  2896.                Set Line-No-Not-Found to true
  2897.       *        ...set Line-No to '   n/a'...
  2898.                Set Line-No-NA to true
  2899.  
  2900.              Else
  2901.                Set Line-No-Found to true
  2902.       *        ...move line number to Line-No right adjusted...
  2903.                Move spaces to Line-No
  2904.                Move zeroes to Line-No-9s
  2905.                Move Token ( 1: Line-No-Size )
  2906.                  to Line-No    ( 7 - Line-No-Size: Line-No-Size ),
  2907.                     Line-No-9s ( 7 - Line-No-Size: Line-No-Size )
  2908.  
  2909.            End-If.
  2910.       *--------------------------------------------------------------*
  2911.       *   End of Get-Start-Line-Number Routine                       *
  2912.       *--------------------------------------------------------------*
  2913.  
  2914.       *--------------------------------------------------------------*
  2915.       *   Get-Ref-Type-Info Routine                                  *
  2916.       *--------------------------------------------------------------*
  2917.       *     Given a StartLine.Col.EndLine.Col token in Token, this   *
  2918.       *     routine returns the character string indicating the      *
  2919.       *     reference type at the end of the reference token.        *
  2920.       *                                                              *
  2921.       *     It returns the position of reference type info string    *
  2922.       *     within Token in Ref-Type-Info-Pos and the size           *
  2923.       *     in Ref-Type-Info-Size.                                   *
  2924.       *--------------------------------------------------------------*
  2925.        Get-Ref-Type-Info.
  2926.            Move 1 to Ref-Type-Info-Pos
  2927.  
  2928.       *    ...look for the first alphanumeric char in Token
  2929.            Perform with test before Until
  2930.               Ref-Type-Info-Pos > Token-Length
  2931.              or
  2932.               Token ( Ref-Type-Info-Pos: 1) is alphabetic
  2933.  
  2934.              Add 1 to Ref-Type-Info-Pos
  2935.            End-Perform
  2936.  
  2937.       *    ...calculate the length of type info (should be 1, 2 or 3)
  2938.            Compute Ref-Type-Info-Size =
  2939.                    Token-Length - Ref-Type-Info-Pos + 1
  2940.  
  2941.       *    ...Verify the result is valid
  2942.            If Ref-Type-Info-Size > 3
  2943.              Display MSG-POSITION-ERROR
  2944.              Display MSG-POSITION-SIZE Ref-Type-Info-Size
  2945.              Display MSG-POSITION-POS Ref-Type-Info-Pos
  2946.              Perform Quit-It
  2947.            End-If.
  2948.       *--------------------------------------------------------------*
  2949.       *   End of Get-Ref-Type-Info Routine                           *
  2950.       *--------------------------------------------------------------*
  2951.  
  2952.       *--------------------------------------------------------------*
  2953.       *   Process-FileID-Table Routine:                              *
  2954.       *--------------------------------------------------------------*
  2955.       *     Given a file name this routine either find an entry      *
  2956.       *     in File-ID-Table or, if not found, creates a new entry   *
  2957.       *     for the file name. The File-ID associated with the       *
  2958.       *     file name is returned in Current-FileID.                 *
  2959.       *--------------------------------------------------------------*
  2960.        Process-FileID-Table.
  2961.  
  2962.            If Number-of-Files = 0
  2963.  
  2964.              Then
  2965.       *        ...Table is empty. Add new one in the table...
  2966.                Move 1 to File-ID-No (1), Number-of-Files
  2967.                Move File-ID-in-Table (1) to File-ID, Current-FileID
  2968.                Move File-Name-Length to File-Name-Size (1)
  2969.                Move File-Name (1: File-Name-Length)
  2970.                  to File-Name-in-Table (1)
  2971.  
  2972.       *       ...Tell Y2K-exit routine about a new source file...
  2973.               If Y2K-Exit-ON
  2974.                 Perform Y2K-Exit-NewSource
  2975.               End-If
  2976.       *       ...End of call to Y2K-Exit...
  2977.  
  2978.              Else
  2979.       *        ...Table has entries...
  2980.                Set FileID-IX to 1
  2981.  
  2982.       *        ---------------------------------------------------
  2983.       *           Search matching file name in File-ID-Table
  2984.       *        ---------------------------------------------------
  2985.                Search File-ID-Table-Entry
  2986.                  At End
  2987.       *            ...Matching file name not found. Add new one...
  2988.       *               ...set file ID column in the new entry...
  2989.                    Add 1 to Number-of-Files
  2990.                    Move Number-of-Files
  2991.                      to File-ID-No (Number-of-Files)
  2992.       *                ...set Current-FileID...
  2993.                    Move File-ID-in-Table (Number-of-Files)
  2994.                      to Current-FileID
  2995.       *                 ...set the file name column in the new entry...
  2996.                    Move File-Name-Length
  2997.                      to File-Name-Size (Number-of-Files)
  2998.                    Move File-Name (1: File-Name-Length)
  2999.                      to File-Name-in-Table (Number-of-Files)
  3000.  
  3001.       *            ...Tell Y2K-exit routine about a new source file...
  3002.                    If Y2K-Exit-ON
  3003.                      Perform Y2K-Exit-NewSource
  3004.                    End-If
  3005.       *           ...End of call to Y2K-Exit...
  3006.  
  3007.                  When File-Name-in-Table (FileID-IX)
  3008.                         = File-Name ( 1: File-Name-Length )
  3009.                     and
  3010.                       File-Name-Size (FileID-IX)
  3011.                         = File-Name-Length
  3012.  
  3013.       *            ...Matching file name found. Get the file ID...
  3014.                    Set IX to FileID-IX
  3015.                    Move File-ID-in-Table (IX) to Current-FileID
  3016.                End-Search
  3017.       *        ---------------------------------------------------
  3018.  
  3019.              End-If.
  3020.       *--------------------------------------------------------------*
  3021.       *   End of Process-FileID-Table Routine                        *
  3022.       *--------------------------------------------------------------*
  3023.  
  3024.       *--------------------------------------------------------------*
  3025.       *   Invoke Y2K-Exit routine for a new sporce file              *
  3026.       *--------------------------------------------------------------*
  3027.        Y2K-Exit-NewSource.
  3028.            Set Y2K-Exit-Func-Source to true
  3029.            Call Y2K-Exit-Program
  3030.              Using
  3031.                Y2K-Exit-Func
  3032.                Current-Program-Name
  3033.                File-Name-in-Table (Number-of-Files)
  3034.                File-Name-Size (Number-of-Files)
  3035.  
  3036.            If Return-Code not = 0
  3037.              Perform Y2K-Exit-Error
  3038.            End-If.
  3039.  
  3040.       *--------------------------------------------------------------*
  3041.       *   Quit-It (internal error detected) Routine                  *
  3042.       *--------------------------------------------------------------*
  3043.       *     Currently setup to quit processing rater than continuing *
  3044.       *     at the next tag.                                         *
  3045.       *--------------------------------------------------------------*
  3046.        Quit-It.
  3047.            Display MSG-ERROR-DETECTED
  3048.  
  3049.       *    ...if still not finished with Rpt-In file, identify the line
  3050.       *       which caused the error...
  3051.            If not Rpt-In-EOF
  3052.       *      ...if In-Rec-Pos = 1, the error is in the previous line...
  3053.              If In-Rec-Pos = 1
  3054.                Then
  3055.                  Compute Temp2 = Rpt-In-Record-No - 1
  3056.                  Display MSG-ERROR-LINE-NO Temp2 '.'
  3057.                  Display MSG-INPUT-RECORD
  3058.                    Prev-In-Rec ( 1: Prev-In-Rec-Length )
  3059.                Else
  3060.                  Display MSG-ERROR-LINE-NO Rpt-In-Record-No '.'
  3061.                  Display MSG-INPUT-RECORD
  3062.                    Rpt-In-Record ( 1: In-Rec-Length)
  3063.              End-If
  3064.            End-If
  3065.  
  3066.       *    ...if more records to process, continue...
  3067.       *    If Rpt-In-EOF
  3068.       *      Then
  3069.                Display MSG-EXECUTION-TERMINATED
  3070.                Perform Y2K-Exit-Term-Error
  3071.                Goback
  3072.       *      Else
  3073.       *        Display 'Processing will be attempted at next tag.'
  3074.       *     End-If.
  3075.             Exit.
  3076.  
  3077.       *----------------------------------------------------------------*
  3078.       *   This routine handles cases when Y2K-Exit program returned    *
  3079.       *   non-zero Return-Code.                                        *
  3080.       *----------------------------------------------------------------*
  3081.        Y2K-Exit-Error.
  3082.            Display MSG-EXIT-FAILED
  3083.            Display MSG-EXIT-FUNCTION Y2K-Exit-Func
  3084.            Display MSG-EXIT-RETURN-CODE Return-Code
  3085.            Perform Y2K-Exit-Term-Error
  3086.            Goback.
  3087.  
  3088.       *----------------------------------------------------------------*
  3089.       *   Notify Y2K-Exit routine that we are terminating with         *
  3090.       *   an error.                                                    *
  3091.       *----------------------------------------------------------------*
  3092.        Y2K-Exit-Term-Error.
  3093.            If Y2K-Exit-On and
  3094.               Y2K-Exit-Initialized
  3095.  
  3096.              Set Y2K-Exit-Func-Term-Error to true
  3097.              Call Y2K-Exit-Program
  3098.                Using Y2K-Exit-Func
  3099.  
  3100.            End-If.
  3101.  
  3102.       *================================================================*
  3103.        End Program dczy2kr.
  3104.       *================================================================*
  3105.       *================================================================*
  3106.       *  End of dczy2kr program                                        *
  3107.       *================================================================*
  3108.