Add PMTSTATE
This commit is contained in:
SJLennon
Binary file not shown.
|
Before Width: | Height: | Size: 31 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 30 KiB |
@@ -0,0 +1,185 @@
|
||||
A*%%TS SD 20200724 153608 LENNONS REL-V7R4M0 5770-WDS
|
||||
A*===============================================================
|
||||
A* This is a full screen expanding subfile to search for and
|
||||
A* select a Manufacturing QC Hold Disposition code
|
||||
A*===============================================================
|
||||
A* There is a naming convention for the fields in each record.
|
||||
A* -- Screen Header: Fields begin with SH_
|
||||
A* -- Subfile: Fields begin with SF_
|
||||
A* -- Subfile Control: Fields begin with SC_
|
||||
A* -- Screen footer: Fields begin with SFT_
|
||||
A*===============================================================
|
||||
A* Indicator usage:
|
||||
A* 01-20 Are not routinely cleared after an EXFMT. Some
|
||||
A* of these are used in subfile & subfile control for
|
||||
A* highlighting, etc., which does not change unless
|
||||
A* explicitly requested.
|
||||
A* 21-99 Are routinely cleared after and EXFMT.
|
||||
A* 80-89 Subfile record
|
||||
A* 90 Nessage Subfile end
|
||||
A* 91-99 Subfile Control Record
|
||||
A* Note: INDARA is specified here and in the program and this
|
||||
A* means that the display file indicators are in a
|
||||
A* data structure separate from the program indicators.
|
||||
A* This makes it easy to name the indicators in the DS.
|
||||
A*==============================================================
|
||||
A* MM/DD/YYYY Proj# Developer
|
||||
A* ---------- ----- -------------------------------------------
|
||||
A* 04/14/2013 8651 Sam Lennon Original coding
|
||||
A*
|
||||
A*==============================================================
|
||||
A*%%EC
|
||||
A DSPSIZ(24 80 *DS3 -
|
||||
A 27 132 *DS4)
|
||||
A PRINT
|
||||
A INDARA
|
||||
A ALTHELP
|
||||
A CA03
|
||||
A CF05
|
||||
A CA07
|
||||
A CA12
|
||||
A HELP
|
||||
A*===============================================================
|
||||
A*=== Screen Header: Fields begin with SH_ =====================
|
||||
A*
|
||||
A R SH_HDR
|
||||
A*%%TS SD 20111207 212036 SLENNON REL-V7R1M0 5770-WDS
|
||||
A OVERLAY
|
||||
A TEXT('Screen Header')
|
||||
A WINDOW(*DFT 17 40)
|
||||
A WDWBORDER((*DSPATR RI))
|
||||
A WDWBORDER((*COLOR BLU))
|
||||
A* CA03
|
||||
A* CA12
|
||||
A SH_PGM 10A O 1 1
|
||||
A 1 16'USA States'
|
||||
A COLOR(WHT)
|
||||
A 1 33DATE
|
||||
A EDTCDE(Y)
|
||||
A SH_FUNCT 17A O 2 13DSPATR(HI)
|
||||
A 2 33TIME
|
||||
A 2 1USER
|
||||
A*===============================================================
|
||||
A*=== Subfile: Fields begin with SF_ ===========================
|
||||
A*
|
||||
A R SFL SFL
|
||||
A*%%TS SD 20200723 210409 LENNONS REL-V7R4M0 5770-WDS
|
||||
A TEXT('SubFile')
|
||||
A 80 SFLNXTCHG
|
||||
A SF_OPT 1A B 6 2
|
||||
A 81 DSPATR(RI)
|
||||
A 82 DSPATR(PC)
|
||||
A SF_CODE 2A 6 6
|
||||
A 22 COLOR(RED)
|
||||
A SF_NAME 30A O 6 11
|
||||
A 22 COLOR(RED)
|
||||
A*===============================================================
|
||||
A*=== Subfile Control: Fields begin with SC_ ====================
|
||||
A*
|
||||
A R SFLCTL SFLCTL(SFL)
|
||||
A*%%TS SD 20200723 210409 LENNONS REL-V7R4M0 5770-WDS
|
||||
A *DS3 SFLSIZ(0008)
|
||||
A *DS4 SFLSIZ(0008)
|
||||
A *DS3 SFLPAG(0007)
|
||||
A *DS4 SFLPAG(0007)
|
||||
A *DS3 WINDOW(SH_HDR)
|
||||
A *DS4 WINDOW(SH_HDR)
|
||||
A TEXT('Subfile Control')
|
||||
A PAGEDOWN
|
||||
A RTNCSRLOC(&SC_PMT_RCD &SC_PMT_FLD)
|
||||
A BLINK
|
||||
A OVERLAY
|
||||
A N98 ERASE(SFL)
|
||||
A 98 SFLDSP
|
||||
A SFLDSPCTL
|
||||
A 99 SFLCLR
|
||||
A 97 SFLEND(*MORE)
|
||||
A 3 1'Name Contains'
|
||||
A SC_NAME 10A B 3 16
|
||||
A 95 DSPATR(MDT)
|
||||
A SC_OPTIONS 20A 4 1COLOR(BLU)
|
||||
A 4 26'Sorted by:'
|
||||
A SC_SORTED 4 4 37
|
||||
A 5 1'Opt'
|
||||
A DSPATR(HI)
|
||||
A DSPATR(UL)
|
||||
A 5 5'Code'
|
||||
A N01 COLOR(WHT)
|
||||
A 01 COLOR(PNK)
|
||||
A DSPATR(UL)
|
||||
A 5 11'Name '
|
||||
A DSPATR(UL)
|
||||
A 01 COLOR(WHT)
|
||||
A N01 COLOR(PNK)
|
||||
A SC_PMT_RCD 10A H
|
||||
A SC_PMT_FLD 10A H
|
||||
A SC_CSR_RCD 4S 0H SFLRCDNBR(CURSOR)
|
||||
A*===============================================================
|
||||
A*=== Screen footer & function keys: Fields begin with SFT_ ====
|
||||
A*
|
||||
A R SFT_FKEY
|
||||
A*%%TS SD 20200724 143229 LENNONS REL-V7R4M0 5770-WDS
|
||||
A *DS3 WINDOW(SH_HDR)
|
||||
A *DS4 WINDOW(SH_HDR)
|
||||
A TEXT('Screen Footer')
|
||||
A OVERLAY
|
||||
A 14 1' Demo Corp of America -
|
||||
A '
|
||||
A DSPATR(UL)
|
||||
A SFT_KEYS 40 O 15 1
|
||||
A*===============================================================
|
||||
A*=== Message Subfile: No fields ===============================
|
||||
A*
|
||||
A R MSGSFL SFL
|
||||
A*%%TS SD 19990831 134515 LENNON$S REL-V4R2M0 5769-PW1
|
||||
A TEXT('Message Subfile')
|
||||
A SFLMSGRCD(16)
|
||||
A MSGKEY SFLMSGKEY
|
||||
A MSGPGMQF SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Message Subfile Control: No fields ========================
|
||||
A*
|
||||
A R MSGCTL SFLCTL(MSGSFL)
|
||||
A*%%TS SD 19990831 134515 LENNON$S REL-V4R2M0 5769-PW1
|
||||
A TEXT('Message Subfile Control')
|
||||
A WINDOW(SH_HDR)
|
||||
A PAGEDOWN
|
||||
A PAGEUP
|
||||
A OVERLAY
|
||||
A SFLDSP
|
||||
A SFLDSPCTL
|
||||
A SFLINZ
|
||||
A N90 SFLEND
|
||||
A SFLSIZ(0002)
|
||||
A SFLPAG(0001)
|
||||
A MSGPGMQC SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Dummy Record - Assume =====================================
|
||||
A*
|
||||
A R DUMMY
|
||||
A ASSUME
|
||||
A 1 2' '
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="SCREEN1">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ <record-write record-format="SH_HDR" />
|
||||
A*%%RS+ <record-write record-format="SFL" />
|
||||
A*%%RS+ <record-write record-format="SFLCTL" />
|
||||
A*%%RS+ <record-write record-format="SFT_FKEY" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="Untitled">
|
||||
A*%%RS+ <device type="display" width="132" height="27" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="Untitled">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="Untitled">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
@@ -0,0 +1,754 @@
|
||||
/TITLE PMTSTATE Search and return a USA State Code
|
||||
//==============================================================*
|
||||
// Displays USA state names and their 2-char codes in a window.
|
||||
// Can sort the display by name or code.
|
||||
// Optionally can select and return a 2-char code.
|
||||
//
|
||||
// Parameters
|
||||
// ----------
|
||||
// Out CL2 Selected 2-Char State Code (optional)
|
||||
//
|
||||
//===============================================================
|
||||
// Program is essentially without indicators. (Indicators are
|
||||
// stil lneeded to control the display file, but all have names.)
|
||||
//
|
||||
// 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')
|
||||
H main(Main)
|
||||
|
||||
//=== Display File ==============================================
|
||||
FPMTSTATED CF E WorkStn INFDS(dfInfDS)
|
||||
F INDDS(dfIndDS)
|
||||
F SFILE(SFL:SflRRN)
|
||||
F USROPN
|
||||
|
||||
D Main pr extpgm('PMTSTATER')
|
||||
D 2A
|
||||
|
||||
//=== Service Program Prototypes ================================
|
||||
/include DEMO,Srv_Msg_P
|
||||
|
||||
//=== Named hexadecimal constants for function keys =============
|
||||
/include DEMO,##AIDBYTES
|
||||
|
||||
//=== Fields read by SQL ========================================
|
||||
// NOTE: Only the fields in fetchData which are fetched by the
|
||||
// SQL Cursor are populated.
|
||||
D STATES e ds extname(STATES)
|
||||
D qualified template
|
||||
d FetchData ds likeds(STATES)
|
||||
|
||||
//=== SQL State Constants =======================================
|
||||
d SQLSuccess c '00000'
|
||||
d SQLNoData c '02000'
|
||||
d SQLNoMoreData c '02000'
|
||||
d SQLDupRecd c '23505'
|
||||
d SQLRowLocked c '57033'
|
||||
|
||||
//=== 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 scSortColor 01 01
|
||||
|
||||
//--- 21-99 automatically cleared after EXFMT ------------------
|
||||
D dfIndClr 21 99
|
||||
|
||||
//--- Subfile indicators (prefix "sf") -------------------------
|
||||
D sfSflNxtChg 80 80n
|
||||
D sfOPT_RI 81 81n
|
||||
D sfOPT_PC 82 82n
|
||||
|
||||
//--- Subfile Control indicators (prefix "sc") ----------------
|
||||
D scMDT 95 95n
|
||||
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 7
|
||||
// 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.
|
||||
|
||||
//=== Program Status Data Structure =============================
|
||||
D ProgStatus sds
|
||||
D PgmName *PROC
|
||||
|
||||
D MainProc S 10a
|
||||
|
||||
//=== Text for function keys ====================================
|
||||
D F3Text c 'F3=Exit'
|
||||
d F5Text c 'F5=Refresh'
|
||||
d F12Text c 'F12=Cancel'
|
||||
D F7Text1 c 'F7=By '
|
||||
D F7Text2 s 5a inz(' ')
|
||||
D F7Text S 11a inz(' ')
|
||||
|
||||
//SortSeq is used in SQL Order By
|
||||
D SortSeq s 4a inz(' ')
|
||||
D SortbyName s 4a inz('Name')
|
||||
D SortbyCode s 4a inz('Code')
|
||||
|
||||
//=== Options Text ==============================================
|
||||
|
||||
d Opt1Text c '1=Select'
|
||||
|
||||
//=== Search Criteria Screen Fields =============================
|
||||
d SearchCriteria ds inz
|
||||
D SC_NAME
|
||||
|
||||
//=== Last Search Criteria Fields ===============================
|
||||
d LastSearchCriteria...
|
||||
d ds inz
|
||||
D LastSC_NAME Like(SC_NAME)
|
||||
|
||||
//=== SQL Search Variables ======================================
|
||||
D DESCLike S 12 varying
|
||||
|
||||
//=== Global Switches ===========================================
|
||||
D EofData s n
|
||||
D CursorOpen s n
|
||||
D NewSearchCriteria...
|
||||
D s n
|
||||
D SflMsgSnt s n
|
||||
d Opt1OK s n
|
||||
D OptError s n
|
||||
D CowsComeHome c const('0')
|
||||
|
||||
//=== Work Fields ===============================================
|
||||
D inx s 10i 0
|
||||
|
||||
//=== Translation ===============================================
|
||||
D Lower c const('abcdefghijklmnopqrstuvwxyz')
|
||||
D Upper c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
|
||||
|
||||
D HighVals s 30 inz(*hival)
|
||||
|
||||
|
||||
//=============================================================
|
||||
//== Program Starts Here ======================================
|
||||
//=============================================================
|
||||
p Main b
|
||||
d Main pi
|
||||
d pState Like(FetchData.STATE)
|
||||
|
||||
|
||||
/FREE
|
||||
exsr Init;
|
||||
exsr BldFkeyText;
|
||||
|
||||
//=== Set SQL Options =========================================
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod;
|
||||
//=== SQL Cursor Definitions ==================================
|
||||
// Sort Order is controlled by field SortSeq which is
|
||||
// used in a CASE statement.
|
||||
exec SQL
|
||||
declare DataCur cursor for
|
||||
select
|
||||
STATE,
|
||||
NAME
|
||||
from STATES
|
||||
where upper(NAME) like :DescLike
|
||||
order by case :SortSeq
|
||||
when :SortByName then NAME
|
||||
when :SortByCode then STATE
|
||||
else '1'
|
||||
end
|
||||
optimize for 7 rows
|
||||
for fetch only;
|
||||
|
||||
// === Initial screen display =================================
|
||||
write SH_HDR;
|
||||
SflClear();
|
||||
exsr SflFirstPage;
|
||||
|
||||
//=============================================================
|
||||
// === Main Program Loop ======================================
|
||||
//=============================================================
|
||||
dou CowsComeHome;
|
||||
// Put the last search criteria back on the screen.
|
||||
SearchCriteria = LastSearchCriteria;
|
||||
// Set "*More" display
|
||||
scSflEnd = EofData;
|
||||
|
||||
// If switching display order, reload first page
|
||||
if Key = F07;
|
||||
exsr SflFirstPage;
|
||||
endif;
|
||||
|
||||
// Write/Read the screen
|
||||
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;
|
||||
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(MainProc);
|
||||
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;
|
||||
*inlr = *on;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
//--- F12: Return to caller, leave program active ---------
|
||||
when Key = F12;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
//--- F5: Refresh all search fields ----------------------
|
||||
when Key = F05;
|
||||
clear LastSearchCriteria;
|
||||
NewSearchCriteria = *on;
|
||||
SflClear();
|
||||
|
||||
//--- F7: Toggle Sort Sequence ---------------------------
|
||||
when Key = F07;
|
||||
if SortSeq=SortByName;
|
||||
SortSeq = SortByCode;
|
||||
SC_SORTED = SortbyName;
|
||||
ScSortColor=*on;
|
||||
F7Text2 = SortByName;
|
||||
else;
|
||||
SortSeq = SortByName;
|
||||
SC_SORTED = SortbyCode;
|
||||
scSortColor = *off;
|
||||
F7Text2 = SortbyCode;
|
||||
endif;
|
||||
F7Text = F7Text1 + F7Text2;
|
||||
exsr BldFkeyText;
|
||||
NewSearchCriteria = *on;
|
||||
SflClear();
|
||||
|
||||
//--- Other keys: Function key not active message ---------
|
||||
other;
|
||||
SflMsgSnt= SndSflMsg('DEM0003');
|
||||
endsl;
|
||||
|
||||
endsr;
|
||||
|
||||
//=== ProcessOption ===========================================
|
||||
// Did user enter an option? If so, process it.
|
||||
// May not return from this subroutine.
|
||||
|
||||
begsr ProcessOption;
|
||||
if RcdsInSfl > 0;
|
||||
OptError = *off;
|
||||
|
||||
// Don't know yet which 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 Opt1OK;
|
||||
// Return Code to caller
|
||||
pSTATE = SF_CODE;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
|
||||
//--- Opt is blank ----------------------------------------
|
||||
when SF_OPT = ' ';
|
||||
// If changed, assume clearing an error from last time
|
||||
sfOPT_PC = *off;
|
||||
sfOPT_RI = *off;
|
||||
update SFL;
|
||||
|
||||
//--- 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;
|
||||
|
||||
update SFL;
|
||||
// set off indicators applying to just this recd.
|
||||
sfSflNxtChg = *off;
|
||||
sfOPT_RI = *off;
|
||||
|
||||
endsl;
|
||||
|
||||
readc SFL;
|
||||
enddo;
|
||||
|
||||
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();
|
||||
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;
|
||||
SF_CODE = FetchData.STATE;
|
||||
SF_NAME = FetchData.NAME;
|
||||
|
||||
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,9999 records.
|
||||
if SflRRN = 9999;
|
||||
EofData = *on;
|
||||
SflMsgSnt= SndSflMsg('DEM0006');
|
||||
leave;
|
||||
endif;
|
||||
|
||||
EofData = FetchNextData();
|
||||
if EofData = *on;
|
||||
leave;
|
||||
endIf;
|
||||
|
||||
endfor;
|
||||
|
||||
endsl;
|
||||
|
||||
endsr;
|
||||
|
||||
//=== ProcessSearchCriteria====================================
|
||||
// Examines the data entered in the search fields and sets up
|
||||
// variables used in the SQL Cursor.
|
||||
//
|
||||
// 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();
|
||||
|
||||
//---------------------------------------------------------------
|
||||
if SC_NAME = ' ';
|
||||
// Not searching, take all
|
||||
DESCLike = '%%';
|
||||
else;
|
||||
DESCLike = '%' + %trim(SC_NAME) + '%';
|
||||
endif;
|
||||
//---------------------------------------------------------------
|
||||
|
||||
// If no errors, open the SQL cursor
|
||||
if NewSearchCriteria = *off;
|
||||
exec sql open DataCur;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('Open DataCur');
|
||||
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 : F5Text);
|
||||
SFT_KEYS = CatB(SFT_KEYS : F7Text);
|
||||
SFT_KEYS = CatB(SFT_KEYS : F12Text);
|
||||
endsr;
|
||||
|
||||
//=== CloseDownPgm ============================================
|
||||
// Things to do before we issue a return to the caller
|
||||
begsr CloseDownPgm;
|
||||
CloseCursor();
|
||||
endsr;
|
||||
|
||||
//=== Init ====================================================
|
||||
// Must be executed each time program is entered, because F12
|
||||
// and Enter key leave with LR off.
|
||||
begsr Init;
|
||||
SortSeq = SortByCode;
|
||||
SC_SORTED = SortbyName;
|
||||
scSortColor = *off;
|
||||
F7Text2 = SortByCode;
|
||||
F7Text = F7Text1 + F7Text2;
|
||||
|
||||
//--- Analyse parameters ---
|
||||
Opt1OK = *off;
|
||||
if %parms() > 0;
|
||||
Opt1OK = *on;
|
||||
endif;
|
||||
// Set up for subfile message queue
|
||||
MainProc = %proc();
|
||||
MSGPGMQF = MainProc;
|
||||
MSGPGMQC = MSGPGMQF;
|
||||
SH_PGM = PgmName;
|
||||
if not %open(PMTSTATED);
|
||||
open PMTSTATED;
|
||||
endif;
|
||||
// Clear fields left over from previous F12.
|
||||
reset LastSearchCriteria;
|
||||
reset SearchCriteria;
|
||||
|
||||
// Build options string.
|
||||
clear SC_OPTIONS;
|
||||
if Opt1OK;
|
||||
SC_OPTIONS = Opt1Text;
|
||||
endif;
|
||||
endsr;
|
||||
p Main e
|
||||
|
||||
//=============================================================
|
||||
// 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.
|
||||
/END-FREE
|
||||
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
|
||||
|
||||
|
||||
//--------------------------------------------------
|
||||
// Procedure name: FetchNextData
|
||||
// Purpose: 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
|
||||
|
||||
// Local fields
|
||||
D wkEof S N
|
||||
/FREE
|
||||
wkEoF= *off;
|
||||
exec sql fetch DataCur into
|
||||
:FetchData.STATE,
|
||||
:FetchData.NAME
|
||||
;
|
||||
select;
|
||||
when SQLSTT = SQLSuccess;
|
||||
wkEof = *off;
|
||||
when SQLSTT = SQLNoMoreData;
|
||||
wkEof = *on;
|
||||
Other;
|
||||
SQLProblem('Fetch DATACUR');
|
||||
endsl;
|
||||
|
||||
RETURN wkEof;
|
||||
|
||||
/END-FREE
|
||||
P FetchNextData E
|
||||
|
||||
//--------------------------------------------------
|
||||
// Procedure name: SndSflMsg
|
||||
// Purpose: 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 80a varying
|
||||
|
||||
/FREE
|
||||
if %parms >2;
|
||||
wkMsgFile = ErrMsgFile;
|
||||
else;
|
||||
wkMsgFile = 'CUSTMSGF';
|
||||
ENDIF;
|
||||
if %parms > 1;
|
||||
wkMsgData = ErrMsgData;
|
||||
else;
|
||||
wkMsgData = ' ';
|
||||
ENDIF;
|
||||
wkMsgId = ErrMsgId;
|
||||
SNDMSGPGMQ(MainProc:
|
||||
wkMsgid:
|
||||
wkMsgFile:
|
||||
wkMsgData);
|
||||
|
||||
retField = *on;
|
||||
RETURN retField;
|
||||
|
||||
/END-FREE
|
||||
P SndSflMsg E
|
||||
|
||||
//--------------------------------------------------
|
||||
// Procedure name: CloseCurssor
|
||||
// Purpose: Closes the SQL Cursor
|
||||
//--------------------------------------------------
|
||||
P CloseCursor B
|
||||
D CloseCursor PI
|
||||
/FREE
|
||||
if CursorOpen = *on;
|
||||
exec sql close DataCur;
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('Close DATACUR');
|
||||
endif;
|
||||
CursorOpen = *off;
|
||||
endif;
|
||||
RETURN;
|
||||
/END-FREE
|
||||
P CloseCursor E
|
||||
|
||||
|
||||
//--------------------------------------------------
|
||||
// Procedure name: SflClear
|
||||
// Purpose: Clears the Subfile
|
||||
// Returns:
|
||||
//--------------------------------------------------
|
||||
P SflClear B
|
||||
D SflClear PI
|
||||
/FREE
|
||||
clear SflRRN;
|
||||
clear RcdsInSfl;
|
||||
scSflClr = *ON;
|
||||
write SFLCTL;
|
||||
scSflClr = *OFF;
|
||||
return;
|
||||
/END-FREE
|
||||
P SflClear E
|
||||
|
||||
|
||||
|
||||
+37
-5
@@ -13,20 +13,46 @@ This is a working application that allows display, selection and maintenance of
|
||||
### Sample Maintenance Screen
|
||||
|
||||
|
||||
### Prompting to Select a State
|
||||
|
||||
|
||||
|
||||
#### General Notes
|
||||
|
||||
Some of the programs use /Include statements, which are found in the Copy_Mbrs directory. In the code these programs refer to my DEMO library, so to compile you may need to change this.
|
||||
|
||||
The RPG code is free form, except that the D-Specs are fixed form. This probably allows more people developers who are still on older versions of the OS, or are still using the out of date SEU, to more easily use the code. The code can be converted to totally free form using the free "JCRHFD - Rpg H,F,D to free form syntax" command available at [JCRCMDS.COM](http://www.jcrcmds.com/jcrdown2.html#JCRHFD_tag). If there is interest I may post totally free form versions.
|
||||
|
||||
The genesis of these programs was code that I wrote in RPG IV for a Fortune 500 retailer circa 2000. The code was then cloned as a standard approach by another team leader. This code is a more modern version that I cleaned up in 2020.
|
||||
|
||||
The style tries to have consistent naming and I do not share field names between the RPG and the display files--I've seen too many accidental modifications in my support career.
|
||||
|
||||
The display file uses a private set of indicators, something I started doing to try to educate coworkers who were struggling with monolithic code where all 99 indicators were in use. You can also reset indicators and such in display files, but I prefer to do it myself.
|
||||
|
||||
#### PMTCUSTR/PMTCUSTD
|
||||
|
||||
RPG program that puts up a 5250 subfile that allows searching by customer name, city and state. Display of Inactive records can be toggled using F9.
|
||||
|
||||
There are 3 functions, or modes, controlled by the first parameter passsed: Inquiry to display a record; Maintenance to change a record;, Selection to return a customer id.
|
||||
There are 3 functions, or modes, controlled by the first parameter passsed: Inquiry to display a record; Maintenance to change a record; Selection to return a customer id.
|
||||
|
||||
- I gives 5=Display
|
||||
- M gives 2=Edit 5=Display
|
||||
- S gives 1=select 5=Display
|
||||
Conceptually, you can call this program from almost anywhere and access to it is contolled by whatever menuing or security system you have in place. The general user population would progably get Inquiry and Sales would have Maintenance. Selection could be used for any in-house program that needed to prompt for a customer id number.
|
||||
If the cursor is in a field with a + in the field name (ST+ here) you can press F4 to prompt the field.
|
||||
|
||||
Conceptually, you can call this program from almost anywhere and control access to it by whatever menuing or security system you have in place. The general user population would progably get Inquiry and Sales would have Maintenance. Selection could be used for any in-house program that needed to prompt for a customer id number.
|
||||
|
||||
#### MTNCUSTR/MTNCUSTD
|
||||
|
||||
RPG program that maintains a customer. Customer id is provided as the first parameter. It also adds or displays a customer. Function is controlled by the second parameter. It is called from PMTCUSTR, but it could be called from any program that has a customer id available, or needs to add a customer.
|
||||
RPG program that maintains a customer. Customer id is provided as the first parameter. It also adds or displays a customer. Function is controlled by the second parameter. It is called from PMTCUSTR, but it could be called from any program that has a customer id available, or which needs to add a customer.
|
||||
|
||||
If the cursor is in a field with a + in the field name (ST+ here) you can press F4 to prompt the field.
|
||||
|
||||
### PMTSTATER/PMTSTATED
|
||||
|
||||
RPG program and window display file to prompt for a USA state code. Called when F4 is used in PMTCUSTR or MTNCUSTR. Disply can be by either state name or 2-character code, toggled by F7.
|
||||
|
||||
Strictly speaking, this is more of a demonstration program that may, or may not, have a lot of practical value in real life.
|
||||
|
||||
#### CRTMSGF
|
||||
|
||||
@@ -34,10 +60,16 @@ This is a working application that allows display, selection and maintenance of
|
||||
|
||||
#### CRTDTAARA
|
||||
|
||||
Create the CUSTNEXT data area that contains the next available customer id.
|
||||
Creates the CUSTNEXT data area that contains the next available customer id.
|
||||
|
||||
#### CustMast.SQL
|
||||
|
||||
SQL code to create and populate the CUSTMAST tsble. You will need to change the _**set schema**_ in the first line to your target library. You would put this file in the IFS and run it with the RUNSQLSTM command.
|
||||
|
||||
Contains 300 randomly generate rows, courtesy of the fine folk at _http://generatedata.com/_, plus a little tweaking by hand.
|
||||
Contains 300 randomly generate rows, courtesy of the fine folk at _http://generatedata.com/_, plus a little tweaking by hand.
|
||||
|
||||
### States.SQL
|
||||
|
||||
SQL Code to create and populate the STATES table, which is a table of USA state names and their 2-character abbreviations.
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,77 @@
|
||||
-- Build table of US State code and names
|
||||
-- RUNSQLSTM SRCSTMF(states.sql) COMMIT(*NONE) ERRLVL(40)
|
||||
set schema lennons1;
|
||||
drop table states;
|
||||
CREATE TABLE STATES (
|
||||
STATE CHAR(2) CCSID 273 NOT NULL ,
|
||||
NAME CHAR(30) CCSID 273 NOT NULL ,
|
||||
CONSTRAINT state_primary_key PRIMARY KEY( STATE ) )
|
||||
|
||||
RCDFMT STATESF ;
|
||||
|
||||
ALTER TABLE STATES
|
||||
ADD CONSTRAINT state_name_unique
|
||||
UNIQUE( NAME ) ;
|
||||
|
||||
LABEL ON TABLE STATES
|
||||
IS 'US States' ;
|
||||
|
||||
INSERT into states values
|
||||
('AA', 'Armed Forces America'),
|
||||
('AE', 'Armed Forces'),
|
||||
('AK', 'Alaska'),
|
||||
('AL', 'Alabama'),
|
||||
('AS', 'American Samoa'),
|
||||
('AZ', 'Arizona'),
|
||||
('AR', 'Arkansas'),
|
||||
('CA', 'California'),
|
||||
('CO', 'Colorado'),
|
||||
('CT', 'Connecticut'),
|
||||
('DE', 'Delaware'),
|
||||
('DC', 'District of Columbia'),
|
||||
('FL', 'Florida'),
|
||||
('GA', 'Georgia'),
|
||||
('GU', 'Guam'),
|
||||
('HI', 'Hawaii'),
|
||||
('ID', 'Idaho'),
|
||||
('IL', 'Illinois'),
|
||||
('IN', 'Indiana'),
|
||||
('IA', 'Iowa'),
|
||||
('KS', 'Kansas'),
|
||||
('KY', 'Kentucky'),
|
||||
('LA', 'Louisiana'),
|
||||
('ME', 'Maine'),
|
||||
('MD', 'Maryland'),
|
||||
('MA', 'Massachusetts'),
|
||||
('MI', 'Michigan'),
|
||||
('MN', 'Minnesota'),
|
||||
('MP', 'Northern Mariana Islands'),
|
||||
('MS', 'Mississippi'),
|
||||
('MO', 'Missouri'),
|
||||
('MT', 'Montana'),
|
||||
('NE', 'Nebraska'),
|
||||
('NV', 'Nevada'),
|
||||
('NH', 'New Hampshire'),
|
||||
('NJ', 'New Jersey'),
|
||||
('NM', 'New Mexico'),
|
||||
('NY', 'New York'),
|
||||
('NC', 'North Carolina'),
|
||||
('ND', 'North Dakota'),
|
||||
('OH', 'Ohio'),
|
||||
('OK', 'Oklahoma'),
|
||||
('OR', 'Oregon'),
|
||||
('PA', 'Pennsylvania'),
|
||||
('PR', 'Puerto Rico'),
|
||||
('RI', 'Rhode Island'),
|
||||
('SC', 'South Carolina'),
|
||||
('SD', 'South Dakota'),
|
||||
('TN', 'Tennessee'),
|
||||
('TX', 'Texas'),
|
||||
('UT', 'Utah'),
|
||||
('VT', 'Vermont'),
|
||||
('VA', 'Virginia'),
|
||||
('WA', 'Washington'),
|
||||
('WV', 'West Virginia'),
|
||||
('WI', 'Wisconsin'),
|
||||
('VI', 'Virgin Islands'),
|
||||
('WY', 'Wyoming');
|
||||
@@ -18,3 +18,7 @@ Utility support routines that are called from other code.
|
||||
## SQL_SKELETON
|
||||
|
||||
Batch program with SQL embedded in RPGLE. Includes error checking and handling. There are two versions, one in completely free format and one not free with the D-Specs in fixed format.
|
||||
|
||||
## 5250 Subfile
|
||||
|
||||
Fully functional 5250 "green screen" Customer Master maintenance and prompting application, with full screen and window displays, modular code, service programs, message files and a sample database.
|
||||
|
||||
Reference in New Issue
Block a user