KMPDUGV.m

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 ---KMPDUGV   2647     printed  Feb 18, 2025@23:07:31                                                                                                                                                                                                     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