AS400 Learners : January 2018

Tuesday, 16 January 2018

%Found Example

* Program :·FoundR
* Description :·%Found() Example
*
* Syntex :
*
* %Found { File Name }
*
* Output :·1 : if most recent relevent operation
* chain,delete,setll, setgt found a match
* 0 : otherwise
*
*=====================================================
*
FFile1 IF E K Disk
D

C
/Free
Chain 'R1FD1' Rcd1 ;
Dsply %Found(File1) ; // 1

Chain 'R2FD1' Rcd1 ;
Dsply %Found ; // 1

Chain 'ABCDE' Rcd1 ;
Dsply %Found ; // 0

/End-Free
C SetOn LR

Saturday, 6 January 2018

%FLOAT Example

*
* Description :·%Float() Example
*
* Syntex :
*
* %Float(Numeric Expression)
*
* Output :·Float value
*
*=====================================================
*
D FloatVar S 8F

C
/Free
FloatVar = %Float(100) ;
Dsply FloatVar ; // +1.000000000000000E+002

FloatVar = %Float(10 * 15.5) ;
Dsply FloatVar ; // +1.550000000000000E+002

/End-Free
C SetOn LR

%ERROR Example

*
* Description :·%Error() Example
*
* Syntex :
*
* %Error()
*
* Output :·1 - if most recent opcode specified with
* operation extender 'E' ends in error
* 0 - otherwise
*=====================================================
*
FFile2 UF A E K Disk

D Arr1 S 1A Dim(2)
D Index S 1P 0
D Var1 S 2P 0
D Error S 1A

C Delete(E) Rcd1

C If %Error
C Eval Error = %Error
C Error Dsply // 1
C EndIf
C
C SetOn LR

%EQUAL Example

*
* Description :·%Equal() Example
*
* Syntex :
*
* %Equal(File Name)
*
* Output :·1 - if most recent SetLL found exact match
* 0 - otherwise
*=====================================================
*
FFile1 IF E K Disk

D EoF S 1A

C
/Free
SetLL 'R1FD1' File1 ;

Dsply %Equal(file1) ; // 1

SetLL 'ABCDE' File1 ;

Dsply %Equal(file1) ; // 0

/End-Free
C SetOn LR

%EOF Example

*
* Description :·%EoF() Example
*
* Syntex :
*
* %EoF(File Name)
*
* Output :·1 - when file pointer is reeached to end of file
* 0 - otherwise
*=====================================================
*
FFile1 IF E K Disk

D EoF S 1A

C
/Free
SetLL *LoVal File1 ;
Read File1 ;

DoW (%EoF(File1) = '0') ; // Or DoW Not(%EoF(File1))
// Or DoW Not(%EoF)
EoF = %EoF(File1) ;

Dsply Fld1 ; // R1FD1, R2FD1
Dsply EoF ; // 0

Read File1 ;
EndDo ;

EoF = %EoF(File1) ;
Dsply EoF ; // 1
/End-Free
C SetOn LR

%ELEM Example

*
* Description :·%Elem() Example
*
* Syntex :
*
* %Elem(Array / Table / multiple occurance DS)
*
* Output :·No. of elements
*
*=====================================================
*
D Arr1 S 5A Dim(5)
D Arr2 S 5A Dim(%Elem(Arr1))
D Table1 S 5A Dim(10) CTData
D MulDS1 DS Occurs(15)
D Fld1 5A
D Fld2 5A
D NoOfElem S 5P 0

C
/Free

NoOfElem = %Elem(Arr1) ;
Dsply NoOfElem ; // 5

NoOfElem = %Elem(Table1) ;
Dsply NoOfElem ; // 10

NoOfElem = %Elem(MulDS1) ;
Dsply NoOfElem ; // 15

/End-Free
C SetOn LR
** Table
row1
row2

%EDITW Example

