988 lines
35 KiB
Plaintext
988 lines
35 KiB
Plaintext
/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
|
|
// call 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
|
|
// Use CRTSQLRPGI command.
|
|
// Note that /INCLUDEs expects to find code in DEMO library,
|
|
// not the default of QRPGLESRC. Change as needed.
|
|
//=============================================================
|
|
|
|
h DftActGrp(*NO) ActGrp(*CALLER) option(*nodebugio: *srcstmt)
|
|
h BndDir('UTIL_BND')
|
|
|
|
//=== Display File ============================================
|
|
fPMTCUSTD CF E WorkStn INFDS(dfInfDS)
|
|
f INDDS(dfIndDS)
|
|
f SFILE(SFL:SflRRN)
|
|
f USROPN
|
|
// File is closed when returning with LR off. This avoids an
|
|
// annoying resdisplay of the last subfile on re-entry.
|
|
|
|
//=== Service Program Prototypes ==============================
|
|
/include copy_mbrs,Srv_Msg_P
|
|
/include copy_mbrs,Srv_Str_P
|
|
|
|
//=== Named hexadecimal constants for function keys ===========
|
|
/include copy_mbrs,##AIDBYTES
|
|
|
|
//=== Display File Information Data Structure =================
|
|
// Allows us to determine which function key was pressed
|
|
d dfInfDS DS
|
|
d Key 369 369
|
|
//=== Display File Indicator Data Structure ===================
|
|
// This is a "private" indicator area for the display file.
|
|
d dfIndDS ds 99
|
|
|
|
//--- 01-20 are not automatically cleared after EXFMT ----------
|
|
d scIncActInc 03 03n
|
|
|
|
//--- 21-99 automatically cleared after EXFMT ------------------
|
|
d dfIndClr 21 99
|
|
|
|
//--- Subfile indicators (prefix "sf") ---
|
|
d SC_NAME_PC 79 79n
|
|
d sfSflNxtChg 80 80n
|
|
d sfOPT_RI 81 81n
|
|
d sfOPT_PC 82 82n
|
|
d sfInAct 83 83n
|
|
|
|
//--- Subfile Control indicators (prefix "sc") ---
|
|
d*scNoDta 96 96n
|
|
d scSflEnd 97 97n
|
|
d scSflDsp 98 98n
|
|
d scSflClr 99 99n
|
|
|
|
//=== Fields to control the subfile screen ====================
|
|
d SflRRN s 5 0
|
|
d RcdsInSfl s 5 0
|
|
d SflPageSize c 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.
|
|
|
|
//=== Text for function keys ==================================
|
|
d F3Text c 'F3=Exit'
|
|
d F4Text c 'F4=Prompt+'
|
|
d F5Text c 'F5=Reset'
|
|
d F6Text c 'F6=Add'
|
|
d F12Text c 'F12=Cancel'
|
|
d F9Text s 25
|
|
|
|
//=== Options Text ============================================
|
|
d Opt1Text c '1=Select'
|
|
d Opt2Text c '2=Edit'
|
|
d Opt5Text c '5=Display'
|
|
|
|
//=== Screen Header Text=======================================
|
|
d HdrInq s like(SH_FUNCT)
|
|
d inz('Inquiry')
|
|
d HdrSelect s like(SH_FUNCT)
|
|
d inz('Selection')
|
|
d HdrMaint s like(SH_FUNCT)
|
|
d inz('Maintenance')
|
|
d HdrBad s like(SH_FUNCT)
|
|
d inz('-> Bad Parm 1 <-')
|
|
d
|
|
|
|
//=== Search Criteria Screen Fields ===========================
|
|
d SearchCriteria ds inz
|
|
d SC_NAME
|
|
d SC_CITY
|
|
d SC_STATE
|
|
|
|
//=== Last Search Criteria Fields =============================
|
|
d LastSearchCriteria...
|
|
d ds inz
|
|
d LastSC_NAME Like(SC_NAME)
|
|
d LastSC_CITY Like(SC_CITY)
|
|
d LastSC_STATE Like(SC_STATE)
|
|
|
|
//=== SQL Search Variables ====================================
|
|
d Stmt s 1024 varying Select Statement
|
|
|
|
//=== SQL State Constants =====================================
|
|
d SQLSuccess c '00000'
|
|
d SQLNoData c '02000'
|
|
d SQLNoMoreData c '02000'
|
|
d SQLDupRecd c '23505'
|
|
d SQLRowLocked c '57033'
|
|
|
|
//== CUSTMAST - define fields for SQL =========================
|
|
// NOTE: Only the fields read by SQL are populated!
|
|
d CustMast e ds extname(CUSTMAST) template
|
|
|
|
// Records from SQL CURSOR read into CustCursor
|
|
d CustCursor ds likeds(Custmast)
|
|
|
|
// Records from SQL SELECT read into CustSelect
|
|
d CustSelect ds likeds(CustMast)
|
|
|
|
//=== External Programs Prototypes ============================
|
|
|
|
d CustDsp pr extpgm('MTNCUSTR')
|
|
d CustID options(*nopass) like(CUSTID)
|
|
d Maintain 1a options(*nopass)
|
|
|
|
d PmtState PR EXTPGM('PMTSTATER')
|
|
d TheState like(STATE)
|
|
d
|
|
|
|
//=== Global Switches =========================================
|
|
d EofData s n
|
|
d CursorOpen s n
|
|
d NewSearchCriteria...
|
|
d s n
|
|
d SflMsgSnt s n
|
|
d Opt1_OK s n
|
|
d OptError s n
|
|
d Maint_OK s n
|
|
d CowsComeHome c const('0')
|
|
d MaxSflRecds c const(9999)
|
|
|
|
//=== Work Fields =============================================
|
|
d inx s 10i 0
|
|
|
|
// Would prefer to defind these as like(SC_NAME)
|
|
// But SQL precompiler throws an error SQL0312, reason code 1
|
|
d wkName s 13a varying
|
|
d wkCity s 13a varying
|
|
|
|
//=== Parm fields for MTNCUSTR ================================
|
|
d wkCustid s like(CUSTID)
|
|
d CustDspParm s 1a
|
|
d CustDspEdit c const('E')
|
|
d CustDspAdd c const('A')
|
|
d CustDspDsply c const('D')
|
|
d
|
|
|
|
//=== Program Status Data Structure ===========================
|
|
d ProgStatus sds
|
|
d PgmName *PROC
|
|
|
|
//=== Program Parameters ======================================
|
|
d pParmType S 1A
|
|
d pCustID s Like(CUSTID)
|
|
|
|
//=============================================================
|
|
// === Program Starts Here ====================================
|
|
//=============================================================
|
|
c *Entry plist
|
|
c parm pParmType
|
|
c parm pCustID
|
|
|
|
/FREE
|
|
//=== Set SQL Options =========================================
|
|
exec sql set option datfmt=*iso,
|
|
closqlcsr=*endmod;
|
|
|
|
// === Set up for the first screen IO =========================
|
|
exsr Init;
|
|
exsr 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' ;
|
|
exsr SflFirstPage;
|
|
endif;
|
|
endif;
|
|
|
|
//=============================================================
|
|
// === Main Program Loop ======================================
|
|
//=============================================================
|
|
dou CowsComeHome;
|
|
|
|
// Set "*More" display
|
|
scSflEnd = EofData;
|
|
|
|
// Write/Read the sreen
|
|
exsr 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();
|
|
exsr SflFirstPage;
|
|
else;
|
|
exsr ProcessOption;
|
|
endif;
|
|
iter;
|
|
endif;
|
|
|
|
//--- Page Down --------------------------------------------
|
|
if Key = PageDown;
|
|
if RcdsInSfl > 0;
|
|
exsr 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 ---------------
|
|
exsr ProcessFunctionKey;
|
|
|
|
enddo;
|
|
|
|
//=============================================================
|
|
//=== End of Main Program Loop ================================
|
|
//=============================================================
|
|
|
|
//=== ScreenIO ================================================
|
|
// Writes and Reads the screen
|
|
begsr 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;
|
|
|
|
endsr;
|
|
|
|
//=== 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.
|
|
|
|
begsr ProcessFunctionKey;
|
|
|
|
select;
|
|
|
|
//--- F3: Exit, close down program -----------------------
|
|
when Key = F03;
|
|
exsr CloseDownPgm;
|
|
*inlr = *on;
|
|
return;
|
|
|
|
//--- F12: Return to caller, leave program active ---------
|
|
when Key = F12;
|
|
exsr CloseDownPgm;
|
|
return;
|
|
|
|
//--- 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;
|
|
exsr BldFkeyText;
|
|
SflClear();
|
|
NewSearchCriteria = *on;
|
|
exsr SflFirstPage;
|
|
|
|
//--- Other keys: Function key not active message ---------
|
|
other;
|
|
SflMsgSnt= SndSflMsg('DEM0003');
|
|
endsl;
|
|
|
|
endsr;
|
|
|
|
//=== 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.
|
|
|
|
begsr 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 = %dec(SF_CUST_H:4:0);
|
|
exsr CloseDownPgm;
|
|
return;
|
|
//--- 2 = Edit with external program -----------------
|
|
when SF_OPT = '2' and Maint_OK = *on;
|
|
wkCustId = %dec(SF_CUST_H:4:0);
|
|
CustDspParm = CustDspEdit;
|
|
CustDsp(wkCustId : CustDspParm);
|
|
// Reset Opt and leave cursor at last valid option
|
|
SF_OPT = ' ';
|
|
exsr SetCursorPosition;
|
|
// Re-read the changed record & update subfile
|
|
ReadByKey(wkCustid : CustSelect);
|
|
BuildSflRecd(CustSelect);
|
|
exsr UpdSflRecd;
|
|
|
|
//--- 5 = Display Detail with external program -------
|
|
when SF_OPT = '5';
|
|
wkCustId = %dec(SF_CUST_H:4:0);
|
|
CustDspParm = CustDspDsply;
|
|
CustDsp(wkCustId : CustDspParm);
|
|
// Reset Opt and leave cursor at last valid option
|
|
SF_OPT = ' ';
|
|
exsr SetCursorPosition;
|
|
exsr UpdSflRecd;
|
|
|
|
//--- Opt is blank -----------------------------------
|
|
when SF_OPT = ' ';
|
|
// If changed, assume clearing an error from last time
|
|
sfOPT_PC = *off;
|
|
sfOPT_RI = *off;
|
|
exsr 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
|
|
exsr 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;
|
|
|
|
exsr 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;
|
|
|
|
endsr;
|
|
|
|
//=== 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.
|
|
|
|
begsr SflFirstPage;
|
|
exsr ProcessSearchCriteria;
|
|
if NewSearchCriteria = *off;
|
|
EofData = FetchNextData(CustCursor);
|
|
if EofData = *off;
|
|
exsr SflFillPage;
|
|
else;
|
|
// No records match selection criteria
|
|
SflMsgSnt= SndSflMsg('DEM0002');
|
|
NewSearchCriteria = *on;
|
|
endif;
|
|
|
|
endif;
|
|
endsr;
|
|
|
|
//=== 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.
|
|
|
|
begsr SflFillPage;
|
|
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;
|
|
for inx = 1 to SflPageSize;
|
|
// Build/Format the subfile record
|
|
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;
|
|
|
|
EofData = FetchNextData(CustCursor);
|
|
if EofData = *on;
|
|
leave;
|
|
endIf;
|
|
|
|
endfor;
|
|
|
|
endsl;
|
|
|
|
endsr;
|
|
|
|
|
|
//=== Update Subfile Recd =====================================
|
|
begsr 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
|
|
endsr;
|
|
|
|
//=== ProcessSearchCriteria====================================
|
|
// Examinethe 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
|
|
|
|
begsr ProcessSearchCriteria;
|
|
// Reset switches
|
|
NewSearchCriteria = *off;
|
|
// Save entered values. (Never change screen fields.)
|
|
LastSearchCriteria = SearchCriteria;
|
|
//exsr SaveSearchCriteria;
|
|
CloseCursor();
|
|
// Build select statement
|
|
// Using parameter markers protects against
|
|
// SQL injection attacks.
|
|
clear wkNAME;
|
|
clear wkCity;
|
|
Stmt = 'select NAME +
|
|
,CITY +
|
|
,STATE +
|
|
,ZIP +
|
|
,ACTIVE +
|
|
,CUSTID +
|
|
from CUSTMAST +
|
|
where NAME LIKE ? +
|
|
and CITY like ? ';
|
|
wkName = Sanatize(%trim(SC_NAME) + '%') ;
|
|
wkCity = Sanatize(%trim(SC_CITY) + '%');
|
|
|
|
if SC_STATE <> ' ';
|
|
if %len(%trim(SC_STATE)) <> 2;
|
|
NewSearchCriteria=*on;
|
|
SflMsgSnt = ClrMsgPgmQ(PgmName);
|
|
SflMsgSnt= SndSflMsg('DEM0007');
|
|
endif;
|
|
Stmt += ' and STATE =' + Quote(SC_STATE);
|
|
endif;
|
|
|
|
If scIncActInc = *off;
|
|
Stmt += ' and ACTIVE = ' + quote('Y');
|
|
endif;
|
|
|
|
stmt += ' order by NAME, CITY';
|
|
Stmt += ' optimize for 13 rows';
|
|
Stmt += ' for fetch only';
|
|
// SndInfMsg(Stmt); // Testing...
|
|
|
|
//----------------------------------------------------------
|
|
// If stmt bulit without errors open the SQL cursor
|
|
if NewSearchCriteria = *off;
|
|
exec sql prepare mySelect from :Stmt;
|
|
if SQLSTT <> SQLSuccess;
|
|
SQLProblem('Prepare mySelect');
|
|
endif;
|
|
exec sql declare ItemCur cursor for mySelect;
|
|
exec sql open ItemCur using :wkName,:wkCity ;
|
|
if SQLSTT <> SQLSuccess;
|
|
SQLProblem('Open ItemCur');
|
|
endif;
|
|
CursorOpen = *on;
|
|
endif;
|
|
endsr;
|
|
|
|
//=== SetCursorPostion ========================================
|
|
// If Invalid Option, position screen cursor on first one,
|
|
// else postion cursor on the last valid option.
|
|
begsr SetCursorPosition;
|
|
if OptError = *off;
|
|
SC_CSR_RCD=SflRRN;
|
|
endif;
|
|
endsr;
|
|
|
|
//=== BldFKeyText =============================================
|
|
// Build the Function key text for the bottom of the screen.
|
|
begsr BldFkeyText;
|
|
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);
|
|
endsr;
|
|
|
|
//=== CloseDownPgm ============================================
|
|
// Things to do before we issue a return to the caller
|
|
begsr CloseDownPgm;
|
|
CloseCursor();
|
|
close PMTCUSTD;
|
|
CustDsp(); // Close Window display file.
|
|
endsr;
|
|
|
|
//=== Init ====================================================
|
|
// Must be executed each time program is entered, because F12
|
|
// and Enter key leave with LR off.
|
|
begsr Init;
|
|
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);
|
|
endsr;
|
|
|
|
//=============================================================
|
|
// S u b P r o c e d u r e s
|
|
//=============================================================
|
|
|
|
// === Quote ==================================================
|
|
// Sanatize and puts quotes around a string
|
|
/END-FREE
|
|
pQuote b
|
|
dQuote pi 100 varying
|
|
dStr 100 varying value
|
|
/free
|
|
return '''' + %trim(Sanatize(str)) +'''';
|
|
|
|
/END-FREE
|
|
p e
|
|
//=============================================================
|
|
// === Sanatize ===============================================
|
|
// Sanatize an entered search string field.
|
|
// - Remove any single quotes, otherwise the built SQL prepare
|
|
// will fail, or it could allow SQL Injection.
|
|
// Double quotes are OK.
|
|
|
|
pSanatize b
|
|
dSanatize pi 100 varying
|
|
dStr 100 varying value
|
|
|
|
d wkStr s like(Str)
|
|
dQuotesTwo c ''''''
|
|
dQuotesOne c ''''
|
|
/free
|
|
wkSTR = %scanrpl(QuotesTwo:x'ff':Str);
|
|
wkStr = %scanrpl(QuotesOne:'':wkStr);
|
|
wkStr = %scanrpl(x'ff':QuotesTwo:wkStr);
|
|
return wkStr;
|
|
/END-FREE
|
|
p e
|
|
|
|
//=== 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.
|
|
pCatB b
|
|
dCatB PI 79 varying
|
|
d ToStr 79 varying value
|
|
d AddStr 79 varying value
|
|
/FREE
|
|
if ToStr=' ';
|
|
return AddStr;
|
|
else;
|
|
return %trimr(ToStr) + ' ' + AddStr;
|
|
endif;
|
|
/END-FREE
|
|
pCatB e
|
|
|
|
//=== SQLProblem ==============================================
|
|
// For those "Never should happen" SQL errors.
|
|
// Issues DUMP(A) to dump memory, then ends program by
|
|
// sending an *ESCAPE message of the supplied debugging text.
|
|
p SQLProblem B
|
|
d SQLProblem PI
|
|
d piSQLDebug 1024 varying value
|
|
|
|
//--- Local Variables ----------------------------------------
|
|
d wkSQLDebug s 1024 varying
|
|
|
|
/free
|
|
wkSQLDebug = 'SQLSTT ' + SQLSTT
|
|
+ ' << Unexpected SQL Return Code: '
|
|
+ piSQLDebug;
|
|
dump(a);
|
|
SndEscMsg(wkSqlDebug);
|
|
return;
|
|
/end-free
|
|
p SQLProblem E
|
|
|
|
//=== FetchNextData ===========================================
|
|
// Fetch the next row from the cursor
|
|
// Returns: End of data Indicator:
|
|
// *ON No more data, nothing returned
|
|
// *OFF Data returned
|
|
//------------------------------------------------------------
|
|
p FetchNextData B
|
|
d FetchNextData PI N
|
|
d TheRecd likeds(Custmast)
|
|
|
|
// Local fields
|
|
d wkEof S N
|
|
/FREE
|
|
wkEoF= *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-FREE
|
|
|
|
p FetchNextData E
|
|
|
|
//=== ReadByKey ===============================================
|
|
// Read the record by key into the specified data record
|
|
// using the key passed in.
|
|
p ReadByKey B
|
|
d ReadByKey PI
|
|
d TheKey like(CUSTID)
|
|
d TheRecd likeds(CustMast)
|
|
/FREE
|
|
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-FREE
|
|
|
|
p ReadByKey E
|
|
|
|
//=== BuildSFLRecd ============================================
|
|
// Builds a SFL record from the specified data record
|
|
p BuildSflRecd b
|
|
d BuildSflRecd PI
|
|
d CustRecd likeds(CUSTMAST)
|
|
/FREE
|
|
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 = %editc(CustRecd.CUSTID:'3');
|
|
// 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-FREE
|
|
p BuildSFLRecd E
|
|
|
|
//=== Procedure name: CloseCurssor ============================
|
|
// Closes the SQL Cursor if open
|
|
//------------------------------------------------------------
|
|
p CloseCursor B
|
|
d CloseCursor PI
|
|
// Local fields
|
|
//CursorOpen s n static
|
|
/FREE
|
|
if CursorOpen = *on;
|
|
exec sql close ItemCur;
|
|
if SQLSTT <> SQLSuccess;
|
|
SQLProblem('Close ITEMCUR');
|
|
endif;
|
|
CursorOpen = *off;
|
|
endif;
|
|
RETURN;
|
|
/END-FREE
|
|
p CloseCursor E
|
|
|
|
//=== 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
|
|
//------------------------------------------------------------
|
|
p SndSflMsg B
|
|
d SndSflMsg PI N
|
|
d ErrMsgId 7A CONST
|
|
d ErrMsgData 80A CONST
|
|
d OPTIONS(*NOPASS:*VARSIZE)
|
|
d ErrMsgFile 10A CONST
|
|
d OPTIONS(*NOPASS)
|
|
|
|
// Local fields
|
|
d retField S N
|
|
d wkMsgId s 7a
|
|
d wkMsgFile s 10a
|
|
d wkMsgData s 512a varying
|
|
|
|
/FREE
|
|
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-FREE
|
|
p SndSflMsg E
|
|
|
|
//=== SflClear ================================================
|
|
// Clears the Subfile
|
|
//------------------------------------------------------------
|
|
p SflClear B
|
|
d SflClear PI
|
|
/FREE
|
|
clear SflRRN;
|
|
clear RcdsInSfl;
|
|
scSflClr = *ON;
|
|
write SFLCTL;
|
|
scSflClr = *OFF;
|
|
return;
|
|
/END-FREE
|
|
p SflClear E
|
|
|
|
|