MAGVRS46 ;WOIFO/DAC,MLH,NST - Utilities for RPC calls for DICOM file processing ; 29 Feb 2012 5:21 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 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
; Called by MAGVRS41
;
;+++++ Add multi-keys to KEYFLD array
; Input Parameters
; ================
;
; FILE - VA FileMan file number ( e.g. 2005.6)
; .ATTNAMS - Array with field names and values
; .KEYFLD - Array with key field and values
;
; Return values
; =============
;
; if error found during execution
; OUT(1) = Negative number ` Error message
; if success
; OUT(1) is not set
;
ADDMKEYS(OUT,FILE,ATTNAMS,KEYFLD) ; Set multi-keys
N FIELD,NAM,VAL
N SSEP
S SSEP=$$STATSEP^MAGVRS41
; Add multi-keys for Patient and Procedure reference
I (FILE=2005.6)!(FILE=2005.61) D
. S FIELD=.01
. F S FIELD=$O(^DD(FILE,FIELD)) Q:(FIELD'>0)!(FIELD'<.05) D Q:$D(OUT(1)) ; Private IA (#5551)
. . S NAM=$$GET1^DID(FILE,FIELD,,"LABEL")
. . I '$D(ATTNAMS(NAM)) S OUT(1)="-61"_SSEP_"Expected attribute "_NAM_" not found" Q
. . S KEYFLD(FIELD)=ATTNAMS(NAM)
. . S KEYFLD(FIELD,"GSL")=$$GET1^DID(FILE,FIELD,,"GLOBAL SUBSCRIPT LOCATION")
. . Q
. Q:$D(OUT(1))
. ; Resolve Creating Entity value
. I '$D(ATTNAMS("CREATING ENTITY")) S OUT(1)="-62"_SSEP_"Expected attribute CREATING ENTITY not found" Q
. D SERVINST^MAGVRS44(ATTNAMS("CREATING ENTITY"),.VAL)
. I VAL'>0 S OUT(1)="-65"_SSEP_"Cannot resolve Creating Entity value: "_ATTNAMS("CREATING ENTITY") Q
. S KEYFLD(.05)=VAL
. S KEYFLD(.05,"GSL")=$$GET1^DID(FILE,.05,,"GLOBAL SUBSCRIPT LOCATION")
. Q
Q
;
;+++++ Find a record by .01 field and key fields
; Input Parameters
; ================
;
; FILE - VA FileMan file number ( e.g. 2005.6)
; UATT - Value to be found in "B" cross-reference
; PIEN - Parent IEN (.e.g. Patient reference is a parent of Procedure reference)
; .KEYFLD - Array with key field and values
;
; Return values
; =============
; If a record is not found it returns zero (0),
; If a record is found it returns IEN of the record
;
MATCH(FILE,UATT,PIEN,KEYFLD) ; Find match by keys
N POS,HIT,IEN,R,I
;
S FILE=+$G(FILE)
S UATT=$G(UATT)
S PIEN=$G(PIEN)
;
I UATT="" Q 0 ; no record found
;
S HIT=0
S IEN=0
F S IEN=$O(^MAGV(FILE,"B",UATT,IEN)) Q:'IEN D Q:HIT
. S R=$G(^MAGV(FILE,IEN,0)) ; The assumption is that all key fields are on "0" subscript
. D:R'=""
. . S HIT=1,I=0
. . F S I=$O(KEYFLD(I)) Q:'I S POS=$P(KEYFLD(I,"GSL"),";",2) I $P(R,"^",POS)'=KEYFLD(I) S HIT=0 Q
. . ; Check the parent for study and series
. . I ((FILE=2005.62)!(FILE=2005.63)) D
. . . I PIEN'=+$G(^MAGV(FILE,IEN,6)) S HIT=0
. . . Q
. . Q
. Q
Q IEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS46 3743 printed Dec 13, 2024@02:10:22 Page 2
MAGVRS46 ;WOIFO/DAC,MLH,NST - Utilities for RPC calls for DICOM file processing ; 29 Feb 2012 5:21 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 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
+18 ; Called by MAGVRS41
+19 ;
+20 ;+++++ Add multi-keys to KEYFLD array
+21 ; Input Parameters
+22 ; ================
+23 ;
+24 ; FILE - VA FileMan file number ( e.g. 2005.6)
+25 ; .ATTNAMS - Array with field names and values
+26 ; .KEYFLD - Array with key field and values
+27 ;
+28 ; Return values
+29 ; =============
+30 ;
+31 ; if error found during execution
+32 ; OUT(1) = Negative number ` Error message
+33 ; if success
+34 ; OUT(1) is not set
+35 ;
ADDMKEYS(OUT,FILE,ATTNAMS,KEYFLD) ; Set multi-keys
+1 NEW FIELD,NAM,VAL
+2 NEW SSEP
+3 SET SSEP=$$STATSEP^MAGVRS41
+4 ; Add multi-keys for Patient and Procedure reference
+5 IF (FILE=2005.6)!(FILE=2005.61)
Begin DoDot:1
+6 SET FIELD=.01
+7 ; Private IA (#5551)
FOR
SET FIELD=$ORDER(^DD(FILE,FIELD))
if (FIELD'>0)!(FIELD'<.05)
QUIT
Begin DoDot:2
+8 SET NAM=$$GET1^DID(FILE,FIELD,,"LABEL")
+9 IF '$DATA(ATTNAMS(NAM))
SET OUT(1)="-61"_SSEP_"Expected attribute "_NAM_" not found"
QUIT
+10 SET KEYFLD(FIELD)=ATTNAMS(NAM)
+11 SET KEYFLD(FIELD,"GSL")=$$GET1^DID(FILE,FIELD,,"GLOBAL SUBSCRIPT LOCATION")
+12 QUIT
End DoDot:2
if $DATA(OUT(1))
QUIT
+13 if $DATA(OUT(1))
QUIT
+14 ; Resolve Creating Entity value
+15 IF '$DATA(ATTNAMS("CREATING ENTITY"))
SET OUT(1)="-62"_SSEP_"Expected attribute CREATING ENTITY not found"
QUIT
+16 DO SERVINST^MAGVRS44(ATTNAMS("CREATING ENTITY"),.VAL)
+17 IF VAL'>0
SET OUT(1)="-65"_SSEP_"Cannot resolve Creating Entity value: "_ATTNAMS("CREATING ENTITY")
QUIT
+18 SET KEYFLD(.05)=VAL
+19 SET KEYFLD(.05,"GSL")=$$GET1^DID(FILE,.05,,"GLOBAL SUBSCRIPT LOCATION")
+20 QUIT
End DoDot:1
+21 QUIT
+22 ;
+23 ;+++++ Find a record by .01 field and key fields
+24 ; Input Parameters
+25 ; ================
+26 ;
+27 ; FILE - VA FileMan file number ( e.g. 2005.6)
+28 ; UATT - Value to be found in "B" cross-reference
+29 ; PIEN - Parent IEN (.e.g. Patient reference is a parent of Procedure reference)
+30 ; .KEYFLD - Array with key field and values
+31 ;
+32 ; Return values
+33 ; =============
+34 ; If a record is not found it returns zero (0),
+35 ; If a record is found it returns IEN of the record
+36 ;
MATCH(FILE,UATT,PIEN,KEYFLD) ; Find match by keys
+1 NEW POS,HIT,IEN,R,I
+2 ;
+3 SET FILE=+$GET(FILE)
+4 SET UATT=$GET(UATT)
+5 SET PIEN=$GET(PIEN)
+6 ;
+7 ; no record found
IF UATT=""
QUIT 0
+8 ;
+9 SET HIT=0
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^MAGV(FILE,"B",UATT,IEN))
if 'IEN
QUIT
Begin DoDot:1
+12 ; The assumption is that all key fields are on "0" subscript
SET R=$GET(^MAGV(FILE,IEN,0))
+13 if R'=""
Begin DoDot:2
+14 SET HIT=1
SET I=0
+15 FOR
SET I=$ORDER(KEYFLD(I))
if 'I
QUIT
SET POS=$PIECE(KEYFLD(I,"GSL"),";",2)
IF $PIECE(R,"^",POS)'=KEYFLD(I)
SET HIT=0
QUIT
+16 ; Check the parent for study and series
+17 IF ((FILE=2005.62)!(FILE=2005.63))
Begin DoDot:3
+18 IF PIEN'=+$GET(^MAGV(FILE,IEN,6))
SET HIT=0
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
if HIT
QUIT
+22 QUIT IEN
