DataMuseum.dk

top - download

    Length: 2898 (0xb52)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »ÅKOPI.B«

└─⟦ff7f7aeee⟧ Bits:30009007 NBT	15/3-84
    └─⟦this⟧ »ÅKOPI.B« 

SPC/1 COMAL-BIN

0100 DIM K1$(17),A$(6),TYPE$(E),T1(W),K2$(17)
0110 DIM TILNAVN$(33,8),FRANAVN$(33,8),NAVNTIL$(8),NAVNFRA$(8)
0120 DIM DREVFRA$(G),DREVTIL$(G),K$(32,11),TILNAVN1$(33,8),FRANAVN1$(33,8)
0130 PROC COPY
0140 FLAG=B
0150 CALL "P641210:CFCOPY"
0160 ENDPROC
0170 PROC NRTEST(NUM1)
0180 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
0190 IF L>6 THEN EXIT
0200 CASE L OF
0210 FOR I=E TO L
0220 P1=INT(ORD(NUM1$(I))-48)
0230 IF P1<B OR P1>W THEN TEST2=E
0240 P=P*10+P1
0250 NEXT I
0260 KTAL=P DIV 10000
0270 WHEN B
0280 P=-E
0290 WHEN E
0300 CASE NUM1$ OF
0310 P=INT(ORD(NUM1$)-48)
0320 WHEN "D","d"
0330 P=-G
0340 WHEN "A","a"
0350 P=-V
0360 WHEN "M","m"
0370 P=-4
0380 WHEN "J","j"
0390 P=-7
0400 WHEN "N","n"
0410 P=-8
0420 ENDCASE
0430 ENDCASE
0440 ENDPROC
0450 PROC FEJL(NR1,NR2,NR3)
0460 IF STATUS(NR3$)<>B THEN
0470 PRINT STATUS(NR3$),NR1,NR2,NR3$
0480 STOP
0490 ENDIF
0500 ENDPROC
0510 K1$="P641220:SYSTEM1"
0520 OPEN K1$,R
0530 FOR I=E TO 32
0540 GET K1$,I+10:K$(I)
0550 EXEC FEJL(W,8,K1$)
0560 NEXT I
0570 CLOSE K1$
0580 EXEC FEJL(W,11,K1$)
0590 K2$="P6412"+K$(26)
0600 OPEN K2$,R
0610 EXEC FEJL(11,E,K2$)
0620 GET K2$,12:T1(E),T1(G),T1(V),T1(4),T1(5),T1(6),T1(7),T1(8),T1(W)
0630 EXEC FEJL(11,10,K2$)
0640 GET K2$,17:GENTAG,MAFSLUT
0650 CLOSE K2$
0660 EXEC FEJL(11,G,K2$)
0670 DREVFRA$="P2";DREVTIL$="P3";TYPE$="K"
0680 J=B;FLAG=B;H=B
0690 P=MAFSLUT+E;PLADE=20+P
0700 IF MAFSLUT=V THEN P=E;PLADE=21
0710 FOR I=E TO 32
0730 J=J+E
0740 FRANAVN$(J)=K$(I,4:LEN(K$(I))-V);TILNAVN$(J)=FRANAVN$(J)+CHR(P+48)
0810 NEXT I
0820 J=J+E;FRANAVN$(J)="SYSTEM1";TILNAVN$(J)=FRANAVN$(J)
0830 PROC COPY1(J1,FRAN,TILN)
0840 REPEAT
0850 CLEAR
0860 REPEAT
0870 CURSOR 15,13
0880 PRINT "Isæt plade nr";PLADE;
0890 CURSOR 31,13
0900 INPUT " og tast RETURN",A$
0910 EXEC NRTEST(A$)
0920 UNTIL P=-E
0930 CURSOR 15,15
0940 P=B
0950 FOR I=E TO J1
0960 NAVNFRA$=FRAN$(I);NAVNTIL$=TILN$(I)
0965 CURSOR 15,23
0966 PRINT NAVNFRA$;" kopieres           "
0970 EXEC COPY
0980 IF FLAG THEN EXIT
0990 NEXT I
0991 CURSOR 15,23
0992 PRINT "                                               "
1000 CASE FLAG OF
1010 PRINT "Uidentificeret fejl tilkald hjælp.Fejlkode:";FLAG
1020 STOP
1030 WHEN B
1040 WHEN E
1050 PRINT "Pladen i løbeværk nr 2 er ikke nr 20 eller"
1060 CURSOR 15,17
1070 PRINT "Pladen indeholder ingen data"
1080 WHEN V,14
1090 PRINT "Pladen i løbeværk nr 1 er ikke nr ";
1100 PRINT PLADE
1110 WHEN 40
1120 PRINT "Et af løbeværkerne er ikke klar"
1130 CURSOR 15,17
1140 PRINT "Klappen åben, mangler pladen eller pladen vendt forkert"
1150 ENDCASE
1160 IF FLAG<>B THEN
1170 REPEAT
1180 CURSOR 15,19
1190 INPUT "Ret fejlen og tast RETURN",A$
1200 EXEC NRTEST(A$)
1210 UNTIL P=-E
1220 ENDIF
1230 UNTIL P=B
1240 ENDPROC
1250 IF J>B THEN EXEC COPY1(J,FRANAVN$,TILNAVN$)
1260 PLADE=PLADE+10
1270 IF H>B THEN EXEC COPY1(H,FRANAVN1$,TILNAVN1$)
1280 CLEAR
1290 REPEAT
1300 CURSOR 15,13
1310 INPUT "Udtag pladen og tast RETURN ",A$
1320 EXEC NRTEST(A$)
1330 UNTIL P=-E
1340 CASE MAFSLUT OF
1350 WHEN B
1360 IF T1(7)>B THEN CHAIN "P641210:FJOUR"
1370 IF T1(7)=B THEN CHAIN "P641210:BJ"
1380 WHEN E
1390 CHAIN "P641210:KSP1"
1400 WHEN G
1410 CHAIN "P641210:ÅRSLUT"
1420 WHEN V
1430 CHAIN "P641210:OPSTART"
1440 ENDCASE