Loading...
Select Version
Example of address management
This sample application for a UTM application on a BS2000 system allows you to manage address data stored in a file. The application provides the following management functions for this purpose; each function can be called by means of an entry in the appropriate field in the relevant TAC. Input and output are both made in a format.
On Unix, Linux and Windows systems, you can find an example for a UTM application in the sample application (Unix and Linux systems) and the QuickStartKit (Windows systems) which are provided with openUTM.
TAC | Function | Explanation |
1 | Display | displays one of the addresses in the file. The search string consists of the surname and the first two letters of the forename, which must be entered in the appropriate fields. |
2 | Add | enters a new address in the file. The file must not already contain an address with the same search string (see above). |
3 | Update | modifies an address entry. The address must already exist in the file. |
4 | Delete | deletes an existing address from the file. |
If the user makes an error, an error message is displayed in the bottom line of the format.
The figures indicated above are the transaction codes (TACs) which control the application. Transaction code 1 calls the program unit DISPLAY; transaction codes 2, 3 and 4 all call the program unit UPDATE. These program units then branch to the program unit FILES.
The program unit FILES is implemented as the START and SHUT exit and contains the subroutines which implement input to and output from the address file.
openUTM calls the program unit BADTACS automatically if an invalid TAC is entered. Once the connection to the application has been established and KDCSIGN has been called successfully, openUTM immediately outputs the format (start format). Subsequent interaction with the user is strictly dialog-driven; in other words, the application responds to the input of a TAC and a key by outputting the format which contains the address being searched for and/or by outputting a success or an error message in the bottom line.
This program is intended merely to show you how you can program with openUTM. The file accesses despicted here are not subject to UTM’s transaction management concept.
The following structure diagrams show the structure of the program units:
Figure: Structure diagram of program unit DISPLAY
Figure: Structure diagram of program unit UPDATE
For the sake of completeness, the generation of the application has also been appended to the COBOL program listings. To find out the exact meanings of the individual operands and statements, please refer to the openUTM manual “Generating Applications”.
The figure below shows the format used for this application:
Figure: The *format "FORMA" with which the application works
The structure of the addressing aid for this format is provided below:
* USER-AREA-LEN: 228
41 TACO PIC X(8).
41 FUNCTIONO PIC X(26).
41 LASTNAMEO PIC X(14).
41 FSTO PIC X(2).
41 FSTRESTO PIC X(18).
41 STREETO PIC X(26).
41 HOUSENOO PIC X(10).
41 ZIPO PIC X(5).
41 CITYO PIC X(26).
41 PHONEO PIC X(18).
41 MSGTEXTO PIC X(80).
The fields "FUNCTIONO" and "MSGTEXTO" are protected fields, the field "ZIPO" is numeric.
Program unit DISPLAY
IDENTIFICATION DIVISION.
PROGRAM-ID. DISPLAY.
*****************************************************************
ENVIRONMENT DIVISION.
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY KCOPC.
01 ERROR-TEXT.
05 FILLER PIC X(21)
VALUE "*** E R R O R ***".
05 FILLER PIC X(14)
VALUE "PROGRAM UNIT: ".
05 F-TP PIC X(08).
05 FILLER PIC X(17)
VALUE " KDCS OPCODE: ".
05 F-OP PIC X(04).
05 FILLER PIC X(13)
VALUE "RETURN CODE: ".
05 F-CD PIC X(03).
LINKAGE SECTION.
COPY KCKBC.
05 KBPRG PIC X(228).
COPY KCPAC.
03 NB.
05 TAC PIC X(008).
05 DATA1 PIC X(220).
03 FILLER REDEFINES NB.
COPY FORMAO.
*****************************************************************
PROCEDURE DIVISION USING KCKBC KCSPAB.
INIT-OPERATION-SECTION.
MOVE SPACES TO NB.
MOVE INIT TO KCOP.
MOVE 0 TO KCLKBPRG.
MOVE 512 TO KCLPAB.
CALL "KDCS" USING KCPAC.
IF KCRCCC NOT = ZERO
THEN MOVE INIT TO F-OP GO TO ERROR-HANDLING.
MGET-OPERATION.
MOVE MGET TO KCOP.
MOVE 228 TO KCLA.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC DATA1.
IF KCRCCC NOT = ZERO
THEN MOVE MGET TO F-OP GO TO ERROR-HANDLING.
* CALL PROGRAM UNIT "FILES" IN ORDER TO CALL *
* READ ROUTINE *
READ-OPERATION.
CALL "FILES" USING KCKBC, KCSPAB.
MPUT-OPERATION.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 228 TO KCLM.
MOVE SPACES TO KCRN.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC NB.
IF KCRCCC NOT = ZERO
THEN MOVE MPUT TO F-OP GO TO ERROR-HANDLING.
PEND-OPERATION.
MOVE PEND TO KCOP.
MOVE "FI" TO KCOM.
CALL "KDCS" USING KCPAC NB.
PROG-END.
EXIT PROGRAM.
ERROR-HANDLING.
MOVE "DISPLAY" TO F-TP.
MOVE KCRCCC TO F-CD.
MOVE ERROR-TEXT TO NB.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 80 TO KCLM.
MOVE SPACES TO KCRN.
MOVE SPACES TO KCMF.
MOVE ZEROES TO KCDF.
CALL "KDCS" USING KCPAC NB.
MOVE PEND TO KCOP.
MOVE "ER" TO KCOM.
CALL "KDCS" USING KCPAC.
GO TO PROG-END.
Program unit UPDATE
IDENTIFICATION DIVISION.
PROGRAM-ID. UPDATE.
*****************************************************************
ENVIRONMENT DIVISION.
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY KCOPC.
01 ERROR-TEXT.
05 FILLER PIC X(21)
VALUE "*** E R R O R ***".
05 FILLER PIC X(14)
VALUE "PROGRAM UNIT: ".
05 F-TP PIC X(08).
05 FILLER PIC X(17)
VALUE " KDCS OPCODE: ".
05 F-OP PIC X(04).
05 FILLER PIC X(13)
VALUE "RETURN CODE: ".
05 F-CD PIC X(03).
LINKAGE SECTION.
COPY KCKBC.
05 KBPRG PIC X(228).
COPY KCPAC.
03 NB.
05 TAC PIC X(008).
05 DATA1 PIC X(220).
03 FILLER REDEFINES NB.
COPY FORMAO.
*****************************************************************
PROCEDURE DIVISION USING KCKBC, KCSPAB.
***************************************
INIT-OPERATION-SECTION.
MOVE SPACES TO NB.
MOVE INIT TO KCOP.
MOVE 0 TO KCLKBPRG.
MOVE 512 TO KCLPAB.
CALL "KDCS" USING KCPAC.
IF KCRCCC NOT = ZERO
THEN MOVE INIT TO F-OP GO TO ERROR-HANDLING.
MGET-OPERATION.
MOVE MGET TO KCOP.
MOVE 228 TO KCLA.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC DATA1.
IF KCRCCC NOT = ZERO
THEN MOVE MGET TO F-OP GO TO ERROR-HANDLING.
* CALL PROGRAM UNIT "FILES" IN ORDER TO BRANCH TO *
* WRITING, OVERWRITING AND DELETING ROUTINES *
* ACCORDING TO THE TAC *
FILE-OPERATION.
CALL "FILES" USING KCKBC, KCSPAB.
MPUT-OPERATION.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 228 TO KCLM.
MOVE SPACES TO KCRN.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC NB.
IF KCRCCC NOT = ZERO
THEN MOVE MPUT TO F-OP GO TO ERROR-HANDLING.
PEND-OPERATION.
MOVE PEND TO KCOP.
MOVE "FI" TO KCOM.
CALL "KDCS" USING KCPAC NB.
PROG-END.
EXIT PROGRAM.
ERROR-HANDLING.
MOVE "UPDATE" TO F-TP.
MOVE KCRCCC TO F-CD.
MOVE ERROR-TEXT TO NB.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 80 TO KCLM.
MOVE SPACES TO KCRN.
MOVE SPACES TO KCMF.
MOVE ZEROES TO KCDF.
CALL "KDCS" USING KCPAC NB.
MOVE PEND TO KCOP.
MOVE "ER" TO KCOM.
CALL "KDCS" USING KCPAC.
GO TO PROG-END.
Program unit FILES with START/SHUT exit and file access operations
IDENTIFICATION DIVISION.
PROGRAM-ID. FILES.
ENVIRONMENT DIVISION.
***********************
INPUT-OUTPUT SECTION.
*----------------------
FILE-CONTROL.
SELECT ADDRESSES ASSIGN TO "addresses"
ACCESS MODE IS RANDOM
ORGANIZATION IS INDEXED
RECORD KEY IS D-NAME
FILE STATUS IS FILE-STATUS.
DATA DIVISION.
****************
FILE SECTION.
*--------------
FD ADDRESSES LABEL RECORD IS STANDARD.
01 D-ADDRESSRECORD.
05 D-NAME.
10 D-LASTNAME PIC X(14).
10 D-FST PIC X(02).
05 D-FIRSTNAME PIC X(18).
05 D-STREET PIC X(26).
05 D-HOUSENO PIC X(10).
05 D-ZIP PIC X(05).
05 D-CITY PIC X(26).
05 D-PHONE PIC X(18).
WORKING-STORAGE SECTION.
*------------------------
01 FILE-ERROR-LINE.
05 FILLER PIC X(24)
VALUE " *** FILE ERROR NO.: ".
05 FILE-STATUS PIC X(02).
05 FILLER PIC X(04)
VALUE " ***".
05 FILLER PIC X(50) VALUE SPACES.
LINKAGE SECTION.
*-----------------
COPY KCKBC.
05 KBPRG PIC X(228).
COPY KCPAC.
03 NB.
05 TAC PIC X(008).
05 DATA1 PIC X(220).
03 FILLER REDEFINES NB.
COPY FORMAO.
PROCEDURE DIVISION USING KCKBC KCSPAB.
****************************************
CONTROLLING SECTION.
*---------------------
CONTROLLING-BEGIN.
IF KCTACVG = "STARTUP"
THEN OPEN I-O ADDRESSES GO TO CONTROLLING-END.
IF KCTACVG = "SHUTDOWN"
THEN CLOSE ADDRESSES GO TO CONTROLLING-END.
IF KCTACVG = "1"
THEN GO TO READING-BEGIN.
IF KCTACVG = "2"
THEN GO TO WRITING-BEGIN.
IF KCTACVG = "3"
THEN GO TO OVERWRITING-BEGIN.
IF KCTACVG = "4"
THEN GO TO DELETING-BEGIN.
CONTROLLING-END.
EXIT PROGRAM.
READING SECTION.
*-----------------
READING-BEGIN.
* SET THE ISAM KEY
MOVE LASTNAMEO TO D-LASTNAME.
MOVE FSTO TO D-FST.
MOVE SPACES TO STREETO HOUSENOO CITYO PHONEO.
MOVE ZEROES TO ZIPO.
MOVE KCTACVG TO TACO.
MOVE "DISPLAY ADDRESSES" TO FUNCTIONO.
READ ADDRESSES RECORD
INVALID KEY PERFORM FILE-ERROR GO TO READING-END.
MOVE D-LASTNAME TO LASTNAMEO.
MOVE D-FST TO FSTO.
MOVE D-FIRSTNAME TO FSTRESTO.
MOVE D-STREET TO STREETO.
MOVE D-HOUSENO TO HOUSENOO.
MOVE D-ZIP TO ZIPO.
MOVE D-CITY TO CITYO.
MOVE D-PHONE TO PHONEO.
READING-END.
EXIT PROGRAM.
WRITING SECTION.
*-----------------
WRITING-BEGIN.
ENTRY "WRITING" USING ADDRESSRECORD.
MOVE FSTO TO D-FST.
MOVE FSTRESTO TO D-FIRSTNAME.
MOVE STREETO TO D-STREET.
MOVE HOUSENOO TO D-HOUSENO.
MOVE ZIPO TO D-ZIP.
MOVE CITYO TO D-CITY.
MOVE PHONEO TO D-PHONE.
MOVE KCTACVG TO TACO.
MOVE "ADD NEW ADDRESSES" TO FUNCTIONO.
MOVE " * ADDRESS ADDED * " TO MSGTEXTO.
WRITE D-ADDRESSRECORD INVALID KEY PERFORM FILE-ERROR.
WRITING-END.
EXIT PROGRAM.
OVERWRITING SECTION.
*---------------------
OVERWRITING-BEGIN.
* Read record to lock record
MOVE LASTNAMEO TO D-LASTNAME.
MOVE FSTO TO D-FST.
MOVE "UPDATE ADDRESSES " TO FUNCTIONO.
READ ADDRESSES RECORD
INVALID KEY PERFORM FILE-ERROR GO TO OVERWRITING-END.
MOVE FSTRESTO TO D-FIRSTNAME.
MOVE STREETO TO D-STREET.
MOVE HOUSENOO TO D-HOUSENO.
MOVE ZIPO TO D-ZIP.
MOVE CITYO TO D-CITY.
MOVE PHONEO TO D-PHONE.
MOVE " * ADDRESS UPDATED * " TO MSGTEXTO.
REWRITE D-ADDRESSRECORD INVALID KEY PERFORM FILE-ERROR.
OVERWRITING-END.
EXIT PROGRAM.
DELETING SECTION.
*------------------
DELETING-BEGIN.
* Read record to lock record
MOVE LASTNAMEO TO D-LASTNAME.
MOVE FSTO TO D-FST.
MOVE "DELETE ADDRESSES" TO FUNCTIONO.
READ ADDRESSES RECORD
INVALID KEY PERFORM FILE-ERROR GO TO DELETING-END.
DELETE ADDRESSES RECORD
INVALID KEY PERFORM FILE-ERROR GO TO DELETING-END.
MOVE KCTACVG TO TACO.
MOVE "* ADDRESS DELETED *" TO MSGTEXTO.
DELETING-END.
EXIT PROGRAM.
FILE-ERROR SECTION.
*--------------------
FILE-ERROR-BEGIN.
IF FILE-STATUS = 22 THEN
MOVE "*** ADDRESS WITH THIS NAME ALREADY EXISTS ***"
TO MSGTEXTO GO TO FILE-ERROR-END.
IF FILE-STATUS = 23 THEN
MOVE "*** ADDRESS WITH THIS NAME DOES NOT EXIST ***"
TO MSGTEXTO GO TO FILE-ERROR-END.
MOVE FILE-ERROR-LINE TO MSGTEXTO.
FILE-ERROR-END.
EXIT.
Program unit BADTACS
IDENTIFICATION DIVISION.
PROGRAM-ID. BADTACS.
*****************************************************************
ENVIRONMENT DIVISION.
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
77 BTEXT PIC X(41) VALUE
"INCORRECT TAC - PLEASE REPEAT INPUT".
77 STAR PIC X(6) VALUE ALL "*".
COPY KCOPC.
01 ERRORTEXT.
05 FILLER PIC X(21)
VALUE "*** E R R O R ***".
05 FILLER PIC X(14)
VALUE "PROGRAM UNIT: ".
05 F-TP PIC X(08).
05 FILLER PIC X(17)
VALUE " KDCS OPCODE: ".
05 F-OP PIC X(04).
05 FILLER PIC X(13)
VALUE "RETURN CODE: ".
05 F-CD PIC X(03).
LINKAGE SECTION.
COPY KCKBC.
COPY KCPAC.
03 NB.
05 TRANSAC PIC X(08).
05 DATA1 PIC X(220).
03 NB-A REDEFINES NB.
COPY FORMAO.
41 ERROR1 REDEFINES MSGTEXTO.
45 STAR1 PIC X(6).
45 BADTEXT PIC X(41).
45 STAR2 PIC X(6).
45 REST PIC X(27).
*****************************************************************
PROCEDURE DIVISION USING KCKBC KCSPAB.
***************************************
INIT-OPERATION-SECTION.
MOVE SPACES TO NB.
MOVE INIT TO KCOP.
MOVE 0 TO KCLKBPRG.
MOVE 228 TO KCLPAB.
CALL "KDCS" USING KCPAC.
IF KCRCCC NOT = ZERO
THEN MOVE INIT TO F-OP GO TO ERROR-HANDLING.
MGET-OPERATION.
MOVE MGET TO KCOP.
MOVE 228 TO KCLA.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC, DATA1.
IF KCRCCC = "05Z"
THEN MOVE SPACES TO NB-A.
GO TO MPUT-OPERATION.
IF KCRCCC NOT = ZERO
THEN MOVE MGET TO F-OP GO TO ERROR-HANDLING.
MPUT-OPERATION.
MOVE BTEXT TO BADTEXT.
MOVE STAR TO STAR1.
MOVE STAR TO STAR2.
MOVE SPACES TO REST.
MOVE SPACES TO TAC.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 228 TO KCLM.
MOVE SPACES TO KCRN.
MOVE "*FORMA" TO KCMF.
CALL "KDCS" USING KCPAC, NB.
IF KCRCCC NOT = ZERO
THEN MOVE MPUT TO F-OP GO TO ERROR-HANDLING.
PEND-OPERATION.
MOVE PEND TO KCOP.
MOVE "FI" TO KCOM.
CALL "KDCS" USING KCPAC.
PROG-END.
EXIT PROGRAM.
ERROR-HANDLING.
MOVE "BADTACS" TO F-TP.
MOVE KCRCCC TO F-CD.
MOVE ERRORTEXT TO NB.
MOVE MPUT TO KCOP.
MOVE "NE" TO KCOM.
MOVE 80 TO KCLM.
MOVE SPACES TO KCRN.
MOVE SPACES TO KCMF.
MOVE ZEROES TO KCDF.
CALL "KDCS" USING KCPAC NB.
MOVE PEND TO KCOP.
MOVE "ER" TO KCOM.
CALL "KDCS" USING KCPAC.
GO TO PROG-END.
Generation of the sample application
REM ************************************************************** REM *** D E F - S T A T E M E N T S *** REM *** *** REM *** KDCFILE = APPLI *** REM ************************************************************** MAX APPLINAME=A MAX KDCFILE=(KDCFILE.APPLI,S),TASKS=2,ASYNTASKS=0 MAX CONRTIME=5,LOGACKWAIT=60 ROOT ADR1ROOT OPTION GEN=ALL REM ************************************************************** REM ************ PROGRAM STATEMENTS ************ REM ************************************************************** PROGRAM KDCADM,COMP=C PROGRAM DISPLAY,COMP=COB1 PROGRAM UPDATE,COMP=COB1 PROGRAM FILES,COMP=COB1 PROGRAM BADTACS,COMP=COB1 REM ************************************************************** REM ************ EXIT STATEMENTS ************ REM ************************************************************** EXIT PROGRAM=TPFILE,USAGE=START EXIT PROGRAM=TPFILE,USAGE=SHUT REM ************************************************************** REM ************ TAC STATEMENTS ************ REM ************************************************************** DEFAULT TAC ADMIN=Y,PROGRAM=KDCADM TAC KDCTAC TAC KDCLTERM TAC KDCPTERM TAC KDCSWTCH TAC KDCUSER TAC KDCSEND TAC KDCAPPL TAC KDCDIAG TAC KDCLOG TAC KDCINF TAC KDCHELP TAC KDCSHUT DEFAULT TAC TYPE=A,ADMIN=Y,PROGRAM=KDCADM TAC KDCTACA TAC KDCLTRMA TAC KDCPTRMA TAC KDCSWCHA TAC KDCUSERA TAC KDCSENDA TAC KDCAPPLA TAC KDCDIAGA TAC KDCLOGA TAC KDCINFA TAC KDCHELPA TAC KDCSHUTA TAC KDCTCLA DEFAULT TAC TYPE=D,PROGRAM=(STD) TAC KDCBADTC,PROGRAM=BADTACS TAC 1,LOCK=1,PROGRAM=DISPLAY TAC 2,LOCK=2,PROGRAM=UPDATE TAC 3,LOCK=2,PROGRAM=UPDATE TAC 4,LOCK=2,PROGRAM=UPDATE REM ************************************************************** REM ************ USER STATEMENTS ************ REM ************************************************************** USER GUENTER,PASS=C'AUFGEHTS',KSET=BUND1,PERMIT=ADMIN,FORMAT=*FORMA USER BESSY,PASS=C'HH',KSET=BUND2,STATUS=ON,FORMAT=*FORMA USER HAPPI,KSET=BUND3,STATUS=ON,FORMAT=*FORMA REM ************************************************************** REM ************ FORMSYS STATEMENTS ************ REM ************************************************************** FORMSYS TYPE=FHS REM ************************************************************** REM ************ PTERM/LTERM STATEMENTS ************ REM ************************************************************** DEFAULT PTERM PRONAM=DSR01,PTYPE=T9750 PTERM DSS01,LTERM=UTMDST1 PTERM DSS02,LTERM=UTMDST2 PTERM DSS03,LTERM=UTMDST3 DEFAULT PTERM PRONAM=DSR01,PTYPE=T9022,USAGE=O PTERM G01,LTERM=DRUCKER,CONNECT=A LTERM UTMDST1,KSET=BUND1 LTERM UTMDST2,LOCK=4,KSET=BUND1 LTERM UTMDST3,LOCK=5,KSET=BUND1 LTERM DRUCKER,USAGE=O REM ************************************************************** REM ************ KSET STATEMENTS ************ REM ************************************************************** KSET BUND1,KEYS=(1,2,3,4,5) KSET BUND2,KEYS=(1,2,4) KSET BUND3,KEYS=(1) REM ************************************************************** REM ************ TLS STATEMENTS ************ REM ************************************************************** TLS TLSA TLS TLSB END