IDENTIFICATION DIVISION.
       PROGRAM-ID.                  GETSTOCK.
       AUTHOR.                      RICH SMRCINA.
       INSTALLATION.                VM ASSIST, INC.
       DATE-WRITTEN.                DECEMBER, 2005.
      *****************************************************************
      *    THIS PROGRAM WILL CALL A WEB SERVICE TO GET A STOCK QUOTE  *
      *****************************************************************
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  MISCELLANEOUS.
           05  COMMAND-LINE.
               10 FILLER               PIC X(5)  VALUE SPACES.
               10 INPUT-SYMBOL         PIC X(5)  VALUE SPACES.
           05  COMMAND-LENGTH          PIC S9(4) COMP  VALUE +10.
           05  MESSAGE1-LENGTH         PIC S9(4) COMP  VALUE +35.
           05  MESSAGE2-LENGTH         PIC S9(4) COMP  VALUE +18.
           05  MESSAGE3-LENGTH         PIC S9(4) COMP  VALUE +281.
           05  TS-QUEUE-LENGTH-OUT     PIC S9(4) COMP  VALUE +2000.
           05  TS-QUEUE-LENGTH-IN      PIC S9(4) COMP  VALUE +45.
           05  ENC-DEC-COMMAREA-LENGTH PIC S9(4) COMP  VALUE +420.
           05  COMMAND-RESPONSE        PIC S9(8) COMP  VALUE +0.
           05  COMMAND-RESPONSE2       PIC S9(8) COMP  VALUE +0.
       01  MESSAGE1.
           05  FILLER                  PIC X(21)
               VALUE 'The quote for symbol '.
           05  MSG-SYMBOL              PIC X(5)  VALUE SPACES.
           05  FILLER                  PIC X(4)  VALUE ' is '.
           05  MSG-VALUE               PIC X(5)  VALUE SPACES.
       01  MESSAGE2.
           05  FILLER                  PIC X(20)
               VALUE 'No symbol entered.'.
       01  MESSAGE3.
           05  FILLER                  PIC X(21)
               VALUE 'SOAP fault returned: '.
           05  MSG3                    PIC X(260).
      *  SOAP Parameter TS-Queue data area.
       01  SOAP-PARAM-HDR.
           05  NAME                    PIC X(16) VALUE SPACES.
           05  TYPENAME                PIC X(16) VALUE SPACES.
           05  PARAM-LENGTH            PIC 9(8)  COMP.
           05  TYPECODE                PIC 9(8)  COMP.
           05  PARAMETER.
               10 PARAMETER-FIRST-FIVE PIC X(5).
               10 FILLER               PIC X(1995).
      *  SOAP Encoder/Decoder COMMAREA.
       01  SOAP-DEC-PARAM.
           05  URL                     PIC X(128) VALUE SPACES.
           05  METHOD                  PIC X(16)  VALUE SPACES.
           05  URN                     PIC X(128) VALUE SPACES.
           05  INQUEUE.
               10 CICS-TASKNUM-I       PIC 9(7).
               10 FILLER               PIC X     VALUE 'I'.
           05  OUTQUEUE.
               10 CICS-TASKNUM-O       PIC 9(7).
               10 FILLER               PIC X     VALUE 'O'.
           05  FILLER                  PIC X(128) VALUE SPACES.
           05  PROXYTYPE               PIC 9(8)  COMP VALUE 0.
       PROCEDURE DIVISION.
       0000-MAINLINE.
      *  Get Zip Code from the transaction invocation.
           EXEC CICS RECEIVE INTO (COMMAND-LINE) LENGTH(COMMAND-LENGTH)
               END-EXEC.
           IF INPUT-SYMBOL = SPACES OR INPUT-SYMBOL = LOW-VALUES
               PERFORM 0100-WRITE-ERRMSG THRU 0100-EXIT
               GO TO 0000-DONE.
      *  Fill in the parameter information.
           MOVE INPUT-SYMBOL TO MSG-SYMBOL, PARAMETER.
           MOVE 'symbol' TO NAME.
           MOVE 'string' TO TYPENAME.
           MOVE 10 TO TYPECODE.
      *  Determine symbol length
           COMPUTE PARAM-LENGTH = ( COMMAND-LENGTH - 5 ) + 40
      *  Set up the queue names and write out the parameter.
           MOVE EIBTASKN TO CICS-TASKNUM-O, CICS-TASKNUM-I.
           EXEC CICS WRITEQ TS QUEUE(INQUEUE)
               FROM(SOAP-PARAM-HDR)
               LENGTH(TS-QUEUE-LENGTH-IN)
               RESP(COMMAND-RESPONSE)
               END-EXEC.
           IF COMMAND-RESPONSE NOT EQUAL DFHRESP(NORMAL)
               MOVE 'WRITEQ ERROR' TO MESSAGE2
               PERFORM 0100-WRITE-ERRMSG THRU 0100-EXIT
               GO TO 0000-DONE.
      *  Clear out SOAP-PARAM-HDR for the response.
           MOVE SPACES TO SOAP-PARAM-HDR.
      *  Set up encoder/decoder commarea.
           MOVE 'http://64.124.140.30:80/soap' TO URL.
           MOVE 'getQuote' TO METHOD.
           MOVE 'urn:xmethods-delayed-quotes' TO URN.
      *  Call the encoder.
           EXEC CICS LINK PROGRAM('IESSOAPE')
               LENGTH(ENC-DEC-COMMAREA-LENGTH)
               COMMAREA(SOAP-DEC-PARAM)
               RESP(COMMAND-RESPONSE)
               RESP2(COMMAND-RESPONSE2)
               END-EXEC.
      *  Retrieve the SOAP Service response from TS.
           EXEC CICS READQ TS QUEUE(OUTQUEUE)
               INTO(SOAP-PARAM-HDR)
               LENGTH(TS-QUEUE-LENGTH-OUT)
               RESP(COMMAND-RESPONSE)
               END-EXEC.
           IF COMMAND-RESPONSE NOT EQUAL DFHRESP(NORMAL)
               MOVE 'READQ ERROR' TO MESSAGE2
               PERFORM 0100-WRITE-ERRMSG THRU 0100-EXIT
               GO TO 0000-DONE.
      *  Delete the temporary storage queues.
           EXEC CICS DELETEQ TS QUEUE(INQUEUE)
               END-EXEC.
           EXEC CICS DELETEQ TS QUEUE(OUTQUEUE)
               END-EXEC.
      *  Check for a SOAP fault.
           IF PARAMETER-FIRST-FIVE EQUAL 'fault' THEN
               MOVE PARAMETER TO MSG3
               EXEC CICS SEND TEXT
                   ERASE
                   FROM(MESSAGE3)
                   LENGTH(MESSAGE3-LENGTH)
                   END-EXEC
               GO TO 0000-DONE.
      *  Move the response to the message output area and display it.
           MOVE PARAMETER TO MSG-VALUE.
           EXEC CICS SEND TEXT
               ERASE
               FROM(MESSAGE1)
               LENGTH(MESSAGE1-LENGTH)
               END-EXEC.
       0000-DONE.
           EXEC CICS RETURN
                END-EXEC.
       0000-EXIT.
      *
       0100-WRITE-ERRMSG.
           EXEC CICS SEND TEXT
               ERASE
               FROM(MESSAGE2)
               LENGTH(MESSAGE2-LENGTH)
               END-EXEC.
       0100-EXIT.
      *
           GOBACK.