Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-documentation/jtvrpt.cbl
There are 22 other files named jtvrpt.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID.
JTVRPT.
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 a program that "lives" on the DEC-20 and
writes a remote sequential ASCII file on the VAX. It will
open a link and use DAP routines to handle remote file access.
INSTALLATION.
DEC-MARLBOROUGH.
DATE-WRITTEN.
JUNE 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'5', '06-Jan-83', 'Sandy Clemens')
* %( Make JTVRPT prompt for password neater. File: 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 )%
*
* 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 JT-FIL ASSIGN TO DSK
ORGANIZATION IS RMS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS BADGE-NUM.
DATA DIVISION.
FILE SECTION.
FD JT-FIL LABEL RECORDS ARE STANDARD
VALUE OF IDENTIFICATION IS "JOBTICRMS".
01 JT-REC.
05 NAME PIC X(30).
05 BADGE-NUM PIC 9(7).
05 COST-CENTER PIC X(4).
05 WK-END-DATE PIC 9(6).
05 TOTAL-HRS COMP-1.
05 DETAIL-LINE OCCURS 10.
15 ACTIV-CODE PIC X(4).
15 PROD-LINE PIC X(4).
15 DISCR-NUM PIC 9(5) COMP.
15 MFG-NUM PIC 9(5) COMP.
15 HOURS COMP-1.
15 OPER-CODE PIC X(4).
WORKING-STORAGE SECTION.
01 DILINI-PARAMETERS.
05 DIL-INIT-STATUS PIC S9(10) COMP.
05 DIL-STATUS PIC S9(10) COMP.
05 DIL-SEVERITY PIC S9(10) COMP.
05 DIL-MESSAGE PIC S9(10) COMP.
01 VAX-FILNO PIC S9(10) COMP.
01 VAX-FILNAM PIC X(39) VALUE "SPAGS::JTSUM.RPT" USAGE DISPLAY-7.
01 VAX-USER PIC X(39) VALUE "SCLEMENS" USAGE DISPLAY-7.
01 VAX-PSWD PIC X(39) USAGE DISPLAY-7.
01 VAX-ACCNT PIC X(39) USAGE DISPLAY-7.
01 REC-FOR-CONVERSION.
05 CONV-NAME PIC X(30).
05 FILLER PIC X VALUE SPACES.
05 CONV-BADGE-NUM PIC X(7).
05 FILLER PIC X VALUE SPACES.
05 CONV-COST-CENTER PIC X(5).
05 FILLER PIC XX VALUE SPACES.
05 CONV-DATE PIC X(6).
01 VAX-TRANS-REC PIC X(52) USAGE DISPLAY-7.
01 EOF-FLAG PIC X.
88 NOT-END-OF-FILE VALUE "N".
88 END-OF-FILE VALUE "Y".
01 COPY-DIL-INTERFILS.
COPY DIX OF "SYS:DIL.LIB".
COPY DIT OF "SYS:DIL.LIB".
COPY DIL OF "SYS:DIL.LIB".
77 ANS PIC X.
77 KNT PIC 99 COMP VALUE 0.
77 WS-COMMAND PIC X(10).
77 RET-CODE PIC S9(10) COMP.
*******************************************************************************
PROCEDURE DIVISION.
*******************************************************************************
THE-TOP SECTION.
PERFORM START-UP.
* PERFORM OPEN-REMOTE-FILE.
perform main.
* PERFORM WRITE-REPORT-HEADER.
PERFORM PROCESS-RECORD THRU PROCESS-EXIT UNTIL END-OF-FILE.
PERFORM FINISH-UP.
STOP RUN.
*******************************************************************************
START-UP SECTION.
*******************************************************************************
INITIALIZE-DIL.
CALL DILINI USING DIL-INIT-STATUS,
DIL-STATUS,
DIL-MESSAGE,
DIL-SEVERITY.
IF DIL-INIT-STATUS NOT = 1
DISPLAY "%Fatal error: Unsuccessful return from DILINI routine."
DISPLAY "%Process halted."
STOP RUN.
INITIALIZE-DATA-FILE.
MOVE "N" TO EOF-FLAG.
OPEN INPUT JT-FIL.
*******************************************************************************
MAIN SECTION.
*******************************************************************************
GET-VAX-PSWD.
DISPLAY "Enter the password for account: " VAX-USER.
ACCEPT VAX-PSWD.
OPEN-REMOTE-FILE.
CALL ROPEN USING VAX-FILNO, VAX-FILNAM, VAX-USER, VAX-PSWD,
VAX-ACCNT, DIT-MODE-WRITE, DIT-TYPE-ASCII,
DIT-RFM-FIXED, DIT-RAT-ENVELOPE, 52, 7.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "ROP$OK Open successful."
ELSE
PERFORM ANALYZE-DIL-STATUS
STOP RUN.
WRITE-REPORT-HEADER.
MOVE "NAME" TO CONV-NAME.
MOVE "BDG-NUM" TO CONV-BADGE-NUM.
MOVE "C-C" TO CONV-COST-CENTER.
MOVE "DATE" TO CONV-DATE.
PERFORM CONVERT-LOCAL-DATA THRU PROCESS-EXIT.
*******************************************************************************
FINISH-UP SECTION.
*******************************************************************************
CLOSE-LOCAL-DATA-FILE.
CLOSE JT-FIL.
CLOSE-REMOTE-REPORT-FILE.
CALL RCLOSE USING VAX-FILNO,
DIT-OPT-NOTHING.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "RCL$OK Close successful."
ELSE
PERFORM ANALYZE-DIL-STATUS
STOP RUN.
*******************************************************************************
PROCESS-RECORD SECTION.
*******************************************************************************
READ-LOCAL-DATA-RECORD.
READ JT-FIL NEXT
AT END MOVE "Y" TO EOF-FLAG
GO TO PROCESS-EXIT.
DISPLAY-NAME.
DISPLAY "Name is : " NAME.
MOVE-LOCAL-DATA.
MOVE NAME TO CONV-NAME.
MOVE BADGE-NUM TO CONV-BADGE-NUM.
MOVE COST-CENTER TO CONV-COST-CENTER.
MOVE WK-END-DATE TO CONV-DATE.
CONVERT-LOCAL-DATA.
CALL CVGEN USING
REC-FOR-CONVERSION, DIX-SYS-10-20, 6, 0, 0, DIX-DT-SIXBIT, 52, 0,
VAX-TRANS-REC, DIX-SYS-10-20, 7, 0, 0, DIX-DT-ASCII-7, 52, 0.
CHECK-CONVERSION-STATUS.
IF DIL-SEVERITY = STS-K-SUCCESS
NEXT SENTENCE
ELSE
IF DIL-MESSAGE = DIX-C-ROUNDED DISPLAY "STS$K_INFO Result is rounded."
ELSE
IF DIL-MESSAGE = DIX-C-TRUNC
DISPLAY "STS$K_INFO Destination too long--truncated."
ELSE
IF DIL-SEVERITY NOT = STS-K-INFO
PERFORM ANALYZE-DIX-ERROR
STOP RUN.
WRITE-REMOTE-RECORD.
CALL RWRITE USING VAX-FILNO,
7,
52,
VAX-TRANS-REC.
IF DIL-SEVERITY = STS-K-SUCCESS
DISPLAY "Record " BADGE-NUM " written successfully. "
ELSE
PERFORM ANALYZE-DIL-STATUS
STOP RUN.
PROCESS-EXIT.
*******************************************************************************
ANALYZE-DIL-STATUS SECTION.
*******************************************************************************
ANALYZE-STAT.
IF DIL-MESSAGE = DIT-C-TOOMANY
DISPLAY "%Error: too many files open, can't open another"
ELSE
IF DIL-MESSAGE = DIT-C-INVARG
DISPLAY "%Error: argument type or invalid arguement "
ELSE
IF DIL-MESSAGE = DIT-C-NETOPRFAIL
DISPLAY "?Network operation could not be done "
ELSE
IF DIL-MESSAGE = DIT-C-CHECKSUM
DISPLAY "?Checksum error "
ELSE
IF DIL-MESSAGE = DIT-C-UNSFILETYPE
DISPLAY "%Error: cannot write specified file type"
ELSE
IF DIL-MESSAGE = DIT-C-FILEINUSE
DISPLAY "%Error: file activity precludes this operation"
ELSE
IF DIL-MESSAGE = DIT-C-NOFILE
DISPLAY "?File does not exist or is not available"
ELSE
IF DIL-MESSAGE = DIT-C-HORRIBLE
DISPLAY "%Internal or system error."
else display "?Error not recognized... "
display "Dil-Status was " DIL-STATUS
display "Dil-Severity was " DIL-SEVERITY
display "Dil-Message was " DIL-MESSAGE
DISPLAY " ".
DISPLAY "%Process halted.".
*******************************************************************************
ANALYZE-DIX-ERROR SECTION.
*******************************************************************************
ANALYZE-STAT.
IF DIL-MESSAGE = DIX-C-TOOBIG
DISPLAY "STS$K_SEVERE Converted source field too large for destination"
ELSE
IF DIL-MESSAGE = DIX-C-INVDATTYP
DISPLAY "STS$K_SEVERE Invalid data type."
ELSE
IF DIL-MESSAGE = DIX-C-UNKARGTYP
DISPLAY "STS$K_SEVERE Argument passed by descriptor is unknown type."
ELSE
IF DIL-MESSAGE = DIX-C-UNKSYS
DISPLAY "STS$K_SEVERE Unknown system of origin specified."
ELSE
IF DIL-MESSAGE = DIX-C-INVLNG
DISPLAY "STS$K_SEVERE Scale factor invalid or unspecified."
ELSE
IF DIL-MESSAGE = DIX-C-INVSCAL
DISPLAY "STS$K_SEVERE Scale factor invalid or unspecified."
ELSE
IF DIL-MESSAGE = DIX-C-GRAPHIC
DISPLAY "STS$K_WARNING Graphic charater changed in conversion"
ELSE
IF DIL-MESSAGE = DIX-C-FMTLOST
DISPLAY "STS$K_WARNING Format effector gained or lost in conversion."
ELSE
IF DIL-MESSAGE = DIX-C-NONPRINT
DISPLAY "STS$K_WARNING Non-printing char gained or lost in conversion."
ELSE
IF DIL-MESSAGE = DIX-C-UNIMP
DISPLAY "STS$K_SEVERE Unimplemented conversion."
ELSE
IF DIL-MESSAGE = DIX-C-INVALCHAR
DISPLAY "STS$K_ERROR Invalid char in source field or conversion table."
ELSE
IF DIL-MESSAGE = DIX-C-ALIGN
DISPLAY "STS$K_SEVERE Invalid alignment for data type."
ELSE
IF DIL-MESSAGE = DIX-C-UNNORM
DISPLAY "STS$K_SEVERE Floating point number improperly normalized."
ELSE
IF DIL-MESSAGE = DIX-C-IMPOSSIBLE
DISPLAY "STS$K_SEVERE Total internal fuckup."
ELSE
IF DIL-MESSAGE = DIX-C-UNSIGNED
DISPLAY "STS$K_ERROR Negative value moved to unsigned field."
ELSE
IF DIL-MESSAGE = DIX-C-INVBYTSIZ
DISPLAY "STS$K_SEVERE Invalid byte size specified."
ELSE
DISPLAY "STS$K_SEVERE Unrecognized message code returned."
DISPLAY "Dil-Message was: " DIL-MESSAGE
DISPLAY "Dil-Severity was: " DIL-SEVERITY.
DISPLAY "%Process halted due to severity of error return.".