* Program :·EditWR
* Description :·%EditW() Example
*
* Syntex :
*
* %EditW(Non-float numeric expression : Edit word)
*
* Output :·String representing edited value
*
* Note :
*
* >·if '0' or '*' is used in edit word
* >>·first '0' or '*' will be considerd as Ends Zero Suppression, will be clear with
* examples. after first '0' or '*' other given '0' or '*' will be considered as
* constants.
*
*=====================================================
*
D Var1 S 5P 2 Inz(123.45)
D Str C '$ Cents '
D IntDate S 6P 0 Inz(010112)
D DateEditW C ' / / '
D Str1 S 30A

C
/Free

Str1 = 'I have ' + %EditW(Var1 : Str) ;
Dsply Str1 ; // I have $123Cents45

Str1 = 'Today''s Date' + %EditW(IntDate : DateEditW) ;
Dsply Str1 ; // Today's Date 1/01/12

Str1 = %EditW(00142.20 : ' $0. ') ;
Dsply Str1 ; // DSPLY $142.20

// '0' as end zero suppressor
Str1 = %EditW(0001 : ' 0 ') ;
Dsply Str1 ; // DSPLY 1

Str1 = %EditW(0001 : ' 0 ') ;
Dsply Str1 ; // DSPLY 01

Str1 = %EditW(0001 : '0 ') ;
Dsply Str1 ; // DSPLY 001

// only first '0' will be considerd as zero suppressor & will be replaced by given
// string, second '0' onwards it will be treated as constant & will not be replaced
Str1 = %EditW(0001 : '00 ') ;
Dsply Str1 ; // DSPLY 0001

// '*' as end zero suppressor
Str1 = %EditW(0001 : ' * ') ;
Dsply Str1 ; // DSPLY ***1

Str1 = %EditW(0001 : ' * ') ;
Dsply Str1 ; // DSPLY **01

Str1 = %EditW(0001 : '* ') ;
Dsply Str1 ; // DSPLY *001

// only first '*' will be considerd as zero suppressor & will be replaced by given
// string, second '*' onwards it will be treated as constant & will not be replaced
Str1 = %EditW(0001 : '** ') ;
Dsply Str1 ; // DSPLY **001

/End-Free
C SetOn LR

%EDITFLT Example

*
* Description :·%EditFlt() Example
*
* Syntex :
*
* %EditFlt(Numeric Expression)
*
* Function :·Character external display representation of float
*
* Note :·Returned string length
* 4F => 14A
* 8F => 23A
*
*=====================================================
*
D FloatVar S 8F Inz(123456.78)

C
/Free

Str = %EditFlt(FloatVar) ;
Dsply Str ; // +1.234567800000000E+005

Str = %EditFlt(FloatVar - 1E4) ; // +1.134567800000000E+005
Dsply Str ;

/End-Free
C SetOn LR

Wednesday, 3 January 2018

%EDITC Example

*
* Description :·%EditC() Example
*
* Syntex :
*
* %EditC(Non float numeric expression : edit code {:*CURSYM | *ASTFILL | currency symbol })
*
* Function :·Edit the numeric expression for given edit code & return edited string
*
* Notes :
*
* Zero Balance:·if a number having all zeros will be given,
* function will return single zero followed by
* 0s in decimal positions(if dec pos > 0)
* for eg.
* 000000 => 0
* 000 => 0
* 000.00 => .00
* without zero balance·a blank string will be returned
*
*=====================================================
*
D EditedStr S 20A
D IntVar S 10 4 Inz(001234.5600)
D ZeroNoDecPos S 10 0 Inz(00000000000)
D ZeroWithDecPos S 10 4 Inz(000000.0000)
D Date4Dig S 4 0 Inz(1234)
D Date8Dig S 8 0 Inz(01012001)

C
/Free
// X : Numeric to Char without supressing leading zeros
EditedStr = %EditC(IntVar : 'X' ) ;
Dsply EditedStr ; // 00100

//--------------------------------------------------
// No Sign - Edit code will not put any sign in string
//==================================================
// with commas & zero balances
// ---------------------------
EditedStr = %EditC(IntVar : '1') ;
Dsply EditedStr ; // 12,34.5600

