MAGVRS51 ;WOIFO/DAC/JSL/NST - Utilities for RPC calls for DICOM file processing ; 7 Jun 2012 2:43 PM
;;3.0;IMAGING;**118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; 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() ; Name value separator for output data ie. NAME|TESTPATIENT
Q "|"
MULTISEP() ; Name value separator for multiple option values ie. READ|1`WRITE|1`DELETE|0
Q "="
STATSEP() ; Status and Result separator ie. -3``No record IEN
Q "`"
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
Q "`"
DCRCTSET(OUT,ATTS) ; Set DICOM Correct data into file 2006.575
N FDA,ERR,IENS,STUDYUID,IEN,FIELDERR
S IENS="+1,"
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
D SETFDA^MAGVRS44(2006.575,.ATTS,IENS,.FDA,.FIELDERR)
S FILEPATH=$G(FDA(2006.575,"+1,",.01))
I FILEPATH="" S OUT="-1"_SSEP_"No FILEPATH identified" Q
I $D(^MAGD(2006.575,"B",FILEPATH)) S OUT="-4"_SSEP_"Non-unique FILEPATH" Q
S STUDYUID=$G(FDA(2006.575,"+1,",9)) S LOCATION=$G(FDA(2006.575,"+1,",36))
K FDA(2006.575,"+1,",9),FDA(2006.575,"+1,",36)
D UPDATE^DIE("","FDA","","ERR")
S IEN=$O(^MAGD(2006.575,"B",FILEPATH,"")) ; New Record IEN
S OUT="0"_SSEP_$G(FIELDERR)_SSEP_IEN ; Set return ouput to IEN of new record
K FDA
I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-2"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
K ERR
;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
S FDA(2006.575,IEN_",",9)=1
D FILE^DIE("","FDA","ERR")
K FDA,ERR
I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-3"_SSEP_"Related record:"_$G(ERR("DIERR",1,"TEXT",1))
;
;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
S FDA(2006.575,IEN_",",36)=LOCATION
D FILE^DIE("","FDA","ERR")
I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-3"_SSEP_"Related record:"_$G(ERR("DIERR",1,"TEXT",1))
K FDA,ERR
;
;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
S FDA(2006.575,IEN_",",9)=STUDYUID
D FILE^DIE("","FDA","ERR")
K FDA,ERR
I $D(ERR("DIERR",1,"TEXT",1)) S OUT="-3"_SSEP_"Related record:"_$G(ERR("DIERR",1,"TEXT",1))
;
Q
DCRCTGET(OUT,MACHID) ; Get DICOM Correct data from file 2006.575
; Return record data for all fixed and deleted images of machine ID provided
N IEN,J,RIEN,DOB,DFN,ICN,SEX,VADM,PATLOOK,SERVTYPE,CASENUMB,NEWCASE
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP,J=2,IEN=0,OUT(1)="0"_SSEP_SSEP
F S IEN=$O(^MAGD(2006.575,IEN)) Q:+IEN=0 D
. ; Return deleted records
. I ($P($G(^MAGD(2006.575,IEN,0)),U,6)=1)&(MACHID=$P($G(^MAGD(2006.575,IEN,1)),U,4)) D Q
. . S OUT(J)="FILEPATH"_OSEP_$P($G(^MAGD(2006.575,IEN,0)),U,1)_SSEP,J=J+1
. . S OUT(J)="DELETE FLAG"_OSEP_1_SSEP,J=J+1
. . Q
. I (+$G(^MAGD(2006.575,IEN,"FIXD"))'=1)!(MACHID'=$P($G(^MAGD(2006.575,IEN,1)),U,4)) Q ; Loop through all DICOM failed images
. D REFRESH(.OUT,IEN,.J)
. D REFRESHF(.OUT,IEN,.J)
. S RIEN=""
. I $D(^MAGD(2006.575,IEN,"RLATE")) D ; RLATE - Related images loop
. . F S RIEN=$O(^MAGD(2006.575,IEN,"RLATE","B",RIEN)) Q:RIEN="" D
. . . D REFRESH(.OUT,RIEN,.J)
. . . D REFRESHF(.OUT,IEN,.J)
. . . Q
. . Q
. ; Look up patient DFN and retrieve DOB, Sex, ICN.
. S SERVTYPE=$$GET1^DIQ(2006.575,IEN,"SERVICE TYPE","E"),CASENUMB=$$GET1^DIQ(2006.575,IEN,"CASE NUMB","E"),NEWCASE=$$GET1^DIQ(2006.575,IEN,"NEWCASE NO","E")
. I NEWCASE'="" S CASENUMB=NEWCASE
. I (SERVTYPE="")!(CASENUMB="") Q
. S PATLOOK=$$LOOKUP^MAGVORDR(CASENUMB,SERVTYPE)
. I +PATLOOK=-1 Q
. S DFN=$P(PATLOOK,"~",2)
. D DEM^VADPT ; Supported IA (#10061)
. S OUT(J)="DFN"_OSEP_DFN_SSEP,J=J+1
. S DOB=+$$FM2IDF^MAGVAF01(+($G(VADM(3))))
. S SEX=$E($G(VADM(5)))
. S ICN=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI") ; Supported IA (#2701)
. S OUT(J)="DATE OF BIRTH"_OSEP_DOB_SSEP,J=J+1
. S OUT(J)="SEX"_OSEP_SEX_SSEP,J=J+1
. S OUT(J)="INTEGRATION CONTROL NUMBER"_OSEP_ICN_SSEP,J=J+1
. Q
Q
DCRCTCNT(OUT,MACHID,SERVTYPE) ; Get count of entries with provided machine id and service type from file 2006.575
N IEN,J,ISEP,SSEP
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP,J=0,IEN=0
I MACHID="" S OUT="-1"_SSEP_"No machine ID provided" Q
I SERVTYPE="" S OUT="-1"_SSEP_"No service type provided" Q
F S IEN=$O(^MAGD(2006.575,IEN)) Q:+IEN=0 D
. I (MACHID=$P($G(^MAGD(2006.575,IEN,1)),U,4))&(SERVTYPE=$$GET1^DIQ(2006.575,IEN,"SERVICE TYPE","E")) S J=J+1 ; Loop through all unfixed images
S OUT="0"_SSEP_SSEP_J
Q
DCRCTDEL(OUT,FILEPATH) ; DICOM Correct delete entry
N IEN,LOCATION,OSEP
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
I $G(FILEPATH)="" S OUT="-1"_SSEP_"No Filepath provided" Q
S IEN=$O(^MAGD(2006.575,"B",FILEPATH,""))
I IEN="" Q
S FDA(2006.575,IEN_",",.01)="@"
D UPDATE^DIE("","FDA",IEN,"ERR")
I $D(ERR("DIERR")) S OUT="-2"_SSEP_$G(ERR("DIERR",1,"TEXT",1))
I $G(OUT)="" S OUT="0"_SSEP_SSEP
Q
REFRESH(OUT,IEN,OUTI) ; Retrieve specified file data attributes
N FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
N MULTOUT,FDA,VALUE
S OSEP=$$OUTSEP,SSEP=$$STATSEP,FILE=2006.575,FIELD=""
F FIELD="FILEPATH","GATEWAY LOCATION","IMAGE UID","STUDY UID","SERVICE TYPE" D
. I FIELD["IEN" S FORMAT="I" ; If the field is an IEN pointer return the internal format rather than the UID string
. S VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
. S OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
. S OUTI=OUTI+1
. Q
Q
REFRESHF(OUT,IEN,OUTI) ; Retrieve specified file data attributes - Fixed Information
N FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
N MULTOUT,FDA,VALUE
S OUT(OUTI)=""
S OSEP=$$OUTSEP,SSEP=$$STATSEP,FILE=2006.575,FIELD=""
F FIELD="INSTRUMENT NAME","MACHINE ID","NEWNME","NEWSSN","NEWCASE NO","NEW PROC IEN","NEW PROCEDURE" D
. I FIELD["IEN" S FORMAT="I" ; If the field is an IEN pointer return the internal format rather than the UID string
. S VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
. S OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
. S OUTI=OUTI+1
. Q
Q
REFRESHP(OUT,DFN,OUTI) ; Retrieve specified file data attributes - Patient Information
N FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
N MULTOUT,FDA,VALUE
S OSEP=$$OUTSEP,SSEP=$$STATSEP,FILE=2,FIELD=""
F FIELD="DATE OF BIRTH","SEX","INTEGRATION CONTROL NUMBER" D
. I FIELD["IEN" S FORMAT="I" ; If the field is an IEN pointer return the internal format rather than the UID string
. S VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
. S OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
. S OUTI=OUTI+1
. Q
Q
MULTIPLE(FILE,FIELD) ; Process multiple DB entries
N MULTIPLE,FNUM
S FNUM=$$FLDNUM^DILFD(FILE,FIELD)
Q:FNUM="" 0
S MULTIPLE=$$GET1^DID(FILE,FNUM,,"MULTIPLE-VALUED")
Q MULTIPLE
INTRFACE ; Entry for AE INSTANCE and SECURITY MATRIX interface
N Y
S Y=""
W !,"DICOM AE SECURITY MATRIX APPLICATION EDIT"
F Q:$G(Y)=-1 D AEINTR2(.Y)
Q
AEINTR2(Y) ; Edit/Add AE Instance
; Select AE Instance
N NEW,I,D,IEN,DLAYGO,DIE,D0,DA,DIC,DIR,IENS,S,X,DO
S DLAYGO=2006.9192
S DIC="^MAGV(2006.9192,"
S DIC(0)="QEALN"
S DIC("W")="D OUTLINE^MAGVRS51(Y)" ; write a line in the lookup
D ^DIC
I Y=-1 Q
S IEN=$P(Y,U,1) S NEW=$P(Y,U,3)
I NEW=1 D AEINTR3(IEN,NEW)
; If entry was deleted quit
I NEW'=1 D
. S DIC="^MAGV(2006.9192,"
. S DA=IEN
. D EN^DIQ
. K DIC,IENS,S,X
. D AEINTR3(IEN,NEW)
. Q
; Quit if entry was just deleted by user
I '$D(^MAGV(2006.9192,IEN)) K DA Q
S DIE=2006.9192
K DIC
S DA=IEN
S DIC="^MAGV(2006.9192,",DIC(0)="QEAL"
I NEW=1 S DR="12" D ^DIE
I NEW'=1 D
. ;List Services and Roles
. D AEINTR6(IEN,.I)
. S DIR(0)="Y",DIR("B")="NO",DIR("A")="Add/Modify/Delete Services and Roles for this entry"
. D ^DIR K DIR
. W !
. I Y=1 S DR="12" D ^DIE
K DA
Q
AEINTR3(IEN,NEW) ; DICOM AE SECURITY MATRIX User Interface - Allows user to add and edit AE entries
N DIE,DR,DA,FDA,ERR,DIC,FLAGNAME,FLAGVALU,DIR,DLAYGO,D0,SMIEN
S DIE=2006.9192
I Y=-1 Q
I NEW'=1 S DR=".01;1;1.1;1.3;1.4;2;2.1;3;4;6;7;8;9;10;11;13;14"
I NEW=1 S DR="1//VISTA_STORAGE;1.3//NO;1.4//V;2.1;3;4"
S DA=IEN
D ^DIE
K DIC,IENS,S,X
; Quit if entry was just deleted by user
I '$D(DA) Q
I NEW=1 D
. S FDA(2006.9192,DA_",",6)=1
. S FDA(2006.9192,DA_",",7)=1
. S FDA(2006.9192,DA_",",8)=1
. S FDA(2006.9192,DA_",",9)=1
. S FDA(2006.9192,DA_",",10)=1
. S FDA(2006.9192,DA_",",11)="RAD"
. D FILE^DIE("","FDA","SMIEN")
. Q
; Display default flags and default flag values for C-STORE entries
I NEW=1 D
. W !!,"Flag Names",?20,"Flag Values",!
. W "-------------------------------",!
. F J=6:1:11 D
. . S FLAGNAME=$$GET1^DID(2006.9192,J,"","LABEL")
. . S FLAGVALU=$$GET1^DIQ(2006.9192,DA_",",J)
. . W FLAGNAME,?20,FLAGVALU,!
. . Q
. ;Ask the user if they accept the field defaults for the flags names and flag values
. S DIR(0)="Y",DIR("B")="YES",DIR("A")="Accept these defaults"
. D ^DIR K DIR
. I Y'=1 S DR="6;7;8;9;10;11" D ^DIE K DIC,IENS,S,X
. S DR="13;14" D ^DIE K DIC,IENS,S,X
K DA
Q
AEINTR6(SMIEN,I) ; Display DICOM AE SECURITY MATRIX entries for a given AE Instance
N DSRIEN,DSERVICE,DROLE,I
S I=0,DSRIEN=0
W !!
F S DSRIEN=$O(^MAGV(2006.9192,SMIEN,3,DSRIEN)) Q:(DSRIEN="")!(+DSRIEN=0) D
. S I=I+1
. S IENS=DSRIEN_","_SMIEN_","
. S DSERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
. S DROLE=$$GET1^DIQ(2006.919212,IENS,1)
. W $P(I,U,1)_") "_DSERVICE_" "_DROLE,!
. Q
I I=0 W "No DICOM AE SECURITY MATRIX entries for this AE INSTANCE",!
Q
;
OUTLINE(Y) ; Form the output line in the DICOM AE SECURITY MATRIX Lookup
N OUT,I,SUBFILE
I '$D(Y) Q
D GETS^DIQ(2006.9192,Y_",","12*","","OUT")
; Output the data
S I="" ; IENs
S SUBFILE="2006.919212"
F S I=$O(OUT(SUBFILE,I)) Q:I="" D
. W !,?18,$G(OUT(SUBFILE,I,.01)),?28,$G(OUT(SUBFILE,I,1))
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS51 10832 printed Jan 18, 2025@03:11:35 Page 2
MAGVRS51 ;WOIFO/DAC/JSL/NST - Utilities for RPC calls for DICOM file processing ; 7 Jun 2012 2:43 PM
+1 ;;3.0;IMAGING;**118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+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
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
+1 QUIT "|"
MULTISEP() ; Name value separator for multiple option values ie. READ|1`WRITE|1`DELETE|0
+1 QUIT "="
STATSEP() ; Status and Result separator ie. -3``No record IEN
+1 QUIT "`"
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
+1 QUIT "`"
DCRCTSET(OUT,ATTS) ; Set DICOM Correct data into file 2006.575
+1 NEW FDA,ERR,IENS,STUDYUID,IEN,FIELDERR
+2 SET IENS="+1,"
+3 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
+4 DO SETFDA^MAGVRS44(2006.575,.ATTS,IENS,.FDA,.FIELDERR)
+5 SET FILEPATH=$GET(FDA(2006.575,"+1,",.01))
+6 IF FILEPATH=""
SET OUT="-1"_SSEP_"No FILEPATH identified"
QUIT
+7 IF $DATA(^MAGD(2006.575,"B",FILEPATH))
SET OUT="-4"_SSEP_"Non-unique FILEPATH"
QUIT
+8 SET STUDYUID=$GET(FDA(2006.575,"+1,",9))
SET LOCATION=$GET(FDA(2006.575,"+1,",36))
+9 KILL FDA(2006.575,"+1,",9),FDA(2006.575,"+1,",36)
+10 DO UPDATE^DIE("","FDA","","ERR")
+11 ; New Record IEN
SET IEN=$ORDER(^MAGD(2006.575,"B",FILEPATH,""))
+12 ; Set return ouput to IEN of new record
SET OUT="0"_SSEP_$GET(FIELDERR)_SSEP_IEN
+13 KILL FDA
+14 IF $DATA(ERR("DIERR",1,"TEXT",1))
SET OUT="-2"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+15 KILL ERR
+16 ;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
+17 SET FDA(2006.575,IEN_",",9)=1
+18 DO FILE^DIE("","FDA","ERR")
+19 KILL FDA,ERR
+20 IF $DATA(ERR("DIERR",1,"TEXT",1))
SET OUT="-3"_SSEP_"Related record:"_$GET(ERR("DIERR",1,"TEXT",1))
+21 ;
+22 ;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
+23 SET FDA(2006.575,IEN_",",36)=LOCATION
+24 DO FILE^DIE("","FDA","ERR")
+25 IF $DATA(ERR("DIERR",1,"TEXT",1))
SET OUT="-3"_SSEP_"Related record:"_$GET(ERR("DIERR",1,"TEXT",1))
+26 KILL FDA,ERR
+27 ;
+28 ;Must re-file with Study UID after location has been set to create "F" (location & Study UID) x-ref
+29 SET FDA(2006.575,IEN_",",9)=STUDYUID
+30 DO FILE^DIE("","FDA","ERR")
+31 KILL FDA,ERR
+32 IF $DATA(ERR("DIERR",1,"TEXT",1))
SET OUT="-3"_SSEP_"Related record:"_$GET(ERR("DIERR",1,"TEXT",1))
+33 ;
+34 QUIT
DCRCTGET(OUT,MACHID) ; Get DICOM Correct data from file 2006.575
+1 ; Return record data for all fixed and deleted images of machine ID provided
+2 NEW IEN,J,RIEN,DOB,DFN,ICN,SEX,VADM,PATLOOK,SERVTYPE,CASENUMB,NEWCASE
+3 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
SET J=2
SET IEN=0
SET OUT(1)="0"_SSEP_SSEP
+4 FOR
SET IEN=$ORDER(^MAGD(2006.575,IEN))
if +IEN=0
QUIT
Begin DoDot:1
+5 ; Return deleted records
+6 IF ($PIECE($GET(^MAGD(2006.575,IEN,0)),U,6)=1)&(MACHID=$PIECE($GET(^MAGD(2006.575,IEN,1)),U,4))
Begin DoDot:2
+7 SET OUT(J)="FILEPATH"_OSEP_$PIECE($GET(^MAGD(2006.575,IEN,0)),U,1)_SSEP
SET J=J+1
+8 SET OUT(J)="DELETE FLAG"_OSEP_1_SSEP
SET J=J+1
+9 QUIT
End DoDot:2
QUIT
+10 ; Loop through all DICOM failed images
IF (+$GET(^MAGD(2006.575,IEN,"FIXD"))'=1)!(MACHID'=$PIECE($GET(^MAGD(2006.575,IEN,1)),U,4))
QUIT
+11 DO REFRESH(.OUT,IEN,.J)
+12 DO REFRESHF(.OUT,IEN,.J)
+13 SET RIEN=""
+14 ; RLATE - Related images loop
IF $DATA(^MAGD(2006.575,IEN,"RLATE"))
Begin DoDot:2
+15 FOR
SET RIEN=$ORDER(^MAGD(2006.575,IEN,"RLATE","B",RIEN))
if RIEN=""
QUIT
Begin DoDot:3
+16 DO REFRESH(.OUT,RIEN,.J)
+17 DO REFRESHF(.OUT,IEN,.J)
+18 QUIT
End DoDot:3
+19 QUIT
End DoDot:2
+20 ; Look up patient DFN and retrieve DOB, Sex, ICN.
+21 SET SERVTYPE=$$GET1^DIQ(2006.575,IEN,"SERVICE TYPE","E")
SET CASENUMB=$$GET1^DIQ(2006.575,IEN,"CASE NUMB","E")
SET NEWCASE=$$GET1^DIQ(2006.575,IEN,"NEWCASE NO","E")
+22 IF NEWCASE'=""
SET CASENUMB=NEWCASE
+23 IF (SERVTYPE="")!(CASENUMB="")
QUIT
+24 SET PATLOOK=$$LOOKUP^MAGVORDR(CASENUMB,SERVTYPE)
+25 IF +PATLOOK=-1
QUIT
+26 SET DFN=$PIECE(PATLOOK,"~",2)
+27 ; Supported IA (#10061)
DO DEM^VADPT
+28 SET OUT(J)="DFN"_OSEP_DFN_SSEP
SET J=J+1
+29 SET DOB=+$$FM2IDF^MAGVAF01(+($GET(VADM(3))))
+30 SET SEX=$EXTRACT($GET(VADM(5)))
+31 ; Supported IA (#2701)
SET ICN=$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI")
+32 SET OUT(J)="DATE OF BIRTH"_OSEP_DOB_SSEP
SET J=J+1
+33 SET OUT(J)="SEX"_OSEP_SEX_SSEP
SET J=J+1
+34 SET OUT(J)="INTEGRATION CONTROL NUMBER"_OSEP_ICN_SSEP
SET J=J+1
+35 QUIT
End DoDot:1
+36 QUIT
DCRCTCNT(OUT,MACHID,SERVTYPE) ; Get count of entries with provided machine id and service type from file 2006.575
+1 NEW IEN,J,ISEP,SSEP
+2 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
SET J=0
SET IEN=0
+3 IF MACHID=""
SET OUT="-1"_SSEP_"No machine ID provided"
QUIT
+4 IF SERVTYPE=""
SET OUT="-1"_SSEP_"No service type provided"
QUIT
+5 FOR
SET IEN=$ORDER(^MAGD(2006.575,IEN))
if +IEN=0
QUIT
Begin DoDot:1
+6 ; Loop through all unfixed images
IF (MACHID=$PIECE($GET(^MAGD(2006.575,IEN,1)),U,4))&(SERVTYPE=$$GET1^DIQ(2006.575,IEN,"SERVICE TYPE","E"))
SET J=J+1
End DoDot:1
+7 SET OUT="0"_SSEP_SSEP_J
+8 QUIT
DCRCTDEL(OUT,FILEPATH) ; DICOM Correct delete entry
+1 NEW IEN,LOCATION,OSEP
+2 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
+3 IF $GET(FILEPATH)=""
SET OUT="-1"_SSEP_"No Filepath provided"
QUIT
+4 SET IEN=$ORDER(^MAGD(2006.575,"B",FILEPATH,""))
+5 IF IEN=""
QUIT
+6 SET FDA(2006.575,IEN_",",.01)="@"
+7 DO UPDATE^DIE("","FDA",IEN,"ERR")
+8 IF $DATA(ERR("DIERR"))
SET OUT="-2"_SSEP_$GET(ERR("DIERR",1,"TEXT",1))
+9 IF $GET(OUT)=""
SET OUT="0"_SSEP_SSEP
+10 QUIT
REFRESH(OUT,IEN,OUTI) ; Retrieve specified file data attributes
+1 NEW FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
+2 NEW MULTOUT,FDA,VALUE
+3 SET OSEP=$$OUTSEP
SET SSEP=$$STATSEP
SET FILE=2006.575
SET FIELD=""
+4 FOR FIELD="FILEPATH","GATEWAY LOCATION","IMAGE UID","STUDY UID","SERVICE TYPE"
Begin DoDot:1
+5 ; If the field is an IEN pointer return the internal format rather than the UID string
IF FIELD["IEN"
SET FORMAT="I"
+6 SET VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
+7 SET OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
+8 SET OUTI=OUTI+1
+9 QUIT
End DoDot:1
+10 QUIT
REFRESHF(OUT,IEN,OUTI) ; Retrieve specified file data attributes - Fixed Information
+1 NEW FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
+2 NEW MULTOUT,FDA,VALUE
+3 SET OUT(OUTI)=""
+4 SET OSEP=$$OUTSEP
SET SSEP=$$STATSEP
SET FILE=2006.575
SET FIELD=""
+5 FOR FIELD="INSTRUMENT NAME","MACHINE ID","NEWNME","NEWSSN","NEWCASE NO","NEW PROC IEN","NEW PROCEDURE"
Begin DoDot:1
+6 ; If the field is an IEN pointer return the internal format rather than the UID string
IF FIELD["IEN"
SET FORMAT="I"
+7 SET VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
+8 SET OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
+9 SET OUTI=OUTI+1
+10 QUIT
End DoDot:1
+11 QUIT
REFRESHP(OUT,DFN,OUTI) ; Retrieve specified file data attributes - Patient Information
+1 NEW FIELD,MULTOUT,FDA,ERR,OSEP,ISEP,SSEP,MULTIPLE,DATETIME,UIEN,UFILE,FORMAT,FILE
+2 NEW MULTOUT,FDA,VALUE
+3 SET OSEP=$$OUTSEP
SET SSEP=$$STATSEP
SET FILE=2
SET FIELD=""
+4 FOR FIELD="DATE OF BIRTH","SEX","INTEGRATION CONTROL NUMBER"
Begin DoDot:1
+5 ; If the field is an IEN pointer return the internal format rather than the UID string
IF FIELD["IEN"
SET FORMAT="I"
+6 SET VALUE=$$GET1^DIQ(FILE,IEN,FIELD,"E")
+7 SET OUT(OUTI)=FIELD_OSEP_VALUE_SSEP
+8 SET OUTI=OUTI+1
+9 QUIT
End DoDot:1
+10 QUIT
MULTIPLE(FILE,FIELD) ; Process multiple DB entries
+1 NEW MULTIPLE,FNUM
+2 SET FNUM=$$FLDNUM^DILFD(FILE,FIELD)
+3 if FNUM=""
QUIT 0
+4 SET MULTIPLE=$$GET1^DID(FILE,FNUM,,"MULTIPLE-VALUED")
+5 QUIT MULTIPLE
INTRFACE ; Entry for AE INSTANCE and SECURITY MATRIX interface
+1 NEW Y
+2 SET Y=""
+3 WRITE !,"DICOM AE SECURITY MATRIX APPLICATION EDIT"
+4 FOR
if $GET(Y)=-1
QUIT
DO AEINTR2(.Y)
+5 QUIT
AEINTR2(Y) ; Edit/Add AE Instance
+1 ; Select AE Instance
+2 NEW NEW,I,D,IEN,DLAYGO,DIE,D0,DA,DIC,DIR,IENS,S,X,DO
+3 SET DLAYGO=2006.9192
+4 SET DIC="^MAGV(2006.9192,"
+5 SET DIC(0)="QEALN"
+6 ; write a line in the lookup
SET DIC("W")="D OUTLINE^MAGVRS51(Y)"
+7 DO ^DIC
+8 IF Y=-1
QUIT
+9 SET IEN=$PIECE(Y,U,1)
SET NEW=$PIECE(Y,U,3)
+10 IF NEW=1
DO AEINTR3(IEN,NEW)
+11 ; If entry was deleted quit
+12 IF NEW'=1
Begin DoDot:1
+13 SET DIC="^MAGV(2006.9192,"
+14 SET DA=IEN
+15 DO EN^DIQ
+16 KILL DIC,IENS,S,X
+17 DO AEINTR3(IEN,NEW)
+18 QUIT
End DoDot:1
+19 ; Quit if entry was just deleted by user
+20 IF '$DATA(^MAGV(2006.9192,IEN))
KILL DA
QUIT
+21 SET DIE=2006.9192
+22 KILL DIC
+23 SET DA=IEN
+24 SET DIC="^MAGV(2006.9192,"
SET DIC(0)="QEAL"
+25 IF NEW=1
SET DR="12"
DO ^DIE
+26 IF NEW'=1
Begin DoDot:1
+27 ;List Services and Roles
+28 DO AEINTR6(IEN,.I)
+29 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Add/Modify/Delete Services and Roles for this entry"
+30 DO ^DIR
KILL DIR
+31 WRITE !
+32 IF Y=1
SET DR="12"
DO ^DIE
End DoDot:1
+33 KILL DA
+34 QUIT
AEINTR3(IEN,NEW) ; DICOM AE SECURITY MATRIX User Interface - Allows user to add and edit AE entries
+1 NEW DIE,DR,DA,FDA,ERR,DIC,FLAGNAME,FLAGVALU,DIR,DLAYGO,D0,SMIEN
+2 SET DIE=2006.9192
+3 IF Y=-1
QUIT
+4 IF NEW'=1
SET DR=".01;1;1.1;1.3;1.4;2;2.1;3;4;6;7;8;9;10;11;13;14"
+5 IF NEW=1
SET DR="1//VISTA_STORAGE;1.3//NO;1.4//V;2.1;3;4"
+6 SET DA=IEN
+7 DO ^DIE
+8 KILL DIC,IENS,S,X
+9 ; Quit if entry was just deleted by user
+10 IF '$DATA(DA)
QUIT
+11 IF NEW=1
Begin DoDot:1
+12 SET FDA(2006.9192,DA_",",6)=1
+13 SET FDA(2006.9192,DA_",",7)=1
+14 SET FDA(2006.9192,DA_",",8)=1
+15 SET FDA(2006.9192,DA_",",9)=1
+16 SET FDA(2006.9192,DA_",",10)=1
+17 SET FDA(2006.9192,DA_",",11)="RAD"
+18 DO FILE^DIE("","FDA","SMIEN")
+19 QUIT
End DoDot:1
+20 ; Display default flags and default flag values for C-STORE entries
+21 IF NEW=1
Begin DoDot:1
+22 WRITE !!,"Flag Names",?20,"Flag Values",!
+23 WRITE "-------------------------------",!
+24 FOR J=6:1:11
Begin DoDot:2
+25 SET FLAGNAME=$$GET1^DID(2006.9192,J,"","LABEL")
+26 SET FLAGVALU=$$GET1^DIQ(2006.9192,DA_",",J)
+27 WRITE FLAGNAME,?20,FLAGVALU,!
+28 QUIT
End DoDot:2
+29 ;Ask the user if they accept the field defaults for the flags names and flag values
+30 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Accept these defaults"
+31 DO ^DIR
KILL DIR
+32 IF Y'=1
SET DR="6;7;8;9;10;11"
DO ^DIE
KILL DIC,IENS,S,X
+33 SET DR="13;14"
DO ^DIE
KILL DIC,IENS,S,X
End DoDot:1
+34 KILL DA
+35 QUIT
AEINTR6(SMIEN,I) ; Display DICOM AE SECURITY MATRIX entries for a given AE Instance
+1 NEW DSRIEN,DSERVICE,DROLE,I
+2 SET I=0
SET DSRIEN=0
+3 WRITE !!
+4 FOR
SET DSRIEN=$ORDER(^MAGV(2006.9192,SMIEN,3,DSRIEN))
if (DSRIEN="")!(+DSRIEN=0)
QUIT
Begin DoDot:1
+5 SET I=I+1
+6 SET IENS=DSRIEN_","_SMIEN_","
+7 SET DSERVICE=$$GET1^DIQ(2006.919212,IENS,.01)
+8 SET DROLE=$$GET1^DIQ(2006.919212,IENS,1)
+9 WRITE $PIECE(I,U,1)_") "_DSERVICE_" "_DROLE,!
+10 QUIT
End DoDot:1
+11 IF I=0
WRITE "No DICOM AE SECURITY MATRIX entries for this AE INSTANCE",!
+12 QUIT
+13 ;
OUTLINE(Y) ; Form the output line in the DICOM AE SECURITY MATRIX Lookup
+1 NEW OUT,I,SUBFILE
+2 IF '$DATA(Y)
QUIT
+3 DO GETS^DIQ(2006.9192,Y_",","12*","","OUT")
+4 ; Output the data
+5 ; IENs
SET I=""
+6 SET SUBFILE="2006.919212"
+7 FOR
SET I=$ORDER(OUT(SUBFILE,I))
if I=""
QUIT
Begin DoDot:1
+8 WRITE !,?18,$GET(OUT(SUBFILE,I,.01)),?28,$GET(OUT(SUBFILE,I,1))
+9 QUIT
End DoDot:1
+10 QUIT
