/* REXX
 |
 | Name: XMITINFO
 |
 | Author: David Alcock
 |         dalcock@csw.com  (work)
 |         davea@ticnet.com (home)
 |
 | Purpose: Display information about a TSO XMIT file
 |
 |          TSO XMIT files are a convienent way to ship MVS files
 |          from one system to another.
 |
 |          The XMIT file specifications can be found in the TSO/E
 |          Customization manual.
 |
 | Syntax:
 |
 | - PC:
 |   - XMITINFO name.XMI
 |   - XMITINFO name.XMI debug
 |   - XMITINFO name.XMI debug dump
 |
 | - TSO (online or batch):
 |   - XMITINFO 'xmit.file'
 |   - XMITINFO 'xmit.file' debug
 |   - XMITINFO 'xmit.file' dump
 |
 | - Batch MVS via IRXJCL:
 |
 |   //JUSTDOIT EXEC PGM=IRXJCL,PARM='XMITINFO'
 |   //SYSTSPRT DD SYSOUT=*
 |   //SYSEXEC  DD DISP=SHR,DSN=your.rexx.library
 |   //SYSUT1   DD DISP=SHR,DSN=your.xmit.file
 |
 | - VM:
 |   - XMITINFO name xmit
 |   - XMITINFO name xmit w ( DEBUG
 |   - XMITINFO name xmit w ( DEBUG dump
 |
 |   Note: My VM machine is VM/ESA 1.1 and so the "DUMP" option
 |         fails there - David Alcock @21-APR-1998
 |
 | Disclaimer: This REXX exec is FREEWARE.  Use at your own risk.  It
 |             is provided for your enjoyment and neither David
 |             Alcock or his employer provides any warranty for it's
 |             use.  I'd like to hear how it works on your system.
 |
 |             This software is not in the public domain but is
 |             available free of charge and with source code provided.
 |             It is copyright 1998 by David Alcock.  All rights
 |             reserved.
 */

/**********************************************************************
*           M o d i f i c a t i o n   H i s t o r y
*
* Person     Date        Description
* ---------- ----------- ---------------------------------------------
* DGAlcock   2000-07-06  v1.1 Handle Regina Rexx;
* DGAlcock   21-APR-1997 v1.0 Extract_Text_Unit routine created;
* DGAlcock   20-APR-1997 v0.7 Added text unit value type; Added dsorg
*                             and recfm detection; misc other changes;
* DGAlcock   18-APR-1997 v0.6 Added processing of a few text units in
*                             INMR01 and INMR02 records;
* DGAlcock   06-APR-1997 v0.5 Initial exec written - This base version
*                             processes segments and outputs hex dumps;
**********************************************************************/

vrm = '1.1'

mtype = address()
PARSE SOURCE s1 s2 s3 s4 s5 s6 s7 s8 s9

if mtype == "TSO" | mtype == "MVS" then ,
   if sysvar(systsoe) > "2040" then systemid = mvsvar(syssmfid)
   else do
        cvt    = storage(10,4)
        dcvt   = c2d(cvt)
        smca   = storage(c2x(d2c(dcvt+x2d(c5))),3)
        dsmca  = c2d(smca)
        systemid = storage(c2x(d2c(dsmca+x2d(10))),4)
        end
else systemid = ""

if substr(systemid,1,3) == "CSW" then "cls" /* clear screen for Dave */

say "XMITINFO - version "vrm "- Freeware - TSO XMIT file utility"
say "Copyright 1998-2000 by David Alcock. All rights reserved."
say " "
say ". Executing in Environment: "s1 "-" mtype
if systemid <> "" then say ". Executing on system: "systemid
say " "

/*---------------------------------------------------------------------
 | Read in the input file based on the environment
 ------------------------------------------------------------------- */

ebcdic = 0

