|
|
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 - metrics - download
Length: 2688 (0xa80)
Types: TextFile
Names: »MERG.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─⟦this⟧ »MERG.PRG«
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
└─⟦this⟧ »MERG.PRG«
*******************************************************************************
* TASK:MERG
* MERGES DPL'S AND SUMMARY LISTS TO ONE LIST
*******************************************************************************
*INITIALIZE
SET FORMAT TO SCREEN
SELECT SECO
USE
SELECT PRIM
USE
*ASK USER TO DEFINE SUMMARY SPECIFICATION FILE
ERASE
STORE 'FILE' TO MCON
@ 10,10 SAY 'ENTER SUMMARY SPECIFICATION FILE: CONS_' GET MCON PICTURE 'AAAX'
READ
STORE 'CONS'-!(MCON) TO MCON
*CHECK IF THE DEFINED SPECIFICATION FILE EXISTS
IF FILE(MCON)
*IF IT DOES THEN PUT IT IN USE AND CHECK IF THE SPECIFIED FILES EXIST
STORE 'PROCEED' TO STATUS
USE &MCON
GO TOP
DO WHILE (STATUS='PROCEED').AND.(.NOT.EOF)
IF TYPE='S'
STORE 'SUM_' TO MPREF
ELSE
STORE 'DPL_' TO MPREF
ENDIF
IF .NOT.FILE(MPREF-SOURCE-'.DBF')
STORE 'SOURCE_FILE(S) MISSING' TO STATUS
ENDIF
SKIP
ENDDO
* NOW THAT CHECK HAS BEEN MADE AND WE CAN BEGIN TO APPEND FROM THE SOURCES
IF STATUS='PROCEED'
ERASE
@ 10,10 SAY 'APPENDING RECORDS TO SUMMARY PARTSLIST'
SELECT SECO
USE SUM_STRU
STORE 'SUM_'-$(MCON,5,4) TO MSUM
COPY STRU TO WORK
USE WORK
SET LINKAGE OFF
SELECT PRIM
GO TOP
STORE 1 TO NUMBER
STORE ' ' TO IDENTROW
DO WHILE .NOT.EOF
IF NUMBER<10
STORE 2 TO X
ELSE
STORE 3 TO X
ENDIF
IF TYPE='S'
STORE 'SUM_' TO MPREF
ELSE
STORE 'DPL_' TO MPREF
ENDIF
STORE MPREF-SOURCE TO MSOURCE
STORE IDENTROW-STR(NUMBER,X)-':'-MSOURCE-'--' TO IDENTROW
SELECT SECO
GO BOTTOM
STORE # TO MBOTT
APPEND FROM &MSOURCE
GO MBOTT+1
REPLACE NEXT 9999 NUMROW WITH STR(NUMBER,X)-':('-STR(COUNTER,5)-';';
-STR(REQUIRED,5)-') '
STORE NUMBER+1 TO NUMBER
SELECT PRIM
SKIP
ENDDO
SELECT SECO
GO BOTTOM
@ 10,10 SAY 'COMPRESSION OF DATABASE ....... START SIZE='-STR(#,5)
*NOW THE RECORDS MUST BE MERGED
INDEX ON REF:CODE + STR(NVALUE,13,4) TO WORK
COPY TO &MSUM
USE &MSUM
DELETE FILE WORK
DO SUMDEL
APPEND BLANK
REPLACE NUMROW WITH IDENTROW
INDEX ON REF:CODE + STR(NVALUE,13,4) TO &MSUM
STORE 'SUMMARY LIST CREATED' TO STATUS
ENDIF
ELSE
STORE 'SUMMARY SPECIFICATION FILE DOES NOT EXIST.' TO STATUS
ENDIF
RELEASE ALL LIKE M*
RELEASE IDENTROW,NUMBER,X
SELECT SECO
USE
SELECT PRIM
USE
RETURN
«eof»