AS400 Identify the Program Functions

\\AS400 Identify the Program functions//

Names the user-defined function. The combination of name, schema name, the number of parameters, and the data type of each parameter (without regard for any length, precision, scale, or CCSID attributes of the data type) must not identify a user-defined function that exists at the current server.
For SQL naming, the function will be created in the schema specified by the implicit or explicit qualifier.

C     P1PIRD        CHAIN     RPRID                              96      
C     *IN96         IFEQ      *OFF                                       
C     PRST          SUB       20000000      INDATE                       
C                   CALL      'DATCHG'                                   
C                   PARM                    INDATE            6 0        
C                   PARM      'YMD'         INFORM            3          
C                   PARM      'SYS'         OTFORM            3          
C                   PARM                    OTDATE            6 0        
C                   PARM                    OTCENT            1 0

|--+-+---SMALLINT---+
   | +-+-INTEGER-+--+                                                                                     |   
   | | '-INT-----'  |                                                                                      
   | '---BIGINT-----'                                                                                    
   |  .-(5,0)------------------------.                                                  
   +-+-+-DECIMAL-+-+
   | | '-DEC-----' |  |             .-,0------                                 
   | '-+-NUMERIC-+-'  '-(--integer--+-----------+--)                                               |   
   |   '-NUM-----'                  '-, integer-'                                                         |   
   |          .-(--53--)------.                                                                           
   +-+-FLOAT--+---------------+
   | |        '-(--integer--)-' |                                                                       
   | +-REAL---------------------+                                                                         |   
   | |         .-PRECISION-.    |                                                                         |   

   | '-DOUBLE--+-----------+----'  

A function can have zero or more input parameters. There must be one entry in the list for each parameter that the function expects to receive. All the parameters for a function are input parameters and are nullable. In the case of JAVA, numeric parameters other than the DECIMAL and NUMERIC types are not nullable. A runtime error will occur if a null value is input to such a parameter for a CALLED ON NULL INPUT function. For more information, see Defining the parameters in CREATE FUNCTION.

Share:

Read More

Physical File Record AS400

\\Physical File Record AS400//

 d PGMNAME         pr
 d  TrgBuffer_                         like(TrgBuffer)
 d  TrgBufLen_                         like(TrgBufLen)

 d BefImg        e ds                  extname(FILENAME) prefix(b_)
 d AftImg        e ds                  extname(FILENAME) prefix(a_)

 d FILENAMER       pi
 d  p$TrgBuffer                        like(TrgBuffer)
 d  p$TrgBufLen                        like(TrgBufLen)

    TrgBuffer = p$TrgBuffer;
    TrgBufLen = p$TrgBufLen;

    NRO = NewRecOff + 1;
    NRL = NewRecLen;
    ORO = OrgRecOff + 1;
    ORL = OrgRecLen;

    // Set Before / After Images
    BefImg = %subst(TrgBuffer:ORO:ORL);
    AftImg = %subst(TrgBuffer:NRO:NRL);

    select;

    // Update
     when TrgEvent = '3';

     // Set last updated timestamp on record.
     a_lstupd = %timestamp();
     %subst(TrgBuffer:NRO:NRL) = AftImg;
     p$TrgBuffer = TrgBuffer; 
LAST_UPDATED for column LSTUPD
  timestamp not null
  generated always
  for each row on update
  as row change timestamp

Share:

Read More

AS400 Cleaner Functions

//AS400 Cleaner files

D ErrMsgDSDS DS
D ErrPrefix 3
D ErrMsgID 4
D ErrMajor 2 OVERLAY(ErrMsgID:1)
D ErrMinor 2 OVERLAY(ErrMsgID:3)
D RtnCode DS
D PackedNbr 15P 5
D RtnCode DS
D PackedNbr 1 8P 5
D APIRtn DS
D Pos145 145 152
D PackNbr 15P 5
OVERLAY(Pos145)
C*                                               
C     STEP          DOUEQ     *BLANK             
C*                                               
C     STEP          CASEQ     'INZ01 '      INZ01 
C*                                               
C     STEP          CASEQ     'DSP01 '      DSP01 
C*                                               
C     STEP          CASEQ     'NOP01 '      NOP01 
C*                                               
C     STEP          CASEQ     'DSP02 '      DSP02 
C*                                               
C     STEP          CASEQ     'LSF01 '      LSF01 
C*                                               
C     STEP          CASEQ     'EDT01 '      EDT01 
C*                                               
C     STEP          CASEQ     'EDT02 '      EDT02 
C*                                               
C     STEP          CASEQ     'EXIT  '      EXIT 

D IndicatorPtr * INZ(%ADDR(*IN))

D DS BASED(IndicatorPtr)

D F03Key 3 3

D F05Key 5 5

D CustNotFnd 50 50

D SflClr 91 91

D SflDsp 92 92

D SflDspCtl 93 93

C IF F03Key = *ON

C EVAL *INLR = *ON

C RETURN

C ENDIF
C*

Share:

Read More

AS400 Easy way to Read File A to File B

FFilea            if   e           k disk   
Ffileb            uf a  e         k disk   

D ds_filea        E DS                  ExtName( Filea )
D ds_fileb        E DS                  ExtName( Fileb )

read filea
dow not%eof(filea)

eval ds_fileb = ds_filea
eval random_number = random_number
write {fileb}
read  filea
enddo 

 // dump member names to outfile for processing                       
  runCmd( 'DSPFD FILE(LIB/FILEA) TYPE(*MBRLIST) OUTPUT(*OUTFILE) '
        + 'FILEATR(*ALL) OUTFILE(QTEMP/DUMPF)' );
FFilea            if   e           k disk     usropn
Ffileb            uf a  e         k disk   
D CmdString       s            256    inz(*blanks)
D CmdLength       s             15  5 inz(0)

D ds_filea        E DS                  ExtName( Filea ) 
D ds_fileb        E DS                  ExtName( Fileb ) 

C                   eval      CmdString = %trim('ovrdbf  filea  member(*ALL) ')
C                   eval      CmdLength = %len(%trim(CmdString))
C                   call(e)   'QCMDEXC'                           
C                   parm                    CmdString
C                   parm                    CmdLength

c                    if  not%open(filea)
c                    open filea
c                    endif

read filea 
dow not%eof(filea)

eval ds_fileb = ds_filea
eval random_number = random_number
write {fileb}
read  filea
enddo 

Share:

Read More