status = $OPEN                       ! Open a data file
status = $CONNECT                    ! Connect a record stream
status = $OPEN                       ! Open an error file
status = $CONNECT                    ! Connect a record stream
UNTIL <no more records to process>

    BEGIN
    trx_aborted = FALSE              ! Assume everything will work
    status = $START_TRANSW           ! Start a transaction
    status = $GET                    ! Read a record from the file
    status = $ACMS$CALL              ! Call a task
    IF .status                       ! If task completed OK,
    THEN                             ! then...

        BEGIN               
        status = $DELETE             !   Delete the record
        status = $END_TRANSW         !   and end the transaction
        IF NOT .status               !   If transaction rolled back,
        THEN                         !   then...
            txn_aborted = TRUE       !     Set the flag so we know
        END

    IF NOT .status                   ! If something went wrong (task
    THEN                             ! failed or txn rolled back,
        BEGIN                        ! then...
        IF NOT .txn_aborted          !   If txn hasn't rolled back,
        THEN                         !   then...
            $ABORT_TRANS             !     Roll back transaction
        $START_TRANSW                !   Start a new transaction
        $GET                         !   Reread record from file
        $PUT                         !   Store record in error file
        $DELETE                      !   Delete rec. from data file
        $END_TRANSW                  !   And end the transaction
        END  

$DISCONNECT                          ! Disconnect both
$DISCONNECT                          ! record streams
$CLOSE                               ! Close both the data
$CLOSE                               ! and error files

REPLACE TASK BANKING_SAMPLE_TSK /DIAGNOSTIC
DEFAULT FORM IS BANKING_SAMPLE_FORM;
WORKSPACE IS BANKING_SAMPLE_WORKSPACE WITH TYPE TASK;

     BLOCK WORK WITH FORM I/O

        INPUT_REQUEST:

         EXCHANGE
      TRANSCEIVE RECORD BANKING_SAMPLE_REC, BANKING_SAMPLE_REC
        IN BANKING_SAMPLE_FORM
          SENDING BANKING_SAMPLE_WORKSPACE
          RECEIVING BANKING_SAMPLE_WORKSPACE;


        BANKING_SAMPLE_PROCESSING:

        PROCESSING WITH DISTRIBUTED TRANSACTION
          CALL BANKING_SAMPLE_TXN IN BANKING_SAMPLE_SERVER
          USING BANKING_SAMPLE_WORKSPACE;

!+
!  Check the return status in the field ACMS$L_STATUS.
!  This field contains 1 is success, -913 if deadlock.
!  If deadlock, try again.  Otherwise, cancel task.
!-



        ACTION IS
            SELECT FIRST TRUE OF
            (ACMS$L_STATUS = 1):    COMMIT TRANSACTION;
            (ACMS$L_STATUS = -913): ROLLBACK TRANSACTION;
                                    GOTO STEP BANKING_SAMPLE_PROCESSING; 
            NOMATCH:                ROLLBACK TRANSACTION;
                                    CANCEL TASK;
            END SELECT;



        EXCEPTION ACTION IS
            CANCEL TASK;




        OUTPUT_REQUEST:

         EXCHANGE
          TRANSCEIVE RECORD BANKING_SAMPLE_REC, BANKING_SAMPLE_REC
            IN BANKING_SAMPLE_FORM
          SENDING BANKING_SAMPLE_WORKSPACE
          RECEIVING BANKING_SAMPLE_WORKSPACE;




!+
!  Examine the control field. If the request returns Y, 
!  then leave the task; else, repeat the task.
!-



        ACTION IS
            IF (BANKING_SAMPLE_WORKSPACE.WORKSPACE_EXIT_SWITCH = "Y") THEN
                EXIT TASK;
            ELSE
                GOTO STEP BANKING_SAMPLE_PROCESSING;
            END IF;


    END BLOCK WORK;

END DEFINITION;

REPLACE TASK BANKING_SAMPLE_ACTUPD_TSK /DIAGNOSTIC
WORKSPACE IS BANKING_SAMPLE_WORKSPACE WITH TYPE TASK;
TASK ARGUMENT IS BANKING_SAMPLE_WORKSPACE WITH ACCESS MODIFY;

    BLOCK WORK WITH DISTRIBUTED TRANSACTION NO I/O 



        BANKING_SAMPLE_PROCESSING:

        PROCESSING
            CALL BANKING_SAMPLE_ACTUPD_TXN IN BANKING_SAMPLE_ACTUPD_SERVER
            USING BANKING_SAMPLE_WORKSPACE;

    END BLOCK WORK;



    ACTION IS 
        IF (ACMS$L_STATUS <> 1) THEN
            CANCEL TASK RETURNING ACMS$L_STATUS;
        END IF;

END DEFINITION;

/*************************************************************************/
/*                                                                       */
/*                        Sample Banking Application                     */
/*                     Branch/Teller Update Transaction                  */
/*                     --------------------------------                  */
/*                                                                       */
/*  This is the server procedure called by the BANKING_SAMPLE_TSK task   */
/*  to perform local update of branch and teller data and invoke the     */
/*  remote task, BANKING_SAMPLE_ACTUPD_TASK, for update of an account    */
/*  on a remote node.                                                    */
/*************************************************************************/



#include ssdef
#include stdio
#include descrip
#include string
#include ACMS$SUBMITTER                          



/* DECdtm transaction ID structure */
struct tid_structure    
    {
    long int  field_1;
    long int  field_2;
    short int field_3;
    short int field_4;
    long int  field_5;
    } tid;


/* SQL Transaction context structure */
struct context_structure    
    {
    long int version;
    long int type;
    long int length;
    struct tid_structure in_tid;
    long int end;
    };



char txn_time[9],txn_date[7];
$DESCRIPTOR(date_time_dscrptr,"dd-mmm-yyyy hh:mm:ss.hh");


/* Data Structure for ACMS/SI */    
struct ACMS$SUBMITTER_ID submitter_id;
struct ACMS$PROCEDURE_ID procedure_id; 
struct dsc$descriptor wksp_dscrptr;
struct dsc$descriptor tsk_dscrptr;
struct dsc$descriptor appl_dscrptr; 
char appl_name[32];


struct single_item_list_structure {
    short int proc_bufsize;
    short int proc_itmcode;
    char     *proc_bufaddr;
    char     *proc_retlen;
    int       item_last;
} single_item_list;


struct arg_list_struct {
    long int count;
    char *sel_str;
    char *ext_sts;
    char *tsk_io;
    char *ws_1;
} arg_list;


/* SQL and Database Declaration */
EXEC SQL INCLUDE SQLCA;
EXEC SQL DECLARE SCHEMA FOR FILENAME BANK_SAMPLE;
EXEC SQL INCLUDE FROM DICTIONARY BANKING_SAMPLE_WORKSPACE;    




/*********************************************************/
/*               Banking Sample Transaction.             */
/*********************************************************/
banking_sample_txn(workspace_area)
struct banking_workspace *workspace_area;
{
    struct banking_workspace WSBuff;
    char ActBranchBuff[5],ActAccountBuff[7];
    static struct context_structure context={1,1,16,{0,0,0,0,0},0};
    char ErrMsgText[300];
    int  ErrMsgLength;
    int  status;
    $DESCRIPTOR(ErrMsgBuffDsc,"");



    /* Copy some data values from workspace to local buffers due */
    /* to the lack of pointer support in Embedded SQL for C.     */

    WSBuff.workspace_branch = workspace_area->workspace_branch;
    WSBuff.workspace_teller = workspace_area->workspace_teller;
    strncpy(ActBranchBuff, 
        workspace_area->workspace_account.workspace_acc_branch,
            4);
    strncpy(ActAccountBuff,
            workspace_area->workspace_account.workspace_acc_account,
            6);
    WSBuff.workspace_delta  = workspace_area->workspace_delta;



    /* Get TID from ACMS and store into SQL context structure */
    status = ACMS$GET_TID(&tid);     
    if (!(status & SS$_NORMAL)) return(status);
    context.in_tid = tid;


    EXEC SQL WHENEVER SQLERROR GOTO sql_error_check;



    /* Initialization in preparation for ACMS RPC call. */
    status = InitializeACMSRPC();     
    if (!(status & SS$_NORMAL)) 
      return(status);
 


transaction_restart:
    /***********************************************/
    /*                Modify Branch.               */
    /***********************************************/
    /* Perform update on the MONEY field for 
       appropriate branch in BRANCH relation. */
    EXEC SQL USING CONTEXT :context
      UPDATE BRANCH B
        SET B.BR_MONEY_FIELD = 
          B.BR_MONEY_FIELD + :WSBuff.workspace_delta
        WHERE B.BR_BRANCH = :WSBuff.workspace_branch;


    /***********************************************/
    /*                Modify Teller.               */
    /***********************************************/

    /* Perform update on MONEY field for appropriate 
       teller in the TELLER relation.                */
    EXEC SQL USING CONTEXT :context
      UPDATE TELLER T
        SET T.TEL_MONEY_FIELD = 
          T.TEL_MONEY_FIELD + :WSBuff.workspace_delta
        WHERE (T.TEL_BRANCH = :WSBuff.workspace_branch)
          AND (T.TEL_TELLER = :WSBuff.workspace_teller);        

    
    /**********************************************/
    /*  Invoke remote task to update Account and  */     
    /*  store History records via ACMS$CALL.      */
    /**********************************************/
    wksp_dscrptr.dsc$a_pointer = workspace_area;
    wksp_dscrptr.dsc$w_length  = sizeof(*workspace_area);
    status = ACMS$CALL (&submitter_id,
                        &procedure_id,
                        &arg_list,
                        &tid);



    /* Check return status code - if failure, log error msg */    

    if (!(status & SS$_NORMAL)) {
      error_logging("ACMS$CALL error.",
                     status,
                     WSBuff.workspace_branch,
                     WSBuff.workspace_teller,
                     ActBranchBuff,
                     ActAccountBuff,
                     WSBuff.workspace_delta);
      return(status);
      }



    /* End of Transaction. */
    workspace_area->workspace_delta = 0;
    status = SS$_NORMAL;
    return(status);



    /* Log error message if SQL error. */     
    sql_error_check:

      ErrMsgBuffDsc.dsc$a_pointer = ErrMsgText;
      SQL$GET_ERROR_TEXT(&ErrMsgBuffDsc,&ErrMsgLength);
      ErrMsgText[ErrMsgLength] = '\0';
      error_logging(ErrMsgText,
                 SQLCA.SQLCODE,
                 WSBuff.workspace_branch,
                 WSBuff.workspace_teller,
                 ActBranchBuff,
                 ActAccountBuff,
                 WSBuff.workspace_delta);

      return(SQLCA.SQLCODE);
}




InitializeACMSRPC()
{
    int status;

    /* initialize ACMS RPC data structure */    
    tsk_dscrptr.dsc$a_pointer = "BANKING_SAMPLE_ACTUPD_TSK";    
    tsk_dscrptr.dsc$w_length  = 25;

    strcpy(&appl_name[0],"SLVSTR::BANK_SAMPLE_APP");
    appl_dscrptr.dsc$a_pointer = &appl_name[0];
    appl_dscrptr.dsc$w_length  = strlen(&appl_name[0]);


    /* Sign-in to ACMS as a task submitter. */
    status = ACMS$SIGN_IN(&submitter_id,0,0,0,0);     
    if (!(status & SS$_NORMAL)) {
      error_logging("ACMS sign-in error.",status,0,0," "," ",0);
      return(status);
      }

    /* Prepare ACMS$GET_PROCEDURE_INFO item list for remote task */    
    single_item_list.proc_bufsize = ACMS$S_PROCEDURE_ID;
    single_item_list.proc_itmcode = ACMS$K_PROC_PROCEDURE_ID;
    single_item_list.proc_retlen  = 0; 
    single_item_list.item_last = 0; 


    /* Get remote procedure information */
    single_item_list.proc_bufaddr = &procedure_id;
    status = ACMS$GET_PROCEDURE_INFO (&submitter_id,
                                      &tsk_dscrptr,
                                      &appl_dscrptr,
                                      &single_item_list);
    if (!(status & SS$_NORMAL)) 
      {
       error_logging("ACMS GET_PROCEDURE_INFO error.",status,
                      0,0," "," ",0);
       return(status);
      }


    /* Prepare ACMS$CALL() argument list for remote task */
    arg_list.count   = 4;
    arg_list.sel_str = 0;
    arg_list.ext_sts = 0;
    arg_list.tsk_io  = 0;
    arg_list.ws_1    = &wksp_dscrptr;    

    return(1);
}

/**************************************************************/
/*                                                            */
/*               Version:        01                           */
/*               Authors:        HP                           */
/*                                                            */
/**************************************************************/
/**************************************************************/
/*         F U N C T I O N A L   D E S C R I P T I O N        */
/*                                                            */
/*                                                            */
/*    VR_AGENT is an ACMS agent program that acts like an ATM */
/*    where you type in your reservation number and odometer  */
/*    reading, drop the keys in a slot, and walk away.  The   */
/*    system bills you later for the amount you owe.  The     */
/*    agent uses QIOs to get the data, starts a distributed   */
/*    transaction, then calls a task to do the work. The task */
/*    consists of a nonparticipating step that validates the  */
/*    reservation number, a step that queues a task to do the */
/*    actual checkin work, and a step that writes a history   */
/*    record.  If the task succeeds, the agent commits the    */
/*    transaction.  If the task  fails, the agent aborts the  */
/*    the transaction and notifies the user of the problem.   */
/*    The agent is also responsible for handling errors, such */
/*    as transaction timeouts.                                */
/*                                                            */
/**************************************************************/



/*************************************************/
/*                                               */
/*    Include's / Define's / Macros Required     */
/*                                               */
/*************************************************/

#include descrip
#include iodef
#include rmsdef
#include ssdef
#include stdio
#include stsdef

#include ACMS$SUBMITTER
#include ACMS$STREAM



#define MAX_RESERVATION    10
#define MAX_ODOMETER       6
#define MAX_RETRY          5

#define TRUE               1
#define FALSE              0
#define CANCEL             'C'

#define check_status(stat) if (!(stat & 1)) LIB$STOP(stat)




/*****************************/
/*                           */
/*    Declare Global Data    */
/*                           */
/*****************************/

    globalvalue ACMS$_NOSUCH_PKG;
    globalvalue ACMS$_SRVDEAD;
    globalvalue ACMS$_TRANSTIMEDOUT;

    globalvalue RDB$_DEADLOCK;
    globalvalue RDB$_LOCK_CONFLICT;
    globalvalue RDMS$_DEADLOCK;
    globalvalue RDMS$_LCKCNFLCT;
    globalvalue RDMS$_TIMEOUT;

    typedef struct {
        short int bufsize;
        short int itmcode;
        int bufadr;
        int retlen;
    } item;

    typedef int quadword[2];

    struct fast_check_in_blk {
        int reservation_id;
        int return_odometer_reading;
        quadword actual_return_date;                
    } fast_check_in_wksp;



    struct io_stat_blk {
    short int status ;
        short int msg_len ;
        int unused;
    } iosb;

    struct {
        item pr_id;
    int  terminator;
    } task_info_list;

    int status, *tid[ 4 ], argument_list[ 5 ];

    short chan;



    char task_status[ 80 ];

    $DESCRIPTOR(task_status_desc, task_status);

    $DESCRIPTOR(task_name_desc, "VR_FAST_CHECKIN_TASK");
    $DESCRIPTOR(appl_name_desc, "VR_APPL");

    struct dsc$descriptor_s fast_check_in_wksp_desc;
    
    struct ACMS$SUBMITTER_ID    submitter_id;
    struct ACMS$PROCEDURE_ID    procedure_id;
    struct ACMS$CALL_ID         call_id;




main ()

/**************************************************************************/
/*                                                                        */
/*    Get procedure information to see if the application is running.     */
/*                                                                        */
/*    While the application is up and running, prompt user for            */
/*    reservation ID and odometer reading.                                */
/*                                                                        */
/*    If the user enters the data, process the fast checkin transaction.  */
/*                                                                        */
/*    If the user aborts, then notify the user that the transaction was   */
/*    not processed.                                                      */
/*                                                                        */
/**************************************************************************/
{
    for (;;)
    {
        status = initialization ();

        check_status(status);

        status = ACMS$GET_PROCEDURE_INFO(&submitter_id,
                                         &task_name_desc,
                                         &appl_name_desc,
                                         &task_info_list);

        while (status & STS$M_SUCCESS)
        {
            status = get_data ();        

            if (status & STS$M_SUCCESS) 
                status = process_this_transaction();
            else if (status == RMS$_EOF)
                    status = report_user_abort();



            check_status(status);

            status = ACMS$GET_PROCEDURE_INFO(&submitter_id,
                                             &task_name_desc,
                                             &appl_name_desc,
                                             &task_info_list);
        }
    
        if (status == ACMS$_NOSUCH_PKG)
            status = application_not_running();

        check_status(status);

        status = termination ();

        check_status(status);

    }

}



initialization ()

/************************************************/
/*                                              */
/*    Assign channel and sign user in to ACMS.  */
/*    Set up descriptors, task info list, and   */
/*    argument lists for later processing       */
/*                                              */
/************************************************/

{
    $DESCRIPTOR(terminal, "SYS$COMMAND"); 

    status = SYS$ASSIGN (&terminal, &chan,0,0);

    if (status & STS$M_SUCCESS) 
        status = ACMS$SIGN_IN(&submitter_id, 0, 0);

    if (status & STS$M_SUCCESS) 
    {

        fast_check_in_wksp_desc.dsc$w_length = sizeof(fast_check_in_wksp);
        fast_check_in_wksp_desc.dsc$a_pointer = &fast_check_in_wksp;
        fast_check_in_wksp_desc.dsc$b_dtype = DSC$K_DTYPE_T;
        fast_check_in_wksp_desc.dsc$b_class = DSC$K_CLASS_S;

    task_info_list.pr_id.bufsize    = ACMS$S_PROCEDURE_ID;
    task_info_list.pr_id.itmcode    = ACMS$K_PROC_PROCEDURE_ID;
    task_info_list.pr_id.bufadr = &procedure_id;
    task_info_list.pr_id.retlen = 0;
    task_info_list.terminator   = 0;


        argument_list[ 0 ] = 4;
        argument_list[ 1 ] = 0;
        argument_list[ 2 ] = &task_status_desc;
        argument_list[ 3 ] = 0;
        argument_list[ 4 ] = &fast_check_in_wksp_desc;

    }

    return status;
}



get_data ()

/*********************************************************/
/*                                                       */
/*    Prompt for reservation ID and odometer reading.    */
/*                                                       */
/*    For the purpose of this example, it is expected    */
/*    that input will consist of numeric characters &    */
/*    that the user will enter leading zeroes.           */
/*                                                       */
/*    e.g., Reservation ID 000123456                     */
/*          Odometer Reading 05575                       */
/*                                                       */
/*    Validation will be done to ensure this; the        */
/*    user can abort by entering "Cancel."               */
/*                                                       */
/*********************************************************/



{
    short input_complete;

    char reservation[ MAX_RESERVATION ];
    char odometer[ MAX_ODOMETER ];

    $DESCRIPTOR(reservation_desc, reservation);
    $DESCRIPTOR(odometer_desc, odometer);

    $DESCRIPTOR(input_reservation_id, "Input Reseveration Id 'Cancel' to Exit: ");
    $DESCRIPTOR(input_odometer, "Input Odometer Reading 'Cancel' to Exit: ");

    input_complete = FALSE;

    while (input_complete == FALSE)
    {



        printf("\n");
        status = SYS$QIOW (0, 
                           chan, 
                           IO$_READPROMPT|IO$M_CVTLOW, 
                           &iosb, 
                           0, 0,
                           &reservation,
                           reservation_desc.dsc$w_length,
                           0, 0,
                           input_reservation_id.dsc$a_pointer,
                           input_reservation_id.dsc$w_length);


            
        if (status & STS$M_SUCCESS)
            status = iosb.status;
    
        if ((status & STS$M_SUCCESS) && (reservation[0] == CANCEL))
            status = RMS$_EOF; 
    
        if (status & STS$M_SUCCESS)
            status = OTS$CVT_TU_L(&reservation_desc,
                                  &fast_check_in_wksp.reservation_id,
                                  4,0);

        if ((status & STS$M_SUCCESS) || (status == RMS$_EOF))
            input_complete = TRUE;
    }


        
    if (status & STS$M_SUCCESS)
    {
        input_complete = FALSE;

        while (input_complete == FALSE)
        {

            printf("\n");
            status = SYS$QIOW (0, 
                               chan, 
                               IO$_READPROMPT|IO$M_CVTLOW, 
                               &iosb, 
                               0, 0,
                               &odometer, 
                               odometer_desc.dsc$w_length,
                               0, 0,
                               input_odometer.dsc$a_pointer,
                               input_odometer.dsc$w_length);

            if (status & STS$M_SUCCESS)
                status = iosb.status;
    
            if ((status & STS$M_SUCCESS) && (odometer[0] == CANCEL))
                status = RMS$_EOF;
    
            if (status & STS$M_SUCCESS)
                status = OTS$CVT_TU_L(&odometer_desc,
                                      &fast_check_in_wksp.return_odometer_reading,
                                      4,0);

            if ((status & STS$M_SUCCESS) || (status == RMS$_EOF))
                input_complete = TRUE;
        }
    }


    
    if (status & STS$M_SUCCESS)
        status = SYS$GETTIM (&fast_check_in_wksp.actual_return_date);

    return status;

}




process_this_transaction()

/********************************************************************/
/*                                                                  */
/*    Start transaction. Call the task. Commit if successful.       */
/*    Abort if failure. Retry if timed out. Notify user whether     */
/*    transaction succeeded or failed.                              */
/*                                                                  */
/********************************************************************/


  

{
    short retry, trans_completed;
    retry = 0;
    trans_completed = FALSE;


    
    while ((trans_completed == FALSE) && (retry < MAX_RETRY))
    {
        status = SYS$START_TRANSW (0,0,&iosb,0,0,tid);       
    
        if (status & STS$M_SUCCESS)
            status = iosb.status;

        check_status(status);

        status = call_return_task();       



        if (status & STS$M_SUCCESS) 
        {
            status = SYS$END_TRANSW (0,0,&iosb,0,0,tid);       

            if (status & STS$M_SUCCESS)
                status = iosb.status;

            check_status(status);



            trans_completed = TRUE;
        }
        else
        {
            if ((status == ACMS$_TRANSTIMEDOUT) || 
                (status == ACMS$_SRVDEAD) ||
                (status == RDB$_DEADLOCK) ||
                (status == RDMS$_DEADLOCK) ||
                (status == RDB$_LOCK_CONFLICT) ||
                (status == RDMS$_LCKCNFLCT) ||
                (status == RDMS$_TIMEOUT))
                ++retry;
            else
                retry = MAX_RETRY;



            status = SYS$ABORT_TRANSW (0,0,&iosb,0,0,tid);        
        
            if (status & STS$M_SUCCESS)
                status = iosb.status;

            check_status(status);
        }
    }


    if (trans_completed == FALSE)
        status = notify_failure();
    else
        status = notify_success();

    return status;
}



call_return_task()

/******************************************************************/
/*                                                                */
/*    Call the task. Error handling will be done by the calling   */
/*    task.                                                       */
/*                                                                */
/******************************************************************/



{
    status = ACMS$START_CALL (&submitter_id, 
                              &procedure_id,
                              &call_id,
                              argument_list,
                              tid);

    if (status & STS$M_SUCCESS)
    status = ACMS$WAIT_FOR_CALL_END (&submitter_id,
                                         &call_id);

    return status;
}



notify_failure ()

/*******************************************************************/
/*                                                                 */
/*    Failure returned from called task is displayed to the user.  */
/*                                                                 */
/*******************************************************************/



{
    printf("\n");
    status = SYS$QIOW (0, 
                       chan, 
                       IO$_WRITEVBLK, 
                       &iosb, 
                       0, 0,
                       task_status_desc.dsc$a_pointer,
                       task_status_desc.dsc$w_length,
                       0, 0, 0, 0);

    return status;
}



application_not_running()

/*************************************************************/
/*                                                           */
/*    Display application not running and wait 60 seconds.   */
/*                                                           */
/*************************************************************/



{
     float wait_time = 10.0;

    $DESCRIPTOR(appl_not_up_msg, "Application not Available at this time" );

    printf("\n");
    status = SYS$QIOW (0, 
                       chan, 
                       IO$_WRITEVBLK, 
                       &iosb, 
                       0, 0,
                       appl_not_up_msg.dsc$a_pointer,
                       appl_not_up_msg.dsc$w_length,
                       0, 0, 0, 0);


    
    if (status & STS$M_SUCCESS)
        status = iosb.status;

    if (status & STS$M_SUCCESS)
        status = LIB$WAIT(&wait_time);

    return status;
}



notify_success()

/*************************************************************/
/*                                                           */
/*    Display transaction has been successfully completed.   */
/*                                                           */
/*************************************************************/



{
    $DESCRIPTOR(success_queued_msg, "Transaction Successfully Queued ");

    printf("\n");
    status = SYS$QIOW (0, 
                       chan, 
                       IO$_WRITEVBLK, 
                       &iosb, 
                       0, 0,
                       success_queued_msg.dsc$a_pointer,
                       success_queued_msg.dsc$w_length,
                       0, 0, 0, 0);


    
    if (status & STS$M_SUCCESS)
        status = iosb.status;

    return status;
}



report_user_abort()

/******************************************************/
/*                                                    */
/*    Display operation canceled at user's request.   */
/*                                                    */
/******************************************************/



{
    $DESCRIPTOR(user_abort_msg, "Fast Checkin Has Been Canceled by user ");

    printf("\n");
    status = SYS$QIOW (0, 
                       chan, 
                       IO$_WRITEVBLK, 
                       &iosb, 
                       0, 0,
                       user_abort_msg.dsc$a_pointer,
                       user_abort_msg.dsc$w_length,
                       0, 0, 0, 0);


    
    if (status & STS$M_SUCCESS)
        status = iosb.status;

    return status;
}



termination ()

/****************************************************/
/*                                                  */
/*    Deassign channel and sign user out of ACMS    */
/*                                                  */
/****************************************************/



{
    status = SYS$DASSGN(chan);

    if (status & STS$M_SUCCESS)
        status = ACMS$SIGN_OUT(&submitter_id);

    return status;

}

PROGRAM fortran_agent
C   
C   This agent program allows the user to select tasks of all exchange I/O 
C   methods except stream I/O or I/O involving the ACMS Request Interface 
C   (RI).
C
        IMPLICIT NONE
C
 INCLUDE 'SYS$LIBRARY:ACMSFOR (ACMS$SUBMITTER)/LIST'

        RECORD / ACMS$SUBMITTER_ID / submitter_id
        RECORD / ACMS$EXCHANGE_IO_ID / exchange_io_id
        RECORD / ACMS$PROCEDURE_ID / procedure_id
        RECORD / ACMS$CALL_ID / call_id



     INTEGER*4 status
 INTEGER*4 LIB$SYS_TRNLOG, LIB$GET_INPUT, LIB$PUT_OUTPUT
C
C Variable declarations for ACMS$SIGN_IN
C
 CHARACTER*10 terminal_name
 INTEGER*4 terminal_name_desc (2)


C
C Variable declarations for ACMS$GET_PROCEDURE_INFO
C
 LOGICAL select_task
 LOGICAL need_task_info
C
 INTEGER*4 io_method
 CHARACTER*31 application_name
 CHARACTER*31 task_name
 INTEGER*4 task_name_desc (2)
 INTEGER*4 task_name_len


C
 INTEGER*2 task_info_list (14)
     EQUIVALENCE ( task_info_list (1), itm_io_bufsize )
     INTEGER*2 itm_io_bufsize
     EQUIVALENCE ( task_info_list (2), itm_io_itmcode )
     INTEGER*2 itm_io_itmcode
     EQUIVALENCE ( task_info_list (3), itm_io_bufadr )
     INTEGER*4 itm_io_bufadr
     EQUIVALENCE ( task_info_list (5), itm_io_retlen )
     INTEGER*4 itm_io_retlen


C
     EQUIVALENCE ( task_info_list (7), itm_proc_bufsize )
     INTEGER*2 itm_proc_bufsize
     EQUIVALENCE ( task_info_list (8), itm_proc_itmcode )
     INTEGER*2 itm_proc_itmcode
     EQUIVALENCE ( task_info_list (9), itm_proc_bufadr )
     INTEGER*4 itm_proc_bufadr
     EQUIVALENCE ( task_info_list (11), itm_proc_retlen )
     INTEGER*4 itm_proc_retlen
C
     EQUIVALENCE ( task_info_list (13), itm_last )
     INTEGER*4 itm_last



C
C Variable declarations for ACMS$START_CALL
C
 INTEGER*4 argument_list (4)

 CHARACTER*255 selection_string
 CHARACTER*80 status_string
     INTEGER*4 selection_string_desc (2)
     INTEGER*4 status_string_desc (2)



C***************************************************************************

C
C Sign in to ACMS, including terminal so that tasks ACMS can authenticate
C the terminal and the submitter can select tasks that use the terminal.
C
 status = LIB$SYS_TRNLOG ('TT', , terminal_name)
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL (%VAL (status) )
 END IF



 status = ACMS$SIGN_IN (  submitter_id,
 1                        ,
 2    terminal_name )

 IF (.NOT. status) THEN 
     CALL LIB$SIGNAL (%VAL (status) )
 END IF



C
C Initialize the submitter to do exchange I/O on behalf of the tasks that it 
C selects.  This submitter is written to do any kind of exchange I/O except 
C stream I/O or I/O involving the ACMS Request Interface (RI).
C
        status = ACMS$INIT_EXCHANGE_IO ( submitter_id, exchange_io_id )
 IF (.NOT. status) THEN 
     CALL LIB$SIGNAL (%VAL (status) )
 END IF


C
C Construct the item list to get information about the task
C
     itm_io_bufsize = 4
     itm_io_itmcode = ACMS$K_PROC_IO_METHOD
     itm_io_bufadr = %LOC (io_method ) 
     itm_io_retlen = 0



     itm_proc_bufsize = ACMS$S_PROCEDURE_ID
     itm_proc_itmcode = ACMS$K_PROC_PROCEDURE_ID
     itm_proc_bufadr = %LOC ( procedure_id )
     itm_proc_retlen = 0
C
     itm_last = 0
C
C Loop for task selections, until user types EXIT instead of application name
C
 select_task = .TRUE.
 DO WHILE (select_task)


C
C Loop until we get a good application/task name.
C
     need_task_info = .TRUE.
     DO WHILE (need_task_info)


C
C Ask for application name and task name.
C
 status = LIB$GET_INPUT (application_name, 'Application name: ')
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL ( %VAL (status) )
 ELSE
     IF (application_name .EQ. 'EXIT') THEN 
  select_task = .FALSE.
         GO TO 2000
     END IF
 END IF


 status = LIB$GET_INPUT (task_name, 'Task name: ', task_name_len)
 IF (.NOT. status) THEN
     CALL LIB$SIGNAL ( %VAL (status) )
 END IF

 task_name_desc (1) = task_name_len
 task_name_desc (2) = %LOC (task_name)
C
C Get the procedure ID for the task.
C If we have a good application/task name, continue.  Otherwise, 
C print error message and try again.
C


 status = ACMS$GET_PROCEDURE_INFO ( submitter_id,
1                                          task_name_desc,
    2               application_name,
    3                                          task_info_list )
 IF (.NOT. status) THEN 
         CALL LIB$SIGNAL (%VAL( status ) )
 ELSE
     need_task_info = .FALSE.
 END IF
        END DO


C
C Get the selection string, if any.
C
        status = LIB$GET_INPUT (selection_string, 'Selection string: ')
         IF (.NOT. status) THEN
             CALL LIB$SIGNAL (%VAL (status) )
        END IF


C
C Set up argument list for the task. 
C
C   - Selection string descriptor
C   - Extended status descriptor
C   - Exchange I/O ID
C
            argument_list (1) = 3


        selection_string_desc (1)= LEN (selection_string)
    selection_string_desc (2)= %LOC (selection_string)
    argument_list (2) = %LOC (selection_string_desc)
C
        status_string_desc (1) = LEN (status_string)
    status_string_desc (2) = %LOC (status_string)
    argument_list (3) = %LOC (status_string_desc)
C
            argument_list (4) = %LOC (exchange_io_id)


C
C Now start the task.
C
     status = ACMS$START_CALL ( submitter_id, 
     1          procedure_id,
     2          call_id,
     3      argument_list ) 
     IF (.NOT. status) THEN 
      CALL LIB$SIGNAL (%VAL (status) )
     END IF


C
C Wait for task to complete.
C
    status = ACMS$WAIT_FOR_CALL_END (submitter_id, 
    1      call_id)
    IF (.NOT. status) THEN 
      CALL LIB$SIGNAL (%VAL (status) )
    END IF


C Display final status for task.
C
 IF ((status_string .NE. ' ') .AND. 
 1   (status_string .NE. 'Task completed normally')) THEN
     CALL LIB$PUT_OUTPUT (status_string)
 END IF


C
C We come here when the user wishes to exit the agent program.
C
2000 END DO



C
C Sign the submitter out. 
C
     status = ACMS$SIGN_OUT ( submitter_id )
  IF (.NOT. status) THEN 
     CALL LIB$SIGNAL (%VAL (status) )
  END IF
C
END

/*
 *  This agent program is a special-case agent that only handles tasks 
 *  that do stream I/O in exchange steps.  
 */


 
/** include descriptor declarations **/
#include "sys$library:descrip.h"



/** include ACMS definition files (from sys$library:acmscc.tlb) **/
#include acms$submitter
#include acms$stream



#define SUCCESS 1
#define TRUE 1
#define FALSE 0
#define NULL 0


/** define structure for item list **/
struct item {
    short int bufsize;
    short int itmcode;
    char *bufadr;
    int retlen;
};



main()
{

/*
 *      External routines
 */
int LIB$GET_INPUT();
int LIB$PUT_OUTPUT();


/*
 *      Variables for ACMS IDs
 */
struct ACMS$SUBMITTER_ID submitter_id;
struct ACMS$EXCHANGE_IO_ID exchange_io_id;
struct ACMS$CONNECT_ID connect_id;
struct ACMS$PROCEDURE_ID procedure_id;
struct ACMS$IO_ID io_id;



/*
 *      Variables for ACMS$INIT_EXCHANGE_IO
 */
struct item init_exch_io_list[2] = 
    { ACMS$S_CONNECT_ID, ACMS$K_CONNECT_ID, &connect_id, 0, 
      0, 0 };   /* zero the last longword (2 words) for list termination */
int io_enable_flags;


 
/*
 *      Variable declarations for ACMS$GET_PROCEDURE_INFO
 */
int io_method;

char task_name_string[39], appl_name_string[255];
$DESCRIPTOR(task_name_desc,task_name_string);
$DESCRIPTOR (appl_name_desc,appl_name_string);
$DESCRIPTOR (appl_prompt_desc,"Application name: ");
$DESCRIPTOR (task_prompt_desc,"Task name: ");



/*
 *     Item list structure to be used in ACMS$GET_PROCEDURE_INFO
 *
 * There are 2 elements specified in this item list:
 *  1) 4 bytes of data for ACMS$K_PROC_IO_METHOD, to be
 *     returned in variable io_method.
 *  2) 8 bytes data for ACMS$K_PROC_PROCEDURE_ID, to be
 *     returned in variable procedure_id.
 *  (This code omits the return length variable address, which
 *   could be specified to receive the actual length of data
 *   returned for each item.)
 *  Other possible items include:
 *   - ACMS$K_PROC_WORKSPACE_COUNT to receive count of TASK ARGUMENTS
 *        which the task could accept from the agent program
 *   - ACMS$K_PROC_WAIT_DELAY_ACTION to receive the wait/delay
 *        action specified in the task definition
 */



struct item task_info_list[3] = 
    { 4, ACMS$K_PROC_IO_METHOD, &io_method, 0,
      ACMS$S_PROCEDURE_ID, ACMS$K_PROC_PROCEDURE_ID, &procedure_id, 0,
      0, 0 };   /* zero the last longword (2 words) for list termination */


/*
 * Variable declarations for ACMS$START_CALL
 */

struct ACMS$CALL_ID call_id;
int argument_list[4];
char selection_string[255], status_string[80];
$DESCRIPTOR(selection_string_desc,selection_string);
$DESCRIPTOR(status_string_desc,status_string);



/*
 * Variable declarations for ACMS$WAIT_FOR_STREAM_IO
 */
globalvalue int ACMS$_SENDER_DISCONN;
int sender_disconn;
short int processing_io;
char *input_string_addr, *output_string_addr;    



/*
 *      Miscellaneous variables
 */
int status;
short int i, all_spaces;

/**************************************************************/



/*
 * Sign in to ACMS, no terminal IO, only stream IO
 */
    status = ACMS$SIGN_IN (&submitter_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


/*
 *      Set up the agent program to do only stream I/O in exchange steps.  
 */ 
    io_enable_flags = ACMS$M_IO_DISABLE_TDMS + ACMS$M_IO_DISABLE_DECFORMS;
    
    status = ACMS$INIT_EXCHANGE_IO ( &submitter_id,
                                     &exchange_io_id,
                                     &io_enable_flags,
                                     &init_exch_io_list );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


 
/*
 * Get the procedure ID for the task
 *  - prompt the user for the task name
 *  - prompt the user for application logical name
 *    (These strings should be entered in upper case
 *     or converted to upper case.)
 *  - then call ACMS$GET_PROCEDURE_INFO
 */
    status = LIB$GET_INPUT ( &task_name_desc, &task_prompt_desc );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);



    status = LIB$GET_INPUT ( &appl_name_desc, &appl_prompt_desc );
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

    status = ACMS$GET_PROCEDURE_INFO (&submitter_id,
           &task_name_desc,
           &appl_name_desc,
           task_info_list);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);



/*
 * Set up the argument list for the task
 */
    argument_list[0] = 3;
    argument_list[1] = &selection_string_desc;
    argument_list[2] = &status_string_desc;
    argument_list[3] = &exchange_io_id;


/*
 *  Now start the task.  This agent program does not supply TASK 
 *  ARGUMENTS. If TASK ARGUMENTS were used, they would require
 *  the task_info_list structure to be expanded to include the item
 *  ACMS$K_PROC_WORKSPACE_COUNT, which returns the number of TASK
 *  ARGUMENTS (if any) declared in the task definition.  This agent
 *  program would then build descriptors pointing to C variables
 *  corresponding to the number of arguments to be supplied.  Then
 *  argument_list[4] would be supplied the address of the
 *  first argument descriptor, argument_list[5] the address of the
 *  second argument descriptor.  argument_list[0] would be amended to
 *  reflect the total argument count = 3 + NUMBER_OF_TASK_ARGUMENTS
 *  supplied to the task by the agent program.
 */



    status = ACMS$START_CALL (&submitter_id,
             &procedure_id,
             &call_id,
             argument_list);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

/*
 *  This agent program handles only tasks that do no exchange I/O and 
 *  tasks that do stream I/O.  If it is a NO I/O task, skip the stream
 *  processing.
 */
    if (io_method == ACMS$K_IO_NONE)
        processing_io = FALSE; 
    else
        {
        processing_io = TRUE;
        sender_disconn = ACMS$_SENDER_DISCONN;
        }


        
/*
 *      Process the stream task with the following algorithm:
 *          
 *          - wait for notification to begin the I/O (WAIT_FOR_STREAM_IO
 *              completes)
 *          - do the I/O
 *          - reply that the I/O is finished (REPLY_TO_STREAM_IO)
 *          - wait for more notification - if there is no more I/O. the
 *              sender will disconnect and we will be finished
 */



    while (processing_io)
    {
     status = ACMS$WAIT_FOR_STREAM_IO (&connect_id,
          &output_string_addr,
          &input_string_addr,
          &io_id);
     if ((status & 1) != SUCCESS)
     {
            processing_io = FALSE;
            if (status != sender_disconn)
                LIB$SIGNAL (status);
     }
     else 


        {
            /*
              *      We have been notified to do the I/O - do it
             */
            if ((output_string_addr != NULL) && (input_string_addr == NULL))
            {
                status = LIB$PUT_OUTPUT (output_string_addr);


     if ((status & 1) != SUCCESS) LIB$SIGNAL (status);
            }

            if (input_string_addr != NULL)
            {
                if (output_string_addr == NULL)
    status = LIB$GET_INPUT (input_string_addr);
   else
    status = LIB$GET_INPUT (input_string_addr,
       output_string_addr);
   if ((status & 1) != SUCCESS) LIB$SIGNAL (status);
            }



            /*
             *      Tell the application that we are done with 
             *      the I/O
             */
            status = ACMS$REPLY_TO_STREAM_IO (&connect_id,
               &io_id);
            if ((status & 1) != SUCCESS) LIB$SIGNAL (status);
        
        }   /* end of successful WAIT_FOR_STREAM_IO */

    } /*  end while loop  */


/*
 * Wait for the task to complete
 */
    status = ACMS$WAIT_FOR_CALL_END (&submitter_id, &call_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);

/*  
 *      Terminate the exchange I/O for the submitter
 */
    status = ACMS$TERM_EXCHANGE_IO (&exchange_io_id);


    
/*
 * Sign the submitter out
 */                 
    status = ACMS$SIGN_OUT (&submitter_id);
    if ((status & 1) != SUCCESS) LIB$SIGNAL (status);


    
/*
 * Display the final status
 */
    all_spaces = TRUE;
    for (i = 0; (i < 80) && (status_string[i] != NULL) && all_spaces; i++)
     if (status_string[i] != ' ')
      all_spaces = FALSE;

    if (!all_spaces)
     LIB$PUT_OUTPUT (status_string);
}

