DataMuseum.dk

top - download

    Length: 8152 (0x1fd8)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »OPSTART.B«

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

SPC/1 COMAL-BIN

0100 DIM TEK$(30),SVAR1$(2),SVAR2$(1),A$(8),B$(17),N$(6),T(9),T1(9),T2(9)
0110 DIM DAT$(8),T3(9),C$(8),C1$(8),K$(17)
0120 PROC TESTSYS
0130 A$="P641220:";B$=A$+"SYSTEM1"
0140 REPEAT
0150 FEJL1=0
0160 OPEN B$,R
0170 IF STATUS(B$)<>0 THEN
0180 CLEAR
0190 CURSOR 11,11
0200 PRINT "Pladen  ";A$(6:2);" er ikke monteret."
0210 CURSOR 11,13
0220 INPUT "Tast RETURN når dette er gjort.",TEK$
0230 FEJL1=1
0240 ENDIF
0250 UNTIL FEJL1=0
0260 CLEAR
0270 GET B$,2:MKAS,MPOS,MBH
0280 EXEC FEJL(1,1,B$)
0290 GET B$,4:MKMID,MFAK
0300 EXEC FEJL(1,1,B$)
0310 GET B$,5:MKRGR,MFKL
0320 EXEC FEJL(2,10,B$)
0330 CLOSE B$
0340 EXEC FEJL(1,2,B$)
0350 B$=A$+"SYSTEM2"
0360 OPEN B$,W
0370 EXEC FEJL(1,3,B$)
0380 GET B$,2:T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9)
0390 EXEC FEJL(1,4,B$)
0400 GET B$,12:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
0410 EXEC FEJL(1,5,B$)
0420 GET B$,13:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
0430 EXEC FEJL(1,6,B$)
0440 GET B$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
0450 EXEC FEJL(1,7,B$)
0460 T3(2)=0
0470 PUT B$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
0480 EXEC FEJL(1,8,B$)
0490 CLOSE B$
0500 EXEC FEJL(5,1,B$)
0510 ENDPROC
0520 PROC BIL
0530 XY=(39-LEN(TEK$)) DIV 2
0540 CLEAR
0550 CURSOR 20,9
0560 PRINT "*****************************************"
0570 CURSOR 20,10
0580 PRINT "*";TAB(41);"*"
0590 CURSOR 20,11
0600 PRINT "*";TAB(XY);TEK$;TAB(41);"*"
0610 CURSOR 20,12
0620 PRINT "*";TAB(41);"*"
0630 CURSOR 20,13
0640 PRINT "*****************************************"
0650 ENDPROC
0660 PROC FEJL(NR1,NR2,NR3)
0670 IF STATUS(NR3$)<>0 THEN
0680 PRINT STATUS(NR3$),NR1,NR2,NR3$
0690 STOP
0700 ENDIF
0710 ENDPROC
0720 EXEC TESTSYS
0730 A$="P641210:";C$="P641210:";GENT=0
0740 REPEAT
0750 TEK$="                              "
0760 CLEAR
0770 CURSOR 21,1
0780 PRINT "Programvalg."
0790 CURSOR 11,2
0800 PRINT "0: Start"
0810 CURSOR 11,4
0820 PRINT "1: Kartoteksvedligeholdelse."
0830 CURSOR 11,6
0840 PRINT "2: Fakturering."
0850 CURSOR 11,8
0860 PRINT "3: Bogføring."
0870 CURSOR 11,10
0880 PRINT "4: Spørge- og listeprogrammer."
0890 CURSOR 11,12
0900 PRINT "5: Sikkerhedskopiering."
0910 CURSOR 11,14
0920 PRINT "6: Dagsafslutning."
0930 CURSOR 11,16
0940 PRINT "7: Månedsafslutning."
0950 CURSOR 11,18
0960 PRINT "8: Årsafslutning."
0970 CURSOR 11,20
0980 PRINT "9: Entrepriser."
0982 CURSOR 10,22
0983 PRINT "10: Løn."
0990 REPEAT
1000 CURSOR 11,23
1010 INPUT "Vælg 0-10:",SVAR1$
1020 UNTIL SVAR1$=>"0" OR SVAR1$<="10"
1030 CLEAR
1040 CURSOR 21,1
1050 FEJL1,D,E,F=0
1060 CASE SVAR1$ OF
1070 WHEN "0"
1080 TEK$="START";B$=A$+"START"
1090 WHEN "1"
1100 PRINT "Programvalg: Kartoteksvedligeholdelse."
1110 CURSOR 11,4
1120 PRINT "1: Kundekontovedligeholdelse."
1130 CURSOR 11,6
1140 PRINT "2: Finanskontovedligeholdelse."
1150 CURSOR 11,8
1160 PRINT "3: Kreditorkontovedligeholdelse."
1170 CURSOR 11,10
1180 PRINT "4: Varevedligeholdelse."
1190 CURSOR 11,12
1200 PRINT "5: Systemvedligeholdelse."
1210 REPEAT
1220 CURSOR 11,15
1230 INPUT "Vælg 1-5:",SVAR2$
1240 UNTIL SVAR2$=>"0" AND SVAR2$<="5"
1250 CASE SVAR2$ OF
1260 FEJL1=1
1270 WHEN "1"
1280 TEK$="Kundekontovedligeholdelse.";B$=A$+"DEBVEDL"
1290 WHEN "2"
1300 TEK$="Finanskontovedligeholdelse.";B$=A$+"FINVEDL"
1310 WHEN "3"
1320 TEK$="Kreditorkontovedligeholdelse";B$=A$+"KREVEDL"
1330 WHEN "4"
1340 TEK$="Varevedligeholdelse.";B$=A$+"VAREVEDL"
1350 WHEN "5"
1360 TEK$="Systemvedligeholdelse";B$=A$+"SYSVEDL"
1370 ENDCASE
1380 WHEN "2"
1390 PRINT "Programvalg. Fakturering."
1400 CURSOR 11,4
1410 PRINT "1: Fakturering."
1420 CURSOR 11,6
1430 PRINT "2: Udskrivning af fakturaer."
1440 REPEAT
1450 CURSOR 11,9
1460 INPUT "Vælg 1-2:",SVAR2$
1470 UNTIL SVAR2$=>"0" AND SVAR2$<="2"
1480 CURSOR 21,11
1490 CASE SVAR2$ OF
1500 FEJL1=1
1510 WHEN "1"
1520 IF T1(4)<(MFKL+5)*MFAK-15+2*MFKL OR T1(8)<MFAK THEN
1530 TEK$="Fakturering.";B$=A$+"FAKTURA"
1540 ELSE
1550 PRINT "Der er ikke plads til flere fakturaer."
1560 FEJL1=1
1570 ENDIF
1580 WHEN "2"
1590 IF T1(4)>0 THEN
1600 TEK$="Udskrivning af fakturaer.";B$=A$+"FAKUD"
1610 ELSE
1620 PRINT "Der ikke nogle fakturaer at udskrive."
1630 FEJL1=1
1640 ENDIF
1650 ENDCASE
1660 IF FEJL1=1 THEN
1670 CURSOR 21,13
1680 INPUT "Tast RETURN",TEK$
1690 ENDIF
1700 WHEN "3"
1710 PRINT "Programvalg. Bogføring."
1720 CURSOR 11,4
1730 PRINT "1: Kasserapport."
1740 CURSOR 11,6
1750 PRINT "2: Posteringsark."
1760 REPEAT
1770 CURSOR 11,9
1780 INPUT "Vælg 1-2:",SVAR2$
1790 UNTIL SVAR2$=>"0" AND SVAR2$<="2"
1800 IF T2(1)>MBH-3 THEN
1810 FEJL1=1
1820 CURSOR 5,11
1830 PRINT "Ikke plads til flere posteringer, dagsafslutning skal foretages";
1840 INPUT ", tast RETURN",TEK$
1850 ELSE
1860 CASE SVAR2$ OF
1870 FEJL1=1
1880 WHEN "1"
1890 TEK$="Kasserapport.";B$=A$+"KASRAP"
1900 WHEN "2"
1910 TEK$="Posteringsark";B$=A$+"PSTERING"
1920 ENDCASE
1930 ENDIF
1940 WHEN "4"
1950 PRINT "Programvalg. Spørge- og listeprogrammer."
1960 CURSOR 11,4
1970 PRINT "1: Kontospørgeprogram."
1980 CURSOR 11,6
1990 PRINT "2: Debitorlister"
2000 CURSOR 11,8
2010 PRINT "3: Balancer."
2020 CURSOR 11,10
2030 PRINT "4: Kreditorlister."
2040 REPEAT
2050 CURSOR 11,13
2060 INPUT "Vælg 1-4:",SVAR2$
2070 UNTIL SVAR2$=>"0" AND SVAR2$<"5"
2080 CASE SVAR2$ OF
2090 FEJL1=1
2100 WHEN "1"
2110 TEK$="Kontospørgeprogram";B$=A$+"KSP1"
2120 WHEN "2"
2130 TEK$="Debitorlister";B$=A$+"DEBLIST"
2140 WHEN "3"
2150 TEK$="Balancer";B$=A$+"BALANCE"
2160 WHEN "4"
2170 TEK$="Kreditorlister";B$=C$+"KRELIST";D=1
2180 ENDCASE
2190 WHEN "6"
2200 TEK$="Dagsafslutning.";B$=C$+"ÅKOPI";E=1;D=1
2210 WHEN "8"
2220 TEK$="Årsafslutning.";B$=C$+"ÅRSAFS";D=1;E=4
2230 CLEAR
2240 REPEAT
2250 CURSOR 20,13
2260 INPUT "Er månedsafslutning foretaget (J/N) ",SVAR2$
2270 UNTIL SVAR2$="J" OR SVAR2$="N" OR SVAR2$="j" OR SVAR2$="n"
2280 IF SVAR2$="n" OR SVAR2$="N" THEN FEJL1=1
2290 WHEN "5"
2300 TEK$="Sikkerhedskopiering";B$=C$+"SKOPI";D=1
2310 WHEN "9"
2320 PRINT "Programvalg. Entrepriser."
2330 CURSOR 11,4
2340 PRINT "1: Entreprisevedligeholdelse"
2350 CURSOR 11,6
2360 PRINT "2: Underkontovedligeholdelse"
2370 CURSOR 11,8
2380 PRINT "3: Entreprisespørgeprogram"
2390 CURSOR 11,10
2400 PRINT "4: Entreprisebalancer"
2410 REPEAT
2420 CURSOR 11,13
2430 INPUT "Vælg 1-4:",SVAR2$
2440 UNTIL SVAR2$=>"0" AND SVAR2$<"5"
2450 CASE SVAR2$ OF
2460 FEJL1=1
2470 WHEN "1"
2480 TEK$="Enterprisevedligeholdelse";B$=C$+"ENTVEDL";D=1
2490 WHEN "2"
2500 TEK$="Underkontovedligeholdelse";B$=C$+"UNKVEDL";D=1
2510 WHEN "3"
2520 TEK$="Enterprisespørgeprogram";B$=C$+"ENTKSP1";D=1
2530 WHEN "4"
2540 TEK$="Entreprisebalancer";B$=C$+"ENTBAL";D=1
2550 ENDCASE
2560 WHEN "7"
2570 PRINT "Programvalg. Månedsafslutning."
2580 CURSOR 11,4
2590 PRINT "1: Månedsafslutning."
2600 CURSOR 11,6
2610 PRINT "2: Renteberegning."
2620 REPEAT
2630 CURSOR 11,9
2640 INPUT "Vælg 1-2:",SVAR2$
2650 UNTIL SVAR2$=>"0" AND SVAR2$<"3"
2660 CASE SVAR2$ OF
2670 FEJL1=1
2680 WHEN "1"
2690 TEK$="Månedsafslutning";B$=C$+"ÅKOPI";E=3;D=1;T3(2)=1
2700 WHEN "2"
2710 TEK$="Renteberegning.";B$=C$+"RENTE";D=1;E=2
2720 ENDCASE
2721 WHEN "10"
2722 TEK$="Løn.";B$=C$+"STARTB"
2730 ENDCASE
2740 IF T1(2)>0 OR T1(4)>0 OR T1(1)>0 THEN F=1
2750 IF (F=1 OR (T2(1)>0 AND E>1) OR (T2(8)>0 AND E>2)) AND E>0 THEN
2760 CLEAR
2770 CURSOR 20,4
2780 PRINT TEK$;" kan ikke foretages , da :"
2790 IF T1(2)<>0 THEN
2800 CURSOR 20,6
2810 PRINT "1. Kasserapport ikke afstemt"
2820 ENDIF
2830 IF T1(1)<>0 THEN
2840 CURSOR 20,8
2850 PRINT "2.Posteringsark ikke afsluttet"
2860 ENDIF
2870 IF T1(4)<>0 THEN
2880 CURSOR 20,10
2890 PRINT "3. Fakturaer ikke udskrevet"
2900 ENDIF
2910 IF T2(1)>0 AND E>1 THEN
2920 CURSOR 20,12
2930 PRINT "4. Dagsafslutning ikke foretaget"
2940 ENDIF
2950 IF T2(8)>0 AND E>2 THEN
2960 CURSOR 20,14
2970 PRINT "5. Rentebogføring ikke foretaget"
2980 ENDIF
2990 REPEAT
3000 CURSOR 20,16
3010 INPUT "Tast RETURN",SVAR1$
3020 UNTIL ORD(SVAR1$)=255
3030 FEJL1=1
3040 ENDIF
3050 IF FEJL1=0 THEN
3060 EXEC BIL
3070 K$="P641220:SYSTEM2"
3080 OPEN K$,W
3090 EXEC FEJL(11,1,K$)
3100 PUT K$,2:T(1),T(2),T(3),T(4),T(5),T(6),T(7),T(8),T(9)
3110 EXEC FEJL(1,8,K$)
3120 PUT K$,17:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
3130 EXEC FEJL(1,9,K$)
3140 CLOSE K$
3150 EXEC FEJL(11,2,K$)
3160 IF D=9 THEN
3170 REPEAT
3180 CURSOR 20,15
3190 INPUT "Isæt plade nr 15 og tast RETURN ",SVAR1$
3200 UNTIL ORD(SVAR1$)=255
3210 ENDIF
3220 CHAIN B$
3230 ENDIF
3240 UNTIL GENT=1