Add RCDLCKDSP

2021-05-13 15:08:41 -04:00
parent 7c8791fcf7
commit 0b9cdff216
7 changed files with 460 additions and 0 deletions
@@ -0,0 +1,93 @@
+      *==============================================================
+      * 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';