XBVIDEO.m

XBVIDEO ; IHS/ADC/GTH - SET VIDEO ATTRIBUTES ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; Thanks to Don Jackson, DSD/OIRM, for the original routine.

 ;

 ; Set various video attributes.  $X is saved and the cursor

 ; is returned to it's original position thru X IOXY (except

 ; certain attributes).

 ;

 ; In addition to the attributes supported by ENDR^%ZISS,

 ; some color attributes are supported, and other mnemonics

 ; to provide for backward compatibility.

 ;

 ;

 Q

 ;

EN(XB) ;PEP - Set video attribute in XB.  E.g. D EN^XBVIDEO("IOBOFF").

 ;

 Q:'$L($G(XB))

 Q:$D(ZTQUEUED)

 ;

 NEW DX,DY,XBXY

 S DX=$X,DY=$Y,XBXY=0

 ;

 I '$G(IOST(0)) D HOME^%ZIS

 U IO(0)

 ;

 I $L($T(@XB)),$L($P($T(@XB),";;",6)) S XBXY=$P($T(@XB),";;",7),XB=$P($T(@XB),";;",6)

 I $L($T(@XB^%ZISS)) S X=XB D ENDR^%ZISS W @XB X:XBXY IOXY U IO Q

 ;

 I '$L($T(@XB)) U IO Q

 ;

 S XB("LN")=$T(@XB),XB(1)=$P(XB("LN"),";;",2),XB(2)=$P(XB("LN"),";;",3),XB(3)=$P(XB("LN"),";;",4)

 S XB=$P($G(^%ZIS(2,+IOST(0),XB(1))),"^",XB(2),XB(3))

 I XB="" S XB="*0"

 W @XB

 X:XBXY IOXY

 U IO

 Q

 ;

 ; Global locations for mnenomics and colors supported by %ZISS.

 ;

 ;;<subscript>;<beginning piece>;<ending piece>;<desc>;<var name>;<X IOXY flag>

 ;

10 ;;5;;1;;1;;TEN PITCH;;IOPTCH10;;1

12 ;;5;;2;;2;;TWELVE PITCH;;IOPTCH12;;1

16 ;;12.1;;1;;250;;SIXTEEN PITCH;;IOPTCH16;;1

BLF ;;5;;9;;9;;BLINK OFF;;IOBOFF;;1

BLN ;;5;;8;;8;;BLINK ON;;IOBON;;1

CLR ;;6;;1;;1;;RESET;;IORESET;;1

CUP ;;8;;1;;1;;CURSOR UP;;IOCUU;;0

DTB ;;17;;2;;2;;DOUBLE HIGH BOTTOM HALF;;IODHLB;;0

DTP ;;17;;1;;1;;DOUBLE HIGH TOP HALF;;IODHLT;;0

HIF ;;7;;2;;2;;HI INTENSITY OFF;;IOINORM;;1

HIN ;;7;;1;;1;;HI INTENSITY ON;;IOINHI;;1

HOM ;;5;;3;;3;;HOME CURSOR;;IOHOME;;0

IOF ;;1;;2;;2;;FORM FEED/CLEAR SCREEN;;;;0

RVF ;;5;;5;;5;;REVERSE VIDEO OFF;;IORVOFF;;1

RVN ;;5;;4;;4;;REVERSE VIDEO ON;;IORVON;;1

ULF ;;6;;5;;5;;UNDERLINE OFF;;IOUOFF;;1

ULN ;;6;;4;;4;;UNDERLINE ON;;IOUON;;1

 ;

 ; Global locations for mnenomics and colors UN-supported by %ZISS.

 ;;<subscript>;<beginning piece>;<ending piece>;<desc>;<>;<X IOXY flag>

CYB ;;C;;3;;3;;CYAN BACKGROUND;;;;1

GRF ;;C;;1;;1;;GREEN FOREGROUND;;;;1

REB ;;C;;5;;5;;RED BACKGROUND;;;;1

WHF ;;C;;4;;4;;WHITE FOREGROUND;;;;1

YEF ;;C;;2;;2;;YELLOW FOREGROUND;;;;1

 ;

XBVIDEO   ; IHS/ADC/GTH - SET VIDEO ATTRIBUTES ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; Thanks to Don Jackson, DSD/OIRM, for the original routine.

 +4       ;

 +5       ; Set various video attributes.  $X is saved and the cursor

 +6       ; is returned to it's original position thru X IOXY (except

 +7       ; certain attributes).

 +8       ;

 +9       ; In addition to the attributes supported by ENDR^%ZISS,

 +10      ; some color attributes are supported, and other mnemonics

 +11      ; to provide for backward compatibility.

 +12      ;

 +13      ;

 +14       QUIT 

 +15      ;

