DataMuseum.dk

top - metrics - download

    Length: 21345 (0x5361)
    Types: SPC/1-COMAL-BCD
    Notes: Mikados_B
    Names: »KASRAP«

└─⟦ec8c1e0b0⟧ Bits:30007442 8" floppy ( MIKPROG vol. 1-3, MIKREL vol. 1-3, PCSE 4.7.80 vol 1-3, GL.SYS )
    └─⟦this⟧ »KASRAP« 

SPC/1 COMAL-BCD

0100 DIM OP1 $ ( 12 ) , OP2 $ ( 12 ) , RES $ ( 14 ) , A1 $ ( 12 ) , A2 $ ( 77 ) , A3 $ ( 25 ) , A4 $ ( 17 )
0110 DIM A5 $ ( 17 ) , A6 $ ( 17 ) , A7 $ ( 25 ) , A8 $ ( 12 ) , A9 $ ( 1 ) , B0 $ ( 25 )
0120 DIM B1 $ ( 12 ) , B2 $ ( 12 ) , B3 $ ( 12 ) , B4 $ ( 25 ) , B5 $ ( 25 )
0130 DIM B6 $ ( 17 ) , B7 $ ( 77 ) , B8 $ ( 14 ) , B9 $ ( 12 ) , C0 $ ( 9 ) , C1 $ ( 20 ) , C2 $ ( 17 )
0140 DIM C3 $ ( 12 ) , C4 $ ( 12 ) , C5 $ ( 1 ) , A $ ( 2 ) , C6 $ ( 12 ) , C7 $ ( 1 ) , C8 $ ( 1 )
0150 DIM C9 $ ( 17 ) , D0 $ ( 17 ) , D1 $ ( 17 ) , D2 $ ( 17 ) , D3 $ ( 17 ) , D4 $ ( 26 ) , D5 $ ( 7 ) , D6 $ ( 8 )
0160 DIM D7 $ ( 12 ) , D8 $ ( 12 ) , D9 $ ( 12 ) , E0 $ ( 12 ) , E1 $ ( 12 )
0170 DIM E2 $ ( 17 ) , E3 $ ( 25 ) , E4 $ ( 25 ) , E5 $ ( 18 , 10 ) , E6 $ ( 1 ) , E7 $ ( 6 ) , E8 ( 9 )
0180 DIM E9 $ ( 17 ) , F0 ( 9 ) , F1 $ ( 1 ) , F2 $ ( 1 ) , F3 $ ( 12 ) , F4 $ ( 12 ) , F5 $ ( 6 , 12 )
0190 DIM F6 $ ( 12 ) , F7 $ ( 12 ) , F8 $ ( 25 ) , F9 $ ( 6 , 12 ) , G0 $ ( 1 ) , G1 ( 9 )
0200 DIM G2 ( 18 ) , G3 ( 18 ) , G4 ( 18 ) , G5 ( 18 ) , G6 $ ( 18 , 12 ) , G7 ( 18 ) , G8 $ ( 18 , 25 )
0210 PROC CALC ( G9 , H0 , H1 , H2 )
0220 OP1 $ = H0 $ ; OP2 $ = H1 $ ; RES $ = H2 $ ; SI = 0 ; FLAG = 0 ; ART = G9 - 6 * ( G9 > 5 )
0230 CALL "P641210:REGN"
0240 H2 $ = RES $
0250 IF G9 >< 6 THEN
0260 IF FLAG THEN STOP
0270 ENDIF
0280 ENDPROC
0290 PROC INDTASTNING ( H3 )
0300 REPEAT
0310 CASE H3 OF
0320 STOP
0330 WHEN 1
0340 REPEAT
0350 REPEAT
0360 CURSOR 3 , 23
0370 PRINT "Bilag………………(0:F{rdig,…RETURN:Automatisk,…D:Ny…dato,…A:Annuller)"
0380 CURSOR 8 , 23
0390 INPUT D5 $
0400 EXEC NRTEST ( D5 $ )
0410 UNTIL P >= - 3 AND H4 = 0
0420 IF P >< 0 AND H5 = 19 AND P >< - 2 AND P >< - 3 THEN
0430 CLEAR
0440 EXEC UDHOVED
0450 H5 = 1
0460 EXEC UDLINIE ( H6 , H7 , E4 $ , F4 $ , H8 )
0470 EXEC KYSGEM
0480 H5 = H5 + 1
0490 ENDIF
0500 H9 = - 1
0510 REPEAT
0520 H9 = - 1
0530 CASE P OF
0540 CURSOR 1 , H5 + 3
0550 PRINT USING "###" : H5
0560 H7 = P
0570 P = - 4
0580 I0 = H7
0590 CURSOR 4 , H5 + 3
0600 PRINT USING "#######" : H7
0610 H3 = 2
0620 WHEN 0
0630 H3 = 6
0640 IF I1 = 2 THEN H3 = - 1
0650 P = - 4
0660 WHEN - 1
0670 I0 = I0 + 1
0680 P = I0
0690 H9 = 0
0700 WHEN - 2
0710 EXEC NYDATO
0720 EXEC UDHOVED
0730 WHEN - 3
0740 IF I2 > I3 THEN
0750 I0 = I0 - 1
0760 H5 = H5 - 1
0770 EXEC KLET ( 5 )
0780 EXEC [ND ( 1 , F4 $ , H8 )
0790 I2 = I3 ; I4 = I3 - 1
0800 ENDIF
0810 ENDCASE
0820 UNTIL H9 = - 1
0830 UNTIL P = - 4
0840 WHEN 2
0850 REPEAT
0860 REPEAT
0870 CURSOR 3 , 23
0880 PRINT "Tekst" + B7 $ ( 1 : 27 ) + "(max…25…tegn)" + B7 $ ( 1 : 32 )
0890 CURSOR 9 , 23
0900 INPUT D4 $
0910 I5 = LEN ( D4 $ )
0920 UNTIL I5 =< 25
0930 IF I5 < 3 THEN
0940 EXEC NRTEST ( D4 $ )
0950 ELSE
0960 P = 20 ; H4 = 0
0970 ENDIF
0980 UNTIL P >= 0 AND P < 21 AND H4 = 0 AND P >< 10
0990 IF P >< 0 THEN
1000 I6 = P MOD 10
1010 IF I6 = 0 THEN
1020 P = 10
1030 E3 $ = D4 $
1040 E4 $ = E3 $
1050 ELSE
1060 E4 $ = E5 $ ( I6 ) + B7 $ ( 1 : 15 )
1070 IF P > 10 THEN
1080 REPEAT
1090 CURSOR 3 , 23
1100 PRINT "Tekst" ; B7 $ ( 1 : 16 ) ; "(max…14…tegn)" + B7 $ ( 1 : 43 )
1110 CURSOR 9 , 23
1120 INPUT D4 $
1130 UNTIL LEN ( D4 $ ) < 15
1140 E4 $ ( 12 , 25 ) = D4 $
1150 E3 $ = E4 $
1160 ENDIF
1170 ENDIF
1180 CURSOR 12 , H5 + 3
1190 PRINT E4 $
1200 ELSE
1210 E4 $ = B7 $ ( 1 : 25 )
1220 ENDIF
1230 H3 = 3
1240 I7 = P
1250 WHEN 3
1260 REPEAT
1270 REPEAT
1280 CURSOR 3 , 23
1290 PRINT "Konto………………………(5…cifre)" ; B7 $ ( 1 : 53 )
1300 CURSOR 9 , 23
1310 INPUT D5 $
1320 EXEC NRTEST ( D5 $ )
1330 UNTIL H4 = 0 AND ( I8 >< 0 AND I5 = 5 )
1340 H6 = P
1350 EXEC KTNAVN ( I8 , H6 )
1360 CURSOR 15 , 23
1370 PRINT "(Navn:" ; B7 $ ( 1 : 27 ) ; "Er…konto…rigtig……………(J/N)…………………"
1380 CURSOR 22 , 23
1390 PRINT B4 $
1400 REPEAT
1410 CURSOR 64 , 23
1420 INPUT A $
1430 EXEC NRTEST ( A $ )
1440 UNTIL P = - 7 OR P = - 8
1450 UNTIL P = - 7 AND ( ( I9 = 0 AND I1 = 1 ) OR I1 >< 1 )
1460 IF I9 = 1 THEN
1470 EXEC KLET ( 5 )
1480 H3 = 1 ; I0 = I0 - 1
1490 ELSE
1500 CURSOR 38 , H5 + 3
1510 H3 = 4
1520 IF I1 = 1 THEN H3 = - 1
1530 PRINT USING "######" : H6
1540 ENDIF
1550 WHEN 4
1560 REPEAT
1570 REPEAT
1580 REPEAT
1590 REPEAT
1600 CURSOR 3 , 23
1610 PRINT "Bel|b" ; B7 $ ( 1 : 14 ) ; "(Kredit…indtastes…med…efterstillet…minus)" ;
1620 PRINT B7 $ ( 1 : 16 )
1630 CURSOR 8 , 23
1640 INPUT F3 $
1650 UNTIL LEN ( F3 $ ) > 0
1660 EXEC FORTEGN
1670 EXEC CALC ( 6 , F3 $ , B9 $ , B8 $ )
1680 UNTIL FLAG = 0
1690 EXEC CALC ( 4 , F3 $ , B9 $ , B9 $ )
1700 UNTIL SI >< 0 AND FLAG = 0
1710 I8 = H6 DIV 10000
1720 J0 = 0
1730 D5 $ = F3 $ ( LEN ( F3 $ ) )
1740 IF ( I8 = J1 AND D5 $ = "+" ) OR ( I8 = J2 AND D5 $ = "-" ) THEN
1750 EXEC TESTSALDO ( F3 $ )
1760 ENDIF
1770 UNTIL J0 = 0
1780 F4 $ = F3 $
1790 EXEC KLET ( 3 )
1800 IF D5 $ = "+" THEN
1810 CURSOR 46 , H5 + 3
1820 J3 = 1
1830 ELSE
1840 CURSOR 61 , H5 + 3
1850 J3 = 0
1860 ENDIF
1870 EXEC TUD ( F4 $ , B8 $ , 0 , 0 )
1880 PRINT B8 $
1890 H3 = 5
1900 IF I1 = 1 THEN H3 = - 1
1910 WHEN 5
1920 REPEAT
1930 CURSOR 3 , 23
1940 PRINT "Kode………(0:Annullering,…1:Kasse,…2:Giro,…3:Bank)" + B7 $ ( 1 : 27 )
1950 CURSOR 7 , 23
1960 INPUT D5 $
1970 EXEC NRTEST ( D5 $ )
1980 UNTIL ( P > 0 AND P < 4 ) OR ( P = 0 AND I1 >< 1 )
1990 H8 = P ; H3 = 1
2000 IF H8 = 0 THEN
2010 EXEC KLET ( 5 )
2020 I0 = I0 - 1
2030 ELSE
2040 CURSOR 77 , H5 + 3
2050 PRINT USING "##" : H8
2060 IF I1 >< 1 THEN
2070 EXEC [ND ( 0 , F4 $ , H8 )
2080 H5 = H5 + 1
2090 EXEC GENNYPOST
2100 ENDIF
2110 ENDIF
2120 IF I1 = 1 THEN H3 = - 1
2130 WHEN 6
2140 REPEAT
2150 CURSOR 3 , 23
2160 PRINT "\nskes…afstemning…J/N…" + B7 $ ( 1 : 54 )
2170 CURSOR 22 , 23
2180 INPUT A $
2190 EXEC NRTEST ( A $ )
2200 UNTIL P = - 7 OR P = - 8
2210 EXEC KYSGEM
2220 IF P = - 7 THEN
2230 J4 = 0
2240 FOR I = 1 TO 6
2250 REPEAT
2260 REPEAT
2270 CURSOR 3 , 23
2280 PRINT J5 $ ( I ) ; B7 $ ( 1 : 60 )
2290 CURSOR 17 , 23
2300 INPUT F3 $
2310 UNTIL LEN ( F3 $ ) > 0
2320 EXEC FORTEGN
2330 EXEC CALC ( 6 , F3 $ , B9 $ , B8 $ )
2340 UNTIL FLAG = 0
2350 IF I MOD 2 = 1 THEN
2360 F9 $ ( I ) = F3 $
2370 ELSE
2380 F9 $ ( I ) = F3 $ ( 1 : LEN ( F3 $ ) - 1 ) + "-"
2390 ENDIF
2400 NEXT I
2410 ELSE
2420 J4 = 1
2430 ENDIF
2440 H3 = - 1
2450 ENDCASE
2460 UNTIL H3 = - 1
2470 ENDPROC
2480 PROC GENNYPOST
2490 I3 = I2 ; F1 $ = CHR ( I7 + 48 ) ; F2 $ = CHR ( H8 + 48 )
2500 PUT D2 $ , I2 : H6 , J6 , H7 , F1 $ , F4 $ , F2 $
2510 EXEC FEJL ( 6 , 1 , D2 $ )
2520 I2 = I2 + 1
2530 IF I7 > 9 THEN
2540 PUT D2 $ , I2 : E3 $
2550 EXEC FEJL ( 6 , 2 , D2 $ )
2560 I2 = I2 + 1
2570 ENDIF
2580 I4 = I2 - 1
2590 ENDPROC
2600 PROC HENTKRPOST
2610 J7 = J8 ( J9 , 2 )
2620 GET D1 $ , J7 : K0 , F8 $ , A3 $
2630 EXEC FEJL ( 5 , 1 , D1 $ )
2640 GET D1 $ , J7 + 1 : A5 $ , C7 $ , C8 $ , K1 , F6 $ , F7 $
2650 EXEC FEJL ( 5 , 2 , D1 $ )
2660 ENDPROC
2670 PROC HENTKASPOST
2680 EXEC UDHOVED
2690 IF K2 = I2 THEN K2 = 1
2700 K3 = K2 ; H5 = 1
2710 FOR I = 1 TO 18
2720 GET D2 $ , K2 : G2 ( I ) , G3 ( I ) , G4 ( I ) , F1 $ , G6 $ ( I ) , F2 $
2730 EXEC FEJL ( 2 , 1 , D2 $ )
2740 K2 = K2 + 1
2750 G5 ( I ) = ORD ( F1 $ ) - 48 ; G7 ( I ) = ORD ( F2 $ ) - 48
2760 IF G5 ( I ) > 9 AND G5 ( I ) < 20 THEN
2770 IF I2 = K2 THEN EXIT
2780 GET D2 $ , K2 : G8 $ ( I )
2790 EXEC FEJL ( 2 , 2 , D2 $ )
2800 K2 = K2 + 1
2810 ELSE
2820 IF G5 ( I ) > 0 THEN
2830 G8 $ ( I ) = E5 $ ( G5 ( I ) - 10 * ( G5 ( I ) > 20 ) )
2840 ELSE
2850 G8 $ ( I ) = B7 $ ( 1 : 25 )
2860 ENDIF
2870 ENDIF
2880 IF G2 ( I ) >< 0 THEN EXEC UDLINIE ( G2 ( I ) , G4 ( I ) , G8 $ ( I ) , G6 $ ( I ) , G7 ( I ) )
2890 H5 = H5 + 1
2900 IF K2 = I2 THEN EXIT
2910 NEXT I
2920 ENDPROC
2930 PROC GEMKASPOST
2940 FOR I = 1 TO 18
2950 F1 $ = CHR ( G5 ( I ) + 48 ) ; F2 $ = CHR ( G7 ( I ) + 48 )
2960 PUT D2 $ , K3 : G2 ( I ) , G3 ( I ) , G4 ( I ) , F1 $ , G6 $ ( I ) , F2 $
2970 EXEC FEJL ( 3 , 1 , D2 $ )
2980 K3 = K3 + 1
2990 IF G5 ( I ) > 9 AND G5 ( I ) < 20 THEN
3000 PUT D2 $ , K3 : G8 $ ( I )
3010 EXEC FEJL ( 3 , 2 , D2 $ )
3020 K3 = K3 + 1
3030 ENDIF
3040 IF K3 = K2 THEN EXIT
3050 NEXT I
3060 ENDPROC
3070 PROC [ND ( K4 , K5 , K6 )
3080 J3 = 0 ; B8 $ = K5 $
3090 IF B8 $ ( LEN ( B8 $ ) ) = "+" THEN J3 = 1
3100 J3 = 2 * K6 - J3
3110 EXEC CALC ( K4 , F5 $ ( J3 ) , B8 $ , F5 $ ( J3 ) )
3120 ENDPROC
3130 PROC RETTE
3140 K3 = 1 ; K2 = 1
3150 IF I2 = 1 THEN EXIT
3160 REPEAT
3170 CLEAR
3180 EXEC HENTKASPOST
3190 K7 = H5 ; K8 = 0
3200 REPEAT
3210 REPEAT
3220 CURSOR 3 , 23
3230 PRINT "\nskes…{ndringer…………(1-18:Linienr,…0:F{rdig,…RETURN:Ny…side,…N:" ;
3240 PRINT "Ny…post)……………"
3250 CURSOR 20 , 23
3260 INPUT D5 $
3270 EXEC NRTEST ( D5 $ )
3280 UNTIL ( P = - 8 OR P > - 2 AND P < K7 ) AND H4 = 0
3290 K9 = P
3300 IF K9 < 1 THEN EXIT
3310 K8 = 1
3320 REPEAT
3330 REPEAT
3340 CURSOR 3 , 23
3350 PRINT "Linie:" ; K9 ; "…V{lg…{ndring…………(0:F{rdig,…A:Annuller,…1:Konto,…" ;
3360 PRINT "2:Bel|b,…3:Kode)"
3370 CURSOR 25 , 23
3380 INPUT D5 $
3390 EXEC NRTEST ( D5 $ )
3400 UNTIL ( P = - 3 OR P > - 1 AND P < 4 ) AND H4 = 0
3410 L0 = P
3420 IF L0 = 0 THEN EXIT
3430 H5 = K9
3440 IF G2 ( K9 ) = 0 THEN
3450 CURSOR 3 , H5 + 3
3460 PRINT "Postering…er…annulleret"
3470 ELSE
3480 IF L0 >< 1 THEN EXEC [ND ( 1 , G6 $ ( K9 ) , G7 ( K9 ) )
3490 IF L0 = - 3 THEN
3500 EXEC KLET ( 5 )
3510 G2 ( K9 ) = 0
3520 ELSE
3530 L0 = L0 + 2 ; L1 = L0 ; I1 = 1 ; H6 = G2 ( K9 ) ; F4 $ = G6 $ ( K9 ) ; H8 = G7 ( K9 )
3540 EXEC INDTASTNING ( L0 )
3550 G2 ( K9 ) = H6 ; G6 $ ( K9 ) = F4 $ ; G7 ( K9 ) = H8
3560 IF L1 >< 3 THEN EXEC [ND ( 0 , F4 $ , H8 )
3570 ENDIF
3580 ENDIF
3590 UNTIL L0 = - 3 OR L0 = 0
3600 UNTIL K9 < 1
3610 IF K8 = 1 THEN
3620 EXEC GEMKASPOST
3630 EXEC KYSGEM
3640 ENDIF
3650 UNTIL K9 = 0 OR K9 = - 8
3660 IF K9 = - 8 THEN
3670 CLEAR
3680 EXEC UDHOVED
3690 H5 = 1 ; I1 = 2
3700 EXEC INDTASTNING ( 1 )
3710 ENDIF
3720 ENDPROC
3730 PROC KYSGEM
3740 E8 ( 4 ) = L2 ; E8 ( 8 ) = I0 ; F0 ( 2 ) = I4 ; G1 ( 1 ) = L3
3750 OPEN E2 $ , W
3760 EXEC FEJL ( 3 , 1 , E2 $ )
3770 PUT E2 $ , 2 : E8 ( 1 ) , E8 ( 2 ) , E8 ( 3 ) , E8 ( 4 ) , E8 ( 5 ) , E8 ( 6 ) , E8 ( 7 ) , E8 ( 8 ) , E8 ( 9 )
3780 EXEC FEJL ( 3 , 2 , E2 $ )
3790 PUT E2 $ , 12 : F0 ( 1 ) , F0 ( 2 ) , F0 ( 3 ) , F0 ( 4 ) , F0 ( 5 ) , F0 ( 6 ) , F0 ( 7 ) , F0 ( 8 ) , F0 ( 9 )
3800 EXEC FEJL ( 3 , 3 , E2 $ )
3810 PUT E2 $ , 13 : G1 ( 1 ) , G1 ( 2 ) , G1 ( 3 ) , G1 ( 4 ) , G1 ( 5 ) , G1 ( 6 ) , G1 ( 7 ) , G1 ( 8 ) , G1 ( 9 )
3820 EXEC FEJL ( 3 , 4 , E2 $ )
3830 PUT E2 $ , 15 : F5 $ ( 1 ) , F5 $ ( 2 ) , F5 $ ( 3 )
3840 EXEC FEJL ( 3 , 5 , E2 $ )
3850 PUT E2 $ , 16 : F5 $ ( 4 ) , F5 $ ( 5 ) , F5 $ ( 6 )
3860 EXEC FEJL ( 3 , 6 , E2 $ )
3870 CLOSE E2 $
3880 EXEC FEJL ( 3 , 7 , E2 $ )
3890 ENDPROC
3900 PROC HENTKASPOST1
3910 GET D2 $ , I : H6 , L4 , H7 , F1 $ , F4 $ , F2 $
3920 EXEC FEJL ( 4 , 1 , D2 $ )
3930 I7 = ORD ( F1 $ ) - 48 ; H8 = ORD ( F2 $ ) - 48
3940 IF I7 > 9 AND I7 < 20 THEN
3950 I = I + 1
3960 GET D2 $ , I : E3 $
3970 EXEC FEJL ( 4 , 2 , D2 $ )
3980 ENDIF
3990 ENDPROC
4000 PROC FINDPOST1 ( L5 , Q , L6 , L7 , L8 , L9 )
4010 M0 = L6 DIV 8 ; L8 = M0 ; I9 = 1 ; M1 = L6 DIV 4 ; M2 = L6 DIV 32
4020 REPEAT
4030 IF L7 = L5 ( L8 ) OR M0 = 1 THEN EXIT
4040 M0 = ( M0 + 1 ) DIV 2
4050 L8 = L8 + M0 * ( 1 - 2 * ( L7 < L5 ( L8 ) ) )
4060 IF L8 < 1 THEN L8 = 1
4070 IF L8 > M1 THEN L8 = M1
4080 UNTIL M0 = 0
4090 IF L5 ( L8 ) > L7 THEN L8 = L8 - 1 * ( L8 > 1 )
4100 L8 = M2 + L8
4110 GET L9 $ , L8 : Q ( 1 , 1 ) , Q ( 1 , 2 ) , Q ( 2 , 1 ) , Q ( 2 , 2 ) , Q ( 3 , 1 ) , Q ( 3 , 2 ) , Q ( 4 , 1 ) , Q ( 4 , 2 )
4120 EXEC FEJL ( 1 , 1 , L9 $ )
4130 FOR L8 = 1 TO 4
4140 IF L7 = Q ( L8 , 1 ) THEN EXIT
4150 NEXT L8
4160 IF L8 >< 5 THEN I9 = 0
4170 ENDPROC
4180 PROC INDTAB1 ( Z , M3 , M4 )
4190 M0 = M3 DIV 32
4200 FOR I = 1 TO M0
4210 H = ( I - 1 ) * 8 + 1
4220 GET M4 $ , I : Z ( H ) , Z ( H + 1 ) , Z ( H + 2 ) , Z ( H + 3 ) , Z ( H + 4 ) , Z ( H + 5 ) , Z ( H + 6 ) , Z ( H + 7 )
4230 EXEC FEJL ( 5 , 1 , M4 $ )
4240 NEXT I
4250 ENDPROC
4260 PROC KTNAVN ( M5 , M6 )
4270 I9 = 1
4280 CASE M5 OF
4290 EXEC FINDPOST1 ( M7 , M8 , M9 , M6 , N0 , A6 $ )
4300 IF I9 = 0 THEN
4310 EXEC HENTPOST
4320 B4 $ = B0 $
4330 ENDIF
4340 WHEN J1
4350 IF NOT ( M5 * 10000 =< M6 AND M5 * 10000 + N1 >= M6 ) THEN
4360 EXEC FINDPOST1 ( N2 , N3 , N4 , M6 , N5 , A4 $ )
4370 IF I9 = 0 THEN
4380 EXEC HENTDPOST
4390 B4 $ = A7 $
4400 ENDIF
4410 ENDIF
4420 WHEN J2
4430 IF NOT ( M5 * 1000 =< M6 AND M5 * 1000 + N6 >= M6 ) THEN
4440 EXEC FINDPOST1 ( N7 , J8 , N8 , M6 , J9 , B6 $ )
4450 IF I9 = 0 THEN
4460 EXEC HENTKRPOST
4470 B4 $ = F8 $
4480 ENDIF
4490 ENDIF
4500 ENDCASE
4510 IF I9 = 1 THEN
4520 B4 $ = "Konto…eksisterer…ikke…………"
4530 ENDIF
4540 ENDPROC
4550 PROC TESTSALDO ( N9 )
4560 EXEC KTNAVN ( I8 , H6 )
4570 IF I9 = 0 THEN
4580 J0 = 0
4590 C6 $ = N9 $
4600 IF I8 = J1 THEN
4610 EXEC CALC ( 4 , B3 $ , B9 $ , B9 $ )
4620 IF SI >< 0 THEN
4630 EXEC CALC ( 0 , B3 $ , C6 $ , C6 $ )
4640 ELSE
4650 EXEC CALC ( 4 , B2 $ , B9 $ , B9 $ )
4660 IF SI >< 0 THEN
4670 EXEC CALC ( 0 , B2 $ , C6 $ , C6 $ )
4680 ELSE
4690 EXEC CALC ( 4 , B1 $ , B9 $ , B9 $ )
4700 IF SI >< 0 THEN
4710 EXEC CALC ( 0 , B1 $ , C6 $ , C6 $ )
4720 ELSE
4730 EXEC CALC ( 4 , A8 $ , B9 $ , B9 $ )
4740 IF SI >< 0 THEN
4750 EXEC CALC ( 0 , A8 $ , C6 $ , C6 $ )
4760 ELSE
4770 J0 = 1
4780 C6 $ = "0+"
4790 ENDIF
4800 ENDIF
4810 ENDIF
4820 ENDIF
4830 IF C6 $ ( LEN ( C6 $ ) ) = "-" THEN J0 = 1
4840 ELSE
4850 EXEC CALC ( 4 , F7 $ , B9 $ , B9 $ )
4860 IF SI >< 0 THEN
4870 EXEC CALC ( 0 , F7 $ , C6 $ , C6 $ )
4880 ELSE
4890 EXEC CALC ( 4 , F6 $ , B9 $ , B9 $ )
4900 IF SI >< 0 THEN
4910 EXEC CALC ( 0 , F6 $ , C6 $ , C6 $ )
4920 ELSE
4930 C6 $ = "0+"
4940 ENDIF
4950 ENDIF
4960 IF C6 $ ( LEN ( C6 $ ) ) = "+" THEN J0 = 1
4970 ENDIF
4980 IF J0 = 1 THEN
4990 REPEAT
5000 CURSOR 22 , 23
5010 PRINT "……Er…bel|bet…rigtigt…?…………(J/N)" ; B7 $ ( 1 : 20 )
5020 CURSOR 45 , 23
5030 INPUT "…" , A $
5040 EXEC NRTEST ( A $ )
5050 UNTIL P = - 7 OR P = - 8
5060 IF P = - 7 THEN J0 = 0
5070 ENDIF
5080 ELSE
5090 STOP
5100 ENDIF
5110 ENDPROC
5120 PROC KLET ( O0 )
5130 CASE O0 OF
5140 STOP
5150 WHEN 1
5160 CURSOR 4 , H5 + 3
5170 PRINT B7 $ ( 1 : 32 )
5180 WHEN 2
5190 CURSOR 38 , H5 + 3
5200 PRINT "………………"
5210 WHEN 3
5220 CURSOR 46 , H5 + 3
5230 PRINT B7 $ ( 1 : 28 )
5240 WHEN 4
5250 CURSOR 77 , H5 + 3
5260 PRINT B7 $ ( 1 )
5270 WHEN 5
5280 CURSOR 4 , H5 + 3
5290 PRINT B7 $
5300 ENDCASE
5310 ENDPROC
5320 PROC FORTEGN
5330 I5 = LEN ( F3 $ )
5340 IF I5 = 0 THEN F3 $ = "0+"
5350 IF F3 $ ( I5 ) >< "+" AND F3 $ ( I5 ) >< "-" THEN
5360 F3 $ = F3 $ + "+"
5370 ENDIF
5380 ENDPROC
5390 PROC UDHOVED
5400 CURSOR 35 , 1
5410 PRINT "Kasserapport" ; TAB ( 30 ) ; "Dato:"
5420 CURSOR 72 , 1
5430 PRINT J6
5440 CURSOR 2 , 3
5450 PRINT "Nr……Bilag…Tekst" ; TAB ( 38 ) ; "Konto…………………Debet………………………Kredit" ;
5460 PRINT "…………Kode"
5470 ENDPROC
5480 PROC NYDATO
5490 REPEAT
5500 CURSOR 3 , 23
5510 PRINT "Ny…dato……………………(}}mmdd)" + B7 $ ( 1 : 54 )
5520 CURSOR 11 , 23
5530 INPUT D5 $
5540 EXEC NRTEST ( D5 $ )
5550 UNTIL I8 >= 80 AND ( P MOD 10000 ) DIV 100 < 13 AND P MOD 100 < 32
5560 J6 = P
5570 ENDPROC
5580 PROC UDLINIE ( O1 , O2 , O3 , O4 , O5 )
5590 B8 $ = O4 $
5600 CURSOR 1 , H5 + 3
5610 PRINT USING "###" : H5
5620 IF O2 >< - 1 THEN
5630 CURSOR 4 , H5 + 3
5640 PRINT USING "#######" : O2
5650 ENDIF
5660 CURSOR 12 , H5 + 3
5670 PRINT O3 $
5680 CURSOR 38 , H5 + 3
5690 PRINT O1
5700 IF B8 $ ( LEN ( B8 $ ) ) = "+" THEN
5710 CURSOR 46 , H5 + 3
5720 ELSE
5730 CURSOR 61 , H5 + 3
5740 ENDIF
5750 EXEC TUD ( B8 $ , B8 $ , 0 , 0 )
5760 PRINT B8 $
5770 CURSOR 77 , H5 + 3
5780 PRINT O5
5790 ENDPROC
5800 PROC FEJL ( O6 , O7 , O8 )
5810 IF STATUS ( O8 $ ) >< 0 THEN
5820 PRINT STATUS ( O8 $ ) , O6 , O7 , O8 $
5830 STOP
5840 ENDIF
5850 ENDPROC
5860 PROC HENTDPOST
5870 J7 = N3 ( N5 , 2 )
5880 GET D0 $ , J7 : O9 , A7 $ , A8 $ , A9 $
5890 EXEC FEJL ( 8 , 2 , D0 $ )
5900 IF O9 >< N3 ( N5 , 1 ) THEN STOP
5910 GET D0 $ , J7 + 1 : B1 $ , B2 $ , B3 $ , P0 , C5 $
5920 EXEC FEJL ( 8 , 3 , D0 $ )
5930 GET D0 $ , J7 + 2 : B5 $ , C0 $ , P1 , P2
5940 EXEC FEJL ( 8 , 4 , D0 $ )
5950 GET D0 $ , J7 + 3 : C1 $ , C3 $ , C4 $
5960 EXEC FEJL ( 8 , 5 , D0 $ )
5970 ENDPROC
5980 PROC TUD ( P3 , P4 , P5 , P6 )
5990 C6 $ = P3 $ ; B8 $ = P4 $
6000 EXEC CALC ( 5 , C6 $ , B9 $ , B8 $ )
6010 P4 $ = B8 $
6020 IF P5 = 0 THEN
6030 P4 $ = P4 $ ( 1 : 13 )
6040 ELSE
6050 IF P5 = 1 AND P4 $ ( LEN ( P4 $ ) ) = "+" THEN
6060 P4 $ ( LEN ( P4 $ ) ) = "…"
6070 ENDIF
6080 ENDIF
6090 IF P6 = 1 THEN
6100 P4 $ = P4 $ ( 4 : LEN ( P4 $ ) - 3 )
6110 ENDIF
6120 ENDPROC
6130 PROC NRTEST ( P7 )
6140 P = 0 ; H4 = 0 ; I8 = 0 ; I5 = LEN ( P7 $ )
6150 CASE I5 OF
6160 FOR I = 1 TO I5
6170 P8 = INT ( ORD ( P7 $ ( I ) ) - 48 )
6180 IF P8 >= 0 AND P8 < 10 THEN
6190 P = P * 10 + P8
6200 ELSE
6210 H4 = 1
6220 ENDIF
6230 NEXT I
6240 I8 = P DIV 10000 ; KTAL9 = P DIV 1000
6250 IF KTAL9 = J2 THEN I8 = KTAL9
6260 WHEN 0
6270 P = - 1
6280 WHEN 1
6290 CASE P7 $ OF
6300 P = INT ( ORD ( P7 $ ) - 48 )
6310 WHEN "d" , "D"
6320 P = - 2
6330 WHEN "a" , "A"
6340 P = - 3
6350 WHEN "j" , "J"
6360 P = - 7
6370 WHEN "n" , "N"
6380 P = - 8
6390 ENDCASE
6400 ENDCASE
6410 ENDPROC
6420 PROC HENTPOST
6430 J7 = M8 ( N0 , 2 )
6440 GET C9 $ , J7 : P9 , B0 $
6450 EXEC FEJL ( 3 , 2 , C9 $ )
6460 IF P9 >< M8 ( N0 , 1 ) THEN STOP
6470 GET C9 $ , J7 + 1 : G0 $ , D7 $ , D8 $
6480 EXEC FEJL ( 3 , 3 , C9 $ )
6490 GET C9 $ , J7 + 2 : E6 $ , D9 $ , E0 $
6500 EXEC FEJL ( 3 , 4 , C9 $ )
6510 ENDPROC
6520 PROC BFSTEMNING
6530 REPEAT
6540 CLEAR
6550 CURSOR 21 , 1
6560 PRINT "Kasserapport…afstemning"
6570 CURSOR 66 , 1
6580 PRINT "Dato…:" ; J6
6590 CURSOR 21 , 3
6600 PRINT "Differencer………Indtastede…saldi"
6610 FOR I = 1 TO 6
6620 EXEC CALC ( 1 , F5 $ ( I ) , F9 $ ( I ) , F3 $ )
6630 CURSOR 1 , I + 4
6640 PRINT I ; J5 $ ( I )
6650 CURSOR 19 , I + 4
6660 EXEC TUD ( F3 $ , B8 $ , 1 , 0 )
6670 PRINT B8 $
6680 CURSOR 36 , I + 4
6690 EXEC TUD ( F9 $ ( I ) , B8 $ , 1 , 0 )
6700 PRINT B8 $
6710 NEXT I
6720 CURSOR 4 , 12
6730 PRINT "Kontroller…dine…saldi…!"
6740 REPEAT
6750 CURSOR 4 , 14
6760 PRINT "Hvilken…er…forkert……………(0:ingen,1-6)"
6770 CURSOR 25 , 14
6780 INPUT D5 $
6790 EXEC NRTEST ( D5 $ )
6800 UNTIL - 1 < P AND P < 7 AND H4 = 0
6810 IF P >< 0 THEN
6820 REPEAT
6830 REPEAT
6840 CURSOR 1 , 16
6850 PRINT P ; J5 $ ( P ) ; "……………………………………(tast…{ndret…saldo)"
6860 CURSOR 19 , 16
6870 INPUT F3 $
6880 UNTIL LEN ( F3 $ ) > 0
6890 EXEC FORTEGN
6900 EXEC CALC ( 6 , F3 $ , B9 $ , B8 $ )
6910 UNTIL FLAG = 0
6920 IF P MOD 2 = 0 THEN
6930 F9 $ ( P ) = F3 $ ( 1 : LEN ( F3 $ ) - 1 ) + "-"
6940 ELSE
6950 F9 $ ( P ) = F3 $
6960 ENDIF
6970 Q0 = 0
6980 ELSE
6990 FOR I = 1 TO 6
7000 EXEC CALC ( 1 , F5 $ ( I ) , F9 $ ( I ) , F3 $ )
7010 EXEC CALC ( 4 , F3 $ , B9 $ , B9 $ )
7020 IF SI >< 0 THEN EXIT
7030 NEXT I
7040 IF SI >< 0 THEN
7050 EXEC RETTE
7060 Q0 = 0
7070 ELSE
7080 REPEAT
7090 CURSOR 4 , 16
7100 PRINT "\nskes…{ndringer……………(J/N)"
7110 CURSOR 22 , 16
7120 INPUT A $
7130 EXEC NRTEST ( A $ )
7140 UNTIL ( P = - 7 OR P = - 8 ) AND H4 = 0
7150 IF P = - 7 THEN
7160 EXEC RETTE
7170 Q0 = 0
7180 ELSE
7190 Q0 = - 1
7200 ENDIF
7210 ENDIF
7220 ENDIF
7230 UNTIL Q0 = - 1
7240 ENDPROC
7250 PROC HOVEDUD ( Q1 , Q2 )
7260 EXEC DATOUD ( Q1 , D6 $ )
7270 OUTPUT P
7280 IF R3 = 36 THEN PRINT CHR ( 10 ) ; CHR ( 10 ) ; CHR ( 10 ) ; CHR ( 10 ) ; CHR ( 10 ) ; CHR ( 10 )
7290 PRINT TAB ( 9 ) ; CHR ( 14 ) ; "Kasserapport" ; CHR ( 15 ) ; TAB ( 44 ) ; "Dato:" ; D6 $ ;
7300 PRINT TAB ( 61 ) ;
7310 PRINT USING "Side:####" : Q2
7320 PRINT CHR ( 10 )
7330 PRINT TAB ( 3 ) ; "Bilag" ; TAB ( 10 ) ; "Tekst" ; TAB ( 39 ) ; "Konto" ;
7340 PRINT TAB ( 52 ) ; "Debet" ; TAB ( 67 ) ; "Kredit" ; TAB ( 75 ) ; "Kode"
7350 PRINT TAB ( 3 ) ; A2 $
7360 ENDPROC
7370 PROC LINIEUD ( Q3 , Q4 , Q5 , Q6 , Q7 , Q8 )
7380 IF Q3 >< - 1 THEN
7390 PRINT USING "#######" : Q3 ;
7400 ENDIF
7410 IF Q4 < 10 AND Q4 > 0 THEN
7420 E3 $ = E5 $ ( Q4 ) + B7 $ ( 1 : 15 )
7430 ENDIF
7440 IF Q4 >< 0 THEN
7450 PRINT TAB ( 10 ) ; E3 $ ;
7460 ENDIF
7470 PRINT TAB ( 38 ) ;
7480 PRINT USING "######" : Q5 ;
7490 PRINT TAB ( 47 + 14 * ( Q6 = 0 ) ) ;
7500 EXEC TUD ( Q7 $ , B8 $ , 0 , 0 )
7510 PRINT B8 $ ; TAB ( 76 ) ;
7520 PRINT USING "##" : Q8
7530 ENDPROC
7540 PROC DATOUD ( Q9 , R0 )
7550 R1 = Q9
7560 R0 $ = "……………………"
7570 FOR J = 8 TO 1 STEP - 1
7580 IF J MOD 3 = 0 THEN
7590 R0 $ ( J ) = "."
7600 ELSE
7610 R0 $ ( J ) = CHR ( R1 MOD 10 + 48 )
7620 R1 = R1 DIV 10
7630 ENDIF
7640 NEXT J
7650 ENDPROC
7660 PROC UDSKRIV ( R2 , R3 )
7670 IF R3 = 36 OR R3 = 0 THEN
7680 R2 = R2 + 1
7690 EXEC HOVEDUD ( R4 , R2 )
7700 R3 = 0
7710 ENDIF
7720 R5 = 0
7730 R3 = R3 + 1
7740 IF F4 $ ( LEN ( F4 $ ) ) = "+" THEN R5 = 1
7750 EXEC LINIEUD ( H7 , I7 , H6 , R5 , F4 $ , H8 )
7760 ENDPROC
7770 PROC MODFORTEGN ( R6 , R7 )
7780 I5 = LEN ( R7 $ )
7790 IF R7 $ ( I5 ) = "+" THEN
7800 R6 $ = R7 $ ( 1 : I5 - 1 ) + "-"
7810 ELSE
7820 R6 $ = R7 $ ( 1 : I5 - 1 ) + "+"
7830 ENDIF
7840 ENDPROC
7850 PROC GEMBHPOST
7860 J7 = L3 ; D5 $ = "1"
7870 J7 = J7 + 1
7880 F1 $ = CHR ( I7 + 48 )
7890 PUT D3 $ , J7 : H6 , L4 , H7 , F1 $ , F3 $ , D5 $
7900 EXEC FEJL ( 7 , 2 , D3 $ )
7910 IF I7 >= 10 AND I7 < 20 THEN
7920 J7 = J7 + 1
7930 PUT D3 $ , J7 : H6 , E3 $
7940 EXEC FEJL ( 7 , 3 , D3 $ )
7950 ENDIF
7960 L3 = J7
7970 ENDPROC
7980 PROC BUND
7990 FOR I = R8 TO 36
8000 PRINT CHR ( 10 ) ;
8010 NEXT I
8020 PRINT "…"
8030 PRINT TAB ( 3 ) ; A2 $
8040 EXEC TUD ( A1 $ , B8 $ , 0 , 0 )
8050 PRINT TAB ( 10 ) ; CHR ( 14 ) ; "Difference" ; CHR ( 15 ) ;
8060 PRINT TAB ( 39 + 14 * ( B8 $ ( LEN ( B8 $ ) ) = "-" ) ) ; B8 $
8070 PRINT TAB ( 3 ) ; A2 $
8080 PRINT CHR ( 10 )
8090 ENDPROC
8100 PROC UDBIL
8110 CLEAR
8120 REPEAT
8130 CURSOR 8 , 13
8140 INPUT "Monter…papir…til…udskrift…af…kasserapport…og…tast…RETURN" , A $
8150 UNTIL ORD ( A $ ) = 255
8160 ENDPROC
8170 C2 $ = "P641220:SYSTEM1"
8180 OPEN C2 $ , R
8190 EXEC FEJL ( 9 , 1 , C2 $ )
8200 GET C2 $ , 1 : M9 , N4 , N8
8210 EXEC FEJL ( 9 , 2 , C2 $ )
8220 GET C2 $ , 2 : R9 , S0 , S1
8230 EXEC FEJL ( 9 , 3 , C2 $ )
8240 GET C2 $ , 4 : S2 , S3 , S4 , N1
8250 EXEC FEJL ( 9 , 4 , C2 $ )
8260 GET C2 $ , 5 : N6
8270 EXEC FEJL ( 9 , 5 , C2 $ )
8280 GET C2 $ , 6 : S5 , S6 , S7
8290 EXEC FEJL ( 9 , 6 , C2 $ )
8300 GET C2 $ , 8 : S8 , S9 , T0 , J1
8310 EXEC FEJL ( 9 , 7 , C2 $ )
8320 GET C2 $ , 9 : J2
8330 EXEC FEJL ( 9 , 8 , C2 $ )
8340 GET C2 $ , 10 : E7 $
8350 EXEC FEJL ( 9 , 9 , C2 $ )
8360 GET C2 $ , 11 : A6 $
8370 EXEC FEJL ( 9 , 10 , C2 $ )
8380 GET C2 $ , 12 : A4 $
8390 EXEC FEJL ( 9 , 11 , C2 $ )
8400 GET C2 $ , 13 : B6 $
8410 EXEC FEJL ( 9 , 12 , C2 $ )
8420 GET C2 $ , 15 : C9 $
8430 EXEC FEJL ( 9 , 13 , C2 $ )
8440 GET C2 $ , 16 : D0 $
8450 EXEC FEJL ( 9 , 14 , C2 $ )
8460 GET C2 $ , 17 : D1 $
8470 EXEC FEJL ( 9 , 15 , C2 $ )
8480 GET C2 $ , 19 : D2 $
8490 EXEC FEJL ( 9 , 16 , C2 $ )
8500 GET C2 $ , 21 : D3 $
8510 EXEC FEJL ( 9 , 17 , C2 $ )
8520 GET C2 $ , 36 : E2 $
8530 EXEC FEJL ( 9 , 18 , C2 $ )
8540 CLOSE C2 $
8550 EXEC FEJL ( 9 , 19 , C2 $ )
8560 DIM M7 ( M9 DIV 4 ) , N2 ( N4 DIV 4 ) , N7 ( N8 DIV 4 )
8570 DIM M8 ( 4 , 2 ) , N3 ( 4 , 2 ) , J8 ( 4 , 2 ) , J5 $ ( 6 , 14 )
8580 E2 $ = E7 $ + E2 $
8590 OPEN E2 $ , R
8600 EXEC FEJL ( 9 , 20 , E2 $ )
8610 GET E2 $ , 2 : E8 ( 1 ) , E8 ( 2 ) , E8 ( 3 ) , E8 ( 4 ) , E8 ( 5 ) , E8 ( 6 ) , E8 ( 7 ) , E8 ( 8 ) , E8 ( 9 )
8620 EXEC FEJL ( 9 , 21 , E2 $ )
8630 FOR I = 1 TO 6
8640 J = ( I - 1 ) * 3 + 1
8650 GET E2 $ , I + 5 : E5 $ ( J ) , E5 $ ( J + 1 ) , E5 $ ( J + 2 )
8660 EXEC FEJL ( 9 , 22 , E2 $ )
8670 NEXT I
8680 GET E2 $ , 12 : F0 ( 1 ) , F0 ( 2 ) , F0 ( 3 ) , F0 ( 4 ) , F0 ( 5 ) , F0 ( 6 ) , F0 ( 7 ) , F0 ( 8 ) , F0 ( 9 )
8690 EXEC FEJL ( 9 , 23 , E2 $ )
8700 GET E2 $ , 13 : G1 ( 1 ) , G1 ( 2 ) , G1 ( 3 ) , G1 ( 4 ) , G1 ( 5 ) , G1 ( 6 ) , G1 ( 7 ) , G1 ( 8 ) , G1 ( 9 )
8710 EXEC FEJL ( 9 , 24 , E2 $ )
8720 GET E2 $ , 15 : F5 $ ( 1 ) , F5 $ ( 2 ) , F5 $ ( 3 )
8730 EXEC FEJL ( 9 , 25 , E2 $ )
8740 GET E2 $ , 16 : F5 $ ( 4 ) , F5 $ ( 5 ) , F5 $ ( 6 )
8750 EXEC FEJL ( 9 , 26 , E2 $ )
8760 CLOSE E2 $
8770 EXEC FEJL ( 9 , 27 , E2 $ )
8780 A6 $ = E7 $ + A6 $ ; A4 $ = E7 $ + A4 $ ; B6 $ = E7 $ + B6 $ ; C9 $ = E7 $ + C9 $ ; D0 $ = E7 $ + D0 $ ; D1 $ = E7 $ + D1 $
8790 D2 $ = E7 $ + D2 $ ; D3 $ = E7 $ + D3 $
8800 OPEN A6 $ , R
8810 EXEC FEJL ( 9 , 28 , A6 $ )
8820 OPEN A4 $ , R
8830 EXEC FEJL ( 9 , 29 , A4 $ )
8840 OPEN B6 $ , R
8850 EXEC FEJL ( 9 , 30 , B6 $ )
8860 OPEN C9 $ , R
8870 EXEC FEJL ( 9 , 31 , C9 $ )
8880 OPEN D0 $ , R
8890 EXEC FEJL ( 9 , 32 , D0 $ )
8900 OPEN D1 $ , R
8910 EXEC FEJL ( 9 , 33 , D1 $ )
8920 OPEN D2 $ , W
8930 EXEC FEJL ( 9 , 34 , D2 $ )
8940 EXEC INDTAB1 ( M7 , M9 , A6 $ )
8950 EXEC INDTAB1 ( N2 , N4 , A4 $ )
8960 EXEC INDTAB1 ( N7 , N8 , B6 $ )
8970 J5 $ ( 1 ) = "Kasse…debet………" ; J5 $ ( 2 ) = "Kasse…kredit……" ; J5 $ ( 3 ) = "Giro……debet………"
8980 J5 $ ( 4 ) = "Giro……kredit……" ; J5 $ ( 5 ) = "Bank……debet………" ; J5 $ ( 6 ) = "Bank……kredit……"
8990 B7 $ = "…………………………………………………………………………………………………………" ; B7 $ = B7 $ + B7 $
9000 B9 $ = "0+" ; A1 $ = "0+" ; A2 $ = "--------------------------------------"
9010 I1 = 0 ; A2 $ = A2 $ + A2 $ + "…"
9020 L2 = E8 ( 4 ) ; R4 = E8 ( 7 ) ; I0 = E8 ( 8 ) ; I4 = F0 ( 2 ) ; L3 = G1 ( 1 )
9030 H5 = 1 ; J6 = R4 ; R8 = 0 ; L4 = 0 ; B8 $ = "0+" ; I3 = I4 + 1
9040 I2 = I3 ; K3 = 1 ; K2 = 1
9050 CLEAR
9060 EXEC UDHOVED
9070 EXEC INDTASTNING ( 1 )
9080 IF J4 = 0 THEN
9090 EXEC BFSTEMNING
9100 EXEC UDBIL
9110 OPEN D3 $ , W
9120 EXEC FEJL ( 9 , 37 , D3 $ )
9130 FOR I = 1 TO I4
9140 EXEC HENTKASPOST1
9150 IF H6 >< 0 THEN
9160 EXEC MODFORTEGN ( F3 $ , F4 $ )
9170 EXEC GEMBHPOST
9180 EXEC CALC ( 0 , F3 $ , A1 $ , A1 $ )
9190 EXEC UDSKRIV ( L2 , R8 )
9200 ENDIF
9210 NEXT I
9220 I7 = 24 ; H7 = L2 ; H8 = 0
9230 EXEC CALC ( 0 , F5 $ ( 1 ) , F5 $ ( 2 ) , F3 $ )
9240 EXEC CALC ( 0 , F3 $ , A1 $ , A1 $ )
9250 H6 = S5
9260 EXEC GEMBHPOST
9270 I7 = 10 ; H7 = - 1 ; F4 $ = F3 $ ; E3 $ = "Samlet…kassepostering"
9280 EXEC UDSKRIV ( L2 , R8 )
9290 EXEC CALC ( 0 , F5 $ ( 3 ) , F5 $ ( 4 ) , F3 $ )
9300 EXEC CALC ( 0 , F3 $ , A1 $ , A1 $ )
9310 I7 = 24 ; H7 = L2 ; H6 = S6
9320 EXEC GEMBHPOST
9330 F4 $ = F3 $ ; I7 = 10 ; H7 = - 1 ; E3 $ = "Samlet…giropostering"
9340 EXEC UDSKRIV ( L2 , R8 )
9350 EXEC CALC ( 0 , F5 $ ( 5 ) , F5 $ ( 6 ) , F3 $ )
9360 EXEC CALC ( 0 , F3 $ , A1 $ , A1 $ )
9370 I7 = 24 ; H7 = L2 ; H6 = S7
9380 EXEC GEMBHPOST
9390 E3 $ = "Samlet…bankpostering" ; F4 $ = F3 $ ; I7 = 10 ; H7 = - 1
9400 EXEC UDSKRIV ( L2 , R8 )
9410 EXEC CALC ( 4 , A1 $ , B9 $ , B9 $ )
9420 IF SI >< 0 THEN
9430 I7 = 10 ; H7 = L2 ; H6 = T0 ; E3 $ = "Difference…kasserapport"
9440 EXEC MODFORTEGN ( F3 $ , A1 $ )
9450 EXEC GEMBHPOST
9460 EXEC CALC ( 0 , F3 $ , A1 $ , A1 $ )
9470 F4 $ = F3 $ ; H7 = - 1
9480 EXEC UDSKRIV ( L2 , R8 )
9490 ENDIF
9500 EXEC BUND
9510 CLOSE D3 $
9520 EXEC FEJL ( 9 , 38 , D3 $ )
9530 I4 = 0
9540 FOR I = 1 TO 6
9550 F5 $ ( I ) = "0+"
9560 NEXT I
9570 ELSE
9580 REPEAT
9590 CURSOR 3 , 23
9600 PRINT "\nskes…kontroludskrift…J/N…" ; B7 $ ( 1 : 45 )
9610 CURSOR 26 , 23
9620 INPUT A $
9630 UNTIL ( A $ = "J" OR A $ = "N" OR A $ = "j" OR A $ = "n" ) AND LEN ( A $ ) = 1
9640 IF A $ = "J" OR A $ = "j" THEN
9650 T1 = L2
9660 EXEC UDBIL
9670 FOR I = 1 TO I4
9680 EXEC HENTKASPOST1
9690 EXEC UDSKRIV ( T1 , R8 )
9700 EXEC CALC ( 1 , A1 $ , F4 $ , A1 $ )
9710 NEXT I
9720 I7 = 10 ; H7 = - 1 ; H8 = 0 ; H6 = 0
9730 FOR I = 1 TO 6
9740 E3 $ = J5 $ ( I ) ; F4 $ = F5 $ ( I )
9750 EXEC UDSKRIV ( T1 , R8 )
9760 EXEC CALC ( 0 , A1 $ , F4 $ , A1 $ )
9770 NEXT I
9780 EXEC BUND
9790 ENDIF
9800 ENDIF
9810 EXEC KYSGEM
9820 CLOSE D2 $
9830 EXEC FEJL ( 9 , 39 , D2 $ )
9840 CLOSE
9850 OUTPUT T
9860 CHAIN "P641210:OPSTART"
4d87