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 - metrics - download

⟦25bc0e7d5⟧ TextFile

    Length: 7808 (0x1e80)
    Types: TextFile
    Names: »AJVARER2.FRM«

Derivation

└─⟦7c116f58e⟧ Bits:30007007/RCPRAX.imd RC Prislistesystem
    └─⟦this⟧ »AJVARER2.FRM« 
└─⟦9cc652d2b⟧ Bits:30007007/RCPRAZ.imd RC Prislistesystem
    └─⟦this⟧ »AJVARER2.FRM«

TextFile

/PROMPM                                 // PROGRAM: AJVARER2.FRM
*****************************************************************************
***              P R I S L I S T E     S Y S T E M                 M 23-2 ***
*****************************************************************************


PROGRAM NAVN  ............:    AJOURFØR VARE REGISTER MED PLS DATA.


BEHANDLET ................:    ___________


BEMÆRKNING ...............:    ______________________________

                               ______________________________

SVAR TIL BEMÆRKNING ......:    _             Hjælp findes her

*****************************************************************************
/HELP1
=============================================================================
===               OPLYSNINGER  OM  PROGRAMMET                             ===
=============================================================================
                  Dette program overfører data fra PLS til VARE REGISTER,
                  og udfører beregninger af DB, DG samt RABAT for danske
                  priser.
                  For EKSPORT priser beregnes DB og DG, såfremt
                  den omregnede danske pris er større end nul.
                  VALUTA beregning udføres IKKE !

AFBRYD            Du kan afbryde programmet ved at trykke på et tilfældigt
                  bogstav under kørsel, og ENTEN vælge S for stop, men så kan
                  du ikke anvende SYSTEMET, før du har startet forfra, ELLER
                  tryk RETUR, og så vil programmet fortsætte.