MODULE bliss_agent (IDENT = 'V2.1-000',
         MAIN = agent_main,
         ADDRESSING_MODE (EXTERNAL=GENERAL,
     NONEXTERNAL=LONG_RELATIVE)) =
BEGIN



!
! External References
!
EXTERNAL ROUTINE
    LIB$SYS_TRNLOG,
    LIB$GET_EF,
    LIB$FREE_EF,
    LIB$GET_INPUT,
    LIB$PUT_OUTPUT,
    STR$UPCASE;
EXTERNAL LITERAL
    ACMS$_SENDER_DISCONN,
    ACMS$_NORMAL;



!
! Library Files
!
LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'SYS$LIBRARY:ACMSBLI';



ROUTINE agent_main =
!
!   Agent's main routine
!
BEGIN
    
    LOCAL
 status,
 sub_id:              ACMS$SUBMITTER_ID,


!
! Variable declarations for ACMS$GET_PROCEDURE_INFO_A
!
 task_name:           BLOCK [ DSC$K_D_BLN, BYTE],
 application_name:    BLOCK [ DSC$K_D_BLN, BYTE],
 io_method,
     task_info_list:      $ITMLST_DECL ( ITEMS = 2 ),
     have_task_info,


!
! Variable declarations for ACMS$START_CALL_A
!
 proc_id:              CMS$PROCEDURE_ID,
 task_id:                ACMS$CALL_ID,
     argument_list:        VECTOR [4,LONG],
     selection_string:   BLOCK [ DSC$K_D_BLN, BYTE],
     status_string:      BLOCK [ DSC$K_D_BLN, BYTE],
     terminal_name:  BLOCK [ DSC$K_D_BLN, BYTE],


