94 lines
3.3 KiB
Plaintext
94 lines
3.3 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.
|
|
*==============================================================
|
|
* - Locking the record first 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.
|
|
* It is used here to demonstate the RCDLCKDSP processing.
|
|
*==============================================================
|
|
* - Pgm reads by RRN for convenience. This is generally not a
|
|
* good idea is a production program.
|
|
*
|
|
*- DSPLY is use to simulate a display file interaction with
|
|
* the user. Not normally done in production.
|
|
*
|
|
* - 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 RCDLCKDSP PR EXTPGM('RCDLCKDSP')
|
|
D poReply 1A
|
|
D piPSDS *
|
|
|
|
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
|
|
|
|
D myPSDS SDS
|
|
D myPSDS_ptr S * inz(%addr(myPSDS))
|
|
|
|
/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;
|
|
|
|
dou not %error;
|
|
chain(e) RRN QCUSTCDT;
|
|
if %error;
|
|
RCDLCKDSP(reply: myPSDS_ptr);
|
|
if reply = 'R';
|
|
iter;
|
|
endif;
|
|
if reply = 'C';
|
|
exsr Prog_Cancelled;
|
|
endif;
|
|
if reply = 'D';
|
|
dump(a);
|
|
exsr Prog_Cancelled;
|
|
endif;
|
|
endif;
|
|
enddo;
|
|
|
|
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;
|
|
|
|
begsr Prog_Cancelled;
|
|
close QCUSTCDT;
|
|
// Put graceful ending logic & notification to user here
|
|
return;
|
|
endsr;
|
|
|
|
// 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';
|