MAGVCQRY.m

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 ---MAGVCQRY   8395     printed  Feb 18, 2025@23:36:02                                                                                                                                                                                                    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