!
! Variable declarations for Stream Services
!
        stream_id:           ACMS$STREAM_ID,
        connect_id:          ACMS$CONNECT_ID,
 io_id:       ACMS$IO_ID,
 output_string_addr:  REF BLOCK [4, BYTE],
 input_string_addr:   REF BLOCK [4, BYTE],
     processing_io,


!
! Variable declarations for asychronous service arguments
!
     comp_status_block:   VECTOR [ 2, LONG ],
     event_flag;

    LITERAL
        TRUE = 1 EQL 1,
        FALSE = 0 EQL 1;

    BIND
     comp_status = comp_status_block [ 0 ];


!
! Initialize dynamic string descriptors
!
    $INIT_DYNDESC ( task_name );
    $INIT_DYNDESC ( application_name );
    $INIT_DYNDESC ( selection_string );
    $INIT_DYNDESC ( status_string );
    $INIT_DYNDESC ( terminal_name );

    status = LIB$GET_EF ( event_flag );
    IF NOT .status THEN SIGNAL ( .status );


    status = LIB$SYS_TRNLOG ( %ASCID'TT', 0, terminal_name );
    IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );
!
!   Sign in to ACMS
!
    status = $ACMS$SIGN_IN_A (SUBMITTER_ID = sub_id,
             DEVICE = terminal_name,
             COMP_STATUS = comp_status,
             EFN = event_flag );
    IF NOT .status 
    THEN 
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
    END;


