RPGLE Applications on the iSeries

All things RPG-ILE for the iSeries / i5 / Power System

An RPG-Free Template for Subfile Programs

leave a comment »

The DDS for the screen

Listed here are the DDS specifications used to define a typical subfile. It’s up to the developer to define the column headers and the fields used for each row of the subfile.

 
A*%%TS SD 20101216 140901 REL-V6R1M0 5761-WDS A************************************************************************** A* A* $FREEDSPF - A* A* A* MODIFICATION HISTORY A* A* MODIFIED BY DATE MODIFICATION DESCRIPTION A* ----------- -------- ------------------------------------------------ A* INITIAL RELEASE A* A************************************************************************** A* A* COMPILE USING: A* A* CRTDSPF FILE( LIB / DSPF ) SRCFILE( LIB / SRCF ) RSTDSP(*YES) A* DFRWRT(*NO) A* A************************************************************************** A*%%EC A DSPSIZ(24 80 *DS3) A PRINT(*LIBL/PRINTKEY) A ALTHELP(CA01) A CF02(02) A CF03(03) A CF04(04) A CF05(05) A CF06(06) A CF07(07) A CF08(08) A CF09(09) A CF10(10) A CF11(11) A CF12(12) A CF13(13) A CF14(14) A CF15(15) A CF16(16) A CF17(17) A CF18(18) A CF19(19) A CF20(20) A CLEAR(30) A HOME(31) A HELP(48) A* A* A************************************************************************* A* SUBFILE 01 SUBFILE DEF A************************************************************************* A R SF01SF SFL A*%%TS SD 20101216 140901 REL-V6R1M0 5761-WDS A 49 SFLNXTCHG A S1SELECT 1A B 10 3DSPATR(HI) A**************************************************************** A* SUBFILE 01 CONTROL DEF A**************************************************************** A R SF01CT SFLCTL(SF01SF) A*%%TS SD 20101216 075740 REL-V6R1M0 5761-WDS A SFLSIZ(0013) A SFLPAG(0012) A N21 ROLLUP(35) A SETOF(48) A BLINK A OVERLAY A 44 SFLDSP A 45 SFLDSPCTL A 46 SFLCLR A 21 SFLEND A C1RCDNBR 4S 0H SFLRCDNBR A* A 1 2DATE A EDTCDE(Y) A COLOR(GRN) A 1 13TIME A COLOR(GRN) A C1CONAME 33A O 1 24DSPATR(HI) A C1PGMNAME 10A O 1 60COLOR(GRN) A C1FILENAME 10A O 1 71COLOR(GRN) A C1USERID 10A O 2 2COLOR(GRN) A C1TITLE 35A O 2 23DSPATR(HI) A 2 71SYSNAME A COLOR(GRN) A* A* Filter-by A* A* A* Type Options, Press Enter A 4 2'Type option, press Enter.' A COLOR(BLU) A C1OPTIONS 78A O 5 2DSPATR(HI) A COLOR(BLU) A* A* Subfile Headings A 8 2'Sel' A* Subfile Headings A 9 2'Opt' DSPATR(UL) * A**************************************************************** A* SCREEN 01 COMMAND KEY LIST A**************************************************************** A R SF01CK A*%%TS SD 20100107 125520 REL-V6R1M0 5761-WDS A OVERLAY A S1CKLEGND 78A O 23 2 A COLOR(BLU) A* A**************************************************************** A* ERROR MESSAGE SUBFILE A* THIS IS THE ERROR MESSAGE SUBFILE RECORD. IT WILL ALWAYS BE A* USED AND ITS CONTENTS NEVER CHANGED. A**************************************************************** A R ERRMSGSF SFL A SFLMSGRCD(24) A EMSMSGKEY SFLMSGKEY A EMSPGMQUE SFLPGMQ A* A**************************************************************** A* ERROR MESSAGE SUBFILE CONTROL RECORD DEF A* THIS IS THE ERROR MESSAGE CONTROL REOCRD. IT WILL ALWAYS BE A* USED AND ITS CONTENTS NEVER CHANGED. A***************************************************************** A R ERRMSGCT SFLCTL(ERRMSGSF) A 34 PROTECT A N01 OVERLAY A 48 CSRLOC(EMSLINNBR EMSPOSNBR) A SFLDSP A SFLDSPCTL A SFLINZ A SFLSIZ(0002) A SFLPAG(0001) A 36 SFLEND A EMSPGMQUE SFLPGMQ A EMSLINNBR 3 0H A EMSPOSNBR 3 0H A**************************************************************** A***** END OF SOURCE **************************************** A****************************************************************

 

The Constants used throughout the subfile program

Below is a /copy-member to be used by the interactive programs. The member is named CPYSFCONST and contains all constants used by the template. It is referenced in the section of the RPG template labeled “Miscellaneous /copy source members”.

