DataMuseum.dk

top - download

    Length: 20224 (0x4f00)
    Types: TextFile
    Notes: Mikados_K
    Names: »VAREDUMP.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »VAREDUMP.K« 

Mikados K File

0100 DIM A1$(145)
0101 A2=0;A3=1
1000 PROC IOPEN(D1,A4,D2)
1010 IF D2=1 THEN 
1020 OPEN A4$,W
1030 ELSE ;D3 FOR D4 D5. D6
1040 OPEN A4$,R
1050 ENDIF 
1060 A9=STATUS(A4$)
1070 IF A9<>0 THEN EXIT 
1075 REM INDLAES FILHOVED
1080 D1$(1:20)=A4$
1090 GET A4$,1:D1$(48:76)
1100 EXEC UNPACK(B8,D1$,69,71)
1110 GET A4$,2:D1$(48+76:B8-76)
1115 EXEC DEFVAR
1120 A9=STATUS(A4$)
1140 IF A9<>0 THEN EXIT 
1145 REM ER FILEN EN COMISQ-FIL
1180 IF B7<>B2*B5 THEN A9=-4
1200 IF A9<>0 THEN EXIT 
1205 REM INDLAES BUKETTABEL
1240 IF D7 THEN EXEC COPSEGS(3,C3,D8,A2)
1330 IF A9<>0 THEN EXIT 
1350 IF D9 THEN 
1360 A9=-18
1370 IF NOT D7 THEN 
1380 A9=-19
1390 E0,E1,E2,E3=0
1400 EXEC PACK(E0,D1$,102,104)
1420 ELSE 
1450 E1,E2,E3=0
1480 E4=D8+6
1490 FOR B1=1 TO B6
1493 E5=D8+(B1-1)*(B0+6);E6=E5+2
1495 EXEC UNPACK(E7,D1$,E5,E6)
1500 EXEC COPSEGS(E7,C4,E8,A2)
1510 IF A9<>0 THEN EXIT 
1520 A9=-18
1530 D1$(E4:B0)=D1$(E8+6:B0)
1540 E9=0
1550 E5=E8+3;E6=E5+2
1560 FOR C8=1 TO B5
1580 EXEC UNPACK(F0,D1$,E5,E6)
1585 E5=E5+B0+6;E6=E5+2
1590 IF F0>0 THEN 
1600 E9=E9+F0
1610 E2=E2+1
1620 F1=C8
1630 ENDIF 
1640 NEXT C8
1650 IF E9>0 THEN 
1660 E3=E3+E9
1670 E1=E1+1
1680 D1$(E4:B0)=D1$(E8+(F1-1)*(B0+6)+6:B0)
1690 ENDIF 
1700 E5=E4-3;E6=E5+2
1710 EXEC PACK(E9,D1$,E5,E6)
1725 E4=E4+B0+6
1730 NEXT B1
1735 IF A9<>-18 THEN EXIT 
1740 F2=B6
1750 EXEC PACK(F2,D1$,21,23)
1760 ENDIF 
1765 IF A9<>-18 AND A9<>-19 THEN EXIT 
1770 EXEC PACK(E1,D1$,105,107)
1780 EXEC PACK(E2,D1$,108,110)
1790 EXEC PACK(E3,D1$,111,113)
1800 ENDIF 
1805 IF A9<>-18 AND A9<>-19 AND A9<>0 THEN EXIT 
1810 D9=1
1811 FOR B1=21 TO 45 STEP 3
1812 C8=B1+2
1813 EXEC PACK(0,D1$,B1,C8)
1814 NEXT B1
1815 REM LOKALE ZONE-VARIABLE
1820 EXEC PACK(D9,D1$,117,119)
1821 EXEC PACK(D2,D1$,30,32)
1825 IF D2=1 THEN 
1830 B1=A9
1840 PUT A4$,1:D1$(48:76)
1850 PUT A4$,2:D1$(48+76:B8-76)
1860 A9=STATUS(A4$)
1870 IF A9>0 THEN EXIT 
1880 A9=B1
1885 ENDIF 
1900 ENDPROC 
3000 PROC COPSEGS(G8,G9,H0,H1)
3010 H2=H0
3020 H3=G8
3030 REPEAT 
3040 IF H1=0 THEN 
3050 GET D1$(1:20),H3:D1$(H2:76)
3060 ELSE 
3070 PUT D1$(1:20),H3:D1$(H2:76)
3080 ENDIF 
3090 H2=H2+76
3100 H3=H3+1
3110 A9=STATUS(D1$(1:20))
3120 UNTIL H3=G8+G9 OR A9>0
3130 ENDPROC 
3140 PROC DIMS(A4)
3150 OPEN A4$,R
3160 A9=STATUS(A4$)
3170 IF A9>0 THEN EXIT 
3180 GET A4$,1:A1$(1:76)
3190 A9=STATUS(A4$)
3200 IF A9>0 THEN EXIT 
3210 CLOSE A4$
3220 A9=STATUS(A4$)
3230 IF A9>0 THEN EXIT 
3240 EXEC UNPACK(B0,A1$,37,39)
3250 EXEC UNPACK(B8,A1$,22,24)
3260 EXEC UNPACK(B9,A1$,25,27)
3270 EXEC UNPACK(C0,A1$,28,30)
3280 EXEC UNPACK(B3,A1$,52,54)
3290 EXEC UNPACK(A6,A1$,34,36)
3300 C7=47+B8+B9+C0+B3*76+A6+1+6+B0
3310 ENDPROC 
3400 PROC FINDPOST
3424 EXEC EXTRACT(F4$,G5$)
3430 E5=D8+3;E6=E5+2
3433 G7=-1
3436 B1=1
3439 REPEAT 
3442 EXEC UNPACK(E9,D1$,E5,E6)
3445 IF E9>0 THEN 
3448 H4=B1
3449 G6$=""
3450 G6$=D1$(E5+3:B0)
3451 EXEC COMPARE(G6$,G5$)
3454 ENDIF 
3457 B1=B1+1
3460 E5=E5+6+B0;E6=E5+2
3463 UNTIL B1>B6 OR G7=>0
3466 IF B1>B6 AND G7<0 THEN 
3469 REM SQGNING ENDT UDENFOR FILEN
3472 EXEC READTABLE(H4)
3475 IF A9<>0 THEN EXIT 
3478 E5=E8+(B5-1)*(B0+6)+3;E6=E5+2
3481 FOR H4=B5 TO 1 STEP -1
3484 EXEC UNPACK(E9,D1$,E5,E6)
3487 IF E9>0 THEN 
3490 EXEC READBLOCK(H4,1)
3493 IF A9<>0 THEN EXIT 
3496 G1=E9+1
3499 EXEC PACK(G1,D1$,27,29)
3502 A9=-1
3505 ENDIF 
3508 E5=E5-(6+B0);E6=E5+2
3511 IF A9<>0 THEN EXIT 
3514 NEXT H4
3517 IF A9<>0 THEN EXIT 
3520 PRINT "KATASTROFE"
3523 STOP 
3526 ELSE 
3529 REM POSTEN ER I FILEN
3532 EXEC READTABLE(H4)
3535 E5=E8+3;E6=E5+2
3538 FOR H4=1 TO B5
3541 EXEC UNPACK(E9,D1$,E5,E6)
3544 IF E9>0 THEN 
3545 G6$=""
3546 G6$=D1$(E5+3:B0)
3547 EXEC COMPARE(G6$,G5$)
3550 IF G7=>0 THEN 
3553 EXEC READBLOCK(H4,1)
3556 H4=B5+1
3559 ENDIF 
3562 ENDIF 
3565 IF A9<>0 THEN EXIT 
3568 E5=E5+6+B0;E6=E5+2
3571 NEXT H4
3574 IF A9<>0 THEN EXIT 
3583 G7=-1;B1=0;E5=F6
3586 WHILE G7<0
3589 B1=B1+1
3592 IF B1>E9 THEN 
3595 PRINT "KATASTROFE"
3598 STOP 
3601 ENDIF 
3603 F9$=D1$(E5:A6)
3604 EXEC EXTRACT(F9$,G6$)
3607 EXEC COMPARE(G6$,G5$)
3608 E5=E5+A6
3610 ENDWHILE 
3613 IF G7=0 THEN 
3616 A9=0
3619 ELSE 
3622 A9=-1
3625 ENDIF 
3628 G1=B1
3631 EXEC PACK(G1,D1$,27,29)
3633 ENDIF 
3634 ENDPROC 
3637 PROC READTABLE(H5)
3649 IF H5<>F2 THEN 
3658 IF H6 THEN 
3664 H7=E8+(G0-1)*(B0+6);H8=H7+2
3667 EXEC UNPACK(H9,D1$,H7,H8)
3670 EXEC COPSEGS(H9,B3,F6,A3)
3673 ENDIF 
3676 IF A9<>0 THEN EXIT 
3679 IF I0 THEN 
3682 H7=D8+(F2-1)*(B0+6);H8=H7+2
3685 EXEC UNPACK(H9,D1$,H7,H8)
3688 EXEC COPSEGS(H9,C4,E8,A3)
3691 ENDIF 
3694 IF A9<>0 THEN EXIT 
3697 EXEC PACK(0,D1$,42,44)
3698 I0=0
3699 H6=0
3700 EXEC PACK(0,D1$,45,47)
3703 H7=D8+(H5-1)*(B0+6);H8=H7+2
3706 EXEC UNPACK(H9,D1$,H7,H8)
3709 EXEC COPSEGS(H9,C4,E8,A2)
3712 IF A9<>0 THEN EXIT 
3715 F2=H5
3718 G0=0
3721 EXEC PACK(F2,D1$,21,23)
3724 EXEC PACK(G0,D1$,24,26)
3727 ENDIF 
3730 ENDPROC 
3733 PROC READBLOCK(I1,I2)
3745 IF I1<>G0 THEN 
3748 IF H6 THEN 
3751 H7=E8+(G0-1)*(B0+6);H8=H7+2
3754 EXEC UNPACK(H9,D1$,H7,H8)
3757 EXEC COPSEGS(H9,B3,F6,A3)
3760 ENDIF 
3763 IF A9<>0 THEN EXIT 
3766 EXEC PACK(0,D1$,45,47)
3767 H6=0
3769 H7=E8+(I1-1)*(B0+6);H8=H7+2
3772 EXEC UNPACK(H9,D1$,H7,H8)
3774 H7=F6+(I2-1)*A6
3775 EXEC COPSEGS(H9,B3,H7,A2)
3778 IF A9<>0 THEN EXIT 
3781 G0=I1
3784 EXEC PACK(G0,D1$,24,26)
3787 ENDIF 
3790 ENDPROC 
3793 PROC FORSKYDIBLOK(I3)
3796 H7=E8+(G0-1)*(B0+6)+3;H8=H7+2
3799 EXEC UNPACK(E9,D1$,H7,H8)
3802 IF I3>0 THEN 
3805 H7=F6+E9*A6;H8=H7-A6
3808 FOR I4=E9 TO I3 STEP -1
3811 D1$(H7:A6)=D1$(H8:A6)
3814 H7=H8
3817 H8=H7-A6
3820 NEXT I4
3823 ELSE 
3826 IF I3<0 THEN 
3829 H7=F6-I3*A6;H8=H7-A6
3832 FOR I4=-I3 TO E9-1
3835 D1$(H8:A6)=D1$(H7:A6)
3838 H8=H7
3841 H7=H7+A6
3844 NEXT I4
3847 ELSE 
3850 A9=4711
3853 ENDIF 
3856 ENDIF 
3859 ENDPROC 
3862 PROC SAETKEY(I3)
3864 F9$=D1$(F6+(I3-1)*A6:A6)
3871 H7=D8+(F2-1)*(B0+6)+3;H8=H7+2
3874 EXEC UNPACK(I5,D1$,H7,H8)
3877 H7=E8+(G0-1)*(B0+6)+6
3878 G5$=""
3879 G5$=D1$(H7:B0)
3880 H8=D8+(F2-1)*(B0+6)+6
3881 G6$=""
3882 G6$=D1$(H8:B0)
3883 EXEC COMPARE(G5$,G6$)
3886 I6=G7
3887 EXEC EXTRACT(F9$,G5$)
3889 EXEC COMPARE(G5$,G6$)
3892 IF I5=0 OR I6=0 OR G7>0 THEN 
3895 D1$(H8:B0)=G5$(1:B0)
3898 EXEC PACK(1,D1$,39,41)
3899 I7=1
3901 ENDIF 
3904 D1$(H7:B0)=G5$(1:B0)
3907 EXEC PACK(1,D1$,42,44)
3908 I0=1
3910 ENDPROC 
3913 PROC QGNUM
3916 H7=D8+(F2-1)*(B0+6)+3;H8=H7+2
3919 EXEC UNPACK(I6,D1$,H7,H8)
3922 I6=I6+1
3925 EXEC PACK(I6,D1$,H7,H8)
3928 H7=E8+(G0-1)*(B0+6)+3;H8=H7+2
3931 EXEC UNPACK(I5,D1$,H7,H8)
3934 I5=I5+1
3937 EXEC PACK(I5,D1$,H7,H8)
3940 E3=E3+1
3943 EXEC PACK(E3,D1$,111,113)
3946 IF I5=1 THEN 
3952 E2=E2+1
3955 EXEC PACK(E2,D1$,108,110)
3958 IF I6=1 THEN 
3964 E1=E1+1
3967 EXEC PACK(E1,D1$,105,107)
3970 ENDIF 
3973 ENDIF 
3976 EXEC PACK(1,D1$,39,41)
3977 I7=1
3979 EXEC PACK(1,D1$,42,44)
3980 I0=1
3982 ENDPROC 
3985 PROC EXTRACT(I8,I9)
3988 J0=120;J1=J0+2
3989 I9$=""
3991 J2=1
3994 FOR I4=1 TO A7
3997 EXEC UNPACK(J3,D1$,J0,J1)
4000 J0=J0+3;J1=J0+2
4003 EXEC UNPACK(J4,D1$,J0,J1)
4006 I9$(J2:J4)=I8$(J3:J4)
4009 J2=J2+J4
4012 J0=J0+6;J1=J0+2
4015 NEXT I4
4018 ENDPROC 
4021 PROC COMPARE(J5,J6)
4024 J0=123;J1=J0+2
4027 J2=1
4030 G7=0
4033 FOR I4=1 TO A7
4036 EXEC UNPACK(J4,D1$,J0,J1)
4039 J0=J0+3;J1=J0+2
4042 IF J5$(J2:J4)<>J6$(J2:J4) THEN 
4045 EXEC UNPACK(G7,D1$,J0,J1)
4048 G7=G7-2
4049 J7=J2
4050 WHILE J5$(J7)=J6$(J7)
4051 J7=J7+1
4052 ENDWHILE 
4053 IF ORD(J5$(J7))<ORD(J6$(J7)) THEN G7=-G7
4054 ENDIF 
4057 IF G7<>0 THEN EXIT 
4060 J2=J2+J4
4063 J0=J0+6;J1=J0+2
4066 NEXT I4
4069 ENDPROC 
4271 PROC RETNING
4280 E5=D8+(F2-1)*(B0+6)+3;E6=E5+2
4283 EXEC UNPACK(E9,D1$,E5,E6)
4286 K8=(E9<B7)
4289 IF K8 THEN 
4292 EXEC FINDDIR(G0,B2,B5,E8)
4295 ELSE 
4298 EXEC FINDDIR(F2,B7,B6,D8)
4301 ENDIF 
4304 ENDPROC 
4307 PROC FINDDIR(L0,L1,L2,L3)
4310 J8=L2+1;L4=L0+1;L5=L0
4313 WHILE J8=L2+1
4316 IF L4>L2 AND L5<1 THEN 
4319 PRINT "FEJL: FULD TABEL"
4322 PRINT "FQRSTE","SIZE","TABLESIZE","TABLEST"
4325 PRINT L0,L1,L2,L3
4328 PRINT "NAESTE","FORRIGE"
4331 PRINT L4,L5
4334 STOP 
4337 ENDIF 
4340 IF L4<=L2 THEN 
4343 E5=L3+(L4-1)*(6+B0)+3;E6=E5+2
4346 EXEC UNPACK(E9,D1$,E5,E6)
4349 IF E9<L1 THEN J8=L4-L0
4352 ENDIF 
4355 IF L5=>1 THEN 
4358 E5=L3+(L5-1)*(6+B0)+3;E6=E5+2
4361 EXEC UNPACK(E9,D1$,E5,E6)
4364 IF E9<L1 THEN J8=L5-L0
4367 ENDIF 
4370 L4=L4+1;L5=L5-1
4373 ENDWHILE 
4376 ENDPROC 
4400 PROC ICLOSE(D1)
4403 A9=0
4406 EXEC DEFVAR
4407 IF L6=1 THEN 
4412 IF D7=0 AND E3>0 THEN 
4415 EXEC PACK(1,D1$,114,116)
4418 EXEC PACK(E3,D1$,102,104)
4421 REM INITREC
4424 ENDIF 
4454 IF H6 THEN 
4463 E5=E8+(G0-1)*(B0+6);E6=E5+2
4466 EXEC UNPACK(H9,D1$,E5,E6)
4469 EXEC COPSEGS(H9,B3,F6,A3)
4472 ENDIF 
4475 IF A9<>0 THEN EXIT 
4478 IF I0 THEN 
4487 E5=D8+(F2-1)*(B0+6);E6=E5+2
4490 EXEC UNPACK(H9,D1$,E5,E6)
4493 EXEC COPSEGS(H9,C4,E8,A3)
4496 ENDIF 
4499 IF A9<>0 THEN EXIT 
4508 IF I7 THEN EXEC COPSEGS(3,C3,D8,A3)
4514 IF A9<>0 THEN EXIT 
4517 PUT D1$(1:20),2:D1$(48+76:B8-76)
4520 A9=STATUS(D1$(1:20))
4523 IF A9<>0 THEN EXIT 
4526 EXEC PACK(0,D1$,117,119)
4529 PUT D1$(1:20),1:D1$(48:76)
4532 A9=STATUS(D1$(1:20))
4535 IF A9<>0 THEN EXIT 
4537 ENDIF 
4538 CLOSE D1$(1:20)
4541 A9=STATUS(D1$(1:20))
4544 ENDPROC 
4900 PROC NEXTREC(D1,F4,F9)
4903 EXEC DEFVAR
4906 A9=0
4930 IF D7 THEN 
4933 EXEC EXTRACT(F4$,G5$)
4939 G7=1
4942 IF G1>0 THEN 
4945 F9$=D1$(F6+(G1-1)*A6:A6)
4948 EXEC EXTRACT(F9$,G6$)
4951 EXEC COMPARE(G5$,G6$)
4954 ENDIF 
4957 IF G7<>0 THEN EXEC FINDPOST
4960 IF A9<>0 AND A9<>-1 THEN EXIT 
4966 E5=E8+(G0-1)*(B0+6)+3;E6=E5+2
4969 EXEC UNPACK(E9,D1$,E5,E6)
4972 IF E9<=G1+A9 THEN 
4978 K7=G0+1
4981 E5=E8+G0*(B0+6)+3;E6=E5+2
4984 FOR B1=K7 TO B5
4987 EXEC UNPACK(E9,D1$,E5,E6)
4990 IF E9>0 THEN 
4993 K7=B1
4996 B1=B5
4999 ENDIF 
5002 E5=E5+6+B0;E6=E5+2
5005 NEXT B1
5008 IF E9=0 THEN 
5017 K6=F2+1
5020 E5=D8+F2*(B0+6)+3;E6=E5+2
5023 FOR B1=K6 TO B6
5026 EXEC UNPACK(E9,D1$,E5,E6)
5029 IF E9>0 THEN 
5032 L7=B1
5035 B1=B6
5038 ENDIF 
5041 E5=E5+B0+6;E6=E5+2
5044 NEXT B1
5047 IF E9=0 THEN 
5053 IF E3<=1 THEN 
5056 A9=-9
5059 ELSE 
5062 A9=-2
5065 ENDIF 
5068 K6=1
5071 E5=D8+3;E6=E5+2
5074 FOR B1=K6 TO F2
5077 EXEC UNPACK(E9,D1$,E5,E6)
5080 IF E9>0 THEN 
5083 L7=B1
5086 B1=F2
5089 ENDIF 
5092 E5=E5+B0+6;E6=E5+2
5095 NEXT B1
5098 IF E9=0 THEN 
5101 PRINT "ALVORLIG TABELFEJL"
5104 STOP 
5107 ENDIF 
5110 ENDIF 
5113 B1=A9
5114 A9=0
5116 EXEC READTABLE(K6)
5119 IF A9<>0 THEN EXIT 
5122 A9=B1
5125 K7=1
5128 E5=E8+3;E6=E5+2
5131 FOR B1=K7 TO B5
5134 EXEC UNPACK(E9,D1$,E5,E6)
5137 IF E9>0 THEN 
5140 K7=B1
5143 B1=B5
5146 ENDIF 
5149 E5=E5+B0+6;E6=E5+2
5152 NEXT B1
5155 IF E9=0 THEN 
5158 PRINT "ALVORLIG TABELFEJL"
5161 STOP 
5164 ENDIF 
5167 ENDIF 
5170 IF A9>0 THEN EXIT 
5173 B1=A9
5176 A9=0
5179 EXEC READBLOCK(K7,1)
5182 IF A9<>0 THEN EXIT 
5185 A9=B1
5188 G1=1
5191 ELSE 
5194 G1=G1+1+A9
5197 ENDIF 
5200 IF A9>0 THEN EXIT 
5203 F4$=D1$(F6+(G1-1)*A6:A6)
5204 EXEC PACK(G1,D1$,27,29)
5206 ELSE 
5209 A9=-12
5212 ENDIF 
5215 ENDPROC 
5300 PROC DEFVAR
5303 EXEC UNPACK(F2,D1$,21,23)
5306 EXEC UNPACK(G0,D1$,24,26)
5309 EXEC UNPACK(G1,D1$,27,29)
5312 EXEC UNPACK(L6,D1$,30,32)
5315 EXEC UNPACK(F7,D1$,33,35)
5318 EXEC UNPACK(F8,D1$,36,38)
5321 EXEC UNPACK(I7,D1$,39,41)
5324 EXEC UNPACK(I0,D1$,42,44)
5327 EXEC UNPACK(H6,D1$,45,47)
5330 EXEC UNPACK(B6,D1$,48,50)
5333 EXEC UNPACK(B4,D1$,51,53)
5336 EXEC UNPACK(A5,D1$,54,56)
5339 EXEC UNPACK(B5,D1$,57,59)
5342 EXEC UNPACK(B7,D1$,60,62)
5345 EXEC UNPACK(B2,D1$,63,65)
5348 EXEC UNPACK(A7,D1$,66,68)
5351 EXEC UNPACK(B8,D1$,69,71)
5354 EXEC UNPACK(B9,D1$,72,74)
5357 EXEC UNPACK(C0,D1$,75,77)
5360 EXEC UNPACK(C1,D1$,78,80)
5363 EXEC UNPACK(A6,D1$,81,83)
5366 EXEC UNPACK(B0,D1$,84,86)
5369 EXEC UNPACK(C2,D1$,87,89)
5372 EXEC UNPACK(C3,D1$,90,92)
5375 EXEC UNPACK(C5,D1$,93,95)
5378 EXEC UNPACK(C4,D1$,96,98)
5381 EXEC UNPACK(B3,D1$,99,101)
5384 EXEC UNPACK(E0,D1$,102,104)
5387 EXEC UNPACK(E1,D1$,105,107)
5390 EXEC UNPACK(E2,D1$,108,110)
5393 EXEC UNPACK(E3,D1$,111,113)
5396 EXEC UNPACK(D7,D1$,114,116)
5399 EXEC UNPACK(D9,D1$,117,119)
5402 D8=48+B8
5405 E8=D8+B9
5408 F6=E8+C0
5411 ENDPROC 
7000 PROC TESTOMS(N0,N1)
7005 N2=LEN(N0$)
7010 N3=4
7015 FOR N4=1 TO 70
7020 IF ORD(N0$(N4))=255 THEN EXIT 
7025 IF N0$(N4)<>" " THEN 
7030 IF N0$(N4)<>"-" THEN 
7035 N5=N4
7040 N1$(13)="+"
7045 ELSE 
7050 N5=N4+1
7055 N1$(13)="-"
7060 ENDIF 
7065 N6=1+N2
7070 N4=70
7075 N3=0
7080 ENDIF 
7085 NEXT N4
7090 IF N3 THEN EXIT 
7095 FOR N4=N5 TO N5+N2-1
7100 IF N0$(N4)="." THEN 
7105 N6=N4
7110 N4=N5+N2-1
7115 ENDIF 
7120 NEXT N4
7125 IF N6-N5>9 THEN N3=3
7130 IF N3 THEN EXIT 
7135 FOR N4=1 TO 9-N6+N5
7140 N1$(N4)=" "
7145 NEXT N4
7150 IF N6>N5 THEN 
7155 FOR N4=10-N6+N5 TO 9
7160 IF N0$(N4+N6-10)<"0" OR N0$(N4+N6-10)>"9" THEN 
7165 N3=2
7170 ELSE 
7175 N1$(N4)=N0$(N4+N6-10)
7180 ENDIF 
7185 NEXT N4
7190 ENDIF 
7195 IF N3 THEN EXIT 
7200 N1$(10)="."
7205 FOR N4=11 TO 12
7210 CASE 1 OF 
7215 N3=2
7220 WHEN N0$(N6+N4-10)=" " OR ORD(N0$(N6+N4-10))=255
7225 N1$(N4)="0"
7230 WHEN N0$(N6+N4-10)<="9" AND N0$(N6+N4-10)=>"0"
7235 N1$(N4)=N0$(N6+N4-10)
7240 ENDCASE 
7245 NEXT N4
7250 IF N0$(N6+3)=>"5" AND N0$(N6+3)<="9" THEN 
7255 IF N1$(12)<"9" THEN 
7260 N1$(12)=CHR(ORD(N1$(12))+1)
7265 ELSE 
7270 N1$(12)="0"
7275 IF N1$(11)<"9" THEN 
7280 N1$(11)=CHR(ORD(N1$(11))+1)
7285 ELSE 
7290 N1$(11)="0"
7295 FOR N4=9 TO 1 STEP -1
7300 CASE N1$(N4) OF 
7305 N1$(N4)=CHR(ORD(N1$(N4))+1)
7310 N4=1
7315 WHEN "9"
7320 IF N4=1 THEN N3=1
7325 N1$(N4)="0"
7330 WHEN " "
7335 N1$(N4)="1"
7340 N4=1
7345 ENDCASE 
7350 NEXT N4
7355 ENDIF 
7360 ENDIF 
7365 ENDIF 
7370 ENDPROC 
7375 PROC TEKTAL(N7,N8,N9)
7380 O0=4
7385 FOR N4=1 TO 9
7390 IF N7$(N4)<>" " THEN 
7395 O0=14-N4
7400 N4=9
7405 ENDIF 
7410 NEXT N4
7415 N5=O0 DIV 3
7420 N8=0
7425 N9=ORD(N7$(12))+ORD(N7$(11))*10+(ORD(N7$(9))-48)*100*(O0>4)-528
7430 N9=N9+(ORD(N7$(8))-48)*1000*(O0>5)+(ORD(N7$(7))-48)*10000*(O0>6)
7435 N9=N9+(ORD(N7$(6))-48)*100000*(O0>7)
7440 IF O0>8 THEN 
7445 N8=ORD(N7$(5))-48+(ORD(N7$(4))-48)*10*(O0>9)
7450 N8=N8+(ORD(N7$(3))-48)*100*(O0>10)+(ORD(N7$(2))-48)*1000*(O0>11)
7455 N8=N8+(ORD(N7$(1))-48)*10000*(O0>12)
7460 ENDIF 
7465 ENDPROC 
7470 PROC NULU(N7)
7475 FOR N4=1 TO 9
7480 IF N7$(N4)<>" " AND N7$(N4)<>"0" THEN EXIT 
7485 N7$(N4)=" "
7490 NEXT N4
7495 ENDPROC 
7500 PROC TALTEK(N8,N9,N7)
7505 FOR N4=1 TO 5
7510 N7$(N4)=CHR((N8 DIV 10**(5-N4)) MOD 10+48)
7515 NEXT N4
7520 O1=1
7525 FOR N4=6 TO 12
7530 IF N4=10 THEN 
7535 N4=11;O1=0;N7$(10)="."
7540 ENDIF 
7545 N7$(N4)=CHR((N9 DIV 10**(12-N4-O1)) MOD 10+48)
7550 NEXT N4
7555 EXEC NULU(N7$)
7560 ENDPROC 
7565 PROC LANGPAK(O2,O3,O4,O5)
7570 IF O2$(13)="-" THEN N3=1
7575 EXEC TEKTAL(O2$,O6,O7)
7580 O8=O5-2
7585 EXEC PACK(O7,O3$,O8,O5)
7590 O8=O8-1
7595 EXEC PACK(O6,O3$,O4,O8)
7600 ENDPROC 
7605 PROC LANGUDPAK(O3,O2,O4,O5)
7610 O8=O5-2
7615 EXEC UNPACK(O7,O2$,O8,O5)
7620 O8=O8-1
7625 EXEC UNPACK(O6,O2$,O4,O8)
7630 EXEC TALTEK(O6,O7,O3$)
7635 ENDPROC 
7640 DIM O9$(20),FILE$(20)
7645 O9$="VENDOR:VAREREG "
7650 EXEC DIMS(O9$)
7655 IF A9<>0 THEN EXEC FEJL(O9$)
7660 DIM P0$(C7),G5$(B0),G6$(B0)
7665 EXEC IOPEN(P0$,O9$,0)
7670 IF A9<>0 THEN EXEC ERROR(P0$)
7675 DIM P4$(152),P5$(152),P6$(30),P7$(10),P8$(51),P9$(20),Q5$(13)
8980 PROC PRVAREOPL
8985 CURSOR 1,1
8990 EXEC UNPACK(Q1,P4$,1,3)
8995 PRINT "1 VARENR                    ",Q1
9000 CURSOR 1,2
9005 P6$=P4$(4,33)
9010 PRINT "2 VARENAVN                     ",P6$
9015 CURSOR 1,3
9020 P6$=P4$(34,63)
9025 PRINT "3 BETEGNELSE HOS LEVERANDØR ",P6$
9030 CURSOR 1,4
9035 EXEC LANGUDPAK(Q5$,P4$,64,67)
9040 PRINT "4 PRIS                      ",Q5$
9050 EXEC LANGUDPAK(Q5$,P4$,68,71)
9055 CURSOR 1,5
9060 PRINT "5 KOSTPRIS                  ",Q5$
9070 CURSOR 1,6
9075 EXEC UNPACK(Q1,P4$,72,73)
9080 PRINT "6 LEVERANDØRNR              ",Q1
9085 CURSOR 1,7
9090 EXEC UNPACK(Q1,P4$,128,129)
9095 PRINT "7 OPRINDELSESLAND           ",Q1
9100 CURSOR 1,8
9105 EXEC LANGUDPAK(Q5$,P4$,75,78)
9110 PRINT "8 TOLDPOSITIONSNR                   ";Q5$(1:9);Q5$(11,12)
9115 CURSOR 1,9
9120 EXEC UNPACK(Q1,P4$,79,80)
9125 PRINT "9 PAKNINGSENHED             ",Q1
9130 CURSOR 1,10
9135 EXEC UNPACK(Q1,P4$,81,83)
9140 PRINT "10 FYSISK LAGER             ",Q1
9145 EXEC UNPACK(Q3,P4$,84,86)
9150 CURSOR 40,10
9155 PRINT "   PRIMOLAGER               ",Q3
9160 Q6=(Q3+Q1)/2
9165 CURSOR 1,11
9170 EXEC UNPACK(Q1,P4$,87,89)
9175 PRINT "11 MINIMUMSLAGER            ",Q1
9180 CURSOR 1,12
9185 EXEC UNPACK(Q1,P4$,90,92)
9190 PRINT "12 RESERVERET AF FYSISK LAGER ",Q1
9195 CURSOR 1,13
9200 EXEC UNPACK(Q1,P4$,93,95)
9205 PRINT "13 I ORDRE                  ",Q1
9210 CURSOR 30,13
9215 EXEC UNPACK(Q1,P4$,96,98)
9220 PRINT "14 HERAF RESERVERET   ",Q1
9225 CURSOR 58,13
9230 EXEC UNPACK(Q1,P4$,99,99)
9235 PRINT "15 FORV. LEV. UGE           ",Q1
9240 CURSOR 1,14
9245 EXEC UNPACK(Q1,P4$,100,102)
9250 PRINT "16 STØRRELSE AF SIDSTE BESTILLING ",Q1
9255 CURSOR 40,14
9260 EXEC UNPACK(Q1,P4$,103,105)
9265 PRINT "17 DATO FOR SIDSTE BEST ",Q1
9270 CURSOR 1,15
9275 EXEC UNPACK(Q1,P4$,106,108)
9280 PRINT "18 DATO FOR SIDSTE ORDRE ",Q1
9290 CURSOR 1,16
9295 EXEC UNPACK(Q1,P4$,109,111)
9300 PRINT "19 ANTAL SOLGT I ÅR  ",Q1
9305 IF Q6<>0 THEN Q6=Q1/Q6
9310 CURSOR 40,16
9315 EXEC UNPACK(Q1,P4$,112,114)
9320 PRINT "20 ANTAL SOLGT S. ÅR  ",Q1
9325 CURSOR 1,17
9330 EXEC UNPACK(Q7,P4$,115,117)
9335 PRINT "21 OMSÆTNING I ÅR   ",Q7
9340 CURSOR 40,17
9345 EXEC UNPACK(Q1,P4$,118,120)
9350 PRINT "22 OMSÆTNING S. ÅR   ",Q1
9355 CURSOR 1,18
9360 EXEC UNPACK(Q1,P4$,121,123)
9365 PRINT "23 DÆK. BID. TIL DATO  ",Q1
9370 IF Q7<>0 AND Q6<>0 THEN 
9375 CURSOR 65,1
9380 PRINT "GODT TAL ";Q6*Q1/Q7
9385 ENDIF 
9390 CURSOR 40,18
9395 EXEC UNPACK(Q1,P4$,124,124)
9400 PRINT "24 DÆK. GRAD S. ÅR   ",Q1
9410 CURSOR 1,19
9415 EXEC UNPACK(Q1,P4$,125,127)
9420 Q1=Q1-500000
9425 PRINT "25 ANDRE AFGANGE-TILGANGE ",Q1
9430 ENDPROC 
9435 PROC ERROR(Q8)
9440 PRINT "FEJL PAA FIL ";Q8$(1:20)
9445 PRINT "FEJLSTATUS ",A9
9450 EXEC CLOSET
9455 ENDPROC 
9460 PROC CLOSET
9465 EXEC ICLOSE(P0$)
9470 IF A9 THEN 
9475 PRINT "VAREREG LUKKET UREGLEMENTERET, SITUATIONEN MAASKE PENIBEL";
9480 PRINT "STATUS ";A9
9485 ENDIF 
9490 STOP 
9495 ENDPROC 
9500 PROC FEJL(R0)
9505 IF STATUS(R0$) THEN 
9510 PRINT "FEJL I FILSYSTEMET, FEJLNR ";STATUS(R0$)
9515 PRINT "PAA FIL ";R0$
9520 STOP 
9525 ENDIF 
9530 ENDPROC 
9600 PROC FL(FLE)
9605 A=0
9610 OUT 84,24
9615 OUT 85,FLE+64
9620 REPEAT 
9625 IN 86,64,A
9630 UNTIL A=0
9635 OUT 86,1
9640 OUT 86,0
9645 ENDPROC 
9650 PROC FF
9655 A=0
9660 REPEAT 
9665 IN 86,64,A
9670 UNTIL A=0
9675 OUT 85,192
9680 OUT 85,64
9685 ENDPROC 
9689 FILE$="ISF:VAREREG "
9690 OPEN FILE$,W
9695 EXEC PACK(0,P4$,1,152)
9700 EXEC NEXTREC(P0$,P4$,P5$)
9705 IF A9<>-1 THEN EXEC ERROR(P0$)
9708 AV=0
9710 REPEAT 
9715 PUT FILE$:P4$(1,76)
9716 IF STATUS(FILE$)<>0 THEN STOP 
9717 PUT FILE$:P4$(77,152)
9718 IF STATUS(FILE$)<>0 THEN STOP 
9720 EXEC UNPACK(Q,P4$,1,3)
9721 PRINT Q
9725 AV=AV+1
9730 EXEC NEXTREC(P0$,P4$,P5$)
9735 UNTIL A9<>0
9740 PRINT "DER ER UDSKREVET ";AV;" VARER "
9750 CLOSE FILE$
9755 IF A9<>-2 THEN EXEC ERROR(P0$)
9760 EXEC ICLOSE(P0$)
9800 PROC PACK(L8,L9,M0,M1)
9805 IF M1<M0 THEN 
9810 PRINT "PARAMFEJL I PACK"
9815 STOP 
9820 ELSE 
9823 M2=L8
9824 M3=M1
9825 REPEAT 
9830 M4=M2 MOD 100+32
9835 L9$(M3)=CHR(M4)
9840 M2=M2 DIV 100
9845 M3=M3-1
9850 UNTIL M3<M0
9851 IF M2<>0 THEN 
9852 PRINT "TAL IKKE PAKKET"
9853 STOP 
9854 ENDIF 
9855 ENDIF 
9860 ENDPROC 
9865 PROC UNPACK(L8,L9,M0,M1)
9870 L8=0
9875 IF M1<M0 THEN 
9880 PRINT "PARAMFEJL I UNPACK"
9885 STOP 
9890 ELSE 
9893 M5=M0
9895 REPEAT 
9900 L8=L8*100+ORD(L9$(M5))-32
9905 M5=M5+1
9910 UNTIL M5>M1
9915 ENDIF 
9920 ENDPROC