DataMuseum.dk

top - metrics - download

    Length: 17990 (0x4646)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_01, UNKNOWN_TOKEN_11, UNKNOWN_TOKEN_17, UNKNOWN_TOKEN_1f, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSKRY«

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

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 , PRTNR $ OF 1
00330 REAL RESRV , PPAR
00340 INTEGER OK , TRUE , FALSE , I , J , K
00350 // Hj{lpevariable
00360 REAL TOT ( 6 )
00370 INTEGER A_POST , HIGH , LOW , POS , IDXPOS , KREDIT , DEBET , LIN_T , MAX_LIN , T_IDX
00380 // Variable…til…filen…SYSPARA
00390 DIM SYSPARA $ OF 17
00400 DIM SYST_NAVN $ OF 30 , S_KODE $ OF 1
00410 DIM DATAFL $ OF 8 , T_KODE $ OF 1
00420 // Variable…til…filen…@@PARAM
00430 DIM PARAM $ OF 17
00440 DIM FIRMANAVN $ OF 30 , SYST_DAT $ OF 6
00450 REAL MOMS
00460 // Variable…til…filen…@@KASSE
00470 DIM KASSE $ OF 17
00480 DIM K_BDAT $ OF 6
00490 INTEGER K_H\JREC , K_MAXREC , S_NR_KASSE
00500 DIM K_BKTO $ OF 8 , K_LKOD $ OF 1 , K_MKOD $ OF 1
00510 DIM K_BNR $ OF 5 , K_TXT $ OF 20
00520 REAL K_BKR
00530 INTEGER K_DK
00540 // Variable…til…filen…@@KONTO
00550 DIM KONTO $ OF 17
00560 DIM ST_DATO $ OF 6
00570 INTEGER N_FRIREC , N_MAXREC , ANT_PER , PER_NR
00580 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00590 REAL KTO_PRIMO , KTO_ULTIMO
00600 INTEGER KTO_FP , KTO_SP
00610 // Variable…til…filen…@@KTOIDX
00620 DIM KTOIDX $ OF 17
00630 INTEGER I_H\JREC , I_MAXREC
00640 DIM KTONR $ OF 8
00650 INTEGER RECNR
00660 // Variable…til…filen…@@FKTONR
00670 DIM FKTONR $ OF 17
00680 DIM KASSE_KTO $ OF 8 , BANK_KTO $ OF 8 , GIRO_KTO $ OF 8
00690 ENDPROC DIMENSIONER
00700
00710 PROC INITIER
00720 LET PRGFL $ := "DP2"
00730 LET PROGRAM $ := PRGFL $ + ":SYSI"
00740 LET TAL $ := "0123456789"
00750 FOR I := ╱cc╱ ( "A" ) TO ( "]" ) DO LET ALFA $ := ALFA $ + CHR$ ( I )
00760 LET SPC $ := "………………………………………………………………………………………………………………………"
00770 LET SPC $ := SPC $ + SPC $
00780 LET FALSE := 0 ; TRUE := 1 // boolske…variable
00790 LET KREDIT := - 1 ; DEBET := 1
00800 LET SYSPARA $ := PRGFL $ + ":SYSPARA"
00810 EXEC OPENFIL ( SYSPARA $ , "R" )
00820 GET SYSPARA $ , 1 : SYST_NAVN $ , S_KODE $
00830 EXEC TERMINAL_IDX
00840 CLOSE SYSPARA $
00850 LET PARAM $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "PARAM"
00860 EXEC OPENFIL ( PARAM $ , "R" )
00870 GET PARAM $ , 1 : FIRMANAVN $ , SYST_DAT $ , MOMS
00880 CLOSE PARAM $
00890 LET KTOIDX $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KTOIDX"
00900 LET KONTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KONTO"
00910 LET KASSE $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "KASSE"
00920 LET FKTONR $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "FKTONR"
00930 EXEC OPENFIL ( KTOIDX $ , "r" )
00940 EXEC OPENFIL ( KONTO $ , "R" )
00950 EXEC OPENFIL ( KASSE $ , "W" )
00960 EXEC OPENFIL ( FKTONR $ , "R" )
00970 GET FKTONR $ , 1 : KASSE_KTO $
00980 GET FKTONR $ , 2 : BANK_KTO $
00990 GET FKTONR $ , 3 : GIRO_KTO $
01000 CLOSE FKTONR $
01010 ENDPROC INITIER
01020
01030 PROC FUNKTIONSMENU
01040 REPEAT
01050 EXEC OVERSKRIFT ( "Kasserapport" , 6 )
01060 PRINT "<C2009>Indtastning…af…kasseposteringer……………IK"
01070 PRINT "<C2011>Udskrivning…af…kassekladde…………………………UK"
01080 PRINT "<C2013>Ret…kasseposteringer…………………………………………RK"
01090 PRINT "<C2015>Afstem…og…bogf|r…kasseposteringer………AK"
01100 PRINT "<C2018>Programfordeler…………………………………………………RETURN"
01110 LET SVAR $ := "……"
01120 REPEAT
01130 EDIT "<C2523>Indtast…funktionskode:…" : SVAR $ ( 1 : 2 )
01140 EXEC SL_FEJLLINIE
01150 IF SVAR $ IN "……" THEN EXIT
01160 IF "/" + SVAR $ ( 1 : 2 ) + "/" IN "/IK/ik/UK/uk/RK/rk/AK/ak/" THEN
01170 EXEC FEJL ( "Ulovlig…funktionskode:…'" + SVAR $ ( 1 : 2 ) + "'" )
01180 ENDIF
01190 UNTIL OK
01200 GET KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
01210 CASE SVAR $ ( 1 : 2 ) OF
01220 WHILE "IK" , "ik"
01230 IF _H\JREC > 1 AND K_BDAT $ >< SYST_DAT $ THEN
01240 PRINT "<XC1210>Du…er…startet…p}…en…ny…dato…siden…du…sidst…ind-"
01250 PRINT "<C1211>tastede…kasseposteringer…-……kasserapporten…skal…"
01260 PRINT "<C1212>afstemmes…inden…du…kan…indtaste…flere…kasse-"
01270 PRINT "<C1213>posteringer."
01280 INPUT "<SC6523>Tryk…RETURN" : SVAR $
01290 ELSE
01300 EXEC INDTAST_POSTER
01310 ENDIF
01320 WHILE "UK" , "uk"
01330 EXEC UDSKRIV_POSTER
01340 WHILE "RK" , "rk"
01350 EXEC RET_POSTER
01360 WHILE "AK" , "ak"
01370 IF _H\JREC = 1 THEN
01380 EXEC FEJL ( "Ulovlig…afstemning…-…ingen…posteringer" )
01390 ELSE
01400 LET PROGRAM $ := PRGFL $ + ":SYSAK"
01410 CHAIN PROGRAM $
01420 ENDIF
01430 OTHERWISE
01440 CHAIN PROGRAM $
01450 ENDCASE
01460 UNTIL FALSE
01470 ENDPROC FUNKTIONSMENU
01480
01490 PROC TERMINAL_IDX
01500 LET PPAR := 5 ; RESRV := 0
01510 CALL :PRES"
01520 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01530 ENDPROC TERMINAL_IDX
01540
01550 PROC OPENFIL ( FNAVN $ , WAY $ )
01560 REPEAT
01570 IF AY $ = "W" OR WAY $ = "w" THEN
01580 OPEN FNAVN $ , W
01590 ELSE
01600 OPEN FNAVN $ , R
01610 ENDIF
01620 IF ( FNAVN $ ) THEN
01630 PRINT "<SC0123>" ; CHR$ ( 7 )
01640 IF ( FNAVN $ ) = 6 THEN
01650 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01660 INPUT "" : SVAR $
01670 ELSE
01680 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01690 PRINT "<S>" ; FNAVN $ ; "…***"
01700 INPUT "" : SVAR $
01710 PRINT "<C0102>" ; SPC $
01720 ENDIF
01730 ENDIF
01740 UNTIL NOT ╱cd╱ ( FNAVN $ )
01750 ENDPROC OPENFIL
01760
01770 PROC TAL_CONTROL ( REF RST $ )
01780 LET J := 0 ; OK := TRUE
01790 FOR I := 1 TO ( RST $ ) DO
01800 IF RST $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
01810 NEXT I
01820 IF = 0 THEN
01830 LET OK := FALSE
01840 ELSE
01850 LET RST $ := RST $ ( 1 : J )
01860 ENDIF
01870 ENDPROC TAL_CONTROL
01880
01890 PROC KASSEHOVED
01900 EXEC OVERSKRIFT ( "INDTASTNING…AF…KASSEBILAG" , 4 )
01910 PRINT "<C0105>………BILAG……TEKST……………………………………MOMS……KASSE"
01920 PRINT "<C0106>…………NR……………………………………………………………KODE……BANK/"
01930 PRINT "<C0107>……………………………………………………………………………………………GIRO"
01940 PRINT "<C0108>----------------------------------------"
01950 PRINT "<C4105>/……INDBETALING……UDBETALING……MODPOST-…F/"
01960 PRINT "<C4106>……………(DEBET)……………(KREDIT)………ERES……………R/"
01970 PRINT "<C4107>…………………………………………………………………………KONTONR……S"
01980 PRINT "<C4108>----------------------------------------"
01990 ENDPROC KASSEHOVED
02000
02010 PROC OVERSKRIFT ( ST $ , L )
02020 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
02030 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
02040 PRINT SYST_DAT $ ( 5 : 2 )
02050 CURSOR 34 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
02060 PRINT "***…" ; ST $ ; "…***"
02070 ENDPROC OVERSKRIFT
02080
02090 PROC EDIT_LIN ( R_LIN )
02100 LET R_SLIN := R_LIN MOD 12 + 8
02110 IF R_SLIN = 8 THEN LET R_SLIN := 12 + R_SLIN
02120 EXEC L[S_K_POST ( R_LIN )
02130 IF _BNR $ = "*****" THEN
02140 LET K_BKTO $ := "" ; K_LKOD $ := "…" ; K_MKOD $ := "…"
02150 LET K_BNR $ := "…………………" ; K_TXT $ := "" ; K_BKR := 0 ; K_DK := 0
02160 ENDIF
02170 REPEAT
02180 EXEC SL_FEJLLINIE
02190 CURSOR 1 , R_SLIN
02200 PRINT CHR$ ( R_LIN , 2 )
02210 REPEAT
02220 CURSOR 4 , R_SLIN
02230 EDIT "" : K_BNR $
02240 EXEC SL_FEJLLINIE
02250 IF _BNR $ = "*****" OR "/" + K_BNR $ + "/" IN "/SLUT/slut/" THEN
02260 LET OK := TRUE
02270 ELSE
02280 EXEC TAL_CONTROL ( K_BNR $ )
02290 IF NOT OK THEN EXEC FEJL ( "Ulovlig…bilagsnummer" )
02300 ENDIF
02310 UNTIL OK
02320 CURSOR 4 , R_SLIN
02330 PRINT SPC $ ( 1 : 5 )
02340 CURSOR 4 , R_SLIN
02350 IF _BNR $ = "*****" OR "/" + K_BNR $ + "/" IN "/SLUT/slut/" THEN
02360 IF /" + K_BNR $ + "/" IN "/SLUT/slut/" THEN
02370 LET SVAR $ := "S" ; K_BNR $ := "*****" ; K_H\JREC := K_H\JREC - 1
02380 ENDIF
02390 PRINT SPC $ ( 1 : 76 )
02400 EXIT
02410 ELSE
02420 PRINT K_BNR $
02430 ENDIF
02440 CURSOR 11 , R_SLIN
02450 EDIT "" : K_TXT $
02460 REPEAT
02470 CURSOR 32 , R_SLIN
02480 EDIT "" : K_MKOD $
02490 EXEC SL_FEJLLINIE
02500 EXEC ST_BGST ( K_MKOD $ )
02510 IF NOT K_MKOD $ IN "IU…" THEN EXEC FEJL ( "ULOVLIG…KODE:…'" + K_MKOD $ + "'" )
02520 UNTIL OK
02470 REPEAT
02480 CURSOR 38 , R_SLIN
02490 EDIT "" : K_LKOD $
02500 EXEC SL_FEJLLINIE
02510 EXEC ST_BGST ( K_LKOD $ )
02520 IF "/" + K_LKOD $ + "/" IN "/K/B/G/" THEN
02530 EXEC FEJL ( "ULOVLIG…KODE:…'" + K_LKOD $ + "'" )
02540 ENDIF
02550 UNTIL OK
02560 REPEAT
02570 IF _DK = KREDIT THEN
02580 LET SVAR $ := CHR$ ( K_BKR , 7 , 2 )
02590 IF K_BKR = 0 THEN LET SVAR $ := ""
02600 CURSOR 57 , R_SLIN
02610 EDIT "" : SVAR $
02620 EXEC SL_FEJLLINIE
02630 EXEC TAL_CONTROL ( SVAR $ )
02640 IF NOT "." IN SVAR $ THEN LET SVAR $ := SVAR $ + "."
02650 LET K_BKR := INT ( 100 * ASC ( "0" + SVAR $ ) + 0.5 ) / 100
02660 CURSOR 57 , R_SLIN
02670 IF _BKR > 0 THEN
02680 PRINT CHR$ ( K_BKR , 7 , 2 )
02690 ELSE
02700 PRINT SPC $ ( 1 : 10 )
02710 ENDIF
02720 ELSE
02730 LET K_DK := DEBET
02740 LET SVAR $ := CHR$ ( K_BKR , 7 , 2 )
02750 IF K_BKR = 0 THEN LET SVAR $ := ""
02760 CURSOR 44 , R_SLIN
02770 EDIT "" : SVAR $
02780 EXEC SL_FEJLLINIE
02790 EXEC TAL_CONTROL ( SVAR $ )
02800 IF NOT "." IN SVAR $ THEN LET SVAR $ := SVAR $ + "."
02810 LET K_BKR := INT ( 100 * ASC ( "0" + SVAR $ ) + 0.5 ) / 100
02820 CURSOR 44 , R_SLIN
02830 IF _BKR > 0 THEN
02840 PRINT CHR$ ( K_BKR , 7 , 2 )
02850 ELSE
02860 PRINT SPC $ ( 1 : 10 )
02870 ENDIF
02880 ENDIF
02890 IF K_BKR = 0 THEN LET K_DK := K_DK * ( - 1 )
02900 UNTIL K_BKR > 0
02910 REPEAT
02920 CURSOR 69 , R_SLIN
02930 EDIT "" : K_BKTO $
02940 EXEC SL_FEJLLINIE
02950 EXEC FIND_KTO ( K_BKTO $ )
02960 IF K THEN
02970 EXEC L[S_KONTO ( RECNR )
02980 IF TO_TYPE $ >< "A" THEN
02990 EXEC FEJL ( "Ulovlig…kontonr…-…kontotype…<…>…'A'" )
03000 ELSE
03010 PRINT "<C0102>" ; TAB ( 35 - ╱cb╱ ( KTO_NAVN $ ) / 2 ) ; "Konto:…" ; KTO_NAVN $
03020 ENDIF
03030 ELSE
03040 EXEC FEJL ( "Ulovlig…kontonr…-…konto…findes…ikke" )
03050 ENDIF
03060 UNTIL OK
03070 REPEAT
03080 LET SVAR $ := "f"
03090 CURSOR 78 , R_SLIN
03100 EDIT "" : SVAR $ ( 1 )
03110 EXEC ST_BGST ( SVAR $ )
03120 UNTIL "/" + SVAR $ ( 1 ) + "/" IN "/F/S/R/"
03130 UNTIL SVAR $ ( 1 ) IN "FS"
03140 EXEC SKRIV_K_POST ( R_LIN )
03150 EXEC SL_FEJLLINIE
03160 ENDPROC EDIT_LIN
03170
03180 PROC SL_FEJLLINIE
03190 LET OK := TRUE
03200 PRINT "<C0102>" ; SPC $
03210 ENDPROC SL_FEJLLINIE
03220
03230 PROC FEJL ( ST $ )
03240 LET OK := FALSE
03250 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
03260 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
03270 ENDPROC FEJL
03280
03290
03300 PROC INDTAST_POSTER
03310 EXEC SKRIV_LINIER
03320 LET SVAR $ := "F"
03330 WHILE SVAR $ = "F" DO
03340 GET KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
03350 IF K_H\JREC = 1 THEN LET K_BDAT $ := SYST_DAT $
03360 IF _H\JREC = K_MAXREC THEN
03370 EXEC FEJL ( "Der…kan…ikke…indtastes…flere…posteringer…f|r…afstemning" )
03380 INPUT "<SC6524>Tryk…RETURN" : SVAR $
03390 EXEC SL_FEJLLINIE
03400 EXIT
03410 ENDIF
03420 LET K_H\JREC := K_H\JREC + 1
03430 EXEC EDIT_LIN ( K_H\JREC - 1 )
03440 PUT KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
03450 IF K_H\JREC - 1 ) MOD 12 = 0 AND SVAR $ = "F" THEN
03460 EXEC RET_LINIER
03470 EXEC KASSEHOVED
03480 LET SVAR $ := "F"
03490 ENDIF
03500 ENDWHILE
03510 EXEC RET_LINIER
03520 ENDPROC INDTAST_POSTER
03530
03540 PROC RET_LINIER
03550 REPEAT
03560 PRINT "<SC0122>" ; SPC $
03570 LET SVAR $ := "j"
03580 EDIT "<SC1222>Ok…(j)…eller…linienummer…der…skal…rettes?…" : SVAR $
03590 IF "/" + SVAR $ + "/" IN "/J/j/" THEN
03600 EXEC TAL_CONTROL ( SVAR $ )
03610 IF K THEN
03620 IF ( SVAR $ ) < K_H\JREC AND ASC ( SVAR $ ) > 0 THEN
03630 EXEC EDIT_LIN ( ASC ( SVAR $ ) )
03640 ENDIF
03650 ENDIF
03660 ENDIF
03670 UNTIL "/" + SVAR $ + "/" IN "/J/j/"
03680 ENDPROC RET_LINIER
03690
03700
03710 PROC SKRIV_LINIER
03720 GET KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
03730 EXEC KASSEHOVED
03740 FOR I := K_H\JREC - ( K_H\JREC - 1 ) MOD 12 TO _H\JREC - 1 DO
03750 IF > 0 THEN
03760 EXEC L[S_K_POST ( I )
03770 IF K_BNR $ >< "*****" THEN EXEC SKRIV_LIN ( I )
03780 ENDIF
03790 NEXT I
03800 ENDPROC SKRIV_LINIER
03810
03820 PROC SKRIV_LIN ( R_LIN )
03830 IF K_BNR $ = "*****" THEN EXIT
03840 LET R_SLIN := R_LIN MOD 12 + 8
03850 IF R_SLIN = 8 THEN LET R_SLIN := 12 + R_SLIN
03860 CURSOR 1 , R_SLIN
03870 PRINT CHR$ ( R_LIN , 2 )
03880 CURSOR 4 , R_SLIN
03890 PRINT K_BNR $
03900 CURSOR 11 , R_SLIN
03910 PRINT K_TXT $
03920 CURSOR 32 , R_SLIN
03930 PRINT K_MKOD $
03940 CURSOR 38 , R_SLIN
03950 PRINT K_LKOD $
03960 IF _DK = DEBET THEN
03970 CURSOR 42 , R_SLIN
03980 ELSE
03990 CURSOR 55 , R_SLIN
04000 ENDIF
04010 PRINT CHR$ ( K_BKR , 9 , 2 )
04020 CURSOR 69 , R_SLIN
04030 PRINT K_BKTO $
04040 ENDPROC SKRIV_LIN
04050
04060 PROC SKRIV_K_POST ( P )
04070 PUT KASSE $ , P + 1 : K_BKTO $ , K_LKOD $ , K_MKOD $ , K_BNR $ , K_TXT $ , K_BKR , K_DK
04080 ENDPROC SKRIV_K_POST
04090
04100 PROC L[S_K_POST ( P )
04110 GET KASSE $ , P + 1 : K_BKTO $ , K_LKOD $ , K_MKOD $ , K_BNR $ , K_TXT $ , K_BKR , K_DK
04120 ENDPROC L[S_K_POST
04130
04140 PROC L[S_KONTO ( P )
04150 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
04160 ENDPROC L[S_KONTO
04170
04180 PROC ST_BGST ( REF RST $ )
04190 FOR I := 1 TO ( RST $ ) DO
04200 IF RST $ ( I ) =< "}" AND RST $ ( I ) >= "a" THEN LET RST $ ( I ) := CHR$ ( ╱cc╱ ( RST $ ( I ) ) - 32 )
04210 NEXT I
04220 ENDPROC ST_BGST
04230 PROC RET_POSTER
04240 GET KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
04250 LET K := 0
04260 WHILE K < K_H\JREC - 1 DO
04270 IF ( K + 12 ) MOD 12 = 0 THEN EXEC KASSEHOVED
04280 LET K := K + 1
04290 EXEC L[S_K_POST ( K )
04300 EXEC SKRIV_LIN ( K )
04310 IF K MOD 12 = 0 OR K = K_H\JREC - 1 THEN EXEC RET_LINIER
04320 ENDWHILE
04330 ENDPROC RET_POSTER
04340 PROC SIDE_SKIFT
04350 FOR I := LIN_T TO AX_LIN DO PRINT
04360 LET LIN_T := 9
04430 PRINT
04380 PRINT "***…" ; SYST_NAVN $ ; "…***"
04390 PRINT
04400 PRINT "<S>Firmanavn:…" ; FIRMANAVN $ ; TAB ( 42 )
04410 PRINT "**…KASSEKLADDE…PR.…" ; K_BDAT $ ( 1 : 2 ) ; "." ; K_BDAT $ ( 3 : 2 ) ; "." ;
04420 PRINT K_BDAT $ ( 5 : 2 ) ; "…**…………**…UDSKREVET…PR.…" ; SYST_DAT $ ( 1 : 2 ) ; "." ;
04430 PRINT SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…**…"
04440 PRINT
04450 LET SVAR $ := "-----------------"
04460 LET K := ╱cb╱ ( "…" + KASSE_KTO $ + "…KASSE…" ) ; I := K DIV 2 ; K := 22 - K - I
04470 PRINT "<S>" ; TAB ( 37 ) ; SVAR $ ( 1 : I ) ; "…" ; KASSE_KTO $ ; "…KASSE…" ; SVAR $ ( 1 : K ) ; "……"
04480 LET K := ╱cb╱ ( "…" + BANK_KTO $ + "…BANK…" ) ; I := K DIV 2 ; K := 22 - K - I
04490 PRINT "<S>" ; SVAR $ ( 1 : I ) ; "…" ; BANK_KTO $ ; "…BANK…" ; SVAR $ ( 1 : K ) ; "……"
04500 LET K := ╱cb╱ ( "…" + GIRO_KTO $ + "…GIRO…" ) ; I := K DIV 2 ; K := 22 - K - I
04510 PRINT SVAR $ ( 1 : I ) ; "…" ; GIRO_KTO $ ; "…GIRO…" ; SVAR $ ( 1 : K )
04580 PRINT "<S>BILAG……TEKST……………………………………………MK……INDBETALT…………UDBETALT………"
04530 PRINT "……INDSAT………………H[VET…………………INDSAT………………H[VET……………KONTONR"
04540 EXEC SLUT_LINIE
04550 ENDPROC SIDE_SKIFT
04560
04570 PROC PRINT_LINIE
04580 IF K_BNR $ = "*****" THEN EXIT
04590 IF LIN_T + 15 >= MAX_LIN THEN EXEC TRANSPORT
04600 LET LIN_T := LIN_T + 1
04610 PRINT "<S>" ; K_BNR $ ; TAB ( 11 ) ; K_TXT $ ; TAB ( 33 ) ; K_MKOD $ ; TAB ( 36 )
04620 CASE K_LKOD $ OF
04630 WHILE "K"
04640 // DO…NOTHING
04650 LET T_IDX := 1
04660 WHILE "B"
04670 PRINT TAB ( 25 ) ;
04680 LET T_IDX := 3
04690 WHILE "G"
04700 PRINT TAB ( 49 ) ;
04710 LET T_IDX := 5
04720 ENDCASE
04730 IF _DK = DEBET THEN
04740 PRINT USING "########.##" : K_BKR ;
04750 LET TOT ( T_IDX ) := TOT ( T_IDX ) + K_BKR
04760 ELSE
04770 PRINT USING "…………………………………#######.##" : K_BKR ;
04780 LET TOT ( T_IDX + 1 ) := TOT ( T_IDX + 1 ) + K_BKR
04790 ENDIF
04800 IF _BKTO $ + "/" IN KASSE_KTO $ + "/" + BANK_KTO $ + "/" + GIRO_KTO $ + "/" THEN
04810 PRINT "<N>"
04820 PRINT "<S>" ; TAB ( 36 )
04830 CASE K_BKTO $ OF
04840 WHILE KASSE_KTO $
04850 // DO…NOTHING
04860 LET T_IDX := 1
04870 WHILE BANK_KTO $
04880 PRINT "<S>" ; TAB ( 28 )
04890 LET T_IDX := 3
04900 WHILE GIRO_KTO $
04910 PRINT "<S>" ; TAB ( 52 )
04920 LET T_IDX := 5
04930 ENDCASE
04940 IF _DK = DEBET THEN
04950 PRINT USING "………………………………########.##" : K_BKR
04960 LET TOT ( T_IDX + 1 ) := TOT ( T_IDX + 1 ) + K_BKR
04970 ELSE
04980 PRINT USING "########.##" : K_BKR
04990 LET TOT ( T_IDX ) := TOT ( T_IDX ) + K_BKR
05000 ENDIF
05010 ELSE
05020 PRINT TAB ( 73 ) ;
05030 PRINT "<S>…"
05040 PRINT K_BKTO $
05050 ENDIF
05060 ENDPROC PRINT_LINIE
05070
05080 PROC SLUT_LINIE
05150 PRINT "<S>-----……--------------------……--……----------……----------……"
05100 PRINT "----------……----------……----------……----------……--------"
05110 ENDPROC SLUT_LINIE
05120
05130 PROC TRANSPORT
05140 IF IN_T = 100 THEN
05150 EXEC SIDE_SKIFT
05160 ELSE
05170 EXEC SLUT_LINIE
05180 LET LIN_T := LIN_T + 2
05190 PRINT "<S>" ; TAB ( 11 ) ; "TRANSPORT" ; TAB ( 36 )
05200 PRINT USING "<S>########.##…########.##…" : TOT ( 1 ) , TOT ( 2 )
05210 PRINT USING "<S>########.##…########.##…" : TOT ( 3 ) , TOT ( 4 )
05220 PRINT USING "########.##…########.##" : TOT ( 5 ) , TOT ( 6 )
05230 EXEC SIDE_SKIFT
05240 LET LIN_T := LIN_T + 1
05250 PRINT "<S>" ; TAB ( 11 ) ; "TRANSPORT" ; TAB ( 36 )
05260 PRINT USING "<S>########.##…########.##…" : TOT ( 1 ) , TOT ( 2 )
05270 PRINT USING "<S>########.##…########.##…" : TOT ( 3 ) , TOT ( 4 )
05280 PRINT USING "########.##…########.##…" : TOT ( 5 ) , TOT ( 6 )
05350 ENDIF
05360 ENDPROC TRANSPORT
05370
05380 PROC UDSKRIV_POSTER
05390 EXEC OVERSKRIFT ( "Udskrivning…af…kassekladde" , 7 )
05400 EXEC PRINTRES ( "EDB-liste" , 12 )
05410 LET TOT ( 1 ) , TOT ( 2 ) , TOT ( 3 ) , TOT ( 4 ) , TOT ( 5 ) , TOT ( 6 ) := 0 ; LIN_T := 100 ; MAX_LIN := 51
05360 GET KASSE $ , 1 : K_H\JREC , K_MAXREC , S_NR_KASSE , K_BDAT $
05370 FOR J := 1 TO _H\JREC - 1 DO
05380 EXEC L[S_K_POST ( J )
05390 EXEC PRINT_LINIE
05400 NEXT J
05410 IF LIN_T >< 100 THEN EXEC AFSLUT
05420 EXEC PRINTREL
05430 ENDPROC UDSKRIV_POSTER
05440
05450 PROC AFSLUT
05460 EXEC SLUT_LINIE
05470 LET LIN_T := LIN_T + 6
05480 PRINT "<S>" ; TAB ( 11 ) ; "DAGENS…BEV[GELSER…" ; TAB ( 35 )
05490 PRINT "<S>" ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; CHR$ ( TOT ( 2 ) , 9 , 2 )
05500 PRINT "<S>" ; CHR$ ( TOT ( 3 ) , 9 , 2 ) ; CHR$ ( TOT ( 4 ) , 9 , 2 )
05510 PRINT CHR$ ( TOT ( 5 ) , 9 , 2 ) ; CHR$ ( TOT ( 6 ) , 9 , 2 )
05520 PRINT
05530 PRINT "<S>" ; TAB ( 11 ) ; "BEHOLDNING…MORGEN" ; TAB ( 35 )
05540 EXEC FIND_KTO ( KASSE_KTO $ )
05550 EXEC L[S_KONTO ( RECNR )
05560 PRINT "<S>" ; CHR$ ( KTO_ULTIMO , 9 , 2 ) ; TAB ( 28 )
05570 LET TOT ( 1 ) := TOT ( 1 ) + KTO_ULTIMO
05580 EXEC FIND_KTO ( BANK_KTO $ )
05590 EXEC L[S_KONTO ( RECNR )
05600 PRINT "<S>" ; CHR$ ( KTO_ULTIMO , 9 , 2 ) ; TAB ( 28 )
05610 LET TOT ( 3 ) := TOT ( 3 ) + KTO_ULTIMO
05620 EXEC FIND_KTO ( GIRO_KTO $ )
05630 EXEC L[S_KONTO ( RECNR )
05640 PRINT CHR$ ( KTO_ULTIMO , 9 , 2 )
05650 LET TOT ( 5 ) := TOT ( 5 ) + KTO_ULTIMO
05660 PRINT "<S>" ; TAB ( 11 ) ; "BEHOLDNING…AFTEN(ber.)" ; TAB ( 47 )
05670 PRINT "<S>" ; CHR$ ( TOT ( 1 ) - TOT ( 2 ) , 9 , 2 ) ; TAB ( 28 )
05680 PRINT "<S>" ; CHR$ ( TOT ( 3 ) - TOT ( 4 ) , 9 , 2 ) ; TAB ( 28 )
05690 PRINT CHR$ ( TOT ( 5 ) - TOT ( 6 ) , 9 , 2 )
05700 PRINT "<S>………………………………………………………………………………………----------……----------……"
05710 PRINT "----------……----------……----------……----------"
05720 PRINT "<S>" ; TAB ( 11 ) ; "BALANCE" ; TAB ( 35 )
05730 PRINT CHR$ ( TOT ( 1 ) , 9 , 2 ) ; CHR$ ( TOT ( 1 ) , 9 , 2 ) ; CHR$ ( TOT ( 3 ) , 9 , 2 ) ;
05740 PRINT CHR$ ( TOT ( 3 ) , 9 , 2 ) ; CHR$ ( TOT ( 5 ) , 9 , 2 ) ; CHR$ ( TOT ( 5 ) , 9 , 2 )
05760 FOR I := LIN_T TO AX_LIN DO PRINT
05770 ENDPROC AFSLUT
05780
05790 PROC FIND_KTO ( REF R_KTONR $ )
05800 LET OK := FALSE
05810 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
05820 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
05830 IF IGH > 1 THEN
05840 REPEAT
05850 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
05860 GET KTOIDX $ , POS : KTONR $ , RECNR
05870 IF TONR $ > R_KTONR $ THEN
05880 LET HIGH := POS
05890 ELSE
05900 IF TONR $ < R_KTONR $ THEN
05910 LET LOW := POS
05920 ENDIF
05930 ENDIF
05940 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
05950 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
05960 GET KTOIDX $ , POS : KTONR $ , RECNR
05970 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
05980 ENDIF
05990 LET FIND_KTO := POS
06000 ENDPROC FIND_KTO
06010 //
06070 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
06080 LET PRTNR $ := "1" ; OK := TRUE
06090 REPEAT
06100 CURSOR 15 , LINE
06110 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
06120 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
06130 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
06140 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
06150 INPUT "" : SVAR $
06160 SELECT OUTPUT "P" + PRTNR $
06170 IF ( "P" ) THEN
06180 CURSOR 12 , LINE
06190 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
06200 CURSOR 12 , LINE + 1
06210 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
06220 IF VAR $ = "J" OR SVAR $ = "j" THEN
06230 CURSOR 12 , LINE
06240 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
06250 PRINT "<SZ>"
06260 WHILE ╱cd╱ ( "P" ) DO
06270 LET SEK := ╱ca╱ ( 5 )
06280 SELECT OUTPUT "P" + PRTNR $
06290 ENDWHILE
06300 ELSE
06310 LET OK := FALSE
06320 ENDIF
06330 ENDIF
06340 CURSOR 1 , LINE
06350 PRINT "<Z>"
06360 PRINT "<SZ>"
06370 ENDPROC PRINTRES
06020 //
06030 PROC PRINTREL // RELEASE…PRINTER
06040 SELECT OUTPUT "T"
06050 ENDPROC PRINTREL
04370 PRINT "<K>"
05750 PRINT "<LIN>"
05410 LET TOT ( 1 ) , TOT ( 2 ) , TOT ( 3 ) , TOT ( 4 ) , TOT ( 5 ) , TOT ( 6 ) := 0 ; LIN_T := 100 ; MAX_LIN := 51
05410 LET TOT ( 1 ) , TOT ( 2 ) , TOT ( 3 ) , TOT ( 4 ) , TOT ( 5 ) , TOT ( 6 ) := 0 ; LIN_T := 100 ; MAX_LIN := 72
05400 EXEC PRINTRES ( "papir" , 12 )
01910 PRINT "<C0105>………BILAG……TEKST……………………………………………………KASSE"
01920 PRINT "<C0106>…………NR……………………………………………………………………………BANK/"
02460 LET K_MKOD $ := ""
04520 PRINT "<S>BILAG……TEKST………………………………………………………INDBETALT…………UDBETALT………"
05090 PRINT "<S>-----……------------------------……----------……----------……"
01400 LET PROGRAM $ := PRGFL $ + ":SYSAK" + S_KODE $
05290 ENDIF
05300 ENDPROC TRANSPORT
05310
05320 PROC UDSKRIV_POSTER
05330 EXEC OVERSKRIFT ( "Udskrivning…af…kassekladde" , 7 )
05340 EXEC PRINTRES ( "papir" , 12 )
05350 LET TOT ( 1 ) , TOT ( 2 ) , TOT ( 3 ) , TOT ( 4 ) , TOT ( 5 ) , TOT ( 6 ) := 0 ; LIN_T := 100 ; MAX_LIN := 72
07967 ╱1f╱ ╱1f╱ ESSAKAY:2PD ╱00╱ ╱00╱ ╱11╱ ╱00╱ W ╱00╱ ╱00╱ ╱01╱ ╱00╱ G OR CHAIN ╱17╱ //
06070 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
06080 LET PRTNR $ := "1" ; OK := TRUE
06090 REPEAT
06100 CURSOR 15 , LINE
06110 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
06120 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
06130 CURSOR 1 , LINE
06140 PRINT "<Z>"
06150 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
06160 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
06170 INPUT "" : SVAR $
06180 SELECT OUTPUT "P" + PRTNR $
06190 IF ( "P" ) THEN
06200 CURSOR 12 , LINE
06210 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
06220 CURSOR 12 , LINE + 1
06230 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
06240 IF VAR $ = "J" OR SVAR $ = "j" THEN
06250 CURSOR 12 , LINE
06260 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
06270 PRINT "<SZ>"
06280 WHILE ╱cd╱ ( "P" ) DO
06290 LET SEK := ╱ca╱ ( 5 )
06300 SELECT OUTPUT "P" + PRTNR $
06310 ENDWHILE
06320 ELSE
06330 LET OK := FALSE
06340 ENDIF
06350 ENDIF
06360 CURSOR 1 , LINE
06370 PRINT "<Z>"
06380 PRINT "<SZ>"
06390 ENDPROC PRINTRES
08000 PROC REMOVEBLANK ( REF [[ $ )
08010 LET J := 0
08020 FOR I := 1 TO ( [[ $ ) DO
08030 IF [[ $ ( I ) >< "…" THEN LET J := J + 1 ; [[ $ ( J ) := [[ $ ( I )
08040 NEXT I
08050 ENDPROC REMOVEBLANK
02741 EXEC REMOVEBLANK
02741 EXEC REMOVEBLANK ( SVAR $ )
02585 EXEC REMOVEBLANK ( SVAR $ )
02200 PRINT "<Z>" ; CHR$ ( R_LIN , 2 )
08045 LET [[ $ := [[ $ ( 1 : J )
38382 ╱00╱ ╱00╱