source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1MAGGTIA2 ;WOIFO/GEK - Imaging Utilities for Add/Modify Image entry ; 11/10/2005 15:07
2 ;;3.0;IMAGING;**10,50**;26-May-2006
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19RSLVPLC ;VISN15 We are here to resolve the institution pointer
20 ; field .05 In consolidated sites, we need this field.
21 ; But if workstation hasn't updated yet, we'll try DUZ(2) for
22 ; Capture Workstations
23 N PLC
24 ; USE of MAGJOB("VERSION") for this purpose will have to change.
25 ; All calls will be setting it later.
26 I '$D(MAGJOB("VERSION")) D ; Peter or Import API is calling;
27 . I '$D(MAGGFDA(2005,"+1,",.05)) S MAGERR="0^Required data missing: INSTITUTION.!" Q
28 . I '$D(DUZ(2)) S DUZ(2)=MAGGFDA(2005,"+1,",.05) ; Peter's change.
29 . Q
30 I $D(MAGJOB("VERSION")) D ; Capture Workstation is calling;
31 . I '$D(MAGGFDA(2005,"+1,",.05)) D DUZ2INST I $L(MAGERR) Q
32 . Q
33 Q
34 ;
35DUZ2INST ;VISN15 Compute the Users Institution for older versions of Imaging Capture workstation.
36 ; Newer versions will have DUZ(2) defined.
37 ; Either from New Person, or default from Kernel System Parameter file.
38 N MAGINST
39 S MAGINST=+$G(DUZ(2))
40 I 'MAGINST D ; If we don't have a DUZ(2) check the user's Divisions in New Person.
41 . I +$P($G(^VA(200,DUZ,2,0)),U,4)=0 Q
42 . I $P($G(^VA(200,DUZ,2,0)),U,4)=1 S MAGINST=$O(^VA(200,DUZ,2,0))
43 . I 'MAGINST S MAGINST=+$O(^VA(200,DUZ,2,"AX1",1,""))
44 . Q
45 I 'MAGINST S MAGERR="You must update your workstation to the latest Version of Imaging. Call IRM." Q
46 S MAGGFDA(2005,"+1,",.05)=MAGINST
47 Q
48 ;
49QACHK(MAGY,MAGDFN,MAGPK,MAGPKDA) ; Check Patient of Parent Report against patient we
50 ; are saving image too.
51 ;
52 S MAGDFN=$G(MAGDFN),MAGPK=$G(MAGPK),MAGPKDA=$G(MAGPKDA)
53 S ^TMP("MAGFDA",$J,"DFN")=MAGDFN
54 S ^TMP("MAGFDA",$J,"PK")=MAGPK
55 S ^TMP("MAGFDA",$J,"PKDA")=MAGPKDA
56 S MAGY="0^Checking for Matching Patients..."
57 I 'MAGDFN S MAGY="0^Missing Patient ID." Q
58 I 'MAGPK,'MAGPKDA S MAGY="1^No Report associated with Image." Q
59 I MAGPK,'MAGPKDA S MAGY="0^Missing Parent root" Q
60 I 'MAGPK,MAGPKDA S MAGY="0^Parent root, but Missing Parent." Q
61 ; Here we have Parent and root and Patient DFN.
62 ; Surgery reports
63 I MAGPK=130 D Q
64 . I MAGDFN'=$P(^SRF(MAGPKDA,0),U,1) S MAGY="0^Patient Mismatch (130)" Q
65 . S MAGY="1^Image and Report Package Patients are the same."
66 . Q
67 ; TIU documents
68 I MAGPK=8925 D Q
69 . I MAGDFN'=$P($G(^TIU(8925,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (8925)" Q
70 . S MAGY="1^Image and Report Package Patients are the same."
71 . Q
72 ; Medicine reports
73 I MAGPK>689.999,MAGPK<703 D Q
74 . I MAGDFN'=$P($G(^MCAR(MAGPK,MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch("_MAGPK_")" Q
75 . S MAGY="1^Image and Report Package Patients are the same."
76 . Q
77 ; Radiology reports
78 I MAGPK=74 D Q
79 . I MAGDFN'=$P($G(^RARPT(MAGPKDA,0)),U,2) S MAGY="0^Patient Mismatch (74)" Q
80 . S MAGY="1^Image and Report Package Patients are the same."
81 . Q
82 ; Laboratory reports
83 I MAGPK'<63,MAGPK<64 D Q
84 . S MAGY="1^Lab image not checked "
85 . S MAGY="1^Image and Report Package Patients are the same."
86 . Q
87 ; Temporary DICOM GMRC list (waiting for TIU notes for the association)
88 I MAGPK=2006.5839 D Q
89 . I MAGDFN'=$$GET1^DIQ(123,MAGPKDA,.02,"I") S MAGY="0^Patient Mismatch (2006.5839)" Q
90 . S MAGY="1^Image and Report Package Patients are the same."
91 . Q
92 S MAGY="0^Invalid Parent Package Pointer: "_MAGPK
93 Q
Note: See TracBrowser for help on using the repository browser.