D/EJECT D************************************************************************** D* RECOMMENDED INDICATOR USAGE FOR DISPLAY FILES * D************************************************************************** D* * D* INDICATOR DESCRIPTION * D* ----------- ------------------------------------------------------ * D* 01 TURNS OFF THE OVERLAY WHEN WRITING MSGCT * D* 10 SUBFILE RECORD DSPATR(HI) * D* 20 SUBFILE FOLD/UNFOLD MODE * D* 21 SUBFILE 1 END AND ENABLE ROLLUP KEY * D* 22 SUBFILE 2 END AND ENABLE ROLLUP KEY * D* 23 SUBFILE 3 END AND ENABLE ROLLUP KEY * D* 24 SUBFILE 4 END AND ENABLE ROLLUP KEY * D* 25 SUBFILE 5 END AND ENABLE ROLLUP KEY * D* 26 SUBFILE 6 END AND ENABLE ROLLUP KEY * D* 30 CLEAR KEY PRESSED * D* 31 HOME KEY PRESSED * D* 32 WINDOW ERROR SUBFILE END * D* 33 PROTECT FIELD MODE * D* 34 PROTECT SCREEN MODE * D* 35 ROLLUP KEY PRESSED * D* 36 ROLLDOWN KEY PRESSED * D* 37 ERROR SUBFILE DISPLAY CONTROL RECORD * D* 38 ERROR SUBFILE DISPLAY * D* 39 ERROR SUBFILE CLEAR * D* 40 RECORD NOT FOUND * D* 41 FILE EXCEPTION/DIRECT CALL ERROR * D* 42 OUT OF LIMIT FOR SETLL/SETGT * D* 44 SUBFILE DISPLAY * D* 45 SUBFILE DISPLAY CONTROL * D* 46 SUBFILE CLEAR * D* 47 SUBFILE END AND ENABLE ROLLUP KEY * D* 48 HELP ENABLED * D* 49 SUBFILE NEXT CHANGE * D* 70 EXAMPLE ERROR INDICATOR * D* LR LAST RECORD (LOGICAL END OF PROGRAM) * D************************************************************************** D/EJECT D************************************************************************** D* Screen File Information Data Structure with constants used for D* screen navigation control D* D************************************************************************** D* DISPLAY FILE INFORMATION DATA STRUCTURE * D************************************************************************** D DSPFDS DS D DSP_SDSPFF 1 102 Display File Format D DSP_SCREENID 261 268 Screen ID D DSP_WSID 273 282 Workstation ID D* D DSP_DSPFLAG 367 368 DISPLAY FLAG D DSP_FUNCTKEY 369 369 Function Key Value D DSP_CURSOR 370 371B 0 Cursor Row and Col D DSP_SFPAGERRN 378 379B 0 Subfile Page RRN D* D DSP_FILENAME *FILE File Name D DSP_STATUS *STATUS Status code D DSP_OPCODE *OPCODE Last opcode D DSP_ROUTINE *ROUTINE RPG Routine D DSP_RECFORMAT *RECORD Record format D* D CURSORROWCOL DS D CURSOR_ROW 1 3S 0 D CURSOR_COL 1 3S 0 D************************************************************************** D/EJECT D************************************************************************** D* Function Key Constants - Attention Indicator Byte (AID). D* Function Keys F1 Through F24. These are interrogated by subr s1CmdKeys, D* to determine the appropriate program behavior. D************************************************************************** D @FK01 C CONST(X'31') D @FK02 C CONST(X'32') D @FK03 C CONST(X'33') D @FK04 C CONST(X'34') D @FK05 C CONST(X'35') D @FK06 C CONST(X'36') D @FK07 C CONST(X'37') D @FK08 C CONST(X'38') D @FK09 C CONST(X'39') D @FK10 C CONST(X'3A') D @FK11 C CONST(X'3B') D @FK12 C CONST(X'3C') D @FK13 C CONST(X'B1') D @FK14 C CONST(X'B2') D @FK15 C CONST(X'B3') D @FK16 C CONST(X'B4') D @FK17 C CONST(X'B5') D @FK18 C CONST(X'B6') D @FK19 C CONST(X'B7') D @FK20 C CONST(X'B8') D @FK21 C CONST(X'B9') D @FK22 C CONST(X'BA') D @FK23 C CONST(X'BB') D @FK24 C CONST(X'BC') * * Clear, Enter, Help, Roll Up/Down, Print D @FK_CLEAR C CONST(X'BD') D @FK_ENTER C CONST(X'F1') D @FK_HELP C CONST(X'F3') D @FK_ROLLDOWN C CONST(X'F4') D @FK_PAGEUP C CONST(X'F4') D @FK_ROLLUP C CONST(X'F5') D @FK_PAGEDOWN C CONST(X'F5') D @FK_PRINT C CONST(X'F6') D @FK_HOME C CONST(X'F8') D @NULL C CONST(X'00') D************************************************************************** D* Screen Title D************************************************************************** D @TITLE C CONST( D 'Company Name Goes Here') D/EJECT D******************************************************************** D* To control which screen is to be presented, move one of the D* generic screen names into SCREEN, which is interrogated by D* various screen controllers (subr screenController, s1CmdKeys, etc.) D* to determine which screen is to be presented to the user. D* D* In the event that screen navigation may not be incremental, ie, D* the program design does not ensure navigation will proceed from D* screen 1 through 9 and back down again, but instead may bounce D* from one to another, use PREVSCREEN to store the current screen D* before proceeding to the next screen. When the user presses F12 D* to return to the previous screen, move PREVSCREEN into SCREEN. D******************************************************************** D SCREEN S 8A SCREEN TO DISPLAY D PREVSCREEN S 8A PREVIOUS SCREEN D @PROMPT01 C CONST('PROMPT01') D @PROMPT02 C CONST('PROMPT02') D @PROMPT03 C CONST('PROMPT03') D @PROMPT04 C CONST('PROMPT04') D @PROMPT05 C CONST('PROMPT05') D @SCREEN01 C CONST('SCREEN01') D @SCREEN02 C CONST('SCREEN02') D @SCREEN03 C CONST('SCREEN03') D @SCREEN04 C CONST('SCREEN04') D @SCREEN05 C CONST('SCREEN05') D @SCREEN06 C CONST('SCREEN06') D @SCREEN07 C CONST('SCREEN07') D @SCREEN08 C CONST('SCREEN08') D @SCREEN09 C CONST('SCREEN09') D******************************************************************** D* Once within a screen's controlling logic, certain keyboard driven D* events are conveyed by constants used to determine screen behavior. D* When the user presses "Page up", "Page Down", etc, the related D* value is then moved into NEW_FUNCTION which is interrogated by D* the various screen controllers (subrs S1Init, S1Control, etc) D* to determine the next screen related action. D******************************************************************** D NEW_FUNCTION S 8A FUNCTION DIRECTIVES D @ENDPGM C CONST('ENDPGM ') D @ROLLUP C CONST('ROLLUP ') D @ROLLDOWN C CONST('ROLLDOWN') D @PREVPAGE C CONST('PREVPAGE') D @NEXTPAGE C CONST('NEXTPAGE') D @NOPAGE C CONST('NOPAGE ') D @READNEXT C CONST('READNEXT') D @CANCEL C CONST('CANCEL ') D************************************************************************** D* General Purpose Constants D************************************************************************** D @YES C CONST('Y') D @NO C CONST('N') D @MAYBE C CONST('M') D @NORECORDS C CONST('NORECORDS') D******************************************************************** D* FILE_STATE is used to govern read-oriented loops. To use, D* move *BLANKS to FILE_STATE then start read loop using D* dou FILE_STATE = @EOF. Read the file, test for EOF and when true D* move @EOF to FILE_STATE. D******************************************************************** D FILE_STATE S 8A D LOOP_CONTROL S 8A INZ(' ') D @EOF C CONST('EOF ') D @STOP C CONST('STOP ') D******************************************************************** D* DATASTATUS and FILTERSTATUS are used together to determine the D* outcome of Filter Values entered on the subfile control-record. D* D* In the event no data was found for a subfile load when no filter-by D* values where entered on the control record, DATASTATUS will contain D* @NOTFOUND D* D* In the event no data was found for a subfile load when filter-by D* values where entered on the control record, DATASTATUS will contain D* @NOTFOUND while FILTERSTATUS will contain @FILTERED. D* D* With these, the proper message to be displayed in the error message D* subfile can be determined. For example, normal page loading is D* driven by initial subfile load followed by "Page Down" directives. D* If no data is found or at EOF, DATASTATUS should be populated with D* @NORECORDS while FILTERSTATUS is populated with @NOTFILTERED. As D* a result, a simple "No data found" type of message would appear D* in the error message subfile. D* D* When filtering subfile loads using input fields on the control D* record, if no data is found or at EOF, DATASTATUS should be populated D* with @NOTFOUND while FILTERSTATUS is populated with @FILTERED. As D* a result, the message "No data found for supplied data ?data?" D* might be required. D******************************************************************** D DATASTATUS S 8A D @FOUND C CONST('FOUND ') D @NOTFOUND C CONST('NOTFOUND') D FILTERSTATUS S 8A D @FILTERED C CONST('FILTERED') D @NOTFILTERED C CONST('UNFILTRD') D/EJECT D******************************************************************** D* MISCELLANEOUS D* ACTION holds the function-key mneumonic and is populated by D* s1CommandKeys, s2CommandKeys, s3CommandKeys, etc. D* ERROR holds @YES/@NO D******************************************************************** D ACTION S 8A D ERROR S 3A D******************************************************************** D* Error Message Subfile control and parm fields. D* EMS_FUNCTION hold @CLEAR or @SEND for error message subfile mgmt. D* EMS_MSGFILE and EMS_MSGLIB are initialized in the program's *INZSR D* EMS_MSGID value is moved to this field. D* D* To clear the message file: D* EMS_FUNCTION = @CLEAR; D* exsr sendPgmMsg; D* D* To send a message: D* EMS_FUNCTION = @SEND; D* EMS_MSGID = @MKT0002; D* exsr sendPgmMsg; D* D******************************************************************** D EMS_FUNCTION S 8A D EMS_MSGFILE S 10A D EMS_MSGLIB S 10A D EMS_MSGID S 7A D EMS_MSGTEXT S 2000A D @CLEAR C CONST('CLEAR ') D @SEND C CONST('SEND ') D******************************************************************** D* SCREEN CONTROL FIELDS D******************************************************************** D ERROR_STATUS S 8A ERROR STATUS D SCREEN01_INIT S 1A D SCREEN02_INIT S 1A D SCREEN03_INIT S 1A D SCREEN04_INIT S 1A D SCREEN05_INIT S 1A D SCREEN06_INIT S 1A D SCREEN07_INIT S 1A D SCREEN08_INIT S 1A D SCREEN09_INIT S 1A D******************************************************************** D* Subfile Options and Command Key Legends D******************************************************************** D*S1OPTIONS S 77A D*S1CKLEGND S 79A D*S2OPTIONS S 77A D*S2CKLEGND S 79A D*S3OPTIONS S 77A D*S3CKLEGND S 79A D*S4OPTIONS S 77A D*S4CKLEGND S 79A D*S5OPTIONS S 77A D*S5CKLEGND S 79A D*S6OPTIONS S 77A D*S6CKLEGND S 79A D*S7OPTIONS S 77A D*S7CKLEGND S 79A D*S8OPTIONS S 77A D*S8CKLEGND S 79A D*S9OPTIONS S 77A D*S9CKLEGND S 79A D******************************************************************** D* Subfile Relative Record Number and Page Size Fields D* D* The S1PAGE type field values are static and are initialized D* during progam initialization with the value in the subfile's D* SFLPAG(nnnn) keyword in the DDS. D* D* The S1RRN fields are to be initialized with zero and are D* referenced by the WORKSTN file using SFILE(SF01SF:S1RRN). When D* the subfile is cleared, S1RRN should be reset to zero. During D* subfile loading, S1RRN is to be incremented by one for each subfile D* record written. D* D* The S1LINENBR fields are initialized differently. Subfile page D* loading is performed with a do-loop at which time S1LINE is zero. D* The do-loop is 'dou S1LINENBR = S1PAGE'. During subfile loading, D* S1LINE is incremented by one for each record written. D* D* S1RCDNBR is defined using the DDS keyword SFLRCDNBR seen on D* the subfile's control record. It is used to govern which page is D* seen after loads. To position to a page, specify that the page D* of the subfile to be displayed is the page containing the record D* whose relative record number is in this field. The default D* behavior is governed by moving S1LINE into S1RCDNBR after each load. D* D* In summary, S1PAGE is used by the program to determine if a full D* page has been loaded. S1RRN is defined on the F-Spec for the D* WORKSTN file to define the file's RRN field. It should not be used D* for anything other than for that purpose. Running parallel with D* this field is S1LINENBR which is used to control the load-loop. D* S1RCDNBR is used to control page positioning after loading. It may D* also be used to allow the user to control page positioning by D* moving the value supplied by a control record input field into D* S1RCDNBR. D* D******************************************************************** D S1RRN S 4 0 D S1PAGE S 5 0 D S1LINENBR S 5 0 D S2RRN S 4 0 D S2PAGE S 5 0 D S2LINENBR S 5 0 D S3RRN S 4 0 D S3PAGE S 5 0 D S3LINENBR S 5 0 D S4RRN S 4 0 D S4PAGE S 5 0 D S4LINENBR S 5 0 D S5RRN S 4 0 D S5PAGE S 5 0 D S5LINENBR S 5 0 D S6RRN S 4 0 D S6PAGE S 5 0 D S6LINENBR S 5 0 D S7RRN S 4 0 D S7PAGE S 5 0 D S7LINENBR S 5 0 D S8RRN S 4 0 D S8PAGE S 5 0 D S8LINENBR S 5 0 D S9RRN S 4 0 D S9PAGE S 5 0 D S9LINENBR S 5 0 D******************************************************************** D* Values seen on a subfile record's select field D******************************************************************** D @ZERO C CONST(0) D @ONE C CONST(1) D @TWO C CONST(2) D @THREE C CONST(3) D @FOUR C CONST(4) D @FIVE C CONST(5) D @SIX C CONST(6) D @SEVEN C CONST(7) D @EIGHT C CONST(8) D @NINE C CONST(9) D @ZEROa C CONST('0') D @ONEa C CONST('1') D @TWOa C CONST('2') D @THREEa C CONST('3') D @FOURa C CONST('4') D @FIVEa C CONST('5') D @SIXa C CONST('6') D @SEVENa C CONST('7') D @EIGHTa C CONST('8') D @NINEa C CONST('9') ******************************************************************** * Shared Screen Constants ******************************************************************** * Values for subfile select field D @SELECT C CONST('1') D @DELETE C CONST('4') D @WORKWITH C CONST('5') D @PRINT C CONST('P') * Command Key field values seen at bottom of screen. D @CKHELP C CONST('F1=Help') D @CKEXIT C CONST('F3=Exit') D @CKPROMPT C CONST('F4=Prompt') D @CKREFRESH C CONST('F5=Refresh') D @CKCREATE C CONST('F6=Create') D @CKADD C CONST('F6=Add') D @CKNEW C CONST('F6=New') D @CKCANCEL C CONST('F12=Cancel') D @CKPREV C CONST('F12=Previous') D @CKPRINT C CONST('F17=Print') D******************************************************************** D*** END OF CPYSFCONST COPY MEMBER ****************************** D********************************************************************

 
 

