DataMuseum.dk

top - metrics - download

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

└─⟦86fa88d8d⟧ Bits:30005772 Bogføringssystemet 'SYS-KAMMS' v.1.0
    └─⟦this⟧ »SYSTIME« 

SPC/1 COMAL-80

00100 // **************************************************
00110 // *………………………………………………………………………………………………………………………………*
00120 // *…………………………Bogf|ringssystemet…'SYS-KAS'…………………………*
00130 // *………………………………………………vers.…1.0………………………………………………………*
00140 // *………………………………………………………………………………………………………………………………*
00150 // *…Udviklet…marts…1983…p}…en…'SPC/1'…mikrodatamat…*
00160 // *…Programsystemet…er…skrevet…i…COMAL80…vers.…1.2…*
00170 // *………………………………………………………………………………………………………………………………*
00180 // *…Udviklet…af…:…Peter…Kristensen……………………………………………*
00190 // *………………………………………Vestervang…6,…6920…Videb{k…………………*
00200 // *………………………………………………………………………………………………………………………………*
00210 // *………(C)…………………:…forlaget…systime…a/s…………………………………*
00220 // *………………………………………Klokkebakken…20,…Gjellerup…………………*
00230 // *………………………………………7400……Herning……………………………………………………*
00240 // **************************************************
00250 EXEC DIMENSIONER
00260 EXEC INITIER
00270 EXEC MENU
00280 EXEC SYSTEMDATO
00290 CHAIN PROGRAM $
00300 // ===========…Procedurer…starter…============
00310 PROC DIMENSIONER
00320 // Standard…variable
00330 DIM SPC $ OF 80 , SVAR $ OF 8 , PRGFL $ OF 8 , PROGRAM $ OF 17
00340 REAL RESRV , PPAR
00350 INTEGER OK , TRUE , FALSE , I , J
00360
00370 // Variable…til…filen…SYSPARA
00380 DIM SYSPARA $ OF 17
00390 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00400 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00410
00420 // Variable…til…filen…@@PARAM
00430 DIM PARAM $ OF 17
00440 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00450 REAL MOMS
00460 ENDPROC DIMENSIONER
00470
00480 PROC INITIER
00490 LET PRGFL $ := "DP2"
00500 LET PROGRAM $ := PRGFL $ + ":SYS"
00510 LET TRUE := 1 ; FALSE := 0 // boolske…variable
00520 LET SPC $ := "………………………………………………………………………………………………………………………"
00530 LET SPC $ := SPC $ + SPC $
00540 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00550 EXEC OPENFIL ( SYSPARA $ , "R" )
00560 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00570 EXEC TERMINAL_IDX
00580 CLOSE SYSPARA $
00590 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00600 EXEC OPENFIL ( PARAM $ , "W" )
00610 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00620 ENDPROC INITIER
00630
00640 PROC MENU
00650 CLEAR
00660 CURSOR 36 - ╱cb╱ ( SYST_NAVN $ ) / 2 , 6
00670 PRINT "***…" + SYST_NAVN $ + "…***"
00680 PRINT "<C1607>Udviklet…af…forlaget…systime,…Herning,…marts…1983."
00690 PRINT "<C1410>Dette…bogf|ringssystem…viser,…hvordan…en…virksomheds…"
00700 PRINT "<C1411>regnskab…kan…styres…ved…hj{lp…af…edb."
00710 PRINT "<C1413>Bogf|ringssystemet…bygger…p}…samme…kontoplan…som…til"
00720 PRINT "<C1414>regnskab…IV."
00730 INPUT "<C1417>Tryk…RETURN,…n}r…du…er…klar…til…at…forts{tte." : SVAR $
00740 ENDPROC MENU
00750
00760 PROC SYSTEMDATO
00770 EXEC OVERSKRIFT ( "Indtastning…af…systemdato" , 6 )
00780 REPEAT
00790 EDIT "<C1412>Systemdato…(}}mmdd):…" : SYST_DAT $
00800 EXEC SL_FEJLLINIE
00810 EXEC DATO_CONTROL ( SYST_DAT $ )
00820 UNTIL OK
00830 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
00840 PRINT SYST_DAT $ ( 5 : 2 )
00850 PUT PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00860 CLOSE PARAM $
00870 ENDPROC SYSTEMDATO
00880
00890 PROC OPENFIL ( FNAVN $ , WAY $ )
00900 REPEAT
00910 IF AY $ = "W" OR WAY $ = "w" THEN
00920 OPEN FNAVN $ , W
00930 ELSE
00940 OPEN FNAVN $ , R
00950 ENDIF
00960 IF ( FNAVN $ ) THEN
00970 IF ( FNAVN $ ) = 46 THEN
00980 PRINT "<SC1602>***…Fejl…nr.…46…-…inds{t…diskette…og…tryk…<RETURN>…***"
00990 INPUT "" : SVAR $
01000 ELSE
01010 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01020 PRINT "<S>" ; FNAVN $ ; "…***"
01030 INPUT "" : SVAR $
01040 PRINT "<C0102>" ; SPC $
01050 ENDIF
01060 ENDIF
01070 UNTIL NOT ╱cd╱ ( FNAVN $ )
01080 ENDPROC OPENFIL
01090
01100 PROC TERMINAL_IDX
01110 LET PPAR := 5 ; RESRV := 0
01120 CALL :PRES"
01130 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01140 ENDPROC TERMINAL_IDX
01150
01160 PROC FEJL ( ST $ )
01170 LET OK := FALSE
01180 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01190 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01200 ENDPROC FEJL
01210
01220 PROC SL_FEJLLINIE
01230 LET OK := TRUE
01240 PRINT "<C0102>" ; SPC $
01250 ENDPROC SL_FEJLLINIE
01260
01270 PROC OVERSKRIFT ( ST $ , L )
01280 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01290 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01300 PRINT SYST_DAT $ ( 5 : 2 )
01310 CURSOR 34 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
01320 PRINT "***…" ; ST $ ; "…***"
01330 ENDPROC OVERSKRIFT
01340
01350 PROC DATO_CONTROL ( REF RST $ )
01360 LET OK := TRUE
01370 IF RST $ ( 1 : 2 ) < "00" OR RST $ ( 1 : 2 ) > "99" THEN LET OK := FALSE
01380 IF RST $ ( 3 : 2 ) < "01" OR RST $ ( 3 : 2 ) > "12" THEN LET OK := FALSE
01390 IF RST $ ( 5 : 2 ) < "01" OR RST $ ( 5 : 2 ) > "31" THEN LET OK := FALSE
01400 IF NOT OK THEN EXEC FEJL ( "Ulovlig…dato" )
01410 ENDPROC DATO_CONTROL
00680 PRINT "<C1607>Udviklet…af…forlaget…systime…a/s,…DK-7400…Herning"
38382 ╱00╱ ╱00╱