* 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
AS400 Learners
Tuesday, 16 January 2018
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
* 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
* 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
* 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
* 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
* 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
* 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
Subscribe to:
Posts (Atom)