| 1 | MAGQBPRG ;WOIOFO/RMP Magnetic Server Purge processes [ 06/29/2001 18:28 ]
|
|---|
| 2 | ;;3.0;IMAGING;**7,3,8,20**;Apr 12, 2006
|
|---|
| 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 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | FILEREF(RESULT,FILEPATH,FNAM,EXT,NETLOC,RADHOLD) ; RPC[MAGQBP FREF]
|
|---|
| 19 | ;VALIDATES THAT THE FILEPATH IS CONSISTENT WITH VISTA MAGFILE REFERENCE
|
|---|
| 20 | ;SET THE SECOND PIECE TO "PACS" IF IT REPRESENTS DICOM
|
|---|
| 21 | ;VALIDATES THAT A JUKEBOX POINTER EXISTS
|
|---|
| 22 | ;RESULT VALUES
|
|---|
| 23 | ;PIECE 1:-3 = FOREIGN FILE, DO NOT PURGE
|
|---|
| 24 | ; -2 = QUEUED FOR JUKEBOX COPY, DO NOT PURGE
|
|---|
| 25 | ; -1 = DO NOT PURGE
|
|---|
| 26 | ; 0 = PURGE('MAG 2005 ENTRY)!('JUKEBOX PTRS & 'EXCEPTIONS)
|
|---|
| 27 | ; 1 = PURGE GIVEN NORMAL DATE CRITERIA (NDC) + CONFIRMED ON JB
|
|---|
| 28 | ; 2 = PURGE GIVEN NDC IF TGA PRESENT
|
|---|
| 29 | ; 3 = PURGE IF FILE IS AT ALTERNATE NETWORK LOCATION SITE
|
|---|
| 30 | ; ELSE PURGE IF AGED & UPDATE FILE REFERENCES
|
|---|
| 31 | ; **4 = (**NA**)AGE PURGE IF ON JUKEBOX, UPDATE FILE REFERENCES
|
|---|
| 32 | ; ELSE UPDATE FILEREFENCES, QUEUE JUKEBOX COPY
|
|---|
| 33 | ; 5 = PURGE IF AT ALTERNATE SITE,QUEUE JUKEBOX IF NOT ON JB
|
|---|
| 34 | ; 6 = PURGE GIVEN NORMAL DATE CRITERIA
|
|---|
| 35 | ;PIECE 2:0 = NONPACS
|
|---|
| 36 | ; :1 = PACS
|
|---|
| 37 | ;PIECE 3: RECORD CATEGORY
|
|---|
| 38 | ; 1 = 'NO 2005 ENTRY
|
|---|
| 39 | ; 2 = RADIOLOGY HOLD
|
|---|
| 40 | ; 3 = NO JUKEBOX/JUKEBOX PTRS
|
|---|
| 41 | ; 4 = JUKEBOX - NO JUKEBOX PTRS (P/EXCEPT)ELSE QUEUE
|
|---|
| 42 | ; 5 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS,PURGE IF CONFIRMED
|
|---|
| 43 | ; 6 = JUKEBOX/JUKEBOX PTRS, WRONG CACHE PTRS PURGE IF AT ALT
|
|---|
| 44 | ; 7 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS, FIX PTRS
|
|---|
| 45 | ; 8 = JUKEBOX/JUKEBOX PTRS, CACHE PTRS, AGE (IF CONFIRMED)
|
|---|
| 46 | ; 9 = RECORD NOT IN THE IMAGE FILE
|
|---|
| 47 | ; 10 = FOREIGN IMAGE FILE
|
|---|
| 48 | ; 11 = NOT AN IMAGE FILE
|
|---|
| 49 | ; 12 = FILE LOCATION NOT VALID
|
|---|
| 50 | ; 13 = DELETE 2005 ENTRY (LAST LOCATION REFERENCED)
|
|---|
| 51 | ; 14 = Duplicate 2005/2005.1 entry
|
|---|
| 52 | ; 15 = Foreign Place
|
|---|
| 53 | ; 16 = Record in Archive file
|
|---|
| 54 | ; 17 = Jukebox offline
|
|---|
| 55 | N FILEXT,IEN,SITEID,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,PACS,RIEN,ZNODE
|
|---|
| 56 | N FILETYPE,CPTR,JBPTR,CPOK,BNODE,ALTPATH,NMSPC,PLACE,RDHOLD
|
|---|
| 57 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 58 | S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
|
|---|
| 59 | S U="^",(MAGFILE2,RESULT)=""
|
|---|
| 60 | S FNAM=$$UPPER^MAGQE4(FNAM)
|
|---|
| 61 | S ^TMP("MAGQ",$J,"PRG","LAST")=FILEPATH_U_FNAM_U_EXT_U_NETLOC_U_RADHOLD
|
|---|
| 62 | I FNAM'?1.5A1.13N1"."1.3E D Q ;LATER ADD EXT VERIFY USING 2005.02
|
|---|
| 63 | . D ELOG(FNAM,FILEPATH) S RESULT="-3^^11" Q ;'IMAGE FILE
|
|---|
| 64 | S SITEID=$$UPPER^MAGQE4($$INIS^MAGQBPG2(PLACE))
|
|---|
| 65 | S NMSPC=$TR($P(FNAM,"."),"0123456789","")
|
|---|
| 66 | S FILEPATH=$$UPPER^MAGQE4(FILEPATH)
|
|---|
| 67 | I SITEID'[NMSPC D ELOG(FNAM,FILEPATH) S RESULT="-3^^10" Q ;FOREIGN FILE
|
|---|
| 68 | S IEN=$O(^MAG(2005,"F",$P(FNAM,"."),""))
|
|---|
| 69 | S:'IEN IEN=$O(^MAG(2005.1,"F",$P(FNAM,"."),""))
|
|---|
| 70 | I 'IEN S RESULT="1^^9^^^"_IEN Q
|
|---|
| 71 | S FTYPE=$$FTYPE(EXT)
|
|---|
| 72 | S JBPTR=$$JBPTR(IEN,FTYPE)
|
|---|
| 73 | ;PURGE UNCONDITIONALLY IF NO 2005 ENTRY
|
|---|
| 74 | I '$D(^MAG(2005,IEN,0)) D Q
|
|---|
| 75 | . I $D(^MAG(2005.1,IEN,0)) D Q
|
|---|
| 76 | . . I ('JBPTR&($P($G(^MAG(2005.2,+$$CWP^MAGBAPI(PLACE),0)),U,6)="1")) D
|
|---|
| 77 | . . . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
|
|---|
| 78 | . . . S RESULT="-2^^9^^^"_IEN
|
|---|
| 79 | . . . Q
|
|---|
| 80 | . . E D
|
|---|
| 81 | . . . I JBPTR S RESULT="5^^16^"_$$JBPATH(FNAM,JBPTR)_U_$$JBPATH(FNAM,JBPTR)_U_IEN
|
|---|
| 82 | . . . E S RESULT="-1^^17"
|
|---|
| 83 | . . . Q
|
|---|
| 84 | . E S RESULT="1^^9^^^"_IEN
|
|---|
| 85 | . Q
|
|---|
| 86 | I PLACE'=$$PLACE^MAGBAPI($P($G(^MAG(2005,IEN,100)),U,3)) D Q
|
|---|
| 87 | . S RESULT="-3^^15" Q ;Foreign Place
|
|---|
| 88 | S ZNODE=^MAG(2005,IEN,0)
|
|---|
| 89 | I $P(ZNODE,U,12)="1" S RESULT="-1^^14" Q ; Duplicate Image/Archive entry
|
|---|
| 90 | S BNODE=$S(FTYPE="BIG":$G(^MAG(2005,IEN,"FBIG")),1:"")
|
|---|
| 91 | ; NEXT PROCESS MAGNETIC PTR~LESS
|
|---|
| 92 | S CPTR=$$CHKCP($S(FTYPE="BIG":BNODE,1:ZNODE),FTYPE)
|
|---|
| 93 | I 'CPTR D Q
|
|---|
| 94 | . D CPUPD(FTYPE,IEN,FILEPATH,FNAM)
|
|---|
| 95 | . I 'JBPTR,$P($G(^MAG(2005.2,+$$CWP^MAGBAPI(PLACE),0)),U,6)="1" D
|
|---|
| 96 | . . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
|
|---|
| 97 | . S RESULT="-1^^7^^"_JBPTR_U_IEN ;$S(JBPTR:JBPTR,1:XX)_U_IEN
|
|---|
| 98 | S CPOK=$S('CPTR:0,1:$$CPOK(FTYPE,.ALTPATH,FILEPATH,IEN))
|
|---|
| 99 | S ALTPATH=ALTPATH_FNAM
|
|---|
| 100 | S PACS=$S($D(^MAG(2005,IEN,"PACS")):1,1:0)
|
|---|
| 101 | I 'CPOK,JBPTR D Q
|
|---|
| 102 | . S RESULT="3^"_PACS_"^6^"_ALTPATH_U_$$JBPATH(FNAM,JBPTR)_U_IEN
|
|---|
| 103 | I 'JBPTR D Q
|
|---|
| 104 | . I $P($G(^MAG(2005.2,+$$CWP^MAGBAPI(PLACE),0)),U,6)="1" D
|
|---|
| 105 | . . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
|
|---|
| 106 | . . S RESULT="-1^^7^^"_JBPTR_U_IEN ;$S(JBPTR:JBPTR,1:XX)_U_IEN
|
|---|
| 107 | . . Q
|
|---|
| 108 | . E S RESULT="-1^^17"
|
|---|
| 109 | . Q
|
|---|
| 110 | S RESULT="1^"_PACS_"^8^^"_$$JBPATH(FNAM,JBPTR)_U_IEN
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | LASTNP(TYPE) ;
|
|---|
| 114 | I TYPE="BIG" Q $S($P(ZNODE,U,3,4)="^":1,1:0)
|
|---|
| 115 | I TYPE="ABS" Q $S((($P(ZNODE,U,3)="")&($P(BNODE,U)="")):1,1:0)
|
|---|
| 116 | Q $S((($P(ZNODE,U,4)="")&($P(BNODE,U)="")):1,1:0)
|
|---|
| 117 | JBPATH(FN,NL) ;
|
|---|
| 118 | Q $P($G(^MAG(2005.2,NL,0)),U,2)_$$DIRHASH^MAGFILEB(FN,NL)_FN
|
|---|
| 119 | WXCPT(RESULT,XPACS,TYPE) ;Check for Worm Exceptions
|
|---|
| 120 | ; when no Worm reference in 2005
|
|---|
| 121 | ;NO JUKEBOX Q:1 ????
|
|---|
| 122 | ;SITE PARAMETER EXCEPTIONS
|
|---|
| 123 | ; ALL "JBEX";1
|
|---|
| 124 | ; ALL PACS "JBEX";2
|
|---|
| 125 | ; ALL PACS BIG "JBEX";3
|
|---|
| 126 | ; ALL PACS BIG IF TGA PRESENT ON MAGNETIC
|
|---|
| 127 | ; ALL BIG NON PACS "JBEX";4
|
|---|
| 128 | N PARNODE,RY
|
|---|
| 129 | ; I '$D(^MAG(2006.1,PLACE,"JBEX")) D Q
|
|---|
| 130 | S $P(RESULT,U)="-2^"_XPACS_"^4" ;NO WXCPT - We no longer support this activity
|
|---|
| 131 | S PARNODE=$G(^MAG(2006.1,1,"JBEX"))
|
|---|
| 132 | I +$P(PARNODE,U)?1"1" S $P(RESULT,U)="6^"_XPACS_"^4" Q ;ALL
|
|---|
| 133 | I +$P(PARNODE,U)?1"2" S $P(RESULT,U)="6^"_XPACS_"^4" D Q ;ALL
|
|---|
| 134 | . S ^XUSEC("MAG DELETE",DUZ)=""
|
|---|
| 135 | . D DELETE^MAGGTID(.RY,IEN,0)
|
|---|
| 136 | . S ^TMP("MAGQ",$J,IEN)=RY(0)
|
|---|
| 137 | . K RY
|
|---|
| 138 | I XPACS D Q
|
|---|
| 139 | . I $P(PARNODE,U,2) S $P(RESULT,U)="6^1^4" Q ;ALL PACS
|
|---|
| 140 | . I TYPE="BIG" D
|
|---|
| 141 | . . I +$P(PARNODE,U,3) S $P(RESULT,U)="6^1^4" Q ;ALL BIG PACS
|
|---|
| 142 | . . I +$P(PARNODE,U,6) S $P(RESULT,U)="2^1^4" Q ;BIG PACS IF TGA
|
|---|
| 143 | . I $P(RESULT,U)="" D
|
|---|
| 144 | . . I $P($G(^MAG(2005.2,+$$CWP^MAGBAPI(PLACE),0)),U,6)'="1" S RESULT="-1" Q
|
|---|
| 145 | . . S RESULT="-2^1^4"
|
|---|
| 146 | ;NON PACS
|
|---|
| 147 | I ((TYPE="BIG")&(+$P(PARNODE,U,4))) S RESULT="6^0^4" Q
|
|---|
| 148 | I $P($G(^MAG(2005.2,+$$CWP^MAGBAPI(PLACE),0)),U,6)'="1" S RESULT="-1^0^4" Q
|
|---|
| 149 | S RESULT="-2^0^4"
|
|---|
| 150 | Q
|
|---|
| 151 | ;
|
|---|
| 152 | FTYPE(FEXT) ;
|
|---|
| 153 | S FEXT=$$UPPER^MAGQE4(FEXT)
|
|---|
| 154 | I "^ABS^"[("^"_FEXT_"^") Q "ABS"
|
|---|
| 155 | I "^BIG^"[("^"_FEXT_"^") Q "BIG"
|
|---|
| 156 | Q "FULL"
|
|---|
| 157 | CHKCP(NODE,TYPE) ;
|
|---|
| 158 | N PIECE,CP
|
|---|
| 159 | S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,1:0)
|
|---|
| 160 | Q $P(NODE,U,PIECE)
|
|---|
| 161 | JBPTR(MAGIEN,TYPE) ;
|
|---|
| 162 | N PTR
|
|---|
| 163 | I TYPE="BIG" D
|
|---|
| 164 | . S PTR=+$P($G(^MAG(2005,MAGIEN,"FBIG")),"^",2)
|
|---|
| 165 | . S:'PTR PTR=+$P($G(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
|
|---|
| 166 | E D
|
|---|
| 167 | . S PTR=+$P($G(^MAG(2005,MAGIEN,0)),"^",5)
|
|---|
| 168 | . S:'PTR PTR=+$P($G(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
|
|---|
| 169 | Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:0)
|
|---|
| 170 | RDHOLD(IEN) ;
|
|---|
| 171 | N HOLD,RIEN
|
|---|
| 172 | S RIEN=$G(^MAG(2005,IEN,2))
|
|---|
| 173 | Q:$P(RIEN,"^",6)'=74 0
|
|---|
| 174 | S HOLD=$G(^RARPT($P(RIEN,"^",7),"NOPURGE"))
|
|---|
| 175 | Q $S($$UPPER^MAGQE4(HOLD)="N":1,1:0)
|
|---|
| 176 | CPOK(TYPE,ALTPATH,FILEPATH,IEN) ;
|
|---|
| 177 | N MAGXX,PIECE,NODE,LOC
|
|---|
| 178 | S MAGXX=IEN
|
|---|
| 179 | S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,1:0)
|
|---|
| 180 | S NODE=$S(TYPE="BIG":"FBIG",1:0)
|
|---|
| 181 | S LOC=$P($G(^MAG(2005,IEN,NODE)),U,PIECE)
|
|---|
| 182 | Q:'LOC 0
|
|---|
| 183 | S ALTPATH=$$UPPER^MAGQE4($P($G(^MAG(2005.2,LOC,0)),U,2)_$$DIRHASH^MAGFILEB(FNAM,LOC))
|
|---|
| 184 | Q $S(ALTPATH=FILEPATH:1,1:0)
|
|---|
| 185 | CPUPD(TYPE,IEN,FP,FN) ;
|
|---|
| 186 | N PIECE,CP,NODE,LOC
|
|---|
| 187 | S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,1:0)
|
|---|
| 188 | S NODE=$S(TYPE="BIG":"FBIG",1:0)
|
|---|
| 189 | S LOC=$$UNHASH(FN,FP)
|
|---|
| 190 | I (PIECE=0)!(+LOC=0) D ELOG(FN,FP) Q
|
|---|
| 191 | S $P(^MAG(2005,IEN,NODE),U,PIECE)=LOC
|
|---|
| 192 | Q
|
|---|
| 193 | CUPD(RESULT,FILEPATH,FILENAME,EXT,IEN) ; RPC[MAGQ CUPDTE]
|
|---|
| 194 | N TYPE
|
|---|
| 195 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 196 | S TYPE=$$FTYPE(EXT)
|
|---|
| 197 | D CPUPD(TYPE,IEN,FILEPATH,FILENAME)
|
|---|
| 198 | Q
|
|---|
| 199 | UNHASH(FN,FP) ; RETURN NETWORK LOCATION NUMBER
|
|---|
| 200 | N SHARE,HASH
|
|---|
| 201 | S SHARE=$S(FP[":":$P(FP,"\",1,2)_"\",1:$P(FP,"\",1,4)_"\")
|
|---|
| 202 | S HASH=$S($P(FP,SHARE,2)["\":"Y",1:"")
|
|---|
| 203 | Q $$SHNAM(SHARE,HASH)
|
|---|
| 204 | ELOG(FN,FP) ;
|
|---|
| 205 | N INDX
|
|---|
| 206 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 207 | S INDX=+$O(^TMP("MAGQ",$J,"PRG",FN,99999),-1)+1
|
|---|
| 208 | S ^TMP("MAGQ",$J,"PRG",FN,INDX)=FN_"^"_FP
|
|---|
| 209 | Q
|
|---|
| 210 | ELOGR(RESULT) ;[MAGQ ELOGR] - Error log report and purge
|
|---|
| 211 | N FN,INDX,CNT
|
|---|
| 212 | S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
|
|---|
| 213 | S FN="",CNT=0
|
|---|
| 214 | F S FN=$O(^TMP("MAGQ",$J,"PRG",FN)) Q:FN="" D
|
|---|
| 215 | . S INDX=""
|
|---|
| 216 | . F S INDX=$O(^TMP("MAGQ",$J,"PRG",FN,INDX)) Q:INDX'?1N.N D
|
|---|
| 217 | . . S CNT=CNT+1,RESULT(CNT)=^TMP("MAGQ",$J,"PRG",FN,INDX)
|
|---|
| 218 | S RESULT(0)=CNT
|
|---|
| 219 | K ^TMP("MAGQ",$J,"PRG")
|
|---|
| 220 | Q
|
|---|
| 221 | SHNAM(SHARE,HASH) ;
|
|---|
| 222 | N NUM,ONLINE,ZNODE
|
|---|
| 223 | S (NUM,ONLINE)=0
|
|---|
| 224 | Q:((SHARE="")!(SHARE[":")) ""
|
|---|
| 225 | F S NUM=$O(^MAG(2005.2,"AC",SHARE,NUM)) Q:'NUM D Q:ONLINE
|
|---|
| 226 | . S ZNODE=^MAG(2005.2,NUM,0)
|
|---|
| 227 | . Q:($P(ZNODE,"^",6)'="1")
|
|---|
| 228 | . Q:($P(ZNODE,"^",8)'=HASH)
|
|---|
| 229 | . S ONLINE="1"
|
|---|
| 230 | Q NUM
|
|---|
