Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_1of2_bb-x128b-sb
-
10,7/dil/dildoc/jtserv.cbl
There are 22 other files named jtserv.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID.
JTSERV.
AUTHOR.
DIGITAL EQUIPMENT CORPORATION.
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983.
This software is furnished under a license and may be used and
copied only in accordance with the terms of such license and
with the inclusion of the above copyright notice. This
software or any other copies thereof may not be provided or
otherwise made available to any other person. No title to and
ownership of the software is hereby transferred.
The information in this software is subject to change without
notice and should not be construed as a commitment by Digital
Equipment Corporation.
Digital assumes no responsibility for the use or reliability
of its software on equipment which is not supplied by Digital.
This program is a portion of the DIL Load Test sample
application. It is the server program, which is accessed from
the remote programs: JTTERM.CBL on the 20 and JTTERM.COB on
the VAX.
INSTALLATION.
DEC-MARLBOROUGH.
DATE-WRITTEN.
JUNE 24, 1982.
* Facility: DIL-SAMPLE
*
* Edit History:
*
* new_version (1, 0)
*
* Edit (%O'1', '29-Oct-82', 'Sandy Clemens')
* %( Clean up DIL sample application and place in library.
* Files: JTSERV.CBL (NEW), JTTERM.CBL (NEW), IDXINI.CBL (NEW),
* JTTERM.VAX-COB (NEW), JTVRPT.CBL (NEW), PROCES.MAC (NEW) )%
*
* Edit (%O'2', '06-DEC-82', 'Sandy Clemens')
* %( Put correct status code handling into all sample application
* programs. Add the use of VMS system service calls to vax
* program. General clean up.
* Files: JTSERV.CBL (NEW), JTTERM.CBL (NEW), JTTERM.VAX-COB (NEW),
* JTVRPT.CBL (NEW) )%
*
* Edit (%O'3', '04-Jan-83', 'Sandy Clemens')
* %( Add SYS: to the interface files COPY statement for the 10/20
* programs. Add SYS$LIBRARY for the VAX program.
* Files: JTSERV.CBL, JTTERM.CBL, JTTERM.VAX-COB,
* JTVRPT.CBL )%
*
* Edit (%O'4', '06-Jan-83', 'Sandy Clemens')
* %( Fix code bug in server that caused update information to
* disappear. File: JTSERV.CBL )%
*
* Edit (%O'6', '20-Jan-83', 'Sandy Clemens')
* %( Add copyright notice for 1983. Files: DSHST.TXT, IDXINI.CBL,
* JTSERV.CBL, JTTERM.CBL, JTTERM.VAX-COB, JTVRPT.CBL, PROCES.MAC )%
*
* Edit (%O'7', '24-Jan-83', 'Sandy Clemens')
* %( Add liability waiver to copyright notice. Files: DSHST.TXT,
* IDXINI.CBL, JTSERV.CBL, JTTERM.CBL, JTTERM.VAX-COB, JTVRPT.CBL,
* PROCES.MAC )%
*
* Edit (%O'10', '25-Jan-83', 'Sandy Clemens')
* %( Standardize "Author" entry. Files: DSHST.TXT, IDXINI.CBL,
* JTSERV.CBL, JTTERM.CBL, JTTERM.VAX-COB, JTVRPT.CBL )%
*
* new_version (2, 0)
*
* Edit (%O'12', '17-Apr-84', 'Sandy Clemens')
* %( Add V2 files to DS2:. )%
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.
DECSYSTEM-20.
OBJECT-COMPUTER.
DECSYSTEM-20.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DUMMY ASSIGN TO DSK
ORGANIZATION IS RMS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS DUMMY-REC.
SELECT JT-FIL ASSIGN TO DSK
ORGANIZATION IS RMS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS JT-BADGE-NUM.
DATA DIVISION.
FILE SECTION.
FD DUMMY LABEL RECORDS ARE STANDARD
VALUE OF IDENTIFICATION IS "DUMMY FIL".
01 DUMMY-REC PIC X.
FD JT-FIL LABEL RECORDS ARE STANDARD
VALUE OF IDENTIFICATION IS "JOBTICRMS".
01 JT-REC.
05 JT-NAME PIC X(30).
05 JT-BADGE-NUM PIC 9(7).
05 JT-COST-CENTER PIC X(4).
05 JT-WK-END-DATE PIC 9(6).
05 JT-TOTAL-HRS COMP-1.
05 JT-DETAIL-LINES OCCURS 10.
10 JT-ACTIV-CD PIC X(4).
10 JT-PL-NUM PIC X(4).
10 JT-DIS-NUM PIC 9(5) COMP.
10 JT-MFG-NUM PIC 9(5) COMP.
10 JT-HOURS COMP-1.
10 JT-OP-CD PIC X(4).
WORKING-STORAGE SECTION.
***** message records *********************************************************
*01 MESSAGE-REC PIC X(6).
*01 MESSAGE-STUFF REDEFINES MESSAGE-REC.
01 MESSAGE-STUFF.
05 MESSAGE-DATA PIC S9(10) COMP.
***** badge-or-close-request records ******************************************
***** from the vax
01 BDGORCLS-REC.
05 BDGORCLS-WORD PIC S9(10) COMP OCCURS 3.
***** from the 20
01 BADGE-REC.
05 REQTYP1 PIC S9(10) COMP.
05 BADGE-NUM PIC S9(7).
05 FILLER PIC X(5).
***** data-or-stop-update records ********************************************
***** from the vax
01 REMOTE-DATA-REC.
05 REMOTE-DATA-WORD PIC S9(10) COMP OCCURS 65.
***** from the 20
01 DATA-RECORD.
05 REQTYP2 PIC S9(10) COMP.
05 WS-JOB-TICKET.
10 WS-NAME PIC X(30).
10 WS-COST-CENTER PIC X(4).
10 WS-WK-END-DATE PIC 9(6).
10 WS-TOTAL-HRS COMP-1.
10 WS-COUNT PIC S9(10) COMP.
10 WS-DETAIL-LINES OCCURS 10.
15 WS-ACTIV-CD PIC X(4).
15 WS-PL-NUM PIC X(4).
15 WS-DIS-NUM PIC 9(5) COMP.
15 WS-MFG-NUM PIC 9(5) COMP.
15 WS-HOURS COMP-1.
15 WS-OP-CD PIC X(4).
***** table of link status names **********************************************
01 NETWORK-LINK-STATUS-TABLE.
05 NETLN-ENTRY OCCURS 4 TO 6 DEPENDING ON SUB2 INDEXED BY NETIDX.
10 LINK-SYS-ORIG PIC S9(10) COMP.
* system or origin of remote program, 1=DEC10/DEC20, 2=Vax
10 NETLN PIC S9(10) COMP.
* network logical name assigned by dit routine NFOPP.
10 LINK-STATE PIC S9(10) COMP.
* link state (see net-link-status below) used to keep track of
* what each link is doing, so that more than one link can be
* serviced at a time.
10 LINK-BADGE-NUM PIC S9(7).
* keep track of which badge number this link is interested in
***** table of link information ***********************************************
01 NET-LINK-STATUS.
* link-state (above contains the relative state of a network
* link at any given time. A list of possible link states and
* their names is given below in the net-link-status table.
05 UNOP PIC S9(10) COMP VALUE 0.
* link is unopened, code is 0
05 O-PASS PIC S9(10) COMP VALUE 1.
* link is passive open, code is 1
05 A-BDGORCLS PIC S9(10) COMP VALUE 2.
* link is active open and awaiting either a disconnect request
* or another badge number, code is 2
05 A-ABORDAT PIC S9(10) COMP VALUE 3.
* link is active open and awaiting either the remaining data or
* a request to quit and not update the record, code is 3
05 A-WAIT PIC S9(10) COMP VALUE 4.
* link is active open and waiting for data to be processed by
* the server, code is 4
05 A-UNKN PIC S9(10) COMP VALUE 5.
* link is active open and an unknown event has occured!, code is 5
05 P-UNKN PIC S9(10) COMP VALUE 6.
* link is passive open and an unknown event has occured!, code is 6
05 A-ID PIC S9(10) COMP VALUE 7.
* link is active open and waiting to be sent the id record
***** table of message values sent between server and remote ******************
01 MESSAGE-DATA-VALUES.
* This table lists the possible values that can be moved into
* the message-data field which is used to send messages between
* the server and the remote programs. All of the programs use
* these values as their message codes or status returns.
05 B-EXIST PIC S9(10) COMP VALUE 0.
* badge number presently exits in ISAM file
05 B-NOTEXIST PIC S9(10) COMP VALUE 1.
* badge number presently does no exist in ISAM file.
05 REQ-ERROR PIC S9(10) COMP VALUE 2.
* error in request type, not recognized by server
05 UPDA-OK PIC S9(10) COMP VALUE 3.
* update finished allright.
05 UPDA-ERR PIC S9(10) COMP VALUE 4.
* error in update, update aborted
05 UPDA-ABORT PIC S9(10) COMP VALUE 5.
* the update was aborted (as requested, hopefully!)
***** dil call return code parameters *****************************************
01 DILINI-PARAMETERS.
05 DIL-INIT-STATUS PIC S9(9) COMP.
05 DIL-STATUS PIC S9(9) COMP.
05 DIL-SEVERITY PIC S9(9) COMP.
05 DIL-MESSAGE PIC S9(9) COMP.
01 RET-NETLN PIC S9(10) COMP.
***** dil interface files *****************************************************
01 COPY-INTER-FILES.
COPY DIL OF "SYS:DIL.LIB".
COPY DIT OF "SYS:DIL.LIB".
COPY DIX OF "SYS:DIL.LIB".
***** DCR call parameters*****************************************************
01 FFDS.
05 RQ1-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 RQ1-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 RQ2-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 RQ2-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 BDG-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 BDG-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 NAM-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 NAM-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 CC-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 CC-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 WK-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 WK-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 TOT-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 TOT-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 CNT-SRC-DSCR PIC S9(10) COMP OCCURS 3.
05 CNT-DST-DSCR PIC S9(10) COMP OCCURS 3.
05 DETAIL-LINE-FLD-FFDS OCCURS 10.
10 ACT-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 ACT-DST-DSCR PIC S9(10) COMP OCCURS 3.
10 PLN-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 PLN-DST-DSCR PIC S9(10) COMP OCCURS 3.
10 DIS-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 DIS-DST-DSCR PIC S9(10) COMP OCCURS 3.
10 MNF-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 MNF-DST-DSCR PIC S9(10) COMP OCCURS 3.
10 HRS-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 HRS-DST-DSCR PIC S9(10) COMP OCCURS 3.
10 OPC-SRC-DSCR PIC S9(10) COMP OCCURS 3.
10 OPC-DST-DSCR PIC S9(10) COMP OCCURS 3.
01 BYTE-SIZES.
05 BYTSZ6 PIC S9(10) COMP VALUE 6.
05 BYTSZ8 PIC S9(10) COMP VALUE 8.
05 BYTSZ36 PIC S9(10) COMP VALUE 36.
01 SRC-BYO PIC S9(10) COMP.
01 DST-BYO PIC S9(10) COMP.
01 SRC-BIO PIC S9(10) COMP VALUE 0.
01 DST-BIO PIC S9(10) COMP VALUE 0.
***** dit call parameters *****************************************************
01 OBJID PIC X(16) VALUE "135" USAGE IS DISPLAY-7.
01 DESCR PIC X(16) VALUE SPACES USAGE IS DISPLAY-7.
01 TASKNAME PIC X(16) VALUE SPACES USAGE IS DISPLAY-7.
01 NUMOPCHAR PIC S9(10) COMP VALUE 0.
01 OPCHAR PIC X(16) VALUE SPACES USAGE IS DISPLAY-7.
01 MSG-BYTSIZ PIC S9(10) COMP.
01 MSGLEN PIC S9(10) COMP.
01 SYNCH-DISCONN PIC S9(10) COMP VALUE 0.
01 USER-ABORT-DISCONN PIC S9(10) COMP VALUE 9.
01 DISCONN-TYPE PIC S9(10) COMP.
01 WHEEL-CHK PIC S9(10) COMP.
***** flags, subscripts, ******************************************************
01 BDG-FLAG PIC S9(10) COMP.
01 BIT-REMAINDER PIC S9(10) COMP.
77 SUB PIC S9(5) COMP.
77 SUB2 PIC S9(5) COMP.
77 DL-SUB PIC S9(5) COMP.
*******************************************************************************
PROCEDURE DIVISION.
*******************************************************************************
THE-TOP SECTION.
SET-STUFF-UP.
* open a dummy file to fool RMS into working!
OPEN OUTPUT DUMMY.
CLOSE DUMMY.
PERFORM SET-UP.
MAIN-STUFF.
PERFORM KEEP-LINKS-OPEN.
PERFORM WAIT-FOR-NETWORK-EVENT.
PERFORM WHAT-HAPPENED.
* done with event, go back and wait for the next event to occur
GO TO MAIN-STUFF.
*******************************************************************************
SET-UP SECTION.
*******************************************************************************
CHECK-FOR-WHEEL.
* if the process does not have wheel enabled then it can not
* open more than 4 network links... so check to see if wheel is
* enabled and then set sub2 which is the number of links to open
* (four for non-wheel and six for wheel).
ENTER MACRO PROCES USING WHEEL-CHK.
IF WHEEL-CHK = 1 SET SUB2 TO 6
ELSE IF WHEEL-CHK = 0 SET SUB2 TO 4
ELSE DISPLAY "%Invalid return from wheel check subroutine. "
DISPLAY " Process halted"
STOP RUN.
SET-UP-DILINI.
* set up dilini in order to have it intercept the status returns
* for each of the various calls to dil routines
ENTER MACRO DILINI USING DIL-INIT-STATUS, DIL-STATUS,
DIL-MESSAGE, DIL-SEVERITY.
IF DIL-INIT-STATUS NOT = 1
DISPLAY "%Invalid return from DILINI call. Process halted."
STOP RUN.
SET-UP-FFDS.
* if data comes from a vax, it will have to be converted to
* Tops-20 format... make the field descriptors to facilitate
* the conversions
PERFORM MAKE-FFDS THRU MFFDS-EXIT.
*******************************************************************************
MAIN SECTION.
*******************************************************************************
KEEP-LINKS-OPEN.
* keep links open for connections from remote users
PERFORM CHECK-ON-LINKS THRU CHECK-EXIT
VARYING NETIDX FROM 1 BY 1 UNTIL NETIDX > SUB2.
CHECK-ON-LINKS.
* this paragraph is called from the Main Section and is used to
* keep checking on the state of all the links. if any of the
* links is unopened, then reopen it
IF LINK-STATE(NETIDX) = UNOP PERFORM OPEN-ONE-PASSIVE-LINK THRU OPEN-EXIT.
CHECK-EXIT.
OPEN-ONE-PASSIVE-LINK.
* this paragraph is called from the Check-On-Links paragraph of
* the Main Section. if it is discovered that a link is closed
* at any time then come to this paragraph and open that link
* back up.
ENTER MACRO NFOPP USING NETLN(NETIDX), OBJID, DESCR, TASKNAME, DIT-WAIT-NO.
CHECK-NFOPP-STATUS.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " => Link " NETIDX " is open."
MOVE O-PASS TO LINK-STATE(NETIDX)
ELSE
PERFORM DIT-STAT-CHECK.
OPEN-EXIT.
WAIT-FOR-NETWORK-EVENT.
* use dit routine nfgnd to get information on asynchronous
* network events, wait for any network event to occur
MOVE -1 TO RET-NETLN.
ENTER MACRO NFGND USING RET-NETLN, DIT-WAIT-YES.
WHAT-HAPPENED.
* when a network event occurs, analyze the status return code
* from nfgnd to find out what happened, then perform the
* appropriate function
IF DIL-MESSAGE = DIT-C-DATAEVENT
PERFORM WHICH-LINK THRU WHICH-EXIT VARYING SUB FROM 1 BY 1
UNTIL SUB > SUB2
PERFORM PROCESS-DATA-EVENT THRU PD-EXIT
ELSE
IF DIL-MESSAGE = DIT-C-CONNECTEVENT
PERFORM WHICH-LINK THRU WHICH-EXIT VARYING SUB FROM 1 BY 1
UNTIL SUB > SUB2
PERFORM PROCESS-CONNECT THRU PC-EXIT
ELSE
IF DIL-MESSAGE = DIT-C-ABREJEVENT
PERFORM WHICH-LINK THRU WHICH-EXIT VARYING SUB FROM 1 BY 1
UNTIL SUB > SUB2
DISPLAY "?DIT$_ABREJEVENT:NFGND Link " NETIDX " aborted/rejected."
DISPLAY "Link " NETIDX " will be closed..."
MOVE USER-ABORT-DISCONN TO DISCONN-TYPE
PERFORM CLOSE-LINK THRU CL-EXIT
ELSE
IF DIL-SEVERITY = STS-K-SUCCESS
* this should not occur since we are 'waiting' in the call to nfgnd
DISPLAY "STS-K-SUCCESS:NFGND No event occured. Wait... "
ELSE
PERFORM DIT-STAT-CHECK.
*******************************************************************************
PROCESS-CONNECT SECTION.
*******************************************************************************
* when a connect event has occured the Main Section calls this
* section to process the connect (accept a link from a remote
* task)
ENTER MACRO NFACC USING NETLN(NETIDX), DIT-LTYPE-BINARY, NUMOPCHAR, OPCHAR.
IF DIL-SEVERITY = STS-K-SUCCESS
display " Link " netidx " is active."
MOVE A-ID TO LINK-STATE(NETIDX)
ELSE
PERFORM DIT-STAT-CHECK.
PC-EXIT.
*******************************************************************************
PROCESS-DATA-EVENT SECTION.
*******************************************************************************
* When a data event has occured the Main Section calls this
* section to process that event. Since there are a number of
* different possible data events, first decide which type of
* data event has occured. The Link-State field holds a value
* which indicates the type of event that is to be expected for
* the specified link at any given time. Therefore use the
* Link-State value to check which type of data event to process
* now.
IF LINK-STATE(NETIDX) = A-ID
PERFORM RECEIVE-ID-REC THRU R-ID-EXIT
ELSE
IF LINK-STATE(NETIDX) = A-BDGORCLS
PERFORM PROCESS-BDGORCLS THRU BDGORCLS-EXIT
ELSE IF LINK-STATE(NETIDX) = A-ABORDAT
PERFORM PROCESS-ABORDAT THRU ABORDAT-EXIT.
PD-EXIT.
*******************************************************************************
RECEIVE-ID-REC SECTION.
*******************************************************************************
RECEIVE-ID.
* receive a record (in DEC-20 format) from the remote program
* which will identify the remote system of origin as either VAX
* or 10/20.
MOVE 36 TO MSG-BYTSIZ.
MOVE 1 TO MSGLEN.
ENTER MACRO NFRCV USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN, MESSAGE-DATA,
DIT-MSG-MSG, DIT-WAIT-YES.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " NFRCV:INFO data receive was ok!"
ELSE
PERFORM DIT-STAT-CHECK.
* determine whether the remote system is a vax (code = 2) or a
* 10/20 (code = 1)
CHECK-SYSTEM-OF-ORIGIN.
IF MESSAGE-DATA = DIX-SYS-10-20 OR
MESSAGE-DATA = DIX-SYS-VAX
MOVE MESSAGE-DATA TO LINK-SYS-ORIG(NETIDX)
MOVE A-BDGORCLS TO LINK-STATE(NETIDX)
ELSE
DISPLAY " "
DISPLAY "%ERROR IN REMOTE SYSTEM CODE. PROCESS HALTED"
STOP RUN.
R-ID-EXIT.
*******************************************************************************
PROCESS-BDGORCLS SECTION.
*******************************************************************************
RECEIVE-BADGE-REC.
* receive a record in the remote system's native format which
* contains either a badge number to be processed or a request to
* disconnect the link because the remote task is through
IF LINK-SYS-ORIG(NETIDX) = DIX-SYS-10-20
PERFORM RECEIVE-10-20-BDG
ELSE
PERFORM RECEIVE-VAX-BDG.
CHECK-REQUEST-TYPE.
* If reqtyp1 = 0 then process badge number. If reqtyp1 = 1 then
* the remote program is requesting a disconnect. If processing
* of badge-num is requested, then save the badge-num in the
* Network-Link-Status-Table for further use. If disconnect is
* requested then close the link.
IF REQTYP1 = 0 MOVE BADGE-NUM TO LINK-BADGE-NUM(NETIDX)
ELSE IF REQTYP1 = 1 MOVE 0 TO LINK-BADGE-NUM(NETIDX)
MOVE SYNCH-DISCONN TO DISCONN-TYPE
PERFORM CLOSE-LINK THRU CL-EXIT
GO TO BDGORCLS-EXIT
ELSE DISPLAY " "
DISPLAY "%Error in request from remote process. Process halted."
STOP RUN.
CHECK-BADGE-NUMBER.
* search jt-fil for the record that corresponds to badge-num
OPEN INPUT-OUTPUT JT-FIL.
MOVE BADGE-NUM TO JT-BADGE-NUM.
READ JT-FIL KEY IS JT-BADGE-NUM
* if key was valid:
INVALID KEY MOVE B-NOTEXIST TO MESSAGE-DATA
DISPLAY "INFO-JTSERV:B-NOTEXIST Badge number " badge-num " does not exist in file."
CLOSE JT-FIL
GO TO SEND-MESSAGE.
* if key was valid:
MOVE B-EXIST TO MESSAGE-DATA.
DISPLAY "INFO-JTSERV:B-EXIST Badge number " badge-num " exists in file.".
CLOSE JT-FIL.
SEND-MESSAGE.
* Send the remote task a message indicating whether the badge
* number presently exists in the ISAM file or not.
* The possibile values for the message are:
* 0 = badge # exists
* 1 = badge number does not exits
MOVE 36 TO MSG-BYTSIZ.
MOVE 1 TO MSGLEN.
ENTER MACRO NFSND USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN,
MESSAGE-DATA, DIT-MSG-MSG.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "INFO-NFSND: Message send successful on link " NETIDX
ELSE
PERFORM DIT-STAT-CHECK.
MOVE A-ABORDAT TO LINK-STATE(NETIDX).
BDGORCLS-EXIT.
RECEIVE-10-20-BDG.
* if the remote system is also a 10/20, move the information
* directly into the badge-rec
MOVE 36 TO MSG-BYTSIZ.
MOVE 3 TO MSGLEN.
ENTER MACRO NFRCV USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN,
BADGE-REC, DIT-MSG-MSG, DIT-WAIT-YES.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " NFRCV:INFO data receive was ok!"
ELSE
PERFORM DIT-STAT-CHECK.
RECEIVE-VAX-BDG.
* if the remote system is a VAX, then move the information into
* a hold area and do data conversion, THEN move the data into
* the badge-rec
MOVE 8 TO MSG-BYTSIZ.
MOVE 11 TO MSGLEN.
ENTER MACRO NFRCV USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN,
BDGORCLS-REC, DIT-MSG-MSG, DIT-WAIT-YES.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " NFRCV:INFO data receive was ok!"
ELSE
PERFORM DIT-STAT-CHECK.
ENTER MACRO XCGEN USING RQ1-SRC-DSCR(1), RQ1-DST-DSCR(1).
IF DIL-SEVERITY NOT = STS-K-SUCCESS
PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of reqtyp1 is : " REQTYP1.
ENTER MACRO XCGEN USING BDG-SRC-DSCR(1), BDG-DST-DSCR(1).
IF DIL-SEVERITY NOT = STS-K-SUCCESS
PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of badge-num is : " BADGE-NUM.
*******************************************************************************
PROCESS-ABORDAT SECTION.
*******************************************************************************
* Receive a record in the remote system's native format which
* contains either job ticket data to be processed or a request
* to discontinue the record update process for this particular
* badge number (but NOT to close the link).
RECEIVE-DATA.
IF LINK-SYS-ORIG(NETIDX) = DIX-SYS-10-20
PERFORM RECEIVE-10-20-DATA
ELSE
PERFORM RECEIVE-VAX-DATA.
CHECK-REQUEST-TYPE.
* NOTE: if reqtyp2 = 1 didn't want to continue with update
* if reqtyp2 = 0 wanted to continue with update
IF REQTYP2 = 1
MOVE UPDA-ABORT TO MESSAGE-DATA
GO TO SEND-STATUS-TO-REMOTE
ELSE
IF REQTYP2 = 0
NEXT SENTENCE
ELSE DISPLAY " "
DISPLAY "%ERROR IN REMOTE SYSTEM CODE. PROCESS HALTED"
STOP RUN.
CONVERT-DATA-IF-NECESS.
* if the data is from a vax, then convert it to DEC20 format
IF LINK-SYS-ORIG(NETIDX) = DIX-SYS-VAX
PERFORM CONVERT-VAX-DATA THRU CVD-EXIT.
UPDATE-DATA-FILE.
MOVE SPACES TO JT-REC.
* an update of the data file was requested by the remote program
* now open the file to the correct record
MOVE 0 TO BDG-FLAG.
OPEN INPUT-OUTPUT JT-FIL.
MOVE LINK-BADGE-NUM(NETIDX) TO JT-BADGE-NUM.
READ JT-FIL KEY IS JT-BADGE-NUM
INVALID KEY DISPLAY "INFO-JTSERV: Badge number not exist in file."
MOVE B-NOTEXIST TO BDG-FLAG.
* first move the data from the ws-rec into the jt-rec
MOVE WS-NAME TO JT-NAME.
MOVE WS-COST-CENTER TO JT-COST-CENTER.
MOVE WS-WK-END-DATE TO JT-WK-END-DATE.
MOVE WS-TOTAL-HRS TO JT-TOTAL-HRS.
PERFORM MOVE-DETAIL-LINES THRU MOVE-DL-EXIT
VARYING DL-SUB FROM 1 BY 1 UNTIL DL-SUB > WS-COUNT.
* now write or rewrite the record
IF BDG-FLAG = B-EXIST
REWRITE JT-REC INVALID KEY DISPLAY "INVALID KEY ON REWRITE."
MOVE UPDA-ERR TO MESSAGE-DATA
GO TO CLOSE-FILE
ELSE IF BDG-FLAG = B-NOTEXIST
WRITE JT-REC INVALID KEY DISPLAY "INVALID KEY ON WRITE."
MOVE UPDA-ERR TO MESSAGE-DATA
GO TO CLOSE-FILE.
* if update ok, move upda-ok value to message-data to be sent to
* remote
MOVE UPDA-OK TO MESSAGE-DATA.
DISPLAY " Record written to RMS indexed file ok!! ".
CLOSE-FILE.
CLOSE JT-FIL.
SEND-STATUS-TO-REMOTE.
* send the remote program the status of the update: either
* upda-abort, upda-ok, or upda-err
MOVE 36 TO MSG-BYTSIZ.
MOVE 1 TO MSGLEN.
ENTER MACRO NFSND USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN,
MESSAGE-DATA, DIT-MSG-MSG.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "INFO-NFSND: Message send successful on link " NETIDX
ELSE
PERFORM DIT-STAT-CHECK.
MOVE A-BDGORCLS TO LINK-STATE(NETIDX).
ABORDAT-EXIT.
RECEIVE-10-20-DATA.
* If the remote system is also a 10/20, move the information
* directly into the data-rec.
MOVE 36 TO MSG-BYTSIZ.
MOVE 61 TO MSGLEN.
ENTER MACRO NFRCV USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN,
DATA-RECORD, DIT-MSG-MSG, DIT-WAIT-YES.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " NFRCV:INFO data receive was ok!"
ELSE
PERFORM DIT-STAT-CHECK.
RECEIVE-VAX-DATA.
* If the remots system is a VAX, then move the information into
* a hold area and do data conversion, THEN move the data into
* the data-rec.
MOVE 32 TO MSG-BYTSIZ.
MOVE 73 TO MSGLEN.
ENTER MACRO NFRCV USING NETLN(NETIDX), MSG-BYTSIZ, MSGLEN, REMOTE-DATA-REC,
DIT-MSG-MSG, DIT-WAIT-YES.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY " NFRCV:INFO data receive was ok!"
ELSE
PERFORM DIT-STAT-CHECK.
ENTER MACRO XCGEN USING RQ2-SRC-DSCR(1), RQ2-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of reqtyp2 is : " REQTYP2.
MOVE-DETAIL-LINES.
MOVE WS-ACTIV-CD(DL-SUB) TO JT-ACTIV-CD(DL-SUB).
MOVE WS-PL-NUM(DL-SUB) TO JT-PL-NUM(DL-SUB).
MOVE WS-DIS-NUM(DL-SUB) TO JT-DIS-NUM(DL-SUB).
MOVE WS-MFG-NUM(DL-SUB) TO JT-MFG-NUM(DL-SUB).
MOVE WS-HOURS(DL-SUB) TO JT-HOURS(DL-SUB).
MOVE WS-OP-CD(DL-SUB) TO JT-OP-CD(DL-SUB).
MOVE-DL-EXIT.
*******************************************************************************
CLOSE-LINK SECTION.
*******************************************************************************
* This section is used to close a link either when there is an
* abort/reject event or when a disconnect event is requested.
ENTER MACRO NFCLS USING NETLN(NETIDX), DISCONN-TYPE, NUMOPCHAR, OPCHAR.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "NFCLS:SUCCESS close successful."
MOVE UNOP TO LINK-STATE(NETIDX)
ELSE
IF DIL-MESSAGE = DIT-C-ABORTREJECT
DISPLAY "NFCLS:INFO ABRORTREJECT Link aborted before close done."
ELSE
PERFORM DIT-STAT-CHECK.
CL-EXIT.
*******************************************************************************
WHICH-LINK SECTION.
*******************************************************************************
* this section is called from various parts of the program and
* is used to determine which link of the in the
* network-link-status-table has had an event occur
IF RET-NETLN = NETLN(SUB)
SET NETIDX TO SUB
MOVE 7 TO SUB.
WHICH-EXIT.
*******************************************************************************
CONVERT-VAX-DATA SECTION.
*******************************************************************************
CONVERT-NAME-FIELD.
* convert name field
ENTER MACRO XCGEN USING NAM-SRC-DSCR(1), NAM-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of name is : " WS-NAME.
CONVERT-COST-CENTER-FLD.
* convert cost center field
ENTER MACRO XCGEN USING CC-SRC-DSCR(1), CC-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of cost-center is : " WS-COST-CENTER.
CONVERT-WK-END-DT-FLD.
* convert week ending date field
ENTER MACRO XCGEN USING WK-SRC-DSCR(1), WK-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of wk-end-date is : " WS-WK-END-DATE.
CONVERT-TOT-HRS-FLD.
* convert total hours field
ENTER MACRO XCGEN USING TOT-SRC-DSCR(1), TOT-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of total-hrs is : " WS-TOTAL-HRS.
CONVERT-WS-COUNT.
* convert count of projects field, ws-count = number of project
* lines in record
ENTER MACRO XCGEN USING CNT-SRC-DSCR(1), CNT-DST-DSCR(1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of ws-count is : " WS-COUNT.
PERFORM CONVERT-DETAIL-LINES THROUGH CONV-EXIT
VARYING DL-SUB FROM 1 BY 1 UNTIL DL-SUB > WS-COUNT.
CVD-EXIT.
CONVERT-DETAIL-LINES.
CONVERT-ACTIV-CD-FLD.
* convert acitvity code field
ENTER MACRO XCGEN USING ACT-SRC-DSCR(DL-SUB,1), ACT-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of activ-cd is : " WS-ACTIV-CD(DL-SUB).
CONVERT-PL-NUM-FLD.
* convert product line number field
ENTER MACRO XCGEN USING PLN-SRC-DSCR(DL-SUB,1), PLN-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of pl-num is : " WS-PL-NUM(DL-SUB).
CONVERT-DIS-NUM-FLD.
* convert discrete number field
ENTER MACRO XCGEN USING DIS-SRC-DSCR(DL-SUB,1), DIS-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of dis-num is : " WS-DIS-NUM(DL-SUB).
CONVERT-MANUF-NUM-FLD.
* convert manufacturing number field
ENTER MACRO XCGEN USING MNF-SRC-DSCR(DL-SUB,1), MNF-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of mfg-num is : " ws-mfg-num(dl-sub).
CONVERT-PROJ-HRS-FLD.
* convert project hours field
ENTER MACRO XCGEN USING HRS-SRC-DSCR(DL-SUB,1), HRS-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of hours is : " WS-HOURS(DL-SUB).
CONVERT-OP-CD-FLD.
* convert operations code field
ENTER MACRO XCGEN USING OPC-SRC-DSCR(DL-SUB,1), OPC-DST-DSCR(DL-SUB,1).
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
DISPLAY " Conversion of op-cd is : " WS-OP-CD(DL-SUB).
CONV-EXIT.
*******************************************************************************
MAKE-FFDS SECTION.
*******************************************************************************
* make reqtyp1 field ffds
ENTER MACRO XDESCR USING RQ1-SRC-DSCR(1), BDGORCLS-REC, DIX-SYS-VAX,
BYTSZ8, 0, 0, DIX-DT-SBF32, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING RQ1-DST-DSCR(1), REQTYP1, DIX-SYS-10-20,
BYTSZ36, 0, 0, DIX-DT-SBF36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make badge number field ffds
ENTER MACRO XDESCR USING BDG-SRC-DSCR(1), BDGORCLS-REC, DIX-SYS-VAX,
BYTSZ8, 4, 0, DIX-DT-ASCII-8, 7, 0,
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING BDG-DST-DSCR(1), BADGE-NUM, DIX-SYS-10-20,
BYTSZ6, 0, 0, DIX-DT-SIXBIT, 7, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make name field ffds
ENTER MACRO XDESCR USING NAM-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 4, 0, DIX-DT-ASCII-8, 30, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING NAM-DST-DSCR(1), DATA-RECORD, DIX-SYS-10-20,
BYTSZ6, 6, 0, DIX-DT-SIXBIT, 30, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make reqtyp2 field ffds
ENTER MACRO XDESCR USING RQ2-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 0, 0, DIX-DT-SBF32, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING RQ2-DST-DSCR(1), REQTYP2, DIX-SYS-10-20,
BYTSZ36, 0, 0, DIX-DT-SBF36, 0, 0
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make cost center field ffds
ENTER MACRO XDESCR USING CC-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 34, 0, DIX-DT-ASCII-8, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING CC-DST-DSCR(1), DATA-RECORD, DIX-SYS-10-20,
BYTSZ6, 36, 0, DIX-DT-SIXBIT, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make week ending date field ffds
ENTER MACRO XDESCR USING WK-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 38, 0, DIX-DT-ASCII-8, 6, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING WK-DST-DSCR(1), DATA-RECORD, DIX-SYS-10-20,
BYTSZ6, 40, 0, DIX-DT-SIXBIT, 6, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make total hours field ffds
ENTER MACRO XDESCR USING TOT-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 44, 0, DIX-DT-F-FLOAT, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING TOT-DST-DSCR(1), DATA-RECORD, DIX-SYS-10-20,
BYTSZ36, 8, 0, DIX-DT-FLOAT-36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make count (of projects) field ffds
ENTER MACRO XDESCR USING CNT-SRC-DSCR(1), REMOTE-DATA-REC, DIX-SYS-VAX,
BYTSZ8, 48, 0, DIX-DT-SBF32, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ENTER MACRO XDESCR USING CNT-DST-DSCR(1), DATA-RECORD, DIX-SYS-10-20,
BYTSZ36, 9, 0, DIX-DT-SBF36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
MOVE 48 TO SRC-BYO.
MOVE 56 TO DST-BYO.
PERFORM MAKE-DETAIL-LINES-FFDS THRU MDLFFDS-EXIT
VARYING DL-SUB FROM 1 BY 1 UNTIL DL-SUB > 10.
MFFDS-EXIT.
MAKE-DETAIL-LINES-FFDS.
* make activity code field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING ACT-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-ASCII-8, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +4 TO DST-BYO.
ENTER MACRO XDESCR USING ACT-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ6, DST-BYO, 0, DIX-DT-SIXBIT, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make product line number field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING PLN-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-ASCII-8, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +4 TO DST-BYO.
ENTER MACRO XDESCR USING PLN-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ6, DST-BYO, 0, DIX-DT-SIXBIT, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make discrete number field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING DIS-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-SBF32, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +4 TO DST-BYO.
DIVIDE DST-BYO BY 6 GIVING DST-BYO REMAINDER BIT-REMAINDER.
IF BIT-REMAINDER > 0 ADD +1 TO DST-BYO.
ENTER MACRO XDESCR USING DIS-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ36, DST-BYO, 0, DIX-DT-SBF36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make manufacturing number field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING MNF-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-SBF32, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +1 TO DST-BYO.
ENTER MACRO XDESCR USING MNF-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ36, DST-BYO, 0, DIX-DT-SBF36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make project hours field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING HRS-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-F-FLOAT, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +1 TO DST-BYO.
ENTER MACRO XDESCR USING HRS-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ36, DST-BYO, 0, DIX-DT-FLOAT-36, 0, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
* make operations code field ffds
ADD +4 TO SRC-BYO.
ENTER MACRO XDESCR USING OPC-SRC-DSCR(DL-SUB,1), REMOTE-DATA-REC,
DIX-SYS-VAX, BYTSZ8, SRC-BYO, 0, DIX-DT-ASCII-8, 4, 0.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
ADD +1 TO DST-BYO.
MULTIPLY DST-BYO BY 6 GIVING DST-BYO.
ENTER MACRO XDESCR USING OPC-DST-DSCR(DL-SUB,1), DATA-RECORD,
DIX-SYS-10-20, BYTSZ6, DST-BYO, 0, DIX-DT-SIXBIT, 4, 0.
ADD +2 TO DST-BYO.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE PERFORM DCR-STATUS-CHECK THRU DCR-STATUS-EXIT.
MDLFFDS-EXIT.
*******************************************************************************
DCR-STATUS-CHECK SECTION.
*******************************************************************************
* This section is performed whenever a call is made to XDESCR
* and XCGEN (the data conversion routines). It is used to
* determine the status returned from the attempted conversion.
IF DIL-SEVERITY = STS-K-SUCCESS NEXT SENTENCE
ELSE
IF DIL-SEVERITY = STS-K-INFO
PERFORM DCR-INFO-RET-CHECK THRU CI-EXIT
ELSE PERFORM DCR-ERROR-RET-CHECK THRU CE-EXIT.
DCR-STATUS-EXIT.
DCR-INFO-RET-CHECK.
IF DIL-MESSAGE = DIX-C-ROUNDED
DISPLAY "DCR:STS$K_INFO Result is rounded."
ELSE
IF DIL-MESSAGE = DIX-C-TRUNC
DISPLAY "DCR:STS$K_INFO String too long for destination--truncated.".
CI-EXIT.
DCR-ERROR-RET-CHECK.
IF DIL-MESSAGE = DIX-C-TOOBIG
DISPLAY "DCR:STS$K_SEVERE Converted source field too large for destination field"
ELSE
IF DIL-MESSAGE = DIX-C-INVDATTYP
DISPLAY "DCR:STS$K_SEVERE Invalid data type."
ELSE
IF DIL-MESSAGE = DIX-C-UNKARGTYP
DISPLAY "DCR:STS$K_SEVERE Argument passed by descriptor is unknown type."
ELSE
IF DIL-MESSAGE = DIX-C-UNKSYS
DISPLAY "DCR:STS$K_SEVERE Unknown system of origin specified."
ELSE
IF DIL-MESSAGE = DIX-C-INVLNG
DISPLAY "DCR:STS$K_SEVERE Scale factor invalid or unspecified."
ELSE
IF DIL-MESSAGE = DIX-C-INVSCAL
DISPLAY "DCR:STS$K_SEVERE Scale factor invalid or unspecified."
ELSE
IF DIL-MESSAGE = DIX-C-GRAPHIC
DISPLAY "DCR:STS$K_WARNING Graphic charater changed in conversion"
ELSE
IF DIL-MESSAGE = DIX-C-FMTLOST
DISPLAY "DCR:STS$K_WARNING Format effector gained or lost in conversion."
ELSE
IF DIL-MESSAGE = DIX-C-NONPRINT
DISPLAY "DCR:STS$K_WARNING Non-printing character gained or lost in conversion."
ELSE
IF DIL-MESSAGE = DIX-C-UNIMP
DISPLAY "DCR:STS$K_SEVERE Unimplemented conversion."
ELSE
IF DIL-MESSAGE = DIX-C-INVALCHAR
DISPLAY "DCR:STS$K_ERROR Invalid character in source field or conversion table."
ELSE
IF DIL-MESSAGE = DIX-C-ALIGN
DISPLAY "DCR:STS$K_SEVERE Invalid alignment for data type."
ELSE
IF DIL-MESSAGE = DIX-C-UNNORM
DISPLAY "DCR:STS$K_SEVERE Floating point number improperly normalized."
ELSE
IF DIL-MESSAGE = DIX-C-IMPOSSIBLE
DISPLAY "DCR:STS$K_SEVERE Total internal fuckup."
ELSE
IF DIL-MESSAGE = DIX-C-UNSIGNED
DISPLAY "DCR:STS$K_ERROR Negative value moved to unsigned field."
ELSE
IF DIL-MESSAGE = DIX-C-INVBYTSIZ
DISPLAY "DCR:STS$K_SEVERE Invalid byte size specified."
ELSE DISPLAY "DCR:STS$K_SEVERE Unrecognized message code returned.".
DISPLAY "%Process halted due to severity of error return".
DISPLAY " Dil-Status was: " DIL-STATUS.
DISPLAY " Dil-Message was: " DIL-MESSAGE.
DISPLAY " Dil-Severity was: " DIL-SEVERITY.
STOP RUN.
CE-EXIT.
*******************************************************************************
DIT-STAT-CHECK SECTION.
*******************************************************************************
* This section is performed whenever a call is made to one of
* the DIT routines and an erroneous status code was returned.
* It is used to determine the error returned from the routine.
IF DIL-MESSAGE = DIT-C-OVERRUN
DISPLAY "?DIT$_OVERRUN: Data overrun."
ELSE
IF DIL-MESSAGE = DIT-C-INVARG
DISPLAY "%DIT$_INVARG: Invalid arguement. Process halted."
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-HORRIBLE
DISPLAY "%DIT$_HORRIBLE: Jsys Error. Process halted."
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-ABORTREJECT
DISPLAY "%DIT$_ABORTREJECT: Link abort/reject. Process halted."
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-INTERRUPT
DISPLAY "%DIT$_INTERRUPT: Not supported and should not occur"
DISPLAY " Process Halted."
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-NOTENOUGH
DISPLAY "%DIT$_NOTENOUGH: Required amt of data not available."
DISPLAY " Process Halted."
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-TOOMANY
DISPLAY "%DIT$_TOOMANY: Too many link/no more interrupt channels"
STOP RUN
ELSE
IF DIL-MESSAGE = DIT-C-INTDATAEVENT
DISPLAY "%DIT$_INTDATAEVENT: Not supported and should not occur."
DISPLAY " Process Halted."
STOP RUN
ELSE
DISPLAY "%DIT: Invalid or unexpected status return code. "
DISPLAY "%Process Halted."
STOP RUN.