KMPDUG1 ;OAK/RAK - CM Tools Graph Utility ;2/17/04 09:58
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
DRAW ;-- draw graph
W @IOF,!,IOG1 S DY=2
; draw top line
F I=1:1:27 S DX=41+I X IOXY W IOHL S DX=43-I X IOXY W IOHL
; draw top left and right corners
S DX=15 X IOXY W IOTLC S DX=68 X IOXY W IOTRC,!
; draw sides
F DY=(DY+1):1:BOTTOM F DX=15,68 X IOXY W IOVL,!
; draw bottom left and right corners
S DY=BOTTOM,DX=15 X IOXY W IOBLC S DX=68 X IOXY W IOBRC,!
; draw bottom line
F I=1:1:27 S DX=15+I X IOXY W IOHL S DX=68-I X IOXY W IOHL
; draw 'hash marks' on bottom line for relative values
S DX=15 X IOXY W IOLT,!
F DX=20:5:65 X IOXY W IOMT,!
; print grid
I KMPUOPT["G" D
.S DY=2 F DX=20:5:65 X IOXY W IOTT,!
. F DX=20:5:65 F DY=3:1:(BOTTOM-1) X IOXY W IOVL,!
W IOG0
Q
INIT ;-- initialize required variables.
D GSET^%ZISS S X="IOECH;IORVOFF;IORVON;IOUOFF;IOUON" D ENDR^%ZISS
; actual bars representing data
S BAR(0)="IORVON,"" "",IORVOFF"
S BAR(1)="IOG1,""a"",IOG0"
S (DEC,DNUM,MAX,MIN,SCALE,YNUM)=0,GWIDTH=$S(KMPUOPT["V":10,1:50)
S TITLE=$P($G(KMPUTI),U,1,2)
S XTITLE=$P($G(KMPUTI),U,3)
S YTITLE=$P($G(KMPUTI),U,4)
; determine maximum and minimum number and decimals (if any).
S (I,MAX,MIN)=""
F S I=$O(@KMPUAR@(I)) Q:I="" I $D(@KMPUAR@(I,0)) S YNUM=YNUM+1 D
.I $P(@KMPUAR@(I,0),U,2)>MAX S MAX=$P(@KMPUAR@(I,0),U,2)
.I $P(@KMPUAR@(I,0),U,2)<MIN S MIN=$P(@KMPUAR@(I,0),U,2)
.; determine number of decimal places (if any).
.S DNUM=$P($P(@KMPUAR@(I,0),U,2),".",2) Q:'DNUM
.I $L(DNUM)>DEC S DEC=$L(DNUM)
Q:MAX'>0
; get maximum number for graph.
D MAX
; determine if there are decimal places when printed at end of graph
S I="" F S I=$O(@KMPUAR@(I)) Q:I="" I $D(@KMPUAR@(I,0)) D
.S Z=$L($P($P(@KMPUAR@(I,0),U,2)/DIV,".",2)) Q:'Z
.I Z>DEC S DEC=$S(Z>2:2,1:1)
S BOTTOM=$S(KMPUOPT["D":(YNUM*2+2),1:(YNUM+3))
S SCALE=((MAX-KMPUSTRT)/10),STEP=((MAX-KMPUSTRT)/GWIDTH)
S NUM=(SCALE+KMPUSTRT)
; determine if relative values have decimal
S DEC1=0 F I=20:5:65 I $L($P((NUM/DIV),".",2)) D
.S DEC1=$S($L($P((NUM/DIV),".",2))>2:2,1:1)
Q
;
MAX ;-- determine 'max' or largest number for graph.
;
S:$G(KMPUMAX) MAX=KMPUMAX
S DIV=1,MAX=$FN(MAX,"",0)
I MAX<2 S MAX=1 Q
S X=1 F I=1:1:$L(MAX)-1 S X=X*10 I MAX=X S X=X/10
S MAX=$E(MAX-1)+1*X
I $L(MAX)>4 D
.F I=1:1:($L(MAX)-1) S DIV=DIV_"0"
.I $L(DIV)<7 S DIVT=$S(KMPUOPT["S":"10^"_I,1:(DIV/1000)_"k") Q
.S DIVT=$S(KMPUOPT["S":"10^"_I,1:(DIV/1000000)_"m")
Q
;
TITLES ;-- print graph titles.
W IOG0
; print first and second line of title
S DX=(IOM-$L($P(TITLE,U))\2+1),DY=0 X IOXY W $P(TITLE,U),!
S DX=(IOM-$L($P(TITLE,U,2))\2+1),DY=1 X IOXY W $P(TITLE,U,2),!
; print y title
S DX=(14-$L(YTITLE)) X IOXY W IOUON,YTITLE,IOUOFF,!
; print relative values under hash marks
S NUM=(SCALE+KMPUSTRT)
S DY=BOTTOM+1,DX=15-$S($L($FN((KMPUSTRT/DIV),"",DEC1))=1:0,1:$L($FN((KMPUSTRT/DIV),"",DEC1))-2) X IOXY W $FN((KMPUSTRT/DIV),"",DEC1),!
F I=20:5:65 D
.I $L($FN((NUM/DIV),"",DEC1))=1 S DX=(I-$L($FN((NUM/DIV),"",DEC1))+1)
.E S DX=(I-($L($FN((NUM/DIV),"",DEC1))-2))
.X IOXY W $FN((NUM/DIV),"",DEC1),! S NUM=NUM+SCALE
; if div>1 write (x div)
I DIV>1 S DX=69 X IOXY W "<x",DIVT,">",!
; print x title at bottom
S DX=(IOM-$L(XTITLE)\2+1),DY=BOTTOM+2 X IOXY W IOUON,XTITLE,IOUOFF,!
; print data titles
S DY=3,I=0 F S I=$O(@KMPUAR@(I)) Q:'I I $D(@KMPUAR@(I,0)) D
.S YTITLE=$E($P(@KMPUAR@(I,0),U),1,14)
.S DX=(14-$L(YTITLE)) X IOXY W YTITLE,!
.S DY=DY+$S(KMPUOPT["D":2,1:1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUG1 3575 printed Oct 16, 2024@17:41:57 Page 2
KMPDUG1 ;OAK/RAK - CM Tools Graph Utility ;2/17/04 09:58
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
DRAW ;-- draw graph
+1 WRITE @IOF,!,IOG1
SET DY=2
+2 ; draw top line
+3 FOR I=1:1:27
SET DX=41+I
XECUTE IOXY
WRITE IOHL
SET DX=43-I
XECUTE IOXY
WRITE IOHL
+4 ; draw top left and right corners
+5 SET DX=15
XECUTE IOXY
WRITE IOTLC
SET DX=68
XECUTE IOXY
WRITE IOTRC,!
+6 ; draw sides
+7 FOR DY=(DY+1):1:BOTTOM
FOR DX=15,68
XECUTE IOXY
WRITE IOVL,!
+8 ; draw bottom left and right corners
+9 SET DY=BOTTOM
SET DX=15
XECUTE IOXY
WRITE IOBLC
SET DX=68
XECUTE IOXY
WRITE IOBRC,!
+10 ; draw bottom line
+11 FOR I=1:1:27
SET DX=15+I
XECUTE IOXY
WRITE IOHL
SET DX=68-I
XECUTE IOXY
WRITE IOHL
+12 ; draw 'hash marks' on bottom line for relative values
+13 SET DX=15
XECUTE IOXY
WRITE IOLT,!
+14 FOR DX=20:5:65
XECUTE IOXY
WRITE IOMT,!
+15 ; print grid
+16 IF KMPUOPT["G"
Begin DoDot:1
+17 SET DY=2
FOR DX=20:5:65
XECUTE IOXY
WRITE IOTT,!
+18 FOR DX=20:5:65
FOR DY=3:1:(BOTTOM-1)
XECUTE IOXY
WRITE IOVL,!
End DoDot:1
+19 WRITE IOG0
+20 QUIT
INIT ;-- initialize required variables.
+1 DO GSET^%ZISS
SET X="IOECH;IORVOFF;IORVON;IOUOFF;IOUON"
DO ENDR^%ZISS
+2 ; actual bars representing data
+3 SET BAR(0)="IORVON,"" "",IORVOFF"
+4 SET BAR(1)="IOG1,""a"",IOG0"
+5 SET (DEC,DNUM,MAX,MIN,SCALE,YNUM)=0
SET GWIDTH=$SELECT(KMPUOPT["V":10,1:50)
+6 SET TITLE=$PIECE($GET(KMPUTI),U,1,2)
+7 SET XTITLE=$PIECE($GET(KMPUTI),U,3)
+8 SET YTITLE=$PIECE($GET(KMPUTI),U,4)
+9 ; determine maximum and minimum number and decimals (if any).
+10 SET (I,MAX,MIN)=""
+11 FOR
SET I=$ORDER(@KMPUAR@(I))
if I=""
QUIT
IF $DATA(@KMPUAR@(I,0))
SET YNUM=YNUM+1
Begin DoDot:1
+12 IF $PIECE(@KMPUAR@(I,0),U,2)>MAX
SET MAX=$PIECE(@KMPUAR@(I,0),U,2)
+13 IF $PIECE(@KMPUAR@(I,0),U,2)<MIN
SET MIN=$PIECE(@KMPUAR@(I,0),U,2)
+14 ; determine number of decimal places (if any).
+15 SET DNUM=$PIECE($PIECE(@KMPUAR@(I,0),U,2),".",2)
if 'DNUM
QUIT
+16 IF $LENGTH(DNUM)>DEC
SET DEC=$LENGTH(DNUM)
End DoDot:1
+17 if MAX'>0
QUIT
+18 ; get maximum number for graph.
+19 DO MAX
+20 ; determine if there are decimal places when printed at end of graph
+21 SET I=""
FOR
SET I=$ORDER(@KMPUAR@(I))
if I=""
QUIT
IF $DATA(@KMPUAR@(I,0))
Begin DoDot:1
+22 SET Z=$LENGTH($PIECE($PIECE(@KMPUAR@(I,0),U,2)/DIV,".",2))
if 'Z
QUIT
+23 IF Z>DEC
SET DEC=$SELECT(Z>2:2,1:1)
End DoDot:1
+24 SET BOTTOM=$SELECT(KMPUOPT["D":(YNUM*2+2),1:(YNUM+3))
+25 SET SCALE=((MAX-KMPUSTRT)/10)
SET STEP=((MAX-KMPUSTRT)/GWIDTH)
+26 SET NUM=(SCALE+KMPUSTRT)
+27 ; determine if relative values have decimal
+28 SET DEC1=0
FOR I=20:5:65
IF $LENGTH($PIECE((NUM/DIV),".",2))
Begin DoDot:1
+29 SET DEC1=$SELECT($LENGTH($PIECE((NUM/DIV),".",2))>2:2,1:1)
End DoDot:1
+30 QUIT
+31 ;
MAX ;-- determine 'max' or largest number for graph.
+1 ;
+2 if $GET(KMPUMAX)
SET MAX=KMPUMAX
+3 SET DIV=1
SET MAX=$FNUMBER(MAX,"",0)
+4 IF MAX<2
SET MAX=1
QUIT
+5 SET X=1
FOR I=1:1:$LENGTH(MAX)-1
SET X=X*10
IF MAX=X
SET X=X/10
+6 SET MAX=$EXTRACT(MAX-1)+1*X
+7 IF $LENGTH(MAX)>4
Begin DoDot:1
+8 FOR I=1:1:($LENGTH(MAX)-1)
SET DIV=DIV_"0"
+9 IF $LENGTH(DIV)<7
SET DIVT=$SELECT(KMPUOPT["S":"10^"_I,1:(DIV/1000)_"k")
QUIT
+10 SET DIVT=$SELECT(KMPUOPT["S":"10^"_I,1:(DIV/1000000)_"m")
End DoDot:1
+11 QUIT
+12 ;
TITLES ;-- print graph titles.
+1 WRITE IOG0
+2 ; print first and second line of title
+3 SET DX=(IOM-$LENGTH($PIECE(TITLE,U))\2+1)
SET DY=0
XECUTE IOXY
WRITE $PIECE(TITLE,U),!
+4 SET DX=(IOM-$LENGTH($PIECE(TITLE,U,2))\2+1)
SET DY=1
XECUTE IOXY
WRITE $PIECE(TITLE,U,2),!
+5 ; print y title
+6 SET DX=(14-$LENGTH(YTITLE))
XECUTE IOXY
WRITE IOUON,YTITLE,IOUOFF,!
+7 ; print relative values under hash marks
+8 SET NUM=(SCALE+KMPUSTRT)
+9 SET DY=BOTTOM+1
SET DX=15-$SELECT($LENGTH($FNUMBER((KMPUSTRT/DIV),"",DEC1))=1:0,1:$LENGTH($FNUMBER((KMPUSTRT/DIV),"",DEC1))-2)
XECUTE IOXY
WRITE $FNUMBER((KMPUSTRT/DIV),"",DEC1),!
+10 FOR I=20:5:65
Begin DoDot:1
+11 IF $LENGTH($FNUMBER((NUM/DIV),"",DEC1))=1
SET DX=(I-$LENGTH($FNUMBER((NUM/DIV),"",DEC1))+1)
+12 IF '$TEST
SET DX=(I-($LENGTH($FNUMBER((NUM/DIV),"",DEC1))-2))
+13 XECUTE IOXY
WRITE $FNUMBER((NUM/DIV),"",DEC1),!
SET NUM=NUM+SCALE
End DoDot:1
+14 ; if div>1 write (x div)
+15 IF DIV>1
SET DX=69
XECUTE IOXY
WRITE "<x",DIVT,">",!
+16 ; print x title at bottom
+17 SET DX=(IOM-$LENGTH(XTITLE)\2+1)
SET DY=BOTTOM+2
XECUTE IOXY
WRITE IOUON,XTITLE,IOUOFF,!
+18 ; print data titles
+19 SET DY=3
SET I=0
FOR
SET I=$ORDER(@KMPUAR@(I))
if 'I
QUIT
IF $DATA(@KMPUAR@(I,0))
Begin DoDot:1
+20 SET YTITLE=$EXTRACT($PIECE(@KMPUAR@(I,0),U),1,14)
+21 SET DX=(14-$LENGTH(YTITLE))
XECUTE IOXY
WRITE YTITLE,!
+22 SET DY=DY+$SELECT(KMPUOPT["D":2,1:1)
End DoDot:1
+23 QUIT