!
! Set up item list
!
    $ITMLST_INIT ( ITMLST = task_info_list,
         ( ITMCOD = ACMS$K_PROC_PROCEDURE_ID,
           BUFSIZ = ACMS$S_PROCEDURE_ID,
           BUFADR = proc_id ),

         ( ITMCOD = ACMS$K_PROC_IO_METHOD,
           BUFSIZ = %UPVAL,
           BUFADR = io_method ) );



    have_task_info = FALSE;
!
! Loop until we get a good application/task name
!

    DO
        BEGIN
    !
    ! Ask for application name and task name.
    ! Convert names to all caps for comparisons in ACMS.
    !
 status = LIB$GET_INPUT (application_name, %ASCID 'Application name: ');
 IF NOT .status THEN SIGNAL (.status);

        status = STR$UPCASE (application_name, application_name);
        IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );



 status = LIB$GET_INPUT (task_name, %ASCID 'Task name: ');
 IF NOT .status THEN SIGNAL (.status);

        status = STR$UPCASE (task_name, task_name);
        IF .status NEQ SS$_NORMAL THEN SIGNAL ( .status );



        !
        ! Ask ACMS if task is known and get its ID
        !
        status = $ACMS$GET_PROCEDURE_INFO_A ( SUBMITTER_ID = sub_id,
                                              PROCEDURE = task_name,
                                              PACKAGE = application_name,
                                              ITEM_LIST = task_info_list,
                  EFN = event_flag,
                  COMP_STATUS = comp_status );
     IF NOT .status
     THEN
         SIGNAL ( .status )


     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF .comp_status EQL ACMS$_NORMAL
         THEN
      have_task_info = TRUE
         ELSE
      SIGNAL ( .comp_status );
         END;
     END
    UNTIL .have_task_info;


