|
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: 1280 (0x500)
Types: TextFile
Names: »CRTPERM.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »CRTPERM.PRG«
*******************************************************************************
* GENERATES PERMUTATION OF COMPONENTS FROMM PPL
SELECT PRIM
USE PLS_STRU
COPY TO CONFPERM
USE CONFPERM
APPEND FROM PPL_IN01
GO TOP
SET EXACT OFF
STORE 0 TO MX
DO WHILE MX<4
STORE MX+1 TO MX
DO CASE
CASE MX=1
STORE '4' TO GROUP
STORE 'RESIPERM' TO APPDBF
CASE MX=2
STORE '5' TO GROUP
STORE 'CAPAPERM' TO APPDBF
CASE MX=3
STORE '8' TO GROUP
STORE 'INDUPERM' TO APPDBF
ENDCASE
STORE 0 TO OLDNR
LOCATE FOR $(REF:CODE,1,1)=GROUP.AND..NOT.*
DO WHILE #>OLDNR.AND.REF:CODE=GROUP.AND..NOT.*
STORE # TO OLDNR
STORE REF:CODE TO MREFC
GO BOTTOM
STORE # TO LBOTT
APPEND FROM &APPDBF
GO BOTTOM
STORE STR(#-LBOTT,5) TO MSCOPE
GO LBOTT+1
REPLACE NEXT &MSCOPE REF:CODE WITH MREFC
DELETE FOR REF:CODE=MREFC
LOCATE FOR $(REF:CODE,1,1)=GROUP.AND..NOT.*
ENDDO
ENDDO
RECALL ALL
INDEX ON REF:CODE+STR(NVALUE,13,4) TO WORK
SET INDEX TO WORK
COPY TO CONFPERM.PLS
US CONFPERM.PLS
DELETE FOR $(REF:CODE,1,1)$'458'.AND.NVALUE=0
PACK
REPLACE ALL REF:DES WITH 'NR'-STR(#,4)
DO REPREF
LIST
CLEAR
RETURN
«eof»