PDP-10 Archive: iql-verification/qpqrys.seq from BB-H548C-BM

Trailing-Edge - PDP-10 Archives - BB-H548C-BM - iql-verification/qpqrys.seq
There are 4 other files named qpqrys.seq in the archive. Click here to see a list.
**SALES-BONUSES
  OPEN SALESMEN .
  HEADING "BONUS PROJECTION//1975//BASED ON JANUARY PERFORMANCE" .
  DISPLAY ON .
  TITLES XBONUS = "PROJECTED//BONUS" . PICTURE XBONUS = "ZZZZ,ZZ9" .
  COMPUTE XBONUS = ( ( SSALES * 12 ) - SQUOTA ) * 52 * SSAL / SQUOTA .
  IF XBONUS LEQ 0 COMPUTE XBONUS = 0 .
  PRINT SNAME,SASSIGN,SQUOTA,XBONUS .
**FIND-FREE-FORM-SORT
  OPEN PERSONNEL .
  FIND KEY = "00026" THRU "00030","00036","00038",
             "00040" THRU "00045",
             "00047",
             "00048" THRU EOF .
  SORT PERSONNEL BY NAME .
  DISPLAY ON .
  AUTHORITY BEAR .
  PRINT EMPNO,NAME,CITY .
**DN-AS-KEY
  HEADING "DATA NAME//FROM SECONDARY FILE//INTO ISAM KEY" .
  OPEN PERSONNEL,PAYROLL.
  AUTHORITY TIGER .
  FIND P-NO = NEXT .
  IF P-NO = '     ', '00000' GO TO XT .
  IF P-SAL GR 250.00
  FIND KEY = P-NO.
  IF P-SAL <= 250.00 GO TO NR .
  PRINT  EMPNO,P-NO,P-SAL,HRLY.
COMPUTE X = X + 1. IF X > 10 GO TO QT.
**NEW-CUST-OVER-CREDIT
  PICTURE TODAY = '99-99-99'.
  HEADING 'LIST OF CUSTOMERS OVER CREDIT'
  '//BY CREDIT LIMIT// AS OF' TODAY.
  OPEN CUSTOMERS.
  COMPUTE X = CYSALES - CYPAID.
  IF X GEQ CLIMIT SORT BY DESCENDING CLIMIT.
  PRINT CNAME,1,CYSALES,CYPAID,CLIMIT
  SORT BY DESCENDING CYSALES.
  HEADING 'OVER-CREDIT//CUSTOMERS//BY DESCENDING SALES THIS YEAR'
  PRINT CYSALES,CNAME,CLIMIT.
**MIXED-SORT
  HEADING 'MIXED ASCENDING AND DESCENDING SORT'
  '//FOR A REAL CASE' .
  AUTHORITY TIGER.
  OPEN PERSONNEL.
  IF SALARY GREATER  250
  SORT BY ASCENDING DIV, DEPT, DESCENDING SALARY.
  VSPACE 1.
  IF NEWGROUP OF DIV OR NEWGROUP OF DEPT
     VSPACE 2.
  PRINT DIV, DEPT, LNAME, SALARY.
**TODAY-XRANDOM
  HEADING 'NO FILE IN TEST//OF XRANDOM//& OTHER GOODIES'.
  TITLES TODAY = "TODAY'S//DATE" XRANDOM = "IQL'S//RANDOM NO.".
  PICTURE TODAY = '99/99/99'  XRANDOM = '9999999999'.
  PRINT TODAY XRANDOM.
  COMPUTE X = X + 1.
  IF X GEQ 6 GO TO XT.
**MULTIPLE-REPORTS
  AUTHORITY TIGER.
  OPEN PERSONNEL.
  REPORT 1.
  VSPACE 1.  LMARGIN 1.
  HEADING 'FIRST REPORT'.
  TOTAL SALARY BY DEPT.
  PRINT EMPNO  LNAME  DEPT  SALARY.
  REPORT 2.
  IF EMPNO GR 10 GO TO XT.
  HEADING "SECOND REPORT".
  VSPACE 3.
  LMARGIN 10.
  PRINT CO,1,DIV,DEPT,LNAME,EMPNO.
