- 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 Feb 18, 2025@23:27:20 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 ;
