home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rxhll.zip
/
CPIC.REX
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-01-21
|
29KB
|
690 lines
/* #include <cpic.rex> */
CMINIT: procedure expose cpic.
/**
*** CMINIT with state checking and error handling
**/
parse arg cpic.sideinfo
cpic.CurrentVerb = 'CMINIT'
address CPICOMM 'CMINIT cpic.Id cpic.sideinfo code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = cpic.CM_INITIALIZE_STATE
cpic.LastVerb = 'CMINIT'
return
CMALLC: procedure expose cpic.
/**
*** Allocate the conversation
**/
cpic.CurrentVerb = 'CMALLC'
address CPICOMM 'CMALLC cpic.Id code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
when code = cpic.CM_UNSUCCESSFUL then call CpicError code,1
when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
when code = cpic.CM_ALLOCATE_FAILURE_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
otherwise
call CpicError code,1
end /* select */
else
cpic.State = cpic.CM_SEND_STATE
cpic.LastVerb = 'CMALLC'
return
CMPTR: procedure expose cpic.
/**
*** Allocate the conversation
**/
cpic.CurrentVerb = 'CMPTR'
address CPICOMM 'CMPTR cpic.Id code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = cpic.CM_RECEIVE_STATE
cpic.LastVerb = 'CMPTR'
return
CMACCP: procedure expose cpic.
/**
*** Accept the conversation
**/
cpic.CurrentVerb = 'CMACCP'
address CPICOMM 'CMACCP cpic.Id code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = cpic.CM_RECEIVE_STATE
cpic.LastVerb = 'CMACCP'
return
CMDEAL: procedure expose cpic.
/**
*** Deallocate the conversation
**/
cpic.CurrentVerb = 'CMDEAL'
address CPICOMM 'CMDEAL cpic.Id code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
when code = cpic.CM_PROGRAM_ERROR_PURGING then
do
call CpicError code,0
cpic.State = cpic.CM_RECEIVE_STATE
end
when code = cpic.CM_SVC_ERROR_PURGING then
do
call CpicError code,0
cpic.State = cpic.CM_RECEIVE_STATE
end
otherwise
call CpicError code,1
end /* select */
else
cpic.State = cpic.CM_RESET_STATE
cpic.LastVerb = 'CMDEAL'
return
CMSEND: procedure expose cpic.
/**
*** Send data to the partner
**/
parse arg Buffer
cpic.CurrentVerb = 'CMSEND'
BufferLen = length(Buffer)
address CPICOMM 'CMSEND cpic.Id Buffer BufferLen cpic.RTSreceived code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
when code = cpic.CM_UNSUCCESSFUL then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_BO then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_SVC then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_SVC_BO then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_TIMER_BO then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_NORETRY then call CpicError code,1
when code = cpic.CM_RESOURCE_FAIL_NO_RETRY_BO then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_RETRY then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_RETRY_BO then call CpicError code,1
when code = cpic.CM_TAKE_BACKOUT then call CpicError code,1
when code = cpic.CM_PROGRAM_ERROR_PURGING then call CpicError code,1
when code = cpic.CM_SVC_ERROR_PURGING then call CpicError code,1
when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
when code = cpic.CM_ALLOCATE_FAILURE_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
otherwise
call CpicError code,1
end /* select */
else
do
/* Check the send type for appropriate state change handling */
select
when cpic.SendType = cpic.CM_SEND_AND_PREP_TO_RECEIVE then
select
when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_SYNC_LEVEL then cpic.State = cpic.CM_DEFER_RECEIVE_STATE
when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_FLUSH then cpic.State = cpic.CM_RECEIVE_STATE
when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_CONFIRM then cpic.State = cpic.CM_RECEIVE_STATE
otherwise
cpic.State = cpic.CM_RECEIVE_STATE
end /* select */
when cpic.SendType = cpic.CM_SEND_AND_DEALLOCATE then
select
when cpic.DeallocateType = cpic.CM_DEALLOCATE_SYNC_LEVEL then cpic.State = cpic.CM_DEFER_DEALLOCATE_STATE
when cpic.DeallocateType = cpic.CM_DEALLOCATE_FLUSH then cpic.State = cpic.CM_RESET_STATE
when cpic.DeallocateType = cpic.CM_DEALLOCATE_CONFIRM then cpic.State = cpic.CM_RESET_STATE
when cpic.DeallocateType = cpic.CM_DEALLOCATE_ABEND then cpic.State = cpic.CM_RESET_STATE
otherwise
cpic.State = cpic.CM_RESET_STATE
end /* select */
otherwise
cpic.State = cpic.CM_SEND_STATE
end /* select */
end /* do */
cpic.LastVerb = 'CMSEND'
return
CMRCV: procedure expose cpic.
/**
*** Send data to the partner
**/
cpic.CurrentVerb = 'CMRCV'
RequestedLength = 32767
address CPICOMM 'CMRCV cpic.Id cpic.ReceiveBuffer RequestedLength',
'DataReceived ReceivedLength',
'StatusReceived RTSreceived code'
if (CpicCheckCode(rc, code)) & (code <> cpic.CM_DEALLOCATED_NORMAL) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
when code = cpic.CM_PARAMETER_ERROR then call CpicError code,1
when code = cpic.CM_UNSUCCESSFUL then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_BO then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_SVC then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_SVC_BO then call CpicError code,1
when code = cpic.CM_DEALLOCATED_ABEND_TIMER_BO then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_NORETRY then call CpicError code,1
when code = cpic.CM_RESOURCE_FAIL_NO_RETRY_BO then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_RETRY then call CpicError code,1
when code = cpic.CM_RESOURCE_FAILURE_RETRY_BO then call CpicError code,1
when code = cpic.CM_TAKE_BACKOUT then call CpicError code,1
when code = cpic.CM_PROGRAM_ERROR_PURGING then call CpicError code,1
when code = cpic.CM_SVC_ERROR_PURGING then call CpicError code,1
when code = cpic.CM_PROGRAM_ERROR_NO_TRUNC then call CpicError code,1
when code = cpic.CM_SVC_ERROR_NO_TRUNC then call CpicError code,1
when code = cpic.CM_PROGRAM_ERROR_TRUNC then call CpicError code,1
when code = cpic.CM_SVC_ERROR_TRUNC then call CpicError code,1
when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
when code = cpic.CM_ALLOCATE_FAILURE_RETRY then
do
call CpicError code,0
cpic.State = cpic.CM_RESET_STATE
end
otherwise
call CpicError code,1
end /* select */
else
do
/* Make sure the length of the buffer is OK. There was a note in the */
/* SAA CPI Communications Reference to do this for REXX code. */
if ReceivedLength <> 'RECEIVEDLENGTH' then
cpic.ReceiveBuffer = left(cpic.ReceiveBuffer, ReceivedLength)
/* Check data status indicators */
select
when DataReceived = cpic.CM_NO_DATA_RECEIVED then
select
when StatusReceived = cpic.CM_SEND_RECEIVED then cpic.State = cpic.CM_SEND_STATE
when StatusReceived = cpic.CM_NO_STATUS_RECEIVED then cpic.State = cpic.CM_RECEIVE_STATE
when StatusReceived = cpic.CM_CONFIRM_RECEIVED then cpic.State = cpic.CM_CONFIRM_STATE
when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED then cpic.State = cpic.CM_CONFIRM_SEND_STATE
when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT then cpic.State = cpic.CM_SYNC_POINT_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_SEND then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
otherwise nop
end
when DataReceived = cpic.CM_DATA_RECEIVED then
select
when StatusReceived = cpic.CM_SEND_RECEIVED then cpic.State = cpic.CM_SEND_PENDING_STATE
when StatusReceived = cpic.CM_NO_STATUS_RECEIVED then cpic.State = cpic.CM_RECEIVE_STATE
when StatusReceived = cpic.CM_CONFIRM_RECEIVED then cpic.State = cpic.CM_CONFIRM_STATE
when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED then cpic.State = cpic.CM_CONFIRM_SEND_STATE
when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT then cpic.State = cpic.CM_SYNC_POINT_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_SEND then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
otherwise nop
end
when DataReceived = cpic.CM_COMPLETE_DATA_RECEIVED then
select
when StatusReceived = cpic.CM_SEND_RECEIVED then cpic.State = cpic.CM_SEND_PENDING_STATE
when StatusReceived = cpic.CM_NO_STATUS_RECEIVED then cpic.State = cpic.CM_RECEIVE_STATE
when StatusReceived = cpic.CM_CONFIRM_RECEIVED then cpic.State = cpic.CM_CONFIRM_STATE
when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED then cpic.State = cpic.CM_CONFIRM_SEND_STATE
when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT then cpic.State = cpic.CM_SYNC_POINT_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_SEND then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
otherwise nop
end
when DataReceived = cpic.CM_INCOMPLETE_DATA_RECEIVED then
do
select
when StatusReceived = cpic.CM_SEND_RECEIVED then cpic.State = cpic.CM_SEND_STATE
when StatusReceived = cpic.CM_NO_STATUS_RECEIVED then cpic.State = cpic.CM_RECEIVE_STATE
when StatusReceived = cpic.CM_CONFIRM_RECEIVED then cpic.State = cpic.CM_CONFIRM_STATE
when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED then cpic.State = cpic.CM_CONFIRM_SEND_STATE
when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT then cpic.State = cpic.CM_SYNC_POINT_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_SEND then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
otherwise nop
end
/* I still need to put code here to loop on this condition */
end
otherwise
nop
end /* CM_OK */
cpic.LastVerb = 'CMRCV'
return
CMFLUS: procedure expose cpic.
/**
***
**/
cpic.CurrentVerb = 'CMFLUS'
address CPICOMM 'CMFLUS cpic.Id code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_STATE_CHECK then call CpicError code,0
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
do
if cpic.State = cpic.CM_DEFER_RECEIVE_STATE then
cpic.State = cpic.CM_RECEIVE_STATE
else
cpic.State = cpic.CM_SEND_STATE
end
cpic.LastVerb = 'CMFLUS'
return
CpicError: procedure expose cpic.
/**
*** This is called on a CPI-C error
**/
parse arg code, fatal
select
when cpic.CM_ALLOCATE_FAILURE_NO_RETRY = code then codeText = "CM_ALLOCATE_FAILURE_NO_RETRY"
when cpic.CM_ALLOCATE_FAILURE_RETRY = code then codeText = "CM_ALLOCATE_FAILURE_RETRY"
when cpic.CM_CONVERSATION_TYPE_MISMATCH = code then codeText = "CM_CONVERSATION_TYPE_MISMATCH"
when cpic.CM_PIP_NOT_SPECIFIED_CORRECTLY = code then codeText = "CM_PIP_NOT_SPECIFIED_CORRECTLY"
when cpic.CM_SECURITY_NOT_VALID = code then codeText = "CM_SECURITY_NOT_VALID"
when cpic.CM_SYNC_LVL_NOT_SUPPORTED_LU = code then codeText = "CM_SYNC_LVL_NOT_SUPPORTED_LU"
when cpic.CM_SYNC_LVL_NOT_SUPPORTED_PGM = code then codeText = "CM_SYNC_LVL_NOT_SUPPORTED_PGM"
when cpic.CM_TPN_NOT_RECOGNIZED = code then codeText = "CM_TPN_NOT_RECOGNIZED"
when cpic.CM_TP_NOT_AVAILABLE_NO_RETRY = code then codeText = "CM_TP_NOT_AVAILABLE_NO_RETRY"
when cpic.CM_TP_NOT_AVAILABLE_RETRY = code then codeText = "CM_TP_NOT_AVAILABLE_RETRY"
when cpic.CM_DEALLOCATED_ABEND = code then codeText = "CM_DEALLOCATED_ABEND"
when cpic.CM_DEALLOCATED_NORMAL = code then codeText = "CM_DEALLOCATED_NORMAL"
when cpic.CM_PARAMETER_ERROR = code then codeText = "CM_PARAMETER_ERROR"
when cpic.CM_PRODUCT_SPECIFIC_ERROR = code then codeText = "CM_PRODUCT_SPECIFIC_ERROR"
when cpic.CM_PROGRAM_ERROR_NO_TRUNC = code then codeText = "CM_PROGRAM_ERROR_NO_TRUNC"
when cpic.CM_PROGRAM_ERROR_PURGING = code then codeText = "CM_PROGRAM_ERROR_PURGING"
when cpic.CM_PROGRAM_ERROR_TRUNC = code then codeText = "CM_PROGRAM_ERROR_TRUNC"
when cpic.CM_PROGRAM_PARAMETER_CHECK = code then codeText = "CM_PROGRAM_PARAMETER_CHECK"
when cpic.CM_PROGRAM_STATE_CHECK = code then codeText = "CM_PROGRAM_STATE_CHECK"
when cpic.CM_RESOURCE_FAILURE_NO_RETRY = code then codeText = "CM_RESOURCE_FAILURE_NO_RETRY"
when cpic.CM_RESOURCE_FAILURE_RETRY = code then codeText = "CM_RESOURCE_FAILURE_RETRY"
when cpic.CM_UNSUCCESSFUL = code then codeText = "CM_UNSUCCESSFUL"
when cpic.CM_DEALLOCATED_ABEND_SVC = code then codeText = "CM_DEALLOCATED_ABEND_SVC"
when cpic.CM_DEALLOCATED_ABEND_TIMER = code then codeText = "CM_DEALLOCATED_ABEND_TIMER"
when cpic.CM_SVC_ERROR_NO_TRUNC = code then codeText = "CM_SVC_ERROR_NO_TRUNC"
when cpic.CM_SVC_ERROR_PURGING = code then codeText = "CM_SVC_ERROR_PURGING"
when cpic.CM_SVC_ERROR_TRUNC = code then codeText = "CM_SVC_ERROR_TRUNC"
when cpic.CM_TAKE_BACKOUT = code then codeText = "CM_TAKE_BACKOUT"
when cpic.CM_DEALLOCATED_ABEND_BO = code then codeText = "CM_DEALLOCATED_ABEND_BO"
when cpic.CM_DEALLOCATED_ABEND_SVC_BO = code then codeText = "CM_DEALLOCATED_ABEND_SVC_BO"
when cpic.CM_DEALLOCATED_ABEND_TIMER_BO = code then codeText = "CM_DEALLOCATED_ABEND_TIMER_BO"
when cpic.CM_RESOURCE_FAIL_NO_RETRY_BO = code then codeText = "CM_RESOURCE_FAIL_NO_RETRY_BO"
when cpic.CM_RESOURCE_FAILURE_RETRY_BO = code then codeText = "CM_RESOURCE_FAILURE_RETRY_BO"
when cpic.CM_DEALLOCATED_NORMAL_BO = code then codeText = "CM_DEALLOCATED_NORMAL_BO"
otherwise codeText = 'Unknown condition'
end
select
when cpic.CM_RESET_STATE = cpic.State then stateText = "CM_RESET_STATE"
when cpic.CM_INITIALIZE_STATE = cpic.State then stateText = "CM_INITIALIZE_STATE"
when cpic.CM_SEND_STATE = cpic.State then stateText = "CM_SEND_STATE"
when cpic.CM_RECEIVE_STATE = cpic.State then stateText = "CM_RECEIVE_STATE"
when cpic.CM_SEND_PENDING_STATE = cpic.State then stateText = "CM_SEND_PENDING_STATE"
when cpic.CM_CONFIRM_STATE = cpic.State then stateText = "CM_CONFIRM_STATE"
when cpic.CM_CONFIRM_SEND_STATE = cpic.State then stateText = "CM_CONFIRM_SEND_STATE"
when cpic.CM_CONFIRM_DEALLOCATE_STATE = cpic.State then stateText = "CM_CONFIRM_DEALLOCATE_STATE"
when cpic.CM_DEFER_RECEIVE_STATE = cpic.State then stateText = "CM_DEFER_RECEIVE_STATE"
when cpic.CM_DEFER_DEALLOCATE_STATE = cpic.State then stateText = "CM_DEFER_DEALLOCATE_STATE"
when cpic.CM_SYNC_POINT_STATE = cpic.State then stateText = "CM_SYNC_POINT_STATE"
when cpic.CM_SYNC_POINT_SEND_STATE = cpic.State then stateText = "CM_SYNC_POINT_SEND_STATE"
when cpic.CM_SYNC_POINT_DEALLOCATE_STATE = cpic.State then stateText = "CM_SYNC_POINT_DEALLOCATE_STATE"
otherwise codeText = 'Unknown state'
end
say "CPI-C error ["right(code,4)"]: "codeText"."
say "Last verb :" cpic.LastVerb
say "Current verb :" cpic.CurrentVerb
say "Current state :" stateText
if fatal = 1 then
exit
else
say 'Continuing...'
return
CpicSetSideInfo: procedure expose cpic.
/**
*** This will set the CPI-C side information based on the contents of
*** the information passed. It will set some values of the cpic
*** stem variable as a side effect.
***
*** If this routine is called, we want to ignore side information
*** in the cpic stem.
**/
parse arg cpic.plu, cpic.tpname, cpic.mode
if cpic.plu = '' then
return 0
if cpic.tpname = '' then
return 0
if cpic.mode = '' then
cpic.mode = '#BATCH'
cpic.sideinfo = ''
/* Manually set the PLU name */
cpic.CurrentVerb = 'CMSPLN'
address CPICOMM 'CMSPLN cpic.Id cpic.plu' length(cpic.plu) 'code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
call CpicError code,1
when code = cpic.CM_PROGRAM_STATE_CHECK then
call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = 2
cpic.LastVerb = 'CMSPLN'
/* Manually set the TP name */
cpic.CurrentVerb = 'CMSTPN'
address CPICOMM 'CMSTPN cpic.Id cpic.tpname' length(cpic.tpname) 'code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
call CpicError code,1
when code = cpic.CM_PROGRAM_STATE_CHECK then
call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = 2
cpic.LastVerb = 'CMSTPN'
/* Manually set the mode */
cpic.CurrentVerb = 'CMSMN'
address CPICOMM 'CMSMN cpic.Id cpic.mode' length(cpic.mode) 'code'
if CpicCheckCode(rc, code) then
select
when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
call CpicError code,1
when code = cpic.CM_PROGRAM_STATE_CHECK then
call CpicError code,1
otherwise
call CpicError code,1
end /* select */
else
cpic.State = 2
cpic.LastVerb = 'CMSMN'
return 1
CpicCheckCode: procedure expose cpic.
/**
*** This will check the return codes based on the current state.
**/
parse arg CpiCommCode, Code
if CpiCommCode <> 0 then
do
say "CPICOMM error ["CpiCommCode"]."
say "Last verb :" cpic.LastVerb
say "Current verb :" cpic.CurrentVerb
say "Current state :" cpic.State
exit
end
cpic.LastCode = Code
if Code = cpic.CM_OK then
return 0
return 1
CpicSetup: procedure expose cpic.
/**
*** This will initialize the information for the CPI-C calls
***
*** The 'cpic.' stem variable contains all of the information about
*** cpic that is needed for this collection of routines.
***
*** The 'cpic.State' holds the current conversation state as documented
*** in the SAA CPI Communication Reference (SC26-4399) Appendix C as
*** follows:
***
**/
cpic. = ''
cpic.State = cpic.CM_RESET_STATE
cpic.LastVerb = 'N/A'
call CpicDefineReturnCodes
/* Establish the CPI-C REXX environment */
'@cpicrexx 2>NUL >NUL'
return
CpicDefineReturnCodes: procedure expose cpic.
/**
*** This will define the mnemonics for the return codes from CPI-C.
*** Adapted from code by IBM APPC Market Enablement
**/
/* ────── conversation_state ───── */
cpic.CM_RESET_STATE = 1
cpic.CM_INITIALIZE_STATE = 2
cpic.CM_SEND_STATE = 3
cpic.CM_RECEIVE_STATE = 4
cpic.CM_SEND_PENDING_STATE = 5
cpic.CM_CONFIRM_STATE = 6
cpic.CM_CONFIRM_SEND_STATE = 7
cpic.CM_CONFIRM_DEALLOCATE_STATE = 8
cpic.CM_DEFER_RECEIVE_STATE = 9
cpic.CM_DEFER_DEALLOCATE_STATE = 10
cpic.CM_SYNC_POINT_STATE = 11
cpic.CM_SYNC_POINT_SEND_STATE = 12
cpic.CM_SYNC_POINT_DEALLOCATE_STATE = 13
/* ────── conversation_type ───── */
cpic.CM_BASIC_CONVERSATION = 0
cpic.CM_MAPPED_CONVERSATION = 1
/* ────── data_received ───── */
cpic.CM_NO_DATA_RECEIVED = 0
cpic.CM_DATA_RECEIVED = 1
cpic.CM_COMPLETE_DATA_RECEIVED = 2
cpic.CM_INCOMPLETE_DATA_RECEIVED = 3
/* ────── deallocate_type ───── */
cpic.CM_DEALLOCATE_SYNC_LEVEL = 0
cpic.CM_DEALLOCATE_FLUSH = 1
cpic.CM_DEALLOCATE_CONFIRM = 2
cpic.CM_DEALLOCATE_ABEND = 3
/* ────── error_direction ───── */
cpic.CM_RECEIVE_ERROR = 0
cpic.CM_SEND_ERROR = 1
/* ────── fill ───── */
cpic.CM_FILL_LL = 0
cpic.CM_FILL_BUFFER = 1
/* ────── prepare_to_receive_type ───── */
cpic.CM_PREP_TO_RECEIVE_SYNC_LEVEL = 0
cpic.CM_PREP_TO_RECEIVE_FLUSH = 1
cpic.CM_PREP_TO_RECEIVE_CONFIRM = 2
/* ────── receive_type ───── */
cpic.CM_RECEIVE_AND_WAIT = 0
cpic.CM_RECEIVE_IMMEDIATE = 1
/* ────── request_to_send_received ───── */
cpic.CM_REQ_TO_SEND_NOT_RECEIVED = 0
cpic.CM_REQ_TO_SEND_RECEIVED = 1
/* ────── return_code ───── */
cpic.CM_OK = 0
cpic.CM_ALLOCATE_FAILURE_NO_RETRY = 1
cpic.CM_ALLOCATE_FAILURE_RETRY = 2
cpic.CM_CONVERSATION_TYPE_MISMATCH = 3
cpic.CM_PIP_NOT_SPECIFIED_CORRECTLY = 5
cpic.CM_SECURITY_NOT_VALID = 6
cpic.CM_SYNC_LVL_NOT_SUPPORTED_LU = 7
cpic.CM_SYNC_LVL_NOT_SUPPORTED_PGM = 8
cpic.CM_TPN_NOT_RECOGNIZED = 9
cpic.CM_TP_NOT_AVAILABLE_NO_RETRY = 10
cpic.CM_TP_NOT_AVAILABLE_RETRY = 11
cpic.CM_DEALLOCATED_ABEND = 17
cpic.CM_DEALLOCATED_NORMAL = 18
cpic.CM_PARAMETER_ERROR = 19
cpic.CM_PRODUCT_SPECIFIC_ERROR = 20
cpic.CM_PROGRAM_ERROR_NO_TRUNC = 21
cpic.CM_PROGRAM_ERROR_PURGING = 22
cpic.CM_PROGRAM_ERROR_TRUNC = 23
cpic.CM_PROGRAM_PARAMETER_CHECK = 24
cpic.CM_PROGRAM_STATE_CHECK = 25
cpic.CM_RESOURCE_FAILURE_NO_RETRY = 26
cpic.CM_RESOURCE_FAILURE_RETRY = 27
cpic.CM_UNSUCCESSFUL = 28
cpic.CM_DEALLOCATED_ABEND_SVC = 30
cpic.CM_DEALLOCATED_ABEND_TIMER = 31
cpic.CM_SVC_ERROR_NO_TRUNC = 32
cpic.CM_SVC_ERROR_PURGING = 33
cpic.CM_SVC_ERROR_TRUNC = 34
cpic.CM_TAKE_BACKOUT = 100
cpic.CM_DEALLOCATED_ABEND_BO = 130
cpic.CM_DEALLOCATED_ABEND_SVC_BO = 131
cpic.CM_DEALLOCATED_ABEND_TIMER_BO = 132
cpic.CM_RESOURCE_FAIL_NO_RETRY_BO = 133
cpic.CM_RESOURCE_FAILURE_RETRY_BO = 134
cpic.CM_DEALLOCATED_NORMAL_BO = 135
/* ────── return_control ───── */
cpic.CM_WHEN_SESSION_ALLOCATED = 0
cpic.CM_IMMEDIATE = 1
/* ────── send_type ───── */
cpic.CM_BUFFER_DATA = 0
cpic.CM_SEND_AND_FLUSH = 1
cpic.CM_SEND_AND_CONFIRM = 2
cpic.CM_SEND_AND_PREP_TO_RECEIVE = 3
cpic.CM_SEND_AND_DEALLOCATE = 4
/* ────── status_received ───── */
cpic.CM_NO_STATUS_RECEIVED = 0
cpic.CM_SEND_RECEIVED = 1
cpic.CM_CONFIRM_RECEIVED = 2
cpic.CM_CONFIRM_SEND_RECEIVED = 3
cpic.CM_CONFIRM_DEALLOC_RECEIVED = 4
cpic.CM_TAKE_COMMIT = 5
cpic.CM_TAKE_COMMIT_SEND = 6
cpic.CM_TAKE_COMMIT_DEALLOCATE = 7
/* ────── sync_level ───── */
cpic.CM_NONE = 0
cpic.CM_CONFIRM = 1
cpic.CM_SYNC_POINT = 2
return;