The following is a sample API application written in Cobol.
This program is the same between mainframe and other tested platforms (Open VMS using Compaq Cobol 2.6 and Micro FOCUS Express 2.0.11 on AIX) except for the COPY statement as noted in the body of the example.
This example has had limited testing other than the mentioned platforms as noted in the body of the example.
On MVS this is the EDACTL.DATA (EDAAPCOB) file. On all other platforms, this is the edaapp.cbl file in the etc directory of EDAHOME.
000100
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. EDAAPP.
000400 AUTHOR. API PGMER.
000500 DATE-WRITTEN. 4 NOVEMBER, 1993.
000600
000700* Illustration of API commands from within Cobol.
000800*
000900* This simple 3GL program demonstrates the basic commands
001000* required by the API to establish a session with a
001100* server and retrieve information.
001200*
001300* Production Notes ...
001400*
001500* Updates to this example and the copy book were done around
001600* 5.3 so the sample also runs in the OS/400 environment.
001700* There were four primary changes ...
001800*
001900* 1. Change COMP usages to BINARY as this more across
002000* platform compatible.
002100*
002200* 2. PIC S9(9) declarations were changed to S9(9) for
002300* consistency between paltforms to go with the
002400* COMP to BINARY change.
002500*
002600* 3. Change the EDA-ID usage to use a pointer and have a
002700* separate pointer ECX. While you can "share" this
002800* pointer as a long on many platforms (the old way),
002900* you can't get away with this on OS/400. This same
003000* issue would also eventually be a problem with 64bit
003100* usage, thus this clarifies the situation. This is
003200* now also more consistent with the C version.
003300*
003400* 4. Improved comments.
003500*
003600* This program is sourced and shipped as ...
003700*
003800* MVS - EDACTL.DATA(EDAAPCOB) on MVS
003900* All Others - etc/edaapp.cbl
004000*
004100* The only difference in the files are the copybook
004200* statement on MVS and OS400 being EDACPY and other platforms
004300* use "edacpy.cpy" to be cross platform usable in other
004400* environments. Each one has a commented out version of
004500* the other's respective COPY statement and comments
004600* so usage is clear. The OS/400 environment is the only
004700* one where you need to manually change the copy statement
004800* in order for it to find the copy book at compile time.
004900*
005000* There were some post production 5.1.0 changes to
005100* account for a problem that was found in the area of error
005200* message handling plus the MVS and non-MVS versions were
005300* similiar, but out of sync. They are now the same except
005400* for the copy book line as noted above. Additionally, the
005500* copy book file was missing from the non-MVS distributions.
005600* If you are reading these notes, you have the fixed version.
005700*
005800* Testing of this version was done with the following
005900* test environments MVS, UNIX, and OpenVMS using the
006000* following compilers ...
006100*
006200* MVS - Cobol II
006300* Unix - Micro FOCUS Express 2.0.11 on AIX
006400* OpenVMS - Compaq Cobol V2.6
006500* OS/400 - IBM ILE Cobol
006600*
006700* We have no reason to believe that compilers on other
006800* platforms (i.e. Sun, HP, etc.) and from other
006900* third party vendors will not work, they are just untested
007000* environments. There are no specific plans to test these
007100* untested environments due to logistics of obtaining,
007200* maintaining and testing what could be many combinations.
007300* If you are attempting to use an untested environment and
007400* are having specific problems, Customer Support will be glad
007500* to assist in researching issues and bringing them to the
007600* attention of the development staff for resolution if need.
007700*
007800* We also have no reason to believe that this new version
007900* of the sample will not work with older release levels,
008000* but they are untested environments with no plans to do so.
008100*
008200* Usage ... the following general steps were taken ...
008300*
008400* MVS ........... Follow instruction as per API manual.
008500*
008600* OpenVMS ....... Follow instruction as per API manual and
008700* notes below.
008800*
008900* OS/400 ........ Follow instruction as per API manual and
009000* notes below.
009100*
009200* UNIX and NT ... Instructions will vary by Cobol vendor
009300* and their requirements for linking to
009400* external libraries. Below are directions
009500* for tested environment.
009600*
009700* OpenVMS Compilation.
009800*
009900* 1. This example and the copy book are stored with line
010000* numbers, but your application may not have line numbers.
010100* When compiling this example or others that have line
010200* numbers define the symbol COB :== "COB /ANSI_FORMAT" or
010300* add "/ANSI_FORMAT" to your existing declaration. This
010400* will account for the numbers without having to changing
010500* underlying scripts such as the supplied GENCPGM.COM.
010600*
010700* 2. Use GENCPGM.COM DCL script as described in API manual
010800* to compile this program. However, 5.1 and older versions
010900* of the GENCPGM.COM script fail to add "OGIN.CFG" to the
011000* end of the EDACS3 declaration in the DCL helper script
011100* that is created to run the binary. This a simple
011200* manual fix of editing the resulting DCL if you have the
011300* older version.
011400*
011500* OS/400 Compilation.
011600*
011700* 1. Copy edaapp.cbl and edacpy.cpy (source and copybook) files
011800* to local directory.
011900*
012000* 2. Change to the appropriate copy book statement as noted.
012100*
012200* 3. Use gencpgm.sh to compile. Since the ILE Cobol compile
012300* does not support compilation directly against IFS files, a
012400* *CURLIB/QCBLLESRC source file will be created (if needed)
012500* and the .cbl and .cpy copied to it as members. Sources may
012600* also be placed directly in QCBLLESRC and gencpgm.sh will
012700* find them.
012800*
012900* 4. A new 5.3 feature of gencpgm.sh is to also create CL
013000* and CMD scripts to wrapper an application and compile
013100* them. This makes it easier to call an application from
013200* QSH using the .sh wrapper that continues to be created
013300* or from the OS/400 menu using the newly created CL and
013400* CMD files, however, applications must be be 8 or less
013500* in name length to create the CL with a unique name
013600* (ie *CURLIB/QCLSRC({app}CL)) ). The CL and CMD source
013700* members are not erased afterwards, so they can be
013800* further customized to fit other application needs and
013900* recompiled.
014000*
014100* Please Note: This is a skeletion sample and as such it
014200* needs to be fairly cross platform portable and as
014300* such no DDS for screen control has been added for
014400* OS/400. This also explains why raw console (SYSIN)
014500* mode is used and the "flashing" behavior of text to
014600* the screen and the extra prompts about "awaiting
014700* reply ...", which may not seem normal, but are for
014800* this mode of execution.
014900*
015000* There are no plans to add DDS to the example to
015100* eliminate this behavior since screen handling
015200* methods are a function a specific applications and
015300* not a requirement of a proof of concept sample.
015400*
015500* UNIX Compilation for Micro Focus Cobol Express
015600*
015700* Cobol compilation via gencpgm is in these environments.
015800* is not supported ... follow steps and notes below.
015900*
016000* Older versions of Micro Focus Cobol required an customer
016100* written interface stub and prefacing of calls with special
016200* syntax to link and use external libraries; this is no longer
016300* required in recent Micro Focus Cobol releases and programs
016400* link much like C. However, this may be indicative of the
016500* complexity of using other third party compliers, so BEWARE.
016600*
016700* Note: Micro Focus Cobol may have the word "Focus" in it,
016800* but is not a product of Information Builders nor
016900* iWay Software. We do work with them in the area of
017000* C-ISAM support. They may be found on the web at
017100* http://www.microfocus.com.
017200*
017300* UNIX (using Micro Focus Cobol Express) ...
017400*
017500* 1. Required variables for compilation are EDAHOME and the
017600* library path for the machine (AIX uses LIBPATH, HP/UX
017700* uses SHLIB_PATH and LD_LIBRARY_PATH on other UNIX
017800* systems. The libary path will require Micro Focus's
017900* Cobol library directory and the EDAHOME bin directory.
018000* It is also convient if the Micro Focus Cobol bin
018100* directory is on the PATH.
018200*
018300* 2. The actual Cobol compile should look like:
018400*
018500* cob -V -x myprogram.cbl -L $EDAHOME/bin -l edaapi
018600*
018700* The result is an executable without an extension.
018800* You probably also get an error message about non
018900* debuggable library, this may be ignored and may be
019000* prevented by using the debuggable version of the
019100* library.
019200*
019300* 3. Create a shell with appropriate variables set and
019400* execute of the actual binary. Alternately, declare
019500* variables in the .profile and just execute binary.
019600* The required variables are EDAHOME, EDACONF, EDACS3
019700* (EDACONF with "/etc/odin.cfg" appended) and the library
019800* pathing variable for $EDAHOME/bin as above.
019900*
020000* Other Notes:
020100*
020200* Some initial attempts were tried on NT, but ...
020300*
020400* 1. Compiler was Micro Focus. Installation set up
020500* a general environment and the command to use
020600* seems to be cbllink. Resulting program ran, but
020700* only to first step of procedure. This most likely
020800* a logistical problem and not the program itself.
020900*
021000* 1. Compiler installation sets environment, so only
021100* EDAHOME needs to be set.
021200*
021300* 2. NT uses % enclosed variables, so $EDAHOME would be
021400* %EDAHOME%. Resulting file will have .exe extension.
021500*
021600* 3. NT calls this sort of shell file a batch file and it
021700* ends in .bat, but the same variables need to be set
021800* or put in registry. Library pathing uses PATH, so add
021900* EDAHOME/bin to pick up API dll.
022000*
022100 ENVIRONMENT DIVISION.
022200
022300 CONFIGURATION SECTION.
022400 SOURCE-COMPUTER. IBM-370.
022500 OBJECT-COMPUTER. IBM-370.
022600
022700 SPECIAL-NAMES.
022800 SYSIN IS EDA-TERMIN.
022900
023000 DATA DIVISION.
023100
023200 WORKING-STORAGE SECTION.
023300
023400 77 ANOTHER-SQL-STATEMENT PIC X VALUE "Y".
023500 77 DISPLAY-STATUS PIC -ZZ9.
023600 77 DISPLAY-MSG-CODE PIC ZZZZZZZZ9.
023700 77 HOLD-TUPLE-SIZE PIC S9(8) COMP.
023800 77 DISPLAY-TUPLE PIC X(80).
023900 77 COLUMN-NUMBER PIC S9(8) COMP VALUE 1.
024000
024100* DEFINE THE EDA-ID
024200* Define one SCB, one INFO area and an EDA status variable
024300* Define a list of Error messages
024400
024500* Use the copy book statement appropriate to your platform.
024600* This the only platform specific change that is needed to
024700* run this example.
024800* MVS ... uses COPY EDACPY
024900* OS/400 ... uses COPY EDACPY or COPY EDACPY IN QCBLLESRC.
025000* Change as need depending on where you want to
025100* keep copy book files.
025200* Others
025300* Platforms ... use a double quoted lowercase real name.
025400
025500*COPY EDACPY
025600 COPY "edacpy.cpy"
025700
025800 REPLACING
025900 ECX BY ECX
026000 SCB BY SCB
026100 INFO BY INFO-AREA
026200 STAT BY EDA-STATUS
026300 ETEXT BY ERROR-TEXT
026400 ELIST BY ERROR-MSG
026500 EOFFSET BY MSG-OFFSET
026600 MAXERROR BY MAX-ERROR
026700 MAXWARNING BY MAX-WARNING.
026800
026900 01 USER-NAME PIC X(8) VALUE " ".
027000 01 USER-LENGTH PIC S9(8) BINARY VALUE 8.
027100
027200 01 EDA-PASSWORD PIC X(8) VALUE " ".
027300 01 PASSLENGTH PIC S9(8) BINARY VALUE 8.
027400
027500 01 DBAPASS PIC X(8) VALUE " ".
027600 01 DBALENGTH PIC S9(8) BINARY VALUE 0.
027700
027800 01 SERVER PIC X(8) VALUE " ".
027900 01 SERVER-LENGTH PIC S9(8) BINARY VALUE 8.
028000
028100* In our example, all SQL statements shall be less than
028200* 80 characters. This simplifies string manipulation.
028300
028400 01 SQL-STMT PIC X(80).
028500 01 SQL-LENGTH PIC S9(8) BINARY VALUE 80.
028600
028700* Tuple for EDAFETCH (to receive the answer set).
028800
028900 01 TUPLE.
029000 02 TUPLE-BLOCK PIC X(4000).
029100 02 TUPLE-LINES REDEFINES TUPLE-BLOCK.
029200 03 TUPLE-INSTANCE PIC X(80)
029300 OCCURS 50 TIMES
029400 INDEXED BY IX-TUPLE.
029500
029600 01 TUPLE-LENGTH PIC S9(8) BINARY VALUE 4000.
029700 01 TUPLE-TYPE PIC S9(8) BINARY VALUE 1.
029800
029900* Estimate parmameters for EDASQL (future use).
030000
030100 01 ESTIMATE1 PIC S9(8) BINARY VALUE 0.
030200 01 ESTIMATE2 PIC S9(8) BINARY VALUE 0.
030300
030400 01 SERVER-BUFFER.
030500 02 SERVER-NAME-1 PIC X(8).
030600 02 SERVER-NAME-2 PIC X(8).
030700 02 SERVER-NAME-3 PIC X(8).
030800 02 SERVER-NAME-4 PIC X(8).
030900 02 SERVER-NAME-5 PIC X(8).
031000 02 SERVER-NAME-6 PIC X(8).
031100 02 SERVER-NAME-7 PIC X(8).
031200 02 SERVER-NAME-8 PIC X(8).
031300
031400 01 SERVER-BUFFER-LNG PIC S9(8) BINARY VALUE 64.
031500
031600* Constant for execparm of EDASQL.
031700
031800 01 ONE PIC S9(8) BINARY VALUE 1.
031900
032000* Wait parms for EDAWAIT.
032100
032200 01 WAIT-TIME PIC S9(8) BINARY VALUE 0.
032300 01 WAIT-SESSION PIC S9(8) BINARY.
032400
032500 77 ECODE PIC S9(8) BINARY.
032600
032700 PROCEDURE DIVISION.
032800
032900* A simple session.
033000*
033100* Initialize, connect to a server, send an SQL request,
033200* receive an answer set (response) and terminate the session.
033300
033400 AN-EDA-SESSION.
033500 PERFORM INITIALIZE-EDA.
033600 PERFORM GET-LOGIN-INFO.
033700 PERFORM EDACONN.
033800 PERFORM PROCESS-SQL UNTIL
033900 ANOTHER-SQL-STATEMENT IS EQUAL TO "N" OR "n".
034000 PERFORM EDAFINISH.
034100
034200* EDATERM -> Terminate this context
034300
034400 EDATERM.
034500 DISPLAY " ".
034600 DISPLAY "Issuing EDATERM and Stopping Run...".
034700 DISPLAY " ".
034800 CALL "EDATERM" USING ECX, EDA-STATUS.
034900 PERFORM CHECK-STAT.
035000 STOP RUN.
035100
035200* EDAINIT -> Initialize API
035300
035400 INITIALIZE-EDA.
035500 DISPLAY " ".
035600 DISPLAY "Issuing EDAINIT...".
035700
035800 CALL "EDAINIT" USING ECX, EDA-STATUS.
035900 PERFORM CHECK-STAT.
036000 IF EDA-STATUS < 0
036100 THEN GO TO EDATERM.
036200
036300* Prompt for User ID, Password, and Server and
036400* use EDASERVERS to get server name list to
036500* to select from.
036600
036700 GET-LOGIN-INFO.
036800 DISPLAY " ".
036900 DISPLAY "Enter a valid user ID: ".
037000 ACCEPT USER-NAME FROM EDA-TERMIN.
037100 DISPLAY " ".
037200 DISPLAY "Enter a valid password: ".
037300 ACCEPT EDA-PASSWORD FROM EDA-TERMIN.
037400 CALL "EDASERVERS" USING ECX, SERVER-BUFFER,
037500 SERVER-BUFFER-LNG, EDA-STATUS.
037600 PERFORM CHECK-STAT.
037700 IF EDA-STATUS < 0
037800 THEN GO TO EDATERM.
037900 DISPLAY " ".
038000 DISPLAY "Available servers are:"
038100 DISPLAY SERVER-NAME-1 " " SERVER-NAME-2
038200 SERVER-NAME-3 " " SERVER-NAME-4.
038300 DISPLAY SERVER-NAME-5 " " SERVER-NAME-6
038400 SERVER-NAME-7 " " SERVER-NAME-8.
038500 DISPLAY "Enter a valid server name or leave BLANK for "
038600 SERVER-NAME-1 " : ".
038700 ACCEPT SERVER FROM EDA-TERMIN.
038800 IF SERVER IS EQUAL TO " "
038900 THEN MOVE SERVER-NAME-1 TO SERVER.
039000
039100* EDACONNECT -> establish server connection.
039200
039300 EDACONN.
039400 DISPLAY " ".
039500 DISPLAY "Issuing EDACONNECT ...".
039600 COMPUTE USER-LENGTH = FUNCTION LENGTH (USER-NAME).
039700 COMPUTE PASSLENGTH = FUNCTION LENGTH (EDA-PASSWORD).
039800 COMPUTE SERVER-LENGTH = FUNCTION LENGTH (SERVER).
039900 CALL "EDACONNECT" USING ECX, SCB,
040000 USER-NAME, USER-LENGTH,
040100 EDA-PASSWORD, PASSLENGTH,
040200 SERVER, SERVER-LENGTH.
040300 MOVE SCB-STATUS TO EDA-STATUS.
040400 PERFORM CHECK-STAT.
040500 IF EDA-STATUS < 0
040600 THEN GO TO EDATERM.
040700
040800* Prompt for SQL statement, submit to server and retrieve rows.
040900
041000 PROCESS-SQL.
041100 MOVE SPACES TO SQL-STMT.
041200 DISPLAY " ".
041300 DISPLAY "Enter SQL statement followed by a ';' ...".
041400 ACCEPT SQL-STMT FROM EDA-TERMIN.
041500 PERFORM SQL-STATEMENT.
041600 PERFORM EDAPAUSE.
041700 PERFORM FETCH-RESPONSE
041800 UNTIL EDA-STATUS IS EQUAL TO 5.
041900 DISPLAY " ".
042000 DISPLAY "Do you wish to enter another SQL request? (Y or N)".
042100 ACCEPT ANOTHER-SQL-STATEMENT FROM EDA-TERMIN.
042200
042300* EDASQL -> submit query to server
042400
042500 SQL-STATEMENT.
042600 DISPLAY " ".
042700 DISPLAY "Issuing EDASQL ..." .
042800 CALL "EDASQL" USING SCB, SQL-STMT, SQL-LENGTH,
042900 ESTIMATE1, ESTIMATE2, DBAPASS, DBALENGTH, ONE.
043000 MOVE SCB-STATUS TO EDA-STATUS.
043100 PERFORM CHECK-STAT.
043200 IF EDA-STATUS < 0
043300 THEN GO TO EDATERM.
043400
043500* EDAWAIT/EDATEST are a cycle that should always be used together.
043600* EDAWAIT -> Wait for communication event from the server.
043700* EDATEST -> Determine if the scb is ready.
043800
043900 EDAPAUSE.
044000 DISPLAY "Issuing EDAWAIT/EDATEST ...".
044100 CALL "EDAWAIT" USING ECX, WAIT-TIME,
044200 WAIT-SESSION, EDA-STATUS.
044300 PERFORM CHECK-STAT.
044400 IF EDA-STATUS < 0
044500 THEN GO TO EDATERM.
044600*
044610* Modern Cobol can pass a NULL using OMITTED key word.
044620* Application upgraded to pass null to get wait behavior.
044630* If your Cobol doesn't support OMITTED, try BY VALUE 0
044640* else switch to previous variable of EDA-STATUS.
044650 CALL "EDATEST" USING SCB, OMITTED.
044700 PERFORM CHECK-STAT.
044800 PERFORM CHECK-MSG.
044900 IF EDA-STATUS < 0
045000 THEN GO TO EDATERM.
045100
045200* EDAINFO -> sample of obtaining information about a column.
045300*
045400* EDAINFO.
045500* DISPLAY " ".
045600* DISPLAY "Issuing EDAINFO ... ".
045700* CALL "EDAINFO" USING SCB, COLUMN-NUMBER, INFO-AREA.
045800* MOVE SCB-STATUS TO EDA-STATUS.
045900* PERFORM CHECK-STAT.
046000* PERFORM CHECK-MSG.
046100* IF EDA-STATUS < 0
046200* THEN GO TO EDATERM.
046300* ADD 1 TO COLUMN-NUMBER.
046400
046500* EDAFETCH -> Fetch answer set and display.
046600*
046700* A production program should terminate upon receiving a fatal status
046800* (-12 for example). In this example, we show the appropriate error
046900* handling for 1) bad SCB statuses and 2) server messages (MSG-TEXT)
047000* in the CHECK-MSG routine.
047100
047200 FETCH-RESPONSE.
047300 CALL "EDAFETCH" USING SCB, TUPLE, TUPLE-LENGTH, TUPLE-TYPE.
047400 MOVE SCB-STATUS TO EDA-STATUS.
047500 IF NOT EDA-END-OF-SET
047600 PERFORM CHECK-STAT.
047700 PERFORM CHECK-MSG.
047800 IF EDA-END-OF-SET
047900 THEN NEXT SENTENCE
048000 ELSE
048100 IF EDA-STATUS < 0
048200 THEN GO TO EDATERM
048300 ELSE
048400 MOVE ALPHA-SIZE TO HOLD-TUPLE-SIZE
048500 SET IX-TUPLE TO 1
048600 PERFORM DISPLAY-TUPLE-LINES
048700 UNTIL HOLD-TUPLE-SIZE < 0.
048800
048900* Display the tuple in 80-byte chunks.
049000
049100 DISPLAY-TUPLE-LINES.
049200 MOVE TUPLE-INSTANCE (IX-TUPLE) TO DISPLAY-TUPLE.
049300 DISPLAY DISPLAY-TUPLE.
049400 SET IX-TUPLE UP BY 1.
049500 SUBTRACT 80 FROM HOLD-TUPLE-SIZE.
049600
049700* EDAXCONNECT -> disconnect the server connection
049800
049900 EDAFINISH.
050000 DISPLAY " ".
050100 DISPLAY "Issuing EDAXCONNECT ... ".
050200 CALL "EDAXCONNECT" USING SCB.
050300 MOVE SCB-STATUS TO EDA-STATUS.
050400 PERFORM CHECK-STAT.
050500
050600* Check-stat routine to DISPLAY error messages.
050700*
050800* The EDA-status codes range from -n to +m, including 0.
050900* The DISPLAY statement below uses the range values defined
051000* by the EDA-MSGS copy section.
051100
051200 CHECK-STAT.
051300 IF NOT EDA-SUCCESS
051400*
051500* If out of range set to initialize, but unused array value.
051600*
051700 IF (EDA-STATUS < MAX-ERROR) OR
051800 (EDA-STATUS > MAX-WARNING)
051900 COMPUTE ECODE = ( MAX-ERROR + 1 )
052000 END-IF
052100*
052200* If negative make positive and add offset else use as is.
052300*
052400 IF EDA-STATUS < 0
052500 COMPUTE ECODE = ( ( EDA-STATUS * -1 ) + MSG-OFFSET )
052600 ELSE
052700 COMPUTE ECODE = (EDA-STATUS)
052800 END-IF
052900
053000 MOVE EDA-STATUS TO DISPLAY-STATUS
053100 DISPLAY "EDA status: " DISPLAY-STATUS " "
053200 ERROR-MSG(ECODE)
053300 PERFORM SHOW-SCB
053400 END-IF.
053500
053600* On error display the SCB contents.
053700
053800 SHOW-SCB.
053900* Pointer is a handle and not for application use,
054000* just display as the text POINTER.
054100 DISPLAY " ".
054200 DISPLAY "SCB Contents ...".
054300 DISPLAY " ".
054400 DISPLAY " Context ID : POINTER".
054500 DISPLAY " Session ID : " SID.
054600 DISPLAY " Command : " COMMAND.
054700 DISPLAY " SCB-STATUS : " SCB-STATUS.
054800 DISPLAY " Column-Count : " NBRCOLS.
054900 DISPLAY " A-Tuple Size : " ALPHA-SIZE.
055000 DISPLAY " B-Tuple Size : " BINARY-SIZE.
055100 DISPLAY " Row-Count : " ROW-COUNT.
055200 DISPLAY " ".
055300
055400* DISPLAY the info area after EDAinfo.
055500
055600 SHOW-INFO.
055700 DISPLAY " ".
055800 DISPLAY "INFO Area Contents ...".
055900 DISPLAY " ".
056000 DISPLAY " column name :" COL-NAME.
056100 DISPLAY " column length:" COL-LENGTH.
056200 DISPLAY " column number:" COL-NBR.
056300 DISPLAY " alias :" ALIAS.
056400 DISPLAY " alias length :" AL-LENGTH.
056500 DISPLAY " data type :" DATA-TYPE.
056600 DISPLAY " alpha size :" FLD-LENGTH.
056700 DISPLAY " packed-scale :" DCML.
056800 DISPLAY " edit-options :" OPTIONS.
056900 DISPLAY " binary size :" BFLD-SIZE.
057000 DISPLAY " alpha offset :" A-OFFSET.
057100 DISPLAY " binary offset:" B-OFFSET.
057200 DISPLAY " ".
057300
057400* Check messages from the server.
057500* For instance, RPC, warning, Smart Mode, etc.
057600
057700 CHECK-MSG.
057800 IF MSG-TYPE IS NOT EQUAL TO 0
057900 THEN MOVE MSG-CODE TO DISPLAY-MSG-CODE
058000 DISPLAY "Message code is: " MSG-ORIGIN
058100 DISPLAY-MSG-CODE
058200 DISPLAY MSG-TEXT.
058300 PERFORM CHECK-QUEUE UNTIL MSG-PENDING IS EQUAL TO 0.
058400
058500* Receive messages from the message queue into the scb until the message
058600* queue is exhausted.
058700
058800 CHECK-QUEUE.
058900 CALL "EDAACCEPT" USING SCB.
059000 DISPLAY MSG-TEXT.
| iWay Software |