| 1 | PRCPRGRU ;WISC/RFJ-get graph in variable ;09 Feb 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | GETGRAPH(HEADING,YHEADING,XHEADING,XCODE,BARCHART,AVGFZERO,DATA) ;
|
|---|
| 8 | ; return graph in variable yline
|
|---|
| 9 | ; heading=top of graph
|
|---|
| 10 | ; yheading=yaxis heading
|
|---|
| 11 | ; xheading=xaxis heading
|
|---|
| 12 | ; xcode=mumps code to set label on xaxis
|
|---|
| 13 | ; barchart=1 for barchart
|
|---|
| 14 | ; avgfzero=1 to include zero values when calculating the average
|
|---|
| 15 | ; data(xaxis)=value
|
|---|
| 16 | ;
|
|---|
| 17 | N %,AVERAGE,AVGCOUNT,AVGFLAG,AVGLINE,CHAR,COLUMN,COUNT,DATALINE,FRONT,INCREMEN,LASTLINE,LINE,MAXVALUE,SPACE,STEP,TOTAL,TOTLENGT,TOTVALUE,VALUE,X,XAXIS,Y
|
|---|
| 18 | S SPACE=" "
|
|---|
| 19 | S YHEADING=YHEADING_SPACE
|
|---|
| 20 | S MAXVALUE=0,TOTVALUE=0,AVGCOUNT=0
|
|---|
| 21 | S X="" F TOTAL=1:1 S X=$O(DATA(X)) Q:X="" S COLUMN(TOTAL*5)=DATA(X)_"*^",TOTVALUE=TOTVALUE+DATA(X) S AVGCOUNT=$S('AVGFZERO&('DATA(X)):AVGCOUNT,1:AVGCOUNT+1) I DATA(X)>MAXVALUE S MAXVALUE=DATA(X)
|
|---|
| 22 | S AVERAGE="0.00" I AVGCOUNT S AVERAGE=$J(TOTVALUE/AVGCOUNT,0,2)
|
|---|
| 23 | S LASTLINE="",$P(LASTLINE,"+----",TOTAL+1)=""
|
|---|
| 24 | S INCREMEN=$J(MAXVALUE/6,0,2) I +INCREMEN=0 S INCREMEN=1
|
|---|
| 25 | ; build array in yline
|
|---|
| 26 | S YLINE(1)=" ^ "_HEADING
|
|---|
| 27 | S YLINE(2)=" |"_$E(SPACE,1,69)
|
|---|
| 28 | S COUNT=2
|
|---|
| 29 | F LINE=6:-1:1 D
|
|---|
| 30 | . D SETLINE(LINE)
|
|---|
| 31 | . S FRONT=$E(YHEADING,COUNT-1)_$E($J(INCREMEN*LINE,7),1,7)_"-+"
|
|---|
| 32 | . S COUNT=COUNT+1,YLINE(COUNT)=FRONT_$E(DATALINE,1,79)
|
|---|
| 33 | . D SETLINE(LINE-.5)
|
|---|
| 34 | . S FRONT=$E(YHEADING,COUNT-1)_" |"
|
|---|
| 35 | . S COUNT=COUNT+1,YLINE(COUNT)=FRONT_$E(DATALINE,1,79)
|
|---|
| 36 | S YLINE(COUNT)=$E(YLINE(COUNT),1,9)_LASTLINE_">",TOTLENGT=$L(YLINE(COUNT))
|
|---|
| 37 | S COUNT=COUNT+1,YLINE(COUNT)=$E($E(XHEADING,1,10)_SPACE,1,10)
|
|---|
| 38 | S YLINE(COUNT+1)=$E($E(XHEADING,11,20)_SPACE,1,10)
|
|---|
| 39 | S XAXIS="" F S XAXIS=$O(DATA(XAXIS)) Q:XAXIS="" S X=XAXIS K X(1) X:XCODE'="" XCODE S YLINE(COUNT)=YLINE(COUNT)_$E($J(X,5),1,5) I $D(X(1)) S YLINE(COUNT+1)=YLINE(COUNT+1)_$E($J(X(1),5),1,5)
|
|---|
| 40 | I $TR($G(YLINE(COUNT+1))," ")'="" S COUNT=COUNT+1
|
|---|
| 41 | S COUNT=COUNT+1,YLINE(COUNT)=" AVERAGE: "_AVERAGE
|
|---|
| 42 | I $G(AVGLINE) S YLINE(AVGLINE)=$E(YLINE(AVGLINE),1,10)_$E($TR($E(YLINE(AVGLINE),11,255)," -|^","===="),1,TOTLENGT-15)_" AVG"
|
|---|
| 43 | ; remove trailing spaces
|
|---|
| 44 | S X=0 F S X=$O(YLINE(X)) Q:'X D
|
|---|
| 45 | . F %=$L(YLINE(X)):-1,10 Q:$E(YLINE(X),%)'=" "
|
|---|
| 46 | . S YLINE(X)=$E(YLINE(X),1,%)
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | SETLINE(STEP) ; build line of display
|
|---|
| 51 | ; step=incerment on y-axis
|
|---|
| 52 | S DATALINE=$E(SPACE,1,69)
|
|---|
| 53 | F %=5:5 Q:'$D(COLUMN(%)) S VALUE=+COLUMN(%),CHAR=$P(COLUMN(%),"*",2) I VALUE'<(INCREMEN*STEP) D
|
|---|
| 54 | . ; set value on top of previous line
|
|---|
| 55 | . I CHAR="^" S X=$S($G(BARCHART):8,1:9),Y=X-1+%+$L(VALUE),YLINE(COUNT)=$E(YLINE(COUNT),0,X+%-1)_VALUE_$E(YLINE(COUNT),Y+1,200)
|
|---|
| 56 | . S X=" "_CHAR I $G(BARCHART),CHAR="^" S X="-----"
|
|---|
| 57 | . I $G(BARCHART),$E(DATALINE,%-5)=" " S DATALINE=$E(DATALINE,0,%-6)_$S(X["-":"-",1:"|")_$E(DATALINE,%-4,200)
|
|---|
| 58 | . S DATALINE=$E(DATALINE,0,%-5)_X_$E(DATALINE,%-3,200),$P(COLUMN(%),"*",2)="|"
|
|---|
| 59 | I AVERAGE'<(INCREMEN*STEP),'$G(AVGFLAG) S AVGFLAG=1,AVGLINE=COUNT+1
|
|---|
| 60 | Q
|
|---|