**TRIPLE-ISAM1
  AUTHORITY TIGER.
  HEADING 'TEST OF TRIPLE MIXED ASCII/SIXBIT ISAM READ//TABLE LOOKUP'.
  RMARGIN 80.
  OPEN PERSONNEL JOB-TABLE COLLEGE-TABLE.
  FIND KEY1 = '00010' '00021' THRU '00030' '00047' THRU EOF.
  FIND KEY2 = JOB-ID.
  FIND KEY3 = COLLEGE-ID.
  PRINT EMPNO,1,LNAME,JOB-CODE,JOB-NAME,COLLEGE-CODE,COLLEGE-NAME.
**RECORDS-IN-MASTER
RMARGIN 80.
HEADING 'RECORDS IN ' HELD-FD-NAME 'DATABASE'.
OPEN DICTIONARY.
IF FD-ID = 'FD' AND X = 1 GO TO XT.
IF FD-ID = 'FD' AND FD-NAME = 'MASTER' HOLD FD-NAME COMPUTE X = 1.
IF X = 1 AND FD-ID = 'RD' PRINT RD-NAME.
**THINGS-IN-ACCEPTED
DISPLAY '(TO END ENTER "QUIT")'.
SET AKIND TO '       '.
SET ANAME TO '                              '.
TITLES AKIND = 'RECORDS, //SETS, ITEMS'.
TITLES ANAME = 'DATABASE//NAME'.
10DISPLAY 'TYPE KIND OF DATA BASE OBJECT TO SELECT'.
 ACCEPT AKIND.
IF AKIND = 'QUIT ' GO TO XT.
IF AKIND = 'SETS ' , 'RECORDS', 'ITEMS ' GO TO 20.
GO TO 10.
20DISPLAY 'TYPE NAME OF DATA BASE TO EXAMINE'.
 ACCEPT ANAME.
DISPLAY ''.
HEADING 'ANALYSIS OF//SCHEMA STRUCTURE'.
OPEN DICTIONARY.
IF FIRSTIME PRINT AKIND ANAME.
IF FD-ID = 'FD' AND X = 1 GO TO XT.
IF FD-ID = 'FD' AND FD-NAME = ANAME  COMPUTE X = 1.
IF X NOT = 1 GO TO NR.
IF AKIND = 'SETS ' AND FD-ID = 'SD' PRINT SD-NAME
    TALLY SD-NAME GO TO NR.
IF AKIND = 'RECORDS ' AND FD-ID = 'RD' PRINT RD-NAME
    TALLY RD-NAME GO TO NR.
IF FD-ID = 'RD' HOLD RD-NAME.
IF AKIND = 'ITEMS ' AND FD-ID = 'DD'
    PRINT DD-NAME HELD-RD-NAME
    TALLY DD-NAME.
**SORTED-IN-ACCEPTED
RMARGIN 80.
SET AKIND TO '       '.
SET ADBNAME TO '                              '.
10 DISPLAY 'ENTER "SETS" "RECORDS" OR "ITEMS":'
ACCEPT AKIND.
IF AKIND = 'QUIT ' GO TO XT.
IF AKIND = 'SETS' TITLES NAME = 'SET//NAME' GO TO 20.
IF AKIND = 'RECORDS' TITLES NAME = 'RECORD//NAME' GO TO 20.
IF AKIND = 'ITEMS' TITLES NAME = 'ITEM//NAME' GO TO 20.
GO TO 10.
20 DISPLAY 'ENTER DATABASE NAME:'.
ACCEPT ADBNAME.
DISPLAY ''.
HEADING 'STRUCTURE OF DATABASE' ADBNAME.
OPEN DICTIONARY.
IF EOF1 AND X NEQ 1
	DISPLAY '?-DATA BASE DICTIONARY NOT FOUND'
	GO TO QT.
IF FD-ID = 'FD' AND X = 1 GO TO XT.
IF FD-ID = 'FD' AND FD-NAME = ADBNAME  COMPUTE X = 1
   PRINT FD-NAME HEADING OFF.
