|
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: 4480 (0x1180) Types: TextFile Names: »CKITSPAR.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system └─ ⟦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»