DataMuseum.dk

top - download

    Length: 5056 (0x13c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »SKOPI.K«

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

Mikados K File

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