MAG7UCFG ;WOIFO/MLH,DAC - Configure HL7 PACS interface ; 16 NOV 2014 4:29 PM
;;3.0;IMAGING;**49,156**;Mar 19, 2002;Build 10;Nov 16, 2014
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
CONFIG ; MAIN ENTRY POINT - Configure the HL7 PACS interface
; Allow user to specify sender and receiver names, and to toggle
; the interface between active/inactive.
;
; Called by Option MAG CONFIGURE IHE PACS HL7 I/F.
;
N DA,DIC,DIE,DIQ,DR,DTOUT,DUOUT ; -- FileMan work variables
N APP ; ------ work array for DIQ application lookups
N SNDIX ; ---- IEN of the sending application
N SNDNAME ; -- name of the sending application
N RCVIX ; ---- IEN of the receiving application
N RCVNAME ; -- name of the receiving application
N LINKIX ; --- IEN of the logical link
;
W !!,"HL7 PACS Interface Configuration",!!
;
; Look up the sending application
S DIC="^ORD(101,",X="MAG CPACS A01",DIC(0)="X"
D ^DIC I Y<0 D G ABEND
. W !,"ERROR: HL7 messaging event driver protocol(s) missing."
. Q
K APP S DIQ="APP",DIQ(0)="I",DIC="^ORD(101,",DA=$P(Y,U,1),DR=770.1
D EN^DIQ1 S SNDIX=$G(APP(101,DA,770.1,"I"))
I SNDIX'>0 D G ABEND
. W !,"ERROR: No sending application defined."
. Q
; Look up sender name directly in application file - this allows
; us to catch a missing pointer
K APP S DIQ="APP",DIQ(0)="IE",DIC="^HL(771,",DA=SNDIX,DR=.01
D EN^DIQ1 I '$D(APP) D G ABEND
. W !,"ERROR: Pointed-to sender entry ("_DA_") missing"
. W !," from HL7 APPLICATION PARAMETER File (#771)."
. Q
S SNDNAME=$G(APP(771,DA,.01,"E"))
;
; Look up the receiving application
S DIC="^ORD(101,",X="MAG CPACS A01 SUBS",DIC(0)="X"
D ^DIC I Y<0 D G ABEND
. W !,"ERROR: HL7 messaging subscriber protocol(s) missing."
. Q
K APP S DIQ="APP",DIQ(0)="I",DIC="^ORD(101,",DA=$P(Y,U,1),DR=770.2
D EN^DIQ1 S RCVIX=$G(APP(101,DA,770.2,"I"))
I RCVIX'>0 D G ABEND
. W !,"ERROR: No receiving application defined."
. Q
; Look up receiver name directly in application file - this allows
; us to catch a missing pointer
K APP S DIQ="APP",DIQ(0)="IE",DIC="^HL(771,",DA=RCVIX,DR=.01
D EN^DIQ1 I '$D(APP) D G ABEND
. W !,"ERROR: Pointed-to receiver entry ("_DA_") missing"
. W !," from HL7 APPLICATION PARAMETER File (#771)."
. Q
S RCVNAME=$G(APP(771,DA,.01,"E"))
;
W !,"Sending application name: "_SNDNAME,!
W "Receiving application name: "_RCVNAME,!
S DIR("A")="Do you wish to change either of these names? ",DIR(0)="YA"
D ^DIR G END:$D(DTOUT),END:$D(DUOUT)
I Y D G END:$D(DTOUT),END:$D(Y)
. W !!,"Please enter the name of the SENDING application."
. S DIE="^HL(771,",DA=SNDIX,DR=.01 D ^DIE Q:$D(DTOUT) Q:$D(Y)
. W !,"Please enter the name of the RECEIVING application."
. S DIE="^HL(771,",DA=RCVIX,DR=.01 D ^DIE Q:$D(DTOUT) Q:$D(Y)
. Q
;
; Look up the logical link
S DIC="^HLCS(870,",X="MAG CPACS",DIC(0)="X"
D ^DIC I Y<0 D G ABEND
. W !,"ERROR: HL7 logical link missing."
. Q
D G END:$D(DTOUT),END:$D(Y) ; update link information
. S LINKIX=+Y
. W !!,"Please enter the TCP/IP address and port number for the logical link."
. S DIE="^HLCS(870,",DA=LINKIX,DR="400.01;400.02" D ^DIE Q:$D(DTOUT) Q:$D(Y)
. Q
;
; Toggle the interface
W !!,"Enter Y or YES below to turn the IHE-based HL7 PACS interface ON;",!
W "enter N or NO to turn the interface OFF.",!
S DIE="^MAG(2006.1," ; P156 DAC - Removed hardcoded reference to the 1st entry
S DA=$O(^MAG(2006.1,"B",DUZ(2),""))
S DR=3.01 D ^DIE Q:$D(DTOUT) Q:$D(Y)
G END
;
ABEND ;
W !,"PACS HL7 messaging must be installed before using this option."
W !,"Please contact Imaging Support for further assistance."
END ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAG7UCFG 4664 printed Apr 09, 2024@21:09:13 Page 2
MAG7UCFG ;WOIFO/MLH,DAC - Configure HL7 PACS interface ; 16 NOV 2014 4:29 PM
+1 ;;3.0;IMAGING;**49,156**;Mar 19, 2002;Build 10;Nov 16, 2014
+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 QUIT
+18 ;
CONFIG ; MAIN ENTRY POINT - Configure the HL7 PACS interface
+1 ; Allow user to specify sender and receiver names, and to toggle
+2 ; the interface between active/inactive.
+3 ;
+4 ; Called by Option MAG CONFIGURE IHE PACS HL7 I/F.
+5 ;
+6 ; -- FileMan work variables
NEW DA,DIC,DIE,DIQ,DR,DTOUT,DUOUT
+7 ; ------ work array for DIQ application lookups
NEW APP
+8 ; ---- IEN of the sending application
NEW SNDIX
+9 ; -- name of the sending application
NEW SNDNAME
+10 ; ---- IEN of the receiving application
NEW RCVIX
+11 ; -- name of the receiving application
NEW RCVNAME
+12 ; --- IEN of the logical link
NEW LINKIX
+13 ;
+14 WRITE !!,"HL7 PACS Interface Configuration",!!
+15 ;
+16 ; Look up the sending application
+17 SET DIC="^ORD(101,"
SET X="MAG CPACS A01"
SET DIC(0)="X"
+18 DO ^DIC
IF Y<0
Begin DoDot:1
+19 WRITE !,"ERROR: HL7 messaging event driver protocol(s) missing."
+20 QUIT
End DoDot:1
GOTO ABEND
+21 KILL APP
SET DIQ="APP"
SET DIQ(0)="I"
SET DIC="^ORD(101,"
SET DA=$PIECE(Y,U,1)
SET DR=770.1
+22 DO EN^DIQ1
SET SNDIX=$GET(APP(101,DA,770.1,"I"))
+23 IF SNDIX'>0
Begin DoDot:1
+24 WRITE !,"ERROR: No sending application defined."
+25 QUIT
End DoDot:1
GOTO ABEND
+26 ; Look up sender name directly in application file - this allows
+27 ; us to catch a missing pointer
+28 KILL APP
SET DIQ="APP"
SET DIQ(0)="IE"
SET DIC="^HL(771,"
SET DA=SNDIX
SET DR=.01
+29 DO EN^DIQ1
IF '$DATA(APP)
Begin DoDot:1
+30 WRITE !,"ERROR: Pointed-to sender entry ("_DA_") missing"
+31 WRITE !," from HL7 APPLICATION PARAMETER File (#771)."
+32 QUIT
End DoDot:1
GOTO ABEND
+33 SET SNDNAME=$GET(APP(771,DA,.01,"E"))
+34 ;
+35 ; Look up the receiving application
+36 SET DIC="^ORD(101,"
SET X="MAG CPACS A01 SUBS"
SET DIC(0)="X"
+37 DO ^DIC
IF Y<0
Begin DoDot:1
+38 WRITE !,"ERROR: HL7 messaging subscriber protocol(s) missing."
+39 QUIT
End DoDot:1
GOTO ABEND
+40 KILL APP
SET DIQ="APP"
SET DIQ(0)="I"
SET DIC="^ORD(101,"
SET DA=$PIECE(Y,U,1)
SET DR=770.2
+41 DO EN^DIQ1
SET RCVIX=$GET(APP(101,DA,770.2,"I"))
+42 IF RCVIX'>0
Begin DoDot:1
+43 WRITE !,"ERROR: No receiving application defined."
+44 QUIT
End DoDot:1
GOTO ABEND
+45 ; Look up receiver name directly in application file - this allows
+46 ; us to catch a missing pointer
+47 KILL APP
SET DIQ="APP"
SET DIQ(0)="IE"
SET DIC="^HL(771,"
SET DA=RCVIX
SET DR=.01
+48 DO EN^DIQ1
IF '$DATA(APP)
Begin DoDot:1
+49 WRITE !,"ERROR: Pointed-to receiver entry ("_DA_") missing"
+50 WRITE !," from HL7 APPLICATION PARAMETER File (#771)."
+51 QUIT
End DoDot:1
GOTO ABEND
+52 SET RCVNAME=$GET(APP(771,DA,.01,"E"))
+53 ;
+54 WRITE !,"Sending application name: "_SNDNAME,!
+55 WRITE "Receiving application name: "_RCVNAME,!
+56 SET DIR("A")="Do you wish to change either of these names? "
SET DIR(0)="YA"
+57 DO ^DIR
if $DATA(DTOUT)
GOTO END
if $DATA(DUOUT)
GOTO END
+58 IF Y
Begin DoDot:1
+59 WRITE !!,"Please enter the name of the SENDING application."
+60 SET DIE="^HL(771,"
SET DA=SNDIX
SET DR=.01
DO ^DIE
if $DATA(DTOUT)
QUIT
if $DATA(Y)
QUIT
+61 WRITE !,"Please enter the name of the RECEIVING application."
+62 SET DIE="^HL(771,"
SET DA=RCVIX
SET DR=.01
DO ^DIE
if $DATA(DTOUT)
QUIT
if $DATA(Y)
QUIT
+63 QUIT
End DoDot:1
if $DATA(DTOUT)
GOTO END
if $DATA(Y)
GOTO END
+64 ;
+65 ; Look up the logical link
+66 SET DIC="^HLCS(870,"
SET X="MAG CPACS"
SET DIC(0)="X"
+67 DO ^DIC
IF Y<0
Begin DoDot:1
+68 WRITE !,"ERROR: HL7 logical link missing."
+69 QUIT
End DoDot:1
GOTO ABEND
+70 ; update link information
Begin DoDot:1
+71 SET LINKIX=+Y
+72 WRITE !!,"Please enter the TCP/IP address and port number for the logical link."
+73 SET DIE="^HLCS(870,"
SET DA=LINKIX
SET DR="400.01;400.02"
DO ^DIE
if $DATA(DTOUT)
QUIT
if $DATA(Y)
QUIT
+74 QUIT
End DoDot:1
if $DATA(DTOUT)
GOTO END
if $DATA(Y)
GOTO END
+75 ;
+76 ; Toggle the interface
+77 WRITE !!,"Enter Y or YES below to turn the IHE-based HL7 PACS interface ON;",!
+78 WRITE "enter N or NO to turn the interface OFF.",!
+79 ; P156 DAC - Removed hardcoded reference to the 1st entry
SET DIE="^MAG(2006.1,"
+80 SET DA=$ORDER(^MAG(2006.1,"B",DUZ(2),""))
+81 SET DR=3.01
DO ^DIE
if $DATA(DTOUT)
QUIT
if $DATA(Y)
QUIT
+82 GOTO END
+83 ;
ABEND ;
+1 WRITE !,"PACS HL7 messaging must be installed before using this option."
+2 WRITE !,"Please contact Imaging Support for further assistance."
END ;
+1 QUIT
