MAGDIR83 ;WOIFO/PMK - Read a DICOM image file ; 06/06/2005 09:20
;;3.0;IMAGING;**11,30,51,54**;03-July-2009;;Build 1424
;; 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. |
;; +---------------------------------------------------------------+
;;
;
; M2MB server
;
; This routine is invoked by the ^MAGDIR8 to update handle DICOM
; CORRECT functions, that is, the "CORRECT" REQUEST item.
;
; This is a four-step process:
;
; 1) The "QUERY" record is sent, to obtain a list of corrected
; images. The list is sent back to the gateway in a list of
; "CORRECT" RESULT items, each with new patient/study values.
; If the images are to be deleted, the list will contain "DELETE"
; instead of "FIXED" RESULT items.
; 2) The gateway processes each corrected/deleted image, one at a
; time.
; 3) The gateway sends a "PROCESSED | IMAGE" record is sent back to
; the server for each corrected image, so that each can be
; deleted from the list. (This is called an RPC Callback.)
; 4) Finally, the gateway sends a "PROCESSED | STUDY" record back to
; the server to delete the remainder of the study from the list.
;
ENTRY ; update image acquisition statistics
N LOCATION,MACHID,STATUS
S STATUS=$P(ARGS,"|",1)
I STATUS="QUERY" D
. D QUERY
. Q
E I STATUS="PROCESSED" D
. D PROCESS
. Q
Q
;
QUERY ; get the list of DICOM CORRECTED files
N DELFLAG,ICOUNT,IMAGEIEN,INSTNAME,LOCATION,MACHID
N NEW,NEWNAME,NEWPID,NEWACN,NIMAGES,STUDYIEN,STUDYUID
;
S LOCATION=$P(ARGS,"|",2),MACHID=$P(ARGS,"|",3)
S NIMAGES=0,STUDYIEN=""
F S STUDYIEN=$O(^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN)) Q:'STUDYIEN Q:NIMAGES>24 D
. S DELFLAG=^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN)
. S INSTNAME=$P(^MAGD(2006.575,STUDYIEN,"AMFG"),"^",1)
. S STUDYUID=^MAGD(2006.575,STUDYIEN,"ASUID")
. S NEW=^MAGD(2006.575,STUDYIEN,"FIXD")
. S NEWNAME=$P(NEW,"^",3),NEWPID=$P(NEW,"^",4),NEWACN=$P(NEW,"^",5)
. S IMAGEIEN=STUDYIEN ; need to process the first image
. D QUERY1("NONE") ; first time - defer deleting this node
. S ICOUNT=0
. F S ICOUNT=$O(^MAGD(2006.575,STUDYIEN,"RLATE",ICOUNT)) Q:'ICOUNT Q:NIMAGES>24 D
. . S IMAGEIEN=^MAGD(2006.575,STUDYIEN,"RLATE",ICOUNT,0)
. . D QUERY1("IMAGE") ; regular image - delete it
. . S NIMAGES=NIMAGES+1
. . Q
. I 'ICOUNT D ; end of study reached - delete first image & study
. . S IMAGEIEN=STUDYIEN ; need to delete first image and the study
. . D QUERY1("STUDY") ; second time, now delete the study entry
. . Q
. Q
Q
;
QUERY1(DELTYPE) ; build one CORRECT Result PROCESS array node
N FROMPATH,X
S FROMPATH=$P($G(^MAGD(2006.575,IMAGEIEN,0)),"^",1) Q:FROMPATH=""
S X=$S(DELFLAG="D":"DELETE",1:"FIXED")
S X=X_"|"_IMAGEIEN_"|"_STUDYIEN_"|"_DELTYPE_"|"_INSTNAME
S X=X_"|"_FROMPATH_"|"_STUDYUID_"|"_NEWNAME_"|"_NEWPID_"|"_NEWACN
D RESULT^MAGDIR8("CORRECT",X)
Q
;
; ----------------------- RPC CALLBACK ------------------------------
;
PROCESS ; delete the processed corrected entry from the ^MAGD(2006.575) file
N DELTYPE,EXIST,FILEPATH,IMAGEIEN,LOCATION,RLATEIEN,STUDYIEN
S IMAGEIEN=$P(ARGS,"|",2),STUDYIEN=$P(ARGS,"|",3)
S DELTYPE=$P(ARGS,"|",4),FILEPATH=$P(ARGS,"|",6) ; ignore piece #5
I DELTYPE'="NONE" D ; don't delete the first image/study in the list
. L +^MAGD(2006.575,0):1E9 ; Background process MUST wait
. I DELTYPE="IMAGE" D ; delete this image
. . ; remove the related image cross-references
. . S RLATEIEN=$O(^MAGD(2006.575,STUDYIEN,"RLATE","B",IMAGEIEN,""))
. . I RLATEIEN D
. . . K ^MAGD(2006.575,STUDYIEN,"RLATE",RLATEIEN)
. . . K ^MAGD(2006.575,STUDYIEN,"RLATE","B",IMAGEIEN,RLATEIEN)
. . . S $P(^(0),"^",4)=$P(^MAGD(2006.575,STUDYIEN,"RLATE",0),"^",4)-1
. . . Q
. . Q
. E I DELTYPE="STUDY" D ; delete the first image and study information
. . ; remove the "AFX" and "F" cross-references
. . S STUDYUID=$P(ARGS,"|",7),MACHID=$P(ARGS,"|",8)
. . S LOCATION=$P(ARGS,"|",9)
. . K ^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN)
. . K ^MAGD(2006.575,"F",LOCATION,STUDYUID,STUDYIEN)
. . Q
. ; Only subtract 1 from #entries, if we're actually deleting one:
. S EXIST=$D(^MAGD(2006.575,IMAGEIEN))
. K ^MAGD(2006.575,IMAGEIEN)
. K ^MAGD(2006.575,"B",FILEPATH,IMAGEIEN)
. S:EXIST $P(^(0),"^",4)=$P(^MAGD(2006.575,0),"^",4)-1
. L -^MAGD(2006.575,0)
. Q
D RESULT^MAGDIR8("CORRECT","COMPLETE|"_IMAGEIEN_"|"_STUDYIEN_"|"_DELTYPE)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR83 5377 printed Oct 16, 2024@18:01:08 Page 2
MAGDIR83 ;WOIFO/PMK - Read a DICOM image file ; 06/06/2005 09:20
+1 ;;3.0;IMAGING;**11,30,51,54**;03-July-2009;;Build 1424
+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 ;
+18 ; M2MB server
+19 ;
+20 ; This routine is invoked by the ^MAGDIR8 to update handle DICOM
+21 ; CORRECT functions, that is, the "CORRECT" REQUEST item.
+22 ;
+23 ; This is a four-step process:
+24 ;
+25 ; 1) The "QUERY" record is sent, to obtain a list of corrected
+26 ; images. The list is sent back to the gateway in a list of
+27 ; "CORRECT" RESULT items, each with new patient/study values.
+28 ; If the images are to be deleted, the list will contain "DELETE"
+29 ; instead of "FIXED" RESULT items.
+30 ; 2) The gateway processes each corrected/deleted image, one at a
+31 ; time.
+32 ; 3) The gateway sends a "PROCESSED | IMAGE" record is sent back to
+33 ; the server for each corrected image, so that each can be
+34 ; deleted from the list. (This is called an RPC Callback.)
+35 ; 4) Finally, the gateway sends a "PROCESSED | STUDY" record back to
+36 ; the server to delete the remainder of the study from the list.
+37 ;
ENTRY ; update image acquisition statistics
+1 NEW LOCATION,MACHID,STATUS
+2 SET STATUS=$PIECE(ARGS,"|",1)
+3 IF STATUS="QUERY"
Begin DoDot:1
+4 DO QUERY
+5 QUIT
End DoDot:1
+6 IF '$TEST
IF STATUS="PROCESSED"
Begin DoDot:1
+7 DO PROCESS
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
QUERY ; get the list of DICOM CORRECTED files
+1 NEW DELFLAG,ICOUNT,IMAGEIEN,INSTNAME,LOCATION,MACHID
+2 NEW NEW,NEWNAME,NEWPID,NEWACN,NIMAGES,STUDYIEN,STUDYUID
+3 ;
+4 SET LOCATION=$PIECE(ARGS,"|",2)
SET MACHID=$PIECE(ARGS,"|",3)
+5 SET NIMAGES=0
SET STUDYIEN=""
+6 FOR
SET STUDYIEN=$ORDER(^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN))
if 'STUDYIEN
QUIT
if NIMAGES>24
QUIT
Begin DoDot:1
+7 SET DELFLAG=^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN)
+8 SET INSTNAME=$PIECE(^MAGD(2006.575,STUDYIEN,"AMFG"),"^",1)
+9 SET STUDYUID=^MAGD(2006.575,STUDYIEN,"ASUID")
+10 SET NEW=^MAGD(2006.575,STUDYIEN,"FIXD")
+11 SET NEWNAME=$PIECE(NEW,"^",3)
SET NEWPID=$PIECE(NEW,"^",4)
SET NEWACN=$PIECE(NEW,"^",5)
+12 ; need to process the first image
SET IMAGEIEN=STUDYIEN
+13 ; first time - defer deleting this node
DO QUERY1("NONE")
+14 SET ICOUNT=0
+15 FOR
SET ICOUNT=$ORDER(^MAGD(2006.575,STUDYIEN,"RLATE",ICOUNT))
if 'ICOUNT
QUIT
if NIMAGES>24
QUIT
Begin DoDot:2
+16 SET IMAGEIEN=^MAGD(2006.575,STUDYIEN,"RLATE",ICOUNT,0)
+17 ; regular image - delete it
DO QUERY1("IMAGE")
+18 SET NIMAGES=NIMAGES+1
+19 QUIT
End DoDot:2
+20 ; end of study reached - delete first image & study
IF 'ICOUNT
Begin DoDot:2
+21 ; need to delete first image and the study
SET IMAGEIEN=STUDYIEN
+22 ; second time, now delete the study entry
DO QUERY1("STUDY")
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
+25 QUIT
+26 ;
QUERY1(DELTYPE) ; build one CORRECT Result PROCESS array node
+1 NEW FROMPATH,X
+2 SET FROMPATH=$PIECE($GET(^MAGD(2006.575,IMAGEIEN,0)),"^",1)
if FROMPATH=""
QUIT
+3 SET X=$SELECT(DELFLAG="D":"DELETE",1:"FIXED")
+4 SET X=X_"|"_IMAGEIEN_"|"_STUDYIEN_"|"_DELTYPE_"|"_INSTNAME
+5 SET X=X_"|"_FROMPATH_"|"_STUDYUID_"|"_NEWNAME_"|"_NEWPID_"|"_NEWACN
+6 DO RESULT^MAGDIR8("CORRECT",X)
+7 QUIT
+8 ;
+9 ; ----------------------- RPC CALLBACK ------------------------------
+10 ;
PROCESS ; delete the processed corrected entry from the ^MAGD(2006.575) file
+1 NEW DELTYPE,EXIST,FILEPATH,IMAGEIEN,LOCATION,RLATEIEN,STUDYIEN
+2 SET IMAGEIEN=$PIECE(ARGS,"|",2)
SET STUDYIEN=$PIECE(ARGS,"|",3)
+3 ; ignore piece #5
SET DELTYPE=$PIECE(ARGS,"|",4)
SET FILEPATH=$PIECE(ARGS,"|",6)
+4 ; don't delete the first image/study in the list
IF DELTYPE'="NONE"
Begin DoDot:1
+5 ; Background process MUST wait
LOCK +^MAGD(2006.575,0):1E9
+6 ; delete this image
IF DELTYPE="IMAGE"
Begin DoDot:2
+7 ; remove the related image cross-references
+8 SET RLATEIEN=$ORDER(^MAGD(2006.575,STUDYIEN,"RLATE","B",IMAGEIEN,""))
+9 IF RLATEIEN
Begin DoDot:3
+10 KILL ^MAGD(2006.575,STUDYIEN,"RLATE",RLATEIEN)
+11 KILL ^MAGD(2006.575,STUDYIEN,"RLATE","B",IMAGEIEN,RLATEIEN)
+12 SET $PIECE(^(0),"^",4)=$PIECE(^MAGD(2006.575,STUDYIEN,"RLATE",0),"^",4)-1
+13 QUIT
End DoDot:3
+14 QUIT
End DoDot:2
+15 ; delete the first image and study information
IF '$TEST
IF DELTYPE="STUDY"
Begin DoDot:2
+16 ; remove the "AFX" and "F" cross-references
+17 SET STUDYUID=$PIECE(ARGS,"|",7)
SET MACHID=$PIECE(ARGS,"|",8)
+18 SET LOCATION=$PIECE(ARGS,"|",9)
+19 KILL ^MAGD(2006.575,"AFX",LOCATION,MACHID,STUDYIEN)
+20 KILL ^MAGD(2006.575,"F",LOCATION,STUDYUID,STUDYIEN)
+21 QUIT
End DoDot:2
+22 ; Only subtract 1 from #entries, if we're actually deleting one:
+23 SET EXIST=$DATA(^MAGD(2006.575,IMAGEIEN))
+24 KILL ^MAGD(2006.575,IMAGEIEN)
+25 KILL ^MAGD(2006.575,"B",FILEPATH,IMAGEIEN)
+26 if EXIST
SET $PIECE(^(0),"^",4)=$PIECE(^MAGD(2006.575,0),"^",4)-1
+27 LOCK -^MAGD(2006.575,0)
+28 QUIT
End DoDot:1
+29 DO RESULT^MAGDIR8("CORRECT","COMPLETE|"_IMAGEIEN_"|"_STUDYIEN_"|"_DELTYPE)
+30 QUIT
