MAGDROUT ;WOIFO/EdM - Copy routine code ; 01/29/2004 11:59
;;3.0;IMAGING;**10,36**;13-February-2004
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
; This routine can be used to copy code from the VistA system
; to a DICOM Gateway computer.
;
; The entry point VISTA collects the software from the live system
; and stores it in ^MAGD.
;
; The entry point DICOM takes the software from the global variable
; and stores it in the local system.
Q
;
VISTA D SAVE(1)
Q
;
SILENT D SAVE(0)
Q
;
SAVE(VERBOSE) ; Collect active code
N D0,D1,I,N,R,X
S VERBOSE=+$G(VERBOSE),N=0
;
; From Kernel:
F R="XLFDT","XUSRB1","XUMF333" S R(R)=""
; From Radiology 5.0
F R="RARIC","RARTE2","RAUTL","RAUTL1","RAUTL2","RAUTL20","RAUTL3","RAUTL5","RAXREF" S R(R)=""
; From MAS
F R="VADPT","VADPT0","VADPT1","VADPT2","VADPT3","VADPT30","VADPT31","VADPT32","VADPT4","VADPT5","VADPT6","VADPT60","VADPT61","VADPT62" S R(R)=""
; From TIU
F R="TIULC1","TIULS","TIUSRVPL" S R(R)=""
; From Medicine
S R="MCUIMAG0",R(R)=""
;
; Store the code from the routines:
W !!,"Saving source code for Imaging..."
W:VERBOSE !!,"Now copying:",!
S R="" F S R=$O(R(R)) Q:R="" D
. N %
. W:VERBOSE !,R,?15 S N=N+1
. D NOW^%DTC
. S D0=$O(^MAGD(2006.79,"B",R,"")) D:'D0
. . L +^MAGD(2006.79)
. . S X=$G(^MAGD(2006.79,0)),$P(X,"^",1,2)="DICOM ROUTINE COPY^2006.79"
. . S D0=$O(^MAGD(2006.79," "),-1)+1
. . S ^MAGD(2006.79,D0,0)=R_"^"_%,^MAGD(2006.79,"B",R,D0)=""
. . S $P(X,"^",3)=D0,$P(X,"^",4)=$P(X,"^",4)+1
. . S ^MAGD(2006.79,0)=X
. . L -^MAGD(2006.79)
. . Q
. S X=$G(^MAGD(2006.79,D0,0)),$P(X,"^",2)=%
. L +^MAGD(2006.79,D0)
. K ^MAGD(2006.79,D0,1)
. S D1=0 F I=1:1 S X=$T(+I^@R) Q:X="" S D1=D1+1,^MAGD(2006.79,D0,1,D1,0)=X
. S ^MAGD(2006.79,D0,1,0)="^2006.791^"_D1_"^"_D1
. L -^MAGD(2006.79,D0)
. I VERBOSE W $J(D1,4)," line" W:D1'=1 "s"
. Q
W !,"Code saved for ",N," routine" W:N'=1 "s" W "."
Q
;
DICOM ; Restore routines in DICOM environment
;N D0,D1,L,N,R,S,X
S R="" F S R=$O(^MAGD(2006.79,"B",R)) Q:R="" D
. S D0="" F S D0=$O(^MAGD(2006.79,"B",R,D0)) Q:D0="" D
. . W !,R,?15
. . S X="ZR S D1=0 F S D1=$O(^MAGD(2006.79,D0,1,D1)),L="""" S:D1 L=^MAGD(2006.79,D0,1,D1,0),N=D1 ZI:L'="""" L I 'D1 ZS "_R_" ZL "_$T(+0)_" Q"
. . X X
. . W $J(N,4)," line" W:N'=1 "s"
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDROUT 3323 printed Dec 13, 2024@02:01:19 Page 2
MAGDROUT ;WOIFO/EdM - Copy routine code ; 01/29/2004 11:59
+1 ;;3.0;IMAGING;**10,36**;13-February-2004
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 ; This routine can be used to copy code from the VistA system
+18 ; to a DICOM Gateway computer.
+19 ;
+20 ; The entry point VISTA collects the software from the live system
+21 ; and stores it in ^MAGD.
+22 ;
+23 ; The entry point DICOM takes the software from the global variable
+24 ; and stores it in the local system.
+25 QUIT
+26 ;
VISTA DO SAVE(1)
+1 QUIT
+2 ;
SILENT DO SAVE(0)
+1 QUIT
+2 ;
SAVE(VERBOSE) ; Collect active code
+1 NEW D0,D1,I,N,R,X
+2 SET VERBOSE=+$GET(VERBOSE)
SET N=0
+3 ;
+4 ; From Kernel:
+5 FOR R="XLFDT","XUSRB1","XUMF333"
SET R(R)=""
+6 ; From Radiology 5.0
+7 FOR R="RARIC","RARTE2","RAUTL","RAUTL1","RAUTL2","RAUTL20","RAUTL3","RAUTL5","RAXREF"
SET R(R)=""
+8 ; From MAS
+9 FOR R="VADPT","VADPT0","VADPT1","VADPT2","VADPT3","VADPT30","VADPT31","VADPT32","VADPT4","VADPT5","VADPT6","VADPT60","VADPT61","VADPT62"
SET R(R)=""
+10 ; From TIU
+11 FOR R="TIULC1","TIULS","TIUSRVPL"
SET R(R)=""
+12 ; From Medicine
+13 SET R="MCUIMAG0"
SET R(R)=""
+14 ;
+15 ; Store the code from the routines:
+16 WRITE !!,"Saving source code for Imaging..."
+17 if VERBOSE
WRITE !!,"Now copying:",!
+18 SET R=""
FOR
SET R=$ORDER(R(R))
if R=""
QUIT
Begin DoDot:1
+19 NEW %
+20 if VERBOSE
WRITE !,R,?15
SET N=N+1
+21 DO NOW^%DTC
+22 SET D0=$ORDER(^MAGD(2006.79,"B",R,""))
if 'D0
Begin DoDot:2
+23 LOCK +^MAGD(2006.79)
+24 SET X=$GET(^MAGD(2006.79,0))
SET $PIECE(X,"^",1,2)="DICOM ROUTINE COPY^2006.79"
+25 SET D0=$ORDER(^MAGD(2006.79," "),-1)+1
+26 SET ^MAGD(2006.79,D0,0)=R_"^"_%
SET ^MAGD(2006.79,"B",R,D0)=""
+27 SET $PIECE(X,"^",3)=D0
SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+28 SET ^MAGD(2006.79,0)=X
+29 LOCK -^MAGD(2006.79)
+30 QUIT
End DoDot:2
+31 SET X=$GET(^MAGD(2006.79,D0,0))
SET $PIECE(X,"^",2)=%
+32 LOCK +^MAGD(2006.79,D0)
+33 KILL ^MAGD(2006.79,D0,1)
+34 SET D1=0
FOR I=1:1
SET X=$TEXT(+I^@R)
if X=""
QUIT
SET D1=D1+1
SET ^MAGD(2006.79,D0,1,D1,0)=X
+35 SET ^MAGD(2006.79,D0,1,0)="^2006.791^"_D1_"^"_D1
+36 LOCK -^MAGD(2006.79,D0)
+37 IF VERBOSE
WRITE $JUSTIFY(D1,4)," line"
if D1'=1
WRITE "s"
+38 QUIT
End DoDot:1
+39 WRITE !,"Code saved for ",N," routine"
if N'=1
WRITE "s"
WRITE "."
+40 QUIT
+41 ;
DICOM ; Restore routines in DICOM environment
+1 ;N D0,D1,L,N,R,S,X
+2 SET R=""
FOR
SET R=$ORDER(^MAGD(2006.79,"B",R))
if R=""
QUIT
Begin DoDot:1
+3 SET D0=""
FOR
SET D0=$ORDER(^MAGD(2006.79,"B",R,D0))
if D0=""
QUIT
Begin DoDot:2
+4 WRITE !,R,?15
+5 SET X="ZR S D1=0 F S D1=$O(^MAGD(2006.79,D0,1,D1)),L="""" S:D1 L=^MAGD(2006.79,D0,1,D1,0),N=D1 ZI:L'="""" L I 'D1 ZS "_R_" ZL "_$TEXT(+0)_" Q"
+6 XECUTE X
+7 WRITE $JUSTIFY(N,4)," line"
if N'=1
WRITE "s"
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
