DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦04f518efa⟧ TextFile

    Length: 5120 (0x1400)
    Types: TextFile
    Names: »PRINDPL1.PRG«

Derivation

└─⟦71c82d5c0⟧ Bits:30004214 LISTAID - Partslist management system
    └─ ⟦this⟧ »PRINDPL1.PRG« 

TextFile

*DESIGN NIF/ASD/SEPTEMBER 1985
*******************************************************************************
*
*PROCEDURE PRINTDPL 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 F TO INTERN
@ 10,10 SAY 'PLEASE ADJUST TO TOP OF FORM'
@ 12,10 SAY 'FOR INTERNAL USE? (Y/N) ' GET  INTERN
READ
@ 12,10 SAY 'PRINTING DECLARED PARTSLIST (LONG FORM)'
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 '** DECLARED PARTSLIST                                         **'
@ 13,1 SAY '**                                                            **'
@ 14,1 SAY '** UNIT: '+UNITNAME+'    CONFIGURATION_FILE: '+CONFIGNAME
@ 14,RIGHT SAY '**'
@ 15,1 SAY '**------------------------------------------------------------**'
@ 16,1 SAY '**                                                            **'
@ 17,1 SAY '** INFORMATION CONTAINED IN FILE: '+OPERDBF
@ 17,RIGHT SAY '**'
@ 18,1 SAY '**                                                            **'
IF INTERN
@ 19,1 SAY '** LISTING FOR INTERNAL USE ONLY********************************'
ELSE
@ 19,1 SAY '****************************************************************'
ENDIF
@ 20,1 SAY PRINTCTR
*******************************************************************************

   SET MARGIN TO 5
   EJECT
   STORE 40 TO ROWTRESH
   STORE PINIT TO PAGE
        *012345678901234567890123456789012345678901234567890123456789012345678
  STORE 'GEN_NAME----VALUE-------TOL---VOLT--' TO HEADER
STORE HEADER+'SPECIFICATION_CODE--------------ISS-PACKAGE-MANUF-AG.--QTY-REQU.;
--ATT-TOTAL' TO HEADER
IF INTERN
   STORE HEADER+'-ORDER--REST-CPP-' TO HEADER
ENDIF
STORE '-----------------------------------------------------------------------;
----------------------------' TO SEP1
STORE '***********************************************************************;
****************************' TO SEP2
STORE LEN(HEADER)-30 TO RIGHT

   DO WHILE .NOT.EOF
      @ 2,1 SAY HEAD1L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
      @ 2,RIGHT SAY HEAD1R USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
      @ 3,1 SAY HEAD2L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
      @ 3,RIGHT SAY HEAD2R USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
      @ 4,1 SAY HEAD3L USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
      @ 4,RIGHT SAY '                       PAGE '+STR(PAGE,2)
      STORE 6 TO ROW
      STORE 1 TO COLUMN
      @ ROW,COLUMN SAY HEADER
      STORE ROW+2 TO ROW
      DO WHILE ROW<=ROWTRESH.AND..NOT.EOF
         STORE 1 TO COLUMN
         @ ROW,COLUMN SAY GEN:NAME USING 'XXXXXXXXXX'
         STORE 13 TO COLUMN
         @ ROW,COLUMN SAY CVALUE USING 'XXXXXXXXX'
         STORE 24 TO COLUMN
         @ ROW,COLUMN SAY TOLERANCE USING 'XXXX'
         STORE 30 TO COLUMN
         @ ROW,COLUMN SAY RATED:VOLT USING 'XXXX'
         STORE 37 TO COLUMN
         @ ROW,COLUMN SAY SPEC:CODE USING 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
         STORE 69 TO COLUMN
         @ ROW,COLUMN SAY ISSUE USING 'XXX'
         STORE 73 TO COLUMN
         @ ROW,COLUMN SAY PACKAGE USING 'XXXXXXXX'
         STORE 81 TO COLUMN
         @ ROW,COLUMN SAY MANUF USING 'XXXXX'
         STORE 87 TO COLUMN
         @ ROW,COLUMN SAY AGENCY USING 'XXX'
         STORE 91 TO COLUMN
         STORE STR(COUNTER,4) TO MPRINTVAR
         @ ROW,COLUMN SAY MPRINTVAR USING 'XXXX'
         STORE 96 TO COLUMN
         STORE STR(REQUIRED,5) TO MPRINTVAR
         @ ROW,COLUMN SAY MPRINTVAR USING 'XXXXX'
         STORE 102 TO COLUMN
         STORE STR(NATTR,4) TO MPRINTVAR
         @ ROW,COLUMN SAY MPRINTVAR USING 'XXXX'         
         STORE 107 TO COLUMN
         STORE STR(NATTR+REQUIRED,5) TO MPRINTVAR
         @ ROW,COLUMN SAY MPRINTVAR USING 'XXXXX'
         
         IF INTERN
            STORE 113 TO COLUMN
            STORE STR(ORDERED,5) TO MPRINTVAR
            @ ROW,COLUMN SAY MPRINTVAR USING 'XXXXX'
            STORE 119 TO COLUMN
            STORE STR(REST,5) TO MPRINTVAR
            @ ROW,COLUMN SAY MPRINTVAR USING 'XXXXX'
            STORE 125 TO COLUMN
            @ ROW,COLUMN SAY CPP:NO
         ENDIF
         STORE ROW+2 TO ROW
         SKIP
      ENDDO
      STORE ROW+2 TO ROW
      @ ROW,1 SAY BOTT1
      STORE ROW+1 TO ROW
      @ ROW,1 SAY BOTT2
      STORE ROW+1 TO ROW
      @ ROW,1 SAY BOTT3
      STORE PAGE+1 TO PAGE
   ENDDO
@ ROW+2,1 SAY '--------- END OF LIST -----------------------------------------;
-------------------------------------'
*******************************************************************************
*RETURN
RELEASE ROW,COLUMN,PAGE,ROWTRESH,HEADER,RIGHT,SEPERATOR,MPRINTVAR
RETURN
«eof»