DataMuseum.dk

top - metrics - download

    Length: 3224 (0xc98)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cd
    Names: »SYSPTK«

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

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