!
! Get the selection string
!
    status = LIB$GET_INPUT (selection_string, %ASCID 'Selection string: ');
    IF NOT .status THEN SIGNAL (.status);


!
! If the I/O method is stream, then setup the stream
!
    IF .io_method EQL ACMS$K_IO_STREAM
    THEN
 BEGIN



 status = $ACMS$CREATE_STREAM_A (MODE = %REF(ACMS$K_STRM_BIDIRECTIONAL),
            STREAM_ID = stream_id,
             COMP_STATUS = comp_status,
             EFN = event_flag );
     IF NOT .status 
     THEN 
         SIGNAL (.status)
     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;


 status = $ACMS$CONNECT_STREAM_A (STREAM_ID = stream_id,
             CONNECT_ID = connect_id,
           MODE = %REF(ACMS$K_STRM_PASSIVE),
              COMP_STATUS = comp_status,
                EFN = event_flag );
     IF NOT .status 
     THEN 
         SIGNAL (.status)
     ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;

 END;


!
! Set up argument list for task
!
    argument_list [1] = selection_string;
    argument_list [2] = status_string;

    SELECTONE .io_method OF
 SET
 [ACMS$K_IO_NONE]:
     argument_list [0] = 2;
 [ACMS$K_IO_TERMINAL,
  ACMS$K_IO_REQUEST]:
     BEGIN
     argument_list [0] = 3;
     argument_list [3] = terminal_name;
     END;
 [ACMS$K_IO_STREAM]:
     BEGIN
     argument_list [0] = 3;
     argument_list [3] = stream_id;
     END;
 [OTHERWISE]:
     SIGNAL (SS$_ABORT);
 TES;


