Routine: KMPDUG1

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

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)

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")

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUG1   3575     printed  Feb 18, 2025@23:07:29                                                                                                                                                                                                     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

KMPDUG1.m