List unassigned numbers 2

[TinLegs]

Greetings all, I have an app (Legacy C6.1) that for each record added a member number must be assigned (any number between 1 and 5000) that can not be duplicate. I would like to be able to generate a list of unused member numbers only. A seamingly simple task for which I am not able to find a solution.

 

[ShankarJ]

SQL or ISAM database?

 

[TinLegs]

Hi Shankar, its ISAM

 

[ShankarJ]

An example of finding missing nos and storing it in a Queue. My Number Key (Reference - VOUCH) was Alphanumeric with a prefix and so I had to extract the Number part to find missing nos. You can adapt this code to your requirements.

DNO_TBL QUEUE,PRE(DOC)
NO STRING(10)
DATE LONG
.

SEL_GRP GROUP,PRE(SEL)
TYPE STRING(2) !Trn Type
VCH_PFX STRING(4) !Voucher Prefix
F_DATE LONG !From Date
T_DATE LONG !To Date
.

GROUP,PRE(SAV)
VOUCH STRING(10)
DATE LONG
F_NO STRING(10)
T_NO STRING(10)
.

CLEAR(TRN:RECORD,-1)
TRN:VOUCH = SEL:VCH_PFX ; L# = LEN(CLIP(SEL:VCH_PFX)) ; SAV:VOUCH = ''
SET(TRN:KEY1,TRN:KEY1)
LOOP
NEXT(SCTRAN)

