Trailing-Edge
-
PDP-10 Archives
-
BB-H548C-BM
-
iql-source/iqes.cbl
There are 2 other files named iqes.cbl in the archive. Click here to see a list.
000100 IDENTIFICATION DIVISION.
000200
000300 PROGRAM-ID. IQES.
000400
000500 SECURITY. COPYRIGHT 1981 AZREX INC.
000600
000700 REMARKS. IQES20 IS THE SORT-CALL MODULE OF IQL3.0
000800 -INVOKES SORT20
000900 -TESTED WITH COBOL V12, SORT V4
001000
001100 ENVIRONMENT DIVISION.
001200 CONFIGURATION SECTION.
001300 SOURCE-COMPUTER. DECSYSTEM-20.
001400 OBJECT-COMPUTER. DECSYSTEM-20.
001500
001600 INPUT-OUTPUT SECTION.
001700 FILE-CONTROL.
001800
001900 SELECT CMD-FILE
002000 ASSIGN TO DSK
002100 RECORDING MODE IS BINARY.
002200
002300 I-O-CONTROL.
002400
002500 DATA DIVISION.
002600
002700 FILE SECTION.
002800
002900 FD CMD-FILE
003000 VALUE OF IDENTIFICATION IS TEMPNAME
003100 USER-NUMBER IS PPN
003200 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
003300 DATA RECORD IS CMD-FILE-REC.
003400 01 CMD-FILE-REC USAGE IS DISPLAY-7 PICTURE X(80).
003500
003600
003700 WORKING-STORAGE SECTION.
000000*
000000 01 COPYRIGHT-NOTICE PIC X(50) VALUE
000000 "COPYRIGHT 1981 - AZREX, INC. - ALL RIGHTS RESERVED".
000000*
003800
003900 01 JOB-NO PICTURE 9(03) COMP VALUE 0.
004000 01 PPN PICTURE S9(10) COMP VALUE 0.
004100 01 DUMMY PICTURE S9(10) COMP VALUE 0.
004200 01 SORT-NAM-FILE PIC X(12) DISPLAY-7 VALUE 'SYS:SORT.EXE'.
004300 01 INFOBLOCK.
004400 02 RN-DEV PIC X(06).
004500 02 RN-PPN PIC X(06).
004600 02 RN-PRG PIC X(06).
004700 02 RN-NAM PIC X(06).
004800 01 CALLER-NAME PIC X(6) VALUE 'IQE '.
004900 01 TEMPNAME.
005000 02 TEMP-NUM PIC X(3) VALUE '000'.
005100 02 FILLER PIC X(6) VALUE 'SRTTMP'.
005200 01 SORT-CMD-FILE DISPLAY-7.
005300 02 FILLER PIC X(4) VALUE 'DSK:'.
005400 02 CMD-NUM PIC 9(3) VALUE 0.
005500 02 FILLER PIC X(7) VALUE 'SRT.TMP'.
005600 01 SORT-STATUS PIC X(4) DISPLAY-7.
005700 01 TMPCOR-BLOCK DISPLAY-7.
005800 02 FILLER PIC X(17) VALUE IS 'SORT/RECORD-SIZE:'.
005900 02 RECSIZE PIC 9(04) VALUE IS 0.
006000 02 FILLER PIC X(05) VALUE IS '/KEY:'.
006100 02 KEYOFFS PIC 9(04) VALUE IS 0.
006200 02 FILLER PIC X VALUE IS ','.
006300 02 KEYSIZE PIC 9(04) VALUE IS 0.
006400 02 FILLER PIC X(07) VALUE IS '/SIXBIT'.
006500 02 FILLER PIC X(03) VALUE IS ' QT'.
006600 02 INPNUM PIC 9(03) VALUE IS 0.
006700 02 FILLER PIC X(08) VALUE IS 'S.TMP QT'.
006800 02 OUTNUM PIC 9(03) VALUE IS 0.
006900 02 FILLER PIC X(05) VALUE IS 'S.TMP'.
007000 02 CRLF PIC X(02).
007100 02 FILLER PIC X(04) VALUE 'EXIT'.
007200 02 CRLF2 PIC X(02).
007300
007400 LINKAGE SECTION.
007500 01 P-RECSIZE PIC 9(04) COMP.
007600 01 P-KEYOFFS PIC 9(04) COMP.
007700 01 P-KEYSIZE PIC 9(04) COMP.
007800
007900
008000 PROCEDURE DIVISION.
008100 ENTRY IQES1 USING P-RECSIZE, P-KEYOFFS, P-KEYSIZE.
008200
008300 DOIT.
008400 ENTER MACRO IQGJOB USING JOB-NO.
008500 MOVE JOB-NO TO TEMP-NUM CMD-NUM INPNUM OUTNUM.
008600 MOVE P-RECSIZE TO RECSIZE.
008700 MOVE P-KEYOFFS TO KEYOFFS.
008800 MOVE P-KEYSIZE TO KEYSIZE.
008900 ENTER MACRO IQCRLF USING CRLF.
009000 ENTER MACRO IQCRLF USING CRLF2.
009100 OPEN OUTPUT CMD-FILE.
009200 WRITE CMD-FILE-REC FROM TMPCOR-BLOCK.
009300 CLOSE CMD-FILE.
009400
009500 ENTER MACRO GOSORT USING
009600 SORT-NAM-FILE
009700 SORT-CMD-FILE
009800 SORT-CMD-FILE
009900 DUMMY
010000 DUMMY
010100 SORT-STATUS.
010200 IF SORT-STATUS NOT = 'DONE'
010300 DISPLAY '?SORT ERROR'
010400 EXIT PROGRAM.
010500
010505* *DISPOSE OF TEMP CMD FILE
010510 OPEN INPUT CMD-FILE CLOSE CMD-FILE WITH DELETE.
010600 ENTER MACRO IQWHOX USING INFOBLOCK.
010700 IF RN-PRG NOT = ' '
010800 ENTER MACRO IQRUN0 USING INFOBLOCK
010900 ELSE ENTER MACRO IQNEXT USING CALLER-NAME.
011000 DISPLAY '?RUN FAILED'.
011100 EXIT PROGRAM.