MAGDQR02 ;WOIFO/EdM,MLH,JSL,BT,DSB,NST - Imaging RPCs for Query/Retrieve ; 22 Jul 2021 4:11 PM
;;3.0;IMAGING;**51,54,66,118,239,301**Sept 09,2019;Build ;Build 18
;; 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
;
QUERY ; --- perform actual query --- Called by TaskMan
; The RESULT index, MAGDUZ, and REQ() array are passed into this routine's
; partition implicitly by the TaskMan invocation
N ACC,ANY,ENT,FATAL,MAGD0,MAGD1,MAGD2,FD,FT,I,IMAGE,L,LD,LT,OFFSET,P,PAT,PRMUID,SDT,SID,SSN,T,TIM,UID,V,X
;
K ^TMP("MAG",$J,"QR")
S (PAT,SSN,ACC,UID,SID,SDT,TIM,FATAL)=0
S FD=0,LD=9999999,FT=0,LT=240000
;
S PRMUID=0 ; 0=error, 1=all, 2=oldest, 3=newest
S T="0000,0902",I=0 ; Duplicate UID handling parameter
S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
. S PRMUID=REQ(T,P)
. Q
K REQ(T)
S:($L(PRMUID)'=1)!(123'[PRMUID) PRMUID=0
;
S T="0008,0020",I=0 ; R Study Date
S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
. N FR,UT
. S I=I+1 I I>1 D ERR^MAGDQRUE("More than one study date specified.") Q
. S (X,FR,UT)=REQ(T,P) S:X["-" FR=$P(X,"-",1),UT=$P(X,"-",2)
. I FR'="",FR'?8N D ERR^MAGDQRUE("Invalid 'from' date: """_FR_""".")
. I UT'="",UT'?8N D ERR^MAGDQRUE("Invalid 'until' date: """_UT_""".")
. S FD=+FR S:FD FD=FD-17000000
. I UT'="" S LD=+UT S:LD LD=LD-17000000 ;P239;DSB-Fix last date when null
. I UT="" S LD=$$HTFM^XLFDT($H,1)
. S TIM=1
. Q
;
S T="0008,0030",I=0 ; R Study Time
S P="" F S P=$O(REQ(T,P)) Q:P="" D:REQ(T,P)'=""
. N FR,UT
. S I=I+1 I I>1 D ERR^MAGDQRUE("More than one study time specified.") Q
. S (X,FR,UT)=REQ(T,P) S:X["-" FR=$P(X,"-",1),UT=$P(X,"-",2)
. D CHKTIM(FR,"from")
. D CHKTIM(UT,"until")
. S FT=+$E(FR_"000000",1,6)
. S LT=+$E(UT_"000000",1,6)
. S TIM=1
. Q
I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE Q
;
S FD=FT/1E6+FD,LD=LT/1E6+LD
;
S T="0010,0010",ANY=0 ; R Patient's Name
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^MAGDQRUE("No matches for tag "_T)
. D ERRSAV^MAGDQRUE
. Q
;
S T="0010,0020",ANY=0 ; R Patient ID
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
. I 'SSN,$$ISIHS^MAGSPID(),$TR(REQ(T,P),"*")?1.6N D Q ;IHS Health Record No - patient lookup
. . S V=$$FIND1^DIC(9000001,,"MX",$TR(REQ(T,P),"*")) ;IA #447
. . S:V ^TMP("MAG",$J,"QR",4,V)="",SSN=1
. . Q
. Q
I ANY,'SSN D Q
. D ERR^MAGDQRUE("No matches for tag "_T)
. D ERRSAV^MAGDQRUE
. Q
;
S T="0008,0050",ANY=0 ; R Accession Number
D ACCNUM^MAGDQR07(.REQ,T,.ACC,.ANY)
I ANY,'ACC D Q
. D ERR^MAGDQRUE("No matches for tag "_T)
. D ERRSAV^MAGDQRUE
. Q
;
S T="0020,0010",ANY=0 ; R Study ID
D STUDYID^MAGDQR12(.REQ,T,.SID,.ANY)
I ANY,'SID D Q
. D ERR^MAGDQRUE("No matches for tag "_T)
. D ERRSAV^MAGDQRUE
. Q
;
D I ANY,'UID Q
. N OK,UIDS
. D UIDS^MAGDQR08(.REQ,T,.UID,PRMUID,.ANY,.OK,.UIDS)
. Q:'$G(ANY) Q:$G(OK)
. S UID=0
. D ERR^MAGDQRUE("Conflicting UIDs: "_$G(UIDS))
. D ERRSAV^MAGDQRUE
. Q
;
I TIM,'(PAT+SSN+SID+UID+ACC) D TIM^MAGDQR05(.REQ,FD,LD,.TIM,.ANY,.SID)
;
I '(PAT+SSN+SID+UID+ACC) D Q
. D ERR^MAGDQRUE("No Selection Specified.")
. D ERRSAV^MAGDQRUE
. 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 ELIMB(PAT+SSN,ACC+SID,11,12,"Patient and Study Info")
I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE Q
;
K ^TMP("MAG",$J,"DICOMQR")
S ^TMP("MAG",$J,"DICOMQR","RESULTSET")=0
S ^TMP("MAG",$J,"DICOMQR","DUMMY SIUID")=0
D ; switch
. ;return data on image / study entries from appropriate queue based on type of lookup
. I UID D Q ; UID lookup case
. . S IMAGE="" F S IMAGE=$O(^TMP("MAG",$J,"QR",8,IMAGE)) Q:IMAGE="" D
. . . ; new or old database?
. . . I $E(IMAGE,1)="N" D UIDNEW^MAGDQR31(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD) Q
. . . D UIDOLD^MAGDQR32(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,ACC,SID,UID,FD,LD)
. . . Q
. . Q
. I ACC+SID D Q ; accession no. / study ID lookup case
. . S P="" F S P=$O(^TMP("MAG",$J,"QR",12,P)) Q:P="" D
. . . D ACCSID^MAGDQR10(P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD)
. . . Q
. . Q
. I PAT+SSN D Q ; pt name / SSN lookup case
. . S P="" F S P=$O(^TMP("MAG",$J,"QR",11,P)) Q:P="" D Q:$G(FATAL)
. . . ; new database
. . . D:$D(^MAGV(2005.6,"B",P)) PATSSNNU^MAGDQR22(.P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD,.ERROR,.FATAL)
. . . ; old database
. . . S IMAGE="" F S IMAGE=$O(^MAG(2005,"AC",P,IMAGE)) Q:IMAGE="" D Q:$G(FATAL)
. . . . D PATSSNOL^MAGDQR23(IMAGE,.REQ,RESULT,MAGDUZ,FD,LD,.ERROR,.FATAL)
. . . . Q
. . . Q
. . Q
. Q
;
D:$O(PRMUID(""))'="" PRUNE^MAGDQR08(RESULT) ; There are duplicate UIDs
S $P(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
K ^TMP("MAG",$J,"QR")
K ^TMP("MAG",$J,"DICOMQR")
Q
;
CHKTIM(V,L) ;
Q:V=""
I V'?1.6N D ERR^MAGDQRUE("Invalid '"_L_"' time: """_V_""".")
I $E(V,1,2)>23 D ERR^MAGDQRUE("Invalid hours in '"_L_"' time: """_V_""".")
I $E(V,3,4),$E(V,3,4)>59 D ERR^MAGDQRUE("Invalid minutes in '"_L_"' time: """_V_""".")
I $E(V,5,6),$E(V,5,6)>59 D ERR^MAGDQRUE("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=($D(^TMP("MAG",$J,"QR",I1))>9)*($D(^TMP("MAG",$J,"QR",I2))>9)
D:'ANY ERR^MAGDQRUE("No matches left, conflict between "_E)
Q
;
ELIMB(ONE,TWO,I1,I2,E) N ANY,I,O
; elimination logic between subtrees w/different data structures,
; e.g., 11 (I1) and 12 (I2)
N HIT ; match flag
Q:'ONE Q:'TWO
S I="" F S I=$O(^TMP("MAG",$J,"QR",I1,I)) Q:I="" D
. S O="",HIT=0
. ; match?
. F S O=$O(^TMP("MAG",$J,"QR",I2,O)) Q:O="" I $P(O,"^",2)=I S HIT=1 Q ; yes
. K:'HIT ^TMP("MAG",$J,"QR",I1,I) ; no
. Q
S I="" F S I=$O(^TMP("MAG",$J,"QR",I2,I)) Q:I="" D
. S O=$P(I,"^",2) I O,$D(^TMP("MAG",$J,"QR",I1,O)) Q ; match
. K ^TMP("MAG",$J,"QR",I2,I) ; no match
. Q
S ANY=($D(^TMP("MAG",$J,"QR",I1))>9)*($D(^TMP("MAG",$J,"QR",I2))>9)
D:'ANY ERR^MAGDQRUE("No matches left, conflict between "_E)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR02 8366 printed Dec 13, 2024@02:00:49 Page 2
MAGDQR02 ;WOIFO/EdM,MLH,JSL,BT,DSB,NST - Imaging RPCs for Query/Retrieve ; 22 Jul 2021 4:11 PM
+1 ;;3.0;IMAGING;**51,54,66,118,239,301**Sept 09,2019;Build ;Build 18
+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 ;
QUERY ; --- perform actual query --- Called by TaskMan
+1 ; The RESULT index, MAGDUZ, and REQ() array are passed into this routine's
+2 ; partition implicitly by the TaskMan invocation
+3 NEW ACC,ANY,ENT,FATAL,MAGD0,MAGD1,MAGD2,FD,FT,I,IMAGE,L,LD,LT,OFFSET,P,PAT,PRMUID,SDT,SID,SSN,T,TIM,UID,V,X
+4 ;
+5 KILL ^TMP("MAG",$JOB,"QR")
+6 SET (PAT,SSN,ACC,UID,SID,SDT,TIM,FATAL)=0
+7 SET FD=0
SET LD=9999999
SET FT=0
SET LT=240000
+8 ;
+9 ; 0=error, 1=all, 2=oldest, 3=newest
SET PRMUID=0
+10 ; Duplicate UID handling parameter
SET T="0000,0902"
SET I=0
+11 SET P=""
FOR
SET P=$ORDER(REQ(T,P))
if P=""
QUIT
if REQ(T,P)'=""
Begin DoDot:1
+12 SET PRMUID=REQ(T,P)
+13 QUIT
End DoDot:1
+14 KILL REQ(T)
+15 if ($LENGTH(PRMUID)'=1)!(123'[PRMUID)
SET PRMUID=0
+16 ;
+17 ; R Study Date
SET T="0008,0020"
SET I=0
+18 SET P=""
FOR
SET P=$ORDER(REQ(T,P))
if P=""
QUIT
if REQ(T,P)'=""
Begin DoDot:1
+19 NEW FR,UT
+20 SET I=I+1
IF I>1
DO ERR^MAGDQRUE("More than one study date specified.")
QUIT
+21 SET (X,FR,UT)=REQ(T,P)
if X["-"
SET FR=$PIECE(X,"-",1)
SET UT=$PIECE(X,"-",2)
+22 IF FR'=""
IF FR'?8N
DO ERR^MAGDQRUE("Invalid 'from' date: """_FR_""".")
+23 IF UT'=""
IF UT'?8N
DO ERR^MAGDQRUE("Invalid 'until' date: """_UT_""".")
+24 SET FD=+FR
if FD
SET FD=FD-17000000
+25 ;P239;DSB-Fix last date when null
IF UT'=""
SET LD=+UT
if LD
SET LD=LD-17000000
+26 IF UT=""
SET LD=$$HTFM^XLFDT($HOROLOG,1)
+27 SET TIM=1
+28 QUIT
End DoDot:1
+29 ;
+30 ; R Study Time
SET T="0008,0030"
SET I=0
+31 SET P=""
FOR
SET P=$ORDER(REQ(T,P))
if P=""
QUIT
if REQ(T,P)'=""
Begin DoDot:1
+32 NEW FR,UT
+33 SET I=I+1
IF I>1
DO ERR^MAGDQRUE("More than one study time specified.")
QUIT
+34 SET (X,FR,UT)=REQ(T,P)
if X["-"
SET FR=$PIECE(X,"-",1)
SET UT=$PIECE(X,"-",2)
+35 DO CHKTIM(FR,"from")
+36 DO CHKTIM(UT,"until")
+37 SET FT=+$EXTRACT(FR_"000000",1,6)
+38 SET LT=+$EXTRACT(UT_"000000",1,6)
+39 SET TIM=1
+40 QUIT
End DoDot:1
+41 IF $DATA(^TMP("MAG",$JOB,"ERR"))
DO ERRSAV^MAGDQRUE
QUIT
+42 ;
+43 SET FD=FT/1E6+FD
SET LD=LT/1E6+LD
+44 ;
+45 ; R Patient's Name
SET T="0010,0010"
SET ANY=0
+46 SET P=""
FOR
SET P=$ORDER(REQ(T,P))
if P=""
QUIT
if REQ(T,P)'=""
Begin DoDot:1
+47 ; The references below to ^DPT are permitted according to the
+48 ; explicit permission in Section II of the PIMS V5.3 technical manual
+49 ; (dated 23 Nov 2004)
+50 SET ANY=1
+51 SET I=$$MATCHD^MAGDQR03(REQ(T,P),"^DPT(""B"",LOOP)","^TMP(""MAG"",$J,""QR"",1,LOOP)")
+52 SET V=""
FOR
SET V=$ORDER(^TMP("MAG",$JOB,"QR",1,V))
if V=""
QUIT
Begin DoDot:2
+53 SET I=""
FOR
SET I=$ORDER(^DPT("B",V,I))
if I=""
QUIT
SET ^TMP("MAG",$JOB,"QR",2,I)=""
SET PAT=1
+54 QUIT
End DoDot:2
+55 QUIT
End DoDot:1
+56 IF ANY
IF 'PAT
Begin DoDot:1
+57 DO ERR^MAGDQRUE("No matches for tag "_T)
+58 DO ERRSAV^MAGDQRUE
+59 QUIT
End DoDot:1
QUIT
+60 ;
+61 ; R Patient ID
SET T="0010,0020"
SET ANY=0
+62 SET P=""
FOR
SET P=$ORDER(REQ(T,P))
if P=""
QUIT
if REQ(T,P)'=""
Begin DoDot:1
+63 ; The references below to ^DPT are permitted according to the
+64 ; explicit permission in Section II of the PIMS V5.3 technical manual
+65 ; (dated 23 Nov 2004)
+66 SET ANY=1
+67 SET I=$$MATCHD^MAGDQR03($TRANSLATE(REQ(T,P),"-"),"^DPT(""SSN"",LOOP)","^TMP(""MAG"",$J,""QR"",3,LOOP)")
+68 SET V=""
FOR
SET V=$ORDER(^TMP("MAG",$JOB,"QR",3,V))
if V=""
QUIT
Begin DoDot:2
+69 SET I=""
FOR
SET I=$ORDER(^DPT("SSN",V,I))
if I=""
QUIT
SET ^TMP("MAG",$JOB,"QR",4,I)=""
SET SSN=1
+70 QUIT
End DoDot:2
+71 ;IHS Health Record No - patient lookup
IF 'SSN
IF $$ISIHS^MAGSPID()
IF $TRANSLATE(REQ(T,P),"*")?1.6N
Begin DoDot:2
+72 ;IA #447
SET V=$$FIND1^DIC(9000001,,"MX",$TRANSLATE(REQ(T,P),"*"))
+73 if V
SET ^TMP("MAG",$JOB,"QR",4,V)=""
SET SSN=1
+74 QUIT
End DoDot:2
QUIT
+75 QUIT
End DoDot:1
+76 IF ANY
IF 'SSN
Begin DoDot:1
+77 DO ERR^MAGDQRUE("No matches for tag "_T)
+78 DO ERRSAV^MAGDQRUE
+79 QUIT
End DoDot:1
QUIT
+80 ;
+81 ; R Accession Number
SET T="0008,0050"
SET ANY=0
+82 DO ACCNUM^MAGDQR07(.REQ,T,.ACC,.ANY)
+83 IF ANY
IF 'ACC
Begin DoDot:1
+84 DO ERR^MAGDQRUE("No matches for tag "_T)
+85 DO ERRSAV^MAGDQRUE
+86 QUIT
End DoDot:1
QUIT
+87 ;
+88 ; R Study ID
SET T="0020,0010"
SET ANY=0
+89 DO STUDYID^MAGDQR12(.REQ,T,.SID,.ANY)
+90 IF ANY
IF 'SID
Begin DoDot:1
+91 DO ERR^MAGDQRUE("No matches for tag "_T)
+92 DO ERRSAV^MAGDQRUE
+93 QUIT
End DoDot:1
QUIT
+94 ;
+95 Begin DoDot:1
+96 NEW OK,UIDS
+97 DO UIDS^MAGDQR08(.REQ,T,.UID,PRMUID,.ANY,.OK,.UIDS)
+98 if '$GET(ANY)
QUIT
if $GET(OK)
QUIT
+99 SET UID=0
+100 DO ERR^MAGDQRUE("Conflicting UIDs: "_$GET(UIDS))
+101 DO ERRSAV^MAGDQRUE
+102 QUIT
End DoDot:1
IF ANY
IF 'UID
QUIT
+103 ;
+104 IF TIM
IF '(PAT+SSN+SID+UID+ACC)
DO TIM^MAGDQR05(.REQ,FD,LD,.TIM,.ANY,.SID)
+105 ;
+106 IF '(PAT+SSN+SID+UID+ACC)
Begin DoDot:1
+107 DO ERR^MAGDQRUE("No Selection Specified.")
+108 DO ERRSAV^MAGDQRUE
+109 QUIT
End DoDot:1
QUIT
+110 ;
+111 DO ELIM(ACC,SID,6,10,"Accession and Study ID",0)
+112 MERGE ^TMP("MAG",$JOB,"QR",12)=^TMP("MAG",$JOB,"QR",6)
+113 MERGE ^TMP("MAG",$JOB,"QR",12)=^TMP("MAG",$JOB,"QR",10)
+114 ;
+115 DO ELIM(PAT,SSN,2,4,"Patient Name and ID",0)
+116 MERGE ^TMP("MAG",$JOB,"QR",11)=^TMP("MAG",$JOB,"QR",2)
+117 MERGE ^TMP("MAG",$JOB,"QR",11)=^TMP("MAG",$JOB,"QR",4)
+118 ;
+119 DO ELIMB(PAT+SSN,ACC+SID,11,12,"Patient and Study Info")
+120 IF $DATA(^TMP("MAG",$JOB,"ERR"))
DO ERRSAV^MAGDQRUE
QUIT
+121 ;
+122 KILL ^TMP("MAG",$JOB,"DICOMQR")
+123 SET ^TMP("MAG",$JOB,"DICOMQR","RESULTSET")=0
+124 SET ^TMP("MAG",$JOB,"DICOMQR","DUMMY SIUID")=0
+125 ; switch
Begin DoDot:1
+126 ;return data on image / study entries from appropriate queue based on type of lookup
+127 ; UID lookup case
IF UID
Begin DoDot:2
+128 SET IMAGE=""
FOR
SET IMAGE=$ORDER(^TMP("MAG",$JOB,"QR",8,IMAGE))
if IMAGE=""
QUIT
Begin DoDot:3
+129 ; new or old database?
+130 IF $EXTRACT(IMAGE,1)="N"
DO UIDNEW^MAGDQR31(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD)
QUIT
+131 DO UIDOLD^MAGDQR32(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,ACC,SID,UID,FD,LD)
+132 QUIT
End DoDot:3
+133 QUIT
End DoDot:2
QUIT
+134 ; accession no. / study ID lookup case
IF ACC+SID
Begin DoDot:2
+135 SET P=""
FOR
SET P=$ORDER(^TMP("MAG",$JOB,"QR",12,P))
if P=""
QUIT
Begin DoDot:3
+136 DO ACCSID^MAGDQR10(P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD)
+137 QUIT
End DoDot:3
+138 QUIT
End DoDot:2
QUIT
+139 ; pt name / SSN lookup case
IF PAT+SSN
Begin DoDot:2
+140 SET P=""
FOR
SET P=$ORDER(^TMP("MAG",$JOB,"QR",11,P))
if P=""
QUIT
Begin DoDot:3
+141 ; new database
+142 if $DATA(^MAGV(2005.6,"B",P))
DO PATSSNNU^MAGDQR22(.P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD,.ERROR,.FATAL)
+143 ; old database
+144 SET IMAGE=""
FOR
SET IMAGE=$ORDER(^MAG(2005,"AC",P,IMAGE))
if IMAGE=""
QUIT
Begin DoDot:4
+145 DO PATSSNOL^MAGDQR23(IMAGE,.REQ,RESULT,MAGDUZ,FD,LD,.ERROR,.FATAL)
+146 QUIT
End DoDot:4
if $GET(FATAL)
QUIT
+147 QUIT
End DoDot:3
if $GET(FATAL)
QUIT
+148 QUIT
End DoDot:2
QUIT
+149 QUIT
End DoDot:1
+150 ;
+151 ; There are duplicate UIDs
if $ORDER(PRMUID(""))'=""
DO PRUNE^MAGDQR08(RESULT)
+152 SET $PIECE(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
+153 KILL ^TMP("MAG",$JOB,"QR")
+154 KILL ^TMP("MAG",$JOB,"DICOMQR")
+155 QUIT
+156 ;
CHKTIM(V,L) ;
+1 if V=""
QUIT
+2 IF V'?1.6N
DO ERR^MAGDQRUE("Invalid '"_L_"' time: """_V_""".")
+3 IF $EXTRACT(V,1,2)>23
DO ERR^MAGDQRUE("Invalid hours in '"_L_"' time: """_V_""".")
+4 IF $EXTRACT(V,3,4)
IF $EXTRACT(V,3,4)>59
DO ERR^MAGDQRUE("Invalid minutes in '"_L_"' time: """_V_""".")
+5 IF $EXTRACT(V,5,6)
IF $EXTRACT(V,5,6)>59
DO ERR^MAGDQRUE("Invalid seconds '"_L_"' time: """_V_""".")
+6 QUIT
+7 ;
ELIM(ONE,TWO,I1,I2,E,C) NEW ANY,I,O
+1 if 'ONE
QUIT
if 'TWO
QUIT
+2 SET I=""
FOR
SET I=$ORDER(^TMP("MAG",$JOB,"QR",I1,I))
if I=""
QUIT
Begin DoDot:1
+3 SET O=I
IF C
if I'["^"
QUIT
SET O=+I
+4 IF '$DATA(^TMP("MAG",$JOB,"QR",I2,O))
KILL ^TMP("MAG",$JOB,"QR",I1,I)
+5 QUIT
End DoDot:1
+6 SET I=""
FOR
SET I=$ORDER(^TMP("MAG",$JOB,"QR",I2,I))
if I=""
QUIT
Begin DoDot:1
+7 SET O=I
IF C
if I'["^"
QUIT
SET O=+I
+8 IF '$DATA(^TMP("MAG",$JOB,"QR",I1,O))
KILL ^TMP("MAG",$JOB,"QR",I2,I)
+9 QUIT
End DoDot:1
+10 SET ANY=($DATA(^TMP("MAG",$JOB,"QR",I1))>9)*($DATA(^TMP("MAG",$JOB,"QR",I2))>9)
+11 if 'ANY
DO ERR^MAGDQRUE("No matches left, conflict between "_E)
+12 QUIT
+13 ;
ELIMB(ONE,TWO,I1,I2,E) NEW ANY,I,O
+1 ; elimination logic between subtrees w/different data structures,
+2 ; e.g., 11 (I1) and 12 (I2)
+3 ; match flag
NEW HIT
+4 if 'ONE
QUIT
if 'TWO
QUIT
+5 SET I=""
FOR
SET I=$ORDER(^TMP("MAG",$JOB,"QR",I1,I))
if I=""
QUIT
Begin DoDot:1
+6 SET O=""
SET HIT=0
+7 ; match?
+8 ; yes
FOR
SET O=$ORDER(^TMP("MAG",$JOB,"QR",I2,O))
if O=""
QUIT
IF $PIECE(O,"^",2)=I
SET HIT=1
QUIT
+9 ; no
if 'HIT
KILL ^TMP("MAG",$JOB,"QR",I1,I)
+10 QUIT
End DoDot:1
+11 SET I=""
FOR
SET I=$ORDER(^TMP("MAG",$JOB,"QR",I2,I))
if I=""
QUIT
Begin DoDot:1
+12 ; match
SET O=$PIECE(I,"^",2)
IF O
IF $DATA(^TMP("MAG",$JOB,"QR",I1,O))
QUIT
+13 ; no match
KILL ^TMP("MAG",$JOB,"QR",I2,I)
+14 QUIT
End DoDot:1
+15 SET ANY=($DATA(^TMP("MAG",$JOB,"QR",I1))>9)*($DATA(^TMP("MAG",$JOB,"QR",I2))>9)
+16 if 'ANY
DO ERR^MAGDQRUE("No matches left, conflict between "_E)
+17 QUIT
