This is an example of a multi-page file maintenance function using sub-files. Records can be added, amended or displayed or removed one at a time, or directly in the list. The fold capabilities of a sub-file are also illustrated here.
The short video clip gives a quick overview of the example program.
/TITLE TPL015A - TEMPLATE - MULTI PAGE MAINTENANCE SUBFILE h debug option(*srcstmt:*nodebugio) fTPLPF uf a e k disk fTPLD015A cf e workstn infds(dsinf) f sfile(dsp01:rrn) //------------------------------------------------------------------------- // Data Structures //------------------------------------------------------------------------- // Program status d d@status sds 333 d d_pgm *proc d d_parms *parms d d_sttype *status d d_ErrorStatus 209 213 d d_WsId 244 253a d d_#user 254 263a // Screen file INFDS d dsinf ds d d_stat *status d d_label 261 270 d d_fkey 369 369A d d_cursor 370 371b 0 d d_sfllin 378 379b 0 //------------------------------------------------------------------------- // function key definitions (named constants). //------------------------------------------------------------------------- d exit c const(x'33') d create c const(x'36') d cancel c const(x'3C') d enter c const(x'F1') d help c const(x'F3') d pageup c const(x'F4') d pagedn c const(x'F5') d print c const(x'F6') // SFL work Variables d rrn s 9 0 d rrnhld s 9 0 d updflg s 1 d loadct s 1s 0 d lastrec s 10s 0 d frstrec s 10s 0 //-------------------------------------------------------------- // Indicator Mapping (Naming) //-------------------------------------------------------------- d Indicator s * inz(%ADDR(*IN)) d Indstruct ds based(Indicator) d sfldsp 50 50 d sfldspctl 51 51 d sflclr 52 52 d sflnxtchg 53 53 d sflerror 54 54 d sflend 55 55 d msgsflend 59 59 d s_protect 60 60 /free setll *loval TPLPF; read TPLPF; exsr loadsubfile; sflrcd = 1; *in57 = *on; // Initially display the subfile in "drop" mode write dsp02; // Initial display read dsp02; dow d_fkey <> exit; if csrloc <> 0; // keep the cursor in the same position sflrcd = csrloc; endif; exsr response; // Process user response *in57 = sflmd; // Remember whether the subfile is in "drop" or "fold" mode write dsp02; // Re-display read dsp02; enddo; *inLR = *on; Return; //----------------------------------------------------------------------------------------- // loadsubfile - Load the sub-file //----------------------------------------------------------------------------------------- begsr loadsubfile; // Clear the sub-file sflclr = *off; sfldsp = *off; sfldspctl = *off; write dsp02; sflclr = *on; // Enable the display of the sub-file sfldsp = *on; sfldspctl = *on; rrn = 0; // RRN holds the current number of records in the sub-file rrnhld = 0; loadct = 0; frstrec= TPCUST; write footer1; dow not %eof and rrn < 8; // Load until file empty or max reached d1pick = ' '; // record selection field D1CUST = TPCUST; D1NAME = TPNAME; D1TELNO = TPTELNO; D1EMAIL = TPEMAIL; D1NOTES = TPNOTES; loadct = loadct + 1; // file position rrn = rrn + 1; // file position write dsp01; lastrec= TPCUST; read TPLPF; // read next record sflend = %eof; // sflend is mapped to indicator 55 in DSPF enddo; if rrn = *zero; sfldsp = *off; write empty; // Display message when sub-file is empty endif; write footer1; // Write footer to display record; endsr; //----------------------------------------------------------------------------------------- // response - Process responses to subfile //----------------------------------------------------------------------------------------- begsr response; if d_fkey = create; exsr AddRec; // Add a record Else; if *in25 = *on or // Rollup pressed? *in26 = *on; // Rolldown pressed? if *in26 = *on; exsr backup; else; *in91 = *off; setgt lastrec TPLPF; read TPLPF; endif; exsr loadsubfile; else; updflg = *off; // Conditions re-build of sub-file readc dsp01; // Retrieve selected record dow not %eof; if *in27 = *on; exsr changedirect; // Change direct on screen elseif d1pick = '2'; exsr changerec; // Change a record elseif d1pick = '4'; exsr deleterec; // Delete a record elseif d1pick = '5'; exsr displayrec; // Display a record endif; readc dsp01; // Get next selected record enddo; endif; endif; if updflg = *on; // If an update has taken place setll frstrec TPLPF; read TPLPF; exsr loadsubfile; endif; endsr; //----------------------------------------------------------------------------------------- // changedirect - //----------------------------------------------------------------------------------------- begsr changedirect; chain d1cust TPLPF; if %found; TPNAME = D1NAME; TPTELNO = D1TELNO; TPEMAIL = D1EMAIL; TPNOTES = D1NOTES; update TPLPFR; update dsp01; // update sub-file updflg = *on; endif; endsr; //----------------------------------------------------------------------------------------- // backup - Go back one page //----------------------------------------------------------------------------------------- begsr backup; setll frstrec TPLPF; loadct = 0; dow not %eof and loadct < 9; Readp TPLPF; loadct +=1; enddo; if %eof; Setll *loval TPLPF; endif; read TPLPF; endsr; //----------------------------------------------------------------------------------------- // changerec - Process change request //----------------------------------------------------------------------------------------- begsr changerec; chain D1CUST TPLPF; // Retrieve selected record if %found; W2CUST = TPCUST; // Load information to be changed W2NAME = TPNAME; W2TELNO = TPTELNO; W2EMAIL = TPEMAIL; W2NOTES = TPNOTES; Exfmt Window2; // Display Window and accept changes If d_fkey = Enter; // If enter pressed then update record TPCUST = W2CUST; TPNAME = W2NAME; TPTELNO = W2TELNO; TPEMAIL = W2EMAIL; TPNOTES = W2NOTES; update TPLPFR; update dsp01; // update sub-file updflg = *on; endif; endif; endsr; //----------------------------------------------------------------------------------------- // DeleteRec - Process delete request //----------------------------------------------------------------------------------------- begsr deleterec; Chain D1CUST TPLPF; // Retrieve record selected for deletion if %found; W3CUST = TPCUST; W3NAME = TPNAME; exfmt window3; // Prompt for confirmation of deletion if d_fkey = enter; // Enter pressed to confirm deletion of record delete TPLPFR; update dsp01; updflg = *on; sflrcd = 1; // reposition to top endif; endif; endsr; //----------------------------------------------------------------------------------------- // displayrec - Process display request //----------------------------------------------------------------------------------------- begsr displayrec; chain D1CUST TPLPF; // Retrieve record selected for display if %found; W2CUST = TPCUST; // Load information to be changed W2NAME = TPNAME; W2TELNO = TPTELNO; W2EMAIL = TPEMAIL; W2NOTES = TPNOTES; s_protect = *on; exfmt window2; s_protect = *off; endif; endsr; //----------------------------------------------------------------------------------------- // AddRec - Process add request //----------------------------------------------------------------------------------------- begsr addrec; W2CUST = 0; W2NAME = ' '; W2TELNO = ' '; W2EMAIL = ' '; W2NOTES = ' '; dou updflg = *on or d_fkey = cancel; exfmt window2; // Accept new details if d_fkey = enter; // Validate .... chain W2CUST TPLPF; // Check for duplicate key if %found; // duplicate!!! exfmt window2b; // Error message else; TPCUST = W2CUST; TPNAME = W2NAME; TPTELNO = W2TELNO; TPEMAIL = W2EMAIL; TPNOTES = W2NOTES; write TPLPFR; // add new record updflg = *on; endif; endif; enddo; endsr; /end-free ================================================== DISPLAY FILE ==================================================
A*%%TS SD 20180608 142515 NIGEL REL-V7R3M0 5770-WDS A*%%EC A DSPSIZ(27 132 *DS4) A PRINT A CF03 A CF06 A* Sub-file record A R DSP01 SFL A*%%TS SD 20180608 142515 NIGEL REL-V7R3M0 5770-WDS A D1PICK 1A B 8 2 A D1CUST 10S 0O 8 4 A D1NAME 40A B 8 16CHANGE(27) A CHECK(LC) A D1TELNO 20A B 8 58CHANGE(27) A CHECK(LC) A D1EMAIL 50A B 8 80CHANGE(27) A CHECK(LC) A D1NOTES 100A B 9 16CHANGE(27) A CHECK(LC) A 10 1' ' A* Sub-file control A R DSP02 SFLCTL(DSP01) A*%%TS SD 20180608 142354 NIGEL REL-V7R3M0 5770-WDS A SFLSIZ(0009) A SFLPAG(0003) A 57 SFLDROP(CF11) A N57 SFLFOLD(CF11) A N55 ROLLUP(25) A N56 ROLLDOWN(26) A OVERLAY A 50 SFLDSP A 51 SFLDSPCTL A N52 SFLCLR A SFLMODE(&SFLMD) A SFLCSRRRN(&CSRLOC) A**55 SFLEND A* Sub-file header A SFLMD 1A H A CSRLOC 5S 0H A SFLRCD 4S 0H SFLRCDNBR(CURSOR) A 1 53'Work with customers' A 1 2USER A 1119DATE A EDTCDE(Y) A 4 3'2=Change' A 4 15'4=Delete' A 4 26'5=Display' A 6 4'Customer' A 6 16'Customer name' A 6 58'Telephone' A 6 80'Email' A R FOOTER1 A*%%TS SD 20180608 140032 NIGEL REL-V7R3M0 5770-WDS A OVERLAY A 22 2'==================================- A ===================================- A ===================================- A ==========================' A 23 4'F3=Exit' A 23 14'F6=Create' A 23 26'F11=Fold' A R EMPTY A OVERLAY A 9 4'No records found' A R WINDOW2 A*%%TS SD 20180608 140032 NIGEL REL-V7R3M0 5770-WDS A WINDOW(8 5 12 72) A CF12 A WDWBORDER((*COLOR RED) (*DSPATR HI - A RI) (*CHAR ' ')) A N60 1 13'Change Record' A 60 1 13'Display Record' A 3 3'Customer:' A W2CUST 10S 0B 3 17CHECK(RB) A 60 DSPATR(PR) A 4 3'Customer name' A W2NAME 40A B 4 17 A CHECK(LC) A 60 DSPATR(PR) A 5 3'Telephone:' A W2TELNO 20A B 5 17 A CHECK(LC) A 60 DSPATR(PR) A 6 3'Email:' A W2EMAIL 50A B 6 17 A CHECK(LC) A 60 DSPATR(PR) A 7 3'Notes:' A W2NOTES 100A B 7 17CNTFLD(50) A CHECK(LC) A 60 DSPATR(PR) A 10 3'F12=Cancel' A DSPATR(HI) A R WINDOW2B A*%%TS SD 20090526 120821 TARGET REL-V6R1M0 5761-WDS A WINDOW(8 5 12 62) A WDWBORDER((*COLOR RED) (*DSPATR HI - A RI) (*CHAR ' ')) A 1 13'Duplicate Key' A 3 3'Customer:' A W2CUST 10S 0O 3 17 A 5 3'Press Enter to Continue' A DSPATR(HI) A R WINDOW3 A*%%TS SD 20090526 120821 TARGET REL-V6R1M0 5761-WDS A WINDOW(8 5 12 62) A CF12 A WDWBORDER((*COLOR RED) (*DSPATR HI - A RI) (*CHAR ' ')) A 1 13'Delete Record' A 3 3'Customer:' A W3CUST 10S 0O 3 20 A 4 3'Customer name:' A W3NAME 40A O 4 20 A 5 3'Press Enter to confirm delete' A 10 3'F12=Cancel' A DSPATR(HI)
================================================== TABLE ==================================================
A R TPLPFR
A TPCUST 10S 0 COLHDG('Customer Nr.')
A TPNAME 40 COLHDG('Customer name')
A TPTELNO 20 COLHDG('Telephone')
A TPEMAIL 50 COLHDG('Email')
A TPNOTES 100 COLHDG('Notes')
A K TPCUST