select

  /*--------------------------------------------------------------
   | PC: OS/2, Windows 95, Windows NT, etc.
   ------------------------------------------------------------ */


  when mtype == "CMD"     | ,        /* Object Rexx: OS/2, Win */
       mtype == "COMMAND" | ,        /* PC/DOS 7.0 */
       mtype == "SYSTEM"  then do    /* Regina Rexx */

       arg xmitfile_name options

       filesize = chars(xmitfile_name)
       if filesize == 0 then do
          say "Error reading input file: "xmitfile_name
          exit 12
          end

       end

  /*--------------------------------------------------------------
   | MVS (PGM=IRXJCL)
   ------------------------------------------------------------ */

  when mtype == "MVS" then do

       arg options
       ebcdic = 1
       xmitfile_dd = "SYSUT1"
       xmitfile_name = "//SYSUT1"

    end

  /*--------------------------------------------------------------
   | TSO
   ------------------------------------------------------------ */

  when mtype == "TSO" then do
       ebcdic = 1
       arg xmitfile_dsn options

       if xmitfile_dsn == "" then do
          "Missing input dataset name, terminating"
          exit 12
          end

       x = LISTDSI(xmitfile_dsn)
       if x <> 0 then do
          say "Error accessing DSN:" xmitfile_dsn
          say "> "sysmsglvl1
          say "> "sysmsglvl2
          say "> SYSREASON: "sysreason
          exit 12
          end

       xmitfile_name = sysdsname
       parse value xmitfile_dsn with . "(" member ")" .
       if member <> "" then do
          xmitfile_name = xmitfile_name"("strip(member)")"
          end

       xmitfile_dd = "XI"random()
       address TSO "ALLOCATE FILE("xmitfile_dd")" ,
                   "DA('"xmitfile_name"') SHR REUSE"

       end

  /*--------------------------------------------------------------
   | VM files
   ------------------------------------------------------------ */

  when mtype == "CMS" then do
       ebcdic = 1

       parse arg fn ft fm "(" options

       fn = strip(fn)
       ft = strip(ft)
       fm = strip(fm)
       if fm == "" then fm = "A"

       address command
       "STATE" fn ft fm
       if rc <> 0 then do
          upper fn ft fm
          "STATE" fn ft fm
          if rc <> 0 then do
             say "%XMITINFO - File" fn ft fm "not found"
             exit
             end
          end

       vmfclear
       "FINIS" fn ft fm


       xmitfile_name = fn ft fm
       end

  /*--------------------------------------------------------------
   | Other systems that we don't support
   ------------------------------------------------------------ */

  otherwise
       say "XMITINFO does not support system type: "mtype
       say "It does support: COMMAND, CMD, CMS, MVS and TSO"
       exit 12
  end /* of "select" */

say "Processing XMIT file: "xmitfile_name
say " "

/*---------------------------------------------------------------------
 | Parse options
 ------------------------------------------------------------------- */

debug = 0
dump = 0
options = translate(options)

do i = 1 to words(options)
   select
     when word(options,i) == "DEBUG"   then debug   = 1
     when word(options,i) == "DUMP"    then dump    = 1
     otherwise
          say "Option '"word(options,i)"'",
              "unknown and was ignored"
     end /* of select */
   end


/*---------------------------------------------------------------------
 | Perform functions for non-EBCDIC environments
 ------------------------------------------------------------------- */