EditedStr = %EditC(ZeroNoDecPos : '1') ;
Dsply EditedStr ; // 0

EditedStr = %EditC(ZeroWithDecPos : '1') ;
Dsply EditedStr ; // .0000

// commas only No zero balance
// ---------------------------
EditedStr = %EditC(ZeroNoDecPos : '2') ;
Dsply EditedStr ; // *Blanks

EditedStr = %EditC(ZeroWithDecPos : '2') ;
Dsply EditedStr ; // *Blanks

EditedStr = %EditC(IntVar : '2') ;
Dsply EditedStr ; // 1,234.5600

// zero balances only
// ---------------------------
EditedStr = %EditC(IntVar : '3') ;
Dsply EditedStr ; // 1234.5600

EditedStr = %EditC(ZeroNoDecPos : '3') ;
Dsply EditedStr ; // 0

EditedStr = %EditC(ZeroWithDecPos : '3') ;
Dsply EditedStr ; // .0000

// No commas or zero balance
// ---------------------------
EditedStr = %EditC(ZeroNoDecPos : '4') ;
Dsply EditedStr ; // *Blanks

EditedStr = %EditC(ZeroWithDecPos : '4') ;
Dsply EditedStr ; // *Blanks

EditedStr = %EditC(IntVar : '4') ;
Dsply EditedStr ; // 1234.5600

//--------------------------------------------------
// CR Sign - Currency sign will be placed in front
//==================================================
// with commas & zero balances
// ---------------------------
EditedStr = %EditC(IntVar : 'A' : *CurSym) ;
Dsply EditedStr ; // $1,234.5600

EditedStr = %EditC(IntVar : 'A' : '@') ;
Dsply EditedStr ; // @1,234.5600

EditedStr = %EditC(IntVar : 'A' : *AstFill) ;
Dsply EditedStr ; // **1,234.5600

EditedStr = %EditC(ZeroNoDecPos : 'A' : *CurSym) ;
Dsply EditedStr ; // $0

EditedStr = %EditC(ZeroWithDecPos : 'A' : *CurSym) ;
Dsply EditedStr ; // $.0000

// commas only No zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'B' : *CurSym) ;
Dsply EditedStr ; // $1,234.5600

EditedStr = %EditC(IntVar : 'B' : '@') ;
Dsply EditedStr ; // @1,234.5600

EditedStr = %EditC(ZeroNoDecPos : 'B' : *CurSym) ;
Dsply EditedStr ; // No Output

EditedStr = %EditC(ZeroWithDecPos : 'B' : *CurSym) ;
Dsply EditedStr ; // No Output

// zero balances only
// ---------------------------
EditedStr = %EditC(IntVar : 'C' : *CurSym) ;
Dsply EditedStr ; // $1234.5600

EditedStr = %EditC(IntVar : 'C' : '@') ;
Dsply EditedStr ; // @1234.5600

EditedStr = %EditC(ZeroNoDecPos : 'C' : *CurSym) ;
Dsply EditedStr ; // $0

EditedStr = %EditC(ZeroWithDecPos : 'C' : *CurSym) ;
Dsply EditedStr ; // $.0000

// No commas or zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'D' : *CurSym) ;
Dsply EditedStr ; // $1234.5600

EditedStr = %EditC(IntVar : 'D' : '@') ;
Dsply EditedStr ; // @1234.5600

EditedStr = %EditC(ZeroNoDecPos : 'D' : *CurSym) ;
Dsply EditedStr ; // No Output

EditedStr = %EditC(ZeroWithDecPos : 'D' : *CurSym) ;
Dsply EditedStr ; // No Output

//--------------------------------------------------
// -Sign(R) - '-' Sign at right
//==================================================
// with commas & zero balances
// ---------------------------
EditedStr = %EditC(IntVar : 'J') ;
Dsply EditedStr ; // 1,234.5600-

EditedStr = %EditC(ZeroNoDecPos : 'J') ;
Dsply EditedStr ; // 0-

