Back in 1999 I had to break very large files into Excel-sized chunks and
came up with a BREAK.MY.LIST program that does pretty much the same thing,
only different...I originally wrote it for my non-programmer buddy Leo, and
found myself using it a couple of months later...heh....
(Unidata, using M2K includes)
* Release Information
* MANAGE-2000 - VSI - Release 6.2e
* BREAK.MY.LIST - Written, just for my Buddy, Leo, 08-06-99
Version="~Ver=~6.2.8~1569099109~"
*===/============================================================\===*
* / Written by Allen E. Elwood 08/06/99 - AK Savage Software \ * =We=
*<------------------------------------------------------------------>* =Be=
* \ (c) Copyright 1999 by AK Savage Software - All Rights Reserved / *
=Bad!=
*===\============================================================/===*
***
* Permission hereby granted per Allen Elwood to allow this code to be
modified
* and shared under an open-source license. Please feel free to enhance and
improve
* as you see fit, but retain all header information you see here.
*
*** Gnu General Public License
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details. www.gnu.org
*
***
* Revision Log
* Who..... When.....
Why................................................................
* AElwood 1999Aug06 Initial coding.
* Andrew 1999Aug06 Added command line argument feature. Changes marked
* with *[001]. Added open source license info with
* original author's permission. Thanks Allen!
*
***
*
*#* COPY COPY.TOOLS.BP STANDARD.VARIABLES.2 (REPLACING PGM.NAME BY
BREAK.MY.LIST, FN.NAME BY BREAK.MY.LIST, IO.OPEN.OPTS BY
TERM.DATA:LOCK:XREF) ;*#* Copied Source Follows (08-06-99)
$INCLUDE STANDARD.COMMON.VARIABLES FROM COPY.TOOLS.BP
$INCLUDE STANDARD.COMMON.APP.PROGRAMS FROM COPY.TOOLS.BP
$INCLUDE COM500 FROM COPY.TOOLS.BP
$INCLUDE STANDARD.VARIABLES.END FROM COPY.TOOLS.BP
PGM.NAME='BREAK.MY.LIST'; FN.NAME ='BREAK.MY.LIST'
CALL IO.OPEN('TERM.DATA:LOCK:XREF',PASSWORDS)
*#*
*===========================================================================
====
* Note that this program remains the intellectual property of Allen E.
Elwood
* and may not be re-sold under any conditions. You can give it away, but if
* you charge for it, you'll find me knocking on your front door, probably,
* really late at night. Also note that this program is not guaranteed to
* do ANYTHING AT ALL. No functionality is implied or expressed.
* Also note that it looks awful, I was in a hurry....
*===========================================================================
====
*#* OPEN SAVEDLISTS ;*#* Open Source Follows
IF PASSWORDS # '' THEN CALL SUB.PASSWORDS(PASSWORDS)
OPEN.ERROR = ''
OPEN '', 'SAVEDLISTS' TO SAVEDLISTS ELSE OPEN.ERROR<-1> = 'SAVEDLISTS'
IF OPEN.ERROR # '' THEN
CALL SCREEN.MSG('OPEN ERRORS':AM:OPEN.ERROR)
GO 999
END
COM_FILES.LIST<1,-1> = 'SAVEDLISTS'
*#*
*===========================================================================
====
* get info
PARMS = CONVERT (" ",@FM, UPCASE(TRIM(@SENTENCE)))
;*[001]
DEL PARMS<1>
;*[001]
IF PARMS THEN
;*[001]
IN.LIST = PARMS<1>
;*[001]
RT.LIST = PARMS<2>
;*[001]
SAMPLE.MOD = PARMS<3>
;*[001]
MONGO = "Y"
;*[001]
IF NOT (SAMPLE.MOD) THEN
;*[001]
CRT "Usage: BREAK.MY.LIST InputListName RootListName
SampleSize";*[001]
STOP
;*[001]
END
;*[001]
END ELSE
;*[001]
*
PRINT CLR:B4.T
PRINT ' This utility will break a list up into smaller lists.
'
PRINT ' You will be asked for the source list name, the root name
'
PRINT ' and for the desired size of the new, smaller, lists to make.
'
PRINT ' Theses new "sub-lists" will be the root name with a number
appended.'
PRINT ' Example: A root name of DAISY would create sub-lists
'
PRINT ' Named DAISY1 DAISY2 DAISY3... Until the list source list is
expired.'
PRINT AFT.T
PRINT ' Enter the list name to break up : ':;INPUT IN.LIST
PRINT ' Enter the root name for sub-lists : ':;INPUT RT.LIST
PRINT ' Enter sample size for the sub-lists : ':;INPUT SAMPLE.MOD
PRINT ' Continue? (Y/END) : ':;INPUT MONGO
PRINT
*===========================================================================
====
*Verify
IF UPCASE(MONGO) = 'END' THEN STOP
IF UPCASE(MONGO) # 'Y' THEN
PRINT 'Invalid entry'
STOP
END
PERFORM 'GET.LIST ':IN.LIST
[EMAIL PROTECTED]
IF SELECTED < 1 THEN
PRINT 'There were no entries in list ':IN.LIST
STOP
END
*===========================================================================
====
*On yer marks
IN.COUNT = 0
OUT.REC = ''
OUT.COUNT = 1
*===========================================================================
====
*GOOOOoooooo......
LOOP
READNEXT ID ELSE EXIT
OUT.REC<-1> = ID
IN.COUNT += 1
IF IN.COUNT = SAMPLE.MOD THEN
GOSUB WRITE.SUB.LIST
END
REPEAT
IF IN.COUNT>0 THEN
*Any leftovers?
GOSUB WRITE.SUB.LIST
END
*===========================================================================
====
* Finish off
PRINT 'There were ':OUT.COUNT-1:' sub-lists created from ':IN.LIST
PRINT 'End of job'
PRINT
*===========================================================================
====
* /\/\/\/\
*
STOP
* \/\/\/\/
*
*===========================================================================
====
WRITE.SUB.LIST:
OUT.ID = RT.LIST:OUT.COUNT
PERFORM 'DELETE.LIST ':OUT.ID CAPTURING JUNK
OUT.ID := '000'
WRITE OUT.REC TO SAVEDLISTS, OUT.ID
OUT.COUNT += 1
OUT.REC = ''
IN.COUNT = 0
RETURN
*===========================================================================
====
999*
PROGRAMMED.ABORT:
SS= 'Program:':PGM.NAME:', Function:':FN.NAME:' - Aborted - '
SS:='Call Systems;B;E;A;C;H'
CALL SCREEN.MSG(SS)
STOP
END
*===========================================================================
====
-----Original Message-----
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] Behalf Of George Gallen
Sent: Monday, September 19, 2005 12:34
To: [email protected]
Subject: [U2] Trimming a SELECT list evenly....
In case anyone can use this:
I needed to trim my select list to specific number, usually I take
my ACTUAL/NEED and then do a SAMPLED # but I ran into a problem
when my NEED was fairly close to my ACTUAL, and you can't use
SAMPLED with a fractional number (I needed 1.25)
You sort and save your list, run this program, give it a new list
name (or overwrite your original if your so bold), and the
count you want to achieve.
I tested it a few times and it was exact, but given the nature of
decimals, it might be off 1 or 2.
George
PRINT "What is the SOURCE List Name :":;INPUT SLIST
PRINT "What is the OUTPUT List Name :":;INPUT OLIST
*
PRINT "What is the maximum count :":;INPUT MAX
*
OPEN "","&SAVEDLISTS&" TO F.SL ELSE STOP "NO &SAVEDLISTS&"
*
READ XDATA FROM F.SL,SLIST ELSE STOP "NO ":SLIST:" LIST FOUND"
UU=DCOUNT(XDATA,CHAR(254))
IF UU <= MAX THEN STOP "LIST HAS ":UU:" ENTRIES NOW"
*
SKIP=UU/MAX
NEXTKEEP=SKIP
IF NEXTKEEP#INT(NEXTKEEP) THEN NEXTCHECK=INT(NEXTKEEP)+1 ELSE
NEXTCHECK=NEXTKEEP
*
T=1
KEEP=""
*
LOOP
IF T > UU THEN EXIT
IF T = NEXTCHECK THEN
KEEP<-1>=XDATA<T>
NEXTKEEP=NEXTKEEP+SKIP
IF NEXTKEEP#INT(NEXTKEEP) THEN NEXTCHECK=INT(NEXTKEEP)+1 ELSE
NEXTCHECK=NEXTKEEP
END
T=T+1
REPEAT
WRITE KEEP ON F.SL,OLIST
STOP
END
-------
u2-users mailing list
[email protected]
To unsubscribe please visit http://listserver.u2ug.org/
-------
u2-users mailing list
[email protected]
To unsubscribe please visit http://listserver.u2ug.org/
