OpenTP1 Version 7 Programming Reference COBOL Language

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

6.1 Coding samples for client/server UAPs (SUP, SPP DAM access)

The figure below shows an example of a client/server configuration UAP.

Figure 6-1 Client/server UAP configuration sample (DAM access)

[Figure]

Explanation
DAM file damfile0 contains a control section in its first block and data records in the second and subsequent blocks. During service processing, the first block is read (CBLDCDAM('READ')) and is updated (CBLDCDAM('REWT')), then the second and subsequent blocks are directly updated using CBLDCDAM('WRIT').

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

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

(1) SUP sample

The following shows a coding example for SUP.

  10       *
  20       **********************************************
  30       * SUP01                                      *
  40       **********************************************
  50       *
  60        IDENTIFICATION DIVISION.
  70       *
  80        PROGRAM-ID. MAIN.
  90       *
 100       **********************************************
 110       *  Set the data area                         *
 120       **********************************************
 130       *
 140        DATA DIVISION.
 150        WORKING-STORAGE SECTION.
 160        01  RPC-ARG1.
 170            02 REQUEST      PIC X(8) VALUE SPACE.
 180            02 STATUS-CODE  PIC X(5) VALUE SPACE.
 190            02 FILLER       PIC X(3).
 200            02 FLAGS        PIC S9(9) COMP VALUE ZERO.
 210       *
 220        01  RPC-ARG2.
 230            02 REQUEST      PIC X(8) VALUE SPACE.
 240            02 STATUS-CODE  PIC X(5) VALUE SPACE.
 250            02 FILLER       PIC X(3).
 260            02 FLAGS        PIC S9(9) COMP VALUE ZERO.
 270            02 DESCRIPTOR   PIC S9(9) COMP VALUE ZERO.
 280            02 S-NAME       PIC X(32) VALUE SPACE.
 290            02 G-NAME       PIC X(32) VALUE SPACE.
 300       *
 310        01  RPC-ARG3.
 320            02  SEND-DATA-LENG  PIC S9(9) COMP VALUE ZERO.
 330            02  SEND-DATA       PIC X(32) VALUE SPACE.
 340       *
 350        01  RPC-ARG4.
 360            02  RECEIVE-DATA-LENG PIC S9(9) COMP VALUE ZERO.
 370            02  RECEIVE-DATA      PIC X(32) VALUE SPACE.
 380       *
 390        01  ADM-ARG1.
 400            02  REQUEST      PIC X(8) VALUE SPACE.
 410            02  STATUS-CODE  PIC X(5) VALUE SPACE.
 420            02  FILLER       PIC X(3).
 430            02  FLAGS        PIC S9(9) COMP VALUE ZERO.
 440            02  FILLER       PIC X(3).
 450       *
 460        01  TRN-ARG1.
 470            02  REQUEST      PIC X(8) VALUE SPACE.
 480            02  STATUS-CODE  PIC X(5) VALUE SPACE.
 490       *
 500        PROCEDURE DIVISION.
 510       *
 520       **********************************************
 530       * RPC-OPEN (start the UAP)                   *
 540       **********************************************
 550       *
 560        MOVE 'OPEN' TO REQUEST OF RPC-ARG1.
 570         MOVE ZERO   TO FLAGS   OF RPC-ARG1.
 580         CALL 'CBLDCRPC' USING RPC-ARG1.
 590             IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN
 600               DISPLAY 'SUP01:RPC-OPEN FAILED. CODE = '
 610               STATUS-CODE OF RPC-ARG1
 620               GO TO PROG-END
 630             END-IF.
 640        *
 650        *********************************************
 660        * ADM-COMPLETE (report completion of        *
 665        * user server start processing)             *
 670        *********************************************
 680        *
 690         MOVE 'COMPLETE' TO REQUEST OF ADM-ARG1.
 700         CALL 'CBLDCADM' USING ADM-ARG1.
 710             IF STATUS-CODE OF ADM-ARG1 NOT = '00000' THEN
 720               DISPLAY 'SUP01:RPC-COMPLETE FAILED. CODE = '
 730               STATUS-CODE OF ADM-ARG1
 740               GO TO PROG-END
 750             END-IF.
 760        *
 770        *********************************************
 780        * TRN_BEGIN (start the transaction)         *
 790        *********************************************
 800        *
 810         MOVE 'BEGIN' TO REQUEST OF TRN-ARG1.
 820         CALL 'CBLDCTRN' USING TRN-ARG1.
 830             IF STATUS-CODE OF TRN-ARG1 NOT = '00000' THEN
 840               DISPLAY 'SUP01:TRN-BEGIN FAILED. CODE = '
 850               STATUS-CODE OF TRN-ARG1
 860               GO TO TRAN-END
 870             END-IF.
 880        *
 890        *********************************************
 900        *  RPC-CALL (request a remote service)      *
 910        *********************************************
 920        *
 930         MOVE 'CALL'  TO REQUEST OF RPC-ARG2.
 940         MOVE 'SPP01' TO G-NAME  OF RPC-ARG2.
 950         MOVE 'SVR01' TO S-NAME  OF RPC-ARG2.
 960         MOVE 'SUP01:DATA OpenTP1' TO SEND-DATA OF RPC-ARG3.
 970         MOVE 32 TO SEND-DATA-LENG OF RPC-ARG3.
 980         MOVE 32 TO RECEIVE-DATA-LENG  OF RPC-ARG4.
 990         CALL 'CBLDCRPC' USING RPC-ARG2 RPC-ARG3 RPC-ARG4.
