|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 12726 (0x31b6)
Types: SPC/1-COMAL-80
Notes: Mikados_B, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
Names: »SYSBPY.B«
└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
└─⟦this⟧ »SYSBPY.B«
0100 // **************************************************
0110 // * *
0120 // * Bogføringssystemet 'SYS-KAS' *
0130 // * vers. 1.0 *
0140 // * *
0150 // * Udviklet marts 1983 på en 'SPC/1' mikrodatamat *
0160 // * Programsystemet er skrevet i COMAL80 vers. 1.2 *
0170 // * *
0180 // * Udviklet af : Peter Kristensen *
0190 // * Vestervang 6, 6920 Videbæk *
0200 // * *
0210 // * (C) : forlaget systime a/s *
0220 // * Klokkebakken 20, Gjellerup *
0230 // * 7400 Herning *
0240 // **************************************************
0250 EXEC DIMENSIONER
0260 EXEC INITIER
0270 EXEC FKT_MENU
0280 CHAIN PROGRAM$
0290 // =========== Procedurer starter ==============
0300 PROC DIMENSIONER
0310 // Standard variable
0320 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0330 DIM PROGRAM$ OF 17,PRTNR$ OF 1
0340 REAL RESRV,PPAR
0350 INTEGER OK,TRUE,FALSE,I,J
0360 // Hjælpevariable
0370 REAL MOMS_KR,NULR
0380 INTEGER HIGH,LOW,POS,KREDIT,DEBET,LIN_T,MAX_LIN,T_IDX,K,NUL
0390 // Variable til filen SYSPARA
0400 DIM SYSPARA$ OF 17
0410 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0420 DIM DATAFL$ OF 8,T_KODE$ OF 1
0430 // Variable til filen @@PARAM
0440 DIM PARAM$ OF 17
0450 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0460 REAL MOMS
0470 // Variable til filen @@KONTO
0480 DIM KONTO$ OF 17
0490 DIM ST_DATO$ OF 6
0500 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0510 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0520 REAL KTO_PRIMO,KTO_ULTIMO
0530 INTEGER KTO_FP,KTO_SP
0540 // Variable til filen @@KTOIDX
0550 DIM KTOIDX$ OF 17
0560 INTEGER I_HØJREC,I_MAXREC
0570 DIM KTONR$ OF 8
0580 INTEGER RECNR
0590 // Variable til filen @@DG_POS
0600 DIM DG_POS$ OF 17
0610 DIM P_BDAT$ OF 6
0620 REAL P_DEB,P_KRED
0630 INTEGER P_HØJREC,P_MAXREC,S_NR_DG_POS
0640 DIM P_BKTO$ OF 8,P_MKOD$ OF 1,P_BNR$ OF 5,P_TXT$ OF 20
0650 REAL P_BKR
0660 INTEGER P_DK
0670 // Variable til filen @@ST_KTO
0680 DIM ST_KTO$ OF 17
0690 DIM UDMOMS_KTO$ OF 8,INDMOMS_KTO$ OF 8
0700 // Variable til file @@TRANS
0710 DIM TRANS$ OF 17
0720 INTEGER T_HØJREC,T_MAXREC
0730 DIM BKTONR$ OF 8,BDATO$ OF 6,BLGNR$ OF 5,BTXT$ OF 20
0740 REAL BMOMS,BBELØB
0750 INTEGER DK,NTRANS
0760 ENDPROC DIMENSIONER
0770
0780 PROC INITIER
0790 LET PRGFL$ := "DP2"
0800 LET PROGRAM$ := PRGFL$ + ":SYSKA"
0810 LET TAL$ := "0123456789"
0820 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0830 LET SPC$ := " "
0840 LET SPC$ := SPC$ + SPC$ ; NUL := 0 ; NULR := 0
0850 LET FALSE := 0 ; TRUE := 1 // boolske variable
0860 LET KREDIT := - 1 ; DEBET := 1
0870 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0880 EXEC OPENFIL(SYSPARA$,"R")
0890 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0900 EXEC TERMINAL_IDX
0910 CLOSE SYSPARA$
0930 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0940 EXEC OPENFIL(PARAM$,"R")
0950 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0960 CLOSE PARAM$
0970 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
0980 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
0990 LET DG_POS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "DG_POS"
1000 LET TRANS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "TRANS"
1010 LET ST_KTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "ST_KTO"
1020 EXEC OPENFIL(KTOIDX$,"R")
1030 EXEC OPENFIL(KONTO$,"W")
1040 EXEC OPENFIL(DG_POS$,"W")
1050 EXEC OPENFIL(TRANS$,"W")
1060 EXEC OPENFIL(ST_KTO$,"R")
1070 GET ST_KTO$,5 : INDMOMS_KTO$
1080 GET ST_KTO$,6 : UDMOMS_KTO$
1090 CLOSE ST_KTO$
1100 ENDPROC INITIER
1110
1120 PROC TERMINAL_IDX
1130 LET PPAR := 5 ; RESRV := 0
1140 CALL T"DDE:PRES"
1150 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1160 ENDPROC TERMINAL_IDX
1170
1180 PROC OPENFIL(FNAVN$,WAY$)
1190 REPEAT
1200 IF AY$ = "W" OR WAY$ = "w" THEN
1210 OPEN FNAVN$,W
1220 ELSE
1230 OPEN FNAVN$,R
1240 ENDIF
1250 IF (FNAVN$) THEN
1260 PRINT "<SC0123>" ; CHR$ (7)
1270 IF (FNAVN$) = 6 THEN
1280 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1290 INPUT "" : SVAR$
1300 ELSE
1310 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1320 PRINT "<S>" ; FNAVN$ ; " ***"
1330 INPUT "" : SVAR$
1340 PRINT "<C0102>" ; SPC$
1350 ENDIF
1360 ENDIF
1370 UNTIL NOT ╱cd╱ (FNAVN$)
1380 ENDPROC OPENFIL
1390
1400 PROC TAL_CONTROL( REF RST$)
1410 LET J := 0 ; OK := TRUE
1420 FOR I := 1 TO (RST$) DO
1430 IF RST$(I) IN TAL$ + "." THEN LET J := J + 1 ; RST$(J) := RST$(I)
1440 NEXT I
1450 IF = 0 THEN
1460 LET OK := FALSE
1470 ELSE
1480 LET RST$ := RST$(1 : J)
1490 ENDIF
1500 ENDPROC TAL_CONTROL
1510
1520 PROC DIV_POSHOVED
1530 EXEC OVERSKRIFT("BOGFØRING AF DIVERSE POSTERINGER",4)
1530 PRINT "<C0105> BILAG TEKST MOMS KO"
1540 PRINT "<C0106> NR KODE NU"
1550 PRINT "<C0107>----------------------------------------"
1560 PRINT "<C4105>NTO- DEBET KREDIT F/R/S "
1570 PRINT "<C4106>MMER "
1580 PRINT "<C4107>----------------------------------------"
1590 ENDPROC DIV_POSHOVED
1600
1610 PROC OVERSKRIFT(ST$,L)
1620 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1630 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1640 PRINT SYST_DAT$(5 : 2)
1660 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
1670 PRINT "*** " ; ST$ ; " ***"
1680 ENDPROC OVERSKRIFT
1690
1700 PROC SL_FEJLLINIE
1710 LET OK := TRUE
1720 PRINT "<C0102>" ; SPC$
1730 ENDPROC SL_FEJLLINIE
1740
1750 PROC FEJL(ST$)
1760 LET OK := FALSE
1770 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1780 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1790 ENDPROC FEJL
1800
1810 PROC LÆS_KONTO(P)
1820 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
1830 ENDPROC LÆS_KONTO
1840
1850 PROC ST_BGST( REF RST$)
1860 FOR I := 1 TO (RST$) DO
1870 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
1880 NEXT I
1890 ENDPROC ST_BGST
1900 PROC FIND_KTO( REF R_KTONR$)
1910 LET OK := FALSE
1920 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
1930 LET LOW := 1 ; HIGH := I_HØJREC + 1 ; POS := 2
1940 IF IGH > 1 THEN
1950 REPEAT
1960 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
1970 GET KTOIDX$,POS : KTONR$,RECNR
1980 IF TONR$ > R_KTONR$ THEN
1990 LET HIGH := POS
2000 ELSE
2010 IF TONR$ < R_KTONR$ THEN
2020 LET LOW := POS
2030 ENDIF
2040 ENDIF
2050 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
2060 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
2070 ENDIF
2080 LET FIND_KTO := POS
2090 ENDPROC FIND_KTO
2100
2110 PROC SKRIV_DG_POS(P)
2120 PUT DG_POS$,P + 1 : P_BKTO$,P_MKOD$,P_BNR$,P_TXT$,P_BKR,P_DK
2130 ENDPROC SKRIV_DG_POS
2140
2150 PROC LÆS_DG_POS(P)
2160 GET DG_POS$,P + 1 : P_BKTO$,P_MKOD$,P_BNR$,P_TXT$,P_BKR,P_DK
2170 ENDPROC LÆS_DG_POS
2180
2190 PROC SKRIV_LIN(R_LIN)
2200 IF P_BNR$ = "*****" THEN EXIT
2210 LET R_SLIN := R_LIN MOD 12 + 7
2220 IF R_SLIN = 7 THEN LET R_SLIN := 12 + R_SLIN
2230 CURSOR 1,R_SLIN
2240 PRINT CHR$ (R_LIN,2)
2250 CURSOR 4,R_SLIN
2260 PRINT P_BNR$
2270 CURSOR 11,R_SLIN
2280 PRINT P_TXT$
2290 CURSOR 34,R_SLIN
2300 PRINT P_MKOD$
2310 CURSOR 39,R_SLIN
2320 PRINT P_BKTO$
2330 IF _DK = DEBET THEN
2340 CURSOR 49,R_SLIN
2350 ELSE
2360 CURSOR 61,R_SLIN
2370 ENDIF
2380 PRINT CHR$ (P_BKR,7,2)
2390 ENDPROC SKRIV_LIN
2400
2410 PROC UDSKRIV_POSTER
2420 EXEC OVERSKRIFT("Udskrivning af konteringsliste",7)
2420 EXEC PRINTRES("smal EDB-liste",12)
2440 LET LIN_T := 100 ; MAX_LIN := 72
2450 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
2460 LET P_DEB,P_KRED := 0
2470 FOR J := 1 TO _HØJREC - 1 DO
2480 EXEC LÆS_DG_POS(J)
2490 EXEC PRINT_LIN
2500 NEXT J
2510 IF LIN_T >< 100 THEN EXEC AFSLUT
2520 EXEC PRINTREL
2530 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
2540 ENDPROC UDSKRIV_POSTER
2550
2560 PROC SIDESKIFT
2570 FOR I := LIN_T TO AX_LIN DO PRINT
2580 LET LIN_T := 9
2590 PRINT "*** " ; SYST_NAVN$ ; " ***" ; TAB(58) ; "SIDE: " ; S_NR_DG_POS
2600 PRINT
2610 PRINT "Firmanavn: " ; FIRMANAVN$
2620 PRINT
2630 PRINT "<S>*** KONTERINGSLISTE PR. " ; P_BDAT$(1 : 2) ; "." ; P_BDAT$(3 : 2) ; "."
2640 PRINT "<S>" ; P_BDAT$(5 : 2) ; " ** ** UDSKREVET PR. "
2650 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
2660 PRINT
2660 PRINT "<S>BILAG TEKST MK KONTONR DEBET "
2680 PRINT " KREDIT "
2680 PRINT "<S>----- -------------------- -- -------- ----------"
2700 PRINT " ----------"
2710 IF _DEB > 0 OR P_KRED > 0 THEN
2720 PRINT TAB(8) ; "TRANSPORT" ; TAB(41) ; CHR$ (P_DEB,9,2) ; CHR$ (P_KRED,9,2)
2730 LET LIN_T := LIN_T + 1
2740 ENDIF
2750 LET S_NR_DG_POS := S_NR_DG_POS + 1
2760 ENDPROC SIDESKIFT
2770
2780 PROC PRINT_LIN
2790 IF P_BNR$ = "*****" THEN EXIT
2800 IF IN_T + 5 > MAX_LIN THEN
2810 IF _DEB > 0 OR P_KRED > 0 THEN
2810 PRINT "<S>----- -------------------- -- -------- ---------- "
2830 PRINT "----------"
2840 PRINT TAB(9) ; "TRANSPORT" ; TAB(41) ; CHR$ (P_DEB,9,2) ; CHR$ (P_KRED,9,2)
2850 LET LIN_T := LIN_T + 2
2860 ENDIF
2870 EXEC SIDESKIFT
2880 ENDIF
2890 LET LIN_T := LIN_T + 1
2900 PRINT "<S>" ; P_BNR$ ; TAB(11) ; P_TXT$ ; TAB(33) ; P_MKOD$ ; TAB(37)
2910 PRINT "<S>" ; P_BKTO$ ; TAB(14)
2920 IF _DK = DEBET THEN
2930 PRINT CHR$ (P_BKR,7,2)
2940 LET P_DEB := P_DEB + P_BKR
2950 ELSE
2960 PRINT TAB(13) ; CHR$ (P_BKR,7,2)
2970 LET P_KRED := P_KRED + P_BKR
2980 ENDIF
2990 ENDPROC PRINT_LIN
3000
3010 PROC AFSLUT
3020 LET LIN_T := LIN_T + 2
3020 PRINT "<S>----- -------------------- -- -------- ---------- "
3040 PRINT "----------"
3050 PRINT TAB(8) ; "DEBET/KREDIT TOTAL" ; TAB(42) ; CHR$ (P_DEB,9,2) ;
3060 PRINT CHR$ (P_KRED,9,2)
3070 IF _DEB > P_KRED THEN
3080 PRINT TAB(11) ; "DIFFERENCE" ; TAB(42) ; CHR$ (P_DEB - P_KRED,9,2)
3090 LET LIN_T := LIN_T + 1
3100 ELSE
3110 IF _KRED > P_DEB THEN
3120 PRINT TAB(11) ; "DIFFERENCE" ; TAB(54) ; CHR$ (P_KRED - P_DEB,9,2)
3130 LET LIN_T := LIN_T + 1
3140 ENDIF
3150 ENDIF
3160 FOR I := LIN_T TO AX_LIN DO PRINT
3170 ENDPROC AFSLUT
3180
3190 PROC LÆS_TRANS(P)
3200 GET TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
3210 ENDPROC LÆS_TRANS
3220
3230 PROC SKRIV_TRANS(P)
3240 PUT TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
3250 ENDPROC SKRIV_TRANS
3260
3270 PROC SKRIV_KONTO(P)
3280 PUT KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
3290 ENDPROC SKRIV_KONTO
3300
3310 PROC BOGFØR( REF Q_KTO$, REF Q_DAT$, REF Q_TXT$, REF Q_M, REF Q_KR,Q_DK,QN$)
3320 EXEC FIND_KTO(Q_KTO$)
3330 IF OK THEN
3340 EXEC FEJL("UKENDT KONTONR: " + Q_KTO$)
3350 EXIT
3360 ELSE
3370 EXEC LÆS_KONTO(RECNR)
3380 IF TO_TYPE$ >< "A" THEN
3390 EXEC FEJL("ULOVLIG KONTONR: " + Q_KTO$)
3400 EXIT
3410 ENDIF
3420 ENDIF
3430 GET TRANS$,1 : T_HØJREC,T_MAXREC
3440 IF _HØJREC = T_MAXREC THEN
3450 EXEC FEJL("TRANSAKTIONSFILEN ER FULD")
3460 EXIT
3470 ENDIF
3480 LET T_HØJREC := T_HØJREC + 1
3490 IF TO_FP > 0 THEN
3500 EXEC LÆS_TRANS(KTO_SP)
3510 LET NTRANS := T_HØJREC
3520 EXEC SKRIV_TRANS(KTO_SP)
3530 ELSE
3540 LET KTO_FP := T_HØJREC
3550 ENDIF
3560 LET BKTONR$ := Q_KTO$ ; BDATO$ := Q_DAT$ ; BTXT$ := Q_TXT$ ; BMOMS := Q_M ; BBELØB := Q_KR
3570 LET DK := Q_DK ; NTRANS := NUL ; BLGNR$ := QN$
3580 EXEC SKRIV_TRANS(T_HØJREC)
3590 LET KTO_SP := T_HØJREC
3600 IF K = DEBET THEN
3610 LET KTO_ULTIMO := KTO_ULTIMO + BBELØB
3620 ELSE
3630 LET KTO_ULTIMO := KTO_ULTIMO - BBELØB
3640 ENDIF
3650 EXEC SKRIV_KONTO(RECNR)
3660 PUT TRANS$,1 : T_HØJREC,T_MAXREC
3670 ENDPROC BOGFØR
3680
3690 PROC BOGFØR_POSTER
3700 FOR K := 1 TO _HØJREC - 1 DO
3710 EXEC LÆS_DG_POS(K)
3720 IF _BNR$ >< "*****" THEN
3730 IF (K + 11) MOD 12 = 0 THEN EXEC DIV_POSHOVED
3740 EXEC SKRIV_LIN(K)
3750 IF /" + P_MKOD$ + "/" IN "/I/U/" THEN
3760 LET MOMS_KR := INT(MOMS * 100 * (P_BKR / (MOMS + 100)) + .5) / 100 ; P_BKR := P_BKR - MOMS_KR
3770 IF _MKOD$ = "I" THEN
3780 EXEC BOGFØR(INDMOMS_KTO$,P_BDAT$,P_TXT$,NULR,MOMS_KR,P_DK,P_BNR$)
3790 ELSE
3800 EXEC BOGFØR(UDMOMS_KTO$,P_BDAT$,P_TXT$,NULR,MOMS_KR,P_DK,P_BNR$)
3810 ENDIF
3820 ELSE
3830 LET MOMS_KR := 0
3840 ENDIF
3850 EXEC BOGFØR(P_BKTO$,P_BDAT$,P_TXT$,MOMS_KR,P_BKR,P_DK,P_BNR$)
3860 LET P_BKR := 0 ; P_BNR$ := "*****"
3870 CURSOR 4,R_SLIN
3880 PRINT "* * * * * * * * * * * B O G F Ø R T * * * * * * * * * * * *" ;
3890 PRINT SPC$(1 : 10)
3900 EXEC SKRIV_DG_POS(K)
3910 ENDIF
3920 NEXT K
3930 LET P_HØJREC := 1 ; P_DEB,P_KRED := 0
3940 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
3950 ENDPROC BOGFØR_POSTER
3960 PROC FKT_MENU
3970 EXEC UDSKRIV_POSTER
3980 EXEC BOGFØR_POSTER
3990 ENDPROC FKT_MENU
4000 //
9901 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
9902 LET PRTNR$ := "1" ; OK := TRUE
9903 REPEAT
9904 CURSOR 15,LINE
9905 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
9906 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
9907 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
9908 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
9909 INPUT "" : SVAR$
9910 SELECT OUTPUT "P" + PRTNR$
9911 IF ("P") THEN
9912 CURSOR 12,LINE
9913 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
9914 CURSOR 12,LINE + 1
9915 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
9916 IF VAR$ = "J" OR SVAR$ = "j" THEN
9917 CURSOR 12,LINE
9918 PRINT "<Z> Der ventes på at printeren bliver ledig...."
9919 PRINT "<SZ>"
9920 WHILE ╱cd╱ ("P") DO
9921 LET SEK := ╱ca╱ (5)
9922 SELECT OUTPUT "P" + PRTNR$
9923 ENDWHILE
9924 ELSE
9925 LET OK := FALSE
9926 ENDIF
9927 ENDIF
9928 CURSOR 1,LINE
9929 PRINT "<Z>"
9930 PRINT "<SZ>"
9931 ENDPROC PRINTRES
4010 //
4020 PROC PRINTREL // RELEASE PRINTER
4030 SELECT OUTPUT "T"
4040 ENDPROC PRINTREL
0920 LET PROGRAM$ := PROGRAM$ + S_KODE$
1540 PRINT "<C0105> BILAG TEKST KO"
1550 PRINT "<C0106> NR NU"
1560 PRINT "<C0107>----------------------------------------"
1570 PRINT "<C4105>NTO- DEBET KREDIT F/R/S "
1580 PRINT "<C4106>MMER "
1590 PRINT "<C4107>----------------------------------------"
1600 ENDPROC DIV_POSHOVED
1610
1620 PROC OVERSKRIFT(ST$,L)
1630 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1640 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1650 PRINT SYST_DAT$(5 : 2)
2430 EXEC PRINTRES("papir",12)
2670 PRINT "<S>BILAG TEKST KONTONR DEBET "
2690 PRINT "<S>----- ------------------------ -------- ----------"
2820 PRINT "<S>----- ------------------------ -------- ---------- "
3030 PRINT "<S>----- ------------------------ -------- ---------- "
4050 //
4060 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
4070 LET PRTNR$ := "1" ; OK := TRUE
4080 REPEAT
4090 CURSOR 15,LINE
4100 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
4110 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
4120 CURSOR 1,LINE
4130 PRINT "<Z>"
4140 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
4150 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
4160 INPUT "" : SVAR$
4170 SELECT OUTPUT "P" + PRTNR$
4180 IF ("P") THEN
4190 CURSOR 12,LINE
4200 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
4210 CURSOR 12,LINE + 1
4220 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
4230 IF VAR$ = "J" OR SVAR$ = "j" THEN
4240 CURSOR 12,LINE
4250 PRINT "<Z> Der ventes på at printeren bliver ledig...."
4260 PRINT "<SZ>"
4270 WHILE ╱cd╱ ("P") DO
4280 LET SEK := ╱ca╱ (5)
4290 SELECT OUTPUT "P" + PRTNR$
4300 ENDWHILE
4310 ELSE
4320 LET OK := FALSE
4330 ENDIF
4340 ENDIF
4350 CURSOR 1,LINE
4360 PRINT "<Z>"
4370 PRINT "<SZ>"
4380 ENDPROC PRINTRES