DataMuseum.dk

top - metrics - download

    Length: 6820 (0x1aa4)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSUP«

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

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 , PRTNR $ OF 1
00340 REAL RESRV , PPAR
00350 INTEGER OK , TRUE , FALSE , I , J , DEBET , KREDIT
00360 // Hj{lpevariable
00370 DIM A_NR $ OF 8 , A_TYP $ OF 1
00380 INTEGER MAX_LIN , LIN_T , SIDENR
00390 // Variable…til…filen…SYSPARA
00400 DIM SYSPARA $ OF 17
00410 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00420 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00430 // Variable…til…filen…@@PARAM
00440 DIM PARAM $ OF 17
00450 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00460 REAL MOMS
00470 // Variable…til…filen…@@KONTO
00480 DIM KONTO $ OF 17
00490 DIM ST_DATO $ OF 6
00500 INTEGER N_FRIREC , N_MAXREC , ANT_PER , PER_NR
00510 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00520 REAL KTO_PRIMO , KTO_ULTIMO
00530 INTEGER KTO_FP , KTO_SP
00540 // Variable…til…filen…@@KTOIDX
00550 DIM KTOIDX $ OF 17
00560 INTEGER I_H\JREC , I_MAXREC
00570 DIM KTONR $ OF 8
00580 INTEGER RECNR
00590 ENDPROC DIMENSIONER
00600
00610 PROC INITIER
00620 LET PRGFL $ := "DP2"
00630 LET PROGRAM $ := PRGFL $ + ":SYSU"
00640 LET TAL $ := "0123456789" ; NULR := 0
00650 FOR I := ╱cc╱ ( "A" ) TO ( "]" ) DO LET ALFA $ := ALFA $ + CHR$ ( I )
00660 LET SPC $ := "………………………………………………………………………………………………………………………"
00670 LET SPC $ := SPC $ + SPC $
00680 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00690 LET KREDIT := - 1 ; DEBET := 1
00700 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00710 EXEC OPENFIL ( SYSPARA $ , "R" )
00720 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00730 EXEC TERMINAL_IDX
00740 CLOSE SYSPARA $
00750 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00760 EXEC OPENFIL ( PARAM $ , "R" )
00770 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00780 CLOSE PARAM $
00790 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
00800 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
00810 EXEC OPENFIL ( KTOIDX $ , "R" )
00820 EXEC OPENFIL ( KONTO $ , "R" )
00830 ENDPROC INITIER
00840
00850 PROC FKT_MENU
00860 REPEAT
00870 EXEC OVERSKRIFT ( "Udskrivning…af…kontoplan" , 7 )
00880 LET A_TYP $ := "A"
00890 REPEAT
00900 // EDIT…"<C2310>Udskrivning…af…konti…med…typen:…":A_TYP$
00910 EXEC SL_FEJLLINIE
00920 EXEC ST_BGST ( A_TYP $ )
00930 IF "/" + A_TYP $ + "/" IN "/A/B/C/D/E/F/*/" THEN
00940 EXEC FEJL ( "Ulovlig…kontotype…'" + A_TYP $ + "'" )
00950 ENDIF
00960 UNTIL OK
00970 EXEC PRINTRES ( "smal…EDB-liste" , 12 )
00980 LET A_NR $ := "########" ; MAX_LIN := 72 ; LIN_T := 123 ; SIDENR := 0
00990 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
01000 FOR K := 2 TO _H\JREC DO
01010 GET KTOIDX $ , K : KTONR $ , RECNR
01020 EXEC L[S_KONTO ( RECNR )
01030 IF TO_TYPE $ = A_TYP $ OR A_TYP $ = "*" THEN
01040 EXEC SKRIV_LIN ( KTONR $ , KTO_NAVN $ , KTO_TYPE $ )
01050 ENDIF
01060 NEXT K
01070 FOR I := LIN_T TO AX_LIN DO PRINT
01080 EXEC PRINTREL
01090 LET SVAR $ := "n"
01100 EDIT "<C2614>Flere…udskrifter…(j/n)?…" : SVAR $ ( 1 )
01110 UNTIL NOT "/" + SVAR $ + "/" IN "/J/j/"
01120 ENDPROC FKT_MENU
01130
01140 PROC OPENFIL ( FNAVN $ , WAY $ )
01150 REPEAT
01160 IF AY $ = "W" OR WAY $ = "w" THEN
01170 OPEN FNAVN $ , W
01180 ELSE
01190 OPEN FNAVN $ , R
01200 ENDIF
01210 IF ( FNAVN $ ) THEN
01220 PRINT "<SC0123>" ; CHR$ ( 7 )
01230 IF ( FNAVN $ ) = 6 THEN
01240 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01250 INPUT "" : SVAR $
01260 ELSE
01270 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01280 PRINT "<S>" ; FNAVN $ ; "…***"
01290 INPUT "" : SVAR $
01300 PRINT "<C0102>" ; SPC $
01310 ENDIF
01320 ENDIF
01330 UNTIL NOT ╱cd╱ ( FNAVN $ )
01340 ENDPROC OPENFIL
01350
01360 PROC OVERSKRIFT ( ST $ , L )
01370 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
01380 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
01390 PRINT SYST_DAT $ ( 5 : 2 )
01400 CURSOR 36 - ╱cb╱ ( ST $ ) DIV 2 , L
01410 PRINT "***…" ; ST $ ; "…***"
01420 ENDPROC OVERSKRIFT
01430
01440 PROC ST_BGST ( REF RST $ )
01450 FOR I := 1 TO ( RST $ ) DO
01460 IF RST $ ( I ) =< "}" AND RST $ ( I ) >= "a" THEN LET RST $ ( I ) := CHR$ ( ╱cc╱ ( RST $ ( I ) ) - 32 )
01470 NEXT I
01480 ENDPROC ST_BGST
01490
01500 PROC L[S_KONTO ( P )
01510 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
01520 ENDPROC L[S_KONTO
01530
01540 PROC TERMINAL_IDX
01550 LET PPAR := 5 ; RESRV := 0
01560 CALL :PRES"
01570 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01580 ENDPROC TERMINAL_IDX
01590
01600 PROC FEJL ( ST $ )
01610 LET OK := FALSE
01620 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
01630 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
01640 ENDPROC FEJL
01650
01660 PROC SL_FEJLLINIE
01670 LET OK := TRUE
01680 PRINT "<C0102>" ; SPC $
01690 ENDPROC SL_FEJLLINIE
01700 PROC SKRIV_LIN ( REF R_NR $ , REF R_NAVN $ , REF R_TYP $ )
01710 IF LIN_T + 5 > MAX_LIN THEN EXEC SIDESKIFT
01720 IF _NR $ ( 1 : 2 ) >< R_NR $ ( 1 : 2 ) THEN
01730 PRINT
01740 LET LIN_T := LIN_T + 1
01750 ENDIF
01760 LET A_NR $ := R_NR $ ; LIN_T := LIN_T + 1
01880 PRINT "…" ; R_NR $ ; TAB ( 12 ) ; R_NAVN $ ; TAB ( 52 ) ; R_TYP $
01780 ENDPROC SKRIV_LIN
01790
01800 PROC SIDESKIFT
01810 FOR I := LIN_T TO AX_LIN DO PRINT
01820 LET LIN_T := 9 ; SIDENR := SIDENR + 1
01830 PRINT "***…" ; SYST_NAVN $ ; "…***" ; TAB ( 50 ) ; "SIDE:…" ; SIDENR
01840 PRINT
01850 PRINT "Firmanavn:…" ; FIRMANAVN $
01860 PRINT
01870 PRINT "<S>***…KONTOPLAN…***………………………***…UDSKREVET…PR.…"
01880 PRINT SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…***"
01890 PRINT "--------------------------------------------------------"
02010 PRINT "…KONTONR………KONTONAVN………………………………………………………………………KONTOTYPE"
01910 PRINT "--------------------------------------------------------"
01920 ENDPROC SIDESKIFT
09900 //
09901 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
09902 LET PRTNR $ := "1" ; OK := TRUE
09903 REPEAT
09904 CURSOR 21 , LINE
09905 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
09906 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
09907 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
09908 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
09909 INPUT "" : SVAR $
09910 SELECT OUTPUT "P" + PRTNR $
09911 IF ( "P" ) THEN
09912 CURSOR 12 , LINE
09913 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
09914 CURSOR 12 , LINE + 1
09915 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
09916 IF VAR $ = "J" OR SVAR $ = "j" THEN
09917 CURSOR 12 , LINE
09918 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
09919 PRINT "<SZ>"
09920 WHILE ╱cd╱ ( "P" ) DO
09921 LET SEK := ╱ca╱ ( 5 )
09922 SELECT OUTPUT "P" + PRTNR $
09923 ENDWHILE
09924 ELSE
09925 LET OK := FALSE
09926 ENDIF
09927 ENDIF
09928 CURSOR 1 , LINE
09929 PRINT "<Z>"
09930 PRINT "<SZ>"
09931 ENDPROC PRINTRES
01930 //
01940 PROC PRINTREL // RELEASE…PRINTER
01950 SELECT OUTPUT "T"
01960 ENDPROC PRINTREL
01770 PRINT "…" ; R_NR $ ; TAB ( 12 ) ; R_NAVN $
01900 PRINT "…KONTONR………KONTONAVN"
00970 EXEC PRINTRES ( "papir" , 12 )
09900 //
09901 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
09902 LET PRTNR $ := "1" ; OK := TRUE
09903 REPEAT
09904 CURSOR 15 , LINE
09905 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
09906 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
09907 CURSOR 1 , LINE
09908 PRINT "<Z>"
09909 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
09910 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
09911 INPUT "" : SVAR $
09912 SELECT OUTPUT "P" + PRTNR $
09913 IF ( "P" ) THEN
09914 CURSOR 12 , LINE
09915 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
09916 CURSOR 12 , LINE + 1
09917 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
09918 IF VAR $ = "J" OR SVAR $ = "j" THEN
09919 CURSOR 12 , LINE
09920 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
09921 PRINT "<SZ>"
09922 WHILE ╱cd╱ ( "P" ) DO
09923 LET SEK := ╱ca╱ ( 5 )
09924 SELECT OUTPUT "P" + PRTNR $
09925 ENDWHILE
09926 ELSE
09927 LET OK := FALSE
09928 ENDIF
09929 ENDIF
09930 CURSOR 1 , LINE
09931 PRINT "<Z>"
09932 PRINT "<SZ>"
09933 ENDPROC PRINTRES
38382 ╱00╱ ╱00╱