MAGSDEL5 ;WOIF/JSL - Delete the Not-Used Network Location w/ none ref of IMAGE ; 6/11/2010 10:12am
;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
;; 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
NETLOC(OUT,IN,PLACE,STEP) ;RPC - MAG UTIL CLNLOC
;NETWORK LOCATION 2005.2 to verify 0 reference of IMAGE file 2005
; OUT : result - code,message
; IN : delete network Location IEN
; PLACE : Site Parameter IN
; STEP : Heart beat (M2M)
N ERR,I,IEN0,IEN,IEN9,NO,CNT,X0,XBIG,NO,N
N NETLOC,PHY,NAME,TYP,TL,P
K OUT S OUT(1)="-1",(ERR,TL)=0
I ($G(IN)="")!'$G(PLACE) S OUT(1)="-1, No IEN or PLACE value." Q
S IEN0=+$P(STEP,"#",1),IEN9=+$P(STEP,"#",2),CNT=IEN9-IEN0 S:CNT<1 CNT=1 ;;BEG#END
F N=2:1 S NO=$P(IN,"^",N) Q:'NO D ;;Pre-check selected raid/jb entry
. S X0=$G(^MAG(2005.2,NO,0)) ;;NO - ien of network location
. I X0="" S OUT(1)="-1,Loc #"_IN_" not found",ERR=1 Q
. S TYP=$P(X0,"^",7) ;storage type
. I "MAG^WORM"'[$P(TYP,"-") S OUT(1)="-1,Not the 'MAG' or 'WORM' type location, but(#"_NO_"/"_TYP_")",ERR=1 Q
. Q
I ERR S OUT(1)=OUT(1)_",Network location file #2005.2 issue" Q
S IEN=IEN0 F N=1:1 S IEN=$O(^MAG(2005,IEN)) Q:'IEN!(IEN>IEN9) I N<CNT D
. S X0=$G(^MAG(2005,IEN,0)),XBIG=$G(^MAG(2005,IEN,"FBIG"))
. F N=2:1 S NO=$P(IN,"^",N) Q:'NO D
. . F P=3,4,5 I $P(X0,"^",P)=NO S ERR=1+ERR,TL=TL+1 S:TL<999 OUT(TL+1)="-1,Found IMAGE 2005 IEN "_IEN_" which has a reference to NETWORK LOCATION IEN "_NO_"("_$P($G(^MAG(2005.2,NO,0)),U)_")" Q
. . F P=1,2 I $P(XBIG,"^",P)=NO S ERR=1+ERR,TL=TL+1 S:TL<999 OUT(TL+1)="-1,Found IMAGE 2005 IEN "_IEN_" 'FBIG' which has a reference to NETWORK LOCATION IEN "_NO_"("_$P($G(^MAG(2005.2,NO,0)),U)_")" Q
. Q
I ERR S OUT(1)="-1,Network location cleanup with #2005 IMAGE file reference issue" Q
S IEN=IEN0 F N=1:1 S IEN=$O(^MAG(2005.1,IEN)) Q:'IEN!(IEN>IEN9) I N<CNT D
. S X0=$G(^MAG(2005.1,IEN,0)),XBIG=$G(^MAG(2005.1,IEN,"FBIG"))
. F N=2:1 S NO=$P(IN,"^",N) Q:'NO D
. . F P=3,4,5 I $P(X0,"^",P)=NO S ERR=1+ERR,TL=TL+1 S:TL<999 OUT(TL+1)="-1,Found IMAGE Audit 2005.1 IEN "_IEN_" which has a reference to NETWORK LOCATION IEN "_NO_"("_$P($G(^MAG(2005.2,NO,0)),U)_")" Q
. . F P=1,2 I $P(XBIG,"^",P)=NO S ERR=1+ERR,TL=TL+1 S:TL<999 OUT(TL+1)="-1,Found IMAGE Audit 2005.1 IEN "_IEN_" 'FBIG' which has a reference to NETWORK LOCATION IEN "_NO_"("_$P($G(^MAG(2005.2,NO,0)),U)_")" Q
. Q
I ERR S OUT(1)="-1,Network location cleanup with #2005.1 IMAGE Audit file reference issue" Q
I (ERR=0)&(IEN0=IEN9) D Q ;;0 ref OF #2005 then cleanup
. S OUT(1)=0_",Done "
. F N=2:1 S NO=$P(IN,"^",N) Q:'NO D DELOC(NO,PLACE) S:ERR=0 OUT(1)=OUT(1)_" #"_$P(IN,"^",N)
. Q
I ERR S OUT(1)=OUT(1)_", "_ERR
S OUT(1)="1,NEXT#"_IEN Q ;just to continue - RPC call, next IEN range step
Q
;
DELOC(NN,PLACE) ;
; NN: IEN of 2005.2
; PLACE : IEN of 2006.1
N X,DA
Q:$G(ERR)'=0 Q:+$G(NN)<1 Q:+$G(PLACE)<1
D RLOC(NN) ;FM delete
S OUT(1)="0,Done "_$G(NN)
Q
;
RLOC(NN) ; Delete Network Location file entry
N DA,DIK,NAME,PHY,TYP
S DA=NN I $D(^MAG(2005.2,DA,0)) D
. S NAME=$P(^MAG(2005.2,DA,0),"^"),PHY=$P(^MAG(2005.2,DA,0),"^",2),TYP=$P(^MAG(2005.2,DA,0),"^",7)
. S DIK="^MAG(2005.2,"
. D ^DIK
. I '$D(^MAG(2005.2,DA,0)),$D(^MAG(2005.2,"B",NAME,DA)) K ^MAG(2005.2,"B",NAME,DA)
. I '$D(^MAG(2005.2,DA,0)),(TYP'="") I $D(^MAG(2005.2,"E",TYP,DA)) K ^MAG(2005.2,"E",TYP,DA)
. I '$D(^MAG(2005.2,DA,0)),(PHY'="") I $D(^MAG(2005.2,"AC",PHY,DA)) K ^MAG(2005.2,"AC",PHY,DA)
. D RAIDGR(DA)
. K DIK,DA,NAME
. Q
Q
;
RAIDGR(IEN) ;
;IEN is the 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 DIV,MAGIEN,DIK,DA
Q:'+IEN
S DIV=0 F S DIV=$O(^MAG(2005.2,"F",DIV)) Q:'DIV D:$D(^MAG(2005.2,"F",DIV,"GRP"))
. S MAGIEN=0 F S MAGIEN=$O(^MAG(2005.2,"F",DIV,"GRP",MAGIEN)) Q:'MAGIEN D:$D(^MAG(2005.2,MAGIEN,7,"B",IEN,0))
. . S DA=$O(^MAG(2005.2,MAGIEN,7,"B",IEN,0)) Q:'DA
. . S DA(1)=MAGIEN,DIK="^MAG(2005.2,"_DA(1)_",7,"
. . D ^DIK
. . Q
. Q
Q
;
SHARE(MAGRY,TYPE) ;RPC [MAG UTIL GETNETLOC]
; Get list of current online/offline image shares
;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
N TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
I TYPE="" S TYPE="ALL"
S MAGRY(0)="1^SUCCESS"
S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
. S DATA0=$G(^MAG(2005.2,I,0)) Q:'$L(DATA0)
. S DATA2=$G(^MAG(2005.2,I,2))
. S DATA3=$G(^MAG(2005.2,I,3))
. S DATA6=$G(^MAG(2005.2,I,6))
. S PHYREF=$P(DATA0,"^",2) ; PHYSICAL REFERENCE
. S STYP=$P(DATA0,"^",7) ; STORAGE TYPE
. I TYPE'="ALL" Q:STYP'[TYPE ;filter by TYPE
. S INFO=$S($E(PHYREF,$L(PHYREF))="\":$E(PHYREF,1,$L(PHYREF)-1),1:PHYREF)
. S $P(INFO,"^",2)=$P($G(DATA0),"^",7) ;Physical reference (path)
. S $P(INFO,"^",3)=$P($G(DATA0),"^",6) ;Operational Status 0=OFFLINE 1=ONLINE
. S $P(INFO,"^",4)=$P($G(DATA2),"^",1) ;Username
. S $P(INFO,"^",5)=$P($G(DATA2),"^",2) ;Password
. S $P(INFO,"^",6)=$P($G(DATA6),"^",1) ;MUSE Site #
. I $P($G(DATA6),"^",2)'="" S $P(INFO,"^",7)=^MAG(2006.17,$P(DATA6,"^",2),0) ;MUSE version #
. S $P(INFO,"^",8)=$P($G(DATA3),"^",5) ;Network location SITE
. S $P(INFO,"^",9)=$P($G(DATA0),"^",10) ;PLACE #2006.1
. S $P(INFO,"^",10)=$P($G(DATA0),"^",1) ;Name #2005.2
. Q:$D(TMP(INFO))
. S TMP(INFO)=I ;ien #2005.2
S INFO=""
F S INFO=$O(TMP(INFO)) Q:INFO="" D ;Sort by Physical Ref
. S MAGRY($O(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
K TMP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGSDEL5 6565 printed Dec 13, 2024@02:08:14 Page 2
MAGSDEL5 ;WOIF/JSL - Delete the Not-Used Network Location w/ none ref of IMAGE ; 6/11/2010 10:12am
+1 ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
+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
NETLOC(OUT,IN,PLACE,STEP) ;RPC - MAG UTIL CLNLOC
+1 ;NETWORK LOCATION 2005.2 to verify 0 reference of IMAGE file 2005
+2 ; OUT : result - code,message
+3 ; IN : delete network Location IEN
+4 ; PLACE : Site Parameter IN
+5 ; STEP : Heart beat (M2M)
+6 NEW ERR,I,IEN0,IEN,IEN9,NO,CNT,X0,XBIG,NO,N
+7 NEW NETLOC,PHY,NAME,TYP,TL,P
+8 KILL OUT
SET OUT(1)="-1"
SET (ERR,TL)=0
+9 IF ($GET(IN)="")!'$GET(PLACE)
SET OUT(1)="-1, No IEN or PLACE value."
QUIT
+10 ;;BEG#END
SET IEN0=+$PIECE(STEP,"#",1)
SET IEN9=+$PIECE(STEP,"#",2)
SET CNT=IEN9-IEN0
if CNT<1
SET CNT=1
+11 ;;Pre-check selected raid/jb entry
FOR N=2:1
SET NO=$PIECE(IN,"^",N)
if 'NO
QUIT
Begin DoDot:1
+12 ;;NO - ien of network location
SET X0=$GET(^MAG(2005.2,NO,0))
+13 IF X0=""
SET OUT(1)="-1,Loc #"_IN_" not found"
SET ERR=1
QUIT
+14 ;storage type
SET TYP=$PIECE(X0,"^",7)
+15 IF "MAG^WORM"'[$PIECE(TYP,"-")
SET OUT(1)="-1,Not the 'MAG' or 'WORM' type location, but(#"_NO_"/"_TYP_")"
SET ERR=1
QUIT
+16 QUIT
End DoDot:1
+17 IF ERR
SET OUT(1)=OUT(1)_",Network location file #2005.2 issue"
QUIT
+18 SET IEN=IEN0
FOR N=1:1
SET IEN=$ORDER(^MAG(2005,IEN))
if 'IEN!(IEN>IEN9)
QUIT
IF N<CNT
Begin DoDot:1
+19 SET X0=$GET(^MAG(2005,IEN,0))
SET XBIG=$GET(^MAG(2005,IEN,"FBIG"))
+20 FOR N=2:1
SET NO=$PIECE(IN,"^",N)
if 'NO
QUIT
Begin DoDot:2
+21 FOR P=3,4,5
IF $PIECE(X0,"^",P)=NO
SET ERR=1+ERR
SET TL=TL+1
if TL<999
SET OUT(TL+1)="-1,Found IMAGE 2005 IEN "_IEN_" which has a reference to NETWORK LOCATION IEN "_NO_"("_$PIECE($GET(^MAG(2005.2,NO,0)),U)_")"
QUIT
+22 FOR P=1,2
IF $PIECE(XBIG,"^",P)=NO
SET ERR=1+ERR
SET TL=TL+1
if TL<999
SET OUT(TL+1)="-1,Found IMAGE 2005 IEN "_IEN_" 'FBIG' which has a reference to NETWORK LOCATION IEN "_NO_"("_$PIECE($GET(^MAG(2005.2,NO,0)),U)_")"
QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 IF ERR
SET OUT(1)="-1,Network location cleanup with #2005 IMAGE file reference issue"
QUIT
+25 SET IEN=IEN0
FOR N=1:1
SET IEN=$ORDER(^MAG(2005.1,IEN))
if 'IEN!(IEN>IEN9)
QUIT
IF N<CNT
Begin DoDot:1
+26 SET X0=$GET(^MAG(2005.1,IEN,0))
SET XBIG=$GET(^MAG(2005.1,IEN,"FBIG"))
+27 FOR N=2:1
SET NO=$PIECE(IN,"^",N)
if 'NO
QUIT
Begin DoDot:2
+28 FOR P=3,4,5
IF $PIECE(X0,"^",P)=NO
SET ERR=1+ERR
SET TL=TL+1
if TL<999
SET OUT(TL+1)="-1,Found IMAGE Audit 2005.1 IEN "_IEN_" which has a reference to NETWORK LOCATION IEN "_NO_"("_$PIECE($GET(^MAG(2005.2,NO,0)),U)_")"
QUIT
+29 FOR P=1,2
IF $PIECE(XBIG,"^",P)=NO
SET ERR=1+ERR
SET TL=TL+1
if TL<999
SET OUT(TL+1)="-1,Found IMAGE Audit 2005.1 IEN "_IEN_" 'FBIG' which has a reference to NETWORK LOCATION IEN "_NO_"("_$PIECE($GET(^MAG(2005.2,NO,0)),U)_")"
QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 IF ERR
SET OUT(1)="-1,Network location cleanup with #2005.1 IMAGE Audit file reference issue"
QUIT
+32 ;;0 ref OF #2005 then cleanup
IF (ERR=0)&(IEN0=IEN9)
Begin DoDot:1
+33 SET OUT(1)=0_",Done "
+34 FOR N=2:1
SET NO=$PIECE(IN,"^",N)
if 'NO
QUIT
DO DELOC(NO,PLACE)
if ERR=0
SET OUT(1)=OUT(1)_" #"_$PIECE(IN,"^",N)
+35 QUIT
End DoDot:1
QUIT
+36 IF ERR
SET OUT(1)=OUT(1)_", "_ERR
+37 ;just to continue - RPC call, next IEN range step
SET OUT(1)="1,NEXT#"_IEN
QUIT
+38 QUIT
+39 ;
DELOC(NN,PLACE) ;
+1 ; NN: IEN of 2005.2
+2 ; PLACE : IEN of 2006.1
+3 NEW X,DA
+4 if $GET(ERR)'=0
QUIT
if +$GET(NN)<1
QUIT
if +$GET(PLACE)<1
QUIT
+5 ;FM delete
DO RLOC(NN)
+6 SET OUT(1)="0,Done "_$GET(NN)
+7 QUIT
+8 ;
RLOC(NN) ; Delete Network Location file entry
+1 NEW DA,DIK,NAME,PHY,TYP
+2 SET DA=NN
IF $DATA(^MAG(2005.2,DA,0))
Begin DoDot:1
+3 SET NAME=$PIECE(^MAG(2005.2,DA,0),"^")
SET PHY=$PIECE(^MAG(2005.2,DA,0),"^",2)
SET TYP=$PIECE(^MAG(2005.2,DA,0),"^",7)
+4 SET DIK="^MAG(2005.2,"
+5 DO ^DIK
+6 IF '$DATA(^MAG(2005.2,DA,0))
IF $DATA(^MAG(2005.2,"B",NAME,DA))
KILL ^MAG(2005.2,"B",NAME,DA)
+7 IF '$DATA(^MAG(2005.2,DA,0))
IF (TYP'="")
IF $DATA(^MAG(2005.2,"E",TYP,DA))
KILL ^MAG(2005.2,"E",TYP,DA)
+8 IF '$DATA(^MAG(2005.2,DA,0))
IF (PHY'="")
IF $DATA(^MAG(2005.2,"AC",PHY,DA))
KILL ^MAG(2005.2,"AC",PHY,DA)
+9 DO RAIDGR(DA)
+10 KILL DIK,DA,NAME
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
RAIDGR(IEN) ;
+1 ;IEN is the 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 DIV,MAGIEN,DIK,DA
+5 if '+IEN
QUIT
+6 SET DIV=0
FOR
SET DIV=$ORDER(^MAG(2005.2,"F",DIV))
if 'DIV
QUIT
if $DATA(^MAG(2005.2,"F",DIV,"GRP"))
Begin DoDot:1
+7 SET MAGIEN=0
FOR
SET MAGIEN=$ORDER(^MAG(2005.2,"F",DIV,"GRP",MAGIEN))
if 'MAGIEN
QUIT
if $DATA(^MAG(2005.2,MAGIEN,7,"B",IEN,0))
Begin DoDot:2
+8 SET DA=$ORDER(^MAG(2005.2,MAGIEN,7,"B",IEN,0))
if 'DA
QUIT
+9 SET DA(1)=MAGIEN
SET DIK="^MAG(2005.2,"_DA(1)_",7,"
+10 DO ^DIK
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
SHARE(MAGRY,TYPE) ;RPC [MAG UTIL GETNETLOC]
+1 ; Get list of current online/offline image shares
+2 ;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
+3 NEW TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
+4 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+5 IF TYPE=""
SET TYPE="ALL"
+6 SET MAGRY(0)="1^SUCCESS"
+7 SET I=0
FOR
SET I=$ORDER(^MAG(2005.2,I))
if 'I
QUIT
Begin DoDot:1
+8 SET DATA0=$GET(^MAG(2005.2,I,0))
if '$LENGTH(DATA0)
QUIT
+9 SET DATA2=$GET(^MAG(2005.2,I,2))
+10 SET DATA3=$GET(^MAG(2005.2,I,3))
+11 SET DATA6=$GET(^MAG(2005.2,I,6))
+12 ; PHYSICAL REFERENCE
SET PHYREF=$PIECE(DATA0,"^",2)
+13 ; STORAGE TYPE
SET STYP=$PIECE(DATA0,"^",7)
+14 ;filter by TYPE
IF TYPE'="ALL"
if STYP'[TYPE
QUIT
+15 SET INFO=$SELECT($EXTRACT(PHYREF,$LENGTH(PHYREF))="\":$EXTRACT(PHYREF,1,$LENGTH(PHYREF)-1),1:PHYREF)
+16 ;Physical reference (path)
SET $PIECE(INFO,"^",2)=$PIECE($GET(DATA0),"^",7)
+17 ;Operational Status 0=OFFLINE 1=ONLINE
SET $PIECE(INFO,"^",3)=$PIECE($GET(DATA0),"^",6)
+18 ;Username
SET $PIECE(INFO,"^",4)=$PIECE($GET(DATA2),"^",1)
+19 ;Password
SET $PIECE(INFO,"^",5)=$PIECE($GET(DATA2),"^",2)
+20 ;MUSE Site #
SET $PIECE(INFO,"^",6)=$PIECE($GET(DATA6),"^",1)
+21 ;MUSE version #
IF $PIECE($GET(DATA6),"^",2)'=""
SET $PIECE(INFO,"^",7)=^MAG(2006.17,$PIECE(DATA6,"^",2),0)
+22 ;Network location SITE
SET $PIECE(INFO,"^",8)=$PIECE($GET(DATA3),"^",5)
+23 ;PLACE #2006.1
SET $PIECE(INFO,"^",9)=$PIECE($GET(DATA0),"^",10)
+24 ;Name #2005.2
SET $PIECE(INFO,"^",10)=$PIECE($GET(DATA0),"^",1)
+25 if $DATA(TMP(INFO))
QUIT
+26 ;ien #2005.2
SET TMP(INFO)=I
End DoDot:1
+27 SET INFO=""
+28 ;Sort by Physical Ref
FOR
SET INFO=$ORDER(TMP(INFO))
if INFO=""
QUIT
Begin DoDot:1
+29 SET MAGRY($ORDER(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
End DoDot:1
+30 KILL TMP
+31 QUIT
