       IDENTIFICATION DIVISION.
       PROGRAM-ID.    IMSCLAIM.
       AUTHOR.        YVES TOLOD.
       INSTALLATION.  ESYSMVS1
      ******************************************************************
      * (c) Copyright IBM Corp. 2020 All Rights Reserved               *
      *                                                                *
      * Licensed under the Apache License, Version 2.0 which you can   *
      * read at https://www.apache.org/licenses/LICENSE-2.0            *
      *                                                                *
      * Sample IMS COBOL program that calls an external REST API. The  *
      * API can be hosted on Node.js on z/OS or using the IBM CloudPak *
      * for Applications. The REST API is called using the z/OS        *
      * CONNECT V3 API Requester function.                             *
      *                                                                *
      ******************************************************************
       ENVIRONMENT DIVISION.
      ***********************
       DATA DIVISION.
      ****************
       WORKING-STORAGE SECTION.
      **************************
      *
      ******************************************************************
      * INCLUDE THE COPYBOOK FOR z/OS CONNECT API REQUESTER
      ******************************************************************
       COPY BAQRINFO.
      ******************************************************************
      * INLCUDE THE COPYBOOK FOR THE API REQUEST / RESPONSE
      * AND API INFO FILE (GENERATED BY THE ZCONBT UTILITY)
      ******************************************************************
       01  REQUEST.
           COPY CLAIMREQ.
       01  RESPONSE.
           COPY CLAIMRSP.
       01  API-INFO.
           COPY CLAIMINF.
      ******************************************************************
      * INCLUDE THE COPYBOOK FOR REQUEST AND RESPONSE DATA STRUCTURE
      * OF THE CLAIMS PROGRAM.
      ******************************************************************
       COPY IMSCLAIC.
      ******************************************************************
      * DECLARE THE WORKING STORAGE VARIABLES FOR API REQUESTER
      ******************************************************************
       01 BAQ-REQUEST-PTR           USAGE POINTER.
       01 BAQ-REQUEST-LEN           PIC S9(9) COMP-5 SYNC.
       01 BAQ-RESPONSE-PTR          USAGE POINTER.
       01 BAQ-RESPONSE-LEN          PIC S9(9) COMP-5 SYNC.
       77 COMM-STUB-PGM-NAME        PIC X(8) VALUE 'BAQCSTUB'.
       77 COMM-TERM-PGM-NAME        PIC X(8) VALUE 'BAQCTERM'.
      ******************************************************************
      * DECLARE THE WORKING STORAGE VARIABLES SPECIFIC TO IMS
      ******************************************************************
       77 DLI-GET-UNIQUE            PIC X(4) VALUE 'GU  '.
       77 DLI-GET-NEXT              PIC X(4) VALUE 'GN  '.
       77 DLI-INSERT                PIC X(4) VALUE 'ISRT'.
       77 DLI-MESSAGE-EXISTS        PIC X(2) VALUE 'CF'.
       77 DLI-END-SEGMENTS          PIC X(2) VALUE 'QD'.
       77 DLI-END-MESSAGES          PIC X(2) VALUE 'QC'.
      ******************************************************************
      * DECLARE THE WORKING STORAGE VARIABLES USED IN THIS PROGRAM
      ******************************************************************
       01 API-STATUS-MESSAGE.
          05 OUT-API-STATUS-CODE    PIC S9(9) COMP-5.
          05 OUT-API-STATUS-MSGLEN  PIC S9(9) COMP-5.
          05 OUT-API-STATUS-MESSAGE PIC X(1024).
       01 CLAIM-TEMP-AMOUNT         PIC S9(7)V9(2) COMP-3.
       01 WS-LOG-MESSAGE            PIC X(80).
       01 WS-TEMP-TS.
          05 WS-TEMP-DATE-TIME.
             10 WS-TEMP-DATE.
                15 WS-TEMP-YEAR     PIC 9(4).
                15 WS-TEMP-MONTH    PIC 9(2).
                15 WS-TEMP-DAY      PIC 9(2).
             10 WS-TEMP-TIME.
                15 WS-TEMP-HOUR     PIC 9(2).
                15 WS-TEMP-MIN      PIC 9(2).
                15 WS-TEMP-SEC      PIC 9(2).
                15 WS-TEMP-MS       PIC 9(2).
             10 WS-DIFF-GMT         PIC S9(4).
       01 WS-FORMATTED-TS.
          05 WS-FORMATTED-DATE-TIME.
             10 WS-FORMATTED-YEAR   PIC 9(4).
             10 FILLER              PIC X VALUE '-'.
             10 WS-FORMATTED-MONTH  PIC 9(2).
             10 FILLER              PIC X VALUE '-'.
             10 WS-FORMATTED-DAY    PIC 9(2).
             10 FILLER              PIC X VALUE ' '.
             10 WS-FORMATTED-HOUR   PIC 9(2).
             10 FILLER              PIC X VALUE ':'.
             10 WS-FORMATTED-MIN    PIC 9(2).
             10 FILLER              PIC X VALUE ':'.
             10 WS-FORMATTED-SEC    PIC 9(2).
             10 FILLER              PIC X VALUE ':'.
             10 WS-FORMATTED-MS     PIC 9(2).
      *
       LINKAGE SECTION.
      ******************
       01 IO-PCB-MASK.
          05 IO-PCB-LTERM          PIC X(8).
          05 FILLER                PIC XX.
          05 IO-PCB-STATUS-CODE    PIC XX.
          05 IO-PCB-DATE           PIC S9(7) COMP-3.
          05 IO-PCB-TIME           PIC S9(6)V9 COMP-3.
          05 IO-PCB-MSG-SEG-NUMBER PIC S9(5) COMP.
          05 IO-PCB-MOD-NAME       PIC X(8).
          05 IO-PCB-USER-ID        PIC X(8).
      ******************************************************************
      * MAIN PROGRAM
      ******************************************************************
       PROCEDURE DIVISION USING IO-PCB-MASK.
       DO-MAIN SECTION.

           MOVE 'PROGRAM CALLED' TO WS-LOG-MESSAGE
           PERFORM LOG-MESSAGE
           PERFORM GET-INPUT-MESSAGE
           PERFORM UNTIL IO-PCB-STATUS-CODE     = DLI-END-MESSAGES
                   OR    IO-PCB-STATUS-CODE NOT = SPACES
             PERFORM CALL-API
             PERFORM SET-OUTPUT-MESSAGE
             PERFORM GET-INPUT-MESSAGE
           END-PERFORM
           GOBACK
           .
      ******************************************************************
      * ROUTINE TO CALL API USING Z/OS CONNECT EE
      ******************************************************************
       CALL-API.
      *
           INITIALIZE REQUEST.
           INITIALIZE RESPONSE.
      ******************************************************************
      * SET POINTER AND LENGTH TO SPECIFY THE LOCATION OF REQUEST
      * AND RESPONSE SEGMENT
      ******************************************************************
           SET BAQ-REQUEST-PTR TO ADDRESS OF REQUEST
           MOVE LENGTH OF REQUEST TO BAQ-REQUEST-LEN
           SET BAQ-RESPONSE-PTR TO ADDRESS OF RESPONSE
           MOVE LENGTH OF RESPONSE TO BAQ-RESPONSE-LEN
      ******************************************************************
      * USE Z/OS CONNECT TO CALL REST API TO EVALUATE CLAIM BASED
      * ON BUSINESS RULES
      ******************************************************************
           MOVE IN-CLAIM-AMOUNT TO CLAIM-TEMP-AMOUNT
           MOVE IN-CLAIM-TYPE TO claimType OF REQUEST
           MOVE CLAIM-TEMP-AMOUNT TO claimAmount OF REQUEST

           EVALUATE IN-CLAIM-TYPE
             WHEN 'DRUG'
               MOVE 4 TO claimType-length
             WHEN 'DENTAL'
               MOVE 6 TO claimType-length
             WHEN 'MEDICAL'
               MOVE 7 TO claimType-length
             WHEN OTHER
               MOVE 7 TO claimType-length
               MOVE 'MEDICAL' TO claimType OF REQUEST
           END-EVALUATE
      ******************************************************************
      * CALL API CLIENT CODE THAT WAS GENERATED BY THE BUILD TOOLKIT
      * THIS IS USED TO PASS PARAMETER AND RECEIVE RESULTS FOR THE
      * REST API THAT WILL BE INVOKED BY z/OS CONNECT.
      ******************************************************************
           CALL COMM-STUB-PGM-NAME USING
                BY REFERENCE API-INFO
                BY REFERENCE BAQ-REQUEST-INFO
                BY REFERENCE BAQ-REQUEST-PTR
                BY REFERENCE BAQ-REQUEST-LEN
                BY REFERENCE BAQ-RESPONSE-INFO
                BY REFERENCE BAQ-RESPONSE-PTR
                BY REFERENCE BAQ-RESPONSE-LEN
      ******************************************************************
      * CHECK IF THE API CALL WAS SUCCESSFUL AND EVALUATE IF THE
      * CLAIM WAS ACCEPTED OR REQUIRES FURTHER REVIEW AND SET
      * THE STATUS TO 'OKAY' OR 'PEND'.
      ******************************************************************
           IF BAQ-SUCCESS THEN
              IF Xstatus2(1:Xstatus2-length) = 'Accepted'
                 MOVE IN-CLAIM-TYPE TO OUT-CLAIM-TYPE
                 MOVE 'ACCEPTED' TO OUT-CLAIM-STATUS
                 MOVE IN-CLAIM-DESC TO OUT-CLAIM-DESC
                 MOVE IN-CLAIM-AMOUNT TO OUT-CLAIM-AMOUNT
                 MOVE 'CLAIM WAS PROCESSED'
                     TO OUT-MESSAGE
              ELSE
                 MOVE IN-CLAIM-TYPE TO OUT-CLAIM-TYPE
                 MOVE 'REJECTED' TO OUT-CLAIM-STATUS
                 MOVE IN-CLAIM-DESC TO OUT-CLAIM-DESC
                 MOVE IN-CLAIM-AMOUNT TO OUT-CLAIM-AMOUNT
                 MOVE 'CLAIM NEED FURTHER REVIEW'
                     TO OUT-MESSAGE
              END-IF
      ******************************************************************
      * OTHERWISE AN ERROR OCCURED WHEN CALLING THE REST API
      * CHECK THE BAQ-STATUS-CODE AND BAQ-STATUS-MESSAGE FOR
      * DETAILS OF THE ERROR.  SET THE STATUS TO 'PEND'.
      ******************************************************************
           ELSE
              EVALUATE TRUE
      ******************************************************************
      * WHEN ERROR HAPPENS IN API, BAQ-RETURN-CODE IS BAQ-ERROR-IN-API.
      * BAQ-STATUS-CODE IS THE HTTP RESPONSE CODE OF THE API.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-API
                   STRING 'API ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'API ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)
      ******************************************************************
      * WHEN ERROR HAPPENS IN SERVER, BAQ-RETURN-CODE IS
      * BAQ-ERROR-IN-ZCEE
      * BAQ-STATUS-CODE IS THE HTTP RESPONSE CODE OF
      * Z/OS CONNECT EE SERVER.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-ZCEE
                   STRING 'ZCEE ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'ZCEE ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)
      ******************************************************************
      * WHEN ERROR HAPPENS IN COMMUNICATION STUB, BAQ-RETURN-CODE IS
      * BAQ-ERROR-IN-STUB, BAQ-STATUS-CODE IS THE ERROR CODE OF STUB.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-STUB
                   STRING 'STUB ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'STUB ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)

              END-EVALUATE

              MOVE 'ERROR' TO OUT-CLAIM-STATUS
              MOVE IN-CLAIM-TYPE TO OUT-CLAIM-TYPE
              MOVE IN-CLAIM-AMOUNT TO OUT-CLAIM-AMOUNT
           END-IF.

           STRING OUT-CLAIM-TYPE OUT-MESSAGE DELIMITED BY SIZE
              INTO WS-LOG-MESSAGE END-STRING
           PERFORM LOG-MESSAGE
           MOVE LENGTH OF OUTPUT-MSG TO OUT-LL
           MOVE 0 TO OUT-ZZ
      ******************************************************************
      * CALL THE BAQCTERM FUNCTION TO CLOSE AND CLEAR THE CACHED
      * CONNECTION. IF BAQCTERM IS NOT CALLED WHEN THE APPLICATION IS
      * UNLOADED, THE CONNECTION USED BY BAQCSTUB IS NOT CLOSED AND THE
      * MEMORY IT OWNS IS NOT REUSABLE UNTIL THE IMS OR Z/OS
      * COMMUNICATION PROCESS TERMINATES.
      ******************************************************************
           CALL COMM-TERM-PGM-NAME USING
                BY REFERENCE BAQ-RESPONSE-INFO.

           IF BAQ-SUCCESS THEN
              MOVE 'BAQCSTUB CONNECTION TERMINATED' TO WS-LOG-MESSAGE
              PERFORM LOG-MESSAGE
           ELSE
              EVALUATE TRUE
      ******************************************************************
      * WHEN ERROR HAPPENS IN API, BAQ-RETURN-CODE IS BAQ-ERROR-IN-API.
      * BAQ-STATUS-CODE IS THE HTTP RESPONSE CODE OF THE API.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-API
                   STRING 'API ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'API ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)
      ******************************************************************
      * WHEN ERROR HAPPENS IN SERVER, BAQ-RETURN-CODE IS
      * BAQ-ERROR-IN-ZCEE
      * BAQ-STATUS-CODE IS THE HTTP RESPONSE CODE OF
      * Z/OS CONNECT EE SERVER.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-ZCEE
                   STRING 'ZCEE ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'ZCEE ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)
      ******************************************************************
      * WHEN ERROR HAPPENS IN COMMUNICATION STUB, BAQ-RETURN-CODE IS
      * BAQ-ERROR-IN-STUB, BAQ-STATUS-CODE IS THE ERROR CODE OF STUB.
      ******************************************************************
                 WHEN BAQ-ERROR-IN-STUB
                   STRING 'STUB ERROR: MESSAGE = '
                     BAQ-STATUS-MESSAGE DELIMITED BY SIZE
                     INTO OUT-MESSAGE END-STRING
                   DISPLAY 'STUB ERROR: '
                     BAQ-STATUS-MESSAGE(1:BAQ-STATUS-MESSAGE-LEN)

              END-EVALUATE

              MOVE 'ERROR' TO OUT-CLAIM-STATUS
              MOVE IN-CLAIM-TYPE TO OUT-CLAIM-TYPE
              MOVE IN-CLAIM-AMOUNT TO OUT-CLAIM-AMOUNT
           END-IF
           .
      ******************************************************************
      * ROUTINE TO GET INPUT MESSAGE FROM QUEUE
      ******************************************************************
       GET-INPUT-MESSAGE.
      *
           CALL 'CBLTDLI' USING DLI-GET-UNIQUE IO-PCB-MASK
                                INPUT-MSG
           IF IO-PCB-STATUS-CODE NOT = SPACES AND
              IO-PCB-STATUS-CODE NOT = DLI-END-MESSAGES
             DISPLAY 'GU FAILED WITH IO-PCB-STATUS-CODE('
                     IO-PCB-STATUS-CODE ')'
           END-IF
           .
      ******************************************************************
      * ROUTINE TO RETURN THE OUTPUT MESSAGE
      ******************************************************************
       SET-OUTPUT-MESSAGE.
      *
           CALL 'CBLTDLI' USING DLI-INSERT IO-PCB-MASK
                                OUTPUT-MSG
           IF IO-PCB-STATUS-CODE NOT = SPACES
             DISPLAY 'ISRT FAILED WITH IO-PCB-STATUS-CODE('
                     IO-PCB-STATUS-CODE ')'
           END-IF
           .
      ******************************************************************
      * ROUTINE TO LOG MESSAGE TO STDOUT
      ******************************************************************
       LOG-MESSAGE.
      *
           MOVE FUNCTION CURRENT-DATE TO WS-TEMP-DATE-TIME
           MOVE WS-TEMP-YEAR  TO WS-FORMATTED-YEAR
           MOVE WS-TEMP-MONTH TO WS-FORMATTED-MONTH
           MOVE WS-TEMP-DAY   TO WS-FORMATTED-DAY
           MOVE WS-TEMP-HOUR  TO WS-FORMATTED-HOUR
           MOVE WS-TEMP-MIN   TO WS-FORMATTED-MIN
           MOVE WS-TEMP-SEC   TO WS-FORMATTED-SEC
           MOVE WS-TEMP-MS    TO WS-FORMATTED-MS

           DISPLAY WS-FORMATTED-DATE-TIME ' IMSCLAIM VER 1.0 '
             WS-LOG-MESSAGE(1:40)
           .
       END PROGRAM IMSCLAIM.
