000010* cob3.debugboo 01/01/23 nm -e cob3prg.debugboo 000020* 001000* dbimag4.source nm cobol85 001100$control map,verbs,crossref 001200 001300$CONTROL USLINIT 001400 IDENTIFICATION DIVISION. 001500 PROGRAM-ID. DBIMAGE. 001600 AUTHOR. CHUCK GLENN. 001700 001800* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 001900* W A R N I N G * 002000* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 002100* * 002200* XXX XXX XXXX XXX X XXX XXXXX * 002300* X X X X X X X X X X X X * 002400* X X X X X X X X X X XXXX * 002500* X X X XXXX X X X XXX X * 002600* X X X X X X X X X X X * 002700* X X X X X X X X X X X X X * 002800* XXX XXX XXXX XXX XXXXX XXX XXX * 002900* * 003000* This program contains syntax specific to the ANSI 85 * 003100* version of the COBOL language. It must be compiled * 003200* through the ANSI85 entry point of COBOLII.PUB.SYS. This * 003300* can be done by: * 003400* * 003500* :COB85XLK ,, * 003600* * 003700* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 003800 003900* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 004000* P R O G R A M D O C U M E N T A T I O N * 004100* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 004200* * 004300* This program uses any text printer to draw a graphic * 004400* representation of any IMAGE database. It uses DBINFO calls * 004500* to accomplish its database inspecting (no priviledge mode). * 004600* It requires no special capabilities. Database passwords * 004700* must be given at run time. * 004800* * 004900* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 005000* * 005100* version 1.1 changes: * 005200* * 005300* OMNIDEX datasets are automatically excluded unless DBIMAGE * 005400* is run with ;PARM=1. * 005500* * 005600* The minimum dimensions into which the picture could have * 005700* fit are displayed at the end of processing each database. * 005800* * 005900* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 006000* * 006100* version 1.1a changes: * 006200* * 006300* The item definitions line up on the alpha type * 006400* (X,U,Z,P,R,I,etc). * 006500* * 006600* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 006700* * 006800* version 1.2 changes: * 006900* * 007000* PLOTFILE is not initialized; a table is used to indicate * 007100* which records have already been written to, etc. Also made * 007200* plotfile 5000 records since size won't slow it down anymore. * 007300* * 007400* INFO=",[,Q][S]". Q option added to INFO * 007500* string to suppress instruction page. S option added to * 007600* 'spread' into the required width. Leaving S option off * 007700* causes minimum usable width to be used, which may leave * 007800* white spaces on the right side of the right-most pages. * 007900* * 008000* Counts are displayed as the program is working so that the * 008100* user will not be tempted to think it has frozen. * 008200* * 008300* Changes DSET-TABLE and DITEM-TABLE so that the maximums * 008400* per database are 200 and 1024 respectively. * 008500* * 008600* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 008700* * 008800* version 1.2ss changes: (Stan Sieler) * 008900* * 009000* Increased output file max width from 400 to 4000 * 009100* * 009200* Added code to terminate if #masters = 0 or * 009300* # details = 0. * 009400* * 009500* Added default values for password, mode. * 009600* * 009700* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 009800 009900* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 010000* S P E C I A L N O T E * 010100* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 010200* * 010300* Thanks to John Archer for some ideas he had about DBIMAGE. * 010400* Some of these prompted what's in version 1.2. * 010500* * 010600* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 010700 010800 ENVIRONMENT DIVISION. 010900 INPUT-OUTPUT SECTION. 011000 FILE-CONTROL. 011100 011200 SELECT TERMFILE 011300 ASSIGN TO "$STDLIST". 011400 011500 SELECT PRINTFILE 011600 ASSIGN TO "DBIMAGE". 011700 011800 SELECT PLOTFILE 011900 ASSIGN TO "PLOTFILE" 012000 ACCESS MODE IS RANDOM 012100 ACTUAL KEY IS CURRENT-Y. 012200 012300 DATA DIVISION. 012400 FILE SECTION. 012500 012600 FD TERMFILE 012700 DATA RECORD IS TERMFILEREC. 012800 01 TERMFILEREC PIC X(80). 012900 013000 FD PRINTFILE 013100 RECORDING MODE IS F 013200 RECORD CONTAINS 80 TO 4000 CHARACTERS 013300* was 80 to 400 SS 991112 013400 DATA RECORD IS PRINT-REC. 013500 01 PRINT-REC. 013600 02 PRINT-CHAR OCCURS 80 TO 4000 TIMES 013700* was 80 to 400 SS 991112 013800 DEPENDING ON CHARACTERS-PER-LINE 013900 INDEXED BY PRINT-DEX 014000 PIC X(01). 014100 014200 FD PLOTFILE 014300 RECORDING MODE IS F 014400 RECORD CONTAINS 5000 CHARACTERS 014500 DATA RECORD IS PLOT-LINE. 014600 01 PLOT-LINE. 014700 02 PLOTFILECHAR OCCURS 5000 TIMES 014800 INDEXED BY PLOT-DEX 014900 PIC X(01). 015000 015100 WORKING-STORAGE SECTION. 015200 015300* 015400* STATIC ITEMS 015500* 015600 015700 77 SINGLE-WIDTH PIC S9(4) BINARY VALUE 30. 015800 77 HALF-SINGLE-WIDTH PIC S9(4) BINARY VALUE 14. 015900 77 MID-POINT PIC S9(4) BINARY VALUE 10. 016000 016100 01 BACKSPACE-9. 016200 02 PIC X(01) VALUE %010. 016300 02 PIC X(01) VALUE %010. 016400 02 PIC X(01) VALUE %010. 016500 02 PIC X(01) VALUE %010. 016600 02 PIC X(01) VALUE %010. 016700 02 PIC X(01) VALUE %010. 016800 02 PIC X(01) VALUE %010. 016900 02 PIC X(01) VALUE %010. 017000 02 PIC X(01) VALUE %010. 017100 017200 01 BACKSPACE-4. 017300 02 PIC X(01) VALUE %010. 017400 02 PIC X(01) VALUE %010. 017500 02 PIC X(01) VALUE %010. 017600 02 PIC X(01) VALUE %010. 017700 017800 017900* 018000* END OF STATIC ITEMS 018100* 018200 018300 018400 77 CHARACTERS-PER-LINE PIC S9(4) BINARY. 018500 77 LINES-PER-PAGE PIC S9(4) BINARY. 018600 018700 01 PLOT-INIT-TABLE. 018800 02 PLOT-INIT OCCURS 5000 TIMES 018900 PIC X(01). 019000 019100 01 COUNTER PIC S9(4) BINARY. 019200 01 COUNTER2 PIC S9(4) BINARY. 019300 01 COUNTER3 PIC S9(4) BINARY. 019400 01 CURRENT-Y PIC S9(9) BINARY. 019500 01 DESIRED-Y PIC S9(4) BINARY. 019600 01 MASTER-Y PIC S9(4) BINARY. 019700 01 DETAIL-Y PIC S9(4) BINARY. 019800 01 SLOPE PIC S9V9(17) BINARY. 019900 01 NUM-OF-DETAILS PIC S9(4) BINARY. 020000 01 NUM-OF-MASTERS PIC S9(4) BINARY. 020100 01 NUM-CONNECTIONS PIC S9(4) BINARY. 020200 01 DSET-PLOT-WIDTH PIC S9(4) BINARY. 020300 01 OLD-PLABEL PIC S9(9) BINARY. 020400 01 PLOT-WIDTH PIC S9(4) BINARY. 020500 01 SORT-ITEM PIC S9(4) BINARY. 020600 020700 01 X-DIFF PIC S9(4) BINARY. 020800 01 Y-DIFF PIC S9(4) BINARY. 020900 01 FROM-X PIC S9(4) BINARY. 021000 01 FROM-Y PIC S9(4) BINARY. 021100 01 TO-X PIC S9(4) BINARY. 021200 01 TO-Y PIC S9(4) BINARY. 021300 01 X-TEMP PIC S9(4) BINARY. 021400 01 Y-TEMP PIC S9(4) BINARY. 021500 01 STEP PIC S9(4) BINARY. 021600 021700 01 PRINT-COLUMNS PIC S9(4) BINARY. 021800 01 PRINT-ROWS PIC S9(4) BINARY. 021900 01 HORIZONTAL-PAGES PIC S9(4) BINARY. 022000 01 VERTICAL-PAGES PIC S9(4) BINARY. 022100 01 PAGE-X PIC S9(4) BINARY. 022200 01 PAGE-Y PIC S9(4) BINARY. 022300 022400 01 DETL-COUNTER PIC S9(8)V9 BINARY. 022500 01 DETL-SPACING PIC S999V9(15) BINARY. 022600 01 MAST-COUNTER PIC S9(8)V9 BINARY. 022700 01 MAST-SPACING PIC S999V9(15) BINARY. 022800 022900 01 DISP-NUM PIC ZZZ9. 023000 01 WORK-COUNT PIC 9(4) COMP. 023100 023200 01 PROGFILE. 023300 02 PROGFILE-CHAR OCCURS 40 TIMES 023400 PIC X(01). 023500 02 PRG41 PIC X(01). 023600 02 PRG42 PIC X(01). 023700 023800 01 PRGMANY-PARENT. 023900 02 PRGMANY OCCURS 40 TIMES 024000 PIC X(01). 024100 024200 01 PROMPT-BASE. 024300 02 PBC OCCURS 26 TIMES 024400 INDEXED BY PBC-DEX 024500 PIC X(01). 024600 024700 01 PROMPT-PASSWORD PIC X(20). 024800 01 PROMPT-DATASET PIC X(16). 024900 01 OPENMODE PIC S9(4) BINARY. 025000 01 MODE1 PIC S9(4) BINARY VALUE 1. 025100 01 MODE2 PIC S9(4) BINARY VALUE 2. 025200 01 MODE3 PIC S9(4) BINARY VALUE 3. 025300 01 MODE5 PIC S9(4) BINARY VALUE 5. 025400 01 MODE102 PIC S9(4) BINARY VALUE 102. 025500 01 MODE103 PIC S9(4) BINARY VALUE 103. 025600 01 MODE104 PIC S9(4) BINARY VALUE 104. 025700 01 MODE202 PIC S9(4) BINARY VALUE 202. 025800 01 MODE203 PIC S9(4) BINARY VALUE 203. 025900 01 MODE301 PIC S9(4) BINARY VALUE 301. 026000 01 MODE302 PIC S9(4) BINARY VALUE 302. 026100 01 DUMMY-INTEGER-ARRAY. 026200 02 DUMMY-INTEGER PIC S9(4) BINARY. 026300 026400 01 DUMMY-INTEGER2 PIC S9(4) BINARY. 026500 01 DUMMY-STRING PIC X(20). 026600 026700 01 PLOT-STRING. 026800 02 PS-CHAR OCCURS 40 TIMES 026900 INDEXED BY PS-INDEX 027000 PIC X(01). 027100 027200 01 BSTRINGS. 027300 02 BSTRING1 PIC X(05). 027400 02 BSTRING2 PIC X(05). 027500 02 BSTRING3 PIC X(05). 027600 02 BSTRING4 PIC X(05). 027700 02 BSTRING5 PIC X(05). 027800 02 BSTRING6 PIC X(05). 027900 02 BSTRING7 PIC X(05). 028000 02 PIC X(01). 028100 028200 028300 01 PLOT-X PIC S9(4) BINARY. 028400 01 PLOT-Y PIC S9(4) BINARY. 028500 01 BPLOT-X PIC S9(4) BINARY. 028600 01 BPLOT-Y PIC S9(4) BINARY. 028700 028800 01 ODD-BYTE-STUFF. 028900 02 PLOT-CHAR PIC X(01). 029000 02 BPLOT-CHAR PIC X(01). 029100 02 SORT-FLAG PIC X(01). 029200 02 PAGE-FLAG PIC X(01). 029300 02 NTS-FLAG PIC X(01). 029400 02 QUIET-FLAG PIC X(01). 029500 02 SPREAD-OUT-FLAG PIC X(01). 029600 02 PIC X(01). 029700 029800 01 BUFFER-102. 029900 02 ITEM-NAME PIC X(16). 030000 02 ITEM-TYPE PIC X(01). 030100 02 PIC X(01). 030200 02 ITEM-LENGTH PIC S9(4) BINARY. 030300 02 ITEM-COUNT PIC S9(4) BINARY. 030400 02 PIC X(04). 030500 030600 01 BUFFER-103. 030700 02 COUNT-103 PIC S9(4) BINARY. 030800 02 ITEM-103 OCCURS 1024 TIMES 030900 INDEXED BY INDEX-103 031000 PIC S9(4) BINARY. 031100 031200 01 BUFFER-104. 031300 02 COUNT-104 PIC S9(4) BINARY. 031400 02 ITEM-104 OCCURS 200 TIMES 031500 INDEXED BY INDEX-104 031600 PIC S9(4) BINARY. 031700 031800 01 BUFFER-202. 031900 02 SET-NAME PIC X(16). 032000 02 SET-TYPE PIC X(01). 032100 02 PIC X(01). 032200 02 SET-LENGTH PIC S9(4) BINARY. 032300 02 PIC X(14). 032400 032500 01 BUFFER-203. 032600 02 COUNT-203 PIC S9(4) BINARY. 032700 02 DSET-203 OCCURS 150 TIMES 032800 INDEXED BY INDEX-203 032900 PIC S9(4) BINARY. 033000 033100 01 BUFFER-301. 033200 02 COUNT-301 PIC S9(4) BINARY. 033300 02 ENTRY-301 OCCURS 200 TIMES 033400 INDEXED BY INDEX-301. 033500 03 DSET-301 PIC S9(4) BINARY. 033600 03 ITEM-301 PIC S9(4) BINARY. 033700 03 SORT-301 PIC S9(4) BINARY. 033800 033900 01 BUFFER-302. 034000 02 ITEM-302 PIC S9(4) BINARY. 034100 02 PIC X(02). 034200 034300 01 DSET-TABLE. 034400 02 DSET-ENTRY OCCURS 200 TIMES 034500 INDEXED BY DSET-INDEX 034600 DSET-INDEX2 034700 DSET-INDEX3 034800 DSET-INDEX4. 034900 03 DSET-NAME PIC X(16). 035000 03 DSET-NUMBER PIC S9(4) BINARY. 035100 03 DSET-TYPE PIC X(01). 035200 03 DSET-SYMBOL PIC X(01). 035300 03 DSET-X-COORD PIC S9(4) BINARY. 035400 035500 01 DITEM-TABLE. 035600 02 DITEM-ENTRY OCCURS 100 TIMES 035700 INDEXED BY DITEM-INDEX 035800 DITEM-INDEX2. 035900 03 DITEM-NAME PIC X(16). 036000 03 DITEM-TYPE PIC X(01). 036100 03 DITEM-LENGTH PIC S9(4) BINARY. 036200 03 DITEM-COUNT PIC S9(4) BINARY. 036300 036400 036500 036600 01 COMMAND-IMAGE. 036700 02 COMMAND-LINE PIC X(79). 036800 02 PIC X(01) VALUE %15. 036900 037000 01 COMMAND-ERROR PIC S9(4) BINARY. 037100 037200 01 COMMAND-PARM PIC S9(4) BINARY. 037300 037400 01 BASE. 037500 02 PIC X(02). 037600 02 BASE-NAME PIC X(26). 037700 037800 01 STATUSS. 037900 02 COND PIC S9(4) BINARY. 038000 02 RECORD-WIDTH PIC S9(4) BINARY. 038100 02 RECORD-NUMBER PIC S9(9) BINARY. 038200 02 PIC S9(9) BINARY. 038300 02 PIC S9(9) BINARY. 038400 02 PIC S9(9) BINARY. 038500 038600 01 STATUS32 PIC S9(9) BINARY. 038700 038800 01 NTS-CEDE PIC S9(2) BINARY. 038900 01 NTS-DIVISOR PIC S9(18) BINARY. 039000 01 NTS-DIVIDEND PIC S9(18) BINARY. 039100 039200 01 NTS-STRING. 039300 02 NTS-ARRAY OCCURS 20 TIMES 039400 INDEXED BY NTS-INDEX. 039500 03 NTS-CHAR PIC X(01). 039600 03 NTS-CHAR-9 REDEFINES NTS-CHAR 039700 PIC 9(01). 039800 039900 01 NTS-NUMBER PIC S9(18) BINARY. 040000 040100 01 SYMBOLS-DATA. 040200 02 PIC X(30) 040300 VALUE "1234567890ABCDEFGHIJKLMNOPQRST". 040400 02 PIC X(30) 040500 VALUE "UVWXYZ!@#$%&*()-=+abcdefghijkl". 040600 02 PIC X(20) 040700 VALUE "mnopqrstuvwxyz[{}]:?". 040800 01 SYMBOLS-TABLE REDEFINES SYMBOLS-DATA. 040900 02 SYM-CHAR OCCURS 80 TIMES 041000 INDEXED BY SYM-DEX 041100 PIC X(01). 041200 041300 01 CONNECTIONS-TABLE. 041400 02 CONNECTION OCCURS 300 TIMES 041500 INDEXED BY CON-DEX. 041600 03 CON-DETLX PIC S9(4) BINARY. 041700 03 CON-MASTX PIC S9(4) BINARY. 041800 03 CON-SYMBOL PIC X(01). 041900 03 PIC X(01). 042000 03 CON-DSET PIC S9(4) BINARY. 042100 03 CON-ITEM PIC S9(4) BINARY. 042200 03 CON-SORT PIC S9(4) BINARY. 042300 042400 01 HOME-AND-CLEAR. 042500 02 HOME. 042600 03 PIC X(01) VALUE %33. 042700 03 PIC X(01) VALUE "h". 042800 02 CLEAR. 042900 03 PIC X(01) VALUE %33. 043000 03 PIC X(01) VALUE "J". 043100 043200 01 UP-A-LINE. 043300 02 PIC X(01) VALUE %33. 043400 02 PIC X(01) VALUE "A". 043500 043600 01 COVERPAGE-1. 043700 02 PIC X(44) 043800 VALUE " The following pages are to be arranged ". 043900 02 PIC X(44) 044000 VALUE " ------------------------- ". 044100 02 PIC X(44) VALUE SPACES. 044200 044300 01 COVERPAGE-2. 044400 02 PIC X(44) 044500 VALUE "in reading order as illustrated at right. ". 044600 02 PIC X(44) 044700 VALUE " : : : : ". 044800 02 PIC X(44) VALUE SPACES. 044900 045000 01 COVERPAGE-3. 045100 02 PIC X(44) VALUE SPACES. 045200 02 PIC X(44) 045300 VALUE " : 1 : 2 : 3 : ". 045400 02 PIC X(44) VALUE SPACES. 045500 045600 01 COVERPAGE-4. 045700 02 PIC X(44) 045800 VALUE " In the case of this specific listing, ". 045900 02 PIC X(44) 046000 VALUE " : : : : ". 046100 02 PIC X(44) VALUE SPACES. 046200 046300 01 COVERPAGE-5. 046400 02 PIC X(44) 046500 VALUE "please note that the number of pages ". 046600 02 PIC X(44) 046700 VALUE " ------------------------- ". 046800 02 PIC X(44) VALUE SPACES. 046900 047000 01 COVERPAGE-6. 047100 02 PIC X(23) 047200 VALUE "across a single row is ". 047300 02 COVERPAGE-ACROSS PIC 9(2). 047400 02 PIC X(19) 047500 VALUE ". ". 047600 02 PIC X(44) 047700 VALUE " : : : : ". 047800 02 PIC X(44) VALUE SPACES. 047900 048000 01 COVERPAGE-7. 048100 02 PIC X(44) VALUE SPACES. 048200 02 PIC X(44) 048300 VALUE " : 4 : 5 : 6 : ". 048400 02 PIC X(44) VALUE SPACES. 048500 048600 01 COVERPAGE-8. 048700 02 PIC X(44) VALUE SPACES. 048800 02 PIC X(44) 048900 VALUE " : : : : ". 049000 02 PIC X(44) VALUE SPACES. 049100 049200 01 COVERPAGE-9. 049300 02 PIC X(44) VALUE SPACES. 049400 02 PIC X(44) 049500 VALUE " ------------------------- ". 049600 02 PIC X(44) VALUE SPACES. 049700 049800 01 COVERPAGE-44. 049900 02 CP41 PIC X(44) VALUE SPACES. 050000 02 CP42 PIC X(44) VALUE SPACES. 050100 02 CP43 PIC X(44) VALUE SPACES. 050200 050300 01 INFO-LENGTH PIC S9(4) BINARY. 050400 01 INFO-STRING PIC X(40) VALUE SPACES. 050500 01 INFO-PARM PIC S9(4) BINARY. 050600 050700 01 INFO-1 PIC X(40). 050800 01 INFO-2 PIC X(40). 050900 051000 01 PROCNAME PIC X(20) VALUE "~CONTROL-Y-TRAP~". 051100 01 PLABEL PIC S9(9) COMP. 051200 01 OLDPLABEL PIC S9(9) COMP. 051300 01 LEN32 PIC S9(9) BINARY. 051400 051500 PROCEDURE DIVISION. 051600 051700 051800 0000-DBIMAGE. 051900 MOVE 32 TO LEN32. 052000 CALL INTRINSIC "HPMYPROGRAM" USING PRGMANY(1) STATUS32 052100 STATUS32 LEN32. 052200 CALL INTRINSIC "HPGETPROCPLABEL" USING PROCNAME 052300 PLABEL STATUS32 PRGMANY(1). 052400 IF STATUS32 NOT = 0 052500 DISPLAY "Error in HPGETPROCPLABEL: ", STATUS32 052600 CALL INTRINSIC "TERMINATE" 052700 END-IF 052800 052900 CALL INTRINSIC "XCONTRAP" USING PLABEL OLDPLABEL. 053000 053100 DISPLAY HOME-AND-CLEAR. 053200 DISPLAY " DBIMAGE 1.2ss by C. Glenn". 053300 DISPLAY " ". 053400 DISPLAY " This program draws a picture of any I" 053500 "MAGE database. Since almost any". 053600 DISPLAY "database will require a picture larger " 053700 "than a single sheet of paper, some". 053800 DISPLAY "assembly is required. Instructions for" 053900 " assembly of the picture are on the". 054000 DISPLAY "first page of the print-out produced fo" 054100 "r each database.". 054200 DISPLAY " ". 054300 DISPLAY " This program prompts for the database" 054400 ", password and DBOPEN mode to be used.". 054500 DISPLAY " ". 054600 DISPLAY " Omnidex datasets are automatically ex" 054700 "cluded from the picture unless you RUN". 054800 DISPLAY "this program with ;PARM=1.". 054900 DISPLAY " ". 055000 DISPLAY " The output goes to DBIMAGE, defaults " 055100 "are DEV=LP and CCTL. A file equate for". 055200 DISPLAY "DBIMAGE can be used to send output anyw" 055300 "here. This program currently assumes". 055400 DISPLAY "132 characters per line and 60 lines pe" 055500 "r page. You may override this by". 055600 DISPLAY "running this program with ;INFO=" 055700 QUOTE ",[,Q][S]" QUOTE "." 055800 " Specifying the Q in" 055900 DISPLAY "the INFO string will suppress the instr" 056000 "uction page on the print. Specifying" 056100 DISPLAY "the S in the INFO string causes the dia" 056200 "gram to 'spread' to fill the number of" 056300 DISPLAY "pages (horizontally) being printed.". 056400 DISPLAY " ". 056500 MOVE "X" TO PROMPT-BASE. 056600 PERFORM 0100-GETINFO 056700 PERFORM 1000-PROMPT-BASE 056800 UNTIL PROMPT-BASE = SPACES. 056900 GOBACK. 057000 057100 057200 0100-GETINFO. 057300 MOVE 40 TO INFO-LENGTH. 057400 057500 CALL INTRINSIC "GETINFO" 057600 USING INFO-STRING 057700 INFO-LENGTH 057800 INFO-PARM. 057900 058000 IF INFO-LENGTH > 0 058100 MOVE 0 TO NTS-NUMBER 058200 INSPECT INFO-STRING 058300 TALLYING NTS-NUMBER FOR ALL "Q" 058400 INSPECT INFO-STRING 058500 TALLYING NTS-NUMBER FOR ALL "q" 058600 IF NTS-NUMBER = 0 058700 MOVE SPACES TO QUIET-FLAG 058800 ELSE 058900 MOVE "X" TO QUIET-FLAG 059000 END-IF 059100 059200 MOVE 0 TO NTS-NUMBER 059300 INSPECT INFO-STRING 059400 TALLYING NTS-NUMBER FOR ALL "S" 059500 INSPECT INFO-STRING 059600 TALLYING NTS-NUMBER FOR ALL "s" 059700 IF NTS-NUMBER = 0 059800 MOVE SPACES TO SPREAD-OUT-FLAG 059900 ELSE 060000 MOVE "X" TO SPREAD-OUT-FLAG 060100 END-IF 060200 060300 UNSTRING INFO-STRING 060400 DELIMITED BY "," 060500 INTO INFO-1 060600 INFO-2 060700 END-UNSTRING 060800 060900 MOVE INFO-1 TO NTS-STRING 061000 PERFORM S030-STRING-TO-NUMBER 061100 MOVE NTS-NUMBER TO CHARACTERS-PER-LINE 061200 IF CHARACTERS-PER-LINE < 80 061300 MOVE 80 TO CHARACTERS-PER-LINE 061400 DISPLAY "Using minimum columns per page of 80" 061500 END-IF 061600 IF CHARACTERS-PER-LINE > 500 061700 MOVE 500 TO CHARACTERS-PER-LINE 061800 DISPLAY "Using maximum columns per page of 500" 061900 END-IF 062000 062100 MOVE INFO-2 TO NTS-STRING 062200 PERFORM S030-STRING-TO-NUMBER 062300 MOVE NTS-NUMBER TO LINES-PER-PAGE 062400 IF LINES-PER-PAGE < 60 062500 MOVE 60 TO LINES-PER-PAGE 062600 DISPLAY "Using minimum lines per page of 60" 062700 END-IF 062800 IF LINES-PER-PAGE > 300 062900 MOVE 300 TO LINES-PER-PAGE 063000 DISPLAY "Using maximum lines per page of 300" 063100 END-IF 063200 ELSE 063300 MOVE 132 TO CHARACTERS-PER-LINE 063400 MOVE 60 TO LINES-PER-PAGE 063500 END-IF. 063600 063700 063800 063900 1000-PROMPT-BASE. 064000 DISPLAY " ". 064100 DISPLAY "What is the DATABASE name? " NO ADVANCING. 064200 MOVE SPACES TO PROMPT-BASE. 064300 MOVE SPACES TO BASE. 064400 ACCEPT PROMPT-BASE. 064500 IF PROMPT-BASE NOT = SPACES 064600 INSPECT PROMPT-BASE 064700 CONVERTING "abcdefghijklmnopqrstuvwxyz" 064800 TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 064900 MOVE PROMPT-BASE TO BASE-NAME 065000 065100 PERFORM S010-ECHO-OFF 065200 DISPLAY "What is the password? (;) " NO ADVANCING 065300 MOVE SPACES TO PROMPT-PASSWORD 065400 MOVE ";;" TO PROMPT-PASSWORD 065500 ACCEPT PROMPT-PASSWORD 065600 PERFORM S020-ECHO-ON 065700 065800 DISPLAY "Open in what mode? (5) " NO ADVANCING 065900 MOVE SPACES TO NTS-STRING 066000 ACCEPT NTS-STRING 066100 PERFORM S030-STRING-TO-NUMBER 066200 066300 COMPUTE OPENMODE = NTS-NUMBER 066400 IF OPENMODE = 0 066500 MOVE 5 TO OPENMODE 066600 END-IF 066700 066800 CALL INTRINSIC "DBOPEN" 066900 USING BASE 067000 PROMPT-PASSWORD 067100 OPENMODE 067200 STATUSS 067300 IF COND = 0 067400 PERFORM 2000-DRAW-ONE 067500 CALL INTRINSIC "DBCLOSE" 067600 USING BASE 067700 PROMPT-PASSWORD 067800 MODE1 067900 STATUSS 068000 ELSE 068100 CALL INTRINSIC "QUIT" USING 1 068200 END-IF 068300 END-IF. 068400 068500 068600 2000-DRAW-ONE. 068700 DISPLAY "... creating work file ...". 068800 PERFORM 2100-CREATE-PLOTFILE. 068900 PERFORM 2200-LOAD-STRUCTURE. 069000 PERFORM 2300-COUNT-DATASETS. 069100 PERFORM 2400-SET-DSET-X-COORDS. 069200 PERFORM 2500-PLOT-DBNAME. 069300 PERFORM 2550-SET-MAST-BOTTOM. 069400 PERFORM 2600-LIST-MASTERS. 069500 PERFORM 2700-PLOT-MASTERS. 069600 PERFORM 2800-CHECK-CONNECTIONS. 069700 PERFORM 2900-DRAW-CONNECTIONS. 069800 PERFORM 3000-PLOT-DETAILS. 069900 PERFORM 3100-LIST-DETAILS. 070000 DISPLAY "... converting to print ...". 070100 WRITE PLOT-LINE 070200 INVALID KEY GO TO S998-FILE-ERROR. 070300 PERFORM 3200-PRINT-IT. 070400 CLOSE PLOTFILE. 070500 070600 070700 2100-CREATE-PLOTFILE. 070800* 070900* IF FILE EQ. DOESN'T EXIST FOR DBIMAGE, DO ONE YOURSELF 071000* 071100 MOVE SPACES TO COMMAND-LINE. 071200 MOVE "FILE FILEQTST=*DBIMAGE" 071300 TO COMMAND-LINE. 071400 CALL INTRINSIC "COMMAND" 071500 USING COMMAND-IMAGE 071600 COMMAND-ERROR 071700 COMMAND-PARM. 071800 071900 IF COMMAND-ERROR NOT = 0 THEN 072000 MOVE SPACES TO COMMAND-LINE 072100 MOVE "FILE DBIMAGE;DEV=LP;REC=-132;CCTL" 072200 TO COMMAND-LINE 072300 CALL INTRINSIC "COMMAND" 072400 USING COMMAND-IMAGE 072500 COMMAND-ERROR 072600 COMMAND-PARM 072700 END-IF. 072800 072900 MOVE SPACES TO COMMAND-LINE. 073000 MOVE "PURGE PLOTFILE,TEMP" 073100 TO COMMAND-LINE. 073200 CALL INTRINSIC "COMMAND" 073300 USING COMMAND-IMAGE 073400 COMMAND-ERROR 073500 COMMAND-PARM. 073600 073700 MOVE SPACES TO COMMAND-LINE. 073800 MOVE "BUILD PLOTFILE;TEMP;REC=-5000,,F,ASCII;DISC=5001" 073900 TO COMMAND-LINE. 074000 CALL INTRINSIC "COMMAND" 074100 USING COMMAND-IMAGE 074200 COMMAND-ERROR 074300 COMMAND-PARM. 074400 074500 MOVE SPACES TO COMMAND-LINE. 074600 MOVE "FILE PLOTFILE=PLOTFILE,OLDTEMP" 074700 TO COMMAND-LINE. 074800 CALL INTRINSIC "COMMAND" 074900 USING COMMAND-IMAGE 075000 COMMAND-ERROR 075100 COMMAND-PARM. 075200 075300 OPEN I-O PLOTFILE. 075400 MOVE SPACES TO PLOT-INIT-TABLE. 075500 MOVE SPACES TO PLOT-LINE. 075600 MOVE 2 TO CURRENT-Y. 075700 075800 MOVE "DBIMAGE 1.2ss" TO PLOT-STRING. 075900 MOVE 1 TO PLOT-X. 076000 MOVE 1 TO PLOT-Y. 076100 PERFORM S150-PLOT-STRING. 076200 076300 076400 076500 2200-LOAD-STRUCTURE. 076600 076700 CALL INTRINSIC "DBINFO" 076800 USING BASE 076900 DUMMY-STRING 077000 MODE103 077100 STATUSS 077200 BUFFER-103. 077300 IF COND NOT = 0 077400 CALL INTRINSIC "QUIT" USING 1 077500 END-IF. 077600 077700 CALL INTRINSIC "DBINFO" 077800 USING BASE 077900 DUMMY-STRING 078000 MODE203 078100 STATUSS 078200 BUFFER-203 078300 IF COND NOT = 0 078400 CALL INTRINSIC "QUIT" USING 1 078500 ELSE 078600 IF COUNT-203 < 0 078700 COMPUTE COUNT-203 = COUNT-203 * -1 078800 END-IF 078900 END-IF. 079000 079100 INITIALIZE DITEM-TABLE. 079200 079300 PERFORM VARYING INDEX-103 FROM 1 BY 1 079400 UNTIL INDEX-103 > COUNT-103 079500 IF ITEM-103(INDEX-103) < 0 079600 COMPUTE ITEM-103(INDEX-103) 079700 = ITEM-103(INDEX-103) * -1 079800 END-IF 079900 COMPUTE DUMMY-INTEGER = ITEM-103(INDEX-103) 080000 CALL INTRINSIC "DBINFO" 080100 USING BASE 080200 DUMMY-INTEGER-ARRAY 080300 MODE102 080400 STATUSS 080500 BUFFER-102 080600 IF COND NOT = 0 080700 CALL INTRINSIC "QUIT" USING 1 080800 ELSE 080900 SET DITEM-INDEX TO INDEX-103 081000 MOVE ITEM-NAME TO DITEM-NAME(DITEM-INDEX) 081100 MOVE ITEM-TYPE TO DITEM-TYPE(DITEM-INDEX) 081200 MOVE ITEM-LENGTH TO DITEM-LENGTH(DITEM-INDEX) 081300 MOVE ITEM-COUNT TO DITEM-COUNT(DITEM-INDEX) 081400 END-IF 081500 END-PERFORM. 081600 081700 INITIALIZE DSET-TABLE. 081800 SET DSET-INDEX TO 1. 081900 PERFORM VARYING INDEX-203 FROM 1 BY 1 082000 UNTIL INDEX-203 > COUNT-203 082100 IF DSET-203(INDEX-203) < 0 082200 COMPUTE DSET-203(INDEX-203) 082300 = DSET-203(INDEX-203) * -1 082400 END-IF 082500 COMPUTE DUMMY-INTEGER = DSET-203(INDEX-203) 082600 CALL INTRINSIC "DBINFO" 082700 USING BASE 082800 DUMMY-INTEGER-ARRAY 082900 MODE202 083000 STATUSS 083100 BUFFER-202 083200 IF COND NOT = 0 083300 CALL INTRINSIC "QUIT" USING 1 083400 ELSE 083500 IF (SET-NAME = "DX'CONFIG" OR "IMSAM-ROOTFILE" 083600 OR SET-NAME(1:4) = "ODX'" OR "XODX" 083700 OR SET-NAME(7:5) = "-TREE") 083800 AND INFO-PARM <> 1 083900 CONTINUE 084000 ELSE 084100 MOVE DSET-203(INDEX-203) 084200 TO DSET-NUMBER(DSET-INDEX) 084300 MOVE SET-TYPE TO DSET-TYPE(DSET-INDEX) 084400 MOVE SET-NAME TO DSET-NAME(DSET-INDEX) 084500 SET DSET-INDEX UP BY 1 084600 END-IF 084700 END-IF 084800 END-PERFORM. 084900 085000 085100 2300-COUNT-DATASETS. 085200 MOVE 0 TO NUM-OF-DETAILS. 085300 MOVE 0 TO NUM-OF-MASTERS. 085400 PERFORM VARYING DSET-INDEX FROM 1 BY 1 085500 UNTIL DSET-INDEX > 200 085600 OR DSET-NAME(DSET-INDEX) = SPACES 085700 IF DSET-TYPE(DSET-INDEX) = "D" THEN 085800 ADD 1 TO NUM-OF-DETAILS 085900 ELSE 086000 ADD 1 TO NUM-OF-MASTERS 086100 END-IF 086200 END-PERFORM. 086300 086400 DISPLAY "# of masters = ", NUM-OF-MASTERS, 086500 ", # of details = ", NUM-OF-DETAILS. 086600 086700 IF NUM-OF-MASTERS = 0 OR NUM-OF-DETAILS = 0 086800 DISPLAY "Sorry, DBIMAGE cannot handle having 0" 086900 CALL INTRINSIC "TERMINATE" 087000 END-IF. 087100 087200 IF NUM-OF-DETAILS > NUM-OF-MASTERS 087300 MOVE NUM-OF-DETAILS TO DSET-PLOT-WIDTH 087400 ELSE 087500 MOVE NUM-OF-MASTERS TO DSET-PLOT-WIDTH 087600 END-IF. 087700 COMPUTE PLOT-WIDTH = DSET-PLOT-WIDTH * SINGLE-WIDTH. 087800 087900 IF SPREAD-OUT-FLAG = "X" 088000 COMPUTE PLOT-WIDTH = ((PLOT-WIDTH - 1) 088100 / CHARACTERS-PER-LINE) + 1 088200 COMPUTE PLOT-WIDTH = PLOT-WIDTH * CHARACTERS-PER-LINE 088300 END-IF. 088400 088500 088600 2400-SET-DSET-X-COORDS. 088700 SET SYM-DEX TO 1. 088800 COMPUTE DETL-SPACING 088900 = PLOT-WIDTH / NUM-OF-DETAILS. 089000 COMPUTE MAST-SPACING 089100 = PLOT-WIDTH / NUM-OF-MASTERS. 089200 MOVE .5 TO DETL-COUNTER. 089300 MOVE .5 TO MAST-COUNTER. 089400 PERFORM VARYING DSET-INDEX FROM 1 BY 1 089500 UNTIL DSET-INDEX > 200 089600 OR DSET-NAME(DSET-INDEX) = SPACES 089700 IF DSET-TYPE(DSET-INDEX) = "D" THEN 089800 COMPUTE DSET-X-COORD(DSET-INDEX) = 089900 (DETL-COUNTER * DETL-SPACING) 090000 - HALF-SINGLE-WIDTH 090100 ADD 1 TO DETL-COUNTER 090200 ELSE 090300 COMPUTE DSET-X-COORD(DSET-INDEX) = 090400 (MAST-COUNTER * MAST-SPACING) 090500 - HALF-SINGLE-WIDTH 090600 ADD 1 TO MAST-COUNTER 090700 MOVE SYM-CHAR(SYM-DEX) TO DSET-SYMBOL(DSET-INDEX) 090800 SET SYM-DEX UP BY 1 090900 END-IF 091000 END-PERFORM. 091100 091200 091300 2500-PLOT-DBNAME. 091400 MOVE 0 TO COUNTER. 091500 PERFORM VARYING PBC-DEX FROM 1 BY 1 091600 UNTIL PBC(PBC-DEX) = SPACES 091700 OR PBC(PBC-DEX) = "." 091800 ADD 1 TO COUNTER 091900 END-PERFORM. 092000 092100 MOVE 2 TO BPLOT-Y. 092200 092300 COMPUTE BPLOT-X = PLOT-WIDTH - (8 * COUNTER). 092400 COMPUTE BPLOT-X = BPLOT-X / 2. 092500 092600 PERFORM VARYING PBC-DEX FROM 1 BY 1 092700 UNTIL PBC(PBC-DEX) NOT ALPHABETIC 092800 AND PBC(PBC-DEX) NOT NUMERIC 092900 MOVE PBC(PBC-DEX) TO BPLOT-CHAR 093000 PERFORM S100-PLOT-BIG-CHAR 093100 ADD 8 TO BPLOT-X 093200 END-PERFORM. 093300 093400 093500 2550-SET-MAST-BOTTOM. 093600 MOVE 14 TO MASTER-Y. 093700 PERFORM VARYING DSET-INDEX FROM 1 BY 1 093800 UNTIL DSET-INDEX > 200 093900 OR DSET-NAME(DSET-INDEX) = SPACES 094000 IF DSET-TYPE(DSET-INDEX) = "D" THEN 094100 CONTINUE 094200 ELSE 094300 MOVE DSET-NUMBER(DSET-INDEX) TO DUMMY-INTEGER 094400 CALL INTRINSIC "DBINFO" 094500 USING BASE 094600 DUMMY-INTEGER-ARRAY 094700 MODE104 094800 STATUSS 094900 BUFFER-104 095000 COMPUTE COUNTER = COUNT-104 + 15 095100 IF COUNTER > MASTER-Y 095200 MOVE COUNTER TO MASTER-Y 095300 END-IF 095400 END-IF 095500 END-PERFORM. 095600 095700 095800 2600-LIST-MASTERS. 095900 MOVE NUM-OF-MASTERS TO DISP-NUM. 096000 DISPLAY "... listing items for master datasets ... 0/" 096100 DISP-NUM BACKSPACE-9 NO ADVANCING. 096200 MOVE 0 TO WORK-COUNT. 096300 PERFORM VARYING DSET-INDEX FROM 1 BY 1 096400 UNTIL DSET-INDEX > 200 096500 OR DSET-NAME(DSET-INDEX) = SPACES 096600 IF DSET-TYPE(DSET-INDEX) = "D" THEN 096700 CONTINUE 096800 ELSE 096900 PERFORM 2610-LIST-A-MASTER 097000 PERFORM S050-COUNT 097100 END-IF 097200 END-PERFORM. 097300 DISPLAY DISP-NUM. 097400 097500 097600 2610-LIST-A-MASTER. 097700 MOVE DSET-NUMBER(DSET-INDEX) TO DUMMY-INTEGER. 097800 COMPUTE BPLOT-X = DSET-X-COORD(DSET-INDEX). 097900 CALL INTRINSIC "DBINFO" 098000 USING BASE 098100 DUMMY-INTEGER-ARRAY 098200 MODE104 098300 STATUSS 098400 BUFFER-104. 098500 IF COND = 0 098600 CALL INTRINSIC "DBINFO" 098700 USING BASE 098800 DUMMY-INTEGER-ARRAY 098900 MODE302 099000 STATUSS 099100 BUFFER-302 099200 IF COND = 0 099300 IF ITEM-302 < 0 THEN 099400 COMPUTE ITEM-302 = ITEM-302 * -1 099500 END-IF 099600 ELSE 099700 CALL INTRINSIC "QUIT" USING 1 099800 END-IF 099900 ELSE 100000 CALL INTRINSIC "QUIT" USING 1 100100 END-IF. 100200 COMPUTE PLOT-Y = MASTER-Y - COUNT-104 - 1. 100300 PERFORM VARYING INDEX-104 FROM 1 BY 1 100400 UNTIL INDEX-104 > COUNT-104 100500 IF ITEM-104(INDEX-104) < 0 THEN 100600 COMPUTE ITEM-104(INDEX-104) 100700 = ITEM-104(INDEX-104) * -1 100800 END-IF 100900 MOVE BPLOT-X TO PLOT-X 101000 IF ITEM-104(INDEX-104) = ITEM-302 101100 MOVE "!" TO PLOT-CHAR 101200 PERFORM S200-PLOT-CHAR 101300 END-IF 101400 PERFORM VARYING INDEX-103 FROM 1 BY 1 101500 UNTIL ITEM-103(INDEX-103) 101600 = ITEM-104(INDEX-104) 101700 CONTINUE 101800 END-PERFORM 101900 SET DITEM-INDEX TO INDEX-103 102000 102100 COMPUTE PLOT-X = BPLOT-X + 2 102200 MOVE SPACES TO PLOT-STRING 102300 MOVE DITEM-NAME(DITEM-INDEX) TO PLOT-STRING 102400 PERFORM S150-PLOT-STRING 102500 102600 COMPUTE PLOT-X = BPLOT-X + 19 102700 MOVE " ~" TO BSTRINGS 102800 IF DITEM-COUNT(DITEM-INDEX) > 1 102900 MOVE DITEM-COUNT(DITEM-INDEX) TO NTS-NUMBER 103000 PERFORM S040-NUMBER-TO-STRING 103100 IF DITEM-COUNT(DITEM-INDEX) > 99 103200 MOVE NTS-STRING(1:3) TO BSTRINGS(1:3) 103300 ELSE 103400 IF DITEM-COUNT(DITEM-INDEX) > 9 103500 MOVE NTS-STRING(1:2) TO BSTRINGS(2:2) 103600 ELSE 103700 MOVE NTS-STRING(1:1) TO BSTRINGS(3:1) 103800 END-IF 103900 END-IF 104000 END-IF 104100 MOVE DITEM-LENGTH(DITEM-INDEX) TO NTS-NUMBER 104200 PERFORM S040-NUMBER-TO-STRING 104300 MOVE SPACES TO PLOT-STRING 104400 STRING 104500 BSTRINGS DELIMITED BY "~" 104600 DITEM-TYPE(DITEM-INDEX) DELIMITED BY SIZE 104700 NTS-STRING DELIMITED BY SPACES 104800 INTO PLOT-STRING 104900 PERFORM S150-PLOT-STRING 105000 105100 ADD 1 TO PLOT-Y 105200 END-PERFORM. 105300 105400 105500 2700-PLOT-MASTERS. 105600 MOVE NUM-OF-MASTERS TO DISP-NUM. 105700 DISPLAY "... drawing master datasets ... 0/" 105800 DISP-NUM BACKSPACE-9 NO ADVANCING. 105900 MOVE 0 TO WORK-COUNT. 106000 PERFORM VARYING DSET-INDEX FROM 1 BY 1 106100 UNTIL DSET-INDEX > 200 106200 OR DSET-NAME(DSET-INDEX) = SPACES 106300 IF DSET-TYPE(DSET-INDEX) = "D" THEN 106400 CONTINUE 106500 ELSE 106600 PERFORM 2710-PLOT-A-MASTER 106700 PERFORM S050-COUNT 106800 END-IF 106900 END-PERFORM. 107000 DISPLAY DISP-NUM. 107100 107200 107300 2710-PLOT-A-MASTER. 107400 MOVE SPACES TO PLOT-STRING. 107500 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 107600 MOVE MASTER-Y TO PLOT-Y. 107700 MOVE "--------------------- " TO PLOT-STRING. 107800 PERFORM S150-PLOT-STRING. 107900 108000 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 108100 ADD 1 TO PLOT-Y. 108200 STRING 108300 "\ " DELIMITED BY SIZE 108400 DSET-NAME(DSET-INDEX) DELIMITED BY SIZE 108500 " / " DELIMITED BY SIZE 108600 INTO PLOT-STRING. 108700 PERFORM S150-PLOT-STRING. 108800 108900 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 109000 ADD 1 TO PLOT-Y. 109100 MOVE " \ / " TO PLOT-STRING. 109200 PERFORM S150-PLOT-STRING. 109300 109400 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 109500 ADD 1 TO PLOT-Y. 109600 IF DSET-TYPE(DSET-INDEX) = "A" 109700 MOVE " \ AUTOMATIC / " TO PLOT-STRING 109800 ELSE 109900 MOVE " \ MANUAL / " TO PLOT-STRING 110000 END-IF. 110100 PERFORM S150-PLOT-STRING. 110200 110300 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 110400 ADD 1 TO PLOT-Y. 110500 MOVE " \ MASTER / " TO PLOT-STRING. 110600 PERFORM S150-PLOT-STRING. 110700 110800 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 110900 ADD 1 TO PLOT-Y. 111000 MOVE " \ / " TO PLOT-STRING. 111100 PERFORM S150-PLOT-STRING. 111200 111300 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 111400 ADD 1 TO PLOT-Y. 111500 MOVE " \ / " TO PLOT-STRING. 111600 PERFORM S150-PLOT-STRING. 111700 111800 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 111900 ADD 1 TO PLOT-Y. 112000 MOVE " \ / " TO PLOT-STRING. 112100 PERFORM S150-PLOT-STRING. 112200 112300 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 112400 ADD 1 TO PLOT-Y. 112500 MOVE " \ / " TO PLOT-STRING. 112600 PERFORM S150-PLOT-STRING. 112700 112800 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 112900 ADD 1 TO PLOT-Y. 113000 MOVE " \ / " TO PLOT-STRING. 113100 PERFORM S150-PLOT-STRING. 113200 113300 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 113400 ADD 1 TO PLOT-Y. 113500 MOVE " \ / " TO PLOT-STRING. 113600 PERFORM S150-PLOT-STRING. 113700 113800 COMPUTE PLOT-X = DSET-X-COORD(DSET-INDEX) + 10. 113900 ADD 1 TO PLOT-Y. 114000 MOVE DSET-SYMBOL(DSET-INDEX) TO PLOT-CHAR. 114100 PERFORM S200-PLOT-CHAR. 114200 114300 114400 2800-CHECK-CONNECTIONS. 114500 INITIALIZE CONNECTIONS-TABLE. 114600 SET CON-DEX TO 1. 114700* 114800* GO THROUGH EACH DETAIL, LOGGING CONNECTIONS TO MASTERS 114900* 115000 PERFORM VARYING DSET-INDEX FROM 1 BY 1 115100 UNTIL DSET-INDEX > 200 115200 OR DSET-NAME(DSET-INDEX) = SPACES 115300 IF DSET-TYPE(DSET-INDEX) = "D" THEN 115400 PERFORM 2810-DETL-KEYS 115500 ELSE 115600 CONTINUE 115700 END-IF 115800 END-PERFORM. 115900 116000 SET NUM-CONNECTIONS TO CON-DEX. 116100 SUBTRACT 1 FROM NUM-CONNECTIONS. 116200* 116300* NOW GET THE GREATEST DIFFERENCE IN X COORDS FROM ALL 116400* CONNECTIONS 116500* 116600 MOVE 40 TO COUNTER. 116700 PERFORM VARYING CON-DEX FROM 1 BY 1 116800 UNTIL CON-SYMBOL(CON-DEX) = SPACES 116900 COMPUTE COUNTER2 = 117000 CON-MASTX(CON-DEX) - CON-DETLX(CON-DEX) 117100 IF COUNTER2 < 0 117200 COMPUTE COUNTER2 = COUNTER2 * -1 117300 END-IF 117400 IF COUNTER2 > COUNTER 117500 MOVE COUNTER2 TO COUNTER 117600 END-IF 117700 END-PERFORM. 117800 COMPUTE COUNTER = COUNTER / 4. 117900 COMPUTE DETAIL-Y = MASTER-Y + COUNTER + 12. 118000 118100 118200 2810-DETL-KEYS. 118300 MOVE DSET-NUMBER(DSET-INDEX) TO DUMMY-INTEGER. 118400 CALL INTRINSIC "DBINFO" 118500 USING BASE 118600 DUMMY-INTEGER-ARRAY 118700 MODE301 118800 STATUSS 118900 BUFFER-301. 119000 IF COND NOT = 0 119100 CALL INTRINSIC "QUIT" USING 1 119200 END-IF. 119300 PERFORM VARYING INDEX-301 FROM 1 BY 1 119400 UNTIL INDEX-301 > COUNT-301 119500 COMPUTE CON-DETLX(CON-DEX) = 119600 DSET-X-COORD(DSET-INDEX) + MID-POINT 119700 MOVE DSET-NUMBER(DSET-INDEX) TO CON-DSET(CON-DEX) 119800 PERFORM VARYING DSET-INDEX2 FROM 1 BY 1 119900 UNTIL DSET-NUMBER(DSET-INDEX2) 120000 = DSET-301(INDEX-301) 120100 CONTINUE 120200 END-PERFORM 120300 MOVE ITEM-301(INDEX-301) TO CON-ITEM(CON-DEX) 120400 MOVE SORT-301(INDEX-301) TO CON-SORT(CON-DEX) 120500 COMPUTE CON-MASTX(CON-DEX) = 120600 DSET-X-COORD(DSET-INDEX2) + MID-POINT 120700 MOVE DSET-SYMBOL(DSET-INDEX2) TO CON-SYMBOL(CON-DEX) 120800 SET CON-DEX UP BY 1 120900 END-PERFORM. 121000 121100 121200 2900-DRAW-CONNECTIONS. 121300 MOVE NUM-CONNECTIONS TO DISP-NUM. 121400 DISPLAY "... drawing path connections ... 0/" 121500 DISP-NUM BACKSPACE-9 NO ADVANCING. 121600 MOVE 0 TO WORK-COUNT. 121700 COMPUTE Y-DIFF = DETAIL-Y - MASTER-Y - 11. 121800 COMPUTE FROM-Y = MASTER-Y + 11. 121900 COMPUTE TO-Y = DETAIL-Y. 122000 PERFORM VARYING CON-DEX FROM 1 BY 1 122100 UNTIL CON-SYMBOL(CON-DEX) = SPACES 122200 COMPUTE FROM-X = CON-MASTX(CON-DEX) 122300 COMPUTE TO-X = CON-DETLX(CON-DEX) 122400 MOVE CON-SYMBOL(CON-DEX) TO PLOT-CHAR 122500 COMPUTE X-DIFF = FROM-X - TO-X 122600 IF X-DIFF < 0 122700 COMPUTE X-DIFF = X-DIFF * -1 122800 END-IF 122900 IF X-DIFF > Y-DIFF 123000 PERFORM 2910-LINE-STEPPING-X 123100 ELSE 123200 PERFORM 2920-LINE-STEPPING-Y 123300 END-IF 123400 PERFORM S050-COUNT 123500 END-PERFORM. 123600 DISPLAY DISP-NUM. 123700 123800 123900 2910-LINE-STEPPING-X. 124000 COMPUTE SLOPE = Y-DIFF / X-DIFF. 124100 IF FROM-X < TO-X 124200 MOVE 1 TO STEP 124300 ELSE 124400 MOVE -1 TO STEP 124500 END-IF. 124600 124700 MOVE 0 TO X-TEMP. 124800 PERFORM UNTIL X-TEMP > X-DIFF 124900 COMPUTE Y-TEMP ROUNDED = X-TEMP * SLOPE 125000 COMPUTE PLOT-Y = FROM-Y + Y-TEMP 125100 COMPUTE PLOT-X = FROM-X + (X-TEMP * STEP) 125200 PERFORM S200-PLOT-CHAR 125300 ADD 1 TO X-TEMP 125400 END-PERFORM. 125500 125600 125700 2920-LINE-STEPPING-Y. 125800 COMPUTE SLOPE = X-DIFF / Y-DIFF. 125900 IF FROM-X < TO-X 126000 MOVE 1 TO STEP 126100 ELSE 126200 MOVE -1 TO STEP 126300 END-IF. 126400 126500 MOVE 0 TO Y-TEMP. 126600 PERFORM UNTIL Y-TEMP > Y-DIFF 126700 COMPUTE X-TEMP ROUNDED = Y-TEMP * SLOPE 126800 COMPUTE PLOT-Y = FROM-Y + Y-TEMP 126900 COMPUTE PLOT-X = FROM-X + (X-TEMP * STEP) 127000 PERFORM S200-PLOT-CHAR 127100 ADD 1 TO Y-TEMP 127200 END-PERFORM. 127300 127400 127500 3000-PLOT-DETAILS. 127600 MOVE NUM-OF-DETAILS TO DISP-NUM. 127700 DISPLAY "... drawing detail datasets ... 0/" 127800 DISP-NUM BACKSPACE-9 NO ADVANCING. 127900 MOVE 0 TO WORK-COUNT. 128000 ADD 1 TO DETAIL-Y. 128100 PERFORM VARYING DSET-INDEX FROM 1 BY 1 128200 UNTIL DSET-INDEX > 200 128300 OR DSET-NAME(DSET-INDEX) = SPACES 128400 IF DSET-TYPE(DSET-INDEX) = "D" THEN 128500 PERFORM 3010-PLOT-A-DETAIL 128600 PERFORM S050-COUNT 128700 ELSE 128800 CONTINUE 128900 END-IF 129000 END-PERFORM. 129100 ADD 8 TO DETAIL-Y. 129200 DISPLAY DISP-NUM. 129300 129400 129500 3010-PLOT-A-DETAIL. 129600 MOVE SPACES TO PLOT-STRING. 129700 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 129800 MOVE DETAIL-Y TO PLOT-Y. 129900 MOVE "--------------------- " TO PLOT-STRING. 130000 PERFORM S150-PLOT-STRING. 130100 130200 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 130300 ADD 1 TO PLOT-Y. 130400 STRING 130500 "\ " DELIMITED BY SIZE 130600 DSET-NAME(DSET-INDEX) DELIMITED BY SIZE 130700 " / " DELIMITED BY SIZE 130800 INTO PLOT-STRING. 130900 PERFORM S150-PLOT-STRING. 131000 131100 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 131200 ADD 1 TO PLOT-Y. 131300 MOVE " \ / " TO PLOT-STRING. 131400 PERFORM S150-PLOT-STRING. 131500 131600 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 131700 ADD 1 TO PLOT-Y. 131800 MOVE " \ / " TO PLOT-STRING. 131900 PERFORM S150-PLOT-STRING. 132000 132100 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 132200 ADD 1 TO PLOT-Y. 132300 MOVE " \ DETAIL / " TO PLOT-STRING. 132400 PERFORM S150-PLOT-STRING. 132500 132600 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 132700 ADD 1 TO PLOT-Y. 132800 MOVE " \ / " TO PLOT-STRING. 132900 PERFORM S150-PLOT-STRING. 133000 133100 MOVE DSET-X-COORD(DSET-INDEX) TO PLOT-X. 133200 ADD 1 TO PLOT-Y. 133300 MOVE " ----------- " TO PLOT-STRING. 133400 PERFORM S150-PLOT-STRING. 133500 133600 133700 3100-LIST-DETAILS. 133800 MOVE NUM-OF-DETAILS TO DISP-NUM. 133900 DISPLAY "... listing items for detail datasets ... 0/" 134000 DISP-NUM BACKSPACE-9 NO ADVANCING. 134100 MOVE 0 TO WORK-COUNT. 134200 PERFORM VARYING DSET-INDEX FROM 1 BY 1 134300 UNTIL DSET-INDEX > 200 134400 OR DSET-NAME(DSET-INDEX) = SPACES 134500 IF DSET-TYPE(DSET-INDEX) = "D" THEN 134600 PERFORM 3110-LIST-A-DETAIL 134700 PERFORM S050-COUNT 134800 ELSE 134900 CONTINUE 135000 END-IF 135100 END-PERFORM. 135200 DISPLAY DISP-NUM. 135300 135400 135500 3110-LIST-A-DETAIL. 135600 MOVE DSET-NUMBER(DSET-INDEX) TO DUMMY-INTEGER. 135700 COMPUTE BPLOT-X = DSET-X-COORD(DSET-INDEX). 135800 MOVE DETAIL-Y TO PLOT-Y. 135900 CALL INTRINSIC "DBINFO" 136000 USING BASE 136100 DUMMY-INTEGER-ARRAY 136200 MODE104 136300 STATUSS 136400 BUFFER-104. 136500 IF COND = 0 136600 CALL INTRINSIC "DBINFO" 136700 USING BASE 136800 DUMMY-INTEGER-ARRAY 136900 MODE302 137000 STATUSS 137100 BUFFER-302 137200 IF COND = 0 137300 IF ITEM-302 < 0 THEN 137400 COMPUTE ITEM-302 = ITEM-302 * -1 137500 END-IF 137600 ELSE 137700 CALL INTRINSIC "QUIT" USING 1 137800 END-IF 137900 ELSE 138000 CALL INTRINSIC "QUIT" USING 1 138100 END-IF. 138200 PERFORM VARYING INDEX-104 FROM 1 BY 1 138300 UNTIL INDEX-104 > COUNT-104 138400 MOVE BPLOT-X TO PLOT-X 138500 IF ITEM-104(INDEX-104) < 0 138600 COMPUTE ITEM-104(INDEX-104) = 138700 ITEM-104(INDEX-104) * -1 138800 END-IF 138900 IF ITEM-104(INDEX-104) = ITEM-302 139000 MOVE "!" TO PLOT-CHAR 139100 PERFORM S200-PLOT-CHAR 139200 ADD 1 TO PLOT-X 139300 END-IF 139400 PERFORM VARYING INDEX-103 FROM 1 BY 1 139500 UNTIL ITEM-103(INDEX-103) 139600 = ITEM-104(INDEX-104) 139700 CONTINUE 139800 END-PERFORM 139900 SET DITEM-INDEX TO INDEX-103 140000 140100 MOVE SPACES TO PLOT-STRING 140200* 140300* THROW IN SYMBOL IF A KEY 140400* 140500 MOVE 0 TO SORT-ITEM 140600 PERFORM VARYING CON-DEX FROM 1 BY 1 140700 UNTIL CON-SYMBOL(CON-DEX) = SPACES 140800 IF CON-DSET(CON-DEX) = DSET-NUMBER(DSET-INDEX) 140900 AND CON-ITEM(CON-DEX) = ITEM-104(INDEX-104) 141000 MOVE CON-SYMBOL(CON-DEX) TO PLOT-CHAR 141100 PERFORM S200-PLOT-CHAR 141200 MOVE CON-SORT(CON-DEX) TO SORT-ITEM 141300 END-IF 141400 END-PERFORM 141500 141600 COMPUTE PLOT-X = BPLOT-X + 3 141700 MOVE DITEM-NAME(DITEM-INDEX) TO PLOT-STRING 141800 PERFORM S150-PLOT-STRING 141900 142000 COMPUTE PLOT-X = BPLOT-X + 20 142100 MOVE " ~" TO BSTRINGS 142200 IF DITEM-COUNT(DITEM-INDEX) > 1 142300 MOVE DITEM-COUNT(DITEM-INDEX) TO NTS-NUMBER 142400 PERFORM S040-NUMBER-TO-STRING 142500 IF DITEM-COUNT(DITEM-INDEX) > 99 142600 MOVE NTS-STRING(1:3) TO BSTRINGS(1:3) 142700 ELSE 142800 IF DITEM-COUNT(DITEM-INDEX) > 9 142900 MOVE NTS-STRING(1:2) TO BSTRINGS(2:2) 143000 ELSE 143100 MOVE NTS-STRING(1:1) TO BSTRINGS(3:1) 143200 END-IF 143300 END-IF 143400 END-IF 143500 MOVE DITEM-LENGTH(DITEM-INDEX) TO NTS-NUMBER 143600 PERFORM S040-NUMBER-TO-STRING 143700 MOVE SPACES TO PLOT-STRING 143800 STRING 143900 BSTRINGS DELIMITED BY "~" 144000 DITEM-TYPE(DITEM-INDEX) DELIMITED BY SIZE 144100 NTS-STRING DELIMITED BY SPACES 144200 INTO PLOT-STRING 144300 PERFORM S150-PLOT-STRING 144400 ADD 1 TO PLOT-Y 144500 IF SORT-ITEM NOT = 0 144600 PERFORM VARYING INDEX-103 FROM 1 BY 1 144700 UNTIL ITEM-103(INDEX-103) 144800 = SORT-ITEM 144900 CONTINUE 145000 END-PERFORM 145100 SET DITEM-INDEX TO INDEX-103 145200 COMPUTE PLOT-X = BPLOT-X + 4 145300 MOVE SPACES TO PLOT-STRING 145400 STRING 145500 "(SORT:" DELIMITED BY SIZE 145600 DITEM-NAME(DITEM-INDEX) DELIMITED BY SPACES 145700 ")" DELIMITED BY SIZE 145800 INTO PLOT-STRING 145900 PERFORM S150-PLOT-STRING 146000 ADD 1 TO PLOT-Y 146100 END-IF 146200 END-PERFORM. 146300 IF PLOT-Y > MASTER-Y 146400 MOVE PLOT-Y TO MASTER-Y 146500 END-IF. 146600 146700 146800 3200-PRINT-IT. 146900 OPEN OUTPUT PRINTFILE. 147000 COMPUTE HORIZONTAL-PAGES = 147100 PLOT-WIDTH / CHARACTERS-PER-LINE. 147200 147300 PERFORM UNTIL PLOT-INIT(MASTER-Y) = "X" 147400 SUBTRACT 1 FROM MASTER-Y 147500 END-PERFORM. 147600 COMPUTE VERTICAL-PAGES = 147700 (MASTER-Y - 1) / LINES-PER-PAGE. 147800 147900 COMPUTE NTS-NUMBER = HORIZONTAL-PAGES + 1. 148000 IF NTS-NUMBER = 1 THEN 148100 MOVE "Your picture will be 1 page wide and |" 148200 TO COMMAND-LINE 148300 ELSE 148400 MOVE SPACES TO COMMAND-LINE 148500 PERFORM S040-NUMBER-TO-STRING 148600 STRING "Your picture will be " DELIMITED BY SIZE 148700 NTS-STRING DELIMITED BY SPACE 148800 " pages wide and |" DELIMITED BY SIZE 148900 INTO COMMAND-LINE 149000 END-IF. 149100 COMPUTE NTS-NUMBER = VERTICAL-PAGES + 1. 149200 IF NTS-NUMBER = 1 THEN 149300 STRING COMMAND-LINE DELIMITED BY "|" 149400 "1 page tall. |" DELIMITED BY SIZE 149500 INTO COMMAND-LINE 149600 ELSE 149700 PERFORM S040-NUMBER-TO-STRING 149800 STRING COMMAND-LINE DELIMITED BY "|" 149900 NTS-STRING DELIMITED BY SPACE 150000 " pages tall. |" DELIMITED BY SIZE 150100 INTO COMMAND-LINE 150200 END-IF. 150300 STRING COMMAND-LINE DELIMITED BY "|" 150400 "The minimum dimensions" DELIMITED BY SIZE 150500 INTO COMMAND-LINE. 150600 DISPLAY COMMAND-LINE. 150700 MOVE SPACES TO COMMAND-LINE. 150800 COMPUTE NTS-NUMBER = DSET-PLOT-WIDTH * SINGLE-WIDTH. 150900 PERFORM S040-NUMBER-TO-STRING. 151000 STRING "into which this picture c" DELIMITED BY SIZE 151100 "ould have fit: " DELIMITED BY SIZE 151200 NTS-STRING DELIMITED BY SPACES 151300 " columns by |" DELIMITED BY SIZE 151400 INTO COMMAND-LINE. 151500 MOVE MASTER-Y TO NTS-NUMBER. 151600 PERFORM S040-NUMBER-TO-STRING. 151700 STRING COMMAND-LINE DELIMITED BY "|" 151800 NTS-STRING DELIMITED BY SPACES 151900 " rows." DELIMITED BY SIZE 152000 INTO COMMAND-LINE. 152100 DISPLAY COMMAND-LINE. 152200 MOVE SPACES TO COMMAND-LINE. 152300 152400 COMPUTE WORK-COUNT = (VERTICAL-PAGES + 1) 152500 * (HORIZONTAL-PAGES + 1) 152600 MOVE WORK-COUNT TO DISP-NUM. 152700 DISPLAY "... printing pages ... 0/" 152800 DISP-NUM BACKSPACE-9 NO ADVANCING. 152900 153000 IF QUIET-FLAG = SPACES 153100 PERFORM 3210-COVER-PAGE 153200 END-IF. 153300 153400 MOVE 0 TO WORK-COUNT. 153500 MOVE 0 TO PAGE-Y. 153600 PERFORM UNTIL PAGE-Y > VERTICAL-PAGES 153700 MOVE 0 TO PAGE-X 153800 PERFORM UNTIL PAGE-X > HORIZONTAL-PAGES 153900 COMPUTE CURRENT-Y = PAGE-Y * LINES-PER-PAGE + 1 154000 COMPUTE BPLOT-Y = (PAGE-Y + 1) * LINES-PER-PAGE 154100 MOVE SPACES TO PAGE-FLAG 154200 PERFORM UNTIL CURRENT-Y > BPLOT-Y 154300 IF PLOT-INIT(CURRENT-Y) = SPACES 154400 MOVE SPACES TO PLOT-LINE 154500 ELSE 154600 READ PLOTFILE 154700 INVALID KEY MOVE SPACES TO PLOT-LINE 154800 END-READ 154900 END-IF 155000 155100 SET PRINT-DEX TO 1 155200 MOVE SPACES TO PRINT-REC 155300 COMPUTE PLOT-X = PAGE-X * CHARACTERS-PER-LINE + 1 155400 SET PLOT-DEX TO PLOT-X 155500 ADD CHARACTERS-PER-LINE TO PLOT-X 155600 PERFORM UNTIL PLOT-DEX > PLOT-X 155700 MOVE PLOTFILECHAR(PLOT-DEX) 155800 TO PRINT-CHAR(PRINT-DEX) 155900 SET PRINT-DEX UP BY 1 156000 SET PLOT-DEX UP BY 1 156100 IF PRINT-DEX > 4000 156200 DISPLAY "Oops...internal error, ", 156300 "PRINT-DEX = ", PRINT-DEX 156400 CALL INTRINSIC "TERMINATE" 156500 END-IF 156600 END-PERFORM 156700 IF PAGE-FLAG = SPACES 156800 IF QUIET-FLAG <> SPACES AND WORK-COUNT = 0 156900 WRITE PRINT-REC AFTER ADVANCING 0 157000 ELSE 157100 WRITE PRINT-REC AFTER ADVANCING PAGE 157200 END-IF 157300 MOVE "X" TO PAGE-FLAG 157400 ELSE 157500 WRITE PRINT-REC 157600 END-IF 157700 ADD 1 TO CURRENT-Y 157800 END-PERFORM 157900 ADD 1 TO PAGE-X 158000 PERFORM S050-COUNT 158100 END-PERFORM 158200 ADD 1 TO PAGE-Y 158300 END-PERFORM. 158400 CLOSE PRINTFILE. 158500 DISPLAY DISP-NUM. 158600 158700 158800 3210-COVER-PAGE. 158900 MOVE SPACES TO PRINT-REC. 159000 MOVE " DBIMAGE 1.2ss by C. Glenn" TO PRINT-REC. 159100 WRITE PRINT-REC AFTER ADVANCING PAGE. 159200 159300 MOVE HORIZONTAL-PAGES TO COVERPAGE-ACROSS. 159400 ADD 1 TO COVERPAGE-ACROSS. 159500 159600 MOVE COVERPAGE-1 TO PRINT-REC. 159700 WRITE PRINT-REC AFTER ADVANCING 3. 159800 MOVE COVERPAGE-2 TO PRINT-REC. 159900 WRITE PRINT-REC. 160000 MOVE COVERPAGE-3 TO PRINT-REC. 160100 WRITE PRINT-REC. 160200 MOVE COVERPAGE-4 TO PRINT-REC. 160300 WRITE PRINT-REC. 160400 MOVE COVERPAGE-5 TO PRINT-REC. 160500 WRITE PRINT-REC. 160600 MOVE COVERPAGE-6 TO PRINT-REC. 160700 WRITE PRINT-REC. 160800 MOVE COVERPAGE-7 TO PRINT-REC. 160900 WRITE PRINT-REC. 161000 MOVE COVERPAGE-8 TO PRINT-REC. 161100 WRITE PRINT-REC. 161200 MOVE COVERPAGE-9 TO PRINT-REC. 161300 WRITE PRINT-REC. 161400 161500 MOVE " You will notice, after inspecting the diag" TO CP41. 161600 MOVE "ram, that a unique symbol is generated for e" TO CP42. 161700 MOVE "ach master dataset. These symbols make up " TO CP43. 161800 MOVE COVERPAGE-44 TO PRINT-REC. 161900 WRITE PRINT-REC AFTER ADVANCING 3. 162000 162100 MOVE "the paths seen connecting the master and det" TO CP41. 162200 MOVE "ail datasets. These symbols also appear pre" TO CP42. 1623