home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / LAYOUT.ZIP / LAYOUT.CMD next >
OS/2 REXX Batch file  |  1991-05-17  |  12KB  |  295 lines
  1. /* ------------------------------------------------------------------------------- */
  2. /*                                REXX Record Layout Prodecure                     */
  3. /*                                                                                 */
  4. /* This REXX procedure will create a COBOL Record Layout from an OS/2 EE Database. */
  5. /* The Record Layout will be printed and will also create an ASCII file on your    */
  6. /* hard drive which can be uploaded or used in MicroFocus COBOL.  Enjoy            */
  7. /*                                                                                 */
  8. /* Written by Jonathan Schafer with help from IBM manuals                          */     
  9. /*                                                                                 */
  10. /* ------------------------------------------------------------------------------- */
  11.  
  12. ARG struct                                 /* input structure name */
  13.  
  14. IF LENGTH(struct) = 0 THEN                 /* Check to see if structure name was entered */ 
  15.     signal ERROR1
  16. ELSE
  17.     NOP
  18.  
  19. IF RxFuncQuery('SQLDBS') <> 0 THEN         /* Add Database Services DLL's to REXX */
  20.     rcy = RxFuncAdd('SQLDBS', 'SQLAR', 'SQLDBS')
  21. ELSE
  22.     NOP
  23.  
  24. IF RxFuncQuery('SQLEXEC') <> 0 THEN        /* Add Query Manager DLL's to REXX */ 
  25.     rcy = RxFuncAdd('SQLEXEC', 'SQLAR', 'SQLEXEC')
  26. ELSE
  27.     NOP
  28.  
  29. nmrdd_rc = 0                               /* Set return Code */
  30.  
  31. CALL SQLDBS 'START DATABASE MANAGER'       /* Start Database Manager */
  32. IF SQLCA.SQLCODE <> -1026 & SQLCA.SQLCODE <> 0 THEN   
  33.     signal ERROR
  34. ELSE
  35.     NOP
  36.  
  37. CALL SQLDBS 'START USING DATABASE nmrdd'   /* Start using database - DB = nmrdd */
  38. IF SQLCA.SQLCODE <> 0 THEN
  39.     DO
  40.         IF SQLCA.SQLCODE = -1013 THEN
  41.             say 'Database not found...Please contact your Systems Administrator'
  42.         ELSE 
  43.             DO
  44.             IF SQLCA.SQLCODE = -1015 THEN
  45.                    DO
  46.                    say SQLMSG
  47.                    say 'Restarting the database'
  48.                    CALL SQLDBS 'RESTART DATABASE nmrdd'
  49.                    IF SQLCA.SQLCODE <> 0 THEN
  50.                        signal ERROR
  51.                    ELSE
  52.                            DO
  53.                            say 'Starting the Database...Please wait'
  54.                            CALL SQLDBS 'START USING DATABASE nmrdd'
  55.                        END
  56.                    END
  57.             END
  58.     END
  59. ELSE
  60.     NOP
  61.  
  62. nmrdd_rc = structqry(struct)               /* Call to Structure subroutine */        
  63.  
  64. ERROR:                                     /* Database Error subroutine */
  65.     nmrdd_rc = SQLCA.SQLCODE
  66.     say SQLMSG
  67.     signal FINISH
  68.  
  69. ERROR1:                                    /* REXX Error subroutine */
  70.         nmrdd_rc = -1
  71.         say 'You must enter a Structure name'
  72.         signal FINISH
  73.  
  74. ERROR2:                                    /* REXX DISK Error subroutine */
  75.         nmrdd_rc = -2
  76.         say 'Error writing to disk'
  77.         signal FINISH
  78.  
  79.  
  80. FINISH:                                    /* Ending subroutine */ 
  81.          IF nmrdd_rc = -1 THEN
  82.              NOP
  83.          ELSE
  84.              CALL SQLDBS 'STOP USING DATABASE'
  85.          say 'Record Layout finished with rc = 'nmrdd_rc
  86.          rcy = RxFuncdrop('SQLEXEC')   /* Release Database DLL's */
  87.          rcy = RxFuncdrop('SQLDBS')    /* Release Query Manager DLL's */
  88.          exit nmrdd_rc
  89.  
  90. structqry: procedure                       /* Structure subroutine */
  91.  
  92.     ARG struct                             /* Input structure name */ 
  93.     fn = struct||'.ASC'                    /* File name for structure */
  94.  
  95.     '@ERASE 'fn '1>NUL 2>NUL'              /* Erases structure file if file currently exists */
  96.     
  97.     CALL SQLEXEC 'DECLARE c1 CURSOR for s1' /* Cursor declaration */
  98.     IF SQLCA.SQLCODE <> 0 THEN
  99.         signal ERROR
  100.     ELSE 
  101.         NOP
  102.  
  103. /* This is the dynamic SQL statement which retrieves data from the database */
  104.  
  105.     sel_layout = 'SELECT DISTINCT element_level, prefix, element_name,', 
  106.                                  'element_picture, element_value, element_position, a.structure_name',
  107.                  'FROM srs.structure a, srs.element_structure b',
  108.                  'WHERE (a.structure_name = b.structure_name )',
  109.                  'ORDER BY element_position'
  110.  
  111.     CALL SQLEXEC 'PREPARE s1 FROM :sel_layout'     /* This statement creates the actual SQL used by QM */
  112.     IF SQLCA.SQLCODE <> 0 THEN
  113.         signal ERROR
  114.     ELSE
  115.         NOP
  116.  
  117.     CALL SQLEXEC 'OPEN c1'                         /* Opens the cursor */
  118.     IF SQLCA.SQLCODE <> 0 THEN 
  119.         signal ERROR
  120.     ELSE
  121.         NOP
  122.  
  123.     DO WHILE SQLCA.SQLCODE = 0                     /* Performs loop until no more data */
  124.  
  125.         CALL SQLEXEC 'FETCH c1',                   /* Retrieves first data row from cursor */
  126.                      'INTO :level:level1,',
  127.                           ':prefix:prefix1,',
  128.                           ':name:name1,',
  129.                           ':picture:picture1,',
  130.                           ':value:value1,',
  131.                           ':position:position1,',
  132.                           ':structure:structure1'
  133.  
  134.         CALL null_check                            /* Dynamic SQL requires INDICATOR Variables as well as   */
  135.                                                    /* HOST Variables if the Tables allow NULL values.  This */
  136.                                                    /* procedure checks for NULL values and sets the field   */   
  137.                                                    /* blanks if NULLS are found.                            */ 
  138.         
  139.             IF SQLCA.SQLCODE = 0 THEN
  140.             DO
  141.                 IF structure = struct THEN         /* structure must match INPUT Structure name or record   */
  142.                     DO                             /* is ignored.                                           */ 
  143.                         ilevel = indent_level(level, previous_level);   /* calls Indent Level subroutine    */
  144.                         apic = align_pic(level, previous_level, picture); /* calls Align PIC clause subrtne */
  145.                         cvalue = check_value(value);                    /* calls the VALUE check subroutine */ 
  146.              
  147.                         line = ilevel'  'prefix || name' 'apic' 'cvalue; /* These three lines   */
  148.                         line = strip(line, 'T');                         /* put the period at   */
  149.                         line = line || '.';                              /* the end of the line */
  150.      
  151.                         checkpos = lastpos('VALUE', cvalue);             /* Checks for a VALUE clause */ 
  152.                         IF checkpos <> 0 THEN                            /* If a value clause is found, the */
  153.                             DO                                           /* line is split into two.  The    */
  154.                                 valpos = lastpos('VALUE', line);         /* second line will contain the    */
  155.                                 first_line = substr(line, 1, valpos - 1); /* word 'VALUE' and the value     */
  156.                                                                          /* clause.                         */ 
  157.                                 CALL print fn, first_line;     /* Performs the print subroutine */
  158.                                                                                    
  159.                                 num_spaces = pos(level,line);            /* Formats the Value line  */
  160.                                 spaces = substr(line, 1, num_spaces -1);
  161.                                 second_line = spaces || '    ' || substr(line, valpos);
  162.                                 CALL print fn, second_line;    /* Performs the print subroutine */
  163.                             END
  164.                         ELSE 
  165.                             CALL print fn, line;               /* Performs the print subroutine */
  166.  
  167.                         IF level <> '88' THEN                  /* Sets the previous level variable used */
  168.                             previous_level = level             /* in the Align Picture and Indent Level */ 
  169.                         ELSE                                   /* subroutines.                          */
  170.                             NOP
  171.                     END
  172.             END
  173.     END
  174.     IF SQLCA.SQLCODE <> 100 THEN
  175.         signal ERROR
  176.     ELSE
  177.         NOP
  178.  
  179.     CALL SQLEXEC 'CLOSE s1'           /* Closes the cursor */
  180.     '@TYPE ' fn '1> LPT2'             /* Prints the Record layout to the printer */
  181.     nmrdd_rc = 0                      /* Sets the return code */ 
  182.     return nmrdd_rc                   /* Returns to the main function */
  183.  
  184. indent_level: procedure               /* Indent Level subroutine */
  185.  
  186.  
  187. /* This subroutine compares the Level (ex. 05, 10, 88, etc) and compares it to the previous level. */
  188. /* It then determines the appropriate amount of indenting and returns the value to the calling routine. */
  189.  
  190.  
  191.     ARG level, previous_level         /* Input arguments passed from calling routine */
  192.      
  193.     spaces = '    '     
  194.      
  195.     IF level = '88' THEN
  196.         times = (previous_level / 5) + 1
  197.     ELSE
  198.         times = level / 5
  199.  
  200.      DO index = 1 to times
  201.          level = spaces || level 
  202.      END
  203.  
  204.      ilevel = level
  205.      return ilevel 
  206.  
  207.  
  208. align_pic: procedure                 /* Align Picture subroutine */
  209.  
  210.  
  211. /* This subroutine realigns the PIC clauses after the Indent Level procedure makes them non-aligned. */
  212.  
  213.      
  214.     ARG level, previous_level, picture      /* Input arguments passed from the calling routine */
  215.     
  216.     IF level = '88' THEN
  217.         level = previous_level
  218.     ELSE
  219.         NOP
  220.     
  221.     IF level = 05 THEN
  222.         picture = '               '  || picture
  223.     ELSE
  224.         IF level = 10 THEN
  225.             picture = '            ' || picture
  226.         ELSE
  227.             IF level = 15 THEN
  228.                picture = '        '  || picture
  229.             ELSE 
  230.                picture = '    '      || picture
  231.  
  232.     apic = picture
  233.     return apic 
  234.  
  235. check_value: procedure       /* Check Value subroutine */
  236.  
  237.  
  238. /* This subroutine checks to see if a value exists in the VALUE field.  If a value exists, the word 'VALUE */
  239. /* is Concatenated to the beginning of the value.                                                          */
  240.  
  241.     ARG value                /* Input argument passed from calling routine */ 
  242.  
  243.     IF length(strip(value,'B',' ')) <> 0 THEN
  244.         cvalue = 'VALUE '|| value
  245.     ELSE
  246.         cvalue = value
  247.  
  248.     return cvalue
  249.         
  250.  
  251. null_check:                 /* Null check subroutine */
  252.  
  253. /* This subroutine checks the value of the indicator variable.  If a value retrieved from the database is   */
  254. /* NULL (does not exist), the indicator variable will be -1.  This routine then initializes the variable if */ 
  255. /* the indicator variable is set.                                                                           */
  256.  
  257.     IF level1 = -1 THEN
  258.         level = ' '          
  259.     ELSE
  260.         NOP
  261.    
  262.     IF name1 = -1 THEN
  263.         name = ' '          
  264.     ELSE
  265.         NOP
  266.    
  267.     IF picture1 = -1 THEN
  268.         picture = ' '          
  269.     ELSE
  270.         NOP
  271.    
  272.     IF value1 = -1 THEN
  273.         value = ' '          
  274.     ELSE
  275.         NOP
  276.    
  277.     return
  278.  
  279. print: procedure     /* Print subroutine */
  280.  
  281.     ARG fn, line     /* Input arguments from the calling routine */
  282.  
  283.     x = lineout(fn, line)    
  284.  
  285.     IF x = 0 THEN
  286.         NOP
  287.     ELSE
  288.         signal ERROR2    
  289.     
  290.     return
  291.  
  292.  
  293.  
  294.  
  295.