MAGQBPG2 ;WCIOFO/RMP - Magnetic Server Purge processes ; 07 Jun 2013 9:55 AM
;;3.0;IMAGING;**8,20,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
CNP(RESULT,IEN) ; [MAGQ PCHKN]
N FNAME,PIECE,ZNODE,BNODE,BNAME,PTR,HASH,X
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S IEN=+IEN,RESULT="^^^",U="^"
F S IEN=$O(^MAG(2005,IEN)) Q:IEN'?1N.N D Q:RESULT'="^^^"
. S ZNODE=$G(^MAG(2005,IEN,0))
. S FNAME=$P(ZNODE,U,2)
. I (FNAME["\")!(FNAME[":") D
. . S FNAME=$$FNX(FNAME)
. . S $P(^MAG(2005,IEN,0),U,2)=FNAME
. Q:$P(ZNODE,U,2)="" ;PROBABLE GROUP HEAD
. S BNODE=$G(^MAG(2005,IEN,"FBIG"))
. S PTR=$P(ZNODE,U,3) I PTR?1N.N D
. . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
. . S $P(^MAG(2005,IEN,0),U,3)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
. . S $P(RESULT,"^")=$$JBPATH^MAGQBPRG(FNAME,PTR)
. S PTR=$P(ZNODE,U,4) I PTR?1N.N D
. . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
. . S $P(^MAG(2005,IEN,0),U,4)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
. . S $P(RESULT,U,2)=$$JBPATH^MAGQBPRG($P(FNAME,".")_".ABS",PTR)
. S PTR=$P(BNODE,U) I PTR?1N.N D
. . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
. . S $P(^MAG(2005,IEN,"FBIG"),U)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
. . S BNAME=$P(FNAME,".")_".BIG"
. . S $P(RESULT,"^",3)=$$JBPATH^MAGQBPRG(BNAME,PTR)
. I RESULT'="^^^" S $P(RESULT,U,4)=IEN ;IEN
Q
FNX(NAME) ;FIX FILENAME
I NAME[":" S NAME=$P(NAME,":",$L(NAME,":"))
I NAME["\" S NAME=$P(NAME,"\",$L(NAME,"\"))
Q NAME
CNPT ;
N IEN,RESULT,%
S IEN=0
D NOW^%DTC
F D CNP(.RESULT,.IEN) W:RESULT[":" !,RESULT Q:IEN'?1N.N D
. S IEN=$P(RESULT,"^",4)
Q
PGEPAR(RESULT) ; RPC[MAGQBP PARM]
;; RECORD PurgeParam
;; Status^ABS^FULL^BIG^FilePrefix^EXPRESSPURGE^PurgeBy^PhotoID^Minimum
;; FULL:8,BIG:22,ABS:23,EXPRESSP:60.2,PURGEBY:60.1
N ABS,FULL,BIG,PREFIX,NODE3,EXPRESSP,PURGEBY,PREFIX,BIG,MINIMUM
N FILE,PLACE,FIELD,FLAGS,ARR,X,PHOTOID,TEMP
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S NODE3=$G(^MAG(2006.1,PLACE,3))
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S U="^"
S FILE=2006.1,FIELD="8;22;23;24;60.2;60.1",FLAGS="E"
D GETS^DIQ(FILE,PLACE,FIELD,FLAGS,"ARR","ERR")
S FULL=+ARR(2006.1,PLACE_",",8,"E")
S ABS=+ARR(2006.1,PLACE_",",23,"E")
S BIG=+ARR(2006.1,PLACE_",",22,"E")
S PHOTOID=+ARR(2006.1,PLACE_",",24,"E")
S EXPRESSP=ARR(2006.1,PLACE_",",60.2,"E")
S PREFIX=$$INIS(PLACE)
S PURGEBY=ARR(2006.1,PLACE_",",60.1,"E")
S:PURGEBY="" PURGEBY="DATE ACCESSED"
S MINIMUM=FULL F TEMP=ABS,BIG,PHOTOID S:MINIMUM>TEMP MINIMUM=TEMP
S RESULT="1"_U_ABS_U_FULL_U_BIG_U_PREFIX_U_EXPRESSP_U_PURGEBY_U_PHOTOID_U_MINIMUM
K ARR
Q
;;
PGEUD(RESULT,FILENAME,EXT,IEN,DEVICE) ; RPC[MAGQBP UPDATE]
N FTYPE,NODE,PIECE,PLACE,X
S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
S EXT=$$UPPER^MAGQE4(EXT)
S RESULT="0",FTYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
S NODE=$S(FTYPE="BIG":"FBIG",1:0)
S:DEVICE="JB" PIECE=$S(FTYPE="ABS":5,FTYPE="BIG":2,FTYPE="FULL":5,FTYPE="PHOTOID":5,FTYPE="ADIRECT":5,1:0)
S:DEVICE="NET" PIECE=$S(EXT="ABS":4,FTYPE="BIG":1,FTYPE="FULL":3,FTYPE="PHOTOID":3,FTYPE="ADIRECT":3,1:0)
I PIECE=0 D ELOG^MAGQBPRG(NODE,FTYPE,"RAID pointer indeterminate") Q
S RESULT="1"
S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=""
S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=""
Q
INIS(PLACE) ;
N ARRY,CNT,SUB,RESULT
S ARRY($P($G(^MAG(2006.1,PLACE,0)),"^",2))=""
S CNT=0
F S CNT=$O(^MAG(2006.1,PLACE,4,CNT)) Q:CNT'?1N.N D
. S ARRY(^MAG(2006.1,PLACE,4,CNT,0))=""
S (SUB,RESULT)=""
F S SUB=$O(ARRY(SUB)) Q:SUB="" D
. S RESULT=$S(RESULT="":SUB,1:(RESULT_","_SUB))
K ARRY
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBPG2 4668 printed Apr 09, 2024@21:06:17 Page 2
MAGQBPG2 ;WCIOFO/RMP - Magnetic Server Purge processes ; 07 Jun 2013 9:55 AM
+1 ;;3.0;IMAGING;**8,20,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
CNP(RESULT,IEN) ; [MAGQ PCHKN]
+1 NEW FNAME,PIECE,ZNODE,BNODE,BNAME,PTR,HASH,X
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET IEN=+IEN
SET RESULT="^^^"
SET U="^"
+4 FOR
SET IEN=$ORDER(^MAG(2005,IEN))
if IEN'?1N.N
QUIT
Begin DoDot:1
+5 SET ZNODE=$GET(^MAG(2005,IEN,0))
+6 SET FNAME=$PIECE(ZNODE,U,2)
+7 IF (FNAME["\")!(FNAME[":")
Begin DoDot:2
+8 SET FNAME=$$FNX(FNAME)
+9 SET $PIECE(^MAG(2005,IEN,0),U,2)=FNAME
End DoDot:2
+10 ;PROBABLE GROUP HEAD
if $PIECE(ZNODE,U,2)=""
QUIT
+11 SET BNODE=$GET(^MAG(2005,IEN,"FBIG"))
+12 SET PTR=$PIECE(ZNODE,U,3)
IF PTR?1N.N
Begin DoDot:2
+13 SET HASH=$PIECE(^MAG(2005.2,PTR,0),U,8)
+14 SET $PIECE(^MAG(2005,IEN,0),U,3)=$$SHNAM^MAGQBPRG($PIECE(^MAG(2005.2,PTR,0),U,2),HASH)
+15 SET $PIECE(RESULT,"^")=$$JBPATH^MAGQBPRG(FNAME,PTR)
End DoDot:2
+16 SET PTR=$PIECE(ZNODE,U,4)
IF PTR?1N.N
Begin DoDot:2
+17 SET HASH=$PIECE(^MAG(2005.2,PTR,0),U,8)
+18 SET $PIECE(^MAG(2005,IEN,0),U,4)=$$SHNAM^MAGQBPRG($PIECE(^MAG(2005.2,PTR,0),U,2),HASH)
+19 SET $PIECE(RESULT,U,2)=$$JBPATH^MAGQBPRG($PIECE(FNAME,".")_".ABS",PTR)
End DoDot:2
+20 SET PTR=$PIECE(BNODE,U)
IF PTR?1N.N
Begin DoDot:2
+21 SET HASH=$PIECE(^MAG(2005.2,PTR,0),U,8)
+22 SET $PIECE(^MAG(2005,IEN,"FBIG"),U)=$$SHNAM^MAGQBPRG($PIECE(^MAG(2005.2,PTR,0),U,2),HASH)
+23 SET BNAME=$PIECE(FNAME,".")_".BIG"
+24 SET $PIECE(RESULT,"^",3)=$$JBPATH^MAGQBPRG(BNAME,PTR)
End DoDot:2
+25 ;IEN
IF RESULT'="^^^"
SET $PIECE(RESULT,U,4)=IEN
End DoDot:1
if RESULT'="^^^"
QUIT
+26 QUIT
FNX(NAME) ;FIX FILENAME
+1 IF NAME[":"
SET NAME=$PIECE(NAME,":",$LENGTH(NAME,":"))
+2 IF NAME["\"
SET NAME=$PIECE(NAME,"\",$LENGTH(NAME,"\"))
+3 QUIT NAME
CNPT ;
+1 NEW IEN,RESULT,%
+2 SET IEN=0
+3 DO NOW^%DTC
+4 FOR
DO CNP(.RESULT,.IEN)
if RESULT["
WRITE !,RESULT
if IEN'?1N.N
QUIT
Begin DoDot:1
+5 SET IEN=$PIECE(RESULT,"^",4)
End DoDot:1
+6 QUIT
PGEPAR(RESULT) ; RPC[MAGQBP PARM]
+1 ;; RECORD PurgeParam
+2 ;; Status^ABS^FULL^BIG^FilePrefix^EXPRESSPURGE^PurgeBy^PhotoID^Minimum
+3 ;; FULL:8,BIG:22,ABS:23,EXPRESSP:60.2,PURGEBY:60.1
+4 NEW ABS,FULL,BIG,PREFIX,NODE3,EXPRESSP,PURGEBY,PREFIX,BIG,MINIMUM
+5 NEW FILE,PLACE,FIELD,FLAGS,ARR,X,PHOTOID,TEMP
+6 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+7 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+8 SET NODE3=$GET(^MAG(2006.1,PLACE,3))
+9 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+10 SET U="^"
+11 SET FILE=2006.1
SET FIELD="8;22;23;24;60.2;60.1"
SET FLAGS="E"
+12 DO GETS^DIQ(FILE,PLACE,FIELD,FLAGS,"ARR","ERR")
+13 SET FULL=+ARR(2006.1,PLACE_",",8,"E")
+14 SET ABS=+ARR(2006.1,PLACE_",",23,"E")
+15 SET BIG=+ARR(2006.1,PLACE_",",22,"E")
+16 SET PHOTOID=+ARR(2006.1,PLACE_",",24,"E")
+17 SET EXPRESSP=ARR(2006.1,PLACE_",",60.2,"E")
+18 SET PREFIX=$$INIS(PLACE)
+19 SET PURGEBY=ARR(2006.1,PLACE_",",60.1,"E")
+20 if PURGEBY=""
SET PURGEBY="DATE ACCESSED"
+21 SET MINIMUM=FULL
FOR TEMP=ABS,BIG,PHOTOID
if MINIMUM>TEMP
SET MINIMUM=TEMP
+22 SET RESULT="1"_U_ABS_U_FULL_U_BIG_U_PREFIX_U_EXPRESSP_U_PURGEBY_U_PHOTOID_U_MINIMUM
+23 KILL ARR
+24 QUIT
+25 ;;
PGEUD(RESULT,FILENAME,EXT,IEN,DEVICE) ; RPC[MAGQBP UPDATE]
+1 NEW FTYPE,NODE,PIECE,PLACE,X
+2 SET X="ERR^MAGQBTM"
SET @^%ZOSF("TRAP")
+3 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+4 SET EXT=$$UPPER^MAGQE4(EXT)
+5 SET RESULT="0"
SET FTYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
+6 SET NODE=$SELECT(FTYPE="BIG":"FBIG",1:0)
+7 if DEVICE="JB"
SET PIECE=$SELECT(FTYPE="ABS":5,FTYPE="BIG":2,FTYPE="FULL":5,FTYPE="PHOTOID":5,FTYPE="ADIRECT":5,1:0)
+8 if DEVICE="NET"
SET PIECE=$SELECT(EXT="ABS":4,FTYPE="BIG":1,FTYPE="FULL":3,FTYPE="PHOTOID":3,FTYPE="ADIRECT":3,1:0)
+9 IF PIECE=0
DO ELOG^MAGQBPRG(NODE,FTYPE,"RAID pointer indeterminate")
QUIT
+10 SET RESULT="1"
+11 if $DATA(^MAG(2005,IEN,NODE))
SET $PIECE(^MAG(2005,IEN,NODE),U,PIECE)=""
+12 if $DATA(^MAG(2005.1,IEN,NODE))
SET $PIECE(^MAG(2005.1,IEN,NODE),U,PIECE)=""
+13 QUIT
INIS(PLACE) ;
+1 NEW ARRY,CNT,SUB,RESULT
+2 SET ARRY($PIECE($GET(^MAG(2006.1,PLACE,0)),"^",2))=""
+3 SET CNT=0
+4 FOR
SET CNT=$ORDER(^MAG(2006.1,PLACE,4,CNT))
if CNT'?1N.N
QUIT
Begin DoDot:1
+5 SET ARRY(^MAG(2006.1,PLACE,4,CNT,0))=""
End DoDot:1
+6 SET (SUB,RESULT)=""
+7 FOR
SET SUB=$ORDER(ARRY(SUB))
if SUB=""
QUIT
Begin DoDot:1
+8 SET RESULT=$SELECT(RESULT="":SUB,1:(RESULT_","_SUB))
End DoDot:1
+9 KILL ARRY
+10 QUIT RESULT
