![[Contents]](FIGURE/CONTENT.GIF)
OpenTP1 Version 7 Programming Reference COBOL Language
![[Index]](FIGURE/INDEX.GIF)
![[Back]](FIGURE/FRONT.GIF)
![[Next]](FIGURE/AFTER.GIF)
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]](FIGURE/ZU060500.GIF)
This section presents a coding example based on the configuration sample shown in the figure.
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.
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.
All Rights Reserved. Copyright (C) 2006, 2010, Hitachi, Ltd.