Listing of file='VVIEW' on disk='vmedia/731-8011A.wvd.zip'
# Sector 517, program filename = 'VVIEW'
0004 REM % (c) Copyright Wang Laboratories, Inc. 1986
0005 REM % VIEW DMS/VDISK STATUS -"VVIEW" ** Nori Odoi ** Rev. 1.00 * 12/10/86
**
0010 REM % Variables used by screen subs
0015 DIM T1$(416)1, R1, S0, T1(8),S4$80,T1$1
0020 REM % Disk variables- VDISKMAP record, desired VDISK rec,temp,temp
0022 DIM F1$(50)12,F1,F$,F,F6$40
0023 REM /VDISK status file variables-Status file name,#VDISKs in file,Disk ad
dr, packing format,VS filename,#sectors,file handle, Exc/Sh,record buffer
(must be redimmed to (8)28 for VDISK config file)
0024 DIM F2$8,F2,F2$(33)3,F3$,F3$(33)8,F4$(33)8,F5$(33)8,F6$(33)10,F7$(33)2,F7
(33),F9$(8)30
0025 $FORMAT F3$=A3,A8,A8,A8,A2,P1
0027 REM / VDISK config file format
0029 $FORMAT E7$=A3,A8,A8,A8,P1
0030 REM % Storage variables-E1$()?=cntlr add,primary disk addr,config file; E
2$=2200 addr;E3$()=vol name,E4$()=libe name;E5$()=file name;E6$()=platter
size;E7()=mode;E8$()=err msgs;E1$=alternate config file name;E1=last Vdi
sk
0035 DIM E1$(4)8, E2$(33)3, E3$(33)8, E4$(33)8, E5$(33)8, E6$(33)5, E7$(3)9,E7
(33),E8$(32)21,E1, E$(33)8
: E7$(1)="Exclusive"
: E7$(2)="Read only"
: E7$(3)="Shared"
0040 REM % Input variables-D1$()=cntlr add,primary disk addr,config file; D2$=
2200 addr;D3$()=vol name,D4$()=libe name;D5$()=file name;D6$()=platter si
ze;D7()=mode;D8$()=err msgs,D1$=alternate config file name;D1=last VDISK
0045 DIM D1$(4)8, D2$(8)3, D3$(8)8, D4$(8)8, D5$(8)8, D6$(8)10, D7(8),D8$(8)21
,D1$8,D1
0050 REM % Control variables-C=EXIT,P$=Search variable, P9=Screen #,P9$='100 o
ptions,P8$=1st field,E9$=Error msg,E9=print line,E=error,V=valid flag, E5
=main loop,Work var,locator array
0055 DIM C,P$16,P9,P9$,P8$1,E9$80,E,V,E5,W$(1)66,L$(33)2,C,C1$
0070 REM % Scratch
: DIM I,J,D
0083 REM $GIO regs,DMS
: DIM A$16,V$32, V0$1,V1$1, V2$1, V3$1, V4$2, V5$2, V6$6,V7$32, V8$, V8$(16
), V9$2, V9$(16,5)
0099 REM % Goto beginning of program
0100 REM %Start
: GOTO 2000
0110 REM % **** DEFFN'44 - VDISK\A0STATUS (disk address-bottom 2 digits)
0111 REM /** Response in V0$-=0-no DMS, =1-illegal disk addr, =2-not in VDISK
table, =80h-ok. V2$=mode, V7$=SMB hdr, V9$=file handle ***
0112 REM / ** VDISK table, =80h-ok--V2$=mode, V7$=SMB hdr, V9$=file handle ***
0113 DEFFN'44(D1$)
: REM construct command
: STR(A$,7,1)=HEX(62)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(60)
: $OPEN #2,#4
: $GIO #2 (4660 4270 8701, A$)
0115 V0$=STR(A$,1,1)
: IF STR(V0$,1,1)<>HEX(00) THEN 117
: $CLOSE#2,#4
: RETURN
: REM % Send platter address
0117 $GIO #2(A000 8701,A$)D1$
: V0$=STR(A$,1,1)
: STR(V0$,1,1)=ADD HEX(01)
: IF STR(V0$,1,1)>=HEX(80) THEN 119
: $CLOSE#2,#4
: RETURN
: REM % Get SMB hdr, file handle, open mode, data block
0119 REM Get status from 2258
: V9$()=ALL(" ")
: $GIO #2 (1800 C340 1801 C340 1802 C340 8703 8704 1803 C340, A$) V7$;V9$;V
2$;STR(V9$(),1,VAL(STR(A$,3,2),2))
: V1=VAL(STR(A$,3,2),2)
0121 $CLOSE#2,#4
: RETURN
0130 REM % **** DEFFN'45 - DMS\A0STATUS -- V<0=err
0131 REM /* Response-F6$,len V1-assignment,2200SRV status,disk addr,VDISK stat
us *
0132 DEFFN'45
: V=1
: REM construct command
: F6$=ALL(00)
: STR(A$,7,1)=HEX(52)
: STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(50)
: $OPEN 138,#2,#3
: ERRORV=-1
: GOTO 139
0133 $GIO#2(4500)
: ERRORV=-1
: GOTO 139
0134 $BREAK
: FOR D=1 TO 1200
: $IF ON #2,135
: NEXT D
: V=-10
: GOTO 139
0135 $IF ON #3,137
: ERRORV=-1
: GOTO 139
0136 $GIO#3(4550 405F)
: $BREAK
: FOR D=1 TO 1200
: $IF ON #3,137
: NEXT D
: V=-10
: GOTO 139
0137 $GIO #3 (4660 4270 8703 8704 1801 C340, A$)A$;STR(F6$,1,VAL(STR(A$,3,2),2
))
: V1=VAL(STR(A$,3,2),2)
: GOTO 139
0138 V=-20
0139 $CLOSE#2,#3
: RETURN
0140 REM % **** DEFFN'48 - SET\A0DEVICE\A0TABLE(comm addr) V<0 if err
0142 DEFFN'48(A9$)
: V=1
: IF STR(A9$,1,1)<>"0" OR STR(A9$,2,1)="0" THEN 146
: HEXPACK T1$ FROM STR(A9$,2,2)
: IF MOD(VAL(T1$),4)>0 THEN 146
0143 REM /status addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #1 <A9$>
: ERRORGOTO 146
0144 REM /command addr
: T1$=ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #2 <A9$>
: ERRORGOTO 146
0145 REM /data addr
: T1$ =ADD HEX(01)
: HEXUNPACK T1$ TO STR(A9$,2,2)
: SELECT #3 <A9$>
: GOSUB '45
: IF V<0 THEN RETURN
: T$="D"
: HEXUNPACK STR(F6$,4,1) TO STR(T$,2,2)
: SELECT #4<T$>
: RETURN
0146 V=-1
: RETURN
0160 REM %** DEFFN'46-DMS\A0VERSION-ok-V0$=FFh,err=0h,response=STR(V9$(),34,V1
)
0162 DEFFN'46
: V=1
: V7$=ALL(HEX(00))
: STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF)
: STR(V7$,7,1)=HEX(2B)
: STR(V7$,23,2)=HEX(FFFF)
: V8$()=ALL(" ")
: STR(V8$(),1,3)=HEX(000000)
: GOSUB '199
: IF V0$=HEX(5A)THEN 164
: V0$=HEX(FF)
: V1=VAL(STR(V9$(),33,1))*2
: RETURN
0164 V0$=HEX(00)
: RETURN
0220 REM % **** DEFFN'50 - READ\A0MAP
0222 REM / **** Reads VDISKMAP & stores in F1$() ***
0224 DEFFN'50
: V=1
: DATA LOAD DC OPEN T"VDISKMAP"
: ERRORE=ERR
: V=0
: RETURN
0226 MAT REDIM F1$(50)12
: DATA LOAD DC F1$()
: DATA SAVE DC CLOSE
: RETURN
0230 REM % **** DEFFN'52 - GET\A0CTLR routine
0232 REM / **** OK-V=1,no addr-=-1,no platter-=-2,not in VDISKMAP-=-3 ***
0234 REM / **** If found, F1=entry else =trailer record ***
0235 DEFFN '52
: V=1
: D1$(1)=A0$
: GOSUB '48(A0$)
: IF V<0 OR STR(F6$,,1)=HEX(00) THEN RETURN
: D1$(2)=T$
0236 REM /Find configuration file
: MAT SEARCH F1$(),=STR(D1$(1),1,3) TO P$ STEP 12
: IF STR(P$,1,2)=HEX(0000) THEN GOSUB 238
: F=VAL(P$,2)
0237 REM /found address
: F1=F/12 + 1
: D1$(3)=STR(F1$(F1),4,8)
: D1$(4)=STR(F1$(F1),12,1)
: RETURN
0238 REM /gosub if controller not found
: D1$(3)=" "
: RETURN
0240 REM % **** DEFFN'55 - READ\A0VSTATUS
0242 REM / **** Inp=cntlr addr, Out=succ-V=1, open failed or empty=-1, read
******
0243 REM / **** failed-V=-2 **********
0244 DEFFN'55(F$)
: V=1
: F2$="V"&F$
: DATA LOAD DC OPEN T F2$
: ERRORE=ERR
: V=0
: RETURN
0245 F2=0
: MAT REDIM F9$(8)30
: FOR I=1 TO 5
: DATA LOAD DC F9$()
: ERRORE=ERR
: V=0
: RETURN
0246 IF END THEN I=5
: ELSE GOSUB 247
: NEXT I
: DATA SAVE DC CLOSE
: IF F2=0 THEN V=-1
: RETURN
0247 REM /gosub to unpack records
: FOR J=1 TO 8
: IF STR(F9$(J),1,3)="ZZZ" THEN 248
: F2=F2+1
: $UNPACK(F=F3$)F9$(J) TO F2$(F2),F3$(F2),F4$(F2),F5$(F2),F7$(F2),F7(F2)
: NEXT J
: RETURN
0248 REM /End of records
: I=5
: RETURN
0340 REM % **** DEFFN'65 - LOAD\A0TO\A0SCRN (specific to VVIEW)
0344 DEFFN'65(P9)
: P1= (P9*8)-7
: J=1
: D2$(),D3$(),D4$(),D5$(),D6$(),D8$()=" "
: MAT D7=ZER
: P2=P1+7
: IF P2>F2 THEN P2=F2
: FOR I=P1 TO P2
: D2$(J)=F2$(I)
: D3$(J)=F3$(I)
: D4$(J)=F4$(I)
: D5$(J)=F5$(I)
: D6$(J)=F6$(I)
: D8$(J)=E8$(I)
0348 J=J+1
: NEXT I
: RETURN
0360 REM % **** DEFFN'66 - LOAD\A0FROM\A0SCRN routine ***********************
**
0362 REM / **** Loads storage variables from screen variables ************
*
0364 DEFFN'66(P9)
: P1= (P9*8)-7
: J=1
: FOR I=P1 TO P1+7
: E3$(I)=D3$(J)
: E4$(I)=D4$(J)
: E5$(I)=D5$(J)
: E2$(I)=D2$(J)
: E8$(I)=D8$(J)
: E7(I)=D7(J)
0368 J=J+1
: NEXT I
: RETURN
0370 REM % **** DEFFN'67 - GET\A0PLATTER
0372 REM / **** Gets platter size and mode & fills platter status ***********
*
0373 REM / **** if successful, V=1, if 2200SRV problems, V=-1 ************
0374 DEFFN'67
: V=1
: IF STR(F6$,3,1)=HEX(FF) THEN 376
0375 V=-1
: RETURN
0376 FOR P1=1 TO F2
: HEXPACK T1$ FROM STR(F2$(P1),2,2)
: GOSUB '44(T1$)
: IF V0$<HEX(80) THEN 380
: IF V9$<>F7$(P1) THEN 375
: REM /Wrong file handle - System has been corrupted
: E8$(P1)=E7$(F7(P1))
0378 T=VAL(STR(V9$(),10,2),2)+(VAL(STR(V9$(),8,2),2)*65536)
: CONVERT T TO F6$(P1),(##########)
: F6$(P1)=STR(F6$(P1),POS(F6$(P1)<>"0"))
: GOTO 382
0380 REM /can't access VDISK
: E8$(P1)="Not ready"
0382 NEXT P1
: RETURN
0430 REM % **** DEFFN'72 - VDISK\A0VAL
0432 REM / **** Validates VDISK entries-V=1 if valid,<0 if not ************
0433 REM / **** V=0 if both fields blank,T=entry to validate ************
0435 DEFFN'72(T)
: V=1
: IF D5$(T)=" " OR D2$(T)=" " THEN V=-1
: IF D5$(T)=" " AND D2$(T)=" " THEN V=0
: RETURN
0460 REM % **** DEFFN'74 - FIND\A0ATTACHED/DETACHED
0461 REM / **** If T="A" then find 1st attached, else 1st detached ***
0462 REM / **** V=index if fnd, else V<0 ***
0465 DEFFN'74(F$)
: V=-2
: FOR I=1 TO 50
: IF STR(F1$(I),1,3)="ZZZ" THEN 468
: GOSUB '48(STR(F1$(I),1,3))
: IF V<0 THEN 469
: IF F$="A" THEN 466
: IF STR(F6$,,1)<>HEX(00)THEN 469
: ELSE V=I
: IF V>0 THEN RETURN
0466 IF STR(F6$,,1)=HEX(00) THEN 469
: V=I
: RETURN
0468 I=50
0469 NEXT I
: V=-5
: RETURN
0470 REM % **** DEFFN'75 - GET\A0CONTROLLER\A0STATUS routine *****************
**
0471 REM / **** If controller works, gets status. Else helps recover 2200SRV *
*
0472 REM / **** if fnd, V=1. if VS down & is term 1 V=-2, else V=-1 *********
*
0473 DEFFN'75
: D1$(3)=STR(F1$(F1),4,8)
: V=1
: IF STR(F6$,3,1)<>HEX(FF) THEN 476
: REM /open VDISK status file
: GOSUB '55(D1$(1))
: IF V=1 THEN 475
: E9$="No VDISKs open"
: V=-1
: GOTO 483
0475 REM /set up screen
: GOSUB '67
: IF V<>1 THEN 476
: REM /get status
: GOSUB '65(1)
: GOTO 483
0476 REM /DMS/VDISK disabled
: GOSUB '95
: IF V=1 THEN 477
: REM /not terminal 1 so see system administrator
: E9$="2200SRV malfunction at this controller - Please see your system admi
nistrator"
: V=-1
: GOTO 483
0477 REM /user is at terminal 1
: V=-1
: E9$="2200SRV malfunction - Please detach and re-attach this controller"
: V=-1
: GOTO 483
0479 T$=" "
: KEYIN T$
: IF T$=HEX(50) OR T$=HEX(F0) THEN 480
: IF T$=HEX(82) OR T$=HEX(A1) THEN 481
: GOTO 479
0480 REM /cancel
: PRINT AT(22,0,160);
: V=-1
: E9$="2200SRV is not responding to this controller"
: GOTO 483
0481 REM /execute
: PRINT AT(22,0,160);
: V=-2
: REM /!!!!send 2258 commands to attach to DMS & retrieve correct screen
: E9$="Returned from VS emulation"
0483 REM /Exit
: E9=99
: P9$=HEX(F218000150)
: RETURN
0600 REM % **** DEFFN'95 - CHECK\A0FOR\A0TERMINAL\A01
0606 REM / **** Return V=1 if true, V=0 if false. *****
*
0607 REM / **** NOTE - This version does not print error message. *****
*
0615 DEFFN'95
: V=1
: IF #TERM=1 THEN RETURN
: ELSE V=0
: RETURN
0950 REM % Changes in '100
0955 REM % 1007
: REM /Add display screen only option - FA-NEXT T4
: IF POS(S9$=FA)=0 THEN 1008
: REM /else only display
: RETURN
0995 REM % 1013
: REM Add '73 to prefill-MAT REDIM T1$(001)008-GOSUB '126(4,52,8,1,1,001,1,
1,D1$(3),S0$,"X",1,T9," ",1)-IF R1<=0 OR T9<>-1 THEN RETURN-D1$(3)=T1$()-
GOSUB '73-IF V=1 THEN RETURN-GOSUB '128(D1$(3),4,52,20)-RETURN
1000 DEFFN'100(S9$,S0$)
: REM Display and Accept VIEWV (VER 7.00)
1001 S4=1
: S3=01
: S2=0
: S1=0
: T0$=" "
1002 IF POS(S9$=F3)>0 THEN S4=VAL(STR(S9$,POS(S9$=F3)+1))
1003 IF POS(S9$=F2)>0 THEN T0$=STR(S9$,POS(S9$=F2)+1,4)
1004 IF POS(S9$=F6)>0 THEN GOTO 1008
: RESTORE LINE 1050
: GOSUB '129
1005 T9=0
: FOR T4=1TO 08
1006 ON T4GOSUB 1013,1018,1023,1028,1033,1038,1043,1048
1007 NEXT T4
1008 T9=-1
: IF POS(S9$=F9)>0 THEN T3=VAL(STR(S9$,POS(S9$=F9)+1))
: ELSE T3=S4
1009 ON T3GOSUB 1013
1010 ON R1GOTO ,,,,1011,1012
: RETURN
1011 T3=MOD(T3+1,S3+1)
: IF T3=0 THEN T3=S4
: GOTO 1009
1012 T3=MOD(T3-1,S3+1)
: IF T3<S4 THEN GOTO 1012
: GOTO 1009
1013 MAT REDIM T1$(001)003
: GOSUB '126(4,52,3,1,1,001,1,1,D1$(1),S0$,"X",1,T9," ",1)
: IF R1<=0 OR T9=0 THEN RETURN
: D1$(1)=T1$()
: IF VER(T1$(),"HHH")=3 THEN RETURN
: GOSUB '128("Invalid characters in field",99,0,20)
: T0$=HEX(18000150)
: GOTO 1013
1018 MAT REDIM T1$(001)008
: GOSUB '127(5,52,8,1,1,001,1,1,D1$(3)," ")
: RETURN
1023 MAT REDIM T1$(008)003
: GOSUB '127(9,1,3,8,1,008,1,1,D2$()," ")
: RETURN
1028 MAT REDIM T1$(008)008
: GOSUB '127(9,11,8,8,1,008,1,1,D3$()," ")
: RETURN
1033 MAT REDIM T1$(008)008
: GOSUB '127(9,21,8,8,1,008,1,1,D4$()," ")
: RETURN
1038 MAT REDIM T1$(008)008
: GOSUB '127(9,31,8,8,1,008,1,1,D5$()," ")
: RETURN
1043 MAT REDIM T1$(008)010
: GOSUB '127(9,43,10,8,1,008,1,1,D6$()," ")
: RETURN
1048 MAT REDIM T1$(008)021
: GOSUB '127(9,60,21,8,1,008,1,1,D8$()," ")
: RETURN
1050 DATA 01,13,00,"*****"
1051 DATA 01,21,00,"V I E W D M S / V D I S K S T A T U S"
1052 DATA 01,63,00,"*****"
1054 DATA 02,34,00,"Revision 2.0 "
1055 DATA 04,22,00,"Enter communications address:"
1056 DATA 05,27,00,"Configuration file name:"
1057 DATA 07,01,00,"2200"
1058 DATA 07,11,00,"-- VDISK Name on VS System --"
1059 DATA 07,43,00,"Platter"
1060 DATA 08,01,00,"Platter"
1061 DATA 08,11,00,"Volume"
1062 DATA 08,21,00,"Library"
1063 DATA 08,31,00,"File Name"
1064 DATA 08,43,00,"Size (sectors)"
1065 DATA 08,60,00,"VDISK Status"
1066 DATA 20,47,00,"PREV SCRN/SF2 - Previous screen"
1067 DATA 21,48,00,"NEXT SCRN/SF3 - Next screen"
1068 DATA 22,52,00,"EXEC/RUN - View new status"
1069 DATA 23,49,00,"CANCEL/EDIT - Exit"
1070 DATA 09,01,99,HEX(0006)
1071 DATA 09,11,99,HEX(0005)
1072 DATA 09,21,99,HEX(0006)
1073 DATA 09,31,99,HEX(0008)
1074 DATA 09,43,99,HEX(000D)
1075 DATA 09,60,99,HEX(000B)
1076 DATA 0,0,0," "
1649 DEFFN'199
1650 STR(V8$,7,1)=HEX(53)
1651 STR(V8$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50)
1653 $OPEN #3
: $GIO#3(466042708701,V8$)
: IF STR(V8$,1,1)<>HEX(80)THEN 1664
1655 V1=LEN(V8$())+34
: STR(V8$,6,2)=BIN(V1,2)
: $GIO#3(40E3426042701800A0001801A00040008701,V8$)V7$;STR(V8$(),,V1)
1656 IF STR(V8$,1,1)<>HEX(80)THEN 1664
1657 V9$()=ALL(" ")
: $GIO#3(870387041801C340,V8$)V8$;STR(V9$(),1,VAL(STR(V8$,3,2),2))
1658 $GIO#3(4000,V8$)
1660 $CLOSE#3
1662 V0$=HEX(FF)
: RETURN
1664 V0$=HEX(5A)
: RETURN
1999 REM % *********************** Start of Main Program *********************
2000 REM %Read VDISKMAP & get addr
: PRINT HEX(03)
: C=0
: GOSUB '50
: IF V<>1 THEN 2070
: REM /get 1st attached
: GOSUB '74("A")
: IF V<0 THEN 2070
: F1=V
2010 REM / default to first attached cntrlr
: D1$(1)=STR(F1$(F1),1,3)
: REM /open VDISK status file
: IF D1$(1)<>" " THEN GOSUB '75
: ELSE V=-1
: IF V<0 THEN 2230
2070 REM /initialize loop
: P9=1
2080 REM %Repeat loop until (EXIT = FALSE)
: REM /Display input screen
: GOSUB '100(P9$,"NP")
: E9=99
2090 REM % case ( RESPONSE(R1) )
: REM /CASE-screen not found
: IF R1=-2 THEN 2100
: REM / CASE-shift cancel/cancel, exit program
: IF R1<=0 THEN 2105
: REM / CASE-execute, do it
: IF R1=1 THEN 2125
2095 REM /CASE-previous screen
: IF R1=2 THEN 2200
: REM /CASE-next screen
: IF R1=3 THEN 2215
2100 REM % case-screen not found
: E9$="Could not access screen"
: P9$=HEX(F224000180)
: C=1
: E9=23
: GOTO 2230
2105 REM % case-shift cancel/cancel, exit program
: E9$="View DMS/VDISK Status Utility cancelled"
: C=1
: E9=23
: GOTO 2230
2125 REM %case-exec
: D1$(3),D2$(),D3$(),D4$(),D5$(),D6$(),D8$()=" "
: IF D1$(1)=" " THEN 2127
: A0$=D1$(1)
: GOSUB '52
: IF V<1 THEN 2126
: IF STR(F6$,,1)>HEX(00) THEN 2130
: E9$="Controller not attached"
: P9$=HEX(F218000150)
: GOTO 2230
2126 IF V=-1 THEN E9$="Illegal communications address"
: IF V=-10 THEN E9$="Controller not responding"
: IF V=-20 THEN E9$="Controller is being accessed by another partition"
: P9$=HEX(F218000150)
: GOTO 2230
2127 E9$="Please enter communications address"
: P9$=HEX(F218000150)
: GOTO 2230
2130 REM /get status info on controller
: GOSUB '75
: GOTO 2230
2200 REM % case-previous screen, get it if possible, or display error
: IF P9<=1 THEN 2205
: GOSUB '66(P9)
: P9=P9-1
: GOSUB '65(P9)
: P9$=HEX(F218000140)
: GOTO 2210
2205 REM /Error
: E9$="No previous screen"
: P9$=HEX(F218000140F6)
2210 P7=60
: GOTO 2230
2215 REM % case-next screen, get it if possible, or display error
: IF P9=4 THEN 2220
: REM /Validate
: GOSUB '72(8)
: IF V<=0 THEN 2220
: GOSUB '66(P9)
: P9=P9+1
: GOSUB '65(P9)
: P9$=HEX(F218000140)
: GOTO 2230
2220 REM /Error
: E9$="No next screen"
: P9$=HEX(F218000140F410F6)
2230 REM %until (EXIT = TRUE) repeat, else exit program
: PRINT AT(23,0,80);
: IF E9$<>" " THEN GOSUB '128(E9$,E9,0,20)
: E9$=" "
: IF C=0 THEN 2080
3015 REM % VIEW exit
3025 PRINT AT(23,00,80);
: GOSUB '128("Loading VS Services Menu",24,0,20)
3030 LOAD RUN "@VSMENU"
3799 REM % *********************** SCREEN SUBS - APEERS *********************
3800 REM SE.SUBS, RELEASE 7.00, (08/23/82) SCREEN SUBROUTINES
3801 DIM T1(8),T2(2),S1$,S2$124,S3$1,S4$80,T1$1,T2$80,T3$1,T4$3,T$(10)1
3802 DEFFN'126(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),S0$,S2$,T
2,T9,T$(),S9)
: S3$=S2$
: I=20
: GOSUB 3864
: T2,T5=MIN(MAX(1,T2),T1(6))
: $TRAN(T$(),HEX(202E))R
: T$(5)="5"
: R1=1
: IF S9>1THEN 3806
: IF T9<0THEN 3803
: T$(5)="5"
: T3$=S2$
: GOSUB 3831
: S2$=T3$
: IF T9=0THEN 3805
: T2=T5
3803 GOSUB 3835
: GOSUB '130(T0,T1,T1(3),S3$,T1$(T2),S0$," ",T$(),T0$)
: T1$(T2)=S4$
: IF T$(10)=" "THEN 3804
: GOSUB '125
: IF R1=-2THEN 3803
3804 IF R1<5OR R1=11OR R1=14THEN 3805
: IF R1=5THEN T2=T2+1
: IF R1=6THEN T2=T2-1
: IF T2>=1AND T2<=T1(6)THEN 3803
3805 RETURN
3806 S8$=S0$
: SELECT PRINT 205(80)
: PRINT HEX(0202020F);
: $TRAN(S2$,HEX(8520))R
: T2=T2-1
3808 T2=MAX(1,MOD(T2+1,T1(6)))
: IF STR(T1$(T2),,1)=HEX(00)THEN 3808
3810 IF T9<0THEN 3814
: T5=T2
: FOR T2=1TO T1(6)
: IF S9=2THEN 3811
: T4$=STR(S2$,T2,1)&HEX(0F09)
: GOTO 3812
3811 IF T2=T5THEN T4$=HEX(8B0E09)
: ELSE T4$=HEX(900F09)
3812 GOSUB 3835
: GOSUB 3824
: NEXT T2
: T2=T5
: IF T9=0THEN 3825
3814 IF S9=3THEN S8$=S8$&"DI"
: GOSUB 3835
: PRINT HEX(06);AT(T0-1,T1-1);
: T8=1
: GOSUB 3839
: IF S9=2AND R1>08AND R1<15THEN 3825
: IF R1<7THEN 3825
: IF S9=2THEN 3818
: IF POS(HEX(8B85)=STR(S2$,T2,1))=0THEN 3819
: ON R1-8GOTO 3815,3816
: GOTO 3819
3815 STR(S2$,T2,1)=HEX(85)
: GOTO 3817
3816 STR(S2$,T2,1)=HEX(8B)
3817 T4$=STR(S2$,T2,1)&HEX(0F09)
: GOSUB 3824
: I=1
: GOTO 3822
3818 T4$=HEX(900F09)
: GOSUB 3824
3819 ON POS(HEX(2008)=T1$)GOTO 3820,3821
: GOSUB 3826
: GOTO 3823
3820 I=1
: GOTO 3822
3821 I=-1
3822 T2=T2+I
: T2=MOD(T2,T1(6))
: IF T2=0THEN T2=T1(6)
: IF T1$(T2)=" "OR STR(T1$(T2),,1)=HEX(00)THEN 3822
3823 IF S9=3THEN T4$=STR(S2$,T2,1)&HEX(0F09)
: ELSE T4$=HEX(8B0E09)
: GOSUB 3835
: GOSUB 3824
: GOTO 3814
3824 PRINT HEX(06);AT(T0-1,T1-1);
: IF T1$(T2)>" "THEN PRINT HEX(0E);T4$;STR(T1$(T2));
: ELSE IF STR(T1$(T2),,1)>HEX(00)THEN PRINT TAB(T1-1+2);STR(T1$(T2));
: RETURN
3825 $TRAN(S2$,HEX(2085))R
: T0=T2
: PRINT HEX(0F0202000F);
: IF S2=2THEN RETURN
: MAT REDIM T1$(T1(6))1
: T1$()=S2$
: SELECT PRINT 005(80)
: RETURN
3826 T1$=OR HEX(20)
: S=-1
: IF T2=T1(6)THEN 3827
: FOR I=T2+1TO T1(6)
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3827 IF T2=1OR S>0THEN 3828
: FOR I=1TO T2-1
: T3$=STR(T1$(I),1,1)OR HEX(20)
: IF T3$<>T1$THEN NEXT I
: ELSE S=I
3828 IF S>-1THEN T2=S
: RETURN
3830 DEFFN'127(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),T$())
: $TRAN(T$(),HEX(202E))R
3831 SELECT PRINT 405(80)
: IF T$(7)=" "THEN PRINT HEX(020402000E06);
: ELSE PRINT HEX(0F06)
: FOR T2=1TO T1(6)
: GOSUB 3835
: S2$=T1$(T2)
: IF T$(3)=" "OR S2$=" "THEN 3832
: STR(S2$,,LEN(S2$))=ALL(8B)
3832 IF T$(5)>" "THEN $TRAN(S2$,HEX(8520))R
: PRINT AT(T0-1,T1-1);
: IF STR(S2$,,1)>HEX(00)THEN PRINT STR(S2$,,T1(3));
: NEXT T2
: SELECT PRINT 005(80)
: RETURN
3835 IF T$(4)>" "THEN T0=INT((T2-1)/T1(8))*T1(7)+T1(1)
: ELSE T0=MOD((T2-1),T1(4))*T1(7)+T1(1)
: IF T$(4)>" "THEN T1=MOD((T2-1),T1(8))*T1(5)+T1(2)
: ELSE T1=INT((T2-1)/T1(4))*T1(5)+T1(2)
: T0=T0+T2(1)
: T1=T1+T2(2)
: RETURN
3836 IF T0$<>" "THEN GOSUB 3860
: IF T>0THEN GOSUB 3862
: RETURN
3838 T=1
: PRINT HEX(06070E);AT(23,0,40);" Invalid key ignored";AT(T0-1,T1-2+T8);
3839 R1=99
: IF T$(9)=" "THEN PRINT HEX(02050F);
: KEYIN T1$,,3845
: GOSUB 3836
: IF T1$>HEX(82)THEN 3838
: IF T$(9)=" "THEN 3841
: IF POS(HEX(8182)=T1$)=0OR POS(S8$=T1$)=0THEN 3838
3841 IF T1$>HEX(82)THEN 3838
: ON POS(HEX(81820D)=T1$)GOTO 3847,3843,3849
: RETURN
3843 R1=1
: RETURN
3845 GOSUB 3836
: IF T1$>HEX(1F)THEN 3846
: IF POS(S8$=T1$)=0THEN 3846
: R1=4
: S0=VAL(T1$)
: RETURN
3846 ON POS(HEX(F01F50)=T1$)GOTO 3847,3847,3848
: IF T$(9)=" "THEN ON POS(HEX(7E7F)=T1$)GOTO 3849,3850
: GOTO 3851
3847 R1=0
: RETURN
3848 R1=-1
: RETURN
3849 R1=5
: RETURN
3850 R1=6
: RETURN
3851 T1$=AND HEX(0F)
: IF POS(HEX(0203050608090A0C0D)=T1$)>0THEN 3852
: GOTO 3838
3852 $TRAN(T1$,HEX(0B060E05))R
: R1=VAL(T1$)
: T2$="*PN****EDIuewd**"
: IF POS(S8$=STR(T2$,R1,1))>0THEN RETURN
: GOTO 3838
3853 ON POS(HEX(2008)=T1$)GOTO 3854,3855
: GOTO 3856
3854 IF T$(4)>" "THEN R1=12
: ELSE R1=14
: GOTO 3856
3855 IF T$(4)>" "THEN R1=13
: ELSE R1=11
3856 I=T1(6)
: IF T$(4)=" "THEN 3857
: IF R1=14THEN T2=MOD(T2+T1(8),I)
: IF R1=11THEN T2=MOD(T2-T1(8),I)
: GOTO 3858
3857 IF R1=14THEN T2=MOD(T2+1,I)
: IF R1=11THEN T2=MOD(T2-1,I)
3858 IF T2=0THEN T2=T1(6)
: IF T2>T1(6)THEN 3853
: RETURN
3860 FOR I=1TO VAL(STR(T0$,3))
: PRINT HEX(06);AT(VAL(STR(T0$,1))-2+I+T2(1),VAL(STR(T0$,2))+T2(2),VAL(STR(
T0$,4)));
: NEXT I
: T0$=" "
: GOSUB 3898
: RETURN
3862 PRINT HEX(06);AT(23,0,40);
: T=0
: GOSUB 3898
: RETURN
3864 S1$=HEX(0204)&BIN(I/10)&BIN(MOD(I,10))&HEX(0E)
: PRINT STR(S1$,,5);
: RETURN
3866 DEFFN'128(S2$,T0,T1,I)
: SELECT PRINT 005(80)
: IF T0=99THEN PRINT HEX(07);
: IF T1=99THEN T1=40-(LEN(S2$)/2)
: T0=MIN(24,T0)
: T1=MAX(1,T1)
: GOSUB 3864
: I=1
: STR(S2$,LEN(S2$)+1,1)=HEX(AF)
: S=POS(S2$=HEX(AF))
3867 PRINT HEX(06);AT(T0-1,T1-1);STR(S2$,I,S-1);
: I=I+S
: S=POS(STR(S2$,I)=HEX(AF))
: T0=T0+1
: IF S>0THEN 3867
: PRINT HEX(020402000F06);
: RETURN
3869 DEFFN'129
: SELECT PRINT 205(80)
3870 READ T0,T1,I,S4$
: ERRORR1=-2
: RETURN
3871 IF T0=0THEN RETURN
: T0=T0+T2(1)
: T1=T1+T2(2)
: IF I=99THEN 3872
: IF I=0THEN PRINT HEX(0F);
: ELSE GOSUB 3864
: PRINT HEX(06);AT(T0-1,T1-1);STR(S4$,,LEN(S4$));
: GOTO 3870
3872 PRINT HEX(06);AT(T0-1,T1-1);BOX(VAL(S4$),VAL(STR(S4$,2)))
: GOTO 3870
3874 DEFFN'130(T0,T1,T5,S2$,S4$,S8$,T2$,T$(),T0$)
: SELECT PRINT 405(80)
: PRINT HEX(0202000F020402000E);
: $TRAN(T$(),HEX(202E))R
: IF T2$>" "THEN PRINT HEX(060F);AT(T0-1,T1-2-LEN(T2$));T2$;HEX(0E);
: S2$=ALL(S2$)
: T6=POS("H#X"=S2$)
: PRINT HEX(0202020F);
: T8=1
: IF T$(9)>" "THEN 3876
: GOSUB 3897
: IF S8$<>" "THEN S8$=S8$&"IDEew"
: ELSE S8$="IDEew"
3876 GOSUB 3839
: IF T$(9)>" "THEN 3905
: IF R1<7THEN 3899
: IF R1=11OR R1=14THEN 3899
: ON R1-7GOTO 3880,3884,3882,3876,3886,3890,3876
: IF T1$=HEX(08)THEN 3890
: IF T8<=T5THEN 3878
: PRINT HEX(07);
: GOTO 3876
3878 STR(S4$,T8,1)=T1$
: $TRAN(T1$,HEX(8020))R
: IF T$(3)=" "THEN PRINT HEX(0E);T1$;
: ELSE PRINT HEX(0E8B);
: GOTO 3887
3880 IF T5<T8THEN 3876
: STR(S4$,T8)=" "
: GOSUB 3897
: GOTO 3876
3882 IF T5<T8THEN 3876
: MAT COPY -S4$<T8,T5-T8>TO -S4$<T8+1,T5-T8>
: STR(S4$,T8,1)=" "
: GOSUB 3897
: GOTO 3876
3884 IF T5<T8THEN 3876
: MAT COPY S4$<T8+1,T5-T8>TO S4$<T8,T5-T8>
: STR(S4$,T5,1)=" "
: GOSUB 3897
: GOTO 3876
3886 IF T8<T5+1THEN PRINT HEX(09);
3887 IF T8<>T5THEN 3888
: IF T$(1)=" "THEN 3888
: R1=5
: GOTO 3899
3888 T8=MIN(T5+1,T8+1)
: GOTO 3876
3890 IF T8>1THEN 3891
: IF T$(2)=" "THEN 3876
: R1=6
: GOTO 3899
3891 PRINT HEX(08);
: T8=T8-1
: IF T1$<>HEX(08)THEN 3876
: STR(S4$,T8,1)=" "
: PRINT HEX(8508);
: GOTO 3876
3892 PRINT HEX(06070E);AT(23,0,50);T2$;
: T=1
: GOSUB 3898
: GOTO 3876
3893 T2$=" Invalid key ignored"
: GOTO 3892
3894 T2$=" Information required, please enter"
: GOTO 3892
3895 T2$=" Invalid characters in field"
: GOTO 3892
3897 PRINT HEX(06);AT(T0-1,T1-1);
: T2$=S4$
: IF T$(3)>" "AND T2$>" "THEN STR(T2$,,LEN(T2$))=ALL(8B)
: $TRAN(T2$,HEX(8520))R
: PRINT STR(T2$,,T5);
3898 PRINT HEX(06);AT(T0-1,T1-2+T8);
: RETURN
3899 IF T$(7)=" "OR T$(3)>" "THEN 3900
: PRINT HEX(0F);
: GOSUB 3897
3900 $TRAN(S4$,HEX(20802085))R
: IF R1<1THEN 3902
: IF S4$=" "AND T$(6)>" "THEN 3894
3902 ON T6GOTO 3904,3903,3905
: GOTO 3904
3903 IF NUM(S4$)<T5THEN 3895
: GOTO 3905
3904 IF S4$>" "AND VER(STR(S4$,,T5),S2$)<T5THEN GOTO 3895
3905 SELECT PRINT 005(80)
: PRINT HEX(0F0202000F);
: RETURN
3906 % S$="SE.SUBS ": SCRATCH TS$: SAVE <S>T()S$3800,3999: PRINT HEX(0E);S$;H
EX(0F);" updated"
4000 REM % *********************** Text Messages *********************
4010 REM / Disk error messages
4020 DATA "D80 File not open"
4022 DATA "D81 File full"
4024 DATA "D82 File not in catalog or not a data file"
4026 DATA "D83 File already cataloged"
4028 DATA "D84 File not scratched"
4030 DATA "D85 Index full"
4032 DATA "D86 Catalog end error"
4034 DATA "D87 No end-of-file"
4036 DATA "D88 Wrong record type"
4038 DATA "D89 Sector address beyond end-of-file"
4040 DATA "I90 Disk hardware error"
4042 DATA "I91 Disk hardware error"
4044 DATA "I92 Timeout error"
4046 DATA "I93 Format error"
4048 DATA "I94 Format key engaged"
4050 DATA "I95 Device error"
4052 DATA "I96 Data error"
4054 DATA "I97 Longitudinal redundancy check error"
4056 DATA "I98 Illegal sector address or platter not mounted"
4058 DATA "I99 Read-after-write error"
8135 REM
8230 REM
9089 REM /increment VDISK address
: D1$=E1$ AND HEX(0F)
: IF D1$=HEX(0F) THEN E1$=ADD HEX(30)
: E1$=ADD HEX(01)
: NEXT I
9989 REM % *********************** Useful Text Constants *********************
9992 DEFFN '16 "LIST S"
9994 DEFFN '17 "LIST SD 2000,"
9996 DEFFN '18 "LIST SD 132,"
9997 DEFFN '19 "LIST SD 374, "
9999 DEFFN '31 "SCRATCH T";HEX(22);"VVIEW";HEX(22);": SAVE T()";HEX(22);"VVIE
W";HEX(22)