BZXPTMSG ;IHS/PHXAO/AEF - ISSUE PATIENT MESSAGES
;;1.0;ANNE'S SPECIAL ROUTINES;;APR 9, 2004
;;
DESC ;----- ROUTINE DESCRIPTION
;;
;;This option allows entry of messages into the BZX PATIENT MESSAGE
;;file. A text message can be entered which will be displayed whenever
;;a patient is selected. You can cause the message to blink, display
;;in bold letters, or reverse video. You can also choose a color for
;;the text message.
;;
;;$$END
Q
;
EN ;EP -- MAIN ENTRY POINT TO ADD/EDIT BZX PATIENT MESSAGE FILE ENTRIES
;
D ^XBKVAR
;
D HOME^%ZIS
;
D TXT
;
D ADD
;
Q
ADD ;----- ADD/EDIT BZX PATIENT MESSAGE FILE ENTRY
;
N DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,X,Y
;
S DIC="^BZXPTMSG(1991258,"
S DIC(0)="AEMQLI"
S DLAYGO=1991258
D ^DIC
Q:$D(DTOUT)!($D(DUOUT))
Q:+Y'>0
S DA=+Y
S DIE=DIC
S DR="[BZX ADD NEW MESSAGE]"
D ^DIE
W !
G ADD
Q
TXT ;----- PRINT OPTION TEXT
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
MSG(D0) ;EP;CALLED BY AUPNLK
;----- ISSUE MESSAGE
;
; D0 = PATIENT IEN
;
N BZXCOLOR,BZXZIS5,BZXZIS7,DIR,X,Y
;
Q:$G(^BZXPTMSG(1991258,D0,99.01))']""
;
D ^XBKVAR
;
D HOME^%ZIS
;
D COLORS(.BZXCOLOR)
;
S BZXZIS5=$G(^%ZIS(2,+$G(IOST(0)),5))
S BZXZIS7=$G(^%ZIS(2,+$G(IOST(0)),7))
;
D SPEC(D0,BZXZIS5,BZXZIS7,.BZXCOLOR)
;
W *7
W !,$G(^BZXPTMSG(1991258,D0,99.01))
;
D RESET(BZXZIS5,BZXZIS7,.BZXCOLOR)
;
W !
;
I D0 D
. S DIR(0)="E"
. S DIR("A")="Press the RETURN key to continue"
. D ^DIR
Q
SPEC(D0,BZXZIS5,BZXZIS7,BZXCOLOR) ;
;----- SPECIAL DISPLAY CHARACTERISTICS
;
N BZXCOL,BZXDATA
;
S BZXDATA=$G(^BZXPTMSG(1991258,D0,1))
I $P(BZXDATA,U),$P(BZXZIS5,U,8)]"" W @($P(BZXZIS5,U,8)) ;BLINK ON
I $P(BZXDATA,U,2),$P(BZXZIS5,U,4)]"" W @($P(BZXZIS5,U,4)) ;REV VIDEO ON
I $P(BZXDATA,U,3),$P(BZXZIS7,U)]"" W @($P(BZXZIS7,U)) ;BOLD ON
S BZXCOL=$P($G(^BZXPTMSG(1991258,D0,2)),U)
I BZXCOL]"" W @(BZXCOLOR(BZXCOL)) ;COLOR ON
;
Q
RESET(BZXZIS5,BZXZIS7,BZXCOLOR) ;
;----- RESET THE DEVICE
;
I $P(BZXZIS5,U,9)]"" W @($P(BZXZIS5,U,9)) ;BLINK OFF
I $P(BZXZIS5,U,5)]"" W @($P(BZXZIS5,U,5)) ;REV VIDEO OFF
I $P(BZXZIS7,U,3)]"" W @($P(BZXZIS7,U,3)) ;BOLD OFF
W @$G(BZXCOLOR("RESET")) ;COLOR OFF
W *27,*91,*109 ;*** TESTING - AEF *** RESET
W $C(27,91,109) ;*** TESTING - AEF *** RESET
Q
COLORS(BZXCOLOR) ;
;----- SET UP COLORS
;
S BZXCOLOR("BLACK")="$C(27),""[30m"""
S BZXCOLOR("RED")="$C(27),""[31m"""
S BZXCOLOR("GREEN")="$C(27),""[32m"""
S BZXCOLOR("YELLOW")="$C(27),""[33m"""
S BZXCOLOR("BLUE")="$C(27),""[34m"""
S BZXCOLOR("MAGENTA")="$C(27),""[35m"""
S BZXCOLOR("CYAN")="$C(27),""[36m"""
S BZXCOLOR("WHITE")="$C(27),""[37m"""
S BZXCOLOR("RESET")="$C(27),""[m"""
Q
BZXPTMSG ;IHS/PHXAO/AEF - ISSUE PATIENT MESSAGES
+1 ;;1.0;ANNE'S SPECIAL ROUTINES;;APR 9, 2004
+2 ;;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;;This option allows entry of messages into the BZX PATIENT MESSAGE
+3 ;;file. A text message can be entered which will be displayed whenever
+4 ;;a patient is selected. You can cause the message to blink, display
+5 ;;in bold letters, or reverse video. You can also choose a color for
+6 ;;the text message.
+7 ;;
+8 ;;$$END
+9 QUIT
+10 ;
EN ;EP -- MAIN ENTRY POINT TO ADD/EDIT BZX PATIENT MESSAGE FILE ENTRIES
+1 ;
+2 DO ^XBKVAR
+3 ;
+4 DO HOME^%ZIS
+5 ;
+6 DO TXT
+7 ;
+8 DO ADD
+9 ;
+10 QUIT
ADD ;----- ADD/EDIT BZX PATIENT MESSAGE FILE ENTRY
+1 ;
+2 NEW DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,X,Y
+3 ;
+4 SET DIC="^BZXPTMSG(1991258,"
+5 SET DIC(0)="AEMQLI"
+6 SET DLAYGO=1991258
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+9 IF +Y'>0
QUIT
+10 SET DA=+Y
+11 SET DIE=DIC
+12 SET DR="[BZX ADD NEW MESSAGE]"
+13 DO ^DIE
+14 WRITE !
+15 GOTO ADD
+16 QUIT
TXT ;----- PRINT OPTION TEXT
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
MSG(D0) ;EP;CALLED BY AUPNLK
+1 ;----- ISSUE MESSAGE
+2 ;
+3 ; D0 = PATIENT IEN
+4 ;
+5 NEW BZXCOLOR,BZXZIS5,BZXZIS7,DIR,X,Y
+6 ;
+7 IF $GET(^BZXPTMSG(1991258,D0,99.01))']""
QUIT
+8 ;
+9 DO ^XBKVAR
+10 ;
+11 DO HOME^%ZIS
+12 ;
+13 DO COLORS(.BZXCOLOR)
+14 ;
+15 SET BZXZIS5=$GET(^%ZIS(2,+$GET(IOST(0)),5))
+16 SET BZXZIS7=$GET(^%ZIS(2,+$GET(IOST(0)),7))
+17 ;
+18 DO SPEC(D0,BZXZIS5,BZXZIS7,.BZXCOLOR)
+19 ;
+20 WRITE *7
+21 WRITE !,$GET(^BZXPTMSG(1991258,D0,99.01))
+22 ;
+23 DO RESET(BZXZIS5,BZXZIS7,.BZXCOLOR)
+24 ;
+25 WRITE !
+26 ;
+27 IF D0
Begin DoDot:1
+28 SET DIR(0)="E"
+29 SET DIR("A")="Press the RETURN key to continue"
+30 DO ^DIR
End DoDot:1
+31 QUIT
SPEC(D0,BZXZIS5,BZXZIS7,BZXCOLOR) ;
+1 ;----- SPECIAL DISPLAY CHARACTERISTICS
+2 ;
+3 NEW BZXCOL,BZXDATA
+4 ;
+5 SET BZXDATA=$GET(^BZXPTMSG(1991258,D0,1))
+6 ;BLINK ON
IF $PIECE(BZXDATA,U)
IF $PIECE(BZXZIS5,U,8)]""
WRITE @($PIECE(BZXZIS5,U,8))
+7 ;REV VIDEO ON
IF $PIECE(BZXDATA,U,2)
IF $PIECE(BZXZIS5,U,4)]""
WRITE @($PIECE(BZXZIS5,U,4))
+8 ;BOLD ON
IF $PIECE(BZXDATA,U,3)
IF $PIECE(BZXZIS7,U)]""
WRITE @($PIECE(BZXZIS7,U))
+9 SET BZXCOL=$PIECE($GET(^BZXPTMSG(1991258,D0,2)),U)
+10 ;COLOR ON
IF BZXCOL]""
WRITE @(BZXCOLOR(BZXCOL))
+11 ;
+12 QUIT
RESET(BZXZIS5,BZXZIS7,BZXCOLOR) ;
+1 ;----- RESET THE DEVICE
+2 ;
+3 ;BLINK OFF
IF $PIECE(BZXZIS5,U,9)]""
WRITE @($PIECE(BZXZIS5,U,9))
+4 ;REV VIDEO OFF
IF $PIECE(BZXZIS5,U,5)]""
WRITE @($PIECE(BZXZIS5,U,5))
+5 ;BOLD OFF
IF $PIECE(BZXZIS7,U,3)]""
WRITE @($PIECE(BZXZIS7,U,3))
+6 ;COLOR OFF
WRITE @$GET(BZXCOLOR("RESET"))
+7 ;*** TESTING - AEF *** RESET
WRITE *27,*91,*109
+8 ;*** TESTING - AEF *** RESET
WRITE $CHAR(27,91,109)
+9 QUIT
COLORS(BZXCOLOR) ;
+1 ;----- SET UP COLORS
+2 ;
+3 SET BZXCOLOR("BLACK")="$C(27),""[30m"""
+4 SET BZXCOLOR("RED")="$C(27),""[31m"""
+5 SET BZXCOLOR("GREEN")="$C(27),""[32m"""
+6 SET BZXCOLOR("YELLOW")="$C(27),""[33m"""
+7 SET BZXCOLOR("BLUE")="$C(27),""[34m"""
+8 SET BZXCOLOR("MAGENTA")="$C(27),""[35m"""
+9 SET BZXCOLOR("CYAN")="$C(27),""[36m"""
+10 SET BZXCOLOR("WHITE")="$C(27),""[37m"""
+11 SET BZXCOLOR("RESET")="$C(27),""[m"""
+12 QUIT
