MAGDSTAF ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Sep 17, 2020@13:11:24
;;3.0;IMAGING;**231**;5-May-2007;Build 9
;; 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
;
; Fourth Step - Get missing images from PACS.
;
; VistA appears to be missing one or more images. Get them from the PACS
;
; Perform the following steps to get the missing images from the PACS:
; a. Issue a PACS Study Root Series Level query (C-FIND) using the Study
; Instance UID (0020,000D) as the key. Request the following return
; data attributes:
; i. Series Instance UID (0020,000E)
; ii. Number of Series Related Instances (0020,1209)
;
; b. For each Series Instance UID, if the number of Series Related Instances
; (0020,1209) is greater than the number of SOP Instances for that series
; on VistA, do the following steps:
; i. Use the Study Instance UID and Series Instance UID to issue a
; PACS Study Root Image Level query (C-FIND) to obtain the list
; of SOP Instance UIDs (0008,0018) for the series.
; ii. Compare the SOP Instance UIDs (0008,0018) from the PACS against
; those on VistA. Make a list of missing SOP Instances.
; iii. Use the Study Instance UID (0020,000D), Series Instance UID
; (0020,000E), and the list of missing SOP Instances (0008,0018) to
; issue a Study Root Image Level retrieve (C-MOVE) to copy the missing
; SOP Instances from the PACS to VistA.
;
;
; Note: PACS STUDYUID and VISTA STUDYUID are both multiples, since PACS and VistA
; may have more than on Study UID per study.
; GETIMAGE is called for each PACSSERIESUID for the study.
;
GETIMAGE(PACSSERIESUID) ; retrieve one series of "PACS ONLY" SOP Instances
N PACSSTUDYUID
D QRSTATUS^MAGDSTAA("Getting SOP Instance UIDs for a series")
;
; get each PACSSTUDYUID from the multiple and process it
;
S PACSSTUDYUID=""
S PACSSTUDYUID=$O(^TMP("MAG",$J,"UIDS","PACS SERIES UID",PACSSERIESUID,"STUDY UID","")) Q:PACSSTUDYUID="" D
. D STUDYUID(PACSSTUDYUID,PACSSERIESUID)
. Q
Q
;
STUDYUID(PACSSTUDYUID,PACSSERIESUID) ; process one PACS Study Instance UID
N I,SOPUID
;
; get the list of sop instances for the series and compare against VistA
D GETSOPU(PACSSTUDYUID,PACSSERIESUID)
D QRSTATUS^MAGDSTAA("Comparing SOP Instance UIDs for the series")
D UIDCOMP(PACSSTUDYUID,PACSSERIESUID)
;
; retrieve the missing "PACS ONLY" images
;
K ^TMP("MAG",$J,"Q/R QUERY")
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=PACSSTUDYUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=PACSSERIESUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="IMAGE"
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
S I=10000,SOPUID=""
F S SOPUID=$O(^TMP("MAG",$J,"UIDS","PACS ONLY",PACSSTUDYUID,PACSSERIESUID,SOPUID)) Q:SOPUID="" D
. S I=I+1,^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID("_$E(I,2,5)_")")=SOPUID
. Q
S I=I-10000 ; remove numeric offset
I I>1 D
. D QRSTATUS^MAGDSTAA("Retrieving "_(I)_" images for one series")
. Q
E D
. D QRSTATUS^MAGDSTAA("Retrieving one image for one series")
. Q
D STTINC^MAGDSTAA("PACS SERIES LEVEL RETRIEVES",1)
D STTINC^MAGDSTAA("PACS IMAGES RETRIEVED",(I))
D SOPUIDR^MAGDSTV1 ; C-MOVE
Q
;
GETSOPU(PACSSTUDYUID,PACSSERIESUID) ; query for the SOP Instance UIDs for the series
N COUNT,I,SOPUID
K ^TMP("MAG",$J,"Q/R QUERY")
K ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID)
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=PACSSTUDYUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=PACSSERIESUID
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
S ^TMP("MAG",$J,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
D SOPUIDQ^MAGDSTV1 ; C-FIND
S COUNT=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",1,1,1))
F I=1:1:COUNT D
. S SOPUID=$G(^XTMP(MAGXTMP,HOSTNAME,$J,QRSTACK,"IMAGE",1,1,1,I,"SOPUID"),"*")
. S ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID,SOPUID)=""
. Q
S ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID,0)=COUNT
Q
;
UIDCOMP(PACSSTUDYUID,PACSSERIESUID) ;
; Compare the UIDs between those on PACS with those on VistA
; Return a count of UIDs on both as well as lists of missing ones
;
; Note that both PACS and VistA may have multiple Study Instance UIDs
; and that they may be different.
;
; Input: ^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID,SERIESUID,SOPUID)=""
; ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,SERIESUID,SOPUID)=""
;
; Output: BOTH - count of identical UIDs on both VistA and PACS
; ^TMP("MAG",$J,"UIDS","PACS ONLY",PACSSTUDYUID,SERIESUID,SOPUID)=""
; ^TMP("MAG",$J,"UIDS","VISTA ONLY",VISTASTUDYUID,SERIESUID,SOPUID)=""
; ^TMP("MAG",$J,"UIDS","COUNTS","BOTH")
; ^TMP("MAG",$J,"UIDS","COUNTS","PACS")
; ^TMP("MAG",$J,"UIDS","COUNTS","PACS ONLY")
; ^TMP("MAG",$J,"UIDS","COUNTS","VISTA")
; ^TMP("MAG",$J,"UIDS","COUNTS","VISTA ONLY")
;
N BOTH,COUNT,MISSINGUIDS,PACSUIDS,VISTAUIDS,VISTASTUDYUID
K ^TMP("MAG",$J,"UIDS","COUNTS"),^("PACS ONLY"),^("VISTA ONLY")
;
; build lists of SOP Instance UIDs (PACSSTUDYUID is a scalar)
S ^TMP("MAG",$J,"UIDS","COUNTS","PACS")=$$UIDLIST("PACS",PACSSTUDYUID,PACSSERIESUID,.PACSUIDS)
;
; get each VISTASTUDYUID from the multiple and process it
;
S ^TMP("MAG",$J,"UIDS","COUNTS","VISTA")=0,VISTASTUDYUID=""
F S VISTASTUDYUID=$O(^TMP("MAG",$J,"UIDS","VISTA SERIES UID",PACSSERIESUID,"STUDY UID",VISTASTUDYUID)) Q:VISTASTUDYUID="" D
. S COUNT=$$UIDLIST("VISTA",VISTASTUDYUID,PACSSERIESUID,.VISTAUIDS)
. S ^TMP("MAG",$J,"UIDS","COUNTS","VISTA")=^TMP("MAG",$J,"UIDS","COUNTS","VISTA")+COUNT
. Q
;
; compare PACS UIDs against VistA UIDs
D SUBTRACT(.PACSUIDS,.VISTAUIDS,.MISSINGUIDS,.MISSING,.BOTH)
S ^TMP("MAG",$J,"UIDS","COUNTS","BOTH")=BOTH
S ^TMP("MAG",$J,"UIDS","COUNTS","PACS ONLY")=MISSING
M ^TMP("MAG",$J,"UIDS","PACS ONLY",PACSSTUDYUID)=MISSINGUIDS
;
; don't need to compare VistA UIDs against PACS UIDs
Q
;
UIDLIST(SYSTEM,STUDYUID,SERIESUID,ARRAY) ; get an array of Series and SOP Instance UIDs
N COUNT,SOPUID
S COUNT=0 ; SOP Instance UID count
;
; build the array of SOP Instance UIDs and get count
S SOPUID=0 ; skip count
F S SOPUID=$O(^TMP("MAG",$J,"UIDS",SYSTEM,STUDYUID,SERIESUID,SOPUID)) Q:SOPUID="" D
. S ARRAY(SERIESUID,SOPUID)=""
. S COUNT=COUNT+1
. Q
Q COUNT
;
SUBTRACT(A,B,C,MISSING,SAME) ; UID set subtraction
; A, B, and C are arrays of Series and SOP Instance UIDs
; C = all the nodes of A minus the nodes of B
N SS1,SS2
K C S (MISSING,SAME)=0
M C=A
S SS1=0
F S SS1=$O(A(SS1)) Q:SS1="" D
. S SS2=0
. F S SS2=$O(A(SS1,SS2)) Q:SS2="" D
. . I $D(B(SS1,SS2)) D ; same node in B and A (now C)
. . . K C(SS1,SS2) ; remove B's node from C
. . . S SAME=SAME+1 ; count of same nodes
. . . Q
. . E D ; node in B is missing in A (now C)
. . . S MISSING=MISSING+1
. . . Q
. . Q
. Q
Q
;
TEST1 ; test of SUBTRACT subroutine
; N A,B,C,MISSING,SAME
S A(1,1)="1,1"
S A(2,1)="2,1"
S B(1,1)="ONE,ONE"
S B(2,2)="TWO,TWO"
D SUBTRACT(.A,.B,.C,.MISSING,.SAME)
W !,"Same=",SAME," Missing=",MISSING," This should be C(2,1)=""2,1"""
D TEST1A
D SUBTRACT(.B,.A,.C,.MISSING,.SAME)
W !!,"Same=",SAME," Missing=",MISSING," This should be C(2,2)=""TWO,TWO"""
D TEST1A
Q
;
TEST1A ; output
N SS1,SS2
S SS1=""
F S SS1=$O(C(SS1)) Q:SS1="" D
. S SS2=""
. F S SS2=$O(C(SS1,SS2)) Q:SS2="" D
. . W !,"C(",SS1,",",SS2,")=""",C(SS1,SS2),""""
. . Q
. Q
Q
;
TEST2 ; test of UIDCOMP subroutine
N I,PACSSTUDYUID,VISTASTUDYUID
S PACSSTUDYUID="PACS STUDY UID",VISTASTUDYUID="VISTA STUDY UID"
K ^TMP("MAG",$J,"UIDS")
F I=1:1:5 S ^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID,"A",$C(65+I))=""
F I=4:1:9 S ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,"A",$C(65+I))=""
F I=4:1:9 S ^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID,"B",$C(75+I))=""
F I=1:1:5 S ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,"B",$C(75+I))=""
D UIDCOMP(PACSSTUDYUID,VISTASTUDYUID,"A")
W !!,"Numbers should be 2, 6, 4, 5, and 3"
D TEST2A("A")
D UIDCOMP(PACSSTUDYUID,VISTASTUDYUID,"B")
W !!,"Numbers should be 2, 5, 3, 6, and 4"
D TEST2A("B")
Q
;
TEST2A(SERIESUID) ; report
W !,"Series UID: """,SERIESUID,""""
F A="BOTH","PACS","PACS ONLY","VISTA","VISTA ONLY" D
. W !,$J(A,10),": ",^TMP("MAG",$J,"UIDS","COUNTS",A)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDSTAF 9797 printed Dec 13, 2024@02:01:51 Page 2
MAGDSTAF ;WOIFO/PMK - Q/R Retrieve of DICOM images from PACS to VistA ; Sep 17, 2020@13:11:24
+1 ;;3.0;IMAGING;**231**;5-May-2007;Build 9
+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 ; Fourth Step - Get missing images from PACS.
+20 ;
+21 ; VistA appears to be missing one or more images. Get them from the PACS
+22 ;
+23 ; Perform the following steps to get the missing images from the PACS:
+24 ; a. Issue a PACS Study Root Series Level query (C-FIND) using the Study
+25 ; Instance UID (0020,000D) as the key. Request the following return
+26 ; data attributes:
+27 ; i. Series Instance UID (0020,000E)
+28 ; ii. Number of Series Related Instances (0020,1209)
+29 ;
+30 ; b. For each Series Instance UID, if the number of Series Related Instances
+31 ; (0020,1209) is greater than the number of SOP Instances for that series
+32 ; on VistA, do the following steps:
+33 ; i. Use the Study Instance UID and Series Instance UID to issue a
+34 ; PACS Study Root Image Level query (C-FIND) to obtain the list
+35 ; of SOP Instance UIDs (0008,0018) for the series.
+36 ; ii. Compare the SOP Instance UIDs (0008,0018) from the PACS against
+37 ; those on VistA. Make a list of missing SOP Instances.
+38 ; iii. Use the Study Instance UID (0020,000D), Series Instance UID
+39 ; (0020,000E), and the list of missing SOP Instances (0008,0018) to
+40 ; issue a Study Root Image Level retrieve (C-MOVE) to copy the missing
+41 ; SOP Instances from the PACS to VistA.
+42 ;
+43 ;
+44 ; Note: PACS STUDYUID and VISTA STUDYUID are both multiples, since PACS and VistA
+45 ; may have more than on Study UID per study.
+46 ; GETIMAGE is called for each PACSSERIESUID for the study.
+47 ;
GETIMAGE(PACSSERIESUID) ; retrieve one series of "PACS ONLY" SOP Instances
+1 NEW PACSSTUDYUID
+2 DO QRSTATUS^MAGDSTAA("Getting SOP Instance UIDs for a series")
+3 ;
+4 ; get each PACSSTUDYUID from the multiple and process it
+5 ;
+6 SET PACSSTUDYUID=""
+7 SET PACSSTUDYUID=$ORDER(^TMP("MAG",$JOB,"UIDS","PACS SERIES UID",PACSSERIESUID,"STUDY UID",""))
if PACSSTUDYUID=""
QUIT
Begin DoDot:1
+8 DO STUDYUID(PACSSTUDYUID,PACSSERIESUID)
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
STUDYUID(PACSSTUDYUID,PACSSERIESUID) ; process one PACS Study Instance UID
+1 NEW I,SOPUID
+2 ;
+3 ; get the list of sop instances for the series and compare against VistA
+4 DO GETSOPU(PACSSTUDYUID,PACSSERIESUID)
+5 DO QRSTATUS^MAGDSTAA("Comparing SOP Instance UIDs for the series")
+6 DO UIDCOMP(PACSSTUDYUID,PACSSERIESUID)
+7 ;
+8 ; retrieve the missing "PACS ONLY" images
+9 ;
+10 KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+11 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=PACSSTUDYUID
+12 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=PACSSERIESUID
+13 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
+14 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"RETRIEVE LEVEL")="IMAGE"
+15 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
+16 SET I=10000
SET SOPUID=""
+17 FOR
SET SOPUID=$ORDER(^TMP("MAG",$JOB,"UIDS","PACS ONLY",PACSSTUDYUID,PACSSERIESUID,SOPUID))
if SOPUID=""
QUIT
Begin DoDot:1
+18 SET I=I+1
SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SOP INSTANCE UID("_$EXTRACT(I,2,5)_")")=SOPUID
+19 QUIT
End DoDot:1
+20 ; remove numeric offset
SET I=I-10000
+21 IF I>1
Begin DoDot:1
+22 DO QRSTATUS^MAGDSTAA("Retrieving "_(I)_" images for one series")
+23 QUIT
End DoDot:1
+24 IF '$TEST
Begin DoDot:1
+25 DO QRSTATUS^MAGDSTAA("Retrieving one image for one series")
+26 QUIT
End DoDot:1
+27 DO STTINC^MAGDSTAA("PACS SERIES LEVEL RETRIEVES",1)
+28 DO STTINC^MAGDSTAA("PACS IMAGES RETRIEVED",(I))
+29 ; C-MOVE
DO SOPUIDR^MAGDSTV1
+30 QUIT
+31 ;
GETSOPU(PACSSTUDYUID,PACSSERIESUID) ; query for the SOP Instance UIDs for the series
+1 NEW COUNT,I,SOPUID
+2 KILL ^TMP("MAG",$JOB,"Q/R QUERY")
+3 KILL ^TMP("MAG",$JOB,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID)
+4 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"STUDY INSTANCE UID(0001)")=PACSSTUDYUID
+5 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"SERIES INSTANCE UID(0001)")=PACSSERIESUID
+6 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY USER APPLICATION")=$$QRSCP^MAGDSTA8
+7 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"QUERY LEVEL")="IMAGE"
+8 SET ^TMP("MAG",$JOB,"Q/R QUERY",QRSTACK,"ROOT")="STUDY"
+9 ; C-FIND
DO SOPUIDQ^MAGDSTV1
+10 SET COUNT=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"IMAGE",1,1,1))
+11 FOR I=1:1:COUNT
Begin DoDot:1
+12 SET SOPUID=$GET(^XTMP(MAGXTMP,HOSTNAME,$JOB,QRSTACK,"IMAGE",1,1,1,I,"SOPUID"),"*")
+13 SET ^TMP("MAG",$JOB,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID,SOPUID)=""
+14 QUIT
End DoDot:1
+15 SET ^TMP("MAG",$JOB,"UIDS","PACS",PACSSTUDYUID,PACSSERIESUID,0)=COUNT
+16 QUIT
+17 ;
UIDCOMP(PACSSTUDYUID,PACSSERIESUID) ;
+1 ; Compare the UIDs between those on PACS with those on VistA
+2 ; Return a count of UIDs on both as well as lists of missing ones
+3 ;
+4 ; Note that both PACS and VistA may have multiple Study Instance UIDs
+5 ; and that they may be different.
+6 ;
+7 ; Input: ^TMP("MAG",$J,"UIDS","VISTA",VISTASTUDYUID,SERIESUID,SOPUID)=""
+8 ; ^TMP("MAG",$J,"UIDS","PACS",PACSSTUDYUID,SERIESUID,SOPUID)=""
+9 ;
+10 ; Output: BOTH - count of identical UIDs on both VistA and PACS
+11 ; ^TMP("MAG",$J,"UIDS","PACS ONLY",PACSSTUDYUID,SERIESUID,SOPUID)=""
+12 ; ^TMP("MAG",$J,"UIDS","VISTA ONLY",VISTASTUDYUID,SERIESUID,SOPUID)=""
+13 ; ^TMP("MAG",$J,"UIDS","COUNTS","BOTH")
+14 ; ^TMP("MAG",$J,"UIDS","COUNTS","PACS")
+15 ; ^TMP("MAG",$J,"UIDS","COUNTS","PACS ONLY")
+16 ; ^TMP("MAG",$J,"UIDS","COUNTS","VISTA")
+17 ; ^TMP("MAG",$J,"UIDS","COUNTS","VISTA ONLY")
+18 ;
+19 NEW BOTH,COUNT,MISSINGUIDS,PACSUIDS,VISTAUIDS,VISTASTUDYUID
+20 KILL ^TMP("MAG",$JOB,"UIDS","COUNTS"),^("PACS ONLY"),^("VISTA ONLY")
+21 ;
+22 ; build lists of SOP Instance UIDs (PACSSTUDYUID is a scalar)
+23 SET ^TMP("MAG",$JOB,"UIDS","COUNTS","PACS")=$$UIDLIST("PACS",PACSSTUDYUID,PACSSERIESUID,.PACSUIDS)
+24 ;
+25 ; get each VISTASTUDYUID from the multiple and process it
+26 ;
+27 SET ^TMP("MAG",$JOB,"UIDS","COUNTS","VISTA")=0
SET VISTASTUDYUID=""
+28 FOR
SET VISTASTUDYUID=$ORDER(^TMP("MAG",$JOB,"UIDS","VISTA SERIES UID",PACSSERIESUID,"STUDY UID",VISTASTUDYUID))
if VISTASTUDYUID=""
QUIT
Begin DoDot:1
+29 SET COUNT=$$UIDLIST("VISTA",VISTASTUDYUID,PACSSERIESUID,.VISTAUIDS)
+30 SET ^TMP("MAG",$JOB,"UIDS","COUNTS","VISTA")=^TMP("MAG",$JOB,"UIDS","COUNTS","VISTA")+COUNT
+31 QUIT
End DoDot:1
+32 ;
+33 ; compare PACS UIDs against VistA UIDs
+34 DO SUBTRACT(.PACSUIDS,.VISTAUIDS,.MISSINGUIDS,.MISSING,.BOTH)
+35 SET ^TMP("MAG",$JOB,"UIDS","COUNTS","BOTH")=BOTH
+36 SET ^TMP("MAG",$JOB,"UIDS","COUNTS","PACS ONLY")=MISSING
+37 MERGE ^TMP("MAG",$JOB,"UIDS","PACS ONLY",PACSSTUDYUID)=MISSINGUIDS
+38 ;
+39 ; don't need to compare VistA UIDs against PACS UIDs
+40 QUIT
+41 ;
UIDLIST(SYSTEM,STUDYUID,SERIESUID,ARRAY) ; get an array of Series and SOP Instance UIDs
+1 NEW COUNT,SOPUID
+2 ; SOP Instance UID count
SET COUNT=0
+3 ;
+4 ; build the array of SOP Instance UIDs and get count
+5 ; skip count
SET SOPUID=0
+6 FOR
SET SOPUID=$ORDER(^TMP("MAG",$JOB,"UIDS",SYSTEM,STUDYUID,SERIESUID,SOPUID))
if SOPUID=""
QUIT
Begin DoDot:1
+7 SET ARRAY(SERIESUID,SOPUID)=""
+8 SET COUNT=COUNT+1
+9 QUIT
End DoDot:1
+10 QUIT COUNT
+11 ;
SUBTRACT(A,B,C,MISSING,SAME) ; UID set subtraction
+1 ; A, B, and C are arrays of Series and SOP Instance UIDs
+2 ; C = all the nodes of A minus the nodes of B
+3 NEW SS1,SS2
+4 KILL C
SET (MISSING,SAME)=0
+5 MERGE C=A
+6 SET SS1=0
+7 FOR
SET SS1=$ORDER(A(SS1))
if SS1=""
QUIT
Begin DoDot:1
+8 SET SS2=0
+9 FOR
SET SS2=$ORDER(A(SS1,SS2))
if SS2=""
QUIT
Begin DoDot:2
+10 ; same node in B and A (now C)
IF $DATA(B(SS1,SS2))
Begin DoDot:3
+11 ; remove B's node from C
KILL C(SS1,SS2)
+12 ; count of same nodes
SET SAME=SAME+1
+13 QUIT
End DoDot:3
+14 ; node in B is missing in A (now C)
IF '$TEST
Begin DoDot:3
+15 SET MISSING=MISSING+1
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
TEST1 ; test of SUBTRACT subroutine
+1 ; N A,B,C,MISSING,SAME
+2 SET A(1,1)="1,1"
+3 SET A(2,1)="2,1"
+4 SET B(1,1)="ONE,ONE"
+5 SET B(2,2)="TWO,TWO"
+6 DO SUBTRACT(.A,.B,.C,.MISSING,.SAME)
+7 WRITE !,"Same=",SAME," Missing=",MISSING," This should be C(2,1)=""2,1"""
+8 DO TEST1A
+9 DO SUBTRACT(.B,.A,.C,.MISSING,.SAME)
+10 WRITE !!,"Same=",SAME," Missing=",MISSING," This should be C(2,2)=""TWO,TWO"""
+11 DO TEST1A
+12 QUIT
+13 ;
TEST1A ; output
+1 NEW SS1,SS2
+2 SET SS1=""
+3 FOR
SET SS1=$ORDER(C(SS1))
if SS1=""
QUIT
Begin DoDot:1
+4 SET SS2=""
+5 FOR
SET SS2=$ORDER(C(SS1,SS2))
if SS2=""
QUIT
Begin DoDot:2
+6 WRITE !,"C(",SS1,",",SS2,")=""",C(SS1,SS2),""""
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
TEST2 ; test of UIDCOMP subroutine
+1 NEW I,PACSSTUDYUID,VISTASTUDYUID
+2 SET PACSSTUDYUID="PACS STUDY UID"
SET VISTASTUDYUID="VISTA STUDY UID"
+3 KILL ^TMP("MAG",$JOB,"UIDS")
+4 FOR I=1:1:5
SET ^TMP("MAG",$JOB,"UIDS","VISTA",VISTASTUDYUID,"A",$CHAR(65+I))=""
+5 FOR I=4:1:9
SET ^TMP("MAG",$JOB,"UIDS","PACS",PACSSTUDYUID,"A",$CHAR(65+I))=""
+6 FOR I=4:1:9
SET ^TMP("MAG",$JOB,"UIDS","VISTA",VISTASTUDYUID,"B",$CHAR(75+I))=""
+7 FOR I=1:1:5
SET ^TMP("MAG",$JOB,"UIDS","PACS",PACSSTUDYUID,"B",$CHAR(75+I))=""
+8 DO UIDCOMP(PACSSTUDYUID,VISTASTUDYUID,"A")
+9 WRITE !!,"Numbers should be 2, 6, 4, 5, and 3"
+10 DO TEST2A("A")
+11 DO UIDCOMP(PACSSTUDYUID,VISTASTUDYUID,"B")
+12 WRITE !!,"Numbers should be 2, 5, 3, 6, and 4"
+13 DO TEST2A("B")
+14 QUIT
+15 ;
TEST2A(SERIESUID) ; report
+1 WRITE !,"Series UID: """,SERIESUID,""""
+2 FOR A="BOTH","PACS","PACS ONLY","VISTA","VISTA ONLY"
Begin DoDot:1
+3 WRITE !,$JUSTIFY(A,10),": ",^TMP("MAG",$JOB,"UIDS","COUNTS",A)
+4 QUIT
End DoDot:1
+5 QUIT
