MAGGTIA2 ;WOIFO/GEK/PMK - Imaging Utilities for Add/Modify Image entry ; 08 Jul 2013 2:57 PM
;;3.0;IMAGING;**10,50,138**;Mar 19, 2002;Build 5380;Sep 03, 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
RSLVPLC ;VISN15 We are here to resolve the institution pointer
; field .05 In consolidated sites, we need this field.
; But if workstation hasn't updated yet, we'll try DUZ(2) for
; Capture Workstations
N PLC
; USE of MAGJOB("VERSION") for this purpose will have to change.
; All calls will be setting it later.
I '$D(MAGJOB("VERSION")) D ; Peter or Import API is calling;
. I '$D(MAGGFDA(2005,"+1,",.05)) S MAGERR="0^Required data missing: INSTITUTION.!" Q
. I '$D(DUZ(2)) S DUZ(2)=MAGGFDA(2005,"+1,",.05) ; Peter's change.
. Q
I $D(MAGJOB("VERSION")) D ; Capture Workstation is calling;
. I '$D(MAGGFDA(2005,"+1,",.05)) D DUZ2INST I $L(MAGERR) Q
. Q
Q
;
DUZ2INST ;VISN15 Compute the Users Institution for older versions of Imaging Capture workstation.
; Newer versions will have DUZ(2) defined.
; Either from New Person, or default from Kernel System Parameter file.
N MAGINST
S MAGINST=+$G(DUZ(2))
I 'MAGINST D ; If we don't have a DUZ(2) check the user's Divisions in New Person.
. I +$P($G(^VA(200,DUZ,2,0)),U,4)=0 Q
. I $P($G(^VA(200,DUZ,2,0)),U,4)=1 S MAGINST=$O(^VA(200,DUZ,2,0))
. I 'MAGINST S MAGINST=+$O(^VA(200,DUZ,2,"AX1",1,""))
. Q
I 'MAGINST S MAGERR="You must update your workstation to the latest Version of Imaging. Call IRM." Q
S MAGGFDA(2005,"+1,",.05)=MAGINST
Q
;
QACHK(MAGY,MAGDFN,MAGPK,MAGPKDA) ; Check Patient of Parent Report against patient we
; are saving image too.
;
S MAGDFN=$G(MAGDFN),MAGPK=$G(MAGPK),MAGPKDA=$G(MAGPKDA)
S ^TMP("MAGFDA",$J,"DFN")=MAGDFN
S ^TMP("MAGFDA",$J,"PK")=MAGPK
S ^TMP("MAGFDA",$J,"PKDA")=MAGPKDA
S MAGY="0^Checking for Matching Patients..."
I 'MAGDFN S MAGY="0^Missing Patient ID." Q
I 'MAGPK,'MAGPKDA S MAGY="1^No Report associated with Image." Q
I MAGPK,'MAGPKDA S MAGY="0^Missing Parent root" Q
I 'MAGPK,MAGPKDA S MAGY="0^Parent root, but Missing Parent." Q
; Here we have Parent and root and Patient DFN.
; Surgery reports
I MAGPK=130 D Q
. I MAGDFN'=$P(^SRF(MAGPKDA,0),U,1) S MAGY="0^Patient Mismatch (130)" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; TIU documents
I MAGPK=8925 D Q
. I MAGDFN'=$P($G(^TIU(8925,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (8925)" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; Medicine reports
I MAGPK>689.999,MAGPK<703 D Q
. I MAGDFN'=$P($G(^MCAR(MAGPK,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch("_MAGPK_")" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; Radiology reports
I MAGPK=74 D Q
. I MAGDFN'=$P($G(^RARPT(MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (74)" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; Laboratory reports
I MAGPK'<63,MAGPK<64 D Q
. S MAGY="1^Lab image not checked "
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; Temporary DICOM GMRC list (waiting for TIU notes for the association)
I MAGPK=2006.5839 D Q
. I MAGDFN'=$$GET1^DIQ(123,MAGPKDA,.02,"I") S MAGY="0^Patient Mismatch (2006.5839)" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
; Temporary DICOM Lab list (waiting for TIU notes for the association)
I MAGPK=2006.5838 D Q
. I MAGDFN'=$$GET1^DIQ(63,MAGPKDA,.03,"I") S MAGY="0^Patient Mismatch (2006.5838)" Q
. S MAGY="1^Image and Report Package Patients are the same."
. Q
S MAGY="0^Invalid Parent Package Pointer: "_MAGPK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTIA2 4621 printed Sep 23, 2025@19:39:12 Page 2
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
+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
RSLVPLC ;VISN15 We are here to resolve the institution pointer
+1 ; field .05 In consolidated sites, we need this field.
+2 ; But if workstation hasn't updated yet, we'll try DUZ(2) for
+3 ; Capture Workstations
+4 NEW PLC
+5 ; USE of MAGJOB("VERSION") for this purpose will have to change.
+6 ; All calls will be setting it later.
+7 ; Peter or Import API is calling;
IF '$DATA(MAGJOB("VERSION"))
Begin DoDot:1
+8 IF '$DATA(MAGGFDA(2005,"+1,",.05))
SET MAGERR="0^Required data missing: INSTITUTION.!"
QUIT
+9 ; Peter's change.
IF '$DATA(DUZ(2))
SET DUZ(2)=MAGGFDA(2005,"+1,",.05)
+10 QUIT
End DoDot:1
+11 ; Capture Workstation is calling;
IF $DATA(MAGJOB("VERSION"))
Begin DoDot:1
+12 IF '$DATA(MAGGFDA(2005,"+1,",.05))
DO DUZ2INST
IF $LENGTH(MAGERR)
QUIT
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
DUZ2INST ;VISN15 Compute the Users Institution for older versions of Imaging Capture workstation.
+1 ; Newer versions will have DUZ(2) defined.
+2 ; Either from New Person, or default from Kernel System Parameter file.
+3 NEW MAGINST
+4 SET MAGINST=+$GET(DUZ(2))
+5 ; If we don't have a DUZ(2) check the user's Divisions in New Person.
IF 'MAGINST
Begin DoDot:1
+6 IF +$PIECE($GET(^VA(200,DUZ,2,0)),U,4)=0
QUIT
+7 IF $PIECE($GET(^VA(200,DUZ,2,0)),U,4)=1
SET MAGINST=$ORDER(^VA(200,DUZ,2,0))
+8 IF 'MAGINST
SET MAGINST=+$ORDER(^VA(200,DUZ,2,"AX1",1,""))
+9 QUIT
End DoDot:1
+10 IF 'MAGINST
SET MAGERR="You must update your workstation to the latest Version of Imaging. Call IRM."
QUIT
+11 SET MAGGFDA(2005,"+1,",.05)=MAGINST
+12 QUIT
+13 ;
QACHK(MAGY,MAGDFN,MAGPK,MAGPKDA) ; Check Patient of Parent Report against patient we
+1 ; are saving image too.
+2 ;
+3 SET MAGDFN=$GET(MAGDFN)
SET MAGPK=$GET(MAGPK)
SET MAGPKDA=$GET(MAGPKDA)
+4 SET ^TMP("MAGFDA",$JOB,"DFN")=MAGDFN
+5 SET ^TMP("MAGFDA",$JOB,"PK")=MAGPK
+6 SET ^TMP("MAGFDA",$JOB,"PKDA")=MAGPKDA
+7 SET MAGY="0^Checking for Matching Patients..."
+8 IF 'MAGDFN
SET MAGY="0^Missing Patient ID."
QUIT
+9 IF 'MAGPK
IF 'MAGPKDA
SET MAGY="1^No Report associated with Image."
QUIT
+10 IF MAGPK
IF 'MAGPKDA
SET MAGY="0^Missing Parent root"
QUIT
+11 IF 'MAGPK
IF MAGPKDA
SET MAGY="0^Parent root, but Missing Parent."
QUIT
+12 ; Here we have Parent and root and Patient DFN.
+13 ; Surgery reports
+14 IF MAGPK=130
Begin DoDot:1
+15 IF MAGDFN'=$PIECE(^SRF(MAGPKDA,0),U,1)
SET MAGY="0^Patient Mismatch (130)"
QUIT
+16 SET MAGY="1^Image and Report Package Patients are the same."
+17 QUIT
End DoDot:1
QUIT
+18 ; TIU documents
+19 IF MAGPK=8925
Begin DoDot:1
+20 IF MAGDFN'=$PIECE($GET(^TIU(8925,MAGPKDA,0)),U,2)
SET MAGY="0^Patient Mismatch (8925)"
QUIT
+21 SET MAGY="1^Image and Report Package Patients are the same."
+22 QUIT
End DoDot:1
QUIT
+23 ; Medicine reports
+24 IF MAGPK>689.999
IF MAGPK<703
Begin DoDot:1
+25 IF MAGDFN'=$PIECE($GET(^MCAR(MAGPK,MAGPKDA,0)),U,2)
SET MAGY="0^Patient Mismatch("_MAGPK_")"
QUIT
+26 SET MAGY="1^Image and Report Package Patients are the same."
+27 QUIT
End DoDot:1
QUIT
+28 ; Radiology reports
+29 IF MAGPK=74
Begin DoDot:1
+30 IF MAGDFN'=$PIECE($GET(^RARPT(MAGPKDA,0)),U,2)
SET MAGY="0^Patient Mismatch (74)"
QUIT
+31 SET MAGY="1^Image and Report Package Patients are the same."
+32 QUIT
End DoDot:1
QUIT
+33 ; Laboratory reports
+34 IF MAGPK'<63
IF MAGPK<64
Begin DoDot:1
+35 SET MAGY="1^Lab image not checked "
+36 SET MAGY="1^Image and Report Package Patients are the same."
+37 QUIT
End DoDot:1
QUIT
+38 ; Temporary DICOM GMRC list (waiting for TIU notes for the association)
+39 IF MAGPK=2006.5839
Begin DoDot:1
+40 IF MAGDFN'=$$GET1^DIQ(123,MAGPKDA,.02,"I")
SET MAGY="0^Patient Mismatch (2006.5839)"
QUIT
+41 SET MAGY="1^Image and Report Package Patients are the same."
+42 QUIT
End DoDot:1
QUIT
+43 ; Temporary DICOM Lab list (waiting for TIU notes for the association)
+44 IF MAGPK=2006.5838
Begin DoDot:1
+45 IF MAGDFN'=$$GET1^DIQ(63,MAGPKDA,.03,"I")
SET MAGY="0^Patient Mismatch (2006.5838)"
QUIT
+46 SET MAGY="1^Image and Report Package Patients are the same."
+47 QUIT
End DoDot:1
QUIT
+48 SET MAGY="0^Invalid Parent Package Pointer: "_MAGPK
+49 QUIT
