Listing of file='FCST114A' on disk='vmedia/701-2663.wvd.zip'
# Sector 195, program filename = 'FCST114A'
0010 REM FCST114A, MVP RELEASE 1-0, (02/01/79), THIS PROGRAM IS A COPYRIGHT PR
ODUCT OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT
ED, PROFILE PRINT ROUTINE
0300 COM M1$1,F6$8,F7$3
: DIM G1$10,B(13),C5$1,L2$20,L4$(2)4,L(4,13),M$(4)62,A5$1,L$20,A5$1
: DIM Q$1,R1$8,R4$,R9$8,R9$(16)
: DIM G7$(39)1,B6(13),G8$64,G9$4
0380 % #.# +
0390 % #.##
0400 % ###
0410 % ####
0430 % ##
0460 GOTO 4225
0510 DEFFN'79(N)
: Q$=" "
: DATA LOAD DC #N,M$()
: $UNPACK(F=L$)M$()TO G1$,C5$,A5$,B(),L2$,L4$(),L1,L2,L5,L()
: IF END THEN 560
: RETURN
0560 Q$="E"
: RETURN
0590 DEFFN'69(N)
: $PACK(F=L$)M$()FROMG1$,C5$,A5$,B(),L2$,L4$(),L1,L2,L5,L()
: DATA SAVE DC #N,M$()
: RETURN
0650 PRINT TAB(5);"+";
: FOR B6=0TO 5*P
: PRINT "-";
: NEXT B6
: PRINT "+"
: RETURN
4060 DEFFN'90
: SELECT PRINT <I0$>(80)
: PRINT HEX(0C)
: RETURN
4180 PRINT TAB(5);"+";
: FOR B6=0TO 5*P
: PRINT "-";
: NEXT B6
: PRINT "+"
: RETURN
4225 SELECT PRINT 005(64),CO 005,P
: L$=HEX(A00AA001A0015202A014A0046005600160015003)
: DBACKSPACE #2,BEG
4275 GOSUB '79(2)
: IF Q$="E"THEN GOSUB '31
: IF M1$="A"THEN 4350
: IF C5$="P"THEN 4275
4350 PRINT HEX(030A0A0A0A0A0A0A);TAB(18-.5*LEN(G1$));"* * PRINTING PROFILE "
;G1$;" * *"
: GOSUB '90
: PRINT HEX(0A0E);L2$
: PRINT HEX(0A);"ID CODE = ";G1$;TAB(59);L5$
: IF A5$<>C5$THEN 4405
: PRINT HEX(0A0A);"*** PROFILE GENERATOR HAS NOT BEEN RUN ON THIS FILE ***"
: PRINT HEX(0A0A)
: GOTO 4645
4405 GOSUB 4180
: MAT B6=ZER
: INIT("N")G7$()
: INIT(" ")G8$
: PRINT TAB(5);"! ";
: FOR B6=1TO P
: B7=INT(B(B6)*10+.5)
: IF B7=0THEN 4520
: IF B7<39THEN 4510
: G9$="HHHH"
: IF B7>39THEN 4485
: G9$="****"
4485 PRINT TAB(5*B6+2);G9$;
: STR(G8$,5*B6-4,4)="****"
: B7=39
4510 G7$(B7)="Y"
4520 B6(B6)=B7
: NEXT B6
: PRINT TAB(7+5*P);"!"
: FOR B6=38TO 1STEP -1
: IF B6/5<>INT(B6/5)THEN 4570
: PRINTUSING 380,B6/10;
: G9$="+"
: GOTO 4585
4570 PRINT TAB(5);"! ";
: G9$="!"
4585 IF G7$(B6)="N"THEN 4620
: FOR B7=1TO P
: IF B6(B7)<>B6THEN 4610
: STR(G8$,5*B7-4,4)="****"
4610 NEXT B7
4620 PRINT G8$;TAB(7+5*P);G9$
: NEXT B6
: GOSUB 4180
4645 PRINT TAB(5);
: FOR B6=1TO P
: PRINTUSING 400,P$(B6);
: NEXT B6
: PRINT
: PRINT TAB(6);
: FOR B6=1TO P
: PRINTUSING 390,B(B6);
: NEXT B6
: PRINT
: IF A5$="B"THEN 4805
: CONVERT STR(L4$(1),3,2)TO B9
: PRINT HEX(0A0A);"YEAR SALES";TAB(40);"SCALE - ";L1
: CONVERT STR(L4$(1),1,2)TO Q9
: C8=L2+Q9-1
: IF MOD(C8,P)>0THEN B8=INT(C8/P)+1
: ELSE B8=INT(C8/P)
: FOR B7=1TO B8
: PRINTUSING 430,B9+B7-1;
: FOR B6=1TO P
4770 IF (B7-1)*P+B6<Q9OR (B7-1)*P+B6>L2+(Q9-1)THEN 4785
: PRINTUSING 410,L(B7,B6);
: GOTO 4790
4785 PRINTUSING 410;" ";
4790 NEXT B6
: PRINT
: NEXT B7
: IF L5<POR A5$=C5$THEN 4805
: PRINT HEX(0A0A);"INDICES WERE GENERATED WITH";L5;"PERIODS OF DATA BEGINNI
NG - ";L4$(2)
4805 IF C5$="P"THEN 4275
: IF A5$=C5$THEN 4820
: C5$="P"
4820 DBACKSPACE #2,1S
: GOSUB '69(2)
: GOTO 4275
4880 DEFFN'31
: SELECT PRINT 005
: PRINT HEX(010A);TAB(20);"** TERMINATING PROGRAM **";TAB(64)
: GOSUB '219(F6$,2,1,F7$,0)
: $CLOSE#15
: COM CLEAR M1$
: LOAD DC T#0,M$
5100 DEFFN'217(R9$,R9,R8,R1,Q9,Q6$,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8,R
: Q$="D"
: IF ABS(R)=1THEN 5200
: IF R1<=0THEN 5130
: IF R=2THEN 5200
: Q9=4
: Q$="S"
: IF R=0THEN 5110
: IF Q7-Q6+1<R1THEN 5200
: DATA SAVE DC OPEN T#R9,R9$,R9$
: GOTO 5140
5110 DATA SAVE DC OPEN T#R9,R1,R9$
: ERRORGOTO 5200
5120 LIMITS T#R9,Q6,Q7,Q8
: GOTO 5140
5130 IF R<2THEN 5200
5140 GOSUB 5240
: Q$="M"
: IF STR(R9$(1),4,4)<>HEX(FD4D5558)AND R1=-2THEN 5200
: IF STR(R9$(1),4,4)=HEX(FD4D5558)THEN 5150
: STR(R9$(1),4,4)=HEX(FD4D5558)
: R9$(2)=Q6$
: STR(R9$(),33)=" "
5150 Q$="P"
: IF Q6$<>R9$(2)THEN 5200
: Q$="A"
: Q6$=STR(R9$(),33,48)
: IF STR(Q6$,R8,1)=" "XOR R1<>-1THEN 5200
: STR(Q6$,R8,1)=" "
: ON Q9-1GOTO 5160,5170,5190
: R1$=" 1 2 3"
: GOTO 5180
5160 R1$=" 1 2"
: GOTO 5180
5170 R1$=" 1 3"
5180 $TRAN(Q6$,R1$)R
5190 IF Q6$<>" "THEN 5200
: CONVERT Q9TO STR(R9$(),32+R8,1),(#)
: GOSUB 5250
: DATA LOAD DC OPEN T#R9,R9$
: Q$=" "
5200 IF R2=0THEN $CLOSE#R9
: RETURN
5210 DEFFN'218(R9$,R9,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,Q6,Q7,Q8
: Q6=Q8-Q6+2
: R9$()=HEX(A0)
: DATA SAVE BA T#R9,(Q8)R9$()
: GOSUB 5240
: STR(R9$(),2,2)=BIN(Q6,2)
: GOSUB 5250
: DATA LOAD DC OPEN T#R9,R9$
: DSKIP #R9,END
: GOTO 5200
5220 DEFFN'219(R9$,R9,R8,R4$,R2)
: $OPEN #R9
: LIMITS T#R9,R9$,Q6,Q7,Q8
: GOSUB 5240
: STR(R9$(),32+R8,1)=" "
: GOSUB 5250
: DATA SAVE DC CLOSE#R9
: GOTO 5200
5230 DEFFN'215(R4$,Q4)
: MAT SEARCH"310B10320B20330B30350B50360B60370B70",=STR(R4$,,3)TO STR(R4$,4
,2)STEP 3
: ON (VAL(STR(R4$,4),2)+2)/3SELECT #15/310;#15/B10;#15/320;#15/B20;#15/330;
#15/B30;#15/350;#15/B50;#15/360;#15/B60;#15/370;#15/B70
: ELSE RETURN
: IF Q4=0THEN $CLOSE#15
: ELSE $OPEN #15
: RETURN
5240 DATA LOAD BA T#R9,(Q7,Q8)R9$()
: RETURN
5250 DATA SAVE BA T#R9,(Q7,Q8)R9$()
: RETURN