Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

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"))
     1MAGBAPIP ;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 ;;
     18DUZ2PLC(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 ;
     39DA2PLC(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.