gtps2m1mACF/SNA Data Communications Reference

Sample Transaction Programs

When describing program-to-program communications, you must keep in mind your perspective. Program-to-program communications relies on the presence of a local program and a complimentary remote program. The function provided by this pair of programs is distributed in the 2 systems.

The following sample TPF transaction programs (TPs) show how you can use the TPF/APPC support package to have 2 TPF systems communicate with each other to perform a simple task. To reduce confusion, the following sample programs are described as the requesting program and the requested program. The requesting program initiates the communications process and asks the requested program to provide some information. The requesting program then accepts the response from the requested program, takes some action based on the response and then terminates the communications process. In the following example, the simple task is to have 1 TPF system (the requesting TPF system) check the validity of a FACE record type and ordinal number on a remote TPF system (the requested TPF system).

These samples are provided solely to illustrate the interrelationship of the 2 transaction programs and are not intended to demonstrate all the functions or possibilities of the TPF/APPC support package. In fact, the sample programs described below ignore most of the error situations that may occur and that a fully functional program would be expected to handle. It is beyond the scope of these sample programs to demonstrate the necessary error handling of a fully functional program.

Sample Transaction Program Functions

The sample transaction programs provide the following functions:

  1. Initiate the requesting TPF TP with a command, and pass a FACE record type and ordinal number.
  2. The requesting TPF TP allocates a conversation with the requested TPF TP.
  3. The requesting TPF TP sends the record type and ordinal number to the requested TPF TP.
  4. The requested TPF TP receives the record type and ordinal number.
  5. The requested uses the FACE program interface in the remote system to check the validity of the record type and ordinal number.
  6. The requested attempts to read the record if they are valid.
  7. The requested TPF TP returns a message to the requesting TPF TP with the results of the operation.
  8. The requesting TPF TP interprets the returned data and writes a message to the operator based on the reply to indicate the results of the requested TPF TP.
  9. The requesting TPF TP then deallocates the conversation.

For the purpose of this sample, assume that the requesting TPF system has a command with the following format:

Also, assume that this command activates the TPF E-type program segment named SMPS. This process is described in Requesting TPF Transaction Program.

The TPF TP in the remote requested system is activated as a result of the TPPCC ALLOCATE macro being executed in the local requesting TPF TP. Therefore, the remote requested TPF TP must be defined in the remote TPF system. For the purpose of this sample, assume that the following entry is defined in the transaction program name table (TPNT) on the remote TPF system with the ITPNT macro:

    ITPNT  MF=L,TPN=VERIFY_RECORD_TYPE,PGM=SMPR,IS=ANY

If both TPF systems are generated as previously described to accept the ZSAMP command and to define the TP name in the TPNT, either TPF system could be both the requesting TPF system and the requested TPF system.

The requesting TPF TP is described in Requesting TPF Transaction Program and the requested TPF TP is described in Requested TPF Transaction Program.

Requesting TPF Transaction Program

In this sample, the requesting TPF TP is activated by the command previously described. After parsing the command, the requesting TPF TP must allocate a conversation with the requested TPF TP by issuing a TPPCC ALLOCATE macro, as shown in Sample Requesting TPF Transaction Program, at the label START_CONVERSATION. The LUNAME parameter points to the RVT entry of the LU defining the remote TPF system's TPF/APPC support package. The TPN parameter gives the name of the remote TP as defined in the ITPNT of the remote TPF system. The RESID parameter requests that the conversation ID be pointed to by register 3, and the RCODE parameter requests that the return code be pointed to by register 4.

Note:
For these examples, all return codes are assumed to be OK.

After allocating the conversation to the remote requested TPF TP, the requesting TPF TP then builds a message for the requested TP containing the FACE record type and ordinal number that was present on the command. In this example, the message is passed on D0 and consists of the following record:

Field Length Value Description
AM0CCT 2 19 Total message length
AM0TXT 2 14 Logical record length
AM0TXT+2 6 variable Record type from command
AM0TXT+8 6 variable Ordinal number from command

