MAGDTRDX ;WOIFO/PMK - Formatted dump of DICOM MWL & TeleReader dictionaries ; Mar 12, 2020@14:11:05
;;3.0;IMAGING;**46,138,231**;Mar 19, 2002;Build 9;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;
; Supported IA #10114 reference ^%ZIS routine call
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #2056 reference GETS^DIQ subroutine call
; Supported IA #10103 reference $$HTE^XLFDT function call
; Private IA #7095 to read GMRC PROCEDURE file (#123.3)
; Controlled IA #4171 to read REQUEST SERVICES file (#123.5)
; Supported IA #10060 to read NEW PERSON file (#200)
;
ENTRY ;
D WORKLIST,TELEREAD
Q
;
WORKLIST ; display the clinical specialty DICOM MWL and HL7 configuration files
N ACQSITE,CLINNAME,CLINPTR,CPTIEN,D0,D1,D2,D3,DIVISION,HL7SUBLIST
N I,IPROCIDX,ISPECIDX,LOCKTIME,MSG,POP,PRIMARY,PROC,QRSCP,ROUTE
N SERVICE,STATUS,TIUNOTE,TRIGGER,USERPREF,X,X1,X2,X3
D ^%ZIS Q:POP ; Select device quit if none
O IO:"WN" U IO
S (MSG(1),MSG(3))=""
S MSG(2)="CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831) -- "_$$HTE^XLFDT($H,"2M")
W !! D HEADING(.MSG)
S D0=0 F S D0=$O(^MAG(2006.5831,D0)) Q:'D0 D
. S X=$G(^MAG(2006.5831,D0,0))
. S SERVICE=$P(X,"^",1),PROC=$P(X,"^",2),ISPECIDX=$P(X,"^",3)
. S IPROCIDX=$P(X,"^",4),DIVISION=$P(X,"^",5)
. S CPTIEN=$P(X,"^",6),HL7SUBLIST=$P(X,"^",7)
. S QRSCP=$P(X,"^",8)
. W !!?13,$S(PROC:"-- Procedure",1:" -- Consult")," --"
. W !,$$W("Request Service:"),$$GET1^DIQ(123.5,SERVICE,.01)
. I PROC W !,$$W("Procedure:"),$$GET1^DIQ(123.3,PROC,.01)
. W !,$$W("Worklist:"),$$GET1^DIQ(2005.84,ISPECIDX,3)
. I IPROCIDX W "/",$$GET1^DIQ(2005.85,IPROCIDX,3)
. W " (",$$GET1^DIQ(2005.84,ISPECIDX,.01)
. I IPROCIDX W "/",$$GET1^DIQ(2005.85,IPROCIDX,.01)
. W ")"
. W !,$$W("Acquired at:"),$$GET1^DIQ(4,DIVISION,99)," -- ",$$GET1^DIQ(4,DIVISION,.01)
. S ROUTE=$$GET1^DIQ(123.5,SERVICE,132)
. I ROUTE'="" D
. . W !,$$W("Remote IFC:"),ROUTE
. . Q
. I CPTIEN D
. . W !,$$W("CPT Code:"),$$GET1^DIQ(81,CPTIEN,.01)
. . W " -- ",$$GET1^DIQ(81,CPTIEN,2)
. . Q
. I HL7SUBLIST W !,$$W("HL7 Subscriber List:"),$$GET1^DIQ(779.4,HL7SUBLIST,.01)
. I QRSCP'="" W !,$$W("Q/R Provider:"),QRSCP
. S CLINPTR=0
. S D1=0 F S D1=$O(^MAG(2006.5831,D0,1,D1)) Q:'D1 D
. . I 'CLINPTR W !,$$W("Clinic(s):")
. . S CLINPTR=$G(^MAG(2006.5831,D0,1,D1,0))
. . S CLINNAME=$$GET1^DIQ(44,CLINPTR,.01)
. . I $X+$L(CLINNAME)>70 W !,$$W("")
. . W CLINNAME," "
. . Q
. ;
. ; output Associated Stop Code(s) if any
. K X D GETS^DIQ(123.5,SERVICE,"**","E","X")
. I $D(X(123.5688)) D
. . S I="" F S I=$O(X(123.5688,I)) Q:I="" D
. . . W !,$$W("Associated Stop Code:"),X(123.5688,I,.01,"E")
. . . Q
. . Q
. E D
. . W !,"Warning: No Associated Stop Codes are defined for this Request Service."
. . W !," Use CONSULT ASSOCIATED STOP CODE menu option to define them."
. Q
C IO U $P
Q
;
TELEREAD ; display the TeleReader configuration files
N ACQSITE,CLINNAME,CLINPTR,CPTCODE,D0,D1,D2,D3,DIVISION,HL7SUBLIST
N IPROCIDX,ISPECIDX,LOCKTIME,MSG,POP,PRIMARY,PROC,ROUTE,SERVICE,STATUS
N TIUNOTE,TRIGGER,USERPREF,X,X1,X2,X3
S (MSG(1),MSG(3))=""
S MSG(2)="TELEREADER ACQUISITION SERVICE file (#2006.5841) -- "_$$HTE^XLFDT($H,"2M")
I '$D(IO) D ^%ZIS Q:POP ; Select device quit if none
O IO:"WA" U IO
W !! D HEADING(.MSG)
S D0=0 F S D0=$O(^MAG(2006.5841,D0)) Q:'D0 D
. S X=$G(^MAG(2006.5841,D0,0))
. S SERVICE=$P(X,"^",1),PROC=$P(X,"^",2),ISPECIDX=$P(X,"^",3)
. S IPROCIDX=$P(X,"^",4),DIVISION=$P(X,"^",5)
. S TRIGGER=$P(X,"^",6),TIUNOTE=$P(X,"^",7)
. W !!,$$W("Request Service:"),$$GET1^DIQ(123.5,SERVICE,.01)
. I $D(^MAG(2006.5831,SERVICE,0)) W ?63,"*** DICOM MWL ***"
. I PROC W !,$$W("Procedure:"),$$GET1^DIQ(123.3,PROC,.01)
. S ROUTE=$$GET1^DIQ(123.5,SERVICE,132)
. I ROUTE'="" D
. . W !,$$W("Remote IFC:"),ROUTE
. . Q
. W !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
. W " -- ",$$GET1^DIQ(2005.85,IPROCIDX,.01)
. W !,$$W("Trigger:")
. I TRIGGER="I" W "Create/update with every acquired image"
. E I TRIGGER="O" W "Create when request is ordered"
. E I TRIGGER="F" W "Create when consult is forwarded"
. E W "Unknown trigger value: """,TRIGGER,""""
. I TIUNOTE W !,$$W("Note for IFC:"),$$GET1^DIQ(8925.1,TIUNOTE,.01)
. Q
;
S MSG(2)="TELEREADER ACQUISITION SITE file (#2006.5842)"
W !! D HEADING(.MSG)
S D0=0 F S D0=$O(^MAG(2006.5842,D0)) Q:'D0 D
. S X=$G(^MAG(2006.5842,D0,0))
. S ACQSITE=$P(X,"^",1),PRIMARY=$P(X,"^",2)
. S STATUS=$P(X,"^",3),LOCKTIME=$P(X,"^",4)
. W !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
. W ?50,$S(STATUS:"Active",1:"Inactive")
. W ?60,"Lock Time: ",LOCKTIME," min."
. W !,$$W("Primary Site:"),$$GET1^DIQ(4,PRIMARY,.01)
. Q
;
S MSG(2)="TELEREADER READER file (#2006.5843)"
W !! D HEADING(.MSG)
S D0=0 F S D0=$O(^MAG(2006.5843,D0)) Q:'D0 D
. S X=$G(^MAG(2006.5843,D0,0))
. W:D0>1 !!,$TR($J("",80)," ","-")
. W !!,$$W("TeleReader:"),$$GET1^DIQ(200,X,.01)
. S D1=0 F S D1=$O(^MAG(2006.5843,D0,1,D1)) Q:'D1 D
. . S X1=$G(^MAG(2006.5843,D0,1,D1,0))
. . S ACQSITE=$P(X1,"^",1),STATUS=$P(X1,"^",2)
. . W !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
. . W ?50,$S(STATUS:"Active",1:"Inactive")
. . S D2=0 F S D2=$O(^MAG(2006.5843,D0,1,D1,1,D2)) Q:'D2 D
. . . S X2=$G(^MAG(2006.5843,D0,1,D1,1,D2,0))
. . . S ISPECIDX=$P(X2,"^",1),STATUS=$P(X2,"^",2)
. . . W !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
. . . W ?50,$S(STATUS:"Active",1:"Inactive")
. . . S D3=0 F S D3=$O(^MAG(2006.5843,D0,1,D1,1,D2,1,D3)) Q:'D3 D
. . . . S X3=$G(^MAG(2006.5843,D0,1,D1,1,D2,1,D3,0))
. . . . S IPROCIDX=$P(X3,"^",1),STATUS=$P(X3,"^",2),USERPREF=$P(X3,"^",3)
. . . . W !,$$W(""),$$GET1^DIQ(2005.85,IPROCIDX,.01)
. . . . W ?50,$S(STATUS:"Active",1:"Inactive")
. . . . W ?65,"User: ",$S(USERPREF:"Active",1:"Inactive")
. . . . Q
. . . Q
. . Q
. Q
W !,$TR($J("",80)," ","*"),!
W !!,"End of Report",!
C IO U $P
Q
;
W(PROMPT) ; output prompt
Q $J(PROMPT,21)_" "
;
HEADING(MSG) ;
N I
W !,$TR($J("",80)," ","*")
I $D(MSG)=1 W !,"*** ",MSG,?76," ***"
E F I=1:1 Q:'$D(MSG(I)) W !,"*** ",MSG(I),?76," ***"
W !,$TR($J("",80)," ","*")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDTRDX 7251 printed Sep 23, 2025@19:38:24 Page 2
MAGDTRDX ;WOIFO/PMK - Formatted dump of DICOM MWL & TeleReader dictionaries ; Mar 12, 2020@14:11:05
+1 ;;3.0;IMAGING;**46,138,231**;Mar 19, 2002;Build 9;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;
+18 ; Supported IA #10114 reference ^%ZIS routine call
+19 ; Supported IA #2056 reference $$GET1^DIQ function call
+20 ; Supported IA #2056 reference GETS^DIQ subroutine call
+21 ; Supported IA #10103 reference $$HTE^XLFDT function call
+22 ; Private IA #7095 to read GMRC PROCEDURE file (#123.3)
+23 ; Controlled IA #4171 to read REQUEST SERVICES file (#123.5)
+24 ; Supported IA #10060 to read NEW PERSON file (#200)
+25 ;
ENTRY ;
+1 DO WORKLIST
DO TELEREAD
+2 QUIT
+3 ;
WORKLIST ; display the clinical specialty DICOM MWL and HL7 configuration files
+1 NEW ACQSITE,CLINNAME,CLINPTR,CPTIEN,D0,D1,D2,D3,DIVISION,HL7SUBLIST
+2 NEW I,IPROCIDX,ISPECIDX,LOCKTIME,MSG,POP,PRIMARY,PROC,QRSCP,ROUTE
+3 NEW SERVICE,STATUS,TIUNOTE,TRIGGER,USERPREF,X,X1,X2,X3
+4 ; Select device quit if none
DO ^%ZIS
if POP
QUIT
+5 OPEN IO:"WN"
USE IO
+6 SET (MSG(1),MSG(3))=""
+7 SET MSG(2)="CLINICAL SPECIALTY DICOM & HL7 file (#2006.5831) -- "_$$HTE^XLFDT($HOROLOG,"2M")
+8 WRITE !!
DO HEADING(.MSG)
+9 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.5831,D0))
if 'D0
QUIT
Begin DoDot:1
+10 SET X=$GET(^MAG(2006.5831,D0,0))
+11 SET SERVICE=$PIECE(X,"^",1)
SET PROC=$PIECE(X,"^",2)
SET ISPECIDX=$PIECE(X,"^",3)
+12 SET IPROCIDX=$PIECE(X,"^",4)
SET DIVISION=$PIECE(X,"^",5)
+13 SET CPTIEN=$PIECE(X,"^",6)
SET HL7SUBLIST=$PIECE(X,"^",7)
+14 SET QRSCP=$PIECE(X,"^",8)
+15 WRITE !!?13,$SELECT(PROC:"-- Procedure",1:" -- Consult")," --"
+16 WRITE !,$$W("Request Service:"),$$GET1^DIQ(123.5,SERVICE,.01)
+17 IF PROC
WRITE !,$$W("Procedure:"),$$GET1^DIQ(123.3,PROC,.01)
+18 WRITE !,$$W("Worklist:"),$$GET1^DIQ(2005.84,ISPECIDX,3)
+19 IF IPROCIDX
WRITE "/",$$GET1^DIQ(2005.85,IPROCIDX,3)
+20 WRITE " (",$$GET1^DIQ(2005.84,ISPECIDX,.01)
+21 IF IPROCIDX
WRITE "/",$$GET1^DIQ(2005.85,IPROCIDX,.01)
+22 WRITE ")"
+23 WRITE !,$$W("Acquired at:"),$$GET1^DIQ(4,DIVISION,99)," -- ",$$GET1^DIQ(4,DIVISION,.01)
+24 SET ROUTE=$$GET1^DIQ(123.5,SERVICE,132)
+25 IF ROUTE'=""
Begin DoDot:2
+26 WRITE !,$$W("Remote IFC:"),ROUTE
+27 QUIT
End DoDot:2
+28 IF CPTIEN
Begin DoDot:2
+29 WRITE !,$$W("CPT Code:"),$$GET1^DIQ(81,CPTIEN,.01)
+30 WRITE " -- ",$$GET1^DIQ(81,CPTIEN,2)
+31 QUIT
End DoDot:2
+32 IF HL7SUBLIST
WRITE !,$$W("HL7 Subscriber List:"),$$GET1^DIQ(779.4,HL7SUBLIST,.01)
+33 IF QRSCP'=""
WRITE !,$$W("Q/R Provider:"),QRSCP
+34 SET CLINPTR=0
+35 SET D1=0
FOR
SET D1=$ORDER(^MAG(2006.5831,D0,1,D1))
if 'D1
QUIT
Begin DoDot:2
+36 IF 'CLINPTR
WRITE !,$$W("Clinic(s):")
+37 SET CLINPTR=$GET(^MAG(2006.5831,D0,1,D1,0))
+38 SET CLINNAME=$$GET1^DIQ(44,CLINPTR,.01)
+39 IF $X+$LENGTH(CLINNAME)>70
WRITE !,$$W("")
+40 WRITE CLINNAME," "
+41 QUIT
End DoDot:2
+42 ;
+43 ; output Associated Stop Code(s) if any
+44 KILL X
DO GETS^DIQ(123.5,SERVICE,"**","E","X")
+45 IF $DATA(X(123.5688))
Begin DoDot:2
+46 SET I=""
FOR
SET I=$ORDER(X(123.5688,I))
if I=""
QUIT
Begin DoDot:3
+47 WRITE !,$$W("Associated Stop Code:"),X(123.5688,I,.01,"E")
+48 QUIT
End DoDot:3
+49 QUIT
End DoDot:2
+50 IF '$TEST
Begin DoDot:2
+51 WRITE !,"Warning: No Associated Stop Codes are defined for this Request Service."
+52 WRITE !," Use CONSULT ASSOCIATED STOP CODE menu option to define them."
End DoDot:2
+53 QUIT
End DoDot:1
+54 CLOSE IO
USE $PRINCIPAL
+55 QUIT
+56 ;
TELEREAD ; display the TeleReader configuration files
+1 NEW ACQSITE,CLINNAME,CLINPTR,CPTCODE,D0,D1,D2,D3,DIVISION,HL7SUBLIST
+2 NEW IPROCIDX,ISPECIDX,LOCKTIME,MSG,POP,PRIMARY,PROC,ROUTE,SERVICE,STATUS
+3 NEW TIUNOTE,TRIGGER,USERPREF,X,X1,X2,X3
+4 SET (MSG(1),MSG(3))=""
+5 SET MSG(2)="TELEREADER ACQUISITION SERVICE file (#2006.5841) -- "_$$HTE^XLFDT($HOROLOG,"2M")
+6 ; Select device quit if none
IF '$DATA(IO)
DO ^%ZIS
if POP
QUIT
+7 OPEN IO:"WA"
USE IO
+8 WRITE !!
DO HEADING(.MSG)
+9 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.5841,D0))
if 'D0
QUIT
Begin DoDot:1
+10 SET X=$GET(^MAG(2006.5841,D0,0))
+11 SET SERVICE=$PIECE(X,"^",1)
SET PROC=$PIECE(X,"^",2)
SET ISPECIDX=$PIECE(X,"^",3)
+12 SET IPROCIDX=$PIECE(X,"^",4)
SET DIVISION=$PIECE(X,"^",5)
+13 SET TRIGGER=$PIECE(X,"^",6)
SET TIUNOTE=$PIECE(X,"^",7)
+14 WRITE !!,$$W("Request Service:"),$$GET1^DIQ(123.5,SERVICE,.01)
+15 IF $DATA(^MAG(2006.5831,SERVICE,0))
WRITE ?63,"*** DICOM MWL ***"
+16 IF PROC
WRITE !,$$W("Procedure:"),$$GET1^DIQ(123.3,PROC,.01)
+17 SET ROUTE=$$GET1^DIQ(123.5,SERVICE,132)
+18 IF ROUTE'=""
Begin DoDot:2
+19 WRITE !,$$W("Remote IFC:"),ROUTE
+20 QUIT
End DoDot:2
+21 WRITE !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
+22 WRITE " -- ",$$GET1^DIQ(2005.85,IPROCIDX,.01)
+23 WRITE !,$$W("Trigger:")
+24 IF TRIGGER="I"
WRITE "Create/update with every acquired image"
+25 IF '$TEST
IF TRIGGER="O"
WRITE "Create when request is ordered"
+26 IF '$TEST
IF TRIGGER="F"
WRITE "Create when consult is forwarded"
+27 IF '$TEST
WRITE "Unknown trigger value: """,TRIGGER,""""
+28 IF TIUNOTE
WRITE !,$$W("Note for IFC:"),$$GET1^DIQ(8925.1,TIUNOTE,.01)
+29 QUIT
End DoDot:1
+30 ;
+31 SET MSG(2)="TELEREADER ACQUISITION SITE file (#2006.5842)"
+32 WRITE !!
DO HEADING(.MSG)
+33 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.5842,D0))
if 'D0
QUIT
Begin DoDot:1
+34 SET X=$GET(^MAG(2006.5842,D0,0))
+35 SET ACQSITE=$PIECE(X,"^",1)
SET PRIMARY=$PIECE(X,"^",2)
+36 SET STATUS=$PIECE(X,"^",3)
SET LOCKTIME=$PIECE(X,"^",4)
+37 WRITE !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
+38 WRITE ?50,$SELECT(STATUS:"Active",1:"Inactive")
+39 WRITE ?60,"Lock Time: ",LOCKTIME," min."
+40 WRITE !,$$W("Primary Site:"),$$GET1^DIQ(4,PRIMARY,.01)
+41 QUIT
End DoDot:1
+42 ;
+43 SET MSG(2)="TELEREADER READER file (#2006.5843)"
+44 WRITE !!
DO HEADING(.MSG)
+45 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.5843,D0))
if 'D0
QUIT
Begin DoDot:1
+46 SET X=$GET(^MAG(2006.5843,D0,0))
+47 if D0>1
WRITE !!,$TRANSLATE($JUSTIFY("",80)," ","-")
+48 WRITE !!,$$W("TeleReader:"),$$GET1^DIQ(200,X,.01)
+49 SET D1=0
FOR
SET D1=$ORDER(^MAG(2006.5843,D0,1,D1))
if 'D1
QUIT
Begin DoDot:2
+50 SET X1=$GET(^MAG(2006.5843,D0,1,D1,0))
+51 SET ACQSITE=$PIECE(X1,"^",1)
SET STATUS=$PIECE(X1,"^",2)
+52 WRITE !!,$$W("Acquisition:"),$$GET1^DIQ(4,ACQSITE,.01)
+53 WRITE ?50,$SELECT(STATUS:"Active",1:"Inactive")
+54 SET D2=0
FOR
SET D2=$ORDER(^MAG(2006.5843,D0,1,D1,1,D2))
if 'D2
QUIT
Begin DoDot:3
+55 SET X2=$GET(^MAG(2006.5843,D0,1,D1,1,D2,0))
+56 SET ISPECIDX=$PIECE(X2,"^",1)
SET STATUS=$PIECE(X2,"^",2)
+57 WRITE !,$$W(" Unread List:"),$$GET1^DIQ(2005.84,ISPECIDX,.01)
+58 WRITE ?50,$SELECT(STATUS:"Active",1:"Inactive")
+59 SET D3=0
FOR
SET D3=$ORDER(^MAG(2006.5843,D0,1,D1,1,D2,1,D3))
if 'D3
QUIT
Begin DoDot:4
+60 SET X3=$GET(^MAG(2006.5843,D0,1,D1,1,D2,1,D3,0))
+61 SET IPROCIDX=$PIECE(X3,"^",1)
SET STATUS=$PIECE(X3,"^",2)
SET USERPREF=$PIECE(X3,"^",3)
+62 WRITE !,$$W(""),$$GET1^DIQ(2005.85,IPROCIDX,.01)
+63 WRITE ?50,$SELECT(STATUS:"Active",1:"Inactive")
+64 WRITE ?65,"User: ",$SELECT(USERPREF:"Active",1:"Inactive")
+65 QUIT
End DoDot:4
+66 QUIT
End DoDot:3
+67 QUIT
End DoDot:2
+68 QUIT
End DoDot:1
+69 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*"),!
+70 WRITE !!,"End of Report",!
+71 CLOSE IO
USE $PRINCIPAL
+72 QUIT
+73 ;
W(PROMPT) ; output prompt
+1 QUIT $JUSTIFY(PROMPT,21)_" "
+2 ;
HEADING(MSG) ;
+1 NEW I
+2 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*")
+3 IF $DATA(MSG)=1
WRITE !,"*** ",MSG,?76," ***"
+4 IF '$TEST
FOR I=1:1
if '$DATA(MSG(I))
QUIT
WRITE !,"*** ",MSG(I),?76," ***"
+5 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","*")
+6 QUIT
+7 ;
