MAGBAPIP ;WOIFO/MLH - Background Processor API to build queues - Modules for place
;;3.0;IMAGING;**1,7,8,20,59**;Nov 27, 2007;Build 20
;;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. |
;; +---------------------------------------------------------------+
;;
DUZ2PLC(WARN) ;Convert DUZ to a PLACE. File 2006.1 entry (PLACE)
; Extrinsic : Always returns a PLACE
; WARN : message about where the PLACE was derived from.
; Compute the Users Institution for older versions of Imaging Display workstation.
; This is called when DUZ(2) doesn't exist Or Can't resolve DUZ(2)
; into site param entry. This solved a GateWay Problem where DUZ(2) didn't
; exist. - Shouldn't get here anymore, that was fixed.
N MAGINST,DIVDTA,PLACE
S MAGINST=0
D GETS^DIQ(200,DUZ,"16*","I","DIVDTA") ; look up Division field
; ? Any division data on file for this user
I $D(DIVDTA) D ; yes, use it
. S MAGINST=@$Q(DIVDTA),WARN="Using first Division of New Person File."
. Q
E D ; no, use default site param?
. S MAGINST=$$KSP^XUPARAM("INST"),WARN="Using Kernel Site Param default entry." Q
. Q
S PLACE=$$GETPLACE^MAGBAPI(+$$PLACE^MAGBAPI(MAGINST))
I 'PLACE S PLACE=$O(^MAG(2006.1,0)),WARN="Using First Site Param entry."
Q PLACE
;
DA2PLC(MAGDA,TYPE) ; Get Place from Image File IEN
; TYPE : Possible values "A" Abstract, "F" Full Res or "B" Big File
; (defaults to "F" if null)
; Resolve Place (PLC) using the Acquisition Site field (ACQS)
; IF ACQS is null or not doesn't exist in the site parameter file
; THEN Resolve PLC using NetWork Location pointer
;
N MAGREF,MAG0,FBIG,SITE,PLC,MAGJB
I '$G(MAGDA) Q 0
S SITE=$P($G(^MAG(2005,MAGDA,100)),U,3)
I SITE S PLC=$$PLACE^MAGBAPI(SITE) Q:PLC PLC
; p59 Stop the error when an Image is Deleted.
S MAG0=$G(^MAG(2005,MAGDA,0)) Q:MAG0="" 0
;
S TYPE=$E($G(TYPE)_"F",1)
I "AF"[TYPE D
. S MAGREF=$S(TYPE="A":+$P(MAG0,"^",4),1:+$P(MAG0,"^",3))
. I MAGREF=0 S MAGJB=1,MAGREF=+$P(MAG0,"^",5) ; get file from jukebox
I "B"[TYPE D
. S FBIG=$G(^MAG(2005,MAGDA,"FBIG"))
. S MAGREF=+$P(FBIG,"^") ; get file from magnetic disk, if possible
. I MAGREF=0 S MAGREF=+$P(FBIG,"^",2) ; get file from jukebox
I 'MAGREF Q 0
I '$D(^MAG(2005.2,MAGREF,0)) Q 0
Q $$GETPLACE^MAGBAPI(+$$GET1^DIQ(2005.2,MAGREF,.04,"I"))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGBAPIP 3321 printed Dec 13, 2024@01:59:28 Page 2
MAGBAPIP ;WOIFO/MLH - Background Processor API to build queues - Modules for place
+1 ;;3.0;IMAGING;**1,7,8,20,59**;Nov 27, 2007;Build 20
+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 ;; | |
+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 ;;
DUZ2PLC(WARN) ;Convert DUZ to a PLACE. File 2006.1 entry (PLACE)
+1 ; Extrinsic : Always returns a PLACE
+2 ; WARN : message about where the PLACE was derived from.
+3 ; Compute the Users Institution for older versions of Imaging Display workstation.
+4 ; This is called when DUZ(2) doesn't exist Or Can't resolve DUZ(2)
+5 ; into site param entry. This solved a GateWay Problem where DUZ(2) didn't
+6 ; exist. - Shouldn't get here anymore, that was fixed.
+7 NEW MAGINST,DIVDTA,PLACE
+8 SET MAGINST=0
+9 ; look up Division field
DO GETS^DIQ(200,DUZ,"16*","I","DIVDTA")
+10 ; ? Any division data on file for this user
+11 ; yes, use it
IF $DATA(DIVDTA)
Begin DoDot:1
+12 SET MAGINST=@$QUERY(DIVDTA)
SET WARN="Using first Division of New Person File."
+13 QUIT
End DoDot:1
+14 ; no, use default site param?
IF '$TEST
Begin DoDot:1
+15 SET MAGINST=$$KSP^XUPARAM("INST")
SET WARN="Using Kernel Site Param default entry."
QUIT
+16 QUIT
End DoDot:1
+17 SET PLACE=$$GETPLACE^MAGBAPI(+$$PLACE^MAGBAPI(MAGINST))
+18 IF 'PLACE
SET PLACE=$ORDER(^MAG(2006.1,0))
SET WARN="Using First Site Param entry."
+19 QUIT PLACE
+20 ;
DA2PLC(MAGDA,TYPE) ; Get Place from Image File IEN
+1 ; TYPE : Possible values "A" Abstract, "F" Full Res or "B" Big File
+2 ; (defaults to "F" if null)
+3 ; Resolve Place (PLC) using the Acquisition Site field (ACQS)
+4 ; IF ACQS is null or not doesn't exist in the site parameter file
+5 ; THEN Resolve PLC using NetWork Location pointer
+6 ;
+7 NEW MAGREF,MAG0,FBIG,SITE,PLC,MAGJB
+8 IF '$GET(MAGDA)
QUIT 0
+9 SET SITE=$PIECE($GET(^MAG(2005,MAGDA,100)),U,3)
+10 IF SITE
SET PLC=$$PLACE^MAGBAPI(SITE)
if PLC
QUIT PLC
+11 ; p59 Stop the error when an Image is Deleted.
+12 SET MAG0=$GET(^MAG(2005,MAGDA,0))
if MAG0=""
QUIT 0
+13 ;
+14 SET TYPE=$EXTRACT($GET(TYPE)_"F",1)
+15 IF "AF"[TYPE
Begin DoDot:1
+16 SET MAGREF=$SELECT(TYPE="A":+$PIECE(MAG0,"^",4),1:+$PIECE(MAG0,"^",3))
+17 ; get file from jukebox
IF MAGREF=0
SET MAGJB=1
SET MAGREF=+$PIECE(MAG0,"^",5)
End DoDot:1
+18 IF "B"[TYPE
Begin DoDot:1
+19 SET FBIG=$GET(^MAG(2005,MAGDA,"FBIG"))
+20 ; get file from magnetic disk, if possible
SET MAGREF=+$PIECE(FBIG,"^")
+21 ; get file from jukebox
IF MAGREF=0
SET MAGREF=+$PIECE(FBIG,"^",2)
End DoDot:1
+22 IF 'MAGREF
QUIT 0
+23 IF '$DATA(^MAG(2005.2,MAGREF,0))
QUIT 0
+24 QUIT $$GETPLACE^MAGBAPI(+$$GET1^DIQ(2005.2,MAGREF,.04,"I"))
