KMPDUGV ;OAK/RAK - CM Tools Vertical Graph Utility ;2/17/04 10:00
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
EN ;-- entry point.
D DRAW,TITLES,DATA W IOG0
I $D(KMPUTAR) D Q
.;D WP^KMPDU11(KMPUTAR,5,24,(RIGHT+5),IOM,0,$G(KMPUXIT))
.D WP^KMPDU11(KMPUTAR,18,22,5,IOM,0,$G(KMPUXIT))
D:'KMPUXIT CONT^KMPDUG
Q
;
DATA ;-- display data in graph.
W IOG0 S DX=$S(KMPUOPT["D":9,1:10),BAR=0,I=""
F S I=$O(@KMPUAR@(I)) Q:I="" I $D(@KMPUAR@(I,0)) S DATA=@KMPUAR@(I,0) D
.S XCOORD=$P(DATA,U,2),END=(XCOORD-KMPUSTRT) ;-STEP)
.S DY=14,DX=DX+$S(KMPUOPT["D":2,1:1)
.; if no data quit
.Q:$P(@KMPUAR@(I,0),U,2)']""
.F I1=0:STEP:END X IOXY W @BAR(BAR),! S DY=DY-1 Q:DY=5
.S BAR=$S(BAR=1:0,1:1)
Q
;
DRAW ;-- draw graph.
S RIGHT=$S(KMPUOPT["D":(YNUM*2),1:(YNUM+1))+10
W @IOF,!,IOG1 S DX=10
; draw left line
F I=1:1:6 S DY=4+I X IOXY W IOVL S DY=15-I X IOXY W IOVL
; draw left top corner ;and bottom corners
;S DY=4 X IOXY W IOTLC ;S DY=15 X IOXY W IOBLC,!
; draw top and bottom lines
;F DX=(DX+1):1:(RIGHT-1) S DY=5 X IOXY W IOHL,! S DY=15 X IOXY W "s",!
F DX=(DX+1):1:(RIGHT-1) S DY=14 X IOXY W "s",!
; draw right top corner ;and bottom corners
;S DX=RIGHT,DY=5 X IOXY W IOTRC ;S DY=15 X IOXY W IOBRC,!
; draw right line
S DX=RIGHT F I=1:1:6 S DY=4+I X IOXY W IOVL S DY=16-I X IOXY W IOVL
; draw 'hash marks' on left line for relative values
S DX=9,DY=14 X IOXY W "s",! ;W IOLT,!
F DY=13:-1:4 X IOXY W "s",! ;W IOMT,!
; print grid
I KMPUOPT["G" F DY=14:-1:4 F DX=11:1:(RIGHT-1) X IOXY W "s",!
W IOG0
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 x title at bottom
S DX=(10-$L(XTITLE)),DY=3 X IOXY W IOUON,XTITLE,IOUOFF
; if div>1 write (x div)
W:DIV>1 " <x",DIVT,">"
W !
; print y title
S DY=15,DX=$S(KMPUOPT["A":1,1:2)
F I=1:1:8 D
.X IOXY W IOUON,$E(YTITLE,I),IOUOFF,! S DY=DY+1
.I KMPUOPT["A" S DX=DX+1
; print relative values next to hash marks
S NUM=(SCALE+KMPUSTRT)
S DY=14,DX=9-$L($FN((KMPUSTRT/DIV),"",DEC1))
X IOXY W $FN((KMPUSTRT/DIV),"",DEC1),!
F DY=13:-1:4 D
.S DX=(9-$L($FN((NUM/DIV),"",DEC1)))
.X IOXY W $FN((NUM/DIV),"",DEC1),! S NUM=NUM+SCALE
; print data titles
S ZDX=11,I=""
F S I=$O(@KMPUAR@(I)) Q:I="" I $D(@KMPUAR@(I,0)) D
.S YTITLE=$E($P(@KMPUAR@(I,0),U),1,14),DX=ZDX
.I KMPUOPT["A" F I1=1:1:8 S DY=14+I1 X IOXY W $E(YTITLE,I1),! S DX=DX+1
.I KMPUOPT'["A" F I1=1:1:8 S DY=14+I1 X IOXY W $E(YTITLE,I1),!
.S ZDX=ZDX+$S(KMPUOPT["D":2,1:1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUGV 2647 printed Dec 13, 2024@01:41:08 Page 2
KMPDUGV ;OAK/RAK - CM Tools Vertical Graph Utility ;2/17/04 10:00
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
EN ;-- entry point.
+1 DO DRAW
DO TITLES
DO DATA
WRITE IOG0
+2 IF $DATA(KMPUTAR)
Begin DoDot:1
+3 ;D WP^KMPDU11(KMPUTAR,5,24,(RIGHT+5),IOM,0,$G(KMPUXIT))
+4 DO WP^KMPDU11(KMPUTAR,18,22,5,IOM,0,$GET(KMPUXIT))
End DoDot:1
QUIT
+5 if 'KMPUXIT
DO CONT^KMPDUG
+6 QUIT
+7 ;
DATA ;-- display data in graph.
+1 WRITE IOG0
SET DX=$SELECT(KMPUOPT["D":9,1:10)
SET BAR=0
SET I=""
+2 FOR
SET I=$ORDER(@KMPUAR@(I))
if I=""
QUIT
IF $DATA(@KMPUAR@(I,0))
SET DATA=@KMPUAR@(I,0)
Begin DoDot:1
+3 ;-STEP)
SET XCOORD=$PIECE(DATA,U,2)
SET END=(XCOORD-KMPUSTRT)
+4 SET DY=14
SET DX=DX+$SELECT(KMPUOPT["D":2,1:1)
+5 ; if no data quit
+6 if $PIECE(@KMPUAR@(I,0),U,2)']""
QUIT
+7 FOR I1=0:STEP:END
XECUTE IOXY
WRITE @BAR(BAR),!
SET DY=DY-1
if DY=5
QUIT
+8 SET BAR=$SELECT(BAR=1:0,1:1)
End DoDot:1
+9 QUIT
+10 ;
DRAW ;-- draw graph.
+1 SET RIGHT=$SELECT(KMPUOPT["D":(YNUM*2),1:(YNUM+1))+10
+2 WRITE @IOF,!,IOG1
SET DX=10
+3 ; draw left line
+4 FOR I=1:1:6
SET DY=4+I
XECUTE IOXY
WRITE IOVL
SET DY=15-I
XECUTE IOXY
WRITE IOVL
+5 ; draw left top corner ;and bottom corners
+6 ;S DY=4 X IOXY W IOTLC ;S DY=15 X IOXY W IOBLC,!
+7 ; draw top and bottom lines
+8 ;F DX=(DX+1):1:(RIGHT-1) S DY=5 X IOXY W IOHL,! S DY=15 X IOXY W "s",!
+9 FOR DX=(DX+1):1:(RIGHT-1)
SET DY=14
XECUTE IOXY
WRITE "s",!
+10 ; draw right top corner ;and bottom corners
+11 ;S DX=RIGHT,DY=5 X IOXY W IOTRC ;S DY=15 X IOXY W IOBRC,!
+12 ; draw right line
+13 SET DX=RIGHT
FOR I=1:1:6
SET DY=4+I
XECUTE IOXY
WRITE IOVL
SET DY=16-I
XECUTE IOXY
WRITE IOVL
+14 ; draw 'hash marks' on left line for relative values
+15 ;W IOLT,!
SET DX=9
SET DY=14
XECUTE IOXY
WRITE "s",!
+16 ;W IOMT,!
FOR DY=13:-1:4
XECUTE IOXY
WRITE "s",!
+17 ; print grid
+18 IF KMPUOPT["G"
FOR DY=14:-1:4
FOR DX=11:1:(RIGHT-1)
XECUTE IOXY
WRITE "s",!
+19 WRITE IOG0
+20 QUIT
+21 ;
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 x title at bottom
+6 SET DX=(10-$LENGTH(XTITLE))
SET DY=3
XECUTE IOXY
WRITE IOUON,XTITLE,IOUOFF
+7 ; if div>1 write (x div)
+8 if DIV>1
WRITE " <x",DIVT,">"
+9 WRITE !
+10 ; print y title
+11 SET DY=15
SET DX=$SELECT(KMPUOPT["A":1,1:2)
+12 FOR I=1:1:8
Begin DoDot:1
+13 XECUTE IOXY
WRITE IOUON,$EXTRACT(YTITLE,I),IOUOFF,!
SET DY=DY+1
+14 IF KMPUOPT["A"
SET DX=DX+1
End DoDot:1
+15 ; print relative values next to hash marks
+16 SET NUM=(SCALE+KMPUSTRT)
+17 SET DY=14
SET DX=9-$LENGTH($FNUMBER((KMPUSTRT/DIV),"",DEC1))
+18 XECUTE IOXY
WRITE $FNUMBER((KMPUSTRT/DIV),"",DEC1),!
+19 FOR DY=13:-1:4
Begin DoDot:1
+20 SET DX=(9-$LENGTH($FNUMBER((NUM/DIV),"",DEC1)))
+21 XECUTE IOXY
WRITE $FNUMBER((NUM/DIV),"",DEC1),!
SET NUM=NUM+SCALE
End DoDot:1
+22 ; print data titles
+23 SET ZDX=11
SET I=""
+24 FOR
SET I=$ORDER(@KMPUAR@(I))
if I=""
QUIT
IF $DATA(@KMPUAR@(I,0))
Begin DoDot:1
+25 SET YTITLE=$EXTRACT($PIECE(@KMPUAR@(I,0),U),1,14)
SET DX=ZDX
+26 IF KMPUOPT["A"
FOR I1=1:1:8
SET DY=14+I1
XECUTE IOXY
WRITE $EXTRACT(YTITLE,I1),!
SET DX=DX+1
+27 IF KMPUOPT'["A"
FOR I1=1:1:8
SET DY=14+I1
XECUTE IOXY
WRITE $EXTRACT(YTITLE,I1),!
+28 SET ZDX=ZDX+$SELECT(KMPUOPT["D":2,1:1)
End DoDot:1
+29 QUIT
