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

⟦048f2193d⟧ TextFile

    Length: 2048 (0x800)
    Types: TextFile
    Names: »SUMDEL.PRG«

Derivation

└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
    └─⟦this⟧ »SUMDEL.PRG« 
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
    └─⟦this⟧ »SUMDEL.PRG«

TextFile

*******************************************************************************
* DESIGN: NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*PROCEDURE: SUMDEL                                                            *
*PARAMETERS: DATABASE IN USE
*FUNCTION: STORE SUM OF NUM.FIELDS FOR 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
DELETE
GO BOTTOM
STORE # TO MEND
GO TOP
SET EXACT ON
@ 2,10 SAY 'DISTANCE TO END:'
DO WHILE .NOT.EOF
   STORE REF:CODE TO MREFC
   STORE NVALUE TO MV
   STORE TOLERANCE TO MT
   STORE RATED:VOLT TO MRAT
   STORE # TO MPOINT
   STORE STR(MEND-#+1,5) TO MSCOPE
   STORE 1+MPASS TO MPASS
   @ 1,30 SAY MPASS USING '#####'
   @ 2,30 SAY MSCOPE USING 'XXXXX'
   LOCATE NEXT &MSCOPE FOR REF:CODE<>MREFC.OR.NVALUE<>MV
   STORE # TO MPOINT1
   STORE STR(#-MPOINT,5) TO MSCOPE1
   GO MPOINT
IF &MSCOPE1>1
   SUM COUNTER,REQUIRED,NATTR TO MC,MR,MA NEXT &MSCOPE1 ;
FOR REF:CODE=MREFC.AND.NVALUE=MV.AND.TOLERANCE=MT.AND.RATED:VOLT=MRAT
   GO MPOINT+1
   STORE STR(&MSCOPE1-1,5) TO MSCOPE1
   DELETE NEXT &MSCOPE1 ;
FOR REF:CODE=MREFC.AND.NVALUE=MV.AND.TOLERANCE=MT.AND.RATED:VOLT=MRAT
   GO MPOINT+1
   STORE ' ' TO MNUMROW
   DO WHILE #<MPOINT1
      IF *
         STORE MNUMROW-NUMROW TO MNUMROW
      ENDIF
      SKIP
   ENDDO
   GO MPOINT
   REPLACE COUNTER WITH MC,REQUIRED WITH MR,NATTR WITH MA,NUMROW WITH NUMROW-;
MNUMROW
   
ENDIF
   SKIP
   DO WHILE *.AND..NOT.EOF
      SKIP
   ENDDO
ENDDO

@ 1,10 SAY 'PACKING IS BEING PERFORMED                                      '
@ 2,10 SAY 'PACKED SIZE: '+STR(MPASS,5) +'                                  '
PACK
SET EXACT OFF
RETURN



«eof»