|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 1536 (0x600)
Types: TextFile
Names: »TOTDEL.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─⟦this⟧ »TOTDEL.PRG«
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
└─⟦this⟧ »TOTDEL.PRG«
*******************************************************************************
* DESIGN: NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*PROCEDURE: TOTDEL *
*PARAMETERS: DATABASE IN USE
*FUNCTION: STORE NUMBER OF A SPECIFIC COMPONENENT TYPE TO FIRST OCCURRENCE
* AND DELETE THE FOLLOWING REDUNDANT RECORDS *
*
*******************************************************************************
SET DELETED ON
STORE 0 TO MPASS
@ 1,10 SAY 'PASS NUMBER:'
@ 1,30 SAY 'INIT'
APPEND BLANK
GO BOTTOM
DELETE
STORE # TO MEND
GO TOP
SET EXACT ON
@ 2,10 SAY 'DISTANCE TO END:'
STORE 'REF:CODE=MREF.AND.TOLERANCE=MTOL.AND.NVALUE=MVAL.AND.RATED:VOLT=MRAT;
' TO MCRIT
DO WHILE .NOT.EOF
STORE # TO MCURRENT
STORE MPASS+1 TO MPASS
STORE MEND-MCURRENT TO MSCOPE
@ 1,30 SAY MPASS USING '#####'
@ 2,30 SAY MSCOPE USING '#####'
STORE REF:CODE TO MREF
STORE NVALUE TO MVAL
STORE TOLERANCE TO MTOL
STORE RATED:VOLT TO MRAT
SUM COUNTER TO MC WHILE &MCRIT
STORE # TO MLIM
GO MCURRENT
REPLACE COUNTER WITH MC
SKIP
IF MC>1
DELETE WHILE #<MLIM
ENDIF
ENDDO
@ 1,10 SAY 'PACKING IS BEING PERFORMED '
@ 2,10 SAY ' '
PACK
SET EXACT OFF
RETURN
«eof»