H CopyRight('2008 Relational Data Corporation')

      //-----------------------------------------------------------------
      // procedure prototypes
      //-----------------------------------------------------------------

      /copy *libl/qrpglesrc,rdwtnapi#1
      /copy *libl/qrpglesrc,rddbrapi#1
      /copy *libl/qrpglesrc,rdstrapi#1

      //-----------------------------------------------------------------
      // module level variables
      //-----------------------------------------------------------------

     d dbrrec        e ds                  extname(dbrrec) qualified import
     d dbrfld        e ds                  extname(dbrfld) qualified import
     d dbrchk        e ds                  extname(dbrchk) qualified import
     d dbrpar        e ds                  extname(dbrpar) qualified import
     d rw            e ds                  extname(rwpgmc) qualified
     d s1              s               *

      //-----------------------------------------------------------------
      // program entry
      //-----------------------------------------------------------------

     C     *entry        plist
     C                   parm                    rw

      //-----------------------------------------------------------------
      // handle action
      //-----------------------------------------------------------------

      /free

       select;
       when rw.action = 'INIT';
        s1 = wtnOpen('FFD');
       other;
        exsr out_record;
       endsl;

       return;

       //-----------------------------------------------------------------
       // output record info
       //-----------------------------------------------------------------

       begsr out_record;

        if not dbrRecGet(strToUpper(wtnQryGet('fname')));
         wtnRecSet('FD07');
         wtnFldSet('NAME':strToUpper(wtnQryGet('fname')));
         wtnRecWrt('FD07');
         leavesr;
        endif;

        wtnRecSet('FD01');
        wtnFldSet('NAME':%trimr(dbrrec.name));
        wtnFldSet('FORMAT':%trimr(dbrrec.format));
        wtnFldSet('TEXT':%trimr(dbrrec.text));
        wtnFldSet('FCOUNT':%char(dbrrec.fcount));
        wtnFldSet('LENGTH':%char(dbrrec.length));
        wtnRecWrt('FD01');

        dow dbrFldGet(dbr.next);
         exsr out_field;
        enddo;

        wtnRecWrt('FD08');

       endsr;

       //-----------------------------------------------------------------
       // output field info
       //-----------------------------------------------------------------

       begsr out_field;

        wtnRecSet('FD02');
        wtnFldSet('NAME':%trimr(dbrfld.name));
        wtnFldSet('OBUF':%char(dbrfld.obuf));
        wtnFldSet('LENGTH':%char(dbrfld.length));
        wtnFldSet('DECIMAL':%char(dbrfld.decimal));
        wtnFldSet('TEXT':%trimr(dbrfld.text));
        wtnFldSet('COLH1':%trimr(dbrfld.colh1));
        wtnFldSet('COLH2':%trimr(dbrfld.colh2));
        wtnFldSet('COLH3':%trimr(dbrfld.colh3));
        wtnFldSet('TYPE':%trimr(dbrfld.type));
        wtnFldSet('FIOB':%trimr(dbrfld.fiob));
        wtnFldSet('EDITC':%trimr(dbrfld.editc));
        wtnFldSet('CHECKS':%char(dbrfld.checks));
        wtnFldSet('DEFAULT':%trimr(dbrfld.default));
        wtnRecWrt('FD02');

        dow dbrChkGet(dbr.next);
         exsr out_check;
        enddo;

       endsr;

       //-----------------------------------------------------------------
       // output validity check info
       //-----------------------------------------------------------------

       begsr out_check;

        wtnRecSet('FD03');
        wtnFldSet('KEYWORD':%trimr(dbrchk.keyword));
        wtnFldSet('PARMCNT':%char(dbrchk.parmcnt));
        wtnRecWrt('FD03');

        if dbrchk.parmcnt > 0;
         wtnRecWrt('FD04');
         dow dbrParmGet(dbr.next);
          exsr out_parms;
         enddo;
         wtnRecWrt('FD06');
        endif;

       endsr;

       //-----------------------------------------------------------------
       // output validity check parameter
       //-----------------------------------------------------------------

       begsr out_parms;

        wtnRecSet('FD05');
        wtnFldSet('VALUE':%trimr(dbrpar.value));
        wtnRecWrt('FD05');

       endsr;

      /end-free