- 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 Mar 13, 2025@21:13:11 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
