|
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: 6144 (0x1800)
Types: TextFile
Names: »UMOD.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »UMOD.PRG«
*******************************************************************************
*DESIGN: NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*TASK:UMOD
*FUNCTION: UPDATES AN ALREADY EXISTING MODULEFILE
*
*******************************************************************************
*PROMPT USER FOR MODULEFILE IF NOT CALLED FROM ANOTHER PROGRAM
SET ESCAPE OFF
ERASE
SET FORMAT TO SCREEN
IF .NOT.CALL
STORE 'FILE' TO MSOURCE
@ 10,20 SAY 'ENTER POINTER FOR MODULEFILE: '+CONFIGNAME-'_'
@ $,$+1 GET MSOURCE PICTURE 'AAAA'
READ
STORE !(MSOURCE) TO MSOURCE
ENDIF
STORE CONFIGNAME-MSOURCE-'.PLS' TO OPERDBF
IF FILE(OPERDBF)
STORE 'E' TO MOPTION
USE &OPERDBF
COPY TO WORK.PLS
USE WORK.PLS
ERASE
STORE T TO MUPDATE
DO WHILE MOPTION<>'Q'
@ 4,1 SAY 'ENTER OPTION: ' GET MOPTION PICTURE '!'
@ 6,1 SAY 'E= EDIT COMPONENT DENOTED BY REFERENCE DESIGNATOR'
@ 7,1 SAY 'I= APPEND NEW COMPONENTS'
@ 8,1 SAY 'L= LIST WORKFILE'
@ 9,1 SAY 'V= VERIFY CHANGES'
@ 10,1 SAY 'U= MAKE UPDATE EFFECTIVE ON '+OPERDBF
@ 11,1 SAY 'Q= RETURN TO MENU WITHOUT FURTHER UPDATE OF '+OPERDBF
READ
DO CASE
CASE MOPTION='E'
* 'EDIT A RECORD'
CLEAR GETS
STORE ' ' TO MREFD
@ 12,1 SAY 'ENTER REFERENCE DESIGNATOR: '
DO WHILE MREFD=' '
@ 12,29 GET MREFD PICTURE 'AA####'
READ
IF MREFD=' '
@ 12,37 SAY "JUST DO AS YOU'RE TOLD "
ENDIF
ENDDO
ERASE
STORE T TO NEXT
DO WHILE NEXT
CLEAR GETS
SET DELETED OFF
IF MREFD<>' '
LOCATE FOR REF:DES=MREFD
IF REF:DES<>MREFD
@ 2,1 SAY MREFD +" NOT IN MODULE -- OPTION 'I' TO APPEND IT"
STORE F TO NEXT
ELSE
DO PLSEDIT
STORE F TO MUPDATE
ENDIF
ELSE
SKIP
IF EOF
GO TOP
ENDIF
STORE REF:DES TO MREFD
DO PLSEDIT
ENDIF
ENDDO
CASE MOPTION='I'
GO BOTTOM
STORE 'INITIAL STATE' TO MVALIDSTAT
STORE 'APPEND' TO MINTYPE
STORE 'C' TO MCONTINUE
STORE ' ' TO MREFD
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 MODIN
STORE F TO MUPDATE
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 MODIN
ENDDO
ENDDO
IF MCONTINUE='D'
DELETE
ENDIF
CASE MOPTION='V'
*DO VERIFY
@ $,$+3 SAY 'NOT IMPLEMENTED '
CASE MOPTION='U'
@ $,$+3 SAY 'RECORDS ARE BEING TRANSFERRED TO '+OPERDBF
PACK
REPLACE ALL NVALUE WITH 0 FOR $(REF:CODE,1,2)#'64'.AND.(.NOT.($(REF:CODE,1,1)$;
'458'))
REPLACE ALL RATED:VOLT WITH ' ' FOR $(REF:CODE,1,1)<>'5'
REPLACE ALL TOLERANCE WITH ' ' FOR .NOT.($(REF:CODE,1,1)$'458')
DELETE FILE &OPERDBF
INDEX ON $(REF:DES,1,2)+STR(VAL($(REF:DES,3,4)),4) TO WORK.NDX
SET INDEX TO WORK.NDX
COPY TO &OPERDBF
SET INDEX TO
DELETE FILE WORK.NDX
STORE T TO MUPDATE
ERASE
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.PLS
STORE 'READY' TO STATUS
USE &OPERDBF
GO BOTTOM
IF #<1
USE
DELETE FILE &OPERDBF
STORE OPERDBF+' DELETED --- NO ENTRIES' TO STATUS
ENDIF
ELSE
STORE 'E' TO MOPTION
ENDIF
CASE MOPTION='L'
GO TOP
STORE 'C' TO DUMMY
DO WHILE .NOT.EOF.AND.DUMMY='C'
ERASE
@ 1,0 SAY 'RECORD REFDES REFCOD NUMERIC VALUE TOL VOLT REM'
LIST NEXT 18
@ 22,0 SAY 'C= MORE OUTPUT, X= RETURN TO MENU ' GET DUMMY
READ
SKIP
ENDDO
ERASE
OTHERWISE
@ 4,17 SAY 'UNKNOWN OPTION'
ENDCASE
CLEAR GETS
ENDDO
ELSE
STORE 'FILE: '+OPERDBF+' DOES NOT EXIST -- USE DMOD' TO STATUS
ENDIF
RELEASE DUMMY,NEXT
RELEASE ALL LIKE M*
SET ESCAPE ON
RETURN
«eof»