MAGQE1 ;WOIFO/RMP - Support for MAG Enterprise ; 02/18/2005 09:19
;;3.0;IMAGING;**27,29,30,20,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
;
SDATE(FDAY,ORDER) ; Find first image before/after specified date
; EdM: In a future patch, this function must be replaced by a cross-reference.
N I1,I2
I $G(ORDER)'="R" Q 0
S I1=$O(^MAG(2005," "),-1)+1 S I2=$O(^MAG(2005.1," "),-1)+1
Q $S(I1>I2:I1,1:I2)
;
BPV(PLACE) ;
N BPWS,D0,NODE,INDEX,WS,RD
K BPWS
S RD=$$FMADD^XLFDT($$NOW^XLFDT,-180,"","","")
S WS="" F S WS=$O(^MAG(2006.8,"C",PLACE,WS)) Q:WS="" D
. S D0=$O(^MAG(2006.8,"C",PLACE,WS,""))
. Q:$P($G(^MAG(2006.8,D0,0)),"^",12)'="1"
. S NODE=$G(^MAG(2006.8,D0,1))
. Q:(+$P(NODE,U,5))<RD ; last execution date is greater than 6 months or null
. D:$P(NODE,"^",2)>0
. . S INDEX=$P(NODE,"^",2)_"^"_$P(NODE,"^",4)
. . S BPWS(INDEX)=$G(BPWS(INDEX))+1
. . S $P(BPWS(INDEX),"^",2)=$P(NODE,"^",3)
. . Q
. Q
D:$D(BPWS) LLOAD^MAGQE5(.BPWS,"BP VERS NUM DATE: ")
Q
;
IWSV(PLACE) ; Image workstation versions
N D0,IDX,OS,RD,WSC,WSD,WSV,X
S RD=$$FMADD^XLFDT($$NOW^XLFDT,-180,"","","")
S D0=0 F S D0=$O(^MAG(2006.81,"C",PLACE,D0)) Q:'D0 D
. S X=^MAG(2006.81,D0,0) Q:$P(X,"^",3)<RD
. S OS=$P($G(^MAG(2006.81,D0,1)),"^",2)
. S:OS?.N OS=$P($G(^MAG(2006.81,D0,1)),"^",3)
. S IDX=$P(X,"^",9) D:IDX'="" ; Display Station
. . S:OS'="" IDX=IDX_"^"_OS S WSD(IDX)=$G(WSD(IDX))+1
. . Q
. S IDX=$P(X,"^",13) D:IDX'="" ; Capture Station
. . S:OS'="" IDX=IDX_"^"_OS S WSC(IDX)=$G(WSC(IDX))+1
. . Q
. S IDX=$P(X,"^",15) D:IDX'="" ; VistARad Station
. . S:OS'="" IDX=IDX_"^"_OS S WSV(IDX)=$G(WSV(IDX))+1
. . Q
. Q
D LLOAD^MAGQE5(.WSD," WS DIS VERS: ")
D LLOAD^MAGQE5(.WSC," WS CAP VERS: ")
D LLOAD^MAGQE5(.WSV," WS VR VERS: ")
Q
;
DICOMV() ; Version of DICOM
N D0,DCMG,RD,T,VER,X
S RD=$$FMADD^XLFDT($$NOW^XLFDT,-30,"","","")
S X="" F S X=$O(^MAG(2006.83,"B",X)) Q:X="" D
. S D0=$O(^MAG(2006.83,"B",X,"")) Q:'D0
. S T=$G(^MAG(2006.83,D0,0)) Q:$P(T,"^",2)<RD
. S VER=$P(T,"^",3) S:VER="" VER="?"
. S DCMG(VER)=$G(DCMG(VER))+1
. Q
D:$D(DCMG) LLOAD^MAGQE5(.DCMG,"DICOM Gateway Version: ")
Q
;
VSTAV() ;
N VER
S VER=$$VERSION^XPDUTL("IMAGING")
S:$T(LAST^XPDUTL)'="" VER=VER_"^"_$$LAST^XPDUTL("IMAGING",VER)
Q VER
;
SNS(PLACE) ;
N D1,RESULT
S RESULT=$P(^MAG(2006.1,PLACE,0),"^",2)
S D1=0 F S D1=$O(^MAG(2006.1,PLACE,4,D1)) Q:'D1 D
. S RESULT=RESULT_"^"_$P($G(^MAG(2006.1,PLACE,4,D1,0)),"^",1)
. Q
Q RESULT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQE1 3521 printed Apr 09, 2024@21:09:27 Page 2
MAGQE1 ;WOIFO/RMP - Support for MAG Enterprise ; 02/18/2005 09:19
+1 ;;3.0;IMAGING;**27,29,30,20,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
+18 ;
SDATE(FDAY,ORDER) ; Find first image before/after specified date
+1 ; EdM: In a future patch, this function must be replaced by a cross-reference.
+2 NEW I1,I2
+3 IF $GET(ORDER)'="R"
QUIT 0
+4 SET I1=$ORDER(^MAG(2005," "),-1)+1
SET I2=$ORDER(^MAG(2005.1," "),-1)+1
+5 QUIT $SELECT(I1>I2:I1,1:I2)
+6 ;
BPV(PLACE) ;
+1 NEW BPWS,D0,NODE,INDEX,WS,RD
+2 KILL BPWS
+3 SET RD=$$FMADD^XLFDT($$NOW^XLFDT,-180,"","","")
+4 SET WS=""
FOR
SET WS=$ORDER(^MAG(2006.8,"C",PLACE,WS))
if WS=""
QUIT
Begin DoDot:1
+5 SET D0=$ORDER(^MAG(2006.8,"C",PLACE,WS,""))
+6 if $PIECE($GET(^MAG(2006.8,D0,0)),"^",12)'="1"
QUIT
+7 SET NODE=$GET(^MAG(2006.8,D0,1))
+8 ; last execution date is greater than 6 months or null
if (+$PIECE(NODE,U,5))<RD
QUIT
+9 if $PIECE(NODE,"^",2)>0
Begin DoDot:2
+10 SET INDEX=$PIECE(NODE,"^",2)_"^"_$PIECE(NODE,"^",4)
+11 SET BPWS(INDEX)=$GET(BPWS(INDEX))+1
+12 SET $PIECE(BPWS(INDEX),"^",2)=$PIECE(NODE,"^",3)
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 if $DATA(BPWS)
DO LLOAD^MAGQE5(.BPWS,"BP VERS NUM DATE: ")
+16 QUIT
+17 ;
IWSV(PLACE) ; Image workstation versions
+1 NEW D0,IDX,OS,RD,WSC,WSD,WSV,X
+2 SET RD=$$FMADD^XLFDT($$NOW^XLFDT,-180,"","","")
+3 SET D0=0
FOR
SET D0=$ORDER(^MAG(2006.81,"C",PLACE,D0))
if 'D0
QUIT
Begin DoDot:1
+4 SET X=^MAG(2006.81,D0,0)
if $PIECE(X,"^",3)<RD
QUIT
+5 SET OS=$PIECE($GET(^MAG(2006.81,D0,1)),"^",2)
+6 if OS?.N
SET OS=$PIECE($GET(^MAG(2006.81,D0,1)),"^",3)
+7 ; Display Station
SET IDX=$PIECE(X,"^",9)
if IDX'=""
Begin DoDot:2
+8 if OS'=""
SET IDX=IDX_"^"_OS
SET WSD(IDX)=$GET(WSD(IDX))+1
+9 QUIT
End DoDot:2
+10 ; Capture Station
SET IDX=$PIECE(X,"^",13)
if IDX'=""
Begin DoDot:2
+11 if OS'=""
SET IDX=IDX_"^"_OS
SET WSC(IDX)=$GET(WSC(IDX))+1
+12 QUIT
End DoDot:2
+13 ; VistARad Station
SET IDX=$PIECE(X,"^",15)
if IDX'=""
Begin DoDot:2
+14 if OS'=""
SET IDX=IDX_"^"_OS
SET WSV(IDX)=$GET(WSV(IDX))+1
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 DO LLOAD^MAGQE5(.WSD," WS DIS VERS: ")
+18 DO LLOAD^MAGQE5(.WSC," WS CAP VERS: ")
+19 DO LLOAD^MAGQE5(.WSV," WS VR VERS: ")
+20 QUIT
+21 ;
DICOMV() ; Version of DICOM
+1 NEW D0,DCMG,RD,T,VER,X
+2 SET RD=$$FMADD^XLFDT($$NOW^XLFDT,-30,"","","")
+3 SET X=""
FOR
SET X=$ORDER(^MAG(2006.83,"B",X))
if X=""
QUIT
Begin DoDot:1
+4 SET D0=$ORDER(^MAG(2006.83,"B",X,""))
if 'D0
QUIT
+5 SET T=$GET(^MAG(2006.83,D0,0))
if $PIECE(T,"^",2)<RD
QUIT
+6 SET VER=$PIECE(T,"^",3)
if VER=""
SET VER="?"
+7 SET DCMG(VER)=$GET(DCMG(VER))+1
+8 QUIT
End DoDot:1
+9 if $DATA(DCMG)
DO LLOAD^MAGQE5(.DCMG,"DICOM Gateway Version: ")
+10 QUIT
+11 ;
VSTAV() ;
+1 NEW VER
+2 SET VER=$$VERSION^XPDUTL("IMAGING")
+3 if $TEXT(LAST^XPDUTL)'=""
SET VER=VER_"^"_$$LAST^XPDUTL("IMAGING",VER)
+4 QUIT VER
+5 ;
SNS(PLACE) ;
+1 NEW D1,RESULT
+2 SET RESULT=$PIECE(^MAG(2006.1,PLACE,0),"^",2)
+3 SET D1=0
FOR
SET D1=$ORDER(^MAG(2006.1,PLACE,4,D1))
if 'D1
QUIT
Begin DoDot:1
+4 SET RESULT=RESULT_"^"_$PIECE($GET(^MAG(2006.1,PLACE,4,D1,0)),"^",1)
+5 QUIT
End DoDot:1
+6 QUIT RESULT
+7 ;
