DataMuseum.dk

top - metrics - download

    Length: 7367 (0x1cc7)
    Types: SPC/1-COMAL-BCD
    Notes: Mikados_B
    Names: »OPSTART«

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

SPC/1 COMAL-BCD

0100 DIM TEK $ ( 25 ) , SVAR1 $ ( 1 ) , SVAR2 $ ( 1 ) , A $ ( 8 ) , B $ ( 17 ) , N $ ( 6 ) , T ( 9 ) , T1 ( 9 ) , T2 ( 9 )
0110 DIM DAT $ ( 8 ) , T3 ( 9 ) , C $ ( 8 )
0120 PROC TESTSYS
0130 A $ = "P641220:"
0140 B $ = A $ + "SYSTEM1"
0150 REPEAT
0160 OPEN B $ , R
0170 IF STATUS ( B $ ) >< 0 THEN
0180 CLEAR
0190 CURSOR 11 , 11
0200 PRINT "Pladen…" ; A $ ( 1 : 7 ) ; "…er…ikke…monteret."
0210 CURSOR 11 , 13
0220 INPUT "Tast…RETURN…n}r…dette…er…gjort." , TEK $
0230 FEJL1 = 1
0240 ELSE
0250 FEJL1 = 0
0260 ENDIF
0270 UNTIL FEJL1 = 0
0280 CLEAR
0290 GET B $ , 2 : MKAS , MBH
0300 EXEC FEJL ( 1 , 1 , B $ )
0310 GET B $ , 4 : MKMID , MFAK
0320 EXEC FEJL ( 1 , 1 , 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 IF T3 ( 1 ) = 0 THEN
0470 CURSOR 21 , 11
0480 PRINT "Godmorgen.…H}ber…at…vi…m}…f}…en…god…dag…sammen."
0490 CURSOR 21 , 13
0500 PRINT "Indtast…dato…som…]]MMDD,…hvor…]]…er…}ret,…MM…er"
0510 REPEAT
0520 CURSOR 21 , 15
0530 INPUT "m}neden…og…DD…er…dagen:" , DAT $
0540 P = 0 ; TEST2 = 0
0550 FOR I = 1 TO 6
0560 P1 = INT ( ORD ( DAT $ ( I ) ) - 48 )
0570 IF P1 >= 0 AND P1 =< 9 THEN
0580 P = P * 10 + P1
0590 ELSE
0600 TEST2 = 1
0610 ENDIF
0620 NEXT I
0630 IF TEST2 = 0 THEN I = ( P DIV 100 ) MOD 100
0640 UNTIL TEST2 = 0 AND I < 13 AND P MOD 100 < 32 AND P DIV 10000 > 78
0650 T ( 7 ) = P ; T3 ( 1 ) = 1
0660 PUT B $ , 2 : T ( 1 ) , T ( 2 ) , T ( 3 ) , T ( 4 ) , T ( 5 ) , T ( 6 ) , T ( 7 ) , T ( 8 ) , T ( 9 )
0670 EXEC FEJL ( 1 , 8 , B $ )
0680 PUT B $ , 17 : T3 ( 1 ) , T3 ( 2 ) , T3 ( 3 ) , T3 ( 4 ) , T3 ( 5 ) , T3 ( 6 ) , T3 ( 7 ) , T3 ( 8 ) , T3 ( 9 )
0690 EXEC FEJL ( 1 , 9 , B $ )
0700 ENDIF
0710 CLOSE B $
0720 EXEC FEJL ( 1 , 10 , B $ )
0730 ENDPROC
0740 PROC BIL
0750 CLEAR
0760 CURSOR 20 , 9
0770 PRINT "*****************************************"
0780 CURSOR 20 , 10
0790 PRINT "*" ; TAB ( 41 ) ; "*"
0800 CURSOR 20 , 11
0810 PRINT "*" ; TAB ( 11 ) ; TEK $ ; TAB ( 41 ) ; "*"
0820 CURSOR 20 , 12
0830 PRINT "*" ; TAB ( 41 ) ; "*"
0840 CURSOR 20 , 13
0850 PRINT "*****************************************"
0860 ENDPROC
0870 PROC FEJL ( NR1 , NR2 , NR3 )
0880 IF STATUS ( NR3 $ ) >< 0 THEN
0890 PRINT STATUS ( NR3 $ ) , NR1 , NR2 , NR3 $
0900 STOP
0910 ENDIF
0920 ENDPROC
0930 EXEC TESTSYS
0940 A $ = "P641210:" ; C $ = "P641215:"
0950 GENT = 0
0960 REPEAT
0970 TEK $ = "…………………………………………………………………"
0980 CLEAR
0990 CURSOR 21 , 1
1000 PRINT "Programvalg."
1010 CURSOR 11 , 4
1020 PRINT "1:…Kartoteksvedligeholdelse."
1030 CURSOR 11 , 6
1040 PRINT "2:…Fakturering."
1050 CURSOR 11 , 8
1060 PRINT "3:…Bogf|ring."
1070 CURSOR 11 , 10
1080 PRINT "4:…Sp|rge-…og…listeprogrammer."
1090 CURSOR 11 , 12
1100 PRINT "5:…Sikkerhedskopiering."
1110 CURSOR 11 , 14
1120 PRINT "6:…Dagsafslutning."
1130 CURSOR 11 , 16
1140 PRINT "7:…M}nedsafslutning."
1150 CURSOR 11 , 18
1160 PRINT "8:…]rsafslutning."
1170 REPEAT
1180 CURSOR 11 , 21
1190 INPUT "V{lg…1-8:" , SVAR1 $
1200 UNTIL SVAR1 $ >= "1" AND SVAR1 $ =< "8"
1210 CLEAR
1220 CURSOR 21 , 1
1230 FEJL1 = 0 ; D = 0 ; E = 0 ; F = 0
1240 CASE SVAR1 $ OF
1250 WHEN "1"
1260 PRINT "Programvalg:…Kartoteksvedligeholdelse."
1270 CURSOR 11 , 4
1280 PRINT "1:…Kundekontovedligeholdelse."
1290 CURSOR 11 , 6
1300 PRINT "2:…Finanskontovedligeholdelse."
1310 CURSOR 11 , 8
1320 PRINT "3:…Kreditorkontovedligeholdelse."
1330 CURSOR 11 , 10
1340 PRINT "4:…Varevedligeholdelse."
1350 CURSOR 11 , 12
1360 PRINT "5:…Systemvedligeholdelse."
1390 REPEAT
1400 CURSOR 11 , 15
1410 INPUT "V{lg…1-5:" , SVAR2 $
1420 UNTIL SVAR2 $ >= "0" AND SVAR2 $ =< "5"
1430 CASE SVAR2 $ OF
1440 FEJL1 = 1
1450 WHEN "1"
1460 TEK $ = "Kundekontovedligeholdelse." ; B $ = A $ + "DEBVEDL"
1470 WHEN "2"
1480 TEK $ = "Finanskontovedligeholdelse." ; B $ = A $ + "FINVEDL"
1490 WHEN "3"
1500 TEK $ = "Kreditorkontovedligeholdelse" ; B $ = A $ + "KREVEDL"
1510 WHEN "4"
1520 TEK $ = "Varevedligeholdelse." ; B $ = A $ + "VAREVEDL"
1530 WHEN "5"
1540 TEK $ = "Systemvedligeholdelse" ; B $ = A $ + "SYSVEDL"
1570 ENDCASE
1580 WHEN "2"
1590 PRINT "Programvalg.…Fakturering."
1600 CURSOR 11 , 4
1610 PRINT "1:…Fakturering."
1620 CURSOR 11 , 6
1630 PRINT "2:…Udskrivning…af…fakturaer."
1640 CURSOR 11 , 8
1650 PRINT "3:…Udskrivning…af…fakturajournal."
1660 REPEAT
1670 CURSOR 11 , 11
1680 INPUT "V{lg…1-3:" , SVAR2 $
1690 UNTIL SVAR2 $ >= "0" AND SVAR2 $ =< "3"
1700 CURSOR 21 , 11
1710 CASE SVAR2 $ OF
1720 FEJL1 = 1
1730 WHEN "1"
1740 IF T1 ( 4 ) < MFAK * 20 OR T1 ( 8 ) < MFAK THEN
1750 TEK $ = "Fakturering." ; B $ = A $ + "FAKTURA"
1760 ELSE
1770 PRINT "Der…er…ikke…plads…til…flere…fakturaer."
1780 FEJL1 = 1
1790 ENDIF
1800 WHEN "2"
1810 IF T1 ( 4 ) > 0 THEN
1820 TEK $ = "Udskrivning…af…fakturaer." ; B $ = A $ + "FAKUD"
1830 ELSE
1840 PRINT "Der…ikke…nogle…fakturaer…at…udskrive."
1850 FEJL1 = 1
1860 ENDIF
1870 WHEN "3"
1880 IF T1 ( 7 ) > 0 THEN
1890 TEK $ = "Fakturajournal." ; B $ = A $ + "FJOUR"
1900 ELSE
1910 PRINT "Der…kan…ikke…udskrives…fakturajournal."
1920 FEJL1 = 1
1930 ENDIF
1940 ENDCASE
1950 IF FEJL1 = 1 THEN
1960 CURSOR 21 , 13
1970 INPUT "Tast…RETURN" , TEK $
1980 ENDIF
1990 WHEN "3"
2000 PRINT "Programvalg.…Bogf|ring."
2010 CURSOR 11 , 4
2020 PRINT "1:…Kasserapport."
2030 CURSOR 11 , 6
2040 PRINT "2:…Posteringsark."
2050 REPEAT
2060 CURSOR 11 , 9
2070 INPUT "V{lg…1-2:" , SVAR2 $
2080 UNTIL SVAR2 $ >= "0" AND SVAR2 $ =< "2"
2090 CASE SVAR2 $ OF
2100 FEJL1 = 1
2110 WHEN "1"
2120 TEK $ = "Kasserapport." ; B $ = A $ + "KASRAP"
2130 WHEN "2"
2140 TEK $ = "Posteringsark" ; B $ = A $ + "PSTERING"
2150 ENDCASE
2160 WHEN "4"
2170 PRINT "Programvalg.…Sp|rge-…og…listeprogrammer."
2180 CURSOR 11 , 4
2190 PRINT "1:…Kontosp|rgeprogram."
2200 CURSOR 11 , 6
2210 PRINT "2:…Debitorlister"
2220 CURSOR 11 , 8
2230 PRINT "3:…Balancer."
2260 REPEAT
2270 CURSOR 11 , 11
2280 INPUT "V{lg…1-3:" , SVAR2 $
2290 UNTIL SVAR2 $ >= "0" AND SVAR2 $ < "4"
2300 CASE SVAR2 $ OF
2310 FEJL1 = 1
2320 WHEN "1"
2330 TEK $ = "Kontosp|rgeprogram" ; B $ = A $ + "KSP1"
2340 WHEN "2"
2350 TEK $ = "Debitorlister" ; B $ = A $ + "DEBLIST"
2360 WHEN "3"
2370 TEK $ = "Balancer" ; B $ = A $ + "BALANCE"
2400 ENDCASE
2410 WHEN "6"
2420 TEK $ = "Dagsafslutning." ; B $ = A $ + "BJ" ; E = 1
2430 WHEN "8"
2440 TEK $ = "]rsafslutning." ; B $ = C $ + "]RSAFS" ; D = 1 ; E = 4
2450 CLEAR
2460 REPEAT
2470 CURSOR 20 , 13
2480 INPUT "Er…m}nedsafslutning…foretaget…(J/N)…" , SVAR2 $
2490 UNTIL SVAR2 $ = "J" OR SVAR2 $ = "N" OR SVAR2 $ = "j" OR SVAR2 $ = "n"
2500 IF SVAR2 $ = "n" OR SVAR2 $ = "N" THEN FEJL1 = 1
2510 WHEN "5"
2520 TEK $ = "Sikkerhedskopiering" ; B $ = C $ + "SKOPI" ; D = 1
2530 WHEN "7"
2540 PRINT "Programvalg.…M}nedsafslutning."
2550 CURSOR 11 , 4
2560 PRINT "1:…M}nedsafslutning."
2570 CURSOR 11 , 6
2580 PRINT "2:…Renteberegning."
2590 REPEAT
2600 CURSOR 11 , 9
2610 INPUT "V{lg…1-2:" , SVAR2 $
2620 UNTIL SVAR2 $ >= "0" AND SVAR2 $ < "3"
2630 CASE SVAR2 $ OF
2640 FEJL1 = 1
2650 WHEN "1"
2660 TEK $ = "M}nedsafslutning" ; B $ = A $ + "MAFSLUT" ; E = 3
2670 WHEN "2"
2680 TEK $ = "Renteberegning." ; B $ = C $ + "RENTE" ; D = 1 ; E = 2
2690 ENDCASE
2700 ENDCASE
2710 IF T1 ( 2 ) > 0 OR T1 ( 4 ) > 0 OR T1 ( 1 ) > 0 THEN F = 1
2720 IF ( F = 1 OR ( T2 ( 1 ) > 0 AND E > 1 ) OR ( T2 ( 8 ) > 0 AND E > 2 ) ) AND E > 0 THEN
2730 CLEAR
2740 CURSOR 20 , 4
2750 PRINT TEK $ ; "…kan…ikke…foretages…,…da…:"
2760 IF T1 ( 2 ) >< 0 THEN
2770 CURSOR 20 , 6
2780 PRINT "1.…Kasserapport…ikke…afstemt"
2790 ENDIF
2800 IF T1 ( 1 ) >< 0 THEN
2810 CURSOR 20 , 8
2820 PRINT "2.Posteringsark…ikke…afsluttet"
2830 ENDIF
2840 IF T1 ( 4 ) >< 0 THEN
2850 CURSOR 20 , 10
2860 PRINT "3.…Fakturaer…ikke…udskrevet"
2870 ENDIF
2880 IF T2 ( 1 ) > 0 AND E > 1 THEN
2890 CURSOR 20 , 12
2900 PRINT "4.…Dagsafslutning…ikke…foretaget"
2910 ENDIF
2920 IF T2 ( 8 ) > 0 AND E > 2 THEN
2930 CURSOR 20 , 14
2940 PRINT "5.…Rentebogf|ring…ikke…foretaget"
2950 ENDIF
2960 REPEAT
2970 CURSOR 20 , 16
2980 INPUT "Tast…RETURN" , SVAR1 $
2990 UNTIL ORD ( SVAR1 $ ) = 255
3000 FEJL1 = 1
3010 ENDIF
3020 IF FEJL1 = 0 THEN
3030 EXEC BIL
3040 IF D = 1 THEN
3050 REPEAT
3060 CURSOR 20 , 15
3070 INPUT "Is{t…plade…nr…15…og…tast…RETURN…" , SVAR1 $
3080 UNTIL ORD ( SVAR1 $ ) = 255
3090 ENDIF
3100 CHAIN B $
3110 ENDIF
3120 UNTIL GENT = 1
3130 END
4d87