|
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: 2304 (0x900)
Types: TextFile
Names: »UCUS.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »UCUS.PRG«
*******************************************************************************
* NIF/ASD/FEBRUARY 1985
*******************************************************************************
* UCUS.PRG: UPDATES USERDEFINED CUSTOM DESIGNED PARTS LIST
*******************************************************************************
ERASE
SET ESCAPE OFF
STORE $(CONFIGNAME,1,2)-'CUS_'-$(CONFIGNAME,3,4) TO MCUS
IF FILE(MCUS)
USE &MCUS
GO TOP
STORE 'E' TO MOPTION
DO WHILE MOPTION<>'Q'
SET FORMAT TO SCREEN
@ 4,1 SAY 'ENTER OPTION: ' GET MOPTION PICTURE '!'
@ 6,1 SAY 'E= EDIT RECORD DENOTED BY REFERENCE CODE'
@ 7,1 SAY 'I= APPEND NEW RECORDS'
@ 8,1 SAY 'L= LIST RECORD'
@ 9,1 SAY 'Q= RETURN TO MENU'
READ
DO CASE
CASE MOPTION='E'
CLEAR GETS
STORE 'C ' TO MREF
@ 12,1 SAY 'ENTER REF:CODE: ' GET MREF PICTURE 'CX####'
READ
LOCATE FOR REF:CODE=MREF
IF REF:CODE<>MREF
ERASE
@ 2,1 SAY MREF+' DOES NOT EXIST'
ELSE
STORE # TO MREC
ERASE
SET FORMAT TO CUSTOM
EDIT MREC
ERASE
ENDIF
CASE MOPTION='I'
SET FORMAT TO CUSTOM
SET CARRY ON
APPEND
ERASE
CASE MOPTION='L'
GO TOP
DO WHILE .NOT.EOF
ERASE
LIST NEXT 18
SKIP
WAIT
ENDDO
ERASE
CASE MOPTION='Q'
@ 2,1 SAY 'SORTING AND PACKING'
SET DELETED ON
SORT ON REF:CODE TO WORK
USE WORK
DELETE FILE &MCUS
COPY TO &MCUS
USE
DELETE FILE WORK
OTHERWISE
ERASE
@ 2,1 SAY 'UNKNOWN OPTION '
ENDCASE
ENDDO
STORE 'READY' TO STATUS
ELSE
STORE 'CUSTOM DESIGNED COMPONENTS LIST DOES NOT EXIST' TO STATUS
ENDIF
SET ESCAPE ON
RELEASE ALL LIKE M*
RETURN
«eof»