|
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: 18875 (0x49bb)
Types: SPC/1-COMAL-80
Notes: Mikados_B, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
Names: »SYSAKY.B«
└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
└─⟦this⟧ »SYSAKY.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 OPTÆL
0280 EXEC START_MENU
0290 CHAIN PROGRAM$
0300 // =========== Procedurer starter ==============
0310 PROC DIMENSIONER
0320 // Standard variable
0330 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0340 DIM PROGRAM$ OF 17,PRTNR$ OF 1
0350 REAL RESRV,PPAR
0360 INTEGER OK,TRUE,FALSE,I,J
0370 // Hjælpevariable
0380 REAL TOT(6),BAL(6),KASSE_BEH,K_DIFF,MOMS_KR,NULR
0390 INTEGER IDXPOS,HIGH,LOW,KREDIT,DEBET,LIN_T,MAX_LIN,T_IDX,K,NUL
0400 // Variable til filen SYSPARA
0410 DIM SYSPARA$ OF 17
0420 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0430 DIM DATAFL$ OF 8,T_KODE$ OF 1
0440 // Variable til filen @@PARAM
0450 DIM PARAM$ OF 17
0460 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0470 REAL MOMS
0480 // Variable til filen @@KASSE
0490 DIM KASSE$ OF 17
0500 DIM K_BDAT$ OF 6
0510 INTEGER K_HØJREC,K_MAXREC,S_NR_KASSE
0520 DIM K_BKTO$ OF 8,K_LKOD$ OF 1,K_MKOD$ OF 1
0530 DIM K_BNR$ OF 5,K_TXT$ OF 20
0540 REAL K_BKR
0550 INTEGER K_DK
0560 // Variable til filen @@KONTO
0570 DIM KONTO$ OF 17
0580 DIM ST_DATO$ OF 6
0590 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0600 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0610 REAL KTO_PRIMO,KTO_ULTIMO
0620 INTEGER KTO_FP,KTO_SP
0630 // Variable til filen @@KTOIDX
0640 DIM KTOIDX$ OF 17
0650 INTEGER I_HØJREC,I_MAXREC
0660 DIM KTONR$ OF 8
0670 INTEGER RECNR
0680 // Variable til filen @@FKTONR
0690 DIM FKTONR$ OF 17
0700 DIM KASSE_KTO$ OF 8,BANK_KTO$ OF 8,GIRO_KTO$ OF 8
0710 DIM K_DIFF_KTO$ OF 8,INDMOMS_KTO$ OF 8,UDMOMS_KTO$ OF 8
0720 // Variable til filen @@TRANS
0730 DIM TRANS$ OF 17
0740 INTEGER T_HØJREC,T_MAXREC
0750 DIM BKTONR$ OF 8,BDATO$ OF 6,BLGNR$ OF 5,BTXT$ OF 20
0760 REAL BMOMS,BBELØB
0770 INTEGER DK,NTRANS
0780 ENDPROC DIMENSIONER
0790
0800 PROC INITIER
0810 LET PRGFL$ := "DP2"
0820 LET PROGRAM$ := PRGFL$ + ":SYSKR"
0830 LET TAL$ := "0123456789" ; NULR := 0
0840 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0850 LET SPC$ := " "
0860 LET SPC$ := SPC$ + SPC$
0870 LET FALSE := 0 ; TRUE := 1 // boolske variable
0880 LET KREDIT := - 1 ; DEBET := 1
0890 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0900 EXEC OPENFIL(SYSPARA$,"R")
0910 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0920 EXEC TERMINAL_IDX
0930 CLOSE SYSPARA$
0950 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0960 EXEC OPENFIL(PARAM$,"R")
0970 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0980 CLOSE PARAM$
0990 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
1000 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
1010 LET KASSE$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KASSE"
1020 LET FKTONR$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "FKTONR"
1030 LET TRANS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "TRANS"
1040 EXEC OPENFIL(KTOIDX$,"R")
1050 EXEC OPENFIL(KONTO$,"W")
1060 EXEC OPENFIL(KASSE$,"W")
1070 EXEC OPENFIL(FKTONR$,"R")
1080 EXEC OPENFIL(TRANS$,"W")
1090 GET FKTONR$,1 : KASSE_KTO$
1100 GET FKTONR$,2 : BANK_KTO$
1110 GET FKTONR$,3 : GIRO_KTO$
1120 GET FKTONR$,4 : K_DIFF_KTO$
1130 GET FKTONR$,5 : INDMOMS_KTO$
1140 GET FKTONR$,6 : UDMOMS_KTO$
1150 CLOSE FKTONR$
1160 ENDPROC INITIER
1170
1180 PROC TERMINAL_IDX
1190 LET PPAR := 5 ; RESRV := 0
1200 CALL J"DDE:PRES"
1210 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1220 ENDPROC TERMINAL_IDX
1230
1240 PROC OPENFIL(FNAVN$,WAY$)
1250 REPEAT
1260 IF AY$ = "W" OR WAY$ = "w" THEN
1270 OPEN FNAVN$,W
1280 ELSE
1290 OPEN FNAVN$,R
1300 ENDIF
1310 IF (FNAVN$) THEN
1320 PRINT "<SC0123>" ; CHR$ (7)
1330 IF (FNAVN$) = 6 THEN
1340 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1350 INPUT "" : SVAR$
1360 ELSE
1370 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1380 PRINT "<S>" ; FNAVN$ ; " ***"
1390 INPUT "" : SVAR$
1400 PRINT "<C0102>" ; SPC$
1410 ENDIF
1420 ENDIF
1430 UNTIL NOT ╱cd╱ (FNAVN$)
1440 ENDPROC OPENFIL
1450
1460 PROC TAL_CONTROL( REF RST$)
1470 LET J := 0 ; OK := TRUE
1480 FOR I := 1 TO (RST$) DO
1490 IF RST$(I) IN TAL$ + "." THEN LET J := J + 1 ; RST$(J) := RST$(I)
1500 NEXT I
1510 IF = 0 THEN
1520 LET OK := FALSE
1530 ELSE
1540 LET RST$ := RST$(1 : J)
1550 ENDIF
1560 ENDPROC TAL_CONTROL
1570
1580 PROC KASSEHOVED
1590 EXEC OVERSKRIFT("BOGFØRING AF KASSEBILAG",4)
1590 PRINT "<C0105> BILAG TEKST MOMS KASSE"
1600 PRINT "<C0106> NR KODE BANK/"
1620 PRINT "<C0107> GIRO"
1630 PRINT "<C0108>----------------------------------------"
1640 PRINT "<C4105>/ INDBETALING UDBETALING MODPOST- F/"
1650 PRINT "<C4106> (DEBET) (KREDIT) ERES R/"
1660 PRINT "<C4107> KONTONR S"
1670 PRINT "<C4108>----------------------------------------"
1680 ENDPROC KASSEHOVED
1690
1700 PROC OVERSKRIFT(ST$,L)
1710 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1720 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1730 PRINT SYST_DAT$(5 : 2)
1740 CURSOR 36 - ╱cb╱ (ST$) DIV 2,L
1750 PRINT "*** " ; ST$ ; " ***"
1760 ENDPROC OVERSKRIFT
1770
1780 PROC SL_FEJLLINIE
1790 LET OK := TRUE
1800 PRINT "<C0102>" ; SPC$
1810 ENDPROC SL_FEJLLINIE
1820
1830 PROC FEJL(ST$)
1840 LET OK := FALSE
1850 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1860 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1870 ENDPROC FEJL
1880
1890
1900 PROC SKRIV_LIN(R_LIN)
1910 IF K_BNR$ = "*****" THEN EXIT
1920 LET R_SLIN := R_LIN MOD 12 + 8
1930 IF R_SLIN = 8 THEN LET R_SLIN := 12 + R_SLIN
1940 CURSOR 1,R_SLIN
1950 PRINT SPC$(1 : 78)
1960 CURSOR 1,R_SLIN
1970 PRINT CHR$ (R_LIN,2)
1980 CURSOR 4,R_SLIN
1990 PRINT K_BNR$
2000 CURSOR 11,R_SLIN
2010 PRINT K_TXT$
2020 CURSOR 32,R_SLIN
2030 PRINT K_MKOD$
2040 CURSOR 38,R_SLIN
2050 PRINT K_LKOD$
2060 IF _DK = DEBET THEN
2070 CURSOR 42,R_SLIN
2080 ELSE
2090 CURSOR 55,R_SLIN
2100 ENDIF
2110 PRINT CHR$ (K_BKR,9,2)
2120 CURSOR 69,R_SLIN
2130 PRINT K_BKTO$
2140 ENDPROC SKRIV_LIN
2150
2160 PROC SKRIV_K_POST(P)
2170 PUT KASSE$,P + 1 : K_BKTO$,K_LKOD$,K_MKOD$,K_BNR$,K_TXT$,K_BKR,K_DK
2180 ENDPROC SKRIV_K_POST
2190
2200 PROC LÆS_K_POST(P)
2210 GET KASSE$,P + 1 : K_BKTO$,K_LKOD$,K_MKOD$,K_BNR$,K_TXT$,K_BKR,K_DK
2220 ENDPROC LÆS_K_POST
2230
2240 PROC LÆS_KONTO(P)
2250 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
2260 ENDPROC LÆS_KONTO
2270
2280 PROC SKRIV_KONTO(P)
2290 PUT KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
2300 ENDPROC SKRIV_KONTO
2310
2320 PROC LÆS_TRANS(P)
2330 GET TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
2340 ENDPROC LÆS_TRANS
2350
2360 PROC SKRIV_TRANS(P)
2370 PUT TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
2380 ENDPROC SKRIV_TRANS
2390
2400 PROC ST_BGST( REF RST$)
2410 FOR I := 1 TO (RST$) DO
2420 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
2430 NEXT I
2440 ENDPROC ST_BGST
2450
2460 PROC SIDE_SKIFT
2470 FOR I := LIN_T TO AX_LIN DO PRINT
2480 LET LIN_T := 9
2480 PRINT
2500 PRINT "*** " ; SYST_NAVN$ ; " ***"
2510 PRINT
2520 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(42)
2530 PRINT "** KASSERAPPORT PR. " ; K_BDAT$(1 : 2) ; "." ; K_BDAT$(3 : 2) ; "." ;
2540 PRINT K_BDAT$(5 : 2) ; " ** ** UDSKREVET PR. " ; SYST_DAT$(1 : 2) ; "." ;
2550 PRINT SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ** SIDE: " ; S_NR_KASSE
2560 PRINT
2570 LET SVAR$ := "-----------------"
2580 LET K := ╱cb╱ (" " + KASSE_KTO$ + " KASSE ") ; I := K DIV 2 ; K := 22 - K - I
2590 PRINT "<S>" ; TAB(37) ; SVAR$(1 : I) ; " " ; KASSE_KTO$ ; " KASSE " ; SVAR$(1 : K) ; " "
2600 LET K := ╱cb╱ (" " + BANK_KTO$ + " BANK ") ; I := K DIV 2 ; K := 22 - K - I
2600 PRINT "<S>" ; SVAR$(1 : I) ; " " ; BANK_KTO$ ; " BANK " ; SVAR$(1 : K) ; " "
2610 LET K := ╱cb╱ (" " + GIRO_KTO$ + " GIRO ") ; I := K DIV 2 ; K := 22 - K - I
2620 PRINT SVAR$(1 : I) ; " " ; GIRO_KTO$ ; " GIRO " ; SVAR$(1 : K)
2630 PRINT "<S>BILAG TEKST MK INDBETALT UDBETALT "
2640 PRINT " INDSAT HÆVET INDSAT HÆVET KONTONR"
2650 EXEC SLUT_LINIE
2660 LET S_NR_KASSE := S_NR_KASSE + 1
2670 ENDPROC SIDE_SKIFT
2680
2690 PROC PRINT_LINIE
2700 IF K_BNR$ = "*****" THEN EXIT
2710 IF LIN_T + 12 >= MAX_LIN THEN EXEC TRANSPORT
2720 LET LIN_T := LIN_T + 1
2730 PRINT "<S>" ; K_BNR$ ; TAB(11) ; K_TXT$ ; TAB(33) ; K_MKOD$ ; TAB(35)
2750 CASE K_LKOD$ OF
2760 WHILE "K"
2770 // DO NOTHING
2780 LET T_IDX := 1
2790 WHILE "B"
2800 PRINT TAB(25) ;
2810 LET T_IDX := 3
2820 WHILE "G"
2830 PRINT TAB(49) ;
2840 LET T_IDX := 5
2850 ENDCASE
2860 IF _DK = DEBET THEN
2870 PRINT CHR$ (K_BKR,9,2) ;
2880 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
2890 ELSE
2900 PRINT " " ; CHR$ (K_BKR,9,2) ;
2910 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
2920 ENDIF
2930 IF _BKTO$ + "/" IN KASSE_KTO$ + "/" + BANK_KTO$ + "/" + GIRO_KTO$ + "/" THEN
2940 PRINT "<N>"
2950 PRINT "<S>" ; TAB(36)
2960 CASE K_BKTO$ OF
2970 WHILE KASSE_KTO$
2980 // DO NOTHING
2990 LET T_IDX := 1
3000 WHILE BANK_KTO$
3010 PRINT "<S>" ; TAB(28)
3020 LET T_IDX := 3
3030 WHILE GIRO_KTO$
3040 PRINT "<S>" ; TAB(52)
3050 LET T_IDX := 5
3060 ENDCASE
3070 IF _DK = DEBET THEN
3080 PRINT USING " ########.##" : K_BKR
3090 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
3100 ELSE
3110 PRINT USING "########.##" : K_BKR
3120 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
3130 ENDIF
3140 ELSE
3150 PRINT "<S>" ; TAB(78)
3160 PRINT K_BKTO$
3170 ENDIF
3180 ENDPROC PRINT_LINIE
3190
3200 PROC SLUT_LINIE
3200 PRINT "<S>----- -------------------- -- ---------- ---------- "
3220 PRINT "---------- ---------- ---------- ---------- --------"
3230 ENDPROC SLUT_LINIE
3240
3250 PROC TRANSPORT
3260 IF IN_T = 100 THEN
3270 EXEC SIDE_SKIFT
3280 ELSE
3290 EXEC SLUT_LINIE
3300 LET LIN_T := LIN_T + 2
3310 PRINT "<S>" ; TAB(11) ; "TRANSPORT" ; TAB(36)
3320 PRINT USING "<S>########.## ########.## " : TOT(1),TOT(2)
3330 PRINT USING "<S>########.## ########.## " : TOT(3),TOT(4)
3340 PRINT USING "########.## ########.##" : TOT(5),TOT(6)
3350 EXEC SIDE_SKIFT
3360 LET LIN_T := LIN_T + 1
3370 PRINT "<S>" ; TAB(11) ; "TRANSPORT" ; TAB(36)
3380 PRINT USING "<S>########.## ########.## " : TOT(1),TOT(2)
3390 PRINT USING "<S>########.## ########.## " : TOT(3),TOT(4)
3400 PRINT USING "########.## ########.## " : TOT(5),TOT(6)
3410 ENDIF
3420 ENDPROC TRANSPORT
3430
3440 PROC UDSKRIV_POSTER
3450 EXEC OVERSKRIFT("Udskrivning af kasserapport",7)
3450 EXEC PRINTRES("bred EDB-liste",12)
3460 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 51
3480 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
3490 FOR J := 1 TO _HØJREC - 1 DO
3500 EXEC LÆS_K_POST(J)
3510 EXEC PRINT_LINIE
3520 NEXT J
3530 IF LIN_T >< 100 THEN EXEC AFSLUT
3540 EXEC PRINTREL
3550 ENDPROC UDSKRIV_POSTER
3560
3570 PROC AFSLUT
3580 EXEC SLUT_LINIE
3590 LET LIN_T := LIN_T + 7
3600 PRINT "<S>" ; TAB(11) ; "DAGENS BEVÆGELSER " ; TAB(35)
3610 PRINT "<S>" ; CHR$ (TOT(1),9,2) ; CHR$ (TOT(2),9,2)
3620 PRINT "<S>" ; CHR$ (TOT(3),9,2) ; CHR$ (TOT(4),9,2)
3630 PRINT CHR$ (TOT(5),9,2) ; CHR$ (TOT(6),9,2)
3640 PRINT
3650 PRINT "<S>" ; TAB(11) ; "BEHOLDNING MORGEN" ; TAB(35)
3660 EXEC FIND_KTO(KASSE_KTO$)
3670 EXEC LÆS_KONTO(RECNR)
3680 PRINT "<S>" ; CHR$ (KTO_ULTIMO,9,2) ; TAB(28)
3690 LET BAL(1) := TOT(1) + KTO_ULTIMO
3700 EXEC FIND_KTO(BANK_KTO$)
3710 EXEC LÆS_KONTO(RECNR)
3720 PRINT "<S>" ; CHR$ (KTO_ULTIMO,9,2) ; TAB(28)
3730 LET BAL(3) := TOT(3) + KTO_ULTIMO
3740 EXEC FIND_KTO(GIRO_KTO$)
3750 EXEC LÆS_KONTO(RECNR)
3760 PRINT CHR$ (KTO_ULTIMO,9,2)
3770 LET BAL(5) := TOT(5) + KTO_ULTIMO
3780 PRINT "<S>" ; TAB(11) ; "BEHOLDNING AFTEN" ; TAB(47)
3790 PRINT "<S>" ; CHR$ (KASSE_BEH,9,2) ; TAB(28)
3800 PRINT "<S>" ; CHR$ (BAL(3) - TOT(4),9,2) ; TAB(28)
3810 PRINT CHR$ (BAL(5) - TOT(6),9,2)
3820 PRINT "<S> ---------- ---------- "
3830 PRINT "---------- ---------- ---------- ----------"
3840 PRINT "<S>" ; TAB(11) ; "BALANCE" ; TAB(35)
3850 LET BAL(2) := TOT(2) + KASSE_BEH
3860 PRINT CHR$ (BAL(1),9,2) ; CHR$ (BAL(2),9,2) ; CHR$ (BAL(3),9,2) ;
3870 PRINT CHR$ (BAL(3),9,2) ; CHR$ (BAL(5),9,2) ; CHR$ (BAL(5),9,2)
3880 PRINT "<S>" ; TAB(11) ; "KASSEDIFFERENCE" ; TAB(35)
3890 IF _DIFF > 0 THEN
3900 PRINT CHR$ (K_DIFF,9,2)
3910 LET BAL(1) := BAL(1) + K_DIFF
3920 ELSE
3930 PRINT TAB(13) ; CHR$ (ABS(K_DIFF),9,2)
3940 LET BAL(2) := BAL(2) - K_DIFF
3950 ENDIF
3960 PRINT "<S>" ; TAB(11) ; "BALANCE" ; TAB(35)
3970 PRINT CHR$ (BAL(1),9,2) ; CHR$ (BAL(2),9,2)
3990 FOR I := LIN_T TO AX_LIN DO PRINT
4000 ENDPROC AFSLUT
4010
4020 PROC OPTÆL
4030 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0
4040 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
4050 IF _HØJREC < 2 THEN
4060 PRINT "<XC1212>Der kan ikke afstemmes - når der ikke er indtastet"
4070 PRINT "<C1213>nogen kasseposteringer"
4080 INPUT "<C6523>Tryk RETURN" : SVAR$
4090 CHAIN PROGRAM$
4100 ENDIF
4110 FOR I := 1 TO _HØJREC - 1 DO
4120 EXEC LÆS_K_POST(I)
4130 IF _BNR$ >< "*****" THEN
4140 CASE K_LKOD$ OF
4150 WHILE "K"
4160 LET T_IDX := 1
4170 WHILE "B"
4180 LET T_IDX := 3
4190 WHILE "G"
4200 LET T_IDX := 5
4210 OTHERWISE
4220 EXEC FEJL("Ulovlig likviditetskode ved post " + CHR$ (I,2))
4230 ENDCASE
4240 IF _DK = DEBET THEN
4250 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
4260 ELSE
4270 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
4280 ENDIF
4290 CASE K_BKTO$ OF
4300 WHILE KASSE_KTO$
4310 LET T_IDX := 1
4320 WHILE BANK_KTO$
4330 LET T_IDX := 3
4340 WHILE GIRO_KTO$
4350 LET T_IDX := 5
4360 OTHERWISE
4370 LET T_IDX := 0
4380 ENDCASE
4390 IF _IDX > 0 THEN
4400 IF _DK = DEBET THEN
4410 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
4420 ELSE
4430 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
4440 ENDIF
4450 ENDIF
4460 ENDIF
4470 NEXT I
4480 LET IDXPOS := FIND_KTO(KASSE_KTO$)
4490 EXEC LÆS_KONTO(RECNR)
4500 LET TOT(1) := TOT(1) + KTO_ULTIMO
4510 LET IDXPOS := FIND_KTO(BANK_KTO$)
4520 EXEC LÆS_KONTO(RECNR)
4530 LET TOT(3) := TOT(3) + KTO_ULTIMO
4540 LET IDXPOS := FIND_KTO(GIRO_KTO$)
4550 EXEC LÆS_KONTO(RECNR)
4560 LET TOT(5) := TOT(5) + KTO_ULTIMO
4570 ENDPROC OPTÆL
4580 PROC START_MENU
4590 EXEC OVERSKRIFT("Afstemning af kasserapport",4)
4600 CURSOR 42 - ╱cb╱ (KASSE_KTO$ + " KASSE") / 2,6
4610 PRINT KASSE_KTO$ ; " KASSE"
4620 CURSOR 56 - ╱cb╱ (BANK_KTO$ + " BANK") / 2,6
4630 PRINT BANK_KTO$ ; " BANK"
4640 CURSOR 70 - ╱cb╱ (GIRO_KTO$ + " GIRO") / 2,6
4650 PRINT GIRO_KTO$ ; " GIRO"
4660 PRINT "<C0708>Beregnet beholdning aften"
4670 PRINT "<SC3708>" ; CHR$ (TOT(1) - TOT(2),9,2) ; " " ; CHR$ (TOT(3) - TOT(4),9,2)
4680 PRINT " " ; CHR$ (TOT(5) - TOT(6),9,2)
4690 PRINT "<C0711>Indtast herefter optalt"
4700 INPUT "<C0712>kassebeholdning aften " : KASSE_BEH
4710 PRINT "<C3712>" ; CHR$ (KASSE_BEH,9,2)
4720 LET K_DIFF := KASSE_BEH - (TOT(1) - TOT(2))
4730 PRINT "<C0715>Kassedifference i forhold"
4740 PRINT "<C0716>til optalt beholdning " ; CHR$ (K_DIFF,9,2)
4750 REPEAT
4760 LET SVAR$ := "j"
4770 EDIT "<SC2320>Godkend kassedifference (j/n)? " : SVAR$(1)
4780 UNTIL "/" + SVAR$ + "/" IN "/J/j/N/n/"
4790 IF VAR$ IN "Nn" THEN
4800 PRINT "<XSC1212>Gå tilbage og ret kasseposteringerne under funktionskod"
4810 PRINT "e 'RK'"
4820 INPUT "<SC6824>Tryk RETURN" : SVAR$
4830 CHAIN PROGRAM$
4840 ELSE
4850 EXEC UDSKRIV_POSTER
4860 EXEC BOGFØR_KASSEPOST
4870
4880 ENDIF
4890 ENDPROC START_MENU
4900
4910 PROC BOGFØR_KASSEPOST
4920 EXEC KASSEHOVED
4930 FOR I := 1 TO _HØJREC - 1 DO
4940 EXEC LÆS_K_POST(I)
4950 IF _BNR$ >< "*****" THEN
4960 EXEC SKRIV_LIN(I)
4970 IF _BKTO$ >< KASSE_KTO$ THEN
4980 IF _BKTO$ >< GIRO_KTO$ THEN
4990 IF _BKTO$ >< BANK_KTO$ THEN
5000 LET K_DK := K_DK * ( - 1)
5010 IF /" + K_MKOD$ + "/" IN "/I/U/" THEN
5020 LET MOMS_KR := INT(MOMS * 100 * (K_BKR / (MOMS + 100)) + .5) / 100 ; K_BKR := K_BKR - MOMS_KR
5030 IF _MKOD$ = "I" THEN
5040 EXEC BOGFØR(INDMOMS_KTO$,K_BDAT$,K_TXT$,NULR,MOMS_KR,K_DK,K_BNR$)
5050 ELSE
5060 EXEC BOGFØR(UDMOMS_KTO$,K_BDAT$,K_TXT$,NULR,MOMS_KR,K_DK,K_BNR$)
5070 ENDIF
5080 ELSE
5090 LET MOMS_KR := 0
5100 ENDIF
5110 EXEC BOGFØR(K_BKTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK,K_BNR$)
5120 ENDIF
5130 ENDIF
5140 ENDIF
5150 CURSOR 4,R_SLIN
5160 PRINT "* * * * * * * * * * * B O G F Ø R T * * * * * * * * * * * * *" ;
5170 PRINT SPC$(1 : 10)
5180 LET K_BNR$ := "*****"
5190 EXEC SKRIV_K_POST(I)
5200 ENDIF
5210 NEXT I
5220 LET K_TXT$ := "INDBETALINGER" ; K_DK := DEBET ; MOMS_KR := 0
5230 LET K_BKR := TOT(1)
5240 EXEC BOGFØR(KASSE_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5250 LET K_BKR := TOT(3) ; K_TXT$ := "INDSAT"
5260 EXEC BOGFØR(BANK_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5270 LET K_BKR := TOT(5)
5280 EXEC BOGFØR(GIRO_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5290 LET K_DK := KREDIT
5300 LET K_BKR := TOT(2) ; K_TXT$ := "UDBETALINGER"
5310 EXEC BOGFØR(KASSE_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5320 LET K_BKR := TOT(4) ; K_TXT$ := "HÆVET"
5330 EXEC BOGFØR(BANK_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5340 LET K_BKR := TOT(6)
5350 EXEC BOGFØR(GIRO_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_BKR,K_DK," ")
5360 IF _DIFF >< 0 THEN
5370 LET K_DK := SGN(K_DIFF) ; K_TXT$ := "KASSEDIFFERENCE" ; K_DIFF := ABS(K_DIFF)
5380 EXEC BOGFØR(KASSE_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_DIFF,K_DK," ")
5390 LET K_DK := K_DK * ( - 1)
5400 EXEC BOGFØR(K_DIFF_KTO$,K_BDAT$,K_TXT$,MOMS_KR,K_DIFF,K_DK," ")
5410 ENDIF
5420 LET K_HØJREC := 1
5430 PUT KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
5440 ENDPROC BOGFØR_KASSEPOST
5450
5460 PROC BOGFØR( REF Q_KTO$, REF Q_DAT$, REF Q_TXT$, REF Q_M, REF Q_KR,Q_DK,QN$)
5470 EXEC FIND_KTO(Q_KTO$)
5480 IF OK THEN
5490 EXEC FEJL("UKENDT KONTONR: " + Q_KTO$)
5500 EXIT
5510 ELSE
5520 EXEC LÆS_KONTO(RECNR)
5530 IF TO_TYPE$ >< "A" THEN
5540 EXEC FEJL("ULOVLIG KONTONR: " + Q_KTO$)
5550 EXIT
5560 ENDIF
5570 ENDIF
5580 GET TRANS$,1 : T_HØJREC,T_MAXREC
5590 IF _HØJREC = T_MAXREC THEN
5600 EXEC FEJL("TRANSAKTIONSFILEN ER FULD")
5610 EXIT
5620 ENDIF
5630 LET T_HØJREC := T_HØJREC + 1
5640 IF TO_FP > 0 THEN
5650 EXEC LÆS_TRANS(KTO_SP)
5660 LET NTRANS := T_HØJREC
5670 EXEC SKRIV_TRANS(KTO_SP)
5680 ELSE
5690 LET KTO_FP := T_HØJREC
5700 ENDIF
5710 LET BKTONR$ := Q_KTO$ ; BDATO$ := Q_DAT$ ; BTXT$ := Q_TXT$ ; BMOMS := Q_M ; BBELØB := Q_KR
5720 LET DK := Q_DK ; NTRANS := NUL ; BLGNR$ := QN$
5730 EXEC SKRIV_TRANS(T_HØJREC)
5740 LET KTO_SP := T_HØJREC
5750 IF K = DEBET THEN
5760 LET KTO_ULTIMO := KTO_ULTIMO + BBELØB
5770 ELSE
5780 LET KTO_ULTIMO := KTO_ULTIMO - BBELØB
5790 ENDIF
5800 EXEC SKRIV_KONTO(RECNR)
5810 PUT TRANS$,1 : T_HØJREC,T_MAXREC
5820 ENDPROC BOGFØR
5830 PROC FIND_KTO( REF R_KTONR$)
5840 LET OK := FALSE
5850 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
5860 LET LOW := 1 ; HIGH := I_HØJREC ; POS := 2
5870 IF IGH > 1 THEN
5880 REPEAT
5890 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
5900 GET KTOIDX$,POS : KTONR$,RECNR
5910 IF TONR$ > R_KTONR$ THEN
5920 LET HIGH := POS
5930 ELSE
5940 IF TONR$ < R_KTONR$ THEN
5950 LET LOW := POS
5960 ENDIF
5970 ENDIF
5980 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
5990 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
6000 GET KTOIDX$,POS : KTONR$,RECNR
6010 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
6020 ENDIF
6030 LET FIND_KTO := POS
6040 ENDPROC FIND_KTO
6050 //
6040 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
6050 LET PRTNR$ := "1" ; OK := TRUE
6060 REPEAT
6070 CURSOR 15,LINE
6080 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
6090 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
6100 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
6110 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
6120 INPUT "" : SVAR$
6130 SELECT OUTPUT "P" + PRTNR$
6140 IF ("P") THEN
6150 CURSOR 12,LINE
6160 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
6170 CURSOR 12,LINE + 1
6180 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
6190 IF VAR$ = "J" OR SVAR$ = "j" THEN
6200 CURSOR 12,LINE
6210 PRINT "<Z> Der ventes på at printeren bliver ledig...."
6220 PRINT "<SZ>"
6230 WHILE ╱cd╱ ("P") DO
6240 LET SEK := ╱ca╱ (5)
6250 SELECT OUTPUT "P" + PRTNR$
6260 ENDWHILE
6270 ELSE
6280 LET OK := FALSE
6290 ENDIF
6300 ENDIF
6310 CURSOR 1,LINE
6320 PRINT "<Z>"
6330 PRINT "<SZ>"
6340 ENDPROC PRINTRES
6350 //
6060 PROC PRINTREL // RELEASE PRINTER
6070 SELECT OUTPUT "T"
6080 ENDPROC PRINTREL
2490 PRINT "<K>"
3470 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 72
3980 PRINT "<LIN>"
0940 LET PROGRAM$ := PROGRAM$ + S_KODE$
1600 PRINT "<C0105> BILAG TEKST KASSE"
1610 PRINT "<C0106> NR BANK/"
2610 PRINT "<S>" ; SVAR$(1 : I) ; " " ; BANK_KTO$ ; " BANK " ; SVAR$(1 : K) ; " "
2620 LET K := ╱cb╱ (" " + GIRO_KTO$ + " GIRO ") ; I := K DIV 2 ; K := 22 - K - I
2630 PRINT SVAR$(1 : I) ; " " ; GIRO_KTO$ ; " GIRO " ; SVAR$(1 : K)
2640 PRINT "<S>BILAG TEKST INDBETALT UDBETALT "
2650 PRINT " INDSAT HÆVET INDSAT HÆVET KONTONR"
2660 EXEC SLUT_LINIE
2670 LET S_NR_KASSE := S_NR_KASSE + 1
2680 ENDPROC SIDE_SKIFT
2690
2700 PROC PRINT_LINIE
2710 IF K_BNR$ = "*****" THEN EXIT
2720 IF LIN_T + 12 >= MAX_LIN THEN EXEC TRANSPORT
2730 LET LIN_T := LIN_T + 1
2740 PRINT "<S>" ; K_BNR$ ; TAB(11) ; K_TXT$ ; TAB(33) ; K_MKOD$ ; TAB(35)
3210 PRINT "<S>----- ------------------------ ---------- ---------- "
3460 EXEC PRINTRES("papir",12)
9900 //
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 1,LINE
9908 PRINT "<Z>"
9909 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
9910 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
9911 INPUT "" : SVAR$
9912 SELECT OUTPUT "P" + PRTNR$
9913 IF ("P") THEN
9914 CURSOR 12,LINE
9915 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
9916 CURSOR 12,LINE + 1
9917 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
9918 IF VAR$ = "J" OR SVAR$ = "j" THEN
9919 CURSOR 12,LINE
9920 PRINT "<Z> Der ventes på at printeren bliver ledig...."
9921 PRINT "<SZ>"
9922 WHILE ╱cd╱ ("P") DO
9923 LET SEK := ╱ca╱ (5)
9924 SELECT OUTPUT "P" + PRTNR$
9925 ENDWHILE
9926 ELSE
9927 LET OK := FALSE
9928 ENDIF
9929 ENDIF
9930 CURSOR 1,LINE
9931 PRINT "<Z>"
9932 PRINT "<SZ>"
9933 ENDPROC PRINTRES