DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦f3cca0bd8⟧ TextFile

    Length: 7168 (0x1c00)
    Types: TextFile
    Names: »MODIN.PRG«

Derivation

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

TextFile

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