DataMuseum.dk

top - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »MAKEL.PRG«

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

TextFile

*******************************************************************************
* 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»