|
An RPG program demonstrating a technique for excluding selected characters.
The DDS code:
*%%TS SD 19980326 173642 BOOTH REL-V3R7M0 5716-PW1
*%%EC
A DSPSIZ(24 80 *DS3)
A CHGINPDFT(HI UL LC)
A CSRINPONLY
*
A R FMT01
*%%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 *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
* ....................................................
* : S U B R O U T I N E S :
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
* 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
* I is the column # of the field we are checking;
* 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
* The array CT is 30 columns long; we need to check all 30 columns.
C DO 30
C CT,I LOKUPOK 61 61=yes
* 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
* Now, get the next column's character to process:
C ADD 1 I
C END
* _____________________________________________________________
* The array CF now holds the new field as we want it, so we are
* 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
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
* 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
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
* Fill an array with desired characters:
C FILLSR BEGSR
* Move the character into the next available
* column of the array CF, and increment CF's counter.
C MOVE CT,I CF,J
C ADD 1 J
C ENDSR
* ::::::::::::::::::::::::::::::::::::::::::::::::::::
* Initialization sub-routine
C *INZSR BEGSR
C MOVE 'Include' FLDA 7
C MOVE 'Exclude' FLDB 7
C MOVELNCOK SHOWOK
C EXSR DOITSR
C ENDSR
*-----------------------------------------------------------------
|
|
|
|