if ebcdic <> 1  then do

   /*
    |  ISO 8859-1 to CECP 1047 (Extended de-facto EBCDIC):
    */

   toEBCDIC =           '00010203372D2E2F1605250B0C0D0E0F'x  /* 00 */
   toEBCDIC = toEBCDIC||'101112133C3D322618193F271C1D1E1F'x  /* 10 */
   toEBCDIC = toEBCDIC||'405A7F7B5B6C507D4D5D5C4E6B604B61'x  /* 20 */
   toEBCDIC = toEBCDIC||'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x  /* 30 */
   toEBCDIC = toEBCDIC||'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x  /* 40 */
   toEBCDIC = toEBCDIC||'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x  /* 50 */
   toEBCDIC = toEBCDIC||'79818283848586878889919293949596'x  /* 60 */
   toEBCDIC = toEBCDIC||'979899A2A3A4A5A6A7A8A9C04FD0A107'x  /* 70 */
   toEBCDIC = toEBCDIC||'202122232415061728292A2B2C090A1B'x  /* 80 */
   toEBCDIC = toEBCDIC||'30311A333435360838393A3B04143EFF'x  /* 90 */
   toEBCDIC = toEBCDIC||'41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x  /* A0 */
   toEBCDIC = toEBCDIC||'908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x  /* B0 */
   toEBCDIC = toEBCDIC||'6465626663679E687471727378757677'x  /* C0 */
   toEBCDIC = toEBCDIC||'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x  /* D0 */
   toEBCDIC = toEBCDIC||'4445424643479C485451525358555657'x  /* E0 */
   toEBCDIC = toEBCDIC||'8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x  /* F0 */


   /*
    | Hex table to aid in translating all 8-bit characters
    */

   hextable =             '000102030405060708090A0B0C0D0E0F'x   /* 00 */
   hextable = hextable || '101112131415161718191A1B1C1D1E1F'x   /* 10 */
   hextable = hextable || '202122232425262728292A2B2C2D2E2F'x   /* 20 */
   hextable = hextable || '303132333435363738393A3B3C3D3E3F'x   /* 30 */
   hextable = hextable || '404142434445464748494A4B4C4D4E4F'x   /* 40 */
   hextable = hextable || '505152535455565758595A5B5C5D5E5F'x   /* 50 */
   hextable = hextable || '606162636465666768696A6B6C6D6E6F'x   /* 60 */
   hextable = hextable || '707172737475767778797A7B7C7D7E7F'x   /* 70 */
   hextable = hextable || '808182838485868788898A8B8C8D8E8F'x   /* 80 */
   hextable = hextable || '909192939495969798999A9B9C9D9E9F'x   /* 90 */
   hextable = hextable || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x   /* A0 */
   hextable = hextable || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x   /* B0 */
   hextable = hextable || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x   /* C0 */
   hextable = hextable || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x   /* D0 */
   hextable = hextable || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x   /* E0 */
   hextable = hextable || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x   /* F0 */

   end

/*---------------------------------------------------------------------
 | Verify that this looks like an XMIT file
 ------------------------------------------------------------------- */

 EOF = 0            /* End of File = No */
 file = ""          /* Current contents of XMIT file */
 filelen = 0        /* Current file length */
 call get_record 1  /* Read in the first record */

 segmentc = substr(file,3,6)
 if ebcdic == 0 then segmentc = translate(segmentc,hextable,toEBCDIC)

 if segmentc <> "INMR01" then do
    if ebcdic == 0 then e = "(EBCDIC)"
    else e = ""
    say "This does not appear to be a TSO XMIT file!"
    say "> CRI (bytes 2-7) of the first record is not" ,
        "INMR01" e
    if dump == 1 then ,
       call Hex_Dump 1 80 "First record of file"

    signal theend
    end

/*---------------------------------------------------------------------
 | Equate the text units - from SYS1.MACLIB(INMTEXTU)
 |
 | TSO/E 2.5 - OS/390 1.2
 ------------------------------------------------------------------- */

/* KEYS FOR NETWORK USER IDENTIFICATION (INMR01 RECORD) */

INMTNODE = '1001'x /* TARGET NODE NAME               */
INMTUID  = '1002'x /* TARGET USERID                  */
INMFNODE = '1011'x /* ORIGIN NODE NAME               */
INMFUID  = '1012'x /* ORIGIN NODE NAME               */
INMFVERS = '1023'x /* ORIGIN VERSION NUMBER          */
INMFTIME = '1024'x /* ORIGIN TIME STAMP              */
INMTTIME = '1025'x /* DESTINATION TIME STAMP         */
INMNUMF  = '102F'x /* # OF FILES IN TRANSMISSION     */

/* KEYS FOR GENERAL CONTROL */

