Add MTNCUST, etc
This commit is contained in:
SJLennon
parent
dfc6e50c07
commit
c38786fdab
6
5250_Subfile/CRTDTAARA
Normal file
6
5250_Subfile/CRTDTAARA
Normal file
@ -0,0 +1,6 @@
|
||||
PGM
|
||||
DLTDTAARA DTAARA(CUSTNEXT)
|
||||
MONMSG MSGID(CPF0000)
|
||||
CRTDTAARA DTAARA(CUSTNEXT) TYPE(*DEC) LEN(4) +
|
||||
VALUE(301) TEXT('Next customer number')
|
||||
ENDPGM
|
||||
40
5250_Subfile/CRTMSGF
Normal file
40
5250_Subfile/CRTMSGF
Normal file
@ -0,0 +1,40 @@
|
||||
PGM
|
||||
DLTMSGF MSGF(LENNONS1/CUSTMSGF)
|
||||
MONMSG MSGID(CPF0000)
|
||||
|
||||
CRTMSGF MSGF(LENNONS1/CUSTMSGF) TEXT('Customer +
|
||||
Related Messages')
|
||||
ADDMSGD MSGID(DEM0000) MSGF(CUSTMSGF) MSG('Press Enter to +
|
||||
update. F12 to Cancel.')
|
||||
ADDMSGD MSGID(DEM0002) MSGF(CUSTMSGF) MSG('No +
|
||||
records match the selection criteria')
|
||||
ADDMSGD MSGID(DEM0003) MSGF(CUSTMSGF) MSG('Key is +
|
||||
not active now')
|
||||
ADDMSGD MSGID(DEM0004) MSGF(CUSTMSGF) MSG('&1 is not +
|
||||
a valid option at this time.') FMT((*CHAR 1))
|
||||
ADDMSGD MSGID(DEM0005) MSGF(CUSTMSGF) MSG('Use F4 only if +
|
||||
+ is on field')
|
||||
ADDMSGD MSGID(DEM0006) MSGF(CUSTMSGF) MSG('Too many +
|
||||
records. Change the selection criteria.')
|
||||
ADDMSGD MSGID(DEM0007) MSGF(CUSTMSGF) MSG('State +
|
||||
selection field in invalid.')
|
||||
ADDMSGD MSGID(DEM0008) MSGF(CUSTMSGF) MSG('Use F4 +
|
||||
only in field followed by +')
|
||||
ADDMSGD MSGID(DEM0009) MSGF(CUSTMSGF) MSG('Press Enter to +
|
||||
add. Press F12 to cancel')
|
||||
ADDMSGD MSGID(DEM0501) MSGF(CUSTMSGF) MSG('&1: Must +
|
||||
be Y or N') FMT((*CHAR 40))
|
||||
ADDMSGD MSGID(DEM0502) MSGF(CUSTMSGF) MSG('&1: Must +
|
||||
not be blank') FMT((*CHAR 40))
|
||||
ADDMSGD MSGID(DEM0503) MSGF(CUSTMSGF) MSG('State +
|
||||
invalid. Can use F4 to prompt.')
|
||||
ADDMSGD MSGID(DEM0599) MSGF(CUSTMSGF) MSG('Customer +
|
||||
deleted. Exit & redo search.')
|
||||
ADDMSGD MSGID(DEM1001) MSGF(CUSTMSGF) MSG('Customer +
|
||||
being updated by another user or job.')
|
||||
ADDMSGD MSGID(DEM1002) MSGF(CUSTMSGF) MSG('Someone else +
|
||||
changed record. Rewiew data.')
|
||||
|
||||
ADDMSGD MSGID(DEM9999) MSGF(CUSTMSGF) MSG('Program Error! +
|
||||
Please contact IT now.')
|
||||
ENDPGM
|
||||
195
5250_Subfile/MTNCUSTD
Normal file
195
5250_Subfile/MTNCUSTD
Normal file
@ -0,0 +1,195 @@
|
||||
A*%%TS SD 20120202 211644 SLENNON REL-V7R1M0 5770-WDS
|
||||
A*===============================================================
|
||||
A* Window to display or update Customer Master
|
||||
A*===============================================================
|
||||
A* CRTDSPF RSTDSP(*NO)
|
||||
A* There is a naming convention for the fields in each record.
|
||||
A* -- Screen Header: Fields begin with SH_
|
||||
A* -- Details Fields begin with SD_
|
||||
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 an 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* Note: DSPATR HI and RI at the same time = non-display. Thus
|
||||
a* when we turn on RI were turn of HI,
|
||||
A*===============================================================
|
||||
A* MM/DD/YYYY Proj# Developer
|
||||
A* ---------- ----- -------------------------------------------
|
||||
A* 10/21/2012 8399 Sam Lennon Original coding
|
||||
A*
|
||||
A*==============================================================
|
||||
A*%%EC
|
||||
A DSPSIZ(24 80 *DS3)
|
||||
A PRINT
|
||||
A INDARA
|
||||
A ALTHELP
|
||||
A CA03
|
||||
A CF04
|
||||
A CA05
|
||||
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 WDWBORDER((*COLOR PNK))
|
||||
A WINDOW(*DFT 17 54)
|
||||
A* CA03
|
||||
A* CA12
|
||||
A SH_PGM 10A O 1 1
|
||||
A 1 21'Customer Master'
|
||||
A 1 47DATE
|
||||
A EDTCDE(Y)
|
||||
A 2 1USER
|
||||
A SH_FUNCT 25A O 2 16DSPATR(HI)
|
||||
A 2 47TIME
|
||||
A*===============================================================
|
||||
A*=== Data Details - Fields begin with SD_ ======================
|
||||
A R DETAILS
|
||||
A OVERLAY
|
||||
A WINDOW(SH_HDR)
|
||||
A CHGINPDFT
|
||||
A RTNCSRLOC(&SD_PMT_RCD &SD_PMT_FLD)
|
||||
A*---------------------------------------------------------------
|
||||
A 5 1'Customer Id'
|
||||
A SD_CUSTID 4 0 5 14DSPATR(HI)
|
||||
A 5 20'Active Status'
|
||||
A SD_ACTIVE 1 B 5 35
|
||||
A N40 DSPATR(HI)
|
||||
A 40 DSPATR(RI)
|
||||
A 41 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 6 1'Name'
|
||||
A SD_NAME 40 B 6 9
|
||||
A N42 DSPATR(HI)
|
||||
A 42 DSPATR(RI)
|
||||
A 43 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 7 1'Address'
|
||||
A SD_ADDR 40 B 7 9
|
||||
A N44 DSPATR(HI)
|
||||
A 44 DSPATR(RI)
|
||||
A 45 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 1'City'
|
||||
A SD_CITY 20 B 8 9
|
||||
A N46 DSPATR(HI)
|
||||
A 46 DSPATR(RI)
|
||||
A 47 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 32'ST+'
|
||||
A SD_STATE 2 B 8 36
|
||||
A N48 DSPATR(HI)
|
||||
A 48 DSPATR(RI)
|
||||
A 49 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 8 39'ZIP'
|
||||
A SD_ZIP 10 B 8 43
|
||||
A N50 DSPATR(HI)
|
||||
A 50 DSPATR(RI)
|
||||
A 51 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 9 1'Account Manager'
|
||||
A 10 5'Phone'
|
||||
A SD_ACCTPH 20 B 10 15
|
||||
A N52 DSPATR(HI)
|
||||
A 52 DSPATR(RI)
|
||||
A 53 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 11 5'Name'
|
||||
A SD_ACCTMGR 40 B 11 15
|
||||
A N54 DSPATR(HI)
|
||||
A 54 DSPATR(RI)
|
||||
A 55 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 12 1'Corporate Phone'
|
||||
A SD_CORPPH 20 B 12 17
|
||||
A N56 DSPATR(HI)
|
||||
A 56 DSPATR(RI)
|
||||
A 57 DSPATR(PC)
|
||||
A 10 DSPATR(PR)
|
||||
A N10 DSPATR(UL)
|
||||
A 13 1'Last Change'
|
||||
A SD_CHGTIME 23 13 13
|
||||
A 13 37'by'
|
||||
A SD_CHGUSER 15 13 40
|
||||
A SD_PMT_RCD 10A H
|
||||
A SD_PMT_FLD 10A H
|
||||
A*===============================================================
|
||||
A*=== Screen footer & function keys: Fields begin with SFT_ ====
|
||||
A*
|
||||
A R SFT_FKEY
|
||||
A*%%TS SD 20111208 204102 SLENNON REL-V7R1M0 5770-WDS
|
||||
A TEXT('Screen Footer')
|
||||
A OVERLAY
|
||||
A WINDOW(SH_HDR)
|
||||
A 14 1' Demo Corp of America -
|
||||
A '
|
||||
A DSPATR(UL)
|
||||
A SFT_KEYS 53A O 15 1COLOR(BLU)
|
||||
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 MSGPGMQ 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 MSGPGMQ SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Dummy Record - Assume =====================================
|
||||
A*
|
||||
A R DUMMY
|
||||
A ASSUME
|
||||
A KEEP
|
||||
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="DETAILS" />
|
||||
A*%%RS+ <record-write record-format="SFT_FKEY" />
|
||||
A*%%RS+ <record-write record-format="MSGSFL" />
|
||||
A*%%RS+ <record-write record-format="MSGCTL" />
|
||||
A*%%RS+ <record-write record-format="DUMMY" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
833
5250_Subfile/MTNCUSTR
Normal file
833
5250_Subfile/MTNCUSTR
Normal file
@ -0,0 +1,833 @@
|
||||
/TITLE MNTCUSTR - Update/Display a Customer Master
|
||||
//==============================================================
|
||||
// A maintenance or display program for a Customer Master Recds
|
||||
//
|
||||
//
|
||||
// Parameters
|
||||
// ----------
|
||||
// 1 In Z4 Customer Id to, or 0 to add a new code
|
||||
// 2 In CL1 Function
|
||||
// C - Close Display file
|
||||
// E - Edit passed record
|
||||
// A - Add a new record
|
||||
// D - Display record
|
||||
//
|
||||
//==============================================================
|
||||
// MM/DD/YYYY Proj# Developer
|
||||
// ---------- ----- -------------------------------------------
|
||||
// 10/21/2012 8399 Sam Lennon Original coding
|
||||
//
|
||||
//==============================================================
|
||||
// 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 screen field naming convention is used:
|
||||
// Screen Header: Fields begin with SH_
|
||||
// Detail Fields begin with SD_
|
||||
// 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 =============================================
|
||||
FMTNCUSTD CF E WorkStn INFDS(dfInfDS)
|
||||
F INDDS(dfIndDS)
|
||||
F USROPN
|
||||
|
||||
//=== 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 the SQL statement are populated!
|
||||
D CUSTMAST e ds extname(CUSTMAST)
|
||||
// qualified template
|
||||
// FetchData ds likeds(STATES)
|
||||
D
|
||||
//=== 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 Protect_SD_ALL 10 10n
|
||||
|
||||
//--- 21-99 are automatically cleared after EXFMT --------------
|
||||
D dfIndClr 21 99 ????
|
||||
D RI_SD_ACTIVE 40 40n
|
||||
D PC_SD_ACTIVE 41 41n
|
||||
D RI_SD_NAME 42 42n
|
||||
D PC_SD_NAME 43 43n
|
||||
D RI_SD_ADDR 44 44n
|
||||
D PC_SD_ADDR 45 45n
|
||||
D RI_SD_CITY 46 46n
|
||||
D PC_SD_CITY 47 47n
|
||||
D RI_SD_STATE 48 48n
|
||||
D PC_SD_STATE 49 49n
|
||||
D RI_SD_ZIP 50 50n
|
||||
D PC_SD_ZIP 51 51n
|
||||
D RI_SD_ACCTPH 52 52n
|
||||
D PC_SD_ACCTPH 53 53n
|
||||
D RI_SD_ACCTMGR 54 54n
|
||||
D PC_SD_ACCTMGR 55 55n
|
||||
D RI_SD_CORPPH 56 56n
|
||||
D PC_SD_CORPPH 57 57n
|
||||
|
||||
//*=== Fields to control the subfile screen =====================
|
||||
// SflRRN s 5 0
|
||||
// RcdsInSfl s 5 0
|
||||
// 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.
|
||||
|
||||
//=== Screen Header Text =======================================
|
||||
D H2TextD s like(SH_FUNCT)
|
||||
D inz('Display')
|
||||
D H2TextU s like(SH_FUNCT)
|
||||
D inz('Add/Change')
|
||||
|
||||
//=== Text for function keys ===================================
|
||||
D F3Text c 'F3=Exit'
|
||||
//F4Text c 'F4=Prompt*'
|
||||
d F5Text c 'F5=Refresh'
|
||||
d F12Text c 'F12=Cancel'
|
||||
|
||||
//=== External Programs Prototypes =============================
|
||||
D PmtState PR EXTPGM('PMTSTATER')
|
||||
D TheState like(STATE)
|
||||
d
|
||||
//=== Global Switches ==========================================
|
||||
D SflMsgSnt s n
|
||||
D CowsComeHome c const('0')
|
||||
D Function s 1a
|
||||
D Displaying c const('D')
|
||||
D Editing c const('E')
|
||||
D Adding c const('A')
|
||||
D Closing c const('C')
|
||||
D NoErrors s n
|
||||
|
||||
// === Global Fields ===========================================
|
||||
D Orig_CHGTIME s z
|
||||
|
||||
//=== Work Fields ==============================================
|
||||
D wkInt s 10i 0
|
||||
D wkMsgText s 256a varying
|
||||
|
||||
//=== Translation ==============================================
|
||||
D Lower c const('abcdefghijklmnopqrstuvwxyz')
|
||||
D Upper c const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
|
||||
|
||||
D HighVals s 30 inz(*hival)
|
||||
|
||||
// === Next available customer number ==========================
|
||||
// CUSTNEXT ds dtaara(CUSTNEXT)
|
||||
d Cust_Next s 4p 0 dtaara(CUSTNEXT)
|
||||
|
||||
//=== Program Status Data Structure ============================
|
||||
D ProgStatus sds
|
||||
D PgmName *PROC
|
||||
D CURR_USER 358 367 * Current user
|
||||
D USER 254 263 * User name
|
||||
|
||||
//=== Program Parameters =======================================
|
||||
D pId s Like(CUSTID)
|
||||
D pMaintain s 1a
|
||||
|
||||
// I/O/B Type Lgth Description
|
||||
// ----- ---- ---- -----------------------------------------
|
||||
// I P 3 Manufacturing Cust Mast
|
||||
// I C 1 If Y, then maintenance is allowed.
|
||||
// Otherwise, or omitted, display only.
|
||||
|
||||
//==============================================================
|
||||
// === Program Starts Here =====================================
|
||||
//==============================================================
|
||||
C *Entry plist
|
||||
C parm pId
|
||||
C parm pMaintain
|
||||
/FREE
|
||||
|
||||
//=== Set SQL Options ===============================
|
||||
exec sql set option datfmt=*iso,
|
||||
closqlcsr=*endmod,
|
||||
commit = *NONE;
|
||||
|
||||
//=== Initialization Logic ===================================
|
||||
exsr Init;
|
||||
|
||||
//--- Establish window that other formats refer to ---
|
||||
write SH_HDR;
|
||||
|
||||
//============================================================
|
||||
// === Main Program Loop =====================================
|
||||
//============================================================
|
||||
// Loops until logic decides to exit.
|
||||
dou CowsComeHome;
|
||||
|
||||
select;
|
||||
// =======================================================
|
||||
// === Displaying an existing Customer ===================
|
||||
// =======================================================
|
||||
when Function = Displaying;
|
||||
exsr ReadRecd;
|
||||
if SQLSTT = SQLNoData;
|
||||
SQLProblem('Calling error 1: Code passed in does not exist.');
|
||||
endif;
|
||||
exsr FillScreenFields;
|
||||
// All Fields protected
|
||||
exsr ProtectAll;
|
||||
exsr ScreenIO;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
// =======================================================
|
||||
// === Updating an existing Customer =====================
|
||||
// =======================================================
|
||||
when Function = Editing;
|
||||
exsr ReadRecd;
|
||||
if SQLSTT = SQLNoData;
|
||||
SQLProblem('Calling error 2: Code passed in does not exist.');
|
||||
endif;
|
||||
exsr FillScreenFields;
|
||||
|
||||
// Write/read screen until all data is valid,
|
||||
// then re-display for confirmation to update.
|
||||
dou NoErrors;
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
|
||||
when Key = F03 or Key = F12;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
|
||||
when Key = F05;
|
||||
exsr ReadRecd;
|
||||
if SQLSTT = SQLNoData;
|
||||
// Record vanished!
|
||||
SflMsgSnt= SndSflMsg('DEM0599'); //Delete, redo search
|
||||
clear CUSTMAST;
|
||||
endif;
|
||||
NoErrors = *off;
|
||||
|
||||
when Key = F04;
|
||||
// CF04 reads the screen data. We then prompt and replace
|
||||
// anything in the state field, then we redisplay and
|
||||
// re-edit the screen data.
|
||||
select;
|
||||
// --- Prompt for State Code
|
||||
when SD_PMT_FLD = 'SD_STATE';
|
||||
PmtState(STATE);
|
||||
SD_STATE = STATE;
|
||||
NoErrors = *off; // DOU Loop again
|
||||
// --- Field not promptable
|
||||
other;
|
||||
// Use F4 only in field followed by + sign
|
||||
SflMsgSnt= SndSflMsg('DEM0005');
|
||||
NoErrors = *off; // DOU Loop again
|
||||
endsl;
|
||||
|
||||
when Key = Enter;
|
||||
exsr EditUpdData;
|
||||
if NoErrors;
|
||||
// Re-display screen fields for confirmation
|
||||
exsr ProtectAll;
|
||||
exsr FillScreenFields;
|
||||
SflMsgSnt = SndSflMsg('DEM0000'); // Enter to update ...
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
when Key = F12 or Key = F03 or Key = F05;
|
||||
// Loop again
|
||||
when Key = Enter;
|
||||
exsr UpdateRecd;
|
||||
if NoErrors;
|
||||
exsr CloseDownPgm; // Success! Exit program
|
||||
return;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off;
|
||||
endsl;
|
||||
endif;
|
||||
// Open up fields for correction of errors
|
||||
exsr UnprotectAll;
|
||||
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off; // Stay in dou NoErrors
|
||||
endsl;
|
||||
enddo;
|
||||
|
||||
// =======================================================
|
||||
// === Adding a new Customer =============================
|
||||
// =======================================================
|
||||
when Function=Adding;
|
||||
clear CUSTMAST;
|
||||
//Default status to active
|
||||
ACTIVE = 'Y';
|
||||
//set just to make screen look better
|
||||
CHGTIME = %timestamp();
|
||||
CHGUSER = CURR_USER;
|
||||
exsr FillScreenFields;
|
||||
|
||||
dou NoErrors;
|
||||
// Write/read screen until all data is valid,
|
||||
// then re-display for confirmation to update.
|
||||
//All fields can be keyed
|
||||
exsr UnProtectAll;
|
||||
exsr ScreenIO;
|
||||
select;
|
||||
when Key = F03 or Key = F12;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
when Key = Enter;
|
||||
exsr EditUpdData;
|
||||
if NoErrors;
|
||||
// Re-display field for confirmation
|
||||
exsr ProtectAll;
|
||||
SflMsgSnt = SndSflMsg('DEM0009'); // Enter to add ...
|
||||
exsr FillScreenFields;
|
||||
exsr ScreenIo;
|
||||
select;
|
||||
when Key=F12;
|
||||
exsr FillScreenFields;
|
||||
when Key = Enter;
|
||||
exsr AddRecd;
|
||||
if NoErrors;
|
||||
exsr CloseDownPgm;
|
||||
return;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
NoErrors = *off;
|
||||
endsl;
|
||||
endif;
|
||||
other;
|
||||
SflMsgSnt = SndSflMsg('DEM0003'); // Key not active
|
||||
endsl;
|
||||
enddo;
|
||||
|
||||
other;
|
||||
// =======================================================
|
||||
//=== Goofed - Should ever happen ========================
|
||||
// =======================================================
|
||||
dump(a);
|
||||
SflMsgSnt = SndSflMsg('DEM9999'); // Contact IT now ...
|
||||
return;
|
||||
endsl;
|
||||
|
||||
enddo;
|
||||
return;
|
||||
|
||||
//============================================================
|
||||
//=== End of Main Program Loop ===============================
|
||||
//============================================================
|
||||
return;
|
||||
|
||||
|
||||
//=== ReadRecd ===============================================
|
||||
begsr ReadRecd;
|
||||
exec sql
|
||||
select
|
||||
CUSTID
|
||||
,NAME
|
||||
,ADDR
|
||||
,CITY
|
||||
,STATE
|
||||
,ZIP
|
||||
,CORPPHONE
|
||||
,ACCTMGR
|
||||
,ACCTPHONE
|
||||
,ACTIVE
|
||||
,CHGTIME
|
||||
,CHGUSER
|
||||
into :CUSTMAST
|
||||
from CUSTMAST
|
||||
where CUSTID = :pID
|
||||
;
|
||||
if SQLSTT <> SQLSuccess and SQLSTT <> SQLNoData;
|
||||
SQLProblem('ReadRecd');
|
||||
endif;
|
||||
Orig_CHGTIME = CHGTIME; // Save for update comparison
|
||||
endsr;
|
||||
|
||||
//=== FillScreenFields =======================================
|
||||
begsr FillScreenFields;
|
||||
SD_CUSTID = CUSTID;
|
||||
SD_NAME = NAME;
|
||||
SD_ADDR = ADDR;
|
||||
SD_CITY = CITY;
|
||||
SD_STATE = STATE;
|
||||
SD_ZIP = ZIP;
|
||||
SD_ACTIVE = ACTIVE;
|
||||
SD_ACCTPH = ACCTPHONE;
|
||||
SD_ACCTMGR =ACCTMGR;
|
||||
SD_CORPPH = CORPPHONE;
|
||||
exec sql VALUES
|
||||
varchar_format(:CHGTIME, 'YYYY-Mon-DD')
|
||||
concat ' at ' concat
|
||||
varchar_format(:CHGTIME,'HH24:MI:SS')
|
||||
into :SD_CHGTIME;
|
||||
SD_CHGUSER = CHGUSER;
|
||||
endsr;
|
||||
|
||||
//=== EditUpdData ============================================
|
||||
// Edit the screen fields that can be changed on a update.
|
||||
// Give up when the first error found.
|
||||
// A valid screen field is moved to the database record.
|
||||
begsr EditUpdData;
|
||||
NoErrors = *on;
|
||||
|
||||
// ACTIVE Status
|
||||
exsr Edit_SD_ACTIVE;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// Name
|
||||
exsr Edit_SD_NAME;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// Addr
|
||||
exsr Edit_SD_ADDR;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// City
|
||||
exsr Edit_SD_CITY;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// State
|
||||
exsr Edit_SD_STATE;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// ZIP
|
||||
exsr Edit_SD_ZIP;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// Account Phone
|
||||
exsr Edit_SD_ACCTPH;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// Account Manager
|
||||
exsr Edit_SD_ACCTMGR;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
// Corporate Phone
|
||||
exsr Edit_SD_CORPPH;
|
||||
if NoErrors = *off;
|
||||
leavesr;
|
||||
endif;
|
||||
|
||||
endsr;
|
||||
|
||||
//=== EditAddData ============================================
|
||||
// Edit the screen fields needed to add a record.
|
||||
// Give up when the first error found.
|
||||
// A valid screen field is moved to the database record.
|
||||
begsr EditAddData;
|
||||
NoErrors = *on;
|
||||
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACTIVE==========================================
|
||||
begsr Edit_SD_ACTIVE;
|
||||
if SD_ACTIVE = 'Y' or SD_ACTIVE = 'N';
|
||||
ACTIVE = SD_ACTIVE;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0501': 'Active Status');
|
||||
NoErrors = *off;
|
||||
RI_SD_ACTIVE = *on;
|
||||
PC_SD_ACTIVE = *on;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_NAME ===========================================
|
||||
begsr Edit_SD_NAME;
|
||||
if SD_NAME <> ' ';
|
||||
NAME = SD_NAME;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Name');
|
||||
NoErrors= *off;
|
||||
RI_SD_NAME = *ON;
|
||||
PC_SD_NAME = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ADDR ===========================================
|
||||
begsr Edit_SD_ADDR;
|
||||
if SD_ADDR <> ' ';
|
||||
ADDR = SD_ADDR;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Address');
|
||||
NoErrors= *off;
|
||||
RI_SD_ADDR = *ON;
|
||||
PC_SD_ADDR = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_CITY ===========================================
|
||||
begsr Edit_SD_CITY;
|
||||
if SD_CITY <> ' ';
|
||||
CITY = SD_CITY;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'City');
|
||||
NoErrors= *off;
|
||||
RI_SD_CITY = *ON;
|
||||
PC_SD_CITY = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_STATE ==========================================
|
||||
begsr Edit_SD_STATE;
|
||||
exec sql select STATE into :STATE
|
||||
from STATES
|
||||
where STATE = :SD_STATE;
|
||||
if SQLSTT = SQLSuccess;
|
||||
STATE = SD_STATE;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0503');
|
||||
NoErrors= *off;
|
||||
RI_SD_STATE= *ON;
|
||||
PC_SD_STATE = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ZIP ============================================
|
||||
begsr Edit_SD_ZIP;
|
||||
if SD_ZIP <> ' ';
|
||||
ZIP = SD_ZIP;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'ZIP');
|
||||
NoErrors= *off;
|
||||
RI_SD_ZIP= *ON;
|
||||
PC_SD_ZIP = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACCTPH =========================================
|
||||
begsr Edit_SD_ACCTPH;
|
||||
if SD_ACCTPH <> ' ';
|
||||
ACCTPHONE = SD_ACCTPH;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Phone');
|
||||
NoErrors= *off;
|
||||
RI_SD_ACCTPH= *ON;
|
||||
PC_SD_ACCTPH = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_ACCTMGR =========================================
|
||||
begsr Edit_SD_ACCTMGR;
|
||||
if SD_ACCTMGR <> ' ';
|
||||
ACCTMGR = SD_ACCTMGR;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Account Manager Name');
|
||||
NoErrors= *off;
|
||||
RI_SD_ACCTMGR= *ON;
|
||||
PC_SD_ACCTMGR = *ON;
|
||||
endsr;
|
||||
|
||||
//=== Edit_SD_CORPPH =========================================
|
||||
begsr Edit_SD_CORPPH;
|
||||
if SD_CORPPH <> ' ';
|
||||
CORPPHONE = SD_CORPPH;
|
||||
leavesr;
|
||||
endif;
|
||||
SflMsgSnt = SndSflMsg('DEM0502': 'Corporate Phone');
|
||||
NoErrors= *off;
|
||||
RI_SD_CORPPH= *ON;
|
||||
PC_SD_CORPPH = *ON;
|
||||
endsr;
|
||||
|
||||
|
||||
//=== AddRecd ================================================
|
||||
// Insert a record into the file.
|
||||
// Returns: NoErrors = *on if the add was successful.
|
||||
begsr AddRecd;
|
||||
NoErrors = *on;
|
||||
in *LOCK Cust_Next;
|
||||
Cust_Next += 1;
|
||||
Out Cust_Next;
|
||||
CUSTID= Cust_Next;
|
||||
CHGTIME = %timestamp();
|
||||
CHGUSER = USER;
|
||||
exec sql
|
||||
insert into custmast
|
||||
values(:CUSTMAST)
|
||||
;
|
||||
// There is no good reason why insert should fail.
|
||||
if SQLSTT <> SQLSuccess;
|
||||
SQLProblem('Insert into CUSTMAST ...');
|
||||
endif;
|
||||
endsr;
|
||||
|
||||
//=== UpdateRecd =============================================
|
||||
// Updates the record with the screen data.
|
||||
// The SQL WHERE checks the last time stamp and if different,
|
||||
// doesn't update because someone else updated the record.
|
||||
// SQLERRD(3) contains the actual number of records updated
|
||||
// when the update is successful.
|
||||
begsr UpdateRecd;
|
||||
NoErrors = *on;
|
||||
exec sql
|
||||
update CUSTMAST
|
||||
SET NAME = :SD_NAME,
|
||||
ADDR = :SD_ADDR,
|
||||
CITY = :SD_CITY,
|
||||
STATE = :SD_STATE,
|
||||
ZIP = :SD_ZIP,
|
||||
CORPPHONE = :SD_CORPPH,
|
||||
ACCTMGR = :SD_ACCTMGR,
|
||||
ACCTPHONE = :SD_ACCTPH,
|
||||
ACTIVE = :SD_ACTIVE,
|
||||
CHGTIME = CURRENT TIMESTAMP,
|
||||
CHGUSER = USER
|
||||
where CUSTID = :CUSTID
|
||||
-- and compare timestamp
|
||||
and CHGTIME = :Orig_CHGTIME;
|
||||
select;
|
||||
when SQLSTT = SQLNOData; // Update Failed
|
||||
SflMsgSnt = SndSflMsg('DEM1002'); // Record changed, review.
|
||||
NoErrors = *off;
|
||||
// Show the changed data
|
||||
exsr ReadRecd;
|
||||
exsr FillScreenFields;
|
||||
|
||||
when SQLSTT =SQLRowLocked; // Row locked
|
||||
// exec sql get diagnostics condition 1 :wkMsgText = MESSAGE_TEXT;
|
||||
sflMsgSnt = SndSflMsg('DEM1001' : SQLERRMC);
|
||||
NoErrors = *off;
|
||||
when SQLSTT = SQLSuccess;
|
||||
|
||||
other;
|
||||
SQLProblem('Update CUSTMAST');
|
||||
endsl;
|
||||
endsr;
|
||||
|
||||
//=== ClearScreenData ========================================
|
||||
begsr ClearScreenData;
|
||||
clear DETAILS;
|
||||
endsr;
|
||||
|
||||
//=== ProtectAll =============================================
|
||||
begsr ProtectAll;
|
||||
Protect_SD_ALL = *on;
|
||||
endsr;
|
||||
|
||||
//=== UnProtectAll ===========================================
|
||||
begsr UnProtectAll;
|
||||
Protect_SD_ALL = *off;
|
||||
endsr;
|
||||
|
||||
//=== 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;
|
||||
|
||||
exfmt Details;
|
||||
|
||||
// Clear most display file indicators
|
||||
clear dfIndClr;
|
||||
|
||||
// Clear any messages in the error subfile.
|
||||
if SflMsgSnt = *on;
|
||||
SflMsgSnt = ClrMsgPgmQ(PgmName);
|
||||
write MSGCTL;
|
||||
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);
|
||||
SFT_KEYS = CatB(SFT_KEYS : F12Text);
|
||||
endsr;
|
||||
|
||||
//=== CloseDownPgm ===========================================
|
||||
// Things to do before we issue a return to the caller
|
||||
begsr CloseDownPgm;
|
||||
// write DUMMY;
|
||||
// close MTNCUSTD;
|
||||
// Do not turn on *LR to maintain an SFL display in caller
|
||||
endsr;
|
||||
|
||||
//=== Init ===================================================
|
||||
// Every time initialization logic
|
||||
begsr Init;
|
||||
|
||||
//--- Analyse parameters ---
|
||||
select;
|
||||
when %parms() = 0; // Close down
|
||||
if %open(MTNCUSTD);
|
||||
close MTNCUSTD;
|
||||
endif;
|
||||
// *inlr = *on;
|
||||
return;
|
||||
when %parms() = 1;
|
||||
Function = Displaying;
|
||||
when %parms() = 2;
|
||||
select;
|
||||
when pMaintain = Closing;
|
||||
when pMaintain = Adding;
|
||||
Function = Adding;
|
||||
when pMaintain = Editing;
|
||||
Function = Editing;
|
||||
other;
|
||||
Function = Displaying;
|
||||
endsl;
|
||||
other;
|
||||
// Problem.
|
||||
endsl;
|
||||
|
||||
//--- Miscellaneous setup ---
|
||||
MSGPGMQ = PgmName;
|
||||
SH_PGM = PgmName;
|
||||
clear CUSTMAST;
|
||||
clear dfIndDS;
|
||||
exsr BldFkeyText;
|
||||
|
||||
//--- Open display file ---
|
||||
if not %open(MTNCUSTD);
|
||||
open MTNCUSTD;
|
||||
endif;
|
||||
endsr;
|
||||
//============================================================
|
||||
// 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
|
||||
P
|
||||
//=== 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: 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 PCAMSGF
|
||||
//--------------------------------------------------------------
|
||||
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(PgmName:
|
||||
wkMsgid:
|
||||
wkMsgFile:
|
||||
wkMsgData);
|
||||
|
||||
retField = *on;
|
||||
RETURN retField;
|
||||
|
||||
/END-FREE
|
||||
P SndSflMsg E
|
||||
|
||||
184
5250_Subfile/PMTCUSTD
Normal file
184
5250_Subfile/PMTCUSTD
Normal file
@ -0,0 +1,184 @@
|
||||
A*%%TS SD 20200723 195503 LENNONS REL-V7R4M0 5770-WDS
|
||||
A*===============================================================
|
||||
A* This is a full screen expanding subfile to search for and
|
||||
A* select an item number.
|
||||
A* ??- There are "from" and "to" positioner fields.
|
||||
A* ??- There is a filter field on config.
|
||||
A* ??- A message subfile is included.
|
||||
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 an EXFMT.
|
||||
a* 79 SC_NAME Position Cursor
|
||||
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*%%EC
|
||||
A DSPSIZ(24 80 *DS3)
|
||||
A PRINT
|
||||
A INDARA
|
||||
A ALTHELP
|
||||
A CA03
|
||||
A CF04
|
||||
A CA05
|
||||
A CA06
|
||||
A CA09
|
||||
A* CF10
|
||||
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 SH_PGM 10A O 1 2
|
||||
A 1 33'Customer Master'
|
||||
A 1 72DATE
|
||||
A EDTCDE(Y)
|
||||
A SH_FUNCT 50A O 2 16DSPATR(HI)
|
||||
A 2 72TIME
|
||||
A 2 2USER
|
||||
A*===============================================================
|
||||
A*=== Subfile: Fields begin with SF_ ===========================
|
||||
A*
|
||||
A R SFL SFL
|
||||
A*%%TS SD 20200719 214706 LENNONS REL-V7R4M0 5770-WDS
|
||||
A TEXT('SubFile')
|
||||
A 80 SFLNXTCHG
|
||||
A SF_ACT_H 1D H
|
||||
A SF_CUST_H 4D H
|
||||
A SF_OPT 1A B 9 3
|
||||
A 81 DSPATR(RI)
|
||||
A 82 DSPATR(PC)
|
||||
A SF_NAME 40A O 9 6
|
||||
A 83 COLOR(RED)
|
||||
A SF_CITY 20A O 9 47
|
||||
A 83 COLOR(RED)
|
||||
A SF_STATE 2A O 9 69
|
||||
A 83 COLOR(RED)
|
||||
A SF_ZIP 5A O 9 74
|
||||
A 83 COLOR(RED)
|
||||
A*===============================================================
|
||||
A*=== Subfile Control: Fields begin with SC_ ====================
|
||||
A*
|
||||
A R SFLCTL SFLCTL(SFL)
|
||||
A*%%TS SD 20200723 195503 LENNONS REL-V7R4M0 5770-WDS
|
||||
A SFLSIZ(0013)
|
||||
A SFLPAG(0012)
|
||||
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 SC_PMT_RCD 10A H
|
||||
A SC_PMT_FLD 10A H
|
||||
A**** SC_CSR_RCD 4S 0H SFLRCDNBR(CURSOR *TOP)
|
||||
A SC_CSR_RCD 4S 0H SFLRCDNBR(CURSOR)
|
||||
A 4 2'Name starts with:'
|
||||
A 4 31'City Starts with:'
|
||||
A 4 60'State+'
|
||||
A 4 71'Including'
|
||||
A COLOR(RED)
|
||||
A N03 DSPATR(ND)
|
||||
A SC_NAME 13A B 5 6
|
||||
A 79 DSPATR(PC)
|
||||
A SC_CITY 13A B 5 35
|
||||
A SC_STATE 2A B 5 62
|
||||
A 5 71'Inctives'
|
||||
A COLOR(RED)
|
||||
A N03 DSPATR(ND)
|
||||
A 6 2'Type options, press Enter.'
|
||||
A COLOR(BLU)
|
||||
A SC_OPTIONS 69A O 7 2COLOR(BLU)
|
||||
A 8 2'Opt'
|
||||
A DSPATR(HI)
|
||||
A 8 6'Customer Name'
|
||||
A DSPATR(UL)
|
||||
A COLOR(WHT)
|
||||
A 8 47'City '
|
||||
A DSPATR(UL)
|
||||
A COLOR(WHT)
|
||||
A 8 69'St'
|
||||
A DSPATR(UL)
|
||||
A COLOR(WHT)
|
||||
A 8 74'ZIP '
|
||||
A COLOR(WHT)
|
||||
A DSPATR(UL)
|
||||
A*===============================================================
|
||||
A*=== Screen footer & function keys: Fields begin with SFT_ ====
|
||||
A*
|
||||
A R SFT_FKEY
|
||||
A*%%TS SD 20111208 204102 SLENNON REL-V7R1M0 5770-WDS
|
||||
A TEXT('Screen Footer')
|
||||
A OVERLAY
|
||||
A 22 2' Demo Cor-
|
||||
A p of America -
|
||||
A '
|
||||
A DSPATR(UL)
|
||||
A SFT_KEYS 78A O 23 2COLOR(BLU)
|
||||
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(24)
|
||||
A MSGKEY SFLMSGKEY
|
||||
A MSGPGMQ 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 PAGEDOWN
|
||||
A PAGEUP
|
||||
A OVERLAY
|
||||
A SFLDSP
|
||||
A SFLDSPCTL
|
||||
A SFLINZ
|
||||
A N90 SFLEND
|
||||
A SFLSIZ(0002)
|
||||
A SFLPAG(0001)
|
||||
A MSGPGMQ SFLPGMQ(10)
|
||||
A*===============================================================
|
||||
A*=== Dummy Record ==============================================
|
||||
A*
|
||||
A R DUMMY
|
||||
A 24 79'*'
|
||||
A*%%RS+<record-sequences>
|
||||
A*%%RS+ <sequence name="TOP">
|
||||
A*%%RS+ <device type="display" width="80" height="24" />
|
||||
A*%%RS+ <record-write record-format="SH_HDR" />
|
||||
A*%%RS+ <record-write record-format="SFT_FKEY" />
|
||||
A*%%RS+ <record-write record-format="SFL" />
|
||||
A*%%RS+ <record-write record-format="SFLCTL" />
|
||||
A*%%RS+ <record-write record-format="MSGSFL" />
|
||||
A*%%RS+ <record-write record-format="MSGCTL" />
|
||||
A*%%RS+ </sequence>
|
||||
A*%%RS </record-sequences>
|
||||
1001
5250_Subfile/PMTCUSTR
Normal file
1001
5250_Subfile/PMTCUSTR
Normal file
File diff suppressed because it is too large
Load Diff
@ -1,19 +1,19 @@
|
||||
### 5250 Subfile: Full Screen and Windows
|
||||
## 5250 Subfile: Full Screen and Windows
|
||||
|
||||
(__Under Construction__)
|
||||
|
||||
This is a working application that allows display, selection and maintenance of a customer master. The screens are _similar_ to what you see in PDM. The code is modular and there are several programs that can be called from multiple places. SQL is used for all database IO. There are full screen subfiles and subfiles in a window.
|
||||
|
||||
#### Sample Inquiry Screens
|
||||
### Sample Inquiry Screens
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
#### Sample Maintenance Screen
|
||||
### Sample Maintenance Screen
|
||||
|
||||
|
||||
* PMTCUSTR
|
||||
#### 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.
|
||||
|
||||
@ -23,12 +23,20 @@ This is a working application that allows display, selection and maintenance of
|
||||
- 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 Maintanance. Selection could be used for any in-house program that needed to prompt for a customer id number.
|
||||
|
||||
* PMTCUSTD
|
||||
|
||||
This is the display file for PMTCUSTR.
|
||||
#### MTNCUSTR/MTNCUSTD
|
||||
|
||||
* CustMast.SQL
|
||||
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.
|
||||
|
||||
#### CRTMSGF
|
||||
|
||||
Creates the CUSTMSGF message file used by the programs.
|
||||
|
||||
#### CRTDTAARA
|
||||
|
||||
Create 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_ to your target library.
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user