- 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 23, 2025@18:22:12 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
