MAGDHOW0 ;WOIFO/PMK,DAC - Capture Consult/Request data ; Oct 04, 2021@12:30:55
;;3.0;IMAGING;**138,174,305**;Mar 19, 2002;Build 3
;; 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
;
FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
; input -- ARRAY ---- an HL7 array
; input -- SEGMENT -- three-letter HL7 segment identifier
; input -- I -------- index of the found segment (or null)
; output - I -------- index of the found segment (or null)
; output - X -------- string of fields sans segment identifier
; return - HIT ------ flag indicating segment found
;
N HIT
S HIT=0
F S I=$O(ARRAY(I)) Q:I="" I $P(ARRAY(I),DEL)=SEGMENT D Q
. S X=$P(ARRAY(I),DEL,2,99999) ; strip off the segment name
. S HIT=1
. Q
Q HIT
;
NEWTIU(GMRCIEN) ; check if this is a TIU note to be linked to an image group
; if so, create the cross-linkages now
N CROSSREF,D0,FILEDATA,HIT,MAGGP,MAGIEN,NIMAGE,TIUIEN
S HIT=0
S D0=""
F S D0=$O(^MAG(2006.5839,"C",123,GMRCIEN,D0)) Q:'D0 D
. S MAGGP=$P($G(^MAG(2006.5839,D0,0)),"^",3) Q:'MAGGP
. S TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN) Q:'TIUIEN
. S $P(^MAG(2005,MAGGP,2),"^",6,7)="8925^"_TIUIEN
. D TIUXLINK ; create the cross-linkages to TIU
. ; update the parent file pointers for all the images
. S CROSSREF="8925^"_TIUIEN_"^"_FILEDATA("PARENT FILE PTR")
. S NIMAGE=0 F S NIMAGE=$O(^MAG(2005,MAGGP,1,NIMAGE)) Q:'NIMAGE D
. . S MAGIEN=$P(^MAG(2005,MAGGP,1,NIMAGE,0),"^")
. . S $P(^MAG(2005,MAGIEN,2),"^",6,8)=CROSSREF
. . Q
. ; remove entries from ^MAG(2006.5839) & decrement the counter
. K ^MAG(2006.5839,D0),^MAG(2006.5839,"B",123,D0) ; P305 PMK 10/04/2021
. K ^MAG(2006.5839,"C",123,GMRCIEN,D0)
. L +^MAG(2006.5839):1E9 ; Background process MUST wait
. S $P(^MAG(2006.5839,0),"^",4)=$P(^MAG(2006.5839,0),"^",4)-1
. L -^MAG(2006.5839)
. S HIT=1
. Q
Q HIT
;
TIUXLINK ; create the cross-linkages to TIU EXTERNAL DATA LINK file
N TIUXDIEN
D PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
I TIUXDIEN D
. S FILEDATA("PARENT FILE PTR")=TIUXDIEN
. S $P(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
. Q
E D ; fatal error
. N MSG
. S MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
. S MSG(2)=$P(TIUXDIEN,"^",2,999)
. S MSG(3)=" for lookup in DICOM GMRC TEMP LIST (file 2006.5839)."
. D ERR^MAGGTERR ; P174 DAC - Error trap call fix
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOW0 3360 printed Nov 22, 2024@17:10:13 Page 2
MAGDHOW0 ;WOIFO/PMK,DAC - Capture Consult/Request data ; Oct 04, 2021@12:30:55
+1 ;;3.0;IMAGING;**138,174,305**;Mar 19, 2002;Build 3
+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 ;
+18 ;
+19 QUIT
+20 ;
FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
+1 ; input -- ARRAY ---- an HL7 array
+2 ; input -- SEGMENT -- three-letter HL7 segment identifier
+3 ; input -- I -------- index of the found segment (or null)
+4 ; output - I -------- index of the found segment (or null)
+5 ; output - X -------- string of fields sans segment identifier
+6 ; return - HIT ------ flag indicating segment found
+7 ;
+8 NEW HIT
+9 SET HIT=0
+10 FOR
SET I=$ORDER(ARRAY(I))
if I=""
QUIT
IF $PIECE(ARRAY(I),DEL)=SEGMENT
Begin DoDot:1
+11 ; strip off the segment name
SET X=$PIECE(ARRAY(I),DEL,2,99999)
+12 SET HIT=1
+13 QUIT
End DoDot:1
QUIT
+14 QUIT HIT
+15 ;
NEWTIU(GMRCIEN) ; check if this is a TIU note to be linked to an image group
+1 ; if so, create the cross-linkages now
+2 NEW CROSSREF,D0,FILEDATA,HIT,MAGGP,MAGIEN,NIMAGE,TIUIEN
+3 SET HIT=0
+4 SET D0=""
+5 FOR
SET D0=$ORDER(^MAG(2006.5839,"C",123,GMRCIEN,D0))
if 'D0
QUIT
Begin DoDot:1
+6 SET MAGGP=$PIECE($GET(^MAG(2006.5839,D0,0)),"^",3)
if 'MAGGP
QUIT
+7 SET TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN)
if 'TIUIEN
QUIT
+8 SET $PIECE(^MAG(2005,MAGGP,2),"^",6,7)="8925^"_TIUIEN
+9 ; create the cross-linkages to TIU
DO TIUXLINK
+10 ; update the parent file pointers for all the images
+11 SET CROSSREF="8925^"_TIUIEN_"^"_FILEDATA("PARENT FILE PTR")
+12 SET NIMAGE=0
FOR
SET NIMAGE=$ORDER(^MAG(2005,MAGGP,1,NIMAGE))
if 'NIMAGE
QUIT
Begin DoDot:2
+13 SET MAGIEN=$PIECE(^MAG(2005,MAGGP,1,NIMAGE,0),"^")
+14 SET $PIECE(^MAG(2005,MAGIEN,2),"^",6,8)=CROSSREF
+15 QUIT
End DoDot:2
+16 ; remove entries from ^MAG(2006.5839) & decrement the counter
+17 ; P305 PMK 10/04/2021
KILL ^MAG(2006.5839,D0),^MAG(2006.5839,"B",123,D0)
+18 KILL ^MAG(2006.5839,"C",123,GMRCIEN,D0)
+19 ; Background process MUST wait
LOCK +^MAG(2006.5839):1E9
+20 SET $PIECE(^MAG(2006.5839,0),"^",4)=$PIECE(^MAG(2006.5839,0),"^",4)-1
+21 LOCK -^MAG(2006.5839)
+22 SET HIT=1
+23 QUIT
End DoDot:1
+24 QUIT HIT
+25 ;
TIUXLINK ; create the cross-linkages to TIU EXTERNAL DATA LINK file
+1 NEW TIUXDIEN
+2 DO PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
+3 IF TIUXDIEN
Begin DoDot:1
+4 SET FILEDATA("PARENT FILE PTR")=TIUXDIEN
+5 SET $PIECE(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
+6 QUIT
End DoDot:1
+7 ; fatal error
IF '$TEST
Begin DoDot:1
+8 NEW MSG
+9 SET MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
+10 SET MSG(2)=$PIECE(TIUXDIEN,"^",2,999)
+11 SET MSG(3)=" for lookup in DICOM GMRC TEMP LIST (file 2006.5839)."
+12 ; P174 DAC - Error trap call fix
DO ERR^MAGGTERR
+13 QUIT
End DoDot:1
+14 QUIT