INMFACK  = '1026'x /* ACKNOWLEDGEMENT REQUEST        */
INMERRCD = '1027'x /* RECEIVE ERROR CODE             */
INMUTILN = '1028'x /* NAME OF UTILITY PROGRAM        */
INMUSERP = '1029'x /* USER PARAMETER STRING          */
INMRECCT = '102A'x /* TRANSMITTED RECORD COUNT       */

/* KEYS FOR DATASET IDENTIFICATION (INMR02, INMR03 RECORDS) */

INMDDNAM = '0001'x /* DDNAME FOR FILE                */
INMDSNAM = '0002'x /* DATASET NAME FOR FILE          */
INMMEMBR = '0003'x /* TRANSMITTED MEMBER LIST        */
INMSECND = '000B'x /* SECONDARY SPACE QUANTITY       */
INMDIR   = '000C'x /* DIRECTORY SPACE QUANTITY       */
INMEXPDT = '0022'x /* EXPIRATION DATE                */
INMTERM  = '0028'x /* TERMINAL ALLOCATION            */
INMBLKSZ = '0030'x /* BLOCKSIZE                      */
INMDSORG = '003C'x /* DATA SET ORGANIZATION          */
INMLRECL = '0042'x /* LOGICAL RECORD  LENGTH         */
INMRECFM = '0049'x /* RECORD FORMAT                  */
INMLREF  = '1020'x /* LAST REFERENCE DATE            */
INMLCHG  = '1021'x /* LAST CHANGE DATE               */
INMCREAT = '1022'x /* CREATION DATE                  */
INMSIZE  = '102C'x /* FILE SIZE IN BYTES             */
INMTYPE  = '8012'x /* DATA SET TYPE                  */

/*---------------------------------------------------------------------
 | Process the segments in the XMIT file
 ------------------------------------------------------------------- */

fileptr = 1
inmr03_count = 0
inmr01_numf = 0

do while fileptr < filelen
   segmentl = c2d(substr(file,fileptr,1))

   needrecs = segmentl % 80
   if needrecs <> 0 then do
      needrecr = segmentl // 80
      if needrecr <> 0 then needrecs = needrecs + 1
      call get_record needrecs
      end

   segment = substr(file,fileptr,segmentl)
   segmentd = substr(file,fileptr+1,1)
   segmentc = substr(segment,3,6)
   if ebcdic == 0 then ,
      segmentc = translate(segmentc,hextable,toEBCDIC)

   if dump == 1 then do
      /* This code will fail on a VM/ESA 1.1 system (and before)
         because the x2b() function is not available */
      segmentdb = x2b(d2x(c2d(substr(file,fileptr+1,1))))
      call Hex_Dump fileptr segmentl "Segment flags="segmentdb
      end

   if bitand(segmentd,'20'x) = '20'x then , /* Control Record */
      select
         when segmentc == "INMR01" then call handle_inmr01
         when segmentc == "INMR02" then call handle_inmr02
         when segmentc == "INMR03" then do
              call handle_inmr03
              /* If we aren't dumping all segs, stop on last inmr03 */
              if dump == 0 then ,
                 if inmr03_count = inmr01_numf then do
                    EOF = 1
                    fileptr = filelen
                    iterate
                    end
              end
         when segmentc == "INMR04" then call handle_inmr04
         when segmentc == "INMR06" then do
              if debug == 1 then say "Debug: Found INMR06"
              EOF = 1
              fileptr = filelen
              iterate
              end
         when segmentc == "INMR07" then call handle_inmr07
         otherwise
              if debug == 1 then do
                 if substr(segmentc,1,3) == "INM" then do
                    say "Debug: Found unhandled CRI="segmentc
                    end
                 end

        end /* of select */

   fileptr = fileptr + segmentl

   call get_record 1
   end

/*---------------------------------------------------------------------
 | Termination
 ------------------------------------------------------------------- */

theend:

