home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / SQLDEMO.@EM / SQLGENWS.CBL < prev    next >
Encoding:
Text File  |  1991-04-08  |  69.5 KB  |  1,719 lines
  1.       $set mf warning(3)
  2.       $set sql sqlinit sqldb(sample)
  3.       ***************************************************************
  4.       *                                                             *
  5.       *     (c) Micro Focus Ltd. 1989                               *
  6.       *                                                             *
  7.       *        SQLGENWS                                             *
  8.       *                                                             *
  9.       *        This program generates COBOL Working Storage         *
  10.       *        host variable structures from OS/2 EE Database       *
  11.       *        Manager's catalog - using SYSIBM.SYSCOLUMNS          *
  12.       *        as the source of information to build the            *
  13.       *        COBOL data definitions. Additionally these options   *
  14.       *        are available:                                       *
  15.       *                                                             *
  16.       *        Option 1: generate NULL indicator array for the      *
  17.       *                  table.                                     *
  18.       *                                                             *
  19.       *        Option 2: generate SELECT statement                  *
  20.       *                  for the table.                             *
  21.       *                                                             *
  22.       *        Option 3: generate FETCH statement                   *
  23.       *                  for the table.                             *
  24.       *                                                             *
  25.       *        FILES                                                *
  26.       *        =====                                                *
  27.       *                                                             *
  28.       *        1. parameter-ds                                      *
  29.       *                                                             *
  30.       *        This file is read-only, and can contain parameters   *
  31.       *        to be used for batch or deteached run modes.         *
  32.       *        Parameters must be one per record.                   *
  33.       *                                                             *
  34.       *        The file name is hard coded.                         *
  35.       *                                                             *
  36.       *        2. target-ds                                         *
  37.       *                                                             *
  38.       *        This file is write-only, and will contain the        *
  39.       *        program output for any particular program run and    *
  40.       *        parameter set.                                       *
  41.       *                                                             *
  42.       *        The file name is specified by parameter.             *
  43.       *                                                             *
  44.       *        3. message-ds                                        *
  45.       *                                                             *
  46.       *        This file is write-only, and recieves the program    *
  47.       *        messages for successive executions. Since this       *
  48.       *        file is appended, occassional clear-up is required.  *
  49.       *                                                             *
  50.       *        The file name is hard coded.                         *
  51.       *                                                             *
  52.       *                                                             *
  53.       *        RUNNING                                              *
  54.       *        =======                                              *
  55.       *                                                             *
  56.       *        The program may be controlled by file, interactive   *
  57.       *        or command line parameters. A mixture of these       *
  58.       *        methods is available by specifying the correct       *
  59.       *        MODE TYPE (MT parameter) value.                      *
  60.       *                                                             *
  61.       *        The program output is timestamped to enable parameter*
  62.       *        and output files to be matched.                      *
  63.       *                                                             *
  64.       *        All parameters are logged in the message-ds file.    *
  65.       *                                                             *
  66.       ***************************************************************
  67.        environment division.
  68.       *=====================
  69.        configuration section.
  70.       *======================
  71.        special-names.
  72.       *==============
  73.                command-line is os2-cmd-line.
  74.       *
  75.        input-output section.
  76.       *=====================
  77.       *
  78.        file-control.
  79.       *=============
  80.       *
  81.        select parameter-ds
  82.                assign to dynamic parameter-ds-z1
  83.                organization is line sequential
  84.                file status is file-status-z1
  85.                .
  86.        select target-ds
  87.                assign to dynamic target-ds-z1
  88.                organization is line sequential
  89.                file status is file-status-z1
  90.                .
  91.        select message-ds
  92.                assign to dynamic message-ds-z1
  93.                organization is line sequential
  94.                file status is file-status-z1
  95.                .
  96.  
  97.        data division.
  98.       *==============
  99.  
  100.        file section.
  101.       *=============
  102.  
  103.        fd parameter-ds
  104.        recording mode v.
  105.       *=================
  106.  
  107.        01 parameter-rec.
  108.         03 parameter-line                  pic x(80).
  109.  
  110.        fd target-ds.
  111.       *=============
  112.  
  113.        01 target-rec.
  114.         03 target-line                     pic x(80).
  115.  
  116.        fd message-ds.
  117.       *==============
  118.  
  119.        01 message-rec.
  120.         03 message-line                    pic x(80).
  121.  
  122.        working-storage section.
  123.       *========================
  124.       *
  125.        exec sql include sqlca end-exec.
  126.  
  127.        exec sql begin declare section end-exec.
  128.  
  129.       * Area for retrieval of Database Manager system information
  130.       * from the catalog table SYSCOLUMNS
  131.        01 sysibm-syscolumns-a0.
  132.         03 name-a0                         pic x(18).
  133.         03 tbname-a0                       pic x(18).
  134.         03 tbcreator-a0                    pic x(8).
  135.         03 coltype-a0                      pic x(8).
  136.         03 nulls-a0                        pic x.
  137.         03 length-a0                       pic s9(4) comp-5.
  138.         03 scale-a0                        pic s9(4) comp-5.
  139.         03 colno-a0                        pic s9(4) comp-5.
  140.  
  141.  
  142.       * Database host variables used for control and access
  143.        01 dbm-util-a0.
  144.         03 max-columns-a0                  pic s9(4) comp-5.
  145.         03 authorisation-id-a0             pic x(8).
  146.         03 table-name-a0                   pic x(18).
  147.  
  148.        exec sql end declare section end-exec.
  149.  
  150.       * Data items used to create COBOL working storage lines
  151.        01 structure-make-a2.
  152.         03 dataname-a2                     pic x(32).
  153.         03 length-char-a2                  pic x(5).
  154.         03 scale-char-a2                   pic x(2).
  155.         03 length-a2                       pic 99999.
  156.         03 scale-a2                        pic 99.
  157.         03 do-null-ind-a2                  pic s9(4) comp-5.
  158.         03 smallint-pic-a2                 pic x(29)
  159.                                            value
  160.            "PIC S9(4) COMP-5.            ".
  161.         03 smallint-plus-pic-a2            pic x(29)
  162.                                            value
  163.            "PIC S9(4) COMP-5+            ".
  164.         03 integer-pic-a2                  pic x(29)
  165.                                            value
  166.            "PIC S9(9) COMP-5.            ".
  167.         03 decimal-pic-a2                  pic x(29)
  168.                                            value
  169.            "PIC S9(+                     ".
  170.         03 char-pic-a2                     pic x(29)
  171.                                            value
  172.            "PIC X(+                      ".
  173.         03 date-pic-a2                     pic x(29)
  174.                                            value
  175.            "PIC X(10).                   ".
  176.         03 time-pic-a2                     pic x(29)
  177.                                            value
  178.            "PIC x(8).                    ".
  179.         03 timestamp-pic-a2                pic x(29)
  180.                                            value
  181.            "PIC X(26).                   ".
  182.         03 full-stop-a2                    pic x
  183.                                            value ".".
  184.  
  185.       * Area with framework COBOL working storage lines
  186.        01 skeleton-lines-a2.
  187.         03 skeleton-line-a2-n.
  188.          05 skeleton-line-a2-1.
  189.           07 ws-margin-a2-1                pic x(7).
  190.           07 ws-level-a2-1                 pic x(8).
  191.           07 ws-dataname-a2-1              pic x(32).
  192.           07 ws-space-a2-1                 pic x(4).
  193.           07 ws-pic-a2-1                   pic x(29).
  194.          05 skeleton-line-a2-2.
  195.           07 ws-margin-a2-2                pic x(15).
  196.           07 ws-dataname-a2-2              pic x(25).
  197.           07 ws-def-a2-2                   pic x(40).
  198.          05 skeleton-line-a2-3.
  199.           07 param-indent-a2-3             pic x(4).
  200.           07 param-name-a2-3               pic x(12).
  201.           07 param-value-a2-3              pic x(64).
  202.         03 skeleton-line-a2
  203.            redefines
  204.            skeleton-line-a2-n              pic x(80)
  205.                                            occurs 3.
  206.  
  207.       * Area to store all columns for the specified table
  208.       * to avoid multiple retrieval from the database
  209.        01 columns-a3.
  210.         03 fetch-sub-a3                    pic s9(4) comp-5.
  211.         03 column-sub-a3                   pic s9(4) comp-5.
  212.         03 column-a3                       occurs 255.
  213.          05 name-a3                        pic x(18).
  214.          05 tbname-a3                      pic x(18).
  215.          05 tbcreator-a3                   pic x(8).
  216.          05 coltype-a3                     pic x(8).
  217.          05 nulls-a3                       pic x.
  218.          05 length-a3                      pic s9(4) comp-5.
  219.          05 scale-a3                       pic s9(4) comp-5.
  220.          05 colno-a3                       pic s9(4) comp-5.
  221.  
  222.       * Same as a3 but with some elements hyphenised
  223.        01 columns-a4.
  224.         03 column-sub-a4                   pic s9(4) comp-5.
  225.         03 column-a4                       occurs 255.
  226.          05 name-a4                        pic x(18).
  227.          05 tbname-a4                      pic x(18).
  228.          05 tbcreator-a4                   pic x(8).
  229.          05 coltype-a4                     pic x(8).
  230.          05 nulls-a4                       pic x.
  231.          05 length-a4                      pic s9(4) comp-5.
  232.          05 scale-a4                       pic s9(4) comp-5.
  233.          05 colno-a4                       pic s9(4) comp-5.
  234.  
  235.       * General flags, file names, status and control items
  236.        01 utils-z1.
  237.         03 date-z1                         pic x(6).
  238.         03 time-z1                         pic x(8).
  239.         03 parameter-ds-z1                 pic x(64)
  240.                                            value
  241.        'd:\test\sqlgenws\sqlgenws.par'.
  242.         03 end-parameter-ds-z1             pic s9(4) comp-5
  243.                                            value -1.
  244.         03 target-ds-z1                    pic x(64).
  245.         03 message-ds-z1                   pic x(64)
  246.                                            value
  247.            'd:\test\sqlgenws\sqlgenws.log   '.
  248.         03 dbm-message-z1.
  249.          05 dbm-message-text-z1            pic x(72).
  250.          05 dbmcode-z1                     pic -9(6).
  251.         03 dbm-codes-allowable-z1.
  252.          05 allow-dbmcode-z1               pic s9(4) comp-5.
  253.         03 files-opened-z1.
  254.          05 target-ds-open-z1              pic s9(4) comp-5.
  255.          05 message-ds-open-z1             pic s9(4) comp-5.
  256.          05 parameter-ds-open-z1           pic s9(4) comp-5.
  257.         03 file-status-z1                  pic x(2).
  258.         03 last-file-status-z1.
  259.          05 last-file-status-x-z1          pic x.
  260.          05 last-file-status-b-z1          pic 99 comp-x.
  261.         03 display-file-status-z1.
  262.          05 literal-status-z1              pic xx
  263.                                            value "9/".
  264.          05 display-status-z1              pic 999.
  265.         03 current-file-z1                 pic x(12)
  266.                                            value space.
  267.         03 mt-parameter-found-z1           pic s9(4) comp-5.
  268.         03 mode-type-save-z1               pic x(2).
  269.         03 table-name-hyph-z1              pic x(18).
  270.  
  271.       * ARea for storage of checked parameters in correct pictures
  272.        01 parameters-z2.
  273.       *                      mode-z2
  274.       *                      database-id-z2
  275.       *                      authorisation-id-z2
  276.       *                      table-name-z2
  277.       *                      target-ds-z2
  278.       *                      before-text-z2
  279.       *                      after-text-z2
  280.       *                      null-indicators-z2
  281.       *                      select-statement-z2
  282.       *                      fetch-statement-z2
  283.         03 mode-z2                         pic x.
  284.         03 database-id-z2                  pic x(8).
  285.         03 authorisation-id-z2             pic x(8).
  286.         03 table-name-z2                   pic x(18).
  287.         03 target-ds-z2                    pic x(64).
  288.         03 before-text-z2                  pic x(4)
  289.                                            value space.
  290.         03 after-text-z2                   pic x(4)
  291.                                            value space.
  292.         03 null-indicators-z2              pic s9(4) comp-5
  293.                                            value -1.
  294.         03 select-statement-z2             pic s9(4) comp-5
  295.                                            value -1.
  296.         03 fetch-statement-z2              pic s9(4) comp-5
  297.                                            value -1.
  298.  
  299.       * Parameter definition area
  300.        01 parameter-util-z3.
  301.         03 param-cmd-line-z3.
  302.          05 param-cmd-line-1-z3            pic x(120).
  303.         03 parameter-name-z3               pic x(4).
  304.         03 parameter-value-z3              pic x(64).
  305.         03 parameter-error-z3              pic s9(4) comp-5
  306.                                            value -1.
  307.         03 last-parameter-z3               pic s9(4) comp-5
  308.                                            value -1.
  309.         03 parameter-table-z3.
  310.          05 parameter-1-z3                 pic x(2)
  311.                                            value 'MT'.
  312.          05 parameter-1-ok-z3              pic s9(4) comp-5.
  313.          05 parameter-2-z3                 pic x(2)
  314.                                            value 'DB'.
  315.          05 parameter-2-ok-z3              pic s9(4) comp-5.
  316.          05 parameter-3-z3                 pic x(2)
  317.                                            value 'AI'.
  318.          05 parameter-3-ok-z3              pic s9(4) comp-5.
  319.          05 parameter-4-z3                 pic x(2)
  320.                                            value 'TN'.
  321.          05 parameter-4-ok-z3              pic s9(4) comp-5.
  322.          05 parameter-5-z3                 pic x(2)
  323.                                            value 'TF'.
  324.          05 parameter-5-ok-z3              pic s9(4) comp-5.
  325.          05 parameter-6-z3                 pic x(2)
  326.                                            value 'BT'.
  327.          05 parameter-6-ok-z3              pic s9(4) comp-5.
  328.          05 parameter-7-z3                 pic x(2)
  329.                                            value 'AT'.
  330.          05 parameter-7-ok-z3              pic s9(4) comp-5.
  331.          05 parameter-8-z3                 pic x(2)
  332.                                            value 'NI'.
  333.          05 parameter-8-ok-z3              pic s9(4) comp-5.
  334.          05 parameter-9-z3                 pic x(2)
  335.                                            value 'SG'.
  336.          05 parameter-9-ok-z3              pic s9(4) comp-5.
  337.          05 parameter-10-z3                pic x(2)
  338.                                            value 'FG'.
  339.          05 parameter-10-ok-z3             pic s9(4) comp-5.
  340.         03 parameters-z3
  341.            redefines
  342.            parameter-table-z3              occurs 10.
  343.          05 parameter-name-n-z3            pic x(2).
  344.          05 parameter-ok-n-z3              pic s9(4) comp-5.
  345.         03 parameter-subscript-z3          pic s9(4) comp-5.
  346.  
  347.       * Temporary area for parameters during checks
  348.        01 parameter-util-z4.
  349.         03 param-cmd-line-z4.
  350.          05 param-cmd-line-1-z4            pic x(120).
  351.         03 parameter-name-z4               pic x(4).
  352.         03 parameter-value-z4              pic x(64).
  353.         03 parameter-error-z4              pic s9(4) comp-5
  354.                                            value -1.
  355.         03 parameter-table-z4.
  356.          05 param-val-1-z4                 pic x(64).
  357.          05 param-val-2-z4                 pic x(64).
  358.          05 param-val-3-z4                 pic x(64).
  359.          05 param-val-4-z4                 pic x(64).
  360.          05 param-val-5-z4                 pic x(64).
  361.          05 param-val-6-z4                 pic x(64).
  362.          05 param-val-7-z4                 pic x(64).
  363.          05 param-val-8-z4                 pic x(64).
  364.          05 param-val-9-z4                 pic x(64).
  365.          05 param-val-10-z4                pic x(64).
  366.         03 parameters-z4
  367.            redefines
  368.            parameter-table-z4              occurs 10.
  369.          05 param-val-n-z4                 pic x(64).
  370.         03 parameter-subscript-z4          pic s9(4) comp-5.
  371.  
  372.       * Data items for DBM CALL to start_using_database
  373.        01 dbm-call.
  374.         03 spare1                         pic 9(4) comp-5 value 0.
  375.         03 db-length                      pic 9(4) comp-5 value 0.
  376.         03 spare2                         pointer.
  377.         03 database                       pic x(10).
  378.         03 d-use                          pic 9(4) comp-5.
  379.         03 u                              pic x redefines d-use.
  380.  
  381.  
  382.        procedure division.
  383.       *===================
  384.       *
  385.        a-1-start.
  386.       *==========
  387.       *
  388.       * Start up and main control
  389.       *
  390.                perform a-2-initial
  391.                if  parameter-error-z3 negative
  392.                    if  parameter-ok-n-z3(2) positive
  393.                    and parameter-ok-n-z3(3) positive
  394.                    and parameter-ok-n-z3(4) positive
  395.                    and parameter-ok-n-z3(5) positive
  396.                        move zero to max-columns-a0
  397.                        perform b-3-0-get-max-cols
  398.                        if  max-columns-a0 < 1
  399.                        and parameter-error-z3 negative
  400.                            move
  401.                            "No table name as specified in parameters"
  402.                            to   message-line
  403.                            perform z-1-write-message-rec
  404.                            move 1 to parameter-error-z3
  405.                        end-if
  406.                        perform a-8-prepare-target
  407.                        perform a-3-main
  408.                    else
  409.                        move "Not all mandatory parameters specified"
  410.                        to   message-line
  411.                        perform z-1-write-message-rec
  412.                    end-if
  413.                end-if
  414.                perform z-9-stop
  415.                .
  416.       *
  417.        a-2-initial.
  418.       *============
  419.       *
  420.       * Check at least mode type (MT) parameter specified
  421.       * and initialise LOG, prepare TARGET FILE (TF),
  422.       * control parameter reception
  423.       *
  424.                move -1 to target-ds-open-z1
  425.                move -1 to message-ds-open-z1
  426.                move -1 to parameter-ds-open-z1
  427.                move -1 to allow-dbmcode-z1
  428.                accept param-cmd-line-z4 from os2-cmd-line
  429.                unstring param-cmd-line-z4
  430.                         delimited by space
  431.                         into
  432.                              param-val-n-z4(1)
  433.                              param-val-n-z4(2)
  434.                              param-val-n-z4(3)
  435.                              param-val-n-z4(4)
  436.                              param-val-n-z4(5)
  437.                              param-val-n-z4(6)
  438.                              param-val-n-z4(7)
  439.                              param-val-n-z4(8)
  440.                              param-val-n-z4(9)
  441.                              param-val-n-z4(10)
  442.                end-unstring
  443.                move -1 to mt-parameter-found-z1
  444.                perform with test before
  445.                        varying parameter-subscript-z4
  446.                        from    1
  447.                        by      1
  448.                        until parameter-subscript-z4 > 10
  449.                        or    mt-parameter-found-z1 positive
  450.                        move space to parameter-name-z4
  451.                        move space to parameter-value-z4
  452.                        unstring param-val-n-z4(parameter-subscript-z4)
  453.                           delimited by "="
  454.                           into
  455.                           parameter-name-z4
  456.                           parameter-value-z4
  457.                        end-unstring
  458.                        if  parameter-name-z4 = "MT"
  459.                            move 1 to mt-parameter-found-z1
  460.                            move parameter-value-z4 to mode-type-save-z1
  461.                        end-if
  462.                end-perform
  463.                move 'Messages' to current-file-z1
  464.                open extend message-ds
  465.                if  file-status-z1 = '00'
  466.                    move 1 to message-ds-open-z1
  467.                else
  468.                    move file-status-z1 to last-file-status-z1
  469.                    perform z-4-bad-file-status
  470.                    perform z-9-stop
  471.                end-if
  472.                accept date-z1 from date
  473.                accept time-z1 from time
  474.                move "===> SQLGENWS" to ws-margin-a2-2
  475.                move date-z1 to ws-dataname-a2-2
  476.                move time-z1 to ws-def-a2-2
  477.                move skeleton-line-a2-2 to message-line
  478.                perform z-1-write-message-rec
  479.                if  mt-parameter-found-z1 negative
  480.                    move "No mode type parameter specified"
  481.                    to message-line
  482.                    perform z-1-write-message-rec
  483.                    move 1 to parameter-error-z3
  484.                end-if
  485.                perform with test before
  486.                        varying parameter-subscript-z3
  487.                        from 1 by 1
  488.                        until   parameter-subscript-z3 > 10
  489.                        move -1
  490.                        to parameter-ok-n-z3(parameter-subscript-z3)
  491.                end-perform
  492.                perform a-4-help
  493.                perform a-9-parameter-sequence
  494.                .
  495.       *
  496.        a-3-main.
  497.       *=========
  498.       *
  499.       * Acces the speified database with start_using_database,
  500.       * control program activities based on parameters
  501.       *
  502.                move -1 to do-null-ind-a2
  503.                move zero to db-length
  504.                move database-id-z2 to database
  505.                inspect database
  506.                        tallying db-length
  507.                        for characters before initial space
  508.       * Value 83 here causes character <S> in u data item of CALL
  509.       * This sets database usage to SHARE
  510.                move 83 to d-use
  511.                call    "__SQLGSTPD"
  512.                using   sqlca
  513.                if  sqlcode not = 0
  514.                    perform z-2-dbm-error
  515.                end-if
  516.                call    "__SQLGSTRD"
  517.                using   database
  518.                        spare2
  519.                        sqlca
  520.                        by value d-use
  521.                        by value db-length
  522.                        by value spare1
  523.                if  sqlcode not = 0
  524.                    perform z-2-dbm-error
  525.                end-if
  526.                move table-name-z2 to table-name-hyph-z1
  527.                inspect table-name-hyph-z1
  528.                        replacing all "_" by "-"
  529.                perform b-3-1-fetch-syscols
  530.                perform b-3-2-declare-table
  531.                perform b-3-3-cobol-declare
  532.                if null-indicators-z2 positive
  533.                   move 1 to do-null-ind-a2
  534.                   perform b-3-4-null-indicators
  535.                   move -1 to do-null-ind-a2
  536.                end-if
  537.                if select-statement-z2 positive
  538.                   perform b-3-5-select-statement
  539.                end-if
  540.                if fetch-statement-z2 positive
  541.                   perform b-3-6-fetch-statement
  542.                end-if
  543.                .
  544.       *
  545.        a-4-help.
  546.       *=========
  547.       *
  548.       * NOTE. READ THIS SECTION FOR HELP ON PARAMETERS
  549.       *
  550.       * Put help into LOG if command line was blank or help specified
  551.       *
  552.                if  param-cmd-line-z4 = space
  553.                or  param-cmd-line-z4 = "H"
  554.                or  param-cmd-line-z4 = "h"
  555.                or  param-cmd-line-z4 = "HELP"
  556.                or  param-cmd-line-z4 = "Help"
  557.                or  param-cmd-line-z4 = "help"
  558.                    move 1 to parameter-error-z3
  559.                    move "Parameter names and meaning/values."
  560.                    to   message-line
  561.                    perform z-1-write-message-rec
  562.                    perform z-1-write-message-rec
  563.                    move "Parameters can be in any sequence."
  564.                    to   message-line
  565.                    perform z-1-write-message-rec
  566.                    perform z-1-write-message-rec
  567.                    move "MT=0<value<16 where value is MODE TYPE"
  568.                    to   message-line
  569.                    perform z-1-write-message-rec
  570.                    perform z-1-write-message-rec
  571.                    move "DB=database name"
  572.                    to   message-line
  573.                    perform z-1-write-message-rec
  574.                    perform z-1-write-message-rec
  575.                    move "AI=authorisation ID of table"
  576.                    to   message-line
  577.                    perform z-1-write-message-rec
  578.                    perform z-1-write-message-rec
  579.                    move "TN=table name of DATABASE/AUTHID"
  580.                    to   message-line
  581.                    perform z-1-write-message-rec
  582.                    perform z-1-write-message-rec
  583.                    move "TF=destination generation output"
  584.                    to   message-line
  585.                    perform z-1-write-message-rec
  586.                    perform z-1-write-message-rec
  587.                    move "BT=text prior to datanames"
  588.                    to   message-line
  589.                    perform z-1-write-message-rec
  590.                    perform z-1-write-message-rec
  591.                    move "AT=text after datanames"
  592.                    to   message-line
  593.                    perform z-1-write-message-rec
  594.                    perform z-1-write-message-rec
  595.                    move "NI=Y - generate NULL inds"
  596.                    to   message-line
  597.                    perform z-1-write-message-rec
  598.                    perform z-1-write-message-rec
  599.                    move "SG=Y  - generate SELECT"
  600.                    to   message-line
  601.                    perform z-1-write-message-rec
  602.                    perform z-1-write-message-rec
  603.                    move "FG=Y   - generate FETCH"
  604.                    to   message-line
  605.                    perform z-1-write-message-rec
  606.                end-if
  607.                .
  608.       *
  609.        a-5-file-parameters.
  610.       *====================
  611.       *
  612.       * Control reception of file parameters
  613.       *
  614.                move "File parameters:"
  615.                to   message-line
  616.                perform z-1-write-message-rec
  617.                if  parameter-error-z3 negative
  618.                    move 'Parameters' to current-file-z1
  619.                    open input parameter-ds
  620.                    if  file-status-z1 = '00'
  621.                        move 1 to parameter-ds-open-z1
  622.                    else
  623.                        move file-status-z1 to last-file-status-z1
  624.                        perform z-4-bad-file-status
  625.                        perform z-9-stop
  626.                    end-if
  627.                    perform b-2-1-get-pars-f
  628.                end-if
  629.                .
  630.       *
  631.        a-6-command-parameters.
  632.       *=======================
  633.       *
  634.       * Control reception of command line parameters
  635.       *
  636.                move "Command line parameters:"
  637.                to   message-line
  638.                perform z-1-write-message-rec
  639.                if  parameter-error-z3 negative
  640.                    perform b-2-0-get-pars-c
  641.                end-if
  642.                .
  643.       *
  644.        a-7-interactive-parameters.
  645.       *===========================
  646.       *
  647.       * Control reception of parameters from screen
  648.       *
  649.                move "Interactive parameters:"
  650.                to   message-line
  651.                perform z-1-write-message-rec
  652.                if  parameter-error-z3 negative
  653.                    perform b-2-2-get-pars-i
  654.                end-if
  655.                .
  656.       *
  657.        a-8-prepare-target.
  658.       *===================
  659.       *
  660.       * Put header information into target file including timestamp
  661.       *
  662.                if parameter-error-z3 negative
  663.                    move 'Target' to current-file-z1
  664.                    open output target-ds
  665.                    if  file-status-z1 = '00'
  666.                        move 1 to target-ds-open-z1
  667.                    else
  668.                        move file-status-z1 to last-file-status-z1
  669.                        perform z-4-bad-file-status
  670.                        perform z-9-stop
  671.                    end-if
  672.                    move 'Target data set opened OK' to message-line
  673.                    perform z-1-write-message-rec
  674.                    move "      * TIME"
  675.                    to ws-margin-a2-2
  676.                    move "Date" to ws-dataname-a2-2
  677.                    move "Time" to ws-def-a2-2
  678.                    move skeleton-line-a2-2 to target-line
  679.                    perform z-3-write-target-rec
  680.                    move "      * STAMP"
  681.                    to ws-margin-a2-2
  682.                    move date-z1 to ws-dataname-a2-2
  683.                    move time-z1 to ws-def-a2-2
  684.                    move skeleton-line-a2-2 to target-line
  685.                    perform z-3-write-target-rec
  686.                end-if
  687.                .
  688.       *
  689.        a-9-parameter-sequence.
  690.       *=======================
  691.       *
  692.       * CHOICE OF MANY PARAMETER SOURCES
  693.       * You may want to comment out any you dont want active
  694.       * Parameter values for the same parameter type are overwritten
  695.       * by values from subsequent parameter sources
  696.       *
  697.                if  parameter-error-z3 negative
  698.                    evaluate true
  699.                    when  mode-type-save-z1 = "1"
  700.                        perform a-6-command-parameters
  701.                    when  mode-type-save-z1 = "2"
  702.                        perform a-5-file-parameters
  703.                    when  mode-type-save-z1 = "3"
  704.                        perform a-7-interactive-parameters
  705.                    when  mode-type-save-z1 = "4"
  706.                        perform a-6-command-parameters
  707.                        perform a-5-file-parameters
  708.                    when  mode-type-save-z1 = "5"
  709.                        perform a-5-file-parameters
  710.                        perform a-6-command-parameters
  711.                    when  mode-type-save-z1 = "6"
  712.                        perform a-6-command-parameters
  713.                        perform a-7-interactive-parameters
  714.                    when  mode-type-save-z1 = "7"
  715.                        perform a-7-interactive-parameters
  716.                        perform a-6-command-parameters
  717.                    when  mode-type-save-z1 = "8"
  718.                        perform a-5-file-parameters
  719.                        perform a-7-interactive-parameters
  720.                    when  mode-type-save-z1 = "9"
  721.                        perform a-7-interactive-parameters
  722.                        perform a-5-file-parameters
  723.                    when  mode-type-save-z1 = "10"
  724.                        perform a-6-command-parameters
  725.                        perform a-7-interactive-parameters
  726.                        perform a-5-file-parameters
  727.                    when  mode-type-save-z1 = "11"
  728.                        perform a-7-interactive-parameters
  729.                        perform a-6-command-parameters
  730.                        perform a-5-file-parameters
  731.                    when  mode-type-save-z1 = "12"
  732.                        perform a-6-command-parameters
  733.                        perform a-5-file-parameters
  734.                        perform a-7-interactive-parameters
  735.                    when  mode-type-save-z1 = "13"
  736.                        perform a-5-file-parameters
  737.                        perform a-6-command-parameters
  738.                        perform a-7-interactive-parameters
  739.                    when  mode-type-save-z1 = "14"
  740.                        perform a-5-file-parameters
  741.                        perform a-7-interactive-parameters
  742.                        perform a-6-command-parameters
  743.                    when  mode-type-save-z1 = "15"
  744.                        perform a-7-interactive-parameters
  745.                        perform a-5-file-parameters
  746.                        perform a-6-command-parameters
  747.                    when other
  748.                        move "Invalid mode type (MT) specified follows:"
  749.                        to   message-line
  750.                        perform z-1-write-message-rec
  751.                        move mode-type-save-z1
  752.                        to   message-line
  753.                        perform z-1-write-message-rec
  754.                        move 1 to parameter-error-z3
  755.                    end-evaluate
  756.                end-if
  757.                .
  758.       *
  759.        b-2-0-get-pars-c.
  760.       *=================
  761.       *
  762.       * Get and control check of command line parameters
  763.       *
  764.                perform with test before
  765.                        varying parameter-subscript-z4
  766.                        from    1
  767.                        by      1
  768.                        until parameter-subscript-z4 > 10
  769.                        or    parameter-error-z3 positive
  770.                        or    last-parameter-z3 positive
  771.                        move space to parameter-name-z4
  772.                        move space to parameter-value-z4
  773.                        unstring param-val-n-z4(parameter-subscript-z4)
  774.                           delimited by "="
  775.                           into
  776.                           parameter-name-z4
  777.                           parameter-value-z4
  778.                        end-unstring
  779.                        if  parameter-name-z4 = space
  780.                            move 1 to last-parameter-z3
  781.                        else
  782.                            move parameter-name-z4
  783.                            to   parameter-name-z3
  784.                            move parameter-value-z4
  785.                            to   parameter-value-z3
  786.                            perform c-2-0-what-par
  787.                        end-if
  788.                end-perform
  789.                .
  790.       *
  791.        b-2-1-get-pars-f.
  792.       *=================
  793.       *
  794.       * Get and control check of file parameters
  795.       *
  796.                perform until end-parameter-ds-z1 = 1
  797.                        or    parameter-error-z3 positive
  798.                read parameter-ds
  799.                     at end
  800.                        move 1 to end-parameter-ds-z1
  801.                end-read
  802.                if end-parameter-ds-z1 negative
  803.                   unstring parameter-line
  804.                            delimited by '='
  805.                            into parameter-name-z3
  806.                                 parameter-value-z3
  807.                   end-unstring
  808.                   perform c-2-0-what-par
  809.                end-if
  810.                end-perform
  811.                .
  812.       *
  813.        b-2-2-get-pars-i.
  814.       *=================
  815.       *
  816.       * Get and control check of interactive parameters
  817.       *
  818.                perform varying parameter-subscript-z3
  819.                        from    2
  820.                        by      1
  821.                        until parameter-subscript-z3 > 10
  822.                        move parameter-name-n-z3(parameter-subscript-z3)
  823.                        to   parameter-name-z3
  824.                        if  parameter-ok-n-z3(parameter-subscript-z3)
  825.                            negative
  826.                            display 'Please enter value for '
  827.                                    parameter-name-z3
  828.                            accept parameter-value-z3
  829.                            perform c-2-0-what-par
  830.                        end-if
  831.                end-perform
  832.                .
  833.       *
  834.        b-3-0-get-max-cols.
  835.       *===================
  836.       *
  837.       * Get maximum number of columns in the specified table to
  838.       * enable program control functions later in the run
  839.       *
  840.                move authorisation-id-z2 to authorisation-id-a0
  841.                move table-name-z2 to table-name-a0
  842.                exec sql
  843.                        select max(colno)
  844.                        into   :max-columns-a0
  845.                        from   SYSIBM.SYSCOLUMNS
  846.                        where  tbcreator = :authorisation-id-a0
  847.                        and    tbname    = :table-name-a0
  848.                end-exec
  849.                if sqlcode not = zero
  850.                and sqlcode not = -305
  851.                   perform z-2-dbm-error
  852.                end-if
  853.                .
  854.       *
  855.        b-3-1-fetch-syscols.
  856.       *====================
  857.       *
  858.       * Read the SYSCOLUMNS information for each column for the specied
  859.       * table
  860.       *
  861.                add 1 to max-columns-a0
  862.                exec sql
  863.                     declare syscols cursor for
  864.                            select
  865.                            name,
  866.                            tbname,
  867.                            tbcreator,
  868.                            coltype,
  869.                            nulls,
  870.                            length,
  871.                            scale,
  872.                            colno
  873.                    from SYSIBM.SYSCOLUMNS
  874.                    where tbcreator = :authorisation-id-a0
  875.                    and   tbname    = :table-name-a0
  876.                    order by colno
  877.                end-exec
  878.                if sqlcode not = zero
  879.                   perform z-2-dbm-error
  880.                end-if
  881.                exec sql
  882.                    open syscols
  883.                end-exec
  884.                if sqlcode not = zero
  885.                   perform z-2-dbm-error
  886.                end-if
  887.                perform with test before
  888.                        varying fetch-sub-a3 from 1 by 1
  889.                        until   fetch-sub-a3 > max-columns-a0
  890.                        or      sqlcode not = zero
  891.                exec sql
  892.                    fetch syscols into
  893.                            :name-a0,
  894.                            :tbname-a0,
  895.                            :tbcreator-a0,
  896.                            :coltype-a0,
  897.                            :nulls-a0,
  898.                            :length-a0,
  899.                            :scale-a0,
  900.                            :colno-a0
  901.                end-exec
  902.                if sqlcode not = zero
  903.                   perform z-2-dbm-error
  904.                end-if
  905.                move sysibm-syscolumns-a0
  906.                to   column-a4(fetch-sub-a3)
  907.                inspect name-a0
  908.                        replacing all "_" by "-"
  909.                inspect tbname-a0
  910.                        replacing all "_" by "-"
  911.                move sysibm-syscolumns-a0
  912.                to   column-a3(fetch-sub-a3)
  913.                end-perform
  914.                exec sql
  915.                    close syscols
  916.                end-exec
  917.                if sqlcode not = zero
  918.                   perform z-2-dbm-error
  919.                end-if
  920.                .
  921.       *
  922.        b-3-2-declare-table.
  923.       *====================
  924.       *
  925.       * Generate SQL table definition for COBOL
  926.       *
  927.                move "      * SQLGENWS produced this"
  928.                to target-line
  929.                perform z-3-write-target-rec
  930.                move "      * SQL TABLE DECLARATION"
  931.                to target-line
  932.                perform z-3-write-target-rec
  933.                string "       EXEC SQL DECLARE "
  934.                       delimited by size
  935.                       tbname-a4(1) delimited by space
  936.                       " TABLE (" delimited by size
  937.                into target-line
  938.                end-string
  939.                perform z-3-write-target-rec
  940.                perform with test before
  941.                        varying column-sub-a4
  942.                        from 1 by 1
  943.                        until column-sub-a4 > max-columns-a0
  944.                        move space to skeleton-line-a2-2
  945.                        move name-a4(column-sub-a4) to ws-dataname-a2-2
  946.                        if coltype-a4(column-sub-a4) = 'LONGVAR'
  947.                           move "LONG VARCHAR +"
  948.                           to   ws-def-a2-2
  949.                        end-if
  950.                        if coltype-a4(column-sub-a4) = 'TIMESTMP'
  951.                           move "TIMESTAMP +"
  952.                           to   ws-def-a2-2
  953.                        end-if
  954.                        if  coltype-a4(column-sub-a4) not = 'LONGVAR'
  955.                        and coltype-a4(column-sub-a4) not = 'TIMESTMP'
  956.                            string coltype-a4(column-sub-a4)
  957.                                   delimited by space
  958.                                   " +" delimited by size
  959.                            into   ws-def-a2-2
  960.                            end-string
  961.                        end-if
  962.                        move length-a4(column-sub-a4) to length-a2
  963.                        move length-a2 to length-char-a2
  964.                        if  coltype-a4(column-sub-a4) = 'CHAR'
  965.                        or  coltype-a4(column-sub-a4) = 'VARCHAR'
  966.                            string ws-def-a2-2 delimited by "+"
  967.                                   "(" delimited by size
  968.                                   length-char-a2
  969.                                   delimited by size
  970.                                   ") +" delimited by size
  971.                            into   ws-def-a2-2
  972.                            end-string
  973.                        end-if
  974.                        move scale-a4(column-sub-a4) to scale-a2
  975.                        move scale-a2 to scale-char-a2
  976.                        if  coltype-a4(column-sub-a4) = 'DECIMAL'
  977.                            string ws-def-a2-2 delimited by "+"
  978.                                   "(" delimited by size
  979.                                   length-char-a2
  980.                                   delimited by size
  981.                                   "," delimited by size
  982.                                   scale-char-a2
  983.                                   delimited by size
  984.                                   ") +" delimited by size
  985.                            into   ws-def-a2-2
  986.                            end-string
  987.                        end-if
  988.                        if  nulls-a4(column-sub-a4) = 'N'
  989.                            string ws-def-a2-2 delimited by "+"
  990.                                   "NOT NULL +" delimited by size
  991.                            into   ws-def-a2-2
  992.                            end-string
  993.                        end-if
  994.                        if  column-sub-a4 < max-columns-a0
  995.                            string ws-def-a2-2 delimited by "+"
  996.                                   "," delimited by size
  997.                            into   ws-def-a2-2
  998.                            end-string
  999.                        else
  1000.                            string ws-def-a2-2 delimited by "+"
  1001.                                   " " delimited by size
  1002.                            into   ws-def-a2-2
  1003.                            end-string
  1004.                        end-if
  1005.                        move skeleton-line-a2-2 to target-line
  1006.                        perform z-3-write-target-rec
  1007.                end-perform
  1008.                move "        )"
  1009.                to target-line
  1010.                perform z-3-write-target-rec
  1011.                move "        END-EXEC"
  1012.                to target-line
  1013.                perform z-3-write-target-rec
  1014.                .
  1015.       *
  1016.        b-3-3-cobol-declare.
  1017.       *====================
  1018.       *
  1019.       * Generate database host variables for COBOL working storage
  1020.       *
  1021.                move '      * SQLGENWS produced this COBOL'
  1022.                to target-line
  1023.                perform z-3-write-target-rec
  1024.                move '      * SQL host variable structure'
  1025.                to target-line
  1026.                perform z-3-write-target-rec
  1027.                perform with test before
  1028.                        varying column-sub-a3
  1029.                        from 1 by 1
  1030.                        until column-sub-a3 > max-columns-a0
  1031.                    move space to skeleton-line-a2-1
  1032.                    move space to dataname-a2
  1033.                    if column-sub-a3 = 1
  1034.                       perform c-3-1-01-level
  1035.                    end-if
  1036.                    string before-text-z2 delimited by space
  1037.                           name-a3(column-sub-a3)
  1038.                                          delimited by space
  1039.                           after-text-z2  delimited by space
  1040.                    into   dataname-a2
  1041.                    end-string
  1042.                    move dataname-a2 to ws-dataname-a2-1
  1043.                    evaluate true
  1044.                        when coltype-a3(column-sub-a3) = "SMALLINT"
  1045.                         perform c-3-2-smallint
  1046.                        when coltype-a3(column-sub-a3) = "INTEGER"
  1047.                         perform c-3-3-integer
  1048.                        when coltype-a3(column-sub-a3) = "DECIMAL"
  1049.                         perform c-3-4-decimal
  1050.                        when coltype-a3(column-sub-a3) = "CHAR"
  1051.                         perform c-3-5-char
  1052.                        when coltype-a3(column-sub-a3) = "VARCHAR"
  1053.                         perform c-3-6-varchar
  1054.                        when coltype-a3(column-sub-a3) = "LONGVAR"
  1055.                         perform c-3-7-longvar
  1056.                        when coltype-a3(column-sub-a3) = "DATE"
  1057.                         perform c-3-8-date
  1058.                        when coltype-a3(column-sub-a3) = "TIME"
  1059.                         perform c-3-9-time
  1060.                        when coltype-a3(column-sub-a3) = "TIMESTMP"
  1061.                         perform c-3-10-timestmp
  1062.                        when coltype-a3(column-sub-a3) = "FLOAT"
  1063.                         perform c-3-11-float
  1064.                        when other
  1065.                         perform c-3-12-other
  1066.                    end-evaluate
  1067.                    move skeleton-line-a2-1 to target-line
  1068.                    perform z-3-write-target-rec
  1069.                end-perform
  1070.                .
  1071.       *
  1072.        b-3-4-null-indicators.
  1073.       *======================
  1074.       *
  1075.       * Generate database NULL indicator variables for the specified
  1076.       * table
  1077.       *
  1078.                move space to skeleton-line-a2-1
  1079.                perform with test before
  1080.                        varying column-sub-a3
  1081.                        from 1 by 1
  1082.                        until column-sub-a3 > max-columns-a0
  1083.                    if column-sub-a3 = 1
  1084.                        perform c-3-13-null-01-03
  1085.                    end-if
  1086.                    move space to dataname-a2
  1087.                    string before-text-z2 delimited by space
  1088.                           name-a3(column-sub-a3)
  1089.                                          delimited by space
  1090.                           after-text-z2  delimited by space
  1091.                    into   dataname-a2
  1092.                    end-string
  1093.                    move dataname-a2 to ws-dataname-a2-1
  1094.                    perform c-3-2-smallint
  1095.                    move skeleton-line-a2-1 to target-line
  1096.                    perform z-3-write-target-rec
  1097.                    move space to skeleton-line-a2-1
  1098.                end-perform
  1099.                perform c-3-14-null-03red
  1100.                .
  1101.       *
  1102.        b-3-5-select-statement.
  1103.       *=======================
  1104.       *
  1105.       * Generate a SQL SELECT statement for the specified table
  1106.       *
  1107.                move "      *" to target-line
  1108.                perform z-3-write-target-rec
  1109.                move "      * SELECT STATEMENT" to target-line
  1110.                perform z-3-write-target-rec
  1111.                move "               SELECT" to target-line
  1112.                perform z-3-write-target-rec
  1113.                perform with test before
  1114.                        varying column-sub-a4
  1115.                        from    1 by 1
  1116.                        until   column-sub-a4 > max-columns-a0 - 1
  1117.                        string "               " delimited by size
  1118.                               name-a4(column-sub-a4) delimited by space
  1119.                               "," delimited by size
  1120.                        into   target-line
  1121.                        end-string
  1122.                        perform z-3-write-target-rec
  1123.                end-perform
  1124.                string "               " delimited by size
  1125.                       name-a4(column-sub-a4) delimited by space
  1126.                into   target-line
  1127.                end-string
  1128.                perform z-3-write-target-rec
  1129.                string "               FROM " delimited by size
  1130.                       tbname-a4(1) delimited by space
  1131.                into   target-line
  1132.                perform z-3-write-target-rec
  1133.                .
  1134.       *
  1135.        b-3-6-fetch-statement.
  1136.       *======================
  1137.       *
  1138.       * Generate a SQL FETCH statement for the spefied table
  1139.       *
  1140.                move "      *" to target-line
  1141.                perform z-3-write-target-rec
  1142.                move "      * FETCH STATEMENT" to target-line
  1143.                perform z-3-write-target-rec
  1144.                move "               FETCH CURSOR-NAME INTO"
  1145.                to   target-line
  1146.                perform z-3-write-target-rec
  1147.                perform with test before
  1148.                        varying column-sub-a3
  1149.                        from    1 by 1
  1150.                        until   column-sub-a3 > max-columns-a0 - 1
  1151.                        string "               :" delimited by size
  1152.                               before-text-z2 delimited by space
  1153.                               name-a3(column-sub-a3) delimited by space
  1154.                               after-text-z2 delimited by space
  1155.                               "," delimited by size
  1156.                        into   target-line
  1157.                        end-string
  1158.                        perform z-3-write-target-rec
  1159.                end-perform
  1160.                string "               :" delimited by size
  1161.                       before-text-z2 delimited by space
  1162.                       name-a3(column-sub-a3) delimited by space
  1163.                       after-text-z2 delimited by space
  1164.                into   target-line
  1165.                end-string
  1166.                perform z-3-write-target-rec
  1167.                .
  1168.       *
  1169.        c-2-0-what-par.
  1170.       *===============
  1171.       *
  1172.       * Determine the current parameter type
  1173.       *
  1174.                move space to skeleton-line-a2-3
  1175.                string parameter-name-z3 delimited by space
  1176.                       "=" delimited by size
  1177.                into   param-name-a2-3
  1178.                end-string
  1179.                move parameter-value-z3 to param-value-a2-3
  1180.                move skeleton-line-a2-3 to message-line
  1181.                perform z-1-write-message-rec
  1182.                evaluate true
  1183.                         when parameter-name-z3 = 'MT'
  1184.                                perform c-2-2-mode
  1185.                         when parameter-name-z3 = 'DB'
  1186.                                perform c-2-3-database
  1187.                         when parameter-name-z3 = 'AI'
  1188.                                perform c-2-4-authid
  1189.                         when parameter-name-z3 = 'TN'
  1190.                                perform c-2-5-tablename
  1191.                         when parameter-name-z3 = 'TF'
  1192.                                perform c-2-6-targetfile
  1193.                         when parameter-name-z3 = 'BT'
  1194.                                perform c-2-7-beforetext
  1195.                         when parameter-name-z3 = 'AT'
  1196.                                perform c-2-8-aftertext
  1197.                         when parameter-name-z3 = 'NI'
  1198.                                perform c-2-9-nullindgen
  1199.                         when parameter-name-z3 = 'SG'
  1200.                                perform c-2-10-selectgen
  1201.                         when parameter-name-z3 = 'FG'
  1202.                                perform c-2-11-fetchgen
  1203.                         when other
  1204.                                perform c-2-1-pars-error
  1205.                end-evaluate
  1206.                .
  1207.       *
  1208.        c-2-1-pars-error.
  1209.       *=================
  1210.       *
  1211.       * LOG a parameter error
  1212.       *
  1213.                move 1 to parameter-error-z3
  1214.                move 'Unknown or invalid parameter specified'
  1215.                to   message-line
  1216.                perform z-1-write-message-rec
  1217.                move 'Parameter as specified follows:'
  1218.                to   message-line
  1219.                perform z-1-write-message-rec
  1220.                move parameter-name-z3 to message-line
  1221.                perform z-1-write-message-rec
  1222.                .
  1223.       *
  1224.        c-2-2-mode.
  1225.       *===========
  1226.       *
  1227.       * Specific check/move for MODE TYPE parameter
  1228.       *
  1229.                if parameter-error-z3 negative
  1230.                   move parameter-value-z3 to mode-z2
  1231.                   move 1 to parameter-ok-n-z3(1)
  1232.                end-if
  1233.                .
  1234.       *
  1235.        c-2-3-database.
  1236.       *===============
  1237.       *
  1238.       * Specific check/move for DATABASE parameter
  1239.       *
  1240.                if  parameter-value-z3 not = space
  1241.                    move parameter-value-z3 to database-id-z2
  1242.                    move 1 to parameter-ok-n-z3(2)
  1243.                else
  1244.                    perform c-2-1-pars-error
  1245.                end-if
  1246.                .
  1247.       *
  1248.        c-2-4-authid.
  1249.       *=============
  1250.       *
  1251.       * Specific check/move for AUTHORISATION ID parameter
  1252.       *
  1253.                if  parameter-value-z3 not = space
  1254.                    move parameter-value-z3 to authorisation-id-z2
  1255.                    move 1 to parameter-ok-n-z3(3)
  1256.                else
  1257.                    perform c-2-1-pars-error
  1258.                .
  1259.       *
  1260.        c-2-5-tablename.
  1261.       *================
  1262.       *
  1263.       * Specific check/move for TABLENAME parameter
  1264.       *
  1265.                if  parameter-value-z3 not = space
  1266.                    move parameter-value-z3 to table-name-z2
  1267.                    move 1 to parameter-ok-n-z3(4)
  1268.                else
  1269.                    perform c-2-1-pars-error
  1270.                .
  1271.       *
  1272.        c-2-6-targetfile.
  1273.       *=================
  1274.       *
  1275.       * Specific check/move for TARGETFILE parameter
  1276.       *
  1277.                if  parameter-value-z3 not = space
  1278.                    move parameter-value-z3 to target-ds-z1
  1279.                    move parameter-value-z3 to target-ds-z2
  1280.                    move 1 to parameter-ok-n-z3(5)
  1281.                else
  1282.                    perform c-2-1-pars-error
  1283.                .
  1284.       *
  1285.        c-2-7-beforetext.
  1286.       *=================
  1287.       *
  1288.       * Spefific check/move for BEFORETEXT parameter
  1289.       *
  1290.                if  parameter-value-z3 not = space
  1291.                    move parameter-value-z3 to before-text-z2
  1292.                else
  1293.                    move space to before-text-z2
  1294.                end-if
  1295.                move 1 to parameter-ok-n-z3(6)
  1296.                .
  1297.       *
  1298.        c-2-8-aftertext.
  1299.       *================
  1300.       *
  1301.       * Specific check/move for AFTERTEXT parameter
  1302.       *
  1303.                if  parameter-value-z3 not = space
  1304.                    move parameter-value-z3 to after-text-z2
  1305.                else
  1306.                    move space to after-text-z2
  1307.                end-if
  1308.                move 1 to parameter-ok-n-z3(7)
  1309.                .
  1310.       *
  1311.        c-2-9-nullindgen.
  1312.       *=================
  1313.       *
  1314.       * Specific check/move for NULLINDGEN parameter
  1315.       *
  1316.                if parameter-value-z3  = 'Y'
  1317.                   move 1 to null-indicators-z2
  1318.                end-if
  1319.                move 1 to parameter-ok-n-z3(8)
  1320.                .
  1321.       *
  1322.        c-2-10-selectgen.
  1323.       *=================
  1324.       *
  1325.       * Specific check/move for SELECTGEN parameter
  1326.       *
  1327.                if parameter-value-z3 = 'Y'
  1328.                   move 1 to select-statement-z2
  1329.                end-if
  1330.                move 1 to parameter-ok-n-z3(9)
  1331.                .
  1332.       *
  1333.        c-2-11-fetchgen.
  1334.       *================
  1335.       *
  1336.       * Specific check/move for FETCHGEN parameter
  1337.       *
  1338.                if parameter-value-z3 = 'Y'
  1339.                   move 1 to fetch-statement-z2
  1340.                end-if
  1341.                move 1 to parameter-ok-n-z3(10)
  1342.                .
  1343.       *
  1344.        c-3-1-01-level.
  1345.       *===============
  1346.       *
  1347.       * Generate COBOL 01 level line
  1348.       *
  1349.                move '01  ' to ws-level-a2-1
  1350.                string before-text-z2 delimited by space
  1351.                    table-name-hyph-z1 delimited by space
  1352.                    after-text-z2  delimited by space
  1353.                into   dataname-a2
  1354.                end-string
  1355.                string dataname-a2 delimited by space
  1356.                       "." delimited by size
  1357.                into   dataname-a2
  1358.                end-string
  1359.                move dataname-a2 to ws-dataname-a2-1
  1360.                move skeleton-line-a2-1 to target-line
  1361.                perform z-3-write-target-rec
  1362.                move space to skeleton-line-a2-1
  1363.                move space to dataname-a2
  1364.                .
  1365.       *
  1366.        c-3-2-smallint.
  1367.       *===============
  1368.       *
  1369.       * Generate COBOL line for database SMALLINT
  1370.       *
  1371.                move "  10" to ws-level-a2-1
  1372.                if do-null-ind-a2 positive
  1373.                    string ws-dataname-a2-1 delimited by after-text-z2
  1374.                           "-NULL" delimited by size
  1375.                           after-text-z2 delimited by space
  1376.                    into   ws-dataname-a2-1
  1377.                    end-string
  1378.                end-if
  1379.                move smallint-pic-a2 to ws-pic-a2-1
  1380.                .
  1381.       *
  1382.        c-3-3-integer.
  1383.       *==============
  1384.       *
  1385.       * Generate COBOL line for database INTEGER
  1386.       *
  1387.                move "  10" to ws-level-a2-1
  1388.                move integer-pic-a2 to ws-pic-a2-1
  1389.                .
  1390.       *
  1391.        c-3-4-decimal.
  1392.       *==============
  1393.       *
  1394.       * Generate COBOL line for database DECIMAL
  1395.       *
  1396.                move "  10" to ws-level-a2-1
  1397.                move length-a3(column-sub-a3) to length-a2
  1398.                move length-a2 to length-char-a2
  1399.                move scale-a3(column-sub-a3) to scale-a2
  1400.                move scale-a2 to scale-char-a2
  1401.                string decimal-pic-a2 delimited by "+"
  1402.                       length-char-a2 delimited by space
  1403.                       "+" delimited by size
  1404.                into   ws-pic-a2-1
  1405.                end-string
  1406.                if scale-a2 = zero
  1407.                    string ws-pic-a2-1 delimited by "+"
  1408.                           ")." delimited by size
  1409.                    into   ws-pic-a2-1
  1410.                    end-string
  1411.                else
  1412.                    string ws-pic-a2-1 delimited by "+"
  1413.                           ")V9(" delimited by size
  1414.                           scale-char-a2 delimited by space
  1415.                           ")." delimited by size
  1416.                    into   ws-pic-a2-1
  1417.                    end-string
  1418.                .
  1419.       *
  1420.        c-3-5-char.
  1421.       *===========
  1422.       *
  1423.       * Generate COBOL line for database CHAR
  1424.       *
  1425.                move "  10" to ws-level-a2-1
  1426.                move char-pic-a2 to ws-pic-a2-1
  1427.                move length-a3(column-sub-a3) to length-a2
  1428.                move length-a2 to length-char-a2
  1429.                string ws-pic-a2-1 delimited by "+"
  1430.                       length-char-a2 delimited by space
  1431.                       ")." delimited by size
  1432.                into   ws-pic-a2-1
  1433.                end-string
  1434.                .
  1435.       *
  1436.        c-3-6-varchar.
  1437.       *==============
  1438.       *
  1439.       * Generate COBOL line for database VARCHAR
  1440.       *
  1441.                move "  10" to ws-level-a2-1
  1442.                string ws-dataname-a2-1 delimited by space
  1443.                       "." delimited by size
  1444.                into ws-dataname-a2-1
  1445.                end-string
  1446.                move skeleton-line-a2-1 to target-line
  1447.                perform z-3-write-target-rec
  1448.                move space to skeleton-line-a2-1
  1449.                move "    49" to ws-level-a2-1
  1450.                move space to ws-dataname-a2-1
  1451.                string dataname-a2 delimited by after-text-z2
  1452.                       "-LEN" delimited by size
  1453.                       after-text-z2 delimited by space
  1454.                into   ws-dataname-a2-1
  1455.                end-string
  1456.                move smallint-pic-a2 to ws-pic-a2-1
  1457.                move skeleton-line-a2-1 to target-line
  1458.                perform z-3-write-target-rec
  1459.                move space to skeleton-line-a2-1
  1460.                move "    49" to ws-level-a2-1
  1461.                move space to ws-dataname-a2-1
  1462.                string dataname-a2 delimited by after-text-z2
  1463.                       "-TEXT" delimited by size
  1464.                       after-text-z2 delimited by space
  1465.                into   ws-dataname-a2-1
  1466.                end-string
  1467.                move char-pic-a2 to ws-pic-a2-1
  1468.                move length-a3(column-sub-a3) to length-a2
  1469.                move length-a2 to length-char-a2
  1470.                string ws-pic-a2-1 delimited by "+"
  1471.                       length-char-a2 delimited by space
  1472.                       ")." delimited by size
  1473.                into   ws-pic-a2-1
  1474.                end-string
  1475.                .
  1476.       *
  1477.        c-3-7-longvar.
  1478.       *==============
  1479.       *
  1480.       * Generate COBOL line for database LONG VARCHAR
  1481.       * (Same as VARCHAR)
  1482.       *
  1483.                perform c-3-6-varchar
  1484.                .
  1485.       *
  1486.        c-3-8-date.
  1487.       *===========
  1488.       *
  1489.       * Generate COBOL line for database DATE
  1490.       *
  1491.                move "  10" to ws-level-a2-1
  1492.                move date-pic-a2 to ws-pic-a2-1
  1493.                .
  1494.       *
  1495.        c-3-9-time.
  1496.       *===========
  1497.       *
  1498.       * Generate COBOL line for database TIME
  1499.       *
  1500.                move "  10" to ws-level-a2-1
  1501.                move time-pic-a2 to ws-pic-a2-1
  1502.                .
  1503.       *
  1504.        c-3-10-timestmp.
  1505.       *================
  1506.       *
  1507.       * Generate COBOL line for database TIMESTAMP
  1508.       *
  1509.                move "  10" to ws-level-a2-1
  1510.                move timestamp-pic-a2 to ws-pic-a2-1
  1511.                .
  1512.       *
  1513.        c-3-11-float.
  1514.       *=============
  1515.       *
  1516.       * Generate warning for database FLOAT datatype
  1517.       * Not supported in COBOL/2 version
  1518.       *
  1519.                move "*******" to target-line
  1520.                perform z-3-write-target-rec
  1521.                move "******* WARNING:" to target-line
  1522.                perform z-3-write-target-rec
  1523.                move "******* FLOAT DATA TYPE NOT SUPPORTED *******"
  1524.                to   target-line
  1525.                perform z-3-write-target-rec
  1526.                .
  1527.       *
  1528.        c-3-12-other.
  1529.       *=============
  1530.       *
  1531.       * LOG error and stop run if any other types
  1532.       *
  1533.                move "INVALID DATA TYPE IN TABLE"
  1534.                to   message-line
  1535.                perform z-1-write-message-rec
  1536.                move "SQLGENWS RUN ABANDONED"
  1537.                to   message-line
  1538.                perform z-1-write-message-rec
  1539.                perform z-9-stop
  1540.                .
  1541.       *
  1542.        c-3-13-null-01-03.
  1543.       *==================
  1544.       *
  1545.       * Generate NULL indicator 01 and 03 level
  1546.       *
  1547.                move "      *" to target-line
  1548.                perform z-3-write-target-rec
  1549.                move "      * NULL INDICATOR VARIABLES"
  1550.                to   target-line
  1551.                perform z-3-write-target-rec
  1552.                move '01  ' to ws-level-a2-1
  1553.                string before-text-z2 delimited by space
  1554.                       table-name-hyph-z1 delimited by space
  1555.                       "-NULL-INDS" delimited by size
  1556.                       after-text-z2  delimited by space
  1557.                       "." delimited by size
  1558.                into   dataname-a2
  1559.                end-string
  1560.                move dataname-a2 to ws-dataname-a2-1
  1561.                move skeleton-line-a2-1 to target-line
  1562.                perform z-3-write-target-rec
  1563.                move space to skeleton-line-a2-1
  1564.                move space to dataname-a2
  1565.                move ' 03 ' to ws-level-a2-1
  1566.                string before-text-z2 delimited by space
  1567.                       table-name-hyph-z1 delimited by space
  1568.                       "-NULLS" delimited by size
  1569.                       after-text-z2  delimited by space
  1570.                       "." delimited by size
  1571.                into   dataname-a2
  1572.                end-string
  1573.                move dataname-a2 to ws-dataname-a2-1
  1574.                move skeleton-line-a2-1 to target-line
  1575.                perform z-3-write-target-rec
  1576.                move space to skeleton-line-a2-1
  1577.                move space to dataname-a2
  1578.                .
  1579.       *
  1580.        c-3-14-null-03red.
  1581.       *==================
  1582.       *
  1583.       * Generate NULL indicator redefinition line
  1584.       *
  1585.                move ' 03 ' to ws-level-a2-1
  1586.                string before-text-z2 delimited by space
  1587.                       table-name-hyph-z1 delimited by space
  1588.                       "-NULL" delimited by size
  1589.                       after-text-z2  delimited by space
  1590.                into   dataname-a2
  1591.                end-string
  1592.                move dataname-a2 to ws-dataname-a2-1
  1593.                move skeleton-line-a2-1 to target-line
  1594.                perform z-3-write-target-rec
  1595.                move space to skeleton-line-a2-1
  1596.                move space to dataname-a2
  1597.                move "REDEFINES" to ws-dataname-a2-1
  1598.                move skeleton-line-a2-1 to target-line
  1599.                perform z-3-write-target-rec
  1600.                move space to skeleton-line-a2-1
  1601.                move space to dataname-a2
  1602.                string before-text-z2 delimited by space
  1603.                       table-name-hyph-z1 delimited by space
  1604.                       "-NULLS" delimited by size
  1605.                       after-text-z2  delimited by space
  1606.                into   dataname-a2
  1607.                end-string
  1608.                move dataname-a2 to ws-dataname-a2-1
  1609.                move smallint-plus-pic-a2
  1610.                to   ws-pic-a2-1
  1611.                string ws-pic-a2-1 delimited by "+"
  1612.                       " " delimited by size
  1613.                into   ws-pic-a2-1
  1614.                end-string
  1615.                move skeleton-line-a2-1 to target-line
  1616.                perform z-3-write-target-rec
  1617.                move space to skeleton-line-a2-1
  1618.                move space to dataname-a2
  1619.                move max-columns-a0 to length-a2
  1620.                move length-a2 to length-char-a2
  1621.                move "OCCURS +" to ws-pic-a2-1
  1622.                string ws-pic-a2-1 delimited by "+"
  1623.                       length-char-a2 delimited by size
  1624.                       "." delimited by size
  1625.                into ws-pic-a2-1
  1626.                end-string
  1627.                move skeleton-line-a2-1 to target-line
  1628.                perform z-3-write-target-rec
  1629.                move space to skeleton-line-a2-1
  1630.                move space to dataname-a2
  1631.                .
  1632.       *
  1633.        z-1-write-message-rec.
  1634.       *======================
  1635.       *
  1636.       * Write a line to the LOG file
  1637.       *
  1638.                write message-rec
  1639.                move space to message-line
  1640.                .
  1641.       *
  1642.        z-2-dbm-error.
  1643.       *==============
  1644.       *
  1645.       * LOG a database error - if SQLCODE bad
  1646.       *
  1647.                if  sqlcode not = allow-dbmcode-z1
  1648.                    move sqlcode to dbmcode-z1
  1649.                    move 'sqlcode returned with bad value'
  1650.                    to   dbm-message-text-z1
  1651.                    move dbm-message-z1 to message-line
  1652.                    perform z-1-write-message-rec
  1653.                    perform z-9-stop
  1654.                .
  1655.       *
  1656.        z-3-write-target-rec.
  1657.       *=====================
  1658.       *
  1659.       * Write a line to the TARGETFILE
  1660.       *
  1661.                write target-rec
  1662.                move space to target-line
  1663.                .
  1664.       *
  1665.        z-4-bad-file-status.
  1666.       *====================
  1667.       *
  1668.       * Write LOG of file error
  1669.       *
  1670.                move "Bad file status on open."
  1671.                to   message-line
  1672.                perform z-1-write-message-rec
  1673.                move "File name and status follow:"
  1674.                to   message-line
  1675.                perform z-1-write-message-rec
  1676.                move current-file-z1
  1677.                to   message-line
  1678.                perform z-1-write-message-rec
  1679.                move last-file-status-b-z1
  1680.                to   display-status-z1
  1681.                move display-file-status-z1
  1682.                to   message-line
  1683.                perform z-1-write-message-rec
  1684.                .
  1685.       *
  1686.        z-9-stop.
  1687.       *=========
  1688.       *
  1689.       * Breathe a sigh of relief and retire.
  1690.       * LOG the end of run <==== EYECATCHER <====
  1691.       *
  1692.                move "<=== End of RUN" to message-line
  1693.                perform z-1-write-message-rec
  1694.                perform z-9-100
  1695.                perform z-9-999
  1696.                .
  1697.       *
  1698.        z-9-100.
  1699.       *========
  1700.       *
  1701.                if  parameter-ds-open-z1 positive
  1702.                    close parameter-ds
  1703.                end-if
  1704.                if  target-ds-open-z1 positive
  1705.                    close target-ds
  1706.                end-if
  1707.                if  message-ds-open-z1 positive
  1708.                    close message-ds
  1709.                end-if
  1710.                .
  1711.       *
  1712.        z-9-999.
  1713.       *========
  1714.       *
  1715.       * Thats all folks.
  1716.       *
  1717.                stop run
  1718.                .
  1719.