MAGQBPRG ;WOIOFO/RMP - Magnetic Server Purge processes ; 07 Jun 2013 9:53 AM
;;3.0;IMAGING;**7,3,8,20,81,39,135**;Mar 19, 2002;Build 5238;Jul 17, 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
FILEREF(RESULT,FILEPATH,FNAM,EXT,NETLOC) ; RPC[MAGQBP FREF]
;VALIDATES THAT THE FILEPATH IS CONSISTENT WITH VISTA MAGFILE REFERENCE
;SET THE SECOND PIECE TO "PACS" IF IT REPRESENTS DICOM
;VALIDATES THAT A JUKEBOX POINTER EXISTS
;RESULT VALUES
;PIECE 1:-3 = FOREIGN FILE, DO NOT PURGE
; -2 = QUEUED FOR JUKEBOX COPY, DO NOT PURGE
; -1 = DO NOT PURGE
; **0 = PURGE('MAG 2005 ENTRY)!('JUKEBOX PTRS )
; 1 = PURGE GIVEN NORMAL DATE CRITERIA (NDC) + CONFIRMED ON JB
; **2 = PURGE GIVEN NDC IF TGA PRESENT
; 3 = PURGE IF FILE IS AT ALTERNATE NETWORK LOCATION SITE
; ELSE PURGE IF AGED & UPDATE FILE REFERENCES
; **4 = (**NA**)AGE PURGE IF ON JUKEBOX, UPDATE FILE REFERENCES
; ELSE UPDATE FILEREFENCES, QUEUE JUKEBOX COPY
; 5 = PURGE IF AT ALTERNATE SITE,QUEUE JUKEBOX IF NOT ON JB
; **6 = PURGE GIVEN NORMAL DATE CRITERIA
;PIECE ** 2: FILETYPE
; 0 = foreign
; 1 = abstract
; 2 = full
; 3 = big
; 4 = photo id
; 5 = advance directive
;PIECE 3: RECORD CATEGORY
; 1 = 'NO 2005 ENTRY
; **2 = RADIOLOGY HOLD
; 3 = NO JUKEBOX/JUKEBOX PTRS
; 4 = JUKEBOX - NO JUKEBOX PTRS (P/EXCEPT)ELSE QUEUE
; 5 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS,PURGE IF CONFIRMED
; 6 = JUKEBOX/JUKEBOX PTRS, WRONG CACHE PTRS PURGE IF AT ALT
; 7 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS, FIX PTRS
; 8 = JUKEBOX/JUKEBOX PTRS, CACHE PTRS, AGE (IF CONFIRMED)
; 9 = RECORD NOT IN THE IMAGE FILE
; 10 = FOREIGN IMAGE FILE
; 11 = NOT AN IMAGE FILE
; 12 = FILE LOCATION NOT VALID
; 13 = DELETE 2005 ENTRY (LAST LOCATION REFERENCED)
; 14 = Duplicate 2005/2005.1 entry
; 15 = Foreign Place
; 16 = Record in Archive file
; 17 = Jukebox offline
N FILEXT,IEN,SITEID,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,RIEN,ZNODE
N FTYPE,CPTR,JBPTR,CPOK,BNODE,ALTPATH,NMSPC,PLACE,XX,FT,MAGDA
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S U="^",(MAGFILE2,RESULT)=""
S FNAM=$$UPPER^MAGQE4(FNAM)
S EXT=$$UPPER^MAGQE4(EXT)
S ^TMP("MAGQ",$J,"PRG","LAST")=FILEPATH_U_FNAM_U_EXT_U_NETLOC
I FNAM'?1.5A1.13N1"."1.3E D Q ;LATER ADD EXT VERIFY USING 2005.02
. D ELOG(FNAM,FILEPATH,"Not a VistA Imaging file") S RESULT="-3^0^11" Q ;'IMAGE FILE
S SITEID=$$UPPER^MAGQE4($$INIS^MAGQBPG2(PLACE))
S NMSPC=$TR($P(FNAM,"."),"0123456789","")
S FILEPATH=$$UPPER^MAGQE4(FILEPATH)
I SITEID'[NMSPC D ELOG(FNAM,FILEPATH,"Foreign Image file") S RESULT="-3^0^10" Q ;FOREIGN FILE
S (IEN,MAGDA)=$O(^MAG(2005,"F",$P(FNAM,"."),""))
I 'IEN S IEN=$O(^MAG(2005.1,"F",$P(FNAM,"."),""))
; Patch 39 - added logging
I 'IEN D Q
. D ELOG(FNAM,FILEPATH,"Record neither in 2005 nor 2005.1")
. S RESULT="-3^0^9^^^"_IEN
. Q
S FTYPE=$$FTYPE(EXT,IEN)
S FT=$S(FTYPE="ABS":"1",FTYPE="FULL":"2",FTYPE="BIG":"3",FTYPE="PHOTOID":"4",FTYPE="ADIRECT":"5",1:"2")
S JBPTR=$$JBPTR(IEN,FTYPE)
;PURGE UNCONDITIONALLY IF NO 2005 or 2005.1 ENTRY
I '$D(^MAG(2005,IEN,0)) D Q
. I $D(^MAG(2005.1,IEN,0)) D Q
. . I ('JBPTR&($P($G(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1")) D
. . . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
. . . S RESULT="-2^"_FT_"^9^^^"_IEN
. . . Q
. . E D
. . . I JBPTR S RESULT="5^"_FT_"^16^"_$$JBPATH(FNAM,JBPTR)_U_$$JBPATH(FNAM,JBPTR)_U_IEN
. . . E S RESULT="-1^"_FT_"^17"
. . . Q
. E S RESULT="1^"_FT_"^9^^^"_IEN
. Q
I PLACE'=$$PLACE^MAGBAPI(+$P($G(^MAG(2005,IEN,100)),U,3)) D Q
. S RESULT="-3^"_FT_"^15" Q ;Foreign Place
S ZNODE=^MAG(2005,IEN,0)
I $P(ZNODE,U,12)="1" S RESULT="-1^"_FT_"^14" Q ; Duplicate Image/Archive entry
S BNODE=$S(FTYPE="BIG":$G(^MAG(2005,IEN,"FBIG")),1:"")
; NEXT PROCESS MAGNETIC PTR~LESS
S CPTR=$$CHKCP($S(FTYPE="BIG":BNODE,1:ZNODE),FTYPE,EXT)
I 'CPTR D Q
. D CPUPD(FTYPE,IEN,FILEPATH,FNAM,EXT)
. I 'JBPTR,$P($G(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1" D
. . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
. S RESULT="-1^"_FT_"^7^^"_JBPTR_U_IEN ;$S(JBPTR:JBPTR,1:XX)_U_IEN
S CPOK=$S('CPTR:0,1:$$CPOK(FTYPE,.ALTPATH,FILEPATH,IEN,EXT))
S ALTPATH=ALTPATH_FNAM
I 'CPOK,JBPTR D Q
. S RESULT="3^"_FT_"^6^"_ALTPATH_U_$$JBPATH(FNAM,JBPTR)_U_IEN
I 'JBPTR D Q
. I $P($G(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1" D
. . S XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
. . S RESULT="-1^"_FT_"^7^^"_JBPTR_U_IEN ;$S(JBPTR:JBPTR,1:XX)_U_IEN
. . Q
. E S RESULT="-1^"_FT_"^17"
. Q
S RESULT="1^"_FT_"^8^^"_$$JBPATH(FNAM,JBPTR)_U_IEN
Q
;
LASTNP(TYPE) ;
I TYPE="BIG" Q $S($P(ZNODE,U,3,4)="^":1,1:0)
I TYPE="ABS" Q $S((($P(ZNODE,U,3)="")&($P(BNODE,U)="")):1,1:0)
Q $S((($P(ZNODE,U,4)="")&($P(BNODE,U)="")):1,1:0)
JBPATH(FN,NL) ;
Q $P($G(^MAG(2005.2,NL,0)),U,2)_$$DIRHASH^MAGFILEB(FN,NL)_FN
FTYPE(FEXT,IEN) ;
; Patch 39 : checking for ABS in FULL
N FILE
S FILE=$S($D(^MAG(2005,IEN,0)):"2005",1:"2005.1")
S FEXT=$$UPPER^MAGQE4(FEXT)
I "^ABS^"[("^"_FEXT_"^") Q "ABS"
I $P($G(^MAG(FILE,IEN,40)),U,3)=$O(^MAG(2005.83,"B","PHOTO ID","")) Q "PHOTOID"
I $P($G(^MAG(FILE,IEN,0)),U,6)=$O(^MAG(2005.02,"B","PATIENT PHOTO","")) Q "PHOTOID"
I $P($G(^MAG(FILE,IEN,40)),U,3)=$O(^MAG(2005.83,"B","ADVANCE DIRECTIVE","")) Q "ADIRECT"
I $$UPPER^MAGQE4($P($G(^MAG(FILE,IEN,0)),U,2))[".ABS" Q "FULL"
I "^BIG^"[("^"_FEXT_"^") Q "BIG"
I "^"_$P($G(^MAG(FILE,IEN,"FBIG")),U,3)_"^"[("^"_FEXT_"^") Q "BIG"
Q "FULL"
CHKCP(NODE,TYPE,EXT) ;
N PIECE,CP
S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
Q $P(NODE,U,PIECE)
JBPTR(MAGIEN,TYPE) ;
N PTR
I TYPE="BIG" D
. S PTR=+$P($G(^MAG(2005,MAGIEN,"FBIG")),"^",2)
. S:'PTR PTR=+$P($G(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
E D
. S PTR=+$P($G(^MAG(2005,MAGIEN,0)),"^",5)
. S:'PTR PTR=+$P($G(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:0)
CPOK(TYPE,ALTPATH,FILEPATH,IEN,EXT) ;
; Patch 39: initializing ALTPATH, checking nodes of either 2005 or 2005.1
N MAGXX,PIECE,NODE,LOC,FILE
S EXT=$$UPPER^MAGQE4(EXT)
S MAGXX=IEN
S ALTPATH=""
S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
S NODE=$S(TYPE="BIG":"FBIG",1:0)
S FILE=$S($D(^MAG(2005,IEN,0)):"2005",1:"2005.1")
S LOC=$P($G(^MAG(FILE,IEN,NODE)),U,PIECE)
Q:'$D(^MAG(2005.2,+LOC,0)) 0
S ALTPATH=$$UPPER^MAGQE4($P($G(^MAG(2005.2,LOC,0)),U,2)_$$DIRHASH^MAGFILEB(FNAM,LOC))
Q $S(ALTPATH=FILEPATH:1,1:0)
CPUPD(TYPE,IEN,FP,FN,EXT) ;
; Patch 39 - Update : Error log type, and using FILE in case an Archive file
N PIECE,CP,NODE,LOC,FILE
S EXT=$S('$D(EXT):"",1:$$UPPER^MAGQE4(EXT))
S PIECE=$S(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
S NODE=$S(TYPE="BIG":"FBIG",1:0)
S LOC=$$UNHASH(FN,FP)
I (PIECE=0)!(+LOC=0) D ELOG(FN,FP,"RAID pointer indeterminate") Q
S FILE=$S($D(^MAG(2005,IEN,0)):"2005",1:"2005.1")
S $P(^MAG(FILE,IEN,NODE),U,PIECE)=LOC
Q
CUPD(RESULT,FILEPATH,FILENAME,EXT,IEN) ; RPC[MAGQ CUPDTE]
N TYPE ; called from the BP Purge
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S TYPE=$$FTYPE(EXT,IEN)
D CPUPD(TYPE,IEN,FILEPATH,FILENAME,EXT)
Q
UNHASH(FN,FP) ; RETURN NETWORK LOCATION NUMBER
N SHARE,HASH
S SHARE=$S(FP[":":$P(FP,"\",1,2)_"\",1:$P(FP,"\",1,4)_"\")
S HASH=$S($P(FP,SHARE,2)["\":"Y",1:"")
Q $$SHNAM(SHARE,HASH)
ELOG(FN,FP,MESSAGE) ;
N INDX
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S INDX=+$O(^TMP("MAGQ",$J,"PRG",99999),-1)+1
S ^TMP("MAGQ",$J,"PRG",INDX)=MESSAGE_"^"_FN_"^"_FP
Q
ELOGR(RESULT,LIMIT) ;[MAGQ ELOGR] - Error log report and purge
; Please test this
N FN,INDX,CNT
N X S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S CNT=0,INDX=""
F S INDX=$O(^TMP("MAGQ",$J,"PRG",INDX)) Q:INDX'?1N.N Q:CNT=LIMIT D
. S CNT=CNT+1,RESULT(CNT)=^TMP("MAGQ",$J,"PRG",INDX)
. K ^TMP("MAGQ",$J,"PRG",INDX)
. Q
S RESULT(0)=CNT
S INDX=$O(^TMP("MAGQ",$J,"PRG",""))
I INDX?1N.N S RESULT(0)=RESULT(0)_U_"MORE"
Q
SHNAM(SHARE,HASH) ;
N NUM,ONLINE,ZNODE
S (NUM,ONLINE)=0
F S NUM=$O(^MAG(2005.2,"AC",SHARE,NUM)) Q:'NUM D Q:ONLINE
. S ZNODE=^MAG(2005.2,NUM,0)
. Q:($P(ZNODE,"^",6)'="1")
. Q:($P(ZNODE,"^",8)'=HASH)
. S ONLINE="1"
Q NUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBPRG 9538 printed Dec 13, 2024@02:07:51 Page 2
MAGQBPRG ;WOIOFO/RMP - Magnetic Server Purge processes ; 07 Jun 2013 9:53 AM
+1 ;;3.0;IMAGING;**7,3,8,20,81,39,135**;Mar 19, 2002;Build 5238;Jul 17, 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
FILEREF(RESULT,FILEPATH,FNAM,EXT,NETLOC) ; RPC[MAGQBP FREF]
+1 ;VALIDATES THAT THE FILEPATH IS CONSISTENT WITH VISTA MAGFILE REFERENCE
+2 ;SET THE SECOND PIECE TO "PACS" IF IT REPRESENTS DICOM
+3 ;VALIDATES THAT A JUKEBOX POINTER EXISTS
+4 ;RESULT VALUES
+5 ;PIECE 1:-3 = FOREIGN FILE, DO NOT PURGE
+6 ; -2 = QUEUED FOR JUKEBOX COPY, DO NOT PURGE
+7 ; -1 = DO NOT PURGE
+8 ; **0 = PURGE('MAG 2005 ENTRY)!('JUKEBOX PTRS )
+9 ; 1 = PURGE GIVEN NORMAL DATE CRITERIA (NDC) + CONFIRMED ON JB
+10 ; **2 = PURGE GIVEN NDC IF TGA PRESENT
+11 ; 3 = PURGE IF FILE IS AT ALTERNATE NETWORK LOCATION SITE
+12 ; ELSE PURGE IF AGED & UPDATE FILE REFERENCES
+13 ; **4 = (**NA**)AGE PURGE IF ON JUKEBOX, UPDATE FILE REFERENCES
+14 ; ELSE UPDATE FILEREFENCES, QUEUE JUKEBOX COPY
+15 ; 5 = PURGE IF AT ALTERNATE SITE,QUEUE JUKEBOX IF NOT ON JB
+16 ; **6 = PURGE GIVEN NORMAL DATE CRITERIA
+17 ;PIECE ** 2: FILETYPE
+18 ; 0 = foreign
+19 ; 1 = abstract
+20 ; 2 = full
+21 ; 3 = big
+22 ; 4 = photo id
+23 ; 5 = advance directive
+24 ;PIECE 3: RECORD CATEGORY
+25 ; 1 = 'NO 2005 ENTRY
+26 ; **2 = RADIOLOGY HOLD
+27 ; 3 = NO JUKEBOX/JUKEBOX PTRS
+28 ; 4 = JUKEBOX - NO JUKEBOX PTRS (P/EXCEPT)ELSE QUEUE
+29 ; 5 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS,PURGE IF CONFIRMED
+30 ; 6 = JUKEBOX/JUKEBOX PTRS, WRONG CACHE PTRS PURGE IF AT ALT
+31 ; 7 = JUKEBOX/JUKEBOX PTRS, NO CACHE PTRS, FIX PTRS
+32 ; 8 = JUKEBOX/JUKEBOX PTRS, CACHE PTRS, AGE (IF CONFIRMED)
+33 ; 9 = RECORD NOT IN THE IMAGE FILE
+34 ; 10 = FOREIGN IMAGE FILE
+35 ; 11 = NOT AN IMAGE FILE
+36 ; 12 = FILE LOCATION NOT VALID
+37 ; 13 = DELETE 2005 ENTRY (LAST LOCATION REFERENCED)
+38 ; 14 = Duplicate 2005/2005.1 entry
+39 ; 15 = Foreign Place
+40 ; 16 = Record in Archive file
+41 ; 17 = Jukebox offline
+42 NEW FILEXT,IEN,SITEID,MAGXX,MAGFILE,MAGFILE1,MAGFILE2,RIEN,ZNODE
+43 NEW FTYPE,CPTR,JBPTR,CPOK,BNODE,ALTPATH,NMSPC,PLACE,XX,FT,MAGDA
+44 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+45 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+46 SET U="^"
SET (MAGFILE2,RESULT)=""
+47 SET FNAM=$$UPPER^MAGQE4(FNAM)
+48 SET EXT=$$UPPER^MAGQE4(EXT)
+49 SET ^TMP("MAGQ",$JOB,"PRG","LAST")=FILEPATH_U_FNAM_U_EXT_U_NETLOC
+50 ;LATER ADD EXT VERIFY USING 2005.02
IF FNAM'?1.5A1.13N1"."1.3E
Begin DoDot:1
+51 ;'IMAGE FILE
DO ELOG(FNAM,FILEPATH,"Not a VistA Imaging file")
SET RESULT="-3^0^11"
QUIT
End DoDot:1
QUIT
+52 SET SITEID=$$UPPER^MAGQE4($$INIS^MAGQBPG2(PLACE))
+53 SET NMSPC=$TRANSLATE($PIECE(FNAM,"."),"0123456789","")
+54 SET FILEPATH=$$UPPER^MAGQE4(FILEPATH)
+55 ;FOREIGN FILE
IF SITEID'[NMSPC
DO ELOG(FNAM,FILEPATH,"Foreign Image file")
SET RESULT="-3^0^10"
QUIT
+56 SET (IEN,MAGDA)=$ORDER(^MAG(2005,"F",$PIECE(FNAM,"."),""))
+57 IF 'IEN
SET IEN=$ORDER(^MAG(2005.1,"F",$PIECE(FNAM,"."),""))
+58 ; Patch 39 - added logging
+59 IF 'IEN
Begin DoDot:1
+60 DO ELOG(FNAM,FILEPATH,"Record neither in 2005 nor 2005.1")
+61 SET RESULT="-3^0^9^^^"_IEN
+62 QUIT
End DoDot:1
QUIT
+63 SET FTYPE=$$FTYPE(EXT,IEN)
+64 SET FT=$SELECT(FTYPE="ABS":"1",FTYPE="FULL":"2",FTYPE="BIG":"3",FTYPE="PHOTOID":"4",FTYPE="ADIRECT":"5",1:"2")
+65 SET JBPTR=$$JBPTR(IEN,FTYPE)
+66 ;PURGE UNCONDITIONALLY IF NO 2005 or 2005.1 ENTRY
+67 IF '$DATA(^MAG(2005,IEN,0))
Begin DoDot:1
+68 IF $DATA(^MAG(2005.1,IEN,0))
Begin DoDot:2
+69 IF ('JBPTR&($PIECE($GET(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1"))
Begin DoDot:3
+70 SET XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
+71 SET RESULT="-2^"_FT_"^9^^^"_IEN
+72 QUIT
End DoDot:3
+73 IF '$TEST
Begin DoDot:3
+74 IF JBPTR
SET RESULT="5^"_FT_"^16^"_$$JBPATH(FNAM,JBPTR)_U_$$JBPATH(FNAM,JBPTR)_U_IEN
+75 IF '$TEST
SET RESULT="-1^"_FT_"^17"
+76 QUIT
End DoDot:3
End DoDot:2
QUIT
+77 IF '$TEST
SET RESULT="1^"_FT_"^9^^^"_IEN
+78 QUIT
End DoDot:1
QUIT
+79 IF PLACE'=$$PLACE^MAGBAPI(+$PIECE($GET(^MAG(2005,IEN,100)),U,3))
Begin DoDot:1
+80 ;Foreign Place
SET RESULT="-3^"_FT_"^15"
QUIT
End DoDot:1
QUIT
+81 SET ZNODE=^MAG(2005,IEN,0)
+82 ; Duplicate Image/Archive entry
IF $PIECE(ZNODE,U,12)="1"
SET RESULT="-1^"_FT_"^14"
QUIT
+83 SET BNODE=$SELECT(FTYPE="BIG":$GET(^MAG(2005,IEN,"FBIG")),1:"")
+84 ; NEXT PROCESS MAGNETIC PTR~LESS
+85 SET CPTR=$$CHKCP($SELECT(FTYPE="BIG":BNODE,1:ZNODE),FTYPE,EXT)
+86 IF 'CPTR
Begin DoDot:1
+87 DO CPUPD(FTYPE,IEN,FILEPATH,FNAM,EXT)
+88 IF 'JBPTR
IF $PIECE($GET(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1"
Begin DoDot:2
+89 SET XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
End DoDot:2
+90 ;$S(JBPTR:JBPTR,1:XX)_U_IEN
SET RESULT="-1^"_FT_"^7^^"_JBPTR_U_IEN
End DoDot:1
QUIT
+91 SET CPOK=$SELECT('CPTR:0,1:$$CPOK(FTYPE,.ALTPATH,FILEPATH,IEN,EXT))
+92 SET ALTPATH=ALTPATH_FNAM
+93 IF 'CPOK
IF JBPTR
Begin DoDot:1
+94 SET RESULT="3^"_FT_"^6^"_ALTPATH_U_$$JBPATH(FNAM,JBPTR)_U_IEN
End DoDot:1
QUIT
+95 IF 'JBPTR
Begin DoDot:1
+96 IF $PIECE($GET(^MAG(2005.2,+$$JBPTR^MAGBAPI(PLACE),0)),U,6)="1"
Begin DoDot:2
+97 SET XX=$$JUKEBOX^MAGBAPI(IEN,PLACE)
+98 ;$S(JBPTR:JBPTR,1:XX)_U_IEN
SET RESULT="-1^"_FT_"^7^^"_JBPTR_U_IEN
+99 QUIT
End DoDot:2
+100 IF '$TEST
SET RESULT="-1^"_FT_"^17"
+101 QUIT
End DoDot:1
QUIT
+102 SET RESULT="1^"_FT_"^8^^"_$$JBPATH(FNAM,JBPTR)_U_IEN
+103 QUIT
+104 ;
LASTNP(TYPE) ;
+1 IF TYPE="BIG"
QUIT $SELECT($PIECE(ZNODE,U,3,4)="^":1,1:0)
+2 IF TYPE="ABS"
QUIT $SELECT((($PIECE(ZNODE,U,3)="")&($PIECE(BNODE,U)="")):1,1:0)
+3 QUIT $SELECT((($PIECE(ZNODE,U,4)="")&($PIECE(BNODE,U)="")):1,1:0)
JBPATH(FN,NL) ;
+1 QUIT $PIECE($GET(^MAG(2005.2,NL,0)),U,2)_$$DIRHASH^MAGFILEB(FN,NL)_FN
FTYPE(FEXT,IEN) ;
+1 ; Patch 39 : checking for ABS in FULL
+2 NEW FILE
+3 SET FILE=$SELECT($DATA(^MAG(2005,IEN,0)):"2005",1:"2005.1")
+4 SET FEXT=$$UPPER^MAGQE4(FEXT)
+5 IF "^ABS^"[("^"_FEXT_"^")
QUIT "ABS"
+6 IF $PIECE($GET(^MAG(FILE,IEN,40)),U,3)=$ORDER(^MAG(2005.83,"B","PHOTO ID",""))
QUIT "PHOTOID"
+7 IF $PIECE($GET(^MAG(FILE,IEN,0)),U,6)=$ORDER(^MAG(2005.02,"B","PATIENT PHOTO",""))
QUIT "PHOTOID"
+8 IF $PIECE($GET(^MAG(FILE,IEN,40)),U,3)=$ORDER(^MAG(2005.83,"B","ADVANCE DIRECTIVE",""))
QUIT "ADIRECT"
+9 IF $$UPPER^MAGQE4($PIECE($GET(^MAG(FILE,IEN,0)),U,2))[".ABS"
QUIT "FULL"
+10 IF "^BIG^"[("^"_FEXT_"^")
QUIT "BIG"
+11 IF "^"_$PIECE($GET(^MAG(FILE,IEN,"FBIG")),U,3)_"^"[("^"_FEXT_"^")
QUIT "BIG"
+12 QUIT "FULL"
CHKCP(NODE,TYPE,EXT) ;
+1 NEW PIECE,CP
+2 SET PIECE=$SELECT(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
+3 QUIT $PIECE(NODE,U,PIECE)
JBPTR(MAGIEN,TYPE) ;
+1 NEW PTR
+2 IF TYPE="BIG"
Begin DoDot:1
+3 SET PTR=+$PIECE($GET(^MAG(2005,MAGIEN,"FBIG")),"^",2)
+4 if 'PTR
SET PTR=+$PIECE($GET(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET PTR=+$PIECE($GET(^MAG(2005,MAGIEN,0)),"^",5)
+7 if 'PTR
SET PTR=+$PIECE($GET(^MAG(2005.1,MAGIEN,"FBIG")),"^",2)
End DoDot:1
+8 QUIT $SELECT($PIECE($GET(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:0)
CPOK(TYPE,ALTPATH,FILEPATH,IEN,EXT) ;
+1 ; Patch 39: initializing ALTPATH, checking nodes of either 2005 or 2005.1
+2 NEW MAGXX,PIECE,NODE,LOC,FILE
+3 SET EXT=$$UPPER^MAGQE4(EXT)
+4 SET MAGXX=IEN
+5 SET ALTPATH=""
+6 SET PIECE=$SELECT(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
+7 SET NODE=$SELECT(TYPE="BIG":"FBIG",1:0)
+8 SET FILE=$SELECT($DATA(^MAG(2005,IEN,0)):"2005",1:"2005.1")
+9 SET LOC=$PIECE($GET(^MAG(FILE,IEN,NODE)),U,PIECE)
+10 if '$DATA(^MAG(2005.2,+LOC,0))
QUIT 0
+11 SET ALTPATH=$$UPPER^MAGQE4($PIECE($GET(^MAG(2005.2,LOC,0)),U,2)_$$DIRHASH^MAGFILEB(FNAM,LOC))
+12 QUIT $SELECT(ALTPATH=FILEPATH:1,1:0)
CPUPD(TYPE,IEN,FP,FN,EXT) ;
+1 ; Patch 39 - Update : Error log type, and using FILE in case an Archive file
+2 NEW PIECE,CP,NODE,LOC,FILE
+3 SET EXT=$SELECT('$DATA(EXT):"",1:$$UPPER^MAGQE4(EXT))
+4 SET PIECE=$SELECT(TYPE="ABS":4,TYPE="BIG":1,TYPE="FULL":3,"^PHOTOID^ADIRECT^"[("^"_TYPE_"^"):3,1:0)
+5 SET NODE=$SELECT(TYPE="BIG":"FBIG",1:0)
+6 SET LOC=$$UNHASH(FN,FP)
+7 IF (PIECE=0)!(+LOC=0)
DO ELOG(FN,FP,"RAID pointer indeterminate")
QUIT
+8 SET FILE=$SELECT($DATA(^MAG(2005,IEN,0)):"2005",1:"2005.1")
+9 SET $PIECE(^MAG(FILE,IEN,NODE),U,PIECE)=LOC
+10 QUIT
CUPD(RESULT,FILEPATH,FILENAME,EXT,IEN) ; RPC[MAGQ CUPDTE]
+1 ; called from the BP Purge
NEW TYPE
+2 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET TYPE=$$FTYPE(EXT,IEN)
+4 DO CPUPD(TYPE,IEN,FILEPATH,FILENAME,EXT)
+5 QUIT
UNHASH(FN,FP) ; RETURN NETWORK LOCATION NUMBER
+1 NEW SHARE,HASH
+2 SET SHARE=$SELECT(FP[":":$PIECE(FP,"\",1,2)_"\",1:$PIECE(FP,"\",1,4)_"\")
+3 SET HASH=$SELECT($PIECE(FP,SHARE,2)["\":"Y",1:"")
+4 QUIT $$SHNAM(SHARE,HASH)
ELOG(FN,FP,MESSAGE) ;
+1 NEW INDX
+2 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET INDX=+$ORDER(^TMP("MAGQ",$JOB,"PRG",99999),-1)+1
+4 SET ^TMP("MAGQ",$JOB,"PRG",INDX)=MESSAGE_"^"_FN_"^"_FP
+5 QUIT
ELOGR(RESULT,LIMIT) ;[MAGQ ELOGR] - Error log report and purge
+1 ; Please test this
+2 NEW FN,INDX,CNT
+3 NEW X
SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+4 SET CNT=0
SET INDX=""
+5 FOR
SET INDX=$ORDER(^TMP("MAGQ",$JOB,"PRG",INDX))
if INDX'?1N.N
QUIT
if CNT=LIMIT
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
SET RESULT(CNT)=^TMP("MAGQ",$JOB,"PRG",INDX)
+7 KILL ^TMP("MAGQ",$JOB,"PRG",INDX)
+8 QUIT
End DoDot:1
+9 SET RESULT(0)=CNT
+10 SET INDX=$ORDER(^TMP("MAGQ",$JOB,"PRG",""))
+11 IF INDX?1N.N
SET RESULT(0)=RESULT(0)_U_"MORE"
+12 QUIT
SHNAM(SHARE,HASH) ;
+1 NEW NUM,ONLINE,ZNODE
+2 SET (NUM,ONLINE)=0
+3 FOR
SET NUM=$ORDER(^MAG(2005.2,"AC",SHARE,NUM))
if 'NUM
QUIT
Begin DoDot:1
+4 SET ZNODE=^MAG(2005.2,NUM,0)
+5 if ($PIECE(ZNODE,"^",6)'="1")
QUIT
+6 if ($PIECE(ZNODE,"^",8)'=HASH)
QUIT
+7 SET ONLINE="1"
End DoDot:1
if ONLINE
QUIT
+8 QUIT NUM
