DataMuseum.dk

top - download

    Length: 17990 (0x4646)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_17, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSKRY.B«

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSKRY.B« 

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 // =========== Procedurer starter ==============
0290 PROC DIMENSIONER
0300 // Standard variable
0310 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0320 DIM PROGRAM$ OF 17,PRTNR$ OF 1
0330 REAL RESRV,PPAR
0340 INTEGER OK,TRUE,FALSE,I,J,K
0350 // Hjælpevariable
0360 REAL TOT(6)
0370 INTEGER A_POST,HIGH,LOW,POS,IDXPOS,KREDIT,DEBET,LIN_T,MAX_LIN,T_IDX
0380 // Variable til filen SYSPARA
0390 DIM SYSPARA$ OF 17
0400 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0410 DIM DATAFL$ OF 8,T_KODE$ OF 1
0420 // Variable til filen @@PARAM
0430 DIM PARAM$ OF 17
0440 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0450 REAL MOMS
0460 // Variable til filen @@KASSE
0470 DIM KASSE$ OF 17
0480 DIM K_BDAT$ OF 6
0490 INTEGER K_HØJREC,K_MAXREC,S_NR_KASSE
0500 DIM K_BKTO$ OF 8,K_LKOD$ OF 1,K_MKOD$ OF 1
0510 DIM K_BNR$ OF 5,K_TXT$ OF 20
0520 REAL K_BKR
0530 INTEGER K_DK
0540 // Variable til filen @@KONTO
0550 DIM KONTO$ OF 17
0560 DIM ST_DATO$ OF 6
0570 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0580 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0590 REAL KTO_PRIMO,KTO_ULTIMO
0600 INTEGER KTO_FP,KTO_SP
0610 // Variable til filen @@KTOIDX
0620 DIM KTOIDX$ OF 17
0630 INTEGER I_HØJREC,I_MAXREC
0640 DIM KTONR$ OF 8
0650 INTEGER RECNR
0660 // Variable til filen @@FKTONR
0670 DIM FKTONR$ OF 17
0680 DIM KASSE_KTO$ OF 8,BANK_KTO$ OF 8,GIRO_KTO$ OF 8
0690 ENDPROC DIMENSIONER
0700
0710 PROC INITIER
0720 LET PRGFL$ := "DP2"
0730 LET PROGRAM$ := PRGFL$ + ":SYSI"
0740 LET TAL$ := "0123456789"
0750 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0760 LET SPC$ := "                                             "
0770 LET SPC$ := SPC$ + SPC$
0780 LET FALSE := 0 ; TRUE := 1 // boolske variable
0790 LET KREDIT := - 1 ; DEBET := 1
0800 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0810 EXEC OPENFIL(SYSPARA$,"R")
0820 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0830 EXEC TERMINAL_IDX
0840 CLOSE SYSPARA$
0850 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0860 EXEC OPENFIL(PARAM$,"R")
0870 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0880 CLOSE PARAM$
0890 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
0900 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
0910 LET KASSE$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KASSE"
0920 LET FKTONR$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "FKTONR"
0930 EXEC OPENFIL(KTOIDX$,"r")
0940 EXEC OPENFIL(KONTO$,"R")
0950 EXEC OPENFIL(KASSE$,"W")
0960 EXEC OPENFIL(FKTONR$,"R")
0970 GET FKTONR$,1 : KASSE_KTO$
0980 GET FKTONR$,2 : BANK_KTO$
0990 GET FKTONR$,3 : GIRO_KTO$
1000 CLOSE FKTONR$
1010 ENDPROC INITIER
1020
1030 PROC FUNKTIONSMENU
1040 REPEAT
1050 EXEC OVERSKRIFT("Kasserapport",6)
1060 PRINT "<C2009>Indtastning af kasseposteringer     IK"
1070 PRINT "<C2011>Udskrivning af kassekladde          UK"
1080 PRINT "<C2013>Ret kasseposteringer                RK"
1090 PRINT "<C2015>Afstem og bogfør kasseposteringer   AK"
1100 PRINT "<C2018>Programfordeler                   RETURN"
1110 LET SVAR$ := "  "
1120 REPEAT
1130 EDIT "<C2523>Indtast funktionskode: " : SVAR$(1 : 2)
1140 EXEC SL_FEJLLINIE
1150 IF SVAR$ IN "  " THEN EXIT
1160 IF "/" + SVAR$(1 : 2) + "/" IN "/IK/ik/UK/uk/RK/rk/AK/ak/" THEN
1170 EXEC FEJL("Ulovlig funktionskode: '" + SVAR$(1 : 2) + "'")
1180 ENDIF
1190 UNTIL OK
1200 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
1210 CASE SVAR$(1 : 2) OF
1220 WHILE "IK","ik"
1230 IF _HØJREC > 1 AND K_BDAT$ >< SYST_DAT$ THEN
1240 PRINT "<XC1210>Du er startet på en ny dato siden du sidst ind-"
1250 PRINT "<C1211>tastede kasseposteringer -  kasserapporten skal "
1260 PRINT "<C1212>afstemmes inden du kan indtaste flere kasse-"
1270 PRINT "<C1213>posteringer."
1280 INPUT "<SC6523>Tryk RETURN" : SVAR$
1290 ELSE
1300 EXEC INDTAST_POSTER
1310 ENDIF
1320 WHILE "UK","uk"
1330 EXEC UDSKRIV_POSTER
1340 WHILE "RK","rk"
1350 EXEC RET_POSTER
1360 WHILE "AK","ak"
1370 IF _HØJREC = 1 THEN
1380 EXEC FEJL("Ulovlig afstemning - ingen posteringer")
1390 ELSE
1400 LET PROGRAM$ := PRGFL$ + ":SYSAK"
1410 CHAIN PROGRAM$
1420 ENDIF
1430 OTHERWISE
1440 CHAIN PROGRAM$
1450 ENDCASE
1460 UNTIL FALSE
1470 ENDPROC FUNKTIONSMENU
1480
1490 PROC TERMINAL_IDX
1500 LET PPAR := 5 ; RESRV := 0
1510 CALL :PRES"
1520 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1530 ENDPROC TERMINAL_IDX
1540
1550 PROC OPENFIL(FNAVN$,WAY$)
1560 REPEAT
1570 IF AY$ = "W" OR WAY$ = "w" THEN
1580 OPEN FNAVN$,W
1590 ELSE
1600 OPEN FNAVN$,R
1610 ENDIF
1620 IF (FNAVN$) THEN
1630 PRINT "<SC0123>" ; CHR$ (7)
1640 IF (FNAVN$) = 6 THEN
1650 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1660 INPUT "" : SVAR$
1670 ELSE
1680 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1690 PRINT "<S>" ; FNAVN$ ; " ***"
1700 INPUT "" : SVAR$
1710 PRINT "<C0102>" ; SPC$
1720 ENDIF
1730 ENDIF
1740 UNTIL NOT ╱cd╱ (FNAVN$)
1750 ENDPROC OPENFIL
1760
1770 PROC TAL_CONTROL( REF RST$)
1780 LET J := 0 ; OK := TRUE
1790 FOR I := 1 TO (RST$) DO
1800 IF RST$(I) IN TAL$ + "." THEN LET J := J + 1 ; RST$(J) := RST$(I)
1810 NEXT I
1820 IF = 0 THEN
1830 LET OK := FALSE
1840 ELSE
1850 LET RST$ := RST$(1 : J)
1860 ENDIF
1870 ENDPROC TAL_CONTROL
1880
1890 PROC KASSEHOVED
1900 EXEC OVERSKRIFT("INDTASTNING AF KASSEBILAG",4)
1910 PRINT "<C0105>   BILAG  TEKST              MOMS  KASSE"
1920 PRINT "<C0106>    NR                       KODE  BANK/"
1930 PRINT "<C0107>                                   GIRO"
1940 PRINT "<C0108>----------------------------------------"
1950 PRINT "<C4105>/  INDBETALING  UDBETALING  MODPOST- F/"
1960 PRINT "<C4106>     (DEBET)     (KREDIT)   ERES     R/"
1970 PRINT "<C4107>                            KONTONR  S"
1980 PRINT "<C4108>----------------------------------------"
1990 ENDPROC KASSEHOVED
2000
2010 PROC OVERSKRIFT(ST$,L)
2020 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
2030 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
2040 PRINT SYST_DAT$(5 : 2)
2050 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
2060 PRINT "*** " ; ST$ ; " ***"
2070 ENDPROC OVERSKRIFT
2080
2090 PROC EDIT_LIN(R_LIN)
2100 LET R_SLIN := R_LIN MOD 12 + 8
2110 IF R_SLIN = 8 THEN LET R_SLIN := 12 + R_SLIN
2120 EXEC LÆS_K_POST(R_LIN)
2130 IF _BNR$ = "*****" THEN
2140 LET K_BKTO$ := "" ; K_LKOD$ := " " ; K_MKOD$ := " "
2150 LET K_BNR$ := "       " ; K_TXT$ := "" ; K_BKR := 0 ; K_DK := 0
2160 ENDIF
2170 REPEAT
2180 EXEC SL_FEJLLINIE
2190 CURSOR 1,R_SLIN
2200 PRINT CHR$ (R_LIN,2)
2210 REPEAT
2220 CURSOR 4,R_SLIN
2230 EDIT "" : K_BNR$
2240 EXEC SL_FEJLLINIE
2250 IF _BNR$ = "*****" OR "/" + K_BNR$ + "/" IN "/SLUT/slut/" THEN
2260 LET OK := TRUE
2270 ELSE
2280 EXEC TAL_CONTROL(K_BNR$)
2290 IF NOT OK THEN EXEC FEJL("Ulovlig bilagsnummer")
2300 ENDIF
2310 UNTIL OK
2320 CURSOR 4,R_SLIN
2330 PRINT SPC$(1 : 5)
2340 CURSOR 4,R_SLIN
2350 IF _BNR$ = "*****" OR "/" + K_BNR$ + "/" IN "/SLUT/slut/" THEN
2360 IF /" + K_BNR$ + "/" IN "/SLUT/slut/" THEN
2370 LET SVAR$ := "S" ; K_BNR$ := "*****" ; K_HØJREC := K_HØJREC - 1
2380 ENDIF
2390 PRINT SPC$(1 : 76)
2400 EXIT
2410 ELSE
2420 PRINT K_BNR$
2430 ENDIF
2440 CURSOR 11,R_SLIN
2450 EDIT "" : K_TXT$
2460 REPEAT
2470 CURSOR 32,R_SLIN
2480 EDIT "" : K_MKOD$
2490 EXEC SL_FEJLLINIE
2500 EXEC ST_BGST(K_MKOD$)
2510 IF NOT K_MKOD$ IN "IU " THEN EXEC FEJL("ULOVLIG KODE: '" + K_MKOD$ + "'")
2520 UNTIL OK
2470 REPEAT
2480 CURSOR 38,R_SLIN
2490 EDIT "" : K_LKOD$
2500 EXEC SL_FEJLLINIE
2510 EXEC ST_BGST(K_LKOD$)
2520 IF "/" + K_LKOD$ + "/" IN "/K/B/G/" THEN
2530 EXEC FEJL("ULOVLIG KODE: '" + K_LKOD$ + "'")
2540 ENDIF
2550 UNTIL OK
2560 REPEAT
2570 IF _DK = KREDIT THEN
2580 LET SVAR$ := CHR$ (K_BKR,7,2)
2590 IF K_BKR = 0 THEN LET SVAR$ := ""
2600 CURSOR 57,R_SLIN
2610 EDIT "" : SVAR$
2620 EXEC SL_FEJLLINIE
2630 EXEC TAL_CONTROL(SVAR$)
2640 IF NOT "." IN SVAR$ THEN LET SVAR$ := SVAR$ + "."
2650 LET K_BKR := INT(100 * ASC ("0" + SVAR$) + 0.5) / 100
2660 CURSOR 57,R_SLIN
2670 IF _BKR > 0 THEN
2680 PRINT CHR$ (K_BKR,7,2)
2690 ELSE
2700 PRINT SPC$(1 : 10)
2710 ENDIF
2720 ELSE
2730 LET K_DK := DEBET
2740 LET SVAR$ := CHR$ (K_BKR,7,2)
2750 IF K_BKR = 0 THEN LET SVAR$ := ""
2760 CURSOR 44,R_SLIN
2770 EDIT "" : SVAR$
2780 EXEC SL_FEJLLINIE
2790 EXEC TAL_CONTROL(SVAR$)
2800 IF NOT "." IN SVAR$ THEN LET SVAR$ := SVAR$ + "."
2810 LET K_BKR := INT(100 * ASC ("0" + SVAR$) + 0.5) / 100
2820 CURSOR 44,R_SLIN
2830 IF _BKR > 0 THEN
2840 PRINT CHR$ (K_BKR,7,2)
2850 ELSE
2860 PRINT SPC$(1 : 10)
2870 ENDIF
2880 ENDIF
2890 IF K_BKR = 0 THEN LET K_DK := K_DK * ( - 1)
2900 UNTIL K_BKR > 0
2910 REPEAT
2920 CURSOR 69,R_SLIN
2930 EDIT "" : K_BKTO$
2940 EXEC SL_FEJLLINIE
2950 EXEC FIND_KTO(K_BKTO$)
2960 IF K THEN
2970 EXEC LÆS_KONTO(RECNR)
2980 IF TO_TYPE$ >< "A" THEN
2990 EXEC FEJL("Ulovlig kontonr - kontotype < > 'A'")
3000 ELSE
3010 PRINT "<C0102>" ; TAB(35 - ╱cb╱ (KTO_NAVN$) / 2) ; "Konto: " ; KTO_NAVN$
3020 ENDIF
3030 ELSE
3040 EXEC FEJL("Ulovlig kontonr - konto findes ikke")
3050 ENDIF
3060 UNTIL OK
3070 REPEAT
3080 LET SVAR$ := "f"
3090 CURSOR 78,R_SLIN
3100 EDIT "" : SVAR$(1)
3110 EXEC ST_BGST(SVAR$)
3120 UNTIL "/" + SVAR$(1) + "/" IN "/F/S/R/"
3130 UNTIL SVAR$(1) IN "FS"
3140 EXEC SKRIV_K_POST(R_LIN)
3150 EXEC SL_FEJLLINIE
3160 ENDPROC EDIT_LIN
3170
3180 PROC SL_FEJLLINIE
3190 LET OK := TRUE
3200 PRINT "<C0102>" ; SPC$
3210 ENDPROC SL_FEJLLINIE
3220
3230 PROC FEJL(ST$)
3240 LET OK := FALSE
3250 CURSOR 36 - ╱cb╱ (ST$) / 2,2
3260 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
3270 ENDPROC FEJL
3280
3290
3300 PROC INDTAST_POSTER
3310 EXEC SKRIV_LINIER
3320 LET SVAR$ := "F"
3330 WHILE SVAR$ = "F" DO
3340 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
3350 IF K_HØJREC = 1 THEN LET K_BDAT$ := SYST_DAT$
3360 IF _HØJREC = K_MAXREC THEN
3370 EXEC FEJL("Der kan ikke indtastes flere posteringer før afstemning")
3380 INPUT "<SC6524>Tryk RETURN" : SVAR$
3390 EXEC SL_FEJLLINIE
3400 EXIT
3410 ENDIF
3420 LET K_HØJREC := K_HØJREC + 1
3430 EXEC EDIT_LIN(K_HØJREC - 1)
3440 PUT KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
3450 IF K_HØJREC - 1) MOD 12 = 0 AND SVAR$ = "F" THEN
3460 EXEC RET_LINIER
3470 EXEC KASSEHOVED
3480 LET SVAR$ := "F"
3490 ENDIF
3500 ENDWHILE
3510 EXEC RET_LINIER
3520 ENDPROC INDTAST_POSTER
3530
3540 PROC RET_LINIER
3550 REPEAT
3560 PRINT "<SC0122>" ; SPC$
3570 LET SVAR$ := "j"
3580 EDIT "<SC1222>Ok (j) eller linienummer der skal rettes? " : SVAR$
3590 IF "/" + SVAR$ + "/" IN "/J/j/" THEN
3600 EXEC TAL_CONTROL(SVAR$)
3610 IF K THEN
3620 IF (SVAR$) < K_HØJREC AND ASC (SVAR$) > 0 THEN
3630 EXEC EDIT_LIN( ASC (SVAR$))
3640 ENDIF
3650 ENDIF
3660 ENDIF
3670 UNTIL "/" + SVAR$ + "/" IN "/J/j/"
3680 ENDPROC RET_LINIER
3690
3700
3710 PROC SKRIV_LINIER
3720 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
3730 EXEC KASSEHOVED
3740 FOR I := K_HØJREC - (K_HØJREC - 1) MOD 12 TO _HØJREC - 1 DO
3750 IF > 0 THEN
3760 EXEC LÆS_K_POST(I)
3770 IF K_BNR$ >< "*****" THEN EXEC SKRIV_LIN(I)
3780 ENDIF
3790 NEXT I
3800 ENDPROC SKRIV_LINIER
3810
3820 PROC SKRIV_LIN(R_LIN)
3830 IF K_BNR$ = "*****" THEN EXIT
3840 LET R_SLIN := R_LIN MOD 12 + 8
3850 IF R_SLIN = 8 THEN LET R_SLIN := 12 + R_SLIN
3860 CURSOR 1,R_SLIN
3870 PRINT CHR$ (R_LIN,2)
3880 CURSOR 4,R_SLIN
3890 PRINT K_BNR$
3900 CURSOR 11,R_SLIN
3910 PRINT K_TXT$
3920 CURSOR 32,R_SLIN
3930 PRINT K_MKOD$
3940 CURSOR 38,R_SLIN
3950 PRINT K_LKOD$
3960 IF _DK = DEBET THEN
3970 CURSOR 42,R_SLIN
3980 ELSE
3990 CURSOR 55,R_SLIN
4000 ENDIF
4010 PRINT CHR$ (K_BKR,9,2)
4020 CURSOR 69,R_SLIN
4030 PRINT K_BKTO$
4040 ENDPROC SKRIV_LIN
4050
4060 PROC SKRIV_K_POST(P)
4070 PUT KASSE$,P + 1 : K_BKTO$,K_LKOD$,K_MKOD$,K_BNR$,K_TXT$,K_BKR,K_DK
4080 ENDPROC SKRIV_K_POST
4090
4100 PROC LÆS_K_POST(P)
4110 GET KASSE$,P + 1 : K_BKTO$,K_LKOD$,K_MKOD$,K_BNR$,K_TXT$,K_BKR,K_DK
4120 ENDPROC LÆS_K_POST
4130
4140 PROC LÆS_KONTO(P)
4150 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
4160 ENDPROC LÆS_KONTO
4170
4180 PROC ST_BGST( REF RST$)
4190 FOR I := 1 TO (RST$) DO
4200 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
4210 NEXT I
4220 ENDPROC ST_BGST
4230 PROC RET_POSTER
4240 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
4250 LET K := 0
4260 WHILE K < K_HØJREC - 1 DO
4270 IF (K + 12) MOD 12 = 0 THEN EXEC KASSEHOVED
4280 LET K := K + 1
4290 EXEC LÆS_K_POST(K)
4300 EXEC SKRIV_LIN(K)
4310 IF K MOD 12 = 0 OR K = K_HØJREC - 1 THEN EXEC RET_LINIER
4320 ENDWHILE
4330 ENDPROC RET_POSTER
4340 PROC SIDE_SKIFT
4350 FOR I := LIN_T TO AX_LIN DO PRINT
4360 LET LIN_T := 9
4430 PRINT
4380 PRINT "*** " ; SYST_NAVN$ ; " ***"
4390 PRINT
4400 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(42)
4410 PRINT "** KASSEKLADDE PR. " ; K_BDAT$(1 : 2) ; "." ; K_BDAT$(3 : 2) ; "." ;
4420 PRINT K_BDAT$(5 : 2) ; " **    ** UDSKREVET PR. " ; SYST_DAT$(1 : 2) ; "." ;
4430 PRINT SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ** "
4440 PRINT
4450 LET SVAR$ := "-----------------"
4460 LET K := ╱cb╱ (" " + KASSE_KTO$ + " KASSE ") ; I := K DIV 2 ; K := 22 - K - I
4470 PRINT "<S>" ; TAB(37) ; SVAR$(1 : I) ; " " ; KASSE_KTO$ ; " KASSE " ; SVAR$(1 : K) ; "  "
4480 LET K := ╱cb╱ (" " + BANK_KTO$ + " BANK ") ; I := K DIV 2 ; K := 22 - K - I
4490 PRINT "<S>" ; SVAR$(1 : I) ; " " ; BANK_KTO$ ; " BANK " ; SVAR$(1 : K) ; "  "
4500 LET K := ╱cb╱ (" " + GIRO_KTO$ + " GIRO ") ; I := K DIV 2 ; K := 22 - K - I
4510 PRINT SVAR$(1 : I) ; " " ; GIRO_KTO$ ; " GIRO " ; SVAR$(1 : K)
4580 PRINT "<S>BILAG  TEKST                 MK  INDBETALT    UDBETALT   "
4530 PRINT "  INDSAT      HÆVET       INDSAT      HÆVET     KONTONR"
4540 EXEC SLUT_LINIE
4550 ENDPROC SIDE_SKIFT
4560
4570 PROC PRINT_LINIE
4580 IF K_BNR$ = "*****" THEN EXIT
4590 IF LIN_T + 15 >= MAX_LIN THEN EXEC TRANSPORT
4600 LET LIN_T := LIN_T + 1
4610 PRINT "<S>" ; K_BNR$ ; TAB(11) ; K_TXT$ ; TAB(33) ; K_MKOD$ ; TAB(36)
4620 CASE K_LKOD$ OF
4630 WHILE "K"
4640 // DO NOTHING
4650 LET T_IDX := 1
4660 WHILE "B"
4670 PRINT TAB(25) ;
4680 LET T_IDX := 3
4690 WHILE "G"
4700 PRINT TAB(49) ;
4710 LET T_IDX := 5
4720 ENDCASE
4730 IF _DK = DEBET THEN
4740 PRINT USING "########.##" : K_BKR ;
4750 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
4760 ELSE
4770 PRINT USING "             #######.##" : K_BKR ;
4780 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
4790 ENDIF
4800 IF _BKTO$ + "/" IN KASSE_KTO$ + "/" + BANK_KTO$ + "/" + GIRO_KTO$ + "/" THEN
4810 PRINT "<N>"
4820 PRINT "<S>" ; TAB(36)
4830 CASE K_BKTO$ OF
4840 WHILE KASSE_KTO$
4850 // DO NOTHING
4860 LET T_IDX := 1
4870 WHILE BANK_KTO$
4880 PRINT "<S>" ; TAB(28)
4890 LET T_IDX := 3
4900 WHILE GIRO_KTO$
4910 PRINT "<S>" ; TAB(52)
4920 LET T_IDX := 5
4930 ENDCASE
4940 IF _DK = DEBET THEN
4950 PRINT USING "            ########.##" : K_BKR
4960 LET TOT(T_IDX + 1) := TOT(T_IDX + 1) + K_BKR
4970 ELSE
4980 PRINT USING "########.##" : K_BKR
4990 LET TOT(T_IDX) := TOT(T_IDX) + K_BKR
5000 ENDIF
5010 ELSE
5020 PRINT TAB(73) ;
5030 PRINT "<S> "
5040 PRINT K_BKTO$
5050 ENDIF
5060 ENDPROC PRINT_LINIE
5070
5080 PROC SLUT_LINIE
5150 PRINT "<S>-----  --------------------  --  ----------  ----------  "
5100 PRINT "----------  ----------  ----------  ----------  --------"
5110 ENDPROC SLUT_LINIE
5120
5130 PROC TRANSPORT
5140 IF IN_T = 100 THEN
5150 EXEC SIDE_SKIFT
5160 ELSE
5170 EXEC SLUT_LINIE
5180 LET LIN_T := LIN_T + 2
5190 PRINT "<S>" ; TAB(11) ; "TRANSPORT" ; TAB(36)
5200 PRINT USING "<S>########.## ########.## " : TOT(1),TOT(2)
5210 PRINT USING "<S>########.## ########.## " : TOT(3),TOT(4)
5220 PRINT USING "########.## ########.##" : TOT(5),TOT(6)
5230 EXEC SIDE_SKIFT
5240 LET LIN_T := LIN_T + 1
5250 PRINT "<S>" ; TAB(11) ; "TRANSPORT" ; TAB(36)
5260 PRINT USING "<S>########.## ########.## " : TOT(1),TOT(2)
5270 PRINT USING "<S>########.## ########.## " : TOT(3),TOT(4)
5280 PRINT USING "########.## ########.## " : TOT(5),TOT(6)
5350 ENDIF
5360 ENDPROC TRANSPORT
5370
5380 PROC UDSKRIV_POSTER
5390 EXEC OVERSKRIFT("Udskrivning af kassekladde",7)
5400 EXEC PRINTRES("EDB-liste",12)
5410 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 51
5360 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE,K_BDAT$
5370 FOR J := 1 TO _HØJREC - 1 DO
5380 EXEC LÆS_K_POST(J)
5390 EXEC PRINT_LINIE
5400 NEXT J
5410 IF LIN_T >< 100 THEN EXEC AFSLUT
5420 EXEC PRINTREL
5430 ENDPROC UDSKRIV_POSTER
5440
5450 PROC AFSLUT
5460 EXEC SLUT_LINIE
5470 LET LIN_T := LIN_T + 6
5480 PRINT "<S>" ; TAB(11) ; "DAGENS BEVÆGELSER " ; TAB(35)
5490 PRINT "<S>" ; CHR$ (TOT(1),9,2) ; CHR$ (TOT(2),9,2)
5500 PRINT "<S>" ; CHR$ (TOT(3),9,2) ; CHR$ (TOT(4),9,2)
5510 PRINT CHR$ (TOT(5),9,2) ; CHR$ (TOT(6),9,2)
5520 PRINT
5530 PRINT "<S>" ; TAB(11) ; "BEHOLDNING MORGEN" ; TAB(35)
5540 EXEC FIND_KTO(KASSE_KTO$)
5550 EXEC LÆS_KONTO(RECNR)
5560 PRINT "<S>" ; CHR$ (KTO_ULTIMO,9,2) ; TAB(28)
5570 LET TOT(1) := TOT(1) + KTO_ULTIMO
5580 EXEC FIND_KTO(BANK_KTO$)
5590 EXEC LÆS_KONTO(RECNR)
5600 PRINT "<S>" ; CHR$ (KTO_ULTIMO,9,2) ; TAB(28)
5610 LET TOT(3) := TOT(3) + KTO_ULTIMO
5620 EXEC FIND_KTO(GIRO_KTO$)
5630 EXEC LÆS_KONTO(RECNR)
5640 PRINT CHR$ (KTO_ULTIMO,9,2)
5650 LET TOT(5) := TOT(5) + KTO_ULTIMO
5660 PRINT "<S>" ; TAB(11) ; "BEHOLDNING AFTEN(ber.)" ; TAB(47)
5670 PRINT "<S>" ; CHR$ (TOT(1) - TOT(2),9,2) ; TAB(28)
5680 PRINT "<S>" ; CHR$ (TOT(3) - TOT(4),9,2) ; TAB(28)
5690 PRINT CHR$ (TOT(5) - TOT(6),9,2)
5700 PRINT "<S>                                 ----------  ----------  "
5710 PRINT "----------  ----------  ----------  ----------"
5720 PRINT "<S>" ; TAB(11) ; "BALANCE" ; TAB(35)
5730 PRINT CHR$ (TOT(1),9,2) ; CHR$ (TOT(1),9,2) ; CHR$ (TOT(3),9,2) ;
5740 PRINT CHR$ (TOT(3),9,2) ; CHR$ (TOT(5),9,2) ; CHR$ (TOT(5),9,2)
5760 FOR I := LIN_T TO AX_LIN DO PRINT
5770 ENDPROC AFSLUT
5780
5790 PROC FIND_KTO( REF R_KTONR$)
5800 LET OK := FALSE
5810 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
5820 LET LOW := 1 ; HIGH := I_HØJREC ; POS := 2
5830 IF IGH > 1 THEN
5840 REPEAT
5850 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
5860 GET KTOIDX$,POS : KTONR$,RECNR
5870 IF TONR$ > R_KTONR$ THEN
5880 LET HIGH := POS
5890 ELSE
5900 IF TONR$ < R_KTONR$ THEN
5910 LET LOW := POS
5920 ENDIF
5930 ENDIF
5940 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
5950 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
5960 GET KTOIDX$,POS : KTONR$,RECNR
5970 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
5980 ENDIF
5990 LET FIND_KTO := POS
6000 ENDPROC FIND_KTO
6010 //
6070 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
6080 LET PRTNR$ := "1" ; OK := TRUE
6090 REPEAT
6100 CURSOR 15,LINE
6110 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
6120 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
6130 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
6140 PRINT "<SZ>     Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
6150 INPUT "" : SVAR$
6160 SELECT OUTPUT "P" + PRTNR$
6170 IF ("P") THEN
6180 CURSOR 12,LINE
6190 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
6200 CURSOR 12,LINE + 1
6210 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
6220 IF VAR$ = "J" OR SVAR$ = "j" THEN
6230 CURSOR 12,LINE
6240 PRINT "<Z>     Der ventes på at printeren bliver ledig...."
6250 PRINT "<SZ>"
6260 WHILE ╱cd╱ ("P") DO
6270 LET SEK := ╱ca╱ (5)
6280 SELECT OUTPUT "P" + PRTNR$
6290 ENDWHILE
6300 ELSE
6310 LET OK := FALSE
6320 ENDIF
6330 ENDIF
6340 CURSOR 1,LINE
6350 PRINT "<Z>"
6360 PRINT "<SZ>"
6370 ENDPROC PRINTRES
6020 //
6030 PROC PRINTREL // RELEASE PRINTER
6040 SELECT OUTPUT "T"
6050 ENDPROC PRINTREL
4370 PRINT "<K>"
5750 PRINT "<LIN>"
5410 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 51
5410 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 72
5400 EXEC PRINTRES("papir",12)
1910 PRINT "<C0105>   BILAG  TEKST                    KASSE"
1920 PRINT "<C0106>    NR                             BANK/"
2460 LET K_MKOD$ := ""
4520 PRINT "<S>BILAG  TEKST                     INDBETALT    UDBETALT   "
5090 PRINT "<S>-----  ------------------------  ----------  ----------  "
1400 LET PROGRAM$ := PRGFL$ + ":SYSAK" + S_KODE$
5290 ENDIF
5300 ENDPROC TRANSPORT
5310
5320 PROC UDSKRIV_POSTER
5330 EXEC OVERSKRIFT("Udskrivning af kassekladde",7)
5340 EXEC PRINTRES("papir",12)
5350 LET TOT(1),TOT(2),TOT(3),TOT(4),TOT(5),TOT(6) := 0 ; LIN_T := 100 ; MAX_LIN := 72
7967 ╱1f╱ ╱1f╱ ESSAKAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ W ╱00╱ ╱00╱ ╱01╱ ╱00╱ G OR CHAIN ╱17╱ //
6070 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
6080 LET PRTNR$ := "1" ; OK := TRUE
6090 REPEAT
6100 CURSOR 15,LINE
6110 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
6120 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
6130 CURSOR 1,LINE
6140 PRINT "<Z>"
6150 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
6160 PRINT "<SZ>     Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
6170 INPUT "" : SVAR$
6180 SELECT OUTPUT "P" + PRTNR$
6190 IF ("P") THEN
6200 CURSOR 12,LINE
6210 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
6220 CURSOR 12,LINE + 1
6230 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
6240 IF VAR$ = "J" OR SVAR$ = "j" THEN
6250 CURSOR 12,LINE
6260 PRINT "<Z>     Der ventes på at printeren bliver ledig...."
6270 PRINT "<SZ>"
6280 WHILE ╱cd╱ ("P") DO
6290 LET SEK := ╱ca╱ (5)
6300 SELECT OUTPUT "P" + PRTNR$
6310 ENDWHILE
6320 ELSE
6330 LET OK := FALSE
6340 ENDIF
6350 ENDIF
6360 CURSOR 1,LINE
6370 PRINT "<Z>"
6380 PRINT "<SZ>"
6390 ENDPROC PRINTRES
8000 PROC REMOVEBLANK( REF ÆÆ$)
8010 LET J := 0
8020 FOR I := 1 TO (ÆÆ$) DO
8030 IF ÆÆ$(I) >< " " THEN LET J := J + 1 ; ÆÆ$(J) := ÆÆ$(I)
8040 NEXT I
8050 ENDPROC REMOVEBLANK