EN(XB)    ;PEP - Set video attribute in XB.  E.g. D EN^XBVIDEO("IOBOFF").

 +1       ;

 +2        IF '$LENGTH($GET(XB))

               QUIT 

 +3        IF $DATA(ZTQUEUED)

               QUIT 

 +4       ;

 +5        NEW DX,DY,XBXY

 +6        SET DX=$X

           SET DY=$Y

           SET XBXY=0

 +7       ;

 +8        IF '$GET(IOST(0))

               DO HOME^%ZIS

 +9        USE IO(0)

 +10      ;

 +11       IF $LENGTH($TEXT(@XB))

               IF $LENGTH($PIECE($TEXT(@XB),";;",6))

                   SET XBXY=$PIECE($TEXT(@XB),";;",7)

                   SET XB=$PIECE($TEXT(@XB),";;",6)

 +12       IF $LENGTH($TEXT(@XB^%ZISS))

               SET X=XB

               DO ENDR^%ZISS

               WRITE @XB

               IF XBXY

                   XECUTE IOXY

               USE IO

               QUIT 

 +13      ;

 +14       IF '$LENGTH($TEXT(@XB))

               USE IO

               QUIT 

 +15      ;

 +16       SET XB("LN")=$TEXT(@XB)

           SET XB(1)=$PIECE(XB("LN"),";;",2)

           SET XB(2)=$PIECE(XB("LN"),";;",3)

           SET XB(3)=$PIECE(XB("LN"),";;",4)

 +17       SET XB=$PIECE($GET(^%ZIS(2,+IOST(0),XB(1))),"^",XB(2),XB(3))

 +18       IF XB=""

               SET XB="*0"

 +19       WRITE @XB

 +20       IF XBXY

               XECUTE IOXY

 +21       USE IO

 +22       QUIT 

 +23      ;

 +24      ; Global locations for mnenomics and colors supported by %ZISS.

 +25      ;

 +26      ;;<subscript>;<beginning piece>;<ending piece>;<desc>;<var name>;<X IOXY flag>

 +27      ;

10        ;;5;;1;;1;;TEN PITCH;;IOPTCH10;;1

12        ;;5;;2;;2;;TWELVE PITCH;;IOPTCH12;;1

16        ;;12.1;;1;;250;;SIXTEEN PITCH;;IOPTCH16;;1

BLF       ;;5;;9;;9;;BLINK OFF;;IOBOFF;;1

BLN       ;;5;;8;;8;;BLINK ON;;IOBON;;1

CLR       ;;6;;1;;1;;RESET;;IORESET;;1

CUP       ;;8;;1;;1;;CURSOR UP;;IOCUU;;0

DTB       ;;17;;2;;2;;DOUBLE HIGH BOTTOM HALF;;IODHLB;;0

DTP       ;;17;;1;;1;;DOUBLE HIGH TOP HALF;;IODHLT;;0

HIF       ;;7;;2;;2;;HI INTENSITY OFF;;IOINORM;;1

HIN       ;;7;;1;;1;;HI INTENSITY ON;;IOINHI;;1

HOM       ;;5;;3;;3;;HOME CURSOR;;IOHOME;;0

IOF       ;;1;;2;;2;;FORM FEED/CLEAR SCREEN;;;;0

RVF       ;;5;;5;;5;;REVERSE VIDEO OFF;;IORVOFF;;1

RVN       ;;5;;4;;4;;REVERSE VIDEO ON;;IORVON;;1

ULF       ;;6;;5;;5;;UNDERLINE OFF;;IOUOFF;;1

ULN       ;;6;;4;;4;;UNDERLINE ON;;IOUON;;1

 +1       ;

 +2       ; Global locations for mnenomics and colors UN-supported by %ZISS.

 +3       ;;<subscript>;<beginning piece>;<ending piece>;<desc>;<>;<X IOXY flag>

CYB       ;;C;;3;;3;;CYAN BACKGROUND;;;;1

GRF       ;;C;;1;;1;;GREEN FOREGROUND;;;;1

REB       ;;C;;5;;5;;RED BACKGROUND;;;;1

WHF       ;;C;;4;;4;;WHITE FOREGROUND;;;;1

YEF       ;;C;;2;;2;;YELLOW FOREGROUND;;;;1

 +1       ;