Booth Martin; Contract 
Programming, Inc.
28 Delmont Avenue
Barre, Vermont 05641
802-476-7942
boothm@ibm.net

Screen shot of eliminating characters
An RPG program to demonstrate a technique of including only selected characters in a field.
Screen shot of eliminating characters
An RPG program to demonstrate a technique of excluding selected characters from a field.


The DDS code:

     A*%%TS  SD  19980326  173642  BOOTH       REL-V3R7M0  5716-PW1
     A*%%EC
     A                                      DSPSIZ(24 80 *DS3)
     A                                      CHGINPDFT(HI UL LC)
     A                                      CSRINPONLY
     A*
     A          R FMT01
     A*%%TS  SD  19980326  173642  BOOTH       REL-V3R7M0  5716-PW1
     A                                      TEXT('ELIMINATE CHARACTERS')
     A                                      CA03(03 'EXIT')
     A                                      CA11(11 'TOGGLE')
     A                                      BLINK
     A                                      OVERLAY
     A                                  1 20'Sample of eliminating some charact-
     A                                      ers'
     A                                  1 66'Date:'
     A                                  1 72DATE
     A                                      EDTCDE(Y)
     A                                      COLOR(WHT)
     A                                  2  4'(FMT01)   '
     A                                  2 66'Time:'
     A                                  2 72TIME
     A                                      COLOR(WHT)
     A            FLDA           7A  O  4  3
     A                                  4 11'the following Characters:'
     A            SHOWOK        70A  B  6  3
     A  42                              7  5'This field can not be blank.'
     A                                      COLOR(RED)
     A                                 10  3'The field to process:'
     A            FIELD         30A  I 10 27DSPATR(PC)
     A  41                             11 28'Can''t leave field blank'
     A                                      COLOR(RED)
     A                                 14  3'The field as processed:'
     A            FLD004        30   O 14 27COLOR(PNK)
     A            FLDB           7A  O 19 18
     A                                 19 26'the characters in the listing'
     A                                 19  4'F3=exit  F11='




The RPG code:


     FVALUESFMCF  E                    WORKSTN
     E                    CF         30  1
     E                    CT         30  1
     E                    OK         70  1
     I              'ABCDEFGHIJKLMNOPQRST-C         NCOK
     I              'UVWXYZabcdefghijklmn-
     I              'opqrstuvwxyz'
     C*  ..................................................
     C           *INKC     DOUEQ*ON
     C                     EXFMTFMT01
     C           *INKK     IFEQ *OFF
     C                     EXSR DOITSR
     C                     ELSE
     C                     EXSR TOGGSR
     C                     END
     C                     END
     C                     MOVE *ON       *INLR
     C* ....................................................
     C* :           S U B   R O U T I N E S                :
     C* ::::::::::::::::::::::::::::::::::::::::::::::::::::
     C* Accept only the characters appearing in array OK:
     C           DOITSR    BEGSR
     C                     MOVE *OFF      *IN41
     C                     MOVE *OFF      *IN42
     C                     MOVE *BLANKS   CF
     C                     MOVE *BLANKS   CT
     C                     MOVEASHOWOK    OK
     C                     SORTAOK
     C                     MOVEAOK        SHOWOK
     C           SHOWOK    IFEQ *BLANKS
     C                     MOVE *ON       *IN42            ERROR 42
     C                     ELSE
     C           FIELD     IFEQ *BLANKS
     C                     MOVE *ON       *IN41            ERROR 41
     C                     ELSE
     C* I is the column # of the field we are checking;
     C* J is the column # of the field to which we are writing:
     C                     Z-ADD1         I       20
     C                     Z-ADD1         J       20
     C                     MOVEAFIELD     CT
     C* The array CT is 30 columns long; we need to check all 30 columns.
     C                     DO   30
     C           CT,I      LOKUPOK                       61 61=yes
     C* 61 = The character is in the array:
     C           *IN61     IFEQ *ON
     C           FLDA      ANDEQ'Include'
     C                     EXSR FILLSR
     C                     END
     C           *IN61     IFEQ *OFF
     C           FLDA      ANDEQ'Exclude'
     C                     EXSR FILLSR
     C                     END
     C* Now, get the next column's character to process:
     C                     ADD  1         I
     C                     END
     C* _____________________________________________________________
     C* The array CF now holds the new field as we want it, so we are
     C* moving the new field back into the original field to display it.
     C                     MOVE *BLANKS   FLD004
     C                     MOVEACF        FLD004
     C                     MOVE *BLANKS   SHOWOK
     C                     MOVEAOK        SHOWOK
     C                     END
     C                     END
     C                     ENDSR
     C* ::::::::::::::::::::::::::::::::::::::::::::::::::::
     C* Toggle include/exclude:
     C           TOGGSR    BEGSR
     C           FLDA      IFEQ 'Include'
     C                     MOVE 'Exclude' FLDA
     C                     MOVE 'Include' FLDB
     C                     ELSE
     C                     MOVE 'Exclude' FLDB
     C                     MOVE 'Include' FLDA
     C                     END
     C                     ENDSR
     C* ::::::::::::::::::::::::::::::::::::::::::::::::::::
     C* Fill an array with desired characters:
     C           FILLSR    BEGSR
     C* Move the character into the next available
     C* column of the array CF, and increment CF's counter.
     C                     MOVE CT,I      CF,J
     C                     ADD  1         J
     C                     ENDSR
     C* ::::::::::::::::::::::::::::::::::::::::::::::::::::
     C* Initialization sub-routine
     C           *INZSR    BEGSR
     C                     MOVE 'Include' FLDA    7
     C                     MOVE 'Exclude' FLDB    7
     C                     MOVELNCOK      SHOWOK
     C                     EXSR DOITSR
     C                     ENDSR
     C*-------------------------------------------------------------------



For comments or questions, leave e-mail
A series of code for FTP of AS/400 files.
A date verification/formatting program
Review a sample of my coding work
Download this code as text
Return to my home page
Top of page