203 lines
9.9 KiB
Plaintext
203 lines
9.9 KiB
Plaintext
*==============================================================
|
|
* When an interactive program tries to update a record that is
|
|
* locked by another user, often the program doesn't handle it.
|
|
* The RPG error routines kick in and give the user a confusing
|
|
* error message.
|
|
*
|
|
* Instead, trap the error and handle it by calling this program.
|
|
*
|
|
* This program communicates info about a locked record to an
|
|
* interactive user telling who has the lock.
|
|
|
|
* See program RCDLCKDEMO for a usage example.
|
|
*
|
|
* RCDLCKDSP accepts a continuation reply from the user and
|
|
* passes it back to the caller.
|
|
*
|
|
* If the status is not 1218, then it is considered an
|
|
* unexpected error and a slightly different dialog is
|
|
* presented, asking the user to contact IT. You can
|
|
* customize this as you see fit. Or add other statuses.
|
|
*
|
|
* Information is retrieved from the *PSDS passed from the caller.
|
|
*
|
|
*==============================================================
|
|
* Parameters
|
|
* ==========
|
|
* 1 Output CL1 User's reply about what to do:
|
|
* R - Retry the IO operation that failed
|
|
* C - Cancel the program
|
|
* D - DUmp the program and cancel
|
|
* 2 Input * Pointer to the *PSDS in the calling program.
|
|
* (A pointer is used because the *PDSD is not
|
|
* always the same length in a program.)
|
|
*==============================================================
|
|
* Create with CRTBNDRPG
|
|
* New activation group so we destroy nothing in the caller.
|
|
* No worries about overhead since rarely called.
|
|
h OPTION(*NODEBUGIO: *SRCSTMT)
|
|
H DFTACTGRP(*NO) ACTGRP(*NEW)
|
|
*==============================================================
|
|
|
|
FrcdlckdspdCF E WORKSTN
|
|
|
|
d RCDLCKDSP pr
|
|
D poReply 1A
|
|
D piPSDS *
|
|
|
|
d RCDLCKDSP pi
|
|
D poReply 1A
|
|
D piPSDS *
|
|
|
|
* === The caller's Program Status Data Structure ===============
|
|
* Many fields not currently used.
|
|
D PSDS DS qualified based(piPSDS)
|
|
D PROC_NAME 1 10 * Procedure name
|
|
D PGM_STATUS 11 15s 0 * Status code
|
|
D PRV_STATUS 16 20S 0 * Previous status
|
|
D LINE_NUM 21 28 * Src list line num
|
|
D ROUTINE 29 36 * Routine name
|
|
D PARMS 37 39 * Num passed parms
|
|
D EXCP_TYPE 40 42 * Exception type
|
|
D EXCP_NUM 43 46 * Exception number
|
|
D PGM_LIB 81 90 * Program library
|
|
D EXCP_DATA 91 170 * Exception data
|
|
D EXCP_ID 171 174 * Exception Id
|
|
D LAST_FILE_IO 175 184 * Last file used
|
|
D DATE 191 198 * Date (*DATE fmt)
|
|
D YEAR 199 200S 0 * Year (*YEAR fmt)
|
|
D LAST_FILE 201 208 * Last file used
|
|
D FILE_INFO_STATUS...
|
|
D 209 213S 0 * Last file status
|
|
D * Code
|
|
D FILE_INFO_OPCODE...
|
|
D 214 219 * Last file opcode
|
|
D FILE_INFO_ROUTINE...
|
|
D 220 227 * Last file RPG
|
|
D * routine
|
|
D FILE_INFO_LIST_NUM...
|
|
D 228 235 * Last file listing
|
|
D * line
|
|
D FILE_INFO_RECORD...
|
|
D 236 243I 0 * Last file record
|
|
D * name
|
|
D JOB_NAME 244 253 * Job name
|
|
D USER 254 263 * User name
|
|
D JOB_NUM 264 269S 0 * Job number
|
|
D JOB_DATE 270 275S 0 * Date (UDATE fmt)
|
|
D RUN_DATE 276 281S 0 * Run date (UDATE)
|
|
D RUN_TIME 282 287S 0 * Run time (UDATE)
|
|
D CRT_DATE 288 293 * Create date
|
|
D CRT_TIME 294 299 * Create time
|
|
D CPL_LEVEL 300 303 * Compiler level
|
|
D SRC_FILE 304 313 * Source file
|
|
D SRC_LIB 314 323 * Source file lib
|
|
D SRC_MBR 324 333 * Source file mbr
|
|
D PROC_PGM 334 343 * Pgm Proc is in
|
|
D PROC_MOD 344 353 * Mod Proc is in
|
|
D LINE_NUM_SRCID...
|
|
D 354 355I 0 * Src list source ID
|
|
D FILE_INFO_LIST_NUM_SRCID...
|
|
D 356 357I 0 * Last file listing
|
|
D * source ID
|
|
D CURR_USER 358 367 * Current user
|
|
D * profile
|
|
D EXTERNAL_RC 368 371I 0 * External return
|
|
D * code
|
|
D NUM_XML_ELEMS 372 379I 0 * Number of XML
|
|
d * elements
|
|
*=== My Variables ==============================================
|
|
D MyPSDS sDS
|
|
D MyName 1 10 * This program
|
|
|
|
D User c 'User: '
|
|
D UserPrf S 10A inz(' ')
|
|
D UserName S 40A inz(' ')
|
|
|
|
D wkI s 10I 0
|
|
D wkJ s 10I 0
|
|
|
|
d myStatus s 4S 0
|
|
D*AAA DS likeds(PSDS)
|
|
/FREE
|
|
// AAA = PSDS; // Eases Debugging...
|
|
|
|
SH_PGM = MyName;
|
|
|
|
// Sometimes the Status is not numeric
|
|
monitor;
|
|
myStatus = psds.FILE_INFO_STATUS;
|
|
on-error;
|
|
myStatus = -0;
|
|
ENDMON;
|
|
|
|
// Display fields are prefixed with SC_.
|
|
select;
|
|
when myStatus = 1218; //Record locked
|
|
SC_USER1 = 'Cannot continue until the user below completes';
|
|
SC_USER2 = 'their transaction or exits their application.';
|
|
exsr GetUserPrf;
|
|
//exsr GetUserName;
|
|
|
|
// Fill in user profile and user name
|
|
select;
|
|
when UserPrf = ' ' and UserName = ' ';
|
|
SC_USER3 = User + '*Unknown* -- Call IT Now.';
|
|
when UserName = ' ';
|
|
SC_USER3 = User + UserPrf;
|
|
other;
|
|
SC_USER3 = User + UserName;
|
|
endsl;
|
|
|
|
SC_INSTR = 'Enter R to Retry, C to Cancel';
|
|
|
|
other; //Unknown error
|
|
SC_USER1 = 'An unexpected error has occurred.';
|
|
SC_USER2 = 'Please contact IT now.';
|
|
SC_INSTR = 'IT: D=Dump, C=Cancel; R=Retry';
|
|
endsl;
|
|
|
|
// We try to fill in this info for all conditions
|
|
SC_IT_PGM = PSDS.PROC_NAME;
|
|
SC_IT_STS = myStatus;
|
|
SC_IT_FILE = PSDS.LAST_FILE;
|
|
SC_IT_OPCD = PSDS.FILE_INFO_OPCODE;
|
|
|
|
SC_IT_EM1 = %subst(PSDS.EXCP_DATA: 1: %len(SC_IT_EM1));
|
|
SC_IT_EM2 = %subst(PSDS.EXCP_DATA: %len(SC_IT_EM1)+1);
|
|
|
|
exfmt dspwin;
|
|
|
|
poReply = 'R'; //Default to R
|
|
if SC_RESP = 'C' or SC_RESP = 'R' or SC_RESP = 'D';
|
|
poReply = SC_RESP;
|
|
endif;
|
|
|
|
*inlr = *on;
|
|
return;
|
|
|
|
begsr GetUserPrf;
|
|
// Dig the user profile out of the error message (EXCP_DATA)
|
|
// which looks like this:
|
|
// Record 3317 in use by job 018249/SLENNON/MISREMSAM
|
|
UserPrf = ' ';
|
|
wkI = %scan('/':PSDS.EXCP_DATA);
|
|
if wkI <> 0;
|
|
wkI = wkI +1;
|
|
wkJ = %scan('/' :PSDS.EXCP_DATA: wkI);
|
|
if WkJ <> 0;
|
|
wkJ = WkJ - wkI;
|
|
if wkI > 0;
|
|
UserPrf = %subst(PSDS.EXCP_DATA: wkI: wkJ);
|
|
endif;
|
|
endif;
|
|
endif;
|
|
endsr;
|
|
|
|
begsr GetUserName;
|
|
// If you have a way to connect a user name to a user
|
|
// then set UserName here.
|
|
UserName = ' ';
|
|
endsr;
|
|
/END-FREE
|