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)
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.