|
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: 8960 (0x2300)
Types: TextFile
Names: »PRINTKIT.PRG«
└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
└─ ⟦this⟧ »PRINTKIT.PRG«
*******************************************************************************
*DESIGN NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*PROCEDURE PRINTKIT CALLED FROM PFIL
GO TOP
SET TALK OFF
SET FORMAT TO PRINT
EJECT
STORE CHR(30)-CHR(31) TO MHEADW
@ 1,1 SAY MHEADW
SET FORMAT TO SCREEN
ERASE
STORE N TO SOTS
@ 10,10 SAY 'PLEASE ADJUST TO TOP OF FORM'
@ 12,10 SAY 'DO YOU WANT SOTKITS APPENDED (Y/N)? ' GET SOTS
READ
@ 12,10 SAY 'PRINTING KIT-LIST '
SET FORMAT TO PRINT
SET MARGIN TO 1
STORE 63 TO RIGHT
*******************************************************************************
*OUTPUT REPORTHEADER
@ 8,1 SAY 'DATE: '+DATO
@ 10,1 SAY '****************************************************************'
@ 11,1 SAY '** **'
@ 12,1 SAY '** KITLIST **'
@ 13,1 SAY '** **'
@ 14,1 SAY '** UNIT: '+UNITNAME+' CONFIGURATION_FILE: '+CONFIGNAME
@ 14,RIGHT SAY '**'
@ 15,1 SAY '**------------------------------------------------------------**'
@ 16,1 SAY '** **'
@ 17,1 SAY '** COMPONENTS CONTAINED IN FILE: '+OPERDBF
@ 17,RIGHT SAY '**'
@ 18,1 SAY '** **'
@ 19,1 SAY '****************************************************************'
@ 20,1 SAY PRINTCTR
*******************************************************************************
RELEASE RIGHT,MHEADW
STORE CHR(149) TO HY
STORE HY+HY+HY+HY+HY TO LINE
STORE LINE+LINE+LINE+LINE+LINE+LINE+HY TO LINE31
STORE CHR(152)+LINE+CHR(145)+LINE+CHR(145)+LINE31+CHR(145) TO TOPLINE
STORE TOPLINE+$(LINE31,1,15)+CHR(145)+$(LINE31,1,12)+CHR(145) TO TOPLINE
STORE TOPLINE+$(LINE31,1,24)+CHR(153) TO TOPLINE
STORE CHR(147)+LINE+CHR(143)+LINE+CHR(143)+LINE31+CHR(143) TO MIDLINE
STORE MIDLINE+$(LINE31,1,15)+CHR(143)+$(LINE31,1,12)+CHR(143) TO MIDLINE
STORE MIDLINE+$(LINE31,1,24)+CHR(146) TO MIDLINE
STORE CHR(154)+LINE+CHR(144)+LINE+CHR(144)+LINE31+CHR(144) TO BOTLINE
STORE BOTLINE+$(LINE31,1,15)+CHR(144)+$(LINE31,1,12)+CHR(144) TO BOTLINE
STORE BOTLINE+$(LINE31,1,24)+CHR(155) TO BOTLINE
STORE CHR(150) TO I
STORE I+'ITEM '+I+' QTY.'+I+' DESCRIPTION '+I TO COLH1
STORE COLH1+' LOT NUMBER '+I+' IDENTIFIKAT'+I TO COLH1
STORE COLH1+' REMARKS '+I TO COLH1
STORE I+' NO. '+I+' MGD.'+I+' BESKRIVELSE '+I TO COLH2
STORE COLH2+' DATOKODE '+I+' (IKR/ETC.) '+I TO COLH2
STORE COLH2+' BEMÆRKNINGER '+I TO COLH2
STORE I+' '+I+' '+I+' '+I TO BROW
STORE BROW+' '+I+' '+I TO BROW
STORE BROW+' '+I TO BROW
STORE I+' '+I+' '+I TO TAIL
STORE TAIL+' '+I TO TAIL
RELEASE HY,LINE,LINE31
SET MARGIN TO 5
EJECT
STORE 43 TO ROWTRESH
STORE PINIT TO PAGE
STORE LEN(TOPLINE)-30 TO RIGHT
DO WHILE .NOT.EOF
STORE 1 TO COLUMN
@ 5,1 SAY HEAD1L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ 5,RIGHT SAY HEAD1R USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ 6,1 SAY HEAD2L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ 6,RIGHT SAY HEAD2R USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ 7,1 SAY HEAD3L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
IF PAGE>0
@ 7,RIGHT SAY ' PAGE '+STR(PAGE,2)
ELSE
@ 7,RIGHT SAY ' PAGE '
ENDIF
STORE 9 TO ROW
@ ROW,COLUMN SAY TOPLINE
STORE ROW+1 TO ROW
@ ROW,COLUMN SAY COLH1
STORE ROW+1 TO ROW
@ ROW,COLUMN SAY COLH2
STORE ROW+1 TO ROW
@ ROW,COLUMN SAY MIDLINE
STORE ROW+1 TO ROW
@ ROW,COLUMN SAY MIDLINE
STORE ROW+1 TO ROW
@ ROW,COLUMN SAY BROW
STORE ROW+1 TO ROW
STORE 1 TO ITEM
STORE 0 TO ENDPOS
DO WHILE (ROWTRESH-ROW>(ENDPOS/24)+5).AND..NOT.EOF
STORE 0 TO LASTPOS
STORE @('.',REF:DES) TO ENDPOS
IF ENDPOS=0.AND.'$'$REF:DES
STORE @('$',REF:DES) TO ENDPOS
STORE T TO CHAIN
ELSE
STORE F TO CHAIN
ENDIF
STORE I+' '+STR(ITEM,1)+'. '+I+STR(COUNTER,5)+I TO PRINTSTR1
STORE ITEM+1 TO ITEM
DO WHILE LASTPOS<=ENDPOS
STORE $(REF:DES,LASTPOS+1,30) TO PRINTSTR2
IF LASTPOS+30<ENDPOS
STORE @(',',$(PRINTSTR2,24,7)) TO CURPOS
STORE LASTPOS+23+CURPOS TO LASTPOS
STORE CHR(27)+CHR(67)+$(PRINTSTR2,1,23+CURPOS)+CHR(27)+CHR(68);
TO PRINTSTR2
ELSE
IF CHAIN
STORE @('$',PRINTSTR2) TO MERG
STORE $(PRINTSTR2,1,MERG-1)-',' TO PRINTSTR2
SKIP
STORE @('$',REF:DES) TO ENDPOS
IF ENDPOS=0
STORE F TO CHAIN
STORE @('.',REF:DES) TO ENDPOS
STORE 0 TO LASTPOS
ENDIF
ELSE
STORE ENDPOS+1 TO LASTPOS
ENDIF
STORE CHR(27)+CHR(67)+PRINTSTR2+CHR(27)+CHR(68) TO PRINTSTR2
ENDIF
STORE PRINTSTR1+PRINTSTR2 TO PRINTSTR
@ ROW,1 SAY PRINTSTR
@ ROW,47 SAY TAIL
STORE I+' '+I+' '+I TO PRINTSTR1
STORE ROW+1 TO ROW
ENDDO
@ ROW,1 SAY PRINTSTR1
@ ROW,14 SAY MAIN:CHAR
@ ROW,45 SAY TAIL
STORE ROW+1 TO ROW
@ ROW,1 SAY PRINTSTR1 USING 'XXXXXXXXXXXXX'
@ ROW,14 SAY SPEC:CODE USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ ROW,45 SAY TAIL
STORE ROW+1 TO ROW
@ ROW,1 SAY PRINTSTR1 USING 'XXXXXXXXXXXXX'
STORE GEN:NAME+' '+CVALUE+' '+TOLERANCE+' '+RATED:VOLT TO PRINTVAR
@ ROW,14 SAY PRINTVAR USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
@ ROW,45 SAY TAIL
STORE ROW+1 TO ROW
@ ROW,1 SAY BROW
STORE ROW+1 TO ROW
@ ROW,1 SAY MIDLINE
STORE ROW+1 TO ROW
SKIP
IF $(REF:CODE,1,1)$'CDS'
GO BOTTOM
SKIP
ENDIF
ENDDO
DO WHILE ROW<ROWTRESH
@ ROW,1 SAY BROW
STORE ROW+1 TO ROW
ENDDO
@ ROW,1 SAY BOTLINE
STORE ROW+1 TO ROW
@ ROW,1 SAY BOTT1
STORE ROW+1 TO ROW
@ ROW,1 SAY BOTT2
STORE ROW+1 TO ROW
@ ROW,1 SAY BOTT3
IF PAGE>0
STORE PAGE+1 TO PAGE
ENDIF
ENDDO
*******************************************************************************
*RETURN
SET FORMAT TO SCREEN
IF SOTS
STORE OPERDBF TO MPLL
STORE 'MISING SOT-FILES: ' TO MISSING
GO TOP
LOCATE FOR $(REF:CODE,1,3)='SOT'
STORE @('.',OPERDBF) TO PLACE
STORE $(OPERDBF,1,PLACE) TO MSOURCE
RELEASE PLACE
STORE 0 TO OLDNR
DO WHILE #>OLDNR
STORE # TO OLDNR
IF $(REF:CODE,1,3)='SOT'
STORE 'LISTING OF SELECT_ON_TEST-KIT: '+REF:CODE TO HEADING
*CALL PRINTSOT
SET EXACT ON
STORE REF:CODE TO MSOT
DELETE FOR REF:CODE=MSOT
GO OLDNR
STORE $(REF:CODE,4,2) TO MSOT
IF RANK(MSOT)=RANK(' ').OR.RANK(MSOT)=RANK('0')
STORE $(MSOT,2,1) TO MSOT
ENDIF
STORE MSOURCE-'S'-MSOT TO MSOTNAME
*CHECK IF SOT FILE EXISTS, IF IT DOES NOT TELL IT AND PROCCED
IF FILE(MSOTNAME)
USE PLL_STRU
COPY STRU TO SOTPLL
USE SOTPLL
APPEND FROM &MSOTNAME
REPLACE ALL REF:DES WITH 'SOT'-MSOT
STORE 'PLL' TO MDBASE
*INITIALIZE OPERDBF FOR COMPLETE
STORE 'SOTPLL.DBF' TO OPERDBF
DO COMPLETE
DO CONVERT
USE SOTPLL
*INITIALIZE HEADER FOR PRINTSOT
STORE T TO CALL
SET FORMAT TO PRINT
DO PRINTSOT
SET FORMAT TO SCREEN
ELSE
STORE MISSING+MSOTNAME TO MISSING
ENDIF
ENDIF
USE &MPLL
LOCATE FOR $(REF:CODE,1,3)='SOT'.AND..NOT.*
ENDDO
IF '.'$MISSING
SET FORMAT TO PRINT
EJECT
@ 10,1 SAY MISSING
ENDIF
RECALL ALL
ENDIF
RELEASE ALL LIKE PRINTSTR*
RELEASE TOPLINE
RELEASE MIDLINE
RELEASE BOTLINE
RELEASE ROW,COLUMN,PAGE,ROWTRESH,HEADING,OLDNR,TAIL
RETURN
«eof»