OpenTP1 Version 7 Programming Reference COBOL Language

[Contents][Index][Back][Next]

6.2 Coding samples for client/server UAPs (SPP TAM access)

The figure below shows an example of a client/server configuration UAP. This section presents only an SPP coding sample. This example assumes that the same SUP as in 6.1 Coding samples for client/server configuration UAPs (SUP, SPP DAM access) requests this SPP for service.

Figure 6-2 Client/server UAP configuration sample (TAM access)

[Figure]

This section presents a coding example based on the configuration sample shown in the figure.

Organization of this section
(1) SPP sample (main program)
(2) SPP sample (service program)

(1) SPP sample (main program)

The following shows a coding example for the SPP main program.

  10        *
  20        *********************************************
  30        *  SPP01 main program                       *
  40        *********************************************
  50        *
  60         IDENTIFICATION DIVISION.
  70         PROGRAM-ID. MAIN.
  80        *
  90        *********************************************
 100        *  Set the data area                        *
 110        *********************************************
 120        *
 130         DATA DIVISION.
 140         WORKING-STORAGE SECTION.
 150         01 RPC-ARG.
 160            02 REQ-CODE       PIC  X(8)    VALUE SPACE.
 170            02 STATUS-CODE    PIC  X(5)    VALUE SPACE.
 180            02 FILLER          PIC  X(3).
 190            02 FLAGS          PIC S9(9)   COMP.
 200         PROCEDURE DIVISION.
 210        *
 220        *********************************************
 230        *  RPC-OPEN (start the UAP)                 *
 240        *********************************************
 250        *
 260             MOVE 'OPEN' TO REQ-CODE OF RPC-ARG.
 270             MOVE ZERO   TO FLAGS  OF RPC-ARG.
 280             CALL 'CBLDCRPC' USING RPC-ARG.
 290             IF STATUS-CODE OF RPC-ARG NOT = '00000' THEN
 300                 DISPLAY 'SPP01 : RPC-OPEN FAILED. CODE = '
 310                         STATUS-CODE OF RPC-ARG
 320                 GO TO PROG-END
 330             END-IF.
 340        *
 350        *********************************************
 360        *  RPC-MAINLOOP (start the SPP service)     *
 370        *********************************************
 380        *
 390             MOVE 'MAINLOOP' TO REQ-CODE OF RPC-ARG.
 400             MOVE ZERO     TO FLAGS    OF RPC-ARG.
 410             CALL 'CBLDCRSV' USING RPC-ARG.
 420             IF STATUS-CODE OF RPC-ARG NOT = '00000' THEN
 430                 DISPLAY ' SPP01 : RPC-MAINLOOP FAILED. CODE = '
 440                         STATUS-CODE OF RPC-ARG
 450             END-IF.
 460        *
 470        *********************************************
 480        *  RPC-CLOSE (terminate the UAP)            *
 490        *********************************************
 500        *
 510             MOVE 'CLOSE   ' TO REQ-CODE OF RPC-ARG.
 520             MOVE ZERO       TO FLAGS    OF RPC-ARG.
 530             CALL 'CBLDCRPC' USING RPC-ARG.
 540         PROG-END.
 550        *
 560        *********************************************
 570        *  Terminate processing                     *
 580        *********************************************
 590        *
 600             DISPLAY ' SPP01 : GooD-by!' .
 610             STOP RUN.

(2) SPP sample (service program)