IF X NOT = 1 GO TO NR.
IF AKIND = 'SETS ' AND FD-ID = 'SD' GO TO 30.
IF AKIND = 'RECORDS ' AND FD-ID = 'RD' GO TO 30.
IF FD-ID = 'RD' HOLD RD-NAME.
IF AKIND = 'ITEMS ' AND FD-ID = 'DD'
    SET COSMETICS TO HELD-RD-NAME
    GO TO 30.
GO TO NR.
30 SORT BY NAME.
IF FD-ID = 'DD' PRINT NAME 1 COSMETICS ELSE
            PRINT  NAME.
TALLY NAME.
**COMPOUND-CHANGE
* ********************************************************
*
* THIS QUERY ILLUSTRATES HOW TO USE IQL TO UPDATE
* A MASTER FILE (MASTER-CHNG) FROM A TRANSACTION FILE (CHANGE-LIST)
*
* THE TASK IS TO READ TRANSACTIONS FROM THE SECONDARY FILE
* (WHICH IS IN SORTED ORDER), LOOK THROUGH THE MASTER FILE
* FOR THE MATCHING MASTER RECORD, AND CHANGE THE
* REFERRAL CODE TO 1;   IF NO MASTER RECORD MATCHES
* THE TRANSACTION RECORD, PRINT A SEPARATE EXCEPTION REPORT
*
* ************************************************************
HEADING 'LIST OF CHANGED RECORDS'.
OPEN MASTER-CHNG, CHANGE-LIST.
*
* GET THE FIRST TRANSACTION-RECORD.
*
IF FIRST TIME FIND CHANGE-COMPOUND = NEXT.
10 IF EOF2 GO TO XT.
*
* SEARCH THRU MASTER FILE UNTIL MASTER RECORD MATCHES XACT.
*
*
* IF NO MASTER RECORD MATCHED THE XACT, PRINT EXCEPTION REPORT
*
IF COMPOUND-NO GREATER CHANGE-COMPOUND
	REPORT 2
	HEADING "TRANSACTIONS WITH NO MATCHING MASTER"
	PRINT CHANGE-COMPOUND
	REPORT 1
*
* GO ON TO THE NEXT TRANSACTION RECORD
*
	FIND CHANGE-COMPOUND = NEXT
	GO TO 10.
*
* IF MASTER RECORD MATCHES XACT, DO THE UPDATE.
*
IF COMPOUND-NO = CHANGE-COMPOUND
     SET REFERRAL TO '1'
     PRINT COMPOUND-NO
     COPY RECORD
*
* SINCE THE MASTER & XACT MATCHED, GET NEXT RECORD OF BOTH.
*
     FIND CHANGE-COMPOUND = NEXT
     GO TO NR.
*
* IF THE MASTER HAS NOT YET CAUGHT UP WITH XACT,
* COPY THE RECORD AND GO ON TO THE NEXT MASTER.
*
IF COMPOUND-NO LESS CHANGE-COMPOUND
	COPY RECORD.
**SOME-XRANDOMS
HEADING 'WORKING WITH XRANDOM'.
PICTURE XNORMAL = '.99999'.
TITLES  XNORMAL = 'XRANDOM//NORMALIZED'.
PICTURE X = '9999999999.99999'.
PRINT X.
COMPUTE X = XRANDOM.
PRINT X.
17 COMPUTE XNORMAL = XRANDOM / 10000000000.
PRINT XNORMAL.
COMPUTE XCOUNT = XCOUNT + 1.
IF XCOUNT LEQ 10 GO TO 17.
GO TO XT.
**SIMPLE-LIST
  OPEN PERSONNEL .
  AUTHORITY FOX .
  DISPLAY ON .
  HEADING "SHORT PERSONNEL LIST" .
  PRINT EMPNO,NAME,SOC-SEC,DATE-BD.
  IF EMPNO GEQ 4 GO TO XT .
**CUST-OVER-CREDIT
  OPEN CUSTOMERS .
  SORT CUSTOMERS BY DESCENDING CLIMIT .
  DISPLAY ON .
  HEADING "LIST OF CUSTOMERS OVER CREDIT" .
  COMPUTE X = CYSALES - CYPAID .
  IF X GEQ CLIMIT PRINT CNAME,1,CYSALES,CYPAID,CLIMIT .