select
  when mtype == "TSO" | mtype == "MVS" then do
       "EXECIO 0 DISKR "xmitfile_dd" (FINIS"
       if mtype == "TSO" then ,
          address TSO "FREE FILE("xmitfile_dd")"
       end
  otherwise
       nop
       end

exit 0

/*---------------------------------------------------------------------
 | Handle inmr01 segment -- Header Record
 ------------------------------------------------------------------- */

handle_inmr01:

if debug == 1 then do
   say " "
   say left('-',79,'-')
   say "Debug: Found INMR01 -- Header Record"
   end

inmr01_TNODE = "n/a"
inmr01_TUID = "n/a"
inmr01_FNODE = "n/a"
inmr01_FUID = "n/a"
inmr01_FVERS = "n/a"
inmr01_FTIME = "n/a"
inmr01_TTIME = "n/a"
inmr01_LRECL = "n/a"

ptr = 9
textend = segmentl - 9

do while ptr < textend

      call Extract_Text_Unit

   select
     when textui = INMLRECL then inmr01_lrecl = c2d(value.1)
     when textui = INMNUMF  then inmr01_numf  = c2d(value.1)
     when textui = INMFNODE then inmr01_fnode = value.1
     when textui = INMFUID  then inmr01_fuid  = value.1
     when textui = INMTNODE then inmr01_tnode = value.1
     when textui = INMTUID  then inmr01_tuid  = value.1
     when textui = INMFTIME then inmr01_ftime = value.1
     otherwise
          if debug == 1 then ,
             say "       > Note: we don't handle this text unit"
     end /* of select */


   ptr = ptr + textut
   end

if ebcdic == 0 then do
   inmr01_fnode = translate(inmr01_fnode,hextable,toEBCDIC)
   inmr01_fuid  = translate(inmr01_fuid,hextable,toEBCDIC)
   inmr01_tnode = translate(inmr01_tnode,hextable,toEBCDIC)
   inmr01_tuid  = translate(inmr01_tuid,hextable,toEBCDIC)
   inmr01_ftime = translate(inmr01_ftime,hextable,toEBCDIC)
   end

tod = inmr01_ftime           /* 12345678901234 */
if length(tod) == 14 then do /* yyyymmddhhmmss */
   tod = substr(inmr01_ftime,1,4)"-"substr(inmr01_ftime,5,2)"-"
   tod = tod||substr(inmr01_ftime,7,2)" at "substr(inmr01_ftime,9,2)":"
   tod = tod||substr(inmr01_ftime,11,2)":"substr(inmr01_ftime,13,2)
   end

say "Sent from node="left(inmr01_fnode,8)" userid="inmr01_fuid
say "       to node="left(inmr01_tnode,8)" userid="inmr01_tuid
say "       on "tod

if inmr01_numf == 0 then do
   inmr01_numf = 1
   if debug == 1 then ,
      say "Number of files not defined in INMR01 record, assuming 1"
   end
else if debug == 1 then ,
        say "Number of files contained in this XMIT file is" inmr01_numf

if inmr01_lrecl <> 80 then ,
   if debug == 1 then ,
      say "Note: LRECL not 80, found:" inmr01_lrecl

return

/*---------------------------------------------------------------------
 | Handle inmr02 segment -- File Utility Control Record
 ------------------------------------------------------------------- */

handle_inmr02:

if debug == 1 then do
   say " "
   say left('-',79,'-')
   say "Debug: Found INMR02  -- File Utility Control Record"
   end

inmr02_utiln = "n/a"
inmr02_size = 0
inmr02_dsorg = 0
inmr02_lrecl = 0
inmr02_recfm = 0
inmr02_blksz = 0
inmr02_dsnam = ""
inmr02_dir   = 0
inmr02_mail  = 0

ptr = 13
textend = segmentl - 13

