DataMuseum.dk

top - metrics - download

    Length: 8192 (0x2000)
    Types: TextFile
    Names: »VAVARER.FRM«

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

TextFile

/PROMF                                 // PROGRAM: VAVARER.FRM
*****************************************************************************
***              P R I S L I S T E     S Y S T E M                 M 46   ***
*****************************************************************************

PROGRAM NAVN  ............:    VALUTA OMREGNING AF UDENLANDSKE PRISER.

START= VAL, SLUT= N ......:    ___      HJÆLP FINDES HER !

TAST VALG AF VALUTA ......:    _        E=ENGELSK, T=TYSK, S=SVENSK, N=NORSK

ANVENDT VALUTA KURS ......:    _____.____

VARENUMMER / BEHANDLET ...:    ___________

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

                               ______________________________

SVAR TIL BEMÆRKNING ......:    _        HJÆLP FINDES HER !
*****************************************************************************
/HELP1
=============================================================================
===               OPLYSNINGER  OM  PROGRAMMET                             ===
=============================================================================
START             Hvis du svarer N (nej) udføres programmet IKKE, og du
                  kommer tilbage til menu-billedet.

                  Hvis du derimod svarer VAL så udfører dette program
                  følgende:

                  Alle varer, hvor den valgte valutapris er større end nul,
                  omregnes med den viste kurs til danske kroner, og samtidig
                  beregnes ny DB og DG.

                  PRISÆNDRINGS MARKERINGEN  anvendes IKKE i dette program !

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å bør
                  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 PROMF.1 æcapslockå
FORMAT PROMF.2 æcapslockå
FORMAT PROMF.3 ædisplayonlyå
FORMAT PROMF.4 ædisplayonlyå
FORMAT PROMF.5 ædisplayonlyå
FORMAT PROMF.6 ædisplayonlyå
FORMAT PROMF.7 æcapslock,check="S "å
INTEGER LAST
// hent og gem valuta kurser
NUMBER ENGKURS TYSKURS SVEKURS NORKURS MELLEM FARDIG
MOVE 0 TO ENGKURS
MOVE 0 TO NORKURS
MOVE 0 TO SVEKURS
MOVE 0 TO TYSKURS
OPEN VALUTA
DISPLAY 'VALUTA KURSER HENTES   !' TO PROMF.5
DISPLAY ' - -   VENT        - - !' TO PROMF.6
FIND GE VALUTA BY RECNUM
//
ÆFOUNDÅ REPEAT
    IF VALUTA.VAL EQ 'L    ' BEGIN
       MOVE VALUTA.KURS TO ENGKURS
       GOTO GEM_VAL
    END
    IF VALUTA.VAL EQ 'DM   ' BEGIN
       MOVE VALUTA.KURS TO TYSKURS
       GOTO GEM_VAL
    END
    IF VALUTA.VAL EQ 'SKR  ' BEGIN
       MOVE VALUTA.KURS TO SVEKURS
       GOTO GEM_VAL
    END
    IF VALUTA.VAL EQ 'NKR  ' BEGIN
       MOVE VALUTA.KURS TO NORKURS
    END
    GEM_VAL:
    SAVERECORD VALUTA
    FIND GT VALUTA BY RECNUM
ÆFOUNDÅ LOOP
//
OPEN VARER
ENTER VARER
//
OM:
CLEARFORM PROMF.1 THRU PROMF.7
ACCEPT PROMF.1
IF PROMF.1 EQ 'N' CHAIN "OVERSIGT"
IF PROMF.1 NE 'VAL' GOTO OM
ACCEPT PROMF.2
IF PROMF.2 EQ 'E' GOTO ENGLAND
IF PROMF.2 EQ 'T' GOTO TYSKLAND
IF PROMF.2 EQ 'S' GOTO SVERIGE
IF PROMF.2 EQ 'N' GOTO NORGE
GOTO OM
//
ENGLAND:
// valuta beregning ENGELSKE eksport priser samt ny DG og DB ***
//
DISPLAY ENGKURS TO PROMF.3
IF ENGKURS EQ 0 BEGIN
   DISPLAY 'KONTROLLER KURSEN   !!!!' TO PROMF.5
   DISPLAY 'TRYK RETUR          !!!!' TO PROMF.6
   ACCEPT PROMF.7
   GOTO OM
