MAGNVQ02 ;WOIFO/NST - Image query by Context ; 16 Oct 2017 3:59 PM
;;3.0;IMAGING;**185**;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
;
;***** Check for images by context
;
; RPC: MAGN IMAGE EXIST BY CONTEXT
;
; Input Parameters
; ================
;
; DATA - Array contexts in format
; e.g. 'RPT^CPRS^29027^RA^79029185.9998-1'
; or
; RPT^CPRS^4658^TIU^2243408^^^^^^^^1
;
; Return Values
; =============
;
; if error MAGRY(0) = 0 ^Error message^
; if success MAGRY(0) = 1
; MAGRY(1..n) = CONTEXTID | 0 | error message
; CONTEXTID | 1 | 0 or 1 (has images)
;
IMGEXIST(MAGRY,DATA) ;RPC [MAGN IMAGE EXIST BY CONTEXT]
N MAGNI,MAGNCNT,MAGNX,RESULT,HASIMAGE
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
K MAGRY
S MAGRY(0)=0
S MAGNCNT=0
S MAGNI=""
I $G(DATA)'="" S DATA(1)=DATA ; in case of a single context ID
F S MAGNI=$O(DATA(MAGNI)) Q:MAGNI="" D
. S MAGNCXT=DATA(MAGNI) ; contextID
. I $P(MAGNCXT,"^",1,2)'="RPT^CPRS" D Q
. . D SETRES(.MAGRY,.MAGNCNT,MAGNCXT,"0^Unsupported ContextId Type",0)
. . Q
. ;
. S MAGNX=$P(MAGNCXT,"^",4)
. I MAGNX="RA" D Q
. . S HASIMAGE=$$IMAGERA(MAGNCXT) ; get image list for a single Radiology contextID
. . D SETRES(.MAGRY,.MAGNCNT,MAGNCXT,1,HASIMAGE)
. . Q
. I MAGNX="TIU" D Q
. . N MAGNTIU
. . S MAGNTIU=$P(MAGNCXT,"^",5)
. . S RESULT=$$IMAGETIU(MAGNTIU) ; get image list for a single TIU contextID
. . D SETRES(.MAGRY,.MAGNCNT,MAGNCXT,1,HASIMAGE)
. . Q
. D SETRES(.MAGRY,.MAGNCNT,MAGNCXT,"0^Unsupported ContextId Type",0)
. Q
S MAGRY(0)=1
Q
;
IMAGERA(DATA) ;A copy from MAGGTRAI
; DATA is in format of Windows message received from CPRS
; example 'RPT^CPRS^29027^RA^i79029185.9998-1'
N DFN,ENT,INVDTTM,INVDT,INVTM,X,RARPT,ACN
S DFN=+$P(DATA,U,3)
S ENT=+$P($P(DATA,U,5),"-",2)
S INVDTTM=$P($P(DATA,U,5),"-",1)
S INVDT=$P(INVDTTM,".",1)
S INVTM=$P(INVDTTM,".",2)
F Q:($L(INVDT)<8) S INVDT=$E(INVDT,2,$L(INVDT))
S INVDTTM=INVDT_"."_INVTM
S RARPT=0
I '$D(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0)) Q "0^INVALID Data : Attempt to access Exam failed."
S RARPT=$P(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,17)
I RARPT,($P($G(^RARPT(RARPT,0)),U,2)'=DFN) Q "0^Patient Mismatch. Radiology File"
;
I $P($G(^RARPT(RARPT,2005,0)),U,4) Q 1
;
S ACN=$$ACCNUM^RAAPI(DFN,INVDTTM,ENT)
I $L(ACN,"-")=3 S ACN=$P(ACN,"-",2,3)
;
S X=$$IMAGVX(ACN,"RAD") ; Check for images in P34 data structure
Q X
;
IMAGVX(ACCN,TYPE) ; Image in P34 data structure by Accession
N PROCIEN,AOF
; Check for images in P34 data structure
I ACCN="" Q 0
S PROCIEN=""
S AOF=0
F S PROCIEN=$O(^MAGV(2005.61,"B",ACCN,PROCIEN)) Q:'PROCIEN D Q:AOF
. I TYPE'=$$GET1^DIQ(2005.61,PROCIEN,.03,"I") Q ; Not the same procedure type
. S AOF=+$$GET1^DIQ(2005.61,PROCIEN,2,"I") ; Artifact on file
. Q
Q AOF
;
IMAGETIU(MAGTIU) ;
N ACCN,CONSIX,MAGARR,MAGDFN,MAGMRC
;
S MAGDFN=$$GET1^DIQ(8925,MAGTIU,.02,"I") ;MAGQI 8/22/01
I 'MAGDFN Q "0^Invalid Patient DFN for Note ID: '"_MAGTIU_"'"
;
D GETILST^TIUSRVPL(.MAGARR,MAGTIU) ; get Images from old data structure (2005)
I $D(MAGARR) Q 1
;
D GET1405^TIUSRVR(.MAGMRC,MAGTIU)
S CONSIX=+MAGMRC
I (CONSIX'>0)!'(MAGMRC["GMR(123") Q 0
S ACCN=$$GMRCACN^MAGDFCNV(CONSIX) ; site-specific accession number
;
S X=$$IMAGVX(ACCN,"CON")
Q X
;
SETRES(MAGRY,MAGNCNT,MAGNCXT,RESULT,HASIMAGE) ; Append result for one context
S MAGNCNT=MAGNCNT+1
S MAGRY(MAGNCNT)=MAGNCXT_"|"_RESULT_"|"_HASIMAGE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNVQ02 4605 printed Apr 09, 2024@21:05:10 Page 2
MAGNVQ02 ;WOIFO/NST - Image query by Context ; 16 Oct 2017 3:59 PM
+1 ;;3.0;IMAGING;**185**;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 ;
+19 ;***** Check for images by context
+20 ;
+21 ; RPC: MAGN IMAGE EXIST BY CONTEXT
+22 ;
+23 ; Input Parameters
+24 ; ================
+25 ;
+26 ; DATA - Array contexts in format
+27 ; e.g. 'RPT^CPRS^29027^RA^79029185.9998-1'
+28 ; or
+29 ; RPT^CPRS^4658^TIU^2243408^^^^^^^^1
+30 ;
+31 ; Return Values
+32 ; =============
+33 ;
+34 ; if error MAGRY(0) = 0 ^Error message^
+35 ; if success MAGRY(0) = 1
+36 ; MAGRY(1..n) = CONTEXTID | 0 | error message
+37 ; CONTEXTID | 1 | 0 or 1 (has images)
+38 ;
IMGEXIST(MAGRY,DATA) ;RPC [MAGN IMAGE EXIST BY CONTEXT]
+1 NEW MAGNI,MAGNCNT,MAGNX,RESULT,HASIMAGE
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGTERR"
+3 KILL MAGRY
+4 SET MAGRY(0)=0
+5 SET MAGNCNT=0
+6 SET MAGNI=""
+7 ; in case of a single context ID
IF $GET(DATA)'=""
SET DATA(1)=DATA
+8 FOR
SET MAGNI=$ORDER(DATA(MAGNI))
if MAGNI=""
QUIT
Begin DoDot:1
+9 ; contextID
SET MAGNCXT=DATA(MAGNI)
+10 IF $PIECE(MAGNCXT,"^",1,2)'="RPT^CPRS"
Begin DoDot:2
+11 DO SETRES(.MAGRY,.MAGNCNT,MAGNCXT,"0^Unsupported ContextId Type",0)
+12 QUIT
End DoDot:2
QUIT
+13 ;
+14 SET MAGNX=$PIECE(MAGNCXT,"^",4)
+15 IF MAGNX="RA"
Begin DoDot:2
+16 ; get image list for a single Radiology contextID
SET HASIMAGE=$$IMAGERA(MAGNCXT)
+17 DO SETRES(.MAGRY,.MAGNCNT,MAGNCXT,1,HASIMAGE)
+18 QUIT
End DoDot:2
QUIT
+19 IF MAGNX="TIU"
Begin DoDot:2
+20 NEW MAGNTIU
+21 SET MAGNTIU=$PIECE(MAGNCXT,"^",5)
+22 ; get image list for a single TIU contextID
SET RESULT=$$IMAGETIU(MAGNTIU)
+23 DO SETRES(.MAGRY,.MAGNCNT,MAGNCXT,1,HASIMAGE)
+24 QUIT
End DoDot:2
QUIT
+25 DO SETRES(.MAGRY,.MAGNCNT,MAGNCXT,"0^Unsupported ContextId Type",0)
+26 QUIT
End DoDot:1
+27 SET MAGRY(0)=1
+28 QUIT
+29 ;
IMAGERA(DATA) ;A copy from MAGGTRAI
+1 ; DATA is in format of Windows message received from CPRS
+2 ; example 'RPT^CPRS^29027^RA^i79029185.9998-1'
+3 NEW DFN,ENT,INVDTTM,INVDT,INVTM,X,RARPT,ACN
+4 SET DFN=+$PIECE(DATA,U,3)
+5 SET ENT=+$PIECE($PIECE(DATA,U,5),"-",2)
+6 SET INVDTTM=$PIECE($PIECE(DATA,U,5),"-",1)
+7 SET INVDT=$PIECE(INVDTTM,".",1)
+8 SET INVTM=$PIECE(INVDTTM,".",2)
+9 FOR
if ($LENGTH(INVDT)<8)
QUIT
SET INVDT=$EXTRACT(INVDT,2,$LENGTH(INVDT))
+10 SET INVDTTM=INVDT_"."_INVTM
+11 SET RARPT=0
+12 IF '$DATA(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0))
QUIT "0^INVALID Data : Attempt to access Exam failed."
+13 SET RARPT=$PIECE(^RADPT(DFN,"DT",INVDTTM,"P",ENT,0),U,17)
+14 IF RARPT
IF ($PIECE($GET(^RARPT(RARPT,0)),U,2)'=DFN)
QUIT "0^Patient Mismatch. Radiology File"
+15 ;
+16 IF $PIECE($GET(^RARPT(RARPT,2005,0)),U,4)
QUIT 1
+17 ;
+18 SET ACN=$$ACCNUM^RAAPI(DFN,INVDTTM,ENT)
+19 IF $LENGTH(ACN,"-")=3
SET ACN=$PIECE(ACN,"-",2,3)
+20 ;
+21 ; Check for images in P34 data structure
SET X=$$IMAGVX(ACN,"RAD")
+22 QUIT X
+23 ;
IMAGVX(ACCN,TYPE) ; Image in P34 data structure by Accession
+1 NEW PROCIEN,AOF
+2 ; Check for images in P34 data structure
+3 IF ACCN=""
QUIT 0
+4 SET PROCIEN=""
+5 SET AOF=0
+6 FOR
SET PROCIEN=$ORDER(^MAGV(2005.61,"B",ACCN,PROCIEN))
if 'PROCIEN
QUIT
Begin DoDot:1
+7 ; Not the same procedure type
IF TYPE'=$$GET1^DIQ(2005.61,PROCIEN,.03,"I")
QUIT
+8 ; Artifact on file
SET AOF=+$$GET1^DIQ(2005.61,PROCIEN,2,"I")
+9 QUIT
End DoDot:1
if AOF
QUIT
+10 QUIT AOF
+11 ;
IMAGETIU(MAGTIU) ;
+1 NEW ACCN,CONSIX,MAGARR,MAGDFN,MAGMRC
+2 ;
+3 ;MAGQI 8/22/01
SET MAGDFN=$$GET1^DIQ(8925,MAGTIU,.02,"I")
+4 IF 'MAGDFN
QUIT "0^Invalid Patient DFN for Note ID: '"_MAGTIU_"'"
+5 ;
+6 ; get Images from old data structure (2005)
DO GETILST^TIUSRVPL(.MAGARR,MAGTIU)
+7 IF $DATA(MAGARR)
QUIT 1
+8 ;
+9 DO GET1405^TIUSRVR(.MAGMRC,MAGTIU)
+10 SET CONSIX=+MAGMRC
+11 IF (CONSIX'>0)!'(MAGMRC["GMR(123")
QUIT 0
+12 ; site-specific accession number
SET ACCN=$$GMRCACN^MAGDFCNV(CONSIX)
+13 ;
+14 SET X=$$IMAGVX(ACCN,"CON")
+15 QUIT X
+16 ;
SETRES(MAGRY,MAGNCNT,MAGNCXT,RESULT,HASIMAGE) ; Append result for one context
+1 SET MAGNCNT=MAGNCNT+1
+2 SET MAGRY(MAGNCNT)=MAGNCXT_"|"_RESULT_"|"_HASIMAGE
+3 QUIT
