MAGNVQ05 ;WOIFO/NST - List images for a patient ; OCT 18, Sep 2017 3:59 PM
;;3.0;IMAGING;**185,221**;Mar 19, 2002;Build 4525;May 01, 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
;
QUERY34(IARRAY,DFN,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Query P34 database
I DFN D PATIMG34(.IARRAY,DFN,IMGLESS,FROMDATE,TODATE,.MAGDATA) Q
;
D STUDYQRY(.IARRAY,IMGLESS,FROMDATE,TODATE,.MAGDATA) ; Get images from P34 database by Study query
Q
;
PATIMG34(IARRAY,DFN,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Get images from P34 database by Patient
; IARRAY = Output array with patient images
; DFN = Patient DFN
; IMGLESS = 0|1 Include images
; FROMDATE,TODATE = Capture date range of images
; .MAGDATA = Filters
;
N PATIX,PROCIX,STYIX,SERIX,SOPIX,IMAGE,MAGCAPDT
N ACTVIMG,CLASS,CPTCODE,EVT,FOUND,PROC,SPEC,PKG,ORIG,TYPE,TMP
;
S PATIX=""
F S PATIX=$O(^MAGV(2005.6,"C",DFN,PATIX)) Q:'PATIX D
. S PROCIX=""
. F S PROCIX=$O(^MAGV(2005.61,"C",PATIX,PROCIX)) Q:'PROCIX D
. . S TMP=$G(^MAGV(2005.61,PROCIX,0))
. . Q:$P(TMP,"^",5)'="A" ; not active
. . I $D(MAGDATA("CPTCODE")) D Q:'FOUND ; CPT Code doesn't match
. . . S CPTCODE=""
. . . S ACCNUM=$P(TMP,"^",1) ; Accession number
. . . S PROCTYPE=$P(TMP,"^",3) ; Procedure Type
. . . S CPTCODE=$$CPTCODE(ACCNUM,PROCTYPE)
. . . S FOUND=$S(CPTCODE="":0,1:$D(MAGDATA("CPTCODE",CPTCODE)))
. . . Q
. . S STYIX=""
. . F S STYIX=$O(^MAGV(2005.62,"C",PROCIX,STYIX)) Q:'STYIX D
. . . Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)="I" ; study marked inaccessible
. . . S MAGCAPDT=$P($G(^MAGV(2005.62,STYIX,2)),"^",1) ; study date time
. . . Q:(MAGCAPDT<FROMDATE)!(MAGCAPDT>TODATE) ; study out of date range
. . . Q:'$$FLTRSTUD(STYIX,.MAGDATA) ; Filter on study level
. . . S SERIX=""
. . . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. . . . Q:'$$FLTRSER(SERIX,.MAGDATA) ; Filter on series level
. . . . ;
. . . . S ACTVIMG=0
. . . . S SOPIX=""
. . . . F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D Q:IMGLESS&ACTVIMG
. . . . . I $D(MAGDATA("TYPE")) S TYPE=$P($G(^MAGV(2005.64,SOPIX,5)),"^",1) Q:TYPE="" Q:'$D(MAGDATA("TYPE",TYPE)) ; Type Index
. . . . . S IMAGE=""
. . . . . F S IMAGE=$O(^MAGV(2005.65,"C",SOPIX,IMAGE)) Q:'IMAGE D
. . . . . . I $P($G(^MAGV(2005.65,IMAGE,1)),"^",5)'="I" D
. . . . . . . S IARRAY(STYIX,SERIX,SOPIX,IMAGE)="",ACTVIMG=1
. . . . . . . Q
. . . . . . Q
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
Q
;
CPTCODE(ACCNUM,PROCTYPE) ; Get CPT by Accession number
N OSEP,ISEP,SSEP,OUT,CPTCODE,I,FOUNDC,FOUNDT
I PROCTYPE'="RAD" Q ""
S OSEP=$$OUTSEP^MAGVRS41,ISEP=$$INPUTSEP^MAGVRS41,SSEP=$$STATSEP^MAGVRS41
D GETRPROC^MAGVRS81(.OUT,ACCNUM) ; Get radiology exam details
S (FOUNDC,FOUNDT)=0
S CPTCODE=""
S I=""
F S I=$O(OUT(I)) Q:(FOUNDC&FOUNDT)!'I D
. I $P(OUT(I),OSEP,1)="PROCEDURE CODE" S CPTCODE=$P($P(OUT(I),OSEP,2),SSEP),FOUNDC=1 Q
. I ($P(OUT(I),OSEP,1)="TERMINOLOGY"),($P($P(OUT(I),OSEP,2),SSEP)="CPT") S FOUNDT=1 Q
. Q
Q CPTCODE
;
FLTRSER(SERIX,MAGDATA) ; Filter on Series level
N CLASS,MODALITY,PROC,SPEC,TMP
;
I $D(MAGDATA("MODALITY")) S MODALITY=$P($G(^MAGV(2005.63,SERIX,1)),"^") Q:MODALITY="" 0 Q:'$D(MAGDATA("MODALITY",MODALITY)) 0
;
S TMP=$G(^MAGV(2005.63,SERIX,10))
I $D(MAGDATA("CLS")) S CLASS=$P(TMP,"^",1) Q:CLASS="" 0 Q:'$D(MAGDATA("CLS",CLASS)) 0 ; CLASS INDEX
I $D(MAGDATA("PROC")) S PROC=$P(TMP,"^",2) Q:PROC="" 0 Q:'$D(MAGDATA("PROC",PROC)) 0 ; PROC/EVENT INDEX
I $D(MAGDATA("SPEC")) S SPEC=$P(TMP,"^",2) Q:SPEC="" 0 Q:'$D(MAGDATA("SPEC",SPEC)) 0 ; SPEC/SUBSPEC INDEX
Q 1
;
FLTRSTUD(STYIX,MAGDATA) ; Filter on Study level
N TMP,ORIG,PKG
S TMP=$G(^MAGV(2005.62,STYIX,3))
I $D(MAGDATA("GDESC")) Q:$$UP^XLFSTR($P(TMP,U,1))'[MAGDATA("GDESC") 0 ; Short description
I $D(MAGDATA("ORIG")) S ORIG=$P(TMP,"^",2) Q:ORIG="" 0 Q:'$D(MAGDATA("ORIG",ORIG)) 0 ; Origin Index
I $D(MAGDATA("PKG")) S PKG=$$GET1^DIQ(2005.62,STYIX,"11:40","I") Q:PKG="" 0 Q:'$D(MAGDATA("PKG",PKG)) 0
Q 1
;
STUDYQRY(IARRAY,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Get images from P34 database by Study query
; IARRAY = Output array with patient images
; IMGLESS = 0|1 Include images
; FROMDATE,TODATE = Capture date range of images
; .MAGDATA = Filters
N ACTVIMG,DATEIX,IMAGE,STYIX,SERIX,SOPIX,TYPE
;
S DATEIX=FROMDATE-1
F S DATEIX=$O(^MAGV(2005.62,"J",DATEIX)) Q:'DATEIX!(DATEIX>TODATE) D
. S STYIX=""
. F S STYIX=$O(^MAGV(2005.62,"J",DATEIX,STYIX)) Q:'STYIX D
. . Q:$P($G(^MAGV(2005.62,STYIX,5)),"^",2)="I" ; study marked inaccessible
. . Q:'$$FLTRSTUD(STYIX,.MAGDATA) ; Filter on study level
. . S SERIX=""
. . F S SERIX=$O(^MAGV(2005.63,"C",STYIX,SERIX)) Q:'SERIX D
. . . Q:'$$FLTRSER(SERIX,.MAGDATA) ; Filter on series level
. . . ;
. . . S ACTVIMG=0
. . . S SOPIX=""
. . . F S SOPIX=$O(^MAGV(2005.64,"C",SERIX,SOPIX)) Q:'SOPIX D Q:IMGLESS&ACTVIMG
. . . . I $D(MAGDATA("TYPE")) S TYPE=$P($G(^MAGV(2005.64,SOPIX,5)),"^",1) Q:TYPE="" Q:'$D(MAGDATA("TYPE",TYPE)) ; Type Index
. . . . S IMAGE=""
. . . . F S IMAGE=$O(^MAGV(2005.65,"C",SOPIX,IMAGE)) Q:'IMAGE D
. . . . . I $P($G(^MAGV(2005.65,IMAGE,1)),"^",5)'="I" D
. . . . . . S IARRAY(STYIX,SERIX,SOPIX,IMAGE)="",ACTVIMG=1
. . . . . . Q
. . . . . Q
. . . . Q
. . . Q
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNVQ05 6315 printed Apr 09, 2024@21:07 Page 2
MAGNVQ05 ;WOIFO/NST - List images for a patient ; OCT 18, Sep 2017 3:59 PM
+1 ;;3.0;IMAGING;**185,221**;Mar 19, 2002;Build 4525;May 01, 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 ;
QUERY34(IARRAY,DFN,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Query P34 database
+1 IF DFN
DO PATIMG34(.IARRAY,DFN,IMGLESS,FROMDATE,TODATE,.MAGDATA)
QUIT
+2 ;
+3 ; Get images from P34 database by Study query
DO STUDYQRY(.IARRAY,IMGLESS,FROMDATE,TODATE,.MAGDATA)
+4 QUIT
+5 ;
PATIMG34(IARRAY,DFN,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Get images from P34 database by Patient
+1 ; IARRAY = Output array with patient images
+2 ; DFN = Patient DFN
+3 ; IMGLESS = 0|1 Include images
+4 ; FROMDATE,TODATE = Capture date range of images
+5 ; .MAGDATA = Filters
+6 ;
+7 NEW PATIX,PROCIX,STYIX,SERIX,SOPIX,IMAGE,MAGCAPDT
+8 NEW ACTVIMG,CLASS,CPTCODE,EVT,FOUND,PROC,SPEC,PKG,ORIG,TYPE,TMP
+9 ;
+10 SET PATIX=""
+11 FOR
SET PATIX=$ORDER(^MAGV(2005.6,"C",DFN,PATIX))
if 'PATIX
QUIT
Begin DoDot:1
+12 SET PROCIX=""
+13 FOR
SET PROCIX=$ORDER(^MAGV(2005.61,"C",PATIX,PROCIX))
if 'PROCIX
QUIT
Begin DoDot:2
+14 SET TMP=$GET(^MAGV(2005.61,PROCIX,0))
+15 ; not active
if $PIECE(TMP,"^",5)'="A"
QUIT
+16 ; CPT Code doesn't match
IF $DATA(MAGDATA("CPTCODE"))
Begin DoDot:3
+17 SET CPTCODE=""
+18 ; Accession number
SET ACCNUM=$PIECE(TMP,"^",1)
+19 ; Procedure Type
SET PROCTYPE=$PIECE(TMP,"^",3)
+20 SET CPTCODE=$$CPTCODE(ACCNUM,PROCTYPE)
+21 SET FOUND=$SELECT(CPTCODE="":0,1:$DATA(MAGDATA("CPTCODE",CPTCODE)))
+22 QUIT
End DoDot:3
if 'FOUND
QUIT
+23 SET STYIX=""
+24 FOR
SET STYIX=$ORDER(^MAGV(2005.62,"C",PROCIX,STYIX))
if 'STYIX
QUIT
Begin DoDot:3
+25 ; study marked inaccessible
if $PIECE($GET(^MAGV(2005.62,STYIX,5)),"^",2)="I"
QUIT
+26 ; study date time
SET MAGCAPDT=$PIECE($GET(^MAGV(2005.62,STYIX,2)),"^",1)
+27 ; study out of date range
if (MAGCAPDT<FROMDATE)!(MAGCAPDT>TODATE)
QUIT
+28 ; Filter on study level
if '$$FLTRSTUD(STYIX,.MAGDATA)
QUIT
+29 SET SERIX=""
+30 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:4
+31 ; Filter on series level
if '$$FLTRSER(SERIX,.MAGDATA)
QUIT
+32 ;
+33 SET ACTVIMG=0
+34 SET SOPIX=""
+35 FOR
SET SOPIX=$ORDER(^MAGV(2005.64,"C",SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:5
+36 ; Type Index
IF $DATA(MAGDATA("TYPE"))
SET TYPE=$PIECE($GET(^MAGV(2005.64,SOPIX,5)),"^",1)
if TYPE=""
QUIT
if '$DATA(MAGDATA("TYPE",TYPE))
QUIT
+37 SET IMAGE=""
+38 FOR
SET IMAGE=$ORDER(^MAGV(2005.65,"C",SOPIX,IMAGE))
if 'IMAGE
QUIT
Begin DoDot:6
+39 IF $PIECE($GET(^MAGV(2005.65,IMAGE,1)),"^",5)'="I"
Begin DoDot:7
+40 SET IARRAY(STYIX,SERIX,SOPIX,IMAGE)=""
SET ACTVIMG=1
+41 QUIT
End DoDot:7
+42 QUIT
End DoDot:6
+43 QUIT
End DoDot:5
if IMGLESS&ACTVIMG
QUIT
+44 QUIT
End DoDot:4
+45 QUIT
End DoDot:3
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 QUIT
+49 ;
CPTCODE(ACCNUM,PROCTYPE) ; Get CPT by Accession number
+1 NEW OSEP,ISEP,SSEP,OUT,CPTCODE,I,FOUNDC,FOUNDT
+2 IF PROCTYPE'="RAD"
QUIT ""
+3 SET OSEP=$$OUTSEP^MAGVRS41
SET ISEP=$$INPUTSEP^MAGVRS41
SET SSEP=$$STATSEP^MAGVRS41
+4 ; Get radiology exam details
DO GETRPROC^MAGVRS81(.OUT,ACCNUM)
+5 SET (FOUNDC,FOUNDT)=0
+6 SET CPTCODE=""
+7 SET I=""
+8 FOR
SET I=$ORDER(OUT(I))
if (FOUNDC&FOUNDT)!'I
QUIT
Begin DoDot:1
+9 IF $PIECE(OUT(I),OSEP,1)="PROCEDURE CODE"
SET CPTCODE=$PIECE($PIECE(OUT(I),OSEP,2),SSEP)
SET FOUNDC=1
QUIT
+10 IF ($PIECE(OUT(I),OSEP,1)="TERMINOLOGY")
IF ($PIECE($PIECE(OUT(I),OSEP,2),SSEP)="CPT")
SET FOUNDT=1
QUIT
+11 QUIT
End DoDot:1
+12 QUIT CPTCODE
+13 ;
FLTRSER(SERIX,MAGDATA) ; Filter on Series level
+1 NEW CLASS,MODALITY,PROC,SPEC,TMP
+2 ;
+3 IF $DATA(MAGDATA("MODALITY"))
SET MODALITY=$PIECE($GET(^MAGV(2005.63,SERIX,1)),"^")
if MODALITY=""
QUIT 0
if '$DATA(MAGDATA("MODALITY",MODALITY))
QUIT 0
+4 ;
+5 SET TMP=$GET(^MAGV(2005.63,SERIX,10))
+6 ; CLASS INDEX
IF $DATA(MAGDATA("CLS"))
SET CLASS=$PIECE(TMP,"^",1)
if CLASS=""
QUIT 0
if '$DATA(MAGDATA("CLS",CLASS))
QUIT 0
+7 ; PROC/EVENT INDEX
IF $DATA(MAGDATA("PROC"))
SET PROC=$PIECE(TMP,"^",2)
if PROC=""
QUIT 0
if '$DATA(MAGDATA("PROC",PROC))
QUIT 0
+8 ; SPEC/SUBSPEC INDEX
IF $DATA(MAGDATA("SPEC"))
SET SPEC=$PIECE(TMP,"^",2)
if SPEC=""
QUIT 0
if '$DATA(MAGDATA("SPEC",SPEC))
QUIT 0
+9 QUIT 1
+10 ;
FLTRSTUD(STYIX,MAGDATA) ; Filter on Study level
+1 NEW TMP,ORIG,PKG
+2 SET TMP=$GET(^MAGV(2005.62,STYIX,3))
+3 ; Short description
IF $DATA(MAGDATA("GDESC"))
if $$UP^XLFSTR($PIECE(TMP,U,1))'[MAGDATA("GDESC")
QUIT 0
+4 ; Origin Index
IF $DATA(MAGDATA("ORIG"))
SET ORIG=$PIECE(TMP,"^",2)
if ORIG=""
QUIT 0
if '$DATA(MAGDATA("ORIG",ORIG))
QUIT 0
+5 IF $DATA(MAGDATA("PKG"))
SET PKG=$$GET1^DIQ(2005.62,STYIX,"11:40","I")
if PKG=""
QUIT 0
if '$DATA(MAGDATA("PKG",PKG))
QUIT 0
+6 QUIT 1
+7 ;
STUDYQRY(IARRAY,IMGLESS,FROMDATE,TODATE,MAGDATA) ; Get images from P34 database by Study query
+1 ; IARRAY = Output array with patient images
+2 ; IMGLESS = 0|1 Include images
+3 ; FROMDATE,TODATE = Capture date range of images
+4 ; .MAGDATA = Filters
+5 NEW ACTVIMG,DATEIX,IMAGE,STYIX,SERIX,SOPIX,TYPE
+6 ;
+7 SET DATEIX=FROMDATE-1
+8 FOR
SET DATEIX=$ORDER(^MAGV(2005.62,"J",DATEIX))
if 'DATEIX!(DATEIX>TODATE)
QUIT
Begin DoDot:1
+9 SET STYIX=""
+10 FOR
SET STYIX=$ORDER(^MAGV(2005.62,"J",DATEIX,STYIX))
if 'STYIX
QUIT
Begin DoDot:2
+11 ; study marked inaccessible
if $PIECE($GET(^MAGV(2005.62,STYIX,5)),"^",2)="I"
QUIT
+12 ; Filter on study level
if '$$FLTRSTUD(STYIX,.MAGDATA)
QUIT
+13 SET SERIX=""
+14 FOR
SET SERIX=$ORDER(^MAGV(2005.63,"C",STYIX,SERIX))
if 'SERIX
QUIT
Begin DoDot:3
+15 ; Filter on series level
if '$$FLTRSER(SERIX,.MAGDATA)
QUIT
+16 ;
+17 SET ACTVIMG=0
+18 SET SOPIX=""
+19 FOR
SET SOPIX=$ORDER(^MAGV(2005.64,"C",SERIX,SOPIX))
if 'SOPIX
QUIT
Begin DoDot:4
+20 ; Type Index
IF $DATA(MAGDATA("TYPE"))
SET TYPE=$PIECE($GET(^MAGV(2005.64,SOPIX,5)),"^",1)
if TYPE=""
QUIT
if '$DATA(MAGDATA("TYPE",TYPE))
QUIT
+21 SET IMAGE=""
+22 FOR
SET IMAGE=$ORDER(^MAGV(2005.65,"C",SOPIX,IMAGE))
if 'IMAGE
QUIT
Begin DoDot:5
+23 IF $PIECE($GET(^MAGV(2005.65,IMAGE,1)),"^",5)'="I"
Begin DoDot:6
+24 SET IARRAY(STYIX,SERIX,SOPIX,IMAGE)=""
SET ACTVIMG=1
+25 QUIT
End DoDot:6
+26 QUIT
End DoDot:5
+27 QUIT
End DoDot:4
if IMGLESS&ACTVIMG
QUIT
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
