DataMuseum.dk

top - metrics - download

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »CREATDPL.PRG«

└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
    └─⟦this⟧ »CREATDPL.PRG« 
└─⟦9ce0f2175⟧ Bits:30004308/disk3.imd Listaid database backup
    └─⟦this⟧ »CREATDPL.PRG« 

TextFile

*******************************************************************************
*DESIGN: NIF/ASD/SEPTEMBER 1985                                               *
*******************************************************************************
*                                                                             *
*PROCEDURE: CREATDPL CALLED FROM TASK CDPL                                    *
*CALLED WITH PARAMETERS MCON AND MDPL                                         *
*******************************************************************************
SELECT PRIM
USE
ERASE
SELECT SECONDARY
SET EXACT ON
USE DPL_STRU
COPY STRU TO WORK
USE WORK
APPEND BLANK
DELETE
SELECT PRIMARY
USE &MCON
GO TOP
STORE 'PROCEED' TO STATUS
STORE 2 TO ROW
*MERGE MODULES IN CONFIGURATION TO DPL
DO WHILE .NOT.EOF.AND.STATUS='PROCEED'
   STORE CONFIGNAME-SOURCE-'.PLS' TO MSOURCE
   IF ROW>20
      ERASE
      STORE 2 TO ROW
   ENDIF
   @ ROW,10 SAY 'COMPONENTS ARE BEING APPENDED FROM:'
   @ $,$+2  SAY MODULE
   STORE ROW+1 TO ROW
   SELECT SECONDARY
   GO BOTTOM
   STORE # TO MEND
   APPEND FROM &MSOURCE FOR .NOT.($(REF:CODE,1,3)$'DEL,SOT')
   *INITIATE COUNTER
   GO MEND
   SKIP
  REPLACE NEXT 9999 COUNTER WITH NVALUE*P.NUMBER,NVALUE WITH 0,CVALUE WITH ' ';
FOR COUNTER=0.AND.$(REF:CODE,1,2)='64'
   GO BOTTOM
   STORE #+1 TO MSOTPOINT
   APPEND FROM &MSOURCE FOR $(REF:CODE,1,3)='SOT'
   GO BOTTOM
   IF #=MSOTPOINT-1
      STORE F TO MSOTFLAG
   ELSE
      STORE T TO MSOTFLAG
   ENDIF
   GO MEND
   SKIP
   REPLACE NEXT 9999 COUNTER WITH P.NUMBER FOR COUNTER=0
   @ ROW-1,10 SAY 'COMPONENTS HAS BEEN APPENDED FROM: '

  *MERGE COMPONENTS IN SOT_FILES TO DPL
     IF MSOTFLAG
        @ ROW,10 SAY 'PRELIMINARY COMPRESSION'
        APPEND BLANK
        DELETE
        GO MSOTPOINT
        DO WHILE .NOT.EOF.
           STORE # TO MPOINT
           STORE REF:CODE TO MREFC
           SUM NEXT 9999 COUNTER TO MC FOR REF:CODE=MREFC
           GO MPOINT
           REPLACE COUNTER WITH MC
           SKIP
           DELETE NEXT 9999 FOR REF:CODE=MREFC
           GO MPOINT+1
           LOCATE NEXT 9999 FOR .NOT.*
           IF *
              SKIP
           ENDIF
        ENDDO
        GO MSOTPOINT
     ENDIF

     DO WHILE .NOT.EOF.AND.MSOTFLAG

        STORE COUNTER TO MCOUNTER
        STORE # TO MCURRENT
        GO BOTTOM
        STORE # TO MEND
        GO MCURRENT
        STORE CONFIGNAME-P.SOURCE-'.S'-$(REF:CODE,4,2) TO MSOTFILE
        IF FILE(MSOTFILE)
          IF ROW>20
             STORE 2 TO ROW
             ERASE
          ENDIF
          @ ROW,10 SAY 'COMPONENTS ARE BEING APPENDED FROM:'
          @ $,$+2 SAY P.MODULE+' SOT No. '+$(REF:CODE,4,2)
          STORE ROW+1 TO ROW
          APPEND FROM &MSOTFILE FOR .NOT.($(REF:CODE,1,3)$'SOT,DEL')
          *INITIATE COUNTER
          GO MEND+1
          REPLACE NEXT 9999 COUNTER WITH MCOUNTER FOR COUNTER=0
          GO BOTTOM
          @ ROW-1,10 SAY 'COMPONENTS HAS BEEN APPENDED FROM: '
       ELSE
          STORE 'SOT-KIT DEFINITION MISSING: '+MSOTFILE TO STATUS
       ENDIF
       GO MCURRENT
       DELETE
       SKIP
       LOCATE NEXT 9999 FOR $(REF:CODE,1,3)='SOT'.AND..NOT.*
       IF $(REF:CODE,1,3)<>'SOT'.OR.*
          STORE F TO MSOTFLAG
       ENDIF
    ENDDO
   * NEXT MODULE
   SELECT PRIMARY
   SKIP
ENDDO
ERASE
SELECT SECONDARY
IF STATUS='PROCEED'

   GO BOTTOM
   @ 10,10 SAY 'COMPRESSION OF DATABASE....START SIZE = '+STR(#,5)
   *COUNT AND DELETE REDUNDANT RECORDS
   INDEX ON REF:CODE+STR(NVALUE,13,4)+RATED:VOLT+TOLERANCE TO WORK
   COPY TO &MDPL
   USE &MDPL
   DELETE FILE WORK
   DELETE FILE WORK.NDX
   DO TOTDEL
   COPY TO WORK
   USE WORK
   DELETE FILE &MDPL
   COPY TO &MDPL
   USE &MDPL
   DELETE FILE WORK 
   ERASE
ENDIF

IF STATUS='PROCEED'
   *COMPLETE DPL RECORDS FROM PPL AND CUSTOM FILES
   @ $+4,10 SAY 'THE SPECIFICATIONS ARE NOW BEING INSERTED'
   STORE 'DPL' TO MDBASE
   SELECT SECONDARY
   USE
   SELECT PRIMARY
   USE &MDPL
   STORE MDPL TO OPERDBF
   DO CASE
      CASE $(PPLNAME,3,4)='HIP1'
           DO COMPHIP1
      OTHERWISE
           DO COMPLETE
   ENDCASE
   SELECT PRIMARY
   *CONVERT NVALUE TO CVALUE AND FILL IN TO COMPLETE THE SPEC.
   IF STATUS='PROCEED'
      DO CONVERT
   ENDIF
ENDIF
RETURN
«eof»