|
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: 16886 (0x41f6)
Types: SPC/1-COMAL-80
Notes: Mikados_B, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
Names: »SYSKAY.B«
└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
└─⟦this⟧ »SYSKAY.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 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
0350 // Hjælpevariable
0360 REAL TOT(6)
0370 INTEGER HIGH,LOW,POS,KREDIT,DEBET,LIN_T,MAX_LIN,T_IDX,K
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 @@KONTO
0470 DIM KONTO$ OF 17
0480 DIM ST_DATO$ OF 6
0490 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0500 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0510 REAL KTO_PRIMO,KTO_ULTIMO
0520 INTEGER KTO_FP,KTO_SP
0530 // Variable til filen @@KTOIDX
0540 DIM KTOIDX$ OF 17
0550 INTEGER I_HØJREC,I_MAXREC
0560 DIM KTONR$ OF 8
0570 INTEGER RECNR
0580 // Variable til filen @@ST_KTO
0590 DIM ST_KTO$ OF 17
0600 DIM KASSE_KTO$ OF 8,BANK_KTO$ OF 8,GIRO_KTO$ OF 8
0610 // Variable til filen @@DG_POS
0620 DIM DG_POS$ OF 17
0630 DIM P_BDAT$ OF 6
0640 REAL P_DEB,P_KRED
0650 INTEGER P_HØJREC,P_MAXREC,S_NR_DG_POS
0660 DIM P_BKTO$ OF 8,P_MKOD$ OF 1,P_BNR$ OF 5,P_TXT$ OF 20
0670 REAL P_BKR
0680 INTEGER P_DK
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 ST_KTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "ST_KTO"
0920 LET DG_POS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "DG_POS"
0930 EXEC OPENFIL(KTOIDX$,"r")
0940 EXEC OPENFIL(KONTO$,"R")
0950 EXEC OPENFIL(DG_POS$,"W")
0960 EXEC OPENFIL(ST_KTO$,"R")
0970 GET ST_KTO$,1 : KASSE_KTO$
0980 GET ST_KTO$,2 : BANK_KTO$
0990 GET ST_KTO$,3 : GIRO_KTO$
1000 CLOSE ST_KTO$
1010 ENDPROC INITIER
1020
1030 PROC FUNKTIONSMENU
1040 REPEAT
1050 EXEC OVERSKRIFT("Konteringsark",6)
1060 PRINT "<C2009>Indtastning af posteringer IP"
1070 PRINT "<C2011>Udskrivning af konteringskladde UK"
1080 PRINT "<C2013>Ret posteringer RP"
1090 PRINT "<C2015>Bogfør posteringer BP"
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 "/IP/ip/UK/uk/RP/rp/BP/bp/" THEN
1170 EXEC FEJL("Ulovlig funktionskode: '" + SVAR$(1 : 2) + "'")
1180 ENDIF
1190 UNTIL OK
1200 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
1210 CASE SVAR$(1 : 2) OF
1220 WHILE "IP","ip"
1230 IF _HØJREC > 1 AND P_BDAT$ >< SYST_DAT$ THEN
1240 PRINT "<XC1210>Du er begyndt på en ny dato siden du sidst indtastede"
1250 PRINT "<C1211>posteringer - posteringerne skal bogføres før du kan "
1260 PRINT "<C1212>indtaste flere posteringer."
1270 INPUT "<SC6523>Tryk RETURN" : SVAR$
1280 ELSE
1290 EXEC INDTAST_POSTER
1300 ENDIF
1310 WHILE "UK","uk"
1320 EXEC UDSKRIV_POSTER
1330 WHILE "RP","rp"
1340 EXEC RET_POSTER
1350 WHILE "BP","bp"
1360 IF P_DEB >< P_KRED THEN EXEC FEJL("Ulovlig bogføring - debet < > kredit ")
1370 IF _DEB = 0 AND P_KRED = 0 THEN
1380 EXEC FEJL("Ulovlig bogføring - ingen posteringer")
1390 ENDIF
1400 IF OK THEN
1410 INPUT "<SC6524>Tryk RETURN" : SVAR$
1420 ELSE
1430 LET PROGRAM$ := PRGFL$ + ":SYSBP"
1440 CHAIN PROGRAM$
1450 ENDIF
1460 OTHERWISE
1470 CHAIN PROGRAM$
1480 ENDCASE
1490 UNTIL FALSE
1500 ENDPROC FUNKTIONSMENU
1510
1520 PROC TERMINAL_IDX
1530 LET PPAR := 5 ; RESRV := 0
1540 CALL :PRES"
1550 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1560 ENDPROC TERMINAL_IDX
1570
1580 PROC OPENFIL(FNAVN$,WAY$)
1590 REPEAT
1600 IF AY$ = "W" OR WAY$ = "w" THEN
1610 OPEN FNAVN$,W
1620 ELSE
1630 OPEN FNAVN$,R
1640 ENDIF
1650 IF (FNAVN$) THEN
1660 PRINT "<SC0123>" ; CHR$ (7)
1670 IF (FNAVN$) = 6 THEN
1680 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1690 INPUT "" : SVAR$
1700 ELSE
1710 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1720 PRINT "<S>" ; FNAVN$ ; " ***"
1730 INPUT "" : SVAR$
1740 PRINT "<C0102>" ; SPC$
1750 ENDIF
1760 ENDIF
1770 UNTIL NOT ╱cd╱ (FNAVN$)
1780 ENDPROC OPENFIL
1790
1800 PROC TAL_CONTROL( REF RST$)
1810 LET J := 0 ; OK := TRUE
1820 FOR I := 1 TO (RST$) DO
1830 IF RST$(I) IN TAL$ + "." THEN LET J := J + 1 ; RST$(J) := RST$(I)
1840 NEXT I
1850 IF = 0 THEN
1860 LET OK := FALSE
1870 ELSE
1880 LET RST$ := RST$(1 : J)
1890 ENDIF
1900 ENDPROC TAL_CONTROL
1910
1920 PROC DIV_POSHOVED
1930 EXEC OVERSKRIFT("INDTASTNING AF DIVERSE POSTERINGER",4)
1940 PRINT "<C0105> BILAG TEKST MOMS KO"
1950 PRINT "<C0106> NR KODE NU"
1960 PRINT "<C0107>----------------------------------------"
1970 PRINT "<C4105>NTO- DEBET KREDIT F/R/S "
1980 PRINT "<C4106>MMER "
1990 PRINT "<C4107>----------------------------------------"
2000 ENDPROC DIV_POSHOVED
2010
2020 PROC OVERSKRIFT(ST$,L)
2030 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
2040 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
2050 PRINT SYST_DAT$(5 : 2)
2060 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
2070 PRINT "*** " ; ST$ ; " ***"
2080 ENDPROC OVERSKRIFT
2090
2100 PROC SL_FEJLLINIE
2110 LET OK := TRUE
2120 PRINT "<C0102>" ; SPC$
2130 ENDPROC SL_FEJLLINIE
2140
2150 PROC FEJL(ST$)
2160 LET OK := FALSE
2170 CURSOR 36 - ╱cb╱ (ST$) / 2,2
2180 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
2190 ENDPROC FEJL
2200
2210 PROC RET_LINIER
2220 REPEAT
2230 PRINT "<SC0123>" ; SPC$(1 : 78)
2240 LET SVAR$ := "j"
2250 EDIT "<SC1723>Ok (j) eller linienummer der skal rettes? " : SVAR$
2260 IF "/" + SVAR$ + "/" IN "/J/j/" THEN
2270 EXEC TAL_CONTROL(SVAR$)
2280 IF K THEN
2290 IF (SVAR$) < P_HØJREC AND ASC (SVAR$) > 0 THEN
2300 EXEC EDIT_LIN( ASC (SVAR$))
2310 ENDIF
2320 ENDIF
2330 ENDIF
2340 UNTIL "/" + SVAR$ + "/" IN "/J/j/"
2350 ENDPROC RET_LINIER
2360
2370 PROC LÆS_KONTO(P)
2380 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
2390 ENDPROC LÆS_KONTO
2400
2410 PROC ST_BGST( REF RST$)
2420 FOR I := 1 TO (RST$) DO
2430 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
2440 NEXT I
2450 ENDPROC ST_BGST
2460
2470 PROC INDTAST_POSTER
2480 EXEC SKRIV_LINIER
2490 LET SVAR$ := "F"
2500 WHILE SVAR$ = "F" DO
2510 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
2520 IF P_HØJREC = 1 THEN LET P_BDAT$ := SYST_DAT$ ; P_DEB,P_KRED := 0
2530 IF _HØJREC = P_MAXREC THEN
2540 EXEC FEJL("Der kan ikke indtastes flere posteringer før bogføring")
2550 INPUT "<SC6524>Tryk RETURN" : SVAR$
2560 EXEC SL_FEJLLINIE
2570 EXIT
2580 ENDIF
2590 LET P_HØJREC := P_HØJREC + 1
2600 EXEC EDIT_LIN(P_HØJREC - 1)
2610 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
2620 IF P_HØJREC - 1) MOD 12 = 0 AND SVAR$ = "F" THEN
2630 EXEC RET_LINIER
2640 EXEC DIV_POSHOVED
2650 LET SVAR$ := "F"
2660 ENDIF
2670 ENDWHILE
2680 EXEC RET_LINIER
2690 ENDPROC INDTAST_POSTER
2700
2710 PROC SKRIV_LINIER
2720 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
2730 EXEC DIV_POSHOVED
2740 FOR I := P_HØJREC - (P_HØJREC - 1) MOD 12 TO _HØJREC - 1 DO
2750 IF > 0 THEN
2760 EXEC LÆS_DG_POS(I)
2770 EXEC SKRIV_LIN(I)
2780 ENDIF
2790 NEXT I
2800 ENDPROC SKRIV_LINIER
2810
2820 PROC SKRIV_DG_POS(P)
2830 PUT DG_POS$,P + 1 : P_BKTO$,P_MKOD$,P_BNR$,P_TXT$,P_BKR,P_DK
2840 ENDPROC SKRIV_DG_POS
2850
2860 PROC LÆS_DG_POS(P)
2870 GET DG_POS$,P + 1 : P_BKTO$,P_MKOD$,P_BNR$,P_TXT$,P_BKR,P_DK
2880 ENDPROC LÆS_DG_POS
2890
2900 PROC SKRIV_LIN(R_LIN)
2910 IF P_BNR$ = "*****" THEN EXIT
2920 LET R_SLIN := R_LIN MOD 12 + 7
2930 IF R_SLIN = 7 THEN LET R_SLIN := 12 + R_SLIN
2940 CURSOR 1,R_SLIN
2950 PRINT CHR$ (R_LIN,2)
2960 CURSOR 4,R_SLIN
2970 PRINT P_BNR$
2980 CURSOR 11,R_SLIN
2990 PRINT P_TXT$
3000 CURSOR 34,R_SLIN
3010 PRINT P_MKOD$
3020 CURSOR 39,R_SLIN
3030 PRINT P_BKTO$
3040 IF _DK = DEBET THEN
3050 CURSOR 49,R_SLIN
3060 ELSE
3070 CURSOR 61,R_SLIN
3080 ENDIF
3090 PRINT CHR$ (P_BKR,7,2)
3100 ENDPROC SKRIV_LIN
3110
3120 PROC EDIT_LIN(R_LIN)
3130 LET R_SLIN := R_LIN MOD 12 + 7
3140 IF R_SLIN = 7 THEN LET R_SLIN := R_SLIN + 12
3150 EXEC LÆS_DG_POS(R_LIN)
3160 IF _BNR$ = "*****" THEN
3170 LET P_BNR$ := "" ; P_TXT$ := "" ; P_MKOD$ := "" ; P_BKR := 0 ; P_DK := DEBET ; P_BKTO$ := ""
3180 ENDIF
3190 IF _DK = DEBET THEN
3200 LET P_DEB := P_DEB - P_BKR
3210 ELSE
3220 LET P_KRED := P_KRED - P_BKR
3230 ENDIF
3240 REPEAT
3250 EXEC SL_FEJLLINIE
3260 CURSOR 1,R_SLIN
3270 PRINT CHR$ (R_LIN,2)
3280 REPEAT
3290 CURSOR 4,R_SLIN
3300 EDIT "" : P_BNR$
3310 EXEC SL_FEJLLINIE
3320 IF _BNR$ = "*****" OR "/" + P_BNR$ + "/" IN "/SLUT/slut/" THEN
3330 LET OK := TRUE
3340 ELSE
3350 EXEC TAL_CONTROL(P_BNR$)
3360 IF NOT OK THEN EXEC FEJL("Ulovlig bilagsnummer")
3370 ENDIF
3380 UNTIL OK
3390 CURSOR 4,R_SLIN
3400 PRINT SPC$(1 : 5)
3410 CURSOR 4,R_SLIN
3420 IF _BNR$ = "*****" OR "/" + P_BNR$ + "/" IN "/SLUT/slut/" THEN
3430 IF /" + P_BNR$ + "/" IN "/slut/SLUT/" THEN
3440 LET SVAR$ := "S" ; P_BNR$ := "*****" ; P_HØJREC := P_HØJREC - 1
3450 ENDIF
3460 PRINT SPC$(1 : 76)
3470 EXIT
3480 ELSE
3490 PRINT P_BNR$
3500 ENDIF
3510 CURSOR 11,R_SLIN
3520 EDIT "" : P_TXT$
3530 REPEAT
3540 CURSOR 34,R_SLIN
3550 EDIT "" : P_MKOD$
3560 EXEC SL_FEJLLINIE
3570 EXEC ST_BGST(P_MKOD$)
3580 IF P_MKOD$ IN "IU " THEN
3590 EXEC FEJL("Ulovlig momskode: '" + P_MKOD$ + "'")
3600 ENDIF
3610 UNTIL OK
3540 REPEAT
3550 CURSOR 39,R_SLIN
3560 EDIT "" : P_BKTO$
3570 EXEC SL_FEJLLINIE
3580 LET IDXPOS := FIND_KTO(P_BKTO$)
3590 IF K THEN
3600 EXEC LÆS_KONTO(RECNR)
3610 IF TO_TYPE$ >< "A" THEN
3620 EXEC FEJL("Ulovlig kontonr - kontotype < > 'A'")
3630 ELSE
3720 IF _BKTO$ + "/" IN KASSE_KTO$ + "/" + BANK_KTO$ + "/" + GIRO_KTO$ + "/" THEN
3730 EXEC FEJL("Ulovlig kontonr - konto = kasse/bank/giro")
3740 ELSE
3640 PRINT "<C0102>" ; TAB(35 - ╱cb╱ (KTO_NAVN$) / 2) ; "Konto: " ; KTO_NAVN$
3760 ENDIF
3650 ENDIF
3660 ELSE
3670 EXEC FEJL("Ulovlig kontonr - konto findes ikke")
3680 ENDIF
3690 UNTIL OK
3700 REPEAT
3710 LET SVAR$ := CHR$ (P_BKR,7,2)
3720 IF P_BKR = 0 THEN LET SVAR$ := ""
3730 IF _DK = KREDIT THEN
3740 CURSOR 61,R_SLIN
3750 EDIT "" : SVAR$
3760 EXEC SL_FEJLLINIE
3770 EXEC TAL_CONTROL(SVAR$)
3780 IF NOT "." IN SVAR$ THEN LET SVAR$ := SVAR$ + "."
3790 LET P_BKR := INT(100 * ASC ("0" + SVAR$) + 0.5) / 100
3800 CURSOR 61,R_SLIN
3810 IF _BKR > 0 THEN
3820 PRINT CHR$ (P_BKR,7,2)
3830 ELSE
3840 PRINT SPC$(1 : 10)
3850 ENDIF
3860 ELSE
3870 LET P_DK := DEBET
3880 CURSOR 49,R_SLIN
3890 EDIT "" : SVAR$
3900 EXEC SL_FEJLLINIE
3910 EXEC TAL_CONTROL(SVAR$)
3920 IF NOT "." IN SVAR$ THEN LET SVAR$ := SVAR$ + "."
3930 LET P_BKR := INT(100 * ASC ("0" + SVAR$) + .5) / 100
3940 CURSOR 49,R_SLIN
3950 IF _BKR > 0 THEN
3960 PRINT CHR$ (P_BKR,7,2)
3970 ELSE
3980 PRINT SPC$(1 : 10)
3990 ENDIF
4000 ENDIF
4010 IF P_BKR =< 0 THEN LET P_DK := P_DK * ( - 1)
4020 UNTIL P_BKR > 0
4030 REPEAT
4040 LET SVAR$ := "f"
4050 CURSOR 77,R_SLIN
4060 EDIT "" : SVAR$(1)
4070 EXEC ST_BGST(SVAR$)
4080 UNTIL "/" + SVAR$ + "/" IN "/F/S/R/"
4090 UNTIL SVAR$ IN "FS"
4100 IF _DK = DEBET THEN
4110 LET P_DEB := P_DEB + P_BKR
4120 ELSE
4130 LET P_KRED := P_KRED + P_BKR
4140 ENDIF
4150 EXEC SKRIV_DIFF
4160 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
4170 EXEC SKRIV_DG_POS(R_LIN)
4180 EXEC SL_FEJLLINIE
4190 ENDPROC EDIT_LIN
4200
4210 PROC SKRIV_DIFF
4220 PRINT "<SC0120>" ; SPC$
4230 PRINT "<SC0121>" ; SPC$
4240 PRINT "<SC2220>Debet/kredit total " ; CHR$ (P_DEB,9,2)
4250 PRINT CHR$ (P_KRED,9,2)
4260 IF _DEB < P_KRED THEN
4270 PRINT "<SC2221>Difference " ; CHR$ (P_KRED - P_DEB,9,2)
4280 ELSE
4290 IF _KRED < P_DEB THEN
4300 PRINT "<SC2221>Difference"
4310 PRINT "<SC5921>" ; CHR$ (P_DEB - P_KRED,9,2)
4320 ENDIF
4330 ENDIF
4340 ENDPROC SKRIV_DIFF
4350
4360 PROC RET_POSTER
4370 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
4380 LET K := 0
4390 WHILE K < P_HØJREC - 1 DO
4400 IF (K + 12) MOD 12 = 0 THEN EXEC DIV_POSHOVED
4410 LET K := K + 1
4420 EXEC LÆS_DG_POS(K)
4430 EXEC SKRIV_LIN(K)
4440 IF K MOD 12 = 0 OR K = P_HØJREC - 1 THEN EXEC RET_LINIER
4450 ENDWHILE
4460 ENDPROC RET_POSTER
4470
4480 PROC UDSKRIV_POSTER
4490 EXEC OVERSKRIFT("Udskrivning af konteringskladde",7)
4620 EXEC PRINTRES("smal EDB-liste",12)
4510 LET LIN_T := 100 ; MAX_LIN := 72
4520 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
4530 LET P_DEB,P_KRED := 0
4540 FOR J := 1 TO _HØJREC - 1 DO
4550 EXEC LÆS_DG_POS(J)
4560 EXEC PRINT_LIN
4570 NEXT J
4580 IF LIN_T >< 100 THEN EXEC AFSLUT
4590 EXEC PRINTREL
4600 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
4610 ENDPROC UDSKRIV_POSTER
4620
4630 PROC SIDESKIFT
4640 FOR I := LIN_T TO AX_LIN DO PRINT
4650 LET LIN_T := 9
4660 PRINT "*** " ; SYST_NAVN$ ; " ***"
4670 PRINT
4680 PRINT "Firmanavn: " ; FIRMANAVN$
4690 PRINT
4700 PRINT "<S>*** KONTERINGSKLADDE PR. " ; P_BDAT$(1 : 2) ; "." ; P_BDAT$(3 : 2) ; "."
4710 PRINT "<S>" ; P_BDAT$(5 : 2) ; " **** UDSKREVET PR. "
4720 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
4730 PRINT
4860 PRINT "<S>BILAG TEKST MK KONTONR DEBET "
4870 PRINT " KREDIT "
4880 PRINT "<S>----- -------------------- -- -------- ----------"
4890 PRINT " ----------"
4900 IF _DEB > 0 OR P_KRED > 0 THEN
4910 PRINT TAB(8) ; "TRANSPORT" ; TAB(41) ; CHR$ (P_DEB,9,2) ; CHR$ (P_KRED,9,2)
4920 LET LIN_T := LIN_T + 1
4930 ENDIF
4940 ENDPROC SIDESKIFT
4950
4960 PROC PRINT_LIN
4970 IF P_BNR$ = "*****" THEN EXIT
4980 IF IN_T + 5 > MAX_LIN THEN
4990 IF _DEB > 0 OR P_KRED > 0 THEN
5000 PRINT "<S>----- -------------------- -- -------- ---------- "
4890 PRINT "----------"
4900 PRINT TAB(9) ; "TRANSPORT" ; TAB(41) ; CHR$ (P_DEB,9,2) ; CHR$ (P_KRED,9,2)
4910 LET LIN_T := LIN_T + 2
4920 ENDIF
4930 EXEC SIDESKIFT
4940 ENDIF
4950 LET LIN_T := LIN_T + 1
4960 PRINT "<S>" ; P_BNR$ ; TAB(11) ; P_TXT$ ; TAB(33) ; P_MKOD$ ; TAB(37)
4970 PRINT "<S>" ; P_BKTO$ ; TAB(14)
4980 IF _DK = DEBET THEN
4990 PRINT CHR$ (P_BKR,7,2)
5000 LET P_DEB := P_DEB + P_BKR
5010 ELSE
5020 PRINT TAB(13) ; CHR$ (P_BKR,7,2)
5030 LET P_KRED := P_KRED + P_BKR
5040 ENDIF
5050 ENDPROC PRINT_LIN
5060
5070 PROC AFSLUT
5080 LET LIN_T := LIN_T + 2
5210 PRINT "<S>----- -------------------- -- -------- ---------- "
5100 PRINT "----------"
5110 PRINT TAB(8) ; "DEBET/KREDIT TOTAL" ; TAB(42) ; CHR$ (P_DEB,9,2) ;
5120 PRINT CHR$ (P_KRED,9,2)
5130 IF _DEB > P_KRED THEN
5140 PRINT TAB(11) ; "DIFFERENCE" ; TAB(42) ; CHR$ (P_DEB - P_KRED,9,2)
5150 LET LIN_T := LIN_T + 1
5160 ELSE
5170 IF _KRED > P_DEB THEN
5180 PRINT TAB(11) ; "DIFFERENCE" ; TAB(54) ; CHR$ (P_KRED - P_DEB,9,2)
5190 LET LIN_T := LIN_T + 1
5200 ENDIF
5210 ENDIF
5220 FOR I := LIN_T TO AX_LIN DO PRINT
5230 ENDPROC AFSLUT
5240
5250 PROC FIND_KTO( REF R_KTONR$)
5260 LET OK := FALSE
5270 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
5280 LET LOW := 1 ; HIGH := I_HØJREC ; POS := 2
5290 IF IGH > 1 THEN
5300 REPEAT
5310 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
5320 GET KTOIDX$,POS : KTONR$,RECNR
5330 IF TONR$ > R_KTONR$ THEN
5340 LET HIGH := POS
5350 ELSE
5360 IF TONR$ < R_KTONR$ THEN
5370 LET LOW := POS
5380 ENDIF
5390 ENDIF
5400 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
5410 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
5420 GET KTOIDX$,POS : KTONR$,RECNR
5430 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
5440 ENDIF
5450 LET FIND_KTO := POS
5460 ENDPROC FIND_KTO
5470 //
5600 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
5610 LET PRTNR$ := "1" ; OK := TRUE
5620 REPEAT
5630 CURSOR 15,LINE
5640 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
5650 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
5660 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
5670 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
5680 INPUT "" : SVAR$
5690 SELECT OUTPUT "P" + PRTNR$
5700 IF ("P") THEN
5710 CURSOR 12,LINE
5720 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
5730 CURSOR 12,LINE + 1
5740 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
5750 IF VAR$ = "J" OR SVAR$ = "j" THEN
5760 CURSOR 12,LINE
5770 PRINT "<Z> Der ventes på at printeren bliver ledig...."
5780 PRINT "<SZ>"
5790 WHILE ╱cd╱ ("P") DO
5800 LET SEK := ╱ca╱ (5)
5810 SELECT OUTPUT "P" + PRTNR$
5820 ENDWHILE
5830 ELSE
5840 LET OK := FALSE
5850 ENDIF
5860 ENDIF
5870 CURSOR 1,LINE
5880 PRINT "<Z>"
5890 PRINT "<SZ>"
5900 ENDPROC PRINTRES
5480 //
5490 PROC PRINTREL // RELEASE PRINTER
5500 SELECT OUTPUT "T"
5510 ENDPROC PRINTREL
1940 PRINT "<C0105> BILAG TEKST KO"
1950 PRINT "<C0106> NR NU"
1960 PRINT "<C0107>----------------------------------------"
1970 PRINT "<C4105>NTO- DEBET KREDIT F/R/S "
1980 PRINT "<C4106>MMER "
1990 PRINT "<C4107>----------------------------------------"
2000 ENDPROC DIV_POSHOVED
2010
2020 PROC OVERSKRIFT(ST$,L)
2030 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
2040 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
2050 PRINT SYST_DAT$(5 : 2)
3530 LET P_MKOD$ := ""
4740 PRINT "<S>BILAG TEKST KONTONR DEBET "
4750 PRINT " KREDIT "
4760 PRINT "<S>----- ------------------------ -------- ----------"
4770 PRINT " ----------"
4780 IF _DEB > 0 OR P_KRED > 0 THEN
4790 PRINT TAB(8) ; "TRANSPORT" ; TAB(41) ; CHR$ (P_DEB,9,2) ; CHR$ (P_KRED,9,2)
4800 LET LIN_T := LIN_T + 1
4810 ENDIF
4820 ENDPROC SIDESKIFT
4830
4840 PROC PRINT_LIN
4850 IF P_BNR$ = "*****" THEN EXIT
4860 IF IN_T + 5 > MAX_LIN THEN
4870 IF _DEB > 0 OR P_KRED > 0 THEN
5000 PRINT "<S>----- -------------------- -- -------- ---------- "
4880 PRINT "<S>----- ------------------------ -------- ---------- "
5090 PRINT "<S>----- ------------------------ -------- ---------- "
4500 EXEC PRINTRES("papir",12)
1430 LET PROGRAM$ := PRGFL$ + ":SYSBP" + S_KODE$
5520 //
5530 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
5540 LET PRTNR$ := "1" ; OK := TRUE
5550 REPEAT
5560 CURSOR 15,LINE
5570 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
5580 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
5590 CURSOR 1,LINE
5600 PRINT "<Z>"
5610 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
5620 PRINT "<SZ> Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
5630 INPUT "" : SVAR$
5640 SELECT OUTPUT "P" + PRTNR$
5650 IF ("P") THEN
5660 CURSOR 12,LINE
5670 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
5680 CURSOR 12,LINE + 1
5690 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
5700 IF VAR$ = "J" OR SVAR$ = "j" THEN
5710 CURSOR 12,LINE
5720 PRINT "<Z> Der ventes på at printeren bliver ledig...."
5730 PRINT "<SZ>"
5740 WHILE ╱cd╱ ("P") DO
5750 LET SEK := ╱ca╱ (5)
5760 SELECT OUTPUT "P" + PRTNR$
5770 ENDWHILE
5780 ELSE
5790 LET OK := FALSE
5800 ENDIF
5810 ENDIF
5820 CURSOR 1,LINE
5830 PRINT "<Z>"
5840 PRINT "<SZ>"
5850 ENDPROC PRINTRES
3270 PRINT "<Z>" ; CHR$ (R_LIN,2)
4455 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS,P_DEB,P_KRED,P_BDAT$
1995 EXEC SKRIV_DIFF
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
8045 LET ÆÆ$ := ÆÆ$(1 : J)
8050 ENDPROC REMOVEBLANK