Add Supporting code
Copy file and service program
This commit is contained in:
SJLennon
@@ -0,0 +1,51 @@
|
|||||||
|
// 5250 Attention Indicator (AID) definitions
|
||||||
|
D F01 C CONST(X'31')
|
||||||
|
D F02 C CONST(X'32')
|
||||||
|
D F03 C CONST(X'33')
|
||||||
|
D F04 C CONST(X'34')
|
||||||
|
D F05 C CONST(X'35')
|
||||||
|
D F06 C CONST(X'36')
|
||||||
|
D F07 C CONST(X'37')
|
||||||
|
D F08 C CONST(X'38')
|
||||||
|
D F09 C CONST(X'39')
|
||||||
|
D F10 C CONST(X'3A')
|
||||||
|
D F11 C CONST(X'3B')
|
||||||
|
D F12 C CONST(X'3C')
|
||||||
|
D F13 C CONST(X'B1')
|
||||||
|
D F14 C CONST(X'B2')
|
||||||
|
D F15 C CONST(X'B3')
|
||||||
|
D F16 C CONST(X'B4')
|
||||||
|
D F17 C CONST(X'B5')
|
||||||
|
D F18 C CONST(X'B6')
|
||||||
|
D F19 C CONST(X'B7')
|
||||||
|
D F20 C CONST(X'B8')
|
||||||
|
D F21 C CONST(X'B9')
|
||||||
|
D F22 C CONST(X'BA')
|
||||||
|
D F23 C CONST(X'BB')
|
||||||
|
D F24 C CONST(X'BC')
|
||||||
|
// Page Down/Roll Up
|
||||||
|
D RollUp C CONST(X'F5')
|
||||||
|
D PageDown C CONST(X'F5')
|
||||||
|
// Page Up/Roll Down
|
||||||
|
D RollDown C CONST(X'F4')
|
||||||
|
D PageUp C CONST(X'F4')
|
||||||
|
// Enter
|
||||||
|
D Enter C CONST(X'F1')
|
||||||
|
D Home C CONST(X'F8')
|
||||||
|
|
||||||
|
//Mouse events linked to DDS MOUBTN keyword
|
||||||
|
d ME00 c const(x'70')
|
||||||
|
d ME01 c const(x'71')
|
||||||
|
d ME02 c const(x'72')
|
||||||
|
d ME03 c const(x'73')
|
||||||
|
d ME04 c const(x'74')
|
||||||
|
d ME05 c const(x'75')
|
||||||
|
d ME06 c const(x'76')
|
||||||
|
d ME07 c const(x'77')
|
||||||
|
d ME08 c const(x'78')
|
||||||
|
d ME09 c const(x'79')
|
||||||
|
d ME10 c const(x'7A')
|
||||||
|
d ME11 c const(x'7B')
|
||||||
|
d ME12 c const(x'7C')
|
||||||
|
d ME13 c const(x'7D')
|
||||||
|
d ME14 c const(x'7E')
|
||||||
@@ -0,0 +1,13 @@
|
|||||||
|
### Copy Members
|
||||||
|
|
||||||
|
These are source files that will be copied into programs using /COPY or /INCLUDE
|
||||||
|
|
||||||
|
* ##AIDBTYES
|
||||||
|
|
||||||
|
5250 Attention ID Definitions. These are the value that are return in byte 369 of the display file indicator data structure when a screen entry is made.
|
||||||
|
|
||||||
|
* SRV_MSG_P
|
||||||
|
|
||||||
|
Prototype definition for procedures in the SRV_MSG service program.
|
||||||
|
|
||||||
|
|
||||||
@@ -0,0 +1,22 @@
|
|||||||
|
|
||||||
|
//=== Prototypes for SRV_MSG routines ========================
|
||||||
|
//============================================================
|
||||||
|
D SndMsgPgmQ pr Send Msg to PGM Q
|
||||||
|
D pMsgQ 10
|
||||||
|
D pMsgid 7
|
||||||
|
D pMsgFile 10
|
||||||
|
D pMsgDta 80 options(*NOPASS)
|
||||||
|
D Varying
|
||||||
|
//============================================================
|
||||||
|
D ClrMsgPgmQ pr N Clear PGM Msg Q
|
||||||
|
D pPgmMsgQ 10
|
||||||
|
|
||||||
|
//============================================================
|
||||||
|
D SndEscMsg pr Send ESC Msg
|
||||||
|
D piMsg 1024a Const Varying
|
||||||
|
|
||||||
|
//============================================================
|
||||||
|
D SndInfMsg pr Send INF Msg
|
||||||
|
D piMsg 1024a Const Varying
|
||||||
|
|
||||||
|
//=== End of Prototypes forSRV_MSG Routines ==================
|
||||||
@@ -6,6 +6,14 @@ More developers are learning about the **IBM i** as a wonderful business platfor
|
|||||||
My intent is to provide real programs that help you learn, or improve your current understanding, and which you can adapt to you needs.
|
My intent is to provide real programs that help you learn, or improve your current understanding, and which you can adapt to you needs.
|
||||||
Feel free to provide comments and feedback.
|
Feel free to provide comments and feedback.
|
||||||
|
|
||||||
### SQL_SKELETON
|
## Copy_Mbrs
|
||||||
|
|
||||||
|
Code to be copies into other programs.
|
||||||
|
|
||||||
|
## Service_Pgms
|
||||||
|
|
||||||
|
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.
|
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.
|
||||||
|
|||||||
@@ -0,0 +1,7 @@
|
|||||||
|
PGM
|
||||||
|
/* Create UTIL_BND binding directory in *CURLIB */
|
||||||
|
/* Change next statement if a different library is needed */
|
||||||
|
CRTBNDDIR BNDDIR(*CURLIB/UTIL_BND) TEXT('Utilities +
|
||||||
|
Service PGMs')
|
||||||
|
ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
|
||||||
|
ENDPGM
|
||||||
@@ -0,0 +1,19 @@
|
|||||||
|
### Service Programss
|
||||||
|
|
||||||
|
Utility Service Programs
|
||||||
|
|
||||||
|
* SRV_MSG
|
||||||
|
|
||||||
|
Contains procedures to send messages from an RPG program.
|
||||||
|
|
||||||
|
* CRTBNDDIR
|
||||||
|
|
||||||
|
A CLLE program to create UTIL_BND, a binding directory for easy compiling of program that use SRV_MSG.
|
||||||
|
|
||||||
|
* SRV_MSGTR
|
||||||
|
|
||||||
|
RPG program to test the procedures in SRV_MSG.
|
||||||
|
|
||||||
|
* SRV_MSGTD
|
||||||
|
|
||||||
|
Display file used by SRV_MSGTR.
|
||||||
@@ -0,0 +1,257 @@
|
|||||||
|
|
||||||
|
//==============================================================
|
||||||
|
//=== SRV_MSG service program contains prodcedure for sending
|
||||||
|
//=== messages with QMHSNDPM
|
||||||
|
//==============================================================
|
||||||
|
// CRTRPGMOD MODULE(SRV_MSG) DEFINE(COMPILESRV_MSG)
|
||||||
|
// CRTSRVPGM SRVPGM(SRV_MSG) EXPORT(*ALL)
|
||||||
|
// ADDBNDDIRE BNDDIR(UTIL_BND) OBJ((SRV_MSG *SRVPGM *DEFER))
|
||||||
|
|
||||||
|
h nomain option(*NoDebugIo: *srcstmt)
|
||||||
|
/include Demo,Srv_Msg_P
|
||||||
|
|
||||||
|
//=== QMHSNDPM internal prototype =============================
|
||||||
|
D QMHSNDPM pr ExtPgm('QMHSNDPM')
|
||||||
|
D piMsgId 7a Const
|
||||||
|
D piMsgFile 20a Const
|
||||||
|
D piMsgData 1024a Const OPTIONS(*varsize)
|
||||||
|
D piMsgDataLgth 10i 0 Const
|
||||||
|
D piMsgType 10a Const
|
||||||
|
D piCallStk 10a Const
|
||||||
|
D piRelCallStk 10i 0 Const
|
||||||
|
D piRtnMsgKey 4a
|
||||||
|
D apiErrorDS 17a
|
||||||
|
|
||||||
|
//=== QMHRMVPM internal prototype =============================
|
||||||
|
d QMHRMVPM pr Extpgm('QMHRMVPM')
|
||||||
|
d pPgmMsgQ 10a
|
||||||
|
d PgmStk 10i 0
|
||||||
|
d MsgKey 4a
|
||||||
|
d Remove 10a
|
||||||
|
D apiErrorDS 17a
|
||||||
|
|
||||||
|
//=== SNDMSGPGMQ ===============================================
|
||||||
|
// SeND a MeSsaGe to a ProGraM message Queue.
|
||||||
|
// Sends a pre-defined message to a program message queue
|
||||||
|
// that you provide as a parameter.
|
||||||
|
|
||||||
|
// Primarily designed to be used in interactive programs
|
||||||
|
// that send messages via a message subfile.
|
||||||
|
|
||||||
|
// See also CLRMSGPGMQ which clears messages from a program
|
||||||
|
// message queue.
|
||||||
|
//==============================================================
|
||||||
|
// Conceptual call:
|
||||||
|
//=================
|
||||||
|
// H BndDir('UTIL_BND')
|
||||||
|
// /include Demo,Srv_Msg_P
|
||||||
|
// D ProgStatus sds
|
||||||
|
// D PgmName *PROC
|
||||||
|
// SNDMSGPGMQ(PgmName:
|
||||||
|
// Msgid:
|
||||||
|
// MsgFile:
|
||||||
|
// MsgDta);
|
||||||
|
//==============================================================
|
||||||
|
P SndMsgPgmQ b export
|
||||||
|
d SndMsgPgmQ pi
|
||||||
|
d pMsgQ 10
|
||||||
|
d pMsgid 7
|
||||||
|
d pMsgFile 10
|
||||||
|
d pMsgDta 80 options(*NOPASS)
|
||||||
|
d Varying
|
||||||
|
//=== Calling Parameters =======================================
|
||||||
|
// Parm I/O/B Description
|
||||||
|
// ---- ----- -----------
|
||||||
|
// pMsgQ I Message queue to send to. Usually the
|
||||||
|
// program name, or the MAIN procedure name
|
||||||
|
// obtained with %proc().
|
||||||
|
// pMsgId I Predefined message id, e.g. CPF9898.
|
||||||
|
// pMsgFile I Message file containing pMsgid. (Library
|
||||||
|
// is assumed as *LIBL.)
|
||||||
|
// pMsgDta I Optional: Data to substitute into the message.
|
||||||
|
// (Trailing blanks will be truncated before use.)
|
||||||
|
|
||||||
|
//=== API Error Code Structure ==================================
|
||||||
|
// We don't provide any bytes, so an error will cause a crash,
|
||||||
|
// because if we get an error here something bad has happened.
|
||||||
|
dAPIError ds 272
|
||||||
|
d APIEProv 1 4b 0 inz(0)
|
||||||
|
d APIEAvail 5 8b 0 inz(0)
|
||||||
|
d APIErrId 9 15 inz(*blanks)
|
||||||
|
//=== QMHSNDPM Parameters =======================================
|
||||||
|
d QMsgFile s 20
|
||||||
|
d MsgType s 10 inz('*INFO')
|
||||||
|
d StackCntr s 10i 0 inz(0)
|
||||||
|
d MsgKey s 4 inz(' ')
|
||||||
|
d MsgDta s 256 inz(' ')
|
||||||
|
d MsgDtaLgth s 10i 0
|
||||||
|
//=== SNDMSGPGMQ execution starts here ==========================
|
||||||
|
/free
|
||||||
|
QMsgFile = pMsgFile + '*LIBL';
|
||||||
|
// Message data length for QMHSNDPM is optional. If supplied,
|
||||||
|
// use, else default to 0.
|
||||||
|
if %parms > 3;
|
||||||
|
MsgDta = pMsgDta;
|
||||||
|
MsgDtaLgth = %len(%trimr(MsgDta));
|
||||||
|
else;
|
||||||
|
MsgDtaLgth = 0;
|
||||||
|
endif;
|
||||||
|
//=== Send message with API =====================================
|
||||||
|
QMHSNDPM (pMsgid
|
||||||
|
:QMsgFile
|
||||||
|
:MsgDta
|
||||||
|
:MsgDtaLgth
|
||||||
|
:MsgType
|
||||||
|
:pMsgQ
|
||||||
|
:StackCntr
|
||||||
|
:MsgKey
|
||||||
|
:APIError);
|
||||||
|
// Exit with LR off. This is a tiny routine which will probably
|
||||||
|
// be called again.
|
||||||
|
return;
|
||||||
|
/end-free
|
||||||
|
p SndMsgPgmQ e
|
||||||
|
|
||||||
|
//=== CLRMSGPGMQ =-=============================================
|
||||||
|
// CLeaRs all MeSsaGes from a ProGraM message Queue
|
||||||
|
// Clears all the messages from a program message queue that
|
||||||
|
// you specify as a parameter.
|
||||||
|
|
||||||
|
// It is primarily designed for use by interactive programs that
|
||||||
|
// send messages through a message subfile.
|
||||||
|
|
||||||
|
// See also SNDMSGPGMQ which sends a message to the program queue.
|
||||||
|
//
|
||||||
|
// Always returns *OFF
|
||||||
|
//===============================================================
|
||||||
|
|
||||||
|
// Conceptual call:
|
||||||
|
//=================
|
||||||
|
// H BndDir('UTIL_BND')
|
||||||
|
// /include Demo,Srv_Msg_P
|
||||||
|
// D ProgStatus sds
|
||||||
|
// D PgmName *PROC
|
||||||
|
// CLRMSGPGMQ(PgmName)
|
||||||
|
|
||||||
|
p ClrMsgPgmQ b export
|
||||||
|
D ClrMsgPgmQ pi N
|
||||||
|
d pPgmMsgQ 10
|
||||||
|
|
||||||
|
//=== API Error Code Structure ==================================
|
||||||
|
// We don't provide any bytes, so an error will cause a crash,
|
||||||
|
// because if we get an error here something bad has happened.
|
||||||
|
dAPIError ds 272
|
||||||
|
d APIEProv 1 4b 0 inz(0)
|
||||||
|
d APIEAvail 5 8b 0 inz(0)
|
||||||
|
d APIErrId 9 15 inz(*blanks)
|
||||||
|
//=== Parameters for QMHRMVPM API ===============================
|
||||||
|
d PgmStk s 10i 0 inz(0)
|
||||||
|
d MSgKey s 4 inz(*blanks)
|
||||||
|
d Remove s 10 inz('*ALL')
|
||||||
|
|
||||||
|
//=== Calling Parameters =============================================
|
||||||
|
// Parm I/O/B Description
|
||||||
|
// ---- ----- -----------
|
||||||
|
// pPGMMsgQ I Program message queue to clear.
|
||||||
|
|
||||||
|
//=== ClrMsgPgmQ execution starts here ==========================
|
||||||
|
/free
|
||||||
|
QMHRMVPM(pPgmMsgQ
|
||||||
|
:PgmStk
|
||||||
|
:MsgKey
|
||||||
|
:Remove
|
||||||
|
:APIError);
|
||||||
|
|
||||||
|
/free
|
||||||
|
// Exit with LR off. This is a tiny routine which will probably
|
||||||
|
// be called again.
|
||||||
|
RETURN *off;
|
||||||
|
/end-free
|
||||||
|
|
||||||
|
p ClrMsgPgmQ e
|
||||||
|
|
||||||
|
//=== SndEscMsg ===============================================
|
||||||
|
// Sends CPF9898 Escape message of the provided text.
|
||||||
|
// This will kill the current program and cause an
|
||||||
|
// exception in the one that called it.
|
||||||
|
|
||||||
|
P SndEscMsg B Export
|
||||||
|
|
||||||
|
D SndEscMsg PI
|
||||||
|
D piMsg 1024a Const Varying
|
||||||
|
|
||||||
|
//--- Parameters for QMHSNDPM -------------------------
|
||||||
|
D MsgId c const('CPF9898')
|
||||||
|
d MsgF c const('QCPFMSG *LIBL ')
|
||||||
|
d MsgType c const('*ESCAPE ')
|
||||||
|
d PgmQue c const('* ')
|
||||||
|
d InvCount c const(2)
|
||||||
|
d ApiError s 17a inz(X'00')
|
||||||
|
d RetMsgKey s 4a
|
||||||
|
D DataLen s 10i 0
|
||||||
|
|
||||||
|
//--- Local Variables ---------------------------------
|
||||||
|
D MsgData s 1024a
|
||||||
|
|
||||||
|
/FREE
|
||||||
|
|
||||||
|
DataLen = %len(PiMSG);
|
||||||
|
MsgData = piMsg;
|
||||||
|
|
||||||
|
QMHSNDPM(MsgId
|
||||||
|
:MsgF
|
||||||
|
:MsgData
|
||||||
|
:DataLen
|
||||||
|
:MsgType
|
||||||
|
:PgmQue
|
||||||
|
:InvCount
|
||||||
|
:RetMsgKey
|
||||||
|
:APIError);
|
||||||
|
return;
|
||||||
|
|
||||||
|
/end-free
|
||||||
|
|
||||||
|
P SndEscMsg E
|
||||||
|
|
||||||
|
//=== SndInfMsg ===============================================
|
||||||
|
// Sends CPF9898 Info message of the provided text to the
|
||||||
|
// external message queue.
|
||||||
|
// Useful for debugging.
|
||||||
|
|
||||||
|
P SndInfMsg B Export
|
||||||
|
|
||||||
|
D SndInfMsg PI
|
||||||
|
D piMsg 1024a Const Varying
|
||||||
|
|
||||||
|
//--- Parameters for QMHSNDPM -------------------------
|
||||||
|
D MsgId c const('CPF9898')
|
||||||
|
d MsgF c const('QCPFMSG *LIBL ')
|
||||||
|
d MsgType c const('*INFO ')
|
||||||
|
d PgmQue c const('*EXT ')
|
||||||
|
d InvCount c const(2)
|
||||||
|
d ApiError s 17a inz(X'00')
|
||||||
|
d RetMsgKey s 4a
|
||||||
|
D DataLen s 10i 0
|
||||||
|
|
||||||
|
//--- Local Variables ---------------------------------
|
||||||
|
D MsgData s 1024a
|
||||||
|
|
||||||
|
/FREE
|
||||||
|
|
||||||
|
DataLen = %len(PiMSG);
|
||||||
|
MsgData = piMsg;
|
||||||
|
|
||||||
|
QMHSNDPM(MsgId
|
||||||
|
:MsgF
|
||||||
|
:MsgData
|
||||||
|
:DataLen
|
||||||
|
:MsgType
|
||||||
|
:PgmQue
|
||||||
|
:InvCount
|
||||||
|
:RetMsgKey
|
||||||
|
:APIError);
|
||||||
|
return;
|
||||||
|
|
||||||
|
/end-free
|
||||||
|
|
||||||
|
P SndInfMsg E
|
||||||
@@ -0,0 +1,89 @@
|
|||||||
|
A*%%TS SD 20200723 195503 LENNONS REL-V7R4M0 5770-WDS
|
||||||
|
A*===============================================================
|
||||||
|
A* Display to test functions in SRV_MSG service program
|
||||||
|
A*===============================================================
|
||||||
|
A*%%EC
|
||||||
|
A DSPSIZ(24 80 *DS3)
|
||||||
|
A PRINT
|
||||||
|
A INDARA
|
||||||
|
A ALTHELP
|
||||||
|
A CA03
|
||||||
|
A CF04
|
||||||
|
A CF05
|
||||||
|
A CF06
|
||||||
|
A CF07
|
||||||
|
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 27'Test SRV_MSG Service Program'
|
||||||
|
A 1 72DATE
|
||||||
|
A EDTCDE(Y)
|
||||||
|
A 2 2USER
|
||||||
|
A SH_FUNCT 50A O 2 16DSPATR(HI)
|
||||||
|
A 2 72TIME
|
||||||
|
A 4 4'Message to send:'
|
||||||
|
A SH_MSG 69 B 5 4
|
||||||
|
A 8 4'F4 - SndMsgPgmQ'
|
||||||
|
A 9 4'F5 - ClrMsgPgmQ'
|
||||||
|
A 10 4'F6 - SndInfMsg'
|
||||||
|
A 11 4'F7 - SndEscMsg'
|
||||||
|
A 40 6 4'Please enter a message.'
|
||||||
|
A DSPATR(RI)
|
||||||
|
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="MSGSFL" />
|
||||||
|
A*%%RS+ <record-write record-format="MSGCTL" />
|
||||||
|
A*%%RS+ </sequence>
|
||||||
|
A*%%RS </record-sequences>
|
||||||
@@ -0,0 +1,165 @@
|
|||||||
|
|
||||||
|
//=== Tests procedures in SRV_MSG service program =============
|
||||||
|
H DftActGrp(*NO) ActGrp(*CALLER) option(*nodebugio: *srcstmt)
|
||||||
|
H BndDir('UTIL_BND')
|
||||||
|
|
||||||
|
//=== Display File ============================================
|
||||||
|
FSRV_MSGTD 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
|
||||||
|
|
||||||
|
//=== 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
|
||||||
|
D SH_ERR 40 40n
|
||||||
|
|
||||||
|
//=== Global Switches =========================================
|
||||||
|
D SflMsgSnt s n
|
||||||
|
D CowsComeHome c const('0')
|
||||||
|
|
||||||
|
//=== Work Fields =============================================
|
||||||
|
D inx s 10i 0
|
||||||
|
|
||||||
|
//=== Program Status Data Structure ===========================
|
||||||
|
D ProgStatus sds
|
||||||
|
D PgmName *PROC
|
||||||
|
|
||||||
|
/FREE
|
||||||
|
//=============================================================
|
||||||
|
// === Main Program Loop ======================================
|
||||||
|
//=============================================================
|
||||||
|
exsr init;
|
||||||
|
SFT_KEYS='F3/F12=Exit';
|
||||||
|
dou CowsComeHome;
|
||||||
|
write SH_HDR;
|
||||||
|
write SFT_FKEY;
|
||||||
|
if SflMsgSnt = *on;
|
||||||
|
write MSGCTL;
|
||||||
|
endif;
|
||||||
|
|
||||||
|
exfmt SH_HDR;
|
||||||
|
SH_ERR = *off;
|
||||||
|
|
||||||
|
if key = F03 or Key = F12;
|
||||||
|
exsr CloseDownPgm;
|
||||||
|
return;
|
||||||
|
endif;
|
||||||
|
|
||||||
|
if SH_MSG = ' ';
|
||||||
|
SH_ERR = *ON; // Please enter a message
|
||||||
|
iter;
|
||||||
|
endif;
|
||||||
|
|
||||||
|
select;
|
||||||
|
//-- Enter Key ---------------------------------------------
|
||||||
|
when Key = Enter;
|
||||||
|
|
||||||
|
//--- F04 --------------------------------------------------
|
||||||
|
when Key = F04;
|
||||||
|
SflMsgSnt= SndSflMsg('CPF9898' : SH_MSG);
|
||||||
|
iter;
|
||||||
|
|
||||||
|
//--- F05 --------------------------------------------------
|
||||||
|
when Key = F05;
|
||||||
|
if SflMsgSnt = *on;
|
||||||
|
SflMsgSnt = ClrMsgPgmQ(PgmName);
|
||||||
|
write MSGCTL;
|
||||||
|
iter;
|
||||||
|
endif;
|
||||||
|
|
||||||
|
//--- F06 --------------------------------------------------
|
||||||
|
when Key = F06;
|
||||||
|
SndInfMsg(SH_MSG);
|
||||||
|
iter;
|
||||||
|
|
||||||
|
//--- F07 --------------------------------------------------
|
||||||
|
when Key = F07;
|
||||||
|
SndEscMsg(SH_MSG);
|
||||||
|
iter;
|
||||||
|
|
||||||
|
endsl;
|
||||||
|
enddo;
|
||||||
|
|
||||||
|
//=============================================================
|
||||||
|
//=== End of Main Program Loop ================================
|
||||||
|
//=============================================================
|
||||||
|
|
||||||
|
|
||||||
|
//=== CloseDownPgm ============================================
|
||||||
|
// Things to do before we issue a return to the caller
|
||||||
|
begsr CloseDownPgm;
|
||||||
|
*inlr = *on;
|
||||||
|
close SRV_MSGTD;
|
||||||
|
endsr;
|
||||||
|
|
||||||
|
//=== Init ====================================================
|
||||||
|
begsr Init;
|
||||||
|
MSGPGMQ = PgmName;
|
||||||
|
SH_PGM = PgmName;
|
||||||
|
if not %open(SRV_MSGTD);
|
||||||
|
open SRV_MSGTD;
|
||||||
|
endif;
|
||||||
|
endsr;
|
||||||
|
|
||||||
|
//=============================================================
|
||||||
|
// S u b P r o c e d u r e s
|
||||||
|
//=============================================================
|
||||||
|
|
||||||
|
//=== 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
|
||||||
|
//------------------------------------------------------------
|
||||||
|
/END-FREE
|
||||||
|
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 = 'QCPFMSG';
|
||||||
|
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
|
||||||
|
|
||||||
|
|
||||||
Reference in New Issue
Block a user