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