Re: SUB FILE 100%Free

[Scott Klement <rpg400-l@xxxxxxxxxxxxxxxx>]

Hello,

If it helps, I took Booth Martin's SMPLSFL01R program (from his web 
site, see link in the quoted messages below) and converted it to use 
free format H, F and D-specs.  It was very easy since there weren't many 
in that program.

Here's the converted copy.  Compare it to his web site to see the diff, 
you'll see it's pretty minor.


      //***************************************************************
      //   ___             _    _     __ __             _    _        *
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _   *
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |  *
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|  *
      //                                                              *
      //  A program to demonstrate a simple subfile program.          *
      //   Name: SMPLSFL10R                                           *
      //                                                              *
      //  08/2011                                 booth@xxxxxxxxxxxx  *
      //***************************************************************
      // COMMENTS   This program uses MOUBTN() or the Enter key       *
      //            to select an item from the subfile.               *
      //                                                              *
      //--------------------------------------------------------------*

       ctl-opt COPYRIGHT('Booth Martin, All rights reserved.')
              option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f SMPLSFL01D workstn sfile(SFL1: SF1NUM);
       dcl-f CITIES disk keyed;

       dcl-s CityKey like(CITY) inz('boston');


//====================================================================*
      // MAINLINE-BEGIN 
     *

//====================================================================*

       exsr S1Fill;
       // Display screen.
       exsr S1Main;
       // Exit.
       exsr ExitPgm;

//====================================================================*
       // MAINLINE-END 
      *

//====================================================================*
       //-------------------------------*  Sub-Routine  *
       // *inzsr()                      *---------------*
       // Initializing sub routine                      *
       //-----------------------------------------------*
       begsr *inzsr;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // ExitPgm()                     *---------------*
       // end of processing                             *
       //-----------------------------------------------*
       begsr ExitPgm;
         *inlr = *on;
         return;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // S1Main()                      *---------------*
       // Screen - Main processing.                     *
       //-----------------------------------------------*
       begsr S1Main;
         // Loop until exit.
         dow *inkc = *off;
           //   Display screen.
           write S1CMD;
           exfmt S1;
           select;
             // F3=Exit.
           when *inkc = *on;
             exsr ExitPgm;
           when SF1PICKED > 0;
             exsr SFL1TASK;
           endsl;
         enddo;
       endsr;
       //-------------------------------*  Sub-Routine  *
       // SFL1TASK()                    *---------------*
       // Do whatever task is required                  *
       //-----------------------------------------------*
       begsr SFL1TASK;
         SF1TOP = SF1PICKED;  //  for demo purposes
          //  .........  (ToDo)
       endsr;
       //-------------------------------*  Sub-Routine  *
       // S1Fill()                      *---------------*
       // Screen - Fill screen.                         *
       //-----------------------------------------------*
       begsr S1Fill;
         // Clear subfile.
         *in50 = *on;
         clear SFL1;
         write S1;
         *in50 = *off;
         // Fill the subfile.
         //   Read the file.
         setll citykey CITIES;
         read(e) RCITIES;
         dow %eof = *off and SF1NUM < 2500;  // limit the subfile size.
          SF1Field = %trim(accentcity) + ', '
           + %subst(Region: 1: 2) + ' ' + country;
           SF1NUM = SF1NUM + 1;
           write(e) SFL1;
           read(e) RCITIES;
         enddo;
         // Save values.
         SF1RECS = SF1NUM;
         SF1TOP = 1;
       endsr;




On 7/9/2015 1:10 PM, Scott Klement wrote:
> I think when he said "100% Free" he meant using free-format H, F and
> D-specs as well as the calcs...
>
> On 7/9/2015 11:58 AM, Booth Martin wrote:
> > See if this does what you want to do.
> >
> > http://martinvt.com/Subfiles/Simple_Subfile/simple_subfile.html