1000             IF STATUS-CODE OF RPC-ARG2 NOT = '00000' THEN
1010               DISPLAY 'SUP01:RPC-CALL RETURN CODE = '
1020               STATUS-CODE OF RPC-ARG2
1030               GO TO TRAN-END
1040             END-IF.
1050         DISPLAY 'SERVICE FUNCTION RETURN = ' RECEIVE-DATA.
1060         TRAN-END.
1070        *
1080        *********************************************
1090        * TRN-UNCHAINED-COMMIT                      *
1095        * (commit in unchained mode)                *
1100        *********************************************
1110        *
1120         MOVE 'U-COMMIT' TO REQUEST OF TRN-ARG1.
1130         CALL 'CBLDCTRN' USING TRN-ARG1.
1140             IF STATUS-CODE OF TRN-ARG1 NOT = '00000' THEN
1150               DISPLAY 'SUP01:TRN-UNCHAINED-COMMIT FAILED. CODE = '
1160               STATUS-CODE OF TRN-ARG1
1170             END-IF.
1180         PROG-END.
1190        *
1200        *********************************************
1210        * RPC-CLOSE (terminate the UAP)             *
1220        *********************************************
1230        *
1240         MOVE 'CLOSE' TO REQUEST OF RPC-ARG1.
1250         MOVE ZERO    TO FLAGS   OF RPC-ARG1.
1260         CALL 'CBLDCRPC' USING RPC-ARG1.
1270         DISPLAY 'SUP01:SUP PROCESS ENDED'.
1280         STOP RUN.