Once the message is built on D0, the requesting TPF TP sends the message by issuing the TPPCC SEND_DATA macro, as shown in Sample Requesting TPF Transaction Program at label SEND_RECORD_TO_REQUESTED_TP.

The TPPCC FLUSH then causes the message to be sent to the remote requested TPF TP. This requesting TPF TP must now change to receive state and wait for the response from the remote requested TPF TP. This requesting TPF TP accomplishes this by issuing the TPPCC RECEIVE macro as shown in Sample Requesting TPF Transaction Program at label RECEIVE_AND_WAIT_FOR_REPLY.

This requesting TPF TP instance (in TPF terms, the ECB) is now suspended until the remote requested TPF TP sends the response. Assuming all has g1 well, the RECEIVE is satisfied with a return code of OK and a WHATRCV indicator of DATA. The data message received consists of a logical length field and a 2-byte message that gives the results of the requested TPF TP system's checks. In our sample, the 2-byte message can be any of the following:

OK
The record type and ordinal number were valid and the record was successfully read on the remote TPF system.

NR
The record type was invalid on the remote TPF system.

NO
The ordinal number was invalid on the remote TPF system.

IO
The record type and ordinal number were valid, but the record could not be successfully read on the remote TPF system.

The requesting TPF TP now interrogates the response and informs the operator of the results of the action. For example, the logic could be implemented to send a message to the local TPF console as shown in Sample Requesting TPF Transaction Program at label PROCESS_REPLY.

The function is now basically complete, except that the local and remote TPF TPs are still in conversation. The requesting TPF TP ends the conversation by issuing a TPPCC DEALLOCATE macro, as shown in Sample Requesting TPF Transaction Program at label END_CONVERSATION. The requesting TPF TP then frees up any other resources that it has end exits.

Requested TPF Transaction Program

When the requesting TPF TP issues the TPPCC ALLOCATE macro, an ATTACH FMH5 is forwarded to this TPF system. The TPF/APPC support package recognizes the ATTACH as the beginning of a new conversation and assigns a transaction control block identifier (TCB ID), a conversation identifier (CCB ID) and activates the program associated with the transaction program name in the TPF transaction program name table (TPNT). When this TPF program, SMPR in our example, is activated, the TCB ID and CCB ID are passed in the ECB, and the conversation is placed in receive state. This interface is shown in Sample Requested TPF Transaction Program at label BEGIN_SAMPLE_RECEIVE.

No data has been passed to the TP when it is activated, so the requested TPF TP issues the TPPCC RECEIVE macro to request the first data message, as shown in Sample Requested TPF Transaction Program at label RECEIVE_AND_WAIT_FOR_REQUEST.

In this sample, the requesting TPF TP is issuing the TPPCC SEND_DATA macro to forward the FACE record type and ordinal number. If this message has not yet arrived, this ECB is suspended until the message does arrive. Control is returned to the next sequential instruction after the TPPCC verb macro only when there is something available.

When control is returned, this requested TPF TP can use the FACE record type and ordinal number in the data message and perform its processing to check the validity. However, this TPF TP is still in receive state and must wait for the partner requesting TPF TP to change direction and place this TP in send state. Therefore, this requested TPF TP saves the information in the request and again issues a TPPCC RECEIVE macro to wait for the change in direction, as shown in Sample Requested TPF Transaction Program at label RECEIVE_AND_WAIT_FOR_SEND_IND. The change in direction is given to this requested TPF TP when the value in the WHAT_RECEIVED (WHATRCV) parameter is set to LU62WR_SEND. Once the send-indication has arrived, this requested TPF TP may then process the original request as shown in Sample Requested TPF Transaction Program at label PROCESS_REQUEST.

This requested TPF TP then issues the TPPCC SEND_DATA macro to forward the results of the process as a reply to the partner requesting TPF TP. The partner requesting TPF TP has issued a TPPCC RECEIVE macro to await the reply.

