68 lines
2.5 KiB
Plaintext
68 lines
2.5 KiB
Plaintext
*==============================================================
|
|
* Program that locks a record and then waits for input from
|
|
* the operator.
|
|
*
|
|
* Call this program in two different sessions to see the effect.
|
|
* Second program will typically get a error:
|
|
* 'Unable to allocate a record in file' (RNX1218)
|
|
* and the end user typically choses an unhelpful response.
|
|
*==============================================================
|
|
* Note: This is a poor technique because the record remains
|
|
* locked to all other users until the transaction is
|
|
* completed, which may be in a few seconds or after lunch.
|
|
*
|
|
*Note: Pgm reads by RRN for convenience. This is not a good
|
|
* idea is a production program.
|
|
*
|
|
*Note: DSPLY is use to simulate a display file interaction
|
|
* with the user.
|
|
*
|
|
*Note: QIWS/QCUSTCDT: believed to be on virtually all systems.
|
|
*==============================================================
|
|
|
|
H DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF)
|
|
H DFTACTGRP(*NO) ACTGRP(*NEW)
|
|
|
|
FQCUSTCDT UF E DISK USROPN EXTDESC('QIWS/QCUSTCDT')
|
|
F RECNO(RRN)
|
|
F* INFSR(*PSSR)
|
|
|
|
D QCmdexc PR EXTPGM('QCMDEXC')
|
|
D CMD 512A
|
|
D lgth 15P 5 const
|
|
|
|
D RRN s 10p 0 inz(10)
|
|
D reply S 1A inz('*')
|
|
D Cmd S 512A
|
|
|
|
/free
|
|
*inlr = *on;
|
|
|
|
// Set update file to a short wait time. Otherwise the file or
|
|
// system default wait time applies.
|
|
cmd = ' OVRDBF FILE(QCUSTCDT) TOFILE(QIWS/QCUSTCDT) WAITRCD(1)';
|
|
QCMDEXC(cmd:512);
|
|
open QCUSTCDT;
|
|
|
|
chain RRN QCUSTCDT;
|
|
|
|
if %found(QCUSTCDT);
|
|
// Logic to update the record would be here.
|
|
dsply 'Read for update' ' ' reply;
|
|
else;
|
|
// Logic for record not found would be here
|
|
dsply 'Record not found' ' ' reply;
|
|
endif;
|
|
|
|
// === End of Program =========================================
|
|
// Close file before returning
|
|
close QCUSTCDT;
|
|
return;
|
|
|
|
// Often found in old programs. Uncomment INFSR(*PSSR) in the
|
|
// F-SPEC to make this active.
|
|
BEGSR *PSSR;
|
|
dsply 'In the *PSSR' ' ' reply;
|
|
dump(a);
|
|
ENDSR '*CANCL';
|