⟦7d513ec66⟧

SPC/1 COMAL-80

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 FUNKTIONSMENU
0280 CHAIN PROGRAM$
0290 // ============= procedurer starter =============
0300 PROC DIMENSIONER
0310 // Standard variable
0320 DIM SPC$ OF 80,TAL$ OF 10,ALFA$ OF 28,SVAR$ OF 12,PRGFL$ OF 8
0330 DIM PROGRAM$ OF 17,PRTNR$ OF 1
0340 REAL RESRV,PPAR
0350 INTEGER OK,TRUE,FALSE,I,J,K
0360 // Hjælpevariable
0370 DIM HJ_ST$ OF 10,A_TXT$ OF 20,A_BNR$ OF 5,A_KTONR$ OF 8,NONBOOK$ OF 60
0380 DIM A_KTO_TYPE$ OF 1,A_KTO_NAVN$ OF 40
0390 REAL A_KTO_ULTIMO,NULR,TÆLLER(3),OVERSKUD
0400 INTEGER POS,HIGH,LOW,IDXPOS,DEBET,KREDIT,NUL,KOLNR,MAX_LIN
0410 INTEGER A_NTRANS,A_KTO_SP,LIN_T,TABNR(2),SIDENR
0420 // Variable til filen SYSPARA
0430 DIM SYSPARA$ OF 17
0440 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0450 DIM DATAFL$ OF 8,T_KODE$ OF 1
0460 // Variable til filen @@PARAM
0470 DIM PARAM$ OF 17
0480 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 8
0490 REAL MOMS
0500 DIM ST_DATO$ OF 6
0510 INTEGER ANT_PER,PER_NR
0520 // Variable til filen @@TRANS
0530 DIM TRANS$ OF 17
0540 INTEGER T_HØJREC,T_MAXREC
0550 DIM BKTONR$ OF 8,BDATO$ OF 6,BLGNR$ OF 5,BTXT$ OF 20
0560 REAL BMOMS,BBELØB
0570 INTEGER NTRANS,DK
0580 // Variable til filen @@DRIFTØ
0590 DIM DRIFTØ$ OF 17
0600 DIM PRIMODAT$ OF 6
0610 REAL DRIFT(2)
0620 // Variable til filen @@KONTO
0630 DIM KONTO$ OF 17
0640 INTEGER N_FRIREC,N_MAXREC
0650 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0660 REAL KTO_PRIMO,KTO_ULTIMO
0670 INTEGER KTO_FP,KTO_SP
0680 // Variable til filen @@KTOIDX
0690 DIM KTOIDX$ OF 17
0700 INTEGER I_HØJREC,I_MAXREC
0710 DIM KTONR$ OF 8
0720 INTEGER RECNR
0730 // Variable til filen @@FKTONR
0740 DIM FKTONR$ OF 17
0750 DIM BAL_KTO$ OF 8,RES_KTO$ OF 8,BALANCE$ OF 8,PRIVATF$ OF 8,OVERSK$ OF 8
0760 DIM INDMOMS_KTO$ OF 8,UDMOMS_KTO$ OF 8
0770 // Variable til filen @@KTOGRP
0780 DIM KTOGRP$ OF 17
0790 DIM KREDGRP$ OF 8,DEBGRP$ OF 8
0800 ENDPROC DIMENSIONER
0810
0820 PROC INITIER
0830 LET PRGFL$ := "DP2"
0840 LET PROGRAM$ := PRGFL$ + ":SYSA"
0850 LET TAL$ := "0123456789"
0860 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0870 LET SPC$ := "                                        "
0880 LET SPC$ := SPC$ + SPC$
0890 LET FALSE := 0 ; TRUE := 1 // boolske variable
0900 LET DEBET := 1 ; KREDIT := - 1 ; NULR := 0
0910 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0920 EXEC OPENFIL(SYSPARA$,"R")
0930 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0940 EXEC TERMINAL_IDX
0950 CLOSE SYSPARA$
0960 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0970 EXEC OPENFIL(PARAM$,"W")
0980 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0990 GET PARAM$,2 : ST_DATO$,ANT_PER,PER_NR
1000 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
1010 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
1020 LET TRANS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "TRANS"
1030 LET DRIFTØ$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "DRIFTØ"
1040 LET FKTONR$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "FKTONR"
1050 LET KTOGRP$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOGRP"
1060 EXEC OPENFIL(TRANS$,"W")
1070 EXEC OPENFIL(DRIFTØ$,"W")
1080 EXEC OPENFIL(KTOIDX$,"W")
1090 EXEC OPENFIL(KONTO$,"W")
1100 EXEC OPENFIL(FKTONR$,"R")
1110 GET FKTONR$,5 : INDMOMS_KTO$
1120 GET FKTONR$,6 : UDMOMS_KTO$
1130 GET FKTONR$,7 : RES_KTO$
1140 GET FKTONR$,8 : BAL_KTO$
1150 GET FKTONR$,9 : BALANCE$
1160 GET FKTONR$,10 : OVERSK$
1170 GET FKTONR$,11 : PRIVATF$
1180 CLOSE FKTONR$
1190 LET NONBOOK$ := "/" + RES_KTO$ + "/" + BAL_KTO$ + "/"
1200 LET NONBOOK$ := NONBOOK$ + PRIVATF$ + "/" + INDMOMS_KTO$ + "/" + UDMOMS_KTO$ + "/"
1210 EXEC OPENFIL(KTOGRP$,"R")
1220 GET KTOGRP$,12 : DEBGRP$
1230 GET KTOGRP$,17 : KREDGRP$
1240 CLOSE KTOGRP$
1250 ENDPROC INITIER
1260
1270 //
1280 PROC TERMINAL_IDX
1290 LET PPAR := 5 ; RESRV := 0
1300 CALL :PRES"
1310 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1320 ENDPROC TERMINAL_IDX
1330
1340 PROC OPENFIL(FNAVN$,WAY$)
1350 REPEAT
1360 IF AY$ = "W" OR WAY$ = "w" THEN
1370 OPEN FNAVN$,W
1380 ELSE
1390 OPEN FNAVN$,R
1400 ENDIF
1410 IF (FNAVN$) THEN
1420 PRINT "<S>" ; CHR$ (7)
1430 IF (FNAVN$) = 6 THEN
1440 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1450 INPUT "" : SVAR$
1460 ELSE
1470 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1480 PRINT "<S>" ; FNAVN$ ; " ***"
1490 INPUT "" : SVAR$
1500 PRINT "<C0102>" ; SPC$
1510 ENDIF
1520 ENDIF
1530 UNTIL NOT ╱cd╱ (FNAVN$)
1540 ENDPROC OPENFIL
1550
1560 PROC OVERSKRIFT(ST$,L)
1570 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1580 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1590 PRINT SYST_DAT$(5 : 2)
1600 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
1610 PRINT "*** " ; ST$ ; " ***"
1620 ENDPROC OVERSKRIFT
1630
1640 PROC SL_FEJLLINIE
1650 LET OK := TRUE
1660 PRINT "<C0102>" ; SPC$
1670 ENDPROC SL_FEJLLINIE
1680
1690 PROC FEJL(ST$)
1700 LET OK := FALSE
1710 CURSOR 36 - ( ╱cb╱ (ST$) / 2),2
1720 PRINT "<S>*** " + ST$ + " ***" ; CHR$ (7)
1730 ENDPROC FEJL
1740
1750 PROC SKRIV_KONTOOPL
1760 IF OPRET THEN EXEC FIND_IDXPLADS
1770 LET KTO_TYPE$ := A_KTO_TYPE$
1780 EXEC SKRIV_KONTO(RECNR)
1790 ENDPROC SKRIV_KONTOOPL
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 SKRIV_KONTO(P)
1860 PUT KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
1870 ENDPROC SKRIV_KONTO
1880
1890 PROC ST_BGST( REF RST$)
1900 FOR J := 1 TO (RST$) DO
1910 IF "a" =< RST$(J) AND RST$(J) =< "å" THEN LET RST$(J) := CHR$ ( ╱cc╱ (RST$(J)) - 32)
1920 NEXT J
1930 ENDPROC ST_BGST
1940
1950 PROC TAL_CONTROL( REF RST$)
1960 LET J := 0 ; OK := TRUE ; K := 0
1970 FOR I := 1 TO (RST$) DO
1980 IF RST$(I) IN "0123456789" THEN LET J := J + 1 ; RST$(J) := RST$(I)
1990 IF RST$(I) = "." AND K = 0 THEN LET J := J + 1 ; K := K + 1 ; RST$(J) := RST$(I)
2000 NEXT I
2010 IF = 0 THEN
2020 LET OK := FALSE
2030 ELSE
2040 LET RST$ := RST$(1 : J)
2050 ENDIF
2060 ENDPROC TAL_CONTROL
2070
2080 PROC FIND_KTO( REF R_KTONR$)
2090 LET OK := FALSE
2100 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
2110 LET LOW := 1 ; HIGH := I_HØJREC ; POS := 2
2120 IF IGH > 1 THEN
2130 REPEAT
2140 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
2150 GET KTOIDX$,POS : KTONR$,RECNR
2160 IF TONR$ > R_KTONR$ THEN
2170 LET HIGH := POS
2180 ELSE
2190 IF TONR$ < R_KTONR$ THEN
2200 LET LOW := POS
2210 ENDIF
2220 ENDIF
2230 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
2240 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
2250 GET KTOIDX$,POS : KTONR$,RECNR
2260 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
2270 ENDIF
2280 LET FIND_KTO := POS
2290 ENDPROC FIND_KTO
2300
2310 PROC FREMFØR
2320 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
2330 FOR I := 2 TO _HØJREC DO
2340 GET KTOIDX$,I : KTONR$,RECNR
2350 EXEC LÆS_KONTO(RECNR)
2360 PRINT "<C3212>" ; KTONR$ ; SPC$(1 : 10)
2370 LET KTO_PRIMO := KTO_ULTIMO ; KTO_FP := 0 ; KTO_SP := 0
2380 EXEC SKRIV_KONTO(RECNR)
2390 NEXT I
2400 GET TRANS$,1 : T_HØJREC,T_MAXREC
2410 LET T_HØJREC := 1
2420 PUT TRANS$,1 : T_HØJREC,T_MAXREC
2430 LET PER_NR := PER_NR + 1 ; ST_DATO$ := SYST_DAT$
2440 ENDPROC FREMFØR
2450
2460 PROC FUNKTIONSMENU
2470 IF ER_NR = 0 THEN
2480 PRINT "<XSC1212>Balancetal skal fremføres i ny regning før der kan "
2490 PRINT "afsluttes"
2500 INPUT "<SC6523>Tryk RETURN" : SVAR$
2510 CHAIN PROGRAM$
2520 ENDIF
2530 LET SVAR$ := "j"
2540 IF NT_PER > PER_NR THEN
2550 EXEC OVERSKRIFT("Månedsafslutning",6)
2560 EDIT "<C1810>Er alt klar til månedsafslutning (j/n)? " : SVAR$
2570 ELSE
2580 EXEC OVERSKRIFT("Årsafslutning",6)
2590 PRINT "<C1809>Har du kontrolleret kontokortene"
2600 PRINT "<C1810>Er datoen = sidste dato i regnskabsåret"
2610 PRINT "<SC1811>Er ind- og udgående moms overført til konto for momsaf"
2620 PRINT "regning"
2630 PRINT "<C1812>Har du taget sikkerhedskopi"
2640 EDIT "<C3414>(j/n)? " : SVAR$
2650 ENDIF
2660 IF SVAR$ IN "Jj" OR SVAR$ = "" THEN
2670 PRINT "<XC1212>Gå tilbage og gør alt klar til afslutningen"
2680 INPUT "<C6523>Tryk RETURN" : SVAR$
2690 CHAIN PROGRAM$
2700 ENDIF
2710 IF NT_PER = PER_NR THEN
2720 EXEC UDSKRIV
2730 EXEC OVERSKRIFT("Årsafslutning",6)
2740 PRINT "<C1810>Er regnskabet iorden"
2750 PRINT "<C1811>Stemmer balancen"
2760 PRINT "<C1812>Skal regnskabsafslutningen fortsættes"
2770 LET SVAR$ := "j"
2780 EDIT "<C3415>(j/n)? " : SVAR$(1)
2790 IF NOT "/" + SVAR$ + "/" IN "/j/J/" THEN CHAIN PROGRAM$
2800 PRINT "<C2916>Nu afsluttes der!"
2810 EXEC ÅRSAFSLUT
2820 LET PER_NR := 0
2830 ELSE
2840 PRINT "<C0110>" ; SPC$
2850 PRINT "<C2910>Nu fremføres der!"
2860 EXEC FREMFØR
2870 ENDIF
2880 PUT PARAM$,2 : ST_DATO$,ANT_PER,PER_NR
2890 ENDPROC FUNKTIONSMENU
2900
2910 PROC ÅRSAFSLUT
2920 EXEC OVERFØR_PRIVATF
2930 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
2940 FOR K := 2 TO _HØJREC DO
2950 GET KTOIDX$,K : KTONR$,RECNR
2960 EXEC LÆS_KONTO(RECNR)
2970 GET DRIFTØ$,RECNR : DRIFT(1),DRIFT(2)
2980 LET DRIFT(1) := DRIFT(2) ; DRIFT(2) := KTO_ULTIMO
2990 PUT DRIFTØ$,RECNR : DRIFT(1),DRIFT(2)
3000 NEXT K
3010 FOR K := 2 TO _HØJREC DO
3020 GET KTOIDX$,K : KTONR$,RECNR
3030 IF KTONR$ = BALANCE$ THEN EXEC OVERFØR_RESULTAT
3040 EXEC LÆS_KONTO(RECNR)
3050 PRINT "<SC3219>" ; KTONR$ ; SPC$(1 : 10)
3060 IF "/" + KTONR$ + "/" IN NONBOOK$ AND KTO_TYPE$ = "A" THEN
3070 LET A_KTO_ULTIMO := KTO_ULTIMO ; A_KTONR$ := KTONR$
3080 LET A_TXT$ := "SALDO FRA " + KTONR$ ; A_BNR$ := "  " ; A_DK := SGN(A_KTO_ULTIMO)
3090 LET A_KTO_ULTIMO := ABS(A_KTO_ULTIMO)
3100 IF TONR$ < BALANCE$ THEN
3110 EXEC BOGFØR(RES_KTO$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3120 LET A_DK := A_DK * ( - 1) ; A_TXT$ := "OVERFØRT TIL " + RES_KTO$
3130 ELSE
3140 EXEC BOGFØR(BAL_KTO$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3150 LET A_DK := A_DK * ( - 1) ; A_TXT$ := "OVERFØRT TIL " + BAL_KTO$
3160 ENDIF
3170 EXEC BOGFØR(A_KTONR$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3180 ENDIF
3190 NEXT K
3200 ENDPROC ÅRSAFSLUT
3210 PROC OVERFØR_RESULTAT
3220 EXEC FIND_KTO(RES_KTO$)
3230 EXEC LÆS_KONTO(RECNR)
3240 LET A_TXT$ := "RESULTAT TIL " + OVERSK$ ; A_KTO_ULTIMO := ABS(KTO_ULTIMO)
3250 LET A_DK := SGN(( - 1) * KTO_ULTIMO) ; A_BNR$ := "  "
3260 EXEC BOGFØR(RES_KTO$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3270 LET A_TXT$ := "RESULTAT FRA " + RES_KTO$
3280 LET A_DK := A_DK * ( - 1) ; A_BNR$ := "  "
3290 EXEC BOGFØR(OVERSK$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3300 GET KTOIDX$,K : KTONR$,RECNR
3310 ENDPROC OVERFØR_RESULTAT
3320
3330 PROC BOGFØR( REF Q_KTO$, REF Q_DAT$, REF Q_TXT$, REF Q_M, REF Q_KR,Q_DK,QN$)
3340 EXEC FIND_KTO(Q_KTO$)
3350 IF OK THEN
3360 EXEC FEJL("UKENDT KONTONR: " + Q_KTO$)
3370 EXIT
3380 ELSE
3390 EXEC LÆS_KONTO(RECNR)
3400 IF TO_TYPE$ >< "A" THEN
3410 EXEC FEJL("ULOVLIG KONTONR: " + Q_KTO$)
3420 EXIT
3430 ENDIF
3440 ENDIF
3450 GET TRANS$,1 : T_HØJREC,T_MAXREC
3460 LET T_HØJREC := T_HØJREC + 1
3470 IF TO_FP > 0 THEN
3480 EXEC LÆS_TRANS(KTO_SP)
3490 LET NTRANS := T_HØJREC
3500 EXEC SKRIV_TRANS(KTO_SP)
3510 ELSE
3520 LET KTO_FP := T_HØJREC
3530 ENDIF
3540 LET BKTONR$ := Q_KTO$ ; BDATO$ := Q_DAT$ ; BTXT$ := Q_TXT$ ; BMOMS := Q_M ; BBELØB := Q_KR
3550 LET DK := Q_DK ; NTRANS := NUL ; BLGNR$ := QN$
3560 EXEC SKRIV_TRANS(T_HØJREC)
3570 LET KTO_SP := T_HØJREC
3580 IF K = DEBET THEN
3590 LET KTO_ULTIMO := KTO_ULTIMO + BBELØB
3600 ELSE
3610 LET KTO_ULTIMO := KTO_ULTIMO - BBELØB
3620 ENDIF
3630 EXEC SKRIV_KONTO(RECNR)
3640 PUT TRANS$,1 : T_HØJREC,T_MAXREC
3650 ENDPROC BOGFØR
3660 PROC SKRIV_TRANS(P)
3670 PUT TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
3680 ENDPROC SKRIV_TRANS
3690
3700 PROC LÆS_TRANS(P)
3710 GET TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
3720 ENDPROC LÆS_TRANS
3730
3740 PROC OVERFØR_PRIVATF
3750 IF PRIVATF$ IN "************" THEN EXIT
3760 EXEC FIND_KTO(PRIVATF$)
3770 EXEC LÆS_KONTO(RECNR)
3780 LET A_KTO_ULTIMO := KTO_ULTIMO ; A_KTONR$ := KTONR$
3790 LET A_TXT$ := "PRIVATFORBRUG" ; A_BNR$ := " " ; A_DK := SGN(A_KTO_ULTIMO)
3800 LET A_KTO_ULTIMO := ABS(A_KTO_ULTIMO)
3810 EXEC BOGFØR(OVERSK$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3820 LET A_DK := A_DK * ( - 1)
3830 EXEC BOGFØR(PRIVATF$,SYST_DAT$,A_TXT$,NULR,A_KTO_ULTIMO,A_DK,A_BNR$)
3840 ENDPROC OVERFØR_PRIVATF
3850 PROC SIDESKIFT
3860 FOR I := LIN_T TO AX_LIN DO PRINT
3870 LET LIN_T := 7 ; SIDENR := SIDENR + 1
3880 PRINT "     *** " ; SYST_NAVN$ ; " ***" ; TAB(63) ; "SIDE: " ; SIDENR
3890 PRINT
3900 PRINT "     Firmanavn: " ; FIRMANAVN$
3910 PRINT
3920 IF TONR$(1) < "1" THEN
3930 PRINT "<S>         *** RESULTATOPGØRELSE FOR PERIODEN "
3940 PRINT "<S>" ; PRIMODAT$(1 : 2) ; "." ; PRIMODAT$(3 : 2) ; "." ; PRIMODAT$(5 : 2) ; " - "
3950 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
3960 ELSE
3970 PRINT "<S>                      *** BALANCE PR. "
3980 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
3990 ENDIF
4000 EXEC SKRIV_STREG
4010 ENDPROC SIDESKIFT
4020
4030 PROC SKRIV_STREG
4040 PRINT "<S>     -------------------------------------"
4050 PRINT "----------------------------"
4060 ENDPROC SKRIV_STREG
4070
4080 PROC SKRIV_LIN(SALDO)
4090 IF LIN_T + 4 > MAX_LIN THEN EXEC SIDESKIFT
4100 LET LIN_T := LIN_T + 1 ; SALDO := SALDO * DK
4110 CASE KTO_TYPE$ OF
4120 WHILE "A"
4130 IF TONR$ < BALANCE$ THEN
4140 LET OVERSKUD := OVERSKUD + SALDO
4150 ENDIF
4160 PRINT "<S>" ; TAB(10) ; KTO_NAVN$ ; TAB(50)
4170 PRINT TAB(TABNR(KOLNR)) ; CHR$ (ABS(SALDO),9,2)
4180 LET TÆLLER(1) := TÆLLER(1) + SALDO
4190 LET TÆLLER(2) := TÆLLER(2) + SALDO
4200 LET TÆLLER(3) := TÆLLER(3) + SALDO
4210 WHILE "B","C","D"
4220 PRINT TAB(6) ; KTO_NAVN$
4230 CASE KTO_TYPE$ OF
4240 WHILE "C"
4250 LET TÆLLER(1),TÆLLER(2) := 0
4260 LET KOLNR := 2
4270 WHILE "D"
4280 LET TÆLLER(1) := 0
4290 LET KOLNR := 1
4300 ENDCASE
4310 WHILE "E"
4320 PRINT TAB(59) ; "------------"
4330 WHILE "F"
4340 PRINT "<S>    " ; KTO_NAVN$ ; TAB(50)
4350 PRINT TAB(TABNR(2)) ; CHR$ (ABS(TÆLLER(KOLNR)),9,2)
4360 LET TÆLLER(KOLNR) := 0
4370 WHILE "G"
4380 PRINT "<S>    " ; KTO_NAVN$ ; TAB(50)
4390 PRINT TAB(TABNR(2)) ; CHR$ (ABS(TÆLLER(KOLNR)),9,2)
4400 LET KOLNR := 2
4410 WHILE "H"
4420 PRINT "<S>" ; TAB(50)
4430 PRINT TAB(TABNR(KOLNR)) ; "------------"
4440 PRINT "<S>    " ; KTO_NAVN$ ; TAB(50)
4450 PRINT TAB(TABNR(KOLNR)) ; CHR$ (ABS(TÆLLER(1)),9,2)
4460 PRINT "<S>" ; TAB(50)
4470 LET LIN_T := LIN_T + 1
4480 WHILE "I"
4490 PRINT "<S>" ; TAB(50)
4500 PRINT TAB(TABNR(2)) ; "------------"
4510 PRINT "<S>     " ; KTO_NAVN$ ; TAB(50)
4520 PRINT TAB(TABNR(2)) ; CHR$ (TÆLLER(2),9,2)
4530 LET LIN_T := LIN_T + 1
4540 WHILE "J"
4550 PRINT "<S>" ; TAB(50)
4560 PRINT TAB(TABNR(2)) ; "------------"
4570 PRINT "<S>     " ; KTO_NAVN$ ; TAB(50)
4580 PRINT TAB(TABNR(2)) ; CHR$ (TÆLLER(3),9,2)
4590 PRINT
4600 LET LIN_T := LIN_T + 2
4610 WHILE "K"
4620 PRINT "<S>" ; TAB(50)
4630 PRINT TAB(TABNR(2)) ; "------------"
4640 PRINT "<S>     " ; KTO_NAVN$ ; TAB(50)
4650 PRINT TAB(TABNR(2)) ; CHR$ (TÆLLER(3),9,2)
4660 PRINT "<S>" ; TAB(50)
4670 PRINT TAB(TABNR(2)) ; "------------"
4680 LET KOLNR := 2 ; TÆLLER(3) := 0 ; LIN_T := LIN_T + 2
4690 FOR I := LIN_T TO AX_LIN DO PRINT
4700 LET LIN_T := 900
4710 WHILE "L"
4720 PRINT "<S>      " ; KTO_NAVN$ ; TAB(50)
4730 PRINT TAB(TABNR(KOLNR)) ; CHR$ (OVERSKUD,9,2)
4740 LET TÆLLER(1) := TÆLLER(1) + OVERSKUD
4750 LET TÆLLER(2) := TÆLLER(2) + OVERSKUD
4760 LET TÆLLER(3) := TÆLLER(3) + OVERSKUD
4770 ENDCASE
4780 ENDPROC SKRIV_LIN
4790
4800 PROC UDSKRIV
4860 GET DRIFTØ$,1 : PRIMODAT$
4820 EXEC PRINTRES("smal EDB-liste",14)
4880 LET LIN_T := 100 ; MAX_LIN := 72 ; TABNR(1) := 1 ; TABNR(2) := 13 ; KOLNR := 2
4890 LET OVERSKUD := 0
4900 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
4910 FOR K := 2 TO _HØJREC DO
4920 GET KTOIDX$,K : KTONR$,RECNR
4930 IF TONR$ < "1" THEN
4940 LET DK := - 1
4950 ELSE
4960 IF TONR$ < "13" THEN
4970 LET DK := 1
4980 ELSE
4990 LET DK := - 1
5000 ENDIF
5010 ENDIF
5020 EXEC LÆS_KONTO(RECNR)
4980 IF TONR$(1 : ╱cb╱ (DEBGRP$)) = DEBGRP$ THEN
5050 LET A_KTO_ULTIMO := KTO_ULTIMO
5060 GET KTOIDX$,K + 1 : KTONR$,RECNR
5010 WHILE KTONR$(1 : ╱cb╱ (DEBGRP$)) = DEBGRP$ DO
5080 EXEC LÆS_KONTO(RECNR)
5090 LET A_KTO_ULTIMO := A_KTO_ULTIMO + KTO_ULTIMO ; K := K + 1
5100 GET KTOIDX$,K + 1 : KTONR$,RECNR
5110 ENDWHILE
5120 LET KTO_ULTIMO := A_KTO_ULTIMO ; KTO_TYPE$ := "A"
5070 LET KTO_NAVN$ := "Varedebitorer(samlekonto)"
5080 ELSE
5090 IF TONR$(1 : ╱cb╱ (KREDGRP$)) = KREDGRP$ THEN
5100 LET A_KTO_ULTIMO := KTO_ULTIMO
5110 GET KTOIDX$,K + 1 : KTONR$,RECNR
5120 WHILE KTONR$(1 : ╱cb╱ (KREDGRP$)) = KREDGRP$ DO
5130 EXEC LÆS_KONTO(RECNR)
5140 LET A_KTO_ULTIMO := A_KTO_ULTIMO + KTO_ULTIMO ; K := K + 1
5150 GET KTOIDX$,K + 1 : KTONR$,RECNR
5160 ENDWHILE
5170 LET KTO_ULTIMO := A_KTO_ULTIMO ; KTO_TYPE$ := "A"
5180 LET KTO_NAVN$ := "Varekreditorer(samlekonto)"
5190 ELSE
5200 IF TONR$ = "1243" THEN
5210 LET A_KTO_TYPE$ := KTO_TYPE$ ; A_KTONR$ := KTONR$ ; A_KTO_ULTIMO := KTO_ULTIMO
5220 LET A_KTO_NAVN$ := KTO_NAVN$
5230 LET K := K + 1
5240 IF KTONR$ = PRIVATF$ THEN LET KTONR$ := "@@@@"
5250 GET KTOIDX$,K : KTONR$,RECNR
5260 EXEC LÆS_KONTO(RECNR)
5270 ELSE
5280 IF TONR$ = "152" THEN
5290 EXEC SKRIV_LIN(KTO_ULTIMO)
5300 LET KTONR$ := A_KTONR$ ; KTO_ULTIMO := A_KTO_ULTIMO ; KTO_NAVN$ := A_KTO_NAVN$
5310 ENDIF
5320 ENDIF
5330 ENDIF
5340 ENDIF
5160 IF KTONR$ = PRIVATF$ THEN LET KTONR$ := "#####"
5170 IF NOT "/" + KTONR$ + "/" IN NONBOOK$ THEN EXEC SKRIV_LIN(KTO_ULTIMO)
5180 NEXT K
5190 EXEC PRINTREL
5260 ENDPROC UDSKRIV
5270 //
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
5280 //
5290 PROC PRINTREL // RELEASE PRINTER
5300 SELECT OUTPUT "T"
5310 ENDPROC PRINTREL
4675 REPEAT
4675 FOR I := 1 TO BRGRP DO
5140 ENDIF
5030 FOR GN := 1 TO BRG DO
4980 IF TONR$(1 : ╱cb╱ (GRP$(I))) = GRP$(I) THEN
5070 LET KTO_NAVN$ := GRPN$(I)
4801 READ GN
4802 DIM GRP$(GN) OF 8,GRPN$(GN) OF 40
4830 FOR GN := 1 TO BRG DO
4840 READ GRP$(GN),GRPN$(GN)
4850 NEXT GN
4810 READ NBRG
4820 DIM GRP$(NBRG) OF 8,GRPN$(NBRG) OF 40
5150 NEXT GN
5070 WHILE KTONR$(1 : ╱cb╱ (GRP$(GN))) = GRP$(GN) DO
5040 IF TONR$(1 : ╱cb╱ (GRP$(GN))) = GRP$(GN) THEN
5200 DATA 5
5382 DATA "011","Varesalg"
5383 DATA "021","Vareforbrug"
5384 DATA "1211","Varelager (samlekonto)"
5385 DATA "1221","Varedebitorer (samlekonto)"
5386 DATA "153","Varekreditorer (samlekonto)"
5382 DATA "011","Varesalg (samlekonto)"
5383 DATA "021","Vareforbrug (samlekonto)"
5070 LET KTO_NAVN$ := GRPN$(GN)
5210 DATA "011","Omsætning"
5220 DATA "021","Vareforbrug"
5230 DATA "1211","Varelager (samlekonto)"
5240 DATA "1221","Varedebitorer (samlekonto)"
5250 DATA "153","Varekreditorer (samlekonto)"
5070 LET KTO_NAVN$ := GRPN$(GN) ; KTONR$ := "######"
26995 l-BDE lams ╱00╱ ╱00╱ ╱0e╱ ╱00╱ , ╱d6╱ 1 ╱10╱ SELECT OUTPUT "T"
4146 PRINT USING "##########.##        " : OVERSKUD,
4147 PRINT KTONR$
4148 SELECT OUTPUT "P"
5130 LET KTO_NAVN$ := GRPN$(GN) ; KTONR$ := GRP$(GN)
7967 ╱1f╱ ╱1f╱ MARAPAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ W ╱00╱ ╱00╱ ╱01╱ ╱00╱ ESC LN ╱06╱ ╱13╱ EXEC PRINTRES("papir",14)
5320 //
5330 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
5340 LET PRTNR$ := "1" ; OK := TRUE
5350 REPEAT
5360 CURSOR 15,LINE
5370 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
5380 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
5390 CURSOR 1,LINE
5400 PRINT "<Z>"
5410 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
5420 PRINT "<SZ>     Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
5430 INPUT "" : SVAR$
5440 SELECT OUTPUT "P" + PRTNR$
5450 IF ("P") THEN
5460 CURSOR 12,LINE
5470 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
5480 CURSOR 12,LINE + 1
5490 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
5500 IF VAR$ = "J" OR SVAR$ = "j" THEN
5510 CURSOR 12,LINE
5520 PRINT "<Z>     Der ventes på at printeren bliver ledig...."
5530 PRINT "<SZ>"
5540 WHILE ╱cd╱ ("P") DO
5550 LET SEK := ╱ca╱ (5)
5560 SELECT OUTPUT "P" + PRTNR$
5570 ENDWHILE
5580 ELSE
5590 LET OK := FALSE
5600 ENDIF
5610 ENDIF
5620 CURSOR 1,LINE
5630 PRINT "<Z>"
5640 PRINT "<SZ>"
5650 ENDPROC PRINTRES
DataMuseum.dk

MIKADOS

⟦7d513ec66⟧ SPC/1-COMAL-80

Derivation

SPC/1 COMAL-80

Full view
