SoftCode Applications Model
SoftCode Application Example
SoftCode Interactive ILE Model
The following is an actual program designed with the Soft Code functions in place. The program is a typical 5250 sub-file display program—except it doesn’t contain a database file. And, the function keys are not defined in the display. And the program options are contained in a separate database file. And the prompt is a text-driven, dynamically sized window. And the help process is external to the program—other than those oddities it is a typical interactive ILE program.
**FREE
ctl-Opt DEBUG(*YES) OPTION(*SRCSTMT : *NODEBUGIO)
DFTACTGRP(*NO) ACTGRP('QILE') Main(NC0320RP)
BNDDIR('QC2LE':'SC0000_BD') ;
//******************************************************************
// Program Name - SC0320RP *
// *
// Function - This program was designed as a workbench for *
// working with SoftCode objects *
// *
// Programmer - Steve Croy 09/03/09 *
//******************************************************************
//------------ File section -----------------------------------------
Dcl-F SC0320DF WORKSTN UsrOpn
SFILE(SC0320S1:RRNSI)
INFDS(DSPDS) ;
//------------ Data Structures --------------------------------------
/copy qrpglesrc,SCMAPS_pr [1]
Dcl-DS functionkey extname('SCKEYSPF') qualified end-DS;
Dcl-DS OBJECT extname('SCOBJSPF') end-DS;
Dcl-DS before extname('SCOBJSPF') qualified end-DS;
Dcl-DS after extname('SCOBJSPF') qualified end-DS;
// Default cursor position
Dcl-DS #DFPOS INZ ;
#DFROW packed(2:0) INZ(8) ;
#DFCOL packed(3:0) INZ(17);
End-DS ;
// Default message file
Dcl-DS dftPgmMsgF ;
dftMsglib char(10) INZ('*LIBL') ;
dftMsgFile Char(10) INZ('SCMSSGF');
End-DS ;
//------------ Procedure Prototypes ---------------------------------
/copy qrpglesrc,SC0000_pr
/copy qrpglesrc,SC0320_pr
//------------ Define constants -------------------------------------
Dcl-C #TITLE CONST('** Work With Objects List **') ;
//------------ Define Global Variables ------------------------------
Dcl-S dtaPtr pointer inz( %addr(object));
Dcl-S indPtr pointer inz( %addr(*in) ) ;
Dcl-DS indicators len(99) based( indPtr ) ;
ScreenChange ind pos(22) ;
SflControl ind pos(50) ;
SflDisplay ind pos(51) ;
SflInitialize ind pos(52) ;
SflClear ind pos(53) ;
SflEnd ind pos(54) ;
SflDelete ind Pos(55) ;
SflNxtChange ind pos(58) ;
SflMSGQdisplay ind pos(59) ;
End-DS ;
Dcl-S ErrorOccurred ind ;
Dcl-S listAction ind ;
Dcl-S MessageToDisplay ind ;
Dcl-S MoreRecordsRemain ind ;
Dcl-S NoMoreRecords ind ;
Dcl-S objectFound ind ;
Dcl-S authl char(3) inz('999') ;
Dcl-S CMDKEY char(720) ;
Dcl-S dspatr char(1) ;
Dcl-S FKEYDS char(1) ;
Dcl-S fmt char(10) inz('BEGIN');
Dcl-S INDLR char(1) ;
Dcl-S Keyidx char(2) ;
Dcl-S MorOpt char(1) ;
Dcl-S MSG char(80) ;
Dcl-S MSGDTA char(132) ;
Dcl-S MSGF char(10) ;
Dcl-S MSGPGM char(10) ;
Dcl-S MSGRLQ char(5) ;
Dcl-S optIdx char(2) ;
Dcl-S OPTION char(720) ;
Dcl-S p$err char(7) ;
Dcl-S p$mod char(1) ;
Dcl-S p$mode char(1) ;
Dcl-S parm01 char(10) ;
Dcl-S parm02 char(10) ;
Dcl-S passc char(1) ;
Dcl-S promptDta char(256) ;
Dcl-S orderBy char(256) ;
Dcl-S selectOnly char(256) ;
Dcl-S thisOption char(10) ;
Dcl-S thisFormat char(10) ;
Dcl-S thisPgm char(10) inz('SC0320RP');
Dcl-S typatr char(1) ;
Dcl-S UsrNam char(10) ;
Dcl-S CATEG zoned(3:0) inz(500) ; [2]
Dcl-S CL zoned(3:0) ;
Dcl-S dtaSize int(10) inz( %size(object));
Dcl-S M zoned(3:0) ;
Dcl-S O zoned(3:0) ;
Dcl-S RCDNBR int(5) INZ(1) ;
Dcl-S RRNSI binDec(4) ;
Dcl-S RW zoned(3:0) ;
Dcl-S SAVRRN binDec(4) ;
Dcl-S SFLLOD binDec(4) ;
Dcl-S SFLMAX binDec(4) INZ(12) ;
Dcl-S SFLPOS binDec(4) ;
Dcl-S SFLRCN binDec(4) ;
//------------ End of work fields -----------------------------------
Dcl-Proc SC0320RP ;
Dcl-PI SC0320RP extPgm('SC0320RP') ;
END-PI;
CheckAuthority(USER:THISPGM:CATEG:PASSC:AUTHL); [3]
IF PASSC <> 'P';
QUIT();
ENDIF;
If not %open(SC0320DF);
OPEN SC0320DF ;
ENDIF;
z$seq1 = #TITLE;
functionKey = FunctionKeys(); [4]
getMessage('MIS0001');
FilterSelect ( zfcat: zfseq: zfobj: zftyp: zfdsc: zfsts: 'GET');
resetDisplay();
DOU keyPressed = functionKey.F3;
IF MessageToDisplay;
SflMSGQdisplay = *ON;
ELSE;
SflMSGQdisplay = *OFF;
ENDIF;
WRITE SC0320C2 ; // write subfile message queue
IF ScreenChange;
#ROW = #DFROW;
#COL = #DFCOL;
ENDIF;
rrnsi = 0 ;
sflControl = *ON ; // Set subfile control on
IF sflrcn > 0 ; // and if records were loaded
sflDisplay = *ON ; // turn on subfile display
ENDIF ;
WRITE SC032001;
EXFMT SC0320C1;
sflControl = *OFF;
sflDisplay = *OFF;
getCsrLoc(ROW:COL:rw:cl);
#ROW = rw;
#COL = cl;
IF MessageToDisplay;
RmvMessage(prgnam); [5]
MessageToDisplay = *OFF;
ENDIF;
ThisFormat = fmtnam;
GetFunction(thisPgm:thisFormat:keypressed:fkeyid:macro:authl); [6]
SELECT;
WHEN KeyPressed = functionKey.ENTER;
processChanges();
READ SC032001;
If ScreenChange ;
resetDisplay() ;
ENDIF;
WHEN KeyPressed = functionKey.ROLLUP;
loadSubfile();
WHEN KeyPressed = functionKey.ROLLDN;
pageDown();
WHEN KeyPressed = functionKey.F23;
DisplayOptions(option: z$opt1: z$opt2: O); [7]
WHEN KeyPressed = functionKey.F24;
DisplayKeys(cmdkey: z$key1: z$key2: M); [8]
WHEN Function = 'EXIT';
QUIT();
WHEN Function = 'CANCEL';
EXSR returnToCaller;
WHEN Function = 'RESET';
resetDisplay();
WHEN Function = 'PROMPT';
READ SC032001;
displayPrompt(rtnFld) ;
resetDisplay();
WHEN Function = 'HELP';
HelpText(ThisPgm:fmt);
WHEN SUBOP = 'CALL';
callProgram();
WHEN Function = 'CMDLINE';
CommandLine();
ENDSL;
CLEAR macro;
ENDDO;
//*----------------------------------------------------------------
BEGSR returnToCaller;
If %open(SC0320DF) ;
CLOSE SC0320DF ;
ENDIF ;
ErrorOccurred = CloseObjectCursor() ;
*inlr = *on ;
return ;
ENDSR;
End-Proc NC0320RP ;
//*================================================================
Dcl-Proc resetDisplay;
Dcl-PI resetDisplay end-PI;
rrnsi = 1;
rcdnbr = 1;
sflrcn = 0;
sflpos = 0;
SflInitialize = *ON;
WRITE SC0320C1;
SflInitialize = *OFF;
SflEnd = *OFF;
ThisFormat = fmtnam;
m = 0;
o = 0;
usrnam = user;
reset dftPgmMsgF ;
GetKeyText(thisPgm:thisFormat:cmdkey:authl); [9]
GetOptText(thisPgm:thisFormat: option: authl); [10]
DisplayKeys(cmdkey: z$key1: z$key2: M); [11]
DisplayOptions(option: z$opt1: z$opt2: O); [12]
// Format the SQL request ...
FormatSQL ( zfcat: zfseq: zfobj: zftyp: zfdsc: zfsts:
SelectOnly: orderBy);
CloseObjectCursor();
ClearObject();
SetObjectCursor(orderby: selectOnly);
FilterSelect ( zfcat: zfseq: zfobj: zftyp: zfdsc: zfsts: 'SET');
loadSubfile() ;
Return ;
END-Proc resetDisplay ;
//*================================================================
Dcl-Proc pageDown;
Dcl-PI pageDown end-PI;
Z$RRN2 = Z$rrn2 - SFLMAX;
SFLPOS = (SFLPOS - SFLMAX);
IF SFLPOS < 1;
SFLPOS = sflmax;
ENDIF;
IF Z$RRN2 < 1;
Z$RRN2 = 1;
getMessage('MIS0006');
ENDIF;
Return ;
END-Proc pageDown ;
//*================================================================
Dcl-Proc loadSubfile;
Dcl-PI loadSubfile end-PI;
sfllod = 0;
savrrn = z$rrn2;
SflEnd = *OFF;
NoMoreRecords = *OFF;
DOU NoMoreRecords or sfllod >= sflmax;
MoreRecordsRemain = NextObject();
IF MoreRecordsRemain;
OBJECT = GetObjectData();
sflrcn = sflrcn + 1;
sfllod = sfllod + 1;
RRNSI = SFLRCN;
Z$RRN1 =SFLRCN;
z$opt = *BLANKS;
z$desc = exdesc;
zfstat = *blanks;
SELECT; [13]
WHEN exproc = 'Y';
dspatr = SetColor('BLU');
typatr = SetColor('WHT');
zfstat = dspatr + 'Revised';
WHEN exproc = 'E';
dspatr = SetColor('YLW');
typatr = SetColor('WHT');
zfstat = dspatr + 'Review';
WHEN exproc = 'X';
dspatr = SetColor('GRN');
typatr = SetColor('GRN');
zfstat = dspatr + 'Tested';
WHEN exproc = 'N';
dspatr = SetColor('GRN');
typatr = SetColor('GRN');
zfstat = dspatr + 'Pending';
WHEN exproc = 'O';
dspatr = SetColor('RED');
typatr = SetColor('RED');
zfstat = dspatr + 'Obsolete';
OTHER;
dspatr = SetColor('GRN');
typatr = SetColor('GRN');
zfstat = dspatr + 'Undefined';
ENDSL;
zfobnm = dspatr + exobnm + typatr + exobtp;
WRITE SC0320S1;
ELSE ;
Sflend = *ON;
NoMoreRecords = *ON;
ENDIF;
ENDDO;
sflpos = sflpos + sflmax;
z$rrn2 = (sflpos - sflmax) + 1;
IF z$rrn2 > sflrcn;
sflpos = sflpos - sflmax;
z$rrn2 = savrrn;
getMessage('MIS0007');
ENDIF;
Return ;
END-Proc loadSubfile ;
//*================================================================
Dcl-Proc callProgram;
Dcl-PI callProgram end-PI;
setParameters();
MONITOR;
CallPrograms( subPgm :
callPM :
subAct :
dtaPtr :
dtaSize:
p$err ) ;
ON-ERROR;
P$ERR = 'MIS0012';
GetMessage('MIS0012');
ENDMON;
getParameters();
Return ;
END-Proc callProgram ;
//*================================================================
Dcl-Proc setParameters;
Dcl-PI setParameters end-PI;
p$err = *blanks;
IF listAction;
IF RetrieveObject(exobnm:exobtp);
before = GetObjectData();
ELSE;
CLEAR before;
ENDIF;
ENDIF;
Return ;
END-Proc setParameters ;
//*================================================================
Dcl-Proc getParameters;
Dcl-PI getParameters end-PI;
IF listAction;
IF RetrieveObject(exobnm:exobtp);
after = GetObjectData();
ELSE;
CLEAR after;
ENDIF;
ENDIF;
IF p$err <> *BLANKS;
getMessage(P$ERR);
ENDIF;
Return ;
END-proc getParameters ;
//*=====================================================================
Dcl-Proc getMessage ;
Dcl-PI getMessage ;
thisMsg char(7) const ;
end-PI ;
msgID = thisMsg ;
msgdta = *BLANKS;
msg = *BLANKS;
msgf = dftMsgFile;
MONITOR;
RtvMessage(msgid:msgf:msgdta:msg); [14]
msgtxt = msg;
ON-ERROR;
msgf = errFil;
ENDMON;
msgRlq = '*SAME' ;
msgdta = msgtxt;
msgpgm = PRGNAM;
SndMessage(msgid : msgF: msgdta : msgrlq : msgpgm); [15]
MessageToDisplay = *ON;
Return ;
END-Proc getMessage ;
//*=====================================================================
Dcl-Proc Quit ;
Dcl-PI *n end-PI ;
ErrorOccurred = CloseObjectCursor();
*inlr = *on ;
exit(0) ;
Return ;
End-Proc Quit ;
//*=====================================================================
Dcl-Proc displayPrompt ;
Dcl-PI displayPrompt ;
promptField char(10) ;
END-PI;
Dcl-S pmt char(10) ;
If promptField = *blanks;
pmt = 'PROMPT' ;
Else ;
pmt = promptField ;
ENDIF;
PromptDta = *blanks;
Prompter( Thispgm : pmt : PromptDta ); [16]
SELECT;
WHEN rtnfld = 'ZFSTS';
zfsts = %trim(PromptDta);
WHEN rtnfld = 'ZFSEQ';
promptDta = %xlate(' ':'0':promptDta);
zfseq = %dec(%subst(PromptDta:1:7):7:0);
WHEN rtnfld = 'ZFCAT';
promptDta = %xlate(' ':'0':promptDta);
zfcat = %dec(%subst(PromptDta:1:3):3:0);
WHEN rtnfld = 'ZFOBJ';
zfobj = %trim(PromptDta);
WHEN rtnfld = 'ZFTYP';
zftyp = %trim(PromptDta);
WHEN rtnfld = 'ZFDSC';
zfdsc = %trim(PromptDta);
OTHER;
PromptDta = *blanks;
ENDSL;
Return ;
END-Proc displayPrompt ;
//*=====================================================================
Dcl-Proc processChanges;
Dcl-PI processChanges end-PI;
IF Z$RRN1 > 0;
DOU %eof(SC0320DF);
READC SC0320S1;
listAction = *off;
IF NOT %eof(SC0320DF);
IF Z$OPT <> *BLANK;
listAction = *ON;
thisOption = %triml(z$opt);
ThisFormat = fmtnam;
GetOption(Thispgm:ThisFormat:thisOption:macro:authl);
SELECT;
WHEN SUBOP = 'CALL';
callProgram();
Other ;
setParameters() ;
executeFunction( exobnm : exobtp : function : p$err);
getParameters() ;
ENDSL;
z$opt = *BLANK;
IF before <> after;
SELECT;
WHEN p$mode = 'C';
OBJECT = after;
exdesc= '*changed';
WHEN p$mode = 'D';
exdesc = '*deleted';
*IN30 = *ON;
ENDSL;
ENDIF;
z$rrn2 = z$rrn1;
UPDATE SC0320S1;
*IN30 = *OFF;
CLEAR MACRO;
ENDIF;
ENDIF;
ENDDO;
ENDIF;
Return ;
END-PROC processChanges ;
Common Data Maps
The format of function keys are defined in a physical file, as well as the program status data structure (SDS) and the file information feedback data stucture (INFDS). The functions, options and the complex macro formats are also defined. SoftCode applications reference the layouts as externally defined data structure. They are a common copybook in the system. [1]
D FUNCTIONKEY E DS EXTNAME(SCKEYSPF) qualified Function keys
D PGMDS ESDS EXTNAME(SCPSTSPF) Pgm status map
D DSPDS E DS EXTNAME(SCDSPFPF) Display INFDS
D MACDS E DS EXTNAME(SCFUNCPF) INZ Key map
D OPTDS E DS EXTNAME(SCOPTNPF) INZ Option map
D Macro E DS extname(SCMACRPF) Macro instruction
D Function 30a overlay(Macro:1)