DataMuseum.dk

top - download

    Length: 3730 (0xe92)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYS.B«

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYS.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 FUNKTIONSMENU
0280 // =========== Procedurer starter ==============
0290 PROC DIMENSIONER
0300 // Standard variable
0310 DIM SPC$ OF 80,SVAR$ OF 10,PRGFL$ OF 8,ALFA$ OF 28,TAL$ OF 10
0320 DIM PROGRAM$ OF 17
0330 REAL RESRV,PPAR
0340 INTEGER OK,TRUE,FALSE,I,J
0350 // Variable til filen SYSPARA
0360 DIM SYSPARA$ OF 17
0370 DIM SYST_NAVN$ OF 30,S_KODE$ OF 1
0380 DIM DATAFL$ OF 8,T_KODE$ OF 1
0390 // Variable til filen @@PARAM
0400 DIM PARAM$ OF 17
0410 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0420 REAL MOMS
0430 ENDPROC DIMENSIONER
0440
0450 PROC INITIER
0460 LET PRGFL$ := "DP2"
0470 LET PROGRAM$ := PRGFL$ + ":SYSIP"
0480 LET SPC$ := "                                             "
0490 LET SPC$ := SPC$ + SPC$
0500 LET FALSE := 0 ; TRUE := 1 // boolske variable
0510 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0520 EXEC OPENFIL(SYSPARA$,"R")
0530 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0540 EXEC TERMINAL_IDX
0550 CLOSE SYSPARA$
0560 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0570 EXEC OPENFIL(PARAM$,"R")
0580 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0590 CLOSE PARAM$
0600 ENDPROC INITIER
0610
0620 PROC TERMINAL_IDX
0630 LET PPAR := 5 ; RESRV := 0
0640 CALL ("DDE:PRES"
0650 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
0660 ENDPROC TERMINAL_IDX
0670
0680 PROC OPENFIL(FNAVN$,WAY$)
0690 REPEAT
0700 IF AY$ = "W" OR WAY$ = "w" THEN
0710 OPEN FNAVN$,W
0720 ELSE
0730 OPEN FNAVN$,R
0740 ENDIF
0750 IF (FNAVN$) THEN
0760 PRINT "<SC0123>" ; CHR$ (7)
0770 IF (FNAVN$) = 6 THEN
0780 PRINT "<SC1602>*** Fejl nr. 6 - indsæt diskette og tryk <RETURN> ***"
0790 INPUT "" : SVAR$
0800 ELSE
0810 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
0820 PRINT "<S>" ; FNAVN$ ; " ***"
0830 INPUT "" : SVAR$
0840 PRINT "<C0102>" ; SPC$
0850 ENDIF
0860 ENDIF
0870 UNTIL NOT ╱cd╱ (FNAVN$)
0880 ENDPROC OPENFIL
0890
0900 PROC OVERSKRIFT(ST$,L)
0910 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
0920 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
0930 PRINT SYST_DAT$(5 : 2)
0940 CURSOR 36 - INT( ╱cb╱ (ST$) / 2),L
0950 PRINT "*** " ; ST$ ; " ***"
0960 ENDPROC OVERSKRIFT
0970
0980 PROC SL_FEJLLINIE
0990 LET OK := TRUE
1000 PRINT "<C0102>" ; SPC$
1010 ENDPROC SL_FEJLLINIE
1020
1030 PROC FEJL(ST$)
1040 LET OK := FALSE
1050 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1060 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1070 ENDPROC FEJL
1080
1090 PROC FUNKTIONSMENU
1100 EXEC OVERSKRIFT(SYST_NAVN$,3)
1110 PRINT "<C3005>H O V E D M E N U"
1120 PRINT "<C1907>Indtastning af daglige posteringer      I"
1130 PRINT "<C1909>Udskrivning af bogføringsdata           U"
1140 PRINT "<C1911>Kontofunktioner                         K"
1150 PRINT "<C1913>Start og afslutning af regnskab         A"
1160 PRINT "<C1915>Parameterændringer                      P"
1170 PRINT "<C1917>Regnskabsanalyse                        R"
1180 PRINT "<C1920>Stop systemet                           X"
1190 REPEAT
1200 EDIT "<SC2623>Indtast funktionskode: " : SVAR$(1)
1210 EXEC SL_FEJLLINIE
1220 EXEC ST_BGST(SVAR$)
1230 IF "/" + SVAR$ + "/" IN "/I/P/U/K/A/R/X/" THEN
1240 EXEC FEJL("Ulovlig funktionskode: '" + SVAR$ + "'")
1250 ENDIF
1260 UNTIL OK
1270 IF VAR$ IN "X" THEN
1280 PRINT "<XC1212>Slut på " ; SYST_NAVN$
1290 STOP
1300 ENDIF
1310 LET PROGRAM$ := PRGFL$ + ":SYS" + SVAR$
1320 CHAIN PROGRAM$
1330 ENDPROC FUNKTIONSMENU
1340
1350 PROC ST_BGST( REF RST$)
1360 IF " " IN RST$ THEN LET RST$ := RST$(1)
1370 FOR I := 1 TO (RST$) DO
1380 IF RST$(I) =< "å" AND RST$(I) >= "a" THEN LET RST$(I) := CHR$ ( ╱cc╱ (RST$(I)) - 32)
1390 NEXT I
1400 ENDPROC ST_BGST