PDP-10 Archive: 7-documentation/jtterm.vax-cob from tops20-v7-ft-dist2-clock

Trailing-Edge - PDP-10 Archives - tops20-v7-ft-dist2-clock - 7-documentation/jtterm.vax-cob

There are 16 other files named jtterm.vax-cob in the archive. Click here to see a list.

IDENTIFICATION DIVISION.

PROGRAM-ID.

	JTTERM.

AUTHOR.

	DIGITAL EQUIPMENT CORPORATION.

	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1986.
	ALL RIGHTS RESERVED.
	
	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 THAT 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:.  )%
* 
* new_version (2, 1)
* 
* Edit (%O'13', '3-Jul-86', 'Sandy Clemens')
* %( Add V2.1 files to DS21:. )%

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.