// commas only No zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'K') ;
Dsply EditedStr ; // 1,234.5600-

EditedStr = %EditC(ZeroNoDecPos : 'K') ;
Dsply EditedStr ; // No Output

// zero balances only
// ---------------------------
EditedStr = %EditC(IntVar : 'L') ;
Dsply EditedStr ; // 1234.5600-

EditedStr = %EditC(ZeroNoDecPos : 'L') ;
Dsply EditedStr ; // 0-

// No commas or zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'M') ;
Dsply EditedStr ; // 1234.5600-

EditedStr = %EditC(ZeroNoDecPos : 'M') ;
Dsply EditedStr ; // No Output

//--------------------------------------------------
// -Sign(L) - '-' Sign at right
//==================================================
// with commas & zero balances
// ---------------------------
EditedStr = %EditC(0.120 : 'N') ;
Dsply EditedStr ; // -1,234.5600

EditedStr = %EditC(ZeroNoDecPos : 'N') ;
Dsply EditedStr ; // -0

// commas only No zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'O') ;
Dsply EditedStr ; // -1,234.5600

EditedStr = %EditC(ZeroNoDecPos : 'O') ;
Dsply EditedStr ; // No Output

// zero balances only
// ---------------------------
EditedStr = %EditC(IntVar : 'P') ;
Dsply EditedStr ; // -1234.5600

EditedStr = %EditC(ZeroNoDecPos : 'P') ;
Dsply EditedStr ; // -0

// No commas or zero balance
// ---------------------------
EditedStr = %EditC(IntVar : 'Q') ;
Dsply EditedStr ; // -1234.5600

EditedStr = %EditC(ZeroNoDecPos : 'Q') ;
Dsply EditedStr ; // No Output

//--------------------------------------------------
// Date Edit
//==================================================
EditedStr = %EditC(Date8Dig : 'Y') ;
Dsply EditedStr ; // 1/01/2001

EditedStr = %EditC(010112 : 'Y') ;
Dsply EditedStr ; // 1/01/12

//--------------------------------------------------
// Suppress leading zeros
//==================================================
EditedStr = %EditC(00123.40 : 'Z') ;
Dsply EditedStr ; // 12340

EditedStr = %EditC(00123.400 : 'Z') ;
Dsply EditedStr ; // 123400

/End-Free
C SetOn LR

%DIV Example

*
* Description :·%Div() Example
*
* Syntex :
*
* %Div(Dividend : Divisor)
*
* Function :·Return quotient of division
*
*=====================================================
*
D Quotient S 5I 0

C
/Free

Quotient = %Div(5 : 2) ;
Dsply Quotient ; // 2

Quotient = %Div(10*10 : 2) ;
Dsply Quotient ; // 50

/End-Free
C SetOn LR

%DIFF Example

*
* Description :·%Diff() Example
*
* Syntex :
*
* %Diff(Date/Time expression : Date/Time expression : unit)
*
* Function :·Return Difference between date/time given in specified unit
*==========================================================
*
D Diff S 5I 0
D Date1 S D

C
/Free
//-------------------------------------------------------
// For Date
//=======================================================

Diff = %Diff(D'2010-02-01' : D'2010-01-01' : *Days) ;
Dsply %Char(Diff) ; // 31

Diff = %Diff(D'2010-01-01' : D'2010-02-01' : *Days) ;
Dsply %Char(Diff) ; // -31

Diff = %Diff(D'2010-01-01' : D'2010-02-01' : *Months) ;
Dsply %Char(Diff) ; // -1

Diff = %Diff(D'2012-01-01' : D'2010-01-01' : *Years) ;
Dsply %Char(Diff) ; // 2

// Date - TimeStamp
Diff = %Diff(D'2010-01-01' : Z'2010-01-01-09.00.00' : *Years) ;
Dsply %Char(Diff) ; // 0

//-------------------------------------------------------
// For Time
//=======================================================

Diff = %Diff(T'10.00.00' : T'09.00.00' : *Hours) ;
Dsply %Char(Diff) ; // 1

