MAGROI01 ;WOIFO/FG,JSL - Release Of Information(ROI) RPCS ; 11/13/2014 11:37pm
;;3.0;IMAGING;**138,157**;Mar 19, 2002;Build 16;Nov 13, 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 ;
;
;+++++ GET LIST OF TRANSMIT DESTINATIONS TO QUEUE DICOM IMAGES
; RPC: MAG GET DICOM QUEUE LIST
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; Input Parameters
; ================
; SITE id File #4
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: Total Number of Lines
; ^03: "Record Number"
; ^04: "Service Name"
; ^05: "IP Address"
; ^06: "Port Number"
; ^07: "Gateway Station Number"
;
; MAGRY(i) Description
; ^01: Record Number
; ^02: Service Name
; ^03: IP Address
; ^04: Port Number
; ^05: Gateway Station Number
;
GETDCLST(MAGRY,SITE) ; RPC [MAG GET DICOM QUEUE LIST]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
N FILE,SCREEN,MAGREC,REC,CT,SERVNAME,IPADD,PORTN,LOC
N MAGOUT,MAGERR,MAGPL,LIS,I,TEMP
;
; Get local associated sites
S SITE=$G(SITE)
I (SITE'="")!($$STA^XUAF4(SITE)="")!(SITE'=+SITE) D ; P157 - Accept IEN or STATION NUMBER
. N IEN S IEN=$$IEN^XUAF4(SITE) ; Check if is STATION NUMBER
. S:IEN SITE=IEN ; INSTITUTION IEN
. Q
S:SITE<1 SITE=$S($G(DUZ(2)):DUZ(2),1:+$$SITE^VASITE)
S MAGPL=$$PLACE^MAGBAPI(SITE) ; Get 2006.1 place for DUZ(2)
D GETS^DIQ(2006.1,MAGPL,".04*","I","MAGOUT","MAGERR")
I $D(MAGERR) S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1) Q
; Build list of associated sites
S LIS=","_SITE_","
S I=""
F S I=$O(MAGOUT(2006.12,I)) Q:I="" D
. S LIS=LIS_MAGOUT(2006.12,I,.01,"I")_","
;
; Get list of queues, filter out WorkList queues and non-associated sites
;
S FILE=2006.587
K MAGOUT,MAGERR
S SCREEN="I $$UP^XLFSTR($P(^(0),U,6))=""VISTA_SEND_IMAGE""" ; Filter out WorkList queues
S SCREEN=SCREEN_",(LIS[$P(^(0),U,7))" ; Include only sites in LIS
D LIST^DIC(FILE,"",".01;3;4;7I","","","","","",SCREEN,"","MAGOUT","MAGERR")
I $D(MAGERR) S MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1) Q
S MAGREC=""
F S MAGREC=$O(MAGOUT("DILIST","ID",MAGREC),-1) Q:MAGREC'>0 D
. S LOC=MAGOUT("DILIST","ID",MAGREC,7)
. S LOC=$$STA^XUAF4(LOC) ; Station Number ; Supported IA #2171
. S REC=MAGOUT("DILIST",2,MAGREC) ; Record number in file (#2006.587)
. S SERVNAME=MAGOUT("DILIST","ID",MAGREC,.01) ; Name of queue
. S IPADD=MAGOUT("DILIST","ID",MAGREC,3) ; IP address
. S PORTN=MAGOUT("DILIST","ID",MAGREC,4) ; Port number
. S TEMP(SERVNAME_U_IPADD_U_PORTN_U_LOC)=REC ; Temporary array to sort entries
. Q
;
; Eliminate multiple entries: ignore record number
;
S (CT,I)=0
F S I=$O(TEMP(I)) Q:I="" D
. S CT=CT+1
. S MAGRY(CT)=TEMP(I)_U_I
. Q
S MAGRY(0)="1^"_CT_"^Record Number^Service Name^IP Address^Port Number^Gateway Station Number"
Q ;
;
;+++++ QUEUE IMAGE TO A DESTINATION
; RPC: MAG SEND IMAGE
;
; .MAGRY Reference to a local variable where the results
; are returned to.
;
; MAGIEN IEN of the image(s) to send
;
; QREC Record number of the destination queue (DOS/DICOM)
;
; PRI Priority
;
; TYPE Type of image:
; 1: MS-DOS-Copy
; 2: DICOM_Send
;
; Notes
; =====
;
; The MS-DOS-Copy case is included here for compatibility
;
; Return Values
; =============
;
; If MAGRY(0) 1st '^'-piece is 0, then an error
; occurred during execution of the procedure: 0^0^ ERROR explanation
;
; Otherwise, the output array is as follows:
;
; MAGRY(0) Description
; ^01: 1
; ^02: 0
; ^03: Image <MAGIEN> routed to queue <Queue Name>
;
MAGSEND(MAGRY,MAGIEN,QREC,PRI,TYPE) ; RPC [MAG SEND IMAGE]
K MAGRY
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I '$G(MAGIEN) S MAGRY(0)="0^0^No Image IEN" Q
I $$ISDEL^MAGGI11(MAGIEN) S MAGRY(0)="0^0^Deleted Image" Q
N FILE,QUENAM
S FILE=$S(TYPE=1:2005.2,TYPE=2:2006.587,1:"")
I FILE="" S MAGRY(0)="0^0^Type must be 1 (MS-DOS-Copy) or 2 (DICOM_Send)" Q
S QUENAM=$$GET1^DIQ(FILE,$G(QREC),.01)
I QUENAM="" S MAGRY(0)="0^0^Invalid Queue Record" Q
D SEND^MAGBRTUT(MAGIEN,QREC,PRI,TYPE)
S MAGRY(0)="1^0^Image "_MAGIEN_" routed to queue "_QUENAM
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGROI01 5783 printed Apr 09, 2024@21:01:01 Page 2
MAGROI01 ;WOIFO/FG,JSL - Release Of Information(ROI) RPCS ; 11/13/2014 11:37pm
+1 ;;3.0;IMAGING;**138,157**;Mar 19, 2002;Build 16;Nov 13, 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 ;
+19 ;+++++ GET LIST OF TRANSMIT DESTINATIONS TO QUEUE DICOM IMAGES
+20 ; RPC: MAG GET DICOM QUEUE LIST
+21 ;
+22 ; .MAGRY Reference to a local variable where the results
+23 ; are returned to.
+24 ;
+25 ; Input Parameters
+26 ; ================
+27 ; SITE id File #4
+28 ;
+29 ; Return Values
+30 ; =============
+31 ;
+32 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+33 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+34 ;
+35 ; Otherwise, the output array is as follows:
+36 ;
+37 ; MAGRY(0) Description
+38 ; ^01: 1
+39 ; ^02: Total Number of Lines
+40 ; ^03: "Record Number"
+41 ; ^04: "Service Name"
+42 ; ^05: "IP Address"
+43 ; ^06: "Port Number"
+44 ; ^07: "Gateway Station Number"
+45 ;
+46 ; MAGRY(i) Description
+47 ; ^01: Record Number
+48 ; ^02: Service Name
+49 ; ^03: IP Address
+50 ; ^04: Port Number
+51 ; ^05: Gateway Station Number
+52 ;
GETDCLST(MAGRY,SITE) ; RPC [MAG GET DICOM QUEUE LIST]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 NEW FILE,SCREEN,MAGREC,REC,CT,SERVNAME,IPADD,PORTN,LOC
+4 NEW MAGOUT,MAGERR,MAGPL,LIS,I,TEMP
+5 ;
+6 ; Get local associated sites
+7 SET SITE=$GET(SITE)
+8 ; P157 - Accept IEN or STATION NUMBER
IF (SITE'="")!($$STA^XUAF4(SITE)="")!(SITE'=+SITE)
Begin DoDot:1
+9 ; Check if is STATION NUMBER
NEW IEN
SET IEN=$$IEN^XUAF4(SITE)
+10 ; INSTITUTION IEN
if IEN
SET SITE=IEN
+11 QUIT
End DoDot:1
+12 if SITE<1
SET SITE=$SELECT($GET(DUZ(2)):DUZ(2),1:+$$SITE^VASITE)
+13 ; Get 2006.1 place for DUZ(2)
SET MAGPL=$$PLACE^MAGBAPI(SITE)
+14 DO GETS^DIQ(2006.1,MAGPL,".04*","I","MAGOUT","MAGERR")
+15 IF $DATA(MAGERR)
SET MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
QUIT
+16 ; Build list of associated sites
+17 SET LIS=","_SITE_","
+18 SET I=""
+19 FOR
SET I=$ORDER(MAGOUT(2006.12,I))
if I=""
QUIT
Begin DoDot:1
+20 SET LIS=LIS_MAGOUT(2006.12,I,.01,"I")_","
End DoDot:1
+21 ;
+22 ; Get list of queues, filter out WorkList queues and non-associated sites
+23 ;
+24 SET FILE=2006.587
+25 KILL MAGOUT,MAGERR
+26 ; Filter out WorkList queues
SET SCREEN="I $$UP^XLFSTR($P(^(0),U,6))=""VISTA_SEND_IMAGE"""
+27 ; Include only sites in LIS
SET SCREEN=SCREEN_",(LIS[$P(^(0),U,7))"
+28 DO LIST^DIC(FILE,"",".01;3;4;7I","","","","","",SCREEN,"","MAGOUT","MAGERR")
+29 IF $DATA(MAGERR)
SET MAGRY(0)="0^0^Access Error: "_MAGERR("DIERR",1,"TEXT",1)
QUIT
+30 SET MAGREC=""
+31 FOR
SET MAGREC=$ORDER(MAGOUT("DILIST","ID",MAGREC),-1)
if MAGREC'>0
QUIT
Begin DoDot:1
+32 SET LOC=MAGOUT("DILIST","ID",MAGREC,7)
+33 ; Station Number ; Supported IA #2171
SET LOC=$$STA^XUAF4(LOC)
+34 ; Record number in file (#2006.587)
SET REC=MAGOUT("DILIST",2,MAGREC)
+35 ; Name of queue
SET SERVNAME=MAGOUT("DILIST","ID",MAGREC,.01)
+36 ; IP address
SET IPADD=MAGOUT("DILIST","ID",MAGREC,3)
+37 ; Port number
SET PORTN=MAGOUT("DILIST","ID",MAGREC,4)
+38 ; Temporary array to sort entries
SET TEMP(SERVNAME_U_IPADD_U_PORTN_U_LOC)=REC
+39 QUIT
End DoDot:1
+40 ;
+41 ; Eliminate multiple entries: ignore record number
+42 ;
+43 SET (CT,I)=0
+44 FOR
SET I=$ORDER(TEMP(I))
if I=""
QUIT
Begin DoDot:1
+45 SET CT=CT+1
+46 SET MAGRY(CT)=TEMP(I)_U_I
+47 QUIT
End DoDot:1
+48 SET MAGRY(0)="1^"_CT_"^Record Number^Service Name^IP Address^Port Number^Gateway Station Number"
+49 ;
QUIT
+50 ;
+51 ;+++++ QUEUE IMAGE TO A DESTINATION
+52 ; RPC: MAG SEND IMAGE
+53 ;
+54 ; .MAGRY Reference to a local variable where the results
+55 ; are returned to.
+56 ;
+57 ; MAGIEN IEN of the image(s) to send
+58 ;
+59 ; QREC Record number of the destination queue (DOS/DICOM)
+60 ;
+61 ; PRI Priority
+62 ;
+63 ; TYPE Type of image:
+64 ; 1: MS-DOS-Copy
+65 ; 2: DICOM_Send
+66 ;
+67 ; Notes
+68 ; =====
+69 ;
+70 ; The MS-DOS-Copy case is included here for compatibility
+71 ;
+72 ; Return Values
+73 ; =============
+74 ;
+75 ; If MAGRY(0) 1st '^'-piece is 0, then an error
+76 ; occurred during execution of the procedure: 0^0^ ERROR explanation
+77 ;
+78 ; Otherwise, the output array is as follows:
+79 ;
+80 ; MAGRY(0) Description
+81 ; ^01: 1
+82 ; ^02: 0
+83 ; ^03: Image <MAGIEN> routed to queue <Queue Name>
+84 ;
MAGSEND(MAGRY,MAGIEN,QREC,PRI,TYPE) ; RPC [MAG SEND IMAGE]
+1 KILL MAGRY
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 IF '$GET(MAGIEN)
SET MAGRY(0)="0^0^No Image IEN"
QUIT
+4 IF $$ISDEL^MAGGI11(MAGIEN)
SET MAGRY(0)="0^0^Deleted Image"
QUIT
+5 NEW FILE,QUENAM
+6 SET FILE=$SELECT(TYPE=1:2005.2,TYPE=2:2006.587,1:"")
+7 IF FILE=""
SET MAGRY(0)="0^0^Type must be 1 (MS-DOS-Copy) or 2 (DICOM_Send)"
QUIT
+8 SET QUENAM=$$GET1^DIQ(FILE,$GET(QREC),.01)
+9 IF QUENAM=""
SET MAGRY(0)="0^0^Invalid Queue Record"
QUIT
+10 DO SEND^MAGBRTUT(MAGIEN,QREC,PRI,TYPE)
+11 SET MAGRY(0)="1^0^Image "_MAGIEN_" routed to queue "_QUENAM
+12 ;
QUIT
+13 ;