The RPG-Free Template

This is the RPG template.

 
H/TITLE - xxxxxxxxxxxxxxxxxxxxxxxxxxx H DFTACTGRP(*NO) ACTGRP(*NEW) H Option( *ShowCpy: *SrcStmt: *NoDebugIO) H BndDir('YERLIB/YERBNDDIR':'QC2LE') H DEBUG(*YES) F************************************************************************** F* P R O G R A M I N F O R M A T I O N S U M M A R Y * F************************************************************************** F* F* PROGRAM - !PgmName F* !ShortProgramDescription F* F* DATE - !Date F* F* Compile this program with: F* CRTBNDRPG PGM(!ObjLib/!PgmName) SRCFILE(!SrcLib/!SrcFile) DBGVIEW(*LIST) INDENT('| ') F* F* CRTDSPF FILE(!ObjLib/!PgmName) SRCFILE(!SrcLib/!SrcFile) RSTDSP(*YES) DFRWRT(*NO) F* F* F* PROGRAM DESCRIPTION F* ---------------------------------------------------------------------- F* !LongProgramDescription F* F************************************************************************** F* M O D I F I C A T I O N S U M M A R Y * F************************************************************************** F* F* MODIFICATION HISTORY F* F* MODIFIED BY DATE MODIFICATION DESCRIPTION F* ----------- -------- ----------------------------------------------- F* F* F* F* F************************************************************************** * Display File F!DspFile CF E WORKSTN INFDS(DSPFDS) F SFILE(SF01SF:S1RRN) F SFILE(SF02SF:S2RRN) F SFILE(SF03SF:S3RRN) F************************************************************************** F!PrimeFileIF E K DISK INFSR(*PSSR) F RENAME(!FmtName:Data) * !PrimeFileDescription ************************************************************************* * Define procedure call to external program * * If the program represented by this source member is the program * making the call, EXTPGM must have the name of the program being * called. * * Specify the parameters here ************************************************************************* D*P_0001 S like(F0001 ) D*P_0002 S like(F0002 ) D*CALL_EXTPRGM PR extpgm('PGMTOCALL') D*P_0001 15A CONST D*P_0002 5A ************************************************************************* * *ENTRY PLIST (SEE *INZSR) * If this is the program being called EXPPGM must be this program's name ************************************************************************* D*ENTRY_PLIST PR EXTPGM('THISPRGM') D* 15A CONST D* 5A D*ENTRY_PLIST PI D* P_0001 15A CONST D* P_0002 5A D************************************************************************** D* PLIST FIELDS ARE MOVED TO THESE FIELDS IN *INZSR D************************************************************************** D F0001 S 15A D************************************************************************** D* ARRAYS D************************************************************************** D* NAME DESCRIPTION D* ----------- ---------------------------------------------------------- D* SAVE_INARRY Save *IN,x into this array if needed D* SAVE_IN0110 Save *IN,01 through *IN,10 D* SAVE_IN1120 Save *IN,11 through *IN,20 D* SAVE_IN2130 Save *IN,21 through *IN,30 D* D* D************************************************************************** D SAVE_INARRY S 1 DIM(99) D SAVE_IN0110 S 1 DIM(10) D SAVE_IN1120 S 1 DIM(10) D SAVE_IN2130 S 1 DIM(10) D* S 1 DIM ( ) D* D************************************************************************** D************************************************************************** D* Miscellaneous /copy source members D************************************************************************** D************************************************************************** D* D* NAME DESCRIPTION D* ---------- ---------------------------------------------------------- D* CPYSFCONST Contains Display File INFDS in addition to constants to D* support subfile architecture D* D* MsgQueH Message Queue support D* D* PgmStsH Program status data structure. Unlike PSDS, this is a D* source-code based DS, copied into the program. This is D* is required if using MsgQueH D* D* PSDS This is a INFDS based upon an externally defined physical D* file which is used to define the DS fields. D* D* DteTimDSH Date-Time Data Structure. Populated with this proc-call: D* getTimestamp(TimeStamp:CurrentDate:CurrentTime:SysDate: D* SysTime:tsHHMMSS:tsYYYYMMDD:tsMMDDYYYY:DateNow_ISO: D* DateNow_USA); D* D* D************************************************************************** D/COPY QCOPYSRC,CPYSFCONST D/Copy QProtoSrc,MsgQueH D/COPY QProtoSrc,PgmStsH D/Copy QProtosrc,DteTimDSH D************************************************************************** D************************************************************************** D FILSTS S 5 0 D ERTYPE S 2 0 D************************************************************************** D* ERROR MESSAGE IDs (Placed into MessageID and used with MSGF) D************************************************************************** D MessageID S 7A D @MKT0001 C CONST('MKT0001') D @MKT0002 C CONST('MKT0002') D @MKT0003 C CONST('MKT0003') D @MKT9999 C CONST('MKT9999') D************************************************************************** D INCLUDE S 1A D INC_STATUS S 1A D************************************************************************** D* SUBFILE FILTER SAVE FIELDS D************************************************************************** D************************************************************************** D* SUBFILE POSITION-TO SAVE FIELDS D************************************************************************** D************************************************************************** D* STATUS CODES D************************************************************************** D @NOFLTR C CONST(' ') D************************************************************************** D* Dates D************************************************************************** D S2FFIL_USA S D DATFMT(*USA) D S2LFIL_USA S D DATFMT(*USA) /FREE /EJECT //*********************************************************************** //* * //* MAINLINE CONTROLLER * //* CALL HOUSEKEEPING ROUTINES AND DRIVE PROGRAM LOGIC. * //* * //*********************************************************************** //PERFORM ANY REQUIRED STARTUP PROCESSING, THEN PROCEED TO MAIN //PROCESSING AND FINAL SHUTDOWN PROCESSING exsr startUp; exsr screenController; exsr shutDown; //Set on LR to terminate and exit *INLR = *ON; return; /EJECT //*********************************************************************** //* * //* *INZSR - Program Initialization. Only those tasks which are to be * //* performed once during the program's run-life are to be placed here. * //* Typically, initialize static values; values which don't change when * //* called multiple times. //* * //* For example : * //* o Initialization of the Error Message Subfile values * //* o Subfile Page Size field inits * //* o Screen header values * //* o Establishing the first screen to be displayed. * //* * //*********************************************************************** BEGSR *INZSR; //************************************************** // Establish value for Error Message Control file's // SFLPGMQ keyword field, Message file and library. //************************************************** EmsPgmQue = '*'; EMS_MSGFILE = '...MSGF'; EMS_MSGLIB = '....LIB'; EMS_MSGTEXT = *BLANKS; //************************************************** // Establish values for all SnPAGE variables for // all subfiles used in the program. The values of // each must match value of each SFLPAG() keyword. //************************************************** S1PAGE = 11; //************************************************** // Using the Display File's information from its // File Information Data Structure, move the // File Name to the control record field. Use the // Program Status DS to obtain the Program Name and // the User ID for display on the screen header. //************************************************** C1FILENAME = DSP_FILENAME; // From FIDS C1PGMNAME = PGMNAM; // From Program Status DS C1USERID = PGMUSR; // From Program Status DS //************************************************** // Establish Company Name and Titles for all screens //************************************************** C1CONAME = ' Company Name Here '; C1TITLE = ' Place the Screen Title Here '; //************************************************** // Establish the first screen to display //************************************************** SCREEN01_INIT = @YES; SCREEN = @SCREEN01; ENDSR; /EJECT //*********************************************************************** //* * //* Start Up Processing - Since this program may be called from other * //* programs and can return to the caller without setting on LR, * //* process the *ENTRY parms and other processing to be performed on * //* each call here. * //* * //* List of tasks to be performed here are: * //* o Processing of *ENTRY parameters * //* o Obtaining today's date in multiple formats * //* * //*********************************************************************** BEGSR startUp; //************************************************** //* Parameter Lists //************************************************** // Move parms into working space FORMID = P_FORMID; //************************************************** // Populate the Time Stamp related data structures //************************************************** getTimestamp(TimeStamp:CurrentDate:CurrentTime:SysDate:SysTime: tsHHMMSS:tsYYYYMMDD:tsMMDDYYYY:DateNow_ISO:DateNow_USA); //************************************************** // If this program accepts parms to position a file // pointer to govern intial subfile loading, perform // the Setll here. //************************************************** setll (FORMID) PSLCBEN6; ENDSR; /EJECT //*********************************************************************** //* * //* Shutdown processing - Clean up processing, if any. * //* * //*********************************************************************** BEGSR shutDown; ENDSR; //*********************************************************************** //*********************************************************************** //* * //* SCREEN CONTROLLER * //* * //*********************************************************************** //*********************************************************************** begsr screenController; //Any one of the screen's snCmdKeys subr can stop this loop dow SCREEN @ENDPGM; select; //Screen 1 when SCREEN = @SCREEN01; exsr s1Control; //Screen 2 when SCREEN = @SCREEN02; //exsr s2Control; endsl; enddo; ENDSR; /EJECT //*********************************************************************** //* * //* Screen 1 Controller * //* * //*********************************************************************** begsr s1Control; if SCREEN01_INIT = @YES; exsr s1Init; endif; dow SCREEN = @SCREEN01; //Read and display another page of data if Rollup key pressed if NEW_FUNCTION = @ROLLUP; exsr s1Load; endif; //At this point, there can be a few errors, such as no data in //the file or, if there is a filter-by or position-to field on //the control record, nothing was found. All of these conditions //result in s1RRN being zero and so a message needs to be displayed. if s1RRN = *ZERO; ERROR = @YES; //Determine outcome of position-to or normal page load. Use this //when wanting generic "no data found" type of messaging. if DATASTATUS = @NOTFOUND and FILTERSTATUS = @NOTFILTERED; EMS_MSGID = @MKT0002; endif; //Determine outcome of filtered I/O which used control record input //Use this if you want message with context related to filtering as //opposed to generic "no data found" types of messaging. if FILTERSTATUS = @FILTERED; endif; if MessageID *BLANK; //exsr ioError; endif; endif; //send and read the screen exsr s1Display; *IN33 = *OFF; //Clear the Error Message Subfile EMS_FUNCTION = @CLEAR; exsr sendPgmMsg; //command key processor exsr s1ProcessCmdKey; //Reset screen error indicators an process screen ERROR = @NO; *IN(50) = *ALL'0'; enddo; endsr; /EJECT //*********************************************************************** //* * //* Screen 1 Initializer * //* * //*********************************************************************** begsr s1Init; //Build command key legend for display at bottom of screen. This method //makes it easier to change command keys without recompiling screen. clear S1CKLEGND; S1CKLEGND = %trim(S1CKLEGND) + @CKEXIT; S1CKLEGND = %trim(S1CKLEGND) + ' ' + @CKCANCEL; //Reset Error indicators SAVE_INARRY = *ALL'0'; ERROR = @NO; *IN(50) = *ALL'0'; S1OPTIONS = '1=Select'; //Initialize the Screen exsr s1Clear; //Direct a new page load NEW_FUNCTION = @ROLLUP; endsr; /EJECT //*********************************************************************** //* * //* Screen 1 Clear Subfile and Message Queue * //* * //* INDICATOR USAGE * //* *IN44 - SFLDSP * //* *IN45 - SFLDSPCTL * //* *IN46 - SFLCLR, ERASE(SF01SF) * //* * //*********************************************************************** begsr s1Clear; *IN44 = *OFF; *IN45 = *OFF; *IN46 = *ON; write SF01CT; s1RRN = 0; ClearMsgQue(); endsr; //*********************************************************************** //* * //* Screen 1 Load * //* * //*********************************************************************** begsr s1LOAD; //Initialize subfile and error indicators *IN49 = *OFF; *IN51 = *OFF; *IN93 = *OFF; *IN21 = *OFF; //Initialize subfile control processing variables S1SELECT = *BLANKS; S1LINENBR = *ZERO; //************************************************** // Load Subfile until end of file or full screen //************************************************** LOOP_CONTROL = *BLANKS; dou ( (S1LINENBR = S1PAGE) or %eof(PSLCBEN6) or LOOP_CONTROL = @STOP); reade (FORMID) !PrimeFile; if %eof(!PrimeFile); //At EOF. Show+/Disable Rollup [ 21,SFLEND N21,ROLLUP(35) ] *IN21 = *ON; NEW_FUNCTION = *BLANKS; else; //If required place logic to stop the read loop here by moving //@STOP to LOOP_CONTROL //LOOP_CONTROL = @STOP; if LOOP_CONTROL @STOP; //Move data from !PrimeFile into subfile fields //PrimeFieldsToSubfile //For every record written increment s1RRN which is SFLRCDNBR //( used to control page positioning) and the LINE NO field.. S1RRN = S1RRN + @ONE; S1LINENBR = S1LINENBR + @ONE; write SF01SF; endif; endif; enddo; //************************************************** // If no records were written as a result of no data // in the file, write message to error message subfile //************************************************** if S1LINENBR = 0; EMS_FUNCTION = @SEND; EMS_MSGID = @MKT0002; exsr sendPgmMsg; ENDIF; //************************************************** // INITIALIZE SFLRCDNBR TO POSITION THE SUBFILE TO // THE FIRST PAGE OR ANY OTHER PAGE REQUIRED. //************************************************** if S1RRN > *ZERO; S1RCDNBR = S1RRN; endif; NEW_FUNCTION = *BLANKS; endsr; /EJECT //*********************************************************************** //* * //* s1Display - SCREEN 1 DISPLAY * //* * //* INDICATOR USAGE * //* *IN44 - SFLDSP * //* *IN45 - SFLDSPCTL * //* *IN46 - SFLCLR, ERASE(SF01SF) * //* * //*********************************************************************** begsr s1Display; if s1RRN > *ZERO; *IN44 = *ON; *IN45 = *ON; *IN46 = *OFF; else; *IN44 = *OFF; *IN45 = *ON; *IN46 = *ON; endif; //Display error message subfile //exsr sendPgmMsg; write ERRMSGCT; //Display screen write SF01CT; //Control Record write SF01CK; //Command Keys record format read SF01CT; //Clear Error Message Subfile ClearMsgQue(); write ERRMSGCT; ERROR = @NO; endsr; /EJECT //*********************************************************************** //* * //* SCREEN 1 FUNCTION KEY PROCESSOR * //* * //*********************************************************************** begsr s1ProcessCmdKey; NEW_FUNCTION = *BLANKS; select; //EXIT when DSP_FUNCTKEY = @FK03; SCREEN = @ENDPGM; //Prompt (noop example) when DSP_FUNCTKEY = @FK04; EMS_MSGID = @MKT0001; ERROR = @YES; //exsr ioError; //CREATE / ADD / NEW when DSP_FUNCTKEY = @FK06; //RETURN TO PREVIOUS SCREEN. If this is the first screen, then //move @ENDPGM into SCREEN to exit the program. If not, then //move @SCREEN02, @SCREEN01, etc, into SCREEN to redirect. when DSP_FUNCTKEY = @FK12; SCREEN = @ENDPGM; //@FK_PAGEUP is same as @FK_ROLLDOWN (X'F4') when DSP_FUNCTKEY = @FK_PAGEUP; NEW_FUNCTION = @ROLLDOWN; //@FK_PAGEDOWN is same as @FK_ROLLUP (X'F5') when DSP_FUNCTKEY = @FK_PAGEDOWN; NEW_FUNCTION = @ROLLUP; other; //ENTER exsr s1ProcessEnterKey; endsl; endsr; /EJECT //*********************************************************************** //* * //* SCREEN 1 ENTER KEY PROCESSOR * //* * //*********************************************************************** begsr s1ProcessEnterKey; ERROR = @NO; //Validate values entered on control record //if S1PFORM = *BLANKS; // ERROR = @NO; //endif; //If no error process if ERROR = @NO; //If the Filter-by fields have changed, move them to save fields //Initialize the screen via s1Init //Reset file's pointer to top via SETLL //Load subfile //exsr s1Load; //Read Subfile records for any selects exsr s1Read; endif; endsr; /EJECT //*********************************************************************** //* * //* SCREEN 1 SUBFILE READER * //* * //*********************************************************************** begsr s1Read; FILE_STATE = *BLANKS; dou FILE_STATE = @EOF; readc SF01SF; if not %EOF; //Check s1Select values and process select; when s1Select = @SELECT; //SCREEN = @SCREEN02; //s2Init = @YES; //If required, move the subfile's value to the return //parm field passed from the caller, turn on *LR and exit. P_0002 = S1Field; *INLR = *ON; RETURN; when s1Select = @DELETE; when s1Select = @PRINT; other; //Invalid entry EMS_FUNCTION = @SEND; EMS_MSGID = @MKT0001; exsr sendPgmMsg; EMS_FUNCTION = @SEND; EMS_MSGID = @MKT0002; exsr sendPgmMsg; endsl; s1Select = *BLANKS; *IN49 = *ON; //SFLNXTCHG //S1RRN NOW REFLECTS THE ADDRESS OF THE SELECTED SUBFILE RECORD //IT MUST BE REPLACED WITH THE RRN OF THE LAST WRITTEN RECORD //FOR THE SUBFILE. S1RRN = S1RCDNBR; update SF01SF; else; FILE_STATE = @EOF; endif; enddo; endsr; /EJECT //*********************************************************************** //* * //* Send a program-defined message to the error message subfile * //* * //*********************************************************************** begsr sendPgmMsg; select; when EMS_FUNCTION = @CLEAR; ClearMsgQue(); when EMS_FUNCTION = @SEND; PutMsgOnQue( EMS_MSGFILE : EMS_MSGLIB : EMS_MSGID : CompMsgTyp: EMS_MSGTEXT : CurrMsgStk : CurrMsgQue); ENDSL; endsr; /EJECT //*********************************************************************** //*********************************************************************** //************* END OF SOURCE PROGRAM LIST **************** //*********************************************************************** //***********************************************************************

Written by iseriesadmin

August 5, 2012 at 4:49 pm

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Follow

Get every new post delivered to your Inbox.

%d bloggers like this: