MAGVD003 ;WOIFO/NST - Utilities for RPC calls for deletion ; 03 Apr 2012 1:54 PM
;;3.0;IMAGING;**118,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
;+++++ Get Accession number by IEN in IMAGE file (#2005)
;
; Input Parameters
; ================
; MAGDA - IEN in IMAGE file (#2005)
;
; Return Values
; =============
; if error OUT = Failed Status^Error message
; if success OUT = Success status^^Accession number
;
GETACN(OUT,MAGDA) ; get accession number
N PARENTFN,PARENTD0,MAGD2,CONSIX,ERR,ACN
N RESDEL
S RESDEL=$$RESDEL^MAGVAF02() ; Result delimiter
I '$$ISGRP^MAGGI11(MAGDA,.ERR) D Q
. S:$G(ERR)'="" OUT=$$FAILED^MAGVAF02()_RESDEL_$P(ERR,"^",2)
. S:$G(ERR)="" OUT=$$FAILED^MAGVAF02()_RESDEL_"Image "_MAGDA_" is not a group image"
. Q
S MAGD2=$G(^MAG(2005,MAGDA,2))
S PARENTFN=$P(MAGD2,"^",6) ; Parent Data File
S PARENTD0=+$P(MAGD2,"^",7) ; Parent Global Root D0
S ACN=""
I (PARENTFN=74),PARENTD0 D ; Radiology Image
. S ACN=$P($G(^RARPT(PARENTD0,0)),"^") ; IA # 1171 ; Get Accession number
. Q
I (PARENTFN=8925),PARENTD0 D
. S CONSIX=$$GET1^DIQ(8925,PARENTD0,1405,"I") ; #1405 REQUESTING PACKAGE REFERENCE
. S:$P(CONSIX,";",2)="GMR(123," ACN=$$GMRCACN^MAGDFCNV($P(CONSIX,";",1))
. Q
I (PARENTFN=2006.5839),PARENTD0 D ; Consult Image
. S ACN=$$GMRCACN^MAGDFCNV(PARENTD0)
. Q
S:ACN="" OUT=$$FAILED^MAGVAF02()_RESDEL_"Accession number not found"
D:ACN'="" SETOKVAL^MAGVAF02(.OUT,ACN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVD003 2474 printed Oct 16, 2024@18:10:18 Page 2
MAGVD003 ;WOIFO/NST - Utilities for RPC calls for deletion ; 03 Apr 2012 1:54 PM
+1 ;;3.0;IMAGING;**118,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
+18 ;+++++ Get Accession number by IEN in IMAGE file (#2005)
+19 ;
+20 ; Input Parameters
+21 ; ================
+22 ; MAGDA - IEN in IMAGE file (#2005)
+23 ;
+24 ; Return Values
+25 ; =============
+26 ; if error OUT = Failed Status^Error message
+27 ; if success OUT = Success status^^Accession number
+28 ;
GETACN(OUT,MAGDA) ; get accession number
+1 NEW PARENTFN,PARENTD0,MAGD2,CONSIX,ERR,ACN
+2 NEW RESDEL
+3 ; Result delimiter
SET RESDEL=$$RESDEL^MAGVAF02()
+4 IF '$$ISGRP^MAGGI11(MAGDA,.ERR)
Begin DoDot:1
+5 if $GET(ERR)'=""
SET OUT=$$FAILED^MAGVAF02()_RESDEL_$PIECE(ERR,"^",2)
+6 if $GET(ERR)=""
SET OUT=$$FAILED^MAGVAF02()_RESDEL_"Image "_MAGDA_" is not a group image"
+7 QUIT
End DoDot:1
QUIT
+8 SET MAGD2=$GET(^MAG(2005,MAGDA,2))
+9 ; Parent Data File
SET PARENTFN=$PIECE(MAGD2,"^",6)
+10 ; Parent Global Root D0
SET PARENTD0=+$PIECE(MAGD2,"^",7)
+11 SET ACN=""
+12 ; Radiology Image
IF (PARENTFN=74)
IF PARENTD0
Begin DoDot:1
+13 ; IA # 1171 ; Get Accession number
SET ACN=$PIECE($GET(^RARPT(PARENTD0,0)),"^")
+14 QUIT
End DoDot:1
+15 IF (PARENTFN=8925)
IF PARENTD0
Begin DoDot:1
+16 ; #1405 REQUESTING PACKAGE REFERENCE
SET CONSIX=$$GET1^DIQ(8925,PARENTD0,1405,"I")
+17 if $PIECE(CONSIX,";",2)="GMR(123,"
SET ACN=$$GMRCACN^MAGDFCNV($PIECE(CONSIX,";",1))
+18 QUIT
End DoDot:1
+19 ; Consult Image
IF (PARENTFN=2006.5839)
IF PARENTD0
Begin DoDot:1
+20 SET ACN=$$GMRCACN^MAGDFCNV(PARENTD0)
+21 QUIT
End DoDot:1
+22 if ACN=""
SET OUT=$$FAILED^MAGVAF02()_RESDEL_"Accession number not found"
+23 if ACN'=""
DO SETOKVAL^MAGVAF02(.OUT,ACN)
+24 QUIT
