image of READY prompt

Wang2200.org

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 $