DataMuseum.dk

top - download

    Length: 10112 (0x2780)
    Notes: Mikados TextFile, Mikados_K
    Names: »DEBLIST«

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

Text

0100 DIM K1$(17),N$(6),K2$(17),K3$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(2)
0110 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(2),DEBGADE$(25)
0120 DIM BLANK$(77),A$(1),TAL4$(14),TAH$(12),T1(9),DEBTLF$(9),DEBBY$(20)
0130 DIM RES$(14),ÅRKØB$(12),MDNKØB$(12),DSALDI$(12),LK$(3),KG$(3),KTN$(6)
0140 DIM PNR$(6),TY$(1),OP1$(12),OP2$(12),TA$(12),TB$(14),TÅRKØB$(12)
0150 DIM SUM$(12),SUM1$(12),SUM2$(12),SUM3$(12),SUM4$(12),SUM5$(12),SUM6$(12)
0160 DIM TAL1$(14),TAL2$(14),TAL3$(14),KS$(5),DAT$(8),STREG$(78),K4$(17)
0170 DIM K5$(17),LAND$(9,12)
0180 PROC CALC(ART,B1,B2,ES)
0190 OP1$=B1$
0200 OP2$=B2$
0210 RES$=ES$
0220 SI=0
0230 FLAG=0
0240 CALL "P641210:REGN"
0250 ES$=RES$
0260 IF FLAG THEN STOP 
0270 ENDPROC 
0280 PROC FEJL(NR1,NR2,NR3)
0290 IF STATUS(NR3$)<>0 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+1
0360 FOR I=J TO MANTAL DIV 4+J-1
0370 H=(I-J)*4+1;H1=H+1;H2=H+2;H3=H+3
0380 GET L10$,I:T(H,1),T(H,2),T(H1,1),T(H1,2),T(H2,1),T(H2,2),T(H3,1),T(H3,2)
0390 EXEC FEJL(1,1,L10$)
0400 NEXT I
0410 ENDPROC 
0420 PROC HENTDPOST
0430 S=DTAB(DPIL3,2)
0440 GET K3$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
0450 EXEC FEJL(8,2,K3$)
0460 GET K3$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DPOSTNR,DEBLK$
0470 EXEC FEJL(8,3,K3$)
0480 GET K3$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
0490 EXEC FEJL(8,4,K3$)
0500 GET K3$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
0510 EXEC FEJL(8,5,K3$)
0520 ENDPROC 
0530 PROC TUD(BLB,UBLB,TEGN,STØR)
0540 EXEC CALC(5,BLB$,TAH$,UBLB$)
0550 IF TEGN=0 THEN 
0560 UBLB$=UBLB$(1:13)
0570 ELSE 
0580 IF TEGN=1 AND UBLB$(LEN(UBLB$))="+" THEN 
0590 UBLB$(LEN(UBLB$))=" "
0600 ENDIF 
0610 ENDIF 
0620 IF STØR=1 THEN UBLB$=UBLB$(4:LEN(UBLB$)-3)
0630 ENDPROC 
0640 PROC HOVED(GR)
0650 LINIE=LINIE+1
0660 IF LINIE MOD (13*(1+2*(TYPE=2)))=1 THEN 
0670 IF LINIE<>1 THEN PRINT CHR(10);CHR(10)
0680 IF LINIE<>1 AND TYPE=2 THEN PRINT " "
0690 SIDENR=SIDENR+1
0700 PRINT CHR(14);"    Debitor"+KS$+"liste";CHR(15);TAB(25);
0710 IF GR>0 THEN 
0720 PRINT USING "Gruppe:###":GR;
0730 ENDIF 
0740 PRINT TAB(37);"Dato: ";DAT$;
0750 PRINT USING " Side:###":SIDENR
0760 PRINT CHR(10)
0770 IF TYPE=2 THEN 
0780 PRINT " KONTO  NAVN";TAB(37);"POSTNR  BY";TAB(67);"TLF"
0790 PRINT STREG$
0800 ELSE 
0810 PRINT " KONTO   TLF";TAB(28);"SALDO IALT";TAB(44);"0-30 DAGE";
0820 PRINT TAB(56);"60-90 DAGE MÅNEDENS KØB"
0830 PRINT " NAVN";TAB(43);"30-60 DAGE    ÆLDRE      ÅRETS KØB"
0840 PRINT STREG$
0850 ENDIF 
0860 ENDIF 
0870 ENDPROC 
0880 PROC BUND
0890 FOR LINIE=LINIE+1 TO 13*(1+2*(TYPE=2))*SIDENR
0900 IF TYPE=1 THEN 
0910 PRINT CHR(10);CHR(10)
0920 ELSE 
0930 PRINT " "
0940 ENDIF 
0950 NEXT LINIE
0960 IF TYPE=1 THEN 
0970 EXEC TUD(SUM$,TAL1$,1,0)
0980 EXEC TUD(SUM1$,TAL2$,1,0)
0990 EXEC TUD(SUM3$,TAL3$,1,0)
1000 EXEC TUD(SUM5$,TAL4$,1,0)
1010 PRINT TAB(10);CHR(14);"Total";CHR(15);TAB(21);TAL1$,TAB(35);TAL2$;
1020 PRINT TAB(49);TAL3$;TAB(63);TAL4$
1030 EXEC TUD(SUM2$,TAL1$,1,0)
1040 EXEC TUD(SUM4$,TAL2$,1,0)
1050 EXEC TUD(SUM6$,TAL3$,1,0)
1060 PRINT TAB(38);TAL1$;TAB(52);TAL2$;TAB(66);TAL3$
1070 PRINT " "
1080 ELSE 
1090 PRINT CHR(10)
1100 PRINT CHR(10)
1110 ENDIF 
1120 ENDPROC 
1130 PROC UDSKRIV
1140 CASE TYPE OF 
1150 WHEN 1
1160 EXEC CALC(0,DSALDO1$,DSALDO2$,DSALDI$)
1170 EXEC CALC(0,DSALDI$,DSALDO3$,DSALDI$)
1180 EXEC CALC(0,DSALDI$,DSALDO4$,DSALDI$)
1190 EXEC CALC(0,SUM$,DSALDI$,SUM$)
1200 EXEC CALC(0,SUM1$,DSALDO1$,SUM1$)
1210 EXEC CALC(0,SUM2$,DSALDO2$,SUM2$)
1220 EXEC CALC(0,SUM3$,DSALDO3$,SUM3$)
1230 EXEC CALC(0,SUM4$,DSALDO4$,SUM4$)
1240 EXEC CALC(0,SUM5$,MDNKØB$,SUM5$)
1250 TÅRKØB$=ÅRKØB$
1260 EXEC CALC(0,SUM6$,TÅRKØB$,SUM6$)
1270 EXEC TUD(DSALDI$,TAL1$,1,0)
1280 EXEC TUD(DSALDO1$,TAL2$,1,0)
1290 EXEC TUD(DSALDO3$,TAL3$,1,0)
1300 EXEC TUD(MDNKØB$,TAL4$,1,0)
1310 PRINT USING "######   ":DEBNR;
1320 PRINT DEBTLF$;
1330 PRINT TAB(24);TAL1$;TAB(38);TAL2$;TAB(52);TAL3$;TAB(66);TAL4$
1340 EXEC TUD(DSALDO2$,TAL1$,1,0)
1350 EXEC TUD(DSALDO4$,TAL2$,1,0)
1360 EXEC TUD(TÅRKØB$,TAL3$,1,0)
1370 PRINT " ";DEBNAVN$;TAB(38);TAL1$;TAB(52);TAL2$;TAB(66);TAL3$
1380 PRINT " "
1390 WHEN 2
1400 PRINT USING "######  ":DEBNR;
1410 PRINT DEBNAVN$;TAB(34);
1420 PRINT USING "#######    ":DPOSTNR;
1430 PRINT DEBBY$;TAB(67);DEBTLF$
1440 WHEN 3
1450 FOR I=1 TO 4
1460 PRINT CHR(10)
1470 NEXT I
1480 PRINT USING "######   ":DEBNR;
1490 PRINT DEBNAVN$;" "
1500 PRINT " "
1510 PRINT TAB(10);DEBGADE$;" "
1520 PRINT " "
1530 PRINT TAB(7);
1540 PRINT USING "########  ":DPOSTNR;
1550 PRINT DEBBY$;" "
1560 IF DEBLK$>"0" AND DEBLK$<="9" THEN 
1570 PRINT " "
1580 PRINT TAB(9);LAND$(ORD(DEBLK$)-48)
1590 ELSE 
1600 PRINT CHR(10)
1610 ENDIF 
1620 PRINT CHR(10);CHR(10)
1630 ENDCASE 
1640 ENDPROC 
1650 PROC FINDPOST(TAB1,MANT1,NØGL1,PIL3)
1660 PIL1=MANT1 DIV 2;PIL3=PIL1;CEKS=1
1670 REPEAT 
1680 IF NØGL1=TAB1(PIL3,1) OR PIL1=1 THEN EXIT 
1690 PIL1=(PIL1+1) DIV 2;PIL3=PIL3+PIL1*(1-2*(NØGL1<TAB1(PIL3,1)))
1700 IF PIL3<1 THEN PIL3=1
1710 IF PIL3>MANT1 THEN PIL3=MANT1
1720 UNTIL PIL1=0
1730 IF NØGL1=TAB1(PIL3,1) THEN CEKS=0
1740 ENDPROC 
1750 PROC NRTEST(NUM)
1760 P=0;TEST2=0;KTAL=0;L=LEN(NUM$)
1770 CASE L OF 
1780 FOR J=1 TO L
1790 P1=INT(ORD(NUM$(J))-48)
1800 IF P1=>0 AND P1<=9 THEN 
1810 P=P*10+P1
1820 ELSE 
1830 TEST2=1
1840 ENDIF 
1850 NEXT J
1860 KTAL=P DIV 10000
1870 WHEN 0
1880 P=-1
1890 WHEN 1
1900 CASE NUM$ OF 
1910 P=INT(ORD(NUM$)-48)
1920 WHEN "j","J"
1930 P=-7
1940 WHEN "n","N"
1950 P=-8
1960 ENDCASE 
1970 ENDCASE 
1980 ENDPROC 
1990 K1$="P641220:SYSTEM1"
2000 OPEN K1$,R
2010 EXEC FEJL(9,1,K1$)
2020 GET K1$,1:MFANTAL,MDANTAL
2030 EXEC FEJL(9,2,K1$)
2040 GET K1$,4:MKPOST,MFAK,MVGR,MKGR
2050 EXEC FEJL(9,3,K1$)
2060 GET K1$,8:DIVNR,DIVDNR,DIFNR,DTAL
2070 EXEC FEJL(9,4,K1$)
2080 GET K1$,10:N$
2090 EXEC FEJL(9,5,K1$)
2100 GET K1$,12:K2$
2110 EXEC FEJL(9,6,K1$)
2120 GET K1$,16:K3$
2130 EXEC FEJL(9,7,K1$)
2140 GET K1$,35:K4$
2150 EXEC FEJL(9,8,K1$)
2160 GET K1$,36:K5$
2170 EXEC FEJL(9,9,K1$)
2180 CLOSE K1$
2190 EXEC FEJL(9,10,K1$)
2200 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$
2210 OPEN K5$,R
2220 EXEC FEJL(9,11,K5$)
2230 GET K5$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
2240 EXEC FEJL(9,12,K5$)
2250 FOR I=1 TO 3
2260 H=(I-1)*3+1
2270 GET K5$,I+2:LAND$(H),LAND$(H+1),LAND$(H+2)
2280 EXEC FEJL(9,13,K5$)
2290 NEXT I
2300 GET K5$,14:AFIN,ADEB
2310 EXEC FEJL(9,14,K5$)
2320 DIM DTAB(MDANTAL,2),KARRAY(MKGR)
2330 OPEN K4$,R
2340 EXEC FEJL(9,15,K4$)
2350 FOR I=1 TO MKGR DIV 5
2360 J=(I-1)*5+1
2370 GET K4$,I:KARRAY(J),KARRAY(J+1),KARRAY(J+2),KARRAY(J+3),KARRAY(J+4)
2380 EXEC FEJL(9,16,K4$)
2390 NEXT I
2400 CLOSE K4$
2410 EXEC FEJL(9,12,K4$)
2420 OPEN K2$,R
2430 EXEC FEJL(9,18,K2$)
2440 OPEN K3$,R
2450 EXEC FEJL(9,19,K3$)
2460 EXEC INDTAB(DTAB,MDANTAL,K2$)
2470 DA=T1(7)
2480 DAT$="        "
2490 FOR J=8 TO 1 STEP -1
2500 IF J MOD 3=0 THEN 
2510 DAT$(J)="."
2520 ELSE 
2530 DAT$(J)=CHR(DA MOD 10+48)
2540 DA=DA DIV 10
2550 ENDIF 
2560 NEXT J
2570 STREG$="---------------------------------------";STREG$=STREG$+STREG$
2580 REPEAT 
2590 SUM$="0+";SUM1$="0+";SUM2$="0+";SUM3$="0+";SUM4$="0+";SUM5$="0+"
2600 SUM6$="0+";LINIE=0;SIDENR=0
2610 OUTPUT T
2620 CLEAR 
2630 CURSOR 20,1
2640 PRINT "Debitorudskrifter"
2650 CURSOR 11,6
2660 PRINT "0: Færdig"
2670 CURSOR 11,8
2680 PRINT "1: Saldoliste"
2690 CURSOR 11,10
2700 PRINT "2: Kontoliste"
2710 CURSOR 11,12
2720 PRINT "3: Labels"
2730 REPEAT 
2740 CURSOR 13,14
2750 INPUT "Vælg type :",A$
2760 EXEC NRTEST(A$)
2770 UNTIL P>-1 AND P<4
2780 TYPE=P
2790 IF TYPE=0 THEN EXIT 
2800 REPEAT 
2810 CURSOR 13,17
2820 PRINT "Ordnet efter :      (1: Gruppe , 2: Nr)"
2830 CURSOR 26,17
2840 INPUT A$
2850 EXEC NRTEST(A$)
2860 UNTIL P=1 OR P=2
2870 ORDEN=P
2880 REPEAT 
2890 REPEAT 
2900 CURSOR 13,19
2910 IF ORDEN=1 THEN 
2920 PRINT "Fra gruppenr :      (0: Alle)"
2930 ELSE 
2940 PRINT "Fra kontonr  :      (0: Alle)"
2950 ENDIF 
2960 CURSOR 26,19
2970 INPUT KTN$
2980 EXEC NRTEST(KTN$)
2990 UNTIL P=0 OR (P>0 AND P<=MKGR AND ORDEN=1) OR (KTAL=DTAL AND ORDEN=2)
3000 IF ORDEN=1 THEN 
3010 IF P=0 THEN 
3020 FRA=1;TIL=MKGR
3030 ELSE 
3040 FRA=P
3050 ENDIF 
3060 ELSE 
3070 IF P=0 THEN 
3080 FRA=1;TIL=ADEB
3090 ELSE 
3100 IF DTAB(ADEB,1)<P THEN 
3110 FRA=0
3120 ELSE 
3130 EXEC FINDPOST(DTAB,MDANTAL,P,DPIL3)
3140 IF CEKS=0 THEN 
3150 FRA=DPIL3
3160 ELSE 
3170 FRA=DPIL3+1
3180 ENDIF 
3190 ENDIF 
3200 ENDIF 
3210 ENDIF 
3220 UNTIL FRA<>0
3230 IF P>0 THEN 
3240 REPEAT 
3250 REPEAT 
3260 CURSOR 13,21
3270 IF ORDEN=1 THEN 
3280 INPUT "Til gruppenr :",KTN$
3290 ELSE 
3300 INPUT "Til kontonr  :",KTN$
3310 ENDIF 
3320 EXEC NRTEST(KTN$)
3330 UNTIL (P>0 AND P<=MKGR AND ORDEN=1) OR (KTAL=DTAL AND ORDEN=2)
3340 IF ORDEN=1 THEN 
3350 TIL=P
3360 ELSE 
3370 IF DTAB(ADEB,1)<P THEN 
3380 TIL=ADEB
3390 ELSE 
3400 EXEC FINDPOST(DTAB,MDANTAL,P,DPIL3)
3410 TIL=DPIL3
3420 ENDIF 
3430 ENDIF 
3440 UNTIL FRA<=TIL
3450 ENDIF 
3460 CLEAR 
3470 REPEAT 
3480 CURSOR 18,13
3490 INPUT "Monter lister til udskrift og tast RETURN",A$
3500 UNTIL ORD(A$)=255
3510 IF TYPE=1 THEN KS$="saldo"
3520 IF TYPE=2 THEN KS$="konto"
3530 OUTPUT P
3540 IF ORDEN=1 THEN 
3550 FOR H=FRA TO TIL
3560 SUM1$="0+";SUM2$="0+";SUM3$="0+";SUM4$="0+";SUM5$="0+";SUM6$="0+"
3570 SUM$="0+";LINIE=0;SIDENR=0
3580 HKUNDE=KARRAY(H)
3590 REPEAT 
3600 IF HKUNDE=0 THEN EXIT 
3610 IF TYPE<>3 THEN 
3620 EXEC HOVED(H)
3630 ENDIF 
3640 EXEC FINDPOST(DTAB,MDANTAL,HKUNDE,DPIL3)
3650 EXEC HENTDPOST
3660 EXEC UDSKRIV
3670 UNTIL HKUNDE=0
3680 IF TYPE<>3 AND KARRAY(H)<>0 THEN 
3690 EXEC BUND
3700 ENDIF 
3710 NEXT H
3720 ELSE 
3730 FOR DPIL3=FRA TO TIL
3740 IF TYPE<>3 THEN 
3750 EXEC HOVED(0)
3760 ENDIF 
3770 EXEC HENTDPOST
3780 EXEC UDSKRIV
3790 NEXT DPIL3
3800 IF TYPE<>3 THEN 
3810 EXEC BUND
3820 ENDIF 
3830 ENDIF 
3840 UNTIL TYPE=0
3850 CHAIN "P641210:OPSTART"