Listing of file='3741102A' on disk='vmedia/3741_util.wvd.zip'
# Sector 225, program filename = '3741102A'
0010 REM 3741102A 02.00(12/1/78),THIS PROGRAM IS A PRODUCT OF WANG LABS. INC.
1978
3000 % THIS MUST BE STATEMENT 3000
3020 DIM X$(4)62,X0$(1)1,Y$(4)64,F1$17,A$18,C1$(4)64,H1$64,N$64,E$(4)64,E6$(1)
2,E4$1,E5$1
3040 DEFFN1(E2)=E2*(VAL(STR(E$(1),5,1))*256+VAL(STR(E$(1),6,1))-(VAL(STR(E$(1)
,3,1))*256+VAL(STR(E$(1),4,1))))
3060 DEFFN'15
3070 PRINT HEX(03);,"CONVERT 5110 TO TC FORMAT FILE"
: PRINT "MOUNT DISK PLATTERS."
: GOSUB '254
: PRINT HEX(03);,"CONVERT 5110 FILE TO TC FORMAT"
: GOSUB '200("1","2",1,0,"ENTER MODE (1-ALL OR 2-ONE FILE)",1)
: C=Q9
3150 GOSUB '248(8,10,0)
: IF C=1THEN 3210
: C$="MODE - ONE FILE"
: PRINT C$
: GOTO 3300
3210 C$="MODE - ALL"
: PRINT C$
: STR(H1$,1,3)=HEX(0D0C0E)
: STR(H1$,4,18)="CONVERT 5110 TO TC"
: STR(H1$,22,3)=HEX(0D0A0E)
: STR(H1$,25)="INPUT NAME OUTPUT NAME"
: GOSUB '50(H1$)
3300 GOSUB '200("1","2",1,0,"ENTER OPTION (1-TRANSLATE; 2-LEAVE IN EBCDIC)",1)
: A=Q9
: IF A=1THEN 3350
: A$="LEAVE IN EBCDIC"
: GOTO 3370
3350 A$="TRANSLATE TO ASCII"
3370 GOSUB '248(9,10,0)
: PRINT "OPTION - ";A$
: GOSUB '248(1,0,3)
: IF C=2THEN 3500
: C1=16389
3450 GOSUB '91(C1)
: IF C1-16384>=27THEN 4660
: GOTO 3720
3500 GOSUB '200(" "," ",17,0,"ENTER THE INPUT FILE NAME",2)
: F1$=Q6$
: GOSUB '186(F1$)
: IF Z3-Z1>0THEN 3560
: GOSUB '255
: GOTO 3500
3560 IF STR(Z0$(2),32,7)="IBM5100"THEN 3590
: PRINT HEX(010A0A0A07);"ERROR - IMPROPER FILE TYPE"
: GOTO 3500
3590 IF Q$=" "THEN 3640
: PRINT HEX(010A0A0A07);"ERROR - FILE DOES NOT EXIST"
: GOTO 3500
3640 GOSUB '200(" "," ",8,0,"ENTER THE OUTPUT FILE NAME",2)
: Y$=Q6$
: GOSUB '229(5,Y$)
: IF R=0THEN 3720
: PRINT HEX(010A0A0A07);"ERROR - FILE ALREADY EXISTS."
: GOTO 3640
3720 GOSUB '248(10,10,1)
: PRINT "INPUT FILE NAME - ";F1$;TAB(17-LEN(F1$))
: GOSUB '248(11,10,1)
: PRINT "OUTPUT FILE NAME - ";Y$;TAB(8-LEN(Y$))
: K,X,E7,E8,Y=0
: E9=Z1
3820 GOSUB '75
: IF FN1(1)>=3THEN 3910
: GOSUB '248(1,0,3)
: PRINT "AVAILABLE SECTORS - ";FN1(1);"MINIMUM # OF SECTORS REQUIRED - 3";
: GOSUB '254
: GOTO 3820
3910 GOSUB '248(1,0,3)
3920 IF E9=Z3THEN 4570
: E7=0
: IF A=1THEN 3990
: E4$=HEX(15)
: GOSUB '197
: GOTO 4010
3990 E4$=HEX(FC)
: GOSUB '181
4010 E9=E9+1
: IF Q$<>HEX(20)THEN 4570
4050 MAT SEARCHZ$(),=E4$TO E6$()
: IF STR(Z$(1),1,1)=HEX(1E)THEN 4570
: IF E6$(1)<>HEX(0000)THEN 4330
: IF K>=2THEN 4230
: IF E9<Z1+1THEN 4230
: GOSUB '50(HEX(0D0A))
: GOSUB '50(F1$)
: GOSUB '50(" IS NOT A 5110 PROGRAM")
: IF C=2THEN 4660
: GOTO 3450
4230 Y=128-E7
: E5=Y
: IF Z$(1)=HEX(20)THEN 3920
: MAT COPY Z$()<1,Y>TO Y$()<E8+1,Y>
: E8=E8+Y
: GOTO 3920
4330 Y=VAL(E6$(1))*256+VAL(STR(E6$(1),2,1))-1
: MAT COPY Z$()<1,Y>TO Y$()<E8+1,Y>
: E8=E8+Y
: E7=E7+Y+1
: MAT COPY Z$()<Y+2,128-E7>TO Z$()
: K=K+1
: PRINT HEX(010A0A0A0A0A0A);"CONVERTING STMT - ";K
: IF X=0THEN 4840
: IF X+E8>248THEN 4910
4440 Y=Y+E5
: BIN(X0$(1))=Y
: MAT COPY X0$()<1,1>TO X$()<X,1>
: MAT COPY Y$()TO X$()<X+1,Y>
: X=X+Y+1
: E5=0
: BIN(STR(X$(1),2,1))=X
: INIT(20)Y$()
: E8=0
: GOTO 4050
4570 STR(X$(1),1,1)=HEX(F0)
: DATA SAVE DC #5,X$()
: DATA SAVE DC #5,END
: GOSUB '227(5,Y$,0)
: GOSUB '188
: IF C=2THEN 4660
: GOTO 3450
4660 PRINT HEX(03);"CONVERT 5110 TO TC FILE FORMAT"
4670 GOSUB '200(" "," ",1,0,"DO YOU WANT TO RERUN THIS PROGRAM? (Y/N)",2)
: IF Q6$="Y"THEN 3070
: IF Q6$="N"THEN 4740
: GOSUB '255
: GOTO 4670
4740 DEFFN'31
: GOSUB '229(1,"3741020A")
: IF R=1THEN 4800
: PRINT HEX(030A);"MOUNT SYSTEM DISK"
: GOSUB '254
: GOTO 4740
4800 PRINT HEX(03);"SYSTEM NOW LOADING - SYSTEM MENU"
: LOAD DC T#1,"3741020A"3000,6990
4840 GOSUB '228(5,Y$,1)
4850 INIT(20)X$()
: X$(1)=HEX(0003)
: X=3
: GOTO 4440
4910 DATA SAVE DC #5,X$()
: GOSUB '92
: GOTO 4850
4960 DEFFN'91(C1)
4970 C1=C1+1
: IF C1-16384<27THEN 5020
: RETURN
5020 Z0=C1-16384
: GOSUB '199
: C1$(1)=Z0$(1)
: C1$(3)=Z0$(3)
: F1$=STR(C1$(1),6,17)
: GOSUB '186(F1$)
: IF STR(C1$(1),1,3)<>"HDR"THEN 4970
: IF STR(C1$(3),1,1)=HEX(F8)THEN 4970
: IF Q$<>" "THEN 4970
: IF STR(Z0$(2),32,7)="IBM5100"THEN 5200
: GOTO 5230
5200 IF Z3-Z1>0THEN 5370
5230 GOSUB '50(HEX(0D0A))
: GOSUB '50(F1$)
: GOSUB '50(" IS NOT A 5110 FILE")
: GOTO 4970
5290 INIT(20)N$
: STR(N$,1,2)=HEX(0D0A)
: STR(N$,3,22)=F1$
: STR(N$,24)=" CANNOT BE CONVERTED TO 'EOD'"
: GOSUB '50(N$)
: GOTO 4970
5370 IF LEN(F1$)<=8THEN 5400
: Y$=STR(F1$,1,8)
: GOTO 5420
5400 Y$=F1$
5420 GOSUB '40
: RETURN
5460 DEFFN'40
: N0=0
5490 GOSUB '229(5,Y$)
: IF R<>0THEN 5610
: INIT(20)N$
: STR(N$,1,2)=HEX(0D0A)
: STR(N$,3)=F1$
: STR(N$,46)=Y$
: GOSUB '50(N$)
: RETURN
5610 N0=N0+1
: CONVERT N0TO STR(Y$,7,2),(##)
: GOTO 5490
5660 DEFFN'92
: LIMITS T#5,O7,O8,O9
: IF O9=O8-1THEN 5730
: RETURN
5730 DBACKSPACE #5,1S
: STR(X$(1),1,1)=HEX(F0)
: DATA SAVE DC #5,X$()
: DATA SAVE DC #5,END
: GOSUB '248(1,0,3)
: PRINT "MOUNT PLATTER TO CONTAIN NEXT VOLUME OF OUTPUT FILE"
: GOSUB '254
5820 GOSUB '75
: IF FN1(1)>=3THEN 5900
: GOSUB '248(1,0,3)
: PRINT "AVAILABLE SECTORS - ";FN1(1);" MINIMUM # OF SECTORS REQUIRED - 3";
: GOSUB '254
: GOTO 5820
5900 GOSUB '248(1,0,3)
: GOSUB '228(5,Y$,1)
: RETURN
5950 DEFFN'75
: DATA LOAD BA T#5,(0,E)E$()
: AND (STR(E$(1),3,1),7F)
: AND (STR(E$(1),5,1),7F)
: RETURN