(2) 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       *
  80        PROGRAM-ID. MAIN.
  90       *
 100       ********************************************************
 110       * Set the data area                         *
 120       ********************************************************
 130       *
 140        DATA DIVISION.
 150        WORKING-STORAGE SECTION.
 160        01  FD-ID EXTERNAL.
 170            10  FD-SAVE      PIC S9(9) COMP.
 180        01  RPC-ARG1.
 190            02  REQ-CODE     PIC X(8) VALUE SPACE.
 200            02  STATUS-CODE  PIC X(5) VALUE SPACE.
 210            02  FILLER       PIC X(3).
 220            02  FLAGS        PIC S9(9) COMP.
 230        01  DAM-ARG1.
 240            02  REQUEST      PIC X(8) VALUE SPACE.
 250            02  STATUS-CODE  PIC X(5) VALUE SPACE.
 260            02  FILLER       PIC X(3).
 270            02  FILE-NAME    PIC X(8).
 280            02  FILLER       PIC S9(9) COMP.
 290            02  FILLER       PIC S9(9) COMP.
 300            02  FILDES       PIC S9(9) COMP VALUE ZERO.
 310            02  FILLER       PIC X(28).
 320        01  DAM-ARG2.
 330            02  ACCESS-CODE  PIC X(4).
 340            02  FLAG1        PIC X(1).
 350            02  FILLER       PIC X(1).
 360            02  FILLER       PIC X(1).
 370            02  FILLER       PIC X(1).
 380            02  FLAGS        PIC S9(9) COMP VALUE ZERO.
 390       *
 400        PROCEDURE DIVISION.
 410       *
 420       **********************************************
 430       * RPC-OPEN (start the UAP)                   *
 440       **********************************************
 450       *
 460        MOVE 'OPEN' TO REQ-CODE OF RPC-ARG1.
 470        MOVE ZERO   TO FLAGS    OF RPC-ARG1.
 480        CALL 'CBLDCRPC' USING RPC-ARG1.
 490            IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN
 500              DISPLAY 'SPP01:RPC-OPEN FAILED. CODE = '
 510              STATUS-CODE OF RPC-ARG1
 520              GO TO PROG-END
 530            END-IF.
 540       *
 550       **********************************************
 560       * DAM-OPEN (open a logical file)             *
 570       **********************************************
 580       *
 590        MOVE 'DCDAMSVC' TO REQUEST     OF DAM-ARG1.
 600        MOVE 'damfile0' TO FILE-NAME   OF DAM-ARG1.
 610        MOVE 'OPEN'     TO ACCESS-CODE OF DAM-ARG2.
 620        MOVE 'B'        TO FLAG1       OF DAM-ARG2.
 630        CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2.
 640            IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN
 650              DISPLAY 'SPP01:DAM-OPEN FAILED. CODE = '
 660              STATUS-CODE OF DAM-ARG1
 670              GO TO DAM-END
 680            END-IF.
 690        MOVE FILDES TO FD-SAVE.
 700       *
 710       **********************************************
 720       * RPC-MAINLOOP (start the SPP service)       *
 730       **********************************************
 740       *
 750        DISPLAY 'SPP01: MAINLOOP START.'
 760        MOVE 'MAINLOOP' TO REQ-CODE OF RPC-ARG1.
 770        MOVE ZERO       TO FLAGS    OF RPC-ARG1.
 780        CALL 'CBLDCRSV' USING RPC-ARG1.
 790            IF STATUS-CODE OF RPC-ARG1 NOT = '00000' THEN
 800              DISPLAY 'SPP01:RPC-MAINLOOP FAILED. CODE ='
 810              STATUS-CODE OF RPC-ARG1
 820            END-IF.
 830        DAM-END.
 840       *
 850       **********************************************
 860       * DAM-CLOSE (close the logical file)         *
 870       **********************************************
 880       *
 890        MOVE 'damfile0' TO FILE-NAME   OF DAM-ARG1.
 900        MOVE FD-SAVE    TO FILDES      OF DAM-ARG1.
 910        MOVE 'CLOS'     TO ACCESS-CODE OF DAM-ARG2.
 920        CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2.
 930            IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN
 940              DISPLAY 'SPP01:DAM-CLOSE FAILED. CODE = '
 950              STATUS-CODE OF DAM-ARG1
 960            END-IF.
 970        PROG-END.
 980       *
 990       **********************************************