IF ERRORCODE() OR SUB(TRN:VOUCH,1,L#) <> SEL:VCH_PFX
IF SAV:VOUCH <> ''
DOC:NO = SAV:VOUCH
GET(DNO_TBL,DOC:NO)
IF ERRORCODE()
DOC:NO = SAV:VOUCH
DOCATE = SAVATE

ADD(DNO_TBL,DOC:NO)
IF ERROR() THEN STOP('DNO_TBL : ' & ERROR()).
END
END

BREAK
END
IF SEL:T_DATE <> 0 AND TRNATE > SEL:T_DATE THEN CYCLE.
IF TRNATE < SEL:F_DATE THEN CYCLE.

IF SAV:VOUCH = ''
SAV:VOUCH = TRN:VOUCH
SAVATE = TRNATE
END

IF TRN:VOUCH <> SAV:VOUCH
DOC:NO = SAV:VOUCH
GET(DNO_TBL,DOC:NO)
IF ERRORCODE()
DOC:NO = SAV:VOUCH
DOCATE = SAVATE

ADD(DNO_TBL,DOC:NO)
IF ERROR() THEN STOP('DNO_TBL : ' & ERROR()).
END

SAV:VOUCH = TRN:VOUCH
SAVATE = TRNATE
END
END

HTH-Regards

 

[MarkGoldberg]

Tinlegs, I wrote a GENERIC program to accomplish your goal of finding gaps. Also note a few helper functions. Let me know if this helped.
-------------------------------------------------

Program
!Written By: Mark Golderg June 6th, 2005
MAP
FindGaps (qtGaps ArgGapQ, *FILE ArgFile, *KEY ArgKey, BYTE ArgDisplay=0, LONG ArgStartAt=1, LONG ArgEndAt=-1),LONG,PROC
ClearKey ( *FILE ArgFile, *KEY ArgKey, LONG ArgClearType)
Swap (*? ArgA, *? ArgB)
IsFileOpen( *FILE ArgFile),BYTE !returns True or False
END

PrCrewHD FILE,DRIVER('TOPSPEED','/TCF=.\Topspeed.TCF'),PRE(PCH),BINDABLE,THREAD
kProjCrew_ID KEY(PCHroject_ID,PCH:Crew_ID),NOCASE
kCrewLinkID KEY(PCH:CrewLinkID),NOCASE
Record RECORD,PRE()
Crew_ID STRING(1)
CrewLinkID SHORT
Project_ID LONG
Descr STRING(40)
Layer_FTE REAL
CalcOrOvr STRING(1)
Cost_Per_Day REAL
CPD_Base REAL
CPD_Fringe REAL
CPD_Burden REAL
CPD_Equip REAL
TTLSup REAL
TTLLay REAL
TTLSaw REAL
TTLPrd REAL
TTLTnd REAL
Flag BYTE
CreateDate DATE
CreateTime TIME
UpdateDate DATE
UpdateTime TIME
END
END

qtGaps QUEUE,TYPE
Low LONG
High LONG
END

FindGapsErrors ITEMIZE,pre(FindGapsErrors
NoError EQUATE(0)
FileOpen EQUATE
BadCompareField EQUATE
UnusableKey EQUATE
END

Response Long
GapQ1 qtGaps
CODE
Response = FindGaps(GapQ1,PrCrewHD, PCH:kCrewLinkID, TRUE, 4000,8000)
Response = FindGaps(GapQ1,PrCrewHD, PCH:kCrewLinkID, TRUE)

!========================================================================
FindGaps PROCEDURE(qtGaps ArgGapQ, *FILE ArgFile, *KEY ArgKey, BYTE ArgDisplay=0, LONG ArgStartAt=1, LONG ArgEndAt=-1) !,LONG
!Returns an ErrorCode
!Will use the 1st component of the key
!ASSUMES the 1st component of the key is a (see Expected, and ArgStartAt, ArgEndAt)


Expected LIKE(qtGAPS.Low)
CompareField ANY
RetVal LONG(FindGapsErrors::NoError)
FileRecord &Group
FileState LONG
bFileWasOpen BYTE
CODE
!todo :: Add Logic to handle the state of File Open/Closed & save/restore file buffer & Position
bFileWasOpen = IsFileOpen(ArgFile)
IF ~bFileWasOpen
OPEN(ArgFile)
IF ERRORCODE()
!complain
RetVal=FindGapsErrors::FileOpen
DO ProcedureReturn
END
END
FileState = GETSTATE(ArgFile,1)

FileRecord &= ArgFile{PROP:Record}
CompareField &= WHAT(FileRecord, ArgKey{PROP:Field,1})
IF CompareField &= NULL
!complain
RetVal=FindGapsErrors::BadCompareField
DO ProcedureReturn
END

IF ArgEndAt = -1
CLEAR(ArgEndAt,1) !set to +Infinity
END

!This logic added, to better support Descending keys
IF ArgKey{PROP:Ascending,1} = '1' ! '1' means Ascending '' means Descending
IF ArgStartAt > ArgEndAt THEN Swap(ArgStartAt, ArgEndAt) END
ELSIF ArgStartAt < ArgEndAt THEN Swap(ArgStartAt, ArgEndAt)
END

ClearKey(ArgFile, ArgKey, -1)
CompareField = ArgStartAt
SET(ArgKey,ArgKey)

Expected = ArgStartAt
FREE(ArgGapQ)

LOOP !--------------
NEXT(ArgFile)
IF ERRORCODE() or CompareField > ArgEndAt
IF Expected < ArgEndAt
ArgGapQ.Low = Expected
ArgGapQ.High = ArgEndAt
Add(ArgGapQ)
END
BREAK
ELSIF CompareField <> Expected
ArgGapQ.Low = Expected
ArgGapQ.High = CompareField - 1
Add(ArgGapQ)
END
Expected = CompareField + 1
END !loop !--------------

IF ArgDisplay
DO DisplayQueue
END
DO ProcedureReturn

ProcedureReturn ROUTINE
CASE RetVal
OF FindGapsErrors::NoError
OROF FindGapsErrors::BadCompareField
IF bFileWasOpen
COMPILE('**++** _C60_OR_Greater_',_C60_)
RESTORESTATE(ArgFile,FileState,TRUE)
! **++** _C60_OR_Greater_
OMIT ('**--** _PRE_C6_',_C60_)
RESTORESTATE(ArgFile,FileState)
! **--** _PRE_C6_
ELSE
CLOSE(ArgFile)
END
END
RETURN RetVal

DisplayQueue ROUTINE
DATA
Window WINDOW('FindGaps'),AT(,,151,315),FONT('MS Sans Serif',8,,FONT:regular),SYSTEM,GRAY,AUTO
STRING('Field'),AT(9,7)
STRING('--- fieldname goes here ---'),AT(34,7,112,10),USE(?FieldName)
STRING('ArgStartAt'),AT(7,20)
STRING(@n-15),AT(43,20),USE(ArgStartAt)
STRING('ArgEndAt'),AT(7,30)
STRING(@n-15),AT(43,30),USE(ArgEndAt)
LIST,AT(9,45,133,261),USE(?List1),VSCROLL,FORMAT('53R(2)|M~Low~L@N-15@20L(2)|M~High~@N-15@'),FROM(ArgGapQ)
END

CODE
OPEN(Window)
?FieldName{prop:Text} = WHO(FileRecord, ArgKey{PROP:Field,1})
ACCEPT
END

!========================================================================
IsFileOpen PROCEDURE(*FILE ArgFile)!,BYTE !returns True or False
!The NAME() of a File will show it's path when open
!so I'm looking for the ':' of a Drive letter or the '\\' of a UNC name
CODE
RETURN CHOOSE( INSTRING(':',NAME(ArgFile),1) OR INSTRING('\\',NAME(ArgFile),1,2) )

!========================================================================
Swap PROCEDURE(*? ArgA, *? ArgB)
tmp ANY
CODE
tmp = ArgA
ArgA = ArgB
ArgB = tmp

!========================================================================
ClearKey PROCEDURE(*FILE ArgFile, *KEY ArgKey, LONG ArgClearType)
FileRecord &Group
N LONG
DescedingMult LONG
KeyField ANY
CODE
IF ArgClearType < 0 THEN ArgClearType = -1
ELSIF ArgClearType > 0 THEN ArgClearType = 1
END

FileRecord &= ArgFile{PROP:Record}

LOOP N = 1 to ArgKey{PROP:Components}
IF ArgKey{PROP:Ascending,N} = '1' ! '1' means Ascending '' means Descending
DescedingMult = 1
ELSE DescedingMult = -1
END
KeyField &= WHAT(FileRecord, ArgKey{PROP:Field,N})
CLEAR(KeyField, ArgClearType * DescedingMult)
END