DataMuseum.dk

top - download

    Length: 6206 (0x183e)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »FJOUR.B«

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

SPC/1 COMAL-BIN

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