OpenTP1 Version 7 Programming Reference COBOL Language
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.
All Rights Reserved. Copyright (C) 2006, 2010, Hitachi, Ltd.