Google
 

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.