Trailing-Edge
-
PDP-10 Archives
-
bb-ee87a-sb
-
10,7/dil/jtterm.cob
There are 5 other files named jtterm.cob in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID.
JTTERM.
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 test
application. It is the remote terminal interface, used to
collect data from the VAX for the "Job Ticket" system. A
similar remote program will be written to run on a DEC20. The
program JTSERV will be the server program which will live on
the 20.
INSTALLATION.
DEC-MARLBOROUGH.
DATE-WRITTEN.
AUGUST 17, 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'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 )%
*
* Edit (%O'11', '04-Feb-83', 'Sandy Clemens')
* %( Add "optional" trailing arguement to SYS$GETMSG call. It must
* be included in COBOL programs! FILE: JTTERM.VAX-COB )%
*
* new_version (2, 0)
*
* Edit (%O'12', '17-Apr-84', 'Sandy Clemens')
* %( Add V2 files to DS2:. )%
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.
VAX-11.
OBJECT-COMPUTER.
VAX-11.
DATA DIVISION.
WORKING-STORAGE SECTION.
***** badge-or-close-request records ******************************************
01 BADGE-REC.
05 REQTYP1 PIC S9(9) COMP.
05 BADGE-NUM PIC 9(7).
***** data-or-stop-update records *********************************************
01 DATA-RECORD.
05 REQTYP2 PIC S9(9) COMP.
05 JOB-TICKET.
10 NAME PIC X(30).
10 COST-CENTER PIC X(4).
10 WK-END-DATE PIC 9(6).
10 TOTAL-HRS COMP-1.
10 KOUNT PIC S9(9) COMP.
10 DETAIL-LINES OCCURS 10.
15 ACTIV-CD PIC X(4).
15 PL-NUM PIC X(4).
15 DIS-NUM PIC 9(5) COMP.
15 MFG-NUM PIC 9(5) COMP.
15 HOURS COMP-1.
15 OP-CD PIC X(4).
***** message records *********************************************************
01 MESSAGE-REC.
05 MESSAGE-DATA PIC S9(9) COMP.
05 MESSAGE-DAT2 PIC S9(9) COMP.
***** dec-20 data either going to the dec-20 or received from the 20 **********
01 CONV-REC.
05 CONV-DATA PIC X(5).
***** date edit fields ********************************************************
01 WEEK-ENDING.
05 MON PIC 99.
05 FILLER PIC X VALUE "/".
05 DY PIC 99.
05 FILLER PIC X VALUE "/".
05 YR PIC 99.
01 WS-DATE-HOLD.
05 DH-MO PIC 99.
05 DH-DY PIC 99.
05 DH-YR PIC 99.
***** fields used to "convert" data entered from the terminal into floating point data *****
01 ENTERED-FP-DATA.
05 ENTERED-FP-1 PIC XX.
05 ENTERED-FP-DOT PIC X.
05 ENTERED-FP-2 PIC XX.
01 HOLD-FP-DATA1.
05 HOLDFP1 PIC 99V.
05 HOLDFP2 PIC 99.
01 HOLD-FP-DATA2 PIC 99V99.
***** fields used to "convert" data entered from the terminal into fixed point binary data *****
01 ENTERED-FBIN-DATA.
05 ENTERED-FBIN PIC 9 OCCURS 5.
01 HOLD-FBIN-DATA1.
05 HOLDFBIN PIC 9 OCCURS 5.
01 HOLD-FBIN-DATA2 REDEFINES HOLD-FBIN-DATA1 PIC 9(5).
01 FBINSUB1 PIC 9.
01 FBINSUB2 PIC 9.
***** 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(9) COMP VALUE 0.
* badge number presently exits in ISAM file
05 B-NOTEXIST PIC S9(9) COMP VALUE 1.
* badge number presently does no exist in ISAM file.
05 REQ-ERROR PIC S9(9) COMP VALUE 2.
* error in request type, not recognized by server
05 UPDA-OK PIC S9(9) COMP VALUE 3.
* update finished allright.
05 UPDA-ERR PIC S9(9) COMP VALUE 4.
* error in update, update aborted
05 UPDA-ABORT PIC S9(9) COMP VALUE 5.
* the update was aborted (as requested, hopefully!)
***** dil interface files *****************************************************
01 COPY-INTER-FILES.
COPY DIL$COBOL OF "SYS$LIBRARY:DIL.TLB".
COPY DIT$COBOL OF "SYS$LIBRARY:DIL.TLB".
COPY DIX$COBOL OF "SYS$LIBRARY:DIL.TLB".
***** status return code parameters *******************************************
01 DIL-STATUS PIC S9(9) COMP.
01 DIL-MESSAGE-LEN PIC S9(9) COMP.
01 DIL-MESSAGE-TEXT PIC X(256).
01 DIL-MESSAGE-FLAGS PIC S9(9) COMP VALUE 15.
01 DIL-MATCH-COND PIC S9(9) COMP.
88 NO-MATCH VALUE 0.
88 FIRST-MATCH VALUE 1.
88 SECOND-MATCH VALUE 2.
01 DIL-GETMSG-STATUS PIC S9(9) COMP.
01 DIL-DUMMY.
05 DUMMY PIC S9(9) COMP OCCURS 4.
***** parameters for the call to DIX$BY_DET ***********************************
01 SRC-BYSZ PIC S9(9) COMP.
01 SRC-BYO PIC S9(9) COMP.
01 SRC-BTO PIC S9(9) COMP.
01 SRC-LEN PIC S9(9) COMP.
01 SRC-SCAL PIC S9(9) COMP.
01 DST-BYSZ PIC S9(9) COMP.
01 DST-BYO PIC S9(9) COMP.
01 DST-BTO PIC S9(9) COMP.
01 DST-LEN PIC S9(9) COMP.
01 DST-SCAL PIC S9(9) COMP.
***** parameters for the dit routines *****************************************
01 NETNODE PIC X(6) VALUE "KL2137".
01 OBJID PIC X(16) VALUE "135".
01 DESCR PIC X(16) VALUE SPACES.
01 TASKNAME PIC X(16) VALUE SPACES.
01 USRID PIC X(39) VALUE SPACES.
01 PSWD PIC X(39) VALUE SPACES.
01 ACCT PIC X(39) VALUE SPACES.
01 MSG-BYTSIZ PIC S9(9) COMP.
01 MSGLEN PIC S9(9) COMP.
01 OPTCHR PIC X(16) VALUE SPACES.
***** etc *********************************************************************
77 WS-COMMAND PIC X(10).
77 NETLN PIC S9(9) COMP.
77 ANS PIC XXX.
*******************************************************************************
PROCEDURE DIVISION.
*******************************************************************************
THE-TOP SECTION.
TOP-PARA.
DISPLAY " ".
DISPLAY "Welcome to Job Tickets.".
DISPLAY " ".
PERFORM INIT-LINK.
PERFORM PROMPT THRU PROMPT-EXIT.
PERFORM FINISH-UP.
STOP RUN.
*******************************************************************************
INIT-LINK SECTION.
*******************************************************************************
OPEN-BINARY-ACTIVE-LINK.
* establish binary active link to server on dec-20
CALL "DIT$NFOPB" USING NETLN, NETNODE, OBJID, DESCR, TASKNAME,
USRID, PSWD, ACCT, OPTCHR, DIT$K_WAIT_YES
GIVING DIL-STATUS.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Binary link open OK!"
ELSE
DISPLAY " "
DISPLAY "%NFOPB Fatal Error. Cannot open link. Process halted."
PERFORM DIL-STATUS-ABEND.
CONVERT-ID.
* Tell the server program that we are a VAX, and therefore VAX
* data will be passed over this link. First convert the data to
* DEC20 format.
MOVE DIX$K_SYS_VAX TO MESSAGE-DATA.
MOVE 8 TO SRC-BYSZ.
MOVE 36 TO DST-BYSZ.
MOVE 0 TO SRC-BYO SRC-BTO SRC-LEN SRC-SCAL
DST-BYO DST-BTO DST-LEN DST-SCAL.
CALL "DIX$BY_DET" USING
MESSAGE-DATA, DIX$K_SYS_VAX, SRC-BYSZ, SRC-BYO, SRC-BTO,
DIX$K_DT_SBF32, SRC-LEN, SRC-SCAL,
CONV-DATA, DIX$K_SYS_10_20, DST-BYSZ, DST-BYO, DST-BTO,
DIX$K_DT_SBF36, DST-LEN, DST-SCAL
GIVING DIL-STATUS.
CHECK-STATUS.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Data Conversion OK!"
ELSE
PERFORM CONVERSION-STATUS-CHK THRU CSC-EXIT.
SEND-ID-TO-SERVER.
MOVE 36 TO MSG-BYTSIZ.
MOVE 1 TO MSGLEN.
CALL "DIT$NFSND" USING NETLN,
MSG-BYTSIZ,
MSGLEN,
CONV-DATA,
DIT$K_MSG_MSG
GIVING DIL-STATUS.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY "ID record sent to server OK."
ELSE
DISPLAY " "
DISPLAY "%NFSND Fatal Error in initialization. Process Halted."
PERFORM DIL-STATUS-ABEND.
MOVE LOW-VALUES TO MESSAGE-REC.
*******************************************************************************
PROMPT SECTION.
*******************************************************************************
DISPLAY-PROMPT.
DISPLAY "JTTERM>" WITH NO ADVANCING ACCEPT WS-COMMAND.
GET-COMMAND.
IF WS-COMMAND = "HELP" OR WS-COMMAND = "help"
OR WS-COMMAND = "HEL" OR WS-COMMAND = "hel"
OR WS-COMMAND = "HE" OR WS-COMMAND = "he"
OR WS-COMMAND = "H" OR WS-COMMAND = "h"
OR WS-COMMAND = "?"
PERFORM COMMAND-HELP THRU CHELP-EXIT
ELSE
IF WS-COMMAND = "UPDATE" OR WS-COMMAND = "update"
OR WS-COMMAND = "UPDAT" OR WS-COMMAND = "updat"
OR WS-COMMAND = "UPDA" OR WS-COMMAND = "upda"
OR WS-COMMAND = "UPD" OR WS-COMMAND = "upd"
OR WS-COMMAND = "UP" OR WS-COMMAND = "up"
OR WS-COMMAND = "U" OR WS-COMMAND = "u"
PERFORM UPDATE-TICKET THRU UPDATE-EXIT
ELSE
IF WS-COMMAND = "EXIT" OR WS-COMMAND = "exit"
OR WS-COMMAND = "EXI" OR WS-COMMAND = "exi"
OR WS-COMMAND = "EX" OR WS-COMMAND = "ex"
OR WS-COMMAND = "E" OR WS-COMMAND = "e"
GO TO PROMPT-EXIT
ELSE DISPLAY "?Command error: does not match keyword.".
GO TO DISPLAY-PROMPT.
PROMPT-EXIT.
*******************************************************************************
FINISH-UP SECTION.
*******************************************************************************
FINI.
MOVE 1 TO REQTYP1.
PERFORM SEND-REQ1-TO-SERV THRU 1EXIT.
IF DIL-STATUS IS SUCCESS
DISPLAY "Disconnect request sent to server ok."
DISPLAY " "
ELSE
DISPLAY "%NFSND Fatal Error while requesting disconnect."
DISPLAY " Process halted!"
DISPLAY " "
PERFORM DIL-STATUS-ABEND.
CALL "DIT$NFGND" USING NETLN, DIT$K_WAIT_YES GIVING DIL-STATUS.
CALL "LIB$MATCH_COND" USING DIL-STATUS,
DIT$_ABREJEVENT,
DIT$_DISCONNECTEVENT
GIVING DIL-MATCH-COND.
IF NO-MATCH
DISPLAY "NFGND%ERR Expected disconnectevent - status return incorrect."
DISPLAY "Dil-Status was: " DIL-STATUS
ELSE
DISPLAY " "
DISPLAY "NFGND$OK Disconnect OK".
*******************************************************************************
UPDATE-TICKET SECTION.
*******************************************************************************
ENTER-BADGE-NUM.
* first get the badge number and send it to the server
DISPLAY "Please enter your badge number: "
WITH NO ADVANCING ACCEPT BADGE-NUM.
DISPLAY " ".
SEND-BADGE-TO-SERVER.
MOVE 0 TO REQTYP1.
PERFORM SEND-REQ1-TO-SERV THRU 1EXIT.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Badge sent to server OK!"
ELSE
DISPLAY " "
DISPLAY "%NFSND Fatal Error while sending badge. Process halted."
PERFORM DIL-STATUS-ABEND.
RECEIVE-BADGE-MESSAGE.
PERFORM GET-MESSAGE-FROM-SERVER THRU 2EXIT.
ANALYZE-BADGE-RETURN.
* analyze message from server, display message to user
IF MESSAGE-DATA = B-EXIST
DISPLAY " "
DISPLAY "Badge number, " BADGE-NUM ", presently exists in the file."
DISPLAY " "
ELSE
DISPLAY " "
IF MESSAGE-DATA = B-NOTEXIST
DISPLAY "Badge number, " BADGE-NUM ", does not exist in the file."
DISPLAY " "
ELSE
DISPLAY "%Error in return code from server. Process aborted."
PERFORM DIL-STATUS-ABEND.
DECIDE-IF-TO-CONTINUE.
* now that you know the status of the badge-num, do you want to
* keep going?
DISPLAY "Do you want to continue the update? (enter Y or N): "
WITH NO ADVANCING ACCEPT ANS.
REACC.
IF ANS = "Y" OR ANS = "y"
PERFORM ACCEPT-OTHER-DATA THRU ACC-DAT-EXIT
MOVE 0 TO REQTYP2
ELSE
IF ANS = "N" OR ANS = "n" MOVE 1 TO REQTYP2
ELSE DISPLAY "(Y OR N): " WITH NO ADVANCING ACCEPT ANS
GO TO REACC.
SEND-DATA-TO-SERVER.
* request transfer of remaining (update) data to dec-20 server.
* (this will send the data-record, containing the data collected
* from the terminal, (or a discontinue-the-update request), to
* the server program).
MOVE 32 TO MSG-BYTSIZ.
MOVE 73 TO MSGLEN.
CALL "DIT$NFSND" USING NETLN, MSG-BYTSIZ, MSGLEN,
DATA-RECORD, DIT$K_MSG_MSG
GIVING DIL-STATUS.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Data record sent to server OK."
DISPLAY " "
ELSE
DISPLAY "%NFSND Fatal Error. Process Halted."
PERFORM DIL-STATUS-ABEND.
RECEIVE-DATA-MESSAGE.
PERFORM GET-MESSAGE-FROM-SERVER THRU 2EXIT.
CHECK-MSG.
* Check the message from the server. If reqtyp2 = 1 didn't want
* to continue with update. If reqtyp2 = 0 did want to continue
* with update.
IF REQTYP2 NOT = 0
NEXT SENTENCE
ELSE
IF MESSAGE-DATA = UPDA-OK DISPLAY "Update finished successfully."
GO TO UPDATE-EXIT
ELSE
IF MESSAGE-DATA = UPDA-ERR
DISPLAY "?Server update error -- update not completed"
GO TO UPDATE-EXIT
ELSE
DISPLAY "?Invalid return code from server while updating."
DISPLAY "?Update may not be complete."
GO TO UPDATE-EXIT.
IF REQTYP2 = 1 AND MESSAGE-DATA = UPDA-ABORT
DISPLAY "OK. Update discontinued."
ELSE
DISPLAY "?Invalid return code from server while aborting update".
UPDATE-EXIT.
*******************************************************************************
PERFORM-CALLS SECTION.
*******************************************************************************
SEND-REQ1-TO-SERV.
* request transfer of badge-number data to dec-20 server. (this
* will send the badge-rec to the server program).
MOVE 8 TO MSG-BYTSIZ.
MOVE 11 TO MSGLEN.
CALL "DIT$NFSND" USING NETLN, MSG-BYTSIZ, MSGLEN,
BADGE-REC, DIT$K_MSG_MSG
GIVING DIL-STATUS.
1EXIT.
GET-MESSAGE-FROM-SERVER.
* receive message back from server, either b-exist, b-notexist,
* or req-error.
MOVE 36 TO MSG-BYTSIZ.
MOVE 1 TO MSGLEN.
CALL "DIT$NFRCV" USING NETLN, MSG-BYTSIZ, MSGLEN, CONV-DATA,
DIT$K_MSG_MSG, DIT$K_WAIT_YES
GIVING DIL-STATUS.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Message returned from server OK!"
ELSE
DISPLAY "%NFRCV Fatal Error. Process halted."
PERFORM DIL-STATUS-ABEND.
CONVERT-MESSAGE-TO-VAX.
MOVE 36 TO SRC-BYSZ.
MOVE 8 TO DST-BYSZ.
MOVE 0 TO SRC-BYO SRC-BTO SRC-LEN SRC-SCAL
DST-BYO DST-BTO DST-LEN DST-SCAL.
CALL "DIX$BY_DET" USING
CONV-DATA, DIX$K_SYS_10_20, SRC-BYSZ, SRC-BYO, SRC-BTO,
DIX$K_DT_SBF36, SRC-LEN, SRC-SCAL,
MESSAGE-DATA, DIX$K_SYS_VAX, DST-BYSZ, DST-BYO, DST-BTO,
DIX$K_DT_SBF32, DST-LEN, DST-SCAL
GIVING DIL-STATUS.
CHECK-SEVERITY.
IF DIL-STATUS IS SUCCESS
DISPLAY " "
DISPLAY " Data Conversion OK!"
ELSE
PERFORM CONVERSION-STATUS-CHK THRU CSC-EXIT
DISPLAY "%Process halted."
STOP RUN.
2EXIT.
P-C-EXIT.
*******************************************************************************
COMMAND-HELP SECTION.
*******************************************************************************
COMMAND-HELP-TXT.
DISPLAY "The options are: UPDATE HELP EXIT ".
DISPLAY " ".
DISPLAY "UPDATE is for adding weekly project information for an employee.".
DISPLAY "HELP gives you this list of options. ".
DISPLAY "EXIT is for exiting. ".
DISPLAY " ".
CHELP-EXIT.
*******************************************************************************
ACCEPT-OTHER-DATA SECTION.
*******************************************************************************
ACC-PARA.
MOVE 0 TO TOTAL-HRS.
* Accept remaining data from terminal
DISPLAY " ".
DISPLAY "Please enter your full name, as it appears on your check: "
WITH NO ADVANCING ACCEPT NAME.
DISPLAY " ".
DISPLAY "Please enter your cost center number: "
WITH NO ADVANCING ACCEPT COST-CENTER.
DISPLAY " ".
DISPLAY "Please enter the 'week ending' date, that is, the date on".
DISPLAY "Saturday. Enter it in the form MM/DD/YY: "
WITH NO ADVANCING ACCEPT WEEK-ENDING.
MOVE DY TO DH-DY.
MOVE MON TO DH-MO.
MOVE YR TO DH-YR.
MOVE WS-DATE-HOLD TO WK-END-DATE.
DISPLAY " ".
DISPLAY "Now enter the detail lines for each project you are working on: ".
DISPLAY " ".
MOVE 0 TO KOUNT.
ACCEPT-DETAIL-LINES.
ADD +1 TO KOUNT.
DISPLAY "Enter the activity code for this project: "
WITH NO ADVANCING ACCEPT ACTIV-CD(KOUNT).
DISPLAY " ".
DISPLAY "Enter the product line code for this project: "
WITH NO ADVANCING ACCEPT PL-NUM(KOUNT).
DISPLAY " ".
DISPLAY "Enter the discrete number for this project: "
WITH NO ADVANCING ACCEPT ENTERED-FBIN-DATA.
MOVE ZEROS TO HOLD-FBIN-DATA1.
MOVE 5 TO FBINSUB2.
PERFORM MOVE-FBIN VARYING FBINSUB1 FROM 5 BY -1 UNTIL FBINSUB1 < 1.
MOVE HOLD-FBIN-DATA2 TO DIS-NUM(KOUNT).
DISPLAY " ".
DISPLAY "Enter the manufacturing job number for this project: "
WITH NO ADVANCING ACCEPT ENTERED-FBIN-DATA.
MOVE ZEROS TO HOLD-FBIN-DATA1.
MOVE 5 TO FBINSUB2.
PERFORM MOVE-FBIN VARYING FBINSUB1 FROM 5 BY -1 UNTIL FBINSUB1 < 1.
MOVE HOLD-FBIN-DATA2 TO MFG-NUM(KOUNT).
DISPLAY " ".
DISPLAY "Enter the number of hours you worked on this project this week.".
ENTER-HOURS-DATA.
DISPLAY "Enter it in EXACTLY the form 99.99. Include a decimal point! : "
WITH NO ADVANCING ACCEPT ENTERED-FP-DATA.
* Since a user cannot enter floating point data at the terminal,
* we have to "convert" the data entered at the terminal into
* floating point data.
IF ENTERED-FP-DOT NOT = "."
DISPLAY "You goofed! " GO TO ENTER-HOURS-DATA.
INSPECT ENTERED-FP-DATA REPLACING ALL " " BY "0".
MOVE ENTERED-FP-1 TO HOLDFP1.
MOVE ENTERED-FP-2 TO HOLDFP2.
MOVE HOLD-FP-DATA1 TO HOLD-FP-DATA2.
MOVE HOLD-FP-DATA2 TO HOURS(KOUNT).
DISPLAY " ".
DISPLAY "Enter the operation code for this project: "
WITH NO ADVANCING ACCEPT OP-CD(KOUNT).
DISPLAY " ".
ADD HOURS(KOUNT) TO TOTAL-HRS.
IF KOUNT < 10
DISPLAY "Do you want to add more project detail lines? (Y or N): "
WITH NO ADVANCING ACCEPT ANS
ELSE GO TO ACC-DAT-EXIT.
REACC.
IF ANS = "Y" OR ANS = "y"
GO TO ACCEPT-DETAIL-LINES
ELSE
IF ANS = "N" OR ANS = "n" NEXT SENTENCE
ELSE DISPLAY "(Y OR N): " WITH NO ADVANCING ACCEPT ANS
GO TO REACC.
ACC-DAT-EXIT.
MOVE-FBIN.
IF ENTERED-FBIN(FBINSUB1) = " " NEXT SENTENCE
ELSE MOVE ENTERED-FBIN(FBINSUB1) TO HOLDFBIN(FBINSUB2)
SUBTRACT 1 FROM FBINSUB2.
*******************************************************************************
DIL-STATUS-ABEND SECTION.
*******************************************************************************
DIL-ABNORMAL-END.
CALL "SYS$GETMSG" USING BY VALUE DIL-STATUS,
BY REFERENCE DIL-MESSAGE-LEN,
BY DESCRIPTOR DIL-MESSAGE-TEXT,
BY VALUE DIL-MESSAGE-FLAGS,
BY VALUE 0,
BY REFERENCE DIL-DUMMY
GIVING DIL-GETMSG-STATUS.
debug-1.
IF DIL-GETMSG-STATUS IS SUCCESS
DISPLAY DIL-MESSAGE-TEXT
ELSE DISPLAY " CANNOT GET MESSAGE TEXT ".
STOP RUN.
*******************************************************************************
CONVERSION-STATUS-CHK SECTION.
*******************************************************************************
DIX-ERR-CHECK.
CALL "SYS$GETMSG" USING BY VALUE DIL-STATUS,
BY REFERENCE DIL-MESSAGE-LEN,
BY DESCRIPTOR DIL-MESSAGE-TEXT,
BY VALUE DIL-MESSAGE-FLAGS,
BY VALUE 0
GIVING DIL-GETMSG-STATUS.
DISPLAY DIL-MESSAGE-TEXT.
CSC-EXIT.