  |
|
|
|
|||||||
 |
 |
|
|
 |
||
|
Alternatives to Published Tips Dear Readers: Many of you have been kind enough to send me alternatives to the tips we publish in Midrange Guru. I appreciate your efforts, as I am a firm believer that there are many ways to remove the outer covering of a feline. Here are some of those alternatives. 
--Ted Hey, Ted: Here's an easier way to make sure that underlined fields in printer files show the data when displayed on screen. Make sure that the data is printed after the underline, by using a dummy field containing the same number of blanks as there are characters in the data field. Apply the UNDERLINE DDS keyword to the dummy field instead of the data field. Easy!! A REF(CUSTPF) A R DATA SPACEA(1) A A 2' ' A UNDERLINE A 2'CUSTOMER NUMBER:' A A CUSTNUM R +5EDTCDE(4) --Rob I agree it's easy, but it could amount to a lot of work. Thanks, Rob. --Ted Hey, Ted: I think you should register "Hey, Ted" as your personal trademark, but I digress. Here's another way to code a two-dimensional array: D DSQ DS 480 OCCURS(500) D SIZQ 1 480 0 D DIM(96) This code gives you a 500x96 array. Each array element is five digits with zero decimal places, which is determined by dividing the total length of 480 by 96. The number of array elements has to divide evenly into the total length of a single occurrence of the data structure. If we change the number of decimals from 0 to 2, each element of the array is five digits with two decimal positions. I tried to see if I could put that structure inside of another multiple occurring data structure to get a three-dimensional array, but no luck. I just got a headache. --Bruce Thanks, Bruce. Putting an array in a multiple-occurrence data structure works, but I consider it a kludge. Your headache reminds me of something I tried on a VAX 11/780 twenty years ago. The COBOL manual said that arrays of up to 49 dimensions could be defined, so I tried it out. I created a 49-D array of 1 byte elements. You can't get any smaller than that, right? The program would not compile. If I remember correctly, the error message said that the compiled program would not be able to fit into memory. --Ted Hey, Ted: To retrieve the current date, you suggested defining a date variable and initializing it to the *JOB value. Why not just use %date? C eval mydate = %date C write rec --Jerry You're correct, Jerry. If you use the %date function without a parameter, the function returns the current system date, which is the same as initializing a date variable with the *SYS value. This function is not available in releases before V5R1. --Ted Hey, Ted: You suggested using the SFLCSRRRN keyword to retrieve the relative record number of the subfile record on which the cursor is placed. An alternative would be to retrieve the relative record number of the first record currently on screen from the binary number in positions 378-379 of the file information data structure associated with the file. --Simon That's a good technique, Simon. It was around before IBM released the SFLCSRRRN keyword. Here's my code revised to use the data structure.
A DSPSIZ(24 80 *DS3)
A INDARA
A R S1SFL SFL
A 6 2'LOAD:'
A S1LOADNBR 3 0O +1EDTCDE(4)
A +1'REC:'
A S1RECNBR 3 0O +1EDTCDE(4)
A R S1CTL SFLCTL(S1SFL)
A SFLSIZ(11)
A SFLPAG(10)
A OVERLAY
A CA03(03 'EXIT')
A CF05(05 'REFRESH')
A CF10(10 'NEXT LOAD')
A 45 SFLDSP
A 44 SFLDSPCTL
A N44N45 SFLCLR
A 46 SFLEND(*MORE)
A S1RCDNBR 4S 0H SFLRCDNBR(CURSOR
A S1SFLRRN 5S 0H
A R S1LEGEND
A 23 5'F3=Exit'
A +4'F5=Refresh'
A +4'F10=Next load'
Faa02d cf e workstn
F sfile(s1Sfl:s1SflRRN)
F indds(wsIndicators)
F infds(wsInfds)
D true c const(*on)
D false c const(*off)
D wsIndicators ds 99
D s1ExitRequested...
D 3 3n
D s1RefreshRequested...
D 5 5n
D s1LoadRequested...
D 10 10n
D s1SflDspCtl 44 44n
D s1SflDsp 45 45n
D s1SflMore 46 46n
D wsInfds ds
D wsPageRRN 378 379i 0
C eval s1LoadRequested = true
C eval s1SflMore = true
C
C dou s1ExitRequested
C if s1LoadRequested
C exsr s1Load
C elseif s1RefreshRequested
C exsr s1Refresh
C endif
C exsr s1Display
C enddo
C
C eval *inlr = *on
C* ====================================================
C s1Display begsr
C
C eval s1SflDsp = true
C eval s1SflDspCtl = true
C
C if wsPageRRN > *zero
C eval s1RcdNbr = wsPageRRN
C else
C eval s1RcdNbr = 1
C endif
C
C write s1Legend
C exfmt s1Ctl
C
C endsr
C* ================================================
C s1Load begsr
C
C eval s1LoadNbr += 1
C exsr s1Refresh
C
C endsr
C* ================================================
C s1Refresh begsr
C
C exsr s1Clear
C for s1SflRRN = 1 to 50
C eval s1RecNbr = s1SflRRN
C write s1Sfl
C endfor
C
C endsr
C* ================================================
C s1Clear begsr
C
C eval s1SflDsp = false
C eval s1SflDspCtl = false
C write s1Ctl
C
C endsr
--Ted
|
Editors
Contact the Editors |
| Copyright © 1996-2008 Guild Companies, Inc. All Rights Reserved. |
PROFOUND LOGIC SOFTWARE