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