MAGDHPS ;WOIFO/MLH - Maintain subscriptions to Rad HL7 drivers ;25 Sep 2018 9:47 AM
;;3.0;IMAGING;**49,183,208**;Mar 19, 2002;Build 6;Apr 07, 2011
;; 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 #1373 -- accessing ^ORD(101,"B" & ^ORD(101,D0,"775" (including the "B" xref under 775)
Q
;
MAGIP208 ; post install entry point to set subscriptions to V2.4 Radiology
N MAG30P208 ; special variable to control non-intractive mode
S MAG30P208=1
;
MAINT ; MAIN ENTRY POINT - allow the user to select the version of HL7
; that will be used to create Radiology messages to the VistA Text/
; DICOM Gateway and to commercial imaging systems.
;
N MAGPIX ; --- protocol index, either MAGPIXO or MAGPIXR
N MAGPIXO ; -- protocol index for MAGD SEND ORM
N MAGPIXR ; -- protocol index for MAGD SEND ORU
N RADPSTR ; -- Radiology protocol name string
N I ; -------- scratch index variable
N RADPA ; ---- array containing Radiology protocol names and IENs
N RADPEX ; --- exception flag for Radiology protocol name processing
N RADPI ; ---- Radiology protocol IEN
N DA,DIC,DIK,DIR,DTOUT,DUOUT,X,Y ; -- FileMan work variables
N HL7VER ; --- HL7 version desired
;
W !!,"This option is used to set the Radiology HL7 version for the DICOM Text Gateway."
W !,"The HL7 v2.4 is the default and is recommended because it provides more data."
; Are there a MAGD SEND ORM and MAGD SEND ORU protocols for us to subscribe?
S MAGPIXO=$O(^ORD(101,"B","MAGD SEND ORM",0))
I MAGPIXO D ; yes
. U IO(0) W !!,"MAGD SEND ORM protocol found..."
. Q
E D G ABEND ; no, bail
. U IO(0) W !!,"ATTENTION: The MAGD SEND ORM protocol does not exist"
. W !,"on this system."
. Q
;
S MAGPIXR=$O(^ORD(101,"B","MAGD SEND ORU",0))
I MAGPIXR D ; yes
. U IO(0) W !,"MAGD SEND ORU protocol found...",!
. Q
E D G ABEND ; no, bail
. U IO(0) W !!,"ATTENTION: The MAGD SEND ORU protocol does not exist"
. W !,"on this system."
. Q
;
; Make sure we have all the Radiology protocols we need.
S RADPSTR="RA CANCEL^RA EXAMINED^RA REG^RA RPT"
F I=1:1:4 S RADPA(I,0)=$P(RADPSTR,"^",I),RADPA(I+4,0)=RADPA(I,0)_" 2.3",RADPA(I+8,0)=RADPA(I,0)_" 2.4"
S RADPEX=0
F I=1:1:12 D G ABEND:RADPEX
. U IO(0) W !,RADPA(I,0)_" protocol "
. S RADPI=$O(^ORD(101,"B",RADPA(I,0),0))
. I RADPI D
. . U IO(0) W "found..."
. . S RADPA(I,1)=RADPI
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) W ?35," MAGD SEND ORM subscribed "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) W ?35," MAGD SEND ORU subscribed"
. . Q
. E D
. . U IO(0) W "not found..."
. . S RADPEX=1
. . Q
. Q
;
I $G(MAG30P208) S HL7VER=2.4 ; default for MAG*3.0*208 post install
E D G END:$D(DTOUT),END:$D(DUOUT)
. ; Find out which version of HL7 they want to send.
. S DIR(0)="SAX^2.1:HL7 Version 2.1;2.3:HL7 Version 2.3;2.4:HL7 Version 2.4 - Highly Recommended"
. S DIR("A")="Enter the desired version of HL7: "
. U IO(0) W !
. D ^DIR I $D(DTOUT)!$D(DUOUT) Q
. S HL7VER=Y
. Q
;
U IO(0) W !,"Subscribing to HL7 version "_HL7VER_" Radiology HL7 protocols..."
;
S RADPEX=0
I HL7VER=2.1 D G ABEND:RADPEX
. ; If 2.1 protocols are already subscribed to, do nothing;
. ; otherwise, subscribe to them.
. F I=1:1:4 D Q:RADPEX
. . ; associate Imaging and Radiology order and report protocols appropriately
. . S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
. . . W "is already subscribed to, no action taken"
. . . Q
. . E D ADD(MAGPIX,RADPA(I,1),.RADPEX)
. . W "..."
. . Q
. ; If 2.3 or 2.4 protocols are currently subscribed to, unsubscribe from them;
. ; otherwise, do nothing.
. F I=5:1:12 D
. . ; associate Imaging and Radiology order and report protocols appropriately
. . ; S MAGPIX=$S(I=8:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
. . . D KILL(MAGPIXO,RADPA(I,1))
. . . Q
. . E I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
. . . D KILL(MAGPIXR,RADPA(I,1))
. . . Q
. . E D
. . . W "is not currently subscribed to, no action taken"
. . . Q
. . W "..."
. . Q
. Q
;
I HL7VER=2.3 D G ABEND:RADPEX
. ; If 2.1 or 2.4 protocols are currently subscribed to, unsubscribe from them;
. ; otherwise, do nothing.
. F I=1:1:4,9:1:12 D
. . ; associate Imaging and Radiology order and report protocols appropriately
. . ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
. . . D KILL(MAGPIXO,RADPA(I,1))
. . . Q
. . E I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
. . . D KILL(MAGPIXR,RADPA(I,1))
. . . Q
. . E D
. . . W "is not currently subscribed to, no action taken"
. . . Q
. . W "..."
. . Q
. ; If 2.3 protocols are already subscribed to, do nothing;
. ; otherwise, subscribe to them.
. F I=5:1:8 D Q:RADPEX
. . ; associate Imaging and Radiology order and report protocols appropriately
. . S MAGPIX=$S(I=8:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
. . . W "is already subscribed to, no action taken"
. . . Q
. . E D ADD(MAGPIX,RADPA(I,1),.RADPEX)
. . W "..."
. . Q
. Q
;
I HL7VER=2.4 D G ABEND:RADPEX
. ; If 2.1 or 2.3 protocols are currently subscribed to, unsubscribe from them;
. ; otherwise, do nothing.
. F I=1:1:8 D
. . ; associate Imaging and Radiology order and report protocols appropriately
. . ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
. . . D KILL(MAGPIXO,RADPA(I,1))
. . . Q
. . E I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
. . . D KILL(MAGPIXR,RADPA(I,1))
. . . Q
. . E D
. . . W "is not currently subscribed to, no action taken"
. . . Q
. . W "..."
. . Q
. ; If 2.4 protocols are already subscribed to, do nothing;
. ; otherwise, subscribe to them.
. F I=9:1:12 D Q:RADPEX
. . ; associate Imaging and Radiology order and report protocols appropriately
. . S MAGPIX=$S(I=12:MAGPIXR,1:MAGPIXO)
. . U IO(0) W !," Protocol "_RADPA(I,0)_" "
. . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
. . . W "is already subscribed to, no action taken"
. . . Q
. . E D ADD(MAGPIX,RADPA(I,1),.RADPEX)
. . W "..."
. . Q
. Q
;
; P208 PMK 9/24/18
U IO(0)
W !!,"The MAGD SEND ORU protocol should no longer be a subscriber to the RA RPT *"
W !,"event drivers. Vestigial MAGD SEND ORU subscribers to the RA RPT, RA RPT 2.3,"
W !,"and RA RPT 2.4 protocols are now removed.",!
S I=0 F S I=$O(RADPA(I)) Q:'I I RADPA(I,0)?1"RA RPT".E D
. W !,"Protocol ",RADPA(I,0)," "
. I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
. . D KILL(MAGPIXR,RADPA(I,1))
. . W "..."
. . Q
. E I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
. . D KILL(MAGPIXR,RADPA(I,1))
. . W "..."
. . Q
. Q
Q
;
G END
;
ABEND ; exception raised
U IO(0) W !,"Please contact Imaging Support for further assistance."
END ;
Q
;
ADD(SUB,EVENTDRV,STATFLAG) ; SUBROUTINE - not to be invoked except from within this routine
; Subscribe gateway protocol SUB to the Radiology event driver protocol EVENTDRV.
N Y,DIC,DA,X ; -- Fileman variables
S DIC="^ORD(101,"_EVENTDRV_",775,",DIC(0)="L",DA(1)=EVENTDRV,X=SUB
D FILE^DICN
I Y=-1 S STATFLAG=1
W $S('$G(STATFLAG):"has been",1:"could not be")_" subscribed to"
Q
;
KILL(SUB,EVENTDRV) ; SUBROUTINE - not to be invoked except from within this routine
; Unsubscribe gateway protocol SUB from the Radiology event driver protocol EVENTDRV.
N DA,DIK ; -- Fileman variables
S DA(1)=EVENTDRV,DA=$O(^ORD(101,DA(1),775,"B",SUB,0))
S DIK="^ORD(101,"_EVENTDRV_",775,"
D ^DIK
W "has been unsubscribed from"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHPS 8867 printed Dec 13, 2024@02:00:15 Page 2
MAGDHPS ;WOIFO/MLH - Maintain subscriptions to Rad HL7 drivers ;25 Sep 2018 9:47 AM
+1 ;;3.0;IMAGING;**49,183,208**;Mar 19, 2002;Build 6;Apr 07, 2011
+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 ; Supported IA #1373 -- accessing ^ORD(101,"B" & ^ORD(101,D0,"775" (including the "B" xref under 775)
+18 QUIT
+19 ;
MAGIP208 ; post install entry point to set subscriptions to V2.4 Radiology
+1 ; special variable to control non-intractive mode
NEW MAG30P208
+2 SET MAG30P208=1
+3 ;
MAINT ; MAIN ENTRY POINT - allow the user to select the version of HL7
+1 ; that will be used to create Radiology messages to the VistA Text/
+2 ; DICOM Gateway and to commercial imaging systems.
+3 ;
+4 ; --- protocol index, either MAGPIXO or MAGPIXR
NEW MAGPIX
+5 ; -- protocol index for MAGD SEND ORM
NEW MAGPIXO
+6 ; -- protocol index for MAGD SEND ORU
NEW MAGPIXR
+7 ; -- Radiology protocol name string
NEW RADPSTR
+8 ; -------- scratch index variable
NEW I
+9 ; ---- array containing Radiology protocol names and IENs
NEW RADPA
+10 ; --- exception flag for Radiology protocol name processing
NEW RADPEX
+11 ; ---- Radiology protocol IEN
NEW RADPI
+12 ; -- FileMan work variables
NEW DA,DIC,DIK,DIR,DTOUT,DUOUT,X,Y
+13 ; --- HL7 version desired
NEW HL7VER
+14 ;
+15 WRITE !!,"This option is used to set the Radiology HL7 version for the DICOM Text Gateway."
+16 WRITE !,"The HL7 v2.4 is the default and is recommended because it provides more data."
+17 ; Are there a MAGD SEND ORM and MAGD SEND ORU protocols for us to subscribe?
+18 SET MAGPIXO=$ORDER(^ORD(101,"B","MAGD SEND ORM",0))
+19 ; yes
IF MAGPIXO
Begin DoDot:1
+20 USE IO(0)
WRITE !!,"MAGD SEND ORM protocol found..."
+21 QUIT
End DoDot:1
+22 ; no, bail
IF '$TEST
Begin DoDot:1
+23 USE IO(0)
WRITE !!,"ATTENTION: The MAGD SEND ORM protocol does not exist"
+24 WRITE !,"on this system."
+25 QUIT
End DoDot:1
GOTO ABEND
+26 ;
+27 SET MAGPIXR=$ORDER(^ORD(101,"B","MAGD SEND ORU",0))
+28 ; yes
IF MAGPIXR
Begin DoDot:1
+29 USE IO(0)
WRITE !,"MAGD SEND ORU protocol found...",!
+30 QUIT
End DoDot:1
+31 ; no, bail
IF '$TEST
Begin DoDot:1
+32 USE IO(0)
WRITE !!,"ATTENTION: The MAGD SEND ORU protocol does not exist"
+33 WRITE !,"on this system."
+34 QUIT
End DoDot:1
GOTO ABEND
+35 ;
+36 ; Make sure we have all the Radiology protocols we need.
+37 SET RADPSTR="RA CANCEL^RA EXAMINED^RA REG^RA RPT"
+38 FOR I=1:1:4
SET RADPA(I,0)=$PIECE(RADPSTR,"^",I)
SET RADPA(I+4,0)=RADPA(I,0)_" 2.3"
SET RADPA(I+8,0)=RADPA(I,0)_" 2.4"
+39 SET RADPEX=0
+40 FOR I=1:1:12
Begin DoDot:1
+41 USE IO(0)
WRITE !,RADPA(I,0)_" protocol "
+42 SET RADPI=$ORDER(^ORD(101,"B",RADPA(I,0),0))
+43 IF RADPI
Begin DoDot:2
+44 USE IO(0)
WRITE "found..."
+45 SET RADPA(I,1)=RADPI
+46 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXO))
WRITE ?35," MAGD SEND ORM subscribed "
+47 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXR))
WRITE ?35," MAGD SEND ORU subscribed"
+48 QUIT
End DoDot:2
+49 IF '$TEST
Begin DoDot:2
+50 USE IO(0)
WRITE "not found..."
+51 SET RADPEX=1
+52 QUIT
End DoDot:2
+53 QUIT
End DoDot:1
if RADPEX
GOTO ABEND
+54 ;
+55 ; default for MAG*3.0*208 post install
IF $GET(MAG30P208)
SET HL7VER=2.4
+56 IF '$TEST
Begin DoDot:1
+57 ; Find out which version of HL7 they want to send.
+58 SET DIR(0)="SAX^2.1:HL7 Version 2.1;2.3:HL7 Version 2.3;2.4:HL7 Version 2.4 - Highly Recommended"
+59 SET DIR("A")="Enter the desired version of HL7: "
+60 USE IO(0)
WRITE !
+61 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+62 SET HL7VER=Y
+63 QUIT
End DoDot:1
if $DATA(DTOUT)
GOTO END
if $DATA(DUOUT)
GOTO END
+64 ;
+65 USE IO(0)
WRITE !,"Subscribing to HL7 version "_HL7VER_" Radiology HL7 protocols..."
+66 ;
+67 SET RADPEX=0
+68 IF HL7VER=2.1
Begin DoDot:1
+69 ; If 2.1 protocols are already subscribed to, do nothing;
+70 ; otherwise, subscribe to them.
+71 FOR I=1:1:4
Begin DoDot:2
+72 ; associate Imaging and Radiology order and report protocols appropriately
+73 SET MAGPIX=$SELECT(I=4:MAGPIXR,1:MAGPIXO)
+74 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+75 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIX))
Begin DoDot:3
+76 WRITE "is already subscribed to, no action taken"
+77 QUIT
End DoDot:3
+78 IF '$TEST
DO ADD(MAGPIX,RADPA(I,1),.RADPEX)
+79 WRITE "..."
+80 QUIT
End DoDot:2
if RADPEX
QUIT
+81 ; If 2.3 or 2.4 protocols are currently subscribed to, unsubscribe from them;
+82 ; otherwise, do nothing.
+83 FOR I=5:1:12
Begin DoDot:2
+84 ; associate Imaging and Radiology order and report protocols appropriately
+85 ; S MAGPIX=$S(I=8:MAGPIXR,1:MAGPIXO)
+86 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+87 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXO))
Begin DoDot:3
+88 DO KILL(MAGPIXO,RADPA(I,1))
+89 QUIT
End DoDot:3
+90 IF '$TEST
IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXR))
Begin DoDot:3
+91 DO KILL(MAGPIXR,RADPA(I,1))
+92 QUIT
End DoDot:3
+93 IF '$TEST
Begin DoDot:3
+94 WRITE "is not currently subscribed to, no action taken"
+95 QUIT
End DoDot:3
+96 WRITE "..."
+97 QUIT
End DoDot:2
+98 QUIT
End DoDot:1
if RADPEX
GOTO ABEND
+99 ;
+100 IF HL7VER=2.3
Begin DoDot:1
+101 ; If 2.1 or 2.4 protocols are currently subscribed to, unsubscribe from them;
+102 ; otherwise, do nothing.
+103 FOR I=1:1:4,9:1:12
Begin DoDot:2
+104 ; associate Imaging and Radiology order and report protocols appropriately
+105 ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
+106 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+107 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXO))
Begin DoDot:3
+108 DO KILL(MAGPIXO,RADPA(I,1))
+109 QUIT
End DoDot:3
+110 IF '$TEST
IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXR))
Begin DoDot:3
+111 DO KILL(MAGPIXR,RADPA(I,1))
+112 QUIT
End DoDot:3
+113 IF '$TEST
Begin DoDot:3
+114 WRITE "is not currently subscribed to, no action taken"
+115 QUIT
End DoDot:3
+116 WRITE "..."
+117 QUIT
End DoDot:2
+118 ; If 2.3 protocols are already subscribed to, do nothing;
+119 ; otherwise, subscribe to them.
+120 FOR I=5:1:8
Begin DoDot:2
+121 ; associate Imaging and Radiology order and report protocols appropriately
+122 SET MAGPIX=$SELECT(I=8:MAGPIXR,1:MAGPIXO)
+123 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+124 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIX))
Begin DoDot:3
+125 WRITE "is already subscribed to, no action taken"
+126 QUIT
End DoDot:3
+127 IF '$TEST
DO ADD(MAGPIX,RADPA(I,1),.RADPEX)
+128 WRITE "..."
+129 QUIT
End DoDot:2
if RADPEX
QUIT
+130 QUIT
End DoDot:1
if RADPEX
GOTO ABEND
+131 ;
+132 IF HL7VER=2.4
Begin DoDot:1
+133 ; If 2.1 or 2.3 protocols are currently subscribed to, unsubscribe from them;
+134 ; otherwise, do nothing.
+135 FOR I=1:1:8
Begin DoDot:2
+136 ; associate Imaging and Radiology order and report protocols appropriately
+137 ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
+138 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+139 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXO))
Begin DoDot:3
+140 DO KILL(MAGPIXO,RADPA(I,1))
+141 QUIT
End DoDot:3
+142 IF '$TEST
IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXR))
Begin DoDot:3
+143 DO KILL(MAGPIXR,RADPA(I,1))
+144 QUIT
End DoDot:3
+145 IF '$TEST
Begin DoDot:3
+146 WRITE "is not currently subscribed to, no action taken"
+147 QUIT
End DoDot:3
+148 WRITE "..."
+149 QUIT
End DoDot:2
+150 ; If 2.4 protocols are already subscribed to, do nothing;
+151 ; otherwise, subscribe to them.
+152 FOR I=9:1:12
Begin DoDot:2
+153 ; associate Imaging and Radiology order and report protocols appropriately
+154 SET MAGPIX=$SELECT(I=12:MAGPIXR,1:MAGPIXO)
+155 USE IO(0)
WRITE !," Protocol "_RADPA(I,0)_" "
+156 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIX))
Begin DoDot:3
+157 WRITE "is already subscribed to, no action taken"
+158 QUIT
End DoDot:3
+159 IF '$TEST
DO ADD(MAGPIX,RADPA(I,1),.RADPEX)
+160 WRITE "..."
+161 QUIT
End DoDot:2
if RADPEX
QUIT
+162 QUIT
End DoDot:1
if RADPEX
GOTO ABEND
+163 ;
+164 ; P208 PMK 9/24/18
+165 USE IO(0)
+166 WRITE !!,"The MAGD SEND ORU protocol should no longer be a subscriber to the RA RPT *"
+167 WRITE !,"event drivers. Vestigial MAGD SEND ORU subscribers to the RA RPT, RA RPT 2.3,"
+168 WRITE !,"and RA RPT 2.4 protocols are now removed.",!
+169 SET I=0
FOR
SET I=$ORDER(RADPA(I))
if 'I
QUIT
IF RADPA(I,0)?1"RA RPT".E
Begin DoDot:1
+170 WRITE !,"Protocol ",RADPA(I,0)," "
+171 IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXO))
Begin DoDot:2
+172 DO KILL(MAGPIXR,RADPA(I,1))
+173 WRITE "..."
+174 QUIT
End DoDot:2
+175 IF '$TEST
IF $DATA(^ORD(101,RADPA(I,1),775,"B",MAGPIXR))
Begin DoDot:2
+176 DO KILL(MAGPIXR,RADPA(I,1))
+177 WRITE "..."
+178 QUIT
End DoDot:2
+179 QUIT
End DoDot:1
+180 QUIT
+181 ;
+182 GOTO END
+183 ;
ABEND ; exception raised
+1 USE IO(0)
WRITE !,"Please contact Imaging Support for further assistance."
END ;
+1 QUIT
+2 ;
ADD(SUB,EVENTDRV,STATFLAG) ; SUBROUTINE - not to be invoked except from within this routine
+1 ; Subscribe gateway protocol SUB to the Radiology event driver protocol EVENTDRV.
+2 ; -- Fileman variables
NEW Y,DIC,DA,X
+3 SET DIC="^ORD(101,"_EVENTDRV_",775,"
SET DIC(0)="L"
SET DA(1)=EVENTDRV
SET X=SUB
+4 DO FILE^DICN
+5 IF Y=-1
SET STATFLAG=1
+6 WRITE $SELECT('$GET(STATFLAG):"has been",1:"could not be")_" subscribed to"
+7 QUIT
+8 ;
KILL(SUB,EVENTDRV) ; SUBROUTINE - not to be invoked except from within this routine
+1 ; Unsubscribe gateway protocol SUB from the Radiology event driver protocol EVENTDRV.
+2 ; -- Fileman variables
NEW DA,DIK
+3 SET DA(1)=EVENTDRV
SET DA=$ORDER(^ORD(101,DA(1),775,"B",SUB,0))
+4 SET DIK="^ORD(101,"_EVENTDRV_",775,"
+5 DO ^DIK
+6 WRITE "has been unsubscribed from"
+7 QUIT
