000100 IDENTIFICATION DIVISION. 000120 PROGRAM-ID. IQE. 000140 DATE-WRITTEN. 1 DEC 1976. 000160 DATE-COMPILED. 000180 000200 SECURITY. COPYRIGHT 1978 AZREX INC 000220 ALL RIGHTS RESERVED. 000240 000260 REMARKS. EXECUTION MODULE FOR IQL RELEASE 3.0; 000280 FIELD TEST VERSION EDIT 4. 000300 LAST UPDATED 10 NOV 78 BY DWM. 000380 THIS VERSION CONTAINS SUMMARY BREAK TRIPLES 000400 AS WELL AS GETTING ITEM VALUES DIRECTLY FROM 000420 THE RECORD INPUT BUFFERS. 000421 000422 EDIT HISTORY: 000424 000426 EDIT 1 : FIXED NOT FINDING SUMMARY STATEMENT RIGHT 000428 AFTER OPEN IF DBMS OR ISAM READING. 000430 LINE 025044; 6/10/78 BY DWM. 000432 000434 EDIT 2 : INSERTED DECLARATIVE SECTION TO KEEP COBOL 000436 FROM BLOWING OFF ON ABSENCE OF FILES ISAMF6.IDX 000438 AND ISAMF7.IDX UNTIL WE CAN TELL IT THE REAL 000440 .IDX FILES TO USE; 6/10/78 BY DWM. 000442 000444 EDIT 3 : CHANGED BLOCKING FACTORS FROM 2 TO 10 ON ALL 000446 ISAM FILES SO AS TO GIVE MORE ROOM FOR PHYSICAL 000448 BLOCK; 6/10/78 BY DWM. 000450 000452 EDIT 4 : CHANGED ELEM-F-KEYTYPE TO ELEM-F-KEYLOC 000454 JUST AFTER CORE-DATA-MODE IN ALL CALLS TO 000456 IQISAM BEFORE OPENING ISAM FILES; 000457 6/24/78 BY DWM. 000540 000458 EDIT 5 : ADDED INSTRUCTION 67 (IF ERROR-COUNT) 000460 AS PART OF INSTRUCTION IF ERROR-STATUS; 000462 APPLIES TO DBMS PROCESSING ONLY; 000463 7/13/78 BY DWM. 000464 000466 EDIT 6: FIXED INDEX RUNOFF IN PARAGRAPHS 000468 SORTDSC-ALPHA AND SORTDSC-ALPHA1 SO THAT 000470 IQE CAN SUCCESSFULLY COMPLEMENT A VERY 000472 LONG ALPHA FIELD FOR SORT DESCENDING; 000473 7/13/78 BY DWM. 000474 000475 EDIT 7: FIX TO CORRECTLY SORT ASCII DBMS RECORDS 000476 NOTE: REQUIRES IQSXFR.FIX INSTALLED IN 000477 IQLIB.REL TO CORRECTLY HANDLE LOWER-CASE. 000478 3/30/79 BY DMW & WML. 000479 000560 ENVIRONMENT DIVISION. 000580 CONFIGURATION SECTION. 000600 SOURCE-COMPUTER. DECSYSTEM-10. 000620 OBJECT-COMPUTER. DECSYSTEM-10. 000640 SPECIAL-NAMES. CHANNEL (1) IS TOP-OF-PAGE 000660 CONSOLE IS TTY. 000680 000700 INPUT-OUTPUT SECTION. 000720 000740 FILE-CONTROL. 000760 SELECT QTANLZ ASSIGN TO DSK 000780 RESERVE NO ALTERNATE AREAS. 000800 SELECT QTEXEC ASSIGN TO DSK 000820 RESERVE NO ALTERNATE AREAS. 000840 SELECT QLEXEC ASSIGN TO DSK. 000860* *TO AUTOMATICALLY SPOOL PRINTER REPORTS, CHANGE DEVICE 000880* * ABOVE FROM DSK TO LPT. 000900 000920 SELECT INF1SD6 ASSIGN TO DSK. 000940 SELECT INF1SD7 ASSIGN TO DSK. 000960 SELECT INF2SD6 ASSIGN TO DSK 000980 RESERVE NO ALTERNATE AREAS. 001000 SELECT INF2SD7 ASSIGN TO DSK 001020 RESERVE NO ALTERNATE AREAS. 001040 SELECT INF3SD6 ASSIGN TO DSK 001060 RESERVE NO ALTERNATE AREAS. 001080 SELECT INF3SD7 ASSIGN TO DSK 001100 RESERVE NO ALTERNATE AREAS. 001120 SELECT OUTFSD6 ASSIGN TO DSK 001140 RESERVE NO ALTERNATE AREAS. 001160 SELECT OUTFSD7 ASSIGN TO DSK 001180 RESERVE NO ALTERNATE AREAS. 001200 SELECT CREATESD6 ASSIGN TO DSK 001220 RESERVE NO ALTERNATE AREAS. 001240 SELECT CREATESD7 ASSIGN TO DSK 001260 RESERVE NO ALTERNATE AREAS. 001280 SELECT INF1ISAM6 ASSIGN TO DSK 001300 ACCESS IS INDEXED 001320 RECORD KEY IS INF1ISAM6-RECKEY 001340 SYMBOLIC KEY IS INF1ISAM6-SYMKEY 001344 FILE-STATUS IS SC,EM,AC. 001360 SELECT INF1ISAM7 ASSIGN TO DSK 001380 ACCESS IS INDEXED 001400 RECORD KEY IS INF1ISAM7-RECKEY 001420 SYMBOLIC KEY IS INF1ISAM7-SYMKEY 001424 FILE-STATUS IS SC,EM,AC. 001440 SELECT INF2ISAM6 ASSIGN TO DSK 001460 ACCESS IS INDEXED 001480 RECORD KEY IS INF2ISAM6-RECKEY 001500 SYMBOLIC KEY IS INF2ISAM6-SYMKEY 001504 FILE-STATUS IS SC,EM,AC. 001520 SELECT INF2ISAM7 ASSIGN TO DSK 001540 ACCESS IS INDEXED 001560 RECORD KEY IS INF2ISAM7-RECKEY 001580 SYMBOLIC KEY IS INF2ISAM7-SYMKEY 001584 FILE-STATUS IS SC,EM,AC. 001600 SELECT INF3ISAM6 ASSIGN TO DSK 001620 ACCESS IS INDEXED 001640 RECORD KEY IS INF3ISAM6-RECKEY 001660 SYMBOLIC KEY IS INF3ISAM6-SYMKEY 001664 FILE-STATUS IS SC,EM,AC. 001680 SELECT INF3ISAM7 ASSIGN TO DSK 001700 ACCESS IS INDEXED 001720 RECORD KEY IS INF3ISAM7-RECKEY 001740 SYMBOLIC KEY IS INF3ISAM7-SYMKEY 001744 FILE-STATUS IS SC,EM,AC. 001760 SELECT SORTFILE ASSIGN TO DSK. 001780 001800 I-O-CONTROL. 001820 SAME AREA FOR INF1SD6 INF1SD7 INF1ISAM6 INF1ISAM7. 001840 SAME AREA FOR OUTFSD6 OUTFSD7 QTANLZ. 001860 SAME AREA FOR CREATESD6 CREATESD7. 001880 SAME AREA FOR INF2SD6 INF2SD7 INF2ISAM6 INF2ISAM7. 001900 SAME AREA FOR INF3SD6 INF3SD7 INF3ISAM6 INF3ISAM7. 001920 001940 DATA DIVISION. 001960 001980 FILE SECTION. 002000 002020 FD INF1SD6 002040 VALUE OF IDENTIFICATION IS ELEM-F-ID 002060* USER-NUMBER IS ELEM-F-PPN 002080 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002100 DATA RECORDS ARE INF1SD6-REC RD-DBMS-TABLE. 002120 01 INF1SD6-REC PIC X(4092) USAGE IS DISPLAY-6. 002140 002141 01 RD-DBMS-TABLE DISPLAY-6. 002142 02 FILLER OCCURS 96 TIMES INDEXED BY RX. 002143 04 REC-NAM PIC X(30). 002144 04 REC-TYP PIC 9. 002145 88 RSIXBIT VALUE 6. 002146 88 RASCII VALUE 7. 002147 88 REBCDIC VALUE 9. 002148 04 START-LOC PIC 9(4). 002149 04 R-LENGTH PIC 9(4). 002150 04 NMID PIC 99. 002151 04 FILLER PIC X. 002152 002160 FD INF1SD7 002180 VALUE OF IDENTIFICATION IS ELEM-F-ID 002200* USER-NUMBER IS ELEM-F-PPN 002220 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002240 DATA RECORD IS INF1SD7-REC. 002260 01 INF1SD7-REC PIC X(3410) USAGE IS DISPLAY-7. 002280 002300 FD INF2SD6 002320 VALUE OF IDENTIFICATION IS ELEM-F-ID 002340* USER-NUMBER IS ELEM-F-PPN 002360 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002380 DATA RECORD IS INF2SD6-REC. 002400 01 INF2SD6-REC PIC X(4092). 002420 002440 FD INF2SD7 002460 VALUE OF IDENTIFICATION IS ELEM-F-ID 002480* USER-NUMBER IS ELEM-F-PPN 002500 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002520 DATA RECORD IS INF2SD7-REC. 002540 01 INF2SD7-REC PIC X(3410) USAGE IS DISPLAY-7. 002560 002580 FD INF3SD6 002600 VALUE OF IDENTIFICATION IS ELEM-F-ID 002620* USER-NUMBER IS ELEM-F-PPN 002640 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002660 DATA RECORD IS INF3SD6-REC. 002680 01 INF3SD6-REC PIC X(4092) USAGE IS DISPLAY-6. 002700 002720 FD INF3SD7 002740 VALUE OF IDENTIFICATION IS ELEM-F-ID 002760* USER-NUMBER IS ELEM-F-PPN 002780 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002800 DATA RECORD IS INF3SD7-REC. 002820 01 INF3SD7-REC PIC X(3410) USAGE IS DISPLAY-7. 002840 002860 FD OUTFSD6 002880 VALUE OF IDENTIFICATION IS ELEM-F-ID 002900 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 002920 DATA RECORD IS OUTFSD6-REC. 002940 01 OUTFSD6-REC PIC X(4092) USAGE IS DISPLAY-6. 002960 002980 FD OUTFSD7 003000 VALUE OF IDENTIFICATION IS ELEM-F-ID 003020 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 003040 DATA RECORD IS OUTFSD7-REC. 003060 01 OUTFSD7-REC PIC X(3410) USAGE IS DISPLAY-7. 003080 003100 FD CREATESD6 003120 VALUE OF IDENTIFICATION IS ELEM-F-ID 003140 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 003160 DATA RECORD IS CREATESD6-REC. 003180 01 CREATESD6-REC PIC X(4092) USAGE IS DISPLAY-6. 003200 003220 FD CREATESD7 003240 VALUE OF IDENTIFICATION IS ELEM-F-ID 003260 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 003280 DATA RECORD IS CREATESD7-REC. 003300 01 CREATESD7-REC PIC X(3410) USAGE IS DISPLAY-7. 003320 003340 FD INF1ISAM6 003360 VALUE OF IDENTIFICATION IS ELEM-F-ID 003380* USER-NUMBER IS ELEM-F-PPN 003400 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 003420 DATA RECORD IS INF1ISAM6-REC. 003440 01 INF1ISAM6-REC USAGE IS DISPLAY-6. 003460 02 INF1ISAM6-RECKEY PIC X(30). 003480 02 FILLER PIC X(4062). 003500 003520 FD INF1ISAM7 003540 VALUE OF IDENTIFICATION IS INFXISAM7-ID 003560* USER-NUMBER IS ELEM-F-PPN 003580 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 003600 DATA RECORD IS INF1ISAM7-REC. 003620 01 INF1ISAM7-REC USAGE IS DISPLAY-7. 003640 02 INF1ISAM7-RECKEY PIC X(30). 003660 02 FILLER PIC X(3380). 003680 003700 FD INF2ISAM6 003720 VALUE OF IDENTIFICATION IS ELEM-F-ID 003740* USER-NUMBER IS ELEM-F-PPN 003760 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 003780 DATA RECORD IS INF2ISAM6-REC. 003800 01 INF2ISAM6-REC USAGE IS DISPLAY-6. 003820 02 INF2ISAM6-RECKEY PIC X(30). 003840 02 FILLER PIC X(4062). 003860 003880 FD INF2ISAM7 003900 VALUE OF IDENTIFICATION IS INFXISAM7-ID 003920* USER-NUMBER IS ELEM-F-PPN 003940 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 003960 DATA RECORD IS INF2ISAM7-REC. 003980 01 INF2ISAM7-REC USAGE IS DISPLAY-7. 004000 02 INF2ISAM7-RECKEY PIC X(30). 004020 02 FILLER PIC X(3380). 004040 004060 FD INF3ISAM6 004080 VALUE OF IDENTIFICATION IS ELEM-F-ID 004100* USER-NUMBER IS ELEM-F-PPN 004120 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 004140 DATA RECORD IS INF3ISAM6-REC. 004160 01 INF3ISAM6-REC USAGE IS DISPLAY-6. 004180 02 INF3ISAM6-RECKEY PIC X(30). 004200 02 FILLER PIC X(4062). 004220 004240 FD INF3ISAM7 004260 VALUE OF IDENTIFICATION IS INFXISAM7-ID 004280* USER-NUMBER IS ELEM-F-PPN 004300 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 10 RECORDS 004320 DATA RECORD IS INF3ISAM7-REC. 004340 01 INF3ISAM7-REC USAGE IS DISPLAY-7. 004360 02 INF3ISAM7-RECKEY PIC X(30). 004380 02 FILLER PIC X(3380). 004400 004420 FD QTANLZ 004440 VALUE OF IDENTIFICATION IS QTANLZTMP 004460 BLOCK CONTAINS 0 RECORDS 004480 LABEL RECORD IS STANDARD 004500 DATA RECORDS ARE QTANLZ-REC QTANLZ-REC1. 004520 01 QTANLZ-REC. 004540 02 QTANLZ-NAME. 004560 04 QTANLZ-PREFIX PIC X(6). 004580 04 QTANLZ-SUFFIX PIC X(3). 004600 02 FILLER PIC XXX. 004620 02 QTANLZ-PPN PIC S9(10) COMP. 004640 02 FILLER PIC X(72). 004660 004680 01 QTANLZ-REC1. 004700 02 QTANLZ-SWITCH PIC X(30). 004720 02 FILLER PIC X(60). 004740 004760 004780 FD QTEXEC 004800 VALUE OF IDENTIFICATION IS QTEXECTMP 004820 BLOCK CONTAINS 0 RECORDS 004840 LABEL RECORD IS STANDARD DATA RECORD IS QTEXEC-REC. 004860 01 QTEXEC-REC USAGE IS DISPLAY-6. 004880 02 QTE-RPT-PARAMS. 004900 04 QTE-RPT-NO PIC S9(10) COMP. 004920 04 QTE-PAGE-NO PIC S9(10) COMP. 004940 04 QTE-LINE-NO PIC S9(10) COMP. 004960 04 QTE-ACROSS PIC S9(10) COMP. 004980 04 QTE-DISPLAY-FLAG REDEFINES QTE-ACROSS 005000 PIC S9(10) COMP. 005020 04 QTE-VSPACE PIC S9(10) COMP. 005040 04 QTE-PRINT-FLAG REDEFINES QTE-VSPACE 005060 PIC S9(10) COMP. 005080 04 QTE-PRINTX PIC S9(10) COMP. 005100 04 QTE-PAGE-LINES REDEFINES QTE-PRINTX 005120 PIC S9(10) COMP. 005140 04 QTE-PRINTPOS PIC S9(10) COMP. 005160 04 QTE-FORM-LINES REDEFINES QTE-PRINTPOS 005180 PIC S9(10) COMP. 005200 02 QTE-IMAGE PIC X(200). 005220 005240 FD QLEXEC 005260 VALUE OF IDENTIFICATION IS QLEXECLPT 005280 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS 005300 RECORD CONTAINS 132 CHARACTERS 005320 DATA RECORD IS QLEXEC-REC. 005340 01 QLEXEC-REC USAGE IS DISPLAY-7. 005360 02 QLEXEC-REC-CHARS PIC X OCCURS 132 TIMES. 005380 005400 FD SORTFILE 005420 VALUE OF IDENTIFICATION IS QTSORTTMP 005440 LABEL RECORDS ARE STANDARD 005460 BLOCK CONTAINS 0 RECORDS 005480 RECORD CONTAINS 4095 CHARACTERS 005500 DATA RECORD IS SORTFILE-REC. 005520 01 SORTFILE-REC. 005540 02 SORTFILE-KEY. 005560 04 SORTFILE-KEYCHAR PIC X OCCURS 4092 TIMES 005580 INDEXED BY SKX. 005600 005620 WORKING-STORAGE SECTION. 005640 005660*****DYNAMIC FILE NAMES FOLLOW*****. 005680 005700 01 QTSORTTMP. 005720 02 FILLER PIC X(2) VALUE 'QT'. 005740 02 QTSORTNO PIC 999 VALUE 001. 005760 02 FILLER PIC X(4) VALUE 'STMP'. 005780 01 QTANLZTMP PIC X(9). 005800 01 QT001ATMP. 005820 02 FILLER PIC X(2) VALUE 'QT'. 005840 02 QTANLZNO PIC 999 VALUE 001. 005860 02 FILLER PIC X(4) VALUE 'ATMP'. 005880 01 QTEXECTMP. 005900 02 FILLER PIC X(2) VALUE 'QT'. 005920 02 QTEXECNO PIC 999 VALUE 001. 005940 02 FILLER REDEFINES QTEXECNO. 005960 04 QTEXEC-NODUP PIC X. 005980 04 FILLER PIC XX. 006000 02 FILLER PIC X(4) VALUE 'MTMP'. 006020 01 QLEXECLPT. 006040 02 FILLER PIC X(2) VALUE 'QL'. 006060 02 QLEXECNO PIC 999 VALUE 001. 006080 02 FILLER REDEFINES QLEXECNO. 006100 04 QLEXEC-NODUP PIC X. 006120 04 FILLER PIC XX. 006140 02 FILLER PIC X(4) VALUE 'ELPT'. 006160 01 INFXISAM7-ID PIC X(9) VALUE 'ISAMF7IDX'. 006180 006200**DBMS CALL PARAMETERS FOLLOW** 006220 006240 01 FIND-RSE PIC S9(10) COMP VALUE 10. 006260 01 RECORD-NAME PIC X(30) VALUE ' ' DISPLAY-7. 006280 01 SCHEMA-NAME PIC X(30) VALUE ' ' DISPLAY-7. 006300 01 FIRST-NEXT-INDIC PIC S9(10) COMP VALUE -12. 006320 88 OWNER-INDIC VALUE -11. 006340 88 FIRST-INDIC VALUE -12. 006360 88 LAST-INDIC VALUE -13. 006380 88 NEXT-INDIC VALUE -14. 006400 88 PRIOR-INDIC VALUE -15. 006420 01 AREA-NAME PIC X(30) VALUE ' ' DISPLAY-7. 006440 01 SET-NAME REDEFINES AREA-NAME 006460 PIC X(30) DISPLAY-7. 006480 01 SUBSCHEMA-NAME PIC X(30) VALUE ' ' DISPLAY-7. 006500 01 SET-AREA-INDIC PIC S9(10) COMP VALUE -18. 006520 88 AREA-INDIC VALUE -18. 006540 88 SET-INDIC VALUE -20. 006560 01 DBMS-ERROR-FLAG PIC S9(10) COMP VALUE 0. 006580 01 PRIVACY-KEY PIC X(30) VALUE 'NOLOCK' DISPLAY-7. 006600 006620**FLAGS FOLLOW** 006640 006660 01 FLAGS. 006680 02 ALL-SPACES-FLAG PIC 9 COMP VALUE 0. 006700 02 BREAK-FLAG PIC 9 COMP VALUE 0. 006720 02 CALL-IQM-FLAG PIC 9 COMP VALUE 0. 006740 02 COPYFILE-FLAG PIC 9 COMP VALUE 0. 006760 02 CREATEFILE-FLAG PIC 9 COMP VALUE 0. 006780 02 DECIMAL-FLAG PIC 9 COMP VALUE 0. 006800 02 ENDING-FLAG PIC 9 COMP VALUE 0. 006802 02 END-DD-F PIC 9 COMP VALUE 0. 006804 88 END-DD VALUE 1. 006806 02 END-TAB-F PIC 9 COMP VALUE 0. 006808 88 END-TAB VALUE 1. 006820 02 ENTRY-ERROR-FLAG PIC 9 COMP VALUE 0. 006840 02 INF1-FLAG PIC 9 COMP VALUE 0. 006860 88 CLOSED VALUE 0. 006880 88 BEFORE-1ST-REC VALUE 1. 006900 88 FIRST-REC VALUE 2. 006920 88 IN-MIDDLE VALUE 3. 006940 88 LAST-RECORD VALUE 4. 006960 88 END-FILE VALUE 5. 006980 88 NOT-IN-USE VALUE 6. 007000 02 INF2-FLAG PIC 9 COMP VALUE 0. 007020 02 INF3-FLAG PIC 9 COMP VALUE 0. 007030 02 ISAM-ERROR-FLAG PIC 9 COMP VALUE 0. 007040 02 FIND-ERROR-FLAG PIC 9 COMP VALUE 0. 007060 02 LITERAL-FLAG PIC 9 COMP VALUE 0. 007080 02 MINUS-FLAG PIC 9 COMP VALUE 0. 007100 02 MISS-FLAG PIC 9 COMP VALUE 0. 007120 02 NEWGROUP-FLAG PIC 9 COMP VALUE 0. 007140 02 NEWPAGE-FLAG PIC 9 COMP VALUE 0. 007160 02 NUM-VAL-FLAG PIC 9 COMP VALUE 0. 007180 02 OVERFLOW-FLAG PIC 9 COMP VALUE 0. 007200 02 PRINTFILE-FLAG PIC 9 COMP VALUE 0. 007220 02 ROUNDING-FLAG PIC 9 COMP VALUE 0. 007240 02 SORTFILE-FLAG PIC 9 COMP VALUE 0. 007250 02 STOP-FLAG PIC 9 COMP VALUE 0. 007260 02 SPECIAL-ITM-FLAG PIC 9 COMP VALUE 0. 007280 02 SUPPRESSING-FLAG PIC 9 COMP VALUE 1. 007300 02 TRUE-FLAG PIC 9 COMP VALUE 0. 007320 007312**FILE ERROR RETURNS FOR USE BY DECLARATIVES FOLLOW** 007314 01 ERROR-CONTROL-BLOCK. 007316 02 SC PIC 99. 007316 02 EM PIC 9(10). 007317 02 FILLER REDEFINES EM. 000020 04 ERROR-VERB PIC 99. 007322 04 ERROR-CALL PIC 99. 007324 04 ERROR-FILE PIC 99. 007326 04 ERROR-BLOCK PIC 9. 007328 04 ERROR-NUMBER PIC 999. 007330 02 AC INDEX. 007332 007340**WORKING COMPUTATIONAL ITEMS FOLLOW** 007360 007380 01 COMP-WORKERS. 007400 02 ACCUM-SCALE PIC S9(10) COMP VALUE 0. 007420 02 ALT-NHOLDER-SCALE PIC S9(10) COMP VALUE 0. 007440 02 ALT-NHOLDER-TYPE PIC S9(10) COMP VALUE 0. 007460 02 AVERAGE-CODE PIC S9(10) COMP VALUE 49. 007480 02 AVERAGE-TALLY PIC S9(10) COMP VALUE 1. 007500 02 BUFFER-LENGTH PIC S9(10) COMP VALUE 6144. 007510 02 C2E18 PIC S9(10) COMP VALUE 262144. 007515 02 C2E18-1 PIC S9(10) COMP VALUE 262143. 007520 02 CHARS-PER-WORD PIC S9(10) COMP VALUE 6. 007540 02 CONST-1 PIC S9(10) COMP VALUE -1. 007560 02 CONST2 PIC S9(10) COMP VALUE 2. 007580 02 CONST6 PIC S9(10) COMP VALUE 6. 007600 02 CONST7 PIC S9(10) COMP VALUE 7. 007620 02 CONST8 PIC S9(10) COMP VALUE 8. 007640 02 CONST9 PIC S9(10) COMP VALUE 9. 007660 02 CONST10 PIC S9(10) COMP VALUE 10. 007680 02 CONST12 PIC S9(10) COMP VALUE 12. 007700 02 CONST18 PIC S9(10) COMP VALUE 18. 007720 02 CONST19 PIC S9(10) COMP VALUE 19. 007740 02 CONST20 PIC S9(10) COMP VALUE 20. 007742 02 CONST30 PIC S9(10) COMP VALUE 30. 007760 02 CONST63 PIC S9(10) COMP VALUE 63. 007780 02 CONST100 PIC S9(10) COMP VALUE 100. 007800 02 COPY-FX PIC S9(10) COMP VALUE 0. 007820 02 COPY-RECLEN PIC S9(10) COMP VALUE 0. 007840 02 CORE-DATA-MODE PIC S9(10) COMP VALUE 0. 007860 02 CREATE-FX PIC S9(10) COMP VALUE 0. 007880 02 CREATE-RECLEN PIC S9(10) COMP VALUE 0. 007900 02 CURR-HSPACE PIC S9(10) COMP VALUE 0. 007920 02 CURR-VSPACE PIC S9(10) COMP VALUE 1. 007940 02 DOLLAR-COUNT PIC S9(10) COMP VALUE 0. 007950 02 DX-LOWEST PIC S9(10) COMP VALUE 0. 007955 02 ELEM-INSTR PIC S9(10) COMP VALUE 0. 007960 02 FALSEGOX PIC S9(10) COMP VALUE 1. 007980 02 FILE-RECORDING-MODE PIC S9(10) COMP VALUE 0. 008000 02 FILE-ROUTER PIC S9(10) COMP VALUE 1. 008020 02 FIND-ERROR-CODE PIC S9(10) COMP VALUE 0. 008040 02 FIND-PLACE PIC S9(10) COMP VALUE 0. 008060 02 FIND-REC-NO PIC S9(10) COMP VALUE 0. 008080 02 FIND-SET PIC S9(10) COMP VALUE 0. 008100 02 FIND-SUPPRESS PIC S9(10) COMP VALUE 0. 008120 02 FLOAT-POS PIC S9(10) COMP VALUE 0. 008140 02 HOLDX PIC S9(10) COMP VALUE 1. 008150 02 HOLD-TITLE-FLAG PIC S9(10) COMP VALUE 0. 008160 02 I PIC S9(10) COMP VALUE 1. 008180 02 INF1-FX PIC S9(10) COMP VALUE 0. 008200 02 INF1-RECLEN PIC S9(10) COMP VALUE 0. 008220 02 INF1-TYPE PIC S9(10) COMP VALUE 0. 008240 88 SEQUENTIAL-SIXBIT VALUE 1. 008260 88 SEQUENTIAL-ASCII VALUE 2. 008280 88 ISAM-SIXBIT VALUE 3. 008300 88 ISAM-ASCII VALUE 4. 008320 88 DBMS-TYPE VALUE 5. 008340 02 INF2-FX PIC S9(10) COMP VALUE 0. 008360 02 INF2-RECLEN PIC S9(10) COMP VALUE 0. 008380 02 INF2-TYPE PIC S9(10) COMP VALUE 0. 008400 02 INF3-FX PIC S9(10) COMP VALUE 0. 008420 02 INF3-RECLEN PIC S9(10) COMP VALUE 0. 008440 02 INF3-TYPE PIC S9(10) COMP VALUE 0. 008460 02 INPUT-TO-COPY-FTYPE PIC S9(10) COMP VALUE 1. 008480 02 J PIC S9(10) COMP VALUE 1. 008500 02 K PIC S9(10) COMP VALUE 1. 008520 02 KEYLEN1 PIC S9(10) COMP VALUE 1. 008540 02 KEYLEN2 PIC S9(10) COMP VALUE 1. 008560 02 KEYLEN3 PIC S9(10) COMP VALUE 1. 008580 02 KEYLOC1 PIC S9(10) COMP VALUE 1. 008600 02 KEYLOC2 PIC S9(10) COMP VALUE 1. 008620 02 KEYLOC3 PIC S9(10) COMP VALUE 1. 008640 02 KICKOFF-FLAG PIC S9(10) COMP VALUE 0. 008660 02 L PIC S9(10) COMP VALUE 1. 008670 02 LEFT-HALF PIC S9(10) COMP VALUE 0. 008680 02 LINES-IN-PHASE PIC S9(10) COMP VALUE 0. 008700 02 LASTTIME-X PIC S9(10) COMP VALUE 0. 008710 02 LINE-LENGTH PIC S9(10) COMP VALUE 1. 008720 02 LPAREN-COUNT PIC S9(10) COMP VALUE 0. 008740 02 MAXIMUM-CODE PIC S9(10) COMP VALUE 80. 008760 02 MAX-AITEM-LEN PIC S9(10) COMP VALUE 54. 008780 02 MAX-AITEM-LEN-UP1 PIC S9(10) COMP VALUE 55. 008800 02 MAX-ANX PIC S9(10) COMP VALUE 84. 008820 02 MAX-DX PIC S9(10) COMP VALUE 200. 008840 02 MAX-FWX PIC S9(10) COMP VALUE 72. 008860 02 MAX-KEYLEN PIC S9(10) COMP VALUE 30. 008880 02 MAX-NITEM-LEN PIC S9(10) COMP VALUE 18. 008900 02 MAX-NITEM-LEN-UP1 PIC S9(10) COMP VALUE 19. 008920 02 MAX-PRINT-CHARS PIC S9(10) COMP VALUE 220. 008940 02 MAX-PROMPT PIC S9(10) COMP VALUE 33. 008960 02 MAX-REPORTS PIC S9(10) COMP VALUE 10. 008980 02 MINIMUM-CODE PIC S9(10) COMP VALUE 81. 009000 02 NCOPIED PIC S9(10) COMP VALUE 0. 009020 02 NEXTRX PIC S9(10) COMP VALUE 1. 009040 02 NHOLDER-SCALE PIC S9(10) COMP VALUE 0. 009060 02 NHOLDER-TYPE PIC 9 COMP VALUE 0. 009080 88 EMPTY-TYPE VALUE 0. 009100 88 ALPHA-TYPE VALUE 1. 009120 88 NUMERIC-TYPE VALUE 2. 009140 88 BINARY-TYPE VALUE 6. 009150 02 OCCURENCE PIC S9(10) COMP VALUE 0. 009160 02 OPERATION PIC S9(10) COMP VALUE 0. 009180 02 PREV-START-ANX PIC S9(10) COMP VALUE 1. 009200 02 PRINT-POS PIC S9(10) COMP VALUE 1. 009220 02 PROJ PIC S9(10) COMP VALUE 0. 009240 02 QTEXEC-COUNT PIC S9(10) COMP VALUE 0. 009250 02 RANGE1 PIC S9(10) COMP VALUE 0. 009255 02 RANGE2 PIC S9(10) COMP VALUE 0. 009260 02 REPORT-CODE PIC S9(10) COMP VALUE 23. 009280 02 RELATIONSHIP PIC S9(10) COMP VALUE 0. 009290 02 RIGHT-HALF PIC S9(10) COMP VALUE 0. 009300 02 ROUTER PIC S9(10) COMP VALUE 0. 009310 88 IN-SCAN1 VALUE 1,2,3,4. 009312 88 IN-SCAN2 VALUE 7,8,9,10. 009314 88 IN-SCAN3 VALUE 13,14,15,16. 009320 02 RPTHEAD-STOPPER PIC S9(10) COMP VALUE 90902. 009340 02 RUNNING-ACROSS PIC S9(10) COMP VALUE 1. 009360 02 RUNNING-ACROSSX PIC S9(10) COMP VALUE 1. 009380 02 RUNNING-PRINTPOS PIC S9(10) COMP VALUE 1. 009400 02 RUNNING-PRINTPOSX PIC S9(10) COMP VALUE 1. 009404 02 SAVE-BHOLDER PIC S9(18) COMP. 009410 02 SAVE-LEFT-DX-X PIC S9(10) COMP VALUE 0. 009414 02 SAVE-SCALE PIC S9(10) COMP. 009415 02 SAVED-GRPNAME PIC X VALUE SPACE. 009420 02 SAVEX PIC S9(10) COMP VALUE 0. 009425 02 SCAN-ITEM-SW PIC S9(10) COMP VALUE 0. 009430 88 NO-SCAN-ITEMS VALUE 0. 009435 02 SCAN-POS PIC S9(10) COMP VALUE 0. 009440 02 SUMX PIC S9(10) COMP VALUE 0. 009460 02 SIGN-POS PIC S9(10) COMP VALUE 1. 009480 02 SORT-KEYLEN PIC S9(10) COMP VALUE 60. 009500 02 SORT-KEYOFFSET PIC S9(10) COMP VALUE 1. 009520 02 SORT-RECLEN PIC S9(10) COMP VALUE 640. 009540 02 SORTER-ROUTER PIC S9(10) COMP VALUE 1. 009560 02 SORT-STARTX PIC S9(10) COMP VALUE 1. 009580 02 START-ANX PIC S9(10) COMP VALUE 1. 009590 02 STOP-CHARS PIC S9(10) COMP VALUE 0. 009600 02 SUMJ PIC S9(10) COMP VALUE 1. 009620 02 SUMK PIC S9(10) COMP VALUE 1. 009640 02 SUM-WORK PIC S9(18) COMP VALUE 0. 009660 02 SUMMARY-ROUTER PIC S9(10) COMP VALUE 1. 009680 02 TALLY-CODE PIC S9(10) COMP VALUE 47. 009700 02 TARGET-DX PIC S9(10) COMP VALUE 1. 009720 02 TARGET-ROUTER PIC S9(10) COMP VALUE 1. 009730 02 TERM-CHARS PIC S9(10) COMP VALUE 72. 009735 02 TITL-WHILE-ACROSS PIC S9(10) COMP VALUE 0. 009740 02 TOTAL-CODE PIC S9(10) COMP VALUE 48. 009760 02 TRUEGOX PIC S9(10) COMP VALUE 1. 009780 02 TRUE-TYPEV PIC S9(10) COMP VALUE 1. 009800 02 USER PIC S9(10) COMP VALUE 0. 009820 02 WORK-2 PIC S9(18) COMP VALUE 0. 009840 02 FILLER REDEFINES WORK-2. 009860 04 WORK-2-LEFT PIC S9(10) COMP. 009880 04 WORK-2-RIGHT PIC S9(10) COMP. 009900 02 WORKX PIC S9(10) COMP VALUE 0. 009920 009940**MISC ALPHA & STRAIGHT NUM ITEMS FOLLOW** 009960 009980 01 ALPHA-WORKERS. 010000 02 DEVICER PIC X(6) VALUE ' '. 010020 02 CALLED-NAME PIC X(6) VALUE 'IQL '. 010040 02 CURRENT-QUOTE PIC X VALUE SPACE. 010060 02 FLOAT-CHAR PIC X VALUE SPACE. 010080 01 FIND-NAME PIC X(30) VALUE SPACE. 010100 01 FIND-RECORD PIC X(30) VALUE SPACE. 010120 01 FILLER. 010140 02 TODAYS-DATE. 010160 04 TODAY1 PIC 99. 010180 04 TODAY2 PIC 99. 010200 04 TODAY3 PIC 99. 010220 02 REPORTDATE. 010240 04 REPORTDATE1 PIC 99. 010260 04 REPORTDATE2 PIC 99. 010280 04 REPORTDATE3 PIC 99. 010300 02 RPTMASK. 010320 04 RPTMASK1 PIC 99. 010340 04 FILLER PIC X VALUE '/'. 010360 04 RPTMASK2 PIC 99. 010380 04 FILLER PIC X VALUE '/'. 010400 04 RPTMASK3 PIC 99. 010420 02 DISPLAY-PAGE. 010440 04 FILLER PIC X(5) VALUE 'PAGE '. 010460 04 DISPLAY-PAGENO PIC ZZZ9. 010480 02 PICT-WORK. 010500 04 PICT-CHAR PIC X OCCURS 21 010520 INDEXED BY PIX. 010540 02 TEMPKEYV PIC X(30). 010560 010580 01 INF1ISAM6-SYMKEY PIC X(30) VALUE ' ' DISPLAY-6. 010600 01 INF1ISAM7-SYMKEY PIC X(30) VALUE ' ' DISPLAY-7. 010620 01 INF2ISAM6-SYMKEY PIC X(30) VALUE ' ' DISPLAY-6. 010640 01 INF2ISAM7-SYMKEY PIC X(30) VALUE ' ' DISPLAY-7. 010660 01 INF3ISAM6-SYMKEY PIC X(30) VALUE ' ' DISPLAY-6. 010680 01 INF3ISAM7-SYMKEY PIC X(30) VALUE ' ' DISPLAY-7. 010700 01 ERROR-CODE PIC 99999. 010720 01 BINARY-CHAR PIC S9(10) COMP. 010740 01 FILLER REDEFINES BINARY-CHAR. 010760 02 FILLER PIC X(5). 010780 02 ELEM-CHAR PIC X. 010800 01 RANDOM-SEED. 010820 02 SEEDER PIC 9(14) VALUE 47594118. 010840 02 FILLER REDEFINES SEEDER. 010860 04 SEED-JUNK PIC 9(4). 010880 04 SEED PIC 9(10). 010900 01 SEED-WORK-PARAMS. 010920 02 SEED-MULT PIC 99 VALUE 23. 010940 02 SEED-INC PIC 9 VALUE 1. 010960 02 SEED-WORK PIC 9(4). 010980 011000**MISCELLANEOUS BUFFERS FOLLOW** 011020 011040* 011060* *NOTE THAT ARGUMENTS ARE -BEFORE- BUFFERS*. 011080* 011100 01 SYSCOM DISPLAY-7. 011120 03 SYSCOM-AREA-NAME PIC X(30) DISPLAY-7. 011140 03 SYSCOM-RECORD-NAME PIC X(30) DISPLAY-7. 011160 03 ERROR-STATUS PIC 9(5) DISPLAY-7. 011180 03 ERROR-SET PIC X(30) DISPLAY-7. 011200 03 ERROR-RECORD PIC X(30) DISPLAY-7. 011220 03 ERROR-AREA PIC X(30) DISPLAY-7. 011240 03 ERROR-COUNT PIC 99 COMP. 011244 011248 01 CURRENT-RECORD-KEY PIC S9(10) COMP VALUE 0. 011249 01 AREA-NAME-IDENT PIC X(30) DISPLAY-7. 011260 01 BUFFERS. 011280 011300 011320 02 FILLER PIC X(336). 011340 02 HOLD-BUFFER PIC X(1000). 011360* 011380 01 PASSED-PARAMS REDEFINES BUFFERS. 011400 02 EXIT-CODE PIC 999. 011420 02 STATUS-CODE PIC XXX. 011460 02 ARGUMENTS. 011480 04 ARG PIC X(30) OCCURS 11 TIMES 011500 INDEXED BY ARX. 011502 02 ARGUMENTS-R1 REDEFINES ARGUMENTS. 011504 04 ARG-R1 OCCURS 11 TIMES. 011506 06 FILLER PIC X(12). 011508 06 N-ARG PIC S9(18). 011510 02 ARGUMENTS-R2 REDEFINES ARGUMENTS. 011512 04 ARG-R2 OCCURS 11 TIMES. 011514 06 FILLER PIC X(18). 011616 06 B-ARG PIC S9(18) COMP. 011520 02 ARGUMENTS1 REDEFINES ARGUMENTS. 011540 04 EXIT-FNAME PIC X(9). 011560 04 EXIT-FTYPE PIC X. 011580 04 FILLER PIC X(14). 011600 04 EXIT-PPN PIC S9(10) COMP. 011620 04 FILLER PIC X(300). 011640 02 INPCHR. 011660 04 BUFFER-CHAR PIC X OCCURS 1000 011680 INDEXED BY BUFX. 011700 011720 01 PRINT-LINE. 011740 02 PRINT-CHAR PIC X OCCURS 220 TIMES 011760 INDEXED BY PRX. 011780 011800 01 SUMMARY-LINE. 011820 02 SUMMARY-BREAK-TITLE1 PIC X(11). 011840 02 SUMMARY-BREAK-TITLE2 PIC X(11). 011860 02 SUMMARY-BREAK-VALUE PIC X(19). 011880 02 FILLER PIC X VALUE SPACE. 011900 02 SUMMARY-TITLE. 011920 04 SUMMARY-TITLE1 PIC X(11). 011940 04 SUMMARY-TITLE2 PIC X(11). 011960 011980 01 SUMMARY-VERB PIC X(7). 012000 01 SUMMARY-VALUE PIC X(19). 012020 012040 01 PROMPT-LINE. 012060 02 PROMPT-LINE-SHORT. 012080 04 BASIC-LINE-ASTERISK PIC X. 012100 04 BASIC-LINE-TITLE1 PIC X(11). 012120 04 BASIC-LINE-TITLE2 PIC X(11). 012140 04 BASIC-LINE-NCHAR PIC ZZZZ9. 012160 04 BASIC-LINE-POINT PIC X. 012180 04 BASIC-LINE-DECIMALS PIC 9. 012200 04 BASIC-LINE-TYPEV PIC XX. 012220 04 BASIC-LINE-COLON PIC XX. 012240 02 FILLER PIC X(170). 012260 01 WORK-LINE REDEFINES PROMPT-LINE. 012280 02 PROMPT-CHAR PIC X OCCURS 204 TIMES 012300 INDEXED BY PRX. 012320 012340 01 SPACE-LINE PIC X(204) VALUE SPACES. 012360 012362* *BELOW GIVES ASCII NULL CAPABILITY FOR TERMINAL LINES* 012364 01 TERM-LINE USAGE IS DISPLAY-7. 012366 02 TERM-CHAR PIC X OCCURS 205 INDEXED BY NX. 012367 012368 01 SIXBIT-TERM-LINE REDEFINES TERM-LINE DISPLAY-6. 012370 02 SIXBIT-TERM-CHAR PIC X OCCURS 246. 012372 012374 01 SIXBIT-SPACES PIC X(6) VALUE SPACES DISPLAY-6. 012376 01 FILLER REDEFINES SIXBIT-SPACES DISPLAY-7. 012378 02 ASCII-NULL PIC X. 012380 02 FILLER PIC X(4). 012382 012380**WORKING REGISTERS FOR NUMBER CONVERSION FOLLOW** 012400* *NOTE: DO NOT REARRANGE FROM HERE TO BHOLDER. IN 012420* ADDITION TO THEIR PRIMARY FUNCTIONS, ALT-AHOLDER, 012440* ANSWER CATCH OVERFLOW FROM AHOLDER 012460* IN THE CASE OF VERY LONG LITERAL OR ALPHA ITEMS*. 012480 012500 01 AHOLDER. 012520 02 AHOLDER-30. 012540 03 AHOLDER-25. 012560 04 AHOLDER-20. 012580 05 AHOLDER-15. 012600 06 AHOLDER-10. 012620 07 AHOLDER-9. 012640 08 AHOLDER-8. 012660 09 AHOLDER-7. 012680 10 AHOLDER-6. 012700 11 AHOLDER-5. 012720 12 AHOLDER-4. 012740 13 AHOLDER-3. 012760 14 AHOLDER-2. 012780 15 AHOLDER-1 PIC X. 012800 15 FILLER PIC X. 012820 14 FILLER PIC X. 012840 13 FILLER PIC X. 012860 12 FILLER PIC X. 012880 11 FILLER PIC X. 012900 10 FILLER PIC X. 012920 09 FILLER PIC X. 012940 08 FILLER PIC X. 012960 07 FILLER PIC X. 012980 06 FILLER PIC X(5). 013000 05 FILLER PIC X(5). 013020 04 FILLER PIC X(5). 013040 03 FILLER PIC X(5). 013060 02 FILLER PIC X(24). 013080 01 FILLER REDEFINES AHOLDER. 013100 02 AHOLDER-CHAR PIC X OCCURS 54 TIMES 013120 INDEXED BY AHLX. 013140 01 FILLER REDEFINES AHOLDER. 013160 02 NHOLDER-PREFIX PIC X(36). 013180 02 NHOLDER PIC S9(18). 013200 02 ANHOLDER REDEFINES NHOLDER. 013220 04 NHOLDER-CHAR PIC X OCCURS 18 013240 INDEXED BY NHLX. 013260 02 UNPK1 REDEFINES NHOLDER. 013280 04 FILLER PIC X(17). 013300 04 NHOLDER1 PIC S9. 013320 02 UNPK8 REDEFINES NHOLDER. 013340 04 FILLER PIC X(10). 013360 04 NHOLDER8 PIC S9(8). 013380 02 UNPK10 REDEFINES NHOLDER. 013400 04 FILLER PIC X(8). 013420 04 NHOLDER10 PIC S9(10). 013440 02 UNPK18 REDEFINES NHOLDER. 013460 04 NHOLDER18 PIC S9(18). 013480 013484 01 AHOLDER-EXTENSION1. 023500 02 NHOLDER-EXTENSION PIC S9(18) VALUE 0. 023520 02 NHOLDER-EXTENSION1 PIC S9(18) VALUE 0. 013540 013544 01 AHOLDER-EXTENSION2 PIC X(84). 013560 01 ANSWER REDEFINES AHOLDER-EXTENSION2. 013580 02 ANSWER-30. 013600 03 ANSWER-25. 013620 04 ANSWER-20. 013640 05 ANSWER-15. 013660 06 ANSWER-10. 013680 07 ANSWER-9. 013700 08 ANSWER-8. 013720 09 ANSWER-7. 013740 10 ANSWER-6. 013760 11 ANSWER-5. 013780 12 ANSWER-4. 013800 13 ANSWER-3. 013820 14 ANSWER-2. 013840 15 ANSWER-1 PIC X. 013860 15 FILLER PIC X. 013880 14 FILLER PIC X. 013900 13 FILLER PIC X. 013920 12 FILLER PIC X. 013940 11 FILLER PIC X. 013960 10 FILLER PIC X. 013980 09 FILLER PIC X. 014000 08 FILLER PIC X. 014020 07 FILLER PIC X. 014040 06 FILLER PIC X(5). 014060 05 FILLER PIC X(5). 014080 04 FILLER PIC X(5). 014100 03 FILLER PIC X(5). 014120 02 FILLER PIC X(54). 014140 01 FILLER REDEFINES ANSWER. 014160 02 ANS-CHAR PIC X OCCURS 84 TIMES 014180 INDEXED BY ANX. 014184 014185* *FILLER BELOW GIVES SPACE FOR OVERFLOW OF LONG ALPHAS. 014188 01 AHOLDER-EXTENSION3 PICTURE X(300). 014200 014220 01 ALT-AHOLDER PIC X(54). 014240 01 FILLER REDEFINES ALT-AHOLDER. 014260 02 ALT-AHOLDER-30 PIC X(30). 014280 02 FILLER PIC X(6). 014300 02 ALT-NHOLDER PIC S9(18). 014320 02 ALT-UNPK1 REDEFINES ALT-NHOLDER. 014340 04 FILLER PIC X(17). 014360 04 ALT-NHOLDER1 PIC S9. 014380 04 ALT-ANHOLDER1 REDEFINES ALT-NHOLDER1 PIC X. 014400 02 ALT-UNPK8 REDEFINES ALT-UNPK1. 014420 04 FILLER PIC X(10). 014440 04 ALT-NHOLDER8 PIC S9(8). 014460 02 ALT-UNPK10 REDEFINES ALT-UNPK8. 014480 04 FILLER PIC X(8). 014500 04 ALT-NHOLDER10 PIC S9(10). 014520 02 ALT-UNPK18 REDEFINES ALT-UNPK10. 014540 04 ALT-NHOLDER18 PIC S9(18). 014560 014580 01 ALT-NHOLDER-EXTENSION PIC S9(18) VALUE 0. 014600 014601* *FILLER BELOW GIVES SPACES FOR OVERFLOW OF LONG ALPHAS. 014604 01 FILLER PICTURE X(300). 014608 014620 01 BHOLDER-ALPHA PIC X(12). 014640 01 BHOLDER REDEFINES BHOLDER-ALPHA 014660 PIC S9(18) COMP. 014680 01 FILLER REDEFINES BHOLDER-ALPHA. 014700 02 BHOLDER-LEFT PIC S9(10) COMP. 014720 02 BCOMP6 PIC S9(10) COMP. 014740 02 BCOMP6A REDEFINES BCOMP6 PIC X(6). 014760 01 BHOLDER1 REDEFINES BHOLDER-ALPHA. 014780 02 BCOMP12 PIC S9(18) COMP. 014800 02 BCOMP12A REDEFINES BCOMP12 PIC X(12). 014820 014840 01 ALT-BHOLDERA PIC X(12). 014860 01 ALT-BHOLDER REDEFINES ALT-BHOLDERA 014880 PIC S9(18) COMP. 014900 01 FILLER REDEFINES ALT-BHOLDER. 014920 02 ALT-BHOLDER-LEFT PIC S9(10) COMP. 014940 02 ALT-BCOMP6 PIC S9(10) COMP. 014960 02 ALT-BCOMP6A REDEFINES ALT-BCOMP6 PIC X(6). 014980 01 FILLER REDEFINES ALT-BHOLDER. 015000 02 ALT-BCOMP12 PIC S9(18) COMP. 015020 02 ALT-BCOMP12A REDEFINES ALT-BCOMP12 PIC X(12). 015040 02 ACCUM REDEFINES ALT-BCOMP12A 015060 PIC S9(18) COMP. 015080 015100* *TEMP STACK FOR COMPUTATIONS (AND OTHER THINGS): 015120 01 TEMP-REGISTERS OCCURS 10 TIMES INDEXED BY TX. 015140 02 TEMP PIC S9(18) COMP. 015160 02 TSCALE PIC S9(10) COMP. 015180 015200 015220 01 DYN-FILE-CHAR-SET. 015240 02 FILLER PIC X VALUE '1'. 015260 02 FILLER PIC X VALUE '2'. 015280 02 FILLER PIC X VALUE '3'. 015300 02 FILLER PIC X VALUE '4'. 015320 02 FILLER PIC X VALUE '5'. 015340 02 FILLER PIC X VALUE '6'. 015360 02 FILLER PIC X VALUE '7'. 015380 02 FILLER PIC X VALUE '8'. 015400 02 FILLER PIC X VALUE '9'. 015420 02 FILLER PIC X VALUE 'A'. 015440 02 FILLER PIC X VALUE 'B'. 015460 02 FILLER PIC X VALUE 'C'. 015480 02 FILLER PIC X VALUE 'D'. 015500 02 FILLER PIC X VALUE 'E'. 015520 02 FILLER PIC X VALUE 'F'. 015540 02 FILLER PIC X VALUE 'G'. 015560 02 FILLER PIC X VALUE 'H'. 015580 02 FILLER PIC X VALUE 'I'. 015600 02 FILLER PIC X VALUE 'J'. 015620 02 FILLER PIC X VALUE 'K'. 015640 02 FILLER PIC X VALUE 'L'. 015660 02 FILLER PIC X VALUE 'M'. 015680 02 FILLER PIC X VALUE 'N'. 015700 02 FILLER PIC X VALUE 'O'. 015720 02 FILLER PIC X VALUE 'P'. 015740 02 FILLER PIC X VALUE 'Q'. 015760 02 FILLER PIC X VALUE 'R'. 015780 02 FILLER PIC X VALUE 'S'. 015800 02 FILLER PIC X VALUE 'T'. 015820 02 FILLER PIC X VALUE 'U'. 015840 02 FILLER PIC X VALUE 'V'. 015860 02 FILLER PIC X VALUE 'W'. 015880 02 FILLER PIC X VALUE 'X'. 015900 02 FILLER PIC X VALUE 'Y'. 015920 02 FILLER PIC X VALUE 'Z'. 015940 015960 01 DYN-FILE-CHAR-SET1 REDEFINES DYN-FILE-CHAR-SET. 015980 02 DYN-FILE-CHAR PIC X OCCURS 35 TIMES 016000 INDEXED BY DDX. 016020 016040 016060 01 POWERS-OF-TEN. 016080 02 10E1 PIC S9(12) COMP VALUE 10. 016100 02 10E2 PIC S9(12) COMP VALUE 100. 016120 02 10E3 PIC S9(12) COMP VALUE 1000. 016140 02 10E4 PIC S9(12) COMP VALUE 10000. 016160 02 10E5 PIC S9(12) COMP VALUE 100000. 016180 02 10E6 PIC S9(12) COMP VALUE 1000000. 016200 02 10E7 PIC S9(12) COMP VALUE 10000000. 016220 02 10E8 PIC S9(12) COMP VALUE 100000000. 016240 02 10E9 PIC S9(12) COMP VALUE 1000000000. 016260 02 10E10 PIC S9(12) COMP VALUE 10000000000. 016280 02 10E11 PIC S9(12) COMP VALUE 100000000000. 016300 02 10E12 PIC S9(13) COMP VALUE 1000000000000. 016320 02 10E13 PIC S9(14) COMP VALUE 10000000000000. 016340 02 10E14 PIC S9(15) COMP VALUE 100000000000000. 016360 02 10E15 PIC S9(16) COMP VALUE 1000000000000000. 016380 02 10E16 PIC S9(17) COMP VALUE 10000000000000000. 016400 02 10E17 PIC S9(18) COMP VALUE 100000000000000000. 016420 02 10E18 PIC S9(18) COMP VALUE 100000000000000000. 016440 01 FILLER REDEFINES POWERS-OF-TEN. 016460 02 10EX PIC S9(13) COMP OCCURS 18 TIMES 016480 INDEXED BY PTX. 016500 016520 01 ROUNDING-FACTORS. 016540 02 5E0 PIC S9(12) COMP VALUE 5. 016560 02 5E1 PIC S9(12) COMP VALUE 50. 016580 02 5E2 PIC S9(12) COMP VALUE 500. 016600 02 5E3 PIC S9(12) COMP VALUE 5000. 016620 02 5E4 PIC S9(12) COMP VALUE 50000. 016640 02 5E5 PIC S9(12) COMP VALUE 500000. 016660 02 5E6 PIC S9(12) COMP VALUE 5000000. 016680 02 5E7 PIC S9(12) COMP VALUE 50000000. 016700 02 5E8 PIC S9(12) COMP VALUE 500000000. 016720 02 5E9 PIC S9(12) COMP VALUE 5000000000. 016740 02 5E10 PIC S9(12) COMP VALUE 50000000000. 016760 02 5E11 PIC S9(12) COMP VALUE 500000000000. 016780 02 5E12 PIC S9(13) COMP VALUE 5000000000000. 016800 01 FILLER REDEFINES ROUNDING-FACTORS. 016820 02 5EX PIC S9(13) COMP OCCURS 13 016840 INDEXED BY RNDX. 016860 016880***ELEMENTARY TABLES (FOR SPEED) FOLLOW******************* 016900 016920* *TABLE OF ELEMENTARY REPORT PARAMETERS FOLLOWS*. 016940 016960 01 ELEM-R-ENTRY. 016980 02 ELEM-RPT-TYPE PIC S9(10) COMP VALUE 19. 017000 02 ELEM-RPT-PARAMS. 017020 04 ELEM-RPT-NO PIC S9(10) COMP VALUE 1. 017040 04 ELEM-PAGE-NO PIC S9(10) COMP VALUE 0. 017060 04 ELEM-LINE-NO PIC S9(10) COMP VALUE 0. 017080 04 ELEM-ACROSS-NO PIC S9(10) COMP VALUE 1. 017100 04 ELEM-RPTDATE PIC S9(10) COMP VALUE -1. 017120 04 ELEM-LAST-PRINTX PIC S9(10) COMP VALUE 0. 017140 04 ELEM-PRINTPOS PIC S9(10) COMP VALUE 1. 017160 02 ELEM-LAST-PRINTYPE PIC S9(10) COMP VALUE 0. 017180 88 NO-LINE VALUE 0. 017200 88 DETAIL-LINE VALUE 1. 017220 88 SUMMATION-LINE VALUE 2. 017240 88 PAGE-HEADING VALUE 3. 017260 02 ELEM-RPTHEADX PIC S9(10) COMP VALUE 3. 017280 017300 01 ELEM-F-ENTRY. 017320 02 ELEM-F-TYPE PICTURE S9(10) COMP VALUE 7. 017340 02 ELEM-F-RECLEN PICTURE S9(10) COMP VALUE 80. 017360 02 ELEM-F-BLKLEN PICTURE S9(10) COMP VALUE 0. 017380 02 ELEM-F-ORIGIN PICTURE S9(10) COMP VALUE 1. 017400 02 RD1. 017420 03 ELEM-F-KEYLOC PICTURE S9(10) COMP . 017440 03 ELEM-F-KEYLEN PICTURE S9(10) COMP . 017460 03 ELEM-F-KEYTYPE PICTURE S9(10) COMP . 017480 03 ELEM-F-KEYSIGN PICTURE S9(10) COMP . 017500 03 ELEM-F-PPN PICTURE S9(10) COMP . 017520 02 ELEM-F-SUBSCHEMA REDEFINES RD1 PIC X(30). 017540 02 RD2. 017560 03 ELEM-F-ID PICTURE X(9) VALUE 'ISAMF6IDX'. 017580 03 ELEM-F-DEVICE PICTURE X(6). 017600 03 FILLER PICTURE X(14). 017604 03 ELEM-F-OPEN PIC X. 017620 02 ELEM-F-SCHEMA REDEFINES RD2 PICTURE X(30). 017640 02 DBMS-PASSWORD PICTURE X(6) VALUE SPACE. 017660 01 ELEM-B-ENTRY REDEFINES ELEM-F-ENTRY. 017680 02 ELEM-B-TYPEV PICTURE S9(10) COMP. 017700 02 ELEM-B-NCHAR PICTURE S9(10) COMP. 017720 02 ELEM-B-SCALE PICTURE S9(10) COMP. 017740 02 ELEM-B-FILLER-1 PICTURE X(12). 017760 02 ELEM-B-FCHAR PICTURE S9(10) COMP. 017780 02 ELEM-B-FILLER-2 PICTURE X(6). 017800 02 ELEM-B-NAME PICTURE X(30). 017820 02 ELEM-B-AREA-SET PIC S9(10) COMP. 017840 02 ELEM-B-RECNO PICTURE S9(10) COMP. 017860 02 ELEM-B-FILLER-3 PICTURE X(6). 017880 017900 017920 017940 01 ELEM-D-ENTRY REDEFINES ELEM-B-ENTRY. 017960 02 ELEM-D-TYPEV PIC S9(10) COMP. 017980 02 ELEM-D-NCHAR PIC S9(10) COMP. 018000 02 ELEM-D-SCALE PIC S9(10) COMP. 018020 02 ELEM-D-ECHAR PIC S9(10) COMP. 018040 02 ELEM-D-TCHAR PIC S9(10) COMP. 018060 02 ELEM-D-FCHAR PIC S9(10) COMP. 018080 02 ELEM-D-NREPEATS PIC S9(10) COMP. 018100 02 ELEM-D-GRPLEN PIC S9(10) COMP. 018120 02 ELEM-D-TITLE1. 018140 04 EDT1 PIC X OCCURS 10. 018160 02 ELEM-D-TITLE2. 018180 04 EDT2 PIC X OCCURS 10. 018200 02 ELEM-D-PICT. 018220 04 ELEM-D-PICT-T PIC X. 018240 04 FILLER PIC X(19). 018260 02 ELEM-D-GRPNAME PIC X. 018280 02 ELEM-D-STOPV PIC X. 018300 018320 01 ELEM-V-ENTRY REDEFINES ELEM-D-ENTRY. 018340 02 ELEM-V-TYPEV PIC S9(10) COMP. 018360 02 ELEM-V-NCHAR PIC S9(10) COMP. 018380 02 ELEM-V-SCALE PIC S9(10) COMP. 018400 02 ELEM-V-ECHAR PIC S9(10) COMP. 018420 02 ELEM-V-TCHAR PIC S9(10) COMP. 018440 02 ELEM-V-BINARY PIC S9(18) COMP. 018460 02 ELEM-V-WORK PIC S9(10) COMP. 018480 02 ELEM-V-TITLE1 PIC X(10). 018500 02 ELEM-V-TITLE2 PIC X(10). 018520 02 ELEM-V-PICTURET PIC X(20). 018540 02 FILLER PIC XX. 018560 018580 01 ELEM-C-ENTRY REDEFINES ELEM-V-ENTRY. 018600 02 ELEM-C-TYPEV PIC S9(10) COMP. 018620 02 ELEM-C-NCHAR PIC S9(10) COMP. 018640 02 ELEM-C-SCALE PIC S9(10) COMP. 018660 02 FILLER PIC X(12). 018680 02 ELEM-C-BINARY PIC S9(18) COMP. 018700 02 ELEM-C-NUMERIC PIC S9(18). 018720 02 FILLER PIC X(30). 018740 018760 01 ELEM-L-ENTRY REDEFINES ELEM-C-ENTRY. 018780 02 ELEM-L-TYPEV PIC S9(10) COMP. 018800 02 ELEM-L-NCHAR PIC S9(10) COMP. 018820 02 ELEM-L-VALUE PIC X(78). 018840 018860 01 ELEM-K-ENTRY REDEFINES ELEM-L-ENTRY. 018880 02 ELEM-K-TYPEV PIC S9(10) COMP. 018900 02 ELEM-K-NCHAR PIC S9(10) COMP. 018920 02 ELEM-K-STARTKEY PIC X(30). 018940 02 ELEM-K-ENDKEY PIC X(30). 018960 02 FILLER PIC X(18). 018980 019000 019020*****TABLES PASSED FROM ANALYSIS MODULE FOLLOW************ 019040 019060 01 CONTROL-TABLE. 019080* *VALUES BELOW ARE DEFAULTS WHICH SHOULD BE PASSED IF 019100* THE QUERY DOES NOT AFFECT THAT QUANTITY*. 019120* *1ST ENTRY WILL STOP RUN IF EVER GET THERE*. 019140* *2ND & 3RD ENTRIES ARE DEFAULT RPTHEAD DX LIST. 019160 02 CONST1 PIC S9(10) COMP VALUE 1. 019180 02 FILLER PIC S9(10) COMP VALUE 1. 019200 02 CONST0 PIC S9(10) COMP VALUE 0. 019220 02 DYN-JOBNO PIC S9(10) COMP VALUE 1. 019240 02 EXEC-STARTX PIC S9(10) COMP VALUE 1. 019260 02 EOF1-X PIC S9(10) COMP VALUE 1. 019280 02 ACROSS-CONTROL PIC S9(10) COMP VALUE 1. 019300 02 DISPLAY-FLAG PIC S9(10) COMP VALUE 1. 019320 02 HEADING-FLAG PIC S9(10) COMP VALUE 1. 019340 02 PAGING-FLAG PIC S9(10) COMP VALUE 1. 019360 02 PRINT-FLAG PIC S9(10) COMP VALUE 1. 019380 02 SUMPRINT-FLAG PIC S9(10) COMP VALUE 1. 019400 02 TITLE-FLAG PIC S9(10) COMP VALUE 1. 019420 02 FORM-LINES PIC S9(10) COMP VALUE 66. 019440 02 PAGE-LINES PIC S9(10) COMP VALUE 57. 019460 02 REPORT-DX PIC S9(10) COMP VALUE 0. 019480 02 NUMB-REPORTS PIC S9(10) COMP VALUE 1. 019500 02 HSPACE PIC S9(10) COMP VALUE 3. 019520 02 VSPACE PIC S9(10) COMP VALUE 1. 019540 02 LMARGIN PIC S9(10) COMP VALUE 1. 019560 02 RMARGIN PIC S9(10) COMP VALUE 72. 019580 02 DBMS-STSBLK. 019600 04 DBMS-SIXBIT PIC X. 019620 04 DBMS-ASCII PIC X. 019640 04 DBMS-BINARY PIC X. 019660 04 DBMS-EBC PIC X. 019680 04 DBMS-CM3 PIC X. 019700 04 DBMS-CM1 PIC X. 019720 02 FILLER PIC S9(10) COMP OCCURS 2978. 019740 019760 01 INSTR-TABLE REDEFINES CONTROL-TABLE. 019780 02 INSTR PIC S9(10) COMP 019800 OCCURS 3000 INDEXED BY X. 019820 019840 01 FILE-TABLE REDEFINES INSTR-TABLE. 019860 02 F-ENTRY OCCURS 200 INDEXED BY FX. 019880 04 F-TYPE PIC S9(10) COMP. 019900 04 F-RECLEN PIC S9(10) COMP. 019920 04 F-BLKLEN PIC S9(10) COMP. 019940 04 F-ORIGIN PIC S9(10) COMP. 019960 04 F-KEYLOC PIC S9(10) COMP. 019980 04 F-KEYLEN PIC S9(10) COMP. 020000 04 F-KEYTYPE PIC S9(10) COMP. 020020 04 F-KEYSIGN PIC S9(10) COMP. 020040 04 F-PPN PIC S9(10) COMP. 020060 04 F-ID PIC X(9). 020080 04 F-DEVICE PIC X(6). 020100 04 FILLER PIC X(15). 020120 04 F-MARKER PIC X(6). 020140 020160 01 DICTIONARY-TABLE REDEFINES FILE-TABLE. 020180 02 D-ENTRY OCCURS 200 INDEXED BY DX. 020200 04 D-TYPEV PIC S9(10) COMP. 020220 04 D-NCHAR PIC S9(10) COMP. 020240 04 D-SCALE PIC S9(10) COMP. 020260 04 D-ECHAR PIC S9(10) COMP. 020280 04 D-TCHAR PIC S9(10) COMP. 020300 04 D-FCHAR PIC S9(10) COMP. 020320 04 D-NREPEATS PIC S9(10) COMP. 020340 04 D-GRPLEN PIC S9(10) COMP. 020360 04 D-TITLE1 PIC X(10). 020380 04 D-TITLE2 PIC X(10). 020400 04 D-PICTURET PIC X(20). 020420 04 D-GRPNAME PIC X. 020440 04 D-STOPV PIC X. 020450* 01 INTERRUPT-FLAG INDEX. 020051* 01 INTERRUPT-ERROR INDEX. 020460 020480*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 020500*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 020520 020540********************************************************** 020560* THIS SECTION READS IN THE ANALYSIS TABLE FILE AND 020580* INITIALIZES AS NECESSARY. 020600********************************************************** 020620 020640 PROCEDURE DIVISION. 020642 020644 DECLARATIVES. 020646 020648 ISAM-FILE-ERROR SECTION. USE AFTER STANDARD ERROR PROCEDURE 020652 ON INF1SD6 INF1SD7 INF2SD6 INF2SD7 INF3SD6 INF3SD7. 020654 ISAM-FILE-ERROR-SCREEN. 020655* *THIS IS JUST HERE TO CUTOFF COBOL'S SCREAMING ABOUT MISSING 020656* * ISAM FILES UNTIL WE CAN TELL IT WHAT FILES WE REALLY WANT* 020657 MOVE 0 TO ISAM-ERROR-FLAG. 020658 IF NOT ( ERROR-VERB = 1 AND 020660 ( ERROR-CALL = 3 OR ERROR-CALL = 7 )) GO TO ISAM-IS-OK. 020662 MOVE 1 TO ISAM-ERROR-FLAG. 020664 ISAM-IS-OK. 020666 EXIT. 020668 020670 END DECLARATIVES. 020672 020674 MAIN SECTION. 020676* *'ENTER MACRO IQGETI' IS EQUIVALENT TO 020680* * 'MOVE INSTR (X) TO ELEM-INSTR' 020700 020720* *'ENTER MACRO IQGETD' IS EQUIVALENT TO 020740* * 'MOVE D-ENTRY (DX) TO ELEM-D-ENTRY' 020760 020780* *'ENTER MACRO IQPUTI' IS EQUIVALENT TO 020800* * 'MOVE ELEM-INSTR TO INSTR (X)' 020820 020840* *'ENTER MACRO IQPUTD' IS EQUIVALENT TO 020860* * 'MOVE ELEM-D-ENTRY TO D-ENTRY (DX)' 020880 020900* *ALL OF THE ABOVE REQUIRE THAT 'ENTER MACRO IQSETX' 020920* * BE RUN INITIALLY TO INITIALIZE THEM. 020940 020960* * 'ENTER MACRO IQPICT' IS EQUIVALENT TO 020980* * 'PERFORM EDITOR THRU EDITOR-EXIT' 021000* * (IQPICT REQUIRES A CALL TO IQEBND TO 021020* * INITIALIZE IT). 021040 021060 BEGIN-EXEC. 021065* SET INTERRUPT-FLAG TO 0. 021070* CALL SETINT USING 5,INTERRUPT-FLAG,INTERRUPT-ERROR. 021072* IF INTERRUPT-ERROR NOT = 0 021074* DISPLAY '? ERROR IN SETINT' STOP RUN. 021080 ENTER MACRO CLRTTY. 021100 021120* *SET UP FOR FAST INSTRUCT AND DICT ENTRY RETRIEVAL*. 021140 ENTER MACRO IQSETX USING INSTR-TABLE X 021160 DICTIONARY-TABLE DX ELEM-INSTR ELEM-D-ENTRY. 021180 ENTER MACRO IQEBND USING TRUE-TYPEV PICT-WORK AHOLDER 021200 ELEM-D-PICT 021220 ELEM-D-ECHAR ELEM-D-NCHAR ELEM-D-SCALE. 021240 021260* *SET UP DYNAMIC FILE NAMES*. 021280 ENTER MACRO IQGJOB USING J. 021300 MOVE J TO QTSORTNO QTANLZNO QTEXECNO. 021320 MOVE QT001ATMP TO QTANLZTMP. 021340 021360* *OPEN MULTIPLE REPORT FILE HERE, EVEN IF DUMMY* 021380 MOVE 0 TO QTEXEC-COUNT. 021400 OPEN OUTPUT QTEXEC. 021420 021440 OPEN-ANLZ. 021460* *READ IN TABLES FROM ANALYSIS MODULE* 021480 OPEN INPUT QTANLZ. 021500 SET DX TO 1. 021520 021540 READ QTANLZ AT END GO TO READ-ANLZ-ERR. 021560* * IF A PRE-ANALYZED QUERY FILE, TEMP FILE WILL BE ONE 021580* * RECORD CONTAINING NAME OF PRE-ANALYZED QUERY; PLANT IT 021600* * AND EXECUTE FROM THE *REAL* CONTROL FILE. 021620 IF QTANLZ-SUFFIX = 'INQ' MOVE QTANLZ-NAME TO QTANLZTMP 021640 CLOSE QTANLZ GO TO OPEN-ANLZ. 021660 GO TO READ-ANLZ1. 021680 021700 READ-ANLZ. 021720 READ QTANLZ AT END GO TO READ-ANLZ-ERR. 021740 021760 READ-ANLZ1. 021780 IF QTANLZ-SWITCH = ALL SPACES SET K TO DX 021800 SET DX TO MAX-DX GO TO READ-ANLZ2. 021820 MOVE QTANLZ-REC TO D-ENTRY (DX). 021840 SET DX UP BY 1. 021860 IF DX GREATER THAN MAX-DX GO TO READ-ANLZ-ERR. 021880 GO TO READ-ANLZ. 021900 021920 READ-ANLZ2. 021940 READ QTANLZ AT END SET DX-LOWEST TO DX 021950 GO TO READ-ANLZ-DONE. 021960 MOVE QTANLZ-REC TO D-ENTRY (DX). 021980 IF DX LESS THAN K GO TO READ-ANLZ-ERR. 022000 SET DX DOWN BY 1. 022020 GO TO READ-ANLZ2. 022040 022060 READ-ANLZ-ERR. 022080 CLOSE QTANLZ. 022100 MOVE 01 TO ERROR-CODE. 022120 GO TO ABORT-RUN. 022140 022160 READ-ANLZ-DONE. 022180 CLOSE QTANLZ. 022200 MOVE QT001ATMP TO QTANLZTMP. 022220 022240* *SET UP DOUBLE-DYNAMIC FILE NAMES (SO WILL NOT 022260* *COLLIDE WHEN HAVE MULTIPLE SORT STAGES* *. 022265 MOVE J TO DYN-JOBNO. 022280 MOVE DYN-JOBNO TO QLEXECNO. 022300 DIVIDE DYN-JOBNO BY 100 GIVING J. 022320 UNIQUE-PRINTFILE. 022340 IF J GREATER THAN 35 022360 DISPLAY '%Too many .LPT files on DSK:' 022364 UPON CONSOLE 022368 DISPLAY ' Please delete the old ones and re run' 022372 UPON CONSOLE 022376 MOVE 0 TO SORTFILE-FLAG PRINTFILE-FLAG GO TO ENDER. 022380 IF J NOT = 0 022400 SET DDX TO J 022420 MOVE DYN-FILE-CHAR (DDX) TO QLEXEC-NODUP. 022440* *MAKE SURE NOT WRITING OVER AN EXISTING PRINT FILE* 022460 ENTER MACRO IQLOOK USING DEVICER QLEXECLPT PROJ USER I. 022480 IF I = -1 ADD 1 TO J GO TO UNIQUE-PRINTFILE. 022500 OPEN OUTPUT QLEXEC. 022520 MOVE 1 TO PRINTFILE-FLAG. 022540 022560* *INITIALIZE TERMINAL POSITION*. 022580 DISPLAY ' ' UPON CONSOLE. 022600* 022620* *INITIALIZE FILE STATUS FLAGS*. 022640 MOVE 0 TO INF1-FLAG INF2-FLAG INF3-FLAG 022650 INF1-FX INF2-FX INF3-FX 022660 COPYFILE-FLAG CREATEFILE-FLAG LASTTIME-X 022680 LINES-IN-PHASE CALL-IQM-FLAG. 022700 022720 022740 MOVE 1 TO ACROSS-CONTROL. 022760 MOVE 0 TO LASTTIME-X ENDING-FLAG. 022780 022800* *SET UP INITIAL REPORT ENTRY*. 022820 IF REPORT-DX NOT = 0 022840 SET DX TO REPORT-DX 022860 ENTER MACRO IQGETD 022880 MOVE ELEM-D-ENTRY TO ELEM-R-ENTRY 022900 MOVE 0 TO ELEM-PAGE-NO ELEM-LINE-NO 022920 ENTER MACRO IQPUTD. 022940 022960* *SET UP REPORT DATE*. 022980 MOVE TODAY TO TODAYS-DATE. 023000* *DATE COMES IN AS YYMMDD*. 023020* *NOW SET UP FOR EXECUTION*. 023040 MOVE EOF1-X TO SORT-STARTX. 023060* *ABOVE TAKES CARE OF SUMMARY WRAPUP WHEN NO SORT* 023080 SET X TO EXEC-STARTX. 023100 GO TO NEXT-INSTR. 023120 023140********************************************************** 023160* SEQUENCE 'ABORT-RUN' TO ISSUE ERROR MESSAGE AND END 023180* THE RUN ON AN ERROR. 023200********************************************************** 023220 023240 ABORT-RUN. 023260 PERFORM COMPLAINER THRU COMPLAINER-EXIT. 023280* *KILL SORTING SO WILL END RUN RATHER THAN JUST STAGE*. 023290 ABORT-RUN1. 023300 MOVE 0 TO SORTFILE-FLAG. 023320 GO TO ENDER. 023340 023360 COMPLAINER. 023380 MOVE '?IQE ERROR CODE ' TO PROMPT-LINE. 023400 MOVE ERROR-CODE TO BASIC-LINE-NCHAR. 023420 IF DISPLAY-FLAG = 1 DISPLAY PROMPT-LINE-SHORT UPON CONSOLE. 023440 IF PRINT-FLAG = 1 WRITE QLEXEC-REC FROM PROMPT-LINE-SHORT 023460 AFTER ADVANCING 2 LINES ADD 1 TO LINES-IN-PHASE. 023480 ADD 2 TO ELEM-LINE-NO. 023500 023520 023540 COMPLAINER-EXIT. 023560 EXIT. 023580 023600 ILLEGAL-ALPHA. 023620 DISPLAY 023640 '%Illegal alpha in numeric field; changed to 0' 023660 UPON CONSOLE. 023680 023700******************************************************* 023720* MAJOR INSTRUCTION CYCLING LOGIC FOLLOWS. 023740******************************************************* 023760 023780 NEXT-INSTR-UPX. 023800* *RETURN HERE WHEN KICKING X BEFORE NEXT INSTR. 023820 SET X UP BY 1. 023840 023860 NEXT-INSTR. 023862* *CHECK FOR AN INTERRUPT REQUEST..IF SO, SIMULATE A "GO TO QT". 023864* IF INTERRUPT-FLAG NOT = 0 023866* DISPLAY '[^E Panic interrupt detected]' 023868* GO TO GO-TO-QT. 023880 ENTER MACRO IQGETI. 023900 SET X UP BY 1. 023920* 023940* *CENTRAL TRANSFER VECTOR OF ENTIRE MODULE FOLLOWS*. 023960 GO TO ENDER OPENER INSTR-ERR INSTR-ERR 023980 READSEQ READRAN READDBMS COPIER 024000 CREATER READSUBBEG READSUB SORTER 024020 INSTR-ERR ACCEPT2 DISPLAYER PRINTIT 024040 INSTR-ERR HSPACER VSPACER LMARGINER 024060 RMARGINER ACROSSER REPORTER RPTHEADER 024080 NEWPAGE PAGING-ON PAGING-OFF HEADING-ON 024100 HEADING-OFF TITLES-ON TITLES-OFF SUMPRINT-ON 024120 SUMPRINT-OFF DISPLAY-ON DISPLAY-OFF PRINT-ON 024140 PRINT-OFF RPTDATE-ON RPTDATE-OFF HOLDER 024160 RESETTER SETTER COMPUTE-IT PAGELINE-SET 024180 FORMLINE-SET PAGE-SET TALLIER TOTALER 024200 AVERAGER GO-TO-QT GO-TO-XT GO-TO-NR 024220 GO-TO-NN EXITER IF-BOF1 IF-EOF1 024240 IFNEWPAGE IFNEWGRP INSTR-ERR INSTR-ERR 024260 IF-ER IF-FIRST IF-LAST IF-ANY 024280 IF-NEXT INSTR-ERR IFERRCOUNT IFERRSTATUS 024300 INSTR-ERR RPTDATE-SET IF-EOF2 IF-EOF3 024320 INSTR-ERR IF-BOF2 IF-BOF3 INSTR-ERR 024340 INSTR-ERR PICTURER TITLE-IT MAXIMIZER 024360 MINIMIZER INSTR-ERR INSTR-ERR INSTR-ERR 024362 INSTR-ERR INSTR-ERR REWRITE-IT 024380 DEPENDING ON ELEM-INSTR. 024400 024420********************************************************** 024440* NO-OP INSTRUCTION 024460* FORMAT: 024480* (X) = INSTRUCTION VALUE 0. 024500* NOTE: THIS FALLS THROUGH FROM ABOVE FOR ALL 024520* VALUES NOT 1-81. MUST FILTER OUT TRUE NO-OP (VALUE 0) 024540* FROM ERRORS AND ROUTE CONTROL ACCORDINGLY. 024560********************************************************** 024580 024600 NO-OP. 024620 IF ELEM-INSTR = 0 GO TO NEXT-INSTR. 024640 024660 INSTR-ERR. 024680* *IF HERE, HAVE INVALID INSTRUCTION; ABORT RUN. 024700 MOVE 03 TO ERROR-CODE. 024720 GO TO ABORT-RUN. 024740 024760********************************************************** 024780 024800* END RUN INSTRUCTION. 024820* FORMAT: (X) = INSTRUCTION VALUE 1. 024840* -NOTE- DOES NOT FALL THROUGH TO NEXT X. 024860********************************************************** 024880 024900 ENDER. 024920* *CHECK TO SEE IF ANY LAST TIME PROCESSING TO DO*. 024940 IF LASTTIME-X NOT = 0 SET X TO LASTTIME-X 024960 MOVE 0 TO LASTTIME-X GO TO NEXT-INSTR. 024980 025000* *PUMP OUT ANY PENDING SUMMARY QUANTITIES*. 025020 IF SUMPRINT-FLAG NOT = 1 GO TO ENDER3. 025040 SET X TO EXEC-STARTX. 025044 SET X DOWN BY 1. 025060 MOVE 1 TO ENDING-FLAG. 025080 025100 ENDER1. 025120* *CUT OFF SEARCH FOR SUMMARIES AT END OF STAGE* 025140 IF X NOT LESS THAN SORT-STARTX GO TO ENDER3. 025160 ENTER MACRO IQGETI. 025180* *LOOK FOR INSTR (X) OF 0 FOLLOWED BY A 025200* * SUMMARY VERB*. 025220 IF ELEM-INSTR NOT = 0 SET X UP BY 1 GO TO ENDER1. 025240 025260 ENDER1A. 025280 SET X UP BY 1. 025300 ENTER MACRO IQGETI. 025320* *FIRST LOOK TO SEE IF CHANGING REPORT NUMBER* 025322 IF ELEM-INSTR = 0 GO TO ENDER1A. 025340 IF ELEM-INSTR = REPORT-CODE 025360 SET X UP BY 1 025380 ENTER MACRO IQGETI 025400 IF ELEM-INSTR NOT = 0 SET DX TO ELEM-INSTR 025420 ENTER MACRO IQGETD 025440 MOVE ELEM-D-ENTRY TO ELEM-R-ENTRY 025460 GO TO ENDER1 025480 ELSE GO TO ENDER1. 025500* *NO - NOW SEE IF HAVE A SUMMARY VERB* 025520 IF ELEM-INSTR = TALLY-CODE 025540 MOVE 1 TO SUMMARY-ROUTER GO TO ENDER2. 025560 IF ELEM-INSTR = TOTAL-CODE 025580 MOVE 2 TO SUMMARY-ROUTER GO TO ENDER2. 025600 IF ELEM-INSTR = AVERAGE-CODE 025620 MOVE 3 TO SUMMARY-ROUTER GO TO ENDER2. 025640 IF ELEM-INSTR = MAXIMUM-CODE 025660 MOVE 4 TO SUMMARY-ROUTER GO TO ENDER2. 025680 IF ELEM-INSTR = MINIMUM-CODE 025700 MOVE 5 TO SUMMARY-ROUTER GO TO ENDER2. 025720 SET X UP BY 1. GO TO ENDER1. 025740 025760 ENDER2. 025780* *HERE IF HAVE A SUMMARY TO WRAP UP* 025800 SET X UP BY 1. 025820 ENTER MACRO IQGETI. 025840 MOVE ELEM-INSTR TO SUMK. 025850 IF ELEM-INSTR < 0 SUBTRACT ELEM-INSTR FROM 0 GIVING SUMK. 025860 025880 ENDER2A. 025900 SET HOLDX TO X. 025920 SET X UP BY 1. 025940* *GO TO SUMMARIZING WRAPUP LOGIC; IT WILL RETURN 025960* * TO ENDER1A. 025980 GO TO SUMMARIZER4. 026000 026020 ENDER3. 026040* IF QTEXEC-COUNT = 0*WRITE QTEXEC-REC. 026060 CLOSE QTEXEC. 026080* *CLOSE ANY OPEN DATA FILES*. 026100 PERFORM CLOSER1 THRU CLOSER1-EXIT. 026120 PERFORM CLOSER2 THRU CLOSER2-EXIT. 026140 PERFORM CLOSER3 THRU CLOSER3-EXIT. 026160 IF COPYFILE-FLAG NOT = 0 026180 MOVE 0 TO COPYFILE-FLAG 026200 SET DX TO COPY-FX 026220 ENTER MACRO IQGETD 026240 IF ELEM-F-TYPE = 26 CLOSE OUTFSD6 026260 ELSE CLOSE OUTFSD7. 026280 IF CREATEFILE-FLAG NOT = 0 026300 MOVE 0 TO CREATEFILE-FLAG 026320 SET DX TO CREATE-FX 026340 ENTER MACRO IQGETD 026360 IF ELEM-F-TYPE = 26 CLOSE CREATESD6 026380 ELSE CLOSE CREATESD7. 026400 IF PRINTFILE-FLAG NOT = 0 CLOSE QLEXEC 026420 IF LINES-IN-PHASE = 0 OPEN INPUT QLEXEC 026440 CLOSE QLEXEC WITH DELETE 026460 ELSE DISPLAY ' ' DISPLAY 026480 '(End query phase; print file is ' QLEXECLPT ')' 026500 UPON CONSOLE. 026520 IF SORTFILE-FLAG NOT = 0 GO TO ENDER-SORT. 026540 IF CALL-IQM-FLAG = 0 026560 MOVE 'IQL ' TO CALLED-NAME ELSE 026580 MOVE 'IQM ' TO CALLED-NAME. 026600* *ADJUST TERMINAL SO IQM STARTS AT TOP OF PAGE*. 026620 IF NUMB-REPORTS GREATER THAN 1 026640 IF DISPLAY-FLAG = 1 026660 SUBTRACT ELEM-LINE-NO FROM FORM-LINES GIVING I 026680 PERFORM DISPLAY-VSPACE THRU DISPLAY-VSPACE-EXIT. 026700 ENTER MACRO IQNEXT USING CALLED-NAME. 026720 GO TO STOPPER. 026740 026760 ENDER-SORT. 026780* *SET UP STARTX FOR NEXT STAGE (WHEN COME BACK FROM IQS)*. 026800* *NEW EXEC-STARTX IS 1 PAST CURRENT 'END' INSTRUCTION*. 026802* *HOWEVER, DISABLE ANY GO TO NN FOUND HERE* 026804 COMPUTE X = SORT-STARTX + 4. 026806 ENTER MACRO IQGETI. 026808 IF ELEM-INSTR = 53 MOVE 0 TO ELEM-INSTR 026810 ENTER MACRO IQPUTI 026812 SET X UP BY 1 026814 ENTER MACRO IQPUTI. 026820 SET EXEC-STARTX TO SORT-STARTX. 026840 CLOSE SORTFILE. 026860 ADD 100 TO DYN-JOBNO. 026880* *BUILD SORT FILE PARAMS INTO INF1 F-ENTRY FOR NEXT TIME*. 026900 IF SORTER-ROUTER = 1 SET DX TO INF1-FX 026920 ELSE IF SORTER-ROUTER = 2 SET DX TO INF2-FX 026940 ELSE SET DX TO INF3-FX. 026960 ENTER MACRO IQGETD. 026980 MOVE 0 TO ELEM-F-PPN ELEM-F-KEYLOC ELEM-F-KEYLEN 027000 ELEM-F-KEYTYPE ELEM-F-KEYSIGN ELEM-F-BLKLEN. 027020 MOVE QTSORTTMP TO ELEM-F-ID. 027024 IF ELEM-F-TYPE = 27 027028 COMPUTE ELEM-F-RECLEN = ELEM-F-RECLEN * 6 / 5. 027040 MOVE 26 TO ELEM-F-TYPE. 027042 MOVE ' ' TO DBMS-SIXBIT DBMS-ASCII DBMS-BINARY 027044 DBMS-EBC DBMS-CM3 DBMS-CM1. 027060 ENTER MACRO IQPUTD. 027080 027100* *MOVE CURRENT R-ENTRY SO IS CARRIED OVER* 027120 MOVE 0 TO ELEM-LINE-NO. 027140 MOVE ELEM-R-ENTRY TO ELEM-D-ENTRY. 027160 SET DX TO REPORT-DX. 027180 ENTER MACRO IQPUTD. 027200 027220* *WRITE OUT DYNAMIC CONTROL TABLES FOR USE AFTER IQS*. 027240 OPEN OUTPUT QTANLZ. 027260 SET DX TO 1. 027280 027300 ENDER-SORT-SAVE1. 027320* *WRITE OUT LOW CORE (INSTRUCTIONS) FOR NEXT STAGE*. 027340 MOVE D-ENTRY (DX) TO QTANLZ-REC. 027360 WRITE QTANLZ-REC. 027380 IF QTANLZ-REC NOT = ALL SPACES SET DX UP BY 1 027400 GO TO ENDER-SORT-SAVE1. 027420 SET DX TO MAX-DX. 027440 027460 ENDER-SORT-SAVE2. 027480* *NOW WRITE OUT DYNAMIC DICTIONARY FOR NEXT STAGE*. 027500 MOVE D-ENTRY (DX) TO ELEM-D-ENTRY. 027560 IF ELEM-D-ENTRY = ALL SPACES GO TO ENDER-SORT-SAVE4. 027860 027880 ENDER-SORT-SAVE3. 027900 WRITE QTANLZ-REC FROM ELEM-D-ENTRY. 027920 SET DX DOWN BY 1. 027940 GO TO ENDER-SORT-SAVE2. 027960 027980 ENDER-SORT-SAVE4. 028000 CLOSE QTANLZ. 028020* *CALL SUBROUTINE TO BUILD TEMPCOR FILE FOR STAND-ALONE 028040* SORT* 028060 CALL IQES1 USING SORT-RECLEN SORT-KEYOFFSET SORT-KEYLEN. 028080 028100 STOPPER. 028120 STOP RUN. 028140 028160*********************************************************** 028180* OPEN INSTRUCTION; FORMAT: 028200* (X) = INSTRUCTION VALUE 2. 028220* (X+1) = 0 028222* 028224* OPEN CHECKS TO SEE IF THE PRIMARY FILE IS OPEN AND IF SO 028226* CLOSES IT. WHILE THIS MAY SEEM BACKWARD, THE PHYSICAL OPEN 028227* IS DONE JUST BEFORE THE FIRST READ; THE COMBINATION MAKES 028228* ANY 2ND OR SUBSEQUENT OPEN AN EFFECTIVE "REWIND". 028240* OPEN ALSO RESETS THE VALUE OF EXEC-STARTX SO THAT 028260* 'GO TO NR' COMES BACK JUST BELOW THIS OPEN INSTRUCTION. 028280* THIS PERMITS THE USE OF ONE-TIME QUERY COMMANDS BEFORE 028300* THE 'OPEN', THUS SAVING EXECUTION TIME*. 028320********************************************************** 028340 028360 OPENER. 028364 IF INF1-FX = 0 OR INF1-FLAG = 0 GO TO OPENER1 028368 ELSE IF INF1-FLAG NOT = 0 028372 PERFORM CLOSER1 THRU CLOSER1-EXIT. 028376 OPENER1. 028380 SET X UP BY 1. 028400 SET EXEC-STARTX TO X. 028420 GO TO NEXT-INSTR. 028440 028460 028480**************************************************** 028500* INSTRUCTION TO READ SEQUENTIALLY (INCLUDING ISAM FILES) 028520* FORMAT: (X) = INSTRUCTION VALUE 5 028540* (X+1) = FX OF INPUT FILE F-ENTRY. 028560* (X+2) = READ TYPE; VALUES ARE: 028580* 1 = PRIMARY 6 BIT SEQUENTIAL 028600* 2 = PRIMARY 7 BIT (ASCII) SEQUENTIAL 028620* 3 = PRIMARY 6 BIT ISAM READ SEQUENTIALLY 028640* 4 = PRIMARY 7 BIT ISAM READ SEQUENTIALLY 028660* 5 = RESERVED FOR FUTURE USE 028680* 6 = RESERVED FOR FUTURE USE 028700* 7 = SECONDARY 6 BIT SEQUENTIAL 028720* 8 = SECONDARY 7 BIT SEQUENTIAL 028740* 9 = SECONDARY 6 BIT ISAM READ SEQUENTIALLY 028760* 10 = SECONDARY 7 BIT ISAM READ SEQUENTIALLY 028780* 11 = RESERVED FOR FUTURE USE 028800* 12 = RESERVED FOR FUTURE USE 028820* 13 = TERTIARY 6 BIT SEQUENTIAL 028840* 14 = TERTIARY 7 BIT SEQUENTIAL 028860* 15 = TERTIARY 6 BIT ISAM READ SEQUENTIALLY 028880* 16 = TERTIARY 7 BIT ISAM READ SEQUENTIALLY 028900* 17 = RESERVED FOR FUTURE USE 028920* 18 = RESERVED FOR FUTURE USE 028940* 028960* NOTE THAT OPENS ARE DONE HERE JUST BEFORE FIRST READ. 028980********************************************************** 029000 029020 READSEQ. 029040 ENTER MACRO IQGETI. 029060 SET FX TO ELEM-INSTR. 029080 SET X UP BY 1. 029100 ENTER MACRO IQGETI. 029120 MOVE ELEM-INSTR TO ROUTER. 029140 MOVE 0 TO ELEM-INSTR. 029160 029180 READSEQ-COMMON. 029190 IF NO-SCAN-ITEMS NEXT SENTENCE 029195 ELSE PERFORM RESET-SCAN-ITEMS THRU RESET-SCAN-EXIT. 029200 GO TO RD1SEQ6S RD1SEQ7S RD1ISAM6S RD1ISAM7S 029220 READERRS READERRS RD2SEQ6S RD2SEQ7S 029240 RD2ISAM6S RD2ISAM7S READERRS READERRS 029260 RD3SEQ6S RD3SEQ7S RD3ISAM6S RD3ISAM7S 029280 DEPENDING ON ROUTER. 029300 029320 READERRS. 029340 MOVE 04 TO ERROR-CODE. 029360 GO TO ABORT-RUN. 029380 029400 READLT. 029420 029440 READNLT. 029460* *READ INFLT INTO INPUT-RECS AT END GO TO QWRAPUP. 029480 READCD. 029500* *READ INFCD INTO INPUT-RECS AT END GO TO QWRAPUP. 029520 GO TO READERRS. 029540 029560 RD1SEQ6S. 029580 IF INF1-FLAG NOT LESS THAN 5 GO TO END-FILE1. 029600 IF INF1-FLAG = 0 PERFORM OPEN1-SEQ 029620 ELSE MOVE 3 TO INF1-FLAG. 029640 RD1SEQ6S1. 029660 READ INF1SD6 AT END GO TO END-FILE1. 029680* *IF ELEM-INSTR = 0 HAVE AN EFFECTIVE 'FIND NEXT'*. 029700 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 029720* *HERE IF DOING FIND ITEM = VALUE *. 029740 ENTER MACRO IQGETD. 029760 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 029780 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 029800 GO TO RD1SEQ6S1. 029820 029840 RD1ISAM6S. 029860 IF INF1-FLAG NOT LESS THAN 5 GO TO END-FILE1. 029880 IF INF1-FLAG = 0 029900 MOVE LOW-VALUES TO INF1ISAM6-SYMKEY 029920 PERFORM OPEN1-ISAM 029940 ELSE MOVE 3 TO INF1-FLAG. 029960 RD1ISAM6S1. 029980 READ INF1ISAM6 INVALID KEY GO TO END-FILE1. 030000 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 030020 ENTER MACRO IQGETD. 030040 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 030060 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 030080 GO TO RD1ISAM6S1. 030100 030120 RD1SEQ7S. 030140 IF INF1-FLAG NOT LESS THAN 5 GO TO END-FILE1. 030160 IF INF1-FLAG = 0 PERFORM OPEN1-SEQ 030180 ELSE MOVE 3 TO INF1-FLAG. 030200 RD1SEQ7S1. 030220 READ INF1SD7 AT END GO TO END-FILE1. 030240 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 030260 ENTER MACRO IQGETD. 030280 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 030300 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 030320 GO TO RD1SEQ7S1. 030340 030360 RD1ISAM7S. 030380 IF INF1-FLAG NOT LESS THAN 5 GO TO END-FILE1. 030400 IF INF1-FLAG = 0 030420 MOVE LOW-VALUES TO INF1ISAM7-SYMKEY 030440 PERFORM OPEN1-ISAM 030460 ELSE MOVE 3 TO INF1-FLAG. 030480 RD1ISAM7S1. 030500 READ INF1ISAM7 INVALID KEY GO TO END-FILE1. 030520 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 030540 ENTER MACRO IQGETD. 030560 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 030580 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 030600 GO TO RD1ISAM7S1. 030620 030640 RD2SEQ6S. 030660 IF INF2-FLAG = 5 GO TO NEXT-INSTR-UPX. 030680 IF INF2-FLAG = 0 PERFORM OPEN2-SEQ 030700 ELSE MOVE 3 TO INF2-FLAG. 030720 RD2SEQ6S1. 030740 READ INF2SD6 AT END ENTER MACRO IQSXB6 USING INF2-RECLEN 030760 INF2SD6-REC CONST1 GO TO END-FILE2. 030780 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 030800 ENTER MACRO IQGETD. 030820 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 030840 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 030860 GO TO RD2SEQ6S1. 030880 030900 RD2ISAM6S. 030920 IF INF2-FLAG = 5 GO TO NEXT-INSTR-UPX. 030940 IF INF2-FLAG = 0 030960 MOVE LOW-VALUES TO INF2ISAM6-SYMKEY 030980 PERFORM OPEN2-ISAM 031000 ELSE MOVE 3 TO INF2-FLAG. 031020 RD2ISAM6S1. 031040 READ INF2ISAM6 INVALID KEY ENTER MACRO IQSXB6 USING 031060 INF2-RECLEN INF2ISAM6-REC CONST1 GO TO END-FILE2. 031080 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 031100 ENTER MACRO IQGETD. 031120 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 031140 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 031160 GO TO RD2ISAM6S1. 031180 031200 RD2SEQ7S. 031220 IF INF2-FLAG = 5 GO TO NEXT-INSTR-UPX. 031240 IF INF2-FLAG = 0 PERFORM OPEN2-SEQ 031260 ELSE MOVE 3 TO INF2-FLAG. 031280 RD2SEQ7S1. 031300 READ INF2SD7 AT END ENTER MACRO IQSXB7 USING 031320 INF2-RECLEN INF2SD7-REC CONST1 GO TO END-FILE2. 031340 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 031360 ENTER MACRO IQGETD. 031380 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 031400 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 031420 GO TO RD2SEQ7S1. 031440 031460 RD2ISAM7S. 031480 IF INF2-FLAG = 5 GO TO NEXT-INSTR-UPX. 031500 IF INF2-FLAG = 0 031520 MOVE LOW-VALUES TO INF2ISAM7-SYMKEY 031540 PERFORM OPEN2-ISAM 031560 ELSE MOVE 3 TO INF2-FLAG. 031580 RD2ISAM7S1. 031600 READ INF2ISAM7 INVALID KEY ENTER MACRO IQSXB7 USING 031620 INF2-RECLEN INF2ISAM7-REC CONST1 GO TO END-FILE2. 031640 ENTER MACRO IQGETD. 031660 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 031680 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 031700 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 031720 GO TO RD2ISAM7S1. 031740 031760 RD3SEQ6S. 031780 IF INF3-FLAG = 5 GO TO NEXT-INSTR-UPX. 031800 IF INF3-FLAG = 0 PERFORM OPEN3-SEQ 031820 ELSE MOVE 3 TO INF3-FLAG. 031840 RD3SEQ6S1. 031860 READ INF3SD6 AT END ENTER MACRO IQSXB6 USING 031880 INF3-RECLEN INF3SD6-REC CONST1 GO TO END-FILE3. 031900 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 031920 ENTER MACRO IQGETD. 031940 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 031960 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 031980 GO TO RD3SEQ6S1. 032000 032020 RD3ISAM6S. 032040 IF INF3-FLAG = 5 GO TO NEXT-INSTR-UPX. 032060 IF INF3-FLAG = 0 032080 MOVE LOW-VALUES TO INF1ISAM6-SYMKEY 032100 PERFORM OPEN3-ISAM 032120 ELSE MOVE 3 TO INF3-FLAG. 032140 RD3ISAM6S1. 032160 READ INF3ISAM6 INVALID KEY ENTER MACRO IQSXB6 USING 032180 INF3-RECLEN INF3ISAM6-REC CONST1 GO TO END-FILE3. 032200 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 032220 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 032240 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 032260 GO TO RD3ISAM6S1. 032280 032300 RD3SEQ7S. 032320 IF INF3-FLAG = 5 GO TO NEXT-INSTR-UPX. 032340 IF INF3-FLAG = 0 PERFORM OPEN3-SEQ 032360 ELSE MOVE 3 TO INF3-FLAG. 032380 RD3SEQ7S1. 032400 READ INF3SD7 AT END ENTER MACRO IQSXB7 USING 032420 INF3-RECLEN INF3SD7-REC CONST1 GO TO END-FILE3. 032440 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 032460 ENTER MACRO IQGETD. 032480 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 032500 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 032520 GO TO RD3SEQ7S1. 032540 032560 RD3ISAM7S. 032580 IF INF3-FLAG = 0 GO TO NEXT-INSTR-UPX. 032600 IF INF3-FLAG = 0 032620 MOVE LOW-VALUES TO INF3ISAM7-SYMKEY 032640 PERFORM OPEN3-ISAM 032660 ELSE MOVE 3 TO INF3-FLAG. 032680 RD3ISAM7S1. 032700 READ INF3ISAM7 INVALID KEY ENTER MACRO IQSXB7 USING 032720 INF3-RECLEN INF3ISAM7-REC CONST1 GO TO END-FILE3. 032740 IF ELEM-INSTR = 0 GO TO NEXT-INSTR-UPX. 032760 ENTER MACRO IQGETD. 032780 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 032800 IF AHOLDER = ALT-AHOLDER GO TO NEXT-INSTR-UPX. 032820 GO TO RD3ISAM7S1. 032840 032860 END-FILE1. 032880 MOVE 5 TO INF1-FLAG. 032900 SET X TO EOF1-X. 032920 GO TO NEXT-INSTR. 032940 032960 END-FILE2. 032980 MOVE 5 TO INF2-FLAG. 033000 GO TO NEXT-INSTR-UPX. 033020 033040 END-FILE3. 033060 MOVE 5 TO INF3-FLAG. 033080 GO TO NEXT-INSTR-UPX. 033100 033120* *OPEN/CLOSE SUBROUTINES FOLLOW* 033140* *EACH IS ENTERED WITH FX POINTING TO CORRECT F-ENTRY*. 033160 033180 OPEN1-SEQ. 033200 MOVE 0 TO NEWGROUP-FLAG. 033220 MOVE ROUTER TO INF1-TYPE. 033240 SET INF1-FX TO FX. 033260 PERFORM LOCATE-INPUT-FILE. 033280 MOVE ELEM-F-RECLEN TO INF1-RECLEN. 033300 IF ELEM-F-TYPE = 26 OPEN INPUT INF1SD6 033320 ELSE OPEN INPUT INF1SD7. 033340* *RESTORE ELEM-D-ENTRY WIPED OUT BY ELEM-F-ENTRY ABOVE*. 033360 ENTER MACRO IQGETD. 033380 MOVE 2 TO INF1-FLAG. 033400 033420 033440 OPEN1-ISAM. 033460 MOVE 0 TO NEWGROUP-FLAG. 033480 MOVE ROUTER TO INF1-TYPE. 033500 SET INF1-FX TO FX. 033520 PERFORM LOCATE-INPUT-FILE. 033540 MOVE ELEM-F-RECLEN TO INF1-RECLEN. 033560 MOVE ELEM-F-KEYLEN TO KEYLEN1. 033580 MOVE ELEM-F-KEYLOC TO KEYLOC1. 033600 MOVE 2 TO INF1-FLAG. 033620 IF ELEM-F-TYPE = 26 033640 MOVE 1 TO CORE-DATA-MODE FILE-RECORDING-MODE 033650 IF ELEM-F-OPEN NOT = 'O' 033660 ENTER MACRO IQISAM USING ELEM-F-ID 033680 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 033700 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 033720 ELEM-F-KEYSIGN FILE-RECORDING-MODE 033740 OPEN INPUT INF1ISAM6 033760 ELSE ENTER MACRO IQISAM USING ELEM-F-ID 033762 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 033764 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 033766 ELEM-F-KEYSIGN FILE-RECORDING-MODE 033768 OPEN INPUT-OUTPUT INF1ISAM6. 033770 IF ELEM-F-TYPE = 27 033780 MOVE ELEM-F-ID TO INFXISAM7-ID 033800 MOVE 0 TO CORE-DATA-MODE FILE-RECORDING-MODE 033810 IF ELEM-F-OPEN NOT = 'O' 033820 ENTER MACRO IQISAM USING INFXISAM7-ID 033840 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 033860 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 033880 ELEM-F-KEYSIGN FILE-RECORDING-MODE 033900 OPEN INPUT INF1ISAM7 033902 ELSE ENTER MACRO IQISAM USING INFXISAM7-ID 033904 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 033906 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 033908 ELEM-F-KEYSIGN FILE-RECORDING-MODE 033910 OPEN INPUT-OUTPUT INF1ISAM7. 033920 ENTER MACRO IQGETD. 033940 033960 OPEN1-DBMS. 033980 MOVE 10 TO FIND-RSE. 034000 SET INF1-FX TO FX. 034040 PERFORM LOCATE-INPUT-FILE. 034060 MOVE ELEM-F-RECLEN TO INF1-RECLEN. 034080* MOVE ELEM-F-ORIGIN TO INF1SD6-REC-ORIGIN. 034100 IF ELEM-F-TYPE NOT = 28 GO TO OPENERR. 034120 MOVE ELEM-F-SUBSCHEMA TO SUBSCHEMA-NAME. 034140 MOVE ELEM-F-SCHEMA TO SCHEMA-NAME. 034160 MOVE 1 TO FIRST-NEXT-INDIC. 034180 MOVE 0 TO SET-AREA-INDIC. 034200 MOVE DBMS-PASSWORD TO PRIVACY-KEY. 034220 ENTER MACRO IQDBIO USING FIND-RSE SCHEMA-NAME 034240 FIRST-NEXT-INDIC SUBSCHEMA-NAME SET-AREA-INDIC 034260 DBMS-ERROR-FLAG INF1SD6-REC PRIVACY-KEY DBMS-STSBLK 034270 FIND-SUPPRESS 034280 SYSCOM CURRENT-RECORD-KEY AREA-NAME-IDENT. 034290 IF DBMS-ERROR-FLAG NOT EQUAL 0 034295 MOVE ERROR-STATUS TO ERROR-CODE 034297 GO TO ABORT-RUN. 034299 MOVE 2 TO INF1-FLAG. 034360 MOVE 5 TO INF1-TYPE. 034380 IF DBMS-ERROR-FLAG NOT = 0 034400 MOVE ERROR-STATUS TO ERROR-CODE 034420 GO TO ABORT-RUN. 034440 034441 SET DX TO MAX-DX. 034521 034522 OPEN2-SEQ. 034524 MOVE ROUTER TO INF2-TYPE. 034526 SET INF2-FX TO FX. 034528 PERFORM LOCATE-INPUT-FILE. 034540 MOVE ELEM-F-RECLEN TO INF2-RECLEN. 034560 IF ELEM-F-TYPE = 26 OPEN INPUT INF2SD6 034580 ELSE OPEN INPUT INF2SD7. 034600 ENTER MACRO IQGETD. 034620 MOVE 2 TO INF2-FLAG. 034640 034660 OPEN2-ISAM. 034680 MOVE ROUTER TO INF2-TYPE. 034700 SET INF2-FX TO FX. 034720 PERFORM LOCATE-INPUT-FILE. 034740 MOVE ELEM-F-RECLEN TO INF2-RECLEN. 034760 MOVE ELEM-F-KEYLEN TO KEYLEN2. 034780 MOVE ELEM-F-KEYLOC TO KEYLOC2. 034800 MOVE 2 TO INF2-FLAG. 034820 IF ELEM-F-TYPE = 26 034840 MOVE 1 TO CORE-DATA-MODE FILE-RECORDING-MODE 034850 IF ELEM-F-OPEN NOT = 'O' 034860 ENTER MACRO IQISAM USING ELEM-F-ID 034880 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 034900 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 034920 ELEM-F-KEYSIGN FILE-RECORDING-MODE 034940 OPEN INPUT INF2ISAM6 034960 ELSE ENTER MACRO IQISAM USING ELEM-F-ID 034962 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 034964 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 034966 ELEM-F-KEYSIGN FILE-RECORDING-MODE 034968 OPEN INPUT-OUTPUT INF1ISAM6. 034970 IF ELEM-F-TYPE = 27 034980 MOVE ELEM-F-ID TO INFXISAM7-ID 035000 MOVE 0 TO CORE-DATA-MODE FILE-RECORDING-MODE 035010 IF ELEM-F-OPEN NOT = 'O' 035020 ENTER MACRO IQISAM USING INFXISAM7-ID 035040 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035060 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035080 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035100 OPEN INPUT INF2ISAM7 035102 ELSE ENTER MACRO IQISAM USING INFXISAM7-ID 035104 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035106 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035108 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035110 OPEN INPUT-OUTPUT INF2ISAM7. 035120 ENTER MACRO IQGETD. 035140 035160 OPEN3-SEQ. 035180 MOVE ROUTER TO INF3-TYPE. 035200 SET INF3-FX TO FX. 035220 PERFORM LOCATE-INPUT-FILE. 035240 MOVE ELEM-F-RECLEN TO INF3-RECLEN. 035260 IF ELEM-F-TYPE = 26 OPEN INPUT INF3SD6 035280 ELSE OPEN INPUT INF3SD7. 035300 ENTER MACRO IQGETD. 035320 MOVE 2 TO INF3-FLAG. 035340 035360 OPEN3-ISAM. 035380 MOVE ROUTER TO INF3-TYPE. 035400 SET INF3-FX TO FX. 035420 PERFORM LOCATE-INPUT-FILE. 035440 MOVE ELEM-F-RECLEN TO INF3-RECLEN. 035460 MOVE ELEM-F-KEYLEN TO KEYLEN3. 035480 MOVE ELEM-F-KEYLOC TO KEYLOC3. 035500 MOVE 2 TO INF3-FLAG. 035520 IF ELEM-F-TYPE = 26 035540 MOVE 1 TO CORE-DATA-MODE FILE-RECORDING-MODE 035550 IF ELEM-F-OPEN NOT = 'O' 035560 ENTER MACRO IQISAM USING ELEM-F-ID 035580 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035600 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035620 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035640 OPEN INPUT INF3ISAM6 035660 ELSE ENTER MACRO IQISAM USING ELEM-F-ID 035662 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035664 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035666 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035668 OPEN INPUT-OUTPUT INF3ISAM6. 035670 IF ELEM-F-TYPE = 27 035680 MOVE ELEM-F-ID TO INFXISAM7-ID 035700 MOVE 0 TO CORE-DATA-MODE FILE-RECORDING-MODE 035710 IF ELEM-F-OPEN NOT = 'O' 035720 ENTER MACRO IQISAM USING INFXISAM7-ID 035740 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035760 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035780 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035800 OPEN INPUT INF3ISAM7 035802 ELSE ENTER MACRO IQISAM USING INFXISAM7-ID 035804 ELEM-F-BLKLEN ELEM-F-RECLEN ELEM-F-KEYTYPE 035806 ELEM-F-KEYLEN CORE-DATA-MODE ELEM-F-KEYLOC 035808 ELEM-F-KEYSIGN FILE-RECORDING-MODE 035810 OPEN INPUT-OUTPUT INF3ISAM7. 035820 ENTER MACRO IQGETD. 035840 035860 OPENERR. 035880 MOVE 05 TO ERROR-CODE. GO TO ABORT-RUN. 035882 035884* *SPECIAL SUBROUTINE TO LOCATE INPUT FILE AND COMPLAIN IF NOT* 035886 LOCATE-INPUT-FILE. 035888 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 035890 ENTER MACRO IQLOOK USING DEVICER ELEM-F-ID 035892 PROJ USER I. 035894 IF I NOT = -1 DISPLAY 035896 '?Cannot find input file ' ELEM-F-ID '; ending run.' 035898 GO TO ABORT-RUN1. 035900 035920 CLOSER1. 035940 IF INF1-FLAG = 0 OR INF1-FLAG = 6 GO TO CLOSER1-EXIT. 035960 SET FX TO INF1-FX. 035980 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 036000 MOVE 0 TO INF1-FLAG. 036020 IF ELEM-F-TYPE NOT = 28 GO TO CLOSER1A. 036040 MOVE 9 TO FIND-RSE. 036060 ENTER MACRO IQDBIO USING FIND-RSE SCHEMA-NAME 036080 FIRST-NEXT-INDIC SUBSCHEMA-NAME SET-AREA-INDIC 036100 DBMS-ERROR-FLAG INF1SD6-REC PRIVACY-KEY DBMS-STSBLK, 036110 FIND-SUPPRESS 036120 SYSCOM CURRENT-RECORD-KEY AREA-NAME-IDENT. 036140 IF DBMS-ERROR-FLAG NOT = 0 036160 MOVE ERROR-STATUS TO ERROR-CODE 036180 GO TO ABORT-RUN. 036200 GO TO CLOSER1-EXIT. 036220 036240 036260 CLOSER1A. 036280 IF ELEM-F-KEYLEN NOT = 0 GO TO CLOSER1-ISAM. 036300 IF ELEM-F-TYPE = 26 CLOSE INF1SD6 ELSE CLOSE INF1SD7. 036320 GO TO CLOSER1-EXIT. 036340 036360 CLOSER1-ISAM. 036380 IF ELEM-F-TYPE = 26 CLOSE INF1ISAM6 ELSE CLOSE INF1ISAM7. 036400 036420 CLOSER1-EXIT. 036440 EXIT. 036460 036480 CLOSER2. 036500 IF INF2-FLAG = 0 GO TO CLOSER2-EXIT. 036520 SET FX TO INF2-FX. 036540 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 036560 MOVE 0 TO INF2-FLAG. 036580 IF ELEM-F-KEYLEN NOT = 0 GO TO CLOSER2-ISAM. 036600 IF ELEM-F-TYPE = 26 CLOSE INF2SD6 ELSE CLOSE INF2SD7. 036620 GO TO CLOSER2-EXIT. 036640 036660 CLOSER2-ISAM. 036680 IF ELEM-F-TYPE = 26 CLOSE INF2ISAM6 ELSE CLOSE INF2ISAM7. 036700 036720 CLOSER2-EXIT. 036740 EXIT. 036760 036780 CLOSER3. 036800 IF INF3-FLAG = 0 GO TO CLOSER3-EXIT. 036820 SET FX TO INF3-FX. 036840 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 036860 MOVE 0 TO INF3-FLAG. 036880 IF ELEM-F-KEYLEN NOT = 0 GO TO CLOSER3-ISAM. 036900 IF ELEM-F-TYPE = 26 CLOSE INF3SD6 ELSE CLOSE INF3SD7. 036920 GO TO CLOSER3-EXIT. 036940 036960 CLOSER3-ISAM. 036980 IF ELEM-F-TYPE = 26 CLOSE INF3ISAM6 ELSE CLOSE INF3ISAM7. 037000 037020 CLOSER3-EXIT. 037040 EXIT. 037060 037080********************************************************** 037100* INSTRUCTION TO READ RANDOMLY 037120* FORMAT (X) = INSTRUCTION VALUE 6 037140* (X+1) = FX OF INPUT FILE F-ENTRY. 037160* (X+2) = X OF NEXT INSTRUCTION (1 PAST END OF LIST) 037180* (X+3) = READ TYPE; VALUES ARE: 037200* 1 = PRIMARY 6 BIT ISAM 037220* 2 = PRIMARY 7 BIT ISAM 037240* 3 = RESERVED FOR FUTURE USE 037260* 4 = RESERVED FOR FUTURE USE 037280* 5 = SECONDARY 6 BIT ISAM 037300* 6 = SECONDARY 7 BIT ISAM 037320* 7 = RESERVED FOR FUTURE USE 037340* 8 = RESERVED FOR FUTURE USE 037360* 9 = TERTIARY 6 BIT ISAM 037380* 10 = TERTIARY 7 BIT ISAM 037400* 11 = RESERVED FOR FUTURE USE 037420* 12 = RESERVED FOR FUTURE USE 037440* (X+4) = BEGINNING OF LIST OF DX ENTRIES POINTING 037460* TO KEY VALUE ENTRIES. END OF LIST 037480* IS SIGNIFIED BY A DX OF 0; NEXT X IS 037500* NEXT INSTRUCTION. 037520* 037540* SEE LAYOUT OF ELEM-K-ENTRY FOR FORMAT OF A KEY ENTRY. 037560* VALUE ASSIGNMENTS ARE: 037580* 037600* 1. IF A SINGLE KEY: STARTKEY IS SOUGHT VALUE. 037620* TYPEV IS 13. 037640* 037660* 2. IF A RANGE OF KEYS: STARTKEY IS BEGINNING VALUE. 037680* ENDKEY IS ENDING VALUE. 037700* TYPEV IS 14. 037720* 037740* 3. IF A RANGE OF KEYS GOING TO END-OF-FILE: 037760* STARTKEY IS BEGINNING VALUE. 037780* ENDKEY IS HIGH-VALUES 037800* TYPEV IS 14. 037820* NOTE: LOGIC BELOW WILL CHANGE VALUES IN KEY ENTRIES 037840* AS IT GOES; SEE COMMENTS IN SECTION BELOW. 037860* NOTE THAT OPENS ARE DONE HERE JUST BEFORE FIRST READ. 037880* NOTE THAT PARTIAL KEY READS ARE VALID ONLY FOR ALPHA ARGS. 037900********************************************************** 037920 037940 READRAN. 037960 MOVE 0 TO MISS-FLAG. 037980 ENTER MACRO IQGETI. 038000 SET FX TO ELEM-INSTR. 038020 SET X UP BY 1. 038040 ENTER MACRO IQGETI. 038060 MOVE ELEM-INSTR TO TRUEGOX. 038080 SET X UP BY 1. 038100 ENTER MACRO IQGETI. 038120 MOVE ELEM-INSTR TO ROUTER. 038140 038160 READRAN1. 038180* *GET FIRST/NEXT DX POINTER TO A KEY ENTRY*. 038200 SET X UP BY 1. 038220 ENTER MACRO IQGETI. 038240* *DX OF HIGH-VALUES SAYS 'READ FOR THIS ENTRY COMPLETED - 038260* * GO ON TO NEXT ENTRY'*. 038280 IF ELEM-INSTR = HIGH-VALUES GO TO READRAN1. 038300* *DX OF 0 SAYS 'END OF FILE - SET EOF FLAG FOR THIS FILE'*. 038320 IF ELEM-INSTR = 0 GO TO READRAN-ROUTER. 038340 SET DX TO ELEM-INSTR. 038360 ENTER MACRO IQGETD. 038380* *IF TYPEV IS LESS THAN 13, KEY IS A DATA ITEM*. 038400* *IF TYPEV IS 13, 14, 15, A KEY VALUE IS IN ELEM-K-STARTKEY*. 038420 IF ELEM-D-TYPEV = 13 OR 14 OR 15 038440 MOVE ELEM-K-STARTKEY TO AHOLDER-30 038460 MOVE 1 TO NHOLDER-TYPE 038480 MOVE -1 TO NHOLDER-SCALE 038500 ELSE 038520 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 038540 038560 READRAN-ROUTER. 038580 MOVE SPACES TO TEMPKEYV. 038590 IF NO-SCAN-ITEMS NEXT SENTENCE 038595 ELSE PERFORM RESET-SCAN-ITEMS THRU RESET-SCAN-EXIT. 038600 GO TO RD1ISAM RD1ISAM READRAN-ERR READRAN-ERR 038620 RD2ISAM RD2ISAM READRAN-ERR READRAN-ERR 038640 RD3ISAM RD3ISAM DEPENDING ON ROUTER. 038660 038680 READRAN-ERR. 038700 MOVE 06 TO ERROR-CODE. GO TO ABORT-RUN. 038720 038740 RD1ISAM. 038760 MOVE 0 TO NEWGROUP-FLAG. 038780 IF INF1-FLAG = 5 GO TO RD1ISAM-EOF. 038800 IF INF1-FLAG = 0 PERFORM OPEN1-ISAM 038820 ELSE MOVE 3 TO INF1-FLAG. 038840 IF ELEM-INSTR = 0 GO TO RD1ISAM-EOF. 038860* *ADJUST KEY LEFT TO ALPHA IF IT IS NUMERIC* 038880 IF NHOLDER-TYPE NOT = 1 038900 SUBTRACT KEYLEN1 FROM MAX-NITEM-LEN-UP1 GIVING I 038920 ENTER MACRO IQSX66 USING KEYLEN1 038940 NHOLDER I AHOLDER CONST1. 038960 IF ROUTER = 2 GO TO RD1ISAM7R. 038980 MOVE AHOLDER-30 TO INF1ISAM6-SYMKEY. 039000 RD1ISAM6R1. 039020 READ INF1ISAM6 INVALID KEY 039040 GO TO RD1ISAM6R2. 039060 ENTER MACRO IQSX66 USING KEYLEN1 INF1ISAM6-REC 039080 KEYLOC1 TEMPKEYV CONST1. 039100 GO TO READGOOD1. 039120 RD1ISAM6R2. 039140* *IF INVALID KEY, MAY HAVE PARTIAL KEY - 039160* * READ NEXT SEQUENTIAL RECORD*. 039180 IF ( ELEM-D-TYPEV = 14 OR 15 ) 039200 IF INF1ISAM6-SYMKEY = LOW-VALUES GO TO RD1ISAM-EOF 039220 ELSE MOVE LOW-VALUES TO INF1ISAM6-SYMKEY 039240 GO TO RD1ISAM6R1. 039260 MOVE LOW-VALUES TO INF1ISAM6-SYMKEY. 039280 READ INF1ISAM6 INVALID KEY 039300 GO TO RD1ISAM-EOF. 039320 ENTER MACRO IQSX66 USING KEYLEN1 INF1ISAM6-REC 039340 KEYLOC1 TEMPKEYV CONST1. 039360 GO TO READGOOD2. 039380 039400 RD1ISAM7R. 039420 IF AHOLDER-30 = LOW-VALUES 039440 MOVE LOW-VALUES TO INF1ISAM7-SYMKEY 039460 ELSE MOVE AHOLDER-30 TO INF1ISAM7-SYMKEY. 039480 RD1ISAM7R1. 039500 READ INF1ISAM7 INVALID KEY 039520 GO TO RD1ISAM7R2. 039540 ENTER MACRO IQSX76 USING KEYLEN1 INF1ISAM7-REC 039560 KEYLOC1 TEMPKEYV CONST1. 039580 GO TO READGOOD1. 039600 RD1ISAM7R2. 039620 IF ( ELEM-D-TYPEV = 14 OR 15 ) 039640 IF INF1ISAM7-SYMKEY = LOW-VALUES GO TO RD1ISAM-EOF 039660 ELSE MOVE LOW-VALUES TO INF1ISAM7-SYMKEY 039680 GO TO RD1ISAM7R1. 039700 MOVE LOW-VALUES TO INF1ISAM7-SYMKEY. 039720 READ INF1ISAM7 INVALID KEY 039740 GO TO RD1ISAM-EOF. 039760 ENTER MACRO IQSX76 USING KEYLEN1 INF1ISAM7-REC 039780 KEYLOC1 TEMPKEYV CONST1. 039800 GO TO READGOOD2. 039820 039840 039860 RD1ISAM-EOF. 039880 IF ELEM-INSTR NOT = 0 IF ( ELEM-D-TYPEV = 13 OR 14 OR 15 ) 039900 MOVE HIGH-VALUES TO ELEM-INSTR ENTER MACRO IQPUTI 039920 MOVE 1 TO MISS-FLAG GO TO READRAN1. 039940 MOVE 5 TO INF1-FLAG. 039960 SET X TO EOF1-X. 039980 GO TO NEXT-INSTR. 040000 040020 RD2ISAM. 040040 IF INF2-FLAG = 0 PERFORM OPEN2-ISAM 040060 ELSE MOVE 3 TO INF2-FLAG. 040080 IF ELEM-INSTR = 0 GO TO RD2ISAM-EOF. 040100 IF NHOLDER-TYPE NOT = 1 040120 SUBTRACT KEYLEN2 FROM MAX-NITEM-LEN-UP1 GIVING I 040140 ENTER MACRO IQSX66 USING KEYLEN2 040160 NHOLDER I AHOLDER CONST1. 040180 IF ROUTER = 6 GO TO RD2ISAM7R. 040200 MOVE AHOLDER-30 TO INF2ISAM6-SYMKEY 040220 RD2ISAM6R1. 040240 READ INF2ISAM6 INVALID KEY 040260 GO TO RD2ISAM6R2. 040280 ENTER MACRO IQSX66 USING KEYLEN2 INF2ISAM6-REC 040300 KEYLOC2 TEMPKEYV CONST1. 040320 GO TO READGOOD1. 040340 RD2ISAM6R2. 040360 IF ( ELEM-D-TYPEV = 14 OR 15 ) 040380 IF INF2ISAM6-SYMKEY = LOW-VALUES GO TO RD2ISAM-EOF 040400 ELSE MOVE LOW-VALUES TO INF2ISAM6-SYMKEY 040420 GO TO RD2ISAM6R1. 040440 MOVE LOW-VALUES TO INF2ISAM6-SYMKEY. 040460 READ INF2ISAM6 INVALID KEY 040480 GO TO RD2ISAM-EOF. 040500 ENTER MACRO IQSX66 USING KEYLEN2 INF2ISAM6-REC 040520 KEYLOC2 TEMPKEYV CONST1. 040540 GO TO READGOOD2. 040560 040580 RD2ISAM7R. 040600 IF AHOLDER-30 = LOW-VALUES 040620 MOVE LOW-VALUES TO INF2ISAM7-SYMKEY 040640 ELSE MOVE AHOLDER-30 TO INF2ISAM7-SYMKEY. 040660 RD2ISAM7R1. 040680 READ INF2ISAM7 INVALID KEY 040700 GO TO RD2ISAM7R2. 040720 ENTER MACRO IQSX76 USING KEYLEN2 INF2ISAM7-REC 040740 KEYLOC2 TEMPKEYV CONST1. 040760 GO TO READGOOD1. 040780 RD2ISAM7R2. 040800 IF ( ELEM-D-TYPEV = 14 OR 15 ) 040820 IF INF2ISAM7-SYMKEY = LOW-VALUES GO TO RD2ISAM-EOF 040840 ELSE MOVE LOW-VALUES TO INF2ISAM7-SYMKEY 040860 GO TO RD2ISAM7R1. 040880 MOVE LOW-VALUES TO INF2ISAM7-SYMKEY, 040900 READ INF2ISAM7 INVALID KEY 040920 GO TO RD2ISAM-EOF. 040940 ENTER MACRO IQSX76 USING KEYLEN2 INF2ISAM7-REC 040960 KEYLOC2 TEMPKEYV CONST1. 040980 GO TO READGOOD2. 041000 041020 RD2ISAM-EOF. 041040 MOVE 5 TO INF2-FLAG. 041060 GO TO READRAN-ENTRYDONE. 041080 041100 RD3ISAM. 041120 IF INF3-FLAG = 0 PERFORM OPEN3-ISAM 041140 ELSE MOVE 3 TO INF3-FLAG. 041160 IF ELEM-INSTR = 0 GO TO RD3ISAM-EOF. 041180 IF NHOLDER-TYPE NOT = 1 041200 SUBTRACT KEYLEN3 FROM MAX-NITEM-LEN-UP1 GIVING I 041220 ENTER MACRO IQSX66 USING KEYLEN3 041240 NHOLDER I AHOLDER CONST1. 041260 IF ROUTER = 10 GO TO RD3ISAM7R. 041280 MOVE AHOLDER-30 TO INF3ISAM6-SYMKEY. 041300 RD3ISAM6R1. 041320 READ INF3ISAM6 INVALID KEY 041340 GO TO RD3ISAM6R2. 041360 ENTER MACRO IQSX66 USING KEYLEN3 INF3ISAM6-REC 041380 KEYLOC3 TEMPKEYV CONST1. 041400 GO TO READGOOD1. 041420 RD3ISAM6R2. 041440 IF ( ELEM-D-TYPEV = 14 OR 15 ) 041460 IF INF3ISAM6-SYMKEY = LOW-VALUES GO TO RD3ISAM-EOF 041480 ELSE MOVE LOW-VALUES TO INF3ISAM6-SYMKEY 041500 GO TO RD3ISAM6R1. 041520 MOVE LOW-VALUES TO INF3ISAM6-SYMKEY. 041540 READ INF3ISAM6 INVALID KEY 041560 GO TO RD3ISAM-EOF. 041580 ENTER MACRO IQSX66 USING KEYLEN3 INF3ISAM6-REC 041600 KEYLOC3 TEMPKEYV CONST1. 041620 GO TO READGOOD2. 041640 041660 RD3ISAM7R. 041680 IF AHOLDER-30 = LOW-VALUES 041700 MOVE LOW-VALUES TO INF3ISAM7-SYMKEY 041720 ELSE MOVE AHOLDER-30 TO INF3ISAM7-SYMKEY. 041740 RD3ISAM7R1. 041760 READ INF3ISAM7 INVALID KEY 041780 GO TO RD3ISAM7R2. 041800 ENTER MACRO IQSX76 USING KEYLEN3 INF3ISAM7-REC 041820 KEYLOC3 TEMPKEYV CONST1. 041840 GO TO READGOOD1. 041860 RD3ISAM7R2. 041880 IF ( ELEM-D-TYPEV = 14 OR 15 ) 041900 IF INF3ISAM7-SYMKEY = LOW-VALUES GO TO RD3ISAM-EOF 041920 ELSE MOVE LOW-VALUES TO INF3ISAM7-SYMKEY 041940 GO TO RD3ISAM7R1. 041960 MOVE LOW-VALUES TO INF3ISAM7-SYMKEY. 041980 READ INF3ISAM7 INVALID KEY 042000 GO TO RD3ISAM-EOF. 042020 ENTER MACRO IQSX76 USING KEYLEN3 INF3ISAM7-REC 042040 KEYLOC3 TEMPKEYV CONST1. 042060 GO TO READGOOD2. 042080 042100 042120 READGOOD1. 042140* *HERE IF HIT VALID READ FIRST TIME THRU - IF HAVE 042160* * EXACT KEY (13) OR ITEM, GOT TRUE HIT; 042180* * IF RANGE THRU KEY (14) OR RANGE TO KEY (15) 042200* * MAY BE READING IN RANGE*. 042220 IF ELEM-D-TYPEV = 13 MOVE HIGH-VALUES TO ELEM-INSTR 042240 ENTER MACRO IQPUTI 042260 SET X TO TRUEGOX GO TO NEXT-INSTR. 042280 IF ELEM-D-TYPEV NOT = 14 AND NOT = 15 042300 SET X TO TRUEGOX GO TO NEXT-INSTR. 042320* *SET UP FOR SEQUENTIAL READ IN RANGE NEXT TIME* 042340 MOVE LOW-VALUES TO ELEM-K-STARTKEY. 042360 ENTER MACRO IQPUTD. 042380* *NOW LOOK TO SEE IF RAN OUT OF RANGE* 042400 IF ELEM-D-TYPEV = 15 042420 IF TEMPKEYV LESS THAN ELEM-K-ENDKEY 042440 SET X TO TRUEGOX GO TO NEXT-INSTR. 042460 IF ELEM-D-TYPEV = 14 042480 IF TEMPKEYV NOT GREATER THAN ELEM-K-ENDKEY 042500 SET X TO TRUEGOX GO TO NEXT-INSTR. 042520* *DID RUN OUT OF RANGE; MOVE DOWN TO NEXT ENTRY IN STACK* 042540 MOVE HIGH-VALUES TO ELEM-INSTR. 042560 ENTER MACRO IQPUTI. 042580 GO TO READRAN1. 042600 042620 READGOOD2. 042640* *ONLY GET HERE ON (SINGLE KEY OR ITEM) & IF DID NOT HIT 042660* * EXACT VALUE & ARE LOOKING AT NEXT SEQUENTIAL RECORD*. 042680* *ONLY PERMIT PARTIAL KEY THRU IF (A) ALPHA 042700* * AND (B) EXACT MATCH ON # OF CHARACTERS FURNISHED*. 042720* *IF SO, BLANK OUT EXTRA CHARACTERS ON RIGHT OF KEY* 042740 IF NHOLDER-TYPE = 1 042760 SUBTRACT ELEM-D-NCHAR FROM MAX-KEYLEN GIVING I 042780 ADD 1 TO ELEM-D-NCHAR 042800 IF I GREATER THAN 0 042820 ENTER MACRO IQSXB6 USING I TEMPKEYV ELEM-D-NCHAR. 042840 IF TEMPKEYV = AHOLDER-30 IF ELEM-D-TYPEV = 13 042860 MOVE HIGH-VALUES TO ELEM-INSTR ENTER MACRO IQPUTI 042880 SET X TO TRUEGOX GO TO NEXT-INSTR 042900 ELSE SET X TO TRUEGOX GO TO NEXT-INSTR. 042920 IF ELEM-D-TYPEV = 13 MOVE HIGH-VALUES TO ELEM-INSTR 042940 ENTER MACRO IQPUTI. 042960 MOVE 1 TO MISS-FLAG. 042980 SET X TO TRUEGOX. 043000* *ON MISSED KEY, BLANK OUT APPROPRIATE BUFFER* 043020 GO TO READGOOD2A READGOOD2B READGOOD2X READGOOD2X 043040 READGOOD2E READGOOD2F READGOOD2X READGOOD2X 043060 READGOOD2I READGOOD2J DEPENDING ON ROUTER. 043080 READGOOD2X. 043100 GO TO NEXT-INSTR. 043120 READGOOD2A. 043140 ENTER MACRO IQSXB6 USING INF1-RECLEN INF1ISAM6-REC CONST1. 043160 GO TO NEXT-INSTR. 043180 READGOOD2B. 043200 ENTER MACRO IQSXB7 USING INF1-RECLEN INF1ISAM7-REC CONST1. 043220 GO TO NEXT-INSTR. 043240 READGOOD2E. 043260 ENTER MACRO IQSXB6 USING INF2-RECLEN INF2ISAM6-REC CONST1. 043280 GO TO NEXT-INSTR. 043300 READGOOD2F. 043320 ENTER MACRO IQSXB7 USING INF2-RECLEN INF2ISAM7-REC CONST1. 043340 GO TO NEXT-INSTR. 043360 READGOOD2I. 043380 ENTER MACRO IQSXB6 USING INF3-RECLEN INF3ISAM6-REC CONST1. 043400 GO TO NEXT-INSTR. 043420 READGOOD2J. 043440 ENTER MACRO IQSXB7 USING INF3-RECLEN INF3ISAM7-REC CONST1. 043460 GO TO NEXT-INSTR. 043480 043500 RD3ISAM-EOF. 043520 MOVE 5 TO INF3-FLAG. 043540 043560 READRAN-ENTRYDONE. 043580 IF ELEM-INSTR NOT = 0 043600 IF ( ELEM-D-TYPEV = 13 OR 14 OR 15 ) 043620 MOVE HIGH-VALUES TO ELEM-INSTR 043640 ENTER MACRO IQPUTI. 043660 MOVE 1 TO MISS-FLAG. 043680 043700 SET X TO TRUEGOX. 043720 GO TO NEXT-INSTR. 043740 043760****************************************************** 043780* READ DATA BASE INSTRUCTION. 043800* FORMAT: (X) = INSTRUCTION VALUE 7. 043820* (X+1) = FX OF INPUT DATA BASE FILE F-ENTRY. 043840* (X+2) = RSE-NUMBER (1-5 FOR DBMS V5) 043860* (X+3) = PLACEMENT-NO: OWNER = -11 043880* FIRST = -12 043900* LAST = -13 043920* PRIOR = -14 043940* NEXT = -15 043941* DUPLICATE = -16 043942* (NOT USED) = 0 043960* (X+4) = DX OF RECORD NAME ENTRY (RSE 1,3,5) 043961* DX OF SET-NAME-1, OR 0 (RSE 2) 043962* 0 (RSE 4) 043963* 043980* (X+5) = DX OF ITEM-NAME (RSE 1) 043981* DX OF SET-NAME-2 OR AREA-NAME OR RECORD-NAME (RSE 2) 043982* OR KEYWORD RUN-UNIT (= -23) 043987* DX OF SET OR AREA NAME (RSE 3) 043988* DX OF SET NAME (RSE 4) 043989* 0 (RSE 5) 043990* 044000* (X+6) = SUPPRESS OPTION: NONE = 0 044020* ALL = -17 044040* AREA = -18 044060* RECORD = -19 044080* SET = -20 044100* (X+7) = ZERO (END OF INSTRUCTION) 044120****************************************************** 044140 044160 READDBMS. 044180 ENTER MACRO IQGETI. 044200 SET FX TO ELEM-INSTR. 044220 SET X UP BY 1. 044240 IF INF1-FLAG = 0 PERFORM OPEN1-DBMS 044260 MOVE 2 TO INF1-FLAG 044280 ELSE MOVE 3 TO INF1-FLAG. 044300 ENTER MACRO IQGETI. 044320 MOVE ELEM-INSTR TO FIND-RSE. 044340 SET X UP BY 1. 044360 ENTER MACRO IQGETI. 044380 MOVE ELEM-INSTR TO FIRST-NEXT-INDIC. 044400 SET X UP BY 1. 044420 ENTER MACRO IQGETI. 044440 SET DX TO ELEM-INSTR. 044450 IF DX > 0 044460 ENTER MACRO IQGETD 044480 MOVE ELEM-B-NAME TO RECORD-NAME 044485 ELSE MOVE SPACES TO RECORD-NAME. 044500 SET X UP BY 1. 044520 ENTER MACRO IQGETI. 044540 SET DX TO ELEM-INSTR. 044545 IF DX < 0 044546 MOVE SPACES TO AREA-NAME 044547 MOVE 0 TO SET-AREA-INDIC. 044550 IF DX > 0 044560 ENTER MACRO IQGETD. 044580 IF FIND-RSE NOT = 1 AND DX > 0 044584 MOVE ELEM-B-NAME TO AREA-NAME 044588 MOVE ELEM-B-AREA-SET TO SET-AREA-INDIC 044592 GO TO FINDDBMS1. 044595 IF FIND-RSE = 1 044596 PERFORM GETB-VALUE THRU GET-VALUE-EXIT 044600 IF ELEM-D-SCALE NOT = 0 044604 SET PTX TO ELEM-D-SCALE 044608 DIVIDE 10EX (PTX) INTO BHOLDER GIVING I 044612 ELSE MOVE BHOLDER TO I. 044616 FINDDBMS1. 044660 SET X UP BY 1. 044680 ENTER MACRO IQGETI. 044700 MOVE ELEM-INSTR TO FIND-SUPPRESS. 044720 MOVE 0 TO FIND-ERROR-CODE FIND-ERROR-FLAG. 044740* *NOW ACTUALLY READ DATA BASE* 044760 MOVE 0 TO DBMS-ERROR-FLAG. 044780 IF FIND-RSE = 1 044800 ENTER MACRO IQDBIO USING FIND-RSE RECORD-NAME 044820 I AREA-NAME SET-AREA-INDIC 044840 DBMS-ERROR-FLAG INF1SD6-REC PRIVACY-KEY DBMS-STSBLK 044850 FIND-SUPPRESS 044860 SYSCOM CURRENT-RECORD-KEY AREA-NAME-IDENT 044880 ELSE 044900 ENTER MACRO IQDBIO USING FIND-RSE RECORD-NAME 044920 FIRST-NEXT-INDIC AREA-NAME SET-AREA-INDIC 044940 DBMS-ERROR-FLAG INF1SD6-REC PRIVACY-KEY DBMS-STSBLK 044950 FIND-SUPPRESS 044960 SYSCOM CURRENT-RECORD-KEY AREA-NAME-IDENT. 044980 IF DBMS-ERROR-FLAG NOT = 0 045000 MOVE ERROR-STATUS TO ERROR-CODE 045020 GO TO ABORT-RUN. 045040 GO TO NEXT-INSTR-UPX. 045060 045062***************************************************** 045064* REWRITE INSTRUCTION 045066* FORMAT: 045068* (X) = INSTRUCTION VALUE 87 045070* (X+1) = FX OF REWRITE FILE F-ENTRY 045072* (X+2) = REWRITE FILE TYPE, VALUES ARE: 045074* 1 = REWRITE PRIMARY 6 BIT 045076* 2 = REWRITE PRIMARY ASCII 045078* 3 = RESERVED FOR FUTURE USE PRIMARY EBCDIC) 045080* 4 = REWRITE SECONDARY 6 BIT 045082* 5 = REWRITE SECONDARY ASCII 045084* 6 = RESERVED FOR FUTURE USE (SECONDARY EBCDIC) 045086* 7 = REWRITE TERTIARY 6 BIT 045088* 8 = REWRITE TERTIARY ASCII 045090* 9 = RESERVED FOR FUTURE USE (TERTIARY EBCDIC) 045092************************************************************ 045094 REWRITE-IT. 045096 ENTER MACRO IQGETI. 045098 SET FX TO ELEM-INSTR. 045100 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 045102 SET X UP BY 1. 045104 ENTER MACRO IQGETI. 045106 MOVE ELEM-INSTR TO ROUTER. 045110 GO TO REWRITE1-6 REWRITE1-7 INSTR-ERR 045112 REWRITE2-6 REWRITE2-7 INSTR-ERR 045114 REWRITE3-6 REWRITE3-7 INSTR-ERR 045116 DEPENDING ON ROUTER. 045118 GO TO INSTR-ERR. 045120 045122 REWRITE1-6. 045124 ENTER MACRO IQSX66 USING CONST30 045122 INF1ISAM6-REC ELEM-F-KEYLOC INF1ISAM6-SYMKEY CONST1. 045123 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045124 REWRITE INF1ISAM6-REC INVALID KEY GO TO REWRITE-ERR. 045126 GO TO NEXT-INSTR-UPX. 045128 REWRITE1-7. 045128 ENTER MACRO IQSX77 USING CONST30 045128 INF1ISAM7-REC ELEM-F-KEYLOC INF1ISAM7-SYMKEY CONST1. 045130 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045132 REWRITE INF1ISAM7-REC INVALID KEY GO TO REWRITE-ERR. 045133 GO TO NEXT-INSTR-UPX. 045134 REWRITE2-6. 045134 ENTER MACRO IQSX66 USING CONST30 045134 INF2ISAM6-REC ELEM-F-KEYLOC INF2ISAM6-SYMKEY CONST1. 045136 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045138 REWRITE INF2ISAM6-REC INVALID KEY GO TO REWRITE-ERR. 045140 GO TO NEXT-INSTR-UPX. 045142 REWRITE2-7. 045142 ENTER MACRO IQSX77 USING CONST30 045142 INF2ISAM7-REC ELEM-F-KEYLOC INF2ISAM7-SYMKEY CONST1. 045144 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045146 REWRITE INF2ISAM7-REC INVALID KEY GO TO REWRITE-ERR. 045148 GO TO NEXT-INSTR-UPX. 045150 REWRITE3-6. 045150 ENTER MACRO IQSX66 USING CONST30 045150 INF3ISAM6-REC ELEM-F-KEYLOC INF3ISAM6-SYMKEY CONST1. 045152 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045154 REWRITE INF3ISAM6-REC INVALID KEY GO TO REWRITE-ERR. 045156 GO TO NEXT-INSTR-UPX. 045158 REWRITE3-7. 045158 ENTER MACRO IQSX77 USING CONST30 045158 INF3ISAM7-REC ELEM-F-KEYLOC INF3ISAM7-SYMKEY CONST1. 045160 ENTER MACRO IQWRTI USING ELEM-F-RECLEN. 045162 REWRITE INF3ISAM7-REC INVALID KEY GO TO REWRITE-ERR. 045164 GO TO NEXT-INSTR-UPX. 045166 045168 REWRITE-ERR. 045170 DISPLAY '%REWRITE error symbolic key ' 045172 UPON CONSOLE. 045174 045176********************************************************** 045178* COPY INSTRUCTION 045180* FORMAT: 045182* (X) = INSTRUCTION VALUE 8. 045200* (X+1) = FX OF COPY FILE F-ENTRY. 045220* (X+2) = COPY TYPE; VALUES ARE: 045240* 1 = COPY PRIMARY 6 BIT. 045260* 2 = COPY PRIMARY 7 BIT (ASCII). 045280* 3 = RESERVED FOR FUTURE USE. 045300* 4 = COPY SECONDARY 6 BIT. 045320* 5 = COPY SECONDARY 7 BIT (ASCII). 045340* 6 = RESERVED FOR FUTURE USE. 045360* 7 = COPY TERTIARY 6 BIT. 045380* 8 = COPY TERTIARY 7 BIT (ASCII). 045400* 9 = RESERVED FOR FUTURE USE. 045420* 045440* THERE MAY BE MULTIPLE COPY STATEMENTS IN A QUERY, BUT 045460* ONLY ONE COPY MAY BE USED IN EACH STAGE*. 045480* 045500* NOTE THAT COPY FILE IS OPENED JUST BEFORE FIRST WRITE. 045520********************************************************** 045540 045560 COPIER. 045570* *IF COPY FILE IS NOT OPEN, OPEN IT. 045580 IF COPYFILE-FLAG NOT = 0 GO TO COPIER1. 045600 ENTER MACRO IQGETI. 045620 SET FX TO ELEM-INSTR. 045640 SET COPY-FX TO FX. 045650* *BRING IN F-ENTRY GOVERNING COPY FILE. 045660 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY. 045680 MOVE ELEM-F-RECLEN TO COPY-RECLEN. 045700 MOVE 2 TO COPYFILE-FLAG. 045702* *ADJUST COPY F-ENTRY TO MATCH ORIGINAL FILE BEING COPIED; 045704* * THIS LETS US PUT OUT AN ASCII FILE EVEN THOUGH IT 045706* * BECAME SIXBIT DURING SORTING. 045706 SET X UP BY 1. 045708 ENTER MACRO IQGETI. 045709 MOVE ELEM-INSTR TO ROUTER. 045710* *CHECK ROUTER TO SEE WHAT FILE WE ARE COPYING. 045712 IF ELEM-INSTR LESS THAN 4 SET FX TO INF1-FX 045716 ELSE IF ELEM-INSTR LESS THAN 7 SET FX TO INF2-FX 045720 ELSE SET FX TO INF3-FX. 045721* *REMOVE THIS LOGIC TO CONVERT SORTED FILES, AS THEY ARE MAINTAINED IN ASCII NOW 045722* MOVE F-TYPE (FX) TO INPUT-TO-COPY-FTYPE. 045736* *MAKE SURE 6-BIT RECORD LENGTH IS MULTIPLE OF 6* 045740 IF ELEM-F-TYPE = 26 045760 SUBTRACT 1 FROM COPY-RECLEN GIVING WORKX 045780 DIVIDE CONST6 INTO WORKX GIVING WORKX 045800 ADD 1 TO WORKX 045820 MULTIPLY WORKX BY CONST6 GIVING COPY-RECLEN 045840 OPEN OUTPUT OUTFSD6 045860 ELSE OPEN OUTPUT OUTFSD7. 045864 GO TO COPIER2. 045864 045868 COPIER1. 045880 SET X UP BY 1. 045900 ENTER MACRO IQGETI. MOVE ELEM-INSTR TO ROUTER. 045910 COPIER2. 045920 GO TO COPY1SEQ6 COPY1SEQ7 INSTR-ERR 045940 COPY2SEQ6 COPY2SEQ7 INSTR-ERR 045960 COPY3SEQ6 COPY3SEQ7 DEPENDING ON ROUTER. 045980 MOVE 07 TO ERROR-CODE. GO TO ABORT-RUN. 046000 046020 COPY1SEQ6. 046040 ENTER MACRO IQSX66 USING COPY-RECLEN 046060 INF1SD6-REC CONST1 OUTFSD6-REC CONST1. 046080 ENTER MACRO IQWRTS USING COPY-RECLEN. 046100 WRITE OUTFSD6-REC. 046120 GO TO NEXT-INSTR-UPX. 046140 046160 COPY1SEQ7. 046162* *IF SORTED, AND ORIGINAL FILE WAS ASCII, TRANSFORM BACK* 046164* IF INPUT-TO-COPY-FTYPE = 26 046166* ENTER MACRO IQSX67 USING COPY-RECLEN 046168* INF1SD6-REC CONST1 OUTFSD7-REC CONST1 ELSE 046180 ENTER MACRO IQSX77 USING COPY-RECLEN 046200 INF1SD7-REC CONST1 OUTFSD7-REC CONST1. 046220 ENTER MACRO IQWRTS USING COPY-RECLEN. 046240 WRITE OUTFSD7-REC. 046260 GO TO NEXT-INSTR-UPX. 046280 046300 COPY2SEQ6. 046320 ENTER MACRO IQSX66 USING COPY-RECLEN 046340 INF2SD6-REC CONST1 OUTFSD6-REC CONST1. 046360 ENTER MACRO IQWRTS USING COPY-RECLEN. 046380 WRITE OUTFSD6-REC. 046400 GO TO NEXT-INSTR-UPX. 046420 046440 COPY2SEQ7. 046442* *IF SORTED, AND ORIGINAL FILE WAS ASCII, TRANSFORM BACK* 046444* IF INPUT-TO-COPY-FTYPE = 26 046446* ENTER MACRO IQSX67 USING COPY-RECLEN 046448* INF2SD6-REC CONST1 OUTFSD7-REC CONST1 ELSE 046460 ENTER MACRO IQSX77 USING COPY-RECLEN 046480 INF2SD7-REC CONST1 OUTFSD7-REC CONST1. 046500 ENTER MACRO IQWRTS USING COPY-RECLEN. 046520 WRITE OUTFSD7-REC. 046540 GO TO NEXT-INSTR-UPX. 046560 046580 COPY3SEQ6. 046600 ENTER MACRO IQSX66 USING COPY-RECLEN 046620 INF3SD6-REC CONST1 OUTFSD6-REC CONST1. 046640 ENTER MACRO IQWRTS USING COPY-RECLEN. 046660 WRITE OUTFSD6-REC. 046680 GO TO NEXT-INSTR-UPX. 046700 046720 COPY3SEQ7. 046722* *IF SORTED, AND ORIGINAL FILE WAS ASCII, TRANSFORM BACK* 046724* IF INPUT-TO-COPY-FTYPE = 26 046724* ENTER MACRO IQSX67 USING COPY-RECLEN 046728* INF3SD6-REC CONST1 OUTFSD7-REC CONST1 ELSE 046740 ENTER MACRO IQSX77 USING COPY-RECLEN 046760 INF3SD7-REC CONST1 OUTFSD7-REC CONST1. 046780 ENTER MACRO IQWRTS USING COPY-RECLEN. 046800 WRITE OUTFSD7-REC. 046820 GO TO NEXT-INSTR-UPX. 046840 046860********************************************************** 046880* CREATE INSTRUCTION. 046900* FORMAT: 046920* (X) = INSTRUCTION VALUE 9. 046940* (X+1) = FX OF CREATE FILE F-ENTRY. 046960* (X+2) = CREATE TYPE; VALUES ARE: 046980* 1 = 6 BIT. 047000* 2 = 7 BIT (ASCII). 047020* 3 = RESERVED FOR FUTURE USE. 047040* (X+3) = START OF DX LIST. END OF LIST IS MARKED BY 0. 047060* IF A DX IS NEGATIVE, ITS ABSOLUTE MAGNITUDE 047080* IS A SPACING (FILLER) INCREMENT. 047100* 047120* NOTE THAT NUMERIC QUANTITIES ARE WRITTEN OUT NUMERIC, 047140* NOT BINARY. 047160* 047180* NOTE THAT CREATE FILE IS OPENED JUST BEFORE FIRST WRITE. 047200* 047220* NOTE: MULTIPLE CREATE STATEMENTS MAY BE USED IN 047240* A QUERY, BUT ONLY ONE CREATE MAY BE USED PER STAGE. 047260* 047280* NOTE: CUSTOM MOVES INSTEAD OF USING GETN-VALUE WOULD BE 047300* FASTER BUT LATTER USED HERE FOR REDUCING CORE. 047320********************************************************** 047340 047360 CREATER. 047380 IF CREATEFILE-FLAG = 0 047400 ENTER MACRO IQGETI 047420 SET FX TO ELEM-INSTR 047440 MOVE F-ENTRY (FX) TO ELEM-F-ENTRY 047460 SET CREATE-FX TO FX 047480 MOVE 2 TO CREATEFILE-FLAG 047500 MOVE ELEM-F-RECLEN TO CREATE-RECLEN 047520* *MAKE SURE 6-BIT RECORD LENGTH IS MULTIPLE OF 6*. 047540 IF ELEM-F-TYPE = 26 047560 SUBTRACT 1 FROM CREATE-RECLEN GIVING WORKX 047580 DIVIDE CONST6 INTO WORKX GIVING WORKX 047600 ADD 1 TO WORKX 047620 MULTIPLY WORKX BY CONST6 GIVING CREATE-RECLEN 047640 OPEN OUTPUT CREATESD6 047660 ELSE OPEN OUTPUT CREATESD7. 047680 SET X UP BY 1. 047700 ENTER MACRO IQGETI. 047720 MOVE ELEM-INSTR TO J. 047740 MOVE CONST1 TO K. 047760 047780 CREATER1. 047800 SET X UP BY 1. 047820 ENTER MACRO IQGETI. 047840 IF ELEM-INSTR = 0 047860 GO TO CREATER2 CREATER3 DEPENDING ON J. 047880 IF ELEM-INSTR LESS THAN 0 047900 SUBTRACT ELEM-INSTR FROM K GIVING K 047920 GO TO CREATER1. 047940 SET DX TO ELEM-INSTR. 047960 ENTER MACRO IQGETD. 047980 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 048000 IF TRUE-TYPEV NOT = 1 AND TRUE-TYPEV NOT = 10 048020 GO TO CREATER1N. 048040 IF J = 1 ENTER MACRO IQSX66 USING ELEM-D-NCHAR AHOLDER 048060 CONST1 CREATESD6-REC K. 048080 IF J = 2 ENTER MACRO IQSX67 USING ELEM-D-NCHAR AHOLDER 048100 CONST1 CREATESD7-REC K. 048120 ADD ELEM-D-NCHAR TO K. 048140 GO TO CREATER1. 048160 048180* *IF GET HERE, ARE PROCESSING SOME KIND OF NUMERIC*. 048200 CREATER1N. 048220 SUBTRACT ELEM-D-NCHAR FROM MAX-NITEM-LEN-UP1 GIVING WORKX. 048240 IF J = 1 ENTER MACRO IQSX66 USING ELEM-D-NCHAR NHOLDER WORKX 048260 CREATESD6-REC K. 048280 IF J = 2 ENTER MACRO IQSX67 USING ELEM-D-NCHAR NHOLDER WORKX 048300 CREATESD7-REC K. 048320 ADD ELEM-D-NCHAR TO K. 048340 GO TO CREATER1. 048360 048380 CREATER2. 048400 ENTER MACRO IQWRTS USING CREATE-RECLEN. 048420 WRITE CREATESD6-REC. 048440 GO TO NEXT-INSTR-UPX. 048460 048480 CREATER3. 048500 ENTER MACRO IQWRTS USING CREATE-RECLEN. 048520 WRITE CREATESD7-REC. 048540 GO TO NEXT-INSTR-UPX. 048560 048580******************************************************** 048600* READ SUB FILE FROM BEGINNING INSTRUCTION VALUE 10 048620* FOR FORMAT SEE INSTR VALUE 11 048640******************************************************** 048660 READSUBBEG. 048680* *FORCE 'FROM BEGINNING' BY CLOSING PROPER FILE*. 048700 ENTER MACRO IQGETI. 048720 SET FX TO ELEM-INSTR. 048740 SET X UP BY 1. 048760 ENTER MACRO IQGETI. 048780 IF ELEM-INSTR LESS THAN 7 048800 PERFORM CLOSER1 THRU CLOSER1-EXIT 048820 GO TO READSUB-COMMON. 048840 IF ELEM-INSTR LESS THAN 13 048860 PERFORM CLOSER2 THRU CLOSER2-EXIT 048880 ELSE PERFORM CLOSER3 THRU CLOSER3-EXIT. 048900 GO TO READSUB-COMMON. 048920 048940 048960******************************************************** 048980* READ SUB FILE FROM CURRENT POSITION 049000* FORMAT: 049020* (X) = INSTRUCTION VALUE 11. 049040* (X+1) = FX OF INPUT FILE F-ENTRY. 049060* (X+2) = READTYPE ROUTER; SAME AS FOR INSTRUCT 5. 049080* (X+3) = DX OF LEFTSIDE ITEM. 049100* (X+4) = DX OF RIGHTSIDE ITEM (0 IF FIND NEXT). 049120********************************************************** 049140 READSUB. 049160 ENTER MACRO IQGETI. 049180 SET FX TO ELEM-INSTR. 049200 SET X UP BY 1. 049220 ENTER MACRO IQGETI. 049240 READSUB-COMMON. 049260 MOVE ELEM-INSTR TO ROUTER. 049280 SET X UP BY 2. 049300 ENTER MACRO IQGETI. 049320 IF ELEM-INSTR = 0 GO TO READSEQ-COMMON. 049340* *HERE FOR FIND ITEM = ITEM OR VALUE 049360* *- ELEM-INSTR = RIGHTSIDE DX* 049380 SET DX TO ELEM-INSTR. 049400 ENTER MACRO IQGETD. 049420* *GET RIGHTSIDE VALUE AND SAVE RIGHTSIDE TYPE*. 049440 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 049460 MOVE TRUE-TYPEV TO L. 049480 SET X DOWN BY 1. 049500 ENTER MACRO IQGETI. 049520 SET DX TO ELEM-INSTR. 049540* *CHECK RIGHTSIDE VS LEFTSIDE ITEM TYPE; ADJUST IF NECESSARY*. 049560 ENTER MACRO IQGETD. 049620 PERFORM HOLDER-ADJUST THRU HOLDER-ADJUST-EXIT. 049640* *NOW GET READY TO GO TO COMMON FILE READING LOGIC* 049660 MOVE AHOLDER TO ALT-AHOLDER. 049680 MOVE NHOLDER-SCALE TO ALT-NHOLDER-SCALE. 049700 ENTER MACRO IQGETI. 049720 SET DX TO ELEM-INSTR. 049740 SET X UP BY 1. 049760 GO TO READSEQ-COMMON. 049780 049800********************************************************** 049820* SORT INSTRUCTION 049840* FORMAT: 049860* (X) = INSTRUCTION VALUE 12. 049880* (X+1) = FILE NUMBER; 1, 2, OR 3 049900* (X+2) = START OF DX LIST OF ITEMS TO GO INTO KEY. 049920* END OF DX LIST IS SIGNIFIED BY 0. 049940* IF AN ITEM IS TO BE SORTED DESCENDING, ITS 049960* DX IS NEGATED; IE -197 MEANS THE ITEM 049980* SORTED DESCRIBED BY DX 197 IS TO BE SORTED 050000* DESCENDING. 050020* 050040* NOTE: AFTER SORT RECORD WRITTEN, CONTROL GOES TO X POINTED 050060* TO BY EXEC-STARTX. THIS IS THE SAME AS IF SORT HAD 050080* BEEN FOLLOWED BY A 'GO TO NR$' INSTRUCTION. 050100* THERE SHOULD BE A 'GO TO NR$' INSTRUCTION IMMEDIATELY 050120* AFTER SORT ( GENERATED AUTOMATICALLY BY IQA ) ANYWAY 050140* TO SERVE AS THE FALSEGOX TARGET OF ANY IF WHICH CONTROLS 050160* THE SORT. I.E: IF DIV = 421 SORT BY DEPT $ 050180* GENERATES CODE AS IF IT HAD BEEN WRITTEN 050200* IF DEPT = 421 SORT BY DEPT $ 050220* GO TO NR $ 050240* 050260* ON IQE'S HITTING END OF INPUT FILE, CONTROL GOES TO LOCATION 050280* ADDRESSED BY EOF1-X. THIS NORMALLY WILL BE AN 'END' 050300* INSTRUCTION. HERE, IQE WILL LOOK TO SEE IF IT IS 050320* SORTING, AND IF SO IT WILL WRITE OUT THE CURRENT 050340* CONTROL TABLES AND EXIT TO IQS. BEFORE WRITING THE 050360* CONTROL TABLES, IT RESETS EXEC-STARTX TO POINT TO THE 050380* NEXT READ INSTRUCTION AFTER THE SORT INSTRUCTION NOW BEING 050400* EXECUTED. THIS NORMALLY WILL BE A 050420* 'READ PRIMARY SEQUENTIAL SIXBIT' INSTRUCTION, WHICH 050440* WILL SERVE AS THE FIRST INSTRUCTION WHEN IQE IS 050460* RE ENTERED FROM IQS; IT WILL ALSO BE THE TARGET OF ANY 050480* 'GO TO NR' (IMPLIED OR REAL) IN THE NEW STAGE. 050500* 050520* NOTE THAT IQE TAKES CARE OF OPENING AND CLOSING THE 050540* SORTED FILE. 050560********************************************************** 050580 050600 SORTER. 050620 IF SORTFILE-FLAG NOT = 0 GO TO SORTER1. 050640 OPEN OUTPUT SORTFILE. 050660 MOVE 1 TO SORTFILE-FLAG. 050680 SORTER1. 050700 ENTER MACRO IQGETI. 050720 MOVE ELEM-INSTR TO SORTER-ROUTER. 050740 GO TO SORTER-BUILDREC1 SORTER-BUILDREC2 SORTER-BUILDREC3 050760 DEPENDING ON SORTER-ROUTER. 050780 050800 SORTER-BUILDREC1. 050820 SET DX TO INF1-FX. 050840 ENTER MACRO IQGETD. 050860 IF ELEM-F-TYPE = 27 050864 COMPUTE ELEM-F-RECLEN = ELEM-F-RECLEN * 6 / 5. 051000 ENTER MACRO IQSX66 USING ELEM-F-RECLEN INF1SD6-REC 051020 CONST1 SORTFILE-REC CONST1. 051040 GO TO SORTER2. 051060 051300 SORTER-BUILDREC2. 051320 SET DX TO INF2-FX. 051340 ENTER MACRO IQGETD. 051360 IF ELEM-F-TYPE = 27 051364 COMPUTE ELEM-F-RECLEN = ELEM-F-RECLEN * 6 / 5. 051500 ENTER MACRO IQSX66 USING ELEM-F-RECLEN INF2SD6-REC 051520 CONST1 SORTFILE-REC CONST1. 051540 GO TO SORTER2. 051560 051760 051780 SORTER-BUILDREC3. 051800 SET DX TO INF3-FX. 051820 ENTER MACRO IQGETD. 051840 IF ELEM-F-TYPE = 27 051860 COMPUTE ELEM-F-RECLEN = ELEM-F-RECLEN * 6 / 5. 051980 ENTER MACRO IQSX66 USING ELEM-F-RECLEN INF3SD6-REC 052000 CONST1 SORTFILE-REC CONST1. 052020 GO TO SORTER2. 052040 052240 052260 SORTER2. 052280 MOVE ELEM-F-RECLEN TO SORT-KEYOFFSET. 052300 ADD 1 TO SORT-KEYOFFSET. 052320 SET SKX TO SORT-KEYOFFSET. 052340 052360 SORTER-LOOP. 052380* *BUILD KEY IN THIS LOOP*. 052400 SET X UP BY 1. 052420 ENTER MACRO IQGETI. 052440 IF ELEM-INSTR = 0 GO TO SORTER-BUILDREC. 052460 IF ELEM-INSTR LESS THAN 0 GO TO SORTER-DESC-KEY. 052480 052500 SORTER-ASC-KEY. 052520* *PROCESS ASCENDING KEY FIELD HERE*. 052540 SET DX TO ELEM-INSTR. 052560 ENTER MACRO IQGETD. 052580 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 052600 GO TO SORTASC-ALPHA SORTASC-NUM SORTER-ERR SORTER-ERR 052620 SORTER-ERR SORTASC-NUM SORTASC-NUM SORTASC-NUM 052640 SORTASC-NUM SORTASC-ALPHA SORTASC-NUM SORTER-ERR 052660 SORTASC-ALPHA SORTASC-ALPHA SORTASC-NUM 052680 DEPENDING ON TRUE-TYPEV. 052700 052720 SORTER-ERR. 052740 MOVE 08 TO ERROR-CODE. 052760 PERFORM COMPLAINER THRU COMPLAINER-EXIT. 052780 GO TO SORTER-LOOP. 052800 SORTASC-ALPHA. 052820 ENTER MACRO IQSX66 USING ELEM-D-NCHAR AHOLDER 052840 CONST1 SORTFILE-KEY SKX. 052860 SET SKX UP BY ELEM-D-NCHAR. 052880 GO TO SORTER-LOOP. 052900 052920 SORTASC-NUM. 052940 SUBTRACT ELEM-D-NCHAR FROM MAX-NITEM-LEN-UP1 GIVING I. 052960 052980 SORTASC-NUM1. 053000 SET PTX TO ELEM-D-NCHAR. 053020* *ADJUST FOR POSSIBLE NEGATIVE VALUES*. 053040 ADD 10EX (PTX) TO NHOLDER. 053060 053080 SORTASC-NUM2. 053100 IF I GREATER 1 053120 SUBTRACT 1 FROM I ADD 1 TO ELEM-D-NCHAR. 053140 ENTER MACRO IQSX66 USING ELEM-D-NCHAR 053160 NHOLDER I SORTFILE-KEY SKX. 053180 SET SKX UP BY ELEM-D-NCHAR. 053200 GO TO SORTER-LOOP. 053220 053240 053260 SORTER-DESC-KEY. 053280* *PROCESS DESCENDING KEY FIELD HERE*. 053300 SUBTRACT ELEM-INSTR FROM 0 GIVING ELEM-INSTR. 053320 SET DX TO ELEM-INSTR. 053340 ENTER MACRO IQGETD. 053360 PERFORM GETN-VALUE THRU GET-VALUE-EXIT. 053380 GO TO SORTDSC-ALPHA SORTDSC-NUM SORTER-ERR SORTER-ERR 053400 SORTER-ERR SORTDSC-NUM SORTDSC-NUM SORTDSC-NUM 053420 SORTDSC-NUM SORTDSC-ALPHA SORTDSC-NUM SORTER-ERR 053440 SORTDSC-ALPHA SORTDSC-ALPHA SORTDSC-NUM 053460 DEPENDING ON TRUE-TYPEV. 053480 053500 SORTDSC-ALPHA. 053580* *COMPLEMENT ALPHA CHAR FOR SORTING DESCENDING*. 053582 SET I TO SKX. 053584 ADD ELEM-D-NCHAR TO I. 053586 ENTER MACRO IQSX66 USING ELEM-D-NCHAR 053588 AHOLDER CONST1 SORTFILE-KEY SKX. 053590 053592 SORTDSC-ALPHA1. 053600 MOVE SORTFILE-KEYCHAR (SKX) TO ELEM-CHAR. 053620 SUBTRACT BINARY-CHAR FROM CONST63 GIVING BINARY-CHAR. 053640 MOVE ELEM-CHAR TO SORTFILE-KEYCHAR (SKX). 053660 IF SKX NOT GREATER THAN I 053680 SET SKX UP BY 1 GO TO SORTDSC-ALPHA1. 053760 GO TO SORTER-LOOP. 053780 053800 SORTDSC-NUM. 053820 SUBTRACT ELEM-D-NCHAR FROM MAX-NITEM-LEN-UP1 GIVING I. 053840 053860 SORTDSC-NUM1. 053880 SET PTX TO ELEM-D-NCHAR. 053900* *ADJUST FOR POSSIBLE NEGATIVE VALUES AND COMPLEMENT*. 053920 SUBTRACT NHOLDER FROM 10EX (PTX) GIVING NHOLDER. 053940 053960 SORTDSC-NUM2. 053980 IF I GREATER 1 054000 SUBTRACT 1 FROM I 054020 ADD 1 TO ELEM-D-NCHAR. 054040 ENTER MACRO IQSX66 USING ELEM-D-NCHAR 054060 NHOLDER I SORTFILE-KEY SKX. 054080 SET SKX UP BY ELEM-D-NCHAR. 054100 GO TO SORTER-LOOP. 054120 054140 054160 SORTER-BUILDREC. 054180 IF SORTFILE-FLAG = 1 MOVE 2 TO SORTFILE-FLAG 054200 SET SORT-RECLEN TO SKX 054220 MOVE SORT-RECLEN TO SORT-KEYLEN 054240 SUBTRACT SORT-KEYOFFSET FROM SORT-KEYLEN 054260 SUBTRACT 1 FROM SORT-RECLEN 054280 ENTER MACRO IQWRTS USING SORT-RECLEN. 054300 WRITE SORTFILE-REC. 054320* *SET UP START EXECUTION ROUTER FOR NEXT STAGE - 054340* *THIS ALSO SERVES TO STOP SUMMARY OUT SEARCH* 054350* *SORT-STARTX IS 5 PAST END OF KEY LIST TO GIVE ROOM FOR ANY 054355* * GO TO NN INSTRUCTION THAT MAY IMMEDIATELY FOLLOW SORT. 054360 COMPUTE SORT-STARTX = X + 5. 054442* *TURN OFF FIRST TIME ACTIVITY* 054444 IF INF1-FLAG LESS THAN 3 MOVE 3 TO INF1-FLAG. 054460 GO TO NEXT-INSTR. 054480 054500*********