Dynamic subfile fields in AS/400

620 pts.
Tags:
AS 400
AS/400 Subfiles
Hi,
I would like to design a file query tool, Subfile fields should be displayed based on file structure I select. I don't want do define a single long field and assign data into that. I may use the same screen for editing the field data as well.
Thanks,
Elango G

Answer Wiki

Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.

Discuss This Question: 10  Replies

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when members answer or reply to this question.
  • ToddN2000
    Why not just use a standard subfile? I'm a little confused as to what you hope to accomplish
    102,670 pointsBadges:
    report
  • WoodEngineer
    Check out ProData's DBU tool. It may do what you need. Very handy tool at a reasonable price.
    7,930 pointsBadges:
    report
  • as400dev
    Thanks!
    620 pointsBadges:
    report
  • anandx
    1. Option indicators not allowed on fields in subfile record so, following DDS with 2 diff fields occupying same row and col will fail to create the dspf file
        R SFLX               SFL
     70   field1  10A B 11 05
    N70   field2  10A B 11 05

    2.
    However, following DDS 2 (diff fields occupying same 
    row and col without option indicators) will have an error severity of 10 on compilation but will create successfully dspf file
        R SFLX               SFL
          field1  10A   B 11 05
          field2  05P0 B 11 05
    HLL can selectively use either filed1 or field2 based on requirement.
    Use two diff subroutines or sub procedures, one for handling field1 (structure 1)  and another for field2 (structure 2).
    Same screen, two diff structures and input capable fields
    Alternatively, if number of structures are very small, use multiple subfiles
    715 pointsBadges:
    report
  • bernard85
    I have defined a subfile with variable length fields conditioned by indicaors


    Work with grid - Columns                                                              
                    field      header                                                                
    Seq. formula    width fit  width -- header -------------------- -- Text  ------------------------
      10 WHFILE       10         10  File                           File                             
      20 WHLIB        10         10  Library                        Library                          
      30 WHCRTD        7          7  Create                         File creation date: century/date 
      40 WHCNT         6          6  Rcds.F                         Number of record formats         
      50 WHDTTM       13         13  Retrieve at                    Retrieval date: century/date/time
      60 WHNAME       10    1    11  format                         Record format                    
      70 WHSEQ        13         13  level                          Format level identifier           
          
    575 pointsBadges:
    report
  • bernard85
    here is the code for the dspf :     

             A DSPSIZ(27 132 *DS4)
             A CHGINPDFT(UL)
         A          R HDR1
         A                                      CHANGE(90)
         A                                      CF03
         A                                      OVERLAY
         A            ZTL          129A  O  1  2DSPATR(HI)
         A                                  3 18'field'
         A                                      DSPATR(HI)
         A                                  3 29'header'
         A                                      DSPATR(HI)
         A                                  4  2'Seq.'
         A                                      DSPATR(HI)
         A                                  4  7'formula'
         A                                      DSPATR(HI)
         A                                  4 18'width'
         A                                      DSPATR(HI)
         A                                  4 24'fit'
         A                                      DSPATR(HI)
         A                                  4 29'width'
         A                                      DSPATR(HI)
         A                                  4 35'-- header --------------------'
         A                                      DSPATR(HI)
         A                                  4 66'-- Text  --------------------------
         A                                      ----------------'
         A                                      DSPATR(HI)
         A          R SFL1                      SFL
         A            XSEQ           4Y 0B  5  2EDTCDE(Z)
         A            XFORMULA      10   O  5  7
         A            XEDTWIDTH      4Y 0O  5 18EDTCDE(Z)
         A            XHDRFIT        2Y 0B  5 25EDTCDE(Z)
         A            XHDRWIDTH      4Y 0O  5 29EDTCDE(Z)
         A  01        XH01          01   B  5 35CHECK(LC)
         A  02        XH02          02   B  5 35CHECK(LC)
         A  03        XH03          03   B  5 35CHECK(LC)
         A  04        XH04          04   B  5 35CHECK(LC)
         A  05        XH05          05   B  5 35CHECK(LC)
    	  ...
         A  30        XH30          30   B  5 35CHECK(LC)
         A            XTEXT         50   O  5 66
         A          R CTL1                      SFLCTL(SFL1)
         A                                      SFLSIZ(0021)
         A                                      SFLPAG(0021)
         A                                      CSRLOC(CSRTOROW   CSRTOCOL)
         A                                      CF01 CF02 CF03 CF04 CF05 CF06 CF07
         A                                      CF08 CF09 CF10 CF11 CF12 CF13 CF14
         A                                      CF15 CF16 CF17 CF18 CF19 CF20 CF21
         A                                      CF22 CF23 CF24 ROLLDOWN ROLLUP
         A                                      OVERLAY
         A                                      SFLCSRRRN(&SFLCSRRRN)
         A  88                                  SFLDSP
         A N89                                  SFLDSPCTL
         A  89                                  SFLCLR
         A            SFLCSRRRN      5S 0H
         A            CSRTOROW       3S 0H
         A            CSRTOCOL       3S 0H
         A            SFLRRN         4S 0H
         A            MYSFLEND      11A  O 26122DSPATR(HI)
         A            ZFK          119   O 26  2COLOR(BLU)
         A          R EMPTY1
         A                                      OVERLAY
         A                                  8  5'(No item has been found)'
    
         A          R MSGSFL                    SFL SFLMSGRCD(27)
         A            MSGSFLKEY                 SFLMSGKEY
         A            PGMID                     SFLPGMQ(10)
         A          R MSGCTL                    SFLCTL(MSGSFL)
         A                                      SFLDSP SFLDSPCTL SFLINZ
         A N98                                  SFLEND
         A                                      SFLPAG(1) SFLSIZ(2)
         A            PGMID                     SFLPGMQ(10)
    
    575 pointsBadges:
    report
  • bernard85
    here is the program in rpg to generate a dedicated XML:

         H DFTACTGRP(*NO) bnddir('U6') actgrp('AG6')
         Fgridupd   CF   E             WORKSTN SFILE(SFL1:SFlRRN) InfDS(wsDS)
    
          /copy cpy,u6Ibm_h
          /copy cpy,u6env_h
          /copy cpy,u6grid_h
          /copy cpy,u6msg_h
          /copy cpy,u6screen_h
          /copy cpy,u6tree_h
          /copy cpy,u6xml_h
    
          //˜Global fields
         d dspXh           ds
         d                                 *   inz(%addr(xh01))
         d                                 *   inz(%addr(xh02))
         d                                 *   inz(%addr(xh03))
         d                                 *   inz(%addr(xh04))
         d                                 *   inz(%addr(xh05))
         d .... 
         d                                 *   inz(%addr(xh30))
         d  pXH                            *   dim(30) overlay(dspXh:1)
          //˜Global fields
         D G               DS                  qualified
         d  gridID                       10A   varying
         d  screen                        3u 0 inz(1)
         d  lGrid                          *
         d  lColumn                        *   dim(21)
         d  lColumn1                       *
         d  lColumn1_b4                    *
         d  lColumn9                       *
         d  lColumn9_b4                    *
         d  fToSort                        n
         d  error                          n
         d  refresh                        n
         d  lActions                       *
          //‚--------------------------------------------------------------------
          //‚main
          //‚--------------------------------------------------------------------
         d GridUP          pi
         d  GridID                       10
          /free
           g.gridID=%trim(gridID);
           //‚welcome message
           msg_SndPM(pgmID:env_getWelcomeMessage());
           //‚Title
           ZTL='Work with grid - Columns';
           //‚Load function keys
           screen_SetAction(g.lActions:x'33':'0':%pAddr(F3):'F3=Exit');
           screen_SetAction(g.lActions:x'36':'1':%pAddr(f6):'F6=Save');
           screen_SetAction(g.lActions:x'3a':'1':%pAddr(f10):'F10=Move to top');
           screen_SetAction(g.lActions:x'b8':'1':%pAddr(f20):'F20=Renumber');
           screen_SetAction(g.lActions:x'f1':'1':%pAddr(Enter));
           screen_SetAction(g.lActions:x'f4':*ON :%pAddr(rollUP  ));
           screen_SetAction(g.lActions:x'f5':*ON :%pAddr(rolldown));
           zFK=screen_getfkentitle(g.lActions);
           //‚load grid                                                            -
           g.lGrid=tree_xml2tree(env_getFileName(cGrid:g.gridID)
                              :%paddr(grid_xmlinput));
           //‚work screens                                                        -
           wrkScreen();
           //‚end of program                                                       -
           *inlr=*on;
          /end-free
          //‚--------------------------------------------------------------------
          //‚work screen
          //‚--------------------------------------------------------------------
         pwrkScreen        b
          /free
           //‚Activate screen 1 + Column1                                        -
           g.screen=1;
           g.lColumn1=tree_getFirst(g.lGrid);
           dow g.screen>0;
             if G.screen=1;
               Screen1();
             endif;
           endDo;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Screen 1 - display form
          //‚--------------------------------------------------------------------
         p Screen1         b
         d fkProcess       pr                  extproc(pAction)
          *
         d pAction         s               *   procptr
         d fcontrol        s               n
          /free
           if g.lColumn9<>g.lColumn9_b4;
             sync();
           endIf;
           if g.lColumn1<>g.lColumn1_b4 or g.refresh;
             loadWA1();
             loadSf1();
             //‚more item or bottom of list
             if tree_getNext(g.lColumn9)=*null;
               mySflEnd='Bottom';
             else;
               mySflEnd='More...';
             endIf;
           endIf;
           //‚display activation                                                 -
           write msgCtl;
           write hdr1;
           *in88=*on;
           *in89=*off;
           exfmt ctl1;
           msg_rmvPM(pgmID);
           //‚get/launch function key                                            -
           pAction=screen_getActionfromKey(g.lActions:wsds.kp:fcontrol);
           g.Error=*off;
           if pAction=*null;
             msg_SndPM(pgmID:'Function key invalid');
           else;
             if fControl;
               control();
             endIf;
             if not g.Error;
               fkProcess();
             endIf;
           endIf;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚check input
          //‚--------------------------------------------------------------------
         pControl          b
         d Control         pi
         d column          ds                  likeds(tColumn) based(pColumn)
         d w30a            s             30a
          *
          /free
           readc sfl1;
           dow not %eof();
             g.refresh=*on;
             pColumn=tree_getItem(g.lColumn(sflrrn));
             if column.seq<>xseq;
               g.fToSort=*on;
               column.seq=xseq;
             endIf;
             memcpy(%addr(w30a)
                   :pXH(xhdrWidth)
                   :xhdrWidth);
             column.hdr1=w30a;
             if column.edtwidth>30;
               column.hdrfit  =0;
               column.hdrwidth=30;
             else;
               column.hdrfit=xHdrFit;
               column.hdrwidth=column.edtwidth+column.hdrfit;
             endif;
             if column.edtWidth>column.hdrWidth;
               column.maxWidth=column.edtWidth;
             else;
               column.maxWidth=column.hdrWidth;
             endIf;
             readc sfl1;
           enddo;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Loadind work area
          //‚--------------------------------------------------------------------
         p loadWA1         b
          *
         d lX              s               *
         d i               s              3u 0
          /free
           clear g.lColumn;
           g.refresh=*off;
           lX=g.lColumn1;
           for i=1 to 21;
             g.lColumn(i)=lX;
             g.lColumn9=lX;
             lX=tree_getNext(lX);
           endFor;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Loadind subfile
          //‚--------------------------------------------------------------------
         p loadSF1         b
          *
         d column          ds                  likeDs(tColumn) based(pColumn)
         d w30a            s             30a
          /free
           //‚clear subfile
           *in88=*off;
           *in89=*on;
           WRITE ctl1;
           //‚Reload subfile
           for sflrrn=1 to 21;
             if g.lColumn(sflrrn)=*null;
               leave;
             endIf;
             pColumn=tree_getItem(g.lColumn(sflrrn));
    
             xseq     =column.seq;
             xtext    =column.text;
             xformula =column.formula;
             xedtwidth=column.edtwidth;
             xhdrfit  =column.hdrfit;
             xhdrWidth=column.hdrWidth;
             w30a=column.hdr1;
             memcpy(pXH(xhdrWidth)
                   :%addr(w30a)
                   :xhdrWidth);
             %SubArr(*IN:1:30)=*Off;
             *in(xhdrWidth)=*on;
             write sfl1;
           endFor;
           g.lColumn1_b4=g.lColumn1;
           g.lColumn9_b4=g.lColumn9;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Roll-UP
          //‚--------------------------------------------------------------------
         pRollUp           b
         d RollUp          pi
          /free
           if G.lColumn1=tree_GetFirst(G.lGrid);
             msg_SndPM(pgmID:'You have reached the top of the list');
           else;
             g.lColumn9=tree_getPrev(g.lColumn1);
           endIf;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Roll-down
          //‚--------------------------------------------------------------------
         pRollDown         b
         d RollDown        pi
          /free
           if mySflEnd='Bottom';
             msg_SndPM(pgmID:'You have reached the bottom of the list');
           else;
             g.lColumn1=tree_getNext(g.lColumn9);
           endIf;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚Enter
          //‚--------------------------------------------------------------------
         pEnter            b
         d Enter           pi
          /free
           if g.fToSort;
             g.fToSort=*off;
             //‚Sort elements                                                      -
             tree_Sort(g.lGrid:%paddr(column_comparator));
             g.lColumn1=tree_getFirst(g.lGrid);
             return;
           endIf;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚F3=Exit
          //‚--------------------------------------------------------------------
         pf3               b
         d f3              pi
          /free
           G.screen=0;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚F6=Save
          //‚--------------------------------------------------------------------
         pf6               b
         d f6              pi
          /free
           f20();
           xml_tree2xml(env_getFileName(cGrid:g.gridID)
                       :g.lGrid
                       :%paddr(grid_XmlOutput));
           g.screen=0;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚F10=Move to top
          //‚--------------------------------------------------------------------
         pf10              b
         d f10             pi
          /free
           if SFLCSRRRN=0;
             msg_SndPM(pgmID:'Wrong cursor position');
           else;
             g.lColumn1=g.lColumn(sflcsrrrn);
           endIf;
          /end-free
         p                 e
          //‚--------------------------------------------------------------------
          //‚F20=Renumber
          //‚--------------------------------------------------------------------
         pf20              b
         d f20             pi
          *
         d Seq             s             10u 0 inz(0)
         d lColumn         s               *
         d column          ds                  likeDs(tColumn) based(pColumn)
          /free
           //‚Resequence elements                                                -
           lColumn=tree_getFirst(g.lGrid);
           dow lColumn<>*null;
             pColumn=tree_getItem(lColumn);
             if Column.seq=0;
               leave;
             else;
               Seq+=10;
               Column.seq=seq;
             endIf;
             lColumn=tree_getNext(lColumn);
           endDo;
           g.lColumn1_b4=*null;
          /end-free
         p                 e
          //‚------------------------------------------------------------------- ---
          //‚Synch
          //‚------------------------------------------------------------------- ---
         pSync             b
         d Sync            pi
          *
         d i               s              3u 0
         d lX              s               *
          /free
           for i=1 to 21;
             lX=tree_getPrev(G.lColumn1);
             if lX=*null;
               leave;
             endIf;
             G.lColumn1=lX;
           endFor;
          /end-free
         p                 e
          //‚-----------------------------------------------------------------------
          //‚Comparator
          //‚-----------------------------------------------------------------------
         pcolumn_comparator...
         p                 b                   export
         d column_comparator...
         D                 PI             3i 0
         D  lColumn1                       *   const
         D  lColumn2                       *   const
          *
         D Column1         ds                  likeDs(tColumn) based(pColumn1)
         D Column2         ds                  likeDs(tColumn) based(pColumn2)
          *
          /free
            pColumn1=tree_GetItem(lColumn1);
            pColumn2=tree_GetItem(lColumn2);
            //‚-1 1st is lower than 2nd Column                                   --
            //‚+1 1st is greater than 2nd Column                                 --
            //‚0  they are equal                                                  --
            if     Column1.Seq>0 and Column2.Seq=0;
              return -1;
            elseif Column1.Seq=0 and Column2.Seq>0;
              return +1;
            elseif Column1.Seq<Column2.Seq;
              return -1;
            elseif Column1.Seq>Column2.Seq;
              return +1;
            elseif Column1.ID<Column2.ID;
              return -1;
            elseif Column1.ID>Column2.ID;
              return +1;
            endif;
            return 0;
          /end-free
         P                 E
    
    575 pointsBadges:
    report
  • anandx
    Badges:

    That's great... dynamic subfile, something new for me that I learned today.
    Thanks for sharing the concept and the code
    715 pointsBadges:
    report
  • ToddN2000
    Interesting code and concept. Never had a use for one in 35+ years of coding, can you explain the benefits of this over using SQL or a web interface?
    102,670 pointsBadges:
    report
  • anandx
    I notice something wrt opt ind in DSPF. . Ex: First, SFL records accept option indicators. Second, compiler accepts even if the data type and data lenghth are different for those fields which occupy the same row & col and indicators. Ex: following sys accepts following two diff DDS
    (1)
    01        XH01          01   B  5 35CHECK(LC) 
    02        XH02          02   B  5 35CHECK(LC) 
    03        XH03          03   B  5 35CHECK(LC) 
    (2)
    01        XH01           5S 0B  5 35          
    02        XH02           6A  B  5 35CHECK(LC) 
    03        XH03           7S 0B  5 35          

    Usage:
    I reckon this can be used in following scenario:
    Let's say I have 2 diff database files. I want to write one single RPGLE pgm catering to both the dbf(s). 
    Solution: Have a single display file, single sfl record, redefine fields within the sfl, one set of fields for first dbf and another set for the 2nd dbf, with option indicators in DDS. Write a single HLL pgm, check with user which data he/she wants, control building sfl thru a logic to load appropriate dbf record. The benefit is in maintenance of pgm. Only one pgm to be modified and two are more sfl data (even headers) can be handled for multiple dbf(s). Pgm will be clumsy, but would work.
    I think, this can be more appropriated called "overlay subfile", not dynamic subfile as it does not grow, it just redefines record structure
    Good idea from Badges

    715 pointsBadges:
    report

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to:

To follow this tag...

There was an error processing your information. Please try again later.

Thanks! We'll email you when relevant content is added and updated.

Following

Share this item with your network: