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

⟦4b2c753fe⟧ SPC/1-COMAL-80

    Length: 6820 (0x1aa4)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSUP.B«

Derivation

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSUP.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 FKT_MENU
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,DEBET,KREDIT
0360 // Hjælpevariable
0370 DIM A_NR$ OF 8,A_TYP$ OF 1
0380 INTEGER MAX_LIN,LIN_T,SIDENR
0390 // Variable til filen SYSPARA
0400 DIM SYSPARA$ OF 17
0410 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0420 DIM DATAFL$ OF 8,T_KODE$ OF 1
0430 // Variable til filen @@PARAM
0440 DIM PARAM$ OF 17
0450 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0460 REAL MOMS
0470 // Variable til filen @@KONTO
0480 DIM KONTO$ OF 17
0490 DIM ST_DATO$ OF 6
0500 INTEGER N_FRIREC,N_MAXREC,ANT_PER,PER_NR
0510 DIM KTO_TYPE$ OF 1,KTO_NAVN$ OF 40
0520 REAL KTO_PRIMO,KTO_ULTIMO
0530 INTEGER KTO_FP,KTO_SP
0540 // Variable til filen @@KTOIDX
0550 DIM KTOIDX$ OF 17
0560 INTEGER I_HØJREC,I_MAXREC
0570 DIM KTONR$ OF 8
0580 INTEGER RECNR
0590 ENDPROC DIMENSIONER
0600
0610 PROC INITIER
0620 LET PRGFL$ := "DP2"
0630 LET PROGRAM$ := PRGFL$ + ":SYSU"
0640 LET TAL$ := "0123456789" ; NULR := 0
0650 FOR I := ╱cc╱ ("A") TO ("Å") DO LET ALFA$ := ALFA$ + CHR$ (I)
0660 LET SPC$ := "                                             "
0670 LET SPC$ := SPC$ + SPC$
0680 LET FALSE := 0 ; TRUE := 1 // boolske variable
0690 LET KREDIT := - 1 ; DEBET := 1
0700 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0710 EXEC OPENFIL(SYSPARA$,"R")
0720 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0730 EXEC TERMINAL_IDX
0740 CLOSE SYSPARA$
0750 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0760 EXEC OPENFIL(PARAM$,"R")
0770 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0780 CLOSE PARAM$
0790 LET KTOIDX$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KTOIDX"
0800 LET KONTO$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "KONTO"
0810 EXEC OPENFIL(KTOIDX$,"R")
0820 EXEC OPENFIL(KONTO$,"R")
0830 ENDPROC INITIER
0840
0850 PROC FKT_MENU
0860 REPEAT
0870 EXEC OVERSKRIFT("Udskrivning af kontoplan",7)
0880 LET A_TYP$ := "A"
0890 REPEAT
0900 // EDIT "<C2310>Udskrivning af konti med typen: ":A_TYP$
0910 EXEC SL_FEJLLINIE
0920 EXEC ST_BGST(A_TYP$)
0930 IF "/" + A_TYP$ + "/" IN "/A/B/C/D/E/F/*/" THEN
0940 EXEC FEJL("Ulovlig kontotype '" + A_TYP$ + "'")
0950 ENDIF
0960 UNTIL OK
0970 EXEC PRINTRES("smal EDB-liste",12)
0980 LET A_NR$ := "########" ; MAX_LIN := 72 ; LIN_T := 123 ; SIDENR := 0
0990 GET KTOIDX$,1 : I_HØJREC,I_MAXREC
1000 FOR K := 2 TO _HØJREC DO
1010 GET KTOIDX$,K : KTONR$,RECNR
1020 EXEC LÆS_KONTO(RECNR)
1030 IF TO_TYPE$ = A_TYP$ OR A_TYP$ = "*" THEN
1040 EXEC SKRIV_LIN(KTONR$,KTO_NAVN$,KTO_TYPE$)
1050 ENDIF
1060 NEXT K
1070 FOR I := LIN_T TO AX_LIN DO PRINT
1080 EXEC PRINTREL
1090 LET SVAR$ := "n"
1100 EDIT "<C2614>Flere udskrifter (j/n)? " : SVAR$(1)
1110 UNTIL NOT "/" + SVAR$ + "/" IN "/J/j/"
1120 ENDPROC FKT_MENU
1130
1140 PROC OPENFIL(FNAVN$,WAY$)
1150 REPEAT
1160 IF AY$ = "W" OR WAY$ = "w" THEN
1170 OPEN FNAVN$,W
1180 ELSE
1190 OPEN FNAVN$,R
1200 ENDIF
1210 IF (FNAVN$) THEN
1220 PRINT "<SC0123>" ; CHR$ (7)
1230 IF (FNAVN$) = 6 THEN
1240 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
1250 INPUT "" : SVAR$
1260 ELSE
1270 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1280 PRINT "<S>" ; FNAVN$ ; " ***"
1290 INPUT "" : SVAR$
1300 PRINT "<C0102>" ; SPC$
1310 ENDIF
1320 ENDIF
1330 UNTIL NOT ╱cd╱ (FNAVN$)
1340 ENDPROC OPENFIL
1350
1360 PROC OVERSKRIFT(ST$,L)
1370 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1380 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1390 PRINT SYST_DAT$(5 : 2)
1400 CURSOR 36 - ╱cb╱ (ST$) DIV 2,L
1410 PRINT "*** " ; ST$ ; " ***"
1420 ENDPROC OVERSKRIFT
1430
1440 PROC ST_BGST( REF RST$)
1450 FOR I := 1 TO (RST$) DO
1460 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
1470 NEXT I
1480 ENDPROC ST_BGST
1490
1500 PROC LÆS_KONTO(P)
1510 GET KONTO$,P : KTO_TYPE$,KTO_NAVN$,KTO_PRIMO,KTO_ULTIMO,KTO_FP,KTO_SP
1520 ENDPROC LÆS_KONTO
1530
1540 PROC TERMINAL_IDX
1550 LET PPAR := 5 ; RESRV := 0
1560 CALL :PRES"
1570 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1580 ENDPROC TERMINAL_IDX
1590
1600 PROC FEJL(ST$)
1610 LET OK := FALSE
1620 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1630 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1640 ENDPROC FEJL
1650
1660 PROC SL_FEJLLINIE
1670 LET OK := TRUE
1680 PRINT "<C0102>" ; SPC$
1690 ENDPROC SL_FEJLLINIE
1700 PROC SKRIV_LIN( REF R_NR$, REF R_NAVN$, REF R_TYP$)
1710 IF LIN_T + 5 > MAX_LIN THEN EXEC SIDESKIFT
1720 IF _NR$(1 : 2) >< R_NR$(1 : 2) THEN
1730 PRINT
1740 LET LIN_T := LIN_T + 1
1750 ENDIF
1760 LET A_NR$ := R_NR$ ; LIN_T := LIN_T + 1
1880 PRINT " " ; R_NR$ ; TAB(12) ; R_NAVN$ ; TAB(52) ; R_TYP$
1780 ENDPROC SKRIV_LIN
1790
1800 PROC SIDESKIFT
1810 FOR I := LIN_T TO AX_LIN DO PRINT
1820 LET LIN_T := 9 ; SIDENR := SIDENR + 1
1830 PRINT "*** " ; SYST_NAVN$ ; " ***" ; TAB(50) ; "SIDE: " ; SIDENR
1840 PRINT
1850 PRINT "Firmanavn: " ; FIRMANAVN$
1860 PRINT
1870 PRINT "<S>*** KONTOPLAN ***         *** UDSKREVET PR. "
1880 PRINT SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "." ; SYST_DAT$(5 : 2) ; " ***"
1890 PRINT "--------------------------------------------------------"
2010 PRINT " KONTONR   KONTONAVN                           KONTOTYPE"
1910 PRINT "--------------------------------------------------------"
1920 ENDPROC SIDESKIFT
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
1930 //
1940 PROC PRINTREL // RELEASE PRINTER
1950 SELECT OUTPUT "T"
1960 ENDPROC PRINTREL
1770 PRINT " " ; R_NR$ ; TAB(12) ; R_NAVN$
1900 PRINT " KONTONR   KONTONAVN"
0970 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