sponsored links

Collapse

Announcement

Collapse
No announcement yet.

First post (hopefully not the last)

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • First post (hopefully not the last)

    Iíve started a tutorial/sample reservoir on data areaís and their uses....

    I have included some .pdf's from http://www.itjungle.com/
    If you find any of the information useful please contact
    someone from itjungle and let them know how much you
    appreciate their efforts.


    I would appreciate any help in continuing this effort.


    DDS for file used in example
    PHP Code:
          file                                                                                        
         A          R 
    ##FILER                                                                           
         
    A            F1TEXT1       10          TEXT('Text-1')                                          
         
    A            F1TEXT2       10          TEXT('Text-2')                                          
         
    A            F1TEXT3       10          TEXT('Text-3')                                          
         
    A            F1NUM1         5  0       TEXT('Number-1')                                        
         
    A            F1DATE          L         DATFMT(*USA)                                            
         
    A          K F1DATE 
    Source for the program
    PHP Code:
         F##FILE    uf a e           k disk                                                             
          //-------------------------- ##FILE -------------------------                                 
          // A          R ##FILER                                                                       
          // A            F1TEXT1       10          TEXT('Text-1')                                      
          // A            F1TEXT2       10          TEXT('Text-2')                                      
          // A            F1TEXT3       10          TEXT('Text-3')                                      
          // A            F1NUM1         5  0       TEXT('Number-1')                                    
          // A            F1DATE          L         DATFMT(*USA)                                        
          // A          K F1DATE                                                                        
          //-----------------------------------------------------------                                 
          
    *                                                                                             
          * 
    Variable Definition                                                                         
          
    *                                                                                             
         
    d CmdLength       s             15  5 inz(0)                                                   
         
    d CmdString       s            256    inz(*blanks)                                             
         
    d foundrecord     s               n                                                            
         d indataarea      s             20                                                             
         d  inDtaAra       s             10                                                             
         d  inLibrary      s             10                                                             
         d reply           s              1                                                             
                                                                                                        
         d MyTwenty1DS     ds            21    dtaara
    ('MYTWENTY1')                                      
         
    d Program21                     21                                                             
                                                                                                        
         d DtaAraRcv       ds                                                                           
         d  AraBytes                     10i 0                                                          
         d  AraBytesOut                  10i 0                                                          
         d  AraDtaType                   10a                                                            
         d  AraLibrary                   10a                                                            
         d  AraLength                    10i 0                                                          
         d  AraDecimals                  10i 0                                                          
         d  AraValue                   2000a                                                            
                                                                                                        
         d APIError        ds                  Qualified                                                
         d  BytesP                       10i 0 inz
    (%size(apiError))                                     
         
    d  BytesA                       10i 0 inz(0)                                                   
         
    d  Messageid                     7                                                             
         d  Reserved                      1                                                             
         d  messagedta                  240                                                             
                                                                                                        
           
    //                                                                                           
           //  external calls                                                                           
           //                                                                                           
                                                                                                        
         
    d $command        pr                  extpgm('QCMDEXC')                                        
         
    d   command                   5000    options(*varsize)                                        
         
    d   Length                      15  5                                                          
                                                                                                        
         d $GetData        pr                  extpgm
    ('QWCRDTAA')                                       
         
    d   thedata                           like(DtaAraRcv)                                          
         
    d   thedatasize                 10i 0 const                                                    
         
    d   libDtaara                   20    const                                                    
         
    d   start                       10i 0 const                                                    
         
    d   length                      10i 0 const                                                    
         
    d   Error                             Like(ApiError)                                           
                                                                                                        
           
    // automatically qualified by datastructure name                                             
         
    d beforeDS        ds                  LIKEREC(##FILER : *INPUT)                                
         
    d afterDS         ds                  LIKEREC(##FILER : *OUTPUT)                               
         
    d KeyDS           ds                  LIKEREC(##FILER : *KEY)                                  
                                                                                                        
          
    /free                                                                                         
                                                                                                        
            
    //--------------------------------------------------------                                  
            // MAIN PROGRAM                                                                             
            //--------------------------------------------------------                                  
                                                                                                        
                  // this allows me to read from a file                                                 
                  // keep a copy of the before record in datastructure BeforeDS                         
                  // keep a copy of the after record in datastructure AfterDS                           
                  // and update the table using the datastructure.                                      
                  // only field changed was Text2...                                                    
                                                                                                        
                  
    read ##FILE beforeDS;                                                                 
                  //move the fields                                                                     
                  
    afterDS beforeDS;                                                                   
                                                                                                        
                  
    // increment the number field by 1                                                    
                  
    AfterDS.F1Num1 += 1;                                                                  
                  
    // update the first record                                                            
                  
    update ##FILER afterDS;                                                               
                                                                                                        
                   // text2 update with dec field                                                       
                  
    AfterDS.F1text2 'Counter:' + %char(AfterDS.F1Num1);                                 
                  
    // write  a new record using datastructure                                            
                  
    write ##FILER afterDS;                                                                
                                                                                                        
                  
    reset foundrecord;                                                                    
                  
    keyds.F1date = %date();                                                               
                  
    setll %kds(KEYDS##FILER;                                                            
                  
    if %equal;                                                                            
                   
    foundrecord = *on;                                                                   
                  endif;                                                                                
                                                                                                        
                
    // more dataarea code                                                                   
                                                                                                        
                 
    cmdstring 'CRTDTAARA DTAARA(QTEMP/MYTWENTY1) TYPE(*CHAR)' +                          
                             
    ' LEN(21)';                                                                
                 
    cmdlength = %len(%trim(cmdstring));                                                    
                 
    monitor;                                                                               
                 
    $command (cmdstring:cmdlength);                                                        
                 
    on-error;                                                                              
                 
    endmon;                                                                                
                                                                                                        
               
    // populate it  ....                                                                     
                                                                                                        
                 
    *in99 = *on;                                                                           
                 
    dow *in99 = *on;                                                                       
                 
    in(e) *lock MyTwenty1DS;                                                               
                  *
    in99 = %error;                                                                       
                 
    enddo;                                                                                 
                                                                                                        
                 
    Program21 'Holy Crap Batman!';                                                       
                 
    out MyTwenty1DS;                                                                       
                 
    Unlock MyTwenty1DS;                                                                    
                                                                                                        
                 
    in  MyTwenty1DS;         // no lock                                                    
                 
    dsply program21 reply;                                                                 
                                                                                                        
               
    // now clear it  ....                                                                    
                                                                                                        
                 
    *in99 = *on;                                                                           
                 
    dow *in99 = *on;                                                                       
                 
    in(e) *lock MyTwenty1DS ;                                                              
                  *
    in99 = %error;                                                                       
                 
    enddo;                                                                                 
                 
    clear Program21;                                                                       
                 
    out  MyTwenty1DS;                                                                      
                                                                                                        
                 
    in  MyTwenty1DS;                                                                       
                                                                                                        
                 
    dsply program21 reply ;                                                                
                                                                                                        
               
    // re-populate it  ....                                                                  
                                                                                                        
                 
    *in99 = *on;                                                                           
                 
    dow *in99 = *on;                                                                       
                 
    in(e) *lock MyTwenty1DS;                                                               
                  *
    in99 = %error;                                                                       
                 
    enddo;                                                                                 
                                                                                                        
                 
    Program21 'Lets try this again!';                                                    
                 
    out MyTwenty1DS;                                                                       
                 
    in MyTwenty1DS;                                                                        
                 
    dsply program21 reply;                                                                 
                                                                                                        
                 
    // use API QWCRDTAA to retrieve data from dataarea                                     
                 
    exsr $QWCRDTAA;                                                                        
                                                                                                        
                                                                                                        
                  *
    inlr = *on;                                                                          
                                                                                                        
            
    //--------------------------------------------------------                                  
            // $QWCRDTAA - read dataarea with API                                                       
            //--------------------------------------------------------                                  
                                                                                                        
                 
    begsr $QWCRDTAA;                                                                       
                                                                                                        
                  
    // these could be parameters nice if you need to access multiple                      
                  // dataareas in multiple libraries.                                                   
                  
    inDtaAra  'MYTWENTY1';                                                              
                  
    inLibrary 'QTEMP';                                                                  
                                                                                                        
                  if 
    InDtaAra '*GDA' or                                                               
                     
    InDtaAra '*LDA' or                                                               
                     
    InDtaAra '*PDA';                                                                 
                   %
    subst(InDataArea:1:10)  = InDtaARa;                                                 
                   %
    subst(indataarea:11:10) = *blanks;                                                  
                  else;                                                                                 
                   
    indataarea =  inDtaAra inlibrary;                                                  
                  endif;                                                                                
                                                                                                        
                  
    $getData(DtaAraRcv       :                                                            
                           %
    Size(DtaAraRcv):                                                            
                           
    InDataArea      :                                                            
                           -
    1              :                                                            
                           
    512             :                                                            
                           
    ApiError        );                                                           
                                                                                                        
                  
    dsply %subst(AraValue:1:25reply;                                                    
                                                                                                        
                                                                                                        
                 
    endsr;                                                                                 
            
    //--------------------------------------------------------                                  
                                                                                                        
          
    /end-free 
    Attached Files
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com

  • #2
    Re: First post (hopefully not the last)

    Code:
        
     h/include QCpySrc,HSpecStd
    
         fLPAY99C   if   e           k disk    Prefix(x_)
         FLPAYE99C  uf   e           k disk
    
         D                 DS
         D TermDate                       8  0
         D  x_PTRMDC                      2  0 Overlay(TermDate)
         D  x_PTRMDT                      6  0 Overlay(TermDate:3)
    
         dnumofdays        s              6  0
         dTdate            s               d
         dPdate            s               d
    
         C     *DTAARA       DEFINE    pytotday      tday              2 0
    
          //Read LPAY99C compare todays date (Tdate) to termination date if > tday save Pin
          //to unused field and blank out Pin field.
          /free
           in *dtaara;
           Tdate = %Date();
           Read LPAY99C;
           DOW NOT %EOF(LPAY99C);
           if x_PTRMDT <> *zeros;
             Pdate = %Date(TermDate);
             numofdays = %diff(Tdate:Pdate:*DAYS);
             if numofdays > tday;
               Chain (x_empno1) LPAYE99C;
               if %found(LPAYE99C);
                 PHRSCD = PPIN#;
                 Clear PPIN#;
                 PATMAC = 'N';
                 update paymster %fields (PHRSCD:PPIN#:PATMAC);
               ENDIF;
             ENDIF;
           ENDIF;
             Read LPAY99c;
           ENDDO;
           *inlr = *on;
          /end-free
    I know this post is a couple of years old but hey the more examples the merrier . The data area just holds a number (tday. which just holds a value that relates to a number of days). Used a data area so if the accounting people decided to change the number of days for this process just need to change the data area.

    Comment


    • #3
      Re: First post (hopefully not the last)

      Originally posted by jamief
      If you find any of the information useful please contact someone from itjungle and let them know how much you appreciate their efforts.
      Thanks, Jamie. It's always nice to be appreciated. I passed your post along to the people who run the site.

      Comment


      • #4
        Re: First post (hopefully not the last)

        I sometimes wish that we as a community would do this more often.

        Happy Monday *ALL!
        All my answers were extracted from the "Big Dummy's Guide to the As400"
        and I take no responsibility for any of them.

        www.code400.com

        Comment

        sponsored links

        Collapse

        Working...
        X