Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BZXPTMSG

BZXPTMSG.m

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