1000       * RPC-CLOSE (terminate the UAP)               *
1010       **********************************************
1020       *
1030        MOVE 'CLOSE' TO REQ-CODE OF RPC-ARG1.
1040        MOVE ZERO    TO FLAGS    OF RPC-ARG1.
1050        CALL 'CBLDCRPC' USING RPC-ARG1.
1060       *
1070       **********************************************
1080       * Terminate processing                       *
1090       **********************************************
1100       *
1110        DISPLAY 'SPP01:Good-by!'
1120        STOP RUN.

(3) 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       *
  80        PROGRAM-ID. SVR01.
  90       *
 100       **********************************************
 110       * Set the data area                          *
 120       **********************************************
 130       *
 140        DATA DIVISION.
 150        WORKING-STORAGE SECTION.
 160        01  FD-ID EXTERNAL.
 170            10  FD-SAVE      PIC S9(9) COMP.
 180        01  DAM-ARG1.
 190            02  REQUEST      PIC X(8) VALUE SPACE.
 200            02  STATUS-CODE  PIC X(5) VALUE SPACE.
 210            02  FILLER       PIC X(3).
 220            02  FILE-NAME    PIC X(8).
 230            02  KEY-NO       PIC S9(9) COMP VALUE ZERO.
 240            02  BUFFER-LEN   PIC S9(9) COMP VALUE ZERO.
 250            02  FILDES       PIC S9(9) COMP VALUE ZERO.
 260            02  FILLER       PIC X(28).
 270        01  DAM-ARG2.
 280            02  ACCESS-CODE  PIC X(4).
 290            02  FLAG1        PIC X(1).
 300            02  FLAG2        PIC X(1).
 310            02  FLAG3        PIC X(1).
 320            02  FLAG4        PIC X(1).
 330            02  FLAGS        PIC S9(9) COMP VALUE ZERO.
 340            02  DAMKEY.
 350                03  FIRST-BLOCK-NO PIC S9(9) COMP.
 360                03  LAST-BLOCK-NO  PIC S9(9) COMP.
 370       *
 380        01  CNTL-BUFFER.
 390            02  W-COUNT      PIC S9(9) COMP.
 400            02  RWT-DATA     PIC X(18) VALUE SPACE.
 410            02  FILLER       PIC X(483) VALUE SPACE.
 420       *
 430        01  W-BUFFER.
 440            02  FILLER       PIC X(504).
 450       *
 460         LINKAGE SECTION.
 470         77  IN-DATA      PIC X(32).
 480         77  IN-LENG      PIC S9(9) COMP.
 490         77  OUT-DATA     PIC X(32).
 500         77  OUT-LENG     PIC S9(9) COMP.
 510       *
 520         PROCEDURE DIVISION USING IN-DATA IN-LENG OUT-DATA OUT-LENG.
 530         SVR01 SECTION.
 540         DISPLAY  'SVR01:PROCEDURE START' .
 550        *
 560        *********************************************
 570        * DAM_READ(read logical file blocks)        *
 580        *********************************************
 590        *
 600         MOVE 'DCDAMSVC' TO REQUEST     OF DAM-ARG1.
 610         MOVE 'damfile0' TO FILE-NAME   OF DAM-ARG1.
 620         MOVE 1          TO KEY-NO      OF DAM-ARG1.
 630         MOVE 504        TO BUFFER-LEN  OF DAM-ARG1.
 640         MOVE FD-SAVE    TO FILDES      OF DAM-ARG1.
 650         MOVE 'READ'     TO ACCESS-CODE OF DAM-ARG2.
 660         MOVE 'M'        TO FLAG1       OF DAM-ARG2.
 670         MOVE SPACE      TO FLAG2       OF DAM-ARG2.
 680         MOVE 0          TO FIRST-BLOCK-NO OF DAMKEY.
 690         MOVE 0          TO LAST-BLOCK-NO  OF DAMKEY.
 700         CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 CNTL-BUFFER.
 710             IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN
 720                DISPLAY 'SVR01:DAM-READ FAILED. CODE ='
 730                STATUS-CODE OF DAM-ARG1
 740                MOVE 'SVR01: DAM READ FAILED' TO OUT-DATA
 750                MOVE 25 TO OUT-LENG
 760                GO TO PROG-END
 770             END-IF.
 780        *
 790        *********************************************
 800        * DAM_WRITE (write to logical file blocks)  *
 810        *********************************************
 820        *
 830         DAM-WRITE.
 840         ADD 1 TO W-COUNT OF CNTL-BUFFER.
 850         MOVE 'DCDAMSVC' TO REQUEST     OF DAM-ARG1.
 860         MOVE 'damfile0' TO FILE-NAME   OF DAM-ARG1.
 870         MOVE 1          TO KEY-NO      OF DAM-ARG1.
 880         MOVE 504        TO BUFFER-LEN  OF DAM-ARG1.
 890         MOVE FD-SAVE    TO FILDES      OF DAM-ARG1.
 900         MOVE 'WRIT'     TO ACCESS-CODE OF DAM-ARG2.
 910         MOVE W-COUNT OF CNTL-BUFFER TO FIRST-BLOCK-NO OF DAMKEY.
 920         MOVE 0          TO LAST-BLOCK-NO OF DAMKEY.
 930         MOVE IN-DATA TO W-BUFFER.
 940         CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 W-BUFFER.
 950             IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN
 960               IF STATUS-CODE OF DAM-ARG1 = '01606' THEN
 970                 MOVE 0 TO W-COUNT OF CNTL-BUFFER
 980                 GO TO DAM-WRITE
 990               END-IF