The following shows a coding example for the SPP service program.

  10   *
  20   **************************************************
  30   *  SPP service program  SVR01                    *
  40   **************************************************
  50   *
  60    IDENTIFICATION DIVISION.
  70    PROGRAM-ID. SVR01.
  80   *
  90   **************************************************
 100   *  Set the data area                             *
 110   **************************************************
 120   *
 130    DATA DIVISION.
 140    WORKING-STORAGE SECTION.
 150    01 TAM-ARG1.
 160       02 REQ-CODE       PIC  X(4)    VALUE SPACE.
 170       02 STATUS-CODE    PIC  X(5)    VALUE SPACE.
 180       02 FILLER          PIC  X(3).
 190       02 TABLE-NAME     PIC  X(32)   VALUE SPACE.
 200       02 FILLER         PIC  X(68).
 210       02 BUF-SIZE       PIC S9(4)   COMP VALUE ZERO.
 220       02 FILLER         PIC  X(398).
 230    01 READ-ARG1.
 240       02 DML-KIND       PIC  X(4)    VALUE SPACE.
 250       02 LOK-KIND       PIC  X(1)    VALUE SPACE.
 260       02 FILLER         PIC  X(3).
 270    01 WRITE-ARG1.
 280       02 DML-KIND       PIC  X(4)    VALUE SPACE.
 290       02 FILLER         PIC  X(4).
 300    01 KEY-DATA1         PIC X(10)   VALUE X'00000000000000000001'.
 310    01 KEY-DATA2         PIC X(10)   VALUE X'00000000000000000002'.
 320    01 KEY-DATA4         PIC X(10)   VALUE X'00000000000000000004'.
 330    01 KEY-ARG.
 340       02 KEYNAME        PIC X(10)   VALUE SPACE.
 350    01 W-BUFFER.
 360       02 KEYNAME        PIC X(10)   VALUE SPACE.
 370       02 DATAREA        PIC  X(118)  VALUE SPACE.
 380    LINKAGE SECTION.
 390       77 IN-DATA        PIC X(118).
 400       77 IN-LENG        PIC S9(9)   COMP.
 410       77 OUT-DATA       PIC X(32).
 420       77 OUT-LENG       PIC S9(9)   COMP.
 430    PROCEDURE DIVISION USING IN-DATA IN-LENG OUT-DATA OUT-LENG.
 440        DISPLAY ' SVR01:PROCEDURE START' .
 450   *
 460   **************************************************
 470   *  TAM_READ (read the first record from the     *
       *  TAM table)                                    *
 480   **************************************************
 490   *
 500        MOVE 'tamtable30' TO TABLE-NAME  OF TAM-ARG1.
 510        MOVE 128         TO BUF-SIZE     OF TAM-ARG1.
 520        MOVE 'FCHU'      TO DML-KIND     OF READ-ARG1.
 530        MOVE KEY-DATA1   TO KEY-ARG.
 540         CALL 'CBLDCTAM' USING TAM-ARG1 READ-ARG1 KEY-ARG W-BUFFER.
 550         IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN
 560             DISPLAY 'SVR01:TAM-READ FAILED. CODE = '
 570                     STATUS-CODE OF TAM-ARG1
 580             MOVE 'SVR01: TAM READ FAILED' TO OUT-DATA
 590             MOVE 22 TO OUT-LENG
 600             GO TO PROG-END
 610         END-IF.
 620    *
 630    *************************************************
 640    * TAM_REWRITE (update the first record of       *
        * TAM table on the assumption of entry)        *
 650    *************************************************
 660    *
 670         MOVE 'MFY '       TO DML-KIND    OF WRITE-ARG1.
 680         MOVE IN-DATA      TO DATAREA     OF W-BUFFER.
 690         CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER.
 700         IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN
 710             DISPLAY 'SVR01:TAM-REWRITE FAILED. CODE = '
 720                     STATUS-CODE OF TAM-ARG1
 730             MOVE 'SVR01: TAM REWRITE FAILED' TO OUT-DATA
 740             MOVE 25 TO OUT-LENG
 750             GO TO PROG-END
 760         END-IF.
 770    *
 780    *************************************************
 790    *  TAM_WRITE (update the second record of       *
        * TAM table)                                    *
 800    *************************************************
 810    *
 820         MOVE 'MFY '      TO DML-KIND OF WRITE-ARG1.
 830         MOVE KEY-DATA2   TO KEY-ARG.
 840         MOVE KEY-DATA2   TO KEYNAME OF W-BUFFER.
 850         MOVE IN-DATA     TO DATAREA OF W-BUFFER.
 860         CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER.
 870         IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN
 880             DISPLAY 'SVR01:TAM-WRITE FAILED. CODE = '
 890                     STATUS-CODE OF TAM-ARG1
 900             MOVE 'SVR01: TAM WRITE FAILED' TO OUT-DATA
 910             MOVE 23 TO OUT-LENG
 920             GO TO PROG-END
 930         END-IF.
 940    *
 950    *************************************************
 960    *  TAM-DELETE(delete the fourth record of       *
        * the TAM table)                                *
 970    *************************************************
 980    *
 990         MOVE 'ERS '    TO DML-KIND OF WRITE-ARG1.
1000         MOVE KEY-DATA4 TO KEY-ARG.
1010         CALL 'CBLDCTAM' USING TAM-ARG1 WRITE-ARG1 KEY-ARG W-BUFFER.
1020         IF STATUS-CODE OF TAM-ARG1 NOT = '00000' THEN
1030             DISPLAY 'SVR01:TAM-DELETE FAILED. CODE = '
1040                     STATUS-CODE OF TAM-ARG1
1050             MOVE 'SVR01: TAM DELETE FAILED' TO OUT-DATA
1060             MOVE 24 TO OUT-LENG
1070         END-IF.
1080     PROG-END.
1090    *
1100    *************************************************
1110    *  Terminate processing                         *
1120    *************************************************
1130    *
1140         DISPLAY 'SVR01:GooD-by!'.
1150         EXIT PROGRAM.