Listing of file='ddu.027' on disk='vmedia/701-2720C.wvd.zip'
# Sector 861, program filename = 'ddu.027'
1060 COM A0$44,A1$(1792)1,A2$(5)2,A2(5),A2$,A2,A3$(500)1,A3$21,A3,A4,A5,A6,A6$
5,F1$(2)8
1062 F1$(1)="ddu.027"
: A1$()="DDA.142 DDA.143 DDA.147 DDA.148 DDA.149 "
: LOAD T<5>A1$()7000,7999BEG 1075
1075 A1$()=ALL(" ")
: PRINT AT(20,0,);"Converting Definitions: ";
: A2$()="5 525657B "
: A2(1)=80
: A2(2)=60
: A2(3)=168
: A2(4)=490
: A2(5)=170
: A0$="5 "
1110 GOSUB '132(A0$,"GT",1)
: IF M=75THEN 1180
: IF M<>0THEN 1435
: A0$=STR(X0$,1,23)
: IF STR(A0$,3,21)=" "THEN 1110
: MAT SEARCHA2$(),=STR(A0$,1,2)TO A2$STEP 2
: A2=(VAL(A2$,2)+1)/2
: IF A2=0THEN 1110
: PRINT AT(20,24,);A0$;
: K8$()=ALL(" ")
: GOSUB '133(1)
: IF M<>0THEN 1435
: GOSUB '142(A0$,A2(A2),1)
: IF M=53OR M=0THEN 1110
: F1$(2)="DM/view"
: GOTO 1445
1180 A0$="52"
: A3$=" "
: A3=1
1185 A9$=STR(A0$,1,2)
1186 GOSUB '132(A0$,"GT",2)
: F1$(2)="view/rec"
: IF M<>0AND M<>75THEN 1445
: IF M<>75THEN 1200
: IF A9$="57"THEN GOSUB 1500
: GOTO 1375
1200 A0$=STR(X0$,1,44)
: IF STR(A0$,3,42)=" "THEN 1186
: MAT SEARCHA2$(),=STR(A0$,1,2)TO A2$STEP 2
: A2=(VAL(A2$,2)+1)/2
: IF A2=0THEN 1186
: PRINT AT(20,24,);A0$
: K8$()=" "
: GOSUB '133(2)
: IF M<>0THEN 1435
: IF STR(A0$,1,2)="57"THEN 1260
: IF A9$="57"THEN GOSUB 1500
: GOSUB '142(A0$,A2(A2),2)
: F1$(2)="view fld"
: IF M<>53AND M<>0THEN 1445
: GOTO 1185
1260 IF STR(A0$,3,21)=A3$THEN 1345
: IF A3$<>" "THEN GOSUB 1500
: A1$()=ALL(" ")
: A3$=STR(K8$(),3,21)
: A3=1
1345 A4=POS(-STR(K8$(),29,224)<>" ")
: IF A4=0THEN 1365
: IF (A3+A4-1)>1792THEN 1365
: STR(A1$(),A3,A4)=STR(K8$(),29,A4)
: A3=A3+A4
1365 GOTO 1185
1375 GOSUB '134
: GOSUB '147
: PRINT AT(20,0,);HEX(020402000E07);"DATAMERGE Definitions successfully con
verted";AT(22,55);HEX(0F);"CANCEL/EDIT - Exit";
1390 KEYIN A8$
: IF A8$=HEX(F0)THEN 1415
: PRINT AT(23,0,);HEX(07);
: GOTO 1390
1415 COM CLEAR A8$
: LOAD T"@MENU"
1435 GOSUB '136
: COM CLEAR A8$
: LOAD T"@MENU"
1445 A3$()="DDA.ERR DDA.CLOSDDA.HSUB"
: LOAD T<3>A3$()7000,7999BEG 1450
1450 GOSUB '160(1,F1$(1),F1$(2))
: COM CLEAR A8$
: LOAD T"@MENU"
1500 A4=POS(-A1$()=HEX(FF))
: IF A4=0THEN 1575
: A3$()=K8$()
: A5=INT(A4/462)
: IF MOD(A4,462)>0THEN A5=A5+1
: FOR A6=1TO A5
: K8$()=" "
: A7=(A6-1)*462+1
: A8=A4-A7+1
: IF A8<1THEN 1565
: IF A8>462THEN A8=462
: STR(K8$(),1,2)="57"
: STR(K8$(),3,21)=A3$
: CONVERT A6TO A6$,(#####)
: STR(K8$(),24,5)=A6$
: STR(K8$(),29,462)=STR(A1$(),A7,A8)
1555 GOSUB '142(STR(K8$(),1,28),490,2)
: F1$(2)="vw/crit"
: IF M<>53AND M<>0THEN 1445
1565 NEXT A6
: K8$()=A3$()
1575 RETURN
8556 %DDA.143, RELEASE X01, (AUG 03, 81) FIND RECORD KEY OCCURANCE
8558 DEFFN'132(X0$,M$,X3)
: X3(4)=SGN(X3)
: X3=ABS(X3)
: MAT SEARCH"EQGTGELTLE",=M$TO X2$()STEP 2
: IF X2$(1)>HEX(0000)THEN 8564
: M=54
: GOTO 8816
8564 J0$="E G H L M "
: X2$=STR(J0$,VAL(X2$(1),2),1)
: M=52
: X1$()=ALL(00)
: X2=0
: X5=0
: X3(6)=0
: IF X1(9)=X3THEN GOTO 8574
: DATA LOAD DA T#X0,(X(X3,3))X0(),X9$
: ERRORM=ERR
: GOTO 8816
8572 X1(9)=X3
8574 X3(5)=INT((X0(6)*256)/X0(5))
: IF X0(2)=0THEN 8652
: X3(2)=1
: X3(3)=X0(2)
: X5=X1(9+X3)
: IF X5=0OR X5>X0(2)THEN 8582
: MAT COPY X5$()<(X3-1)*256+1,X0(6)*256>TO X0$()<1,X0(6)*256>
: GOTO 8586
8582 IF X3(3)-X3(2)=1AND X5=X3(2)THEN X3(2)=X3(2)+1
: X5=X3(2)+INT((X3(3)-X3(2))/2)
: % PRINTUSING "Point #### Beg #### End ####",N5;N3(2);N3(3)
8584 GOSUB '135(X(X3,3)+X0(1),X0(6),X5)
: IF X3(3)-X3(2)=1THEN X3(2)=X3(3)
8586 MAT COPY X0$()<1,X0(5)>TO X1$(2)
: IF STR(X1$(2),,X0(5)-6)<=STR(X0$,,X0(5)-6)THEN X3(2)=X5
: IF STR(X1$(2),,X0(5)-6)>=STR(X0$,,X0(5)-6)THEN X3(3)=X5
: MAT COPY X0$()<(X3(5)-1)*X0(5)+1,X0(5)>TO X1$(2)
: IF STR(X1$(2),,X0(5)-6)>=STR(X0$,,X0(5)-6)THEN X3(3)=X5
: IF STR(X1$(2),,X0(5)-6)<=STR(X0$,,X0(5)-6)THEN X3(2)=X5
8598 %IF N3(3)-N3(2)<>N2THEN 7199: N3(3)=N3(3)-1: GOTO 7200
8600 X2=X3(3)-X3(2)
: IF X3(2)<X3(3)THEN 8582
: ON POS("EGHLM"=X2$)GOSUB 8606,8616,8626,8630,8642
: GOTO 8648
8606 GOSUB 8772
: J8=VAL(X2$(1),2)
: IF J8=0THEN 8614
: GOSUB 8646
: IF J9=1THEN 8614
: GOSUB 8808
8614 RETURN
8616 GOSUB 8774
: J6=0
: M=75
8618 J6=J6+1
: J8=VAL(X2$(J6),2)
: IF J8=0THEN 8620
: GOSUB 8646
: IF J9=1THEN 8618
: IF STR(X0$(),J8,1)=HEX(FF)THEN 8624
: GOTO 8622
8620 X5=X5+1
: GOSUB '135(X(X3,3)+X0(1),X0(6),X5)
: IF STR(X0$(),,1)<>HEX(FF)THEN 8616
: M=75
: GOTO 8624
8622 GOSUB 8808
8624 RETURN
8626 GOSUB 8606
: IF M<>0THEN GOSUB 8616
: RETURN
8630 GOSUB 8776
8632 J6=0
: IF X2$(1)=HEX(0000)THEN 8638
8634 J6=J6+1
: IF X2$(J6+1)>HEX(0000)THEN 8634
: J8=VAL(X2$(J6),2)
: GOSUB 8646
: IF J9=0THEN 8636
: X2$(J6)=HEX(0000)
: GOTO 8632
8636 GOSUB 8808
: GOTO 8640
8638 X5=X5-1
: IF X5<1THEN 8640
: GOSUB '135(X(X3,3)+X0(1),X0(6),X5)
: GOTO 8630
8640 RETURN
8642 GOSUB 8606
: IF M<>0THEN GOSUB 8630
: RETURN
8646 IF STR(X0$(),J8+X0(5)-3,2)=HEX(FFFF)THEN J9=1
: ELSE J9=0
: RETURN
8648 IF M>0AND M<>52AND M<>75THEN 8816
: IF M=0AND POS("EHM"=X2$)>0AND STR(X0$,,X0(5)-6)=STR(X1$(1),,X0(5)-6)THEN
8816
8652 IF X0(4)=0THEN 8816
: %PRINT HEX(020400020E);"..ENTER ANNEX AREA..";HEX(0F);
8654 IF M<>0THEN 8656
: IF POS("LM"=X2$)>0THEN 8658
: IF STR(X1$(1),X0(5)-5,2)>HEX(0000)THEN 8660
: ELSE GOTO 8816
8656 IF POS("GH"=X2$)=0THEN 8658
: X1$(1)=ALL(FF)
: M=75
: GOTO 8660
8658 IF M=0THEN 8660
: IF POS("LM"=X2$)=0THEN 8660
: X1$(1)=ALL(00)
: M=52
: GOTO 8660
8660 X1(8)=0
: MAT SEARCHX3$(),=STR(X0$,,2)TO X2$()STEP 4
: I2=VAL(X2$(1),2)
: IF I2>0THEN 8666
: GOSUB '135(X(X3,3)+1,1,1)
: MAT COPY X0$()TO X3$()
: MAT SEARCHX3$(),=STR(X0$,,2)TO X2$()STEP 4
: I2=VAL(X2$(1),2)
: %PRINT HEX(0E);"PREFIX STACK LOADED";
8666 IF I2=0THEN 8816
: X5=VAL(STR(X3$(),I2+2),2)
8668 GOSUB '135(X(X3,3)+X0(1),X0(6),X5)
: IF X1(3)=0THEN GOTO 8672
: ELSE M=X1(3)
: GOTO 8816
8672 ON POS("EGHLM"=X2$)GOTO 8674,8684,8700,8726,8742
8674 GOSUB 8772
: X6=0
8676 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8682
: GOSUB 8646
: IF J9=1THEN 8676
: X2=1
: GOSUB 8808
8682 GOTO 8766
8684 GOSUB 8774
: X6=0
8688 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8698
: GOSUB 8646
: IF J9=1THEN 8688
: GOSUB 8788
: GOTO 8688
8698 GOTO 8766
8700 GOSUB 8772
: X6=0
8702 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8710
: GOSUB 8646
: IF J9=1THEN 8702
: GOSUB 8808
: GOTO 8724
8710 GOSUB 8774
: X6=0
8714 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8724
: GOSUB 8646
: IF J9=1THEN 8714
: GOSUB 8788
: GOTO 8714
8724 GOTO 8766
8726 GOSUB 8776
: X6=0
8730 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8740
: GOSUB 8646
: IF J9=1THEN 8730
: GOSUB 8798
: GOTO 8730
8740 GOTO 8766
8742 GOSUB 8772
: X6=0
8744 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8752
: GOSUB 8646
: IF J9=1THEN 8744
: GOSUB 8808
: GOTO 8766
8752 GOSUB 8776
: X6=0
8756 X6=X6+1
: J8=VAL(X2$(X6),2)
: IF J8=0THEN 8766
: GOSUB 8646
: IF J9=1THEN 8756
: GOSUB 8798
: GOTO 8756
8766 IF X1(8)=1THEN 8816
: I0=VAL(STR(X0$(),X0(6)*256-1),2)
: IF I0=0THEN 8816
: X5=I0
: GOTO 8668
8772 MAT SEARCHX0$()<1,X3(5)*X0(5)>,=STR(X0$,,X0(5)-6)TO X2$()STEP X0(5)
: RETURN
8774 MAT SEARCHX0$()<1,X3(5)*X0(5)>,>STR(X0$,,X0(5)-6)TO X2$()STEP X0(5)
: RETURN
8776 MAT SEARCHX0$()<1,X3(5)*X0(5)>,<STR(X0$,,X0(5)-6)TO X2$()STEP X0(5)
: RETURN
8778 MAT COPY X0$()<1,X0(6)*256>TO X5$()<(X3-1)*X0(6)*256+1,X0(6)*256>
: X(X3,1)=X5
: X(X3,2)=J8
: X1(9+X3)=X5
: M=0
: RETURN
8788 MAT COPY X0$()<J8,X0(5)>TO X1$(2)
: IF STR(X1$(2),,X0(5)-6)>=STR(X1$(1),,X0(5)-6)THEN 8796
: IF STR(X1$(2),,X0(5)-6)=STR(X0$,,X0(5)-6)THEN 8796
: GOSUB 8808
: X1(8)=0
: X2=1
8796 RETURN
8798 MAT COPY X0$()<J8,X0(5)>TO X1$(2)
: IF STR(X1$(2),,X0(5)-6)<=STR(X1$(1),,X0(5)-6)THEN 8806
: IF STR(X1$(2),,X0(5)-6)=STR(X0$,,X0(5)-6)THEN 8806
: GOSUB 8808
: X1(8)=0
: X2=1
8806 RETURN
8808 IF X3(4)=1THEN GOSUB 8778
: X3(6)=X5
: X3(7)=J8
: MAT COPY X0$()<J8,X0(5)>TO X1$(1)
: X1(8)=1
: M=0
: RETURN
8816 IF M=0AND X3(4)=1THEN MAT COPY X1$(1)<,X0(5)-6>TO X0$
: RETURN
8820 %DDA.147, RELEASE X01, (AUG 03, 81) CLOSE ALL FILES
8822 DEFFN'134
: M=0
: $OPEN #X0
: IF X(1,3)=0THEN 8842
: DATA LOAD DA T#X0,(X(01,3))X0(),X9$
: ERRORM=ERR
: GOTO 8842
8832 MAT SEARCHX9$,=STR(X1$,,3)TO X2$()STEP 3
: IF X2$(1)=HEX(0000)THEN 8842
: MAT COPY X9$<VAL(X2$(1),2)+3>TO X9$<VAL(X2$(1),2)>
: STR(X9$,46)=ALL(FF)
: DATA SAVE DA T#X0,(X(01,3))X0(),X9$
: ERRORM=ERR
8840 MAT X=ZER
8842 $CLOSE#X0
: RETURN
8844 %DDA.149, RELEASE X01, (AUG 3, 81) READ PHYSICAL BLOCK
8846 DEFFN'135(J3,J4,J5)
: %PRINT HEX(020402000E);"(..DISK ACCESS..)";HEX(0F);
8848 X1(3)=0
: X1(1)=J3+((J5-1)*J4)
: J0=0
8850 J0=J0+1
: DATA LOAD BA T#X0,(X1(1),X1(1))STR(X0$(),(J0-1)*256+1)
: ERRORX1(3)=ERR
: GOTO 8856
8854 IF J0<J4THEN GOTO 8850
8856 RETURN
8858 %DDA.144, RELEASE X01, (AUG 3, 81) READ A RECORD
8860 DEFFN'133(X3)
: M=0
: IF X(X3,1)=0OR X(X3,2)=0THEN M=61
: IF X(X3,3)=0THEN M=78
: IF M>0THEN 8886
: X1$()=ALL(00)
: M=62
: MAT COPY X5$()<(X3-1)*(256*X0(6))+X(X3,2),X0(5)>TO X1$(2)
: X1(6)=VAL(STR(X1$(2),X0(5)-3),2)
: X1(5)=VAL(STR(X1$(2),X0(5)-1),2)
: IF X1(5)=0OR X1(6)=0THEN 8886
: GOSUB '135(X(X3,3)+X0(7),X0(10),X1(6))
8876 IF X1(3)=0THEN GOTO 8878
: ELSE M=X1(3)
: GOTO 8886
8878 X1(2)=VAL(STR(X0$(),X1(5)),2)
: IF X1(2)=0THEN 8886
: MAT COPY X0$()<X1(5)+2,X1(2)>TO K8$()
: M=0
8886 RETURN
9600 DEFFN'136
: PRINT HEX(020402000E);
: PRINT AT(17,0,80);HEX(07);
: IF M<80THEN 9610
: PRINT "Disk Error(";M;")occurred while accessing definitions - Press any
key to exit";
: GOTO 9630
9610 IF M<>43THEN 9614
: PRINT "Program has not been properly initialized - Press any key to exit"
;
: GOTO 9630
9614 IF M<70THEN 9628
: ON M-69GOTO 9618,9620,9628,9628,9628,9628,9622,9624,9628,9626
9618 PRINT "Definition file is currently being reorganized - Press any key to
exit";
: GOTO 9630
9620 PRINT "Definition file is not on the specified device - Press any key to
exit";
: GOTO 9630
9622 PRINT "Definition file is full or requires reorganization - Press any key
to exit";
: GOTO 9630
9624 PRINT "Definition file is already in use by this user id. - Press any key
to exit";
: GOTO 9630
9626 PRINT "User list for Definition file is full - Press any key to exit";
: GOTO 9630
9628 PRINT "Software error(";M;")occurred while accessing definitions - Press
any key to exit";
: GOTO 9630
9630 KEYIN J8$
: IF M<>77THEN GOSUB '134
: PRINT AT(18,0,80);HEX(0F);
: RETURN
9999 % SCRATCH T"ddu.027" :SAVE <SR>T()"ddu.027"0,9999 : SCRATCH T"DDU.027"
: SAVE T()"DDU.027"0,9999