Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGQBPG2

MAGQBPG2.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1. CNP(RESULT,IEN) ; [MAGQ PCHKN]
  1.  N FNAME,PIECE,ZNODE,BNODE,BNAME,PTR,HASH,X
  1.  S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1.  S IEN=+IEN,RESULT="^^^",U="^"
  1.  F  S IEN=$O(^MAG(2005,IEN)) Q:IEN'?1N.N  D  Q:RESULT'="^^^"
  1.  . S ZNODE=$G(^MAG(2005,IEN,0))
  1.  . S FNAME=$P(ZNODE,U,2)
  1.  . I (FNAME["\")!(FNAME[":") D
  1.  . . S FNAME=$$FNX(FNAME)
  1.  . . S $P(^MAG(2005,IEN,0),U,2)=FNAME
  1.  . Q:$P(ZNODE,U,2)=""  ;PROBABLE GROUP HEAD
  1.  . S BNODE=$G(^MAG(2005,IEN,"FBIG"))
  1.  . S PTR=$P(ZNODE,U,3) I PTR?1N.N D
  1.  . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
  1.  . . S $P(^MAG(2005,IEN,0),U,3)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
  1.  . . S $P(RESULT,"^")=$$JBPATH^MAGQBPRG(FNAME,PTR)
  1.  . S PTR=$P(ZNODE,U,4) I PTR?1N.N D
  1.  . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
  1.  . . S $P(^MAG(2005,IEN,0),U,4)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
  1.  . . S $P(RESULT,U,2)=$$JBPATH^MAGQBPRG($P(FNAME,".")_".ABS",PTR)
  1.  . S PTR=$P(BNODE,U) I PTR?1N.N D
  1.  . . S HASH=$P(^MAG(2005.2,PTR,0),U,8)
  1.  . . S $P(^MAG(2005,IEN,"FBIG"),U)=$$SHNAM^MAGQBPRG($P(^MAG(2005.2,PTR,0),U,2),HASH)
  1.  . . S BNAME=$P(FNAME,".")_".BIG"
  1.  . . S $P(RESULT,"^",3)=$$JBPATH^MAGQBPRG(BNAME,PTR)
  1.  . I RESULT'="^^^" S $P(RESULT,U,4)=IEN  ;IEN
  1.  Q
  1. FNX(NAME) ;FIX FILENAME
  1.  I NAME[":" S NAME=$P(NAME,":",$L(NAME,":"))
  1.  I NAME["\" S NAME=$P(NAME,"\",$L(NAME,"\"))
  1.  Q NAME
  1. CNPT ;
  1.  N IEN,RESULT,%
  1.  S IEN=0
  1.  D NOW^%DTC
  1.  F  D CNP(.RESULT,.IEN) W:RESULT[":" !,RESULT Q:IEN'?1N.N  D
  1.  . S IEN=$P(RESULT,"^",4)
  1.  Q
  1. PGEPAR(RESULT) ; RPC[MAGQBP PARM]
  1.  ;; RECORD PurgeParam
  1.  ;; Status^ABS^FULL^BIG^FilePrefix^EXPRESSPURGE^PurgeBy^PhotoID^Minimum
  1.  ;; FULL:8,BIG:22,ABS:23,EXPRESSP:60.2,PURGEBY:60.1
  1.  N ABS,FULL,BIG,PREFIX,NODE3,EXPRESSP,PURGEBY,PREFIX,BIG,MINIMUM
  1.  N FILE,PLACE,FIELD,FLAGS,ARR,X,PHOTOID,TEMP
  1.  S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1.  S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1.  S NODE3=$G(^MAG(2006.1,PLACE,3))
  1.  S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1.  S U="^"
  1.  S FILE=2006.1,FIELD="8;22;23;24;60.2;60.1",FLAGS="E"
  1.  D GETS^DIQ(FILE,PLACE,FIELD,FLAGS,"ARR","ERR")
  1.  S FULL=+ARR(2006.1,PLACE_",",8,"E")
  1.  S ABS=+ARR(2006.1,PLACE_",",23,"E")
  1.  S BIG=+ARR(2006.1,PLACE_",",22,"E")
  1.  S PHOTOID=+ARR(2006.1,PLACE_",",24,"E")
  1.  S EXPRESSP=ARR(2006.1,PLACE_",",60.2,"E")
  1.  S PREFIX=$$INIS(PLACE)
  1.  S PURGEBY=ARR(2006.1,PLACE_",",60.1,"E")
  1.  S:PURGEBY="" PURGEBY="DATE ACCESSED"
  1.  S MINIMUM=FULL F TEMP=ABS,BIG,PHOTOID S:MINIMUM>TEMP MINIMUM=TEMP
  1.  S RESULT="1"_U_ABS_U_FULL_U_BIG_U_PREFIX_U_EXPRESSP_U_PURGEBY_U_PHOTOID_U_MINIMUM
  1.  K ARR
  1.  Q
  1.  ;;
  1. PGEUD(RESULT,FILENAME,EXT,IEN,DEVICE) ; RPC[MAGQBP UPDATE]
  1.  N FTYPE,NODE,PIECE,PLACE,X
  1.  S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
  1.  S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1.  S EXT=$$UPPER^MAGQE4(EXT)
  1.  S RESULT="0",FTYPE=$$FTYPE^MAGQBPRG(EXT,IEN)
  1.  S NODE=$S(FTYPE="BIG":"FBIG",1:0)
  1.  S:DEVICE="JB" PIECE=$S(FTYPE="ABS":5,FTYPE="BIG":2,FTYPE="FULL":5,FTYPE="PHOTOID":5,FTYPE="ADIRECT":5,1:0)
  1.  S:DEVICE="NET" PIECE=$S(EXT="ABS":4,FTYPE="BIG":1,FTYPE="FULL":3,FTYPE="PHOTOID":3,FTYPE="ADIRECT":3,1:0)
  1.  I PIECE=0 D ELOG^MAGQBPRG(NODE,FTYPE,"RAID pointer indeterminate") Q
  1.  S RESULT="1"
  1.  S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=""
  1.  S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=""
  1.  Q
  1. INIS(PLACE) ;
  1.  N ARRY,CNT,SUB,RESULT
  1.  S ARRY($P($G(^MAG(2006.1,PLACE,0)),"^",2))=""
  1.  S CNT=0
  1.  F  S CNT=$O(^MAG(2006.1,PLACE,4,CNT)) Q:CNT'?1N.N  D
  1.  . S ARRY(^MAG(2006.1,PLACE,4,CNT,0))=""
  1.  S (SUB,RESULT)=""
  1.  F  S SUB=$O(ARRY(SUB)) Q:SUB=""  D
  1.  . S RESULT=$S(RESULT="":SUB,1:(RESULT_","_SUB))
  1.  K ARRY
  1.  Q RESULT