|
|
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 - metrics - download
Length: 4480 (0x1180)
Types: TextFile
Names: »CKITSPAR.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─⟦this⟧ »CKITSPAR.PRG«
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
└─⟦this⟧ »CKITSPAR.PRG«
*******************************************************************************
* 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»