DataMuseum.dk

top - download

    Length: 3847 (0xf07)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
    Names: »SYSTIME.B«

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSTIME.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 MENU
0280 EXEC SYSTEMDATO
0290 CHAIN PROGRAM$
0300 // =========== Procedurer starter ============
0310 PROC DIMENSIONER
0320 // Standard variable
0330 DIM SPC$ OF 80,SVAR$ OF 8,PRGFL$ OF 8,PROGRAM$ OF 17
0340 REAL RESRV,PPAR
0350 INTEGER OK,TRUE,FALSE,I,J
0360
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
0420 // Variable til filen @@PARAM
0430 DIM PARAM$ OF 17
0440 DIM FIRMANAVN$ OF 30,SYST_DAT$ OF 6
0450 REAL MOMS
0460 ENDPROC DIMENSIONER
0470
0480 PROC INITIER
0490 LET PRGFL$ := "DP2"
0500 LET PROGRAM$ := PRGFL$ + ":SYS"
0510 LET TRUE := 1 ; FALSE := 0 // boolske variable
0520 LET SPC$ := "                                             "
0530 LET SPC$ := SPC$ + SPC$
0540 LET SYSPARA$ := PRGFL$ + ":SYSPARA"
0550 EXEC OPENFIL(SYSPARA$,"R")
0560 GET SYSPARA$,1 : SYST_NAVN$,S_KODE$
0570 EXEC TERMINAL_IDX
0580 CLOSE SYSPARA$
0590 LET PARAM$ := DATAFL$ + ":" + S_KODE$ + T_KODE$ + "PARAM"
0600 EXEC OPENFIL(PARAM$,"W")
0610 GET PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0620 ENDPROC INITIER
0630
0640 PROC MENU
0650 CLEAR
0660 CURSOR 36 - ╱cb╱ (SYST_NAVN$) / 2,6
0670 PRINT "*** " + SYST_NAVN$ + " ***"
0680 PRINT "<C1607>Udviklet af forlaget systime, Herning, marts 1983."
0690 PRINT "<C1410>Dette bogføringssystem viser, hvordan en virksomheds "
0700 PRINT "<C1411>regnskab kan styres ved hjælp af edb."
0710 PRINT "<C1413>Bogføringssystemet bygger på samme kontoplan som til"
0720 PRINT "<C1414>regnskab IV."
0730 INPUT "<C1417>Tryk RETURN, når du er klar til at fortsætte." : SVAR$
0740 ENDPROC MENU
0750
0760 PROC SYSTEMDATO
0770 EXEC OVERSKRIFT("Indtastning af systemdato",6)
0780 REPEAT
0790 EDIT "<C1412>Systemdato (ååmmdd): " : SYST_DAT$
0800 EXEC SL_FEJLLINIE
0810 EXEC DATO_CONTROL(SYST_DAT$)
0820 UNTIL OK
0830 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
0840 PRINT SYST_DAT$(5 : 2)
0850 PUT PARAM$,1 : FIRMANAVN$,SYST_DAT$,MOMS
0860 CLOSE PARAM$
0870 ENDPROC SYSTEMDATO
0880
0890 PROC OPENFIL(FNAVN$,WAY$)
0900 REPEAT
0910 IF AY$ = "W" OR WAY$ = "w" THEN
0920 OPEN FNAVN$,W
0930 ELSE
0940 OPEN FNAVN$,R
0950 ENDIF
0960 IF (FNAVN$) THEN
0970 IF (FNAVN$) = 46 THEN
0980 PRINT "<SC1602>*** Fejl nr. 46 - indsæt diskette og tryk <RETURN> ***"
0990 INPUT "" : SVAR$
1000 ELSE
1010 PRINT "<SC1802>*** Fejl nr. " ; CHR$ ( ╱cd╱ (FNAVN$),2) ; " ved åbning af "
1020 PRINT "<S>" ; FNAVN$ ; " ***"
1030 INPUT "" : SVAR$
1040 PRINT "<C0102>" ; SPC$
1050 ENDIF
1060 ENDIF
1070 UNTIL NOT ╱cd╱ (FNAVN$)
1080 ENDPROC OPENFIL
1090
1100 PROC TERMINAL_IDX
1110 LET PPAR := 5 ; RESRV := 0
1120 CALL :PRES"
1130 GET SYSPARA$,1 + RESRV : DATAFL$,T_KODE$
1140 ENDPROC TERMINAL_IDX
1150
1160 PROC FEJL(ST$)
1170 LET OK := FALSE
1180 CURSOR 36 - ╱cb╱ (ST$) / 2,2
1190 PRINT "*** " + ST$ + " ***" ; CHR$ (7)
1200 ENDPROC FEJL
1210
1220 PROC SL_FEJLLINIE
1230 LET OK := TRUE
1240 PRINT "<C0102>" ; SPC$
1250 ENDPROC SL_FEJLLINIE
1260
1270 PROC OVERSKRIFT(ST$,L)
1280 PRINT "<XC0101>Firmanavn: " ; FIRMANAVN$
1290 PRINT "<SC6501>Dato: " ; SYST_DAT$(1 : 2) ; "." ; SYST_DAT$(3 : 2) ; "."
1300 PRINT SYST_DAT$(5 : 2)
1310 CURSOR 34 - INT( ╱cb╱ (ST$) / 2),L
1320 PRINT "*** " ; ST$ ; " ***"
1330 ENDPROC OVERSKRIFT
1340
1350 PROC DATO_CONTROL( REF RST$)
1360 LET OK := TRUE
1370 IF RST$(1 : 2) < "00" OR RST$(1 : 2) > "99" THEN LET OK := FALSE
1380 IF RST$(3 : 2) < "01" OR RST$(3 : 2) > "12" THEN LET OK := FALSE
1390 IF RST$(5 : 2) < "01" OR RST$(5 : 2) > "31" THEN LET OK := FALSE
1400 IF NOT OK THEN EXEC FEJL("Ulovlig dato")
1410 ENDPROC DATO_CONTROL