|
|
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: 7168 (0x1c00)
Types: TextFile
Names: »MODIN.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─⟦this⟧ »MODIN.PRG«
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
└─⟦this⟧ »MODIN.PRG«
*******************************************************************************
* DESIGN: NIF/ASD/SEPTEMBER 85 *
*******************************************************************************
* *
* PROCEDURE: 'MODIN' CALLED FROM: TASK:'DMOD','UMOD' *
* THIS COMMANDFILE IS PART OF THE 'LISTAID' PARTSLIST MANAGEMENT SYSTEM *
* IT PROVIDES USER INTERFACE FOR DEFINITION OF COMPONENTS IN MODULES *
*******************************************************************************
*
* PARAMETERS:INITIALIZED VARIABLES:MTOL,MRATE,MVALIDSTAT,MCONTINUE,OPERDBF
* MREFD,MREFC,
SET CONFIRM OFF
STORE NVALUE TO OLDVALUE
STORE 'INIT' TO OLDREFC
ERASE
*ACCEPT USER-INPUT
DO WHILE MVALIDSTAT<>'NO OBJECTION'
@ 1,19 SAY ' '
@ 1,1 SAY 'VALIDATION STATE:'
@ 1,19 SAY MVALIDSTAT
@ 3,1 SAY OPERDBF
@ 5,1 SAY 'ENTER COMMAND: '
@ 5,16 GET MCONTINUE PICTURE '!'
DO CASE
CASE MINTYPE='CREATION'
@ 7,1 SAY 'C= CONTINUE, S= COMPLETE THIS ENTRY AND EXIT, D= EXIT'
CASE MINTYPE='EDIT'
@ 3,20 SAY MREFD USING 'XXXXXX'
@ 7,1 SAY 'A= ABORT CHANGE, M= MAKE CHANGE, D= DELETE, R= RECALL'
@ 7,$+1 SAY ', F= FIND REF.CODE'
IF *
@ 5,20 SAY 'RECORD MARKED FOR DELETION'
ELSE
@ 5,20 SAY 'RECORD NOT MARKED FOR DELETION'
ENDIF
CASE MINTYPE='APPEND'
@ 7,1 SAY 'C= CONTINUE, S= COMPLETE THIS ENTRY AND EXIT, D= EXIT'
@ 7,$+1 SAY ', F= FIND REF.CODE'
ENDCASE
READ
CLEAR GETS
IF .NOT.(MCONTINUE$'DF'.OR.(MINTYPE='EDIT'.AND.MCONTINUE='A'))
@ 10,16 SAY 'ENTER REFERENCE DESIGNATOR:'
@ 10,43 GET MREFD PICTURE 'AA####'
@ 12,22 SAY 'ENTER REFERENCE CODE:'
@ 12,43 GET MREFC PICTURE '!!!###'
READ
CLEAR GETS
IF MCONTINUE#'D'.AND.MCONTINUE<>'F'
IF LEN(TRIM(MREFD))<2
STORE 'WHAT DOCUMENT HAS NO NAMING OF PARTS' TO MVALIDSTAT
ELSE
IF $(MREFC,1,3)#'SOT'.AND.$(MREFC,1,1)#'C'.AND.VAL($(MREFC,1,6))<100001;
.AND.$(MREFC,1,3)#'DEL'
IF ($(MREFC,1,1)='4'.OR.$(MREFC,1,1)='5')
IF $(MREFC,2,1)#' '
STORE 'NO OBJECTION' TO MVALIDSTAT
ENDIF
ELSE
STORE 'REFERENCE CODE SYNTAX ERROR' TO MVALIDSTAT
ENDIF
ELSE
STORE 'NO OBJECTION' TO MVALIDSTAT
ENDIF
IF $(MREFC,1,3)='SOT'
IF VAL($(MREFC,4,3))>99
STORE 'MAXIMUM NUMBER OF SOT-KITS IN MODULE IS 100' TO MVALIDSTAT
ELSE
IF VAL($(MREFC,4,3))=0
STORE 'GIVE REFERENCE NUMBER FOR THE SOT-KIT' TO MVALIDSTAT
ELSE
IF $(MREFC,4,1)='0'
STORE 'SOT'-$(MREFC,5,2) TO MREFC
ENDIF
STORE 'NO OBJECTION' TO MVALIDSTAT
ENDIF
ENDIF
ENDIF
ENDIF
*MAKE SURE THAT COMPONENTTYPE HAS NOT BEEN CHANGED
IF MREFC#OLDREFC.AND.OLDREFC#'INIT'.AND.MVALIDSTAT='NO OBJECTION'
STORE 'REFERENCE CODE HAS BEEN CHANGED' TO MVALIDSTAT
STORE 'INIT' TO OLDREFC
ERASE
ENDIF
IF MVALIDSTAT='NO OBJECTION'
STORE MREFC TO OLDREFC
ENDIF
*GET REST OF PARAMETERS
IF MVALIDSTAT='NO OBJECTION'
DO CASE
*RESISTOR
CASE $(MREFC,1,1)='4'
@ 14,17 SAY "ENTER RESISTANCE IN OHM'S:"
@ 14,43 GET NVALUE
*CAPACITOR
CASE $(MREFC,1,1)='5'
@ 14,19 SAY 'ENTER CAPACITANCE IN nF:'
@ 14,43 GET NVALUE
@ 16,23 SAY 'ENTER RATED VOLTAGE: V'
@ 16,43 GET MRATE PICTURE '####'
*ACCSESSORIES FOR CONNECTORS
CASE $(MREFC,1,2)='64'
@ 14,19 SAY ' ENTER NUMBER OF PARTS:'
@ 14,43 GET NVALUE PICTURE '####'
*INDUCTORS
CASE $(MREFC,1,1)='8'
@ 14,19 SAY ' ENTER INDUCTANCE IN uH:'
@ 14,43 GET NVALUE
ENDCASE
IF $(MREFC,1,1)$'458'
@ $+2,9 SAY 'ENTER TOLERANCE <%=REL. , A=ABS.>:'
@ $,43 GET MTOLV PICTURE '##.##'
@ $,48 GET MTOLT PICTURE '!'
ENDIF
@ $+2,27 SAY 'OPTIONAL REMARK:' GET REM
READ
*ACCESORIES SYNTAX CHECK
IF $(REF:CODE,1,2)='64'
REPLACE NVALUE WITH INT(NVALUE)
IF NVALUE=0
STORE 'NUMBER OF PARTS MUST BE GREATER THAN ZERO' TO MVALIDSTAT
ENDIF
ENDIF
*RESISTOR + CAPACITOR+INDUCTOR SYNTAX CHECK
IF ($(MREFC,1,1)$'458').AND.MVALIDSTAT='NO OBJECTION'
IF NVALUE=0
STORE 'VALUE MUST BE GREATER THAN ZERO' TO MVALIDSTAT
ELSE
IF MTOLT#'%'.AND.MTOLT#'A'
STORE 'ILLEGAL TOLERANCE-TYPE' TO MVALIDSTAT
ELSE
IF MTOLV=0
STORE 'TOLERANCE EXCEEDING PHYSICAL CONSTRAINTS' TO MVALIDSTAT
ELSE
IF VAL(MRATE)<=0.AND.$(MREFC,1,1)='5'
STORE "THIS CAPACITOR WOULDN'T STAND ANY VOLTAGE" TO MVALIDSTAT
ELSE
STORE STR(VAL(MRATE),4) TO MRATE
STORE 'NO OBJECTION' TO VALIDSTATE
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
*OVERRULE SYNTAXCHECK
STORE # TO MCURRENT
GO BOTTOM
DO CASE
CASE MCONTINUE='D'
IF (#=1)
STORE 'MODULE_FILE DELETED: '+ OPERDBF TO STATUS
STORE 'NO OBJECTION' TO MVALIDSTAT
ELSE
STORE 'NO OBJECTION' TO MVALIDSTAT
ENDIF
CASE MCONTINUE='F'
STORE 'NO OBJECTION' TO MVALIDSTAT
ENDCASE
GO MCURRENT
*DUPLICATED FIELDS?
IF MVALIDSTAT='NO OBJECTION'.AND.MCONTINUE#'D'.AND.MCONTINUE<>'F'
STORE # TO MCURRENT
GO TOP
COUNT FOR REF:DES=MREFD TO MCOUNTER
IF MCOUNTER>0
LOCATE FOR REF:DES=MREFD
IF #<>MCURRENT
STORE 'THIS REFERENCE DESIGNATOR IS ALREADY USED' TO MVALIDSTAT
ENDIF
ENDIF
GO MCURRENT
ENDIF
ENDDO
*REPLACE RECORDS WITH MEMVARS
IF MCONTINUE<>'F'.AND..NOT.(MINTYPE='EDIT'.AND.MCONTINUE='A')
REPLACE REF:DES WITH TRIM(MREFD)
STORE REF:DES TO MREFD
REPLACE REF:CODE WITH MREFC
IF $(MREFC,1,1)$'458'
IF MTOLV>=1
STORE STR(MTOLV,3) TO MVAL
ELSE
STORE '.'-$(STR(MTOLV,5,2),4,2) TO MVAL
ENDIF
REPLACE TOLERANCE WITH MVAL-MTOLT
IF $(MREFC,1,1)='5'
REPLACE RATED:VOLT WITH MRATE
ENDIF
ENDIF
ELSE
REPLACE NVALUE WITH OLDVALUE
ENDIF
IF MINTYPE='EDIT'.AND.MCONTINUE<>'F'
CLEAR GETS
@ 21,21 SAY 'ANOTHER RECORD? (Y/N):'
@ $,43 GET NEXT
READ
IF NEXT
STORE ' ' TO MREFD
@ 22,2 SAY 'REF.DESIGNATOR (RETURN FOR NEXT RECORD) :'
@ $,43 GET MREFD PICTURE 'AA####'
READ
ENDIF
ENDIF
SET CONFIRM ON
RELEASE OLDREFC,OLDVALUE
ERASE
RETURN
*TO CALLING COMMANDFILE
«eof»