!
!       EXPISM - ISAM File Expand/Contract Utility
!
! Program to Expand or Contract an ISAM file to user specified size.
!
! Author:       Creed Erickson
!               Computer Systems Plus, Inc.
!               1630 Manheim Pike
!               Lancaster, PA           17601
!               (717) 560-0140
!
!  The author assumes no liability for the use of this program for any purpose.
!
!  Released to the public domain on 12-June-1986.
!
       program EXISM,1.0(1)

! Edit History:
!
!       [001]   Original Code. 9-Jun-86 / CAE
!
!*********************
!*****  NOTICE   *****
!*********************
!       This program uses ISMROK.SBR which IS NOT a public domain utility.
!       ISMROK is part of the "Isam Utilities Package" availible from:
!
!               Distributed Management System, Inc.
!               P. O. Box 16995
!               Irvine, CA.    92713
!               (714) 957-1193
!
!       This little utility package might seem a bit salty until you use it
!       and see how many headaches it saves you. If you do a lot of ISAM work
!       I would reccomend you look into DMSI's stuff. I am unaware of other
!       widely distributed ISAM utilies of this nature but that doesn't mean
!       that they aren't out there somewhere.
!

       ! REALS
       map1    FOUND,                  F,6
       map1    NUM'RECS'ALLOC,         F,6
       map1    NUM'RECS'AVAIL,         F,6
       map1    NEW'REC'CNT,    F,6
       map1    REC'SIZE,               F,6
       map1    KEY'SIZE,               F,6
       map1    ACTUAL'KEY'SIZE,        F,6
       map1    KEY'POSITION,           F,6
       map1    RECPTR,                 F,6
       map1    NUMREC,                 F,6
       map1    DIR'ENTRY,              F,6
       map1    FIRST'LEVEL,            F,6
       map1    SECOND'LEVEL,           F,6
       map1    THIRD'LEVEL,            F,6
       map1    TOP'LEVEL,              F,6
       map1    MID'LEVEL,              F,6
       map1    BOT'LEVEL,              F,6
       map1    BLOCK'FACTOR,           F,6
       map1    HALF'FACTOR,            F,6
       map1    SMALL'SIZE,             F,6
       map1    FILE'SIZE,              F,6
       map1    EMPTY'IDX'BLKS,         F,6


       ! STRINGS
       map1    DATA'FILE'DEV'DRV,      S,10
       map1    ISAM'FILE'NAME,         S,6
       map1    SEQ'FILE'NAME,          S,20


       print : print
       print "ISAM filename: ";
       input line ISAM'FILE'NAME

       lookup ISAM'FILE'NAME+".IDA", FOUND

       if FOUND=0 then                                                 &
               print :                                                 &
               print "ONLY WORKS FOR PRIMARY FILES THAT ALREADY EXIST":&
               print :                                                 &
               end

       open #1, ISAM'FILE'NAME, INDEXED, 512, RECPTR

       XCALL ISMROK, 1,NUM'RECS'ALLOC, NUM'RECS'AVAIL, REC'SIZE, KEY'SIZE,&
                       KEY'POSITION, DATA'FILE'DEV'DRV

       close #1


       ! SHOW CURRENT MAX/INUSE - GET NEW MAX

       print
       print "Max. number of records in file : ";
       print NUM'RECS'ALLOC+NUM'RECS'AVAIL
       print "Number of records in use       : ";NUM'RECS'ALLOC
       input "Number of records for new file :  ";NEW'REC'CNT
       print

       !
       ! DO SOME CALCS
       !   (Bibilography: ISAM/LOKSER TUTORIAL, AMTS JOURNAL)
       !

       if (KEY'SIZE/2) = int(KEY'SIZE/2) then &
               ACTUAL'KEY'SIZE=KEY'SIZE else ACTUAL'KEY'SIZE = KEY'SIZE + 1

       DIR'ENTRY = ACTUAL'KEY'SIZE + 4

       BLOCK'FACTOR = int(508/DIR'ENTRY)

       HALF'FACTOR = int(BLOCK'FACTOR/2)

       THIRD'LEVEL = &
               1 max (int((NEW'REC'CNT-BLOCK'FACTOR+1)/HALF'FACTOR))+1

       SECOND'LEVEL = &
               1 max (int((THIRD'LEVEL-BLOCK'FACTOR)/HALF'FACTOR))+1

       FIRST'LEVEL = &
               1 max (int((SECOND'LEVEL-BLOCK'FACTOR)/HALF'FACTOR))+1

       FILE'SIZE = FIRST'LEVEL + SECOND'LEVEL + THIRD'LEVEL

       BOT'LEVEL = int(NEW'REC'CNT/BLOCK'FACTOR)
       if BOT'LEVEL <> (NEW'REC'CNT/BLOCK'FACTOR) then &
               BOT'LEVEL = BOT'LEVEL + 1

       MID'LEVEL = int(BOT'LEVEL/BLOCK'FACTOR)
       if MID'LEVEL <> (BOT'LEVEL/BLOCK'FACTOR) then &
               MID'LEVEL = MID'LEVEL + 1

       FIRST'LEVEL = int(MID'LEVEL/BLOCK'FACTOR)
       if FIRST'LEVEL <> (MID'LEVEL/BLOCK'FACTOR) then &
               FIRST'LEVEL = FIRST'LEVEL + 1

       SMALL'SIZE = FIRST'LEVEL + MID'LEVEL + BOT'LEVEL

       EMPTY'IDX'BLKS = FILE'SIZE - SMALL'SIZE

       SEQ'FILE'NAME = ISAM'FILE'NAME + ".SEQ"

       open #2, "EXISM.CMD", output
       print #2, ":S"
       print #2, "ERASE EXISM.CMD"
       print #2, "ERASE ";SEQ'FILE'NAME
       print #2, "ISMDMP "+ISAM'FILE'NAME
       print #2, SEQ'FILE'NAME
       print #2, "ERASE ";ISAM'FILE'NAME;".ID?"
       print #2, "ISMBLD "+ISAM'FILE'NAME
       print #2, str(KEY'SIZE)
       print #2, str(KEY'POSITION)
       print #2, str(REC'SIZE)
       print #2, str(NEW'REC'CNT)
       print #2, str(EMPTY'IDX'BLKS)
       print #2, "Y"
       print #2, DATA'FILE'DEV'DRV
       print #2, SEQ'FILE'NAME
       print #2, ":R"
       close #2
       chain "EXISM.CMD"