- 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 Feb 18, 2025@23:29:27 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