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

MAGDHOW0.m

Go to the documentation of this file. 
  1. 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
  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.  ;
  1.  ;
  1.  Q
  1.  ;
  1. FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
  1.  ; input -- ARRAY ---- an HL7 array
  1.  ; input -- SEGMENT -- three-letter HL7 segment identifier 
  1.  ; input -- I -------- index of the found segment (or null)
  1.  ; output - I -------- index of the found segment (or null)
  1.  ; output - X -------- string of fields sans segment identifier
  1.  ; return - HIT ------ flag indicating segment found 
  1.  ;
  1.  N HIT
  1.  S HIT=0
  1.  F  S I=$O(ARRAY(I)) Q:I=""  I $P(ARRAY(I),DEL)=SEGMENT D  Q
  1.  . S X=$P(ARRAY(I),DEL,2,99999) ; strip off the segment name
  1.  . S HIT=1
  1.  . Q
  1.  Q HIT
  1.  ;
  1. NEWTIU(GMRCIEN) ; check if this is a TIU note to be linked to an image group
  1.  ; if so, create the cross-linkages now
  1.  N CROSSREF,D0,FILEDATA,HIT,MAGGP,MAGIEN,NIMAGE,TIUIEN
  1.  S HIT=0
  1.  S D0=""
  1.  F  S D0=$O(^MAG(2006.5839,"C",123,GMRCIEN,D0)) Q:'D0  D
  1.  . S MAGGP=$P($G(^MAG(2006.5839,D0,0)),"^",3) Q:'MAGGP
  1.  . S TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN) Q:'TIUIEN
  1.  . S $P(^MAG(2005,MAGGP,2),"^",6,7)="8925^"_TIUIEN
  1.  . D TIUXLINK ; create the cross-linkages to TIU
  1.  . ; update the parent file pointers for all the images
  1.  . S CROSSREF="8925^"_TIUIEN_"^"_FILEDATA("PARENT FILE PTR")
  1.  . S NIMAGE=0 F  S NIMAGE=$O(^MAG(2005,MAGGP,1,NIMAGE)) Q:'NIMAGE  D
  1.  . . S MAGIEN=$P(^MAG(2005,MAGGP,1,NIMAGE,0),"^")
  1.  . . S $P(^MAG(2005,MAGIEN,2),"^",6,8)=CROSSREF
  1.  . . Q
  1.  . ; remove entries from ^MAG(2006.5839) & decrement the counter
  1.  . K ^MAG(2006.5839,D0),^MAG(2006.5839,"B",123,D0) ; P305 PMK 10/04/2021
  1.  . K ^MAG(2006.5839,"C",123,GMRCIEN,D0)
  1.  . L +^MAG(2006.5839):1E9 ; Background process MUST wait
  1.  . S $P(^MAG(2006.5839,0),"^",4)=$P(^MAG(2006.5839,0),"^",4)-1
  1.  . L -^MAG(2006.5839)
  1.  . S HIT=1
  1.  . Q
  1.  Q HIT
  1.  ;
  1.  N TIUXDIEN
  1.  D PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
  1.  I TIUXDIEN D
  1.  . S FILEDATA("PARENT FILE PTR")=TIUXDIEN
  1.  . S $P(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
  1.  . Q
  1.  E  D  ; fatal error
  1.  . N MSG
  1.  . S MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
  1.  . S MSG(2)=$P(TIUXDIEN,"^",2,999)
  1.  . S MSG(3)=" for lookup in DICOM GMRC TEMP LIST (file 2006.5839)."
  1.  . D ERR^MAGGTERR ; P174 DAC - Error trap call fix
  1.  . Q
  1.  Q