I have written the below expandable subfile program where there seems to be an issue that causes it to not work properly once the Position to feature is used to position to a particular record. Once the display is positioned to a particular record, the program does not seem to detect Pagedown/Page up key presses anymore. No clue why. If the position to feature is not used, the paging works as expected. I don't think that the Display file DDS has an issue and hence not posting it.
HOPTION(*NODEBUGIO)
FSFLTBL IF E K DISK Rename(SFLTBL:SFLTBLR)
FSFLDSPF CF E WorkStn SFILE(SFLRCD:RRN1)
F INFDS(INFO)
DInfo DS
DCfKey 369 369
DExit C Const(X'33')
DCancel C Const(X'3C')
DEnter C Const(X'F1')
DRollUp C Const(X'F5')
DSflPag C Const(15)
DLstRrn S 4 0 Inz(0)
DI S 4 0 Inz(0)
/Free
Exsr Clear_Subfile;
Exsr Build_Subfile;
Dou (*Inkc or *InKl);
Write Footer;
Exfmt SFLCTLRCD;
Select;
When (CfKey = Enter and Ptname <> *Blanks);
Setll (PtName) Sfltbl;
Exsr Clear_Subfile;
Exsr Build_Subfile;
Clear PtName;
When (CfKey = Rollup and Not *In32);
Exsr Build_Subfile;
EndSl;
EndDo;
*Inlr = *On;
BegSr Clear_Subfile;
Rrn1 = *Zero;
LstRrn = *Zero;
*In31 = *On;
Write SFLCTLRCD;
*In32 = *Off;
*In31 = *Off;
*In90 = *Off;
EndSr;
BegSr Build_Subfile;
Rrn1 = LstRrn;
For i = 1 to SflPag;
Read Sfltblr;
If %Eof();
*In90 = *On;
Leave;
Else;
Rrn1 += 1;
Write SFLRCD;
EndIf;
EndFor;
If (Rrn1 > 0);
*In32 = *Off;
EndIf;
LstRrn = Rrn1;
EndSr;
/End-Free
DSPF DDS below:
A*%%TS SD 20170914 151431 THEJU112 REL-V5R3M0 5722-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A PRINT
A ERRSFL
A CA03
A CA12
A R SFLRCD SFL
A FNAME R O 5 2REFFLD(SFLTBL/FNAME *LIBL/SFLTBL)
A MNAME R O 5 24REFFLD(SFLTBL/FNAME *LIBL/SFLTBL)
A LNAME R O 5 46REFFLD(SFLTBL/FNAME *LIBL/SFLTBL)
A R SFLCTLRCD SFLCTL(SFLRCD)
A*%%TS SD 20170914 151431 THEJU112 REL-V5R3M0 5722-WDS
A SFLSIZ(0016)
A SFLPAG(0015)
A OVERLAY
A N32 SFLDSP
A N31 SFLDSPCTL
A 31 SFLCLR
A 90 SFLEND(*SCRBAR *SCRBAR)
A ALARM
A ROLLUP
A RRN1 4S 0H SFLRCDNBR
A 1 2USER
A 1 69DATE
A EDTCDE(Y)
A 2 69TIME
A 4 5'FIRST NAME'
A COLOR(BLU)
A DSPATR(UL)
A DSPATR(RI)
A 4 28'MIDDLE NAME'
A COLOR(BLU)
A DSPATR(UL)
A DSPATR(RI)
A 4 49'LAST NAME'
A COLOR(BLU)
A DSPATR(UL)
A DSPATR(RI)
A 1 24'EXPANDABLE SUBFILE'
A COLOR(RED)
A 3 6'Position To...'
A PTNAME 20 I 3 21
A R FOOTER
A 23 2'F3 = Exit'
A 23 16'F12 = Previous'
I think that part of your problem is that SFLRCDNBR
is set to the same field that is used for the relative record number for subfile IO operations RRN1
. So no matter what you do, when Enter
or Page Down
is pressed, the subfile will always reposition to the last record written to SFLRCD
.
Ok, that's one issue, but here is another issue:
When (CfKey = Enter and Ptname <> *Blanks);
Setll (PtName) Sfltbl;
Exsr Clear_Subfile;
Exsr Build_Subfile;
Clear PtName;
When you position the subfile on Ptname
, you are clearing out the subfile, so there is nothing to roll back to. instead of clearing the subfile, you should read through the subfile until you find the correct record, and then set the SFLRCDNBR
field to that value. You may also want to specify SFLRCDNBR(*TOP)
in your DDS, and ensure that you have a full page in the subfile after that record.
Note: SFLRCDNBR
can at times be a bit difficult to handle as it can not use conditioning indicators, and may not be an invalid value (i.e. it must have a value between 1 and the number of records in the subfile). So on every write to the subfile control format you need to know exactly which record needs to be the first subfile record on the display (If you are using *TOP
), or at least one of the records on the display.
You can use a sub-procedure to locate a record in a loaded subfile. Subfile records can be read with a CHAIN rrn
where rrn is a relative record number. So as long as I know how many records I have written to the subfile, I can loop through them with a for
loop. Once I have found the record I am searching for, I return from the procedure and pass back the record number that I just read. That will be the relative record number of the record I found in the subfile.
dcl-proc FindNameInSubfile;
dcl-pi *n Int(5)
PtName Char(20) const;
end-pi;
dcl-ds sflds LikeRec(sflrcd: *input) Inz;
dcl-s ix Int(5) Inz(0);
for ix = 1 to maxrrn;
chain ix sflrcd sflds;
if sflds.lastname = PtName;
return ix;
endif;
endfor;
return -1;
end-proc;
This sub-procedure returns -1 if the subfile record is not found. To use this to set sflrcdnbr
you would want to do something like this:
When (CfKey = Enter and Ptname <> *Blanks);
sflrrn = FindNameInSubfile(Ptname);
if sflrrn > 0;
sflrcdnbr = sflrrn;
endif;
Ptname = '';
Note, sflrrn
is a new work field defined as Int(5)
, and sflrcdnbr
is a new field (not RRN1) that is attached to the SFLRCDNBR
DDS keyword.