- 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 Feb 18, 2025@23:36:06 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
