Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGBAPIP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGBAPIP.m
r613 r623 1 MAGBAPIP ;WOIFO/MLH - Background Processor API to build queues - Modules for place 2 ;;3.0;IMAGING;**1,7,8,20,59**;Nov 27, 2007;Build 20 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ;; +---------------------------------------------------------------+ 5 ;; | Property of the US Government. | 6 ;; | No permission to copy or redistribute this software is given. | 7 ;; | Use of unreleased versions of this software requires the user | 8 ;; | to execute a written test agreement with the VistA Imaging | 9 ;; | Development Office of the Department of Veterans Affairs, | 10 ;; | telephone (301) 734-0100. | 11 ;; | | 12 ;; | The Food and Drug Administration classifies this software as | 13 ;; | a medical device. As such, it may not be changed in any way. | 14 ;; | Modifications to this software may result in an adulterated | 15 ;; | medical device under 21CFR820, the use of which is considered | 16 ;; | to be a violation of US Federal Statutes. | 17 ;; +---------------------------------------------------------------+ 18 ;; 19 DUZ2PLC(WARN) ;Convert DUZ to a PLACE. File 2006.1 entry (PLACE) 20 ; Extrinsic : Always returns a PLACE 21 ; WARN : message about where the PLACE was derived from. 22 ; Compute the Users Institution for older versions of Imaging Display workstation. 23 ; This is called when DUZ(2) doesn't exist Or Can't resolve DUZ(2) 24 ; into site param entry. This solved a GateWay Problem where DUZ(2) didn't 25 ; exist. - Shouldn't get here anymore, that was fixed. 26 N MAGINST,DIVDTA,PLACE 27 S MAGINST=0 28 D GETS^DIQ(200,DUZ,"16*","I","DIVDTA") ; look up Division field 29 ; ? Any division data on file for this user 30 I $D(DIVDTA) D ; yes, use it 31 . S MAGINST=@$Q(DIVDTA),WARN="Using first Division of New Person File." 32 . Q 33 E D ; no, use default site param? 34 . S MAGINST=$$KSP^XUPARAM("INST"),WARN="Using Kernel Site Param default entry." Q 35 . Q 36 S PLACE=$$GETPLACE^MAGBAPI(+$$PLACE^MAGBAPI(MAGINST)) 37 I 'PLACE S PLACE=$O(^MAG(2006.1,0)),WARN="Using First Site Param entry." 38 Q PLACE 39 ; 40 DA2PLC(MAGDA,TYPE) ; Get Place from Image File IEN 41 ; TYPE : Possible values "A" Abstract, "F" Full Res or "B" Big File 42 ; (defaults to "F" if null) 43 ; Resolve Place (PLC) using the Acquisition Site field (ACQS) 44 ; IF ACQS is null or not doesn't exist in the site parameter file 45 ; THEN Resolve PLC using NetWork Location pointer 46 ; 47 N MAGREF,MAG0,FBIG,SITE,PLC,MAGJB 48 I '$G(MAGDA) Q 0 49 S SITE=$P($G(^MAG(2005,MAGDA,100)),U,3) 50 I SITE S PLC=$$PLACE^MAGBAPI(SITE) Q:PLC PLC 51 ; p59 Stop the error when an Image is Deleted. 52 S MAG0=$G(^MAG(2005,MAGDA,0)) Q:MAG0="" 0 53 ; 54 S TYPE=$E($G(TYPE)_"F",1) 55 I "AF"[TYPE D 56 . S MAGREF=$S(TYPE="A":+$P(MAG0,"^",4),1:+$P(MAG0,"^",3)) 57 . I MAGREF=0 S MAGJB=1,MAGREF=+$P(MAG0,"^",5) ; get file from jukebox 58 I "B"[TYPE D 59 . S FBIG=$G(^MAG(2005,MAGDA,"FBIG")) 60 . S MAGREF=+$P(FBIG,"^") ; get file from magnetic disk, if possible 61 . I MAGREF=0 S MAGREF=+$P(FBIG,"^",2) ; get file from jukebox 62 I 'MAGREF Q 0 63 I '$D(^MAG(2005.2,MAGREF,0)) Q 0 64 Q $$GETPLACE^MAGBAPI(+$$GET1^DIQ(2005.2,MAGREF,.04,"I")) 1 MAGBAPIP ;WOIFO/MLH - Background Processor API to build queues - Modules for place 2 ;;3.0;IMAGING;**1,7,8,20**;Apr 12, 2006 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 ;; 18 DUZ2PLC(WARN) ; Moved from MAGGTU3 v2.5 - DBI - SEB Patch 4 19 ; Extrinsic : Always returns a PLACE /gek 8/2003 20 ; WARN : message about where the PLACE was derived from. /gek 8/2003 21 ; Compute the Users Institution for older versions of Imaging Display workstation. 22 ; This is called when : 23 ; DUZ(2) doesn't exist, 24 ; Or Can't resolve DUZ(2) into site param entry 25 N MAGINST,DIVDTA,PLACE 26 S MAGINST=0 27 D GETS^DIQ(200,DUZ,"16*","I","DIVDTA") ; look up Division field 28 ; ? Any division data on file for this user 29 I $D(DIVDTA) D ; yes, use it 30 . S MAGINST=@$Q(DIVDTA),WARN="Using first Division of New Person File." 31 . Q 32 E D ; no, use default site param? 33 . S MAGINST=$$KSP^XUPARAM("INST"),WARN="Using Kernel Site Param default entry." Q 34 . Q 35 S PLACE=$$GETPLACE^MAGBAPI(+$$PLACE^MAGBAPI(MAGINST)) 36 I 'PLACE S PLACE=$O(^MAG(2006.1,0)),WARN="Using First Site Param entry." 37 Q PLACE 38 ; 39 DA2PLC(MAGDA,TYPE) ; Moved from MAGGTU7 v2.5 - DBI - SEB Patch 4 40 ; TYPE : Possible values "A" Abstract, "F" Full Res or "B" Big File 41 ; (defaults to "F" if null) 42 ; Resolve current place of image using the Acquisition Site field, then 43 ; resolve current place of image using NetWork Location pointer 44 ; if the Acquisition Site field is null or not related to the site 45 ; parameter file. 46 ; 47 N MAGREF,MAG0,FBIG,SITE,PLC,MAGJB 48 I '$G(MAGDA) Q 0 49 S SITE=$P($G(^MAG(2005,MAGDA,100)),U,3) 50 I SITE S PLC=$$PLACE^MAGBAPI(SITE) Q:PLC PLC 51 S MAG0=^MAG(2005,MAGDA,0) 52 ;I '$D(TYPE) S TYPE="F" /gek 8/2003 mod for efficiency (from ed) 53 S TYPE=$E($G(TYPE)_"F",1) 54 I "AF"[TYPE D 55 . S MAGREF=$S(TYPE="A":+$P(MAG0,"^",4),1:+$P(MAG0,"^",3)) 56 . I MAGREF=0 S MAGJB=1,MAGREF=+$P(MAG0,"^",5) ; get file from jukebox 57 I "B"[TYPE D 58 . S FBIG=$G(^MAG(2005,MAGDA,"FBIG")) 59 . S MAGREF=+$P(FBIG,"^") ; get file from magnetic disk, if possible 60 . I MAGREF=0 S MAGREF=+$P(FBIG,"^",2) ; get file from jukebox 61 I 'MAGREF Q 0 62 I '$D(^MAG(2005.2,MAGREF,0)) Q 0 63 Q $$GETPLACE^MAGBAPI(+$$GET1^DIQ(2005.2,MAGREF,.04,"I"))
Note:
See TracChangeset
for help on using the changeset viewer.