|
midrange.com
The procedures below helped an application that could not be stopped
because of record locks. The procedures below made sure the application
completed processing all records in the file from beginning to end.
Before the procedures below were put in place, the application would
encounter a record lock while processing and hold up other jobs. The
technical support staff would have to end the job so that other jobs in
the system could complete. When the application was restarted, the job
would encounter another record lock. This process was constant and so the
file would never be completed 100%. The procedures below would allow the
file processing to stop at the record locked and allow technical support
or a programmer to determine who has the file locked and ask them to hurry
up with what they're doing or get out of whatever application they are in.
I did modify the procedures to allow the user(instead of technical support
or a programmer) to determine who has the file locked so that they could
go bug the other user, but I forgot to keep a "backup copy" of the source
before I left the company.
To see the actual record, I think you might have to run the below
procedures in debug.
I'm sure someone has an easier method, but this is how I did it:
============================================================
RPGIV
============================================================
D PGMSTS SDS
D SV_MSGDTA 1 80 Job Name
D SV_JOBNAME 244 253 Job Name
D SV_JOBUSER 254 263 Job User
D SV_JOBNUM 264 269 Job Number
D RECORDLOCKED C CONST(01218)
/FREE
// Read Loop Processing for MYFILE File
SETLL FILEKEY MYFILE;
DOU %EOF(MYFILE);
READ(E) MYFILE;
// Error on Read Operation
IF %ERROR;
// Record is Locked;
IF %STATUS = RECORDLOCKED;
SV_ERRTYP = '0001';
SV_MSGRPY = ' ';
CALLP AA47C001(SV_ERRTYP:
SV_JOBNUM:
SV_JOBUSER:
SV_JOBNAME:
SV_MSGRPY);
ITER;
// Record is NOT Locked
ELSE;
SV_ERRTYP = '0002';
SV_MSGRPY = ' ';
CALLP AA47C001(SV_ERRTYP:
SV_JOBNUM:
SV_JOBUSER:
SV_JOBNAME:
SV_MSGRPY);
LEAVE;
ENDIF;
//IF %STATUS = RECORDLOCKED;
ENDIF;
//IF %ERROR;
// End of File
IF %EOF(MYFILE);
LEAVE;
ENDIF;
// DO SOME STUFF.....
ENDDO;
// DOU %EOF(MYFILE)
/END-FREE
==========================================================================
CL
==========================================================================
/***********************************************************************/
/* ‚ */
/* Program name: AA47C001 */
/* Programmer..: Frank Kany */
/* Date........: 09/30/03 */
/* Description.: This program is called when a program can't */
/* allocate a file record.
/* */
/*---------------------------------------------------------------------*/
/***********************************************************************/
/* &ERRTYP = '0001' - CAN'T ALLOCATE RECORD */
/* '0002' - NOT A RECORD ALLOCATION PROBLEM */
/* '0003' - XXXXXXXXXXXXXXXXXXXXX */
/* '0004' - XXXXXXXXXXXXXXXXXXXXX */
/* '0005' - XXXXXXXXXXXXXXXXXXXXX */
/***********************************************************************/
PGM PARM(&ERRTYP &NBR &USER &JOB &MSGRPY)
/* I/O Parameters */
DCL VAR(&ERRTYP) TYPE(*CHAR) LEN(4) /* ERROR TYPE */
DCL VAR(&NBR) TYPE(*CHAR) LEN(6) /* JOB NUMBER */
DCL VAR(&USER) TYPE(*CHAR) LEN(10) /* USER */
DCL VAR(&JOB) TYPE(*CHAR) LEN(10) /* JOB NAME */
DCL VAR(&MSGRPY) TYPE(*CHAR) LEN(1) /* MSG REPLY */
/* Program Fields */
DCL VAR(&ERR0001) TYPE(*CHAR) LEN(512)
DCL VAR(&ERR0002) TYPE(*CHAR) LEN(512)
/* BUILD &ERR0001 */
CHGVAR VAR(&ERR0001) VALUE( +
&NBR *CAT '/' *CAT +
&USER *TCAT '/' *CAT +
&JOB +
*BCAT 'is sending this message.' +
*BCAT 'The program for this job is not able' +
*BCAT 'to allocate a record from a file.' +
*BCAT 'Press F10 now to look at the job log' +
*BCAT 'and find out which job has locked the' +
*BCAT 'record. If a user has locked the' +
*BCAT 'record, ask the user if they still' +
*BCAT 'need the record. If the user does' +
*BCAT 'not need the record, answer this' +
*BCAT 'message with a "R". If the user does' +
*BCAT 'need the record, wait until they are' +
*BCAT 'finished before answering this' +
*BCAT 'message with a "R".')
CHGVAR VAR(&ERR0002) VALUE( +
&NBR *CAT '/' *CAT +
&USER *TCAT '/' *CAT +
&JOB +
*BCAT 'is sending this message. The' +
*BCAT 'program for this job had a problem' +
*BCAT 'reading a file record. Look at the' +
*BCAT 'job log and email a copy of the job' +
*BCAT 'log to the last programmer who had' +
*BCAT 'worked on the program that called' +
*BCAT 'this program. Then answer this' +
*BCAT 'message with a "C" to cancel the' +
*BCAT 'process the program was working on.')
/* CAN'T ALLOCATE RECORD */
IF COND(&ERRTYP *EQ '0001') THEN(DO)
SNDUSRMSG MSG(&ERR0001) VALUES('R' 'r') +
TOUSR(*REQUESTER) MSGRPY(&MSGRPY)
ENDDO
/* NOT A RECORD ALLOCATION PROBLEM */
IF COND(&ERRTYP *EQ '0002') THEN(DO)
SNDUSRMSG MSG(&ERR0002) VALUES('C' 'c') +
TOUSR(*REQUESTER) MSGRPY(&MSGRPY)
ENDDO
/* EXTRA */
IF COND(&ERRTYP *EQ '0003') THEN(DO)
ENDDO
/* EXTRA */
IF COND(&ERRTYP *EQ '0004') THEN(DO)
ENDDO
/* EXTRA */
IF COND(&ERRTYP *EQ '0005') THEN(DO)
ENDDO
ENDPGM
=============================================================================
hth,
Frank W. Kany IV
Senior Programmer/Analyst
Unipres USA, Inc.
(615) 325-8428 - Office
(615) 517-1742 - Cell
http://www.unipres.com
"Brian Piotrowski" <bpiotrowski@xxxxxxxxxxxxxxx>
Sent by: midrange-l-bounces@xxxxxxxxxxxx
01/11/2006 07:37 AM
Please respond to
Midrange Systems Technical Discussion <midrange-l@xxxxxxxxxxxx>
To
"Midrange Systems Technical Discussion" <midrange-l@xxxxxxxxxxxx>
cc
Subject
Determining Lock on Specific PF Record
Hi All,
Is there an easy way to determine who has a lock on a specific record
(or set of records) in a Physical File? We have a problem in one of our
records where when we try to update it the system tells me that it is
unable to allocate a record in the PF. However, there are other users
who are currently updating other records in the same PF without issues.
Thanks,
Brian.
-=-=-=-=-=-=-=-=-=-=-=-=-=-
Brian Piotrowski
Specialist - I.T.
Simcoe Parts Service, Inc.
PH: 705-435-7814
FX: 705-435-6746
-=-=-=-=-=-=-=-=-=-=-=-=-=-
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
