DataMuseum.dk

top - download

    Length: 3968 (0xf80)
    Types: SPC/1-COMAL-BIN
    Notes: Mikados_B
    Names: »SKOPI.B«

└─⟦385f097a1⟧ Bits:30008988 SPC/1 COMAL programmer til bogføring
    └─⟦this⟧ »SKOPI.B« 

SPC/1 COMAL-BIN

0100 DIM A$(V),DREVFRA$(G),DREVTIL$(G),TYPE$(E),K1$(17),PL1$(V),PL2$(V)
0110 DIM K$(32,11),NAVNFRA$(8),FN$(33,8),TN$(33,8),NAVNTIL$(8)
0120 DIM J2$(E),J3$(E),J4$(5),R$(G),FN1$(33,8),TN1$(33,8)
0130 PROC COPY
0140 FLAG=B
0150 CALL "P641210:CFCOPY"
0160 IF FLAG=B THEN J1=J1+E
0170 ENDPROC
0180 PROC TKOPI(J9,FNV,TNV)
0190 FOR I=E TO J9
0200 NAVNFRA$=FNV$(I);NAVNTIL$=TNV$(I)
0210 CURSOR 15,23
0220 PRINT NAVNFRA$;" kopieres                        "
0230 EXEC COPY
0240 IF FLAG THEN EXIT
0250 NEXT I
0260 ENDPROC
0270 PROC FEJL(NR1,NR2,NR3)
0280 IF STATUS(NR3$)<>B THEN
0290 PRINT STATUS(NR3$),NR1,NR2,NR3$
0300 STOP
0310 ENDIF
0320 ENDPROC
0330 PROC FO(J9,FNV,TNV)
0340 J9=J9+E;FNV$(J9)=K$(I,4:LEN(K$(I))-V);TNV$(J9)=FNV$(J9)
0350 IF PL1$(G)<>"0" THEN FNV$(J9)=FNV$(J9)+PL1$(G)
0360 IF PL2$(G)<>"0" THEN TNV$(J9)=TNV$(J9)+PL2$(G)
0370 ENDPROC
0380 PROC NRTEST(NUM1)
0390 P=B;TEST2=B;KTAL=B;L=LEN(NUM1$)
0400 IF L>6 THEN EXIT
0410 CASE L OF
0420 FOR I=E TO L
0430 P1=INT(ORD(NUM1$(I))-48)
0440 IF P1<B OR P1>W THEN TEST2=E
0450 P=P*10+P1
0460 NEXT I
0470 KTAL=P DIV 10000
0480 WHEN B
0490 P=-E
0500 WHEN E
0510 CASE NUM1$ OF
0520 P=INT(ORD(NUM1$)-48)
0530 WHEN "j","J"
0540 P=-7
0550 WHEN "n","N"
0560 P=-8
0570 ENDCASE
0580 ENDCASE
0590 ENDPROC
0600 PROC IND(X,PL)
0610 CURSOR 15,X
0620 PRINT "Isæt plade nr ";PL$;" i løbeværket og tast RETURN";
0630 INPUT " ",A$
0640 ENDPROC
0650 K1$="P641220:SYSTEM1"
0660 OPEN K1$,R
0670 EXEC FEJL(W,E,K1$)
0680 FOR I=E TO 32
0690 GET K1$,I+10:K$(I)
0700 EXEC FEJL(W,G,K1$)
0710 NEXT I
0720 CLOSE K1$
0730 EXEC FEJL(W,V,K1$)
0740 DREVFRA$="P2";DREVTIL$="P3";TYPE$="K"
0750 REPEAT
0760 REPEAT
0770 OUTPUT T
0780 CLEAR
0790 CURSOR 20,E
0800 PRINT "Sikkerhedskopiering"
0810 CURSOR 15,4
0820 PRINT "Det gælder nu om at udvise stor omhyggelighed"
0830 CURSOR 15,5
0840 INPUT "Og gøre nøjagtigt som angivet ; tast RETURN",A$
0850 CURSOR 15,6
0860 INPUT "Fjern evt. plade fra løbeværket(nr. 3) og tast RETURN",A$
0870 REPEAT
0880 CURSOR 15,8
0890 INPUT "Hvilken plade ønskes kopieret (14-23, 0:for færdig) ",PL1$
0900 EXEC NRTEST(PL1$)
0910 P2=P DIV 10;P4=P MOD 10;FP=P
0920 UNTIL (P=B OR (P>16 AND P<24)) AND TEST2=B
0930 DREVFRA$="P3";DREVTIL$="P2";TP=20;PL2$="20";P3=P2;P5=B
0940 IF P4=8 OR P4=W THEN P5=7
0950 IF P=17 OR P=20 THEN DREVFRA$="P2";DREVTIL$="P3"
0960 IF P=B THEN EXIT
0970 IF DREVFRA$="P3" THEN
0980 EXEC IND(10,PL1$)
0990 ELSE
1000 REPEAT
1010 CURSOR 15,12
1020 INPUT "Hvilken plade ønskes kopieret til (14-23) ",PL2$
1030 EXEC NRTEST(PL2$)
1040 P3=P DIV 10;P5=P MOD 10;TP=P
1050 UNTIL (P>16 AND P<24) AND TEST2=B
1060 EXEC IND(14,PL2$)
1070 ENDIF
1080 REPEAT
1090 CURSOR 15,16
1100 PRINT "Ønskes kopieret fra plade nr ";PL1$;" til plade nr ";PL2$;
1110 INPUT " (J/N)",A$
1120 EXEC NRTEST(A$)
1130 UNTIL P=-7 OR P=-8
1140 UNTIL P=-7
1150 IF P=B THEN EXIT
1160 J=B;FLAG=B;J1=B;H=B
1170 IF P4<4 THEN
1180 FOR I=E TO 32
1190 EXEC FO(J,FN$,TN$)
1200 NEXT I
1210 ENDIF
1220 IF P2=G THEN J=J+E;FN$(J)="SYSTEM1";TN$(J)=FN$(J)
1230 CURSOR 15,18
1240 CASE E OF
1250 STOP
1260 WHEN J=B AND P4<4
1270 PRINT "Der er ingen data på plade nr ";PL1$;
1280 INPUT " der kan kopieres,tast RETURN",A$
1290 WHEN P4<4
1300 EXEC TKOPI(J,FN$,TN$)
1310 WHEN TP=19 OR FP=19 OR TP=18 OR FP=18 OR TP=17
1320 TN$(E)="VIRKKART";TN$(G)="LØNARTRG";TN$(V)="LØNMODRG"
1330 TN$(4)="TRANSREG";TN$(5)="TÆLLEREG";TN$(6)="AKKREGNS"
1340 TN$(7)="AKKTABEL";TN$(8)="AKKHOVED"
1350 FOR I=E TO 8
1360 FN$(I)=TN$(I);J2$=CHR(ORD(FN$(I,8))+P4-7)
1370 J3$=CHR(ORD(TN$(I,8))+P5-7)
1380 NAVNFRA$=FN$(I,E:7)+J2$;NAVNTIL$=TN$(I,E:7)+J3$
1390 CURSOR 15,23
1400 PRINT NAVNFRA$;" kopieres                         "
1410 EXEC COPY
1420 IF FLAG THEN EXIT
1430 NEXT I
1440 ENDCASE
1450 CASE FLAG OF
1460 PRINT "Uidentificeret fejl tilkald hjælp.Fejlkode: ";FLAG
1470 STOP
1480 WHEN B
1490 WHEN E
1500 IF (J1=B AND P4>V) OR P4<4 THEN
1510 PRINT "Pladen i løbeværk nr 1 er ikke den opgivne eller"
1520 CURSOR 15,19
1530 PRINT "Pladen indeholder ingen data"
1540 ENDIF
1550 WHEN V,14
1560 PRINT "Pladen i løbeværk nr 3 er ikke den opgivne"
1570 WHEN 40
1580 PRINT "Et af løbeværkerne er ikke klar"
1590 CURSOR 15,19
1600 PRINT "Klappen åben, mangler pladen eller pladen vendt forkert"
1610 ENDCASE
1620 CURSOR 15,21
1630 INPUT "Ønskes ny kopiering (J/N)",A$
1640 EXEC NRTEST(A$)
1650 UNTIL P=-8
1660 CURSOR 15,23
1670 INPUT "Tag pladen i drev nr.3 ud, og tast RETURN",A$
1680 CHAIN "P641210:OPSTART"