do while ptr < textend

   call Extract_Text_Unit

   select
     when textui = INMSIZE  then inmr02_size  = c2d(value.1)
     when textui = INMLRECL then inmr02_lrecl = c2d(value.1)
     when textui = INMDSORG then inmr02_dsorg = value.1
     when textui = INMRECFM then inmr02_recfm = value.1
     when textui = INMBLKSZ then inmr02_blksz = c2d(value.1)
     when textui = INMDIR   then inmr02_dir   = c2d(value.1)
     when textui = INMTERM  then inmr02_mail  = 1
     when textui = INMUTILN then inmr02_utiln = value.1
     when textui = INMDSNAM then do
          do j = 1 to value.0
             if ebcdic == 0 then ,
                inmr02_dsnam = inmr02_dsnam"."translate(value.j, ,
                               hextable,toEBCDIC)
             else inmr02_dsnam = inmr02_dsnam"."strip(value.j)
             end
          inmr02_dsnam = strip(inmr02_dsnam,'L','.')
          end
     otherwise
          if debug == 1 then ,
             say "       > Note: we don't handle this text unit"
     end /* of select */


   ptr = ptr + textut
   end

if ebcdic == 0 then do
   inmr02_utiln = translate(inmr02_futiln,hextable,toEBCDIC)
   end

if inmr02_dsnam <> "" then do
   say " "
   say "File: DSN="inmr02_dsnam

   if inmr02_blksz <> 0 then blk = "BLKSIZE="inmr02_blksz
   else blk = ""

   if inmr02_dsorg <> 0 then dsorg = "DSORG="set_dsorg(inmr02_dsorg)
   else dsorg = ""

   if inmr02_recfm <> 0 then recfm = "RECFM="set_recfm(inmr02_recfm)
   else recfm = ""

   say "      "dsorg" LRECL="inmr02_lrecl blk recfm
   say "      Approximate Size in bytes:" inmr02_size
   end
else if inmr02_mail == 1 then do
     say " "
     say "File: Mail message"
     end

return

/*---------------------------------------------------------------------
 | Handle inmr03 segment -- Data Control Record
 ------------------------------------------------------------------- */

handle_inmr03:

if debug == 1 then do
   say " "
   say left('-',79,'-')
   say "Debug: Found INMR03 -- Data Control Record"
   end

inmr03_count = inmr03_count + 1

ptr = 9
textend = segmentl - 9

do while ptr < textend

   call Extract_Text_Unit

   /* Insert code here to look at text unit keys - when needed */
   /* The debug option prints text units found in INMR03 record */

   ptr = ptr + textut
   end

return

/*---------------------------------------------------------------------
 | Handle inmr04 segment -- User Control Record
 ------------------------------------------------------------------- */

handle_inmr04:

if debug == 1 then do
   say " "
   say left('-',79,'-')
   say "Debug: Found INMR04 -- User Control Record"
   end

return

/*---------------------------------------------------------------------
 | Handle inmr07 segment -- Notification Control Record
 ------------------------------------------------------------------- */

handle_inmr07:

if debug == 1 then do
   say " "
   say left('-',79,'-')
   say "Debug: Found INMR07 -- Notification Control Record"
   end

return


/*---------------------------------------------------------------------
 | Extract text unit
 ------------------------------------------------------------------- */

Extract_Text_Unit:

textui = substr(segment,ptr,2)
textun = c2d(substr(segment,ptr+2,2))
textul = c2d(substr(segment,ptr+4,2))
textut = 4                    /* set starting length of text unit */

if textun == 0 then do  /* got a "null" text unit */
   value.1 = ""
   value.0 = 1
   end
else do
     tpos = ptr + 4          /* get temp position in segment */
     do j = 1 to textun
        tlen = c2d(substr(segment,tpos,2))
        value.j = substr(segment,tpos+2,tlen)
        tpos = tpos + tlen + 2
        textut = textut + 2 + tlen
        end
     value.0 = textun
     end

if debug == 1 then do
   call get_textui
   say "Debug: Text Unit key="c2x(textui)" - "tuk
   if value.0 == 0 then say "       > Null text unit"
   else do j = 1 to value.0
           if tuvt == "H" then v = c2x(value.j)
           else do
                v = value.j
                if ebcdic == 0 then ,
                   v = translate(v,hextable,toEBCDIC)
                end
           say "       > Length="length(value.j) "value: "v
           end
   end
