Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDQR02

MAGDQR02.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1. QUERY ; --- perform actual query --- Called by TaskMan
  1.  ; The RESULT index, MAGDUZ, and REQ() array are passed into this routine's
  1.  ; partition implicitly by the TaskMan invocation
  1.  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
  1.  ;
  1.  K ^TMP("MAG",$J,"QR")
  1.  S (PAT,SSN,ACC,UID,SID,SDT,TIM,FATAL)=0
  1.  S FD=0,LD=9999999,FT=0,LT=240000
  1.  ;
  1.  S PRMUID=0 ; 0=error, 1=all, 2=oldest, 3=newest
  1.  S T="0000,0902",I=0 ; Duplicate UID handling parameter
  1.  S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
  1.  . S PRMUID=REQ(T,P)
  1.  . Q
  1.  K REQ(T)
  1.  S:($L(PRMUID)'=1)!(123'[PRMUID) PRMUID=0
  1.  ;
  1.  S T="0008,0020",I=0 ; R  Study Date
  1.  S P="" F  S P=$O(REQ(T,P))   Q:P=""  D:REQ(T,P)'=""
  1.  . N FR,UT
  1.  . S I=I+1 I I>1 D ERR^MAGDQRUE("More than one study date specified.") Q
  1.  . S (X,FR,UT)=REQ(T,P) S:X["-" FR=$P(X,"-",1),UT=$P(X,"-",2)
  1.  . I FR'="",FR'?8N D ERR^MAGDQRUE("Invalid 'from' date: """_FR_""".")
  1.  . I UT'="",UT'?8N D ERR^MAGDQRUE("Invalid 'until' date: """_UT_""".")
  1.  . S FD=+FR S:FD FD=FD-17000000
  1.  . I UT'="" S LD=+UT S:LD LD=LD-17000000  ;P239;DSB-Fix last date when null
  1.  . I UT="" S LD=$$HTFM^XLFDT($H,1)
  1.  . S TIM=1
  1.  . Q
  1.  ;
  1.  S T="0008,0030",I=0 ; R  Study Time
  1.  S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
  1.  . N FR,UT
  1.  . S I=I+1 I I>1 D ERR^MAGDQRUE("More than one study time specified.") Q
  1.  . S (X,FR,UT)=REQ(T,P) S:X["-" FR=$P(X,"-",1),UT=$P(X,"-",2)
  1.  . D CHKTIM(FR,"from")
  1.  . D CHKTIM(UT,"until")
  1.  . S FT=+$E(FR_"000000",1,6)
  1.  . S LT=+$E(UT_"000000",1,6)
  1.  . S TIM=1
  1.  . Q
  1.  I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE Q
  1.  ;
  1.  S FD=FT/1E6+FD,LD=LT/1E6+LD
  1.  ;
  1.  S T="0010,0010",ANY=0 ; R  Patient's Name
  1.  S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
  1.  . ; The references below to ^DPT are permitted according to the
  1.  . ; explicit permission in Section II of the PIMS V5.3 technical manual
  1.  . ; (dated 23 Nov 2004)
  1.  . S ANY=1
  1.  . S I=$$MATCHD^MAGDQR03(REQ(T,P),"^DPT(""B"",LOOP)","^TMP(""MAG"",$J,""QR"",1,LOOP)")
  1.  . S V="" F  S V=$O(^TMP("MAG",$J,"QR",1,V)) Q:V=""  D
  1.  . . S I="" F  S I=$O(^DPT("B",V,I)) Q:I=""  S ^TMP("MAG",$J,"QR",2,I)="",PAT=1
  1.  . . Q
  1.  . Q
  1.  I ANY,'PAT D  Q
  1.  . D ERR^MAGDQRUE("No matches for tag "_T)
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  S T="0010,0020",ANY=0 ; R  Patient ID
  1.  S P="" F  S P=$O(REQ(T,P)) Q:P=""  D:REQ(T,P)'=""
  1.  . ; The references below to ^DPT are permitted according to the
  1.  . ; explicit permission in Section II of the PIMS V5.3 technical manual
  1.  . ; (dated 23 Nov 2004)
  1.  . S ANY=1
  1.  . S I=$$MATCHD^MAGDQR03($TR(REQ(T,P),"-"),"^DPT(""SSN"",LOOP)","^TMP(""MAG"",$J,""QR"",3,LOOP)")
  1.  . S V="" F  S V=$O(^TMP("MAG",$J,"QR",3,V)) Q:V=""  D
  1.  . . S I="" F  S I=$O(^DPT("SSN",V,I)) Q:I=""  S ^TMP("MAG",$J,"QR",4,I)="",SSN=1
  1.  . . Q
  1.  . I 'SSN,$$ISIHS^MAGSPID(),$TR(REQ(T,P),"*")?1.6N D  Q  ;IHS Health Record No - patient lookup
  1.  . . S V=$$FIND1^DIC(9000001,,"MX",$TR(REQ(T,P),"*")) ;IA #447 
  1.  . . S:V ^TMP("MAG",$J,"QR",4,V)="",SSN=1
  1.  . . Q
  1.  . Q
  1.  I ANY,'SSN D  Q
  1.  . D ERR^MAGDQRUE("No matches for tag "_T)
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  S T="0008,0050",ANY=0 ; R  Accession Number
  1.  D ACCNUM^MAGDQR07(.REQ,T,.ACC,.ANY)
  1.  I ANY,'ACC D  Q
  1.  . D ERR^MAGDQRUE("No matches for tag "_T)
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  S T="0020,0010",ANY=0 ; R  Study ID
  1.  D STUDYID^MAGDQR12(.REQ,T,.SID,.ANY)
  1.  I ANY,'SID D  Q
  1.  . D ERR^MAGDQRUE("No matches for tag "_T)
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  D  I ANY,'UID Q
  1.  . N OK,UIDS
  1.  . D UIDS^MAGDQR08(.REQ,T,.UID,PRMUID,.ANY,.OK,.UIDS)
  1.  . Q:'$G(ANY)  Q:$G(OK)
  1.  . S UID=0
  1.  . D ERR^MAGDQRUE("Conflicting UIDs: "_$G(UIDS))
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  I TIM,'(PAT+SSN+SID+UID+ACC) D TIM^MAGDQR05(.REQ,FD,LD,.TIM,.ANY,.SID)
  1.  ;
  1.  I '(PAT+SSN+SID+UID+ACC) D  Q
  1.  . D ERR^MAGDQRUE("No Selection Specified.")
  1.  . D ERRSAV^MAGDQRUE
  1.  . Q
  1.  ;
  1.  D ELIM(ACC,SID,6,10,"Accession and Study ID",0)
  1.  M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",6)
  1.  M ^TMP("MAG",$J,"QR",12)=^TMP("MAG",$J,"QR",10)
  1.  ;
  1.  D ELIM(PAT,SSN,2,4,"Patient Name and ID",0)
  1.  M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",2)
  1.  M ^TMP("MAG",$J,"QR",11)=^TMP("MAG",$J,"QR",4)
  1.  ;
  1.  D ELIMB(PAT+SSN,ACC+SID,11,12,"Patient and Study Info")
  1.  I $D(^TMP("MAG",$J,"ERR")) D ERRSAV^MAGDQRUE Q
  1.  ;
  1.  K ^TMP("MAG",$J,"DICOMQR")
  1.  S ^TMP("MAG",$J,"DICOMQR","RESULTSET")=0
  1.  S ^TMP("MAG",$J,"DICOMQR","DUMMY SIUID")=0
  1.  D  ; switch
  1.  . ;return data on image / study entries from appropriate queue based on type of lookup
  1.  . I UID D  Q  ; UID lookup case
  1.  . . S IMAGE="" F  S IMAGE=$O(^TMP("MAG",$J,"QR",8,IMAGE)) Q:IMAGE=""  D
  1.  . . . ; new or old database?
  1.  . . . I $E(IMAGE,1)="N" D UIDNEW^MAGDQR31(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD) Q
  1.  . . . D UIDOLD^MAGDQR32(IMAGE,.REQ,RESULT,MAGDUZ,PAT,SSN,ACC,SID,UID,FD,LD)
  1.  . . . Q
  1.  . . Q
  1.  . I ACC+SID D  Q  ; accession no. / study ID lookup case
  1.  . . S P="" F  S P=$O(^TMP("MAG",$J,"QR",12,P)) Q:P=""  D
  1.  . . . D ACCSID^MAGDQR10(P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD)
  1.  . . . Q
  1.  . . Q
  1.  . I PAT+SSN D  Q  ; pt name / SSN lookup case
  1.  . . S P="" F  S P=$O(^TMP("MAG",$J,"QR",11,P)) Q:P=""  D  Q:$G(FATAL)
  1.  . . . ; new database
  1.  . . . D:$D(^MAGV(2005.6,"B",P)) PATSSNNU^MAGDQR22(.P,.REQ,RESULT,MAGDUZ,PAT,SSN,UID,FD,LD,.ERROR,.FATAL)
  1.  . . . ; old database
  1.  . . . S IMAGE="" F  S IMAGE=$O(^MAG(2005,"AC",P,IMAGE)) Q:IMAGE=""  D  Q:$G(FATAL)
  1.  . . . . D PATSSNOL^MAGDQR23(IMAGE,.REQ,RESULT,MAGDUZ,FD,LD,.ERROR,.FATAL)
  1.  . . . . Q
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  ;
  1.  D:$O(PRMUID(""))'="" PRUNE^MAGDQR08(RESULT) ; There are duplicate UIDs
  1.  S $P(^MAGDQR(2006.5732,RESULT,0),"^",2,3)="OK^"_$$NOW^XLFDT()
  1.  K ^TMP("MAG",$J,"QR")
  1.  K ^TMP("MAG",$J,"DICOMQR")
  1.  Q
  1.  ;
  1. CHKTIM(V,L) ;
  1.  Q:V=""
  1.  I V'?1.6N D ERR^MAGDQRUE("Invalid '"_L_"' time: """_V_""".")
  1.  I $E(V,1,2)>23 D ERR^MAGDQRUE("Invalid hours in '"_L_"' time: """_V_""".")
  1.  I $E(V,3,4),$E(V,3,4)>59 D ERR^MAGDQRUE("Invalid minutes in '"_L_"' time: """_V_""".")
  1.  I $E(V,5,6),$E(V,5,6)>59 D ERR^MAGDQRUE("Invalid seconds '"_L_"' time: """_V_""".")
  1.  Q
  1.  ;
  1. ELIM(ONE,TWO,I1,I2,E,C) N ANY,I,O
  1.  Q:'ONE  Q:'TWO
  1.  S I="" F  S I=$O(^TMP("MAG",$J,"QR",I1,I)) Q:I=""  D
  1.  . S O=I I C Q:I'["^"  S O=+I
  1.  . I '$D(^TMP("MAG",$J,"QR",I2,O)) K ^TMP("MAG",$J,"QR",I1,I)
  1.  . Q
  1.  S I="" F  S I=$O(^TMP("MAG",$J,"QR",I2,I)) Q:I=""  D
  1.  . S O=I I C Q:I'["^"  S O=+I
  1.  . I '$D(^TMP("MAG",$J,"QR",I1,O)) K ^TMP("MAG",$J,"QR",I2,I)
  1.  . Q
  1.  S ANY=($D(^TMP("MAG",$J,"QR",I1))>9)*($D(^TMP("MAG",$J,"QR",I2))>9)
  1.  D:'ANY ERR^MAGDQRUE("No matches left, conflict between "_E)
  1.  Q
  1.  ;
  1. ELIMB(ONE,TWO,I1,I2,E) N ANY,I,O
  1.  ; elimination logic between subtrees w/different data structures,
  1.  ; e.g., 11 (I1) and 12 (I2)
  1.  N HIT ; match flag
  1.  Q:'ONE  Q:'TWO
  1.  S I="" F  S I=$O(^TMP("MAG",$J,"QR",I1,I)) Q:I=""  D
  1.  . S O="",HIT=0
  1.  . ; match?
  1.  . F  S O=$O(^TMP("MAG",$J,"QR",I2,O)) Q:O=""  I $P(O,"^",2)=I S HIT=1 Q  ; yes
  1.  . K:'HIT ^TMP("MAG",$J,"QR",I1,I) ; no
  1.  . Q
  1.  S I="" F  S I=$O(^TMP("MAG",$J,"QR",I2,I)) Q:I=""  D
  1.  . S O=$P(I,"^",2) I O,$D(^TMP("MAG",$J,"QR",I1,O)) Q  ; match
  1.  . K ^TMP("MAG",$J,"QR",I2,I) ; no match
  1.  . Q
  1.  S ANY=($D(^TMP("MAG",$J,"QR",I1))>9)*($D(^TMP("MAG",$J,"QR",I2))>9)
  1.  D:'ANY ERR^MAGDQRUE("No matches left, conflict between "_E)
  1.  Q