941 lines
29 KiB
Plaintext
941 lines
29 KiB
Plaintext
**free
|
|
/TITLE Demo Expanding Subfile Search using SQL for IO
|
|
//=============================================================
|
|
// This is an customer master prompt/search program.
|
|
// It can be called to return a selected customer number or
|
|
// just to provide general inquiry functionality from a menu
|
|
|
|
// Detailed Item information is displayed in a window by
|
|
// calling another program, MTNCUSTR.
|
|
|
|
// Parameters:
|
|
// -----------
|
|
// 1 Char 1 Type of parameter
|
|
// S - Return Selected Customer Id: 1=Select
|
|
// M - Allow maintenance: 2=Edit, F6=Add
|
|
// I - Inquiry, read only: 5=Display
|
|
// 2 Char 4 Selected customer id if parm 1 is S.
|
|
|
|
//=============================================================
|
|
// Program uses a full screen expanding subfile to select
|
|
// a Customer Master record.
|
|
|
|
// The screen layout is similar to PDM.
|
|
|
|
// Instead of using native IO it uses SQL to retrieve records.
|
|
|
|
// It is essentially without indicators. (Indicators are still
|
|
// needed to control the display file, but they all have names.)
|
|
|
|
// It is possible to use F4 to prompt for the State abbreviation
|
|
// when the cursor is in the ST field.
|
|
|
|
// F09 is a toggle to display or not display inactive Customers.
|
|
|
|
//=============================================================
|
|
// Naming Conventions
|
|
// ==================
|
|
// - Lower case is the default for opcodes.
|
|
// - TitleCase is used for program variables, subroutines and procedure
|
|
// names, e.g. MaxOrderQty, BldFkeyText, etc.
|
|
// - Temporary variables are prefixed with "wk", e.g., wkDate. Such
|
|
// variables contain valid data for only a short time and are never
|
|
// carried across subroutines.
|
|
// - UPPERCASE is used for external names, i.e., files, fields, formats
|
|
// and anything else not directly coded in the program.
|
|
|
|
// - In the display file, this field naming convention is used:
|
|
// Screen Header: Fields begin with SH_
|
|
// Subfile: Fields begin with SF_
|
|
// Subfile Control: Fields begin with SC_
|
|
// Screen footer: Fields begin with SFT_
|
|
|
|
//=============================================================
|
|
// Compilation
|
|
// This source is set up to compile from the IFS, with /COPY &
|
|
// /INCLUDE files using relative paths. For example, a path
|
|
// such as "/INCLUDE ../Copy_Mbrs/SRV_MSG_P.RPGLE".
|
|
//
|
|
// Use CRTSQLRPGI command with RPGPPOPT(*LVL2) specified. This means
|
|
// the copy files are included using the relative path before the
|
|
// SQL preprocessor rewrites the code to a temporary location.
|
|
|
|
// I edit using VS Code with the 'Code for IBM i" extension.
|
|
//============================================================
|
|
// 12/2023 Converted to totally **FREE
|
|
// Changed to use SQLPROBLEM service pgm
|
|
// 01/2025 Require at least one parameter.
|
|
// Remove commented SQLPROBLEM code.
|
|
// Fix some issues with "Return selected customer"
|
|
//============================================================
|
|
|
|
ctl-opt dftactgrp(*no) actgrp(*caller) option(*nodebugio: *srcstmt)
|
|
bnddir('UTIL_BND':'SQL_BND');
|
|
|
|
// === Program parameters ====================================
|
|
dcl-pi *n;
|
|
pParmType char(1);
|
|
pCustID like(CUSTID);
|
|
end-pi;
|
|
|
|
//=== External Programs Prototypes ============================
|
|
//--- Display/maintain customer ---
|
|
dcl-pr CustDsp extpgm('MTNCUSTR');
|
|
*n options(*nopass) like(custid); // CustID
|
|
*n char(1) options(*nopass); // Maintain
|
|
end-pr;
|
|
//--- Prompt for State
|
|
dcl-pr PmtState extpgm('PMTSTATER');
|
|
*n like(state); // TheState
|
|
end-pr;
|
|
|
|
//=== Service Program Prototypes ==============================
|
|
/INCLUDE ../Copy_Mbrs/SRV_MSG_P.RPGLE
|
|
/INCLUDE ../Copy_Mbrs/SRV_STR_P.RPGLE
|
|
/INCLUDE ../Copy_Mbrs/SRV_SQL_P.RPGLE
|
|
|
|
//=== Named hexadecimal constants for function keys ===========
|
|
/INCLUDE ../Copy_Mbrs/AIDBYTES.RPGLE
|
|
|
|
//=== Display File ===========================================
|
|
dcl-f PMTCUSTD workstn infds(dfInfDS) indds(dfIndDS) sfile(SFL:SflRRN)
|
|
usropn;
|
|
// File is closed when returning with LR off. This avoids an
|
|
// annoying resdisplay of the last subfile on re-entry.
|
|
|
|
//=== Display File Information Data Structure =================
|
|
// Allows us to determine which function key was pressed
|
|
dcl-ds dfInfDS;
|
|
Key char(1) pos(369);
|
|
end-ds;
|
|
|
|
//=== Display File Indicator Data Structure ===================
|
|
// This is a "private" indicator area for the display file.
|
|
dcl-ds dfIndDS len(99);
|
|
//--- 01-20 are not automatically cleared after EXFMT -----
|
|
scIncActInc ind pos(3);
|
|
//--- 21-99 automatically cleared after EXFMT -------------
|
|
dfIndClr char(79) pos(21);
|
|
SC_NAME_PC ind pos(79);
|
|
// Subfile indicators (prefix "sf") ---
|
|
sfSflNxtChg ind pos(80);
|
|
sfOPT_RI ind pos(81);
|
|
sfOPT_PC ind pos(82);
|
|
sfInAct ind pos(83);
|
|
// Subfile Control indicators (prefix "sc") -------------
|
|
scSflEnd ind pos(97);
|
|
scSflDsp ind pos(98);
|
|
scSflClr ind pos(99);
|
|
end-ds;
|
|
|
|
//=== Fields to control the subfile screen ====================
|
|
dcl-s SflRRN packed(5);
|
|
dcl-s RcdsInSfl packed(5);
|
|
dcl-c SFLPAGESIZE 12;
|
|
// SC_CSR_RCD is defined in the display file and is set with a
|
|
// RRN which determines which subfile page is displayed and on
|
|
// which record the cursor is positioned.
|
|
|
|
//=== Search Criteria Screen Fields ===========================
|
|
dcl-ds SearchCriteria inz;
|
|
SC_NAME;
|
|
SC_CITY;
|
|
SC_STATE;
|
|
end-ds;
|
|
|
|
//=== Last Search Criteria Fields =============================
|
|
dcl-ds LastSearchCriteria inz;
|
|
LastSC_NAME like(sc_name);
|
|
LastSC_CITY like(sc_city);
|
|
LastSC_STATE like(sc_state);
|
|
end-ds;
|
|
|
|
//=== SQL State Constants =====================================
|
|
dcl-c SQLSUCCESS '00000';
|
|
dcl-c SQLNODATA '02000';
|
|
dcl-c SQLNOMOREDATA '02000';
|
|
dcl-c SQLDUPRECD '23505';
|
|
dcl-c SQLROWLOCKED '57033';
|
|
|
|
//== CUSTMAST - define fields for SQL =========================
|
|
dcl-ds CustMast extname('CUSTMAST') template end-ds;
|
|
|
|
// NOTE: !!! Only the fields read by SQL are populated !!!
|
|
// Records from SQL CURSOR read into CustCursor
|
|
dcl-ds CustCursor likeds(CustMast);
|
|
|
|
// Records from SQL SELECT read into CustSelect
|
|
dcl-ds CustSelect likeds(CustMast);
|
|
|
|
//=== Global Switches =========================================
|
|
dcl-s Quit_Pgm ind inz(*off);
|
|
dcl-s EofData ind;
|
|
dcl-s CursorOpen ind;
|
|
dcl-s NewSearchCriteria ind;
|
|
dcl-s SflMsgSnt ind;
|
|
dcl-s Opt1_OK ind;
|
|
dcl-s OptError ind;
|
|
dcl-s Maint_OK ind;
|
|
dcl-c COWSCOMEHOME const('0');
|
|
dcl-c MAXSFLRECDS const(9999);
|
|
|
|
//=== Parm fields for MTNCUSTR ================================
|
|
dcl-s wkCustid like(custid);
|
|
dcl-s CustDspParm char(1);
|
|
dcl-c CUSTDSPEDIT const('E');
|
|
dcl-c CUSTDSPADD const('A');
|
|
dcl-c CUSTDSPDSPLY const('D');
|
|
|
|
//=== Program Status Data Structure ===========================
|
|
dcl-ds ProgStatus PSDS;
|
|
PgmName *PROC;
|
|
end-ds;
|
|
|
|
//=== Set SQL Options =========================================
|
|
// Note: Compile time settings
|
|
exec sql set option datfmt=*iso,
|
|
closqlcsr=*endmod;
|
|
//=== SQL Cursor for SFL data selection =======================
|
|
// Would prefer to defind these as like(SC_NAME)
|
|
// But SQL precompiler throws an error SQL0312, reason code 1
|
|
dcl-s wkName varchar(13) ;
|
|
dcl-s wkCity varchar(13) ;
|
|
dcl-s wkStateLow varchar(2);
|
|
dcl-s wkStateHigh varchar(2);
|
|
dcl-s wkActiveLow char(1);
|
|
dcl-s wkActiveHigh char(1);
|
|
|
|
exec sql declare ItemCur cursor for
|
|
select NAME
|
|
,CITY
|
|
,STATE
|
|
,ZIP
|
|
,ACTIVE
|
|
,CUSTID
|
|
from CUSTMAST
|
|
where NAME LIKE :wkName
|
|
and CITY LIKE :wkCity
|
|
and STATE between :wkStateLow and :wkStateHigh
|
|
and ACTIVE between :wkActiveLow and :wkActiveHigh
|
|
order by NAME, CITY, STATE
|
|
optimize for 13 rows
|
|
for fetch only
|
|
;
|
|
|
|
//=============================================================
|
|
// === Program Starts Here ====================================
|
|
//=============================================================
|
|
// Check at least one parameter. Calling from the command line
|
|
// without a parm caused confusion for newer developers.
|
|
// In a production environment, this would be called from a
|
|
// tested menu or some program that enforced security.
|
|
if %parms() = 0;
|
|
snd-msg *DIAG (%trim(PgmName) + ': There must be at least one parameter');
|
|
snd-msg *ESCAPE 'See previous diagnostic (*DIAG) message ';
|
|
endif;
|
|
|
|
// === Set up for the first screen IO =========================
|
|
Init(pParmType : pCustID);
|
|
BldFkeyText();
|
|
SflClear();
|
|
|
|
// Force evalualtion if enter pressed with no data
|
|
NewSearchCriteria = *on;
|
|
|
|
// If we are to return a customer number, Clear the return field
|
|
// in case nothing is selected
|
|
if Opt1_OK = *on;
|
|
clear pCustID;
|
|
endif;
|
|
|
|
// If just doing inquiry, load first subfile page
|
|
if %parms() > 0;
|
|
if pParmType = 'I' ;
|
|
SflFirstPage();
|
|
endif;
|
|
endif;
|
|
|
|
//=============================================================
|
|
// === Main Program Loop ======================================
|
|
//=============================================================
|
|
dou COWSCOMEHOME;
|
|
|
|
// Set "*More" display
|
|
scSflEnd = EofData;
|
|
|
|
// Write/Read the sreen
|
|
ScreenIO();
|
|
|
|
//-- Enter Key ---------------------------------------------
|
|
If Key = Enter;
|
|
// Either new Search Criteria entered or option(s) entered.
|
|
// New Search Criteria takes precedence over option(s).
|
|
if SearchCriteria <> LastSearchCriteria
|
|
or NewSearchCriteria = *on;
|
|
SflClear();
|
|
SflFirstPage();
|
|
else;
|
|
ProcessOption();
|
|
endif;
|
|
if Quit_Pgm = *on;
|
|
leave;
|
|
endif;
|
|
iter;
|
|
endif;
|
|
|
|
//--- Page Down --------------------------------------------
|
|
if Key = PageDown;
|
|
if RcdsInSfl > 0;
|
|
SflFillPage();
|
|
if SflRRN = MAXSFLRECDS;
|
|
SflMsgSnt= SndSflMsg('DEM0006');
|
|
iter;
|
|
endif;
|
|
else;
|
|
// Key not active msg
|
|
SflMsgSnt= SndSflMsg('DEM0003');
|
|
endif;
|
|
iter;
|
|
endif;
|
|
|
|
//--- Any other entry must be a function key ---------------
|
|
ProcessFunctionKey();
|
|
if (Quit_Pgm = *on);
|
|
leave;
|
|
endif;
|
|
|
|
enddo;
|
|
|
|
return;
|
|
|
|
//=============================================================
|
|
//=== End of Main Program Loop ================================
|
|
//=============================================================
|
|
|
|
//=== ScreenIO ================================================
|
|
// Writes and Reads the screen
|
|
Dcl-Proc ScreenIO;
|
|
|
|
write SH_HDR;
|
|
write SFT_FKEY;
|
|
|
|
// Show any messages in the error subfile.
|
|
if SflMsgSnt = *on;
|
|
write MSGCTL;
|
|
endif;
|
|
|
|
// If we have records in the subfile, display them.
|
|
if RcdsInSfl > 0;
|
|
scSflDsp = *ON;
|
|
else;
|
|
scSflDsp = *OFF;
|
|
ENDIF;
|
|
|
|
// Write/read the subfile. SC_CSR_RCD contains a RRN and
|
|
// determines which page will be on the screen and where the
|
|
// cursor will be.
|
|
exfmt SFLCTL;
|
|
|
|
// Clear most display file indicators
|
|
clear dfIndClr;
|
|
|
|
// Clear any messages in the error subfile.
|
|
if SflMsgSnt = *on;
|
|
SflMsgSnt = ClrMsgPgmQ(PgmName);
|
|
write MSGCTL;
|
|
endif;
|
|
|
|
End-Proc ScreenIO;
|
|
|
|
//=== ProcessFunctionKey ======================================
|
|
// Process whatever keyboard entry was made.
|
|
// Will not return from subroutine if F3 or F12 was pressed.
|
|
// May not return from subroutine when an option is entered.
|
|
|
|
Dcl-Proc ProcessFunctionKey;
|
|
|
|
select;
|
|
|
|
//--- F3: Exit, close down program -----------------------
|
|
when Key = F03;
|
|
CloseDownPgm();
|
|
*inlr = *on;
|
|
Quit_Pgm = *on;
|
|
|
|
//--- F12: Return to caller, leave program active ---------
|
|
when Key = F12;
|
|
CloseDownPgm();
|
|
Quit_Pgm = *on;
|
|
|
|
//--- F4: Prompt to fill the field -----------------------
|
|
when Key = F04;
|
|
// The result of a successful F4 is as if the field
|
|
// had been keyed from the screen.
|
|
select;
|
|
// --- Prompt for State Code
|
|
when SC_PMT_FLD = 'SC_STATE';
|
|
PmtState(SC_STATE);
|
|
if SC_STATE <> LastSC_STATE;
|
|
SflClear();
|
|
NewSearchCriteria = *on;
|
|
endif;
|
|
// --- Field not promptable
|
|
other;
|
|
// Use F4 only in field followed by + sign
|
|
SflMsgSnt= SndSflMsg('DEM0005');
|
|
endsl;
|
|
|
|
//--- F5: Refresh all search fields ----------------------
|
|
when Key = F05;
|
|
clear LastSearchCriteria;
|
|
clear SearchCriteria;
|
|
SflClear();
|
|
NewSearchCriteria = *on;
|
|
scIncActInc = *off;
|
|
|
|
//--- F6: Add a record. ----------------------------------
|
|
when Key = F06;
|
|
if Maint_OK = *on;
|
|
CustDspParm = CUSTDSPADD;
|
|
CustDsp(wkCustid : CustDspParm);
|
|
else;
|
|
// Function key not active
|
|
SflMsgSnt= SndSflMsg('DEM0003');
|
|
endif;
|
|
|
|
//--- F9: Toggle Include InActive ------------------------
|
|
when Key = F09;
|
|
CloseCursor();
|
|
scIncActInc = not scIncActInc;
|
|
BldFkeyText();
|
|
SflClear();
|
|
NewSearchCriteria = *on;
|
|
SflFirstPage();
|
|
|
|
//--- Other keys: Function key not active message ---------
|
|
other;
|
|
SflMsgSnt= SndSflMsg('DEM0003');
|
|
endsl;
|
|
|
|
End-Proc ProcessFunctionKey;
|
|
|
|
//=== ProcessOption ===========================================
|
|
// Did user enter one or more options? Loop through the
|
|
// subfile and process them all.
|
|
// May not return from this subroutine for some options.
|
|
|
|
Dcl-Proc ProcessOption;
|
|
if RcdsInSfl > 0;
|
|
OptError = *off;
|
|
|
|
// Don't know yet which sfl page to display next time.
|
|
SC_CSR_RCD = 0;
|
|
|
|
// Loop through changed records in the subfile.
|
|
readc SFL;
|
|
dow not %eof;
|
|
select;
|
|
//--- 1 = Select -------------------------------------
|
|
when SF_OPT = '1'
|
|
and Opt1_OK = *on;
|
|
// Return customer number to caller
|
|
pCustID = SF_CUST_H;
|
|
CloseDownPgm();
|
|
Quit_Pgm = *on;
|
|
return;
|
|
//--- 2 = Edit with external program -----------------
|
|
when SF_OPT = '2' and Maint_OK = *on;
|
|
wkCustid = SF_CUST_H;
|
|
CustDspParm = CUSTDSPEDIT;
|
|
CustDsp(wkCustid : CustDspParm);
|
|
// Reset Opt and leave cursor at last valid option
|
|
SF_OPT = ' ';
|
|
SetCursorPosition();
|
|
// Re-read the changed record & update subfile
|
|
ReadByKey(wkCustid : CustSelect);
|
|
BuildSflRecd(CustSelect);
|
|
UpdSflRecd();
|
|
|
|
//--- 5 = Display Detail with external program -------
|
|
when SF_OPT = '5';
|
|
wkCustid = SF_CUST_H;
|
|
CustDspParm = CUSTDSPDSPLY;
|
|
CustDsp(wkCustid : CustDspParm);
|
|
// Reset Opt and leave cursor at last valid option
|
|
SF_OPT = ' ';
|
|
SetCursorPosition();
|
|
UpdSflRecd();
|
|
|
|
//--- Opt is blank -----------------------------------
|
|
when SF_OPT = ' ';
|
|
// If changed, assume clearing an error from last time
|
|
sfOPT_PC = *off;
|
|
sfOPT_RI = *off;
|
|
UpdSflRecd();
|
|
|
|
//--- Other ------------------------------------------
|
|
other;
|
|
// Send message about invalid selection.
|
|
// Position cursor and page at first error.
|
|
// Always force to be read again next time & reverse image.
|
|
|
|
// Not a valid option at this time
|
|
SflMsgSnt= SndSflMsg('DEM0004':SF_OPT);
|
|
// Leave cursor at first invalid option
|
|
SetCursorPosition();
|
|
OptError = *on;
|
|
|
|
// SFLNXTCHG forces this record to be read again
|
|
// (even if user doesn't correct it) so we can
|
|
// check it again for validity.
|
|
sfSflNxtChg = *on;
|
|
sfOPT_RI = *on;
|
|
|
|
UpdSflRecd();
|
|
// set off indicators applying to just this recd.
|
|
sfSflNxtChg = *off;
|
|
sfOPT_RI = *off;
|
|
|
|
endsl;
|
|
|
|
readc SFL;
|
|
enddo;
|
|
CustDsp(); // Closes Window DSPF & restores our subfile
|
|
endif;
|
|
|
|
// If no positioning done, display last page, cursor on 1st recd.
|
|
// (Enter with no option takes you to the last page of subfile.)
|
|
if SC_CSR_RCD = 0;
|
|
SC_CSR_RCD =
|
|
( %int( (RcdsInSfl-1) / SFLPAGESIZE )
|
|
* SFLPAGESIZE
|
|
) + 1;
|
|
endif;
|
|
|
|
End-Proc ProcessOption;
|
|
|
|
//=== SflFirstPage ============================================
|
|
// Processes the Search fields in the Sub file control, then
|
|
// fills the first page of the subfile.
|
|
// If any errors in the search fields then no records are
|
|
// are added to the subfile.
|
|
|
|
// Returns:
|
|
// EofData = *on if there are no more data records
|
|
// *off if there is at least one more data
|
|
// record.
|
|
// NewSearchCriteria = *on Next time evaluate the
|
|
// search fields again.
|
|
// RcdsInSfl contains relative record number of last record
|
|
// written to the subfile.
|
|
|
|
Dcl-Proc SflFirstPage;
|
|
ProcessSearchCriteria();
|
|
if NewSearchCriteria = *off;
|
|
EofData = FetchNextData(CustCursor);
|
|
if EofData = *off;
|
|
SflFillPage();
|
|
else;
|
|
// No records match selection criteria
|
|
SflMsgSnt= SndSflMsg('DEM0002');
|
|
NewSearchCriteria = *on;
|
|
endif;
|
|
|
|
endif;
|
|
End-Proc SflFirstPage;
|
|
|
|
//=== SflFillPage =============================================
|
|
// Adds a page worth of records to the subfile.
|
|
|
|
// Assumes:
|
|
// One record is already read from the SQL cursor.
|
|
|
|
// Returns:
|
|
// EofData = *on if no more data records.
|
|
// *off if at least one data record is read
|
|
// and has not been displayed.
|
|
// RcdsInSfl contains relative record number of last record
|
|
// written to the subfile.
|
|
// SC_CSR_RCD contains relative record number of 1st record
|
|
// on the page & positions cursor there.
|
|
|
|
Dcl-Proc SflFillPage;
|
|
|
|
dcl-s inx int(10);
|
|
select;
|
|
when EofData = *on;
|
|
// do nothing
|
|
other;
|
|
// Add a subfile page. If not EOF, then one extra recd is
|
|
// read for the next time.
|
|
// Position cursor at first record on the subfile page.
|
|
SC_CSR_RCD = 0;
|
|
// Build/Format the subfile record
|
|
for inx = 1 to SFLPAGESIZE;
|
|
clear SF_OPT;
|
|
BuildSflRecd(CustCursor);
|
|
|
|
RcdsInSfl = RcdsInSfl + 1;
|
|
SflRRN = RcdsInSfl;
|
|
write SFL;
|
|
|
|
// Leave curson on first SFL record
|
|
if SC_CSR_RCD = 0;
|
|
SC_CSR_RCD = SflRRN;
|
|
endif;
|
|
|
|
// Can't display more than 9,999 records.
|
|
if SflRRN = MAXSFLRECDS;
|
|
EofData = *on;
|
|
SflMsgSnt= SndSflMsg('DEM0006');
|
|
leave;
|
|
endif;
|
|
// Get next record from SQL cursor
|
|
EofData = FetchNextData(CustCursor);
|
|
if EofData = *on;
|
|
leave;
|
|
endIf;
|
|
endfor;
|
|
endsl;
|
|
End-Proc SflFillPage;
|
|
|
|
|
|
//=== Update Subfile Recd =====================================
|
|
Dcl-Proc UpdSflRecd;
|
|
// Set on indicator based on saved SFL fields
|
|
if SF_ACT_H = 'N';
|
|
sfInAct = *on;
|
|
endif;
|
|
update SFL;
|
|
sfInAct = *off;
|
|
write DUMMY; // Supposed to help restore SFL display
|
|
End-Proc UpdSflRecd;
|
|
|
|
//=== ProcessSearchCriteria ====================================
|
|
// Examine the data entered in the search fields and build an
|
|
// SQL statement.
|
|
// Success:
|
|
// NewSearchCriteria is set off
|
|
// SQL Cursor is open
|
|
// Failure:
|
|
// NewSearchCriteria is left on
|
|
// Error message is sent to the msg sufile
|
|
// Cursor is postioned at the field in error
|
|
|
|
Dcl-Proc ProcessSearchCriteria;
|
|
// Reset switches
|
|
NewSearchCriteria = *off;
|
|
// Save entered values. (Never change screen fields.)
|
|
LastSearchCriteria = SearchCriteria;
|
|
CloseCursor();
|
|
// Build SQL cursor host variables. Using host variables
|
|
// protects against SQL injection attacks.
|
|
wkName = %trim(SC_NAME) + '%' ;
|
|
wkCity = %trim(SC_CITY) + '%';
|
|
if SC_STATE = ' '; // All states
|
|
wkStateLow = ' ';
|
|
wkStateHigh = 'ZZ';
|
|
else;
|
|
if %len(%trim(SC_STATE)) <> 2;
|
|
NewSearchCriteria=*on;
|
|
SflMsgSnt = ClrMsgPgmQ(PgmName);
|
|
SflMsgSnt = SndSflMsg('DEM0007');
|
|
endif;
|
|
wkStateLow = SC_STATE;
|
|
wkStateHigh = SC_STATE;
|
|
endif;
|
|
If scIncActInc = *off; // Include just actives
|
|
wkActiveLow = 'Y';
|
|
wkActiveHigh = 'Y';
|
|
else;
|
|
wkActiveLow = ' ';
|
|
wkActiveHigh = 'Z';
|
|
endif;
|
|
// Open the Cursor
|
|
if NewSearchCriteria = *off;
|
|
exec sql open ItemCur
|
|
using :wkName,:wkCity,
|
|
:wkStateLow, :wkStateHigh,
|
|
:wkActiveLow,:wkActiveHigh;
|
|
if SQLSTT <> SQLSUCCESS;
|
|
SQLProblem('Open ItemCur');
|
|
endif;
|
|
CursorOpen = *on;
|
|
endif;
|
|
End-Proc ProcessSearchCriteria ;
|
|
|
|
//=== SetCursorPostion ========================================
|
|
// If Invalid Option, position screen cursor on first error,
|
|
// else postion cursor on the last valid option.
|
|
Dcl-Proc SetCursorPosition;
|
|
if OptError = *off;
|
|
SC_CSR_RCD=SflRRN;
|
|
endif;
|
|
End-Proc SetCursorPosition;
|
|
|
|
//=== BldFKeyText =============================================
|
|
// Build the Function key text for the bottom of the screen.
|
|
Dcl-Proc BldFkeyText;
|
|
//=== Text for function keys ==============================
|
|
dcl-c F3TEXT 'F3=Exit';
|
|
dcl-c F4TEXT 'F4=Prompt+';
|
|
dcl-c F5TEXT 'F5=Reset';
|
|
dcl-c F6TEXT 'F6=Add';
|
|
dcl-c F12TEXT 'F12=Cancel';
|
|
dcl-s F9Text char(25);
|
|
|
|
SFT_KEYS=' ';
|
|
SFT_KEYS = CatB(SFT_KEYS : F3TEXT);
|
|
SFT_KEYS = CatB(SFT_KEYS : F4TEXT);
|
|
SFT_KEYS = CatB(SFT_KEYS : F5TEXT);
|
|
if pParmType = 'M';
|
|
SFT_KEYS = CatB(SFT_KEYS : F6TEXT);
|
|
Maint_OK = *on;
|
|
endif;
|
|
if scIncActInc = *on;
|
|
F9Text = 'F9=Exclude Inactive';
|
|
else;
|
|
F9Text = 'F9=Include Inactive';
|
|
endif;
|
|
SFT_KEYS = CatB(SFT_KEYS : F9Text);
|
|
SFT_KEYS = CatB(SFT_KEYS : F12TEXT);
|
|
End-Proc BldFkeyText ;
|
|
|
|
//=== CloseDownPgm ============================================
|
|
// Things to do before we issue a return to the caller
|
|
Dcl-Proc CloseDownPgm;
|
|
CloseCursor();
|
|
close PMTCUSTD;
|
|
CustDsp(); // Close Window display file.
|
|
End-Proc CloseDownPgm;
|
|
|
|
//=== Init ====================================================
|
|
// Must be executed each time program is entered, because F12
|
|
// and Enter key leave with LR off.
|
|
Dcl-Proc Init;
|
|
dcl-pi *n;
|
|
pParmType char(1);
|
|
pCustID like(CUSTID);
|
|
end-pi;
|
|
|
|
//=== Options Text ========================================
|
|
dcl-c OPT1TEXT '1=Select';
|
|
dcl-c OPT2TEXT '2=Edit';
|
|
dcl-c OPT5TEXT '5=Display';
|
|
//=== Screen Header Text===================================
|
|
dcl-s HdrInq like(sh_funct) inz('Inquiry');
|
|
dcl-s HdrSelect like(sh_funct) inz('Selection');
|
|
dcl-s HdrMaint like(sh_funct) inz('Maintenance');
|
|
dcl-s HdrBad like(sh_funct) inz('--> Bad Parm 1 <--');
|
|
|
|
Quit_Pgm = *off;
|
|
MSGPGMQ = PgmName;
|
|
SH_PGM = PgmName;
|
|
SH_FUNCT = CenterStr(HdrBad);
|
|
if not %open(PMTCUSTD);
|
|
open PMTCUSTD;
|
|
endif;
|
|
// Clear fields left over from previous F12.
|
|
reset LastSearchCriteria;
|
|
reset SearchCriteria;
|
|
scIncActInc = *off;
|
|
Maint_OK = *off;
|
|
|
|
// Put cursor in first field if inquiry
|
|
if pParmType = 'I';
|
|
SC_NAME_PC = *ON;
|
|
SH_FUNCT = CenterStr(HdrInq);
|
|
endif;
|
|
|
|
// Build options string.
|
|
// If we have a field to return customer number and we
|
|
// are doing selection, set 1=Select option.
|
|
clear SC_OPTIONS;
|
|
|
|
Opt1_OK = *off;
|
|
If pParmType = 'S' and %parms > 1;
|
|
SC_OPTIONS = OPT1TEXT;
|
|
Opt1_OK = *on;
|
|
SH_FUNCT = CenterStr(HdrSelect);
|
|
endif;
|
|
|
|
if pParmType = 'M';
|
|
SC_OPTIONS = CatB(SC_OPTIONS : OPT2TEXT);
|
|
SH_FUNCT = CenterStr(HdrMaint);
|
|
endif;
|
|
SC_OPTIONS = CatB(SC_OPTIONS : OPT5TEXT);
|
|
End-Proc Init;
|
|
|
|
//=============================================================
|
|
// === S u b P r o c e d u r e s ============================
|
|
//=============================================================
|
|
|
|
|
|
//=== CatB ====================================================
|
|
// Concatenates a string to another string with a blank between.
|
|
// If the target string is all blank to start with it will not
|
|
// end up with a leading blank.
|
|
dcl-proc CatB;
|
|
dcl-pi CatB varchar(79);
|
|
ToStr varchar(79) value;
|
|
AddStr varchar(79) value;
|
|
end-pi;
|
|
if ToStr = ' ';
|
|
return AddStr;
|
|
else;
|
|
return %trimr(ToStr) + ' ' + AddStr;
|
|
endif;
|
|
end-proc CatB;
|
|
|
|
//=== FetchNextData ===========================================
|
|
// Fetch the next row from the cursor
|
|
// Returns: End of data Indicator:
|
|
// *ON No more data, nothing returned
|
|
// *OFF Data returned
|
|
//------------------------------------------------------------
|
|
dcl-proc FetchNextData;
|
|
dcl-pi FetchNextData ind;
|
|
TheRecd likeds(CustMast);
|
|
end-pi;
|
|
// Local fields
|
|
dcl-s wkEof ind inz(*off);
|
|
|
|
exec sql fetch ItemCur into
|
|
:TheRecd.NAME,
|
|
:TheRecd.CITY,
|
|
:TheRecd.STATE,
|
|
:TheRecd.ZIP,
|
|
:TheRecd.ACTIVE,
|
|
:TheRecd.CUSTID
|
|
;
|
|
select;
|
|
when SQLSTT = SQLSUCCESS;
|
|
wkEof = *off;
|
|
when SQLSTT = SQLNOMOREDATA;
|
|
wkEof = *on;
|
|
Other;
|
|
SQLProblem('Fetch ITEMCUR');
|
|
endsl;
|
|
|
|
RETURN wkEof;
|
|
|
|
end-proc FetchNextData;
|
|
|
|
//=== ReadByKey ===============================================
|
|
// Read the record by key into the specified data record
|
|
// using the key passed in.
|
|
dcl-proc ReadByKey;
|
|
dcl-pi ReadByKey;
|
|
TheKey like(custid);
|
|
TheRecd likeds(CustMast);
|
|
end-pi;
|
|
exec sql select
|
|
NAME,
|
|
CITY,
|
|
STATE,
|
|
ZIP,
|
|
ACTIVE,
|
|
CUSTID
|
|
into
|
|
:TheRecd.NAME,
|
|
:TheRecd.CITY,
|
|
:TheRecd.STATE,
|
|
:TheRecd.ZIP,
|
|
:TheRecd.ACTIVE,
|
|
:TheRecd.CUSTID
|
|
from CUSTMAST
|
|
where CUSTID = :TheKey
|
|
;
|
|
end-proc ReadByKey;
|
|
|
|
//=== BuildSFLRecd ============================================
|
|
// Builds a SFL record from the specified data record
|
|
dcl-proc BuildSflRecd;
|
|
dcl-pi BuildSflRecd;
|
|
CustRecd likeds(CustMast);
|
|
end-pi;
|
|
SF_NAME = CustRecd.NAME;
|
|
SF_CITY = CustRecd.CITY;
|
|
SF_STATE = CustRecd.STATE;
|
|
SF_ZIP = CustRecd.ZIP;
|
|
// Save Id in case we need it for 5=Display
|
|
SF_CUST_H = CustRecd.CUSTID;
|
|
// Change color if record is inactive
|
|
if CustRecd.ACTIVE = 'N';
|
|
sfInAct = *on;
|
|
else;
|
|
sfInAct= *off;
|
|
endif;
|
|
// Save Active status in case we update subfile
|
|
SF_ACT_H = CustRecd.ACTIVE;
|
|
end-proc BuildSflRecd;
|
|
|
|
//=== CloseCursor =============================================
|
|
// Closes the SQL Cursor if open
|
|
dcl-proc CloseCursor;
|
|
dcl-pi CloseCursor end-pi;
|
|
// Local fields
|
|
if CursorOpen = *on;
|
|
exec sql close ItemCur;
|
|
if SQLSTT <> SQLSUCCESS;
|
|
SQLProblem('Close ITEMCUR');
|
|
endif;
|
|
CursorOpen = *off;
|
|
endif;
|
|
RETURN;
|
|
end-proc CloseCursor;
|
|
|
|
//=== SndSflMsg ===============================================
|
|
// Send a message to the Error Subfile
|
|
// Returns: *ON
|
|
// Parameter: ErrMsgId => Msg Id to Send
|
|
// Parameter: ErrMsgData => Optional Error Message Data
|
|
// Parameter: ErrMsgFile => Optional Error Message File
|
|
// Defaults to CUSTMSGF
|
|
//------------------------------------------------------------
|
|
dcl-proc SndSflMsg;
|
|
dcl-pi SndSflMsg ind;
|
|
ErrMsgId char(7) const;
|
|
ErrMsgData char(80) const options(*nopass:*varsize);
|
|
ErrMsgFile char(10) const options(*nopass);
|
|
end-pi;
|
|
|
|
// Local fields
|
|
dcl-s retField ind;
|
|
dcl-s wkMsgId char(7);
|
|
dcl-s wkMsgFile char(10);
|
|
dcl-s wkMsgData varchar(512);
|
|
|
|
if %parms >2;
|
|
wkMsgFile = ErrMsgFile;
|
|
else;
|
|
wkMsgFile = 'CUSTMSGF';
|
|
ENDIF;
|
|
if %parms > 1;
|
|
wkMsgData = ErrMsgData;
|
|
else;
|
|
wkMsgData = ' ';
|
|
ENDIF;
|
|
wkMsgId = ErrMsgId;
|
|
SNDMSGPGMQ(PgmName:
|
|
wkMsgId:
|
|
wkMsgFile:
|
|
wkMsgData);
|
|
|
|
retField = *on;
|
|
RETURN retField;
|
|
|
|
end-proc SndSflMsg;
|
|
|
|
//=== SflClear ================================================
|
|
// Clears the Subfile
|
|
dcl-proc SflClear;
|
|
dcl-pi SflClear end-pi;
|
|
clear SflRRN;
|
|
clear RcdsInSfl;
|
|
scSflClr = *ON;
|
|
write SFLCTL;
|
|
scSflClr = *OFF;
|
|
return;
|
|
end-proc SflClear;
|