!
! Now start the task
!
    status = $ACMS$START_CALL_A (SUBMITTER_ID = sub_id,
          PROCEDURE_ID = proc_id,
                               ARGUMENTS = argument_list,
                               CALL_ID = task_id,
              COMP_STATUS = comp_status,
              EFN = event_flag );



    IF NOT .status 
    THEN 
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;


!
! If the task I/O method is stream, process the stream I/O in the following 
! loop
    IF .io_method EQL ACMS$K_IO_STREAM 
    THEN 
     BEGIN
     processing_io = TRUE;
     WHILE .processing_io DO
    
            BEGIN


     status = $ACMS$WAIT_FOR_STREAM_IO_A
              ( CONNECT_ID = connect_id,
                                 OUTPUT_OBJECT = output_string_addr,
                                 INPUT_OBJECT = input_string_addr,
     IO_ID = io_id,
                COMP_STATUS = comp_status,
               EFN = event_flag );
     IF NOT .status 
         THEN 
          SIGNAL (.status)
         ELSE
             BEGIN
             $WAITFR ( EFN = .event_flag );
             IF .comp_status EQL ACMS$_SENDER_DISCONN 
         THEN
             processing_io = FALSE
             THEN
            SIGNAL ( .comp_status )
        ELSE
            BEGIN


        !
        ! See what kind of EXCHANGE was in the task defintion
        !
         IF .output_string_addr NEQ 0 AND .input_string_addr EQL 0
         THEN


