DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦5cdfb17de⟧ TextFile

    Length: 1536 (0x600)
    Types: TextFile
    Names: »TOTDEL.PRG«

Derivation

└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
    └─⟦this⟧ »TOTDEL.PRG«

TextFile

*******************************************************************************
* 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»