After sending the reply, this requested TPF TP causes a change of direction by issuing the TPPCC RECEIVE macro and waits for the partner requesting TPF TP to respond.

The requesting TPF TP receives the reply sent by the TPPCC SEND_DATA macro and continues its processing. It then issues a TPPCC RECEIVE again, and gets the send-indication in the WHATRCVD parameter. Because all processing is complete, the requesting TPF/APPC TP issues the TPPCC DEALLOCATE macro, which causes this requested TPF/APPC TP's RECEIVE verb to be satisfied by passing the deallocation request in the WHATRCVD parameter. This is shown in Sample Requested TPF Transaction Program at label RECEIVE_AND_WAIT_FOR_END_CONV.

When this RECEIVE is satisfied with the deallocation request, the requested TPF TP then issues the TPPCC DEALLOCATE macro with the TYPE=LOCAL option to free up the conversation resources and end the conversation, as shown in Sample Requested TPF Transaction Program at label END_CONVERSATION. The requested TPF TP can then issue the TPF EXITC macro.

Sample Requesting TPF Transaction Program

**********************************************************************
*         THIS PRODUCT CONTAINS "RESTRICTED MATERIALS OF IBM "
*         COPYRIGHT = 5748-T12 (C) COPYRIGHT IBM CORP 1979,1988
*             LICENSED MATERIAL - PROGRAM PROPERTY OF IBM
*             REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083
**********************************************************************
         BEGIN NAME=SMPS,VERSION=24,IBM=YES
*
***************************************************************
*                                                             *
* MODULE NAME..... SMPS - (Local TPF/APPC TP)                 *
* RELATED MODULE.. SMPR - (Remote partner TP)                 *
* DOCUMENT NAME... N/A                                        *
* DESCRIPTION..... Sample requesting (SEND) TPF/APPC TP       *
* LEVEL........... N/A                                        *
*                                                             *
* FUNCTION........ This simple sample program illustrates a   *
*                  TPF/APPC transaction program (TP) that     *
*                  requests information from a remote         *
*                  TPF/APPC TP.  The command ZSAMP *
*                  activates this program.                    *
*                                                             *
*                  This requesting TP allocates a conversation*
*                  with a remote TP.  This program passes a   *
*                  FACE record type and ordinal number to the *
*                  remote side TPF/APPC TP.  The remote TP    *
*                  then verifies if the passed record type is *
*                  valid on the remote TPF system and replies *
*                  accordingly.  This requesting side then    *
*                  interprets the response and formats an     *
*                  operator message based on the response.    *
*                                                             *
*                  This sample program is intended to show    *
*                  only the format and use of some of the     *
*                  TPPCC verb macros and is NOT intended      *
*                  to be a fully-functional or practical      *
*                  TP.                                        *
*                                                             *
*                                                             *
*                                                             *
*                                                             *
* MODULE ATTRIBUTES..                                         *
*   TYPE.......... 'E' (ECB CONTROLLED)                       *
*   ENVIRONMENT... Sample code only                           *
*   ENTRY POINT... BEGIN_SAMPLE_SEND                          *
*                                                             *
*                                                             *
***************************************************************
* INTERFACE REQUIREMENTS:                                     *
*                                                             *
* INPUT.......... ZSAMP #FACER ORDINAL                        *
*                       ----- -------                         *
*                       I      I--- A six byte ordinal        *
*                       I---------- A FACE record type        *
*                                                             *
* RESTRICTIONS... This program assumes that the remote        *
*                 TPF system has a entry in its ITPNT         *
*                 table for the requested (RECEIVE side) TP,  *
*                 named 'VERIFY_RECORD_TYPE'                  *
*                                                             *
*                                                             *
*  ECB ON --->  * INPUT..              * OUTPUT..             *
* --------------*----------------------*----------------------*
* WORK AREA.... * N/A                  * N/A                  *
* DATA LEVELS.. * D0 - Input Zmsg      * N/A                  *
* REGISTERS.... * N/A                  * N/A                  *
*               *                      *                      *
* --------------*----------------------*----------------------*
  EJECT
