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