*     Name        - LISTCOL
*     Called By   - MD Command
*     Description - Utilities - Produce SORTED list of File Items
*     Version     - 25 Nov 2000 - INTERNET
*     Written - Nine Elms Solutions Ltd
*
*<-----------------------------------  COPYRIGHT NOTICE  ----------------------------------->
*                 Copyright 2000 - email code@nineelms.com
*
*     THIS HEADER MUST REMAIN INTACT IN THIS AND ANY CHANGED VERSION OF THIS ROUTINE
*
* LISTCOL 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
*
* Install this Program in a directory named WEBPROGS or change the Program file for the
* SORT2 SORT3 etc items to reflect your UTILITIES directory
*<------------------------------------------------------------------------------------------>
*
   PROMPT ""
*
   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)
   ERR    = ''

   OPEN 'MD' TO MD ELSE ERR = ERR : 'MD '
   IF ERR NE '' THEN GOTO 9200

   READ MDITEM FROM MD,'LISTCOL' THEN

     READ CHKITEM FROM MD,'SORT2' ELSE
       MDITEM<5> ='WEBPROGS LISTCOL' ; * See note above!!!!
       WRITE MDITEM ON MD,'SORT2'
       WRITE MDITEM ON MD,'SORT3'
       WRITE MDITEM ON MD,'SORT4'
       WRITE MDITEM ON MD,'SORT5'
       WRITE MDITEM ON MD,'SORT6'
     END
   END
   COMMAND  = SENTENCE()
   COMMAND  = TRIM(COMMAND)
   OPTIONS  = FIELD(COMMAND,'(',2)
*
   IF INDEX(OPTIONS,'P',1) THEN
     MAXCOLS = 6 
   END ELSE MAXCOLS = 6
*
   COMMAND1 = FIELD(COMMAND,'(',1)
   FLD1     = FIELD(COMMAND1,' ',1)
   FNAME    = FIELD(COMMAND1,' ',2)
*
* Check for Dictionary
*
   DICTFLAG = 0

   IF FNAME = 'DICT' THEN
     DICTFLAG = 1
     FNAME    = FIELD(COMMAND1,' ',3)
     FILENAME = COMMAND1[11,999]
   END ELSE
     FILENAME = COMMAND1[7,999]
   END

   IF FNAME = '' THEN GOTO 9202
   IF FNAME = '?' THEN GOTO 9203
   READV FITEM FROM MD,FNAME,1 ELSE GOTO 9204
   IF NOT(FITEM[1,1] = 'D' OR FITEM = 'Q') THEN GOTO 9204
*
   IF DICTFLAG THEN
     HEADFN   = 'Items in File Dictionary : ':FNAME
   END ELSE
     HEADFN   = 'Items in File : ':FNAME
   END

   FILL     = INT((SYSTEM(2)-LEN(HEADFN)-19)/2)
   HEAD     = ' HEADING "': "'D'" : SPACE(FILL) : HEADFN : SPACE(FILL) : "PAGE 'PL'" : '"'
   COLS     = FLD1[5,1]
   IF COLS LT "1" OR COLS GT MAXCOLS THEN COLS = MAXCOLS

   IF DICTFLAG THEN
     VERB     = 'SORT-LABEL ONLY DICT ':FILENAME : ' NE "':FILENAME[2,999] :'" ': HEAD
   END ELSE
     VERB     = 'SORT-LABEL ONLY ':FILENAME : HEAD
   END
*
   IF OPTIONS NE '' THEN
     VERB  = VERB : ' (':OPTIONS
   END
*
   ROWS   = 1
   SKIP   = 0
   INDENT = 0
   SIZE   = 0
   SPACE  = 1
*
* Find Current Col width of Screen
*
   SIZE  = INT((SYSTEM(2)-COLS)/COLS)
   DATA COLS:",":ROWS:",":SKIP:",":INDENT:",":SIZE:",":SPACE:",C"
   EXECUTE VERB
   STOP
*
* Error Routine
*
   9200 MESS = 'The following file(s) are not on this Account : "':ERR:'"' ;GOTO 9998
   9201 MESS = 'Must be run from a PROC' ;GOTO 9998
   9202 MESS = 'Filename must be specified, enter "':FLD1:' ?" for more information!' ;GOTO 9998
   9203 *
   CRT @(-1)
   CRT @(35,0):"SORTn  USEAGE"
   CRT @(10,7):"FORMAT IS 'SORTn Filename, DICT, Selection criteria, (Options'"
   CRT @(10,9)  :"n                  - the number of Columns"
   CRT @(10,10) :"DICT (Optional)    - only enter if a DICTIONARY is to be listed"
   CRT @(10,11) :"Filename           - a valid Filename on the Account"
   CRT @(10,12) :"Selection Criteria - Enter if only specific records are needed"
   CRT @(10,13) :"Options            - can be null or 'P' for printed report"
   CRT @(10,15):"Press RTN ":;INPUT TX
   STOP
   9204 MESS = 'A valid Filename must be entered, enter "':FLD1:' ?" for more information!' ;GOTO 9998
*
   9998 CRT @(0,22):MESS:;INPUT TX
   END