tryk på en tast for RETUR til billed.
=============================================================================
/*
FORMAT PROMPM.1 ædisplayonlyå
FORMAT PROMPM.2 ædisplayonlyå
FORMAT PROMPM.3 ædisplayonlyå
FORMAT PROMPM.4 æcapslock,check="S "å
INDICATOR NYBEREGN      // TRUE = PRISÆNDRING ELLER NY REKORD ELLER FALSE
STRING NYSKODE 1
STRING NYSHG 1
STRING NYVNR 11
STRING NYPLSBETG 29
STRING NYDANSKET 40
STRING NYINDGARI 40
NUMBER NYSKOPRIS NYLISPRIS NYDISPRIS NYFORPRIS MELLEM FARDIG
STRING FORST 1
INTEGER LAST
MOVE 0 TO LAST
OPEN VARER
ENTER VARER
//
//    2. RUNDE   opdater fra OVVARER.TXT  til VARER      ***
//
DISPLAY '           ' TO PROMPM.1
DISPLAY 'OPDAT MED NYE DATA OG  !' TO PROMPM.2
DISPLAY 'BEREGNINGER, TRYK RETUR!' TO PROMPM.3
ACCEPT PROMPM.4
DISPLAY '           ' TO PROMPM.1
DISPLAY 'OPDATERING MED PLS-DATA!' TO PROMPM.2
DISPLAY 'SAMT BEREGNINGER, VENT !' TO PROMPM.3
DISPLAY ' ' TO PROMPM.4
STRING TEMSTR
DIRECT_INPUT "OVVARER.TXT"
ÆSEQEOFÅ GOTO SLUT
//
REPEAT
 CLEAR VARER
 INDICATE NYBEREGN FALSE
 READLN NYVNR
 IF NYVNR EQ 'SLUT' BEGIN
    INDICATE SEQEOF TRUE
    GOTO SLUT
 END
 UPPERCASE NYVNR
 READLN NYSKODE
 READLN NYSHG
 UPPERCASE NYSHG
 READLN NYPLSBETG
 UPPERCASE NYPLSBETG
 READLN NYDANSKET
 UPPERCASE NYDANSKET
 READLN NYSKOPRIS
 READLN NYLISPRIS
 READLN NYFORPRIS
 READLN NYDISPRIS
 READLN NYINDGARI
 // nye data læst, find og opdat varen ***
 MOVE NYVNR TO VARER.VNR
 DISPLAY VARER.VNR TO PROMPM.1
 FIND EQ VARER BY INDEX.1
 // VARENUMMER EKSISTRER I FORVEJEN - ALM. OPDAT
 ÆFOUNDÅ BEGIN
  KEYCHECK GOSUB UDRUTINE
  IF VARER.DANSKET EQ ' ' BEGIN
     MOVE NYDANSKET TO VARER.DANSKET
  END
  IF NYSKOPRIS NE VARER.SKOPRIS BEGIN
     MOVE 'K' TO VARER.SKOKOR
     INDICATE NYBEREGN TRUE
  END
  IF NYLISPRIS NE VARER.LISPRIS BEGIN
     MOVE 'L' TO VARER.LISKOR
     INDICATE NYBEREGN TRUE
  END
  IF NYFORPRIS NE VARER.FORPRIS BEGIN
     MOVE 'F' TO VARER.FORKOR
     INDICATE NYBEREGN TRUE
  END
  IF NYDISPRIS NE VARER.DISPRIS BEGIN
     MOVE 'D' TO VARER.DISKOR
     INDICATE NYBEREGN TRUE
  END
  MOVE 'A' TO VARER.AJO
  GOTO FAELLES
 END
 // NY RECORD SKAL OPRETTES
 ÆFINDERRÅ BEGIN
  KEYCHECK GOSUB UDRUTINE
  CLEAR VARER
  INDICATE NYBEREGN TRUE
  MOVE NYVNR TO VARER.VNR
  LEFT VARER.VNR TO FORST 1
  MOVE '6' TO VARER.SNR
  IF FORST IN "R" MOVE '1' TO VARER.SNR
  IF FORST IN "M" MOVE '2' TO VARER.SNR
  IF FORST IN "T" MOVE '3' TO VARER.SNR
  IF FORST IN "F" MOVE '4' TO VARER.SNR
  IF FORST IN "C" MOVE '5' TO VARER.SNR
  IF FORST IN "S" MOVE '9' TO VARER.SNR
  MOVE NYDANSKET TO VARER.DANSKET
  MOVE ' ' TO VARER.SKOKOR
  MOVE ' ' TO VARER.LISKOR
  MOVE ' ' TO VARER.FORKOR
  MOVE ' ' TO VARER.DISKOR
  MOVE ' ' TO VARER.ENGKOR
  MOVE 0   TO VARER.ENGVALU
  MOVE 0   TO VARER.ENGPRIS
  MOVE ' ' TO VARER.TYSKOR
  MOVE 0   TO VARER.TYSVALU
  MOVE 0   TO VARER.TYSPRIS
  MOVE ' ' TO VARER.SVEKOR
  MOVE 0   TO VARER.SVEVALU
  MOVE 0   TO VARER.SVEPRIS
  MOVE ' ' TO VARER.NORKOR
  MOVE 0   TO VARER.NORVALU
  MOVE 0   TO VARER.NORPRIS
  MOVE 'O' TO VARER.AJO
 END
FAELLES:
 // FÆLLES FOR EKSISTERENDE OG NYOPRETTEDE VARER
 MOVE NYSHG     TO VARER.SHG
 MOVE NYPLSBETG TO VARER.PLSBETG
 MOVE NYSKOPRIS TO VARER.SKOPRIS
 MOVE NYLISPRIS TO VARER.LISPRIS
 MOVE NYFORPRIS TO VARER.FORPRIS
 MOVE NYDISPRIS TO VARER.DISPRIS
 MOVE NYINDGARI TO VARER.INDGARI
 MOVE NYSKODE   TO VARER.SKODE
 Æ NOT NYBEREGN Å GOTO GEM
 MOVE 0 TO VARER.LISDB
 MOVE 0 TO VARER.LISDG
 MOVE 0 TO VARER.FORDB
 MOVE 0 TO VARER.FORDG
 MOVE 0 TO VARER.FORRABAT
 MOVE 0 TO VARER.DISDB
 MOVE 0 TO VARER.DISDG
 MOVE 0 TO VARER.DISRABAT
 MOVE 0 TO VARER.ENGDB
 MOVE 0 TO VARER.ENGDG
 MOVE 0 TO VARER.TYSDB
 MOVE 0 TO VARER.TYSDG
 MOVE 0 TO VARER.SVEDB
 MOVE 0 TO VARER.SVEDG
 MOVE 0 TO VARER.NORDB
 MOVE 0 TO VARER.NORDG
 // beregn db og dg danske priser
 IF VARER.SKOPRIS NE 0 BEGIN
  IF VARER.LISPRIS NE 0 BEGIN
   MOVE (VARER.LISPRIS - VARER.SKOPRIS) TO VARER.LISDB
   MOVE ((VARER.LISDB * 100) / VARER.LISPRIS) TO VARER.LISDG
  END
  IF VARER.FORPRIS NE 0 BEGIN
   MOVE (VARER.FORPRIS - VARER.SKOPRIS) TO VARER.FORDB
   MOVE ((VARER.FORDB * 100) / VARER.FORPRIS) TO VARER.FORDG
  END
  IF VARER.DISPRIS NE 0 BEGIN
   MOVE (VARER.DISPRIS - VARER.SKOPRIS) TO VARER.DISDB
   MOVE ((VARER.DISDB * 100) / VARER.DISPRIS) TO VARER.DISDG
  END
 END
 // beregn rabat danske priser
 IF VARER.LISPRIS NE 0 BEGIN
  IF VARER.FORPRIS NE 0 BEGIN
  MOVE (((VARER.LISPRIS-VARER.FORPRIS)*100)/VARER.LISPRIS) TO VARER.FORRABAT
  END
  IF VARER.DISPRIS NE 0 BEGIN
  MOVE (((VARER.LISPRIS-VARER.DISPRIS)*100)/VARER.LISPRIS) TO VARER.DISRABAT
  END
 END
 // beregn DB OG DG eksport priser
 IF VARER.DISPRIS NE 0 BEGIN
  IF VARER.ENGPRIS NE 0 BEGIN
   MOVE (VARER.ENGPRIS - VARER.DISPRIS) TO VARER.ENGDB
   MOVE ((VARER.ENGDB * 100) / VARER.ENGPRIS) TO VARER.ENGDG
  END
  IF VARER.TYSPRIS NE 0 BEGIN
   MOVE (VARER.TYSPRIS - VARER.DISPRIS) TO VARER.TYSDB
   MOVE ((VARER.TYSDB * 100) / VARER.TYSPRIS) TO VARER.TYSDG
  END
  IF VARER.SVEPRIS NE 0 BEGIN
   MOVE (VARER.SVEPRIS - VARER.DISPRIS) TO VARER.SVEDB
   MOVE ((VARER.SVEDB * 100) / VARER.SVEPRIS) TO VARER.SVEDG
  END
  IF VARER.NORPRIS NE 0 BEGIN
   MOVE (VARER.NORPRIS - VARER.DISPRIS) TO VARER.NORDB
   CALC (VARER.NORDB * 100) TO MELLEM
   CALC (MELLEM / VARER.NORPRIS) TO FARDIG
   MOVE FARDIG TO VARER.NORDG
  END
 END
GEM:
SAVERECORD VARER
KEYCHECK GOSUB UDRUTINE
INCREMENT LAST
ÆNOT SEQEOFÅ LOOP
//
SLUT:
DISPLAY LAST TO PROMPM.1
DISPLAY 'OPDATERET MED NYE DATA !' TO PROMPM.2
DISPLAY 'SLUT 2 --  TRYK RETUR  !' TO PROMPM.3
ACCEPT PROMPM.4
KEYCHECK GOSUB UDRUTINE
CHAIN "AJVARER3"
//
UDRUTINE:
 INDICATE KEYPRESS FALSE 
 DISPLAY 'DU HAR STOPPET PROGRAMMET !' TO PROMPM.2
 DISPLAY 'TAST S (STOP) ELLER TRYK RETUR' TO PROMPM.3
 ACCEPT PROMPM.4
 IF PROMPM.4 IN "Ss" MOVE 0 TO LAST
 IF PROMPM.4 IN "Ss" CHAIN "AJVARER3"
RETURN
//
KEYPROC KEY.HELP:
    HELP
    ENTAGAIN
RETURN
//
ENTEREND
CHAIN "OVERSIGT"
«eof»