DataMuseum.dk

top - download

    Length: 6860 (0x1acc)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »KRELIST.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »KRELIST.B« 
└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »KRELIST.B« 

SPC/1 COMAL-BIN

0100 DIM OP1$(12),OP2$(12),RES$(15)
0110 DIM KSALDO1$(12),KSALDO2$(12)
0120 DIM K1$(17),N$(6),K2$(17),K3$(17),KRENAVN$(25)
0130 DIM KRELK$(G),KREGADE$(25),KREGR$(G),GEM$(G),TSALDO1$(12),TSALDO2$(12)
0140 DIM BLANK$(77),A$(E),TAL3$(14),TAH$(12),T1(W),KREBY$(20)
0150 DIM KSALDI$(14),LK$(V),KG$(V),KTN$(6),TSALDI$(14)
0160 DIM PNR$(6),TY$(E),TA$(12),TB$(14),DV$(10)
0170 DIM SUM$(12),SUM1$(12),SUM2$(12),SUM3$(12),SUM4$(12),SUM5$(12),SUM6$(12)
0180 DIM TAL1$(14),TAL2$(14),KS$(5),STREG$(78),DAT$(8)
0190 DIM K5$(17),LAND$(W,12),VTAB2(5),SVAR$(E)
0200 PROC CALC(AR3,B1,B2,ES)
0210 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=B;FLAG=B;ART=AR3-6*(AR3>5)
0220 CALL "P641210:REGN"
0230 ES$=RES$
0240 IF AR3<6 THEN
0250 IF FLAG THEN STOP
0260 ENDIF
0270 ENDPROC
0280 PROC FEJL(NR1,NR2,NR3)
0290 IF STATUS(NR3$)<>B THEN
0300 PRINT STATUS(NR3$),NR1,NR2,NR3$
0310 STOP
0320 ENDIF
0330 ENDPROC
0340 PROC INDTAB(T,MANTAL,L10)
0350 J=MANTAL DIV 32+E
0360 FOR I=J TO MANTAL DIV 4+J-E
0370 H=(I-J)*4+E;H1=H+E;H2=H+G;H3=H+V
0380 GET L10$,I:T(H,E),T(H,G),T(H1,E),T(H1,G),T(H2,E),T(H2,G),T(H3,E),T(H3,G)
0390 EXEC FEJL(E,E,L10$)
0400 NEXT I
0410 ENDPROC
0420 PROC HENTKPOST
0430 S=KTAB(KPIL3,G)
0440 GET K3$,S:KRENR,KRENAVN$,KREGADE$
0450 EXEC FEJL(8,G,K3$)
0460 GET K3$,S+E:KREBY$,KRELK$,KREGR$,KREPOSTNR,KSALDO1$,KSALDO2$
0470 EXEC FEJL(8,V,K3$)
0480 ENDPROC
0490 PROC TUD(BLB,UBLB,TEGN,STØR)
0500 EXEC CALC(5,BLB$,TAH$,UBLB$)
0510 IF TEGN=B THEN
0520 UBLB$=UBLB$(E:13)
0530 ELSE
0540 IF TEGN=E AND UBLB$(LEN(UBLB$))="+" THEN
0550 UBLB$(LEN(UBLB$))=" "
0560 ENDIF
0570 ENDIF
0580 IF STØR=E THEN UBLB$=UBLB$(4:LEN(UBLB$)-V)
0590 ENDPROC
0600 PROC HOVED
0610 IF (LINIE=E OR LINIE=41) THEN
0620 SIDENR=SIDENR+E
0630 IF SIDENR>E THEN PRINT " "
0640 IF TYPE<>V THEN
0650 IF LINIE=41 THEN
0660 PRINT " "
0670 PRINT " "
0680 ENDIF
0690 PRINT TAB(67);DV$;" "
0700 PRINT CHR(14);"    Kreditor"+KS$+"liste";CHR(15);TAB(25);
0710 ELSE
0711 IF SIDENR>E THEN
0720 PRINT " "
0730 PRINT " "
0735 ENDIF
0740 PRINT TAB(67);DV$;" "
0750 PRINT CHR(14);"      Forfaldsliste";CHR(15);TAB(25);
0760 ENDIF
0770 PRINT TAB(37);"Dato: ";DAT$;
0780 PRINT USING " Side:###":SIDENR
0790 PRINT " "
0800 ENDIF
0810 IF (TYPE=E OR TYPE=V) AND (LINIE=E OR LINIE=41) THEN
0820 PRINT " KONTO    NAVN";TAB(38);"SALDO IALT";TAB(56);"0-30 DAGE";
0830 PRINT TAB(73);"ÆLDRE"
0840 PRINT STREG$
0850 IF TYPE=E THEN LINIE=E
0860 IF TYPE=V THEN LINIE=G
0870 ENDIF
0880 ENDIF
0890 IF (LINIE=E OR LINIE=41) AND TYPE=G THEN
0900 PRINT " KONTO   NAVN";TAB(34);"ADRESSE";TAB(57);"POSTNR  BY"
0910 PRINT STREG$
0920 LINIE=E
0930 ENDIF
0940 ENDPROC
0950 PROC BUND
0960 IF TYPE=V THEN PRINT " "
0970 EXEC TUD(TSALDO1$,TAL1$,E,B)
0980 EXEC TUD(TSALDO2$,TAL2$,E,B)
0990 EXEC TUD(TSALDI$,TAL3$,E,B)
1000 PRINT TAB(10);CHR(14);"Total";CHR(15);TAB(29);TAL3$;TAB(46);TAL1$;
1010 PRINT TAB(62);TAL2$
1020 PRINT " "
1030 ENDPROC
1040 PROC UDSKRIV
1050 CASE TYPE OF
1060 WHEN E,V
1070 LINIE=LINIE+E
1080 IF TYPE=V THEN LINIE=LINIE+E
1090 EXEC CALC(B,KSALDO1$,TSALDO1$,TSALDO1$)
1100 EXEC CALC(B,KSALDO2$,TSALDO2$,TSALDO2$)
1110 EXEC CALC(B,KSALDO1$,KSALDO2$,KSALDI$)
1120 EXEC CALC(B,TSALDO1$,TSALDO2$,TSALDI$)
1130 EXEC TUD(KSALDO1$,TAL1$,E,E)
1140 EXEC TUD(KSALDO2$,TAL2$,E,E)
1150 EXEC TUD(KSALDI$,TAL3$,E,E)
1170 PRINT USING "######   ":KRENR;
1180 PRINT TAB(11);KRENAVN$;TAB(38);TAL3$;TAB(55);TAL1$;TAB(68);TAL2$
1190 IF TYPE=V THEN PRINT " "
1200 IF LINIE=42 THEN LINIE=41
1210 WHEN G
1220 LINIE=LINIE+E
1230 PRINT USING "######   ":KRENR;
1240 PRINT KRENAVN$;TAB(34);
1250 PRINT KREGADE$;
1260 PRINT TAB(56);KREPOSTNR;
1270 PRINT TAB(63);KREBY$(E:16)
1280 ENDCASE
1290 ENDPROC
1300 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
1310 PIL1=MANT1 DIV G;PIL3=PIL1;CEKS=E
1320 REPEAT
1330 IF NØGL1=TAB1(PIL3,E) OR PIL1=E THEN EXIT
1340 PIL1=(PIL1+E) DIV G;PIL3=PIL3+PIL1*(E-G*(NØGL1<TAB1(PIL3,E)))
1350 IF PIL3<E THEN PIL3=E
1360 IF PIL3>MANT1 THEN PIL3=MANT1
1370 UNTIL PIL1=B
1380 IF NØGL1=TAB1(PIL3,E) THEN CEKS=B
1390 ENDPROC
1400 PROC NRTEST(NUM)
1410 P=B;TEST2=B;KTAL=B;L=LEN(NUM$)
1420 CASE L OF
1430 FOR J=E TO L
1440 P1=INT(ORD(NUM$(J))-48)
1450 IF P1=>B AND P1<=W THEN
1460 P=P*10+P1
1470 ELSE
1480 TEST2=E
1490 ENDIF
1500 NEXT J
1510 KTAL=P DIV 10000;KTAL9=P DIV 1000
1520 IF KRTAL=KTAL9 THEN KTAL=KTAL9
1530 WHEN B
1540 P=-E
1550 WHEN E
1560 CASE NUM$ OF
1570 P=INT(ORD(NUM$)-48)
1580 WHEN "j","J"
1590 P=-7
1600 WHEN "n","N"
1610 P=-8
1620 ENDCASE
1630 ENDCASE
1640 ENDPROC
1650 K1$="P641220:SYSTEM1"
1660 OPEN K1$,R
1670 EXEC FEJL(W,E,K1$)
1680 GET K1$,E:MFANTAL,MDANTAL,MKANTAL
1690 EXEC FEJL(W,G,K1$)
1700 GET K1$,5:MKRGR
1710 EXEC FEJL(W,V,K1$)
1720 GET K1$,W:KRTAL
1730 EXEC FEJL(W,4,K1$)
1740 GET K1$,10:N$
1750 EXEC FEJL(W,5,K1$)
1760 GET K1$,13:K2$
1770 EXEC FEJL(W,6,K1$)
1780 GET K1$,17:K3$
1790 EXEC FEJL(W,7,K1$)
1800 GET K1$,36:K5$
1810 EXEC FEJL(W,8,K1$)
1820 GET K1$,36:K5$
1830 EXEC FEJL(W,W,K1$)
1840 CLOSE K1$
1850 EXEC FEJL(W,10,K1$)
1860 K2$=N$+K2$;K3$=N$+K3$;K5$=N$+K5$
1870 OPEN K5$,R
1880 EXEC FEJL(W,11,K5$)
1890 GET K5$,G:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
1900 EXEC FEJL(W,12,K5$)
1910 FOR I=E TO V
1920 H=(I-E)*V+E
1930 GET K5$,I+G:LAND$(H),LAND$(H+E),LAND$(H+G)
1940 EXEC FEJL(W,13,K5$)
1950 NEXT I
1960 GET K5$,14:AFIN,ADEB,AKRE,VTAB2(E),VTAB2(G),VTAB2(V),VTAB2(4),VTAB2(5)
1970 EXEC FEJL(W,14,K5$)
1980 GET K5$,20:DV$
1990 EXEC FEJL(W,25,K5$)
2000 DIM KTAB(MKANTAL,G)
2010 OPEN K2$,R
2020 EXEC FEJL(W,18,K2$)
2030 OPEN K3$,R
2040 EXEC FEJL(W,19,K3$)
2050 EXEC INDTAB(KTAB,MKANTAL,K2$)
2060 DA=T1(7)
2070 DAT$="        "
2080 FOR J=8 TO E STEP -E
2090 IF J MOD V=B THEN
2100 DAT$(J)="."
2110 ELSE
2120 DAT$(J)=CHR(DA MOD 10+48)
2130 DA=DA DIV 10
2140 ENDIF
2150 NEXT J
2160 STREG$="---------------------------------------";STREG$=STREG$+STREG$
2170 REPEAT
2180 SUM$="0+";SUM1$="0+";SUM2$="0+";SUM3$="0+";SUM4$="0+";SUM5$="0+"
2190 SUM6$="0+";SIDENR=B;TAH$="0+";SI=E
2200 OUTPUT T
2210 CLEAR
2220 CURSOR 20,E
2230 PRINT "Kreditorudskrifter"
2240 CURSOR 11,6
2250 PRINT "0: Færdig"
2260 CURSOR 11,8
2270 PRINT "1: Saldoliste"
2280 CURSOR 11,10
2290 PRINT "2: Kontoliste"
2300 CURSOR 11,12
2310 PRINT "3: Forfaldsliste"
2320 REPEAT
2330 CURSOR 13,14
2340 INPUT "Vælg type :",A$
2350 EXEC NRTEST(A$)
2360 UNTIL P>-E AND P<4
2370 TYPE=P
2380 IF TYPE=B THEN EXIT
2390 REPEAT
2400 REPEAT
2410 CURSOR 13,19
2420 PRINT "Fra kontonr  :      (0: Alle)"
2430 CURSOR 26,19
2440 INPUT KTN$
2450 EXEC NRTEST(KTN$)
2460 UNTIL P=B OR (P>B AND P<=MKRGR) OR KTAL=KRTAL
2470 IF P=B THEN
2480 FRA=E;TIL=AKRE
2490 ELSE
2500 IF KTAB(AKRE,E)<P THEN
2510 FRA=B
2520 ELSE
2530 EXEC FINDPOST(KTAB,MKANTAL,P,KPIL3)
2540 IF CEKS=B OR KTAB(KPIL3,E)>P THEN
2550 FRA=KPIL3
2560 ELSE
2570 FRA=KPIL3+E
2580 ENDIF
2590 ENDIF
2600 ENDIF
2610 UNTIL FRA<>B
2620 IF P>B THEN
2630 REPEAT
2640 REPEAT
2650 CURSOR 13,21
2660 INPUT "Til kontonr  :",KTN$
2670 EXEC NRTEST(KTN$)
2680 UNTIL (P>B AND P<=MKRGR) OR KTAL=KRTAL
2690 IF KTAB(AKRE,E)<P THEN
2700 TIL=AKRE
2710 ELSE
2720 EXEC FINDPOST(KTAB,MKANTAL,P,KPIL3)
2730 TIL=KPIL3
2740 ENDIF
2750 UNTIL FRA<=TIL
2760 ENDIF
2770 CLEAR
2780 REPEAT
2790 CURSOR 18,13
2800 INPUT "Monter lister til udskrift og tast RETURN",A$
2810 UNTIL ORD(A$)=255
2820 IF TYPE=E THEN KS$="saldo"
2830 IF TYPE=G THEN KS$="konto"
2840 OUTPUT P
2850 TSALDO1$="0+";TSALDO2$="0+";TSALDI$="0+";KSALDI$="0+";LINIE=E
2860 IF TYPE<>V THEN
2870 FOR KPIL3=FRA TO TIL
2880 EXEC HOVED
2890 EXEC HENTKPOST
2900 EXEC UDSKRIV
2910 NEXT KPIL3
2920 IF TYPE=E THEN LINIE=LINIE+E
2930 ENDIF
2940 IF TYPE=V THEN
2950 FOR KPIL3=FRA TO TIL
2960 EXEC HOVED
2970 EXEC HENTKPOST
2980 EXEC CALC(4,KSALDO2$,TAH$,TAH$)
2990 IF SI<>B THEN EXEC UDSKRIV
3000 NEXT KPIL3
3010 LINIE=LINIE+E
3020 ENDIF
3030 IF LINIE<41 THEN
3040 REPEAT
3050 PRINT " "
3060 LINIE=LINIE+E
3070 UNTIL LINIE=43
3080 ENDIF
3090 IF TYPE<>G THEN EXEC BUND
3100 IF TYPE=G THEN
3110 PRINT " "
3120 ENDIF
3130 UNTIL TYPE=B
3140 CLEAR
3190 CHAIN "P641210:OPSTART"