IDENTIFICATION DIVISION. PROGRAM-ID. ADKCOBOL. * This program demonstrates dynaTrace IMS ADK APIs. * * One group of APIs contains functions for starting and * ending a Purepath for the transaction and associated tagging * functions. A newer group of APIs permits nodes to be inserted * into a Purepath that is already in progress and to capture * its arguments or return value. The two groups of APIs are * unrelated, but they can be used within the same transaction. ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. * 01 GU PIC X(4) VALUE 'GU '. 01 ISRT PIC X(4) VALUE 'ISRT'. * Optional name to describe the initial path. 77 PATHNAME Pic X(24) Value "Started from tagging ADK". 77 PATHNAME_LEN Pic S9(9) Comp Value 24. 77 PATHNAME_CCSID Pic S9(9) Comp Value 0. * Buffer to hold the tag that will identify a child path. * Note: DynaTrace 5.x requires a buffer of at least 77 bytes. 77 TAG_BUFFER Pic X(100). 77 TAG_BUFFER_LEN Pic S9(9) Comp value 100. 77 TAG_LEN Pic S9(9) Comp. 77 TERM_MSG Pic X(23) Value "COBOL TAGTEST complete.". 77 TERM_MSG_ERROR PIC X(35) VALUE "COBOL TAGTEST COMPLETE WITH ERROR.". 77 RC Pic S9(9) Comp. 01 ERROR_MSG. 05 MSG_API Pic X(10). 05 MSG_TEXT Pic X(16) Value "API returned RC ". 05 MSG_RC PIC -ZZ9. 01 ADK-ERROR PIC S9(1) Comp Value 0. 01 INPUT-MSG. 03 IN-LL PIC S9(4) COMP. 03 IN-ZZ PIC S9(4) COMP. 03 IN-TC PIC X(8). 01 OUTPUT-MSG. 03 OUT-LL PIC S9(4) COMP VALUE +47. 03 OUT-ZZ PIC S9(4) COMP VALUE +0. 03 OUT-TC PIC X(08). 03 OUT-MESSAGE PIC X(35). LINKAGE SECTION. 01 IOPCB. 03 IO-LTERM-NAME PIC X(8). 03 FILLER PIC X(2). 03 IO-STCODE PIC X(2). 03 IO-C-DATE PIC S9(7) COMP-3. 03 IO-C-TIME PIC S9(7) COMP-3. 03 IO-INSEQ-NUM PIC S9(3) COMP. 03 FILLER PIC X(2). 03 IO-MOD-NAME PIC X(8). 03 IO-USER-ID PIC X(8). PROCEDURE DIVISION. ENTRY 'DLITCBL' USING IOPCB. CALL 'CBLTDLI' USING GU, IOPCB, INPUT-MSG IF IO-STCODE NOT = SPACES * ---------------------------------------------------------------- * Error on GU Call * ---------------------------------------------------------------- MOVE "GU Error" TO MSG_API MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------- * Start an initial path for this transaction. * ---------------------------------------------------------------- * ---------------------------------------------------------------- * Note that a transaction that receives a tag from a program * running on another platform should start a linked path instead * so it can set a tag. For an example, see subroutine SUB1 * below. * ---------------------------------------------------------------- CALL "DTSPTF", USING PATHNAME, PATHNAME_LEN, PATHNAME_CCSID RETURNING RC. IF RC NOT EQUAL ZERO MOVE "DTSPTF" TO MSG_API MOVE RC TO MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------- * Note: * Any activity that occurs in this transaction between a start * path or start linked path API and the next DTEP API will be * associated with the started path. Optionally, insert link APIs * can be used to create tags to represent subpaths for children * of this transaction. The IMS agent automatically tags IMS * transactions started by program switch requests made by any * traced transaction, so insert link is typically used to tag * service requests made to programs running on non-IMS platforms. * ---------------------------------------------------------------- * ---------------------------------------------------------------- * Insert a link for a child path to trace a service request to a * program that will run on another platform. The tag length must * be initialized to the size of the buffer to hold the tag that * will be returned. * ---------------------------------------------------------------- MOVE TAG_BUFFER_LEN TO TAG_LEN. CALL "DTILTF", USING TAG_BUFFER, TAG_LEN RETURNING RC. IF RC NOT EQUAL ZERO MOVE "DTILTF" TO MSG_API MOVE RC TO MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------- * Note: * Pass the tag that was obtained above to the service to identify * the path that it will set to report its activity. * ---------------------------------------------------------------- * ---------------------------------------------------------------- * End the initial path early because one transaction can't be * linked to two paths at once. Normally this API would be used * when the transaction is finished or when it wants to start * another path to trace a new unit of work. * ---------------------------------------------------------------- CALL "DTEP" RETURNING RC. IF RC NOT EQUAL ZERO MOVE "DTEP" TO MSG_API MOVE RC TO MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------- * To avoid the inconvenience of defining additional transactions * and programs, we will call an embedded subroutine here instead * of making a request to an external service. * ---------------------------------------------------------------- * ---------------------------------------------------------------- * Perform some calculations * ---------------------------------------------------------------- CALL "SUB1" USING TAG_BUFFER, TAG_LEN RETURNING RC. * ---------------------------------------------------------------- * Send a message to the terminal and return to IMS. * ---------------------------------------------------------------- IF ADK-ERROR = 1 MOVE TERM_MSG_ERROR TO OUT-MESSAGE ELSE MOVE TERM_MSG TO OUT-MESSAGE. CALL 'CBLTDLI' USING ISRT IOPCB OUTPUT-MSG IF IO-STCODE NOT = SPACES * ---------------------------------------------------------------- * Error on ISRT Call * ---------------------------------------------------------------- MOVE "ISRT Error" TO MSG_API DISPLAY ERROR_MSG UPON CONSOLE. GOBACK. IDENTIFICATION DIVISION. PROGRAM-ID. SUB1. DATA DIVISION. WORKING-STORAGE SECTION. 77 NODENAME Pic X(8) Value "TESTPROG". 77 NAMELEN Pic S9(9) Comp Value 8. 77 ARGUMENT Pic X(6) Value "Hello.". 77 ARGLEN Pic S9(9) Comp Value 6. 77 ARGCCSID Pic S9(9) Comp Value 0. 77 RC8 Pic S9(9) Comp Value 8. 77 RC Pic S9(9) Comp. 77 TOKEN Pic S9(9) Comp. 01 ADK-ERROR PIC 9(1) VALUE 0. 01 ERROR_MSG. 05 MSG_API PIC X(10). 05 MSG_TEXT PIC X(16) VALUE "API returned RC ". 05 MSG_RC PIC -ZZ9. LINKAGE SECTION. 77 TAG PIC X(100). 77 TAGLEN PIC S9(9) COMP. PROCEDURE DIVISION USING TAG, TAGLEN. * ---------------------------------------------------------------* * Start the linked path. If your IMS transaction receives a * dynaTrace tag from another platform, a DTSLP* API is all that * is required to trace the transaction and any other IMS * transactions that it starts through a supported protocol. * ---------------------------------------------------------------* CALL "DTSLPTF" USING TAG, TAGLEN RETURNING RC. IF RC NOT EQUAL ZERO MOVE "DTSLPTF" TO MSG_API MOVE RC TO MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * -------------------------------------------------------------* * Simulate calling another program by inserting another node * into the Purepath here. A Data Capture API is used to specify * a string argument. Note that these functions are unrelated * to the tagging functions that are also being demonstrated * elsewhere in this program. * * The token value must be retained and supplied on the matching * Exit API. If nested nodes are created, each will have its own * token and the most recent one must be exited first. * * Start by capturing an argument for the simulated program node. * -------------------------------------------------------------* Call "DTDCTF" Using ARGUMENT, ARGLEN, ARGCCSID Returning RC. If RC Not Equal ZERO MOVE "DTDCTF" to MSG_API MOVE RC to MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * -------------------------------------------------------------* * Enter the simulated program. * -------------------------------------------------------------* Call "DTENTF" Using NODENAME, NAMELEN, TOKEN Returning RC. If RC Not Equal ZERO MOVE "DTENTF" to MSG_API MOVE RC to MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------* * The application work associated with this program goes here. * ---------------------------------------------------------------* Move RC8 to RETURN-CODE. * -------------------------------------------------------------* * End the program node that we added with a return code 8. * * Start by capturing the return value. * -------------------------------------------------------------* Call "DTDCI" Using RC8 Returning RC. If RC Not Equal ZERO MOVE "DTDCI" to MSG_API MOVE RC to MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * -------------------------------------------------------------* * Exit from the simulated program using the token from the most * recent Enter API. * -------------------------------------------------------------* Call "DTEX" Using TOKEN Returning RC. If RC Not Equal ZERO MOVE "DTEX" to MSG_API MOVE RC to MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. * ---------------------------------------------------------------* * End the linked path before returning. * ---------------------------------------------------------------* CALL "DTEP" RETURNING RC. IF RC NOT EQUAL ZERO MOVE "DTEP" TO MSG_API MOVE RC TO MSG_RC MOVE 1 TO ADK-ERROR DISPLAY ERROR_MSG UPON CONSOLE. GOBACK. END PROGRAM SUB1. END PROGRAM ADKCOBOL.