RPG: Unterschied zwischen den Versionen

Aus informatikvs
Wechseln zu: Navigation, Suche
(→‎sprintf (textconcatenation))
(→‎Datum - Monatsletzten ermitteln)
 
(2 dazwischenliegende Versionen desselben Benutzers werden nicht angezeigt)
Zeile 38: Zeile 38:
 
0069.00  EndSr;                                                                   
 
0069.00  EndSr;                                                                   
 
0070.00  //**************************************************************/   
 
0070.00  //**************************************************************/   
 +
</pre>
 +
== mehr Datum ==
 +
<pre>
 +
0033.00  /free                                                           
 +
0034.00  //**************************************************************/
 +
0035.00  BegSr §Datum;                                                   
 +
0036.00    #Date  =  %date('2016-07-01')  +  %months(1);                 
 +
0037.00    #Brain =  %diff(#Date:D'1899-12-30':*days);                   
 +
0038.00    #char2 = %char(%subdt(%date(): *months));                     
 +
0039.00    #char4 = %char(%subdt(%date(): *years));                     
 +
0040.00    #char8a= %char(%date() : *iso0);                             
 +
0041.00    #char8b= %char(%date() : *dmy.);                             
 +
0042.00    #char10= %char(%date() : *iso);                               
 +
0043.00    #dec6s0= %dec(%date() : *dmy);                               
 +
0044.00    #dec8s0= %dec(%date() : *iso);                               
 +
0045.00    #Brain = %diff(%date():D'1899-12-30':*days);                 
 +
0046.00    #Date  = D'1899-12-30' + %days(#Brain);                       
 +
0047.00    #Date  = %date(151224  : *ymd);                             
 +
0048.00    #Date  = %date(20151224 : *iso);                             
 +
0049.00    #Date  = %date('151224' : *ymd0);                             
 +
0050.00    #Date  = %date('20151224' : *iso0);                           
 +
0051.00    #Date  = %date('18.12.14' : *dmy.);
 +
0052.00    #Ultimo = %date();                                    // '2015-03-30'
 +
0053.00    #Ultimo = #Ultimo - %days(%subdt(#Ultimo : *days)-1);  // '2015-03-01'
 +
0054.00    #Ultimo = #Ultimo + %months(1);                        // '2015-04-01'
 +
0055.00    #Ultimo = #Ultimo - %days(1);                          // '2015-03-31'
 +
0056.00    #Brain  = %diff(#ultimo:D'1899-12-30':*days);          // 42094     
 +
0057.00  EndSr;                                                                 
 +
0058.00  //**************************************************************/                                 
 +
</pre>
  
−
0027.00  //**************************************************************/
 
−
0028.00  BegSr §Datum;                                                   
 
−
0029.00    #Brain = %diff(%date():D'1899-12-30':*days);                 
 
−
0030.00    #Date  = D'1899-12-30' + %days(#Brain);                       
 
−
0031.00    #Date  = %date(151224  : *ymd);                             
 
−
0032.00    #Date  = %date(20151224 : *iso);                             
 
−
0033.00    #Date  = %date('151224' : *ymd0);                             
 
−
0034.00    #Date  = %date('20151224' : *iso0);                           
 
−
0035.00    #Date  = %date('18.12.14' : *dmy.);   
 
−
0036.00    #num8s0= %dec(%date():*eur);          // ttmmjjjj
 
−
0037.00    #num8s0= %dec(%date():*iso);          // jjjjmmtt       
 
−
0046.00  EndSr;                                                         
 
−
0047.00  //**************************************************************/
 
−
</pre>
 
 
== Embedded SQL programming ==
 
== Embedded SQL programming ==
 
<pre>
 
<pre>
Zeile 355: Zeile 371:
 
         return;
 
         return;
 
       /end-free
 
       /end-free
 +
</pre>
 +
== merge ==
 +
