MAGDQR02 ;WOIFO/EdM - Imaging RPCs for Query/Retrieve ; 05/16/2005  09:30
 ;;3.0;IMAGING;**51**;26-August-2005
 ;; +---------------------------------------------------------------+
 ;; | 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
 ;
QUERY ; --- perform actual query --- Called by TaskMan
 N ACC,ANY,MAGD0,MAGD1,MAGD2,ERROR,FD,FT,I,IMAGE,L,LD,LT,OFFSET,P,PAT,SID,SSN,T,TIM,UID,V,X
 ;
 K ^TMP("MAG",$J,"QR")
 S (PAT,SSN,ACC,UID,SID,SDT,TIM,ERROR)=0
 S FD=0,LD=9999999,FT=0,LT=240000
 ;
 S T="0008,0020",I=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . N F,U
 . S I=I+1 I I>1 D ERR^MAGDQR01("More than one study date specified.") Q
 . S (X,F,U)=REQ(T,P) S:X["-" F=$P(X,"-",1),U=$P(X,"-",2)
 . I F'="",F'?8N D ERR^MAGDQR01("Invalid 'from' date: """_F_""".")
 . I U'="",U'?8N D ERR^MAGDQR01("Invalid 'until' date: """_U_""".")
 . S FD=+F S:FD FD=FD-17000000
 . S LD=+U S:LD LD=LD-17000000
 . S TIM=1
 . Q
 ;
 S T="0008,0030",I=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . N F,U
 . S I=I+1 I I>1 D ERR^MAGDQR01("More than one study time specified.") Q
 . S (X,F,U)=REQ(T,P) S:X["-" F=$P(X,"-",1),U=$P(X,"-",2)
 . D CHKTIM(F,"from")
 . D CHKTIM(U,"until")
 . S FT=+$E(F_"000000",1,6)
 . S LT=+$E(U_"000000",1,6)
 . S TIM=1
 . Q
 I ERROR D ERRSAV^MAGDQR01 Q
 ;
 S FD=FT/1E6+FD,LD=LT/1E6+LD
 ;
 S T="0010,0010",ANY=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . ; The references below to ^DPT are permitted according to the
 . ; explicit permission in Section II of the PIMS V5.3 technical manual
 . ; (dated 23 Nov 2004)
 . S ANY=1
 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^DPT(""B"",LOOP)","^TMP(""MAG"",$J,""QR"",1,LOOP)")
 . S V="" F  S V=$O(^TMP("MAG",$J,"QR",1,V)) Q:V=""  D
 . . S I="" F  S I=$O(^DPT("B",V,I)) Q:I=""  S ^TMP("MAG",$J,"QR",2,I)="",PAT=1
 . . Q
 . Q
 I ANY,'PAT D  Q
 . D ERR^MAGDQR01("No matches for tag "_T)
 . D ERRSAV^MAGDQR01
 . Q
 ;
 S T="0010,0020",ANY=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . ; The references below to ^DPT are permitted according to the
 . ; explicit permission in Section II of the PIMS V5.3 technical manual
 . ; (dated 23 Nov 2004)
 . S ANY=1
 . S I=$$MATCHD^MAGDQR03($TR(REQ(T,P),"-"),"^DPT(""SSN"",LOOP)","^TMP(""MAG"",$J,""QR"",3,LOOP)")
 . S V="" F  S V=$O(^TMP("MAG",$J,"QR",3,V)) Q:V=""  D
 . . S I="" F  S I=$O(^DPT("SSN",V,I)) Q:I=""  S ^TMP("MAG",$J,"QR",4,I)="",SSN=1
 . . Q
 . Q
 I ANY,'SSN D  Q
 . D ERR^MAGDQR01("No matches for tag "_T)
 . D ERRSAV^MAGDQR01
 . Q
 ;
 S T="0008,0050",ANY=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . ; The references below to ^RADPT are permitted according to the
 . ; existing Integration Agreement # 1172
 . S ANY=1
 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^RADPT(""ADC"",LOOP)","^TMP(""MAG"",$J,""QR"",5,LOOP)")
 . S V="" F  S V=$O(^TMP("MAG",$J,"QR",5,V)) Q:V=""  D
 . . S MAGD0="" F  S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0=""  D
 . . . S MAGD1="" F  S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1=""  D
 . . . . S MAGD2="" F  S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2=""  D
 . . . . . S ^TMP("MAG",$J,"QR",6,MAGD0_"^"_MAGD1_"^"_MAGD2)="",ACC=1
 . . . . . Q
 . . . . Q
 . . . Q
 . . Q
 . Q
 I ANY,'ACC D  Q
 . D ERR^MAGDQR01("No matches for tag "_T)
 . D ERRSAV^MAGDQR01
 . Q
 ;
 S T="0020,0010",ANY=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . ; The references below to ^RADPT are permitted according to the
 . ; existing Integration Agreement # 1172
 . S ANY=1
 . S I=$$MATCHD^MAGDQR03("*-"_REQ(T,P),"^RADPT(""ADC"",LOOP)","^TMP(""MAG"",$J,""QR"",9,LOOP)")
 . S V="" F  S V=$O(^TMP("MAG",$J,"QR",9,V)) Q:V=""  D
 . . S MAGD0="" F  S MAGD0=$O(^RADPT("ADC",V,MAGD0)) Q:MAGD0=""  D
 . . . S MAGD1="" F  S MAGD1=$O(^RADPT("ADC",V,MAGD0,MAGD1)) Q:MAGD1=""  D
 . . . . S MAGD2="" F  S MAGD2=$O(^RADPT("ADC",V,MAGD0,MAGD1,MAGD2)) Q:MAGD2=""  D
 . . . . . S ^TMP("MAG",$J,"QR",10,MAGD0_"^"_MAGD1_"^"_MAGD2)="",SID=1
 . . . . . Q
 . . . . Q
 . . . Q
 . . Q
 . Q
 I ANY,'SID D  Q
 . D ERR^MAGDQR01("No matches for tag "_T)
 . D ERRSAV^MAGDQR01
 . Q
 ;
 S T="0020,000D",ANY=0
 S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
 . S ANY=1
 . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^MAG(2005,""P"",LOOP)","^TMP(""MAG"",$J,""QR"",7,LOOP)")
 . S V="" F  S V=$O(^TMP("MAG",$J,"QR",7,V)) Q:V=""  D
 . . S I="" F  S I=$O(^MAG(2005,"P",V,I)) Q:I=""  D
 . . . ; If this image has a parent, its UID is not a study UID
 . . . Q:$P($G(^MAG(2005,I,0)),"^",10)
 . . . S ^TMP("MAG",$J,"QR",8,I)="",UID=1
 . . . Q
 . . Q
 . Q
 I ANY,'UID D  Q
 . D ERR^MAGDQR01("No matches for tag "_T)
 . D ERRSAV^MAGDQR01
 . Q
 ;
 I TIM,'(PAT+SSN+SID+UID+ACC) D TIM^MAGDQR04
 ;
 I '(PAT+SSN+SID+UID+ACC) D  Q
 . D ERR^MAGDQR01("No Selection Specified.")
 . D ERRSAV^MAGDQR01
 . Q
 ;
 D ELIM(ACC,SID,6,10,"Accession and Study ID",0)
 M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",6)
 M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",10)
 ;
 D ELIM(PAT,SSN,2,4,"Patient Name and ID",0)
 M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",2)
 M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",4)
 ;
 D ELIM(PAT+SSN,ACC+SID,11,12,"Patient and Study Info",1)
 I ERROR D ERRSAV^MAGDQR01 Q
 ;
 S ANY=0
 D
 . I UID D  Q
 . . S IMAGE="" F  S IMAGE=$O(^TMP("MAG",$J,"QR",8,IMAGE)) Q:IMAGE=""  D
 . . . S X=$G(^MAG(2005,IMAGE,0)),P=$P(X,"^",7)
 . . . I PAT+SSN,P,'$D(^TMP("MAG",$J,"QR",11,P)) Q
 . . . S X=$G(^MAG(2005,IMAGE,2)),V=$P(X,"^",6) Q:V'=74
 . . . S V=$P(X,"^",5) I V,(V<FD)!(V>LD) Q
 . . . S X=$G(^RARPT(+$P(X,"^",7),0)) ; IA # 1171
 . . . S MAGD0=$P(X,"^",2),MAGD1=9999999.9999-$P(X,"^",3),V=$P(X,"^",4)
 . . . S MAGD2=$O(^RADPT(MAGD0,"DT",MAGD1,"P","B",V,"")) ; IA # 1172
 . . . I ACC+SID,'$D(^TMP("MAG",$J,"QR",12,MAGD0_"^"_MAGD1_"^"_MAGD2)) Q
 . . . D RESULT^MAGDQR03
 . . . Q
 . . Q
 . ;
 . I ACC+SID D  Q
 . . N OK,P1,P2,P3,P4
 . . S P="" F  S P=$O(^TMP("MAG",$J,"QR",12,P)) Q:P=""  D
 . . . S MAGD0=$P(P,"^",1),MAGD1=$P(P,"^",2),MAGD2=$P(P,"^",3)
 . . . I PAT+SSN,'$D(^TMP("MAG",$J,"QR",11,MAGD0)) Q
 . . . S OK=0 D  Q:'OK
 . . . . S V=$P($G(^RADPT(MAGD0,"DT",MAGD1,"P",MAGD2,0)),"^",17) Q:'V  ; IA # 1172
 . . . . S P1=0 F  S P1=$O(^RARPT(V,2005,P1)) Q:'P1  D  Q:OK  ; IA # 1171
 . . . . . S P2=+$G(^RARPT(V,2005,P1,0)) Q:'P2  ; IA # 1171
 . . . . . I UID,$D(^TMP("MAG",$J,"QR",8,P2)) S OK=1,IMAGE=P2 Q
 . . . . . I 'UID S OK=1,IMAGE=P2 Q
 . . . . . S P3=0 F  S P3=$O(^MAG(2005,P2,1,P3)) Q:'P3  D  Q:OK
 . . . . . . S P4=$P($G(^MAG(2005,P2,1,P3,0)),"^",1) Q:'P4
 . . . . . . I UID,$D(^TMP("MAG",$J,"QR",8,P4)) S OK=1,IMAGE=P4 Q
 . . . . . . I 'UID S OK=1,IMAGE=P4 Q
 . . . . . . Q
 . . . . . Q
 . . . . Q
 . . . D RESULT^MAGDQR03
 . . . Q
 . . Q
 . ;
 . I PAT+SSN D  Q
 . . S P="" F  S P=$O(^TMP("MAG",$J,"QR",11,P)) Q:P=""  D
 . . . S IMAGE="" F  S IMAGE=$O(^MAG(2005,"AC",P,IMAGE)) Q:IMAGE=""  D
 . . . . Q:$P($G(^MAG(2005,IMAGE,0)),"^",10)
 . . . . S X=$G(^MAG(2005,IMAGE,2)),V=$P(X,"^",6) Q:V'=74
 . . . . S V=$P(X,"^",5) I V,(V<FD)!(V>LD) Q
 . . . . S X=$G(^RARPT(+$P(X,"^",7),0)) ; IA # 1171
 . . . . S MAGD0=$P(X,"^",2),MAGD1=9999999.9999-$P(X,"^",3),V=$P(X,"^",4)
 . . . . S MAGD2=$O(^RADPT(MAGD0,"DT",MAGD1,"P","B",V,"")) ; IA # 1172
 . . . . I ACC+SID,'$D(^TMP("MAG",$J,"QR",12,MAGD0_"^"_MAGD1_"^"_MAGD2)) Q
 . . . . D RESULT^MAGDQR03
 . . . . Q
 . . . Q
 . . Q
 . Q
 ;
 S $P(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
 K ^TMP("MAG",$J,"QR")
 Q
 ;
CHKTIM(V,L) ;
 Q:V=""
 I V'?1.6N D ERR^MAGDQR01("Invalid '"_L_"' time: """_V_""".")
 I $E(V,1,2)>23 D ERR^MAGDQR01("Invalid hours in '"_L_"' time: """_V_""".")
 I $E(V,3,4),$E(V,3,4)>59 D ERR^MAGDQR01("Invalid minutes in '"_L_"' time: """_V_""".")
 I $E(V,5,6),$E(V,5,6)>59 D ERR^MAGDQR01("Invalid seconds '"_L_"' time: """_V_""".")
 Q
 ;
ELIM(ONE,TWO,I1,I2,E,C) N ANY,I,O
 Q:'ONE  Q:'TWO
 S I="" F  S I=$O(^TMP("MAG",$J,"QR",I1,I)) Q:I=""  D
 . S O=I I C Q:I'["^"  S O=+I
 . I '$D(^TMP("MAG",$J,"QR",I2,O)) K ^TMP("MAG",$J,"QR",I1,I)
 . Q
 S I="" F  S I=$O(^TMP("MAG",$J,"QR",I2,I)) Q:I=""  D
 . S O=I I C Q:I'["^"  S O=+I
 . I '$D(^TMP("MAG",$J,"QR",I1,O)) K ^TMP("MAG",$J,"QR",I2,I)
 . Q
 S ANY=$O(^TMP("MAG",$J,"QR",I1,""))*$O(^TMP("MAG",$J,"QR",I2,""))
 D:'ANY ERR^MAGDQR01("No matches left, conflict between "_E)
 Q
 ;