END
DISPLAY 'FORTRYDER DU SÅ TAST S !' TO PROMF.5
DISPLAY '     ELLERS TRYK RETUR !' TO PROMF.6
ACCEPT PROMF.7
IF PROMF.7 IN "Ss" GOTO OM
DISPLAY 'BEREGNINGER UDFØRES FOR!' TO PROMF.5
DISPLAY 'ENGLAND , ....... VENT !' TO PROMF.6
MOVE 0 TO LAST
MOVE 0 TO VARER.RECNUM
FIND GE VARER BY RECNUM
//
ÆFOUNDÅ REPEAT
 IF VARER.ENGVALU EQ 0 GOTO GEM_E
 DISPLAY VARER.VNR TO PROMF.4
 INCREMENT LAST
 MOVE 0 TO VARER.ENGPRIS
 MOVE 0 TO VARER.ENGDB
 MOVE 0 TO VARER.ENGDG
 MOVE ((VARER.ENGVALU*ENGKURS)/100) TO VARER.ENGPRIS
 IF VARER.DISPRIS GT 0 BEGIN
   MOVE (VARER.ENGPRIS-VARER.DISPRIS) TO VARER.ENGDB
   MOVE ((VARER.ENGDB*100)/VARER.ENGPRIS) TO VARER.ENGDG
 END
 GEM_E:
 SAVERECORD VARER
 KEYCHECK GOSUB UDRUTINE
 FIND GT VARER BY RECNUM
ÆFOUNDÅ LOOP
GOTO SLUT
//
TYSKLAND:
// valuta beregning TYSKE eksport priser samt ny DG og DB ***
//
DISPLAY TYSKURS TO PROMF.3
IF TYSKURS EQ 0 BEGIN
   DISPLAY 'KONTROLLER KURSEN   !!!!' TO PROMF.5
   DISPLAY 'TRYK RETUR          !!!!' TO PROMF.6
   ACCEPT PROMF.7
   GOTO OM
END
DISPLAY 'FORTRYDER DU SÅ TAST S !' TO PROMF.5
DISPLAY '     ELLERS TRYK RETUR !' TO PROMF.6
ACCEPT PROMF.7
IF PROMF.7 IN "Ss" GOTO OM
DISPLAY 'BEREGNINGER UDFØRES FOR!' TO PROMF.5
DISPLAY 'TYSKLAND , ...... VENT !' TO PROMF.6
MOVE 0 TO LAST
MOVE 0 TO VARER.RECNUM
FIND GE VARER BY RECNUM
//
ÆFOUNDÅ REPEAT
 IF VARER.TYSVALU EQ 0 GOTO GEM_T
 DISPLAY VARER.VNR TO PROMF.4
 INCREMENT LAST
 MOVE 0 TO VARER.TYSPRIS
 MOVE 0 TO VARER.TYSDB
 MOVE 0 TO VARER.TYSDG
 MOVE ((VARER.TYSVALU*TYSKURS)/100) TO VARER.TYSPRIS
 IF VARER.DISPRIS GT 0 BEGIN
   MOVE (VARER.TYSPRIS-VARER.DISPRIS) TO VARER.TYSDB
   MOVE ((VARER.TYSDB*100)/VARER.TYSPRIS) TO VARER.TYSDG
 END
 GEM_T:
 SAVERECORD VARER
 KEYCHECK GOSUB UDRUTINE
 FIND GT VARER BY RECNUM
ÆFOUNDÅ LOOP
GOTO SLUT
//
SVERIGE:
// valuta beregning SVENSKE eksport priser samt ny DG og DB ***
//
DISPLAY SVEKURS TO PROMF.3
IF SVEKURS EQ 0 BEGIN
   DISPLAY 'KONTROLLER KURSEN   !!!!' TO PROMF.5
   DISPLAY 'TRYK RETUR          !!!!' TO PROMF.6
   ACCEPT PROMF.7
   GOTO OM
