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

MAGSFTCH.m

Go to the documentation of this file.
  1. MAGSFTCH ;WOIFO/JSL - IMAGE STORAGE COPY UTILITY PROGRAM ; July 01, 2010 1:06 PM
  1. ;;3.0;IMAGING;**98**;Mar 19, 2002;Build 1849;Sep 22, 2010
  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. FETCH(OUT,MAGIEN,DATE,NETLOC) ;RPC = MAG STORAGE FETCH
  1. ;; OUT() : result - code,message
  1. ;; for example: OUT(1) = "0, Done", OUT(1)= "Ien1: Ien2, copy command line"
  1. ;; MAGIEN : fetching IEN (start ien) | (stop ien)
  1. ;; DATE : image saved date (start date) | (stop date)
  1. ;; NETLOC : FROM | TO - network location | remove source file | WinZip option
  1. N CNT,CMD,DT1,DT2,DTOUT,ENDIM,EXT,FILE,FNAME,FROM,FRMLOC,IEN1,IEN2,IM,IN,IN1,IN2,JBLOC,LOC,LOCN,LNO
  1. N M,MOVOLD,WZIP,NTLOC,OK,PS,PLACE,RDLOC,SITE,START,STOP,STYP,TLOC,TO,TP,X,X0,X1,X2,XBIG,Y,WRTLOC,LOGTIME,BTMOUT
  1. K OUT S OUT(1)=0,OK=0,U="^",LNO=0
  1. S LOGTIME=$$NOW^XLFDT(),BTMOUT=+$P(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),"KEYS"),U,2) I $G(XWBTIME) S:BTMOUT>XWBTIME BTMOUT=XWBTIME ;broker time out
  1. I $G(MAGIEN) S:'$G(DATE) DATE=$P($$NOW^XLFDT,"."),DT2="2800101" S IM=+$G(MAGIEN),ENDIM=$P($G(MAGIEN),":",2) ;ien range - IM ~ ENDIM
  1. E S DATE=$G(DATE),DT2=$P(DATE,"|",2),DATE=+DATE ;DT2 fetch end date
  1. ;DATE range iens, find one
  1. I '$G(IM) S IM=$S($G(DATE):$$FINDIEN(DATE),1:$O(^MAG(2005," "),-1))
  1. I '$G(ENDIM) S ENDIM=$S($G(DT2):$$FINDIEN(DT2),$G(DATE):$$FINDIEN(DATE-1),1:0)
  1. NEXT ;IEN range in reverse order, find matched IEN to fetch/copy
  1. S X0=$G(^MAG(2005,IM,0))
  1. I $P(X0,U,2)'["." I IM>1 F CNT=1:1:100000 S IM=$O(^MAG(2005,IM),-1) Q:'IM!(IM<ENDIM) S X0=$G(^MAG(2005,IM,0)) I $P(X0,U,2)["." Q ;find next
  1. I IM I ($$NOW^XLFDT-$G(^MAG(2005,IM,2)))<1 S IM=$O(^MAG(2005,IM),-1) G NEXT ;exclude today image(s) IM
  1. I (IM'<ENDIM),($P(X0,U,2)[".") D FETCH1
  1. I OK S OUT(1)=IM_":"_ENDIM_",CMD summit "_LNO_U_WRTLOC_U_$G(FRMLOC)_U_DT1_U_$G(MOVOLD)_"@"_DATE_"|"_DT2_"|"_$G(STYP)_"|"_FNAME_"|"_+$G(XBIG,0)
  1. I $P(OUT(1),",",1)=-1 Q ;error occured
  1. I 'OK I ($$FMDIFF^XLFDT($$NOW^XLFDT(),LOGTIME,2)+1)>$G(BTMOUT) D Q ;before BK time out, still not finding any image
  1. . S OUT(1)="-2,Cannot find image file on selected Source location to copy within IEN range("_IM_"~"_+$G(MAGIEN)_") after broker timeout"_$S($G(BTMOUT):" of "_BTMOUT_" sec.",1:".")
  1. . Q
  1. I 'OK,$G(OUT(2))="" S IM=$O(^MAG(2005,IM),-1) K OUT(2) G:IM>0 NEXT
  1. S:IM<1 OUT(1)=0_",Done"
  1. Q
  1. ;
  1. FETCH1 ;Find the image file from share
  1. S XBIG=$G(^MAG(2005,IM,"FBIG"))
  1. S X2=$G(^MAG(2005,IM,2)),DT1=$P(X2,U) ;D/T image saved
  1. I DT1 I DT1<DT2 S:(DT1-DATE)<-1 IM=-1 Q ;early than fetch end date, or stop the loop $O()
  1. S OUT(1)=IM_":"_ENDIM ;last fetching IEN
  1. S LNO=1 ;LN number of OUT()
  1. S SITE=$P($G(^MAG(2005,IM,100)),U,3) ;SITE ID
  1. S PLACE=+$S(SITE:$O(^MAG(2006.1,"B",SITE,0)),1:$O(^MAG(2006.1,0))) S:'PLACE PLACE=1
  1. S FRMLOC=+$P($G(NETLOC),"|"),WRTLOC=+$P($G(NETLOC),"|",2),MOVOLD=$P($G(NETLOC),"|",3),WZIP=$P($G(NETLOC),"|",4)
  1. I WRTLOC="" S OUT(1)="-1,Can't Find 'TO' write network location" Q
  1. S FNAME=$P(X0,U,2),FILE=$P(FNAME,"."),EXT=$P(FNAME,".",2) Q:FILE=""
  1. I $L(FILE)>8 I $L(FILE)'=14 I FRMLOC=$P(X0,U,3) D MAGFIX93(.OUT,IM) S X0=^MAG(2005,IM,0),FNAME=$P(X0,U,2),FILE=$P(FNAME,".") ;valid 8.3, 14.3
  1. I FRMLOC=$P(X0,U,5) D FULL Q
  1. I FRMLOC=$P(X0,U,3) D FULL Q
  1. I FRMLOC=$P(X0,U,4) D FULL Q
  1. I $L(XBIG) I (FRMLOC=$P(XBIG,U))!(FRMLOC=$P(XBIG,U,2)) D FULL Q
  1. I $P($G(NETLOC),"|")="*" D ALLCPY Q
  1. E I (FRMLOC'=$P(X0,U,3))&(FRMLOC'=$P(X0,U,5)) S OK=0,OUT(1)=0,OUT(2)="" Q ;Not on selected share
  1. S:'WRTLOC WRTLOC=$P($G(^MAG(2006.1,PLACE,0)),U,3) ;current write location vs Site ID
  1. I 'WRTLOC S OUT(1)="-1,Can't Find Current Write Location for ("_MAGIEN_")" Q
  1. Q
  1. ;
  1. ALLCPY ;copy ALL set image files to JB
  1. N MKDIR,X1,NO S LNO=$S($D(OUT(2)):$O(OUT(" "),-1),1:2)
  1. S LOCN=$P(XBIG,U) S:LOCN LOCN(LOCN)=1 F PS=3,4 S LOCN=$P(X0,U,PS) S:LOCN LOCN(LOCN)=PS ;all possible RAID loc
  1. I '$O(LOCN(0)) S OUT(1)="-1,Can't Find Current Image Location for ("_MAGIEN_")" Q
  1. S LOCN=0 F S LOCN=$O(LOCN(LOCN)) Q:'LOCN D
  1. . S LOC=$G(^MAG(2005.2,LOCN,0)) Q:'$L(LOC)
  1. . I LOCN I LOCN'=$P(X0,U,5) I LOCN'=$P(X0,U,3) Q ;not on RAID share nor JB
  1. . S STYP=$S($P(LOC,U,7)="MAG":"R",1:"J") ;storage type
  1. . I $P(^MAG(2005.2,LOCN,0),U,10) Q:PLACE'=$P(^MAG(2005.2,LOCN,0),U,10) ;chk PLACE
  1. . S TLOC=$G(^MAG(2005.2,WRTLOC,0)) Q:'$L(TLOC)
  1. . I $P(TLOC,U,8)'="Y" S OUT(1)="-1,WRITE Location is not hashed" Q
  1. . S STYP="RJ"
  1. . S JBLOC=$P(LOC,U,2),RDLOC=$P(^MAG(2005.2,WRTLOC,0),U,2) ;phyical location
  1. . S FROM=$$DIRHASH^MAGFILEB(FNAME,LOCN),FROM=$$CHKDIR(FROM) ;JB hash dir
  1. . S TO=$$DIRHASH^MAGFILEB(FNAME,WRTLOC),TO=$$CHKDIR(TO) ;RD hash dir
  1. . I '$G(MKDIR) D
  1. . . S:'$D(OUT(2)) OUT(2)="DIR "_JBLOC_FROM_FILE_".*" ;chk file exist
  1. . . I $F(TO,"\") F NO=1:1 S X1=$P(TO,"\",NO) Q:X1="" S LNO=LNO+1,OUT(LNO)="MKDIR "_RDLOC_$P(TO,"\",1,NO)
  1. . . E S LNO=LNO+1,OUT(LNO)="MKDIR "_RDLOC_TO
  1. . . S MKDIR=1 ;create hash folder
  1. . . Q
  1. . D @STYP
  1. Q
  1. ;
  1. FULL ;copy all images full set
  1. N X1,NO S LNO=$S($D(OUT(2)):$O(OUT(" "),-1),1:2)
  1. S LOCN=FRMLOC S:'LOCN LOCN=$P(X0,U,5) S:'LOCN LOCN=$P(X0,U,3) S:'LOCN LOCN=$P(X0,U,4) Q:'LOCN
  1. S LOC=$G(^MAG(2005.2,LOCN,0)) Q:'$L(LOC)
  1. I LOCN I LOCN'=$P(X0,U,5) I LOCN'=$P(X0,U,3) I LOCN'=$P(X0,U,4) I '(FRMLOC=$P(XBIG,U)) I '(FRMLOC=$P(XBIG,U,2)) Q ;not on RAID share nor JB
  1. S STYP=$S($P(LOC,U,7)="MAG":"R",1:"J") ;storage type
  1. I $P(^MAG(2005.2,LOCN,0),U,10) Q:PLACE'=$P(^MAG(2005.2,LOCN,0),U,10) ;chk PLACE
  1. S TLOC=$G(^MAG(2005.2,WRTLOC,0)) Q:'$L(TLOC)
  1. I $P(TLOC,U,8)'="Y" S OUT(1)="-1,WRITE Location is not hashed" Q
  1. S STYP=STYP_$S($P(TLOC,U,7)="MAG":"R",1:"J")
  1. S JBLOC=$P(LOC,U,2),RDLOC=$P(^MAG(2005.2,WRTLOC,0),U,2) ;phyical location
  1. S FROM=$$DIRHASH^MAGFILEB(FNAME,LOCN),FROM=$$CHKDIR(FROM) ;JB hash dir
  1. S TO=$$DIRHASH^MAGFILEB(FNAME,WRTLOC),TO=$$CHKDIR(TO) ;RD hash dir
  1. S:'$D(OUT(2)) OUT(2)="DIR "_JBLOC_FROM_FILE_".*" ;chk file exist
  1. I $F(TO,"\") F NO=1:1 S X1=$P(TO,"\",NO) Q:X1="" S LNO=LNO+1,OUT(LNO)="MKDIR "_RDLOC_$P(TO,"\",1,NO)
  1. E S LNO=LNO+1,OUT(LNO)="MKDIR "_RDLOC_TO ;create hashed dir
  1. I '(FRMLOC=$P(XBIG,U)) I '(FRMLOC=$P(XBIG,U,2)) S XBIG="" ;no BIG copy
  1. D @STYP
  1. Q
  1. ;
  1. STYP ;; COPY image - JB->RAID (e.g.:Fetching JB)
  1. ;; JB->JB (e.g.:Hashing/Media Copy)
  1. ;; RAID->JB (e.g.:Archive JB)
  1. ;; RAID->RAID (e.g.: Media Copy)
  1. JR ;JB to RAID
  1. D COPYCMD
  1. S OK=1
  1. Q
  1. ;
  1. JJ ;JB to JB
  1. D COPYCMD
  1. S OK=1
  1. Q
  1. ;
  1. RJ ;RAID to JB
  1. I $G(MOVOLD)=1 D MOVECMD S OK=1 Q
  1. D COPYCMD
  1. S OK=1
  1. Q
  1. ;
  1. RR ;RAID to RAID
  1. I $G(MOVOLD)=1 D MOVECMD S OK=1 Q
  1. D COPYCMD
  1. S OK=1
  1. Q
  1. COPYCMD ;create each copy cmd line for GUI (called by FETCH1/JR/JJ/RJ/RR)
  1. N SRC S CMD="",SRC=$$CHKSRC(STYP,X0,$G(XBIG))
  1. I $P(SRC,U,1) S CMD="COPY/Y /V "_JBLOC_FROM_FILE_".TXT "_RDLOC_TO_FILE_".TXT ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,2) S CMD="COPY/Y /V "_JBLOC_FROM_FILE_".ABS "_RDLOC_TO_FILE_".ABS ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,3) S CMD="COPY/Y /V "_JBLOC_FROM_FILE_"."_EXT_" "_RDLOC_TO_FILE_"."_EXT_" ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,4) S CMD="COPY/Y /V "_JBLOC_FROM_FILE_".BIG "_RDLOC_TO_FILE_".BIG ",LNO=LNO+1,OUT(LNO)=CMD
  1. I CMD="" S OUT(1)="-1,Can't find image set for IEN("_MAGIEN_")" Q
  1. Q
  1. MOVECMD ;create each Move cmd line for GUI
  1. N SRC S CMD="",SRC=$$CHKSRC(STYP,X0,$G(XBIG))
  1. I $P(SRC,U,1) S CMD="MOVE/Y "_JBLOC_FROM_FILE_".TXT "_RDLOC_TO_FILE_".TXT ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,2) S CMD="MOVE/Y "_JBLOC_FROM_FILE_".ABS "_RDLOC_TO_FILE_".ABS ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,3) S CMD="MOVE/Y "_JBLOC_FROM_FILE_"."_EXT_" "_RDLOC_TO_FILE_"."_EXT_" ",LNO=LNO+1,OUT(LNO)=CMD
  1. I $P(SRC,U,4) S CMD="MOVE/Y "_JBLOC_FROM_FILE_".BIG "_RDLOC_TO_FILE_".BIG ",LNO=LNO+1,OUT(LNO)=CMD
  1. I CMD="" S OUT(1)="-1,Can't find image set for IEN("_MAGIEN_")" Q
  1. Q
  1. CHKSRC(STYP,X0,XBIG) ;check if source files exist for copy
  1. ;; STYP = storage types, X0 = 2005 entry, XBIG = 2005 FBIG entry
  1. N ABS,BIG,TGA,TXT S (ABS,BIG,TGA,TXT)=0
  1. I (STYP="RR") S:(LOCN=$P(X0,U,3)) (TXT,TGA)=1 S:(LOCN=$P(X0,U,4)) (TXT,ABS)=1 S:(LOCN=$P(XBIG,U)) (TXT,BIG)=1
  1. I (STYP="RJ") S:(LOCN=$P(X0,U,3))!(LOCN=$P(X0,U,4)) (TGA,ABS,TXT)=1 S:(LOCN=$P(XBIG,U)) (TXT,BIG)=1
  1. I (STYP="JJ") S:(LOCN=$P(X0,U,5)) (TGA,ABS,TXT)=1 S:(LOCN=$P(XBIG,U,2)) (TXT,BIG)=1
  1. I (STYP="JR") S:(LOCN=$P(X0,U,5)) (TGA,ABS,TXT)=1 S:(LOCN=$P(XBIG,U,2)) (TXT,BIG)=1
  1. Q TXT_U_ABS_U_TGA_U_BIG
  1. ;---------------------------------------------------------------------
  1. SETLOC(OUT,IM,NTLOC) ;RPC = MAG STORAGE FETCH SET
  1. ;; Set the RAID location piece(NTLOC) in MAG(2005,IM includes 3,4 & FBIG
  1. ;; OUT(1)= 1 success | IM = ien IMAGE file #2005
  1. ;; 0 no action | NTLOC = network loction ien+(opt:overwrt "*" full or "@" .ABS or "b" .BIG) + (| source location)
  1. ;; -1 error |
  1. N OK,X,XBIG,Y,SRC
  1. K OUT S OUT(1)=0,OK=0,U="^"
  1. S SRC=+$P($G(NTLOC),"|",2) ;source location ien
  1. I '$G(IM) S OUT(1)="-1,No IMAGE IEN Specified ("_$G(IM)_")" Q
  1. I $G(NTLOC)="" S OUT(1)="-1,No Network Location Specified" Q
  1. S X=$G(^MAG(2005.2,+NTLOC,0)) Q:$P(X,U,9) ;no Set for router
  1. I $P(X,U,2)="" S OUT(1)="-1,Invalid Network Location "_NTLOC Q
  1. I $P(X,U,7)["WORM" D SETJBL Q
  1. I $P(X,U,7)'="MAG" S OUT(1)="0,Not a RAID/MAG nor a JB/WORM NETWORK LOCATION type - IEN "_NTLOC Q
  1. S (X,Y)=$G(^MAG(2005,IM,0)) I X="" S OUT(1)="-1,No IMAGE File entry - IEN "_IM Q
  1. S XBIG=$G(^MAG(2005,IM,"FBIG"))
  1. I SRC>0 D Q ;with the file(s) source info, use it to set RAID pt
  1. . I ($P(X,U,4)=SRC)!($P(X,U,5)=SRC) S $P(Y,U,4)=+NTLOC,OK=1 ;ABS
  1. . I ($P(X,U,3)=SRC)!($P(X,U,5)=SRC) S $P(Y,U,3)=+NTLOC,OK=1 ;full
  1. . I OK S ^MAG(2005,IM,0)=Y,OUT(1)="1,Set RAID pointer for 2005 IMAGE IEN "_IM
  1. . I ($P(XBIG,U)=SRC)!($P(XBIG,U,2)=SRC) S $P(^MAG(2005,IM,"FBIG"),"^")=+NTLOC,OUT(1)=$S(OK:OUT(1)_" w/FBIG",1:"1,Set RAID(FBIG) pointer for 2005 IMAGE IEN "_IM)
  1. . Q
  1. I (NTLOC["b") G SETLOC4B ;BIG file only
  1. I (NTLOC["@") S $P(Y,U,4)=+NTLOC,OK=1 ;set ABS only
  1. E D
  1. . I '$P(X,U,4)!(NTLOC["*") S:'(NTLOC["r") $P(Y,U,4)=+NTLOC,OK=1 ;r : p3 only
  1. . I '$P(X,U,3)!(NTLOC["*")!(NTLOC["r") S $P(Y,U,3)=+NTLOC,OK=1 ;set FULL
  1. . Q
  1. I OK S ^MAG(2005,IM,0)=Y,OUT(1)="1,Set RAID pointer for 2005 IMAGE IEN ,"_IM
  1. I OK=0,$P(X,U,3) I (+NTLOC)'=$P(X,U,3) S OUT(1)="-1,Not setting #"_NTLOC_" already exist other network location #"_$P(X,U,3) Q
  1. Q:XBIG=""!(XBIG="^")!(NTLOC["@") ;no BIG file to set
  1. SETLOC4B ;BIG file RAID
  1. S $P(^MAG(2005,IM,"FBIG"),"^")=+NTLOC,OUT(1)=$S(OK:OUT(1)_" w/FBIG",1:"1,Set RAID(FBIG) pointer for 2005 IMAGE IEN "_IM)
  1. Q
  1. ;
  1. SETJBL ;SET JB location
  1. I '$G(NTLOC)="" S OUT(1)="-1,No Network Location Specified" Q
  1. S (X,Y)=$G(^MAG(2005,IM,0)) I X="" S OUT(1)="-1,No Image File"_IM Q
  1. S XBIG=$G(^MAG(2005,IM,"FBIG"))
  1. I SRC>0 D Q ;with the source info, use it to set new jukebox pt
  1. . I ($P(X,U,3)=SRC)!($P(X,U,4)=SRC)!($P(X,U,5)=SRC) S $P(Y,U,5)=+NTLOC,OK=1 ;JB
  1. . I OK S ^MAG(2005,IM,0)=Y,OUT(1)="1,Set JB pointer for 2005 IMAGE IEN "_IM
  1. . I ($P(XBIG,U)=SRC)!($P(XBIG,U,2)=SRC) S $P(^MAG(2005,IM,"FBIG"),"^",2)=+NTLOC,OUT(1)=$S(OK:OUT(1)_" w/FBIG",1:"1,Set JB(FIBG) pointer for 2005 IMAGE IEN "_IM)
  1. . Q
  1. I $P(X,U,5)'=NTLOC S $P(Y,U,5)=+NTLOC,OK=1 ;set FULL
  1. I OK S ^MAG(2005,IM,0)=Y,OUT(1)="1,Set JB pointer for 2005 IMAGE IEN "_IM
  1. Q:XBIG=""!(XBIG="^") ;no BIG
  1. I SRC>0 I $P(XBIG,U)'=SRC I $P(XBIG,U,2)'=SRC Q ;not same source loc
  1. S $P(^MAG(2005,IM,"FBIG"),"^",2)=+NTLOC,OUT(1)=$S(OK:OUT(1)_" w/FBIG",1:"1,Set JB(FIBG) pointer for 2005 IMAGE IEN "_IM)
  1. Q
  1. ;
  1. FINDIEN(DT1) ; Find last IEN mark(IN) to process on DT1
  1. S IN1=0,IN2=$O(^MAG(2005,"A"),-1),IN=(IN1+IN2)\2
  1. LOOP ;check image saved date
  1. S Y=$G(^MAG(2005,IN,2)) I Y="" S IN=IN+1 I IN<IN2 G LOOP
  1. I +Y>DT1 S IN2=IN,IN=(IN1+IN2)\2
  1. E S IN1=IN,IN=(IN1+IN2)\2
  1. I IN1'=IN,IN2'=IN G LOOP
  1. Q IN
  1. ;
  1. MAGFIX93(OUT,IEN) ;API - MAG UTIL FIX9.3, fix 9.3 10.3 file format (call by FETCH1)
  1. ;; OUT() : result - DOS commands to rename(move) the 9.3 or 10.3 file name to 14.3
  1. ;; for example: OUT(1) = "move abc123456.abs abc0\00\00\12\34\abc00000123456.abs"
  1. ;; IEN : image file IEN
  1. ;;
  1. N NWNAME,NO,OFNAME,X,Y,LOCN,LOC,ODIR,EXT,NFNAME,NDIR,CMD,DIE,DA,DR,EXT1,CMD,X1,SITE
  1. S:'$D(U) U="^"
  1. S SITE=+$P($G(^MAG(2005,IEN,100)),U,3) ;SITE ID
  1. S:'$D(PLACE) PLACE=+$S(SITE:$O(^MAG(2006.1,"B",SITE,0)),1:$O(^MAG(2006.1,0))) S:'PLACE PLACE=1
  1. S LNO=2,NWNAME=$P(^MAG(2006.1,PLACE,0),U,2) ;current site namespace
  1. S X=$G(^MAG(2005,IEN,0)) I $L(X) D
  1. . S Y=$P(X,U,2) Q:Y="" ;GROUP no file reference
  1. . S OFNAME=$P(Y,".") I ($L(OFNAME)=8)!(OFNAME="")!($L(OFNAME)=14) Q ;8.3 14.3 format
  1. . S LOCN=$P(X,U,3) Q:'LOCN ;RAID location
  1. . ;;I $P(X,U,5) Q ;don't change file name w/ JB(WORM) copy
  1. . S LOC=$P($G(^MAG(2005.2,LOCN,0)),U,2) Q:'$L(LOC)
  1. . S ODIR=$$DIRHASH(OFNAME,LOCN),ODIR=$$CHKDIR(ODIR)
  1. . S EXT=$P(Y,".",2) Q:EXT="" ;no extn?
  1. . S NFNAME=NWNAME_$$PRE0(IEN)_IEN ;correct img file name
  1. . S NDIR=$$DIRHASH(NFNAME,LOCN),NDIR=$$CHKDIR(NDIR)
  1. . S OUT(2)="DIR "_LOC_ODIR_OFNAME_".*" ;chk file exist
  1. . I $F(NDIR,"\") F NO=1:1 S X1=$P(NDIR,"\",NO) Q:X1="" S LNO=LNO+1,OUT(LNO)="MKDIR "_LOC_$P(NDIR,"\",1,NO) ; make sub dir
  1. . E S LNO=LNO+1,OUT(LNO)="MKDIR "_LOC_NDIR
  1. . S EXT1="" F EXT1="ABS","TXT","BIG",EXT D ;copy all possible extn types
  1. . . I EXT1="BIG" I ($G(XBIG)="")!($G(XBIG)="^") Q
  1. . . S LNO=LNO+1,OUT(LNO)="MOVE/Y "_LOC_ODIR_OFNAME_"."_EXT1_" "_LOC_NDIR_NFNAME_"."_EXT1
  1. . . Q
  1. . S DA=+IEN,DR="1///"_NFNAME_"."_EXT,DIE="^MAG(2005," D ^DIE ;chg "F" X-REF
  1. . D ENTRY^MAGLOG("MAG UTIL",$G(DUZ),IEN,"MAG UTIL FIX9.3","","1",OFNAME_"=>"_NFNAME)
  1. . Q
  1. Q
  1. ;
  1. PRE0(IEN) ;pre '0' for 14 characters => Namespace_nnnnnnnn_ien'
  1. N NO,J
  1. S:$G(NWNAME)="" NWNAME=$P(^MAG(2006.1,PLACE,0),"^",2)
  1. S NO="" F J=1:1:(14-$L(IEN)-$L(NWNAME)) S NO=NO_"0"
  1. Q NO
  1. ;
  1. CHKDIR(DIR) ; chk "\\"
  1. N L S L=$L(DIR) I $E(DIR,L-1,L)="\\" S DIR=$E(DIR,1,L-1) ;trim \\ at end
  1. Q DIR
  1. ;
  1. DIRHASH(FILENAME,NETLOCN) ; determine the hierarchical file directory hash
  1. ; Input Variables:
  1. ; FILENAME -- the name of the file, with or without the extension
  1. ; NETLOCN --- the network location file internal entry number
  1. ; Return Value: the hierarchical file directory hash
  1. N FN,HASHFLAG,HASH,I
  1. S HASHFLAG=$P(^MAG(2005.2,NETLOCN,0),"^",8)
  1. I HASHFLAG="Y" D ; calculate the hierarchical directory hash
  1. . ; for an 8.3 filename AB123456.XYZ, the directory hash is AB\12\34
  1. . ; for a 14.3 filename BALT1234567890.XYZ, its BALT\12\34\56\78
  1. . S FN=$P(FILENAME,".") ; strip off the extension
  1. . I $L(FN)=8 S HASH=$E(FN,1,2)_"\"_$E(FN,3,4)_"\"_$E(FN,5,6)
  1. . E S HASH=$E(FN,1,4) F I=5,7,9,11 S HASH=HASH_"\"_$E(FN,I,I+1)
  1. . S HASH=HASH_"\" ; add the trailing directory separator
  1. . Q
  1. E S HASH="" ; flat directory structure, no hierarchical hashing
  1. Q HASH