- 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 Feb 18, 2025@23:25:55 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"))