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

MAGGTIA2.m

Go to the documentation of this file.
  1. MAGGTIA2 ;WOIFO/GEK/PMK - Imaging Utilities for Add/Modify Image entry ; 08 Jul 2013 2:57 PM
  1. ;;3.0;IMAGING;**10,50,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
  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. Q
  1. RSLVPLC ;VISN15 We are here to resolve the institution pointer
  1. ; field .05 In consolidated sites, we need this field.
  1. ; But if workstation hasn't updated yet, we'll try DUZ(2) for
  1. ; Capture Workstations
  1. N PLC
  1. ; USE of MAGJOB("VERSION") for this purpose will have to change.
  1. ; All calls will be setting it later.
  1. I '$D(MAGJOB("VERSION")) D ; Peter or Import API is calling;
  1. . I '$D(MAGGFDA(2005,"+1,",.05)) S MAGERR="0^Required data missing: INSTITUTION.!" Q
  1. . I '$D(DUZ(2)) S DUZ(2)=MAGGFDA(2005,"+1,",.05) ; Peter's change.
  1. . Q
  1. I $D(MAGJOB("VERSION")) D ; Capture Workstation is calling;
  1. . I '$D(MAGGFDA(2005,"+1,",.05)) D DUZ2INST I $L(MAGERR) Q
  1. . Q
  1. Q
  1. ;
  1. DUZ2INST ;VISN15 Compute the Users Institution for older versions of Imaging Capture workstation.
  1. ; Newer versions will have DUZ(2) defined.
  1. ; Either from New Person, or default from Kernel System Parameter file.
  1. N MAGINST
  1. S MAGINST=+$G(DUZ(2))
  1. I 'MAGINST D ; If we don't have a DUZ(2) check the user's Divisions in New Person.
  1. . I +$P($G(^VA(200,DUZ,2,0)),U,4)=0 Q
  1. . I $P($G(^VA(200,DUZ,2,0)),U,4)=1 S MAGINST=$O(^VA(200,DUZ,2,0))
  1. . I 'MAGINST S MAGINST=+$O(^VA(200,DUZ,2,"AX1",1,""))
  1. . Q
  1. I 'MAGINST S MAGERR="You must update your workstation to the latest Version of Imaging. Call IRM." Q
  1. S MAGGFDA(2005,"+1,",.05)=MAGINST
  1. Q
  1. ;
  1. QACHK(MAGY,MAGDFN,MAGPK,MAGPKDA) ; Check Patient of Parent Report against patient we
  1. ; are saving image too.
  1. ;
  1. S MAGDFN=$G(MAGDFN),MAGPK=$G(MAGPK),MAGPKDA=$G(MAGPKDA)
  1. S ^TMP("MAGFDA",$J,"DFN")=MAGDFN
  1. S ^TMP("MAGFDA",$J,"PK")=MAGPK
  1. S ^TMP("MAGFDA",$J,"PKDA")=MAGPKDA
  1. S MAGY="0^Checking for Matching Patients..."
  1. I 'MAGDFN S MAGY="0^Missing Patient ID." Q
  1. I 'MAGPK,'MAGPKDA S MAGY="1^No Report associated with Image." Q
  1. I MAGPK,'MAGPKDA S MAGY="0^Missing Parent root" Q
  1. I 'MAGPK,MAGPKDA S MAGY="0^Parent root, but Missing Parent." Q
  1. ; Here we have Parent and root and Patient DFN.
  1. ; Surgery reports
  1. I MAGPK=130 D Q
  1. . I MAGDFN'=$P(^SRF(MAGPKDA,0),U,1) S MAGY="0^Patient Mismatch (130)" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; TIU documents
  1. I MAGPK=8925 D Q
  1. . I MAGDFN'=$P($G(^TIU(8925,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (8925)" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; Medicine reports
  1. I MAGPK>689.999,MAGPK<703 D Q
  1. . I MAGDFN'=$P($G(^MCAR(MAGPK,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch("_MAGPK_")" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; Radiology reports
  1. I MAGPK=74 D Q
  1. . I MAGDFN'=$P($G(^RARPT(MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (74)" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; Laboratory reports
  1. I MAGPK'<63,MAGPK<64 D Q
  1. . S MAGY="1^Lab image not checked "
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; Temporary DICOM GMRC list (waiting for TIU notes for the association)
  1. I MAGPK=2006.5839 D Q
  1. . I MAGDFN'=$$GET1^DIQ(123,MAGPKDA,.02,"I") S MAGY="0^Patient Mismatch (2006.5839)" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. ; Temporary DICOM Lab list (waiting for TIU notes for the association)
  1. I MAGPK=2006.5838 D Q
  1. . I MAGDFN'=$$GET1^DIQ(63,MAGPKDA,.03,"I") S MAGY="0^Patient Mismatch (2006.5838)" Q
  1. . S MAGY="1^Image and Report Package Patients are the same."
  1. . Q
  1. S MAGY="0^Invalid Parent Package Pointer: "_MAGPK
  1. Q