Monday 17 October 2011

RPGLE - Translate Lower case to Upper case

    RPGLE  - Translate Lower case to Upper case

*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
     H DftActGrp(*No) Option(*SrcStmt : *NoDebugIO)
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
      * Program Name:
      * Description :
      * Date Written:
      * Modification:
      * ~~~~~~~~~~~~
      *
      *
      *
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
     FINBOX     if   e           k disk    prefix(x)
      *
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
      *
      * Program Information
      * ~~~~~~~~~~~~~~~~~~~
     D @PgmInfo       sds
     D  @PgmNam                1     10
     D  @Parms                37     39  0
     D  @MsgId                40     46
     D  @MsgDta               91    170
     D  @JobNam              244    253
     D  @UserId              254    263
     D  @JobNum              264    269  0
      *
      * Constants
      * ~~~~~~~~~
     D UpperCase       C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D LowerCase       C                   'abcdefghijklmnopqrstuvwxyz'
      *
      * Define Variables
      * ~~~~~~~~~~~~~~~~
     D XMLField        s           1000    inz(*blanks)
      *
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
      *     M  A  I  N     L  I  N  E
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
      *
     C                   eval      *inlr = *on
     C                   return
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
      *
      *-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
     C     *inzsr        begsr
      *
     C                   read      INBOX
     C                   dow       not %eof(INBOX)
      *
     C                   eval      XMLField = %xlate(LowerCase : UpperCase :
     C                                               %trim(xSRCDTA))
      *
     C                   read      INBOX
     C                   enddo
      *
     C                   endsr

No comments:

Post a Comment