midrange.com code scratchpad
Name:
create table based on original file
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
03/16/2010 01:30:30 pm
IP:
Logged
Description:
creates a table from an existing table's definition using the parms of from file and to file
Code:
  1.      h option(*nodebugio)
  2.      ‚*---------------------------------------------------------------*
  3.      ‚* Program Name: CRTTOPFR        Program Author:  Tommy Holden   *
  4.      ‚* Program Date: 09/01/2004      Program Purpose: Create Output  *
  5.      ‚*                                   File From "Template" File   *
  6.      ‚*---------------------------------------------------------------*
  7.      ‚* Modifications Section                                         *
  8.      ‚*---------------------------------------------------------------*
  9.      ‚* Programmer:                      Mod. Mark:                   *
  10.      ‚* Date of Change:  00/00/1999      Project Number:              *
  11.      ‚* Purpose Of Changes:                                           *
  12.      ‚* Description:                                                  *
  13.      *---------------------------------------------------------------*
  14.  
  15.      * Work Fields
  16.      DCreateString     s          30000a   Varying
  17.      DFieldName        s             10a
  18.      DColType          s              8a
  19.      DLength           s              9s 0
  20.      DDecimals         s              9s 0
  21.      DColNo            s              9s 0
  22.      d n2              s              4b 0
  23.  
  24.      * Template File DS
  25.      D                 ds
  26.      D FromFileDS              1     20a
  27.      D FileName                1     10a
  28.      D LibName                11     20a
  29.  
  30.      * Output File DS
  31.      D                 ds
  32.      D ToFileDS                1     20a
  33.      D ToFileName              1     10a
  34.      D ToLib                  11     20a
  35.  
  36.      * Parameter Entry
  37.      C     *Entry        PList
  38.      C                   Parm                    FromFile         20
  39.      C                   Parm                    ToFile           20
  40.  
  41.      * Load File DS's
  42.      c                   Eval      FromFileDS=FromFile
  43.      c                   Eval      ToFileDS=ToFile
  44.  
  45.      * SQL Error Trapping
  46.      c/exec sql
  47.      c+ whenever sqlerror continue
  48.      c/end-exec
  49.  
  50.      * Declare SQL Cursor For Retrieving File Attributes From SYSCOLUMNS
  51.      c/exec sql
  52.      c+ declare FileCursor Cursor For
  53.      c+  Select Sys_CName,ColType,Length,Scale,ColNo
  54.      c+      From SYSCOLUMNS
  55.      c+        Where Sys_DName= :LibName and Sys_TName= :FileName
  56.      c+      Order By ColNo
  57.      c+    For Fetch Only
  58.      c/end-exec
  59.  
  60.      * Open SQL Cursor
  61.      c/exec sql
  62.      c+  Open FileCursor
  63.      c/end-exec
  64.  
  65.      * Open SQL Cursor Failed
  66.      c                   If        SQLCOD<0
  67.      c                   ExSR      Terminate
  68.      c                   EndIf
  69.  
  70.      * Initialize The SQL Statement Variable
  71.      c                   Eval      CreateString='CREATE TABLE '
  72.      c                             +%Trim(ToLib)+'/'+%Trim(ToFileName)
  73.      c                             +' ('
  74.  
  75.      * Load All Fields Into The SQL Variable
  76.      c                   DoU       SQLCOD=100
  77.  
  78.      * Read The SQL Cursor
  79.      c/exec sql
  80.      c+ Fetch FileCursor Into :FieldName,:ColType,
  81.      c+        :Length,:Decimals:n2,:ColNo
  82.      c/end-exec
  83.  
  84.      * End Of The SQL Cursor Data
  85.      c                   If        SQLCOD=100
  86.      c                   ExSR      Terminate
  87.      c                   EndIf
  88.  
  89.      * SQL Error Occured Get Next Record
  90.      c                   If        SQLCOD<0
  91.      c                   Iter
  92.      c                   EndIf
  93.  
  94.      * If Column Type In SYSCOLUMNS is NOT TIMESTMP...
  95.      c                   If        ColType<>'TIMESTMP'
  96.      c                   Eval      CreateString=%Trim(CreateString)+
  97.      c                             %Trim(FieldName)+' '
  98.      c                             +%Trim(ColType)+' ('
  99.      c                             +%Trim(%editc(Length:'Z'))+' '
  100.      c                   Else
  101.      ‚* If Column Type In SYSCOLUMNS is TIMESTMP...
  102.      *         Add The TIMESTAMP Column Type...
  103.      c                   Eval      CreateString=%Trim(CreateString)+
  104.      c                             %Trim(FieldName)+' TIMESTAMP'
  105.      c                             +'  NOT NULL WITH DEFAULT,'
  106.      c                   Iter
  107.      c                   EndIf
  108.  
  109.      * If Column Type In SYSCOLUMNS is Numeric
  110.      c                   If        ColType<>'CHAR'
  111.      c                   If        Decimals<>0
  112.      c                   Eval      CreateString=%Trim(CreateString)
  113.      c                             +', '+%Trim(%Editc(Decimals:'Z'))
  114.      c                   Else
  115.      c                   Eval      CreateString=%Trim(CreateString)
  116.      c                             +',0 '
  117.      c                   EndIf
  118.      c                   EndIf
  119.  
  120.      * Terminate This Field's Creation String
  121.      c                   Eval      CreateString=%Trim(CreateString)
  122.      c                             +') NOT NULL WITH DEFAULT,'
  123.      c                   EndDo
  124.  
  125.      * Terminate
  126.      C     Terminate     BegSR
  127.  
  128.      * If End Of SQL Cursor, Terminate the Create Table String
  129.      C                   If        SQLCOD=100
  130.      c                   Eval      CreateString=%Trim(CreateString)
  131.      c                             +' MNLIB CHAR (10) NOT NULL WITH '
  132.      C                             +'DEFAULT)'
  133.  
  134.      * Prepare The Create Table as SQL
  135.      c/exec sql
  136.      c+ Prepare BuildFile From :CreateString
  137.      c/end-exec
  138.  
  139.      * Execute The Create Table
  140.      c/exec sql
  141.      c+ Execute BuildFile
  142.      c/end-exec
  143.      c                   EndIf
  144.  
  145.      * Exit
  146.      c                   Eval      *InLR=*On
  147.      c                   Return
  148.      c                   EndSR
  149.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css