|
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: 11219 (0x2bd3)
Types: SPC/1-COMAL-80
Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
Names: »SYSP.B«
└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
└─⟦this⟧ »SYSP.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 // * *
0200 // * (C) : forlaget systime a/s *
0210 // * Klokkebakken 20, Gjellerup *
0220 // * 7400 Herning *
0230 // **************************************************
0240 EXEC DIMENSIONER
0250 EXEC INITIER
0260 EXEC MENU
0270 CHAIN PROGRAM$
0280 PROC DIMENSIONER
0290 // Standard variable
0300 DIM SPC$ OF 80,TAL$ OF 10,ALFA$ OF 28,SVAR$ OF 8,PRGFL$ OF 8
0310 DIM PROGRAM$ OF 17
0320 REAL RESRV,PPAR
0330 INTEGER OK,TRUE,FALSE,I,J
0340 // Hjælpevariable
0350 DIM A_KTONR$ OF 8
0360 INTEGER HIGH,LOW,POS,IDXPOS
0370 // Variable til filen SYSPARA
0380 DIM SYSPARA$ OF 17
0390 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0400 DIM DATAFL$ OF 8,T_KODE$ OF 1
0410 // Variable til filen @@PARAM
0420 DIM PARAM$ OF 17
0430 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 8
0440 REAL MOMS
0450 DIM ST_DATO$ OF 8
0460 INTEGER ANT_PER,PER_NR
0470 // Variable til filen @@KTOIDX
0480 DIM KTOIDX$ OF 17
0490 INTEGER I_HØJREC,I_MAXREC
0500 DIM KTONR$ OF 8
0510 INTEGER RECNR
0520 // Variable til filen @@FKTONR
0530 DIM FKTONR$ OF 17
0540 // Variable til filen @@KTOGRP
0550 DIM KTOGRP$ OF 17
0560 DIM A_KTOGRP$ OF 8
0570 // Variable til filen @@KASSE
0580 DIM KASSE$ OF 17
0590 INTEGER K_HØJREC,K_MAXREC,S_NR_KASSE
0600 // Variable til filen @@DG_POS
0610 DIM DG_POS$ OF 17
0620 INTEGER P_HØJREC,P_MAXREC,S_NR_DG_POS
0630 // Variable til filen @@DRIFTØ
0640 DIM DRIFTØ$ OF 17
0650 DIM PRIMODAT$ OF 6
0660 ENDPROC DIMENSIONER
0670
0680 PROC INITIER
0690 LET PRGFL$ := "DP2"
0700 LET PROGRAM$ := PRGFL$ + ":SYS"
0710 LET TAL$ := "1234567890"
0720 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0730 LET SPC$ := " "
0740 LET SPC$ := SPC$ + SPC$
0750 LET FALSE := 0 ; TRUE := 1 // boolske variable
0760 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0770 EXEC OPENFIL(SYSPARA$,"R")
0780 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0790 EXEC TERMINAL_IDX
0800 CLOSE SYSPARA$
0810 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0820 EXEC OPENFIL(PARAM$,"W")
0830 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0840 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
0850 LET FKTONR$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "FKTONR"
0860 LET KTOGRP$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOGRP"
0870 LET KASSE$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KASSE"
0880 LET DG_POS$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "DG_POS"
0890 LET DRIFTØ$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "DRIFTØ"
0900 EXEC OPENFIL(DRIFTØ$,"W")
0910 EXEC OPENFIL(KTOIDX$,"R")
0920 EXEC OPENFIL(FKTONR$,"W")
0930 EXEC OPENFIL(KTOGRP$,"W")
0940 EXEC OPENFIL(KASSE$,"W")
0950 EXEC OPENFIL(DG_POS$,"W")
0960 ENDPROC INITIER
0970
0980 PROC MENU
0990 EXEC OVERSKRIFT("Ændring af parameteroplysninger",4)
1000 PRINT "<C0808>1. Firmanavn"
1010 PRINT "<C0809>2. Momsprocent"
1020 PRINT "<C0810>3. Næste nummer på kasserapport"
1030 PRINT "<C0811>4. Næste nummer på konteringsliste"
1040 PRINT "<C0812>5. Startdato for regnskabsåret"
1050 PRINT "<C0813>6. Antal perioder i regnskabsåret"
1060 PRINT "<C0814>7. Nr. på nuværende regnskabsperiode"
1070 PRINT "<C0815>8. Ændring af terminalkoder m.m."
1080 PRINT "<SC0817>RETURN = Programfordeler"
1090 IF ALSE THEN
1100 PRINT "<SC0211>Kontonumre:"
1110 PRINT "<C0212>9. kasse"
1120 PRINT "<C0213>10. bank"
1130 PRINT "<C0214>11. giro"
1140 PRINT "<C0215>12. kassedifferencer"
1150 PRINT "<C0216>13. indg. moms"
1160 PRINT "<C0217>14. udg. moms"
1170 PRINT "<SC0218>15. resultatopgørelse"
1180 PRINT "<SC0219>16. balance"
1190 PRINT "<SC0220>17. første balancekonto"
1200 PRINT "<C0221>18. Årets resultat"
1210 PRINT "<C2711>Kontonumre:"
1220 PRINT "<C2712>19. Privatforbrug"
1230 PRINT "<SC2714>Kontogrupper:"
1240 PRINT "<SC2715>20. Omsætning"
1250 PRINT "<SC2716>21. Variable omkostninger"
1260 PRINT "<SC2717>22. Andre omkostninger"
1270 PRINT "<SC2718>23. Personale omkostninger"
1280 PRINT "<SC2719>24. Afskrivninger"
1290 PRINT "<SC2720>25. Finansieringsindtægter"
1300 PRINT "<SC2721>26. Finansieringsomk."
1310 PRINT "<SC5412>27. Ekstraordinære poster"
1320 PRINT "<SC5411>Kontogrupper:"
1330 PRINT "<SC5413>28. Anlægsaktiver"
1340 PRINT "<SC5414>29. Varebeholdninger"
1350 PRINT "<SC5415>30. Tilgodehavender"
1360 PRINT "<SC5416>31. Debitorer"
1370 PRINT "<SC5417>32. Likvide beh. m.v."
1380 PRINT "<SC5418>33. Egenkapital"
1390 PRINT "<SC5419>34. Hensættelser"
1400 PRINT "<SC5420>35. Gæld"
1410 PRINT "<C5421>36. Kreditorer"
1420 ENDIF
1430 REPEAT
1440 EDIT "<SC0223>Indtast linienummer " : SVAR$(1 : 2)
1450 EXEC SL_FEJLLINIE
1460 IF SVAR$ IN " " THEN EXIT
1470 IF SVAR$(1) IN TAL$ THEN
1480 EXEC FEJL("Ulovligt tegn: '" + SVAR$(1) + "'")
1490 ELSE
1500 IF SVAR$(2) IN TAL$ + " " THEN
1510 EXEC FEJL("Ulovligt tegn: '" + SVAR$(2) + "'")
1520 ENDIF
1530 ENDIF
1540 IF K THEN
1550 EXEC TAL_CONTROL(SVAR$)
1560 IF ASC (SVAR$) =< 8 THEN EXEC RET_LINIE( ASC (SVAR$))
1570 LET SVAR$ := ""
1580 ENDIF
1590 UNTIL FALSE
1600 ENDPROC MENU
1610
1620 PROC RET_LINIE(R_LIN)
1630 PRINT "<SC0123>" ; SPC$(1 : 78)
1640 CASE R_LIN OF
1650 WHILE 1
1660 LET FIRMANAVN$ := ""
1670 PRINT "<SC1623>.............................."
1680 EDIT "<SC0223>1. Firmanavn: " : FIRMANAVN$
1690 PUT PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
1700 PRINT "<SC0101>" ; SPC$(1 : 50)
1710 PRINT "<SC0101>Firmanavn: " ; FIRMANAVN$
1720 WHILE 2
1730 LET SVAR$ := CHR$ (MOMS,2,2)
1740 REPEAT
1750 PRINT "<SC0223>" ; SPC$(1 : 20)
1760 EDIT "<SC0223>2. Momsprocent: " : SVAR$
1770 EXEC SL_FEJLLINIE
1780 EXEC TAL_CONTROL(SVAR$)
1790 UNTIL OK
1800 LET MOMS := ASC (SVAR$)
1810 PUT PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
1820 WHILE 3
1830 GET KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE
1840 REPEAT
1850 LET SVAR$ := CHR$ (S_NR_KASSE,4)
1860 PRINT "<SC0223>" ; SPC$(1 : 40)
1870 EDIT "<SC0223>3. Næste nummer på kasserapport: " : SVAR$(1 : 4)
1880 EXEC SL_FEJLLINIE
1890 EXEC TAL_CONTROL(SVAR$)
1900 IF "." IN SVAR$ THEN EXEC FEJL("Ulovligt tegn: '.'")
1910 UNTIL OK
1920 LET S_NR_KASSE := ASC (SVAR$)
1930 PUT KASSE$,1 : K_HØJREC,K_MAXREC,S_NR_KASSE
1940 WHILE 4
1950 GET DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS
1960 REPEAT
1970 LET SVAR$ := CHR$ (S_NR_DG_POS,4)
1980 PRINT "<SC0223>" ; SPC$(1 : 40)
1990 EDIT "<SC0223>3. Næste nummer på konteringsliste: " : SVAR$(1 : 4)
2000 EXEC SL_FEJLLINIE
2010 EXEC TAL_CONTROL(SVAR$)
2020 IF "." IN SVAR$ THEN EXEC FEJL("Ulovligt tegn: '.'")
2030 UNTIL OK
2040 LET S_NR_DG_POS := ASC (SVAR$)
2050 PUT DG_POS$,1 : P_HØJREC,P_MAXREC,S_NR_DG_POS
2060 WHILE 5
2070 GET DRIFTØ$,1 : PRIMODAT$
2080 REPEAT
2090 EDIT "<SC0223>16. Startdato for regnskabsåret (ååmmdd): " : PRIMODAT$
2100 EXEC SL_FEJLLINIE
2110 EXEC DATO_CONTROL(PRIMODAT$)
2120 UNTIL OK
2130 PUT DRIFTØ$,1 : PRIMODAT$
2140 WHILE 6,7
2150 GET PARAM$,2 : ST_DATO$,ANT_PER,PER_NR
2160 CASE R_LIN OF
2170 WHILE 6
2180 REPEAT
2190 LET SVAR$ := CHR$ (ANT_PER,2)
2200 EDIT "<SC0223>6. Antal perioder i regnskabsåret: " : SVAR$(1 : 2)
2210 EXEC TAL_CONTROL(SVAR$)
2220 IF "." IN SVAR$ THEN EXEC FEJL("Ulovligt tegn: '.'")
2230 UNTIL OK
2240 LET ANT_PER := ASC (SVAR$)
2250 WHILE 7
2260 REPEAT
2270 LET SVAR$ := CHR$ (PER_NR,2)
2280 EDIT "<SC0223>7. Nr. på nuværende regnskabsperiode: " : SVAR$(1 : 2)
2290 EXEC TAL_CONTROL(SVAR$)
2300 IF "." IN SVAR$ THEN EXEC FEJL("Ulovligt tegn: '.'")
2310 UNTIL OK
2320 LET PER_NR := ASC (SVAR$)
2330 ENDCASE
2340 PUT PARAM$,2 : ST_DATO$,ANT_PER,PER_NR
2350 WHILE 8
2360 LET PROGRAM$ := PRGFL$ + ":SYSPTK"
2370 CHAIN PROGRAM$
2380 WHILE 9
2390 EXEC ÆNDRE_KTONR("9. Kontonummer for kasse: ",1)
2400 WHILE 10
2410 EXEC ÆNDRE_KTONR("10. Kontonummer for bank: ",2)
2420 WHILE 11
2430 EXEC ÆNDRE_KTONR("11. Kontonummer for giro: ",3)
2440 WHILE 12
2450 EXEC ÆNDRE_KTONR("12. Kontonummer for kassedifferencer: ",4)
2460 WHILE 13
2470 EXEC ÆNDRE_KTONR("13. Kontonummer for indg. moms: ",5)
2480 WHILE 14
2490 EXEC ÆNDRE_KTONR("14. Kontonummer for udg. moms: ",6)
2500 WHILE 15
2510 EXEC ÆNDRE_KTONR("15. Kontonummer for resultatopgørelse: ",7)
2520 WHILE 16
2530 EXEC ÆNDRE_KTONR("16. Kontonummer for balance: ",8)
2540 WHILE 17
2550 EXEC ÆNDRE_KTONR("17. Kontonummer for første balancekonto: ",9)
2560 WHILE 18
2570 EXEC ÆNDRE_KTONR("18. Kontonummer for årets resultat: ",10)
2580 WHILE 19
2590 EXEC ÆNDRE_KTONR("19. Kontonummer for privatforbrug: ",11)
2600 WHILE 20
2610 EXEC ÆNDRE_KTOGRP("20. Kontogruppe for omsætning: ",1)
2620 WHILE 21
2630 EXEC ÆNDRE_KTOGRP("21. Kontogruppe for variable omkostninger: ",2)
2640 WHILE 22
2650 EXEC ÆNDRE_KTOGRP("22. Kontogruppe for andre omkostninger: ",3)
2660 WHILE 23
2670 EXEC ÆNDRE_KTOGRP("23. Kontogruppe for personale omkostninger: ",4)
2680 WHILE 24
2690 EXEC ÆNDRE_KTOGRP("24. Kontogruppe for afskrivninger: ",5)
2700 WHILE 25
2710 EXEC ÆNDRE_KTOGRP("25. Kontogruppe for finansieringsindtægter: ",6)
2720 WHILE 26
2730 EXEC ÆNDRE_KTOGRP("26. Kontogruppe for finansieringsomk.: ",7)
2740 WHILE 27
2750 EXEC ÆNDRE_KTOGRP("27. Kontogruppe for ekstraordinære poster: ",8)
2760 WHILE 28
2770 EXEC ÆNDRE_KTOGRP("28. Kontogruppe for anlægsaktiver: ",9)
2780 WHILE 29
2790 EXEC ÆNDRE_KTOGRP("29. Kontogruppe for varebeholdninger: ",10)
2800 WHILE 30
2810 EXEC ÆNDRE_KTOGRP("30. Kontogruppe for tilgodehavender: ",11)
2820 WHILE 31
2830 EXEC ÆNDRE_KTOGRP("31. Kontogruppe for debitorer: ",12)
2840 WHILE 32
2850 EXEC ÆNDRE_KTOGRP("32. Kontogruppe for likvide beholdninger m.v.: ",13)
2860 WHILE 33
2870 EXEC ÆNDRE_KTOGRP("33. Kontogruppe for egenkapital: ",14)
2880 WHILE 34
2890 EXEC ÆNDRE_KTOGRP("34. Kontogruppe for hensættelser: ",15)
2900 WHILE 35
2910 EXEC ÆNDRE_KTOGRP("35. Kontogruppe for gæld: ",16)
2920 WHILE 36
2930 EXEC ÆNDRE_KTOGRP("36. Kontogruppe for kreditorer: ",17)
2940 ENDCASE
2950 PRINT "<SC0123>" ; SPC$(1 : 78)
2960 ENDPROC RET_LINIE
2970
2980 PROC OPENFIL(FNAVN$,WAY$)
2990 REPEAT
3000 IF AY$ = "W" OR WAY$ = "w" THEN
3010 OPEN FNAVN$,W
3020 ELSE
3030 OPEN FNAVN$,R
3040 ENDIF
3050 IF (FNAVN$) THEN
3060 PRINT "<SC2301>" ; CHR$ (7)
3070 IF (FNAVN$) = 6 THEN
3080 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
3090 INPUT "" : SVAR$
3100 ELSE
3110 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
3120 PRINT "<S>" ; FNAVN$ ; " ***"
3130 INPUT "" : SVAR$
3140 PRINT "<C0102>" ; SPC$
3150 ENDIF
3160 ENDIF
3170 UNTIL NOT ╱cd╱ (FNAVN$)
3180 ENDPROC OPENFIL
3190 PROC TERMINAL_IDX
3200 LET PPAR := 5 ; RESRV := 0
3210 CALL E"DDE:PRES"
3220 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
3230 ENDPROC TERMINAL_IDX
3240 PROC SL_FEJLLINIE
3250 LET OK := TRUE
3260 PRINT "<C0102>" ; SPC$
3270 ENDPROC SL_FEJLLINIE
3280
3290 PROC FEJL(ST$)
3300 LET OK := FALSE
3310 CURSOR 36 - ( ╱cb╱ (ST$) / 2),2
3320 PRINT "<S>*** " + ST$ + " ***" ; CHR$ (7)
3330 ENDPROC FEJL
3340 PROC OVERSKRIFT(ST$,L)
3350 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
3360 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
3370 PRINT SYST_DAT$(5 : 2)
3380 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
3390 PRINT "*** " ; ST$ ; " ***"
3400 ENDPROC OVERSKRIFT
3410 PROC TAL_CONTROL( REF RST$)
3420 LET J := 0 ; OK := TRUE
3430 FOR I := 1 TO (RST$) DO
3440 IF RST$(I) IN "0123456789." THEN LET J := J + 1 ; RST$(J) := RST$(I)
3450 NEXT I
3460 IF = 0 THEN
3470 LET OK := FALSE
3480 ELSE
3490 LET RST$ := RST$(1 : J)
3500 ENDIF
3510 ENDPROC TAL_CONTROL
3520
3530 PROC FIND_KTO( REF R_KTONR$)
3540 LET OK := FALSE
3550 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
3560 LET LOW := 1 ; HIGH := I_HØJREC + 1 ; POS := 2
3570 IF IGH > 1 THEN
3580 REPEAT
3590 LET POS := INT((HIGH - LOW) / 2 + .5) + LOW
3600 GET KTOIDX$,POS : KTONR$,RECNR
3610 IF TONR$ > R_KTONR$ THEN
3620 LET HIGH := POS
3630 ELSE
3640 IF TONR$ < R_KTONR$ THEN
3650 LET LOW := POS
3660 ENDIF
3670 ENDIF
3680 UNTIL HIGH - LOW =< 1 OR R_KTONR$ = KTONR$
3690 IF KTONR$ = R_KTONR$ THEN LET OK := TRUE
3700 ENDIF
3710 LET FIND_KTO := POS
3720 ENDPROC FIND_KTO
3730 PROC DATO_CONTROL( REF RST$)
3740 LET OK := TRUE
3750 IF RST$(1 : 2) < "00" OR RST$(1 : 2) > "99" THEN LET OK := FALSE
3760 IF RST$(3 : 2) < "01" OR RST$(3 : 2) > "12" THEN LET OK := FALSE
3770 IF RST$(5 : 2) < "01" OR RST$(5 : 2) > "31" THEN LET OK := FALSE
3780 IF NOT OK THEN EXEC FEJL("Ulovlig dato: '" + RST$ + "'")
3790 ENDPROC DATO_CONTROL
3800
3810 PROC ÆNDRE_KTONR(ST2$,PNR)
3820 LET A_KTONR$ := ""
3830 GET FKTONR$,PNR : A_KTONR$
3840 REPEAT
3850 PRINT "<SC0223>" ; ST2$
3860 CURSOR 2 + ╱cb╱ (ST2$),23
3870 EDIT "" : A_KTONR$
3880 EXEC SL_FEJLLINIE
3890 LET IDXPOS := FIND_KTO(A_KTONR$)
3900 IF NOT OK THEN EXEC FEJL("Konto er ikke oprettet")
3910 UNTIL OK
3920 PUT FKTONR$,PNR : A_KTONR$
3930 ENDPROC ÆNDRE_KTONR
3940
3950 PROC ÆNDRE_KTOGRP(ST2$,PNR)
3960 LET A_KTOGRP$ := ""
3970 GET KTOGRP$,PNR : A_KTOGRP$
3980 PRINT "<SC0223>" ; ST2$
3990 CURSOR 2 + ╱cb╱ (ST2$),23
4000 EDIT "" : A_KTOGRP$
4010 PUT KTOGRP$,PNR : A_KTOGRP$
4020 ENDPROC ÆNDRE_KTOGRP