DataMuseum.dk

top - metrics - download

    Length: 18875 (0x49bb)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSAKY«

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

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