***************************************************************
*                                                             *
*        Define Data Records Used                             *
*                                                             *
***************************************************************
  AM0SG REG=R1        Define Input message format
  TPPCE
  SPACE  3
STUFF    DSECT ,      Define Save Stuff Area
SFACER   DS    CL6    Six byte FACE Record Type
SFACEO   DS    CL6    Six byte Face Ordinal number
SRCODE   DS   0CL6    Full 6 byte return code
SRCODEP  DS    CL2    2 byte primary return code
SRCODES  DS    CL4    4 byte secondary return code
         DS   0F      Full word alignment
SRESID   DS    XL4    Resource (Conversation) ID
SRTS     DS    XL1    Request_To_Send_Received Indicator
SWHAT    DS    XL1    What_Received Indicator
  USING  STUFF,R2     Establish Addressability
$IS$     CSECT ,      Continue Program CSECT
  EJECT
***************************************************************
*                                                             *
*        Begin Mainline logic                                 *
*                                                             *
***************************************************************
BEGIN_SAMPLE_SEND       DS    0H
 L     R1,CE1CR0        Get address of command text
 GETCC D2,L0            Get a block to save stuff in
 LR    R2,R14           Get address of block
 MVC   SFACER,AM0TXT+4  Save Record Type
 MVC   SFACEO,AM0TXT+11 Save Ordinal Number
 RELCC D0               Discard command
 SPACE   3
***************************************************************
*                                                             *
*        Allocate a conversation with RECEIVE side TP         *
*                                                             *
***************************************************************
START_CONVERSATION           DS  0H
 TPPCC         ALLOCATE,                                               X
               LUNAME=KLUNAME,                                         X
               TPN=KTPNAME,                                            X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               SYNC=N1
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on ALLOCATE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 SPACE   3
***************************************************************
*                                                             *
*        Send the data to the remote TP                       *
*                                                             *
***************************************************************
BUILD_RECORD_TO_SEND          DS  0H
 GETCC   D0,L1                   Get a 381 byte block
 LR      R1,R14                  Gets its address
 XC      0(27,R1),0(R1)          Clear AM0SG header
 MVC     AM0TXT+2(L'SFACER+L'SFACEO),SFACER  Move data to be sent
 MVC     AM0CCT,=AL2(L'SFACER+L'SFACEO+7) Set count field
 MVC     AM0TXT(2),=AL2(L'SFACER+L'SFACEO+2)  logical record length
SEND_RECORD_TO_REQUESTED_TP   DS  0H
 TPPCC         SEND_DATA,                                              X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on SEND_DATA
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SRTS,LU62_RTSND_RCVDYES  Did we get Request_To_Send
 BE      TERMINATE_CONVERSATION   Yes - don't honor it
 SPACE   3
***************************************************************
*        FLUSH the data to be sent                            *
***************************************************************
 TPPCC         FLUSH,                                                  X
               RESID=SRESID,                                           X
               RCODE=SRCODE
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on SEND_DATA
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 SPACE   3
***************************************************************
*                                                             *
*        Issue RECEIVE and wait for the answer                *
*                                                             *
***************************************************************
RECEIVE_AND_WAIT_FOR_REPLY   DS  0H
 TPPCC         RECEIVE,                                                X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS,                                           X
               WHATRCV=SWHAT,                                          X
               WAIT=YES
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on RECEIVE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SRTS,LU62_RTSND_RCVDYES  Did we get Request_To_Send
 BE      TERMINATE_CONVERSATION   Yes - don't honor it
 CLI     SWHAT,LU62WR_DATACOMPLETE Did we get complete data
 BNE     TERMINATE_CONVERSATION   No  - terminate the conversation
