MAGVCQRY ;;WOIFO/MAT - DICOM Storage Commit RPCs ; 19 Jul 2013 5:59 PM
;;3.0;IMAGING;**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
;
; /* Query each serially, < MAG*3.0*34 structure first. Order may
; change if we determine that modalities are able & configured
; to use Storage Commit are stacked heavily in favor of the SOP
; Classes supported by *34.
; */
;
;+++ Process ad hoc queries from MAGVC WI GET for existing work items.
;
MAIN(RETURN,WIIEN) ;
;
N FILE S FILE=2006.941
;
;--- Validate incoming items.
Q:$G(WIIEN)="" -1_"`"_"WORK ITEM IEN Not Provided."
;
Q:('$D(^MAGV(FILE,WIIEN))) -2_"`"_"WORK ITEM IEN Not Found."
;
;--- Process STATUS=RECEIVED; FAILED only? Do not process "IN PROGRESS","SUCCESS".
N SCSTATUS S SCSTATUS=1
;
;--- Lock Work Item.
L +^MAGV(FILE,WIIEN):5 I $T D
. ;
. ;--- Set WI Status to "IN PROGRESS"
. N STATSET S STATSET=$$ZUPD8STS(WIIEN,"IN PROGRESS")
. I +STATSET<0 D
. . ;
. . ;--- Watch locking...
. . Q
. ;--- Loop through items & check archive status.
. N CTITEM S CTITEM=$P(^MAGV(FILE,WIIEN,2,0),U,4)
. N CT
. F CT=1:1:CTITEM D
. . ;
. . N UIDSOP S UIDSOP=$P(^MAGV(FILE,WIIEN,2,CT,0),"~",2)
. . ;--- Query < MAG*3.0*34 structure.
. . N STATUS S STATUS=$$QRYLEGAC^MAGVCQRY(UIDSOP)
. . ;--- Query >= MAG*3.0*34 structure.
. . I 'STATUS S STATUS=$$QRYCURNT^MAGVCQRY(UIDSOP)
. . ;
. . I STATUS D
. . . S $P(^MAGV(FILE,WIIEN,2,CT,0),"~",3,4)="C"
. . . Q
. . E D
. . . S $P(^MAGV(FILE,WIIEN,2,CT,0),"~",3,4)="U~U"
. . . S SCSTATUS=0
. . . Q
. ;--- Set aggregate STATUS and unlock WI.
. N WISTATUS S WISTATUS=$S(SCSTATUS=0:"FAILURE",1:"SUCCESS")
. S RETURN(0)=$$ZUPD8STS(WIIEN,WISTATUS)
. L -^MAGV(FILE,WIIEN)
. Q
;--- Else error nolock.
E D
. S RETURN(0)="-1`Unable to Lock Work Item "_WIIEN
. Q
;--- Return Status [??? No; the re-sent WI handles that] and Reason
Q RETURN(0)
;
;+++++ Query a single MAG*3.0*34 introduced IMAGE SOP INSTANCE.
;
QRYCURNT(UIDSOP) ;
;
N YNCURNT S YNCURNT=0
N SOPUID S SOPUID=UIDSOP
;
;--- Check STATUS (#15) is 'A'ccessible in IMAGE SOP INSTANCE file (#2005.54).
; Returns '0' if 'I'naccessible, IEN in IMAGE SOP INSTANCE file if 'A'ccessible.
N IENIMGSOP S IENIMGSOP=$$QRYSOPIN(SOPUID)
D
. Q:'IENIMGSOP
. ;
. ;--- Return ARTIFACT TOKEN of IMAGE INSTANCE file (#2005.65) for input IEN
. ; of IMAGE SOP INSTANCE file (#2005.54)
. N TKNARTIF S TKNARTIF=$$QRYIMGIN(IENIMGSOP)
. Q:TKNARTIF="" D
. . ;
. . ;--- Return IEN of ARTIFACT INSTANCE file (#2006.918) given ARTIFACT TOKEN
. . N IENARTIF S IENARTIF=$$QRYARTIF(TKNARTIF)
. . Q:'IENARTIF D
. . . ;
. . . ;--- Return ARCHIVE status of STORAGE PROVIDER file (#2006.917) given IENARTIN.
. . . N ARCHSTAT S ARCHSTAT=$$QRYARTIN(IENARTIF)
. . . Q:'ARCHSTAT S YNCURNT=ARCHSTAT
Q YNCURNT
;
;+++ Level 1: Query IMAGE SOP INSTANCE file (#2005.64) for accessibility.
;
; Note: "ORIGINAL [old] SOP INSTANCE UID" is field #1 at 0;2
;
; Note: "ARTIFACT ON FILE" (#12) description says "at least one Object";
; Is there only one object per IMGSOPIN.
;
QRYSOPIN(IMGSOPIN) ;
;
N RETURN S RETURN=0
N IENIMGSOP S IENIMGSOP=$O(^MAGV(2005.64,"B",IMGSOPIN,""))
D
. Q:IENIMGSOP=""
. ;
. ;--- Check STATUS (#40) as "A"ccessible or "I"naccessible.
. Q:$P($G(^MAGV(2005.64,IENIMGSOP,11)),U,1)'="A"
. S RETURN=IENIMGSOP
. Q
Q RETURN
;
;+++ Level 2: Lookup ARTIFACT TOKEN (#.01) via IMAGE INSTANCE file (#2005.65)
;
QRYIMGIN(IENIMGSOP) ;
;
N IENARTIF,TKNARTIF S (IENARTIF,TKNARTIF)=0
D
. ;--- SOP INSTANCE REFERENCE (#11) points to IMAGE SOP INSTANCE (#2005.64)
. N IENIMGIN S IENIMGIN=""
. F S IENIMGIN=$O(^MAGV(2005.65,"C",IENIMGSOP,IENIMGIN)) Q:IENIMGIN="" D
. . ;
. . ;--- Select the object w/ ORIGINAL SOP INSTANCE=1 (not 'derived').
. . S:+$P(^MAGV(2005.65,IENIMGIN,1),U,2) TKNARTIF=$P(^MAGV(2005.65,IENIMGIN,0),U)
. . Q
. Q
Q TKNARTIF
;
;+++ Level 3: Query ARTIFACT file (#2006.916)
;
; POINTED TO BY: ARTIFACT REFERENCE field (#.02) of the IMAGE INSTANCE FILE File (#2005.65)
; ARTIFACT field (#.01) of the ARTIFACT INSTANCE File (#2006.918)
;
; /* Based on the above, can bypass the ARTIFACT file. Else use ARTIFACT TOKEN?
; */
; ARTIFACT field (#.01) of the ARTIFACT RETENTION POLICY File (#2006.921)
; ARTIFACT field (#5 ) of the STORAGE TRANSACTION File (#2006.926)
;
QRYARTIF(TKNARTIF) ;
;
N IENARTIF S IENARTIF=$O(^MAGV(2006.916,"B",TKNARTIF,""))
Q IENARTIF
;
;+++ Level 4: Query ARTIFACT INSTANCE file (#2006.918) for STORAGE PROVIDER
;
QRYARTIN(IENARTIF) ;
;
N FILE S FILE=2006.918
N ARCHSTAT S ARCHSTAT=0
N IENPROVD
D
. N IENARTIN S IENARTIN=""
. F S IENARTIN=$O(^MAGV(FILE,"B",IENARTIF,IENARTIN)) Q:IENARTIN="" Q:ARCHSTAT D
. . ;
. . S IENPROVD=$P(^MAGV(FILE,IENARTIN,0),U,2)
. . I IENPROVD'="" S ARCHSTAT=$$YNSTOPRV(IENPROVD)
. . Q
. Q
Q ARCHSTAT
;
;+++ Level 5: Query STORAGE PROVIDER file (#2006.917)
;
; Note: Depending on number of these, may best array them first.
;
; INPUT: PROVDIEN -- IEN of entry in the STORAGE PROVIDER file (#2006.917)
; OUTPUT: YN -- 1 if ARCHIVE field (#4) is 1 (YES)
; 0 else.
YNSTOPRV(IENPROVD) ;
;
N YN S YN=0
N ARCH S ARCH=$P($G(^MAGV(2006.917,IENPROVD,0)),U,4)
S:ARCH YN=ARCH
Q YN
;
ZUPD8STS(WIIEN,STATUS) ;
N RETURN S RETURN=0
N FDA S FDA(2006.941,WIIEN_",",3)=STATUS
N MAGERR
D FILE^DIE("E","FDA","MAGERR")
;--- Trap UPDATER Error
I $D(MAGERR) S RETURN=-6_"`"_MAGERR("DIERR",1,"TEXT",1)
Q RETURN
;
;+++ Process an object in legacy structure (<MAG*3.0*34).
;
QRYLEGAC(UIDSOP) ;
;
N RETURN S RETURN=0
D
. Q:($D(^MAG(2005,"P",UIDSOP))="")
. ;
. N MAGIEN S MAGIEN=$$WMAGIEN(UIDSOP)
. Q:MAGIEN=""
. ;
. ;--- Check the STATUS (#113) field ... ,D0,100) [8S]
. N VIEWSTAT S VIEWSTAT=$$WMAGSTAT(MAGIEN)
. Q:'VIEWSTAT
. ;
. N NEXTVAR S NEXTVAR=$$WRMVOL(MAGIEN)
. Q:NEXTVAR=""
. ;
. N ISWORM S ISWORM=$$YNWORM(NEXTVAR)
. Q:ISWORM=""
. ;
. S:ISWORM RETURN=1
. Q
Q RETURN
;
; # 60 -- PACS UID ,D0,"PACS") [60F] ... "P" Cross-reference
;
; for a group entry: is (0020,000D), Study Instance UID
; for an image entry: is (0008,0018), SOP Instance UID
;
; #252 -- NEW SOP INSTANCE UID ,D0,"SOP") [2F] ... "P" Cross-reference
;
; the VA's new SOP instance UID for the corrected image.
;
;--- Check the STATUS (#113) field ... ,D0,100) [8S]
;
; By default, all images are viewable. Images w/ no status are viewable.
; Status 12 --> Deleted
;
WMAGSTAT(MAGIEN) ;
N YNMAGST S YNMAGST=$P(^MAG(2005,MAGIEN,100),U,8)
S YNMAGST=$S(0:YNMAGST=12,1:1)
Q YNMAGST
;
;--- Return IMAGE file (#2005) IEN. Caller QUITs if null.
;
WMAGIEN(UIDSOP) ;
N MAGIEN S MAGIEN=$O(^MAG(2005,"P",UIDSOP,""))
Q MAGIEN
;
WRMVOL(MAGIEN) ;
N PTNETLOC S PTNETLOC=$P(^MAG(2005,MAGIEN,0),U,5)
Q PTNETLOC
;
;+++ Is NETWORK LOCATION file (#2005.2) STORAGE TYPE field (#6) "WORM"?
;
YNWORM(IENETLOC) ;
;
N ISWORM S ISWORM=0
N TMP S TMP=$P(^MAG(2005.2,IENETLOC,0),U,7)
S:($E(TMP,1,4)="WORM") ISWORM=1
Q ISWORM
;
; MAGVCQRY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVCQRY 8395 printed Oct 16, 2024@18:10:15 Page 2
MAGVCQRY ;;WOIFO/MAT - DICOM Storage Commit RPCs ; 19 Jul 2013 5:59 PM
+1 ;;3.0;IMAGING;**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
+18 ;
+19 ; /* Query each serially, < MAG*3.0*34 structure first. Order may
+20 ; change if we determine that modalities are able & configured
+21 ; to use Storage Commit are stacked heavily in favor of the SOP
+22 ; Classes supported by *34.
+23 ; */
+24 ;
+25 ;+++ Process ad hoc queries from MAGVC WI GET for existing work items.
+26 ;
MAIN(RETURN,WIIEN) ;
+1 ;
+2 NEW FILE
SET FILE=2006.941
+3 ;
+4 ;--- Validate incoming items.
+5 if $GET(WIIEN)=""
QUIT -1_"`"_"WORK ITEM IEN Not Provided."
+6 ;
+7 if ('$DATA(^MAGV(FILE,WIIEN)))
QUIT -2_"`"_"WORK ITEM IEN Not Found."
+8 ;
+9 ;--- Process STATUS=RECEIVED; FAILED only? Do not process "IN PROGRESS","SUCCESS".
+10 NEW SCSTATUS
SET SCSTATUS=1
+11 ;
+12 ;--- Lock Work Item.
+13 LOCK +^MAGV(FILE,WIIEN):5
IF $TEST
Begin DoDot:1
+14 ;
+15 ;--- Set WI Status to "IN PROGRESS"
+16 NEW STATSET
SET STATSET=$$ZUPD8STS(WIIEN,"IN PROGRESS")
+17 IF +STATSET<0
Begin DoDot:2
+18 ;
+19 ;--- Watch locking...
+20 QUIT
End DoDot:2
+21 ;--- Loop through items & check archive status.
+22 NEW CTITEM
SET CTITEM=$PIECE(^MAGV(FILE,WIIEN,2,0),U,4)
+23 NEW CT
+24 FOR CT=1:1:CTITEM
Begin DoDot:2
+25 ;
+26 NEW UIDSOP
SET UIDSOP=$PIECE(^MAGV(FILE,WIIEN,2,CT,0),"~",2)
+27 ;--- Query < MAG*3.0*34 structure.
+28 NEW STATUS
SET STATUS=$$QRYLEGAC^MAGVCQRY(UIDSOP)
+29 ;--- Query >= MAG*3.0*34 structure.
+30 IF 'STATUS
SET STATUS=$$QRYCURNT^MAGVCQRY(UIDSOP)
+31 ;
+32 IF STATUS
Begin DoDot:3
+33 SET $PIECE(^MAGV(FILE,WIIEN,2,CT,0),"~",3,4)="C"
+34 QUIT
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 SET $PIECE(^MAGV(FILE,WIIEN,2,CT,0),"~",3,4)="U~U"
+37 SET SCSTATUS=0
+38 QUIT
End DoDot:3
End DoDot:2
+39 ;--- Set aggregate STATUS and unlock WI.
+40 NEW WISTATUS
SET WISTATUS=$SELECT(SCSTATUS=0:"FAILURE",1:"SUCCESS")
+41 SET RETURN(0)=$$ZUPD8STS(WIIEN,WISTATUS)
+42 LOCK -^MAGV(FILE,WIIEN)
+43 QUIT
End DoDot:1
+44 ;--- Else error nolock.
+45 IF '$TEST
Begin DoDot:1
+46 SET RETURN(0)="-1`Unable to Lock Work Item "_WIIEN
+47 QUIT
End DoDot:1
+48 ;--- Return Status [??? No; the re-sent WI handles that] and Reason
+49 QUIT RETURN(0)
+50 ;
+51 ;+++++ Query a single MAG*3.0*34 introduced IMAGE SOP INSTANCE.
+52 ;
QRYCURNT(UIDSOP) ;
+1 ;
+2 NEW YNCURNT
SET YNCURNT=0
+3 NEW SOPUID
SET SOPUID=UIDSOP
+4 ;
+5 ;--- Check STATUS (#15) is 'A'ccessible in IMAGE SOP INSTANCE file (#2005.54).
+6 ; Returns '0' if 'I'naccessible, IEN in IMAGE SOP INSTANCE file if 'A'ccessible.
+7 NEW IENIMGSOP
SET IENIMGSOP=$$QRYSOPIN(SOPUID)
+8 Begin DoDot:1
+9 if 'IENIMGSOP
QUIT
+10 ;
+11 ;--- Return ARTIFACT TOKEN of IMAGE INSTANCE file (#2005.65) for input IEN
+12 ; of IMAGE SOP INSTANCE file (#2005.54)
+13 NEW TKNARTIF
SET TKNARTIF=$$QRYIMGIN(IENIMGSOP)
+14 if TKNARTIF=""
QUIT
Begin DoDot:2
+15 ;
+16 ;--- Return IEN of ARTIFACT INSTANCE file (#2006.918) given ARTIFACT TOKEN
+17 NEW IENARTIF
SET IENARTIF=$$QRYARTIF(TKNARTIF)
+18 if 'IENARTIF
QUIT
Begin DoDot:3
+19 ;
+20 ;--- Return ARCHIVE status of STORAGE PROVIDER file (#2006.917) given IENARTIN.
+21 NEW ARCHSTAT
SET ARCHSTAT=$$QRYARTIN(IENARTIF)
+22 if 'ARCHSTAT
QUIT
SET YNCURNT=ARCHSTAT
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT YNCURNT
+24 ;
+25 ;+++ Level 1: Query IMAGE SOP INSTANCE file (#2005.64) for accessibility.
+26 ;
+27 ; Note: "ORIGINAL [old] SOP INSTANCE UID" is field #1 at 0;2
+28 ;
+29 ; Note: "ARTIFACT ON FILE" (#12) description says "at least one Object";
+30 ; Is there only one object per IMGSOPIN.
+31 ;
QRYSOPIN(IMGSOPIN) ;
+1 ;
+2 NEW RETURN
SET RETURN=0
+3 NEW IENIMGSOP
SET IENIMGSOP=$ORDER(^MAGV(2005.64,"B",IMGSOPIN,""))
+4 Begin DoDot:1
+5 if IENIMGSOP=""
QUIT
+6 ;
+7 ;--- Check STATUS (#40) as "A"ccessible or "I"naccessible.
+8 if $PIECE($GET(^MAGV(2005.64,IENIMGSOP,11)),U,1)'="A"
QUIT
+9 SET RETURN=IENIMGSOP
+10 QUIT
End DoDot:1
+11 QUIT RETURN
+12 ;
+13 ;+++ Level 2: Lookup ARTIFACT TOKEN (#.01) via IMAGE INSTANCE file (#2005.65)
+14 ;
QRYIMGIN(IENIMGSOP) ;
+1 ;
+2 NEW IENARTIF,TKNARTIF
SET (IENARTIF,TKNARTIF)=0
+3 Begin DoDot:1
+4 ;--- SOP INSTANCE REFERENCE (#11) points to IMAGE SOP INSTANCE (#2005.64)
+5 NEW IENIMGIN
SET IENIMGIN=""
+6 FOR
SET IENIMGIN=$ORDER(^MAGV(2005.65,"C",IENIMGSOP,IENIMGIN))
if IENIMGIN=""
QUIT
Begin DoDot:2
+7 ;
+8 ;--- Select the object w/ ORIGINAL SOP INSTANCE=1 (not 'derived').
+9 if +$PIECE(^MAGV(2005.65,IENIMGIN,1),U,2)
SET TKNARTIF=$PIECE(^MAGV(2005.65,IENIMGIN,0),U)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT TKNARTIF
+13 ;
+14 ;+++ Level 3: Query ARTIFACT file (#2006.916)
+15 ;
+16 ; POINTED TO BY: ARTIFACT REFERENCE field (#.02) of the IMAGE INSTANCE FILE File (#2005.65)
+17 ; ARTIFACT field (#.01) of the ARTIFACT INSTANCE File (#2006.918)
+18 ;
+19 ; /* Based on the above, can bypass the ARTIFACT file. Else use ARTIFACT TOKEN?
+20 ; */
+21 ; ARTIFACT field (#.01) of the ARTIFACT RETENTION POLICY File (#2006.921)
+22 ; ARTIFACT field (#5 ) of the STORAGE TRANSACTION File (#2006.926)
+23 ;
QRYARTIF(TKNARTIF) ;
+1 ;
+2 NEW IENARTIF
SET IENARTIF=$ORDER(^MAGV(2006.916,"B",TKNARTIF,""))
+3 QUIT IENARTIF
+4 ;
+5 ;+++ Level 4: Query ARTIFACT INSTANCE file (#2006.918) for STORAGE PROVIDER
+6 ;
QRYARTIN(IENARTIF) ;
+1 ;
+2 NEW FILE
SET FILE=2006.918
+3 NEW ARCHSTAT
SET ARCHSTAT=0
+4 NEW IENPROVD
+5 Begin DoDot:1
+6 NEW IENARTIN
SET IENARTIN=""
+7 FOR
SET IENARTIN=$ORDER(^MAGV(FILE,"B",IENARTIF,IENARTIN))
if IENARTIN=""
QUIT
if ARCHSTAT
QUIT
Begin DoDot:2
+8 ;
+9 SET IENPROVD=$PIECE(^MAGV(FILE,IENARTIN,0),U,2)
+10 IF IENPROVD'=""
SET ARCHSTAT=$$YNSTOPRV(IENPROVD)
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT ARCHSTAT
+14 ;
+15 ;+++ Level 5: Query STORAGE PROVIDER file (#2006.917)
+16 ;
+17 ; Note: Depending on number of these, may best array them first.
+18 ;
+19 ; INPUT: PROVDIEN -- IEN of entry in the STORAGE PROVIDER file (#2006.917)
+20 ; OUTPUT: YN -- 1 if ARCHIVE field (#4) is 1 (YES)
+21 ; 0 else.
YNSTOPRV(IENPROVD) ;
+1 ;
+2 NEW YN
SET YN=0
+3 NEW ARCH
SET ARCH=$PIECE($GET(^MAGV(2006.917,IENPROVD,0)),U,4)
+4 if ARCH
SET YN=ARCH
+5 QUIT YN
+6 ;
ZUPD8STS(WIIEN,STATUS) ;
+1 NEW RETURN
SET RETURN=0
+2 NEW FDA
SET FDA(2006.941,WIIEN_",",3)=STATUS
+3 NEW MAGERR
+4 DO FILE^DIE("E","FDA","MAGERR")
+5 ;--- Trap UPDATER Error
+6 IF $DATA(MAGERR)
SET RETURN=-6_"`"_MAGERR("DIERR",1,"TEXT",1)
+7 QUIT RETURN
+8 ;
+9 ;+++ Process an object in legacy structure (<MAG*3.0*34).
+10 ;
QRYLEGAC(UIDSOP) ;
+1 ;
+2 NEW RETURN
SET RETURN=0
+3 Begin DoDot:1
+4 if ($DATA(^MAG(2005,"P",UIDSOP))="")
QUIT
+5 ;
+6 NEW MAGIEN
SET MAGIEN=$$WMAGIEN(UIDSOP)
+7 if MAGIEN=""
QUIT
+8 ;
+9 ;--- Check the STATUS (#113) field ... ,D0,100) [8S]
+10 NEW VIEWSTAT
SET VIEWSTAT=$$WMAGSTAT(MAGIEN)
+11 if 'VIEWSTAT
QUIT
+12 ;
+13 NEW NEXTVAR
SET NEXTVAR=$$WRMVOL(MAGIEN)
+14 if NEXTVAR=""
QUIT
+15 ;
+16 NEW ISWORM
SET ISWORM=$$YNWORM(NEXTVAR)
+17 if ISWORM=""
QUIT
+18 ;
+19 if ISWORM
SET RETURN=1
+20 QUIT
End DoDot:1
+21 QUIT RETURN
+22 ;
+23 ; # 60 -- PACS UID ,D0,"PACS") [60F] ... "P" Cross-reference
+24 ;
+25 ; for a group entry: is (0020,000D), Study Instance UID
+26 ; for an image entry: is (0008,0018), SOP Instance UID
+27 ;
+28 ; #252 -- NEW SOP INSTANCE UID ,D0,"SOP") [2F] ... "P" Cross-reference
+29 ;
+30 ; the VA's new SOP instance UID for the corrected image.
+31 ;
+32 ;--- Check the STATUS (#113) field ... ,D0,100) [8S]
+33 ;
+34 ; By default, all images are viewable. Images w/ no status are viewable.
+35 ; Status 12 --> Deleted
+36 ;
WMAGSTAT(MAGIEN) ;
+1 NEW YNMAGST
SET YNMAGST=$PIECE(^MAG(2005,MAGIEN,100),U,8)
+2 SET YNMAGST=$SELECT(0:YNMAGST=12,1:1)
+3 QUIT YNMAGST
+4 ;
+5 ;--- Return IMAGE file (#2005) IEN. Caller QUITs if null.
+6 ;
WMAGIEN(UIDSOP) ;
+1 NEW MAGIEN
SET MAGIEN=$ORDER(^MAG(2005,"P",UIDSOP,""))
+2 QUIT MAGIEN
+3 ;
WRMVOL(MAGIEN) ;
+1 NEW PTNETLOC
SET PTNETLOC=$PIECE(^MAG(2005,MAGIEN,0),U,5)
+2 QUIT PTNETLOC
+3 ;
+4 ;+++ Is NETWORK LOCATION file (#2005.2) STORAGE TYPE field (#6) "WORM"?
+5 ;
YNWORM(IENETLOC) ;
+1 ;
+2 NEW ISWORM
SET ISWORM=0
+3 NEW TMP
SET TMP=$PIECE(^MAG(2005.2,IENETLOC,0),U,7)
+4 if ($EXTRACT(TMP,1,4)="WORM")
SET ISWORM=1
+5 QUIT ISWORM
+6 ;
+7 ; MAGVCQRY
