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

MAGQBU6A.m

Go to the documentation of this file. 
  1. MAGQBU6A ;WIOFO/RMP Utility to find possible incorrect Image issues with the Import Queue File. ; 14 Oct 2010 10:12 AM
  1.  ;;3.0;IMAGING;**39**;Mar 19, 2002;Build 2010;Mar 08, 2011
  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. GETRL(LIST) ;  Get Redundant List (of shares)
  1.  N HASH,IEN,NODE,NODE2,NODE3,PATH,PLACE,TYPE
  1.  ; Must have same:  PHYSICAL REFERENCE,STORAGE TYPE,HASH DIRECTORY,PLACE
  1.  ; Return array:(UNC path, 1 or 0 for hash directory,division)=list of iens that match the UNC path
  1.  ; ARRAY(\\UNC_HASH_DIVISION)=1ST IEN FOUND_IEN_IEN,etc.
  1.  K LIST
  1.  S U="^"
  1.  S IEN=0 F  S IEN=$O(^MAG(2005.2,IEN)) Q:'IEN  D
  1.  . S NODE=$G(^MAG(2005.2,IEN,0)),NODE3=$G(^MAG(2005.2,IEN,3)),NODE2=$G(^MAG(2005,IEN,3))
  1.  . S PATH=$P(NODE,U,2),PLACE=$P(NODE,U,10),TYPE=$P(NODE,U,7),HASH=$P(NODE,U,8)
  1.  . Q:((TYPE'["WORM")&(TYPE'["MAG"))  ; Only RAID and Jukebox NAMES
  1.  . I +$D(LIST(PATH_U_HASH_U_PLACE)) D  Q
  1.  . . S $P(LIST(PATH_U_HASH_U_PLACE),U,1,99)=$P(LIST(PATH_U_HASH_U_PLACE),U,1,99)_U_IEN
  1.  . . Q
  1.  . E  S LIST(PATH_U_HASH_U_PLACE)=IEN
  1.  . Q
  1.  S PATH="" F  S PATH=$O(LIST(PATH)) Q:PATH=""  D
  1.  . I $G(LIST(PATH))'["^" K LIST(PATH) ;Only entry with more than one IEN defined.
  1.  . Q
  1.  ;Now start applying rule: 
  1.  ;Use the IEN in the duplicates that is ONLINE-- as the primary.
  1.  N NEW,OLD,ON,PC,PRIME
  1.  S EN="" F  S EN=$O(LIST(EN)) Q:EN=""  D
  1.  . S ON=0 F PC=1:1:$L(LIST(EN),"^") S IEN=$P(LIST(EN),U,PC) D  Q:ON
  1.  . . I PC=1,+$P(^MAG(2005.2,IEN,0),U,6) S ON=1 Q    ;above rule
  1.  . . I +$P(^MAG(2005.2,IEN,0),U,6) S ON=1 S NEW(EN)=IEN_"^"_PC
  1.  . . Q
  1.  . Q
  1.  ;resort the array to place the new prime in right order
  1.  S EN="" F  S EN=$O(NEW(EN)) Q:EN=""  D
  1.  . ;get the original prime (OLD)and the new piece value for it.
  1.  . S PRIME=$G(NEW(EN)),OLD=+LIST(EN)_U_$P(PRIME,U,2)
  1.  . S NEW(EN)=$G(LIST(EN))   ;get the original prime and dup values 
  1.  . S $P(NEW(EN),U)=+PRIME   ;set the new prime
  1.  . S $P(NEW(EN),U,$P(OLD,U,2))=+OLD  ;Reposition the old prime value
  1.  . Q
  1.  S EN="" F  S EN=$O(LIST(EN)) Q:EN=""  D
  1.  . I $D(NEW(EN)) M LIST(EN)=NEW(EN)
  1.  . Q
  1.  ;Now save in a temp file in case errors occur during repointing of dangling pointers in the IMAGE files.
  1.  N ENTRY,ILIST,X,X2
  1.  S X=$$NOW^XLFDT,X2=$$FMADD^XLFDT(X,30,"","","")
  1.  S ^XTMP("MAGP39","DUPSHARE",0)=X_"^"_X2_"^"_"Patch 39 Consolidating Network Locations"
  1.  S PATH="" F  S PATH=$O(LIST(PATH)) Q:PATH=""  D 
  1.  . S ILIST=$G(LIST(PATH)) I ILIST S ENTRY=$P(ILIST,"^") I ENTRY D
  1.  . S ^XTMP("MAGP39","DUPSHARE","ENTRIES",ENTRY,PATH)=ILIST
  1.  . Q
  1.  Q 
  1.  ;
  1. DSPNL ; Display the original Network Location file
  1.  N EN,DATA,ONLINE,ROUTER
  1.  S EN=0
  1.  D PMSG^MAGQBUT6("")
  1.  D PMSG^MAGQBUT6("======================================================================")
  1.  D PMSG^MAGQBUT6("Display the original Network Location file")
  1.  F  S EN=$O(^MAG(2005.2,EN)) Q:'EN  D
  1.  . D PMSG^MAGQBUT6("Entry:"_EN_" "_$G(^MAG(2005.2,EN,0)))
  1.  . Q
  1.  D PMSG^MAGQBUT6("======================================================================")
  1.  Q
  1. REPNAM ;Report residual duplicate names
  1.  N ARRAY,DSITE,EN,EN1,PSITE,TMP
  1.  S (TMP,ARRAY)=""
  1.  F  S TMP=$O(^MAG(2005.2,"B",TMP)) Q:TMP=""  D
  1.  . S (EN,EN1)="",EN=$O(^MAG(2005.2,"B",TMP,"")) S PSITE=$P($G(^MAG(2005.2,EN,0)),U,10)
  1.  . S EN1=EN F  S EN1=$O(^MAG(2005.2,"B",TMP,EN1)) Q:EN1=""  D
  1.  . . S DSITE=$P($G(^MAG(2005.2,EN1,0)),U,10)  I PSITE'=DSITE Q  ;Not the same site.
  1.  . . S ARRAY(TMP,EN1)="",ARRAY(TMP,EN)="" Q
  1.  . Q
  1.  Q:$O(ARRAY(""))=""
  1.  S TMP=""
  1.  D PMSG^MAGQBUT6("The following is a list of residual duplicate names in the Network Location file")
  1.  F  S TMP=$O(ARRAY(TMP)) Q:TMP=""  D
  1.  . S EN="" F  S EN=$O(ARRAY(TMP,EN)) Q:EN=""  D
  1.  . . S SITE=$P($G(^MAG(2005.2,EN,0)),U,10),SITE=$P($G(^MAG(2006.1,SITE,0)),U)
  1.  . . D PMSG^MAGQBUT6("NAME: "_TMP_" "_" IEN: "_EN_" for Imaging division "_SITE)
  1.  . . Q
  1.  . Q
  1.  K ARRAY
  1.  Q
  1. RLOC(LIST,RESULT) ; Delete Network Location file entry
  1.  N DA,DIK,EN,PC,PLACE,APP
  1.  S X="ERR^MAGQBU6A",@^%ZOSF("TRAP")
  1.  S RESULT="1"
  1.  S EN=""  F  S EN=$O(LIST(EN)) Q:EN=""  D
  1.  . F PC=2:1:$L(LIST(EN),U) D
  1.  . . S DA=$P(LIST(EN),U,PC) Q:'DA
  1.  . . S PLACE=$P($G(^MAG(2005.2,DA,0)),U,10)
  1.  . . I '$D(^MAG(2005.2,DA,0)) S RESULT="-1^This is an invalid entry." Q
  1.  . . I $P($G(^MAG(2005.2,DA,0)),U,7)["GRP" Q:'$$GRP(DA,PLACE,.RESULT)
  1.  . . E   I DA=$$CWL^MAGBAPI(PLACE) D  ; Attempt to reset the Current Write location wo an able share within the current group
  1.  . . . N MIN,SPACE,SIZE,IEN,TSPACE,TSIZE,GRP
  1.  . . . S (TSIZE,TSPACE,SPACE,SIZE,IEN,CNT)=0
  1.  . . . S MIN=$$SPARM^MAGQBUT
  1.  . . . S GRP=$$GRP^MAGQBUT(PLACE)
  1.  . . . D FSP^MAGQBUT(MIN,.SPACE,.SIZE,.IEN,.TSPACE,.TSIZE,PLACE,.GRP,DA)
  1.  . . . I IEN>0 D  Q
  1.  . . . . I $$VALRD^MAGQBUT(IEN,PLACE,GRP) D
  1.  . . . . . S APP="Network Location Delete: RAID"
  1.  . . . . . D SCWL^MAGQBUT(IEN,PLACE,GRP,APP,DUZ)
  1.  . . . . . S RESULT="1^The Current Write Location has been reset to: "_IEN
  1.  . . . . . Q
  1.  . . . . E  S RESULT="0^This is invalid share: "_IEN Q
  1.  . . . S RESULT="0^This is the current Write Location and there are no other able members in the current group."
  1.  . . . Q
  1.  . . Q:$P(RESULT,U,1)<1
  1.  . . D GRPEN(DA)
  1.  . . S DIK="^MAG(2005.2,"
  1.  . . D ^DIK
  1.  . . K DIK,DA
  1.  . . Q
  1.  . Q
  1.  Q
  1.  ;
  1. GRP(GRPIEN,PLACE,RESULT) ;
  1.  N GROUP,CWL,APP,RES
  1.  S RES=1
  1.  I GRPIEN=$$GRP^MAGQBUT(PLACE) D  ;Advance RAID Group and reset the Current Write Location
  1.  . S GROUP=$$NXTGP^MAGQBUT(PLACE,GRPIEN)
  1.  . I GROUP=GRPIEN S RESULT="-1^This Network Location is the Current Write Group.",RES=0 Q 
  1.  . S CWL=$O(^MAG(2005.2,GROUP,7,"B",""))
  1.  . I CWL<1 S RESULT="-1^The Current Write Group has no member shares.",RES=0 Q
  1.  . S APP="GRP^MAGQBU6A: Group Delete"
  1.  . D SCWL^MAGQBUT(CWL,PLACE,GROUP,APP,DUZ)
  1.  . Q
  1.  D:RES
  1.  . N INDX
  1.  . S INDX="" F  S INDX=$O(^MAG(2005.2,GRPIEN,7,"B",INDX)) Q:'INDX  D
  1.  . . S $P(^MAG(2005.2,INDX,1),U,8)=""
  1.  . . Q
  1.  . Q
  1.  Q RES
  1. GRPEN(DUPIEN) ;
  1.  ;DUPIEN is the duplicate entry in file 2005.2 being deleted.
  1.  ;This module checks if the duplicate entry is part of a RAID group and
  1.  ;deletes the entry to prevent hanging pointers.
  1.  N DA,DIK,MAGIEN,SITE
  1.  Q:'+$G(DUPIEN)
  1.  S SITE=0 F  S SITE=$O(^MAG(2005.2,"F",SITE)) Q:'SITE  D
  1.  . Q:'$D(^MAG(2005.2,"F",SITE,"GRP"))
  1.  . S MAGIEN=0 F  S MAGIEN=$O(^MAG(2005.2,"F",SITE,"GRP",MAGIEN)) Q:'MAGIEN  D
  1.  . . I $D(^MAG(2005.2,MAGIEN,7,"B",DUPIEN)) D
  1.  . . . N DA,DIK
  1.  . . . S DA=$O(^MAG(2005.2,MAGIEN,7,"B",DUPIEN,0)) Q:'DA
  1.  . . . S DA(1)=MAGIEN,DIK="^MAG(2005.2,"_DA(1)_",7," D ^DIK K DA,DIK
  1.  . . . Q
  1.  . . Q 
  1.  . Q
  1.  Q
  1. RLOCA(RESULT,RLOC) ; Delete Network Location file entry
  1.  ; [RPC:MAGQ DEL NLOC ]
  1.  Q:'$D(^XUSEC("MAG SYSTEM",DUZ))  ; Requires the "MAG SYS" security key
  1.  N LST,RES
  1.  S LST(1)=$P(RLOC,U,2)_U_$P(RLOC,U,2),RES="1"
  1.  D RLOC(.LST,.RES)
  1.  S RESULT=RES
  1.  K LST
  1.  Q 
  1. REQDUP ; Are there duplicate .01 entries? If so rename by adding A,B, etc. 
  1.  N ARRAY,CHAR,CNT,IEN,NAME,NME,NODE,NNAME,MSG,ROUTE,SITE,TYPE
  1.  S NAME="" F  S NAME=$O(^MAG(2005.2,"B",NAME)) Q:NAME=""  D
  1.  . S IEN="",CNT=0 F  S IEN=$O(^MAG(2005.2,"B",NAME,IEN)) Q:'IEN  D
  1.  . . ;GET TYPE ON MAG TYPE WILL BE DUPLICATED.
  1.  . . S NODE=$G(^MAG(2005.2,IEN,0)),TYPE=$P(NODE,"^",7),SITE=$P(NODE,"^",10)
  1.  . . S ROUTE=$P(NODE,"^",9)
  1.  . . ;QUIT IF ROUTER, NOT MAG OR WORM TYPE
  1.  . . Q:ROUTE
  1.  . . Q:NAME["MUSE"
  1.  . . I TYPE["MAG"!(TYPE["WORM") D
  1.  . . . S NME(NAME,SITE)=$G(NME(NAME,SITE))+1
  1.  . . . S ARRAY(NAME,SITE,IEN)=CNT,CNT=CNT+1
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  S SITE=0 F  S SITE=$O(ARRAY(NAME,SITE)) Q:'SITE  D
  1.  . Q:+$G(NME(NAME,SITE))'>1
  1.  . S IEN=0 F  S IEN=$O(ARRAY(NAME,SITE,IEN)) Q:'IEN  D
  1.  . . S CHAR=$G(ARRAY(NAME,SITE,IEN)) Q:'CHAR  S CHAR=(63+CHAR)
  1.  . . S NNAME=NAME_$C(CHAR)
  1.  . . Q:'$D(^MAG(2005.2,IEN,0))
  1.  . . N FDA S FDA(2005.2,IEN_",",.01)=NNAME D UPDATE^DIE("U","FDA")
  1.  . . S ^XTMP("MAGP39","^MAG(2005.2,"_IEN_",0)",1)=NNAME_U_NAME
  1.  . . S MSG="Duplicate named Network Location entry, "_NAME_" was renamed to "_NNAME
  1.  . . D PMSG^MAGQBUT6(MSG)
  1.  . . S (CHAR,NNAME)=""
  1.  . . Q
  1.  . Q
  1.  Q
  1. RESTART ;
  1.  ;Controls the purging of this global at the sites.
  1.  ;^XTMP("MAGP39","DUPSHARE",0)=X_"^"_X2_"^"_"Patch 39 Consolidating Network Locations"
  1.  ;contains the list of duplicate shares to be used to remove dangling network entries.
  1.  ;^XTMP("MAGP39","DUPSHARE","ENTRIES",ENTRY,PATH)= Original ien^nn^nn (nn^nn are the duplicate entries).
  1.  ;set in MAGQBUT6 while processing the entries in file 2005 and 2005.1
  1.  ;^XTMP("MAGP39","DUPSHARE","LAST")=Last ien processed in either 2005 or 2005.1
  1.  ;
  1.  N ARRAY,ENTRY,SHAREDIR
  1.  I '$D(^XMTP("MAGP39","DUPSHARE")) W !,"Nothing to process, global does not exist." H 2 Q
  1.  ;rebuild the list
  1.  I '$D(^XMTP("MAGP39","DUPSHARE","ENTRIES")) D  Q
  1.  . W !,"No duplicate shares information available." H 2
  1.  . Q
  1.  S ENTRY=0 F  S ENTRY=$O(^XMTP("MAGP39","DUPSHARE","ENTRIES",ENTRY)) Q:'ENTRY  D
  1.  . S SHAREDIR="" S SHAREDIR=$O(^XMTP("MAGP39","DUPSHARE","ENTRIES",ENTRY,SHAREDIR)) D:SHAREDIR'=""
  1.  . . S ARRAY(SHAREDIR)=$G(^XMTP("MAGP39","DUPSHARE","ENTRIES",ENTRY,SHAREDIR))
  1.  . . Q
  1.  . Q
  1.  S ENTRY=$G(^XTMP("MAGP39","DUPSHARE","LAST")) Q:'ENTRY
  1.  D RSREF^MAGQBUT6(ARRAY,ENTRY)
  1.  Q
  1. PRINT ;Print out the entries in files 2005 and 2005.1 whose fields were modified by the redundant share job
  1.  ;
  1.  I '$D(^XTMP("MAGP39","IMAGEFILE")) W !,"Sorry, the XTMP global has been cleared, nothing to display. Quitting" H 2 Q
  1.  W !,"Image files 2005, 2005.1 & 2006.035 whose network location was reset as a result of redundant network location entries."
  1.  N POP,ZTDESC,ZTRTN,ZTSK
  1.  S %ZIS="QMP" D ^%ZIS K %ZIS I POP Q
  1.  I '$D(IO("Q")) U IO D STARTPRT Q
  1.  ; task job
  1.  S ZTRTN="STARTPRT^MAGQBU6A",ZTDESC="Patch 39 changes to Image files."
  1.  D ^%ZTLOAD
  1.  W !!,$S(+$D(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.") K IO("Q")
  1.  Q
  1. STARTPRT ;
  1.  N ANS,FILE,FIELD,IEN,HEADING,PAGE,STOP,TEXT,ZTREQ
  1.  S ZTREQ="@"  ;TaskMan utilities to delete the task.
  1.  S:'$G(DTIME) DTIME=600
  1.  S PAGE=0,HEADING="Patch 39 changes to Image files 2005,2005.1 and 2006.035"
  1.  D HDR
  1.  S (STOP,FILE)=0
  1.  F  S FILE=$O(^XTMP("MAGP39","IMAGEFILE",FILE)) Q:'FILE!STOP  D 
  1.  . S IEN=0 F  S IEN=$O(^XTMP("MAGP39","IMAGEFILE",FILE,IEN)) Q:'IEN!STOP  D
  1.  . . S FIELD=0 F  S FIELD=$O(^XTMP("MAGP39","IMAGEFILE",FILE,IEN,FIELD)) Q:'FIELD!STOP  D
  1.  . . . S TEXT=$G(^XTMP("MAGP39","IMAGEFILE",FILE,IEN,FIELD)) D LINE
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  D ^%ZISC
  1.  Q
  1. HDR ;
  1.  W @IOF S PAGE=PAGE+1
  1.  W !?2,HEADING,"  Page: ",PAGE
  1.  W !,?10,"___________________________________",!
  1.  Q
  1. LINE ;Display output
  1.  D HDR:$Y+4>IOSL
  1.  W !,"File: "_FILE_" entry: "_IEN_" was modified by changing "_TEXT
  1.  I $E(IOST,1,2)["C-",$Y+4>IOSL D
  1.  . W !,"Press RETURN to continue or '^' to exit: "
  1.  . R ANS:DTIME S STOP=$S(ANS="^":1,1:0)
  1.  . Q
  1.  Q
  1. ERR ;
  1.  N ERRXX
  1.  S ERRXX=$$EC^%ZOSV
  1.  D ^%ZTER
  1.  D ^XUSCLEAN
  1.  Q
  1.  ;