home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rxhll.zip / CPIC.REX < prev    next >
OS/2 REXX Batch file  |  1994-01-21  |  29KB  |  690 lines
  1.  
  2.  
  3. /* #include <cpic.rex> */
  4.  
  5. CMINIT: procedure expose cpic.
  6.    /**
  7.    ***  CMINIT with state checking and error handling
  8.    **/
  9.  
  10.    parse arg cpic.sideinfo
  11.  
  12.    cpic.CurrentVerb = 'CMINIT'
  13.    address CPICOMM 'CMINIT cpic.Id cpic.sideinfo code'
  14.    if CpicCheckCode(rc, code) then
  15.       select
  16.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
  17.          otherwise
  18.             call CpicError code,1
  19.       end /* select */
  20.    else
  21.       cpic.State = cpic.CM_INITIALIZE_STATE
  22.  
  23.    cpic.LastVerb = 'CMINIT'
  24.    return
  25.  
  26.  
  27. CMALLC: procedure expose cpic.
  28.    /**
  29.    *** Allocate the conversation
  30.    **/
  31.  
  32.    cpic.CurrentVerb = 'CMALLC'
  33.    address CPICOMM 'CMALLC cpic.Id code'
  34.    if CpicCheckCode(rc, code) then
  35.       select
  36.          when code = cpic.CM_PROGRAM_STATE_CHECK       then call CpicError code,0
  37.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK   then call CpicError code,1
  38.          when code = cpic.CM_PARAMETER_ERROR           then call CpicError code,1
  39.          when code = cpic.CM_UNSUCCESSFUL              then call CpicError code,1
  40.          when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY then
  41.             do
  42.             call CpicError code,0
  43.             cpic.State = cpic.CM_RESET_STATE
  44.             end
  45.          when code = cpic.CM_ALLOCATE_FAILURE_RETRY   then
  46.             do
  47.             call CpicError code,0
  48.             cpic.State = cpic.CM_RESET_STATE
  49.             end
  50.          otherwise
  51.             call CpicError code,1
  52.       end /* select */
  53.    else
  54.       cpic.State = cpic.CM_SEND_STATE
  55.  
  56.    cpic.LastVerb = 'CMALLC'
  57.    return
  58.  
  59.  
  60. CMPTR: procedure expose cpic.
  61.    /**
  62.    *** Allocate the conversation
  63.    **/
  64.  
  65.    cpic.CurrentVerb = 'CMPTR'
  66.    address CPICOMM 'CMPTR cpic.Id code'
  67.    if CpicCheckCode(rc, code) then
  68.       select
  69.          when code = cpic.CM_PROGRAM_STATE_CHECK       then call CpicError code,0
  70.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK   then call CpicError code,1
  71.          when code = cpic.CM_PARAMETER_ERROR           then call CpicError code,1
  72.          otherwise
  73.             call CpicError code,1
  74.       end /* select */
  75.    else
  76.       cpic.State = cpic.CM_RECEIVE_STATE
  77.  
  78.    cpic.LastVerb = 'CMPTR'
  79.    return
  80.  
  81.  
  82. CMACCP: procedure expose cpic.
  83.    /**
  84.    *** Accept the conversation
  85.    **/
  86.  
  87.    cpic.CurrentVerb = 'CMACCP'
  88.    address CPICOMM 'CMACCP cpic.Id code'
  89.    if CpicCheckCode(rc, code) then
  90.       select
  91.          when code = cpic.CM_PROGRAM_STATE_CHECK       then call CpicError code,0
  92.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK   then call CpicError code,1
  93.          when code = cpic.CM_PARAMETER_ERROR           then call CpicError code,1
  94.          otherwise
  95.             call CpicError code,1
  96.       end /* select */
  97.    else
  98.       cpic.State = cpic.CM_RECEIVE_STATE
  99.  
  100.    cpic.LastVerb = 'CMACCP'
  101.    return
  102.  
  103.  
  104. CMDEAL: procedure expose cpic.
  105.    /**
  106.    *** Deallocate the conversation
  107.    **/
  108.  
  109.    cpic.CurrentVerb = 'CMDEAL'
  110.    address CPICOMM 'CMDEAL cpic.Id code'
  111.    if CpicCheckCode(rc, code) then
  112.       select
  113.          when code = cpic.CM_PROGRAM_STATE_CHECK       then call CpicError code,0
  114.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK   then call CpicError code,1
  115.          when code = cpic.CM_PARAMETER_ERROR           then call CpicError code,1
  116.          when code = cpic.CM_PROGRAM_ERROR_PURGING     then
  117.             do
  118.             call CpicError code,0
  119.             cpic.State = cpic.CM_RECEIVE_STATE
  120.             end
  121.          when code = cpic.CM_SVC_ERROR_PURGING         then
  122.             do
  123.             call CpicError code,0
  124.             cpic.State = cpic.CM_RECEIVE_STATE
  125.             end
  126.          otherwise
  127.             call CpicError code,1
  128.       end /* select */
  129.    else
  130.       cpic.State = cpic.CM_RESET_STATE
  131.  
  132.    cpic.LastVerb = 'CMDEAL'
  133.    return
  134.  
  135.  
  136. CMSEND: procedure expose cpic.
  137.    /**
  138.    *** Send data to the partner
  139.    **/
  140.  
  141.    parse arg Buffer
  142.  
  143.    cpic.CurrentVerb = 'CMSEND'
  144.  
  145.    BufferLen = length(Buffer)
  146.  
  147.    address CPICOMM 'CMSEND cpic.Id Buffer BufferLen cpic.RTSreceived code'
  148.    if CpicCheckCode(rc, code) then
  149.       select
  150.          when code = cpic.CM_PROGRAM_STATE_CHECK         then call CpicError code,0
  151.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK     then call CpicError code,1
  152.          when code = cpic.CM_PARAMETER_ERROR             then call CpicError code,1
  153.          when code = cpic.CM_UNSUCCESSFUL                then call CpicError code,1
  154.          when code = cpic.CM_DEALLOCATED_ABEND           then call CpicError code,1
  155.          when code = cpic.CM_DEALLOCATED_ABEND_BO        then call CpicError code,1
  156.          when code = cpic.CM_DEALLOCATED_ABEND_SVC       then call CpicError code,1
  157.          when code = cpic.CM_DEALLOCATED_ABEND_SVC_BO    then call CpicError code,1
  158.          when code = cpic.CM_DEALLOCATED_ABEND_TIMER_BO  then call CpicError code,1
  159.          when code = cpic.CM_RESOURCE_FAILURE_NORETRY    then call CpicError code,1
  160.          when code = cpic.CM_RESOURCE_FAIL_NO_RETRY_BO   then call CpicError code,1
  161.          when code = cpic.CM_RESOURCE_FAILURE_RETRY      then call CpicError code,1
  162.          when code = cpic.CM_RESOURCE_FAILURE_RETRY_BO   then call CpicError code,1
  163.          when code = cpic.CM_TAKE_BACKOUT                then call CpicError code,1
  164.          when code = cpic.CM_PROGRAM_ERROR_PURGING       then call CpicError code,1
  165.          when code = cpic.CM_SVC_ERROR_PURGING           then call CpicError code,1
  166.          when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY   then
  167.             do
  168.             call CpicError code,0
  169.             cpic.State = cpic.CM_RESET_STATE
  170.             end
  171.          when code = cpic.CM_ALLOCATE_FAILURE_RETRY      then
  172.             do
  173.             call CpicError code,0
  174.             cpic.State = cpic.CM_RESET_STATE
  175.             end
  176.          otherwise
  177.             call CpicError code,1
  178.       end /* select */
  179.    else
  180.       do
  181.  
  182.       /* Check the send type for appropriate state change handling */
  183.  
  184.       select
  185.          when cpic.SendType = cpic.CM_SEND_AND_PREP_TO_RECEIVE then
  186.             select
  187.                when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_SYNC_LEVEL   then cpic.State = cpic.CM_DEFER_RECEIVE_STATE
  188.                when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_FLUSH        then cpic.State = cpic.CM_RECEIVE_STATE
  189.                when cpic.PTRtype = cpic.CM_PREP_TO_RECEIVE_CONFIRM      then cpic.State = cpic.CM_RECEIVE_STATE
  190.                otherwise
  191.                   cpic.State = cpic.CM_RECEIVE_STATE
  192.             end /* select */
  193.          when cpic.SendType = cpic.CM_SEND_AND_DEALLOCATE then
  194.             select
  195.                when cpic.DeallocateType = cpic.CM_DEALLOCATE_SYNC_LEVEL then cpic.State = cpic.CM_DEFER_DEALLOCATE_STATE
  196.                when cpic.DeallocateType = cpic.CM_DEALLOCATE_FLUSH      then cpic.State = cpic.CM_RESET_STATE
  197.                when cpic.DeallocateType = cpic.CM_DEALLOCATE_CONFIRM    then cpic.State = cpic.CM_RESET_STATE
  198.                when cpic.DeallocateType = cpic.CM_DEALLOCATE_ABEND      then cpic.State = cpic.CM_RESET_STATE
  199.                otherwise
  200.                   cpic.State = cpic.CM_RESET_STATE
  201.             end /* select */
  202.          otherwise
  203.             cpic.State = cpic.CM_SEND_STATE
  204.       end /* select */
  205.       end /* do */
  206.  
  207.    cpic.LastVerb = 'CMSEND'
  208.    return
  209.  
  210.  
  211. CMRCV: procedure expose cpic.
  212.    /**
  213.    *** Send data to the partner
  214.    **/
  215.  
  216.    cpic.CurrentVerb = 'CMRCV'
  217.  
  218.    RequestedLength = 32767
  219.    address CPICOMM 'CMRCV cpic.Id cpic.ReceiveBuffer RequestedLength',
  220.                          'DataReceived ReceivedLength',
  221.                          'StatusReceived RTSreceived code'
  222.    if (CpicCheckCode(rc, code)) & (code <> cpic.CM_DEALLOCATED_NORMAL) then
  223.       select
  224.          when code = cpic.CM_PROGRAM_STATE_CHECK         then call CpicError code,0
  225.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK     then call CpicError code,1
  226.          when code = cpic.CM_PARAMETER_ERROR             then call CpicError code,1
  227.          when code = cpic.CM_UNSUCCESSFUL                then call CpicError code,1
  228.  
  229.          when code = cpic.CM_DEALLOCATED_ABEND_BO        then call CpicError code,1
  230.          when code = cpic.CM_DEALLOCATED_ABEND_SVC       then call CpicError code,1
  231.          when code = cpic.CM_DEALLOCATED_ABEND_SVC_BO    then call CpicError code,1
  232.          when code = cpic.CM_DEALLOCATED_ABEND_TIMER_BO  then call CpicError code,1
  233.  
  234.          when code = cpic.CM_RESOURCE_FAILURE_NORETRY    then call CpicError code,1
  235.          when code = cpic.CM_RESOURCE_FAIL_NO_RETRY_BO   then call CpicError code,1
  236.          when code = cpic.CM_RESOURCE_FAILURE_RETRY      then call CpicError code,1
  237.          when code = cpic.CM_RESOURCE_FAILURE_RETRY_BO   then call CpicError code,1
  238.  
  239.          when code = cpic.CM_TAKE_BACKOUT                then call CpicError code,1
  240.          when code = cpic.CM_PROGRAM_ERROR_PURGING       then call CpicError code,1
  241.          when code = cpic.CM_SVC_ERROR_PURGING           then call CpicError code,1
  242.          when code = cpic.CM_PROGRAM_ERROR_NO_TRUNC      then call CpicError code,1
  243.          when code = cpic.CM_SVC_ERROR_NO_TRUNC          then call CpicError code,1
  244.          when code = cpic.CM_PROGRAM_ERROR_TRUNC         then call CpicError code,1
  245.          when code = cpic.CM_SVC_ERROR_TRUNC             then call CpicError code,1
  246.          when code = cpic.CM_ALLOCATE_FAILURE_NO_RETRY   then
  247.             do
  248.             call CpicError code,0
  249.             cpic.State = cpic.CM_RESET_STATE
  250.             end
  251.          when code = cpic.CM_ALLOCATE_FAILURE_RETRY      then
  252.             do
  253.             call CpicError code,0
  254.             cpic.State = cpic.CM_RESET_STATE
  255.             end
  256.          otherwise
  257.             call CpicError code,1
  258.       end /* select */
  259.    else
  260.       do
  261.       /* Make sure the length of the buffer is OK.  There was a note in the */
  262.       /* SAA CPI Communications Reference to do this for REXX code.         */
  263.  
  264.       if ReceivedLength <> 'RECEIVEDLENGTH' then
  265.          cpic.ReceiveBuffer = left(cpic.ReceiveBuffer, ReceivedLength)
  266.  
  267.       /* Check data status indicators */
  268.  
  269.       select
  270.          when DataReceived = cpic.CM_NO_DATA_RECEIVED then
  271.             select
  272.                when StatusReceived = cpic.CM_SEND_RECEIVED            then cpic.State = cpic.CM_SEND_STATE
  273.                when StatusReceived = cpic.CM_NO_STATUS_RECEIVED       then cpic.State = cpic.CM_RECEIVE_STATE
  274.                when StatusReceived = cpic.CM_CONFIRM_RECEIVED         then cpic.State = cpic.CM_CONFIRM_STATE
  275.                when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED    then cpic.State = cpic.CM_CONFIRM_SEND_STATE
  276.                when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
  277.                when StatusReceived = cpic.CM_TAKE_COMMIT              then cpic.State = cpic.CM_SYNC_POINT_STATE
  278.                when StatusReceived = cpic.CM_TAKE_COMMIT_SEND         then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
  279.                when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE   then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
  280.                otherwise nop
  281.             end
  282.          when DataReceived = cpic.CM_DATA_RECEIVED then
  283.             select
  284.                when StatusReceived = cpic.CM_SEND_RECEIVED            then cpic.State = cpic.CM_SEND_PENDING_STATE
  285.                when StatusReceived = cpic.CM_NO_STATUS_RECEIVED       then cpic.State = cpic.CM_RECEIVE_STATE
  286.                when StatusReceived = cpic.CM_CONFIRM_RECEIVED         then cpic.State = cpic.CM_CONFIRM_STATE
  287.                when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED    then cpic.State = cpic.CM_CONFIRM_SEND_STATE
  288.                when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
  289.                when StatusReceived = cpic.CM_TAKE_COMMIT              then cpic.State = cpic.CM_SYNC_POINT_STATE
  290.                when StatusReceived = cpic.CM_TAKE_COMMIT_SEND         then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
  291.                when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE   then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
  292.                otherwise nop
  293.             end
  294.          when DataReceived = cpic.CM_COMPLETE_DATA_RECEIVED then
  295.             select
  296.                when StatusReceived = cpic.CM_SEND_RECEIVED            then cpic.State = cpic.CM_SEND_PENDING_STATE
  297.                when StatusReceived = cpic.CM_NO_STATUS_RECEIVED       then cpic.State = cpic.CM_RECEIVE_STATE
  298.                when StatusReceived = cpic.CM_CONFIRM_RECEIVED         then cpic.State = cpic.CM_CONFIRM_STATE
  299.                when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED    then cpic.State = cpic.CM_CONFIRM_SEND_STATE
  300.                when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
  301.                when StatusReceived = cpic.CM_TAKE_COMMIT              then cpic.State = cpic.CM_SYNC_POINT_STATE
  302.                when StatusReceived = cpic.CM_TAKE_COMMIT_SEND         then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
  303.                when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE   then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
  304.                otherwise nop
  305.             end
  306.          when DataReceived = cpic.CM_INCOMPLETE_DATA_RECEIVED then
  307.             do
  308.             select
  309.                when StatusReceived = cpic.CM_SEND_RECEIVED            then cpic.State = cpic.CM_SEND_STATE
  310.                when StatusReceived = cpic.CM_NO_STATUS_RECEIVED       then cpic.State = cpic.CM_RECEIVE_STATE
  311.                when StatusReceived = cpic.CM_CONFIRM_RECEIVED         then cpic.State = cpic.CM_CONFIRM_STATE
  312.                when StatusReceived = cpic.CM_CONFIRM_SEND_RECEIVED    then cpic.State = cpic.CM_CONFIRM_SEND_STATE
  313.                when StatusReceived = cpic.CM_CONFIRM_DEALLOC_RECEIVED then cpic.State = cpic.CM_CONFIRM_DEALLOCATE_STATE
  314.                when StatusReceived = cpic.CM_TAKE_COMMIT              then cpic.State = cpic.CM_SYNC_POINT_STATE
  315.                when StatusReceived = cpic.CM_TAKE_COMMIT_SEND         then cpic.State = cpic.CM_SYNC_POINT_SEND_STATE
  316.                when StatusReceived = cpic.CM_TAKE_COMMIT_DEALLOCATE   then cpic.State = cpic.CM_SYNC_POINT_DEALLOCATE_STATE
  317.                otherwise nop
  318.             end
  319.  
  320.             /* I still need to put code here to loop on this condition */
  321.  
  322.             end
  323.          otherwise
  324.             nop
  325.       end /* CM_OK */
  326.  
  327.    cpic.LastVerb = 'CMRCV'
  328.    return
  329.  
  330.  
  331. CMFLUS: procedure expose cpic.
  332.    /**
  333.    ***
  334.    **/
  335.  
  336.    cpic.CurrentVerb = 'CMFLUS'
  337.    address CPICOMM 'CMFLUS cpic.Id code'
  338.    if CpicCheckCode(rc, code) then
  339.       select
  340.          when code = cpic.CM_PROGRAM_STATE_CHECK     then call CpicError code,0
  341.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK then call CpicError code,1
  342.          otherwise
  343.             call CpicError code,1
  344.       end /* select */
  345.    else
  346.       do
  347.       if cpic.State = cpic.CM_DEFER_RECEIVE_STATE then
  348.          cpic.State = cpic.CM_RECEIVE_STATE
  349.       else
  350.          cpic.State = cpic.CM_SEND_STATE
  351.       end
  352.  
  353.    cpic.LastVerb = 'CMFLUS'
  354.    return
  355.  
  356.  
  357. CpicError: procedure expose cpic.
  358.    /**
  359.    ***  This is called on a CPI-C error
  360.    **/
  361.  
  362.    parse arg code, fatal
  363.  
  364.    select
  365.       when cpic.CM_ALLOCATE_FAILURE_NO_RETRY    = code then codeText = "CM_ALLOCATE_FAILURE_NO_RETRY"
  366.       when cpic.CM_ALLOCATE_FAILURE_RETRY       = code then codeText = "CM_ALLOCATE_FAILURE_RETRY"
  367.       when cpic.CM_CONVERSATION_TYPE_MISMATCH   = code then codeText = "CM_CONVERSATION_TYPE_MISMATCH"
  368.       when cpic.CM_PIP_NOT_SPECIFIED_CORRECTLY  = code then codeText = "CM_PIP_NOT_SPECIFIED_CORRECTLY"
  369.       when cpic.CM_SECURITY_NOT_VALID           = code then codeText = "CM_SECURITY_NOT_VALID"
  370.       when cpic.CM_SYNC_LVL_NOT_SUPPORTED_LU    = code then codeText = "CM_SYNC_LVL_NOT_SUPPORTED_LU"
  371.       when cpic.CM_SYNC_LVL_NOT_SUPPORTED_PGM   = code then codeText = "CM_SYNC_LVL_NOT_SUPPORTED_PGM"
  372.       when cpic.CM_TPN_NOT_RECOGNIZED           = code then codeText = "CM_TPN_NOT_RECOGNIZED"
  373.       when cpic.CM_TP_NOT_AVAILABLE_NO_RETRY    = code then codeText = "CM_TP_NOT_AVAILABLE_NO_RETRY"
  374.       when cpic.CM_TP_NOT_AVAILABLE_RETRY       = code then codeText = "CM_TP_NOT_AVAILABLE_RETRY"
  375.       when cpic.CM_DEALLOCATED_ABEND            = code then codeText = "CM_DEALLOCATED_ABEND"
  376.       when cpic.CM_DEALLOCATED_NORMAL           = code then codeText = "CM_DEALLOCATED_NORMAL"
  377.       when cpic.CM_PARAMETER_ERROR              = code then codeText = "CM_PARAMETER_ERROR"
  378.       when cpic.CM_PRODUCT_SPECIFIC_ERROR       = code then codeText = "CM_PRODUCT_SPECIFIC_ERROR"
  379.       when cpic.CM_PROGRAM_ERROR_NO_TRUNC       = code then codeText = "CM_PROGRAM_ERROR_NO_TRUNC"
  380.       when cpic.CM_PROGRAM_ERROR_PURGING        = code then codeText = "CM_PROGRAM_ERROR_PURGING"
  381.       when cpic.CM_PROGRAM_ERROR_TRUNC          = code then codeText = "CM_PROGRAM_ERROR_TRUNC"
  382.       when cpic.CM_PROGRAM_PARAMETER_CHECK      = code then codeText = "CM_PROGRAM_PARAMETER_CHECK"
  383.       when cpic.CM_PROGRAM_STATE_CHECK          = code then codeText = "CM_PROGRAM_STATE_CHECK"
  384.       when cpic.CM_RESOURCE_FAILURE_NO_RETRY    = code then codeText = "CM_RESOURCE_FAILURE_NO_RETRY"
  385.       when cpic.CM_RESOURCE_FAILURE_RETRY       = code then codeText = "CM_RESOURCE_FAILURE_RETRY"
  386.       when cpic.CM_UNSUCCESSFUL                 = code then codeText = "CM_UNSUCCESSFUL"
  387.       when cpic.CM_DEALLOCATED_ABEND_SVC        = code then codeText = "CM_DEALLOCATED_ABEND_SVC"
  388.       when cpic.CM_DEALLOCATED_ABEND_TIMER      = code then codeText = "CM_DEALLOCATED_ABEND_TIMER"
  389.       when cpic.CM_SVC_ERROR_NO_TRUNC           = code then codeText = "CM_SVC_ERROR_NO_TRUNC"
  390.       when cpic.CM_SVC_ERROR_PURGING            = code then codeText = "CM_SVC_ERROR_PURGING"
  391.       when cpic.CM_SVC_ERROR_TRUNC              = code then codeText = "CM_SVC_ERROR_TRUNC"
  392.       when cpic.CM_TAKE_BACKOUT                 = code then codeText = "CM_TAKE_BACKOUT"
  393.       when cpic.CM_DEALLOCATED_ABEND_BO         = code then codeText = "CM_DEALLOCATED_ABEND_BO"
  394.       when cpic.CM_DEALLOCATED_ABEND_SVC_BO     = code then codeText = "CM_DEALLOCATED_ABEND_SVC_BO"
  395.       when cpic.CM_DEALLOCATED_ABEND_TIMER_BO   = code then codeText = "CM_DEALLOCATED_ABEND_TIMER_BO"
  396.       when cpic.CM_RESOURCE_FAIL_NO_RETRY_BO    = code then codeText = "CM_RESOURCE_FAIL_NO_RETRY_BO"
  397.       when cpic.CM_RESOURCE_FAILURE_RETRY_BO    = code then codeText = "CM_RESOURCE_FAILURE_RETRY_BO"
  398.       when cpic.CM_DEALLOCATED_NORMAL_BO        = code then codeText = "CM_DEALLOCATED_NORMAL_BO"
  399.       otherwise codeText = 'Unknown condition'
  400.    end
  401.  
  402.    select
  403.       when cpic.CM_RESET_STATE                  = cpic.State then stateText = "CM_RESET_STATE"
  404.       when cpic.CM_INITIALIZE_STATE             = cpic.State then stateText = "CM_INITIALIZE_STATE"
  405.       when cpic.CM_SEND_STATE                   = cpic.State then stateText = "CM_SEND_STATE"
  406.       when cpic.CM_RECEIVE_STATE                = cpic.State then stateText = "CM_RECEIVE_STATE"
  407.       when cpic.CM_SEND_PENDING_STATE           = cpic.State then stateText = "CM_SEND_PENDING_STATE"
  408.       when cpic.CM_CONFIRM_STATE                = cpic.State then stateText = "CM_CONFIRM_STATE"
  409.       when cpic.CM_CONFIRM_SEND_STATE           = cpic.State then stateText = "CM_CONFIRM_SEND_STATE"
  410.       when cpic.CM_CONFIRM_DEALLOCATE_STATE     = cpic.State then stateText = "CM_CONFIRM_DEALLOCATE_STATE"
  411.       when cpic.CM_DEFER_RECEIVE_STATE          = cpic.State then stateText = "CM_DEFER_RECEIVE_STATE"
  412.       when cpic.CM_DEFER_DEALLOCATE_STATE       = cpic.State then stateText = "CM_DEFER_DEALLOCATE_STATE"
  413.       when cpic.CM_SYNC_POINT_STATE             = cpic.State then stateText = "CM_SYNC_POINT_STATE"
  414.       when cpic.CM_SYNC_POINT_SEND_STATE        = cpic.State then stateText = "CM_SYNC_POINT_SEND_STATE"
  415.       when cpic.CM_SYNC_POINT_DEALLOCATE_STATE  = cpic.State then stateText = "CM_SYNC_POINT_DEALLOCATE_STATE"
  416.       otherwise codeText = 'Unknown state'
  417.    end
  418.  
  419.    say "CPI-C error ["right(code,4)"]: "codeText"."
  420.    say "Last verb         :" cpic.LastVerb
  421.    say "Current verb      :" cpic.CurrentVerb
  422.    say "Current state     :" stateText
  423.  
  424.    if fatal = 1 then
  425.       exit
  426.    else
  427.       say 'Continuing...'
  428.    return
  429.  
  430.  
  431. CpicSetSideInfo: procedure expose cpic.
  432.    /**
  433.    ***  This will set the CPI-C side information based on the contents of
  434.    ***  the information passed.  It will set some values of the cpic
  435.    ***  stem variable as a side effect.
  436.    ***
  437.    ***  If this routine is called, we want to ignore side information
  438.    ***  in the cpic stem.
  439.    **/
  440.  
  441.    parse arg cpic.plu, cpic.tpname, cpic.mode
  442.  
  443.    if cpic.plu = '' then
  444.       return 0
  445.    if cpic.tpname = '' then
  446.       return 0
  447.    if cpic.mode = '' then
  448.       cpic.mode = '#BATCH'
  449.  
  450.    cpic.sideinfo = ''
  451.  
  452.    /* Manually set the PLU name */
  453.  
  454.    cpic.CurrentVerb = 'CMSPLN'
  455.    address CPICOMM 'CMSPLN cpic.Id cpic.plu' length(cpic.plu) 'code'
  456.    if CpicCheckCode(rc, code) then
  457.       select
  458.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
  459.             call CpicError code,1
  460.          when code = cpic.CM_PROGRAM_STATE_CHECK then
  461.             call CpicError code,1
  462.          otherwise
  463.             call CpicError code,1
  464.       end /* select */
  465.    else
  466.       cpic.State = 2
  467.    cpic.LastVerb = 'CMSPLN'
  468.  
  469.    /* Manually set the TP name */
  470.  
  471.    cpic.CurrentVerb = 'CMSTPN'
  472.    address CPICOMM 'CMSTPN cpic.Id cpic.tpname' length(cpic.tpname) 'code'
  473.    if CpicCheckCode(rc, code) then
  474.       select
  475.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
  476.             call CpicError code,1
  477.          when code = cpic.CM_PROGRAM_STATE_CHECK then
  478.             call CpicError code,1
  479.          otherwise
  480.             call CpicError code,1
  481.       end /* select */
  482.    else
  483.       cpic.State = 2
  484.    cpic.LastVerb = 'CMSTPN'
  485.  
  486.    /* Manually set the mode */
  487.  
  488.    cpic.CurrentVerb = 'CMSMN'
  489.    address CPICOMM 'CMSMN cpic.Id cpic.mode' length(cpic.mode) 'code'
  490.    if CpicCheckCode(rc, code) then
  491.       select
  492.          when code = cpic.CM_PROGRAM_PARAMETER_CHECK then
  493.             call CpicError code,1
  494.          when code = cpic.CM_PROGRAM_STATE_CHECK then
  495.             call CpicError code,1
  496.          otherwise
  497.             call CpicError code,1
  498.       end /* select */
  499.    else
  500.       cpic.State = 2
  501.    cpic.LastVerb = 'CMSMN'
  502.    return 1
  503.  
  504.  
  505. CpicCheckCode: procedure expose cpic.
  506.    /**
  507.    ***  This will check the return codes based on the current state.
  508.    **/
  509.  
  510.    parse arg CpiCommCode, Code
  511.  
  512.    if CpiCommCode <> 0 then
  513.       do
  514.       say "CPICOMM error ["CpiCommCode"]."
  515.       say "Last verb         :" cpic.LastVerb
  516.       say "Current verb      :" cpic.CurrentVerb
  517.       say "Current state     :" cpic.State
  518.       exit
  519.       end
  520.  
  521.    cpic.LastCode = Code
  522.    if Code = cpic.CM_OK then
  523.       return 0
  524.    return 1
  525.  
  526.  
  527. CpicSetup: procedure expose cpic.
  528.    /**
  529.    ***  This will initialize the information for the CPI-C calls
  530.    ***
  531.    ***  The 'cpic.' stem variable contains all of the information about
  532.    ***  cpic that is needed for this collection of routines.
  533.    ***
  534.    ***  The 'cpic.State' holds the current conversation state as documented
  535.    ***  in the SAA CPI Communication Reference (SC26-4399) Appendix C as
  536.    ***  follows:
  537.    ***
  538.    **/
  539.  
  540.    cpic.          = ''
  541.    cpic.State     = cpic.CM_RESET_STATE
  542.    cpic.LastVerb  = 'N/A'
  543.  
  544.    call CpicDefineReturnCodes
  545.  
  546.    /* Establish the CPI-C REXX environment */
  547.  
  548.    '@cpicrexx 2>NUL >NUL'
  549.    return
  550.  
  551.  
  552.  
  553. CpicDefineReturnCodes: procedure expose cpic.
  554.    /**
  555.    ***  This will define the mnemonics for the return codes from CPI-C.
  556.    ***  Adapted from code by IBM APPC Market Enablement
  557.    **/
  558.  
  559.    /* ────── conversation_state       ───── */
  560.  
  561.    cpic.CM_RESET_STATE                  = 1
  562.    cpic.CM_INITIALIZE_STATE             = 2
  563.    cpic.CM_SEND_STATE                   = 3
  564.    cpic.CM_RECEIVE_STATE                = 4
  565.    cpic.CM_SEND_PENDING_STATE           = 5
  566.    cpic.CM_CONFIRM_STATE                = 6
  567.    cpic.CM_CONFIRM_SEND_STATE           = 7
  568.    cpic.CM_CONFIRM_DEALLOCATE_STATE     = 8
  569.    cpic.CM_DEFER_RECEIVE_STATE          = 9
  570.    cpic.CM_DEFER_DEALLOCATE_STATE       = 10
  571.    cpic.CM_SYNC_POINT_STATE             = 11
  572.    cpic.CM_SYNC_POINT_SEND_STATE        = 12
  573.    cpic.CM_SYNC_POINT_DEALLOCATE_STATE  = 13
  574.  
  575.    /* ────── conversation_type        ───── */
  576.  
  577.    cpic.CM_BASIC_CONVERSATION           = 0
  578.    cpic.CM_MAPPED_CONVERSATION          = 1
  579.  
  580.    /* ────── data_received            ───── */
  581.  
  582.    cpic.CM_NO_DATA_RECEIVED             = 0
  583.    cpic.CM_DATA_RECEIVED                = 1
  584.    cpic.CM_COMPLETE_DATA_RECEIVED       = 2
  585.    cpic.CM_INCOMPLETE_DATA_RECEIVED     = 3
  586.  
  587.    /* ────── deallocate_type          ───── */
  588.  
  589.    cpic.CM_DEALLOCATE_SYNC_LEVEL        = 0
  590.    cpic.CM_DEALLOCATE_FLUSH             = 1
  591.    cpic.CM_DEALLOCATE_CONFIRM           = 2
  592.    cpic.CM_DEALLOCATE_ABEND             = 3
  593.  
  594.    /* ────── error_direction          ───── */
  595.  
  596.    cpic.CM_RECEIVE_ERROR                = 0
  597.    cpic.CM_SEND_ERROR                   = 1
  598.  
  599.    /* ────── fill                     ───── */
  600.  
  601.    cpic.CM_FILL_LL                      = 0
  602.    cpic.CM_FILL_BUFFER                  = 1
  603.  
  604.    /* ────── prepare_to_receive_type  ───── */
  605.  
  606.    cpic.CM_PREP_TO_RECEIVE_SYNC_LEVEL   = 0
  607.    cpic.CM_PREP_TO_RECEIVE_FLUSH        = 1
  608.    cpic.CM_PREP_TO_RECEIVE_CONFIRM      = 2
  609.  
  610.    /* ────── receive_type             ───── */
  611.  
  612.    cpic.CM_RECEIVE_AND_WAIT             = 0
  613.    cpic.CM_RECEIVE_IMMEDIATE            = 1
  614.  
  615.    /* ────── request_to_send_received ───── */
  616.  
  617.    cpic.CM_REQ_TO_SEND_NOT_RECEIVED     = 0
  618.    cpic.CM_REQ_TO_SEND_RECEIVED         = 1
  619.  
  620.    /* ────── return_code              ───── */
  621.  
  622.    cpic.CM_OK                           = 0
  623.    cpic.CM_ALLOCATE_FAILURE_NO_RETRY    = 1
  624.    cpic.CM_ALLOCATE_FAILURE_RETRY       = 2
  625.    cpic.CM_CONVERSATION_TYPE_MISMATCH   = 3
  626.    cpic.CM_PIP_NOT_SPECIFIED_CORRECTLY  = 5
  627.    cpic.CM_SECURITY_NOT_VALID           = 6
  628.    cpic.CM_SYNC_LVL_NOT_SUPPORTED_LU    = 7
  629.    cpic.CM_SYNC_LVL_NOT_SUPPORTED_PGM   = 8
  630.    cpic.CM_TPN_NOT_RECOGNIZED           = 9
  631.    cpic.CM_TP_NOT_AVAILABLE_NO_RETRY    = 10
  632.    cpic.CM_TP_NOT_AVAILABLE_RETRY       = 11
  633.    cpic.CM_DEALLOCATED_ABEND            = 17
  634.    cpic.CM_DEALLOCATED_NORMAL           = 18
  635.    cpic.CM_PARAMETER_ERROR              = 19
  636.    cpic.CM_PRODUCT_SPECIFIC_ERROR       = 20
  637.    cpic.CM_PROGRAM_ERROR_NO_TRUNC       = 21
  638.    cpic.CM_PROGRAM_ERROR_PURGING        = 22
  639.    cpic.CM_PROGRAM_ERROR_TRUNC          = 23
  640.    cpic.CM_PROGRAM_PARAMETER_CHECK      = 24
  641.    cpic.CM_PROGRAM_STATE_CHECK          = 25
  642.    cpic.CM_RESOURCE_FAILURE_NO_RETRY    = 26
  643.    cpic.CM_RESOURCE_FAILURE_RETRY       = 27
  644.    cpic.CM_UNSUCCESSFUL                 = 28
  645.    cpic.CM_DEALLOCATED_ABEND_SVC        = 30
  646.    cpic.CM_DEALLOCATED_ABEND_TIMER      = 31
  647.    cpic.CM_SVC_ERROR_NO_TRUNC           = 32
  648.    cpic.CM_SVC_ERROR_PURGING            = 33
  649.    cpic.CM_SVC_ERROR_TRUNC              = 34
  650.    cpic.CM_TAKE_BACKOUT                 = 100
  651.  
  652.    cpic.CM_DEALLOCATED_ABEND_BO         = 130
  653.    cpic.CM_DEALLOCATED_ABEND_SVC_BO     = 131
  654.    cpic.CM_DEALLOCATED_ABEND_TIMER_BO   = 132
  655.    cpic.CM_RESOURCE_FAIL_NO_RETRY_BO    = 133
  656.    cpic.CM_RESOURCE_FAILURE_RETRY_BO    = 134
  657.    cpic.CM_DEALLOCATED_NORMAL_BO        = 135
  658.  
  659.    /* ────── return_control           ───── */
  660.  
  661.    cpic.CM_WHEN_SESSION_ALLOCATED       = 0
  662.    cpic.CM_IMMEDIATE                    = 1
  663.  
  664.    /* ────── send_type                ───── */
  665.  
  666.    cpic.CM_BUFFER_DATA                  = 0
  667.    cpic.CM_SEND_AND_FLUSH               = 1
  668.    cpic.CM_SEND_AND_CONFIRM             = 2
  669.    cpic.CM_SEND_AND_PREP_TO_RECEIVE     = 3
  670.    cpic.CM_SEND_AND_DEALLOCATE          = 4
  671.  
  672.    /* ────── status_received          ───── */
  673.  
  674.    cpic.CM_NO_STATUS_RECEIVED           = 0
  675.    cpic.CM_SEND_RECEIVED                = 1
  676.    cpic.CM_CONFIRM_RECEIVED             = 2
  677.    cpic.CM_CONFIRM_SEND_RECEIVED        = 3
  678.    cpic.CM_CONFIRM_DEALLOC_RECEIVED     = 4
  679.    cpic.CM_TAKE_COMMIT                  = 5
  680.    cpic.CM_TAKE_COMMIT_SEND             = 6
  681.    cpic.CM_TAKE_COMMIT_DEALLOCATE       = 7
  682.  
  683.    /* ────── sync_level               ───── */
  684.  
  685.    cpic.CM_NONE                         = 0
  686.    cpic.CM_CONFIRM                      = 1
  687.    cpic.CM_SYNC_POINT                   = 2
  688.  
  689.    return;
  690.