<pre>
 +
    H DECEDIT('0,') DATEDIT(*DMY.)
 +
    H OPTION(*SRCSTMT:*NODEBUGIO)
 +
      //===========================================================//
 +
    fL4FPROLL  iF  E            disk    infds(rollinf)
 +
    f                                    rename(l4f0kid:l4f0roll)
 +
    fL4FL01S  uF a E          k disk    infds(samminf)
 +
    f                                    rename(l4f0kid:l4f0samm)
 +
 +
    fQPRINT    O    F  132        PRINTER OFLIND(*INOA)
 +
 +
      //===========================================================//
 +
    d PSDS          sds                  qualified                            Programmdatenstruk
 +
    d    PGMN          *PROC                                                  Programmname
 +
    d    JOBU                      10a  overlay(PSDS:254)                    JobUser
 +
    d rollinf        ds                  qualified
 +
    d    rrn              397    400i 0
 +
    d samminf        ds                  qualified
 +
    d    rrn              397    400i 0
 +
    d rollds        e ds                  extname(l4fproll:*input)
 +
    d                                    qualified
 +
    d sammds          ds                  likerec(l4f0samm)
 +
    d sammout        ds                  likerec(l4f0samm:*output)
 +
    d
 +
    d drLine          s            80a  inz(*all'=')
 +
    d #zzequal        s              5u 0 inz(0)
 +
    d #zznoteq        s                  like(#zzequal)
 +
    d #zzstat        s                  like(#zzequal)
 +
    d #msg            s            52a  varying
 +
      //===========================================================//
 +
    c                  ExSr      §Work
 +
    c    #msg          Dsply
 +
    c                  Eval      *inlr = *On
 +
    c                  Return
 +
      //===========================================================//
 +
      /free
 +
        BegSr §Work;
 +
          Except DrKopf;
 +
          setll 1 l4f0roll;
 +
          DoW 1=1;
 +
            Read l4f0roll rollds;
 +
            If %EOF();
 +
              Leave;
 +
            Else;
 +
              chain (rollds.L4KID : rollds.L4AT: rollds.L4NMND
 +
                    :rollds.l4nwhl : rollds.l4van) l4f0samm sammds;
 +
              If Not %Found();
 +
                        ExSr §L4Write;
 +
                        Write l4f0samm  sammout;
 +
              Else;
 +
                If    %subst (sammds : 1 : %len(rollds)) =
 +
                        %subst (rollds : 1 : %len(rollds));
 +
                        #zzequal += 1;
 +
                        unlock l4fl01s;
 +
                ElseIf sammds.L4STAT  <>  rollds.L4STAT
 +
                    Or sammds.L4NFLV  <>  rollds.L4NFLV
 +
                    Or sammds.L4FAK  <>  rollds.L4FAK
 +
                    Or sammds.L4RKZ  <>  rollds.L4RKZ
 +
                    Or sammds.L4M    <>  rollds.L4M
 +
                    Or sammds.L4ATT  <>  rollds.L4ATT
 +
                    Or sammds.L4AMM  <>  rollds.L4AMM
 +
                    Or sammds.L4AJA  <>  rollds.L4AJA
 +
                    Or sammds.L4LB    <>  rollds.L4LB
 +
                    Or sammds.L4TIME  <>  rollds.L4TIME;
 +
                        ExSr §L4Updat;
 +
                        #zzstat  += 1;
 +
                        #zznoteq += 1;
 +
                        update l4f0samm sammds;
 +
                Else;
 +
                        #zznoteq += 1;
 +
                        unlock l4fl01s;
 +
                Endif;
 +
              EndIf;
 +
            EndIf;
 +
          EndDo;
 +
 +
          Except DrSumme;
 +
 +
          If #zznoteq = 0;
 +
            #msg  = 'ROLL und SAMM sind identisch !';
 +
          Else;
 +
            #msg  = 'Von '
 +
                  + %char(#zzequal+#zznoteq)
 +
                  + ' ROLL sind '
 +
                  + %char(#zznoteq)
 +
                  + ' unterschiedlich zur SAMM !';
 +
          Endif;
 +
        EndSr;
 +
      //===========================================================//
 +
        BegSr §L4Write;
 +
                  Clear sammds;
 +
                  eval-corr sammds = rollds;
 +
                  sammds.L4Q3LB = psds.pgmn;
 +
                  sammds.L4Q3TT = *day;
 +
                  sammds.L4Q3MM = *month;
 +
                  sammds.L4Q3JA = *year;
 +
                  %subarr (*in : 71 : 5) = *ON;
 +
                  eval-corr sammout = sammds;
 +
                  Except DrZeile;
 +
        EndSr;
 +
      //===========================================================//
 +
        BegSr §L4updat;
 +
                  *IN71 = (sammds.L4STAT <> rollds.L4STAT);
 +
                  *IN72 = (sammds.L4nflv <> rollds.L4nflv);
 +
                  *IN73 = (sammds.L4fak  <> rollds.L4fak);
 +
                  *IN74 = (sammds.L4rkz  <> rollds.L4rkz);
 +
                  *IN75 = (sammds.L4m    <> rollds.L4m);
 +
                  Except DrZeile;
 +
                  sammds.L4STAV  = sammds.L4STAT;
 +
                  sammds.L4STAT  = rollds.L4STAT;
 +
                  sammds.L4NFLV  = rollds.L4NFLV;
 +
                  sammds.L4FAK    = rollds.L4FAK;
 +
                  sammds.L4RKZ    = rollds.L4RKZ;
 +
                  sammds.L4M      = rollds.L4M;
 +
                  sammds.L4ATT    = rollds.L4ATT;
 +
                  sammds.L4AMM    = rollds.L4AMM;
 +
                  sammds.L4AJA    = rollds.L4AJA;
 +
                  sammds.L4LB    = rollds.L4LB ;
 +
                  sammds.L4TIME  = rollds.L4TIME;
 +
                  sammds.L4Q3LB  = psds.pgmn;
 +
                  sammds.L4Q3TT  = *day;
 +
                  sammds.L4Q3MM  = *month;
 +
                  sammds.L4Q3JA  = *year;
 +
        EndSr;
 +
      /end-free
 +
      //===========================================================//
 +
    oQPRINT    E            Drkopf      1    01
 +
    o                      drLine              80
 +
    oQPRINT    E            DrKopf      1
 +
    o                                          +0 'PGM:'
 +
    o                      PSDS.PGMN          +1
 +
    o                                        +  4 'Korrektur Menge'
 +
    o                                        +  4 'PER:'
 +
    o                      *DATE        Y  +  1
 +
    oQPRINT    E            DrKopf      1
 +
    o                      drLine              80
 +
      //===========================================================//
 +
    oQPRINT    E            DrZeile    1
 +
    o                      rollds.L4KID        +1
 +
    o                                          +1 '//'
 +
    o              71      rollds.L4STAT      +1
 +
    o                                          +1 '->'
 +
    o              71      sammds.L4STAT      +1
 +
    o                                          +1 '//'
 +
    o              72      rollds.L4nflv      +1
 +
    o                                          +1 '->'
 +
    o              72      sammds.L4nflv      +1
 +
    o                                          +1 '//'
 +
    o              73      rollds.L4fak        +1
 +
    o                                          +1 '->'
 +
    o              73      sammds.L4fak        +1
 +
    o                                          +1 '//'
 +
    o              74      rollds.L4rkz        +1
 +
    o                                          +1 '->'
 +
    o              74      sammds.L4rkz        +1
 +
    o                                          +1 '//'
 +
    o              75      rollds.L4m          +1
 +
    o                                          +1 '->'
 +
    o              75      sammds.L4m          +1
 +
    o                      sammds.L4lb        +1
 +
      //===========================================================//
 +
    oQPRINT    E            DrSumme    1
 +
    o                      #zzequal            +1
 +
    o                                          +1 'DS sind identisch'
 +
    oQPRINT    E            DrSumme    1
 +
    o                      #zznoteq            +1
 +
    o                                          +1 'DS sind unterschiedlich'
 +
    oQPRINT    E            DrSumme    1
 +
    o                      #zzstat            +1
 +
    o                                          +1 'DS wurden angeglichen'
 
</pre>
 
</pre>

Aktuelle Version vom 4. Mai 2017, 14:04 Uhr

  1. Raten - Programmieren - Gewinnen
  2. Role - Play - Game
  3. Report - Program - Generator

Dekodieren Unicode- / Character-Feld

0000.00  **************************************************************/  
0027.00 h CCSID(*GRAPH : *SRC)     
0028.00 h CCSID(*UCS2 : 1200)      
0029.00 h CCSID(*CHAR : *JOBRUN)
0030.00 h alwnull(*usrctl)
0031.00 h option(*NoDebugIo:*SrcStmt)
...         
0131.00  **************************************************************/ 
0132.00 d $256UNIC        S            256C   CCSID(1200)    
0133.00 d $256CHAR        S            256A  
0134.00  **************************************************************/    
...            
0179.00 c                   Clear                   $256UNIC  
0180.00 c                   Eval      $256UNIC    = mytstuc   
0181.00 c                   Eval      $256CHAR    = $256UNIC  
0182.00 c                   Eval      myt2tch     = $256CHAR  
0183.00 c                   Clear                   $256UNIC  
0184.00 c                   Eval      $256CHAR    = mytstch   
0185.00 c                   Eval      $256UNIC    = $256CHAR  
0186.00 c                   Eval      myt2tuc     = $256UNIC   
...         
0999.00   //**************************************************************/

Datum - Monatsletzten ermitteln

0061.00   //**************************************************************/        
0062.00   BegSr §Ultimo;                                                           
0063.00     #Ultimo = %date();                                     // '2015-03-30' 
0064.00     #Ultimo = #Ultimo - %days(%subdt(#Ultimo : *days)-1);  // '2015-03-01' 
0065.00     #Ultimo = #Ultimo + %months(1);                        // '2015-04-01' 
0066.00     #Ultimo = #Ultimo - %days(1);                          // '2015-03-31' 
0067.00     #Brain  = %diff(#ultimo:D'1899-12-30':*days);          // 42094        
0069.00   EndSr;                                                                   
0070.00   //**************************************************************/

mehr Datum

0033.00  /free                                                             
0034.00   //**************************************************************/
0035.00   BegSr §Datum;                                                    
0036.00     #Date  =  %date('2016-07-01')  +  %months(1);                  
0037.00     #Brain =  %diff(#Date:D'1899-12-30':*days);                    
0038.00     #char2 = %char(%subdt(%date(): *months));                      
0039.00     #char4 = %char(%subdt(%date(): *years));                       
0040.00     #char8a= %char(%date() : *iso0);                               
0041.00     #char8b= %char(%date() : *dmy.);                               
0042.00     #char10= %char(%date() : *iso);                                
0043.00     #dec6s0= %dec(%date() : *dmy);                                 
0044.00     #dec8s0= %dec(%date() : *iso);                                 
0045.00     #Brain = %diff(%date():D'1899-12-30':*days);                   
0046.00     #Date  = D'1899-12-30' + %days(#Brain);                        
0047.00     #Date  = %date(151224   : *ymd);                               
0048.00     #Date  = %date(20151224 : *iso);                               
0049.00     #Date  = %date('151224' : *ymd0);                              
0050.00     #Date  = %date('20151224' : *iso0);                            
0051.00     #Date  = %date('18.12.14' : *dmy.); 
0052.00     #Ultimo = %date();                                     // '2015-03-30'
0053.00     #Ultimo = #Ultimo - %days(%subdt(#Ultimo : *days)-1);  // '2015-03-01'
0054.00     #Ultimo = #Ultimo + %months(1);                        // '2015-04-01'
0055.00     #Ultimo = #Ultimo - %days(1);                          // '2015-03-31'
0056.00     #Brain  = %diff(#ultimo:D'1899-12-30':*days);          // 42094       
0057.00   EndSr;                                                                  
0058.00   //**************************************************************/

Embedded SQL programming

//**************************************************************/
...   
  exec sql set option commit=*NONE,         
                      closqlcsr=*ENDMOD,    
                      dlyprp=*YES;          
                                            
...
   Exec Sql select v7tgtx                                             
            into :#feld                                               
            from v7tabgld                                             
            where v7apid = 'KW'                                       
              and v7tbnr = 363                                        
              and v7tgid = : #tgid                                    
              and v7spcd = : #spcd                                    
            fetch first 1 rows only;                                  
   If     SqlCode = 100;                                              
      #feld = *blanks;                                                
   Exec Sql                                                           
      insert into v7tabgld  (V7APID, V7TBNR, V7TGID, V7SPCD, V7TGTX)  
                      Values('KW',      363, :#tgid, :#spcd, :#FELD); 
   ElseIf SqlCode <> 0;                                               
      #feld = 'sqlcode: ' + %char(sqlcode);                           
      dsply(e) #feld;                                                 
   Endif;                                                             
...
   Exec Sql update v7tabgld                           
            set  v7tgtx = :#feld                      
            where v7apid = 'KW'                       
              and v7tbnr = 363                        
              and v7tgid = : #tgid                    
              and v7spcd = : #spcd;  
   If     SqlCode <> 0;                               
      #Feld = 'Fehler beim Update ' + %char(sqlcode); 
      dsply(e) #Feld;                                 
   Endif;                                             
...                                                        
//**************************************************************/

Zebra Etikett drucken

0001.00       *****************************************************************   
0002.00      h dftname(hszebrac)                                                  
0003.00      h decedit('0,') datedit(*ymd.)                                       
0004.00      h datfmt(*iso) timfmt(*iso)                                          
0005.00      h Option(*NoDebugIo:*SrcStmt)                                        
0006.00       /IF DEFINED(*CRTBNDRPG)                                             
0007.00      h dftactgrp(*no)                                                     
0008.00       /ENDIF                                                              
0009.00       *****************************************************************   
0010.00       *****************************************************************   
0011.00       * Druckerdatei um Kartonkleber auf Zebradrucker zu drucken          
0012.00       * CRTPRTF FILE(LEHRBIB/HSZEBRA) DEVTYPE(*LINE)                      
0013.00      Fhszebra   O    F  100        Printer UsrOpn                         
0014.00       *****************************************************************   
0015.00      d sprintf         PR            10i 0 ExtProc('sprintf')             
0016.00      d                                 *   Value                          
0017.00      d                                 *   Value Options(*string:*nopass) 
0018.00      d                                 *   Value Options(*string:*nopass) 
0019.00      d                                 *   Value Options(*string:*nopass) 
0020.00      d                                 *   Value Options(*string:*nopass) 
0021.00      d system          PR            10i 0 ExtProc('system')              
0022.00      d                                 *   Value Options(*string)         
0023.00       *****************************************************************   
0024.00      d DrZeile#        s             90a                                  
0025.00      d AnzEti#         s              5u 0 inz(1)                         
0026.00      d #dots           c                   'N,40,55'                      
0027.00      d #name           s             30a                                  
0028.00      d x               s              5u 0                                
0029.00      d #col            s                   like(x)                        
0030.00      d #row            s                   like(x)                        
0031.00       *****************************************************************   
0032.00                                                                           
0033.00      c                   ExSr      Drck2Zebra                             
0034.00                                                                           
0035.00      c                   Eval      *inlr = *On                            
0036.00      c                   Return                                           
0037.00       *****************************************************************   
0038.00       /free                                                               
0039.00        //**************************************************************   
0040.00        //***                                                              
0041.00        //**************************************************************   
0042.00        BegSr  Drck2Zebra;                                                 
0043.00            DrZeile# = 'ovrprtf file(HSZEBRA) HOLD(*YES) OUTQ(*JOB)';      
0044.00            If (system(%trim(%trim(DrZeile#))) <> 0);                      
0045.00               Dsply 'Fehler beim Ovrprtf !';                              
0046.00               LeaveSr;                                                    
0047.00            EndIf;                                                         
0048.00            open HSZEBRA;                                                  
0049.00                                                                           
0050.00            // Kleber initialisieren                                       
0051.00            DrZeile#           = '^XA'     // start format                 
0052.00                               + '^CFD'    // alphanum. Font "D"           
0053.00                               + '^FWN'    // Feld nicht drehen            
0054.00                               + '^LH0,0'  // label home position          
0055.00                               + '^LRN'    // nicht revers drucken         
0056.00                               + '^MD0'    // Schwärzung wie Druckerdefault
0057.00                               + '^MMT'    // Vorschub nach Druck          
0058.00                               + '^MNY'    // seperate Etiketten           
0059.00                               + '^MTT'    // Thermotransfer-Etiketten 
0060.00                               + '^PMN'    // nicht horizontal spiegeln           
0061.00                               + '^PON'    // nicht auf den Kopf                  
0062.00                               + '^PQ'     // Druckqualität                       
0063.00                               + %char(AnzEti#)                                   
0064.00                               + ',0,1,Y'  // keine Pause, one replicate??, pause 
0065.00                               + '^PR2';   // langsam drucken                     
0066.00            Except DrZeile;                                                       
0067.00                                                                                  
0068.00            //*** 6 Adressaufkleber für Max Müller in 2 Spalten ***               
0069.00            #row = 0;                                                             
0070.00            For x=1 to 9;                                                         
0071.00               #row += 50;                                                        
0072.00               If %rem(x+3 : 3) = 1;                                              
0073.00                  #name = 'Max Müller';                                           
0074.00                  #row += 50;                                                     
0075.00               ElseIf %rem(x+3 : 3) = 2;                                          
0076.00                  #name = 'Maximilianstraße 1';                                   
0077.00               Else;                                                              
0078.00                  #name = '80539 München';                                        
0079.00               EndIf;                                      
0080.00               ExSr EineZeile;                                           
0081.00            EndFor;                                                      
0082.00                                                                         
0083.00            DrZeile# = '^XA';                                            
0084.00            Except DrZeile;                                              
0085.00        EndSr;                                                           
0086.00                                                                         
0087.00        //************************************************************** 
0088.00        BegSr  EineZeile;                                                
0089.00            DrZeile# = '';                                               
0090.00            #col = 100;                                                  
0091.00            sprintf( %addr(DrZeile#)                                     
0092.00                   : '^A0%s^FO%s^FD%s^FS'                                
0093.00                   : #dots                                               
0094.00                   : %char(#col)+','+%char(#row)                         
0095.00                   : %trim(#name)                                        
0096.00                   );                                                    
0097.00            Except DrZeile;                                              
0098.00            DrZeile# = '';                                               
0099.00            #col = 800;    
0100.00            sprintf( %addr(DrZeile#)                                     
0101.00                   : '^A0%s^FO%s^FD%s^FS'                                
0102.00                   : #dots                                               
0103.00                   : %char(#col)+','+%char(#row)                         
0104.00                   : %trim(#name)                                        
0105.00                   );                                                    
0106.00            Except DrZeile;                                              
0107.00        EndSr;                                                           
0108.00        //************************************************************** 
0109.00       /end-free                                                         
0110.00       ***************************************************************** 
0111.00       * Druckausgabe für Zebradrucker                                   
0112.00      OHSZEBRA   E            DrZeile        1                           
0113.00      O                       DrZeile#            90

return points (endsr)

*DETL Continue at the beginning of detail lines. 
*GETIN Continue at the get input record routine. 
*TOTC Continue at the beginning of total calculations. 
*TOTL Continue at the beginning of total lines. 
*OFL Continue at the beginning of overflow lines. 
*DETC Continue at the beginning of detail calculations. 
*CANCL Cancel the processing of the program.

Funktionstasten

*inka F01
*inkb F02
*inkc F03
*inkd F04
*inke F05
*inkf F06
*inkg F07
*inkh F08
*inki F09
*inkj F10
*inkk F11
*inkl F12
*inkm F13
*inkn F14
*inkp F15
*inkq F16
*inkr F17
*inks F18
*inkt F19
*inku F20
*inkv F21
*inkw F22
*inkx F23
*inky F24

random number

      /if defined(*crtbndrpg)
     h dftactgrp(*no)
      /endif
     h option(*srcstmt)
      //==================================================================//
     d genrndnum       pr                  ExtProc('CEERAN0')
     d                               10i 0 Const
     d                                8f
     d                               10a   Options(*omit)
     d rndnbr          s              8f
     d result          s              5p 0
     d message         s             52a   Varying
       //==================================================================//
      /free
        genrndnum(0 : rndnbr : *omit);
        result  = %int(rndnbr * 6) + 1;
        message = 'random number (1..6) is '
                +  %char(result);
        dsply message;
        return;
      /end-free

sprintf (textconcatenation)

     /if defined(*crtbndrpg)
    h dftactgrp(*no)
     /endif
    h option(*srcstmt)
      //==================================================================//
    d sprintf         pr            10i 0 ExtProc('sprintf')
    d                                 *   Value
    d                                 *   Value Options(*string:*nopass)
    d                                 *   Value Options(*string:*nopass)
    d                                 *   Value Options(*string:*nopass)
    d                                 *   Value Options(*string:*nopass)
      //                              ...
    d psds           sds                  Qualified
    d     pgmn          *proc
    d     jobu                      10a   Overlay(psds:254)
    d message         s             52a
      //==================================================================//
     /free
       sprintf( %addr(message)
               : 'Program %s is used by %s on %s'
               : %trim(psds.pgmn)
               : %trim(psds.jobu)
               : %char(%date())
               );
        dsply message;
        return;
      /end-free

date converting

     h datfmt(*ISO) timfmt(*HMS)
     h datedit(*dmy.) decedit('0,')
      *---------------------------------------------------------------*
     d date8s          s              8s 0       
     d date6s          s              6s 0
     d year4s          s              4s 0
     d year2s          s              2s 0
     d dated           s               d      
      *---------------------------------------------------------------*
      /free                                                                   
         date8s = *date;
         // => 01092011 [dep. datedit(*dmy.)]
         date8s = %dec(%date());
         // => 20110901 [dep. datfmt(*iso)]
         date6s = *date;              
         // Receiver value too small
         year4s = %subdt(%date():*years);
         // => 2011
         year4s = *year;                 
         // => 2011 
         year2s = %subdt(%date():*years);
         // Receiver value too small
         year2s = *year;
         // Receiver value too small
         dated=%date()+%months(1)-%days(%subdt(%date()+%months(1):*days));
         // '2011-09-30        
         eval *inlr = *on;
         return;
      /end-free

merge

     H DECEDIT('0,') DATEDIT(*DMY.)
     H OPTION(*SRCSTMT:*NODEBUGIO)
       //===========================================================//
     fL4FPROLL  iF   E             disk    infds(rollinf)
     f                                     rename(l4f0kid:l4f0roll)
     fL4FL01S   uF a E           k disk    infds(samminf)
     f                                     rename(l4f0kid:l4f0samm)

     fQPRINT    O    F  132        PRINTER OFLIND(*INOA)

       //===========================================================//
     d PSDS           sds                  qualified                            Programmdatenstruk
     d     PGMN          *PROC                                                  Programmname
     d     JOBU                      10a   overlay(PSDS:254)                    JobUser
     d rollinf         ds                  qualified
     d     rrn               397    400i 0
     d samminf         ds                  qualified
     d     rrn               397    400i 0
     d rollds        e ds                  extname(l4fproll:*input)
     d                                     qualified
     d sammds          ds                  likerec(l4f0samm)
     d sammout         ds                  likerec(l4f0samm:*output)
     d
     d drLine          s             80a   inz(*all'=')
     d #zzequal        s              5u 0 inz(0)
     d #zznoteq        s                   like(#zzequal)
     d #zzstat         s                   like(#zzequal)
     d #msg            s             52a   varying
       //===========================================================//
     c                   ExSr      §Work
     c     #msg          Dsply
     c                   Eval      *inlr = *On
     c                   Return
       //===========================================================//
      /free
        BegSr §Work;
          Except DrKopf;
          setll 1 l4f0roll;
          DoW 1=1;
            Read l4f0roll rollds;
            If %EOF();
               Leave;
            Else;
               chain (rollds.L4KID : rollds.L4AT: rollds.L4NMND
                     :rollds.l4nwhl : rollds.l4van) l4f0samm sammds;
               If Not %Found();
                        ExSr §L4Write;
                        Write l4f0samm  sammout;
               Else;
                 If     %subst (sammds : 1 : %len(rollds)) =
                        %subst (rollds : 1 : %len(rollds));
                        #zzequal += 1;
                        unlock l4fl01s;
                 ElseIf sammds.L4STAT  <>  rollds.L4STAT
                     Or sammds.L4NFLV  <>  rollds.L4NFLV
                     Or sammds.L4FAK   <>  rollds.L4FAK
                     Or sammds.L4RKZ   <>  rollds.L4RKZ
                     Or sammds.L4M     <>  rollds.L4M
                     Or sammds.L4ATT   <>  rollds.L4ATT
                     Or sammds.L4AMM   <>  rollds.L4AMM
                     Or sammds.L4AJA   <>  rollds.L4AJA
                     Or sammds.L4LB    <>  rollds.L4LB
                     Or sammds.L4TIME  <>  rollds.L4TIME;
                        ExSr §L4Updat;
                        #zzstat  += 1;
                        #zznoteq += 1;
                        update l4f0samm sammds;
                 Else;
                        #zznoteq += 1;
                        unlock l4fl01s;
                 Endif;
               EndIf;
            EndIf;
          EndDo;

          Except DrSumme;

          If #zznoteq = 0;
             #msg  = 'ROLL und SAMM sind identisch !';
          Else;
             #msg  = 'Von '
                   + %char(#zzequal+#zznoteq)
                   + ' ROLL sind '
                   + %char(#zznoteq)
                   + ' unterschiedlich zur SAMM !';
          Endif;
        EndSr;
       //===========================================================//
        BegSr §L4Write;
                  Clear sammds;
                  eval-corr sammds = rollds;
                  sammds.L4Q3LB = psds.pgmn;
                  sammds.L4Q3TT = *day;
                  sammds.L4Q3MM = *month;
                  sammds.L4Q3JA = *year;
                  %subarr (*in : 71 : 5) = *ON;
                  eval-corr sammout = sammds;
                  Except DrZeile;
        EndSr;
       //===========================================================//
        BegSr §L4updat;
                  *IN71 = (sammds.L4STAT <> rollds.L4STAT);
                  *IN72 = (sammds.L4nflv <> rollds.L4nflv);
                  *IN73 = (sammds.L4fak  <> rollds.L4fak);
                  *IN74 = (sammds.L4rkz  <> rollds.L4rkz);
                  *IN75 = (sammds.L4m    <> rollds.L4m);
                  Except DrZeile;
                  sammds.L4STAV   = sammds.L4STAT;
                  sammds.L4STAT   = rollds.L4STAT;
                  sammds.L4NFLV   = rollds.L4NFLV;
                  sammds.L4FAK    = rollds.L4FAK;
                  sammds.L4RKZ    = rollds.L4RKZ;
                  sammds.L4M      = rollds.L4M;
                  sammds.L4ATT    = rollds.L4ATT;
                  sammds.L4AMM    = rollds.L4AMM;
                  sammds.L4AJA    = rollds.L4AJA;
                  sammds.L4LB     = rollds.L4LB ;
                  sammds.L4TIME   = rollds.L4TIME;
                  sammds.L4Q3LB   = psds.pgmn;
                  sammds.L4Q3TT   = *day;
                  sammds.L4Q3MM   = *month;
                  sammds.L4Q3JA   = *year;
        EndSr;
      /end-free
       //===========================================================//
     oQPRINT    E            Drkopf      1    01
     o                       drLine              80
     oQPRINT    E            DrKopf      1
     o                                           +0 'PGM:'
     o                       PSDS.PGMN           +1
     o                                         +  4 'Korrektur Menge'
     o                                         +  4 'PER:'
     o                       *DATE         Y   +  1
     oQPRINT    E            DrKopf      1
     o                       drLine              80
       //===========================================================//
     oQPRINT    E            DrZeile     1
     o                       rollds.L4KID        +1
     o                                           +1 '//'
     o               71      rollds.L4STAT       +1
     o                                           +1 '->'
     o               71      sammds.L4STAT       +1
     o                                           +1 '//'
     o               72      rollds.L4nflv       +1
     o                                           +1 '->'
     o               72      sammds.L4nflv       +1
     o                                           +1 '//'
     o               73      rollds.L4fak        +1
     o                                           +1 '->'
     o               73      sammds.L4fak        +1
     o                                           +1 '//'
     o               74      rollds.L4rkz        +1
     o                                           +1 '->'
     o               74      sammds.L4rkz        +1
     o                                           +1 '//'
     o               75      rollds.L4m          +1
     o                                           +1 '->'
     o               75      sammds.L4m          +1
     o                       sammds.L4lb         +1
       //===========================================================//
     oQPRINT    E            DrSumme     1
     o                       #zzequal            +1
     o                                           +1 'DS sind identisch'
     oQPRINT    E            DrSumme     1
     o                       #zznoteq            +1
     o                                           +1 'DS sind unterschiedlich'
     oQPRINT    E            DrSumme     1
     o                       #zzstat             +1
     o                                           +1 'DS wurden angeglichen'
Abgerufen von „http:///mediawiki/index.php?title=RPG&oldid=431“