midrange.com code scratchpad
Name:
AFRU100D1
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
09/15/2015 01:06:52 am
IP:
Logged
Description:
Provide DB I/O Procedures for FRUITS table
Code:
  1.       //-----------------------------------------------------------------
  2.       // DB I/O module for "FRUITS" table
  3.       //-----------------------------------------------------------------
  4.  
  5.      h copyright('2015 Relational Data Corporation') nomain
  6.  
  7.       //-----------------------------------------------------------------
  8.       // file specifications
  9.       //-----------------------------------------------------------------
  10.  
  11.      fafru100p  uf a e           k disk
  12.  
  13.       //-----------------------------------------------------------------
  14.       // copy members
  15.       //-----------------------------------------------------------------
  16.  
  17.       /copy *libl/qmodelsrc,wlmaind1#1
  18.       /copy *libl/qrpglesrc,rdmsgapi#1
  19.       /copy *libl/qdbssrc,rdtrginf#1
  20.  
  21.      d trgptr          s               *   import
  22.  
  23.       //-----------------------------------------------------------------
  24.       // module level data structures
  25.       //-----------------------------------------------------------------
  26.  
  27.      d dettKey         ds                  export
  28.      d  det_key1                     10s 0
  29.  
  30.      d msgDs           ds                  export
  31.      d  msg_type                      1a
  32.      d  msg_text                    128a   varying
  33.  
  34.      d dettrec       e ds                  extname(afru100p)
  35.      d                                     export prefix(m_)
  36.  
  37.      d dettrec1      e ds                  extname(afru100p)
  38.  
  39.       //-----------------------------------------------------------------
  40.       // module level variables
  41.       //-----------------------------------------------------------------
  42.  
  43.      d focusfld        s             10a   varying export
  44.      d msg_module      s             10a   inz('WLMAINT')
  45.  
  46.       //-----------------------------------------------------------------
  47.       // initialization
  48.       //-----------------------------------------------------------------
  49.  
  50.      p d1Init          b                   export
  51.  
  52.       /free
  53.  
  54.        msgFileOpen('WLMAINT');
  55.  
  56.        clear dettKey;
  57.        clear dettRec;
  58.        clear dettRec1;
  59.  
  60.       /end-free
  61.  
  62.      p d1Init          e
  63.  
  64.       //-----------------------------------------------------------------
  65.       // clean up
  66.       //-----------------------------------------------------------------
  67.  
  68.      p d1Term          b                   export
  69.  
  70.       /free
  71.  
  72.        msgFileClose();
  73.  
  74.       /end-free
  75.  
  76.      p d1Term          e
  77.  
  78.       //-----------------------------------------------------------------
  79.       // get detail record
  80.       //-----------------------------------------------------------------
  81.  
  82.      p d1GetDettRec    b                   export
  83.      d d1GetDettRec    pi              n
  84.  
  85.       /free
  86.  
  87.        clear dettrec;
  88.        clear dettrec1;
  89.  
  90.        chain(n) det_key1 afru100r;
  91.  
  92.        if not %found();
  93.          msg_type = type_error;
  94.          msg_text = msgGetText(msg_module:1);
  95.          return *off;
  96.        endif;
  97.  
  98.        dettrec = dettrec1;
  99.  
  100.        return *on;
  101.  
  102.       /end-free
  103.  
  104.      p d1GetDettRec    e
  105.  
  106.       //-----------------------------------------------------------------
  107.       // change detail record
  108.       //-----------------------------------------------------------------
  109.  
  110.      p d1ChgDettRec    b                   export
  111.      d d1ChgDettRec    pi              n
  112.  
  113.       /free
  114.  
  115.        chain m_keyseqn afru100r;
  116.  
  117.        if not %found();
  118.          focusfld = 'NAME';
  119.          msg_type = type_error;
  120.          msg_text = msgGetText(msg_module:2);
  121.          return *off;
  122.        endif;
  123.  
  124.        dettrec1 = dettrec;
  125.  
  126.        update(e) afru100r;
  127.  
  128.        if %error();
  129.         d1ChkMsg();
  130.         return *off;
  131.        endif;
  132.  
  133.        msg_type = type_info;
  134.        msg_text = msgGetText(msg_module:3);
  135.  
  136.        return *on;
  137.  
  138.       /end-free
  139.  
  140.      p d1ChgDettRec    e
  141.  
  142.       //-----------------------------------------------------------------
  143.       // add detail record
  144.       //-----------------------------------------------------------------
  145.  
  146.      p d1AddDettRec    b                   export
  147.      d d1AddDettRec    pi              n
  148.  
  149.       /free
  150.  
  151.        dettrec1 = dettrec;
  152.  
  153.        write(e) afru100r;
  154.  
  155.        if %error();
  156.         d1ChkMsg();
  157.         return *off;
  158.        endif;
  159.  
  160.        msg_type = type_info;
  161.        msg_text = msgGetText(msg_module:5);
  162.  
  163.        return *on;
  164.  
  165.       /end-free
  166.  
  167.      p d1AddDettRec    e
  168.  
  169.       //-----------------------------------------------------------------
  170.       // delete detail record
  171.       //-----------------------------------------------------------------
  172.  
  173.      p d1DelDettRec    b                   export
  174.      d d1DelDettRec    pi              n
  175.  
  176.       /free
  177.  
  178.        delete(e) m_keyseqn afru100r;
  179.  
  180.        if %error();
  181.          msg_type = type_error;
  182.          msg_text = msgGetText(msg_module:6);
  183.          return *off;
  184.        else;
  185.          msg_type = type_info;
  186.          msg_text = msgGetText(msg_module:7);
  187.          return *on;
  188.        endif;
  189.  
  190.       /end-free
  191.  
  192.      p d1DelDettRec    e
  193.  
  194.       //-----------------------------------------------------------------
  195.       // check for DB event messages
  196.       //-----------------------------------------------------------------
  197.  
  198.      p d1ChkMsg        b                   export
  199.  
  200.       /free
  201.  
  202.        if trg.escape;
  203.         msg_type = trg.msg(1).type;
  204.         msg_text = trg.msg(1).text;
  205.         focusfld = trg.msg(1).column;
  206.        endif;
  207.  
  208.       /end-free
  209.  
  210.      p d1ChkMsg        e
  211.  
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css