return

/*---------------------------------------------------------------------
 | Get record from input XMIT file
 ------------------------------------------------------------------- */

get_record:

arg num

if EOF == 1 then return  /* check for End-Of-File */

select
  when mtype == "CMD"     | ,        /* Object Rexx: OS/2, Win */
       mtype == "COMMAND" | ,        /* PC/DOS 7.0 */
       mtype == "SYSTEM"  then do    /* Regina Rexx */

       iolen = num * 80
       fileloc = filelen + 1
       file = file||charin(xmitfile_name,fileloc,iolen)
       filelen = filelen + iolen
       if filelen = filesize then EOF = 1
       if filelen > filesize then EOF = 1
       end

  when mtype == "TSO" | mtype == "MVS" then do
       "EXECIO "num" DISKR "xmitfile_dd "(STEM xmitfile."
       erc = rc

       if erc <> 0 then EOF = 1
       else do n = 1 to xmitfile.0
               file = file||xmitfile.n
               filelen = filelen + 80
               end
       end

  when mtype == "CMS" then do
       "EXECIO "num" DISKR "fn ft fm" (STEM XMITFILE."
       erc = rc
       if erc <> 0 then EOF = 1
       else do n = 1 to xmitfile.0
               file = file||xmitfile.n
               filelen = filelen + 80
               end
       end

  otherwise
       nop
       end

return


/*---------------------------------------------------------------------
 | Set recfm
 ------------------------------------------------------------------- */

set_recfm: procedure

arg r

r1 = substr(r,1,1)
r2 = substr(r,2,1)

it = ""

if bitand(r1,'C0'x) = 'C0'x then it = "U"
else do
     if bitand(r1,'80'x) = '80'x then it = "F"
     if bitand(r1,'40'x) = '40'x then it = "V"
     end

if bitand(r1,'10'x) = '10'x then it = it"B"
if bitand(r1,'04'x) = '04'x then it = it"A"
if bitand(r1,'02'x) = '02'x then it = it"M"

return it

/*---------------------------------------------------------------------
 | Set dsorg
 ------------------------------------------------------------------- */

set_dsorg: procedure

arg dsorg

select
  when dsorg = '0008'x then it = 'AM'
  when dsorg = '0200'x then it = 'PO'
  when dsorg = '4000'x then it = 'PS'
  otherwise
       it = "??"
       end

return it
/*---------------------------------------------------------------------
 | Hex dump of portions of the file
 ------------------------------------------------------------------- */

Hex_Dump:

parse arg dstart dlen dtitle
say  ' '
say  'Dump of: 'dtitle '- length: 'dlen
say  '+offset 0 1 2 3  4 5 6 7  8 9 a b  c d e f'
doffset = dstart
dleft = dlen
do h = 1 to dlen by 16
   doff = '+'right(d2x(doffset-1),6,'0')
   if dleft < 16 then dgrab = dleft
   else dgrab = 16
   dline = substr(file,doffset,dgrab)
   dhex = ""
   do dj = 1 to dgrab
      if dj == 4 | dj == 8 | dj == 12 then dspace = " "
      else dspace = ""
      dhex = dhex""c2x(substr(dline,dj,1))""dspace
      end
   if ebcdic == 0 then do
      dchars = translate(dline,hextable,toEBCDIC)
      dchars = translate(dchars,copies('.',32),xrange('00'x,'1f'x))
      end
   else dchars = translate(dline,copies('.',32),xrange('00'x,'1f'x))

   say   doff left(dhex,35) "*"left(dchars,16)"*"
   doffset = doffset + 16
   dleft = dleft - 16
   end

return

/*---------------------------------------------------------------------
 | Get meaningful name for this text unit
 |
 | input: textui
 | output: tuk (Text Unit Key)
 |         tuvt (Text Unit value type: H for hex and C for character)
 ------------------------------------------------------------------- */

get_textui:

select
   when textui = INMBLKSZ then do
        tuk = "INMBLKSZ - File block size"
        tuvt = "H"
        end
   when textui = INMCREAT then do
        tuk = "INMCREAT - Creation date"
        tuvt = "C"
        end
   when textui = INMDDNAM then do
        tuk = "INMDDNAM - DDNAME associated with the file"
        tuvt = "C"
        end
   when textui = INMDIR   then do
        tuk = "INMDIR - Number of directory blocks"
        tuvt = "H"
        end
   when textui = INMDSNAM then do
        tuk = "INMDSNAM - File name"
        tuvt = "C"
        end
   when textui = INMDSORG then do
        tuk = "INMDSORG - File organization"
        tuvt = "H"
        end
   when textui = INMERRCD then do
        tuk = "INMERRCD - Error indication for the receive operation"
        tuvt = "C"
        end
   when textui = INMEXPDT then do
        tuk = "INMEXPDT - Expiration date"
        tuvt = "C"
        end
   when textui = INMFACK  then do
        tuk = "INMFACK - Notification ID" ,
        "-OR- Receipt notification requested"
        tuvt = "C"
        end
   when textui = INMFFM   then do
        tuk = "INMFFM - Filemode number of a CMS file"
        tuvt = "C"
        end
   when textui = INMFM    then do
        tuk = "INMFM - Filemode number"
        tuvt = "H"
        end
   when textui = INMFNODE then do
        tuk = "INMFNODE - Origin node name"
        tuvt = "C"
        end
   when textui = INMFTIME then do
        tuk = "INMFTIME - Origin timestamp"
        tuvt = "C"
        end
   when textui = INMFUID  then do
        tuk = "INMFUID - Origin user ID"
        tuvt = "C"
        end
   when textui = INMFVERS then do
        tuk = "INMFVERS - Origin version number"
        tuvt = "H"
        end
   when textui = INMLCHG  then do
        tuk = "INMLCHG - Last change date"
        tuvt = "C"
        end
   when textui = INMLRECL then do
        tuk = "INMLRECL - Length of physical control record segments" ,
        "-OR- Logical record length"
        tuvt = "H"
        end
   when textui = INMLREF  then do
        tuk = "INMLREF - Last reference date"
        tuvt = "H"
        end
   when textui = INMMEMBR then do
        tuk = "INMMEMBR - Member name list"
        tuvt = "C"
        end
   when textui = INMNUMF  then do
        tuk = "INMNUMF - Number of files in this transmission"
        tuvt = "H"
        end
   when textui = INMRECCT then do
        tuk = "INMRECCT - Number of records transmitted"
        tuvt = "H"
        end
   when textui = INMRECFM then do
        tuk = "INMRECFM - Record format"
        tuvt = "H"
        end
   when textui = INMSIZE  then do
        tuk = "INMSIZE - Approximate size of file in bytes" ,
        "-OR- Size of file in bytes"
        tuvt = "H"
        end
   when textui = INMTERM  then do
        tuk = "INMTERM - Data transmitted as a message" ,
        "-OR- Mail file"
        tuvt = "H"
        end
   when textui = INMTNODE then do
        tuk = "INMTNODE - Target node name"
        tuvt = "C"
        end
   when textui = INMTTIME then do
        tuk = "INMTTIME - The time the transmission was received," ,
              "in standard format"
        tuvt = "C"
        end
   when textui = INMTUID  then do
        tuk = "INMTUID - Target user ID"
        tuvt = "C"
        end
   when textui = INMUSERP then do
        tuk = "INMUSERP - User parameter string"
        tuvt = "H"
        end
   when textui = INMUTILN then do
        tuk = "INMUTILN - Utility program name"
        tuvt = "C"
        end
   otherwise
        tuk = "INM???? - Unknown (unhandled) text unit"
        tuvt = "H"
        end

return

/*---------------------------------------------------------------------
 | END END END END END - End of XMITINFO exec - END END END END END
 ------------------------------------------------------------------- */