*                                 Looks like we got the answer
***************************************************************
*                                                             *
*        Process reply received from requested TP             *
*                                                             *
***************************************************************
PROCESS_REPLY                DS  0H
 L       R1,CE1CR0                Point to block received
 SELECT
   WHEN  KOK,=,AM0TXT+2
         WTOPC TEXTA=MOK,SUB=(CHARA,SFACER,CHARA,SFACEO),              X
               PREFIX=SAMP,NUM=01,LET=I
   WHEN  KNR,=,AM0TXT+2
         WTOPC TEXTA=MNR,SUB=(CHARA,SFACER,CHARA,SFACEO),              X
               PREFIX=SAMP,NUM=02,LET=I
   WHEN  KNO,=,AM0TXT+2
         WTOPC TEXTA=MNO,SUB=(CHARA,SFACER,CHARA,SFACEO),              X
               PREFIX=SAMP,NUM=03,LET=I
   WHEN  KIO,=,AM0TXT+2
         WTOPC TEXTA=MIO,SUB=(CHARA,SFACER,CHARA,SFACEO),              X
               PREFIX=SAMP,NUM=04,LET=I
   OTHERW
         WTOPC TEXTA=MUN,PREFIX=SAMP,NUM=05,LET=I
 ENDSEL
 RELCC   D0
 SPACE 3
***************************************************************
*                                                             *
*        WAIT for SEND indicator to get into SEND state       *
*                                                             *
***************************************************************
 TPPCC         RECEIVE,                                                X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS,                                           X
               WHATRCV=SWHAT                                           X
               WAIT=YES
 CLC     SRCODEP,=AL2(LU62RC_OK)  any bad news ?
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SWHAT,LU62WR_SEND        Did we get send indication ?
 BNE     TERMINATE_CONVERSATION   No  - terminate the conversation
***************************************************************
*                                                             *
*        Free up resources and DEALLOCATE                     *
*                                                             *
***************************************************************
END_CONVERSATION             DS  0H
 TPPCC         DEALLOCATE,                                             X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=SYNC
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on DEALLOCATE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 RELCC   D2                       Discard save area
 EXITC   ,                        All done
 SPACE   3
***************************************************************
*                                                             *
*        Terminate conversation on bad return code            *
*                                                             *
***************************************************************
TERMINATE_CONVERSATION       DS  0H
 WTOPC  TEXTA=MCF,SUB=(HEX4A,SRCODEP,HEX4A,SRCODES),                   X
               PREFIX=SAMP,NUM=99,LET=I
 SELECT
   WHEN  SRCODEP,=,=AL2(LU62RC_ALLOC_ERROR)
         TPPCC DEALLOCATE,                                             X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=LOCAL
   OTHERW
         TPPCC DEALLOCATE,                                             X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=ABENDP
 ENDSEL
 CRUSA  S0=0
 RELCC  D2                  Discard save area
 EXITC  ,
 EJECT  ,
***************************************************************
*                                                             *
*        Define WTOPC message texts                           *
*                                                             *
***************************************************************
DEFINE_MESSAGES              DS  0H
MOK      DC  AL1(43)
         DC  C'ORDINAL ...... FOR TYPE ...... OK ON REMOTE'
MNR      DC  AL1(29)
         DC  C'TYPE ...... INVALID ON REMOTE'
MNO      DC  AL1(48)
         DC  C'ORDINAL ...... FOR TYPE ...... TOO BIG ON REMOTE'
MIO      DC  AL1(48)
         DC  C'ORDINAL ...... FOR TYPE ...... I/O ERR ON REMOTE'
MUN      DC  AL1(48)
         DC  C'UNKNOWN RESPONSE FROM REMOTE'
MCF      DC  AL1(34)
         DC  C'CONVERSATION FAILURE .... ........'
