MAGVRS52 ;WOIFO/EdM/DAC/NST/JSL - Imaging RPCs ,156for Query/Retrieve ; 30 Jan 2015 3:05 PM
;;3.0;IMAGING;**118,145,138,156**;Mar 19, 2002;Build 10;Jan 3, 2015
;; 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
;
OUTSEP() ; Separator for output data ie. NAME`DOB
Q "`"
MULTISEP() ; Name value separator for multiple values ie. REJECT=1|WARNING=1
Q "|"
SRSEP() ; Service and Role Separator ie. C-Store^SCU^C-Move^SCP
Q "^"
;
AETITLE(OUT,RTITLE,LOCATION) ; MAG DICOM CHECK AE TITLE RPC
; Returns AE Title and Security Matrix information for a given AE Title and Location
N AEIEN,AEINST,MATCH,MSEP,I,LOCIEN,OSEP,STATION,SERVTYPE
I $G(RTITLE)="" S OUT(1)="-1,No AE Title specified" Q
I $G(LOCATION)="" S OUT(1)="-3,No Location specified" Q
S AEIEN=0,MATCH=0,I=1,OSEP="`",MSEP="|",SERVTYPE="^"
; Loop through all entries - match on AE Instance name and Location
F S AEIEN=$O(^MAGV(2006.9192,AEIEN)) Q:(AEIEN="")!(+AEIEN=0) D
. S AEINST=$G(^MAGV(2006.9192,AEIEN,0))
. S LOCIEN=$P(AEINST,U,3)
. Q:LOCIEN=""
. S STATION=$$STA^XUAF4(LOCIEN) ; P145 DAC
. ; Perform case-insensitive DICOM AE Title check
. S AEINST=$$UP^XLFSTR(AEINST) ; IA #10104
. S RTITLE=$$UP^XLFSTR(RTITLE) ; IA #10104
. I (LOCATION=STATION)&(($P(AEINST,U,6))=RTITLE) D ; P145 DAC
. . ; If 1st match write all AE Instance info and Service Role
. . I MATCH=0 D AEINST(.OUT,AEIEN,AEINST,LOCATION) S OUT(1)=OUT(1)_"SERVICE MESSAGE="
. . S I=I+1
. . S MATCH=MATCH+1
. . ; Add Services and Roles to output
. . D AESECMX(.OUT,AEIEN)
. . ;--- Add N-Response Delay (#13) in seconds, N-Response Retries (#14) *79.
. . S OUT(1)=OUT(1)_OSEP_(60*$$GET1^DIQ(2006.9192,AEIEN,13,"I"))
. . S OUT(1)=OUT(1)_OSEP_(1*$$GET1^DIQ(2006.9192,AEIEN,14,"I"))
. . Q
. Q
I MATCH=0 S OUT(1)="-2,No entry for AE Title """_RTITLE_""" at location """_LOCATION_"""."
Q
AEINST(OUT,AEIEN,AEINST,LOCATION) ; Retrieve AE Instance information
N AENAME,AETITLE,FLAGDATA,IP,LABEL,PORT,OSEP,MSEP,MULTOUT,SUBIEN,SUBFILE,FIELD,FLAG,FORCER,ORIGIX,VALUE
I $G(AEIEN)="" S OUT(1)="-4,DICOM AE Security Matrix IEN not defined" Q
I $G(AEINST)="" S OUT(1)="-5,AE Instance data not defined" Q
I $G(LOCATION)="" S OUT(1)="-6,LOCATION not defined" Q
I $G(^MAGV(2006.9192,AEIEN,0))="" S OUT(1)="-7,DICOM AE Security Matrix entry not found" Q
S OSEP=$$OUTSEP,MSEP=$$MULTISEP
S AENAME=$P(AEINST,U,1)
S AETITLE=$P(AEINST,U,2)
S RTITLE=$P(AEINST,U,6)
S IP=$P(AEINST,U,4)
S PORT=$P(AEINST,U,5)
S FORCER=$P(AEINST,U,8)
S ORIGIX=$P(AEINST,U,9)
S OUT(1)="0,"_AENAME_OSEP_RTITLE_OSEP_AETITLE_OSEP_LOCATION_OSEP_IP_OSEP_PORT_OSEP_FORCER_OSEP_ORIGIX_OSEP
S FLAGDATA=$G(^MAGV(2006.9192,AEIEN,2))
S FLAG=""
F FIELD=6:1:11 D
. S LABEL=$$GET1^DID(2006.9192,FIELD,,"LABEL")
. S VALUE=$$GET1^DIQ(2006.9192,AEIEN,FIELD,"I")
. I VALUE'="",FLAG'="" S FLAG=FLAG_MSEP
. I VALUE'="" S FLAG=FLAG_LABEL_"="_VALUE
. Q
I FLAG'="" S OUT(1)=OUT(1)_FLAG
S OUT(1)=OUT(1)_OSEP
Q
AESECMX(OUT,AEIEN) ; Retrieve Security Matrix information
N SERVICE,ROLE,SRSEP,SRIEN,SRDATA,IENS
S SRSEP=$$SRSEP
I $G(AEIEN)="" S OUT(1)="-4,DICOM AE Security Matrix IEN not defined" Q
I $G(^MAGV(2006.9192,AEIEN,0))="" S OUT(1)="-7,DICOM AE Security Matrix entry not found" Q
S SRIEN=0
F S SRIEN=$O(^MAGV(2006.9192,AEIEN,3,SRIEN)) Q:(SRIEN="")!(+SRIEN=0) D
. S IENS=SRIEN_","_AEIEN_","
. S SERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
. S ROLE=$$GET1^DIQ(2006.919212,IENS,1)
. S SRDATA=$G(SRDATA)_SERVICE_SRSEP_ROLE_SRSEP
. Q
S OUT(1)=OUT(1)_$G(SRDATA)
Q
VATITLE(OUT,SERVICE,ROLE,LOCATION) ; RPC = MAG DICOM VISTA AE TITLE
; The RPC will return the first AE Title with matching provided service, role, and location fields
N DROLE,DSERVICE,IEN,DSRIEN,DSR,AEDATA,OSEP
S OSEP=$$OUTSEP,IEN=0,OUT=""
I $G(LOCATION)="" S OUT="-2"_OSEP_"No LOCATION provided." Q
I $G(SERVICE)="" S OUT="-2"_OSEP_"No SERVICE provided." Q
I $G(ROLE)="" S OUT="-2"_OSEP_"No ROLE provided." Q
F S IEN=$O(^MAGV(2006.9192,IEN)) Q:(+IEN=0)!(IEN="")!(OUT'="") D
. S AEDATA=$G(^MAGV(2006.9192,IEN,0))
. I LOCATION'=$P(AEDATA,U,3) Q
. S DSRIEN=0
. F S DSRIEN=$O(^MAGV(2006.9192,IEN,3,DSRIEN)) Q:(+DSRIEN=0)!(DSRIEN="")!(OUT'="") D
. . S IENS=DSRIEN_","_IEN_","
. . S DSERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
. . S DROLE=$$GET1^DIQ(2006.919212,IENS,1)
. . I (SERVICE=DSERVICE)&(ROLE=DROLE) S OUT=0_OSEP_$P(AEDATA,U,6)
. . Q
. Q
S:OUT="" OUT="-1"_OSEP_"No title for """_SERVICE_""", """_ROLE_""" at location """_LOCATION_"""."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS52 5504 printed Dec 13, 2024@02:10:24 Page 2
MAGVRS52 ;WOIFO/EdM/DAC/NST/JSL - Imaging RPCs ,156for Query/Retrieve ; 30 Jan 2015 3:05 PM
+1 ;;3.0;IMAGING;**118,145,138,156**;Mar 19, 2002;Build 10;Jan 3, 2015
+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 ;
OUTSEP() ; Separator for output data ie. NAME`DOB
+1 QUIT "`"
MULTISEP() ; Name value separator for multiple values ie. REJECT=1|WARNING=1
+1 QUIT "|"
SRSEP() ; Service and Role Separator ie. C-Store^SCU^C-Move^SCP
+1 QUIT "^"
+2 ;
AETITLE(OUT,RTITLE,LOCATION) ; MAG DICOM CHECK AE TITLE RPC
+1 ; Returns AE Title and Security Matrix information for a given AE Title and Location
+2 NEW AEIEN,AEINST,MATCH,MSEP,I,LOCIEN,OSEP,STATION,SERVTYPE
+3 IF $GET(RTITLE)=""
SET OUT(1)="-1,No AE Title specified"
QUIT
+4 IF $GET(LOCATION)=""
SET OUT(1)="-3,No Location specified"
QUIT
+5 SET AEIEN=0
SET MATCH=0
SET I=1
SET OSEP="`"
SET MSEP="|"
SET SERVTYPE="^"
+6 ; Loop through all entries - match on AE Instance name and Location
+7 FOR
SET AEIEN=$ORDER(^MAGV(2006.9192,AEIEN))
if (AEIEN="")!(+AEIEN=0)
QUIT
Begin DoDot:1
+8 SET AEINST=$GET(^MAGV(2006.9192,AEIEN,0))
+9 SET LOCIEN=$PIECE(AEINST,U,3)
+10 if LOCIEN=""
QUIT
+11 ; P145 DAC
SET STATION=$$STA^XUAF4(LOCIEN)
+12 ; Perform case-insensitive DICOM AE Title check
+13 ; IA #10104
SET AEINST=$$UP^XLFSTR(AEINST)
+14 ; IA #10104
SET RTITLE=$$UP^XLFSTR(RTITLE)
+15 ; P145 DAC
IF (LOCATION=STATION)&(($PIECE(AEINST,U,6))=RTITLE)
Begin DoDot:2
+16 ; If 1st match write all AE Instance info and Service Role
+17 IF MATCH=0
DO AEINST(.OUT,AEIEN,AEINST,LOCATION)
SET OUT(1)=OUT(1)_"SERVICE MESSAGE="
+18 SET I=I+1
+19 SET MATCH=MATCH+1
+20 ; Add Services and Roles to output
+21 DO AESECMX(.OUT,AEIEN)
+22 ;--- Add N-Response Delay (#13) in seconds, N-Response Retries (#14) *79.
+23 SET OUT(1)=OUT(1)_OSEP_(60*$$GET1^DIQ(2006.9192,AEIEN,13,"I"))
+24 SET OUT(1)=OUT(1)_OSEP_(1*$$GET1^DIQ(2006.9192,AEIEN,14,"I"))
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 IF MATCH=0
SET OUT(1)="-2,No entry for AE Title """_RTITLE_""" at location """_LOCATION_"""."
+28 QUIT
AEINST(OUT,AEIEN,AEINST,LOCATION) ; Retrieve AE Instance information
+1 NEW AENAME,AETITLE,FLAGDATA,IP,LABEL,PORT,OSEP,MSEP,MULTOUT,SUBIEN,SUBFILE,FIELD,FLAG,FORCER,ORIGIX,VALUE
+2 IF $GET(AEIEN)=""
SET OUT(1)="-4,DICOM AE Security Matrix IEN not defined"
QUIT
+3 IF $GET(AEINST)=""
SET OUT(1)="-5,AE Instance data not defined"
QUIT
+4 IF $GET(LOCATION)=""
SET OUT(1)="-6,LOCATION not defined"
QUIT
+5 IF $GET(^MAGV(2006.9192,AEIEN,0))=""
SET OUT(1)="-7,DICOM AE Security Matrix entry not found"
QUIT
+6 SET OSEP=$$OUTSEP
SET MSEP=$$MULTISEP
+7 SET AENAME=$PIECE(AEINST,U,1)
+8 SET AETITLE=$PIECE(AEINST,U,2)
+9 SET RTITLE=$PIECE(AEINST,U,6)
+10 SET IP=$PIECE(AEINST,U,4)
+11 SET PORT=$PIECE(AEINST,U,5)
+12 SET FORCER=$PIECE(AEINST,U,8)
+13 SET ORIGIX=$PIECE(AEINST,U,9)
+14 SET OUT(1)="0,"_AENAME_OSEP_RTITLE_OSEP_AETITLE_OSEP_LOCATION_OSEP_IP_OSEP_PORT_OSEP_FORCER_OSEP_ORIGIX_OSEP
+15 SET FLAGDATA=$GET(^MAGV(2006.9192,AEIEN,2))
+16 SET FLAG=""
+17 FOR FIELD=6:1:11
Begin DoDot:1
+18 SET LABEL=$$GET1^DID(2006.9192,FIELD,,"LABEL")
+19 SET VALUE=$$GET1^DIQ(2006.9192,AEIEN,FIELD,"I")
+20 IF VALUE'=""
IF FLAG'=""
SET FLAG=FLAG_MSEP
+21 IF VALUE'=""
SET FLAG=FLAG_LABEL_"="_VALUE
+22 QUIT
End DoDot:1
+23 IF FLAG'=""
SET OUT(1)=OUT(1)_FLAG
+24 SET OUT(1)=OUT(1)_OSEP
+25 QUIT
AESECMX(OUT,AEIEN) ; Retrieve Security Matrix information
+1 NEW SERVICE,ROLE,SRSEP,SRIEN,SRDATA,IENS
+2 SET SRSEP=$$SRSEP
+3 IF $GET(AEIEN)=""
SET OUT(1)="-4,DICOM AE Security Matrix IEN not defined"
QUIT
+4 IF $GET(^MAGV(2006.9192,AEIEN,0))=""
SET OUT(1)="-7,DICOM AE Security Matrix entry not found"
QUIT
+5 SET SRIEN=0
+6 FOR
SET SRIEN=$ORDER(^MAGV(2006.9192,AEIEN,3,SRIEN))
if (SRIEN="")!(+SRIEN=0)
QUIT
Begin DoDot:1
+7 SET IENS=SRIEN_","_AEIEN_","
+8 SET SERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
+9 SET ROLE=$$GET1^DIQ(2006.919212,IENS,1)
+10 SET SRDATA=$GET(SRDATA)_SERVICE_SRSEP_ROLE_SRSEP
+11 QUIT
End DoDot:1
+12 SET OUT(1)=OUT(1)_$GET(SRDATA)
+13 QUIT
VATITLE(OUT,SERVICE,ROLE,LOCATION) ; RPC = MAG DICOM VISTA AE TITLE
+1 ; The RPC will return the first AE Title with matching provided service, role, and location fields
+2 NEW DROLE,DSERVICE,IEN,DSRIEN,DSR,AEDATA,OSEP
+3 SET OSEP=$$OUTSEP
SET IEN=0
SET OUT=""
+4 IF $GET(LOCATION)=""
SET OUT="-2"_OSEP_"No LOCATION provided."
QUIT
+5 IF $GET(SERVICE)=""
SET OUT="-2"_OSEP_"No SERVICE provided."
QUIT
+6 IF $GET(ROLE)=""
SET OUT="-2"_OSEP_"No ROLE provided."
QUIT
+7 FOR
SET IEN=$ORDER(^MAGV(2006.9192,IEN))
if (+IEN=0)!(IEN="")!(OUT'="")
QUIT
Begin DoDot:1
+8 SET AEDATA=$GET(^MAGV(2006.9192,IEN,0))
+9 IF LOCATION'=$PIECE(AEDATA,U,3)
QUIT
+10 SET DSRIEN=0
+11 FOR
SET DSRIEN=$ORDER(^MAGV(2006.9192,IEN,3,DSRIEN))
if (+DSRIEN=0)!(DSRIEN="")!(OUT'="")
QUIT
Begin DoDot:2
+12 SET IENS=DSRIEN_","_IEN_","
+13 SET DSERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
+14 SET DROLE=$$GET1^DIQ(2006.919212,IENS,1)
+15 IF (SERVICE=DSERVICE)&(ROLE=DROLE)
SET OUT=0_OSEP_$PIECE(AEDATA,U,6)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 if OUT=""
SET OUT="-1"_OSEP_"No title for """_SERVICE_""", """_ROLE_""" at location """_LOCATION_"""."
+19 QUIT
+20 ;
