source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDFCNV.m@ 1111

Last change on this file since 1111 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1MAGDFCNV ;WOIFO/PMK - Read HL7 and generate DICOM ; 06/06/2005 09:14
2 ;;3.0;IMAGING;**11,51**;26-August-2005
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 ;
19 ; This routine needs to be on both the Gateway and on the VistA HIS.
20 ;
21 ; The M-to-M Broker Gateway can't use $$CONSOLID^MAGBAPI since is
22 ; doesn't have DDP.
23 ;
24 ; Note: The ^MAGOSFIL routine can never be on the VistA HIS.
25 ;
26CONSOLID() ; check if this is a consolidated site or not
27 ; return 0 = non-consolidated (normal) site
28 ; return 1 = consolidated site
29 ;
30 ; code for the main VistA HIS
31 Q $GET(^MAG(2006.1,"CONSOLIDATED"))="YES"
32 ;
33ACQDEV(MFGR,MODEL,SITE) ; get pointer to the Acquisition Device file
34 N ACQDEV ;--- name of acquisition device
35 N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
36 ;
37 S ACQDEV=$$UP^MAGDFCNV(MFGR_" ("_MODEL_")")
38 S ACQDEVP=$O(^MAG(2006.04,"B",ACQDEV,""))
39 I 'ACQDEVP D ; create the entry
40 . L +^MAG(2006.04,0):1E9 ; serialize name generation code
41 . I '$D(^MAG(2006.04,0)) S ^(0)="ACQUISITION DEVICE^2006.04^^"
42 . S ACQDEVP=$P(^MAG(2006.04,0),"^",3)+1
43 . S ^MAG(2006.04,ACQDEVP,0)=ACQDEV_"^"_SITE_"^" ; 3rd piece is null
44 . S ^MAG(2006.04,"B",ACQDEV,ACQDEVP)=""
45 . S $P(^MAG(2006.04,0),"^",3)=ACQDEVP
46 . S $P(^MAG(2006.04,0),"^",4)=ACQDEVP
47 . L -^MAG(2006.04,0) ; clear the serial name generation code
48 Q ACQDEVP
49 ;
50EQUIVGRP(P1,P2) ; see if two SOP Class pointers are in equivalent groups
51 N G1,G2
52 Q:'$G(P1) 0
53 Q:'$G(P2) 0
54 S G1=$P($G(^MAG(2006.532,P1,0)),"^",3) S:G1="" G1=P1
55 S G2=$P($G(^MAG(2006.532,P2,0)),"^",3) S:G2="" G2=P2
56 Q G1=G2
57 ;
58UP(X) ; special UPPER CASE function -- removes redundant blanks as well
59 F Q:X'[" " S $E(X,$F(X," ")-1)="" ; remove redundant blank
60 I $E(X)=" " S $E(X)="" ; remove leading blank
61 I $E(X,$L(X))=" " S $E(X,$L(X))="" ; remove trailing blank
62 Q $TR(X,"abcdefghijklmnopqrstuvwxyz^|","ABCDEFGHIJKLMNOPQRSTUVWXYZ~~")
Note: See TracBrowser for help on using the repository browser.