***************************************************************
*                                                             *
*        Define Constants Used                                *
*                                                             *
***************************************************************
DEFINE_CONSTANTS             DS  0H
KLUNAME  DS  0CL16                Remote FQN
KLUNAMEN DC   CL8'NETID   '       Remote NETID
KLUNAMEL DC   CL8'LUNAME  '       Remote LUNAME
KTPNAME  DS  0CL65                Max area
KTPNAMEL DC   AL1(L'KTPNAMEN)     TP_NAME Length
KTPNAMEN DC   C'VERIFY_RECORD_TYPE'
KOK      DC   C'OK' ==> Record type and ordinal all okay
KNR      DC   C'NR' ==> Record type was invalid in remote system
KNO      DC   C'NO' ==> Ordinal number was too big in remote system
KIO      DC   C'IO' ==> Could not read the record in the remote system
  LTORG ,
  FINIS ,
  END   ,

Sample Requested TPF Transaction Program

**********************************************************************
*         THIS PRODUCT CONTAINS "RESTRICTED MATERIALS OF IBM "
*         COPYRIGHT = 5748-T12 (C) COPYRIGHT IBM CORP 1979,1988
*             LICENSED MATERIAL - PROGRAM PROPERTY OF IBM
*             REFER TO COPYRIGHT INSTRUCTIONS FORM NUMBER G120-2083
**********************************************************************
         BEGIN NAME=SMPR,VERSION=24,IBM=YES
*
***************************************************************
*                                                             *
* MODULE NAME..... SMPR - The sample requested TP             *
* RELATED MODULE.. SMPS - The sample requesting TP            *
* DOCUMENT NAME... N/A                                        *
* DESCRIPTION..... Sample requested (RECEIVE) TPF/APPC TP     *
* LEVEL........... N/A                                        *
*                                                             *
* FUNCTION........ This sample TPF/APPC transaction program   *
*                  illustrates a TP that receives a request   *
*                  from a TPF/APPC TP.  An ATTACH sent from   *
*                  the requesting side activates this TP.     *
*                                                             *
*                  This requested side of the TPF/APPC TP     *
*                  receives a FACE record type and ordinal    *
*                  number in the first message from the       *
*                  requesting TP.  This TP uses this          *
*                  information to call FACE on THIS TPF       *
*                  system.  Upon successful return from FACE, *
*                  this program attempts to read the record   *
*                  from DASD.  The results are returned to the*
*                  requesting TP as follows:                  *
*                  OK ===> Request record could be read       *
*                  NR ===> Record type invalid                *
*                  NO ===> Ordinal number invalid             *
*                  IO ===> Error reading record from DASD     *
*                                                             *
*                  This sample program is intended to show    *
*                  only the format and use of some of the     *
*                  TPPCC verb macros and is NOT intended      *
*                  to be a fully functional or practical      *
*                  TP.                                        *
*                                                             *
*                                                             *
*                                                             *
*                                                             *
* MODULE ATTRIBUTES..                                         *
*   TYPE.......... 'E' (ECB CONTROLLED)                       *
*   ENVIRONMENT... Sample code only                           *
*   ENTRY POINT... BEGIN_SAMPLE_RECEIVE                       *
*                                                             *
*                                                             *
***************************************************************
* INTERFACE REQUIREMENTS:                                     *
*                                                             *
* INPUT.......... Standard TPF/APPC ATTACH interface          *
*                                                             *
* RESTRICTIONS... This program assumes that there is an       *
*                 entry in the ITPNT for this TPF system      *
*                 that directs incoming ALLOCATES (ATTACH)    *
*                 to this program. The TP_NAME is             *
*                 VERIFY_RECORD_TYPE.                         *
*                                                             *
*                                                             *
*  Input/Output Interface                                     *
*               Standard TPF/APPC ATTACH Interface:           *
*  ECB          * INPUT..              * OUTPUT..             *
* --------------*----------------------*----------------------*
* WORK AREA.... * N/A                  * N/A                  *
* DATA LEVELS.. * N/A                  * N/A                  *
* REGISTERS.... * N/A                  * N/A                  *
*               *                      *                      *
* --------------*----------------------*----------------------*
  EJECT
***************************************************************
*                                                             *
*        Define Data Records Used                             *
*                                                             *
***************************************************************
  AM0SG REG=R1        Define Input message format
  TPPCE  ,            Define TPF/APPC values
  DCLREG ,            Define registers for SPM use
  SPACE  3
STUFF    DSECT ,      Define Save Stuff Area
SFACER   DS    CL6    Six byte FACE Record Type
SFACEO   DS    CL6    Six byte Face Ordinal number
SRCODE   DS   0CL6    Full 6 byte return code
SRCODEP  DS    CL2    2 byte primary return code
SRCODES  DS    CL4    4 byte secondary return code
         DS   0F      Full word alignment
SRESID   DS    XL4    Resource (Conversation) ID
SRTS     DS    XL1    Request_To_Send_Received Indicator
SWHAT    DS    XL1    What_Received Indicator
STCBID   DS    XL1    TCB_ID
         DS   0D
SDWORD   DS    D      Double word work area
SFWORD   DS    F      Full word work area
  USING  STUFF,R2     Establish Addressability
$IS$     CSECT ,      Continue Program CSECT
  EJECT
***************************************************************
*                                                             *
*        Begin Mainline logic (ATTACH Received)               *
*                                                             *
***************************************************************
BEGIN_SAMPLE_RECEIVE    DS    0H
 GETCC D2,L0            Get a block to save stuff in
 LR    R2,R14           Get address of block
 MVC   SRESID,EBCCBID   Save RESID value
 MVC   STCBID,EBTCBID   Save TCBID value
 SPACE   3
***************************************************************
*                                                             *
*        Issue RECEIVE and wait for the message               *
*                                                             *
***************************************************************
RECEIVE_AND_WAIT_FOR_REQUEST    DS  0H
 TPPCC         RECEIVE,                                                X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS,                                           X
               WHATRCV=SWHAT,                                          X
               WAIT=YES
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on RECEIVE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SRTS,LU62_RTSND_RCVDYES  Did we get Request_To_Send
 BE      TERMINATE_CONVERSATION   Yes - don't honor it
 CLI     SWHAT,LU62WR_DATACOMPLETE Did we get complete data
 BNE     TERMINATE_CONVERSATION   No  - terminate the conversation
*                                 Looks like we got the message
 L       R1,CE1CR0                Point to block received
 MVC   SFACER,AM0TXT+2  Save Record Type
 MVC   SFACEO,AM0TXT+8  Save Ordinal Number
 RELCC D0               Discard message
***************************************************************
*                                                             *
*        Wait for SEND indicator                              *
*                                                             *
***************************************************************
RECEIVE_AND_WAIT_FOR_SEND_IND     DS  0H
 TPPCC         RECEIVE,                                                X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS,                                           X
               WHATRCV=SWHAT,                                          X
               WAIT=YES
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on RECEIVE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SRTS,LU62_RTSND_RCVDYES  Did we get Request_To_Send
 BE      TERMINATE_CONVERSATION   Yes - don't honor it
 CLI     SWHAT,LU62WR_SEND        Did we get SEND indicator
 BNE     TERMINATE_CONVERSATION   No  - terminate the conversation
***************************************************************
*                                                             *
*        Initialize the response block                        *
*                                                             *
***************************************************************
PROCESS_REQUEST              DS  0H
 GETCC   D0,L1                    Get a block
 LR      R1,R14                   Point to the msg block
 XC      0(27,R1),0(R1)           Clear AM0SG header
 MVC     AM0CCT,=AL2(2+2+5)       Set length
 MVC     AM0TXT(2),=AL2(2+2)      Dup in LL field
***************************************************************
*                                                             *
*        Call FACE with requested data                        *
*                                                             *
***************************************************************
 XC      CE1FM6,CE1FM6            Clear FARW
 PACK    SDWORD,SFACEO            Convert Ordinal to packed
 CVB     R0,SDWORD                and then binary
 LA      R6,SFACER                Point to Record Type
 LA      R7,CE1FA6                Point to Return Area
 ENTRC   FACS                     Call FACE Program
 LTR     R0,R0                    Check Return Code
 BE      FACE_ERROR               Bad News
 FINWC   D6,FIND_ERROR            Read Record and branch on err
 MVC     AM0TXT+2(2),KOK          Set response = OK
 B       SEND_REPLY
FIND_ERROR                        DS 0H
 MVC     AM0TXT+2(2),KIO          Set response = IO
 B       SEND_REPLY
FACE_ERROR                        DS 0H
 IF      R7,=,1                   If bad record type
         THEN
         MVC  AM0TXT+2(2),KNR     Set response = NR
         ELSE                        bad ordinal number
         MVC  AM0TXT+2(2),KNO     Set response = NO
 ENDIF
***************************************************************
*                                                             *
*        Send the data to the remote TP                       *
*                                                             *
***************************************************************
SEND_REPLY                   DS 0H
 TPPCC         SEND_DATA,                                              X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on SEND_DATA
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CLI     SRTS,LU62_RTSND_RCVDYES  Did we get Request_To_Send
 BE      TERMINATE_CONVERSATION   Yes - don't honor it
 SPACE   3
***************************************************************
*                                                             *
*        FLUSH data to remote                                 *
*                                                             *
***************************************************************
 TPPCC         FLUSH,                                                  X
               RESID=SRESID,                                           X
               RCODE=SRCODE
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on FLUSH ?
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
***************************************************************
*                                                             *
*    Issue PREPARE TO RECEIVE to put remote in SEND state     *
*                                                             *
***************************************************************
 TPPCC         PREPARE_TO_RECEIVE,                                     X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=SYNC
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news ?
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
***************************************************************
*                                                             *
*        Issue RECEIVE and wait for DEALLOCATE                *
*                                                             *
***************************************************************
RECEIVE_AND_WAIT_FOR_END_CONV     DS  0H
 TPPCC         RECEIVE,                                                X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               RTSRCVD=SRTS,                                           X
               WHATRCV=SWHAT,                                          X
               WAIT=YES
 CLC     SRCODEP,=AL2(LU62RC_DLLOC_NORMAL)
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
***************************************************************
*                                                             *
*        Free up resources and DEALLOCATE                     *
*                                                             *
***************************************************************
END_CONVERSATION       DS  0H
 TPPCC         DEALLOCATE,                                             X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=LOCAL
 CLC     SRCODEP,=AL2(LU62RC_OK)  Any bad news on DEALLOCATE
 BNE     TERMINATE_CONVERSATION   Yes - terminate the conversation
 CRUSA   S0=2,S1=0                Discard any blocks
 EXITC   ,                        All done
 SPACE   3
***************************************************************
*                                                             *
*        Terminate conversation on bad return code            *
*                                                             *
***************************************************************
TERMINATE_CONVERSATION            DS  0H
 WTOPC  TEXTA=MCF,SUB=(HEX4A,SRCODEP,HEX4A,SRCODES),                   X
               PREFIX=SAMP,NUM=99,LET=I
         TPPCC DEALLOCATE,                                             X
               RESID=SRESID,                                           X
               RCODE=SRCODE,                                           X
               TYPE=ABENDP
 CRUSA   S0=2,S1=0          Discard any blocks
 EXITC  ,
 EJECT  ,
***************************************************************
*                                                             *
*        Define Constants Used                                *
*                                                             *
***************************************************************
DEFINE_CONSTANTS        DS  0H
KOK      DC   C'OK' ==> Record type and ordinal all okay
KNR      DC   C'NR' ==> Record type was invalid in remote system
KNO      DC   C'NO' ==> Ordinal number was too big in remote system
KIO      DC   C'IO' ==> Couldn't read the record in the remote system
MCF      DC   AL1(34)
         DC   C'CONVERSATION FAILURE .... ........'
  LTORG ,
  FINIS ,
  END   ,