Subsystem Exit for OODA Subsystem (mfjyooda.cbl)

It also verifies that it received the expected subsystem-subparameter string.

For the most up-to-date information refer to the source for this copybook in your product installation.

 *>==============================================================
*> Use directives at least: /CHARSET"ASCII"
*> /DIALECT"MF"
/DEFAULTBYTE"00"
*>==============================================================
*> Copyright ©) 1997-2008 Micro Focus (IP) Ltd. 
*> All rights reserved. 
*> 
*> This sample source code is provided for use by users of 
*> Micro Focus products (the "Software") and may be used, 
*> modified and distributed as part of your application provided
*> that you properly acknowledge the copyright of Micro Focus in 
*> this material. 
*> 
*> All conditions, warranties and undertakings, express or implied, 
*> statutory or otherwise, on the part of Micro Focus are excluded, 
*> including without limitation those of merchantability or fitness 
*> for purpose. This shall not, however, purport to exclude or 
*> restrict the liability of Micro Focus to any extent not 
*> permitted by law. 
*> 
*> IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
*> INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
*> OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
*> SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
*> DAMAGES IN ADVANCE. THESE LIMITATIONS APPLY TO ALL CAUSES OF 
*> ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
*> LIABILITY, AND ANY ACTIONS IN TORTS.
*>==============================================================

*>==============================================================
*> Note that subsystem exit is ways named as MFJYssss, where
*> ssss is the subssystem name (1st sub-parameter of SUBSYS=)
*>==============================================================

*>==============================================================
*> SUBSYS Subsystem exit for OODA subsystem
*>==============================================================

identification division.
program-id. MFJYOODA. 
environment division. 
file-control. 
data division.
*>=============================================================
working-storage section. 
77 subsys-val-expected pic x(30)     value
                    'OODA,A,DKP39CPM,PPP3,STD,,USER'. 
77 msg-dest-both       pic 9(8) comp value 0. 
77 msg-len             pic 9(8) comp value 80. 
77 msg-txt             pic x(80).
77 w-len               pic 99999. 
linkage section. copy "mfjdsxit.cpy" replacing ==()== by ==sxit==. 
01 subsys-val          pic x(32000).

*>=============================================================
procedure division using by reference sxit.

* Dsa temp >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
* call 'CBL_DEBUGBREAK' 
* Dsa temp <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
			evaluate sxit-I-event
    when sxit-I-event-dd-alloc-pre
      *>======================================================= 
      *> DD is about to be allocated. Change to SYSOUT=*
      *>=======================================================
      move sxit-U-ds-type-sysout to sxit-U-ds-type 
      set sxit-U-ds-name-ptr to null 
      move sxit-U-action-use-updated-data to sxit-U-action
      *>======================================================= 
      *> The code below is informational only. Note that 
      *> - sxit-U-subsys-ptr points to the the entire 
      *>   SUBSYS string with syntactic quotes removed. 
      *> - sxit-U-subsys-len is the length of the string 
      set address of subsys-val to sxit-U-subsys-ptr 
      if sxit-U-subsys-len <> length subsys-val-expected 
        move sxit-U-subsys-len to w-len 
        move ' ' to msg-txt 
        string 'MFJYOODA - Length should be 30 but is '
                                            delimited by size 
                w-len                       delimited by size
        into msg-txt 
        call 'MFJZLOG' using msg-dest-both msg-len msg-txt 
      end-if
      if subsys-val(1:length subsys-val-expected) <>
         subsys-val-expected 
        move ' ' to msg-txt 
        string 'MFJYOODA - Value incorrect. It is ' 
                                             delimited by size
                subsys-val(1:length subsys-val-expected) 
                                             delimited by size
        into msg-txt 
        call 'MFJZLOG' using msg-dest-both msg-len msg-txt 
      end-if 
      *> move subsys-val(1:sxit-U-subsys-len) to ...
      *>======================================================= 
      goback 
    when other
      *>======================================================= 
      *> Ignore all other events
      *>=======================================================
      continue 
  end-evaluate 
  goback.
  *>===========================================================