* Name - WU * Called By - PROC * Description - Utilities - Where Used * Version - 25 Nov 2000 - INTERNET * Written - Nine Elms Solutions Ltd * *<----------------------------------- COPYRIGHT NOTICE -----------------------------------> * Copyright 2000 - code@nineelms.com * * THIS HEADER MUST REMAIN INTACT IN THIS AND ANY CHANGED VERSION OF THIS ROUTINE * * WU may be used and modified free of charge by anyone so long as this * copyright notice and comments above remain intact. By using this code you * agree to indemnify Nine Elms Solutions Ltd from any liability that may arise from its use. * * Selling the code for this program without prior written consent is * expressly forbidden. In other words, please ask first before you try and * make money off my program. * * Obtain permission before redistributing this software over the Internet or * in any other medium. In all cases copyright and the header must remain intact * *<------------------------------------------------------------------------------------------> * * EQU TILDE TO CHAR(126) EQU BUZ TO CHAR(7), SVM TO CHAR(252), VM TO CHAR(253), AM TO CHAR(254) REVON = '' ;* Set to your own Preference REVOFF = '' ;* Set to your own Preference EOL = @(-4) EOS = @(-3) ESC = CHAR(27) COMMAND = SENTENCE() PROGRAMNAME = FIELD(COMMAND,' ',2) PROMPT "" TODAY = OCONV(DATE(),'D4') BUF = '' STARTLINE = 8 * OPEN "WHERE.USED" TO WHERE.USED ELSE X = 'WHERE.USED' ;GOTO 9001 OPEN 'DICT','WHERE.USED' TO DSL ELSE X = 'DICT WHERE.USED' ;GOTO 9001 * READV LAST.UPD FROM DSL,'LAST.UPDATE',1 ELSE LAST.UPD = '' VOIDIT = '*' ICOMS = '*<' * PROGNAME="WU.REPORT" HDRS = STR('*',79) HDRP = STR('*',119) SYST = 'Nine Elms Solutions Ltd' SCREENTITLE = "Utilities - Where Used" DIM COL(50),ROW(50),MAX(50),IVAL(50),HMESS(50),SC(50),SPC(50),JMASK(50) MAT SC = '' ;MAT COL = '' ;MAT ROW = '';MAT MAX = '';MAT IVAL = '' ;MAT HMESS = '';MAT SPC = '0' * MAX(1) = 1 ;MAX(2) = 1 ;MAX(3) = 35 ;MAX(4) = 3 ;MAX(5) = 3 FOR J = 1 TO 4 COL(J) = '32' ;ROW(J) = 3+J ;SPC(J) = '31' ;IVAL(J) = 'X '; JMASK(J)="L#":MAX(J) NEXT J IVAL(3) = 'X.-? ' HFLAG = '1' ;* Help messages set to on GOSUB 1000 ;* Set up screen variables GOSUB 2000 ;* Initialise Help / Error messages GOSUB 4000 ;* Set up Search Array * * Initialise variables * FINISHED = 0 SREC = '' SREC<4> = 'YES' IF PROGRAMNAME NE '' THEN SREC<3> = PROGRAMNAME LOOP UNTIL FINISHED DO INP = '' GOSUB 3000 ;* Call screen setup routines CALL USEROPTS(ICOMS) FOR FLD = 1 TO 4 UNTIL FINISHED IF HFLAG THEN MSG = HMESS(FLD)'L#75' ELSE MSG='' CRT @(0,23):EOL:@(0,23):MSG: INP = SREC CRT @(COL(FLD),ROW(FLD)):INP JMASK(FLD) :@(COL(FLD),ROW(FLD)):;INPUT INP IF INP = TILDE THEN INP = SREC CRT @(0,21):SPACE(78): IF INP = 'E' THEN INP = VOIDIT IF INP = '' THEN INP = SREC BEGIN CASE * CASE INP = VOIDIT INP = '*' FINISHED = 1 * CASE INP = '<' CRT @(COL(FLD),ROW(FLD)):SREC FLD = FLD-2 IF FLD LT 1 THEN FLD = 1 * CASE FLD = 1 ;* Screen or Print IF INP = '' THEN INP = 'S' IF NOT(INP='S' OR INP='P') THEN FLD=FLD-1 END ELSE SREC = INP RUNTYPE = INP IF RUNTYPE ='S' THEN COMMENT = 'SCREEN' ELSE COMMENT = 'HARDCOPY' CRT @(COL(FLD),ROW(FLD)):COMMENT'L#20' END * CASE FLD = 2 ;* CALLS or Uses IF INP = '' THEN INP = 'C' IF NOT(INP = 'C' OR INP = 'U') THEN FLD = FLD-1 END ELSE IF INP = 'C' THEN COMMENT = 'CALLS' END ELSE COMMENT = 'USES' END COMMENT = COMMENT'L#7' CRT @(COL(FLD),ROW(FLD)):COMMENT SREC = INP END * CASE FLD = 3 ;* Program Name IF INP = '' THEN INP = SREC IF INP = '' THEN FLD = FLD-1 END ELSE IF INP = '?' THEN EXIT = 0 X1 = 'FULL.SCREENP' ;* Partial Screen* LOOP UNTIL EXIT DO PAGE.NO=1 PAGE.OPTION='' CALL PAGING(PAGE.TITLE,X1,Y1,X2,Y2,"",DATA.ARRAY,COL.HEADER,COL.WIDTH,COL.FORMAT,COL.JUST,PAGE.NO,PAGE.TOTAL,"",PAGE.OPTION) BEGIN CASE * CASE PAGE.OPTION='E' EXIT=1 INP = '' * CASE PAGE.OPTION MATCHES '1N0N' AND PAGE.OPTION GE '1' INP = DATA.ARRAY<1,PAGE.OPTION> EXIT=1 * CASE 1 NULL END CASE REPEAT GOSUB 3000 FOR J = 1 TO 3 CRT @(COL(J),ROW(J)):SREC NEXT J END * IF INP = '' THEN INP = SREC<3> READ REC FROM WHERE.USED,INP THEN CHK=0 FOR XX = 2 TO 6 IF REC NE '' THEN CHK = 1 NEXT XX IF CHK THEN LIBRARY = REC<1> IF REC<1> = 'FILE' THEN SREC<2> = 'U' COMMENT = 'USES' CRT @(COL(2),ROW(2)):COMMENT'L#7' END SREC = INP CRT @(COL(FLD),ROW(FLD)):SPACE(MAX(FLD)):@(COL(FLD)):SREC END ELSE SREC = INP CRT @(COL(FLD),ROW(FLD)):SPACE(MAX(FLD)):@(COL(FLD)):SREC CRT @(1,21):'Program Name ':INP:', is not called or Used by any Program, Press RTN ':;INPUT TX CRT @(0,21):EOL: FLD = FLD-1 END END ELSE CRT @(5,21):'Program Name ':INP:', is not recognised in WHERE.USED File, Press RTN ':;INPUT TX FLD = FLD-1 END END * CASE FLD = 4 IF INP # 'YES' THEN FLD = 0 END ELSE GOSUB 6000 END END CASE NEXT FLD REPEAT IF INP = 'E' OR INP = VOIDIT THEN GOTO 7000 * * Setup screen layout * 1000 SC(1) = '(S)creen or (P)rint' SC(2) = '(C)alls OR (U)sed In' SC(3) = 'Program Name' SC(4) = 'Confirm above details correct' FOR J = 1 TO 4 IF SC(J) # '' THEN SC(J) = REVON:SC(J):REVOFF NEXT J RETURN * * Initialise Help messages * 2000 HMESS(1) = "Enter 'S' or 'RTN' for screen display or 'P' for hardcopy print.." HMESS(2) = "Enter whether Where (U)sed or by (C)alled from " HMESS(3) = "Enter Program, Filename or '?' for Index, for which Information is required" HMESS(4) = "Enter 'YES' to confirm details,'*' to void run" RETURN * 3000 *** Displays skeleton screen * CRT CHAR(12):@(0,0):TODAY : @(20,0):SCREENTITLE:@(65):PROGNAME 'R#15' G = LEN(SYST) SP = INT((80-G)/2) CRT @(0,1):SPACE(SP):SYST * * Redisplay data area of screen * 3100 SCRIMAGE='' FOR S = 1 TO 4 SCRIMAGE = SCRIMAGE: @(COL(S)-SPC(S),ROW(S)):SC(S):@(COL(S)):STR('_',MAX(S)) NEXT S SCRIMAGE = SCRIMAGE : @(1,10):'Remember to REBUILD the WHERE.USED data when Programs have' SCRIMAGE = SCRIMAGE : @(1,11):'been modified as the line references will be out of Date' SCRIMAGE = SCRIMAGE : @(1,13):'Run routine "CALL.USED" from TCL to rebuild....' IF LAST.UPD THEN SCRIMAGE = SCRIMAGE : @(1,14):'Last rebuilt ':OCONV(LAST.UPD,'D4') END PRINT SCRIMAGE RETURN * * Build up Search Index * 4000 READ ARRAY FROM DSL,'INDEX' ELSE ARRAY = '' IF ARRAY = '' THEN CRT @(-1): @(10,10):'Please wait rebuilding Index.': CNT = 0 SELECT WHERE.USED ENDED = 0 LOOP READNEXT ITM ELSE ENDED = 1 UNTIL ENDED DO READ DET FROM WHERE.USED,ITM THEN CNT = CNT + 1 IF CNT/50 = INT(CNT/50) THEN CRT '.': LOCATE ITM IN ARRAY<1> BY 'AL' SETTING POS ELSE INS ITM BEFORE ARRAY<1,POS> INS DET<1>[1,11] BEFORE ARRAY<2,POS> END END REPEAT WRITE ARRAY ON DSL,'INDEX' END * * Build up PAGING Window Details * PAGE.TITLE = ' Selection Screen for Where used Program ' Y1 = STARTLINE X2 = 79 Y2 = 20 PAGE.NAME = '' COL.HEADER = '' COL.HEADER<1> = 'Program' COL.HEADER<2> = 'Library' COL.WIDTH = '18':AM:'11' COL.FORMAT = '' COL.JUST = 'L':AM:'L' PAGE.NO = 1 PAGE.UIMS = '' PAGE.TOTAL = '' * * Build up Data Array * DATA.ARRAY = ARRAY RETURN * * End of Run Procedures * 6000 * * Produce the required report * * Firstly sort out the Dictionary FOUND = 1 READ DET FROM DSL,'WHERE.USED' ELSE FOUND = 0 IF FOUND THEN IF SREC<2> = 'U' THEN * TXT = 'V;;2' TXT = '' END ELSE TXT = 'V;;4' END DET<8> = TXT WRITE DET ON DSL,'WHERE.USED' END ELSE CRT @(5,21):'Dictionary Corrupted (WHERE.USED), needs investigating - Press RTN':;INPUT TX STOP END * IF SREC<2> = 'C' THEN TXT = 'LIST WITHIN WHERE.USED "':SREC<3>:'" 0 4 5 6' END ELSE TXT = 'LIST WHERE.USED "':SREC<3>:'" 0 2 3' END * BEGIN CASE * CASE SREC<2> = 'U' AND REC<2> = '' CRT @(5,21):'No USED by details for this Program':;INPUT TX * CASE SREC<2> = 'C' AND REC<4> = '' CRT @(5,21):'No CALLED routines for this Program':;INPUT TX * CASE 1 CRT @(0,16):"Now producing the ":SCREENTITLE:" - Please Wait" IF RUNTYPE = 'S' THEN X = TXT HEAD = ' HEADING "':HDRS HEAD = HEAD:"'L'WU.REPORT - ":SYST:" - 'TCL'":SCREENTITLE:" Page: 'PCL'" IF LIBRARY = 'FILE' THEN HEAD = HEAD : ' Useage of File Name : - ':SREC<3>: "'CL'" END ELSE HEAD = HEAD : 'Program File : - ':LIBRARY:', Program Name : - ':SREC<3>: "'CL'" END HEAD = HEAD:HDRS:'" ID-SUPP' HEAD = HEAD:' FOOTING "Enter Ctrl X to exit display, RTN to Page"' X = X:HEAD EXECUTE X CRT @(15,23):"Press RTN :":;INPUT TX END ELSE X = TXT HEAD = ' HEADING "':HDRP HEAD = HEAD:"'L'WU.REPORT - ":SYST:" - 'TCL'":SCREENTITLE:" Page: 'PCL'" IF LIBRARY = 'FILE' THEN HEAD = HEAD : ' Useage of File Name : - ':SREC<3>: "'CL'" END ELSE HEAD = HEAD : 'Program File : - ':LIBRARY:', Program Name : - ':SREC<3>: "'CL'" END HEAD = HEAD:HDRP:'" ID-SUPP LPTR' X = X:HEAD EXECUTE X PRINTER CLOSE END END CASE RETURN * 7000 * STOP * * Fatal Error Routines * 9000 MESS = "This Program Must be Run from a Proc";GOTO 9999 9001 MESS = "No ":X:" file";GOTO 9999 9002 MESS = "You are not privileged to use this option";GOTO 9999 * 9999 PRINT @(0,23):EOL:BUZ:@(0,23):MESS: INPUT ANS,1: END