Listing of file='START' on disk='vmedia/701-2003.wvd.zip'
# Sector 252, program filename = 'START'
0010 REM BAS1A MODULE=START
0012 REM 2200 STANDARDS UTILITIES
0013 REM UPDATED 5/30/74
0014 COM Q1,Q5$1,Q6$64,W$8,W3$3,W4$1,W$(3)8,Q4(3),Q5(3),Q1$8
0015 COM U1,Z
0016 DIM U(12),U$10
0100 REM ******************************************************
0110 REM DEFFN'241 END OF VOL./FILE OUTPUT
0120 REM \CE'240 OPEN OUTPUT FILE
0130 REM DEFFN'251 CLOSE INPUT VOL.
0140 REM \CE'250; OPEN FILE INPUT
0150 REM \CE'254; OPERATOR WAIT
0160 REM DEFFN' 243 ACCEPT ALPHA DATA W/MESSAGE
0170 REM DEFFN' 244 ACCEPT ALPHA DATA
0175 REM DEFFN' 245 ACCEPT NUMERIC DATA W/MESSAGE
0178 REM DEFFN' 246 ACCEPT NUMERIC DATA
0180 REM \CE'248; POSITION CURSOR
0190 REM ******************************************************
0200 REM START UP, GET TODAY'S DATE, JULIAN
0220 SELECT PRINT 005
: PRINT HEX(03)
: GOSUB 400
0230 LOAD DC F "SACMENU"10,8499
0240 U(1)=0
: U(2)=31
: U(3)=60
: U(4)=91
: U(5)=121
: U(6)=152
: U(7)=182
: U(8)=213
: U(9)=244
: U(10)=274
: U(11)=305
: U(12)=335
: U$="0123456789"
: RETURN
0250 V4=V4-100*INT(V4/100)
: V=INT(V4/10)
: STR(U3$,V5,1)=STR(U$,V+1,1)
: STR(U3$,V5+1,1)=STR(U$,V4-10*V+1,1)
: RETURN
0260 V3=0
: FOR V2=1TO LEN(U3$)
: U0$=STR(U3$,V2,1)
: FOR V=1TO 10
: IF U0$=STR(U$,V,1)THEN 270
: NEXT V
: RETURN
0270 V3=10*V3+V-1
: NEXT V2
: RETURN
0280 GOSUB 260
: U1=V3
: U3$=STR(U3$,V2+1)
: GOSUB 260
: U2=V3
: U3$=STR(U3$,V2+1)
: GOSUB 260
: U3=V3
: RETURN
0290 V=INT((U1-1)/12)
: U3=U3+V
: U1=U1-12*V
: U4=U(U1)+U2-SGN(U3-4*INT(U3/4))*(SGN(U1-2.5)+1)/2
: RETURN
0300 U0=1000*U3+U4
: RETURN
0310 U3=INT(U0/1000)
: U4=U0-1000*U3
: RETURN
0320 U1=SGN(U3-4*INT(U3/4))
: U2=U4+(SGN(U4-60.5+U1)+1)/2*U1
: FOR U1=1TO 11
: IF U2<=U(U1+1)THEN 330
: NEXT U1
: U1=12
0330 U2=U2-U(U1)
: RETURN
0340 V4=U1
: V5=1
: GOSUB 250
: V4=U2
: V5=4
: GOSUB 250
: V4=U3
: V5=7
: GOSUB 250
: STR(U3$,3,1),STR(U3$,6,1)="/"
: RETURN
0350 U5=U4+INT(365.25*(U3-1))
: RETURN
0360 U4=INT(U4)
0370 V=366-SGN(U3-4*INT(U3/4))
: IF U4<V+1THEN 390
: U3=U3+1
: U4=U4-V
: GOTO 370
0380 V=366-SGN(U3-1-4*INT((U3-1)/4))
: U3=U3-1
: U4=U4+V
0390 IF U4<1THEN 380
: RETURN
0400 GOSUB 240
0410 GOSUB '243("ENTER TODAY'S DATE AS MM/DD/YY",8)
: U3$=Q6$
: GOSUB 280
: GOSUB 290
: GOSUB 300
: Q1=U0
: GOSUB 310
: GOSUB 320
: GOSUB 340
: Q1$=U3$
: GOSUB '248(0,0,1)
0420 PRINT Q1$,Q1
: GOSUB '243("OK (Y OR N)",1)
0430 IF Q6$="N" THEN 410
: GOSUB '248(1,0,3)
: RETURN
8500 REM ******************************************************
8505 REM '241 END OF VOL./FILE OUTPUT
8510 REM \CE'240 OPEN OUTPUT FILE
8520 DEFFN'241 (W,W3$)
8535 GOSUB 9575
: REM *WRITE TRAILER
8536 DATA SAVE DC $ #W,END
8537 DATA SAVE DC CLOSE#W
8540 GOSUB '247("REMOVE AND LABEL")
8565 IF W3$= "EOF" THEN 8705
8570 Q5(W)=Q5(W)+1
8580 DEFFN'240(W,W$(W),Q4(W),Q5(W))
8595 GOSUB '247("MOUNT SCRATCH VOL. TO BECOME")
8600 GOSUB 9480
: REM *OPEN VOL.
8625 GOSUB 9525
: REM *READ HEADER
8635 IF Q6$="X" THEN 8690
8640 DEFFNA(Q)=Q-1000*INT(Q/1000)+INT(365.25*INT(Q/1000))
8650 IF Q4+FNA(W1)-FNA(Q1)<= 0 THEN 8690
8670 GOSUB 8710
: REM *CURSOR(3,0,1)
8675 PRINT "RETENTION CYCLE NOT EXPIRED"
8680 GOTO 8580
8690 W3$="HDR"
8692 SCRATCH T #W,"SCRATCH"
8693 DATA SAVE DC OPEN T #W,"SCRATCH","SCRATCH"
8695 GOSUB 9575
: REM *WRITE HEADER
8705 GOSUB 9288
: REM *CURSOR(0,0.1)
8710 Q6=3
: GOTO 9289
: REM *(CURSOR(3,0,1)
8735 REM *******************************************************
8740 REM DEFFN'251; CLOSE INPUT VOL.
8745 REM \CE'250; OPEN FILE INPUT
8755 DEFFN'251(W)
8765 GOSUB 9525
: REM *READ TRAILER
8775 Q5$=STR(W3$,3,1)
8780 IF Q5$= "F" THEN 8705
8785 Q5(W)=Q5(W)+1
8795 DEFFN'250(W,W$(W),Q5(W))
8805 GOSUB ' 247("MOUNT")
8820 GOSUB 9480
: REM *OPEN VOL.
8830 GOSUB 9525
: REM *READ HEADER
8840 IF Q6$="X" THEN 8705
8842 IF W$<>W$(W) THEN 8855
8845 IF Q5=Q5(W) THEN 8705
8855 GOSUB 8710
: REM *CURSOR(3,0,1)
8860 PRINT "INCORRECT VOL."
8870 GOTO 8795
8895 % VOL. ## OF FILE ######## - UNIT #
8905 REM *******************************************************
8910 REM \CE'254; OPERATOR WAIT
8920 DEFFN'254
8925 GOSUB '243("KEY RETURN(EXEC) TO RESUME",0)
8930 W4$=Q6$
8935 GOSUB '248(0,0,4)
8940 Q6$=W4$
8945 RETURN
8950 REM ******************************************************
8952 REM DEFFN'242;
8955 REM DEFFN'243; ACCEPT ALPHA DATA W/ MESSAGE
8960 REM DEFFN'244; ACCEPT ALPHA DATA
8965 REM DEFFN'245; ACCEPT NUMERIC DATA W/ MESSAGE
8970 REM DEFFN'246; ACCEPT NUMERIC DATA
8975 DEFFN'242(W0,Q6$)
8980 IF W0<=0 THEN 9405
8981 IF W0=1 THEN 8990
8985 STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
9000 RETURN
9010 DEFFN'243(Q6$,Q0)
9020 GOSUB 9200
9022 SELECT CO 205
9023 Q6$=" "
9024 INPUT Q6$
9026 IF Q0=0 THEN 9231
9028 IF LEN(Q6$)<=Q0 THEN 9231
9030 GOSUB 9150
9032 DEFFN'244(Q0)
9033 GOSUB 9220
9034 GOSUB 9210
9036 GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
9040 Q0=ABS(Q2)+Q3+1
9042 GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOSUB 9220
9046 SELECT CO 205
9048 Q9,W0=-1E-99
9050 INPUT Q9
9052 IF W0=Q9 THEN 9058
9054 IF Q9>= 0 THEN 9070
9056 IF Q2<= 0 THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
9062 Q0=ABS(Q2)+Q3+1
9063 GOSUB 9220
9064 GOSUB 9210
9066 GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2) THEN 9058
9072 W0=ABS(Q9*10^Q3)
9074 IF INT(W0)<>W0 THEN 9058
9076 GOTO 8710
9150 GOSUB 8710
: PRINT "RE-ENTER"
: RETURN
9200 GOSUB 9405
: PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
9220 PRINT HEX(010A0A)
9230 RETURN
9231 PRINT HEX(0A);TAB(64)
: GOTO 9405
9275 REM ******************************************************
9280 REM \CE'248; POSITION CURSOR
9288 Q6=0
9289 Q7=0
: Q8=1
9290 DEFFN'248(Q6,Q7,Q8)
9291 GOSUB 9405
9295 IF Q8<1 THEN 9350
9300 GOSUB 9350
9305 SELECT PRINT 205
9310 Q6$=" "
9315 PRINT STR(Q6$,Q7+1)
9320 IF Q8<2 THEN 9350
9325 FOR W0=2 TO Q8
9330 PRINT HEX(0A);STR(Q6$,1)
9335 NEXT W0
9350 PRINT HEX(01)
9360 GOSUB '242(Q7,HEX(09))
9370 GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
9410 RETURN
9415 REM ******************************************************
9461 DEFFN'247(Q6$)
9464 GOSUB 9405
: PRINT HEX(01);Q6$;
9465 PRINTUSING 8895,Q5(W),W$(W),W;
9466 PRINT TAB(64)
9467 GOSUB '254
: REM OPERATOR WAIT
9470 RETURN
9480 DATA LOAD DC OPEN T #W,"SCRATCH "
9490 RETURN
9510 REM ******************************************************
9515 REM READ HEADER/TRAILER RECORD (FROM UNIT W)
9525 IF W>1 THEN 9540
9530 DATA LOAD DC #1,W3$,W$,W1,Q4,Q5
9535 RETURN
9540 IF W>2 THEN 9555
9545 DATA LOAD DC #2,W3$,W$,W1,Q4,Q5
9550 RETURN
9555 DATA LOAD DC #3,W3$,W$,W1,Q4,Q5
9557 RETURN
9560 REM ******************************************************
9565 REM WRITE HEADER/TRAILER RECORD (ONTO UNIT W)
9575 IF W>1 THEN 9590
9580 DATA SAVE DC #1,W3$,W$(W),Q1,Q4(W),Q5(W)
9585 RETURN
9590 IF W>2 THEN 9605
9595 DATA SAVE DC #2,W3$,W$(W),Q1,Q4(W),Q5(W)
9600 RETURN
9605 DATA SAVE DC #3,W3$,W$(W),Q1,Q4(W),Q5(W)
9610 RETURN
9620 REM $