DataMuseum.dk

top - metrics - download

    Length: 16886 (0x41f6)
    Types: SPC/1-COMAL-80
    Notes: Mikados_B, UNKNOWN_TOKEN_00, UNKNOWN_TOKEN_ca, UNKNOWN_TOKEN_cb, UNKNOWN_TOKEN_cc, UNKNOWN_TOKEN_cd
    Names: »SYSKAY«

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

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
00350 // Hj{lpevariable
00360 REAL TOT ( 6 )
00370 INTEGER HIGH , LOW , POS , KREDIT , DEBET , LIN_T , MAX_LIN , T_IDX , K
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…@@KONTO
00470 DIM KONTO $ OF 17
00480 DIM ST_DATO $ OF 6
00490 INTEGER N_FRIREC , N_MAXREC , ANT_PER , PER_NR
00500 DIM KTO_TYPE $ OF 1 , KTO_NAVN $ OF 40
00510 REAL KTO_PRIMO , KTO_ULTIMO
00520 INTEGER KTO_FP , KTO_SP
00530 // Variable…til…filen…@@KTOIDX
00540 DIM KTOIDX $ OF 17
00550 INTEGER I_H\JREC , I_MAXREC
00560 DIM KTONR $ OF 8
00570 INTEGER RECNR
00580 // Variable…til…filen…@@ST_KTO
00590 DIM ST_KTO $ OF 17
00600 DIM KASSE_KTO $ OF 8 , BANK_KTO $ OF 8 , GIRO_KTO $ OF 8
00610 // Variable…til…filen…@@DG_POS
00620 DIM DG_POS $ OF 17
00630 DIM P_BDAT $ OF 6
00640 REAL P_DEB , P_KRED
00650 INTEGER P_H\JREC , P_MAXREC , S_NR_DG_POS
00660 DIM P_BKTO $ OF 8 , P_MKOD $ OF 1 , P_BNR $ OF 5 , P_TXT $ OF 20
00670 REAL P_BKR
00680 INTEGER P_DK
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 ST_KTO $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "ST_KTO"
00920 LET DG_POS $ := DATAFL $ + ":" + S_KODE $ + T_KODE $ + "DG_POS"
00930 EXEC OPENFIL ( KTOIDX $ , "r" )
00940 EXEC OPENFIL ( KONTO $ , "R" )
00950 EXEC OPENFIL ( DG_POS $ , "W" )
00960 EXEC OPENFIL ( ST_KTO $ , "R" )
00970 GET ST_KTO $ , 1 : KASSE_KTO $
00980 GET ST_KTO $ , 2 : BANK_KTO $
00990 GET ST_KTO $ , 3 : GIRO_KTO $
01000 CLOSE ST_KTO $
01010 ENDPROC INITIER
01020
01030 PROC FUNKTIONSMENU
01040 REPEAT
01050 EXEC OVERSKRIFT ( "Konteringsark" , 6 )
01060 PRINT "<C2009>Indtastning…af…posteringer…………………………IP"
01070 PRINT "<C2011>Udskrivning…af…konteringskladde……………UK"
01080 PRINT "<C2013>Ret…posteringer………………………………………………………RP"
01090 PRINT "<C2015>Bogf|r…posteringer………………………………………………BP"
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 "/IP/ip/UK/uk/RP/rp/BP/bp/" THEN
01170 EXEC FEJL ( "Ulovlig…funktionskode:…'" + SVAR $ ( 1 : 2 ) + "'" )
01180 ENDIF
01190 UNTIL OK
01200 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
01210 CASE SVAR $ ( 1 : 2 ) OF
01220 WHILE "IP" , "ip"
01230 IF _H\JREC > 1 AND P_BDAT $ >< SYST_DAT $ THEN
01240 PRINT "<XC1210>Du…er…begyndt…p}…en…ny…dato…siden…du…sidst…indtastede"
01250 PRINT "<C1211>posteringer…-…posteringerne…skal…bogf|res…f|r…du…kan…"
01260 PRINT "<C1212>indtaste…flere…posteringer."
01270 INPUT "<SC6523>Tryk…RETURN" : SVAR $
01280 ELSE
01290 EXEC INDTAST_POSTER
01300 ENDIF
01310 WHILE "UK" , "uk"
01320 EXEC UDSKRIV_POSTER
01330 WHILE "RP" , "rp"
01340 EXEC RET_POSTER
01350 WHILE "BP" , "bp"
01360 IF P_DEB >< P_KRED THEN EXEC FEJL ( "Ulovlig…bogf|ring…-…debet…<…>…kredit…" )
01370 IF _DEB = 0 AND P_KRED = 0 THEN
01380 EXEC FEJL ( "Ulovlig…bogf|ring…-…ingen…posteringer" )
01390 ENDIF
01400 IF OK THEN
01410 INPUT "<SC6524>Tryk…RETURN" : SVAR $
01420 ELSE
01430 LET PROGRAM $ := PRGFL $ + ":SYSBP"
01440 CHAIN PROGRAM $
01450 ENDIF
01460 OTHERWISE
01470 CHAIN PROGRAM $
01480 ENDCASE
01490 UNTIL FALSE
01500 ENDPROC FUNKTIONSMENU
01510
01520 PROC TERMINAL_IDX
01530 LET PPAR := 5 ; RESRV := 0
01540 CALL :PRES"
01550 GET SYSPARA $ , 1 + RESRV : DATAFL $ , T_KODE $
01560 ENDPROC TERMINAL_IDX
01570
01580 PROC OPENFIL ( FNAVN $ , WAY $ )
01590 REPEAT
01600 IF AY $ = "W" OR WAY $ = "w" THEN
01610 OPEN FNAVN $ , W
01620 ELSE
01630 OPEN FNAVN $ , R
01640 ENDIF
01650 IF ( FNAVN $ ) THEN
01660 PRINT "<SC0123>" ; CHR$ ( 7 )
01670 IF ( FNAVN $ ) = 6 THEN
01680 PRINT "<SC1602>***…Fejl…nr.…6…-…inds{t…diskette…og…tryk…<RETURN>…***"
01690 INPUT "" : SVAR $
01700 ELSE
01710 PRINT "<SC1802>***…Fejl…nr.…" ; CHR$ ( ╱cd╱ ( FNAVN $ ) , 2 ) ; "…ved…}bning…af…"
01720 PRINT "<S>" ; FNAVN $ ; "…***"
01730 INPUT "" : SVAR $
01740 PRINT "<C0102>" ; SPC $
01750 ENDIF
01760 ENDIF
01770 UNTIL NOT ╱cd╱ ( FNAVN $ )
01780 ENDPROC OPENFIL
01790
01800 PROC TAL_CONTROL ( REF RST $ )
01810 LET J := 0 ; OK := TRUE
01820 FOR I := 1 TO ( RST $ ) DO
01830 IF RST $ ( I ) IN TAL $ + "." THEN LET J := J + 1 ; RST $ ( J ) := RST $ ( I )
01840 NEXT I
01850 IF = 0 THEN
01860 LET OK := FALSE
01870 ELSE
01880 LET RST $ := RST $ ( 1 : J )
01890 ENDIF
01900 ENDPROC TAL_CONTROL
01910
01920 PROC DIV_POSHOVED
01930 EXEC OVERSKRIFT ( "INDTASTNING…AF…DIVERSE…POSTERINGER" , 4 )
01940 PRINT "<C0105>………BILAG……TEKST……………………………………………MOMS……KO"
01950 PRINT "<C0106>…………NR……………………………………………………………………KODE……NU"
01960 PRINT "<C0107>----------------------------------------"
01970 PRINT "<C4105>NTO-…………………DEBET………………KREDIT………………F/R/S…"
01980 PRINT "<C4106>MMER……………………………………………………………………………………………"
01990 PRINT "<C4107>----------------------------------------"
02000 ENDPROC DIV_POSHOVED
02010
02020 PROC OVERSKRIFT ( ST $ , L )
02030 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
02040 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
02050 PRINT SYST_DAT $ ( 5 : 2 )
02060 CURSOR 34 - INT ( ╱cb╱ ( ST $ ) / 2 ) , L
02070 PRINT "***…" ; ST $ ; "…***"
02080 ENDPROC OVERSKRIFT
02090
02100 PROC SL_FEJLLINIE
02110 LET OK := TRUE
02120 PRINT "<C0102>" ; SPC $
02130 ENDPROC SL_FEJLLINIE
02140
02150 PROC FEJL ( ST $ )
02160 LET OK := FALSE
02170 CURSOR 36 - ╱cb╱ ( ST $ ) / 2 , 2
02180 PRINT "***…" + ST $ + "…***" ; CHR$ ( 7 )
02190 ENDPROC FEJL
02200
02210 PROC RET_LINIER
02220 REPEAT
02230 PRINT "<SC0123>" ; SPC $ ( 1 : 78 )
02240 LET SVAR $ := "j"
02250 EDIT "<SC1723>Ok…(j)…eller…linienummer…der…skal…rettes?…" : SVAR $
02260 IF "/" + SVAR $ + "/" IN "/J/j/" THEN
02270 EXEC TAL_CONTROL ( SVAR $ )
02280 IF K THEN
02290 IF ( SVAR $ ) < P_H\JREC AND ASC ( SVAR $ ) > 0 THEN
02300 EXEC EDIT_LIN ( ASC ( SVAR $ ) )
02310 ENDIF
02320 ENDIF
02330 ENDIF
02340 UNTIL "/" + SVAR $ + "/" IN "/J/j/"
02350 ENDPROC RET_LINIER
02360
02370 PROC L[S_KONTO ( P )
02380 GET KONTO $ , P : KTO_TYPE $ , KTO_NAVN $ , KTO_PRIMO , KTO_ULTIMO , KTO_FP , KTO_SP
02390 ENDPROC L[S_KONTO
02400
02410 PROC ST_BGST ( REF RST $ )
02420 FOR I := 1 TO ( RST $ ) DO
02430 IF RST $ ( I ) =< "}" AND RST $ ( I ) >= "a" THEN LET RST $ ( I ) := CHR$ ( ╱cc╱ ( RST $ ( I ) ) - 32 )
02440 NEXT I
02450 ENDPROC ST_BGST
02460
02470 PROC INDTAST_POSTER
02480 EXEC SKRIV_LINIER
02490 LET SVAR $ := "F"
02500 WHILE SVAR $ = "F" DO
02510 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
02520 IF P_H\JREC = 1 THEN LET P_BDAT $ := SYST_DAT $ ; P_DEB , P_KRED := 0
02530 IF _H\JREC = P_MAXREC THEN
02540 EXEC FEJL ( "Der…kan…ikke…indtastes…flere…posteringer…f|r…bogf|ring" )
02550 INPUT "<SC6524>Tryk…RETURN" : SVAR $
02560 EXEC SL_FEJLLINIE
02570 EXIT
02580 ENDIF
02590 LET P_H\JREC := P_H\JREC + 1
02600 EXEC EDIT_LIN ( P_H\JREC - 1 )
02610 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
02620 IF P_H\JREC - 1 ) MOD 12 = 0 AND SVAR $ = "F" THEN
02630 EXEC RET_LINIER
02640 EXEC DIV_POSHOVED
02650 LET SVAR $ := "F"
02660 ENDIF
02670 ENDWHILE
02680 EXEC RET_LINIER
02690 ENDPROC INDTAST_POSTER
02700
02710 PROC SKRIV_LINIER
02720 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
02730 EXEC DIV_POSHOVED
02740 FOR I := P_H\JREC - ( P_H\JREC - 1 ) MOD 12 TO _H\JREC - 1 DO
02750 IF > 0 THEN
02760 EXEC L[S_DG_POS ( I )
02770 EXEC SKRIV_LIN ( I )
02780 ENDIF
02790 NEXT I
02800 ENDPROC SKRIV_LINIER
02810
02820 PROC SKRIV_DG_POS ( P )
02830 PUT DG_POS $ , P + 1 : P_BKTO $ , P_MKOD $ , P_BNR $ , P_TXT $ , P_BKR , P_DK
02840 ENDPROC SKRIV_DG_POS
02850
02860 PROC L[S_DG_POS ( P )
02870 GET DG_POS $ , P + 1 : P_BKTO $ , P_MKOD $ , P_BNR $ , P_TXT $ , P_BKR , P_DK
02880 ENDPROC L[S_DG_POS
02890
02900 PROC SKRIV_LIN ( R_LIN )
02910 IF P_BNR $ = "*****" THEN EXIT
02920 LET R_SLIN := R_LIN MOD 12 + 7
02930 IF R_SLIN = 7 THEN LET R_SLIN := 12 + R_SLIN
02940 CURSOR 1 , R_SLIN
02950 PRINT CHR$ ( R_LIN , 2 )
02960 CURSOR 4 , R_SLIN
02970 PRINT P_BNR $
02980 CURSOR 11 , R_SLIN
02990 PRINT P_TXT $
03000 CURSOR 34 , R_SLIN
03010 PRINT P_MKOD $
03020 CURSOR 39 , R_SLIN
03030 PRINT P_BKTO $
03040 IF _DK = DEBET THEN
03050 CURSOR 49 , R_SLIN
03060 ELSE
03070 CURSOR 61 , R_SLIN
03080 ENDIF
03090 PRINT CHR$ ( P_BKR , 7 , 2 )
03100 ENDPROC SKRIV_LIN
03110
03120 PROC EDIT_LIN ( R_LIN )
03130 LET R_SLIN := R_LIN MOD 12 + 7
03140 IF R_SLIN = 7 THEN LET R_SLIN := R_SLIN + 12
03150 EXEC L[S_DG_POS ( R_LIN )
03160 IF _BNR $ = "*****" THEN
03170 LET P_BNR $ := "" ; P_TXT $ := "" ; P_MKOD $ := "" ; P_BKR := 0 ; P_DK := DEBET ; P_BKTO $ := ""
03180 ENDIF
03190 IF _DK = DEBET THEN
03200 LET P_DEB := P_DEB - P_BKR
03210 ELSE
03220 LET P_KRED := P_KRED - P_BKR
03230 ENDIF
03240 REPEAT
03250 EXEC SL_FEJLLINIE
03260 CURSOR 1 , R_SLIN
03270 PRINT CHR$ ( R_LIN , 2 )
03280 REPEAT
03290 CURSOR 4 , R_SLIN
03300 EDIT "" : P_BNR $
03310 EXEC SL_FEJLLINIE
03320 IF _BNR $ = "*****" OR "/" + P_BNR $ + "/" IN "/SLUT/slut/" THEN
03330 LET OK := TRUE
03340 ELSE
03350 EXEC TAL_CONTROL ( P_BNR $ )
03360 IF NOT OK THEN EXEC FEJL ( "Ulovlig…bilagsnummer" )
03370 ENDIF
03380 UNTIL OK
03390 CURSOR 4 , R_SLIN
03400 PRINT SPC $ ( 1 : 5 )
03410 CURSOR 4 , R_SLIN
03420 IF _BNR $ = "*****" OR "/" + P_BNR $ + "/" IN "/SLUT/slut/" THEN
03430 IF /" + P_BNR $ + "/" IN "/slut/SLUT/" THEN
03440 LET SVAR $ := "S" ; P_BNR $ := "*****" ; P_H\JREC := P_H\JREC - 1
03450 ENDIF
03460 PRINT SPC $ ( 1 : 76 )
03470 EXIT
03480 ELSE
03490 PRINT P_BNR $
03500 ENDIF
03510 CURSOR 11 , R_SLIN
03520 EDIT "" : P_TXT $
03530 REPEAT
03540 CURSOR 34 , R_SLIN
03550 EDIT "" : P_MKOD $
03560 EXEC SL_FEJLLINIE
03570 EXEC ST_BGST ( P_MKOD $ )
03580 IF P_MKOD $ IN "IU…" THEN
03590 EXEC FEJL ( "Ulovlig…momskode:…'" + P_MKOD $ + "'" )
03600 ENDIF
03610 UNTIL OK
03540 REPEAT
03550 CURSOR 39 , R_SLIN
03560 EDIT "" : P_BKTO $
03570 EXEC SL_FEJLLINIE
03580 LET IDXPOS := FIND_KTO ( P_BKTO $ )
03590 IF K THEN
03600 EXEC L[S_KONTO ( RECNR )
03610 IF TO_TYPE $ >< "A" THEN
03620 EXEC FEJL ( "Ulovlig…kontonr…-…kontotype…<…>…'A'" )
03630 ELSE
03720 IF _BKTO $ + "/" IN KASSE_KTO $ + "/" + BANK_KTO $ + "/" + GIRO_KTO $ + "/" THEN
03730 EXEC FEJL ( "Ulovlig…kontonr…-…konto…=…kasse/bank/giro" )
03740 ELSE
03640 PRINT "<C0102>" ; TAB ( 35 - ╱cb╱ ( KTO_NAVN $ ) / 2 ) ; "Konto:…" ; KTO_NAVN $
03760 ENDIF
03650 ENDIF
03660 ELSE
03670 EXEC FEJL ( "Ulovlig…kontonr…-…konto…findes…ikke" )
03680 ENDIF
03690 UNTIL OK
03700 REPEAT
03710 LET SVAR $ := CHR$ ( P_BKR , 7 , 2 )
03720 IF P_BKR = 0 THEN LET SVAR $ := ""
03730 IF _DK = KREDIT THEN
03740 CURSOR 61 , R_SLIN
03750 EDIT "" : SVAR $
03760 EXEC SL_FEJLLINIE
03770 EXEC TAL_CONTROL ( SVAR $ )
03780 IF NOT "." IN SVAR $ THEN LET SVAR $ := SVAR $ + "."
03790 LET P_BKR := INT ( 100 * ASC ( "0" + SVAR $ ) + 0.5 ) / 100
03800 CURSOR 61 , R_SLIN
03810 IF _BKR > 0 THEN
03820 PRINT CHR$ ( P_BKR , 7 , 2 )
03830 ELSE
03840 PRINT SPC $ ( 1 : 10 )
03850 ENDIF
03860 ELSE
03870 LET P_DK := DEBET
03880 CURSOR 49 , R_SLIN
03890 EDIT "" : SVAR $
03900 EXEC SL_FEJLLINIE
03910 EXEC TAL_CONTROL ( SVAR $ )
03920 IF NOT "." IN SVAR $ THEN LET SVAR $ := SVAR $ + "."
03930 LET P_BKR := INT ( 100 * ASC ( "0" + SVAR $ ) + .5 ) / 100
03940 CURSOR 49 , R_SLIN
03950 IF _BKR > 0 THEN
03960 PRINT CHR$ ( P_BKR , 7 , 2 )
03970 ELSE
03980 PRINT SPC $ ( 1 : 10 )
03990 ENDIF
04000 ENDIF
04010 IF P_BKR =< 0 THEN LET P_DK := P_DK * ( - 1 )
04020 UNTIL P_BKR > 0
04030 REPEAT
04040 LET SVAR $ := "f"
04050 CURSOR 77 , R_SLIN
04060 EDIT "" : SVAR $ ( 1 )
04070 EXEC ST_BGST ( SVAR $ )
04080 UNTIL "/" + SVAR $ + "/" IN "/F/S/R/"
04090 UNTIL SVAR $ IN "FS"
04100 IF _DK = DEBET THEN
04110 LET P_DEB := P_DEB + P_BKR
04120 ELSE
04130 LET P_KRED := P_KRED + P_BKR
04140 ENDIF
04150 EXEC SKRIV_DIFF
04160 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
04170 EXEC SKRIV_DG_POS ( R_LIN )
04180 EXEC SL_FEJLLINIE
04190 ENDPROC EDIT_LIN
04200
04210 PROC SKRIV_DIFF
04220 PRINT "<SC0120>" ; SPC $
04230 PRINT "<SC0121>" ; SPC $
04240 PRINT "<SC2220>Debet/kredit…total…………………" ; CHR$ ( P_DEB , 9 , 2 )
04250 PRINT CHR$ ( P_KRED , 9 , 2 )
04260 IF _DEB < P_KRED THEN
04270 PRINT "<SC2221>Difference………………………………………" ; CHR$ ( P_KRED - P_DEB , 9 , 2 )
04280 ELSE
04290 IF _KRED < P_DEB THEN
04300 PRINT "<SC2221>Difference"
04310 PRINT "<SC5921>" ; CHR$ ( P_DEB - P_KRED , 9 , 2 )
04320 ENDIF
04330 ENDIF
04340 ENDPROC SKRIV_DIFF
04350
04360 PROC RET_POSTER
04370 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
04380 LET K := 0
04390 WHILE K < P_H\JREC - 1 DO
04400 IF ( K + 12 ) MOD 12 = 0 THEN EXEC DIV_POSHOVED
04410 LET K := K + 1
04420 EXEC L[S_DG_POS ( K )
04430 EXEC SKRIV_LIN ( K )
04440 IF K MOD 12 = 0 OR K = P_H\JREC - 1 THEN EXEC RET_LINIER
04450 ENDWHILE
04460 ENDPROC RET_POSTER
04470
04480 PROC UDSKRIV_POSTER
04490 EXEC OVERSKRIFT ( "Udskrivning…af…konteringskladde" , 7 )
04620 EXEC PRINTRES ( "smal…EDB-liste" , 12 )
04510 LET LIN_T := 100 ; MAX_LIN := 72
04520 GET DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
04530 LET P_DEB , P_KRED := 0
04540 FOR J := 1 TO _H\JREC - 1 DO
04550 EXEC L[S_DG_POS ( J )
04560 EXEC PRINT_LIN
04570 NEXT J
04580 IF LIN_T >< 100 THEN EXEC AFSLUT
04590 EXEC PRINTREL
04600 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
04610 ENDPROC UDSKRIV_POSTER
04620
04630 PROC SIDESKIFT
04640 FOR I := LIN_T TO AX_LIN DO PRINT
04650 LET LIN_T := 9
04660 PRINT "***…" ; SYST_NAVN $ ; "…***"
04670 PRINT
04680 PRINT "Firmanavn:…" ; FIRMANAVN $
04690 PRINT
04700 PRINT "<S>***…KONTERINGSKLADDE…PR.…" ; P_BDAT $ ( 1 : 2 ) ; "." ; P_BDAT $ ( 3 : 2 ) ; "."
04710 PRINT "<S>" ; P_BDAT $ ( 5 : 2 ) ; "…****…UDSKREVET…PR.…"
04720 PRINT SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "." ; SYST_DAT $ ( 5 : 2 ) ; "…***"
04730 PRINT
04860 PRINT "<S>BILAG……TEKST……………………………………………MK……KONTONR……………DEBET………"
04870 PRINT "…………KREDIT……"
04880 PRINT "<S>-----……--------------------……--……--------……----------"
04890 PRINT "……----------"
04900 IF _DEB > 0 OR P_KRED > 0 THEN
04910 PRINT TAB ( 8 ) ; "TRANSPORT" ; TAB ( 41 ) ; CHR$ ( P_DEB , 9 , 2 ) ; CHR$ ( P_KRED , 9 , 2 )
04920 LET LIN_T := LIN_T + 1
04930 ENDIF
04940 ENDPROC SIDESKIFT
04950
04960 PROC PRINT_LIN
04970 IF P_BNR $ = "*****" THEN EXIT
04980 IF IN_T + 5 > MAX_LIN THEN
04990 IF _DEB > 0 OR P_KRED > 0 THEN
05000 PRINT "<S>-----……--------------------……--……--------……----------……"
04890 PRINT "----------"
04900 PRINT TAB ( 9 ) ; "TRANSPORT" ; TAB ( 41 ) ; CHR$ ( P_DEB , 9 , 2 ) ; CHR$ ( P_KRED , 9 , 2 )
04910 LET LIN_T := LIN_T + 2
04920 ENDIF
04930 EXEC SIDESKIFT
04940 ENDIF
04950 LET LIN_T := LIN_T + 1
04960 PRINT "<S>" ; P_BNR $ ; TAB ( 11 ) ; P_TXT $ ; TAB ( 33 ) ; P_MKOD $ ; TAB ( 37 )
04970 PRINT "<S>" ; P_BKTO $ ; TAB ( 14 )
04980 IF _DK = DEBET THEN
04990 PRINT CHR$ ( P_BKR , 7 , 2 )
05000 LET P_DEB := P_DEB + P_BKR
05010 ELSE
05020 PRINT TAB ( 13 ) ; CHR$ ( P_BKR , 7 , 2 )
05030 LET P_KRED := P_KRED + P_BKR
05040 ENDIF
05050 ENDPROC PRINT_LIN
05060
05070 PROC AFSLUT
05080 LET LIN_T := LIN_T + 2
05210 PRINT "<S>-----……--------------------……--……--------……----------……"
05100 PRINT "----------"
05110 PRINT TAB ( 8 ) ; "DEBET/KREDIT…TOTAL" ; TAB ( 42 ) ; CHR$ ( P_DEB , 9 , 2 ) ;
05120 PRINT CHR$ ( P_KRED , 9 , 2 )
05130 IF _DEB > P_KRED THEN
05140 PRINT TAB ( 11 ) ; "DIFFERENCE" ; TAB ( 42 ) ; CHR$ ( P_DEB - P_KRED , 9 , 2 )
05150 LET LIN_T := LIN_T + 1
05160 ELSE
05170 IF _KRED > P_DEB THEN
05180 PRINT TAB ( 11 ) ; "DIFFERENCE" ; TAB ( 54 ) ; CHR$ ( P_KRED - P_DEB , 9 , 2 )
05190 LET LIN_T := LIN_T + 1
05200 ENDIF
05210 ENDIF
05220 FOR I := LIN_T TO AX_LIN DO PRINT
05230 ENDPROC AFSLUT
05240
05250 PROC FIND_KTO ( REF R_KTONR $ )
05260 LET OK := FALSE
05270 GET KTOIDX $ , 1 : I_H\JREC , I_MAXREC
05280 LET LOW := 1 ; HIGH := I_H\JREC ; POS := 2
05290 IF IGH > 1 THEN
05300 REPEAT
05310 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
05320 GET KTOIDX $ , POS : KTONR $ , RECNR
05330 IF TONR $ > R_KTONR $ THEN
05340 LET HIGH := POS
05350 ELSE
05360 IF TONR $ < R_KTONR $ THEN
05370 LET LOW := POS
05380 ENDIF
05390 ENDIF
05400 UNTIL HIGH - LOW =< 1 OR R_KTONR $ = KTONR $
05410 LET POS := INT ( ( HIGH - LOW ) / 2 + .5 ) + LOW
05420 GET KTOIDX $ , POS : KTONR $ , RECNR
05430 IF KTONR $ = R_KTONR $ THEN LET OK := TRUE
05440 ENDIF
05450 LET FIND_KTO := POS
05460 ENDPROC FIND_KTO
05470 //
05600 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
05610 LET PRTNR $ := "1" ; OK := TRUE
05620 REPEAT
05630 CURSOR 15 , LINE
05640 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
05650 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
05660 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
05670 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
05680 INPUT "" : SVAR $
05690 SELECT OUTPUT "P" + PRTNR $
05700 IF ( "P" ) THEN
05710 CURSOR 12 , LINE
05720 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
05730 CURSOR 12 , LINE + 1
05740 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
05750 IF VAR $ = "J" OR SVAR $ = "j" THEN
05760 CURSOR 12 , LINE
05770 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
05780 PRINT "<SZ>"
05790 WHILE ╱cd╱ ( "P" ) DO
05800 LET SEK := ╱ca╱ ( 5 )
05810 SELECT OUTPUT "P" + PRTNR $
05820 ENDWHILE
05830 ELSE
05840 LET OK := FALSE
05850 ENDIF
05860 ENDIF
05870 CURSOR 1 , LINE
05880 PRINT "<Z>"
05890 PRINT "<SZ>"
05900 ENDPROC PRINTRES
05480 //
05490 PROC PRINTREL // RELEASE…PRINTER
05500 SELECT OUTPUT "T"
05510 ENDPROC PRINTREL
01940 PRINT "<C0105>………BILAG……TEKST……………………………………………………………KO"
01950 PRINT "<C0106>…………NR……………………………………………………………………………………NU"
01960 PRINT "<C0107>----------------------------------------"
01970 PRINT "<C4105>NTO-…………………DEBET………………KREDIT………………F/R/S…"
01980 PRINT "<C4106>MMER……………………………………………………………………………………………"
01990 PRINT "<C4107>----------------------------------------"
02000 ENDPROC DIV_POSHOVED
02010
02020 PROC OVERSKRIFT ( ST $ , L )
02030 PRINT "<XC0101>Firmanavn:…" ; FIRMANAVN $
02040 PRINT "<SC6501>Dato:…" ; SYST_DAT $ ( 1 : 2 ) ; "." ; SYST_DAT $ ( 3 : 2 ) ; "."
02050 PRINT SYST_DAT $ ( 5 : 2 )
03530 LET P_MKOD $ := ""
04740 PRINT "<S>BILAG……TEKST………………………………………………………KONTONR……………DEBET………"
04750 PRINT "…………KREDIT……"
04760 PRINT "<S>-----……------------------------……--------……----------"
04770 PRINT "……----------"
04780 IF _DEB > 0 OR P_KRED > 0 THEN
04790 PRINT TAB ( 8 ) ; "TRANSPORT" ; TAB ( 41 ) ; CHR$ ( P_DEB , 9 , 2 ) ; CHR$ ( P_KRED , 9 , 2 )
04800 LET LIN_T := LIN_T + 1
04810 ENDIF
04820 ENDPROC SIDESKIFT
04830
04840 PROC PRINT_LIN
04850 IF P_BNR $ = "*****" THEN EXIT
04860 IF IN_T + 5 > MAX_LIN THEN
04870 IF _DEB > 0 OR P_KRED > 0 THEN
05000 PRINT "<S>-----……--------------------……--……--------……----------……"
04880 PRINT "<S>-----……------------------------……--------……----------……"
05090 PRINT "<S>-----……------------------------……--------……----------……"
04500 EXEC PRINTRES ( "papir" , 12 )
01430 LET PROGRAM $ := PRGFL $ + ":SYSBP" + S_KODE $
05520 //
05530 PROC PRINTRES ( PAGETYPE $ , LINE ) // PRINTER…RESERVATION
05540 LET PRTNR $ := "1" ; OK := TRUE
05550 REPEAT
05560 CURSOR 15 , LINE
05570 EDIT "<Z>Udskrivning…p}…printer…nr.…?…(1/2/3/4)…" : PRTNR $
05580 UNTIL "/" + PRTNR $ + "/" IN "/1/2/3/4/"
05590 CURSOR 1 , LINE
05600 PRINT "<Z>"
05610 CURSOR ( 39 - ╱cb╱ ( PAGETYPE $ ) ) DIV 2 , LINE
05620 PRINT "<SZ>……………Monter…" ; PAGETYPE $ ; "…i…printeren…-…tryk…RETURN…"
05630 INPUT "" : SVAR $
05640 SELECT OUTPUT "P" + PRTNR $
05650 IF ( "P" ) THEN
05660 CURSOR 12 , LINE
05670 PRINT "<SZ>Printeren…er…reserveret…af…en…anden…bruger,"
05680 CURSOR 12 , LINE + 1
05690 INPUT "<SZ>Skal…der…ventes…p}…at…den…bliver…ledig…?…(j/n)…" : SVAR $
05700 IF VAR $ = "J" OR SVAR $ = "j" THEN
05710 CURSOR 12 , LINE
05720 PRINT "<Z>……………Der…ventes…p}…at…printeren…bliver…ledig...."
05730 PRINT "<SZ>"
05740 WHILE ╱cd╱ ( "P" ) DO
05750 LET SEK := ╱ca╱ ( 5 )
05760 SELECT OUTPUT "P" + PRTNR $
05770 ENDWHILE
05780 ELSE
05790 LET OK := FALSE
05800 ENDIF
05810 ENDIF
05820 CURSOR 1 , LINE
05830 PRINT "<Z>"
05840 PRINT "<SZ>"
05850 ENDPROC PRINTRES
03270 PRINT "<Z>" ; CHR$ ( R_LIN , 2 )
04455 PUT DG_POS $ , 1 : P_H\JREC , P_MAXREC , S_NR_DG_POS , P_DEB , P_KRED , P_BDAT $
01995 EXEC SKRIV_DIFF
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
08045 LET [[ $ := [[ $ ( 1 : J )
08050 ENDPROC REMOVEBLANK
03715 EXEC REMOVEBLANK ( SVAR $ )
02215 EXEC SKRIV_DIFF
02485 IF P_H\JREC > 1 THEN EXEC SKRIV_DIFF
38382 ╱00╱ ╱00╱