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 $