!
! Exchange step was a WRITE
!
        BEGIN
    status = LIB$PUT_OUTPUT (.output_string_addr);
    IF NOT .status THEN SIGNAL (.status);
    END;


    IF .input_string_addr NEQ 0
    THEN
    IF .output_string_addr EQL 0 
    THEN
        !
        ! Exchange step was a READ
        !
        BEGIN
        status = LIB$GET_INPUT (.input_string_addr);
        IF NOT .status THEN SIGNAL (.status);
        END



    ELSE
        !
        ! Exchange step was a READ WITH PROMPT
        !
        BEGIN
        status = LIB$GET_INPUT (.input_string_addr,
              .output_string_addr );
        IF NOT .status THEN SIGNAL (.status);
        END;


           !
           ! Reply to the I/O request
           !
              status = $ACMS$REPLY_TO_STREAM_IO_A 
              (CONNECT_ID = connect_id,
           IO_ID = io_id,
                         EFN = event_flag );
           IF NOT .status 
           THEN 
               SIGNAL (.status)
            ELSE
            BEGIN
            $WAITFR ( EFN = .event_flag );
            IF NOT .comp_status THEN SIGNAL ( .comp_status );
            END;


           END;        ! End of successful wait_for_stream_io completion

              END;        ! End of successful wait_for_stream_io starting
     
             END;  ! End of stream processing loop

    END; ! End of stream task


!
!   Wait for task to complete
!
    status = $ACMS$WAIT_FOR_CALL_END_A (SUBMITTER_ID = sub_id,
                                        CALL_ID = task_id,
                       COMP_STATUS = comp_status,
                       EFN = event_flag );
    IF NOT .status 
    THEN 
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;


!
! If a stream was used, disconnect it and delete it
!
    IF .io_method EQL ACMS$K_IO_STREAM 
    THEN
 BEGIN


 status = $ACMS$DISCONNECT_STREAM_A (CONNECT_ID = connect_id,
                           COMP_STATUS = comp_status,
                   EFN = event_flag );
        IF NOT .status 
        THEN 
         SIGNAL (.status)
        ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;



 status = $ACMS$DELETE_STREAM_A (STREAM_ID = stream_id,
         COMP_STATUS = comp_status,
         EFN = event_flag );
        IF NOT .status 
        THEN 
         SIGNAL (.status)
        ELSE
         BEGIN
         $WAITFR ( EFN = .event_flag );
         IF NOT .comp_status THEN SIGNAL ( .comp_status );
         END;

 END;


    status = $ACMS$SIGN_OUT_A ( SUBMITTER_ID = sub_id,
        COMP_STATUS = comp_status,
        EFN = event_flag );
    IF NOT .status 
    THEN 
     SIGNAL (.status)
    ELSE
     BEGIN
     $WAITFR ( EFN = .event_flag );
     IF NOT .comp_status THEN SIGNAL ( .comp_status );
     END;
!
! Display final status
!
    IF CH$NEQ (.status_string [DSC$W_LENGTH], .status_string [DSC$A_POINTER],
            1, UPLIT (' '), %C' ')
    THEN
 LIB$PUT_OUTPUT (status_string);

    status = LIB$FREE_EF ( event_flag );
    IF NOT .status THEN SIGNAL ( .status );

    RETURN SS$_NORMAL;

    END;

END ELUDOM

[INHERIT('SYS$LIBRARY:STARLET','SYS$LIBRARY:ACMSPAS')]
PROGRAM campus_transactions(INPUT,OUTPUT);

{ Program to gather transactions from various nodes.
  After all transactions are complete, generate a report }
  
CONST
  pstring_length = 32;


  