Diff = %Diff(T'10.00.00' : T'09.00.00' : *Minutes) ;
Dsply %Char(Diff) ; // 60

Diff = %Diff(T'10.00.00' : T'09.00.00' : *Seconds) ;
Dsply %Char(Diff) ; // 3600

// Time - TimeStamp
Diff = %Diff(T'10.00.00' : Z'2010-01-01-08.00.00' : *Hours) ;
Dsply %Char(Diff) ; // 2

//-------------------------------------------------------
// For TimeStamp
//-------------------------------------------------------

Diff = %Diff(Z'2010-03-03-10.00.00.000200' :
Z'2010-03-03-10.00.00.000100' :
*MSeconds) ;
Dsply %Char(Diff) ; // 100

//-------------------------------------------------------
// %Diff as Duration
//-------------------------------------------------------

Date1 = %Date() +
%Diff(D'2012-11-11' : D'2011-10-10' : *Days) ;

Dsply Date1 ; // Some Date

/End-Free
C SetOn LR

%DEC Example

*
* Description :·%Dec() Example
*
* Syntex :
*
* %Dec(Numeric/Character Expression { : Precision : Decimal Places })
* %Dec(date/Time/TimeStamp { : Format })
*
* Output :·Packed Decimal Value of first parameter
*==========================================================
*
D ZonedDec S 2S 1 Inz(1.1)
D PackedDec S 2P 1
D DateUSA S D Inz(D'2010-11-12')
D PackedDate S 8 0
D Time S T Inz(T'10.11.12')
D PackedTime S 8 0
D TimeStamp S Z Inz(Z'2001-02-03-04.05.06.070809')
D PackedTimeStmp S 20 0

C
/Free
// ------------------------------------------------------
// Numeric or Character Expression
// ======================================================

PackedDec = %Dec(ZonedDec : 2 : 1) ;
Dsply %Char(PackedDec) ; // 1.1

PackedDec = %Dec('1.2' : 2 : 1) ;
Dsply %Char(PackedDec) ; // 1.2

PackedDec = %Dec('+1.3' : 2 : 1) ;
Dsply %Char(PackedDec) ; // 1.3

PackedDec = %Dec('1.4+' : 2 : 1) ;
Dsply %Char(PackedDec) ; // 1.4

PackedDec = %Dec('1,5' : 2 : 1) ;
Dsply %Char(PackedDec) ; // 1.5
// ------------------------------------------------------
// Date/Time/TimeStamp Expression
// ======================================================

PackedDate = %Dec(DateUSA) ;
Dsply %Char(PackedDate) ; // 20101112

PackedDate = %Dec(DateUSA : *USA) ;
Dsply %Char(PackedDate) ; // 11122010

PackedTime = %Dec(Time) ;
Dsply %Char(PackedTime) ; // 101112

PackedTime = %Dec(Time : *HMS) ;
Dsply %Char(PackedTime) ; // 101112

PackedTimeStmp = %Dec(TimeStamp) ;
Dsply %Char(PackedTimeStmp) ; // 20010203040506070809

PackedTimeStmp = %Dec(Z'2001-02-03-04.05.06') ;
Dsply %Char(PackedTimeStmp) ; // 20010203040506000000

/End-Free
C SetOn LR

%DECPOS Example

*
* Description :·%DecPos() Example
*
* Syntex :
*
* %DecPos(Numeric Expression)
*
* Function :·Return No. of decimal positions for given Expression
*
* Note :·Given Expression must not be a float value
*==========================================================
*
D DecPosition S 5U 0 Unsigned Integer

C
/Free
DecPosition = %DecPos(123.456) ;
Dsply DecPosition ; // 3

DecPosition = %DecPos(1234.56) ;
Dsply DecPosition ; // 2

DecPosition = %DecPos(123.45 * 6.789) ;
Dsply DecPosition ; // 5

DecPosition = %DecPos(123) ;
Dsply DecPosition ; // 0
/End-Free
C SetOn LR