DataMuseum.dk

top - download

    Length: 7584 (0x1da0)
    Notes: Mikados TextFile, Mikados_K
    Names: »FJOUR«

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

Text

0100 DIM K1$(17),N$(6),K2$(17),K3$(17),DEBNAVN$(25),DSALDO1$(12),DEBKGR$(1)
0110 DIM DSALDO2$(12),DSALDO3$(12),DSALDO4$(12),DEBLK$(1),DEBGADE$(25)
0120 DIM DEBTLF$(9),DEBBY$(20),SALDO$(12),KR$(25),T$(13),D$(8)
0130 DIM ÅRKØB$(12),MDNKØB$(12),TEK$(13),GBELØB$(12),MOMSH$(12)
0140 DIM KOD1$(1),KOD$(1),TAL4$(14),SVAR1$(1),VARTEKST$(25)
0150 DIM RES$(14),OP1$(12),OP2$(12),TOTAL$(12),BELØB$(12)
0160 DIM TE$(30),TEKO$(1),F$(1),TK1$(1),TAH$(12),BLB2$(12)
0170 DIM K4$(17),K5$(17),K6$(17),K7$(17),T1(9),T2(9)
0180 PROC CALC(AR3,B1,B2,ES)
0190 OP1$=B1$;OP2$=B2$;RES$=ES$;SI=0;FLAG=0;ART=AR3-6*(AR3>5)
0200 CALL "P641210:REGN"
0210 IF AR3<6 THEN 
0220 IF FLAG THEN STOP 
0230 ENDIF 
0240 ES$=RES$
0250 ENDPROC 
0260 PROC FEJL(NR1,NR2,NR3)
0270 IF STATUS(NR3$)<>0 THEN 
0280 PRINT STATUS(NR3$),NR1,NR2,NR3$
0290 STOP 
0300 ENDIF 
0310 ENDPROC 
0320 PROC TUD(BLB1,UBLB1,TEGN,STØR)
0330 BLB2$=BLB1$
0340 EXEC CALC(5,BLB2$,TAH$,UBLB1$)
0350 IF TEGN=0 THEN UBLB1$=UBLB1$(1:13)
0360 IF TEGN=1 AND UBLB1$(LEN(UBLB1$))="+" THEN UBLB1$(LEN(UBLB1$))=" "
0370 IF STØR=1 THEN UBLB1$=UBLB1$(4:LEN(UBLB1$)-3)
0380 PRINT UBLB1$
0390 ENDPROC 
0400 PROC FINDPOST1(TAB4,Q,MANT2,NØGL5,PIL6,L8)
0410 PIL1=MANT2 DIV 8;PIL6=PIL1;CEKS=1;MANT3=MANT2 DIV 4;MANT4=MANT2 DIV 32
0420 REPEAT 
0430 IF NØGL5=TAB4(PIL6) OR PIL1=1 THEN EXIT 
0440 PIL1=(PIL1+1) DIV 2;PIL6=PIL6+PIL1*(1-2*(NØGL5<TAB4(PIL6)))
0450 IF PIL6<1 THEN PIL6=1
0460 IF PIL6>MANT3 THEN PIL6=MANT3
0470 UNTIL PIL1=0
0480 IF TAB4(PIL6)>NØGL5 THEN PIL6=PIL6-1*(PIL6>1)
0490 PIL6=MANT4+PIL6
0500 GET L8$,PIL6:Q(1,1),Q(1,2),Q(2,1),Q(2,2),Q(3,1),Q(3,2),Q(4,1),Q(4,2)
0510 EXEC FEJL(1,1,L8$)
0520 FOR PIL6=1 TO 4
0530 IF NØGL5=Q(PIL6,1) THEN EXIT 
0540 NEXT PIL6
0550 IF PIL6<>5 THEN CEKS=0
0560 ENDPROC 
0570 PROC INDTAB1(Z,MANT5,L7)
0580 PIL1=MANT5 DIV 32
0590 FOR I=1 TO PIL1
0600 H=(I-1)*8+1
0610 GET L7$,I:Z(H),Z(H+1),Z(H+2),Z(H+3),Z(H+4),Z(H+5),Z(H+6),Z(H+7)
0620 EXEC FEJL(2,1,L7$)
0630 NEXT I
0640 ENDPROC 
0650 PROC HENTDPOST
0660 S=DTAB(DPIL3,2)
0670 GET K3$,S:DEBNR,DEBNAVN$,DSALDO1$,DEBKGR$
0680 EXEC FEJL(3,1,K3$)
0690 GET K3$,S+1:DSALDO2$,DSALDO3$,DSALDO4$,DPOSTNR,DEBLK$
0700 EXEC FEJL(3,2,K3$)
0710 GET K3$,S+2:DEBGADE$,DEBTLF$,HPOST,HKUNDE
0720 EXEC FEJL(3,3,K3$)
0730 GET K3$,S+3:DEBBY$,ÅRKØB$,MDNKØB$
0740 EXEC FEJL(3,4,K3$)
0750 ENDPROC 
0760 PROC DATOU(DA)
0770 PRINT TAB(5);
0780 PRINT USING "###.##":(DA MOD 10000)/100;
0790 PRINT TAB(2);
0800 PRINT USING "###.#":(DA DIV 1000)/10;
0810 ENDPROC 
0820 K1$="P641220:SYSTEM1"
0830 OPEN K1$,R
0840 EXEC FEJL(9,1,K1$)
0850 GET K1$,1:MFANTAL,MDANTAL
0860 EXEC FEJL(9,2,K1$)
0870 GET K1$,10:N$
0880 EXEC FEJL(9,3,K1$)
0890 GET K1$,12:K2$
0900 EXEC FEJL(9,4,K1$)
0910 GET K1$,16:K3$
0920 EXEC FEJL(9,5,K1$)
0930 GET K1$,28:K4$
0940 EXEC FEJL(9,6,K1$)
0950 GET K1$,30:K5$
0960 EXEC FEJL(9,7,K1$)
0970 GET K1$,31:K6$
0980 EXEC FEJL(9,8,K1$)
0990 GET K1$,36:K7$
1000 EXEC FEJL(9,9,K1$)
1010 CLOSE K1$
1020 EXEC FEJL(9,10,K1$)
1030 K2$=N$+K2$;K3$=N$+K3$;K4$=N$+K4$;K5$=N$+K5$;K6$=N$+K6$;K7$=N$+K7$
1040 DIM DTAB1(MDANTAL DIV 4),DTAB(4,2)
1050 OPEN K2$,R
1060 EXEC FEJL(9,11,K2$)
1070 OPEN K3$,R
1080 EXEC FEJL(9,12,K3$)
1090 EXEC INDTAB1(DTAB1,MDANTAL,K2$)
1100 OPEN K7$,R
1110 EXEC FEJL(9,13,K7$)
1120 GET K7$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
1130 EXEC FEJL(9,14,K7$)
1140 GET K7$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
1150 EXEC FEJL(9,15,K7$)
1160 CLOSE K7$
1170 EXEC FEJL(9,16,K7$)
1180 JOURSIDE=T1(3);DATO=T1(7);FAKPOSTNR=T2(3);AVKONTI=T2(7);FJPOST=T2(8)
1190 DIM VJOURARR(AVKONTI),VBJOUARR$(AVKONTI,12)
1200 CLEAR 
1210 TOTAL$="0+";TAH$="0+"
1220 OPEN K5$,R
1230 EXEC FEJL(2,1,K5$)
1240 CURSOR 20,10
1250 PRINT "Monter papir til udskrift af fakturajournal."
1260 CURSOR 20,12
1270 INPUT "Tast RETURN.",SVAR1$
1280 TE$="Der udskrives fakturajournal."
1290 EXEC BIL
1300 OUTPUT P
1310 PRINT " "
1320 PRINT " "
1330 PRINT TAB(27);CHR(14);"Fakturajournal";CHR(15);TAB(52);"Side:";TAB(57);
1340 PRINT USING "#####":JOURSIDE
1350 JOURSIDE=JOURSIDE+1
1360 PRINT " "
1370 PRINT " "
1380 PRINT TAB(5);"Dato      Bilag     Tekst";TAB(55);"Konto";TAB(68);"Beløb"
1390 PRINT " "
1400 PRINT " "
1410 FOR I=1 TO FJPOST
1420 GET K5$,I:KUNDENR,BELØB$,BILAGSNR,FDATO
1430 EXEC FEJL(2,2,K5$)
1440 EXEC FINDPOST1(DTAB1,DTAB,MDANTAL,KUNDENR,DPIL3,K2$)
1450 IF CEKS=0 THEN EXEC HENTDPOST
1460 EXEC DATOU(FDATO)
1470 PRINT TAB(13);
1480 PRINT USING "#######":BILAGSNR;
1490 PRINT TAB(26);DEBNAVN$;TAB(53);
1500 PRINT USING "#######":KUNDENR;
1510 PRINT TAB(64);
1520 EXEC CALC(0,TOTAL$,BELØB$,TOTAL$)
1530 EXEC TUD(BELØB$,TAL4$,1,0)
1540 OPEN K4$,W
1550 EXEC FEJL(2,3,K4$)
1560 IF BELØB$(12)="+" THEN 
1570 TKODE=21
1580 ELSE 
1590 TKODE=22
1600 ENDIF 
1610 FAKPOSTNR=FAKPOSTNR+1;TEKO$=CHR(48+TKODE);TK1$="3"
1620 PUT K4$,FAKPOSTNR:KUNDENR,FDATO,BILAGSNR,TEKO$,BELØB$,TK1$
1630 EXEC FEJL(2,4,K4$)
1640 CLOSE K4$
1650 EXEC FEJL(2,5,K4$)
1660 NEXT I
1670 PRINT TAB(26);"TOTAL";TAB(64);
1680 EXEC TUD(TOTAL$,TAL4$,1,0)
1681 FOR I=1 TO 48-FJPOST-9
1682 PRINT " "
1683 NEXT I
1690 CLOSE K5$
1700 EXEC FEJL(2,6,K5$)
1710 FJPOST=0
1720 OPEN K6$,R
1730 EXEC FEJL(2,7,K6$)
1740 FOR I=1 TO AVKONTI
1750 GET K6$,I:VJOURARR(I),VBJOUARR$(I)
1760 EXEC FEJL(2,8,K6$)
1770 NEXT I
1780 CLOSE K6$
1790 EXEC FEJL(2,9,K6$)
1800 TEKO$=CHR(75)
1810 OUTPUT T
1820 OPEN K4$,W
1830 EXEC FEJL(2,10,K4$)
1840 FOR I=1 TO AVKONTI
1850 FAKPOSTNR=FAKPOSTNR+1;TK1$="3"
1860 PUT K4$,FAKPOSTNR:VJOURARR(I),DATO,JOURSIDE-1,TEKO$,VBJOUARR$(I),TK1$
1870 EXEC FEJL(2,11,K4$)
1880 NEXT I
1890 CLOSE K4$
1900 EXEC FEJL(2,12,K4$)
1910 TE$="        Programvalg.          ";AVKONTI=0
1920 EXEC BIL
1930 T1(3)=JOURSIDE;T2(3)=FAKPOSTNR;T2(7)=AVKONTI;T2(8)=FJPOST
1940 OPEN K7$,W
1950 EXEC FEJL(9,17,K7$)
1960 PUT K7$,2:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
1970 EXEC FEJL(9,18,K7$)
1980 PUT K7$,12:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
1990 EXEC FEJL(9,19,K7$)
2000 CLOSE K7$
2010 EXEC FEJL(9,20,K7$)
2020 CLOSE 
2030 CHAIN "P641210:OPSTART"
2040 END 
2050 PROC BIL
2060 CLEAR 
2070 CURSOR 20,9
2080 PRINT "*****************************************"
2090 CURSOR 20,10
2100 PRINT "*";TAB(41);"*"
2110 PRINT TAB(20);"*";TAB(26);TE$;TAB(60);"*"
2120 PRINT TAB(20);"*";TAB(60);"*"
2130 PRINT TAB(20);"*****************************************"
2140 ENDPROC