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 - download

⟦74742ca52⟧ TextFile

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »CKITSPAR.PRG«

Derivation

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

TextFile

*******************************************************************************
* DESIGN: NIF/ASD/NOVEMBER 1986
*******************************************************************************
* TASK: CKITSPAR
* FUNCTION: CREATES A KITLIST FROM A LONG FORM MODULE LEVEL PARTSLIST (SOT-INC)
*******************************************************************************

SELECT PRIMARY
IF .NOT.CALL

*GET THE SOURCEFILE
STORE 'PLL' TO MEXTEN
DO GETSOURC
ENDIF

IF FILE(OPERDBF)
   STORE 'KIT-LIST CREATED' TO STATUS
   ERASE
   SELE PRIM
   @ 10,10 SAY 'CONVERSION FROM PLL TO KIT HAS BEEN STARTED'
   STORE $(OPERDBF,1,10)+'.KIT' TO MKITNAME
   IF FILE(MKITNAME)
      DELETE FILE &MKITNAME
      STORE 'OLD KIT-LIST DELETED --- NEW CREATED' TO STATUS
   ENDIF
   USE KIT_STRU
   COPY STRU TO &MKITNAME
   COPY STRU TO D:SOTREFS
   COPY STRU TO D:SOTWORK
   USE &MKITNAME
   APPEND FROM &OPERDBF FOR .NOT.'SOT'$REF:CODE
   REPLACE ALL COUNTER WITH 1
   USE D:SOTWORK
   APPEND FROM &OPERDBF FOR $(REF:CODE,1,3)='SOT'
   IF #>0
      REPLACE ALL REF:DES WITH TRIM(REF:DES)-'('-TRIM(REF:CODE)-')'
      INDEX ON VAL($(REF:CODE,4,3)) TO D:WORK
      COPY TO D:SOTREFS
      USE D:SOTREFS
      GO TOP
      DO WHILE .NOT.EOF
         STORE # TO MCURRENT
         STORE # TO MLAST
         STORE 1 TO MC
         STORE TRIM(REF:DES) TO MDES
         STORE REF:CODE TO MREF
         SKIP
         DO WHILE REF:CODE=MREF.AND.#>MLAST
            STORE MDES-','-TRIM(REF:DES) TO MDES
            STORE # TO MLAST
            STORE MC+1 TO MC
            DELETE
            SKIP
         ENDDO
         GO MCURRENT
         REPLACE REF:DES WITH MDES, COUNTER WITH MC
         GO MLAST
         SKIP
      ENDDO
      PACK
      GO TOP
      SELE SECO
      USE KIT_STRU
      COPY STRU TO D:SOTWORK
      USE D:SOTWORK
      SELE PRIM
      DO WHILE .NOT.EOF
         SELE PRIM
         IF VAL($(REF:CODE,4,2))<10
            STORE 1 TO X
         ELSE
            STORE 2 TO X
         ENDIF
         STORE $(OPERDBF,1,10)-'.S'-STR(VAL($(REF:CODE,4,2)),X) TO MSOT
         IF FILE(MSOT)
            SELE SECO
            APPEND FROM &MSOT
            REPLACE ALL S.REF:DES WITH P.REF:DES, S.COUNTER WITH P.COUNTER ;
FOR S.REF:DES=P.REF:CODE
         ELSE
            STORE 'FILE: '+MSOT+' IS MISSING' TO STATUS
         ENDIF
         SELE PRIM
         SKIP
      ENDDO
      USE &MKITNAME
      SELE SECO
      USE
      SELE PRIM
      APPEND FROM D:SOTWORK
   ELSE
      USE &MKITNAME
   ENDIF
  
   IF .NOT.'MISSING'$STATUS   
   INDEX ON REF:CODE+STR(NVALUE,13,4)+RATED:VOLT+TOLERANCE TO D:WORK
   COPY TO D:WORK
   USE D:WORK
   DELETE FILE &MKITNAME
   APPEND BLANK
   GO BOTT
   DELETE
   STORE # TO MEND
   GO TOP
   STORE 'REF:CODE=MREF.AND.TOLERANCE=MTOL.AND.NVALUE=MVAL.AND.RATED:VOLT=MRAT;
' TO MCRIT
   DO WHILE .NOT.EOF
      STORE # TO MCURRENT
      STORE REF:CODE TO MREF
      STORE NVALUE TO MVAL
      STORE TOLERANCE TO MTOL
      STORE RATED:VOLT TO MRAT
      STORE 0 TO MC
      SUM COUNTER TO MC WHILE &MCRIT
      STORE # TO MLIM
      GO MCURRENT
      STORE 0 TO MS
      IF 'SOT'$REF:DES
         STORE COUNTER TO MS
      ENDIF
      REPLACE COUNTER WITH MC
      IF MLIM-MCURRENT>1
         STORE TRIM(REF:DES) TO MDES
         SKIP
         DO WHILE #<MLIM
            IF 'SOT'$REF:DES
               STORE COUNTER+MS TO MS
            ENDIF
            IF LEN(MDES)<247
               STORE TRIM(MDES-','-TRIM(REF:DES)) TO MDES
               DELETE
            ELSE
               STORE # TO MCUR2
               GO MCURRENT
               REPLACE REF:DES WITH MDES-'$'
               GO MCUR2
               STORE MCUR2 TO MCURRENT
               STORE TRIM(REF:DES) TO MDES
               REPLACE COUNTER WITH 0
            ENDIF
            SKIP
         ENDDO
         GO MCURRENT
         REPLACE REF:DES WITH MDES-'.', SOTCOUNT WITH MS
      ELSE
         REPLACE REF:DES WITH TRIM(REF:DES)-'.', SOTCOUNT WITH MS
      ENDIF
      GO MCURRENT+1
      DO WHILE *.AND..NOT.EOF
         SKIP
      ENDDO
   ENDDO
   DELETE FILE D:SOTREFS
   DELETE FILE D:SOTWORK
   COPY TO &MKITNAME
   USE
   DELETE FILE D:WORK
   ENDIF     
ELSE
   STORE 'PLL MUST BE RESIDENT ON SELECTED UNIT-DRIVE' TO STATUS
ENDIF
RELEASE ALL LIKE M*
RETURN

«eof»