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

MAGDHPS.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  ; Supported IA #1373 -- accessing ^ORD(101,"B" & ^ORD(101,D0,"775" (including the "B" xref under 775)
  1.  Q
  1.  ;
  1. MAGIP208 ; post install entry point to set subscriptions to V2.4 Radiology
  1.  N MAG30P208 ; special variable to control non-intractive mode
  1.  S MAG30P208=1
  1.  ; 
  1. 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/
  1.  ; DICOM Gateway and to commercial imaging systems.
  1.  ; 
  1.  N MAGPIX ; --- protocol index, either MAGPIXO or MAGPIXR
  1.  N MAGPIXO ; -- protocol index for MAGD SEND ORM
  1.  N MAGPIXR ; -- protocol index for MAGD SEND ORU
  1.  N RADPSTR ; -- Radiology protocol name string
  1.  N I ; -------- scratch index variable
  1.  N RADPA ; ---- array containing Radiology protocol names and IENs
  1.  N RADPEX ; --- exception flag for Radiology protocol name processing
  1.  N RADPI ; ---- Radiology protocol IEN
  1.  N DA,DIC,DIK,DIR,DTOUT,DUOUT,X,Y ; -- FileMan work variables
  1.  N HL7VER ; --- HL7 version desired 
  1.  ;
  1.  W !!,"This option is used to set the Radiology HL7 version for the DICOM Text Gateway."
  1.  W !,"The HL7 v2.4 is the default and is recommended because it provides more data."
  1.  ; Are there a MAGD SEND ORM and MAGD SEND ORU protocols for us to subscribe?
  1.  S MAGPIXO=$O(^ORD(101,"B","MAGD SEND ORM",0))
  1.  I MAGPIXO D  ; yes
  1.  . U IO(0) W !!,"MAGD SEND ORM protocol found..."
  1.  . Q
  1.  E  D  G ABEND  ; no, bail
  1.  . U IO(0) W !!,"ATTENTION:  The MAGD SEND ORM protocol does not exist"
  1.  . W !,"on this system."
  1.  . Q
  1.  ;
  1.  S MAGPIXR=$O(^ORD(101,"B","MAGD SEND ORU",0))
  1.  I MAGPIXR D  ; yes
  1.  . U IO(0) W !,"MAGD SEND ORU protocol found...",!
  1.  . Q
  1.  E  D  G ABEND  ; no, bail
  1.  . U IO(0) W !!,"ATTENTION:  The MAGD SEND ORU protocol does not exist"
  1.  . W !,"on this system."
  1.  . Q
  1.  ;
  1.  ; Make sure we have all the Radiology protocols we need.
  1.  S RADPSTR="RA CANCEL^RA EXAMINED^RA REG^RA RPT"
  1.  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"
  1.  S RADPEX=0
  1.  F I=1:1:12 D  G ABEND:RADPEX
  1.  . U IO(0) W !,RADPA(I,0)_" protocol "
  1.  . S RADPI=$O(^ORD(101,"B",RADPA(I,0),0))
  1.  . I RADPI D
  1.  . . U IO(0) W "found..."
  1.  . . S RADPA(I,1)=RADPI
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) W ?35," MAGD SEND ORM subscribed "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) W ?35," MAGD SEND ORU subscribed"
  1.  . . Q
  1.  . E  D
  1.  . . U IO(0) W "not found..."
  1.  . . S RADPEX=1
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I $G(MAG30P208) S HL7VER=2.4 ; default for MAG*3.0*208 post install
  1.  E  D  G END:$D(DTOUT),END:$D(DUOUT)
  1.  . ; Find out which version of HL7 they want to send.
  1.  . S DIR(0)="SAX^2.1:HL7 Version 2.1;2.3:HL7 Version 2.3;2.4:HL7 Version 2.4 - Highly Recommended"
  1.  . S DIR("A")="Enter the desired version of HL7: "
  1.  . U IO(0) W !
  1.  . D ^DIR I $D(DTOUT)!$D(DUOUT) Q
  1.  . S HL7VER=Y
  1.  . Q
  1.  ;
  1.  U IO(0) W !,"Subscribing to HL7 version "_HL7VER_" Radiology HL7 protocols..."
  1.  ;
  1.  S RADPEX=0
  1.  I HL7VER=2.1 D  G ABEND:RADPEX
  1.  . ; If 2.1 protocols are already subscribed to, do nothing;
  1.  . ; otherwise, subscribe to them.
  1.  . F I=1:1:4 D  Q:RADPEX
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
  1.  . . . W "is already subscribed to, no action taken"
  1.  . . . Q
  1.  . . E  D ADD(MAGPIX,RADPA(I,1),.RADPEX)
  1.  . . W "..."
  1.  . . Q
  1.  . ; If 2.3 or 2.4 protocols are currently subscribed to, unsubscribe from them;
  1.  . ; otherwise, do nothing.
  1.  . F I=5:1:12 D
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . ; S MAGPIX=$S(I=8:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
  1.  . . . D KILL(MAGPIXO,RADPA(I,1))
  1.  . . . Q
  1.  . . E  I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
  1.  . . . D KILL(MAGPIXR,RADPA(I,1))
  1.  . . . Q
  1.  . . E  D
  1.  . . . W "is not currently subscribed to, no action taken"
  1.  . . . Q
  1.  . . W "..."
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I HL7VER=2.3 D  G ABEND:RADPEX
  1.  . ; If 2.1 or 2.4 protocols are currently subscribed to, unsubscribe from them;
  1.  . ; otherwise, do nothing.
  1.  . F I=1:1:4,9:1:12 D
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
  1.  . . . D KILL(MAGPIXO,RADPA(I,1))
  1.  . . . Q
  1.  . . E  I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
  1.  . . . D KILL(MAGPIXR,RADPA(I,1))
  1.  . . . Q
  1.  . . E  D
  1.  . . . W "is not currently subscribed to, no action taken"
  1.  . . . Q
  1.  . . W "..."
  1.  . . Q
  1.  . ; If 2.3 protocols are already subscribed to, do nothing;
  1.  . ; otherwise, subscribe to them.
  1.  . F I=5:1:8 D  Q:RADPEX
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . S MAGPIX=$S(I=8:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
  1.  . . . W "is already subscribed to, no action taken"
  1.  . . . Q
  1.  . . E  D ADD(MAGPIX,RADPA(I,1),.RADPEX)
  1.  . . W "..."
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I HL7VER=2.4 D  G ABEND:RADPEX
  1.  . ; If 2.1 or 2.3 protocols are currently subscribed to, unsubscribe from them;
  1.  . ; otherwise, do nothing.
  1.  . F I=1:1:8 D
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . ; S MAGPIX=$S(I=4:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
  1.  . . . D KILL(MAGPIXO,RADPA(I,1))
  1.  . . . Q
  1.  . . E  I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
  1.  . . . D KILL(MAGPIXR,RADPA(I,1))
  1.  . . . Q
  1.  . . E  D
  1.  . . . W "is not currently subscribed to, no action taken"
  1.  . . . Q
  1.  . . W "..."
  1.  . . Q
  1.  . ; If 2.4 protocols are already subscribed to, do nothing;
  1.  . ; otherwise, subscribe to them.
  1.  . F I=9:1:12 D  Q:RADPEX
  1.  . . ; associate Imaging and Radiology order and report protocols appropriately
  1.  . . S MAGPIX=$S(I=12:MAGPIXR,1:MAGPIXO)
  1.  . . U IO(0) W !,"   Protocol "_RADPA(I,0)_" "
  1.  . . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIX)) D
  1.  . . . W "is already subscribed to, no action taken"
  1.  . . . Q
  1.  . . E  D ADD(MAGPIX,RADPA(I,1),.RADPEX)
  1.  . . W "..."
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; P208 PMK 9/24/18
  1.  U IO(0)
  1.  W !!,"The MAGD SEND ORU protocol should no longer be a subscriber to the RA RPT *"
  1.  W !,"event drivers. Vestigial MAGD SEND ORU subscribers to the RA RPT, RA RPT 2.3,"
  1.  W !,"and RA RPT 2.4 protocols are now removed.",!
  1.  S I=0 F  S I=$O(RADPA(I)) Q:'I  I RADPA(I,0)?1"RA RPT".E D
  1.  . W !,"Protocol ",RADPA(I,0)," "
  1.  . I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXO)) D
  1.  . . D KILL(MAGPIXR,RADPA(I,1))
  1.  . . W "..."
  1.  . . Q
  1.  . E  I $D(^ORD(101,RADPA(I,1),775,"B",MAGPIXR)) D
  1.  . . D KILL(MAGPIXR,RADPA(I,1))
  1.  . . W "..."
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1.  G END
  1.  ; 
  1. ABEND ; exception raised
  1.  U IO(0) W !,"Please contact Imaging Support for further assistance."
  1. END ;
  1.  Q
  1.  ;
  1. 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.
  1.  N Y,DIC,DA,X ; -- Fileman variables
  1.  S DIC="^ORD(101,"_EVENTDRV_",775,",DIC(0)="L",DA(1)=EVENTDRV,X=SUB
  1.  D FILE^DICN
  1.  I Y=-1 S STATFLAG=1
  1.  W $S('$G(STATFLAG):"has been",1:"could not be")_" subscribed to"
  1.  Q
  1.  ;
  1. 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.
  1.  N DA,DIK ; -- Fileman variables
  1.  S DA(1)=EVENTDRV,DA=$O(^ORD(101,DA(1),775,"B",SUB,0))
  1.  S DIK="^ORD(101,"_EVENTDRV_",775,"
  1.  D ^DIK
  1.  W "has been unsubscribed from"
  1.  Q