| 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 | 
|---|