IDENTIFICATION DIVISION.
       PROGRAM-ID.                  SOAPWRAP.
       AUTHOR.                      RICH SMRCINA.
       INSTALLATION.                VM ASSIST, INC.
       DATE-WRITTEN.                MARCH, 2005.
      *****************************************************************
      *    THIS PROGRAM IS USED AS A WRAPPER FOR CALLING A CICS       *
      *    PROGRAM AS A WEB SERVICE.                                  *
      *****************************************************************
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  MISCELLANEOUS.
           05  TS-QUEUE-LENGTH-OUT     PIC S9(4) COMP  VALUE +62.
           05  TS-QUEUE-LENGTH-IN      PIC S9(4) COMP  VALUE +42.
           05  LISTSTAD-CA-LENGTH      PIC S9(4) COMP  VALUE +22.
           05  COMMAND-RESPONSE        PIC S9(8) COMP  VALUE +0.
           05  COMMAND-RESPONSE2       PIC S9(8) COMP  VALUE +0.
           05  METHOD-UPCASE           PIC X(16) VALUE SPACES.
       01  MESSAGES.
           05  MSG1 PIC X(19) VALUE 'INVALID METHOD NAME'.
           05  MSG2 PIC X(11) VALUE 'READQ ERROR'.
           05  MSG3 PIC X(17) VALUE 'METHOD CALL ERROR'.
           05  MSG4 PIC X(12) VALUE 'WRITEQ ERROR'.
      *  SOAP Parameter TS-Queue data area.
       01  SOAP-PARAM-HDR.
           05  PNAME                   PIC X(16) VALUE SPACES.
           05  TYPENAME                PIC X(16) VALUE SPACES.
           05  PLENGTH                 PIC 9(8)  COMP.
           05  TYPECODE                PIC 9(8)  COMP.
           05  PARAMETER.
               10 PARM-STATE-CODE      PIC X(2)  VALUE SPACES.
               10 FILLER               PIC X(20) VALUE SPACES.
       01  LISTSTAD-COMMAREA.
           05  STATE-CODE              PIC XX.
           05  STATE-DESC              PIC X(20).
       LINKAGE SECTION.
       01  DFHCOMMAREA.
      *  SOAP Program Parameters.
           05  METHOD                  PIC X(16).
           05  INQUEUE                 PIC X(8).
           05  OUTQUEUE                PIC X(8).
           05  FILLER                  PIC X(128).
           05  RET-CODE                PIC 9(8) COMP.
       PROCEDURE DIVISION.
       0000-MAINLINE.
      *  The method name received needs to be converted to upper case
           MOVE FUNCTION UPPER-CASE(METHOD) TO METHOD-UPCASE.
           IF METHOD-UPCASE NOT EQUAL 'LISTSTAD' THEN
               EXEC CICS WRITE OPERATOR
                   TEXT(MSG1) TEXTLENGTH(19)
                   END-EXEC
               MOVE 4 TO RET-CODE
               GO TO 0000-DONE.
      *  Read the SOAP request parameters from TS.
           EXEC CICS READQ TS QUEUE(INQUEUE)
               INTO(SOAP-PARAM-HDR)
               LENGTH(TS-QUEUE-LENGTH-IN)
               RESP(COMMAND-RESPONSE)
               END-EXEC.
           IF COMMAND-RESPONSE NOT EQUAL DFHRESP(NORMAL)
               EXEC CICS WRITE OPERATOR
                   TEXT(MSG2) TEXTLENGTH(11)
                   END-EXEC
               MOVE 4 TO RET-CODE
               GO TO 0000-DONE.
      *  Move parameter from SOAP call to COMMAREA.
           MOVE PARM-STATE-CODE TO STATE-CODE.
      *  Call the program identified in the method name.
           EXEC CICS LINK PROGRAM(METHOD-UPCASE)
               COMMAREA(LISTSTAD-COMMAREA)
               LENGTH(LISTSTAD-CA-LENGTH)
               END-EXEC.
           IF COMMAND-RESPONSE NOT EQUAL DFHRESP(NORMAL)
               EXEC CICS WRITE OPERATOR
                   TEXT(MSG3) TEXTLENGTH(17)
                   END-EXEC
               MOVE 4 TO RET-CODE
               GO TO 0000-DONE.
      *  Fill in the queue record for the return value.
           MOVE 'return' TO PNAME.
           MOVE 'string' TO TYPENAME.
           MOVE TS-QUEUE-LENGTH-OUT TO PLENGTH.
           MOVE 10 TO TYPECODE.
           MOVE LISTSTAD-COMMAREA TO PARAMETER.
      *  Write the return value to the output queue.
           EXEC CICS WRITEQ TS QUEUE(OUTQUEUE)
               FROM(SOAP-PARAM-HDR)
               LENGTH(TS-QUEUE-LENGTH-OUT)
               RESP(COMMAND-RESPONSE)
               END-EXEC.
           IF COMMAND-RESPONSE NOT EQUAL DFHRESP(NORMAL)
               EXEC CICS WRITE OPERATOR
                   TEXT(MSG4) TEXTLENGTH(12)
                   END-EXEC
               MOVE 4 TO RET-CODE
               GO TO 0000-DONE.
           MOVE 0 TO RET-CODE.
       0000-DONE.
           EXEC CICS RETURN
               END-EXEC.
       0000-EXIT.
      *
           GOBACK.