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

MAGDQR09.m

Go to the documentation of this file.
  1. MAGDQR09 ;WOIFO/EDM,MLH,NST,BT,PMK - Imaging RPCs for Query/Retrieve ; Feb 15, 2022@10:26:14
  1. ;;3.0;IMAGING;**118,305**;Mar 19, 2002;Build 3
  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. ; Overflows from MAGDQR03
  1. Q020000D(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Study Instance UID
  1. ; sensitive/employee?
  1. I SENSEMP D Q ; yes, scrub
  1. . S V(T)="1.2.840.113754.2.1.3.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID"))
  1. . Q
  1. ; no
  1. S V(T)="" Q:'MAGIEN
  1. D ; retrieve from old or new DB?
  1. . N PARENT
  1. . I TYPE'="N" D Q
  1. . . N PARENT
  1. . . S PARENT=$P($G(^MAG(2005,MAGIEN,0)),"^",10)
  1. . . S:'PARENT PARENT=MAGIEN
  1. . . S V(T)=$P($G(^MAG(2005,PARENT,"PACS")),"^",1)
  1. . . Q
  1. . I TYPE="N" D Q
  1. . . S PARENT=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'PARENT Q
  1. . . S PARENT=$P($G(^MAGV(2005.63,PARENT,6)),"^",1) I 'PARENT Q
  1. . . S V(T)=$P($G(^MAGV(2005.62,PARENT,0)),"^",1)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. Q020000E(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;U Series Instance UID
  1. ; sensitive/employee?
  1. I SENSEMP D Q ; yes, scrub
  1. . S V(T)="1.2.840.113754.2.1.3.1.1.1.66."_$G(^TMP("MAG",$J,"DICOMQR","DUMMY SIUID"))
  1. . Q
  1. ; no
  1. D ; retrieve from old or new DB?
  1. . N PARENT
  1. . I TYPE'="N" D Q
  1. . . I MAGIEN="" S V(T)="" Q
  1. . . S V(T)=$P($G(^MAG(2005,MAGIEN,"SERIESUID")),"^",1)
  1. . . Q
  1. . I TYPE="N" D Q
  1. . . S PARENT=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'PARENT Q
  1. . . S V(T)=$P($G(^MAGV(2005.63,PARENT,0)),"^",1)
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. Q0080061(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Modalities in Study
  1. ; sensitive/employee?
  1. I SENSEMP D Q ; yes, scrub
  1. . N I
  1. . S I=$O(REQ(T,""))
  1. . S V(T)="OT" I I,$G(REQ(T,I))]"" S V(T)=REQ(T,I)
  1. . Q
  1. ; no
  1. N ANY,I1,I2,LIST,MOD,P1,P2,R,TMP,PARENT,I,X
  1. I MAGIEN="" S V(T)="" Q
  1. ;
  1. S I1="" F S I1=$O(REQ(T,I1)) Q:I1="" D
  1. . S R=$TR(REQ(T,I1),"/","\")
  1. . F I2=1:1:$L(R,"\") S X=$P(R,"\",I2) S:X'="" LIST(X)=1
  1. . Q
  1. ;
  1. ; select based on old/new DB
  1. I TYPE="N" D NSTYMOD(MAGIEN,.MOD)
  1. I (TYPE="C")!(TYPE="R") D STYMOD(MAGIEN,.MOD)
  1. ;
  1. ; return only the requested Modalities
  1. S R="",ANY=0,X=""
  1. F S X=$O(MOD(X)) Q:X="" D
  1. . D ; filter out consult-related noise
  1. . . Q:$E(X,1,7)="CONSULT" Q:X="CON/PROC"
  1. . . S:R'="" R=R_"," S R=R_X
  1. . . Q
  1. . I $O(LIST(""))="" S ANY=1 Q
  1. . S I1="" F S I1=$O(LIST(I1)) Q:I1="" D Q:ANY
  1. . . S:$$MATCHD^MAGDQR03(X,"LIST(LOOP)","TMP(LOOP)") ANY=1
  1. . . Q
  1. . Q
  1. S V(T)=R
  1. I 'ANY,$D(LIST) S OK=0 ; no matches
  1. Q
  1. ;
  1. ;given MAGIEN, save all study's modalities (New DB) to MOD array
  1. NSTYMOD(MAGIEN,MOD) ;
  1. N SERREF,STYREF,D0,MODS,I,MODITEM
  1. S SERREF=$P($G(^MAGV(2005.64,MAGIEN,6)),"^",1) I 'SERREF Q
  1. S STYREF=$P($G(^MAGV(2005.63,SERREF,6)),"^",1) I 'STYREF Q
  1. S D0=0
  1. F S D0=$O(^MAGV(2005.63,"C",STYREF,D0)) Q:'D0 D
  1. . S MODS=$P($G(^MAGV(2005.63,D0,1)),"^",1)
  1. . F I=1:1:$L(MODS,"/") S MODITEM=$P(MODS,"/",I) S:$L(MODITEM) MOD(MODITEM)=""
  1. Q
  1. ;
  1. ;given MAGIEN, save all study's modalities (Old/legacy DB) to MOD array
  1. STYMOD(MAGIEN,MOD) ;
  1. N STUDYUID,X,R,P1,P2
  1. S STUDYUID=$P($G(^MAG(2005,MAGIEN,"PACS")),"^",1) Q:STUDYUID=""
  1. S MAGIEN=0
  1. F S MAGIEN=$O(^MAG(2005,"P",STUDYUID,MAGIEN)) Q:'MAGIEN D
  1. . S X=$P($G(^MAG(2005,MAGIEN,0)),"^",8)
  1. . S:$E(X,1,4)="RAD " X=$E(X,5,$L(X))
  1. . S:X'="" MOD(X)=""
  1. . S R="",P1=0
  1. . F S P1=$O(^MAG(2005,MAGIEN,1,P1)) Q:'P1 D
  1. . . S P2=+$G(^MAG(2005,MAGIEN,1,P1,0)) Q:'P2
  1. . . S X=$P($G(^MAG(2005,P2,0)),"^",8)
  1. . . S:$E(X,1,4)="RAD " X=$E(X,5,$L(X))
  1. . . S:X'="" MOD(X)=""
  1. . . Q
  1. . Q
  1. Q
  1. ;
  1. Q0201206(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Series
  1. ; sensitive/employee?
  1. I $G(SENSEMP) D Q ; yes, scrub
  1. . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
  1. . Q
  1. ; no
  1. N N,S,UID
  1. S UID=$G(V("0020,000D")),N=0
  1. D:UID'="" ; select based on old/new type
  1. . I TYPE="N" D Q ; new P34 DB
  1. . . N STYIX,SERIX
  1. . . S STYIX=0
  1. . . F S STYIX=$O(^MAGV(2005.62,"B",UID,STYIX)) Q:STYIX="" D
  1. . . . I $$PROBLEM62^MAGDSTA8(STYIX) Q ; P305 PMK 12/06/2021
  1. . . . ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
  1. . . . S SERIX=0
  1. . . . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
  1. . . . . I $$PROBLEM63^MAGDSTA8(SERIX) Q ; P305 PMK 12/06/2021
  1. . . . . ; S:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)="A" N=N+1 ; accessible status
  1. . . . . S N=N+1
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . I (TYPE="R")!(TYPE="C") D Q ; legacy DB
  1. . . S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" S N=N+1
  1. . . Q
  1. . Q
  1. S V(T)=N
  1. S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
  1. Q
  1. ;
  1. Q0201208(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Number of Study Related Instances
  1. ; sensitive/employee?
  1. I $G(SENSEMP) D Q ; yes, scrub
  1. . N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
  1. . Q
  1. ; no
  1. N N,P1,P2,S,UID
  1. S UID=$G(V("0020,000D")),N=0
  1. D:UID'="" ; select based on old / new type
  1. . I TYPE="N" D Q
  1. . . N STYIX,SERIX,SOPIX
  1. . . S STYIX=0
  1. . . F S STYIX=$O(^MAGV(2005.62,"B",UID,STYIX)) Q:STYIX="" D
  1. . . . I $$PROBLEM62^MAGDSTA8(STYIX) Q ; P305 PMK 12/06/2021
  1. . . . ; Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)'="A" ; inaccessible status
  1. . . . S SERIX=0
  1. . . . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
  1. . . . . I $$PROBLEM63^MAGDSTA8(SERIX) Q ; P305 PMK 12/06/2021
  1. . . . . ; Q:$P($G(^MAGV(2005.63,SERIX,9)),"^",1)'="A" ; inaccessible status
  1. . . . . S SOPIX=0
  1. . . . . F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D
  1. . . . . . I $$PROBLEM64^MAGDSTA8(SOPIX) Q ; P305 PMK 12/06/2021
  1. . . . . . ; S:$P($G(^MAGV(2005.64,SOPIX,11)),"^",1)="A" N=N+1 ; accessible status
  1. . . . . . S N=N+1
  1. . . . . . Q
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . I (TYPE="R")!(TYPE="C") D Q
  1. . . S S="" F S S=$O(^MAG(2005,"P",UID,S)) Q:S="" D
  1. . . . S P1=0 F S P1=$O(^MAG(2005,S,1,P1)) Q:'P1 D
  1. . . . . S P2=+$G(^MAG(2005,S,1,P1,0)) Q:'P2
  1. . . . . S N=N+1
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . Q
  1. S V(T)=N
  1. S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
  1. Q