DataMuseum.dk

Presents historical artifacts from the history of:

Christian Rovsing CR7, CR8 & CR16 CP/M

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

See our Wiki for more about Christian Rovsing CR7, CR8 & CR16 CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦b34588d04⟧ TextFile

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

Derivation

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

TextFile

* CREATES SPAREKIT FROM KITLISTS
ERASE
SET LINKAGE OFF
SET FORMAT TO SCREEN
STORE 'D:FILEFILE.DTP' TO DATDEF
@ 10,10 SAY 'ENTER DRIVE, FILENAME FOR DEFINITION-FILE: ' GET DATDEF PICTURE ;
'A:XXXXXXXX.XXX'
READ
STORE TRIM($(DATDEF,1,10))-TRIM($(DATDEF,11,4)) TO DATDEF
IF FILE(DATDEF)
   STORE $(DATDEF,1,@('.',DATDEF))-'SPR' TO SPARE
   SELE SECO
   USE E:SPR_STRU
   COPY STRU TO &SPARE
   USE &SPARE
   SELE PRIM
   USE &DATDEF
   DO WHILE .NOT.EOF
      IF MEMBER
         SELE SECO
         GO BOTTOM
         STORE # TO LAST
         STORE P.CONF-P.MODULE-'.KIT' TO SOURCE
         APPEND FROM &SOURCE FOR .NOT.('DEL'$REF:CODE.OR.$(REF:CODE,1,1)=;
'C'.OR.COUNTER=0)
         GO BOTTOM
         IF #>LAST
            IF LAST>0
               GO LAST+1
            ELSE
               GO TOP
            ENDIF
            REPLACE NEXT 9999 S.NAME WITH P.NAME
         ENDIF
         SELE PRIM
         SKIP
      ELSE
         SKIP
      ENDIF
   ENDDO
   USE
   SELE SECO
   INDEX ON REF:CODE+STR(NVALUE,13,4)+RATED:VOLT+TOLERANCE+STR(99999-COUN;
TER,5) TO D:WORK
   COPY TO D:WORK
   USE D:WORK
   DELETE FILE &SPARE
   STORE 'REF:CODE=MREF.AND.TOLERANCE=MTOL.AND.NVALUE=MVAL.AND.RATED:VOLT=MRAT;
.AND..NOT.EOF' TO MCRIT
   GO TOP
   DO WHILE .NOT.EOF
      STORE REF:CODE TO MREF
      STORE NVALUE TO MVAL
      STORE TOLERANCE TO MTOL
      STORE RATED:VOLT TO MRAT
      SKIP
      DO WHILE &MCRIT
         DELETE
         SKIP
      ENDDO
   ENDDO
   SET DELETED ON
   COPY TO &SPARE
   USE
   DELETE FILE D:WORK
   DELETE FILE D:WORK.NDX
ENDIF
RELEASE ALL LIKE M*
RELEASE DATDEF,SPARE,SOURCE,LAST
RETURN


      «eof»