|
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: 5632 (0x1600)
Types: TextFile
Names: »USOT.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »USOT.PRG«
*******************************************************************************
*DESIGN: NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*TASK:USOT
*FUNCTION: UPDATES AN ALREADY EXISTING SOT KIT FILE
*
*******************************************************************************
*PROMPT USER FOR MODULEFILE&SOT KIT NO.IF NOT CALLED FROM ANOTHER PROGRAM
SET ESCAPE OFF
ERASE
SET FORMAT TO SCREEN
IF .NOT.CALL
STORE 'FILE' TO MSOURCE
STORE ' ' TO MSOT
@ 10,20 SAY 'ENTER POINTER FOR MODULEFILE: '+CONFIGNAME-'_'
@ $,$+1 GET MSOURCE PICTURE 'AAAA'
@ 12,20 SAY 'ENTER SOT-KIT No. ' GET MSOT PICTURE '##'
READ
STORE !(MSOURCE) TO MSOURCE
IF RANK(MSOT)=RANK(' ').OR.RANK(MSOT)=RANK('0')
STORE $(MSOT,2,1) TO MSOT
ENDIF
STORE CONFIGNAME-MSOURCE-'.S'-MSOT TO OPERDBF
ENDIF
IF FILE(OPERDBF)
STORE 'E' TO MOPTION
USE &OPERDBF
COPY TO WORK.SOT
USE WORK.SOT
ERASE
STORE F TO MUPDATE
DO WHILE MOPTION<>'Q'
@ 4,1 SAY 'ENTER OPTION: ' GET MOPTION PICTURE '!'
@ 6,1 SAY 'E= EDIT COMPONENT DENOTED BY RECORD NUMBER'
@ 7,1 SAY 'I= APPEND NEW COMPONENTS'
@ 8,1 SAY 'L= LIST OF COMPONENTS'
@ 9,1 SAY 'U= MAKE UPDATE EFFECTIVE ON '+OPERDBF
@ 10,1 SAY 'Q= RETURN TO MENU WITHOUT FURTHER UPDATE OF '+OPERDBF
READ
DO CASE
CASE MOPTION='E'
* 'EDIT A RECORD'
STORE F TO MUPDATE
CLEAR GETS
STORE 0 TO MRECNO
GO BOTTOM
STORE # TO MEND
IF MEND>0
@ 12,1 SAY 'ENTER RECORD NUMBER: '
DO WHILE MRECNO=0
@ 12,29 GET MRECNO PICTURE '#####'
READ
DO CASE
CASE MRECNO=0
@ 12,37 SAY "JUST DO AS YOU'RE TOLD "
CASE MRECNO>MEND
@ 12,37 SAY "THERE IS ONLY "+TRIM(STR(MEND,5))+" RECORDS"
OTHERWISE
GO MRECNO
ENDCASE
ENDDO
CLEAR GETS
DO SOTEDIT
ELSE
STORE 'I' TO MOPTION
@ 4,17 SAY 'THERE ARE NO COMPONENTS IN THE KIT '
ENDIF
CASE MOPTION='I'
STORE F TO MUPDATE
GO BOTTOM
STORE 'INITIAL STATE' TO MVALIDSTAT
STORE 'APPEND' TO MINTYPE
STORE 'C' TO MCONTINUE
STORE ' ' TO MREFC
STORE ' ' TO MRATE
STORE 0 TO MTOLV
STORE '%' TO MTOLT
DO WHILE MCONTINUE<>'S'.AND.MCONTINUE<>'D'
STORE 'C' TO MCONTINUE
STORE 'INITIAL STATE' TO MVALIDSTAT
IF MCONTINUE<>'F'
APPEND BLANK
ENDIF
DO SOTIN
DO WHILE MCONTINUE='F'
STORE 'C' TO MCONTINUE
STORE ' ' TO MGEN
ERASE
@ 10,10 SAY 'ENTER GENERIC NAME: ' GET MGEN PICTURE 'XXXXXXXXXXX'
READ
CLEAR GETS
DO PPLSEARCH
@ $+2,4 SAY 'SELECTED REF.CODE: ' GET MREFC PICTURE 'XXXXXX'
READ
CLEAR GETS
STORE 'PPL-SEARCH COMPLETED' TO MVALIDSTAT
DO SOTIN
ENDDO
ENDDO
IF MCONTINUE='D'
DELETE
ENDIF
CASE MOPTION='L'
ERASE
@ 1,0 SAY 'RECORD REFCODE NVALUE TOL VOLTAGE'
SET DELETED OFF
LIST REF:CODE,NVALUE,TOLERANCE,RATED:VOLT
STORE ' ' TO MDUMMY
@ 22,0 SAY 'RETURN TO CONTINUE ' GET MDUMMY
READ
ERASE
CASE MOPTION='U'
PACK
DELETE FILE &OPERDBF
INDEX ON NVALUE TO WORK.NDX
SET INDEX TO WORK.NDX
COPY TO &OPERDBF
SET INDEX TO
DELETE FILE WORK.NDX
STORE T TO MUPDATE
CASE MOPTION='Q'
IF .NOT.MUPDATE
@ $,$+3 SAY 'UPDATE HAS NOT BEEN MADE...PROCEED? (Y/N) '
@ $,$+2 GET MUPDATE
READ
ENDIF
IF MUPDATE
USE
DELETE FILE WORK.SOT
STORE 'READY' TO STATUS
USE &OPERDBF
GO BOTTOM
IF #<1
USE
DELETE FILE &OPERDBF
STORE OPERDBF+' DELETED --- NO ENTRIES' TO STATUS
ELSE
REPLACE ALL REF:DES WITH 'SOT'-MSOT
STORE 'PLL' TO MDBASE
DO COMPLETE
DO CONVERT
USE
ENDIF
ENDIF
OTHERWISE
@ 4,17 SAY 'UNKNOWN OPTION '
ENDCASE
CLEAR GETS
ENDDO
ELSE
STORE 'FILE: '+OPERDBF+' DOES NOT EXIST -- USE DSOT' TO STATUS
ENDIF
RELEASE ALL LIKE M*
SET ESCAPE ON
RETURN
«eof»