Trailing-Edge
-
PDP-10 Archives
-
BB-H548C-BM
-
iql-source/iqfnd6.cbl
There are 2 other files named iqfnd6.cbl in the archive. Click here to see a list.
000100 IDENTIFICATION DIVISION.
000200
000300 PROGRAM-ID. IQCALL.
000400
000500 DATE-WRITTEN. 1978.
000600 DATE-COMPILED.
000700 SECURITY. COPYRIGHT 1981 AZREX INC
000800 ALL RIGHTS RESERVED.
000900
001000 REMARKS. THIS IS A SKELETON USER'S OWN-CODE PROGRAM
000000 TO TEST/DEMOSTRATE IQL RELEASE 3'S CALL VERB.
000000
001700
001800
003100 ENVIRONMENT DIVISION.
003200
003300 CONFIGURATION SECTION.
003400 SOURCE-COMPUTER. DECSYSTEM-20.
003500 OBJECT-COMPUTER. DECSYSTEM-20.
003600 SPECIAL-NAMES. CHANNEL (1) IS TOP-OF-PAGE
003700 CONSOLE IS TTY.
003800
003900 INPUT-OUTPUT SECTION.
004000
004100 FILE-CONTROL.
004200 SELECT FILE-IN ASSIGN TO DSK.
004300 SELECT FILE-OUT ASSIGN TO DSK.
005000 I-O-CONTROL.
005400
005500 DATA DIVISION.
005600 FILE SECTION.
005700
005800 FD FILE-IN
005900 VALUE OF IDENTIFICATION IS FILE-IN-ID
006000 LABEL RECORDS ARE STANDARD
006100 RECORD CONTAINS 400 CHARACTERS
006200 BLOCK CONTAINS 0 RECORDS
006300 DATA RECORD IS FILE-IN-REC.
006400 01 FILE-IN-REC USAGE IS DISPLAY-7.
006500 02 FILE-IN-CHAR PIC X OCCURS 400 INDEXED BY FIX.
006600
006700 FD FILE-OUT
006800 VALUE OF IDENTIFICATION IS FILE-OUT-ID
006900 BLOCK CONTAINS 0 RECORDS
007000 LABEL RECORDS ARE STANDARD
007050 RECORD CONTAINS 400 CHARACTERS
007100 DATA RECORD IS FILE-OUT-REC.
007200 01 FILE-OUT-REC USAGE IS DISPLAY-7.
007200 02 FILE-OUT-CHAR PIC X OCCURS 400 INDEXED BY FOX.
013100
013150 WORKING-STORAGE SECTION.
000000*
000000 01 COPYRIGHT-NOTICE PIC X(50) VALUE
000000 "COPYRIGHT 1981 - AZREX, INC. - ALL RIGHTS RESERVED".
000000*
000000
000000 01 I PIC S9(10) COMP VALUE 1.
000000 01 NO-RECS PIC S9(10) COMP VALUE 0.
000000 01 NO-CHARS PIC S9(10) COMP VALUE 0.
000000 01 FILE-PARSE-ERROR PIC S9(10) COMP VALUE 0.
000000 01 ELEM-CHAR PIC X DISPLAY-7 VALUE SPACE.
000000 01 ANSWER DISPLAY-7.
000000 02 ANSWER-CHAR PIC X OCCURS 60 TIMES INDEXED BY ANX.
000000 01 FILE-IN-ID.
000000 02 FILE-IN-NAME PIC X(6) VALUE SPACES.
000000 02 FILE-IN-EXT PIC X(3) VALUE SPACES.
000000 01 FILE-OUT-ID.
000000 02 FILE-OUT-NAME PIC X(6) VALUE SPACES.
000000 02 FILE-OUT-EXT PIC X(3) VALUE SPACES.
000000 01 PARSED-FILE-NAME DISPLAY-7.
000000 02 PARSED-FILE-CHAR PIC X OCCURS 9 INDEXED BY PFCX.
000000 01 REC-NAME PIC X(30) DISPLAY-7.
000000 01 SET-NAME PIC X(30) DISPLAY-7.
000000 LINKAGE SECTION.
000000 01 PASSED-PARAMS.
000000 02 EXIT-CODE PIC 999.
000000 02 STATUS-CODE PIC XXX.
000000 02 ARGUMENTS.
000000 04 ALPHA-ARG PIC X(30) OCCURS 11.
000000 02 FILLER1 REDEFINES ARGUMENTS.
000000 04 NUM-ARG-GROUP OCCURS 11.
000000 06 FILLER PIC X(12).
000000 06 NUM-ARG PIC S9(18).
000000 02 FILLER2 REDEFINES ARGUMENTS.
000000 04 BIN-ARG-GROUP OCCURS 11.
000000 06 FILLER PIC X(18).
000000 06 BIN-ARG PIC S9(18) COMP.
000000
000000 PROCEDURE DIVISION USING PASSED-PARAMS.
136900 BEGIN.
000000*
000000* * CALLING CODE OF 999 MEANS TO CALL FOR DBMS STATS.
000000*
136910 IF EXIT-CODE = 999
136920 ENTER MACRO STATS
136930 GO TO EXIT-IQCALL.
000000*
000000* * CALLING CODE 6 MEANS TO A FIND RSE 6 (BUT NOT THE GETS)
000000*
000000 IF EXIT-CODE = 6
000000 MOVE ALPHA-ARG (1) TO REC-NAME
000000 MOVE ALPHA-ARG (2) TO SET-NAME
000000 ENTER MACRO FINS6 USING
000000 REC-NAME
000000 SET-NAME
000000 GO TO EXIT-IQCALL.
000000*
000000* * CALLING CODE 66 MEANS TO DO A GETS CALL
000000* * PRESUMABLE TO GET THE JUST-FOUND RSE 6 RECORD
000000* * (THIS IS NECESSARY SO THAT THE CALLING QUERY CAN
000000* * CHECK ERROR-COUNT FOR ITSELF BEFORE DOING A GETS
000000* * WHICH WILL DESTROY THE VALIDITY OF ERROR-COUNT)
000000*
000000 IF EXIT-CODE = 66
000000 ENTER MACRO GETS USING 0
000000 GO TO EXIT-IQCALL.
000000*
000000* *FIRST SHOW ENTRY THEN CALL CODE AND ENTRY STATUS*
000000 DISPLAY '**ENTERED IQCALL**' UPON CONSOLE.
000000 DISPLAY ' EXIT-CODE: ' EXIT-CODE UPON CONSOLE.
000000 DISPLAY ' STATUS-CODE: ' STATUS-CODE UPON CONSOLE.
000000 MOVE 1 TO I.
000000 SHOW-ARG-STACK.
000000* *NOW SHOW CONTENTS OF ALL 11 ARGUMENT STACKS*
000000 SHOW-ARGS-LOOP.
000000 DISPLAY ' *GROUP = ' I UPON CONSOLE.
000000 DISPLAY ' ALPHA-ARG: ' ALPHA-ARG (I) UPON CONSOLE.
000000 DISPLAY ' NUM-ARG: ' NUM-ARG (I) UPON CONSOLE.
000000 DISPLAY ' BIN-ARG: ' BIN-ARG (I) UPON CONSOLE.
000000 IF I LESS THAN 10 ADD 1 TO I
000000 GO TO SHOW-ARGS-LOOP.
000000* *SET IN SOME VALUES TO BE RETURNED*
000000 MOVE 'RETURNED ALPHA' TO ALPHA-ARG (1).
000000 MOVE 12345 TO NUM-ARG (2).
000000 MOVE 54321 TO BIN-ARG (3).
000000 MOVE 'AOK' TO STATUS-CODE.
000000 EXIT-IQCALL.
000000 EXIT PROGRAM.