TYPE

  uword = [WORD] 0..65535;                    { Unsigned word }
  ubyte = [BYTE] 0..255;                      { Unsigned byte }

  pstring = PACKED ARRAY [1..pstring_length] OF CHAR;


  { descriptor datatype }
  desc_type = [BYTE(8)]
              RECORD
              length : [POS(0)] uword;
              dtype  : [POS(16)] ubyte;
              class  : [POS(24)] ubyte;
              ptr    : [POS(32),UNSAFE] INTEGER;
              END;
  
  quad = PACKED ARRAY [0..1] OF [UNSAFE] INTEGER;


  
  nodes = (eku,nku,wku,ul,cmu);
 
  arg_list = PACKED ARRAY [0..3] OF [UNSAFE] INTEGER;
    
VAR
  submitter_id : ACMS$SUBMITTER_ID;
  exchange_io_id: ACMS$EXCHANGE_IO_ID;
  status       : [unsafe] INTEGER;
  status_block : ARRAY[eku..cmu] OF quad;
  selection_string : ARRAY[eku..cmu] of desc_type;
  padded_application_name : pstring;
  padded_task_name : pstring;
  status_string    : ARRAY[eku..cmu] of desc_type;
  argument_list: ARRAY[eku..cmu] OF arg_list;
  i : nodes;


  
{ Run-time library output routine }
[external] FUNCTION lib$put_output(%REF desc :desc_type):integer;extern;


{ Run-time library routine to signal errors }
[ASYNCHRONOUS,EXTERNAL(LIB$SIGNAL)]
PROCEDURE signal(%IMMED condition : INTEGER;
                 %IMMED fao_parms : [UNSAFE,LIST] INTEGER);EXTERN;

FUNCTION init_dyndesc:desc_type;
{ Function to initialize dynamic string desciptors }
VAR
 temp : desc_type;


 
BEGIN
   WITH temp DO
   BEGIN
     length := 0;
     class := dsc$k_class_d;
     dtype := dsc$k_dtype_t;
     ptr := 0;
   END;
   init_dyndesc := temp;
END ; { function init_dyndesc}



PROCEDURE call_task( SUBMITTER_ID :ACMS$SUBMITTER_ID;
                     APPLICATION_NAME : pstring;
                     TASK_NAME : pstring;
                     VAR argument_list: arg_list;
                     VAR STATUS_BLOCK : quad);



{ Procedure to perform an $acms$_call_a for the requested task }

TYPE
  uword = [WORD] 0..65535;


  item_type = [BYTE (12)]
              RECORD
                buffer_length : [POS (0)] uword;
                item_code     : [POS (16)] uword;
                buffer_address: [POS (32),UNSAFE] INTEGER;
                ret_length_adr: [POS (64),UNSAFE] INTEGER;
              END ; {item_type}



   list_type = [BYTE (16)]
               RECORD
                  list : [POS (0) ] item_type;
                  term : [POS (96)] INTEGER;
               END; {list_type}
 VAR
   status    : [UNSAFE] INTEGER;
   proc_list : list_type;
   procedure_id : ACMS$PROCEDURE_ID;
   ACMS$EFN  : [EXTERNAL] ubyte;


 
 BEGIN { call_task}
 
   { Build get procedure info list }
   WITH proc_list.list DO
     BEGIN
       buffer_length := acms$s_procedure_id;
       item_code := acms$k_proc_procedure_id;
       buffer_address := iaddress(procedure_id);
       ret_length_adr := 0;
     END ; {with proc_list}
   proc_list.term := 0;


   { Get procedure_id via acms$get_procedure_info }
   status := $ACMS$GET_PROCEDURE_INFO(SUBMITTER_ID := submitter_id,
                                     PACKAGE := application_name,
                                     procedure_ := task_name,
                                     item_list := proc_list);
   IF not odd(status) THEN SIGNAL(status);


      
   status := $ACMS$CALL_A(SUBMITTER_ID := submitter_id,
                          PROCEDURE_ID := procedure_id,
                          ARGUMENTS := argument_list,
                          EFN := ACMS$EFN,
                          COMP_STATUS := status_block);
    IF not odd(status) THEN SIGNAL(status);

 END ; { procedure call_task }
   



BEGIN { main }

  { Init argument list for calls }
  FOR i := eku TO cmu DO
  BEGIN
    status_string[i] := init_dyndesc;
    selection_string[i] := init_dyndesc;
    
    argument_list[i][0] := 3; {Number of argument in list}
    argument_list[i][1] := IADDRESS(selection_string[i]);
    argument_list[i][2] := IADDRESS(status_string[i]);
    argument_list[i][3] := IADDRESS(exchange_io_id);
  END;{for}


  { sign into acms }
  
  status := $ACMS$SIGN_IN(SUBMITTER_ID := submitter_id);
  IF not odd(status) THEN SIGNAL(status);

  status := $ACMS$INIT_EXCHANGE_IO(SUBMITTER_ID := submitter_id,
                                   EXCHANGE_IO_ID := exchange_io_id );
  IF not odd(status) THEN SIGNAL(status);
    
  padded_task_name := PAD ( 'ENROLLMENT_TRANSACTIONS', ' ', pstring_length );
    
  padded_application_name := PAD ( 'EKU::TRANSACTIONS', ' ', pstring_length );


  
  call_task(SUBMITTER_ID := submitter_id,
            application_name := padded_application_name,
            task_name := padded_task_name,
            argument_list := argument_list[eku],
            status_block := status_block[eku]);

  padded_application_name := PAD ( 'NKU::TRANSACTIONS', ' ', pstring_length );
  
  call_task(SUBMITTER_ID := submitter_id,
            application_name := padded_application_name,
            task_name := padded_task_name,
            argument_list := argument_list[nku],
            status_block := status_block[nku]);

  padded_application_name := PAD ( 'WKU::TRANSACTIONS', ' ', pstring_length );


  
  call_task(SUBMITTER_ID := submitter_id,
            application_name := padded_application_name,
            task_name := padded_task_name,
            argument_list := argument_list[wku],
            status_block := status_block[wku]);


  padded_application_name := PAD ( 'UL::TRANSACTIONS', ' ', pstring_length );
  
  call_task(SUBMITTER_ID := submitter_id,
            application_name := padded_application_name,
            task_name := padded_task_name,
            argument_list := argument_list[ul],
            status_block := status_block[ul]);



{ Now wait for all the procedures to complete }

FOR i := eku to ul DO
   BEGIN
     status := $ACMS$WAIT(COMP_STATUS := status_block[i]); 
     { Wait for routine to complete}
     IF not odd(status) THEN SIGNAL(status);

     IF not odd (status_block[i][0]) 
     THEN 
        signal(status_block[i][0])
     ELSE
        { Tell user status result of his request }
        LIB$PUT_OUTPUT(status_string[i]);
   END;



{ Call report generating routine }

 padded_task_name := PAD ( 'GENERATE_REPORTS',' ', pstring_length );
    
 padded_application_name := PAD ( 'CMU::REPORTS', ' ', pstring_length );
  
 call_task(submitter_id := submitter_id,
            application_name := padded_application_name,
            task_name := padded_task_name,
            argument_list :=argument_list[cmu],
            status_block := status_block[cmu]);




 status := $ACMS$WAIT(COMP_STATUS := status_block[cmu]);
 IF not odd(status) THEN SIGNAL(status);

 IF not odd (status_block[cmu][0])
 THEN
    signal(status_block[cmu][0])
 ELSE
    { Tell user status result of his request }
    LIB$PUT_OUTPUT( status_string[cmu]);

status := $ACMS$TERM_EXCHANGE_IO(EXCHANGE_IO_ID := exchange_io_id);
IF not odd(status) THEN SIGNAL(status);


status := $ACMS$SIGN_OUT(SUBMITTER_ID := submitter_id);
IF not odd(status) THEN SIGNAL(status);

END. {main}