|
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 - download
Length: 2048 (0x800)
Types: TextFile
Names: »SUMDEL.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »SUMDEL.PRG«
*******************************************************************************
* 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»