DataMuseum.dk

top - metrics - download

    Length: 17427 (0x4413)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_06, UNKNOWN_TOKEN_0e, UNKNOWN_TOKEN_10, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_13, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd, UNKNOWN_TOKEN_d6
    Names: »SYSAR«

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

SPC/1 COMAL-80

00100 // **************************************************
00110 // *………………………………………………………………………………………………………………………………*
00120 // *…………………………Bogf|ringssystemet…'SYS-KAS'…………………………*
00130 // *………………………………………………vers.…1.0………………………………………………………*
00140 // *………………………………………………………………………………………………………………………………*
00150 // *…Udviklet…marts…1983…p}…en…'SPC/1'…mikrodatamat…*
00160 // *…Programsystemet…er…skrevet…i…COMAL80…vers.…1.2…*
00170 // *………………………………………………………………………………………………………………………………*
00180 // *…Udviklet…af…:…Peter…Kristensen……………………………………………*
00190 // *………………………………………Vestervang…6,…6920…Videb{k…………………*
00200 // *………………………………………………………………………………………………………………………………*
00210 // *………(C)…………………:…forlaget…systime…a/s…………………………………*
00220 // *………………………………………Klokkebakken…20,…Gjellerup…………………*
00230 // *………………………………………7400……Herning……………………………………………………*
00240 // **************************************************
00250 EXEC DIMENSIONER
00260 EXEC INITIER
00270 EXEC FUNKTIONSMENU
00280 CHAIN PROGRAM $
00290 // =============…procedurer…starter…=============
00300 PROC DIMENSIONER
00310 // Standard…variable
00320 DIM SPC $ OF 80 , TAL $ OF 10 , ALFA $ OF 28 , SVAR $ OF 12 , PRGFL $ OF 8
00330 DIM PROGRAM $ OF 17 , PRTNR $ OF 1
00340 REAL RESRV , PPAR
00350 INTEGER OK , TRUE , FALSE , I , J , K
00360 // Hj{lpevariable
00370 DIM HJ_ST $ OF 10 , A_TXT $ OF 20 , A_BNR $ OF 5 , A_KTONR $ OF 8 , NONBOOK $ OF 60
00380 DIM A_KTO_TYPE $ OF 1 , A_KTO_NAVN $ OF 40
00390 REAL A_KTO_ULTIMO , NULR , T[LLER ( 3 ) , OVERSKUD
00400 INTEGER POS , HIGH , LOW , IDXPOS , DEBET , KREDIT , NUL , KOLNR , MAX_LIN
00410 INTEGER A_NTRANS , A_KTO_SP , LIN_T , TABNR ( 2 ) , SIDENR
00420 // Variable…til…filen…SYSPARA
00430 DIM SYSPARA $ OF 17
00440 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00450 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00460 // Variable…til…filen…@@PARAM
00470 DIM PARAM $ OF 17
00480 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 8
00490 REAL MOMS
00500 DIM ST_DATO $ OF 6
00510 INTEGER ANT_PER , PER_NR
00520 // Variable…til…filen…@@TRANS
00530 DIM TRANS $ OF 17
00540 INTEGER T_H\JREC , T_MAXREC
00550 DIM BKTONR $ OF 8 , BDATO $ OF 6 , BLGNR $ OF 5 , BTXT $ OF 20
00560 REAL BMOMS , BBEL\B
00570 INTEGER NTRANS , DK
00580 // Variable…til…filen…@@DRIFT\
00590 DIM DRIFT\ $ OF 17
00600 DIM PRIMODAT $ OF 6
00610 REAL DRIFT ( 2 )
00620 // Variable…til…filen…@@KONTO
00630 DIM KONTO $ OF 17
00640 INTEGER N_FRIREC , N_MAXREC
00650 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00660 REAL KTO_PRIMO , KTO_ULTIMO
00670 INTEGER KTO_FP , KTO_SP
00680 // Variable…til…filen…@@KTOIDX
00690 DIM KTOIDX $ OF 17
00700 INTEGER I_H\JREC , I_MAXREC
00710 DIM KTONR $ OF 8
00720 INTEGER RECNR
00730 // Variable…til…filen…@@FKTONR
00740 DIM FKTONR $ OF 17
00750 DIM BAL_KTO $ OF 8 , RES_KTO $ OF 8 , BALANCE $ OF 8 , PRIVATF $ OF 8 , OVERSK $ OF 8
00760 DIM INDMOMS_KTO $ OF 8 , UDMOMS_KTO $ OF 8
00770 // Variable…til…filen…@@KTOGRP
00780 DIM KTOGRP $ OF 17
00790 DIM KREDGRP $ OF 8 , DEBGRP $ OF 8
00800 ENDPROC DIMENSIONER
00810
00820 PROC INITIER
00830 LET PRGFL $ := "DP2"
00840 LET PROGRAM $ := PRGFL $ + ":SYSA"
00850 LET TAL $ := "0123456789"
00860 FOR I := ╱cc╱ ( "A" ) TO ( "]" ) DO LET ALFA $ := ALFA $ + CHR$ ( I )
00870 LET SPC $ := "…………………………………………………………………………………………………………"
00880 LET SPC $ := SPC $ + SPC $
00890 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00900 LET DEBET := 1 ; KREDIT := - 1 ; NULR := 0
00910 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00920 EXEC OPENFIL ( SYSPARA $ , "R" )
00930 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00940 EXEC TERMINAL_IDX
00950 CLOSE SYSPARA $
00960 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00970 EXEC OPENFIL ( PARAM $ , "W" )
00980 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00990 GET PARAM $ , 2 : ST_DATO $ , ANT_PER , PER_NR
01000 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
01010 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
01020 LET TRANS $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "TRANS"
01030 LET DRIFT\ $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "DRIFT\"
01040 LET FKTONR $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "FKTONR"
01050 LET KTOGRP $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOGRP"
01060 EXEC OPENFIL ( TRANS $ , "W" )
01070 EXEC OPENFIL ( DRIFT\ $ , "W" )
01080 EXEC OPENFIL ( KTOIDX $ , "W" )
01090 EXEC OPENFIL ( KONTO $ , "W" )
01100 EXEC OPENFIL ( FKTONR $ , "R" )
01110 GET FKTONR $ , 5 : INDMOMS_KTO $
01120 GET FKTONR $ , 6 : UDMOMS_KTO $
01130 GET FKTONR $ , 7 : RES_KTO $
01140 GET FKTONR $ , 8 : BAL_KTO $
01150 GET FKTONR $ , 9 : BALANCE $
01160 GET FKTONR $ , 10 : OVERSK $
01170 GET FKTONR $ , 11 : PRIVATF $
01180 CLOSE FKTONR $
01190 LET NONBOOK $ := "/" + RES_KTO $ + "/" + BAL_KTO $ + "/"
01200 LET NONBOOK $ := NONBOOK $ + PRIVATF $ + "/" + INDMOMS_KTO $ + "/" + UDMOMS_KTO $ + "/"
01210 EXEC OPENFIL ( KTOGRP $ , "R" )
01220 GET KTOGRP $ , 12 : DEBGRP $
01230 GET KTOGRP $ , 17 : KREDGRP $
01240 CLOSE KTOGRP $
01250 ENDPROC INITIER
01260
01270 //
01280 PROC TERMINAL_IDX
01290 LET PPAR := 5 ; RESRV := 0
01300 CALL :PRES"
01310 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01320 ENDPROC TERMINAL_IDX
01330
01340 PROC OPENFIL ( FNAVN $ , WAY $ )
01350 REPEAT
01360 IF AY $ = "W" OR WAY $ = "w" THEN
01370 OPEN FNAVN $ , W
01380 ELSE
01390 OPEN FNAVN $ , R
01400 ENDIF
01410 IF ( FNAVN $ ) THEN
01420 PRINT "<S>" ; CHR$ ( 7 )
01430 IF ( FNAVN $ ) = 6 THEN
01440 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01450 INPUT "" : SVAR $
01460 ELSE
01470 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01480 PRINT "<S>" ; FNAVN $ ; "…***"
01490 INPUT "" : SVAR $
01500 PRINT "<C0102>" ; SPC $
01510 ENDIF
01520 ENDIF
01530 UNTIL NOT ╱cd╱ ( FNAVN $ )
01540 ENDPROC OPENFIL
01550
01560 PROC OVERSKRIFT ( ST $ , L )
01570 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01580 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01590 PRINT SYST_DAT $ ( 5 : 2 )
01600 CURSOR 34 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
01610 PRINT "***…" ; ST $ ; "…***"
01620 ENDPROC OVERSKRIFT
01630
01640 PROC SL_FEJLLINIE
01650 LET OK := TRUE
01660 PRINT "<C0102>" ; SPC $
01670 ENDPROC SL_FEJLLINIE
01680
01690 PROC FEJL ( ST $ )
01700 LET OK := FALSE
01710 CURSOR 36 - ( ╱cb╱ ( ST $ ) / 2 ) , 2
01720 PRINT "<S>***…" + ST $ + "…***" ; CHR$ ( 7 )
01730 ENDPROC FEJL
01740
01750 PROC SKRIV_KONTOOPL
01760 IF OPRET THEN EXEC FIND_IDXPLADS
01770 LET KTO_TYPE $ := A_KTO_TYPE $
01780 EXEC SKRIV_KONTO ( RECNR )
01790 ENDPROC SKRIV_KONTOOPL
01800
01810 PROC L[S_KONTO ( P )
01820 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01830 ENDPROC L[S_KONTO
01840
01850 PROC SKRIV_KONTO ( P )
01860 PUT KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01870 ENDPROC SKRIV_KONTO
01880
01890 PROC ST_BGST ( REF RST $ )
01900 FOR J := 1 TO ( RST $ ) DO
01910 IF "a" =< RST $ ( J ) AND RST $ ( J ) =< "}" THEN LET RST $ ( J ) := CHR$ ( ╱cc╱ ( RST $ ( J ) ) - 32 )
01920 NEXT J
01930 ENDPROC ST_BGST
01940
01950 PROC TAL_CONTROL ( REF RST $ )
01960 LET J := 0 ; OK := TRUE ; K := 0
01970 FOR I := 1 TO ( RST $ ) DO
01980 IF RST $ ( I ) IN "0123456789" THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
01990 IF RST $ ( I ) = "." AND K = 0 THEN LET J := J + 1 ; K := K + 1 ; RST $ ( J ) := RST $ ( I )
02000 NEXT I
02010 IF = 0 THEN
02020 LET OK := FALSE
02030 ELSE
02040 LET RST $ := RST $ ( 1 : J )
02050 ENDIF
02060 ENDPROC TAL_CONTROL
02070
02080 PROC FIND_KTO ( REF R_KTONR $ )
02090 LET OK := FALSE
02100 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
02110 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
02120 IF IGH > 1 THEN
02130 REPEAT
02140 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
02150 GET KTOIDX $ , POS : KTONR $ , RECNR
02160 IF TONR $ > R_KTONR $ THEN
02170 LET HIGH := POS
02180 ELSE
02190 IF TONR $ < R_KTONR $ THEN
02200 LET LOW := POS
02210 ENDIF
02220 ENDIF
02230 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
02240 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
02250 GET KTOIDX $ , POS : KTONR $ , RECNR
02260 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
02270 ENDIF
02280 LET FIND_KTO := POS
02290 ENDPROC FIND_KTO
02300
02310 PROC FREMF\R
02320 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
02330 FOR I := 2 TO _H\JREC DO
02340 GET KTOIDX $ , I : KTONR $ , RECNR
02350 EXEC L[S_KONTO ( RECNR )
02360 PRINT "<C3212>" ; KTONR $ ; SPC $ ( 1 : 10 )
02370 LET KTO_PRIMO := KTO_ULTIMO ; KTO_FP := 0 ; KTO_SP := 0
02380 EXEC SKRIV_KONTO ( RECNR )
02390 NEXT I
02400 GET TRANS $ , 1 : T_H\JREC , T_MAXREC
02410 LET T_H\JREC := 1
02420 PUT TRANS $ , 1 : T_H\JREC , T_MAXREC
02430 LET PER_NR := PER_NR + 1 ; ST_DATO $ := SYST_DAT $
02440 ENDPROC FREMF\R
02450
02460 PROC FUNKTIONSMENU
02470 IF ER_NR = 0 THEN
02480 PRINT "<XSC1212>Balancetal…skal…fremf|res…i…ny…regning…f|r…der…kan…"
02490 PRINT "afsluttes"
02500 INPUT "<SC6523>Tryk…RETURN" : SVAR $
02510 CHAIN PROGRAM $
02520 ENDIF
02530 LET SVAR $ := "j"
02540 IF NT_PER > PER_NR THEN
02550 EXEC OVERSKRIFT ( "M}nedsafslutning" , 6 )
02560 EDIT "<C1810>Er…alt…klar…til…m}nedsafslutning…(j/n)?…" : SVAR $
02570 ELSE
02580 EXEC OVERSKRIFT ( "]rsafslutning" , 6 )
02590 PRINT "<C1809>Har…du…kontrolleret…kontokortene"
02600 PRINT "<C1810>Er…datoen…=…sidste…dato…i…regnskabs}ret"
02610 PRINT "<SC1811>Er…ind-…og…udg}ende…moms…overf|rt…til…konto…for…momsaf"
02620 PRINT "regning"
02630 PRINT "<C1812>Har…du…taget…sikkerhedskopi"
02640 EDIT "<C3414>(j/n)?…" : SVAR $
02650 ENDIF
02660 IF SVAR $ IN "Jj" OR SVAR $ = "" THEN
02670 PRINT "<XC1212>G}…tilbage…og…g|r…alt…klar…til…afslutningen"
02680 INPUT "<C6523>Tryk…RETURN" : SVAR $
02690 CHAIN PROGRAM $
02700 ENDIF
02710 IF NT_PER = PER_NR THEN
02720 EXEC UDSKRIV
02730 EXEC OVERSKRIFT ( "]rsafslutning" , 6 )
02740 PRINT "<C1810>Er…regnskabet…iorden"
02750 PRINT "<C1811>Stemmer…balancen"
02760 PRINT "<C1812>Skal…regnskabsafslutningen…forts{ttes"
02770 LET SVAR $ := "j"
02780 EDIT "<C3415>(j/n)?…" : SVAR $ ( 1 )
02790 IF NOT "/" + SVAR $ + "/" IN "/j/J/" THEN CHAIN PROGRAM $
02800 PRINT "<C2916>Nu…afsluttes…der!"
02810 EXEC ]RSAFSLUT
02820 LET PER_NR := 0
02830 ELSE
02840 PRINT "<C0110>" ; SPC $
02850 PRINT "<C2910>Nu…fremf|res…der!"
02860 EXEC FREMF\R
02870 ENDIF
02880 PUT PARAM $ , 2 : ST_DATO $ , ANT_PER , PER_NR
02890 ENDPROC FUNKTIONSMENU
02900
02910 PROC ]RSAFSLUT
02920 EXEC OVERF\R_PRIVATF
02930 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
02940 FOR K := 2 TO _H\JREC DO
02950 GET KTOIDX $ , K : KTONR $ , RECNR
02960 EXEC L[S_KONTO ( RECNR )
02970 GET DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
02980 LET DRIFT ( 1 ) := DRIFT ( 2 ) ; DRIFT ( 2 ) := KTO_ULTIMO
02990 PUT DRIFT\ $ , RECNR : DRIFT ( 1 ) , DRIFT ( 2 )
03000 NEXT K
03010 FOR K := 2 TO _H\JREC DO
03020 GET KTOIDX $ , K : KTONR $ , RECNR
03030 IF KTONR $ = BALANCE $ THEN EXEC OVERF\R_RESULTAT
03040 EXEC L[S_KONTO ( RECNR )
03050 PRINT "<SC3219>" ; KTONR $ ; SPC $ ( 1 : 10 )
03060 IF "/" + KTONR $ + "/" IN NONBOOK $ AND KTO_TYPE $ = "A" THEN
03070 LET A_KTO_ULTIMO := KTO_ULTIMO ; A_KTONR $ := KTONR $
03080 LET A_TXT $ := "SALDO…FRA…" + KTONR $ ; A_BNR $ := "……" ; A_DK := SGN ( A_KTO_ULTIMO )
03090 LET A_KTO_ULTIMO := ABS ( A_KTO_ULTIMO )
03100 IF TONR $ < BALANCE $ THEN
03110 EXEC BOGF\R ( RES_KTO $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03120 LET A_DK := A_DK * ( - 1 ) ; A_TXT $ := "OVERF\RT…TIL…" + RES_KTO $
03130 ELSE
03140 EXEC BOGF\R ( BAL_KTO $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03150 LET A_DK := A_DK * ( - 1 ) ; A_TXT $ := "OVERF\RT…TIL…" + BAL_KTO $
03160 ENDIF
03170 EXEC BOGF\R ( A_KTONR $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03180 ENDIF
03190 NEXT K
03200 ENDPROC ]RSAFSLUT
03210 PROC OVERF\R_RESULTAT
03220 EXEC FIND_KTO ( RES_KTO $ )
03230 EXEC L[S_KONTO ( RECNR )
03240 LET A_TXT $ := "RESULTAT…TIL…" + OVERSK $ ; A_KTO_ULTIMO := ABS ( KTO_ULTIMO )
03250 LET A_DK := SGN ( ( - 1 ) * KTO_ULTIMO ) ; A_BNR $ := "……"
03260 EXEC BOGF\R ( RES_KTO $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03270 LET A_TXT $ := "RESULTAT…FRA…" + RES_KTO $
03280 LET A_DK := A_DK * ( - 1 ) ; A_BNR $ := "……"
03290 EXEC BOGF\R ( OVERSK $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03300 GET KTOIDX $ , K : KTONR $ , RECNR
03310 ENDPROC OVERF\R_RESULTAT
03320
03330 PROC BOGF\R ( REF Q_KTO $ , REF Q_DAT $ , REF Q_TXT $ , REF Q_M , REF Q_KR , Q_DK , QN $ )
03340 EXEC FIND_KTO ( Q_KTO $ )
03350 IF OK THEN
03360 EXEC FEJL ( "UKENDT…KONTONR:…" + Q_KTO $ )
03370 EXIT
03380 ELSE
03390 EXEC L[S_KONTO ( RECNR )
03400 IF TO_TYPE $ >< "A" THEN
03410 EXEC FEJL ( "ULOVLIG…KONTONR:…" + Q_KTO $ )
03420 EXIT
03430 ENDIF
03440 ENDIF
03450 GET TRANS $ , 1 : T_H\JREC , T_MAXREC
03460 LET T_H\JREC := T_H\JREC + 1
03470 IF TO_FP > 0 THEN
03480 EXEC L[S_TRANS ( KTO_SP )
03490 LET NTRANS := T_H\JREC
03500 EXEC SKRIV_TRANS ( KTO_SP )
03510 ELSE
03520 LET KTO_FP := T_H\JREC
03530 ENDIF
03540 LET BKTONR $ := Q_KTO $ ; BDATO $ := Q_DAT $ ; BTXT $ := Q_TXT $ ; BMOMS := Q_M ; BBEL\B := Q_KR
03550 LET DK := Q_DK ; NTRANS := NUL ; BLGNR $ := QN $
03560 EXEC SKRIV_TRANS ( T_H\JREC )
03570 LET KTO_SP := T_H\JREC
03580 IF K = DEBET THEN
03590 LET KTO_ULTIMO := KTO_ULTIMO + BBEL\B
03600 ELSE
03610 LET KTO_ULTIMO := KTO_ULTIMO - BBEL\B
03620 ENDIF
03630 EXEC SKRIV_KONTO ( RECNR )
03640 PUT TRANS $ , 1 : T_H\JREC , T_MAXREC
03650 ENDPROC BOGF\R
03660 PROC SKRIV_TRANS ( P )
03670 PUT TRANS $ , P : BKTONR $ , BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK , NTRANS
03680 ENDPROC SKRIV_TRANS
03690
03700 PROC L[S_TRANS ( P )
03710 GET TRANS $ , P : BKTONR $ , BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK , NTRANS
03720 ENDPROC L[S_TRANS
03730
03740 PROC OVERF\R_PRIVATF
03750 IF PRIVATF $ IN "************" THEN EXIT
03760 EXEC FIND_KTO ( PRIVATF $ )
03770 EXEC L[S_KONTO ( RECNR )
03780 LET A_KTO_ULTIMO := KTO_ULTIMO ; A_KTONR $ := KTONR $
03790 LET A_TXT $ := "PRIVATFORBRUG" ; A_BNR $ := "…" ; A_DK := SGN ( A_KTO_ULTIMO )
03800 LET A_KTO_ULTIMO := ABS ( A_KTO_ULTIMO )
03810 EXEC BOGF\R ( OVERSK $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03820 LET A_DK := A_DK * ( - 1 )
03830 EXEC BOGF\R ( PRIVATF $ , SYST_DAT $ , A_TXT $ , NULR , A_KTO_ULTIMO , A_DK , A_BNR $ )
03840 ENDPROC OVERF\R_PRIVATF
03850 PROC SIDESKIFT
03860 FOR I := LIN_T TO AX_LIN DO PRINT
03870 LET LIN_T := 7 ; SIDENR := SIDENR + 1
03880 PRINT "……………***…" ; SYST_NAVN $ ; "…***" ; TAB ( 63 ) ; "SIDE:…" ; SIDENR
03890 PRINT
03900 PRINT "……………Firmanavn:…" ; FIRMANAVN $
03910 PRINT
03920 IF TONR $ ( 1 ) < "1" THEN
03930 PRINT "<S>………………………***…RESULTATOPG\RELSE…FOR…PERIODEN…"
03940 PRINT "<S>" ; PRIMODAT $ ( 1 : 2 ) ; "." ; PRIMODAT $ ( 3 : 2 ) ; "." ; PRIMODAT $ ( 5 : 2 ) ; "…-…"
03950 PRINT SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…***"
03960 ELSE
03970 PRINT "<S>…………………………………………………………***…BALANCE…PR.…"
03980 PRINT SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…***"
03990 ENDIF
04000 EXEC SKRIV_STREG
04010 ENDPROC SIDESKIFT
04020
04030 PROC SKRIV_STREG
04040 PRINT "<S>……………-------------------------------------"
04050 PRINT "----------------------------"
04060 ENDPROC SKRIV_STREG
04070
04080 PROC SKRIV_LIN ( SALDO )
04090 IF LIN_T + 4 > MAX_LIN THEN EXEC SIDESKIFT
04100 LET LIN_T := LIN_T + 1 ; SALDO := SALDO * DK
04110 CASE KTO_TYPE $ OF
04120 WHILE "A"
04130 IF TONR $ < BALANCE $ THEN
04140 LET OVERSKUD := OVERSKUD + SALDO
04150 ENDIF
04160 PRINT "<S>" ; TAB ( 10 ) ; KTO_NAVN $ ; TAB ( 50 )
04170 PRINT TAB ( TABNR ( KOLNR ) ) ; CHR$ ( ABS ( SALDO ) , 9 , 2 )
04180 LET T[LLER ( 1 ) := T[LLER ( 1 ) + SALDO
04190 LET T[LLER ( 2 ) := T[LLER ( 2 ) + SALDO
04200 LET T[LLER ( 3 ) := T[LLER ( 3 ) + SALDO
04210 WHILE "B" , "C" , "D"
04220 PRINT TAB ( 6 ) ; KTO_NAVN $
04230 CASE KTO_TYPE $ OF
04240 WHILE "C"
04250 LET T[LLER ( 1 ) , T[LLER ( 2 ) := 0
04260 LET KOLNR := 2
04270 WHILE "D"
04280 LET T[LLER ( 1 ) := 0
04290 LET KOLNR := 1
04300 ENDCASE
04310 WHILE "E"
04320 PRINT TAB ( 59 ) ; "------------"
04330 WHILE "F"
04340 PRINT "<S>…………" ; KTO_NAVN $ ; TAB ( 50 )
04350 PRINT TAB ( TABNR ( 2 ) ) ; CHR$ ( ABS ( T[LLER ( KOLNR ) ) , 9 , 2 )
04360 LET T[LLER ( KOLNR ) := 0
04370 WHILE "G"
04380 PRINT "<S>…………" ; KTO_NAVN $ ; TAB ( 50 )
04390 PRINT TAB ( TABNR ( 2 ) ) ; CHR$ ( ABS ( T[LLER ( KOLNR ) ) , 9 , 2 )
04400 LET KOLNR := 2
04410 WHILE "H"
04420 PRINT "<S>" ; TAB ( 50 )
04430 PRINT TAB ( TABNR ( KOLNR ) ) ; "------------"
04440 PRINT "<S>…………" ; KTO_NAVN $ ; TAB ( 50 )
04450 PRINT TAB ( TABNR ( KOLNR ) ) ; CHR$ ( ABS ( T[LLER ( 1 ) ) , 9 , 2 )
04460 PRINT "<S>" ; TAB ( 50 )
04470 LET LIN_T := LIN_T + 1
04480 WHILE "I"
04490 PRINT "<S>" ; TAB ( 50 )
04500 PRINT TAB ( TABNR ( 2 ) ) ; "------------"
04510 PRINT "<S>……………" ; KTO_NAVN $ ; TAB ( 50 )
04520 PRINT TAB ( TABNR ( 2 ) ) ; CHR$ ( T[LLER ( 2 ) , 9 , 2 )
04530 LET LIN_T := LIN_T + 1
04540 WHILE "J"
04550 PRINT "<S>" ; TAB ( 50 )
04560 PRINT TAB ( TABNR ( 2 ) ) ; "------------"
04570 PRINT "<S>……………" ; KTO_NAVN $ ; TAB ( 50 )
04580 PRINT TAB ( TABNR ( 2 ) ) ; CHR$ ( T[LLER ( 3 ) , 9 , 2 )
04590 PRINT
04600 LET LIN_T := LIN_T + 2
04610 WHILE "K"
04620 PRINT "<S>" ; TAB ( 50 )
04630 PRINT TAB ( TABNR ( 2 ) ) ; "------------"
04640 PRINT "<S>……………" ; KTO_NAVN $ ; TAB ( 50 )
04650 PRINT TAB ( TABNR ( 2 ) ) ; CHR$ ( T[LLER ( 3 ) , 9 , 2 )
04660 PRINT "<S>" ; TAB ( 50 )
04670 PRINT TAB ( TABNR ( 2 ) ) ; "------------"
04680 LET KOLNR := 2 ; T[LLER ( 3 ) := 0 ; LIN_T := LIN_T + 2
04690 FOR I := LIN_T TO AX_LIN DO PRINT
04700 LET LIN_T := 900
04710 WHILE "L"
04720 PRINT "<S>………………" ; KTO_NAVN $ ; TAB ( 50 )
04730 PRINT TAB ( TABNR ( KOLNR ) ) ; CHR$ ( OVERSKUD , 9 , 2 )
04740 LET T[LLER ( 1 ) := T[LLER ( 1 ) + OVERSKUD
04750 LET T[LLER ( 2 ) := T[LLER ( 2 ) + OVERSKUD
04760 LET T[LLER ( 3 ) := T[LLER ( 3 ) + OVERSKUD
04770 ENDCASE
04780 ENDPROC SKRIV_LIN
04790
04800 PROC UDSKRIV
04860 GET DRIFT\ $ , 1 : PRIMODAT $
04820 EXEC PRINTRES ( "smal…EDB-liste" , 14 )
04880 LET LIN_T := 100 ; MAX_LIN := 72 ; TABNR ( 1 ) := 1 ; TABNR ( 2 ) := 13 ; KOLNR := 2
04890 LET OVERSKUD := 0
04900 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
04910 FOR K := 2 TO _H\JREC DO
04920 GET KTOIDX $ , K : KTONR $ , RECNR
04930 IF TONR $ < "1" THEN
04940 LET DK := - 1
04950 ELSE
04960 IF TONR $ < "13" THEN
04970 LET DK := 1
04980 ELSE
04990 LET DK := - 1
05000 ENDIF
05010 ENDIF
05020 EXEC L[S_KONTO ( RECNR )
04980 IF TONR $ ( 1 : ╱cb╱ ( DEBGRP $ ) ) = DEBGRP $ THEN
05050 LET A_KTO_ULTIMO := KTO_ULTIMO
05060 GET KTOIDX $ , K + 1 : KTONR $ , RECNR
05010 WHILE KTONR $ ( 1 : ╱cb╱ ( DEBGRP $ ) ) = DEBGRP $ DO
05080 EXEC L[S_KONTO ( RECNR )
05090 LET A_KTO_ULTIMO := A_KTO_ULTIMO + KTO_ULTIMO ; K := K + 1
05100 GET KTOIDX $ , K + 1 : KTONR $ , RECNR
05110 ENDWHILE
05120 LET KTO_ULTIMO := A_KTO_ULTIMO ; KTO_TYPE $ := "A"
05070 LET KTO_NAVN $ := "Varedebitorer(samlekonto)"
05080 ELSE
05090 IF TONR $ ( 1 : ╱cb╱ ( KREDGRP $ ) ) = KREDGRP $ THEN
05100 LET A_KTO_ULTIMO := KTO_ULTIMO
05110 GET KTOIDX $ , K + 1 : KTONR $ , RECNR
05120 WHILE KTONR $ ( 1 : ╱cb╱ ( KREDGRP $ ) ) = KREDGRP $ DO
05130 EXEC L[S_KONTO ( RECNR )
05140 LET A_KTO_ULTIMO := A_KTO_ULTIMO + KTO_ULTIMO ; K := K + 1
05150 GET KTOIDX $ , K + 1 : KTONR $ , RECNR
05160 ENDWHILE
05170 LET KTO_ULTIMO := A_KTO_ULTIMO ; KTO_TYPE $ := "A"
05180 LET KTO_NAVN $ := "Varekreditorer(samlekonto)"
05190 ELSE
05200 IF TONR $ = "1243" THEN
05210 LET A_KTO_TYPE $ := KTO_TYPE $ ; A_KTONR $ := KTONR $ ; A_KTO_ULTIMO := KTO_ULTIMO
05220 LET A_KTO_NAVN $ := KTO_NAVN $
05230 LET K := K + 1
05240 IF KTONR $ = PRIVATF $ THEN LET KTONR $ := "@@@@"
05250 GET KTOIDX $ , K : KTONR $ , RECNR
05260 EXEC L[S_KONTO ( RECNR )
05270 ELSE
05280 IF TONR $ = "152" THEN
05290 EXEC SKRIV_LIN ( KTO_ULTIMO )
05300 LET KTONR $ := A_KTONR $ ; KTO_ULTIMO := A_KTO_ULTIMO ; KTO_NAVN $ := A_KTO_NAVN $
05310 ENDIF
05320 ENDIF
05330 ENDIF
05340 ENDIF
05160 IF KTONR $ = PRIVATF $ THEN LET KTONR $ := "#####"
05170 IF NOT "/" + KTONR $ + "/" IN NONBOOK $ THEN EXEC SKRIV_LIN ( KTO_ULTIMO )
05180 NEXT K
05190 EXEC PRINTREL
05260 ENDPROC UDSKRIV
05270 //
09901 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
09902 LET PRTNR $ := "1" ; OK := TRUE
09903 REPEAT
09904 CURSOR 15 , LINE
09905 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
09906 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
09907 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
09908 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
09909 INPUT "" : SVAR $
09910 SELECT OUTPUT "P" + PRTNR $
09911 IF ( "P" ) THEN
09912 CURSOR 12 , LINE
09913 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
09914 CURSOR 12 , LINE + 1
09915 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
09916 IF VAR $ = "J" OR SVAR $ = "j" THEN
09917 CURSOR 12 , LINE
09918 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
09919 PRINT "<SZ>"
09920 WHILE ╱cd╱ ( "P" ) DO
09921 LET SEK := ╱ca╱ ( 5 )
09922 SELECT OUTPUT "P" + PRTNR $
09923 ENDWHILE
09924 ELSE
09925 LET OK := FALSE
09926 ENDIF
09927 ENDIF
09928 CURSOR 1 , LINE
09929 PRINT "<Z>"
09930 PRINT "<SZ>"
09931 ENDPROC PRINTRES
05280 //
05290 PROC PRINTREL // RELEASE…PRINTER
05300 SELECT OUTPUT "T"
05310 ENDPROC PRINTREL
04675 REPEAT
04675 FOR I := 1 TO BRGRP DO
05140 ENDIF
05030 FOR GN := 1 TO BRG DO
04980 IF TONR $ ( 1 : ╱cb╱ ( GRP $ ( I ) ) ) = GRP $ ( I ) THEN
05070 LET KTO_NAVN $ := GRPN $ ( I )
04801 READ GN
04802 DIM GRP $ ( GN ) OF 8 , GRPN $ ( GN ) OF 40
04830 FOR GN := 1 TO BRG DO
04840 READ GRP $ ( GN ) , GRPN $ ( GN )
04850 NEXT GN
04810 READ NBRG
04820 DIM GRP $ ( NBRG ) OF 8 , GRPN $ ( NBRG ) OF 40
05150 NEXT GN
05070 WHILE KTONR $ ( 1 : ╱cb╱ ( GRP $ ( GN ) ) ) = GRP $ ( GN ) DO
05040 IF TONR $ ( 1 : ╱cb╱ ( GRP $ ( GN ) ) ) = GRP $ ( GN ) THEN
05200 DATA 5
05382 DATA "011" , "Varesalg"
05383 DATA "021" , "Vareforbrug"
05384 DATA "1211" , "Varelager…(samlekonto)"
05385 DATA "1221" , "Varedebitorer…(samlekonto)"
05386 DATA "153" , "Varekreditorer…(samlekonto)"
05382 DATA "011" , "Varesalg…(samlekonto)"
05383 DATA "021" , "Vareforbrug…(samlekonto)"
05070 LET KTO_NAVN $ := GRPN $ ( GN )
05210 DATA "011" , "Oms{tning"
05220 DATA "021" , "Vareforbrug"
05230 DATA "1211" , "Varelager…(samlekonto)"
05240 DATA "1221" , "Varedebitorer…(samlekonto)"
05250 DATA "153" , "Varekreditorer…(samlekonto)"
05070 LET KTO_NAVN $ := GRPN $ ( GN ) ; KTONR $ := "######"
26995 l-BDE…lams ╱00╱ ╱00╱ ╱0e╱ ╱00╱ , ╱d6╱ 1 ╱10╱ SELECT OUTPUT "T"
04146 PRINT USING "##########.##……………………" : OVERSKUD ,
04147 PRINT KTONR $
04148 SELECT OUTPUT "P"
05130 LET KTO_NAVN $ := GRPN $ ( GN ) ; KTONR $ := GRP $ ( GN )
07967 ╱1f╱ ╱1f╱ MARAPAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ W ╱00╱ ╱00╱ ╱01╱ ╱00╱ ESC LN ╱06╱ ╱13╱ EXEC PRINTRES ( "papir" , 14 )
05320 //
05330 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
05340 LET PRTNR $ := "1" ; OK := TRUE
05350 REPEAT
05360 CURSOR 15 , LINE
05370 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
05380 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
05390 CURSOR 1 , LINE
05400 PRINT "<Z>"
05410 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
05420 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
05430 INPUT "" : SVAR $
05440 SELECT OUTPUT "P" + PRTNR $
05450 IF ( "P" ) THEN
05460 CURSOR 12 , LINE
05470 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
05480 CURSOR 12 , LINE + 1
05490 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
05500 IF VAR $ = "J" OR SVAR $ = "j" THEN
05510 CURSOR 12 , LINE
05520 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
05530 PRINT "<SZ>"
05540 WHILE ╱cd╱ ( "P" ) DO
05550 LET SEK := ╱ca╱ ( 5 )
05560 SELECT OUTPUT "P" + PRTNR $
05570 ENDWHILE
05580 ELSE
05590 LET OK := FALSE
05600 ENDIF
05610 ENDIF
05620 CURSOR 1 , LINE
05630 PRINT "<Z>"
05640 PRINT "<SZ>"
05650 ENDPROC PRINTRES
01152 PUT FKTONR $ , 9 : BALANCE $
01151 LET BALANCE $ := "10"
38382 ╱00╱ ╱00╱