DataMuseum.dk

top - metrics - download

    Length: 17540 (0x4484)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_05, UNKNOWN_TOKEN_06, UNKNOWN_TOKEN_08, UNKNOWN_TOKEN_0a, UNKNOWN_TOKEN_0b, UNKNOWN_TOKEN_0c, UNKNOWN_TOKEN_14, UNKNOWN_TOKEN_18, UNKNOWN_TOKEN_1b, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_c7, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd, UNKNOWN_TOKEN_d1
    Names: »SYSUKY«

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

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 FKT_MENU
00280 CHAIN PROGRAM $
00290 // ===========…Procedurer…starter…==============
00300 PROC DIMENSIONER
00310 // Standard…variable
00320 DIM SPC $ OF 80 , SVAR $ OF 10 , PRGFL $ OF 8 , ALFA $ OF 28 , TAL $ OF 10
00330 DIM PROGRAM $ OF 17 , PRTNR $ OF 1
00340 REAL RESRV , PPAR
00350 INTEGER OK , TRUE , FALSE , I , J
00360 // Hj{lpevariable
00370 DIM A_KTONR $ OF 8 , OUT_WAY $ OF 1
00380 REAL TOT ( 2 )
00390 INTEGER IDXPOS , HIGH , LOW , KREDIT , DEBET , LIN_T , MAX_LIN , T_IDX , K , NUL , F_IDX
00400 INTEGER SIDENR
00410 // Variable…til…filen…SYSPARA
00420 DIM SYSPARA $ OF 17
00430 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00440 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00450 // Variable…til…filen…@@PARAM
00460 DIM PARAM $ OF 17
00470 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00480 REAL MOMS
00490 DIM ST_DATO $ OF 6
00500 INTEGER ANT_PER , PER_NR
00510 // Variable…til…filen…@@KONTO
00520 DIM KONTO $ OF 17
00530 INTEGER N_FRIREC , N_MAXREC
00540 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00550 REAL KTO_PRIMO , KTO_ULTIMO
00560 INTEGER KTO_FP , KTO_SP
00570 // Variable…til…filen…@@KTOIDX
00580 DIM KTOIDX $ OF 17
00590 INTEGER I_H\JREC , I_MAXREC
00600 DIM KTONR $ OF 8
00610 INTEGER RECNR
00620 // Variable…til…filen…@@ST_KTO
00630 DIM ST_KTO $ OF 17
00640 DIM KASSE_KTO $ OF 8 , BANK_KTO $ OF 8 , GIRO_KTO $ OF 8
00650 DIM K_DIFF_KTO $ OF 8 , INDMOMS_KTO $ OF 8 , UDMOMS_KTO $ OF 8
00660 // Variable…til…filen…@@TRANS
00670 DIM TRANS $ OF 17
00680 INTEGER T_H\JREC , T_MAXREC
00690 DIM BKTONR $ OF 8 , BDATO $ OF 6 , BLGNR $ OF 5 , BTXT $ OF 20
00700 REAL BMOMS , BBEL\B
00710 INTEGER DK , NTRANS
00720 ENDPROC DIMENSIONER
00730
00740 PROC INITIER
00750 LET PRGFL $ := "DP2"
00760 LET PROGRAM $ := PRGFL $ + ":SYSU"
00770 LET TAL $ := "0123456789" ; NULR := 0
00780 FOR I := ╱cc╱ ( "A" ) TO ( "]" ) DO LET ALFA $ := ALFA $ + CHR$ ( I )
00790 LET SPC $ := "………………………………………………………………………………………………………………………"
00800 LET SPC $ := SPC $ + SPC $
00810 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00820 LET KREDIT := - 1 ; DEBET := 1
00830 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00840 EXEC OPENFIL ( SYSPARA $ , "R" )
00850 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00860 EXEC TERMINAL_IDX
00870 CLOSE SYSPARA $
00880 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00890 EXEC OPENFIL ( PARAM $ , "R" )
00900 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00910 GET PARAM $ , 2 : ST_DATO $ , ANT_PER , PER_NR
00920 CLOSE PARAM $
00930 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
00940 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
00950 LET ST_KTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "ST_KTO"
00960 LET TRANS $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "TRANS"
00970 EXEC OPENFIL ( KTOIDX $ , "R" )
00980 EXEC OPENFIL ( KONTO $ , "R" )
00990 EXEC OPENFIL ( TRANS $ , "R" )
01000 ENDPROC INITIER
01010
01020 PROC TERMINAL_IDX
01030 LET PPAR := 5 ; RESRV := 0
01040 CALL :PRES"
01050 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01060 ENDPROC TERMINAL_IDX
01070
01080 PROC OPENFIL ( FNAVN $ , WAY $ )
01090 REPEAT
01100 IF AY $ = "W" OR WAY $ = "w" THEN
01110 OPEN FNAVN $ , W
01120 ELSE
01130 OPEN FNAVN $ , R
01140 ENDIF
01150 IF ( FNAVN $ ) THEN
01160 PRINT "<SC0123>" ; CHR$ ( 7 )
01170 IF ( FNAVN $ ) = 6 THEN
01180 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…RETURN…***"
01190 INPUT "" : SVAR $
01200 ELSE
01210 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01220 PRINT "<S>" ; FNAVN $ ; "…***"
01230 INPUT "" : SVAR $
01240 PRINT "<C0102>" ; SPC $
01250 ENDIF
01260 ENDIF
01270 UNTIL NOT ╱cd╱ ( FNAVN $ )
01280 ENDPROC OPENFIL
01290
01300 PROC TAL_CONTROL ( REF RST $ )
01310 LET J := 0 ; OK := TRUE
01320 FOR I := 1 TO ( RST $ ) DO
01330 IF RST $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
01340 NEXT I
01350 IF = 0 THEN
01360 LET OK := FALSE
01370 ELSE
01380 LET RST $ := RST $ ( 1 : J )
01390 ENDIF
01400 ENDPROC TAL_CONTROL
01410
01420 PROC OVERSKRIFT ( ST $ , L )
01430 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01440 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01450 PRINT SYST_DAT $ ( 5 : 2 )
01460 CURSOR 34 - ╱cb╱ ( ST $ ) DIV 2 , L
01470 PRINT "***…" ; ST $ ; "…***"
01480 ENDPROC OVERSKRIFT
01490
01500 PROC SL_FEJLLINIE
01510 LET OK := TRUE
01520 PRINT "<C0102>" ; SPC $
01530 ENDPROC SL_FEJLLINIE
01540
01550 PROC FEJL ( ST $ )
01560 LET OK := FALSE
01570 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01580 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01590 ENDPROC FEJL
01600
01610 PROC L[S_KONTO ( P )
01620 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01630 ENDPROC L[S_KONTO
01640
01650 PROC SKRIV_KONTO ( P )
01660 PUT KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01670 ENDPROC SKRIV_KONTO
01680
01690 PROC L[S_TRANS ( P )
01700 GET TRANS $ , P : BKTONR $ , BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK , NTRANS
01710 ENDPROC L[S_TRANS
01720
01730 PROC ST_BGST ( REF RST $ )
01740 FOR I := 1 TO ( RST $ ) DO
01750 IF RST $ ( I ) =< "}" AND RST $ ( I ) >= "a" THEN LET RST $ ( I ) := CHR$ ( ╱cc╱ ( RST $ ( I ) ) - 32 )
01760 NEXT I
01770 ENDPROC ST_BGST
01780 PROC FKT_MENU
01790 REPEAT
01800 EXEC OVERSKRIFT ( "Udskrivning…af…kontokort" , 6 )
01810 LET A_KTONR $ := ""
01820 REPEAT
01830 EDIT "<C2810>Fra…kontonr:…" : A_KTONR $
01840 EXEC SL_FEJLLINIE
01850 LET F_IDX := FIND_KTO ( A_KTONR $ )
01860 IF NOT OK THEN EXEC FEJL ( "Kontonr…findes…ikke" )
01870 UNTIL OK
01880 LET A_KTONR $ := ""
01890 REPEAT
01900 EDIT "<C2812>Til…kontonr:…" : A_KTONR $
01910 EXEC SL_FEJLLINIE
01920 LET T_IDX := FIND_KTO ( A_KTONR $ )
01930 IF OK THEN
01940 EXEC FEJL ( "Kontonr…findes…ikke" )
01950 ELSE
01960 IF T_IDX < F_IDX THEN EXEC FEJL ( "Fra…kontonr…>…Til…kontonr" )
01970 ENDIF
01980 UNTIL OK
01990 LET OUT_WAY $ := "P"
02000 REPEAT
02010 EDIT "<SC1814>Udskrift…p}…(P)rinter…eller…(S)k{rm?…" : OUT_WAY $
02020 EXEC SL_FEJLLINIE
02030 EXEC ST_BGST ( OUT_WAY $ )
02040 IF "/" + OUT_WAY $ + "/" IN "/S/P/" THEN
02050 EXEC FEJL ( "Ukendt…svar:…'" + OUT_WAY $ + "'" )
02060 ENDIF
02070 UNTIL OK
02090 EXEC UDSKRIV
02100 CLEAR
02110 LET SVAR $ := "n"
02120 EDIT "<C2012>Udskrivning…af…flere…kontokort…(j/n)?…" : SVAR $ ( 1 )
02130 UNTIL NOT "/" + SVAR $ + "/" IN "/J/j/"
02140 ENDPROC FKT_MENU
02150
02160 PROC UDSKRIV
02170 IF UT_WAY $ = "P" THEN
02170 EXEC PRINTRES ( "smal…EDB-liste" , 16 )
02190 LET MAX_LIN := 36
02200 ELSE
02210 LET MAX_LIN := 24
02220 ENDIF
02230 FOR IDXPOS := F_IDX TO _IDX DO
02240 LET SIDENR := 0 ; TOT ( 1 ) , TOT ( 2 ) := 0 ; LIN_T := 40
02250 GET KTOIDX $ , IDXPOS : KTONR $ , RECNR
02260 EXEC L[S_KONTO ( RECNR )
02270 IF TO_TYPE $ = "A" THEN
02270 LET BLGNR $ := "……" ; BTXT $ := "GAMMEL…SALDO"
02280 LET BMOMS := 0 ; DK := SGN ( KTO_PRIMO )
02300 LET KTO_PRIMO := ABS ( KTO_PRIMO )
02310 EXEC SKRIV_LIN ( ST_DATO $ , BLGNR $ , BTXT $ , BMOMS , KTO_PRIMO , DK )
02320 IF TO_FP > 0 THEN
02330 LET NTRANS := KTO_FP
02340 REPEAT
02350 EXEC L[S_TRANS ( NTRANS )
02410 EXEC SKRIV_LIN ( BDATO $ , BLGNR $ , BTXT $ , BMOMS , BBEL\B , DK )
02420 UNTIL NTRANS = 0
02430 ENDIF
02440 EXEC AFSLUT
02450 ENDIF
02460 NEXT IDXPOS
02470 IF UT_WAY $ = "P" THEN
02480 EXEC PRINTREL
02490 ELSE
02500 INPUT "<SC5023>N{ste…side…-…tryk…RETURN" : SVAR $ ( 1 )
02510 ENDIF
02520 ENDPROC UDSKRIV
02530
02480 PROC SIDESKIFT
02490 IF OT ( 1 ) > 0 OR TOT ( 2 ) > 0 THEN
02500 PRINT "<S>---------------------------------------"
02510 PRINT "---------------------------------------"
02520 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02530 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02540 LET LIN_T := LIN_T + 2
02550 EXEC NYSIDE
02560 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02570 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02580 LET LIN_T := LIN_T + 1
02590 ELSE
02600 EXEC NYSIDE
02610 ENDIF
02620 ENDPROC SIDESKIFT
02630 PROC NYSIDE
02640 IF UT_WAY $ = "P" THEN
02650 FOR I := LIN_T TO AX_LIN DO PRINT
02660 ELSE
02670 INPUT "<SC5523>N{ste…side…-…tryk…RETURN" : SVAR $
02680 CLEAR
02690 ENDIF
02700 LET LIN_T := 9 ; SIDENR := SIDENR + 1
02710 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 41 ) ;
02720 PRINT "***…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02730 PRINT SYST_DAT $ ( 5 : 2 ) ; "…***…SIDE:…" ; SIDENR
02740 PRINT
02750 PRINT "Firmanavn:…" ; FIRMANAVN $ ; TAB ( 54 ) ; "**…KONTOKORT…**"
02760 PRINT
02770 PRINT "**…KONTONR:…" ; KTONR $ ; TAB ( 25 ) ; "KONTONAVN:…" ; KTO_NAVN $ ; TAB ( 77 ) ; "**"
02780 PRINT "<S>---------------------------------------"
02790 PRINT "---------------------------------------"
02800 PRINT "<S>……DATO…………BILAG……TEKST" ; TAB ( 47 ) ; "MOMSBEL\B………DEBETBEL\B"
02810 PRINT "……KREDITBEL\B"
02820 PRINT "<S>---------------------------------------"
02830 PRINT "---------------------------------------"
02840 ENDPROC NYSIDE
02850
02860 PROC SKRIV_LIN ( Q_D $ , Q_B $ , Q_T $ , Q_M , Q_K , Q_DK )
02870 IF LIN_T + 6 > MAX_LIN THEN EXEC SIDESKIFT
02880 LET LIN_T := LIN_T + 1
02890 PRINT Q_D $ ( 1 : 2 ) ; "." ; Q_D $ ( 3 : 2 ) ; "." ; Q_D $ ( 5 : 2 ) ; TAB ( 11 ) ;
02900 PRINT Q_B $ ; TAB ( 11 ) ; Q_B $ ; TAB ( 18 ) ; Q_T $ ; TAB ( 41 ) ;
02910 IF Q_M > 0 THEN PRINT CHR$ ( Q_M , 9 , 2 ) ;
02920 IF _DK = DEBET THEN
02930 PRINT TAB ( 54 ) ; CHR$ ( Q_K , 9 , 2 ) ;
02940 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02950 ELSE
02960 PRINT TAB ( 67 ) ; CHR$ ( Q_K , 9 , 2 ) ;
02970 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02980 ENDIF
02990 PRINT
03000 ENDPROC SKRIV_LIN
03010
03020 PROC AFSLUT
03030 FOR I := LIN_T TO AX_LIN - 6 DO PRINT
03040 LET LIN_T := MAX_LIN - 5
03050 PRINT "<S>---------------------------------------"
03060 PRINT "---------------------------------------"
03070 PRINT TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ; CHR$ ( TOT ( 2 ) , 9 , 2 )
03080 PRINT TAB ( 18 ) ; "NY…SALDO…………" ;
03090 IF OT ( 1 ) - TOT ( 2 ) > 0 THEN
03100 PRINT TAB ( 67 ) ; CHR$ ( TOT ( 1 ) - TOT ( 2 ) , 9 , 2 )
03110 LET TOT ( 2 ) := TOT ( 1 )
03120 ELSE
03130 PRINT TAB ( 54 ) ; CHR$ ( TOT ( 2 ) - TOT ( 1 ) , 9 , 2 )
03140 LET TOT ( 1 ) := TOT ( 2 )
03150 ENDIF
03160 PRINT TAB ( 18 ) ; "BALANCE" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; "…" ; CHR$ ( TOT ( 1 ) , 9 , 2 )
03170 IF UT_WAY $ = "P" THEN
03180 PRINT
03190 PRINT
03200 ENDIF
03210 ENDPROC AFSLUT
03220 PROC FIND_KTO ( REF R_KTONR $ )
03230 LET OK := FALSE
03240 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
03250 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
03260 IF IGH > 1 THEN
03270 REPEAT
03280 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
03290 GET KTOIDX $ , POS : KTONR $ , RECNR
03300 IF TONR $ > R_KTONR $ THEN
03270 LET HIGH := POS
03280 ELSE
03290 IF TONR $ < R_KTONR $ THEN
03300 LET LOW := POS
03310 ENDIF
03320 ENDIF
03330 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
03340 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
03350 GET KTOIDX $ , POS : KTONR $ , RECNR
03360 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
03370 ENDIF
03380 LET FIND_KTO := POS
03390 ENDPROC FIND_KTO
03400 //
03410 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
03420 LET PRTNR $ := "1" ; OK := TRUE
03430 REPEAT
03440 CURSOR 15 , LINE
03450 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
03460 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
03490 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
03500 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
03510 INPUT "" : SVAR $
03520 SELECT OUTPUT "P" + PRTNR $
03530 IF ( "P" ) THEN
03540 CURSOR 12 , LINE
03550 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
03560 CURSOR 12 , LINE + 1
03570 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
03580 IF VAR $ = "J" OR SVAR $ = "j" THEN
03590 CURSOR 12 , LINE
03600 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
03610 PRINT "<SZ>"
03620 WHILE ╱cd╱ ( "P" ) DO
03630 LET SEK := ╱ca╱ ( 5 )
03640 SELECT OUTPUT "P" + PRTNR $
03650 ENDWHILE
03660 ELSE
03670 LET OK := FALSE
03680 ENDIF
03690 ENDIF
03700 CURSOR 1 , LINE
03710 PRINT "<Z>"
03720 PRINT "<SZ>"
03730 ENDPROC PRINTRES
03740 //
03750 PROC PRINTREL // RELEASE…PRINTER
03760 SELECT OUTPUT "T"
03770 ENDPROC PRINTREL
02270 LET BLGNR $ := "……" ; BTXT $ := "GAMMEL…SALDO" ; SUM := 0.0
02800 PRINT "<S>……DATO…………BILAG……TEKST" ; TAB ( 47 ) ; "DEBETBEL\B……KREDITBEL\B"
02810 PRINT "!………SALDO"
02930 PRINT TAB ( 42 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ; "!" ;
02940 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02950 ELSE
02960 PRINT TAB ( 55 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ; "!" ;
02970 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02980 ENDIF
02990 PRINT
02981 PRINT CHR$ ( ABS ( SUM ) , 9 , 2 ) ;
02290 LET BMOMS := 0 ; DK := SGN ( KTO_PRIMO ) ; SUM := KTO_PRIMO
02280 LET BLGNR $ := "……" ; BTXT $ := "GAMMEL…SALDO"
02360 IF K = DEBET THEN
02370 LET SUM := SUM + BBEL\B
02380 ELSE
02390 LET SUM := SUM - BBEL\B
02400 ENDIF
12594 38 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ NOT DUMMY END ╱0a╱ LET LIN_T := 9 ; SIDENR := SIDENR + 1
02710 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 42 ) ;
02720 PRINT "***…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02730 PRINT SYST_DAT $ ( 5 : 2 ) ; "…***…SIDE:…" ; SIDENR
02740 PRINT
02750 PRINT "Firmanavn:…" ; FIRMANAVN $ ; TAB ( 55 ) ; "**…KONTOKORT…**"
02760 PRINT
02770 PRINT "**…KONTONR:…" ; KTONR $ ; TAB ( 25 ) ; "KONTONAVN:…" ; KTO_NAVN $ ; TAB ( 78 ) ; "**"
02780 PRINT "<S>---------------------------------------"
02790 PRINT "----------------------------------------"
02800 PRINT "<S>……DATO…………BILAG……TEKST" ; TAB ( 47 ) ; "DEBETBEL\B……KREDITBEL\B"
02810 PRINT "…………SALDO"
02820 PRINT "<S>----------------------------------------"
02830 PRINT "---------------------------------------"
02840 ENDPROC NYSIDE
02850
02860 PROC SKRIV_LIN ( Q_D $ , Q_B $ , Q_T $ , Q_M , Q_K , Q_DK )
02870 IF LIN_T + 6 > MAX_LIN THEN EXEC SIDESKIFT
02880 LET LIN_T := LIN_T + 1
02890 PRINT Q_D $ ( 1 : 2 ) ; "." ; Q_D $ ( 3 : 2 ) ; "." ; Q_D $ ( 5 : 2 ) ; TAB ( 11 ) ;
02900 PRINT Q_B $ ; TAB ( 11 ) ; Q_B $ ; TAB ( 18 ) ; Q_T $ ; TAB ( 41 ) ;
02910 IF Q_M > 0 THEN PRINT CHR$ ( Q_M , 9 , 2 ) ;
02920 IF _DK = DEBET THEN
02930 PRINT TAB ( 42 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ; "!" ;
02940 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02950 ELSE
02960 PRINT TAB ( 55 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ; "!" ;
02970 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02980 ENDIF
02981 PRINT CHR$ ( ABS ( SUM ) , 9 , 2 ) ;
02990 PRINT
03000 ENDPROC SKRIV_LIN
03010
03020 PROC AFSLUT
03030 FOR I := LIN_T TO AX_LIN - 6 DO PRINT
03040 LET LIN_T := MAX_LIN - 5
03050 PRINT "<S>---------------------------------------"
03060 PRINT "----------------------------------------"
03070 PRINT TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 55 ) ; CHR$ ( TOT ( 2 ) , 9 , 2 )
03070 PRINT TAB ( 42 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 55 ) ; CHR$ ( TOT ( 2 ) , 9 , 2 )
02930 PRINT TAB ( 42 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
02940 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02950 ELSE
02960 PRINT TAB ( 55 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
03100 PRINT TAB ( 55 ) ; CHR$ ( TOT ( 1 ) - TOT ( 2 ) , 9 , 2 )
03130 PRINT TAB ( 42 ) ; CHR$ ( TOT ( 2 ) - TOT ( 1 ) , 9 , 2 )
03160 PRINT TAB ( 18 ) ; "BALANCE" ; TAB ( 42 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; "…" ; CHR$ ( TOT ( 1 ) , 9 , 2 )
12594 38 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ STEP ABS ELSE LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02980 ENDIF
02981 PRINT CHR$ ( ABS ( SUM ) , 10 , 2 ) ;
02540 PROC SIDESKIFT
02490 IF OT ( 1 ) > 0 OR TOT ( 2 ) > 0 THEN
02500 PRINT "<S>---------------------------------------"
02510 PRINT "---------------------------------------"
02520 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02530 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02540 LET LIN_T := LIN_T + 2
02550 EXEC NYSIDE
02560 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02570 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02580 LET LIN_T := LIN_T + 1
02590 ELSE
02600 EXEC NYSIDE
02610 ENDIF
02550 IF OT ( 1 ) > 0 OR TOT ( 2 ) > 0 THEN
02560 PRINT "<S>--------------------------------------"
02570 PRINT "---------------------------------------"
02520 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02530 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02540 LET LIN_T := LIN_T + 2
02550 EXEC NYSIDE
02560 PRINT TAB ( 18 ) ; "TRANSPORT" ; TAB ( 54 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 67 ) ;
02570 PRINT CHR$ ( TOT ( 2 ) , 9 , 2 )
02580 LET LIN_T := LIN_T + 1
02590 ELSE
02600 EXEC NYSIDE
02590 ENDIF
02610 ENDPROC SIDESKIFT
02620 PROC NYSIDE
02630 IF UT_WAY $ = "P" THEN
02640 FOR I := LIN_T TO AX_LIN DO PRINT
02650 ELSE
02660 INPUT "<SC5523>N{ste…side…-…tryk…RETURN" : SVAR $
02670 CLEAR
02680 ENDIF
02690 LET LIN_T := 9 ; SIDENR := SIDENR + 1
02710 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 42 ) ;
02700 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 41 ) ;
02710 PRINT "***…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02720 PRINT SYST_DAT $ ( 5 : 2 ) ; "…***…SIDE:…" ; SIDENR
02730 PRINT
02740 PRINT "Firmanavn:…" ; FIRMANAVN $ ; TAB ( 54 ) ; "**…KONTOKORT…**"
02750 PRINT
02760 PRINT "**…KONTONR:…" ; KTONR $ ; TAB ( 25 ) ; "KONTONAVN:…" ; KTO_NAVN $ ; TAB ( 77 ) ; "**"
02770 PRINT "<S>--------------------------------------"
02780 PRINT "----------------------------------------"
02790 PRINT "<S>……DATO…………BILAG……TEKST" ; TAB ( 47 ) ; "DEBETBEL\B……KREDITBEL\B"
02800 PRINT "…………SALDO"
02810 PRINT "<S>---------------------------------------"
02820 PRINT "---------------------------------------"
02830 ENDPROC NYSIDE
02840
02850 PROC SKRIV_LIN ( Q_D $ , Q_B $ , Q_T $ , Q_M , Q_K , Q_DK )
02870 IF LIN_T + 6 > MAX_LIN THEN EXEC SIDESKIFT
02870 LET LIN_T := LIN_T + 1
02880 PRINT Q_D $ ( 1 : 2 ) ; "." ; Q_D $ ( 3 : 2 ) ; "." ; Q_D $ ( 5 : 2 ) ; TAB ( 11 ) ;
02890 PRINT Q_B $ ; TAB ( 11 ) ; Q_B $ ; TAB ( 18 ) ; Q_T $ ; TAB ( 41 ) ;
02900 IF Q_M > 0 THEN PRINT CHR$ ( Q_M , 9 , 2 ) ;
02910 IF _DK = DEBET THEN
02920 PRINT TAB ( 42 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
02930 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02940 ELSE
02950 PRINT TAB ( 55 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
02960 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02970 ENDIF
02980 PRINT CHR$ ( ABS ( SUM ) , 9 , 2 ) ;
02990 PRINT
03000 ENDPROC SKRIV_LIN
03010
03020 PROC AFSLUT
03030 FOR I := LIN_T TO AX_LIN - 6 DO PRINT
03040 LET LIN_T := MAX_LIN - 5
03050 PRINT "<S>---------------------------------------"
03060 PRINT "---------------------------------------"
03070 PRINT TAB ( 42 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; TAB ( 55 ) ; CHR$ ( TOT ( 2 ) , 9 , 2 )
03080 PRINT TAB ( 18 ) ; "NY…SALDO…………" ;
03090 IF OT ( 1 ) - TOT ( 2 ) > 0 THEN
03100 PRINT TAB ( 55 ) ; CHR$ ( TOT ( 1 ) - TOT ( 2 ) , 9 , 2 )
03110 LET TOT ( 2 ) := TOT ( 1 )
03120 ELSE
03130 PRINT TAB ( 42 ) ; CHR$ ( TOT ( 2 ) - TOT ( 1 ) , 9 , 2 )
03140 LET TOT ( 1 ) := TOT ( 2 )
03150 ENDIF
03160 PRINT TAB ( 18 ) ; "BALANCE" ; TAB ( 42 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; "…" ; CHR$ ( TOT ( 1 ) , 9 , 2 )
03070 IF UT_WAY $ = "P" THEN
03080 PRINT
03100 PRINT
03110 ENDIF
03120 ENDPROC AFSLUT
03130 PROC FIND_KTO ( REF R_KTONR $ )
03140 LET OK := FALSE
03150 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
03160 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
03170 IF IGH > 1 THEN
03180 REPEAT
03190 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
03200 GET KTOIDX $ , POS : KTONR $ , RECNR
03260 IF TONR $ > R_KTONR $ THEN
12594 38 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ trokotnok…fa…gninvirksdU ╱00╱ ╱00╱ ╱18╱ ╱00╱ d ENDFILE NEXT ╱08╱ EXEC PRINTRES ( "papir" , 16 )
02600 EXEC NYSIDE
02580 LET LIN_T := LIN_T + 1
03040 LET LIN_T := MAX_LIN - 3
24944 p ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱0c╱ ╱d1╱ DATA 1 , LINE
03480 PRINT "<Z>"
02080 LET PNUMMER := 0
02585 LET PNUMMER := PNUMMER + 1
02635 LET PNUMMER := PNUMMER + 1
02860 IF LIN_T + 8 > MAX_LIN THEN EXEC SIDESKIFT
03030 FOR I := LIN_T TO AX_LIN - 4 DO PRINT
03090 PRINT
02981 IF UM > 0 THEN
02982 PRINT "…K" ;
02983 ELSE
02984 PRINT "…D" ;
02985 ENDIF
24944 p ╱00╱ ╱00╱ ╱05╱ ╱00╱ 922138 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ ╱1b╱ TAB OUTPUT ╱0b╱ IF UM < 0 THEN
02982 PRINT "K" ;
02983 ELSE
02984 PRINT "D" ;
02985 ENDIF
12594 38 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ READ TAB END ╱0a╱ PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 41 ) ;
02710 PRINT "***…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02700 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 39 ) ;
02700 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 39 ) ;
02710 PRINT "***…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ;
02720 PRINT SYST_DAT $ ( 5 : 2 ) ; "…***…SIDE:…" ; SIDENR
02730 PRINT
02740 PRINT "Firmanavn:…" ; FIRMANAVN $ ; TAB ( 52 ) ; "**…KONTOKORT…**"
02750 PRINT
02760 PRINT "**…KONTONR:…" ; KTONR $ ; TAB ( 25 ) ; "KONTONAVN:…" ; KTO_NAVN $ ; TAB ( 75 ) ; "**"
02770 PRINT "<S>--------------------------------------"
02780 PRINT "--------------------------------------"
02790 PRINT "<S>……DATO…………BILAG……TEKST" ; TAB ( 45 ) ; "DEBETBEL\B……KREDITBEL\B"
02800 PRINT "…………SALDO"
02810 PRINT "<S>-------------------------------------"
02820 PRINT "---------------------------------------"
02830 ENDPROC NYSIDE
02840
02850 PROC SKRIV_LIN ( Q_D $ , Q_B $ , Q_T $ , Q_M , Q_K , Q_DK )
02860 IF LIN_T + 8 > MAX_LIN THEN EXEC SIDESKIFT
02870 LET LIN_T := LIN_T + 1
02880 PRINT Q_D $ ( 1 : 2 ) ; "." ; Q_D $ ( 3 : 2 ) ; "." ; Q_D $ ( 5 : 2 ) ; TAB ( 11 ) ;
02890 PRINT Q_B $ ; TAB ( 11 ) ; Q_B $ ; TAB ( 18 ) ; Q_T $ ; TAB ( 39 ) ;
02900 IF Q_M > 0 THEN PRINT CHR$ ( Q_M , 9 , 2 ) ;
02910 IF _DK = DEBET THEN
02920 PRINT TAB ( 42 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
02930 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02940 ELSE
02950 PRINT TAB ( 55 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 67 ) ;
02960 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02970 ENDIF
02980 PRINT CHR$ ( ABS ( SUM ) , 9 , 2 ) ;
02981 IF UM < 0 THEN
02982 PRINT "…K" ;
03010 ELSE
03020 PRINT "…D" ;
03030 ENDIF
03040 PRINT
03050 ENDPROC SKRIV_LIN
03060
03070 PROC AFSLUT
03080 FOR I := LIN_T TO AX_LIN - 4 DO PRINT
03090 LET LIN_T := MAX_LIN - 3
03100 PRINT "<S>-------------------------------------"
03110 PRINT "---------------------------------------"
03120 IF UT_WAY $ = "P" THEN
03130 PRINT
03140 PRINT
03150 PRINT
03160 ENDIF
03170 ENDPROC AFSLUT
03180 PROC FIND_KTO ( REF R_KTONR $ )
03190 LET OK := FALSE
03200 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
03210 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
03220 IF IGH > 1 THEN
03230 REPEAT
03240 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
03250 GET KTOIDX $ , POS : KTONR $ , RECNR
12594 38 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ m AND h ╱0b╱ PRINT TAB ( 40 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 65 ) ;
02930 LET TOT ( 1 ) := TOT ( 1 ) + Q_K
02940 ELSE
02950 PRINT TAB ( 53 ) ; CHR$ ( Q_K , 9 , 2 ) ; TAB ( 65 ) ;
02960 LET TOT ( 2 ) := TOT ( 2 ) + Q_K
02970 ENDIF
02980 PRINT CHR$ ( ABS ( SUM ) , 9 , 2 ) ;
02990 IF UM < 0 THEN
03000 PRINT "…K" ;
24944 p ╱00╱ ╱00╱ ╱05╱ ╱00╱ 922138 ╱00╱ ╱00╱ ╱06╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ …… ╱00╱ ╱00╱ ╱05╱ ╱00╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ╱1f╱ ODLAS…LEMMAG ╱00╱ ╱00╱ ╱14╱ ╱00╱ V DIV ╱c7╱ ╱0b╱ IF UM > 0 THEN
03020 IF SUM > 0 THEN PRINT "…D" ;
38382 ╱00╱ ╱00╱