END
DISPLAY 'FORTRYDER DU SÅ TAST S !' TO PROMF.5
DISPLAY '     ELLERS TRYK RETUR !' TO PROMF.6
ACCEPT PROMF.7
IF PROMF.7 IN "Ss" GOTO OM
DISPLAY 'BEREGNINGER UDFØRES FOR!' TO PROMF.5
DISPLAY 'SVERIGE , ....... VENT !' TO PROMF.6
MOVE 0 TO LAST
MOVE 0 TO VARER.RECNUM
FIND GE VARER BY RECNUM
//
ÆFOUNDÅ REPEAT
 IF VARER.SVEVALU EQ 0 GOTO GEM_S
 DISPLAY VARER.VNR TO PROMF.4
 INCREMENT LAST
 MOVE 0 TO VARER.SVEPRIS
 MOVE 0 TO VARER.SVEDB
 MOVE 0 TO VARER.SVEDG
 MOVE ((VARER.SVEVALU*SVEKURS)/100) TO VARER.SVEPRIS
 IF VARER.DISPRIS GT 0 BEGIN
   MOVE (VARER.SVEPRIS-VARER.DISPRIS) TO VARER.SVEDB
   MOVE ((VARER.SVEDB*100)/VARER.SVEPRIS) TO VARER.SVEDG
 END
 GEM_S:
 SAVERECORD VARER
 KEYCHECK GOSUB UDRUTINE
 FIND GT VARER BY RECNUM
ÆFOUNDÅ LOOP
GOTO SLUT
//
NORGE:
// valuta beregning NORSKE eksport priser samt ny DG og DB ***
//
DISPLAY NORKURS TO PROMF.3
IF NORKURS EQ 0 BEGIN
   DISPLAY 'KONTROLLER KURSEN   !!!!' TO PROMF.5
   DISPLAY 'TRYK RETUR          !!!!' TO PROMF.6
   ACCEPT PROMF.7
   GOTO OM
END
DISPLAY 'FORTRYDER DU SÅ TAST S !' TO PROMF.5
DISPLAY '     ELLERS TRYK RETUR !' TO PROMF.6
ACCEPT PROMF.7
IF PROMF.7 IN "Ss" GOTO OM
DISPLAY 'BEREGNINGER UDFØRES FOR!' TO PROMF.5
DISPLAY 'NORGE , ......... VENT !' TO PROMF.6
MOVE 0 TO LAST
MOVE 0 TO VARER.RECNUM
FIND GE VARER BY RECNUM
//
ÆFOUNDÅ REPEAT
 IF VARER.NORVALU EQ 0 GOTO GEM_N
 DISPLAY VARER.VNR TO PROMF.4
 INCREMENT LAST
 MOVE 0 TO VARER.NORPRIS
 MOVE 0 TO VARER.NORDB
 MOVE 0 TO VARER.NORDG
 MOVE ((VARER.NORVALU*NORKURS)/100) TO VARER.NORPRIS
 IF VARER.DISPRIS GT 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
 GEM_N:
 SAVERECORD VARER
 KEYCHECK GOSUB UDRUTINE
 FIND GT VARER BY RECNUM
ÆFOUNDÅ LOOP
//
SLUT:
DISPLAY LAST TO PROMF.4
DISPLAY 'BEREGNINGER FORETAGET  !' TO PROMF.5
DISPLAY 'SLUT  -- TRYK RETUR    !' TO PROMF.6
ACCEPT PROMF.7
KEYCHECK GOSUB UDRUTINE
GOTO OM
//
UDRUTINE:
 INDICATE KEYPRESS FALSE 
 DISPLAY 'DU HAR STOPPET PROGRAMMET !' TO PROMF.5
 DISPLAY 'TAST S (STOP) ELLER TRYK RETUR' TO PROMF.6
 ACCEPT PROMF.7
 IF PROMF.7 IN "Ss" CHAIN "OVERSIGT"
RETURN
//
KEYPROC KEY.HELP:
    HELP
    ENTAGAIN
RETURN
//
ENTEREND
CHAIN "OVERSIGT"
«eof»