- 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 Feb 18, 2025@23:26:43 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