MAGDQR05 ;WOIFO/EdM,MLH,DAC - Imaging RPCs for Query/Retrieve ; 07 Feb 2013 5:18 PM
;;3.0;IMAGING;**54,118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; 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
;
TIM(REQ,FD,LD,TIM,ANY,SID) ; Overflow from MAGDQR02
N D0,D1,D2,I,PAT,SDT,V,X,STDATE,STTIME,STUDYIX,STUTYP,STUDTA,DAT0,DATF,TIM0,TIMF,T,P
N PROCIX,PATREFIX,PATREFDTA,SERIX,SOPIX
D:$D(REQ("0008,0020"))>9
. ; search old structure for studies by date and time
. ; The references below to ^RADPT are permitted according to the
. ; existing Integration Agreement # 1172
. S V="" F S V=$O(^RADPT("ADC",V)) Q:V="" D
. . S D0="" F S D0=$O(^RADPT("ADC",V,D0)) Q:D0="" D
. . . S D1="" F S D1=$O(^RADPT("ADC",V,D0,D1)) Q:D1="" D
. . . . S SDT=9999999.9999-D1 Q:SDT<FD Q:SDT>LD
. . . . S D2="" F S D2=$O(^RADPT("ADC",V,D0,D1,D2)) Q:D2="" D
. . . . . Q:'$P($G(^RADPT(D0,"DT",D1,"P",D2,0)),"^",17)
. . . . . S ^TMP("MAG",$J,"QR",10,"R^"_D0_"^"_D1_"^"_D2)="",TIM=2
. . . . . S ANY=1,SID=1
. . . . . Q
. . . . Q
. . . Q
. . Q
. S PAT="" F S PAT=$O(^MAG(2005,"APDTPX",PAT)) Q:PAT="" D
. . S D1="" F S D1=$O(^MAG(2005,"APDTPX",PAT,D1)) Q:D1="" D
. . . S SDT=9999999.9999-D1 Q:SDT<FD Q:SDT>LD
. . . S D0="" F S D0=$O(^MAG(2005,"APDTPX",PAT,D1,"CON/PROC",D0)) Q:D0="" D
. . . . S X=$G(^MAG(2005,D0,2)),V=""
. . . . D:$P(X,"^",6)=2006.5839
. . . . . S V="123^"_$P(X,"^",7)_"^"_D0_"^"_$P(X,"^",7)
. . . . . Q
. . . . D:$P(X,"^",6)=8925
. . . . . N T
. . . . . S T=$P($G(^TIU(8925,+$P(X,"^",7),14)),"^",5) ; IA# 3268
. . . . . S T=$S(T[";GMR(123,":$$GMRCACN^MAGDFCNV(+T),1:"") ; Should use FileMan
. . . . . S V="8925^"_$P(X,"^",7)_"^"_D0_"^"_T
. . . . . Q
. . . . S ^TMP("MAG",$J,"QR",10,"C^"_PAT_"^"_V)="",TIM=2
. . . . S ANY=1,SID=1
. . . . Q
. . . Q
. . Q
. Q
; search new structure for studies by date and time
S T="0008,0020" ; search by date and time
D:$D(REQ(T))>9
. S P=$O(REQ(T,"")) Q:P="" S (DAT0,DATF)=$G(REQ(T,P)) Q:DAT0=""
. S:DAT0["-" DATF=$P(DAT0,"-",2),DAT0=$P(DAT0,"-",1)
. S DAT0=DAT0-17000000,DATF=DATF-17000000
. S T="0008,0030" D:$D(REQ(T))>9
. . S P=$O(REQ(T,"")),(TIM0,TIMF)=$G(REQ(T,P)) Q:TIM0=""
. . S:TIM0["-" TIMF=$P(TIM0,"-",2),TIM0=$P(TIM0,"-",1)
. . S TIM0=$E(TIM0_"000000",1,6),TIMF=$E(TIMF_"000000",1,6)
. . Q
. S STDATE=$O(^MAGV(2005.62,"J",DAT0),-1)
. F S STDATE=$O(^MAGV(2005.62,"J",STDATE)) Q:STDATE>DATF Q:'STDATE D
. . S STUDYIX=""
. . F S STUDYIX=$O(^MAGV(2005.62,"J",STDATE,STUDYIX)) Q:STUDYIX="" D
. . . Q:$P($G(^MAGV(2005.62,STUDYIX,5)),"^",2)="I" ; study marked inaccessible
. . . N HIT
. . . S HIT=1
. . . D:$D(TIM0)
. . . . S HIT=0
. . . . S STTIME=$P($P($G(^MAGV(2005.62,STUDYIX,2)),"^",1),".",2) Q:STTIME=""
. . . . S STTIME=$E((STTIME\1)_"000000",1,6)
. . . . I STTIME'<TIM0,STTIME'>TIMF S HIT=1
. . . . Q
. . . S:HIT ^TMP("MAG",$J,"QR",30,STUDYIX)=""
. . . Q
. . Q
. Q
S T="0008,0030" ; search by time alone
D:$D(REQ(T))>9
. Q:$D(REQ("0008,0020"))>9 ; already did date & time search
. S P=$O(REQ(T,"")) Q:P="" S (TIM0,TIMF)=$G(REQ(T,P)) Q:TIM0=""
. S:TIM0["-" TIMF=$P(TIM0,"-",2),TIM0=$P(TIM0,"-",1)
. S TIM0=$E(TIM0_"000000",1,6),TIMF=$E(TIMF_"000000",1,6)
. S STTIME=$O(^MAGV(2005.62,"K",TIM0),-1)
. F S STTIME=$O(^MAGV(2005.62,"K",STTIME)) Q:STTIME>TIMF Q:'STTIME D
. . S STUDYIX=""
. . F S STUDYIX=$O(^MAGV(2005.62,"K",STTIME,STUDYIX)) Q:STUDYIX="" D
. . . Q:$P($G(^MAGV(2005.62,STUDYIX,5)),"^",2)="I" ; study marked inaccessible
. . . S ^TMP("MAG",$J,"QR",30,STUDYIX)=""
. . . Q
. . Q
. Q
D:$D(^TMP("MAG",$J,"QR",30))
. S TIM=2,STUDYIX=""
. F S STUDYIX=$O(^TMP("MAG",$J,"QR",30,STUDYIX)) Q:'STUDYIX D
. . S PROCIX=$P($G(^MAGV(2005.62,STUDYIX,6)),"^",1) Q:'PROCIX
. . S PATREFIX=$P($G(^MAGV(2005.61,PROCIX,6)),"^",1) Q:'PATREFIX
. . S PATREFDTA=$G(^MAGV(2005.6,PATREFIX,0)) Q:$P(PATREFDTA,"^",3)'="D"
. . S PAT=$P(PATREFDTA,"^",1) Q:PAT=""
. . S ^TMP("MAG",$J,"QR",10,"N^"_PAT_"^"_STUDYIX)=""
. . S ANY=1,SID=1
. . Q
. K ^TMP("MAG",$J,"QR",30)
. Q
I TIM=1 D Q
. D ERR^MAGDQRUE("No matches for tag 0008,0020 / 0008,0030")
. D ERRSAV^MAGDQRUE
. Q
;
Q
;
GWINFO(OUT,HOSTNAME,LOCATION,FILES,VER) ; RPC = MAG DICOM STORE GATEWAY INFO
N D0,X
I $G(HOSTNAME)="" S OUT="-1,No HostName provided." Q
I '$G(LOCATION) S OUT="-3,No location provided." Q
S HOSTNAME=$TR(HOSTNAME,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S D0=$O(^MAG(2006.87,"B",HOSTNAME,"")) D:'D0
. L +^MAG(2006.87,0):1E9 ; Background process MUST wait
. S X=$G(^MAG(2006.87,0))
. S $P(X,"^",1,2)="DICOM GATEWAY INFORMATION^2006.87"
. S D0=$O(^MAG(2006.87," "),-1)+1
. S $P(X,"^",3)=D0
. S $P(X,"^",4)=$P(X,"^",4)+1
. S ^MAG(2006.87,0)=X
. S ^MAG(2006.87,D0,0)=HOSTNAME
. S ^MAG(2006.87,"B",HOSTNAME,D0)=""
. L -^MAG(2006.87,0)
. Q
S ^MAG(2006.87,D0,0)=HOSTNAME_"^"_"^"_(+LOCATION)
D GWLOG(.FILES,"INSTRUMENT",D0,1)
D GWLOG(.FILES,"MODALITY",D0,2)
D GWLOG(.FILES,"PORTLIST",D0,3)
D GWLOG(.FILES,"SCU_LIST",D0,4)
D GWLOG(.FILES,"WORKLIST",D0,5)
D GWLOG(.FILES,"CT_PARAM",D0,6)
D GWLOG(.VER,"GW",D0,100)
D GWLOG(.VER,"MAG_DCMVIEW",D0,101)
D GWLOG(.VER,"MAG_MAKEABS",D0,102)
D GWLOG(.VER,"MAG_CSTORE",D0,103)
D GWLOG(.VER,"MAG_RECON",D0,104)
D GWLOG(.VER,"MAG_DCMTOTGA",D0,105)
S OUT=0
Q
;
GWLOG(ARRAY,NAME,D0,F) ;
S:$D(ARRAY(NAME)) ^MAG(2006.87,D0,F)=ARRAY(NAME)
Q
;
GETINFO(OUT,HOSTNAME) ; RPC = MAG DICOM GET GATEWAY INFO
N D0,N,X
I $G(HOSTNAME)="" S OUT="-1,No HostName provided." Q
S HOSTNAME=$TR(HOSTNAME,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S D0=$O(^MAG(2006.87,"B",HOSTNAME,""))
I 'D0 S OUT(1)="-2,Cannot find info for """_HOSTNAME_"""." Q
S N=1
S X=$G(^MAG(2006.87,D0,0))
S:$P(X,"^",3) N=N+1,OUT(N)="Loc="_$$STA^XUAF4($P(X,"^",3))
D GWGET($G(^MAG(2006.87,D0,1)),"In")
D GWGET($G(^MAG(2006.87,D0,2)),"Mo")
D GWGET($G(^MAG(2006.87,D0,3)),"PL")
D GWGET($G(^MAG(2006.87,D0,4)),"SL")
D GWGET($G(^MAG(2006.87,D0,5)),"WL")
D GWGET($G(^MAG(2006.87,D0,6)),"CP")
S X=$G(^MAG(2006.87,D0,100)) S:X'="" N=N+1,OUT(N)="Ver="_X
D GWGET($G(^MAG(2006.87,D0,101)),"Vw")
D GWGET($G(^MAG(2006.87,D0,102)),"Ab")
D GWGET($G(^MAG(2006.87,D0,103)),"CS")
D GWGET($G(^MAG(2006.87,D0,104)),"Rc")
D GWGET($G(^MAG(2006.87,D0,105)),"DT")
S OUT(1)=N
Q
;
GWGET(X,K) N T
Q:X=""
S:$P(X,"^",2)'="" N=N+1,OUT(N)=K_"_p="_$P(X,"^",2)
S T=$P(X,"^",1) Q:'T
S N=N+1,OUT(N)=K_"_s="_$$STAMP(T)
Q
;
STAMP(T) N O,V
S V=(T\1#100)_"-"_$P("JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"," ",T\100#100)_"-"_(T\10000+1700)
S O=$E($P(T,".",2)_"000000",1,6),V=V_" "_$E(O,1,2)_":"_$E(O,3,4)_":"_$E(O,5,6)
Q V
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR05 7722 printed Apr 09, 2024@21:07:56 Page 2
MAGDQR05 ;WOIFO/EdM,MLH,DAC - Imaging RPCs for Query/Retrieve ; 07 Feb 2013 5:18 PM
+1 ;;3.0;IMAGING;**54,118,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+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 ;
TIM(REQ,FD,LD,TIM,ANY,SID) ; Overflow from MAGDQR02
+1 NEW D0,D1,D2,I,PAT,SDT,V,X,STDATE,STTIME,STUDYIX,STUTYP,STUDTA,DAT0,DATF,TIM0,TIMF,T,P
+2 NEW PROCIX,PATREFIX,PATREFDTA,SERIX,SOPIX
+3 if $DATA(REQ("0008,0020"))>9
Begin DoDot:1
+4 ; search old structure for studies by date and time
+5 ; The references below to ^RADPT are permitted according to the
+6 ; existing Integration Agreement # 1172
+7 SET V=""
FOR
SET V=$ORDER(^RADPT("ADC",V))
if V=""
QUIT
Begin DoDot:2
+8 SET D0=""
FOR
SET D0=$ORDER(^RADPT("ADC",V,D0))
if D0=""
QUIT
Begin DoDot:3
+9 SET D1=""
FOR
SET D1=$ORDER(^RADPT("ADC",V,D0,D1))
if D1=""
QUIT
Begin DoDot:4
+10 SET SDT=9999999.9999-D1
if SDT<FD
QUIT
if SDT>LD
QUIT
+11 SET D2=""
FOR
SET D2=$ORDER(^RADPT("ADC",V,D0,D1,D2))
if D2=""
QUIT
Begin DoDot:5
+12 if '$PIECE($GET(^RADPT(D0,"DT",D1,"P",D2,0)),"^",17)
QUIT
+13 SET ^TMP("MAG",$JOB,"QR",10,"R^"_D0_"^"_D1_"^"_D2)=""
SET TIM=2
+14 SET ANY=1
SET SID=1
+15 QUIT
End DoDot:5
+16 QUIT
End DoDot:4
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 SET PAT=""
FOR
SET PAT=$ORDER(^MAG(2005,"APDTPX",PAT))
if PAT=""
QUIT
Begin DoDot:2
+20 SET D1=""
FOR
SET D1=$ORDER(^MAG(2005,"APDTPX",PAT,D1))
if D1=""
QUIT
Begin DoDot:3
+21 SET SDT=9999999.9999-D1
if SDT<FD
QUIT
if SDT>LD
QUIT
+22 SET D0=""
FOR
SET D0=$ORDER(^MAG(2005,"APDTPX",PAT,D1,"CON/PROC",D0))
if D0=""
QUIT
Begin DoDot:4
+23 SET X=$GET(^MAG(2005,D0,2))
SET V=""
+24 if $PIECE(X,"^",6)=2006.5839
Begin DoDot:5
+25 SET V="123^"_$PIECE(X,"^",7)_"^"_D0_"^"_$PIECE(X,"^",7)
+26 QUIT
End DoDot:5
+27 if $PIECE(X,"^",6)=8925
Begin DoDot:5
+28 NEW T
+29 ; IA# 3268
SET T=$PIECE($GET(^TIU(8925,+$PIECE(X,"^",7),14)),"^",5)
+30 ; Should use FileMan
SET T=$SELECT(T[";GMR(123,":$$GMRCACN^MAGDFCNV(+T),1:"")
+31 SET V="8925^"_$PIECE(X,"^",7)_"^"_D0_"^"_T
+32 QUIT
End DoDot:5
+33 SET ^TMP("MAG",$JOB,"QR",10,"C^"_PAT_"^"_V)=""
SET TIM=2
+34 SET ANY=1
SET SID=1
+35 QUIT
End DoDot:4
+36 QUIT
End DoDot:3
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 ; search new structure for studies by date and time
+40 ; search by date and time
SET T="0008,0020"
+41 if $DATA(REQ(T))>9
Begin DoDot:1
+42 SET P=$ORDER(REQ(T,""))
if P=""
QUIT
SET (DAT0,DATF)=$GET(REQ(T,P))
if DAT0=""
QUIT
+43 if DAT0["-"
SET DATF=$PIECE(DAT0,"-",2)
SET DAT0=$PIECE(DAT0,"-",1)
+44 SET DAT0=DAT0-17000000
SET DATF=DATF-17000000
+45 SET T="0008,0030"
if $DATA(REQ(T))>9
Begin DoDot:2
+46 SET P=$ORDER(REQ(T,""))
SET (TIM0,TIMF)=$GET(REQ(T,P))
if TIM0=""
QUIT
+47 if TIM0["-"
SET TIMF=$PIECE(TIM0,"-",2)
SET TIM0=$PIECE(TIM0,"-",1)
+48 SET TIM0=$EXTRACT(TIM0_"000000",1,6)
SET TIMF=$EXTRACT(TIMF_"000000",1,6)
+49 QUIT
End DoDot:2
+50 SET STDATE=$ORDER(^MAGV(2005.62,"J",DAT0),-1)
+51 FOR
SET STDATE=$ORDER(^MAGV(2005.62,"J",STDATE))
if STDATE>DATF
QUIT
if 'STDATE
QUIT
Begin DoDot:2
+52 SET STUDYIX=""
+53 FOR
SET STUDYIX=$ORDER(^MAGV(2005.62,"J",STDATE,STUDYIX))
if STUDYIX=""
QUIT
Begin DoDot:3
+54 ; study marked inaccessible
if $PIECE($GET(^MAGV(2005.62,STUDYIX,5)),"^",2)="I"
QUIT
+55 NEW HIT
+56 SET HIT=1
+57 if $DATA(TIM0)
Begin DoDot:4
+58 SET HIT=0
+59 SET STTIME=$PIECE($PIECE($GET(^MAGV(2005.62,STUDYIX,2)),"^",1),".",2)
if STTIME=""
QUIT
+60 SET STTIME=$EXTRACT((STTIME\1)_"000000",1,6)
+61 IF STTIME'<TIM0
IF STTIME'>TIMF
SET HIT=1
+62 QUIT
End DoDot:4
+63 if HIT
SET ^TMP("MAG",$JOB,"QR",30,STUDYIX)=""
+64 QUIT
End DoDot:3
+65 QUIT
End DoDot:2
+66 QUIT
End DoDot:1
+67 ; search by time alone
SET T="0008,0030"
+68 if $DATA(REQ(T))>9
Begin DoDot:1
+69 ; already did date & time search
if $DATA(REQ("0008,0020"))>9
QUIT
+70 SET P=$ORDER(REQ(T,""))
if P=""
QUIT
SET (TIM0,TIMF)=$GET(REQ(T,P))
if TIM0=""
QUIT
+71 if TIM0["-"
SET TIMF=$PIECE(TIM0,"-",2)
SET TIM0=$PIECE(TIM0,"-",1)
+72 SET TIM0=$EXTRACT(TIM0_"000000",1,6)
SET TIMF=$EXTRACT(TIMF_"000000",1,6)
+73 SET STTIME=$ORDER(^MAGV(2005.62,"K",TIM0),-1)
+74 FOR
SET STTIME=$ORDER(^MAGV(2005.62,"K",STTIME))
if STTIME>TIMF
QUIT
if 'STTIME
QUIT
Begin DoDot:2
+75 SET STUDYIX=""
+76 FOR
SET STUDYIX=$ORDER(^MAGV(2005.62,"K",STTIME,STUDYIX))
if STUDYIX=""
QUIT
Begin DoDot:3
+77 ; study marked inaccessible
if $PIECE($GET(^MAGV(2005.62,STUDYIX,5)),"^",2)="I"
QUIT
+78 SET ^TMP("MAG",$JOB,"QR",30,STUDYIX)=""
+79 QUIT
End DoDot:3
+80 QUIT
End DoDot:2
+81 QUIT
End DoDot:1
+82 if $DATA(^TMP("MAG",$JOB,"QR",30))
Begin DoDot:1
+83 SET TIM=2
SET STUDYIX=""
+84 FOR
SET STUDYIX=$ORDER(^TMP("MAG",$JOB,"QR",30,STUDYIX))
if 'STUDYIX
QUIT
Begin DoDot:2
+85 SET PROCIX=$PIECE($GET(^MAGV(2005.62,STUDYIX,6)),"^",1)
if 'PROCIX
QUIT
+86 SET PATREFIX=$PIECE($GET(^MAGV(2005.61,PROCIX,6)),"^",1)
if 'PATREFIX
QUIT
+87 SET PATREFDTA=$GET(^MAGV(2005.6,PATREFIX,0))
if $PIECE(PATREFDTA,"^",3)'="D"
QUIT
+88 SET PAT=$PIECE(PATREFDTA,"^",1)
if PAT=""
QUIT
+89 SET ^TMP("MAG",$JOB,"QR",10,"N^"_PAT_"^"_STUDYIX)=""
+90 SET ANY=1
SET SID=1
+91 QUIT
End DoDot:2
+92 KILL ^TMP("MAG",$JOB,"QR",30)
+93 QUIT
End DoDot:1
+94 IF TIM=1
Begin DoDot:1
+95 DO ERR^MAGDQRUE("No matches for tag 0008,0020 / 0008,0030")
+96 DO ERRSAV^MAGDQRUE
+97 QUIT
End DoDot:1
QUIT
+98 ;
+99 QUIT
+100 ;
GWINFO(OUT,HOSTNAME,LOCATION,FILES,VER) ; RPC = MAG DICOM STORE GATEWAY INFO
+1 NEW D0,X
+2 IF $GET(HOSTNAME)=""
SET OUT="-1,No HostName provided."
QUIT
+3 IF '$GET(LOCATION)
SET OUT="-3,No location provided."
QUIT
+4 SET HOSTNAME=$TRANSLATE(HOSTNAME,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+5 SET D0=$ORDER(^MAG(2006.87,"B",HOSTNAME,""))
if 'D0
Begin DoDot:1
+6 ; Background process MUST wait
LOCK +^MAG(2006.87,0):1E9
+7 SET X=$GET(^MAG(2006.87,0))
+8 SET $PIECE(X,"^",1,2)="DICOM GATEWAY INFORMATION^2006.87"
+9 SET D0=$ORDER(^MAG(2006.87," "),-1)+1
+10 SET $PIECE(X,"^",3)=D0
+11 SET $PIECE(X,"^",4)=$PIECE(X,"^",4)+1
+12 SET ^MAG(2006.87,0)=X
+13 SET ^MAG(2006.87,D0,0)=HOSTNAME
+14 SET ^MAG(2006.87,"B",HOSTNAME,D0)=""
+15 LOCK -^MAG(2006.87,0)
+16 QUIT
End DoDot:1
+17 SET ^MAG(2006.87,D0,0)=HOSTNAME_"^"_"^"_(+LOCATION)
+18 DO GWLOG(.FILES,"INSTRUMENT",D0,1)
+19 DO GWLOG(.FILES,"MODALITY",D0,2)
+20 DO GWLOG(.FILES,"PORTLIST",D0,3)
+21 DO GWLOG(.FILES,"SCU_LIST",D0,4)
+22 DO GWLOG(.FILES,"WORKLIST",D0,5)
+23 DO GWLOG(.FILES,"CT_PARAM",D0,6)
+24 DO GWLOG(.VER,"GW",D0,100)
+25 DO GWLOG(.VER,"MAG_DCMVIEW",D0,101)
+26 DO GWLOG(.VER,"MAG_MAKEABS",D0,102)
+27 DO GWLOG(.VER,"MAG_CSTORE",D0,103)
+28 DO GWLOG(.VER,"MAG_RECON",D0,104)
+29 DO GWLOG(.VER,"MAG_DCMTOTGA",D0,105)
+30 SET OUT=0
+31 QUIT
+32 ;
GWLOG(ARRAY,NAME,D0,F) ;
+1 if $DATA(ARRAY(NAME))
SET ^MAG(2006.87,D0,F)=ARRAY(NAME)
+2 QUIT
+3 ;
GETINFO(OUT,HOSTNAME) ; RPC = MAG DICOM GET GATEWAY INFO
+1 NEW D0,N,X
+2 IF $GET(HOSTNAME)=""
SET OUT="-1,No HostName provided."
QUIT
+3 SET HOSTNAME=$TRANSLATE(HOSTNAME,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+4 SET D0=$ORDER(^MAG(2006.87,"B",HOSTNAME,""))
+5 IF 'D0
SET OUT(1)="-2,Cannot find info for """_HOSTNAME_"""."
QUIT
+6 SET N=1
+7 SET X=$GET(^MAG(2006.87,D0,0))
+8 if $PIECE(X,"^",3)
SET N=N+1
SET OUT(N)="Loc="_$$STA^XUAF4($PIECE(X,"^",3))
+9 DO GWGET($GET(^MAG(2006.87,D0,1)),"In")
+10 DO GWGET($GET(^MAG(2006.87,D0,2)),"Mo")
+11 DO GWGET($GET(^MAG(2006.87,D0,3)),"PL")
+12 DO GWGET($GET(^MAG(2006.87,D0,4)),"SL")
+13 DO GWGET($GET(^MAG(2006.87,D0,5)),"WL")
+14 DO GWGET($GET(^MAG(2006.87,D0,6)),"CP")
+15 SET X=$GET(^MAG(2006.87,D0,100))
if X'=""
SET N=N+1
SET OUT(N)="Ver="_X
+16 DO GWGET($GET(^MAG(2006.87,D0,101)),"Vw")
+17 DO GWGET($GET(^MAG(2006.87,D0,102)),"Ab")
+18 DO GWGET($GET(^MAG(2006.87,D0,103)),"CS")
+19 DO GWGET($GET(^MAG(2006.87,D0,104)),"Rc")
+20 DO GWGET($GET(^MAG(2006.87,D0,105)),"DT")
+21 SET OUT(1)=N
+22 QUIT
+23 ;
GWGET(X,K) NEW T
+1 if X=""
QUIT
+2 if $PIECE(X,"^",2)'=""
SET N=N+1
SET OUT(N)=K_"_p="_$PIECE(X,"^",2)
+3 SET T=$PIECE(X,"^",1)
if 'T
QUIT
+4 SET N=N+1
SET OUT(N)=K_"_s="_$$STAMP(T)
+5 QUIT
+6 ;
STAMP(T) NEW O,V
+1 SET V=(T\1#100)_"-"_$PIECE("JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC"," ",T\100#100)_"-"_(T\10000+1700)
+2 SET O=$EXTRACT($PIECE(T,".",2)_"000000",1,6)
SET V=V_" "_$EXTRACT(O,1,2)_":"_$EXTRACT(O,3,4)_":"_$EXTRACT(O,5,6)
+3 QUIT V
+4 ;
