SJLennon
90 lines
2.7 KiB
RPGLE
90 lines
2.7 KiB
RPGLE
**free
|
|
// ==============================================================
|
|
// 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.
|
|
// ==============================================================
|
|
|
|
Ctl-Opt DEBUG(*YES) OPTION(*NODEBUGIO:*SRCSTMT:*NOUNREF);
|
|
Ctl-Opt DFTACTGRP(*NO) ACTGRP(*NEW);
|
|
|
|
Dcl-F QCUSTCDT Usage(*Update:*Delete:*Output)
|
|
USROPN EXTDESC('QIWS/QCUSTCDT') RECNO(RRN)
|
|
// INFSR(*PSSR)
|
|
;
|
|
|
|
Dcl-PR RCDLCKDSP EXTPGM('RCDLCKDSP');
|
|
poReply Char(1);
|
|
piPSDS Pointer;
|
|
End-PR;
|
|
Dcl-PR QCmdexc EXTPGM('QCMDEXC');
|
|
Cmd Char(512);
|
|
lgth Packed(15:5) CONST;
|
|
End-PR;
|
|
Dcl-S RRN Packed(10:0) INZ(10);
|
|
Dcl-S reply Char(1) INZ('*');
|
|
Dcl-S Cmd Char(512);
|
|
Dcl-DS myPSDS PSDS;
|
|
End-DS;
|
|
Dcl-S myPSDS_ptr Pointer INZ(%ADDR(myPSDS));
|
|
*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';
|