DataMuseum.dk

Presents historical artifacts from the history of:

MIKADOS

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about MIKADOS

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦69bf32e0c⟧ SPC/1-COMAL-80

    Length: 10650 (0x299a)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_08, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd, UNKNOWN_TOKEN_d4
    Names: »SYSUS.B«

Derivation

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSUS.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 UDSKRIV
0280 CHAIN PROGRAM$
0290 // =========== Procedurer starter ==============
0300 PROC DIMENSIONER
0310 // Standard variable
0320 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0330 DIM PROGRAM$ OF 17,PRTNR$ OF 1
0340 REAL RESRV,PPAR
0350 INTEGER OK,TRUE,FALSE,I,J
0360 // Hjælpevariable
0370 DIM A_KTONR$ OF 8
0380 REAL TOT(2),TOTAL(4)
0390 INTEGER IDXPOS,HIGH,LOW,KREDIT,DEBET,LIN_T,MAX_LIN,T_IDX,K,NUL,F_IDX
0400 INTEGER SIDENR
0410 // Variable til filen SYSPARA
0420 DIM SYSPARA$ OF 17
0430 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0440 DIM DATAFL$ OF 8,T_KODE$ OF 1
0450 // Variable til filen @@PARAM
0460 DIM PARAM$ OF 17
0470 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0480 REAL MOMS
0490 // Variable til filen @@KONTO
0500 DIM KONTO$ OF 17
0510 DIM ST_DATO$ OF 6
0520 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0530 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0540 REAL KTO_PRIMO,KTO_ULTIMO
0550 INTEGER KTO_FP,KTO_SP
0560 // Variable til filen @@KTOIDX
0570 DIM KTOIDX$ OF 17
0580 INTEGER I_HØJREC,I_MAXREC
0590 DIM KTONR$ OF 8
0600 INTEGER RECNR
0610 // Variable til filen @@ST_KTO
0620 DIM ST_KTO$ OF 17
0630 DIM KASSE_KTO$ OF 8,BANK_KTO$ OF 8,GIRO_KTO$ OF 8
0640 DIM K_DIFF_KTO$ OF 8,INDMOMS_KTO$ OF 8,UDMOMS_KTO$ OF 8
0650 // Variable til filen @@TRANS
0660 DIM TRANS$ OF 17
0670 INTEGER T_HØJREC,T_MAXREC
0680 DIM BKTONR$ OF 8,BDATO$ OF 6,BLGNR$ OF 5,BTXT$ OF 20
0690 REAL BMOMS,BBELØB
0700 INTEGER DK,NTRANS
0710 ENDPROC DIMENSIONER
0720
0730 PROC INITIER
0740 LET PRGFL$ := "DP2"
0750 LET PROGRAM$ := PRGFL$ + ":SYSU"
0760 LET TAL$ := "0123456789" ; NULR := 0 ; MAX_LIN := 51
0770 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0780 LET SPC$ := "                                             "
0790 LET SPC$ := SPC$ + SPC$
0800 LET FALSE := 0 ; TRUE := 1 // boolske variable
0810 LET KREDIT := - 1 ; DEBET := 1
0820 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0830 EXEC OPENFIL(SYSPARA$,"R")
0840 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0850 EXEC TERMINAL_IDX
0860 CLOSE SYSPARA$
0870 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0880 EXEC OPENFIL(PARAM$,"R")
0890 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0900 CLOSE PARAM$
0910 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
0920 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
0930 LET TRANS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "TRANS"
0940 EXEC OPENFIL(KTOIDX$,"R")
0950 EXEC OPENFIL(KONTO$,"R")
0960 EXEC OPENFIL(TRANS$,"R")
0970 ENDPROC INITIER
0980
0990 PROC TERMINAL_IDX
1000 LET PPAR := 5 ; RESRV := 0
1010 CALL :PRES"
1020 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1030 ENDPROC TERMINAL_IDX
1040
1050 PROC OPENFIL(FNAVN$,WAY$)
1060 REPEAT
1070 IF AY$ = "W" OR WAY$ = "w" THEN
1080 OPEN FNAVN$,W
1090 ELSE
1100 OPEN FNAVN$,R
1110 ENDIF
1120 IF (FNAVN$) THEN
1130 PRINT "<SC0123>" ; CHR$ (7)
1140 IF (FNAVN$) = 6 THEN
1150 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk RETURN ***"
1160 INPUT "" : SVAR$
1170 ELSE
1180 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1190 PRINT "<S>" ; FNAVN$ ; " ***"
1200 INPUT "" : SVAR$
1210 PRINT "<C0102>" ; SPC$
1220 ENDIF
1230 ENDIF
1240 UNTIL NOT ╱cd╱ (FNAVN$)
1250 ENDPROC OPENFIL
1260
1270 PROC TAL_CONTROL( REF RST$)
1280 LET J := 0 ; OK := TRUE
1290 FOR I := 1 TO (RST$) DO
1300 IF RST$(I) IN TAL$ + "." THEN LET J := J + 1 ; RST$(J) := RST$(I)
1310 NEXT I
1320 IF = 0 THEN
1330 LET OK := FALSE
1340 ELSE
1350 LET RST$ := RST$(1 : J)
1360 ENDIF
1370 ENDPROC TAL_CONTROL
1380
1390 PROC OVERSKRIFT(ST$,L)
1400 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1410 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1420 PRINT SYST_DAT$(5 : 2)
1430 CURSOR 36 - ╱cb╱ (ST$) DIV 2,L
1440 PRINT "*** " ; ST$ ; " ***"
1450 ENDPROC OVERSKRIFT
1460
1470 PROC SL_FEJLLINIE
1480 LET OK := TRUE
1490 PRINT "<C0102>" ; SPC$
1500 ENDPROC SL_FEJLLINIE
1510
1520 PROC FEJL(ST$)
1530 LET OK := FALSE
1540 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1550 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1560 ENDPROC FEJL
1570
1580 PROC LÆS_KONTO(P)
1590 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
1600 ENDPROC LÆS_KONTO
1610
1620 PROC SKRIV_KONTO(P)
1630 PUT KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
1640 ENDPROC SKRIV_KONTO
1650
1660 PROC LÆS_TRANS(P)
1670 GET TRANS$,P : BKTONR$,BDATO$,BLGNR$,BTXT$,BMOMS,BBELØB,DK,NTRANS
1680 ENDPROC LÆS_TRANS
1690
1700 PROC ST_BGST( REF RST$)
1710 FOR I := 1 TO (RST$) DO
1720 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
1730 NEXT I
1740 ENDPROC ST_BGST
1750
1760 PROC FIND_KTO( REF R_KTONR$)
1770 LET OK := FALSE
1780 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
1790 LET LOW := 1 ; HIGH := I_HØJREC + 1 ; POS := 2
1800 IF IGH > 1 THEN
1810 REPEAT
1820 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
1830 GET KTOIDX$,POS : KTONR$,RECNR
1840 IF TONR$ > R_KTONR$ THEN
1850 LET HIGH := POS
1860 ELSE
1870 IF TONR$ < R_KTONR$ THEN
1880 LET LOW := POS
1890 ENDIF
1900 ENDIF
1910 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
1920 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
1930 ENDIF
1940 LET FIND_KTO := POS
1950 ENDPROC FIND_KTO
1960
2230 PROC UDSKRIV
2240 REPEAT
2250 EXEC OVERSKRIFT("Udskrivning af saldobalance",8)
2260 EXEC PRINTRES("bred EDB-liste",12)
2270 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
2280 LET LIN_T := 100 ; SIDENR := 0 ; TOTAL(1),TOTAL(2),TOTAL(3),TOTAL(4) := 0
2290 FOR IDXPOS := 2 TO _HØJREC DO
2300 GET KTOIDX$,IDXPOS : KTONR$,RECNR
2050 EXEC LÆS_KONTO(RECNR)
2060 IF TO_TYPE$ = "A" THEN
2070 EXEC SAMMENTÆL
2080 EXEC SKRIV_LIN
2090 ENDIF
2100 NEXT IDXPOS
2110 IF LIN_T >< 100 THEN EXEC AFSLUT
2120 EXEC PRINTREL
2130 LET SVAR$ := "n"
2140 EDIT "<C2618>Flere udskrifter (j/n)? " : SVAR$(1)
2150 UNTIL NOT "/" + SVAR$ + "/" IN "/J/j/"
2160 ENDPROC UDSKRIV
2170
2180 PROC SIDESKIFT
2190 IF IN_T >< 100 THEN
2200 EXEC SKRIV_STREG
2210 PRINT "<S>" ; TAB(15) ; "TRANSPORT" ; TAB(54)
2220 PRINT "<S>" ; CHR$ (TOTAL(1),9,2) ; "  " ; CHR$ (TOTAL(2),9,2)
2230 PRINT "  " ; CHR$ (TOTAL(3),9,2) ; "  " ; CHR$ (TOTAL(4),9,2)
2240 LET LIN_T := LIN_T + 2
2250 EXEC NYSIDE
2260 PRINT "<S>" ; TAB(15) ; "TRANSPORT" ; TAB(54)
2270 PRINT "<S>" ; CHR$ (TOTAL(1),9,2) ; "  " ; CHR$ (TOTAL(2),9,2)
2280 PRINT "  " ; CHR$ (TOTAL(3),9,2) ; "  " ; CHR$ (TOTAL(4),9,2)
2290 LET LIN_T := LIN_T + 1
2300 ELSE
2310 EXEC NYSIDE
2320 ENDIF
2330 ENDPROC SIDESKIFT
2340
2350 PROC NYSIDE
2360 FOR I := LIN_T TO AX_LIN DO PRINT
2630 LET LIN_T := 8 ; SIDENR := SIDENR + 1
2640 PRINT "<S>*** " ; SYST_NAVN$ ; " ***" ; TAB(73)
2650 PRINT TAB(27) ; "SIDE: " ; SIDENR
2660 PRINT
2670 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(46)
2680 PRINT "<S>*** BALANCE ***" ; TAB(24) ; "*** UDSKREVET PR. "
2690 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
2700 PRINT
2710 PRINT "<S>" ; TAB(54)
2460 PRINT TAB(7) ; "R Å B A L A N C E" ; TAB(30) ; "S A L D O B A L A N C E"
2470 PRINT "<S>KONTONR.   KONTONAVN" ; TAB(54)
2480 PRINT "    DEBET         KREDIT        DEBET         KREDIT"
2490 EXEC SKRIV_STREG
2500 ENDPROC NYSIDE
2510
2520 PROC SKRIV_LIN
2530 IF LIN_T + 5 > MAX_LIN THEN EXEC SIDESKIFT
2540 LET LIN_T := LIN_T + 1
2550 PRINT "<S>" ; KTONR$ ; TAB(15) ; KTO_NAVN$ ; TAB(54)
2560 PRINT "<S>" ; CHR$ (TOT(1),9,2) ; "  " ; CHR$ (TOT(2),9,2)
2570 LET TOTAL(1) := TOTAL(1) + TOT(1) ; TOTAL(2) := TOTAL(2) + TOT(2)
2580 IF OT(1) > TOT(2) THEN
2590 PRINT "  " ; CHR$ (TOT(1) - TOT(2),9,2)
2600 LET TOTAL(3) := TOTAL(3) + TOT(1) - TOT(2)
2610 ELSE
2620 IF OT(2) > TOT(1) THEN
2630 PRINT TAB(17) ; CHR$ (TOT(2) - TOT(1),9,2)
2640 LET TOTAL(4) := TOTAL(4) + TOT(2) - TOT(1)
2650 ELSE
2660 PRINT
2670 ENDIF
2680 ENDIF
2690 ENDPROC SKRIV_LIN
2700
2710 PROC AFSLUT
2720 EXEC SKRIV_STREG
2730 PRINT "<S>" ; TAB(15) ; "BALANCE" ; TAB(54)
2740 PRINT "<S>" ; CHR$ (TOTAL(1),9,2) ; "  " ; CHR$ (TOTAL(2),9,2)
3010 PRINT "  " ; CHR$ (TOTAL(3),9,2) ; "  " ; CHR$ (TOTAL(4),9,2)
2770 LET LIN_T := LIN_T + 2
2780 FOR I := LIN_T TO AX_LIN DO PRINT
2790 ENDPROC AFSLUT
2800
2810 PROC SAMMENTÆL
2820 LET TOT(1),TOT(2) := 0
2830 LET NTRANS := KTO_FP
2840 WHILE NTRANS > 0 DO
2850 EXEC LÆS_TRANS(NTRANS)
2860 IF K = DEBET THEN
2870 LET TOT(1) := TOT(1) + BBELØB
2880 ELSE
2890 LET TOT(2) := TOT(2) + BBELØB
2900 ENDIF
2910 ENDWHILE
2920 IF TO_PRIMO > 0 THEN
2930 LET TOT(1) := TOT(1) + KTO_PRIMO
2940 ELSE
2950 LET TOT(2) := TOT(2) + ABS(KTO_PRIMO)
2960 ENDIF
2970 ENDPROC SAMMENTÆL
2980
2990 PROC SKRIV_STREG
3000 PRINT "<S>----------------------------------------"
3010 PRINT "<S>----------------------------------------"
3020 PRINT "------------------------"
3030 ENDPROC SKRIV_STREG
9900 //
9901 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
9902 LET PRTNR$ := "1" ; OK := TRUE
9903 REPEAT
9904 CURSOR 21,LINE
9905 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
9906 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
9907 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
9908 PRINT "<SZ>     Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
9909 INPUT "" : SVAR$
9910 SELECT OUTPUT "P" + PRTNR$
9911 IF ("P") THEN
9912 CURSOR 12,LINE
9913 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
9914 CURSOR 12,LINE + 1
9915 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
9916 IF VAR$ = "J" OR SVAR$ = "j" THEN
9917 CURSOR 12,LINE
9918 PRINT "<Z>     Der ventes på at printeren bliver ledig...."
9919 PRINT "<SZ>"
9920 WHILE ╱cd╱ ("P") DO
9921 LET SEK := ╱ca╱ (5)
9922 SELECT OUTPUT "P" + PRTNR$
9923 ENDWHILE
9924 ELSE
9925 LET OK := FALSE
9926 ENDIF
9927 ENDIF
9928 CURSOR 1,LINE
9929 PRINT "<Z>"
9930 PRINT "<SZ>"
9931 ENDPROC PRINTRES
3040 //
3050 PROC PRINTREL // RELEASE PRINTER
3060 SELECT OUTPUT "T"
3070 ENDPROC PRINTREL
2640 PRINT "<S>*** " ; SYST_NAVN$ ; " ***" ; TAB(73)
2640 PRINT "<SK>*** " ; SYST_NAVN$ ; " ***" ; TAB(73)
2750 PRINT "<S>  " ; CHR$ (TOTAL(3),9,2) ; "  " ; CHR$ (TOTAL(4),9,2)
3011 PRINT "<L>"
7967 ╱1f╱ ╱1f╱ MARAPDY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ R ╱00╱ ╱00╱ ╱01╱ ╱00╱ CHAIN GET ╱d4╱ ╱08╱ EXEC PRINTRES("smal EDB-liste",12)
2260 EXEC PRINTRES("EDB-liste",12)
0760 LET TAL$ := "0123456789" ; NULR := 0 ; MAX_LIN := 72
2640 PRINT "<LS>*** " ; SYST_NAVN$ ; " ***" ; TAB(68)
2650 PRINT "SIDE: " ; SIDENR
2660 PRINT
2670 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(30)
2680 PRINT "<S>*** BALANCE ***" ; TAB(16) ; "*** UDSKREVET PR. "
2430 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
2440 PRINT
2450 PRINT "<KS>" ; TAB(54)
2370 LET LIN_T := 8 ; SIDENR := SIDENR + 1
2640 PRINT "<LIS>*** " ; SYST_NAVN$ ; " ***" ; TAB(68)
1970 PROC UDSKRIV
1980 REPEAT
1990 EXEC OVERSKRIFT("Udskrivning af saldobalance",8)
2260 EXEC PRINTRES("EDB-liste",12)
2010 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
2020 LET LIN_T := 100 ; SIDENR := 0 ; TOTAL(1),TOTAL(2),TOTAL(3),TOTAL(4) := 0
2030 FOR IDXPOS := 2 TO _HØJREC DO
2040 GET KTOIDX$,IDXPOS : KTONR$,RECNR
2420 PRINT "<S>*** BALANCE PR. "
2670 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(42)
2380 PRINT "<LIS>*** " ; SYST_NAVN$ ; " ***" ; TAB(62)
2390 PRINT "SIDE: " ; SIDENR
2400 PRINT
2670 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(42)
2410 PRINT "<S>Firmanavn: " ; FIRMANAVN$ ; TAB(38)
2760 PRINT "<LI>"
2000 EXEC PRINTRES("papir",12)
9900 //
9901 PROC PRINTRES(PAGETYPE$,LINE) // PRINTER RESERVATION
9902 LET PRTNR$ := "1" ; OK := TRUE
9903 REPEAT
9904 CURSOR 15,LINE
9905 EDIT "<Z>Udskrivning på printer nr. ? (1/2/3/4) " : PRTNR$
9906 UNTIL "/" + PRTNR$ + "/" IN "/1/2/3/4/"
9907 CURSOR 1,LINE
9908 PRINT "<Z>"
9909 CURSOR (39 - ╱cb╱ (PAGETYPE$)) DIV 2,LINE
9910 PRINT "<SZ>     Monter " ; PAGETYPE$ ; " i printeren - tryk RETURN "
9911 INPUT "" : SVAR$
9912 SELECT OUTPUT "P" + PRTNR$
9913 IF ("P") THEN
9914 CURSOR 12,LINE
9915 PRINT "<SZ>Printeren er reserveret af en anden bruger,"
9916 CURSOR 12,LINE + 1
9917 INPUT "<SZ>Skal der ventes på at den bliver ledig ? (j/n) " : SVAR$
9918 IF VAR$ = "J" OR SVAR$ = "j" THEN
9919 CURSOR 12,LINE
9920 PRINT "<Z>     Der ventes på at printeren bliver ledig...."
9921 PRINT "<SZ>"
9922 WHILE ╱cd╱ ("P") DO
9923 LET SEK := ╱ca╱ (5)
9924 SELECT OUTPUT "P" + PRTNR$
9925 ENDWHILE
9926 ELSE
9927 LET OK := FALSE
9928 ENDIF
9929 ENDIF
9930 CURSOR 1,LINE
9931 PRINT "<Z>"
9932 PRINT "<SZ>"
9933 ENDPROC PRINTRES

Full view