|
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: 4096 (0x1000)
Types: TextFile
Names: »MAKEL.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─⟦this⟧ »MAKEL.PRG«
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
└─⟦this⟧ »MAKEL.PRG«
*******************************************************************************
* DESIGN NIF/ASD/SEPTEMBER 1985
*
*PROCEDURE: MAKELC
*PARAM: DBASE IN USE
*CONVERTS GENERATES CVALUE AND SPECCODE FOR INDUCTORS
*
*******************************************************************************
LOCATE FOR $(REF:CODE,1,1)='8'
DO WHILE $(REF:CODE,1,1)='8'.AND..NOT.EOF
*GENERATE CVALUE AND SPECCODEVALUE FROM NVALUE
STORE STR(NVALUE,13,4) TO MOPER
STORE 13 TO MLENO
*MOVE DECIMAL POINT TO INDICATE VALUE IN NANOHENRYS
STORE @('.',MOPER) TO MPOINT
STORE $(MOPER,1,MPOINT-1)-$(MOPER,MPOINT+1,3)-'.'-$(MOPER,MPOINT+4,1) TO MOPER
*REMOVE TRAILING BLANKS AND ZEROES
DO WHILE RANK(MOPER)=32.OR.RANK(MOPER)=48
STORE MLENO-1 TO MLENO
STORE $(MOPER,2,MLENO) TO MOPER
ENDDO
*GENERATE ENGINEERING NOTATION
STORE @('.',MOPER) TO MPOINT
DO CASE
CASE MPOINT>=11
STORE 'L' TO MSEP
STORE MPOINT-10 TO MBEF
CASE MPOINT>=8
STORE 'm' TO MSEP
STORE MPOINT -7 TO MBEF
CASE MPOINT>=5
STORE 'u' TO MSEP
STORE MPOINT-4 TO MBEF
OTHERWISE
STORE 'n' TO MSEP
STORE MPOINT-1 TO MBEF
ENDCASE
DO CASE
CASE MPOINT>2
STORE $(MOPER,1,MPOINT-1) TO MINT
STORE $(MOPER,MPOINT+1,1) TO MENG2
STORE $(MINT,1,MBEF) TO MENG1
IF MBEF<LEN(MINT)
STORE $(MINT,MBEF+1,MPOINT-MBEF-1)-MENG2 TO MENG2
ENDIF
STORE MENG1-MSEP-MENG2 TO MCVAL
CASE MPOINT=2
STORE $(MOPER,1,1)-MSEP-$(MOPER,3,1) TO MCVAL
OTHERWISE
STORE MSEP-$(MOPER,MPOINT+1,1) TO MCVAL
ENDCASE
IF LEN(MCVAL)<3
STORE MCVAL-'0' TO MCVAL
ENDIF
STORE LEN(MCVAL) TO MLENC
DO WHILE (MLENC>3.AND.$(MCVAL,MLENC,1)='0').OR.MLENC>8
STORE MLENC-1 TO MLENC
STORE $(MCVAL,1,MLENC) TO MCVAL
ENDDO
IF LEN(MCVAL)<4.AND.VAL(TOLERANCE)<2.AND.'%'$TOLERANCE
REPLACE CVALUE WITH MCVAL-'0'
ELSE
REPLACE CVALUE WITH MCVAL
ENDIF
*GENRATION OF VALUE FOR THE SPEC:CODE
*INITIALIZE VAR
STORE STR(NVALUE,13,4) TO MOPER
STORE 13 TO MLENO
*REMOVE TRAILING BLANKS AND ZEROES
DO WHILE RANK(MOPER)=32.OR.RANK(MOPER)=48
STORE MLENO-1 TO MLENO
STORE $(MOPER,2,MLENO) TO MOPER
ENDDO
STORE @('.',MOPER) TO MPOINT
STORE SPEC:CODE TO MSPEC
STORE @('<V',MSPEC) TO MSTART
STORE @('V>',MSPEC) TO MSTOP
*FIND LENGTH OF ACTUAL FORMAT FOR SPEC:VALUE
STORE VAL($(MSPEC,MSTART+2,1)) TO MFLOAT
STORE MSTOP-MSTART TO MLENS
STORE $(TOLERANCE,1,3) TO MTOL
IF &MTOL>1.AND.'%'$TOLERANCE
DO WHILE MFLOAT>0
STORE MLENS-1 TO MLENS
STORE MFLOAT-1 TO MFLOAT
ENDDO
ENDIF
DO CASE
CASE 'SCC'$MSPEC.OR.'MIL'$MSPEC
*GENERATE VALUE IN SCC-SPEC. NOTATION
STORE $(MOPER,1,MLENS) TO MSVAL
IF MPOINT<MLENS
IF MPOINT=1
STORE 'L'-$(MSVAL,2,MLENS-1) TO MSVAL
ELSE
STORE $(MSVAL,1,MPOINT-1)-'L'-$(MSVAL,MPOINT+1,MLENS) TO MSVAL
ENDIF
ELSE
STORE $(MSVAL,1,MLENS-1)-STR(MPOINT-MLENS,1) TO MSVAL
ENDIF
OTHERWISE
*GENERATE VALUE IN ENG. NOTATION
STORE MCVAL TO MSVAL
DO WHILE LEN(MSVAL)<MLENS
STORE MSVAL-'0' TO MSVAL
ENDDO
ENDCASE
*INSERT IN SPEC:CODE
STORE $(MSPEC,1,MSTART-1)-MSVAL-$(MSPEC,MSTOP+2,28-MSTOP) TO MSPEC
REPLACE SPEC:CODE WITH MSPEC
*PROCEDURE: MAKETOLL
*FUNCTION: GENERATES THE TOLERANCE CODE LETTER FOR THE SPEC. AND INSERTS IT.
IF '<T>'$SPEC:CODE
STORE $(TOLERANCE,1,3) TO MTOL
IF $(TOLERANCE,4,1)='A'
STORE '?' TO MTOL
ELSE
DO CASE
CASE &MTOL=10
STORE 'K' TO MTOL
CASE &MTOL=20
STORE 'M' TO MTOL
OTHERWISE
STORE '?' TO MTOL
ENDCASE
ENDIF
STORE SPEC:CODE TO MOPER
STORE @('<T>',MOPER) TO MSTART
STORE $(MOPER,1,MSTART-1)-MTOL-$(MOPER,MSTART+3,27-MSTART) TO MOPER
REPLACE SPEC:CODE WITH MOPER
ENDIF
STORE # TO OLD
CONTINUE
IF #=OLD
SKIP
ENDIF
ENDDO
RETURN
«eof»