1 | MAGGTIA2 ;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
|
---|
19 | RSLVPLC ;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 | ;
|
---|
35 | DUZ2INST ;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 | ;
|
---|
49 | QACHK(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
|
---|