1000               DISPLAY 'SVR01:DAM-WRITE FAILED. CODE = '
1010               STATUS-CODE OF DAM-ARG1
1020               MOVE 'SVR01:DAM WRITE FAILED' TO OUT-DATA
1030               MOVE 26 TO OUT-LENG
1040               GO TO PROG-END
1050             END-IF.
1060        *
1070        *********************************************
1080        * DAM_REWRITE (update logical file blocks)  *
1090        *********************************************
1100        *
1110         MOVE 'DCDAMSVC' TO REQUEST     OF DAM-ARG1.
1120         MOVE 'damfile0' TO FILE-NAME   OF DAM-ARG1.
1130         MOVE 1          TO KEY-NO      OF DAM-ARG1.
1140         MOVE 504        TO BUFFER-LEN  OF DAM-ARG1.
1150         MOVE FD-SAVE    TO FILDES      OF DAM-ARG1.
1160         MOVE 'REWT'     TO ACCESS-CODE OF DAM-ARG2.
1170         MOVE 'U'        TO FLAG1       OF DAM-ARG2.
1180         MOVE 0         TO FIRST-BLOCK-NO OF DAMKEY.
1190         MOVE 0         TO LAST-BLOCK-NO  OF DAMKEY.
1200         MOVE 'REWRITE COMPLETE' TO RWT-DATA OF CNTL-BUFFER.
1210         CALL 'CBLDCDAM' USING DAM-ARG1 DAM-ARG2 CNTL-BUFFER.
1220             IF STATUS-CODE OF DAM-ARG1 NOT = '00000' THEN
1230               DISPLAY 'SVR01:DAM-REWRITE FAILED. CODE = '
1240               STATUS-CODE OF DAM-ARG1
1250               MOVE 'SVR01:DAM REWRITE FAILED' TO OUT-DATA
1260               MOVE 28 TO OUT-LENG
1270               GO TO PROG-END
1280             END-IF.
1290         MOVE 'SVR01:PROCESS COMPLETE' TO OUT-DATA.
1300         MOVE 26 TO OUT-LENG.
1310         PROG-END.
1320         DISPLAY 'SVR01:Good-By!!'.
1330         END PROGRAM SVR01.

[Contents][Back][Next]

[Trademarks]

All Rights Reserved. Copyright (C) 2006, 2010, Hitachi, Ltd.