identification division.
program-id.     acpqio.
data division.
working-storage section.
*
* File Information Block (FIB).
*
01  fib.
    03  fib$l_acctl     pic s9(9)       comp.
    03  fib$w_fid.
        05  fid_num     pic s9(4)       comp.
        05  fid_seq     pic s9(4)       comp.
        05  fid-rvn     pic s9(4)       comp.
    03  fib$w_did.
        05  did_num     pic s9(4)       comp.
        05  did_seq     pic s9(4)       comp.
        05  did_rvn     pic s9(4)       comp.
    03  fib$l_wcc       pic s9(9)       comp.
    03  fib$w_nmctl     pic s9(4)       comp.
*
* Attribute list.
*
01  attr_control_block.
    03  attr1_size      pic s9(4)    comp  value external atr$s_ascdates.
    03  attr1_type      pic s9(4)    comp  value external atr$c_ascdates.
    03  attr1_addr      pointer value reference asc_dates.
    03  attr_terminator pic s9(9)    comp  value 0.
*
* Attribute buffer.
*
01  asc_dates.
    03  rev_count       pic s9(4)       comp.
    03  rev_date        pic x(7).
    03  rev_time        pic x(6).
    03  cre_date        pic x(7).
    03  cre_time        pic x(6).
    03  exp_date        pic x(7).
    03  exp_time        pic x(6).
*
* I/O Status Block.
*
01  iosb.
    03  iosb_stat       pic s9(4)       comp.
    03  filler          pic x(6).
*
01  io$_access          pic s9(9)       comp value external io$_access.
01  stat                pic s9(9)       comp.
01  chan                pic s9(4)       comp.
01  func                pic s9(9)       comp.
01  device_name         pic x(5).
01  file_name           pic x(63).
procedure division.
begin.
*
* Assign a channel to the disk for the SYS$QIO call.
*
    display 'Enter disk device name <dduu:> ' with no advancing.
    accept device_name.

    call 'SYS$ASSIGN' using by descriptor device_name
                            by reference chan
                            by value 0 0
                      giving stat.
    if stat is failure call 'lib$stop' using by value stat.
*
* Get the file ID for the file to be accessed.  Here we call a user-
* written MACRO routine to return the FID
* (see below for GETFID.MAR source).
*
    display 'Enter file name ' with no advancing.
    accept file_name.
    call 'GETFID' using by descriptor file_name
                        by reference fib$w_fid.
*
* Call the ACP QIO service with a function code of IO$_ACCESS
* to initiate a read attributes operation.
*
    move io$_access to func.
    call 'SYS$QIOW' using by value 0
                          by value chan
                          by value func
                          by reference iosb
                          by value 0 0
                          by descriptor fib
                          by value 0 0 0
                          by reference attr_control_block
                          by value 0
                    giving stat.
    if stat is failure call 'lib$stop' using by value stat.
    if iosb_stat is failure call 'lib$stop' using by value iosb_stat.
    display 'File accessed:'
    display '    creation date:   ' cre_date.
    display '    revision date:   ' rev_date.
    display '    expiration date: ' exp_date.
*
* De-assign the I/O channel.
*
    call 'SYS$DASSGN' using by value chan
                      giving stat.
    if stat is failure call 'lib$stop' using by value stat.
    stop run.
end program acpqio.