DataMuseum.dk

top - metrics - download

    Length: 3441 (0xd71)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
    Names: »SYSU«

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

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 FUNKTIONSMENU
00280 // ===========…Procedurer…starter…==============
00290 PROC DIMENSIONER
00300 // Standard…variable
00310 DIM SPC $ OF 80 , SVAR $ OF 10 , PRGFL $ OF 8 , ALFA $ OF 28 , TAL $ OF 10
00320 DIM PROGRAM $ OF 17
00330 REAL RESRV , PPAR
00340 INTEGER OK , TRUE , FALSE , I , J
00350 // Variable…til…filen…SYSPARA
00360 DIM SYSPARA $ OF 17
00370 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00380 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00390 // Variable…til…filen…@@PARAM
00400 DIM PARAM $ OF 17
00410 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00420 REAL MOMS
00430 ENDPROC DIMENSIONER
00440
00450 PROC INITIER
00460 LET PRGFL $ := "DP2"
00470 LET PROGRAM $ := PRGFL $ + ":SYSIP"
00480 LET SPC $ := "………………………………………………………………………………………………………………………"
00490 LET SPC $ := SPC $ + SPC $
00500 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00510 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00520 EXEC OPENFIL ( SYSPARA $ , "R" )
00530 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00540 EXEC TERMINAL_IDX
00550 CLOSE SYSPARA $
00560 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00570 EXEC OPENFIL ( PARAM $ , "R" )
00580 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00590 CLOSE PARAM $
00600 ENDPROC INITIER
00610
00620 PROC TERMINAL_IDX
00630 LET PPAR := 5 ; RESRV := 0
00640 CALL ( "DDE:PRES"
00650 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
00660 ENDPROC TERMINAL_IDX
00670
00680 PROC OPENFIL ( FNAVN $ , WAY $ )
00690 REPEAT
00700 IF AY $ = "W" OR WAY $ = "w" THEN
00710 OPEN FNAVN $ , W
00720 ELSE
00730 OPEN FNAVN $ , R
00740 ENDIF
00750 IF ( FNAVN $ ) THEN
00760 PRINT "<SC0123>" ; CHR$ ( 7 )
00770 IF ( FNAVN $ ) = 6 THEN
00780 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
00790 INPUT "" : SVAR $
00800 ELSE
00810 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
00820 PRINT "<S>" ; FNAVN $ ; "…***"
00830 INPUT "" : SVAR $
00840 PRINT "<C0102>" ; SPC $
00850 ENDIF
00860 ENDIF
00870 UNTIL NOT ╱cd╱ ( FNAVN $ )
00880 ENDPROC OPENFIL
00890
00900 PROC OVERSKRIFT ( ST $ , L )
00910 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
00920 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
00930 PRINT SYST_DAT $ ( 5 : 2 )
00940 CURSOR 36 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
00950 PRINT "***…" ; ST $ ; "…***"
00960 ENDPROC OVERSKRIFT
00970
00980 PROC SL_FEJLLINIE
00990 LET OK := TRUE
01000 PRINT "<C0102>" ; SPC $
01010 ENDPROC SL_FEJLLINIE
01020
01030 PROC FEJL ( ST $ )
01040 LET OK := FALSE
01050 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01060 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01070 ENDPROC FEJL
01080
01090 PROC FUNKTIONSMENU
01100 EXEC OVERSKRIFT ( "Udskrivning…af…bogf|ringsdata" , 7 )
01110 PRINT "<C1910>Kontokort…………………………………………………………………………………UK"
01120 PRINT "<C1912>Kontoplan…………………………………………………………………………………UP"
01130 PRINT "<C1914>Saldobalance…………………………………………………………………………US"
01140 PRINT "<C1917>Programfordeler……………………………………………………………RETURN"
01150 REPEAT
01160 EDIT "<C2720>Indtast…funktionskode:…" : SVAR $ ( 1 : 2 )
01170 EXEC SL_FEJLLINIE
01180 IF "/" + SVAR $ + "/" IN "/UK/uk/UP/up/US/us//……/…/" THEN
01190 EXEC FEJL ( "Ulovlig…funktionskode:…'" + SVAR $ + "'" )
01200 ENDIF
01210 UNTIL OK
01220 LET PROGRAM $ := PRGFL $ + ":SYS" + SVAR $
01230 CHAIN PROGRAM $
01240 ENDPROC FUNKTIONSMENU
01221 IF "/" + SVAR $ + "/" IN "/UK/uk" THEN LET PROGRAM $ := PROGRAM $ + S_KODE $
01221 IF "/" + SVAR $ + "/" IN "/UK/uk/" THEN LET PROGRAM $ := PROGRAM $ + S_KODE $
38382 ╱00╱ ╱00╱