Construct RPG statements from a file

35 pts.
Tags:
AS/400
RPG
Does anyone have any example programs where an RPG statement can be constructed from a file? Example: Below is a file with a result field and conditions. I would like to have the RPG program read the file and execute the statement:
IF FIELD1=1 or FIELD4=2 or FIELD6 = 'ABC' then 'XXX'.

=====FILE=============
Result Field . . . . : XXX

A/O     Fld Name    Oper  Value
FIELD1      EQ    00001.00
O      FIELD4      EQ    00002.00
O      FIELD6      EQ    ABC
===============================
1

Answer Wiki

Thanks. We'll let you know when a new response is added.

You MIGHT and I mean might be able to parse out the fields you need and build an embedded SQL statement to run it. That is going to be a LOT of work and if the file layout changes your progam may not function properly.  Can you explain how this issue came about? I have never had a request like in in all my years.

Discuss This Question: 6  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.
  • philpl1jb

    I agree with Todd, this could be done with embedded SQL prepared statement .. perhaps a set expression.

    54,090 pointsBadges:
    report
  • PGMBOB
    Or you can pass the values to an OPNQRYF selection.
    1,235 pointsBadges:
    report
  • BigKat
    I actually prototyped something like this where it would test on the fly based on a regulation and an overrirde file that had fields of reg/ovr ID, And/Or Code, Comparison File, Comparison Field, Comparison Type, and Comparison Value.   Here is the code.  Not all of the character type conversions are coded, but the are stubbed in the Procedures and would have used the C API's to make them.

      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:23:20    DUBLIN2      PAGE    1
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  DRR
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
        100      h dftactgrp(*no) actgrp(*caller) option(*srcstmt:*nodebugio)
        200      h bnddir('TEST')
        300
        400      fregpf     if   e             disk
        500      fovrpf     if   e             disk
        600      fitem_mast if   e           k disk    rename(item_mast:itemmast)
        700      f                                     prefix(a)
        800      fitem_00001if   e           k disk    rename(item_00001:item00001)
        900      f                                     prefix(b)
       1000      fvend_mast if   e           k disk    rename(vend_mast:vendmast)
       1100      f                                     prefix(c)
       1200
       1300      d file001       e ds                  extname(item_mast:*input)
       1400      d                                     inz qualified
       1500      d file002       e ds                  extname(item_00001:*input)
       1600      d                                     inz qualified
       1700      d file003       e ds                  extname(vend_mast:*input)
       1800      d                                     inz qualified
       1900
       2000      d dataAddrs       ds
       2100      d                                 *   inz(%addr(file001))
       2200      d                                 *   inz(%addr(file002))
       2300      d                                 *   inz(%addr(file003))
       2400      d  dataAddr                       *   dim(3) overlay(dataAddrs)
       2500
       2600      d fileNames       ds
       2700      d                               10a   inz('ITEM_MAST')
       2800      d                               10a   inz('ITEM_00001')
       2900      d                               10a   inz('VEND_MAST')
       3000      d  fileName                     10a   dim(3) overlay(fileNames)
       3100
       3200      d item            s              7p 0 inz(3385390)
       3300      d blocked         s               n
       3400      d isTrue          s               n
       3500      d curRegID        s                   like(regID)
       3600      d curOvrID        s                   like(ovrID)
       3700      d idx             s             10i 0
       3800
       3900       /copy qrpglesrc,cmp001pr
       4000       /free
       4100          // item load
       4200          chain(e) (item) item_mast file001;
       4300          chain(e) (item) item_00001 file002;
       4400          chain(e) (file001.vendor_num) vend_mast file003;
       4500          if %found(item_mast) and %found(item_00001) and %found(vend_mast);
       4600            blocked = *off;
       4700            // regulation processing
       4800            // - loop through file
       4900            dou %eof(regpf);
       5000              read(e) regpf;
       5100              if %eof(regpf);
       5200                  leave;
       5300              endif;
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:23:20    DUBLIN2      PAGE    2
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  DRR
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
       5400              if curRegID <> regID or regAndOr = 'O';
       5500                if isTrue;
       5600                  leave;
       5700                endif;
       5800                curRegID = regID;
       5900                isTrue = *on;
       6000              endif;
       6100              if not isTrue;
       6200                iter;
       6300              endif;
       6400              idx = %lookup(regCFil:fileName);
       6500              if idx > 0; // ignore unknown files ???
       6600                isTrue = testField(dataAddr(idx):regCFil:regCFld:regComp:
       6700                         regVal:*off);
       6800              endif;
       6900            enddo;
       7000            if isTrue;
       7100              blocked = *on;
       7200            endif;
       7300
       7400            if blocked;
       7500              // override processing -- only if blocked
       7600              // - loop through file
       7700              dou %eof(ovrpf);
       7800                read(e) ovrpf;
       7900                if %eof(ovrpf);
       8000                  leave;
       8100                endif;
       8200                if curOvrID <> ovrID or ovrAndOr = 'O';
       8300                  if isTrue;
       8400                    leave;
       8500                  endif;
       8600                  curOvrID = ovrID;
       8700                  isTrue = *on;
       8800                endif;
       8900                if not isTrue;
       9000                  iter;
       9100                endif;
       9200                idx = %lookup(ovrCFil:fileName);
       9300                if idx > 0; // ignore unknown files ???
       9400                  isTrue = testField(dataAddr(idx):ovrCFil:ovrCFld:ovrComp:
       9500                           ovrVal:*off);
       9600                endif;
       9700              enddo;
       9800              if isTrue;
       9900                blocked = *off;
      10000              endif;
      10100            endif;
      10200          endif;
      10300          *inlr = *on;
      10400          dump(a);
      10500       /end-free
                                      * * * *  E N D  O F  S O U R C E  * * * *
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:44:22    DUBLIN2      PAGE    1
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001PR
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
        100       /if defined(CMP001PR)
        200       /eof
        300       /endif
        400       /define CMP001PR
        500
        600      d testField       pr              n
        700      d  pDataAddr                      *   const options(*string)
        800      d  pFileName                    10a   const
        900      d  pFieldName                   10a   const
       1000      d  pTestType                     5a   const
       1100      d  pTestValue                    5a   const
       1200      d  pDefault                       n   const
                                      * * * *  E N D  O F  S O U R C E  * * * *
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    1
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
        100      h nomain
        200       /copy qrpglesrc,cmp001pr
        300
        400      d compareMemory   pr            10i 0 extproc('memcmp')
        500      d  string1                        *   value options(*string)
        600      d  string2                        *   value options(*string)
        700      d  compareLength                10u 0 value
        800
        900      d charToHex       pr                  extproc('cvtch')
       1000      d  hexOutput                 32767a   options(*varsize)
       1100      d  charInput                 32767a   const options(*varsize)
       1200      d  charInputSize...
       1300      d                               10u 0 value
       1400
       1500      d hexToChar       pr                  extproc('cvthc')
       1600      d  charOutput                32767a   options(*varsize)
       1700      d  hexInput                  32767a   const options(*varsize)
       1800      d  charOutputSize...
       1900      d                               10u 0 value
       2000
       2100      d charToBin       pr             4a
       2200      d  charInput                     9a   const
       2300
       2400      d binToChar       pr             9a
       2500      d  binInput                      4a   const
       2600
       2700      d charToFloat     pr             8a
       2800      d  charInput                    20a   const
       2900
       3000      d floatToChar     pr            20a
       3100      d  floatInput                    8a   const
       3200
       3300      d quslfld         pr                  extpgm('QUSLFLD')
       3400      d  qUsrSpc                      20a   const
       3500      d  format                        8a   const
       3600      d  qFile                        20a   const
       3700      d  rcdFmt                       10a   const
       3800      d  override                       n   const
       3900      d  qusec                              like(qusec_t)
       4000
       4100      d quscrtus        pr                  extpgm('QUSCRTUS')
       4200      d  qUsrSpc                      20a   const
       4300      d  extendedAtr                  10a   const
       4400      d  initialSize                  10i 0 const
       4500      d  initialValue                  1a   const
       4600      d  publicAuth                   10a   const
       4700      d  text                         50a   const
       4800      d  replace                      10a   const options(*nopass)
       4900      d  qusec                              like(qusec_t) options(*nopass)
       5000
       5100      d qusptrus        pr                  extpgm('QUSPTRUS')
       5200      d  qUsrSpc                      20a   const
       5300      d  usrSpc@                        *
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    2
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
       5400      d  qusec                              like(qusec_t) options(*nopass)
       5500
       5600      d getFFD          pr              n
       5700      d  pFile                        10a   const
       5800      d  pFFD                               like(ffd_t)
       5900
       6000      d qush0100        ds                  based(qush0100@) qualified
       6100      d  userArea                     64a
       6200      d  genHdrSize                   10i 0
       6300      d  structRlsLvl                  4a
       6400      d  formatName                    8a
       6500      d  apiUsed                      10a
       6600      d  datTimCrt                    13a
       6700      d  infStatus                     1a
       6800      d  usrSpcSize                   10i 0
       6900      d  inpParmOS                    10i 0
       7000      d  inpParmSize                  10i 0
       7100      d  headerOS                     10i 0
       7200      d  headerSize                   10i 0
       7300      d  listDataOS                   10i 0
       7400      d  listDataSize                 10i 0
       7500      d  listEntryNbr                 10i 0
       7600      d  listEntrySize                10i 0
       7700      d  listEntryCCSID...
       7800      d                               10i 0
       7900      d  countryID                     2a
       8000      d  languageID                    3a
       8100      d  subsetListInd                 1a
       8200      d  reserved1                    42a
       8300      d  APIEntryPoint               256a
       8400      d  reserved2                   128a
       8500
       8600      d fldl0100        ds                  based(fldl0100@) qualified
       8700      d  fldName                      10a
       8800      d  fldDataType                   1a
       8900      d  fldUse                        1a
       9000      d  fldOutBufPos                 10i 0
       9100      d  fldInpBufPos                 10i 0
       9200      d  fldSize                      10i 0
       9300      d  fldDigits                    10i 0
       9400      d  fldDecPos                    10i 0
       9500      d  fldText                      50a
       9600      d  fldEditCode                   2a
       9700      d  fldEdtWrdLen                 10i 0
       9800      d  fldEdtWrd                    64a
       9900      d  fldColHdg1                   20a
      10000      d  fldColHdg2                   20a
      10100      d  fldColHdg3                   20a
      10200      d  fldIntName                   10a
      10300      d  fldAltName                   30a
      10400      d  fldAltNameLen                10i 0
      10500      d  fldDBCSNbr                   10i 0
      10600      d  fldNullValAlw                 1a
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    3
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      10700      d  fldHostVarInd                 1a
      10800      d  fldDatTimeFmt                 4a
      10900      d  fldDatTimSep                  1a
      11000      d  fldVarLenInd                  1a
      11100      d  fldTextCCSID                 10i 0
      11200      d  fldDataCCSID                 10i 0
      11300      d  fldColHdgCCS                 10i 0
      11400      d  fldEdtWrdCCS                 10i 0
      11500      d  fldUCS2DspLen                10i 0
      11600
      11700      d ffd_t           ds                  template qualified
      11800      d  header
      11900      d   filnam                      10a   overlay(header)
      12000      d   fldnbr                      10i 0 overlay(header:*next)
      12100      d  fldarr                             dim(1000) like(ffdelm_t)
      12200      d   fldnam                      10a   overlay(fldarr)
      12300
      12400      d ffdelm_t        ds                  template qualified
      12500      d  fldnam                       10a
      12600      d  bufpos                       10i 0
      12700      d  buflen                       10i 0
      12800      d  digits                       10i 0
      12900      d  decpos                       10i 0
      13000      d  dtatyp                        1a
      13100      d  text                         50a
      13200
      13300      d qusec_t         ds                  template qualified inz
      13400      d  errBytesProv                 10i 0 inz(%size(qusec_t))
      13500      d  errBytesAvail                10i 0
      13600      d  errMsgID                      7a
      13700      d  reserved                      1a
      13800      d  errMsgDta                   512a
      13900
      14000      d ffd             ds                  likeds(ffd_t)
      14100
      14200      d ffdelm          ds                  likeds(ffdelm_t)
      14300
      14400      d data            s          65535a   based(data@)
      14500      d value           s                   like(data)
      14600      d testValue       s                   like(data)
      14700      d hex             s          32767a
      14800      d char            s          32767a
      14900
      15000       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      15100       * testField(): perform specified test for a given data set
      15200       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      15300      p testField       b                   export
      15400      d testField       pi              n
      15500      d  pDataAddr                      *   const options(*string)
      15600      d  pFileName                    10a   const
      15700      d  pFieldName                   10a   const
      15800      d  pTestType                     5a   const
      15900      d  pTestValue                    5a   const
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    4
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      16000      d  pDefault                       n   const
      16100
      16200      d idx             s             10i 0
      16300      d compare         s             10i 0
      16400
      16500       /free
      16600          // - find ffd information for compare file/field
      16700          if getFFD(pFileName:ffd);
      16800
      16900            // - extract data value from data structure
      17000            data@ = pDataAddr;
      17100            idx = %lookup(pFieldName:ffd.fldnam:1:ffd.fldnbr);
      17200            if idx > 0; // ignore unknown fields ???
      17300              ffdelm = ffd.fldarr(idx);
      17400              value = %trim(%subst(data:ffdelm.bufpos:ffdelm.buflen));
      17500
      17600              // - perform specified test
      17700              select;
      17800              when %trim(pTestType) = 'IN';
      17900                select;
      18000                when ffdelm.dtatyp = 'P';
      18100                  testValue = value;
      18200                   // -- convert from hex
      18300                   // -- trim leading 0's
      18400                   // -- add sign - remove 'F'(plus) or 'D'(minus)
      18500                   // -- add decimal point
      18600                when ffdelm.dtatyp = 'B';
      18700                  testValue = binToChar(value);
      18800                when ffdelm.dtatyp = 'F';
      18900                  testValue = floatToChar(value);
      19000                when ffdelm.dtatyp = 'L';
      19100                  testValue = %str(%addr(value):10);
      19200                when ffdelm.dtatyp = 'T';
      19300                  testValue = %str(%addr(value):8);
      19400                when ffdelm.dtatyp = 'Z';
      19500                  testValue = %str(%addr(value):26);
      19600                other;
      19700                  testValue = value;
      19800                endsl;
      19900                return (%scan(testValue:pTestValue) <> 0);
      20000              when %trim(pTestType) = 'NIN';
      20100                select;
      20200                when ffdelm.dtatyp = 'P';
      20300                  testValue = value;
      20400                   // -- convert from hex
      20500                   // -- trim leading 0's
      20600                   // -- add sign - remove 'F'(plus) or 'D'(minus)
      20700                   // -- add decimal point
      20800                when ffdelm.dtatyp = 'B';
      20900                  testValue = binToChar(value);
      21000                when ffdelm.dtatyp = 'F';
      21100                  testValue = floatToChar(value);
      21200                when ffdelm.dtatyp = 'L';
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    5
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      21300                  testValue = %str(%addr(value):10);
      21400                when ffdelm.dtatyp = 'T';
      21500                  testValue = %str(%addr(value):8);
      21600                when ffdelm.dtatyp = 'Z';
      21700                  testValue = %str(%addr(value):26);
      21800                other;
      21900                  testValue = value;
      22000                endsl;
      22100                return (%scan(testValue:pTestValue) = 0);
      22200              when %trim(pTestType) = 'LIKE';
      22300                select;
      22400                when ffdelm.dtatyp = 'P';
      22500                  testValue = value;
      22600                   // -- convert from hex
      22700                   // -- trim leading 0's
      22800                   // -- add sign - remove 'F'(plus) or 'D'(minus)
      22900                   // -- add decimal point
      23000                when ffdelm.dtatyp = 'B';
      23100                  testValue = binToChar(value);
      23200                when ffdelm.dtatyp = 'F';
      23300                  testValue = floatToChar(value);
      23400                when ffdelm.dtatyp = 'L';
      23500                  testValue = %str(%addr(value):10);
      23600                when ffdelm.dtatyp = 'T';
      23700                  testValue = %str(%addr(value):8);
      23800                when ffdelm.dtatyp = 'Z';
      23900                  testValue = %str(%addr(value):26);
      24000                other;
      24100                  testValue = value;
      24200                endsl;
      24300                return (%scan(pTestValue:testValue) <> 0);
      24400              when %trim(pTestType) = 'NLIKE';
      24500                select;
      24600                when ffdelm.dtatyp = 'P';
      24700                  testValue = value;
      24800                   // -- convert from hex
      24900                   // -- trim leading 0's
      25000                   // -- add sign - remove 'F'(plus) or 'D'(minus)
      25100                   // -- add decimal point
      25200                when ffdelm.dtatyp = 'B';
      25300                  testValue = binToChar(value);
      25400                when ffdelm.dtatyp = 'F';
      25500                  testValue = floatToChar(value);
      25600                when ffdelm.dtatyp = 'L';
      25700                  testValue = %str(%addr(value):10);
      25800                when ffdelm.dtatyp = 'T';
      25900                  testValue = %str(%addr(value):8);
      26000                when ffdelm.dtatyp = 'Z';
      26100                  testValue = %str(%addr(value):26);
      26200                other;
      26300                  testValue = value;
      26400                endsl;
      26500                return (%scan(pTestValue:testValue) = 0);
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    6
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      26600              other;
      26700                select;
      26800                when ffdelm.dtatyp = 'P';
      26900                  testValue = pTestValue;
      27000                   // -- remove decimal point
      27100                   // -- remove sign - replace with 'F'(plus) or 'D'(minus)
      27200                   // -- check length is ffdelm.digits - pad with leading 0's
      27300                   // -- check length is even - pad with leading 0
      27400                   // -- convert to hex
      27500                when ffdelm.dtatyp = 'B';
      27600                  testValue = charToBin(pTestValue);
      27700                when ffdelm.dtatyp = 'F';
      27800                  testValue = charToFloat(pTestValue);
      27900                when ffdelm.dtatyp = 'L';
      28000                  testValue = pTestValue;
      28100                when ffdelm.dtatyp = 'T';
      28200                  testValue = pTestValue;
      28300                when ffdelm.dtatyp = 'Z';
      28400                  testValue = pTestValue;
      28500                other;
      28600                  testValue = pTestValue;
      28700                endsl;
      28800                compare = compareMemory(value:testValue:ffdelm.buflen);
      28900                select;
      29000                when %trim(pTestType) = '=';
      29100                  return (compare = 0);
      29200                when %trim(pTestType) = '<>';
      29300                  return (compare <> 0);
      29400                when %trim(pTestType) = '>';
      29500                  return (compare > 0);
      29600                when %trim(pTestType) = '<';
      29700                  return (compare < 0);
      29800                when %trim(pTestType) = '>=';
      29900                  return (compare >= 0);
      30000                when %trim(pTestType) = '<=';
      30100                  return (compare <= 0);
      30200                endsl;
      30300              endsl;
      30400            endif;
      30500          endif;
      30600          return pDefault;
      30700       /end-free
      30800      p testField       e
      30900
      31000       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      31100       * getFFD(): Retrieve/create a file's ffd structure.
      31200       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      31300      p getFFD          b
      31400      d getFFD          pi              n
      31500      d   pFile                       10a   const
      31600      d   pFFD                                    like(ffd_t)
      31700
      31800      d qusec           ds                  likeds(qusec_t) inz(*LIKEDS)
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    7
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      31900
      32000      d qUsrSpc         ds
      32100      d   UsrSpc                      10a   inz('QUSLFLD')
      32200      d   UsrSpcLib                   10a   inz('QTEMP')
      32300
      32400      d qFile           ds
      32500      d   File                        10a
      32600      d   Lib                         10a   inz('*LIBL')
      32700      d RcdFmt          s             10a   inz('*FIRST')
      32800
      32900      d ffdhdr          ds                  qualified static inz
      33000      d   idx                         10i 0
      33100      d   lu                          10i 0
      33200      d   alcsize                     10i 0
      33300      d   fldidx                      10i 0
      33400      d   filarr                            dim(256)
      33500      d     filnam                    10a   overlay(filarr)
      33600      d     size                      10i 0 overlay(filarr:*next)
      33700      d                                2a   overlay(filarr:*next)
      33800      d     ffd@                        *   overlay(filarr:*next)
      33900
      34000      d ffd             ds                  likeds(ffd_t) based(ffd@)
      34100      d ffdelm          ds                  likeds(ffdelm_t)
      34200
      34300       /free
      34400         // Check if the file information has already been retrieved
      34500         ffdhdr.lu = %lookup(pFile:ffdhdr.filnam:1:ffdhdr.idx);
      34600
      34700         if ffdhdr.lu > 0;
      34800           ffd@ = ffdhdr.ffd@(ffdhdr.lu);
      34900         else;
      35000
      35100           // Create the user space if it doesn't already exist.
      35200
      35300           reset qusec;
      35400           quscrtus(qUsrSpc:*blanks:1000000:x'00':'*ALL':*blanks:'*NO':qusec);
      35500           if qusec.ErrMsgID <> *blanks and qusec.ErrMsgID <> 'CPF9870';
      35600             exsr *pssr;
      35700           endif;
      35800
      35900           // Load the fields into the user space
      36000
      36100           File = pFile;
      36200           reset qusec;
      36300           quslfld(qUsrSpc:'FLDL0100':qFile:RcdFmt:*off:qusec);
      36400           if qusec.ErrMsgID <> *blanks;
      36500             exsr *pssr;
      36600           endif;
      36700
      36800           // Retrieve the pointer to the user space.
      36900
      37000           reset qusec;
      37100           qusptrus(qUsrSpc:QUSH0100@:qusec);
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    8
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      37200           if qusec.ErrMsgID <> *blanks;
      37300             exsr *pssr;
      37400           endif;
      37500
      37600           // Allocate space for the file
      37700
      37800           ffdhdr.idx = ffdhdr.idx + 1;
      37900           ffdhdr.lu  = ffdhdr.idx;
      38000           ffdhdr.filnam(ffdhdr.lu) = pFile;
      38100           ffdhdr.alcsize = %size(ffd.header) +
      38200                            (%size(ffdelm) * QUSH0100.ListEntryNbr);
      38300           ffdhdr.ffd@(ffdhdr.lu) = %alloc(ffdhdr.alcsize);
      38400           ffdhdr.size(ffdhdr.lu) = ffdhdr.alcsize;
      38500           ffd@ = ffdhdr.ffd@(ffdhdr.lu);
      38600
      38700           // Load the ffd header information
      38800
      38900           ffd.filnam = pFile;
      39000           ffd.fldnbr = QUSH0100.ListEntryNbr;
      39100
      39200           // Load the field information into the fldarr array
      39300
      39400           FLDL0100@ = QUSH0100@ + QUSH0100.ListDataOS;
      39500           for ffdhdr.fldidx = 1 to ffd.fldnbr;
      39600             ffdelm.fldnam = FLDL0100.FldName;
      39700             ffdelm.bufpos = FLDL0100.FldOutBufPos;
      39800             ffdelm.buflen = FLDL0100.FldSize;
      39900             ffdelm.digits = FLDL0100.FldDigits;
      40000             ffdelm.decpos = FLDL0100.FldDecPos;
      40100             ffdelm.dtatyp = FLDL0100.FldDataType;
      40200             ffdelm.text   = FLDL0100.FldText;
      40300             ffd.fldarr(ffdhdr.fldidx) = ffdelm;
      40400             FLDL0100@ = FLDL0100@ + QUSH0100.ListEntrySize;
      40500           endfor;
      40600
      40700         endif;
      40800
      40900         pFFD = %subst(ffd:1:ffdhdr.size(ffdhdr.lu));
      41000         return *on;
      41100
      41200         begsr *pssr;
      41300           return *off;
      41400         endsr;
      41500
      41600       /end-free
      41700      p getFFD          e
      41800
      41900       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      42000       * charToBin(): Convert character string to binary string
      42100       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      42200      p charToBin       b
      42300      d charToBin       pi             4a
      42400      d  pCharStr                      9a   const
     
      5761WDS V6R1M0  080215                  SEU SOURCE LISTING                            06/20/11 08:43:35    DUBLIN2      PAGE    9
    
      SOURCE FILE . . . . . . .  DTKDEVKK01/QRPGLESRC
      MEMBER  . . . . . . . . .  CMP001R
    
      SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
      42500      c                   return    ' '
      42600      p charToBin       e
      42700
      42800       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      42900       * binToChar(): Convert binary string to character string
      43000       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      43100      p binToChar       b
      43200      d binToChar       pi             9a
      43300      d  pBinStr                       4a   const
      43400      c                   return    ' '
      43500      p binToChar       e
      43600
      43700       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      43800       * charToFloat(): Convert character string to float string
      43900       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      44000      p charToFloat     b
      44100      d charToFloat     pi             8a
      44200      d  pCharStr                     20a   const
      44300      c                   return    ' '
      44400      p charToFloat     e
      44500
      44600       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      44700       * floatToChar(): Convert float string to character string
      44800       * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      44900      p floatToChar     b
      45000      d floatToChar     pi            20a
      45100      d  pFloatStr                     8a   const
      45200      c                   return    ' '
      45300      p floatToChar     e
                                      * * * *  E N D  O F  S O U R C E  * * * *
    
    9,410 pointsBadges:
    report
  • BigKat
    REGPF source 
         A          R REGPFR
         A            REGID          3A
         A            REGANDOR       1A
         A            REGCFIL       10A
         A            REGCFLD       10A
         A            REGCOMP        5A
         A            REGVAL         5A
    9,410 pointsBadges:
    report
  • BigKat
    OVRPF source
         A          R OVRPFR
         A            OVRID          3A
         A            OVRANDOR       1A
         A            OVRCFIL       10A
         A            OVRCFLD       10A
         A            OVRCOMP        5A
         A            OVRVAL         5A
    
    9,410 pointsBadges:
    report
  • BigKat
    DRR was the Dynamic Regulation Resolution engine, and this prototype was coded to run for a hardcoded item number in the d-specs.
    9,410 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: